diff --git a/CMakeLists.txt b/CMakeLists.txt index 8c345d183..fecc8acc1 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -193,6 +193,7 @@ set( "Management/Tillage.for" "Management/TillEvent.for" "Plant/plant.for" + "Plant/ECO_read.for" "Plant/ALOHA-Pineapple/Aloha_GROSUB.for" "Plant/ALOHA-Pineapple/Aloha_mod.f90" "Plant/ALOHA-Pineapple/Aloha_NFACTO.for" diff --git a/Data/Genotype/AMGRO048.ECO b/Data/Genotype/AMGRO048.ECO index aefa62b12..cf6ed98a4 100644 --- a/Data/Genotype/AMGRO048.ECO +++ b/Data/Genotype/AMGRO048.ECO @@ -45,7 +45,8 @@ ! SLOBI Slope of relationship reducing progress toward flowering if ! TMIN for the day is less than OPTBI ! -@ECO# ECONAME.......... MG TM PP-SS PL-EM EM-V1 V1-JU JU-R0 PM06 PM09 LNHSH R7-R8 FL-VS TRIFL RWDTH RHGHT R1PPO OPTBI SLOBI +!ECO# ECONAME.......... MG TM PP-SS PL-EM EM-V1 V1-JU JU-R0 PM06 PM09 LNHSH R7-R8 FL-VS TRIFL RWDTH RHGHT R1PPO OPTBI SLOBI +@ECO# ECONAME.......... MG TM THVAR PL-EM EM-V1 V1-JU JU-R0 PM06 PM09 LNGSH R7-R8 FL-VS TRIFL RWDTH RHGHT R1PPO OPTBI SLOBI ! 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 !Calibration N N N P P N N N G G P G G G G P P P diff --git a/Data/Genotype/BRGRO048.ECO b/Data/Genotype/BRGRO048.ECO index 0bdef9e59..147b805ca 100644 --- a/Data/Genotype/BRGRO048.ECO +++ b/Data/Genotype/BRGRO048.ECO @@ -45,7 +45,8 @@ ! SLOBI Slope of relationship reducing progress toward flowering if ! TMIN for the day is less than OPTBI ! -@ECO# ECONAME.......... MG TM PP-SS PL-EM EM-V1 V1-JU JU-R0 PM06 PM09 LNHSH R7-R8 FL-VS TRIFL RWDTH RHGHT R1PPO OPTBI SLOBI +!ECO# ECONAME.......... MG TM PP-SS PL-EM EM-V1 V1-JU JU-R0 PM06 PM09 LNHSH R7-R8 FL-VS TRIFL RWDTH RHGHT R1PPO OPTBI SLOBI +@ECO# ECONAME.......... MG TM THVAR PL-EM EM-V1 V1-JU JU-R0 PM06 PM09 LNGSH R7-R8 FL-VS TRIFL RWDTH RHGHT R1PPO OPTBI SLOBI ! 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 BR0001 DEFAULT BRACHI 00 01 1.00 3.0 6.0 9999. 9999. 0.0 0.75 10.0 9999. 9999. 0.10 1.0 1.0 .000 0.0 .000 DFAULT DEFAULT ECOTYPE 00 01 1.00 0.0 0.0 9999. 9999. 0.0 0.75 10.0 9999. 9999. 0.10 1.0 1.0 .000 0.0 .000 diff --git a/Data/Genotype/CBGRO048.ECO b/Data/Genotype/CBGRO048.ECO index 06d4c5dab..3e11695a6 100644 --- a/Data/Genotype/CBGRO048.ECO +++ b/Data/Genotype/CBGRO048.ECO @@ -45,7 +45,8 @@ ! SLOBI Slope of relationship reducing progress toward flowering if ! TMIN for the day is less than OPTBI ! -@ECO# ECONAME.......... MG TM PP-SS PL-EM EM-V1 V1-JU JU-R0 PM06 PM09 LNHSH R7-R8 FL-VS TRIFL RWDTH RHGHT R1PPO OPTBI SLOBI +!ECO# ECONAME.......... MG TM PP-SS PL-EM EM-V1 V1-JU JU-R0 PM06 PM09 LNHSH R7-R8 FL-VS TRIFL RWDTH RHGHT R1PPO OPTBI SLOBI +@ECO# ECONAME.......... MG TM THVAR PL-EM EM-V1 V1-JU JU-R0 PM06 PM09 LNGSH R7-R8 FL-VS TRIFL RWDTH RHGHT R1PPO OPTBI SLOBI ! 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 !Calibration N N N N N N N N G G P G G G G N N N @@ -55,4 +56,4 @@ CB0401 CABBAGE TYPE 1 04 01 0.0 3.6 6.0 0.0 05.0 0.0 0.35 25.0 12.0 35.00 0.38 1.0 1.0 .000 20.0 .035 CB0402 CABBAGE TYPE 2 04 01 0.0 3.6 6.0 0.0 05.0 0.0 0.35 25.0 12.0 39.00 0.38 1.0 1.0 .000 20.0 .035 CB0403 Kalorama 04 01 0.0 3.6 6.0 0.0 05.0 0.0 0.35 25.0 12.0 23.00 0.45 1.8 1.2 .000 20.0 .035 -DFAULT DEFAULT TYPE 04 01 0.0 3.6 6.0 0.0 05.0 0.0 0.35 25.0 12.0 39.00 0.38 1.0 1.0 .000 20.0 .035 \ No newline at end of file +DFAULT DEFAULT TYPE 04 01 0.0 3.6 6.0 0.0 05.0 0.0 0.35 25.0 12.0 39.00 0.38 1.0 1.0 .000 20.0 .035 diff --git a/Data/Genotype/CPGRO048.ECO b/Data/Genotype/CPGRO048.ECO index 6d433267d..a2d5c0e91 100644 --- a/Data/Genotype/CPGRO048.ECO +++ b/Data/Genotype/CPGRO048.ECO @@ -48,7 +48,8 @@ ! TMIN for the day is less than OPTBI ! PM09 is 1.35 for CP0410. Not good. Parameter cannot exceed 1.00 ! -@ECO# ECONAME.......... MG TM PP-SS PL-EM EM-V1 V1-JU JU-R0 PM06 PM09 LNHSH R7-R8 FL-VS TRIFL RWDTH RHGHT R1PPO OPTBI SLOBI +!ECO# ECONAME.......... MG TM PP-SS PL-EM EM-V1 V1-JU JU-R0 PM06 PM09 LNHSH R7-R8 FL-VS TRIFL RWDTH RHGHT R1PPO OPTBI SLOBI +@ECO# ECONAME.......... MG TM THVAR PL-EM EM-V1 V1-JU JU-R0 PM06 PM09 LNGSH R7-R8 FL-VS TRIFL RWDTH RHGHT R1PPO OPTBI SLOBI ! 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 !Calibration N N N P P N N N G G P G G G G N N N diff --git a/Data/Genotype/FBGRO048.ECO b/Data/Genotype/FBGRO048.ECO index ce1c206ad..28995d093 100644 --- a/Data/Genotype/FBGRO048.ECO +++ b/Data/Genotype/FBGRO048.ECO @@ -48,7 +48,8 @@ ! 4/11/23 reduced PL-EM from 6.0 to 4.0 to recover time to emergence, V1, and anthesis. ! Exe has soil temp fix. Soil temp 2-3C cooler now -@ECO# ECONAME.......... MG TM PP-SS PL-EM EM-V1 V1-JU JU-R0 PM06 PM09 LNHSH R7-R8 FL-VS TRIFL RWDTH RHGHT R1PPO OPTBI SLOBI +!ECO# ECONAME.......... MG TM PP-SS PL-EM EM-V1 V1-JU JU-R0 PM06 PM09 LNHSH R7-R8 FL-VS TRIFL RWDTH RHGHT R1PPO OPTBI SLOBI +@ECO# ECONAME.......... MG TM THVAR PL-EM EM-V1 V1-JU JU-R0 PM06 PM09 LNGSH R7-R8 FL-VS TRIFL RWDTH RHGHT R1PPO OPTBI SLOBI ! 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 !Calibration N N N P P N N N G G P G G G G N N N diff --git a/Data/Genotype/LTGRO048.ECO b/Data/Genotype/LTGRO048.ECO index d0a1a464b..4177f82c7 100644 --- a/Data/Genotype/LTGRO048.ECO +++ b/Data/Genotype/LTGRO048.ECO @@ -46,7 +46,8 @@ ! TMIN for the day is less than OPTBI ! -@ECO# ECONAME.......... MG TM PP-SS PL-EM EM-V1 V1-JU JU-R0 PM06 PM09 LNHSH R7-R8 FL-VS TRIFL RWDTH RHGHT R1PPO OPTBI SLOBI +!ECO# ECONAME.......... MG TM PP-SS PL-EM EM-V1 V1-JU JU-R0 PM06 PM09 LNHSH R7-R8 FL-VS TRIFL RWDTH RHGHT R1PPO OPTBI SLOBI +@ECO# ECONAME.......... MG TM THVAR PL-EM EM-V1 V1-JU JU-R0 PM06 PM09 LNGSH R7-R8 FL-VS TRIFL RWDTH RHGHT R1PPO OPTBI SLOBI ! 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 !Calibration N N N P P N N N G G P G G G G N N N diff --git a/Data/Genotype/PRGRO048.ECO b/Data/Genotype/PRGRO048.ECO index 06915a3bc..0bb6a83de 100644 --- a/Data/Genotype/PRGRO048.ECO +++ b/Data/Genotype/PRGRO048.ECO @@ -46,7 +46,8 @@ ! TMIN for the day is less than OPTBI ! XMAGE Photothermal time required for Multi-harvest ! -@ECO# ECONAME.......... MG TM PP-SS PL-EM EM-V1 V1-JU JU-R0 PM06 PM09 LNHSH R7-R8 FL-VS TRIFL RWDTH RHGHT R1PPO OPTBI SLOBI XMAGE +!ECO# ECONAME.......... MG TM PP-SS PL-EM EM-V1 V1-JU JU-R0 PM06 PM09 LNHSH R7-R8 FL-VS TRIFL RWDTH RHGHT R1PPO OPTBI SLOBI XMAGE +@ECO# ECONAME.......... MG TM THVAR PL-EM EM-V1 V1-JU JU-R0 PM06 PM09 LNGSH R7-R8 FL-VS TRIFL RWDTH RHGHT R1PPO OPTBI SLOBI XMAGE ! 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 !Calibration N N N N N N N G G G N G G G G N N N G diff --git a/Data/Genotype/SBGRO048.CUL b/Data/Genotype/SBGRO048.CUL index 04187fcc9..ec3cdfb69 100644 --- a/Data/Genotype/SBGRO048.CUL +++ b/Data/Genotype/SBGRO048.CUL @@ -117,8 +117,10 @@ CCCA01 SAMIRA 1 . SB0401 13.09 0.294 19.4 7.0 15.0 34.50 26.00 1 IB0045 DON MARIO (4) . SB0501 12.95 0.294 15.0 9.7 19.4 35.10 26.00 1.200 390. 200.0 1.00 0.19 21.0 2.10 16.0 78.0 .400 .200 IB0056 ASGROW (4) . SB0401 13.20 0.294 12.5 8.5 15.0 28.00 26.00 1.250 400. 200.0 1.00 0.19 21.0 2.10 12.0 77.0 .405 .205 -RB0002 MG77PA (13) . SB0777 11.80 0.325 25.0 5.0 10.5 27.50 22.00 1.200 365. 230.0 1.00 0.150 18.2 2.00 10. 76.0 .400 .200 -RB0003 MG88PA (11) . SB0888 11.50 0.340 24.5 8.2 12.0 25.00 18.00 1.175 388. 216.0 1.00 0.160 25.0 2.06 10. 78.0 .400 .200 +!RB0002 MG77PA (13) . SB0777 11.80 0.325 25.0 5.0 10.5 27.50 22.00 1.200 365. 230.0 1.00 0.150 18.2 2.00 10. 76.0 .400 .200 +!RB0003 MG88PA (11) . SB0888 11.50 0.340 24.5 8.2 12.0 25.00 18.00 1.175 388. 216.0 1.00 0.160 25.0 2.06 10. 78.0 .400 .200 +RB0002 MG77PA (13) . DFAULT 11.80 0.325 25.0 5.0 10.5 27.50 22.00 1.200 365. 230.0 1.00 0.150 18.2 2.00 10. 76.0 .400 .200 +RB0003 MG88PA (11) . DFAULT 11.50 0.340 24.5 8.2 12.0 25.00 18.00 1.175 388. 216.0 1.00 0.160 25.0 2.06 10. 78.0 .400 .200 ! Brazil 990248 BRS 399 . SB0601 12.58 0.311 20.4 8.2 13.7 28.70 18.00 1.030 335. 180.0 1.00 0.19 23.0 2.40 10.0 78.0 .400 .200 \ No newline at end of file diff --git a/Data/Genotype/SRGRO048.ECO b/Data/Genotype/SRGRO048.ECO index 027ebd98e..e06f3b20c 100644 --- a/Data/Genotype/SRGRO048.ECO +++ b/Data/Genotype/SRGRO048.ECO @@ -48,7 +48,7 @@ ! @ECO# ECONAME.......... MG TM THVAR PL-EM EM-V1 V1-JU JU-R0 PM06 PM09 LNGSH R7-R8 FL-VS TRIFL RWDTH RHGHT R1PPO OPTBI SLOBI XMAGE XFPHT XFINT ! - 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 +! 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 !Calibration N N N N N N N N N G N G G G G N N N G G G 999991 MINIMA . . 0.0 6.0 22.0 0.0 05.0 0.0 0.99 8.0 0.0 70.0 0.36 0.9 0.9 .000 00.0 .000 9.0 58.0 0.18 diff --git a/Data/Genotype/VBGRO048.ECO b/Data/Genotype/VBGRO048.ECO index 700b9638e..02cf70293 100644 --- a/Data/Genotype/VBGRO048.ECO +++ b/Data/Genotype/VBGRO048.ECO @@ -45,7 +45,8 @@ ! SLOBI Slope of relationship reducing progress toward flowering if ! TMIN for the day is less than OPTBI ! -@ECO# ECONAME.......... MG TM PP-SS PL-EM EM-V1 V1-JU JU-R0 PM06 PM09 LNHSH R7-R8 FL-VS TRIFL RWDTH RHGHT R1PPO OPTBI SLOBI +!ECO# ECONAME.......... MG TM PP-SS PL-EM EM-V1 V1-JU JU-R0 PM06 PM09 LNHSH R7-R8 FL-VS TRIFL RWDTH RHGHT R1PPO OPTBI SLOBI +@ECO# ECONAME.......... MG TM THVAR PL-EM EM-V1 V1-JU JU-R0 PM06 PM09 LNGSH R7-R8 FL-VS TRIFL RWDTH RHGHT R1PPO OPTBI SLOBI ! 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 !Calibration N N N P P N N N G G P G G G G N N N diff --git a/Plant/CROPGRO/CANOPY.for b/Plant/CROPGRO/CANOPY.for index 8b9c209b9..d5a69a4d3 100644 --- a/Plant/CROPGRO/CANOPY.for +++ b/Plant/CROPGRO/CANOPY.for @@ -19,25 +19,26 @@ C Calls : ERROR, FIND, IGNORE C======================================================================== SUBROUTINE CANOPY(DYNAMIC, - & ECONO, FILECC, FILEGC, KCAN, PAR, ROWSPC, !Input +! & ECONO, FILECC, FILEGC, KCAN, PAR, ROWSPC, !Input + & FILECC, KCAN, PAR, ROWSPC, !Input & RVSTGE, TGRO, TURFAC, VSTAGE, XLAI, NSTRES, !Input & CANHT, CANWH) !Output C----------------------------------------------------------------------- USE ModuleDefs IMPLICIT NONE - EXTERNAL GETLUN, FIND, ERROR, IGNORE, TABEX + EXTERNAL GETLUN, FIND, ERROR, IGNORE, TABEX, ECO_read SAVE CHARACTER*6 ERRKEY PARAMETER (ERRKEY = 'CANOPY') CHARACTER*6 SECTION - CHARACTER*6 ECOTYP, ECONO - CHARACTER*92 FILECC, FILEGC +! CHARACTER*6 ECOTYP, ECONO + CHARACTER*92 FILECC !, FILEGC CHARACTER*255 C255 - INTEGER I, II, LUNCRP, LUNECO, ERR, LINC, LNUM, ISECT + INTEGER I, II, LUNCRP, ERR, LINC, LNUM, ISECT !, LUNECO INTEGER DYNAMIC INTEGER FOUND @@ -134,31 +135,34 @@ C----------------------------------------------------------------------- C----------------------------------------------------------------------- C Read Ecotype Parameter File C----------------------------------------------------------------------- - CALL GETLUN('FILEE', LUNECO) - OPEN (LUNECO,FILE = FILEGC,STATUS = 'OLD',IOSTAT=ERR) - IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILEGC,0) - ECOTYP = ' ' - LNUM = 0 - DO WHILE (ECOTYP .NE. ECONO) - CALL IGNORE(LUNECO, LNUM, ISECT, C255) - IF ((ISECT .EQ. 1) .AND. (C255(1:1) .NE. ' ') .AND. - & (C255(1:1) .NE. '*')) THEN - READ (C255,'(A6,90X,2(1X,F5.0))',IOSTAT=ERR) - & ECOTYP, RWIDTH, RHGHT - IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILEGC,LNUM) - IF (ECOTYP .EQ. ECONO) THEN - EXIT - ENDIF - - ELSE IF (ISECT .EQ. 0) THEN - IF (ECONO .EQ. 'DFAULT') CALL ERROR(ERRKEY,35,FILEGC,LNUM) - ECONO = 'DFAULT' - REWIND(LUNECO) - LNUM = 0 - ENDIF - ENDDO +! CALL GETLUN('FILEE', LUNECO) +! OPEN (LUNECO,FILE = FILEGC,STATUS = 'OLD',IOSTAT=ERR) +! IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILEGC,0) +! ECOTYP = ' ' +! LNUM = 0 +! DO WHILE (ECOTYP .NE. ECONO) +! CALL IGNORE(LUNECO, LNUM, ISECT, C255) +! IF ((ISECT .EQ. 1) .AND. (C255(1:1) .NE. ' ') .AND. +! & (C255(1:1) .NE. '*')) THEN +! READ (C255,'(A6,90X,2(1X,F5.0))',IOSTAT=ERR) +! & ECOTYP, RWIDTH, RHGHT +! IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILEGC,LNUM) +! IF (ECOTYP .EQ. ECONO) THEN +! EXIT +! ENDIF +! +! ELSE IF (ISECT .EQ. 0) THEN +! IF (ECONO .EQ. 'DFAULT') CALL ERROR(ERRKEY,35,FILEGC,LNUM) +! ECONO = 'DFAULT' +! REWIND(LUNECO) +! LNUM = 0 +! ENDIF +! ENDDO +! +! CLOSE (LUNECO) - CLOSE (LUNECO) + CALL ECO_read('RWDTH', RWIDTH) + CALL ECO_read('RHGHT', RHGHT) CANHT = 0.0 CANWH = 0.0 diff --git a/Plant/CROPGRO/CROPGRO.for b/Plant/CROPGRO/CROPGRO.for index 23521e629..84ada235c 100644 --- a/Plant/CROPGRO/CROPGRO.for +++ b/Plant/CROPGRO/CROPGRO.for @@ -345,7 +345,8 @@ C----------------------------------------------------------------------- !----------------------------------------------------------------------- CALL VEGGR (RUNINIT, & AGRLF, AGRRT, AGRSTM, CMINEP, CSAVEV, DTX, !Input - & DXR57, ECONO, FILECC, FILEGC, FNINL, FNINR, !Input +! & DXR57, ECONO, FILECC, FILEGC, FNINL, FNINR, !Input + & DXR57, FILECC, FNINL, FNINR, !Input & FNINS, KCAN, NAVL, NDMNEW, NDMOLD, !Input & NFIXN, NMINEA, NR1, PAR, PCH2O, PG, PGAVL, !Input & PStres2, ROWSPC, RVSTGE, STMWT, TGRO, !Input @@ -614,7 +615,8 @@ C Initialize pest coupling point and damage variables !----------------------------------------------------------------------- CALL VEGGR (SEASINIT, & AGRLF, AGRRT, AGRSTM, CMINEP, CSAVEV, DTX, !Input - & DXR57, ECONO, FILECC, FILEGC, FNINL, FNINR, !Input +! & DXR57, ECONO, FILECC, FILEGC, FNINL, FNINR, !Input + & DXR57, FILECC, FNINL, FNINR, !Input & FNINS, KCAN, NAVL, NDMNEW, NDMOLD, !Input & NFIXN, NMINEA, NR1, PAR, PCH2O, PG, PGAVL, !Input & PStres2, ROWSPC, RVSTGE, STMWT, TGRO, !Input @@ -838,7 +840,8 @@ C----------------------------------------------------------------------- !----------------------------------------------------------------------- CALL VEGGR(EMERG, & AGRLF, AGRRT, AGRSTM, CMINEP, CSAVEV, DTX, !Input - & DXR57, ECONO, FILECC, FILEGC, FNINL, FNINR, !Input +! & DXR57, ECONO, FILECC, FILEGC, FNINL, FNINR, !Input + & DXR57, FILECC, FNINL, FNINR, !Input & FNINS, KCAN, NAVL, NDMNEW, NDMOLD, !Input & NFIXN, NMINEA, NR1, PAR, PCH2O, PG, PGAVL, !Input & PStres2, ROWSPC, RVSTGE, STMWT, TGRO, !Input @@ -1149,7 +1152,8 @@ C Call routine to compute actual vegetative growth, C to mine or add C----------------------------------------------------------------------- CALL VEGGR(INTEGR, & AGRLF, AGRRT, AGRSTM, CMINEP, CSAVEV, DTX, !Input - & DXR57, ECONO, FILECC, FILEGC, FNINL, FNINR, !Input +! & DXR57, ECONO, FILECC, FILEGC, FNINL, FNINR, !Input + & DXR57, FILECC, FNINL, FNINR, !Input & FNINS, KCAN, NAVL, NDMNEW, NDMOLD, !Input & NFIXN, NMINEA, NR1, PAR, PCH2O, PG, PGAVL, !Input & PStres2, ROWSPC, RVSTGE, STMWT, TGRO, !Input diff --git a/Plant/CROPGRO/DEMAND.for b/Plant/CROPGRO/DEMAND.for index ccec9e019..7986f0f85 100644 --- a/Plant/CROPGRO/DEMAND.for +++ b/Plant/CROPGRO/DEMAND.for @@ -712,20 +712,20 @@ C 24 changed to TS by Bruce Kimball on 3Jul17 !----------------------------------------------------------------------- IMPLICIT NONE - EXTERNAL GETLUN, ERROR, FIND, IGNORE, WARNING + EXTERNAL GETLUN, ERROR, FIND, IGNORE, WARNING, ECO_read !----------------------------------------------------------------------- CHARACTER*3 TYPSDT CHARACTER*6 ERRKEY PARAMETER (ERRKEY = 'IPDMND') CHARACTER*6 SECTION - CHARACTER*6 ECOTYP, ECONO + CHARACTER*6 ECONO !, ECOTYP, CHARACTER*30 FILEIO - CHARACTER*78 MSG(4) +! CHARACTER*78 MSG(4) CHARACTER*80 C80 CHARACTER*92 FILECC, FILEGC - CHARACTER*255 C255 +! CHARACTER*255 C255 - INTEGER LUNCRP, LUNIO, LUNECO, ERR, LINC, LNUM, FOUND, ISECT + INTEGER LUNCRP, LUNIO, ERR, LINC, LNUM, FOUND, ISECT !, LUNECO INTEGER I, II REAL CARMIN, FINREF, FRLFF, FRLFMX, FRSTMF, @@ -965,49 +965,59 @@ C 24 changed to TS by Bruce Kimball on 3Jul17 !----------------------------------------------------------------------- ! Read Ecotype Parameter File !----------------------------------------------------------------------- - CALL GETLUN('FILEE', LUNECO) - OPEN (LUNECO,FILE = FILEGC,STATUS = 'OLD',IOSTAT=ERR) - IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILEGC,0) - ECOTYP = ' ' - LNUM = 0 - DO WHILE (ECOTYP .NE. ECONO) - CALL IGNORE(LUNECO, LNUM, ISECT, C255) - IF ((ISECT .EQ. 1) .AND. (C255(1:1) .NE. ' ') .AND. - & (C255(1:1) .NE. '*')) THEN -! READ (C255,'(A6,66X,F6.0,30X,3F6.0)',IOSTAT=ERR) -! & ECOTYP, LNGSH, THRESH, SDPRO, SDLIP - READ (C255,'(A6,66X,F6.0,54X,2(F6.0))',IOSTAT=ERR) ECOTYP, - & LNGSH, XFPHT, XFINT - IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILEGC,LNUM) - IF (ECOTYP .EQ. ECONO) THEN - EXIT - ENDIF - - ELSE IF (ISECT .EQ. 0) THEN - IF (ECONO .EQ. 'DFAULT') CALL ERROR(ERRKEY,35,FILEGC,LNUM) - ECONO = 'DFAULT' - REWIND(LUNECO) - LNUM = 0 - ENDIF - ENDDO - - IF(XFPHT .LT. 0.0) THEN - MSG(1) = 'Ecotype coefficient is not properly defined.' - MSG(2) = 'Time required to reach maximum partitioning to ' - MSG(3) = 'pod/fruit. (photothermal days)' - MSG(4) = 'XFPHT must be greater then 0.0.' - CALL WARNING (4, ERRKEY, MSG) - CALL ERROR(ERRKEY,1,FILEGC,0) - ELSE IF(XFINT .LT. 0.0 .OR. XFINT .GT. 1.0) THEN - MSG(1) = 'Ecotype Coefficients is not properly defined.' - MSG(2) = 'Initial partitioning to pod/fruit during early ' - MSG(3) = 'pod/fruit growth.' - MSG(4) = 'XFINT must be between/included 0.0 and 1.0.' - CALL WARNING (4, ERRKEY, MSG) - CALL ERROR(ERRKEY,2,FILEGC,0) - ENDIF - - CLOSE (LUNECO) +! CALL GETLUN('FILEE', LUNECO) +! OPEN (LUNECO,FILE = FILEGC,STATUS = 'OLD',IOSTAT=ERR) +! IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILEGC,0) +! ECOTYP = ' ' +! LNUM = 0 +! DO WHILE (ECOTYP .NE. ECONO) +! CALL IGNORE(LUNECO, LNUM, ISECT, C255) +! IF ((ISECT .EQ. 1) .AND. (C255(1:1) .NE. ' ') .AND. +! & (C255(1:1) .NE. '*')) THEN +!! READ (C255,'(A6,66X,F6.0,30X,3F6.0)',IOSTAT=ERR) +!! & ECOTYP, LNGSH, THRESH, SDPRO, SDLIP +! READ (C255,'(A6,66X,F6.0,54X,2(F6.0))',IOSTAT=ERR) ECOTYP, +! & LNGSH, XFPHT, XFINT +! IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILEGC,LNUM) +! IF (ECOTYP .EQ. ECONO) THEN +! EXIT +! ENDIF +! +! ELSE IF (ISECT .EQ. 0) THEN +! IF (ECONO .EQ. 'DFAULT') CALL ERROR(ERRKEY,35,FILEGC,LNUM) +! ECONO = 'DFAULT' +! REWIND(LUNECO) +! LNUM = 0 +! ENDIF +! ENDDO + +! chp 2025-01-09 ECO_read returns a value of -99 for cotton because these values are not in the ecotype file +! The reads above return a value of zero. + CALL ECO_read('LNGSH',LNGSH) + CALL ECO_read('XFPHT',XFPHT) + CALL ECO_read('XFINT',XFINT) + +! chp 2025-01-09 +! Use of these values is triggered by a value > 0.0 +! Generic ECO_read checks for missing data. +! This error check no longer useful. +! IF(XFPHT .LT. 0.0) THEN +! MSG(1) = 'Ecotype coefficient is not properly defined.' +! MSG(2) = 'Time required to reach maximum partitioning to ' +! MSG(3) = 'pod/fruit. (photothermal days)' +! MSG(4) = 'XFPHT must be greater then 0.0.' +! CALL WARNING (4, ERRKEY, MSG) +! CALL ERROR(ERRKEY,1,FILEGC,0) +! ELSE IF(XFINT .LT. 0.0 .OR. XFINT .GT. 1.0) THEN +! MSG(1) = 'Ecotype Coefficients is not properly defined.' +! MSG(2) = 'Initial partitioning to pod/fruit during early ' +! MSG(3) = 'pod/fruit growth.' +! MSG(4) = 'XFINT must be between/included 0.0 and 1.0.' +! CALL WARNING (4, ERRKEY, MSG) +! CALL ERROR(ERRKEY,2,FILEGC,0) +! ENDIF +! +! CLOSE (LUNECO) !----------------------------------------------------------------------- RETURN diff --git a/Plant/CROPGRO/IPPLNT.for b/Plant/CROPGRO/IPPLNT.for index 05be26406..5dc3cc5bb 100644 --- a/Plant/CROPGRO/IPPLNT.for +++ b/Plant/CROPGRO/IPPLNT.for @@ -35,7 +35,7 @@ C----------------------------------------------------------------------- USE ModuleDefs USE ModuleData IMPLICIT NONE - EXTERNAL FIND, ERROR, GETLUN, IGNORE, WARNING, UPCASE + EXTERNAL FIND, ERROR, GETLUN, IGNORE, WARNING, UPCASE, ECO_READ !----------------------------------------------------------------------- CHARACTER*1 BLANK, UPCASE, DETACH, MEEVP @@ -62,7 +62,7 @@ C----------------------------------------------------------------------- & PLIGSH, PMINSD, PMINSH, POASD, POASH, & PROLFI, PRORTI, PROSHI, PROSTI, R30C2, & RCH2O, RES30C, RFIXN, RLIG, RLIP, RMIN, - & RNH4C, RNO3C, ROA, RPRO, TTFIX + & RNH4C, RNO3C, ROA, RPRO, TTFIX, VALUE ! Species-dependant variables exported to SPAM or WATBAL: REAL EORATIO, KCAN, KEP, PORMIN, RWUMX, RWUEP1 @@ -331,9 +331,15 @@ C----------------------------------------------------------------------- C----------------------------------------------------------------------- CLOSE (LUNCRP) -C----------------------------------------------------------------------- -C Read Ecotype Parameter File -C----------------------------------------------------------------------- +!C----------------------------------------------------------------------- +! 2025-01-08 REPLACE ECOTYPE READS WITH GENERIC ROUTINE FOR FLEXIBLE INPUT + CALL ECO_read('NEW', Value) + +!C Read Ecotype Parameter File +! chp 2025-01-09 +! Keep this section here until all ECO parameters are obtained with +! ECO_read +!C----------------------------------------------------------------------- ! Set file plus pathname for ecotype parameter file ! 06/29/2023 FO - Removed unused KCAN_ECO read and left FILEGC build. ! This is need to feed with FILEGC path for ecotype file present in diff --git a/Plant/CROPGRO/Ipphenol.for b/Plant/CROPGRO/Ipphenol.for index 905708358..bc61d589c 100644 --- a/Plant/CROPGRO/Ipphenol.for +++ b/Plant/CROPGRO/Ipphenol.for @@ -30,22 +30,22 @@ C======================================================================= ! which contain control information, soil ! parameters, hourly weather data. IMPLICIT NONE - EXTERNAL ERROR, FIND, GETLUN, IGNORE + EXTERNAL ERROR, FIND, GETLUN, IGNORE, ECO_read !----------------------------------------------------------------------- CHARACTER*1 PLME, BLANK CHARACTER*2 CROP CHARACTER*3 CTMP(20), DLTYP(20) - CHARACTER*6 SECTION, ECOTYP, ECONO, ERRKEY + CHARACTER*6 SECTION, ECONO, ERRKEY !, ECOTYP CHARACTER*12 FILEC, FILEE - CHARACTER*16 ECONAM +! CHARACTER*16 ECONAM CHARACTER*30 FILEIO CHARACTER*80 CHAR, PATHCR, PATHEC CHARACTER*92 FILECC, FILEGC - CHARACTER*255 C255 +! CHARACTER*255 C255 INTEGER LUNIO, NPHS - INTEGER LUNCRP, LUNECO, ISECT, PATHL - INTEGER I, J, K + INTEGER LUNCRP, ISECT, PATHL !, LUNECO + INTEGER I, J !, K INTEGER IVRGRP, IVRTEM, ERR, LINC, LNUM, FOUND INTEGER NPRIOR(20), TSELC(20) @@ -61,6 +61,8 @@ C======================================================================= REAL WSENP(20), NSENP(20) REAL PHTHRS(20), PSENP(20) + REAL IVRGRP_real, IVRTEM_real + !----------------------------------------------------------------------- ! Define constructed variable types based on definitions in ! ModuleDefs.for. @@ -199,38 +201,56 @@ C----------------------------------------------------------------------- FILEGC = PATHEC(1:(PATHL-1)) // FILEE ENDIF -C----------------------------------------------------------------------- -C Read Ecotype Parameter File -C----------------------------------------------------------------------- - CALL GETLUN('FILEE', LUNECO) - OPEN (LUNECO,FILE = FILEGC,STATUS = 'OLD',IOSTAT=ERR) - IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILEGC,0) - ECOTYP = ' ' - LNUM = 0 - - DO WHILE (ECOTYP .NE. ECONO) - CALL IGNORE(LUNECO, LNUM, ISECT, C255) - IF (ISECT .EQ. 1 .AND. C255(1:1) .NE. ' ' .AND. - & C255(1:1) .NE. '*') THEN - READ (C255,3100,IOSTAT=ERR) ECOTYP, ECONAM, IVRGRP, - & IVRTEM, THVAR, (PHTHRS(K), K=1,4), PM06, PM09, - & (PHTHRS(K),K=11,12), TRIFOL, R1PPO, OPTBI, SLOBI - 3100 FORMAT (A6, 1X, A16, 1X, 2(1X,A2), 7(1X,F5.0), 6X, - & 3(1X,F5.0), 2(6X), 3(1X,F5.0)) - IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILEGC,LNUM) - IF (ECOTYP .EQ. ECONO) THEN - EXIT - ENDIF - - ELSE IF (ISECT .EQ. 0) THEN - IF (ECONO .EQ. 'DFAULT') CALL ERROR(ERRKEY,35,FILEGC,LNUM) - ECONO = 'DFAULT' - REWIND(LUNECO) - LNUM = 0 - ENDIF - ENDDO +!C----------------------------------------------------------------------- +!C Read Ecotype Parameter File +!C----------------------------------------------------------------------- +! CALL GETLUN('FILEE', LUNECO) +! OPEN (LUNECO,FILE = FILEGC,STATUS = 'OLD',IOSTAT=ERR) +! IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILEGC,0) +! ECOTYP = ' ' +! LNUM = 0 +! +! DO WHILE (ECOTYP .NE. ECONO) +! CALL IGNORE(LUNECO, LNUM, ISECT, C255) +! IF (ISECT .EQ. 1 .AND. C255(1:1) .NE. ' ' .AND. +! & C255(1:1) .NE. '*') THEN +! READ (C255,3100,IOSTAT=ERR) ECOTYP, ECONAM, IVRGRP, +! & IVRTEM, THVAR, (PHTHRS(K), K=1,4), PM06, PM09, +! & (PHTHRS(K),K=11,12), TRIFOL, R1PPO, OPTBI, SLOBI +! 3100 FORMAT (A6, 1X, A16, 1X, 2(1X,A2), 7(1X,F5.0), 6X, +! & 3(1X,F5.0), 2(6X), 3(1X,F5.0)) +! IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILEGC,LNUM) +! IF (ECOTYP .EQ. ECONO) THEN +! EXIT +! ENDIF +! +! ELSE IF (ISECT .EQ. 0) THEN +! IF (ECONO .EQ. 'DFAULT') CALL ERROR(ERRKEY,35,FILEGC,LNUM) +! ECONO = 'DFAULT' +! REWIND(LUNECO) +! LNUM = 0 +! ENDIF +! ENDDO +! +! CLOSE (LUNECO) - CLOSE (LUNECO) + CALL ECO_read('MG',IVRGRP_real) + IVRGRP = NINT(IVRGRP_real) + CALL ECO_read('TM',IVRTEM_real) + IVRTEM = NINT(IVRTEM_real) + CALL ECO_read('THVAR',THVAR) + CALL ECO_read('PL-EM',PHTHRS(1)) + CALL ECO_read('EM-V1',PHTHRS(2)) + CALL ECO_read('V1-JU',PHTHRS(3)) + CALL ECO_read('JU-R0',PHTHRS(4)) + CALL ECO_read('PM06',PM06) + CALL ECO_read('PM09',PM09) + CALL ECO_read('R7-R8',PHTHRS(11)) + CALL ECO_read('FL-VS',PHTHRS(12)) + CALL ECO_read('TRIFL',TRIFOL) + CALL ECO_read('R1PPO',R1PPO) + CALL ECO_read('OPTBI',OPTBI) + CALL ECO_read('SLOBI',SLOBI) PHTHRS(5) = MAX(0.,PH2T5 - PHTHRS(3) - PHTHRS(4)) PHTHRS(7) = PHTHRS(6) + MAX(0.,(PHTHRS(8) - PHTHRS(6))* PM06) diff --git a/Plant/CROPGRO/LTGROW.for b/Plant/CROPGRO/LTGROW.for index 86f055914..b5c0b691e 100644 --- a/Plant/CROPGRO/LTGROW.for +++ b/Plant/CROPGRO/LTGROW.for @@ -13,7 +13,7 @@ C======================================================================== C----------------------------------------------------------------------- USE ModuleDefs IMPLICIT NONE - EXTERNAL GETLUN, FIND, ERROR, IGNORE, TABEX + EXTERNAL GETLUN, FIND, ERROR, IGNORE, TABEX, ECO_READ SAVE CHARACTER*6 ERRKEY @@ -24,7 +24,7 @@ C----------------------------------------------------------------------- CHARACTER*92 FILECC, FILEGC CHARACTER*255 C255 - INTEGER I, LUNCRP, LUNECO, ERR, LINC, LNUM, ISECT + INTEGER I, LUNCRP, ERR, LINC, LNUM, ISECT, LUNECO INTEGER DYNAMIC INTEGER FOUND @@ -43,36 +43,40 @@ C----------------------------------------------------------------------- C----------------------------------------------------------------------- C Read Ecotype Parameter File C----------------------------------------------------------------------- - PCTLT = -99.0 - SPCTLT = ' ' - - CALL GETLUN('FILEE', LUNECO) - OPEN (LUNECO,FILE = FILEGC,STATUS = 'OLD',IOSTAT=ERR) - IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILEGC,0) - ECOTYP = ' ' - LNUM = 0 - DO WHILE (ECOTYP .NE. ECONO) - CALL IGNORE(LUNECO, LNUM, ISECT, C255) - IF ((ISECT .EQ. 1) .AND. (C255(1:1) .NE. ' ') .AND. - & (C255(1:1) .NE. '*')) THEN - READ (C255,'(A6,120X,A6)',IOSTAT=ERR) - & ECOTYP, SPCTLT - IF (SPCTLT .EQ. '') CALL ERROR(ERRKEY,10,FILEGC,LNUM) - READ(SPCTLT,'(F6.0)',IOSTAT=ERR) PCTLT - IF (PCTLT .LT. 25 .OR. PCTLT .GT. 60) - & CALL ERROR(ERRKEY,11,FILEGC,LNUM) - IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILEGC,LNUM) - IF (ECOTYP .EQ. ECONO) EXIT +! PCTLT = -99.0 +! SPCTLT = ' ' - ELSE IF (ISECT .EQ. 0) THEN - IF (ECONO .EQ. 'DFAULT') CALL ERROR(ERRKEY,35,FILEGC,LNUM) - ECONO = 'DFAULT' - REWIND(LUNECO) - LNUM = 0 - ENDIF - ENDDO +! CALL GETLUN('FILEE', LUNECO) +! OPEN (LUNECO,FILE = FILEGC,STATUS = 'OLD',IOSTAT=ERR) +! IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILEGC,0) +! ECOTYP = ' ' +! LNUM = 0 +! DO WHILE (ECOTYP .NE. ECONO) +! CALL IGNORE(LUNECO, LNUM, ISECT, C255) +! IF ((ISECT .EQ. 1) .AND. (C255(1:1) .NE. ' ') .AND. +! & (C255(1:1) .NE. '*')) THEN +! READ (C255,'(A6,120X,A6)',IOSTAT=ERR) +! & ECOTYP, SPCTLT +! IF (SPCTLT .EQ. '') CALL ERROR(ERRKEY,10,FILEGC,LNUM) +! READ(SPCTLT,'(F6.0)',IOSTAT=ERR) PCTLT +! IF (PCTLT .LT. 25 .OR. PCTLT .GT. 60) +! & CALL ERROR(ERRKEY,11,FILEGC,LNUM) +! IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILEGC,LNUM) +! IF (ECOTYP .EQ. ECONO) EXIT +! +! ELSE IF (ISECT .EQ. 0) THEN +! IF (ECONO .EQ. 'DFAULT') CALL ERROR(ERRKEY,35,FILEGC,LNUM) +! ECONO = 'DFAULT' +! REWIND(LUNECO) +! LNUM = 0 +! ENDIF +! ENDDO +! CLOSE (LUNECO) + + CALL ECO_read('PCTLT', PCTLT) + IF (PCTLT .LT. 25 .OR. PCTLT .GT. 60) + & CALL ERROR(ERRKEY,11,FILEGC,LNUM) - CLOSE (LUNECO) !----------------------------------------------------------------------- ! Read in values from input file, which were previously input ! in Subroutine IPCROP. diff --git a/Plant/CROPGRO/PODS.for b/Plant/CROPGRO/PODS.for index a971d4dd5..c306e6a74 100644 --- a/Plant/CROPGRO/PODS.for +++ b/Plant/CROPGRO/PODS.for @@ -47,7 +47,7 @@ USE ModuleData IMPLICIT NONE EXTERNAL GETLUN, FIND, ERROR, IGNORE, PODCOMP, FreshWt, - & WARNING, TIMDIF, CURV, TABEX + & WARNING, TIMDIF, CURV, TABEX, ECO_read SAVE CHARACTER*1 ISWWAT, ISWFWT @@ -242,36 +242,41 @@ !----------------------------------------------------------------------- ! Read Ecotype Parameter File !----------------------------------------------------------------------- - CALL GETLUN('FILEE', LUNECO) - OPEN (LUNECO,FILE = FILEGC,STATUS = 'OLD',IOSTAT=ERR) - IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILEGC,0) - ECOTYP = ' ' - LNUM = 0 - DO WHILE (ECOTYP .NE. ECONO) - CALL IGNORE(LUNECO, LNUM, ISECT, C255) - IF ((ISECT .EQ. 1) .AND. (C255(1:1) .NE. ' ') .AND. - & (C255(1:1) .NE. '*')) THEN -! READ (C255,'(A6,66X,F6.0,30X,F6.0)',IOSTAT=ERR) -! & ECOTYP, LNGSH, THRESH - READ (C255,'(A6,66X,F6.0)',IOSTAT=ERR) - & ECOTYP, LNGSH - IF (ISWFWT .EQ. 'Y') THEN - READ (C255,'(126X,F6.0)',IOSTAT=ERR) XMAGE - ENDIF - IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILEGC,LNUM) - IF (ECOTYP .EQ. ECONO) THEN - EXIT - ENDIF +! CALL GETLUN('FILEE', LUNECO) +! OPEN (LUNECO,FILE = FILEGC,STATUS = 'OLD',IOSTAT=ERR) +! IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILEGC,0) +! ECOTYP = ' ' +! LNUM = 0 +! DO WHILE (ECOTYP .NE. ECONO) +! CALL IGNORE(LUNECO, LNUM, ISECT, C255) +! IF ((ISECT .EQ. 1) .AND. (C255(1:1) .NE. ' ') .AND. +! & (C255(1:1) .NE. '*')) THEN +!! READ (C255,'(A6,66X,F6.0,30X,F6.0)',IOSTAT=ERR) +!! & ECOTYP, LNGSH, THRESH +! READ (C255,'(A6,66X,F6.0)',IOSTAT=ERR) +! & ECOTYP, LNGSH +! IF (ISWFWT .EQ. 'Y') THEN +! READ (C255,'(126X,F6.0)',IOSTAT=ERR) XMAGE +! ENDIF +! IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILEGC,LNUM) +! IF (ECOTYP .EQ. ECONO) THEN +! EXIT +! ENDIF +! +! ELSE IF (ISECT .EQ. 0) THEN +! IF (ECONO .EQ. 'DFAULT') CALL ERROR(ERRKEY,35,FILEGC,LNUM) +! ECONO = 'DFAULT' +! REWIND(LUNECO) +! LNUM = 0 +! ENDIF +! ENDDO +! +! CLOSE (LUNECO) - ELSE IF (ISECT .EQ. 0) THEN - IF (ECONO .EQ. 'DFAULT') CALL ERROR(ERRKEY,35,FILEGC,LNUM) - ECONO = 'DFAULT' - REWIND(LUNECO) - LNUM = 0 + CALL ECO_read('LNGSH', LNGSH) + IF (ISWFWT .EQ. 'Y') THEN + CALL ECO_read('XMAGE', XMAGE) ENDIF - ENDDO - - CLOSE (LUNECO) !----------------------------------------------------------------------- diff --git a/Plant/CROPGRO/VEGGR.for b/Plant/CROPGRO/VEGGR.for index 6e006184a..a359f4057 100644 --- a/Plant/CROPGRO/VEGGR.for +++ b/Plant/CROPGRO/VEGGR.for @@ -28,7 +28,8 @@ C======================================================================== SUBROUTINE VEGGR (DYNAMIC, & AGRLF, AGRRT, AGRSTM, CMINEP, CSAVEV, DTX, !Input - & DXR57, ECONO, FILECC, FILEGC, FNINL, FNINR, !Input +! & DXR57, ECONO, FILECC, FILEGC, FNINL, FNINR, !Input + & DXR57, FILECC, FNINL, FNINR, !Input & FNINS, KCAN, NAVL, NDMNEW, NDMOLD, !Input & NFIXN, NMINEA, NR1, PAR, PCH2O, PG, PGAVL, !Input & PStres2, ROWSPC, RVSTGE, STMWT, TGRO, !Input @@ -50,9 +51,9 @@ C======================================================================== CHARACTER*6 ERRKEY PARAMETER (ERRKEY = 'VEGGR') - CHARACTER*6 ECONO, SECTION + CHARACTER*6 SECTION !ECONO, CHARACTER*80 C80 - CHARACTER*92 FILECC, FILEGC + CHARACTER*92 FILECC !, FILEGC INTEGER DYNAMIC INTEGER YRDOY, YREMRG, NR1, DAS @@ -165,7 +166,7 @@ C======================================================================== ! Call CANOPY for input !----------------------------------------------------------------------- CALL CANOPY(RUNINIT, - & ECONO, FILECC, FILEGC, KCAN, PAR, ROWSPC, !Input + & FILECC, KCAN, PAR, ROWSPC, !Input & RVSTGE, TGRO, TURFAC, VSTAGE, XLAI, NSTRES, !Input & CANHT, CANWH) !Output @@ -205,7 +206,7 @@ C======================================================================== XNSTRES= 1.0 CALL CANOPY(SEASINIT, - & ECONO, FILECC, FILEGC, KCAN, PAR, ROWSPC, !Input + & FILECC, KCAN, PAR, ROWSPC, !Input & RVSTGE, TGRO, TURFAC, VSTAGE, XLAI, NSTRES, !Input & CANHT, CANWH) !Output @@ -222,7 +223,7 @@ C======================================================================== CUMTUR = 1.0 CALL CANOPY(EMERG, - & ECONO, FILECC, FILEGC, KCAN, PAR, ROWSPC, !Input + & FILECC, KCAN, PAR, ROWSPC, !Input & RVSTGE, TGRO, TURFAC, VSTAGE, XLAI, NSTRES, !Input & CANHT, CANWH) !Output @@ -464,7 +465,7 @@ C function of VSTAGE, air temperature, drought stress (TURFAC), C daylenght and radiation (PAR). C----------------------------------------------------------------------- CALL CANOPY(INTEGR, - & ECONO, FILECC, FILEGC, KCAN, PAR, ROWSPC, !Input + & FILECC, KCAN, PAR, ROWSPC, !Input & RVSTGE, TGRO, TURFAC, VSTAGE, XLAI, NSTRES, !Input & CANHT, CANWH) !Output diff --git a/Plant/ECO_read.for b/Plant/ECO_read.for new file mode 100644 index 000000000..67509613c --- /dev/null +++ b/Plant/ECO_read.for @@ -0,0 +1,227 @@ +!============================================================================================ + Subroutine ECO_read(LABEL, Value) +!----------------------------------------------------------------------- +! Opens and reads Ecotype file and stores parameters for the current +! ecotype in memory. +! - Ecotype files must be one line per ecotype with the data values +! right-justified under each header. +! - Values are stored as text, but sent back as real. +! - Ecotype file is read each time the routine is called with +! LABEL = 'NEW' +! - Initially implemented only for CROPGRO but should work for any crop. +!----------------------------------------------------------------------- +! REVISION HISTORY +! 01/09/2025 CHP Written +!----------------------------------------------------------------------- + + USE ModuleData + IMPLICIT NONE + SAVE + EXTERNAL ERROR, FIND, GETLUN, IGNORE, IGNORE2, LENSTRING, + & PARSE_HEADERS, UPCASE, WARNING + + CHARACTER*(*), INTENT(IN) :: LABEL + REAL, INTENT(OUT) :: Value + + INTEGER C1, C2, ERR, FOUND, I, J, ISECT, LINC, LNUM + INTEGER LENGTH, LUNECO, LUNIO, PATHL, LENSTRING + INTEGER, PARAMETER :: MAXCOL = 30 !Max number of ecotype columns + INTEGER iCOUNT, COL(MAXCOL,2) + + CHARACTER*1, PARAMETER :: BLANK = ' ' + CHARACTER*1 UPCASE + CHARACTER*5 MODEL + CHARACTER*6 ECONO, ECOTYP, SECTION + CHARACTER*7, PARAMETER :: ERRKEY = 'IPECO' + CHARACTER*12 FILEIO, FILEE + CHARACTER*15 HTXT + CHARACTER*80 PATHEC + CHARACTER*92 FILEGC + CHARACTER*92 MSG(4) + CHARACTER*200 HEADERLINE, TEXTLINE + +! Array of headers and text value of ecotype parameters. +! Each header can be up to 15 characters long + CHARACTER*15 HEADER(MAXCOL) +! Values are stored as text because they may contain both character and numeric values + CHARACTER*15 TEXTVAL(MAXCOL) + + LOGICAL ECOFOUND + + TYPE (ControlType) CONTROL + +!----------------------------------------------------------------------- +! New simulation, need to read Ecotype file + IF (TRIM(LABEL) .EQ. 'NEW') THEN + CALL GET(CONTROL) + FILEIO = CONTROL % FILEIO + LUNIO = CONTROL % LUNIO + +! Read name and path of ecotype file from FILEIO + OPEN (LUNIO, FILE = FILEIO, STATUS = 'OLD', IOSTAT=ERR) + IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILEIO,0) + + READ (LUNIO,105,IOSTAT=ERR) FILEE, PATHEC; LNUM = LNUM + 1 + 105 FORMAT(///////,15X,A12,1X,A80) + IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILEIO,LNUM) + +! Read Cultivar Section to get ecotype name + SECTION = '*CULTI' + CALL FIND(LUNIO, SECTION, LINC, FOUND) ; LNUM = LNUM + LINC +! Need the 2nd cultivar section at the bottom of FileIO + CALL FIND(LUNIO, SECTION, LINC, FOUND) ; LNUM = LNUM + LINC + IF (FOUND .EQ. 0) THEN + CALL ERROR(SECTION, 42, FILEIO, LNUM) + ELSE + READ(LUNIO,'(24X,A6)',IOSTAT=ERR) ECONO ; LNUM = LNUM + 1 + IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILEIO,LNUM) + ENDIF + CLOSE (LUNIO) + +!----------------------------------------------------------------------- +! Open ecotype file + LNUM = 0 + PATHL = INDEX(PATHEC,BLANK) + IF (PATHL .LE. 1) THEN + FILEGC = FILEE + ELSE + FILEGC = PATHEC(1:(PATHL-1)) // FILEE + ENDIF + + CALL GETLUN('FILEE', LUNECO) + OPEN (LUNECO,FILE = FILEGC, STATUS = 'OLD', IOSTAT=ERR) + IF (ERR .NE. 0) CALL ERROR(ERRKEY,ERR,FILEGC,0) + + MODEL = FILEE(1:5) + +!----------------------------------------------------------------------- +! Look for 1st header line beginning with '@' in column 1 (ISECT = 3) + DO WHILE (.TRUE.) ! + CALL IGNORE2 (LUNECO, LNUM, ISECT, HEADERLINE) + SELECT CASE(ISECT) + CASE(0) !End of file + CALL ERROR(ERRKEY,3,FILEGC,LNUM) + CASE(1); CYCLE !data line + CASE(2); CYCLE !End of section + CASE(3); EXIT !Header line + END SELECT + ENDDO + +! Found header line for ecotype file + CALL PARSE_HEADERS(HEADERLINE, MAXCOL, HEADER, ICOUNT, COL) + IF (ICOUNT .LT. 1) CALL ERROR (ERRKEY,3,FILEGC,LNUM) + DO I = 1, ICOUNT + HTXT = HEADER(I) + DO J = 1, LEN(TRIM(HTXT)) + HTXT(J:J) = UPCASE(HTXT(J:J)) + END DO + HEADER(I) = HTXT + ENDDO + + ECOFOUND = .FALSE. +! Look for correct ecotype line + DO WHILE (.TRUE.) ! + CALL IGNORE (LUNECO, LNUM, ISECT, TEXTLINE) + SELECT CASE(ISECT) + CASE(0); EXIT !End of file + + CASE(1) !data line +! Found a line of ecotype data. Is it the right one? + READ(TEXTLINE(COL(1,1):COL(1,2)+1),*,IOSTAT=ERR) ECOTYP + IF (ECOTYP .EQ. ECONO) THEN + ECOFOUND = .TRUE. + TEXTVAL(1) = ECOTYP + DO I = 2, ICOUNT + C1 = COL(I,1) + C2 = COL(I,2) + TEXTVAL(I) = TEXTLINE(C1:C2) + LENGTH = LenString(TEXTVAL(I)) + IF (LENGTH < 1) THEN + WRITE(MSG(1),'(A,A)') + & "Ecotype value missing for parameter ", HEADER(I) + WRITE(MSG(2),'(A,A)') "Ecotype: ", ECOTYP + MSG(3) = FILEGC + CALL WARNING(3,ERRKEY,MSG) + CALL ERROR(ERRKEY,4,FILEGC,LNUM) + ENDIF + ENDDO + EXIT + ENDIF + + CASE(2); EXIT !End of section + CASE(3); EXIT !Header line + END SELECT + ENDDO + + IF (.NOT. ECOFOUND) THEN +! Error if ecotype not found. +! NOTE: previously, the DFAULT ecotype was used if ECONO not found. +! As per GH, stop doing that! + WRITE(MSG(1),'(A,A,A)')'Ecotype ',ECONO, ' not found in file:' + MSG(2) = FILEGC + MSG(3) = "Program will stop." + CALL WARNING(3, ERRKEY, MSG) + CALL ERROR(ERRKEY,3,FILEGC,LNUM) + ENDIF + CLOSE (LUNECO) + +! Return a dummy value + Value = -99. + +!----------------------------------------------------------------------- +! Ecotype info has already been read, just send back the requested value + ELSE + Value = -99. + DO I = 2, ICOUNT + IF (TRIM(HEADER(I)) .EQ. TRIM(LABEL)) THEN + READ (TEXTVAL(I),*,IOSTAT=ERR) Value +! Note chp: will we ever need non-numeric values in ecotype file? + IF (ERR .NE. 0) THEN + WRITE(MSG(1),'(A,A)') + & HEADER(I),' contains non-numeric data.' + MSG(2) = "Program will stop." + CALL WARNING(2, ERRKEY, MSG) + CALL ERROR(ERRKEY,1,FILEGC,LNUM) + ENDIF + EXIT + ENDIF + ENDDO + +!----------------------------------------------------------------------- +! Error checking is crop specific + IF (I > ICOUNT) THEN +! Parameter not found in ECO file, check to see if it's required for this crop model + ERR = 4 !assume the missing parameter is needed, check for exclusions below + +! Some strawberry model parameters are not needed for other crops. + IF (TRIM(LABEL) == 'XFPHT' .AND. MODEL /= 'SRGRO') ERR = 0 + IF (TRIM(LABEL) == 'XFINT' .AND. MODEL /= 'SRGRO') ERR = 0 + +! Some cotton model parameters are not needed for other crops. + IF (TRIM(LABEL) == 'PCTLT' .AND. MODEL /= 'COGRO') ERR = 0 + +! Tomato, pepper, strawberry, green bean use XMAGE. Other crops don't. + IF (TRIM(LABEL) == 'XMAGE') THEN + IF (INDEX('TMGRO PRGRO SRGRO GBGRO',MODEL) < 1) ERR = 0 + ENDIF + +! G0GRO - is this model even used anymore? + IF (TRIM(LABEL) == 'THRSH' .AND. MODEL /= 'G0GRO') ERR = 0 + IF (TRIM(LABEL) == 'SDPRO' .AND. MODEL /= 'G0GRO') ERR = 0 + IF (TRIM(LABEL) == 'SDLIP' .AND. MODEL /= 'G0GRO') ERR = 0 + + IF (ERR > 0) THEN + MSG(1) = "Ecotype variable not found." + MSG(2) = "Variable: " // LABEL + MSG(3) = "File: " // FILEGC + MSG(4) = "Simulations terminated." + CALL WARNING(4, ERRKEY, MSG) + CALL ERROR(ERRKEY,4,FILEGC,LNUM) + ENDIF + ENDIF + ENDIF + +!----------------------------------------------------------------------- + RETURN + END SUBROUTINE ECO_read +!============================================================================================ diff --git a/Soil/SoilUtilities/SOILDYN.for b/Soil/SoilUtilities/SOILDYN.for index dcbfdca3c..846565308 100644 --- a/Soil/SoilUtilities/SOILDYN.for +++ b/Soil/SoilUtilities/SOILDYN.for @@ -1573,12 +1573,6 @@ c** wdb orig SUMKEL = SUMKE * EXP(-0.15*MCUMDEP) SOILPROP % MSALB = MSALB SOILPROP % SWALB = SWALB -!! Temporary -- print soil albedo stuff -! GET (CONTROL) -! CALL YR_DOY(CONTROL.YRDOY, YEAR, DOY) -! WRITE(2250,'(1X,I4,1X,I3.3,1X,I5,8F8.3)') YEAR, DOY, CONTROL.DAS, SOILPROP.SALB, -! & FF, SWALB, MULCHCOVER, MSALB, CANCOV, CMSALB - RETURN END SUBROUTINE ALBEDO_avg !=======================================================================