diff --git a/CMakeLists.txt b/CMakeLists.txt index df03f0fe6..f895cc92c 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -632,6 +632,7 @@ set( "Soil/SoilWater/WBAL.for" "Soil/SoilWater/WBSUBS.for" "SPAM/ESR_SoilEvap.for" + "SPAM/ESR_SoilEvap_mod.for" "SPAM/ETPHOT.for" "SPAM/ETPHR.for" "SPAM/OPETPHOT.for" diff --git a/CSM_Main/LAND.for b/CSM_Main/LAND.for index 948fbbc91..b1aaaa633 100644 --- a/CSM_Main/LAND.for +++ b/CSM_Main/LAND.for @@ -64,7 +64,7 @@ C Soil Processes Module Variables C----------------------------------------------------------------------- REAL SNOW, WINF REAL, DIMENSION(NL) :: NH4_plant, NO3_plant, SPi_Avail, SKi_Avail - REAL, DIMENSION(NL) :: ST, UPPM, SW, SWDELTS, UPFLOW + REAL, DIMENSION(NL) :: ST, UPPM, SW, SWDELTS, UPFLOW, ES_LYR TYPE (SoilType) SOILPROP !type defined in ModuleDefs TYPE (FloodWatType) FLOODWAT TYPE (FloodNType) FloodN @@ -166,7 +166,7 @@ C----------------------------------------------------------------------- C Read initial soil data C----------------------------------------------------------------------- CALL SOIL(CONTROL, ISWITCH, - & ES, FERTDATA, FracRts, HARVRES, IRRAMT, !Input + & ES, ES_LYR, FERTDATA, FracRts, HARVRES, IRRAMT, !Input & KTRANS, KUptake, OMAData, PUptake, RLV, !Input & SENESCE, ST, SWDELTX,TILLVALS, UNH4, UNO3, !Input & WEATHER, XHLAI, !Input @@ -183,7 +183,7 @@ C----------------------------------------------------------------------- & PSTRES1, PORMIN, RLV, RWUMX, SOILPROP, SW, !Input & SWDELTS, UH2O, WEATHER, WINF, XHLAI, XLAI, !Input & FLOODWAT, SWDELTU, !I/O - & EO, EOP, EOS, EP, ES, RWU, SRFTEMP, ST, !Output + & EO, EOP, EOS, EP, ES, ES_LYR, RWU, SRFTEMP, ST, !Output & SWDELTX, TRWU, TRWUP, UPFLOW) !Output C----------------------------------------------------------------------- @@ -236,7 +236,7 @@ C----------------------------------------------------------------------- C Seasonal initialization for soil processes C----------------------------------------------------------------------- CALL SOIL(CONTROL, ISWITCH, - & ES, FERTDATA, FracRts, HARVRES, IRRAMT, !Input + & ES, ES_LYR, FERTDATA, FracRts, HARVRES, IRRAMT, !Input & KTRANS, KUptake, OMAData, PUptake, RLV, !Input & SENESCE, ST, SWDELTX,TILLVALS, UNH4, UNO3, !Input & WEATHER, XHLAI, !Input @@ -255,7 +255,7 @@ C----------------------------------------------------------------------- & PSTRES1, PORMIN, RLV, RWUMX, SOILPROP, SW, !Input & SWDELTS, UH2O, WEATHER, WINF, XHLAI, XLAI, !Input & FLOODWAT, SWDELTU, !I/O - & EO, EOP, EOS, EP, ES, RWU, SRFTEMP, ST, !Output + & EO, EOP, EOS, EP, ES, ES_LYR, RWU, SRFTEMP, ST, !Output & SWDELTX, TRWU, TRWUP, UPFLOW) !Output C----------------------------------------------------------------------- @@ -308,7 +308,7 @@ C Call Soil processes module to determine today's rates of C change of soil properties. C----------------------------------------------------------------------- CALL SOIL(CONTROL, ISWITCH, - & ES, FERTDATA, FracRts, HARVRES, IRRAMT, !Input + & ES, ES_LYR, FERTDATA, FracRts, HARVRES, IRRAMT, !Input & KTRANS, KUptake, OMAData, PUptake, RLV, !Input & SENESCE, ST, SWDELTX,TILLVALS, UNH4, UNO3, !Input & WEATHER, XHLAI, !Input @@ -326,7 +326,7 @@ C----------------------------------------------------------------------- & PSTRES1, PORMIN, RLV, RWUMX, SOILPROP, SW, !Input & SWDELTS, UH2O, WEATHER, WINF, XHLAI, XLAI, !Input & FLOODWAT, SWDELTU, !I/O - & EO, EOP, EOS, EP, ES, RWU, SRFTEMP, ST, !Output + & EO, EOP, EOS, EP, ES, ES_LYR, RWU, SRFTEMP, ST, !Output & SWDELTX, TRWU, TRWUP, UPFLOW) !Output C----------------------------------------------------------------------- @@ -356,7 +356,7 @@ C*********************************************************************** C Integrate soil state variables C----------------------------------------------------------------------- CALL SOIL(CONTROL, ISWITCH, - & ES, FERTDATA, FracRts, HARVRES, IRRAMT, !Input + & ES, ES_LYR, FERTDATA, FracRts, HARVRES, IRRAMT, !Input & KTRANS, KUptake, OMAData, PUptake, RLV, !Input & SENESCE, ST, SWDELTX,TILLVALS, UNH4, UNO3, !Input & WEATHER, XHLAI, !Input @@ -373,7 +373,7 @@ C----------------------------------------------------------------------- & PSTRES1, PORMIN, RLV, RWUMX, SOILPROP, SW, !Input & SWDELTS, UH2O, WEATHER, WINF, XHLAI, XLAI, !Input & FLOODWAT, SWDELTU, !I/O - & EO, EOP, EOS, EP, ES, RWU, SRFTEMP, ST, !Output + & EO, EOP, EOS, EP, ES, ES_LYR, RWU, SRFTEMP, ST, !Output & SWDELTX, TRWU, TRWUP, UPFLOW) !Output C----------------------------------------------------------------------- @@ -413,7 +413,7 @@ C*********************************************************************** CALL WEATHR(CONTROL, ISWITCH, WEATHER, YREND) CALL SOIL(CONTROL, ISWITCH, - & ES, FERTDATA, FracRts, HARVRES, IRRAMT, !Input + & ES, ES_LYR, FERTDATA, FracRts, HARVRES, IRRAMT, !Input & KTRANS, KUptake, OMAData, PUptake, RLV, !Input & SENESCE, ST, SWDELTX,TILLVALS, UNH4, UNO3, !Input & WEATHER, XHLAI, !Input @@ -427,7 +427,7 @@ C*********************************************************************** & PSTRES1, PORMIN, RLV, RWUMX, SOILPROP, SW, !Input & SWDELTS, UH2O, WEATHER, WINF, XHLAI, XLAI, !Input & FLOODWAT, SWDELTU, !I/O - & EO, EOP, EOS, EP, ES, RWU, SRFTEMP, ST, !Output + & EO, EOP, EOS, EP, ES, ES_LYR, RWU, SRFTEMP, ST, !Output & SWDELTX, TRWU, TRWUP, UPFLOW) !Output C----------------------------------------------------------------------- @@ -463,7 +463,7 @@ C Call WEATHER module to close current weather file C Print seasonal summaries and close files. CALL SOIL(CONTROL, ISWITCH, - & ES, FERTDATA, FracRts, HARVRES, IRRAMT, !Input + & ES, ES_LYR, FERTDATA, FracRts, HARVRES, IRRAMT, !Input & KTRANS, KUptake, OMAData, PUptake, RLV, !Input & SENESCE, ST, SWDELTX,TILLVALS, UNH4, UNO3, !Input & WEATHER, XHLAI, !Input @@ -477,7 +477,7 @@ C Print seasonal summaries and close files. & PSTRES1, PORMIN, RLV, RWUMX, SOILPROP, SW, !Input & SWDELTS, UH2O, WEATHER, WINF, XHLAI, XLAI, !Input & FLOODWAT, SWDELTU, !I/O - & EO, EOP, EOS, EP, ES, RWU, SRFTEMP, ST, !Output + & EO, EOP, EOS, EP, ES, ES_LYR, RWU, SRFTEMP, ST, !Output & SWDELTX, TRWU, TRWUP, UPFLOW) !Output CALL PLANT(CONTROL, ISWITCH, @@ -538,7 +538,7 @@ C End of Run C*********************************************************************** ELSE IF (DYNAMIC .EQ. ENDRUN) THEN CALL SOIL(CONTROL, ISWITCH, - & ES, FERTDATA, FracRts, HARVRES, IRRAMT, !Input + & ES, ES_LYR, FERTDATA, FracRts, HARVRES, IRRAMT, !Input & KTRANS, KUptake, OMAData, PUptake, RLV, !Input & SENESCE, ST, SWDELTX,TILLVALS, UNH4, UNO3, !Input & WEATHER, XHLAI, !Input diff --git a/InputModule/IPSIM.for b/InputModule/IPSIM.for index 52e19c6d7..dc8e37bc2 100644 --- a/InputModule/IPSIM.for +++ b/InputModule/IPSIM.for @@ -16,6 +16,8 @@ C 02/21/2006 GH Removed crop model selection ! 05/07/2020 FO Added check for SimLevel to set YRSIM using YRPLT ! 93/22/2022 GH Fix forecast issue ! 07/30/2023 FO Initialized ATMOW and ATTP. +! 02/07/2025 CHP Move all codes checking after the call to External_SimControls +! so that we can do this once in the code instead of twice. C----------------------------------------------------------------------- C INPUT : LUNEXP,FILEX,LNSIM C @@ -50,7 +52,8 @@ C======================================================================= USE CsvOutput IMPLICIT NONE EXTERNAL ERROR, FIND, IGNORE, UPCASE, WARNING, IGNORE2, Y4K_DOY, - & YR_DOY, MODEL_NAME, FILL_ISWITCH, DEFAULT_SIMCONTROLS, GET_CROPD + & YR_DOY, MODEL_NAME, FILL_ISWITCH, External_SimControls, + & GET_CROPD SAVE INCLUDE 'COMSWI.blk' @@ -60,6 +63,7 @@ C======================================================================= CHARACTER*5 NEND,NCODE,IOFF,IAME, TEXT CHARACTER*6 ERRKEY,FINDCH CHARACTER*8 MODEL, MODELARG, CRMODEL, TRY_MODEL, Try_MODELARG + CHARACTER*8 CTRMODEL CHARACTER*12 FILEX CHARACTER*16 CROPD CHARACTER*25 TITSIM @@ -224,34 +228,6 @@ C ISWTIL = UPCASE(ISWTIL) ICO2 = UPCASE(ICO2) - SELECT CASE (CROP) - CASE ('BN','SB','PN','PE','CH','PP','GY', - & 'VB','CP','CB','FB','GB','LT','AL', - & 'CV','BG') -! Do nothing -- these crops fix N and can have Y or N - CASE DEFAULT; ISWSYM = 'N' !other crops don't have a choice - END SELECT -! ENDIF - IF (ISWCHE .EQ. ' ') THEN - ISWCHE = 'N' - ENDIF - IF (ISWTIL .EQ. ' ') THEN - ISWTIL = 'N' - ENDIF - IF (ISWWAT .EQ. 'N') THEN - ISWNIT = 'N' - ISWPHO = 'N' -! ISWCHE = 'N' - ENDIF - - IF (INDEX('FNQS',RNMODE) > 0) THEN -! For sequence, seasonal runs, default CO2 uses static value - IF (INDEX ('WMD', ICO2) < 1) ICO2 = 'D' - ELSE -! For experimental runs, default CO2 uses measured values - IF (INDEX ('WMD', ICO2) < 1) ICO2 = 'M' - ENDIF - ! ============================================================== C Read THIRD line of simulation control - METHODS C @@ -272,67 +248,6 @@ C METMP = UPCASE(METMP) MEGHG = UPCASE(MEGHG) - IF (INDEX('PG',MESOM) .EQ. 0) THEN - MESOM = 'G' - ENDIF - - IF (INDEX('G',MESOM) > 0 .AND. - & INDEX('FQ',RNMODE) > 0 .AND. - & INDEX('N',MEINF) == 0) THEN - MEINF = 'N' - IF (.NOT. MulchWarn) THEN - MSG(1)= - & "Long-term simulation of surface residues may not be accurate" - MSG(2)= - & "when using Godwin soil organic matter module. The effects of" - MSG(3)= - & "a surface mulch layer on runoff and evaporation will " // - & "not be modeled." - MSG(4)= - & "Simulation Options/Methods/Infiltration = 'No mulch effects'" - MSG(5)= - & "You may want to consider using the Parton (CENTURY) method of" - MSG(6)= "modeling soil organic matter." - CALL WARNING(6,ERRKEY,MSG) - MulchWarn = .TRUE. - ENDIF - ENDIF - -! ** DEFAULT MESOL = 2 ** 3/26/2007 -! MESOL = '1' Original soil layer distribution. Calls LYRSET. -! MESOL = '2' New soil layer distribution. Calls LYRSET2. -! MESOL = '3' User specified soil layer distribution. Calls LYRSET3. - IF (INDEX('123',MESOL) < 1) THEN - MESOL = '2' - ENDIF - -! 3/27/2016 chp Default soil temperature method is EPIC -! 7/21/2016 chp Default soil temperature method is DSSAT, per GH -! 5/04/2023 FO Default ST method is TMA(1) = TAVG (BK changes) - IF (INDEX('EDR',METMP) < 1) METMP = 'D' -! METMP = 'D' - default DSSAT (improved Kimball) soil temperature -! METMP = 'R' - previous DSSAT default method (Ritchie) -! METMP = 'E' - EPIC soil temperature routine - -! Default greenhouse gas method is DSSAT - IF (INDEX('01',MEGHG) < 1) MEGHG = '0' - - SELECT CASE(MESEV) - CASE('R','r'); MESEV = 'R' - CASE('s','S'); MESEV = 'S' - CASE DEFAULT; MESEV = 'R' !Default method Ritchie - END SELECT - - IF (MEEVP == 'Z' .AND. MEPHO /= 'L') CALL ERROR(ERRKEY,3,' ',0) - - IF (MEHYD .EQ. ' ') THEN - MEHYD = 'R' - ENDIF - - IF (NSWITCH .LE. 0 .AND. ISWNIT .EQ. 'Y') THEN - NSWITCH = 1 - ENDIF -C ! ============================================================== C Read FOURTH line of simulation control - MANAGEMENT C @@ -346,58 +261,6 @@ C IRESI = UPCASE(IRESI) IHARI = UPCASE(IHARI) -C TF, FO & DP - 2022-07-12 - AutomaticMOW Switch -! 2023-07-30 FO Initialized ATMOW and ATTP. -! W - AutoMOW days frequency -! X - AutoMOW GDD -! Y - SmartMOW days frequency -! Z - SmartMOW GDD - ISWITCH%ATMOW = .FALSE. - ISWITCH%ATTP = ' ' - IF(IHARI .EQ. 'W') THEN - ISWITCH%ATMOW = .TRUE. - ISWITCH%ATTP = 'W' - ELSEIF(IHARI .EQ. 'X') THEN - ISWITCH%ATMOW = .TRUE. - ISWITCH%ATTP = 'X' - ELSEIF(IHARI .EQ. 'Y') THEN - ISWITCH%ATMOW = .TRUE. - ISWITCH%ATTP = 'Y' - ELSEIF(IHARI .EQ. 'Z') THEN - ISWITCH%ATMOW = .TRUE. - ISWITCH%ATTP = 'Z' - ELSE - ISWITCH%ATMOW = .FALSE. - ENDIF - - IF ((INDEX('CSPT',CROP)) .GT. 0) THEN - IF (IHARI .EQ. 'A') THEN - WRITE(MSG(1),'("Automatic harvest option ", - & "is not valid for crop type: ",A2)') CROP - CALL WARNING(1, ERRKEY, MSG) - CALL ERROR (ERRKEY,4,FILEX,LINEXP) - ENDIF - ENDIF - - IF ((INDEX('CS',CROP)) .GT. 0) THEN - IF (IHARI .EQ. 'M') THEN - WRITE(MSG(1),'("Harvest at maturity option is ", - & "not valid for crop type: ",A2)') CROP - CALL WARNING(1, ERRKEY, MSG) - CALL ERROR ('IPSIM ',11,FILEX,LINEXP) - ENDIF - ENDIF - - IF ((INDEX('PT',CROP)) .GT. 0) THEN - IF (IPLTI .EQ. 'A') THEN - WRITE(MSG(1),'("Automatic planting option is ", - & "not valid for crop type: ",A2)') CROP - CALL WARNING(1, ERRKEY, MSG) - CALL ERROR (ERRKEY,5,FILEX,LINEXP) - ENDIF - ENDIF - -C ! ============================================================== C Read FIFTH line of simulation control - OUTPUTS C @@ -417,68 +280,9 @@ C IDETN = UPCASE(IDETN) IDETP = UPCASE(IDETP) IDETD = UPCASE(IDETD) - FMOPT = UPCASE(FMOPT) ! VSH -! FMOPT = 'A': ASCII format output -! FMOPT = 'C': CSV format output -! By default, use ASCII outputs - IF (INDEX('CA',FMOPT) < 1) FMOPT = 'A' - -! IDETL = VBOSE. -! 0 Only Summary.OUT -! N Minimal output -! Y Normal output -! D Detailed output -! A All outputs - - IF (IDETL .EQ. ' ') THEN - IDETL = 'N' - ENDIF - IDETL = UPCASE(IDETL) - IF (IDETH .EQ. ' ') THEN - IDETH = 'N' - ENDIF - IDETH = UPCASE(IDETH) - IF (IDETR .EQ. ' ') THEN - IDETR = 'Y' - ENDIF - IDETR = UPCASE(IDETR) - -! Verbose output switch - IF (IDETL == '0') THEN -! VBOSE = zero, suppress all output except Summary and Evaluate - IDETS = 'Y' - IDETG = 'N' - IDETC = 'N' - IDETW = 'N' - IDETN = 'N' - IDETP = 'N' - IDETD = 'N' - IDETH = 'N' - IDETR = 'N' - IDETO = 'E' -! Seasonal, Spatial, and Yield forecast runs do not get evaluate file when IDETL=0 - IF (INDEX('SNY',RNMODE) > 0) IDETO = 'N' - ELSEIF (IDETL == 'A' .OR. IDETL == 'D') THEN -! VBOSE = 'A', generate all output - IDETS = 'A' - IDETO = 'Y' - IDETG = 'Y' - IDETC = 'Y' - IDETW = 'Y' - IDETN = 'Y' - IDETP = 'Y' - IDETD = 'Y' - IDETH = 'Y' - IDETR = 'Y' -! Set IDETL back to "D" so no need for changes elsewhere -! IDETL = 'D' - FROP = 1 - ENDIF + ENDIF - IF (FROP .LE. 0) FROP = 10 - ENDIF -C ! ============================================================== C Read SIXTH line of simulation control - AUTOMATIC PLANTING C @@ -490,18 +294,6 @@ C ! IF (PWDINF .LT. 1000) PWDINF = YEAR * 1000 + PWDINF ! IF (PWDINL .LT. 1000) PWDINL = YEAR * 1000 + PWDINL -C FO - 05/07/2020 Add new Y4K subroutine call to convert YRDOY - !CALL Y2K_DOY (PWDINF) - !CALL Y2K_DOY (PWDINL) - IF(IPLTI .EQ. 'A' .OR. IPLTI .EQ. 'F') THEN - CALL Y4K_DOY (PWDINF,FILEX,LINEXP,ERRKEY,9) - CALL Y4K_DOY (PWDINL,FILEX,LINEXP,ERRKEY,9) - ELSE - PWDINF = -99 - PWDINL = -99 - ENDIF - -C ! ============================================================== C Read SEVENTH line of simulation control - AUTOMATIC IRRIGATION C @@ -689,58 +481,13 @@ C FO - 05/07/2020 Add new Y4K subroutine call to convert YRDOY REWIND (LUNEXP) -C----------------------------------------------------------------------- -C Select Model Name and Path -- order of priority: -! CTRMODEL is value from control file override -- this is used -! over all other values if valid. (Done in Default_SimControls) -! CRMODEL is read from FILEX. Use this if no control file. -! MODELARG is from command line argument list. Third priority. -! Last, use value from DSSATPRO.v??. -C----------------------------------------------------------------------- -! First check model name from FILEX - TRY_MODEL = CRMODEL - CALL MODEL_NAME (CROP, DSSATP, TRY_MODEL, MODEL) - -! If FILEX model name was not acceptable, then try the -! model name read from command line. If this is not OK, -! MODEL contains value from DSSATPRO file - IF (TRY_MODEL /= MODEL) THEN -! Fallow must be associated with CRGRO model (for now) - IF (CROP == 'FA') THEN - Try_MODELARG(1:5) = "CRGRO" - ELSE - Try_MODELARG = MODELARG - ENDIF - CALL MODEL_NAME (CROP, DSSATP, Try_MODELARG, MODEL) - ENDIF - - IF (MEPHO .EQ. 'L' .AND. MODEL(1:5) .NE. 'CRGRO' - & .and. model(1:5) .ne. 'PRFRM' ) THEN - MEPHO = 'C' - WRITE(MSG(1),80) - WRITE (MSG(2),81) MODEL(1:5) - CALL WARNING(2, "IPEXP ", MSG) - - 80 FORMAT('Photosynthesis method (PHOTO in FILEX) has been changed') - 81 FORMAT('from "L" to "C" for compatibility with crop model, ' - & ,A5,'.') - ENDIF - CALL FILL_ISWITCH( & CONTROL, ISWITCH, FROP, MODEL, NYRS, RNMODE) - -! Planting date needed for generic start of simulation - SELECT CASE(IPLTI) - CASE('R'); PLDATE = YRPLT - CASE('A'); PLDATE = PWDINF - END SELECT - ! Check Simulation control file for control overrides - CALL Default_SimControls( - & CONTROL, CRMODEL, DSSATP, FILECTL, ISWITCH, !Input - & MODELARG, PLDATE, !Input - & UseSimCtr, MODEL) !Output + CALL External_SimControls( + & CONTROL, FILECTL, ISWITCH, !Input + & UseSimCtr, CTRMODEL) !Output IF (UseSimCtr) THEN IOX = ISWITCH % FNAME @@ -792,6 +539,287 @@ C----------------------------------------------------------------------- ENDIF +! ============================================================================= +! Check codes for valid values +! 2025-02-07 CHP moved these here so that a single set of checks can be done for +! both FileX values and those from the external simulation controls. +! Previously, changes to checks in FileX were not also done for simulation controls. + +C----------------------------------------------------------------------- +C Select Model Name and Path -- order of priority: +! CTRMODEL is value from control file override -- this is used +! over all other values if valid. (Done in External_SimControls) +! CRMODEL is read from FILEX. Use this if no control file. +! MODELARG is from command line argument list. Third priority. +! Last, use value from DSSATPRO.v??. +C----------------------------------------------------------------------- +! ------------------------------------------------- +! Line 1 +! ------------------------------------------------- +! First check model from external simulation control file + TRY_MODEL = CTRMODEL !from external control file + CALL MODEL_NAME (CROP, DSSATP, TRY_MODEL, MODEL) + +! Next check model name from FILEX +! If CTR file model name was not acceptable, then try the +! model name read from FileX. + IF (TRY_MODEL /= MODEL) THEN + TRY_MODEL = CRMODEL !from FileX + CALL MODEL_NAME (CROP, DSSATP, TRY_MODEL, MODEL) + +! If FILEX model name was not acceptable, then try the +! model name read from command line. If this is not OK, +! get MODEL name from DSSATPRO file + IF (TRY_MODEL /= MODEL) THEN +! Fallow must be associated with CRGRO model (for now) + IF (CROP == 'FA') THEN + Try_MODELARG(1:5) = "CRGRO" + ELSE + Try_MODELARG = MODELARG !From command line + ENDIF + CALL MODEL_NAME (CROP, DSSATP, Try_MODELARG, MODEL) + ENDIF + ENDIF + +! Planting date needed for generic start of simulation + SELECT CASE(IPLTI) + CASE('R'); PLDATE = YRPLT + CASE('A'); PLDATE = PWDINF + END SELECT + +! Check for N fixation in CROPGRO crops + SELECT CASE (CROP) + CASE ('BN','SB','PN','PE','CH','PP','GY', + & 'VB','CP','CB','FB','GB','LT','AL', + & 'CV','BG') +! Do nothing -- these crops fix N and can have Y or N + CASE DEFAULT; ISWSYM ='N' !other crops don't have a choice + END SELECT + + IF (ISWCHE .EQ. ' ') THEN + ISWCHE = 'N' + ENDIF + + IF (ISWTIL .EQ. ' ') THEN + ISWTIL = 'N' + ENDIF + + IF (ISWWAT .EQ. 'N') THEN + ISWNIT = 'N' + ISWPHO = 'N' +! ISWCHE = 'N' + ENDIF + + IF (INDEX('FNQS',RNMODE) > 0) THEN +! For sequence, seasonal runs, default CO2 uses static value + IF (INDEX ('WMD', ICO2) < 1) ICO2 = 'D' + ELSE +! For experimental runs, default CO2 uses measured values + IF (INDEX ('WMD', ICO2) < 1) ICO2 = 'M' + ENDIF + +! ------------------------------------------------- +! Line 3 +! ------------------------------------------------- + IF (MEPHO .EQ. 'L' .AND. MODEL(1:5) .NE. 'CRGRO' + & .and. model(1:5) .ne. 'PRFRM' ) THEN + MEPHO = 'C' + WRITE(MSG(1),80) + WRITE (MSG(2),81) MODEL(1:5) + CALL WARNING(2, "IPEXP ", MSG) + + 80 FORMAT('Photosynthesis method (PHOTO in FILEX) has been changed') + 81 FORMAT('from "L" to "C" for compatibility with crop model, ' + & ,A5,'.') + ENDIF + + IF (INDEX('PG',MESOM) .EQ. 0) THEN + MESOM = 'G' + ENDIF + + IF (INDEX('G',MESOM) > 0 .AND. + & INDEX('FQ',RNMODE) > 0 .AND. + & INDEX('N',MEINF) == 0) THEN + MEINF = 'N' + IF (.NOT. MulchWarn) THEN + MSG(1)= + & "Long-term simulation of surface residues may not be accurate" + MSG(2)= + & "when using Godwin soil organic matter module. The effects of" + MSG(3)= + & "a surface mulch layer on runoff and evaporation will " // + & "not be modeled." + MSG(4)= + & "Simulation Options/Methods/Infiltration = 'No mulch effects'" + MSG(5)= + & "You may want to consider using the Parton (CENTURY) method of" + MSG(6)= "modeling soil organic matter." + CALL WARNING(6,ERRKEY,MSG) + MulchWarn = .TRUE. + ENDIF + ENDIF + +! ** DEFAULT MESOL = 2 ** 3/26/2007 +! MESOL = '1' Original soil layer distribution. Calls LYRSET. +! MESOL = '2' New soil layer distribution. Calls LYRSET2. +! MESOL = '3' User specified soil layer distribution. Calls LYRSET3. + IF (INDEX('123',MESOL) < 1) THEN + MESOL = '2' + ENDIF + +! 3/27/2016 chp Default soil temperature method is EPIC +! 7/21/2016 chp Default soil temperature method is DSSAT, per GH +! 5/04/2023 FO Default ST method is TMA(1) = TAVG (BK changes) + IF (INDEX('EDR',METMP) < 1) METMP = 'D' +! METMP = 'D' - default DSSAT (improved Kimball) soil temperature +! METMP = 'R' - previous DSSAT default method (Ritchie) +! METMP = 'E' - EPIC soil temperature routine + +! Default greenhouse gas method is DSSAT + IF (INDEX('01',MEGHG) < 1) MEGHG = '0' + + SELECT CASE(MESEV) + CASE('R','r'); MESEV = 'R' + CASE('s','S'); MESEV = 'S' + CASE('m','M'); MESEV = 'M' + CASE DEFAULT; MESEV = 'R' !Default method Ritchie + END SELECT + + IF (MEEVP == 'Z' .AND. MEPHO /= 'L') CALL ERROR(ERRKEY,3,' ',0) + + IF (MEHYD .EQ. ' ') MEHYD = 'R' + + IF (NSWITCH .LE. 0 .AND. ISWNIT .EQ. 'Y') THEN + NSWITCH = 1 + ENDIF + +! ------------------------------------------------- +! Line 4 +! ------------------------------------------------- +C TF, FO & DP - 2022-07-12 - AutomaticMOW Switch +! 2023-07-30 FO Initialized ATMOW and ATTP. +! W - AutoMOW days frequency +! X - AutoMOW GDD +! Y - SmartMOW days frequency +! Z - SmartMOW GDD + ISWITCH%ATMOW = .FALSE. + ISWITCH%ATTP = ' ' + IF(IHARI .EQ. 'W') THEN + ISWITCH%ATMOW = .TRUE. + ISWITCH%ATTP = 'W' + ELSEIF(IHARI .EQ. 'X') THEN + ISWITCH%ATMOW = .TRUE. + ISWITCH%ATTP = 'X' + ELSEIF(IHARI .EQ. 'Y') THEN + ISWITCH%ATMOW = .TRUE. + ISWITCH%ATTP = 'Y' + ELSEIF(IHARI .EQ. 'Z') THEN + ISWITCH%ATMOW = .TRUE. + ISWITCH%ATTP = 'Z' + ELSE + ISWITCH%ATMOW = .FALSE. + ENDIF + + IF ((INDEX('CSPT',CROP)) .GT. 0) THEN + IF (IHARI .EQ. 'A') THEN + WRITE(MSG(1),'("Automatic harvest option ", + & "is not valid for crop type: ",A2)') CROP + CALL WARNING(1, ERRKEY, MSG) + CALL ERROR (ERRKEY,4,FILEX,LINEXP) + ENDIF + ENDIF + + IF ((INDEX('CS',CROP)) .GT. 0) THEN + IF (IHARI .EQ. 'M') THEN + WRITE(MSG(1),'("Harvest at maturity option is ", + & "not valid for crop type: ",A2)') CROP + CALL WARNING(1, ERRKEY, MSG) + CALL ERROR ('IPSIM ',11,FILEX,LINEXP) + ENDIF + ENDIF + + IF ((INDEX('PT',CROP)) .GT. 0) THEN + IF (IPLTI .EQ. 'A') THEN + WRITE(MSG(1),'("Automatic planting option is ", + & "not valid for crop type: ",A2)') CROP + CALL WARNING(1, ERRKEY, MSG) + CALL ERROR (ERRKEY,5,FILEX,LINEXP) + ENDIF + ENDIF + +! ------------------------------------------------- +! Line 5 +! ------------------------------------------------- +! FMOPT = 'A': ASCII format output +! FMOPT = 'C': CSV format output +! By default, use ASCII outputs + IF (INDEX('CA',FMOPT) < 1) FMOPT = 'A' + +! IDETL = VBOSE. +! 0 Only Summary.OUT +! N Minimal output +! Y Normal output +! D Detailed output +! A All outputs + + IF (IDETL .EQ. ' ') IDETL = 'N' + IDETL = UPCASE(IDETL) + IF (IDETH .EQ. ' ') IDETH = 'N' + IDETH = UPCASE(IDETH) + IF (IDETR .EQ. ' ') IDETR = 'Y' + IDETR = UPCASE(IDETR) + +! Verbose output switch + IF (IDETL == '0') THEN +! VBOSE = zero, suppress all output except Summary and Evaluate + IDETS = 'Y' + IDETG = 'N' + IDETC = 'N' + IDETW = 'N' + IDETN = 'N' + IDETP = 'N' + IDETD = 'N' + IDETH = 'N' + IDETR = 'N' + IDETO = 'E' +! Seasonal, Spatial, and Yield forecast runs do not get evaluate file when IDETL=0 + IF (INDEX('SNY',RNMODE) > 0) IDETO = 'N' + ELSEIF (IDETL == 'A' .OR. IDETL == 'D') THEN +! VBOSE = 'A', generate all output + IDETS = 'A' + IDETO = 'Y' + IDETG = 'Y' + IDETC = 'Y' + IDETW = 'Y' + IDETN = 'Y' + IDETP = 'Y' + IDETD = 'Y' + IDETH = 'Y' + IDETR = 'Y' +! Set IDETL back to "D" so no need for changes elsewhere +! IDETL = 'D' + FROP = 1 + ENDIF + + IF (FROP .LE. 0) FROP = 10 + +! ------------------------------------------------- +! Line 6 +! ------------------------------------------------- +C FO - 05/07/2020 Add new Y4K subroutine call to convert YRDOY + !CALL Y2K_DOY (PWDINF) + !CALL Y2K_DOY (PWDINL) + IF(IPLTI .EQ. 'A' .OR. IPLTI .EQ. 'F') THEN + CALL Y4K_DOY (PWDINF,FILEX,LINEXP,ERRKEY,9) + CALL Y4K_DOY (PWDINL,FILEX,LINEXP,ERRKEY,9) + ELSE + PWDINF = -99 + PWDINL = -99 + ENDIF + + CALL FILL_ISWITCH( + & CONTROL, ISWITCH, FROP, MODEL, NYRS, RNMODE) + CALL PUT(CONTROL) CALL PUT(ISWITCH) @@ -927,6 +955,9 @@ C----------------------------------------------------------------------- END SELECT ENDIF + CALL FILL_ISWITCH( + & CONTROL, ISWITCH, FROP, MODEL, NYRS, RNMODE) + RETURN C----------------------------------------------------------------------- @@ -1044,7 +1075,7 @@ C----------------------------------------------------------------------- !======================================================================= -! Default_SimControls, Subroutine +! External_SimControls, Subroutine ! ! Reads default simulation controls file. These values override the ! values in the FileX simulation controls. @@ -1057,10 +1088,9 @@ C----------------------------------------------------------------------- ! Calls : ERROR IGNORE FIND YR_DOY !======================================================================= - SUBROUTINE Default_SimControls( - & CONTROL, CRMODEL, DSSATP, FILECTL, ISWITCH, !Input - & MODELARG, PLDATE, !Input - & UseSimCtr, MODEL) !Output + SUBROUTINE External_SimControls( + & CONTROL, FILECTL, ISWITCH, !Input + & UseSimCtr, CTRMODEL) !Output USE ModuleDefs IMPLICIT NONE @@ -1078,18 +1108,18 @@ C----------------------------------------------------------------------- CHARACTER*1 IDETH,IDETL, IDETR ! VSH CHARACTER*1 FMOPT - + CHARACTER*6 ERRKEY,FINDCH, SECTION - CHARACTER*8 MODEL, CRMODEL, CTRMODEL, MODELARG, TRY_MODEL + CHARACTER*8 MODEL, CTRMODEL CHARACTER*12 FILEX !, DSSATS CHARACTER*78 MSG(50) - CHARACTER*102 DSSATP, SIMCTR + CHARACTER*102 SIMCTR CHARACTER*120 INPUTX, FILECTL CHARACTER*128 CHARTEST INTEGER CTRNO, ERRNUM, FOUND, FROP, I, IFIND, IPX, ISECT, ISIM INTEGER LEVEL, LINEXP, NMSG, NREPSQ, NSWITCH, NYRS - INTEGER PLDATE, RSEED1, SCLun, YEAR, YRSIM + INTEGER RSEED1, SCLun, YEAR, YRSIM INTEGER SimLen, LenString, FIND_IN_FILE TYPE (SwitchType) ISWITCH @@ -1100,6 +1130,9 @@ C----------------------------------------------------------------------- PARAMETER (ERRKEY = 'SIMCTR') + MEPHO_SAVE = ISWITCH % MEPHO + ISWSYM_SAVE = ISWITCH % ISWSYM + !----------------------------------------------------------------------- IF (FIRST) THEN FIRST = .FALSE. @@ -1296,7 +1329,7 @@ C----------------------------------------------------------------------- CALL CHECK_A('ISIMI', ISIMI, ERRNUM, MSG, NMSG) READ (CHARTEST,'(33X,I5)',IOSTAT=ERRNUM) YRSIM - IF (YRSIM == -99) YRSIM = PLDATE + IF (YRSIM == -99) YRSIM = '.' CALL CHECK_I('YRSIM', YRSIM, ERRNUM, MSG, NMSG) IF (ERRNUM == 0) THEN C FO - 05/07/2020 Add new Y4K subroutine call to convert YRDOY @@ -1359,16 +1392,6 @@ C FO - 05/07/2020 Add new Y4K subroutine call to convert YRDOY ISWTIL = UPCASE(ISWTIL) ICO2 = UPCASE(ICO2) - IF (ISWWAT .EQ. 'N') THEN - ISWNIT = 'N' - ISWCHE = 'N' - ENDIF - - IF (ISWNIT .EQ. 'N') THEN - ISWPHO = 'N' - ISWPOT = 'N' - ENDIF - ! Third line of simulation controls CASE('@N MET') CALL IGNORE(SCLun,LINEXP,ISECT,CHARTEST) @@ -1432,14 +1455,6 @@ C FO - 05/07/2020 Add new Y4K subroutine call to convert YRDOY METMP = UPCASE(METMP) MEGHG = UPCASE(MEGHG) - IF (INDEX('PG' ,MESOM) == 0) MESOM = ' ' - IF (INDEX('123',MESOL) == 0) MESOL = ' ' - IF (INDEX('RS' ,MESEV) == 0) MESEV = ' ' - IF (INDEX('Z' ,MEEVP) > 0) MEPHO = 'L' -! IF (INDEX('ED' ,METMP) == 0) METMP = 'E' !3/27/2016 - IF (INDEX('ED' ,METMP) == 0) METMP = 'D' !7/21/2016 - IF (INDEX('01' ,MEGHG) == 0) MEGHG = '0' - ! Fourth line of simulation controls CASE('@N MAN') CALL IGNORE(SCLun,LINEXP,ISECT,CHARTEST) @@ -1541,43 +1556,6 @@ C FO - 05/07/2020 Add new Y4K subroutine call to convert YRDOY IDETR = UPCASE(IDETR) FMOPT = UPCASE(FMOPT) ! VSH -! Verbose output switch - IF (IDETL == '0') THEN -! VBOSE = zero, suppress all output except Summary and Evaluate - IDETS = 'Y' - IDETG = 'N' - IDETC = 'N' - IDETW = 'N' - IDETN = 'N' - IDETP = 'N' - IDETD = 'N' - IDETH = 'N' - IDETR = 'N' - IDETO = 'E' -! FMOPT = 'N' ! VSH !CHP FMOPT is not tied to IDETL - -! Seasonal, Spatial, and Yield forecast runs do not get evaluate file when IDETL=0 - IF (INDEX('SNY',CONTROL%RNMODE) > 0) IDETO = 'N' - - ELSEIF (IDETL == 'A' .OR. IDETL == 'D') THEN -! VBOSE = 'A', generate all output - IDETS = 'A' - IDETO = 'Y' - IDETG = 'Y' - IDETC = 'Y' - IDETW = 'Y' - IDETN = 'Y' - IDETP = 'Y' - IDETD = 'Y' - IDETH = 'Y' - IDETR = 'Y' -! FMOPT = 'A' ! VSH !CHP FMOPT is not tied to IDETL - -! Set IDETL back to "D" so no need for changes elsewhere -! IDETL = 'D' - FROP = 1 - ENDIF - END SELECT ENDDO @@ -1586,6 +1564,7 @@ C FO - 05/07/2020 Add new Y4K subroutine call to convert YRDOY IF (NMSG < 6) THEN MSG(4)='No default simulation controls read.' NMSG = 4 + UseSimCtr = .FALSE. ELSE UseSimCtr = .TRUE. ENDIF @@ -1598,83 +1577,6 @@ C FO - 05/07/2020 Add new Y4K subroutine call to convert YRDOY ISWSYM = ISWSYM_SAVE ENDIF -C----------------------------------------------------------------------- -C Select Model Name and Path -- order of priority: -! CTRMODEL is value from control file override -- this is used -! over all other values if valid. (Done in Default_SimControls) -! CRMODEL is read from FILEX. Use this if no control file. -! MODELARG is from command line argument list. Third priority. -! Last, use value from DSSATPRO file -C----------------------------------------------------------------------- -! First check model from simulation control file - TRY_MODEL = CTRMODEL - CALL MODEL_NAME (CONTROL%CROP, DSSATP, TRY_MODEL, MODEL) - -! If model name from simulation control file is not acceptable, -! try value from FILEX - IF (TRY_MODEL /= MODEL) THEN - TRY_MODEL = CRMODEL - CALL MODEL_NAME (CONTROL%CROP, DSSATP, TRY_MODEL, MODEL) - -! If FILEX model name was not acceptable, then try the -! model name read from command line. If this is not OK, -! MODEL contains value from DSSATPRO file - IF (TRY_MODEL /= MODEL) THEN - TRY_MODEL = MODELARG - CALL MODEL_NAME (CONTROL%CROP, DSSATP, TRY_MODEL, MODEL) - ENDIF - ENDIF - - MEPHO_SAVE = MEPHO -! IF (MEPHO .EQ. 'L' .AND. CTRMODEL(1:5) .NE. 'CRGRO') THEN - IF (MEPHO .EQ. 'L' .AND. MODEL(1:5) .NE. 'CRGRO') THEN - MEPHO = 'C' - MSG(1)='Photosynthesis method (PHOTO in FILEX) has been changed' - WRITE (MSG(2),81) CTRMODEL(1:5) - 81 FORMAT('from "L" to "C" for compatibility with crop model, ' - & ,A5,'.') - CALL WARNING(2, "IPSIM ", MSG) - ENDIF - - ISWSYM_SAVE = ISWSYM - SELECT CASE (CONTROL % CROP) - CASE ('BN','SB','PN','PE','CH','PP', - & 'VB','CP','CB','FB','GB','LT', - & 'AL','BG','CV' ) -C! Do nothing -- CROPGRO crops can have Y or N - CASE DEFAULT; ISWSYM = 'N' !other crops don't have a choice - END SELECT - - IF ((INDEX('CSPT',CONTROL % CROP)) .GT. 0) THEN - IF (IHARI .EQ. 'A') THEN - MSG(1) = "Default Simulation controls file used." - WRITE(MSG(2),'("Automatic harvest option is not valid for ", - & "crop type: ",A2)') CONTROL%CROP - CALL WARNING(2, ERRKEY, MSG) - CALL ERROR ('IPSIM ',4,FILEX,LINEXP) - ENDIF - ENDIF - - IF ((INDEX('CS',CONTROL % CROP)) .GT. 0) THEN - IF (IHARI .EQ. 'M') THEN - MSG(1) = "Default Simulation controls file used." - WRITE(MSG(2),'("Harvest at maturity option is not valid for ", - & "crop type: ",A2)') CONTROL%CROP - CALL WARNING(1, ERRKEY, MSG) - CALL ERROR ('IPSIM ',11,FILEX,LINEXP) - ENDIF - ENDIF - - IF ((INDEX('PT',CONTROL % CROP)) .GT. 0) THEN - IF (IPLTI .EQ. 'A') THEN - MSG(1) = "Default Simulation controls file used." - WRITE(MSG(2),'("Automatic planting option is not valid for ", - & "crop type: ",A2)') CONTROL%CROP - CALL WARNING(2, ERRKEY, MSG) - CALL ERROR ('IPSIM ',5,FILEX,LINEXP) - ENDIF - ENDIF - ! Fill ISWITCH variable (complete) IF (IOX /= ' ' .AND. IOX /= '.') ISWITCH % FNAME = IOX IF (ISIMI /= ' ' .AND. ISIMI /= '.') ISWITCH % ISIMI = ISIMI @@ -1728,7 +1630,7 @@ C! Do nothing -- CROPGRO crops can have Y or N IF (FROP > 0) CONTROL % FROP = FROP RETURN - END SUBROUTINE Default_SimControls + END SUBROUTINE External_SimControls !======================================================================= SUBROUTINE CHECK_A(LABEL, VALUE, ERRNUM, MSG, NMSG) diff --git a/Plant/ALOHA-Pineapple/Aloha_OPGROW.f90 b/Plant/ALOHA-Pineapple/Aloha_OPGROW.f90 index cf48ed45d..430ae348a 100644 --- a/Plant/ALOHA-Pineapple/Aloha_OPGROW.f90 +++ b/Plant/ALOHA-Pineapple/Aloha_OPGROW.f90 @@ -188,7 +188,7 @@ SUBROUTINE Aloha_OpGrow (CONTROL, ISWITCH, & !----------------------------------------------------------------------- ! PlantGro.OUT !----------------------------------------------------------------------- - IF (IDETG == 'Y') THEN +! IF (IDETG == 'Y') THEN LEAFNO = LN VSTAGE = REAL (LEAFNO) @@ -265,7 +265,7 @@ SUBROUTINE Aloha_OpGrow (CONTROL, ISWITCH, & PCNL = 0.0 ENDIF - IF (FMOPT /= 'C') THEN ! VSH + IF (IDETG == 'Y' .AND. FMOPT /= 'C') THEN ! VSH WRITE (NOUTDG,400) YEAR, DOY, DAS, DAP, VSTAGE, ISTAGE, XLAI, & NINT(TOPWT), NINT(VWAD), NINT(LWAD), NINT(SWAD), NINT(FLWAD), & NINT(FWAD), NINT(CRAD), NINT(BWAD), NINT(SUGD), NINT(RWAD), HI, & @@ -297,12 +297,12 @@ SUBROUTINE Aloha_OpGrow (CONTROL, ISWITCH, & ! !CALL Linklst(vCsvline) ENDIF - ENDIF !Print PlantGro report +! ENDIF !Print PlantGro report !----------------------------------------------------------------------- ! PlantN.OUT !----------------------------------------------------------------------- - IF (IDETN .EQ. 'Y' .AND. ISWNIT .EQ. 'Y') THEN + IF (ISWNIT .EQ. 'Y') THEN WTNSD = GRAINN * PLTPOP WTNRT = ROOTN * PLTPOP ! Is this right? @@ -337,7 +337,7 @@ SUBROUTINE Aloha_OpGrow (CONTROL, ISWITCH, & !----------------------------------------------------------------------- - IF (FMOPT /= 'C') THEN ! VSH + IF (IDETN == 'Y' .AND. FMOPT /= 'C') THEN ! VSH WRITE (NOUTPN,300) YEAR, DOY, DAS, DAP, & (WTNUP*10.0), (WTNCAN*10.0), (WTNVEG*10.0), (WTNLF*10.0), (WTNST*10.0), (WTNRT*10), & PCNVEG, PCNL, PCNST, PCNRT diff --git a/Plant/CROPGRO/Opgrow.for b/Plant/CROPGRO/Opgrow.for index fe0088fdd..1dd73d96e 100644 --- a/Plant/CROPGRO/Opgrow.for +++ b/Plant/CROPGRO/Opgrow.for @@ -92,7 +92,10 @@ C Calls: None ! No output for fallow crop CROP = CONTROL % CROP IDETG = ISWITCH % IDETG - IF (CROP .EQ. 'FA' .OR. IDETG .EQ. 'N') RETURN + +! 2025-02-06 still need to calcs even if we don't print +! IF (CROP .EQ. 'FA' .OR. IDETG .EQ. 'N') RETURN + IF (CROP .EQ. 'FA') RETURN ! Transfer values from constructed data types into local variables. DAS = CONTROL % DAS @@ -113,14 +116,14 @@ C Calls: None IF (DYNAMIC .EQ. RUNINIT) THEN !----------------------------------------------------------------------- IF (FMOPT == 'A' .OR. FMOPT == ' ') THEN ! VSH - OUTG = 'PlantGro.OUT' - CALL GETLUN('OUTG', NOUTDG) - - OUTPN = 'PlantN.OUT ' - CALL GETLUN('OUTPN', NOUTPN) - - OUTPC = 'PlantC.OUT ' - CALL GETLUN('OUTPC', NOUTPC) + OUTG = 'PlantGro.OUT' + CALL GETLUN('OUTG', NOUTDG) + + OUTPN = 'PlantN.OUT ' + CALL GETLUN('OUTPN', NOUTPN) + + OUTPC = 'PlantC.OUT ' + CALL GETLUN('OUTPC', NOUTPC) END IF ! VSH !*********************************************************************** @@ -129,57 +132,60 @@ C Calls: None !*********************************************************************** ELSEIF (DYNAMIC .EQ. SEASINIT) THEN !----------------------------------------------------------------------- +! CHP 2025-02-06 only print if requested + IF (IDETG .NE. 'N') THEN + IF (FMOPT == 'A' .OR. FMOPT == ' ') THEN ! VSH -! Initialize daily growth output file - INQUIRE (FILE = OUTG, EXIST = FEXIST) - IF (FEXIST) THEN - OPEN (UNIT = NOUTDG, FILE = OUTG, STATUS = 'OLD', - & IOSTAT = ERRNUM, POSITION = 'APPEND') - FIRST = .FALSE. - ELSE - OPEN (UNIT = NOUTDG, FILE = OUTG, STATUS = 'NEW', - & IOSTAT = ERRNUM) - WRITE(NOUTDG,'("*GROWTH ASPECTS OUTPUT FILE")') - FIRST = .TRUE. - ENDIF +! Initialize daily growth output file + INQUIRE (FILE = OUTG, EXIST = FEXIST) + IF (FEXIST) THEN + OPEN (UNIT = NOUTDG, FILE = OUTG, STATUS = 'OLD', + & IOSTAT = ERRNUM, POSITION = 'APPEND') + FIRST = .FALSE. + ELSE + OPEN (UNIT = NOUTDG, FILE = OUTG, STATUS = 'NEW', + & IOSTAT = ERRNUM) + WRITE(NOUTDG,'("*GROWTH ASPECTS OUTPUT FILE")') + FIRST = .TRUE. + ENDIF + + !Write headers + CALL HEADER(SEASINIT, NOUTDG, RUN) + ENDIF ! VSH - !Write headers - CALL HEADER(SEASINIT, NOUTDG, RUN) - END IF ! VSH - N_LYR = MIN(10, MAX(4,SOILPROP%NLAYR)) IF (FMOPT == 'A' .OR. FMOPT == ' ') THEN ! VSH -! IF (ISWPHO .NE. 'N') THEN - WRITE (NOUTDG, 100) "Root Dens. (cm/cm3) by soil ", - & "depth (cm):",(SoilProp%LayerText(L), L=1,N_LYR) - 100 FORMAT("!",244X,A,A,/,"!",239X,10A8) -! ELSE -! WRITE (NOUTDG,102) (SoilProp%LayerText(L), L=1,N_LYR) -! 102 FORMAT("!",216X,"Soil Layer depths (cm):",/,"!",211X,10A8) -! ENDIF - - WRITE (NOUTDG,200, ADVANCE='NO') - 200 FORMAT('@YEAR DOY DAS DAP', +! IF (ISWPHO .NE. 'N') THEN + WRITE (NOUTDG, 100) "Root Dens. (cm/cm3) by soil ", + & "depth (cm):",(SoilProp%LayerText(L), L=1,N_LYR) + 100 FORMAT("!",244X,A,A,/,"!",239X,10A8) +! ELSE +! WRITE (NOUTDG,102) (SoilProp%LayerText(L), L=1,N_LYR) +! 102 FORMAT("!",216X,"Soil Layer depths (cm):",/,"!",211X,10A8) +! ENDIF + + WRITE (NOUTDG,200, ADVANCE='NO') + 200 FORMAT('@YEAR DOY DAS DAP', & ' L#SD GSTD LAID LWAD SWAD GWAD') - IF(CROP .EQ. 'CO') THEN - WRITE (NOUTDG,'(A)', ADVANCE='NO') ' LIWAM LINTP' - ENDIF + IF(CROP .EQ. 'CO') THEN + WRITE (NOUTDG,'(A)', ADVANCE='NO') ' LIWAM LINTP' + ENDIF - WRITE (NOUTDG,205, ADVANCE='NO') - 205 FORMAT(' RWAD VWAD CWAD G#AD GWGD HIAD PWAD', + WRITE (NOUTDG,205, ADVANCE='NO') + 205 FORMAT(' RWAD VWAD CWAD G#AD GWGD HIAD PWAD', & ' P#AD WSPD WSGD NSTD') -! IF (ISWPHO .NE. 'N') THEN - WRITE (NOUTDG,"(' PST1A PST2A')", ADVANCE='NO') -! ENDIF -! IF (ISWPOT .EQ. 'Y') THEN - WRITE (NOUTDG,"(' KSTD')", ADVANCE='NO') -! ENDIF +! IF (ISWPHO .NE. 'N') THEN + WRITE (NOUTDG,"(' PST1A PST2A')", ADVANCE='NO') +! ENDIF +! IF (ISWPOT .EQ. 'Y') THEN + WRITE (NOUTDG,"(' KSTD')", ADVANCE='NO') +! ENDIF - WRITE (NOUTDG,214, ADVANCE='NO') - 214 FORMAT(' EWSD LN%D', + WRITE (NOUTDG,214, ADVANCE='NO') + 214 FORMAT(' EWSD LN%D', & ' SH%D HIPD PWDD PWTD SLAD CHTD', & ' CWID NWAD RDPD') @@ -191,69 +197,72 @@ C Calls: None ENDIF ENDDO - WRITE (NOUTDG,220) - 220 FORMAT(' SNW0C SNW1C') ! SNW0D SNW1D', + WRITE (NOUTDG,220) + 220 FORMAT(' SNW0C SNW1C') ! SNW0D SNW1D', ! & ' EOP TRWUP WRDOTN') !----------------------------------------------------------------------- -! Initialize daily plant nitrogen output file - INQUIRE (FILE = OUTPN, EXIST = FEXIST) - IF (FEXIST) THEN - OPEN (UNIT = NOUTPN, FILE = OUTPN, STATUS = 'OLD', - & IOSTAT = ERRNUM, POSITION = 'APPEND') - FIRST = .FALSE. - ELSE - OPEN (UNIT = NOUTPN, FILE = OUTPN, STATUS = 'NEW', - & IOSTAT = ERRNUM) - WRITE(NOUTPN,'("*PLANT N OUTPUT FILE")') - FIRST = .TRUE. - ENDIF +! Initialize daily plant nitrogen output file + INQUIRE (FILE = OUTPN, EXIST = FEXIST) + IF (FEXIST) THEN + OPEN (UNIT = NOUTPN, FILE = OUTPN, STATUS = 'OLD', + & IOSTAT = ERRNUM, POSITION = 'APPEND') + FIRST = .FALSE. + ELSE + OPEN (UNIT = NOUTPN, FILE = OUTPN, STATUS = 'NEW', + & IOSTAT = ERRNUM) + WRITE(NOUTPN,'("*PLANT N OUTPUT FILE")') + FIRST = .TRUE. + ENDIF - !Write headers - CALL HEADER(SEASINIT, NOUTPN, RUN) +! Write headers + CALL HEADER(SEASINIT, NOUTPN, RUN) - WRITE (NOUTPN,230) - 230 FORMAT('@YEAR DOY DAS DAP', + WRITE (NOUTPN,230) + 230 FORMAT('@YEAR DOY DAS DAP', & ' CNAD GNAD VNAD GN%D VN%D NFXC NUPC', & ' LNAD SNAD LN%D SN%D SHND', !CHP & ' RN%D NFXD') & ' RN%D NFXD SNN0C SNN1C') !----------------------------------------------------------------------- -! Initialize daily plant carbon output file - INQUIRE (FILE = OUTPC, EXIST = FEXIST) - IF (FEXIST) THEN - OPEN (UNIT = NOUTPC, FILE = OUTPC, STATUS = 'OLD', - & IOSTAT = ERRNUM, POSITION = 'APPEND') - FIRST = .FALSE. - ELSE - OPEN (UNIT = NOUTPC, FILE = OUTPC, STATUS = 'NEW', - & IOSTAT = ERRNUM) - WRITE(NOUTPC,'("*PLANT C OUTPUT FILE")') - FIRST = .TRUE. - ENDIF +! Initialize daily plant carbon output file + INQUIRE (FILE = OUTPC, EXIST = FEXIST) + IF (FEXIST) THEN + OPEN (UNIT = NOUTPC, FILE = OUTPC, STATUS = 'OLD', + & IOSTAT = ERRNUM, POSITION = 'APPEND') + FIRST = .FALSE. + ELSE + OPEN (UNIT = NOUTPC, FILE = OUTPC, STATUS = 'NEW', + & IOSTAT = ERRNUM) + WRITE(NOUTPC,'("*PLANT C OUTPUT FILE")') + FIRST = .TRUE. + ENDIF - !Write headers - CALL HEADER(SEASINIT, NOUTPC, RUN) +! Write headers + CALL HEADER(SEASINIT, NOUTPC, RUN) - WRITE (NOUTPC,250) - 250 FORMAT('@YEAR DOY DAS DAP TWAD PHAD', + WRITE (NOUTPC,250) + 250 FORMAT('@YEAR DOY DAS DAP TWAD PHAD', & ' CMAD CGRD GRAD MRAD CHAD CL%D CS%D', & ' TGNN TGAV GN%D GL%D GC%D') END IF ! VSH - - CUMSENSURF = 0.0 - CUMSENSOIL = 0.0 - CUMSENSURFN = 0.0 - CUMSENSOILN = 0.0 - SWF_AV = 0.0 - TUR_AV = 0.0 - NST_AV = 0.0 - EXW_AV = 0.0 - PS1_AV = 0.0 - PS2_AV = 0.0 - KST_AV = 0.0 - LINTP = 0.0 + + + ENDIF !IDETG for printing + + CUMSENSURF = 0.0 + CUMSENSOIL = 0.0 + CUMSENSURFN = 0.0 + CUMSENSOILN = 0.0 + SWF_AV = 0.0 + TUR_AV = 0.0 + NST_AV = 0.0 + EXW_AV = 0.0 + PS1_AV = 0.0 + PS2_AV = 0.0 + KST_AV = 0.0 + LINTP = 0.0 !*********************************************************************** !*********************************************************************** @@ -287,14 +296,6 @@ C----------------------------------------------------------------------- CUMSENSOILN = CUMSENSOILN + SENESCE % ResE(L,1) ENDDO - IF ((MOD(DAS,FROP) .EQ. 0) !Daily output every FROP days, - & .OR. (YRDOY .EQ. YRPLT) !on planting date, and - & .OR. (YRDOY .EQ. MDATE)) THEN !at harvest maturity - - DAP = MAX(0,TIMDIF(YRPLT,YRDOY)) - IF (DAP > DAS) DAP = 0 - CALL YR_DOY(YRDOY, YEAR, DOY) - !Prior to emergence, do not report %N, %C values !Hold off on this until GBuild can handle -99 values ! IF (DAS .GE. NVEG0) THEN @@ -327,32 +328,48 @@ C----------------------------------------------------------------------- ! PCNSHP = -99. ! ENDIF - IF (PODWT .GT. 0.1) THEN - SHELPC = SDWT*100./PODWT - ELSE - SHELPC = 0.0 - ENDIF + IF (PODWT .GT. 0.1) THEN + SHELPC = SDWT*100./PODWT + ELSE + SHELPC = 0.0 + ENDIF - SHELPC = MIN(SHELPC,99.99) - SHELLW = PODWT - SDWT !Not used + SHELPC = MIN(SHELPC,99.99) + SHELLW = PODWT - SDWT !Not used - IF (SEEDNO .GT. 1.E-4) THEN - SDSIZE = SDWT/SEEDNO*1000 - ELSE - SDSIZE = 0.0 - ENDIF + IF (SEEDNO .GT. 1.E-4) THEN + SDSIZE = SDWT/SEEDNO*1000 + ELSE + SDSIZE = 0.0 + ENDIF - IF (TOPWT .GT. 1.E-4 .AND. SDWT .GE. 1.E-4) THEN - HI = SDWT/TOPWT - ELSE - HI = 0. - ENDIF + IF (TOPWT .GT. 1.E-4 .AND. SDWT .GE. 1.E-4) THEN + HI = SDWT/TOPWT + ELSE + HI = 0. + ENDIF - IF (TOPWT .GT. 1.E-4 .AND. PODWT .GE. 1.E-4) THEN - HIP = PODWT/TOPWT - ELSE - HIP = 0. - ENDIF + IF (TOPWT .GT. 1.E-4 .AND. PODWT .GE. 1.E-4) THEN + HIP = PODWT/TOPWT + ELSE + HIP = 0. + ENDIF + + VWAD = NINT(WTLF*10. + STMWT*10.) + + IF(CROP .EQ. 'CO' .AND. SDWT .GT. 0.0) THEN + LINTP = (LINTW*100.)/SDWT + ENDIF + + IF ((IDETG .NE. 'N') !Growth output switch is on + & .AND. !plus at least one of the following is true + & ((MOD(DAS,FROP) .EQ. 0) !Output every FROP days, + & .OR. (YRDOY .EQ. YRPLT) !or on planting date, + & .OR. (YRDOY .EQ. MDATE))) THEN !or at harvest maturity + + DAP = MAX(0,TIMDIF(YRPLT,YRDOY)) + IF (DAP > DAS) DAP = 0 + CALL YR_DOY(YRDOY, YEAR, DOY) ! Compute average stress factors since last printout IF (COUNT > 0) THEN @@ -366,69 +383,63 @@ C----------------------------------------------------------------------- COUNT = 0 ENDIF - VWAD = NINT(WTLF*10. + STMWT*10.) - - IF(CROP .EQ. 'CO' .AND. SDWT .GT. 0.0) THEN - LINTP = (LINTW*100.)/SDWT - ENDIF - IF (FMOPT == 'A' .OR. FMOPT == ' ') THEN ! VSH - WRITE (NOUTDG,300, ADVANCE='NO') + WRITE (NOUTDG,300, ADVANCE='NO') & YEAR, DOY, DAS, DAP, VSTAGE, RSTAGE, XLAI, & NINT(WTLF*10.), NINT(STMWT*10.), NINT(SDWT*10.) - - 300 FORMAT (1X,I4,1X,I3.3,2(1X,I5), + + 300 FORMAT (1X,I4,1X,I3.3,2(1X,I5), & 1X,F6.1,1X,I6,1X,F6.3,3(1X,I6)) - IF(CROP .EQ. 'CO') THEN - WRITE (NOUTDG,305, ADVANCE='NO') - & NINT(LINTW*10.), LINTP - 305 FORMAT (1X,I6,1X,F6.2) - ENDIF + IF(CROP .EQ. 'CO') THEN + WRITE (NOUTDG,305, ADVANCE='NO') + & NINT(LINTW*10.), LINTP + 305 FORMAT (1X,I6,1X,F6.2) + ENDIF - WRITE (NOUTDG,310, ADVANCE='NO') + WRITE (NOUTDG,310, ADVANCE='NO') & NINT(RTWT*10.), VWAD, NINT(TOPWT*10.), NINT(SEEDNO), - & SDSIZE, HI, NINT(PODWT*10.), NINT(PODNO), SWF_AV, TUR_AV, + & SDSIZE, HI, NINT(PODWT*10.), NINT(PODNO), SWF_AV,TUR_AV, & NST_AV - 310 FORMAT (4(1X,I6), + 310 FORMAT (4(1X,I6), & 1X,F7.1,1X,F6.3,2(1X,I6),2(1X,F6.3), & 1X,F6.3) -! IF (ISWPHO .NE. 'N') THEN - WRITE (NOUTDG,'(2(1X,F6.3))', ADVANCE='NO') PS1_AV, PS2_AV -! ENDIF - -! IF (ISWPOT .EQ. 'Y') THEN - WRITE (NOUTDG,'(1X,F6.3)', ADVANCE='NO') KST_AV -! ENDIF +! IF (ISWPHO .NE. 'N') THEN + WRITE (NOUTDG,'(2(1X,F6.3))', ADVANCE='NO')PS1_AV,PS2_AV +! ENDIF + +! IF (ISWPOT .EQ. 'Y') THEN + WRITE (NOUTDG,'(1X,F6.3)', ADVANCE='NO') KST_AV +! ENDIF - WRITE (NOUTDG,314, ADVANCE='NO') + WRITE (NOUTDG,314, ADVANCE='NO') & EXW_AV, PCNLP, SHELPC, HIP, NINT(PODWTD*10.), - & NINT((PODWTD+PODWT)*10.), SLAP, CANHT, CANWH, (DWNOD*10.), + & NINT((PODWTD+PODWT)*10.), SLAP, CANHT,CANWH,(DWNOD*10.), & (RTDEP/100.), (RLV(I),I=1,N_LYR) - 314 FORMAT (1X,F6.3,1X,F7.2,2(1X,F6.2), + 314 FORMAT (1X,F6.3,1X,F7.2,2(1X,F6.2), & 2(1X,I6),1X,F6.1,2(1X,F6.2),1X,F6.1,1X,F6.2,11(1X,F7.2)) - WRITE (NOUTDG,316) - & NINT(CUMSENSURF), NINT(CUMSENSOIL) !, SENSURFT, SENSOILT + WRITE (NOUTDG,316) + & NINT(CUMSENSURF), NINT(CUMSENSOIL) !,SENSURFT,SENSOILT ! & , EOP, TRWUP, WRDOTN - 316 FORMAT (I8,1X,I7, 2F8.3, 3F8.4) - END IF ! VSH -!----------------------------------------------------------------------- -! VSH CSV output corresponding to PlantGro.OUT - IF (FMOPT == 'C') THEN - CALL CsvOut(EXPNAME,CONTROL%RUN, CONTROL%TRTNUM,CONTROL%ROTNUM - &,CONTROL%REPNO, YEAR, DOY, DAS, DAP, VSTAGE, RSTAGE, XLAI, - &WTLF, STMWT, SDWT, LINTW, LINTP, - &RTWT, VWAD, TOPWT, SEEDNO, SDSIZE, HI, PODWT, - &PODNO, SWF_AV, TUR_AV, NST_AV, PS1_AV, PS2_AV, KST_AV, EXW_AV, - &PCNLP, SHELPC, HIP, PODWTD, SLAP, CANHT, CANWH, - &DWNOD, RTDEP, N_LYR, RLV, CUMSENSURF, CUMSENSOIL, - &vCsvline, vpCsvline, vlngth) - - CALL Linklst(vCsvline) - END IF - + 316 FORMAT (I8,1X,I7, 2F8.3, 3F8.4) + ENDIF ! VSH +!--------------------------------------------------------------------- +! VSH CSV output corresponding to PlantGro.OUT + IF (FMOPT == 'C') THEN + CALL CsvOut(EXPNAME,CONTROL%RUN, CONTROL%TRTNUM, + & CONTROL%ROTNUM, CONTROL%REPNO, YEAR, DOY, DAS, DAP, + & VSTAGE, RSTAGE, XLAI, WTLF, STMWT, SDWT, LINTW, LINTP, + & RTWT, VWAD, TOPWT, SEEDNO, SDSIZE, HI, PODWT, + & PODNO, SWF_AV, TUR_AV, NST_AV, PS1_AV, PS2_AV, KST_AV, + & EXW_AV, PCNLP, SHELPC, HIP, PODWTD, SLAP, CANHT, CANWH, + & DWNOD, RTDEP, N_LYR, RLV, CUMSENSURF, CUMSENSOIL, + & vCsvline, vpCsvline, vlngth) + + CALL Linklst(vCsvline) + ENDIF + ! Set average stress factors since last printout back to zero SWF_AV = 0.0 TUR_AV = 0.0 @@ -438,35 +449,9 @@ C----------------------------------------------------------------------- PS2_AV = 0.0 KST_AV = 0.0 -! WRITE (NOUTDG,312)YEAR, DOY, DAS, DAP, VSTAGE, RSTAGE, XLAI, -! 312 FORMAT (1X,I4,1X,I3.3,2(1X,I5),1X,F6.1,1X,I6,1X,F6.2, - -! & NINT(WTLF*10.), NINT(STMWT*10.), NINT(SDWT*10.), -! & NINT(RTWT*10.), NINT(TOPWT*10.), NINT(SEEDNO), -! & 6(1X,I6), - -! & SDSIZE, HI, -! & 1X,F7.1,1X,F6.3, - -! & NINT(PODWT*10.), NINT(PODNO), (1.-SWFAC), (1.-TURFAC), -! & (1.-NSTRES), (1.-PSTRES1), (1.-PSTRES2), SATFAC, -! & 2(1X,I6),6(1X,F6.3), - -! & PCNLP, SHELPC, HIP, -! & 1X,F7.2,2(1X,F6.2), - -! & NINT(PODWTD*10.),NINT((PODWTD+PODWT)*10.), SLAP, CANHT, CANWH, -! & 2(1X,I6),1X,F6.1,2(1X,F6.2), - -! & (DWNOD*10.),(RTDEP/100.), (RLV(I),I=1,10), -! & 1X,F6.1,11(1X,F6.2), - -! & NINT(CUMSENSURF), NINT(CUMSENSOIL), SENSURFT, SENSOILT -! & , EOP, TRWUP, WRDOTN -! & 2(1X,I7), 2F8.3, 3F8.3) -C----------------------------------------------------------------------- +!----------------------------------------------------------------------- WTNVEG = (WTNLF + WTNST) - + IF ((WTLF+STMWT).GT. 0.0001) THEN PCNVEG = (WTNLF+WTNST)/(WTLF+STMWT)*100. ELSE @@ -475,48 +460,50 @@ C----------------------------------------------------------------------- ENDIF IF (FMOPT == 'A' .OR. FMOPT == ' ') THEN ! VSH - WRITE (NOUTPN,410) YEAR, DOY, DAS, DAP, (WTNCAN*10), + WRITE (NOUTPN,410) YEAR, DOY, DAS, DAP, (WTNCAN*10), & (WTNSD*10), (WTNVEG*10), PCNSDP, PCNVEG, (WTNFX*10), & (WTNUP*10), (WTNLF*10), (WTNST*10), PCNLP, PCNSTP, & PCNSHP, PCNRTP, NFIXN*10, CUMSENSURFN, CUMSENSOILN - 410 FORMAT(1X,I4,1X,I3.3,2(1X,I5),3(1X,F7.1),2(1X,F7.2),1X, + 410 FORMAT(1X,I4,1X,I3.3,2(1X,I5),3(1X,F7.1),2(1X,F7.2),1X, & 2(1X,F7.1),2(1X,F7.1),2(1X,F7.2),1X,F7.1,2(1X,F6.1), & 2(1X,F7.2)) END IF ! VSH - - ! VSH - IF (FMOPT == 'C') THEN - CALL CsvOutPlNCrGro(EXPNAME, CONTROL%RUN, CONTROL%TRTNUM, - &CONTROL%ROTNUM, CONTROL%REPNO, YEAR, DOY, DAS, DAP, - &WTNCAN, WTNSD, WTNVEG, PCNSDP, PCNVEG, WTNFX, WTNUP, - &WTNLF, WTNST, PCNLP, PCNSTP, PCNSHP, PCNRTP, NFIXN, - &CUMSENSURFN, CUMSENSOILN, - &vCsvlinePlNCrGro, vpCsvlinePlNCrGro, vlngthPlNCrGro) - - CALL LinklstPlNCrGro(vCsvlinePlNCrGro) - - CALL CsvOutPlCCrGro(EXPNAME, CONTROL%RUN, CONTROL%TRTNUM, - &CONTROL%ROTNUM, CONTROL%REPNO, YEAR, DOY, DAS, DAP, - &TOTWT, PG, CMINEA, GROWTH, GRWRES, MAINR, CADLF, - &CADST, RHOLP, RHOSP, TGRO, TGROAV, PCNSDP, PCLSDP, - &PCCSDP, TS, - &vCsvlinePlCCrGro, vpCsvlinePlCCrGro, vlngthPlCCrGro) - - CALL LinklstPlCCrGro(vCsvlinePlCCrGro) - END IF -C----------------------------------------------------------------------- + +! VSH + IF (FMOPT == 'C') THEN + CALL CsvOutPlNCrGro(EXPNAME, CONTROL%RUN, CONTROL%TRTNUM, + & CONTROL%ROTNUM, CONTROL%REPNO, YEAR, DOY, DAS, DAP, + & WTNCAN, WTNSD, WTNVEG, PCNSDP, PCNVEG, WTNFX, WTNUP, + & WTNLF, WTNST, PCNLP, PCNSTP, PCNSHP, PCNRTP, NFIXN, + & CUMSENSURFN, CUMSENSOILN, + & vCsvlinePlNCrGro, vpCsvlinePlNCrGro, vlngthPlNCrGro) + + CALL LinklstPlNCrGro(vCsvlinePlNCrGro) + + CALL CsvOutPlCCrGro(EXPNAME, CONTROL%RUN, CONTROL%TRTNUM, + & CONTROL%ROTNUM, CONTROL%REPNO, YEAR, DOY, DAS, DAP, + & TOTWT, PG, CMINEA, GROWTH, GRWRES, MAINR, CADLF, + & CADST, RHOLP, RHOSP, TGRO, TGROAV, PCNSDP, PCLSDP, + & PCCSDP, TS, + & vCsvlinePlCCrGro, vpCsvlinePlCCrGro, vlngthPlCCrGro) + + CALL LinklstPlCCrGro(vCsvlinePlCCrGro) + END IF + +!--------------------------------------------------------------------- IF (FMOPT == 'A' .OR. FMOPT == ' ') THEN ! VSH - WRITE (NOUTPC,510) YEAR, DOY, DAS, DAP, + WRITE (NOUTPC,510) YEAR, DOY, DAS, DAP, & NINT(TOTWT*10), PG, CMINEA, GROWTH, & GRWRES, MAINR, (CADLF + CADST), RHOLP, RHOSP, & TGRO(TS/2), TGROAV, PCNSDP, PCLSDP, PCCSDP -C changed from 12 to TS/2 on 9Jul17 by Bruce Kimball - 510 FORMAT(1X,I4,1X,I3.3,2(1X,I5),1X,I6,5(F8.4),F8.5,2(F7.3), +C changed from 12 to TS/2 on 9Jul17 by Bruce Kimball + 510 FORMAT(1X,I4,1X,I3.3,2(1X,I5),1X,I6,5(F8.4),F8.5,2(F7.3), & 2(1X,F6.3),3(1X,F7.4)) -! 510 FORMAT(1X,I4,1X,I3.3,2(1X,I5),1X,I6,6(1X,F7.2),2(1X,F6.1), +! 510 FORMAT(1X,I4,1X,I3.3,2(1X,I5),1X,I6,6(1X,F7.2),2(1X,F6.1), ! & 2(1X,F6.1),3(1X,F7.2)) - END IF ! VSH - ENDIF + ENDIF ! VSH + + ENDIF !print today !*********************************************************************** !*********************************************************************** @@ -525,10 +512,10 @@ C changed from 12 to TS/2 on 9Jul17 by Bruce Kimball ELSE IF (DYNAMIC .EQ. SEASEND) THEN C----------------------------------------------------------------------- IF (FMOPT == 'A' .OR. FMOPT == ' ') THEN ! VSH - !Close daily output files. - CLOSE (NOUTDG) - CLOSE (NOUTPN) - CLOSE (NOUTPC) + !Close daily output files. + CLOSE (NOUTDG) + CLOSE (NOUTPN) + CLOSE (NOUTPC) END IF ! VSH !*********************************************************************** diff --git a/SPAM/ESR_SoilEvap.for b/SPAM/ESR_SoilEvap.for index cd7abe513..ea4922030 100644 --- a/SPAM/ESR_SoilEvap.for +++ b/SPAM/ESR_SoilEvap.for @@ -77,6 +77,7 @@ CALL GET("PM", "PMFRACTION", PMFRACTION) ES = 0.0 + ES_LYR = 0.0 !********************************************************************** ! NEW 4/18/2008 @@ -117,6 +118,7 @@ ENDIF ENDIF + ES_LYR = 0.0 DO L = 1, NLAYR !----------------------------------------------------------------------- SELECT CASE (ProfileType) @@ -126,6 +128,7 @@ ! Depth-dependant coefficients based on Ritchie spreadsheet 11/29/2006 A = 0.5 + 0.24 * DUL(L) B = -2.04 + 0.20 * DUL(L) + ES_Coef(L) = A * MEANDEP(L) ** B ! Equilibrium profile diff --git a/SPAM/ESR_SoilEvap_mod.for b/SPAM/ESR_SoilEvap_mod.for new file mode 100644 index 000000000..54de5c405 --- /dev/null +++ b/SPAM/ESR_SoilEvap_mod.for @@ -0,0 +1,230 @@ +!======================================================================= +! SALUS SOIL EVAPORATION MODULE - File ESR_SoilEvap.for +!======================================================================= +! ESR_SoilEvap_Mod, Subroutine, J. Ritchie, C. Porter +! +! Calculates actual soil evaporation (ES, mm/d) based on method +! described in: +! +! Ritchie, J.T., C.H. Porter, J.Judge, J.W.Jones, A.A. Suleiman. 2009. +! Application of a functional model for simulation of soil evaporation +! and water redistribution. Division S-1 -- soil Physics; +! Soil Science Society of America. in review. +! +! and +! +! Suleiman, A.A., J.T.Ritchie. Modeling Soil Water Redistribution +! during Second-Stage Evaporation. Division S-1 -- soil Physics; +! Soil Science Society of America. Vol. 67, No. 2. March-apr 2003. +! +! This routine takes the place of SOILEV and UPFLOW. +!----------------------------------------------------------------------- +! REVISION HISTORY +! 05/03/2005 JTR/CHP Written +! 07/05/2006 JTR/CHP Modified calculation of C_dry, function of depth +! only. Eliminate A and B coefficients. +! 04/08/2008 JTR modification for wet profile +! 05/29/2008 JTR added intermediate profile case +! 10/02/2008 CHP/JTR changed depth for determining evaporation case +! from 50 cm to 100 cm. +! 01/05/2025 CHP / AS Modified to take evaporation only from EvapDepth cm +!----------------------------------------------------------------------- +! Called by: SPAM +!======================================================================= + SUBROUTINE ESR_SoilEvap_mod(DYNAMIC, + & EOS, SOILPROP, SW, SWDELTS, !Input + & ES, ES_LYR) !Output + +!----------------------------------------------------------------------- + USE ModuleData + IMPLICIT NONE + SAVE + +! ------------------------------------------------ +! Interface Variables: + INTEGER, INTENT(IN) :: DYNAMIC + REAL, INTENT(IN) :: EOS !Potential soil evap (mm/d) + REAL, INTENT(IN) :: SW(NL) !Soil water content (cm3/cm3) + REAL, INTENT(IN) :: SWDELTS(NL) !Rate of drainage (cm3/cm3) + TYPE (SoilType), INTENT(IN) :: SOILPROP !Soil properties + + REAL, INTENT(OUT):: ES !Actual soil evaporation (mm/d) +! REAL, INTENT(OUT):: SWDELTU(NL) !Change in soil water (cm3/cm3) +! REAL, INTENT(OUT):: UPFLOW(NL) !Flow or N transport (cm/d) + REAL, INTENT(OUT):: ES_LYR(NL) !Actual soil evap by layer (mm/d) +! UPFLOW(1:NL) refers to water which moves up from layer L to +! layer L-1, and includes upflow from lower layers. + +! ------------------------------------------------ + + REAL, PARAMETER :: EvapDepth = 50. + INTEGER L, Levap, NLAYR, ProfileType + REAL A, B, RedFac, SW_threshold + REAL, DIMENSION(NL) :: DLAYR, DS, DUL, LL, MEANDEP, EvapFrac + REAL, DIMENSION(NL) :: SWAD, SWTEMP, SW_AVAIL, ES_Coef + REAL SWDELTEvap(NL) !Change in soil water (cm3/cm3) + REAL PMFRACTION + +!----------------------------------------------------------------------- +! ProfileType: +! 1 = Wet: SW > DUL in at least one layer in top 100 cm and +! SW > SW_threshold in top layer +! 2 = Intermediate: wet, but SW < SW_threshold in top layer +! 3 = Dry: SW < DUL in all layers in top 100 cm +!----------------------------------------------------------------------- + + DLAYR = SOILPROP % DLAYR + DS = SOILPROP % DS + DUL = SOILPROP % DUL + LL = SOILPROP % LL + +!*********************************************************************** +!*********************************************************************** +! Seasonal initialization - run once per season +!*********************************************************************** + IF (DYNAMIC .EQ. SEASINIT) THEN +!----------------------------------------------------------------------- + NLAYR = SOILPROP % NLAYR + CALL GET("PM", "PMFRACTION", PMFRACTION) + + ES = 0.0 + ES_LYR = 0.0 + +! Calculate the proportion of each soil layer within top 30 cm + EvapFrac = 0.0 !default to 0.0 for all layers + EvapFrac(1) = MIN(1.0, EvapDepth / DS(1)) !Top layer + Levap = 1 + DO L = 2, NLAYR + EvapFrac(L) = MIN(1.0, (EvapDepth - DS(L-1)) / DLAYR(L)) + Levap = L + IF (EvapFrac(L) < 1.0) THEN + EXIT + ENDIF + ENDDO + +!*********************************************************************** +! RATE CALCULATIONS +!*********************************************************************** + ELSEIF (DYNAMIC .EQ. RATE) THEN +!----------------------------------------------------------------------- +! NEW 4/18/2008 + ProfileType = 3 !assume dry profile until proven wet + DO L = 1, Levap +! Air dry water content + SWAD(L) = 0.30 * LL(L) !JTR 11/28/2006 + +! Mean depth for each soil layer + MEANDEP(L) = DS(L) - DLAYR(L) / 2. !cm + +! Pseudo-integraton step +! If increase in SW due to rain or irrigation, include half + IF (SWDELTS(L) > 0.0) THEN + SWTEMP(L) = SW(L) + 0.5 * SWDELTS(L) + ELSE +! If decrease in SW due to drainage, include all + SWTEMP(L) = SW(L) + SWDELTS(L) + ENDIF + +! If any layer in top 100 cm is wet, use wet profile method + IF (MEANDEP(L) < 100. .AND. SWTEMP(L) > DUL(L)) THEN + ProfileType = 1 + ENDIF + ENDDO + +! If wet profile, check for top layer SW below threshold. + IF (ProfileType == 1) THEN +! SW_threshold = DUL(1) - 0.05 !/ 0.13 * (DUL(1) - LL(1)) +! JTR 6/4/2008 +! Threshold WC = 0.275*DUL +1.165*DUL^2 + (1.2*DUL^3.75)*depth (center) + SW_threshold = 0.275*DUL(1) + 1.165*DUL(1)*DUL(1) + + & (1.2*DUL(1)**3.75)*MEANDEP(1) +! chp 6/4/2008 use DUL - 0.05, like before, but limit to air dry +! SW_threshold = MAX(SWAD(1), DUL(1) - 0.05) + IF (SWTEMP(1) < SW_threshold) THEN + ProfileType = 2 + ENDIF + ENDIF + + ES_LYR = 0.0 +! Calculate evaporation in the top EvapDepth cm + DO L = 1, Levap +!----------------------------------------------------------------------- + SELECT CASE (ProfileType) + +! Dry profile + CASE (3) + +!! Depth-dependant coefficients based on Ritchie spreadsheet 11/29/2006 +! A = 0.5 + 0.24 * DUL(L) +! B = -2.04 + 0.20 * DUL(L) + +! From Ayman Suilieman 2025-01-09 +! Use these equations above 15 cm; Below 15 cm just UPFLOW. +! from Suleiman Ritchie 2003 publication + A = 0.56 + 0.3 * DUL(L) + B = -1.99 + 0.22 * DUL(L) + + ES_Coef(L) = A * MEANDEP(L) ** B + +! Equilibrium profile + CASE (2) + ES_Coef(L) = 0.011 !for all depths + +! Wet profile + CASE (1) +! Ritchie spreadsheet of 5/28/08 + A = 0.26 !6/20/08 A = 0.14 !6/2/08 A = 0.42 !4/18/08 + B = -0.70 !6/20/08 B = -0.46 !6/2/08 B = -0.73 !4/18/08 + ES_Coef(L) = A * MEANDEP(L) ** B !function, no integration + + END SELECT + + ES_Coef(L) = ES_Coef(L) * EvapFrac(L) +!----------------------------------------------------------------------- + + SWDELTEvap(L) = -(SWTEMP(L) - SWAD(L)) * ES_Coef(L) !mm3/mm3 + +! Apply the fraction of plastic mulch coverage + IF (PMFRACTION .GT. 1.E-6) THEN + SWDELTEvap(L) = SWDELTEvap(L) * (1.0 - PMFRACTION) + END IF + +! Limit to available water + SW_AVAIL(L) = SW(L) + SWDELTS(L) - SWAD(L) + IF (-SWDELTEvap(L) > SW_AVAIL(L)) THEN + SWDELTEvap(L) = -SW_AVAIL(L) !mm3/mm3 + ENDIF + +! Limit to negative values (decrease SW) + SWDELTEvap(L) = AMIN1(0.0, SWDELTEvap(L)) + +! Aggregate soil evaporation from each layer + ES_LYR(L) = -SWDELTEvap(L) * DLAYR(L) * 10. !mm + ES = ES + ES_LYR(L) !profile sum (mm) + ENDDO + +! Limit total profile soil evaporation to potential soil evaporation + RedFac = 1.0 + If (ES > EOS) Then + RedFac = EOS / ES + ES_LYR = ES_LYR * RedFac + SWDELTEvap = SWDELTEvap * RedFac + ES = EOS + End If + +! UPFLOW = 0.0 +! UPFLOW(NLAYR) = ES_LYR(NLAYR) / 10. +! DO L = NLAYR-1, 1, -1 +! UPFLOW(L) = UPFLOW(L+1) + ES_LYR(L) / 10. !cm/d +! ENDDO + +!*********************************************************************** +!*********************************************************************** +! END OF DYNAMIC IF CONSTRUCT +!*********************************************************************** + ENDIF +!*********************************************************************** + RETURN + END SUBROUTINE ESR_SoilEvap_mod +!======================================================================= + diff --git a/SPAM/SPAM.for b/SPAM/SPAM.for index fe7c1f2a8..5ca81bf7b 100644 --- a/SPAM/SPAM.for +++ b/SPAM/SPAM.for @@ -24,6 +24,7 @@ C 04/01/2004 CHP/US Added Penman - Meyer routine for potential ET ! 10/16/2020 CHP Cumulative "soil" evaporation includes mulch and flood evap ! 01/26/2023 CHP Reduce compile warnings: add EXTERNAL stmts, remove ! unused variables, shorten lines. +! 01/10/2025 CHP Added modified Sulieman-Ritchie method per AS C----------------------------------------------------------------------- C Called by: Main C Calls: XTRACT, OPSPAM (File SPSUBS.for) @@ -39,7 +40,7 @@ C======================================================================= & PSTRES1, PORMIN, RLV, RWUMX, SOILPROP, SW, !Input & SWDELTS, UH2O, WEATHER, WINF, XHLAI, XLAI, !Input & FLOODWAT, SWDELTU, !I/O - & EO, EOP, EOS, EP, ES, RWU, SRFTEMP, ST, !Output + & EO, EOP, EOS, EP, ES, ES_LYR, RWU, SRFTEMP, ST, !Output & SWDELTX, TRWU, TRWUP, UPFLOW) !Output !----------------------------------------------------------------------- @@ -50,7 +51,7 @@ C======================================================================= IMPLICIT NONE EXTERNAL ETPHOT, STEMP_EPIC, STEMP, ROOTWU, SOILEV, TRANS EXTERNAL MULCH_EVAP, OPSPAM, PET, PSE, FLOOD_EVAP, ESR_SOILEVAP - EXTERNAL XTRACT + EXTERNAL XTRACT, ESR_SoilEvap_mod SAVE CHARACTER*1 IDETW, ISWWAT @@ -196,6 +197,11 @@ C======================================================================= & DLAYR, DUL, EOS, LL, SW, SW_AVAIL(1), !Input & U, WINF, !Input & ES) !Output +! ------------------------ + CASE ('M') ! Modified Sulieman-Ritchie soil evap routine + CALL ESR_SoilEvap_mod(DYNAMIC, + & EOS, SOILPROP, SW, SWDELTS, !Input + & ES, ES_LYR) !Output ! ---------------------------- END SELECT @@ -350,10 +356,14 @@ C======================================================================= SELECT CASE(MESEV) ! ------------------------ CASE ('S') ! Sulieman-Ritchie soil evaporation routine -! Note that this routine calculates UPFLOW, unlike the SOILEV. CALL ESR_SoilEvap( & EOS_SOIL, SOILPROP, SW, SWDELTS, !Input & ES, ES_LYR, SWDELTU, UPFLOW) !Output +! ------------------------ + CASE ('M') ! Modified Sulieman-Ritchie soil evap routine + CALL ESR_SoilEvap_mod(DYNAMIC, + & EOS_SOIL, SOILPROP, SW, SWDELTS, !Input + & ES, ES_LYR) !Output ! ------------------------ CASE DEFAULT ! CASE ('R') !Ritchie soil evaporation routine @@ -411,7 +421,7 @@ C======================================================================= ! (MEPHO = 'L' and MEEVP = 'Z'). CALL ETPHOT(CONTROL, ISWITCH, & PORMIN, PSTRES1, RLV, RWUMX, SOILPROP, ST, SW, !Input - & WEATHER, XLAI, !Input + & WEATHER, XLAI, !Input & EOP, EP, ES, RWU, TRWUP) !Output EVAP = ES !CHP / BK 7/13/2017 ENDIF diff --git a/SPAM/SPSUBS.for b/SPAM/SPSUBS.for index 51956ddda..c7a1dee7c 100644 --- a/SPAM/SPSUBS.for +++ b/SPAM/SPSUBS.for @@ -127,7 +127,7 @@ C----------------------------------------------------------------------- ENDIF END IF ! VSH - IF (ISWITCH % MESEV == 'S') THEN + IF (ISWITCH % MESEV == 'S'. OR. ISWITCH % MESEV == 'M') THEN ! Include soil evap by soil layer for Suleiman-Ritchie method IF (FMOPT == 'A' .OR. FMOPT == ' ') THEN ! VSH @@ -266,7 +266,7 @@ C----------------------------------------------------------------------- & AVTMN, REFA, EOAA, EOPA, EOSA, ETAA, EPAA, ESAA, EFAA, & EMAA, CEO, CET, CEP, CES, CEF, CEM, KCAA, KBSA, KEAA - IF (ISWITCH % MESEV == 'S') THEN + IF (ISWITCH % MESEV == 'S'. OR. ISWITCH % MESEV == 'M') THEN IF (SOILPROP % NLAYR < 11) THEN WRITE(LUN,'(12F8.3)') ES_LYR(1:N_LYR) , AVRWU, AVRWUP ELSE diff --git a/Soil/GHG/GHG_mod.for b/Soil/GHG/GHG_mod.for index 45b2f4507..432482b44 100644 --- a/Soil/GHG/GHG_mod.for +++ b/Soil/GHG/GHG_mod.for @@ -361,9 +361,9 @@ C----------------------------------------------------------------------- ! IDETL = ISWITCH % IDETL ! IF (INDEX('AD',IDETL) == 0) RETURN - IF (IDETN .EQ. 'Y') THEN + FROP = CONTROL % FROP - FROP = CONTROL % FROP + IF (IDETN .EQ. 'Y') THEN RNMODE = CONTROL % RNMODE REPNO = CONTROL % REPNO RUN = CONTROL % RUN @@ -451,7 +451,7 @@ C----------------------------------------------------------------------- ENDIF ENDIF ENDIF - + ENDIF ! Close FMOPT ! NDN20 = 0.0 @@ -477,13 +477,12 @@ C----------------------------------------------------------------------- CN2O_emitted = N2O_data % CN2O_emitted CN2_emitted = N2O_data % CN2_emitted CNO_emitted = N2O_data % CNO_emitted - - IF (IDETN == 'N') RETURN - IF (MOD(DAS, FROP) .NE. 0) RETURN + +! IF (IDETN == 'N') RETURN +! IF (MOD(DAS, FROP) .NE. 0) RETURN CALL YR_DOY(YRDOY, YEAR, DOY) - - + ! Conver Variables (CV) cvN2O_emitted = N2O_emitted*1000. cvN2_emitted = N2_emitted*1000. @@ -501,17 +500,17 @@ C----------------------------------------------------------------------- cvN2flux(I) = N2flux(I)*1000. cvNOflux(I) = NOflux(I)*1000. END DO - - IF (FMOPT == 'A' .OR. FMOPT == ' ') THEN ! FO-OPEN FILE - WRITE(FRMT2,'(A,A,A,I2.2,A,I2.2,A,I2.2,A)') + IF ((FMOPT == 'A' .OR. FMOPT == ' ') ! FO-ASCII output + & .AND. (IDETN .EQ. 'Y') ! N output requested + & .AND. (MOD(DAS, FROP) .EQ. 0)) THEN ! Every FROP days + WRITE(FRMT2,'(A,A,A,I2.2,A,I2.2,A,I2.2,A)') & '(1X,I4,1X,I3.3,I6,', & '3F8.2,F8.2,F8.1,4F8.3,', & '3F8.1, F8.1,I8,4F8.2,', & N_LYR, 'F8.1,', N_LYR,'F8.0,', 3*N_LYR, 'F8.1)' - IF (IDETN .EQ. 'Y') THEN - WRITE (GHGLUN,TRIM(FRMT2)) YEAR, DOY, DAS, + WRITE (GHGLUN,TRIM(FRMT2)) YEAR, DOY, DAS, & CN2O_emitted, CN2_emitted, CNO_emitted, & CNOX, CNITRIFY, CN2Odenit, CN2Onitrif, CN2, CNOflux, & cvN2O_emitted, cvN2_emitted, cvNO_emitted, @@ -520,9 +519,6 @@ C----------------------------------------------------------------------- & (cvDENITRIF(I), i=1,N_LYR), (cvNITRIF(I),I=1,N_LYR), & (cvN2Oflux(i), i=1,n_lyr), (cvN2flux(i),i=1,n_lyr), & (cvNOflux(i),i=1,n_lyr) - ENDIF - - ENDIF ! Close FMOPT C 05/01/2022 FO Added csv output for N2O.csv @@ -632,9 +628,9 @@ C 06/15/2014 CHP Written C----------------------------------------------------------------------- C Variable heading for GHG.OUT C----------------------------------------------------------------------- - IF (IDETN .EQ. 'Y') THEN + FROP = CONTROL % FROP - FROP = CONTROL % FROP + IF (IDETN .EQ. 'Y') THEN RNMODE = CONTROL % RNMODE REPNO = CONTROL % REPNO RUN = CONTROL % RUN @@ -693,8 +689,8 @@ C----------------------------------------------------------------------- C----------------------------------------------------------------------- ! IF (INDEX('AD',IDETL) == 0) RETURN - IF (IDETN == 'N') RETURN - IF (MOD(DAS, FROP) .NE. 0) RETURN +! IF (IDETN == 'N') RETURN +! IF (MOD(DAS, FROP) .NE. 0) RETURN CALL YR_DOY(YRDOY, YEAR, DOY) @@ -731,7 +727,7 @@ C----------------------------------------------------------------------- ! Total CO2-equivalent TCEQC = CCEQC + NCEQC + MCEQC - IF (IDETN .EQ. 'Y') THEN + IF (IDETN .EQ. 'Y' .AND. MOD(DAS, FROP) == 0) THEN WRITE (GHGLUN,'(I5,I4.3,I6,2I9,2F9.2,2I9,2F9.2,4I9)') & YEAR, DOY, DAS, & NINT(CO2GED), NINT(CO2END), N2OGED, CH4GED, diff --git a/Soil/GHG/Methane.for b/Soil/GHG/Methane.for index 321077dbd..8f95e1665 100644 --- a/Soil/GHG/Methane.for +++ b/Soil/GHG/Methane.for @@ -24,7 +24,7 @@ C======================================================================= INTEGER n1,NLAYR,i,j, DYNAMIC REAL dlayr(NL),SW(NL),DLL(NL),RLV(NL),CSubstrate(NL),BD(NL), - & Buffer(NL,2),afp(NL), SAEA(NL), SAT(NL), DUL(NL) + & Buffer(NL,2),afp(NL), SAEA(NL) !, SAT(NL), DUL(NL) REAL, DIMENSION(0:NL) :: newCO2 REAL drain,flood,x,CH4Emission,buffconc,rCO2, & rCH4,TCH4Substrate,rbuff,afpmax, diff --git a/Soil/GHG/diffusiv.for b/Soil/GHG/diffusiv.for index db375d8b0..961430eb1 100644 --- a/Soil/GHG/diffusiv.for +++ b/Soil/GHG/diffusiv.for @@ -23,7 +23,7 @@ type (SoilType), intent(in) :: SOILPROP real, dimension(NL) :: dul, bd, poros - real, dimension(NL) :: dD0_fc, dD0_DayCent, ratio + real, dimension(NL) :: dD0_fc, dD0_DayCent !, ratio real POROSer REAL PFC, VFRAC, THETA_V, THETA_P, THETA_A, S_WAT, SW_P REAL TP1, TP2, TP3, TP4, TP5, TP6, TP7, TP8 @@ -147,8 +147,9 @@ dD0_DayCent(L) = MAX(0.0, (TP8/1.E7 + TP7 * TP6)) !***************************************************************************** -! compare with Shcherbak method - ratio(L) = dD0_DayCent(L) / dD0_fc(L) +!! compare with Shcherbak method +! ratio(L) = dD0_DayCent(L) / dD0_fc(L) + enddo dD0 = dD0_DayCent diff --git a/Soil/SOIL.for b/Soil/SOIL.for index b0ea97aef..6193bd88d 100644 --- a/Soil/SOIL.for +++ b/Soil/SOIL.for @@ -34,7 +34,7 @@ C===================================================================== SUBROUTINE SOIL(CONTROL, ISWITCH, - & ES, FERTDATA, FracRts, HARVRES, IRRAMT, !Input + & ES, ES_LYR, FERTDATA, FracRts, HARVRES, IRRAMT, !Input & KTRANS, KUptake, OMAData, PUptake, RLV, !Input & SENESCE, ST, SWDELTX,TILLVALS, UNH4, UNO3, !Input & WEATHER, XHLAI, !Input @@ -58,7 +58,7 @@ C===================================================================== TYPE (SwitchType) , INTENT(IN) :: ISWITCH REAL , INTENT(IN) :: ES TYPE (FertType) , INTENT(IN) :: FERTDATA - REAL, DIMENSION(NL), INTENT(IN) :: FracRts + REAL, DIMENSION(NL), INTENT(IN) :: FracRts, ES_LYR Type (ResidueType) , INTENT(IN) :: HARVRES REAL , INTENT(IN) :: IRRAMT REAL , INTENT(IN) :: KTRANS @@ -133,7 +133,7 @@ C===================================================================== ! Call WATBAL first for all except seasonal initialization IF (DYNAMIC /= SEASINIT) THEN CALL WATBAL(CONTROL, ISWITCH, - & ES, IRRAMT, SOILPROP, SWDELTX, !Input + & ES, ES_LYR, IRRAMT, SOILPROP, SWDELTX, !Input & TILLVALS, WEATHER, !Input & FLOODWAT, MULCH, SWDELTU, !I/O & DRAIN, DRN, SNOW, SW, SWDELTS, !Output @@ -183,7 +183,7 @@ C===================================================================== IF (DYNAMIC == SEASINIT) THEN ! Soil water balance -- call last for initialization CALL WATBAL(CONTROL, ISWITCH, - & ES, IRRAMT, SOILPROP, SWDELTX, !Input + & ES, ES_LYR, IRRAMT, SOILPROP, SWDELTX, !Input & TILLVALS, WEATHER, !Input & FLOODWAT, MULCH, SWDELTU, !I/O & DRAIN, DRN, SNOW, SW, SWDELTS, !Output diff --git a/Soil/SoilWater/WATBAL.for b/Soil/SoilWater/WATBAL.for index e75cbda94..92a74d19f 100644 --- a/Soil/SoilWater/WATBAL.for +++ b/Soil/SoilWater/WATBAL.for @@ -49,7 +49,7 @@ C SATFLO (File SATFLO.for) C======================================================================= SUBROUTINE WATBAL(CONTROL, ISWITCH, !Input - & ES, IRRAMT, SOILPROP, SWDELTX, !Input + & ES, ES_LYR, IRRAMT, SOILPROP, SWDELTX, !Input & TILLVALS, WEATHER, !Input & FLOODWAT, MULCH, SWDELTU, !I/O & DRAIN, DRN, SNOW, SW, SWDELTS, !Output @@ -62,7 +62,7 @@ C======================================================================= IMPLICIT NONE EXTERNAL IPWBAL, TILEDRAIN, WBSUM, SNOWFALL, & MULCHWATER, WBAL, OPWBAL, RNOFF, INFIL, SATFLO, UP_FLOW, - & SOILMIXING, SUMSW, WTDEPT, WaterTable + & SOILMIXING, SUMSW, WTDEPT, WaterTable, OPSWBL SAVE !----------------------------------------------------------------------- ! Interface variables: @@ -71,6 +71,7 @@ C======================================================================= TYPE (ControlType), INTENT(IN) :: CONTROL TYPE (SwitchType) , INTENT(IN) :: ISWITCH REAL , INTENT(IN) :: ES + REAL, DIMENSION(NL),INTENT(IN) :: ES_LYR REAL , INTENT(IN) :: IRRAMT TYPE (SoilType) , INTENT(IN) :: SOILPROP REAL, DIMENSION(NL),INTENT(IN) :: SWDELTX @@ -419,7 +420,6 @@ C Conflict with CERES-Wheat C Calculate upward movement of water due to evaporation and root C extraction (based on yesterday's values) for each soil layer. -! Don't call when using SALUS soil evaporation routine (MESEV = 'S') CALL UP_FLOW( & NLAYR, DLAYR, DUL, LL, SAT, SW, SW_AVAIL, !Input & UPFLOW, SWDELTU) !Output @@ -469,11 +469,19 @@ C extraction (based on yesterday's values) for each soil layer. ! CALL SUMSW(NLAYR, DLAYR, SW, SWTOT1) - IF (MESEV .NE. 'S' .OR. MEEVP == 'Z') THEN -! Perform integration of soil water fluxes -! Subtract soil evaporation from layer 1 - SW(1) = SW(1) - 0.1 * ES / DLAYR_YEST(1) - ENDIF + SELECT CASE(MESEV) + CASE ('M') !Subtract ES from top 15 cm + DO L = 1, NLAYR + SW(L) = SW(L) - 0.1 * ES_LYR(L) / DLAYR_YEST(L) + ENDDO + + CASE DEFAULT + IF (MESEV .NE. 'S' .OR. MEEVP == 'Z') THEN +! Perform integration of soil water fluxes +! Subtract soil evaporation from layer 1 + SW(1) = SW(1) - 0.1 * ES / DLAYR_YEST(1) + ENDIF + END SELECT ! Perform integration of soil water fluxes DO L = 1, NLAYR