subroutine inprun C ***************************************************************** wjr C reads management file into common blocks C C Edit History C 06-Feb-99 wjr created from existing code, select added C include 'p1werm.inc' include 'wpath.inc' include 'm1subr.inc' include 'm1sim.inc' include 'm1geo.inc' include 'm1flag.inc' include 'm1dbug.inc' include 's1layr.inc' include 's1surf.inc' include 's1phys.inc' include 's1agg.inc' include 's1dbh.inc' include 's1dbc.inc' include 's1layd.inc' include 's1sgeo.inc' include 'c1gen.inc' include 'd1gen.inc' include 'd1glob.inc' include 'h1hydro.inc' include 'h1scs.inc' include 'h1db1.inc' include 'file.fi' c + + + LOCAL COMMON BLOCKS + + + include 'main/main.inc' c + + + LOCAL VARIABLES + + + integer i, isr, iar, ios, ibr character line*256 real srln, srwdth logical fexist c + + + FUNCTION DECLARATIONS + + + c integer julday integer lstday integer lentrm C integer linnum, typidx data linnum /0/, typidx /0/ C C open simulation run file write (*,*) 'runfil is ', runfil print *, 'We are no going to open runfil!' print *, 'lui1: ', lui1 call fopenk (lui1, runfil(1:lentrm(runfil)), 'old') print *, 'We now have opened runfil!' c call fopenk (lui1, runfil, 'old') C c read simulation run file 100 linnum = linnum + 1 if (typidx.eq.36) go to 200 105 read (lui1,'(a)',err=80) line C C skip comment lines if (line(1:1) .eq. '#') go to 100 C C use case statement to appropriately assign values typidx = typidx + 1 select case (typidx) case (1) usrnam = line case (2) usrid = line case (3) usrloc = line case (4) read (line,*,err=80, iostat=ios) amalat if ((amalat .lt. 0.) .or. (amalat .gt. 90.)) then write (*,2220) goto 80 end if case (5) read (line,*,err=80) amalon if ((amalon .lt. 0.) .or. (amalon .gt. 360.)) then write (*,2230) goto 80 end if case (6) read (line,*,err=80) amzele case (7) read (line,*,err=80) id,im,iy case (8) read (line,*,err=80) ld,lm,ly if (((id .lt. 1) .or. (id .gt. lstday(im,iy))) .or. ((ld .lt. 1) & .or. (ld .gt. lstday(lm,ly)))) then write (*,2240) goto 80 end if if (((id .lt. 1) .or. (id .gt. 31)) .or. ((ld .lt. 1) .or. (ld & .gt. 31))) then write (*,2250) goto 80 end if if (((im .lt. 1) .or. (im .gt. 12)) .or. ((lm .lt. 1) .or. (lm & .gt. 12))) then write (*,2250) goto 80 end if if (((iy .lt. 0) .or. (iy .gt.9999)) .or. ((ly .lt. 0) .or. (ly & .gt. 9999))) then write (*,2260) goto 80 end if if ((ly - iy) .lt. 0) then write (*,2265) goto 80 end if case (9) read (line,*,err=80) ntstep c read CLIGEN file name case (10) write(luolog, *) 'line ', line write(luolog, *) 'line: ', line(1:lentrm(line)) clifil = rootp(1:lentrm(rootp)) // line(1:lentrm(line)) c open CLIGEN run file write(luolog, *) 'line2 ', line write(luolog, *) 'clifil ', clifil write(luolog, *) 'len ', len(clifil), lentrm(clifil) inquire(file = clifil, exist = fexist) if(.not. fexist) then write(*,*) clifil,' CLIGEN file not found' goto 80 endif call fopenk (luicli, clifil, 'old') case (11) c read WINDGEN file name winfil = rootp(1:lentrm(rootp)) // line c open WINDGEN run file inquire(file = winfil, exist = fexist) if(.not. fexist) then write(*,*) winfil,' WINDGEN file not found' goto 80 endif call fopenk (luiwin, winfil, 'old') case (12) c read subdaily wind file name if (line(1:4) .ne. 'none') then subfil = rootp(1:lentrm(rootp)) // line c inquire(file = subfil, exist = fexist) c if(.not. fexist) then c write(*,*) ' ' c write(*,*) ' warning, the subdaily wind file:' c write(*,*) subfil,'was not found - all winds will be generated' c end if c open sub-daily wind file (i.e.'real' data) if it exists inquire(file = subfil, exist = fexist) if(fexist) then write(*,2270) subfil 2270 format (/,' using the sub-daily wind file: ',a80) call fopenk (luiwsd, subfil, 'old') endif endif case (13) c read in initial field conditions file name sinfil = rootp(1:lentrm(rootp)) // line case (14) c read in management file name tinfil = rootp(1:lentrm(rootp)) // line case (15) c read output file name simout = rootp(1:lentrm(rootp)) // line open (unit = 2, file = simout) case (16) c read the flags to select the various general report forms read (line,*,err=80) (gnrpt(i), i=1,6) c read code to select period for output c yearly and simulation summaries are always given case (17) read (line,*,err=80) erosrpt C c read flags to print submodel output case (18) read (line,*,err=80) am0hfl,am0sfl,am0tfl,am0cfl,am0dfl,am0efl case (19) read (line,*,err=80) am0hdb,am0sdb,am0cdb,am0ddb,am0tdb if (am0hdb .eq. 1) open (unit = 25, & file = rootp(1:lentrm(rootp)) // 'hdbug.out') if (am0sdb .eq. 1) open (unit = 26, & file = rootp(1:lentrm(rootp)) // 'sdbug.out') if (am0cdb .eq. 1) open (unit = 27, & file = rootp(1:lentrm(rootp)) // 'cdbug.out') if (am0ddb .eq. 1) open (unit = 28, & file = rootp(1:lentrm(rootp)) // 'ddbug.out') if (am0tdb .eq. 1) open (unit = 29, & file = rootp(1:lentrm(rootp)) // 'tdbug.out') c open output files for the crop submodel: unit =17,57,58,59,60 are c being used by CROP. (A. Retta: 11/19/96) if (am0cfl .eq. 1) call cpout case (20) read (line,*,err=80) amasim case (21) read (line,*,err=80) amxsim(1,1), amxsim(2,1) case (22) read (line,*,err=80) amxsim(1,2),amxsim(2,2) case (23) read (line,*,err=80) srln, srwdth case (24) read (line,*,err=80) nacctr C set up iar for reading in next lines iar = 1 case (25) read (line,*,err=80) amxar(1,1,iar), amxar(2,1,iar) case (26) read (line,*,err=80) amxar(1,2,iar), amxar(2,2,iar) C send us back to case (25) to read in array if (iar.lt.nacctr) typidx = typidx - 2 iar = iar + 1 case (27) read (line,*,err=80) nsubr isr = 1 c *** do 20 isr = 1,nsubr case (28) read (line,*,err=80) amxsr(1,1,isr), amxsr(2,1,isr) case (29) read (line,*,err=80) amxsr(1,2,isr), amxsr(2,2,isr) case (30) c read in barrier info read (line,*,err=80) nbr C I wonder why this line is here ibr = 1 case (31) read (line,*,err=80) amxbr(1,1,ibr), amxbr(2,1,ibr) write(luodbg,*) line, amxbr(1,1,ibr), amxbr(2,1,ibr) case (32) read (line,*,err=80) amxbr(1,2,ibr), amxbr(2,2,ibr) case (33) read (line,*,err=80) amzbr(ibr) case (34) read (line,*,err=80) amxbrw(ibr) case (35) read (line,*,err=80) ampbr(ibr) case (36) read (line,*,err=80) amrslp(isr) if (isr.lt.nsubr) typidx=typidx-9 isr = isr+1 end select goto 100 C 80 write(*,9001) runfil, linnum, typidx, line 9001 format('Error in file ',a,' on line #',i4,i3,' ',a) stop 200 close (lui1) C C Format statements C 2220 format (/,' error, latitude is not between 0. and 90. degrees',/,' & - please check run file') 2230 format (/,' error, longitude is not between 0. and 360. degrees',/ &,' - please check run file') 2240 format (/,' error, initial or last day of simulation is out of bou &nds',/,' - please check run file') 2250 format (/,' error, initial or last day or month of simulation is o &ut of bounds',/,' - please check run file') 2260 format (/,' error, initial or last year of simulation is not betwe &en 0 and 99',/,' - please check run file') 2265 format (/,' error, initial year of simulation is greater than the &last year of simulation',/,' - please check run file') end