4a47859e by Roger Marquez

File Handle Fix

-Changed all UPGM file handles to dynamic values. Fixes bug with FORTRAN global file handles being shared among all DLL instances.
1 parent bc9d664f
......@@ -29,6 +29,7 @@ import annotations.Status;
import annotations.Author;
import annotations.Documentation;
import annotations.Keywords;
import com.sun.jna.ptr.IntByReference;
import gov.usda.jcf.annotations.Input;
import gov.usda.jcf.annotations.Description;
......@@ -75,6 +76,10 @@ public class JupgmInitGen {
@Description("Upgm_mgmt.dat file")
@Input public String shootoutfile;
@Description("HRU ID")
@Input
public int hruid;
public nap.Libupgm lib;
public void exec() throws Exception {
......@@ -89,6 +94,7 @@ public class JupgmInitGen {
inptoutfile, inptoutfile.length(),
phenoloutfile, phenoloutfile.length(),
seasonoutfile, seasonoutfile.length(),
shootoutfile, shootoutfile.length());
shootoutfile, shootoutfile.length(),
new IntByReference(hruid));
}
}
......
......@@ -176,6 +176,7 @@ public class Upgm {
Jupgminit.phenoloutfile = outParent.resolve("phenol" + idString + ".out").toString();
Jupgminit.seasonoutfile = outParent.resolve("season" + idString + ".out").toString();
Jupgminit.shootoutfile = outParent.resolve("shoot" + idString + ".out").toString();
Jupgminit.hruid = hruID;
initLock.lock();
try {
......
......@@ -2,6 +2,8 @@ subroutine cdbug(isr,slay)
!
implicit none
!
include 'file.fi'
include 'p1werm.inc'
include 'm1flag.inc'
include 's1layr.inc'
......@@ -84,40 +86,40 @@ call caldatw(cd,cm,cy)
! write weather cligen and windgen variables
if ((cd==tday).and.(cm==tmo).and.(cy==tyr).and.(isr==tisr)) then
write (27,1000) cd,cm,cy,isr
write (cdbugfile,1000) cd,cm,cy,isr
else
write (27,1100) cd,cm,cy,isr
write (cdbugfile,1100) cd,cm,cy,isr
end if
write (27,1200)
write (27,1300) awzdpt,awtdmx,awtdmn,aweirr,awudmx,awudmn,awtdpt,awadir,awhrmx, &
write (cdbugfile,1200)
write (cdbugfile,1300) awzdpt,awtdmx,awtdmn,aweirr,awudmx,awudmn,awtdpt,awadir,awhrmx, &
& awrrh
! write(27,2045) isr
write (27,1400) isr,isr,isr,isr,isr,isr,isr
write (cdbugfile,1400) isr,isr,isr,isr,isr,isr,isr
! admf(isr) is not dimensioned correctly anymore - lew 04/23/99
! just commenting it out for now since it is a debug routine
! write(27,2051) amrslp(isr), acftcv(isr), acrlai(isr), aczrtd(isr),
! & admf(isr), ahfwsf(isr), ac0nam(isr)
write (27,1600) isr,isr,isr,isr
write (27,1700) actdtm(isr),acthucum(isr),acmst(isr),acmrt(isr),ahzeta,ahzetp, &
write (cdbugfile,1600) isr,isr,isr,isr
write (cdbugfile,1700) actdtm(isr),acthucum(isr),acmst(isr),acmrt(isr),ahzeta,ahzetp, &
& ahzpta
! write (27,1800) isr,isr,isr,isr
write (27,1800) isr,isr,isr
!write (27,1900) ahzea,ahzep,ahzptp,actmin(isr),actopt(isr),as0rrk(isr), &
! write (cdbugfile,1800) isr,isr,isr,isr
write (cdbugfile,1800) isr,isr,isr
!write (cdbugfile,1900) ahzea,ahzep,ahzptp,actmin(isr),actopt(isr),as0rrk(isr), &
! & aslrr(isr)
write (27,1900) ahzea,ahzep,ahzptp,actmin(isr),actopt(isr),as0rrk(isr)
write (27,2000)
write (cdbugfile,1900) ahzea,ahzep,ahzptp,actmin(isr),actopt(isr),as0rrk(isr)
write (cdbugfile,2000)
do l = 1,slay
write (27,2100) l,aszlyt(l,isr),ahrsk(l,isr),ahrwc(l,isr),ahrwcs(l,isr), &
write (cdbugfile,2100) l,aszlyt(l,isr),ahrsk(l,isr),ahrwc(l,isr),ahrwcs(l,isr), &
& ahrwca(l,isr),ahrwcf(l,isr),ahrwcw(l,isr),ah0cb(l,isr), &
& aheaep(l,isr),ahtsmx(l,isr),ahtsmn(l,isr)
end do
write (27,2200)
write (cdbugfile,2200)
do l = 1,slay
write (27,2300) l,asfsan(l,isr),asfsil(l,isr),asfcla(l,isr),asfom(l,isr), &
write (cdbugfile,2300) l,asfsan(l,isr),asfsil(l,isr),asfcla(l,isr),asfom(l,isr), &
& asdblk(l,isr),aslagm(l,isr),as0ags(l,isr),aslagn(l,isr), &
& aslagx(l,isr),aseags(l,isr)
end do
......
......@@ -41,6 +41,7 @@ subroutine cinit(bnslay,bszlyt,bszlyd,bsdblk,bsfcce,bsfcec,bsfsmb,bsfom,bsfcla,
!
implicit none
!
include 'file.fi'
include 'p1werm.inc'
include 'p1solar.inc'
include 'm1flag.inc'
......@@ -646,7 +647,7 @@ else
end if
! print out heat average heat unit and days to maturity
if (am0cfl>0) write (60,1100) pdate,hdate,bcthudf,dtm,bctdtm,phu,bcthum
if (am0cfl>0) write (luoinpt,1100) pdate,hdate,bcthudf,dtm,bctdtm,phu,bcthum
! after printing the value, set the global parameter for maximum
! heat units to the new calculated value (this database value is
......
......@@ -90,15 +90,15 @@ if (icli==1) then ! read from cligen data file
!
else ! read in historical data
!debe add reading in climate file name
read (7,*) cliname
read (upgmcli,*) cliname
!
! read monthy average of daily maximum temperature
!
read (7,*) (awtmxav(idx),idx=1,12)
read (upgmcli,*) (awtmxav(idx),idx=1,12)
!
! read monthy average of daily minimum temperature
!
read (7,*) (awtmnav(idx),idx=1,12)
read (upgmcli,*) (awtmnav(idx),idx=1,12)
!
! find yearly average temperature
!
......@@ -116,7 +116,7 @@ else ! read in historical data
!debe i think the above comment should read: "read average monthly
! total precipitation"
!
read (7,*) (awzmpt(idx),idx=1,12)
read (upgmcli,*) (awzmpt(idx),idx=1,12)
!
end if
!
......
......@@ -92,7 +92,7 @@ data dayidx/0/
if (icli==0) then ! read in historical precip, tmax, tmin, and solar radiation
! if ((ccd.eq.29).and.(ccm.eq.2)) then
! dayidx = ccd
! read (7,*) wcd(dayidx),wcm(dayidx),wcy(dayidx),wwzdpt(dayidx),wwtdmx(dayidx), &
! read (upgmcli,*) wcd(dayidx),wcm(dayidx),wcy(dayidx),wwzdpt(dayidx),wwtdmx(dayidx), &
! & wwtdmn(dayidx),wgrad(dayidx)
!
! ccd = 1
......@@ -102,18 +102,18 @@ if (icli==0) then ! read in historical precip, tmax, tmin, and solar radiatio
dayidx = ccd
!
read (7,*) wcd(dayidx),wcm(dayidx),wcy(dayidx),wwzdpt(dayidx),wwtdmx(dayidx), &
read (upgmcli,*) wcd(dayidx),wcm(dayidx),wcy(dayidx),wwzdpt(dayidx),wwtdmx(dayidx), &
& wwtdmn(dayidx),wgrad(dayidx)
! print*, ' in if statement checking for leap year'
if ((wcd(dayidx)==29).and.(wcm(dayidx)==2)) read (7,*) wcd(dayidx),wcm(dayidx)&
if ((wcd(dayidx)==29).and.(wcm(dayidx)==2)) read (upgmcli,*) wcd(dayidx),wcm(dayidx)&
& ,wcy(dayidx),wwzdpt(dayidx),wwtdmx(dayidx),wwtdmn(dayidx),wgrad(dayidx)
! if ((wcm(dayidx).lt.4).and.(wcy(dayidx).eq.2)) then
! print*, 'day= ', wcd(dayidx), 'month= ', wcm(dayidx), 'tmax= ', wwtdmx(dayidx)
! endif
!
! read (7,*) wcd(dayidx),wcm(dayidx),wcy(dayidx), &
! read (upgmcli,*) wcd(dayidx),wcm(dayidx),wcy(dayidx), &
! & wwzdpt(dayidx),wwdurpt(dayidx),wwpeaktpt(dayidx) &
! & ,wwpeakipt(dayidx),wwtdmx(dayidx),wwtdmn(dayidx) &
! & ,wgrad(dayidx),dummy,dummy,wwtdpt(dayidx)
......
......@@ -3,169 +3,192 @@
!$Revision: 1.25 $
!$Source: /weru/cvs/weps/weps.src/inc/file.fi,v $
!
integer lui1
parameter (lui1=141)
!
integer lui2
parameter (lui2=102)
!
integer lui3
parameter (lui3=103)
!
integer lui4
parameter (lui4=104)
!
integer lui5
parameter (lui5=105)
!
integer luicli
parameter (luicli=146)
!
integer luiwin
parameter (luiwin=147)
!
integer luiwsd
parameter (luiwsd=148)
! Roger Marquez - > these files are not used as far as I can tell.
! integer lui1
! parameter (lui1=141)
!!
! integer lui2
! parameter (lui2=102)
!!
! integer lui3
! parameter (lui3=103)
!!
! integer lui4
! parameter (lui4=104)
!!
! integer lui5
! parameter (lui5=105)
!Logical Unit number for "mandate.man" (MCREW management) file
integer luimandate
parameter (luimandate=149)
!
integer luo1
parameter (luo1=111)
!
integer luo2
parameter (luo2=112)
!
integer luo3
parameter (luo3=113)
!
integer luo4
parameter (luo4=114)
!
integer luo5
parameter (luo5=115)
!
integer luolog
parameter (luolog=116)
!
integer luodbg
parameter (luodbg=117)
!
integer luoplt
parameter (luoplt=118)
integer luicli
! parameter (luicli=146)
!
! ! Roger Marquez - > not used as far as I can tell.
! integer luiwin
! parameter (luiwin=147)
!!
! integer luiwsd
! parameter (luiwsd=148)
!
! !Logical Unit number for "mandate.man" (MCREW management) file
! integer luimandate
! parameter (luimandate=149)
!!
! integer luo1
! parameter (luo1=111)
!!
! integer luo2
! parameter (luo2=112)
!!
! integer luo3
! parameter (luo3=113)
!!
! integer luo4
! parameter (luo4=114)
!!
! integer luo5
! parameter (luo5=115)
!!
! integer luolog
! parameter (luolog=116)
!!
! integer luodbg
! parameter (luodbg=117)
!!
! integer luoplt
! parameter (luoplt=118)
! these are for debugging the crop and decomp biomass variables - LEW
integer luocrop
parameter (luocrop=17)
! parameter (luocrop=17)
integer luoshoot
parameter (luoshoot=62)
! parameter (luoshoot=62)
integer luoseason
parameter (luoseason=59)
! parameter (luoseason=59)
integer luoinpt
parameter (luoinpt=60)
! parameter (luoinpt=60)
integer luoallcrop
parameter (luoallcrop=61)
!parameter (luoallcrop=61)
! debe 090408 added for emergence output
integer luoemerge
parameter (luoemerge=63)
! parameter (luoemerge=63)
!
! debe 091108 added for phenology output
integer luophenol
parameter (luophenol=64)
! parameter (luophenol=64)
!
! debe 033111 added for canopy height output
integer luocanopyht
parameter (luocanopyht=65)
!
integer luod_above !Above ground decomp output
parameter (luod_above=18)
!
integer luod_below !Below ground decomp output
parameter (luod_below=19)
! parameter (luocanopyht=65)
! RMarquez - Added these files as input file handles to be initialized by "init" subroutines.
integer cropxml
integer upgmmgt
integer upgmstress
integer upgmcli
integer upgmcrop
integer upgmco2
integer upgmco2atmos
! output for debugging
integer cdbugfile
common /filehandles/ cropxml, luicli, upgmmgt, upgmstress, & !Input file handles
& upgmcli, upgmcrop, upgmco2, upgmco2atmos, & !Input file handles
& luocrop, luoshoot, luoseason, luoinpt, luoemerge, luophenol, & !Output file handles
& luocanopyht, luoallcrop, cdbugfile
!
!Roger Marquez - > not used as far as I can tell.
! integer luod_above !Above ground decomp output
! parameter (luod_above=18)
!!
! integer luod_below !Below ground decomp output
! parameter (luod_below=19)
!!
! integer luocrp1
! parameter (luocrp1=121)
!!
! integer luodec1
! parameter (luodec1=122)
!!
! integer luodec2
! parameter (luodec2=123)
!!
! integer luodec3
! parameter (luodec3=124)
!!
! integer luobio1
! parameter (luobio1=125)
!
! ! logical unit number for soil conditioning index out files
! integer luosci
! parameter (luosci=153)
! integer luostir
! parameter (luostir=154)
!
!! these are for debugging the hydrology variables
!
! integer luohydro
! parameter (luohydro=151)
!
! integer luohlayers
! parameter (luohlayers=152)
!
! integer luowater
! parameter (luowater=12)
! new output units for general information
! integer luoharvest_si
! parameter (luoharvest_si=126)
! integer luoharvest_en
! parameter (luoharvest_en=127)
!
integer luocrp1
parameter (luocrp1=121)
! integer luohydrobal
! parameter (luohydrobal=129)
!
integer luodec1
parameter (luodec1=122)
!! new output unit for calibration information
! integer luoharvest_calib
! parameter (luoharvest_calib=130)
!
integer luodec2
parameter (luodec2=123)
!! new output unit for GUI required calibration information
! integer luoharvest_calib_parm
! parameter (luoharvest_calib_parm=131)
!
integer luodec3
parameter (luodec3=124)
! !Logical Unit number for "gui1_data.out" file
! integer luogui1
! parameter (luogui1=52)
!
integer luobio1
parameter (luobio1=125)
! logical unit number for soil conditioning index out files
integer luosci
parameter (luosci=153)
integer luostir
parameter (luostir=154)
! these are for debugging the hydrology variables
integer luohydro
parameter (luohydro=151)
integer luohlayers
parameter (luohlayers=152)
integer luowater
parameter (luowater=12)
! new output units for general information
integer luoharvest_si
parameter (luoharvest_si=126)
integer luoharvest_en
parameter (luoharvest_en=127)
integer luohydrobal
parameter (luohydrobal=129)
! new output unit for calibration information
integer luoharvest_calib
parameter (luoharvest_calib=130)
! new output unit for GUI required calibration information
integer luoharvest_calib_parm
parameter (luoharvest_calib_parm=131)
!Logical Unit number for "gui1_data.out" file
integer luogui1
parameter (luogui1=52)
!Logical Unit number for "mandate.out" file
integer luomandate
parameter (luomandate=81)
! !Logical Unit number for "mandate.out" file
! integer luomandate
! parameter (luomandate=81)
! New output units for erosion submodel
integer luo_egrd ! For daily grid output
parameter (luo_egrd=201)
integer luo_erod ! For daily erosion summary output
parameter (luo_erod=202)
integer luo_emit ! For subdaily erosion summary output
parameter (luo_emit=203)
integer luo_sgrd ! For subdaily grid output
parameter (luo_sgrd=204)
! Logical Unit number for "soilsurf.out" file
integer luosoilsurf
parameter (luosoilsurf=160)
! Logical Unit number for "soilsurf.out" file
integer luosoillay
parameter (luosoillay=161)
!
!integer luo_egrd ! For daily grid output
!parameter (luo_egrd=201)
!integer luo_erod ! For daily erosion summary output
!parameter (luo_erod=202)
!integer luo_emit ! For subdaily erosion summary output
!parameter (luo_emit=203)
!integer luo_sgrd ! For subdaily grid output
!parameter (luo_sgrd=204)
!
!! Logical Unit number for "soilsurf.out" file
!integer luosoilsurf
!parameter (luosoilsurf=160)
!
!! Logical Unit number for "soilsurf.out" file
!integer luosoillay
!parameter (luosoillay=161)
! Note: One must check main/openfils.for to ensure unit numbers are unique.
! Not all files are using logical unit numbers yet.
......
......@@ -33,7 +33,7 @@ subroutine jupgminit(cropxmlfile,cropxmlfile_len,upgmcropfile, &
& canopyhtoutfile_len,cdbugoutfile,cdbugoutfile_len,cropoutfile, &
& cropoutfile_len,emergeoutfile,emergeoutfile_len,inptoutfile, &
& inptoutfile_len,phenoloutfile,phenoloutfile_len,seasonoutfile, &
& seasonoutfile_len,shootoutfile,shootoutfile_len)
& seasonoutfile_len,shootoutfile,shootoutfile_len, hruID)
use, intrinsic :: ISO_C_BINDING
implicit none
......@@ -122,11 +122,35 @@ subroutine jupgminit(cropxmlfile,cropxmlfile_len,upgmcropfile, &
character(kind=C_CHAR, len=shootoutfile_len) :: shootoutfile
integer(C_INT), value, intent(in) :: shootoutfile_len
! @Description("HRU ID")
! @In
integer(C_INT), value, intent(in) :: hruID
integer :: phenolfilehandle
!
! Method
!
integer :: julday
cropxml = 0 + hruID
upgmmgt = 10000 + hruID
upgmstress = 20000 + hruID
upgmcli = 30000 + hruID
upgmcrop = 40000 + hruID
upgmco2 = 50000 + hruID
upgmco2atmos = 60000 + hruID
luicli = 70000 + hruID
luocrop = 80000 + hruID
luoshoot = 90000 + hruID
luoseason = 100000 + hruID
luoinpt = 110000 + hruID
luoemerge = 120000 + hruID
luophenol = 130000 + hruID
luocanopyht = 140000 + hruID
luoallcrop = 150000 + hruID
cdbugfile = 160000 + hruID
row = 4
i = 0
......@@ -142,18 +166,19 @@ subroutine jupgminit(cropxmlfile,cropxmlfile_len,upgmcropfile, &
!
! open required input files
!
call fopenk(1,cropxmlfile,'old') ! open weps crop parameter file
call fopenk(cropxml,cropxmlfile,'old') ! open weps crop parameter file
! call fopenk(luicli,'cligen.cli','old') ! open cligen climate file
call fopenk(3,upgmmgmtfile,'old') ! open management file
!call fopenk(4,'upgm_stress.dat','old') ! open water stress file
!call fopenk(7,'upgm_cli.dat','old') ! open historical climate file
call fopenk(8,upgmcropfile,'old') ! open upgm crop file
call fopenk(upgmmgt,upgmmgmtfile,'old') ! open management file
!call fopenk(upgmstress,'upgm_stress.dat','old') ! open water stress file
!call fopenk(upgmcli,'upgm_cli.dat','old') ! open historical climate file
call fopenk(upgmcrop,upgmcropfile,'old') ! open upgm crop file
!
!debe added these variables to be initialized. added canopyflg for determining
! which method of calculating canopy height will be used. added dayhtinc to get
! the daily increase in height when using the phenologymms method of calculating
! canopy height.
call cropinit(1,aepa,aifs,antes,antss,blstrs,boots,browns,callgdd,canopyflg, &
call cropinit(1,aepa,aifs,antes,antss,blstrs,boots,browns,callgdd, &
& canopyflg, &
& cliname,cots,cropname,dayhtinc,dents,doughs,drs,dummy1,dummy2, &
& ears,ecanht,egdd,emrgflg,ems,endlgs,epods,ergdd,eseeds,first7,fps,&
& fullbs,gddtbg,germgdd,germs,ggdd,gmethod,gpds,growth_stress, &
......@@ -264,29 +289,29 @@ subroutine jupgminit(cropxmlfile,cropxmlfile_len,upgmcropfile, &
!
! read in plant parameters from cropxml.dat
!
read (1,' (a80) ') ac0nam(1)
read (1,*) acdpop(1),acdmaxshoot(1),acbaflg(1),acytgt(1),acbaf(1),acyraf(1), &
read (cropxml,' (a80) ') ac0nam(1)
read (cropxml,*) acdpop(1),acdmaxshoot(1),acbaflg(1),acytgt(1),acbaf(1),acyraf(1), &
& achyfg(1),acynmu(1)
read (1,*) acywct(1),acycon(1),ac0idc(1),acgrf(1),ac0ck(1),acehu0(1),aczmxc(1), &
read (cropxml,*) acywct(1),acycon(1),ac0idc(1),acgrf(1),ac0ck(1),acehu0(1),aczmxc(1), &
& ac0growdepth(1)
read (1,*) aczmrt(1),actmin(1),actopt(1),acthudf(1),actdtm(1),acthum(1), &
read (cropxml,*) aczmrt(1),actmin(1),actopt(1),acthudf(1),actdtm(1),acthum(1), &
& ac0fd1(1,1),ac0fd2(1,1)
read (1,*) ac0fd1(2,1),ac0fd2(2,1),actverndel(1),ac0bceff(1),ac0alf(1),ac0blf(1)&
read (cropxml,*) ac0fd1(2,1),ac0fd2(2,1),actverndel(1),ac0bceff(1),ac0alf(1),ac0blf(1)&
& ,ac0clf(1),ac0dlf(1)
read (1,*) ac0arp(1),ac0brp(1),ac0crp(1),ac0drp(1),ac0aht(1),ac0bht(1),ac0ssa(1)&
read (cropxml,*) ac0arp(1),ac0brp(1),ac0crp(1),ac0drp(1),ac0aht(1),ac0bht(1),ac0ssa(1)&
& ,ac0ssb(1)
read (1,*) ac0sla(1),ac0hue(1),ac0transf(1),ac0diammax(1),ac0storeinit(1), &
read (cropxml,*) ac0sla(1),ac0hue(1),ac0transf(1),ac0diammax(1),ac0storeinit(1), &
& ac0shoot(1),acfleafstem(1),acfshoot(1)
read (1,*) acfleaf2stor(1),acfstem2stor(1),acfstor2stor(1),acrbc(1), &
read (cropxml,*) acfleaf2stor(1),acfstem2stor(1),acfstor2stor(1),acrbc(1), &
& acdkrate(1,1),acdkrate(2,1),acdkrate(3,1),acdkrate(4,1)
read (1,*) acdkrate(5,1),acxstm(1),acddsthrsh(1),accovfact(1),acresevapa(1), &
read (cropxml,*) acdkrate(5,1),acxstm(1),acddsthrsh(1),accovfact(1),acresevapa(1), &
& acresevapb(1),acyld_coef(1),acresid_int(1)
!
!read management information from upgm_mgmt.dat. currently it includes
! starting and ending day, month, and year for planting and harvest.
!
read (3,*) sd,sm,sy,ed,em,ey
read (3,*) pd,pm,py,hd,hm,hy
read (upgmmgt,*) sd,sm,sy,ed,em,ey
read (upgmmgt,*) pd,pm,py,hd,hm,hy
start_jday = julday(sd,sm,sy)
......@@ -305,7 +330,7 @@ subroutine jupgminit(cropxmlfile,cropxmlfile_len,upgmcropfile, &
!read in canopyflg and emergence data for the crop from upgm_crop.dat.
!debe added reading in phenolflg from upgm_crop.dat
read (8,*) canopyflg,emrgflg,phenolflg,seedbed
read (upgmcrop,*) canopyflg,emrgflg,phenolflg,seedbed
if (seedbed=='Optimum') then
seedsw = 1 !set seedsw = to a real number. changed back to integer 2/23/11
else if (seedbed=='Medium') then
......@@ -332,15 +357,15 @@ subroutine jupgminit(cropxmlfile,cropxmlfile_len,upgmcropfile, &
!
! put these values into 5 one dimensional arrays.
do i = 1,row
read (8,*) swtype !swtype = soil moisture condition.
read (upgmcrop,*) swtype !swtype = soil moisture condition.
soilwat(i) = swtype
read (8,*) wlow !wlow = lower range of soil moisture
read (upgmcrop,*) wlow !wlow = lower range of soil moisture
wfpslo(i) = wlow
read (8,*) wup !wup = upper range of soil moisture
read (upgmcrop,*) wup !wup = upper range of soil moisture
wfpsup(i) = wup
read (8,*) germd !germd = gdd's for germination at soil moisture
read (upgmcrop,*) germd !germd = gdd's for germination at soil moisture
germgdd(i) = germd
read (8,*) elrate !elrate = elongation for emergence
read (upgmcrop,*) elrate !elrate = elongation for emergence
ergdd(i) = elrate
end do
......@@ -352,29 +377,29 @@ subroutine jupgminit(cropxmlfile,cropxmlfile_len,upgmcropfile, &
!
!the following is read in whether leaf number or gdd is used.
! read in phenology parameters and 4 temperature values from upgm_crop.dat.
read (8,*) pchron
read (8,*) tbase
read (8,*) toptlo
read (8,*) toptup
read (8,*) tupper
read (upgmcrop,*) pchron
read (upgmcrop,*) tbase
read (upgmcrop,*) toptlo
read (upgmcrop,*) toptup
read (upgmcrop,*) tupper
! read in method of calculating gdd (gmethod) from upgm_crop.dat
read (8,*) gmethod
read (upgmcrop,*) gmethod
!debe added reading in maxht value for canopy height subroutine.
!debe added ecanht for height in phase 1 of canopy height.
read (8,*) maxht,ecanht
read (upgmcrop,*) maxht,ecanht
print *,'maxht = ',maxht,'ecanht = ',ecanht
!debe added reading in growth_stress to set which kind of stress to be used:
! 0=no stress, 1=water stress only, 2=temp stress only,
! 3=min of water and temp stress.
read (8,*) growth_stress
read (upgmcrop,*) growth_stress
print *,'growth_stress = ',growth_stress
!debe changed dimensions of dummy1 and dummy2 to allow both non-stresseed
! and stressed values to be read in.
do i = 1,30
read (8,*) dummy1(i),dummy2(i)
read (upgmcrop,*) dummy1(i),dummy2(i)
if (dummy1(i)=='ln'.or.dummy1(i)=='ls') dummy2(i) = dummy2(i)*pchron
end do
......@@ -406,19 +431,19 @@ subroutine jupgminit(cropxmlfile,cropxmlfile_len,upgmcropfile, &
co2y(10) = 1.5
if (am0cfl>0) then
call fopenk(17,cropoutfile,'unknown') ! daily crop output of most state variables
call fopenk(59,seasonoutfile,'unknown') ! seasonal summaries of yield and biomass
call fopenk(60,inptoutfile,'unknown') ! echo crop input data
call fopenk(62,shootoutfile,'unknown') ! crop shoot output
call fopenk(63,emergeoutfile,'unknown') ! debe added for emergence output
call fopenk(64,phenoloutfile,'unknown') ! debe added for phenology output
call fopenk(65,canopyhtoutfile,'unknown')
call fopenk(luocrop,cropoutfile,'unknown') ! daily crop output of most state variables
call fopenk(luoseason,seasonoutfile,'unknown') ! seasonal summaries of yield and biomass
call fopenk(luoinpt,inptoutfile,'unknown') ! echo crop input data
call fopenk(luoshoot,shootoutfile,'unknown') ! crop shoot output
call fopenk(luoemerge,emergeoutfile,'unknown') ! debe added for emergence output
call fopenk(luophenol,phenoloutfile,'unknown') ! debe added for phenology output
call fopenk(luocanopyht,canopyhtoutfile,'unknown')
!debe added for canopy height output
call cpout ! print headings for crop output files
end if
!
if (am0cfl>1) call fopenk(61,'allcrop.prn','unknown') ! main crop debug output file
if (am0cdb>0) call fopenk(27,cdbugoutfile,'unknown') ! crop submodel debug output file
if (am0cfl>1) call fopenk(luoallcrop,'allcrop.prn','unknown') ! main crop debug output file
if (am0cdb>0) call fopenk(cdbugfile,cdbugoutfile,'unknown') ! crop submodel debug output file
!close input files
close(1)
......
Styling with Markdown is supported
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!