diff --git a/examples/sample_run/s022852 b/examples/sample_run/s022852 index 8b25ca4..221b659 100755 --- a/examples/sample_run/s022852 +++ b/examples/sample_run/s022852 @@ -10,7 +10,7 @@ 0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00 0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00 5.77,5.77,5.77,5.77,5.80,5.80,5.80,5.80,4.35,4.35,4.35,4.35,4.35,4.35,4.35,0.00,0.00,0.00,0.00 -0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00,5.00,5.00,5.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00 +10.00,10.00,10.00,10.00,10.00,10.00,10.00,10.00,5.00,5.00,5.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00 3.00,3.00,3.00,3.00,3.00,3.00,3.00,3.00,3.00,3.00,3.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00 3.87,2.87,2.6,2.6,2.00,2.00,2.00,2.00,3.00,0.50,0.50,0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00 0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00,0.00 diff --git a/f77src/Makefile b/f77src/Makefile index 74f0ec2..657060e 100644 --- a/f77src/Makefile +++ b/f77src/Makefile @@ -56,7 +56,7 @@ CMD = ecosys.x # WARNING: SIMULTANEOUSLY PROFILING AND FLOWTRACING IS NOT RECOMMENDED #FFLAGS = -axP -xW -ipo -O3 -r8 -i4 -align dcommons -cpp -save #intel setup -FFLAGS = -O2 -mp1 -r8 -i4 -align dcommons -cpp -auto-scalar +FFLAGS = -O2 -mp1 -r8 -i4 -align dcommons -cpp -auto-scalar -fimf-arch-consistency=true #gfortran #FFLAGS = -O2 diff --git a/f77src/blk13a.h b/f77src/blk13a.h index b98cb8b..1b57c24 100755 --- a/f77src/blk13a.h +++ b/f77src/blk13a.h @@ -19,7 +19,7 @@ 1,ZNO2SH(JZ,JY,JX),Z2GSH(JZ,JY,JX),Z2OSH(JZ,JY,JX),TRC0(JY,JX) 2,ZNO2BH(JZ,JY,JX),RC0(0:5,JY,JX),RA0(0:5,JY,JX),TRA0(JY,JX) 3,TOQCK(0:JZ,JY,JX),ORGN(0:JZ,JY,JX),ORGR(0:JZ,JY,JX) - 4,ZNFNI(0:JZ,JY,JX),ZNFNG(0:JZ,JY,JX),ZNFN0(0:JZ,JY,JX) + 4,ZNFNI(0:JZ,JY,JX),ZNFN0(0:JZ,JY,JX) 5,ZNHUI(0:JZ,JY,JX),ZNHU0(0:JZ,JY,JX),H1PO4(0:JZ,JY,JX) 6,H1POB(0:JZ,JY,JX),H1PO4H(JZ,JY,JX),H1POBH(JZ,JY,JX) diff --git a/f77src/blk8b.h b/f77src/blk8b.h index c685884..46f1d59 100755 --- a/f77src/blk8b.h +++ b/f77src/blk8b.h @@ -6,6 +6,6 @@ 6,YDPTH(JZ,JY,JX),POROQ(0:JZ,JY,JX),TFND(0:JZ,JY,JX),VOLXA(JY,JX) 7,PSIMS(JY,JX),PSIMX(JY,JX),PSIMN(JY,JX),PSISD(JY,JX),PSIMD(JY,JX) 8,SAND(JZ,JY,JX),SILT(JZ,JY,JX),CLAY(JZ,JY,JX),CDPTHZ(0:JZ,JY,JX) - 9,DPTHZ(JZ,JY,JX),AREA(3,0:JZ,JY,JX),DISP(3,JD,JV,JH),OXKM + 9,DPTHZ(JZ,JY,JX),AREA(3,0:JZ,JY,JX),DISP(3,JD,JV,JH),OXKM,PSIHY 1,OMCI(3,0:4),OMCF(7),OMCA(7) 2,IUTYP(JY,JX),IXTYP(2,JY,JX),IYTYP(0:2,366,JY,JX) diff --git a/f77src/grosub.f b/f77src/grosub.f index 5d7b989..f973da3 100755 --- a/f77src/grosub.f +++ b/f77src/grosub.f @@ -40,7 +40,7 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) DIMENSION RTNT(2),RLNT(2,JZ),RTSK1(2,JZ,10),RTSK2(2,JZ,10) 2,RTDPL(10,JZ),FWTR(JZ),FWTB(JP),FRTDP(0:3),RCCX(0:2),RCCQ(0:2) 3,RCCZ(0:3),RCCY(0:3),EFIRE(2,5:5),WGLFBL(JZ,10,JP,JY,JX) - 4,WTSHTA(JZ,JY,JX),FLG4Y(0:3),ATRPX(0:1),GVMX(0:1) + 4,WTSHTA(JZ,JY,JX),FLG4Y(0:3),ATRPX(0:1),GVMX(0:1),RTSK(0:2) DIMENSION CH2O3(25),CH2O4(25),CPOOLK(10,JP,JY,JX),FHVSTK(0:25) 2,FHVSHK(0:25),WFNGR(2,JZ),PSILY(0:2) DIMENSION FWOOD(0:1),FWOODN(0:1),FWOODP(0:1) @@ -71,6 +71,7 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) DATA RCCY/0.333,0.333,0.333,0.333/ DATA RCCX/0.250,0.833,0.833/ DATA RCCQ/0.833,0.833,0.833/ + DATA RTSK/1.0,1.0,4.0/ DATA FXRN/0.50,0.05,0.50,0.05/ DATA FXFB/1.0E-02,1.0E-02,1.0E-05,1.0E-05/ DATA FPART1/1.00/,FPART2/0.40/ @@ -1373,14 +1374,17 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) C IF(IDAY(1,NB,NZ,NY,NX).NE.0 2.AND.CCPOLB(NB,NZ,NY,NX).GT.ZERO)THEN - CCC=AMIN1(CZPOLB(NB,NZ,NY,NX)/(CZPOLB(NB,NZ,NY,NX) + CCC=AMAX1(0.0,AMIN1(1.0 + 1,CZPOLB(NB,NZ,NY,NX)/(CZPOLB(NB,NZ,NY,NX) 2+CCPOLB(NB,NZ,NY,NX)*CNKI) 3,CPPOLB(NB,NZ,NY,NX)/(CPPOLB(NB,NZ,NY,NX) - 4+CCPOLB(NB,NZ,NY,NX)*CPKI)) - CNC=CCPOLB(NB,NZ,NY,NX)/(CCPOLB(NB,NZ,NY,NX) - 2+CZPOLB(NB,NZ,NY,NX)/CNKI) - CPC=CCPOLB(NB,NZ,NY,NX)/(CCPOLB(NB,NZ,NY,NX) - 2+CPPOLB(NB,NZ,NY,NX)/CPKI) + 4+CCPOLB(NB,NZ,NY,NX)*CPKI))) + CNC=AMAX1(0.0,AMIN1(1.0 + 1,CCPOLB(NB,NZ,NY,NX)/(CCPOLB(NB,NZ,NY,NX) + 2+CZPOLB(NB,NZ,NY,NX)/CNKI))) + CPC=AMAX1(0.0,AMIN1(1.0 + 1,CCPOLB(NB,NZ,NY,NX)/(CCPOLB(NB,NZ,NY,NX) + 2+CPPOLB(NB,NZ,NY,NX)/CPKI))) ELSE CCC=0.0 CNC=0.0 @@ -2530,16 +2534,17 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) C OF STALK RESERVES C IF(WTRSVB(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - ZNPG=AMIN1(WTRSBN(NB,NZ,NY,NX)/(WTRSBN(NB,NZ,NY,NX) + ZNPGN=WTRSBN(NB,NZ,NY,NX)/(WTRSBN(NB,NZ,NY,NX) 2+SETN*WTRSVB(NB,NZ,NY,NX)) - 3,WTRSBP(NB,NZ,NY,NX)/(WTRSBP(NB,NZ,NY,NX) - 3+SETP*WTRSVB(NB,NZ,NY,NX))) - ZPGRX=ZPGRM+ZPGRD*AMAX1(0.0,AMIN1(1.0,ZNPG)) + ZNPGP=WTRSBP(NB,NZ,NY,NX)/(WTRSBP(NB,NZ,NY,NX) + 3+SETP*WTRSVB(NB,NZ,NY,NX)) + ZPGRN=ZPGRM+ZPGRD*AMAX1(0.0,AMIN1(1.0,ZNPGN)) + ZPGRP=ZPGRM+ZPGRD*AMAX1(0.0,AMIN1(1.0,ZNPGP)) XLOCN=AMIN1(XLOCM*CNGR(NZ,NY,NX) - 2,AMAX1(0.0,WTRSBN(NB,NZ,NY,NX)*ZPGRX) + 2,AMAX1(0.0,WTRSBN(NB,NZ,NY,NX)*ZPGRN) 3,(WTGRB(NB,NZ,NY,NX)+XLOCC)*CNGR(NZ,NY,NX)-WTGRBN(NB,NZ,NY,NX)) XLOCP=AMIN1(XLOCM*CPGR(NZ,NY,NX) - 2,AMAX1(0.0,WTRSBP(NB,NZ,NY,NX)*ZPGRX) + 2,AMAX1(0.0,WTRSBP(NB,NZ,NY,NX)*ZPGRP) 3,(WTGRB(NB,NZ,NY,NX)+XLOCC)*CPGR(NZ,NY,NX)-WTGRBP(NB,NZ,NY,NX)) ELSE XLOCN=0.0 @@ -3233,11 +3238,15 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) CPPOLN=1.0 ENDIF IF(CCPOLN.GT.ZERO)THEN - CCC=AMIN1(CZPOLN/(CZPOLN+CCPOLN*CNKI) - 2,CPPOLN/(CPPOLN+CCPOLN*CPKI)) - CNC=CCPOLN/(CCPOLN+CZPOLN/CNKI) - CPC=CCPOLN/(CCPOLN+CPPOLN/CPKI) - CNF=CCPOLN/(CCPOLN+CZPOLN/CNKF) + CCC=AMAX1(0.0,AMIN1(1.0 + 1,CZPOLN/(CZPOLN+CCPOLN*CNKI) + 2,CPPOLN/(CPPOLN+CCPOLN*CPKI))) + CNC=AMAX1(0.0,AMIN1(1.0 + 1,CCPOLN/(CCPOLN+CZPOLN/CNKI))) + CPC=AMAX1(0.0,AMIN1(1.0 + 1,CCPOLN/(CCPOLN+CPPOLN/CPKI))) + CNF=AMAX1(0.0,AMIN1(1.0 + 1,CCPOLN/(CCPOLN+CZPOLN/CNKF))) ELSE CCC=0.0 CNC=0.0 @@ -3369,8 +3378,7 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) IF(CPOOL(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX) 2.AND.WTLSB(NB,NZ,NY,NX).GT.ZEROL(NZ,NY,NX))THEN WTLSB1=WTLSB(NB,NZ,NY,NX) - WTNDB1=AMIN1(WTLSB(NB,NZ,NY,NX),AMAX1(FSNKM - 2*WTLSB(NB,NZ,NY,NX),WTNDB(NB,NZ,NY,NX))) + WTNDB1=AMIN1(WTLSB(NB,NZ,NY,NX),WTNDB(NB,NZ,NY,NX)) WTLSBT=WTLSB1+WTNDB1 IF(WTLSBT.GT.ZEROP(NZ,NY,NX))THEN CPOOLD=(CPOOL(NB,NZ,NY,NX)*WTNDB1 @@ -3480,7 +3488,8 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) IF(RTDP1(N,NR,NZ,NY,NX).GT.CDPTHZ(L-1,NY,NX))THEN IF(RTDP1(N,NR,NZ,NY,NX).LE.CDPTHZ(L,NY,NX))THEN RTDPP=RTDP1(N,NR,NZ,NY,NX)+HTSTZ(NZ,NY,NX) - RTSK1(N,L,NR)=XRTN1*RRAD1(N,L,NZ,NY,NX)**2/RTDPP + RTSK1(N,L,NR)=RTSK(IGTYP(NZ,NY,NX))*XRTN1 + 2*RRAD1(N,L,NZ,NY,NX)**2/RTDPP RTNT(N)=RTNT(N)+RTSK1(N,L,NR) RLNT(N,L)=RLNT(N,L)+RTSK1(N,L,NR) ENDIF @@ -3633,14 +3642,17 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) C IF(IDAY(1,NB1(NZ,NY,NX),NZ,NY,NX).NE.0 2.AND.CCPOLR(N,L,NZ,NY,NX).GT.ZERO)THEN - CCC=AMIN1(CZPOLR(N,L,NZ,NY,NX)/(CZPOLR(N,L,NZ,NY,NX) + CCC=AMAX1(0.0,AMIN1(1.0 + 1,CZPOLR(N,L,NZ,NY,NX)/(CZPOLR(N,L,NZ,NY,NX) 2+CCPOLR(N,L,NZ,NY,NX)*CNKI) 3,CPPOLR(N,L,NZ,NY,NX)/(CPPOLR(N,L,NZ,NY,NX) - 4+CCPOLR(N,L,NZ,NY,NX)*CPKI)) - CNC=CCPOLR(N,L,NZ,NY,NX)/(CCPOLR(N,L,NZ,NY,NX) - 2+CZPOLR(N,L,NZ,NY,NX)/CNKI) - CPC=CCPOLR(N,L,NZ,NY,NX)/(CCPOLR(N,L,NZ,NY,NX) - 2+CPPOLR(N,L,NZ,NY,NX)/CPKI) + 4+CCPOLR(N,L,NZ,NY,NX)*CPKI))) + CNC=AMAX1(0.0,AMIN1(1.0 + 1,CCPOLR(N,L,NZ,NY,NX)/(CCPOLR(N,L,NZ,NY,NX) + 2+CZPOLR(N,L,NZ,NY,NX)/CNKI))) + CPC=AMAX1(0.0,AMIN1(1.0 + 1,CCPOLR(N,L,NZ,NY,NX)/(CCPOLR(N,L,NZ,NY,NX) + 2+CPPOLR(N,L,NZ,NY,NX)/CPKI))) ELSE CCC=0.0 CNC=0.0 @@ -3869,14 +3881,17 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) C IF(IDAY(1,NB1(NZ,NY,NX),NZ,NY,NX).NE.0 2.AND.CCPOLR(N,L,NZ,NY,NX).GT.ZERO)THEN - CCC=AMIN1(CZPOLR(N,L,NZ,NY,NX)/(CZPOLR(N,L,NZ,NY,NX) + CCC=AMAX1(0.0,AMIN1(1.0 + 1,CZPOLR(N,L,NZ,NY,NX)/(CZPOLR(N,L,NZ,NY,NX) 2+CCPOLR(N,L,NZ,NY,NX)*CNKI) 3,CPPOLR(N,L,NZ,NY,NX)/(CPPOLR(N,L,NZ,NY,NX) - 4+CCPOLR(N,L,NZ,NY,NX)*CPKI)) - CNC=CCPOLR(N,L,NZ,NY,NX)/(CCPOLR(N,L,NZ,NY,NX) - 2+CZPOLR(N,L,NZ,NY,NX)/CNKI) - CPC=CCPOLR(N,L,NZ,NY,NX)/(CCPOLR(N,L,NZ,NY,NX) - 2+CPPOLR(N,L,NZ,NY,NX)/CPKI) + 4+CCPOLR(N,L,NZ,NY,NX)*CPKI))) + CNC=AMAX1(0.0,AMIN1(1.0 + 1,CCPOLR(N,L,NZ,NY,NX)/(CCPOLR(N,L,NZ,NY,NX) + 2+CZPOLR(N,L,NZ,NY,NX)/CNKI))) + CPC=AMAX1(0.0,AMIN1(1.0 + 1,CCPOLR(N,L,NZ,NY,NX)/(CCPOLR(N,L,NZ,NY,NX) + 2+CPPOLR(N,L,NZ,NY,NX)/CPKI))) ELSE CCC=0.0 CNC=0.0 @@ -4475,11 +4490,15 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) CPPOLN=1.0 ENDIF IF(CCPOLN.GT.ZERO)THEN - CCC=AMIN1(CZPOLN/(CZPOLN+CCPOLN*CNKI) - 2,CPPOLN/(CPPOLN+CCPOLN*CPKI)) - CNC=CCPOLN/(CCPOLN+CZPOLN/CNKI) - CPC=CCPOLN/(CCPOLN+CPPOLN/CPKI) - CNF=CCPOLN/(CCPOLN+CZPOLN/CNKF) + CCC=AMAX1(0.0,AMIN1(1.0 + 1,CZPOLN/(CZPOLN+CCPOLN*CNKI) + 2,CPPOLN/(CPPOLN+CCPOLN*CPKI))) + CNC=AMAX1(0.0,AMIN1(1.0 + 1,CCPOLN/(CCPOLN+CZPOLN/CNKI))) + CPC=AMAX1(0.0,AMIN1(1.0 + 1,CCPOLN/(CCPOLN+CPPOLN/CPKI))) + CNF=AMAX1(0.0,AMIN1(1.0 + 1,CCPOLN/(CCPOLN+CZPOLN/CNKF))) ELSE CCC=0.0 CNC=0.0 diff --git a/f77src/hfunc.f b/f77src/hfunc.f index 447a1ef..3e908fe 100755 --- a/f77src/hfunc.f +++ b/f77src/hfunc.f @@ -279,7 +279,7 @@ SUBROUTINE hfunc(I,J,NHW,NHE,NVN,NVS) C IF(ISTYP(NZ,NY,NX).EQ.0.AND.IDAY(6,NB,NZ,NY,NX).EQ.0)THEN WFNS=AMIN1(1.0,AMAX1(0.0,PSILG(NZ,NY,NX)-PSILM)) - WFNSP=WFNS**0.25 + WFNSP=WFNS**0.167 RNI=RNI*WFNSP RLA=RLA*WFNSP ENDIF diff --git a/f77src/hour1.f b/f77src/hour1.f index 049cc32..1d01236 100755 --- a/f77src/hour1.f +++ b/f77src/hour1.f @@ -72,7 +72,7 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) 4,ANH3X=0.07,AH2GX=0.14) PARAMETER (ALBRW=0.1,ALBPW=0.1,ABSRW=1.0-ALBRW,ABSPW=1.0-ALBPW) PARAMETER (VISC=0.28E-12,BKDSX=1.89,ZW=0.005,CFW=0.5,FPSISR=-4.0 - 2,FORGW=0.25E+06,HYGR=-2500.0,DTHETW=1.0E-06 + 2,FORGW=0.25E+06,PSIMA=-0.01E-03,DTHETW=1.0E-06 3,THETPW=0.01,THETWP=1.0-THETPW) DATA XVOLWC/5.0E-04,2.5E-04,2.5E-04/ DATA THETRX/8.0E-06,8.0E-06,8.0E-06/ @@ -541,9 +541,17 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) C IF(IFLGS(NY,NX).NE.0)THEN DO 9975 L=NU(NY,NX),NL(NY,NX) +C IF(FHOL(L,NY,NX).LT.0.0)THEN +C THETH=EXP((PSIMS(NY,NX)-LOG(-PSISE(L,NY,NX)-PSIMA)) +C 2*PSD(L,NY,NX)/PSISD(NY,NX)+PSL(L,NY,NX)) +C FHOL(L,NY,NX)=POROS(L,NY,NX)-THETH +C WRITE(*,3332)'FHOL',IYRC,L,FHOL(L,NY,NX),POROS(L,NY,NX) +C 2,THETH,FC(L,NY,NX),PSISE(L,NY,NX),PSIMA,-PSISE(L,NY,NX)-PSIMA +C ENDIF VOLT(L,NY,NX)=AREA(3,L,NY,NX)*DLYR(3,L,NY,NX) VOLX(L,NY,NX)=VOLT(L,NY,NX)*FMPR(L,NY,NX) BKDS(L,NY,NX)=AMIN1(0.99*BKDSX,BKDS(L,NY,NX)) + 2/(1.0-FHOL(L,NY,NX)) BKVL(L,NY,NX)=BKDS(L,NY,NX)*VOLX(L,NY,NX) IF(BKVL(L,NY,NX).GT.0.0)THEN CORGC(L,NY,NX)=ORGC(L,NY,NX)/BKVL(L,NY,NX) @@ -556,13 +564,18 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) CSILT(L,NY,NX)=0.0 CCLAY(L,NY,NX)=0.0 ENDIF + IF(BKDS(L,NY,NX).GT.ZERO)THEN CORGCM=AMAX1(0.0,AMIN1(1.0,2.0E-06*CORGC(L,NY,NX))) PTDS=1.30*CORGCM+2.66*(1.0-CORGCM) -C IF(L.EQ.NU(NY,NX))THEN -C POROS(L,NY,NX)=AMAX1(POROS(L,NY,NX),1.0-(BKDS(L,NY,NX)/PTDS)) -C ELSE -C POROS(L,NY,NX)=1.0-(BKDS(L,NY,NX)/PTDS) -C ENDIF + IF(L.EQ.NU(NY,NX))THEN + POROS(L,NY,NX)=AMAX1(POROS(L,NY,NX),1.0-(BKDS(L,NY,NX)/PTDS)) + ELSE + POROS(L,NY,NX)=1.0-(BKDS(L,NY,NX)/PTDS) + ENDIF + ELSE + PTDS=0.0 + POROS(L,NY,NX)=1.0 + ENDIF POROQ(L,NY,NX)=POROS(L,NY,NX)**0.667 VOLA(L,NY,NX)=POROS(L,NY,NX)*VOLX(L,NY,NX) VOLAH(L,NY,NX)=FHOL(L,NY,NX)*VOLT(L,NY,NX) @@ -578,10 +591,17 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) ELSE SRP(L,NY,NX)=1.0 ENDIF + PSL(L,NY,NX)=LOG(POROS(L,NY,NX)) + IF((ISOIL(1,L,NY,NX).EQ.0.AND.ISOIL(2,L,NY,NX).EQ.0) + 2.OR.DATA(20).EQ.'YES')THEN + FCL(L,NY,NX)=LOG(FC(L,NY,NX)) + WPL(L,NY,NX)=LOG(WP(L,NY,NX)) + PSD(L,NY,NX)=PSL(L,NY,NX)-FCL(L,NY,NX) + FCD(L,NY,NX)=FCL(L,NY,NX)-WPL(L,NY,NX) + ELSE C -C SOIL HYDROLOGIC PROPERTIES (FIELD CAPACITY, WILTING POINT) +C DEFAULT SOIL HYDROLOGIC PPTYS (FIELD CAPACITY, WILTING POINT) C - IF(ISOIL(1,L,NY,NX).EQ.1.OR.ISOIL(2,L,NY,NX).EQ.1)THEN IF(DATA(20).EQ.'NO')THEN IF(ISOIL(1,L,NY,NX).EQ.1)THEN IF(CORGC(L,NY,NX).LT.FORGW)THEN @@ -598,9 +618,9 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) ENDIF FC(L,NY,NX)=FC(L,NY,NX)/(1.0-FHOL(L,NY,NX)) FC(L,NY,NX)=AMIN1(0.75*POROS(L,NY,NX),FC(L,NY,NX)) - WRITE(*,3332)'FC',IYRC,L,FC(L,NY,NX),CCLAY(L,NY,NX),CORGC(L,NY,NX) - 2,CSAND(L,NY,NX) -3332 FORMAT(A8,2I4,12E12.4) +C WRITE(*,3332)'FC',IYRC,I,J,L,FC(L,NY,NX),CCLAY(L,NY,NX) +C 2,CORGC(L,NY,NX),CSAND(L,NY,NX) +3332 FORMAT(A8,4I6,20E12.4) ENDIF IF(ISOIL(2,L,NY,NX).EQ.1)THEN IF(CORGC(L,NY,NX).LT.FORGW)THEN @@ -617,9 +637,13 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) ENDIF WP(L,NY,NX)=WP(L,NY,NX)/(1.0-FHOL(L,NY,NX)) WP(L,NY,NX)=AMIN1(0.75*FC(L,NY,NX),WP(L,NY,NX)) - WRITE(*,3332)'WP',IYRC,L,WP(L,NY,NX),CCLAY(L,NY,NX),CORGC(L,NY,NX) - 2,FC(L,NY,NX) +C WRITE(*,3332)'WP',IYRC,I,J,L,WP(L,NY,NX),CCLAY(L,NY,NX) +C 2,CORGC(L,NY,NX),FC(L,NY,NX) ENDIF + FCL(L,NY,NX)=LOG(FC(L,NY,NX)) + WPL(L,NY,NX)=LOG(WP(L,NY,NX)) + PSD(L,NY,NX)=PSL(L,NY,NX)-FCL(L,NY,NX) + FCD(L,NY,NX)=FCL(L,NY,NX)-WPL(L,NY,NX) ENDIF IF(THW(L,NY,NX).GT.1.0.OR.DPTH(L,NY,NX).GE.DTBLZ(NY,NX))THEN THW(L,NY,NX)=POROS(L,NY,NX) @@ -648,16 +672,11 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) VOLIH(L,NY,NX)=THETI(L,NY,NX)*VOLAH(L,NY,NX) ENDIF ENDIF - PSL(L,NY,NX)=LOG(POROS(L,NY,NX)) - FCL(L,NY,NX)=LOG(FC(L,NY,NX)) - WPL(L,NY,NX)=LOG(WP(L,NY,NX)) - PSD(L,NY,NX)=PSL(L,NY,NX)-FCL(L,NY,NX) - FCD(L,NY,NX)=FCL(L,NY,NX)-WPL(L,NY,NX) VOLP(L,NY,NX)=AMAX1(0.0,VOLA(L,NY,NX)-VOLW(L,NY,NX) 2-VOLI(L,NY,NX))+AMAX1(0.0,VOLAH(L,NY,NX)-VOLWH(L,NY,NX) 3-VOLIH(L,NY,NX)) THETP(L,NY,NX)=VOLP(L,NY,NX)/VOLT(L,NY,NX) - THETY(L,NY,NX)=EXP((PSIMX(NY,NX)-LOG(-HYGR)) + THETY(L,NY,NX)=EXP((PSIMX(NY,NX)-LOG(-PSIHY)) 2*FCD(L,NY,NX)/PSIMD(NY,NX)+FCL(L,NY,NX)) C C SATURATED HYDRAULIC CONDUCTIVITY FROM SWC AT SATURATION VS. @@ -672,8 +691,9 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) SCNV(L,NY,NX)=0.10+75.0*1.0E-15**BKDS(L,NY,NX) SCNV(L,NY,NX)=SCNV(L,NY,NX)*FMPR(L,NY,NX) ENDIF - WRITE(*,3332)'SCNV',IYRC,L,SCNV(L,NY,NX),POROS(L,NY,NX),THETF - 2,FMPR(L,NY,NX) +C WRITE(*,3332)'SCNV',IYRC,I,J,L,SCNV(L,NY,NX),POROS(L,NY,NX) +C 2,THETF,FMPR(L,NY,NX),PSIMS(NY,NX),LOG(0.033) +C 3,PSL(L,NY,NX),FCL(L,NY,NX),PSISD(NY,NX) ENDIF IF(ISOIL(4,L,NY,NX).EQ.1)THEN IF(CORGC(L,NY,NX).LT.FORGW)THEN @@ -684,14 +704,14 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) SCNH(L,NY,NX)=0.10+75.0*1.0E-15**BKDS(L,NY,NX) SCNH(L,NY,NX)=SCNH(L,NY,NX)*FMPR(L,NY,NX) ENDIF - WRITE(*,3332)'SCNH',IYRC,L,SCNH(L,NY,NX),POROS(L,NY,NX),THETF - 2,FMPR(L,NY,NX) +C WRITE(*,3332)'SCNH',IYRC,I,J,L,SCNH(L,NY,NX),POROS(L,NY,NX) +C 2,THETF,FMPR(L,NY,NX) ENDIF -C WRITE(*,3333)'PPTYS',I,J,NX,NY,L,ISOIL(1,L,NY,NX) -C 2,ISOIL(2,L,NY,NX),ISOIL(3,L,NY,NX),ISOIL(4,L,NY,NX) -C 3,SCNV(L,NY,NX),POROS(L,NY,NX),THETF -C 2,FC(L,NY,NX),WP(L,NY,NX),BKDS(L,NY,NX),THW(L,NY,NX) -C 3,THETW(L,NY,NX),THI(L,NY,NX),THETI(L,NY,NX) + WRITE(*,3333)'PPTYS',I,J,NX,NY,L,ISOIL(1,L,NY,NX) + 2,ISOIL(2,L,NY,NX),ISOIL(3,L,NY,NX),ISOIL(4,L,NY,NX) + 3,SCNV(L,NY,NX),SCNH(L,NY,NX),POROS(L,NY,NX),THETF + 2,FC(L,NY,NX),WP(L,NY,NX),BKDS(L,NY,NX),THW(L,NY,NX) + 3,VOLW(L,NY,NX),THI(L,NY,NX),THETI(L,NY,NX) 3333 FORMAT(A8,9I4,20E12.4) C C HYDRAULIC CONDUCTIVITY FUNCTION FROM KSAT AND SOIL WATER RELEASE CURVE @@ -702,7 +722,7 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) XK=K-1 THETK=POROS(L,NY,NX)-(XK/100.0*POROS(L,NY,NX)) IF(THETK.LT.FC(L,NY,NX))THEN - PSISK(K)=AMAX1(HYGR,-EXP(PSIMX(NY,NX) + PSISK(K)=AMAX1(PSIHY,-EXP(PSIMX(NY,NX) 2+((FCL(L,NY,NX)-LOG(THETK)) 3/FCD(L,NY,NX)*PSIMD(NY,NX)))) ELSEIF(THETK.LT.POROS(L,NY,NX)-DTHETW)THEN @@ -760,6 +780,7 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) C SOIL HEAT CAPACITY AND THERMAL CONDUCTIVITY OF SOLID PHASE C FROM SOC AND TEXTURE C + IF(BKDS(L,NY,NX).GT.ZERO)THEN VORGC=CORGCM*BKDS(L,NY,NX)/PTDS VMINL=(CSILT(L,NY,NX)+CCLAY(L,NY,NX))*BKDS(L,NY,NX)/PTDS VSAND=CSAND(L,NY,NX)*BKDS(L,NY,NX)/PTDS @@ -768,16 +789,21 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) 3+0.514*ROCK(L,NY,NX)*1.056E-02 DTC(L,NY,NX)=(1.253*VORGC+0.514*VMINL+0.386*VSAND) 2*FMPR(L,NY,NX)+0.514*ROCK(L,NY,NX) -C VHCM(L,NY,NX)=((2.496*VORGC+2.385*VMINL+2.128*VSAND) -C 2*FMPR(L,NY,NX)+2.128*ROCK(L,NY,NX)) -C 3*AREA(3,L,NY,NX)*DLYR(3,L,NY,NX) + VHCM(L,NY,NX)=((2.496*VORGC+2.385*VMINL+2.128*VSAND) + 2*FMPR(L,NY,NX)+2.128*ROCK(L,NY,NX)) + 3*AREA(3,L,NY,NX)*DLYR(3,L,NY,NX) + ELSE + STC(L,NY,NX)=0.0 + DTC(L,NY,NX)=0.0 + VHCM(L,NY,NX)=0.0 + ENDIF 9975 CONTINUE C C SURFACE RESIDUE PROPERTIES C CORGC(0,NY,NX)=0.5E+06 FCR(NY,NX)=(-0.03/PSISE(0,NY,NX))**(1.0/FPSISR) - THETY(0,NY,NX)=(HYGR/PSISE(0,NY,NX))**(1.0/FPSISR) + THETY(0,NY,NX)=(PSIHY/PSISE(0,NY,NX))**(1.0/FPSISR) DTBLX(NY,NX)=DTBLZ(NY,NX) C C SOIL SURFACE WATER STORAGE CAPACITY @@ -1161,35 +1187,35 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) C C CALCULATE SUBSIDENCE C - IF(BKDS(L,NY,NX).EQ.0.0)THEN +C IF(BKDS(L,NY,NX).EQ.0.0)THEN C 2.AND.CDPTH(L-1,NY,NX).LT.DPTHA(NY,NX))THEN - DDLYR=(1.0-(VOLW(L,NY,NX)+VOLI(L,NY,NX))/VOLA(L,NY,NX)) - 2*DLYR(3,L,NY,NX) - IF(DLYR(3,L,NY,NX).GT.1.0E-03.OR.DDLYR.LT.0.0)THEN - DO 900 LL=NU(NY,NX),L - CDPTH(LL-1,NY,NX)=CDPTH(LL-1,NY,NX)+DDLYR +C DDLYR=(1.0-(VOLW(L,NY,NX)+VOLI(L,NY,NX))/VOLA(L,NY,NX)) +C 2*DLYR(3,L,NY,NX) +C IF(DLYR(3,L,NY,NX).GT.1.0E-03.OR.DDLYR.LT.0.0)THEN +C DO 900 LL=NU(NY,NX),L +C CDPTH(LL-1,NY,NX)=CDPTH(LL-1,NY,NX)+DDLYR 900 CONTINUE - DO 905 LL=NU(NY,NX),L - DLYR(3,LL,NY,NX)=(CDPTH(LL,NY,NX)-CDPTH(LL-1,NY,NX)) - DPTH(LL,NY,NX)=0.5*(CDPTH(LL,NY,NX)+CDPTH(LL-1,NY,NX)) - VOLT(L,NY,NX)=AREA(3,L,NY,NX)*DLYR(3,L,NY,NX) - VOLX(L,NY,NX)=VOLT(L,NY,NX)*FMPR(L,NY,NX) - VOLA(L,NY,NX)=POROS(L,NY,NX)*VOLX(L,NY,NX) +C DO 905 LL=NU(NY,NX),L +C DLYR(3,LL,NY,NX)=(CDPTH(LL,NY,NX)-CDPTH(LL-1,NY,NX)) +C DPTH(LL,NY,NX)=0.5*(CDPTH(LL,NY,NX)+CDPTH(LL-1,NY,NX)) +C VOLT(L,NY,NX)=AREA(3,L,NY,NX)*DLYR(3,L,NY,NX) +C VOLX(L,NY,NX)=VOLT(L,NY,NX)*FMPR(L,NY,NX) +C VOLA(L,NY,NX)=POROS(L,NY,NX)*VOLX(L,NY,NX) C IF((I/30)*30.EQ.I.AND.J.EQ.15)THEN C WRITE(*,1114)'DDLYR',I,J,L,LL,DDLYR,VOLW(LL,NY,NX) C 2,VOLI(LL,NY,NX),VOLA(LL,NY,NX),CDPTH(LL-1,NY,NX) 1114 FORMAT(A8,4I4,12E12.4) C ENDIF 905 CONTINUE - ENDIF - ENDIF - CDPTHZ(L,NY,NX)=CDPTH(L,NY,NX)-CDPTH(NU(NY,NX),NY,NX) - 2+DLYR(3,NU(NY,NX),NY,NX) - IF(L.EQ.NU(NY,NX))THEN - DPTHZ(L,NY,NX)=0.5*CDPTHZ(L,NY,NX) - ELSE - DPTHZ(L,NY,NX)=0.5*(CDPTHZ(L,NY,NX)+CDPTHZ(L-1,NY,NX)) - ENDIF +C ENDIF +C ENDIF +C CDPTHZ(L,NY,NX)=CDPTH(L,NY,NX)-CDPTH(NU(NY,NX),NY,NX) +C 2+DLYR(3,NU(NY,NX),NY,NX) +C IF(L.EQ.NU(NY,NX))THEN +C DPTHZ(L,NY,NX)=0.5*CDPTHZ(L,NY,NX) +C ELSE +C DPTHZ(L,NY,NX)=0.5*(CDPTHZ(L,NY,NX)+CDPTHZ(L-1,NY,NX)) +C ENDIF C C CALCULATE SOIL CONCENTRATIONS OF SOLUTES, GASES C @@ -1448,7 +1474,7 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) 2*EXP(0.597-0.0199*TCS(L,NY,NX))*FH2O C IF(BKVL(L,NY,NX).GT.0.0)THEN IF(THETW(L,NY,NX).LT.FC(L,NY,NX))THEN - PSISM(L,NY,NX)=AMAX1(HYGR,-EXP(PSIMX(NY,NX) + PSISM(L,NY,NX)=AMAX1(PSIHY,-EXP(PSIMX(NY,NX) 2+((FCL(L,NY,NX)-LOG(THETW(L,NY,NX))) 3/FCD(L,NY,NX)*PSIMD(NY,NX)))) ELSEIF(THETW(L,NY,NX).LT.POROS(L,NY,NX)-DTHETW)THEN @@ -2100,7 +2126,7 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) C RADIATION REFLECTED FROM GROUND SURFACE C IF(VHCPW(NY,NX).GT.VHCPWX(NY,NX))THEN - ALBW=(0.85*VOLSS(NY,NX)+0.30*VOLIS(NY,NX)+0.06*VOLWS(NY,NX)) + ALBW=(0.80*VOLSS(NY,NX)+0.30*VOLIS(NY,NX)+0.06*VOLWS(NY,NX)) 2/(VOLSS(NY,NX)+VOLIS(NY,NX)+VOLWS(NY,NX)) FSNOW=AMIN1((DPTHS(NY,NX)/0.07)**2,1.0) ALBG=FSNOW*ALBW+(1.0-FSNOW)*ALBS(NY,NX) @@ -2850,11 +2876,11 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) ENDIF DO 9964 L=0,NL(NY,NX) IF(L.EQ.LFDPTH)THEN - ZNHUI(L,NY,NX)=1.0 ZNHU0(L,NY,NX)=1.0 + ZNHUI(L,NY,NX)=1.0 ELSE - ZNHUI(L,NY,NX)=0.0 ZNHU0(L,NY,NX)=0.0 + ZNHUI(L,NY,NX)=0.0 ENDIF 9964 CONTINUE ENDIF @@ -2863,11 +2889,9 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) IF(L.EQ.LFDPTH)THEN ZNFN0(L,NY,NX)=1.0 ZNFNI(L,NY,NX)=1.0 - ZNFNG(L,NY,NX)=0.0 ELSE ZNFN0(L,NY,NX)=0.0 ZNFNI(L,NY,NX)=0.0 - ZNFNG(L,NY,NX)=1.0 ENDIF 9965 CONTINUE ENDIF @@ -2884,3 +2908,4 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) RETURN END + diff --git a/f77src/nitro.f b/f77src/nitro.f index 0d25191..bc57c9d 100755 --- a/f77src/nitro.f +++ b/f77src/nitro.f @@ -20,6 +20,7 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) include "blk15b.h" include "blk18a.h" include "blk18b.h" + include "blk19a.h" include "blk21b.h" DIMENSION CNOMA(7,0:5),CPOMA(7,0:5),OMA(7,0:5),FOMA(7,0:5) 2,FOMN(7,0:5),RDOSC(4,0:4),RDOSN(4,0:4),RDOSP(4,0:4),RHOSC(4,0:4) @@ -27,10 +28,10 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) 4,SPOSC(4,0:4),RDORC(2,0:4),RDORN(2,0:4),RDORP(2,0:4),SPORC(2) 5,RDOHC(0:4),RDOHN(0:4),RDOHP(0:4),RDOHA(0:4),CSORP(0:4),ZSORP(0:4) 6,PSORP(0:4),CSORPA(0:4),OSRH(0:4),RUPOX(7,0:5),RGN2F(7,0:5) - 8,RGOMO(7,0:5),ROXYM(7,0:5),ROXYP(7,0:5),ROXYO(7,0:5),RDNO3(7,0:5) - 9,RDNOB(7,0:5),RDNO2(7,0:5),RDN2B(7,0:5),RDN2O(7,0:5),RGOMD(7,0:5) - 1,RMOMC(2,7,0:5),RINH4(7,0:5),RINO3(7,0:5),RIPO4(7,0:5) - 2,RINB4(7,0:5),RINB3(7,0:5),RIPOB(7,0:5),FOMK(7,0:5) + 8,RGOMO(7,0:5),ROXYM(7,0:5),ROXYP(7,0:5),ROXYO(7,0:5) + 9,RDNO3(7,0:5),RDNOB(7,0:5),RDNO2(7,0:5),RDN2B(7,0:5),RDN2O(7,0:5) + 1,RGOMD(7,0:5),RMOMC(2,7,0:5),RINH4(7,0:5),RINO3(7,0:5) + 2,RIPO4(7,0:5),RINB4(7,0:5),RINB3(7,0:5),RIPOB(7,0:5),FOMK(7,0:5) 3,RDOMC(2,7,0:5),RDOMN(2,7,0:5),RDOMP(2,7,0:5),RHOMC(2,7,0:5) 4,RHOMN(2,7,0:5),RHOMP(2,7,0:5),RCOMC(2,7,0:5),RCOMN(2,7,0:5) 5,RCOMP(2,7,0:5),CGOMC(7,0:5),CGOMN(7,0:5),RH2GX(7,0:5) @@ -65,20 +66,20 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) 2,BIOA=BIOS*12.57*ORAD**2,DCKI=2.5,RCCX=0.833 3,RCCQ=0.833,RCCZ=0.167,RCCY=0.833,FPRIM=5.0E-02,FPRIMM=1.0E-06 4,OMGR=0.250,OQKI=1.2E+03,H2KI=1.0,OAKI=12.0,COMKI=1.0E-03 - 5,COMKM=1.0E-04,CKC=1.0E-03,FOSCZ0=2.0E-02 - 6,FOSCZL=5.0E-06,FMN=1.0E-03,DCKM0=5.0E+03,DCKML=1.0E+03) + 5,COMKM=1.0E-04,CKC=1.0E-03,FOSCZ0=2.0E-02,FOSCZL=5.0E-06 + 6,FMN=1.0E-03,DCKM0=5.0E+03,DCKML=1.0E+03) C C SPECIFIC RESPIRATION RATES, M-M UPTAKE CONSTANTS, C STOICHIOMETRIC CONSTANTS FOR MICROBIAL REDOX REACTIONS C - PARAMETER (VMXO=0.125,VMXF=0.125,VMXM=0.125,VMXH=0.25,VMXN=0.25 - 2,VMX4=0.25,VMXC=0.125,OQKM=1.2E+01,OQKA=1.2E+01,OQKAM=1.2E+01 - 3,CCKM=0.15,CCK4=1.2E-04,ZHKM=1.4E-04,ZNKM=1.4,Z3KM=1.4 - 4,Z2KM=1.4,Z1KM=0.014,Z4MX=5.0E-03,Z4KU=0.40,Z4MN=0.0125 - 5,ZOMX=5.0E-03,ZOKU=0.35,ZOMN=0.03,HPMX=1.0E-03,HPKU=0.075 - 6,HPMN=0.002,ZFKM=0.14,H2KM=0.01,ECNH=0.30 - 7,ECNO=0.10,ECN3=0.857,ECN2=0.857,ECN1=0.429,RNFNI=5.0E-04 - 8,RNFNG=0.05,ECHO=0.75,VMKI=8.0,OXKA=0.32 + PARAMETER (VMXO=0.125,VMXF=0.125,VMXM=0.125,VMXH=0.375 + 2,VMXN=0.25,VMX4=0.375,VMXC=0.125,OQKM=1.2E+01,OQKA=1.2E+01 + 3,OQKAM=1.2E+01,CCKM=0.15,CCK4=1.2E-04,ZHKM=1.4,ZHKI=7.0E+03 + 4,ZNKM=1.4,Z3KM=1.4,Z2KM=1.4,Z1KM=0.014,Z4MX=5.0E-03 + 5,Z4KU=0.40,Z4MN=0.0125,ZOMX=5.0E-03,ZOKU=0.35,ZOMN=0.03 + 7,HPMX=1.0E-03,HPKU=0.075,HPMN=0.002,ZFKM=0.14,H2KM=0.01 + 8,ECNH=0.30,ECNO=0.10,ECN3=0.857,ECN2=0.857,ECN1=0.429 + 9,RNFNI=2.0E-04,ECHO=0.75,VMKI=0.125,VHKI=15.0,OXKA=0.16 9,EDNH=1.00,EDNA=1.00) C C ENERGY REQUIREMENTS FOR MICROBIAL GROWTH AND @@ -125,15 +126,26 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) IF(L.EQ.0)THEN KL=2 IF(VOLWRX(NY,NX).GT.ZEROS(NY,NX))THEN - VOLWZ=AMAX1(0.0,(AMIN1(FCR(NY,NX),VOLW(0,NY,NX)/VOLWRX(NY,NX)) - 2-THETY(L,NY,NX))*VOLWRX(NY,NX)) + THETR=VOLW(0,NY,NX)/VOLWRX(NY,NX) + THETZ=AMAX1(0.0,(AMIN1(FCR(NY,NX),THETR)-THETY(L,NY,NX))) + VOLWZ=THETZ/(1.0+THETZ)*VOLWRX(NY,NX) +C IF((I/30)*30.EQ.I.AND.J.EQ.24)THEN +C WRITE(*,8824)'THETZ',I,J,L,THETZ,THETR,VOLWZ,VOLWRX(NY,NX) +C 2,POROS(L,NY,NX),FCR(NY,NX),THETY(L,NY,NX) +C ENDIF ELSE VOLWZ=0.0 ENDIF ELSE KL=4 - VOLWZ=AMAX1(0.0,(AMIN1(AMAX1(0.5*POROS(L,NY,NX),FC(L,NY,NX)) - 2,THETW(L,NY,NX))-THETY(L,NY,NX))*VOLX(L,NY,NX)) + THETZ=AMAX1(0.0,(AMIN1(AMAX1(0.5*POROS(L,NY,NX),FC(L,NY,NX)) + 2,THETW(L,NY,NX))-THETY(L,NY,NX))) + VOLWZ=THETZ/(1.0+THETZ)*VOLX(L,NY,NX) +C IF((I/30)*30.EQ.I.AND.J.EQ.24)THEN +C WRITE(*,8824)'THETZ',I,J,L,THETZ,THETW(L,NY,NX),VOLWZ +C 2,VOLX(L,NY,NX),POROS(L,NY,NX),FC(L,NY,NX),THETY(L,NY,NX) +8824 FORMAT(A8,3I4,12E12.4) +C ENDIF ENDIF C C TEMPERATURE FUNCTIONS FOR GROWTH AND MAINTENANCE @@ -149,20 +161,6 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) OXYI=1.0-1.0/(1.0+EXP(1.0*(-COXYS(L,NY,NX)+3.0))) ORGCX=AMIN1(1.0E+05*BKVL(L,NY,NX),ORGC(L,NY,NX)) C -C NITRIFICATION INHIBITION -C - IF(ZNFN0(L,NY,NX).GT.ZEROS(NY,NX))THEN - TFNI=AMAX1(0.2,TFNX) - ZNFNI(L,NY,NX)=AMAX1(0.0,ZNFNI(L,NY,NX)-RNFNI*TFNI) - ZNFNG(L,NY,NX)=ZNFNG(L,NY,NX)+RNFNG*TFNI - 2*(1.0-ZNFNG(L,NY,NX)) - ZNFNA=1.0-ZNFNI(L,NY,NX)*ZNFNG(L,NY,NX) - ELSE - ZNFNI(L,NY,NX)=0.0 - ZNFNG(L,NY,NX)=1.0 - ZNFNA=1.0 - ENDIF -C C BIOLOGICALLY AVAILABLE WATER, TOTAL MINERAL NH4, NO3 AND PO4 C ZNH4T(L)=AMAX1(0.0,ZNH4S(L,NY,NX))+AMAX1(0.0,ZNH4B(L,NY,NX)) @@ -206,6 +204,7 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) FH2PB=VLPOB(L,NY,NX) ENDIF COXYQ1=COXYG(L,NY,NX)*SOXYL(L,NY,NX) + XCO2=CCO2S(L,NY,NX)/(CCO2S(L,NY,NX)+CCKM) C C TOTAL SUBSTRATE C @@ -386,24 +385,6 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) ELSE LL=NU(NY,NX) ENDIF - IF(OSC(1,4,LL,NY,NX).GT.ZEROS(NY,NX))THEN - CNSHY1=AMIN1(CNRH(4),OSN(1,4,LL,NY,NX)/OSC(1,4,LL,NY,NX)) - CPSHY1=AMIN1(CPRH(4),OSP(1,4,LL,NY,NX)/OSC(1,4,LL,NY,NX)) - ELSE - CNSHY1=CNRH(4) - CPSHY1=CPRH(4) - ENDIF - IF(OSC(2,4,LL,NY,NX).GT.ZEROS(NY,NX))THEN - CNSHY2=AMIN1(CNRH(4),OSN(2,4,LL,NY,NX)/OSC(2,4,LL,NY,NX)) - CPSHY2=AMIN1(CPRH(4),OSP(2,4,LL,NY,NX)/OSC(2,4,LL,NY,NX)) - ELSE - CNSHY2=CNRH(4) - CPSHY2=CPRH(4) - ENDIF - CNSHY=CNSHY1*CFOMC(1,LL,NY,NX)+CNSHY2*CFOMC(2,LL,NY,NX) - CPSHY=CPSHY1*CFOMC(1,LL,NY,NX)+CPSHY2*CFOMC(2,LL,NY,NX) - FNSHY=AMIN1(1.5,0.67+6.7*CNSHY) - FPSHY=AMIN1(1.5,0.67+67.0*CPSHY) DO 760 K=0,5 IF(L.NE.0.OR.(K.NE.3.AND.K.NE.4))THEN TCGOQC(K)=0.0 @@ -730,7 +711,6 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) C (3) CH4 OXIDIZERS, (5) H2TROPHIC METHANOGENS C ELSEIF(K.EQ.5)THEN - XCO2=CCO2S(L,NY,NX)/(CCO2S(L,NY,NX)+CCKM) C C NH3 OXIDIZERS C @@ -752,42 +732,55 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) TFNH4X=TFNH4X+FNH4 TFNH4B=TFNH4B+FNB4 C +C NITRIFICATION INHIBITION +C + IF(ZNFN0(L,NY,NX).GT.ZEROS(NY,NX))THEN + ZNFNI(L,NY,NX)=ZNFNI(L,NY,NX)*(1.0-RNFNI*TFNX) + ZNFN4S=ZNFN0(L,NY,NX)-ZNFNI(L,NY,NX)/(1.0+CNH4S(L,NY,NX)/ZHKI) + ZNFN4B=ZNFN0(L,NY,NX)-ZNFNI(L,NY,NX)/(1.0+CNH4B(L,NY,NX)/ZHKI) + ELSE + ZNFN4S=1.0 + ZNFN4B=1.0 + ENDIF +C C NH3 OXIDATION FROM SPECIFIC OXIDATION RATE, ENERGY YIELD, C ACTIVE OXIDIZER BIOMASS, TEMPERATURE, AQUEOUS CO2 AND C NH3 CONCENTRATIONS IN BAND AND NON-BAND SOIL ZONES C ECHZ=EO2X - VMXA=TFNG(N,K)*FCNP(N,K)*XCO2*OMA(N,K)*VMXH - FCN3S=FNH4S*CNH3S(L,NY,NX)/(CNH3S(L,NY,NX)+ZHKM) - FCN3B=FNHBS*CNH3B(L,NY,NX)/(CNH3B(L,NY,NX)+ZHKM) - FSBST=FCN3S+FCN3B - RVMX4S=VMXA*FCN3S*ZNFNA - RVMX4B=VMXA*FCN3B*ZNFNA - RNNH4=AMAX1(0.0,AMIN1(RVMX4S,FNH4*ZNH4S(L,NY,NX))) - RNNHB=AMAX1(0.0,AMIN1(RVMX4B,FNB4*ZNH4B(L,NY,NX))) + VMXX=VMXH*TFNG(N,K)*FCNP(N,K)*XCO2*OMA(N,K) + IF(VOLWZ.GT.ZEROS(NY,NX))THEN + VMXA=VMXX/(1.0+VMXX/(VHKI*VOLWZ)) + ELSE + VMXA=0.0 + ENDIF + FCN4S=FNH4S*CNH4S(L,NY,NX)/(CNH4S(L,NY,NX)+ZHKM) + FCN4B=FNHBS*CNH4B(L,NY,NX)/(CNH4B(L,NY,NX)+ZHKM) + FSBST=FCN4S+FCN4B + VMX4S=VMXA*FCN4S + VMX4B=VMXA*FCN4B + RNNH4=AMAX1(0.0,AMIN1(VMX4S,FNH4*ZNH4S(L,NY,NX)))*ZNFN4S + RNNHB=AMAX1(0.0,AMIN1(VMX4B,FNB4*ZNH4B(L,NY,NX)))*ZNFN4B RVOXP=RNNH4+RNNHB RVOXPA=RNNH4 RVOXPB=RNNHB RGOMP=AMAX1(0.0,RVOXP*ECNH*ECHZ) - RVMX4(N,K,L,NY,NX)=RVMX4S - RVMB4(N,K,L,NY,NX)=RVMX4B + RVMX4(N,K,L,NY,NX)=VMX4S + RVMB4(N,K,L,NY,NX)=VMX4B C C O2 DEMAND FROM NH3 OXIDATION C ROXYM(N,K)=2.667*RGOMP ROXYP(N,K)=ROXYM(N,K)+3.429*RVOXP ROXYS(N,K,L,NY,NX)=ROXYP(N,K) -C IF((I/1)*1.EQ.I.AND.J.EQ.14.AND.L.LE.5)THEN -C WRITE(*,6666)'NITRI',I,J,L,K,N,RNNH4,RNNHB -C 2,ZNH4S(L,NY,NX),ZNH4B(L,NY,NX),CNH4S(L,NY,NX),CNH4B(L,NY,NX) -C 3,CNH3S(L,NY,NX),CNH3B(L,NY,NX),COXYS(L,NY,NX),FNH4S,FNHBS -C 4,PH(L,NY,NX),TFNG,FCNP(N,K),XCO2,ROXYM(N,K),OMA(N,K) -C 5,FCN3S,FCN3B,VLNH4(L,NY,NX),VLNHB(L,NY,NX),FNH4,FNB4 -C 6,DPNH4(NY,NX),COXYG(L,NY,NX),RVMX4S,RVMX4B,VMXA,TFNX,WFNG -C 7,OMC(1,N,K,L,NY,NX),OMC(2,N,K,L,NY,NX),OMC(3,N,K,L,NY,NX) -C 8,TFNI,WFNG,ZNFNI(L,NY,NX),ZNFNG(L,NY,NX),ZNFNA -C 9,SPOMK(1),RMOMK(1),BKVL(L,NY,NX) -6666 FORMAT(A8,5I4,120E12.4) +C IF((I/1)*1.EQ.I.AND.J.EQ.19.AND.L.LE.5)THEN +C WRITE(*,6666)'NITRI',I,J,L,K,N,RNNH4,RNNHB,VMXX,VMXA,VOLWZ +C 2,CNH4S(L,NY,NX),CNH4B(L,NY,NX),14.0*XN4(L,NY,NX),14.0*XNB(L,NY,NX) +C 3,ZNH4S(L,NY,NX),ZNH4B(L,NY,NX),COXYS(L,NY,NX),RGOMP +C 4,PH(L,NY,NX),TFNX,FCNP(N,K),XCO2,ROXYM(N,K) +C 5,VMX4S,VMX4B,FCN4S,FCN4B,FNH4S,FNHBS,OMA(N,K) +C 6,FNH4,FNB4,ZNFN4S,ZNFN4B,ZNFNI(L,NY,NX),ZNFN0(L,NY,NX) +6666 FORMAT(A8,5I4,40E12.4) C ENDIF C C NO2 OXIDIZERS @@ -819,16 +812,16 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) FCN2S=FNH4S*CNO2S(L,NY,NX)/(CNO2S(L,NY,NX)+ZNKM) FCN2B=FNHBS*CNO2B(L,NY,NX)/(CNO2B(L,NY,NX)+ZNKM) FSBST=FCN2S+FCN2B - RVMX2S=VMXA*FCN2S - RVMX2B=VMXA*FCN2B - RNNO2=AMAX1(0.0,AMIN1(RVMX2S,FNO2*ZNO2S(L,NY,NX))) - RNNOB=AMAX1(0.0,AMIN1(RVMX2B,FNB2*ZNO2B(L,NY,NX))) + VMX2S=VMXA*FCN2S + VMX2B=VMXA*FCN2B + RNNO2=AMAX1(0.0,AMIN1(VMX2S,FNO2*ZNO2S(L,NY,NX))) + RNNOB=AMAX1(0.0,AMIN1(VMX2B,FNB2*ZNO2B(L,NY,NX))) RVOXP=RNNO2+RNNOB RVOXPA=RNNO2 RVOXPB=RNNOB RGOMP=AMAX1(0.0,RVOXP*ECNO*ECHZ) - RVMX2(N,K,L,NY,NX)=RVMX2S - RVMB2(N,K,L,NY,NX)=RVMX2B + RVMX2(N,K,L,NY,NX)=VMX2S + RVMB2(N,K,L,NY,NX)=VMX2B C C O2 DEMAND FROM NO2 OXIDATION C @@ -839,7 +832,7 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) C WRITE(*,6667)'NO2OX',I,J,L,K,N,RNNO2,RNNOB,ZNO2S(L,NY,NX) C 2,ZNO2B(L,NY,NX),CNO2S(L,NY,NX),CNO2B(L,NY,NX),CNH3S(L,NY,NX) C 3,CNH3B(L,NY,NX),CNH4S(L,NY,NX),CNH4B(L,NY,NX),CNO3S(L,NY,NX) -C 3,CNO3B(L,NY,NX),CHNO2,CHNOB,VMXA,TFNG(N,K),FCNP(N,K),XCO2,VMXN,ZNKM +C 3,CNO3B(L,NY,NX),CHNO2,CHNOB,VMXA,TFNG(N,K),FCNP(N,K),VMXN,ZNKM C 4,FCN2S,FCN2B,OMA(N,K),FOMN(N,K),TOMN,RVMX2(N,K,L,NY,NX) C 5,RNO2Y(L,NY,NX),FNO2,FNB2,ROXYM(N,K),ROXYP(N,K) C 6,ROXYS(N,K,L,NY,NX),VLNHB(L,NY,NX),VLNOB(L,NY,NX) @@ -1022,7 +1015,7 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) C IF(L.EQ.2.AND.M.EQ.NPH.AND.MX.EQ.NPT)THEN C WRITE(*,5545)'RMPOX',I,J,L,K,N,M,MX,OXYS1,ROXDFQ,ROXYLX,RMPOX C 2,DFGS(M,L,NY,NX),OXYG1,VOLWOX,VOLPOX,VOLWPM,X,B,C -C 3,RUPMX,DIFOX,OXKM,COXYS1,FOXYX,ROXYL(L,NY,NX) +C 3,RUPMX,DIFOX,OXKX,COXYS1,FOXYX,ROXYL(L,NY,NX) C 4,ROXSK(M,L,NY,NX),VOLWM(M,L,NY,NX)/VOLX(L,NY,NX) C 5,OXYS(L,NY,NX) 5545 FORMAT(A8,7I4,30E16.6) @@ -1035,7 +1028,7 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) C 4/(VOLWM(M,L,NY,NX)*FOXYX),OXYG1/(VOLPM(M,L,NY,NX)*FOXYX) C 5,THETW1,THETPM(M,L,NY,NX),DFGS(M,L,NY,NX),ROXSK(M,L,NY,NX) C 6,VOLPM(M,L,NY,NX),VOLWM(M,L,NY,NX),VOLA(L,NY,NX) -C 7,COXYS(L,NY,NX),COXYG(L,NY,NX),ROXYY(L,NY,NX),OXKX +C 7,COXYS(L,NY,NX),COXYG(L,NY,NX),ROXYY(L,NY,NX) 5544 FORMAT(A8,7I4,50E12.4) C ENDIF 425 CONTINUE @@ -1135,24 +1128,27 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) C NOT ACCEPTED BY O2 IN BAND AND NON-BAND SOIL ZONES C ROXYD=AMAX1(0.0,ROXYM(N,K)-ROXYO(N,K)) - VMXDX=EDNH*0.875*ROXYD - IF(VOLWZ.GT.ZEROS(NY,NX).AND.FOSRH(K,L,NY,NX).GT.ZERO)THEN - VMXD3=VMXDX/(1.0+VMKI*ROXYD/(VOLWZ*FOSRH(K,L,NY,NX))) - ELSE - VMXD3=0.0 - ENDIF + VMXD3=EDNH*0.875*ROXYD IF(CNO3S(L,NY,NX).GT.ZERO)THEN - VMXD3S=VMXD3*FNO3S*CNO3S(L,NY,NX)/(CNO3S(L,NY,NX)+Z3KM) + VMXDXS=FNO3S*VMXD3*CNO3S(L,NY,NX)/(CNO3S(L,NY,NX)+Z3KM) 2/(1.0+(CNO2S(L,NY,NX)*Z3KM)/(CNO3S(L,NY,NX)*Z2KM)) ELSE - VMXD3S=0.0 + VMXDXS=0.0 ENDIF IF(CNO3B(L,NY,NX).GT.ZERO)THEN - VMXD3B=VMXD3*FNO3B*CNO3B(L,NY,NX)/(CNO3B(L,NY,NX)+Z3KM) + VMXDXB=FNO3B*VMXD3*CNO3B(L,NY,NX)/(CNO3B(L,NY,NX)+Z3KM) 2/(1.0+(CNO2B(L,NY,NX)*Z3KM)/(CNO3B(L,NY,NX)*Z2KM)) ELSE - VMXD3B=0.0 + VMXDXB=0.0 + ENDIF + VMXDXT=VMXDXS+VMXDXB + IF(VOLWZ.GT.ZEROS(NY,NX).AND.FOSRH(K,L,NY,NX).GT.ZERO)THEN + FVMXDX=1.0/(1.0+VMXDXT/(VMKI*VOLWZ*FOSRH(K,L,NY,NX))) + ELSE + FVMXDX=0.0 ENDIF + VMXD3S=VMXDXS*FVMXDX + VMXD3B=VMXDXB*FVMXDX OQCZ3=AMAX1(0.0,OQC(K,L,NY,NX)*FOQC-RGOCP*WFN(N,K)) OQCD3=OQCZ3/ECN3 OQCD3S=OQCD3*FNO3S @@ -1193,17 +1189,25 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) C VMXD2=VMXD3-RDNOT IF(CNO2S(L,NY,NX).GT.ZERO)THEN - VMXD2S=VMXD2*FNO3S*CNO2S(L,NY,NX)/(CNO2S(L,NY,NX)+Z2KM) + VMXDXS=FNO2S*VMXD2*CNO2S(L,NY,NX)/(CNO2S(L,NY,NX)+Z2KM) 2/(1.0+(CZ2OS(L,NY,NX)*Z2KM)/(CNO2S(L,NY,NX)*Z1KM)) ELSE - VMXD2S=0.0 + VMXDXS=0.0 ENDIF IF(CNO2B(L,NY,NX).GT.ZERO)THEN - VMXD2B=VMXD2*FNO3B*CNO2B(L,NY,NX)/(CNO2B(L,NY,NX)+Z2KM) + VMXDXB=FNO2B*VMXD2*CNO2B(L,NY,NX)/(CNO2B(L,NY,NX)+Z2KM) 2/(1.0+(CZ2OS(L,NY,NX)*Z2KM)/(CNO2B(L,NY,NX)*Z1KM)) ELSE - VMXD2B=0.0 + VMXDXB=0.0 ENDIF + VMXDXT=VMXDXS+VMXDXB + IF(VOLWZ.GT.ZEROS(NY,NX).AND.FOSRH(K,L,NY,NX).GT.ZERO)THEN + FVMXDX=1.0/(1.0+VMXDXT/(VMKI*VOLWZ*FOSRH(K,L,NY,NX))) + ELSE + FVMXDX=0.0 + ENDIF + VMXD2S=VMXDXS*FVMXDX + VMXD2B=VMXDXB*FVMXDX OQCZ2=AMAX1(0.0,OQCZ3-RGOMD3) OQCD2=OQCZ2/ECN2 OQCD2S=OQCD2*FNO3S @@ -1237,7 +1241,13 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) C NOT ACCEPTED BY O2, NO3 AND NO2 IN BAND AND NON-BAND SOIL ZONES C VMXD1=(VMXD2-RDN2T)*2.0 - VMXD1S=VMXD1*CZ2OS(L,NY,NX)/(CZ2OS(L,NY,NX)+Z1KM) + VMXDXS=VMXD1*CZ2OS(L,NY,NX)/(CZ2OS(L,NY,NX)+Z1KM) + IF(VOLWZ.GT.ZEROS(NY,NX).AND.FOSRH(K,L,NY,NX).GT.ZERO)THEN + FVMXDX=1.0/(1.0+VMXDXS/(VMKI*VOLWZ*FOSRH(K,L,NY,NX))) + ELSE + FVMXDX=0.0 + ENDIF + VMXD1S=VMXDXS*FVMXDX OQCZ1=AMAX1(0.0,OQCZ2-RGOMD2) OQCD1=OQCZ1/ECN1 Z2OSX=(Z2OS(L,NY,NX)+RDN2T)*FN2O @@ -1250,7 +1260,7 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) RVMX1(N,K,L,NY,NX)=VMXD1S C TRN2OD(NY,NX)=TRN2OD(NY,NX)+RDNO2(N,K)+RDN2B(N,K) C TRN2GD(NY,NX)=TRN2GD(NY,NX)+RDN2O(N,K) -C IF(J.EQ.16)THEN +C IF((I/1)*1.EQ.I.AND.L.LE.5)THEN C WRITE(*,2222)'DENIT',I,J,L,K,N,RDNO3(N,K),RDNOB(N,K),RDNO2(N,K) C 2,RDN2B(N,K),RDN2O(N,K),TRN2OD(NY,NX),TRN2GD(NY,NX) C 3,COXYS(L,NY,NX),COXYG(L,NY,NX),ROXYM(N,K) @@ -1295,36 +1305,41 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) C NOT ACCEPTED BY O2 C ROXYD=AMAX1(0.0,ROXYM(N,K)-ROXYO(N,K)) - VMXDX=EDNA*0.875*ROXYD*XCO2 - IF(VOLWZ.GT.ZEROS(NY,NX))THEN - VMXDA=VMXDX/(1.0+VMKI*ROXYD/VOLWZ) - ELSE - VMXDA=0.0 - ENDIF - VMXDS=VMXDA*CNO2S(L,NY,NX)/(CNO2S(L,NY,NX)+Z2KM)*FNO2S - VMXDB=VMXDA*CNO2B(L,NY,NX)/(CNO2B(L,NY,NX)+Z2KM)*FNO2B - RDNO2(N,K)=AMAX1(0.0,AMIN1(VMXDS,ZNO2S(L,NY,NX)*FNO2)) - RDN2B(N,K)=AMAX1(0.0,AMIN1(VMXDB,ZNO2B(L,NY,NX)*FNB2)) + VMXD4=EDNA*0.875*ROXYD*XCO2 + VMXDXS=FNO2S*VMXD4*CNO2S(L,NY,NX)/(CNO2S(L,NY,NX)+Z2KM) + VMXDXB=FNO2B*VMXD4*CNO2B(L,NY,NX)/(CNO2B(L,NY,NX)+Z2KM) + VMXDXT=VMXDXS+VMXDXB + IF(VOLWZ.GT.ZEROS(NY,NX))THEN + FVMXDX=1.0/(1.0+VMXDXT/(VMKI*VOLWZ)) + ELSE + FVMXDX=0.0 + ENDIF + VMXD4S=VMXDXS*FVMXDX + VMXD4B=VMXDXB*FVMXDX + ZNO2SX=ZNO2S(L,NY,NX)+RVOXA(1) + ZNO2BX=ZNO2B(L,NY,NX)+RVOXB(1) + RDNO2(N,K)=AMAX1(0.0,AMIN1(VMXD4S,ZNO2SX)) + RDN2B(N,K)=AMAX1(0.0,AMIN1(VMXD4B,ZNO2BX)) RDNOT=RDNO2(N,K)+RDN2B(N,K) RGOMY(N,K)=0.0 RGOMD(N,K)=RDNOT*ECNO*ENOX RDNO3(N,K)=0.0 RDNOB(N,K)=0.0 RDN2O(N,K)=0.0 - RVMX2(N,K,L,NY,NX)=VMXDS - RVMB2(N,K,L,NY,NX)=VMXDB + RVMX2(N,K,L,NY,NX)=VMXD4S + RVMB2(N,K,L,NY,NX)=VMXD4B RVOXA(N)=RVOXA(N)+0.333*RDNO2(N,K) RVOXB(N)=RVOXB(N)+0.333*RDN2B(N,K) C TRN2ON(NY,NX)=TRN2ON(NY,NX)+RDNO2(N,K)+RDN2B(N,K) -C IF((I/1)*1.EQ.I.AND.J.EQ.14.AND.L.LE.5)THEN +C IF((I/1)*1.EQ.I.AND.J.EQ.19.AND.L.LE.5)THEN C WRITE(*,7777)'AUTO',I,J,L,K,N,RDNO2(N,K),RDN2B(N,K),TRN2ON(NY,NX) C 2,CNO2S(L,NY,NX),CNO2B(L,NY,NX),CNO3S(L,NY,NX),CNO3B(L,NY,NX) -C 3,VLNO3(L,NY,NX),VLNOB(L,NY,NX),ZNO2S(L,NY,NX),ZNO2B(L,NY,NX) -C 3,XCO2,FNO2,FNB2,VMXDS,VMXDB,TFNG(N,K),OMA(N,K),COMN,FCN2S,FCN2B -C 2,ROXYP(N,K),ROXYM(N,K),ROXYO(N,K),FOXYX,DFGS(NPH,L,NY,NX) -C 3,THETW(L,NY,NX),WFN(N,K),COXYS(L,NY,NX),COXYG(L,NY,NX) -C 4,ROXYD,ROXYD/VOLWZ,VMXDX,VMXDA,FNO2S,FNO2B -7777 FORMAT(A8,5I4,40E12.4) +C 3,Z2OS(L,NY,NX),VLNOB(L,NY,NX),ZNO2S(L,NY,NX),ZNO2B(L,NY,NX) +C 3,XCO2,FNO2,FNB2,TFNG(N,K),OMA(N,K),ROXYP(N,K) +C 2,ROXYM(N,K),ROXYO(N,K),WFN(N,K),FOXYX +C 3,THETW(L,NY,NX),COXYS(L,NY,NX),COXYG(L,NY,NX) +C 4,ROXYD,VMXD4,VMXDXS,VMXDXB,VMXD4S,VMXD4B,FNO2S,FNO2B,ZNFN4S,ZNFN4B +7777 FORMAT(A8,5I4,50E12.4) C ENDIF ELSE RDNO3(N,K)=0.0 @@ -1621,17 +1636,19 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) C IF(OMC(3,N,K,L,NY,NX).GT.ZEROS(NY,NX) 2.AND.OMC(1,N,K,L,NY,NX).GT.ZEROS(NY,NX))THEN - CCC=AMAX1(0.0,AMIN1 - 2(OMN(3,N,K,L,NY,NX)/(OMN(3,N,K,L,NY,NX) + CCC=AMAX1(0.0,AMIN1(1.0 + 2,OMN(3,N,K,L,NY,NX)/(OMN(3,N,K,L,NY,NX) 2+OMC(3,N,K,L,NY,NX)*CNOMC(3,N,K)) 3,OMP(3,N,K,L,NY,NX)/(OMP(3,N,K,L,NY,NX) 4+OMC(3,N,K,L,NY,NX)*CPOMC(3,N,K)))) CXC=OMC(3,N,K,L,NY,NX)/OMC(1,N,K,L,NY,NX) C3C=1.0/(1.0+CXC/CKC) - CNC=AMAX1(0.0,OMC(3,N,K,L,NY,NX)/(OMC(3,N,K,L,NY,NX) - 2+OMN(3,N,K,L,NY,NX)/CNOMC(3,N,K))) - CPC=AMAX1(0.0,OMC(3,N,K,L,NY,NX)/(OMC(3,N,K,L,NY,NX) - 2+OMP(3,N,K,L,NY,NX)/CPOMC(3,N,K))) + CNC=AMAX1(0.0,AMIN1(1.0 + 2,OMC(3,N,K,L,NY,NX)/(OMC(3,N,K,L,NY,NX) + 2+OMN(3,N,K,L,NY,NX)/CNOMC(3,N,K)))) + CPC=AMAX1(0.0,AMIN1(1.0 + 2,OMC(3,N,K,L,NY,NX)/(OMC(3,N,K,L,NY,NX) + 3+OMP(3,N,K,L,NY,NX)/CPOMC(3,N,K)))) RCCC=RCCZ+AMAX1(CCC,C3C)*RCCY RCCN=CNC*RCCX RCCP=CPC*RCCQ @@ -1669,8 +1686,8 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) RXOMN(M,N,K)=AMAX1(0.0,OMN(M,N,K,L,NY,NX)*SPOMX) RXOMP(M,N,K)=AMAX1(0.0,OMP(M,N,K,L,NY,NX)*SPOMX) RDOMC(M,N,K)=RXOMC(M,N,K)*(1.0-RCCC) - RDOMN(M,N,K)=RXOMN(M,N,K)*(1.0-RCCN)*(1.0-RCCC) - RDOMP(M,N,K)=RXOMP(M,N,K)*(1.0-RCCP)*(1.0-RCCC) + RDOMN(M,N,K)=RXOMN(M,N,K)*(1.0-RCCC)*(1.0-RCCN) + RDOMP(M,N,K)=RXOMP(M,N,K)*(1.0-RCCC)*(1.0-RCCP) R3OMC(M,N,K)=RXOMC(M,N,K)-RDOMC(M,N,K) R3OMN(M,N,K)=RXOMN(M,N,K)-RDOMN(M,N,K) R3OMP(M,N,K)=RXOMP(M,N,K)-RDOMP(M,N,K) @@ -1679,18 +1696,17 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) C DECOMPOSITION RATE, SOIL CLAY AND OC 'EHUM' FROM 'HOUR1' C RHOMC(M,N,K)=AMAX1(0.0,RDOMC(M,N,K)*EHUM(L,NY,NX)) - RHOMN(M,N,K)=AMAX1(0.0,RDOMN(M,N,K)*EHUM(L,NY,NX)*FNSHY) - RHOMP(M,N,K)=AMAX1(0.0,RDOMP(M,N,K)*EHUM(L,NY,NX)*FPSHY) -C IF((I/30)*30.EQ.I.AND.J.EQ.24)THEN + RHOMN(M,N,K)=AMAX1(0.0,RDOMN(M,N,K)*EHUM(L,NY,NX)) + RHOMP(M,N,K)=AMAX1(0.0,RDOMP(M,N,K)*EHUM(L,NY,NX)) +C IF((I/30)*30.EQ.I.AND.J.EQ.24.AND.N.EQ.1.AND.M.EQ.1)THEN C WRITE(*,8821)'RHOMC',I,J,L,K,N,M -C 3,CNSHY,CPSHY,FNSHY,FPSHY +C 2,RDOMC(M,N,K),RDOMN(M,N,K),RDOMP(M,N,K) +C 2,RHOMC(M,N,K),RHOMN(M,N,K),RHOMP(M,N,K) C 4,OMC(M,N,K,L,NY,NX),OMN(M,N,K,L,NY,NX) C 5,OMP(M,N,K,L,NY,NX) C 4,OMC(3,N,K,L,NY,NX),OMN(3,N,K,L,NY,NX) C 5,OMP(3,N,K,L,NY,NX) C 6,OQC(K,L,NY,NX),OQN(K,L,NY,NX),OQP(K,L,NY,NX) -C 2,RDOMC(M,N,K),RDOMN(M,N,K),RDOMP(M,N,K) -C 2,RHOMC(M,N,K),RHOMN(M,N,K),RHOMP(M,N,K) C 2,RCCC,RCCN,RCCP C ENDIF C @@ -1725,8 +1741,8 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) C PRODUCTS C RHMMC(M,N,K)=AMAX1(0.0,RDMMC(M,N,K)*EHUM(L,NY,NX)) - RHMMN(M,N,K)=AMAX1(0.0,RDMMN(M,N,K)*EHUM(L,NY,NX)*FNSHY) - RHMMP(M,N,K)=AMAX1(0.0,RDMMP(M,N,K)*EHUM(L,NY,NX)*FPSHY) + RHMMN(M,N,K)=AMAX1(0.0,RDMMN(M,N,K)*EHUM(L,NY,NX)) + RHMMP(M,N,K)=AMAX1(0.0,RDMMP(M,N,K)*EHUM(L,NY,NX)) RCMMC(M,N,K)=RDMMC(M,N,K)-RHMMC(M,N,K) RCMMN(M,N,K)=RDMMN(M,N,K)-RHMMN(M,N,K) RCMMP(M,N,K)=RDMMP(M,N,K)-RHMMP(M,N,K) @@ -1738,8 +1754,8 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) C 5,CPSHZ,EHUM(L,NY,NX),RXOMT,RMOMT,RMOMT,RGOMO(N,K) C 6,RGOMP,WFN(N,K) C WRITE(*,8821)'RCMMP',I,J,L,K,N,M,RCMMP(M,N,K) -C 2,RDMMP(M,N,K),RHMMP(M,N,K),EHUM(L,NY,NX),FPSHY -C 3,CPSHY1,CPSHY2,RCCC,RCCN,RCCP,RXMMP(M,N,K) +C 2,RDMMP(M,N,K),RHMMP(M,N,K),EHUM(L,NY,NX) +C 3,RCCC,RCCN,RCCP,RXMMP(M,N,K) C ENDIF 730 CONTINUE ELSE @@ -1862,22 +1878,22 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) ENDIF TFNO2X=TFNO2X+FNO2 TFNO2B=TFNO2B+FNB2 - VMXDS=7.5E-02*CHNO2*VOLWM(NPH,L,NY,NX)*TFNX*FNO3S - VMXDB=7.5E-02*CHNOB*VOLWM(NPH,L,NY,NX)*TFNX*FNO3B - RCNO2=AMAX1(0.0,AMIN1(ZNO2S(L,NY,NX)*FNO2,VMXDS)) - RCNOB=AMAX1(0.0,AMIN1(ZNO2B(L,NY,NX)*FNB2,VMXDB)) + VMXC4S=7.5E-02*CHNO2*VOLWM(NPH,L,NY,NX)*FNO3S*TFNX + VMXC4B=7.5E-02*CHNOB*VOLWM(NPH,L,NY,NX)*FNO3B*TFNX + RCNO2=AMAX1(0.0,AMIN1(ZNO2S(L,NY,NX)*FNO2,VMXC4S)) + RCNOB=AMAX1(0.0,AMIN1(ZNO2B(L,NY,NX)*FNB2,VMXC4B)) RCN2O=0.10*RCNO2 RCN2B=0.10*RCNOB RCNO3=0.80*RCNO2 RCN3B=0.80*RCNOB RCOQN=0.10*(RCNO2+RCNOB) - RVMXC(L,NY,NX)=VMXDS - RVMBC(L,NY,NX)=VMXDB -C IF(J.EQ.16)THEN + RVMXC(L,NY,NX)=VMXC4S + RVMBC(L,NY,NX)=VMXC4B +C IF((I/1)*1.EQ.I.AND.L.LE.5)THEN C WRITE(*,7779)'CHEMO',I,J,L,RCNO2,RCNOB,CHY1,CHNO2,CHNOB C 2,CNO2S(L,NY,NX),CNO2B(L,NY,NX),VOLWM(NPH,L,NY,NX),FNO2 -C 3,VMXDS,VMXDB,RVMXC(L,NY,NX),RNO2Y(L,NY,NX),RCN2O,RCN2B,RCNO3 -C 4,RCNOB,RCOQN,VLNO3(L,NY,NX),VLNOB(L,NY,NX) +C 3,VMXC4S,VMXC4B,RVMXC(L,NY,NX),RNO2Y(L,NY,NX),RCN2O,RCN2B +C 4,RCNO3,RCNOB,RCOQN,VLNO3(L,NY,NX),VLNOB(L,NY,NX) 7779 FORMAT(A8,3I4,30E12.4) C ENDIF C @@ -2626,10 +2642,6 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) 640 CONTINUE ENDIF 650 CONTINUE -C IF(J.EQ.12.AND.L.LE.4)THEN -C WRITE(*,3334)'CHEMO',I,J,L,RCN2O,RCN2B -3334 FORMAT(A8,3I4,12E12.4) -C ENDIF DO 645 N=1,7 IF(N.LE.3.OR.N.EQ.5)THEN IF(N.NE.3)THEN @@ -2647,7 +2659,7 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) RUPOXO(L,NY,NX)=TUPOX RN2G(L,NY,NX)=-TRDNO RN2O(L,NY,NX)=-TRDN2-TRD2B-RCN2O-RCN2B+TRDNO -C IF(J.EQ.16)THEN +C IF((I/1)*1.EQ.I.AND.J.EQ.19.AND.L.LE.5)THEN C WRITE(*,2468)'RCO2O',I,J,NX,NY,L,RCO2O(L,NY,NX) C 2,TRGOA,TRGOM,TRGOD,RVOXA(3),RCH4O(L,NY,NX) C 3,CGOMC(3,5),TRGOC @@ -2878,10 +2890,10 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) 7931 CONTINUE 7901 CONTINUE ENDIF -C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.EQ.3)THEN +C IF((I/1)*1.EQ.I.AND.J.EQ.19.AND.L.LE.5)THEN C WRITE(*,2123)'TOTALL',I,J,NX,NY,L,TFOXYX,TFNH4X C 2,TFNO3X,TFPO4X,TFNH4B,TFNO3B,TFPO4B,TFNO2X,TFNO2B -C 3,TFOQC,TFOQA +C 3,TFOQC,TFOQA 2123 FORMAT(A8,5I4,12E15.4) C ENDIF ENDIF diff --git a/f77src/outpd.f b/f77src/outpd.f index 1fe928d..1017880 100755 --- a/f77src/outpd.f +++ b/f77src/outpd.f @@ -64,7 +64,7 @@ SUBROUTINE outpd(I,NT,NE,NAX,NDX,NTX,NEX,NHW,NHE,NVN,NVS) IF(K.EQ.59)HEAD(M)=WTND(NZ,NY,NX)/AREA(3,NU(NY,NX),NY,NX) IF(K.EQ.60)HEAD(M)=WTRVC(NZ,NY,NX)/AREA(3,NU(NY,NX),NY,NX) IF(K.EQ.61)HEAD(M)=GRNO(NZ,NY,NX)/AREA(3,NU(NY,NX),NY,NX) - IF(K.EQ.62)HEAD(M)=ARLFS(NZ,NY,NX)/AREA(3,NU(NY,NX),NY,NX) + IF(K.EQ.62)HEAD(M)=ARLFP(NZ,NY,NX)/AREA(3,NU(NY,NX),NY,NX) IF(K.EQ.63)HEAD(M)=CARBN(NZ,NY,NX)/AREA(3,NU(NY,NX),NY,NX) IF(K.EQ.64)HEAD(M)=TCUPTK(NZ,NY,NX)/AREA(3,NU(NY,NX),NY,NX) IF(K.EQ.65)HEAD(M)=TCSNC(NZ,NY,NX)/AREA(3,NU(NY,NX),NY,NX) diff --git a/f77src/readi.f b/f77src/readi.f index 1b78df5..24d6504 100755 --- a/f77src/readi.f +++ b/f77src/readi.f @@ -1,491 +1,494 @@ - - SUBROUTINE readi(NA,ND,NT,NE,NAX,NDX,NTX,NEX,NF,NFX,NTZ - 2,NTZX,NHW,NHE,NVN,NVS) -C -C THIS SUBROUTINE READS ALL SOIL AND TOPOGRAPHIC INPUT FILES -C - include "parameters.h" - include "filec.h" - include "files.h" - include "blkc.h" - include "blk2a.h" - include "blk2b.h" - include "blk2c.h" - include "blk8a.h" - include "blk8b.h" - include "blk17.h" - DIMENSION NA(10),ND(10),NM(JY,JX),DHI(JX),DVI(JY) - CHARACTER*16 DATA(30),DATAC(30,250,250),DATAP(JP,JY,JX) - 2,DATAM(JP,JY,JX),DATAX(JP),DATAY(JP),DATAZ(JP,JY,JX) - 3,OUTS(10),OUTP(10),OUTFILS(10,JY,JX),OUTFILP(10,JP,JY,JX) - CHARACTER*3 CHOICE(102,20) - CHARACTER*8 CDATE - CHARACTER*16 OUTW,OUTI,OUTT,OUTN,OUTF - CHARACTER*4 CHARY - CHARACTER*1 TTYPE,CTYPE,IVAR(20),VAR(50),TYP(50) - CHARACTER*80 PREFIX - DIMENSION IDAT(20),DAT(50),DATK(50) - PARAMETER (TWILGT=0.06976) -C -C OPEN SITE, TOPOGRAPHY, AND WEATHER FILES FROM -C FILE NAMES IN DATA ARRAYS LOADED IN 'MAIN' -C - OPEN(18,FILE='logfile1',STATUS='UNKNOWN') - OPEN(19,FILE='logfile2',STATUS='UNKNOWN') - OPEN(20,FILE='logfile3',STATUS='UNKNOWN') - OPEN(1,FILE=TRIM(PREFIX)//DATA(1),STATUS='OLD') - OPEN(7,FILE=TRIM(PREFIX)//DATA(2),STATUS='OLD') - WRITE(18,5000)' 17 APR 2019' -5000 FORMAT(A16) - NF=1 - NFX=1 - NTZ=0 -C -C READ SITE DATA -C - READ(1,*)ALATG,ALTIG,ATCAG,IPRCG - READ(1,*)OXYEG,Z2GEG,CO2EIG,CH4EG,Z2OEG,ZNH3EG - READ(1,*)IETYPG,ISALTG,IERSNG,NCNG,DTBLIG,DDRGIG,DTBLGG - READ(1,*)RCHQNG,RCHQEG,RCHQSG,RCHQWG,RCHGNUG,RCHGEUG,RCHGSUG - 2,RCHGWUG,RCHGNTG,RCHGETG,RCHGSTG,RCHGWTG,RCHGDG - READ(1,*)(DHI(NX),NX=1,NHE) - READ(1,*)(DVI(NY),NY=1,NVS) - CLOSE(1) - DO 9895 NX=NHW,NHE - DO 9890 NY=NVN,NVS - ALAT(NY,NX)=ALATG - ALTI(NY,NX)=ALTIG - ATCAI(NY,NX)=ATCAG - IPRC(NY,NX)=IPRCG - OXYE(NY,NX)=OXYEG - Z2GE(NY,NX)=Z2GEG - CO2EI(NY,NX)=CO2EIG - CH4E(NY,NX)=CH4EG - Z2OE(NY,NX)=Z2OEG - ZNH3E(NY,NX)=ZNH3EG - IETYP(NY,NX)=IETYPG - IERSN(NY,NX)=IERSNG - NCN(NY,NX)=NCNG - DTBLI(NY,NX)=DTBLIG - DDRGI(NY,NX)=DDRGIG - DTBLG(NY,NX)=DTBLGG - RCHQN(NY,NX)=RCHQNG - RCHQE(NY,NX)=RCHQEG - RCHQS(NY,NX)=RCHQSG - RCHQW(NY,NX)=RCHQWG - RCHGNU(NY,NX)=RCHGNUG - RCHGEU(NY,NX)=RCHGEUG - RCHGSU(NY,NX)=RCHGSUG - RCHGWU(NY,NX)=RCHGWUG - RCHGNT(NY,NX)=RCHGNTG - RCHGET(NY,NX)=RCHGETG - RCHGST(NY,NX)=RCHGSTG - RCHGWT(NY,NX)=RCHGWTG - RCHGD(NY,NX)=RCHGDG - DH(NY,NX)=DHI(NX) - DV(NY,NX)=DVI(NY) - CO2E(NY,NX)=CO2EI(NY,NX) - H2GE(NY,NX)=1.0E-03 - IF(ALAT(NY,NX).GT.0.0)THEN - XI=173 - ELSE - XI=356 - ENDIF - DECDAY=XI+100 - DECLIN=SIN((DECDAY*0.9863)*1.7453E-02)*(-23.47) - AZI=SIN(ALAT(NY,NX)*1.7453E-02)*SIN(DECLIN*1.7453E-02) - DEC=COS(ALAT(NY,NX)*1.7453E-02)*COS(DECLIN*1.7453E-02) - IF(AZI/DEC.GE.1.0-TWILGT)THEN - DYLM(NY,NX)=24.0 - ELSEIF(AZI/DEC.LE.-1.0+TWILGT)THEN - DYLM(NY,NX)=0.0 - ELSE - DYLM(NY,NX)=12.0*(1.0+2.0/3.1416*ASIN(TWILGT+AZI/DEC)) - ENDIF -9890 CONTINUE -9895 CONTINUE - DO 9885 NX=NHW,NHE+1 - DO 9880 NY=NVN,NVS+1 - ISALT(NY,NX)=ISALTG -9880 CONTINUE -9885 CONTINUE -C -C READ TOPOGRAPHY DATA AND SOIL FILE NAME FOR EACH GRID CELL -C -50 READ(7,*,END=20)NH1,NV1,NH2,NV2,ASPX,SL2,SL1,DPTHSX - READ(7,52)DATA(7) -52 FORMAT(A16) -C -C OPEN AND READ SOIL FILE -C - OPEN(9,FILE=TRIM(PREFIX)//DATA(7),STATUS='OLD') - DO 9995 NX=NH1,NH2 - DO 9990 NY=NV1,NV2 -C -C SURFACE SLOPES AND ASPECTS -C - ASP(NY,NX)=ASPX - SL(1,NY,NX)=SL1 - SL(2,NY,NX)=SL2 - DPTHS(NY,NX)=DPTHSX - ASP(NY,NX)=450.0-ASP(NY,NX) - IF(ASP(NY,NX).GE.360.0)ASP(NY,NX)=ASP(NY,NX)-360.0 -C -C SURFACE RESIDUE C, N AND P -C - READ(9,*)PSIFC(NY,NX),PSIWP(NY,NX),ALBS(NY,NX),PH(0,NY,NX) - 2,RSC(1,0,NY,NX),RSN(1,0,NY,NX),RSP(1,0,NY,NX) - 3,RSC(0,0,NY,NX),RSN(0,0,NY,NX),RSP(0,0,NY,NX) - 4,RSC(2,0,NY,NX),RSN(2,0,NY,NX),RSP(2,0,NY,NX) - 5,IXTYP(1,NY,NX),IXTYP(2,NY,NX) - 6,NU(NY,NX),NJ(NY,NX),NL1,NL2,ISOILR(NY,NX) - NK(NY,NX)=NJ(NY,NX)+1 - NM(NY,NX)=NJ(NY,NX)+NL1 - NL(NY,NX)=NM(NY,NX)+NL2 -C -C PHYSICAL PROPERTIES -C - READ(9,*)(CDPTH(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) - READ(9,*)(BKDS(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) -C -C HYDROLOGIC PROPERTIES -C - READ(9,*)(FC(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) - READ(9,*)(WP(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) - READ(9,*)(SCNV(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) - READ(9,*)(SCNH(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) -C -C PHYSICAL PROPERTIES -C - READ(9,*)(CSAND(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) - READ(9,*)(CSILT(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) - READ(9,*)(FHOL(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) - READ(9,*)(ROCK(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) -C -C CHEMICAL PROPERTIES -C - READ(9,*)(PH(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) - READ(9,*)(CEC(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) - READ(9,*)(AEC(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) -C -C ORGANIC C, N AND P CONCENTRATIONS -C - READ(9,*)(CORGC(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) - READ(9,*)(CORGR(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) - READ(9,*)(CORGN(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) - READ(9,*)(CORGP(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) -C -C INORGANIC N AND P CONCENTRATIONS -C - READ(9,*)(CNH4(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) - READ(9,*)(CNO3(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) - READ(9,*)(CPO4(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) -C -C CATION AND ANION CONCENTRATIONS -C - READ(9,*)(CAL(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) - READ(9,*)(CFE(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) - READ(9,*)(CCA(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) - READ(9,*)(CMG(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) - READ(9,*)(CNA(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) - READ(9,*)(CKA(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) - READ(9,*)(CSO4(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) - READ(9,*)(CCL(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) -C -C PRECIPITATED MINERAL CONCENTRATIONS -C - READ(9,*)(CALPO(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) - READ(9,*)(CFEPO(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) - READ(9,*)(CCAPD(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) - READ(9,*)(CCAPH(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) - READ(9,*)(CALOH(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) - READ(9,*)(CFEOH(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) - READ(9,*)(CCACO(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) - READ(9,*)(CCASO(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) -C -C GAPON SELECTIVITY CO-EFFICIENTS -C - READ(9,*)(GKC4(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) - READ(9,*)(GKCH(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) - READ(9,*)(GKCA(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) - READ(9,*)(GKCM(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) - READ(9,*)(GKCN(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) - READ(9,*)(GKCK(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) -C -C INITIAL WATER, ICE CONTENTS -C - READ(9,*)(THW(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) - READ(9,*)(THI(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) -C -C INITIAL PLANT AND ANIMAL RESIDUE C, N AND P -C - READ(9,*)(RSC(1,L,NY,NX),L=NU(NY,NX),NM(NY,NX)) - READ(9,*)(RSN(1,L,NY,NX),L=NU(NY,NX),NM(NY,NX)) - READ(9,*)(RSP(1,L,NY,NX),L=NU(NY,NX),NM(NY,NX)) - READ(9,*)(RSC(0,L,NY,NX),L=NU(NY,NX),NM(NY,NX)) - READ(9,*)(RSN(0,L,NY,NX),L=NU(NY,NX),NM(NY,NX)) - READ(9,*)(RSP(0,L,NY,NX),L=NU(NY,NX),NM(NY,NX)) - READ(9,*)(RSC(2,L,NY,NX),L=NU(NY,NX),NM(NY,NX)) - READ(9,*)(RSN(2,L,NY,NX),L=NU(NY,NX),NM(NY,NX)) - READ(9,*)(RSP(2,L,NY,NX),L=NU(NY,NX),NM(NY,NX)) - REWIND(9) - RSC(1,0,NY,NX)=AMAX1(1.0E-03,RSC(1,0,NY,NX)) - RSN(1,0,NY,NX)=AMAX1(0.04E-03,RSN(1,0,NY,NX)) - RSP(1,0,NY,NX)=AMAX1(0.004E-03,RSP(1,0,NY,NX)) - CDPTH(0,NY,NX)=0.0 -C -C ADD SOIL BOUNDARY LAYERS ABOVE ROOTING ZONE -C - IF(NU(NY,NX).GT.1)THEN - DO 31 L=NU(NY,NX)-1,0,-1 - IF(BKDS(L+1,NY,NX).GT.0.025)THEN - CDPTH(L,NY,NX)=CDPTH(L+1,NY,NX)-0.01 - ELSE - CDPTH(L,NY,NX)=CDPTH(L+1,NY,NX)-0.02 - ENDIF - IF(L.GT.0)THEN - BKDS(L,NY,NX)=BKDS(L+1,NY,NX) - FC(L,NY,NX)=FC(L+1,NY,NX) - WP(L,NY,NX)=WP(L+1,NY,NX) - SCNV(L,NY,NX)=SCNV(L+1,NY,NX) - SCNH(L,NY,NX)=SCNH(L+1,NY,NX) - CSAND(L,NY,NX)=CSAND(L+1,NY,NX) - CSILT(L,NY,NX)=CSILT(L+1,NY,NX) - CCLAY(L,NY,NX)=CCLAY(L+1,NY,NX) - FHOL(L,NY,NX)=FHOL(L+1,NY,NX) - ROCK(L,NY,NX)=ROCK(L+1,NY,NX) - PH(L,NY,NX)=PH(L+1,NY,NX) - CEC(L,NY,NX)=CEC(L+1,NY,NX) - AEC(L,NY,NX)=AEC(L+1,NY,NX) - CORGC(L,NY,NX)=0.0*CORGC(L+1,NY,NX) - CORGR(L,NY,NX)=0.0*CORGR(L+1,NY,NX) - CORGN(L,NY,NX)=0.0*CORGN(L+1,NY,NX) - CORGP(L,NY,NX)=0.0*CORGP(L+1,NY,NX) - CNH4(L,NY,NX)=CNH4(L+1,NY,NX) - CNO3(L,NY,NX)=CNO3(L+1,NY,NX) - CPO4(L,NY,NX)=CPO4(L+1,NY,NX) - CAL(L,NY,NX)=CAL(L+1,NY,NX) - CFE(L,NY,NX)=CFE(L+1,NY,NX) - CCA(L,NY,NX)=CCA(L+1,NY,NX) - CMG(L,NY,NX)=CMG(L+1,NY,NX) - CNA(L,NY,NX)=CNA(L+1,NY,NX) - CKA(L,NY,NX)=CKA(L+1,NY,NX) - CSO4(L,NY,NX)=CSO4(L+1,NY,NX) - CCL(L,NY,NX)=CCL(L+1,NY,NX) - CALOH(L,NY,NX)=CALOH(L+1,NY,NX) - CFEOH(L,NY,NX)=CFEOH(L+1,NY,NX) - CCACO(L,NY,NX)=CCACO(L+1,NY,NX) - CCASO(L,NY,NX)=CCASO(L+1,NY,NX) - CALPO(L,NY,NX)=CALPO(L+1,NY,NX) - CFEPO(L,NY,NX)=CFEPO(L+1,NY,NX) - CCAPD(L,NY,NX)=CCAPD(L+1,NY,NX) - CCAPH(L,NY,NX)=CCAPH(L+1,NY,NX) - GKC4(L,NY,NX)=GKC4(L+1,NY,NX) - GKCH(L,NY,NX)=GKCH(L+1,NY,NX) - GKCA(L,NY,NX)=GKCA(L+1,NY,NX) - GKCM(L,NY,NX)=GKCM(L+1,NY,NX) - GKCN(L,NY,NX)=GKCN(L+1,NY,NX) - GKCK(L,NY,NX)=GKCK(L+1,NY,NX) - THW(L,NY,NX)=THW(L+1,NY,NX) - THI(L,NY,NX)=THI(L+1,NY,NX) - ISOIL(1,L,NY,NX)=ISOIL(1,L+1,NY,NX) - ISOIL(2,L,NY,NX)=ISOIL(2,L+1,NY,NX) - ISOIL(3,L,NY,NX)=ISOIL(3,L+1,NY,NX) - ISOIL(4,L,NY,NX)=ISOIL(4,L+1,NY,NX) - RSC(1,L,NY,NX)=0.0 - RSN(1,L,NY,NX)=0.0 - RSP(1,L,NY,NX)=0.0 - RSC(0,L,NY,NX)=0.0 - RSN(0,L,NY,NX)=0.0 - RSP(0,L,NY,NX)=0.0 - RSC(2,L,NY,NX)=0.0 - RSN(2,L,NY,NX)=0.0 - RSP(2,L,NY,NX)=0.0 - ENDIF -31 CONTINUE - ENDIF -C -C ADD SOIL BOUNDARY LAYERS BELOW ROOTING ZONE -C - DO 32 L=NM(NY,NX)+1,JZ - CDPTH(L,NY,NX)=2.0*CDPTH(L-1,NY,NX)-1.0*CDPTH(L-2,NY,NX) - BKDS(L,NY,NX)=BKDS(L-1,NY,NX) - FC(L,NY,NX)=FC(L-1,NY,NX) - WP(L,NY,NX)=WP(L-1,NY,NX) - SCNV(L,NY,NX)=SCNV(L-1,NY,NX) - SCNH(L,NY,NX)=SCNH(L-1,NY,NX) - CSAND(L,NY,NX)=CSAND(L-1,NY,NX) - CSILT(L,NY,NX)=CSILT(L-1,NY,NX) - CCLAY(L,NY,NX)=CCLAY(L-1,NY,NX) - FHOL(L,NY,NX)=FHOL(L-1,NY,NX) - ROCK(L,NY,NX)=ROCK(L-1,NY,NX) - PH(L,NY,NX)=PH(L-1,NY,NX) - CEC(L,NY,NX)=CEC(L-1,NY,NX) - AEC(L,NY,NX)=AEC(L-1,NY,NX) -C IF(IPRC(NY,NX).EQ.0)THEN - CORGC(L,NY,NX)=0.0*CORGC(L-1,NY,NX) - CORGR(L,NY,NX)=0.0*CORGR(L-1,NY,NX) - CORGN(L,NY,NX)=0.0*CORGN(L-1,NY,NX) - CORGP(L,NY,NX)=0.0*CORGP(L-1,NY,NX) -C ELSE -C CORGC(L,NY,NX)=CORGC(L-1,NY,NX) -C CORGR(L,NY,NX)=CORGR(L-1,NY,NX) -C CORGN(L,NY,NX)=CORGN(L-1,NY,NX) -C CORGP(L,NY,NX)=CORGP(L-1,NY,NX) -C ENDIF - CNH4(L,NY,NX)=CNH4(L-1,NY,NX) - CNO3(L,NY,NX)=CNO3(L-1,NY,NX) - CPO4(L,NY,NX)=CPO4(L-1,NY,NX) - CAL(L,NY,NX)=CAL(L-1,NY,NX) - CFE(L,NY,NX)=CFE(L-1,NY,NX) - CCA(L,NY,NX)=CCA(L-1,NY,NX) - CMG(L,NY,NX)=CMG(L-1,NY,NX) - CNA(L,NY,NX)=CNA(L-1,NY,NX) - CKA(L,NY,NX)=CKA(L-1,NY,NX) - CSO4(L,NY,NX)=CSO4(L-1,NY,NX) - CCL(L,NY,NX)=CCL(L-1,NY,NX) - CALOH(L,NY,NX)=CALOH(L-1,NY,NX) - CFEOH(L,NY,NX)=CFEOH(L-1,NY,NX) - CCACO(L,NY,NX)=CCACO(L-1,NY,NX) - CCASO(L,NY,NX)=CCASO(L-1,NY,NX) - CALPO(L,NY,NX)=CALPO(L-1,NY,NX) - CFEPO(L,NY,NX)=CFEPO(L-1,NY,NX) - CCAPD(L,NY,NX)=CCAPD(L-1,NY,NX) - CCAPH(L,NY,NX)=CCAPH(L-1,NY,NX) - GKC4(L,NY,NX)=GKC4(L-1,NY,NX) - GKCH(L,NY,NX)=GKCH(L-1,NY,NX) - GKCA(L,NY,NX)=GKCA(L-1,NY,NX) - GKCM(L,NY,NX)=GKCM(L-1,NY,NX) - GKCN(L,NY,NX)=GKCN(L-1,NY,NX) - GKCK(L,NY,NX)=GKCK(L-1,NY,NX) - THW(L,NY,NX)=THW(L-1,NY,NX) - THI(L,NY,NX)=THI(L-1,NY,NX) - ISOIL(1,L,NY,NX)=ISOIL(1,L-1,NY,NX) - ISOIL(2,L,NY,NX)=ISOIL(2,L-1,NY,NX) - ISOIL(3,L,NY,NX)=ISOIL(3,L-1,NY,NX) - ISOIL(4,L,NY,NX)=ISOIL(4,L-1,NY,NX) - RSC(1,L,NY,NX)=0.0 - RSN(1,L,NY,NX)=0.0 - RSP(1,L,NY,NX)=0.0 - RSC(0,L,NY,NX)=0.0 - RSN(0,L,NY,NX)=0.0 - RSP(0,L,NY,NX)=0.0 - RSC(2,L,NY,NX)=0.0 - RSN(2,L,NY,NX)=0.0 - RSP(2,L,NY,NX)=0.0 -32 CONTINUE -C -C CALCULATE DERIVED SOIL PROPERTIES FROM INPUT SOIL PROPERTIES -C - DO 28 L=1,NL(NY,NX) - FMPR(L,NY,NX)=(1.0-ROCK(L,NY,NX))*(1.0-FHOL(L,NY,NX)) - BKDS(L,NY,NX)=BKDS(L,NY,NX)/(1.0-FHOL(L,NY,NX)) - FC(L,NY,NX)=FC(L,NY,NX)/(1.0-FHOL(L,NY,NX)) - WP(L,NY,NX)=WP(L,NY,NX)/(1.0-FHOL(L,NY,NX)) - SCNV(L,NY,NX)=0.1*SCNV(L,NY,NX)*FMPR(L,NY,NX) - SCNH(L,NY,NX)=0.1*SCNH(L,NY,NX)*FMPR(L,NY,NX) - CCLAY(L,NY,NX)=AMAX1(0.0,1.0E+03-(CSAND(L,NY,NX) - 2+CSILT(L,NY,NX))) - CORGC(L,NY,NX)=CORGC(L,NY,NX)*1.0E+03 - CORGR(L,NY,NX)=CORGR(L,NY,NX)*1.0E+03 - CORGCX=CORGC(L,NY,NX)+(RSC(1,L,NY,NX)+RSC(0,L,NY,NX)) - 2/(BKDS(L,NY,NX)*(CDPTH(L,NY,NX)-CDPTH(L-1,NY,NX))) - CSAND(L,NY,NX)=CSAND(L,NY,NX) - 2*1.0E-03*AMAX1(0.0,(1.0-CORGCX/0.5E+06)) - CSILT(L,NY,NX)=CSILT(L,NY,NX) - 2*1.0E-03*AMAX1(0.0,(1.0-CORGCX/0.5E+06)) - CCLAY(L,NY,NX)=CCLAY(L,NY,NX) - 2*1.0E-03*AMAX1(0.0,(1.0-CORGCX/0.5E+06)) - CEC(L,NY,NX)=CEC(L,NY,NX)*10.0 - AEC(L,NY,NX)=AEC(L,NY,NX)*10.0 - CNH4(L,NY,NX)=CNH4(L,NY,NX)/14.0 - CNO3(L,NY,NX)=CNO3(L,NY,NX)/14.0 - CPO4(L,NY,NX)=CPO4(L,NY,NX)/31.0 - CAL(L,NY,NX)=CAL(L,NY,NX)/27.0 - CFE(L,NY,NX)=CFE(L,NY,NX)/56.0 - CCA(L,NY,NX)=CCA(L,NY,NX)/40.0 - CMG(L,NY,NX)=CMG(L,NY,NX)/24.3 - CNA(L,NY,NX)=CNA(L,NY,NX)/23.0 - CKA(L,NY,NX)=CKA(L,NY,NX)/39.1 - CSO4(L,NY,NX)=CSO4(L,NY,NX)/32.0 - CCL(L,NY,NX)=CCL(L,NY,NX)/35.5 - CALPO(L,NY,NX)=CALPO(L,NY,NX)/31.0 - CFEPO(L,NY,NX)=CFEPO(L,NY,NX)/31.0 - CCAPD(L,NY,NX)=CCAPD(L,NY,NX)/31.0 - CCAPH(L,NY,NX)=CCAPH(L,NY,NX)/(31.0*3.0) - CALOH(L,NY,NX)=CALOH(L,NY,NX)/27.0 - CFEOH(L,NY,NX)=CFEOH(L,NY,NX)/56.0 - CCACO(L,NY,NX)=CCACO(L,NY,NX)/40.0 - CCASO(L,NY,NX)=CCASO(L,NY,NX)/40.0 - IF(FC(L,NY,NX).LT.0.0)THEN - ISOIL(1,L,NY,NX)=1 - PSIFC(NY,NX)=-0.033 - ELSE - ISOIL(1,L,NY,NX)=0 - ENDIF - IF(WP(L,NY,NX).LT.0.0)THEN - ISOIL(2,L,NY,NX)=1 - PSIWP(NY,NX)=-1.5 - ELSE - ISOIL(2,L,NY,NX)=0 - ENDIF - IF(SCNV(L,NY,NX).LT.0.0)THEN - ISOIL(3,L,NY,NX)=1 - ELSE - ISOIL(3,L,NY,NX)=0 - ENDIF - IF(SCNH(L,NY,NX).LT.0.0)THEN - ISOIL(4,L,NY,NX)=1 - ELSE - ISOIL(4,L,NY,NX)=0 - ENDIF -C IF(BKDS(L,NY,NX).EQ.0.0)THEN -C FC(L,NY,NX)=1.0 -C WP(L,NY,NX)=1.0 -C ISOIL(1,L,NY,NX)=0 -C ISOIL(2,L,NY,NX)=0 -C CCLAY(L,NY,NX)=0.0 -C ENDIF -C -C BIOCHEMISTRY 130:117-131 -C - IF(CORGN(L,NY,NX).LT.0.0)THEN - CORGN(L,NY,NX)=AMIN1(0.125*CORGC(L,NY,NX) - 2,8.9E+02*(CORGC(L,NY,NX)/1.0E+04)**0.80) -C WRITE(*,1111)'CORGN',L,CORGN(L,NY,NX),CORGC(L,NY,NX) - ENDIF - IF(CORGP(L,NY,NX).LT.0.0)THEN - CORGP(L,NY,NX)=AMIN1(0.0125*CORGC(L,NY,NX) - 2,1.2E+02*(CORGC(L,NY,NX)/1.0E+04)**0.52) -C WRITE(*,1111)'CORGP',L,CORGP(L,NY,NX),CORGC(L,NY,NX) - ENDIF - IF(CEC(L,NY,NX).LT.0.0)THEN - CEC(L,NY,NX)=10.0*(200.0*2.0*CORGC(L,NY,NX)/1.0E+06 - 2+80.0*CCLAY(L,NY,NX)+20.0*CSILT(L,NY,NX) - 3+5.0*CSAND(L,NY,NX)) -C WRITE(*,1111)'CEC',L,CEC(L,NY,NX),CORGC(L,NY,NX) -C 2,CCLAY(L,NY,NX),CSILT(L,NY,NX),CSAND(L,NY,NX) -1111 FORMAT(A8,1I4,12E12.4) - ENDIF -28 CONTINUE -9990 CONTINUE -9995 CONTINUE - CLOSE(9) - GO TO 50 -20 CONTINUE - CLOSE(7) - DO 9975 NX=NHW,NHE - NL(NVS+1,NX)=NL(NVS,NX) -C WRITE(*,2223)'NHE',NX,NHW,NHE,NVS,NL(NVS,NX) -9975 CONTINUE - DO 9970 NY=NVN,NVS - NL(NY,NHE+1)=NL(NY,NHE) -C WRITE(*,2223)'NVS',NY,NVN,NVS,NHE,NL(NY,NHE) -2223 FORMAT(A8,6I4) -9970 CONTINUE - NL(NVS+1,NHE+1)=NL(NVS,NHE) - IOLD=0 - RETURN - END - - + + SUBROUTINE readi(NA,ND,NT,NE,NAX,NDX,NTX,NEX,NF,NFX,NTZ + 2,NTZX,NHW,NHE,NVN,NVS) +C +C THIS SUBROUTINE READS ALL SOIL AND TOPOGRAPHIC INPUT FILES +C + include "parameters.h" + include "filec.h" + include "files.h" + include "blkc.h" + include "blk2a.h" + include "blk2b.h" + include "blk2c.h" + include "blk8a.h" + include "blk8b.h" + include "blk17.h" + DIMENSION NA(10),ND(10),NM(JY,JX),DHI(JX),DVI(JY) + CHARACTER*16 DATA(30),DATAC(30,250,250),DATAP(JP,JY,JX) + 2,DATAM(JP,JY,JX),DATAX(JP),DATAY(JP),DATAZ(JP,JY,JX) + 3,OUTS(10),OUTP(10),OUTFILS(10,JY,JX),OUTFILP(10,JP,JY,JX) + CHARACTER*3 CHOICE(102,20) + CHARACTER*8 CDATE + CHARACTER*16 OUTW,OUTI,OUTT,OUTN,OUTF + CHARACTER*4 CHARY + CHARACTER*1 TTYPE,CTYPE,IVAR(20),VAR(50),TYP(50) + CHARACTER*80 PREFIX + DIMENSION IDAT(20),DAT(50),DATK(50) + PARAMETER (TWILGT=0.06976) +C +C OPEN SITE, TOPOGRAPHY, AND WEATHER FILES FROM +C FILE NAMES IN DATA ARRAYS LOADED IN 'MAIN' +C + OPEN(18,FILE='logfile1',STATUS='UNKNOWN') + OPEN(19,FILE='logfile2',STATUS='UNKNOWN') + OPEN(20,FILE='logfile3',STATUS='UNKNOWN') + OPEN(1,FILE=TRIM(PREFIX)//DATA(1),STATUS='OLD') + OPEN(7,FILE=TRIM(PREFIX)//DATA(2),STATUS='OLD') + WRITE(18,5000)' 02 SEP 2019' +5000 FORMAT(A16) + NF=1 + NFX=1 + NTZ=0 +C +C READ SITE DATA +C + READ(1,*)ALATG,ALTIG,ATCAG,IPRCG + READ(1,*)OXYEG,Z2GEG,CO2EIG,CH4EG,Z2OEG,ZNH3EG + READ(1,*)IETYPG,ISALTG,IERSNG,NCNG,DTBLIG,DDRGIG,DTBLGG + READ(1,*)RCHQNG,RCHQEG,RCHQSG,RCHQWG,RCHGNUG,RCHGEUG,RCHGSUG + 2,RCHGWUG,RCHGNTG,RCHGETG,RCHGSTG,RCHGWTG,RCHGDG + READ(1,*)(DHI(NX),NX=1,NHE) + READ(1,*)(DVI(NY),NY=1,NVS) + CLOSE(1) + DO 9895 NX=NHW,NHE + DO 9890 NY=NVN,NVS + ALAT(NY,NX)=ALATG + ALTI(NY,NX)=ALTIG + ATCAI(NY,NX)=ATCAG + IPRC(NY,NX)=IPRCG + OXYE(NY,NX)=OXYEG + Z2GE(NY,NX)=Z2GEG + CO2EI(NY,NX)=CO2EIG + CH4E(NY,NX)=CH4EG + Z2OE(NY,NX)=Z2OEG + ZNH3E(NY,NX)=ZNH3EG + IETYP(NY,NX)=IETYPG + IERSN(NY,NX)=IERSNG + NCN(NY,NX)=NCNG + DTBLI(NY,NX)=DTBLIG + DDRGI(NY,NX)=DDRGIG + DTBLG(NY,NX)=DTBLGG + RCHQN(NY,NX)=RCHQNG + RCHQE(NY,NX)=RCHQEG + RCHQS(NY,NX)=RCHQSG + RCHQW(NY,NX)=RCHQWG + RCHGNU(NY,NX)=RCHGNUG + RCHGEU(NY,NX)=RCHGEUG + RCHGSU(NY,NX)=RCHGSUG + RCHGWU(NY,NX)=RCHGWUG + RCHGNT(NY,NX)=RCHGNTG + RCHGET(NY,NX)=RCHGETG + RCHGST(NY,NX)=RCHGSTG + RCHGWT(NY,NX)=RCHGWTG + RCHGD(NY,NX)=RCHGDG + DH(NY,NX)=DHI(NX) + DV(NY,NX)=DVI(NY) + CO2E(NY,NX)=CO2EI(NY,NX) + H2GE(NY,NX)=1.0E-03 + IF(ALAT(NY,NX).GT.0.0)THEN + XI=173 + ELSE + XI=356 + ENDIF + DECDAY=XI+100 + DECLIN=SIN((DECDAY*0.9863)*1.7453E-02)*(-23.47) + AZI=SIN(ALAT(NY,NX)*1.7453E-02)*SIN(DECLIN*1.7453E-02) + DEC=COS(ALAT(NY,NX)*1.7453E-02)*COS(DECLIN*1.7453E-02) + IF(AZI/DEC.GE.1.0-TWILGT)THEN + DYLM(NY,NX)=24.0 + ELSEIF(AZI/DEC.LE.-1.0+TWILGT)THEN + DYLM(NY,NX)=0.0 + ELSE + DYLM(NY,NX)=12.0*(1.0+2.0/3.1416*ASIN(TWILGT+AZI/DEC)) + ENDIF +9890 CONTINUE +9895 CONTINUE + DO 9885 NX=NHW,NHE+1 + DO 9880 NY=NVN,NVS+1 + ISALT(NY,NX)=ISALTG +9880 CONTINUE +9885 CONTINUE +C +C READ TOPOGRAPHY DATA AND SOIL FILE NAME FOR EACH GRID CELL +C +50 READ(7,*,END=20)NH1,NV1,NH2,NV2,ASPX,SL2,SL1,DPTHSX + READ(7,52)DATA(7) +52 FORMAT(A16) +C +C OPEN AND READ SOIL FILE +C + OPEN(9,FILE=TRIM(PREFIX)//DATA(7),STATUS='OLD') + DO 9995 NX=NH1,NH2 + DO 9990 NY=NV1,NV2 +C +C SURFACE SLOPES AND ASPECTS +C + ASP(NY,NX)=ASPX + SL(1,NY,NX)=SL1 + SL(2,NY,NX)=SL2 + DPTHS(NY,NX)=DPTHSX + ASP(NY,NX)=450.0-ASP(NY,NX) + IF(ASP(NY,NX).GE.360.0)ASP(NY,NX)=ASP(NY,NX)-360.0 +C +C SURFACE RESIDUE C, N AND P +C + READ(9,*)PSIFC(NY,NX),PSIWP(NY,NX),ALBS(NY,NX),PH(0,NY,NX) + 2,RSC(1,0,NY,NX),RSN(1,0,NY,NX),RSP(1,0,NY,NX) + 3,RSC(0,0,NY,NX),RSN(0,0,NY,NX),RSP(0,0,NY,NX) + 4,RSC(2,0,NY,NX),RSN(2,0,NY,NX),RSP(2,0,NY,NX) + 5,IXTYP(1,NY,NX),IXTYP(2,NY,NX) + 6,NU(NY,NX),NJ(NY,NX),NL1,NL2,ISOILR(NY,NX) + NK(NY,NX)=NJ(NY,NX)+1 + NM(NY,NX)=NJ(NY,NX)+NL1 + NL(NY,NX)=NM(NY,NX)+NL2 +C +C PHYSICAL PROPERTIES +C + READ(9,*)(CDPTH(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(BKDS(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) +C +C HYDROLOGIC PROPERTIES +C + READ(9,*)(FC(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(WP(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(SCNV(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(SCNH(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) +C +C PHYSICAL PROPERTIES +C + READ(9,*)(CSAND(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(CSILT(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(FHOL(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(ROCK(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) +C +C CHEMICAL PROPERTIES +C + READ(9,*)(PH(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(CEC(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(AEC(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) +C +C ORGANIC C, N AND P CONCENTRATIONS +C + READ(9,*)(CORGC(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(CORGR(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(CORGN(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(CORGP(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) +C +C INORGANIC N AND P CONCENTRATIONS +C + READ(9,*)(CNH4(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(CNO3(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(CPO4(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) +C +C CATION AND ANION CONCENTRATIONS +C + READ(9,*)(CAL(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(CFE(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(CCA(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(CMG(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(CNA(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(CKA(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(CSO4(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(CCL(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) +C +C PRECIPITATED MINERAL CONCENTRATIONS +C + READ(9,*)(CALPO(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(CFEPO(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(CCAPD(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(CCAPH(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(CALOH(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(CFEOH(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(CCACO(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(CCASO(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) +C +C GAPON SELECTIVITY CO-EFFICIENTS +C + READ(9,*)(GKC4(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(GKCH(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(GKCA(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(GKCM(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(GKCN(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(GKCK(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) +C +C INITIAL WATER, ICE CONTENTS +C + READ(9,*)(THW(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(THI(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) +C +C INITIAL PLANT AND ANIMAL RESIDUE C, N AND P +C + READ(9,*)(RSC(1,L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(RSN(1,L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(RSP(1,L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(RSC(0,L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(RSN(0,L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(RSP(0,L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(RSC(2,L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(RSN(2,L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(RSP(2,L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + REWIND(9) + RSC(1,0,NY,NX)=AMAX1(1.0E-03,RSC(1,0,NY,NX)) + RSN(1,0,NY,NX)=AMAX1(0.04E-03,RSN(1,0,NY,NX)) + RSP(1,0,NY,NX)=AMAX1(0.004E-03,RSP(1,0,NY,NX)) + CDPTH(0,NY,NX)=0.0 +C +C ADD SOIL BOUNDARY LAYERS ABOVE ROOTING ZONE +C + IF(NU(NY,NX).GT.1)THEN + DO 31 L=NU(NY,NX)-1,0,-1 + IF(BKDS(L+1,NY,NX).GT.0.025)THEN + CDPTH(L,NY,NX)=CDPTH(L+1,NY,NX)-0.01 + ELSE + CDPTH(L,NY,NX)=CDPTH(L+1,NY,NX)-0.02 + ENDIF + IF(L.GT.0)THEN + BKDS(L,NY,NX)=BKDS(L+1,NY,NX) + FC(L,NY,NX)=FC(L+1,NY,NX) + WP(L,NY,NX)=WP(L+1,NY,NX) + SCNV(L,NY,NX)=SCNV(L+1,NY,NX) + SCNH(L,NY,NX)=SCNH(L+1,NY,NX) + CSAND(L,NY,NX)=CSAND(L+1,NY,NX) + CSILT(L,NY,NX)=CSILT(L+1,NY,NX) + CCLAY(L,NY,NX)=CCLAY(L+1,NY,NX) + FHOL(L,NY,NX)=FHOL(L+1,NY,NX) + ROCK(L,NY,NX)=ROCK(L+1,NY,NX) + PH(L,NY,NX)=PH(L+1,NY,NX) + CEC(L,NY,NX)=CEC(L+1,NY,NX) + AEC(L,NY,NX)=AEC(L+1,NY,NX) + CORGC(L,NY,NX)=0.0*CORGC(L+1,NY,NX) + CORGR(L,NY,NX)=0.0*CORGR(L+1,NY,NX) + CORGN(L,NY,NX)=0.0*CORGN(L+1,NY,NX) + CORGP(L,NY,NX)=0.0*CORGP(L+1,NY,NX) + CNH4(L,NY,NX)=CNH4(L+1,NY,NX) + CNO3(L,NY,NX)=CNO3(L+1,NY,NX) + CPO4(L,NY,NX)=CPO4(L+1,NY,NX) + CAL(L,NY,NX)=CAL(L+1,NY,NX) + CFE(L,NY,NX)=CFE(L+1,NY,NX) + CCA(L,NY,NX)=CCA(L+1,NY,NX) + CMG(L,NY,NX)=CMG(L+1,NY,NX) + CNA(L,NY,NX)=CNA(L+1,NY,NX) + CKA(L,NY,NX)=CKA(L+1,NY,NX) + CSO4(L,NY,NX)=CSO4(L+1,NY,NX) + CCL(L,NY,NX)=CCL(L+1,NY,NX) + CALOH(L,NY,NX)=CALOH(L+1,NY,NX) + CFEOH(L,NY,NX)=CFEOH(L+1,NY,NX) + CCACO(L,NY,NX)=CCACO(L+1,NY,NX) + CCASO(L,NY,NX)=CCASO(L+1,NY,NX) + CALPO(L,NY,NX)=CALPO(L+1,NY,NX) + CFEPO(L,NY,NX)=CFEPO(L+1,NY,NX) + CCAPD(L,NY,NX)=CCAPD(L+1,NY,NX) + CCAPH(L,NY,NX)=CCAPH(L+1,NY,NX) + GKC4(L,NY,NX)=GKC4(L+1,NY,NX) + GKCH(L,NY,NX)=GKCH(L+1,NY,NX) + GKCA(L,NY,NX)=GKCA(L+1,NY,NX) + GKCM(L,NY,NX)=GKCM(L+1,NY,NX) + GKCN(L,NY,NX)=GKCN(L+1,NY,NX) + GKCK(L,NY,NX)=GKCK(L+1,NY,NX) + THW(L,NY,NX)=THW(L+1,NY,NX) + THI(L,NY,NX)=THI(L+1,NY,NX) + ISOIL(1,L,NY,NX)=ISOIL(1,L+1,NY,NX) + ISOIL(2,L,NY,NX)=ISOIL(2,L+1,NY,NX) + ISOIL(3,L,NY,NX)=ISOIL(3,L+1,NY,NX) + ISOIL(4,L,NY,NX)=ISOIL(4,L+1,NY,NX) + RSC(1,L,NY,NX)=0.0 + RSN(1,L,NY,NX)=0.0 + RSP(1,L,NY,NX)=0.0 + RSC(0,L,NY,NX)=0.0 + RSN(0,L,NY,NX)=0.0 + RSP(0,L,NY,NX)=0.0 + RSC(2,L,NY,NX)=0.0 + RSN(2,L,NY,NX)=0.0 + RSP(2,L,NY,NX)=0.0 + ENDIF +31 CONTINUE + ENDIF +C +C ADD SOIL BOUNDARY LAYERS BELOW ROOTING ZONE +C + DO 32 L=NM(NY,NX)+1,JZ + CDPTH(L,NY,NX)=2.0*CDPTH(L-1,NY,NX)-1.0*CDPTH(L-2,NY,NX) + BKDS(L,NY,NX)=BKDS(L-1,NY,NX) + FC(L,NY,NX)=FC(L-1,NY,NX) + WP(L,NY,NX)=WP(L-1,NY,NX) + SCNV(L,NY,NX)=SCNV(L-1,NY,NX) + SCNH(L,NY,NX)=SCNH(L-1,NY,NX) + CSAND(L,NY,NX)=CSAND(L-1,NY,NX) + CSILT(L,NY,NX)=CSILT(L-1,NY,NX) + CCLAY(L,NY,NX)=CCLAY(L-1,NY,NX) + FHOL(L,NY,NX)=FHOL(L-1,NY,NX) + ROCK(L,NY,NX)=ROCK(L-1,NY,NX) + PH(L,NY,NX)=PH(L-1,NY,NX) + CEC(L,NY,NX)=CEC(L-1,NY,NX) + AEC(L,NY,NX)=AEC(L-1,NY,NX) +C IF(IPRC(NY,NX).EQ.0)THEN + CORGC(L,NY,NX)=0.0*CORGC(L-1,NY,NX) + CORGR(L,NY,NX)=0.0*CORGR(L-1,NY,NX) + CORGN(L,NY,NX)=0.0*CORGN(L-1,NY,NX) + CORGP(L,NY,NX)=0.0*CORGP(L-1,NY,NX) +C ELSE +C CORGC(L,NY,NX)=CORGC(L-1,NY,NX) +C CORGR(L,NY,NX)=CORGR(L-1,NY,NX) +C CORGN(L,NY,NX)=CORGN(L-1,NY,NX) +C CORGP(L,NY,NX)=CORGP(L-1,NY,NX) +C ENDIF + CNH4(L,NY,NX)=CNH4(L-1,NY,NX) + CNO3(L,NY,NX)=CNO3(L-1,NY,NX) + CPO4(L,NY,NX)=CPO4(L-1,NY,NX) + CAL(L,NY,NX)=CAL(L-1,NY,NX) + CFE(L,NY,NX)=CFE(L-1,NY,NX) + CCA(L,NY,NX)=CCA(L-1,NY,NX) + CMG(L,NY,NX)=CMG(L-1,NY,NX) + CNA(L,NY,NX)=CNA(L-1,NY,NX) + CKA(L,NY,NX)=CKA(L-1,NY,NX) + CSO4(L,NY,NX)=CSO4(L-1,NY,NX) + CCL(L,NY,NX)=CCL(L-1,NY,NX) + CALOH(L,NY,NX)=CALOH(L-1,NY,NX) + CFEOH(L,NY,NX)=CFEOH(L-1,NY,NX) + CCACO(L,NY,NX)=CCACO(L-1,NY,NX) + CCASO(L,NY,NX)=CCASO(L-1,NY,NX) + CALPO(L,NY,NX)=CALPO(L-1,NY,NX) + CFEPO(L,NY,NX)=CFEPO(L-1,NY,NX) + CCAPD(L,NY,NX)=CCAPD(L-1,NY,NX) + CCAPH(L,NY,NX)=CCAPH(L-1,NY,NX) + GKC4(L,NY,NX)=GKC4(L-1,NY,NX) + GKCH(L,NY,NX)=GKCH(L-1,NY,NX) + GKCA(L,NY,NX)=GKCA(L-1,NY,NX) + GKCM(L,NY,NX)=GKCM(L-1,NY,NX) + GKCN(L,NY,NX)=GKCN(L-1,NY,NX) + GKCK(L,NY,NX)=GKCK(L-1,NY,NX) + THW(L,NY,NX)=THW(L-1,NY,NX) + THI(L,NY,NX)=THI(L-1,NY,NX) + ISOIL(1,L,NY,NX)=ISOIL(1,L-1,NY,NX) + ISOIL(2,L,NY,NX)=ISOIL(2,L-1,NY,NX) + ISOIL(3,L,NY,NX)=ISOIL(3,L-1,NY,NX) + ISOIL(4,L,NY,NX)=ISOIL(4,L-1,NY,NX) + RSC(1,L,NY,NX)=0.0 + RSN(1,L,NY,NX)=0.0 + RSP(1,L,NY,NX)=0.0 + RSC(0,L,NY,NX)=0.0 + RSN(0,L,NY,NX)=0.0 + RSP(0,L,NY,NX)=0.0 + RSC(2,L,NY,NX)=0.0 + RSN(2,L,NY,NX)=0.0 + RSP(2,L,NY,NX)=0.0 +32 CONTINUE +C +C CALCULATE DERIVED SOIL PROPERTIES FROM INPUT SOIL PROPERTIES +C + DO 28 L=1,NL(NY,NX) + FMPR(L,NY,NX)=(1.0-ROCK(L,NY,NX))*(1.0-FHOL(L,NY,NX)) + IF(FHOL(L,NY,NX).GT.0.0)THEN + BKDS(L,NY,NX)=BKDS(L,NY,NX)/(1.0-FHOL(L,NY,NX)) + ENDIF + FC(L,NY,NX)=FC(L,NY,NX)/(1.0-FHOL(L,NY,NX)) + WP(L,NY,NX)=WP(L,NY,NX)/(1.0-FHOL(L,NY,NX)) + SCNV(L,NY,NX)=0.1*SCNV(L,NY,NX)*FMPR(L,NY,NX) + SCNH(L,NY,NX)=0.1*SCNH(L,NY,NX)*FMPR(L,NY,NX) + CCLAY(L,NY,NX)=AMAX1(0.0,1.0E+03-(CSAND(L,NY,NX) + 2+CSILT(L,NY,NX))) + CORGC(L,NY,NX)=CORGC(L,NY,NX)*1.0E+03 + CORGR(L,NY,NX)=CORGR(L,NY,NX)*1.0E+03 + CORGCX=CORGC(L,NY,NX)+(RSC(1,L,NY,NX)+RSC(0,L,NY,NX)) + 2/(BKDS(L,NY,NX)*(CDPTH(L,NY,NX)-CDPTH(L-1,NY,NX))) + CSAND(L,NY,NX)=CSAND(L,NY,NX) + 2*1.0E-03*AMAX1(0.0,(1.0-CORGCX/0.5E+06)) + CSILT(L,NY,NX)=CSILT(L,NY,NX) + 2*1.0E-03*AMAX1(0.0,(1.0-CORGCX/0.5E+06)) + CCLAY(L,NY,NX)=CCLAY(L,NY,NX) + 2*1.0E-03*AMAX1(0.0,(1.0-CORGCX/0.5E+06)) + CEC(L,NY,NX)=CEC(L,NY,NX)*10.0 + AEC(L,NY,NX)=AEC(L,NY,NX)*10.0 + CNH4(L,NY,NX)=CNH4(L,NY,NX)/14.0 + CNO3(L,NY,NX)=CNO3(L,NY,NX)/14.0 + CPO4(L,NY,NX)=CPO4(L,NY,NX)/31.0 + CAL(L,NY,NX)=CAL(L,NY,NX)/27.0 + CFE(L,NY,NX)=CFE(L,NY,NX)/56.0 + CCA(L,NY,NX)=CCA(L,NY,NX)/40.0 + CMG(L,NY,NX)=CMG(L,NY,NX)/24.3 + CNA(L,NY,NX)=CNA(L,NY,NX)/23.0 + CKA(L,NY,NX)=CKA(L,NY,NX)/39.1 + CSO4(L,NY,NX)=CSO4(L,NY,NX)/32.0 + CCL(L,NY,NX)=CCL(L,NY,NX)/35.5 + CALPO(L,NY,NX)=CALPO(L,NY,NX)/31.0 + CFEPO(L,NY,NX)=CFEPO(L,NY,NX)/31.0 + CCAPD(L,NY,NX)=CCAPD(L,NY,NX)/31.0 + CCAPH(L,NY,NX)=CCAPH(L,NY,NX)/(31.0*3.0) + CALOH(L,NY,NX)=CALOH(L,NY,NX)/27.0 + CFEOH(L,NY,NX)=CFEOH(L,NY,NX)/56.0 + CCACO(L,NY,NX)=CCACO(L,NY,NX)/40.0 + CCASO(L,NY,NX)=CCASO(L,NY,NX)/40.0 + IF(FC(L,NY,NX).LT.0.0)THEN + ISOIL(1,L,NY,NX)=1 + PSIFC(NY,NX)=-0.033 + ELSE + ISOIL(1,L,NY,NX)=0 + ENDIF + IF(WP(L,NY,NX).LT.0.0)THEN + ISOIL(2,L,NY,NX)=1 + PSIWP(NY,NX)=-1.5 + ELSE + ISOIL(2,L,NY,NX)=0 + ENDIF + IF(SCNV(L,NY,NX).LT.0.0)THEN + ISOIL(3,L,NY,NX)=1 + ELSE + ISOIL(3,L,NY,NX)=0 + ENDIF + IF(SCNH(L,NY,NX).LT.0.0)THEN + ISOIL(4,L,NY,NX)=1 + ELSE + ISOIL(4,L,NY,NX)=0 + ENDIF +C IF(BKDS(L,NY,NX).EQ.0.0)THEN +C FC(L,NY,NX)=1.0 +C WP(L,NY,NX)=1.0 +C ISOIL(1,L,NY,NX)=0 +C ISOIL(2,L,NY,NX)=0 +C CCLAY(L,NY,NX)=0.0 +C ENDIF +C +C BIOCHEMISTRY 130:117-131 +C + IF(CORGN(L,NY,NX).LT.0.0)THEN + CORGN(L,NY,NX)=AMIN1(0.125*CORGC(L,NY,NX) + 2,8.9E+02*(CORGC(L,NY,NX)/1.0E+04)**0.80) +C WRITE(*,1111)'CORGN',L,CORGN(L,NY,NX),CORGC(L,NY,NX) + ENDIF + IF(CORGP(L,NY,NX).LT.0.0)THEN + CORGP(L,NY,NX)=AMIN1(0.0125*CORGC(L,NY,NX) + 2,1.2E+02*(CORGC(L,NY,NX)/1.0E+04)**0.52) +C WRITE(*,1111)'CORGP',L,CORGP(L,NY,NX),CORGC(L,NY,NX) + ENDIF + IF(CEC(L,NY,NX).LT.0.0)THEN + CEC(L,NY,NX)=10.0*(200.0*2.0*CORGC(L,NY,NX)/1.0E+06 + 2+80.0*CCLAY(L,NY,NX)+20.0*CSILT(L,NY,NX) + 3+5.0*CSAND(L,NY,NX)) +C WRITE(*,1111)'CEC',L,CEC(L,NY,NX),CORGC(L,NY,NX) +C 2,CCLAY(L,NY,NX),CSILT(L,NY,NX),CSAND(L,NY,NX) +1111 FORMAT(A8,1I4,12E12.4) + ENDIF +28 CONTINUE +9990 CONTINUE +9995 CONTINUE + CLOSE(9) + GO TO 50 +20 CONTINUE + CLOSE(7) + DO 9975 NX=NHW,NHE + NL(NVS+1,NX)=NL(NVS,NX) +C WRITE(*,2223)'NHE',NX,NHW,NHE,NVS,NL(NVS,NX) +9975 CONTINUE + DO 9970 NY=NVN,NVS + NL(NY,NHE+1)=NL(NY,NHE) +C WRITE(*,2223)'NVS',NY,NVN,NVS,NHE,NL(NY,NHE) +2223 FORMAT(A8,6I4) +9970 CONTINUE + NL(NVS+1,NHE+1)=NL(NVS,NHE) + IOLD=0 + RETURN + END + + + diff --git a/f77src/reads.f b/f77src/reads.f index c66868f..59f79e3 100755 --- a/f77src/reads.f +++ b/f77src/reads.f @@ -1,865 +1,866 @@ - - SUBROUTINE reads(NA,ND,NT,NE,NAX,NDX,NTX,NEX,NF,NFX,NTZ - 2,NTZX,NHW,NHE,NVN,NVS) -C -C THIS SUBROUTINE READS ALL SOIL AND PLANT MANAGEMENT INPUT FILES -C - include "parameters.h" - include "filec.h" - include "files.h" - include "blkc.h" - include "blk2a.h" - include "blk2b.h" - include "blk2c.h" - include "blk8a.h" - include "blk8b.h" - include "blk17.h" - include "blktest.h" - DIMENSION NA(10),ND(10) - CHARACTER*16 DATA(30),DATAC(30,250,250),DATAP(JP,JY,JX) - 2,DATAM(JP,JY,JX),DATAX(JP),DATAY(JP),DATAZ(JP,JY,JX) - 3,OUTS(10),OUTP(10),OUTFILS(10,JY,JX),OUTFILP(10,JP,JY,JX) - CHARACTER*3 CHOICE(102,20) - CHARACTER*8 CDATE - CHARACTER*16 OUTW,OUTI,OUTT,OUTN,OUTF - CHARACTER*4 CHARY - CHARACTER*1 TTYPE,CTYPE,IVAR(20),VAR(50),TYP(50) - CHARACTER*80 PREFIX - DIMENSION IDAT(20),DAT(50),DATK(50),OUT(50) - PARAMETER (TWILGT=0.06976) - DATA IFLGY,IYRX,IYRD/0,0,0/ - SAVE N1,N2,N1X,N2X,IFLGY,IYRX,IYRD -C -C OPEN WEATHER AND OPTIONS FILES FROM -C FILE NAMES IN DATA ARRAYS LOADED IN 'MAIN' -C - OPEN(3,FILE=TRIM(PREFIX)//DATAC(3,NE,NEX),STATUS='OLD') - OPEN(4,FILE=TRIM(PREFIX)//DATAC(4,NE,NEX),STATUS='OLD') - IF(DATAC(9,NE,NEX).NE.'NO')THEN - OPEN(13,FILE=TRIM(PREFIX)//DATAC(9,NE,NEX),STATUS='OLD') - ENDIF -C -C ARTIFICIAL SOIL WARMING -C -C OPEN(6,FILE='soiltemp',STATUS='OLD') -C23 READ(6,'(F8.3,4X,A8,I8,50E16.7E3)',END=27)DOY,CDATE,J -C 2,(OUT(L),L=1,33) -C IF(J.EQ.24)THEN -C I=INT(DOY) -C ELSE -C I=INT(DOY)+1 -C ENDIF -C DO 24 L=1,20 -C TKSZ(I,J,L)=OUT(L+13)+4.0+273.15 -24 CONTINUE -C GO TO 23 -27 CONTINUE -C -C READ START AND END DATES, WEATHER OPTIONS -C - READ(4,'(2I2,I4)')IDATA(1),IDATA(2),IDATA(3) - READ(4,'(2I2,I4)')IDATA(4),IDATA(5),IDATA(6) - READ(4,'(2I2,I4)')IDATA(7),IDATA(8),IDATA(9) - READ(4,'(A3)')DATA(18) - READ(4,'(A3)')DATA(19) - READ(4,'(A3)')DATA(20) - DO 25 N=1,4 - READ(4,*)DRAD(N),DTMPX(N),DTMPN(N),DHUM(N),DPREC(N) - 2,DIRRI(N),DWIND(N),DCO2E(N),DCN4R(N),DCNOR(N) -25 CONTINUE - DO 26 N=5,12 - DRAD(N)=DRAD(N-1) - DTMPX(N)=DTMPX(N-1) - DTMPN(N)=DTMPN(N-1) - DHUM(N)=DHUM(N-1) - DPREC(N)=DPREC(N-1) - DIRRI(N)=DIRRI(N-1) - DWIND(N)=DWIND(N-1) - DCO2E(N)=DCO2E(N-1) - DCN4R(N)=DCN4R(N-1) - DCNOR(N)=DCNOR(N-1) -26 CONTINUE - READ(4,*)NPX,NPY,JOUT,IOUT,KOUT,ICLM - NTZX=NTZ - IF(IGO.EQ.0.OR.IDATA(3).NE.0)THEN - IDATA(3)=IDATA(3)+(NT-1)*NF+(NTX-1)*NFX-NTZX - IDATA(6)=IDATA(6)+(NT-1)*NF+(NTX-1)*NFX-NTZX - IYRC=IDATA(3) - ELSE - IF(IDATA(1).EQ.1.AND.IDATA(2).EQ.1)THEN - IDATA(3)=IYRC+1 - ELSE - IDATA(3)=IYRC - ENDIF - IDATA(6)=IDATA(3) - IYRC=IDATA(3) - ENDIF - IF(NE.EQ.1)THEN - N1=IDATA(3) - ENDIF - IF(NE.EQ.NA(NEX))THEN - N2=IDATA(6) - NF=N2-N1+1 - IF(IDATA(4).NE.31.OR.IDATA(5).NE.12)THEN - NTZ=NTZ+1 - ENDIF - ENDIF - IF(NE.EQ.1.AND.NT.EQ.1.AND.NEX.EQ.1)THEN - N1X=IDATA(3) - ENDIF - IF(NE.EQ.NA(NEX).AND.NT.EQ.ND(NEX).AND.NEX.EQ.NAX)THEN - N2X=IDATA(6) - NFX=N2X-N1X+1 - IF(NE.NE.NA(NEX))THEN - IF(IDATA(4).NE.31.OR.IDATA(5).NE.12)THEN - NTZ=NTZ+1 - ENDIF - ENDIF - ENDIF - WRITE(*,7766)'IDATA3',IGO,IDATA(3),IDATA(6),IYRR,IYRC - 2,NE,NT,NEX,NF,NTX,NFX,NTZ,NTZX,N1,N2,N1X,N2X - 3,NA(NEX),ND(NEX),NAX -7766 FORMAT(A8,30I8) -C -C OPEN CHECKPOINT FILES FOR SOIL VARIABLES -C - IF(IGO.EQ.0)THEN - IF(DATA(20).EQ.'YES')THEN - IDATE=IDATA(9) - ELSE - IDATE=IDATA(3) - ENDIF - WRITE(CHARY,'(I4)')IDATE - OUTW='W'//DATA(1)(1:2)//CHARY(1:4) - OUTN='N'//DATA(1)(1:2)//CHARY(1:4) - OPEN(21,FILE=OUTW,STATUS='UNKNOWN') - OPEN(22,FILE=OUTN,STATUS='UNKNOWN') - ENDIF -C -C CALCULATE START AND FINISH DATES -C - LPY=0 - LYRC=365 - LYRX=365 - DO 575 N=1,7,3 - IF(MOD(IDATA(N+2),4))520,510,520 -510 IF(IDATA(N+1).GT.2)LPY=1 - IF(N.EQ.1)LYRC=366 -520 IF(IDATA(N+1).EQ.1)GO TO 525 - IDY=30*(IDATA(N+1)-1)+ICOR(IDATA(N+1)-1)+IDATA(N)+LPY - GO TO 527 -525 IDY=IDATA(N) -527 IF(N.EQ.1)ISTART=IDY - IF(N.EQ.4)IFIN=IDY - IF(N.EQ.7)IRUN=IDY - IF(MOD(IDATA(N+2)-1,4))575,530,575 -530 IF(N.EQ.1)LYRX=366 -575 CONTINUE - IF(IGO.EQ.0)THEN - IF(DATA(20).EQ.'NO')IRUN=ISTART - L=1 - ILAST=ISTART-1 - ITERM=IFIN - ELSE - L=2 - ILAST=MIN(ISTART-1,ITERM,IEND) - ITERM=IFIN - ENDIF -C -C READ WEATHER DATA -C - IF(DATAC(3,NE,NEX).NE.'NO')THEN - IFLG3=0 - READ(3,'(2A1,2I2,50A1)')TTYPE,CTYPE,NI,NN,(IVAR(K),K=1,NI) - 2,(VAR(K),K=1,NN) - READ(3,'(50A1)')(TYP(K),K=1,NN) - READ(3,*)Z0G,IFLGW,ZNOONG - READ(3,*)PHRG,CN4RIG,CNORIG,CPORG,CALRG,CFERG,CCARG,CMGRG,CNARG - 2,CKARG,CSORG,CCLRG - DO 55 K=1,NN - DATK(K)=0.0 -55 CONTINUE - IH=1 -60 READ(3,*,END=110)(IDAT(K),K=1,NI),(DAT(K),K=1,NN) -C WRITE(*,61)(IDAT(K),K=1,NI),(DAT(K),K=1,NN) -61 FORMAT(3I6,50E12.4) -C -C READ DAILY WEATHER DATA AND CONVERT TO MODEL UNITS -C - IF(TTYPE.EQ.'D')THEN - IWTHR(L)=1 - DO 160 K=1,NI - IF(IVAR(K).EQ.'M')THEN - M=IDAT(K) - ELSEIF(IVAR(K).EQ.'D')THEN - N=IDAT(K) - ENDIF - IF(IVAR(K).EQ.'Y')THEN - IFLGY=1 - IYRX=IDAT(K)+(NTX-1)*NFX - IF(MOD(IDAT(K),4))170,175,170 -175 IYRD=366 -170 IYRD=365 - ENDIF -160 CONTINUE - IF(IFLGY.EQ.1.AND.IYRX.LT.IYRC)GO TO 60 - IF(CTYPE.EQ.'J')THEN - I=N - ELSE - LPY=0 - IF(MOD(IDATA(3),4))70,75,70 -75 IF(M.GT.2)LPY=1 -70 IF(M.EQ.1)THEN - I=N - ELSE - I=30*(M-1)+ICOR(M-1)+N+LPY - ENDIF - ENDIF - IF(IFLG3.EQ.0)THEN - IBEGIN=I - ISTART=MAX(ISTART,IBEGIN) - IFLG3=1 - ENDIF - IF(L.NE.1)THEN - IF(I.LE.ILAST)GO TO 60 - ENDIF - DO 65 K=1,NN - IF(VAR(K).EQ.'M')THEN - IF(TYP(K).EQ.'F')THEN - TMPX(I)=(DAT(K)-32.0)*0.556 - ELSEIF(TYP(K).EQ.'K')THEN - TMPX(I)=DAT(K)-273.16 - ELSE - TMPX(I)=DAT(K) - ENDIF - ELSEIF(VAR(K).EQ.'N')THEN - IF(TYP(K).EQ.'F')THEN - TMPN(I)=(DAT(K)-32.0)*0.556 - ELSEIF(TYP(K).EQ.'K')THEN - TMPN(I)=DAT(K)-273.16 - ELSE - TMPN(I)=DAT(K) - ENDIF - ELSEIF(VAR(K).EQ.'R')THEN - IF(TYP(K).EQ.'L')THEN - SRAD(I)=AMAX1(0.0,DAT(K)/23.87) - ELSEIF(TYP(K).EQ.'J')THEN - SRAD(I)=AMAX1(0.0,DAT(K)*0.01) - ELSE - SRAD(I)=AMAX1(0.0,DAT(K)) - ENDIF - ELSEIF(VAR(K).EQ.'W')THEN - IF(TYP(K).EQ.'S')THEN - WIND(I)=ABS(DAT(K))*3600.0 - ELSEIF(TYP(K).EQ.'H')THEN - WIND(I)=ABS(DAT(K))*1000.0 - ELSEIF(TYP(K).EQ.'D')THEN - WIND(I)=ABS(DAT(K))*1000.0/24.0 - ELSEIF(TYP(K).EQ.'M')THEN - WIND(I)=ABS(DAT(K))*1600.0 - ELSE - WIND(I)=ABS(DAT(K)) - ENDIF - ELSEIF(VAR(K).EQ.'H')THEN - IF(TYP(K).EQ.'D')THEN - DWPT(1,I)=0.61*EXP(5360.0*(3.661E-03-1.0 - 2/(273.15+DAT(K)))) - DWPT(2,I)=0.61*EXP(5360.0*(3.661E-03-1.0 - 2/(273.15+DAT(K)))) - ELSEIF(TYP(K).EQ.'F')THEN - DAT(K)=(DAT(K)-32.0)*0.556 - DWPT(1,I)=0.61*EXP(5360.0*(3.661E-03-1.0 - 2/(273.15+DAT(K)))) - DWPT(2,I)=0.61*EXP(5360.0*(3.661E-03-1.0 - 2/(273.15+DAT(K)))) - ELSEIF(TYP(K).EQ.'H')THEN - DAT(K)=AMAX1(0.0,AMIN1(1.0,DAT(K))) - DWPT(1,I)=0.61*EXP(5360.0*(3.661E-03-1.0 - 2/(273.15+(TMPN(I)+TMPX(I))/2)))*DAT(K) - DWPT(2,I)=0.61*EXP(5360.0*(3.661E-03-1.0 - 2/(273.15+TMPN(I)))) - ELSEIF(TYP(K).EQ.'R')THEN - DAT(K)=AMAX1(0.0,AMIN1(100.0,DAT(K))) - DWPT(1,I)=0.61*EXP(5360.0*(3.661E-03-1.0 - 2/(273.15+(TMPN(I)+TMPX(I))/2)))*DAT(K)*0.01 - DWPT(2,I)=0.61*EXP(5360.0*(3.661E-03-1.0 - 2/(273.15+TMPN(I)))) - ELSEIF(TYP(K).EQ.'S')THEN - DWPT(1,I)=AMAX1(0.0,DAT(K))*0.0289/18.0*101.325 - 2*EXP(-ALTIG/7272.0)*288.15/(273.15+(TMPN(I)+TMPX(I))/2) - DWPT(2,I)=AMAX1(0.0,DAT(K))*0.0289/18.0*101.325 - 2*EXP(-ALTIG/7272.0)*288.15/(273.15+TMPN(I)) - ELSEIF(TYP(K).EQ.'G')THEN - DWPT(1,I)=AMAX1(0.0,DAT(K))*28.9/18.0*101.325 - 2*EXP(-ALTIG/7272.0)*288.15/(273.15+(TMPN(I)+TMPX(I))/2) - DWPT(2,I)=AMAX1(0.0,DAT(K))*28.9/18.0*101.325 - 2*EXP(-ALTIG/7272.0)*288.15/(273.15+TMPN(I)) - ELSEIF(TYP(K).EQ.'M')THEN - DWPT(1,I)=AMAX1(0.0,DAT(K)*0.1) - DWPT(2,I)=AMAX1(0.0,DAT(K)*0.1) - ELSE - DWPT(1,I)=AMAX1(0.0,DAT(K)) - DWPT(2,I)=AMAX1(0.0,DAT(K)) - ENDIF - ELSEIF(VAR(K).EQ.'P')THEN - IF(TYP(K).EQ.'M')THEN - RAIN(I)=AMAX1(0.0,DAT(K))/1.0E+03 - ELSEIF(TYP(K).EQ.'C')THEN - RAIN(I)=AMAX1(0.0,DAT(K))/1.0E+02 - ELSEIF(TYP(K).EQ.'I')THEN - RAIN(I)=AMAX1(0.0,DAT(K))*0.0254 - ELSE - RAIN(I)=AMAX1(0.0,DAT(K)) - ENDIF - ENDIF -65 CONTINUE - IX=I - IF(IFLGY.EQ.1.AND.I.EQ.IYRD)THEN - GO TO 110 - ENDIF - GO TO 60 -C -C READ HOURLY WEATHER DATA AND CONVERT TO MODEL UNITS -C - ELSE - IWTHR(L)=2 - DO 190 K=1,NI - IF(IVAR(K).EQ.'M')THEN - M=IDAT(K) - ELSEIF(IVAR(K).EQ.'D')THEN - N=IDAT(K) - ELSEIF(IVAR(K).EQ.'H')THEN - J=IDAT(K) - ENDIF - IF(IVAR(K).EQ.'Y')THEN - IFLGY=1 - ENDIF -190 CONTINUE - IF(IFLGY.EQ.1.AND.IYRX.LT.IYRC)GO TO 60 - IF(CTYPE.EQ.'J')THEN - I=N - ELSE - LPY=0 - IF(MOD(IDATA(3),4))100,115,100 -115 IF(M.GT.2)LPY=1 -100 IF(M.EQ.1)THEN - I=N - ELSE - I=30*(M-1)+ICOR(M-1)+N+LPY - ENDIF - ENDIF - IF(J.GT.24.AND.(J/100)*100.NE.J)THEN - DO 80 K=1,NN - DATK(K)=DATK(K)+DAT(K) -80 CONTINUE - IH=IH+1 - GO TO 60 - ENDIF - IF(J.GT.24)J=INT(J/100) - IF(J.EQ.0)THEN - J=24 - I=I-1 - IF(I.LT.1)GO TO 60 - ENDIF - IF(IFLG3.EQ.0)THEN - IBEGIN=N - ISTART=MAX(ISTART,IBEGIN) - IFLG3=1 - ENDIF - IF(L.NE.1)THEN - IF(I.LE.ILAST)GO TO 60 - ENDIF - XWTHR(J,I)=0.0 - DO 95 K=1,NN - IF(VAR(K).EQ.'T')THEN - IF(TYP(K).EQ.'F')THEN - TMPH(J,I)=((DAT(K)+DATK(K))/IH-32.0)*0.556 - ELSEIF(TYP(K).EQ.'K')THEN - TMPH(J,I)=(DAT(K)+DATK(K))/IH-273.16 - ELSE - TMPH(J,I)=(DAT(K)+DATK(K))/IH - ENDIF - ELSEIF(VAR(K).EQ.'R')THEN - IF(TYP(K).EQ.'W')THEN - SRADH(J,I)=AMAX1(0.0,(DAT(K)+DATK(K))/IH*0.0036) - ELSEIF(TYP(K).EQ.'J')THEN - SRADH(J,I)=AMAX1(0.0,(DAT(K)+DATK(K))/IH*0.01) - ELSEIF(TYP(K).EQ.'K')THEN - SRADH(J,I)=AMAX1(0.0,(DAT(K)+DATK(K))/IH*0.001) - ELSEIF(TYP(K).EQ.'P')THEN - SRADH(J,I)=AMAX1(0.0,(DAT(K)+DATK(K))/IH*0.0036*0.457) -C ELSEIF(TYP(K).EQ.'M')THEN -C SRADH(J,I)=AMAX1(0.0,(DAT(K)+DATK(K))/IH*3.6*0.457) - ELSE - SRADH(J,I)=AMAX1(0.0,(DAT(K)+DATK(K))/IH) - ENDIF - ELSEIF(VAR(K).EQ.'W')THEN - IF(TYP(K).EQ.'S')THEN - WINDH(J,I)=(DAT(K)+DATK(K))/IH*3600.0 - ELSEIF(TYP(K).EQ.'H')THEN - WINDH(J,I)=(DAT(K)+DATK(K))/IH*1000.0 - ELSEIF(TYP(K).EQ.'M')THEN - WINDH(J,I)=(DAT(K)+DATK(K))/IH*1600.0 - ELSE - WINDH(J,I)=(DAT(K)+DATK(K))/IH - ENDIF - ELSEIF(VAR(K).EQ.'H')THEN - IF(TYP(K).EQ.'D')THEN - DWPTH(J,I)=0.61*EXP(5360.0*(3.661E-03-1.0/(273.15 - 2+(DAT(K)+DATK(K))/IH))) - ELSEIF(TYP(K).EQ.'F')THEN - DAT(K)=(DAT(K)-32.0)*0.556 - DWPTH(J,I)=0.61*EXP(5360.0*(3.661E-03-1.0/(273.15 - 2+(DAT(K)+DATK(K))/IH))) - ELSEIF(TYP(K).EQ.'H')THEN - DWPTH(J,I)=0.61*EXP(5360.0*(3.661E-03-1.0/(273.15+TMPH(J,I)))) - 2*AMAX1(0.0,AMIN1(1.0,(DAT(K)+DATK(K))/IH)) - ELSEIF(TYP(K).EQ.'R')THEN - DWPTH(J,I)=0.61*EXP(5360.0*(3.661E-03-1.0/(273.15+TMPH(J,I)))) - 2*AMAX1(0.0,AMIN1(100.0,(DAT(K)+DATK(K))/IH))*0.01 - ELSEIF(TYP(K).EQ.'S')THEN - DWPTH(J,I)=AMAX1(0.0,(DAT(K)+DATK(K))/IH)*0.0289/18.0*101.325 - 2*EXP(-ALTIG/7272.0)*288.15/(273.15+TMPH(J,I)) - ELSEIF(TYP(K).EQ.'G')THEN - DWPTH(J,I)=AMAX1(0.0,(DAT(K)+DATK(K))/IH)*28.9/18.0*101.325 - 2*EXP(-ALTIG/7272.0)*288.15/(273.15+TMPH(J,I)) - ELSEIF(TYP(K).EQ.'M')THEN - DWPTH(J,I)=AMAX1(0.0,(DAT(K)+DATK(K))/IH*0.1) - ELSE - DWPTH(J,I)=AMAX1(0.0,(DAT(K)+DATK(K))/IH) - ENDIF - ELSEIF(VAR(K).EQ.'P')THEN - IF(TYP(K).EQ.'M')THEN - RAINH(J,I)=AMAX1(0.0,DAT(K)+DATK(K))/1.0E+03 - ELSEIF(TYP(K).EQ.'C')THEN - RAINH(J,I)=AMAX1(0.0,DAT(K)+DATK(K))/1.0E+02 - ELSEIF(TYP(K).EQ.'I')THEN - RAINH(J,I)=AMAX1(0.0,DAT(K)+DATK(K))*0.0254 - ELSEIF(TYP(K).EQ.'S')THEN - IF(TTYPE.EQ.'H')THEN - RAINH(J,I)=AMAX1(0.0,DAT(K)+DATK(K))*3.6 - ELSE - RAINH(J,I)=AMAX1(0.0,DAT(K)+DATK(K))*1.8 - ENDIF - ELSE - RAINH(J,I)=AMAX1(0.0,DAT(K)+DATK(K)) - ENDIF - ELSEIF(VAR(K).EQ.'L')THEN - IF(TYP(K).EQ.'W')THEN - XWTHR(J,I)=AMAX1(0.0,(DAT(K)+DATK(K))/IH*0.0036) - ELSEIF(TYP(K).EQ.'J')THEN - XWTHR(J,I)=AMAX1(0.0,(DAT(K)+DATK(K))/IH*0.01) - ELSEIF(TYP(K).EQ.'K')THEN - XWTHR(J,I)=AMAX1(0.0,(DAT(K)+DATK(K))/IH*0.001) - ELSE - XWTHR(J,I)=AMAX1(0.0,(DAT(K)+DATK(K))/IH) - ENDIF - ENDIF - DATK(K)=0.0 -95 CONTINUE - IH=1 - IX=I - IF(TTYPE.EQ.'3')THEN - JJ=J-3 - II=I - IF(JJ.EQ.0)THEN - JJ=24 - II=I-1 - ENDIF - IF(II.LT.1)THEN - TMPH(J-2,I)=TMPH(J,I) - TMPH(J-1,I)=TMPH(J,I) - SRADH(J-2,I)=SRADH(J,I) - SRADH(J-1,I)=SRADH(J,I) - WINDH(J-2,I)=WINDH(J,I) - WINDH(J-1,I)=WINDH(J,I) - DWPTH(J-2,I)=DWPTH(J,I) - DWPTH(J-1,I)=DWPTH(J,I) - RAINH(J,I)=RAINH(J,I)/3.0 - RAINH(J-2,I)=RAINH(J,I) - RAINH(J-1,I)=RAINH(J,I) - XWTHR(J-2,I)=XWTHR(J,I) - XWTHR(J-1,I)=XWTHR(J,I) - ELSE - TMPH(J-2,I)=0.667*TMPH(JJ,II)+0.333*TMPH(J,I) - TMPH(J-1,I)=0.333*TMPH(JJ,II)+0.667*TMPH(J,I) - SRADH(J-2,I)=0.667*SRADH(JJ,II)+0.333*SRADH(J,I) - SRADH(J-1,I)=0.333*SRADH(JJ,II)+0.667*SRADH(J,I) - WINDH(J-2,I)=0.667*WINDH(JJ,II)+0.333*WINDH(J,I) - WINDH(J-1,I)=0.333*WINDH(JJ,II)+0.667*WINDH(J,I) - DWPTH(J-2,I)=0.667*DWPTH(JJ,II)+0.333*DWPTH(J,I) - DWPTH(J-1,I)=0.333*DWPTH(JJ,II)+0.667*DWPTH(J,I) - RAINH(J,I)=RAINH(J,I)/3.0 - RAINH(J-2,I)=RAINH(J,I) - RAINH(J-1,I)=RAINH(J,I) - XWTHR(J-2,I)=0.667*XWTHR(JJ,II)+0.333*XWTHR(J,I) - XWTHR(J-1,I)=0.333*XWTHR(JJ,II)+0.667*XWTHR(J,I) - ENDIF - ENDIF - IF(IFLGY.EQ.1.AND.I.EQ.IYRD.AND.J.EQ.24)THEN - GO TO 110 - ENDIF - GO TO 60 - ENDIF -110 CONTINUE -C -C ACCOUNT FOR LEAP YEAR -C - IF(I.EQ.365)THEN - IF(TTYPE.EQ.'D')THEN - TMPX(I+1)=TMPX(I) - TMPN(I+1)=TMPN(I) - SRAD(I+1)=SRAD(I) - WIND(I+1)=WIND(I) - DWPT(1,I+1)=DWPT(1,I) - DWPT(2,I+1)=DWPT(2,I) - RAIN(I+1)=RAIN(I) - ELSE - DO 130 J=1,24 - TMPH(J,I+1)=TMPH(J,I) - SRADH(J,I+1)=SRADH(J,I) - WINDH(J,I+1)=WINDH(J,I) - DWPTH(J,I+1)=DWPTH(J,I) - RAINH(J,I+1)=RAINH(J,I) - XWTHR(J,I+1)=XWTHR(J,I) -130 CONTINUE - ENDIF - IX=I+1 - ENDIF - ELSE - IFLGW=1 - Z0G=2.0 - ZNOONG=12.0 - PHRG=7.0 - CN4RIG=0.0 - CNORIG=0.0 - CN4RG=CN4RIG - CNORG=CNORIG - CPORG=0.0 - CALRG=0.0 - CFERG=0.0 - CCARG=0.0 - CMGRG=0.0 - CNARG=0.0 - CKARG=0.0 - CSORG=0.0 - CCLRG=0.0 - IX=365 - ENDIF -C -C CALCULATE PRECIPITATION COMPOSITION -C - CN4RIG=CN4RIG/14.0 - CNORIG=CNORIG/14.0 - CN4RG=CN4RIG - CNORG=CNORIG - CPORG=CPORG/31.0 - CALRG=CALRG/27.0 - CFERG=CFERG/55.8 - CCARG=CCARG/40.0 - CMGRG=CMGRG/24.3 - CNARG=CNARG/23.0 - CKARG=CKARG/39.1 - CSORG=CSORG/32.0 - CCLRG=CCLRG/35.5 - DO 8970 NX=NHW,NHE - DO 8975 NY=NVN,NVS - Z0(NY,NX)=Z0G - ZNOON(NY,NX)=ZNOONG - PHR(NY,NX)=PHRG - CN4RI(NY,NX)=CN4RIG - CNORI(NY,NX)=CNORIG - CN4R(NY,NX)=CN4RIG - CNOR(NY,NX)=CNORIG - CPOR(NY,NX)=CPORG - CALR(NY,NX)=CALRG - CFER(NY,NX)=CFERG - CCAR(NY,NX)=CCARG - CMGR(NY,NX)=CMGRG - CNAR(NY,NX)=CNARG - CKAR(NY,NX)=CKARG - CSOR(NY,NX)=CSORG - CCLR(NY,NX)=CCLRG -8975 CONTINUE -8970 CONTINUE - ICHECK=0 - IF(TTYPE.EQ.'H'.AND.J.NE.24)ICHECK=1 - IEND=IX-ICHECK - IFIN=MIN(IFIN,IEND) - IDAYR=MIN(ISTART-1,ILAST) - IYRR=IDATA(3) - NYR=0 - IF(IDAYR.EQ.0)THEN - IDAYR=LYRX - IYRR=IDATA(3)-1 - NYR=1 - ENDIF - IFLGY=0 - CLOSE(3) - CLOSE(4) -C -C READ LAND MANAGEMENT FILE NAMES FOR EACH GRID CELL -C - DO 9980 NX=NHW,NHE - DO 9985 NY=NVN,NVS - ROWN(NY,NX)=0.0 - ROWO(NY,NX)=0.0 - ROWP(NY,NX)=0.0 - DO 325 I=1,366 - ITILL(I,NY,NX)=0 - DCORP(I,NY,NX)=0.0 -325 CONTINUE - DO 40 I=1,366 - DO 45 N=1,20 - FERT(N,I,NY,NX)=0.0 -45 CONTINUE - DO 35 N=0,2 - IYTYP(N,I,NY,NX)=0 -35 CONTINUE - FDPTH(I,NY,NX)=0.0 -40 CONTINUE - DO 125 I=1,366 - DO 120 J=1,24 - RRIG(J,I,NY,NX)=0.0 -120 CONTINUE - PHQ(I,NY,NX)=0.0 - CN4Q(I,NY,NX)=0.0 - CNOQ(I,NY,NX)=0.0 - CPOQ(I,NY,NX)=0.0 - CALQ(I,NY,NX)=0.0 - CFEQ(I,NY,NX)=0.0 - CCAQ(I,NY,NX)=0.0 - CMGQ(I,NY,NX)=0.0 - CNAQ(I,NY,NX)=0.0 - CKAQ(I,NY,NX)=0.0 - CSOQ(I,NY,NX)=0.0 - CCLQ(I,NY,NX)=0.0 - WDPTH(I,NY,NX)=0.0 - ROWI(I,NY,NX)=0.0 -125 CONTINUE -9985 CONTINUE -9980 CONTINUE -C -C READ LAND MANAGEMENT FILE STORED -C IN FILE NAME DATA ARRAY LOADED IN 'MAIN'. -C THIS FILE CONTAINS NAMES OF TILLAGE, IRRIGATION -C AND FERTILIZER FILES -C - IF(DATAC(9,NE,NEX).NE.'NO')THEN -150 READ(13,*,END=200)NH1,NV1,NH2,NV2 - READ(13,*)DATA(8),DATA(5),DATA(6) - IF(DATA(8).NE.'NO')THEN - OPEN(10,FILE=TRIM(PREFIX)//DATA(8),STATUS='OLD') - ENDIF - IF(DATA(5).NE.'NO')THEN - OPEN(8,FILE=TRIM(PREFIX)//DATA(5),STATUS='OLD') - ENDIF - IF(DATA(6).NE.'NO')THEN - OPEN(2,FILE=TRIM(PREFIX)//DATA(6),STATUS='OLD') - ENDIF -C -C READ TILLAGE INPUT FILE -C - IF(DATA(8).NE.'NO')THEN -295 CONTINUE - READ(10,*,END=305)DY,IPLOW,DPLOW - LPY=0 - IDY1=INT(DY/1.0E+06) - IDY2=INT(DY/1.0E+04-IDY1*1.0E+02) - IDY3=INT(DY-(IDY1*1.0E+06+IDY2*1.0E+04)) - IF(MOD(IDY3,4))3520,3510,3520 -3510 IF(IDY2.GT.2)LPY=1 -3520 IF(IDY2.EQ.1)GO TO 3535 - IDY=30*(IDY2-1)+ICOR(IDY2-1)+IDY1+LPY -C IF(IDY2.LE.6)IDY=IDY-0.5*(NTX-1) -C IF(IDY2.GE.7)IDY=IDY+0.5*(NTX-1) - GO TO 3530 -3535 IDY=IDY1 -3530 CONTINUE - DO 8995 NX=NH1,NH2 - DO 8990 NY=NV1,NV2 - ITILL(IDY,NY,NX)=IPLOW - DCORP(IDY,NY,NX)=DPLOW -8990 CONTINUE -8995 CONTINUE - GO TO 295 -305 CONTINUE - CLOSE(10) - ENDIF -C -C READ FERTLIZER INPUT FILE -C - IF(DATA(5).NE.'NO')THEN -1500 CONTINUE - READ(8,*,END=85)DY,Z4A,Z3A,ZUA,ZOA,Z4B,Z3B,ZUB,ZOB - 2,PMA,PMB,PHA,CAC,CAS,RSC1,RSN1,RSP1,RSC2,RSN2,RSP2,FDPTHI - 3,ROWX,IR0,IR1,IR2 - LPY=0 - IDY1=INT(DY/1.0E+06) - IDY2=INT(DY/1.0E+04-IDY1*1.0E+02) - IDY3=INT(DY-(IDY1*1.0E+06+IDY2*1.0E+04)) - IF(MOD(IDY3,4))1520,1510,1520 -1510 IF(IDY2.GT.2)LPY=1 -1520 IF(IDY2.EQ.1)GO TO 1525 - IDY=30*(IDY2-1)+ICOR(IDY2-1)+IDY1+LPY -C IF(IDY2.LE.6)IDY=IDY-0.5*(NTX-1) -C IF(IDY2.GE.7)IDY=IDY+0.5*(NTX-1) - GO TO 1530 -1525 IDY=IDY1 -1530 CONTINUE - DO 8985 NX=NH1,NH2 - DO 8980 NY=NV1,NV2 -C -C NH4,NH3,UREA,NO3 BROADCAST (A) AND BANDED (B) -C - FERT(1,IDY,NY,NX)=Z4A - FERT(2,IDY,NY,NX)=Z3A - FERT(3,IDY,NY,NX)=ZUA - FERT(4,IDY,NY,NX)=ZOA - FERT(5,IDY,NY,NX)=Z4B - FERT(6,IDY,NY,NX)=Z3B - FERT(7,IDY,NY,NX)=ZUB - FERT(8,IDY,NY,NX)=ZOB -C -C MONOCALCIUM PHOSPHATE OR HYDROXYAPATITE BROADCAST (A) -C AND BANDED (B) -C - FERT(9,IDY,NY,NX)=PMA - FERT(10,IDY,NY,NX)=PMB - FERT(11,IDY,NY,NX)=PHA -C -C LIME AND GYPSUM -C - FERT(12,IDY,NY,NX)=CAC - FERT(13,IDY,NY,NX)=CAS -C -C PLANT AND ANIMAL RESIDUE C, N AND P -C - FERT(14,IDY,NY,NX)=RSC1 - FERT(15,IDY,NY,NX)=RSN1 - FERT(16,IDY,NY,NX)=RSP1 - FERT(17,IDY,NY,NX)=RSC2 - FERT(18,IDY,NY,NX)=RSN2 - FERT(19,IDY,NY,NX)=RSP2 -C -C DEPTH OF APPLICATION -C - FDPTH(IDY,NY,NX)=FDPTHI - ROWI(IDY,NY,NX)=ROWX -C -C TYPE OF PLANT OR ANIMAL RESIDUE -C - IYTYP(0,IDY,NY,NX)=IR0 - IYTYP(1,IDY,NY,NX)=IR1 - IYTYP(2,IDY,NY,NX)=IR2 -8980 CONTINUE -8985 CONTINUE - GO TO 1500 -85 CONTINUE - CLOSE(8) - ENDIF -C -C READ IRRIGATION INPUT FILE -C - IF(DATA(6).NE.'NO')THEN - IF(DATA(6)(1:4).EQ.'auto')THEN - READ(2,*,END=105)DST,DEN,FIRRX,CIRRX,DIRRX,WDPTHI,PHQX,CN4QX,CNOQX - 2,CPOQX,CALQX,CFEQX,CCAQX,CMGQX,CNAQX,CKAQX,CSOQX,CCLQX - LPY=0 - IDY1=INT(DST/1.0E+06) - IDY2=INT(DST/1.0E+04-IDY1*1.0E+02) - IDY3=INT(DST-(IDY1*1.0E+06+IDY2*1.0E+04)) - IF(MOD(IDY3,4))4520,4510,4520 -4510 IF(IDY2.GT.2)LPY=1 -4520 IF(IDY2.EQ.1)GO TO 4535 - IDYS=30*(IDY2-1)+ICOR(IDY2-1)+IDY1+LPY - GO TO 4530 -4535 IDYS=IDY1 -4530 CONTINUE - IHRS=IDY3 - LPY=0 - IDY1=INT(DEN/1.0E+06) - IDY2=INT(DEN/1.0E+04-IDY1*1.0E+02) - IDY3=INT(DEN-(IDY1*1.0E+06+IDY2*1.0E+04)) - IF(MOD(IDY3,4))5520,5510,5520 -5510 IF(IDY2.GT.2)LPY=1 -5520 IF(IDY2.EQ.1)GO TO 5535 - IDYE=30*(IDY2-1)+ICOR(IDY2-1)+IDY1+LPY - GO TO 5530 -5535 IDYE=IDY1 -5530 CONTINUE - IHRE=IDY3 - DO 7965 NX=NH1,NH2 - DO 7960 NY=NV1,NV2 - IIRRA(1,NY,NX)=IDYS - IIRRA(2,NY,NX)=IDYE - IIRRA(3,NY,NX)=IHRS - IIRRA(4,NY,NX)=IHRE - FIRRA(NY,NX)=FIRRX - CIRRA(NY,NX)=CIRRX - DIRRA(1,NY,NX)=DIRRX - DIRRA(2,NY,NX)=WDPTHI - DO 220 I=1,366 - PHQ(IDY,NY,NX)=PHQX - CN4Q(IDY,NY,NX)=CN4QX/14.0 - CNOQ(IDY,NY,NX)=CNOQX/14.0 - CPOQ(IDY,NY,NX)=CPOQX/31.0 - CALQ(IDY,NY,NX)=CALQX/27.0 - CFEQ(IDY,NY,NX)=CFEQX/55.8 - CCAQ(IDY,NY,NX)=CCAQX/40.0 - CMGQ(IDY,NY,NX)=CMGQX/24.3 - CNAQ(IDY,NY,NX)=CNAQX/23.0 - CKAQ(IDY,NY,NX)=CKAQX/39.1 - CSOQ(IDY,NY,NX)=CSOQX/32.0 - CCLQ(IDY,NY,NX)=CCLQX/35.5 -220 CONTINUE -7960 CONTINUE -7965 CONTINUE - ELSE -2500 CONTINUE - READ(2,*,END=105)DY,RR,JST,JEN,WDPTHI,PHQX,CN4QX,CNOQX,CPOQX - 2,CALQX,CFEQX,CCAQX,CMGQX,CNAQX,CKAQX,CSOQX,CCLQX - LPY=0 - IDY1=INT(DY/1.0E+06) - IDY2=INT(DY/1.0E+04-IDY1*1.0E+02) - IDY3=INT(DY-(IDY1*1.0E+06+IDY2*1.0E+04)) - IF(MOD(IDY3,4))2520,2510,2520 -2510 IF(IDY2.GT.2)LPY=1 -2520 IF(IDY2.EQ.1)GO TO 2525 - IDY=30*(IDY2-1)+ICOR(IDY2-1)+IDY1+LPY - GO TO 2530 -2525 IDY=IDY1 -2530 CONTINUE - RRH=RR/(JEN-(JST-1)) - DO 8965 NX=NH1,NH2 - DO 8960 NY=NV1,NV2 - DO 2535 J=1,24 - IF(J.GE.JST.AND.J.LE.JEN)RRIG(J,IDY,NY,NX)=RRH/1000.0 -2535 CONTINUE - PHQ(IDY,NY,NX)=PHQX - CN4Q(IDY,NY,NX)=CN4QX/14.0 - CNOQ(IDY,NY,NX)=CNOQX/14.0 - CPOQ(IDY,NY,NX)=CPOQX/31.0 - CALQ(IDY,NY,NX)=CALQX/27.0 - CFEQ(IDY,NY,NX)=CFEQX/55.8 - CCAQ(IDY,NY,NX)=CCAQX/40.0 - CMGQ(IDY,NY,NX)=CMGQX/24.3 - CNAQ(IDY,NY,NX)=CNAQX/23.0 - CKAQ(IDY,NY,NX)=CKAQX/39.1 - CSOQ(IDY,NY,NX)=CSOQX/32.0 - CCLQ(IDY,NY,NX)=CCLQX/35.5 - WDPTH(IDY,NY,NX)=WDPTHI -8960 CONTINUE -8965 CONTINUE - GO TO 2500 - ENDIF -105 CONTINUE - ENDIF - CLOSE(2) - GO TO 150 -200 CONTINUE - CLOSE(13) - ENDIF - IMNG=1 - RETURN - END + + SUBROUTINE reads(NA,ND,NT,NE,NAX,NDX,NTX,NEX,NF,NFX,NTZ + 2,NTZX,NHW,NHE,NVN,NVS) +C +C THIS SUBROUTINE READS ALL SOIL AND PLANT MANAGEMENT INPUT FILES +C + include "parameters.h" + include "filec.h" + include "files.h" + include "blkc.h" + include "blk2a.h" + include "blk2b.h" + include "blk2c.h" + include "blk8a.h" + include "blk8b.h" + include "blk17.h" + include "blktest.h" + DIMENSION NA(10),ND(10) + CHARACTER*16 DATA(30),DATAC(30,250,250),DATAP(JP,JY,JX) + 2,DATAM(JP,JY,JX),DATAX(JP),DATAY(JP),DATAZ(JP,JY,JX) + 3,OUTS(10),OUTP(10),OUTFILS(10,JY,JX),OUTFILP(10,JP,JY,JX) + CHARACTER*3 CHOICE(102,20) + CHARACTER*8 CDATE + CHARACTER*16 OUTW,OUTI,OUTT,OUTN,OUTF + CHARACTER*4 CHARY + CHARACTER*1 TTYPE,CTYPE,IVAR(20),VAR(50),TYP(50) + CHARACTER*80 PREFIX + DIMENSION IDAT(20),DAT(50),DATK(50),OUT(50) + PARAMETER (TWILGT=0.06976) + DATA IFLGY,IYRX,IYRD/0,0,0/ + SAVE N1,N2,N1X,N2X,IFLGY,IYRX,IYRD +C +C OPEN WEATHER AND OPTIONS FILES FROM +C FILE NAMES IN DATA ARRAYS LOADED IN 'MAIN' +C + OPEN(3,FILE=TRIM(PREFIX)//DATAC(3,NE,NEX),STATUS='OLD') + OPEN(4,FILE=TRIM(PREFIX)//DATAC(4,NE,NEX),STATUS='OLD') + IF(DATAC(9,NE,NEX).NE.'NO')THEN + OPEN(13,FILE=TRIM(PREFIX)//DATAC(9,NE,NEX),STATUS='OLD') + ENDIF +C +C ARTIFICIAL SOIL WARMING +C +C OPEN(6,FILE='soiltemp',STATUS='OLD') +C23 READ(6,'(F8.3,4X,A8,I8,50E16.7E3)',END=27)DOY,CDATE,J +C 2,(OUT(L),L=1,33) +C IF(J.EQ.24)THEN +C I=INT(DOY) +C ELSE +C I=INT(DOY)+1 +C ENDIF +C DO 24 L=1,20 +C TKSZ(I,J,L)=OUT(L+13)+4.0+273.15 +24 CONTINUE +C GO TO 23 +27 CONTINUE +C +C READ START AND END DATES, WEATHER OPTIONS +C + READ(4,'(2I2,I4)')IDATA(1),IDATA(2),IDATA(3) + READ(4,'(2I2,I4)')IDATA(4),IDATA(5),IDATA(6) + READ(4,'(2I2,I4)')IDATA(7),IDATA(8),IDATA(9) + READ(4,'(A3)')DATA(18) + READ(4,'(A3)')DATA(19) + READ(4,'(A3)')DATA(20) + DO 25 N=1,4 + READ(4,*)DRAD(N),DTMPX(N),DTMPN(N),DHUM(N),DPREC(N) + 2,DIRRI(N),DWIND(N),DCO2E(N),DCN4R(N),DCNOR(N) +25 CONTINUE + DO 26 N=5,12 + DRAD(N)=DRAD(N-1) + DTMPX(N)=DTMPX(N-1) + DTMPN(N)=DTMPN(N-1) + DHUM(N)=DHUM(N-1) + DPREC(N)=DPREC(N-1) + DIRRI(N)=DIRRI(N-1) + DWIND(N)=DWIND(N-1) + DCO2E(N)=DCO2E(N-1) + DCN4R(N)=DCN4R(N-1) + DCNOR(N)=DCNOR(N-1) +26 CONTINUE + READ(4,*)NPX,NPY,JOUT,IOUT,KOUT,ICLM + NTZX=NTZ + IF(IGO.EQ.0.OR.IDATA(3).NE.0)THEN + IDATA(3)=IDATA(3)+(NT-1)*NF+(NTX-1)*NFX-NTZX + IDATA(6)=IDATA(6)+(NT-1)*NF+(NTX-1)*NFX-NTZX + IYRC=IDATA(3) + ELSE + IF(IDATA(1).EQ.1.AND.IDATA(2).EQ.1)THEN + IDATA(3)=IYRC+1 + ELSE + IDATA(3)=IYRC + ENDIF + IDATA(6)=IDATA(3) + IYRC=IDATA(3) + ENDIF + IF(NE.EQ.1)THEN + N1=IDATA(3) + ENDIF + IF(NE.EQ.NA(NEX))THEN + N2=IDATA(6) + NF=N2-N1+1 + IF(IDATA(4).NE.31.OR.IDATA(5).NE.12)THEN + NTZ=NTZ+1 + ENDIF + ENDIF + IF(NE.EQ.1.AND.NT.EQ.1.AND.NEX.EQ.1)THEN + N1X=IDATA(3) + ENDIF + IF(NE.EQ.NA(NEX).AND.NT.EQ.ND(NEX).AND.NEX.EQ.NAX)THEN + N2X=IDATA(6) + NFX=N2X-N1X+1 + IF(NE.NE.NA(NEX))THEN + IF(IDATA(4).NE.31.OR.IDATA(5).NE.12)THEN + NTZ=NTZ+1 + ENDIF + ENDIF + ENDIF +C WRITE(*,7766)'IDATA3',IGO,IDATA(3),IDATA(6),IYRR,IYRC +C 2,NE,NT,NEX,NF,NTX,NFX,NTZ,NTZX,N1,N2,N1X,N2X +C 3,NA(NEX),ND(NEX),NAX +7766 FORMAT(A8,30I8) +C +C OPEN CHECKPOINT FILES FOR SOIL VARIABLES +C + IF(IGO.EQ.0)THEN + IF(DATA(20).EQ.'YES')THEN + IDATE=IDATA(9) + ELSE + IDATE=IDATA(3) + ENDIF + WRITE(CHARY,'(I4)')IDATE + OUTW='W'//DATA(1)(1:2)//CHARY(1:4) + OUTN='N'//DATA(1)(1:2)//CHARY(1:4) + OPEN(21,FILE=OUTW,STATUS='UNKNOWN') + OPEN(22,FILE=OUTN,STATUS='UNKNOWN') + ENDIF +C +C CALCULATE START AND FINISH DATES +C + LPY=0 + LYRC=365 + LYRX=365 + DO 575 N=1,7,3 + IF(MOD(IDATA(N+2),4))520,510,520 +510 IF(IDATA(N+1).GT.2)LPY=1 + IF(N.EQ.1)LYRC=366 +520 IF(IDATA(N+1).EQ.1)GO TO 525 + IDY=30*(IDATA(N+1)-1)+ICOR(IDATA(N+1)-1)+IDATA(N)+LPY + GO TO 527 +525 IDY=IDATA(N) +527 IF(N.EQ.1)ISTART=IDY + IF(N.EQ.4)IFIN=IDY + IF(N.EQ.7)IRUN=IDY + IF(MOD(IDATA(N+2)-1,4))575,530,575 +530 IF(N.EQ.1)LYRX=366 +575 CONTINUE + IF(IGO.EQ.0)THEN + IF(DATA(20).EQ.'NO')IRUN=ISTART + L=1 + ILAST=ISTART-1 + ITERM=IFIN + ELSE + L=2 + ILAST=MIN(ISTART-1,ITERM,IEND) + ITERM=IFIN + ENDIF +C +C READ WEATHER DATA +C + IF(DATAC(3,NE,NEX).NE.'NO')THEN + IFLG3=0 + READ(3,'(2A1,2I2,50A1)')TTYPE,CTYPE,NI,NN,(IVAR(K),K=1,NI) + 2,(VAR(K),K=1,NN) + READ(3,'(50A1)')(TYP(K),K=1,NN) + READ(3,*)Z0G,IFLGW,ZNOONG + READ(3,*)PHRG,CN4RIG,CNORIG,CPORG,CALRG,CFERG,CCARG,CMGRG,CNARG + 2,CKARG,CSORG,CCLRG + DO 55 K=1,NN + DATK(K)=0.0 +55 CONTINUE + IH=1 +60 READ(3,*,END=110)(IDAT(K),K=1,NI),(DAT(K),K=1,NN) +C WRITE(*,61)(IDAT(K),K=1,NI),(DAT(K),K=1,NN) +61 FORMAT(3I6,50E12.4) +C +C READ DAILY WEATHER DATA AND CONVERT TO MODEL UNITS +C + IF(TTYPE.EQ.'D')THEN + IWTHR(L)=1 + DO 160 K=1,NI + IF(IVAR(K).EQ.'M')THEN + M=IDAT(K) + ELSEIF(IVAR(K).EQ.'D')THEN + N=IDAT(K) + ENDIF + IF(IVAR(K).EQ.'Y')THEN + IFLGY=1 + IYRX=IDAT(K)+(NTX-1)*NFX + IF(MOD(IDAT(K),4))170,175,170 +175 IYRD=366 +170 IYRD=365 + ENDIF +160 CONTINUE + IF(IFLGY.EQ.1.AND.IYRX.LT.IYRC)GO TO 60 + IF(CTYPE.EQ.'J')THEN + I=N + ELSE + LPY=0 + IF(MOD(IDATA(3),4))70,75,70 +75 IF(M.GT.2)LPY=1 +70 IF(M.EQ.1)THEN + I=N + ELSE + I=30*(M-1)+ICOR(M-1)+N+LPY + ENDIF + ENDIF + IF(IFLG3.EQ.0)THEN + IBEGIN=I + ISTART=MAX(ISTART,IBEGIN) + IFLG3=1 + ENDIF + IF(L.NE.1)THEN + IF(I.LE.ILAST)GO TO 60 + ENDIF + DO 65 K=1,NN + IF(VAR(K).EQ.'M')THEN + IF(TYP(K).EQ.'F')THEN + TMPX(I)=(DAT(K)-32.0)*0.556 + ELSEIF(TYP(K).EQ.'K')THEN + TMPX(I)=DAT(K)-273.16 + ELSE + TMPX(I)=DAT(K) + ENDIF + ELSEIF(VAR(K).EQ.'N')THEN + IF(TYP(K).EQ.'F')THEN + TMPN(I)=(DAT(K)-32.0)*0.556 + ELSEIF(TYP(K).EQ.'K')THEN + TMPN(I)=DAT(K)-273.16 + ELSE + TMPN(I)=DAT(K) + ENDIF + ELSEIF(VAR(K).EQ.'R')THEN + IF(TYP(K).EQ.'L')THEN + SRAD(I)=AMAX1(0.0,DAT(K)/23.87) + ELSEIF(TYP(K).EQ.'J')THEN + SRAD(I)=AMAX1(0.0,DAT(K)*0.01) + ELSE + SRAD(I)=AMAX1(0.0,DAT(K)) + ENDIF + ELSEIF(VAR(K).EQ.'W')THEN + IF(TYP(K).EQ.'S')THEN + WIND(I)=ABS(DAT(K))*3600.0 + ELSEIF(TYP(K).EQ.'H')THEN + WIND(I)=ABS(DAT(K))*1000.0 + ELSEIF(TYP(K).EQ.'D')THEN + WIND(I)=ABS(DAT(K))*1000.0/24.0 + ELSEIF(TYP(K).EQ.'M')THEN + WIND(I)=ABS(DAT(K))*1600.0 + ELSE + WIND(I)=ABS(DAT(K)) + ENDIF + ELSEIF(VAR(K).EQ.'H')THEN + IF(TYP(K).EQ.'D')THEN + DWPT(1,I)=0.61*EXP(5360.0*(3.661E-03-1.0 + 2/(273.15+DAT(K)))) + DWPT(2,I)=0.61*EXP(5360.0*(3.661E-03-1.0 + 2/(273.15+DAT(K)))) + ELSEIF(TYP(K).EQ.'F')THEN + DAT(K)=(DAT(K)-32.0)*0.556 + DWPT(1,I)=0.61*EXP(5360.0*(3.661E-03-1.0 + 2/(273.15+DAT(K)))) + DWPT(2,I)=0.61*EXP(5360.0*(3.661E-03-1.0 + 2/(273.15+DAT(K)))) + ELSEIF(TYP(K).EQ.'H')THEN + DAT(K)=AMAX1(0.0,AMIN1(1.0,DAT(K))) + DWPT(1,I)=0.61*EXP(5360.0*(3.661E-03-1.0 + 2/(273.15+(TMPN(I)+TMPX(I))/2)))*DAT(K) + DWPT(2,I)=0.61*EXP(5360.0*(3.661E-03-1.0 + 2/(273.15+TMPN(I)))) + ELSEIF(TYP(K).EQ.'R')THEN + DAT(K)=AMAX1(0.0,AMIN1(100.0,DAT(K))) + DWPT(1,I)=0.61*EXP(5360.0*(3.661E-03-1.0 + 2/(273.15+(TMPN(I)+TMPX(I))/2)))*DAT(K)*0.01 + DWPT(2,I)=0.61*EXP(5360.0*(3.661E-03-1.0 + 2/(273.15+TMPN(I)))) + ELSEIF(TYP(K).EQ.'S')THEN + DWPT(1,I)=AMAX1(0.0,DAT(K))*0.0289/18.0*101.325 + 2*EXP(-ALTIG/7272.0)*288.15/(273.15+(TMPN(I)+TMPX(I))/2) + DWPT(2,I)=AMAX1(0.0,DAT(K))*0.0289/18.0*101.325 + 2*EXP(-ALTIG/7272.0)*288.15/(273.15+TMPN(I)) + ELSEIF(TYP(K).EQ.'G')THEN + DWPT(1,I)=AMAX1(0.0,DAT(K))*28.9/18.0*101.325 + 2*EXP(-ALTIG/7272.0)*288.15/(273.15+(TMPN(I)+TMPX(I))/2) + DWPT(2,I)=AMAX1(0.0,DAT(K))*28.9/18.0*101.325 + 2*EXP(-ALTIG/7272.0)*288.15/(273.15+TMPN(I)) + ELSEIF(TYP(K).EQ.'M')THEN + DWPT(1,I)=AMAX1(0.0,DAT(K)*0.1) + DWPT(2,I)=AMAX1(0.0,DAT(K)*0.1) + ELSE + DWPT(1,I)=AMAX1(0.0,DAT(K)) + DWPT(2,I)=AMAX1(0.0,DAT(K)) + ENDIF + ELSEIF(VAR(K).EQ.'P')THEN + IF(TYP(K).EQ.'M')THEN + RAIN(I)=AMAX1(0.0,DAT(K))/1.0E+03 + ELSEIF(TYP(K).EQ.'C')THEN + RAIN(I)=AMAX1(0.0,DAT(K))/1.0E+02 + ELSEIF(TYP(K).EQ.'I')THEN + RAIN(I)=AMAX1(0.0,DAT(K))*0.0254 + ELSE + RAIN(I)=AMAX1(0.0,DAT(K)) + ENDIF + ENDIF +65 CONTINUE + IX=I + IF(IFLGY.EQ.1.AND.I.EQ.IYRD)THEN + GO TO 110 + ENDIF + GO TO 60 +C +C READ HOURLY WEATHER DATA AND CONVERT TO MODEL UNITS +C + ELSE + IWTHR(L)=2 + DO 190 K=1,NI + IF(IVAR(K).EQ.'M')THEN + M=IDAT(K) + ELSEIF(IVAR(K).EQ.'D')THEN + N=IDAT(K) + ELSEIF(IVAR(K).EQ.'H')THEN + J=IDAT(K) + ENDIF + IF(IVAR(K).EQ.'Y')THEN + IFLGY=1 + ENDIF +190 CONTINUE + IF(IFLGY.EQ.1.AND.IYRX.LT.IYRC)GO TO 60 + IF(CTYPE.EQ.'J')THEN + I=N + ELSE + LPY=0 + IF(MOD(IDATA(3),4))100,115,100 +115 IF(M.GT.2)LPY=1 +100 IF(M.EQ.1)THEN + I=N + ELSE + I=30*(M-1)+ICOR(M-1)+N+LPY + ENDIF + ENDIF + IF(J.GT.24.AND.(J/100)*100.NE.J)THEN + DO 80 K=1,NN + DATK(K)=DATK(K)+DAT(K) +80 CONTINUE + IH=IH+1 + GO TO 60 + ENDIF + IF(J.GT.24)J=INT(J/100) + IF(J.EQ.0)THEN + J=24 + I=I-1 + IF(I.LT.1)GO TO 60 + ENDIF + IF(IFLG3.EQ.0)THEN + IBEGIN=N + ISTART=MAX(ISTART,IBEGIN) + IFLG3=1 + ENDIF + IF(L.NE.1)THEN + IF(I.LE.ILAST)GO TO 60 + ENDIF + XWTHR(J,I)=0.0 + DO 95 K=1,NN + IF(VAR(K).EQ.'T')THEN + IF(TYP(K).EQ.'F')THEN + TMPH(J,I)=((DAT(K)+DATK(K))/IH-32.0)*0.556 + ELSEIF(TYP(K).EQ.'K')THEN + TMPH(J,I)=(DAT(K)+DATK(K))/IH-273.16 + ELSE + TMPH(J,I)=(DAT(K)+DATK(K))/IH + ENDIF + ELSEIF(VAR(K).EQ.'R')THEN + IF(TYP(K).EQ.'W')THEN + SRADH(J,I)=AMAX1(0.0,(DAT(K)+DATK(K))/IH*0.0036) + ELSEIF(TYP(K).EQ.'J')THEN + SRADH(J,I)=AMAX1(0.0,(DAT(K)+DATK(K))/IH*0.01) + ELSEIF(TYP(K).EQ.'K')THEN + SRADH(J,I)=AMAX1(0.0,(DAT(K)+DATK(K))/IH*0.001) + ELSEIF(TYP(K).EQ.'P')THEN + SRADH(J,I)=AMAX1(0.0,(DAT(K)+DATK(K))/IH*0.0036*0.457) +C ELSEIF(TYP(K).EQ.'M')THEN +C SRADH(J,I)=AMAX1(0.0,(DAT(K)+DATK(K))/IH*3.6*0.457) + ELSE + SRADH(J,I)=AMAX1(0.0,(DAT(K)+DATK(K))/IH) + ENDIF + ELSEIF(VAR(K).EQ.'W')THEN + IF(TYP(K).EQ.'S')THEN + WINDH(J,I)=(DAT(K)+DATK(K))/IH*3600.0 + ELSEIF(TYP(K).EQ.'H')THEN + WINDH(J,I)=(DAT(K)+DATK(K))/IH*1000.0 + ELSEIF(TYP(K).EQ.'M')THEN + WINDH(J,I)=(DAT(K)+DATK(K))/IH*1600.0 + ELSE + WINDH(J,I)=(DAT(K)+DATK(K))/IH + ENDIF + ELSEIF(VAR(K).EQ.'H')THEN + IF(TYP(K).EQ.'D')THEN + DWPTH(J,I)=0.61*EXP(5360.0*(3.661E-03-1.0/(273.15 + 2+(DAT(K)+DATK(K))/IH))) + ELSEIF(TYP(K).EQ.'F')THEN + DAT(K)=(DAT(K)-32.0)*0.556 + DWPTH(J,I)=0.61*EXP(5360.0*(3.661E-03-1.0/(273.15 + 2+(DAT(K)+DATK(K))/IH))) + ELSEIF(TYP(K).EQ.'H')THEN + DWPTH(J,I)=0.61*EXP(5360.0*(3.661E-03-1.0/(273.15+TMPH(J,I)))) + 2*AMAX1(0.0,AMIN1(1.0,(DAT(K)+DATK(K))/IH)) + ELSEIF(TYP(K).EQ.'R')THEN + DWPTH(J,I)=0.61*EXP(5360.0*(3.661E-03-1.0/(273.15+TMPH(J,I)))) + 2*AMAX1(0.0,AMIN1(100.0,(DAT(K)+DATK(K))/IH))*0.01 + ELSEIF(TYP(K).EQ.'S')THEN + DWPTH(J,I)=AMAX1(0.0,(DAT(K)+DATK(K))/IH)*0.0289/18.0*101.325 + 2*EXP(-ALTIG/7272.0)*288.15/(273.15+TMPH(J,I)) + ELSEIF(TYP(K).EQ.'G')THEN + DWPTH(J,I)=AMAX1(0.0,(DAT(K)+DATK(K))/IH)*28.9/18.0*101.325 + 2*EXP(-ALTIG/7272.0)*288.15/(273.15+TMPH(J,I)) + ELSEIF(TYP(K).EQ.'M')THEN + DWPTH(J,I)=AMAX1(0.0,(DAT(K)+DATK(K))/IH*0.1) + ELSE + DWPTH(J,I)=AMAX1(0.0,(DAT(K)+DATK(K))/IH) + ENDIF + ELSEIF(VAR(K).EQ.'P')THEN + IF(TYP(K).EQ.'M')THEN + RAINH(J,I)=AMAX1(0.0,DAT(K)+DATK(K))/1.0E+03 + ELSEIF(TYP(K).EQ.'C')THEN + RAINH(J,I)=AMAX1(0.0,DAT(K)+DATK(K))/1.0E+02 + ELSEIF(TYP(K).EQ.'I')THEN + RAINH(J,I)=AMAX1(0.0,DAT(K)+DATK(K))*0.0254 + ELSEIF(TYP(K).EQ.'S')THEN + IF(TTYPE.EQ.'H')THEN + RAINH(J,I)=AMAX1(0.0,DAT(K)+DATK(K))*3.6 + ELSE + RAINH(J,I)=AMAX1(0.0,DAT(K)+DATK(K))*1.8 + ENDIF + ELSE + RAINH(J,I)=AMAX1(0.0,DAT(K)+DATK(K)) + ENDIF + ELSEIF(VAR(K).EQ.'L')THEN + IF(TYP(K).EQ.'W')THEN + XWTHR(J,I)=AMAX1(0.0,(DAT(K)+DATK(K))/IH*0.0036) + ELSEIF(TYP(K).EQ.'J')THEN + XWTHR(J,I)=AMAX1(0.0,(DAT(K)+DATK(K))/IH*0.01) + ELSEIF(TYP(K).EQ.'K')THEN + XWTHR(J,I)=AMAX1(0.0,(DAT(K)+DATK(K))/IH*0.001) + ELSE + XWTHR(J,I)=AMAX1(0.0,(DAT(K)+DATK(K))/IH) + ENDIF + ENDIF + DATK(K)=0.0 +95 CONTINUE + IH=1 + IX=I + IF(TTYPE.EQ.'3')THEN + JJ=J-3 + II=I + IF(JJ.EQ.0)THEN + JJ=24 + II=I-1 + ENDIF + IF(II.LT.1)THEN + TMPH(J-2,I)=TMPH(J,I) + TMPH(J-1,I)=TMPH(J,I) + SRADH(J-2,I)=SRADH(J,I) + SRADH(J-1,I)=SRADH(J,I) + WINDH(J-2,I)=WINDH(J,I) + WINDH(J-1,I)=WINDH(J,I) + DWPTH(J-2,I)=DWPTH(J,I) + DWPTH(J-1,I)=DWPTH(J,I) + RAINH(J,I)=RAINH(J,I)/3.0 + RAINH(J-2,I)=RAINH(J,I) + RAINH(J-1,I)=RAINH(J,I) + XWTHR(J-2,I)=XWTHR(J,I) + XWTHR(J-1,I)=XWTHR(J,I) + ELSE + TMPH(J-2,I)=0.667*TMPH(JJ,II)+0.333*TMPH(J,I) + TMPH(J-1,I)=0.333*TMPH(JJ,II)+0.667*TMPH(J,I) + SRADH(J-2,I)=0.667*SRADH(JJ,II)+0.333*SRADH(J,I) + SRADH(J-1,I)=0.333*SRADH(JJ,II)+0.667*SRADH(J,I) + WINDH(J-2,I)=0.667*WINDH(JJ,II)+0.333*WINDH(J,I) + WINDH(J-1,I)=0.333*WINDH(JJ,II)+0.667*WINDH(J,I) + DWPTH(J-2,I)=0.667*DWPTH(JJ,II)+0.333*DWPTH(J,I) + DWPTH(J-1,I)=0.333*DWPTH(JJ,II)+0.667*DWPTH(J,I) + RAINH(J,I)=RAINH(J,I)/3.0 + RAINH(J-2,I)=RAINH(J,I) + RAINH(J-1,I)=RAINH(J,I) + XWTHR(J-2,I)=0.667*XWTHR(JJ,II)+0.333*XWTHR(J,I) + XWTHR(J-1,I)=0.333*XWTHR(JJ,II)+0.667*XWTHR(J,I) + ENDIF + ENDIF + IF(IFLGY.EQ.1.AND.I.EQ.IYRD.AND.J.EQ.24)THEN + GO TO 110 + ENDIF + GO TO 60 + ENDIF +110 CONTINUE +C +C ACCOUNT FOR LEAP YEAR +C + IF(I.EQ.365)THEN + IF(TTYPE.EQ.'D')THEN + TMPX(I+1)=TMPX(I) + TMPN(I+1)=TMPN(I) + SRAD(I+1)=SRAD(I) + WIND(I+1)=WIND(I) + DWPT(1,I+1)=DWPT(1,I) + DWPT(2,I+1)=DWPT(2,I) + RAIN(I+1)=RAIN(I) + ELSE + DO 130 J=1,24 + TMPH(J,I+1)=TMPH(J,I) + SRADH(J,I+1)=SRADH(J,I) + WINDH(J,I+1)=WINDH(J,I) + DWPTH(J,I+1)=DWPTH(J,I) + RAINH(J,I+1)=RAINH(J,I) + XWTHR(J,I+1)=XWTHR(J,I) +130 CONTINUE + ENDIF + IX=I+1 + ENDIF + ELSE + IFLGW=1 + Z0G=2.0 + ZNOONG=12.0 + PHRG=7.0 + CN4RIG=0.0 + CNORIG=0.0 + CN4RG=CN4RIG + CNORG=CNORIG + CPORG=0.0 + CALRG=0.0 + CFERG=0.0 + CCARG=0.0 + CMGRG=0.0 + CNARG=0.0 + CKARG=0.0 + CSORG=0.0 + CCLRG=0.0 + IX=365 + ENDIF +C +C CALCULATE PRECIPITATION COMPOSITION +C + CN4RIG=CN4RIG/14.0 + CNORIG=CNORIG/14.0 + CN4RG=CN4RIG + CNORG=CNORIG + CPORG=CPORG/31.0 + CALRG=CALRG/27.0 + CFERG=CFERG/55.8 + CCARG=CCARG/40.0 + CMGRG=CMGRG/24.3 + CNARG=CNARG/23.0 + CKARG=CKARG/39.1 + CSORG=CSORG/32.0 + CCLRG=CCLRG/35.5 + DO 8970 NX=NHW,NHE + DO 8975 NY=NVN,NVS + Z0(NY,NX)=Z0G + ZNOON(NY,NX)=ZNOONG + PHR(NY,NX)=PHRG + CN4RI(NY,NX)=CN4RIG + CNORI(NY,NX)=CNORIG + CN4R(NY,NX)=CN4RIG + CNOR(NY,NX)=CNORIG + CPOR(NY,NX)=CPORG + CALR(NY,NX)=CALRG + CFER(NY,NX)=CFERG + CCAR(NY,NX)=CCARG + CMGR(NY,NX)=CMGRG + CNAR(NY,NX)=CNARG + CKAR(NY,NX)=CKARG + CSOR(NY,NX)=CSORG + CCLR(NY,NX)=CCLRG +8975 CONTINUE +8970 CONTINUE + ICHECK=0 + IF(TTYPE.EQ.'H'.AND.J.NE.24)ICHECK=1 + IEND=IX-ICHECK + IFIN=MIN(IFIN,IEND) + IDAYR=MIN(ISTART-1,ILAST) + IYRR=IDATA(3) + NYR=0 + IF(IDAYR.EQ.0)THEN + IDAYR=LYRX + IYRR=IDATA(3)-1 + NYR=1 + ENDIF + IFLGY=0 + CLOSE(3) + CLOSE(4) +C +C READ LAND MANAGEMENT FILE NAMES FOR EACH GRID CELL +C + DO 9980 NX=NHW,NHE + DO 9985 NY=NVN,NVS + ROWN(NY,NX)=0.0 + ROWO(NY,NX)=0.0 + ROWP(NY,NX)=0.0 + DO 325 I=1,366 + ITILL(I,NY,NX)=0 + DCORP(I,NY,NX)=0.0 +325 CONTINUE + DO 40 I=1,366 + DO 45 N=1,20 + FERT(N,I,NY,NX)=0.0 +45 CONTINUE + DO 35 N=0,2 + IYTYP(N,I,NY,NX)=0 +35 CONTINUE + FDPTH(I,NY,NX)=0.0 +40 CONTINUE + DO 125 I=1,366 + DO 120 J=1,24 + RRIG(J,I,NY,NX)=0.0 +120 CONTINUE + PHQ(I,NY,NX)=0.0 + CN4Q(I,NY,NX)=0.0 + CNOQ(I,NY,NX)=0.0 + CPOQ(I,NY,NX)=0.0 + CALQ(I,NY,NX)=0.0 + CFEQ(I,NY,NX)=0.0 + CCAQ(I,NY,NX)=0.0 + CMGQ(I,NY,NX)=0.0 + CNAQ(I,NY,NX)=0.0 + CKAQ(I,NY,NX)=0.0 + CSOQ(I,NY,NX)=0.0 + CCLQ(I,NY,NX)=0.0 + WDPTH(I,NY,NX)=0.0 + ROWI(I,NY,NX)=0.0 +125 CONTINUE +9985 CONTINUE +9980 CONTINUE +C +C READ LAND MANAGEMENT FILE STORED +C IN FILE NAME DATA ARRAY LOADED IN 'MAIN'. +C THIS FILE CONTAINS NAMES OF TILLAGE, IRRIGATION +C AND FERTILIZER FILES +C + IF(DATAC(9,NE,NEX).NE.'NO')THEN +150 READ(13,*,END=200)NH1,NV1,NH2,NV2 + READ(13,*)DATA(8),DATA(5),DATA(6) + IF(DATA(8).NE.'NO')THEN + OPEN(10,FILE=TRIM(PREFIX)//DATA(8),STATUS='OLD') + ENDIF + IF(DATA(5).NE.'NO')THEN + OPEN(8,FILE=TRIM(PREFIX)//DATA(5),STATUS='OLD') + ENDIF + IF(DATA(6).NE.'NO')THEN + OPEN(2,FILE=TRIM(PREFIX)//DATA(6),STATUS='OLD') + ENDIF +C +C READ TILLAGE INPUT FILE +C + IF(DATA(8).NE.'NO')THEN +295 CONTINUE + READ(10,*,END=305)DY,IPLOW,DPLOW + LPY=0 + IDY1=INT(DY/1.0E+06) + IDY2=INT(DY/1.0E+04-IDY1*1.0E+02) + IDY3=INT(DY-(IDY1*1.0E+06+IDY2*1.0E+04)) + IF(MOD(IDY3,4))3520,3510,3520 +3510 IF(IDY2.GT.2)LPY=1 +3520 IF(IDY2.EQ.1)GO TO 3535 + IDY=30*(IDY2-1)+ICOR(IDY2-1)+IDY1+LPY +C IF(IDY2.LE.6)IDY=IDY-0.5*(NTX-1) +C IF(IDY2.GE.7)IDY=IDY+0.5*(NTX-1) + GO TO 3530 +3535 IDY=IDY1 +3530 CONTINUE + DO 8995 NX=NH1,NH2 + DO 8990 NY=NV1,NV2 + ITILL(IDY,NY,NX)=IPLOW + DCORP(IDY,NY,NX)=DPLOW +8990 CONTINUE +8995 CONTINUE + GO TO 295 +305 CONTINUE + CLOSE(10) + ENDIF +C +C READ FERTLIZER INPUT FILE +C + IF(DATA(5).NE.'NO')THEN +1500 CONTINUE + READ(8,*,END=85)DY,Z4A,Z3A,ZUA,ZOA,Z4B,Z3B,ZUB,ZOB + 2,PMA,PMB,PHA,CAC,CAS,RSC1,RSN1,RSP1,RSC2,RSN2,RSP2,FDPTHI + 3,ROWX,IR0,IR1,IR2 + LPY=0 + IDY1=INT(DY/1.0E+06) + IDY2=INT(DY/1.0E+04-IDY1*1.0E+02) + IDY3=INT(DY-(IDY1*1.0E+06+IDY2*1.0E+04)) + IF(MOD(IDY3,4))1520,1510,1520 +1510 IF(IDY2.GT.2)LPY=1 +1520 IF(IDY2.EQ.1)GO TO 1525 + IDY=30*(IDY2-1)+ICOR(IDY2-1)+IDY1+LPY +C IF(IDY2.LE.6)IDY=IDY-0.5*(NTX-1) +C IF(IDY2.GE.7)IDY=IDY+0.5*(NTX-1) + GO TO 1530 +1525 IDY=IDY1 +1530 CONTINUE + DO 8985 NX=NH1,NH2 + DO 8980 NY=NV1,NV2 +C +C NH4,NH3,UREA,NO3 BROADCAST (A) AND BANDED (B) +C + FERT(1,IDY,NY,NX)=Z4A + FERT(2,IDY,NY,NX)=Z3A + FERT(3,IDY,NY,NX)=ZUA + FERT(4,IDY,NY,NX)=ZOA + FERT(5,IDY,NY,NX)=Z4B + FERT(6,IDY,NY,NX)=Z3B + FERT(7,IDY,NY,NX)=ZUB + FERT(8,IDY,NY,NX)=ZOB +C +C MONOCALCIUM PHOSPHATE OR HYDROXYAPATITE BROADCAST (A) +C AND BANDED (B) +C + FERT(9,IDY,NY,NX)=PMA + FERT(10,IDY,NY,NX)=PMB + FERT(11,IDY,NY,NX)=PHA +C +C LIME AND GYPSUM +C + FERT(12,IDY,NY,NX)=CAC + FERT(13,IDY,NY,NX)=CAS +C +C PLANT AND ANIMAL RESIDUE C, N AND P +C + FERT(14,IDY,NY,NX)=RSC1 + FERT(15,IDY,NY,NX)=RSN1 + FERT(16,IDY,NY,NX)=RSP1 + FERT(17,IDY,NY,NX)=RSC2 + FERT(18,IDY,NY,NX)=RSN2 + FERT(19,IDY,NY,NX)=RSP2 +C +C DEPTH OF APPLICATION +C + FDPTH(IDY,NY,NX)=FDPTHI + ROWI(IDY,NY,NX)=ROWX +C +C TYPE OF PLANT OR ANIMAL RESIDUE +C + IYTYP(0,IDY,NY,NX)=IR0 + IYTYP(1,IDY,NY,NX)=IR1 + IYTYP(2,IDY,NY,NX)=IR2 +8980 CONTINUE +8985 CONTINUE + GO TO 1500 +85 CONTINUE + CLOSE(8) + ENDIF +C +C READ IRRIGATION INPUT FILE +C + IF(DATA(6).NE.'NO')THEN + IF(DATA(6)(1:4).EQ.'auto')THEN + READ(2,*,END=105)DST,DEN,FIRRX,CIRRX,DIRRX,WDPTHI,PHQX,CN4QX,CNOQX + 2,CPOQX,CALQX,CFEQX,CCAQX,CMGQX,CNAQX,CKAQX,CSOQX,CCLQX + LPY=0 + IDY1=INT(DST/1.0E+06) + IDY2=INT(DST/1.0E+04-IDY1*1.0E+02) + IDY3=INT(DST-(IDY1*1.0E+06+IDY2*1.0E+04)) + IF(MOD(IDY3,4))4520,4510,4520 +4510 IF(IDY2.GT.2)LPY=1 +4520 IF(IDY2.EQ.1)GO TO 4535 + IDYS=30*(IDY2-1)+ICOR(IDY2-1)+IDY1+LPY + GO TO 4530 +4535 IDYS=IDY1 +4530 CONTINUE + IHRS=IDY3 + LPY=0 + IDY1=INT(DEN/1.0E+06) + IDY2=INT(DEN/1.0E+04-IDY1*1.0E+02) + IDY3=INT(DEN-(IDY1*1.0E+06+IDY2*1.0E+04)) + IF(MOD(IDY3,4))5520,5510,5520 +5510 IF(IDY2.GT.2)LPY=1 +5520 IF(IDY2.EQ.1)GO TO 5535 + IDYE=30*(IDY2-1)+ICOR(IDY2-1)+IDY1+LPY + GO TO 5530 +5535 IDYE=IDY1 +5530 CONTINUE + IHRE=IDY3 + DO 7965 NX=NH1,NH2 + DO 7960 NY=NV1,NV2 + IIRRA(1,NY,NX)=IDYS + IIRRA(2,NY,NX)=IDYE + IIRRA(3,NY,NX)=IHRS + IIRRA(4,NY,NX)=IHRE + FIRRA(NY,NX)=FIRRX + CIRRA(NY,NX)=CIRRX + DIRRA(1,NY,NX)=DIRRX + DIRRA(2,NY,NX)=WDPTHI + DO 220 I=1,366 + PHQ(IDY,NY,NX)=PHQX + CN4Q(IDY,NY,NX)=CN4QX/14.0 + CNOQ(IDY,NY,NX)=CNOQX/14.0 + CPOQ(IDY,NY,NX)=CPOQX/31.0 + CALQ(IDY,NY,NX)=CALQX/27.0 + CFEQ(IDY,NY,NX)=CFEQX/55.8 + CCAQ(IDY,NY,NX)=CCAQX/40.0 + CMGQ(IDY,NY,NX)=CMGQX/24.3 + CNAQ(IDY,NY,NX)=CNAQX/23.0 + CKAQ(IDY,NY,NX)=CKAQX/39.1 + CSOQ(IDY,NY,NX)=CSOQX/32.0 + CCLQ(IDY,NY,NX)=CCLQX/35.5 +220 CONTINUE +7960 CONTINUE +7965 CONTINUE + ELSE +2500 CONTINUE + READ(2,*,END=105)DY,RR,JST,JEN,WDPTHI,PHQX,CN4QX,CNOQX,CPOQX + 2,CALQX,CFEQX,CCAQX,CMGQX,CNAQX,CKAQX,CSOQX,CCLQX + LPY=0 + IDY1=INT(DY/1.0E+06) + IDY2=INT(DY/1.0E+04-IDY1*1.0E+02) + IDY3=INT(DY-(IDY1*1.0E+06+IDY2*1.0E+04)) + IF(MOD(IDY3,4))2520,2510,2520 +2510 IF(IDY2.GT.2)LPY=1 +2520 IF(IDY2.EQ.1)GO TO 2525 + IDY=30*(IDY2-1)+ICOR(IDY2-1)+IDY1+LPY + GO TO 2530 +2525 IDY=IDY1 +2530 CONTINUE + RRH=RR/(JEN-(JST-1)) + DO 8965 NX=NH1,NH2 + DO 8960 NY=NV1,NV2 + DO 2535 J=1,24 + IF(J.GE.JST.AND.J.LE.JEN)RRIG(J,IDY,NY,NX)=RRH/1000.0 +2535 CONTINUE + PHQ(IDY,NY,NX)=PHQX + CN4Q(IDY,NY,NX)=CN4QX/14.0 + CNOQ(IDY,NY,NX)=CNOQX/14.0 + CPOQ(IDY,NY,NX)=CPOQX/31.0 + CALQ(IDY,NY,NX)=CALQX/27.0 + CFEQ(IDY,NY,NX)=CFEQX/55.8 + CCAQ(IDY,NY,NX)=CCAQX/40.0 + CMGQ(IDY,NY,NX)=CMGQX/24.3 + CNAQ(IDY,NY,NX)=CNAQX/23.0 + CKAQ(IDY,NY,NX)=CKAQX/39.1 + CSOQ(IDY,NY,NX)=CSOQX/32.0 + CCLQ(IDY,NY,NX)=CCLQX/35.5 + WDPTH(IDY,NY,NX)=WDPTHI +8960 CONTINUE +8965 CONTINUE + GO TO 2500 + ENDIF +105 CONTINUE + ENDIF + CLOSE(2) + GO TO 150 +200 CONTINUE + CLOSE(13) + ENDIF + IMNG=1 + RETURN + END + diff --git a/f77src/redist.f b/f77src/redist.f index a059bd6..a2b6e54 100755 --- a/f77src/redist.f +++ b/f77src/redist.f @@ -1196,8 +1196,20 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) LG=0 LX=0 DO 8575 L=NU(NY,NX),NL(NY,NX) - IF(THETP(L,NY,NX).LT.THETX)LX=1 + VCO2G2=CO2G(L,NY,NX)/12.0 + VCH4G2=CH4G(L,NY,NX)/12.0 + VOXYG2=OXYG(L,NY,NX)/32.0 + VZ2GG2=Z2GG(L,NY,NX)/28.0 + VZ2OG2=Z2OG(L,NY,NX)/28.0 + VNH3G2=ZNH3G(L,NY,NX)/14.0 + VH2GG2=H2GG(L,NY,NX)/2.0 + VTATM=AMAX1(0.0,1.2194E+04*VOLP(L,NY,NX)/TKS(L,NY,NX)) + VTGAS=VCO2G2+VCH4G2+VOXYG2+VZ2GG2+VZ2OG2+VNH3G2+VH2GG2 + IF(THETP(L,NY,NX).LT.THETX.OR.VTGAS.GT.VTATM)LX=1 IF(THETP(L,NY,NX).GE.THETX.AND.LX.EQ.0)LG=L +C WRITE(*,5431)'LG',I,J,NX,NY,L,LG,LX,THETP(L,NY,NX),THETX +C 2,VOLP(L,NY,NX),TKS(L,NY,NX),VTGAS,VTATM +5431 FORMAT(A8,7I4,12E12.4) TTHAW(L,NY,NX)=0.0 TTHAWH(L,NY,NX)=0.0 THTHAW(L,NY,NX)=0.0 @@ -2012,7 +2024,7 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) H2GIN=H2GIN+HI HO=RH2GO(0,NY,NX) H2GOU=H2GOU+HO -C IF(NX.EQ.2.AND.NY.EQ.1)THEN +C IF(J.EQ.14)THEN C WRITE(*,6646)'UOXYG',I,J,NX,NY,UCO2G(NY,NX),UOXYG(NY,NX),CI,OI C 2,XCODFS(NY,NX),XCOFLG(3,NU(NY,NX),NY,NX),TCO2Z(NY,NX) C 2,(FLQGQ(NY,NX)+FLQRQ(NY,NX))*CCOR(NY,NX) @@ -2021,8 +2033,9 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) C 5,XOXDFS(NY,NX),XOXFLG(3,NU(NY,NX),NY,NX),TOXYZ(NY,NX) C 2,(FLQGQ(NY,NX)+FLQRQ(NY,NX))*COXR(NY,NX) C 3,(FLQGI(NY,NX)+FLQRI(NY,NX))*COXQ(NY,NX) -C 4,XOXDFG(0,NY,NX)+XOXDFR(NY,NX) -C 5,(TLCO2P(L,NY,NX),L=1,10),(TLOXYP(L,NY,NX),L=1,10) +C 4,XOXDFG(0,NY,NX),XOXDFR(NY,NX) +C 5,(TLCO2P(L,NY,NX),L=1,10) +C 6,(TLOXYP(L,NY,NX),L=1,10) 6646 FORMAT(A8,4I4,60E12.4) C ENDIF C @@ -2252,7 +2265,7 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) C C SURFACE LITTER OUTPUTS C -C IF(NX.EQ.1.AND.NY.EQ.6)THEN +C IF(J.EQ.14)THEN C WRITE(*,1119)'CO2S0',I,J,NX,NY,CO2S(0,NY,NX),XCODFS(NY,NX) C 2,XCODFR(NY,NX),XCOFLS(3,0,NY,NX),XCODFG(0,NY,NX),RCO2O(0,NY,NX) C 3,ORGC(0,NY,NX) @@ -2623,7 +2636,7 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) Z4X=14.0*XN4(0,NY,NX) Z4F=14.0*(ZNH4FA(0,NY,NX)+ZNHUFA(0,NY,NX)+ZNH3FA(0,NY,NX)) TLNH4=TLNH4+Z4S+Z4X+Z4F - UNH4(NY,NX)=UNH4(NY,NX)+Z4S+Z4X+Z4F + UNH4(NY,NX)=UNH4(NY,NX)+Z4S+Z4X ZOS=ZNO3S(0,NY,NX)+ZNO2S(0,NY,NX) ZOF=14.0*ZNO3FA(0,NY,NX) TLNO3=TLNO3+ZOS+ZOF @@ -2782,7 +2795,7 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 3379 FORMAT(A8,6I4,12E12.4) C ENDIF C -C ARTIFICIAL SOIL WARMING +C END ARTIFICIAL SOIL WARMING C TKS(L,NY,NX)=(ENGY+THFLW(L,NY,NX)+THTHAW(L,NY,NX)+TUPHT(L,NY,NX) 2+HWFLU(L,NY,NX))/VHCP(L,NY,NX) @@ -2793,7 +2806,7 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) C IF(J.EQ.15)THEN C WRITE(*,6547)'VOLW',I,J,NX,NY,L,VOLW(L,NY,NX),VOLW1 C 2,TFLW(L,NY,NX),FINH(L,NY,NX),TTHAW(L,NY,NX),TUPWTR(L,NY,NX) -C 3,FLU(L,NY,NX),TQR(NY,NX) +C 3,FLU(L,NY,NX),TQR(NY,NX),VOLI(L,NY,NX),TTHAW(L,NY,NX),DENSI C 4,PSISM(L,NY,NX),VOLI(L,NY,NX),VOLP(L,NY,NX),VOLA(L,NY,NX) C WRITE(*,6547)'VOLWH',I,J,NX,NY,L,VOLWH(L,NY,NX),TFLWH(L,NY,NX) C 2,FINH(L,NY,NX),TTHAWH(L,NY,NX),VOLIH(L,NY,NX),VOLAH(L,NY,NX) @@ -2841,11 +2854,11 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 2-XOPFXS(K,L,NY,NX) OQAH(K,L,NY,NX)=OQAH(K,L,NY,NX)+TOAFHS(K,L,NY,NX) 2-XOAFXS(K,L,NY,NX) -C IF(NX.EQ.1.AND.NY.EQ.6)THEN +C IF(L.LE.4)THEN C WRITE(*,2627)'OQC',I,J,NX,NY,L,K,OQC(K,L,NY,NX),OQCH(K,L,NY,NX) C 2,TOCFLS(K,L,NY,NX),XOCFXS(K,L,NY,NX) C 3,OQN(K,L,NY,NX),TONFLS(K,L,NY,NX),XONFXS(K,L,NY,NX) -C 4,TOCFHS(K,L,NY,NX),XOCFXS(K,L,NY,NX) +C 4,TOCFHS(K,L,NY,NX) C 4,OQNH(K,L,NY,NX),TONFHS(K,L,NY,NX),XONFXS(K,L,NY,NX) C 5,OQAH(K,L,NY,NX),TOAFHS(K,L,NY,NX),XOAFXS(K,L,NY,NX) 2627 FORMAT(A8,6I4,20E12.4) @@ -2873,16 +2886,16 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) OXYS(L,NY,NX)=OXYS(L,NY,NX)+TOXFLS(L,NY,NX)+XOXDFG(L,NY,NX) 2-RUPOXO(L,NY,NX)-TUPOXS(L,NY,NX)+ROXFLU(L,NY,NX) 3+XOXFXS(L,NY,NX)+XOXBBL(L,NY,NX) -C IF(NX.EQ.3.AND.NY.EQ.4)THEN -C WRITE(*,5432)'CO2S',I,J,NX,NY,L,CO2S(L,NY,NX),TCOFLS(L,NY,NX) +C IF(J.EQ.14)THEN +C WRITE(*,5432)'CO2SL',I,J,NX,NY,L,CO2S(L,NY,NX),TCOFLS(L,NY,NX) C 2,XCODFG(L,NY,NX),RCO2O(L,NY,NX),TCO2S(L,NY,NX) C 3,RCOFLU(L,NY,NX),XCOFXS(L,NY,NX),TRCO2(L,NY,NX) C 4,XCOBBL(L,NY,NX),CO2G(L,NY,NX) -C WRITE(*,5432)'CH4S',I,J,NX,NY,L,CH4S(L,NY,NX),TCHFLS(L,NY,NX) +C WRITE(*,5432)'CH4SL',I,J,NX,NY,L,CH4S(L,NY,NX),TCHFLS(L,NY,NX) C 2,XCHDFG(L,NY,NX),RCH4O(L,NY,NX),TUPCHS(L,NY,NX) C 3,RCHFLU(L,NY,NX),XCHFXS(L,NY,NX),XCHBBL(L,NY,NX) C 4,XCOBBL(L,NY,NX),XCHFLS(3,L,NY,NX),XCHFLS(3,L+1,NY,NX) -C WRITE(*,5432)'OXYS',I,J,NX,NY,L,OXYS(L,NY,NX),TOXFLS(L,NY,NX) +C WRITE(*,5432)'OXYSL',I,J,NX,NY,L,OXYS(L,NY,NX),TOXFLS(L,NY,NX) C 2,XOXDFG(L,NY,NX),RUPOXO(L,NY,NX),TUPOXS(L,NY,NX) C 3,ROXFLU(L,NY,NX),XOXFXS(L,NY,NX),XOXBBL(L,NY,NX),COXYS(L,NY,NX) C 4,XOXFLS(3,L,NY,NX),XOXFLS(3,L+1,NY,NX),XOXDFS(NY,NX) @@ -2911,10 +2924,10 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 2+TRN4S(L,NY,NX)-TUPNH4(L,NY,NX)+RN4FLU(L,NY,NX) 3+XN4FXW(L,NY,NX) C IF(L.EQ.1)THEN -C WRITE(20,4443)'H2GS',I,J,NX,NY,L,H2GS(L,NY,NX),THGFLS(L,NY,NX) +C WRITE(*,4443)'H2GS',I,J,NX,NY,L,H2GS(L,NY,NX),THGFLS(L,NY,NX) C 2,XHGDFG(L,NY,NX),RH2GO(L,NY,NX),TUPHGS(L,NY,NX),RHGFLU(L,NY,NX) C 3,XHGFXS(L,NY,NX),XHGBBL(L,NY,NX),XHGDFS(NY,NX) -C WRITE(20,4444)'NH3',I,J,NX,NY,L,ZNH3S(L,NY,NX),TN3FLS(L,NY,NX) +C WRITE(*,4444)'NH3',I,J,NX,NY,L,ZNH3S(L,NY,NX),TN3FLS(L,NY,NX) C 2,XN3DFG(L,NY,NX),TRN3S(L,NY,NX),TUPN3S(L,NY,NX) C 3,RN3FLU(L,NY,NX),XN3FXW(L,NY,NX),XN3BBL(L,NY,NX),XN3DFS(NY,NX) C 4,ZNH4S(L,NY,NX) @@ -3059,13 +3072,13 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 2+XOXBBL(L,NY,NX) RCH4L(L,NY,NX)=TCHFLS(L,NY,NX)+RCHFLU(L,NY,NX)+XCHFXS(L,NY,NX) 2+XCHBBL(L,NY,NX) -C IF(NX.EQ.1.AND.NY.EQ.6)THEN -C WRITE(*,5432)'CO2G',I,J,NX,NY,L,CO2G(L,NY,NX),TCOFLG(L,NY,NX) +C IF(J.EQ.14)THEN +C WRITE(*,5432)'CO2GL',I,J,NX,NY,L,CO2G(L,NY,NX),TCOFLG(L,NY,NX) C 2,XCODFG(L,NY,NX),THETP(L,NY,NX) -C WRITE(*,5432)'OXYG',I,J,NX,NY,L,OXYG(L,NY,NX),TOXFLG(L,NY,NX) +C WRITE(*,5432)'OXYGL',I,J,NX,NY,L,OXYG(L,NY,NX),TOXFLG(L,NY,NX) C 2,XOXDFG(L,NY,NX),COXYG(L,NY,NX),XOXFLG(3,L,NY,NX) C 3,XOXFLG(3,L+1,NY,NX) -C WRITE(*,5432)'CH4G',I,J,NX,NY,L,CH4G(L,NY,NX),TCHFLG(L,NY,NX) +C WRITE(*,5432)'CH4GL',I,J,NX,NY,L,CH4G(L,NY,NX),TCHFLG(L,NY,NX) C 2,XCHDFG(L,NY,NX),CCH4G(L,NY,NX),XCHFLG(3,L,NY,NX) C 3,XCHFLG(3,L+1,NY,NX),XCHDFS(NY,NX),RCH4F(L,NY,NX) C 4,RCH4L(L,NY,NX),TCHFLS(L,NY,NX),RCHFLU(L,NY,NX) @@ -3087,6 +3100,7 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) C GRID CELL BOUNDARY FLUXES BUBBLING C IF(LG.EQ.0)THEN + LL=0 CIB=CIB+XCOBBL(L,NY,NX) CHB=CHB+XCHBBL(L,NY,NX) OIB=OIB+XOXBBL(L,NY,NX) @@ -3139,10 +3153,11 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) HNH3G(NY,NX)=HNH3G(NY,NX)+ZHB UH2GG(NY,NX)=UH2GG(NY,NX)+HGB C IF(NX.EQ.3.AND.NY.EQ.4)THEN -C WRITE(*,6645)'PLT',I,J,NX,NY,L,LG,LL,HCH4G(NY,NX),CH +C WRITE(*,6645)'PLT',I,J,NX,NY,L,LG,LL +C 2,HCH4G(NY,NX),CH C 2,TCHFLA(L,NY,NX),XCHBBL(L,NY,NX),HOXYG(NY,NX),OI C 3,XOXBBL(L,NY,NX),TUPOXP(L,NY,NX),TUPOXS(L,NY,NX) -C 4,TOXFLA(L,NY,NX) +C 4,TOXFLA(L,NY,NX),OXYG(L,NY,NX) C 4,HCO2G(NY,NX),CI,TCOFLA(L,NY,NX),XCOBBL(L,NY,NX) C 2,UN2GG(NY,NX),ZGI,XNGBBL(L,NY,NX) C 5,TN2FLA(L,NY,NX),TNHFLA(L,NY,NX),THGFLA(L,NY,NX) @@ -3332,13 +3347,17 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) ORGC(L,NY,NX)=RC+OC ORGN(L,NY,NX)=RN+ON ORGR(L,NY,NX)=RC -C IF(L.EQ.1)THEN +C IF(I.EQ.365.AND.J.EQ.24)THEN C DO 4344 K=0,4 C WRITE(*,4343)'ORGC',I,J,NX,NY,L,K,ORGC(L,NY,NX),RC,OC C 2,((OMC(M,N,K,L,NY,NX),M=1,3),N=1,7) C 3,(ORC(M,K,L,NY,NX),M=1,2),(OSC(M,K,L,NY,NX),M=1,4) C 4,OQC(K,L,NY,NX),OQCH(K,L,NY,NX),OHC(K,L,NY,NX) C 2,OQA(K,L,NY,NX),OQAH(K,L,NY,NX),OHA(K,L,NY,NX) +C WRITE(*,4343)'ORGN',I,J,NX,NY,L,K,ORGN(L,NY,NX),RN,ON +C 2,((OMN(M,N,K,L,NY,NX),M=1,3),N=1,7) +C 3,(ORN(M,K,L,NY,NX),M=1,2),(OSN(M,K,L,NY,NX),M=1,4) +C 4,OQN(K,L,NY,NX),OQNH(K,L,NY,NX),OHN(K,L,NY,NX) 4343 FORMAT(A8,6I4,60E12.4) 4344 CONTINUE C ENDIF @@ -4898,11 +4917,6 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) TZNH3G=0.0 TH2GG=0.0 TH2GS=0.0 - ZNHUXI=0.0 - ZNHUX0=0.0 - ZNFNXI=0.0 - ZNFNXG=1.0 - ZNFNX0=0.0 DO 3990 K=0,5 DO 3990 N=1,7 DO 3990 M=1,3 @@ -4931,6 +4945,11 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) TOSP(M,K)=0.0 3970 CONTINUE 3980 CONTINUE + TZNFN2=0.0 + TZNFNI=0.0 + ZNHUX0=0.0 + ZNHUXI=0.0 + ZNFNX0=0.0 C C ACCUMULATE STATE VARIABLES IN SURFACE RESIDUE FOR ADDITION C TO SOIL IN TILLAGE MIXING ZONE @@ -5038,6 +5057,7 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) TNH3FG=ZNH3FA(0,NY,NX)*CORP TNHUFG=ZNHUFA(0,NY,NX)*CORP TNO3FG=ZNO3FA(0,NY,NX)*CORP + TZNFNG=ZNFNI(0,NY,NX)*CORP TVOLWR=VOLW(0,NY,NX)*CORP TVOLIR=VOLI(0,NY,NX)*CORP HFLXD=2.496E-06*ORGC(0,NY,NX)*CORP*TKS(0,NY,NX) @@ -5079,10 +5099,8 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) VHCPR(NY,NX)=VHCPR(NY,NX)*XCORP(NY,NX) VOLR(NY,NX)=VOLR(NY,NX)*XCORP(NY,NX) VOLT(0,NY,NX)=VOLT(0,NY,NX)*XCORP(NY,NX) - ZNHUXI=AMAX1(ZNHUXI,ZNHUI(0,NY,NX)) ZNHUX0=AMAX1(ZNHUX0,ZNHU0(0,NY,NX)) - ZNFNXI=AMAX1(ZNFNXI,ZNFNI(0,NY,NX)) - ZNFNXG=AMIN1(ZNFNXG,ZNFNG(0,NY,NX)) + ZNHUXI=AMAX1(ZNHUXI,ZNHUI(0,NY,NX)) ZNFNX0=AMAX1(ZNFNX0,ZNFN0(0,NY,NX)) LL=NU(NY,NX) C @@ -5266,11 +5284,10 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) TOSP(M,K)=TOSP(M,K)+TI*OSP(M,K,L,NY,NX) 4970 CONTINUE 4980 CONTINUE - ZNHUXI=AMAX1(ZNHUXI,ZNHUI(L,NY,NX)) ZNHUX0=AMAX1(ZNHUX0,ZNHU0(L,NY,NX)) - ZNFNXI=AMAX1(ZNFNXI,ZNFNI(L,NY,NX)) - ZNFNXG=AMIN1(ZNFNXG,ZNFNG(L,NY,NX)) + ZNHUXI=AMAX1(ZNHUXI,ZNHUI(L,NY,NX)) ZNFNX0=AMAX1(ZNFNX0,ZNFN0(L,NY,NX)) + TZNFNI=TZNFNI+ZNFNI(L,NY,NX) LL=L ENDIF 1000 CONTINUE @@ -5642,6 +5659,7 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) OXYSH(L,NY,NX)=XCORP(NY,NX)*OXYSH(L,NY,NX) Z2GSH(L,NY,NX)=XCORP(NY,NX)*Z2GSH(L,NY,NX) Z2OSH(L,NY,NX)=XCORP(NY,NX)*Z2OSH(L,NY,NX) + H2GSH(L,NY,NX)=XCORP(NY,NX)*H2GSH(L,NY,NX) DO 5965 K=0,5 DO 5965 N=1,7 DO 5965 M=1,3 @@ -5801,17 +5819,24 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) ZNH3FA(L,NY,NX)=ZNH3FA(L,NY,NX)+FI*TNH3FG ZNHUFA(L,NY,NX)=ZNHUFA(L,NY,NX)+FI*TNHUFG ZNO3FA(L,NY,NX)=ZNO3FA(L,NY,NX)+FI*TNO3FG - ZNHUI(L,NY,NX)=ZNHUXI ZNHU0(L,NY,NX)=ZNHUX0 - ZNFNI(L,NY,NX)=ZNFNXI - ZNFNG(L,NY,NX)=ZNFNXG + ZNHUI(L,NY,NX)=ZNHUXI ZNFN0(L,NY,NX)=ZNFNX0 + ZNFNI(L,NY,NX)=(TI*ZNFNI(L,NY,NX)+CORP*(FI*TZNFNI + 2-TI*ZNFNI(L,NY,NX))+TX*ZNFNI(L,NY,NX)+FI*TZNFNG)/FI + TZNFN2=TZNFN2+ZNFNI(L,NY,NX) 2000 CONTINUE - ZNHUI(0,NY,NX)=ZNHUXI - ZNHU0(0,NY,NX)=ZNHUX0 - ZNFNI(0,NY,NX)=ZNFNXI - ZNFNG(0,NY,NX)=ZNFNXG ZNFN0(0,NY,NX)=ZNFNX0 + ZNFNI(0,NY,NX)=ZNFNI(0,NY,NX)*XCORP(NY,NX) + TZNFN2=TZNFN2+TZNFNG + TZNFNI=TZNFNI+TZNFNG + DO 2001 L=NU(NY,NX),LL + IF(TZNFN2.GT.ZERO)THEN + ZNFNI(L,NY,NX)=ZNFNI(L,NY,NX)*TZNFNI/TZNFN2 + ZNFNI(L,NY,NX)=ZNFNI(L,NY,NX) + 2+0.5*(ZNFN0(L,NY,NX)-ZNFNI(L,NY,NX)) + ENDIF +2001 CONTINUE IFLGS(NY,NX)=1 ENDIF C diff --git a/f77src/routs.f b/f77src/routs.f index 8048340..6468ddf 100755 --- a/f77src/routs.f +++ b/f77src/routs.f @@ -104,7 +104,6 @@ SUBROUTINE routs(NHW,NHE,NVN,NVS) 1,H3PO4W(NY,NX),ZFE1PW(NY,NX),ZFE2PW(NY,NX) 2,ZCA0PW(NY,NX),ZCA1PW(NY,NX),ZCA2PW(NY,NX),ZMG1PW(NY,NX) ENDIF - READ(21,94)IDATE,IYR,(NHOL(L,NY,NX),L=1,NL(NY,NX)) READ(21,91)IDATE,IYR,(FHOL(L,NY,NX),L=1,NL(NY,NX)) READ(21,91)IDATE,IYR,(DLYR(3,L,NY,NX),L=0,NL(NY,NX)) READ(21,91)IDATE,IYR,(CDPTH(L,NY,NX),L=0,NL(NY,NX)) @@ -114,8 +113,8 @@ SUBROUTINE routs(NHW,NHE,NVN,NVS) READ(21,91)IDATE,IYR,(POROQ(L,NY,NX),L=1,NL(NY,NX)) READ(21,91)IDATE,IYR,(FC(L,NY,NX),L=1,NL(NY,NX)) READ(21,91)IDATE,IYR,(WP(L,NY,NX),L=1,NL(NY,NX)) -C READ(21,91)IDATE,IYR,(SCNV(L,NY,NX),L=1,NL(NY,NX)) -C READ(21,91)IDATE,IYR,(SCNH(L,NY,NX),L=1,NL(NY,NX)) + READ(21,91)IDATE,IYR,(SCNV(L,NY,NX),L=1,NL(NY,NX)) + READ(21,91)IDATE,IYR,(SCNH(L,NY,NX),L=1,NL(NY,NX)) READ(21,91)IDATE,IYR,(SAND(L,NY,NX),L=1,NL(NY,NX)) READ(21,91)IDATE,IYR,(SILT(L,NY,NX),L=1,NL(NY,NX)) READ(21,91)IDATE,IYR,(CLAY(L,NY,NX),L=1,NL(NY,NX)) @@ -420,7 +419,6 @@ SUBROUTINE routs(NHW,NHE,NVN,NVS) READ(22,91)IDATE,IYR,(ZNHUI(L,NY,NX),L=0,NL(NY,NX)) READ(22,91)IDATE,IYR,(ZNHU0(L,NY,NX),L=0,NL(NY,NX)) READ(22,91)IDATE,IYR,(ZNFNI(L,NY,NX),L=0,NL(NY,NX)) - READ(22,91)IDATE,IYR,(ZNFNG(L,NY,NX),L=0,NL(NY,NX)) READ(22,91)IDATE,IYR,(ZNFN0(L,NY,NX),L=0,NL(NY,NX)) 9990 CONTINUE 9995 CONTINUE @@ -446,7 +444,6 @@ SUBROUTINE routs(NHW,NHE,NVN,NVS) 2,/,15E17.8E3,/,15E17.8E3,/,15E17.8E3) 93 FORMAT(8I4,15E17.8E3,/,15E17.8E3,/,15E17.8E3,/,15E17.8E3 2,/,15E17.8E3,/,15E17.8E3,/,15E17.8E3,/,15E17.8E3,/,15E17.8E3) -94 FORMAT(2I4,21I17) 95 FORMAT(2I4,15E17.8E3,/,15E17.8E3,/,15E17.8E3,/,15E17.8E3 2,/,15E17.8E3,/,15E17.8E3,/,15E17.8E3,/,15E17.8E3) RETURN diff --git a/f77src/solute.f b/f77src/solute.f index 8bec419..6a00cde 100755 --- a/f77src/solute.f +++ b/f77src/solute.f @@ -29,10 +29,10 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) C C EQUILIBRIUM CONSTANTS C - DIMENSION RNHUI(2) - PARAMETER (DPH2O=6.5E-09,SPALO=5.0E-21,SPFEO=6.3E-27 - 2,SPCAC=5.0E-03,SPCAS=1.4E+01,SPALP=0.75E-15,SPFEP=0.75E-20 - 3,SPCAM=7.0E+07,SPCAD=1.0E-01,SPCAH=6.4E-33,SXOH2=4.5E-05 + DIMENSION RNHUI(0:2) + PARAMETER (DPH2O=6.5E-09,SPALO=6.5E-22,SPFEO=6.5E-27 + 2,SPCAC=5.0E-03,SPCAS=1.4E+01,SPALP=1.0E-15,SPFEP=1.0E-20 + 3,SPCAM=7.0E+07,SPCAD=1.0E-01,SPCAH=2.3E-31,SXOH2=4.5E-05 4,SXOH1=1.1E-06,SXH2P=2.0E+07,SXH1P=2.0E+07 5,DPCO2=4.2E-04,DPHCO=5.6E-08,DPN4=5.7E-07 6,DPAL1=4.6E-07,DPAL2=7.3E-07,DPAL3=1.8E-05 @@ -67,14 +67,14 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 7,SHF4P2=SYF4P2*DPH2O**2,SHCAD2=SPCAD/DPH2P,SYCAD2=SHCAD2*DPH2O 8,SHCAH1=SPCAH/(DPH2O*DPH1P**3),SYCAH1=SHCAH1*DPH2O**4 9,SHCAH2=SHCAH1/DPH2P**3,SYCAH2=SHCAH2*DPH2O**7) - PARAMETER (MRXN=1,TPD=1.0E-03,TPDX=TPD/MRXN,TADA=3.3E-02 - 2,TADAX=TADA/MRXN,TADC=3.3E-02,TADCX=TADC/MRXN + PARAMETER (MRXN=1,TPD=5.0E-03,TPDX=TPD/MRXN,TADA=5.0E-02 + 2,TADAX=TADA/MRXN,TADC=5.0E-02,TADCX=TADC/MRXN 3,TADC0=TADC*1.0E-02,TSL=0.5,TSLX=TSL/MRXN) PARAMETER (DUKM=1.0,DUKI=2.5,A0=1.0,COOH=2.5E-02 2,CCAMX=10.0) - PARAMETER (SPNH4=1.0E-00,SPNH3=1.0E-00,SPNHU=1.25E-00 + PARAMETER (SPNH4=1.0E-00,SPNH3=1.0E-00,SPNHU=1.0E-00 2,SPNO3=1.0E-00,SPPO4=5.0E-03) - DATA RNHUI/5.0E-03,5.0E-04/ + DATA RNHUI/0.0,5.0E-03,5.0E-04/ C C DUKM FROM SOIL SCI 136:56 C @@ -135,29 +135,29 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) IF(ZNHUFA(L,NY,NX).GT.ZEROS(NY,NX) 2.AND.BKVL(L,NY,NX).GT.ZEROS(NY,NX))THEN CNHUA=ZNHUFA(L,NY,NX)/BKVL(L,NY,NX) + ELSE + CNHUA=ZNHUFA(L,NY,NX)/VOLW(L,NY,NX) + ENDIF DFNSA=CNHUA/(CNHUA+DUKD) RSNUA=AMIN1(ZNHUFA(L,NY,NX) 2,SPNHU*TOQCK(L,NY,NX)*DFNSA*TFNQ(L,NY,NX))*(1.0-ZNHUI(L,NY,NX)) - ELSE - RSNUA=0.0 - ENDIF C C UREA CONCENTRATION AND HYDROLYSIS IN BAND C IF(ZNHUFB(L,NY,NX).GT.ZEROS(NY,NX) 2.AND.BKVL(L,NY,NX).GT.ZEROS(NY,NX))THEN - CNHUB=ZNHUFB(L,NY,NX)/BKVL(L,NY,NX) + CNHUB=ZNHUFB(L,NY,NX)/BKVL(L,NY,NX) + ELSE + CNHUB=ZNHUFB(L,NY,NX)/VOLW(L,NY,NX) + ENDIF DFNSB=CNHUB/(CNHUB+DUKD) RSNUB=AMIN1(ZNHUFB(L,NY,NX) 2,SPNHU*TOQCK(L,NY,NX)*DFNSB*TFNQ(L,NY,NX))*(1.0-ZNHUI(L,NY,NX)) - ELSE - RSNUB=0.0 - ENDIF C IF(J.EQ.13.AND.L.LE.4)THEN C WRITE(*,8888)'UREA',I,J,L,IUTYP(NY,NX) C 2,ZNHUFA(L,NY,NX),ZNHUFB(L,NY,NX),RSNUA,RSNUB C 2,DFNSA,DFNSB,TFNQ(L,NY,NX),CNHUA,DUKD,DUKM,DUKI,TOQCK(L,NY,NX) -C 3,BKVL(L,NY,NX),TFNQ(L,NY,NX),SPNHU,ZNHU0(L,NY,NX),ZNHUI(L,NY,NX) +C 3,BKVL(L,NY,NX),SPNHU,ZNHU0(L,NY,NX),ZNHUI(L,NY,NX) C 4,RNHUI(IUTYP(NY,NX)) 8888 FORMAT(A8,4I4,40E12.4) C ENDIF @@ -222,7 +222,8 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) C 2,CN41,CN31,CN4B,CN3B,TUPNH4(L,NY,NX),XNH4S(L,NY,NX) C 3,RSN4AA,TUPN3S(L,NY,NX),RSNUAA,TUPNHB(L,NY,NX) C 4,XNH4B(L,NY,NX),RSN4BA,RSN4BB,TUPN3B(L,NY,NX) -C 5,RSNUBA,RSNUBB +C 5,RSNUBA,RSNUBB,ZNH4S(L,NY,NX),ZNH3S(L,NY,NX) +C 6,VOLWNX,BKVLNH 4141 FORMAT(A8,5I4,30E12.4) C C SOLUBLE, EXCHANGEABLE AND PRECIPITATED PO4 CONCENTRATIONS IN @@ -1417,7 +1418,7 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) VOLWBK=1.0 ENDIF IF(VOLWPO.GT.ZEROS(NY,NX) - 2.AND.AEC(L,NY,NX).GT.ZEROS(NY,NX))THEN + 2.AND.XAEC(L,NY,NX).GT.ZEROS(NY,NX))THEN RXOH2=TADAX*(XOH11*AHY1-SXOH2*XOH21)/(XOH11+SXOH2)*VOLWBK RXOH1=TADAX*(XOH01*AHY1-SXOH1*XOH11)/(XOH01+SXOH1)*VOLWBK C @@ -1449,7 +1450,7 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) C EXCHANGE SITES C IF(VOLWPB.GT.ZEROS(NY,NX) - 2.AND.AEC(L,NY,NX).GT.ZEROS(NY,NX))THEN + 2.AND.XAEC(L,NY,NX).GT.ZEROS(NY,NX))THEN RXO2B=TADAX*(XH11B*AHY1-SXOH2*XH21B)/(XH11B+SXOH2)*VOLWBK RXO1B=TADAX*(XH01B*AHY1-SXOH1*XH11B)/(XH01B+SXOH1)*VOLWBK C @@ -1481,7 +1482,7 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) C CATION EXCHANGE FROM GAPON SELECTIVITY COEFFICIENTS C FOR CA-NH4, CA-H, CA-AL, CA-MG, CA-NA, CA-K C - IF(CEC(L,NY,NX).GT.ZEROS(NY,NX))THEN + IF(XCEC(L,NY,NX).GT.ZEROS(NY,NX))THEN C C CATION CONCENTRATIONS C @@ -2429,7 +2430,7 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) ELSE VOLWBK=1.0 ENDIF - IF(AEC(L,NY,NX).GT.0.0)THEN + IF(XAEC(L,NY,NX).GT.ZEROS(NY,NX))THEN C C H2PO4 EXCHANGE IN NON-BAND SOIL ZONE FROM CONVERGENCE C SOLUTION FOR EQUILIBRIUM AMONG H2PO4-, H+, OH-, X-OH @@ -2445,6 +2446,11 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) C SPH1P=SXH1P*DPH2O/DPH2P RXH1P=TADA*(XOH11*CH1P1-SPH1P*XH1P1)/(XOH11+SPH1P)*VOLWBK + ELSE + RXH2P=0.0 + RYH2P=0.0 + RXH1P=0.0 + ENDIF C IF((I/120)*120.EQ.I.AND.J.EQ.24.AND.L.LE.6)THEN C WRITE(*,1116)'RXH2P',I,J,NX,NY,L,RXH2P C 2,XOH21,CH2P1,XH2P1,XOH21*(CH2P1-RXH2P)/(XH2P1+RXH2P),SPH2P @@ -2466,12 +2472,6 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) S1=AMAX1(0.0,S0**2-4.0*(CH1P1*CHY1-DP*CH2P1)) RH2P=TSL*(S0-SQRT(S1)) ELSE - RXH2P=0.0 - RYH2P=0.0 - RXH1P=0.0 - RH2P=0.0 - ENDIF - ELSE RPALPX=0.0 RPFEPX=0.0 RPCADX=0.0 @@ -2524,7 +2524,7 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) C HPO4--, H+, OH- AND PROTONATED AND NON-PROTONATED -OH C EXCHANGE SITES C - IF(AEC(L,NY,NX).GT.0.0)THEN + IF(XAEC(L,NY,NX).GT.ZEROS(NY,NX))THEN C C H2PO4 EXCHANGE IN BAND SOIL ZONE FROM CONVERGENCE C SOLUTION FOR EQUILIBRIUM AMONG H2PO4-, H+, OH-, X-OH @@ -2540,6 +2540,11 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) C SPH1P=SXH1P*DPH2O/DPH2P RXH1B=TADA*(XH11B*CH1PB-SPH1P*X1P1B)/(XH11B+SPH1P)*VOLWBK + ELSE + RXH2B=0.0 + RYH2B=0.0 + RXH1B=0.0 + ENDIF C WRITE(*,2224)'RXH1B',I,J,L,RXH1B,XH11B,CH1PB,SPH1P,X1P1B 2224 FORMAT(A8,3I4,40E12.4) C @@ -2550,12 +2555,6 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) S1=AMAX1(0.0,S0**2-4.0*(CH1PB*CHY1-DP*CH2PB)) RH2B=TSLX*(S0-SQRT(S1)) ELSE - RXH2B=0.0 - RYH2B=0.0 - RXH1B=0.0 - RH2B=0.0 - ENDIF - ELSE RPALBX=0.0 RPFEBX=0.0 RPCDBX=0.0 @@ -2570,6 +2569,7 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) C CATION EXCHANGE FROM GAPON SELECTIVITY COEFFICIENTS C FOR CA-NH4, CA-H, CA-AL C + IF(XCEC(L,NY,NX).GT.ZEROS(NY,NX))THEN CN41=AMAX1(ZERO,CN41) CN4B=AMAX1(ZERO,CN4B) CALX=AMAX1(ZERO,CAL1)**0.333 @@ -2609,11 +2609,16 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) C NH4 EXCHANGE IN NON-BAND AND BAND SOIL ZONES C RXN4=TADC*(XN4Q-XN41)*CN41/XN4Q - RXNB=TADC*(XNBQ-XN4B)*CN4B/XNBQ + RXNB=TADC*(XNBQ-XN4B)*CN4B/XNBQ + ELSE + RXN4=0.0 + RXNB=0.0 + ENDIF C IF(J.EQ.12.AND.L.EQ.0)THEN -C WRITE(*,2222)'RXN4',I,J,L,RXN4,CN41,XN41,CCAX,CCA1,XCAQ,CCEC -C 2,FN4X,FCAQ,GKC4(L,NY,NX),PH(L,NY,NX),VOLWBK -C 3,(CCA1)**0.5*XN41/(CN41*XCAQ),ZCA(L,NY,NX) +C WRITE(*,2222)'RXN4',I,J,L,RXN4,CN41,XN41,CCAX,CCA1,XCAQ +C 2,CCEC,XCAX,FN4X,FCAQ,GKC4(L,NY,NX),PH(L,NY,NX),VOLWBK +C 3,(CCA1)**0.5*XN41/(CN41*XCAQ),ZCA(L,NY,NX),BKVLX +C 4,CN4B,CHY1,CALX,CFEX,CMGX,CNA1,CKA1 C ENDIF C C NH4-NH3+H IN NON-BAND AND BAND SOIL ZONES @@ -2629,7 +2634,7 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) RNHB=0.0 ENDIF C IF(J.EQ.12.AND.L.LE.6)THEN -C WRITE(20,2222)'RNH4',I,J,L,RNH4,CHY1,CN31,DPN4,CN41 +C WRITE(*,2222)'RNH4',I,J,L,RNH4,CHY1,CN31,DPN4,CN41 C 2,RXN4,XN41,VOLWNH,RNHB,CN3B,CN4B,VOLWNB,RXNB,XN4B,FN4X C 2,CN41*VOLWNH,XN41*VOLWNH,CN4B*VOLWNB,XN4B*VOLWNB C 3,(CCA1)**0.5*XN41/(CN41*XCAQ),(CCA1)**0.5*XN4B/(CN4B*XCAQ) @@ -3252,6 +3257,12 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) RPCAMX=0.0 RXN4=0.0 RNH4=0.0 + RH2P=0.0 + RPALPX=0.0 + RPFEPX=0.0 + RPCADX=0.0 + RPCAMX=0.0 + RPCAHX=0.0 ENDIF C C TOTAL ION FLUXES FOR ALL REACTIONS ABOVE diff --git a/f77src/starte.f b/f77src/starte.f index ae30a65..4e598db 100755 --- a/f77src/starte.f +++ b/f77src/starte.f @@ -27,9 +27,9 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) 2,SN2GX=1.510E-02,SN2OX=5.241E-01,SNH3X=2.852E+02,SH2GX=3.156E-02 3,ACO2X=0.14,ACH4X=0.14,AOXYX=0.31,AN2GX=0.23,AN2OX=0.23 4,ANH3X=0.07,AH2GX=0.14) - PARAMETER (DPH2O=6.5E-09,SPALO=5.0E-21,SPFEO=6.3E-27 - 2,SPCAC=5.0E-03,SPCAS=1.4E+01,SPALP=0.75E-15,SPFEP=0.75E-20 - 3,SPCAM=7.0E+07,SPCAD=1.0E-01,SPCAH=6.4E-33,SXOH2=4.5E-05 + PARAMETER (DPH2O=6.5E-09,SPALO=6.5E-22,SPFEO=6.5E-27 + 2,SPCAC=5.0E-03,SPCAS=1.4E+01,SPALP=1.0E-15,SPFEP=1.0E-20 + 3,SPCAM=7.0E+07,SPCAD=1.0E-01,SPCAH=2.3E-31,SXOH2=4.5E-05 4,SXOH1=1.1E-06,SXH2P=2.0E+07,SXH1P=2.0E+07 5,DPCO2=4.2E-04,DPHCO=5.6E-08,DPN4=5.7E-07 6,DPAL1=4.6E-07,DPAL2=7.3E-07,DPAL3=1.8E-05 @@ -63,7 +63,7 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) 7,SHF4P2=SYF4P2*DPH2O**2,SHCAD2=SPCAD/DPH2P,SYCAD2=SHCAD2*DPH2O 8,SHCAH1=SPCAH/(DPH2O*DPH1P**3),SYCAH1=SHCAH1*DPH2O**4 9,SHCAH2=SHCAH1/DPH2P**3,SYCAH2=SHCAH2*DPH2O**7) - PARAMETER (TPD=0.01,TAD=0.01,TSL=0.01,A0=1.0,COOH=2.5E-02) + PARAMETER (TPD=0.1,TAD=0.1,TSL=0.1,A0=1.0,COOH=2.5E-02) C C INITIALIZE CATION AND ANION CONCENTRATIONS C IN PRECIPITATION (K=1), IRRIGATION (K=2) AND SOIL (K=3) @@ -1012,7 +1012,7 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) C ANION EXCHANGE EQILIBRIA C IF(VOLW(L,NY,NX).GT.ZEROS(NY,NX))THEN - VOLWBK=AMIN1(1.0,BKVL(L,NY,NX)/VOLW(L,NY,NX)) + VOLWBK=AMIN1(1.0,BKVLX/VOLW(L,NY,NX)) ELSE VOLWBK=1.0 ENDIF @@ -1393,7 +1393,7 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) C ANION EXCHANGE FLUXES C IF(VOLW(L,NY,NX).GT.ZEROS(NY,NX))THEN - VOLWBK=AMIN1(1.0,BKVL(L,NY,NX)/VOLW(L,NY,NX)) + VOLWBK=AMIN1(1.0,BKVLX/VOLW(L,NY,NX)) ELSE VOLWBK=1.0 ENDIF @@ -1416,11 +1416,7 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) C C CATION EXCHANGE C - IF(BKVL(L,NY,NX).GT.ZEROS(NY,NX))THEN - BKVLX=BKVL(L,NY,NX) - ELSE - BKVLX=VOLW(L,NY,NX) - ENDIF + IF(XCEC(L,NY,NX).GT.ZEROS(NY,NX))THEN CCEC=AMAX1(ZERO,XCEC(L,NY,NX)/BKVLX) CALX=CAL1**0.333 CFEX=CFE1**0.333 @@ -1445,11 +1441,15 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) FX=0.0 ENDIF XN4Q=FX*XN4Q - RXN4=TSL*(XN4Q-XN41)*CN41/XN4Q + RXN4=TSL*(XN4Q-XN41)*CN41/XN4Q + ELSE + RXN4=0.0 + ENDIF XN41=XN41+RXN4 -C WRITE(*,2224)'RXN4',NX,NY,L,M,RXN4,CN41,XN4Q,XN41,XCAX,CCEC,FX +C WRITE(*,2224)'RXN4E',K,L,M,RXN4,CN41,XN4Q,XN41,XCAX,CCEC,FX C 2,XHYQ,XALQ,XFEQ,XCAQ,XMGQ,XNAQ,XKAQ,CALX,CFEX,CCAX,CMGX,CNA1,CKA1 -2224 FORMAT(A8,4I4,40E12.4) +C 3,CN4X,CNH4(L,NY,NX),XCEC(L,NY,NX) +2224 FORMAT(A8,3I4,40E12.4) ELSE RPALPX=0.0 RPFEPX=0.0 @@ -1483,15 +1483,15 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) CN31=CN31+RN3S CH1P1=CH1P1+RHP1 CH2P1=CH2P1+RHP2 -C IF(K.EQ.3)THEN -C WRITE(*,2222)'RNH4',K,L,CN41,RN4S,RNH4,RXN4 + IF(K.EQ.3)THEN +C WRITE(*,2222)'RNH4E',K,L,CN41,RN4S,RNH4,RXN4 C 2,TSL,XN4Q,XN41,CN41,FX,XTLQ,XHYQ,XALQ,XFEQ C 2,XCAQ,XMGQ,XNAQ,XKAQ,CCEC,BKVLX,XCAX,CAL1,CFE1 C 2,CCA1,CMG1 -C WRITE(*,2222)'RHP1',K,L,CH2P1,CH1P1,RHP2,RHP1 +C WRITE(*,2222)'RHP1E',K,L,CH2P1,CH1P1,RHP2,RHP1 C 2,XH2P1,XH1P1,RXH1P,RXH2P,RYH2P,RH2P,CHY1,COH1 C 3,XOH21,XOH11 -C ENDIF + ENDIF 1100 CONTINUE ENDIF C @@ -1700,6 +1700,9 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) H1POB(L,NY,NX)=CH1PU(L,NY,NX)*VOLW(L,NY,NX)*VLPOB(L,NY,NX) ZNO2S(L,NY,NX)=0.0 ZNO2B(L,NY,NX)=0.0 +C WRITE(*,444)'ZNH4S',NX,NY,L,ZNH4S(L,NY,NX),CN4U(L,NY,NX) +C 2,VOLW(L,NY,NX),VLNH4(L,NY,NX) +444 FORMAT(A8,3I4,12E12.4) C C INITIAL STATE VARIABLES FOR CATIONS, ANIONS AND ION PAIRS IN SOIL C diff --git a/f77src/startq.f b/f77src/startq.f index b718eee..fd1c392 100755 --- a/f77src/startq.f +++ b/f77src/startq.f @@ -259,12 +259,12 @@ SUBROUTINE startq(NHWQ,NHEQ,NVNQ,NVSQ,NZ1Q,NZ2Q) TCX(NZ,NY,NX)=AMIN1(15.0,TCXD-OFFST(NZ,NY,NX)) IF(ICTYP(NZ,NY,NX).EQ.3)THEN IF(DATAP(NZ,NY,NX)(1:4).EQ.'soyb')THEN - HTC(NZ,NY,NX)=36.0+3.0*ZTYP(NZ,NY,NX) + HTC(NZ,NY,NX)=33.0+3.0*ZTYP(NZ,NY,NX) ELSE HTC(NZ,NY,NX)=27.0+3.0*ZTYP(NZ,NY,NX) ENDIF ELSE - HTC(NZ,NY,NX)=30.0+3.0*ZTYP(NZ,NY,NX) + HTC(NZ,NY,NX)=33.0+3.0*ZTYP(NZ,NY,NX) ENDIF C C SEED CHARACTERISTICS diff --git a/f77src/starts.f b/f77src/starts.f index f563a4a..725af75 100755 --- a/f77src/starts.f +++ b/f77src/starts.f @@ -40,6 +40,7 @@ SUBROUTINE starts(NHW,NHE,NVN,NVS) DATA CPRH/3.33E-03,3.33E-03,3.33E-03,5.00E-03,12.50E-03/ DATA BKRS/0.0500,0.0167,0.0167/ DATA FORGC,FVLWB,FCH4F/0.1E+06,1.0,0.01/ + DATA PSIHY/-2500.0/ NDIM=1 IF(NHE.GT.NHW)NDIM=NDIM+1 IF(NVS.GT.NVN)NDIM=NDIM+1 @@ -225,9 +226,9 @@ SUBROUTINE starts(NHW,NHE,NVN,NVS) ELSE ALTY=MAX(ALTY,ALT(NY,NX)) ENDIF - WRITE(18,1111)'ALT',NX,NY,ALT(NY,NX) - 2,DH(NY,NX),DV(NY,NX),ASP(NY,NX),GSIN(NY,NX) - 3,SLOPE(1,NY,NX),SLOPE(2,NY,NX) +C WRITE(18,1111)'ALT',NX,NY,ALT(NY,NX) +C 2,DH(NY,NX),DV(NY,NX),ASP(NY,NX),GSIN(NY,NX) +C 3,SLOPE(1,NY,NX),SLOPE(2,NY,NX) 1111 FORMAT(A8,2I4,20E12.4) 9980 CONTINUE 9985 CONTINUE @@ -361,7 +362,7 @@ SUBROUTINE starts(NHW,NHE,NVN,NVS) C CALCULATE THERMAL ADAPTATION C OFFSET(NY,NX)=0.33*(12.5-AMAX1(0.0,AMIN1(25.0,ATCS(NY,NX)))) - WRITE(*,2222)'OFFSET',OFFSET(NY,NX),ATCS(NY,NX) +C WRITE(*,2222)'OFFSET',OFFSET(NY,NX),ATCS(NY,NX) 2222 FORMAT(A8,2E12.4) C C CALCULATE WHETHER BOUNDARY SLOPES ALLOW RUNOFF @@ -571,7 +572,7 @@ SUBROUTINE starts(NHW,NHE,NVN,NVS) TORGL(L)=TORGC+CORGL*BKVL(L,NY,NX)/AREA(3,L,NY,NX)*0.5 TORGC=TORGC+CORGL*BKVL(L,NY,NX)/AREA(3,L,NY,NX) 1190 CONTINUE - TORGM=AMIN1(0.5E+04,0.25*TORGL(NJ(NY,NX))) + TORGM=AMAX1(2.0E+03,AMIN1(5.0E+03,0.25*TORGL(NJ(NY,NX)))) IF(TORGM.GT.ZERO)THEN HCX=LOG(0.5)/TORGM ELSE @@ -795,7 +796,8 @@ SUBROUTINE starts(NHW,NHE,NVN,NVS) C C DRYLAND C - IF(DPTH(L,NY,NX).LE.DTBLZ(NY,NX) + IF(CORGC(L,NY,NX).LE.FORGC.OR + 2.DPTH(L,NY,NX).LE.DTBLZ(NY,NX) 2+CDPTH(NU(NY,NX),NY,NX)-CDPTHG)THEN FCY=0.60 IF(CORGCX(4).GT.1.0E-32)THEN @@ -816,12 +818,12 @@ SUBROUTINE starts(NHW,NHE,NVN,NVS) ELSE FCO=FCY ENDIF - FCX=(EXP(HCX*TORGL(L)))**0.50 + FCX=(EXP(HCX*TORGL(L)))**0.5 ENDIF - ELSE C C RECONSTRUCTED SOILS C + ELSE FCY=0.60 IF(CORGCX(4).GT.1.0E-32)THEN FC0=FCY*EXP(-5.0*(AMIN1(CORGNX(4),10.0*CORGPX(4)) @@ -829,7 +831,7 @@ SUBROUTINE starts(NHW,NHE,NVN,NVS) ELSE FCO=FCY ENDIF - FCX=0.10 + FCX=0.50 ENDIF FC1=FC0*FCX CFOSC(1,4,L,NY,NX)=FC1 @@ -841,9 +843,10 @@ SUBROUTINE starts(NHW,NHE,NVN,NVS) C CFOMC(1,L,NY,NX)=3.0*FC1/(2.0*FC1+1.0) CFOMC(2,L,NY,NX)=1.0-CFOMC(1,L,NY,NX) - WRITE(*,5432)'PART',L,FC0,FC1,FCX,TORGM,TORGL(L),HCX + WRITE(*,5432)'PART',L,FC0,FC1,FCX,HCX,TORGM,TORGL(L) 2,CORGCX(4),CORGNX(4),CORGPX(4),DPTH(L,NY,NX),DTBLZ(NY,NX) - 3,CDPTH(NU(NY,NX),NY,NX),CDPTHG + 3,CDPTH(NU(NY,NX),NY,NX),CDPTHG,CORGC(L,NY,NX),FORGC + 4,EXP(HCX*TORGL(L)) 5432 FORMAT(A8,I4,20E12.4) ENDIF C @@ -857,10 +860,15 @@ SUBROUTINE starts(NHW,NHE,NVN,NVS) RCH4L(L,NY,NX)=0.0 IF(L.GT.0)THEN HYST(L,NY,NX)=1.0 + IF(BKDS(L,NY,NX).GT.ZERO)THEN CORGCM=AMIN1(0.5E+06 2,(CORGCX(1)+CORGCX(2)+CORGCX(3)+CORGCX(4)))/0.5 PTDS=1.0E-06*(1.30*CORGCM+2.66*(1.0E+06-CORGCM)) POROS(L,NY,NX)=1.0-(BKDS(L,NY,NX)/PTDS) + ELSE + PTDS=0.0 + POROS(L,NY,NX)=1.0 + ENDIF VOLA(L,NY,NX)=POROS(L,NY,NX)*VOLX(L,NY,NX) VOLAH(L,NY,NX)=FHOL(L,NY,NX)*VOLT(L,NY,NX) IF(ISOIL(1,L,NY,NX).EQ.0.AND.ISOIL(2,L,NY,NX).EQ.0)THEN @@ -895,11 +903,15 @@ SUBROUTINE starts(NHW,NHE,NVN,NVS) SAND(L,NY,NX)=CSAND(L,NY,NX)*BKVL(L,NY,NX) SILT(L,NY,NX)=CSILT(L,NY,NX)*BKVL(L,NY,NX) CLAY(L,NY,NX)=CCLAY(L,NY,NX)*BKVL(L,NY,NX) + IF(BKDS(L,NY,NX).GT.ZERO)THEN VORGC=CORGCM*1.0E-06*BKDS(L,NY,NX)/PTDS VMINL=(CSILT(L,NY,NX)+CCLAY(L,NY,NX))*BKDS(L,NY,NX)/PTDS VSAND=CSAND(L,NY,NX)*BKDS(L,NY,NX)/PTDS VHCM(L,NY,NX)=((2.496*VORGC+2.385*VMINL+2.128*VSAND) 2*FMPR(L,NY,NX)+2.128*ROCK(L,NY,NX))*VOLT(L,NY,NX) + ELSE + VHCM(L,NY,NX)=0.0 + ENDIF VHCP(L,NY,NX)=VHCM(L,NY,NX)+4.19*(VOLW(L,NY,NX) 2+VOLWH(L,NY,NX))+1.9274*(VOLI(L,NY,NX)+VOLIH(L,NY,NX)) TCS(L,NY,NX)=ATCS(NY,NX) @@ -1246,7 +1258,6 @@ SUBROUTINE starts(NHW,NHE,NVN,NVS) 1250 CONTINUE ZNHUI(L,NY,NX)=0.0 ZNHU0(L,NY,NX)=0.0 - ZNFNG(L,NY,NX)=1.0 ZNFNI(L,NY,NX)=0.0 ZNFN0(L,NY,NX)=0.0 1200 CONTINUE diff --git a/f77src/trnsfr.f b/f77src/trnsfr.f index 4b240a9..197a8e1 100755 --- a/f77src/trnsfr.f +++ b/f77src/trnsfr.f @@ -194,7 +194,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) RN2SK2(0,NY,NX)=RN2O(0,NY,NX)*XNPG RNHSK2(0,NY,NX)=-TRN3G(0,NY,NX)*XNPG RHGSK2(0,NY,NX)=RH2GO(0,NY,NX)*XNPG - DO 14 K=0,2 + DO 14 K=0,4 ROCSK2(K,0,NY,NX)=-XOQCS(K,0,NY,NX)*XNPH RONSK2(K,0,NY,NX)=-XOQNS(K,0,NY,NX)*XNPH ROPSK2(K,0,NY,NX)=-XOQPS(K,0,NY,NX)*XNPH @@ -212,7 +212,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) Z2GS2(0,NY,NX)=Z2GS(0,NY,NX) Z2OS2(0,NY,NX)=Z2OS(0,NY,NX) H2GS2(0,NY,NX)=H2GS(0,NY,NX) - DO 9979 K=0,2 + DO 9979 K=0,4 OQC2(K,0,NY,NX)=OQC(K,0,NY,NX)-XOQCS(K,0,NY,NX) OQN2(K,0,NY,NX)=OQN(K,0,NY,NX)-XOQNS(K,0,NY,NX) OQP2(K,0,NY,NX)=OQP(K,0,NY,NX)-XOQPS(K,0,NY,NX) @@ -782,7 +782,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) C C RESET RUNOFF SOLUTE FLUX ACCUMULATORS C - DO 9880 K=0,2 + DO 9880 K=0,4 TQROC(K,NY,NX)=0.0 TQRON(K,NY,NX)=0.0 TQROP(K,NY,NX)=0.0 @@ -915,6 +915,9 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) Z2OS2(L,NY,NX)=Z2OS2(L,NY,NX)-RN2SK2(L,NY,NX) H2GS2(L,NY,NX)=H2GS2(L,NY,NX)-RHGSK2(L,NY,NX) ZN3G2(L,NY,NX)=ZN3G2(L,NY,NX)-RNHSK2(L,NY,NX) +C WRITE(*,444)'CO2S1',I,J,NX,NY,L,M,MM,CO2S2(L,NY,NX) +C 2,RCOSK2(L,NY,NX),RCO2O(L,NY,NX),TCO2S(L,NY,NX) +C 3,TRCO2(L,NY,NX) 9885 CONTINUE C C SOLUTE FLUXES AT SOIL SURFACE FROM SURFACE WATER @@ -946,7 +949,9 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) C THROUGH VOLATILIZATION-DISSOLUTION FROM AQUEOUS C DIFFUSIVITIES IN SURFACE RESIDUE C - IF(VOLWM(M,0,NY,NX).GT.ZEROS(NY,NX))THEN + IF(VOLWM(M,0,NY,NX).GT.ZEROS(NY,NX) + 2.AND.VOLT(0,NY,NX).GT.ZEROS(NY,NX))THEN + THETW1(0,NY,NX)=AMAX1(0.0,VOLWM(M,0,NY,NX)/VOLT(0,NY,NX)) VOLWCO(0,NY,NX)=VOLWM(M,0,NY,NX)*SCO2L(0,NY,NX) VOLWCH(0,NY,NX)=VOLWM(M,0,NY,NX)*SCH4L(0,NY,NX) VOLWOX(0,NY,NX)=VOLWM(M,0,NY,NX)*SOXYL(0,NY,NX) @@ -1013,7 +1018,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) XN2DFR(NY,NX)=XN2DFR(NY,NX)+RN2DFR(NY,NX) XN3DFR(NY,NX)=XN3DFR(NY,NX)+RN3DFR(NY,NX) XHGDFR(NY,NX)=XHGDFR(NY,NX)+RHGDFR(NY,NX) -C IF(J.EQ.24)THEN +C IF(I.LE.90.AND.J.EQ.14)THEN C WRITE(*,1118)'RCODFR',I,J,NX,NY,M,MM,CO2S2(0,NY,NX) C 2,RCODFR(NY,NX),PARR(NY,NX),CCO2E(NY,NX),CCO2Q C 3,DCO21,CCO22,SCO2L(0,NY,NX),TORT1,THETW1(0,NY,NX) @@ -1023,7 +1028,8 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) C 3,VOLWCH(0,NY,NX),DFGSCH,TORT(M,0,NY,NX) C WRITE(*,1118)'ROXDFR',I,J,NX,NY,M,MM,ROXDFR(NY,NX) C 2,OXYGQ,OXYS2(0,NY,NX),PARR(NY,NX),COXYE(NY,NX) -C 3,VOLWOX(0,NY,NX),DFGSOX,TORT(M,0,NY,NX),XOXDFR(NY,NX) +C 3,VOLWOX(0,NY,NX),DFGSOX,TORT(M,0,NY,NX),XOXDFR(NY,NX) +C 4,VOLWM(M,0,NY,NX),VOLT(0,NY,NX),DLYR(3,0,NY,NX) 1118 FORMAT(A8,6I4,20E12.4) C ENDIF ELSE @@ -1128,11 +1134,16 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) XNBDFS(NY,NX)=XNBDFS(NY,NX)+RNBDFS(NY,NX) XHGDFS(NY,NX)=XHGDFS(NY,NX)+RHGDFS(NY,NX) C IF(J.EQ.24)THEN +C WRITE(*,1118)'RCODFS',I,J,NX,NY,M,MM,RCODFS(NY,NX) +C 2,XCODFS(NY,NX),CO2GQ,CO2S2X,CO2S2(NU(NY,NX),NY,NX),PARG(NY,NX) +C 3,CCO2E(NY,NX),VOLWCO(NU(NY,NX),NY,NX),DFGSCO +C 2,TORT(M,NU(NY,NX),NY,NX),CLSGL2(NU(NY,NX),NY,NX),TORT1 +C 4,DLYR(3,NU(NY,NX),NY,NX) C WRITE(*,1118)'RCHDFS',I,J,NX,NY,M,MM,RCHDFS(NY,NX) -C 2,CH4GQ,CH4S2(NU(NY,NX),NY,NX),PARG(NY,NX) +C 2,XCHDFS(NY,NX),CH4GQ,CH4S2X,CH4S2(NU(NY,NX),NY,NX),PARG(NY,NX) C 3,CCH4E(NY,NX),VOLWCH(NU(NY,NX),NY,NX),DFGSCH,TORT(M,0,NY,NX) C WRITE(*,1118)'ROXDFS',I,J,NX,NY,M,MM,ROXDFS(NY,NX) -C 2,OXYGQ,OXYS2(NU(NY,NX),NY,NX),PARG(NY,NX) +C 2,XOXDFS(NY,NX),OXYGQ,OXYS2X,OXYS2(NU(NY,NX),NY,NX),PARG(NY,NX) C 3,COXYE(NY,NX),VOLWOX(NU(NY,NX),NY,NX),DFGSOX,TORT(M,0,NY,NX) C 4,XOXDFS(NY,NX) C ENDIF @@ -1170,7 +1181,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) ELSE VFLW=XFRX ENDIF - DO 8820 K=0,2 + DO 8820 K=0,4 RFLOC(K)=VFLW*AMAX1(0.0,OQC2(K,0,NY,NX)) RFLON(K)=VFLW*AMAX1(0.0,OQN2(K,0,NY,NX)) RFLOP(K)=VFLW*AMAX1(0.0,OQP2(K,0,NY,NX)) @@ -1206,7 +1217,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) ELSE VFLW=-XFRX ENDIF - DO 8815 K=0,2 + DO 8815 K=0,4 RFLOC(K)=VFLW*AMAX1(0.0,OQC2(K,NU(NY,NX),NY,NX)) RFLON(K)=VFLW*AMAX1(0.0,OQN2(K,NU(NY,NX),NY,NX)) RFLOP(K)=VFLW*AMAX1(0.0,OQP2(K,NU(NY,NX),NY,NX)) @@ -1241,7 +1252,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) C C MICROPORE CONCENTRATIONS FROM WATER IN RESIDUE AND SOIL SURFACE C - DO 8810 K=0,2 + DO 8810 K=0,4 COQC1(K)=AMAX1(0.0,OQC2(K,0,NY,NX)/VOLWM(M,0,NY,NX)) COQN1(K)=AMAX1(0.0,OQN2(K,0,NY,NX)/VOLWM(M,0,NY,NX)) COQP1(K)=AMAX1(0.0,OQP2(K,0,NY,NX)/VOLWM(M,0,NY,NX)) @@ -1376,7 +1387,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) C DIFFUSIVE FLUXES BETWEEN CURRENT AND ADJACENT GRID CELL C MICROPORES C - DO 8805 K=0,2 + DO 8805 K=0,4 DFVOC(K)=DIFOC*(COQC1(K)-COQC2(K)) DFVON(K)=DIFON*(COQN1(K)-COQN2(K)) DFVOP(K)=DIFOP*(COQP1(K)-COQP2(K)) @@ -1401,7 +1412,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) DFVP1B=DIFPO*(CP14S1-CP14B2)*VLPOB(NU(NY,NX),NY,NX) DFVPOB=DIFPO*(CPO4S1-CPO4B2)*VLPOB(NU(NY,NX),NY,NX) ELSE - DO 8905 K=0,2 + DO 8905 K=0,4 DFVOC(K)=0.0 DFVON(K)=0.0 DFVOP(K)=0.0 @@ -1439,22 +1450,6 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) RONFLS(K,3,NU(NY,NX),NY,NX)=RONFL1(K,NY,NX)+RFLON(K)+DFVON(K) ROPFLS(K,3,NU(NY,NX),NY,NX)=ROPFL1(K,NY,NX)+RFLOP(K)+DFVOP(K) ROAFLS(K,3,NU(NY,NX),NY,NX)=ROAFL1(K,NY,NX)+RFLOA(K)+DFVOA(K) - XOCFLS(K,3,0,NY,NX)=XOCFLS(K,3,0,NY,NX) - 2-RFLOC(K)-DFVOC(K) - XONFLS(K,3,0,NY,NX)=XONFLS(K,3,0,NY,NX) - 2-RFLON(K)-DFVON(K) - XOPFLS(K,3,0,NY,NX)=XOPFLS(K,3,0,NY,NX) - 2-RFLOP(K)-DFVOP(K) - XOAFLS(K,3,0,NY,NX)=XOAFLS(K,3,0,NY,NX) - 2-RFLOA(K)-DFVOA(K) - XOCFLS(K,3,NU(NY,NX),NY,NX)=XOCFLS(K,3,NU(NY,NX),NY,NX) - 2+RFLOC(K)+DFVOC(K) - XONFLS(K,3,NU(NY,NX),NY,NX)=XONFLS(K,3,NU(NY,NX),NY,NX) - 2+RFLON(K)+DFVON(K) - XOPFLS(K,3,NU(NY,NX),NY,NX)=XOPFLS(K,3,NU(NY,NX),NY,NX) - 2+RFLOP(K)+DFVOP(K) - XOAFLS(K,3,NU(NY,NX),NY,NX)=XOAFLS(K,3,NU(NY,NX),NY,NX) - 2+RFLOA(K)+DFVOA(K) 9760 CONTINUE RCOFLS(3,0,NY,NX)=RCOFL0(NY,NX)-RFLCOS-DFVCOS RCHFLS(3,0,NY,NX)=RCHFL0(NY,NX)-RFLCHS-DFVCHS @@ -1486,6 +1481,24 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) RNXFLB(3,NU(NY,NX),NY,NX)=RNXFL2(NY,NX)+RFLN2B+DFVN2B RH1BFB(3,NU(NY,NX),NY,NX)=RH1BF2(NY,NX)+RFLP1B+DFVP1B RH2BFB(3,NU(NY,NX),NY,NX)=RH2BF2(NY,NX)+RFLPOB+DFVPOB + DO 9761 K=0,2 + XOCFLS(K,3,0,NY,NX)=XOCFLS(K,3,0,NY,NX) + 2-RFLOC(K)-DFVOC(K) + XONFLS(K,3,0,NY,NX)=XONFLS(K,3,0,NY,NX) + 2-RFLON(K)-DFVON(K) + XOPFLS(K,3,0,NY,NX)=XOPFLS(K,3,0,NY,NX) + 2-RFLOP(K)-DFVOP(K) + XOAFLS(K,3,0,NY,NX)=XOAFLS(K,3,0,NY,NX) + 2-RFLOA(K)-DFVOA(K) + XOCFLS(K,3,NU(NY,NX),NY,NX)=XOCFLS(K,3,NU(NY,NX),NY,NX) + 2+RFLOC(K)+DFVOC(K) + XONFLS(K,3,NU(NY,NX),NY,NX)=XONFLS(K,3,NU(NY,NX),NY,NX) + 2+RFLON(K)+DFVON(K) + XOPFLS(K,3,NU(NY,NX),NY,NX)=XOPFLS(K,3,NU(NY,NX),NY,NX) + 2+RFLOP(K)+DFVOP(K) + XOAFLS(K,3,NU(NY,NX),NY,NX)=XOAFLS(K,3,NU(NY,NX),NY,NX) + 2+RFLOA(K)+DFVOA(K) +9761 CONTINUE XCOFLS(3,0,NY,NX)=XCOFLS(3,0,NY,NX)-RFLCOS-DFVCOS XCHFLS(3,0,NY,NX)=XCHFLS(3,0,NY,NX)-RFLCHS-DFVCHS XOXFLS(3,0,NY,NX)=XOXFLS(3,0,NY,NX)-RFLOXS-DFVOXS @@ -1677,7 +1690,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) VOLWHS=AMIN1(XFRS*VOLT(NU(NY,NX),NY,NX) 2,VOLWHM(M,NU(NY,NX),NY,NX)) VOLWT=VOLWM(M,NU(NY,NX),NY,NX)+VOLWHS - DO 8835 K=0,2 + DO 8835 K=0,4 DFVOC(K)=XNPX*(AMAX1(0.0,OQCH2(K,NU(NY,NX),NY,NX)) 2*VOLWM(M,NU(NY,NX),NY,NX) 2-AMAX1(0.0,OQC2(K,NU(NY,NX),NY,NX))*VOLWHS)/VOLWT @@ -1758,7 +1771,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 2-AMAX1(0.0,H2POB2(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT 3*VLPOB(NU(NY,NX),NY,NX) ELSE - DO 8935 K=0,2 + DO 8935 K=0,4 DFVOC(K)=0.0 DFVON(K)=0.0 DFVOP(K)=0.0 @@ -1791,14 +1804,6 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) RONFXS(K,NU(NY,NX),NY,NX)=RFLON(K)+DFVON(K) ROPFXS(K,NU(NY,NX),NY,NX)=RFLOP(K)+DFVOP(K) ROAFXS(K,NU(NY,NX),NY,NX)=RFLOA(K)+DFVOA(K) - XOCFXS(K,NU(NY,NX),NY,NX)=XOCFXS(K,NU(NY,NX),NY,NX) - 2+ROCFXS(K,NU(NY,NX),NY,NX) - XONFXS(K,NU(NY,NX),NY,NX)=XONFXS(K,NU(NY,NX),NY,NX) - 2+RONFXS(K,NU(NY,NX),NY,NX) - XOPFXS(K,NU(NY,NX),NY,NX)=XOPFXS(K,NU(NY,NX),NY,NX) - 2+ROPFXS(K,NU(NY,NX),NY,NX) - XOAFXS(K,NU(NY,NX),NY,NX)=XOAFXS(K,NU(NY,NX),NY,NX) - 2+ROAFXS(K,NU(NY,NX),NY,NX) 9940 CONTINUE RCOFXS(NU(NY,NX),NY,NX)=RFLCOS+DFVCOS RCHFXS(NU(NY,NX),NY,NX)=RFLCHS+DFVCHS @@ -1903,7 +1908,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) C IF NO OVERLAND FLOW THEN NO TRANSPORT C IF(QRM(M,N,N5,N4).EQ.0.0)THEN - DO 9840 K=0,2 + DO 9840 K=0,4 RQROC(K,N,N5,N4)=0.0 RQRON(K,N,N5,N4)=0.0 RQROP(K,N,N5,N4)=0.0 @@ -1930,7 +1935,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) ELSE VFLW=XFRX ENDIF - DO 9835 K=0,2 + DO 9835 K=0,4 RQROC(K,N,N5,N4)=VFLW*AMAX1(0.0,OQC2(K,0,N2,N1)) RQRON(K,N,N5,N4)=VFLW*AMAX1(0.0,OQN2(K,0,N2,N1)) RQROP(K,N,N5,N4)=VFLW*AMAX1(0.0,OQP2(K,0,N2,N1)) @@ -1957,7 +1962,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) ELSE VFLW=-XFRX ENDIF - DO 9830 K=0,2 + DO 9830 K=0,4 RQROC(K,N,N5,N4)=VFLW*AMAX1(0.0,OQC2(K,0,N5,N4)) RQRON(K,N,N5,N4)=VFLW*AMAX1(0.0,OQN2(K,0,N5,N4)) RQROP(K,N,N5,N4)=VFLW*AMAX1(0.0,OQP2(K,0,N5,N4)) @@ -1979,7 +1984,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) C C ACCUMULATE HOURLY FLUXES C - DO 9825 K=0,2 + DO 9825 K=0,4 XOCQRS(K,N,N5,N4)=XOCQRS(K,N,N5,N4)+RQROC(K,N,N5,N4) XONQRS(K,N,N5,N4)=XONQRS(K,N,N5,N4)+RQRON(K,N,N5,N4) XOPQRS(K,N,N5,N4)=XOPQRS(K,N,N5,N4)+RQROP(K,N,N5,N4) @@ -3222,10 +3227,11 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) RH1BHB(N,N6,N5,N4)=RFHP1B+DFHP1B RH2BHB(N,N6,N5,N4)=RFHPOB+DFHPOB C IF(M.NE.MX.AND.J.EQ.12)THEN -C WRITE(*,443)'DFVCO2',I,J,N4,N5,N6,M,MM,N +C WRITE(*,443)'RCOFLS',I,J,N4,N5,N6,M,MM,N C 2,RCOFLS(N,N6,N5,N4),RFLCOS,DFVCOS,DIFCS,CCO2S1,CCO2S2 C 3,CLSGL2(N6,N5,N4),TORTL,DISPN,XDPTH(N,N6,N5,N4) -C WRITE(*,443)'DFVOXS',I,J,M,MM,N4,N5,N6,N +C 4,CO2S2(N6,N5,N4),VOLWM(M,N6,N5,N4) +C WRITE(*,443)'ROXFLS',I,J,M,MM,N4,N5,N6,N C 2,ROXFLS(N,N6,N5,N4),RFLOXS,DFVOXS,DIFOS,COXYS1,COXYS2 C 3,OLSGL2(N6,N5,N4),TORTL,DISPN,XDPTH(N,N6,N5,N4) C WRITE(*,443)'RH2PFS',I,J,N4,N5,N6,M,MM,N @@ -3387,20 +3393,21 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) ENDIF C C DIFFUSIVE FLUXES OF SOLUTES BETWEEN MICROPORES AND -C MACROPORES FROM AQUEOUS DIFFUSIVITIES AND CONCENTRATION DIFFERENCES +C MACROPORES FROM AQUEOUS DIFFUSIVITIES AND CONCENTRATION +C DIFFERENCES C IF(VOLWHM(M,N6,N5,N4).GT.ZEROS(N5,N4))THEN VOLWHS=AMIN1(XFRS*VOLT(N6,N5,N4),VOLWHM(M,N6,N5,N4)) VOLWT=VOLWM(M,N6,N5,N4)+VOLWHS - DO 9955 K=0,2 - DFVOC(K)=XNPX*( AMAX1(0.0,OQCH2(K,N6,N5,N4))*VOLWM(M,N6,N5,N4) - 2- AMAX1(0.0,OQC2(K,N6,N5,N4))*VOLWHS)/VOLWT - DFVON(K)=XNPX*( AMAX1(0.0,OQNH2(K,N6,N5,N4))*VOLWM(M,N6,N5,N4) - 2- AMAX1(0.0,OQN2(K,N6,N5,N4))*VOLWHS)/VOLWT - DFVOP(K)=XNPX*( AMAX1(0.0,OQPH2(K,N6,N5,N4))*VOLWM(M,N6,N5,N4) - 2- AMAX1(0.0,OQP2(K,N6,N5,N4))*VOLWHS)/VOLWT - DFVOA(K)=XNPX*( AMAX1(0.0,OQAH2(K,N6,N5,N4))*VOLWM(M,N6,N5,N4) - 2- AMAX1(0.0,OQA2(K,N6,N5,N4))*VOLWHS)/VOLWT + DO 9955 K=0,4 + DFVOC(K)=XNPX*(AMAX1(0.0,OQCH2(K,N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,OQC2(K,N6,N5,N4))*VOLWHS)/VOLWT + DFVON(K)=XNPX*(AMAX1(0.0,OQNH2(K,N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,OQN2(K,N6,N5,N4))*VOLWHS)/VOLWT + DFVOP(K)=XNPX*(AMAX1(0.0,OQPH2(K,N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,OQP2(K,N6,N5,N4))*VOLWHS)/VOLWT + DFVOA(K)=XNPX*(AMAX1(0.0,OQAH2(K,N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,OQA2(K,N6,N5,N4))*VOLWHS)/VOLWT 9955 CONTINUE DFVCOS=XNPX*(AMAX1(0.0,CO2SH2(N6,N5,N4))*VOLWM(M,N6,N5,N4) 2-AMAX1(0.0,CO2S2(N6,N5,N4))*VOLWHS)/VOLWT @@ -3451,7 +3458,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 2-AMAX1(0.0,H2POB2(N6,N5,N4))*VOLWHS)/VOLWT 3*VLPOB(N6,N5,N4) ELSE - DO 9975 K=0,2 + DO 9975 K=0,4 DFVOC(K)=0.0 DFVON(K)=0.0 DFVOP(K)=0.0 @@ -3484,14 +3491,6 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) RONFXS(K,N6,N5,N4)=RFLON(K)+DFVON(K) ROPFXS(K,N6,N5,N4)=RFLOP(K)+DFVOP(K) ROAFXS(K,N6,N5,N4)=RFLOA(K)+DFVOA(K) - XOCFXS(K,N6,N5,N4)=XOCFXS(K,N6,N5,N4) - 2+ROCFXS(K,N6,N5,N4) - XONFXS(K,N6,N5,N4)=XONFXS(K,N6,N5,N4) - 2+RONFXS(K,N6,N5,N4) - XOPFXS(K,N6,N5,N4)=XOPFXS(K,N6,N5,N4) - 2+ROPFXS(K,N6,N5,N4) - XOAFXS(K,N6,N5,N4)=XOAFXS(K,N6,N5,N4) - 2+ROAFXS(K,N6,N5,N4) 9950 CONTINUE RCOFXS(N6,N5,N4)=RFLCOS+DFVCOS RCHFXS(N6,N5,N4)=RFLCHS+DFVCHS @@ -4028,7 +4027,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) C NO RUNOFF C IF(QRM(M,N,M5,M4).EQ.0.0)THEN - DO 9570 K=0,2 + DO 9570 K=0,4 RQROC(K,N,M5,M4)=0.0 RQRON(K,N,M5,M4)=0.0 RQROP(K,N,M5,M4)=0.0 @@ -4058,7 +4057,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) ELSE VFLW=0.0 ENDIF - DO 9540 K=0,2 + DO 9540 K=0,4 RQROC(K,N,M5,M4)=VFLW*AMAX1(0.0,OQC2(K,0,M2,M1)) RQRON(K,N,M5,M4)=VFLW*AMAX1(0.0,OQN2(K,0,M2,M1)) RQROP(K,N,M5,M4)=VFLW*AMAX1(0.0,OQP2(K,0,M2,M1)) @@ -4084,7 +4083,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) C AND BOUNDARY CONDITIONS SET IN SITE FILE C ELSE - DO 9640 K=0,2 + DO 9640 K=0,4 RQROC(K,N,M5,M4)=0.0 RQRON(K,N,M5,M4)=0.0 RQROP(K,N,M5,M4)=0.0 @@ -4116,7 +4115,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) C C ACCUMULATE HOURLY FLUXES C - DO 9565 K=0,2 + DO 9565 K=0,4 XOCQRS(K,N,M5,M4)=XOCQRS(K,N,M5,M4)+RQROC(K,N,M5,M4) XONQRS(K,N,M5,M4)=XONQRS(K,N,M5,M4)+RQRON(K,N,M5,M4) XOPQRS(K,N,M5,M4)=XOPQRS(K,N,M5,M4)+RQROP(K,N,M5,M4) @@ -4440,7 +4439,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) C C TOTAL OVERLAND FLUX C - DO 9550 K=0,2 + DO 9550 K=0,4 TQROC(K,N2,N1)=TQROC(K,N2,N1)+RQROC(K,N,N2,N1)-RQROC(K,N,N5,N4) TQRON(K,N2,N1)=TQRON(K,N2,N1)+RQRON(K,N,N2,N1)-RQRON(K,N,N5,N4) TQROP(K,N2,N1)=TQROP(K,N2,N1)+RQROP(K,N,N2,N1)-RQROP(K,N,N5,N4) @@ -4602,7 +4601,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) C SOIL SURFACE LAYER FROM OVERLAND FLOW AND SURFACE VOLATILIZATION- C DISSOLUTION C - DO 9681 K=0,2 + DO 9681 K=0,4 OQC2(K,0,NY,NX)=OQC2(K,0,NY,NX)+ROCFLS(K,3,0,NY,NX) OQN2(K,0,NY,NX)=OQN2(K,0,NY,NX)+RONFLS(K,3,0,NY,NX) OQP2(K,0,NY,NX)=OQP2(K,0,NY,NX)+ROPFLS(K,3,0,NY,NX) @@ -4628,11 +4627,11 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) ZN3S2(NU(NY,NX),NY,NX)=ZN3S2(NU(NY,NX),NY,NX)+RN3DFS(NY,NX) ZNBS2(NU(NY,NX),NY,NX)=ZNBS2(NU(NY,NX),NY,NX)+RNBDFS(NY,NX) H2GS2(NU(NY,NX),NY,NX)=H2GS2(NU(NY,NX),NY,NX)+RHGDFS(NY,NX) -C WRITE(*,442)'CO2S2',I,J,M,MX,NX,NY,CO2S2(0,NY,NX) +C WRITE(*,442)'CO2S20',I,J,NX,NY,M,MX,CO2S2(0,NY,NX) C 2,CO2S2(NU(NY,NX),NY,NX),RCODFR(NY,NX),RCOFLS(3,0,NY,NX) C 3,RCODFS(NY,NX) 442 FORMAT(A8,6I4,12E12.4) - DO 9680 K=0,2 + DO 9680 K=0,4 OQC2(K,0,NY,NX)=OQC2(K,0,NY,NX)+TQROC(K,NY,NX) OQN2(K,0,NY,NX)=OQN2(K,0,NY,NX)+TQRON(K,NY,NX) OQP2(K,0,NY,NX)=OQP2(K,0,NY,NX)+TQROP(K,NY,NX) @@ -4650,7 +4649,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) ZNO2S2(0,NY,NX)=ZNO2S2(0,NY,NX)+TQRNO2(NY,NX) H1PO42(0,NY,NX)=H1PO42(0,NY,NX)+TQRH1P(NY,NX) H2PO42(0,NY,NX)=H2PO42(0,NY,NX)+TQRH2P(NY,NX) -C IF(I.EQ.87)THEN +C IF(I.LE.90.AND.J.EQ.14)THEN C WRITE(*,8787)'CH4S20',I,J,NX,NY,M,MM,CH4S2(0,NY,NX) C 2,RCHDFR(NY,NX),RCHFLS(3,0,NY,NX),RCHSK2(0,NY,NX) C 3,TQRCHS(NY,NX),RCHDFG(0,NY,NX),XCHFLS(3,0,NY,NX) @@ -4770,8 +4769,8 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) ZN3G2(L,NY,NX)=ZN3G2(L,NY,NX)+TN3FLG(L,NY,NX)-RN3DFG(L,NY,NX) 2-RNBDFG(L,NY,NX) H2GG2(L,NY,NX)=H2GG2(L,NY,NX)+THGFLG(L,NY,NX)-RHGDFG(L,NY,NX) -C IF(J.EQ.12)THEN -C WRITE(*,444)'CO2S2',I,J,M,MM,NX,NY,L +C IF(L.EQ.NU(NY,NX))THEN +C WRITE(*,444)'CO2S2',I,J,NX,NY,L,M,MM C 2,CO2S2(L,NY,NX),TCOFLS(L,NY,NX),RCOFXS(L,NY,NX) C 2,RCOFLZ(L,NY,NX),RCOBBL(L,NY,NX),RCODFG(L,NY,NX) C 2,CO2S(L,NY,NX),RCOSK2(L,NY,NX),TQRCOS(NY,NX) diff --git a/f77src/watsub.f b/f77src/watsub.f index 4b53735..c6889e2 100755 --- a/f77src/watsub.f +++ b/f77src/watsub.f @@ -70,7 +70,7 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) 6,DNUSA=(1.0+(0.492/PRNTA)**0.5625)**0.4444 7,TRBW=0.375,TRBA=0.000) PARAMETER (NPR=10,XNPR=1.0/NPR,FHFLX=0.67 - 2,FVOLAH=0.0,PSISX=-0.5,PSISXR=-0.5,HYGR=-250.0 + 2,FVOLAH=0.0,PSISX=-0.5,PSISXR=-0.5 3,DTHETW=1.0E-06,HCNDRR=25.0) REAL*4 RI,THETWR,THETW1,THETA1,THETAL,THETWL 2,TKR1,TKS1,TKY,TKW1,TK11,TK12,TK0X,TKXR,TK1X,TKX1,TFND1 @@ -553,8 +553,8 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) ELSE DFGS(M,0,NY,NX)=0.0 ENDIF - IF(VOLR(NY,NX).GT.ZEROS(NY,NX))THEN - THETWT=VOLWM(M,0,NY,NX)/VOLR(NY,NX) + IF(VOLT(0,NY,NX).GT.ZEROS(NY,NX))THEN + THETWT=VOLWM(M,0,NY,NX)/VOLT(0,NY,NX) ELSE THETWT=0.0 ENDIF @@ -660,7 +660,7 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) 2,VOLW1(NU(NY,NX),NY,NX)/VOLX(NU(NY,NX),NY,NX))) C IF(BKVL(NU(NY,NX),NY,NX).GT.0.0)THEN IF(THETW1.LT.FC(NU(NY,NX),NY,NX))THEN - PSISM1(NU(NY,NX),NY,NX)=AMAX1(HYGR,-EXP(PSIMX(NY,NX) + PSISM1(NU(NY,NX),NY,NX)=AMAX1(PSIHY,-EXP(PSIMX(NY,NX) 2+((FCL(NU(NY,NX),NY,NX)-LOG(THETW1)) 3/FCD(NU(NY,NX),NY,NX)*PSIMD(NY,NX)))) ELSEIF(THETW1.LT.POROS(NU(NY,NX),NY,NX)-DTHETW)THEN @@ -677,7 +677,7 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) C C SNOWPACK ALBEDO, NET RADIATION C - ALBW=(0.85*VOLS0(NY,NX)+0.30*VOLI0(NY,NX)+0.06*VOLW0(NY,NX)) + ALBW=(0.80*VOLS0(NY,NX)+0.30*VOLI0(NY,NX)+0.06*VOLW0(NY,NX)) 2/(VOLS0(NY,NX)+VOLI0(NY,NX)+VOLW0(NY,NX)) FSNOW=AMIN1(1.0,(DPTHS0(NY,NX)/DPTHSX)**2) ALBG=FSNOW*ALBW+(1.0-FSNOW)*ALBS(NY,NX) @@ -1051,7 +1051,7 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) THETW1=AMAX1(THETY(NU(NY,NX),NY,NX),AMIN1(POROS(NU(NY,NX),NY,NX) 2,VOLW1(NU(NY,NX),NY,NX)/VOLX(NU(NY,NX),NY,NX))) IF(THETW1.LT.FC(NU(NY,NX),NY,NX))THEN - PSISM1(NU(NY,NX),NY,NX)=AMAX1(HYGR,-EXP(PSIMX(NY,NX) + PSISM1(NU(NY,NX),NY,NX)=AMAX1(PSIHY,-EXP(PSIMX(NY,NX) 2+((FCL(NU(NY,NX),NY,NX)-LOG(THETW1)) 3/FCD(NU(NY,NX),NY,NX)*PSIMD(NY,NX)))) ELSEIF(THETW1.LT.POROS(NU(NY,NX),NY,NX)-DTHETW)THEN @@ -1868,24 +1868,24 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) C C CALCULATE CHANGE IN THICKNESS OF ICE LAYER C - IF(BKDS(L,NY,NX).EQ.0.0)THEN +C IF(BKDS(L,NY,NX).EQ.0.0)THEN C 2.AND.CDPTH(L-1,NY,NX).LT.DPTHA(NY,NX))THEN - DDLYR=AMIN1(DLYR(3,L,NY,NX),(VOLA(L,NY,NX)-(VOLW1(L,NY,NX) - 2+VOLI1(L,NY,NX)))/AREA(3,L,NY,NX)) - IF(DLYR(3,L,NY,NX).GT.1.0E-03.OR.DDLYR.LT.0.0)THEN - DO 900 LL=NU(NY,NX),L - CDPTH(LL-1,NY,NX)=CDPTH(LL-1,NY,NX)+DDLYR +C DDLYR=AMIN1(DLYR(3,L,NY,NX),(VOLA(L,NY,NX)-(VOLW1(L,NY,NX) +C 2+VOLI1(L,NY,NX)))/AREA(3,L,NY,NX)) +C IF(DLYR(3,L,NY,NX).GT.1.0E-03.OR.DDLYR.LT.0.0)THEN +C DO 900 LL=NU(NY,NX),L +C CDPTH(LL-1,NY,NX)=CDPTH(LL-1,NY,NX)+DDLYR 900 CONTINUE - DO 905 LL=NU(NY,NX),L - DPTH(LL,NY,NX)=0.5*(CDPTH(LL,NY,NX)+CDPTH(LL-1,NY,NX)) - YDPTH(LL,NY,NX)=ALT(NY,NX)-DPTH(LL,NY,NX) +C DO 905 LL=NU(NY,NX),L +C DPTH(LL,NY,NX)=0.5*(CDPTH(LL,NY,NX)+CDPTH(LL-1,NY,NX)) +C YDPTH(LL,NY,NX)=ALT(NY,NX)-DPTH(LL,NY,NX) 905 CONTINUE - DLYR(3,L,NY,NX)=(CDPTH(L,NY,NX)-CDPTH(L-1,NY,NX)) - VOLT(L,NY,NX)=AREA(3,L,NY,NX)*DLYR(3,L,NY,NX) - VOLX(L,NY,NX)=VOLT(L,NY,NX)*FMPR(L,NY,NX) - VOLA(L,NY,NX)=POROS(L,NY,NX)*VOLX(L,NY,NX) - VOLP1(L,NY,NX)=AMAX1(0.0,VOLA(L,NY,NX)-VOLW1(L,NY,NX) - 2-VOLI1(L,NY,NX)) +C DLYR(3,L,NY,NX)=(CDPTH(L,NY,NX)-CDPTH(L-1,NY,NX)) +C VOLT(L,NY,NX)=AREA(3,L,NY,NX)*DLYR(3,L,NY,NX) +C VOLX(L,NY,NX)=VOLT(L,NY,NX)*FMPR(L,NY,NX) +C VOLA(L,NY,NX)=POROS(L,NY,NX)*VOLX(L,NY,NX) +C VOLP1(L,NY,NX)=AMAX1(0.0,VOLA(L,NY,NX)-VOLW1(L,NY,NX) +C 2-VOLI1(L,NY,NX)) C IF((I/5)*5.EQ.I.AND.J.EQ.15.AND.BKDS(L,NY,NX).EQ.0.0)THEN C WRITE(*,910)'DDLYR',I,J,L,M,L,DDLYR,VOLW1(L,NY,NX) C 2,VOLI1(L,NY,NX),VOLA(L,NY,NX),CDPTH(L-1,NY,NX) @@ -1893,10 +1893,10 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) C 4,VOLP1(L,NY,NX) 910 FORMAT(A8,5I4,12E16.8) C ENDIF - ENDIF - ENDIF +C ENDIF +C ENDIF C -C END THICKNESS +C END CHANGE IN THICKNESS C N1=NX N2=NY @@ -1954,9 +1954,9 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) 2,VOLW1(N3,N2,N1)/VOLX(N3,N2,N1))) THETAL=AMAX1(THETY(N6,N5,N4),AMIN1(POROS(N6,N5,N4) 2,VOLW1(N6,N5,N4)/VOLX(N6,N5,N4))) -C IF(BKVL(N3,N2,N1).GT.0.0)THEN +C IF(BKVL(N3,N2,N1).GT.ZERO)THEN IF(THETA1.LT.FC(N3,N2,N1))THEN - PSISA1=AMAX1(HYGR,-EXP(PSIMX(N2,N1) + PSISA1=AMAX1(PSIHY,-EXP(PSIMX(N2,N1) 2+((FCL(N3,N2,N1)-LOG(THETA1)) 3/FCD(N3,N2,N1)*PSIMD(N2,N1)))) ELSEIF(THETA1.LT.POROS(N3,N2,N1)-DTHETW)THEN @@ -1969,9 +1969,9 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) C ELSE C PSISA1=PSISE(N3,N2,N1) C ENDIF -C IF(BKVL(N6,N5,N4).GT.0.0)THEN +C IF(BKVL(N6,N5,N4).GT.ZERO)THEN IF(THETAL.LT.FC(N6,N5,N4))THEN - PSISAL=AMAX1(HYGR,-EXP(PSIMX(N5,N4) + PSISAL=AMAX1(PSIHY,-EXP(PSIMX(N5,N4) 2+((FCL(N6,N5,N4)-LOG(THETAL)) 3/FCD(N6,N5,N4)*PSIMD(N5,N4)))) ELSEIF(THETAL.LT.POROS(N6,N5,N4)-DTHETW)THEN @@ -2026,9 +2026,9 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) CND1=HCND(N,1,N3,N2,N1)*XNPH CNDL=HCND(N,1,N6,N5,N4)*XNPH PSISM1(N3,N2,N1)=PSISA1 -C IF(BKVL(N6,N5,N4).GT.0.0)THEN +C IF(BKVL(N6,N5,N4).GT.ZERO)THEN IF(THETWL.LT.FC(N6,N5,N4))THEN - PSISM1(N6,N5,N4)=AMAX1(HYGR,-EXP(PSIMX(N5,N4) + PSISM1(N6,N5,N4)=AMAX1(PSIHY,-EXP(PSIMX(N5,N4) 2+((FCL(N6,N5,N4)-LOG(THETWL)) 3/FCD(N6,N5,N4)*PSIMD(N5,N4)))) ELSEIF(THETWL.LT.POROS(N6,N5,N4)-DTHETW)THEN @@ -2051,9 +2051,9 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) THETWL=THETAL CND1=HCND(N,1,N3,N2,N1)*XNPH CNDL=HCND(N,1,N6,N5,N4)*XNPH -C IF(BKVL(N3,N2,N1).GT.0.0)THEN +C IF(BKVL(N3,N2,N1).GT.ZERO)THEN IF(THETW1.LT.FC(N3,N2,N1))THEN - PSISM1(N3,N2,N1)=AMAX1(HYGR,-EXP(PSIMX(N2,N1) + PSISM1(N3,N2,N1)=AMAX1(PSIHY,-EXP(PSIMX(N2,N1) 2+((FCL(N3,N2,N1)-LOG(THETW1)) 3/FCD(N3,N2,N1)*PSIMD(N2,N1)))) ELSEIF(THETW1.LT.POROS(N3,N2,N1)-DTHETW)THEN @@ -2247,20 +2247,20 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) HWFLWL=HWFLQL+HWFLVL FLWL(N,N6,N5,N4)=FLQL+FLVL FLWLX(N,N6,N5,N4)=FLQ2+FLVL -C IF(J.EQ.15/)THEN -C WRITE(*,1115)'FLWL',I,J,M,N4,N5,N6,N,K1,KL,FLWL(N,N3,N2,N1) +C IF(N3.EQ.NU(NY,NX))THEN +C WRITE(*,1115)'FLWL',I,J,M,N4,N5,N6,N,FLWL(N,N3,N2,N1) C 2,FLWL(N,N6,N5,N4),FLQL,FLVL,FLQX,FLVX,HFLWX,FLWLY,FLWHY C 3,CND1,CNDL,AVCNDL,AVCNVL,VP1,VPL,PSIST1,PSISTL C 4,UAG,VOLA(N6,N5,N4),VOLI1(N6,N5,N4),SCNV(N6,N5,N4),THETP1 -C 5,THETPL,VOLPX1(N3,N2,N1),VOLPX1(N6,N5,N4) +C 5,THETPL,VOLPX1(N3,N2,N1),VOLPX1(N6,N5,N4),TKY C 7,TK1(N3,N2,N1),TK1(N6,N5,N4),VOLT(N3,N2,N1),VOLT(N6,N5,N4) C 8,VOLW1(N6,N5,N4),VOLP1(N6,N5,N4),VOLX(N6,N5,N4),VOLW1(N3,N2,N1) C 9,VOLP1(N3,N2,N1),VOLX(N3,N2,N1),POROS(N6,N5,N4),POROS(N3,N2,N1) C 6,THETW1,THETWL,THETK1,THETKL,PSISA1,PSISAL,PSISM1(N3,N2,N1) C 7,PSISM1(N6,N5,N4),PSISH(N3,N2,N1),PSISH(N6,N5,N4) -C 8,DLYR(N,N3,N2,N1),DLYR(N,N6,N5,N4) -C 8,AREA(N,N3,N2,N1) -1115 FORMAT(A8,9I4,60E12.4) +C 8,DLYR(N,N3,N2,N1),DLYR(N,N6,N5,N4),AREA(N,N3,N2,N1) +C 9,VHCP1(N3,N2,N1),VHCP1(N6,N5,N4),POROS(N6,N5,N4),THETAL +1115 FORMAT(A8,7I4,60E12.4) C ENDIF C C THERMAL CONDUCTIVITY diff --git a/f77src/wouts.f b/f77src/wouts.f index 5aba849..61b7fdc 100755 --- a/f77src/wouts.f +++ b/f77src/wouts.f @@ -78,7 +78,6 @@ SUBROUTINE wouts(I,NHW,NHE,NVN,NVS) 1,H3PO4W(NY,NX),ZFE1PW(NY,NX),ZFE2PW(NY,NX) 2,ZCA0PW(NY,NX),ZCA1PW(NY,NX),ZCA2PW(NY,NX),ZMG1PW(NY,NX) ENDIF - WRITE(21,94)I,IDATA(3),(NHOL(L,NY,NX),L=1,NL(NY,NX)) WRITE(21,91)I,IDATA(3),(FHOL(L,NY,NX),L=1,NL(NY,NX)) WRITE(21,91)I,IDATA(3),(DLYR(3,L,NY,NX),L=0,NL(NY,NX)) WRITE(21,91)I,IDATA(3),(CDPTH(L,NY,NX),L=0,NL(NY,NX)) @@ -88,8 +87,8 @@ SUBROUTINE wouts(I,NHW,NHE,NVN,NVS) WRITE(21,91)I,IDATA(3),(POROQ(L,NY,NX),L=1,NL(NY,NX)) WRITE(21,91)I,IDATA(3),(FC(L,NY,NX),L=1,NL(NY,NX)) WRITE(21,91)I,IDATA(3),(WP(L,NY,NX),L=1,NL(NY,NX)) -C WRITE(21,91)I,IDATA(3),(SCNV(L,NY,NX),L=1,NL(NY,NX)) -C WRITE(21,91)I,IDATA(3),(SCNH(L,NY,NX),L=1,NL(NY,NX)) + WRITE(21,91)I,IDATA(3),(SCNV(L,NY,NX),L=1,NL(NY,NX)) + WRITE(21,91)I,IDATA(3),(SCNH(L,NY,NX),L=1,NL(NY,NX)) WRITE(21,91)I,IDATA(3),(SAND(L,NY,NX),L=1,NL(NY,NX)) WRITE(21,91)I,IDATA(3),(SILT(L,NY,NX),L=1,NL(NY,NX)) WRITE(21,91)I,IDATA(3),(CLAY(L,NY,NX),L=1,NL(NY,NX)) @@ -391,11 +390,10 @@ SUBROUTINE wouts(I,NHW,NHE,NVN,NVS) WRITE(22,91)I,IDATA(3),(DPNOB(L,NY,NX),L=1,NL(NY,NX)) WRITE(22,91)I,IDATA(3),(WDPOB(L,NY,NX),L=1,NL(NY,NX)) WRITE(22,91)I,IDATA(3),(DPPOB(L,NY,NX),L=1,NL(NY,NX)) - WRITE(22,91)I,IDATA(3),(ZNHUI(L,NY,NX),L=1,NL(NY,NX)) - WRITE(22,91)I,IDATA(3),(ZNHU0(L,NY,NX),L=1,NL(NY,NX)) - WRITE(22,91)I,IDATA(3),(ZNFNI(L,NY,NX),L=1,NL(NY,NX)) - WRITE(22,91)I,IDATA(3),(ZNFNG(L,NY,NX),L=1,NL(NY,NX)) - WRITE(22,91)I,IDATA(3),(ZNFN0(L,NY,NX),L=1,NL(NY,NX)) + WRITE(22,91)I,IDATA(3),(ZNHUI(L,NY,NX),L=0,NL(NY,NX)) + WRITE(22,91)I,IDATA(3),(ZNHU0(L,NY,NX),L=0,NL(NY,NX)) + WRITE(22,91)I,IDATA(3),(ZNFNI(L,NY,NX),L=0,NL(NY,NX)) + WRITE(22,91)I,IDATA(3),(ZNFN0(L,NY,NX),L=0,NL(NY,NX)) 9990 CONTINUE 9995 CONTINUE 90 FORMAT(2I4,15E17.8E3,/,15E17.8E3,/,15E17.8E3 @@ -405,7 +403,6 @@ SUBROUTINE wouts(I,NHW,NHE,NVN,NVS) 2,/,15E17.8E3,/,15E17.8E3,/,15E17.8E3) 93 FORMAT(8I4,15E17.8E3,/,15E17.8E3,/,15E17.8E3,/,15E17.8E3 2,/,15E17.8E3,/,15E17.8E3,/,15E17.8E3,/,15E17.8E3,/,15E17.8E3) -94 FORMAT(2I4,21I17) 95 FORMAT(2I4,15E17.8E3,/,15E17.8E3,/,15E17.8E3,/,15E17.8E3 2,/,15E17.8E3,/,15E17.8E3,/,15E17.8E3,/,15E17.8E3) RETURN diff --git a/f77src/wthr.f b/f77src/wthr.f index 494956f..f214783 100755 --- a/f77src/wthr.f +++ b/f77src/wthr.f @@ -79,8 +79,8 @@ SUBROUTINE wthr(I,J,NHW,NHE,NVN,NVS) TCA(NY,NX)=TAVG3+AMP3*SIN(((J-ZNOON(NY,NX)-3.0)*3.1416 2/(ZNOON(NY,NX)+9.0-DYLN(NY,NX)/2.0))+1.5708) ELSE - TCA(NY,NX)=TAVG2+AMP2*SIN(((J-(ZNOON(NY,NX)-DYLN(NY,NX)/2.0))*3.1416 - 2/(3.0+DYLN(NY,NX)/2.0))-1.5708) + TCA(NY,NX)=TAVG2+AMP2*SIN(((J-(ZNOON(NY,NX) + 2-DYLN(NY,NX)/2.0))*3.1416/(3.0+DYLN(NY,NX)/2.0))-1.5708) ENDIF TKA(NY,NX)=TCA(NY,NX)+273.15 IF(J.LT.(ZNOON(NY,NX)-DYLN(NY,NX)/2))THEN @@ -90,8 +90,8 @@ SUBROUTINE wthr(I,J,NHW,NHE,NVN,NVS) VPK(NY,NX)=VAVG3+VMP3*SIN(((J-ZNOON(NY,NX)-3.0)*3.1416 2/(ZNOON(NY,NX)+9.0-DYLN(NY,NX)/2.0))+1.5708) ELSE - VPK(NY,NX)=VAVG2+VMP2*SIN(((J-(ZNOON(NY,NX)-DYLN(NY,NX)/2.0))*3.1416 - 2/(3.0+DYLN(NY,NX)/2.0))-1.5708) + VPK(NY,NX)=VAVG2+VMP2*SIN(((J-(ZNOON(NY,NX) + 2-DYLN(NY,NX)/2.0))*3.1416 /(3.0+DYLN(NY,NX)/2.0))-1.5708) ENDIF VPS(NY,NX)=0.61*EXP(5360.0*(3.661E-03-1.0/TKA(NY,NX))) 2*EXP(-ALTI(NY,NX)/7272.0) @@ -159,7 +159,7 @@ SUBROUTINE wthr(I,J,NHW,NHE,NVN,NVS) C RADZ=AMIN1(RADN(NY,NX),0.5*(RADX-RADN(NY,NX))) RADS(NY,NX)=(RADN(NY,NX)-RADZ)/SSIN(NY,NX) - IF(IETYP(NY,NX).GE.-1)RADS(NY,NX)=AMIN1(4.167,RADS(NY,NX)) + RADS(NY,NX)=AMIN1(4.167,RADS(NY,NX)) RADY(NY,NX)=RADZ/TYSIN RAPS(NY,NX)=RADS(NY,NX)*CDIR*PDIR RAPY(NY,NX)=RADY(NY,NX)*CDIF*PDIF @@ -288,9 +288,8 @@ SUBROUTINE wthr(I,J,NHW,NHE,NVN,NVS) ATCA(NY,NX)=ATCAI(NY,NX)+DTA ATCS(NY,NX)=ATCAI(NY,NX)+DTS OFFSET(NY,NX)=0.33*(12.5-AMAX1(0.0,AMIN1(25.0,ATCS(NY,NX)))) -C OFFSET(NY,NX)=OFFSET(NY,NX)+0.11*AMAX1(0.0,0.0-ATCS(NY,NX)) DO 9900 NZ=1,NP(NY,NX) - ZTYP(NZ,NY,NX)=ZTYPI(NZ,NY,NX)+0.33/2.667*DTA + ZTYP(NZ,NY,NX)=ZTYPI(NZ,NY,NX)+0.30/2.667*DTA OFFST(NZ,NY,NX)=2.667*(2.5-ZTYP(NZ,NY,NX)) C TCZ(NZ,NY,NX)=TCZD-OFFST(NZ,NY,NX) C TCX(NZ,NY,NX)=AMIN1(15.0,TCZ(NZ,NY,NX)+TCXD) @@ -299,15 +298,17 @@ SUBROUTINE wthr(I,J,NHW,NHE,NVN,NVS) ELSE HTC(NZ,NY,NX)=30.0+3.0*ZTYP(NZ,NY,NX) ENDIF - GROUPI(NZ,NY,NX)=GROUPX(NZ,NY,NX)+0.33*DTA + GROUPI(NZ,NY,NX)=GROUPX(NZ,NY,NX)+0.30*DTA IF(IBTYP(NZ,NY,NX).NE.0)THEN GROUPI(NZ,NY,NX)=GROUPI(NZ,NY,NX)/25.0 ENDIF GROUPI(NZ,NY,NX)=GROUPI(NZ,NY,NX)-XTLI(NZ,NY,NX) -C WRITE(*,1111)'OFFSET',I,J,NZ,OFFSET(NY,NX),OFFST(NZ,NY,NX) -C 2,DTA,DTS,ATCA(NY,NX),ATCS(NY,NX),ZTYP(NZ,NY,NX) -C 3,GROUPI(NZ,NY,NX) -1111 FORMAT(A8,3I4,12E12.4) + IF(I.EQ.180)THEN + WRITE(*,1111)'OFFSET',IYRC,I,J,NZ,N,OFFSET(NY,NX),OFFST(NZ,NY,NX) + 2,DTA,DTS,ATCA(NY,NX),ATCS(NY,NX),ZTYP(NZ,NY,NX) + 3,GROUPI(NZ,NY,NX),TDTPX(NY,NX,N),TDTPN(NY,NX,N) +1111 FORMAT(A8,5I4,12E12.4) + ENDIF 9900 CONTINUE ENDIF ENDIF