subroutine inpsub C ***************************************************************** wjr C reads management file into common blocks C C Edit History C 06-Feb-99 wjr created 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 'h1hydro.inc' include 'h1scs.inc' include 'h1db1.inc' include 'file.fi' c + + + LOCAL COMMON BLOCKS + + + include 'main/main.inc' c + + + LOCAL VARIABLES + + + integer l character line*256 integer isr c + + + FUNCTION DECLARATIONS + + + real setbds C integer linnum, typidx data linnum /0/, typidx /0/ C C open simulation run file call fopenk (lui1, sinfil, 'old') c read subregion information do 200 isr = 1,nsubr typidx = 0 100 if (typidx.eq.51) go to 200 linnum = linnum + 1 read (lui1,'(a)',err=81) 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) c read initial field conditions file am0sid(isr) = line case (2) read(line,*,err=81) nslay(isr) case (3) read(line,*,err=81) (aszlyt(l,isr), l=1,nslay(isr)) c read soil physical properties case (4) read(line,*,err=81) (asfsan(l,isr), l=1,nslay(isr)) case (5) read(line,*,err=81) (asfsil(l,isr), l=1,nslay(isr)) case (6) read(line,*,err=81) (asfcla(l,isr), l=1,nslay(isr)) case (7) read(line,*,err=81) (asvroc(l,isr), l=1,nslay(isr)) case (8) read(line,*,err=81) (asfcs(l,isr), l=1,nslay(isr)) case (9) read(line,*,err=81) (asfms(l,isr), l=1,nslay(isr)) case (10) read(line,*,err=81) (asffs(l,isr), l=1,nslay(isr)) case (11) read(line,*,err=81) (asfvfs(l,isr), l=1,nslay(isr)) case (12) read(line,*,err=81) (asfwdc(l,isr), l=1,nslay(isr)) case (13) read(line,*,err=81) (asdblk(l,isr), l=1,nslay(isr)) C *** debugging write c write(*,*) ' inpsub: ', asdblk(1:7,isr) C *** eodw case (14) read(line,*,err=81) (asdwbd(l,isr), l=1,nslay(isr)) case (15) c aggregate properties read(line,*,err=81) (aslagm(l,isr), l=1,nslay(isr)) case (16) read(line,*,err=81) (as0ags(l,isr), l=1,nslay(isr)) case (17) read(line,*,err=81) (aslagx(l,isr), l=1,nslay(isr)) case (18) read(line,*,err=81) (aslagn(l,isr), l=1,nslay(isr)) case (19) read(line,*,err=81) (asdagd(l,isr), l=1,nslay(isr)) case (20) read(line,*,err=81) (aseags(l,isr), l=1,nslay(isr)) case (21) c read crust properties read(line,*,err=81) aszcr(isr) case (22) read(line,*,err=81) asdcr(isr) case (23) read(line,*,err=81) asecr(isr) case (24) read(line,*,err=81) asfcr(isr) case (25) c read surface properties read(line,*,err=81) asmlos(isr) write(*,*) ' inpsub: asmlos(isr) ', asmlos(isr) case (26) read(line,*,err=81) asflos(isr) case (27) read(line,*,err=81) aslrr(isr) case (28) read(line,*,err=81) asargo(isr) case (29) read(line,*,err=81) aszrgh(isr) case (30) read(line,*,err=81) asxrgs(isr) case (31) read(line,*,err=81) asxrgw(isr) case (32) c read soil hydrologic properties read(line,*,err=81) (ahrwc(l,isr), l=1,nslay(isr)) case (33) read(line,*,err=81) (ahrwcs(l,isr), l=1,nslay(isr)) case (34) read(line,*,err=81) (ahrwcf(l,isr), l=1,nslay(isr)) case (35) read(line,*,err=81) (ahrwcw(l,isr), l=1,nslay(isr)) case (36) read(line,*,err=81) (ahrwc1(l,isr), l=1,nslay(isr)) case (37) read(line,*,err=81) (ah0cb(l,isr), l=1,nslay(isr)) case (38) read(line,*,err=81) (aheaep(l,isr), l=1,nslay(isr)) case (39) read(line,*,err=81) (ahrsk(l,isr), l=1,nslay(isr)) case (40) read(line,*,err=81) ah0cnp(isr) case (41) read(line,*,err=81) ah0cng(isr) case (42) read(line,*,err=81) asfald(isr) c calculate wet albedo from dry asfalw(isr)=asfald(isr)/((1.33**2.)*(1-asfald(isr)) * +asfald(isr)) case (43) c read soil chemical properties read(line,*,err=81) (asfom(l,isr), l=1,nslay(isr)) C C the three vars are set so set settled bulk density do 210 l=1,nslay(isr) asdsbk(l,isr)=setbds(asfcla(l,isr), asfsan(l,isr), * asfom(l,isr)) 210 continue case (44) read(line,*,err=81) (as0ph(l,isr), l=1,nslay(isr)) case (45) read(line,*,err=81) (asfcce(l,isr), l=1,nslay(isr)) c read other soil chemical properties needed by the CROP case (46) read(line,*,err=81) (asfcec(l,isr), l=1,nslay(isr)) case (47) read(line,*,err=81) (asfsmb(l,isr), l=1,nslay(isr)) case (48) read(line,*,err=81) (as0ec(l,isr), l=1,nslay(isr)) case (49) read(line,*,err=81) (asrsar(l,isr), l=1,nslay(isr)) case (50) read(line,*,err=81) (asftan(l,isr), l=1,nslay(isr)) case (51) read(line,*,err=81) (asftap(l,isr), l=1,nslay(isr)) end select goto 100 200 continue close (lui1) C call dmpall('wrk.dmp') return 81 write(*,9001) sinfil, linnum, line 9001 format('Error in file ',a,' on line #',i4,' ',a) stop 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