From 4040c7f48780fb7ebfd112a67315df00e6e74db2 Mon Sep 17 00:00:00 2001 From: Jinyun Tang Date: Sun, 28 Oct 2018 18:52:21 -0700 Subject: [PATCH 1/2] code update from robert This includes update for organic N&P uptake and some update in snow and crops. --- f77src/blk10.h | 2 +- f77src/blk11b.h | 4 +- f77src/blk12b.h | 29 +- f77src/blk13d.h | 1 + f77src/blk18a.h | 33 +- f77src/blk2a.h | 6 +- f77src/day.f | 85 +- f77src/extract.f | 8 +- f77src/foutp.f | 2 +- f77src/fouts.f | 2 +- f77src/grosub.f | 15027 +++++++++++++++++++++++---------------------- f77src/hfunc.f | 1334 ++-- f77src/hour1.f | 53 +- f77src/main.f | 10 +- f77src/nitro.f | 5555 ++++++++--------- f77src/outpd.f | 2 +- f77src/outph.f | 2 +- f77src/readi.f | 952 +-- f77src/reads.f | 16 +- f77src/redist.f | 11236 ++++++++++++++++----------------- f77src/routs.f | 2 +- f77src/soil.f | 10 +- f77src/solute.f | 9230 ++++++++++++++-------------- f77src/splitc.f | 11 +- f77src/startq.f | 1472 ++--- f77src/starts.f | 2490 ++++---- f77src/stomate.f | 756 ++- f77src/trnsfr.f | 9210 ++++++++++++++------------- f77src/trnsfrs.f | 12 +- f77src/uptake.f | 109 +- f77src/watsub.f | 6162 ++++++++++--------- f77src/wouts.f | 2 +- 32 files changed, 31920 insertions(+), 31905 deletions(-) diff --git a/f77src/blk10.h b/f77src/blk10.h index 6467be0..6145600 100755 --- a/f77src/blk10.h +++ b/f77src/blk10.h @@ -4,4 +4,4 @@ 4,HYSM(60,JZ,JY,JX),FILM(60,0:JZ,JY,JX),QRV(60,2,JV,JH) 5,VOLGM(60,JY,JX),DFGS(60,0:JZ,JY,JX),ROXSK(60,0:JZ,JY,JX) 6,FLWRM(60,JY,JX),FLPM(60,JZ,JY,JX),FINHM(60,JZ,JY,JX) - 7,THETPM(60,0:JZ,JY,JX) + 7,THETPM(60,0:JZ,JY,JX),TORT(60,0:JZ,JY,JX),TORTH(60,JZ,JY,JX) diff --git a/f77src/blk11b.h b/f77src/blk11b.h index 81a4430..8878014 100755 --- a/f77src/blk11b.h +++ b/f77src/blk11b.h @@ -6,7 +6,7 @@ 6,SCO2L(0:JZ,JY,JX),SOXYL(0:JZ,JY,JX),SCH4L(0:JZ,JY,JX) 7,SN2OL(0:JZ,JY,JX),SN2GL(0:JZ,JY,JX),SNH3L(0:JZ,JY,JX) 8,SH2GL(0:JZ,JY,JX),PSISE(0:JZ,JY,JX),PSISA(JZ,JY,JX) - 9,PSISO(JZ,JY,JX),PSISH(JZ,JY,JX),THETX,TORTH(JZ,JY,JX) + 9,PSISO(JZ,JY,JX),PSISH(JZ,JY,JX),THETX 1,THETY(0:JZ,JY,JX),FCR(JY,JX),VOLQ(0:JZ,JY,JX) 2,TFNQ(0:JZ,JY,JX),HGSGL(JZ,JY,JX),HLSGL(0:JZ,JY,JX) - 3,TORT(0:JZ,JY,JX),THAWR(JY,JX),HTHAWR(JY,JX) + 3,THAWR(JY,JX),HTHAWR(JY,JX) diff --git a/f77src/blk12b.h b/f77src/blk12b.h index e9d2066..7877c68 100755 --- a/f77src/blk12b.h +++ b/f77src/blk12b.h @@ -1,14 +1,15 @@ - COMMON/BLK12B/RUPNH4(2,JZ,JP,JY,JX),RUPNHB(2,JZ,JP,JY,JX) - 2,RUPNO3(2,JZ,JP,JY,JX),RUPNOB(2,JZ,JP,JY,JX),RUPH2P(2,JZ,JP,JY,JX) - 3,RUPH2B(2,JZ,JP,JY,JX),RUONH4(2,JZ,JP,JY,JX),RUONHB(2,JZ,JP,JY,JX) - 4,RUONO3(2,JZ,JP,JY,JX),RUONOB(2,JZ,JP,JY,JX),RUOH2P(2,JZ,JP,JY,JX) - 5,RUOH2B(2,JZ,JP,JY,JX),RUCNH4(2,JZ,JP,JY,JX),RUCNHB(2,JZ,JP,JY,JX) - 6,RUCNO3(2,JZ,JP,JY,JX),RUCNOB(2,JZ,JP,JY,JX),RUCH2P(2,JZ,JP,JY,JX) - 7,RUCH2B(2,JZ,JP,JY,JX),RUPNF(JZ,JP,JY,JX),RUPHGS(2,JZ,JP,JY,JX) - 1,VOLWP(JP,JY,JX),RCO2N(2,JZ,JP,JY,JX),RDFOMC(2,JZ,JP,JY,JX) - 2,RDFOMN(2,JZ,JP,JY,JX),RDFOMP(2,JZ,JP,JY,JX),WFR(2,JZ,JP,JY,JX) - 4,RUNNHP(2,JZ,JP,JY,JX),RUNNOP(2,JZ,JP,JY,JX),RUPPOP(2,JZ,JP,JY,JX) - 5,RUNNBP(2,JZ,JP,JY,JX),RUNNXP(2,JZ,JP,JY,JX),RUPPBP(2,JZ,JP,JY,JX) - 6,RNH3Z(JP,JY,JX),RNH3B(JC,JP,JY,JX) - 7,RHGFLA(2,JZ,JP,JY,JX),RHGDFA(2,JZ,JP,JY,JX),H2GA(2,JZ,JP,JY,JX) - 8,H2GP(2,JZ,JP,JY,JX),RH2GZ(JP,JY,JX) + COMMON/BLK12B/RUPNH4(2,JZ,JP,JY,JX),RUPNHB(2,JZ,JP,JY,JX) + 2,RUPNO3(2,JZ,JP,JY,JX),RUPNOB(2,JZ,JP,JY,JX),RUPH2P(2,JZ,JP,JY,JX) + 3,RUPH2B(2,JZ,JP,JY,JX),RUONH4(2,JZ,JP,JY,JX),RUONHB(2,JZ,JP,JY,JX) + 4,RUONO3(2,JZ,JP,JY,JX),RUONOB(2,JZ,JP,JY,JX),RUOH2P(2,JZ,JP,JY,JX) + 5,RUOH2B(2,JZ,JP,JY,JX),RUCNH4(2,JZ,JP,JY,JX),RUCNHB(2,JZ,JP,JY,JX) + 6,RUCNO3(2,JZ,JP,JY,JX),RUCNOB(2,JZ,JP,JY,JX),RUCH2P(2,JZ,JP,JY,JX) + 7,RUCH2B(2,JZ,JP,JY,JX),RUPNF(JZ,JP,JY,JX),RUPHGS(2,JZ,JP,JY,JX) + 1,VOLWP(JP,JY,JX),RCO2N(2,JZ,JP,JY,JX),RDFOMC(2,0:4,JZ,JP,JY,JX) + 2,RDFOMN(2,0:4,JZ,JP,JY,JX),RDFOMP(2,0:4,JZ,JP,JY,JX) + 4,RUNNHP(2,JZ,JP,JY,JX),RUNNOP(2,JZ,JP,JY,JX),RUPPOP(2,JZ,JP,JY,JX) + 5,RUNNBP(2,JZ,JP,JY,JX),RUNNXP(2,JZ,JP,JY,JX),RUPPBP(2,JZ,JP,JY,JX) + 6,RNH3Z(JP,JY,JX),RNH3B(JC,JP,JY,JX),WFR(2,JZ,JP,JY,JX) + 7,RHGFLA(2,JZ,JP,JY,JX),RHGDFA(2,JZ,JP,JY,JX),H2GA(2,JZ,JP,JY,JX) + 8,H2GP(2,JZ,JP,JY,JX),RH2GZ(JP,JY,JX) + diff --git a/f77src/blk13d.h b/f77src/blk13d.h index 4c885ed..e938301 100755 --- a/f77src/blk13d.h +++ b/f77src/blk13d.h @@ -1 +1,2 @@ COMMON/BLK13D/COQC(0:4,0:JZ,JY,JX),COQA(0:4,0:JZ,JY,JX) + 2,FOSRH(0:4,0:JZ,JY,JX) diff --git a/f77src/blk18a.h b/f77src/blk18a.h index 023ae58..1493e18 100755 --- a/f77src/blk18a.h +++ b/f77src/blk18a.h @@ -1,16 +1,17 @@ - COMMON/BLK18/ARLFC(JY,JX),ARSTC(JY,JX),TEVAPP(JY,JX),TEVAPC(JY,JX) - 2,TENGYC(JY,JX),THFLXC(JY,JX),TUPWTR(0:JZ,JY,JX),TUPHT(0:JZ,JY,JX) - 3,TVOLWP(JY,JX),TCOFLA(JZ,JY,JX),TOXFLA(JZ,JY,JX),TCHFLA(JZ,JY,JX) - 4,TN2FLA(JZ,JY,JX),TNHFLA(JZ,JY,JX),TLCO2P(JZ,JY,JX),GPP(JY,JX) - 5,TLOXYP(JZ,JY,JX),TLCH4P(JZ,JY,JX),TLN2OP(JZ,JY,JX),RECO(JY,JX) - 6,TLNH3P(JZ,JY,JX),TCO2S(JZ,JY,JX),TUPOXS(JZ,JY,JX) - 7,TUPCHS(JZ,JY,JX),TUPN2S(JZ,JY,JX),TUPN3S(JZ,JY,JX) - 8,TUPNH4(JZ,JY,JX),TUPNO3(JZ,JY,JX),TUPH2P(JZ,JY,JX) - 9,TUPN3B(JZ,JY,JX),TUPNHB(JZ,JY,JX),TUPNOB(JZ,JY,JX) - 1,TUPH2B(JZ,JY,JX),TUPNF(JZ,JY,JX),CSNT(4,0:1,0:JZ,JY,JX) - 2,ZSNT(4,0:1,0:JZ,JY,JX),PSNT(4,0:1,0:JZ,JY,JX),TDFOMC(0:JZ,JY,JX) - 3,TDFOMN(0:JZ,JY,JX),TDFOMP(0:JZ,JY,JX),TCO2Z(JY,JX),TOXYZ(JY,JX) - 4,TCH4Z(JY,JX),TN2OZ(JY,JX),TNH3Z(JY,JX),RTDNT(JZ,JY,JX) - 5,TCO2P(JZ,JY,JX),TUPOXP(JZ,JY,JX),THRMC(JY,JX),TCNET(JY,JX) - 6,ZCSNC(JY,JX),ZZSNC(JY,JX),ZPSNC(JY,JX),WGLFT(JC,JY,JX) - 7,ARLFT(JC,JY,JX),ARSTT(JC,JY,JX),ARLSS(JY,JX) + COMMON/BLK18/ARLFC(JY,JX),ARSTC(JY,JX),TEVAPP(JY,JX),TEVAPC(JY,JX) + 2,TENGYC(JY,JX),THFLXC(JY,JX),TUPWTR(0:JZ,JY,JX),TUPHT(0:JZ,JY,JX) + 3,TVOLWP(JY,JX),TCOFLA(JZ,JY,JX),TOXFLA(JZ,JY,JX),TCHFLA(JZ,JY,JX) + 4,TN2FLA(JZ,JY,JX),TNHFLA(JZ,JY,JX),TLCO2P(JZ,JY,JX),GPP(JY,JX) + 5,TLOXYP(JZ,JY,JX),TLCH4P(JZ,JY,JX),TLN2OP(JZ,JY,JX),RECO(JY,JX) + 6,TLNH3P(JZ,JY,JX),TCO2S(JZ,JY,JX),TUPOXS(JZ,JY,JX) + 7,TUPCHS(JZ,JY,JX),TUPN2S(JZ,JY,JX),TUPN3S(JZ,JY,JX) + 8,TUPNH4(JZ,JY,JX),TUPNO3(JZ,JY,JX),TUPH2P(JZ,JY,JX) + 9,TUPN3B(JZ,JY,JX),TUPNHB(JZ,JY,JX),TUPNOB(JZ,JY,JX) + 1,TUPH2B(JZ,JY,JX),TUPNF(JZ,JY,JX),CSNT(4,0:1,0:JZ,JY,JX) + 2,ZSNT(4,0:1,0:JZ,JY,JX),PSNT(4,0:1,0:JZ,JY,JX) + 3,TDFOMC(0:4,JZ,JY,JX),TDFOMN(0:4,JZ,JY,JX),TDFOMP(0:4,JZ,JY,JX) + 4,TCO2Z(JY,JX),TOXYZ(JY,JX),TCH4Z(JY,JX),TN2OZ(JY,JX),TNH3Z(JY,JX) + 5,TCO2P(JZ,JY,JX),TUPOXP(JZ,JY,JX),THRMC(JY,JX),TCNET(JY,JX) + 6,ZCSNC(JY,JX),ZZSNC(JY,JX),ZPSNC(JY,JX),WGLFT(JC,JY,JX) + 7,ARLFT(JC,JY,JX),ARSTT(JC,JY,JX),ARLSS(JY,JX),RTDNT(JZ,JY,JX) + diff --git a/f77src/blk2a.h b/f77src/blk2a.h index 1e03f4b..3ee9f7f 100755 --- a/f77src/blk2a.h +++ b/f77src/blk2a.h @@ -4,11 +4,11 @@ 4,VPA(JY,JX),VPK(JY,JX),DYLN(JY,JX),DYLX(JY,JX),ALTZ(JY,JX) 5,PRECU(JY,JX),PRECR(JY,JX),PRECW(JY,JX),PRECI(JY,JX) 6,PRECQ(JY,JX),PRECA(JY,JX),GSIN(JY,JX),GCOS(JY,JX),GAZI(JY,JX) - 7,OMEGAG(4,JY,JX),SL(JY,JX),ASP(JY,JX),ZS(JY,JX),ZD(JY,JX) + 7,OMEGAG(4,JY,JX),SL(2,JY,JX),ASP(JY,JX),ZS(JY,JX),ZD(JY,JX) 8,ZR(JY,JX),ZM(JY,JX),Z0(JY,JX),ALT(JY,JX) 9,RAB(JY,JX),RIB(JY,JX),THS(JY,JX),DTBLI(JY,JX),TRAD(JY,JX) 1,TAMX(JY,JX),TAMN(JY,JX),HUDX(JY,JX),HUDN(JY,JX),TWIND(JY,JX) - 2,TRAI(JY,JX),THSX(JY,JX),OFFSET(JY,JX),DHI(20),DVI(20),DH(JY,JX) + 2,TRAI(JY,JX),THSX(JY,JX),OFFSET(JY,JX),DH(JY,JX) 3,DV(JY,JX),PRECD(JY,JX),PRECB(JY,JX),DDRGI(JY,JX) 4,FERT(20,366,JY,JX),FDPTH(366,JY,JX),RRIG(24,366,JY,JX) 5,WDPTH(366,JY,JX),DCORP(366,JY,JX),CO2EI(JY,JX),CCO2EI(JY,JX) @@ -23,7 +23,7 @@ 5,RCHQS(JY,JX),RCHQW(JY,JX),RCHGD(JY,JX),DTBLG(JY,JX) 6,DPTHA(JY,JX),ROWN(JY,JX),ROWO(JY,JX),ROWP(JY,JX),ROWI(366,JY,JX) 7,FIRRA(JY,JX),CIRRA(JY,JX),DIRRA(2,JY,JX),XWTHR(24,366) - 8,XTILL(JY,JX),DTBLZ(JY,JX),TLEX(JY,JX),TSHX(JY,JX),TLEC(JY,JX) + 8,DTBLZ(JY,JX),TLEX(JY,JX),TSHX(JY,JX),TLEC(JY,JX) 9,TSHC(JY,JX),DPTHSK(JY,JX),TKSD(JY,JX),TCNDG 1,DDRG(JY,JX),ATCAI(JY,JX),RAD(JY,JX),RAP(JY,JX) 2,IPRC(JY,JX),ITILL(366,JY,JX),IIRRA(4,JY,JX),IRCHG(2,2,JY,JX) diff --git a/f77src/day.f b/f77src/day.f index 4c7dfec..0febe2a 100755 --- a/f77src/day.f +++ b/f77src/day.f @@ -248,96 +248,51 @@ SUBROUTINE day(I,NHW,NHE,NVN,NVS) C DO 9995 NX=NHW,NHE DO 9990 NY=NVN,NVS - IF(XTILL(NY,NX).GT.0.0.AND.ITILL(I,NY,NX).EQ.0)THEN - ITILL(I,NY,NX)=19 - DCORP(I,NY,NX)=0.05 - ENDIF IF(ITILL(I,NY,NX).EQ.0.OR.ITILL(I,NY,NX).GT.20)THEN CORP=0.0 ELSE - IF(ITILL(I,NY,NX).EQ.1)THEN - CORP=0.90 - ZS(NY,NX)=0.04 - ENDIF - IF(ITILL(I,NY,NX).EQ.2)THEN - CORP=0.50 - ZS(NY,NX)=0.02 - ENDIF - IF(ITILL(I,NY,NX).EQ.3)THEN - CORP=0.75 - ZS(NY,NX)=0.03 - ENDIF - IF(ITILL(I,NY,NX).EQ.4)THEN + IF(ITILL(I,NY,NX).EQ.1.OR.ITILL(I,NY,NX).EQ.11)THEN CORP=0.10 - ZS(NY,NX)=0.01 - ENDIF - IF(ITILL(I,NY,NX).EQ.5)THEN - CORP=0.60 - ZS(NY,NX)=0.02 - ENDIF - IF(ITILL(I,NY,NX).EQ.6)THEN - CORP=0.42 ZS(NY,NX)=0.04 ENDIF - IF(ITILL(I,NY,NX).EQ.7)THEN - CORP=0.33 - ZS(NY,NX)=0.04 - ENDIF - IF(ITILL(I,NY,NX).EQ.8)THEN - CORP=0.75 - ZS(NY,NX)=0.02 - ENDIF - IF(ITILL(I,NY,NX).EQ.9)THEN - CORP=0.30 - ZS(NY,NX)=0.01 - ENDIF - IF(ITILL(I,NY,NX).EQ.10)THEN + IF(ITILL(I,NY,NX).EQ.2.OR.ITILL(I,NY,NX).EQ.12)THEN CORP=0.20 ZS(NY,NX)=0.04 ENDIF - IF(ITILL(I,NY,NX).EQ.11)THEN + IF(ITILL(I,NY,NX).EQ.3.OR.ITILL(I,NY,NX).EQ.13)THEN CORP=0.30 ZS(NY,NX)=0.04 ENDIF - IF(ITILL(I,NY,NX).EQ.12)THEN - CORP=0.05 - ZS(NY,NX)=0.04 - ENDIF - IF(ITILL(I,NY,NX).EQ.13)THEN - CORP=0.10 + IF(ITILL(I,NY,NX).EQ.4.OR.ITILL(I,NY,NX).EQ.14)THEN + CORP=0.40 ZS(NY,NX)=0.04 ENDIF - IF(ITILL(I,NY,NX).EQ.14)THEN - CORP=0.05 - ZS(NY,NX)=0.04 + IF(ITILL(I,NY,NX).EQ.5.OR.ITILL(I,NY,NX).EQ.15)THEN + CORP=0.50 + ZS(NY,NX)=0.02 ENDIF - IF(ITILL(I,NY,NX).EQ.15)THEN - CORP=0.25 + IF(ITILL(I,NY,NX).EQ.6.OR.ITILL(I,NY,NX).EQ.16)THEN + CORP=0.60 ZS(NY,NX)=0.04 ENDIF - IF(ITILL(I,NY,NX).EQ.16)THEN - CORP=0.15 + IF(ITILL(I,NY,NX).EQ.7.OR.ITILL(I,NY,NX).EQ.17)THEN + CORP=0.70 ZS(NY,NX)=0.04 ENDIF - IF(ITILL(I,NY,NX).EQ.17)THEN - CORP=0.05 - ZS(NY,NX)=0.04 + IF(ITILL(I,NY,NX).EQ.8.OR.ITILL(I,NY,NX).EQ.18)THEN + CORP=0.80 + ZS(NY,NX)=0.02 ENDIF - IF(ITILL(I,NY,NX).EQ.18)THEN - CORP=0.10 + IF(ITILL(I,NY,NX).EQ.9.OR.ITILL(I,NY,NX).EQ.19)THEN + CORP=0.90 ZS(NY,NX)=0.01 ENDIF - IF(ITILL(I,NY,NX).EQ.19)THEN - CORP=XTILL(NY,NX) - ZS(NY,NX)=0.02 - XTILL(NY,NX)=0.0 - ENDIF - IF(ITILL(I,NY,NX).EQ.20)THEN + IF(ITILL(I,NY,NX).EQ.10.OR.ITILL(I,NY,NX).EQ.20)THEN CORP=1.00 - ZS(NY,NX)=0.01 + ZS(NY,NX)=0.02 ENDIF ENDIF - XCORP(NY,NX)=AMAX1(1.0E-03,1.0-CORP) + XCORP(NY,NX)=AMAX1(1.0E-06,1.0-CORP) C C AUTOMATIC IRRIGATION IF SELECTED C diff --git a/f77src/extract.f b/f77src/extract.f index 517ede4..086a017 100755 --- a/f77src/extract.f +++ b/f77src/extract.f @@ -166,9 +166,11 @@ SUBROUTINE extract(I,J,NHW,NHE,NVN,NVS) C C TOTAL ROOT C,N,P EXUDATION C - TDFOMC(L,NY,NX)=TDFOMC(L,NY,NX)-RDFOMC(N,L,NZ,NY,NX) - TDFOMN(L,NY,NX)=TDFOMN(L,NY,NX)-RDFOMN(N,L,NZ,NY,NX) - TDFOMP(L,NY,NX)=TDFOMP(L,NY,NX)-RDFOMP(N,L,NZ,NY,NX) + DO 195 K=0,4 + TDFOMC(K,L,NY,NX)=TDFOMC(K,L,NY,NX)-RDFOMC(N,K,L,NZ,NY,NX) + TDFOMN(K,L,NY,NX)=TDFOMN(K,L,NY,NX)-RDFOMN(N,K,L,NZ,NY,NX) + TDFOMP(K,L,NY,NX)=TDFOMP(K,L,NY,NX)-RDFOMP(N,K,L,NZ,NY,NX) +195 CONTINUE C C TOTAL ROOT O2, NH4, NO3, PO4 UPTAKE CONTRIBUTES TO C TOTAL ROOT + MICROBIAL UPTAKE USED TO CALCULATE diff --git a/f77src/foutp.f b/f77src/foutp.f index 1e858e5..cfd6ed3 100755 --- a/f77src/foutp.f +++ b/f77src/foutp.f @@ -62,7 +62,7 @@ SUBROUTINE foutp(NT,NE,NAX,NDX,NTX,NEX,NF,NFX,NHW,NHE,NVN,NVS) 9995 CONTINUE LUN=N+20 C OPEN(LUN,FILE=OUTP(N-20),STATUS='UNKNOWN') - OPEN(LUN,FILE=trim(outdir)//OUTP(N-20),STATUS='UNKNOWN') + OPEN(LUN,FILE=trim(outdir)//OUTP(N-20),STATUS='UNKNOWN') C C WRITE HEADINGS TO OUTPUT FILES C diff --git a/f77src/fouts.f b/f77src/fouts.f index c514905..e6e33c4 100755 --- a/f77src/fouts.f +++ b/f77src/fouts.f @@ -77,7 +77,7 @@ SUBROUTINE fouts(NT,NE,NAX,NDX,NTX,NEX,NF,NFX,NHW,NHE,NVN,NVS) CLOSE(15) LUN=N+10 C OPEN(LUN,FILE=OUTS(N-20),STATUS='UNKNOWN') - OPEN(LUN,FILE=trim(outdir)//OUTS(N-20),STATUS='UNKNOWN') + OPEN(LUN,FILE=trim(outdir)//OUTS(N-20),STATUS='UNKNOWN') C C WRITE HEADINGS TO OUTPUT FILES C diff --git a/f77src/grosub.f b/f77src/grosub.f index 7df41d1..c5ed343 100755 --- a/f77src/grosub.f +++ b/f77src/grosub.f @@ -1,7513 +1,7514 @@ - - SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) -C -C THIS SUBROUTINE CALCULATES ALL PLANT BIOLOGICAL TRANSFORMATIONS -C - include "parameters.h" - include "files.h" - include "blkc.h" - include "blk1cp.h" - include "blk1cr.h" - include "blk1g.h" - include "blk1n.h" - include "blk1p.h" - include "blk1s.h" - include "blk2a.h" - include "blk2b.h" - include "blk2c.h" - include "blk3.h" - include "blk5.h" - include "blk8a.h" - include "blk8b.h" - include "blk9a.h" - include "blk9b.h" - include "blk9c.h" - include "blk11a.h" - include "blk11b.h" - include "blk12a.h" - include "blk12b.h" - include "blk13a.h" - include "blk13b.h" - include "blk13c.h" - include "blk14.h" - include "blk16.h" - include "blk18a.h" - include "blk18b.h" - DIMENSION PART(7),TFN6(JZ),ARSTKB(10),NRX(2,JZ),ICHK1(2,JZ) - 2,NBZ(10),FXFB(0:3),FXRT(0:1),FXSH(0:1) - 3,VMXS(0:1,0:5),WTLSBZ(10),CPOOLZ(10),ZPOOLZ(10),PPOOLZ(10) - 4,ZCX(JP,JY,JX),UPNFC(JP,JY,JX),FRSV(0:3),FXFV(0:1),FXFZ(0:1) - 5,FXRN(4) - 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) - 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) - 2,FWODB(0:1),FWODLN(0:1),FWODLP(0:1),FWODSN(0:1),FWODSP(0:1) -C DIMENSION VCO2(400,366,05) - PARAMETER(PART1X=0.05,PART2X=0.02 - 2,VMXC=0.015,ATRPX=276.91,FSNR=2.884E-03,FLG4X=168.0 - 3,FLGZX=240.0,XFRX=2.5E-02,XFRY=2.5E-03,IFLGRX=960 - 4,FSNKM=0.05,FXFS=1.0,FMYC=0.01) - PARAMETER(CNKI=1.0E+01,CPKI=1.0E+02,CNKF=1.0) - PARAMETER(RMPLT=0.010,PSILM=0.1,RCMN=1.560E+01,RTDPX=0.00 - 2,RTLGAX=1.0E-02,EMODR=5.0) - PARAMETER(QNTM=0.45,CURV=0.70,CURV2=2.0*CURV,CURV4=4.0*CURV - 2,ELEC3=4.5,ELEC4=3.0,CO2KI=1.0E+03,FCO2B=0.02,FHCOB=1.0-FCO2B) - PARAMETER(COMP4=0.5,FDML=6.0,FBS=0.2*FDML,FMP=0.8*FDML - 2,FVRN=0.5) - PARAMETER(ZPLFM=0.33,ZPLFD=1.0-ZPLFM,ZPGRM=0.75 - 2,ZPGRD=1.0-ZPGRM,FRF=0.25,FRC=1.0-FRF,GY=0.5,GZ=1.0-GY) - PARAMETER(FSTK=0.05,ZSTX=1.0E-03,DSTK=0.225,VSTK=1.0E-06/DSTK - 2,FRTX=1.0/(1.0-(1.0-FSTK)**2)) - PARAMETER(SETC=1.0E-02,SETN=1.0E-03,SETP=1.0E-04) - PARAMETER(SLA2=-0.33,SSL2=-0.50,SNL2=-0.67) - PARAMETER(CNMX=0.20,CPMX=0.020,CNMN=0.050,CPMN=0.005) - PARAMETER(EN2F=0.20,VMXO=0.50,SPNDL=1.0E-06,CCNKM=1.0E-02 - 2,CCNKX=1.0E+02,WTNDI=0.01) - DATA RCCZ/0.167,0.167,0.067,0.167/ - DATA RCCY/0.333,0.333,0.133,0.333/ - DATA RCCX/0.250,0.750,0.750/ - DATA RCCQ/0.833,0.833,0.833/ - DATA FXRN/0.50,0.025,0.25,0.025/ - DATA FXFB/5.0E-03,5.0E-03,5.0E-06,5.0E-06/ - DATA VMXS/0.025,0.0025 - 1,0.0025,0.0025 - 2,0.0025,0.0025 - 3,0.0025,0.0025 - 4,0.0025,0.0025 - 5,0.0025,0.0025/ - DATA FPART1/1.00/,FPART2/0.40/ - DATA FXSH/0.500,0.750/,FXRT/0.500,0.250/ - DATA FRSV/0.025,0.025,0.001,0.001/ - DATA FXFV/0.05,0.005/,FXFZ/0.25,0.005/ - DATA EFIRE/0.917,0.167/ - DATA PSILY/-200.0,-2.0,-2.0/ -C DATA TC4,TLK/0.0,0.0/ - REAL*4 TFN5,WFNG,WFNC,WFNS,WFNSG,WFNSS,WFN4,WFNB - 2,WFNR,WFNRG,WFNGR,FSNC2 -C -C TOTAL AGB FOR GRAZING IN LANDSCAPE GROUP -C - DO 2995 NX=NHW,NHE - DO 2990 NY=NVN,NVS - DO 2985 NZ=1,NP(NY,NX) - IF(IHVST(NZ,I,NY,NX).EQ.4.OR.IHVST(NZ,I,NY,NX).EQ.6)THEN - WTSHTZ=0 - NN=0 - DO 1995 NX1=NHW,NHE - DO 1990 NY1=NVN,NVS - IF(LSG(NZ,NY1,NX1).EQ.LSG(NZ,NY,NX))THEN - IF(IFLGC(NZ,NY1,NX1).EQ.1)THEN - WTSHTZ=WTSHTZ+WTSHT(NZ,NY1,NX1) - NN=NN+1 - ENDIF - ENDIF -1990 CONTINUE -1995 CONTINUE - IF(NN.GT.0)THEN - WTSHTA(NZ,NY,NX)=WTSHTZ/NN - ELSE - WTSHTA(NZ,NY,NX)=WTSHT(NZ,NY,NX) - ENDIF - ENDIF -2985 CONTINUE -2990 CONTINUE -2995 CONTINUE - DO 9995 NX=NHW,NHE - DO 9990 NY=NVN,NVS - DO 9980 NZ=1,NP0(NY,NX) - DO 1 L=0,NJ(NY,NX) - DO 1 K=0,1 - DO 1 M=1,4 - CSNC(M,K,L,NZ,NY,NX)=0.0 - ZSNC(M,K,L,NZ,NY,NX)=0.0 - PSNC(M,K,L,NZ,NY,NX)=0.0 -1 CONTINUE - HCSNC(NZ,NY,NX)=0.0 - HZSNC(NZ,NY,NX)=0.0 - HPSNC(NZ,NY,NX)=0.0 - CNET(NZ,NY,NX)=0.0 - UPNFC(NZ,NY,NX)=0.0 - ZCX(NZ,NY,NX)=ZC(NZ,NY,NX) - ZC(NZ,NY,NX)=0.0 -9980 CONTINUE -C -C TRANSFORMATIONS IN LIVING PLANT POPULATIONS -C - DO 9985 NZ=1,NP(NY,NX) -C IF(J.EQ.INT(ZNOON(NY,NX)))THEN - XHVST=1.0 - WHVSBL=0.0 - WTHTH0=0.0 - WTHNH0=0.0 - WTHPH0=0.0 - WTHTH1=0.0 - WTHNH1=0.0 - WTHPH1=0.0 - WTHTH2=0.0 - WTHNH2=0.0 - WTHPH2=0.0 - WTHTH3=0.0 - WTHNH3=0.0 - WTHPH3=0.0 - WTHTH4=0.0 - WTHNH4=0.0 - WTHPH4=0.0 - WTHTR1=0.0 - WTHNR1=0.0 - WTHPR1=0.0 - WTHTR2=0.0 - WTHNR2=0.0 - WTHPR2=0.0 - WTHTR3=0.0 - WTHNR3=0.0 - WTHPR3=0.0 - WTHTR4=0.0 - WTHNR4=0.0 - WTHPR4=0.0 - WTHTX0=0.0 - WTHNX0=0.0 - WTHPX0=0.0 - WTHTX1=0.0 - WTHNX1=0.0 - WTHPX1=0.0 - WTHTX2=0.0 - WTHNX2=0.0 - WTHPX2=0.0 - WTHTX3=0.0 - WTHNX3=0.0 - WTHPX3=0.0 - WTHTX4=0.0 - WTHNX4=0.0 - WTHPX4=0.0 - WTHTG=0.0 - WTHNG=0.0 - WTHPG=0.0 -C ENDIF -C IF(NX.EQ.4.AND.NY.EQ.4.AND.NZ.EQ.2)THEN -C WRITE(*,2328)'IFLGC',I,J,NZ,IFLGC(NZ,NY,NX) -C 2,IDTHP(NZ,NY,NX),IDTHR(NZ,NY,NX) -2328 FORMAT(A8,10I4) -C ENDIF - IF(IFLGC(NZ,NY,NX).EQ.1)THEN - IF(IDTHP(NZ,NY,NX).EQ.0.OR.IDTHR(NZ,NY,NX).EQ.0)THEN -C IF(I.EQ.1.AND.J.EQ.1)THEN -C DO 87 II=1,366 -C DO 87 N=1,400 -C VCO2(N,II,NZ)=0.0 -87 CONTINUE -C ENDIF -C IF(IYRC.GE.2099)THEN -C IF(I.EQ.365.AND.J.EQ.24)THEN -C DO 88 N=1,400 -C WRITE(19,12)IYRC,NZ,N,(VCO2(N,II,NZ),II=1,181) -C WRITE(20,12)IYRC,NZ,N,(VCO2(N,II,NZ),II=182,365) -12 FORMAT(3I8,365E12.4) -88 CONTINUE -C ENDIF -C ENDIF - IFLGZ=0 - IFLGY=0 - DO 2 L=1,JC - ARLFV(L,NZ,NY,NX)=0.0 - WGLFV(L,NZ,NY,NX)=0.0 - ARSTV(L,NZ,NY,NX)=0.0 -2 CONTINUE - DO 5 NR=1,NRT(NZ,NY,NX) - DO 5 N=1,MY(NZ,NY,NX) - NRX(N,NR)=0 - ICHK1(N,NR)=0 -5 CONTINUE - DO 9 N=1,MY(NZ,NY,NX) - RTNT(N)=0.0 - DO 6 L=NU(NY,NX),NJ(NY,NX) - WSRTL(N,L,NZ,NY,NX)=0.0 - RTN1(N,L,NZ,NY,NX)=0.0 - RTNL(N,L,NZ,NY,NX)=0.0 - RCO2M(N,L,NZ,NY,NX)=0.0 - RCO2N(N,L,NZ,NY,NX)=0.0 - RCO2A(N,L,NZ,NY,NX)=0.0 - RLNT(N,L)=0.0 - DO 6 NR=1,NRT(NZ,NY,NX) - RTSK1(N,L,NR)=0.0 - RTSK2(N,L,NR)=0.0 -6 CONTINUE -9 CONTINUE - IF(IBTYP(NZ,NY,NX).EQ.0.OR.IGTYP(NZ,NY,NX).LE.1 - 2.OR.WTSTK(NZ,NY,NX).LT.ZEROP(NZ,NY,NX) - 3.OR.WVSTK(NZ,NY,NX).LT.ZEROP(NZ,NY,NX))THEN - FWOOD(1)=1.0 - FWODB(1)=1.0 - ELSE - FWOOD(1)=SQRT(FRTX*WVSTK(NZ,NY,NX)/WTSTK(NZ,NY,NX)) - FWODB(1)=1.0 - ENDIF - FWOOD(0)=1.0-FWOOD(1) - FWODB(0)=1.0-FWODB(1) - CNLFW=FWODB(0)*CNSTK(NZ,NY,NX)+FWODB(1)*CNLF(NZ,NY,NX) - CPLFW=FWODB(0)*CPSTK(NZ,NY,NX)+FWODB(1)*CPLF(NZ,NY,NX) - CNSHW=FWODB(0)*CNSTK(NZ,NY,NX)+FWODB(1)*CNSHE(NZ,NY,NX) - CPSHW=FWODB(0)*CPSTK(NZ,NY,NX)+FWODB(1)*CPSHE(NZ,NY,NX) - CNRTW=FWOOD(0)*CNSTK(NZ,NY,NX)+FWOOD(1)*CNRT(NZ,NY,NX) - CPRTW=FWOOD(0)*CPSTK(NZ,NY,NX)+FWOOD(1)*CPRT(NZ,NY,NX) - FWODLN(0)=FWODB(0)*CNSTK(NZ,NY,NX)/CNLFW - FWODLP(0)=FWODB(0)*CPSTK(NZ,NY,NX)/CPLFW - FWODSN(0)=FWODB(0)*CNSTK(NZ,NY,NX)/CNSHW - FWODSP(0)=FWODB(0)*CPSTK(NZ,NY,NX)/CPSHW - FWOODN(0)=FWOOD(0)*CNSTK(NZ,NY,NX)/CNRTW - FWOODP(0)=FWOOD(0)*CPSTK(NZ,NY,NX)/CPRTW - FWODLN(1)=1.0-FWODLN(0) - FWODLP(1)=1.0-FWODLP(0) - FWODSN(1)=1.0-FWODSN(0) - FWODSP(1)=1.0-FWODSP(0) - FWOODN(1)=1.0-FWOODN(0) - FWOODP(1)=1.0-FWOODP(0) -C -C SHOOT AND ROOT TEMPERATURE FUNCTIONS FOR MAINTENANCE -C RESPIRATION FROM TEMPERATURES WITH OFFSETS FOR THERMAL ADAPTATION -C - TKSM=AMAX1(258.15,TKC(NZ,NY,NX))+OFFST(NZ,NY,NX) - RTK=8.3143*TKSM - STK=710.0*TKSM - ACTVM=1+EXP((195000-STK)/RTK)+EXP((STK-232500)/RTK) - TFN5=EXP(25.214-62500/RTK)/ACTVM - DO 7 L=NU(NY,NX),NJ(NY,NX) - TKSM=AMAX1(258.15,TKS(L,NY,NX))+OFFST(NZ,NY,NX) - RTK=8.3143*TKSM - STK=710.0*TKSM - ACTVM=1+EXP((195000-STK)/RTK)+EXP((STK-232500)/RTK) - TFN6(L)=EXP(25.214-62500/RTK)/ACTVM -7 CONTINUE - GROGR=0.0 - WTRTA(NZ,NY,NX)=AMAX1(0.999992087*WTRTA(NZ,NY,NX) - 2,WTRT(NZ,NY,NX)/PP(NZ,NY,NX)) - XRTN1=AMAX1(1.0,WTRTA(NZ,NY,NX)**0.72)*PP(NZ,NY,NX) -C -C WATER STRESS FUNCTIONS FOR EXPANSION AND GROWTH RESPIRATION -C FROM CANOPY TURGOR -C - WFNS=AMIN1(1.0,AMAX1(0.0,PSILG(NZ,NY,NX)-PSILM)) - WFNSG=WFNS**0.25 - WFNSS=WFNS**0.50 - IF(IGTYP(NZ,NY,NX).EQ.0)THEN - WFNC=1.0 - WFNG=EXP(0.05*PSILT(NZ,NY,NX)) - ELSE - WFNC=EXP(RCS(NZ,NY,NX)*PSILG(NZ,NY,NX)) - WFNG=EXP(0.10*PSILT(NZ,NY,NX)) - ENDIF -C -C CALCULATE GROWTH OF EACH BRANCH -C - DO 105 NB=1,NBR(NZ,NY,NX) - WTLSB(NB,NZ,NY,NX)=AMAX1(0.0,WTLFB(NB,NZ,NY,NX) - 2+WTSHEB(NB,NZ,NY,NX)) - IF(IDTHB(NB,NZ,NY,NX).EQ.0)THEN -C -C PARTITION GROWTH WITHIN EACH BRANCH FROM GROWTH STAGE -C 1=LEAF,2=SHEATH OR PETIOLE,3=STALK,4=RESERVE, -C 5,6=REPRODUCTIVE ORGANS,7=GRAIN -C - ARSTKB(NB)=0.0 - TOTAL=0.0 - DO 10 N=1,7 - PART(N)=0.0 -10 CONTINUE -C -C IF BEFORE FLORAL INDUCTION -C - IF(IDAY(2,NB,NZ,NY,NX).EQ.0)THEN - PART(1)=0.725 - PART(2)=0.275 -C -C IF BEFORE ANTHESIS -C - ELSEIF(IDAY(6,NB,NZ,NY,NX).EQ.0)THEN - PART(1)=AMAX1(PART1X,0.725-FPART1*TGSTGI(NB,NZ,NY,NX)) - PART(2)=AMAX1(PART2X,0.275-FPART2*TGSTGI(NB,NZ,NY,NX)) - PARTS=1.0-PART(1)-PART(2) - PART(3)=0.60*PARTS - PART(4)=0.30*PARTS - PARTX=PARTS-PART(3)-PART(4) - PART(5)=0.5*PARTX - PART(6)=0.5*PARTX -C -C IF BEFORE GRAIN FILLING, DETERMINATE OR INDETERMINATE -C - ELSEIF(IDAY(7,NB,NZ,NY,NX).EQ.0)THEN - IF(IDTYP(NZ,NY,NX).EQ.0)THEN - PART(1)=0.0 - PART(2)=0.0 - ELSE - PART(1)=AMAX1(PART1X,(0.725-FPART1)*(1.0-TGSTGF(NB,NZ,NY,NX))) - PART(2)=AMAX1(PART2X,(0.275-FPART2)*(1.0-TGSTGF(NB,NZ,NY,NX))) - ENDIF - PARTS=1.0-PART(1)-PART(2) - PART(3)=AMAX1(0.0,0.60*PARTS*(1.0-TGSTGF(NB,NZ,NY,NX))) - PART(4)=AMAX1(0.0,0.30*PARTS*(1.0-TGSTGF(NB,NZ,NY,NX))) - PARTX=PARTS-PART(3)-PART(4) - PART(5)=0.5*PARTX - PART(6)=0.5*PARTX -C -C DURING GRAIN FILLING, DETERMINATE OR INDETERMINATE -C - ELSE - IF(IDTYP(NZ,NY,NX).EQ.0)THEN - PART(7)=1.0 - ELSE - PART(1)=PART1X - PART(2)=PART2X - PARTS=1.0-PART(1)-PART(2) - IF(ISTYP(NZ,NY,NX).EQ.0)THEN - PART(3)=0.125*PARTS - PART(5)=0.125*PARTS - PART(6)=0.125*PARTS - PART(7)=0.625*PARTS - ELSE - PART(3)=0.75*PARTS - PART(7)=0.25*PARTS - ENDIF - ENDIF - ENDIF -C -C IF AFTER GRAIN FILLING -C - IF(IBTYP(NZ,NY,NX).EQ.0.AND.IDAY(10,NB,NZ,NY,NX).NE.0)THEN - IF(ISTYP(NZ,NY,NX).EQ.0)THEN - PART(4)=0.0 - PART(3)=0.0 - PART(7)=0.0 - ELSE - PART(4)=PART(4)+PART(3) - PART(3)=0.0 - PART(7)=0.0 - ENDIF - ENDIF -C -C REDIRECT FROM STALK TO STALK RESERVES IF RESERVES BECOME LOW -C - IF(IDAY(2,NB,NZ,NY,NX).NE.0)THEN - IF(WTRSVB(NB,NZ,NY,NX).LT.XFRX*WVSTKB(NB,NZ,NY,NX))THEN - DO 1020 N=1,7 - IF(N.NE.4)THEN - PART(4)=PART(4)+0.10*PART(N) - PART(N)=PART(N)-0.10*PART(N) - ENDIF -1020 CONTINUE -C -C REDIRECT FROM STALK RESERVES TO STALK IF RESERVES BECOME TOO LARGE -C - ELSEIF(WTRSVB(NB,NZ,NY,NX).GT.1.0*WVSTKB(NB,NZ,NY,NX))THEN - PART(3)=PART(3)+PART(4)+PART(7) - PART(4)=0.0 - PART(7)=0.0 - ENDIF - ENDIF -C -C REDIRECT FROM LEAVES TO STALK IF LAI BECOMES TOO LARGE -C - ARLFI=ARLFP(NZ,NY,NX)/AREA(3,NU(NY,NX),NY,NX) - IF(ARLFI.GT.5.0)THEN - FPARTL=AMAX1(0.0,(10.0-ARLFI)/5.0) - PART(3)=PART(3)+(1.0-FPARTL)*(PART(1)+PART(2)) - PART(1)=FPARTL*PART(1) - PART(2)=FPARTL*PART(2) - ENDIF -C -C DECIDUOUS LEAF FALL AFTER GRAIN FILL IN DETERMINATES, -C AFTER AUTUMNIZATION IN INDETERMINATES, OR AFTER SUSTAINED -C WATER STRESS -C - IF((ISTYP(NZ,NY,NX).NE.0 - 2.AND.VRNF(NB,NZ,NY,NX).GE.FVRN*VRNX(NB,NZ,NY,NX)) - 3.OR.(ISTYP(NZ,NY,NX).EQ.0 - 4.AND.IDAY(8,NB,NZ,NY,NX).NE.0))THEN - IFLGZ=1 - IF(ISTYP(NZ,NY,NX).EQ.0)THEN - IFLGY=1 - FLGZ(NB,NZ,NY,NX)=FLGZ(NB,NZ,NY,NX)+1.0 - ELSEIF((IWTYP(NZ,NY,NX).EQ.1.OR.IWTYP(NZ,NY,NX).EQ.3) - 2.AND.TCC(NZ,NY,NX).LT.CTC(NZ,NY,NX))THEN - IFLGY=1 - FLGZ(NB,NZ,NY,NX)=FLGZ(NB,NZ,NY,NX)+1.0 - ENDIF - IF(IWTYP(NZ,NY,NX).GE.2 - 2.AND.PSILT(NZ,NY,NX).LT.PSILY(IGTYP(NZ,NY,NX)))THEN - IFLGY=1 - FLGZ(NB,NZ,NY,NX)=FLGZ(NB,NZ,NY,NX)+1.0 - ENDIF - IF(ISTYP(NZ,NY,NX).NE.0.AND.IWTYP(NZ,NY,NX).NE.0)THEN - PART(3)=PART(3)+0.5*(PART(1)+PART(2)) - PART(4)=PART(4)+0.5*(PART(1)+PART(2)) - PART(1)=0.0 - PART(2)=0.0 - ENDIF - ELSE - IFLGZ=0 - IFLGY=0 - FLGZ(NB,NZ,NY,NX)=0.0 - ENDIF -C -C CHECK PARTITIONING COEFFICIENTS -C - DO 1000 N=1,7 - PART(N)=AMAX1(0.0,PART(N)) - TOTAL=TOTAL+PART(N) -1000 CONTINUE - IF(TOTAL.GT.ZERO)THEN - DO 1010 N=1,7 - PART(N)=PART(N)/TOTAL -1010 CONTINUE - ELSE - DO 1015 N=1,7 - PART(N)=0.0 -1015 CONTINUE - ENDIF -C -C SHOOT COEFFICIENTS FOR GROWTH RESPIRATION AND N,P CONTENTS -C FROM GROWTH YIELDS ENTERED IN 'READQ', AND FROM PARTITIONING -C COEFFICIENTS ABOVE -C - IF(IDAY(1,NB,NZ,NY,NX).NE.0)THEN - DMLFB=DMLF(NZ,NY,NX) - DMSHB=DMSHE(NZ,NY,NX) - CNLFB=CNLFW - CNSHB=CNSHW - CPLFB=CPLFW - CPSHB=CPSHW - ELSE - DMLFB=DMRT(NZ,NY,NX) - DMSHB=DMRT(NZ,NY,NX) - CNLFB=CNRTW - CNSHB=CNRTW - CPLFB=CPRTW - CPSHB=CPRTW - ENDIF - DMSHT=PART(1)*DMLFB+PART(2)*DMSHB+PART(3)*DMSTK(NZ,NY,NX) - 2+PART(4)*DMRSV(NZ,NY,NX)+PART(5)*DMHSK(NZ,NY,NX) - 3+PART(6)*DMEAR(NZ,NY,NX)+PART(7)*DMGR(NZ,NY,NX) - DMSHD=1.0-DMSHT - CNLFM=PART(1)*DMLFB*ZPLFM*CNLFB - CPLFM=PART(1)*DMLFB*ZPLFM*CPLFB - CNLFX=PART(1)*DMLFB*ZPLFD*CNLFB - CPLFX=PART(1)*DMLFB*ZPLFD*CPLFB - CNSHX=PART(2)*DMSHB*CNSHB - 2+PART(3)*DMSTK(NZ,NY,NX)*CNSTK(NZ,NY,NX) - 3+PART(4)*DMRSV(NZ,NY,NX)*CNRSV(NZ,NY,NX) - 4+PART(5)*DMHSK(NZ,NY,NX)*CNHSK(NZ,NY,NX) - 5+PART(6)*DMEAR(NZ,NY,NX)*CNEAR(NZ,NY,NX) - 6+PART(7)*DMGR(NZ,NY,NX)*CNRSV(NZ,NY,NX) - CPSHX=PART(2)*DMSHB*CPSHB - 2+PART(3)*DMSTK(NZ,NY,NX)*CPSTK(NZ,NY,NX) - 3+PART(4)*DMRSV(NZ,NY,NX)*CPRSV(NZ,NY,NX) - 4+PART(5)*DMHSK(NZ,NY,NX)*CPHSK(NZ,NY,NX) - 5+PART(6)*DMEAR(NZ,NY,NX)*CPEAR(NZ,NY,NX) - 6+PART(7)*DMGR(NZ,NY,NX)*CPRSV(NZ,NY,NX) -C -C TOTAL SHOOT STRUCTURAL N CONTENT FOR MAINTENANCE RESPIRATION -C - WTSHXN=AMAX1(0.0,WTLFBN(NB,NZ,NY,NX)+WTSHBN(NB,NZ,NY,NX) - 2+CNSTK(NZ,NY,NX)*WVSTKB(NB,NZ,NY,NX)) - IF(IDAY(10,NB,NZ,NY,NX).EQ.0)THEN - WTSHXN=WTSHXN+AMAX1(0.0,WTHSBN(NB,NZ,NY,NX) - 2+WTEABN(NB,NZ,NY,NX)+WTGRBN(NB,NZ,NY,NX)) - ENDIF -C -C GROSS PRIMARY PRODUCTIVITY -C - IF(IDAY(1,NB,NZ,NY,NX).NE.0)THEN - IF(FDBK(NB,NZ,NY,NX).NE.0)THEN - IF(SSIN(NY,NX).GT.0.0.AND.RADP(NZ,NY,NX).GT.0.0 - 2.AND.CO2Q(NZ,NY,NX).GT.0.0)THEN - CO2F=0.0 - CH2O=0.0 - IF(IGTYP(NZ,NY,NX).NE.0.OR.WFNC.GT.0.0)THEN -C IF(NZ.EQ.1.OR.NZ.EQ.4)THEN -C WRITE(*,5651)'CHECK1',I,J,NZ,NB,IDAY(1,NB,NZ,NY,NX) -C 2,FDBK(NB,NZ,NY,NX),RADP(NZ,NY,NX),CO2Q(NZ,NY,NX),WFNC -5651 FORMAT(A8,5I4,12E12.4) -C ENDIF -C -C FOR EACH NODE -C - DO 100 K=1,25 - CH2O3(K)=0.0 - CH2O4(K)=0.0 - IF(ARLF(K,NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN -C -C C4 PHOTOSYNTHESIS -C - IF(ICTYP(NZ,NY,NX).EQ.4.AND.VCGR4(K,NB,NZ,NY,NX).GT.0.0)THEN -C -C FOR EACH CANOPY LAYER -C - DO 110 L=JC,1,-1 - IF(ARLFL(L,K,NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN -C -C FOR EACH LEAF AZIMUTH AND INCLINATION -C - DO 115 N = 1,4 - DO 120 M = 1,4 -C -C CO2 FIXATION BY SUNLIT LEAVES -C - IF(SURFX(N,L,K,NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - IF(PAR(N,M,L,NZ,NY,NX).GT.0.0)THEN -C -C C4 CARBOXYLATION REACTIONS USING VARIABLES FROM 'STOMATE' -C - PARX=QNTM*PAR(N,M,L,NZ,NY,NX) - PARJ=PARX+ETGR4(K,NB,NZ,NY,NX) - ETLF=(PARJ-SQRT(PARJ**2-CURV4*PARX*ETGR4(K,NB,NZ,NY,NX)))/CURV2 - EGRO=ETLF*CBXN4(K,NB,NZ,NY,NX) - VL=AMIN1(VGRO4(K,NB,NZ,NY,NX),EGRO)*FDBK4(K,NB,NZ,NY,NX) -C -C STOMATAL EFFECT OF WATER DEFICIT -C - IF(VL.GT.ZERO)THEN - RS=AMIN1(RCMX(NZ,NY,NX),AMAX1(RCMN,DCO2(NZ,NY,NX)/VL)) - RSL=RS+(RCMX(NZ,NY,NX)-RS)*WFNC - GSL=1.0/RSL*FMOL(NZ,NY,NX) -C -C NON-STOMATAL EFFECT OF WATER DEFICIT -C - IF(IGTYP(NZ,NY,NX).NE.0)THEN - WFN4=(RS/RSL)**1.00 - WFNB=SQRT(RS/RSL) - ELSE - WFN4=WFNG - WFNB=WFNG - ENDIF -C -C CONVERGENCE SOLUTION FOR CO2I AT WHICH CARBOXYLATION -C EQUALS DIFFUSION -C - CO2X=CO2I(NZ,NY,NX) - DO 125 NN=1,100 - CO2C=CO2X*SCO2(NZ,NY,NX) - CO2Y=AMAX1(0.0,CO2C-COMP4) - CBXNX=CO2Y/(ELEC4*CO2C+10.5*COMP4) - VGROX=VCGR4(K,NB,NZ,NY,NX)*CO2Y/(CO2C+XKCO24(NZ,NY,NX)) - EGROX=ETLF*CBXNX - VL=AMIN1(VGROX,EGROX)*WFN4*FDBK4(K,NB,NZ,NY,NX) - VG=(CO2Q(NZ,NY,NX)-CO2X)*GSL - IF(VL+VG.GT.ZERO)THEN - DIFF=(VL-VG)/(VL+VG) - IF(ABS(DIFF).LT.0.005)GO TO 130 - VA=0.95*VG+0.05*VL - CO2X=CO2Q(NZ,NY,NX)-VA/GSL - ELSE - VL=0.0 - GO TO 130 - ENDIF -125 CONTINUE - -C -C ACCUMULATE C4 FIXATION PRODUCT -C -130 CH2O4(K)=CH2O4(K)+VL*SURFX(N,L,K,NB,NZ,NY,NX) - 2*TAUS(L+1,NY,NX) -C ICO2I=MAX(1,MIN(400,INT(CO2X))) -C VCO2(ICO2I,I,NZ)=VCO2(ICO2I,I,NZ) -C 2+(VL*SURFX(N,L,K,NB,NZ,NY,NX)*TAUS(L+1,NY,NX))*0.0432 -C IF(NB.EQ.1.AND.M.EQ.1.AND.N.EQ.3.AND.K.EQ.KLEAF(NB,NZ,NY,NX) -C 2.AND.(I/10)*10.EQ.I.AND.J.EQ.12)THEN -C WRITE(20,4444)'VLD4',IYRC,I,J,NZ,L,M,N,K,VL,PAR(N,M,L,NZ,NY,NX) -C 2,PAR(N,M,L,NZ,NY,NX)*TAUS(L+1,NY,NX)+PARDIF(N,M,L,NZ,NY,NX) -C 3*TAU0(L+1,NY,NX) -C 2,RAPS,TKC(NZ,NY,NX),CO2Q(NZ,NY,NX),ETGR4(K,NB,NZ,NY,NX) -C 3,CBXN4(K,NB,NZ,NY,NX),VGRO4(K,NB,NZ,NY,NX),EGRO -C 3,FDBK4(K,NB,NZ,NY,NX),CH2O4(K),WFN4,VGROX,EGROX -C 4,VCGR4(K,NB,NZ,NY,NX),CO2X,CO2C,CBXNX -C 5,RS,RSL -4444 FORMAT(A8,8I4,40E12.4) -C ENDIF -C -C C3 CARBOXYLATION REACTIONS IN C4 PLANTS USING VARIABLES FROM 'STOMATE' -C - PARJ=PARX+ETGRO(K,NB,NZ,NY,NX) - ETLF=(PARJ-SQRT(PARJ**2-CURV4*PARX*ETGRO(K,NB,NZ,NY,NX)))/CURV2 - EGRO=ETLF*CBXN(K,NB,NZ,NY,NX) - VL=AMIN1(VGRO(K,NB,NZ,NY,NX),EGRO)*WFNB*FDBK(NB,NZ,NY,NX) -C -C ACCUMULATE C3 FIXATION PRODUCT -C - CH2O3(K)=CH2O3(K)+VL*SURFX(N,L,K,NB,NZ,NY,NX) - 2*TAUS(L+1,NY,NX) -C IF(L.EQ.NC-1.AND.NB.EQ.1.AND.M.EQ.1.AND.N.EQ.1)THEN -C WRITE(*,4445)'VLD3',IYRC,I,J,NZ,L,M,N,K,VL,PAR(N,M,L,NZ,NY,NX) -C 2,RAPS,TKC(NZ,NY,NX),CO2Q(NZ,NY,NX),ETGRO(K,NB,NZ,NY,NX) -C 3,CBXN(K,NB,NZ,NY,NX),VGRO(K,NB,NZ,NY,NX),EGRO -C 3,FDBK(NB,NZ,NY,NX),WFNB -4445 FORMAT(A8,8I4,20E12.4) -C ENDIF - ENDIF - ENDIF -C -C CO2 FIXATION BY SHADED LEAVES -C - IF(PARDIF(N,M,L,NZ,NY,NX).GT.0.0)THEN -C -C C4 CARBOXYLATION REACTIONS -C - PARX=QNTM*PARDIF(N,M,L,NZ,NY,NX) - PARJ=PARX+ETGR4(K,NB,NZ,NY,NX) - ETLF=(PARJ-SQRT(PARJ**2-CURV4*PARX*ETGR4(K,NB,NZ,NY,NX)))/CURV2 - EGRO=ETLF*CBXN4(K,NB,NZ,NY,NX) - VL=AMIN1(VGRO4(K,NB,NZ,NY,NX),EGRO)*FDBK4(K,NB,NZ,NY,NX) -C -C STOMATAL EFFECT OF WATER DEFICIT -C - IF(VL.GT.ZERO)THEN - RS=AMIN1(RCMX(NZ,NY,NX),AMAX1(RCMN,DCO2(NZ,NY,NX)/VL)) - RSL=RS+(RCMX(NZ,NY,NX)-RS)*WFNC - GSL=1.0/RSL*FMOL(NZ,NY,NX) -C -C NON-STOMATAL EFFECT OF WATER DEFICIT -C - IF(IGTYP(NZ,NY,NX).NE.0)THEN - WFN4=(RS/RSL)**1.00 - WFNB=SQRT(RS/RSL) - ELSE - WFN4=WFNG - WFNB=WFNG - ENDIF -C -C CONVERGENCE SOLUTION FOR CO2I AT WHICH CARBOXYLATION -C EQUALS DIFFUSION -C - CO2X=CO2I(NZ,NY,NX) - DO 135 NN=1,100 - CO2C=CO2X*SCO2(NZ,NY,NX) - CO2Y=AMAX1(0.0,CO2C-COMP4) - CBXNX=CO2Y/(ELEC4*CO2C+10.5*COMP4) - VGROX=VCGR4(K,NB,NZ,NY,NX)*CO2Y/(CO2C+XKCO24(NZ,NY,NX)) - EGROX=ETLF*CBXNX - VL=AMIN1(VGROX,EGROX)*WFN4*FDBK4(K,NB,NZ,NY,NX) - VG=(CO2Q(NZ,NY,NX)-CO2X)*GSL - IF(VL+VG.GT.ZERO)THEN - DIFF=(VL-VG)/(VL+VG) - IF(ABS(DIFF).LT.0.005)GO TO 140 - VA=0.95*VG+0.05*VL - CO2X=CO2Q(NZ,NY,NX)-VA/GSL - ELSE - VL=0.0 - GO TO 140 - ENDIF -135 CONTINUE -C -C ACCUMULATE C4 FIXATION PRODUCT -C -140 CH2O4(K)=CH2O4(K)+VL*SURFX(N,L,K,NB,NZ,NY,NX) - 2*TAU0(L+1,NY,NX) -C ICO2I=MAX(1,MIN(400,INT(CO2X))) -C VCO2(ICO2I,I,NZ)=VCO2(ICO2I,I,NZ) -C 2+(VL*SURFX(N,L,K,NB,NZ,NY,NX)*TAU0(L+1,NY,NX))*0.0432 -C WRITE(*,4455)'VLB4',IYRC,I,J,NZ,L,M,N,K,VL,PAR(N,M,L,NZ,NY,NX) -C 2,RAPS,TKC(NZ,NY,NX),CO2Q(NZ,NY,NX),ETGR4(K,NB,NZ,NY,NX) -C 3,CBXN4(K,NB,NZ,NY,NX),VGRO4(K,NB,NZ,NY,NX),EGRO -C 3,FDBK4(K,NB,NZ,NY,NX),CH2O4(K),WFN4,VGROX,EGROX -C 4,VCGR4(K,NB,NZ,NY,NX),CO2X,CO2C,CBXNX -C 5,RS,RSL -4455 FORMAT(A8,8I4,40E12.4) -C -C C3 CARBOXYLATION REACTIONS IN C4 PLANTS USING VARIABLES FROM 'STOMATE' -C - PARJ=PARX+ETGRO(K,NB,NZ,NY,NX) - ETLF=(PARJ-SQRT(PARJ**2-CURV4*PARX*ETGRO(K,NB,NZ,NY,NX)))/CURV2 - EGRO=ETLF*CBXN(K,NB,NZ,NY,NX) - VL=AMIN1(VGRO(K,NB,NZ,NY,NX),EGRO)*WFNB*FDBK(NB,NZ,NY,NX) -C -C ACCUMULATE C3 FIXATION PRODUCT -C - CH2O3(K)=CH2O3(K)+VL*SURFX(N,L,K,NB,NZ,NY,NX) - 2*TAU0(L+1,NY,NX) -C IF(J.EQ.13.AND.NB.EQ.1.AND.M.EQ.1.AND.N.EQ.1)THEN -C WRITE(*,4444)'VLB4',IYRC,I,J,NZ,L,K,VL,PARDIF(N,M,L,NZ,NY,NX) -C 2,RAPY,TKC(NZ,NY,NX),CO2Q(NZ,NY,NX),CO2X,FMOL(NZ,NY,NX)/GSL -C 3,VCGRO(K,NB,NZ,NY,NX),ETLF,FDBK(NB,NZ,NY,NX),WFNB -C ENDIF - ENDIF - ENDIF - ENDIF -120 CONTINUE -115 CONTINUE - ENDIF -110 CONTINUE - CO2F=CO2F+CH2O4(K) - CH2O=CH2O+CH2O3(K) -C -C C3 PHOTOSYNTHESIS -C - ELSEIF(ICTYP(NZ,NY,NX).NE.4.AND.VCGRO(K,NB,NZ,NY,NX).GT.0.0)THEN -C -C FOR EACH CANOPY LAYER -C - DO 210 L=JC,1,-1 - IF(ARLFL(L,K,NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN -C -C FOR EACH LEAF AZIMUTH AND INCLINATION -C - DO 215 N=1,4 - DO 220 M=1,4 -C -C CO2 FIXATION BY SUNLIT LEAVES -C - IF(SURFX(N,L,K,NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - - IF(PAR(N,M,L,NZ,NY,NX).GT.0.0)THEN -C -C C3 CARBOXYLATION REACTIONS USING VARIABLES FROM 'STOMATE' -C - PARX=QNTM*PAR(N,M,L,NZ,NY,NX) - PARJ=PARX+ETGRO(K,NB,NZ,NY,NX) - ETLF=(PARJ-SQRT(PARJ**2-CURV4*PARX*ETGRO(K,NB,NZ,NY,NX)))/CURV2 - EGRO=ETLF*CBXN(K,NB,NZ,NY,NX) - VL=AMIN1(VGRO(K,NB,NZ,NY,NX),EGRO)*FDBK(NB,NZ,NY,NX) -C -C STOMATAL EFFECT OF WATER DEFICIT -C - IF(VL.GT.ZERO)THEN - RS=AMIN1(RCMX(NZ,NY,NX),AMAX1(RCMN,DCO2(NZ,NY,NX)/VL)) - RSL=RS+(RCMX(NZ,NY,NX)-RS)*WFNC - GSL=1.0/RSL*FMOL(NZ,NY,NX) -C -C NON-STOMATAL EFFECT OF WATER DEFICIT -C - IF(IGTYP(NZ,NY,NX).NE.0)THEN - WFNB=SQRT(RS/RSL) - ELSE - WFNB=WFNG - ENDIF -C -C CONVERGENCE SOLUTION FOR CO2I AT WHICH CARBOXYLATION -C EQUALS DIFFUSION -C - CO2X=CO2I(NZ,NY,NX) - DO 225 NN=1,100 - CO2C=CO2X*SCO2(NZ,NY,NX) - CO2Y=AMAX1(0.0,CO2C-COMPL(K,NB,NZ,NY,NX)) - CBXNX=CO2Y/(ELEC3*CO2C+10.5*COMPL(K,NB,NZ,NY,NX)) - VGROX=VCGRO(K,NB,NZ,NY,NX)*CO2Y/(CO2C+XKCO2O(NZ,NY,NX)) - EGROX=ETLF*CBXNX - VL=AMIN1(VGROX,EGROX)*WFNB*FDBK(NB,NZ,NY,NX) - VG=(CO2Q(NZ,NY,NX)-CO2X)*GSL - IF(VL+VG.GT.ZERO)THEN - DIFF=(VL-VG)/(VL+VG) - IF(ABS(DIFF).LT.0.005)GO TO 230 - VA=0.95*VG+0.05*VL - CO2X=CO2Q(NZ,NY,NX)-VA/GSL - ELSE - VL=0.0 - GO TO 230 - ENDIF -225 CONTINUE -C -C ACCUMULATE C3 FIXATION PRODUCT -C -230 CH2O3(K)=CH2O3(K)+VL*SURFX(N,L,K,NB,NZ,NY,NX) - 2*TAUS(L+1,NY,NX) -C ICO2I=MAX(1,MIN(400,INT(CO2X))) -C VCO2(ICO2I,I,NZ)=VCO2(ICO2I,I,NZ) -C 2+(VL*SURFX(N,L,K,NB,NZ,NY,NX)*TAUS(L+1,NY,NX))*0.0432 -C IF(NB.EQ.1.AND.M.EQ.1.AND.N.EQ.1.AND.K.EQ.KLEAF(NB,NZ,NY,NX)-1 -C 2.AND.J.EQ.12)THEN -C WRITE(20,3335)'VLD',IYRC,I,J,NZ,L,M,N,K,VL,PAR(N,M,L,NZ,NY,NX) -C 2,RAPS,TKC(NZ,NY,NX),TKA,CO2Q(NZ,NY,NX),CO2X,CO2C,FMOL(NZ,NY,NX) -C 3/GSL,VGROX,EGROX,ETLF,CBXNX,FDBK(NB,NZ,NY,NX),WFNB,PSILG(NZ,NY,NX) -C 4,VCGRO(K,NB,NZ,NY,NX),ETGRO(K,NB,NZ,NY,NX),COMPL(K,NB,NZ,NY,NX) -C 5,SURFX(N,L,K,NB,NZ,NY,NX),TAUS(L+1,NY,NX),CH2O3(K) -3335 FORMAT(A8,8I4,30E12.4) -C ENDIF - ENDIF - ENDIF -C -C CO2 FIXATION BY SHADED LEAVES -C - IF(PARDIF(N,M,L,NZ,NY,NX).GT.0.0)THEN -C -C C3 CARBOXYLATION REACTIONS USING VARIABLES FROM 'STOMATE' -C - PARX=QNTM*PARDIF(N,M,L,NZ,NY,NX) - PARJ=PARX+ETGRO(K,NB,NZ,NY,NX) - ETLF=(PARJ-SQRT(PARJ**2-CURV4*PARX*ETGRO(K,NB,NZ,NY,NX)))/CURV2 - EGRO=ETLF*CBXN(K,NB,NZ,NY,NX) - VL=AMIN1(VGRO(K,NB,NZ,NY,NX),EGRO)*FDBK(NB,NZ,NY,NX) -C -C STOMATAL EFFECT OF WATER DEFICIT -C - IF(VL.GT.ZERO)THEN - RS=AMIN1(RCMX(NZ,NY,NX),AMAX1(RCMN,DCO2(NZ,NY,NX)/VL)) - RSL=RS+(RCMX(NZ,NY,NX)-RS)*WFNC - GSL=1.0/RSL*FMOL(NZ,NY,NX) -C -C NON-STOMATAL EFFECT OF WATER DEFICIT -C - IF(IGTYP(NZ,NY,NX).NE.0)THEN - WFNB=SQRT(RS/RSL) - ELSE - WFNB=WFNG - ENDIF -C -C CONVERGENCE SOLUTION FOR CO2I AT WHICH CARBOXYLATION -C EQUALS DIFFUSION -C - CO2X=CO2I(NZ,NY,NX) - DO 235 NN=1,100 - CO2C=CO2X*SCO2(NZ,NY,NX) - CO2Y=AMAX1(0.0,CO2C-COMPL(K,NB,NZ,NY,NX)) - CBXNX=CO2Y/(ELEC3*CO2C+10.5*COMPL(K,NB,NZ,NY,NX)) - VGROX=VCGRO(K,NB,NZ,NY,NX)*CO2Y/(CO2C+XKCO2O(NZ,NY,NX)) - EGROX=ETLF*CBXNX - VL=AMIN1(VGROX,EGROX)*WFNB*FDBK(NB,NZ,NY,NX) - VG=(CO2Q(NZ,NY,NX)-CO2X)*GSL - IF(VL+VG.GT.ZERO)THEN - DIFF=(VL-VG)/(VL+VG) - IF(ABS(DIFF).LT.0.005)GO TO 240 - VA=0.95*VG+0.05*VL - CO2X=CO2Q(NZ,NY,NX)-VA/GSL - ELSE - VL=0.0 - GO TO 240 - ENDIF -235 CONTINUE -C -C ACCUMULATE C3 FIXATION PRODUCT -C -240 CH2O3(K)=CH2O3(K)+VL*SURFX(N,L,K,NB,NZ,NY,NX) - 2*TAU0(L+1,NY,NX) -C ICO2I=MAX(1,MIN(400,INT(CO2X))) -C VCO2(ICO2I,I,NZ)=VCO2(ICO2I,I,NZ) -C 2+(VL*SURFX(N,L,K,NB,NZ,NY,NX)*TAU0(L+1,NY,NX))*0.0432 -C IF(J.EQ.13.AND.NB.EQ.1.AND.M.EQ.1.AND.N.EQ.1)THEN -C WRITE(*,3335)'VLB',IYRC,I,J,NZ,L,K,VL,PARDIF(N,M,L,NZ,NY,NX) -C 2,RAPY,TKC(NZ,NY,NX),CO2Q(NZ,NY,NX),CO2X,FMOL(NZ,NY,NX)/GSL -C 3,VCGRO(K,NB,NZ,NY,NX),ETLF,FDBK(NB,NZ,NY,NX),WFNB -C ENDIF - ENDIF - ENDIF - ENDIF -220 CONTINUE -215 CONTINUE - ENDIF -210 CONTINUE - CO2F=CO2F+CH2O3(K) - CH2O=CH2O+CH2O3(K) - ENDIF - ENDIF -100 CONTINUE - CO2F=CO2F*0.0432 - CH2O=CH2O*0.0432 -C -C CONVERT UMOL M-2 S-1 TO G C M-2 H-1 -C - DO 150 K=1,25 - CH2O3(K)=CH2O3(K)*0.0432 - CH2O4(K)=CH2O4(K)*0.0432 -150 CONTINUE - ELSE - CO2F=0.0 - CH2O=0.0 - IF(ICTYP(NZ,NY,NX).EQ.4)THEN - DO 155 K=1,25 - CH2O3(K)=0.0 - CH2O4(K)=0.0 -155 CONTINUE - ENDIF - ENDIF - ELSE - CO2F=0.0 - CH2O=0.0 - IF(ICTYP(NZ,NY,NX).EQ.4)THEN - DO 160 K=1,25 - CH2O3(K)=0.0 - CH2O4(K)=0.0 -160 CONTINUE - ENDIF - ENDIF - ELSE - CO2F=0.0 - CH2O=0.0 - IF(ICTYP(NZ,NY,NX).EQ.4)THEN - DO 165 K=1,25 - CH2O3(K)=0.0 - CH2O4(K)=0.0 -165 CONTINUE - ENDIF - ENDIF -C -C SHOOT AUTOTROPHIC RESPIRATION AFTER EMERGENCE -C -C -C N,P CONSTRAINT ON RESPIRATION FROM NON-STRUCTURAL C:N:P -C - IF(CCPOLB(NB,NZ,NY,NX).GT.ZERO)THEN - CNPG=AMIN1(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) - 2+CCPOLB(NB,NZ,NY,NX)/CPKI)) - ELSE - CNPG=1.0 - ENDIF -C -C RESPIRATION FROM NON-STRUCTURAL C DETERMINED BY TEMPERATURE, -C NON-STRUCTURAL C:N:P -C - RCO2C=AMAX1(0.0,VMXC*CPOOL(NB,NZ,NY,NX) - 2*TFN3(NZ,NY,NX))*CNPG*FDBKX(NB,NZ,NY,NX)*WFNG -C -C MAINTENANCE RESPIRATION FROM TEMPERATURE, PLANT STRUCTURAL N -C - RMNCS=AMAX1(0.0,RMPLT*TFN5*WTSHXN) - IF(IWTYP(NZ,NY,NX).EQ.2)THEN - RMNCS=RMNCS*WFNG - ENDIF -C -C GROWTH RESPIRATION FROM TOTAL - MAINTENANCE -C IF > 0 DRIVES GROWTH, IF < 0 DRIVES REMOBILIZATION -C - RCO2X=RCO2C-RMNCS - RCO2Y=AMAX1(0.0,RCO2X)*WFNSG - SNCR=AMAX1(0.0,-RCO2X) -C -C GROWTH RESPIRATION MAY BE LIMITED BY NON-STRUCTURAL N,P -C AVAILABLE FOR GROWTH -C - IF(RCO2Y.GT.0.0.AND.(CNSHX.GT.0.0.OR.CNLFX.GT.0.0))THEN - ZPOOLB=AMAX1(0.0,ZPOOL(NB,NZ,NY,NX)) - PPOOLB=AMAX1(0.0,PPOOL(NB,NZ,NY,NX)) - RCO2G=AMIN1(RCO2Y,ZPOOLB*DMSHD/(CNSHX+CNLFM+CNLFX*CNPG) - 2,PPOOLB*DMSHD/(CPSHX+CPLFM+CPLFX*CNPG)) - ELSE - RCO2G=0.0 - ENDIF -C -C TOTAL NON-STRUCTURAL C,N,P USED IN GROWTH -C AND GROWTH RESPIRATION DEPENDS ON GROWTH YIELDS -C ENTERED IN 'READQ' -C - CGROS=RCO2G/DMSHD - ZADDB=AMAX1(0.0,AMIN1(ZPOOL(NB,NZ,NY,NX) - 2,CGROS*(CNSHX+CNLFM+CNLFX*CNPG))) - PADDB=AMAX1(0.0,AMIN1(PPOOL(NB,NZ,NY,NX) - 2,CGROS*(CPSHX+CPLFM+CPLFX*CNPG))) - CNRDA=AMAX1(0.0,1.70*ZADDB-0.025*CH2O) -C -C TOTAL ABOVE-GROUND AUTOTROPHIC RESPIRATION BY BRANCH -C ACCUMULATE GPP, SHOOT AUTOTROPHIC RESPIRATION, NET C EXCHANGE -C - RCO2T=AMIN1(RMNCS,RCO2C)+RCO2G+SNCR+CNRDA - CARBN(NZ,NY,NX)=CARBN(NZ,NY,NX)+CO2F - TCO2T(NZ,NY,NX)=TCO2T(NZ,NY,NX)-RCO2T - TCO2A(NZ,NY,NX)=TCO2A(NZ,NY,NX)-RCO2T - CNET(NZ,NY,NX)=CNET(NZ,NY,NX)+CO2F-RCO2T - GPP(NY,NX)=GPP(NY,NX)+CO2F - TGPP(NY,NX)=TGPP(NY,NX)+CO2F - RECO(NY,NX)=RECO(NY,NX)-RCO2T - TRAU(NY,NX)=TRAU(NY,NX)-RCO2T -C IF(NZ.EQ.1)THEN -C WRITE(*,4477)'RCO2',I,J,NX,NY,NZ,NB,IFLGZ,CPOOL(NB,NZ,NY,NX) -C 2,CH2O,RMNCS,RCO2C,CGROS,CNRDA,CNPG,RCO2T,RCO2X,SNCR -C 3,RCO2G,DMSHD,ZADDB,PART(1),PART(2),DMLFB,DMSHB -C 4,WTRSVB(NB,NZ,NY,NX),WVSTKB(NB,NZ,NY,NX),WTSHXN -C 5,ZPOOL(NB,NZ,NY,NX),PPOOL(NB,NZ,NY,NX),PSILT(NZ,NY,NX) -C 6,ZADDB,RNH3B(NB,NZ,NY,NX),WFR(1,NG(NZ,NY,NX),NZ,NY,NX) -C 7,WFNG,TFN3(NZ,NY,NX),TFN5,FDBKX(NB,NZ,NY,NX),VMXC -4477 FORMAT(A8,7I4,40E12.4) -C ENDIF -C -C SHOOT AUTOTROPHIC RESPIRATION BEFORE EMERGENCE -C - ELSE -C -C N,P CONSTRAINT ON RESPIRATION FROM NON-STRUCTURAL C:N:P -C - IF(CCPOLB(NB,NZ,NY,NX).GT.ZERO)THEN - CNPG=AMIN1(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)) - ELSE - CNPG=1.0 - ENDIF -C -C RESPIRATION FROM NON-STRUCTURAL C DETERMINED BY TEMPERATURE, -C NON-STRUCTURAL C:N:P, O2 UPTAKE -C - RCO2CM=AMAX1(0.0,VMXC*CPOOL(NB,NZ,NY,NX) - 2*TFN4(NG(NZ,NY,NX),NZ,NY,NX))*CNPG*WFNG*FDBKX(NB,NZ,NY,NX) - RCO2C=RCO2CM*WFR(1,NG(NZ,NY,NX),NZ,NY,NX) -C -C MAINTENANCE RESPIRATION FROM TEMPERATURE, PLANT STRUCTURAL N -C - RMNCS=AMAX1(0.0,RMPLT*TFN6(NG(NZ,NY,NX))*WTSHXN) - IF(IWTYP(NZ,NY,NX).EQ.2)THEN - RMNCS=RMNCS*WFNG - ENDIF -C -C GROWTH RESPIRATION FROM TOTAL - MAINTENANCE -C IF > 0 DRIVES GROWTH, IF < 0 DRIVES REMOBILIZATION -C - RCO2XM=RCO2CM-RMNCS - RCO2X=RCO2C-RMNCS - RCO2YM=AMAX1(0.0,RCO2XM)*WFNSG - RCO2Y=AMAX1(0.0,RCO2X)*WFNSG - SNCRM=AMAX1(0.0,-RCO2XM) - SNCR=AMAX1(0.0,-RCO2X) -C -C GROWTH RESPIRATION MAY BE LIMITED BY NON-STRUCTURAL N,P -C AVAILABLE FOR GROWTH -C - IF(CNSHX.GT.0.0.OR.CNLFX.GT.0.0)THEN - ZPOOLB=AMAX1(0.0,ZPOOL(NB,NZ,NY,NX)) - PPOOLB=AMAX1(0.0,PPOOL(NB,NZ,NY,NX)) - FNP=AMIN1(ZPOOLB*DMSHD/(CNSHX+CNLFM+CNLFX*CNPG) - 2,PPOOLB*DMSHD/(CPSHX+CPLFM+CPLFX*CNPG)) - IF(RCO2YM.GT.0.0)THEN - RCO2GM=AMIN1(RCO2YM,FNP) - ELSE - RCO2GM=0.0 - ENDIF - IF(RCO2Y.GT.0.0)THEN - RCO2G=AMIN1(RCO2Y,FNP*WFR(1,NG(NZ,NY,NX),NZ,NY,NX)) - ELSE - RCO2G=0.0 - ENDIF - ELSE - RCO2GM=0.0 - RCO2G=0.0 - ENDIF -C -C TOTAL NON-STRUCTURAL C,N,P USED IN GROWTH -C AND GROWTH RESPIRATION DEPENDS ON GROWTH YIELDS -C ENTERED IN 'READQ' -C - CGROSM=RCO2GM/DMSHD - CGROS=RCO2G/DMSHD - ZADDBM=AMAX1(0.0,CGROSM*(CNSHX+CNLFM+CNLFX*CNPG)) - ZADDB=AMAX1(0.0,CGROS*(CNSHX+CNLFM+CNLFX*CNPG)) - PADDB=AMAX1(0.0,CGROS*(CPSHX+CPLFM+CPLFX*CNPG)) - CNRDM=AMAX1(0.0,1.70*ZADDBM) - CNRDA=AMAX1(0.0,1.70*ZADDB) -C -C TOTAL ABOVE-GROUND AUTOTROPHIC RESPIRATION BY BRANCH -C ACCUMULATE GPP, SHOOT AUTOTROPHIC RESPIRATION, NET C EXCHANGE -C - RCO2TM=RMNCS+RCO2GM+SNCRM+CNRDM - RCO2T=RMNCS+RCO2G+SNCR+CNRDA - RCO2M(1,NG(NZ,NY,NX),NZ,NY,NX)=RCO2M(1,NG(NZ,NY,NX),NZ,NY,NX) - 2+RCO2TM - RCO2N(1,NG(NZ,NY,NX),NZ,NY,NX)=RCO2N(1,NG(NZ,NY,NX),NZ,NY,NX) - 2+RCO2T - RCO2A(1,NG(NZ,NY,NX),NZ,NY,NX)=RCO2A(1,NG(NZ,NY,NX),NZ,NY,NX) - 2-RCO2T - CH2O=0.0 - ENDIF -C -C REMOVE C,N,P USED IN MAINTENANCE + GROWTH REPIRATION AND GROWTH -C FROM NON-STRUCTURAL POOLS -C - CPOOL(NB,NZ,NY,NX)=CPOOL(NB,NZ,NY,NX)+CH2O-AMIN1(RMNCS,RCO2C) - 2-CGROS-CNRDA - ZPOOL(NB,NZ,NY,NX)=ZPOOL(NB,NZ,NY,NX)-ZADDB+RNH3B(NB,NZ,NY,NX) - PPOOL(NB,NZ,NY,NX)=PPOOL(NB,NZ,NY,NX)-PADDB -C -C TRANSFER OF C4 FIXATION PRODUCTS FROM NON-STRUCTURAL POOLS -C IN MESOPHYLL TO THOSE IN BUNDLE SHEATH, DECARBOXYLATION -C OF C4 FIXATION PRODUCTS IN BUNDLE SHEATH, LEAKAGE OF DECARBOXYLATION -C PRODUCTS BACK TO MESOPHYLL IN C4 PLANTS -C - IF(ICTYP(NZ,NY,NX).EQ.4)THEN - DO 170 K=1,25 - IF(WGLF(K,NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - CCBS1=AMAX1(0.0,0.083E+09*CO2B(K,NB,NZ,NY,NX) - 2/(WGLF(K,NB,NZ,NY,NX)*FBS)) -C -C BUNDLE SHEATH LEAKAGE -C - CO2LK=AMIN1(AMAX1(0.0,CPOOL3(K,NB,NZ,NY,NX)-CH2O3(K)) - 2,5.0E-07*(CCBS1-CO2L(NZ,NY,NX))*WGLF(K,NB,NZ,NY,NX)*FBS) - IF(CPOOL3(K,NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - FPL3X=CPOOL3(K,NB,NZ,NY,NX)/(CPOOL3(K,NB,NZ,NY,NX) - 2+AMAX1(0.0,CO2B(K,NB,NZ,NY,NX))) - ELSE - FPL3X=0.0 - ENDIF - CPL3X=FPL3X*(CH2O3(K)+CO2LK) - CPL3Z=CPL3X-CH2O3(K)-CO2LK - CO2B(K,NB,NZ,NY,NX)=CO2B(K,NB,NZ,NY,NX)+FCO2B*CPL3Z - HCOB(K,NB,NZ,NY,NX)=HCOB(K,NB,NZ,NY,NX)+FHCOB*CPL3Z - CPOOL3(K,NB,NZ,NY,NX)=CPOOL3(K,NB,NZ,NY,NX)-CPL3X -C -C BUNDLE SHEATH DECARBOXYLATION -C - CCBS2=AMAX1(0.0,0.083E+09*CO2B(K,NB,NZ,NY,NX) - 2/(WGLF(K,NB,NZ,NY,NX)*FBS)) - CPL3K=2.5E-02*CPOOL3(K,NB,NZ,NY,NX)/(1.0+CCBS2/CO2KI) - CPOOL3(K,NB,NZ,NY,NX)=CPOOL3(K,NB,NZ,NY,NX)-CPL3K - CO2B(K,NB,NZ,NY,NX)=CO2B(K,NB,NZ,NY,NX)+FCO2B*CPL3K - HCOB(K,NB,NZ,NY,NX)=HCOB(K,NB,NZ,NY,NX)+FHCOB*CPL3K -C -C MESOPHYLL TO BUNDLE SHEATH TRANSFER -C - CPOOL4(K,NB,NZ,NY,NX)=CPOOL4(K,NB,NZ,NY,NX)+CH2O4(K) - CPL4M=0.5*(CPOOL4(K,NB,NZ,NY,NX)*WGLF(K,NB,NZ,NY,NX)*FBS - 2-CPOOL3(K,NB,NZ,NY,NX)*WGLF(K,NB,NZ,NY,NX)*FMP) - 2/(WGLF(K,NB,NZ,NY,NX)*(FBS+FMP)) - CPOOL4(K,NB,NZ,NY,NX)=CPOOL4(K,NB,NZ,NY,NX)-CPL4M - CPOOL3(K,NB,NZ,NY,NX)=CPOOL3(K,NB,NZ,NY,NX)+CPL4M - TCO2T(NZ,NY,NX)=TCO2T(NZ,NY,NX)-CO2LK - TCO2A(NZ,NY,NX)=TCO2A(NZ,NY,NX)-CO2LK - CNET(NZ,NY,NX)=CNET(NZ,NY,NX)-CO2LK - RECO(NY,NX)=RECO(NY,NX)-CO2LK - TRAU(NY,NX)=TRAU(NY,NX)-CO2LK - CO2LKF=CO2LK/ARLF(K,NB,NZ,NY,NX)*23.148 -C TC4=TC4+CH2O4(K) -C TLK=TLK+CO2LK -C IF(NB.EQ.1.AND.(K.EQ.16))THEN -C CCBS3=AMAX1(0.0,0.083E+09*CO2B(K,NB,NZ,NY,NX) -C 2/(WGLF(K,NB,NZ,NY,NX)*FBS)) -C WRITE(*,6667)'CO2K',I,J,NB,K,CPOOL4(K,NB,NZ,NY,NX) -C 2,CPOOL3(K,NB,NZ,NY,NX),CO2B(K,NB,NZ,NY,NX) -C 2,CPOOL4(K,NB,NZ,NY,NX)/(WGLF(K,NB,NZ,NY,NX)*FMP) -C 2,CPOOL3(K,NB,NZ,NY,NX)/(WGLF(K,NB,NZ,NY,NX)*FBS) -C 2,CO2B(K,NB,NZ,NY,NX)/(WGLF(K,NB,NZ,NY,NX)*FBS) -C 4,FPL3X,CH2O4(K),CH2O3(K),CPL4M,CPL3X,CPL3K,CO2LK -C 5,TC4,TLK,CO2LKF,CCBS1,CO2L(NZ,NY,NX),CCBS3 -C 6,ARLF(K,NB,NZ,NY,NX),HCOB(K,NB,NZ,NY,NX) -6667 FORMAT(A8,4I4,30E14.6) -C ENDIF - ENDIF -170 CONTINUE - ENDIF -C -C C,N,P GROWTH OF LEAF, SHEATH OR PETIOLE, STALK, -C STALK RESERVES, REPRODUCTIVE ORGANS, GRAIN -C - GROLF=PART(1)*CGROS*DMLFB - GROSHE=PART(2)*CGROS*DMSHB - GROSTK=PART(3)*CGROS*DMSTK(NZ,NY,NX) - GRORSV=PART(4)*CGROS*DMRSV(NZ,NY,NX) - GROHSK=PART(5)*CGROS*DMHSK(NZ,NY,NX) - GROEAR=PART(6)*CGROS*DMEAR(NZ,NY,NX) - GROGR=PART(7)*CGROS*DMGR(NZ,NY,NX) - GROSHT=CGROS*DMSHT - GROLFN=GROLF*CNLFB*(ZPLFM+ZPLFD*CNPG) - GROSHN=GROSHE*CNSHB - GROSTN=GROSTK*CNSTK(NZ,NY,NX) - GRORSN=GRORSV*CNRSV(NZ,NY,NX) - GROHSN=GROHSK*CNHSK(NZ,NY,NX) - GROEAN=GROEAR*CNEAR(NZ,NY,NX) - GROGRN=GROGR*CNRSV(NZ,NY,NX) - GROLFP=GROLF*CPLFB*(ZPLFM+ZPLFD*CNPG) - GROSHP=GROSHE*CPSHB - GROSTP=GROSTK*CPSTK(NZ,NY,NX) - GRORSP=GRORSV*CPRSV(NZ,NY,NX) - GROHSP=GROHSK*CPHSK(NZ,NY,NX) - GROEAP=GROEAR*CPEAR(NZ,NY,NX) - GROGRP=GROGR*CPRSV(NZ,NY,NX) - WTLFB(NB,NZ,NY,NX)=WTLFB(NB,NZ,NY,NX)+GROLF - WTSHEB(NB,NZ,NY,NX)=WTSHEB(NB,NZ,NY,NX)+GROSHE - WTSTKB(NB,NZ,NY,NX)=WTSTKB(NB,NZ,NY,NX)+GROSTK - WTRSVB(NB,NZ,NY,NX)=WTRSVB(NB,NZ,NY,NX)+GRORSV - WTHSKB(NB,NZ,NY,NX)=WTHSKB(NB,NZ,NY,NX)+GROHSK - WTEARB(NB,NZ,NY,NX)=WTEARB(NB,NZ,NY,NX)+GROEAR - WTLFBN(NB,NZ,NY,NX)=WTLFBN(NB,NZ,NY,NX)+GROLFN - WTSHBN(NB,NZ,NY,NX)=WTSHBN(NB,NZ,NY,NX)+GROSHN - WTSTBN(NB,NZ,NY,NX)=WTSTBN(NB,NZ,NY,NX)+GROSTN - WTRSBN(NB,NZ,NY,NX)=WTRSBN(NB,NZ,NY,NX)+GRORSN - WTHSBN(NB,NZ,NY,NX)=WTHSBN(NB,NZ,NY,NX)+GROHSN - WTEABN(NB,NZ,NY,NX)=WTEABN(NB,NZ,NY,NX)+GROEAN - WTLFBP(NB,NZ,NY,NX)=WTLFBP(NB,NZ,NY,NX)+GROLFP - WTSHBP(NB,NZ,NY,NX)=WTSHBP(NB,NZ,NY,NX)+GROSHP - WTSTBP(NB,NZ,NY,NX)=WTSTBP(NB,NZ,NY,NX)+GROSTP - WTRSBP(NB,NZ,NY,NX)=WTRSBP(NB,NZ,NY,NX)+GRORSP - WTHSBP(NB,NZ,NY,NX)=WTHSBP(NB,NZ,NY,NX)+GROHSP - WTEABP(NB,NZ,NY,NX)=WTEABP(NB,NZ,NY,NX)+GROEAP -C -C DISTRIBUTE LEAF GROWTH AMONG CURRENTLY GROWING NODES -C - CCE=AMIN1(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)) - ETOL=1.0+CCE - IF(NB.EQ.NB1(NZ,NY,NX).AND.HTCTL(NZ,NY,NX).LE.SDPTH(NZ,NY,NX))THEN - NNOD1=0 - ELSE - NNOD1=1 - ENDIF - IF(GROLF.GT.0.0)THEN - MXNOD=KVSTG(NB,NZ,NY,NX) - MNNOD=MAX(NNOD1,MXNOD-NNOD(NZ,NY,NX)+1) - MXNOD=MAX(MXNOD,MNNOD) - KNOD=MXNOD-MNNOD+1 - GNOD=KNOD - ALLOCL=1.0/GNOD - GRO=ALLOCL*GROLF - GRON=ALLOCL*GROLFN - GROP=ALLOCL*GROLFP - GSLA=ALLOCL*FNOD(NZ,NY,NX)*NNOD(NZ,NY,NX) -C -C GROWTH AT EACH CURRENT NODE -C - DO 490 KK=MNNOD,MXNOD - K=MOD(KK,25) - IF(K.EQ.0.AND.KK.NE.0)K=25 - WGLF(K,NB,NZ,NY,NX)=WGLF(K,NB,NZ,NY,NX)+GRO - WGLFN(K,NB,NZ,NY,NX)=WGLFN(K,NB,NZ,NY,NX)+GRON - WGLFP(K,NB,NZ,NY,NX)=WGLFP(K,NB,NZ,NY,NX)+GROP - WSLF(K,NB,NZ,NY,NX)=WSLF(K,NB,NZ,NY,NX) - 2+AMIN1(GRON*CNWS(NZ,NY,NX),GROP*CPWS(NZ,NY,NX)) -C -C SPECIFIC LEAF AREA FUNCTION OF CURRENT LEAF MASS -C WITH PARAMETERS FROM 'READQ' -C - SLA=ETOL*SLA1(NZ,NY,NX)*(AMAX1(ZEROL(NZ,NY,NX) - 2,WGLF(K,NB,NZ,NY,NX))/(PP(NZ,NY,NX)*GSLA))**SLA2*WFNS - GROA=GRO*SLA - ARLFB(NB,NZ,NY,NX)=ARLFB(NB,NZ,NY,NX)+GROA - ARLF(K,NB,NZ,NY,NX)=ARLF(K,NB,NZ,NY,NX)+GROA -490 CONTINUE - ENDIF -C -C DISTRIBUTE SHEATH OR PETIOLE GROWTH AMONG CURRENTLY GROWING NODES -C - IF(GROSHE.GT.0.0)THEN - MXNOD=KVSTG(NB,NZ,NY,NX) - MNNOD=MAX(NNOD1,MXNOD-NNOD(NZ,NY,NX)+1) - MXNOD=MAX(MXNOD,MNNOD) - GNOD=MXNOD-MNNOD+1 - ALLOCS=1.0/GNOD - GRO=ALLOCS*GROSHE - GRON=ALLOCS*GROSHN - GROP=ALLOCS*GROSHP - GSSL=ALLOCL*FNOD(NZ,NY,NX)*NNOD(NZ,NY,NX) -C -C GROWTH AT EACH CURRENT NODE -C - DO 505 KK=MNNOD,MXNOD - K=MOD(KK,25) - IF(K.EQ.0.AND.KK.NE.0)K=25 - WGSHE(K,NB,NZ,NY,NX)=WGSHE(K,NB,NZ,NY,NX)+GRO - WGSHN(K,NB,NZ,NY,NX)=WGSHN(K,NB,NZ,NY,NX)+GRON - WGSHP(K,NB,NZ,NY,NX)=WGSHP(K,NB,NZ,NY,NX)+GROP - WSSHE(K,NB,NZ,NY,NX)=WSSHE(K,NB,NZ,NY,NX) - 2+AMIN1(GRON*CNWS(NZ,NY,NX),GROP*CPWS(NZ,NY,NX)) -C -C SPECIFIC SHEATH OR PETIOLE LENGTH FUNCTION OF CURRENT MASS -C WITH PARAMETERS FROM 'READQ' -C - IF(WGLF(K,NB,NZ,NY,NX).GT.0.0)THEN - SSL=ETOL*SSL1(NZ,NY,NX)*(AMAX1(ZEROL(NZ,NY,NX) - 4,WGSHE(K,NB,NZ,NY,NX))/(PP(NZ,NY,NX)*GSSL))**SSL2*WFNS - GROS=GRO/PP(NZ,NY,NX)*SSL - HTSHE(K,NB,NZ,NY,NX)=HTSHE(K,NB,NZ,NY,NX)+GROS*ANGSH(NZ,NY,NX) -C IF(I.EQ.120.AND.J.EQ.24)THEN -C WRITE(*,2526)'HTSHE',I,J,NZ,NB,K,SSL,WGSHE(K,NB,NZ,NY,NX) -C 2,HTSHE(K,NB,NZ,NY,NX),PP(NZ,NY,NX),SSL1(NZ,NY,NX) -C 3,GSLA,SSL3,WFNS,GROS,GRO,ANGSH(NZ,NY,NX),ZEROL(NZ,NY,NX) -C 4,CCPOLB(NB,NZ,NY,NX),ETOL -2526 FORMAT(A8,5I4,20E12.4) -C ENDIF - ENDIF -505 CONTINUE - ENDIF -C -C DISTRIBUTE STALK GROWTH AMONG CURRENTLY GROWING NODES -C - IF(IDAY(1,NB,NZ,NY,NX).EQ.0)THEN - NN=0 - ELSE - NN=1 - ENDIF - MXNOD=KVSTG(NB,NZ,NY,NX) - MNNOD=MAX(MIN(NN,MAX(NN,MXNOD-NNOD(NZ,NY,NX))) - 2,KVSTG(NB,NZ,NY,NX)-23) - MXNOD=MAX(MXNOD,MNNOD) - IF(GROSTK.GT.0.0)THEN - GNOD=MXNOD-MNNOD+1 - ALLOCN=1.0/GNOD - GRO=ALLOCN*GROSTK - GRON=ALLOCN*GROSTN - GROP=ALLOCN*GROSTP -C -C SPECIFIC INTERNODE LENGTH FUNCTION OF CURRENT STALK MASS -C WITH PARAMETERS FROM 'READQ' -C - SNL=ETOL*SNL1(NZ,NY,NX)*(WTSTKB(NB,NZ,NY,NX)/PP(NZ,NY,NX))**SNL2 - GROH=GRO/PP(NZ,NY,NX)*SNL - KX=MOD(MNNOD-1,25) - IF(KX.EQ.0.AND.MNNOD-1.NE.0)KX=25 -C -C GROWTH AT EACH CURRENT NODE -C - DO 510 KK=MNNOD,MXNOD - K1=MOD(KK,25) - IF(K1.EQ.0.AND.KK.NE.0)K1=25 - K2=MOD(KK-1,25) - IF(K2.EQ.0.AND.KK-1.NE.0)K2=25 - WGNODE(K1,NB,NZ,NY,NX)=WGNODE(K1,NB,NZ,NY,NX)+GRO - WGNODN(K1,NB,NZ,NY,NX)=WGNODN(K1,NB,NZ,NY,NX)+GRON - WGNODP(K1,NB,NZ,NY,NX)=WGNODP(K1,NB,NZ,NY,NX)+GROP - HTNODX(K1,NB,NZ,NY,NX)=HTNODX(K1,NB,NZ,NY,NX)+GROH*ANGBR(NZ,NY,NX) - IF(K1.NE.0)THEN - HTNODE(K1,NB,NZ,NY,NX)=HTNODX(K1,NB,NZ,NY,NX) - 2+HTNODE(K2,NB,NZ,NY,NX) - ELSE - HTNODE(K1,NB,NZ,NY,NX)=HTNODX(K1,NB,NZ,NY,NX) - ENDIF -C IF(NZ.EQ.1)THEN -C WRITE(*,515)'HTNODE',I,J,NZ,NB,KK,K1,K2,MNNOD,MXNOD -C 1,NNOD(NZ,NY,NX),ARLF(K1,NB,NZ,NY,NX) -C 2,HTNODE(K1,NB,NZ,NY,NX),HTNODE(K2,NB,NZ,NY,NX),SNL,GRO -C 3,ALLOCN,WTSTKB(NB,NZ,NY,NX),WGNODE(K1,NB,NZ,NY,NX) -C 4,HTNODX(K1,NB,NZ,NY,NX),PP(NZ,NY,NX),GROSTK -515 FORMAT(A8,10I4,20E12.4) -C ENDIF -510 CONTINUE - ENDIF -C -C RECOVERY OF REMOBILIZABLE N,P DURING REMOBILIZATION DEPENDS -C ON SHOOT NON-STRUCTURAL C:N:P -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) - 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) - ELSE - CCC=0.0 - CNC=0.0 - CPC=0.0 - ENDIF - RCCC=RCCZ(IBTYP(NZ,NY,NX))+CCC*RCCY(IBTYP(NZ,NY,NX)) - RCCN=CNC*RCCX(IGTYP(NZ,NY,NX)) - RCCP=CPC*RCCQ(IGTYP(NZ,NY,NX)) -C -C WITHDRAW REMOBILIZABLE C,N,P FROM LOWEST NODE AFTER -C MAXIMUM NODE NUMBER OF 25 IS REACHED -C - IF(IFLGG(NB,NZ,NY,NX).EQ.1)THEN - KVSTGX=KVSTG(NB,NZ,NY,NX)-24 - IF(KVSTGX.GT.0)THEN - K=MOD(KVSTGX,25) - IF(K.EQ.0.AND.KVSTGX.GT.0)K=25 - KX=MOD(KVSTG(NB,NZ,NY,NX),25) - IF(KX.EQ.0.AND.KVSTG(NB,NZ,NY,NX).NE.0)KX=25 - FSNC=TFN3(NZ,NY,NX)*XRLA(NZ,NY,NX) -C -C REMOBILIZATION OF LEAF C,N,P ALSO DEPENDS ON STRUCTURAL C:N:P -C - IF(IFLGP(NB,NZ,NY,NX).EQ.1)THEN - WGLFX(NB,NZ,NY,NX)=AMAX1(0.0,WGLF(K,NB,NZ,NY,NX)) - WGLFNX(NB,NZ,NY,NX)=AMAX1(0.0,WGLFN(K,NB,NZ,NY,NX)) - WGLFPX(NB,NZ,NY,NX)=AMAX1(0.0,WGLFP(K,NB,NZ,NY,NX)) - ARLFZ(NB,NZ,NY,NX)=AMAX1(0.0,ARLF(K,NB,NZ,NY,NX)) - IF(WGLFX(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - RCCLX(NB,NZ,NY,NX)=RCCC*WGLFX(NB,NZ,NY,NX) - RCZLX(NB,NZ,NY,NX)=WGLFNX(NB,NZ,NY,NX)*(RCCN+(1.0-RCCN)*RCCC) - RCPLX(NB,NZ,NY,NX)=WGLFPX(NB,NZ,NY,NX)*(RCCP+(1.0-RCCP)*RCCC) - ELSE - RCCLX(NB,NZ,NY,NX)=0.0 - RCZLX(NB,NZ,NY,NX)=0.0 - RCPLX(NB,NZ,NY,NX)=0.0 - ENDIF - ENDIF -C -C FRACTION OF CURRENT LEAF TO BE REMOBILIZED -C - IF(FSNC*WGLFX(NB,NZ,NY,NX).GT.WGLF(K,NB,NZ,NY,NX) - 2.AND.WGLFX(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - FSNCL=AMAX1(0.0,WGLF(K,NB,NZ,NY,NX)/WGLFX(NB,NZ,NY,NX)) - ELSE - FSNCL=FSNC - ENDIF -C -C NON-REMOBILIZABLE C,N,P BECOMES LITTERFALL ALLOCATED -C TO FRACTIONS SET IN 'STARTQ' -C - DO 6300 M=1,4 - CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX)+CFOPC(5,M,NZ,NY,NX) - 2*FSNCL*(WGLFX(NB,NZ,NY,NX)-RCCLX(NB,NZ,NY,NX))*FWODB(0) - ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX)+CFOPN(5,M,NZ,NY,NX) - 2*FSNCL*(WGLFNX(NB,NZ,NY,NX)-RCZLX(NB,NZ,NY,NX))*FWODLN(0) - PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX)+CFOPP(5,M,NZ,NY,NX) - 2*FSNCL*(WGLFPX(NB,NZ,NY,NX)-RCPLX(NB,NZ,NY,NX))*FWODLP(0) - CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX)+CFOPC(1,M,NZ,NY,NX) - 2*FSNCL*(WGLFX(NB,NZ,NY,NX)-RCCLX(NB,NZ,NY,NX))*FWODB(1) - ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX)+CFOPN(1,M,NZ,NY,NX) - 2*FSNCL*(WGLFNX(NB,NZ,NY,NX)-RCZLX(NB,NZ,NY,NX))*FWODLN(1) - PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX)+CFOPP(1,M,NZ,NY,NX) - 2*FSNCL*(WGLFPX(NB,NZ,NY,NX)-RCPLX(NB,NZ,NY,NX))*FWODLP(1) -6300 CONTINUE -C -C UPDATE STATE VARIABLES FOR REMOBILIZATION AND LITTERFALL -C - ARLFB(NB,NZ,NY,NX)=ARLFB(NB,NZ,NY,NX) - 2-FSNCL*ARLFZ(NB,NZ,NY,NX) - WTLFB(NB,NZ,NY,NX)=WTLFB(NB,NZ,NY,NX) - 2-FSNCL*WGLFX(NB,NZ,NY,NX) - WTLFBN(NB,NZ,NY,NX)=WTLFBN(NB,NZ,NY,NX) - 2-FSNCL*WGLFNX(NB,NZ,NY,NX) - WTLFBP(NB,NZ,NY,NX)=WTLFBP(NB,NZ,NY,NX) - 2-FSNCL*WGLFPX(NB,NZ,NY,NX) - ARLF(K,NB,NZ,NY,NX)=ARLF(K,NB,NZ,NY,NX) - 2-FSNCL*ARLFZ(NB,NZ,NY,NX) - WGLF(K,NB,NZ,NY,NX)=WGLF(K,NB,NZ,NY,NX) - 2-FSNCL*WGLFX(NB,NZ,NY,NX) - WGLFN(K,NB,NZ,NY,NX)=WGLFN(K,NB,NZ,NY,NX) - 2-FSNCL*WGLFNX(NB,NZ,NY,NX) - WGLFP(K,NB,NZ,NY,NX)=WGLFP(K,NB,NZ,NY,NX) - 2-FSNCL*WGLFPX(NB,NZ,NY,NX) - WSLF(K,NB,NZ,NY,NX)=AMAX1(0.0,WSLF(K,NB,NZ,NY,NX) - 2-FSNCL*AMAX1(WGLFNX(NB,NZ,NY,NX)*CNWS(NZ,NY,NX) - 3,WGLFPX(NB,NZ,NY,NX)*CPWS(NZ,NY,NX))) - CPOOL(NB,NZ,NY,NX)=CPOOL(NB,NZ,NY,NX)+FSNCL*RCCLX(NB,NZ,NY,NX) - ZPOOL(NB,NZ,NY,NX)=ZPOOL(NB,NZ,NY,NX)+FSNCL*RCZLX(NB,NZ,NY,NX) - PPOOL(NB,NZ,NY,NX)=PPOOL(NB,NZ,NY,NX)+FSNCL*RCPLX(NB,NZ,NY,NX) -C -C REMOBILIZATION OF SHEATHS OR PETIOLE C,N,P ALSO DEPENDS ON -C STRUCTURAL C:N:P -C - IF(IFLGP(NB,NZ,NY,NX).EQ.1)THEN - WGSHEX(NB,NZ,NY,NX)=AMAX1(0.0,WGSHE(K,NB,NZ,NY,NX)) - WGSHNX(NB,NZ,NY,NX)=AMAX1(0.0,WGSHN(K,NB,NZ,NY,NX)) - WGSHPX(NB,NZ,NY,NX)=AMAX1(0.0,WGSHP(K,NB,NZ,NY,NX)) - HTSHEX(NB,NZ,NY,NX)=AMAX1(0.0,HTSHE(K,NB,NZ,NY,NX)) - IF(WGSHEX(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - RCCSX(NB,NZ,NY,NX)=RCCC*WGSHEX(NB,NZ,NY,NX) - RCZSX(NB,NZ,NY,NX)=WGSHNX(NB,NZ,NY,NX) - 2*(RCCN+(1.0-RCCN)*RCCSX(NB,NZ,NY,NX)/WGSHEX(NB,NZ,NY,NX)) - RCPSX(NB,NZ,NY,NX)=WGSHPX(NB,NZ,NY,NX) - 2*(RCCP+(1.0-RCCP)*RCCSX(NB,NZ,NY,NX)/WGSHEX(NB,NZ,NY,NX)) - ELSE - RCCSX(NB,NZ,NY,NX)=0.0 - RCZSX(NB,NZ,NY,NX)=0.0 - RCPSX(NB,NZ,NY,NX)=0.0 - ENDIF - WTSTXB(NB,NZ,NY,NX)=WTSTXB(NB,NZ,NY,NX)+WGNODE(K,NB,NZ,NY,NX) - WTSTXN(NB,NZ,NY,NX)=WTSTXN(NB,NZ,NY,NX)+WGNODN(K,NB,NZ,NY,NX) - WTSTXP(NB,NZ,NY,NX)=WTSTXP(NB,NZ,NY,NX)+WGNODP(K,NB,NZ,NY,NX) -C IF(NZ.EQ.2)THEN -C WRITE(*,2358)'WTSTXB',I,J,NZ,NB,K,WTSTXB(NB,NZ,NY,NX) -C 2,WTSTKB(NB,NZ,NY,NX),WGNODE(K,NB,NZ,NY,NX) -2358 FORMAT(A8,5I4,12E12.4) -C ENDIF - WGNODE(K,NB,NZ,NY,NX)=0.0 - WGNODN(K,NB,NZ,NY,NX)=0.0 - WGNODP(K,NB,NZ,NY,NX)=0.0 - HTNODX(K,NB,NZ,NY,NX)=0.0 - ENDIF -C -C FRACTION OF CURRENT SHEATH TO BE REMOBILIZED -C - IF(FSNC*WGSHEX(NB,NZ,NY,NX).GT.WGSHE(K,NB,NZ,NY,NX) - 2.AND.WGSHEX(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - FSNCS=AMAX1(0.0,WGSHE(K,NB,NZ,NY,NX)/WGSHEX(NB,NZ,NY,NX)) - ELSE - FSNCS=FSNC - ENDIF -C -C NON-REMOBILIZABLE C,N,P BECOMES LITTERFALL ALLOCATED -C TO FRACTIONS SET IN 'STARTQ' -C - DO 6305 M=1,4 - CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX)+CFOPC(5,M,NZ,NY,NX) - 2*FSNCS*(WGSHEX(NB,NZ,NY,NX)-RCCSX(NB,NZ,NY,NX))*FWODB(0) - ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX)+CFOPN(5,M,NZ,NY,NX) - 2*FSNCS*(WGSHNX(NB,NZ,NY,NX)-RCZSX(NB,NZ,NY,NX))*FWODSN(0) - PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX)+CFOPP(5,M,NZ,NY,NX) - 2*FSNCS*(WGSHPX(NB,NZ,NY,NX)-RCPSX(NB,NZ,NY,NX))*FWODSP(0) - CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX)+CFOPC(2,M,NZ,NY,NX) - 2*FSNCS*(WGSHEX(NB,NZ,NY,NX)-RCCSX(NB,NZ,NY,NX))*FWODB(1) - ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX)+CFOPN(2,M,NZ,NY,NX) - 2*FSNCS*(WGSHNX(NB,NZ,NY,NX)-RCZSX(NB,NZ,NY,NX))*FWODSN(1) - PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX)+CFOPP(2,M,NZ,NY,NX) - 2*FSNCS*(WGSHPX(NB,NZ,NY,NX)-RCPSX(NB,NZ,NY,NX))*FWODSP(1) -6305 CONTINUE -C -C UPDATE STATE VARIABLES FOR REMOBILIZATION AND LITTERFALL -C - WTSHEB(NB,NZ,NY,NX)=WTSHEB(NB,NZ,NY,NX) - 2-FSNCS*WGSHEX(NB,NZ,NY,NX) - WTSHBN(NB,NZ,NY,NX)=WTSHBN(NB,NZ,NY,NX) - 2-FSNCS*WGSHNX(NB,NZ,NY,NX) - WTSHBP(NB,NZ,NY,NX)=WTSHBP(NB,NZ,NY,NX) - 2-FSNCS*WGSHPX(NB,NZ,NY,NX) - HTSHE(K,NB,NZ,NY,NX)=HTSHE(K,NB,NZ,NY,NX) - 2-FSNCS*HTSHEX(NB,NZ,NY,NX) - WGSHE(K,NB,NZ,NY,NX)=WGSHE(K,NB,NZ,NY,NX) - 2-FSNCS*WGSHEX(NB,NZ,NY,NX) - WGSHN(K,NB,NZ,NY,NX)=WGSHN(K,NB,NZ,NY,NX) - 2-FSNCS*WGSHNX(NB,NZ,NY,NX) - WGSHP(K,NB,NZ,NY,NX)=WGSHP(K,NB,NZ,NY,NX) - 2-FSNCS*WGSHPX(NB,NZ,NY,NX) - WSSHE(K,NB,NZ,NY,NX)=AMAX1(0.0,WSSHE(K,NB,NZ,NY,NX) - 2-FSNCS*AMAX1(WGSHNX(NB,NZ,NY,NX)*CNWS(NZ,NY,NX) - 3,WGSHPX(NB,NZ,NY,NX)*CPWS(NZ,NY,NX))) - CPOOL(NB,NZ,NY,NX)=CPOOL(NB,NZ,NY,NX)+FSNCS*RCCSX(NB,NZ,NY,NX) - ZPOOL(NB,NZ,NY,NX)=ZPOOL(NB,NZ,NY,NX)+FSNCS*RCZSX(NB,NZ,NY,NX) - PPOOL(NB,NZ,NY,NX)=PPOOL(NB,NZ,NY,NX)+FSNCS*RCPSX(NB,NZ,NY,NX) - ENDIF - ENDIF -C -C REMOBILIZATION OF STALK RESERVE C,N,P IF GROWTH RESPIRATION < 0 -C - IF(IFLGZ.EQ.0)THEN - IF(SNCR.GT.0.0.AND.WTRSVB(NB,NZ,NY,NX).GT.0.0)THEN - RCO2V=AMIN1(SNCR,VMXC*WTRSVB(NB,NZ,NY,NX)*TFN3(NZ,NY,NX)) - WTRSVB(NB,NZ,NY,NX)=WTRSVB(NB,NZ,NY,NX)-RCO2V - SNCR=SNCR-RCO2V - ENDIF - ENDIF -C -C TOTAL REMOBILIZATION = GROWTH RESPIRATION < 0 + DECIDUOUS LEAF -C FALL DURING AUTUMN + REMOBILZATION DURING GRAIN FILL IN ANNUALS -C - IF(ISTYP(NZ,NY,NX).NE.0.AND.IFLGZ.EQ.1.AND.IFLGY.EQ.1)THEN - SNCZ=FXFB(IBTYP(NZ,NY,NX)) - 2*WTLSB(NB,NZ,NY,NX)*AMIN1(1.0,FLGZ(NB,NZ,NY,NX)/FLGZX) - ELSE - SNCZ=0.0 - ENDIF - SNCX=SNCR+SNCZ - IF(SNCX.GT.ZEROP(NZ,NY,NX))THEN - SNCF=SNCZ/SNCX - KSNC=INT(0.5*(KVSTG(NB,NZ,NY,NX)-KVSTGN(NB,NZ,NY,NX)))+1 - XKSNC=KSNC - KN=MAX(0,KVSTGN(NB,NZ,NY,NX)-1) -C IF(NZ.EQ.2.OR.NZ.EQ.3)THEN -C WRITE(*,1266)'SNCX0',I,J,NX,NY,NZ,NB,SNCY,SNCR,SNCX,SNCF -C 2,CPOOL(NB,NZ,NY,NX),WTLSB(NB,NZ,NY,NX),RCCC -1266 FORMAT(A8,6I4,12E16.8) -C ENDIF -C -C TRANSFER NON-STRUCTURAL C,N,P FROM BRANCHES TO MAIN STEM -C IF MAIN STEM POOLS ARE DEPLETED -C - IF(IBTYP(NZ,NY,NX).NE.0.AND.IGTYP(NZ,NY,NX).GT.1 - 2.AND.NB.EQ.NB1(NZ,NY,NX).AND.SNCF.EQ.0)THEN - NBY=0 - DO 584 NBL=1,NBR(NZ,NY,NX) - NBZ(NBL)=0 -584 CONTINUE - DO 586 NBL=1,NBR(NZ,NY,NX) - NBX=KVSTG(NB,NZ,NY,NX) - DO 585 NBK=1,NBR(NZ,NY,NX) - IF(IDTHB(NBK,NZ,NY,NX).EQ.0.AND.NBK.NE.NB1(NZ,NY,NX) - 2.AND.NBTB(NBK,NZ,NY,NX).LT.NBX - 3.AND.NBTB(NBK,NZ,NY,NX).GT.NBY)THEN - NBZ(NBL)=NBK - NBX=NBTB(NBK,NZ,NY,NX) - ENDIF -585 CONTINUE - IF(NBZ(NBL).NE.0)THEN - NBY=NBTB(NBZ(NBL),NZ,NY,NX) - ENDIF -586 CONTINUE - DO 580 NBL=1,NBR(NZ,NY,NX) - IF(NBZ(NBL).NE.0)THEN - IF(NBTB(NBZ(NBL),NZ,NY,NX).LT.KK)THEN - IF(CPOOL(NBZ(NBL),NZ,NY,NX).GT.0)THEN - XFRC=1.0E-02*AMIN1(SNCX,CPOOL(NBZ(NBL),NZ,NY,NX)) - XFRN=XFRC*ZPOOL(NBZ(NBL),NZ,NY,NX)/CPOOL(NBZ(NBL),NZ,NY,NX) - XFRP=XFRC*PPOOL(NBZ(NBL),NZ,NY,NX)/CPOOL(NBZ(NBL),NZ,NY,NX) - ELSE - XFRC=0.0 - XFRN=1.0E-02*ZPOOL(NBZ(NBL),NZ,NY,NX) - XFRP=1.0E-02*PPOOL(NBZ(NBL),NZ,NY,NX) - ENDIF - CPOOL(NBZ(NBL),NZ,NY,NX)=CPOOL(NBZ(NBL),NZ,NY,NX)-XFRC - ZPOOL(NBZ(NBL),NZ,NY,NX)=ZPOOL(NBZ(NBL),NZ,NY,NX)-XFRN - PPOOL(NBZ(NBL),NZ,NY,NX)=PPOOL(NBZ(NBL),NZ,NY,NX)-XFRP - CPOOL(NB1(NZ,NY,NX),NZ,NY,NX)=CPOOL(NB1(NZ,NY,NX),NZ,NY,NX) - 2+XFRC*SNCF - ZPOOL(NB1(NZ,NY,NX),NZ,NY,NX)=ZPOOL(NB1(NZ,NY,NX),NZ,NY,NX) - 2+XFRN - PPOOL(NB1(NZ,NY,NX),NZ,NY,NX)=PPOOL(NB1(NZ,NY,NX),NZ,NY,NX) - 2+XFRP - SNCX=SNCX-XFRC - IF(SNCX.LE.0.0)GO TO 595 - ENDIF - ENDIF -580 CONTINUE - ENDIF -C -C REMOBILIZATION AND LITTERFALL WHEN GROWTH RESPIRATION < 0 -C STARTING FROM LOWEST LEAFED NODE AND PROCEEDING UPWARDS -C -C IF(NZ.EQ.2.OR.NZ.EQ.3)THEN -C WRITE(*,1266)'SNCX1',I,J,NX,NY,NZ,NB,SNCY,SNCR,SNCX,SNCF -C 2,CPOOL(NB,NZ,NY,NX),WTLSB(NB,NZ,NY,NX),RCCC -C ENDIF - DO 575 N=1,KSNC - SNCT=SNCX/XKSNC - DO 650 KK=KN,KVSTG(NB,NZ,NY,NX) - SNCLF=0.0 - SNCSH=0.0 - K=MOD(KK,25) - IF(K.EQ.0.AND.KK.NE.0)K=25 -C -C REMOBILIZATION OF LEAF C,N,P DEPENDS ON NON-STRUCTURAL C:N:P -C - IF(WGLF(K,NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - FNCLF=WGLF(K,NB,NZ,NY,NX)/(WGLF(K,NB,NZ,NY,NX) - 2+WGSHE(K,NB,NZ,NY,NX)) - SNCLF=FNCLF*SNCT - SNCSH=SNCT-SNCLF - RCCL=RCCC*WGLF(K,NB,NZ,NY,NX) - RCZL=WGLFN(K,NB,NZ,NY,NX)*(RCCN+(1.0-RCCN)*RCCC) - RCPL=WGLFP(K,NB,NZ,NY,NX)*(RCCP+(1.0-RCCP)*RCCC) -C -C FRACTION OF CURRENT LEAF TO BE REMOBILIZED -C - IF(RCCL.GT.ZEROP(NZ,NY,NX))THEN - FSNCL=AMAX1(0.0,AMIN1(1.0,SNCLF/RCCL)) - ELSE - FSNCL=1.0 - ENDIF - FSNAL=FSNCL -C -C NON-REMOBILIZABLE C,N,P BECOMES LITTERFALL ALLOCATED -C TO FRACTIONS SET IN 'STARTQ' -C -C IF(NZ.EQ.1)THEN -C WRITE(*,4898)'SNCT1',I,J,NX,NY,NZ,NB,K,N -C 2,KN,KVSTG(NB,NZ,NY,NX),SNCLF,SNCT -C 2,FSNCL,RCCL,WTLFB(NB,NZ,NY,NX),ARLFB(NB,NZ,NY,NX) -C 2,WGLFN(K,NB,NZ,NY,NX),WGLFLN(1,K,NB,NZ,NY,NX) -C 3,ARLF(K,NB,NZ,NY,NX) -4898 FORMAT(A8,10I4,12E16.8) -C ENDIF - DO 6310 M=1,4 - CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX)+CFOPC(5,M,NZ,NY,NX) - 2*FSNCL*(WGLF(K,NB,NZ,NY,NX)-RCCL)*FWODB(0) - ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX)+CFOPN(5,M,NZ,NY,NX) - 2*FSNCL*(WGLFN(K,NB,NZ,NY,NX)-RCZL)*FWODLN(0) - PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX)+CFOPP(5,M,NZ,NY,NX) - 2*FSNCL*(WGLFP(K,NB,NZ,NY,NX)-RCPL)*FWODLP(0) - CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX)+CFOPC(1,M,NZ,NY,NX) - 2*FSNCL*(WGLF(K,NB,NZ,NY,NX)-RCCL)*FWODB(1) - ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX)+CFOPN(1,M,NZ,NY,NX) - 2*FSNCL*(WGLFN(K,NB,NZ,NY,NX)-RCZL)*FWODLN(1) - PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX)+CFOPP(1,M,NZ,NY,NX) - 2*FSNCL*(WGLFP(K,NB,NZ,NY,NX)-RCPL)*FWODLP(1) -6310 CONTINUE - IF(K.NE.0)THEN - CSNC(2,1,0,NZ,NY,NX)=CSNC(2,1,0,NZ,NY,NX) - 2+FSNCL*(CPOOL3(K,NB,NZ,NY,NX)+CPOOL4(K,NB,NZ,NY,NX)) - CPOOL3(K,NB,NZ,NY,NX)=CPOOL3(K,NB,NZ,NY,NX) - 2-FSNCL*CPOOL3(K,NB,NZ,NY,NX) - CPOOL4(K,NB,NZ,NY,NX)=CPOOL4(K,NB,NZ,NY,NX) - 2-FSNCL*CPOOL4(K,NB,NZ,NY,NX) - ENDIF -C -C UPDATE STATE VARIABLES FOR REMOBILIZATION AND LITTERFALL -C - ARLFB(NB,NZ,NY,NX)=AMAX1(0.0,ARLFB(NB,NZ,NY,NX) - 2-FSNAL*ARLF(K,NB,NZ,NY,NX)) - WTLFB(NB,NZ,NY,NX)=AMAX1(0.0,WTLFB(NB,NZ,NY,NX) - 2-FSNCL*WGLF(K,NB,NZ,NY,NX)) - WTLFBN(NB,NZ,NY,NX)=AMAX1(0.0,WTLFBN(NB,NZ,NY,NX) - 2-FSNCL*WGLFN(K,NB,NZ,NY,NX)) - WTLFBP(NB,NZ,NY,NX)=AMAX1(0.0,WTLFBP(NB,NZ,NY,NX) - 2-FSNCL*WGLFP(K,NB,NZ,NY,NX)) - ARLF(K,NB,NZ,NY,NX)=ARLF(K,NB,NZ,NY,NX) - 2-FSNAL*ARLF(K,NB,NZ,NY,NX) - WGLF(K,NB,NZ,NY,NX)=WGLF(K,NB,NZ,NY,NX) - 2-FSNCL*WGLF(K,NB,NZ,NY,NX) - WGLFN(K,NB,NZ,NY,NX)=WGLFN(K,NB,NZ,NY,NX) - 2-FSNCL*WGLFN(K,NB,NZ,NY,NX) - WGLFP(K,NB,NZ,NY,NX)=WGLFP(K,NB,NZ,NY,NX) - 2-FSNCL*WGLFP(K,NB,NZ,NY,NX) - WSLF(K,NB,NZ,NY,NX)=AMAX1(0.0,WSLF(K,NB,NZ,NY,NX) - 2-FSNCL*AMAX1(WGLFN(K,NB,NZ,NY,NX)*CNWS(NZ,NY,NX) - 3,WGLFP(K,NB,NZ,NY,NX)*CPWS(NZ,NY,NX))) -C -C FRACTION OF C REMOBILIZED FOR GROWTH RESPIRATION < 0 IS -C RESPIRED AND NOT TRANSFERRED TO NON-STRUCTURAL POOLS -C - CPOOL(NB,NZ,NY,NX)=CPOOL(NB,NZ,NY,NX)+FSNCL*RCCL*SNCF - ZPOOL(NB,NZ,NY,NX)=ZPOOL(NB,NZ,NY,NX)+FSNCL*RCZL - PPOOL(NB,NZ,NY,NX)=PPOOL(NB,NZ,NY,NX)+FSNCL*RCPL - SNCLF=SNCLF-FSNCL*RCCL - SNCT=SNCT-FSNCL*RCCL - IF(WTLFB(NB,NZ,NY,NX).LT.ZEROL(NZ,NY,NX))THEN - WTLFB(NB,NZ,NY,NX)=0.0 - ARLFB(NB,NZ,NY,NX)=0.0 - ENDIF -C -C EXIT LOOP IF REMOBILIZATION REQUIREMENT HAS BEEN MET -C - IF(SNCLF.LE.ZEROP(NZ,NY,NX))GO TO 564 -C -C OTHERWISE REMAINING C,N,P IN LEAF GOES TO LITTERFALL -C - ELSE -C IF(NZ.EQ.1)THEN -C WRITE(*,4899)'SNCT2',I,J,NX,NY,NZ,NB,K,N,SNCLF,SNCT -C 2,FSNCL,RCCL,WTLFB(NB,NZ,NY,NX),ARLFB(NB,NZ,NY,NX) -C 2,WGLFN(K,NB,NZ,NY,NX),WGLFLN(1,K,NB,NZ,NY,NX) -C 3,ARLF(K,NB,NZ,NY,NX) -4899 FORMAT(A8,8I4,12E16.8) -C ENDIF - DO 6315 M=1,4 - CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX)+CFOPC(5,M,NZ,NY,NX) - 2*WGLF(K,NB,NZ,NY,NX)*FWODB(0) - ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX)+CFOPN(5,M,NZ,NY,NX) - 2*WGLFN(K,NB,NZ,NY,NX)*FWODLN(0) - PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX)+CFOPP(5,M,NZ,NY,NX) - 2*WGLFP(K,NB,NZ,NY,NX)*FWODLP(0) - CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX)+CFOPC(1,M,NZ,NY,NX) - 2*WGLF(K,NB,NZ,NY,NX)*FWODB(1) - ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX)+CFOPN(1,M,NZ,NY,NX) - 2*WGLFN(K,NB,NZ,NY,NX)*FWODLN(1) - PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX)+CFOPP(1,M,NZ,NY,NX) - 2*WGLFP(K,NB,NZ,NY,NX)*FWODLP(1) -6315 CONTINUE - IF(K.NE.0)THEN - CSNC(2,1,0,NZ,NY,NX)=CSNC(2,1,0,NZ,NY,NX) - 2+CPOOL3(K,NB,NZ,NY,NX)+CPOOL4(K,NB,NZ,NY,NX) - CPOOL3(K,NB,NZ,NY,NX)=0.0 - CPOOL4(K,NB,NZ,NY,NX)=0.0 - ENDIF - ARLFB(NB,NZ,NY,NX)=AMAX1(0.0,ARLFB(NB,NZ,NY,NX) - 2-ARLF(K,NB,NZ,NY,NX)) - WTLFB(NB,NZ,NY,NX)=AMAX1(0.0,WTLFB(NB,NZ,NY,NX) - 2-WGLF(K,NB,NZ,NY,NX)) - WTLFBN(NB,NZ,NY,NX)=AMAX1(0.0,WTLFBN(NB,NZ,NY,NX) - 2-WGLFN(K,NB,NZ,NY,NX)) - WTLFBP(NB,NZ,NY,NX)=AMAX1(0.0,WTLFBP(NB,NZ,NY,NX) - 2-WGLFP(K,NB,NZ,NY,NX)) - ARLF(K,NB,NZ,NY,NX)=0.0 - WGLF(K,NB,NZ,NY,NX)=0.0 - WGLFN(K,NB,NZ,NY,NX)=0.0 - WGLFP(K,NB,NZ,NY,NX)=0.0 - WSLF(K,NB,NZ,NY,NX)=0.0 - IF(WTLFB(NB,NZ,NY,NX).LT.ZEROL(NZ,NY,NX))THEN - WTLFB(NB,NZ,NY,NX)=0.0 - ARLFB(NB,NZ,NY,NX)=0.0 - ENDIF - ENDIF -C -C REMOBILIZATION OF SHEATHS OR PETIOLE C,N,P DEPENDS ON -C NON-STRUCTURAL C:N:P -C -564 CONTINUE - IF(WGSHE(K,NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - RCCS=RCCC*WGSHE(K,NB,NZ,NY,NX) - RCZS=WGSHN(K,NB,NZ,NY,NX)*(RCCN+(1.0-RCCN)*RCCC) - RCPS=WGSHP(K,NB,NZ,NY,NX)*(RCCP+(1.0-RCCP)*RCCC) -C -C FRACTION OF REMOBILIZATION THAT CAN BE MET FROM CURRENT SHEATH -C OR PETIOLE -C - IF(RCCS.GT.ZEROP(NZ,NY,NX))THEN - FSNCS=AMAX1(0.0,AMIN1(1.0,SNCSH/RCCS)) - ELSE - FSNCS=1.0 - ENDIF - FSNAS=1.0*FSNCS -C -C NON-REMOBILIZABLE C,N,P BECOMES LITTERFALL ALLOCATED -C TO FRACTIONS SET IN 'STARTQ' -C - DO 6320 M=1,4 - CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX)+CFOPC(5,M,NZ,NY,NX) - 2*FSNCS*(WGSHE(K,NB,NZ,NY,NX)-RCCS)*FWODB(0) - ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX)+CFOPN(5,M,NZ,NY,NX) - 2*FSNCS*(WGSHN(K,NB,NZ,NY,NX)-RCZS)*FWODSN(0) - PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX)+CFOPP(5,M,NZ,NY,NX) - 2*FSNCS*(WGSHP(K,NB,NZ,NY,NX)-RCPS)*FWODSP(0) - CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX)+CFOPC(2,M,NZ,NY,NX) - 2*FSNCS*(WGSHE(K,NB,NZ,NY,NX)-RCCS)*FWODB(1) - ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX)+CFOPN(2,M,NZ,NY,NX) - 2*FSNCS*(WGSHN(K,NB,NZ,NY,NX)-RCZS)*FWODSN(1) - PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX)+CFOPP(2,M,NZ,NY,NX) - 2*FSNCS*(WGSHP(K,NB,NZ,NY,NX)-RCPS)*FWODSP(1) -6320 CONTINUE -C -C UPDATE STATE VARIABLES FOR REMOBILIZATION AND LITTERFALL -C - WTSHEB(NB,NZ,NY,NX)=AMAX1(0.0,WTSHEB(NB,NZ,NY,NX) - 2-FSNCS*WGSHE(K,NB,NZ,NY,NX)) - WTSHBN(NB,NZ,NY,NX)=AMAX1(0.0,WTSHBN(NB,NZ,NY,NX) - 2-FSNCS*WGSHN(K,NB,NZ,NY,NX)) - WTSHBP(NB,NZ,NY,NX)=AMAX1(0.0,WTSHBP(NB,NZ,NY,NX) - 2-FSNCS*WGSHP(K,NB,NZ,NY,NX)) - HTSHE(K,NB,NZ,NY,NX)=HTSHE(K,NB,NZ,NY,NX) - 2-FSNAS*HTSHE(K,NB,NZ,NY,NX) - WGSHE(K,NB,NZ,NY,NX)=WGSHE(K,NB,NZ,NY,NX) - 2-FSNCS*WGSHE(K,NB,NZ,NY,NX) - WGSHN(K,NB,NZ,NY,NX)=WGSHN(K,NB,NZ,NY,NX) - 2-FSNCS*WGSHN(K,NB,NZ,NY,NX) - WGSHP(K,NB,NZ,NY,NX)=WGSHP(K,NB,NZ,NY,NX) - 2-FSNCS*WGSHP(K,NB,NZ,NY,NX) - WSSHE(K,NB,NZ,NY,NX)=AMAX1(0.0,WSSHE(K,NB,NZ,NY,NX) - 2-FSNCS*AMAX1(WGSHN(K,NB,NZ,NY,NX)*CNWS(NZ,NY,NX) - 3,WGSHP(K,NB,NZ,NY,NX)*CPWS(NZ,NY,NX))) -C -C FRACTION OF C REMOBILIZED FOR GROWTH RESPIRATION < 0 IS -C RESPIRED AND NOT TRANSFERRED TO NON-STRUCTURAL POOLS -C - CPOOL(NB,NZ,NY,NX)=CPOOL(NB,NZ,NY,NX)+FSNCS*RCCS*SNCF - ZPOOL(NB,NZ,NY,NX)=ZPOOL(NB,NZ,NY,NX)+FSNCS*RCZS - PPOOL(NB,NZ,NY,NX)=PPOOL(NB,NZ,NY,NX)+FSNCS*RCPS - SNCSH=SNCSH-FSNCS*RCCS - SNCT=SNCT-FSNCS*RCCS - IF(WTSHEB(NB,NZ,NY,NX).LT.ZEROL(NZ,NY,NX))THEN - WTSHEB(NB,NZ,NY,NX)=0.0 - ENDIF -C -C EXIT LOOP IF REMOBILIZATION REQUIREMENT HAS BEEN MET -C - IF(SNCSH.LE.ZEROP(NZ,NY,NX))GO TO 565 -C -C OTHERWISE REMAINING C,N,P IN SHEATH OR PETIOLE GOES TO LITTERFALL -C - ELSE - DO 6325 M=1,4 - CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX)+CFOPC(5,M,NZ,NY,NX) - 2*WGSHE(K,NB,NZ,NY,NX)*FWODB(0) - ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX)+CFOPN(5,M,NZ,NY,NX) - 2*WGSHN(K,NB,NZ,NY,NX)*FWODSN(0) - PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX)+CFOPP(5,M,NZ,NY,NX) - 2*WGSHP(K,NB,NZ,NY,NX)*FWODSP(0) - CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX)+CFOPC(2,M,NZ,NY,NX) - 2*WGSHE(K,NB,NZ,NY,NX)*FWODB(1) - ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX)+CFOPN(2,M,NZ,NY,NX) - 2*WGSHN(K,NB,NZ,NY,NX)*FWODSN(1) - PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX)+CFOPP(2,M,NZ,NY,NX) - 2*WGSHP(K,NB,NZ,NY,NX)*FWODSP(1) -6325 CONTINUE - WTSHEB(NB,NZ,NY,NX)=AMAX1(0.0,WTSHEB(NB,NZ,NY,NX) - 2-WGSHE(K,NB,NZ,NY,NX)) - WTSHBN(NB,NZ,NY,NX)=AMAX1(0.0,WTSHBN(NB,NZ,NY,NX) - 2-WGSHN(K,NB,NZ,NY,NX)) - WTSHBP(NB,NZ,NY,NX)=AMAX1(0.0,WTSHBP(NB,NZ,NY,NX) - 2-WGSHP(K,NB,NZ,NY,NX)) - HTSHE(K,NB,NZ,NY,NX)=0.0 - WGSHE(K,NB,NZ,NY,NX)=0.0 - WGSHN(K,NB,NZ,NY,NX)=0.0 - WGSHP(K,NB,NZ,NY,NX)=0.0 - WSSHE(K,NB,NZ,NY,NX)=0.0 - IF(WTSHEB(NB,NZ,NY,NX).LT.ZEROL(NZ,NY,NX))THEN - WTSHEB(NB,NZ,NY,NX)=0.0 - ENDIF - ENDIF -650 CONTINUE - KN=KN+1 - SNCR=SNCT*(1.0-SNCF) -C -C REMOBILIZATION OF RESERVE C -C - IF(WTRSVB(NB,NZ,NY,NX).GT.SNCR)THEN - WTRSVB(NB,NZ,NY,NX)=WTRSVB(NB,NZ,NY,NX)-SNCR - SNCR=0.0 - GO TO 565 - ENDIF -C -C REMOBILIZATION OF STALK C,N,P -C - SNCZ=FXFS*SNCR - SNCT=SNCR+SNCZ - IF(SNCT.GT.ZEROP(NZ,NY,NX) - 2.AND.WTSTKB(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - SNCF=SNCZ/SNCT - FRCC=WVSTKB(NB,NZ,NY,NX)/WTSTKB(NB,NZ,NY,NX) - RCSC=RCCC*FRCC - RCSN=RCCN*FRCC - RCSP=RCCP*FRCC - MXNOD=KVSTG(NB,NZ,NY,NX) - MNNOD=MAX(MIN(0,MAX(0,MXNOD-NNOD(NZ,NY,NX))) - 2,KVSTG(NB,NZ,NY,NX)-23) - MXNOD=MAX(MXNOD,MNNOD) - DO 1650 KK=MXNOD,MNNOD,-1 - K=MOD(KK,25) - IF(K.EQ.0.AND.KK.NE.0)K=25 -C IF(NZ.EQ.1.OR.NZ.EQ.4)THEN -C WRITE(*,2356)'WGNODE1',I,J,NZ,NB,K,KK,MXNOD,MNNOD -C 2,KSNC,RCCC,FRCC,RCSC,SNCT,WGNODE(K,NB,NZ,NY,NX) -C 3,HTNODX(K,NB,NZ,NY,NX),WTSTKB(NB,NZ,NY,NX) -C 4,CPOOL(NB,NZ,NY,NX) -C ENDIF -C -C REMOBILIZATION OF STALK C,N,P DEPENDS ON NON-STRUCTURAL C:N:P -C - IF(WGNODE(K,NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - RCCK=RCSC*WGNODE(K,NB,NZ,NY,NX) - RCZK=WGNODN(K,NB,NZ,NY,NX)*(RCSN+(1.0-RCSN)*RCSC) - RCPK=WGNODP(K,NB,NZ,NY,NX)*(RCSP+(1.0-RCSP)*RCSC) -C -C FRACTION OF CURRENT NODE TO BE REMOBILIZED -C - IF(RCCK.GT.ZEROP(NZ,NY,NX))THEN - FSNCK=AMAX1(0.0,AMIN1(1.0,SNCT/RCCK)) - ELSE - FSNCK=1.0 - ENDIF -C -C NON-REMOBILIZABLE C,N,P BECOMES LITTERFALL ALLOCATED -C TO FRACTIONS SET IN 'STARTQ' -C - DO 7310 M=1,4 - CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX)+CFOPC(3,M,NZ,NY,NX) - 2*FSNCK*(WGNODE(K,NB,NZ,NY,NX)-RCCK) - ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX)+CFOPN(3,M,NZ,NY,NX) - 2*FSNCK*(WGNODN(K,NB,NZ,NY,NX)-RCZK) - PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX)+CFOPP(3,M,NZ,NY,NX) - 2*FSNCK*(WGNODP(K,NB,NZ,NY,NX)-RCPK) -7310 CONTINUE -C -C UPDATE STATE VARIABLES FOR REMOBILIZATION AND LITTERFALL -C - WTSTKB(NB,NZ,NY,NX)=AMAX1(0.0,WTSTKB(NB,NZ,NY,NX) - 2-FSNCK*WGNODE(K,NB,NZ,NY,NX)) - WTSTBN(NB,NZ,NY,NX)=AMAX1(0.0,WTSTBN(NB,NZ,NY,NX) - 2-FSNCK*WGNODN(K,NB,NZ,NY,NX)) - WTSTBP(NB,NZ,NY,NX)=AMAX1(0.0,WTSTBP(NB,NZ,NY,NX) - 2-FSNCK*WGNODP(K,NB,NZ,NY,NX)) - HTNODE(K,NB,NZ,NY,NX)=HTNODE(K,NB,NZ,NY,NX) - 2-FSNCK*HTNODX(K,NB,NZ,NY,NX) - WGNODE(K,NB,NZ,NY,NX)=WGNODE(K,NB,NZ,NY,NX) - 2-FSNCK*WGNODE(K,NB,NZ,NY,NX) - WGNODN(K,NB,NZ,NY,NX)=WGNODN(K,NB,NZ,NY,NX) - 2-FSNCK*WGNODN(K,NB,NZ,NY,NX) - WGNODP(K,NB,NZ,NY,NX)=WGNODP(K,NB,NZ,NY,NX) - 2-FSNCK*WGNODP(K,NB,NZ,NY,NX) - HTNODX(K,NB,NZ,NY,NX)=HTNODX(K,NB,NZ,NY,NX) - 2-FSNCK*HTNODX(K,NB,NZ,NY,NX) -C -C FRACTION OF C REMOBILIZED FOR GROWTH RESPIRATION < 0 IS -C RESPIRED AND NOT TRANSFERRED TO NON-STRUCTURAL POOLS -C - WTRSVB(NB,NZ,NY,NX)=WTRSVB(NB,NZ,NY,NX)+FSNCK*RCCK*SNCF - WTRSBN(NB,NZ,NY,NX)=WTRSBN(NB,NZ,NY,NX)+FSNCK*RCZK - WTRSBP(NB,NZ,NY,NX)=WTRSBP(NB,NZ,NY,NX)+FSNCK*RCPK - SNCT=SNCT-FSNCK*RCCK -C IF(NZ.EQ.1.OR.NZ.EQ.4)THEN -C WRITE(*,2356)'WGNODE2',I,J,NZ,NB,K,KK,MXNOD,MNNOD -C 2,KSNC,RCCC,FRCC,RCSC,SNCT,WGNODE(K,NB,NZ,NY,NX) -C 3,HTNODX(K,NB,NZ,NY,NX),WTSTKB(NB,NZ,NY,NX) -C 4,CPOOL(NB,NZ,NY,NX) -2356 FORMAT(A8,9I4,12E16.8) -C ENDIF -C -C EXIT LOOP IF REMOBILIZATION REQUIREMENT HAS BEEN MET -C - IF(SNCT.LE.ZEROP(NZ,NY,NX))GO TO 565 -C -C OTHERWISE REMAINING C,N,P IN NODE GOES TO LITTERFALL -C - ELSE - DO 7315 M=1,4 - CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX)+CFOPC(3,M,NZ,NY,NX) - 2*WGNODE(K,NB,NZ,NY,NX) - ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX)+CFOPN(3,M,NZ,NY,NX) - 2*WGNODN(K,NB,NZ,NY,NX) - PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX)+CFOPP(3,M,NZ,NY,NX) - 2*WGNODP(K,NB,NZ,NY,NX) -7315 CONTINUE - WTSTKB(NB,NZ,NY,NX)=AMAX1(0.0,WTSTKB(NB,NZ,NY,NX) - 2-WGNODE(K,NB,NZ,NY,NX)) - WTSTBN(NB,NZ,NY,NX)=AMAX1(0.0,WTSTBN(NB,NZ,NY,NX) - 2-WGNODN(K,NB,NZ,NY,NX)) - WTSTBP(NB,NZ,NY,NX)=AMAX1(0.0,WTSTBP(NB,NZ,NY,NX) - 2-WGNODP(K,NB,NZ,NY,NX)) - HTNODE(K,NB,NZ,NY,NX)=HTNODE(K,NB,NZ,NY,NX) - 2-HTNODX(K,NB,NZ,NY,NX) - WGNODE(K,NB,NZ,NY,NX)=0.0 - WGNODN(K,NB,NZ,NY,NX)=0.0 - WGNODP(K,NB,NZ,NY,NX)=0.0 - HTNODX(K,NB,NZ,NY,NX)=0.0 - ENDIF -1650 CONTINUE -C -C RESIDUAL STALK -C - IF(WTSTXB(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - RCCK=RCSC*WTSTXB(NB,NZ,NY,NX) - RCZK=WTSTXN(NB,NZ,NY,NX)*(RCSN+(1.0-RCSN)*RCSC) - RCPK=WTSTXP(NB,NZ,NY,NX)*(RCSP+(1.0-RCSP)*RCSC) -C -C FRACTION OF RESIDUAL STALK TO BE REMOBILIZED -C - IF(RCCK.GT.ZEROP(NZ,NY,NX))THEN - FSNCR=AMAX1(0.0,AMIN1(1.0,SNCT/RCCK)) - ELSE - FSNCR=1.0 - ENDIF -C -C NON-REMOBILIZABLE C,N,P BECOMES LITTERFALL ALLOCATED -C TO FRACTIONS SET IN 'STARTQ' -C - DO 8310 M=1,4 - CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX)+CFOPC(3,M,NZ,NY,NX) - 2*FSNCR*(WTSTXB(NB,NZ,NY,NX)-RCCK) - ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX)+CFOPN(3,M,NZ,NY,NX) - 2*FSNCR*(WTSTXN(NB,NZ,NY,NX)-RCZK) - PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX)+CFOPP(3,M,NZ,NY,NX) - 2*FSNCR*(WTSTXP(NB,NZ,NY,NX)-RCPK) -8310 CONTINUE -C -C UPDATE STATE VARIABLES FOR REMOBILIZATION AND LITTERFALL -C - WTSTKB(NB,NZ,NY,NX)=AMAX1(0.0,WTSTKB(NB,NZ,NY,NX) - 2-FSNCR*WTSTXB(NB,NZ,NY,NX)) - WTSTBN(NB,NZ,NY,NX)=AMAX1(0.0,WTSTBN(NB,NZ,NY,NX) - 2-FSNCR*WTSTXN(NB,NZ,NY,NX)) - WTSTBP(NB,NZ,NY,NX)=AMAX1(0.0,WTSTBP(NB,NZ,NY,NX) - 2-FSNCR*WTSTXP(NB,NZ,NY,NX)) - WTSTXB(NB,NZ,NY,NX)=AMAX1(0.0,WTSTXB(NB,NZ,NY,NX) - 2-FSNCR*WTSTXB(NB,NZ,NY,NX)) - WTSTXN(NB,NZ,NY,NX)=AMAX1(0.0,WTSTXN(NB,NZ,NY,NX) - 2-FSNCR*WTSTXN(NB,NZ,NY,NX)) - WTSTXP(NB,NZ,NY,NX)=AMAX1(0.0,WTSTXP(NB,NZ,NY,NX) - 2-FSNCR*WTSTXP(NB,NZ,NY,NX)) - HTNODZ=0.0 - DO 8320 K=0,25 - HTNODZ=AMAX1(HTNODZ,HTNODE(K,NB,NZ,NY,NX)) -8320 CONTINUE - HTNODZ=AMAX1(0.0,HTNODZ-FSNCR*HTNODZ) - DO 8325 K=0,25 - HTNODE(K,NB,NZ,NY,NX)=AMIN1(HTNODZ,HTNODE(K,NB,NZ,NY,NX)) -8325 CONTINUE -C -C FRACTION OF C REMOBILIZED FOR GROWTH RESPIRATION < 0 IS -C RESPIRED AND NOT TRANSFERRED TO NON-STRUCTURAL POOLS -C - WTRSVB(NB,NZ,NY,NX)=WTRSVB(NB,NZ,NY,NX)+FSNCR*RCCK*SNCF - WTRSBN(NB,NZ,NY,NX)=WTRSBN(NB,NZ,NY,NX)+FSNCR*RCZK - WTRSBP(NB,NZ,NY,NX)=WTRSBP(NB,NZ,NY,NX)+FSNCR*RCPK - SNCT=SNCT-FSNCR*RCCK - ENDIF -C IF(NZ.EQ.1.OR.NZ.EQ.4)THEN -C WRITE(*,2357)'WTSTXB1',I,J,NZ,NB,K,FSNCR,SNCT -C 3,WTSTKB(NB,NZ,NY,NX),WTSTXB(NB,NZ,NY,NX) -C 4,(HTNODE(K,NB,NZ,NY,NX),K=0,25) -2357 FORMAT(A8,5I4,40E12.4) -C ENDIF -C -C EXIT LOOP IF REMOBILIZATION REQUIREMENT HAS BEEN MET -C - IF(SNCT.LE.ZEROP(NZ,NY,NX))GO TO 565 -C -C OTHERWISE REMAINING C,N,P IN NODE GOES TO LITTERFALL -C - ELSE - DO 8315 M=1,4 - CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX)+CFOPC(3,M,NZ,NY,NX) - 2*WTSTXB(NB,NZ,NY,NX) - ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX)+CFOPN(3,M,NZ,NY,NX) - 2*WTSTXN(NB,NZ,NY,NX) - PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX)+CFOPP(3,M,NZ,NY,NX) - 2*WTSTXP(NB,NZ,NY,NX) -8315 CONTINUE - WTSTKB(NB,NZ,NY,NX)=AMAX1(0.0,WTSTKB(NB,NZ,NY,NX) - 2-WTSTXB(NB,NZ,NY,NX)) - WTSTBN(NB,NZ,NY,NX)=AMAX1(0.0,WTSTBN(NB,NZ,NY,NX) - 2-WTSTXN(NB,NZ,NY,NX)) - WTSTBP(NB,NZ,NY,NX)=AMAX1(0.0,WTSTBP(NB,NZ,NY,NX) - 2-WTSTXP(NB,NZ,NY,NX)) - WTSTXB(NB,NZ,NY,NX)=0.0 - WTSTXN(NB,NZ,NY,NX)=0.0 - WTSTXP(NB,NZ,NY,NX)=0.0 - MXNOD=KVSTG(NB,NZ,NY,NX) - MNNOD=MAX(MIN(0,MAX(0,MXNOD-NNOD(NZ,NY,NX))) - 2,KVSTG(NB,NZ,NY,NX)-23) - MXNOD=MAX(MXNOD,MNNOD) - DO 1660 KK=MXNOD,MNNOD,-1 - K=MOD(KK,25) - IF(K.EQ.0.AND.KK.NE.0)K=25 - HTNODE(K,NB,NZ,NY,NX)=0.0 - HTNODX(K,NB,NZ,NY,NX)=0.0 -1660 CONTINUE -C IF(NZ.EQ.2)THEN -C WRITE(*,2357)'WTSTXB2',I,J,NZ,NB,FSNCR,SNCT -C 3,HTNODX(K,NB,NZ,NY,NX),WTSTKB(NB,NZ,NY,NX) -C 4,WTSTXB(NB,NZ,NY,NX),WTSTBN(NB,NZ,NY,NX),WTSTBP(NB,NZ,NY,NX) -C ENDIF - ENDIF -C -C REMOBILIZATION OF STORAGE C,N,P -C - SNCR=SNCT/(1.0+FXFS) - IF(WTRVC(NZ,NY,NX).GT.SNCR)THEN - WTRVC(NZ,NY,NX)=WTRVC(NZ,NY,NX)-SNCR - SNCR=0.0 - GO TO 565 - ELSE - IDTHB(NB,NZ,NY,NX)=1 - ENDIF -565 CONTINUE -575 CONTINUE - ENDIF -595 CONTINUE -C -C DEATH IF MAIN STALK OF TREE DIES -C - IF(IBTYP(NZ,NY,NX).NE.0.AND.IGTYP(NZ,NY,NX).GT.1 - 2.AND.IDTHB(NB1(NZ,NY,NX),NZ,NY,NX).EQ.1)IDTHB(NB,NZ,NY,NX)=1 -C -C REMOBILIZE EXCESS LEAF STRUCTURAL N,P -C - KVSTGX=MAX(0,KVSTG(NB,NZ,NY,NX)-24) - DO 495 KK=KVSTGX,KVSTG(NB,NZ,NY,NX) - K=MOD(KK,25) - IF(K.EQ.0.AND.KK.NE.0)K=25 - IF(WGLF(K,NB,NZ,NY,NX).GT.0.0)THEN - CPOOLT=WGLF(K,NB,NZ,NY,NX)+CPOOL(NB,NZ,NY,NX) - IF(CPOOLT.GT.ZEROP(NZ,NY,NX))THEN - ZPOOLD=WGLFN(K,NB,NZ,NY,NX)*CPOOL(NB,NZ,NY,NX) - 2-ZPOOL(NB,NZ,NY,NX)*WGLF(K,NB,NZ,NY,NX) - XFRN1=AMAX1(0.0,AMIN1(1.0E-03*ZPOOLD/CPOOLT,WGLFN(K,NB,NZ,NY,NX) - 2-ZPLFM*CNLFB*WGLF(K,NB,NZ,NY,NX))) - PPOOLD=WGLFP(K,NB,NZ,NY,NX)*CPOOL(NB,NZ,NY,NX) - 2-PPOOL(NB,NZ,NY,NX)*WGLF(K,NB,NZ,NY,NX) - XFRP1=AMAX1(0.0,AMIN1(1.0E-03*PPOOLD/CPOOLT,WGLFP(K,NB,NZ,NY,NX) - 2-ZPLFM*CPLFB*WGLF(K,NB,NZ,NY,NX))) - XFRN=AMAX1(XFRN1,10.0*XFRP1) - XFRP=AMAX1(XFRP1,0.10*XFRN1) - WGLFN(K,NB,NZ,NY,NX)=WGLFN(K,NB,NZ,NY,NX)-XFRN - WTLFBN(NB,NZ,NY,NX)=WTLFBN(NB,NZ,NY,NX)-XFRN - ZPOOL(NB,NZ,NY,NX)=ZPOOL(NB,NZ,NY,NX)+XFRN - WGLFP(K,NB,NZ,NY,NX)=WGLFP(K,NB,NZ,NY,NX)-XFRP - WTLFBP(NB,NZ,NY,NX)=WTLFBP(NB,NZ,NY,NX)-XFRP - PPOOL(NB,NZ,NY,NX)=PPOOL(NB,NZ,NY,NX)+XFRP - WSLF(K,NB,NZ,NY,NX)=AMAX1(0.0,WSLF(K,NB,NZ,NY,NX) - 2-AMAX1(XFRN*CNWS(NZ,NY,NX),XFRP*CPWS(NZ,NY,NX))) - ENDIF - ENDIF -495 CONTINUE -C -C ALLOCATION OF LEAF AREA TO CANOPY LAYERS -C - KVSTGN(NB,NZ,NY,NX)=0 - IF(HTCTL(NZ,NY,NX).LE.SDPTH(NZ,NY,NX) - 2.AND.ARLF(0,NB1(NZ,NY,NX),NZ,NY,NX).GT.0.0)THEN - XLGLF=SQRT(1.0E+02*ARLF(0,NB1(NZ,NY,NX),NZ,NY,NX) - 2/PP(NZ,NY,NX)) - HTCTL(NZ,NY,NX)=XLGLF+HTSHE(0,NB1(NZ,NY,NX),NZ,NY,NX) - 2+HTNODE(0,NB1(NZ,NY,NX),NZ,NY,NX) - ENDIF -C -C IF CANOPY HAS EMERGED -C - IF(HTCTL(NZ,NY,NX).GT.SDPTH(NZ,NY,NX))THEN - DO 540 K=0,25 - DO 540 L=1,JC - ARLFL(L,K,NB,NZ,NY,NX)=0.0 - WGLFL(L,K,NB,NZ,NY,NX)=0.0 - WGLFLN(L,K,NB,NZ,NY,NX)=0.0 - WGLFLP(L,K,NB,NZ,NY,NX)=0.0 -540 CONTINUE - DO 535 L=1,JC - ARSTK(L,NB,NZ,NY,NX)=0.0 -535 CONTINUE -C -C BRANCH HEIGHT -C - IF(IBTYP(NZ,NY,NX).NE.0.AND.IGTYP(NZ,NY,NX).GT.1)THEN - IF(NB.NE.NB1(NZ,NY,NX))THEN - KVSTG1=MAX(1,KVSTG(NB1(NZ,NY,NX),NZ,NY,NX)-24) - IF(NBTB(NB,NZ,NY,NX).GE.KVSTG1)THEN - K=MOD(NBTB(NB,NZ,NY,NX),25) - IF(K.EQ.0.AND.KK.NE.0)K=25 - HTBR=HTNODE(K,NB1(NZ,NY,NX),NZ,NY,NX) - ELSE - HTBR=0.0 - ENDIF - ELSE - HTBR=0.0 - ENDIF - ELSE - HTBR=0.0 - ENDIF - KVSTGX=MAX(0,KVSTG(NB,NZ,NY,NX)-24) -C -C FOR ALL LEAFED NODES -C - DO 560 KK=KVSTGX,KVSTG(NB,NZ,NY,NX) - K=MOD(KK,25) - IF(K.EQ.0.AND.KK.NE.0)K=25 -C -C HEIGHT OF STALK INTERNODE + SHEATH OR PETIOLE -C AND LENGTH OF LEAF -C - HTSTK=HTBR+HTNODE(K,NB,NZ,NY,NX) - HTLF=HTSTK+HTSHE(K,NB,NZ,NY,NX) - XLGLF=AMAX1(0.0,SQRT(WDLF(NZ,NY,NX)*AMAX1(0.0 - 2,ARLF(K,NB,NZ,NY,NX))/(PP(NZ,NY,NX)*FNOD(NZ,NY,NX)))) - TLGLF=0.0 -C -C ALLOCATE FRACTIONS OF LEAF IN EACH INCLINATION CLASS -C FROM HIGHEST TO LOWEST TO CANOPY LAYER -C - DO 555 N=4,1,-1 - YLGLF=ZSIN(N)*CLASS(N,NZ,NY,NX)*XLGLF - HTLFL=AMIN1(ZCX(NZ,NY,NX)+0.01-YLGLF,HTLF+TLGLF) - HTLFU=AMIN1(ZCX(NZ,NY,NX)+0.01,HTLFL+YLGLF) - LU=0 - LL=0 - DO 550 L=JC,1,-1 - IF(LU.EQ.1.AND.LL.EQ.1)GO TO 551 - IF((HTLFU.GT.ZL(L-1,NY,NX).OR.ZL(L-1,NY,NX).LT.ZERO) - 2.AND.LU.EQ.0)THEN - LHTLFU=MAX(1,L) - LU=1 - ENDIF - IF((HTLFL.GT.ZL(L-1,NY,NX).OR.ZL(L-1,NY,NX).LT.ZERO) - 2.AND.LL.EQ.0)THEN - LHTLFL=MAX(1,L) - LL=1 - ENDIF -550 CONTINUE -551 CONTINUE - DO 570 L=LHTLFL,LHTLFU - IF(LHTLFU.EQ.LHTLFL)THEN - FRACL=CLASS(N,NZ,NY,NX) - ELSEIF(HTLFU.GT.HTLFL.AND.ZL(L,NY,NX).GT.HTLFL)THEN - FRACL=CLASS(N,NZ,NY,NX)*(AMIN1(HTLFU,ZL(L,NY,NX)) - 2-AMAX1(HTLFL,ZL(L-1,NY,NX)))/(HTLFU-HTLFL) - ELSE - FRACL=CLASS(N,NZ,NY,NX) - ENDIF - YARLF=FRACL*ARLF(K,NB,NZ,NY,NX) - YWGLF=FRACL*WGLF(K,NB,NZ,NY,NX) - YWGLFN=FRACL*WGLFN(K,NB,NZ,NY,NX) - YWGLFP=FRACL*WGLFP(K,NB,NZ,NY,NX) -C -C ACCUMULATE LAYER LEAF AREAS, C, N AND P CONTENTS -C - ARLFL(L,K,NB,NZ,NY,NX)=ARLFL(L,K,NB,NZ,NY,NX)+YARLF - WGLFL(L,K,NB,NZ,NY,NX)=WGLFL(L,K,NB,NZ,NY,NX)+YWGLF - WGLFLN(L,K,NB,NZ,NY,NX)=WGLFLN(L,K,NB,NZ,NY,NX)+YWGLFN - WGLFLP(L,K,NB,NZ,NY,NX)=WGLFLP(L,K,NB,NZ,NY,NX)+YWGLFP - ARLFV(L,NZ,NY,NX)=ARLFV(L,NZ,NY,NX)+YARLF - WGLFV(L,NZ,NY,NX)=WGLFV(L,NZ,NY,NX)+YWGLF -C IF(J.EQ.12)THEN -C WRITE(*,4813)'GRO',I,J,NZ,NB,K,KK,L,LHTLFL,LHTLFU -C 2,FRACL,HTLFU,HTLFL,ZL(L-1,NY,NX),ARLFB(NB,NZ,NY,NX) -C 3,ARLF(K,NB,NZ,NY,NX),WTLFB(NB,NZ,NY,NX),WGLF(K,NB,NZ,NY,NX) -C 4,ARLFP(NZ,NY,NX),ZL(L,NY,NX),HTLF,TLGLF,HTSTK,HTBR -C 4,HTNODE(K,NB,NZ,NY,NX),HTSHE(K,NB,NZ,NY,NX),YLGLF -C 5,ZSIN(N),CLASS(N,NZ,NY,NX),XLGLF,ZC(NZ,NY,NX) -C 6,ZCX(NZ,NY,NX) -4813 FORMAT(A8,9I4,30E12.4) -C ENDIF -570 CONTINUE - TLGLF=TLGLF+YLGLF - ZC(NZ,NY,NX)=AMAX1(ZC(NZ,NY,NX),HTLFU) -555 CONTINUE - IF(WSSHE(K,NB,NZ,NY,NX).GT.0.0)THEN - IF(KVSTGN(NB,NZ,NY,NX).EQ.0)KVSTGN(NB,NZ,NY,NX) - 2=MIN(KK,KVSTG(NB,NZ,NY,NX)) - ENDIF -560 CONTINUE - IF(KVSTGN(NB,NZ,NY,NX).EQ.0)KVSTGN(NB,NZ,NY,NX) - 2=KVSTG(NB,NZ,NY,NX) - K1=MOD(KVSTG(NB,NZ,NY,NX),25) - IF(K1.EQ.0.AND.KVSTG(NB,NZ,NY,NX).NE.0)K1=25 - K2=MOD(KVSTG(NB,NZ,NY,NX)-1,25) - IF(K2.EQ.0.AND.KVSTG(NB,NZ,NY,NX)-1.NE.0)K2=25 - IF(HTNODE(K1,NB,NZ,NY,NX).EQ.0.0)THEN - HTNODE(K1,NB,NZ,NY,NX)=HTNODE(K2,NB,NZ,NY,NX) - ENDIF - HTLFB=HTBR - 2+AMAX1(0.0,HTNODE(K1,NB,NZ,NY,NX)) -C -C ALLOCATE STALK SURFACE AREA TO CANOPY LAYERS -C -C IF(NZ.EQ.1)THEN -C WRITE(*,6679)'K1',I,J,NZ,NB,K1,KVSTG(NB,NZ,NY,NX) -C 2,HTNODE(K1,NB,NZ,NY,NX) -6679 FORMAT(A8,6I4,12E12.4) -C ENDIF - IF(HTNODE(K1,NB,NZ,NY,NX).GT.0.0)THEN - LU=0 - LL=0 - DO 545 L=JC,1,-1 - IF(LU.EQ.1.AND.LL.EQ.1)GO TO 546 - IF((HTLFB.GT.ZL(L-1,NY,NX).OR.ZL(L-1,NY,NX).LT.ZERO) - 2.AND.LU.EQ.0)THEN - LHTBRU=MAX(1,L) - LU=1 - ENDIF - IF((HTBR.GT.ZL(L-1,NY,NX).OR.ZL(L-1,NY,NX) - 2.LT.ZERO).AND.LL.EQ.0)THEN - LHTBRL=MAX(1,L) - LL=1 - ENDIF -545 CONTINUE -546 CONTINUE - RSTK=SQRT(VSTK*(AMAX1(0.0,WTSTKB(NB,NZ,NY,NX))/PP(NZ,NY,NX)) - 3/(3.1416*HTNODE(K1,NB,NZ,NY,NX))) - ARSTKB(NB)=3.1416*HTNODE(K1,NB,NZ,NY,NX)*PP(NZ,NY,NX)*RSTK - IF(ISTYP(NZ,NY,NX).EQ.0)THEN - WVSTKB(NB,NZ,NY,NX)=WTSTKB(NB,NZ,NY,NX) - ELSE - ZSTK=AMIN1(ZSTX,FSTK*RSTK) - ASTV=3.1416*(2.0*RSTK*ZSTK-ZSTK**2) - WVSTKB(NB,NZ,NY,NX)=ASTV/VSTK*HTNODE(K1,NB,NZ,NY,NX)*PP(NZ,NY,NX) - ENDIF -C IF(NZ.EQ.1)THEN -C WRITE(*,6677)'WVSTK',I,J,NZ,NB,WVSTKB(NB,NZ,NY,NX) -C 2,ASTV,VSTK,HTNODE(K1,NB,NZ,NY,NX),PP(NZ,NY,NX) -6677 FORMAT(A8,4I4,12E12.4) -C ENDIF - DO 445 L=LHTBRL,LHTBRU - IF(HTLFB.GT.HTBR)THEN - IF(HTLFB.GT.ZL(L-1,NY,NX))THEN - FRACL=(AMIN1(HTLFB,ZL(L,NY,NX))-AMAX1(HTBR - 2,ZL(L-1,NY,NX)))/(HTLFB-HTBR) - ELSE - FRACL=0.0 - ENDIF - ELSE - FRACL=1.0 - ENDIF - ARSTK(L,NB,NZ,NY,NX)=FRACL*ARSTKB(NB) -445 CONTINUE - ELSE - WVSTKB(NB,NZ,NY,NX)=0.0 - DO 450 L=1,JC - ARSTK(L,NB,NZ,NY,NX)=0.0 -450 CONTINUE - ENDIF - ELSE - WVSTKB(NB,NZ,NY,NX)=0.0 - DO 455 L=1,JC - ARSTK(L,NB,NZ,NY,NX)=0.0 -455 CONTINUE - ENDIF -C -C ALLOCATE LEAF AREA TO INCLINATION CLASSES ACCORDING TO -C DISTRIBUTION ENTERED IN 'READQ' ASSUMING AZIMUTH IS UNIFORM -C - IF(SSINN(NY,NX).GT.0.0)THEN - DO 900 K=1,25 - DO 900 L=1,JC - DO 900 N=1,4 - SURF(N,L,K,NB,NZ,NY,NX)=0.0 -900 CONTINUE -C ARLFXB=0.0 -C ARLFXL=0.0 -C SURFXX=0.0 - DO 500 K=1,25 -C ARLFXB=ARLFXB+ARLF(K,NB,NZ,NY,NX) - IF(ARLF(K,NB,NZ,NY,NX).GT.0.0 - 2.AND.ZC(NZ,NY,NX).GT.DPTHS(NY,NX))THEN - DO 700 L=JC,1,-1 -C ARLFXL=ARLFXL+ARLFL(L,K,NB,NZ,NY,NX) - DO 800 N=1,4 - SURF(N,L,K,NB,NZ,NY,NX)=AMAX1(0.0,CLASS(N,NZ,NY,NX) - 2*0.25*ARLFL(L,K,NB,NZ,NY,NX)) -C SURFXX=SURFXX+SURF(N,L,K,NB,NZ,NY,NX) -C IF(I.EQ.151.AND.(NZ.EQ.1.OR.NZ.EQ.4))THEN -C WRITE(*,6363)'SURF',I,J,NX,NY,NZ,NB,K,L,N -C 2,ARLFL(L,K,NB,NZ,NY,NX) -C 2,SURF(N,L,K,NB,NZ,NY,NX),CLASS(N,NZ,NY,NX),ARLF(K,NB,NZ,NY,NX) -C 3,DPTHS(NY,NX),ARLFXB,ARLFXL,SURFXX,ARLF(0,NB,NZ,NY,NX) -C 4,ARLFB(NB,NZ,NY,NX) -6363 FORMAT(A8,9I4,12E16.8) -C ENDIF -800 CONTINUE -700 CONTINUE - ENDIF -500 CONTINUE -C -C ALLOCATE STALK AREA TO INCLINATION CLASSES ACCORDING TO -C BRANCH ANGLE ENTERED IN 'READQ' ASSUMING AZIMUTH IS UNIFORM -C - DO 910 L=1,JC - DO 910 N=1,4 - SURFB(N,L,NB,NZ,NY,NX)=0.0 -910 CONTINUE - IF(NB.EQ.NB1(NZ,NY,NX))THEN - N=4 - ELSE - N=MIN(4,INT(ASIN(ANGBR(NZ,NY,NX))/0.3927)+1) - ENDIF - DO 710 L=JC,1,-1 - SURFB(N,L,NB,NZ,NY,NX)=0.25*ARSTK(L,NB,NZ,NY,NX) -710 CONTINUE - ENDIF -C -C SET MAXIMUM GRAIN NUMBER FROM SHOOT MASS BEFORE ANTHESIS -C - IF(IDAY(3,NB,NZ,NY,NX).NE.0.AND.IDAY(6,NB,NZ,NY,NX).EQ.0)THEN - GRNXB(NB,NZ,NY,NX)=GRNXB(NB,NZ,NY,NX) - 2+STMX(NZ,NY,NX)*AMAX1(0.0,GROSTK) -C WRITE(*,4246)'GRNX',I,J,NZ,NB,IDAY(3,NB,NZ,NY,NX) -C 2,GRNXB(NB,NZ,NY,NX),STMX(NZ,NY,NX),CGROS,GROSTK - ENDIF -C -C SET FINAL GRAIN NUMBER AND MAXIMUM GRAIN SIZE FROM C,N,P -C NON-STRUCTURAL POOLS AFTER ANTHESIS -C - IF(IDAY(6,NB,NZ,NY,NX).NE.0.AND.IDAY(9,NB,NZ,NY,NX).EQ.0)THEN - SET=AMIN1(CCPOLB(NB,NZ,NY,NX)/(CCPOLB(NB,NZ,NY,NX)+SETC) - 2,CZPOLB(NB,NZ,NY,NX)/(CZPOLB(NB,NZ,NY,NX)+SETN) - 3,CPPOLB(NB,NZ,NY,NX)/(CPPOLB(NB,NZ,NY,NX)+SETP)) - IF(TCC(NZ,NY,NX).LT.CTC(NZ,NY,NX))THEN - IF(IDAY(7,NB,NZ,NY,NX).EQ.0)THEN - FGRNX=0.002*(CTC(NZ,NY,NX)-TCC(NZ,NY,NX)) - ELSEIF(IDAY(8,NB,NZ,NY,NX).EQ.0)THEN - FGRNX=0.002*(CTC(NZ,NY,NX)-TCC(NZ,NY,NX)) - ELSE - FGRNX=0.0 - ENDIF - ELSEIF(TCC(NZ,NY,NX).GT.HTC(NZ,NY,NX))THEN - IF(IDAY(7,NB,NZ,NY,NX).EQ.0)THEN - FGRNX=0.002*(TCC(NZ,NY,NX)-HTC(NZ,NY,NX)) - ELSEIF(IDAY(8,NB,NZ,NY,NX).EQ.0)THEN - FGRNX=0.002*(TCC(NZ,NY,NX)-HTC(NZ,NY,NX)) - ELSE - FGRNX=0.0 - ENDIF - ELSE - FGRNX=0.0 - ENDIF - IF(IDAY(6,NB,NZ,NY,NX).NE.0.AND.IDAY(8,NB,NZ,NY,NX).EQ.0)THEN -C GRNXB(NB,NZ,NY,NX)=GRNXB(NB,NZ,NY,NX)*FGRNX - GRNOB(NB,NZ,NY,NX)=AMIN1(SDMX(NZ,NY,NX)*GRNXB(NB,NZ,NY,NX) - 2,GRNOB(NB,NZ,NY,NX)+SDMX(NZ,NY,NX)*GRNXB(NB,NZ,NY,NX) - 3*SET*DGSTGF(NB,NZ,NY,NX)-FGRNX*GRNOB(NB,NZ,NY,NX)) -C IF(FGRNX.LT.1.0)THEN -C WRITE(*,4246)'GRNO',I,J,NZ,NB,IDAY(7,NB,NZ,NY,NX),TCC(NZ,NY,NX) -C 2,HTC(NZ,NY,NX),FGRNX,GRNXB(NB,NZ,NY,NX),GRNOB(NB,NZ,NY,NX) -C 3,SET,CCPOLB(NB,NZ,NY,NX),CZPOLB(NB,NZ,NY,NX) -C 4,CPPOLB(NB,NZ,NY,NX) -4246 FORMAT(A8,5I4,20E12.4) -C ENDIF - ENDIF - IF(IDAY(7,NB,NZ,NY,NX).NE.0.AND.IDAY(9,NB,NZ,NY,NX).EQ.0)THEN - GRMXB=GRMX(NZ,NY,NX)*SQRT(1.0-FGRNX) - GRWTB(NB,NZ,NY,NX)=AMIN1(GRMX(NZ,NY,NX),GRWTB(NB,NZ,NY,NX) - 2+GRMXB*AMAX1(0.50,SQRT(SET))*DGSTGF(NB,NZ,NY,NX)) -C IF(FGRNX.LT.1.0)THEN -C WRITE(*,4246)'GRWT',I,J,NZ,NB,IDAY(8,NB,NZ,NY,NX),TCC(NZ,NY,NX) -C 2,HTC(NZ,NY,NX),FGRNX,GRMX(NZ,NY,NX),GRWTB(NB,NZ,NY,NX) -C ENDIF - ENDIF - ENDIF -C -C GRAIN FILL BY TRANSLOCATION FROM STALK RESERVES -C UNTIL GRAIN SINK (=FINAL GRAIN NUMBER X MAXIMUM -C GRAIN SIZE) IS FILLED OR RESERVES ARE EXHAUSTED -C - IF(IDAY(7,NB,NZ,NY,NX).NE.0)THEN - IF(WTGRB(NB,NZ,NY,NX).GE.GRWTB(NB,NZ,NY,NX) - 2*GRNOB(NB,NZ,NY,NX))THEN - GROLM=0.0 - ELSEIF(IRTYP(NZ,NY,NX).EQ.0)THEN - GROLM=AMAX1(0.0,GFILL(NZ,NY,NX)*GRNOB(NB,NZ,NY,NX) - 2*SQRT(TFN3(NZ,NY,NX))) - ELSE - GROLM=AMAX1(0.0,GFILL(NZ,NY,NX)*GRNOB(NB,NZ,NY,NX) - 2*SQRT(TFN4(NG(NZ,NY,NX),NZ,NY,NX))) - ENDIF -C -C GRAIN FILL RATE MAY BE CONSTRAINED BY HIGH GRAIN C:N OR C:P -C - IF(WTGRBN(NB,NZ,NY,NX).LT.ZPGRM*CNGR(NZ,NY,NX) - 2*WTGRB(NB,NZ,NY,NX).OR.WTGRBP(NB,NZ,NY,NX).LT.ZPGRM - 3*CPGR(NZ,NY,NX)*WTGRB(NB,NZ,NY,NX))THEN - GROLC=0.0 - ELSE - GROLC=GROLM - ENDIF - XLOCM=AMIN1(GROLM,WTRSVB(NB,NZ,NY,NX)) - XLOCC=AMIN1(GROLC,WTRSVB(NB,NZ,NY,NX)) -C -C GRAIN N OR P FILL RATE MAY BE LIMITED BY C:N OR C:P RATIOS -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) - 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)) - XLOCN=AMIN1(XLOCM*CNGR(NZ,NY,NX) - 2,AMAX1(0.0,WTRSBN(NB,NZ,NY,NX)*ZPGRX) - 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) - 3,(WTGRB(NB,NZ,NY,NX)+XLOCC)*CPGR(NZ,NY,NX)-WTGRBP(NB,NZ,NY,NX)) - ELSE - XLOCN=0.0 - XLOCP=0.0 - ENDIF -C IF(NX.EQ.1.AND.NY.EQ.6.AND.NZ.EQ.3)THEN -C WRITE(*,85)'XLOC',I,J,NZ,NB,WTGRB(NB,NZ,NY,NX),WTGRBN(NB,NZ,NY,NX) -C 2,WTRSVB(NB,NZ,NY,NX),WTRSBN(NB,NZ,NY,NX),XLOCC,XLOCN,XLOCP,XLOCM -C 3,CNGR(NZ,NY,NX),ZPGRX,ZNPG,GROLC,GROLM,GROGR,GROGRN -C 3,XLOCM*CNGR(NZ,NY,NX),AMAX1(0.0,WTRSBN(NB,NZ,NY,NX)*ZPGRX) -C 4,(WTGRB(NB,NZ,NY,NX)+XLOCC)*CNGR(NZ,NY,NX)-WTGRBN(NB,NZ,NY,NX) -C 4,GRNOB(NB,NZ,NY,NX),GRWTB(NB,NZ,NY,NX),GFILL(NZ,NY,NX) -C 5,SQRT(TFN3(NZ,NY,NX)),FLG4(NB,NZ,NY,NX) -85 FORMAT(A8,4I4,20E12.4) -C ENDIF -C -C TRANSLOCATE C,N,P FROM STALK RESERVES TO GRAIN -C - WTRSVB(NB,NZ,NY,NX)=WTRSVB(NB,NZ,NY,NX)+GROGR-XLOCC - WTRSBN(NB,NZ,NY,NX)=WTRSBN(NB,NZ,NY,NX)+GROGRN-XLOCN - WTRSBP(NB,NZ,NY,NX)=WTRSBP(NB,NZ,NY,NX)+GROGRP-XLOCP - WTGRB(NB,NZ,NY,NX)=WTGRB(NB,NZ,NY,NX)+XLOCC - WTGRBN(NB,NZ,NY,NX)=WTGRBN(NB,NZ,NY,NX)+XLOCN - WTGRBP(NB,NZ,NY,NX)=WTGRBP(NB,NZ,NY,NX)+XLOCP - ELSE - XLOCC=0.0 - XLOCN=0.0 - XLOCP=0.0 - ENDIF -C -C SET DATE OF PHYSIOLOGICAL MATURITY WHEN GRAIN FILL -C HAS STOPPED FOR SET PERIOD OF TIME -C - IF(IDAY(8,NB,NZ,NY,NX).NE.0)THEN - IF(XLOCC.LE.1.0E-09*PP(NZ,NY,NX))THEN - FLG4(NB,NZ,NY,NX)=FLG4(NB,NZ,NY,NX)+1.0 - ELSE - FLG4(NB,NZ,NY,NX)=0.0 - ENDIF - IF(FLG4(NB,NZ,NY,NX).GE.FLG4X)THEN - IF(IDAY(10,NB,NZ,NY,NX).EQ.0)THEN - IDAY(10,NB,NZ,NY,NX)=I - ENDIF - ENDIF - ENDIF -C -C RESET PHENOLOGY AT EMERGENCE ('VRNS' > 'VRNL') -C AND END OF SEASON ('VRNF' > 'VRNX') -C - IF(ISTYP(NZ,NY,NX).NE.0.OR.IWTYP(NZ,NY,NX).NE.0)THEN - IF((IFLGE(NB,NZ,NY,NX).EQ.0 - 2.AND.VRNS(NB,NZ,NY,NX).GE.VRNL(NB,NZ,NY,NX) - 3.AND.ZC(NZ,NY,NX).GT.DPTHS(NY,NX)-1.0E-03) - 4.OR.(IFLGF(NB,NZ,NY,NX).EQ.0 - 5.AND.VRNF(NB,NZ,NY,NX).GE.VRNX(NB,NZ,NY,NX)) - 6.OR.IDTHB(NB1(NZ,NY,NX),NZ,NY,NX).EQ.1)THEN - IF(IFLGE(NB,NZ,NY,NX).EQ.0 - 2.AND.VRNS(NB,NZ,NY,NX).GE.VRNL(NB,NZ,NY,NX) - 3.AND.ZC(NZ,NY,NX).GT.DPTHS(NY,NX)-1.0E-03)THEN - IF(IBTYP(NZ,NY,NX).EQ.0)THEN - PSTG(NB,NZ,NY,NX)=XTLI(NZ,NY,NX) - VSTG(NB,NZ,NY,NX)=0.0 - KLEAF(NB,NZ,NY,NX)=1 - KVSTG(NB,NZ,NY,NX)=1 - FLG4(NB,NZ,NY,NX)=0.0 - DO 5330 M=1,4 - CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX) - 2+CFOPC(5,M,NZ,NY,NX)*WTLFB(NB,NZ,NY,NX)*FWODB(0) - 3+CFOPC(5,M,NZ,NY,NX)*WTSHEB(NB,NZ,NY,NX)*FWODB(0) - ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX) - 2+CFOPN(5,M,NZ,NY,NX)*WTLFBN(NB,NZ,NY,NX)*FWODLN(0) - 3+CFOPN(5,M,NZ,NY,NX)*WTSHBN(NB,NZ,NY,NX)*FWODSN(0) - PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX) - 2+CFOPP(5,M,NZ,NY,NX)*WTLFBP(NB,NZ,NY,NX)*FWODLP(0) - 3+CFOPP(5,M,NZ,NY,NX)*WTSHBP(NB,NZ,NY,NX)*FWODSP(0) - CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) - 2+CFOPC(1,M,NZ,NY,NX)*WTLFB(NB,NZ,NY,NX)*FWODB(1) - 3+CFOPC(2,M,NZ,NY,NX)*WTSHEB(NB,NZ,NY,NX)*FWODB(1) - ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) - 2+CFOPN(1,M,NZ,NY,NX)*WTLFBN(NB,NZ,NY,NX)*FWODLN(1) - 3+CFOPN(2,M,NZ,NY,NX)*WTSHBN(NB,NZ,NY,NX)*FWODSN(1) - PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) - 2+CFOPP(1,M,NZ,NY,NX)*WTLFBP(NB,NZ,NY,NX)*FWODLP(1) - 3+CFOPP(2,M,NZ,NY,NX)*WTSHBP(NB,NZ,NY,NX)*FWODSP(1) -5330 CONTINUE - ARLFB(NB,NZ,NY,NX)=0.0 - WTLFB(NB,NZ,NY,NX)=0.0 - WTLFBN(NB,NZ,NY,NX)=0.0 - WTLFBP(NB,NZ,NY,NX)=0.0 - WTSHEB(NB,NZ,NY,NX)=0.0 - WTSHBN(NB,NZ,NY,NX)=0.0 - WTSHBP(NB,NZ,NY,NX)=0.0 - DO 5335 K=0,25 - ARLF(K,NB,NZ,NY,NX)=0.0 - HTSHE(K,NB,NZ,NY,NX)=0.0 - WGLF(K,NB,NZ,NY,NX)=0.0 - WSLF(K,NB,NZ,NY,NX)=0.0 - WGLFN(K,NB,NZ,NY,NX)=0.0 - WGLFP(K,NB,NZ,NY,NX)=0.0 - WGSHE(K,NB,NZ,NY,NX)=0.0 - WSSHE(K,NB,NZ,NY,NX)=0.0 - WGSHN(K,NB,NZ,NY,NX)=0.0 - WGSHP(K,NB,NZ,NY,NX)=0.0 -5335 CONTINUE - ENDIF - ENDIF - IF((IBTYP(NZ,NY,NX).LT.2.AND.IWTYP(NZ,NY,NX).NE.0) - 2.OR.(IFLGE(NB,NZ,NY,NX).EQ.0 - 3.AND.VRNS(NB,NZ,NY,NX).GE.VRNL(NB,NZ,NY,NX)))THEN - IF(ISTYP(NZ,NY,NX).EQ.0)THEN - GROUP(NB,NZ,NY,NX)=AMAX1(0.0,GROUPI(NZ,NY,NX) - 2-NBTB(NB,NZ,NY,NX)) - ELSE - GROUP(NB,NZ,NY,NX)=GROUPI(NZ,NY,NX) - ENDIF - PSTGI(NB,NZ,NY,NX)=PSTG(NB,NZ,NY,NX) - PSTGF(NB,NZ,NY,NX)=0.0 - VSTGX(NB,NZ,NY,NX)=0.0 - TGSTGI(NB,NZ,NY,NX)=0.0 - TGSTGF(NB,NZ,NY,NX)=0.0 - IDAY(1,NB,NZ,NY,NX)=I - DO 2005 M=2,10 - IDAY(M,NB,NZ,NY,NX)=0 -2005 CONTINUE - IF(NB.EQ.NB1(NZ,NY,NX))THEN - WSTR(NZ,NY,NX)=0.0 - ENDIF -C -C RESIDUAL STALKS BECOME LITTERFALL IN GRASSES, SHRUBS AT -C START OF SEASON -C - IF(ISTYP(NZ,NY,NX).NE.0.AND.(IFLGE(NB,NZ,NY,NX).EQ.0 - 3.AND.VRNS(NB,NZ,NY,NX).GE.VRNL(NB,NZ,NY,NX)))THEN - DO 6245 M=1,4 - CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX)+CFOPC(2,M,NZ,NY,NX) - 2*(WTHSKB(NB,NZ,NY,NX)+WTEARB(NB,NZ,NY,NX)+WTGRB(NB,NZ,NY,NX)) - ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX)+CFOPN(2,M,NZ,NY,NX) - 2*(WTHSBN(NB,NZ,NY,NX)+WTEABN(NB,NZ,NY,NX)+WTGRBN(NB,NZ,NY,NX)) - PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX)+CFOPP(2,M,NZ,NY,NX) - 2*(WTHSBP(NB,NZ,NY,NX)+WTEABP(NB,NZ,NY,NX)+WTGRBP(NB,NZ,NY,NX)) -6245 CONTINUE - WTHSKB(NB,NZ,NY,NX)=0.0 - WTEARB(NB,NZ,NY,NX)=0.0 - WTGRB(NB,NZ,NY,NX)=0.0 - WTHSBN(NB,NZ,NY,NX)=0.0 - WTEABN(NB,NZ,NY,NX)=0.0 - WTGRBN(NB,NZ,NY,NX)=0.0 - WTHSBP(NB,NZ,NY,NX)=0.0 - WTEABP(NB,NZ,NY,NX)=0.0 - WTGRBP(NB,NZ,NY,NX)=0.0 - GRNXB(NB,NZ,NY,NX)=0.0 - GRNOB(NB,NZ,NY,NX)=0.0 - GRWTB(NB,NZ,NY,NX)=0.0 - IF(IBTYP(NZ,NY,NX).EQ.0.OR.IGTYP(NZ,NY,NX).LE.1)THEN - DO 6345 M=1,4 - CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX)+CFOPC(3,M,NZ,NY,NX) - 2*WTSTKB(NB,NZ,NY,NX) - ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX)+CFOPN(3,M,NZ,NY,NX) - 2*WTSTBN(NB,NZ,NY,NX) - PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX)+CFOPP(3,M,NZ,NY,NX) - 2*WTSTBP(NB,NZ,NY,NX) -6345 CONTINUE - WTSTKB(NB,NZ,NY,NX)=0.0 - WTSTBN(NB,NZ,NY,NX)=0.0 - WTSTBP(NB,NZ,NY,NX)=0.0 - WTSTXB(NB,NZ,NY,NX)=0.0 - WTSTXN(NB,NZ,NY,NX)=0.0 - WTSTXP(NB,NZ,NY,NX)=0.0 - DO 6340 K=0,25 - HTNODE(K,NB,NZ,NY,NX)=0.0 - HTNODX(K,NB,NZ,NY,NX)=0.0 - WGNODE(K,NB,NZ,NY,NX)=0.0 - WGNODN(K,NB,NZ,NY,NX)=0.0 - WGNODP(K,NB,NZ,NY,NX)=0.0 -6340 CONTINUE - ENDIF - ENDIF - ENDIF - IF(IFLGE(NB,NZ,NY,NX).EQ.0 - 2.AND.VRNS(NB,NZ,NY,NX).GE.VRNL(NB,NZ,NY,NX))THEN - IFLGA(NB,NZ,NY,NX)=0 - IFLGE(NB,NZ,NY,NX)=1 - IFLGR(NB,NZ,NY,NX)=0 - IFLGQ(NB,NZ,NY,NX)=0 - ELSE - IFLGF(NB,NZ,NY,NX)=1 - IFLGR(NB,NZ,NY,NX)=1 - IFLGQ(NB,NZ,NY,NX)=0 - ENDIF - ENDIF - ENDIF -C -C REPRODUCTIVE MATERIAL BECOMES LITTERFALL AT END OF SEASON -C - IF(IFLGR(NB,NZ,NY,NX).EQ.1)THEN - IFLGQ(NB,NZ,NY,NX)=IFLGQ(NB,NZ,NY,NX)+1 - IF(IFLGQ(NB,NZ,NY,NX).EQ.IFLGRX)THEN - IFLGR(NB,NZ,NY,NX)=0 - IFLGQ(NB,NZ,NY,NX)=0 - ENDIF - DO 6330 M=1,4 - CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) - 2+FSNR*CFOPC(2,M,NZ,NY,NX) - 2*(WTHSKB(NB,NZ,NY,NX)+WTEARB(NB,NZ,NY,NX)) - ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) - 2+FSNR*CFOPN(2,M,NZ,NY,NX) - 2*(WTHSBN(NB,NZ,NY,NX)+WTEABN(NB,NZ,NY,NX)) - PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) - 2+FSNR*CFOPP(2,M,NZ,NY,NX) - 2*(WTHSBP(NB,NZ,NY,NX)+WTEABP(NB,NZ,NY,NX)) - IF(ISTYP(NZ,NY,NX).EQ.0.AND.IWTYP(NZ,NY,NX).NE.0)THEN - WTRVC(NZ,NY,NX)=WTRVC(NZ,NY,NX) - 2+FSNR*CFOPC(2,M,NZ,NY,NX)*WTGRB(NB,NZ,NY,NX) - WTRVN(NZ,NY,NX)=WTRVN(NZ,NY,NX) - 2+FSNR*CFOPN(2,M,NZ,NY,NX)*WTGRBN(NB,NZ,NY,NX) - WTRVP(NZ,NY,NX)=WTRVP(NZ,NY,NX) - 2+FSNR*CFOPP(2,M,NZ,NY,NX)*WTGRBP(NB,NZ,NY,NX) - ELSE - CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) - 2+FSNR*CFOPC(2,M,NZ,NY,NX)*WTGRB(NB,NZ,NY,NX) - ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) - 2+FSNR*CFOPN(2,M,NZ,NY,NX)*WTGRBN(NB,NZ,NY,NX) - PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) - 2+FSNR*CFOPP(2,M,NZ,NY,NX)*WTGRBP(NB,NZ,NY,NX) - ENDIF -6330 CONTINUE - WTHSKB(NB,NZ,NY,NX)=(1.0-FSNR)*WTHSKB(NB,NZ,NY,NX) - WTEARB(NB,NZ,NY,NX)=(1.0-FSNR)*WTEARB(NB,NZ,NY,NX) - WTGRB(NB,NZ,NY,NX)=(1.0-FSNR)*WTGRB(NB,NZ,NY,NX) - WTHSBN(NB,NZ,NY,NX)=(1.0-FSNR)*WTHSBN(NB,NZ,NY,NX) - WTEABN(NB,NZ,NY,NX)=(1.0-FSNR)*WTEABN(NB,NZ,NY,NX) - WTGRBN(NB,NZ,NY,NX)=(1.0-FSNR)*WTGRBN(NB,NZ,NY,NX) - WTHSBP(NB,NZ,NY,NX)=(1.0-FSNR)*WTHSBP(NB,NZ,NY,NX) - WTEABP(NB,NZ,NY,NX)=(1.0-FSNR)*WTEABP(NB,NZ,NY,NX) - WTGRBP(NB,NZ,NY,NX)=(1.0-FSNR)*WTGRBP(NB,NZ,NY,NX) - GRNXB(NB,NZ,NY,NX)=(1.0-FSNR)*GRNXB(NB,NZ,NY,NX) - GRNOB(NB,NZ,NY,NX)=(1.0-FSNR)*GRNOB(NB,NZ,NY,NX) - GRWTB(NB,NZ,NY,NX)=(1.0-FSNR)*GRWTB(NB,NZ,NY,NX) -C -C STALKS BECOME LITTERFALL IN GRASSES AT END OF SEASON -C - IF((IBTYP(NZ,NY,NX).EQ.0.OR.IGTYP(NZ,NY,NX).LE.1) - 2.AND.ISTYP(NZ,NY,NX).NE.0)THEN - DO 6335 M=1,4 - CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) - 2+FSNR*CFOPC(3,M,NZ,NY,NX)*WTSTKB(NB,NZ,NY,NX) - ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) - 2+FSNR*CFOPN(3,M,NZ,NY,NX)*WTSTBN(NB,NZ,NY,NX) - PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) - 2+FSNR*CFOPP(3,M,NZ,NY,NX)*WTSTBP(NB,NZ,NY,NX) -6335 CONTINUE - WTSTKB(NB,NZ,NY,NX)=(1.0-FSNR)*WTSTKB(NB,NZ,NY,NX) - WTSTBN(NB,NZ,NY,NX)=(1.0-FSNR)*WTSTBN(NB,NZ,NY,NX) - WTSTBP(NB,NZ,NY,NX)=(1.0-FSNR)*WTSTBP(NB,NZ,NY,NX) - WTSTXB(NB,NZ,NY,NX)=(1.0-FSNR)*WTSTXB(NB,NZ,NY,NX) - WTSTXN(NB,NZ,NY,NX)=(1.0-FSNR)*WTSTXN(NB,NZ,NY,NX) - WTSTXP(NB,NZ,NY,NX)=(1.0-FSNR)*WTSTXP(NB,NZ,NY,NX) - DO 2010 K=0,25 -C HTNODE(K,NB,NZ,NY,NX)=(1.0-FSNR)*HTNODE(K,NB,NZ,NY,NX) - HTNODX(K,NB,NZ,NY,NX)=(1.0-FSNR)*HTNODX(K,NB,NZ,NY,NX) - WGNODE(K,NB,NZ,NY,NX)=(1.0-FSNR)*WGNODE(K,NB,NZ,NY,NX) - WGNODN(K,NB,NZ,NY,NX)=(1.0-FSNR)*WGNODN(K,NB,NZ,NY,NX) - WGNODP(K,NB,NZ,NY,NX)=(1.0-FSNR)*WGNODP(K,NB,NZ,NY,NX) -2010 CONTINUE - ENDIF -C -C SELF-SEEDING ANNUALS IF DROUGHT DECIDUOUS -C - IF(J.EQ.INT(ZNOON(NY,NX)))THEN - IF(NB.EQ.NB1(NZ,NY,NX))THEN - IF(ISTYP(NZ,NY,NX).EQ.0.AND.IWTYP(NZ,NY,NX).NE.0)THEN - IDAYH(NZ,NY,NX)=I - IYRH(NZ,NY,NX)=IYRC - IHVST(NZ,I,NY,NX)=1 - JHVST(NZ,I,NY,NX)=2 - HVST(NZ,I,NY,NX)=0.0 - THIN(NZ,I,NY,NX)=0.0 - EHVST(1,1,NZ,I,NY,NX)=1.0 - EHVST(1,2,NZ,I,NY,NX)=1.0 - EHVST(1,3,NZ,I,NY,NX)=1.0 - EHVST(1,4,NZ,I,NY,NX)=1.0 - EHVST(2,1,NZ,I,NY,NX)=0.0 - EHVST(2,2,NZ,I,NY,NX)=1.0 - EHVST(2,3,NZ,I,NY,NX)=0.0 - EHVST(2,4,NZ,I,NY,NX)=0.0 - IDAY0(NZ,NY,NX)=-1E+06 - IYR0(NZ,NY,NX)=-1E+06 - IFLGI(NZ,NY,NX)=1 -C WRITE(*,3366)'HVST',I,J,IYRC,IDAYH(NZ,NY,NX),IYRH(NZ,NY,NX) -C 2,IHVST(NZ,I,NY,NX),JHVST(NZ,I,NY,NX),IFLGI(NZ,NY,NX) -3366 FORMAT(A8,8I8) - ENDIF - ENDIF - ENDIF - ENDIF -C -C TRANSFER C,N,P FROM SEASONAL STORAGE TO SHOOT AND ROOT -C NON-STRUCTURAL C DURING SEED GERMINATION OR LEAFOUT -C -C IF(NZ.EQ.1)THEN -C WRITE(*,2322)'VRNS',I,J,NX,NY,NZ,NB,NB1(NZ,NY,NX),IFLGZ -C 2,ISTYP(NZ,NY,NX),IFLGI(NZ,NY,NX),VRNS(NB1(NZ,NY,NX),NZ,NY,NX) -C 3,VRNL(NB,NZ,NY,NX),VRNF(NB,NZ,NY,NX),VRNX(NB,NZ,NY,NX) -2322 FORMAT(A8,10I4,20E12.4) -C ENDIF - IF((ISTYP(NZ,NY,NX).EQ.0.AND.IFLGI(NZ,NY,NX).EQ.0) - 2.OR.(VRNS(NB1(NZ,NY,NX),NZ,NY,NX).GE.VRNL(NB,NZ,NY,NX) - 3.AND.VRNF(NB,NZ,NY,NX).LT.FVRN*VRNX(NB,NZ,NY,NX)))THEN - WTRTM=0.0 - CPOOLM=0.0 - DO 4 L=NU(NY,NX),NI(NZ,NY,NX) - WTRTM=WTRTM+AMAX1(0.0,WTRTD(1,L,NZ,NY,NX)) - CPOOLM=CPOOLM+AMAX1(0.0,CPOOLR(1,L,NZ,NY,NX)) -4 CONTINUE -C -C RESET TIME COUNTER -C - IF(IFLGA(NB,NZ,NY,NX).EQ.0)THEN - ATRP(NB,NZ,NY,NX)=0.0 - IFLGA(NB,NZ,NY,NX)=1 - ENDIF -C -C INCREMENT TIME COUNTER -C - IF(NB.EQ.NB1(NZ,NY,NX))THEN - IF(IPTYP(NZ,NY,NX).EQ.2 - 2.AND.(IWTYP(NZ,NY,NX).EQ.1.OR.IWTYP(NZ,NY,NX).EQ.3))THEN - PPDX=AMAX1(0.0,XDL(NZ,NY,NX)-XPPD(NZ,NY,NX)-DYLN(NY,NX)) - ATRPPD=EXP(-0.0*PPDX) - ELSE - ATRPPD=1.0 - ENDIF - DATRP=ATRPPD*TFN3(NZ,NY,NX)*WFNSG - ATRP(NB,NZ,NY,NX)=ATRP(NB,NZ,NY,NX)+DATRP -C IF(NZ.EQ.1)THEN -C WRITE(*,2323)'ATRP',I,J,NX,NY,NZ,NB,ATRP(NB,NZ,NY,NX),DATRP -C 2,ATRPPD,TFN3(NZ,NY,NX),WFNSG,PPDX,XDL(NZ,NY,NX),XPPD(NZ,NY,NX) -C 3,DYLN(NY,NX),WTLFB(NB,NZ,NY,NX),ARLFB(NB,NZ,NY,NX),HTCTL(NZ,NY,NX) -2323 FORMAT(A8,6I4,20E12.4) -C ENDIF - IF(ATRP(NB,NZ,NY,NX).LE.ATRPX - 2.OR.(ISTYP(NZ,NY,NX).EQ.0.AND.IWTYP(NZ,NY,NX).EQ.0))THEN - IF(WTRVC(NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - CPOOLT=CPOOLM+CPOOL(NB,NZ,NY,NX) -C -C REMOBILIZE C FROM SEASONAL STORAGE AT FIRST-ORDER RATE -C MODIFIED BY SOIL TEMPERATURE AT SEED DEPTH -C - GFNX=VMXS(ISTYP(NZ,NY,NX),IWTYP(NZ,NY,NX))*DATRP - CH2OH=AMAX1(0.0,GFNX*WTRVC(NZ,NY,NX)) -C IF(NZ.EQ.1.OR.NZ.EQ.4)THEN -C WRITE(*,2123)'GERM0',I,J,NX,NY,NZ,NB,GFNX,CH2OH,WTRVC(NZ,NY,NX) -C 2,CPOOL(NB,NZ,NY,NX),CPOOLR(1,NG(NZ,NY,NX),NZ,NY,NX) -C 3,FXSH(ISTYP(NZ,NY,NX)),FXRT(ISTYP(NZ,NY,NX)) -2123 FORMAT(A8,6I4,20E12.4) -C ENDIF - WTRVC(NZ,NY,NX)=WTRVC(NZ,NY,NX)-CH2OH - CPOOL(NB,NZ,NY,NX)=CPOOL(NB,NZ,NY,NX) - 2+CH2OH*FXSH(ISTYP(NZ,NY,NX)) - IF(WTRTM.GT.ZEROP(NZ,NY,NX).AND.CPOOLM.GT.ZEROP(NZ,NY,NX))THEN - DO 50 L=NU(NY,NX),NI(NZ,NY,NX) - FXFC=AMAX1(0.0,WTRTD(1,L,NZ,NY,NX))/WTRTM - CPOOLR(1,L,NZ,NY,NX)=CPOOLR(1,L,NZ,NY,NX) - 2+FXFC*CH2OH*FXRT(ISTYP(NZ,NY,NX)) -50 CONTINUE - ELSE - CPOOLR(1,NG(NZ,NY,NX),NZ,NY,NX)=CPOOLR(1,NG(NZ,NY,NX),NZ,NY,NX) - 2+CH2OH*FXRT(ISTYP(NZ,NY,NX)) - ENDIF - ELSE - CH2OH=0.0 - ENDIF - ELSE - CH2OH=0.0 - ENDIF -C -C REMOBILIZE N,P FROM SEASONAL STORAGE AT FIRST-ORDER RATE -C MODIFIED BY SOIL TEMPERATURE AT SEED DEPTH -C - IF(WTRVC(NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - IF(ISTYP(NZ,NY,NX).NE.0)THEN - CPOOLT=AMAX1(0.0,WTRVC(NZ,NY,NX)+CPOOL(NB,NZ,NY,NX)) - ZPOOLD=(WTRVN(NZ,NY,NX)*CPOOL(NB,NZ,NY,NX) - 2-ZPOOL(NB,NZ,NY,NX)*WTRVC(NZ,NY,NX))/CPOOLT - PPOOLD=(WTRVP(NZ,NY,NX)*CPOOL(NB,NZ,NY,NX) - 2-PPOOL(NB,NZ,NY,NX)*WTRVC(NZ,NY,NX))/CPOOLT - UPNH4B=AMAX1(0.0,FRSV(IBTYP(NZ,NY,NX))*ZPOOLD) - UPPO4B=AMAX1(0.0,FRSV(IBTYP(NZ,NY,NX))*PPOOLD) - ELSE - UPNH4B=AMAX1(0.0,FXSH(ISTYP(NZ,NY,NX)) - 2*CH2OH*WTRVN(NZ,NY,NX)/WTRVC(NZ,NY,NX)) - UPPO4B=AMAX1(0.0,FXSH(ISTYP(NZ,NY,NX)) - 2*CH2OH*WTRVP(NZ,NY,NX)/WTRVC(NZ,NY,NX)) - ENDIF - ELSE - UPNH4B=AMAX1(0.0,FXSH(ISTYP(NZ,NY,NX))*WTRVN(NZ,NY,NX)) - UPPO4B=AMAX1(0.0,FXSH(ISTYP(NZ,NY,NX))*WTRVP(NZ,NY,NX)) - ENDIF -C -C ADD TO NON-STRUCTURAL POOLS IN ROOT -C - CPOOLM=0.0 - ZPOOLM=0.0 - PPOOLM=0.0 - DO 3 L=NU(NY,NX),NI(NZ,NY,NX) - CPOOLM=CPOOLM+AMAX1(0.0,CPOOLR(1,L,NZ,NY,NX)) - ZPOOLM=ZPOOLM+AMAX1(0.0,ZPOOLR(1,L,NZ,NY,NX)) - PPOOLM=PPOOLM+AMAX1(0.0,PPOOLR(1,L,NZ,NY,NX)) -3 CONTINUE - IF(WTRVC(NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - IF(ISTYP(NZ,NY,NX).NE.0)THEN - CPOOLT=AMAX1(ZEROP(NZ,NY,NX),WTRVC(NZ,NY,NX)+CPOOLM) - ZPOOLD=(WTRVN(NZ,NY,NX)*CPOOLM - 2-ZPOOLM*WTRVC(NZ,NY,NX))/CPOOLT - PPOOLD=(WTRVP(NZ,NY,NX)*CPOOLM - 2-PPOOLM*WTRVC(NZ,NY,NX))/CPOOLT - UPNH4R=AMAX1(0.0,FRSV(IBTYP(NZ,NY,NX))*ZPOOLD) - UPPO4R=AMAX1(0.0,FRSV(IBTYP(NZ,NY,NX))*PPOOLD) -C IF(NZ.EQ.1.OR.NZ.EQ.4)THEN -C WRITE(*,9878)'GERM1',I,J,NZ,UPNH4R,FRSV(IBTYP(NZ,NY,NX)) -C 2,ZPOOLD,WTRVN(NZ,NY,NX),CPOOLM,ZPOOLM,WTRVC(NZ,NY,NX) -C 3,CPOOLT -9878 FORMAT(A8,3I4,12E24.16) -C ENDIF - ELSE - UPNH4R=AMAX1(0.0,FXRT(ISTYP(NZ,NY,NX)) - 2*CH2OH*WTRVN(NZ,NY,NX)/WTRVC(NZ,NY,NX)) - UPPO4R=AMAX1(0.0,FXRT(ISTYP(NZ,NY,NX)) - 2*CH2OH*WTRVP(NZ,NY,NX)/WTRVC(NZ,NY,NX)) - ENDIF - ELSE - UPNH4R=AMAX1(0.0,FXRT(ISTYP(NZ,NY,NX))*WTRVN(NZ,NY,NX)) - UPPO4R=AMAX1(0.0,FXRT(ISTYP(NZ,NY,NX))*WTRVP(NZ,NY,NX)) - ENDIF -C -C TRANSFER STORAGE FLUXES -C - WTRVN(NZ,NY,NX)=WTRVN(NZ,NY,NX)-UPNH4B-UPNH4R - WTRVP(NZ,NY,NX)=WTRVP(NZ,NY,NX)-UPPO4B-UPPO4R - ZPOOL(NB,NZ,NY,NX)=ZPOOL(NB,NZ,NY,NX)+UPNH4B - PPOOL(NB,NZ,NY,NX)=PPOOL(NB,NZ,NY,NX)+UPPO4B - IF(WTRTM.GT.ZEROP(NZ,NY,NX) - 2.AND.CPOOLM.GT.ZEROP(NZ,NY,NX))THEN - DO 51 L=NU(NY,NX),NI(NZ,NY,NX) - FXFN=AMAX1(0.0,CPOOLR(1,L,NZ,NY,NX))/CPOOLM -C IF(NZ.EQ.1.OR.NZ.EQ.4)THEN -C WRITE(*,9879)'GERM2',I,J,NZ,L,UPNH4R,FXFN -C 2,ZPOOLR(1,L,NZ,NY,NX),CPOOLR(1,L,NZ,NY,NX),CPOOLM -9879 FORMAT(A8,4I4,12E24.16) -C ENDIF - ZPOOLR(1,L,NZ,NY,NX)=ZPOOLR(1,L,NZ,NY,NX)+FXFN*UPNH4R - PPOOLR(1,L,NZ,NY,NX)=PPOOLR(1,L,NZ,NY,NX)+FXFN*UPPO4R -51 CONTINUE - ELSE -C IF(NZ.EQ.1.OR.NZ.EQ.4)THEN -C WRITE(*,9879)'GERM3',I,J,NZ,L,UPNH4R,FXFN -C 2,ZPOOLR(1,L,NZ,NY,NX),CPOOLR(1,L,NZ,NY,NX),CPOOLM -C ENDIF - ZPOOLR(1,NG(NZ,NY,NX),NZ,NY,NX)=ZPOOLR(1,NG(NZ,NY,NX),NZ,NY,NX) - 2+UPNH4R - PPOOLR(1,NG(NZ,NY,NX),NZ,NY,NX)=PPOOLR(1,NG(NZ,NY,NX),NZ,NY,NX) - 2+UPPO4R - ENDIF - ENDIF -C -C REDISTRIBUTE TRANFERRED C FROM MAIN STEM TO OTHER BRANCHES -C - IF(NB.NE.NB1(NZ,NY,NX).AND.ATRP(NB,NZ,NY,NX).LE.ATRPX)THEN - ATRP(NB,NZ,NY,NX)=ATRP(NB,NZ,NY,NX)+TFN3(NZ,NY,NX)*WFNG - XFRC=AMAX1(0.0,0.05*TFN3(NZ,NY,NX) - 2*(0.5*(CPOOL(NB1(NZ,NY,NX),NZ,NY,NX)+CPOOL(NB,NZ,NY,NX)) - 3-CPOOL(NB,NZ,NY,NX))) - XFRN=AMAX1(0.0,0.05*TFN3(NZ,NY,NX) - 2*(0.5*(ZPOOL(NB1(NZ,NY,NX),NZ,NY,NX)+ZPOOL(NB,NZ,NY,NX)) - 2-ZPOOL(NB,NZ,NY,NX))) - XFRP=AMAX1(0.0,0.05*TFN3(NZ,NY,NX) - 2*(0.5*(PPOOL(NB1(NZ,NY,NX),NZ,NY,NX)+PPOOL(NB,NZ,NY,NX)) - 3-PPOOL(NB,NZ,NY,NX))) - CPOOL(NB,NZ,NY,NX)=CPOOL(NB,NZ,NY,NX)+XFRC - ZPOOL(NB,NZ,NY,NX)=ZPOOL(NB,NZ,NY,NX)+XFRN - PPOOL(NB,NZ,NY,NX)=PPOOL(NB,NZ,NY,NX)+XFRP - CPOOL(NB1(NZ,NY,NX),NZ,NY,NX)=CPOOL(NB1(NZ,NY,NX),NZ,NY,NX)-XFRC - ZPOOL(NB1(NZ,NY,NX),NZ,NY,NX)=ZPOOL(NB1(NZ,NY,NX),NZ,NY,NX)-XFRN - PPOOL(NB1(NZ,NY,NX),NZ,NY,NX)=PPOOL(NB1(NZ,NY,NX),NZ,NY,NX)-XFRP - ENDIF - ENDIF -C -C TRANSFER LEAF AND STALK NON-STRUCTURAL C,N,P TO SEASONAL STORAGE -C IN PERENNIALS AFTER GRAIN FILL IN DETERMINATES, AFTER AUTUMNIZ'N -C IN INDETERMINATES, OR AFTER SUSTAINED WATER STRESS -C - IF(ISTYP(NZ,NY,NX).NE.0.AND.IFLGZ.EQ.1)THEN - IF(WVSTKB(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX) - 2.AND.WTRSVB(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - CWTRSV=AMAX1(0.0,WTRSVB(NB,NZ,NY,NX)/WVSTKB(NB,NZ,NY,NX)) - CWTRSN=AMAX1(0.0,WTRSBN(NB,NZ,NY,NX)/WVSTKB(NB,NZ,NY,NX)) - CWTRSP=AMAX1(0.0,WTRSBP(NB,NZ,NY,NX)/WVSTKB(NB,NZ,NY,NX)) - CNR=CWTRSV/(CWTRSV+CWTRSN*CNKI) - CPR=CWTRSV/(CWTRSV+CWTRSP*CPKI) - ELSE - CNR=0.0 - CPR=0.0 - ENDIF - XFRCX=FXFB(IBTYP(NZ,NY,NX)) - 2*AMAX1(0.0,WTRSVB(NB,NZ,NY,NX)) - XFRNX=FXFB(IBTYP(NZ,NY,NX)) - 2*AMAX1(0.0,WTRSBN(NB,NZ,NY,NX))*(1.0+CNR) - XFRPX=FXFB(IBTYP(NZ,NY,NX)) - 2*AMAX1(0.0,WTRSBP(NB,NZ,NY,NX))*(1.0+CPR) - XFRC=AMIN1(XFRCX,XFRNX/CNMN,XFRPX/CPMN) - XFRN=AMIN1(XFRNX,XFRC*CNMX,XFRPX*CNMX/CPMN*0.5) - XFRP=AMIN1(XFRPX,XFRC*CPMX,XFRNX*CPMX/CNMN*0.5) - WTRSVB(NB,NZ,NY,NX)=WTRSVB(NB,NZ,NY,NX)-XFRC - WTRVC(NZ,NY,NX)=WTRVC(NZ,NY,NX)+XFRC - WTRSBN(NB,NZ,NY,NX)=WTRSBN(NB,NZ,NY,NX)-XFRN - WTRVN(NZ,NY,NX)=WTRVN(NZ,NY,NX)+XFRN - WTRSBP(NB,NZ,NY,NX)=WTRSBP(NB,NZ,NY,NX)-XFRP - WTRVP(NZ,NY,NX)=WTRVP(NZ,NY,NX)+XFRP - IF(CPOOL(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - CNL=CCPOLB(NB,NZ,NY,NX)/(CCPOLB(NB,NZ,NY,NX) - 2+CZPOLB(NB,NZ,NY,NX)*CNKI) - CPL=CCPOLB(NB,NZ,NY,NX)/(CCPOLB(NB,NZ,NY,NX) - 2+CPPOLB(NB,NZ,NY,NX)*CPKI) - ELSE - CNL=0.0 - CPL=0.0 - ENDIF - XFRCX=FXFB(IBTYP(NZ,NY,NX)) - 2*AMAX1(0.0,CPOOL(NB,NZ,NY,NX)) - XFRNX=FXFB(IBTYP(NZ,NY,NX)) - 2*AMAX1(0.0,ZPOOL(NB,NZ,NY,NX))*(1.0+CNL) - XFRPX=FXFB(IBTYP(NZ,NY,NX)) - 2*AMAX1(0.0,PPOOL(NB,NZ,NY,NX))*(1.0+CPL) - XFRC=AMIN1(XFRCX,XFRNX/CNMN,XFRPX/CPMN) - XFRN=AMIN1(XFRNX,XFRC*CNMX,XFRPX*CNMX/CPMN*0.5) - XFRP=AMIN1(XFRPX,XFRC*CPMX,XFRNX*CPMX/CNMN*0.5) - CPOOL(NB,NZ,NY,NX)=CPOOL(NB,NZ,NY,NX)-XFRC - WTRVC(NZ,NY,NX)=WTRVC(NZ,NY,NX)+XFRC - ZPOOL(NB,NZ,NY,NX)=ZPOOL(NB,NZ,NY,NX)-XFRN - WTRVN(NZ,NY,NX)=WTRVN(NZ,NY,NX)+XFRN - PPOOL(NB,NZ,NY,NX)=PPOOL(NB,NZ,NY,NX)-XFRP - WTRVP(NZ,NY,NX)=WTRVP(NZ,NY,NX)+XFRP -C IF(NZ.EQ.1)THEN -C WRITE(*,4490)'RSV',I,J,NZ,NB,XFRC,XFRN,WTRSVB(NB,NZ,NY,NX) -C 2,WTRSBN(NB,NZ,NY,NX),WTRVC(NZ,NY,NX),WTRVN(NZ,NY,NX) -C 3,CNR,CNL,CPOOL(NB,NZ,NY,NX),ZPOOL(NB,NZ,NY,NX) -C 4,FXFB(IBTYP(NZ,NY,NX)) -4490 FORMAT(A8,4I4,20E12.4) -C ENDIF - ENDIF -C -C TRANSFER NON-STRUCTURAL C,N,P FROM LEAVES AND ROOTS TO RESERVES -C IN STALKS DURING GRAIN FILL IN ANNUALS OR BETWEEN STALK RESERVES -C AND LEAVES IN PERENNIALS ACCORDING TO CONCENTRATION DIFFERENCES -C - IF(IDAY(3,NB,NZ,NY,NX).NE.0)THEN - IF(ISTYP(NZ,NY,NX).EQ.0.AND.IDAY(8,NB,NZ,NY,NX).NE.0)THEN - NS=0 - ELSE - NS=1 - ENDIF - WTPLTT=WTLSB(NB,NZ,NY,NX)+WVSTKB(NB,NZ,NY,NX) - CPOOLT=CPOOL(NB,NZ,NY,NX)+WTRSVB(NB,NZ,NY,NX) - IF(WTPLTT.GT.ZEROP(NZ,NY,NX))THEN - CPOOLD=(CPOOL(NB,NZ,NY,NX)*WVSTKB(NB,NZ,NY,NX) - 2-WTRSVB(NB,NZ,NY,NX)*WTLSB(NB,NZ,NY,NX))/WTPLTT - XFRC=FXFV(NS)*CPOOLD - CPOOL(NB,NZ,NY,NX)=CPOOL(NB,NZ,NY,NX)-XFRC - WTRSVB(NB,NZ,NY,NX)=WTRSVB(NB,NZ,NY,NX)+XFRC - ENDIF - IF(CPOOLT.GT.ZEROP(NZ,NY,NX))THEN - ZPOOLD=(ZPOOL(NB,NZ,NY,NX)*WTRSVB(NB,NZ,NY,NX) - 2-WTRSBN(NB,NZ,NY,NX)*CPOOL(NB,NZ,NY,NX))/CPOOLT - PPOOLD=(PPOOL(NB,NZ,NY,NX)*WTRSVB(NB,NZ,NY,NX) - 2-WTRSBP(NB,NZ,NY,NX)*CPOOL(NB,NZ,NY,NX))/CPOOLT - XFRN=FXFZ(NS)*ZPOOLD - XFRP=FXFZ(NS)*PPOOLD - ZPOOL(NB,NZ,NY,NX)=ZPOOL(NB,NZ,NY,NX)-XFRN - WTRSBN(NB,NZ,NY,NX)=WTRSBN(NB,NZ,NY,NX)+XFRN - PPOOL(NB,NZ,NY,NX)=PPOOL(NB,NZ,NY,NX)-XFRP - WTRSBP(NB,NZ,NY,NX)=WTRSBP(NB,NZ,NY,NX)+XFRP - ENDIF -C IF(NZ.EQ.1)THEN -C WRITE(*,4488)'EXCHC',I,J,NX,NY,NZ,NB,NS,XFRC,XFRN -C 2,FXFV(NS),WTRSVB(NB,NZ,NY,NX),CPOOL(NB,NZ,NY,NX) -C 3,WVSTKB(NB,NZ,NY,NX),WTLSB(NB,NZ,NY,NX) -C 4,CPOOLT,CPOOLD,ZPOOL(NB,NZ,NY,NX),WTRSBN(NB,NZ,NY,NX) -4488 FORMAT(A8,7I4,12E12.4) -C ENDIF - IF(NS.EQ.0)THEN - DO 2050 L=NU(NY,NX),NI(NZ,NY,NX) - WTRTRX=AMAX1(ZEROP(NZ,NY,NX),WTRTL(1,L,NZ,NY,NX)*FWOOD(1)) - WTPLTX=WTRTRX+WVSTKB(NB,NZ,NY,NX) - IF(WTPLTX.GT.ZEROP(NZ,NY,NX))THEN - CPOOLD=(CPOOLR(1,L,NZ,NY,NX)*WVSTKB(NB,NZ,NY,NX) - 2-WTRSVB(NB,NZ,NY,NX)*WTRTRX)/WTPLTX - XFRC=AMIN1(CPOOLR(1,L,NZ,NY,NX),AMAX1(-WTRSVB(NB,NZ,NY,NX) - 2,FXFV(NS)*CPOOLD)) - CPOOLR(1,L,NZ,NY,NX)=CPOOLR(1,L,NZ,NY,NX)-XFRC - WTRSVB(NB,NZ,NY,NX)=WTRSVB(NB,NZ,NY,NX)+XFRC - CPOOLT=CPOOLR(1,L,NZ,NY,NX)+WTRSVB(NB,NZ,NY,NX) - IF(CPOOLT.GT.ZEROP(NZ,NY,NX))THEN - ZPOOLD=(ZPOOLR(1,L,NZ,NY,NX)*WTRSVB(NB,NZ,NY,NX) - 2-WTRSBN(NB,NZ,NY,NX)*CPOOLR(1,L,NZ,NY,NX))/CPOOLT - PPOOLD=(PPOOLR(1,L,NZ,NY,NX)*WTRSVB(NB,NZ,NY,NX) - 2-WTRSBP(NB,NZ,NY,NX)*CPOOLR(1,L,NZ,NY,NX))/CPOOLT - XFRN=AMIN1(ZPOOLR(1,L,NZ,NY,NX),AMAX1(-WTRSBN(NB,NZ,NY,NX) - 2,FXFZ(NS)*ZPOOLD)) - XFRP=AMIN1(PPOOLR(1,L,NZ,NY,NX),AMAX1(-WTRSBP(NB,NZ,NY,NX) - 2,FXFZ(NS)*PPOOLD)) - ZPOOLR(1,L,NZ,NY,NX)=ZPOOLR(1,L,NZ,NY,NX)-XFRN - WTRSBN(NB,NZ,NY,NX)=WTRSBN(NB,NZ,NY,NX)+XFRN - PPOOLR(1,L,NZ,NY,NX)=PPOOLR(1,L,NZ,NY,NX)-XFRP - WTRSBP(NB,NZ,NY,NX)=WTRSBP(NB,NZ,NY,NX)+XFRP -C IF(NZ.EQ.1)THEN -C WRITE(*,4489)'EXCHC',I,J,NZ,NB,L,WTRSVB(NB,NZ,NY,NX) -C 2,WVSTKB(NB,NZ,NY,NX),CPOOLR(1,L,NZ,NY,NX) -C 3,WTRTL(1,L,NZ,NY,NX),FWOOD(1),WTRTRX,WTPLTX -C 4,CPOOLT,CPOOLD,XFRC,FXFV(NS) -4489 FORMAT(A8,5I4,12E16.8) -C ENDIF -C IF(NZ.EQ.1.OR.NZ.EQ.4)THEN -C WRITE(*,4489)'EXCHN',I,J,NZ,NB,L,WTRSBN(NB,NZ,NY,NX) -C 2,WTRSVB(NB,NZ,NY,NX),ZPOOLR(1,L,NZ,NY,NX) -C 3,CPOOLR(1,L,NZ,NY,NX),FWOOD(1),ZPOOLD,XFRN -C ENDIF - ENDIF - ENDIF -2050 CONTINUE - ENDIF - ENDIF -C -C REPLENISH BRANCH NON-STRUCTURAL POOL FROM -C SEASONAL STORAGE POOL -C - IF(WVSTKB(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX) - 2.AND.WVSTK(NZ,NY,NX).GT.ZEROP(NZ,NY,NX) - 3.AND.WTRT(NZ,NY,NX).GT.ZEROP(NZ,NY,NX) - 4.AND.WTRSVB(NB,NZ,NY,NX).LE.XFRX*WVSTKB(NB,NZ,NY,NX))THEN - FWTBR=WVSTKB(NB,NZ,NY,NX)/WVSTK(NZ,NY,NX) - WVSTBX=WVSTKB(NB,NZ,NY,NX) - WTRTTX=WTRT(NZ,NY,NX)*FWTBR - WTPLTT=WVSTBX+WTRTTX - WTRSBX=AMAX1(0.0,WTRSVB(NB,NZ,NY,NX)) - WTRVCX=AMAX1(0.0,WTRVC(NZ,NY,NX)*FWTBR) - CPOOLD=(WTRVCX*WVSTBX-WTRSBX*WTRTTX)/WTPLTT - XFRC=AMAX1(0.0,XFRY*CPOOLD) - WTRSVB(NB,NZ,NY,NX)=WTRSVB(NB,NZ,NY,NX)+XFRC - WTRVC(NZ,NY,NX)=WTRVC(NZ,NY,NX)-XFRC - ENDIF -C -C CANOPY N2 FIXATION (CYANOBACTERIA) -C - IF(INTYP(NZ,NY,NX).GE.3)THEN -C -C INITIAL INFECTION -C - IF(WTNDB(NB,NZ,NY,NX).LE.0.0)THEN - WTNDB(NB,NZ,NY,NX)=WTNDB(NB,NZ,NY,NX) - 2+WTNDI*AREA(3,NU(NY,NX),NY,NX) - WTNDBN(NB,NZ,NY,NX)=WTNDBN(NB,NZ,NY,NX) - 2+WTNDI*AREA(3,NU(NY,NX),NY,NX)*CNND(NZ,NY,NX) - WTNDBP(NB,NZ,NY,NX)=WTNDBP(NB,NZ,NY,NX) - 2+WTNDI*AREA(3,NU(NY,NX),NY,NX)*CPND(NZ,NY,NX) - ENDIF -C -C O2-UNCONSTRAINED RESPIRATION RATES BY HETEROTROPHIC AEROBES -C IN NODULE FROM SPECIFIC OXIDATION RATE, ACTIVE BIOMASS, -C NON-STRUCTURAL C CONCENTRATION, MICROBIAL C:N:P FACTOR, -C AND TEMPERATURE -C - IF(WTNDB(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - CCPOLN=AMAX1(0.0,CPOLNB(NB,NZ,NY,NX)/WTNDB(NB,NZ,NY,NX)) - CZPOLN=AMAX1(0.0,ZPOLNB(NB,NZ,NY,NX)/WTNDB(NB,NZ,NY,NX)) - CPPOLN=AMAX1(0.0,PPOLNB(NB,NZ,NY,NX)/WTNDB(NB,NZ,NY,NX)) - ELSE - CCPOLN=1.0 - CZPOLN=1.0 - 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) - ELSE - CCC=0.0 - CNC=0.0 - CPC=0.0 - CNF=0.0 - ENDIF - IF(WTNDB(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - FCNPF=AMIN1(1.0,AMAX1(0.0 - 2,WTNDBN(NB,NZ,NY,NX)/(WTNDB(NB,NZ,NY,NX)*CNND(NZ,NY,NX)) - 3,WTNDBP(NB,NZ,NY,NX)/(WTNDB(NB,NZ,NY,NX)*CPND(NZ,NY,NX)))) - ELSE - FCNPF=1.0 - ENDIF - RDNDBX=CCPOLN/(CCPOLN+CCNKX) - RCNDL=AMAX1(0.0,AMIN1(CPOLNB(NB,NZ,NY,NX)*(1.0-DMND(NZ,NY,NX)) - 2,VMXO*WTNDB(NB,NZ,NY,NX)*CCPOLN/(CCPOLN+CCNKM) - 3*TFN3(NZ,NY,NX)*FCNPF*WFNG))*CNF -C -C NODULE MAINTENANCE RESPIRATION FROM SOIL TEMPERATURE, -C NODULE STRUCTURAL N -C - RMNDL=AMAX1(0.0,RMPLT*TFN5*WTNDBN(NB,NZ,NY,NX))*RDNDBX -C -C NODULE GROWTH RESPIRATION FROM TOTAL - MAINTENANCE -C IF > 0 DRIVES GROWTH, IF < 0 DRIVES REMOBILIZATION -C - RXNDL=RCNDL-RMNDL - RGNDL=AMAX1(0.0,RXNDL) - RSNDL=AMAX1(0.0,-RXNDL) -C -C NODULE N2 FIXATION FROM GROWTH RESPIRATION, FIXATION ENERGY -C REQUIREMENT AND NON-STRUCTURAL C:N:P PRODUCT INHIBITION, -C CONSTRAINED BY MICROBIAL N REQUIREMENT -C - RGN2P=AMAX1(0.0,WTNDB(NB,NZ,NY,NX)*CNND(NZ,NY,NX) - 2-WTNDBN(NB,NZ,NY,NX))/EN2F - RGN2F=AMIN1(RGNDL,RGN2P) - RUPNFB=RGN2F*EN2F - UPNFC(NZ,NY,NX)=UPNFC(NZ,NY,NX)+RUPNFB -C -C TOTAL NON-STRUCTURAL C,N,P USED IN NODULE GROWTH -C AND GROWTH RESPIRATION DEPENDS ON GROWTH YIELD ENTERED IN 'READQ' -C - CGNDL=(RGNDL-RGN2F)/(1.0-DMND(NZ,NY,NX)) - GRNDG=CGNDL*DMND(NZ,NY,NX) - ZADDN=AMAX1(0.0,AMIN1(ZPOLNB(NB,NZ,NY,NX) - 2,GRNDG*CNND(NZ,NY,NX))*CCC) - PADDN=AMAX1(0.0,AMIN1(PPOLNB(NB,NZ,NY,NX) - 2,GRNDG*CPND(NZ,NY,NX))*CCC) -C -C NODULE C,N,P REMOBILIZATION AND DECOMPOSITION AND LEAKAGE -C - RCCC=RCCZ(IBTYP(NZ,NY,NX))+CCC*RCCY(IBTYP(NZ,NY,NX)) - RCCN=CNC*RCCX(IGTYP(NZ,NY,NX)) - RCCP=CPC*RCCQ(IGTYP(NZ,NY,NX)) - SPNDX=SPNDL*RDNDBX - RXNDLC=SPNDX*WTNDB(NB,NZ,NY,NX)*WFNG - RXNDLN=SPNDX*WTNDBN(NB,NZ,NY,NX)*WFNG - RXNDLP=SPNDX*WTNDBP(NB,NZ,NY,NX)*WFNG - RDNDLC=RXNDLC*(1.0-RCCC) - RDNDLN=RXNDLN*(1.0-RCCN)*(1.0-RCCC) - RDNDLP=RXNDLP*(1.0-RCCP)*(1.0-RCCC) - RCNDLC=RXNDLC-RDNDLC - RCNDLN=RXNDLN-RDNDLN - RCNDLP=RXNDLP-RDNDLP -C -C NODULE SENESCENCE -C - IF(RSNDL.GT.0.0.AND.WTNDB(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX) - 2.AND.RCCC.GT.ZERO)THEN - RXNSNC=RSNDL/RCCC - RXNSNN=RXNSNC*WTNDBN(NB,NZ,NY,NX)/WTNDB(NB,NZ,NY,NX) - RXNSNP=RXNSNC*WTNDBP(NB,NZ,NY,NX)/WTNDB(NB,NZ,NY,NX) - RDNSNC=RXNSNC*(1.0-RCCC) - RDNSNN=RXNSNN*(1.0-RCCN)*(1.0-RCCC) - RDNSNP=RXNSNP*(1.0-RCCP)*(1.0-RCCC) - RCNSNC=RXNSNC-RDNSNC - RCNSNN=RXNSNN-RDNSNN - RCNSNP=RXNSNP-RDNSNP - ELSE - RXNSNC=0.0 - RXNSNN=0.0 - RXNSNP=0.0 - RDNSNC=0.0 - RDNSNN=0.0 - RDNSNP=0.0 - RCNSNC=0.0 - RCNSNN=0.0 - RCNSNP=0.0 - ENDIF -C -C TOTAL NODULE RESPIRATION -C - RCO2T=AMIN1(RMNDL,RCNDL)+RGNDL+RCNSNC - TCO2T(NZ,NY,NX)=TCO2T(NZ,NY,NX)-RCO2T - TCO2A(NZ,NY,NX)=TCO2A(NZ,NY,NX)-RCO2T - CNET(NZ,NY,NX)=CNET(NZ,NY,NX)-RCO2T - RECO(NY,NX)=RECO(NY,NX)-RCO2T - TRAU(NY,NX)=TRAU(NY,NX)-RCO2T -C -C NODULE LITTERFALL CAUSED BY REMOBILIZATION -C - DO 6470 M=1,4 - CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX)+CFOPC(1,M,NZ,NY,NX) - 2*(RDNDLC+RDNSNC) - ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX)+CFOPN(1,M,NZ,NY,NX) - 2*(RDNDLN+RDNSNN) - PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX)+CFOPP(1,M,NZ,NY,NX) - 2*(RDNDLP+RDNSNP) -6470 CONTINUE -C -C CONSUMPTION OF NON-STRUCTURAL C,N,P BY NODULE -C - CPOLNB(NB,NZ,NY,NX)=CPOLNB(NB,NZ,NY,NX)-AMIN1(RMNDL,RCNDL) - 2-RGN2F-CGNDL+RCNDLC - ZPOLNB(NB,NZ,NY,NX)=ZPOLNB(NB,NZ,NY,NX)-ZADDN+RCNDLN+RCNSNN - 2+RUPNFB - PPOLNB(NB,NZ,NY,NX)=PPOLNB(NB,NZ,NY,NX)-PADDN+RCNDLP+RCNSNP -C -C UPDATE STATE VARIABLES FOR NODULE C, N, P -C - WTNDB(NB,NZ,NY,NX)=WTNDB(NB,NZ,NY,NX)+GRNDG-RXNDLC-RXNSNC - WTNDBN(NB,NZ,NY,NX)=WTNDBN(NB,NZ,NY,NX)+ZADDN-RXNDLN-RXNSNN - WTNDBP(NB,NZ,NY,NX)=WTNDBP(NB,NZ,NY,NX)+PADDN-RXNDLP-RXNSNP -C -C TRANSFER NON-STRUCTURAL C,N,P BETWEEN BRANCH AND NODULES -C FROM NON-STRUCTURAL C,N,P CONCENTRATION DIFFERENCES -C - 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),WTNDB(NB,NZ,NY,NX)) - WTLSBT=WTLSB1+WTNDB1 - IF(WTLSBT.GT.ZEROP(NZ,NY,NX))THEN - CPOOLD=(CPOOL(NB,NZ,NY,NX)*WTNDB1 - 2-CPOLNB(NB,NZ,NY,NX)*WTLSB1)/WTLSBT - XFRC=FXRN(INTYP(NZ,NY,NX))*CPOOLD - CPOOL(NB,NZ,NY,NX)=CPOOL(NB,NZ,NY,NX)-XFRC - CPOLNB(NB,NZ,NY,NX)=CPOLNB(NB,NZ,NY,NX)+XFRC - CPOOLT=CPOOL(NB,NZ,NY,NX)+CPOLNB(NB,NZ,NY,NX) - IF(CPOOLT.GT.ZEROP(NZ,NY,NX))THEN - ZPOOLD=(ZPOOL(NB,NZ,NY,NX)*CPOLNB(NB,NZ,NY,NX) - 2-ZPOLNB(NB,NZ,NY,NX)*CPOOL(NB,NZ,NY,NX))/CPOOLT - XFRN=FXRN(INTYP(NZ,NY,NX))*ZPOOLD - PPOOLD=(PPOOL(NB,NZ,NY,NX)*CPOLNB(NB,NZ,NY,NX) - 2-PPOLNB(NB,NZ,NY,NX)*CPOOL(NB,NZ,NY,NX))/CPOOLT - XFRP=FXRN(INTYP(NZ,NY,NX))*PPOOLD - ZPOOL(NB,NZ,NY,NX)=ZPOOL(NB,NZ,NY,NX)-XFRN - PPOOL(NB,NZ,NY,NX)=PPOOL(NB,NZ,NY,NX)-XFRP - ZPOLNB(NB,NZ,NY,NX)=ZPOLNB(NB,NZ,NY,NX)+XFRN - PPOLNB(NB,NZ,NY,NX)=PPOLNB(NB,NZ,NY,NX)+XFRP -C IF((I/10)*10.EQ.I.AND.J.EQ.12.AND.NZ.EQ.4)THEN -C WRITE(*,2121)'NODEX',I,J,NZ,NB,XFRC,XFRN,XFRP -C 3,WTLSB(NB,NZ,NY,NX),WTNDB(NB,NZ,NY,NX),CPOOLT -C 4,CPOLNB(NB,NZ,NY,NX),ZPOLNB(NB,NZ,NY,NX),PPOLNB(NB,NZ,NY,NX) -C 4,CPOOL(NB,NZ,NY,NX),ZPOOL(NB,NZ,NY,NX),PPOOL(NB,NZ,NY,NX) -C ENDIF - ENDIF - ENDIF - ENDIF -C IF((I/10)*10.EQ.I.AND.J.EQ.12.AND.NY.EQ.5)THEN -C WRITE(*,2121)'NODGR',I,J,NZ,NB,RCNDL,RMNDL,RGNDL,RGN2P -C 2,RGN2F,CGNDL,SNCR,GRNDG,ZADDN,PADDN,FSNCN -C 8,RDNDLC,RDNDLN,RDNDLP,RCCC,RCCN,RCCP,TFN5 -C 3,WTNDB(NB,NZ,NY,NX),WTNDBN(NB,NZ,NY,NX),WTNDBP(NB,NZ,NY,NX) -C 4,CPOLNB(NB,NZ,NY,NX),ZPOLNB(NB,NZ,NY,NX),PPOLNB(NB,NZ,NY,NX) -C 5,CCPOLN,CZPOLN,TFN3(NZ,NY,NX),CNF,FCNPF,WFNG -C 6,CPOLNB(NB,NZ,NY,NX)*(1.0-DMND(NZ,NY,NX)) -C 6,VMXO*WTNDB(NB,NZ,NY,NX)*CCPOLN/(CCPOLN+CCNKM) -2121 FORMAT(A8,4I4,60E12.4) -C ENDIF - ENDIF - ENDIF - - -105 CONTINUE -C -C ROOT GROWTH -C - NIX(NZ,NY,NX)=NG(NZ,NY,NX) - IDTHRN=0 -C -C FOR ROOTS (N=1) AND MYCORRHIZAE (N=2) IN EACH SOIL LAYER -C - DO 4990 N=1,MY(NZ,NY,NX) - DO 4990 L=NU(NY,NX),NI(NZ,NY,NX) -C -C RESPIRATION FROM NUTRIENT UPTAKE CALCULATED IN 'UPTAKE': -C ACTUAL, O2-UNLIMITED AND C-UNLIMITED -C - CUPRL=0.86*(RUPNH4(N,L,NZ,NY,NX)+RUPNHB(N,L,NZ,NY,NX) - 2+RUPNO3(N,L,NZ,NY,NX)+RUPNOB(N,L,NZ,NY,NX)+RUPH2P(N,L,NZ,NY,NX) - 3+RUPH2B(N,L,NZ,NY,NX)) - CUPRO=0.86*(RUONH4(N,L,NZ,NY,NX)+RUONHB(N,L,NZ,NY,NX) - 2+RUONO3(N,L,NZ,NY,NX)+RUONOB(N,L,NZ,NY,NX)+RUOH2P(N,L,NZ,NY,NX) - 3+RUOH2B(N,L,NZ,NY,NX)) - CUPRC=0.86*(RUCNH4(N,L,NZ,NY,NX)+RUCNHB(N,L,NZ,NY,NX) - 2+RUCNO3(N,L,NZ,NY,NX)+RUCNOB(N,L,NZ,NY,NX)+RUCH2P(N,L,NZ,NY,NX) - 3+RUCH2B(N,L,NZ,NY,NX)) -C -C ACCUMULATE RESPIRATION IN FLUX ARRAYS -C - RCO2M(N,L,NZ,NY,NX)=RCO2M(N,L,NZ,NY,NX)+CUPRO - RCO2N(N,L,NZ,NY,NX)=RCO2N(N,L,NZ,NY,NX)+CUPRC - RCO2A(N,L,NZ,NY,NX)=RCO2A(N,L,NZ,NY,NX)-CUPRL - CPOOLR(N,L,NZ,NY,NX)=CPOOLR(N,L,NZ,NY,NX)-CUPRL -C -C EXUDATION AND UPTAKE OF C, N AND P TO/FROM SOIL AND ROOT -C OR MYCORRHIZAL NON-STRUCTURAL C,N,P POOLS -C - CPOOLR(N,L,NZ,NY,NX)=CPOOLR(N,L,NZ,NY,NX)+RDFOMC(N,L,NZ,NY,NX) - ZPOOLR(N,L,NZ,NY,NX)=ZPOOLR(N,L,NZ,NY,NX)+RDFOMN(N,L,NZ,NY,NX) - 2+RUPNH4(N,L,NZ,NY,NX)+RUPNHB(N,L,NZ,NY,NX)+RUPNO3(N,L,NZ,NY,NX) - 2+RUPNOB(N,L,NZ,NY,NX) - PPOOLR(N,L,NZ,NY,NX)=PPOOLR(N,L,NZ,NY,NX)+RDFOMP(N,L,NZ,NY,NX) - 2+RUPH2P(N,L,NZ,NY,NX)+RUPH2B(N,L,NZ,NY,NX) -C IF(L.EQ.1)THEN -C WRITE(*,9881)'CUPNH4',I,J,NZ,L,N,CPOOLR(N,L,NZ,NY,NX) -C 2,ZPOOLR(N,L,NZ,NY,NX),PPOOLR(N,L,NZ,NY,NX),CUPRL -C 2,RDFOMC(N,L,NZ,NY,NX),RDFOMN(N,L,NZ,NY,NX),RDFOMP(N,L,NZ,NY,NX) -C 2,RUPNH4(N,L,NZ,NY,NX),RUPNHB(N,L,NZ,NY,NX),RUPNO3(N,L,NZ,NY,NX) -C 2,RUPNOB(N,L,NZ,NY,NX),RUPH2P(N,L,NZ,NY,NX),RUPH2B(N,L,NZ,NY,NX) -C 3,WFR(N,L,NZ,NY,NX) -9881 FORMAT(A8,5I4,30E24.16) -C ENDIF -C -C GROWTH OF EACH ROOT AXIS -C - DO 4985 NR=1,NRT(NZ,NY,NX) -C -C PRIMARY ROOT SINK STRENGTH FROM ROOT RADIUS AND ROOT DEPTH -C - IF(N.EQ.1)THEN - 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 - RTNT(N)=RTNT(N)+RTSK1(N,L,NR) - RLNT(N,L)=RLNT(N,L)+RTSK1(N,L,NR) - ENDIF - ENDIF - ENDIF -C -C SECONDARY ROOT SINK STRENGTH FROM ROOT RADIUS, ROOT AXIS NUMBER, -C AND ROOT LENGTH IN SERIES WITH PRIMARY ROOT SINK STRENGTH -C - IF(N.EQ.1)THEN - RTDPL(NR,L)=AMAX1(0.0,RTDP1(1,NR,NZ,NY,NX)-CDPTHZ(L-1,NY,NX) - 2-RTDPX) - RTDPL(NR,L)=AMAX1(0.0,AMIN1(DLYR(3,L,NY,NX),RTDPL(NR,L)) - 2-AMAX1(0.0,SDPTH(NZ,NY,NX)-CDPTHZ(L-1,NY,NX)-HTCTL(NZ,NY,NX))) - RTDPS=AMAX1(SDPTH(NZ,NY,NX),CDPTHZ(L-1,NY,NX)) - 2+0.5*RTDPL(NR,L)+HTSTZ(NZ,NY,NX) - IF(RTDPS.GT.ZERO)THEN - RTSKP=XRTN1*RRAD1(N,L,NZ,NY,NX)**2/RTDPS - RTSKS=RTN2(N,L,NR,NZ,NY,NX)*RRAD2(N,L,NZ,NY,NX)**2 - 2/RTLGA(N,L,NZ,NY,NX) - IF(RTSKP+RTSKS.GT.ZEROP(NZ,NY,NX))THEN - RTSK2(N,L,NR)=RTSKP*RTSKS/(RTSKP+RTSKS) - ELSE - RTSK2(N,L,NR)=0.0 - ENDIF - ELSE - RTSK2(N,L,NR)=0.0 - ENDIF - ELSE - RTSK2(N,L,NR)=RTN2(N,L,NR,NZ,NY,NX)*RRAD2(N,L,NZ,NY,NX)**2 - 2/RTLGA(N,L,NZ,NY,NX) - ENDIF - RTNT(N)=RTNT(N)+RTSK2(N,L,NR) - RLNT(N,L)=RLNT(N,L)+RTSK2(N,L,NR) -C IF(NZ.EQ.3)THEN -C WRITE(*,3341)'SINK',I,J,NX,NY,NZ,L,NR,N -C 2,RTSK1(N,L,NR),RTSK2(N,L,NR),RLNT(N,L),RTNT(N) -C 3,XRTN1,PP(NZ,NY,NX),RRAD1(N,L,NZ,NY,NX),RTDPP -C 4,RTN2(N,L,NR,NZ,NY,NX),RRAD2(N,L,NZ,NY,NX) -C 2,RTLGA(N,L,NZ,NY,NX) -3341 FORMAT(A8,8I4,20E12.4) -C ENDIF -4985 CONTINUE -4990 CONTINUE -C -C RESPIRATION AND GROWTH OF ROOT, MYCORRHIZAE IN EACH LAYER -C - DO 5010 N=1,MY(NZ,NY,NX) - DO 5000 L=NU(NY,NX),NI(NZ,NY,NX) -C -C WATER STRESS CONSTRAINT ON SECONDARY ROOT EXTENSION IMPOSED -C BY ROOT TURGOR AND SOIL PENETRATION RESISTANCE -C - RSCS2=RSCS(L,NY,NX)*RRAD2(N,L,NZ,NY,NX)/1.0E-03 - WFNR=AMIN1(1.0,AMAX1(0.0,PSIRG(N,L,NZ,NY,NX)-PSILM-RSCS2)) - WFNRG=WFNR**0.25 - WFNGR(N,L)=EXP(0.10*PSIRT(N,L,NZ,NY,NX)) - DMRTD=1.0-DMRT(NZ,NY,NX) - RTLGL=0.0 - RTLGZ=0.0 - WTRTX=0.0 - WTRTZ=0.0 -C -C FOR EACH ROOT AXIS -C - DO 5050 NR=1,NRT(NZ,NY,NX) -C -C SECONDARY ROOT EXTENSION -C - IF(L.LE.NINR(NR,NZ,NY,NX).AND.NRX(N,NR).EQ.0)THEN -C -C FRACTION OF SECONDARY ROOT SINK IN SOIL LAYER ATTRIBUTED -C TO CURRENT AXIS -C - IF(RLNT(N,L).GT.ZEROP(NZ,NY,NX))THEN - FRTN=RTSK2(N,L,NR)/RLNT(N,L) - ELSE - FRTN=1.0 - ENDIF -C -C N,P CONSTRAINT ON SECONDARY ROOT RESPIRATION FROM -C NON-STRUCTURAL C:N:P -C - IF(CCPOLR(N,L,NZ,NY,NX).GT.ZERO)THEN - CNPG=AMIN1(CZPOLR(N,L,NZ,NY,NX)/(CZPOLR(N,L,NZ,NY,NX) - 2+CCPOLR(N,L,NZ,NY,NX)/CNKI),CPPOLR(N,L,NZ,NY,NX) - 3/(CPPOLR(N,L,NZ,NY,NX)+CCPOLR(N,L,NZ,NY,NX)/CPKI)) - ELSE - CNPG=1.0 - ENDIF -C -C O2-UNLIMITED SECONDARY ROOT RESPIRATION FROM NON-STRUCTURAL C -C CONSTRAINED BY TEMPERATURE AND NON-STRUCTURAL C:N:P -C - RCO2RM=AMAX1(0.0,VMXC*FRTN*CPOOLR(N,L,NZ,NY,NX) - 2*TFN4(L,NZ,NY,NX))*CNPG*FDBKX(NB1(NZ,NY,NX),NZ,NY,NX) - 3*WFNGR(N,L) -C -C O2-LIMITED SECONDARY ROOT RESPIRATION FROM 'WFR' IN 'UPTAKE' -C - RCO2R=RCO2RM*WFR(N,L,NZ,NY,NX) -C -C SECONDARY ROOT MAINTENANCE RESPIRATION FROM SOIL TEMPERATURE, -C ROOT STRUCTURAL N -C - RMNCR=AMAX1(0.0,RMPLT*WTRT2N(N,L,NR,NZ,NY,NX))*TFN6(L) - IF(IWTYP(NZ,NY,NX).EQ.2)THEN - RMNCR=RMNCR*WFNGR(N,L) - ENDIF - RCO2XM=RCO2RM-RMNCR - RCO2X=RCO2R-RMNCR - RCO2YM=AMAX1(0.0,RCO2XM)*WFNRG - RCO2Y=AMAX1(0.0,RCO2X)*WFNRG -C -C SECONDARY ROOT GROWTH RESPIRATION MAY BE LIMITED BY -C NON-STRUCTURAL N,P AVAILABLE FOR GROWTH -C - DMRTR=DMRTD*FRTN - ZPOOLB=AMAX1(0.0,ZPOOLR(N,L,NZ,NY,NX)) - PPOOLB=AMAX1(0.0,PPOOLR(N,L,NZ,NY,NX)) - FNP=AMIN1(ZPOOLB*DMRTR/CNRTS(NZ,NY,NX) - 2,PPOOLB*DMRTR/CPRTS(NZ,NY,NX)) - IF(RCO2YM.GT.0.0)THEN - RCO2GM=AMIN1(RCO2YM,FNP) - ELSE - RCO2GM=0.0 - ENDIF - IF(RCO2Y.GT.0.0)THEN - RCO2G=AMIN1(RCO2Y,FNP*WFR(N,L,NZ,NY,NX)) - ELSE - RCO2G=0.0 - ENDIF -C -C TOTAL NON-STRUCTURAL C,N,P USED IN SECONDARY ROOT GROWTH -C AND GROWTH RESPIRATION DEPENDS ON GROWTH YIELD ENTERED IN 'READQ' -C - CGRORM=RCO2GM/DMRTD - CGROR=RCO2G/DMRTD - GRTWGM=CGRORM*DMRT(NZ,NY,NX) - GRTWTG=CGROR*DMRT(NZ,NY,NX) - ZADD2M=AMAX1(0.0,GRTWGM*CNRTW) - ZADD2=AMAX1(0.0,AMIN1(FRTN*ZPOOLR(N,L,NZ,NY,NX),GRTWTG*CNRTW)) - PADD2=AMAX1(0.0,AMIN1(FRTN*PPOOLR(N,L,NZ,NY,NX),GRTWTG*CPRTW)) - CNRDM=AMAX1(0.0,1.70*ZADD2M) - CNRDA=AMAX1(0.0,1.70*ZADD2) -C -C SECONDARY ROOT GROWTH RESPIRATION FROM TOTAL - MAINTENANCE -C IF > 0 DRIVES GROWTH, IF < 0 DRIVES REMOBILIZATION, ALSO -C SECONDARY ROOT C LOSS FROM REMOBILIZATION AND CONSEQUENT LITTERFALL -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) - 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) - ELSE - CCC=0.0 - CNC=0.0 - CPC=0.0 - ENDIF - RCCC=RCCZ(IBTYP(NZ,NY,NX))+CCC*RCCY(IBTYP(NZ,NY,NX)) - RCCN=CNC*RCCX(IGTYP(NZ,NY,NX)) - RCCP=CPC*RCCQ(IGTYP(NZ,NY,NX)) - IF(-RCO2XM.GT.0.0)THEN - IF(-RCO2XM.LT.WTRT2(N,L,NR,NZ,NY,NX)*RCCC)THEN - SNCRM=-RCO2XM - ELSE - SNCRM=AMAX1(0.0,WTRT2(N,L,NR,NZ,NY,NX)*RCCC) - ENDIF - ELSE - SNCRM=0.0 - ENDIF - IF(-RCO2X.GT.0.0)THEN - IF(-RCO2X.LT.WTRT2(N,L,NR,NZ,NY,NX)*RCCC)THEN - SNCR=-RCO2X - ELSE - SNCR=AMAX1(0.0,WTRT2(N,L,NR,NZ,NY,NX)*RCCC) - 2*WFR(N,L,NZ,NY,NX) - ENDIF - ELSE - SNCR=0.0 - ENDIF -C -C RECOVERY OF REMOBILIZABLE N,P FROM SECONDARY ROOT DURING -C REMOBILIZATION DEPENDS ON ROOT NON-STRUCTURAL C:N:P -C - IF(SNCR.GT.0.0.AND.WTRT2(N,L,NR,NZ,NY,NX) - 2.GT.ZEROP(NZ,NY,NX))THEN - RCCR=RCCC*WTRT2(N,L,NR,NZ,NY,NX) - RCZR=WTRT2N(N,L,NR,NZ,NY,NX)*(RCCN+(1.0-RCCN) - 2*RCCR/WTRT2(N,L,NR,NZ,NY,NX)) - RCPR=WTRT2P(N,L,NR,NZ,NY,NX)*(RCCP+(1.0-RCCP) - 2*RCCR/WTRT2(N,L,NR,NZ,NY,NX)) - IF(RCCR.GT.ZEROP(NZ,NY,NX))THEN - FSNC2=AMAX1(0.0,AMIN1(1.0,SNCR/RCCR)) - ELSE - FSNC2=1.0 - ENDIF - ELSE - RCCR=0.0 - RCZR=0.0 - RCPR=0.0 - FSNC2=0.0 - ENDIF -C -C SECONDARY ROOT LITTERFALL CAUSED BY REMOBILIZATION -C - DO 6350 M=1,4 - CSNC(M,0,L,NZ,NY,NX)=CSNC(M,0,L,NZ,NY,NX)+CFOPC(5,M,NZ,NY,NX) - 2*FSNC2*(WTRT2(N,L,NR,NZ,NY,NX)-RCCR)*FWOOD(0) - ZSNC(M,0,L,NZ,NY,NX)=ZSNC(M,0,L,NZ,NY,NX)+CFOPN(5,M,NZ,NY,NX) - 2*FSNC2*(WTRT2N(N,L,NR,NZ,NY,NX)-RCZR)*FWOODN(0) - PSNC(M,0,L,NZ,NY,NX)=PSNC(M,0,L,NZ,NY,NX)+CFOPP(5,M,NZ,NY,NX) - 2*FSNC2*(WTRT2P(N,L,NR,NZ,NY,NX)-RCPR)*FWOODP(0) - CSNC(M,1,L,NZ,NY,NX)=CSNC(M,1,L,NZ,NY,NX)+CFOPC(4,M,NZ,NY,NX) - 2*FSNC2*(WTRT2(N,L,NR,NZ,NY,NX)-RCCR)*FWOOD(1) - ZSNC(M,1,L,NZ,NY,NX)=ZSNC(M,1,L,NZ,NY,NX)+CFOPN(4,M,NZ,NY,NX) - 2*FSNC2*(WTRT2N(N,L,NR,NZ,NY,NX)-RCZR)*FWOODN(1) - PSNC(M,1,L,NZ,NY,NX)=PSNC(M,1,L,NZ,NY,NX)+CFOPP(4,M,NZ,NY,NX) - 2*FSNC2*(WTRT2P(N,L,NR,NZ,NY,NX)-RCPR)*FWOODP(1) -6350 CONTINUE -C -C CONSUMPTION OF NON-STRUCTURAL C,N,P BY SECONDARY ROOT -C - CPOOLR(N,L,NZ,NY,NX)=CPOOLR(N,L,NZ,NY,NX)-AMIN1(RMNCR,RCO2R) - 2-CGROR-CNRDA-SNCR+FSNC2*RCCR - ZPOOLR(N,L,NZ,NY,NX)=ZPOOLR(N,L,NZ,NY,NX)-ZADD2+FSNC2*RCZR - PPOOLR(N,L,NZ,NY,NX)=PPOOLR(N,L,NZ,NY,NX)-PADD2+FSNC2*RCPR -C -C TOTAL SECONDARY ROOT RESPIRATION -C - RCO2TM=AMIN1(RMNCR,RCO2RM)+RCO2GM+SNCRM+CNRDM - RCO2T=AMIN1(RMNCR,RCO2R)+RCO2G+SNCR+CNRDA - RCO2M(N,L,NZ,NY,NX)=RCO2M(N,L,NZ,NY,NX)+RCO2TM - RCO2N(N,L,NZ,NY,NX)=RCO2N(N,L,NZ,NY,NX)+RCO2T - RCO2A(N,L,NZ,NY,NX)=RCO2A(N,L,NZ,NY,NX)-RCO2T -C -C SECONDARY ROOT EXTENSION FROM ROOT GROWTH AND ROOT TURGOR -C - GRTLGL=GRTWTG*RTLG2X(N,NZ,NY,NX)*WFNR*FWOOD(1) - 2-FSNC2*RTLG2(N,L,NR,NZ,NY,NX) - GRTWTL=GRTWTG-FSNC2*WTRT2(N,L,NR,NZ,NY,NX) - GRTWTN=ZADD2-FSNC2*WTRT2N(N,L,NR,NZ,NY,NX) - GRTWTP=PADD2-FSNC2*WTRT2P(N,L,NR,NZ,NY,NX) -C -C UPDATE STATE VARIABLES FOR SECONDARY ROOT LENGTH, C, N, P -C AND AXIS NUMBER -C - RTLG2(N,L,NR,NZ,NY,NX)=RTLG2(N,L,NR,NZ,NY,NX)+GRTLGL - WTRT2(N,L,NR,NZ,NY,NX)=WTRT2(N,L,NR,NZ,NY,NX)+GRTWTL - WTRT2N(N,L,NR,NZ,NY,NX)=WTRT2N(N,L,NR,NZ,NY,NX)+GRTWTN - WTRT2P(N,L,NR,NZ,NY,NX)=WTRT2P(N,L,NR,NZ,NY,NX)+GRTWTP - WSRTL(N,L,NZ,NY,NX)=WSRTL(N,L,NZ,NY,NX) - 2+AMIN1(CNWS(NZ,NY,NX)*WTRT2N(N,L,NR,NZ,NY,NX) - 2,CPWS(NZ,NY,NX)*WTRT2P(N,L,NR,NZ,NY,NX)) - RTLGL=RTLGL+RTLG2(N,L,NR,NZ,NY,NX) - WTRTX=WTRTX+WTRT2(N,L,NR,NZ,NY,NX) - RTN2X=RTFQ(NZ,NY,NX)*XRTN1 - RTN2Y=RTFQ(NZ,NY,NX)*RTN2X - RTN2(N,L,NR,NZ,NY,NX)=RTN2X+RTN2Y - RTNL(N,L,NZ,NY,NX)=RTNL(N,L,NZ,NY,NX)+RTN2(N,L,NR,NZ,NY,NX) -C IF(L.EQ.1)THEN -C WRITE(*,9876)'RCO22',I,J,NZ,NR,L,N -C 2,RCO2TM,RCO2T,RMNCR,RCO2RM,RCO2R,RCO2GM,RCO2G -C 3,RCO2XM,RCO2X,CGROR,SNCRM,SNCR,CNRDA,CPOOLR(N,L,NZ,NY,NX),FRTN -C 4,TFN4(L,NZ,NY,NX),CNPG,FDBKX(NB1(NZ,NY,NX),NZ,NY,NX),WFNGR(N,L) -C 5,TFN6(L),GRTWTG,GRTWTL,GRTLGL,RTLG2(N,L,NR,NZ,NY,NX) -C 5,WTRT2(N,L,NR,NZ,NY,NX),RTLG2(N,L,NR,NZ,NY,NX) -C 4,RCO2M(N,L,NZ,NY,NX),RCO2A(N,L,NZ,NY,NX),WFR(N,L,NZ,NY,NX) -C 8,ZPOOLR(N,L,NZ,NY,NX),PPOOLR(N,L,NZ,NY,NX) -C 9,FSNC2,RLNT(N,L),RTSK1(N,L,NR),RTSK2(N,L,NR) -C 4,RTN2X,RTN2Y,XRTN1 -C 5,RTDPL(NR,L),RTDNP(N,L,NZ,NY,NX) -C 5,RTDP1(1,NR,NZ,NY,NX),CDPTHZ(L-1,NY,NX),DLYR(3,L,NY,NX) -C 6,SDPTH(NZ,NY,NX),HTCTL(NZ,NY,NX) -C 5,WFNRG,FNP,RTLGP(N,L,NZ,NY,NX),ZADD2,PADD2,CUPRO,CUPRL -C 7,RUPNH4(N,L,NZ,NY,NX),RUPNHB(N,L,NZ,NY,NX) -C 8,RUPNO3(N,L,NZ,NY,NX),RUPNOB(N,L,NZ,NY,NX) -C 9,RUPH2P(N,L,NZ,NY,NX),RUPH2B(N,L,NZ,NY,NX) -C 6,RDFOMN(N,L,NZ,NY,NX),RDFOMP(N,L,NZ,NY,NX) -C 2,RTN1(N,L,NZ,NY,NX),RTN2(N,L,NR,NZ,NY,NX) -C 3,RTNL(N,L,NZ,NY,NX) -9876 FORMAT(A8,6I4,100E12.4) -C ENDIF -C -C PRIMARY ROOT EXTENSION -C - IF(N.EQ.1)THEN - IF(RTDP1(N,NR,NZ,NY,NX).GT.CDPTHZ(L-1,NY,NX) - 2.AND.ICHK1(N,NR).EQ.0)THEN - RTN1(N,L,NZ,NY,NX)=RTN1(N,L,NZ,NY,NX)+XRTN1 - IF(RTDP1(N,NR,NZ,NY,NX).LE.CDPTHZ(L,NY,NX))THEN - ICHK1(N,NR)=1 -C -C FRACTION OF PRIMARY ROOT SINK IN SOIL LAYER ATTRIBUTED TO CURRENT AXIS -C - IF(RLNT(N,L).GT.ZEROP(NZ,NY,NX))THEN - FRTN=RTSK1(N,L,NR)/RLNT(N,L) - ELSE - FRTN=1.0 - ENDIF -C -C WATER STRESS CONSTRAINT ON SECONDARY ROOT EXTENSION IMPOSED -C BY ROOT TURGOR AND SOIL PENETRATION RESISTANCE -C - RSCS1=RSCS(L,NY,NX)*RRAD1(N,L,NZ,NY,NX)/1.0E-03 - WFNR=AMIN1(1.0,AMAX1(0.0,PSIRG(N,L,NZ,NY,NX)-PSILM-RSCS1)) - WFNRG=WFNR**0.25 -C -C N,P CONSTRAINT ON PRIMARY ROOT RESPIRATION FROM -C NON-STRUCTURAL C:N:P -C - IF(CCPOLR(N,L,NZ,NY,NX).GT.ZERO)THEN - CNPG=AMIN1(CZPOLR(N,L,NZ,NY,NX)/(CZPOLR(N,L,NZ,NY,NX) - 2+CCPOLR(N,L,NZ,NY,NX)/CNKI),CPPOLR(N,L,NZ,NY,NX) - 3/(CPPOLR(N,L,NZ,NY,NX)+CCPOLR(N,L,NZ,NY,NX)/CPKI)) - ELSE - CNPG=1.0 - ENDIF -C -C O2-UNLIMITED PRIMARY ROOT RESPIRATION FROM ROOT NON-STRUCTURAL C -C CONSTRAINED BY TEMPERATURE AND NON-STRUCTURAL C:N:P -C - RCO2RM=AMAX1(0.0,VMXC*FRTN*CPOOLR(N,L,NZ,NY,NX) - 2*TFN4(L,NZ,NY,NX))*CNPG*FDBKX(NB1(NZ,NY,NX),NZ,NY,NX) - 3*WFNGR(N,L) -C -C O2-LIMITED PRIMARY ROOT RESPIRATION FROM 'WFR' IN 'UPTAKE' -C - RCO2R=RCO2RM*WFR(N,L,NZ,NY,NX) -C -C PRIMARY ROOT MAINTENANCE RESPIRATION FROM SOIL TEMPERATURE, -C ROOT STRUCTURAL N -C - RMNCR=AMAX1(0.0,RMPLT*RTWT1N(N,NR,NZ,NY,NX))*TFN6(L) - IF(IWTYP(NZ,NY,NX).EQ.2)THEN - RMNCR=RMNCR*WFNGR(N,L) - ENDIF - RCO2XM=RCO2RM-RMNCR - RCO2X=RCO2R-RMNCR - RCO2YM=AMAX1(0.0,RCO2XM)*WFNRG - RCO2Y=AMAX1(0.0,RCO2X)*WFNRG -C -C PRIMARY ROOT GROWTH RESPIRATION MAY BE LIMITED BY -C NON-STRUCTURAL N,P AVAILABLE FOR GROWTH -C - DMRTR=DMRTD*FRTN - ZPOOLB=AMAX1(0.0,ZPOOLR(N,L,NZ,NY,NX)) - PPOOLB=AMAX1(0.0,PPOOLR(N,L,NZ,NY,NX)) - FNP=AMIN1(ZPOOLB*DMRTR/CNRTS(NZ,NY,NX) - 2,PPOOLB*DMRTR/CPRTS(NZ,NY,NX)) - IF(RCO2YM.GT.0.0)THEN - RCO2GM=AMIN1(RCO2YM,FNP) - ELSE - RCO2GM=0.0 - ENDIF - IF(RCO2Y.GT.0.0)THEN - RCO2G=AMIN1(RCO2Y,FNP*WFR(N,L,NZ,NY,NX)) - ELSE - RCO2G=0.0 - ENDIF -C -C TOTAL NON-STRUCTURAL C,N,P USED IN PRIMARY ROOT GROWTH -C AND GROWTH RESPIRATION DEPENDS ON GROWTH YIELD -C ENTERED IN 'READQ' -C - CGRORM=RCO2GM/DMRTD - CGROR=RCO2G/DMRTD - GRTWGM=CGRORM*DMRT(NZ,NY,NX) - GRTWTG=CGROR*DMRT(NZ,NY,NX) - ZADD1M=AMAX1(0.0,GRTWGM*CNRTW) - ZADD1=AMAX1(0.0,AMIN1(FRTN*ZPOOLR(N,L,NZ,NY,NX),GRTWTG*CNRTW)) - PADD1=AMAX1(0.0,AMIN1(FRTN*PPOOLR(N,L,NZ,NY,NX),GRTWTG*CPRTW)) - CNRDM=AMAX1(0.0,1.70*ZADD1M) - CNRDA=AMAX1(0.0,1.70*ZADD1) -C -C PRIMARY ROOT GROWTH RESPIRATION FROM TOTAL - MAINTENANCE -C IF > 0 DRIVES GROWTH, IF < 0 DRIVES REMOBILIZATION, ALSO -C PRIMARY ROOT C LOSS FROM REMOBILIZATION AND CONSEQUENT LITTERFALL -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) - 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) - ELSE - CCC=0.0 - CNC=0.0 - CPC=0.0 - ENDIF - RCCC=RCCZ(IBTYP(NZ,NY,NX))+CCC*RCCY(IBTYP(NZ,NY,NX)) - RCCN=CNC*RCCX(IGTYP(NZ,NY,NX)) - RCCP=CPC*RCCQ(IGTYP(NZ,NY,NX)) - IF(-RCO2XM.GT.0.0)THEN - IF(-RCO2XM.LT.RTWT1(N,NR,NZ,NY,NX)*RCCC)THEN - SNCRM=-RCO2XM - ELSE - SNCRM=AMAX1(0.0,RTWT1(N,NR,NZ,NY,NX)*RCCC) - ENDIF - ELSE - SNCRM=0.0 - ENDIF - IF(-RCO2X.GT.0.0)THEN - IF(-RCO2X.LT.RTWT1(N,NR,NZ,NY,NX)*RCCC)THEN - SNCR=-RCO2X - ELSE - SNCR=AMAX1(0.0,RTWT1(N,NR,NZ,NY,NX)*RCCC) - 2*WFR(N,L,NZ,NY,NX) - ENDIF - ELSE - SNCR=0.0 - ENDIF -C -C RECOVERY OF REMOBILIZABLE N,P DURING PRIMARY ROOT REMOBILIZATION -C DEPENDS ON ROOT NON-STRUCTURAL C:N:P -C - IF(SNCR.GT.0.0.AND.RTWT1(N,NR,NZ,NY,NX) - 2.GT.ZEROP(NZ,NY,NX))THEN - RCCR=RCCC*RTWT1(N,NR,NZ,NY,NX) - RCZR=RTWT1N(N,NR,NZ,NY,NX)*(RCCN+(1.0-RCCN) - 2*RCCR/RTWT1(N,NR,NZ,NY,NX)) - RCPR=RTWT1P(N,NR,NZ,NY,NX)*(RCCP+(1.0-RCCP) - 2*RCCR/RTWT1(N,NR,NZ,NY,NX)) - IF(RCCR.GT.ZEROP(NZ,NY,NX))THEN - FSNC1=AMAX1(0.0,AMIN1(1.0,SNCR/RCCR)) - ELSE - FSNC1=1.0 - ENDIF - ELSE - RCCR=0.0 - RCZR=0.0 - RCPR=0.0 - FSNC1=0.0 - ENDIF -C -C PRIMARY ROOT LITTERFALL CAUSED BY REMOBILIZATION -C - DO 6355 M=1,4 - CSNC(M,0,L,NZ,NY,NX)=CSNC(M,0,L,NZ,NY,NX)+CFOPC(5,M,NZ,NY,NX) - 2*FSNC1*(RTWT1(N,NR,NZ,NY,NX)-RCCR)*FWOOD(0) - ZSNC(M,0,L,NZ,NY,NX)=ZSNC(M,0,L,NZ,NY,NX)+CFOPN(5,M,NZ,NY,NX) - 2*FSNC1*(RTWT1N(N,NR,NZ,NY,NX)-RCZR)*FWOODN(0) - PSNC(M,0,L,NZ,NY,NX)=PSNC(M,0,L,NZ,NY,NX)+CFOPP(5,M,NZ,NY,NX) - 2*FSNC1*(RTWT1P(N,NR,NZ,NY,NX)-RCPR)*FWOODP(0) - CSNC(M,1,L,NZ,NY,NX)=CSNC(M,1,L,NZ,NY,NX)+CFOPC(4,M,NZ,NY,NX) - 2*FSNC1*(RTWT1(N,NR,NZ,NY,NX)-RCCR)*FWOOD(1) - ZSNC(M,1,L,NZ,NY,NX)=ZSNC(M,1,L,NZ,NY,NX)+CFOPN(4,M,NZ,NY,NX) - 2*FSNC1*(RTWT1N(N,NR,NZ,NY,NX)-RCZR)*FWOODN(1) - PSNC(M,1,L,NZ,NY,NX)=PSNC(M,1,L,NZ,NY,NX)+CFOPP(4,M,NZ,NY,NX) - 2*FSNC1*(RTWT1P(N,NR,NZ,NY,NX)-RCPR)*FWOODP(1) -6355 CONTINUE -C -C CONSUMPTION OF NON-STRUCTURAL C,N,P BY PRIMARY ROOTS -C - CPOOLR(N,L,NZ,NY,NX)=CPOOLR(N,L,NZ,NY,NX)-AMIN1(RMNCR,RCO2R) - 2-CGROR-CNRDA-SNCR+FSNC1*RCCR - ZPOOLR(N,L,NZ,NY,NX)=ZPOOLR(N,L,NZ,NY,NX)-ZADD1+FSNC1*RCZR - PPOOLR(N,L,NZ,NY,NX)=PPOOLR(N,L,NZ,NY,NX)-PADD1+FSNC1*RCPR -C -C TOTAL PRIMARY ROOT RESPIRATION -C - RCO2TM=AMIN1(RMNCR,RCO2RM)+RCO2GM+SNCRM+CNRDM - RCO2T=AMIN1(RMNCR,RCO2R)+RCO2G+SNCR+CNRDA -C -C ALLOCATE PRIMARY ROOT TOTAL RESPIRATION TO ALL SOIL LAYERS -C THROUGH WHICH PRIMARY ROOTS GROW -C - IF(RTDP1(N,NR,NZ,NY,NX).GT.CDPTHZ(NG(NZ,NY,NX),NY,NX))THEN - DO 5100 LL=NG(NZ,NY,NX),NINR(NR,NZ,NY,NX) - FRCO2=RTLG1(N,LL,NR,NZ,NY,NX)/(RTDP1(N,NR,NZ,NY,NX) - 2-SDPTH(NZ,NY,NX)) - RCO2M(N,LL,NZ,NY,NX)=RCO2M(N,LL,NZ,NY,NX)+RCO2TM*FRCO2 - RCO2N(N,LL,NZ,NY,NX)=RCO2N(N,LL,NZ,NY,NX)+RCO2T*FRCO2 - RCO2A(N,LL,NZ,NY,NX)=RCO2A(N,LL,NZ,NY,NX)-RCO2T*FRCO2 -5100 CONTINUE - ELSE - RCO2M(N,L,NZ,NY,NX)=RCO2M(N,L,NZ,NY,NX)+RCO2TM - RCO2N(N,L,NZ,NY,NX)=RCO2N(N,L,NZ,NY,NX)+RCO2T - RCO2A(N,L,NZ,NY,NX)=RCO2A(N,L,NZ,NY,NX)-RCO2T - ENDIF -C -C ALLOCATE ANY NEGATIVE PRIMARY ROOT C,N,P GROWTH TO SECONDARY -C ROOTS ON THE SAME AXIS IN THE SAME LAYER UNTIL SECONDARY ROOTS -C HAVE DISAPPEARED -C - GRTWTL=GRTWTG-FSNC1*RTWT1(N,NR,NZ,NY,NX) - GRTWTN=ZADD1-FSNC1*RTWT1N(N,NR,NZ,NY,NX) - GRTWTP=PADD1-FSNC1*RTWT1P(N,NR,NZ,NY,NX) - IF(GRTWTL.LT.0.0)THEN - LX=MAX(1,L-1) - DO 5105 LL=L,LX,-1 - GRTWTM=GRTWTL - IF(GRTWTL.LT.0.0)THEN - IF(GRTWTL.GT.-WTRT2(N,LL,NR,NZ,NY,NX))THEN - RTLG2(N,LL,NR,NZ,NY,NX)=RTLG2(N,LL,NR,NZ,NY,NX)+GRTWTL - 2*RTLG2(N,LL,NR,NZ,NY,NX)/WTRT2(N,LL,NR,NZ,NY,NX) - WTRT2(N,LL,NR,NZ,NY,NX)=WTRT2(N,LL,NR,NZ,NY,NX)+GRTWTL - GRTWTL=0.0 - ELSE - GRTWTL=GRTWTL+WTRT2(N,LL,NR,NZ,NY,NX) - RTLG2(N,LL,NR,NZ,NY,NX)=0.0 - WTRT2(N,LL,NR,NZ,NY,NX)=0.0 - ENDIF - ENDIF - IF(GRTWTN.LT.0.0)THEN - IF(GRTWTN.GT.-WTRT2N(N,LL,NR,NZ,NY,NX))THEN - WTRT2N(N,LL,NR,NZ,NY,NX)=WTRT2N(N,LL,NR,NZ,NY,NX)+GRTWTN - GRTWTN=0.0 - ELSE - GRTWTN=GRTWTN+WTRT2N(N,LL,NR,NZ,NY,NX) - WTRT2N(N,LL,NR,NZ,NY,NX)=0.0 - ENDIF - ENDIF - IF(GRTWTP.LT.0.0)THEN - IF(GRTWTP.GT.-WTRT2P(N,LL,NR,NZ,NY,NX))THEN - WTRT2P(N,LL,NR,NZ,NY,NX)=WTRT2P(N,LL,NR,NZ,NY,NX)+GRTWTP - GRTWTP=0.0 - ELSE - GRTWTP=GRTWTP+WTRT2P(N,LL,NR,NZ,NY,NX) - WTRT2P(N,LL,NR,NZ,NY,NX)=0.0 - ENDIF - ENDIF -C WRITE(*,9876)'WTRT2',I,J,NZ,NR,LL,N -C 2,GRTWTL,GRTWTM,GRTWTG,FSNC1,SNCR,RCCR,RTWT1(N,NR,NZ,NY,NX) -C 3,WTRT2(1,LL,NR,NZ,NY,NX),WTRTL(1,LL,NZ,NY,NX) -C 3,WTRT2(2,LL,NR,NZ,NY,NX),WTRTL(2,LL,NZ,NY,NX) -C 4,RTLG2(1,LL,NR,NZ,NY,NX),RTLG1(1,LL,NR,NZ,NY,NX) -C 4,RTLG2(2,LL,NR,NZ,NY,NX),RTLG1(2,LL,NR,NZ,NY,NX) -C -C CONCURRENT LOSS OF MYCORRHIZAE AND NODULES -C - IF(GRTWTM.LT.0.0)THEN - IF(WTRT2(1,LL,NR,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - FSNCM=AMIN1(1.0,ABS(GRTWTM)/WTRT2(1,LL,NR,NZ,NY,NX)) - ELSE - FSNCM=1.0 - ENDIF - IF(WTRTL(1,LL,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - FSNCP=AMIN1(1.0,ABS(GRTWTM)/WTRTL(1,LL,NZ,NY,NX)) - ELSE - FSNCP=1.0 - ENDIF - DO 6450 M=1,4 - CSNC(M,0,LL,NZ,NY,NX)=CSNC(M,0,LL,NZ,NY,NX)+CFOPC(5,M,NZ,NY,NX) - 2*FSNCM*AMAX1(0.0,WTRT2(2,LL,NR,NZ,NY,NX))*FWOOD(0) - ZSNC(M,0,LL,NZ,NY,NX)=ZSNC(M,0,LL,NZ,NY,NX)+CFOPN(5,M,NZ,NY,NX) - 2*FSNCM*AMAX1(0.0,WTRT2N(2,LL,NR,NZ,NY,NX))*FWOODN(0) - PSNC(M,0,LL,NZ,NY,NX)=PSNC(M,0,LL,NZ,NY,NX)+CFOPP(5,M,NZ,NY,NX) - 2*FSNCM*AMAX1(0.0,WTRT2P(2,LL,NR,NZ,NY,NX))*FWOODP(0) - CSNC(M,1,LL,NZ,NY,NX)=CSNC(M,1,LL,NZ,NY,NX)+CFOPC(4,M,NZ,NY,NX) - 2*FSNCM*AMAX1(0.0,WTRT2(2,LL,NR,NZ,NY,NX))*FWOOD(1) - ZSNC(M,1,LL,NZ,NY,NX)=ZSNC(M,1,LL,NZ,NY,NX)+CFOPN(4,M,NZ,NY,NX) - 2*FSNCM*AMAX1(0.0,WTRT2N(2,LL,NR,NZ,NY,NX))*FWOODN(1) - PSNC(M,1,LL,NZ,NY,NX)=PSNC(M,1,LL,NZ,NY,NX)+CFOPP(4,M,NZ,NY,NX) - 2*FSNCM*AMAX1(0.0,WTRT2P(2,LL,NR,NZ,NY,NX))*FWOODP(1) - CSNC(M,1,LL,NZ,NY,NX)=CSNC(M,1,LL,NZ,NY,NX)+CFOPC(0,M,NZ,NY,NX) - 2*FSNCP*AMAX1(0.0,CPOOLR(2,LL,NZ,NY,NX)) - ZSNC(M,1,LL,NZ,NY,NX)=ZSNC(M,1,LL,NZ,NY,NX)+CFOPN(0,M,NZ,NY,NX) - 2*FSNCP*AMAX1(0.0,ZPOOLR(2,LL,NZ,NY,NX)) - PSNC(M,1,LL,NZ,NY,NX)=PSNC(M,1,LL,NZ,NY,NX)+CFOPP(0,M,NZ,NY,NX) - 2*FSNCP*AMAX1(0.0,PPOOLR(2,LL,NZ,NY,NX)) -6450 CONTINUE - RTLG2(2,LL,NR,NZ,NY,NX)=AMAX1(0.0,RTLG2(2,LL,NR,NZ,NY,NX)) - 2*(1.0-FSNCM) - WTRT2(2,LL,NR,NZ,NY,NX)=AMAX1(0.0,WTRT2(2,LL,NR,NZ,NY,NX)) - 2*(1.0-FSNCM) - WTRT2N(2,LL,NR,NZ,NY,NX)=AMAX1(0.0,WTRT2N(2,LL,NR,NZ,NY,NX)) - 2*(1.0-FSNCM) - WTRT2P(2,LL,NR,NZ,NY,NX)=AMAX1(0.0,WTRT2P(2,LL,NR,NZ,NY,NX)) - 2*(1.0-FSNCM) - CPOOLR(2,LL,NZ,NY,NX)=AMAX1(0.0,CPOOLR(2,LL,NZ,NY,NX)) - 2*(1.0-FSNCP) - ZPOOLR(2,LL,NZ,NY,NX)=AMAX1(0.0,ZPOOLR(2,LL,NZ,NY,NX)) - 2*(1.0-FSNCP) - PPOOLR(2,LL,NZ,NY,NX)=AMAX1(0.0,PPOOLR(2,LL,NZ,NY,NX)) - 2*(1.0-FSNCP) - ENDIF -5105 CONTINUE - ENDIF -C -C PRIMARY ROOT EXTENSION FROM ROOT GROWTH AND ROOT TURGOR -C - IF(GRTWTL.LT.0.0.AND.RTWT1(N,NR,NZ,NY,NX) - 2.GT.ZEROP(NZ,NY,NX))THEN - GRTLGL=GRTWTG*RTLG1X(N,NZ,NY,NX)/PP(NZ,NY,NX)*WFNR*FWOOD(1) - 2+GRTWTL*(RTDP1(N,NR,NZ,NY,NX)-SDPTH(NZ,NY,NX)) - 3/RTWT1(N,NR,NZ,NY,NX) - ELSE - GRTLGL=GRTWTG*RTLG1X(N,NZ,NY,NX)/PP(NZ,NY,NX)*WFNR*FWOOD(1) - ENDIF - IF(L.LT.NJ(NY,NX))THEN - GRTLGL=AMIN1(DLYR(3,L+1,NY,NX),GRTLGL) - ENDIF -C -C ALLOCATE PRIMARY ROOT GROWTH TO CURRENT -C AND NEXT SOIL LAYER WHEN PRIMARY ROOTS EXTEND ACROSS LOWER -C BOUNDARY OF CURRENT LAYER -C - IF(GRTLGL.GT.ZEROP(NZ,NY,NX).AND.L.LT.NJ(NY,NX))THEN - FGROL=AMAX1(0.0,AMIN1(1.0,(CDPTHZ(L,NY,NX) - 2-RTDP1(N,NR,NZ,NY,NX))/GRTLGL)) - IF(FGROL.LT.1.0)FGROL=0.0 - FGROZ=AMAX1(0.0,1.0-FGROL) - ELSE - FGROL=1.0 - FGROZ=0.0 - ENDIF -C -C UPDATE STATE VARIABLES FOR PRIMARY ROOT LENGTH, GROWTH -C AND AXIS NUMBER -C - RTWT1(N,NR,NZ,NY,NX)=RTWT1(N,NR,NZ,NY,NX)+GRTWTL - RTWT1N(N,NR,NZ,NY,NX)=RTWT1N(N,NR,NZ,NY,NX)+GRTWTN - RTWT1P(N,NR,NZ,NY,NX)=RTWT1P(N,NR,NZ,NY,NX)+GRTWTP - RTDP1(N,NR,NZ,NY,NX)=RTDP1(N,NR,NZ,NY,NX)+GRTLGL - WTRT1(N,L,NR,NZ,NY,NX)=WTRT1(N,L,NR,NZ,NY,NX)+GRTWTL*FGROL - WTRT1N(N,L,NR,NZ,NY,NX)=WTRT1N(N,L,NR,NZ,NY,NX)+GRTWTN*FGROL - WTRT1P(N,L,NR,NZ,NY,NX)=WTRT1P(N,L,NR,NZ,NY,NX)+GRTWTP*FGROL - WSRTL(N,L,NZ,NY,NX)=WSRTL(N,L,NZ,NY,NX) - 2+AMIN1(CNWS(NZ,NY,NX)*WTRT1N(N,L,NR,NZ,NY,NX) - 2,CPWS(NZ,NY,NX)*WTRT1P(N,L,NR,NZ,NY,NX)) - RTLG1(N,L,NR,NZ,NY,NX)=RTLG1(N,L,NR,NZ,NY,NX)+GRTLGL*FGROL -C -C TRANSFER C,N,P INTO NEXT SOIL LAYER -C WHEN PRIMARY ROOT EXTENDS ACROSS LOWER BOUNDARY -C OF CURRENT SOIL LAYER -C - IF(FGROZ.GT.0.0)THEN - WTRT1(N,L+1,NR,NZ,NY,NX)=WTRT1(N,L+1,NR,NZ,NY,NX) - 2+GRTWTL*FGROZ - WTRT1N(N,L+1,NR,NZ,NY,NX)=WTRT1N(N,L+1,NR,NZ,NY,NX) - 2+GRTWTN*FGROZ - WTRT1P(N,L+1,NR,NZ,NY,NX)=WTRT1P(N,L+1,NR,NZ,NY,NX) - 2+GRTWTP*FGROZ - WSRTL(N,L+1,NZ,NY,NX)=WSRTL(N,L+1,NZ,NY,NX) - 2+AMIN1(CNWS(NZ,NY,NX)*WTRT1N(N,L+1,NR,NZ,NY,NX) - 2,CPWS(NZ,NY,NX)*WTRT1P(N,L+1,NR,NZ,NY,NX)) - WTRTD(N,L+1,NZ,NY,NX)=WTRTD(N,L+1,NZ,NY,NX) - 2+WTRT1(N,L+1,NR,NZ,NY,NX) - RTLG1(N,L+1,NR,NZ,NY,NX)=RTLG1(N,L+1,NR,NZ,NY,NX)+GRTLGL*FGROZ - RRAD1(N,L+1,NZ,NY,NX)=RRAD1(N,L,NZ,NY,NX) - RTLGZ=RTLGZ+RTLG1(N,L+1,NR,NZ,NY,NX) - WTRTZ=WTRTZ+WTRT1(N,L+1,NR,NZ,NY,NX) - XFRC=FRTN*CPOOLR(N,L,NZ,NY,NX) - XFRN=FRTN*ZPOOLR(N,L,NZ,NY,NX) - XFRP=FRTN*PPOOLR(N,L,NZ,NY,NX) - CPOOLR(N,L,NZ,NY,NX)=CPOOLR(N,L,NZ,NY,NX)-XFRC - ZPOOLR(N,L,NZ,NY,NX)=ZPOOLR(N,L,NZ,NY,NX)-XFRN - PPOOLR(N,L,NZ,NY,NX)=PPOOLR(N,L,NZ,NY,NX)-XFRP - CPOOLR(N,L+1,NZ,NY,NX)=CPOOLR(N,L+1,NZ,NY,NX)+XFRC - ZPOOLR(N,L+1,NZ,NY,NX)=ZPOOLR(N,L+1,NZ,NY,NX)+XFRN - PPOOLR(N,L+1,NZ,NY,NX)=PPOOLR(N,L+1,NZ,NY,NX)+XFRP - PSIRT(N,L+1,NZ,NY,NX)=PSIRT(N,L,NZ,NY,NX) - PSIRO(N,L+1,NZ,NY,NX)=PSIRO(N,L,NZ,NY,NX) - PSIRG(N,L+1,NZ,NY,NX)=PSIRG(N,L,NZ,NY,NX) - NINR(NR,NZ,NY,NX)=MAX(NG(NZ,NY,NX),L+1) -C WRITE(*,9877)'INFIL',I,J,NZ,NR,L,N,NINR(NR,NZ,NY,NX) -C 2,FRTN,WTRTD(N,L+1,NZ,NY,NX),CPOOLR(N,L+1,NZ,NY,NX) -C 2,FGROZ,RTDP1(N,NR,NZ,NY,NX),GRTLGL,CDPTHZ(L,NY,NX) - ENDIF -C IF((I/10)*10.EQ.I.AND.J.EQ.14.AND.NZ.EQ.1)THEN -C WRITE(*,9877)'RCO21',I,J,NZ,NR,L,N,NINR(NR,NZ,NY,NX) -C 2,RCO2TM,RCO2T,RMNCR,RCO2RM,RCO2R,RCO2GM,RCO2G -C 3,RCO2XM,RCO2X,CGROR,SNCRM,SNCR,CNRDA,CPOOLR(N,L,NZ,NY,NX),FRTN -C 4,TFN4(L,NZ,NY,NX),CNPG,FDBKX(NB1(NZ,NY,NX),NZ,NY,NX),WFNGR(N,L) -C 5,TFN6(L),GRTWTG,GRTWTL,GRTLGL,RTWT1N(N,NR,NZ,NY,NX) -C 6,WTRT1(N,L,NR,NZ,NY,NX),RTDP1(N,NR,NZ,NY,NX) -C 3,RCO2M(N,L,NZ,NY,NX),RCO2A(N,L,NZ,NY,NX),WFR(N,L,NZ,NY,NX) -C 4,RTSK1(N,L,NR),RRAD1(N,L,NZ,NY,NX),RTDPP -C 5,PSIRG(N,L,NZ,NY,NX),WFNR,WFNRG,FWOOD(1) -C 6,RTDP1(N,NR,NZ,NY,NX),FGROZ,RTWT1(N,NR,NZ,NY,NX),FSNC1 -C 9,ZADD1,PADD1,ZPOOLR(N,L,NZ,NY,NX),PPOOLR(N,L,NZ,NY,NX) -C 1,RUPNH4(N,L,NZ,NY,NX),RUPNO3(N,L,NZ,NY,NX) -9877 FORMAT(A8,7I4,100E12.4) -C ENDIF - ENDIF -C -C TRANSFER PRIMARY ROOT C,N,P TO NEXT SOIL LAYER ABOVE THE -C CURRENT SOIL LAYER WHEN NEGATIVE PRIMARY ROOT GROWTH FORCES -C WITHDRAWAL FROM THE CURRENT SOIL LAYER AND ALL SECONDARY ROOTS -C IN THE CURRENT SOIL LAYER HAVE BEEN LOST -C - IF(L.EQ.NINR(NR,NZ,NY,NX))THEN - DO 5115 LL=L,NG(NZ,NY,NX)+1,-1 - IF(RTDP1(N,NR,NZ,NY,NX).LT.CDPTHZ(LL-1,NY,NX) - 2.OR.RTDP1(N,NR,NZ,NY,NX).LT.SDPTH(NZ,NY,NX))THEN - IF(RLNT(N,LL).GT.ZEROP(NZ,NY,NX))THEN - FRTN=(RTSK1(N,LL,NR)+RTSK2(N,LL,NR))/RLNT(N,LL) - ELSE - FRTN=1.0 - ENDIF - DO 5110 NN=1,MY(NZ,NY,NX) - WTRT1(NN,LL-1,NR,NZ,NY,NX)=WTRT1(NN,LL-1,NR,NZ,NY,NX) - 2+WTRT1(NN,LL,NR,NZ,NY,NX) - WTRT1N(NN,LL-1,NR,NZ,NY,NX)=WTRT1N(NN,LL-1,NR,NZ,NY,NX) - 2+WTRT1N(NN,LL,NR,NZ,NY,NX) - WTRT1P(NN,LL-1,NR,NZ,NY,NX)=WTRT1P(NN,LL-1,NR,NZ,NY,NX) - 2+WTRT1P(NN,LL,NR,NZ,NY,NX) - WTRT2(NN,LL-1,NR,NZ,NY,NX)=WTRT2(NN,LL-1,NR,NZ,NY,NX) - 2+WTRT2(NN,LL,NR,NZ,NY,NX) - WTRT2N(NN,LL-1,NR,NZ,NY,NX)=WTRT2N(NN,LL-1,NR,NZ,NY,NX) - 2+WTRT2N(NN,LL,NR,NZ,NY,NX) - WTRT2P(NN,LL-1,NR,NZ,NY,NX)=WTRT2P(NN,LL-1,NR,NZ,NY,NX) - 2+WTRT2P(NN,LL,NR,NZ,NY,NX) - RTLG1(NN,LL-1,NR,NZ,NY,NX)=RTLG1(NN,LL-1,NR,NZ,NY,NX) - 2+RTLG1(NN,LL,NR,NZ,NY,NX) - WTRT1(NN,LL,NR,NZ,NY,NX)=0.0 - WTRT1N(NN,LL,NR,NZ,NY,NX)=0.0 - WTRT1P(NN,LL,NR,NZ,NY,NX)=0.0 - WTRT2(NN,LL,NR,NZ,NY,NX)=0.0 - WTRT2N(NN,LL,NR,NZ,NY,NX)=0.0 - WTRT2P(NN,LL,NR,NZ,NY,NX)=0.0 - RTLG1(NN,LL,NR,NZ,NY,NX)=0.0 - XFRC=FRTN*CPOOLR(NN,LL,NZ,NY,NX) - XFRN=FRTN*ZPOOLR(NN,LL,NZ,NY,NX) - XFRP=FRTN*PPOOLR(NN,LL,NZ,NY,NX) - XFRW=FRTN*WSRTL(NN,L,NZ,NY,NX) - XFRD=FRTN*WTRTD(NN,LL,NZ,NY,NX) - CPOOLR(NN,LL,NZ,NY,NX)=CPOOLR(NN,LL,NZ,NY,NX)-XFRC - ZPOOLR(NN,LL,NZ,NY,NX)=ZPOOLR(NN,LL,NZ,NY,NX)-XFRN - PPOOLR(NN,LL,NZ,NY,NX)=PPOOLR(NN,LL,NZ,NY,NX)-XFRP - WSRTL(NN,LL,NZ,NY,NX)=WSRTL(NN,LL,NZ,NY,NX)-XFRW - WTRTD(NN,LL,NZ,NY,NX)=WTRTD(NN,LL,NZ,NY,NX)-XFRD - CPOOLR(NN,LL-1,NZ,NY,NX)=CPOOLR(NN,LL-1,NZ,NY,NX)+XFRC - ZPOOLR(NN,LL-1,NZ,NY,NX)=ZPOOLR(NN,LL-1,NZ,NY,NX)+XFRN - PPOOLR(NN,LL-1,NZ,NY,NX)=PPOOLR(NN,LL-1,NZ,NY,NX)+XFRP - WSRTL(NN,LL-1,NZ,NY,NX)=WSRTL(NN,LL-1,NZ,NY,NX)+XFRW - WTRTD(NN,LL-1,NZ,NY,NX)=WTRTD(NN,LL-1,NZ,NY,NX)+XFRD -C -C WITHDRAW GASES IN PRIMARY ROOTS -C - RCO2Z(NZ,NY,NX)=RCO2Z(NZ,NY,NX)-FRTN*(CO2A(NN,LL,NZ,NY,NX) - 2+CO2P(NN,LL,NZ,NY,NX)) - ROXYZ(NZ,NY,NX)=ROXYZ(NZ,NY,NX)-FRTN*(OXYA(NN,LL,NZ,NY,NX) - 2+OXYP(NN,LL,NZ,NY,NX)) - RCH4Z(NZ,NY,NX)=RCH4Z(NZ,NY,NX)-FRTN*(CH4A(NN,LL,NZ,NY,NX) - 2+CH4P(NN,LL,NZ,NY,NX)) - RN2OZ(NZ,NY,NX)=RN2OZ(NZ,NY,NX)-FRTN*(Z2OA(NN,LL,NZ,NY,NX) - 2+Z2OP(NN,LL,NZ,NY,NX)) - RNH3Z(NZ,NY,NX)=RNH3Z(NZ,NY,NX)-FRTN*(ZH3A(NN,LL,NZ,NY,NX) - 2+ZH3P(NN,LL,NZ,NY,NX)) - RH2GZ(NZ,NY,NX)=RH2GZ(NZ,NY,NX)-FRTN*(H2GA(NN,LL,NZ,NY,NX) - 2+H2GP(NN,LL,NZ,NY,NX)) - CO2A(NN,LL,NZ,NY,NX)=(1.0-FRTN)*CO2A(NN,LL,NZ,NY,NX) - OXYA(NN,LL,NZ,NY,NX)=(1.0-FRTN)*OXYA(NN,LL,NZ,NY,NX) - CH4A(NN,LL,NZ,NY,NX)=(1.0-FRTN)*CH4A(NN,LL,NZ,NY,NX) - Z2OA(NN,LL,NZ,NY,NX)=(1.0-FRTN)*Z2OA(NN,LL,NZ,NY,NX) - ZH3A(NN,LL,NZ,NY,NX)=(1.0-FRTN)*ZH3A(NN,LL,NZ,NY,NX) - H2GA(NN,LL,NZ,NY,NX)=(1.0-FRTN)*H2GA(NN,LL,NZ,NY,NX) - CO2P(NN,LL,NZ,NY,NX)=(1.0-FRTN)*CO2P(NN,LL,NZ,NY,NX) - OXYP(NN,LL,NZ,NY,NX)=(1.0-FRTN)*OXYP(NN,LL,NZ,NY,NX) - CH4P(NN,LL,NZ,NY,NX)=(1.0-FRTN)*CH4P(NN,LL,NZ,NY,NX) - Z2OP(NN,LL,NZ,NY,NX)=(1.0-FRTN)*Z2OP(NN,LL,NZ,NY,NX) - ZH3P(NN,LL,NZ,NY,NX)=(1.0-FRTN)*ZH3P(NN,LL,NZ,NY,NX) - H2GP(NN,LL,NZ,NY,NX)=(1.0-FRTN)*H2GP(NN,LL,NZ,NY,NX) -C IF(NZ.EQ.1.OR.NZ.EQ.4)THEN -C WRITE(*,9868)'WITHDR',I,J,NZ,NR,LL,NN,NINR(NR,NZ,NY,NX) -C 2,FRTN,RTSK1(N,LL,NR),RTSK2(N,LL,NR),RLNT(N,LL) -C 2,WTRTD(NN,LL-1,NZ,NY,NX),WTRTD(NN,LL,NZ,NY,NX) -C 2,RTLG1(NN,LL-1,NR,NZ,NY,NX),RTLG1(NN,LL,NR,NZ,NY,NX) -C 2,RTLG2(NN,LL-1,NR,NZ,NY,NX),RTLG2(NN,LL,NR,NZ,NY,NX) -C 3,RTDP1(N,NR,NZ,NY,NX),RTDP1(NN,NR,NZ,NY,NX) -C 4,CPOOLR(NN,LL-1,NZ,NY,NX),CPOOLR(NN,LL,NZ,NY,NX) -C 4,WTRT1(NN,LL-1,NR,NZ,NY,NX),WTRT1(NN,LL,NR,NZ,NY,NX) -C 4,WTRT2(NN,LL-1,NR,NZ,NY,NX),WTRT2(NN,LL,NR,NZ,NY,NX) -9868 FORMAT(A8,7I4,100E24.16) -C ENDIF -5110 CONTINUE - RTNL(N,LL,NZ,NY,NX)=RTNL(N,LL,NZ,NY,NX) - 2-RTN2(N,LL,NR,NZ,NY,NX) - RTNL(N,LL-1,NZ,NY,NX)=RTNL(N,LL-1,NZ,NY,NX) - 2+RTN2(N,LL,NR,NZ,NY,NX) - RTN2(N,LL,NR,NZ,NY,NX)=0.0 - RTN1(N,LL,NZ,NY,NX)=RTN1(N,LL,NZ,NY,NX)-XRTN1 -C -C RESET PRIMARY ROOT LENGTH -C - IF(LL-1.GT.NG(NZ,NY,NX))THEN - RTLG1(N,LL-1,NR,NZ,NY,NX)=DLYR(3,LL-1,NY,NX) - 2-(CDPTHZ(LL-1,NY,NX)-RTDP1(N,NR,NZ,NY,NX)) - ELSE - RTLG1(N,LL-1,NR,NZ,NY,NX)=DLYR(3,LL-1,NY,NX) - 2-(CDPTHZ(LL-1,NY,NX)-RTDP1(N,NR,NZ,NY,NX)) - 3-(SDPTH(NZ,NY,NX)-CDPTHZ(LL-2,NY,NX)) - ENDIF -C -C REMOBILIZE C,N,P FROM ROOT NODULES IN LEGUMES -C - IF(INTYP(NZ,NY,NX).EQ.1.OR.INTYP(NZ,NY,NX).EQ.2)THEN - XFRC=FRTN*WTNDL(LL,NZ,NY,NX) - XFRN=FRTN*WTNDLN(LL,NZ,NY,NX) - XFRP=FRTN*WTNDLP(LL,NZ,NY,NX) - WTNDL(LL,NZ,NY,NX)=WTNDL(LL,NZ,NY,NX)-XFRC - WTNDLN(LL,NZ,NY,NX)=WTNDLN(LL,NZ,NY,NX)-XFRN - WTNDLP(LL,NZ,NY,NX)=WTNDLP(LL,NZ,NY,NX)-XFRP - WTNDL(LL-1,NZ,NY,NX)=WTNDL(LL-1,NZ,NY,NX)+XFRC - WTNDLN(LL-1,NZ,NY,NX)=WTNDLN(LL-1,NZ,NY,NX)+XFRN - WTNDLP(LL-1,NZ,NY,NX)=WTNDLP(LL-1,NZ,NY,NX)+XFRP - XFRC=FRTN*CPOOLN(LL,NZ,NY,NX) - XFRN=FRTN*ZPOOLN(LL,NZ,NY,NX) - XFRP=FRTN*PPOOLN(LL,NZ,NY,NX) - CPOOLN(LL,NZ,NY,NX)=CPOOLN(LL,NZ,NY,NX)-XFRC - ZPOOLN(LL,NZ,NY,NX)=ZPOOLN(LL,NZ,NY,NX)-XFRN - PPOOLN(LL,NZ,NY,NX)=PPOOLN(LL,NZ,NY,NX)-XFRP - CPOOLN(LL-1,NZ,NY,NX)=CPOOLN(LL-1,NZ,NY,NX)+XFRC - ZPOOLN(LL-1,NZ,NY,NX)=ZPOOLN(LL-1,NZ,NY,NX)+XFRN - PPOOLN(LL-1,NZ,NY,NX)=PPOOLN(LL-1,NZ,NY,NX)+XFRP -C WRITE(*,9868)'WITHDRN',I,J,NZ,NR,LL,NN,NINR(NR,NZ,NY,NX) -C 2,WTNDL(LL,NZ,NY,NX),CPOOLN(LL,NZ,NY,NX),RTDP1(N,NR,NZ,NY,NX) - ENDIF - NINR(NR,NZ,NY,NX)=MAX(NG(NZ,NY,NX),LL-1) - ELSE - GO TO 5120 - ENDIF -5115 CONTINUE - ENDIF -5120 CONTINUE - IF(WTRT1(N,L,NR,NZ,NY,NX).LT.0.0)THEN - CPOOLR(N,L,NZ,NY,NX)=CPOOLR(N,L,NZ,NY,NX)+WTRT1(N,L,NR,NZ,NY,NX) - WTRT1(N,L,NR,NZ,NY,NX)=0.0 - ENDIF - IF(WTRT2(N,L,NR,NZ,NY,NX).LT.0.0)THEN - CPOOLR(N,L,NZ,NY,NX)=CPOOLR(N,L,NZ,NY,NX)+WTRT2(N,L,NR,NZ,NY,NX) - WTRT2(N,L,NR,NZ,NY,NX)=0.0 - ENDIF -C -C TOTAL ROOT LENGTH AND MASS -C - RTLGZ=RTLGZ+RTLG1(N,L,NR,NZ,NY,NX) - WTRTZ=WTRTZ+WTRT1(N,L,NR,NZ,NY,NX) - NINR(NR,NZ,NY,NX)=MIN(NINR(NR,NZ,NY,NX),NJ(NY,NX)) - IF(L.EQ.NINR(NR,NZ,NY,NX))NRX(N,NR)=1 - ENDIF - ENDIF - RTLGZ=RTLGZ+RTLG1(N,L,NR,NZ,NY,NX) - WTRTZ=WTRTZ+WTRT1(N,L,NR,NZ,NY,NX) -C ENDIF - ENDIF - NIX(NZ,NY,NX)=MAX(NIX(NZ,NY,NX),NINR(NR,NZ,NY,NX)) -5050 CONTINUE -C -C DRAW FROM ROOT NON-STRUCTURAL POOL WHEN -C SEASONAL STORAGE POOL IS DEPLETED -C - IF(L.LE.NIX(NZ,NY,NX))THEN - IF(WTRTL(N,L,NZ,NY,NX).GT.ZEROP(NZ,NY,NX) - 2.AND.WTRT(NZ,NY,NX).GT.ZEROP(NZ,NY,NX) - 2.AND.WTRVC(NZ,NY,NX).LT.XFRX*WTRT(NZ,NY,NX))THEN - FWTRT=WTRTL(N,L,NZ,NY,NX)/WTRT(NZ,NY,NX) - WTRTLX=WTRTL(N,L,NZ,NY,NX) - WTRTTX=WTRT(NZ,NY,NX)*FWTRT - WTRTTT=WTRTLX+WTRTTX - CPOOLX=AMAX1(0.0,CPOOLR(N,L,NZ,NY,NX)) - WTRVCX=AMAX1(0.0,WTRVC(NZ,NY,NX)*FWTRT) - CPOOLD=(WTRVCX*WTRTLX-CPOOLX*WTRTTX)/WTRTTT - XFRC=AMIN1(0.0,XFRY*CPOOLD) - CPOOLR(N,L,NZ,NY,NX)=CPOOLR(N,L,NZ,NY,NX)+XFRC - WTRVC(NZ,NY,NX)=WTRVC(NZ,NY,NX)-XFRC -C WRITE(*,3471)'RVC',I,J,NX,NY,NZ,L -C 2,XFRC,CPOOLR(N,L,NZ,NY,NX),WTRTD(N,L,NZ,NY,NX) -C 3,WTRVC(NZ,NY,NX),WTRT(NZ,NY,NX),FWTRT -3471 FORMAT(A8,6I4,12E12.4) - ENDIF - ENDIF -C -C ROOT AND MYCORRHIZAL LENGTH, DENSITY, VOLUME, RADIUS, AREA -C TO CALCULATE WATER AND NUTRIENT UPTAKE IN 'UPTAKE' -C - IF(N.EQ.1)THEN - RTLGZ=RTLGZ*FWOOD(1) - RTLGL=RTLGL*FWOOD(1) - ENDIF - RTLGX=RTLGZ*PP(NZ,NY,NX) - RTLGT=RTLGL+RTLGX - WTRTT=WTRTX+WTRTZ - IF(RTLGT.GT.ZEROP(NZ,NY,NX).AND.WTRTT.GT.ZEROP(NZ,NY,NX) - 2.AND.PP(NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - RTLGP(N,L,NZ,NY,NX)=RTLGT/PP(NZ,NY,NX) - RTDNP(N,L,NZ,NY,NX)=RTLGP(N,L,NZ,NY,NX)/DLYR(3,L,NY,NX) - RTVL=AMAX1(RTAR1X(N,NZ,NY,NX)*RTLGX+RTAR2X(N,NZ,NY,NX)*RTLGL - 2,WTRTT*DMVL(N,NZ,NY,NX)*PSIRG(N,L,NZ,NY,NX)) - RTVLP(N,L,NZ,NY,NX)=PORT(N,NZ,NY,NX)*RTVL - RTVLW(N,L,NZ,NY,NX)=(1.0-PORT(N,NZ,NY,NX))*RTVL - RRAD1(N,L,NZ,NY,NX)=AMAX1(RRAD1X(N,NZ,NY,NX) - 2,(1.0+PSIRT(N,L,NZ,NY,NX)/EMODR)*RRAD1M(N,NZ,NY,NX)) - RRAD2(N,L,NZ,NY,NX)=AMAX1(RRAD2X(N,NZ,NY,NX) - 2,(1.0+PSIRT(N,L,NZ,NY,NX)/EMODR)*RRAD2M(N,NZ,NY,NX)) - RTAR=6.283*RRAD1(N,L,NZ,NY,NX)*RTLGX - 2+6.283*RRAD2(N,L,NZ,NY,NX)*RTLGL - RTARP(N,L,NZ,NY,NX)=RTAR/PP(NZ,NY,NX) - IF(RTNL(N,L,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - RTLGA(N,L,NZ,NY,NX)=AMAX1(RTLGAX,RTLGL/RTNL(N,L,NZ,NY,NX)) - ELSE - RTLGA(N,L,NZ,NY,NX)=RTLGAX - ENDIF - ELSE - RTLGP(N,L,NZ,NY,NX)=0.0 - RTDNP(N,L,NZ,NY,NX)=0.0 - RTVLP(N,L,NZ,NY,NX)=0.0 - RTVLW(N,L,NZ,NY,NX)=0.0 - RRAD1(N,L,NZ,NY,NX)=RRAD1M(N,NZ,NY,NX) - RRAD2(N,L,NZ,NY,NX)=RRAD2M(N,NZ,NY,NX) - RTARP(N,L,NZ,NY,NX)=0.0 - RTLGA(N,L,NZ,NY,NX)=RTLGAX - RCO2Z(NZ,NY,NX)=RCO2Z(NZ,NY,NX)-(CO2A(N,L,NZ,NY,NX) - 2+CO2P(N,L,NZ,NY,NX)) - ROXYZ(NZ,NY,NX)=ROXYZ(NZ,NY,NX)-(OXYA(N,L,NZ,NY,NX) - 2+OXYP(N,L,NZ,NY,NX)) - RCH4Z(NZ,NY,NX)=RCH4Z(NZ,NY,NX)-(CH4A(N,L,NZ,NY,NX) - 2+CH4P(N,L,NZ,NY,NX)) - RN2OZ(NZ,NY,NX)=RN2OZ(NZ,NY,NX)-(Z2OA(N,L,NZ,NY,NX) - 2+Z2OP(N,L,NZ,NY,NX)) - RNH3Z(NZ,NY,NX)=RNH3Z(NZ,NY,NX)-(ZH3A(N,L,NZ,NY,NX) - 2+ZH3P(N,L,NZ,NY,NX)) - RH2GZ(NZ,NY,NX)=RH2GZ(NZ,NY,NX)-(H2GA(N,L,NZ,NY,NX) - 2+H2GP(N,L,NZ,NY,NX)) - CO2A(N,L,NZ,NY,NX)=0.0 - OXYA(N,L,NZ,NY,NX)=0.0 - CH4A(N,L,NZ,NY,NX)=0.0 - Z2OA(N,L,NZ,NY,NX)=0.0 - ZH3A(N,L,NZ,NY,NX)=0.0 - H2GA(N,L,NZ,NY,NX)=0.0 - CO2P(N,L,NZ,NY,NX)=0.0 - OXYP(N,L,NZ,NY,NX)=0.0 - CH4P(N,L,NZ,NY,NX)=0.0 - Z2OP(N,L,NZ,NY,NX)=0.0 - ZH3P(N,L,NZ,NY,NX)=0.0 - H2GP(N,L,NZ,NY,NX)=0.0 - ENDIF -5000 CONTINUE -5010 CONTINUE -C -C ADD SEED DIMENSIONS TO ROOT DIMENSIONS (ONLY IMPORTANT DURING -C GERMINATION) -C - RTLGP(1,NG(NZ,NY,NX),NZ,NY,NX)=RTLGP(1,NG(NZ,NY,NX),NZ,NY,NX) - 2+SDLG(NZ,NY,NX) - RTDNP(1,NG(NZ,NY,NX),NZ,NY,NX)=RTLGP(1,NG(NZ,NY,NX),NZ,NY,NX) - 2/DLYR(3,NG(NZ,NY,NX),NY,NX) - RTVL=RTVLP(1,NG(NZ,NY,NX),NZ,NY,NX)+RTVLW(1,NG(NZ,NY,NX),NZ,NY,NX) - 2+SDVL(NZ,NY,NX)*PP(NZ,NY,NX) - RTVLP(1,NG(NZ,NY,NX),NZ,NY,NX)=PORT(1,NZ,NY,NX)*RTVL - RTVLW(1,NG(NZ,NY,NX),NZ,NY,NX)=(1.0-PORT(1,NZ,NY,NX))*RTVL - RTARP(1,NG(NZ,NY,NX),NZ,NY,NX)=RTARP(1,NG(NZ,NY,NX),NZ,NY,NX) - 2+SDAR(NZ,NY,NX) - IF(IDTHRN.EQ.NRT(NZ,NY,NX).OR.(WTRVC(NZ,NY,NX) - 2.LT.ZEROL(NZ,NY,NX).AND.ISTYP(NZ,NY,NX).NE.0))THEN - IDTHR(NZ,NY,NX)=1 - IDTHP(NZ,NY,NX)=1 - ENDIF -C -C ROOT N2 FIXATION (LEGUMES) -C - IF((INTYP(NZ,NY,NX).EQ.1.OR.INTYP(NZ,NY,NX).EQ.2))THEN - DO 5400 L=NU(NY,NX),NIX(NZ,NY,NX) - IF(WTRTD(1,L,NZ,NY,NX).GT.ZEROL(NZ,NY,NX))THEN -C -C INITIAL INFECTION -C - IF(WTNDL(L,NZ,NY,NX).LE.0.0)THEN - WTNDL(L,NZ,NY,NX)=WTNDL(L,NZ,NY,NX) - 2+WTNDI*AREA(3,NU(NY,NX),NY,NX) - WTNDLN(L,NZ,NY,NX)=WTNDLN(L,NZ,NY,NX) - 2+WTNDI*AREA(3,NU(NY,NX),NY,NX)*CNND(NZ,NY,NX) - WTNDLP(L,NZ,NY,NX)=WTNDLP(L,NZ,NY,NX) - 2+WTNDI*AREA(3,NU(NY,NX),NY,NX)*CPND(NZ,NY,NX) - ENDIF -C -C O2-UNCONSTRAINED RESPIRATION RATES BY HETEROTROPHIC AEROBES -C IN NODULE FROM SPECIFIC OXIDATION RATE, ACTIVE BIOMASS, -C NON-STRUCTURAL C CONCENTRATION, MICROBIAL C:N:P FACTOR, -C AND TEMPERATURE -C - IF(WTNDL(L,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - CCPOLN=AMAX1(0.0,CPOOLN(L,NZ,NY,NX)/WTNDL(L,NZ,NY,NX)) - CZPOLN=AMAX1(0.0,ZPOOLN(L,NZ,NY,NX)/WTNDL(L,NZ,NY,NX)) - CPPOLN=AMAX1(0.0,PPOOLN(L,NZ,NY,NX)/WTNDL(L,NZ,NY,NX)) - ELSE - CCPOLN=1.0 - CZPOLN=1.0 - 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) - ELSE - CCC=0.0 - CNC=0.0 - CPC=0.0 - CNF=0.0 - ENDIF - IF(WTNDL(L,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - FCNPF=AMIN1(1.0,AMAX1(0.0 - 2,WTNDLN(L,NZ,NY,NX)/(WTNDL(L,NZ,NY,NX)*CNND(NZ,NY,NX)) - 3,WTNDLP(L,NZ,NY,NX)/(WTNDL(L,NZ,NY,NX)*CPND(NZ,NY,NX)))) - ELSE - FCNPF=1.0 - ENDIF - RDNDLX=CCPOLN/(CCPOLN+CCNKX) - RCNDLM=AMAX1(0.0,AMIN1(CPOOLN(L,NZ,NY,NX)*(1.0-DMND(NZ,NY,NX)) - 2,VMXO*WTNDL(L,NZ,NY,NX)*CCPOLN/(CCPOLN+CCNKM) - 3*TFN4(L,NZ,NY,NX)*FCNPF*WFNGR(1,L)))*CNF -C -C O2-LIMITED NODULE RESPIRATION FROM 'WFR' IN 'UPTAKE' -C - RCNDL=RCNDLM*WFR(1,L,NZ,NY,NX) -C -C NODULE MAINTENANCE RESPIRATION FROM SOIL TEMPERATURE, -C NODULE STRUCTURAL N -C - RMNDL=AMAX1(0.0,RMPLT*WTNDLN(L,NZ,NY,NX))*TFN6(L)*RDNDLX -C -C NODULE GROWTH RESPIRATION FROM TOTAL - MAINTENANCE -C IF > 0 DRIVES GROWTH, IF < 0 DRIVES REMOBILIZATION -C - RXNDLM=RCNDLM-RMNDL - RXNDL=RCNDL-RMNDL - RGNDLM=AMAX1(0.0,RXNDLM) - RGNDL=AMAX1(0.0,RXNDL) - RSNDLM=AMAX1(0.0,-RXNDLM) - RSNDL=AMAX1(0.0,-RXNDL) -C -C NODULE N2 FIXATION FROM GROWTH RESPIRATION, FIXATION ENERGY -C REQUIREMENT AND NON-STRUCTURAL C:N:P PRODUCT INHIBITION, -C CONSTRAINED BY MICROBIAL N REQUIREMENT -C - RGN2P=AMAX1(0.0,WTNDL(L,NZ,NY,NX)*CNND(NZ,NY,NX) - 2-WTNDLN(L,NZ,NY,NX))/EN2F - RGN2F=AMIN1(RGNDL,RGN2P) - RUPNF(L,NZ,NY,NX)=RGN2F*EN2F - UPNF(NZ,NY,NX)=UPNF(NZ,NY,NX)+RUPNF(L,NZ,NY,NX) -C -C TOTAL NON-STRUCTURAL C,N,P USED IN NODULE GROWTH -C AND GROWTH RESPIRATION DEPENDS ON GROWTH YIELD ENTERED IN 'READQ' -C - CGNDL=(RGNDL-RGN2F)/(1.0-DMND(NZ,NY,NX)) - GRNDG=CGNDL*DMND(NZ,NY,NX) - ZADDN=AMAX1(0.0,AMIN1(ZPOOLN(L,NZ,NY,NX) - 2,GRNDG*CNND(NZ,NY,NX))*CCC) - PADDN=AMAX1(0.0,AMIN1(PPOOLN(L,NZ,NY,NX) - 2,GRNDG*CPND(NZ,NY,NX))*CCC) -C -C NODULE C,N,P REMOBILIZATION AND DECOMPOSITION -C - RCCC=RCCZ(IBTYP(NZ,NY,NX))+CCC*RCCY(IBTYP(NZ,NY,NX)) - RCCN=CNC*RCCX(IGTYP(NZ,NY,NX)) - RCCP=CPC*RCCQ(IGTYP(NZ,NY,NX)) - SPNDX=SPNDL*RDNDLX - RXNDLC=SPNDX*WTNDL(L,NZ,NY,NX)*WFNGR(1,L) - RXNDLN=SPNDX*WTNDLN(L,NZ,NY,NX)*WFNGR(1,L) - RXNDLP=SPNDX*WTNDLP(L,NZ,NY,NX)*WFNGR(1,L) - RDNDLC=RXNDLC*(1.0-RCCC) - RDNDLN=RXNDLN*(1.0-RCCN)*(1.0-RCCC) - RDNDLP=RXNDLP*(1.0-RCCP)*(1.0-RCCC) - RCNDLC=RXNDLC-RDNDLC - RCNDLN=RXNDLN-RDNDLN - RCNDLP=RXNDLP-RDNDLP -C -C NODULE SENESCENCE -C - IF(RSNDL.GT.0.0.AND.WTNDL(L,NZ,NY,NX).GT.ZEROP(NZ,NY,NX) - 2.AND.RCCC.GT.ZERO)THEN - RXNSNC=RSNDL/RCCC - RXNSNN=RXNSNC*WTNDLN(L,NZ,NY,NX)/WTNDL(L,NZ,NY,NX) - RXNSNP=RXNSNC*WTNDLP(L,NZ,NY,NX)/WTNDL(L,NZ,NY,NX) - RDNSNC=RXNSNC*(1.0-RCCC) - RDNSNN=RXNSNN*(1.0-RCCN)*(1.0-RCCC) - RDNSNP=RXNSNP*(1.0-RCCP)*(1.0-RCCC) - RCNSNC=RXNSNC-RDNSNC - RCNSNN=RXNSNN-RDNSNN - RCNSNP=RXNSNP-RDNSNP - ELSE - RXNSNC=0.0 - RXNSNN=0.0 - RXNSNP=0.0 - RDNSNC=0.0 - RDNSNN=0.0 - RDNSNP=0.0 - RCNSNC=0.0 - RCNSNN=0.0 - RCNSNP=0.0 - ENDIF -C -C TOTAL NODULE RESPIRATION -C - RCO2TM=AMIN1(RMNDL,RCNDLM)+RGNDLM+RCNSNC - RCO2T=AMIN1(RMNDL,RCNDL)+RGNDL+RCNSNC - RCO2M(1,L,NZ,NY,NX)=RCO2M(1,L,NZ,NY,NX)+RCO2TM - RCO2N(1,L,NZ,NY,NX)=RCO2N(1,L,NZ,NY,NX)+RCO2T - RCO2A(1,L,NZ,NY,NX)=RCO2A(1,L,NZ,NY,NX)-RCO2T -C -C NODULE LITTERFALL CAUSED BY REMOBILIZATION -C - DO 6370 M=1,4 - CSNC(M,1,L,NZ,NY,NX)=CSNC(M,1,L,NZ,NY,NX)+CFOPC(4,M,NZ,NY,NX) - 2*(RDNDLC+RDNSNC) - ZSNC(M,1,L,NZ,NY,NX)=ZSNC(M,1,L,NZ,NY,NX)+CFOPN(4,M,NZ,NY,NX) - 2*(RDNDLN+RDNSNN) - PSNC(M,1,L,NZ,NY,NX)=PSNC(M,1,L,NZ,NY,NX)+CFOPP(4,M,NZ,NY,NX) - 2*(RDNDLP+RDNSNP) -6370 CONTINUE -C -C CONSUMPTION OF NON-STRUCTURAL C,N,P BY NODULE -C - CPOOLN(L,NZ,NY,NX)=CPOOLN(L,NZ,NY,NX)-AMIN1(RMNDL,RCNDL) - 2-RGN2F-CGNDL+RCNDLC - ZPOOLN(L,NZ,NY,NX)=ZPOOLN(L,NZ,NY,NX)-ZADDN+RCNDLN+RCNSNN - 2+RUPNF(L,NZ,NY,NX) - PPOOLN(L,NZ,NY,NX)=PPOOLN(L,NZ,NY,NX)-PADDN+RCNDLP+RCNSNP -C -C UPDATE STATE VARIABLES FOR NODULE C, N, P -C - WTNDL(L,NZ,NY,NX)=WTNDL(L,NZ,NY,NX)+GRNDG-RXNDLC-RXNSNC - WTNDLN(L,NZ,NY,NX)=WTNDLN(L,NZ,NY,NX)+ZADDN-RXNDLN-RXNSNN - WTNDLP(L,NZ,NY,NX)=WTNDLP(L,NZ,NY,NX)+PADDN-RXNDLP-RXNSNP -C -C TRANSFER NON-STRUCTURAL C,N,P BETWEEN ROOT AND NODULES -C FROM NON-STRUCTURAL C,N,P CONCENTRATION DIFFERENCES -C - IF(CPOOLR(1,L,NZ,NY,NX).GT.ZEROP(NZ,NY,NX) - 2.AND.WTRTD(1,L,NZ,NY,NX).GT.ZEROL(NZ,NY,NX))THEN - WTRTD1=WTRTD(1,L,NZ,NY,NX) - WTNDL1=AMIN1(WTRTD(1,L,NZ,NY,NX),AMAX1(FSNKM - 2*WTRTD(1,L,NZ,NY,NX),WTNDL(L,NZ,NY,NX))) - WTRTDT=WTRTD1+WTRTD2 - IF(WTRTDT.GT.ZEROP(NZ,NY,NX))THEN - CPOOLD=(CPOOLR(1,L,NZ,NY,NX)*WTNDL1 - 2-CPOOLN(L,NZ,NY,NX)*WTRTD1)/WTRTDT - XFRC=FXRN(INTYP(NZ,NY,NX))*CPOOLD - CPOOLR(1,L,NZ,NY,NX)=CPOOLR(1,L,NZ,NY,NX)-XFRC - CPOOLN(L,NZ,NY,NX)=CPOOLN(L,NZ,NY,NX)+XFRC - CPOOLT=CPOOLR(1,L,NZ,NY,NX)+CPOOLN(L,NZ,NY,NX) - IF(CPOOLT.GT.ZEROP(NZ,NY,NX))THEN - ZPOOLD=(ZPOOLR(1,L,NZ,NY,NX)*CPOOLN(L,NZ,NY,NX) - 2-ZPOOLN(L,NZ,NY,NX)*CPOOLR(1,L,NZ,NY,NX))/CPOOLT - XFRN=FXRN(INTYP(NZ,NY,NX))*ZPOOLD - PPOOLD=(PPOOLR(1,L,NZ,NY,NX)*CPOOLN(L,NZ,NY,NX) - 2-PPOOLN(L,NZ,NY,NX)*CPOOLR(1,L,NZ,NY,NX))/CPOOLT - XFRP=FXRN(INTYP(NZ,NY,NX))*PPOOLD - ZPOOLR(1,L,NZ,NY,NX)=ZPOOLR(1,L,NZ,NY,NX)-XFRN - PPOOLR(1,L,NZ,NY,NX)=PPOOLR(1,L,NZ,NY,NX)-XFRP - ZPOOLN(L,NZ,NY,NX)=ZPOOLN(L,NZ,NY,NX)+XFRN - PPOOLN(L,NZ,NY,NX)=PPOOLN(L,NZ,NY,NX)+XFRP -C IF(L.EQ.1)THEN -C WRITE(*,2122)'NODEX',I,J,NZ,L,XFRC,XFRN,XFRP -C 3,WTRTD(1,L,NZ,NY,NX),WTRTDT,CPOOLT -C 4,WTNDL(L,NZ,NY,NX),WTNDLN(L,NZ,NY,NX),WTNDLP(L,NZ,NY,NX) -C 2,CPOOLN(L,NZ,NY,NX),ZPOOLN(L,NZ,NY,NX),PPOOLN(L,NZ,NY,NX) -C 3,CPOOLR(1,L,NZ,NY,NX),ZPOOLR(1,L,NZ,NY,NX),PPOOLR(1,L,NZ,NY,NX) -C ENDIF - ENDIF - ENDIF - ENDIF -C IF(L.EQ.1)THEN -C WRITE(*,2122)'NODGR',I,J,NZ,L,RCNDL,RMNDL,RGNDL,RGN2P -C 2,RGN2F,CGNDL,GRNDG,CCC,ZADDN,PADDN,SNCR,RCCC,RCCN,RCCP -C 8,FSNCN,RCCO,RDNDLC,RDNDLN,RDNDLP,WFR(1,L,NZ,NY,NX) -C 3,WTNDL(L,NZ,NY,NX),WTNDLN(L,NZ,NY,NX),WTNDLP(L,NZ,NY,NX) -C 2,CPOOLN(L,NZ,NY,NX),ZPOOLN(L,NZ,NY,NX),PPOOLN(L,NZ,NY,NX) -C 5,FCNPF,TFN4(L,NZ,NY,NX),WFNGR(1,L) -2122 FORMAT(A8,4I4,60E24.16) -C ENDIF - ENDIF -5400 CONTINUE - ENDIF -C -C TRANSFER NON-STRUCTURAL C,N,P AMONG BRANCH LEAVES -C FROM NON-STRUCTURAL C,N,P CONCENTRATION DIFFERENCES -C WHEN SEASONAL STORAGE C IS NOT BEING MOBILIZED -C - IF(NBR(NZ,NY,NX).GT.1)THEN - WTPLTT=0.0 - CPOOLT=0.0 - ZPOOLT=0.0 - PPOOLT=0.0 - DO 300 NB=1,NBR(NZ,NY,NX) - IF(IDTHB(NB,NZ,NY,NX).EQ.0)THEN - IF(ATRP(NB,NZ,NY,NX).GT.ATRPX)THEN - WTLSBZ(NB)=AMAX1(0.0,WTLSB(NB,NZ,NY,NX)) - CPOOLZ(NB)=AMAX1(0.0,CPOOL(NB,NZ,NY,NX)) - ZPOOLZ(NB)=AMAX1(0.0,ZPOOL(NB,NZ,NY,NX)) - PPOOLZ(NB)=AMAX1(0.0,PPOOL(NB,NZ,NY,NX)) - WTPLTT=WTPLTT+WTLSBZ(NB) - CPOOLT=CPOOLT+CPOOLZ(NB) - ZPOOLT=ZPOOLT+ZPOOLZ(NB) - PPOOLT=PPOOLT+PPOOLZ(NB) - ENDIF - ENDIF -300 CONTINUE - DO 305 NB=1,NBR(NZ,NY,NX) - IF(IDTHB(NB,NZ,NY,NX).EQ.0)THEN - IF(ATRP(NB,NZ,NY,NX).GT.ATRPX)THEN - IF(WTPLTT.GT.ZEROP(NZ,NY,NX) - 2.AND.CPOOLT.GT.ZEROP(NZ,NY,NX))THEN - CPOOLD=CPOOLT*WTLSBZ(NB)-CPOOLZ(NB)*WTPLTT - ZPOOLD=ZPOOLT*CPOOLZ(NB)-ZPOOLZ(NB)*CPOOLT - PPOOLD=PPOOLT*CPOOLZ(NB)-PPOOLZ(NB)*CPOOLT - XFRC=0.01*CPOOLD/WTPLTT - XFRN=0.01*ZPOOLD/CPOOLT - XFRP=0.01*PPOOLD/CPOOLT - CPOOL(NB,NZ,NY,NX)=CPOOL(NB,NZ,NY,NX)+XFRC - ZPOOL(NB,NZ,NY,NX)=ZPOOL(NB,NZ,NY,NX)+XFRN - PPOOL(NB,NZ,NY,NX)=PPOOL(NB,NZ,NY,NX)+XFRP - ENDIF - ENDIF - ENDIF -305 CONTINUE - ENDIF -C -C TRANSFER NON-STRUCTURAL C,N,P AMONG BRANCH STALK RESERVES -C FROM NON-STRUCTURAL C,N,P CONCENTRATION DIFFERENCES -C - IF(NBR(NZ,NY,NX).GT.1)THEN - WTSTKT=0.0 - WTRSVT=0.0 - WTRSNT=0.0 - WTRSPT=0.0 - DO 330 NB=1,NBR(NZ,NY,NX) - IF(IDTHB(NB,NZ,NY,NX).EQ.0)THEN - IF(IDAY(7,NB,NZ,NY,NX).NE.0)THEN - WTSTKT=WTSTKT+WVSTKB(NB,NZ,NY,NX) - WTRSVT=WTRSVT+WTRSVB(NB,NZ,NY,NX) - WTRSNT=WTRSNT+WTRSBN(NB,NZ,NY,NX) - WTRSPT=WTRSPT+WTRSBP(NB,NZ,NY,NX) - ENDIF - ENDIF -330 CONTINUE - IF(WTSTKT.GT.ZEROP(NZ,NY,NX) - 2.AND.WTRSVT.GT.ZEROP(NZ,NY,NX))THEN - DO 335 NB=1,NBR(NZ,NY,NX) - IF(IDTHB(NB,NZ,NY,NX).EQ.0)THEN - IF(IDAY(7,NB,NZ,NY,NX).NE.0)THEN - WTRSVD=WTRSVT*WVSTKB(NB,NZ,NY,NX) - 2-WTRSVB(NB,NZ,NY,NX)*WTSTKT - XFRC=0.1*WTRSVD/WTSTKT - WTRSVB(NB,NZ,NY,NX)=WTRSVB(NB,NZ,NY,NX)+XFRC - WTRSND=WTRSNT*WTRSVB(NB,NZ,NY,NX) - 2-WTRSBN(NB,NZ,NY,NX)*WTRSVT - XFRN=0.1*WTRSND/WTRSVT - WTRSBN(NB,NZ,NY,NX)=WTRSBN(NB,NZ,NY,NX)+XFRN - WTRSPD=WTRSPT*WTRSVB(NB,NZ,NY,NX) - 2-WTRSBP(NB,NZ,NY,NX)*WTRSVT - XFRP=0.1*WTRSPD/WTRSVT - WTRSBP(NB,NZ,NY,NX)=WTRSBP(NB,NZ,NY,NX)+XFRP - ENDIF - ENDIF -335 CONTINUE - ENDIF - ENDIF -C -C TRANSFER NON-STRUCTURAL C,N,P BWTWEEN ROOT AND MYCORRHIZAE -C IN EACH ROOTED SOIL LAYER FROM NON-STRUCTURAL C,N,P CONCENTRATION -C DIFFERENCES -C - IF(MY(NZ,NY,NX).EQ.2)THEN - DO 425 L=NU(NY,NX),NIX(NZ,NY,NX) - IF(CPOOLR(1,L,NZ,NY,NX).GT.ZEROP(NZ,NY,NX) - 2.AND.WTRTD(1,L,NZ,NY,NX).GT.ZEROL(NZ,NY,NX))THEN - WTRTD1=WTRTD(1,L,NZ,NY,NX) - WTRTD2=AMIN1(WTRTD(1,L,NZ,NY,NX),AMAX1(FSNKM - 2*WTRTD(1,L,NZ,NY,NX),WTRTD(2,L,NZ,NY,NX))) - WTPLTT=WTRTD1+WTRTD2 - IF(WTPLTT.GT.ZEROP(NZ,NY,NX))THEN - CPOOLD=(CPOOLR(1,L,NZ,NY,NX)*WTRTD2 - 2-CPOOLR(2,L,NZ,NY,NX)*WTRTD1)/WTPLTT - XFRC=FMYC*CPOOLD - CPOOLR(1,L,NZ,NY,NX)=CPOOLR(1,L,NZ,NY,NX)-XFRC - CPOOLR(2,L,NZ,NY,NX)=CPOOLR(2,L,NZ,NY,NX)+XFRC - CPOOLT=CPOOLR(1,L,NZ,NY,NX)+CPOOLR(2,L,NZ,NY,NX) - IF(CPOOLT.GT.ZEROP(NZ,NY,NX))THEN - ZPOOLD=(ZPOOLR(1,L,NZ,NY,NX)*CPOOLR(2,L,NZ,NY,NX) - 2-ZPOOLR(2,L,NZ,NY,NX)*CPOOLR(1,L,NZ,NY,NX))/CPOOLT - XFRN=FMYC*ZPOOLD - PPOOLD=(PPOOLR(1,L,NZ,NY,NX)*CPOOLR(2,L,NZ,NY,NX) - 2-PPOOLR(2,L,NZ,NY,NX)*CPOOLR(1,L,NZ,NY,NX))/CPOOLT - XFRP=FMYC*PPOOLD - ZPOOLR(1,L,NZ,NY,NX)=ZPOOLR(1,L,NZ,NY,NX)-XFRN - ZPOOLR(2,L,NZ,NY,NX)=ZPOOLR(2,L,NZ,NY,NX)+XFRN - PPOOLR(1,L,NZ,NY,NX)=PPOOLR(1,L,NZ,NY,NX)-XFRP - PPOOLR(2,L,NZ,NY,NX)=PPOOLR(2,L,NZ,NY,NX)+XFRP -C IF(L.EQ.NIX(NZ,NY,NX))THEN -C WRITE(*,9873)'MYCO',I,J,NZ,L,XFRC,XFRN,XFRP -C 2,CPOOLR(1,L,NZ,NY,NX),WTRTD(1,L,NZ,NY,NX) -C 3,CPOOLR(2,L,NZ,NY,NX),WTRTD2 -C 3,WTPLTT,ZPOOLR(1,L,NZ,NY,NX),ZPOOLR(2,L,NZ,NY,NX) -C 4,PPOOLR(1,L,NZ,NY,NX),PPOOLR(2,L,NZ,NY,NX),CPOOLT -9873 FORMAT(A8,4I4,20E24.16) -C ENDIF - ENDIF - ENDIF - ENDIF -425 CONTINUE - ENDIF -C -C TRANSFER NON-STRUCTURAL C,N,P BETWEEN ROOT AND STORAGE -C -C IF(IFLGZ.EQ.1.AND.ISTYP(NZ,NY,NX).NE.0)THEN -C DO 5545 N=1,MY(NZ,NY,NX) -C DO 5550 L=NU(NY,NX),NI(NZ,NY,NX) -C IF(CCPOLR(N,L,NZ,NY,NX).GT.ZERO)THEN -C CNL=CCPOLR(N,L,NZ,NY,NX)/(CCPOLR(N,L,NZ,NY,NX) -C 2+CZPOLR(N,L,NZ,NY,NX)*CNKI) -C CPL=CCPOLR(N,L,NZ,NY,NX)/(CCPOLR(N,L,NZ,NY,NX) -C 2+CPPOLR(N,L,NZ,NY,NX)*CPKI) -C ELSE -C CNL=0.0 -C CPL=0.0 -C ENDIF -C XFRCX=FXFB(IBTYP(NZ,NY,NX)) -C 2*AMAX1(0.0,CPOOLR(N,L,NZ,NY,NX)) -C XFRNX=FXFB(IBTYP(NZ,NY,NX)) -C 2*AMAX1(0.0,ZPOOLR(N,L,NZ,NY,NX))*(1.0+CNL) -C XFRPX=FXFB(IBTYP(NZ,NY,NX)) -C 2*AMAX1(0.0,PPOOLR(N,L,NZ,NY,NX))*(1.0+CPL) -C XFRC=AMIN1(XFRCX,XFRNX/CNMN,XFRPX/CPMN) -C XFRN=AMIN1(XFRNX,XFRC*CNMX,XFRPX*CNMX/CPMN*0.5) -C XFRP=AMIN1(XFRPX,XFRC*CPMX,XFRNX*CPMX/CNMN*0.5) -C CPOOLR(N,L,NZ,NY,NX)=CPOOLR(N,L,NZ,NY,NX)-XFRC -C WTRVC(NZ,NY,NX)=WTRVC(NZ,NY,NX)+XFRC -C ZPOOLR(N,L,NZ,NY,NX)=ZPOOLR(N,L,NZ,NY,NX)-XFRN -C WTRVN(NZ,NY,NX)=WTRVN(NZ,NY,NX)+XFRN -C PPOOLR(N,L,NZ,NY,NX)=PPOOLR(N,L,NZ,NY,NX)-XFRP -C WTRVP(NZ,NY,NX)=WTRVP(NZ,NY,NX)+XFRP -5550 CONTINUE -5545 CONTINUE -C ENDIF -C -C ROOT AND NODULE TOTALS -C - DO 5445 N=1,MY(NZ,NY,NX) - DO 5450 L=NU(NY,NX),NI(NZ,NY,NX) - WTRTL(N,L,NZ,NY,NX)=0.0 - WTRTD(N,L,NZ,NY,NX)=0.0 - DO 5460 NR=1,NRT(NZ,NY,NX) - WTRTL(N,L,NZ,NY,NX)=WTRTL(N,L,NZ,NY,NX)+WTRT2(N,L,NR,NZ,NY,NX) - WTRTD(N,L,NZ,NY,NX)=WTRTD(N,L,NZ,NY,NX)+WTRT2(N,L,NR,NZ,NY,NX) - 2+WTRT1(N,L,NR,NZ,NY,NX) -5460 CONTINUE - TCO2T(NZ,NY,NX)=TCO2T(NZ,NY,NX)+RCO2A(N,L,NZ,NY,NX) - RECO(NY,NX)=RECO(NY,NX)+RCO2A(N,L,NZ,NY,NX) - TRAU(NY,NX)=TRAU(NY,NX)+RCO2A(N,L,NZ,NY,NX) -5450 CONTINUE - DO 5470 NR=1,NRT(NZ,NY,NX) - WTRTL(N,NINR(NR,NZ,NY,NX),NZ,NY,NX) - 2=WTRTL(N,NINR(NR,NZ,NY,NX),NZ,NY,NX) - 3+RTWT1(N,NR,NZ,NY,NX) -5470 CONTINUE -5445 CONTINUE -C -C TRANSFER NON-STRUCTURAL C,N,P BETWEEN ROOT AND SHOOT -C -C SINK STRENGTH OF ROOTS IN EACH SOIL LAYER AS A FRACTION -C OF TOTAL SINK STRENGTH OF ROOTS IN ALL SOIL LAYERS -C - IF(ISTYP(NZ,NY,NX).EQ.1)THEN - IF(WTLS(NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - FWTC=AMIN1(1.0,0.667*WTRT(NZ,NY,NX)/WTLS(NZ,NY,NX)) - ELSE - FWTC=1.0 - ENDIF - IF(WTRT(NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - FWTS=AMIN1(1.0,WTLS(NZ,NY,NX)/(0.667*WTRT(NZ,NY,NX))) - ELSE - FWTS=1.0 - ENDIF - ELSE - FWTC=1.0 - FWTS=1.0 - ENDIF - DO 290 L=NU(NY,NX),NI(NZ,NY,NX) - IF(RTNT(1).GT.ZEROP(NZ,NY,NX))THEN - FWTR(L)=AMAX1(0.0,RLNT(1,L)/RTNT(1)) - ELSE - FWTR(L)=1.0 - ENDIF -290 CONTINUE -C -C RATE CONSTANT FOR TRANSFER IS SET FROM INPUT IN 'READQ' -C BUT IS NOT USED FOR ANNUALS DURING GRAIN FILL -C - WTLS(NZ,NY,NX)=0.0 - DO 309 NB=1,NBR(NZ,NY,NX) - WTLS(NZ,NY,NX)=WTLS(NZ,NY,NX)+WTLSB(NB,NZ,NY,NX) -309 CONTINUE - DO 310 NB=1,NBR(NZ,NY,NX) - IF(IDTHB(NB,NZ,NY,NX).EQ.0 - 2.AND.(ISTYP(NZ,NY,NX).NE.0.OR.IDAY(7,NB,NZ,NY,NX).EQ.0))THEN -C -C SINK STRENGTH OF BRANCHES IN EACH CANOPY AS A FRACTION -C OF TOTAL SINK STRENGTH OF THE CANOPY -C - IF(WTLS(NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - FWTB(NB)=AMAX1(0.0,WTLSB(NB,NZ,NY,NX)/WTLS(NZ,NY,NX)) - ELSE - FWTB(NB)=1.0 - ENDIF - IF(FDBK(NB,NZ,NY,NX).GT.ZERO)THEN - FSNKR=0.75/FDBK(NB,NZ,NY,NX) - ELSE - FSNKR=1.0 - ENDIF - PTSHTR=AMIN1(1.0,PTSHT(NZ,NY,NX)*FSNKR) - DO 415 L=NU(NY,NX),NI(NZ,NY,NX) - WTLSBX=WTLSB(NB,NZ,NY,NX)*FWODB(1)*FWTR(L)*FWTC - WTRTLX=WTRTL(1,L,NZ,NY,NX)*FWOOD(1)*FWTB(NB)*FWTS - WTLSBB=AMAX1(0.0,WTLSBX,FSNKM*WTRTLX) - WTRTLR=AMAX1(0.0,WTRTLX,FSNKM*WTLSBX) - WTPLTT=WTLSBB+WTRTLR - IF(WTPLTT.GT.ZEROP(NZ,NY,NX))THEN - CPOOLB=AMAX1(0.0,CPOOL(NB,NZ,NY,NX)*FWTR(L)) - CPOOLS=AMAX1(0.0,CPOOLR(1,L,NZ,NY,NX)*FWTB(NB)) - CPOOLD=(CPOOLB*WTRTLR-CPOOLS*WTLSBB)/WTPLTT - XFRC=PTSHTR*CPOOLD - CPOOL(NB,NZ,NY,NX)=CPOOL(NB,NZ,NY,NX)-XFRC - CPOOLR(1,L,NZ,NY,NX)=CPOOLR(1,L,NZ,NY,NX)+XFRC - CPOOLT=CPOOLS+CPOOLB - IF(CPOOLT.GT.ZEROP(NZ,NY,NX))THEN - ZPOOLB=AMAX1(0.0,ZPOOL(NB,NZ,NY,NX)*FWTR(L)) - ZPOOLS=AMAX1(0.0,ZPOOLR(1,L,NZ,NY,NX)*FWTB(NB)) - ZPOOLD=(ZPOOLB*CPOOLS-ZPOOLS*CPOOLB)/CPOOLT - XFRN=PTSHTR*ZPOOLD - PPOOLB=AMAX1(0.0,PPOOL(NB,NZ,NY,NX)*FWTR(L)) - PPOOLS=AMAX1(0.0,PPOOLR(1,L,NZ,NY,NX)*FWTB(NB)) - PPOOLD=(PPOOLB*CPOOLS-PPOOLS*CPOOLB)/CPOOLT - XFRP=PTSHTR*PPOOLD - ELSE - XFRN=0.0 - XFRP=0.0 - ENDIF - ZPOOL(NB,NZ,NY,NX)=ZPOOL(NB,NZ,NY,NX)-XFRN - ZPOOLR(1,L,NZ,NY,NX)=ZPOOLR(1,L,NZ,NY,NX)+XFRN - PPOOL(NB,NZ,NY,NX)=PPOOL(NB,NZ,NY,NX)-XFRP - PPOOLR(1,L,NZ,NY,NX)=PPOOLR(1,L,NZ,NY,NX)+XFRP -C IF((I/10)*10.EQ.I.AND.J.EQ.14.AND.NZ.EQ.1.AND.NB.EQ.1)THEN -C WRITE(*,3344)'ROOT',I,J,NX,NY,NZ,NB,L -C 2,FSNKR,FDBK(NB,NZ,NY,NX),CPOOL(NB,NZ,NY,NX) -C 3,CPOOLR(1,L,NZ,NY,NX),ZPOOL(NB,NZ,NY,NX) -C 3,ZPOOLR(1,L,NZ,NY,NX),FWTB(NB),FWTR(L) -C 3,FWTC,FWTS,XFRC,XFRN,XFRP,WTLSBX,WTRTLX -C 4,CPOOLD,CPOOLB,WTLSBB,CPOOLS,WTRTLR -C 5,FWOOD(1),FWODB(1),WTRTL(1,L,NZ,NY,NX) -C 6,WTLSB(NB,NZ,NY,NX),RLNT(1,L),RTNT(1) -3344 FORMAT(A8,7I4,30E12.4) -C ENDIF - ENDIF -415 CONTINUE - ENDIF -310 CONTINUE -C -C TOTAL C,N,P IN EACH BRANCH -C - DO 320 NB=1,NBR(NZ,NY,NX) - CPOOLK(NB,NZ,NY,NX)=0.0 - DO 325 K=1,25 - CPOOLK(NB,NZ,NY,NX)=CPOOLK(NB,NZ,NY,NX) - 2+CPOOL3(K,NB,NZ,NY,NX)+CPOOL4(K,NB,NZ,NY,NX) - 3+CO2B(K,NB,NZ,NY,NX)+HCOB(K,NB,NZ,NY,NX) -325 CONTINUE - WTSHTB(NB,NZ,NY,NX)=WTLFB(NB,NZ,NY,NX) - 2+WTSHEB(NB,NZ,NY,NX)+WTSTKB(NB,NZ,NY,NX)+WTRSVB(NB,NZ,NY,NX) - 3+WTHSKB(NB,NZ,NY,NX)+WTEARB(NB,NZ,NY,NX)+WTGRB(NB,NZ,NY,NX) - 4+CPOOL(NB,NZ,NY,NX)+CPOOLK(NB,NZ,NY,NX) - WTSHTN(NB,NZ,NY,NX)=WTLFBN(NB,NZ,NY,NX) - 2+WTSHBN(NB,NZ,NY,NX)+WTSTBN(NB,NZ,NY,NX)+WTRSBN(NB,NZ,NY,NX) - 3+WTHSBN(NB,NZ,NY,NX)+WTEABN(NB,NZ,NY,NX)+WTGRBN(NB,NZ,NY,NX) - 4+ZPOOL(NB,NZ,NY,NX) - WTSHTP(NB,NZ,NY,NX)=WTLFBP(NB,NZ,NY,NX) - 2+WTSHBP(NB,NZ,NY,NX)+WTSTBP(NB,NZ,NY,NX)+WTRSBP(NB,NZ,NY,NX) - 3+WTHSBP(NB,NZ,NY,NX)+WTEABP(NB,NZ,NY,NX)+WTGRBP(NB,NZ,NY,NX) - 4+PPOOL(NB,NZ,NY,NX) -320 CONTINUE -C -C TOTAL C,N,P IN ROOTS AND MYCORRHIZAE IN EACH SOIL LAYER -C - DO 345 N=1,MY(NZ,NY,NX) - DO 345 L=NU(NY,NX),NI(NZ,NY,NX) - WTRTD(N,L,NZ,NY,NX)=WTRTD(N,L,NZ,NY,NX)+CPOOLR(N,L,NZ,NY,NX) -345 CONTINUE - ELSE - HCUPTK(NZ,NY,NX)=UPOMC(NZ,NY,NX) - HZUPTK(NZ,NY,NX)=UPOMN(NZ,NY,NX)+UPNH4(NZ,NY,NX)+UPNO3(NZ,NY,NX) - 2+UPNF(NZ,NY,NX) - HPUPTK(NZ,NY,NX)=UPOMP(NZ,NY,NX)+UPH2P(NZ,NY,NX) - ENDIF -C -C TRANSFER ABOVE-GROUND C,N,P AT HARVEST OR DISTURBANCE -C - IF((IHVST(NZ,I,NY,NX).GE.0.AND.J.EQ.INT(ZNOON(NY,NX)) - 2.AND.IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6) - 3.OR.(IHVST(NZ,I,NY,NX).EQ.4.OR.IHVST(NZ,I,NY,NX).EQ.6))THEN -C -C ACCUMULATE ALL HARVESTED MATERIAL ABOVE CUTTING HEIGHT -C ACCOUNTING FOR HARVEST EFFICIENCY ENTERED IN 'READS' -C - IF(IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6)THEN - IF(JHVST(NZ,I,NY,NX).NE.2)THEN - PPX(NZ,NY,NX)=PPX(NZ,NY,NX)*(1.0-THIN(NZ,I,NY,NX)) - PP(NZ,NY,NX)=PP(NZ,NY,NX)*(1.0-THIN(NZ,I,NY,NX)) - ELSE -C PPI(NZ,NY,NX)=AMAX1(1.0,0.5*(PPI(NZ,NY,NX)+GRNO(NZ,NY,NX) -C 2/AREA(3,NU(NY,NX),NY,NX))) - PPX(NZ,NY,NX)=PPI(NZ,NY,NX) - PP(NZ,NY,NX)=PPX(NZ,NY,NX)*AREA(3,NU(NY,NX),NY,NX) - ENDIF - IF(IHVST(NZ,I,NY,NX).EQ.3)THEN - CF(NZ,NY,NX)=CF(NZ,NY,NX)*HVST(NZ,I,NY,NX) - ENDIF - IF(IHVST(NZ,I,NY,NX).LE.2.AND.HVST(NZ,I,NY,NX).LT.0.0)THEN - ARLFY=(1.0-ABS(HVST(NZ,I,NY,NX)))*ARLFC(NY,NX) - ARLFR=0.0 - DO 9875 L=1,JC - IF(ZL(L,NY,NX).GT.ZL(L-1,NY,NX) - 2.AND.ARLFT(L,NY,NX).GT.ZEROS(NY,NX) - 3.AND.ARLFR.LT.ARLFY)THEN - IF(ARLFR+ARLFT(L,NY,NX).GT.ARLFY)THEN - HVST(NZ,I,NY,NX)=ZL(L-1,NY,NX)+((ARLFY-ARLFR) - 2/ARLFT(L,NY,NX))*(ZL(L,NY,NX)-ZL(L-1,NY,NX)) - ENDIF - ARLFR=ARLFR+ARLFT(L,NY,NX) - ENDIF -C WRITE(*,6544)'HVST',I,J,L,NZ,IHVST(NZ,I,NY,NX),ARLFC(NY,NX) -C 2,ARLFT(L,NY,NX),ARLFY,ARLFR,ZL(L,NY,NX),ZL(L-1,NY,NX) -C 3,ARLFV(L,NZ,NY,NX),HVST(NZ,I,NY,NX) -6544 FORMAT(A8,5I4,20E12.4) -9875 CONTINUE - ENDIF - WHVSTT=0.0 - WHVSLF=0.0 - WHVHSH=0.0 - WHVEAH=0.0 - WHVGRH=0.0 - WHVSCP=0.0 - WHVSTH=0.0 - WHVRVH=0.0 - ELSE -C -C GRAZING REMOVAL -C - IF(WTSHTA(NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - WHVSTT=HVST(NZ,I,NY,NX)*THIN(NZ,I,NY,NX)*0.45/24.0 - 2*AREA(3,NU(NY,NX),NY,NX)*WTSHT(NZ,NY,NX)/WTSHTA(NZ,NY,NX) - ELSE - WHVSTT=0.0 - ENDIF - IF(IHVST(NZ,I,NY,NX).EQ.6)THEN - WHVSTT=WHVSTT*TFN3(NZ,NY,NX) - ENDIF - CCPOLX=CCPOLP(NZ,NY,NX)/(1.0+CCPOLP(NZ,NY,NX)) - CCPLNX=CCPLNP(NZ,NY,NX)/(1.0+CCPLNP(NZ,NY,NX)) - WHVSLX=WHVSTT*EHVST(1,1,NZ,I,NY,NX) - WHVSLY=AMIN1(WTLF(NZ,NY,NX),WHVSLX) - WHVSLF=WHVSLY*(1.0-CCPOLX) - WHVSCL=WHVSLY*CCPOLX - WHVSNL=WHVSLY*CCPLNX - WHVXXX=AMAX1(0.0,WHVSLX-WHVSLY) - WHVSSX=WHVSTT*EHVST(1,2,NZ,I,NY,NX) - WTSHTT=WTSHE(NZ,NY,NX)+WTHSK(NZ,NY,NX)+WTEAR(NZ,NY,NX) - 2+WTGR(NZ,NY,NX) - IF(WTSHTT.GT.ZEROP(NZ,NY,NX))THEN - WHVSHX=WHVSSX*WTSHE(NZ,NY,NX)/WTSHTT+WHVXXX - WHVSHY=AMIN1(WTSHE(NZ,NY,NX),WHVSHX) - WHVSHH=WHVSHY*(1.0-CCPOLX) - WHVSCS=WHVSHY*CCPOLX - WHVSNS=WHVSHY*CCPLNX - WHVXXX=AMAX1(0.0,WHVSHX-WHVSHY) - WHVHSX=WHVSSX*WTHSK(NZ,NY,NX)/WTSHTT+WHVXXX - WHVHSY=AMIN1(WTHSK(NZ,NY,NX),WHVHSX) - WHVHSH=WHVHSY - WHVXXX=AMAX1(0.0,WHVHSX-WHVHSY) - WHVEAX=WHVSSX*WTEAR(NZ,NY,NX)/WTSHTT+WHVXXX - WHVEAY=AMIN1(WTEAR(NZ,NY,NX),WHVEAX) - WHVEAH=WHVEAY - WHVXXX=AMAX1(0.0,WHVEAX-WHVEAY) - WHVGRX=WHVSSX*WTGR(NZ,NY,NX)/WTSHTT+WHVXXX - WHVGRY=AMIN1(WTGR(NZ,NY,NX),WHVGRX) - WHVGRH=WHVGRY - WHVXXX=AMAX1(0.0,WHVGRX-WHVGRY) - ELSE - WHVSHH=0.0 - WHVSCS=0.0 - WHVSNS=0.0 - WHVHSH=0.0 - WHVEAH=0.0 - WHVGRH=0.0 - WHVXXX=WHVXXX+WHVSSX - ENDIF - WHVSCP=WHVSCL+WHVSCS - WHVSNP=WHVSNL+WHVSNS - WHVSKX=WHVSTT*EHVST(1,3,NZ,I,NY,NX) - WTSTKT=WTSTK(NZ,NY,NX)+WTRSV(NZ,NY,NX) - IF(WTSTKT.GT.WHVSKX+WHVXXX)THEN - WHVSTX=WHVSKX*WTSTK(NZ,NY,NX)/WTSTKT+WHVXXX - WHVSTY=AMIN1(WTSTK(NZ,NY,NX),WHVSTX) - WHVSTH=WHVSTY - WHVXXX=AMAX1(0.0,WHVSTX-WHVSTY) - WHVRVX=WHVSKX*WTRSV(NZ,NY,NX)/WTSTKT+WHVXXX - WHVRVY=AMIN1(WTRSV(NZ,NY,NX),WHVRVX) - WHVRVH=WHVRVY - WHVXXX=AMAX1(0.0,WHVRVX-WHVRVY) - ELSE - WHVSTH=0.0 - WHVRVH=0.0 - WHVXXX=AMAX1(0.0,WHVSKX) - IF(WHVXXX.GT.0.0)THEN - WHVSLY=AMIN1(WTLF(NZ,NY,NX)-WHVSLF-WHVSCL,WHVXXX) - WHVSLF=WHVSLF+WHVSLY*(1.0-CCPOLX) - WHVSCL=WHVSCL+WHVSLY*CCPOLX - WHVSNL=WHVSNL+WHVSLY*CCPLNX - WHVXXX=AMAX1(0.0,WHVXXX-WHVSLY) - IF(WTSHTT.GT.ZEROP(NZ,NY,NX))THEN - WHVSHX=WHVXXX*WTSHE(NZ,NY,NX)/WTSHTT - WHVSHY=AMIN1(WTSHE(NZ,NY,NX),WHVSHX) - WHVSHH=WHVSHH+WHVSHY*(1.0-CCPOLX) - WHVSCS=WHVSCS+WHVSHY*CCPOLX - WHVSNS=WHVSNS+WHVSHY*CCPLNX - WHVXXX=AMAX1(0.0,WHVXXX-WHVSHY) - WHVHSX=WHVXXX*WTHSK(NZ,NY,NX)/WTSHTT - WHVHSY=AMIN1(WTHSK(NZ,NY,NX),WHVHSX) - WHVHSH=WHVHSH+WHVHSY - WHVXXX=AMAX1(0.0,WHVXXX-WHVHSY) - WHVEAX=WHVXXX*WTEAR(NZ,NY,NX)/WTSHTT - WHVEAY=AMIN1(WTEAR(NZ,NY,NX),WHVEAX) - WHVEAH=WHVEAH+WHVEAY - WHVXXX=AMAX1(0.0,WHVEAX-WHVEAY) - WHVGRX=WHVXXX*WTGR(NZ,NY,NX)/WTSHTT - WHVGRY=AMIN1(WTGR(NZ,NY,NX),WHVGRX) - WHVGRH=WHVGRH+WHVGRY - WHVXXX=AMAX1(0.0,WHVGRX-WHVGRY) - ENDIF - ENDIF - ENDIF -C -C ALL HARVEST REMOVALS -C - DO 9860 NB=1,NBR(NZ,NY,NX) - DO 9860 L=1,JC - DO 9860 K=0,25 - WGLFBL(L,NB,NZ,NY,NX)=0.0 -9860 CONTINUE - DO 9870 NB=1,NBR(NZ,NY,NX) - DO 9870 L=1,JC - DO 9870 K=0,25 - WGLFBL(L,NB,NZ,NY,NX)=WGLFBL(L,NB,NZ,NY,NX) - 2+WGLFL(L,K,NB,NZ,NY,NX) -9870 CONTINUE - ENDIF - DO 9865 L=JC,1,-1 - IF(IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6)THEN - IF(IHVST(NZ,I,NY,NX).NE.3)THEN - IF(ZL(L,NY,NX).GT.ZL(L-1,NY,NX))THEN - FHGT=AMAX1(0.0,AMIN1(1.0,1.0-((ZL(L,NY,NX)) - 2-HVST(NZ,I,NY,NX))/(ZL(L,NY,NX)-ZL(L-1,NY,NX)))) - ELSE - FHGT=1.0 - ENDIF - ELSE - FHGT=0.0 - ENDIF - IF(THIN(NZ,I,NY,NX).EQ.0.0)THEN - FHVST=AMAX1(0.0,1.0-(1.0-FHGT)*EHVST(1,1,NZ,I,NY,NX)) - FHVSH=FHVST - ELSE - FHVST=AMAX1(0.0,1.0-THIN(NZ,I,NY,NX)) - IF(IHVST(NZ,I,NY,NX).EQ.0)THEN - FHVSH=1.0-(1.0-FHGT)*EHVST(1,1,NZ,I,NY,NX)*THIN(NZ,I,NY,NX) - ELSE - FHVSH=FHVST - ENDIF - ENDIF - ELSE - FHVST=0.0 - FHVSH=0.0 - ENDIF -C -C CUT LEAVES AT HARVESTED NODES AND LAYERS -C - DO 9855 NB=1,NBR(NZ,NY,NX) - IF((IHVST(NZ,I,NY,NX).EQ.4.OR.IHVST(NZ,I,NY,NX).EQ.6) - 2.AND.WTLF(NZ,NY,NX).GT.ZEROL(NZ,NY,NX))THEN - WHVSBL=WHVSLF*AMAX1(0.0,WGLFBL(L,NB,NZ,NY,NX))/WTLF(NZ,NY,NX) - ELSE - WHVSBL=0.0 - ENDIF - DO 9845 K=25,0,-1 - IF((IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6) - 2.OR.WHVSBL.GT.0.0)THEN - IF(IHVST(NZ,I,NY,NX).EQ.4.OR.IHVST(NZ,I,NY,NX).EQ.6)THEN - IF(WGLFL(L,K,NB,NZ,NY,NX).GT.WHVSBL)THEN - FHVST=AMAX1(0.0,AMIN1(1.0,(WGLFL(L,K,NB,NZ,NY,NX)-WHVSBL) - 2/WGLFL(L,K,NB,NZ,NY,NX))) - FHVSH=FHVST - ELSE - FHVST=1.0 - FHVSH=1.0 - ENDIF - ENDIF -C -C HARVESTED LEAF AREA, C, N, P -C - WHVSBL=WHVSBL-(1.0-FHVST)*WGLFL(L,K,NB,NZ,NY,NX) - WTHTH1=WTHTH1+(1.0-FHVSH)*WGLFL(L,K,NB,NZ,NY,NX)*FWODB(1) - WTHNH1=WTHNH1+(1.0-FHVSH)*WGLFLN(L,K,NB,NZ,NY,NX)*FWODLN(1) - WTHPH1=WTHPH1+(1.0-FHVSH)*WGLFLP(L,K,NB,NZ,NY,NX)*FWODLP(1) - WTHTX1=WTHTX1+(FHVSH-FHVST)*WGLFL(L,K,NB,NZ,NY,NX)*FWODB(1) - WTHNX1=WTHNX1+(FHVSH-FHVST)*WGLFLN(L,K,NB,NZ,NY,NX)*FWODLN(1) - WTHPX1=WTHPX1+(FHVSH-FHVST)*WGLFLP(L,K,NB,NZ,NY,NX)*FWODLP(1) - WTHTH3=WTHTH3+(1.0-FHVSH)*WGLFL(L,K,NB,NZ,NY,NX)*FWODB(0) - WTHNH3=WTHNH3+(1.0-FHVSH)*WGLFLN(L,K,NB,NZ,NY,NX)*FWODLN(0) - WTHPH3=WTHPH3+(1.0-FHVSH)*WGLFLP(L,K,NB,NZ,NY,NX)*FWODLP(0) - WTHTX3=WTHTX3+(FHVSH-FHVST)*WGLFL(L,K,NB,NZ,NY,NX)*FWODB(0) - WTHNX3=WTHNX3+(FHVSH-FHVST)*WGLFLN(L,K,NB,NZ,NY,NX)*FWODLN(0) - WTHPX3=WTHPX3+(FHVSH-FHVST)*WGLFLP(L,K,NB,NZ,NY,NX)*FWODLP(0) -C -C REMAINING LEAF C,N,P AND AREA -C - WGLFL(L,K,NB,NZ,NY,NX)=FHVST*WGLFL(L,K,NB,NZ,NY,NX) - WGLFLN(L,K,NB,NZ,NY,NX)=FHVST*WGLFLN(L,K,NB,NZ,NY,NX) - WGLFLP(L,K,NB,NZ,NY,NX)=FHVST*WGLFLP(L,K,NB,NZ,NY,NX) - ARLFL(L,K,NB,NZ,NY,NX)=FHVST*ARLFL(L,K,NB,NZ,NY,NX) - IF(K.EQ.1)THEN - ARSTK(L,NB,NZ,NY,NX)=FHVST*ARSTK(L,NB,NZ,NY,NX) - ENDIF - ENDIF -C IF(I.EQ.262.AND.K.EQ.5)THEN -C WRITE(*,6543)'GRAZ',I,J,NZ,NB,K,L,IHVST(NZ,I,NY,NX) -C 2,ZL(L,NY,NX),ZL(L-1,NY,NX),HVST(NZ,I,NY,NX),FHVST,FHVSH -C 5,WGLFBL(L,NB,NZ,NY,NX),WTLF(NZ,NY,NX),CPOOLP(NZ,NY,NX) -C 6,ARLFL(L,K,NB,NZ,NY,NX),WGLF(K,NB,NZ,NY,NX),ARLF(K,NB,NZ,NY,NX) -C 7,HTNODE(K,NB,NZ,NY,NX) -C 7,WTSHTA(NZ,NY,NX),WHVSBL,WHVSTT,WHVSLF,WHVSHH -C 3,WHVHSH,WHVEAH,WHVGRH,WHVSCP,WHVSTH,WHVRVH,WHVXXX -C 4,WTSHTT,WHVSSX,CCPOLX -6543 FORMAT(A8,7I4,30E12.4) -C ENDIF -9845 CONTINUE -9855 CONTINUE - ARLFV(L,NZ,NY,NX)=0.0 - WGLFV(L,NZ,NY,NX)=0.0 - ARSTV(L,NZ,NY,NX)=ARSTV(L,NZ,NY,NX)*FHVST -9865 CONTINUE - DO 9835 NB=1,NBR(NZ,NY,NX) - CPOOLG=0.0 - ZPOOLG=0.0 - PPOOLG=0.0 - CPOLNG=0.0 - ZPOLNG=0.0 - PPOLNG=0.0 - WTNDG=0.0 - WTNDNG=0.0 - WTNDPG=0.0 - WGLFGX=0.0 - WGSHGX=0.0 - WGLFGY=0.0 - WGSHGY=0.0 - DO 9825 K=0,25 - ARLFG=0.0 - WGLFG=0.0 - WGLFNG=0.0 - WGLFPG=0.0 -C -C REMAINING LEAF AREA, C, N, P -C - DO 9815 L=1,JC - ARLFG=ARLFG+ARLFL(L,K,NB,NZ,NY,NX) - WGLFG=WGLFG+WGLFL(L,K,NB,NZ,NY,NX) - WGLFNG=WGLFNG+WGLFLN(L,K,NB,NZ,NY,NX) - WGLFPG=WGLFPG+WGLFLP(L,K,NB,NZ,NY,NX) - ARLFV(L,NZ,NY,NX)=ARLFV(L,NZ,NY,NX)+ARLFL(L,K,NB,NZ,NY,NX) - WGLFV(L,NZ,NY,NX)=WGLFV(L,NZ,NY,NX)+WGLFL(L,K,NB,NZ,NY,NX) -9815 CONTINUE -C -C ACCUMULATE REMAINING BRANCH LEAF AREA, C, N, P -C - IF(IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6)THEN - IF(WGLF(K,NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX) - 2.AND.EHVST(1,1,NZ,I,NY,NX).GT.0.0)THEN - FHVSTK(K)=AMAX1(0.0,AMIN1(1.0,(1.0-(1.0-AMAX1(0.0,WGLFG) - 2/WGLF(K,NB,NZ,NY,NX))*EHVST(1,2,NZ,I,NY,NX) - 3/EHVST(1,1,NZ,I,NY,NX)))) - FHVSHK(K)=FHVSTK(K) - ELSE - IF(THIN(NZ,I,NY,NX).EQ.0.0)THEN - FHVSTK(K)=1.0-EHVST(1,2,NZ,I,NY,NX) - FHVSHK(K)=FHVSTK(K) - ELSE - FHVSTK(K)=1.0-THIN(NZ,I,NY,NX) - IF(IHVST(NZ,I,NY,NX).EQ.0)THEN - FHVSHK(K)=1.0-EHVST(1,2,NZ,I,NY,NX)*THIN(NZ,I,NY,NX) - ELSE - FHVSHK(K)=FHVSTK(K) - ENDIF - ENDIF - ENDIF - ELSE - FHVSTK(K)=0.0 - FHVSHK(K)=0.0 - ENDIF - WGLFGY=WGLFGY+WGLF(K,NB,NZ,NY,NX) - WTLFB(NB,NZ,NY,NX)=WTLFB(NB,NZ,NY,NX) - 2-WGLF(K,NB,NZ,NY,NX)+WGLFG - WTLFBN(NB,NZ,NY,NX)=WTLFBN(NB,NZ,NY,NX) - 2-WGLFN(K,NB,NZ,NY,NX)+WGLFNG - WTLFBP(NB,NZ,NY,NX)=WTLFBP(NB,NZ,NY,NX) - 2-WGLFP(K,NB,NZ,NY,NX)+WGLFPG - ARLFB(NB,NZ,NY,NX)=ARLFB(NB,NZ,NY,NX)-ARLF(K,NB,NZ,NY,NX)+ARLFG - IF(ARLF(K,NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - WSLF(K,NB,NZ,NY,NX)=WSLF(K,NB,NZ,NY,NX)*ARLFG/ARLF(K,NB,NZ,NY,NX) - ELSE - WSLF(K,NB,NZ,NY,NX)=0.0 - ENDIF - ARLF(K,NB,NZ,NY,NX)=ARLFG - WGLF(K,NB,NZ,NY,NX)=WGLFG - WGLFN(K,NB,NZ,NY,NX)=WGLFNG - WGLFP(K,NB,NZ,NY,NX)=WGLFPG - WGLFGX=WGLFGX+WGLF(K,NB,NZ,NY,NX) -9825 CONTINUE -C -C CUT SHEATHS OR PETIOLES AND STALKS HARVESTED NODES AND LAYERS -C - HTSTKX=-1.0 - IF((IHVST(NZ,I,NY,NX).EQ.4.OR.IHVST(NZ,I,NY,NX).EQ.6) - 2.AND.WTSHE(NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - WHVSBS=WHVSHH*WTSHEB(NB,NZ,NY,NX)/WTSHE(NZ,NY,NX) - ELSE - WHVSBS=0.0 - ENDIF - DO 9805 K=25,0,-1 -C WRITE(*,112)'VSTG',I,J,NX,NY,NZ,NB,K,VSTG(NB,NZ,NY,NX),FHVSTK(K) -C 2,HTNODE(K,NB,NZ,NY,NX),HVST(NZ,I,NY,NX) -112 FORMAT(A8,7I4,12E12.4) - IF(HTNODE(K,NB,NZ,NY,NX).GT.0.0) - 2HTSTKX=AMAX1(HTSTKX,HTNODE(K,NB,NZ,NY,NX)) -C -C HARVESTED SHEATH OR PETIOLE C,N,P -C - IF((IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6) - 2.OR.WHVSBS.GT.0.0)THEN - IF(IHVST(NZ,I,NY,NX).EQ.4.OR.IHVST(NZ,I,NY,NX).EQ.6)THEN - IF(WGSHE(K,NB,NZ,NY,NX).GT.WHVSBS)THEN - FHVSTK(K)=AMAX1(0.0,AMIN1(1.0,(WGSHE(K,NB,NZ,NY,NX)-WHVSBS) - 2/WGSHE(K,NB,NZ,NY,NX))) - FHVSHK(K)=FHVSTK(K) - ELSE - FHVSTK(K)=0.0 - FHVSHK(K)=0.0 - ENDIF - ENDIF - WHVSBS=WHVSBS-(1.0-FHVSTK(K))*WGSHE(K,NB,NZ,NY,NX) - WTHTH2=WTHTH2+(1.0-FHVSHK(K))*WGSHE(K,NB,NZ,NY,NX)*FWODB(1) - WTHNH2=WTHNH2+(1.0-FHVSHK(K))*WGSHN(K,NB,NZ,NY,NX)*FWODSN(1) - WTHPH2=WTHPH2+(1.0-FHVSHK(K))*WGSHP(K,NB,NZ,NY,NX)*FWODSP(1) - WTHTX2=WTHTX2+(FHVSHK(K)-FHVSTK(K))*WGSHE(K,NB,NZ,NY,NX) - 2*FWODB(1) - WTHNX2=WTHNX2+(FHVSHK(K)-FHVSTK(K))*WGSHN(K,NB,NZ,NY,NX) - 2*FWODSN(1) - WTHPX2=WTHPX2+(FHVSHK(K)-FHVSTK(K))*WGSHP(K,NB,NZ,NY,NX) - 2*FWODSP(1) - WTHTH3=WTHTH3+(1.0-FHVSHK(K))*WGSHE(K,NB,NZ,NY,NX)*FWODB(0) - WTHNH3=WTHNH3+(1.0-FHVSHK(K))*WGSHN(K,NB,NZ,NY,NX)*FWODSN(0) - WTHPH3=WTHPH3+(1.0-FHVSHK(K))*WGSHP(K,NB,NZ,NY,NX)*FWODSP(0) - WTHTX3=WTHTX3+(FHVSHK(K)-FHVSTK(K))*WGSHE(K,NB,NZ,NY,NX) - 2*FWODB(0) - WTHNX3=WTHNX3+(FHVSHK(K)-FHVSTK(K))*WGSHN(K,NB,NZ,NY,NX) - 2*FWODSN(0) - WTHPX3=WTHPX3+(FHVSHK(K)-FHVSTK(K))*WGSHP(K,NB,NZ,NY,NX) - 2*FWODSP(0) -C -C REMAINING SHEATH OR PETIOLE C,N,P AND LENGTH -C - WGSHGY=WGSHGY+WGSHE(K,NB,NZ,NY,NX) - WTSHEB(NB,NZ,NY,NX)=WTSHEB(NB,NZ,NY,NX) - 2-(1.0-FHVSTK(K))*WGSHE(K,NB,NZ,NY,NX) - WTSHBN(NB,NZ,NY,NX)=WTSHBN(NB,NZ,NY,NX) - 2-(1.0-FHVSTK(K))*WGSHN(K,NB,NZ,NY,NX) - WTSHBP(NB,NZ,NY,NX)=WTSHBP(NB,NZ,NY,NX) - 2-(1.0-FHVSTK(K))*WGSHP(K,NB,NZ,NY,NX) - WGSHE(K,NB,NZ,NY,NX)=FHVSTK(K)*WGSHE(K,NB,NZ,NY,NX) - WSSHE(K,NB,NZ,NY,NX)=FHVSTK(K)*WSSHE(K,NB,NZ,NY,NX) - WGSHN(K,NB,NZ,NY,NX)=FHVSTK(K)*WGSHN(K,NB,NZ,NY,NX) - WGSHP(K,NB,NZ,NY,NX)=FHVSTK(K)*WGSHP(K,NB,NZ,NY,NX) - WSSHE(K,NB,NZ,NY,NX)=FHVSTK(K)*WSSHE(K,NB,NZ,NY,NX) - IF(IHVST(NZ,I,NY,NX).LE.2 - 2.AND.HTSHE(K,NB,NZ,NY,NX).GT.0.0)THEN - FHGT=AMAX1(0.0,AMIN1(1.0,(HTNODE(K,NB,NZ,NY,NX) - 2+HTSHE(K,NB,NZ,NY,NX)-HVST(NZ,I,NY,NX))/HTSHE(K,NB,NZ,NY,NX))) - HTSHE(K,NB,NZ,NY,NX)=(1.0-FHGT)*HTSHE(K,NB,NZ,NY,NX) - ELSE - HTSHE(K,NB,NZ,NY,NX)=FHVSTK(K)*HTSHE(K,NB,NZ,NY,NX) - ENDIF - WGSHGX=WGSHGX+WGSHE(K,NB,NZ,NY,NX) -C IF(IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6)THEN -C IF(HTNODE(K,NB,NZ,NY,NX).GT.HVST(NZ,I,NY,NX) -C 2.OR.IHVST(NZ,I,NY,NX).EQ.3)THEN -C IF(FHVSTK(K).EQ.0.0.AND.K.GT.0)THEN -C IF(IBTYP(NZ,NY,NX).EQ.0.OR.IGTYP(NZ,NY,NX).LE.1)THEN -C VSTG(NB,NZ,NY,NX)=AMAX1(0.0,VSTG(NB,NZ,NY,NX)-1.0) -C ELSE -C VSTG(NB,NZ,NY,NX)=AMAX1(0.0,VSTG(NB,NZ,NY,NX)-0.04) -C ENDIF -C ENDIF -C ENDIF -C ENDIF - ENDIF -9805 CONTINUE -C -C CUT NON-STRUCTURAL C,N,P IN HARVESTED BRANCHES -C - CPOOLX=AMAX1(0.0,CPOOL(NB,NZ,NY,NX)) - ZPOOLX=AMAX1(0.0,ZPOOL(NB,NZ,NY,NX)) - PPOOLX=AMAX1(0.0,PPOOL(NB,NZ,NY,NX)) - CPOLNX=AMAX1(0.0,CPOLNB(NB,NZ,NY,NX)) - ZPOLNX=AMAX1(0.0,ZPOLNB(NB,NZ,NY,NX)) - PPOLNX=AMAX1(0.0,PPOLNB(NB,NZ,NY,NX)) - IF(IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6)THEN - IF(WGLFGY+WGSHGY.GT.ZEROP(NZ,NY,NX))THEN - FHVST=AMAX1(0.0,AMIN1(1.0,(WGLFGX+WGSHGX) - 2/(WGLFGY+WGSHGY))) - CPOOLG=CPOOLX*FHVST - ZPOOLG=ZPOOLX*FHVST - PPOOLG=PPOOLX*FHVST - CPOLNG=CPOLNX*FHVST - ZPOLNG=ZPOLNX*FHVST - PPOLNG=PPOLNX*FHVST - WTNDG=WTNDB(NB,NZ,NY,NX)*FHVST - WTNDNG=WTNDBN(NB,NZ,NY,NX)*FHVST - WTNDPG=WTNDBP(NB,NZ,NY,NX)*FHVST - ELSE - CPOOLG=0.0 - ZPOOLG=0.0 - PPOOLG=0.0 - CPOLNG=0.0 - ZPOLNG=0.0 - PPOLNG=0.0 - WTNDG=0.0 - WTNDNG=0.0 - WTNDPG=0.0 - ENDIF - ELSE - IF(WTLS(NZ,NY,NX).GT.ZEROL(NZ,NY,NX))THEN - WTLSBX=AMAX1(0.0,WTLSB(NB,NZ,NY,NX)) - IF(CPOOL(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - WHVSCX=AMAX1(0.0,WHVSCP)*WTLSBX/WTLS(NZ,NY,NX) - CPOOLG=AMAX1(0.0,CPOOLX-WHVSCX) - ZPOOLG=AMAX1(0.0,ZPOOLX-WHVSCX*ZPOOLX/CPOOL(NB,NZ,NY,NX)) - PPOOLG=AMAX1(0.0,PPOOLX-WHVSCX*PPOOLX/CPOOL(NB,NZ,NY,NX)) - ELSE - CPOOLG=0.0 - ZPOOLG=0.0 - PPOOLG=0.0 - ENDIF - IF(CPOLNB(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - WHVSNX=AMAX1(0.0,WHVSNP)*WTLSBX/WTLS(NZ,NY,NX) - CPOLNG=AMAX1(0.0,CPOLNX-WHVSNX) - ZPOLNG=AMAX1(0.0,ZPOLNX-WHVSNX*ZPOLNX/CPOLNB(NB,NZ,NY,NX)) - PPOLNG=AMAX1(0.0,PPOLNX-WHVSNX*PPOLNX/CPOLNB(NB,NZ,NY,NX)) - WTNDG=WTNDB(NB,NZ,NY,NX)*(1.0-WHVSNX/CPOLNX) - WTNDNG=WTNDBN(NB,NZ,NY,NX)*(1.0-WHVSNX/CPOLNX) - WTNDPG=WTNDBP(NB,NZ,NY,NX)*(1.0-WHVSNX/CPOLNX) - ELSE - CPOLNG=0.0 - ZPOLNG=0.0 - PPOLNG=0.0 - WTNDG=0.0 - WTNDNG=0.0 - WTNDPG=0.0 - ENDIF - ELSE - CPOOLG=0.0 - ZPOOLG=0.0 - PPOOLG=0.0 - CPOLNG=0.0 - ZPOLNG=0.0 - PPOLNG=0.0 - WTNDG=0.0 - WTNDNG=0.0 - WTNDPG=0.0 - ENDIF - ENDIF -C -C HARVESTED NON-STRUCTURAL C, N, P -C - WTHTH0=WTHTH0+CPOOLX-CPOOLG+CPOLNX-CPOLNG - WTHNH0=WTHNH0+ZPOOLX-ZPOOLG+ZPOLNX-ZPOLNG - WTHPH0=WTHPH0+PPOOLX-PPOOLG+PPOLNX-PPOLNG - WTHTH0=WTHTH0+WTNDB(NB,NZ,NY,NX)-WTNDG - WTHNH0=WTHNH0+WTNDBN(NB,NZ,NY,NX)-WTNDNG - WTHPH0=WTHPH0+WTNDBP(NB,NZ,NY,NX)-WTNDPG -C -C REMAINING NON-STRUCTURAL C, N, P -C - CPOOL(NB,NZ,NY,NX)=CPOOLG - ZPOOL(NB,NZ,NY,NX)=ZPOOLG - PPOOL(NB,NZ,NY,NX)=PPOOLG - CPOLNB(NB,NZ,NY,NX)=CPOLNG - ZPOLNB(NB,NZ,NY,NX)=ZPOLNG - PPOLNB(NB,NZ,NY,NX)=PPOLNG - WTNDB(NB,NZ,NY,NX)=WTNDG - WTNDBN(NB,NZ,NY,NX)=WTNDNG - WTNDBP(NB,NZ,NY,NX)=WTNDPG -C -C REMOVE C4 NON-STRUCTURAL C -C - IF(ICTYP(NZ,NY,NX).EQ.4.AND.CPOOLX.GT.ZEROP(NZ,NY,NX))THEN - FHVST4=CPOOLG/CPOOLX - DO 9810 K=1,25 - WTHTH0=WTHTH0+(1.0-FHVST4)*CPOOL3(K,NB,NZ,NY,NX) - WTHTH0=WTHTH0+(1.0-FHVST4)*CPOOL4(K,NB,NZ,NY,NX) - WTHTH0=WTHTH0+(1.0-FHVST4)*CO2B(K,NB,NZ,NY,NX) - WTHTH0=WTHTH0+(1.0-FHVST4)*HCOB(K,NB,NZ,NY,NX) - CPOOL3(K,NB,NZ,NY,NX)=FHVST4*CPOOL3(K,NB,NZ,NY,NX) - CPOOL4(K,NB,NZ,NY,NX)=FHVST4*CPOOL4(K,NB,NZ,NY,NX) - CO2B(K,NB,NZ,NY,NX)=FHVST4*CO2B(K,NB,NZ,NY,NX) - HCOB(K,NB,NZ,NY,NX)=FHVST4*HCOB(K,NB,NZ,NY,NX) -9810 CONTINUE - ENDIF -C -C CUT STALKS -C - IF(IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6)THEN - IF(HTSTKX.GT.ZERO)THEN - IF(IHVST(NZ,I,NY,NX).NE.3)THEN - FHGT=AMAX1(0.0,AMIN1(1.0,HVST(NZ,I,NY,NX)/HTSTKX)) - ELSE - FHGT=0.0 - ENDIF - IF(THIN(NZ,I,NY,NX).EQ.0.0)THEN - FHVST=AMAX1(0.0,1.0-(1.0-FHGT)*EHVST(1,3,NZ,I,NY,NX)) - FHVSH=FHVST - ELSE - FHVST=AMAX1(0.0,1.0-THIN(NZ,I,NY,NX)) - IF(IHVST(NZ,I,NY,NX).EQ.0)THEN - FHVSH=1.0-(1.0-FHGT)*EHVST(1,3,NZ,I,NY,NX)*THIN(NZ,I,NY,NX) - ELSE - FHVSH=FHVST - ENDIF - ENDIF - ELSE - FHVST=1.0 - FHVSH=1.0 - ENDIF - ELSE - IF(WTSTK(NZ,NY,NX).GT.ZEROL(NZ,NY,NX))THEN - FHVST=AMAX1(0.0,AMIN1(1.0,1.0-WHVSTH/WTSTK(NZ,NY,NX))) - FHVSH=FHVST - ELSE - FHVST=1.0 - FHVSH=1.0 - ENDIF - ENDIF -C -C HARVESTED STALK C,N,P -C - WTHTH3=WTHTH3+(1.0-FHVSH)*WTSTKB(NB,NZ,NY,NX) - WTHNH3=WTHNH3+(1.0-FHVSH)*WTSTBN(NB,NZ,NY,NX) - WTHPH3=WTHPH3+(1.0-FHVSH)*WTSTBP(NB,NZ,NY,NX) - WTHTX3=WTHTX3+(FHVSH-FHVST)*WTSTKB(NB,NZ,NY,NX) - WTHNX3=WTHNX3+(FHVSH-FHVST)*WTSTBN(NB,NZ,NY,NX) - WTHPX3=WTHPX3+(FHVSH-FHVST)*WTSTBP(NB,NZ,NY,NX) -C -C REMAINING STALK C,N,P -C - WTSTKB(NB,NZ,NY,NX)=FHVST*WTSTKB(NB,NZ,NY,NX) - WTSTBN(NB,NZ,NY,NX)=FHVST*WTSTBN(NB,NZ,NY,NX) - WTSTBP(NB,NZ,NY,NX)=FHVST*WTSTBP(NB,NZ,NY,NX) - WVSTKB(NB,NZ,NY,NX)=FHVST*WVSTKB(NB,NZ,NY,NX) - WTSTXB(NB,NZ,NY,NX)=FHVST*WTSTXB(NB,NZ,NY,NX) - WTSTXN(NB,NZ,NY,NX)=FHVST*WTSTXN(NB,NZ,NY,NX) - WTSTXP(NB,NZ,NY,NX)=FHVST*WTSTXP(NB,NZ,NY,NX) - -C -C CUT STALK NODES -C - DO 9820 K=25,0,-1 - IF(IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6)THEN - IF(HTNODX(K,NB,NZ,NY,NX).GT.ZERO)THEN - IF(IHVST(NZ,I,NY,NX).NE.3)THEN - FHGT=AMAX1(0.0,AMIN1(1.0,(HTNODE(K,NB,NZ,NY,NX) - 2-HVST(NZ,I,NY,NX))/HTNODX(K,NB,NZ,NY,NX))) - ELSE - FHGT=0.0 - ENDIF - IF(THIN(NZ,I,NY,NX).EQ.0.0)THEN - FHVST=AMAX1(0.0,1.0-FHGT*EHVST(1,3,NZ,I,NY,NX)) - ELSE - FHVST=AMAX1(0.0,1.0-THIN(NZ,I,NY,NX)) - ENDIF - ELSE - FHVST=1.0 - ENDIF - ELSE - IF(WTSTK(NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - FHVST=AMAX1(0.0,AMIN1(1.0,1.0-WHVSTH/WTSTK(NZ,NY,NX))) - ELSE - FHVST=1.0 - ENDIF - ENDIF - WGNODE(K,NB,NZ,NY,NX)=FHVST*WGNODE(K,NB,NZ,NY,NX) - WGNODN(K,NB,NZ,NY,NX)=FHVST*WGNODN(K,NB,NZ,NY,NX) - WGNODP(K,NB,NZ,NY,NX)=FHVST*WGNODP(K,NB,NZ,NY,NX) - IF(IHVST(NZ,I,NY,NX).LE.2.AND.THIN(NZ,I,NY,NX).EQ.0.0)THEN - HTNODX(K,NB,NZ,NY,NX)=FHVST*HTNODX(K,NB,NZ,NY,NX) - HTNODE(K,NB,NZ,NY,NX)=AMIN1(HTNODE(K,NB,NZ,NY,NX) - 2,HVST(NZ,I,NY,NX)) - ENDIF -C IF(NZ.EQ.2)THEN -C WRITE(*,4811)'STK2',I,J,NZ,NB,K,IHVST(NZ,I,NY,NX) -C 2,HTNODX(K,NB,NZ,NY,NX),HTNODE(K,NB,NZ,NY,NX) -C 3,HVST(NZ,I,NY,NX),FHGT,FHVST,ARLF(K,NB,NZ,NY,NX) -C 4,EHVST(1,3,NZ,I,NY,NX),THIN(NZ,I,NY,NX) -4811 FORMAT(A8,6I4,12E12.4) -C ENDIF -9820 CONTINUE -C -C CUT STALK RESERVES -C - IF(IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6)THEN - IF(WTSTKB(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - FHVST=FHVST - FHVSH=FHVSH - ELSE - FHVST=0.0 - FHVSH=0.0 - ENDIF - ELSE - IF(WTRSV(NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - FHVST=AMAX1(0.0,AMIN1(1.0,1.0-WHVRVH/WTRSV(NZ,NY,NX))) - FHVSH=FHVST - ELSE - FHVST=0.0 - FHVSH=0.0 - ENDIF - ENDIF -C -C HARVESTED STALK RESERVE C,N,P -C - WTHTH3=WTHTH3+(1.0-FHVSH)*WTRSVB(NB,NZ,NY,NX) - WTHNH3=WTHNH3+(1.0-FHVSH)*WTRSBN(NB,NZ,NY,NX) - WTHPH3=WTHPH3+(1.0-FHVSH)*WTRSBP(NB,NZ,NY,NX) - WTHTX3=WTHTX3+(FHVSH-FHVST)*WTRSVB(NB,NZ,NY,NX) - WTHNX3=WTHNX3+(FHVSH-FHVST)*WTRSBN(NB,NZ,NY,NX) - WTHPX3=WTHPX3+(FHVSH-FHVST)*WTRSBP(NB,NZ,NY,NX) -C -C REMAINING STALK RESERVE C,N,P IF STALK REMAINING -C - WTRSVB(NB,NZ,NY,NX)=FHVST*WTRSVB(NB,NZ,NY,NX) - WTRSBN(NB,NZ,NY,NX)=FHVST*WTRSBN(NB,NZ,NY,NX) - WTRSBP(NB,NZ,NY,NX)=FHVST*WTRSBP(NB,NZ,NY,NX) -C -C CUT REPRODUCTIVE ORGANS -C - IF(IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6)THEN - IF(HVST(NZ,I,NY,NX).LT.HTSTKX - 2.OR.IHVST(NZ,I,NY,NX).EQ.3)THEN - IF(THIN(NZ,I,NY,NX).EQ.0.0)THEN - FHVSTG=1.0-EHVST(1,2,NZ,I,NY,NX) - FHVSHG=FHVSTG - ELSE - FHVSTG=1.0-THIN(NZ,I,NY,NX) - FHVSHG=1.0-EHVST(1,2,NZ,I,NY,NX)*THIN(NZ,I,NY,NX) - ENDIF - ELSE - FHVSTG=1.0-THIN(NZ,I,NY,NX) - FHVSHG=FHVSTG - ENDIF - FHVSTH=FHVSTG - FHVSTE=FHVSTG - FHVSHH=FHVSHG - FHVSHE=FHVSHG - ELSE - IF(WTHSK(NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - FHVSTH=AMAX1(0.0,AMIN1(1.0,1.0-WHVHSH/WTHSK(NZ,NY,NX))) - FHVSHH=FHVSTH - ELSE - FHVSTH=1.0 - FHVSHH=1.0 - ENDIF - IF(WTEAR(NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - FHVSTE=AMAX1(0.0,AMIN1(1.0,1.0-WHVEAH/WTEAR(NZ,NY,NX))) - FHVSHE=FHVSTE - ELSE - FHVSTE=1.0 - FHVSHE=1.0 - ENDIF - IF(WTGR(NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - FHVSTG=AMAX1(0.0,AMIN1(1.0,1.0-WHVGRH/WTGR(NZ,NY,NX))) - FHVSHG=FHVSTG - ELSE - FHVSTG=1.0 - FHVSHG=1.0 - ENDIF - ENDIF -C -C HARVESTED REPRODUCTIVE C,N,P -C - WTHTH2=WTHTH2+(1.0-FHVSHH)*WTHSKB(NB,NZ,NY,NX)+(1.0-FHVSHE) - 2*WTEARB(NB,NZ,NY,NX)+(1.0-FHVSHG)*WTGRB(NB,NZ,NY,NX) - WTHNH2=WTHNH2+(1.0-FHVSHH)*WTHSBN(NB,NZ,NY,NX)+(1.0-FHVSHE) - 2*WTEABN(NB,NZ,NY,NX)+(1.0-FHVSHG)*WTGRBN(NB,NZ,NY,NX) - WTHPH2=WTHPH2+(1.0-FHVSHH)*WTHSBP(NB,NZ,NY,NX)+(1.0-FHVSHE) - 2*WTEABP(NB,NZ,NY,NX)+(1.0-FHVSHG)*WTGRBP(NB,NZ,NY,NX) - WTHTX2=WTHTX2+(FHVSHH-FHVSTH)*WTHSKB(NB,NZ,NY,NX)+(FHVSHE-FHVSTE) - 2*WTEARB(NB,NZ,NY,NX)+(FHVSHG-FHVSTG)*WTGRB(NB,NZ,NY,NX) - WTHNX2=WTHNX2+(FHVSHH-FHVSTH)*WTHSBN(NB,NZ,NY,NX)+(FHVSHE-FHVSTE) - 2*WTEABN(NB,NZ,NY,NX)+(FHVSHG-FHVSTG)*WTGRBN(NB,NZ,NY,NX) - WTHPX2=WTHPX2+(FHVSHH-FHVSTH)*WTHSBP(NB,NZ,NY,NX)+(FHVSHE-FHVSTE) - 2*WTEABP(NB,NZ,NY,NX)+(FHVSHG-FHVSTG)*WTGRBP(NB,NZ,NY,NX) - WTHTG=WTHTG+(1.0-FHVSTG)*WTGRB(NB,NZ,NY,NX) - WTHNG=WTHNG+(1.0-FHVSTG)*WTGRBN(NB,NZ,NY,NX) - WTHPG=WTHPG+(1.0-FHVSTG)*WTGRBP(NB,NZ,NY,NX) -C -C REMAINING REPRODUCTIVE C,N,P -C - WTHSKB(NB,NZ,NY,NX)=FHVSTH*WTHSKB(NB,NZ,NY,NX) - WTEARB(NB,NZ,NY,NX)=FHVSTE*WTEARB(NB,NZ,NY,NX) - WTGRB(NB,NZ,NY,NX)=FHVSTG*WTGRB(NB,NZ,NY,NX) - WTHSBN(NB,NZ,NY,NX)=FHVSTH*WTHSBN(NB,NZ,NY,NX) - WTEABN(NB,NZ,NY,NX)=FHVSTE*WTEABN(NB,NZ,NY,NX) - WTGRBN(NB,NZ,NY,NX)=FHVSTG*WTGRBN(NB,NZ,NY,NX) - WTHSBP(NB,NZ,NY,NX)=FHVSTH*WTHSBP(NB,NZ,NY,NX) - WTEABP(NB,NZ,NY,NX)=FHVSTE*WTEABP(NB,NZ,NY,NX) - WTGRBP(NB,NZ,NY,NX)=FHVSTG*WTGRBP(NB,NZ,NY,NX) - GRNXB(NB,NZ,NY,NX)=FHVSTG*GRNXB(NB,NZ,NY,NX) - GRNOB(NB,NZ,NY,NX)=FHVSTG*GRNOB(NB,NZ,NY,NX) - GRWTB(NB,NZ,NY,NX)=FHVSTG*GRWTB(NB,NZ,NY,NX) -C -C REMAINING TOTAL BRANCH C,N,P AND LEAF, STALK AREA -C - CPOOLK(NB,NZ,NY,NX)=0.0 - DO 1325 K=1,25 - CPOOLK(NB,NZ,NY,NX)=CPOOLK(NB,NZ,NY,NX) - 2+CPOOL3(K,NB,NZ,NY,NX)+CPOOL4(K,NB,NZ,NY,NX) - 2+CO2B(K,NB,NZ,NY,NX)+HCOB(K,NB,NZ,NY,NX) -1325 CONTINUE - WTLSB(NB,NZ,NY,NX)=AMAX1(0.0,WTLFB(NB,NZ,NY,NX) - 2+WTSHEB(NB,NZ,NY,NX)) - WTSHTB(NB,NZ,NY,NX)=AMAX1(0.0,WTLFB(NB,NZ,NY,NX) - 2+WTSHEB(NB,NZ,NY,NX)+WTSTKB(NB,NZ,NY,NX)+WTRSVB(NB,NZ,NY,NX) - 3+WTHSKB(NB,NZ,NY,NX)+WTEARB(NB,NZ,NY,NX)+WTGRB(NB,NZ,NY,NX) - 4+CPOOL(NB,NZ,NY,NX)+CPOOLK(NB,NZ,NY,NX)) - WTSHTN(NB,NZ,NY,NX)=AMAX1(0.0,WTLFBN(NB,NZ,NY,NX) - 2+WTSHBN(NB,NZ,NY,NX)+WTSTBN(NB,NZ,NY,NX)+WTRSBN(NB,NZ,NY,NX) - 3+WTHSBN(NB,NZ,NY,NX)+WTEABN(NB,NZ,NY,NX)+WTGRBN(NB,NZ,NY,NX) - 4+ZPOOL(NB,NZ,NY,NX)) - WTSHTP(NB,NZ,NY,NX)=AMAX1(0.0,WTLFBP(NB,NZ,NY,NX) - 2+WTSHBP(NB,NZ,NY,NX)+WTSTBP(NB,NZ,NY,NX)+WTRSBP(NB,NZ,NY,NX) - 3+WTHSBP(NB,NZ,NY,NX)+WTEABP(NB,NZ,NY,NX)+WTGRBP(NB,NZ,NY,NX) - 4+PPOOL(NB,NZ,NY,NX)) - VOLWPX=VOLWP(NZ,NY,NX) - WVPLT=AMAX1(0.0,WTLS(NZ,NY,NX)+WVSTK(NZ,NY,NX)) - APSILT=ABS(PSILT(NZ,NY,NX)) - FDM=0.16+0.10*APSILT/(0.05*APSILT+2.0) - VOLWP(NZ,NY,NX)=1.0E-06*WVPLT/FDM - VOLWOU=VOLWOU+VOLWPX-VOLWP(NZ,NY,NX) - UVOLO(NY,NX)=UVOLO(NY,NX)+VOLWPX-VOLWP(NZ,NY,NX) -C -C RESET PHENOLOGY, GROWTH STAGE IF STALKS ARE CUT -C - IF((IBTYP(NZ,NY,NX).EQ.0.OR.IGTYP(NZ,NY,NX).LE.1) - 2.AND.(IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6) - 3.AND.ZC(NZ,NY,NX).GT.HVST(NZ,I,NY,NX))THEN - IF((IWTYP(NZ,NY,NX).NE.0 - 2.AND.VRNF(NB,NZ,NY,NX).LE.FVRN*VRNX(NB,NZ,NY,NX)) - 3.OR.(IWTYP(NZ,NY,NX).EQ.0 - 4.AND.IDAY(1,NB,NZ,NY,NX).NE.0))THEN - GROUP(NB,NZ,NY,NX)=GROUPI(NZ,NY,NX) - PSTGI(NB,NZ,NY,NX)=PSTG(NB,NZ,NY,NX) - PSTGF(NB,NZ,NY,NX)=0.0 - VSTGX(NB,NZ,NY,NX)=0.0 - TGSTGI(NB,NZ,NY,NX)=0.0 - TGSTGF(NB,NZ,NY,NX)=0.0 - FLG4(NB,NZ,NY,NX)=0.0 - IDAY(1,NB,NZ,NY,NX)=I - DO 3005 M=2,10 - IDAY(M,NB,NZ,NY,NX)=0 -3005 CONTINUE - IFLGA(NB,NZ,NY,NX)=0 - IF(NB.EQ.NB1(NZ,NY,NX))THEN - DO 3010 NBX=1,NBR(NZ,NY,NX) - IF(NBX.NE.NB1(NZ,NY,NX))THEN - GROUP(NBX,NZ,NY,NX)=GROUPI(NZ,NY,NX) - PSTGI(NBX,NZ,NY,NX)=PSTG(NBX,NZ,NY,NX) - PSTGF(NBX,NZ,NY,NX)=0.0 - VSTGX(NBX,NZ,NY,NX)=0.0 - TGSTGI(NBX,NZ,NY,NX)=0.0 - TGSTGF(NBX,NZ,NY,NX)=0.0 - FLG4(NBX,NZ,NY,NX)=0.0 - IDAY(1,NBX,NZ,NY,NX)=I - DO 3015 M=2,10 - IDAY(M,NBX,NZ,NY,NX)=0 -3015 CONTINUE - IFLGA(NBX,NZ,NY,NX)=0 - ENDIF -3010 CONTINUE - ENDIF - ENDIF - ENDIF -C -C DEATH OF BRANCH IF KILLING HARVEST ENTERED IN 'READQ' -C - IF(JHVST(NZ,I,NY,NX).NE.0)IDTHB(NB,NZ,NY,NX)=1 - IF(PP(NZ,NY,NX).LE.0.0)IDTHB(NB,NZ,NY,NX)=1 -9835 CONTINUE - WTLS(NZ,NY,NX)=0.0 - WTSTK(NZ,NY,NX)=0.0 - WVSTK(NZ,NY,NX)=0.0 - ARSTP(NZ,NY,NX)=0.0 - DO 9840 NB=1,NBR(NZ,NY,NX) - WTLS(NZ,NY,NX)=WTLS(NZ,NY,NX)+WTLSB(NB,NZ,NY,NX) - WTSTK(NZ,NY,NX)=WTSTK(NZ,NY,NX)+WTSTKB(NB,NZ,NY,NX) - WVSTK(NZ,NY,NX)=WVSTK(NZ,NY,NX)+WVSTKB(NB,NZ,NY,NX) - DO 9830 L=1,JC - ARSTP(NZ,NY,NX)=ARSTP(NZ,NY,NX)+ARSTK(L,NB,NZ,NY,NX) -9830 CONTINUE -9840 CONTINUE -C -C ROOT LITTERFALL FROM HARVESTING OR FIRE -C - IF(IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6)THEN - XHVST=1.0-THIN(NZ,I,NY,NX) - DO 3985 N=1,MY(NZ,NY,NX) - DO 3980 L=NU(NY,NX),NJ(NY,NX) - IF(IHVST(NZ,I,NY,NX).NE.5)THEN - XHVST=1.0-THIN(NZ,I,NY,NX) - XHVSN=XHVST - XHVSP=XHVST - FFIRE=0.0 - FFIRN=0.0 - FFIRP=0.0 - ELSE - IF(THETW(L,NY,NX).GT.FVLWB.OR.CORGC(L,NY,NX).LE.FORGC)THEN - XHVST=1.0 - XHVSN=XHVST - XHVSP=XHVST - FFIRE=0.0 - FFIRN=0.0 - FFIRP=0.0 - ELSE - XHVST=1.0-EHVST(1,3,NZ,I,NY,NX)*AMIN1(1.0,(CORGC(L,NY,NX)-FORGC) - 2/(0.5E+06-FORGC)) - XHVSN=XHVST - XHVSP=XHVST - FFIRE=EHVST(2,3,NZ,I,NY,NX) - FFIRN=FFIRE*EFIRE(1,IHVST(NZ,I,NY,NX)) - FFIRP=FFIRE*EFIRE(2,IHVST(NZ,I,NY,NX)) - ENDIF - ENDIF - DO 3385 M=1,4 - FHVST=(1.0-XHVST)*CFOPC(0,M,NZ,NY,NX)*CPOOLR(N,L,NZ,NY,NX) - FHVSN=(1.0-XHVSN)*CFOPN(0,M,NZ,NY,NX)*ZPOOLR(N,L,NZ,NY,NX) - FHVSP=(1.0-XHVSP)*CFOPP(0,M,NZ,NY,NX)*PPOOLR(N,L,NZ,NY,NX) - CSNC(M,1,L,NZ,NY,NX)=CSNC(M,1,L,NZ,NY,NX)+(1.0-FFIRE)*FHVST - ZSNC(M,1,L,NZ,NY,NX)=ZSNC(M,1,L,NZ,NY,NX)+(1.0-FFIRN)*FHVSN - PSNC(M,1,L,NZ,NY,NX)=PSNC(M,1,L,NZ,NY,NX)+(1.0-FFIRP)*FHVSP - VCO2F(NZ,NY,NX)=VCO2F(NZ,NY,NX)-(1.0-FCH4F)*FFIRE*FHVST - VCH4F(NZ,NY,NX)=VCH4F(NZ,NY,NX)-FCH4F*FFIRE*FHVST - VOXYF(NZ,NY,NX)=VOXYF(NZ,NY,NX)-(1.0-FCH4F)*FFIRE*FHVST*2.667 - VNH3F(NZ,NY,NX)=VNH3F(NZ,NY,NX)-FFIRN*FHVSN - VN2OF(NZ,NY,NX)=VN2OF(NZ,NY,NX)-0.0 - VPO4F(NZ,NY,NX)=VPO4F(NZ,NY,NX)-FFIRP*FHVSP - CNET(NZ,NY,NX)=CNET(NZ,NY,NX)-(1.0-FCH4F)*FFIRE*FHVST - TNBP(NY,NX)=TNBP(NY,NX)-FCH4F*FFIRE*FHVST - DO 3385 NR=1,NRT(NZ,NY,NX) - FHVST=(1.0-XHVST)*CFOPC(5,M,NZ,NY,NX)*(WTRT1(N,L,NR,NZ,NY,NX) - 3+WTRT2(N,L,NR,NZ,NY,NX))*FWOOD(0) - FHVSN=(1.0-XHVSN)*CFOPN(5,M,NZ,NY,NX)*(WTRT1N(N,L,NR,NZ,NY,NX) - 3+WTRT2N(N,L,NR,NZ,NY,NX))*FWOODN(0) - FHVSP=(1.0-XHVSP)*CFOPP(5,M,NZ,NY,NX)*(WTRT1P(N,L,NR,NZ,NY,NX) - 3+WTRT2P(N,L,NR,NZ,NY,NX))*FWOODP(0) - CSNC(M,1,L,NZ,NY,NX)=CSNC(M,1,L,NZ,NY,NX)+(1.0-FFIRE)*FHVST - ZSNC(M,1,L,NZ,NY,NX)=ZSNC(M,1,L,NZ,NY,NX)+(1.0-FFIRN)*FHVSN - PSNC(M,1,L,NZ,NY,NX)=PSNC(M,1,L,NZ,NY,NX)+(1.0-FFIRP)*FHVSP - VCO2F(NZ,NY,NX)=VCO2F(NZ,NY,NX)-(1.0-FCH4F)*FFIRE*FHVST - VCH4F(NZ,NY,NX)=VCH4F(NZ,NY,NX)-FCH4F*FFIRE*FHVST - VOXYF(NZ,NY,NX)=VOXYF(NZ,NY,NX)-(1.0-FCH4F)*FFIRE*FHVST*2.667 - VNH3F(NZ,NY,NX)=VNH3F(NZ,NY,NX)-FFIRN*FHVSN - VN2OF(NZ,NY,NX)=VN2OF(NZ,NY,NX)-0.0 - VPO4F(NZ,NY,NX)=VPO4F(NZ,NY,NX)-FFIRP*FHVSP - CNET(NZ,NY,NX)=CNET(NZ,NY,NX)-(1.0-FCH4F)*FFIRE*FHVST - TNBP(NY,NX)=TNBP(NY,NX)-FCH4F*FFIRE*FHVST - FHVST=(1.0-XHVST)*CFOPC(4,M,NZ,NY,NX)*(WTRT1(N,L,NR,NZ,NY,NX) - 3+WTRT2(N,L,NR,NZ,NY,NX))*FWOOD(1) - FHVSN=(1.0-XHVSN)*CFOPN(4,M,NZ,NY,NX)*(WTRT1N(N,L,NR,NZ,NY,NX) - 3+WTRT2N(N,L,NR,NZ,NY,NX))*FWOODN(1) - FHVSP=(1.0-XHVSP)*CFOPP(4,M,NZ,NY,NX)*(WTRT1P(N,L,NR,NZ,NY,NX) - 3+WTRT2P(N,L,NR,NZ,NY,NX))*FWOODP(1) - CSNC(M,1,L,NZ,NY,NX)=CSNC(M,1,L,NZ,NY,NX)+(1.0-FFIRE)*FHVST - ZSNC(M,1,L,NZ,NY,NX)=ZSNC(M,1,L,NZ,NY,NX)+(1.0-FFIRN)*FHVSN - PSNC(M,1,L,NZ,NY,NX)=PSNC(M,1,L,NZ,NY,NX)+(1.0-FFIRP)*FHVSP - VCO2F(NZ,NY,NX)=VCO2F(NZ,NY,NX)-(1.0-FCH4F)*FFIRE*FHVST - VCH4F(NZ,NY,NX)=VCH4F(NZ,NY,NX)-FCH4F*FFIRE*FHVST - VOXYF(NZ,NY,NX)=VOXYF(NZ,NY,NX)-(1.0-FCH4F)*FFIRE*FHVST*2.667 - VNH3F(NZ,NY,NX)=VNH3F(NZ,NY,NX)-FFIRN*FHVSN - VN2OF(NZ,NY,NX)=VN2OF(NZ,NY,NX)-0.0 - VPO4F(NZ,NY,NX)=VPO4F(NZ,NY,NX)-FFIRP*FHVSP - CNET(NZ,NY,NX)=CNET(NZ,NY,NX)-(1.0-FCH4F)*FFIRE*FHVST - TNBP(NY,NX)=TNBP(NY,NX)-FCH4F*FFIRE*FHVST -3385 CONTINUE -C WRITE(*,6161)'FIRE',I,J,NZ,L,N,M,VCO2F(NZ,NY,NX),FFIRE -C 2,FHVST,CFOPC(4,M,NZ,NY,NX),CPOOLR(N,L,NZ,NY,NX),THETW(L,NY,NX) -C 3,CORGC(L,NY,NX) -6161 FORMAT(A8,6I4,20E12.4) -C -C RELEASE ROOT GAS CONTENTS DURING HARVESTING -C - RCO2Z(NZ,NY,NX)=RCO2Z(NZ,NY,NX)-(1.0-XHVST) - 2*(CO2A(N,L,NZ,NY,NX)+CO2P(N,L,NZ,NY,NX)) - ROXYZ(NZ,NY,NX)=ROXYZ(NZ,NY,NX)-(1.0-XHVST) - 2*(OXYA(N,L,NZ,NY,NX)+OXYP(N,L,NZ,NY,NX)) - RCH4Z(NZ,NY,NX)=RCH4Z(NZ,NY,NX)-(1.0-XHVST) - 2*(CH4A(N,L,NZ,NY,NX)+CH4P(N,L,NZ,NY,NX)) - RN2OZ(NZ,NY,NX)=RN2OZ(NZ,NY,NX)-(1.0-XHVST) - 2*(Z2OA(N,L,NZ,NY,NX)+Z2OP(N,L,NZ,NY,NX)) - RNH3Z(NZ,NY,NX)=RNH3Z(NZ,NY,NX)-(1.0-XHVST) - 2*(ZH3A(N,L,NZ,NY,NX)+ZH3P(N,L,NZ,NY,NX)) - RH2GZ(NZ,NY,NX)=RH2GZ(NZ,NY,NX)-(1.0-XHVST) - 2*(H2GA(N,L,NZ,NY,NX)+H2GP(N,L,NZ,NY,NX)) - CO2A(N,L,NZ,NY,NX)=XHVST*CO2A(N,L,NZ,NY,NX) - OXYA(N,L,NZ,NY,NX)=XHVST*OXYA(N,L,NZ,NY,NX) - CH4A(N,L,NZ,NY,NX)=XHVST*CH4A(N,L,NZ,NY,NX) - Z2OA(N,L,NZ,NY,NX)=XHVST*Z2OA(N,L,NZ,NY,NX) - ZH3A(N,L,NZ,NY,NX)=XHVST*ZH3A(N,L,NZ,NY,NX) - H2GA(N,L,NZ,NY,NX)=XHVST*H2GA(N,L,NZ,NY,NX) - CO2P(N,L,NZ,NY,NX)=XHVST*CO2P(N,L,NZ,NY,NX) - OXYP(N,L,NZ,NY,NX)=XHVST*OXYP(N,L,NZ,NY,NX) - CH4P(N,L,NZ,NY,NX)=XHVST*CH4P(N,L,NZ,NY,NX) - Z2OP(N,L,NZ,NY,NX)=XHVST*Z2OP(N,L,NZ,NY,NX) - ZH3P(N,L,NZ,NY,NX)=XHVST*ZH3P(N,L,NZ,NY,NX) - H2GP(N,L,NZ,NY,NX)=XHVST*H2GP(N,L,NZ,NY,NX) -C -C REDUCE ROOT STATE VARIABLES DURING HARVESTING -C - DO 3960 NR=1,NRT(NZ,NY,NX) - WTRT1(N,L,NR,NZ,NY,NX)=WTRT1(N,L,NR,NZ,NY,NX)*XHVST - WTRT2(N,L,NR,NZ,NY,NX)=WTRT2(N,L,NR,NZ,NY,NX)*XHVST - WTRT1N(N,L,NR,NZ,NY,NX)=WTRT1N(N,L,NR,NZ,NY,NX)*XHVST - WTRT2N(N,L,NR,NZ,NY,NX)=WTRT2N(N,L,NR,NZ,NY,NX)*XHVST - WTRT1P(N,L,NR,NZ,NY,NX)=WTRT1P(N,L,NR,NZ,NY,NX)*XHVST - WTRT2P(N,L,NR,NZ,NY,NX)=WTRT2P(N,L,NR,NZ,NY,NX)*XHVST - RTWT1(N,NR,NZ,NY,NX)=RTWT1(N,NR,NZ,NY,NX)*XHVST - RTWT1N(N,NR,NZ,NY,NX)=RTWT1N(N,NR,NZ,NY,NX)*XHVST - RTWT1P(N,NR,NZ,NY,NX)=RTWT1P(N,NR,NZ,NY,NX)*XHVST - RTLG1(N,L,NR,NZ,NY,NX)=RTLG1(N,L,NR,NZ,NY,NX)*XHVST - RTLG2(N,L,NR,NZ,NY,NX)=RTLG2(N,L,NR,NZ,NY,NX)*XHVST - RTN2(N,L,NR,NZ,NY,NX)=RTN2(N,L,NR,NZ,NY,NX)*XHVST -3960 CONTINUE - CPOOLR(N,L,NZ,NY,NX)=CPOOLR(N,L,NZ,NY,NX)*XHVST - ZPOOLR(N,L,NZ,NY,NX)=ZPOOLR(N,L,NZ,NY,NX)*XHVST - PPOOLR(N,L,NZ,NY,NX)=PPOOLR(N,L,NZ,NY,NX)*XHVST - WTRTL(N,L,NZ,NY,NX)=WTRTL(N,L,NZ,NY,NX)*XHVST - WTRTD(N,L,NZ,NY,NX)=WTRTD(N,L,NZ,NY,NX)*XHVST - WSRTL(N,L,NZ,NY,NX)=WSRTL(N,L,NZ,NY,NX)*XHVST - RTN1(N,L,NZ,NY,NX)=RTN1(N,L,NZ,NY,NX)*XHVST - RTNL(N,L,NZ,NY,NX)=RTNL(N,L,NZ,NY,NX)*XHVST - RTLGP(N,L,NZ,NY,NX)=RTLGP(N,L,NZ,NY,NX)*XHVST - RTDNP(N,L,NZ,NY,NX)=RTDNP(N,L,NZ,NY,NX)*XHVST - RTVLP(N,L,NZ,NY,NX)=RTVLP(N,L,NZ,NY,NX)*XHVST - RTVLW(N,L,NZ,NY,NX)=RTVLW(N,L,NZ,NY,NX)*XHVST - RTARP(N,L,NZ,NY,NX)=RTARP(N,L,NZ,NY,NX)*XHVST - RCO2M(N,L,NZ,NY,NX)=RCO2M(N,L,NZ,NY,NX)*XHVST - RCO2N(N,L,NZ,NY,NX)=RCO2N(N,L,NZ,NY,NX)*XHVST - RCO2A(N,L,NZ,NY,NX)=RCO2A(N,L,NZ,NY,NX)*XHVST -C -C NODULE LITTERFALL AND STATE VARIABLES DURING HARVESTING -C - IF(INTYP(NZ,NY,NX).NE.0.AND.N.EQ.1)THEN - DO 3395 M=1,4 - CSNC(M,1,L,NZ,NY,NX)=CSNC(M,1,L,NZ,NY,NX)+(1.0-XHVST) - 2*(CFOPC(4,M,NZ,NY,NX)*WTNDL(L,NZ,NY,NX) - 3+CFOPC(0,M,NZ,NY,NX)*CPOOLN(L,NZ,NY,NX)) - ZSNC(M,1,L,NZ,NY,NX)=ZSNC(M,1,L,NZ,NY,NX)+(1.0-XHVST) - 2*(CFOPN(4,M,NZ,NY,NX)*WTNDLN(L,NZ,NY,NX) - 3+CFOPN(0,M,NZ,NY,NX)*ZPOOLN(L,NZ,NY,NX)) - PSNC(M,1,L,NZ,NY,NX)=PSNC(M,1,L,NZ,NY,NX)+(1.0-XHVST) - 2*(CFOPP(4,M,NZ,NY,NX)*WTNDLP(L,NZ,NY,NX) - 3+CFOPP(0,M,NZ,NY,NX)*PPOOLN(L,NZ,NY,NX)) -3395 CONTINUE - WTNDL(L,NZ,NY,NX)=WTNDL(L,NZ,NY,NX)*XHVST - WTNDLN(L,NZ,NY,NX)=WTNDLN(L,NZ,NY,NX)*XHVST - WTNDLP(L,NZ,NY,NX)=WTNDLP(L,NZ,NY,NX)*XHVST - CPOOLN(L,NZ,NY,NX)=CPOOLN(L,NZ,NY,NX)*XHVST - ZPOOLN(L,NZ,NY,NX)=ZPOOLN(L,NZ,NY,NX)*XHVST - PPOOLN(L,NZ,NY,NX)=PPOOLN(L,NZ,NY,NX)*XHVST - ENDIF -3980 CONTINUE -3985 CONTINUE -C -C STORAGE LITTERFALL AND STATE VARIABLES DURING HARVESTING -C - IF(ISTYP(NZ,NY,NX).NE.0)THEN - DO 3400 M=1,4 - CSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX)=CSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX) - 2+((1.0-XHVST)*CFOPC(0,M,NZ,NY,NX)*WTRVC(NZ,NY,NX))*FWOOD(0) - ZSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX)=ZSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX) - 2+((1.0-XHVST)*CFOPN(0,M,NZ,NY,NX)*WTRVN(NZ,NY,NX))*FWOODN(0) - PSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX)=PSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX) - 2+((1.0-XHVST)*CFOPP(0,M,NZ,NY,NX)*WTRVP(NZ,NY,NX))*FWOODP(0) - CSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX)=CSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX) - 2+((1.0-XHVST)*CFOPC(0,M,NZ,NY,NX)*WTRVC(NZ,NY,NX))*FWOOD(1) - ZSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX)=ZSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX) - 2+((1.0-XHVST)*CFOPN(0,M,NZ,NY,NX)*WTRVN(NZ,NY,NX))*FWOODN(1) - PSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX)=PSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX) - 2+((1.0-XHVST)*CFOPP(0,M,NZ,NY,NX)*WTRVP(NZ,NY,NX))*FWOODP(1) -3400 CONTINUE - WTRVC(NZ,NY,NX)=WTRVC(NZ,NY,NX)*XHVST - WTRVN(NZ,NY,NX)=WTRVN(NZ,NY,NX)*XHVST - WTRVP(NZ,NY,NX)=WTRVP(NZ,NY,NX)*XHVST - ENDIF - ENDIF - ENDIF -C -C REDUCE OR REMOVE PLANT POPULATIONS DURING TILLAGE -C - IF(J.EQ.INT(ZNOON(NY,NX)).AND.(IBTYP(NZ,NY,NX).EQ.0 - 2.OR.IGTYP(NZ,NY,NX).LE.1).AND.(I.NE.IDAY0(NZ,NY,NX) - 3.OR.IDATA(3).NE.IYR0(NZ,NY,NX)))THEN - IF(XCORP(NY,NX).LT.1.0.AND.ITILL(I,NY,NX).NE.19)THEN - IF(I.GT.IDAY0(NZ,NY,NX).OR.IYRC.GT.IYR0(NZ,NY,NX))THEN - XHVST=XCORP(NY,NX) - PPX(NZ,NY,NX)=PPX(NZ,NY,NX)*XHVST - PP(NZ,NY,NX)=PP(NZ,NY,NX)*XHVST - FRADP(NZ,NY,NX)=FRADP(NZ,NY,NX)*XHVST - VHCPC(NZ,NY,NX)=VHCPC(NZ,NY,NX)*XHVST - WTLS(NZ,NY,NX)=0.0 - WVSTK(NZ,NY,NX)=0.0 -C -C TERMINATE BRANCHES IF TILLAGE IMPLEMENT 20 IS SELECTED -C - DO 8975 NB=1,NBR(NZ,NY,NX) - IF(IDTHB(NB,NZ,NY,NX).EQ.0)THEN - IF(XHVST.LE.1.0E-03)THEN - IDTHB(NB,NZ,NY,NX)=1 - ENDIF -C -C LITTERFALL FROM BRANCHES DURING TILLAGE -C - DO 6380 M=1,4 - CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX)+(1.0-XHVST) - 2*(CFOPC(0,M,NZ,NY,NX)*(CPOOL(NB,NZ,NY,NX)+CPOLNB(NB,NZ,NY,NX) - 3+CPOOLK(NB,NZ,NY,NX)+WTRSVB(NB,NZ,NY,NX)) - 4+CFOPC(1,M,NZ,NY,NX)*(WTLFB(NB,NZ,NY,NX)*FWODB(1) - 5+WTNDB(NB,NZ,NY,NX)) - 6+CFOPC(2,M,NZ,NY,NX)*(WTSHEB(NB,NZ,NY,NX)*FWODB(1) - 7+WTHSKB(NB,NZ,NY,NX)+WTEARB(NB,NZ,NY,NX))) - CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX)+(1.0-XHVST) - 2*CFOPC(5,M,NZ,NY,NX)*(WTLFB(NB,NZ,NY,NX)*FWODB(0) - 3+WTSHEB(NB,NZ,NY,NX)*FWODB(0)) - ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX)+(1.0-XHVST) - 2*(CFOPN(0,M,NZ,NY,NX)*(ZPOOL(NB,NZ,NY,NX)+ZPOLNB(NB,NZ,NY,NX) - 3+WTRSBN(NB,NZ,NY,NX)) - 4+CFOPN(1,M,NZ,NY,NX)*(WTLFBN(NB,NZ,NY,NX)*FWODLN(1) - 5+WTNDBN(NB,NZ,NY,NX)) - 6+CFOPN(2,M,NZ,NY,NX)*(WTSHBN(NB,NZ,NY,NX)*FWODSN(1) - 7+WTHSBN(NB,NZ,NY,NX)+WTEABN(NB,NZ,NY,NX))) - ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX)+(1.0-XHVST) - 2*CFOPN(5,M,NZ,NY,NX)*(WTLFBN(NB,NZ,NY,NX)*FWODLN(0) - 3+WTSHBN(NB,NZ,NY,NX)*FWODSN(0)) - PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX)+(1.0-XHVST) - 2*(CFOPP(0,M,NZ,NY,NX)*(PPOOL(NB,NZ,NY,NX)+PPOLNB(NB,NZ,NY,NX) - 3+WTRSBP(NB,NZ,NY,NX)) - 4+CFOPP(1,M,NZ,NY,NX)*(WTLFBP(NB,NZ,NY,NX)*FWODLP(1) - 5+WTNDBP(NB,NZ,NY,NX)) - 6+CFOPP(2,M,NZ,NY,NX)*(WTSHBP(NB,NZ,NY,NX)*FWODSP(1) - 7+WTHSBP(NB,NZ,NY,NX)+WTEABP(NB,NZ,NY,NX))) - PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX)+(1.0-XHVST) - 2*CFOPP(5,M,NZ,NY,NX)*(WTLFBP(NB,NZ,NY,NX)*FWODLP(0) - 3+WTSHBP(NB,NZ,NY,NX)*FWODSP(0)) - IF(ISTYP(NZ,NY,NX).EQ.0.AND.IWTYP(NZ,NY,NX).NE.0)THEN - WTRVC(NZ,NY,NX)=WTRVC(NZ,NY,NX)+(1.0-XHVST) - 2*CFOPC(2,M,NZ,NY,NX)*WTGRB(NB,NZ,NY,NX) - WTRVN(NZ,NY,NX)=WTRVN(NZ,NY,NX)+(1.0-XHVST) - 2*CFOPN(2,M,NZ,NY,NX)*WTGRBN(NB,NZ,NY,NX) - WTRVP(NZ,NY,NX)=WTRVP(NZ,NY,NX)+(1.0-XHVST) - 2*CFOPP(2,M,NZ,NY,NX)*WTGRBP(NB,NZ,NY,NX) - ELSE - CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX)+(1.0-XHVST) - 2*CFOPC(2,M,NZ,NY,NX)*WTGRB(NB,NZ,NY,NX) - ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX)+(1.0-XHVST) - 2*CFOPN(2,M,NZ,NY,NX)*WTGRBN(NB,NZ,NY,NX) - PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX)+(1.0-XHVST) - 2*CFOPP(2,M,NZ,NY,NX)*WTGRBP(NB,NZ,NY,NX) - ENDIF - IF(IBTYP(NZ,NY,NX).EQ.0.OR.IGTYP(NZ,NY,NX).LE.1)THEN - CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX)+(1.0-XHVST) - 2*CFOPC(3,M,NZ,NY,NX)*WTSTKB(NB,NZ,NY,NX) - ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX)+(1.0-XHVST) - 2*CFOPN(3,M,NZ,NY,NX)*WTSTBN(NB,NZ,NY,NX) - PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX)+(1.0-XHVST) - 2*CFOPP(3,M,NZ,NY,NX)*WTSTBP(NB,NZ,NY,NX) - ELSE - CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX)+(1.0-XHVST) - 2*CFOPC(5,M,NZ,NY,NX)*WTSTKB(NB,NZ,NY,NX) - ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX)+(1.0-XHVST) - 2*CFOPN(5,M,NZ,NY,NX)*WTSTBN(NB,NZ,NY,NX) - PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX)+(1.0-XHVST) - 2*CFOPP(5,M,NZ,NY,NX)*WTSTBP(NB,NZ,NY,NX) - ENDIF -6380 CONTINUE -C -C REDUCE PLANT STATE VARIABLES DURING TILLAGE -C - CPOOL(NB,NZ,NY,NX)=CPOOL(NB,NZ,NY,NX)*XHVST - CPOOLK(NB,NZ,NY,NX)=CPOOLK(NB,NZ,NY,NX)*XHVST - ZPOOL(NB,NZ,NY,NX)=ZPOOL(NB,NZ,NY,NX)*XHVST - PPOOL(NB,NZ,NY,NX)=PPOOL(NB,NZ,NY,NX)*XHVST - CPOLNB(NB,NZ,NY,NX)=CPOLNB(NB,NZ,NY,NX)*XHVST - ZPOLNB(NB,NZ,NY,NX)=ZPOLNB(NB,NZ,NY,NX)*XHVST - PPOLNB(NB,NZ,NY,NX)=PPOLNB(NB,NZ,NY,NX)*XHVST - WTSHTB(NB,NZ,NY,NX)=WTSHTB(NB,NZ,NY,NX)*XHVST - WTLFB(NB,NZ,NY,NX)=WTLFB(NB,NZ,NY,NX)*XHVST - WTNDB(NB,NZ,NY,NX)=WTNDB(NB,NZ,NY,NX)*XHVST - WTSHEB(NB,NZ,NY,NX)=WTSHEB(NB,NZ,NY,NX)*XHVST - WTSTKB(NB,NZ,NY,NX)=WTSTKB(NB,NZ,NY,NX)*XHVST - WVSTKB(NB,NZ,NY,NX)=WVSTKB(NB,NZ,NY,NX)*XHVST - WTRSVB(NB,NZ,NY,NX)=WTRSVB(NB,NZ,NY,NX)*XHVST - WTHSKB(NB,NZ,NY,NX)=WTHSKB(NB,NZ,NY,NX)*XHVST - WTEARB(NB,NZ,NY,NX)=WTEARB(NB,NZ,NY,NX)*XHVST - WTGRB(NB,NZ,NY,NX)=WTGRB(NB,NZ,NY,NX)*XHVST - WTSHTN(NB,NZ,NY,NX)=WTSHTN(NB,NZ,NY,NX)*XHVST - WTLFBN(NB,NZ,NY,NX)=WTLFBN(NB,NZ,NY,NX)*XHVST - WTNDBN(NB,NZ,NY,NX)=WTNDBN(NB,NZ,NY,NX)*XHVST - WTSHBN(NB,NZ,NY,NX)=WTSHBN(NB,NZ,NY,NX)*XHVST - WTSTBN(NB,NZ,NY,NX)=WTSTBN(NB,NZ,NY,NX)*XHVST - WTRSBN(NB,NZ,NY,NX)=WTRSBN(NB,NZ,NY,NX)*XHVST - WTHSBN(NB,NZ,NY,NX)=WTHSBN(NB,NZ,NY,NX)*XHVST - WTEABN(NB,NZ,NY,NX)=WTEABN(NB,NZ,NY,NX)*XHVST - WTGRBN(NB,NZ,NY,NX)=WTGRBN(NB,NZ,NY,NX)*XHVST - WTSHTP(NB,NZ,NY,NX)=WTSHTP(NB,NZ,NY,NX)*XHVST - WTLFBP(NB,NZ,NY,NX)=WTLFBP(NB,NZ,NY,NX)*XHVST - WTNDBP(NB,NZ,NY,NX)=WTNDBP(NB,NZ,NY,NX)*XHVST - WTSHBP(NB,NZ,NY,NX)=WTSHBP(NB,NZ,NY,NX)*XHVST - WTSTBP(NB,NZ,NY,NX)=WTSTBP(NB,NZ,NY,NX)*XHVST - WTRSBP(NB,NZ,NY,NX)=WTRSBP(NB,NZ,NY,NX)*XHVST - WTHSBP(NB,NZ,NY,NX)=WTHSBP(NB,NZ,NY,NX)*XHVST - WTEABP(NB,NZ,NY,NX)=WTEABP(NB,NZ,NY,NX)*XHVST - WTGRBP(NB,NZ,NY,NX)=WTGRBP(NB,NZ,NY,NX)*XHVST - GRNXB(NB,NZ,NY,NX)=GRNXB(NB,NZ,NY,NX)*XHVST - GRNOB(NB,NZ,NY,NX)=GRNOB(NB,NZ,NY,NX)*XHVST - GRWTB(NB,NZ,NY,NX)=GRWTB(NB,NZ,NY,NX)*XHVST - ARLFB(NB,NZ,NY,NX)=ARLFB(NB,NZ,NY,NX)*XHVST - WTLSB(NB,NZ,NY,NX)=AMAX1(0.0,WTLFB(NB,NZ,NY,NX) - 2+WTSHEB(NB,NZ,NY,NX)) - WTLS(NZ,NY,NX)=WTLS(NZ,NY,NX)+WTLSB(NB,NZ,NY,NX) - WTSTXB(NB,NZ,NY,NX)=WTSTXB(NB,NZ,NY,NX)*XHVST - WTSTXN(NB,NZ,NY,NX)=WTSTXN(NB,NZ,NY,NX)*XHVST - WTSTXP(NB,NZ,NY,NX)=WTSTXP(NB,NZ,NY,NX)*XHVST - WVSTK(NZ,NY,NX)=WVSTK(NZ,NY,NX)+WVSTKB(NB,NZ,NY,NX) - DO 8970 K=0,25 - IF(K.NE.0)THEN - CPOOL3(K,NB,NZ,NY,NX)=CPOOL3(K,NB,NZ,NY,NX)*XHVST - CPOOL4(K,NB,NZ,NY,NX)=CPOOL4(K,NB,NZ,NY,NX)*XHVST - CO2B(K,NB,NZ,NY,NX)=CO2B(K,NB,NZ,NY,NX)*XHVST - HCOB(K,NB,NZ,NY,NX)=HCOB(K,NB,NZ,NY,NX)*XHVST - ENDIF - ARLF(K,NB,NZ,NY,NX)=ARLF(K,NB,NZ,NY,NX)*XHVST - WGLF(K,NB,NZ,NY,NX)=WGLF(K,NB,NZ,NY,NX)*XHVST - WSLF(K,NB,NZ,NY,NX)=WSLF(K,NB,NZ,NY,NX)*XHVST -C HTSHE(K,NB,NZ,NY,NX)=HTSHE(K,NB,NZ,NY,NX)*XHVST - WGSHE(K,NB,NZ,NY,NX)=WGSHE(K,NB,NZ,NY,NX)*XHVST - WSSHE(K,NB,NZ,NY,NX)=WSSHE(K,NB,NZ,NY,NX)*XHVST -C HTNODE(K,NB,NZ,NY,NX)=HTNODE(K,NB,NZ,NY,NX)*XHVST -C HTNODX(K,NB,NZ,NY,NX)=HTNODX(K,NB,NZ,NY,NX)*XHVST - WGNODE(K,NB,NZ,NY,NX)=WGNODE(K,NB,NZ,NY,NX)*XHVST - WGLFN(K,NB,NZ,NY,NX)=WGLFN(K,NB,NZ,NY,NX)*XHVST - WGSHN(K,NB,NZ,NY,NX)=WGSHN(K,NB,NZ,NY,NX)*XHVST - WGNODN(K,NB,NZ,NY,NX)=WGNODN(K,NB,NZ,NY,NX)*XHVST - WGLFP(K,NB,NZ,NY,NX)=WGLFP(K,NB,NZ,NY,NX)*XHVST - WGSHP(K,NB,NZ,NY,NX)=WGSHP(K,NB,NZ,NY,NX)*XHVST - WGNODP(K,NB,NZ,NY,NX)=WGNODP(K,NB,NZ,NY,NX)*XHVST - DO 8965 L=1,JC - ARLFL(L,K,NB,NZ,NY,NX)=ARLFL(L,K,NB,NZ,NY,NX)*XHVST - WGLFL(L,K,NB,NZ,NY,NX)=WGLFL(L,K,NB,NZ,NY,NX)*XHVST - WGLFLN(L,K,NB,NZ,NY,NX)=WGLFLN(L,K,NB,NZ,NY,NX)*XHVST - WGLFLP(L,K,NB,NZ,NY,NX)=WGLFLP(L,K,NB,NZ,NY,NX)*XHVST -8965 CONTINUE -8970 CONTINUE - ENDIF -8975 CONTINUE - VOLWPX=VOLWP(NZ,NY,NX) - WVPLT=AMAX1(0.0,WTLS(NZ,NY,NX)+WVSTK(NZ,NY,NX)) - APSILT=ABS(PSILT(NZ,NY,NX)) - FDM=0.16+0.10*APSILT/(0.05*APSILT+2.0) - VOLWP(NZ,NY,NX)=1.0E-06*WVPLT/FDM - VOLWOU=VOLWOU+VOLWPX-VOLWP(NZ,NY,NX) - UVOLO(NY,NX)=UVOLO(NY,NX)+VOLWPX-VOLWP(NZ,NY,NX) -C -C TERMINATE ROOTS IF TILLAGE IMPLEMENT 20 IS SELECTED -C - IF(XHVST.LE.1.0E-03)THEN - IDTHR(NZ,NY,NX)=1 - IDTHP(NZ,NY,NX)=1 - JHVST(NZ,I,NY,NX)=1 - ENDIF -C -C LITTERFALL FROM ROOTS DURING TILLAGE -C - DO 8985 N=1,MY(NZ,NY,NX) - DO 8980 L=NU(NY,NX),NJ(NY,NX) - DO 6385 M=1,4 - CSNC(M,1,L,NZ,NY,NX)=CSNC(M,1,L,NZ,NY,NX)+(1.0-XHVST) - 2*CFOPC(0,M,NZ,NY,NX)*CPOOLR(N,L,NZ,NY,NX) - ZSNC(M,1,L,NZ,NY,NX)=ZSNC(M,1,L,NZ,NY,NX)+(1.0-XHVST) - 2*CFOPN(0,M,NZ,NY,NX)*ZPOOLR(N,L,NZ,NY,NX) - PSNC(M,1,L,NZ,NY,NX)=PSNC(M,1,L,NZ,NY,NX)+(1.0-XHVST) - 2*CFOPP(0,M,NZ,NY,NX)*PPOOLR(N,L,NZ,NY,NX) - DO 6385 NR=1,NRT(NZ,NY,NX) - CSNC(M,0,L,NZ,NY,NX)=CSNC(M,0,L,NZ,NY,NX)+(1.0-XHVST) - 2*CFOPC(5,M,NZ,NY,NX)*(WTRT1(N,L,NR,NZ,NY,NX) - 3+WTRT2(N,L,NR,NZ,NY,NX))*FWOOD(0) - ZSNC(M,0,L,NZ,NY,NX)=ZSNC(M,0,L,NZ,NY,NX)+(1.0-XHVST) - 2*CFOPN(5,M,NZ,NY,NX)*(WTRT1N(N,L,NR,NZ,NY,NX) - 3+WTRT2N(N,L,NR,NZ,NY,NX))*FWOODN(0) - PSNC(M,0,L,NZ,NY,NX)=PSNC(M,0,L,NZ,NY,NX)+(1.0-XHVST) - 2*CFOPP(5,M,NZ,NY,NX)*(WTRT1P(N,L,NR,NZ,NY,NX) - 3+WTRT2P(N,L,NR,NZ,NY,NX))*FWOODP(0) - CSNC(M,1,L,NZ,NY,NX)=CSNC(M,1,L,NZ,NY,NX)+(1.0-XHVST) - 2*CFOPC(4,M,NZ,NY,NX)*(WTRT1(N,L,NR,NZ,NY,NX) - 3+WTRT2(N,L,NR,NZ,NY,NX))*FWOOD(1) - ZSNC(M,1,L,NZ,NY,NX)=ZSNC(M,1,L,NZ,NY,NX)+(1.0-XHVST) - 2*CFOPN(4,M,NZ,NY,NX)*(WTRT1N(N,L,NR,NZ,NY,NX) - 3+WTRT2N(N,L,NR,NZ,NY,NX))*FWOODN(1) - PSNC(M,1,L,NZ,NY,NX)=PSNC(M,1,L,NZ,NY,NX)+(1.0-XHVST) - 2*CFOPP(4,M,NZ,NY,NX)*(WTRT1P(N,L,NR,NZ,NY,NX) - 3+WTRT2P(N,L,NR,NZ,NY,NX))*FWOODP(1) -6385 CONTINUE -C -C RELEASE ROOT GAS CONTENTS DURING TILLAGE -C - RCO2Z(NZ,NY,NX)=RCO2Z(NZ,NY,NX)-(1.0-XHVST) - 2*(CO2A(N,L,NZ,NY,NX)+CO2P(N,L,NZ,NY,NX)) - ROXYZ(NZ,NY,NX)=ROXYZ(NZ,NY,NX)-(1.0-XHVST) - 2*(OXYA(N,L,NZ,NY,NX)+OXYP(N,L,NZ,NY,NX)) - RCH4Z(NZ,NY,NX)=RCH4Z(NZ,NY,NX)-(1.0-XHVST) - 2*(CH4A(N,L,NZ,NY,NX)+CH4P(N,L,NZ,NY,NX)) - RN2OZ(NZ,NY,NX)=RN2OZ(NZ,NY,NX)-(1.0-XHVST) - 2*(Z2OA(N,L,NZ,NY,NX)+Z2OP(N,L,NZ,NY,NX)) - RNH3Z(NZ,NY,NX)=RNH3Z(NZ,NY,NX)-(1.0-XHVST) - 2*(ZH3A(N,L,NZ,NY,NX)+ZH3P(N,L,NZ,NY,NX)) - RH2GZ(NZ,NY,NX)=RH2GZ(NZ,NY,NX)-(1.0-XHVST) - 2*(H2GA(N,L,NZ,NY,NX)+H2GP(N,L,NZ,NY,NX)) - CO2A(N,L,NZ,NY,NX)=XHVST*CO2A(N,L,NZ,NY,NX) - OXYA(N,L,NZ,NY,NX)=XHVST*OXYA(N,L,NZ,NY,NX) - CH4A(N,L,NZ,NY,NX)=XHVST*CH4A(N,L,NZ,NY,NX) - Z2OA(N,L,NZ,NY,NX)=XHVST*Z2OA(N,L,NZ,NY,NX) - ZH3A(N,L,NZ,NY,NX)=XHVST*ZH3A(N,L,NZ,NY,NX) - H2GA(N,L,NZ,NY,NX)=XHVST*H2GA(N,L,NZ,NY,NX) - CO2P(N,L,NZ,NY,NX)=XHVST*CO2P(N,L,NZ,NY,NX) - OXYP(N,L,NZ,NY,NX)=XHVST*OXYP(N,L,NZ,NY,NX) - CH4P(N,L,NZ,NY,NX)=XHVST*CH4P(N,L,NZ,NY,NX) - Z2OP(N,L,NZ,NY,NX)=XHVST*Z2OP(N,L,NZ,NY,NX) - ZH3P(N,L,NZ,NY,NX)=XHVST*ZH3P(N,L,NZ,NY,NX) - H2GP(N,L,NZ,NY,NX)=XHVST*H2GP(N,L,NZ,NY,NX) -C -C REDUCE ROOT STATE VARIABLES DURING TILLAGE -C - DO 8960 NR=1,NRT(NZ,NY,NX) - WTRT1(N,L,NR,NZ,NY,NX)=WTRT1(N,L,NR,NZ,NY,NX)*XHVST - WTRT2(N,L,NR,NZ,NY,NX)=WTRT2(N,L,NR,NZ,NY,NX)*XHVST - WTRT1N(N,L,NR,NZ,NY,NX)=WTRT1N(N,L,NR,NZ,NY,NX)*XHVST - WTRT2N(N,L,NR,NZ,NY,NX)=WTRT2N(N,L,NR,NZ,NY,NX)*XHVST - WTRT1P(N,L,NR,NZ,NY,NX)=WTRT1P(N,L,NR,NZ,NY,NX)*XHVST - WTRT2P(N,L,NR,NZ,NY,NX)=WTRT2P(N,L,NR,NZ,NY,NX)*XHVST - RTWT1(N,NR,NZ,NY,NX)=RTWT1(N,NR,NZ,NY,NX)*XHVST - RTWT1N(N,NR,NZ,NY,NX)=RTWT1N(N,NR,NZ,NY,NX)*XHVST - RTWT1P(N,NR,NZ,NY,NX)=RTWT1P(N,NR,NZ,NY,NX)*XHVST - RTLG1(N,L,NR,NZ,NY,NX)=RTLG1(N,L,NR,NZ,NY,NX)*XHVST - RTLG2(N,L,NR,NZ,NY,NX)=RTLG2(N,L,NR,NZ,NY,NX)*XHVST - RTN2(N,L,NR,NZ,NY,NX)=RTN2(N,L,NR,NZ,NY,NX)*XHVST -8960 CONTINUE - CPOOLR(N,L,NZ,NY,NX)=CPOOLR(N,L,NZ,NY,NX)*XHVST - ZPOOLR(N,L,NZ,NY,NX)=ZPOOLR(N,L,NZ,NY,NX)*XHVST - PPOOLR(N,L,NZ,NY,NX)=PPOOLR(N,L,NZ,NY,NX)*XHVST - WTRTL(N,L,NZ,NY,NX)=WTRTL(N,L,NZ,NY,NX)*XHVST - WTRTD(N,L,NZ,NY,NX)=WTRTD(N,L,NZ,NY,NX)*XHVST - WSRTL(N,L,NZ,NY,NX)=WSRTL(N,L,NZ,NY,NX)*XHVST - RTN1(N,L,NZ,NY,NX)=RTN1(N,L,NZ,NY,NX)*XHVST - RTNL(N,L,NZ,NY,NX)=RTNL(N,L,NZ,NY,NX)*XHVST - RTLGP(N,L,NZ,NY,NX)=RTLGP(N,L,NZ,NY,NX)*XHVST - RTDNP(N,L,NZ,NY,NX)=RTDNP(N,L,NZ,NY,NX)*XHVST - RTVLP(N,L,NZ,NY,NX)=RTVLP(N,L,NZ,NY,NX)*XHVST - RTVLW(N,L,NZ,NY,NX)=RTVLW(N,L,NZ,NY,NX)*XHVST - RTARP(N,L,NZ,NY,NX)=RTARP(N,L,NZ,NY,NX)*XHVST - RCO2M(N,L,NZ,NY,NX)=RCO2M(N,L,NZ,NY,NX)*XHVST - RCO2N(N,L,NZ,NY,NX)=RCO2N(N,L,NZ,NY,NX)*XHVST - RCO2A(N,L,NZ,NY,NX)=RCO2A(N,L,NZ,NY,NX)*XHVST -C -C LITTERFALL AND STATE VARIABLES FOR NODULES DURING TILLAGE -C - IF(INTYP(NZ,NY,NX).NE.0.AND.N.EQ.1)THEN - DO 6395 M=1,4 - CSNC(M,1,L,NZ,NY,NX)=CSNC(M,1,L,NZ,NY,NX)+(1.0-XHVST) - 2*(CFOPC(4,M,NZ,NY,NX)*WTNDL(L,NZ,NY,NX) - 3+CFOPC(0,M,NZ,NY,NX)*CPOOLN(L,NZ,NY,NX)) - ZSNC(M,1,L,NZ,NY,NX)=ZSNC(M,1,L,NZ,NY,NX)+(1.0-XHVST) - 2*(CFOPN(4,M,NZ,NY,NX)*WTNDLN(L,NZ,NY,NX) - 3+CFOPN(0,M,NZ,NY,NX)*ZPOOLN(L,NZ,NY,NX)) - PSNC(M,1,L,NZ,NY,NX)=PSNC(M,1,L,NZ,NY,NX)+(1.0-XHVST) - 2*(CFOPP(4,M,NZ,NY,NX)*WTNDLP(L,NZ,NY,NX) - 3+CFOPP(0,M,NZ,NY,NX)*PPOOLN(L,NZ,NY,NX)) -6395 CONTINUE - WTNDL(L,NZ,NY,NX)=WTNDL(L,NZ,NY,NX)*XHVST - WTNDLN(L,NZ,NY,NX)=WTNDLN(L,NZ,NY,NX)*XHVST - WTNDLP(L,NZ,NY,NX)=WTNDLP(L,NZ,NY,NX)*XHVST - CPOOLN(L,NZ,NY,NX)=CPOOLN(L,NZ,NY,NX)*XHVST - ZPOOLN(L,NZ,NY,NX)=ZPOOLN(L,NZ,NY,NX)*XHVST - PPOOLN(L,NZ,NY,NX)=PPOOLN(L,NZ,NY,NX)*XHVST - ENDIF -8980 CONTINUE -8985 CONTINUE -C -C LITTERFALL AND STATE VARIABLES FOR SEASONAL STORAGE RESERVES -C DURING TILLAGE -C - DO 6400 M=1,4 - CSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX)=CSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX) - 2+((1.0-XHVST)*CFOPC(0,M,NZ,NY,NX)*WTRVC(NZ,NY,NX))*FWOOD(0) - ZSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX)=ZSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX) - 2+((1.0-XHVST)*CFOPN(0,M,NZ,NY,NX)*WTRVN(NZ,NY,NX))*FWOODN(0) - PSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX)=PSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX) - 2+((1.0-XHVST)*CFOPP(0,M,NZ,NY,NX)*WTRVP(NZ,NY,NX))*FWOODP(0) - CSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX)=CSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX) - 2+((1.0-XHVST)*CFOPC(0,M,NZ,NY,NX)*WTRVC(NZ,NY,NX))*FWOOD(1) - ZSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX)=ZSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX) - 2+((1.0-XHVST)*CFOPN(0,M,NZ,NY,NX)*WTRVN(NZ,NY,NX))*FWOODN(1) - PSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX)=PSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX) - 2+((1.0-XHVST)*CFOPP(0,M,NZ,NY,NX)*WTRVP(NZ,NY,NX))*FWOODP(1) -6400 CONTINUE - WTRVC(NZ,NY,NX)=WTRVC(NZ,NY,NX)*XHVST - WTRVN(NZ,NY,NX)=WTRVN(NZ,NY,NX)*XHVST - WTRVP(NZ,NY,NX)=WTRVP(NZ,NY,NX)*XHVST - ENDIF - ENDIF - ENDIF -C -C DEAD BRANCHES -C - IF(J.EQ.INT(ZNOON(NY,NX)).AND.IDAY(1,NB1(NZ,NY,NX),NZ,NY,NX).NE.0 - 2.AND.(ISTYP(NZ,NY,NX).NE.0.OR.(I.GE.IDAYH(NZ,NY,NX) - 3.AND.IYRC.GE.IYRH(NZ,NY,NX))))THEN - IDTHY=0 -C -C RESET PHENOLOGY AND GROWTH STAGE OF DEAD BRANCHES -C - DO 8845 NB=1,NBR(NZ,NY,NX) - IF(IDTHB(NB,NZ,NY,NX).EQ.1)THEN - GROUP(NB,NZ,NY,NX)=GROUPI(NZ,NY,NX) - PSTG(NB,NZ,NY,NX)=XTLI(NZ,NY,NX) - PSTGI(NB,NZ,NY,NX)=PSTG(NB,NZ,NY,NX) - PSTGF(NB,NZ,NY,NX)=0.0 - VSTG(NB,NZ,NY,NX)=0.0 - VSTGX(NB,NZ,NY,NX)=0.0 - KLEAF(NB,NZ,NY,NX)=1 - KVSTG(NB,NZ,NY,NX)=1 - TGSTGI(NB,NZ,NY,NX)=0.0 - TGSTGF(NB,NZ,NY,NX)=0.0 - IF(IWTYP(NZ,NY,NX).EQ.0)THEN - VRNS(NB,NZ,NY,NX)=VRNL(NB,NZ,NY,NX)+0.5 - ELSE - VRNS(NB,NZ,NY,NX)=0.0 - ENDIF - VRNF(NB,NZ,NY,NX)=0.0 - ATRP(NB,NZ,NY,NX)=0.0 - FLG4(NB,NZ,NY,NX)=0.0 - FDBK(NB,NZ,NY,NX)=1.0 - FDBKX(NB,NZ,NY,NX)=1.0 - IFLGA(NB,NZ,NY,NX)=0 - IFLGE(NB,NZ,NY,NX)=1 - IFLGF(NB,NZ,NY,NX)=0 - IFLGR(NB,NZ,NY,NX)=0 - IFLGQ(NB,NZ,NY,NX)=0 - IFLGD(NB,NZ,NY,NX)=0 - NBTB(NB,NZ,NY,NX)=0 - DO 8850 M=1,10 - IDAY(M,NB,NZ,NY,NX)=0 -8850 CONTINUE -C -C LITTERFALL FROM DEAD BRANCHES -C - DO 6405 M=1,4 - CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) - 2+CFOPC(0,M,NZ,NY,NX)*(CPOOL(NB,NZ,NY,NX)+CPOLNB(NB,NZ,NY,NX) - 3+CPOOLK(NB,NZ,NY,NX)+WTRSVB(NB,NZ,NY,NX)) - 4+CFOPC(1,M,NZ,NY,NX)*(WTLFB(NB,NZ,NY,NX)*FWODB(1) - 5+WTNDB(NB,NZ,NY,NX)) - 6+CFOPC(2,M,NZ,NY,NX)*(WTSHEB(NB,NZ,NY,NX)*FWODB(1) - 7+WTHSKB(NB,NZ,NY,NX)+WTEARB(NB,NZ,NY,NX)) - CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX) - 2+CFOPC(5,M,NZ,NY,NX)*(WTLFB(NB,NZ,NY,NX)*FWODB(0) - 3+WTSHEB(NB,NZ,NY,NX)*FWODB(0)) - ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) - 2+CFOPN(0,M,NZ,NY,NX)*(ZPOOL(NB,NZ,NY,NX)+ZPOLNB(NB,NZ,NY,NX) - 3+WTRSBN(NB,NZ,NY,NX)) - 4+CFOPN(1,M,NZ,NY,NX)*(WTLFBN(NB,NZ,NY,NX)*FWODLN(1) - 5+WTNDBN(NB,NZ,NY,NX)) - 6+CFOPN(2,M,NZ,NY,NX)*(WTSHBN(NB,NZ,NY,NX)*FWODSN(1) - 7+WTHSBN(NB,NZ,NY,NX)+WTEABN(NB,NZ,NY,NX)) - ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX) - 2+CFOPN(5,M,NZ,NY,NX)*(WTLFBN(NB,NZ,NY,NX)*FWODLN(0) - 3+WTSHBN(NB,NZ,NY,NX)*FWODSN(0)) - PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) - 2+CFOPP(0,M,NZ,NY,NX)*(PPOOL(NB,NZ,NY,NX)+PPOLNB(NB,NZ,NY,NX) - 3+WTRSBP(NB,NZ,NY,NX)) - 4+CFOPP(1,M,NZ,NY,NX)*(WTLFBP(NB,NZ,NY,NX)*FWODLP(1) - 5+WTNDBP(NB,NZ,NY,NX)) - 6+CFOPP(2,M,NZ,NY,NX)*(WTSHBP(NB,NZ,NY,NX)*FWODSP(1) - 7+WTHSBP(NB,NZ,NY,NX)+WTEABP(NB,NZ,NY,NX)) - PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX) - 2+CFOPP(5,M,NZ,NY,NX)*(WTLFBP(NB,NZ,NY,NX)*FWODLP(0) - 3+WTSHBP(NB,NZ,NY,NX)*FWODSP(0)) - IF(ISTYP(NZ,NY,NX).EQ.0.AND.IWTYP(NZ,NY,NX).NE.0)THEN - WTRVC(NZ,NY,NX)=WTRVC(NZ,NY,NX) - 2+CFOPC(2,M,NZ,NY,NX)*WTGRB(NB,NZ,NY,NX) - WTRVN(NZ,NY,NX)=WTRVN(NZ,NY,NX) - 2+CFOPN(2,M,NZ,NY,NX)*WTGRBN(NB,NZ,NY,NX) - WTRVP(NZ,NY,NX)=WTRVP(NZ,NY,NX) - 2+CFOPP(2,M,NZ,NY,NX)*WTGRBP(NB,NZ,NY,NX) - ELSE - CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) - 2+CFOPC(2,M,NZ,NY,NX)*WTGRB(NB,NZ,NY,NX) - ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) - 2+CFOPN(2,M,NZ,NY,NX)*WTGRBN(NB,NZ,NY,NX) - PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) - 2+CFOPP(2,M,NZ,NY,NX)*WTGRBP(NB,NZ,NY,NX) - ENDIF - IF(IBTYP(NZ,NY,NX).EQ.0.OR.IGTYP(NZ,NY,NX).LE.1)THEN - CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) - 5+CFOPC(3,M,NZ,NY,NX)*WTSTKB(NB,NZ,NY,NX) - ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) - 5+CFOPN(3,M,NZ,NY,NX)*WTSTBN(NB,NZ,NY,NX) - PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) - 5+CFOPP(3,M,NZ,NY,NX)*WTSTBP(NB,NZ,NY,NX) - ELSE - WTSTDG(M,NZ,NY,NX)=WTSTDG(M,NZ,NY,NX) - 5+CFOPC(5,M,NZ,NY,NX)*WTSTKB(NB,NZ,NY,NX) - WTSTDN(M,NZ,NY,NX)=WTSTDN(M,NZ,NY,NX) - 5+CFOPN(5,M,NZ,NY,NX)*WTSTBN(NB,NZ,NY,NX) - WTSTDP(M,NZ,NY,NX)=WTSTDP(M,NZ,NY,NX) - 5+CFOPP(5,M,NZ,NY,NX)*WTSTBP(NB,NZ,NY,NX) - ENDIF -6405 CONTINUE -C -C RECOVER NON-STRUCTURAL C,N,P FROM BRANCH TO -C SEASONAL STORAGE RESERVES -C - WTRVC(NZ,NY,NX)=WTRVC(NZ,NY,NX) - 2+CPOOL(NB,NZ,NY,NX)+CPOOLK(NB,NZ,NY,NX)+WTRSVB(NB,NZ,NY,NX) - WTRVN(NZ,NY,NX)=WTRVN(NZ,NY,NX) - 2+ZPOOL(NB,NZ,NY,NX)+WTRSBN(NB,NZ,NY,NX) - WTRVP(NZ,NY,NX)=WTRVP(NZ,NY,NX) - 2+PPOOL(NB,NZ,NY,NX)+WTRSBP(NB,NZ,NY,NX) -C -C RESET STATE VARIABLES FROM DEAD BRANCHES -C - CPOOL(NB,NZ,NY,NX)=0.0 - CPOOLK(NB,NZ,NY,NX)=0.0 - ZPOOL(NB,NZ,NY,NX)=0.0 - PPOOL(NB,NZ,NY,NX)=0.0 - CPOLNB(NB,NZ,NY,NX)=0.0 - ZPOLNB(NB,NZ,NY,NX)=0.0 - PPOLNB(NB,NZ,NY,NX)=0.0 - WTSHTB(NB,NZ,NY,NX)=0.0 - WTLFB(NB,NZ,NY,NX)=0.0 - WTNDB(NB,NZ,NY,NX)=0.0 - WTSHEB(NB,NZ,NY,NX)=0.0 - WTSTKB(NB,NZ,NY,NX)=0.0 - WVSTKB(NB,NZ,NY,NX)=0.0 - WTRSVB(NB,NZ,NY,NX)=0.0 - WTHSKB(NB,NZ,NY,NX)=0.0 - WTEARB(NB,NZ,NY,NX)=0.0 - WTGRB(NB,NZ,NY,NX)=0.0 - WTLSB(NB,NZ,NY,NX)=0.0 - WTSHTN(NB,NZ,NY,NX)=0.0 - WTLFBN(NB,NZ,NY,NX)=0.0 - WTNDBN(NB,NZ,NY,NX)=0.0 - WTSHBN(NB,NZ,NY,NX)=0.0 - WTSTBN(NB,NZ,NY,NX)=0.0 - WTRSBN(NB,NZ,NY,NX)=0.0 - WTHSBN(NB,NZ,NY,NX)=0.0 - WTEABN(NB,NZ,NY,NX)=0.0 - WTGRBN(NB,NZ,NY,NX)=0.0 - WTSHTP(NB,NZ,NY,NX)=0.0 - WTLFBP(NB,NZ,NY,NX)=0.0 - WTNDBP(NB,NZ,NY,NX)=0.0 - WTSHBP(NB,NZ,NY,NX)=0.0 - WTSTBP(NB,NZ,NY,NX)=0.0 - WTRSBP(NB,NZ,NY,NX)=0.0 - WTHSBP(NB,NZ,NY,NX)=0.0 - WTEABP(NB,NZ,NY,NX)=0.0 - WTGRBP(NB,NZ,NY,NX)=0.0 - GRNXB(NB,NZ,NY,NX)=0.0 - GRNOB(NB,NZ,NY,NX)=0.0 - GRWTB(NB,NZ,NY,NX)=0.0 - ARLFB(NB,NZ,NY,NX)=0.0 - WTSTXB(NB,NZ,NY,NX)=0.0 - WTSTXN(NB,NZ,NY,NX)=0.0 - WTSTXP(NB,NZ,NY,NX)=0.0 - DO 8855 K=0,25 - IF(K.NE.0)THEN - CPOOL3(K,NB,NZ,NY,NX)=0.0 - CPOOL4(K,NB,NZ,NY,NX)=0.0 - CO2B(K,NB,NZ,NY,NX)=0.0 - HCOB(K,NB,NZ,NY,NX)=0.0 - ENDIF - ARLF(K,NB,NZ,NY,NX)=0.0 - HTNODE(K,NB,NZ,NY,NX)=0.0 - HTNODX(K,NB,NZ,NY,NX)=0.0 - HTSHE(K,NB,NZ,NY,NX)=0.0 - WGLF(K,NB,NZ,NY,NX)=0.0 - WSLF(K,NB,NZ,NY,NX)=0.0 - WGLFN(K,NB,NZ,NY,NX)=0.0 - WGLFP(K,NB,NZ,NY,NX)=0.0 - WGSHE(K,NB,NZ,NY,NX)=0.0 - WSSHE(K,NB,NZ,NY,NX)=0.0 - WGSHN(K,NB,NZ,NY,NX)=0.0 - WGSHP(K,NB,NZ,NY,NX)=0.0 - WGNODE(K,NB,NZ,NY,NX)=0.0 - WGNODN(K,NB,NZ,NY,NX)=0.0 - WGNODP(K,NB,NZ,NY,NX)=0.0 - DO 8865 L=1,JC - ARLFV(L,NZ,NY,NX)=ARLFV(L,NZ,NY,NX)-ARLFL(L,K,NB,NZ,NY,NX) - WGLFV(L,NZ,NY,NX)=WGLFV(L,NZ,NY,NX)-WGLFL(L,K,NB,NZ,NY,NX) - ARLFL(L,K,NB,NZ,NY,NX)=0.0 - WGLFL(L,K,NB,NZ,NY,NX)=0.0 - WGLFLN(L,K,NB,NZ,NY,NX)=0.0 - WGLFLP(L,K,NB,NZ,NY,NX)=0.0 - IF(K.NE.0)THEN - DO 8860 N=1,4 - SURF(N,L,K,NB,NZ,NY,NX)=0.0 -8860 CONTINUE - ENDIF -8865 CONTINUE -8855 CONTINUE - DO 8875 L=1,JC - ARSTK(L,NB,NZ,NY,NX)=0.0 - DO 8875 N=1,4 - SURFB(N,L,NB,NZ,NY,NX)=0.0 -8875 CONTINUE - IDTHY=IDTHY+1 - ENDIF -8845 CONTINUE - IF(IDTHY.EQ.NBR(NZ,NY,NX))THEN - IDTHP(NZ,NY,NX)=1 - NBT(NZ,NY,NX)=0 - WSTR(NZ,NY,NX)=0.0 - IF(IFLGI(NZ,NY,NX).EQ.1)THEN - NBR(NZ,NY,NX)=1 - ELSE - NBR(NZ,NY,NX)=0 - ENDIF - HTCTL(NZ,NY,NX)=0.0 - VOLWOU=VOLWOU+VOLWP(NZ,NY,NX) - UVOLO(NY,NX)=UVOLO(NY,NX)+VOLWP(NZ,NY,NX) - VOLWP(NZ,NY,NX)=0.0 - IF(WTRVC(NZ,NY,NX).LT.1.0E-04*WTRT(NZ,NY,NX) - 2.AND.ISTYP(NZ,NY,NX).NE.0)IDTHR(NZ,NY,NX)=1 - IF(ISTYP(NZ,NY,NX).EQ.0)IDTHR(NZ,NY,NX)=1 - IF(JHVST(NZ,I,NY,NX).NE.0)IDTHR(NZ,NY,NX)=1 - IF(PP(NZ,NY,NX).LE.0.0)IDTHR(NZ,NY,NX)=1 - IF(IDTHR(NZ,NY,NX).EQ.1)IDTHP(NZ,NY,NX)=1 - ENDIF -C -C DEAD ROOTS -C -C -C LITTERFALL FROM DEAD ROOTS -C - IF(IDTHR(NZ,NY,NX).EQ.1)THEN - DO 8900 N=1,MY(NZ,NY,NX) - DO 8895 L=NU(NY,NX),NJ(NY,NX) - DO 6410 M=1,4 - CSNC(M,1,L,NZ,NY,NX)=CSNC(M,1,L,NZ,NY,NX)+CFOPC(0,M,NZ,NY,NX) - 2*CPOOLR(N,L,NZ,NY,NX) - ZSNC(M,1,L,NZ,NY,NX)=ZSNC(M,1,L,NZ,NY,NX)+CFOPN(0,M,NZ,NY,NX) - 2*ZPOOLR(N,L,NZ,NY,NX) - PSNC(M,1,L,NZ,NY,NX)=PSNC(M,1,L,NZ,NY,NX)+CFOPP(0,M,NZ,NY,NX) - 2*PPOOLR(N,L,NZ,NY,NX) - DO 6410 NR=1,NRT(NZ,NY,NX) - CSNC(M,0,L,NZ,NY,NX)=CSNC(M,0,L,NZ,NY,NX)+CFOPC(5,M,NZ,NY,NX) - 2*(WTRT1(N,L,NR,NZ,NY,NX)+WTRT2(N,L,NR,NZ,NY,NX))*FWOOD(0) - ZSNC(M,0,L,NZ,NY,NX)=ZSNC(M,0,L,NZ,NY,NX)+CFOPN(5,M,NZ,NY,NX) - 2*(WTRT1N(N,L,NR,NZ,NY,NX)+WTRT2N(N,L,NR,NZ,NY,NX))*FWOODN(0) - PSNC(M,0,L,NZ,NY,NX)=PSNC(M,0,L,NZ,NY,NX)+CFOPP(5,M,NZ,NY,NX) - 2*(WTRT1P(N,L,NR,NZ,NY,NX)+WTRT2P(N,L,NR,NZ,NY,NX))*FWOODP(0) - CSNC(M,1,L,NZ,NY,NX)=CSNC(M,1,L,NZ,NY,NX)+CFOPC(4,M,NZ,NY,NX) - 2*(WTRT1(N,L,NR,NZ,NY,NX)+WTRT2(N,L,NR,NZ,NY,NX))*FWOOD(1) - ZSNC(M,1,L,NZ,NY,NX)=ZSNC(M,1,L,NZ,NY,NX)+CFOPN(4,M,NZ,NY,NX) - 2*(WTRT1N(N,L,NR,NZ,NY,NX)+WTRT2N(N,L,NR,NZ,NY,NX))*FWOODN(1) - PSNC(M,1,L,NZ,NY,NX)=PSNC(M,1,L,NZ,NY,NX)+CFOPP(4,M,NZ,NY,NX) - 2*(WTRT1P(N,L,NR,NZ,NY,NX)+WTRT2P(N,L,NR,NZ,NY,NX))*FWOODP(1) -6410 CONTINUE -C -C RELEASE GAS CONTENTS OF DEAD ROOTS -C - RCO2Z(NZ,NY,NX)=RCO2Z(NZ,NY,NX)-CO2A(N,L,NZ,NY,NX) - 2-CO2P(N,L,NZ,NY,NX) - ROXYZ(NZ,NY,NX)=ROXYZ(NZ,NY,NX)-OXYA(N,L,NZ,NY,NX) - 2-OXYP(N,L,NZ,NY,NX) - RCH4Z(NZ,NY,NX)=RCH4Z(NZ,NY,NX)-CH4A(N,L,NZ,NY,NX) - 2-CH4P(N,L,NZ,NY,NX) - RN2OZ(NZ,NY,NX)=RN2OZ(NZ,NY,NX)-Z2OA(N,L,NZ,NY,NX) - 2-Z2OP(N,L,NZ,NY,NX) - RNH3Z(NZ,NY,NX)=RNH3Z(NZ,NY,NX)-ZH3A(N,L,NZ,NY,NX) - 2-ZH3P(N,L,NZ,NY,NX) - RH2GZ(NZ,NY,NX)=RH2GZ(NZ,NY,NX)-H2GA(N,L,NZ,NY,NX) - 2-H2GP(N,L,NZ,NY,NX) - CO2A(N,L,NZ,NY,NX)=0.0 - OXYA(N,L,NZ,NY,NX)=0.0 - CH4A(N,L,NZ,NY,NX)=0.0 - Z2OA(N,L,NZ,NY,NX)=0.0 - ZH3A(N,L,NZ,NY,NX)=0.0 - H2GA(N,L,NZ,NY,NX)=0.0 - CO2P(N,L,NZ,NY,NX)=0.0 - OXYP(N,L,NZ,NY,NX)=0.0 - CH4P(N,L,NZ,NY,NX)=0.0 - Z2OP(N,L,NZ,NY,NX)=0.0 - ZH3P(N,L,NZ,NY,NX)=0.0 - H2GP(N,L,NZ,NY,NX)=0.0 -C -C RESET STATE VARIABLES OF DEAD ROOTS -C - DO 8870 NR=1,NRT(NZ,NY,NX) - WTRT1(N,L,NR,NZ,NY,NX)=0.0 - WTRT1N(N,L,NR,NZ,NY,NX)=0.0 - WTRT1P(N,L,NR,NZ,NY,NX)=0.0 - WTRT2(N,L,NR,NZ,NY,NX)=0.0 - WTRT2N(N,L,NR,NZ,NY,NX)=0.0 - WTRT2P(N,L,NR,NZ,NY,NX)=0.0 - RTWT1(N,NR,NZ,NY,NX)=0.0 - RTWT1N(N,NR,NZ,NY,NX)=0.0 - RTWT1P(N,NR,NZ,NY,NX)=0.0 - RTLG1(N,L,NR,NZ,NY,NX)=0.0 - RTLG2(N,L,NR,NZ,NY,NX)=0.0 - RTN2(N,L,NR,NZ,NY,NX)=0.0 -8870 CONTINUE - CPOOLR(N,L,NZ,NY,NX)=0.0 - ZPOOLR(N,L,NZ,NY,NX)=0.0 - PPOOLR(N,L,NZ,NY,NX)=0.0 - WTRTL(N,L,NZ,NY,NX)=0.0 - WTRTD(N,L,NZ,NY,NX)=0.0 - WSRTL(N,L,NZ,NY,NX)=0.0 - RTN1(N,L,NZ,NY,NX)=0.0 - RTNL(N,L,NZ,NY,NX)=0.0 - RTLGP(N,L,NZ,NY,NX)=0.0 - RTDNP(N,L,NZ,NY,NX)=0.0 - RTVLP(N,L,NZ,NY,NX)=0.0 - RTVLW(N,L,NZ,NY,NX)=0.0 - RRAD1(N,L,NZ,NY,NX)=RRAD1M(N,NZ,NY,NX) - RRAD2(N,L,NZ,NY,NX)=RRAD2M(N,NZ,NY,NX) - RTARP(N,L,NZ,NY,NX)=0.0 - RTLGA(N,L,NZ,NY,NX)=RTLGAX -C -C LITTERFALL AND STATE VARIABLES FROM DEAD NODULES -C - IF(INTYP(NZ,NY,NX).NE.0.AND.N.EQ.1)THEN - DO 6420 M=1,4 - CSNC(M,1,L,NZ,NY,NX)=CSNC(M,1,L,NZ,NY,NX)+CFOPC(4,M,NZ,NY,NX) - 2*WTNDL(L,NZ,NY,NX)+CFOPC(0,M,NZ,NY,NX)*CPOOLN(L,NZ,NY,NX) - ZSNC(M,1,L,NZ,NY,NX)=ZSNC(M,1,L,NZ,NY,NX)+CFOPN(4,M,NZ,NY,NX) - 2*WTNDLN(L,NZ,NY,NX)+CFOPN(0,M,NZ,NY,NX)*ZPOOLN(L,NZ,NY,NX) - PSNC(M,1,L,NZ,NY,NX)=PSNC(M,1,L,NZ,NY,NX)+CFOPP(4,M,NZ,NY,NX) - 2*WTNDLP(L,NZ,NY,NX)+CFOPP(0,M,NZ,NY,NX)*PPOOLN(L,NZ,NY,NX) -6420 CONTINUE - WTNDL(L,NZ,NY,NX)=0.0 - WTNDLN(L,NZ,NY,NX)=0.0 - WTNDLP(L,NZ,NY,NX)=0.0 - CPOOLN(L,NZ,NY,NX)=0.0 - ZPOOLN(L,NZ,NY,NX)=0.0 - PPOOLN(L,NZ,NY,NX)=0.0 - ENDIF -8895 CONTINUE -8900 CONTINUE -C -C RESET DEPTH VARIABLES OF DEAD ROOTS -C - DO 8795 NR=1,NRT(NZ,NY,NX) - NINR(NR,NZ,NY,NX)=NG(NZ,NY,NX) - DO 8790 N=1,MY(NZ,NY,NX) - RTDP1(N,NR,NZ,NY,NX)=SDPTH(NZ,NY,NX) - RTWT1(N,NR,NZ,NY,NX)=0.0 - RTWT1N(N,NR,NZ,NY,NX)=0.0 - RTWT1P(N,NR,NZ,NY,NX)=0.0 -8790 CONTINUE -8795 CONTINUE - NIX(NZ,NY,NX)=NG(NZ,NY,NX) - NRT(NZ,NY,NX)=0 - ENDIF -C -C LITTERFALL AND STATE VARIABLES FOR SEASONAL STORAGE -C RESERVES AT DEATH -C - IF(IDTHP(NZ,NY,NX).EQ.1.AND.IDTHR(NZ,NY,NX).EQ.1)THEN - IF(IFLGI(NZ,NY,NX).EQ.0)THEN - DO 6425 M=1,4 - DO 8825 NB=1,NBR(NZ,NY,NX) - CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) - 2+CFOPC(0,M,NZ,NY,NX)*(CPOOL(NB,NZ,NY,NX)+CPOLNB(NB,NZ,NY,NX) - 3+CPOOLK(NB,NZ,NY,NX)+WTRSVB(NB,NZ,NY,NX)) - 4+CFOPC(1,M,NZ,NY,NX)*(WTLFB(NB,NZ,NY,NX)*FWODB(1) - 5+WTNDB(NB,NZ,NY,NX)) - 6+CFOPC(2,M,NZ,NY,NX)*(WTSHEB(NB,NZ,NY,NX)*FWODB(1) - 7+WTHSKB(NB,NZ,NY,NX)+WTEARB(NB,NZ,NY,NX)) - CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX) - 2+CFOPC(5,M,NZ,NY,NX)*(WTLFB(NB,NZ,NY,NX)*FWODB(0) - 3+WTSHEB(NB,NZ,NY,NX)*FWODB(0)) - ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) - 2+CFOPN(0,M,NZ,NY,NX)*(ZPOOL(NB,NZ,NY,NX)+ZPOLNB(NB,NZ,NY,NX) - 3+WTRSBN(NB,NZ,NY,NX)) - 4+CFOPN(1,M,NZ,NY,NX)*(WTLFBN(NB,NZ,NY,NX)*FWODLN(1) - 5+WTNDBN(NB,NZ,NY,NX)) - 6+CFOPN(2,M,NZ,NY,NX)*(WTSHBN(NB,NZ,NY,NX)*FWODSN(1) - 7+WTHSBN(NB,NZ,NY,NX)+WTEABN(NB,NZ,NY,NX)) - ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX) - 2+CFOPN(5,M,NZ,NY,NX)*(WTLFBN(NB,NZ,NY,NX)*FWODLN(0) - 3+WTSHBN(NB,NZ,NY,NX)*FWODSN(0)) - PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) - 2+CFOPP(0,M,NZ,NY,NX)*(PPOOL(NB,NZ,NY,NX)+PPOLNB(NB,NZ,NY,NX) - 3+WTRSBP(NB,NZ,NY,NX)) - 4+CFOPP(1,M,NZ,NY,NX)*(WTLFBP(NB,NZ,NY,NX)*FWODLP(1) - 5+WTNDBP(NB,NZ,NY,NX)) - 6+CFOPP(2,M,NZ,NY,NX)*(WTSHBP(NB,NZ,NY,NX)*FWODSP(1) - 7+WTHSBP(NB,NZ,NY,NX)+WTEABP(NB,NZ,NY,NX)) - PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX) - 2+CFOPP(5,M,NZ,NY,NX)*(WTLFBP(NB,NZ,NY,NX)*FWODLP(0) - 3+WTSHBP(NB,NZ,NY,NX)*FWODSP(0)) - IF(ISTYP(NZ,NY,NX).EQ.0.AND.IWTYP(NZ,NY,NX).NE.0)THEN - WTRVC(NZ,NY,NX)=WTRVC(NZ,NY,NX) - 2+CFOPC(2,M,NZ,NY,NX)*WTGRB(NB,NZ,NY,NX) - WTRVN(NZ,NY,NX)=WTRVN(NZ,NY,NX) - 2+CFOPN(2,M,NZ,NY,NX)*WTGRBN(NB,NZ,NY,NX) - WTRVP(NZ,NY,NX)=WTRVP(NZ,NY,NX) - 2+CFOPP(2,M,NZ,NY,NX)*WTGRBP(NB,NZ,NY,NX) - ELSE - CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) - 2+CFOPC(2,M,NZ,NY,NX)*WTGRB(NB,NZ,NY,NX) - ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) - 2+CFOPN(2,M,NZ,NY,NX)*WTGRBN(NB,NZ,NY,NX) - PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) - 2+CFOPP(2,M,NZ,NY,NX)*WTGRBP(NB,NZ,NY,NX) - ENDIF - IF(IBTYP(NZ,NY,NX).EQ.0.OR.IGTYP(NZ,NY,NX).LE.1)THEN - CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) - 5+CFOPC(3,M,NZ,NY,NX)*WTSTKB(NB,NZ,NY,NX) - ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) - 5+CFOPN(3,M,NZ,NY,NX)*WTSTBN(NB,NZ,NY,NX) - PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) - 5+CFOPP(3,M,NZ,NY,NX)*WTSTBP(NB,NZ,NY,NX) - ELSE - WTSTDG(M,NZ,NY,NX)=WTSTDG(M,NZ,NY,NX) - 5+CFOPC(5,M,NZ,NY,NX)*WTSTKB(NB,NZ,NY,NX) - WTSTDN(M,NZ,NY,NX)=WTSTDN(M,NZ,NY,NX) - 5+CFOPN(5,M,NZ,NY,NX)*WTSTBN(NB,NZ,NY,NX) - WTSTDP(M,NZ,NY,NX)=WTSTDP(M,NZ,NY,NX) - 5+CFOPP(5,M,NZ,NY,NX)*WTSTBP(NB,NZ,NY,NX) - ENDIF -8825 CONTINUE - DO 6415 L=NU(NY,NX),NJ(NY,NX) - DO 6415 N=1,MY(NZ,NY,NX) - CSNC(M,1,L,NZ,NY,NX)=CSNC(M,1,L,NZ,NY,NX)+CFOPC(0,M,NZ,NY,NX) - 2*CPOOLR(N,L,NZ,NY,NX) - ZSNC(M,1,L,NZ,NY,NX)=ZSNC(M,1,L,NZ,NY,NX)+CFOPN(0,M,NZ,NY,NX) - 2*ZPOOLR(N,L,NZ,NY,NX) - PSNC(M,1,L,NZ,NY,NX)=PSNC(M,1,L,NZ,NY,NX)+CFOPP(0,M,NZ,NY,NX) - 2*PPOOLR(N,L,NZ,NY,NX) - DO 6415 NR=1,NRT(NZ,NY,NX) - CSNC(M,0,L,NZ,NY,NX)=CSNC(M,0,L,NZ,NY,NX)+CFOPC(5,M,NZ,NY,NX) - 2*(WTRT1(N,L,NR,NZ,NY,NX)+WTRT2(N,L,NR,NZ,NY,NX))*FWOOD(0) - ZSNC(M,0,L,NZ,NY,NX)=ZSNC(M,0,L,NZ,NY,NX)+CFOPN(5,M,NZ,NY,NX) - 2*(WTRT1N(N,L,NR,NZ,NY,NX)+WTRT2N(N,L,NR,NZ,NY,NX))*FWOODN(0) - PSNC(M,0,L,NZ,NY,NX)=PSNC(M,0,L,NZ,NY,NX)+CFOPP(5,M,NZ,NY,NX) - 2*(WTRT1P(N,L,NR,NZ,NY,NX)+WTRT2P(N,L,NR,NZ,NY,NX))*FWOODP(0) - CSNC(M,1,L,NZ,NY,NX)=CSNC(M,1,L,NZ,NY,NX)+CFOPC(4,M,NZ,NY,NX) - 2*(WTRT1(N,L,NR,NZ,NY,NX)+WTRT2(N,L,NR,NZ,NY,NX))*FWOOD(1) - ZSNC(M,1,L,NZ,NY,NX)=ZSNC(M,1,L,NZ,NY,NX)+CFOPN(4,M,NZ,NY,NX) - 2*(WTRT1N(N,L,NR,NZ,NY,NX)+WTRT2N(N,L,NR,NZ,NY,NX))*FWOODN(1) - PSNC(M,1,L,NZ,NY,NX)=PSNC(M,1,L,NZ,NY,NX)+CFOPP(4,M,NZ,NY,NX) - 2*(WTRT1P(N,L,NR,NZ,NY,NX)+WTRT2P(N,L,NR,NZ,NY,NX))*FWOODP(1) -6415 CONTINUE - CSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX)=CSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX) - 2+CFOPC(0,M,NZ,NY,NX)*WTRVC(NZ,NY,NX)*FWOOD(0) - ZSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX)=ZSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX) - 2+CFOPN(0,M,NZ,NY,NX)*WTRVN(NZ,NY,NX)*FWOODN(0) - PSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX)=PSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX) - 2+CFOPP(0,M,NZ,NY,NX)*WTRVP(NZ,NY,NX)*FWOODP(0) - CSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX)=CSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX) - 2+CFOPC(0,M,NZ,NY,NX)*WTRVC(NZ,NY,NX)*FWOOD(1) - ZSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX)=ZSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX) - 2+CFOPN(0,M,NZ,NY,NX)*WTRVN(NZ,NY,NX)*FWOODN(1) - PSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX)=PSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX) - 2+CFOPP(0,M,NZ,NY,NX)*WTRVP(NZ,NY,NX)*FWOODP(1) -6425 CONTINUE - DO 8835 NB=1,NBR(NZ,NY,NX) - CPOOL(NB,NZ,NY,NX)=0.0 - CPOOLK(NB,NZ,NY,NX)=0.0 - ZPOOL(NB,NZ,NY,NX)=0.0 - PPOOL(NB,NZ,NY,NX)=0.0 - CPOLNB(NB,NZ,NY,NX)=0.0 - ZPOLNB(NB,NZ,NY,NX)=0.0 - PPOLNB(NB,NZ,NY,NX)=0.0 - WTSHTB(NB,NZ,NY,NX)=0.0 - WTLFB(NB,NZ,NY,NX)=0.0 - WTNDB(NB,NZ,NY,NX)=0.0 - WTSHEB(NB,NZ,NY,NX)=0.0 - WTSTKB(NB,NZ,NY,NX)=0.0 - WVSTKB(NB,NZ,NY,NX)=0.0 - WTRSVB(NB,NZ,NY,NX)=0.0 - WTHSKB(NB,NZ,NY,NX)=0.0 - WTEARB(NB,NZ,NY,NX)=0.0 - WTGRB(NB,NZ,NY,NX)=0.0 - WTLSB(NB,NZ,NY,NX)=0.0 - WTSHTN(NB,NZ,NY,NX)=0.0 - WTLFBN(NB,NZ,NY,NX)=0.0 - WTNDBN(NB,NZ,NY,NX)=0.0 - WTSHBN(NB,NZ,NY,NX)=0.0 - WTSTBN(NB,NZ,NY,NX)=0.0 - WTRSBN(NB,NZ,NY,NX)=0.0 - WTHSBN(NB,NZ,NY,NX)=0.0 - WTEABN(NB,NZ,NY,NX)=0.0 - WTGRBN(NB,NZ,NY,NX)=0.0 - WTSHTP(NB,NZ,NY,NX)=0.0 - WTLFBP(NB,NZ,NY,NX)=0.0 - WTNDBP(NB,NZ,NY,NX)=0.0 - WTSHBP(NB,NZ,NY,NX)=0.0 - WTSTBP(NB,NZ,NY,NX)=0.0 - WTRSBP(NB,NZ,NY,NX)=0.0 - WTHSBP(NB,NZ,NY,NX)=0.0 - WTEABP(NB,NZ,NY,NX)=0.0 - WTGRBP(NB,NZ,NY,NX)=0.0 - WTSTXB(NB,NZ,NY,NX)=0.0 - WTSTXN(NB,NZ,NY,NX)=0.0 - WTSTXP(NB,NZ,NY,NX)=0.0 -8835 CONTINUE - DO 6416 L=NU(NY,NX),NJ(NY,NX) - DO 6416 N=1,MY(NZ,NY,NX) - CPOOLR(N,L,NZ,NY,NX)=0.0 - ZPOOLR(N,L,NZ,NY,NX)=0.0 - PPOOLR(N,L,NZ,NY,NX)=0.0 - DO 6416 NR=1,NRT(NZ,NY,NX) - WTRT1(N,L,NR,NZ,NY,NX)=0.0 - WTRT1N(N,L,NR,NZ,NY,NX)=0.0 - WTRT1P(N,L,NR,NZ,NY,NX)=0.0 - WTRT2(N,L,NR,NZ,NY,NX)=0.0 - WTRT2N(N,L,NR,NZ,NY,NX)=0.0 - WTRT2P(N,L,NR,NZ,NY,NX)=0.0 - RTWT1(N,NR,NZ,NY,NX)=0.0 - RTWT1N(N,NR,NZ,NY,NX)=0.0 - RTWT1P(N,NR,NZ,NY,NX)=0.0 - RTLG1(N,L,NR,NZ,NY,NX)=0.0 - RTLG2(N,L,NR,NZ,NY,NX)=0.0 - RTN2(N,L,NR,NZ,NY,NX)=0.0 -6416 CONTINUE - WTRVC(NZ,NY,NX)=0.0 - WTRVN(NZ,NY,NX)=0.0 - WTRVP(NZ,NY,NX)=0.0 - IDTH(NZ,NY,NX)=1 - ENDIF -C -C RESEED DEAD PERENNIALS -C - IF(ISTYP(NZ,NY,NX).NE.0.AND.JHVST(NZ,I,NY,NX).EQ.0)THEN - IF(I.LT.LYRC)THEN - IDAY0(NZ,NY,NX)=I+1 - IYR0(NZ,NY,NX)=IDATA(3) - ELSE - IDAY0(NZ,NY,NX)=1 - IYR0(NZ,NY,NX)=IDATA(3)+1 - ENDIF - ENDIF - ENDIF - ENDIF -C -C CHECK PLANT C,N,P BALANCES -C - CPOOLP(NZ,NY,NX)=0.0 - ZPOOLP(NZ,NY,NX)=0.0 - PPOOLP(NZ,NY,NX)=0.0 - WTSHT(NZ,NY,NX)=0.0 - WTSHN(NZ,NY,NX)=0.0 - WTSHP(NZ,NY,NX)=0.0 - WTLF(NZ,NY,NX)=0.0 - WTSHE(NZ,NY,NX)=0.0 - WTSTK(NZ,NY,NX)=0.0 - WVSTK(NZ,NY,NX)=0.0 - WTRSV(NZ,NY,NX)=0.0 - WTHSK(NZ,NY,NX)=0.0 - WTEAR(NZ,NY,NX)=0.0 - WTGR(NZ,NY,NX)=0.0 - WTLS(NZ,NY,NX)=0.0 - WTRT(NZ,NY,NX)=0.0 - WTRTS(NZ,NY,NX)=0.0 - WTRTN(NZ,NY,NX)=0.0 - WTRTP(NZ,NY,NX)=0.0 - WTLFN(NZ,NY,NX)=0.0 - WTSHEN(NZ,NY,NX)=0.0 - WTSTKN(NZ,NY,NX)=0.0 - WTRSVN(NZ,NY,NX)=0.0 - WTHSKN(NZ,NY,NX)=0.0 - WTEARN(NZ,NY,NX)=0.0 - WTGRNN(NZ,NY,NX)=0.0 - WTLFP(NZ,NY,NX)=0.0 - WTSHEP(NZ,NY,NX)=0.0 - WTSTKP(NZ,NY,NX)=0.0 - WTRSVP(NZ,NY,NX)=0.0 - WTHSKP(NZ,NY,NX)=0.0 - WTEARP(NZ,NY,NX)=0.0 - WTGRNP(NZ,NY,NX)=0.0 - GRNO(NZ,NY,NX)=0.0 - ARLFP(NZ,NY,NX)=0.0 - ARSTP(NZ,NY,NX)=0.0 - DO 8940 L=1,JC - ARSTV(L,NZ,NY,NX)=0.0 -8940 CONTINUE -C -C ACCUMULATE PLANT STATE VARIABLES FROM BRANCH STATE VARIABLES -C - DO 8950 NB=1,NBR(NZ,NY,NX) - CPOOLP(NZ,NY,NX)=CPOOLP(NZ,NY,NX)+CPOOL(NB,NZ,NY,NX) - ZPOOLP(NZ,NY,NX)=ZPOOLP(NZ,NY,NX)+ZPOOL(NB,NZ,NY,NX) - PPOOLP(NZ,NY,NX)=PPOOLP(NZ,NY,NX)+PPOOL(NB,NZ,NY,NX) - WTSHT(NZ,NY,NX)=WTSHT(NZ,NY,NX)+WTSHTB(NB,NZ,NY,NX) - WTLF(NZ,NY,NX)=WTLF(NZ,NY,NX)+WTLFB(NB,NZ,NY,NX) - WTSHE(NZ,NY,NX)=WTSHE(NZ,NY,NX)+WTSHEB(NB,NZ,NY,NX) - WTSTK(NZ,NY,NX)=WTSTK(NZ,NY,NX)+WTSTKB(NB,NZ,NY,NX) - WVSTK(NZ,NY,NX)=WVSTK(NZ,NY,NX)+WVSTKB(NB,NZ,NY,NX) - WTRSV(NZ,NY,NX)=WTRSV(NZ,NY,NX)+WTRSVB(NB,NZ,NY,NX) - WTHSK(NZ,NY,NX)=WTHSK(NZ,NY,NX)+WTHSKB(NB,NZ,NY,NX) - WTEAR(NZ,NY,NX)=WTEAR(NZ,NY,NX)+WTEARB(NB,NZ,NY,NX) - WTGR(NZ,NY,NX)=WTGR(NZ,NY,NX)+WTGRB(NB,NZ,NY,NX) - WTLS(NZ,NY,NX)=WTLS(NZ,NY,NX)+WTLSB(NB,NZ,NY,NX) - WTSHN(NZ,NY,NX)=WTSHN(NZ,NY,NX)+WTSHTN(NB,NZ,NY,NX) - WTLFN(NZ,NY,NX)=WTLFN(NZ,NY,NX)+WTLFBN(NB,NZ,NY,NX) - WTSHEN(NZ,NY,NX)=WTSHEN(NZ,NY,NX)+WTSHBN(NB,NZ,NY,NX) - WTSTKN(NZ,NY,NX)=WTSTKN(NZ,NY,NX)+WTSTBN(NB,NZ,NY,NX) - WTRSVN(NZ,NY,NX)=WTRSVN(NZ,NY,NX)+WTRSBN(NB,NZ,NY,NX) - WTHSKN(NZ,NY,NX)=WTHSKN(NZ,NY,NX)+WTHSBN(NB,NZ,NY,NX) - WTEARN(NZ,NY,NX)=WTEARN(NZ,NY,NX)+WTEABN(NB,NZ,NY,NX) - WTGRNN(NZ,NY,NX)=WTGRNN(NZ,NY,NX)+WTGRBN(NB,NZ,NY,NX) - WTSHP(NZ,NY,NX)=WTSHP(NZ,NY,NX)+WTSHTP(NB,NZ,NY,NX) - WTLFP(NZ,NY,NX)=WTLFP(NZ,NY,NX)+WTLFBP(NB,NZ,NY,NX) - WTSHEP(NZ,NY,NX)=WTSHEP(NZ,NY,NX)+WTSHBP(NB,NZ,NY,NX) - WTSTKP(NZ,NY,NX)=WTSTKP(NZ,NY,NX)+WTSTBP(NB,NZ,NY,NX) - WTRSVP(NZ,NY,NX)=WTRSVP(NZ,NY,NX)+WTRSBP(NB,NZ,NY,NX) - WTHSKP(NZ,NY,NX)=WTHSKP(NZ,NY,NX)+WTHSBP(NB,NZ,NY,NX) - WTEARP(NZ,NY,NX)=WTEARP(NZ,NY,NX)+WTEABP(NB,NZ,NY,NX) - WTGRNP(NZ,NY,NX)=WTGRNP(NZ,NY,NX)+WTGRBP(NB,NZ,NY,NX) - ARLFP(NZ,NY,NX)=ARLFP(NZ,NY,NX)+ARLFB(NB,NZ,NY,NX) - GRNO(NZ,NY,NX)=GRNO(NZ,NY,NX)+GRNOB(NB,NZ,NY,NX) - DO 8945 L=1,JC - ARSTP(NZ,NY,NX)=ARSTP(NZ,NY,NX)+ARSTK(L,NB,NZ,NY,NX) - ARSTV(L,NZ,NY,NX)=ARSTV(L,NZ,NY,NX)+ARSTK(L,NB,NZ,NY,NX) -8945 CONTINUE -8950 CONTINUE -C -C ACCUMULATE ROOT STATE VARIABLES FROM ROOT LAYER STATE VARIABLES -C -C IF(WTLS(NZ,NY,NX).LE.0.0)ARLFP(NZ,NY,NX)=0.0 - DO 8925 N=1,MY(NZ,NY,NX) - DO 8930 L=NU(NY,NX),NJ(NY,NX) - WTRT(NZ,NY,NX)=WTRT(NZ,NY,NX)+CPOOLR(N,L,NZ,NY,NX) - WTRTN(NZ,NY,NX)=WTRTN(NZ,NY,NX)+ZPOOLR(N,L,NZ,NY,NX) - WTRTP(NZ,NY,NX)=WTRTP(NZ,NY,NX)+PPOOLR(N,L,NZ,NY,NX) - DO 8935 NR=1,NRT(NZ,NY,NX) - WTRT(NZ,NY,NX)=WTRT(NZ,NY,NX)+WTRT1(N,L,NR,NZ,NY,NX) - 2+WTRT2(N,L,NR,NZ,NY,NX) - WTRTS(NZ,NY,NX)=WTRTS(NZ,NY,NX)+WTRT1(N,L,NR,NZ,NY,NX) - 2+WTRT2(N,L,NR,NZ,NY,NX) - WTRTN(NZ,NY,NX)=WTRTN(NZ,NY,NX)+WTRT1N(N,L,NR,NZ,NY,NX) - 2+WTRT2N(N,L,NR,NZ,NY,NX) - WTRTP(NZ,NY,NX)=WTRTP(NZ,NY,NX)+WTRT1P(N,L,NR,NZ,NY,NX) - 2+WTRT2P(N,L,NR,NZ,NY,NX) -8935 CONTINUE -8930 CONTINUE -8925 CONTINUE -C -C ACCUMULATE NODULE STATE VATIABLES FROM NODULE LAYER VARIABLES -C - IF(INTYP(NZ,NY,NX).NE.0)THEN - WTND(NZ,NY,NX)=0.0 - WTNDN(NZ,NY,NX)=0.0 - WTNDP(NZ,NY,NX)=0.0 - IF(INTYP(NZ,NY,NX).GE.3)THEN - DO 7950 NB=1,NBR(NZ,NY,NX) - CPOLNP(NZ,NY,NX)=CPOLNP(NZ,NY,NX)+CPOLNB(NB,NZ,NY,NX) - ZPOLNP(NZ,NY,NX)=ZPOLNP(NZ,NY,NX)+ZPOLNB(NB,NZ,NY,NX) - PPOLNP(NZ,NY,NX)=PPOLNP(NZ,NY,NX)+PPOLNB(NB,NZ,NY,NX) - WTND(NZ,NY,NX)=WTND(NZ,NY,NX)+WTNDB(NB,NZ,NY,NX) - 2+CPOLNB(NB,NZ,NY,NX) - WTNDN(NZ,NY,NX)=WTNDN(NZ,NY,NX)+WTNDBN(NB,NZ,NY,NX) - 2+ZPOLNB(NB,NZ,NY,NX) - WTNDP(NZ,NY,NX)=WTNDP(NZ,NY,NX)+WTNDBP(NB,NZ,NY,NX) - 2+PPOLNB(NB,NZ,NY,NX) -7950 CONTINUE - ELSEIF(INTYP(NZ,NY,NX).EQ.1.OR.INTYP(NZ,NY,NX).EQ.2)THEN - DO 8920 L=NU(NY,NX),NI(NZ,NY,NX) - WTND(NZ,NY,NX)=WTND(NZ,NY,NX)+WTNDL(L,NZ,NY,NX) - 2+CPOOLN(L,NZ,NY,NX) - WTNDN(NZ,NY,NX)=WTNDN(NZ,NY,NX)+WTNDLN(L,NZ,NY,NX) - 2+ZPOOLN(L,NZ,NY,NX) - WTNDP(NZ,NY,NX)=WTNDP(NZ,NY,NX)+WTNDLP(L,NZ,NY,NX) - 2+PPOOLN(L,NZ,NY,NX) -8920 CONTINUE - ENDIF - ENDIF -C -C ACCUMULATE TOTAL SOIL-PLANT C,N,P EXCHANGE -C - HCUPTK(NZ,NY,NX)=UPOMC(NZ,NY,NX) - HZUPTK(NZ,NY,NX)=UPOMN(NZ,NY,NX)+UPNH4(NZ,NY,NX)+UPNO3(NZ,NY,NX) - 2+UPNF(NZ,NY,NX) - HPUPTK(NZ,NY,NX)=UPOMP(NZ,NY,NX)+UPH2P(NZ,NY,NX) - TCUPTK(NZ,NY,NX)=TCUPTK(NZ,NY,NX)+UPOMC(NZ,NY,NX) - TZUPTK(NZ,NY,NX)=TZUPTK(NZ,NY,NX)+UPOMN(NZ,NY,NX)+UPNH4(NZ,NY,NX) - 2+UPNO3(NZ,NY,NX) - TPUPTK(NZ,NY,NX)=TPUPTK(NZ,NY,NX)+UPOMP(NZ,NY,NX)+UPH2P(NZ,NY,NX) - TZUPFX(NZ,NY,NX)=TZUPFX(NZ,NY,NX)+UPNF(NZ,NY,NX)+UPNFC(NZ,NY,NX) - ENDIF -C -C HARVEST STANDING DEAD -C - IF(IHVST(NZ,I,NY,NX).GE.0)THEN - IF(J.EQ.INT(ZNOON(NY,NX)).AND.IHVST(NZ,I,NY,NX).NE.4 - 2.AND.IHVST(NZ,I,NY,NX).NE.6)THEN - IF(THIN(NZ,I,NY,NX).EQ.0.0)THEN - FHVST=AMAX1(0.0,1.0-EHVST(1,4,NZ,I,NY,NX)) - FHVSH=FHVST - ELSE - FHVST=AMAX1(0.0,1.0-THIN(NZ,I,NY,NX)) - IF(IHVST(NZ,I,NY,NX).EQ.0)THEN - FHVSH=AMAX1(0.0,1.0-EHVST(1,4,NZ,I,NY,NX)*THIN(NZ,I,NY,NX)) - ELSE - FHVSH=FHVST - ENDIF - ENDIF - ELSEIF(IHVST(NZ,I,NY,NX).EQ.4.OR.IHVST(NZ,I,NY,NX).EQ.6)THEN - IF(WTSTG(NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - WHVSTD=HVST(NZ,I,NY,NX)*THIN(NZ,I,NY,NX)*0.45/24.0 - 2*AREA(3,NU(NY,NX),NY,NX)*EHVST(1,4,NZ,I,NY,NX) - FHVST=AMAX1(0.0,1.0-WHVSTD/WTSTG(NZ,NY,NX)) - FHVSH=FHVST - ELSE - FHVST=1.0 - FHVSH=1.0 - ENDIF - ELSE - FHVST=1.0 - FHVSH=1.0 - ENDIF - DO 6475 M=1,4 - WTHTH4=WTHTH4+(1.0-FHVSH)*WTSTDG(M,NZ,NY,NX) - WTHNH4=WTHNH4+(1.0-FHVSH)*WTSTDN(M,NZ,NY,NX) - WTHPH4=WTHPH4+(1.0-FHVSH)*WTSTDP(M,NZ,NY,NX) - WTHTX4=WTHTX4+(FHVSH-FHVST)*WTSTDG(M,NZ,NY,NX) - WTHNX4=WTHNX4+(FHVSH-FHVST)*WTSTDN(M,NZ,NY,NX) - WTHPX4=WTHPX4+(FHVSH-FHVST)*WTSTDP(M,NZ,NY,NX) - WTSTDG(M,NZ,NY,NX)=FHVST*WTSTDG(M,NZ,NY,NX) - WTSTDN(M,NZ,NY,NX)=FHVST*WTSTDN(M,NZ,NY,NX) - WTSTDP(M,NZ,NY,NX)=FHVST*WTSTDP(M,NZ,NY,NX) -6475 CONTINUE -C -C IF NO PLANT C,N,P REMOVED AT HARVEST (ALL RESIDUE RETURNED) -C - IF(IHVST(NZ,I,NY,NX).EQ.0)THEN - WTHTR0=WTHTH0*(1.0-EHVST(2,1,NZ,I,NY,NX)) - WTHNR0=WTHNH0*(1.0-EHVST(2,1,NZ,I,NY,NX)) - WTHPR0=WTHPH0*(1.0-EHVST(2,1,NZ,I,NY,NX)) - WTHTR1=WTHTH1*(1.0-EHVST(2,1,NZ,I,NY,NX)) - WTHNR1=WTHNH1*(1.0-EHVST(2,1,NZ,I,NY,NX)) - WTHPR1=WTHPH1*(1.0-EHVST(2,1,NZ,I,NY,NX)) - WTHTR2=WTHTH2*(1.0-EHVST(2,2,NZ,I,NY,NX)) - WTHNR2=WTHNH2*(1.0-EHVST(2,2,NZ,I,NY,NX)) - WTHPR2=WTHPH2*(1.0-EHVST(2,2,NZ,I,NY,NX)) - WTHTR3=WTHTH3*(1.0-EHVST(2,3,NZ,I,NY,NX)) - WTHNR3=WTHNH3*(1.0-EHVST(2,3,NZ,I,NY,NX)) - WTHPR3=WTHPH3*(1.0-EHVST(2,3,NZ,I,NY,NX)) - WTHTR4=WTHTH4*(1.0-EHVST(2,4,NZ,I,NY,NX)) - WTHNR4=WTHNH4*(1.0-EHVST(2,4,NZ,I,NY,NX)) - WTHPR4=WTHPH4*(1.0-EHVST(2,4,NZ,I,NY,NX)) -C -C IF ONLY GRAIN C,N,P REMOVED AT HARVEST -C - ELSEIF(IHVST(NZ,I,NY,NX).EQ.1)THEN - WTHTR0=WTHTH0 - WTHNR0=WTHNH0 - WTHPR0=WTHPH0 - WTHTR1=WTHTH1 - WTHNR1=WTHNH1 - WTHPR1=WTHPH1 - WTHTR2=WTHTH2-WTHTG*EHVST(2,2,NZ,I,NY,NX) - WTHNR2=WTHNH2-WTHNG*EHVST(2,2,NZ,I,NY,NX) - WTHPR2=WTHPH2-WTHPG*EHVST(2,2,NZ,I,NY,NX) - WTHTR3=WTHTH3 - WTHNR3=WTHNH3 - WTHPR3=WTHPH3 - WTHTR4=WTHTH4 - WTHNR4=WTHNH4 - WTHPR4=WTHPH4 -C -C IF ONLY WOOD C,N,P REMOVED AT HARVEST -C - ELSEIF(IHVST(NZ,I,NY,NX).EQ.2)THEN - WTHTR0=WTHTH0*(1.0-EHVST(2,1,NZ,I,NY,NX)) - WTHNR0=WTHNH0*(1.0-EHVST(2,1,NZ,I,NY,NX)) - WTHPR0=WTHPH0*(1.0-EHVST(2,1,NZ,I,NY,NX)) - WTHTR1=WTHTH1*(1.0-EHVST(2,1,NZ,I,NY,NX)) - WTHNR1=WTHNH1*(1.0-EHVST(2,1,NZ,I,NY,NX)) - WTHPR1=WTHPH1*(1.0-EHVST(2,1,NZ,I,NY,NX)) - WTHTR2=WTHTH2*(1.0-EHVST(2,2,NZ,I,NY,NX)) - WTHNR2=WTHNH2*(1.0-EHVST(2,2,NZ,I,NY,NX)) - WTHPR2=WTHPH2*(1.0-EHVST(2,2,NZ,I,NY,NX)) - WTHTR3=WTHTH3*(1.0-EHVST(2,3,NZ,I,NY,NX)) - WTHNR3=WTHNH3*(1.0-EHVST(2,3,NZ,I,NY,NX)) - WTHPR3=WTHPH3*(1.0-EHVST(2,3,NZ,I,NY,NX)) - WTHTR4=WTHTH4*(1.0-EHVST(2,4,NZ,I,NY,NX)) - WTHNR4=WTHNH4*(1.0-EHVST(2,4,NZ,I,NY,NX)) - WTHPR4=WTHPH4*(1.0-EHVST(2,4,NZ,I,NY,NX)) -C -C IF ALL PLANT C,N,P REMOVED AT HARVEST (NO RESIDUE RETURNED) -C - ELSEIF(IHVST(NZ,I,NY,NX).EQ.3)THEN - WTHTR0=WTHTH0*(1.0-EHVST(2,1,NZ,I,NY,NX)) - WTHNR0=WTHNH0*(1.0-EHVST(2,1,NZ,I,NY,NX)) - WTHPR0=WTHPH0*(1.0-EHVST(2,1,NZ,I,NY,NX)) - WTHTR1=WTHTH1*(1.0-EHVST(2,1,NZ,I,NY,NX)) - WTHNR1=WTHNH1*(1.0-EHVST(2,1,NZ,I,NY,NX)) - WTHPR1=WTHPH1*(1.0-EHVST(2,1,NZ,I,NY,NX)) - WTHTR2=WTHTH2*(1.0-EHVST(2,2,NZ,I,NY,NX)) - WTHNR2=WTHNH2*(1.0-EHVST(2,2,NZ,I,NY,NX)) - WTHPR2=WTHPH2*(1.0-EHVST(2,2,NZ,I,NY,NX)) - WTHTR3=WTHTH3*(1.0-EHVST(2,3,NZ,I,NY,NX)) - WTHNR3=WTHNH3*(1.0-EHVST(2,3,NZ,I,NY,NX)) - WTHPR3=WTHPH3*(1.0-EHVST(2,3,NZ,I,NY,NX)) - WTHTR4=WTHTH4*(1.0-EHVST(2,4,NZ,I,NY,NX)) - WTHNR4=WTHNH4*(1.0-EHVST(2,4,NZ,I,NY,NX)) - WTHPR4=WTHPH4*(1.0-EHVST(2,4,NZ,I,NY,NX)) -C -C IF PLANT C,N,P REMOVED BY GRAZING -C - ELSEIF(IHVST(NZ,I,NY,NX).EQ.4.OR.IHVST(NZ,I,NY,NX).EQ.6)THEN - WTHTR0=WTHTH0*(1.0-EHVST(2,1,NZ,I,NY,NX)) - WTHNR0=WTHNH0*(1.0-EHVST(2,1,NZ,I,NY,NX)*0.5) - WTHPR0=WTHPH0*(1.0-EHVST(2,1,NZ,I,NY,NX)*0.5) - WTHTR1=WTHTH1*(1.0-EHVST(2,1,NZ,I,NY,NX)) - WTHNR1=WTHNH1*(1.0-EHVST(2,1,NZ,I,NY,NX)*0.5) - WTHPR1=WTHPH1*(1.0-EHVST(2,1,NZ,I,NY,NX)*0.5) - WTHTR2=WTHTH2*(1.0-EHVST(2,2,NZ,I,NY,NX)) - WTHNR2=WTHNH2*(1.0-EHVST(2,2,NZ,I,NY,NX)*0.5) - WTHPR2=WTHPH2*(1.0-EHVST(2,2,NZ,I,NY,NX)*0.5) - WTHTR3=WTHTH3*(1.0-EHVST(2,3,NZ,I,NY,NX)) - WTHNR3=WTHNH3*(1.0-EHVST(2,3,NZ,I,NY,NX)*0.5) - WTHPR3=WTHPH3*(1.0-EHVST(2,3,NZ,I,NY,NX)*0.5) - WTHTR4=WTHTH4*(1.0-EHVST(2,4,NZ,I,NY,NX)) - WTHNR4=WTHNH4*(1.0-EHVST(2,4,NZ,I,NY,NX)*0.5) - WTHPR4=WTHPH4*(1.0-EHVST(2,4,NZ,I,NY,NX)*0.5) -C -C ADD MANURE FROM GRAZING NEXT DAY -C - FERT(17,I+1,NY,NX)=FERT(17,I+1,NY,NX) - 2+(WTHTR1+WTHTR2+WTHTR3+WTHTR4)/AREA(3,NU(NY,NX),NY,NX) - FERT(18,I+1,NY,NX)=FERT(18,I+1,NY,NX) - 2+(WTHNR1+WTHNR2+WTHNR3+WTHNR4)/AREA(3,NU(NY,NX),NY,NX)*0.5 - FERT(3,I+1,NY,NX)=FERT(3,I+1,NY,NX) - 2+(WTHNR1+WTHNR2+WTHNR3+WTHNR4)/AREA(3,NU(NY,NX),NY,NX)*0.5 - FERT(19,I+1,NY,NX)=FERT(19,I+1,NY,NX) - 2+(WTHPR1+WTHPR2+WTHPR3+WTHPR4)/AREA(3,NU(NY,NX),NY,NX) - IYTYP(2,I+1,NY,NX)=3 -C IF(NX.EQ.2)THEN -C WRITE(*,6542)'MANURE',I,J,NX,NY,NZ,FERT(2,I+1,NY,NX) -C 2,WTHNR1,WTHNR2,WTHNR3,WTHNR4,WTHNH1,WTHNH2,WTHNH3 -C 3,WTHNH4 -6542 FORMAT(A8,5I4,20E12.4) -C ENDIF -C -C FIRE -C - ELSEIF(IHVST(NZ,I,NY,NX).EQ.5)THEN - WTHTR0=WTHTH0*(1.0-EHVST(2,1,NZ,I,NY,NX)) - WTHNR0=WTHNH0*(1.0-EFIRE(1,IHVST(NZ,I,NY,NX)) - 2*EHVST(2,1,NZ,I,NY,NX)) - WTHPR0=WTHPH0*(1.0-EFIRE(2,IHVST(NZ,I,NY,NX)) - 2*EHVST(2,1,NZ,I,NY,NX)) - WTHNL0=WTHNH0*(1.0-EHVST(2,1,NZ,I,NY,NX)) - WTHPL0=WTHPH0*(1.0-EHVST(2,1,NZ,I,NY,NX)) - WTHTR1=WTHTH1*(1.0-EHVST(2,1,NZ,I,NY,NX)) - WTHNR1=WTHNH1*(1.0-EFIRE(1,IHVST(NZ,I,NY,NX)) - 2*EHVST(2,1,NZ,I,NY,NX)) - WTHPR1=WTHPH1*(1.0-EFIRE(2,IHVST(NZ,I,NY,NX)) - 2*EHVST(2,1,NZ,I,NY,NX)) - WTHNL1=WTHNH1*(1.0-EHVST(2,1,NZ,I,NY,NX)) - WTHPL1=WTHPH1*(1.0-EHVST(2,1,NZ,I,NY,NX)) - WTHTR2=WTHTH2*(1.0-EHVST(2,2,NZ,I,NY,NX)) - WTHNR2=WTHNH2*(1.0-EFIRE(1,IHVST(NZ,I,NY,NX)) - 2*EHVST(2,2,NZ,I,NY,NX)) - WTHPR2=WTHPH2*(1.0-EFIRE(2,IHVST(NZ,I,NY,NX)) - 2*EHVST(2,2,NZ,I,NY,NX)) - WTHNL2=WTHNH2*(1.0-EHVST(2,2,NZ,I,NY,NX)) - WTHPL2=WTHPH2*(1.0-EHVST(2,2,NZ,I,NY,NX)) - WTHTR3=WTHTH3*(1.0-EHVST(2,3,NZ,I,NY,NX)) - WTHNR3=WTHNH3*(1.0-EFIRE(1,IHVST(NZ,I,NY,NX)) - 2*EHVST(2,3,NZ,I,NY,NX)) - WTHPR3=WTHPH3*(1.0-EFIRE(2,IHVST(NZ,I,NY,NX)) - 2*EHVST(2,3,NZ,I,NY,NX)) - WTHNL3=WTHNH3*(1.0-EHVST(2,3,NZ,I,NY,NX)) - WTHPL3=WTHPH3*(1.0-EHVST(2,3,NZ,I,NY,NX)) - WTHTR4=WTHTH4*(1.0-EHVST(2,4,NZ,I,NY,NX)) - WTHNR4=WTHNH4*(1.0-EFIRE(1,IHVST(NZ,I,NY,NX)) - 2*EHVST(2,4,NZ,I,NY,NX)) - WTHPR4=WTHPH4*(1.0-EFIRE(2,IHVST(NZ,I,NY,NX)) - 2*EHVST(2,4,NZ,I,NY,NX)) - WTHNL4=WTHNH4*(1.0-EHVST(2,4,NZ,I,NY,NX)) - WTHPL4=WTHPH4*(1.0-EHVST(2,4,NZ,I,NY,NX)) - ENDIF -C -C C,N,P REMOVED FROM HARVESTING -C - WTHTHT=WTHTH0+WTHTH1+WTHTH2+WTHTH3+WTHTH4 - WTHTRT=WTHTR0+WTHTR1+WTHTR2+WTHTR3+WTHTR4 - WTHNHT=WTHNH0+WTHNH1+WTHNH2+WTHNH3+WTHNH4 - WTHNRT=WTHNR0+WTHNR1+WTHNR2+WTHNR3+WTHNR4 - WTHPHT=WTHPH0+WTHPH1+WTHPH2+WTHPH3+WTHPH4 - WTHPRT=WTHPR0+WTHPR1+WTHPR2+WTHPR3+WTHPR4 - WTHTXT=WTHTX0+WTHTX1+WTHTX2+WTHTX3+WTHTX4 - WTHNXT=WTHNX0+WTHNX1+WTHNX2+WTHNX3+WTHNX4 - WTHPXT=WTHPX0+WTHPX1+WTHPX2+WTHPX3+WTHPX4 - IF(IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6)THEN - IF(IHVST(NZ,I,NY,NX).NE.5)THEN - IF(JHVST(NZ,I,NY,NX).NE.2)THEN - HVSTC(NZ,NY,NX)=HVSTC(NZ,NY,NX)+WTHTHT-WTHTRT - HVSTN(NZ,NY,NX)=HVSTN(NZ,NY,NX)+WTHNHT-WTHNRT - HVSTP(NZ,NY,NX)=HVSTP(NZ,NY,NX)+WTHPHT-WTHPRT - TNBP(NY,NX)=TNBP(NY,NX)+WTHTRT-WTHTHT - XHVSTC(NY,NX)=XHVSTC(NY,NX)+WTHTHT-WTHTRT - XHVSTN(NY,NX)=XHVSTN(NY,NX)+WTHNHT-WTHNRT - XHVSTP(NY,NX)=XHVSTP(NY,NX)+WTHPHT-WTHPRT - ELSE - WTRVC(NZ,NY,NX)=WTRVC(NZ,NY,NX)+WTHTHT-WTHTRT - WTRVN(NZ,NY,NX)=WTRVN(NZ,NY,NX)+WTHNHT-WTHNRT - WTRVP(NZ,NY,NX)=WTRVP(NZ,NY,NX)+WTHPHT-WTHPRT - ENDIF -C -C C,N,P LOST AS GAS IF FIRE -C - ELSE - VCO2F(NZ,NY,NX)=VCO2F(NZ,NY,NX)-(1.0-FCH4F)*(WTHTHT-WTHTRT) - VCH4F(NZ,NY,NX)=VCH4F(NZ,NY,NX)-FCH4F*(WTHTHT-WTHTRT) - VOXYF(NZ,NY,NX)=VOXYF(NZ,NY,NX)-(1.0-FCH4F)*(WTHTHT-WTHTRT)*2.667 - VNH3F(NZ,NY,NX)=VNH3F(NZ,NY,NX)-WTHNHT+WTHNRT - VN2OF(NZ,NY,NX)=VN2OF(NZ,NY,NX)-0.0 - VPO4F(NZ,NY,NX)=VPO4F(NZ,NY,NX)-WTHPHT+WTHPRT - CNET(NZ,NY,NX)=CNET(NZ,NY,NX)-(1.0-FCH4F)*(WTHTHT-WTHTRT) - TNBP(NY,NX)=TNBP(NY,NX)-FCH4F*(WTHTHT-WTHTRT) -C WRITE(*,5679)'FIRE2',I,J,NZ,VCO2F(NZ,NY,NX),FCH4F,WTHNH0,WTHNH1,WTHNH2 -C 3,WTHNH3,WTHNH4,WTHNR0,WTHNR1,WTHNR2,WTHNR3,WTHNR4,WTHNHT,WTHNRT -5679 FORMAT(A8,3I4,20E12.4) - ENDIF -C -C C,N,P REMOVED FROM GRAZING -C - ELSE - HVSTC(NZ,NY,NX)=HVSTC(NZ,NY,NX)+GY*(WTHTHT-WTHTRT) - TCO2T(NZ,NY,NX)=TCO2T(NZ,NY,NX)-GZ*(WTHTHT-WTHTRT) - TCO2A(NZ,NY,NX)=TCO2A(NZ,NY,NX)-GZ*(WTHTHT-WTHTRT) - HVSTN(NZ,NY,NX)=HVSTN(NZ,NY,NX)+WTHNHT-WTHNRT - HVSTP(NZ,NY,NX)=HVSTP(NZ,NY,NX)+WTHPHT-WTHPRT - TNBP(NY,NX)=TNBP(NY,NX)+GY*(WTHTRT-WTHTHT) - CNET(NZ,NY,NX)=CNET(NZ,NY,NX)+GZ*(WTHTRT-WTHTHT) - XHVSTC(NY,NX)=XHVSTC(NY,NX)+GY*(WTHTHT-WTHTRT) - XHVSTN(NY,NX)=XHVSTN(NY,NX)+WTHNHT-WTHNRT - XHVSTP(NY,NX)=XHVSTP(NY,NX)+WTHPHT-WTHPRT - RECO(NY,NX)=RECO(NY,NX)-GZ*(WTHTHT-WTHTRT) - TRAU(NY,NX)=TRAU(NY,NX)-GZ*(WTHTHT-WTHTRT) - ENDIF -C -C ABOVE-GROUND LITTERFALL FROM HARVESTING -C - IF(IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6)THEN - IF(IHVST(NZ,I,NY,NX).NE.5)THEN - DO 6375 M=1,4 - CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) - 2+CFOPC(0,M,NZ,NY,NX)*(WTHTR0+WTHTX0) - 3+CFOPC(1,M,NZ,NY,NX)*(WTHTR1+WTHTX1) - 4+CFOPC(2,M,NZ,NY,NX)*(WTHTR2+WTHTX2) - ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) - 2+CFOPN(0,M,NZ,NY,NX)*(WTHNR0+WTHNX0) - 3+CFOPN(1,M,NZ,NY,NX)*(WTHNR1+WTHNX1) - 4+CFOPN(2,M,NZ,NY,NX)*(WTHNR2+WTHNX2) - PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) - 2+CFOPP(0,M,NZ,NY,NX)*(WTHPR0+WTHPX0) - 3+CFOPP(1,M,NZ,NY,NX)*(WTHPR1+WTHPX1) - 4+CFOPP(2,M,NZ,NY,NX)*(WTHPR2+WTHPX2) - IF(IBTYP(NZ,NY,NX).EQ.0.OR.IGTYP(NZ,NY,NX).LE.1)THEN - CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) - 2+CFOPC(3,M,NZ,NY,NX)*(WTHTR3+WTHTX3+WTHTR4+WTHTX4) - ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) - 2+CFOPN(3,M,NZ,NY,NX)*(WTHNR3+WTHNX3+WTHNR4+WTHNX4) - PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) - 2+CFOPP(3,M,NZ,NY,NX)*(WTHPR3+WTHPX3+WTHPR4+WTHPX4) - ELSE - WTSTDG(M,NZ,NY,NX)=WTSTDG(M,NZ,NY,NX) - 2+CFOPC(5,M,NZ,NY,NX)*(WTHTX3+WTHTX4) - WTSTDN(M,NZ,NY,NX)=WTSTDN(M,NZ,NY,NX) - 2+CFOPN(5,M,NZ,NY,NX)*(WTHNX3+WTHNX4) - WTSTDP(M,NZ,NY,NX)=WTSTDP(M,NZ,NY,NX) - 2+CFOPP(5,M,NZ,NY,NX)*(WTHPX3+WTHPX4) - CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX) - 2+FRC*CFOPC(5,M,NZ,NY,NX)*(WTHTR3+WTHTR4) - ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX) - 2+FRC*CFOPN(5,M,NZ,NY,NX)*(WTHNR3+WTHNR4) - PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX) - 2+FRC*CFOPP(5,M,NZ,NY,NX)*(WTHPR3+WTHPR4) - CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) - 2+FRF*CFOPC(5,M,NZ,NY,NX)*(WTHTR3+WTHTR4) - ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) - 2+FRF*CFOPN(5,M,NZ,NY,NX)*(WTHNR3+WTHNR4) - PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) - 2+FRF*CFOPP(5,M,NZ,NY,NX)*(WTHPR3+WTHPR4) - ENDIF -6375 CONTINUE -C -C ABOVE-GROUND LITTERFALL FROM FIRE -C - ELSE - DO 6485 M=1,4 - CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) - 2+CFOPC(0,M,NZ,NY,NX)*(WTHTR0+WTHTX0) - 3+CFOPC(1,M,NZ,NY,NX)*(WTHTR1+WTHTX1) - 4+CFOPC(2,M,NZ,NY,NX)*(WTHTR2+WTHTX2) - ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) - 2+CFOPN(0,M,NZ,NY,NX)*WTHNL0 - 3+CFOPN(1,M,NZ,NY,NX)*WTHNL1 - 4+CFOPN(2,M,NZ,NY,NX)*WTHNL2 - PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) - 2+CFOPP(0,M,NZ,NY,NX)*WTHPL0 - 3+CFOPP(1,M,NZ,NY,NX)*WTHPL1 - 4+CFOPP(2,M,NZ,NY,NX)*WTHPL2 - ZSNC(4,1,0,NZ,NY,NX)=ZSNC(4,1,0,NZ,NY,NX) - 2+CFOPN(0,M,NZ,NY,NX)*(WTHNR0+WTHNX0-WTHNL0) - 3+CFOPN(1,M,NZ,NY,NX)*(WTHNR1+WTHNX1-WTHNL1) - 4+CFOPN(2,M,NZ,NY,NX)*(WTHNR2+WTHNX2-WTHNL2) - PSNC(4,1,0,NZ,NY,NX)=PSNC(4,1,0,NZ,NY,NX) - 2+CFOPP(0,M,NZ,NY,NX)*(WTHPR0+WTHPX0-WTHPL0) - 3+CFOPP(1,M,NZ,NY,NX)*(WTHPR1+WTHPX1-WTHPL1) - 4+CFOPP(2,M,NZ,NY,NX)*(WTHPR2+WTHPX2-WTHPL2) - IF(IBTYP(NZ,NY,NX).EQ.0.OR.IGTYP(NZ,NY,NX).LE.1)THEN - CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) - 2+CFOPC(3,M,NZ,NY,NX)*(WTHTR3+WTHTX3+WTHTR4+WTHTX4) - ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) - 2+CFOPN(3,M,NZ,NY,NX)*(WTHNL3+WTHNL4) - PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) - 2+CFOPP(3,M,NZ,NY,NX)*(WTHPL3+WTHPL4) - ZSNC(4,1,0,NZ,NY,NX)=ZSNC(4,1,0,NZ,NY,NX) - 2+CFOPN(3,M,NZ,NY,NX)*(WTHNR3+WTHNX3-WTHNL3+WTHNR4+WTHNX4-WTHNL4) - PSNC(4,1,0,NZ,NY,NX)=PSNC(4,1,0,NZ,NY,NX) - 2+CFOPP(3,M,NZ,NY,NX)*(WTHPR3+WTHPX3-WTHPL3+WTHPR4+WTHPX4-WTHPL4) - ELSE - WTSTDG(M,NZ,NY,NX)=WTSTDG(M,NZ,NY,NX) - 2+CFOPC(5,M,NZ,NY,NX)*(WTHTR3+WTHTX3) - WTSTDN(M,NZ,NY,NX)=WTSTDN(M,NZ,NY,NX) - 2+CFOPN(5,M,NZ,NY,NX)*WTHNL3 - WTSTDP(M,NZ,NY,NX)=WTSTDP(M,NZ,NY,NX) - 2+CFOPP(5,M,NZ,NY,NX)*WTHPL3 - CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX) - 2+FRC*CFOPC(3,M,NZ,NY,NX)*(WTHTR4+WTHTX4) - ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX) - 2+FRC*CFOPN(3,M,NZ,NY,NX)*WTHNL4 - PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX) - 2+FRC*CFOPP(3,M,NZ,NY,NX)*WTHPL4 - ZSNC(4,0,0,NZ,NY,NX)=ZSNC(4,0,0,NZ,NY,NX) - 2+FRC*CFOPN(5,M,NZ,NY,NX)*(WTHNR3+WTHNX3-WTHNL3 - 3+WTHNR4+WTHNX4-WTHNL4) - PSNC(4,0,0,NZ,NY,NX)=PSNC(4,0,0,NZ,NY,NX) - 2+FRC*CFOPP(5,M,NZ,NY,NX)*(WTHPR3+WTHPX3-WTHPL3 - 3+WTHPR4+WTHPX4-WTHPL4) - CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) - 2+FRF*CFOPC(3,M,NZ,NY,NX)*(WTHTR4+WTHTX4) - ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) - 2+FRF*CFOPN(3,M,NZ,NY,NX)*WTHNL4 - PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) - 2+FRF*CFOPP(3,M,NZ,NY,NX)*WTHPL4 - ZSNC(4,1,0,NZ,NY,NX)=ZSNC(4,1,0,NZ,NY,NX) - 2+FRF*CFOPN(5,M,NZ,NY,NX)*(WTHNR3+WTHNX3-WTHNL3 - 3+WTHNR4+WTHNX4-WTHNL4) - PSNC(4,1,0,NZ,NY,NX)=PSNC(4,1,0,NZ,NY,NX) - 2+FRF*CFOPP(5,M,NZ,NY,NX)*(WTHPR3+WTHPX3-WTHPL3 - 3+WTHPR4+WTHPX4-WTHPL4) - ENDIF -6485 CONTINUE - ENDIF - ELSE -C -C ABOVE-GROUND LITTERFALL FROM GRAZING -C - TCSNC(NZ,NY,NX)=TCSNC(NZ,NY,NX)+WTHTRT+WTHTXT - TZSNC(NZ,NY,NX)=TZSNC(NZ,NY,NX)+WTHNRT+WTHNXT - TPSNC(NZ,NY,NX)=TPSNC(NZ,NY,NX)+WTHPRT+WTHPXT - TCSN0(NZ,NY,NX)=TCSN0(NZ,NY,NX)+WTHTRT+WTHTXT - TZSN0(NZ,NY,NX)=TZSNC(NZ,NY,NX)+WTHNRT+WTHNXT - TPSN0(NZ,NY,NX)=TPSNC(NZ,NY,NX)+WTHPRT+WTHPXT - ENDIF - ZEROP(NZ,NY,NX)=ZERO*PP(NZ,NY,NX) - ZEROQ(NZ,NY,NX)=ZERO*PP(NZ,NY,NX)/AREA(3,NU(NY,NX),NY,NX) - ZEROL(NZ,NY,NX)=ZERO*PP(NZ,NY,NX)*1.0E+06 - ENDIF -9985 CONTINUE -C -C TRANSFORMATIONS IN LIVING OR DEAD PLANT POPULATIONS -C - DO 9975 NZ=1,NP0(NY,NX) -C -C ACTIVATE DORMANT SEEDS -C - DO 205 NB=1,NBR(NZ,NY,NX) - IF(IFLGI(NZ,NY,NX).EQ.1)THEN - IF(IFLGE(NB,NZ,NY,NX).EQ.0 - 2.AND.VRNS(NB,NZ,NY,NX).GE.VRNL(NB,NZ,NY,NX))THEN - IDAY0(NZ,NY,NX)=I - IYR0(NZ,NY,NX)=IYRC - SDPTHI(NZ,NY,NX)=0.005 - IFLGI(NZ,NY,NX)=0 - ENDIF - ENDIF -205 CONTINUE -C -C LITTERFALL FROM STANDING DEAD -C - DO 6235 M=1,4 - XFRC=1.5814E-05*TFN3(NZ,NY,NX)*WTSTDG(M,NZ,NY,NX) - XFRN=1.5814E-05*TFN3(NZ,NY,NX)*WTSTDN(M,NZ,NY,NX) - XFRP=1.5814E-05*TFN3(NZ,NY,NX)*WTSTDP(M,NZ,NY,NX) - IF(IBTYP(NZ,NY,NX).EQ.0.OR.IGTYP(NZ,NY,NX).LE.1)THEN - CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX)+XFRC - ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX)+XFRN - PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX)+XFRP - ELSE - CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX)+XFRC - ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX)+XFRN - PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX)+XFRP - ENDIF - WTSTDG(M,NZ,NY,NX)=WTSTDG(M,NZ,NY,NX)-XFRC - WTSTDN(M,NZ,NY,NX)=WTSTDN(M,NZ,NY,NX)-XFRN - WTSTDP(M,NZ,NY,NX)=WTSTDP(M,NZ,NY,NX)-XFRP -6235 CONTINUE -C -C ACCUMULATE TOTAL SURFACE, SUBSURFACE LITTERFALL -C - DO 6430 M=1,4 - DO 6430 K=0,1 - TCSN0(NZ,NY,NX)=TCSN0(NZ,NY,NX)+CSNC(M,K,0,NZ,NY,NX) - TZSN0(NZ,NY,NX)=TZSN0(NZ,NY,NX)+ZSNC(M,K,0,NZ,NY,NX) - TPSN0(NZ,NY,NX)=TPSN0(NZ,NY,NX)+PSNC(M,K,0,NZ,NY,NX) - DO 8955 L=0,NJ(NY,NX) - HCSNC(NZ,NY,NX)=HCSNC(NZ,NY,NX)+CSNC(M,K,L,NZ,NY,NX) - HZSNC(NZ,NY,NX)=HZSNC(NZ,NY,NX)+ZSNC(M,K,L,NZ,NY,NX) - HPSNC(NZ,NY,NX)=HPSNC(NZ,NY,NX)+PSNC(M,K,L,NZ,NY,NX) - TCSNC(NZ,NY,NX)=TCSNC(NZ,NY,NX)+CSNC(M,K,L,NZ,NY,NX) - TZSNC(NZ,NY,NX)=TZSNC(NZ,NY,NX)+ZSNC(M,K,L,NZ,NY,NX) - TPSNC(NZ,NY,NX)=TPSNC(NZ,NY,NX)+PSNC(M,K,L,NZ,NY,NX) -8955 CONTINUE -6430 CONTINUE -C -C TOTAL STANDING DEAD -C - WTSTG(NZ,NY,NX)=WTSTDG(1,NZ,NY,NX)+WTSTDG(2,NZ,NY,NX) - 4+WTSTDG(3,NZ,NY,NX)+WTSTDG(4,NZ,NY,NX) - WTSTGN(NZ,NY,NX)=WTSTDN(1,NZ,NY,NX)+WTSTDN(2,NZ,NY,NX) - 4+WTSTDN(3,NZ,NY,NX)+WTSTDN(4,NZ,NY,NX) - WTSTGP(NZ,NY,NX)=WTSTDP(1,NZ,NY,NX)+WTSTDP(2,NZ,NY,NX) - 4+WTSTDP(3,NZ,NY,NX)+WTSTDP(4,NZ,NY,NX) -C -C PLANT C BALANCE = TOTAL C STATE VARIABLES + TOTAL -C AUTOTROPHIC RESPIRATION + TOTAL LITTERFALL - TOTAL EXUDATION -C - TOTAL CO2 FIXATION -C - ZNPP(NZ,NY,NX)=CARBN(NZ,NY,NX)+TCO2T(NZ,NY,NX) - IF(IFLGC(NZ,NY,NX).EQ.1)THEN - BALC(NZ,NY,NX)=WTSHT(NZ,NY,NX)+WTRT(NZ,NY,NX)+WTND(NZ,NY,NX) - 2+WTRVC(NZ,NY,NX)-ZNPP(NZ,NY,NX)+TCSNC(NZ,NY,NX)-TCUPTK(NZ,NY,NX) - 3-RSETC(NZ,NY,NX)+WTSTG(NZ,NY,NX)+THVSTC(NZ,NY,NX) - 4+HVSTC(NZ,NY,NX)-VCO2F(NZ,NY,NX)-VCH4F(NZ,NY,NX) -C IF(NZ.EQ.1)THEN -C WRITE(*,1111)'BALC',I,J,NX,NY,NZ,BALC(NZ,NY,NX),WTSHT(NZ,NY,NX) -C 2,WTRT(NZ,NY,NX),WTND(NZ,NY,NX),WTRVC(NZ,NY,NX),TCO2T(NZ,NY,NX) -C 3,TCSNC(NZ,NY,NX),TCUPTK(NZ,NY,NX),CARBN(NZ,NY,NX) -C 2,RSETC(NZ,NY,NX),WTSTG(NZ,NY,NX),THVSTC(NZ,NY,NX) -C 3,HVSTC(NZ,NY,NX),CPOOLP(NZ,NY,NX) -C 3,WTLF(NZ,NY,NX),WTSHE(NZ,NY,NX),WTSTK(NZ,NY,NX),WTRSV(NZ,NY,NX) -C 3,WTHSK(NZ,NY,NX),WTEAR(NZ,NY,NX),WTGR(NZ,NY,NX) -C 5,VCO2F(NZ,NY,NX),VCH4F(NZ,NY,NX) -C 5,(WTLFB(NB,NZ,NY,NX),NB=1,5) -C 3,((CSNC(M,0,L,NZ,NY,NX),M=1,4),L=0,NL(NY,NX)) -C 4,((CPOOLR(N,L,NZ,NY,NX),L=1,NL(NY,NX)),N=1,2) -C 4,(CPOOLK(NB,NZ,NY,NX),NB=1,10) -1111 FORMAT(A8,5I4,200F18.6) -C ENDIF -C -C PLANT N BALANCE = TOTAL N STATE VARIABLES + TOTAL N LITTERFALL -C - TOTAL N UPTAKE FROM SOIL - TOTAL N ABSORPTION FROM ATMOSPHERE -C - BALN(NZ,NY,NX)=WTSHN(NZ,NY,NX)+WTRTN(NZ,NY,NX)+WTNDN(NZ,NY,NX) - 2+WTRVN(NZ,NY,NX)+TZSNC(NZ,NY,NX)-TZUPTK(NZ,NY,NX)-TNH3C(NZ,NY,NX) - 3-RSETN(NZ,NY,NX)+WTSTGN(NZ,NY,NX)+HVSTN(NZ,NY,NX)+THVSTN(NZ,NY,NX) - 4-VNH3F(NZ,NY,NX)-VN2OF(NZ,NY,NX)-TZUPFX(NZ,NY,NX) -C IF(NZ.EQ.1)THEN -C WRITE(*,1112)'BALN',I,J,NX,NY,NZ,BALN(NZ,NY,NX),WTSHN(NZ,NY,NX) -C 2,WTRTN(NZ,NY,NX),WTNDN(NZ,NY,NX),WTRVN(NZ,NY,NX),TZSNC(NZ,NY,NX) -C 3,TZUPTK(NZ,NY,NX),TNH3C(NZ,NY,NX),RSETN(NZ,NY,NX),HVSTN(NZ,NY,NX) -C 4,WTSTGN(NZ,NY,NX),WTLFN(NZ,NY,NX),WTSHEN(NZ,NY,NX) -C 5,WTSTKN(NZ,NY,NX),WTRSVN(NZ,NY,NX),WTHSKN(NZ,NY,NX) -C 3,WTEARN(NZ,NY,NX),WTGRNN(NZ,NY,NX),UPOMN(NZ,NY,NX),UPNH4(NZ,NY,NX) -C 2,UPNO3(NZ,NY,NX),VNH3F(NZ,NY,NX),VN2OF(NZ,NY,NX) -C 4,((RDFOMN(N,L,NZ,NY,NX),N=1,2),L=NU(NY,NX),NI(NZ,NY,NX)) -C 4,((ZPOOLR(N,L,NZ,NY,NX),N=1,2),L=NU(NY,NX),NI(NZ,NY,NX)) -1112 FORMAT(A8,5I4,200F18.6) -C ENDIF -C -C PLANT P BALANCE = TOTAL P STATE VARIABLES + TOTAL P LITTERFALL -C - TOTAL P UPTAKE FROM SOIL -C - BALP(NZ,NY,NX)=WTSHP(NZ,NY,NX)+WTRTP(NZ,NY,NX)+WTNDP(NZ,NY,NX) - 2+WTRVP(NZ,NY,NX)+TPSNC(NZ,NY,NX)-TPUPTK(NZ,NY,NX) - 3-RSETP(NZ,NY,NX)+WTSTDP(1,NZ,NY,NX)+WTSTGP(NZ,NY,NX) - 4+HVSTP(NZ,NY,NX)+THVSTP(NZ,NY,NX)-VPO4F(NZ,NY,NX) -C IF(NZ.EQ.4)THEN -C WRITE(*,1112)'BALP',I,J,NX,NY,NZ,BALP(NZ,NY,NX),WTSHP(NZ,NY,NX) -C 2,WTRTP(NZ,NY,NX),WTNDP(NZ,NY,NX),WTRVP(NZ,NY,NX),TPSNC(NZ,NY,NX) -C 3,TPUPTK(NZ,NY,NX),RSETP(NZ,NY,NX) -C 4,WTSTDP(1,NZ,NY,NX),WTSTGP(NZ,NY,NX),HVSTP(NZ,NY,NX) -C 5,THVSTP(NZ,NY,NX),VPO4F(NZ,NY,NX) -C ENDIF - ENDIF -9975 CONTINUE -9990 CONTINUE -9995 CONTINUE - RETURN - END + + SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) +C +C THIS SUBROUTINE CALCULATES ALL PLANT BIOLOGICAL TRANSFORMATIONS +C + include "parameters.h" + include "files.h" + include "blkc.h" + include "blk1cp.h" + include "blk1cr.h" + include "blk1g.h" + include "blk1n.h" + include "blk1p.h" + include "blk1s.h" + include "blk2a.h" + include "blk2b.h" + include "blk2c.h" + include "blk3.h" + include "blk5.h" + include "blk8a.h" + include "blk8b.h" + include "blk9a.h" + include "blk9b.h" + include "blk9c.h" + include "blk11a.h" + include "blk11b.h" + include "blk12a.h" + include "blk12b.h" + include "blk13a.h" + include "blk13b.h" + include "blk13c.h" + include "blk14.h" + include "blk16.h" + include "blk18a.h" + include "blk18b.h" + DIMENSION PART(7),TFN6(JZ),ARSTKB(10),NRX(2,JZ),ICHK1(2,JZ) + 2,NBZ(10),FXFB(0:3),FXRT(0:1),FXSH(0:1),FXRN(4) + 3,VMXS(0:1),WTLSBZ(10),CPOOLZ(10),ZPOOLZ(10),PPOOLZ(10) + 4,ZCX(JP,JY,JX),UPNFC(JP,JY,JX),FRSV(0:3),FXFY(0:1),FXFZ(0:1) + 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) + 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) + 2,FWODB(0:1),FWODLN(0:1),FWODLP(0:1),FWODSN(0:1),FWODSP(0:1) +C DIMENSION VCO2(400,366,05) + PARAMETER(PART1X=0.05,PART2X=0.02 + 2,VMXC=0.015,ATRPX=276.9,FSNR=2.884E-03,FLG4X=168.0 + 3,FLGZX=240.0,XFRX=2.5E-02,XFRY=2.5E-03,IFLGQX=960 + 4,FSNKM=0.05,FXFS=1.0,FMYC=0.01) + PARAMETER(CNKI=1.0E+01,CPKI=1.0E+02,CNKF=1.0) + PARAMETER(RMPLT=0.010,PSILM=0.1,RCMN=1.560E+01,RTDPX=0.00 + 2,RTLGAX=1.0E-02,EMODR=5.0) + PARAMETER(QNTM=0.45,CURV=0.70,CURV2=2.0*CURV,CURV4=4.0*CURV + 2,ELEC3=4.5,ELEC4=3.0,CO2KI=1.0E+03,FCO2B=0.02,FHCOB=1.0-FCO2B) + PARAMETER(COMP4=0.5,FDML=6.0,FBS=0.2*FDML,FMP=0.8*FDML + 2,FVRN=0.5) + PARAMETER(ZPLFM=0.33,ZPLFD=1.0-ZPLFM,ZPGRM=0.75 + 2,ZPGRD=1.0-ZPGRM,FRF=0.25,FRC=1.0-FRF,GY=0.2,GZ=1.0-GY) + PARAMETER(FSTK=0.05,ZSTX=1.0E-03,DSTK=0.225,VSTK=1.0E-06/DSTK + 2,FRTX=1.0/(1.0-(1.0-FSTK)**2)) + PARAMETER(SETC=1.0E-02,SETN=1.0E-03,SETP=1.0E-04) + PARAMETER(SLA2=-0.33,SSL2=-0.50,SNL2=-0.67) + PARAMETER(CNMX=0.20,CPMX=0.020,CNMN=0.050,CPMN=0.005) + PARAMETER(EN2F=0.20,VMXO=0.50,SPNDL=1.0E-06,CCNKM=1.0E-02 + 2,CCNKX=1.0E+02,WTNDI=0.01) + DATA RCCZ/0.167,0.167,0.0557,0.167/ + 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 FXRN/0.50,0.025,0.25,0.025/ + DATA FXFB/1.0E-02,1.0E-02,1.0E-05,1.0E-05/ + DATA VMXS/0.025,0.0025/ + DATA FPART1/1.00/,FPART2/0.40/ + DATA FXSH/0.50,0.75/,FXRT/0.50,0.25/ + DATA FRSV/0.025,0.025,0.001,0.001/ + DATA FXFY/0.05,0.005/,FXFZ/0.25,0.005/ + DATA EFIRE/0.917,0.167/ + DATA PSILY/-200.0,-2.0,-2.0/ + DATA FLG4Y/360.0,1440.0,720.0,720.0/ +C DATA TC4,TLK/0.0,0.0/ + REAL*4 TFN5,WFNG,WFNC,WFNS,WFNSG,WFNSS,WFN4,WFNB + 2,WFNR,WFNRG,WFNGR,FSNC2 +C +C TOTAL AGB FOR GRAZING IN LANDSCAPE GROUP +C + DO 2995 NX=NHW,NHE + DO 2990 NY=NVN,NVS + DO 2985 NZ=1,NP(NY,NX) + IF(IHVST(NZ,I,NY,NX).EQ.4.OR.IHVST(NZ,I,NY,NX).EQ.6)THEN + WTSHTZ=0 + NN=0 + DO 1995 NX1=NHW,NHE + DO 1990 NY1=NVN,NVS + IF(LSG(NZ,NY1,NX1).EQ.LSG(NZ,NY,NX))THEN + IF(IFLGC(NZ,NY1,NX1).EQ.1)THEN + WTSHTZ=WTSHTZ+WTSHT(NZ,NY1,NX1) + NN=NN+1 + ENDIF + ENDIF +1990 CONTINUE +1995 CONTINUE + IF(NN.GT.0)THEN + WTSHTA(NZ,NY,NX)=WTSHTZ/NN + ELSE + WTSHTA(NZ,NY,NX)=WTSHT(NZ,NY,NX) + ENDIF + ENDIF +2985 CONTINUE +2990 CONTINUE +2995 CONTINUE + DO 9995 NX=NHW,NHE + DO 9990 NY=NVN,NVS + DO 9980 NZ=1,NP0(NY,NX) + DO 1 L=0,NJ(NY,NX) + DO 1 K=0,1 + DO 1 M=1,4 + CSNC(M,K,L,NZ,NY,NX)=0.0 + ZSNC(M,K,L,NZ,NY,NX)=0.0 + PSNC(M,K,L,NZ,NY,NX)=0.0 +1 CONTINUE + HCSNC(NZ,NY,NX)=0.0 + HZSNC(NZ,NY,NX)=0.0 + HPSNC(NZ,NY,NX)=0.0 + CNET(NZ,NY,NX)=0.0 + UPNFC(NZ,NY,NX)=0.0 + ZCX(NZ,NY,NX)=ZC(NZ,NY,NX) + ZC(NZ,NY,NX)=0.0 +9980 CONTINUE +C +C TRANSFORMATIONS IN LIVING PLANT POPULATIONS +C + DO 9985 NZ=1,NP(NY,NX) +C IF(J.EQ.INT(ZNOON(NY,NX)))THEN + XHVST=1.0 + WHVSBL=0.0 + WTHTH0=0.0 + WTHNH0=0.0 + WTHPH0=0.0 + WTHTH1=0.0 + WTHNH1=0.0 + WTHPH1=0.0 + WTHTH2=0.0 + WTHNH2=0.0 + WTHPH2=0.0 + WTHTH3=0.0 + WTHNH3=0.0 + WTHPH3=0.0 + WTHTH4=0.0 + WTHNH4=0.0 + WTHPH4=0.0 + WTHTR1=0.0 + WTHNR1=0.0 + WTHPR1=0.0 + WTHTR2=0.0 + WTHNR2=0.0 + WTHPR2=0.0 + WTHTR3=0.0 + WTHNR3=0.0 + WTHPR3=0.0 + WTHTR4=0.0 + WTHNR4=0.0 + WTHPR4=0.0 + WTHTX0=0.0 + WTHNX0=0.0 + WTHPX0=0.0 + WTHTX1=0.0 + WTHNX1=0.0 + WTHPX1=0.0 + WTHTX2=0.0 + WTHNX2=0.0 + WTHPX2=0.0 + WTHTX3=0.0 + WTHNX3=0.0 + WTHPX3=0.0 + WTHTX4=0.0 + WTHNX4=0.0 + WTHPX4=0.0 + WTHTG=0.0 + WTHNG=0.0 + WTHPG=0.0 +C ENDIF +C IF(NX.EQ.4.AND.NY.EQ.4.AND.NZ.EQ.2)THEN +C WRITE(*,2328)'IFLGC',I,J,NZ,IFLGC(NZ,NY,NX) +C 2,IDTHP(NZ,NY,NX),IDTHR(NZ,NY,NX) +2328 FORMAT(A8,10I4) +C ENDIF + IF(IFLGC(NZ,NY,NX).EQ.1)THEN + IF(IDTHP(NZ,NY,NX).EQ.0.OR.IDTHR(NZ,NY,NX).EQ.0)THEN +C IF(I.EQ.1.AND.J.EQ.1)THEN +C DO 87 II=1,366 +C DO 87 N=1,400 +C VCO2(N,II,NZ)=0.0 +87 CONTINUE +C ENDIF +C IF(IYRC.GE.2099)THEN +C IF(I.EQ.365.AND.J.EQ.24)THEN +C DO 88 N=1,400 +C WRITE(19,12)IYRC,NZ,N,(VCO2(N,II,NZ),II=1,181) +C WRITE(20,12)IYRC,NZ,N,(VCO2(N,II,NZ),II=182,365) +12 FORMAT(3I8,365E12.4) +88 CONTINUE +C ENDIF +C ENDIF + IFLGZ=0 + IFLGY=0 + DO 2 L=1,JC + ARLFV(L,NZ,NY,NX)=0.0 + WGLFV(L,NZ,NY,NX)=0.0 + ARSTV(L,NZ,NY,NX)=0.0 +2 CONTINUE + DO 5 NR=1,NRT(NZ,NY,NX) + DO 5 N=1,MY(NZ,NY,NX) + NRX(N,NR)=0 + ICHK1(N,NR)=0 +5 CONTINUE + DO 9 N=1,MY(NZ,NY,NX) + RTNT(N)=0.0 + DO 6 L=NU(NY,NX),NJ(NY,NX) + WSRTL(N,L,NZ,NY,NX)=0.0 + RTN1(N,L,NZ,NY,NX)=0.0 + RTNL(N,L,NZ,NY,NX)=0.0 + RCO2M(N,L,NZ,NY,NX)=0.0 + RCO2N(N,L,NZ,NY,NX)=0.0 + RCO2A(N,L,NZ,NY,NX)=0.0 + RLNT(N,L)=0.0 + DO 6 NR=1,NRT(NZ,NY,NX) + RTSK1(N,L,NR)=0.0 + RTSK2(N,L,NR)=0.0 +6 CONTINUE +9 CONTINUE + IF(IBTYP(NZ,NY,NX).EQ.0.OR.IGTYP(NZ,NY,NX).LE.1 + 2.OR.WTSTK(NZ,NY,NX).LT.ZEROP(NZ,NY,NX) + 3.OR.WVSTK(NZ,NY,NX).LT.ZEROP(NZ,NY,NX))THEN + FWOOD(1)=1.0 + FWODB(1)=1.0 + ELSE + FWOOD(1)=SQRT(FRTX*WVSTK(NZ,NY,NX)/WTSTK(NZ,NY,NX)) + FWODB(1)=1.0 + ENDIF + FWOOD(0)=1.0-FWOOD(1) + FWODB(0)=1.0-FWODB(1) + CNLFW=FWODB(0)*CNSTK(NZ,NY,NX)+FWODB(1)*CNLF(NZ,NY,NX) + CPLFW=FWODB(0)*CPSTK(NZ,NY,NX)+FWODB(1)*CPLF(NZ,NY,NX) + CNSHW=FWODB(0)*CNSTK(NZ,NY,NX)+FWODB(1)*CNSHE(NZ,NY,NX) + CPSHW=FWODB(0)*CPSTK(NZ,NY,NX)+FWODB(1)*CPSHE(NZ,NY,NX) + CNRTW=FWOOD(0)*CNSTK(NZ,NY,NX)+FWOOD(1)*CNRT(NZ,NY,NX) + CPRTW=FWOOD(0)*CPSTK(NZ,NY,NX)+FWOOD(1)*CPRT(NZ,NY,NX) + FWODLN(0)=FWODB(0)*CNSTK(NZ,NY,NX)/CNLFW + FWODLP(0)=FWODB(0)*CPSTK(NZ,NY,NX)/CPLFW + FWODSN(0)=FWODB(0)*CNSTK(NZ,NY,NX)/CNSHW + FWODSP(0)=FWODB(0)*CPSTK(NZ,NY,NX)/CPSHW + FWOODN(0)=FWOOD(0)*CNSTK(NZ,NY,NX)/CNRTW + FWOODP(0)=FWOOD(0)*CPSTK(NZ,NY,NX)/CPRTW + FWODLN(1)=1.0-FWODLN(0) + FWODLP(1)=1.0-FWODLP(0) + FWODSN(1)=1.0-FWODSN(0) + FWODSP(1)=1.0-FWODSP(0) + FWOODN(1)=1.0-FWOODN(0) + FWOODP(1)=1.0-FWOODP(0) +C +C SHOOT AND ROOT TEMPERATURE FUNCTIONS FOR MAINTENANCE +C RESPIRATION FROM TEMPERATURES WITH OFFSETS FOR THERMAL ADAPTATION +C +C TKSM=AMAX1(258.15,TKC(NZ,NY,NX))+OFFST(NZ,NY,NX) + TKSM=TKC(NZ,NY,NX)+OFFST(NZ,NY,NX) + RTK=8.3143*TKSM + STK=710.0*TKSM + ACTVM=1+EXP((195000-STK)/RTK)+EXP((STK-232500)/RTK) + TFN5=EXP(25.214-62500/RTK)/ACTVM + DO 7 L=NU(NY,NX),NJ(NY,NX) +C TKSM=AMAX1(258.15,TKS(L,NY,NX))+OFFST(NZ,NY,NX) + TKSM=TKS(L,NY,NX)+OFFST(NZ,NY,NX) + RTK=8.3143*TKSM + STK=710.0*TKSM + ACTVM=1+EXP((195000-STK)/RTK)+EXP((STK-232500)/RTK) + TFN6(L)=EXP(25.214-62500/RTK)/ACTVM +7 CONTINUE + GROGR=0.0 + WTRTA(NZ,NY,NX)=AMAX1(0.999992087*WTRTA(NZ,NY,NX) + 2,WTRT(NZ,NY,NX)/PP(NZ,NY,NX)) + XRTN1=AMAX1(1.0,WTRTA(NZ,NY,NX)**0.667)*PP(NZ,NY,NX) +C +C WATER STRESS FUNCTIONS FOR EXPANSION AND GROWTH RESPIRATION +C FROM CANOPY TURGOR +C + WFNS=AMIN1(1.0,AMAX1(0.0,PSILG(NZ,NY,NX)-PSILM)) + WFNSG=WFNS**0.25 + WFNSS=WFNS**0.50 + IF(IGTYP(NZ,NY,NX).EQ.0)THEN + WFNC=1.0 + WFNG=EXP(0.05*PSILT(NZ,NY,NX)) + ELSE + WFNC=EXP(RCS(NZ,NY,NX)*PSILG(NZ,NY,NX)) + WFNG=EXP(0.10*PSILT(NZ,NY,NX)) + ENDIF +C +C CALCULATE GROWTH OF EACH BRANCH +C + DO 105 NB=1,NBR(NZ,NY,NX) + WTLSB(NB,NZ,NY,NX)=AMAX1(0.0,WTLFB(NB,NZ,NY,NX) + 2+WTSHEB(NB,NZ,NY,NX)) + IF(IDTHB(NB,NZ,NY,NX).EQ.0)THEN +C +C PARTITION GROWTH WITHIN EACH BRANCH FROM GROWTH STAGE +C 1=LEAF,2=SHEATH OR PETIOLE,3=STALK,4=RESERVE, +C 5,6=REPRODUCTIVE ORGANS,7=GRAIN +C + ARSTKB(NB)=0.0 + TOTAL=0.0 + DO 10 N=1,7 + PART(N)=0.0 +10 CONTINUE +C +C IF BEFORE FLORAL INDUCTION +C + IF(IDAY(2,NB,NZ,NY,NX).EQ.0)THEN + PART(1)=0.725 + PART(2)=0.275 +C +C IF BEFORE ANTHESIS +C + ELSEIF(IDAY(6,NB,NZ,NY,NX).EQ.0)THEN + PART(1)=AMAX1(PART1X,0.725-FPART1*TGSTGI(NB,NZ,NY,NX)) + PART(2)=AMAX1(PART2X,0.275-FPART2*TGSTGI(NB,NZ,NY,NX)) + PARTS=1.0-PART(1)-PART(2) + PART(3)=0.60*PARTS + PART(4)=0.30*PARTS + PARTX=PARTS-PART(3)-PART(4) + PART(5)=0.5*PARTX + PART(6)=0.5*PARTX +C +C IF BEFORE GRAIN FILLING, DETERMINATE OR INDETERMINATE +C + ELSEIF(IDAY(7,NB,NZ,NY,NX).EQ.0)THEN + IF(IDTYP(NZ,NY,NX).EQ.0)THEN + PART(1)=0.0 + PART(2)=0.0 + ELSE + PART(1)=AMAX1(PART1X,(0.725-FPART1)*(1.0-TGSTGF(NB,NZ,NY,NX))) + PART(2)=AMAX1(PART2X,(0.275-FPART2)*(1.0-TGSTGF(NB,NZ,NY,NX))) + ENDIF + PARTS=1.0-PART(1)-PART(2) + PART(3)=AMAX1(0.0,0.60*PARTS*(1.0-TGSTGF(NB,NZ,NY,NX))) + PART(4)=AMAX1(0.0,0.30*PARTS*(1.0-TGSTGF(NB,NZ,NY,NX))) + PARTX=PARTS-PART(3)-PART(4) + PART(5)=0.5*PARTX + PART(6)=0.5*PARTX +C +C DURING GRAIN FILLING, DETERMINATE OR INDETERMINATE +C + ELSE + IF(IDTYP(NZ,NY,NX).EQ.0)THEN + PART(7)=1.0 + ELSE + PART(1)=PART1X + PART(2)=PART2X + PARTS=1.0-PART(1)-PART(2) + IF(ISTYP(NZ,NY,NX).EQ.0)THEN + PART(3)=0.125*PARTS + PART(5)=0.125*PARTS + PART(6)=0.125*PARTS + PART(7)=0.625*PARTS + ELSE + PART(3)=0.75*PARTS + PART(7)=0.25*PARTS + ENDIF + ENDIF + ENDIF +C +C IF AFTER GRAIN FILLING +C + IF(IBTYP(NZ,NY,NX).EQ.0.AND.IDAY(10,NB,NZ,NY,NX).NE.0)THEN + IF(ISTYP(NZ,NY,NX).EQ.0)THEN + PART(4)=0.0 + PART(3)=0.0 + PART(7)=0.0 + ELSE + PART(4)=PART(4)+PART(3) + PART(3)=0.0 + PART(7)=0.0 + ENDIF + ENDIF +C +C REDIRECT FROM STALK TO STALK RESERVES IF RESERVES BECOME LOW +C + IF(IDAY(2,NB,NZ,NY,NX).NE.0)THEN + IF(WTRSVB(NB,NZ,NY,NX).LT.XFRX*WVSTKB(NB,NZ,NY,NX))THEN + DO 1020 N=1,7 + IF(N.NE.4)THEN + PART(4)=PART(4)+0.10*PART(N) + PART(N)=PART(N)-0.10*PART(N) + ENDIF +1020 CONTINUE +C +C REDIRECT FROM STALK RESERVES TO STALK IF RESERVES BECOME TOO LARGE +C + ELSEIF(WTRSVB(NB,NZ,NY,NX).GT.1.0*WVSTKB(NB,NZ,NY,NX))THEN + PART(3)=PART(3)+PART(4)+PART(7) + PART(4)=0.0 + PART(7)=0.0 + ENDIF + ENDIF +C +C REDIRECT FROM LEAVES TO STALK IF LAI BECOMES TOO LARGE +C + ARLFI=ARLFP(NZ,NY,NX)/AREA(3,NU(NY,NX),NY,NX) + IF(ARLFI.GT.5.0)THEN + FPARTL=AMAX1(0.0,(10.0-ARLFI)/5.0) + PART(3)=PART(3)+(1.0-FPARTL)*(PART(1)+PART(2)) + PART(1)=FPARTL*PART(1) + PART(2)=FPARTL*PART(2) + ENDIF +C +C DECIDUOUS LEAF FALL AFTER GRAIN FILL IN DETERMINATES, +C AFTER AUTUMNIZATION IN INDETERMINATES, OR AFTER SUSTAINED +C WATER STRESS +C + IF((ISTYP(NZ,NY,NX).NE.0 + 2.AND.VRNF(NB,NZ,NY,NX).GE.FVRN*VRNX(NB,NZ,NY,NX)) + 3.OR.(ISTYP(NZ,NY,NX).EQ.0 + 4.AND.IDAY(8,NB,NZ,NY,NX).NE.0))THEN + IFLGZ=1 + IF(ISTYP(NZ,NY,NX).EQ.0.OR.IWTYP(NZ,NY,NX).EQ.0)THEN + IFLGY=1 + FLGZ(NB,NZ,NY,NX)=FLGZ(NB,NZ,NY,NX)+1.0 + ELSEIF((IWTYP(NZ,NY,NX).EQ.1.OR.IWTYP(NZ,NY,NX).EQ.3) + 2.AND.TCC(NZ,NY,NX).LT.CTC(NZ,NY,NX))THEN + IFLGY=1 + FLGZ(NB,NZ,NY,NX)=FLGZ(NB,NZ,NY,NX)+1.0 + ELSEIF(IWTYP(NZ,NY,NX).GE.2 + 2.AND.PSILT(NZ,NY,NX).LT.PSILY(IGTYP(NZ,NY,NX)))THEN + IFLGY=1 + FLGZ(NB,NZ,NY,NX)=FLGZ(NB,NZ,NY,NX)+1.0 + ENDIF + IF(ISTYP(NZ,NY,NX).NE.0.AND.IWTYP(NZ,NY,NX).NE.0)THEN + PART(3)=PART(3)+0.5*(PART(1)+PART(2)) + PART(4)=PART(4)+0.5*(PART(1)+PART(2)) + PART(1)=0.0 + PART(2)=0.0 + ENDIF + ELSE + IFLGZ=0 + IFLGY=0 + FLGZ(NB,NZ,NY,NX)=0.0 + ENDIF +C +C CHECK PARTITIONING COEFFICIENTS +C + DO 1000 N=1,7 + PART(N)=AMAX1(0.0,PART(N)) + TOTAL=TOTAL+PART(N) +1000 CONTINUE + IF(TOTAL.GT.ZERO)THEN + DO 1010 N=1,7 + PART(N)=PART(N)/TOTAL +1010 CONTINUE + ELSE + DO 1015 N=1,7 + PART(N)=0.0 +1015 CONTINUE + ENDIF +C +C SHOOT COEFFICIENTS FOR GROWTH RESPIRATION AND N,P CONTENTS +C FROM GROWTH YIELDS ENTERED IN 'READQ', AND FROM PARTITIONING +C COEFFICIENTS ABOVE +C + IF(IDAY(1,NB,NZ,NY,NX).NE.0)THEN + DMLFB=DMLF(NZ,NY,NX) + DMSHB=DMSHE(NZ,NY,NX) + CNLFB=CNLFW + CNSHB=CNSHW + CPLFB=CPLFW + CPSHB=CPSHW + ELSE + DMLFB=DMRT(NZ,NY,NX) + DMSHB=DMRT(NZ,NY,NX) + CNLFB=CNRTW + CNSHB=CNRTW + CPLFB=CPRTW + CPSHB=CPRTW + ENDIF + DMSHT=PART(1)*DMLFB+PART(2)*DMSHB+PART(3)*DMSTK(NZ,NY,NX) + 2+PART(4)*DMRSV(NZ,NY,NX)+PART(5)*DMHSK(NZ,NY,NX) + 3+PART(6)*DMEAR(NZ,NY,NX)+PART(7)*DMGR(NZ,NY,NX) + DMSHD=1.0-DMSHT + CNLFM=PART(1)*DMLFB*ZPLFM*CNLFB + CPLFM=PART(1)*DMLFB*ZPLFM*CPLFB + CNLFX=PART(1)*DMLFB*ZPLFD*CNLFB + CPLFX=PART(1)*DMLFB*ZPLFD*CPLFB + CNSHX=PART(2)*DMSHB*CNSHB + 2+PART(3)*DMSTK(NZ,NY,NX)*CNSTK(NZ,NY,NX) + 3+PART(4)*DMRSV(NZ,NY,NX)*CNRSV(NZ,NY,NX) + 4+PART(5)*DMHSK(NZ,NY,NX)*CNHSK(NZ,NY,NX) + 5+PART(6)*DMEAR(NZ,NY,NX)*CNEAR(NZ,NY,NX) + 6+PART(7)*DMGR(NZ,NY,NX)*CNRSV(NZ,NY,NX) + CPSHX=PART(2)*DMSHB*CPSHB + 2+PART(3)*DMSTK(NZ,NY,NX)*CPSTK(NZ,NY,NX) + 3+PART(4)*DMRSV(NZ,NY,NX)*CPRSV(NZ,NY,NX) + 4+PART(5)*DMHSK(NZ,NY,NX)*CPHSK(NZ,NY,NX) + 5+PART(6)*DMEAR(NZ,NY,NX)*CPEAR(NZ,NY,NX) + 6+PART(7)*DMGR(NZ,NY,NX)*CPRSV(NZ,NY,NX) +C +C TOTAL SHOOT STRUCTURAL N CONTENT FOR MAINTENANCE RESPIRATION +C + WTSHXN=AMAX1(0.0,WTLFBN(NB,NZ,NY,NX)+WTSHBN(NB,NZ,NY,NX) + 2+CNSTK(NZ,NY,NX)*WVSTKB(NB,NZ,NY,NX)) + IF(IDAY(10,NB,NZ,NY,NX).EQ.0)THEN + WTSHXN=WTSHXN+AMAX1(0.0,WTHSBN(NB,NZ,NY,NX) + 2+WTEABN(NB,NZ,NY,NX)+WTGRBN(NB,NZ,NY,NX)) + ENDIF +C +C GROSS PRIMARY PRODUCTIVITY +C + IF(IDAY(1,NB,NZ,NY,NX).NE.0)THEN + IF(FDBK(NB,NZ,NY,NX).NE.0)THEN + IF(SSIN(NY,NX).GT.0.0.AND.RADP(NZ,NY,NX).GT.0.0 + 2.AND.CO2Q(NZ,NY,NX).GT.0.0)THEN + CO2F=0.0 + CH2O=0.0 + IF(IGTYP(NZ,NY,NX).NE.0.OR.WFNC.GT.0.0)THEN +C IF(NZ.EQ.1.OR.NZ.EQ.4)THEN +C WRITE(*,5651)'CHECK1',I,J,NZ,NB,IDAY(1,NB,NZ,NY,NX) +C 2,FDBK(NB,NZ,NY,NX),RADP(NZ,NY,NX),CO2Q(NZ,NY,NX),WFNC +5651 FORMAT(A8,5I4,12E12.4) +C ENDIF +C +C FOR EACH NODE +C + DO 100 K=1,25 + CH2O3(K)=0.0 + CH2O4(K)=0.0 + IF(ARLF(K,NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN +C +C C4 PHOTOSYNTHESIS +C + IF(ICTYP(NZ,NY,NX).EQ.4.AND.VCGR4(K,NB,NZ,NY,NX).GT.0.0)THEN +C +C FOR EACH CANOPY LAYER +C + DO 110 L=JC,1,-1 + IF(ARLFL(L,K,NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN +C +C FOR EACH LEAF AZIMUTH AND INCLINATION +C + DO 115 N = 1,4 + DO 120 M = 1,4 +C +C CO2 FIXATION BY SUNLIT LEAVES +C + IF(SURFX(N,L,K,NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + IF(PAR(N,M,L,NZ,NY,NX).GT.0.0)THEN +C +C C4 CARBOXYLATION REACTIONS USING VARIABLES FROM 'STOMATE' +C + PARX=QNTM*PAR(N,M,L,NZ,NY,NX) + PARJ=PARX+ETGR4(K,NB,NZ,NY,NX) + ETLF=(PARJ-SQRT(PARJ**2-CURV4*PARX*ETGR4(K,NB,NZ,NY,NX)))/CURV2 + EGRO=ETLF*CBXN4(K,NB,NZ,NY,NX) + VL=AMIN1(VGRO4(K,NB,NZ,NY,NX),EGRO)*FDBK4(K,NB,NZ,NY,NX) +C +C STOMATAL EFFECT OF WATER DEFICIT +C + IF(VL.GT.ZERO)THEN + RS=AMIN1(RCMX(NZ,NY,NX),AMAX1(RCMN,DCO2(NZ,NY,NX)/VL)) + RSL=RS+(RCMX(NZ,NY,NX)-RS)*WFNC + GSL=1.0/RSL*FMOL(NZ,NY,NX) +C +C NON-STOMATAL EFFECT OF WATER DEFICIT +C + IF(IGTYP(NZ,NY,NX).NE.0)THEN + WFN4=(RS/RSL)**1.00 + WFNB=SQRT(RS/RSL) + ELSE + WFN4=WFNG + WFNB=WFNG + ENDIF +C +C CONVERGENCE SOLUTION FOR CO2I AT WHICH CARBOXYLATION +C EQUALS DIFFUSION +C + CO2X=CO2I(NZ,NY,NX) + DO 125 NN=1,100 + CO2C=CO2X*SCO2(NZ,NY,NX) + CO2Y=AMAX1(0.0,CO2C-COMP4) + CBXNX=CO2Y/(ELEC4*CO2C+10.5*COMP4) + VGROX=VCGR4(K,NB,NZ,NY,NX)*CO2Y/(CO2C+XKCO24(NZ,NY,NX)) + EGROX=ETLF*CBXNX + VL=AMIN1(VGROX,EGROX)*WFN4*FDBK4(K,NB,NZ,NY,NX) + VG=(CO2Q(NZ,NY,NX)-CO2X)*GSL + IF(VL+VG.GT.ZERO)THEN + DIFF=(VL-VG)/(VL+VG) + IF(ABS(DIFF).LT.0.005)GO TO 130 + VA=0.95*VG+0.05*VL + CO2X=CO2Q(NZ,NY,NX)-VA/GSL + ELSE + VL=0.0 + GO TO 130 + ENDIF +125 CONTINUE + +C +C ACCUMULATE C4 FIXATION PRODUCT +C +130 CH2O4(K)=CH2O4(K)+VL*SURFX(N,L,K,NB,NZ,NY,NX) + 2*TAUS(L+1,NY,NX) +C ICO2I=MAX(1,MIN(400,INT(CO2X))) +C VCO2(ICO2I,I,NZ)=VCO2(ICO2I,I,NZ) +C 2+(VL*SURFX(N,L,K,NB,NZ,NY,NX)*TAUS(L+1,NY,NX))*0.0432 +C IF(NB.EQ.1.AND.M.EQ.1.AND.N.EQ.3.AND.K.EQ.KLEAF(NB,NZ,NY,NX) +C 2.AND.(I/10)*10.EQ.I.AND.J.EQ.12)THEN +C WRITE(20,4444)'VLD4',IYRC,I,J,NZ,L,M,N,K,VL,PAR(N,M,L,NZ,NY,NX) +C 2,PAR(N,M,L,NZ,NY,NX)*TAUS(L+1,NY,NX)+PARDIF(N,M,L,NZ,NY,NX) +C 3*TAU0(L+1,NY,NX) +C 2,RAPS,TKC(NZ,NY,NX),CO2Q(NZ,NY,NX),ETGR4(K,NB,NZ,NY,NX) +C 3,CBXN4(K,NB,NZ,NY,NX),VGRO4(K,NB,NZ,NY,NX),EGRO +C 3,FDBK4(K,NB,NZ,NY,NX),CH2O4(K),WFN4,VGROX,EGROX +C 4,VCGR4(K,NB,NZ,NY,NX),CO2X,CO2C,CBXNX +C 5,RS,RSL +4444 FORMAT(A8,8I4,40E12.4) +C ENDIF +C +C C3 CARBOXYLATION REACTIONS IN C4 PLANTS USING VARIABLES FROM 'STOMATE' +C + PARJ=PARX+ETGRO(K,NB,NZ,NY,NX) + ETLF=(PARJ-SQRT(PARJ**2-CURV4*PARX*ETGRO(K,NB,NZ,NY,NX)))/CURV2 + EGRO=ETLF*CBXN(K,NB,NZ,NY,NX) + VL=AMIN1(VGRO(K,NB,NZ,NY,NX),EGRO)*WFNB*FDBK(NB,NZ,NY,NX) +C +C ACCUMULATE C3 FIXATION PRODUCT +C + CH2O3(K)=CH2O3(K)+VL*SURFX(N,L,K,NB,NZ,NY,NX) + 2*TAUS(L+1,NY,NX) +C IF(L.EQ.NC-1.AND.NB.EQ.1.AND.M.EQ.1.AND.N.EQ.1)THEN +C WRITE(*,4445)'VLD3',IYRC,I,J,NZ,L,M,N,K,VL,PAR(N,M,L,NZ,NY,NX) +C 2,RAPS,TKC(NZ,NY,NX),CO2Q(NZ,NY,NX),ETGRO(K,NB,NZ,NY,NX) +C 3,CBXN(K,NB,NZ,NY,NX),VGRO(K,NB,NZ,NY,NX),EGRO +C 3,FDBK(NB,NZ,NY,NX),WFNB +4445 FORMAT(A8,8I4,20E12.4) +C ENDIF + ENDIF + ENDIF +C +C CO2 FIXATION BY SHADED LEAVES +C + IF(PARDIF(N,M,L,NZ,NY,NX).GT.0.0)THEN +C +C C4 CARBOXYLATION REACTIONS +C + PARX=QNTM*PARDIF(N,M,L,NZ,NY,NX) + PARJ=PARX+ETGR4(K,NB,NZ,NY,NX) + ETLF=(PARJ-SQRT(PARJ**2-CURV4*PARX*ETGR4(K,NB,NZ,NY,NX)))/CURV2 + EGRO=ETLF*CBXN4(K,NB,NZ,NY,NX) + VL=AMIN1(VGRO4(K,NB,NZ,NY,NX),EGRO)*FDBK4(K,NB,NZ,NY,NX) +C +C STOMATAL EFFECT OF WATER DEFICIT +C + IF(VL.GT.ZERO)THEN + RS=AMIN1(RCMX(NZ,NY,NX),AMAX1(RCMN,DCO2(NZ,NY,NX)/VL)) + RSL=RS+(RCMX(NZ,NY,NX)-RS)*WFNC + GSL=1.0/RSL*FMOL(NZ,NY,NX) +C +C NON-STOMATAL EFFECT OF WATER DEFICIT +C + IF(IGTYP(NZ,NY,NX).NE.0)THEN + WFN4=(RS/RSL)**1.00 + WFNB=SQRT(RS/RSL) + ELSE + WFN4=WFNG + WFNB=WFNG + ENDIF +C +C CONVERGENCE SOLUTION FOR CO2I AT WHICH CARBOXYLATION +C EQUALS DIFFUSION +C + CO2X=CO2I(NZ,NY,NX) + DO 135 NN=1,100 + CO2C=CO2X*SCO2(NZ,NY,NX) + CO2Y=AMAX1(0.0,CO2C-COMP4) + CBXNX=CO2Y/(ELEC4*CO2C+10.5*COMP4) + VGROX=VCGR4(K,NB,NZ,NY,NX)*CO2Y/(CO2C+XKCO24(NZ,NY,NX)) + EGROX=ETLF*CBXNX + VL=AMIN1(VGROX,EGROX)*WFN4*FDBK4(K,NB,NZ,NY,NX) + VG=(CO2Q(NZ,NY,NX)-CO2X)*GSL + IF(VL+VG.GT.ZERO)THEN + DIFF=(VL-VG)/(VL+VG) + IF(ABS(DIFF).LT.0.005)GO TO 140 + VA=0.95*VG+0.05*VL + CO2X=CO2Q(NZ,NY,NX)-VA/GSL + ELSE + VL=0.0 + GO TO 140 + ENDIF +135 CONTINUE +C +C ACCUMULATE C4 FIXATION PRODUCT +C +140 CH2O4(K)=CH2O4(K)+VL*SURFX(N,L,K,NB,NZ,NY,NX) + 2*TAU0(L+1,NY,NX) +C ICO2I=MAX(1,MIN(400,INT(CO2X))) +C VCO2(ICO2I,I,NZ)=VCO2(ICO2I,I,NZ) +C 2+(VL*SURFX(N,L,K,NB,NZ,NY,NX)*TAU0(L+1,NY,NX))*0.0432 +C WRITE(*,4455)'VLB4',IYRC,I,J,NZ,L,M,N,K,VL,PAR(N,M,L,NZ,NY,NX) +C 2,RAPS,TKC(NZ,NY,NX),CO2Q(NZ,NY,NX),ETGR4(K,NB,NZ,NY,NX) +C 3,CBXN4(K,NB,NZ,NY,NX),VGRO4(K,NB,NZ,NY,NX),EGRO +C 3,FDBK4(K,NB,NZ,NY,NX),CH2O4(K),WFN4,VGROX,EGROX +C 4,VCGR4(K,NB,NZ,NY,NX),CO2X,CO2C,CBXNX +C 5,RS,RSL +4455 FORMAT(A8,8I4,40E12.4) +C +C C3 CARBOXYLATION REACTIONS IN C4 PLANTS USING VARIABLES FROM 'STOMATE' +C + PARJ=PARX+ETGRO(K,NB,NZ,NY,NX) + ETLF=(PARJ-SQRT(PARJ**2-CURV4*PARX*ETGRO(K,NB,NZ,NY,NX)))/CURV2 + EGRO=ETLF*CBXN(K,NB,NZ,NY,NX) + VL=AMIN1(VGRO(K,NB,NZ,NY,NX),EGRO)*WFNB*FDBK(NB,NZ,NY,NX) +C +C ACCUMULATE C3 FIXATION PRODUCT +C + CH2O3(K)=CH2O3(K)+VL*SURFX(N,L,K,NB,NZ,NY,NX) + 2*TAU0(L+1,NY,NX) +C IF(J.EQ.13.AND.NB.EQ.1.AND.M.EQ.1.AND.N.EQ.1)THEN +C WRITE(*,4444)'VLB4',IYRC,I,J,NZ,L,K,VL,PARDIF(N,M,L,NZ,NY,NX) +C 2,RAPY,TKC(NZ,NY,NX),CO2Q(NZ,NY,NX),CO2X,FMOL(NZ,NY,NX)/GSL +C 3,VCGRO(K,NB,NZ,NY,NX),ETLF,FDBK(NB,NZ,NY,NX),WFNB +C ENDIF + ENDIF + ENDIF + ENDIF +120 CONTINUE +115 CONTINUE + ENDIF +110 CONTINUE + CO2F=CO2F+CH2O4(K) + CH2O=CH2O+CH2O3(K) +C +C C3 PHOTOSYNTHESIS +C + ELSEIF(ICTYP(NZ,NY,NX).NE.4.AND.VCGRO(K,NB,NZ,NY,NX).GT.0.0)THEN +C +C FOR EACH CANOPY LAYER +C + DO 210 L=JC,1,-1 + IF(ARLFL(L,K,NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN +C +C FOR EACH LEAF AZIMUTH AND INCLINATION +C + DO 215 N=1,4 + DO 220 M=1,4 +C +C CO2 FIXATION BY SUNLIT LEAVES +C + IF(SURFX(N,L,K,NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + + IF(PAR(N,M,L,NZ,NY,NX).GT.0.0)THEN +C +C C3 CARBOXYLATION REACTIONS USING VARIABLES FROM 'STOMATE' +C + PARX=QNTM*PAR(N,M,L,NZ,NY,NX) + PARJ=PARX+ETGRO(K,NB,NZ,NY,NX) + ETLF=(PARJ-SQRT(PARJ**2-CURV4*PARX*ETGRO(K,NB,NZ,NY,NX)))/CURV2 + EGRO=ETLF*CBXN(K,NB,NZ,NY,NX) + VL=AMIN1(VGRO(K,NB,NZ,NY,NX),EGRO)*FDBK(NB,NZ,NY,NX) +C +C STOMATAL EFFECT OF WATER DEFICIT +C + IF(VL.GT.ZERO)THEN + RS=AMIN1(RCMX(NZ,NY,NX),AMAX1(RCMN,DCO2(NZ,NY,NX)/VL)) + RSL=RS+(RCMX(NZ,NY,NX)-RS)*WFNC + GSL=1.0/RSL*FMOL(NZ,NY,NX) +C +C NON-STOMATAL EFFECT OF WATER DEFICIT +C + IF(IGTYP(NZ,NY,NX).NE.0)THEN + WFNB=SQRT(RS/RSL) + ELSE + WFNB=WFNG + ENDIF +C +C CONVERGENCE SOLUTION FOR CO2I AT WHICH CARBOXYLATION +C EQUALS DIFFUSION +C + CO2X=CO2I(NZ,NY,NX) + DO 225 NN=1,100 + CO2C=CO2X*SCO2(NZ,NY,NX) + CO2Y=AMAX1(0.0,CO2C-COMPL(K,NB,NZ,NY,NX)) + CBXNX=CO2Y/(ELEC3*CO2C+10.5*COMPL(K,NB,NZ,NY,NX)) + VGROX=VCGRO(K,NB,NZ,NY,NX)*CO2Y/(CO2C+XKCO2O(NZ,NY,NX)) + EGROX=ETLF*CBXNX + VL=AMIN1(VGROX,EGROX)*WFNB*FDBK(NB,NZ,NY,NX) + VG=(CO2Q(NZ,NY,NX)-CO2X)*GSL + IF(VL+VG.GT.ZERO)THEN + DIFF=(VL-VG)/(VL+VG) + IF(ABS(DIFF).LT.0.005)GO TO 230 + VA=0.95*VG+0.05*VL + CO2X=CO2Q(NZ,NY,NX)-VA/GSL + ELSE + VL=0.0 + GO TO 230 + ENDIF +225 CONTINUE +C +C ACCUMULATE C3 FIXATION PRODUCT +C +230 CH2O3(K)=CH2O3(K)+VL*SURFX(N,L,K,NB,NZ,NY,NX) + 2*TAUS(L+1,NY,NX) +C ICO2I=MAX(1,MIN(400,INT(CO2X))) +C VCO2(ICO2I,I,NZ)=VCO2(ICO2I,I,NZ) +C 2+(VL*SURFX(N,L,K,NB,NZ,NY,NX)*TAUS(L+1,NY,NX))*0.0432 +C IF(NB.EQ.1.AND.M.EQ.1.AND.N.EQ.1.AND.K.EQ.KLEAF(NB,NZ,NY,NX)-1 +C 2.AND.J.EQ.12)THEN +C WRITE(20,3335)'VLD',IYRC,I,J,NZ,L,M,N,K,VL,PAR(N,M,L,NZ,NY,NX) +C 2,RAPS,TKC(NZ,NY,NX),TKA,CO2Q(NZ,NY,NX),CO2X,CO2C,FMOL(NZ,NY,NX) +C 3/GSL,VGROX,EGROX,ETLF,CBXNX,FDBK(NB,NZ,NY,NX),WFNB,PSILG(NZ,NY,NX) +C 4,VCGRO(K,NB,NZ,NY,NX),ETGRO(K,NB,NZ,NY,NX),COMPL(K,NB,NZ,NY,NX) +C 5,SURFX(N,L,K,NB,NZ,NY,NX),TAUS(L+1,NY,NX),CH2O3(K) +3335 FORMAT(A8,8I4,30E12.4) +C ENDIF + ENDIF + ENDIF +C +C CO2 FIXATION BY SHADED LEAVES +C + IF(PARDIF(N,M,L,NZ,NY,NX).GT.0.0)THEN +C +C C3 CARBOXYLATION REACTIONS USING VARIABLES FROM 'STOMATE' +C + PARX=QNTM*PARDIF(N,M,L,NZ,NY,NX) + PARJ=PARX+ETGRO(K,NB,NZ,NY,NX) + ETLF=(PARJ-SQRT(PARJ**2-CURV4*PARX*ETGRO(K,NB,NZ,NY,NX)))/CURV2 + EGRO=ETLF*CBXN(K,NB,NZ,NY,NX) + VL=AMIN1(VGRO(K,NB,NZ,NY,NX),EGRO)*FDBK(NB,NZ,NY,NX) +C +C STOMATAL EFFECT OF WATER DEFICIT +C + IF(VL.GT.ZERO)THEN + RS=AMIN1(RCMX(NZ,NY,NX),AMAX1(RCMN,DCO2(NZ,NY,NX)/VL)) + RSL=RS+(RCMX(NZ,NY,NX)-RS)*WFNC + GSL=1.0/RSL*FMOL(NZ,NY,NX) +C +C NON-STOMATAL EFFECT OF WATER DEFICIT +C + IF(IGTYP(NZ,NY,NX).NE.0)THEN + WFNB=SQRT(RS/RSL) + ELSE + WFNB=WFNG + ENDIF +C +C CONVERGENCE SOLUTION FOR CO2I AT WHICH CARBOXYLATION +C EQUALS DIFFUSION +C + CO2X=CO2I(NZ,NY,NX) + DO 235 NN=1,100 + CO2C=CO2X*SCO2(NZ,NY,NX) + CO2Y=AMAX1(0.0,CO2C-COMPL(K,NB,NZ,NY,NX)) + CBXNX=CO2Y/(ELEC3*CO2C+10.5*COMPL(K,NB,NZ,NY,NX)) + VGROX=VCGRO(K,NB,NZ,NY,NX)*CO2Y/(CO2C+XKCO2O(NZ,NY,NX)) + EGROX=ETLF*CBXNX + VL=AMIN1(VGROX,EGROX)*WFNB*FDBK(NB,NZ,NY,NX) + VG=(CO2Q(NZ,NY,NX)-CO2X)*GSL + IF(VL+VG.GT.ZERO)THEN + DIFF=(VL-VG)/(VL+VG) + IF(ABS(DIFF).LT.0.005)GO TO 240 + VA=0.95*VG+0.05*VL + CO2X=CO2Q(NZ,NY,NX)-VA/GSL + ELSE + VL=0.0 + GO TO 240 + ENDIF +235 CONTINUE +C +C ACCUMULATE C3 FIXATION PRODUCT +C +240 CH2O3(K)=CH2O3(K)+VL*SURFX(N,L,K,NB,NZ,NY,NX) + 2*TAU0(L+1,NY,NX) +C ICO2I=MAX(1,MIN(400,INT(CO2X))) +C VCO2(ICO2I,I,NZ)=VCO2(ICO2I,I,NZ) +C 2+(VL*SURFX(N,L,K,NB,NZ,NY,NX)*TAU0(L+1,NY,NX))*0.0432 +C IF(J.EQ.13.AND.NB.EQ.1.AND.M.EQ.1.AND.N.EQ.1)THEN +C WRITE(*,3335)'VLB',IYRC,I,J,NZ,L,K,VL,PARDIF(N,M,L,NZ,NY,NX) +C 2,RAPY,TKC(NZ,NY,NX),CO2Q(NZ,NY,NX),CO2X,FMOL(NZ,NY,NX)/GSL +C 3,VCGRO(K,NB,NZ,NY,NX),ETLF,FDBK(NB,NZ,NY,NX),WFNB +C ENDIF + ENDIF + ENDIF + ENDIF +220 CONTINUE +215 CONTINUE + ENDIF +210 CONTINUE + CO2F=CO2F+CH2O3(K) + CH2O=CH2O+CH2O3(K) + ENDIF + ENDIF +100 CONTINUE + CO2F=CO2F*0.0432 + CH2O=CH2O*0.0432 +C +C CONVERT UMOL M-2 S-1 TO G C M-2 H-1 +C + DO 150 K=1,25 + CH2O3(K)=CH2O3(K)*0.0432 + CH2O4(K)=CH2O4(K)*0.0432 +150 CONTINUE + ELSE + CO2F=0.0 + CH2O=0.0 + IF(ICTYP(NZ,NY,NX).EQ.4)THEN + DO 155 K=1,25 + CH2O3(K)=0.0 + CH2O4(K)=0.0 +155 CONTINUE + ENDIF + ENDIF + ELSE + CO2F=0.0 + CH2O=0.0 + IF(ICTYP(NZ,NY,NX).EQ.4)THEN + DO 160 K=1,25 + CH2O3(K)=0.0 + CH2O4(K)=0.0 +160 CONTINUE + ENDIF + ENDIF + ELSE + CO2F=0.0 + CH2O=0.0 + IF(ICTYP(NZ,NY,NX).EQ.4)THEN + DO 165 K=1,25 + CH2O3(K)=0.0 + CH2O4(K)=0.0 +165 CONTINUE + ENDIF + ENDIF +C +C SHOOT AUTOTROPHIC RESPIRATION AFTER EMERGENCE +C +C +C N,P CONSTRAINT ON RESPIRATION FROM NON-STRUCTURAL C:N:P +C + IF(CCPOLB(NB,NZ,NY,NX).GT.ZERO)THEN + CNPG=AMIN1(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) + 2+CCPOLB(NB,NZ,NY,NX)/CPKI)) + ELSE + CNPG=1.0 + ENDIF +C +C RESPIRATION FROM NON-STRUCTURAL C DETERMINED BY TEMPERATURE, +C NON-STRUCTURAL C:N:P +C + RCO2C=AMAX1(0.0,VMXC*CPOOL(NB,NZ,NY,NX) + 2*TFN3(NZ,NY,NX))*CNPG*FDBKX(NB,NZ,NY,NX)*WFNG +C +C MAINTENANCE RESPIRATION FROM TEMPERATURE, PLANT STRUCTURAL N +C + RMNCS=AMAX1(0.0,RMPLT*TFN5*WTSHXN) + IF(IWTYP(NZ,NY,NX).EQ.2)THEN + RMNCS=RMNCS*WFNG + ENDIF +C +C GROWTH RESPIRATION FROM TOTAL - MAINTENANCE +C IF > 0 DRIVES GROWTH, IF < 0 DRIVES REMOBILIZATION +C + RCO2X=RCO2C-RMNCS + RCO2Y=AMAX1(0.0,RCO2X)*WFNSG + SNCR=AMAX1(0.0,-RCO2X) +C +C GROWTH RESPIRATION MAY BE LIMITED BY NON-STRUCTURAL N,P +C AVAILABLE FOR GROWTH +C + IF(RCO2Y.GT.0.0.AND.(CNSHX.GT.0.0.OR.CNLFX.GT.0.0))THEN + ZPOOLB=AMAX1(0.0,ZPOOL(NB,NZ,NY,NX)) + PPOOLB=AMAX1(0.0,PPOOL(NB,NZ,NY,NX)) + RCO2G=AMIN1(RCO2Y,ZPOOLB*DMSHD/(CNSHX+CNLFM+CNLFX*CNPG) + 2,PPOOLB*DMSHD/(CPSHX+CPLFM+CPLFX*CNPG)) + ELSE + RCO2G=0.0 + ENDIF +C +C TOTAL NON-STRUCTURAL C,N,P USED IN GROWTH +C AND GROWTH RESPIRATION DEPENDS ON GROWTH YIELDS +C ENTERED IN 'READQ' +C + CGROS=RCO2G/DMSHD + ZADDB=AMAX1(0.0,AMIN1(ZPOOL(NB,NZ,NY,NX) + 2,CGROS*(CNSHX+CNLFM+CNLFX*CNPG))) + PADDB=AMAX1(0.0,AMIN1(PPOOL(NB,NZ,NY,NX) + 2,CGROS*(CPSHX+CPLFM+CPLFX*CNPG))) + CNRDA=AMAX1(0.0,1.70*ZADDB-0.025*CH2O) +C +C TOTAL ABOVE-GROUND AUTOTROPHIC RESPIRATION BY BRANCH +C ACCUMULATE GPP, SHOOT AUTOTROPHIC RESPIRATION, NET C EXCHANGE +C + RCO2T=AMIN1(RMNCS,RCO2C)+RCO2G+SNCR+CNRDA + CARBN(NZ,NY,NX)=CARBN(NZ,NY,NX)+CO2F + TCO2T(NZ,NY,NX)=TCO2T(NZ,NY,NX)-RCO2T + TCO2A(NZ,NY,NX)=TCO2A(NZ,NY,NX)-RCO2T + CNET(NZ,NY,NX)=CNET(NZ,NY,NX)+CO2F-RCO2T + GPP(NY,NX)=GPP(NY,NX)+CO2F + TGPP(NY,NX)=TGPP(NY,NX)+CO2F + RECO(NY,NX)=RECO(NY,NX)-RCO2T + TRAU(NY,NX)=TRAU(NY,NX)-RCO2T +C IF(NZ.EQ.1)THEN +C WRITE(*,4477)'RCO2',I,J,NX,NY,NZ,NB,IFLGZ,CPOOL(NB,NZ,NY,NX) +C 2,CH2O,RMNCS,RCO2C,CGROS,CNRDA,CNPG,RCO2T,RCO2X,SNCR +C 3,RCO2G,DMSHD,ZADDB,PART(1),PART(2),DMLFB,DMSHB +C 4,WTRSVB(NB,NZ,NY,NX),WVSTKB(NB,NZ,NY,NX),WTSHXN +C 5,ZPOOL(NB,NZ,NY,NX),PPOOL(NB,NZ,NY,NX),PSILT(NZ,NY,NX) +C 6,ZADDB,RNH3B(NB,NZ,NY,NX),WFR(1,NG(NZ,NY,NX),NZ,NY,NX) +C 7,WFNG,TFN3(NZ,NY,NX),TFN5,FDBKX(NB,NZ,NY,NX),VMXC +4477 FORMAT(A8,7I4,40E12.4) +C ENDIF +C +C SHOOT AUTOTROPHIC RESPIRATION BEFORE EMERGENCE +C + ELSE +C +C N,P CONSTRAINT ON RESPIRATION FROM NON-STRUCTURAL C:N:P +C + IF(CCPOLB(NB,NZ,NY,NX).GT.ZERO)THEN + CNPG=AMIN1(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)) + ELSE + CNPG=1.0 + ENDIF +C +C RESPIRATION FROM NON-STRUCTURAL C DETERMINED BY TEMPERATURE, +C NON-STRUCTURAL C:N:P, O2 UPTAKE +C + RCO2CM=AMAX1(0.0,VMXC*CPOOL(NB,NZ,NY,NX) + 2*TFN4(NG(NZ,NY,NX),NZ,NY,NX))*CNPG*WFNG*FDBKX(NB,NZ,NY,NX) + RCO2C=RCO2CM*WFR(1,NG(NZ,NY,NX),NZ,NY,NX) +C +C MAINTENANCE RESPIRATION FROM TEMPERATURE, PLANT STRUCTURAL N +C + RMNCS=AMAX1(0.0,RMPLT*TFN6(NG(NZ,NY,NX))*WTSHXN) + IF(IWTYP(NZ,NY,NX).EQ.2)THEN + RMNCS=RMNCS*WFNG + ENDIF +C +C GROWTH RESPIRATION FROM TOTAL - MAINTENANCE +C IF > 0 DRIVES GROWTH, IF < 0 DRIVES REMOBILIZATION +C + RCO2XM=RCO2CM-RMNCS + RCO2X=RCO2C-RMNCS + RCO2YM=AMAX1(0.0,RCO2XM)*WFNSG + RCO2Y=AMAX1(0.0,RCO2X)*WFNSG + SNCRM=AMAX1(0.0,-RCO2XM) + SNCR=AMAX1(0.0,-RCO2X) +C +C GROWTH RESPIRATION MAY BE LIMITED BY NON-STRUCTURAL N,P +C AVAILABLE FOR GROWTH +C + IF(CNSHX.GT.0.0.OR.CNLFX.GT.0.0)THEN + ZPOOLB=AMAX1(0.0,ZPOOL(NB,NZ,NY,NX)) + PPOOLB=AMAX1(0.0,PPOOL(NB,NZ,NY,NX)) + FNP=AMIN1(ZPOOLB*DMSHD/(CNSHX+CNLFM+CNLFX*CNPG) + 2,PPOOLB*DMSHD/(CPSHX+CPLFM+CPLFX*CNPG)) + IF(RCO2YM.GT.0.0)THEN + RCO2GM=AMIN1(RCO2YM,FNP) + ELSE + RCO2GM=0.0 + ENDIF + IF(RCO2Y.GT.0.0)THEN + RCO2G=AMIN1(RCO2Y,FNP*WFR(1,NG(NZ,NY,NX),NZ,NY,NX)) + ELSE + RCO2G=0.0 + ENDIF + ELSE + RCO2GM=0.0 + RCO2G=0.0 + ENDIF +C +C TOTAL NON-STRUCTURAL C,N,P USED IN GROWTH +C AND GROWTH RESPIRATION DEPENDS ON GROWTH YIELDS +C ENTERED IN 'READQ' +C + CGROSM=RCO2GM/DMSHD + CGROS=RCO2G/DMSHD + ZADDBM=AMAX1(0.0,CGROSM*(CNSHX+CNLFM+CNLFX*CNPG)) + ZADDB=AMAX1(0.0,CGROS*(CNSHX+CNLFM+CNLFX*CNPG)) + PADDB=AMAX1(0.0,CGROS*(CPSHX+CPLFM+CPLFX*CNPG)) + CNRDM=AMAX1(0.0,1.70*ZADDBM) + CNRDA=AMAX1(0.0,1.70*ZADDB) +C +C TOTAL ABOVE-GROUND AUTOTROPHIC RESPIRATION BY BRANCH +C ACCUMULATE GPP, SHOOT AUTOTROPHIC RESPIRATION, NET C EXCHANGE +C + RCO2TM=RMNCS+RCO2GM+SNCRM+CNRDM + RCO2T=RMNCS+RCO2G+SNCR+CNRDA + RCO2M(1,NG(NZ,NY,NX),NZ,NY,NX)=RCO2M(1,NG(NZ,NY,NX),NZ,NY,NX) + 2+RCO2TM + RCO2N(1,NG(NZ,NY,NX),NZ,NY,NX)=RCO2N(1,NG(NZ,NY,NX),NZ,NY,NX) + 2+RCO2T + RCO2A(1,NG(NZ,NY,NX),NZ,NY,NX)=RCO2A(1,NG(NZ,NY,NX),NZ,NY,NX) + 2-RCO2T + CH2O=0.0 + ENDIF +C +C REMOVE C,N,P USED IN MAINTENANCE + GROWTH REPIRATION AND GROWTH +C FROM NON-STRUCTURAL POOLS +C + CPOOL(NB,NZ,NY,NX)=CPOOL(NB,NZ,NY,NX)+CH2O-AMIN1(RMNCS,RCO2C) + 2-CGROS-CNRDA + ZPOOL(NB,NZ,NY,NX)=ZPOOL(NB,NZ,NY,NX)-ZADDB+RNH3B(NB,NZ,NY,NX) + PPOOL(NB,NZ,NY,NX)=PPOOL(NB,NZ,NY,NX)-PADDB +C +C TRANSFER OF C4 FIXATION PRODUCTS FROM NON-STRUCTURAL POOLS +C IN MESOPHYLL TO THOSE IN BUNDLE SHEATH, DECARBOXYLATION +C OF C4 FIXATION PRODUCTS IN BUNDLE SHEATH, LEAKAGE OF DECARBOXYLATION +C PRODUCTS BACK TO MESOPHYLL IN C4 PLANTS +C + IF(ICTYP(NZ,NY,NX).EQ.4)THEN + DO 170 K=1,25 + IF(WGLF(K,NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + CCBS1=AMAX1(0.0,0.083E+09*CO2B(K,NB,NZ,NY,NX) + 2/(WGLF(K,NB,NZ,NY,NX)*FBS)) +C +C BUNDLE SHEATH LEAKAGE +C + CO2LK=AMIN1(AMAX1(0.0,CPOOL3(K,NB,NZ,NY,NX)-CH2O3(K)) + 2,5.0E-07*(CCBS1-CO2L(NZ,NY,NX))*WGLF(K,NB,NZ,NY,NX)*FBS) + IF(CPOOL3(K,NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + FPL3X=CPOOL3(K,NB,NZ,NY,NX)/(CPOOL3(K,NB,NZ,NY,NX) + 2+AMAX1(0.0,CO2B(K,NB,NZ,NY,NX))) + ELSE + FPL3X=0.0 + ENDIF + CPL3X=FPL3X*(CH2O3(K)+CO2LK) + CPL3Z=CPL3X-CH2O3(K)-CO2LK + CO2B(K,NB,NZ,NY,NX)=CO2B(K,NB,NZ,NY,NX)+FCO2B*CPL3Z + HCOB(K,NB,NZ,NY,NX)=HCOB(K,NB,NZ,NY,NX)+FHCOB*CPL3Z + CPOOL3(K,NB,NZ,NY,NX)=CPOOL3(K,NB,NZ,NY,NX)-CPL3X +C +C BUNDLE SHEATH DECARBOXYLATION +C + CCBS2=AMAX1(0.0,0.083E+09*CO2B(K,NB,NZ,NY,NX) + 2/(WGLF(K,NB,NZ,NY,NX)*FBS)) + CPL3K=2.5E-02*CPOOL3(K,NB,NZ,NY,NX)/(1.0+CCBS2/CO2KI) + CPOOL3(K,NB,NZ,NY,NX)=CPOOL3(K,NB,NZ,NY,NX)-CPL3K + CO2B(K,NB,NZ,NY,NX)=CO2B(K,NB,NZ,NY,NX)+FCO2B*CPL3K + HCOB(K,NB,NZ,NY,NX)=HCOB(K,NB,NZ,NY,NX)+FHCOB*CPL3K +C +C MESOPHYLL TO BUNDLE SHEATH TRANSFER +C + CPOOL4(K,NB,NZ,NY,NX)=CPOOL4(K,NB,NZ,NY,NX)+CH2O4(K) + CPL4M=0.5*(CPOOL4(K,NB,NZ,NY,NX)*WGLF(K,NB,NZ,NY,NX)*FBS + 2-CPOOL3(K,NB,NZ,NY,NX)*WGLF(K,NB,NZ,NY,NX)*FMP) + 2/(WGLF(K,NB,NZ,NY,NX)*(FBS+FMP)) + CPOOL4(K,NB,NZ,NY,NX)=CPOOL4(K,NB,NZ,NY,NX)-CPL4M + CPOOL3(K,NB,NZ,NY,NX)=CPOOL3(K,NB,NZ,NY,NX)+CPL4M + TCO2T(NZ,NY,NX)=TCO2T(NZ,NY,NX)-CO2LK + TCO2A(NZ,NY,NX)=TCO2A(NZ,NY,NX)-CO2LK + CNET(NZ,NY,NX)=CNET(NZ,NY,NX)-CO2LK + RECO(NY,NX)=RECO(NY,NX)-CO2LK + TRAU(NY,NX)=TRAU(NY,NX)-CO2LK + CO2LKF=CO2LK/ARLF(K,NB,NZ,NY,NX)*23.148 +C TC4=TC4+CH2O4(K) +C TLK=TLK+CO2LK +C IF(NB.EQ.1.AND.(K.EQ.16))THEN +C CCBS3=AMAX1(0.0,0.083E+09*CO2B(K,NB,NZ,NY,NX) +C 2/(WGLF(K,NB,NZ,NY,NX)*FBS)) +C WRITE(*,6667)'CO2K',I,J,NB,K,CPOOL4(K,NB,NZ,NY,NX) +C 2,CPOOL3(K,NB,NZ,NY,NX),CO2B(K,NB,NZ,NY,NX) +C 2,CPOOL4(K,NB,NZ,NY,NX)/(WGLF(K,NB,NZ,NY,NX)*FMP) +C 2,CPOOL3(K,NB,NZ,NY,NX)/(WGLF(K,NB,NZ,NY,NX)*FBS) +C 2,CO2B(K,NB,NZ,NY,NX)/(WGLF(K,NB,NZ,NY,NX)*FBS) +C 4,FPL3X,CH2O4(K),CH2O3(K),CPL4M,CPL3X,CPL3K,CO2LK +C 5,TC4,TLK,CO2LKF,CCBS1,CO2L(NZ,NY,NX),CCBS3 +C 6,ARLF(K,NB,NZ,NY,NX),HCOB(K,NB,NZ,NY,NX) +6667 FORMAT(A8,4I4,30E14.6) +C ENDIF + ENDIF +170 CONTINUE + ENDIF +C +C C,N,P GROWTH OF LEAF, SHEATH OR PETIOLE, STALK, +C STALK RESERVES, REPRODUCTIVE ORGANS, GRAIN +C + GROLF=PART(1)*CGROS*DMLFB + GROSHE=PART(2)*CGROS*DMSHB + GROSTK=PART(3)*CGROS*DMSTK(NZ,NY,NX) + GRORSV=PART(4)*CGROS*DMRSV(NZ,NY,NX) + GROHSK=PART(5)*CGROS*DMHSK(NZ,NY,NX) + GROEAR=PART(6)*CGROS*DMEAR(NZ,NY,NX) + GROGR=PART(7)*CGROS*DMGR(NZ,NY,NX) + GROSHT=CGROS*DMSHT + GROLFN=GROLF*CNLFB*(ZPLFM+ZPLFD*CNPG) + GROSHN=GROSHE*CNSHB + GROSTN=GROSTK*CNSTK(NZ,NY,NX) + GRORSN=GRORSV*CNRSV(NZ,NY,NX) + GROHSN=GROHSK*CNHSK(NZ,NY,NX) + GROEAN=GROEAR*CNEAR(NZ,NY,NX) + GROGRN=GROGR*CNRSV(NZ,NY,NX) + GROLFP=GROLF*CPLFB*(ZPLFM+ZPLFD*CNPG) + GROSHP=GROSHE*CPSHB + GROSTP=GROSTK*CPSTK(NZ,NY,NX) + GRORSP=GRORSV*CPRSV(NZ,NY,NX) + GROHSP=GROHSK*CPHSK(NZ,NY,NX) + GROEAP=GROEAR*CPEAR(NZ,NY,NX) + GROGRP=GROGR*CPRSV(NZ,NY,NX) + WTLFB(NB,NZ,NY,NX)=WTLFB(NB,NZ,NY,NX)+GROLF + WTSHEB(NB,NZ,NY,NX)=WTSHEB(NB,NZ,NY,NX)+GROSHE + WTSTKB(NB,NZ,NY,NX)=WTSTKB(NB,NZ,NY,NX)+GROSTK + WTRSVB(NB,NZ,NY,NX)=WTRSVB(NB,NZ,NY,NX)+GRORSV + WTHSKB(NB,NZ,NY,NX)=WTHSKB(NB,NZ,NY,NX)+GROHSK + WTEARB(NB,NZ,NY,NX)=WTEARB(NB,NZ,NY,NX)+GROEAR + WTLFBN(NB,NZ,NY,NX)=WTLFBN(NB,NZ,NY,NX)+GROLFN + WTSHBN(NB,NZ,NY,NX)=WTSHBN(NB,NZ,NY,NX)+GROSHN + WTSTBN(NB,NZ,NY,NX)=WTSTBN(NB,NZ,NY,NX)+GROSTN + WTRSBN(NB,NZ,NY,NX)=WTRSBN(NB,NZ,NY,NX)+GRORSN + WTHSBN(NB,NZ,NY,NX)=WTHSBN(NB,NZ,NY,NX)+GROHSN + WTEABN(NB,NZ,NY,NX)=WTEABN(NB,NZ,NY,NX)+GROEAN + WTLFBP(NB,NZ,NY,NX)=WTLFBP(NB,NZ,NY,NX)+GROLFP + WTSHBP(NB,NZ,NY,NX)=WTSHBP(NB,NZ,NY,NX)+GROSHP + WTSTBP(NB,NZ,NY,NX)=WTSTBP(NB,NZ,NY,NX)+GROSTP + WTRSBP(NB,NZ,NY,NX)=WTRSBP(NB,NZ,NY,NX)+GRORSP + WTHSBP(NB,NZ,NY,NX)=WTHSBP(NB,NZ,NY,NX)+GROHSP + WTEABP(NB,NZ,NY,NX)=WTEABP(NB,NZ,NY,NX)+GROEAP +C +C DISTRIBUTE LEAF GROWTH AMONG CURRENTLY GROWING NODES +C + CCE=AMIN1(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)) + ETOL=1.0+CCE + IF(NB.EQ.NB1(NZ,NY,NX).AND.HTCTL(NZ,NY,NX).LE.SDPTH(NZ,NY,NX))THEN + NNOD1=0 + ELSE + NNOD1=1 + ENDIF + IF(GROLF.GT.0.0)THEN + MXNOD=KVSTG(NB,NZ,NY,NX) + MNNOD=MAX(NNOD1,MXNOD-NNOD(NZ,NY,NX)+1) + MXNOD=MAX(MXNOD,MNNOD) + KNOD=MXNOD-MNNOD+1 + GNOD=KNOD + ALLOCL=1.0/GNOD + GRO=ALLOCL*GROLF + GRON=ALLOCL*GROLFN + GROP=ALLOCL*GROLFP + GSLA=ALLOCL*FNOD(NZ,NY,NX)*NNOD(NZ,NY,NX) +C +C GROWTH AT EACH CURRENT NODE +C + DO 490 KK=MNNOD,MXNOD + K=MOD(KK,25) + IF(K.EQ.0.AND.KK.NE.0)K=25 + WGLF(K,NB,NZ,NY,NX)=WGLF(K,NB,NZ,NY,NX)+GRO + WGLFN(K,NB,NZ,NY,NX)=WGLFN(K,NB,NZ,NY,NX)+GRON + WGLFP(K,NB,NZ,NY,NX)=WGLFP(K,NB,NZ,NY,NX)+GROP + WSLF(K,NB,NZ,NY,NX)=WSLF(K,NB,NZ,NY,NX) + 2+AMIN1(GRON*CNWS(NZ,NY,NX),GROP*CPWS(NZ,NY,NX)) +C +C SPECIFIC LEAF AREA FUNCTION OF CURRENT LEAF MASS +C WITH PARAMETERS FROM 'READQ' +C + SLA=ETOL*SLA1(NZ,NY,NX)*(AMAX1(ZEROL(NZ,NY,NX) + 2,WGLF(K,NB,NZ,NY,NX))/(PP(NZ,NY,NX)*GSLA))**SLA2*WFNS + GROA=GRO*SLA + ARLFB(NB,NZ,NY,NX)=ARLFB(NB,NZ,NY,NX)+GROA + ARLF(K,NB,NZ,NY,NX)=ARLF(K,NB,NZ,NY,NX)+GROA +490 CONTINUE + ENDIF +C +C DISTRIBUTE SHEATH OR PETIOLE GROWTH AMONG CURRENTLY GROWING NODES +C + IF(GROSHE.GT.0.0)THEN + MXNOD=KVSTG(NB,NZ,NY,NX) + MNNOD=MAX(NNOD1,MXNOD-NNOD(NZ,NY,NX)+1) + MXNOD=MAX(MXNOD,MNNOD) + GNOD=MXNOD-MNNOD+1 + ALLOCS=1.0/GNOD + GRO=ALLOCS*GROSHE + GRON=ALLOCS*GROSHN + GROP=ALLOCS*GROSHP + GSSL=ALLOCL*FNOD(NZ,NY,NX)*NNOD(NZ,NY,NX) +C +C GROWTH AT EACH CURRENT NODE +C + DO 505 KK=MNNOD,MXNOD + K=MOD(KK,25) + IF(K.EQ.0.AND.KK.NE.0)K=25 + WGSHE(K,NB,NZ,NY,NX)=WGSHE(K,NB,NZ,NY,NX)+GRO + WGSHN(K,NB,NZ,NY,NX)=WGSHN(K,NB,NZ,NY,NX)+GRON + WGSHP(K,NB,NZ,NY,NX)=WGSHP(K,NB,NZ,NY,NX)+GROP + WSSHE(K,NB,NZ,NY,NX)=WSSHE(K,NB,NZ,NY,NX) + 2+AMIN1(GRON*CNWS(NZ,NY,NX),GROP*CPWS(NZ,NY,NX)) +C +C SPECIFIC SHEATH OR PETIOLE LENGTH FUNCTION OF CURRENT MASS +C WITH PARAMETERS FROM 'READQ' +C + IF(WGLF(K,NB,NZ,NY,NX).GT.0.0)THEN + SSL=ETOL*SSL1(NZ,NY,NX)*(AMAX1(ZEROL(NZ,NY,NX) + 4,WGSHE(K,NB,NZ,NY,NX))/(PP(NZ,NY,NX)*GSSL))**SSL2*WFNS + GROS=GRO/PP(NZ,NY,NX)*SSL + HTSHE(K,NB,NZ,NY,NX)=HTSHE(K,NB,NZ,NY,NX)+GROS*ANGSH(NZ,NY,NX) +C IF(I.EQ.120.AND.J.EQ.24)THEN +C WRITE(*,2526)'HTSHE',I,J,NZ,NB,K,SSL,WGSHE(K,NB,NZ,NY,NX) +C 2,HTSHE(K,NB,NZ,NY,NX),PP(NZ,NY,NX),SSL1(NZ,NY,NX) +C 3,GSLA,SSL3,WFNS,GROS,GRO,ANGSH(NZ,NY,NX),ZEROL(NZ,NY,NX) +C 4,CCPOLB(NB,NZ,NY,NX),ETOL +2526 FORMAT(A8,5I4,20E12.4) +C ENDIF + ENDIF +505 CONTINUE + ENDIF +C +C DISTRIBUTE STALK GROWTH AMONG CURRENTLY GROWING NODES +C + IF(IDAY(1,NB,NZ,NY,NX).EQ.0)THEN + NN=0 + ELSE + NN=1 + ENDIF + MXNOD=KVSTG(NB,NZ,NY,NX) + MNNOD=MAX(MIN(NN,MAX(NN,MXNOD-NNOD(NZ,NY,NX))) + 2,KVSTG(NB,NZ,NY,NX)-23) + MXNOD=MAX(MXNOD,MNNOD) + IF(GROSTK.GT.0.0)THEN + GNOD=MXNOD-MNNOD+1 + ALLOCN=1.0/GNOD + GRO=ALLOCN*GROSTK + GRON=ALLOCN*GROSTN + GROP=ALLOCN*GROSTP +C +C SPECIFIC INTERNODE LENGTH FUNCTION OF CURRENT STALK MASS +C WITH PARAMETERS FROM 'READQ' +C + SNL=ETOL*SNL1(NZ,NY,NX)*(WTSTKB(NB,NZ,NY,NX)/PP(NZ,NY,NX))**SNL2 + GROH=GRO/PP(NZ,NY,NX)*SNL + KX=MOD(MNNOD-1,25) + IF(KX.EQ.0.AND.MNNOD-1.NE.0)KX=25 +C +C GROWTH AT EACH CURRENT NODE +C + DO 510 KK=MNNOD,MXNOD + K1=MOD(KK,25) + IF(K1.EQ.0.AND.KK.NE.0)K1=25 + K2=MOD(KK-1,25) + IF(K2.EQ.0.AND.KK-1.NE.0)K2=25 + WGNODE(K1,NB,NZ,NY,NX)=WGNODE(K1,NB,NZ,NY,NX)+GRO + WGNODN(K1,NB,NZ,NY,NX)=WGNODN(K1,NB,NZ,NY,NX)+GRON + WGNODP(K1,NB,NZ,NY,NX)=WGNODP(K1,NB,NZ,NY,NX)+GROP + HTNODX(K1,NB,NZ,NY,NX)=HTNODX(K1,NB,NZ,NY,NX)+GROH*ANGBR(NZ,NY,NX) + IF(K1.NE.0)THEN + HTNODE(K1,NB,NZ,NY,NX)=HTNODX(K1,NB,NZ,NY,NX) + 2+HTNODE(K2,NB,NZ,NY,NX) + ELSE + HTNODE(K1,NB,NZ,NY,NX)=HTNODX(K1,NB,NZ,NY,NX) + ENDIF +C IF(NZ.EQ.1)THEN +C WRITE(*,515)'HTNODE',I,J,NZ,NB,KK,K1,K2,MNNOD,MXNOD +C 1,NNOD(NZ,NY,NX),ARLF(K1,NB,NZ,NY,NX) +C 2,HTNODE(K1,NB,NZ,NY,NX),HTNODE(K2,NB,NZ,NY,NX),SNL,GRO +C 3,ALLOCN,WTSTKB(NB,NZ,NY,NX),WGNODE(K1,NB,NZ,NY,NX) +C 4,HTNODX(K1,NB,NZ,NY,NX),PP(NZ,NY,NX),GROSTK +515 FORMAT(A8,10I4,20E12.4) +C ENDIF +510 CONTINUE + ENDIF +C +C RECOVERY OF REMOBILIZABLE N,P DURING REMOBILIZATION DEPENDS +C ON SHOOT NON-STRUCTURAL C:N:P +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) + 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) + ELSE + CCC=0.0 + CNC=0.0 + CPC=0.0 + ENDIF + RCCC=RCCZ(IBTYP(NZ,NY,NX))+CCC*RCCY(IBTYP(NZ,NY,NX)) + RCCN=CNC*RCCX(IGTYP(NZ,NY,NX)) + RCCP=CPC*RCCQ(IGTYP(NZ,NY,NX)) +C +C WITHDRAW REMOBILIZABLE C,N,P FROM LOWEST NODE AFTER +C MAXIMUM NODE NUMBER OF 25 IS REACHED +C + IF(IFLGG(NB,NZ,NY,NX).EQ.1)THEN + KVSTGX=KVSTG(NB,NZ,NY,NX)-24 + IF(KVSTGX.GT.0)THEN + K=MOD(KVSTGX,25) + IF(K.EQ.0.AND.KVSTGX.GT.0)K=25 + KX=MOD(KVSTG(NB,NZ,NY,NX),25) + IF(KX.EQ.0.AND.KVSTG(NB,NZ,NY,NX).NE.0)KX=25 + FSNC=TFN3(NZ,NY,NX)*XRLA(NZ,NY,NX) +C +C REMOBILIZATION OF LEAF C,N,P ALSO DEPENDS ON STRUCTURAL C:N:P +C + IF(IFLGP(NB,NZ,NY,NX).EQ.1)THEN + WGLFX(NB,NZ,NY,NX)=AMAX1(0.0,WGLF(K,NB,NZ,NY,NX)) + WGLFNX(NB,NZ,NY,NX)=AMAX1(0.0,WGLFN(K,NB,NZ,NY,NX)) + WGLFPX(NB,NZ,NY,NX)=AMAX1(0.0,WGLFP(K,NB,NZ,NY,NX)) + ARLFZ(NB,NZ,NY,NX)=AMAX1(0.0,ARLF(K,NB,NZ,NY,NX)) + IF(WGLFX(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + RCCLX(NB,NZ,NY,NX)=RCCC*WGLFX(NB,NZ,NY,NX) + RCZLX(NB,NZ,NY,NX)=WGLFNX(NB,NZ,NY,NX)*(RCCN+(1.0-RCCN)*RCCC) + RCPLX(NB,NZ,NY,NX)=WGLFPX(NB,NZ,NY,NX)*(RCCP+(1.0-RCCP)*RCCC) + ELSE + RCCLX(NB,NZ,NY,NX)=0.0 + RCZLX(NB,NZ,NY,NX)=0.0 + RCPLX(NB,NZ,NY,NX)=0.0 + ENDIF + ENDIF +C +C FRACTION OF CURRENT LEAF TO BE REMOBILIZED +C + IF(FSNC*WGLFX(NB,NZ,NY,NX).GT.WGLF(K,NB,NZ,NY,NX) + 2.AND.WGLFX(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + FSNCL=AMAX1(0.0,WGLF(K,NB,NZ,NY,NX)/WGLFX(NB,NZ,NY,NX)) + ELSE + FSNCL=FSNC + ENDIF +C +C NON-REMOBILIZABLE C,N,P BECOMES LITTERFALL ALLOCATED +C TO FRACTIONS SET IN 'STARTQ' +C + DO 6300 M=1,4 + CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX)+CFOPC(5,M,NZ,NY,NX) + 2*FSNCL*(WGLFX(NB,NZ,NY,NX)-RCCLX(NB,NZ,NY,NX))*FWODB(0) + ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX)+CFOPN(5,M,NZ,NY,NX) + 2*FSNCL*(WGLFNX(NB,NZ,NY,NX)-RCZLX(NB,NZ,NY,NX))*FWODLN(0) + PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX)+CFOPP(5,M,NZ,NY,NX) + 2*FSNCL*(WGLFPX(NB,NZ,NY,NX)-RCPLX(NB,NZ,NY,NX))*FWODLP(0) + CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX)+CFOPC(1,M,NZ,NY,NX) + 2*FSNCL*(WGLFX(NB,NZ,NY,NX)-RCCLX(NB,NZ,NY,NX))*FWODB(1) + ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX)+CFOPN(1,M,NZ,NY,NX) + 2*FSNCL*(WGLFNX(NB,NZ,NY,NX)-RCZLX(NB,NZ,NY,NX))*FWODLN(1) + PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX)+CFOPP(1,M,NZ,NY,NX) + 2*FSNCL*(WGLFPX(NB,NZ,NY,NX)-RCPLX(NB,NZ,NY,NX))*FWODLP(1) +6300 CONTINUE +C +C UPDATE STATE VARIABLES FOR REMOBILIZATION AND LITTERFALL +C + ARLFB(NB,NZ,NY,NX)=ARLFB(NB,NZ,NY,NX) + 2-FSNCL*ARLFZ(NB,NZ,NY,NX) + WTLFB(NB,NZ,NY,NX)=WTLFB(NB,NZ,NY,NX) + 2-FSNCL*WGLFX(NB,NZ,NY,NX) + WTLFBN(NB,NZ,NY,NX)=WTLFBN(NB,NZ,NY,NX) + 2-FSNCL*WGLFNX(NB,NZ,NY,NX) + WTLFBP(NB,NZ,NY,NX)=WTLFBP(NB,NZ,NY,NX) + 2-FSNCL*WGLFPX(NB,NZ,NY,NX) + ARLF(K,NB,NZ,NY,NX)=ARLF(K,NB,NZ,NY,NX) + 2-FSNCL*ARLFZ(NB,NZ,NY,NX) + WGLF(K,NB,NZ,NY,NX)=WGLF(K,NB,NZ,NY,NX) + 2-FSNCL*WGLFX(NB,NZ,NY,NX) + WGLFN(K,NB,NZ,NY,NX)=WGLFN(K,NB,NZ,NY,NX) + 2-FSNCL*WGLFNX(NB,NZ,NY,NX) + WGLFP(K,NB,NZ,NY,NX)=WGLFP(K,NB,NZ,NY,NX) + 2-FSNCL*WGLFPX(NB,NZ,NY,NX) + WSLF(K,NB,NZ,NY,NX)=AMAX1(0.0,WSLF(K,NB,NZ,NY,NX) + 2-FSNCL*AMAX1(WGLFNX(NB,NZ,NY,NX)*CNWS(NZ,NY,NX) + 3,WGLFPX(NB,NZ,NY,NX)*CPWS(NZ,NY,NX))) + CPOOL(NB,NZ,NY,NX)=CPOOL(NB,NZ,NY,NX)+FSNCL*RCCLX(NB,NZ,NY,NX) + ZPOOL(NB,NZ,NY,NX)=ZPOOL(NB,NZ,NY,NX)+FSNCL*RCZLX(NB,NZ,NY,NX) + PPOOL(NB,NZ,NY,NX)=PPOOL(NB,NZ,NY,NX)+FSNCL*RCPLX(NB,NZ,NY,NX) +C +C REMOBILIZATION OF SHEATHS OR PETIOLE C,N,P ALSO DEPENDS ON +C STRUCTURAL C:N:P +C + IF(IFLGP(NB,NZ,NY,NX).EQ.1)THEN + WGSHEX(NB,NZ,NY,NX)=AMAX1(0.0,WGSHE(K,NB,NZ,NY,NX)) + WGSHNX(NB,NZ,NY,NX)=AMAX1(0.0,WGSHN(K,NB,NZ,NY,NX)) + WGSHPX(NB,NZ,NY,NX)=AMAX1(0.0,WGSHP(K,NB,NZ,NY,NX)) + HTSHEX(NB,NZ,NY,NX)=AMAX1(0.0,HTSHE(K,NB,NZ,NY,NX)) + IF(WGSHEX(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + RCCSX(NB,NZ,NY,NX)=RCCC*WGSHEX(NB,NZ,NY,NX) + RCZSX(NB,NZ,NY,NX)=WGSHNX(NB,NZ,NY,NX) + 2*(RCCN+(1.0-RCCN)*RCCSX(NB,NZ,NY,NX)/WGSHEX(NB,NZ,NY,NX)) + RCPSX(NB,NZ,NY,NX)=WGSHPX(NB,NZ,NY,NX) + 2*(RCCP+(1.0-RCCP)*RCCSX(NB,NZ,NY,NX)/WGSHEX(NB,NZ,NY,NX)) + ELSE + RCCSX(NB,NZ,NY,NX)=0.0 + RCZSX(NB,NZ,NY,NX)=0.0 + RCPSX(NB,NZ,NY,NX)=0.0 + ENDIF + WTSTXB(NB,NZ,NY,NX)=WTSTXB(NB,NZ,NY,NX)+WGNODE(K,NB,NZ,NY,NX) + WTSTXN(NB,NZ,NY,NX)=WTSTXN(NB,NZ,NY,NX)+WGNODN(K,NB,NZ,NY,NX) + WTSTXP(NB,NZ,NY,NX)=WTSTXP(NB,NZ,NY,NX)+WGNODP(K,NB,NZ,NY,NX) +C IF(NZ.EQ.2)THEN +C WRITE(*,2358)'WTSTXB',I,J,NZ,NB,K,WTSTXB(NB,NZ,NY,NX) +C 2,WTSTKB(NB,NZ,NY,NX),WGNODE(K,NB,NZ,NY,NX) +2358 FORMAT(A8,5I4,12E12.4) +C ENDIF + WGNODE(K,NB,NZ,NY,NX)=0.0 + WGNODN(K,NB,NZ,NY,NX)=0.0 + WGNODP(K,NB,NZ,NY,NX)=0.0 + HTNODX(K,NB,NZ,NY,NX)=0.0 + ENDIF +C +C FRACTION OF CURRENT SHEATH TO BE REMOBILIZED +C + IF(FSNC*WGSHEX(NB,NZ,NY,NX).GT.WGSHE(K,NB,NZ,NY,NX) + 2.AND.WGSHEX(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + FSNCS=AMAX1(0.0,WGSHE(K,NB,NZ,NY,NX)/WGSHEX(NB,NZ,NY,NX)) + ELSE + FSNCS=FSNC + ENDIF +C +C NON-REMOBILIZABLE C,N,P BECOMES LITTERFALL ALLOCATED +C TO FRACTIONS SET IN 'STARTQ' +C + DO 6305 M=1,4 + CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX)+CFOPC(5,M,NZ,NY,NX) + 2*FSNCS*(WGSHEX(NB,NZ,NY,NX)-RCCSX(NB,NZ,NY,NX))*FWODB(0) + ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX)+CFOPN(5,M,NZ,NY,NX) + 2*FSNCS*(WGSHNX(NB,NZ,NY,NX)-RCZSX(NB,NZ,NY,NX))*FWODSN(0) + PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX)+CFOPP(5,M,NZ,NY,NX) + 2*FSNCS*(WGSHPX(NB,NZ,NY,NX)-RCPSX(NB,NZ,NY,NX))*FWODSP(0) + CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX)+CFOPC(2,M,NZ,NY,NX) + 2*FSNCS*(WGSHEX(NB,NZ,NY,NX)-RCCSX(NB,NZ,NY,NX))*FWODB(1) + ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX)+CFOPN(2,M,NZ,NY,NX) + 2*FSNCS*(WGSHNX(NB,NZ,NY,NX)-RCZSX(NB,NZ,NY,NX))*FWODSN(1) + PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX)+CFOPP(2,M,NZ,NY,NX) + 2*FSNCS*(WGSHPX(NB,NZ,NY,NX)-RCPSX(NB,NZ,NY,NX))*FWODSP(1) +6305 CONTINUE +C +C UPDATE STATE VARIABLES FOR REMOBILIZATION AND LITTERFALL +C + WTSHEB(NB,NZ,NY,NX)=WTSHEB(NB,NZ,NY,NX) + 2-FSNCS*WGSHEX(NB,NZ,NY,NX) + WTSHBN(NB,NZ,NY,NX)=WTSHBN(NB,NZ,NY,NX) + 2-FSNCS*WGSHNX(NB,NZ,NY,NX) + WTSHBP(NB,NZ,NY,NX)=WTSHBP(NB,NZ,NY,NX) + 2-FSNCS*WGSHPX(NB,NZ,NY,NX) + HTSHE(K,NB,NZ,NY,NX)=HTSHE(K,NB,NZ,NY,NX) + 2-FSNCS*HTSHEX(NB,NZ,NY,NX) + WGSHE(K,NB,NZ,NY,NX)=WGSHE(K,NB,NZ,NY,NX) + 2-FSNCS*WGSHEX(NB,NZ,NY,NX) + WGSHN(K,NB,NZ,NY,NX)=WGSHN(K,NB,NZ,NY,NX) + 2-FSNCS*WGSHNX(NB,NZ,NY,NX) + WGSHP(K,NB,NZ,NY,NX)=WGSHP(K,NB,NZ,NY,NX) + 2-FSNCS*WGSHPX(NB,NZ,NY,NX) + WSSHE(K,NB,NZ,NY,NX)=AMAX1(0.0,WSSHE(K,NB,NZ,NY,NX) + 2-FSNCS*AMAX1(WGSHNX(NB,NZ,NY,NX)*CNWS(NZ,NY,NX) + 3,WGSHPX(NB,NZ,NY,NX)*CPWS(NZ,NY,NX))) + CPOOL(NB,NZ,NY,NX)=CPOOL(NB,NZ,NY,NX)+FSNCS*RCCSX(NB,NZ,NY,NX) + ZPOOL(NB,NZ,NY,NX)=ZPOOL(NB,NZ,NY,NX)+FSNCS*RCZSX(NB,NZ,NY,NX) + PPOOL(NB,NZ,NY,NX)=PPOOL(NB,NZ,NY,NX)+FSNCS*RCPSX(NB,NZ,NY,NX) + ENDIF + ENDIF +C +C REMOBILIZATION OF STALK RESERVE C,N,P IF GROWTH RESPIRATION < 0 +C + IF(IFLGZ.EQ.0)THEN + IF(SNCR.GT.0.0.AND.WTRSVB(NB,NZ,NY,NX).GT.0.0)THEN + RCO2V=AMIN1(SNCR,VMXC*WTRSVB(NB,NZ,NY,NX)*TFN3(NZ,NY,NX)) + WTRSVB(NB,NZ,NY,NX)=WTRSVB(NB,NZ,NY,NX)-RCO2V + SNCR=SNCR-RCO2V + ENDIF + ENDIF +C +C TOTAL REMOBILIZATION = GROWTH RESPIRATION < 0 + DECIDUOUS LEAF +C FALL DURING AUTUMN + REMOBILZATION DURING GRAIN FILL IN ANNUALS +C + IF(ISTYP(NZ,NY,NX).NE.0.AND.IFLGZ.EQ.1.AND.IFLGY.EQ.1)THEN + SNCZ=FXFB(IBTYP(NZ,NY,NX)) + 2*WTLSB(NB,NZ,NY,NX)*AMIN1(1.0,FLGZ(NB,NZ,NY,NX)/FLGZX) + ELSE + SNCZ=0.0 + ENDIF + SNCX=SNCR+SNCZ + IF(SNCX.GT.ZEROP(NZ,NY,NX))THEN + SNCF=SNCZ/SNCX + KSNC=INT(0.5*(KVSTG(NB,NZ,NY,NX)-KVSTGN(NB,NZ,NY,NX)))+1 + XKSNC=KSNC + KN=MAX(0,KVSTGN(NB,NZ,NY,NX)-1) +C IF(NZ.EQ.2.OR.NZ.EQ.3)THEN +C WRITE(*,1266)'SNCX0',I,J,NX,NY,NZ,NB,SNCY,SNCR,SNCX,SNCF +C 2,CPOOL(NB,NZ,NY,NX),WTLSB(NB,NZ,NY,NX),RCCC +1266 FORMAT(A8,6I4,12E16.8) +C ENDIF +C +C TRANSFER NON-STRUCTURAL C,N,P FROM BRANCHES TO MAIN STEM +C IF MAIN STEM POOLS ARE DEPLETED +C + IF(IBTYP(NZ,NY,NX).NE.0.AND.IGTYP(NZ,NY,NX).GT.1 + 2.AND.NB.EQ.NB1(NZ,NY,NX).AND.SNCF.EQ.0)THEN + NBY=0 + DO 584 NBL=1,NBR(NZ,NY,NX) + NBZ(NBL)=0 +584 CONTINUE + DO 586 NBL=1,NBR(NZ,NY,NX) + NBX=KVSTG(NB,NZ,NY,NX) + DO 585 NBK=1,NBR(NZ,NY,NX) + IF(IDTHB(NBK,NZ,NY,NX).EQ.0.AND.NBK.NE.NB1(NZ,NY,NX) + 2.AND.NBTB(NBK,NZ,NY,NX).LT.NBX + 3.AND.NBTB(NBK,NZ,NY,NX).GT.NBY)THEN + NBZ(NBL)=NBK + NBX=NBTB(NBK,NZ,NY,NX) + ENDIF +585 CONTINUE + IF(NBZ(NBL).NE.0)THEN + NBY=NBTB(NBZ(NBL),NZ,NY,NX) + ENDIF +586 CONTINUE + DO 580 NBL=1,NBR(NZ,NY,NX) + IF(NBZ(NBL).NE.0)THEN + IF(NBTB(NBZ(NBL),NZ,NY,NX).LT.KK)THEN + IF(CPOOL(NBZ(NBL),NZ,NY,NX).GT.0)THEN + XFRC=1.0E-02*AMIN1(SNCX,CPOOL(NBZ(NBL),NZ,NY,NX)) + XFRN=XFRC*ZPOOL(NBZ(NBL),NZ,NY,NX)/CPOOL(NBZ(NBL),NZ,NY,NX) + XFRP=XFRC*PPOOL(NBZ(NBL),NZ,NY,NX)/CPOOL(NBZ(NBL),NZ,NY,NX) + ELSE + XFRC=0.0 + XFRN=1.0E-02*ZPOOL(NBZ(NBL),NZ,NY,NX) + XFRP=1.0E-02*PPOOL(NBZ(NBL),NZ,NY,NX) + ENDIF + CPOOL(NBZ(NBL),NZ,NY,NX)=CPOOL(NBZ(NBL),NZ,NY,NX)-XFRC + ZPOOL(NBZ(NBL),NZ,NY,NX)=ZPOOL(NBZ(NBL),NZ,NY,NX)-XFRN + PPOOL(NBZ(NBL),NZ,NY,NX)=PPOOL(NBZ(NBL),NZ,NY,NX)-XFRP + CPOOL(NB1(NZ,NY,NX),NZ,NY,NX)=CPOOL(NB1(NZ,NY,NX),NZ,NY,NX) + 2+XFRC*SNCF + ZPOOL(NB1(NZ,NY,NX),NZ,NY,NX)=ZPOOL(NB1(NZ,NY,NX),NZ,NY,NX) + 2+XFRN + PPOOL(NB1(NZ,NY,NX),NZ,NY,NX)=PPOOL(NB1(NZ,NY,NX),NZ,NY,NX) + 2+XFRP + SNCX=SNCX-XFRC + IF(SNCX.LE.0.0)GO TO 595 + ENDIF + ENDIF +580 CONTINUE + ENDIF +C +C REMOBILIZATION AND LITTERFALL WHEN GROWTH RESPIRATION < 0 +C STARTING FROM LOWEST LEAFED NODE AND PROCEEDING UPWARDS +C +C IF(NZ.EQ.2.OR.NZ.EQ.3)THEN +C WRITE(*,1266)'SNCX1',I,J,NX,NY,NZ,NB,SNCY,SNCR,SNCX,SNCF +C 2,CPOOL(NB,NZ,NY,NX),WTLSB(NB,NZ,NY,NX),RCCC +C ENDIF + DO 575 N=1,KSNC + SNCT=SNCX/XKSNC + DO 650 KK=KN,KVSTG(NB,NZ,NY,NX) + SNCLF=0.0 + SNCSH=0.0 + K=MOD(KK,25) + IF(K.EQ.0.AND.KK.NE.0)K=25 +C +C REMOBILIZATION OF LEAF C,N,P DEPENDS ON NON-STRUCTURAL C:N:P +C + IF(WGLF(K,NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + FNCLF=WGLF(K,NB,NZ,NY,NX)/(WGLF(K,NB,NZ,NY,NX) + 2+WGSHE(K,NB,NZ,NY,NX)) + SNCLF=FNCLF*SNCT + SNCSH=SNCT-SNCLF + RCCL=RCCC*WGLF(K,NB,NZ,NY,NX) + RCZL=WGLFN(K,NB,NZ,NY,NX)*(RCCN+(1.0-RCCN)*RCCC) + RCPL=WGLFP(K,NB,NZ,NY,NX)*(RCCP+(1.0-RCCP)*RCCC) +C +C FRACTION OF CURRENT LEAF TO BE REMOBILIZED +C + IF(RCCL.GT.ZEROP(NZ,NY,NX))THEN + FSNCL=AMAX1(0.0,AMIN1(1.0,SNCLF/RCCL)) + ELSE + FSNCL=1.0 + ENDIF + FSNAL=FSNCL +C +C NON-REMOBILIZABLE C,N,P BECOMES LITTERFALL ALLOCATED +C TO FRACTIONS SET IN 'STARTQ' +C +C IF(NZ.EQ.1)THEN +C WRITE(*,4898)'SNCT1',I,J,NX,NY,NZ,NB,K,N +C 2,KN,KVSTG(NB,NZ,NY,NX),SNCLF,SNCT +C 2,FSNCL,RCCL,WTLFB(NB,NZ,NY,NX),ARLFB(NB,NZ,NY,NX) +C 2,WGLFN(K,NB,NZ,NY,NX),WGLFLN(1,K,NB,NZ,NY,NX) +C 3,ARLF(K,NB,NZ,NY,NX) +4898 FORMAT(A8,10I4,12E16.8) +C ENDIF + DO 6310 M=1,4 + CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX)+CFOPC(5,M,NZ,NY,NX) + 2*FSNCL*(WGLF(K,NB,NZ,NY,NX)-RCCL)*FWODB(0) + ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX)+CFOPN(5,M,NZ,NY,NX) + 2*FSNCL*(WGLFN(K,NB,NZ,NY,NX)-RCZL)*FWODLN(0) + PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX)+CFOPP(5,M,NZ,NY,NX) + 2*FSNCL*(WGLFP(K,NB,NZ,NY,NX)-RCPL)*FWODLP(0) + CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX)+CFOPC(1,M,NZ,NY,NX) + 2*FSNCL*(WGLF(K,NB,NZ,NY,NX)-RCCL)*FWODB(1) + ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX)+CFOPN(1,M,NZ,NY,NX) + 2*FSNCL*(WGLFN(K,NB,NZ,NY,NX)-RCZL)*FWODLN(1) + PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX)+CFOPP(1,M,NZ,NY,NX) + 2*FSNCL*(WGLFP(K,NB,NZ,NY,NX)-RCPL)*FWODLP(1) +6310 CONTINUE + IF(K.NE.0)THEN + CSNC(2,1,0,NZ,NY,NX)=CSNC(2,1,0,NZ,NY,NX) + 2+FSNCL*(CPOOL3(K,NB,NZ,NY,NX)+CPOOL4(K,NB,NZ,NY,NX)) + CPOOL3(K,NB,NZ,NY,NX)=CPOOL3(K,NB,NZ,NY,NX) + 2-FSNCL*CPOOL3(K,NB,NZ,NY,NX) + CPOOL4(K,NB,NZ,NY,NX)=CPOOL4(K,NB,NZ,NY,NX) + 2-FSNCL*CPOOL4(K,NB,NZ,NY,NX) + ENDIF +C +C UPDATE STATE VARIABLES FOR REMOBILIZATION AND LITTERFALL +C + ARLFB(NB,NZ,NY,NX)=AMAX1(0.0,ARLFB(NB,NZ,NY,NX) + 2-FSNAL*ARLF(K,NB,NZ,NY,NX)) + WTLFB(NB,NZ,NY,NX)=AMAX1(0.0,WTLFB(NB,NZ,NY,NX) + 2-FSNCL*WGLF(K,NB,NZ,NY,NX)) + WTLFBN(NB,NZ,NY,NX)=AMAX1(0.0,WTLFBN(NB,NZ,NY,NX) + 2-FSNCL*WGLFN(K,NB,NZ,NY,NX)) + WTLFBP(NB,NZ,NY,NX)=AMAX1(0.0,WTLFBP(NB,NZ,NY,NX) + 2-FSNCL*WGLFP(K,NB,NZ,NY,NX)) + ARLF(K,NB,NZ,NY,NX)=ARLF(K,NB,NZ,NY,NX) + 2-FSNAL*ARLF(K,NB,NZ,NY,NX) + WGLF(K,NB,NZ,NY,NX)=WGLF(K,NB,NZ,NY,NX) + 2-FSNCL*WGLF(K,NB,NZ,NY,NX) + WGLFN(K,NB,NZ,NY,NX)=WGLFN(K,NB,NZ,NY,NX) + 2-FSNCL*WGLFN(K,NB,NZ,NY,NX) + WGLFP(K,NB,NZ,NY,NX)=WGLFP(K,NB,NZ,NY,NX) + 2-FSNCL*WGLFP(K,NB,NZ,NY,NX) + WSLF(K,NB,NZ,NY,NX)=AMAX1(0.0,WSLF(K,NB,NZ,NY,NX) + 2-FSNCL*AMAX1(WGLFN(K,NB,NZ,NY,NX)*CNWS(NZ,NY,NX) + 3,WGLFP(K,NB,NZ,NY,NX)*CPWS(NZ,NY,NX))) +C +C FRACTION OF C REMOBILIZED FOR GROWTH RESPIRATION < 0 IS +C RESPIRED AND NOT TRANSFERRED TO NON-STRUCTURAL POOLS +C + CPOOL(NB,NZ,NY,NX)=CPOOL(NB,NZ,NY,NX)+FSNCL*RCCL*SNCF + ZPOOL(NB,NZ,NY,NX)=ZPOOL(NB,NZ,NY,NX)+FSNCL*RCZL + PPOOL(NB,NZ,NY,NX)=PPOOL(NB,NZ,NY,NX)+FSNCL*RCPL + SNCLF=SNCLF-FSNCL*RCCL + SNCT=SNCT-FSNCL*RCCL + IF(WTLFB(NB,NZ,NY,NX).LT.ZEROL(NZ,NY,NX))THEN + WTLFB(NB,NZ,NY,NX)=0.0 + ARLFB(NB,NZ,NY,NX)=0.0 + ENDIF +C +C EXIT LOOP IF REMOBILIZATION REQUIREMENT HAS BEEN MET +C + IF(SNCLF.LE.ZEROP(NZ,NY,NX))GO TO 564 +C +C OTHERWISE REMAINING C,N,P IN LEAF GOES TO LITTERFALL +C + ELSE +C IF(NZ.EQ.1)THEN +C WRITE(*,4899)'SNCT2',I,J,NX,NY,NZ,NB,K,N,SNCLF,SNCT +C 2,FSNCL,RCCL,WTLFB(NB,NZ,NY,NX),ARLFB(NB,NZ,NY,NX) +C 2,WGLFN(K,NB,NZ,NY,NX),WGLFLN(1,K,NB,NZ,NY,NX) +C 3,ARLF(K,NB,NZ,NY,NX) +4899 FORMAT(A8,8I4,12E16.8) +C ENDIF + DO 6315 M=1,4 + CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX)+CFOPC(5,M,NZ,NY,NX) + 2*WGLF(K,NB,NZ,NY,NX)*FWODB(0) + ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX)+CFOPN(5,M,NZ,NY,NX) + 2*WGLFN(K,NB,NZ,NY,NX)*FWODLN(0) + PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX)+CFOPP(5,M,NZ,NY,NX) + 2*WGLFP(K,NB,NZ,NY,NX)*FWODLP(0) + CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX)+CFOPC(1,M,NZ,NY,NX) + 2*WGLF(K,NB,NZ,NY,NX)*FWODB(1) + ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX)+CFOPN(1,M,NZ,NY,NX) + 2*WGLFN(K,NB,NZ,NY,NX)*FWODLN(1) + PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX)+CFOPP(1,M,NZ,NY,NX) + 2*WGLFP(K,NB,NZ,NY,NX)*FWODLP(1) +6315 CONTINUE + IF(K.NE.0)THEN + CSNC(2,1,0,NZ,NY,NX)=CSNC(2,1,0,NZ,NY,NX) + 2+CPOOL3(K,NB,NZ,NY,NX)+CPOOL4(K,NB,NZ,NY,NX) + CPOOL3(K,NB,NZ,NY,NX)=0.0 + CPOOL4(K,NB,NZ,NY,NX)=0.0 + ENDIF + ARLFB(NB,NZ,NY,NX)=AMAX1(0.0,ARLFB(NB,NZ,NY,NX) + 2-ARLF(K,NB,NZ,NY,NX)) + WTLFB(NB,NZ,NY,NX)=AMAX1(0.0,WTLFB(NB,NZ,NY,NX) + 2-WGLF(K,NB,NZ,NY,NX)) + WTLFBN(NB,NZ,NY,NX)=AMAX1(0.0,WTLFBN(NB,NZ,NY,NX) + 2-WGLFN(K,NB,NZ,NY,NX)) + WTLFBP(NB,NZ,NY,NX)=AMAX1(0.0,WTLFBP(NB,NZ,NY,NX) + 2-WGLFP(K,NB,NZ,NY,NX)) + ARLF(K,NB,NZ,NY,NX)=0.0 + WGLF(K,NB,NZ,NY,NX)=0.0 + WGLFN(K,NB,NZ,NY,NX)=0.0 + WGLFP(K,NB,NZ,NY,NX)=0.0 + WSLF(K,NB,NZ,NY,NX)=0.0 + IF(WTLFB(NB,NZ,NY,NX).LT.ZEROL(NZ,NY,NX))THEN + WTLFB(NB,NZ,NY,NX)=0.0 + ARLFB(NB,NZ,NY,NX)=0.0 + ENDIF + ENDIF +C +C REMOBILIZATION OF SHEATHS OR PETIOLE C,N,P DEPENDS ON +C NON-STRUCTURAL C:N:P +C +564 CONTINUE + IF(WGSHE(K,NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + RCCS=RCCC*WGSHE(K,NB,NZ,NY,NX) + RCZS=WGSHN(K,NB,NZ,NY,NX)*(RCCN+(1.0-RCCN)*RCCC) + RCPS=WGSHP(K,NB,NZ,NY,NX)*(RCCP+(1.0-RCCP)*RCCC) +C +C FRACTION OF REMOBILIZATION THAT CAN BE MET FROM CURRENT SHEATH +C OR PETIOLE +C + IF(RCCS.GT.ZEROP(NZ,NY,NX))THEN + FSNCS=AMAX1(0.0,AMIN1(1.0,SNCSH/RCCS)) + ELSE + FSNCS=1.0 + ENDIF + FSNAS=1.0*FSNCS +C +C NON-REMOBILIZABLE C,N,P BECOMES LITTERFALL ALLOCATED +C TO FRACTIONS SET IN 'STARTQ' +C + DO 6320 M=1,4 + CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX)+CFOPC(5,M,NZ,NY,NX) + 2*FSNCS*(WGSHE(K,NB,NZ,NY,NX)-RCCS)*FWODB(0) + ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX)+CFOPN(5,M,NZ,NY,NX) + 2*FSNCS*(WGSHN(K,NB,NZ,NY,NX)-RCZS)*FWODSN(0) + PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX)+CFOPP(5,M,NZ,NY,NX) + 2*FSNCS*(WGSHP(K,NB,NZ,NY,NX)-RCPS)*FWODSP(0) + CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX)+CFOPC(2,M,NZ,NY,NX) + 2*FSNCS*(WGSHE(K,NB,NZ,NY,NX)-RCCS)*FWODB(1) + ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX)+CFOPN(2,M,NZ,NY,NX) + 2*FSNCS*(WGSHN(K,NB,NZ,NY,NX)-RCZS)*FWODSN(1) + PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX)+CFOPP(2,M,NZ,NY,NX) + 2*FSNCS*(WGSHP(K,NB,NZ,NY,NX)-RCPS)*FWODSP(1) +6320 CONTINUE +C +C UPDATE STATE VARIABLES FOR REMOBILIZATION AND LITTERFALL +C + WTSHEB(NB,NZ,NY,NX)=AMAX1(0.0,WTSHEB(NB,NZ,NY,NX) + 2-FSNCS*WGSHE(K,NB,NZ,NY,NX)) + WTSHBN(NB,NZ,NY,NX)=AMAX1(0.0,WTSHBN(NB,NZ,NY,NX) + 2-FSNCS*WGSHN(K,NB,NZ,NY,NX)) + WTSHBP(NB,NZ,NY,NX)=AMAX1(0.0,WTSHBP(NB,NZ,NY,NX) + 2-FSNCS*WGSHP(K,NB,NZ,NY,NX)) + HTSHE(K,NB,NZ,NY,NX)=HTSHE(K,NB,NZ,NY,NX) + 2-FSNAS*HTSHE(K,NB,NZ,NY,NX) + WGSHE(K,NB,NZ,NY,NX)=WGSHE(K,NB,NZ,NY,NX) + 2-FSNCS*WGSHE(K,NB,NZ,NY,NX) + WGSHN(K,NB,NZ,NY,NX)=WGSHN(K,NB,NZ,NY,NX) + 2-FSNCS*WGSHN(K,NB,NZ,NY,NX) + WGSHP(K,NB,NZ,NY,NX)=WGSHP(K,NB,NZ,NY,NX) + 2-FSNCS*WGSHP(K,NB,NZ,NY,NX) + WSSHE(K,NB,NZ,NY,NX)=AMAX1(0.0,WSSHE(K,NB,NZ,NY,NX) + 2-FSNCS*AMAX1(WGSHN(K,NB,NZ,NY,NX)*CNWS(NZ,NY,NX) + 3,WGSHP(K,NB,NZ,NY,NX)*CPWS(NZ,NY,NX))) +C +C FRACTION OF C REMOBILIZED FOR GROWTH RESPIRATION < 0 IS +C RESPIRED AND NOT TRANSFERRED TO NON-STRUCTURAL POOLS +C + CPOOL(NB,NZ,NY,NX)=CPOOL(NB,NZ,NY,NX)+FSNCS*RCCS*SNCF + ZPOOL(NB,NZ,NY,NX)=ZPOOL(NB,NZ,NY,NX)+FSNCS*RCZS + PPOOL(NB,NZ,NY,NX)=PPOOL(NB,NZ,NY,NX)+FSNCS*RCPS + SNCSH=SNCSH-FSNCS*RCCS + SNCT=SNCT-FSNCS*RCCS + IF(WTSHEB(NB,NZ,NY,NX).LT.ZEROL(NZ,NY,NX))THEN + WTSHEB(NB,NZ,NY,NX)=0.0 + ENDIF +C +C EXIT LOOP IF REMOBILIZATION REQUIREMENT HAS BEEN MET +C + IF(SNCSH.LE.ZEROP(NZ,NY,NX))GO TO 565 +C +C OTHERWISE REMAINING C,N,P IN SHEATH OR PETIOLE GOES TO LITTERFALL +C + ELSE + DO 6325 M=1,4 + CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX)+CFOPC(5,M,NZ,NY,NX) + 2*WGSHE(K,NB,NZ,NY,NX)*FWODB(0) + ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX)+CFOPN(5,M,NZ,NY,NX) + 2*WGSHN(K,NB,NZ,NY,NX)*FWODSN(0) + PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX)+CFOPP(5,M,NZ,NY,NX) + 2*WGSHP(K,NB,NZ,NY,NX)*FWODSP(0) + CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX)+CFOPC(2,M,NZ,NY,NX) + 2*WGSHE(K,NB,NZ,NY,NX)*FWODB(1) + ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX)+CFOPN(2,M,NZ,NY,NX) + 2*WGSHN(K,NB,NZ,NY,NX)*FWODSN(1) + PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX)+CFOPP(2,M,NZ,NY,NX) + 2*WGSHP(K,NB,NZ,NY,NX)*FWODSP(1) +6325 CONTINUE + WTSHEB(NB,NZ,NY,NX)=AMAX1(0.0,WTSHEB(NB,NZ,NY,NX) + 2-WGSHE(K,NB,NZ,NY,NX)) + WTSHBN(NB,NZ,NY,NX)=AMAX1(0.0,WTSHBN(NB,NZ,NY,NX) + 2-WGSHN(K,NB,NZ,NY,NX)) + WTSHBP(NB,NZ,NY,NX)=AMAX1(0.0,WTSHBP(NB,NZ,NY,NX) + 2-WGSHP(K,NB,NZ,NY,NX)) + HTSHE(K,NB,NZ,NY,NX)=0.0 + WGSHE(K,NB,NZ,NY,NX)=0.0 + WGSHN(K,NB,NZ,NY,NX)=0.0 + WGSHP(K,NB,NZ,NY,NX)=0.0 + WSSHE(K,NB,NZ,NY,NX)=0.0 + IF(WTSHEB(NB,NZ,NY,NX).LT.ZEROL(NZ,NY,NX))THEN + WTSHEB(NB,NZ,NY,NX)=0.0 + ENDIF + ENDIF +650 CONTINUE + KN=KN+1 + SNCR=SNCT*(1.0-SNCF) +C +C REMOBILIZATION OF RESERVE C +C + IF(WTRSVB(NB,NZ,NY,NX).GT.SNCR)THEN + WTRSVB(NB,NZ,NY,NX)=WTRSVB(NB,NZ,NY,NX)-SNCR + SNCR=0.0 + GO TO 565 + ENDIF +C +C REMOBILIZATION OF STALK C,N,P +C + SNCZ=FXFS*SNCR + SNCT=SNCR+SNCZ + IF(ISTYP(NZ,NY,NX).NE.0.AND.SNCT.GT.ZEROP(NZ,NY,NX) + 2.AND.WTSTKB(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + SNCF=SNCZ/SNCT + FRCC=WVSTKB(NB,NZ,NY,NX)/WTSTKB(NB,NZ,NY,NX) + RCSC=RCCC*FRCC + RCSN=RCCN*FRCC + RCSP=RCCP*FRCC + MXNOD=KVSTG(NB,NZ,NY,NX) + MNNOD=MAX(MIN(0,MAX(0,MXNOD-NNOD(NZ,NY,NX))) + 2,KVSTG(NB,NZ,NY,NX)-23) + MXNOD=MAX(MXNOD,MNNOD) + DO 1650 KK=MXNOD,MNNOD,-1 + K=MOD(KK,25) + IF(K.EQ.0.AND.KK.NE.0)K=25 +C IF(NZ.EQ.1.OR.NZ.EQ.4)THEN +C WRITE(*,2356)'WGNODE1',I,J,NZ,NB,K,KK,MXNOD,MNNOD +C 2,KSNC,RCCC,FRCC,RCSC,SNCT,WGNODE(K,NB,NZ,NY,NX) +C 3,HTNODX(K,NB,NZ,NY,NX),WTSTKB(NB,NZ,NY,NX) +C 4,CPOOL(NB,NZ,NY,NX) +C ENDIF +C +C REMOBILIZATION OF STALK C,N,P DEPENDS ON NON-STRUCTURAL C:N:P +C + IF(WGNODE(K,NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + RCCK=RCSC*WGNODE(K,NB,NZ,NY,NX) + RCZK=WGNODN(K,NB,NZ,NY,NX)*(RCSN+(1.0-RCSN)*RCSC) + RCPK=WGNODP(K,NB,NZ,NY,NX)*(RCSP+(1.0-RCSP)*RCSC) +C +C FRACTION OF CURRENT NODE TO BE REMOBILIZED +C + IF(RCCK.GT.ZEROP(NZ,NY,NX))THEN + FSNCK=AMAX1(0.0,AMIN1(1.0,SNCT/RCCK)) + ELSE + FSNCK=1.0 + ENDIF +C +C NON-REMOBILIZABLE C,N,P BECOMES LITTERFALL ALLOCATED +C TO FRACTIONS SET IN 'STARTQ' +C + DO 7310 M=1,4 + CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX)+CFOPC(3,M,NZ,NY,NX) + 2*FSNCK*(WGNODE(K,NB,NZ,NY,NX)-RCCK) + ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX)+CFOPN(3,M,NZ,NY,NX) + 2*FSNCK*(WGNODN(K,NB,NZ,NY,NX)-RCZK) + PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX)+CFOPP(3,M,NZ,NY,NX) + 2*FSNCK*(WGNODP(K,NB,NZ,NY,NX)-RCPK) +7310 CONTINUE +C +C UPDATE STATE VARIABLES FOR REMOBILIZATION AND LITTERFALL +C + WTSTKB(NB,NZ,NY,NX)=AMAX1(0.0,WTSTKB(NB,NZ,NY,NX) + 2-FSNCK*WGNODE(K,NB,NZ,NY,NX)) + WTSTBN(NB,NZ,NY,NX)=AMAX1(0.0,WTSTBN(NB,NZ,NY,NX) + 2-FSNCK*WGNODN(K,NB,NZ,NY,NX)) + WTSTBP(NB,NZ,NY,NX)=AMAX1(0.0,WTSTBP(NB,NZ,NY,NX) + 2-FSNCK*WGNODP(K,NB,NZ,NY,NX)) + HTNODE(K,NB,NZ,NY,NX)=HTNODE(K,NB,NZ,NY,NX) + 2-FSNCK*HTNODX(K,NB,NZ,NY,NX) + WGNODE(K,NB,NZ,NY,NX)=WGNODE(K,NB,NZ,NY,NX) + 2-FSNCK*WGNODE(K,NB,NZ,NY,NX) + WGNODN(K,NB,NZ,NY,NX)=WGNODN(K,NB,NZ,NY,NX) + 2-FSNCK*WGNODN(K,NB,NZ,NY,NX) + WGNODP(K,NB,NZ,NY,NX)=WGNODP(K,NB,NZ,NY,NX) + 2-FSNCK*WGNODP(K,NB,NZ,NY,NX) + HTNODX(K,NB,NZ,NY,NX)=HTNODX(K,NB,NZ,NY,NX) + 2-FSNCK*HTNODX(K,NB,NZ,NY,NX) +C +C FRACTION OF C REMOBILIZED FOR GROWTH RESPIRATION < 0 IS +C RESPIRED AND NOT TRANSFERRED TO NON-STRUCTURAL POOLS +C + WTRSVB(NB,NZ,NY,NX)=WTRSVB(NB,NZ,NY,NX)+FSNCK*RCCK*SNCF + WTRSBN(NB,NZ,NY,NX)=WTRSBN(NB,NZ,NY,NX)+FSNCK*RCZK + WTRSBP(NB,NZ,NY,NX)=WTRSBP(NB,NZ,NY,NX)+FSNCK*RCPK + SNCT=SNCT-FSNCK*RCCK +C IF(NZ.EQ.1.OR.NZ.EQ.4)THEN +C WRITE(*,2356)'WGNODE2',I,J,NZ,NB,K,KK,MXNOD,MNNOD +C 2,KSNC,RCCC,FRCC,RCSC,SNCT,WGNODE(K,NB,NZ,NY,NX) +C 3,HTNODX(K,NB,NZ,NY,NX),WTSTKB(NB,NZ,NY,NX) +C 4,CPOOL(NB,NZ,NY,NX) +2356 FORMAT(A8,9I4,12E16.8) +C ENDIF +C +C EXIT LOOP IF REMOBILIZATION REQUIREMENT HAS BEEN MET +C + IF(SNCT.LE.ZEROP(NZ,NY,NX))GO TO 565 +C +C OTHERWISE REMAINING C,N,P IN NODE GOES TO LITTERFALL +C + ELSE + DO 7315 M=1,4 + CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX)+CFOPC(3,M,NZ,NY,NX) + 2*WGNODE(K,NB,NZ,NY,NX) + ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX)+CFOPN(3,M,NZ,NY,NX) + 2*WGNODN(K,NB,NZ,NY,NX) + PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX)+CFOPP(3,M,NZ,NY,NX) + 2*WGNODP(K,NB,NZ,NY,NX) +7315 CONTINUE + WTSTKB(NB,NZ,NY,NX)=AMAX1(0.0,WTSTKB(NB,NZ,NY,NX) + 2-WGNODE(K,NB,NZ,NY,NX)) + WTSTBN(NB,NZ,NY,NX)=AMAX1(0.0,WTSTBN(NB,NZ,NY,NX) + 2-WGNODN(K,NB,NZ,NY,NX)) + WTSTBP(NB,NZ,NY,NX)=AMAX1(0.0,WTSTBP(NB,NZ,NY,NX) + 2-WGNODP(K,NB,NZ,NY,NX)) + HTNODE(K,NB,NZ,NY,NX)=HTNODE(K,NB,NZ,NY,NX) + 2-HTNODX(K,NB,NZ,NY,NX) + WGNODE(K,NB,NZ,NY,NX)=0.0 + WGNODN(K,NB,NZ,NY,NX)=0.0 + WGNODP(K,NB,NZ,NY,NX)=0.0 + HTNODX(K,NB,NZ,NY,NX)=0.0 + ENDIF +1650 CONTINUE +C +C RESIDUAL STALK +C + IF(WTSTXB(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + RCCK=RCSC*WTSTXB(NB,NZ,NY,NX) + RCZK=WTSTXN(NB,NZ,NY,NX)*(RCSN+(1.0-RCSN)*RCSC) + RCPK=WTSTXP(NB,NZ,NY,NX)*(RCSP+(1.0-RCSP)*RCSC) +C +C FRACTION OF RESIDUAL STALK TO BE REMOBILIZED +C + IF(RCCK.GT.ZEROP(NZ,NY,NX))THEN + FSNCR=AMAX1(0.0,AMIN1(1.0,SNCT/RCCK)) + ELSE + FSNCR=1.0 + ENDIF +C +C NON-REMOBILIZABLE C,N,P BECOMES LITTERFALL ALLOCATED +C TO FRACTIONS SET IN 'STARTQ' +C + DO 8310 M=1,4 + CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX)+CFOPC(3,M,NZ,NY,NX) + 2*FSNCR*(WTSTXB(NB,NZ,NY,NX)-RCCK) + ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX)+CFOPN(3,M,NZ,NY,NX) + 2*FSNCR*(WTSTXN(NB,NZ,NY,NX)-RCZK) + PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX)+CFOPP(3,M,NZ,NY,NX) + 2*FSNCR*(WTSTXP(NB,NZ,NY,NX)-RCPK) +8310 CONTINUE +C +C UPDATE STATE VARIABLES FOR REMOBILIZATION AND LITTERFALL +C + WTSTKB(NB,NZ,NY,NX)=AMAX1(0.0,WTSTKB(NB,NZ,NY,NX) + 2-FSNCR*WTSTXB(NB,NZ,NY,NX)) + WTSTBN(NB,NZ,NY,NX)=AMAX1(0.0,WTSTBN(NB,NZ,NY,NX) + 2-FSNCR*WTSTXN(NB,NZ,NY,NX)) + WTSTBP(NB,NZ,NY,NX)=AMAX1(0.0,WTSTBP(NB,NZ,NY,NX) + 2-FSNCR*WTSTXP(NB,NZ,NY,NX)) + WTSTXB(NB,NZ,NY,NX)=AMAX1(0.0,WTSTXB(NB,NZ,NY,NX) + 2-FSNCR*WTSTXB(NB,NZ,NY,NX)) + WTSTXN(NB,NZ,NY,NX)=AMAX1(0.0,WTSTXN(NB,NZ,NY,NX) + 2-FSNCR*WTSTXN(NB,NZ,NY,NX)) + WTSTXP(NB,NZ,NY,NX)=AMAX1(0.0,WTSTXP(NB,NZ,NY,NX) + 2-FSNCR*WTSTXP(NB,NZ,NY,NX)) + HTNODZ=0.0 + DO 8320 K=0,25 + HTNODZ=AMAX1(HTNODZ,HTNODE(K,NB,NZ,NY,NX)) +8320 CONTINUE + HTNODZ=AMAX1(0.0,HTNODZ-FSNCR*HTNODZ) + DO 8325 K=0,25 + HTNODE(K,NB,NZ,NY,NX)=AMIN1(HTNODZ,HTNODE(K,NB,NZ,NY,NX)) +8325 CONTINUE +C +C FRACTION OF C REMOBILIZED FOR GROWTH RESPIRATION < 0 IS +C RESPIRED AND NOT TRANSFERRED TO NON-STRUCTURAL POOLS +C + WTRSVB(NB,NZ,NY,NX)=WTRSVB(NB,NZ,NY,NX)+FSNCR*RCCK*SNCF + WTRSBN(NB,NZ,NY,NX)=WTRSBN(NB,NZ,NY,NX)+FSNCR*RCZK + WTRSBP(NB,NZ,NY,NX)=WTRSBP(NB,NZ,NY,NX)+FSNCR*RCPK + SNCT=SNCT-FSNCR*RCCK + ENDIF +C IF(NZ.EQ.1.OR.NZ.EQ.4)THEN +C WRITE(*,2357)'WTSTXB1',I,J,NZ,NB,K,FSNCR,SNCT +C 3,WTSTKB(NB,NZ,NY,NX),WTSTXB(NB,NZ,NY,NX) +C 4,(HTNODE(K,NB,NZ,NY,NX),K=0,25) +2357 FORMAT(A8,5I4,40E12.4) +C ENDIF +C +C EXIT LOOP IF REMOBILIZATION REQUIREMENT HAS BEEN MET +C + IF(SNCT.LE.ZEROP(NZ,NY,NX))GO TO 565 +C +C OTHERWISE REMAINING C,N,P IN NODE GOES TO LITTERFALL +C + ELSE + DO 8315 M=1,4 + CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX)+CFOPC(3,M,NZ,NY,NX) + 2*WTSTXB(NB,NZ,NY,NX) + ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX)+CFOPN(3,M,NZ,NY,NX) + 2*WTSTXN(NB,NZ,NY,NX) + PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX)+CFOPP(3,M,NZ,NY,NX) + 2*WTSTXP(NB,NZ,NY,NX) +8315 CONTINUE + WTSTKB(NB,NZ,NY,NX)=AMAX1(0.0,WTSTKB(NB,NZ,NY,NX) + 2-WTSTXB(NB,NZ,NY,NX)) + WTSTBN(NB,NZ,NY,NX)=AMAX1(0.0,WTSTBN(NB,NZ,NY,NX) + 2-WTSTXN(NB,NZ,NY,NX)) + WTSTBP(NB,NZ,NY,NX)=AMAX1(0.0,WTSTBP(NB,NZ,NY,NX) + 2-WTSTXP(NB,NZ,NY,NX)) + WTSTXB(NB,NZ,NY,NX)=0.0 + WTSTXN(NB,NZ,NY,NX)=0.0 + WTSTXP(NB,NZ,NY,NX)=0.0 + MXNOD=KVSTG(NB,NZ,NY,NX) + MNNOD=MAX(MIN(0,MAX(0,MXNOD-NNOD(NZ,NY,NX))) + 2,KVSTG(NB,NZ,NY,NX)-23) + MXNOD=MAX(MXNOD,MNNOD) + DO 1660 KK=MXNOD,MNNOD,-1 + K=MOD(KK,25) + IF(K.EQ.0.AND.KK.NE.0)K=25 + HTNODE(K,NB,NZ,NY,NX)=0.0 + HTNODX(K,NB,NZ,NY,NX)=0.0 +1660 CONTINUE +C IF(NZ.EQ.2)THEN +C WRITE(*,2357)'WTSTXB2',I,J,NZ,NB,FSNCR,SNCT +C 3,HTNODX(K,NB,NZ,NY,NX),WTSTKB(NB,NZ,NY,NX) +C 4,WTSTXB(NB,NZ,NY,NX),WTSTBN(NB,NZ,NY,NX),WTSTBP(NB,NZ,NY,NX) +C ENDIF + ENDIF +C +C REMOBILIZATION OF STORAGE C,N,P +C + SNCR=SNCT/(1.0+FXFS) + IF(WTRVC(NZ,NY,NX).GT.SNCR)THEN + WTRVC(NZ,NY,NX)=WTRVC(NZ,NY,NX)-SNCR + SNCR=0.0 + GO TO 565 + ELSE + IDTHB(NB,NZ,NY,NX)=1 + ENDIF +565 CONTINUE +575 CONTINUE + ENDIF +595 CONTINUE +C +C DEATH IF MAIN STALK OF TREE DIES +C + IF(IBTYP(NZ,NY,NX).NE.0.AND.IGTYP(NZ,NY,NX).GT.1 + 2.AND.IDTHB(NB1(NZ,NY,NX),NZ,NY,NX).EQ.1)IDTHB(NB,NZ,NY,NX)=1 +C +C REMOBILIZE EXCESS LEAF STRUCTURAL N,P +C + KVSTGX=MAX(0,KVSTG(NB,NZ,NY,NX)-24) + DO 495 KK=KVSTGX,KVSTG(NB,NZ,NY,NX) + K=MOD(KK,25) + IF(K.EQ.0.AND.KK.NE.0)K=25 + IF(WGLF(K,NB,NZ,NY,NX).GT.0.0)THEN + CPOOLT=WGLF(K,NB,NZ,NY,NX)+CPOOL(NB,NZ,NY,NX) + IF(CPOOLT.GT.ZEROP(NZ,NY,NX))THEN + ZPOOLD=WGLFN(K,NB,NZ,NY,NX)*CPOOL(NB,NZ,NY,NX) + 2-ZPOOL(NB,NZ,NY,NX)*WGLF(K,NB,NZ,NY,NX) + XFRN1=AMAX1(0.0,AMIN1(1.0E-03*ZPOOLD/CPOOLT,WGLFN(K,NB,NZ,NY,NX) + 2-ZPLFM*CNLFB*WGLF(K,NB,NZ,NY,NX))) + PPOOLD=WGLFP(K,NB,NZ,NY,NX)*CPOOL(NB,NZ,NY,NX) + 2-PPOOL(NB,NZ,NY,NX)*WGLF(K,NB,NZ,NY,NX) + XFRP1=AMAX1(0.0,AMIN1(1.0E-03*PPOOLD/CPOOLT,WGLFP(K,NB,NZ,NY,NX) + 2-ZPLFM*CPLFB*WGLF(K,NB,NZ,NY,NX))) + XFRN=AMAX1(XFRN1,10.0*XFRP1) + XFRP=AMAX1(XFRP1,0.10*XFRN1) + WGLFN(K,NB,NZ,NY,NX)=WGLFN(K,NB,NZ,NY,NX)-XFRN + WTLFBN(NB,NZ,NY,NX)=WTLFBN(NB,NZ,NY,NX)-XFRN + ZPOOL(NB,NZ,NY,NX)=ZPOOL(NB,NZ,NY,NX)+XFRN + WGLFP(K,NB,NZ,NY,NX)=WGLFP(K,NB,NZ,NY,NX)-XFRP + WTLFBP(NB,NZ,NY,NX)=WTLFBP(NB,NZ,NY,NX)-XFRP + PPOOL(NB,NZ,NY,NX)=PPOOL(NB,NZ,NY,NX)+XFRP + WSLF(K,NB,NZ,NY,NX)=AMAX1(0.0,WSLF(K,NB,NZ,NY,NX) + 2-AMAX1(XFRN*CNWS(NZ,NY,NX),XFRP*CPWS(NZ,NY,NX))) + ENDIF + ENDIF +495 CONTINUE +C +C ALLOCATION OF LEAF AREA TO CANOPY LAYERS +C + KVSTGN(NB,NZ,NY,NX)=0 + IF(HTCTL(NZ,NY,NX).LE.SDPTH(NZ,NY,NX) + 2.AND.ARLF(0,NB1(NZ,NY,NX),NZ,NY,NX).GT.0.0)THEN + XLGLF=SQRT(1.0E+02*ARLF(0,NB1(NZ,NY,NX),NZ,NY,NX) + 2/PP(NZ,NY,NX)) + HTCTL(NZ,NY,NX)=XLGLF+HTSHE(0,NB1(NZ,NY,NX),NZ,NY,NX) + 2+HTNODE(0,NB1(NZ,NY,NX),NZ,NY,NX) + ENDIF +C +C IF CANOPY HAS EMERGED +C + IF(HTCTL(NZ,NY,NX).GT.SDPTH(NZ,NY,NX))THEN + DO 540 K=0,25 + DO 540 L=1,JC + ARLFL(L,K,NB,NZ,NY,NX)=0.0 + WGLFL(L,K,NB,NZ,NY,NX)=0.0 + WGLFLN(L,K,NB,NZ,NY,NX)=0.0 + WGLFLP(L,K,NB,NZ,NY,NX)=0.0 +540 CONTINUE + DO 535 L=1,JC + ARSTK(L,NB,NZ,NY,NX)=0.0 +535 CONTINUE +C +C BRANCH HEIGHT +C + IF(IBTYP(NZ,NY,NX).NE.0.AND.IGTYP(NZ,NY,NX).GT.1)THEN + IF(NB.NE.NB1(NZ,NY,NX))THEN + KVSTG1=MAX(1,KVSTG(NB1(NZ,NY,NX),NZ,NY,NX)-24) + IF(NBTB(NB,NZ,NY,NX).GE.KVSTG1)THEN + K=MOD(NBTB(NB,NZ,NY,NX),25) + IF(K.EQ.0.AND.KK.NE.0)K=25 + HTBR=HTNODE(K,NB1(NZ,NY,NX),NZ,NY,NX) + ELSE + HTBR=0.0 + ENDIF + ELSE + HTBR=0.0 + ENDIF + ELSE + HTBR=0.0 + ENDIF + KVSTGX=MAX(0,KVSTG(NB,NZ,NY,NX)-24) +C +C FOR ALL LEAFED NODES +C + DO 560 KK=KVSTGX,KVSTG(NB,NZ,NY,NX) + K=MOD(KK,25) + IF(K.EQ.0.AND.KK.NE.0)K=25 +C +C HEIGHT OF STALK INTERNODE + SHEATH OR PETIOLE +C AND LENGTH OF LEAF +C + HTSTK=HTBR+HTNODE(K,NB,NZ,NY,NX) + HTLF=HTSTK+HTSHE(K,NB,NZ,NY,NX) + XLGLF=AMAX1(0.0,SQRT(WDLF(NZ,NY,NX)*AMAX1(0.0 + 2,ARLF(K,NB,NZ,NY,NX))/(PP(NZ,NY,NX)*FNOD(NZ,NY,NX)))) + TLGLF=0.0 +C +C ALLOCATE FRACTIONS OF LEAF IN EACH INCLINATION CLASS +C FROM HIGHEST TO LOWEST TO CANOPY LAYER +C + DO 555 N=4,1,-1 + YLGLF=ZSIN(N)*CLASS(N,NZ,NY,NX)*XLGLF + HTLFL=AMIN1(ZCX(NZ,NY,NX)+0.01-YLGLF,HTLF+TLGLF) + HTLFU=AMIN1(ZCX(NZ,NY,NX)+0.01,HTLFL+YLGLF) + LU=0 + LL=0 + DO 550 L=JC,1,-1 + IF(LU.EQ.1.AND.LL.EQ.1)GO TO 551 + IF((HTLFU.GT.ZL(L-1,NY,NX).OR.ZL(L-1,NY,NX).LT.ZERO) + 2.AND.LU.EQ.0)THEN + LHTLFU=MAX(1,L) + LU=1 + ENDIF + IF((HTLFL.GT.ZL(L-1,NY,NX).OR.ZL(L-1,NY,NX).LT.ZERO) + 2.AND.LL.EQ.0)THEN + LHTLFL=MAX(1,L) + LL=1 + ENDIF +550 CONTINUE +551 CONTINUE + DO 570 L=LHTLFL,LHTLFU + IF(LHTLFU.EQ.LHTLFL)THEN + FRACL=CLASS(N,NZ,NY,NX) + ELSEIF(HTLFU.GT.HTLFL.AND.ZL(L,NY,NX).GT.HTLFL)THEN + FRACL=CLASS(N,NZ,NY,NX)*(AMIN1(HTLFU,ZL(L,NY,NX)) + 2-AMAX1(HTLFL,ZL(L-1,NY,NX)))/(HTLFU-HTLFL) + ELSE + FRACL=CLASS(N,NZ,NY,NX) + ENDIF + YARLF=FRACL*ARLF(K,NB,NZ,NY,NX) + YWGLF=FRACL*WGLF(K,NB,NZ,NY,NX) + YWGLFN=FRACL*WGLFN(K,NB,NZ,NY,NX) + YWGLFP=FRACL*WGLFP(K,NB,NZ,NY,NX) +C +C ACCUMULATE LAYER LEAF AREAS, C, N AND P CONTENTS +C + ARLFL(L,K,NB,NZ,NY,NX)=ARLFL(L,K,NB,NZ,NY,NX)+YARLF + WGLFL(L,K,NB,NZ,NY,NX)=WGLFL(L,K,NB,NZ,NY,NX)+YWGLF + WGLFLN(L,K,NB,NZ,NY,NX)=WGLFLN(L,K,NB,NZ,NY,NX)+YWGLFN + WGLFLP(L,K,NB,NZ,NY,NX)=WGLFLP(L,K,NB,NZ,NY,NX)+YWGLFP + ARLFV(L,NZ,NY,NX)=ARLFV(L,NZ,NY,NX)+YARLF + WGLFV(L,NZ,NY,NX)=WGLFV(L,NZ,NY,NX)+YWGLF +C IF(J.EQ.12)THEN +C WRITE(*,4813)'GRO',I,J,NZ,NB,K,KK,L,LHTLFL,LHTLFU +C 2,FRACL,HTLFU,HTLFL,ZL(L-1,NY,NX),ARLFB(NB,NZ,NY,NX) +C 3,ARLF(K,NB,NZ,NY,NX),WTLFB(NB,NZ,NY,NX),WGLF(K,NB,NZ,NY,NX) +C 4,ARLFP(NZ,NY,NX),ZL(L,NY,NX),HTLF,TLGLF,HTSTK,HTBR +C 4,HTNODE(K,NB,NZ,NY,NX),HTSHE(K,NB,NZ,NY,NX),YLGLF +C 5,ZSIN(N),CLASS(N,NZ,NY,NX),XLGLF,ZC(NZ,NY,NX) +C 6,ZCX(NZ,NY,NX) +4813 FORMAT(A8,9I4,30E12.4) +C ENDIF +570 CONTINUE + TLGLF=TLGLF+YLGLF + ZC(NZ,NY,NX)=AMAX1(ZC(NZ,NY,NX),HTLFU) +555 CONTINUE + IF(WSSHE(K,NB,NZ,NY,NX).GT.0.0)THEN + IF(KVSTGN(NB,NZ,NY,NX).EQ.0)KVSTGN(NB,NZ,NY,NX) + 2=MIN(KK,KVSTG(NB,NZ,NY,NX)) + ENDIF +560 CONTINUE + IF(KVSTGN(NB,NZ,NY,NX).EQ.0)KVSTGN(NB,NZ,NY,NX) + 2=KVSTG(NB,NZ,NY,NX) + K1=MOD(KVSTG(NB,NZ,NY,NX),25) + IF(K1.EQ.0.AND.KVSTG(NB,NZ,NY,NX).NE.0)K1=25 + K2=MOD(KVSTG(NB,NZ,NY,NX)-1,25) + IF(K2.EQ.0.AND.KVSTG(NB,NZ,NY,NX)-1.NE.0)K2=25 + IF(HTNODE(K1,NB,NZ,NY,NX).EQ.0.0)THEN + HTNODE(K1,NB,NZ,NY,NX)=HTNODE(K2,NB,NZ,NY,NX) + ENDIF + HTLFB=HTBR + 2+AMAX1(0.0,HTNODE(K1,NB,NZ,NY,NX)) +C +C ALLOCATE STALK SURFACE AREA TO CANOPY LAYERS +C +C IF(NZ.EQ.1)THEN +C WRITE(*,6679)'K1',I,J,NZ,NB,K1,KVSTG(NB,NZ,NY,NX) +C 2,HTNODE(K1,NB,NZ,NY,NX) +6679 FORMAT(A8,6I4,12E12.4) +C ENDIF + IF(HTNODE(K1,NB,NZ,NY,NX).GT.0.0)THEN + LU=0 + LL=0 + DO 545 L=JC,1,-1 + IF(LU.EQ.1.AND.LL.EQ.1)GO TO 546 + IF((HTLFB.GT.ZL(L-1,NY,NX).OR.ZL(L-1,NY,NX).LT.ZERO) + 2.AND.LU.EQ.0)THEN + LHTBRU=MAX(1,L) + LU=1 + ENDIF + IF((HTBR.GT.ZL(L-1,NY,NX).OR.ZL(L-1,NY,NX) + 2.LT.ZERO).AND.LL.EQ.0)THEN + LHTBRL=MAX(1,L) + LL=1 + ENDIF +545 CONTINUE +546 CONTINUE + RSTK=SQRT(VSTK*(AMAX1(0.0,WTSTKB(NB,NZ,NY,NX))/PP(NZ,NY,NX)) + 3/(3.1416*HTNODE(K1,NB,NZ,NY,NX))) + ARSTKB(NB)=3.1416*HTNODE(K1,NB,NZ,NY,NX)*PP(NZ,NY,NX)*RSTK + IF(ISTYP(NZ,NY,NX).EQ.0)THEN + WVSTKB(NB,NZ,NY,NX)=WTSTKB(NB,NZ,NY,NX) + ELSE + ZSTK=AMIN1(ZSTX,FSTK*RSTK) + ASTV=3.1416*(2.0*RSTK*ZSTK-ZSTK**2) + WVSTKB(NB,NZ,NY,NX)=ASTV/VSTK*HTNODE(K1,NB,NZ,NY,NX)*PP(NZ,NY,NX) + ENDIF +C IF(NZ.EQ.1)THEN +C WRITE(*,6677)'WVSTK',I,J,NZ,NB,WVSTKB(NB,NZ,NY,NX) +C 2,ASTV,VSTK,HTNODE(K1,NB,NZ,NY,NX),PP(NZ,NY,NX) +6677 FORMAT(A8,4I4,12E12.4) +C ENDIF + DO 445 L=LHTBRL,LHTBRU + IF(HTLFB.GT.HTBR)THEN + IF(HTLFB.GT.ZL(L-1,NY,NX))THEN + FRACL=(AMIN1(HTLFB,ZL(L,NY,NX))-AMAX1(HTBR + 2,ZL(L-1,NY,NX)))/(HTLFB-HTBR) + ELSE + FRACL=0.0 + ENDIF + ELSE + FRACL=1.0 + ENDIF + ARSTK(L,NB,NZ,NY,NX)=FRACL*ARSTKB(NB) +445 CONTINUE + ELSE + WVSTKB(NB,NZ,NY,NX)=0.0 + DO 450 L=1,JC + ARSTK(L,NB,NZ,NY,NX)=0.0 +450 CONTINUE + ENDIF + ELSE + WVSTKB(NB,NZ,NY,NX)=0.0 + DO 455 L=1,JC + ARSTK(L,NB,NZ,NY,NX)=0.0 +455 CONTINUE + ENDIF +C +C ALLOCATE LEAF AREA TO INCLINATION CLASSES ACCORDING TO +C DISTRIBUTION ENTERED IN 'READQ' ASSUMING AZIMUTH IS UNIFORM +C + IF(SSINN(NY,NX).GT.0.0)THEN + DO 900 K=1,25 + DO 900 L=1,JC + DO 900 N=1,4 + SURF(N,L,K,NB,NZ,NY,NX)=0.0 +900 CONTINUE +C ARLFXB=0.0 +C ARLFXL=0.0 +C SURFXX=0.0 + DO 500 K=1,25 +C ARLFXB=ARLFXB+ARLF(K,NB,NZ,NY,NX) + IF(ARLF(K,NB,NZ,NY,NX).GT.0.0 + 2.AND.ZC(NZ,NY,NX).GT.DPTHS(NY,NX))THEN + DO 700 L=JC,1,-1 +C ARLFXL=ARLFXL+ARLFL(L,K,NB,NZ,NY,NX) + DO 800 N=1,4 + SURF(N,L,K,NB,NZ,NY,NX)=AMAX1(0.0,CLASS(N,NZ,NY,NX) + 2*0.25*ARLFL(L,K,NB,NZ,NY,NX)) +C SURFXX=SURFXX+SURF(N,L,K,NB,NZ,NY,NX) +C IF(I.EQ.151.AND.(NZ.EQ.1.OR.NZ.EQ.4))THEN +C WRITE(*,6363)'SURF',I,J,NX,NY,NZ,NB,K,L,N +C 2,ARLFL(L,K,NB,NZ,NY,NX) +C 2,SURF(N,L,K,NB,NZ,NY,NX),CLASS(N,NZ,NY,NX),ARLF(K,NB,NZ,NY,NX) +C 3,DPTHS(NY,NX),ARLFXB,ARLFXL,SURFXX,ARLF(0,NB,NZ,NY,NX) +C 4,ARLFB(NB,NZ,NY,NX) +6363 FORMAT(A8,9I4,12E16.8) +C ENDIF +800 CONTINUE +700 CONTINUE + ENDIF +500 CONTINUE +C +C ALLOCATE STALK AREA TO INCLINATION CLASSES ACCORDING TO +C BRANCH ANGLE ENTERED IN 'READQ' ASSUMING AZIMUTH IS UNIFORM +C + DO 910 L=1,JC + DO 910 N=1,4 + SURFB(N,L,NB,NZ,NY,NX)=0.0 +910 CONTINUE + IF(NB.EQ.NB1(NZ,NY,NX))THEN + N=4 + ELSE + N=MIN(4,INT(ASIN(ANGBR(NZ,NY,NX))/0.3927)+1) + ENDIF + DO 710 L=JC,1,-1 + SURFB(N,L,NB,NZ,NY,NX)=0.25*ARSTK(L,NB,NZ,NY,NX) +710 CONTINUE + ENDIF +C +C SET MAXIMUM GRAIN NUMBER FROM SHOOT MASS BEFORE ANTHESIS +C + IF(IDAY(3,NB,NZ,NY,NX).NE.0.AND.IDAY(6,NB,NZ,NY,NX).EQ.0)THEN + GRNXB(NB,NZ,NY,NX)=GRNXB(NB,NZ,NY,NX) + 2+STMX(NZ,NY,NX)*AMAX1(0.0,GROSTK) +C WRITE(*,4246)'GRNX',I,J,NZ,NB,IDAY(3,NB,NZ,NY,NX) +C 2,GRNXB(NB,NZ,NY,NX),STMX(NZ,NY,NX),CGROS,GROSTK + ENDIF +C +C SET FINAL GRAIN NUMBER AND MAXIMUM GRAIN SIZE FROM C,N,P +C NON-STRUCTURAL POOLS AFTER ANTHESIS +C + IF(IDAY(6,NB,NZ,NY,NX).NE.0.AND.IDAY(9,NB,NZ,NY,NX).EQ.0)THEN + SET=AMIN1(CCPOLB(NB,NZ,NY,NX)/(CCPOLB(NB,NZ,NY,NX)+SETC) + 2,CZPOLB(NB,NZ,NY,NX)/(CZPOLB(NB,NZ,NY,NX)+SETN) + 3,CPPOLB(NB,NZ,NY,NX)/(CPPOLB(NB,NZ,NY,NX)+SETP)) + IF(TCC(NZ,NY,NX).LT.CTC(NZ,NY,NX))THEN + IF(IDAY(7,NB,NZ,NY,NX).EQ.0)THEN + FGRNX=0.002*(CTC(NZ,NY,NX)-TCC(NZ,NY,NX)) + ELSEIF(IDAY(8,NB,NZ,NY,NX).EQ.0)THEN + FGRNX=0.002*(CTC(NZ,NY,NX)-TCC(NZ,NY,NX)) + ELSE + FGRNX=0.0 + ENDIF + ELSEIF(TCC(NZ,NY,NX).GT.HTC(NZ,NY,NX))THEN + IF(IDAY(7,NB,NZ,NY,NX).EQ.0)THEN + FGRNX=0.002*(TCC(NZ,NY,NX)-HTC(NZ,NY,NX)) + ELSEIF(IDAY(8,NB,NZ,NY,NX).EQ.0)THEN + FGRNX=0.002*(TCC(NZ,NY,NX)-HTC(NZ,NY,NX)) + ELSE + FGRNX=0.0 + ENDIF + ELSE + FGRNX=0.0 + ENDIF + IF(IDAY(6,NB,NZ,NY,NX).NE.0.AND.IDAY(8,NB,NZ,NY,NX).EQ.0)THEN +C GRNXB(NB,NZ,NY,NX)=GRNXB(NB,NZ,NY,NX)*FGRNX + GRNOB(NB,NZ,NY,NX)=AMIN1(SDMX(NZ,NY,NX)*GRNXB(NB,NZ,NY,NX) + 2,GRNOB(NB,NZ,NY,NX)+SDMX(NZ,NY,NX)*GRNXB(NB,NZ,NY,NX) + 3*SET*DGSTGF(NB,NZ,NY,NX)-FGRNX*GRNOB(NB,NZ,NY,NX)) +C IF(FGRNX.LT.1.0)THEN +C WRITE(*,4246)'GRNO',I,J,NZ,NB,IDAY(7,NB,NZ,NY,NX),TCC(NZ,NY,NX) +C 2,HTC(NZ,NY,NX),FGRNX,GRNXB(NB,NZ,NY,NX),GRNOB(NB,NZ,NY,NX) +C 3,SET,CCPOLB(NB,NZ,NY,NX),CZPOLB(NB,NZ,NY,NX) +C 4,CPPOLB(NB,NZ,NY,NX) +4246 FORMAT(A8,5I4,20E12.4) +C ENDIF + ENDIF + IF(IDAY(7,NB,NZ,NY,NX).NE.0.AND.IDAY(9,NB,NZ,NY,NX).EQ.0)THEN + GRMXB=GRMX(NZ,NY,NX)*SQRT(1.0-FGRNX) + GRWTB(NB,NZ,NY,NX)=AMIN1(GRMX(NZ,NY,NX),GRWTB(NB,NZ,NY,NX) + 2+GRMXB*AMAX1(0.50,SQRT(SET))*DGSTGF(NB,NZ,NY,NX)) +C IF(FGRNX.LT.1.0)THEN +C WRITE(*,4246)'GRWT',I,J,NZ,NB,IDAY(8,NB,NZ,NY,NX),TCC(NZ,NY,NX) +C 2,HTC(NZ,NY,NX),FGRNX,GRMX(NZ,NY,NX),GRWTB(NB,NZ,NY,NX) +C ENDIF + ENDIF + ENDIF +C +C GRAIN FILL BY TRANSLOCATION FROM STALK RESERVES +C UNTIL GRAIN SINK (=FINAL GRAIN NUMBER X MAXIMUM +C GRAIN SIZE) IS FILLED OR RESERVES ARE EXHAUSTED +C + IF(IDAY(7,NB,NZ,NY,NX).NE.0)THEN + IF(WTGRB(NB,NZ,NY,NX).GE.GRWTB(NB,NZ,NY,NX) + 2*GRNOB(NB,NZ,NY,NX))THEN + GROLM=0.0 + ELSEIF(IRTYP(NZ,NY,NX).EQ.0)THEN + GROLM=AMAX1(0.0,GFILL(NZ,NY,NX)*GRNOB(NB,NZ,NY,NX) + 2*SQRT(TFN3(NZ,NY,NX))) + ELSE + GROLM=AMAX1(0.0,GFILL(NZ,NY,NX)*GRNOB(NB,NZ,NY,NX) + 2*SQRT(TFN4(NG(NZ,NY,NX),NZ,NY,NX))) + ENDIF +C +C GRAIN FILL RATE MAY BE CONSTRAINED BY HIGH GRAIN C:N OR C:P +C + IF(WTGRBN(NB,NZ,NY,NX).LT.ZPGRM*CNGR(NZ,NY,NX) + 2*WTGRB(NB,NZ,NY,NX).OR.WTGRBP(NB,NZ,NY,NX).LT.ZPGRM + 3*CPGR(NZ,NY,NX)*WTGRB(NB,NZ,NY,NX))THEN + GROLC=0.0 + ELSE + GROLC=GROLM + ENDIF + XLOCM=AMIN1(GROLM,WTRSVB(NB,NZ,NY,NX)) + XLOCC=AMIN1(GROLC,WTRSVB(NB,NZ,NY,NX)) +C +C GRAIN N OR P FILL RATE MAY BE LIMITED BY C:N OR C:P RATIOS +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) + 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)) + XLOCN=AMIN1(XLOCM*CNGR(NZ,NY,NX) + 2,AMAX1(0.0,WTRSBN(NB,NZ,NY,NX)*ZPGRX) + 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) + 3,(WTGRB(NB,NZ,NY,NX)+XLOCC)*CPGR(NZ,NY,NX)-WTGRBP(NB,NZ,NY,NX)) + ELSE + XLOCN=0.0 + XLOCP=0.0 + ENDIF +C IF(NX.EQ.1.AND.NY.EQ.6.AND.NZ.EQ.3)THEN +C WRITE(*,85)'XLOC',I,J,NZ,NB,WTGRB(NB,NZ,NY,NX),WTGRBN(NB,NZ,NY,NX) +C 2,WTRSVB(NB,NZ,NY,NX),WTRSBN(NB,NZ,NY,NX),XLOCC,XLOCN,XLOCP,XLOCM +C 3,CNGR(NZ,NY,NX),ZPGRX,ZNPG,GROLC,GROLM,GROGR,GROGRN +C 3,XLOCM*CNGR(NZ,NY,NX),AMAX1(0.0,WTRSBN(NB,NZ,NY,NX)*ZPGRX) +C 4,(WTGRB(NB,NZ,NY,NX)+XLOCC)*CNGR(NZ,NY,NX)-WTGRBN(NB,NZ,NY,NX) +C 4,GRNOB(NB,NZ,NY,NX),GRWTB(NB,NZ,NY,NX),GFILL(NZ,NY,NX) +C 5,SQRT(TFN3(NZ,NY,NX)),FLG4(NB,NZ,NY,NX) +85 FORMAT(A8,4I4,20E12.4) +C ENDIF +C +C TRANSLOCATE C,N,P FROM STALK RESERVES TO GRAIN +C + WTRSVB(NB,NZ,NY,NX)=WTRSVB(NB,NZ,NY,NX)+GROGR-XLOCC + WTRSBN(NB,NZ,NY,NX)=WTRSBN(NB,NZ,NY,NX)+GROGRN-XLOCN + WTRSBP(NB,NZ,NY,NX)=WTRSBP(NB,NZ,NY,NX)+GROGRP-XLOCP + WTGRB(NB,NZ,NY,NX)=WTGRB(NB,NZ,NY,NX)+XLOCC + WTGRBN(NB,NZ,NY,NX)=WTGRBN(NB,NZ,NY,NX)+XLOCN + WTGRBP(NB,NZ,NY,NX)=WTGRBP(NB,NZ,NY,NX)+XLOCP + ELSE + XLOCC=0.0 + XLOCN=0.0 + XLOCP=0.0 + ENDIF +C +C SET DATE OF PHYSIOLOGICAL MATURITY WHEN GRAIN FILL +C HAS STOPPED FOR SET PERIOD OF TIME +C + IF(IDAY(8,NB,NZ,NY,NX).NE.0)THEN + IF(XLOCC.LE.1.0E-09*PP(NZ,NY,NX))THEN + FLG4(NB,NZ,NY,NX)=FLG4(NB,NZ,NY,NX)+1.0 + ELSE + FLG4(NB,NZ,NY,NX)=0.0 + ENDIF + IF(FLG4(NB,NZ,NY,NX).GE.FLG4X)THEN + IF(IDAY(10,NB,NZ,NY,NX).EQ.0)THEN + IDAY(10,NB,NZ,NY,NX)=I + ENDIF + ENDIF +C +C TERMINATE ANNUALS AFTER GRAIN FILL +C + IF(ISTYP(NZ,NY,NX).EQ.0.AND.IWTYP(NZ,NY,NX).NE.0)THEN + IF(FLG4(NB,NZ,NY,NX).GT.FLG4Y(IWTYP(NZ,NY,NX)))THEN + VRNF(NB,NZ,NY,NX)=VRNX(NB,NZ,NY,NX)+0.5 + ENDIF + ENDIF + ENDIF +C +C RESET PHENOLOGY AT EMERGENCE ('VRNS' > 'VRNL') +C AND END OF SEASON ('VRNF' > 'VRNX') +C + IF(ISTYP(NZ,NY,NX).NE.0 + 2.OR.(ISTYP(NZ,NY,NX).EQ.0.AND.IWTYP(NZ,NY,NX).NE.0))THEN + IF((IFLGE(NB,NZ,NY,NX).EQ.0 + 2.AND.VRNS(NB,NZ,NY,NX).GE.VRNL(NB,NZ,NY,NX)) + 3.OR.(IFLGF(NB,NZ,NY,NX).EQ.0 + 4.AND.VRNF(NB,NZ,NY,NX).GE.VRNX(NB,NZ,NY,NX)))THEN +C +C SPRING PHENOLOGY RESET +C + IF((IFLGE(NB,NZ,NY,NX).EQ.0.AND.ISTYP(NZ,NY,NX).NE.0) + 2.AND.(VRNS(NB,NZ,NY,NX).GE.VRNL(NB,NZ,NY,NX)))THEN + IF(ISTYP(NZ,NY,NX).EQ.0)THEN + GROUP(NB,NZ,NY,NX)=AMAX1(0.0,GROUPI(NZ,NY,NX) + 2-NBTB(NB,NZ,NY,NX)) + ELSE + GROUP(NB,NZ,NY,NX)=GROUPI(NZ,NY,NX) + ENDIF + PSTGI(NB,NZ,NY,NX)=PSTG(NB,NZ,NY,NX) + PSTGF(NB,NZ,NY,NX)=0.0 + VSTGX(NB,NZ,NY,NX)=0.0 + TGSTGI(NB,NZ,NY,NX)=0.0 + TGSTGF(NB,NZ,NY,NX)=0.0 + IDAY(1,NB,NZ,NY,NX)=I + DO 2005 M=2,10 + IDAY(M,NB,NZ,NY,NX)=0 +2005 CONTINUE + IF(NB.EQ.NB1(NZ,NY,NX))THEN + WSTR(NZ,NY,NX)=0.0 + ENDIF +C +C SPRING LEAF AND SHEATH RESET +C + IF(IFLGE(NB,NZ,NY,NX).EQ.0.AND.ISTYP(NZ,NY,NX).NE.0 + 2.AND.VRNS(NB,NZ,NY,NX).GE.VRNL(NB,NZ,NY,NX))THEN + IF(IBTYP(NZ,NY,NX).EQ.0)THEN + PSTG(NB,NZ,NY,NX)=XTLI(NZ,NY,NX) + VSTG(NB,NZ,NY,NX)=0.0 + KLEAF(NB,NZ,NY,NX)=1 + KVSTG(NB,NZ,NY,NX)=1 + FLG4(NB,NZ,NY,NX)=0.0 + DO 5330 M=1,4 + CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX) + 2+CFOPC(5,M,NZ,NY,NX)*WTLFB(NB,NZ,NY,NX)*FWODB(0) + 3+CFOPC(5,M,NZ,NY,NX)*WTSHEB(NB,NZ,NY,NX)*FWODB(0) + ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX) + 2+CFOPN(5,M,NZ,NY,NX)*WTLFBN(NB,NZ,NY,NX)*FWODLN(0) + 3+CFOPN(5,M,NZ,NY,NX)*WTSHBN(NB,NZ,NY,NX)*FWODSN(0) + PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX) + 2+CFOPP(5,M,NZ,NY,NX)*WTLFBP(NB,NZ,NY,NX)*FWODLP(0) + 3+CFOPP(5,M,NZ,NY,NX)*WTSHBP(NB,NZ,NY,NX)*FWODSP(0) + CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) + 2+CFOPC(1,M,NZ,NY,NX)*WTLFB(NB,NZ,NY,NX)*FWODB(1) + 3+CFOPC(2,M,NZ,NY,NX)*WTSHEB(NB,NZ,NY,NX)*FWODB(1) + ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) + 2+CFOPN(1,M,NZ,NY,NX)*WTLFBN(NB,NZ,NY,NX)*FWODLN(1) + 3+CFOPN(2,M,NZ,NY,NX)*WTSHBN(NB,NZ,NY,NX)*FWODSN(1) + PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) + 2+CFOPP(1,M,NZ,NY,NX)*WTLFBP(NB,NZ,NY,NX)*FWODLP(1) + 3+CFOPP(2,M,NZ,NY,NX)*WTSHBP(NB,NZ,NY,NX)*FWODSP(1) +5330 CONTINUE + ARLFB(NB,NZ,NY,NX)=0.0 + WTLFB(NB,NZ,NY,NX)=0.0 + WTLFBN(NB,NZ,NY,NX)=0.0 + WTLFBP(NB,NZ,NY,NX)=0.0 + WTSHEB(NB,NZ,NY,NX)=0.0 + WTSHBN(NB,NZ,NY,NX)=0.0 + WTSHBP(NB,NZ,NY,NX)=0.0 + DO 5335 K=0,25 + ARLF(K,NB,NZ,NY,NX)=0.0 + HTSHE(K,NB,NZ,NY,NX)=0.0 + WGLF(K,NB,NZ,NY,NX)=0.0 + WSLF(K,NB,NZ,NY,NX)=0.0 + WGLFN(K,NB,NZ,NY,NX)=0.0 + WGLFP(K,NB,NZ,NY,NX)=0.0 + WGSHE(K,NB,NZ,NY,NX)=0.0 + WSSHE(K,NB,NZ,NY,NX)=0.0 + WGSHN(K,NB,NZ,NY,NX)=0.0 + WGSHP(K,NB,NZ,NY,NX)=0.0 +5335 CONTINUE + ENDIF + ENDIF +C +C RESIDUAL STALKS BECOME LITTERFALL IN GRASSES, SHRUBS AT +C START OF SEASON +C + IF((IFLGE(NB,NZ,NY,NX).EQ.0.AND.ISTYP(NZ,NY,NX).NE.0) + 2.AND.VRNS(NB,NZ,NY,NX).GE.VRNL(NB,NZ,NY,NX))THEN + DO 6245 M=1,4 + CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX)+CFOPC(2,M,NZ,NY,NX) + 2*(WTHSKB(NB,NZ,NY,NX)+WTEARB(NB,NZ,NY,NX)+WTGRB(NB,NZ,NY,NX)) + ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX)+CFOPN(2,M,NZ,NY,NX) + 2*(WTHSBN(NB,NZ,NY,NX)+WTEABN(NB,NZ,NY,NX)+WTGRBN(NB,NZ,NY,NX)) + PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX)+CFOPP(2,M,NZ,NY,NX) + 2*(WTHSBP(NB,NZ,NY,NX)+WTEABP(NB,NZ,NY,NX)+WTGRBP(NB,NZ,NY,NX)) +6245 CONTINUE + WTHSKB(NB,NZ,NY,NX)=0.0 + WTEARB(NB,NZ,NY,NX)=0.0 + WTGRB(NB,NZ,NY,NX)=0.0 + WTHSBN(NB,NZ,NY,NX)=0.0 + WTEABN(NB,NZ,NY,NX)=0.0 + WTGRBN(NB,NZ,NY,NX)=0.0 + WTHSBP(NB,NZ,NY,NX)=0.0 + WTEABP(NB,NZ,NY,NX)=0.0 + WTGRBP(NB,NZ,NY,NX)=0.0 + GRNXB(NB,NZ,NY,NX)=0.0 + GRNOB(NB,NZ,NY,NX)=0.0 + GRWTB(NB,NZ,NY,NX)=0.0 + IF(IBTYP(NZ,NY,NX).EQ.0.OR.IGTYP(NZ,NY,NX).LE.1)THEN + DO 6345 M=1,4 + CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX)+CFOPC(3,M,NZ,NY,NX) + 2*WTSTKB(NB,NZ,NY,NX) + ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX)+CFOPN(3,M,NZ,NY,NX) + 2*WTSTBN(NB,NZ,NY,NX) + PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX)+CFOPP(3,M,NZ,NY,NX) + 2*WTSTBP(NB,NZ,NY,NX) +6345 CONTINUE + WTSTKB(NB,NZ,NY,NX)=0.0 + WTSTBN(NB,NZ,NY,NX)=0.0 + WTSTBP(NB,NZ,NY,NX)=0.0 + WTSTXB(NB,NZ,NY,NX)=0.0 + WTSTXN(NB,NZ,NY,NX)=0.0 + WTSTXP(NB,NZ,NY,NX)=0.0 + DO 6340 K=0,25 + HTNODE(K,NB,NZ,NY,NX)=0.0 + HTNODX(K,NB,NZ,NY,NX)=0.0 + WGNODE(K,NB,NZ,NY,NX)=0.0 + WGNODN(K,NB,NZ,NY,NX)=0.0 + WGNODP(K,NB,NZ,NY,NX)=0.0 +6340 CONTINUE + ENDIF + ENDIF + ENDIF +C +C SPRING OR FALL FLAG RESET +C + IF(IFLGE(NB,NZ,NY,NX).EQ.0 + 2.AND.VRNS(NB,NZ,NY,NX).GE.VRNL(NB,NZ,NY,NX))THEN + IFLGA(NB,NZ,NY,NX)=0 + IFLGE(NB,NZ,NY,NX)=1 + IFLGF(NB,NZ,NY,NX)=0 + IFLGR(NB,NZ,NY,NX)=0 + IFLGQ(NB,NZ,NY,NX)=0 + ELSE + IFLGE(NB,NZ,NY,NX)=0 + IFLGF(NB,NZ,NY,NX)=1 + IFLGR(NB,NZ,NY,NX)=1 + IFLGQ(NB,NZ,NY,NX)=0 + ENDIF + ENDIF + ENDIF +C +C REPRODUCTIVE MATERIAL BECOMES LITTERFALL AT END OF SEASON +C + IF(IFLGR(NB,NZ,NY,NX).EQ.1)THEN + IFLGQ(NB,NZ,NY,NX)=IFLGQ(NB,NZ,NY,NX)+1 + IF(IFLGQ(NB,NZ,NY,NX).EQ.IFLGQX)THEN + IFLGR(NB,NZ,NY,NX)=0 + IFLGQ(NB,NZ,NY,NX)=0 + ENDIF + DO 6330 M=1,4 + CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) + 2+FSNR*CFOPC(2,M,NZ,NY,NX) + 2*(WTHSKB(NB,NZ,NY,NX)+WTEARB(NB,NZ,NY,NX)) + ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) + 2+FSNR*CFOPN(2,M,NZ,NY,NX) + 2*(WTHSBN(NB,NZ,NY,NX)+WTEABN(NB,NZ,NY,NX)) + PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) + 2+FSNR*CFOPP(2,M,NZ,NY,NX) + 2*(WTHSBP(NB,NZ,NY,NX)+WTEABP(NB,NZ,NY,NX)) + IF(ISTYP(NZ,NY,NX).EQ.0.AND.IWTYP(NZ,NY,NX).NE.0)THEN + WTRVC(NZ,NY,NX)=WTRVC(NZ,NY,NX) + 2+FSNR*CFOPC(2,M,NZ,NY,NX)*WTGRB(NB,NZ,NY,NX) + WTRVN(NZ,NY,NX)=WTRVN(NZ,NY,NX) + 2+FSNR*CFOPN(2,M,NZ,NY,NX)*WTGRBN(NB,NZ,NY,NX) + WTRVP(NZ,NY,NX)=WTRVP(NZ,NY,NX) + 2+FSNR*CFOPP(2,M,NZ,NY,NX)*WTGRBP(NB,NZ,NY,NX) + ELSE + CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) + 2+FSNR*CFOPC(2,M,NZ,NY,NX)*WTGRB(NB,NZ,NY,NX) + ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) + 2+FSNR*CFOPN(2,M,NZ,NY,NX)*WTGRBN(NB,NZ,NY,NX) + PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) + 2+FSNR*CFOPP(2,M,NZ,NY,NX)*WTGRBP(NB,NZ,NY,NX) + ENDIF +6330 CONTINUE + WTHSKB(NB,NZ,NY,NX)=(1.0-FSNR)*WTHSKB(NB,NZ,NY,NX) + WTEARB(NB,NZ,NY,NX)=(1.0-FSNR)*WTEARB(NB,NZ,NY,NX) + WTGRB(NB,NZ,NY,NX)=(1.0-FSNR)*WTGRB(NB,NZ,NY,NX) + WTHSBN(NB,NZ,NY,NX)=(1.0-FSNR)*WTHSBN(NB,NZ,NY,NX) + WTEABN(NB,NZ,NY,NX)=(1.0-FSNR)*WTEABN(NB,NZ,NY,NX) + WTGRBN(NB,NZ,NY,NX)=(1.0-FSNR)*WTGRBN(NB,NZ,NY,NX) + WTHSBP(NB,NZ,NY,NX)=(1.0-FSNR)*WTHSBP(NB,NZ,NY,NX) + WTEABP(NB,NZ,NY,NX)=(1.0-FSNR)*WTEABP(NB,NZ,NY,NX) + WTGRBP(NB,NZ,NY,NX)=(1.0-FSNR)*WTGRBP(NB,NZ,NY,NX) + GRNXB(NB,NZ,NY,NX)=(1.0-FSNR)*GRNXB(NB,NZ,NY,NX) + GRNOB(NB,NZ,NY,NX)=(1.0-FSNR)*GRNOB(NB,NZ,NY,NX) + GRWTB(NB,NZ,NY,NX)=(1.0-FSNR)*GRWTB(NB,NZ,NY,NX) +C +C STALKS BECOME LITTERFALL IN GRASSES AT END OF SEASON +C + IF((IBTYP(NZ,NY,NX).EQ.0.OR.IGTYP(NZ,NY,NX).LE.1) + 2.AND.ISTYP(NZ,NY,NX).NE.0)THEN + DO 6335 M=1,4 + CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) + 2+FSNR*CFOPC(3,M,NZ,NY,NX)*WTSTKB(NB,NZ,NY,NX) + ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) + 2+FSNR*CFOPN(3,M,NZ,NY,NX)*WTSTBN(NB,NZ,NY,NX) + PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) + 2+FSNR*CFOPP(3,M,NZ,NY,NX)*WTSTBP(NB,NZ,NY,NX) +6335 CONTINUE + WTSTKB(NB,NZ,NY,NX)=(1.0-FSNR)*WTSTKB(NB,NZ,NY,NX) + WTSTBN(NB,NZ,NY,NX)=(1.0-FSNR)*WTSTBN(NB,NZ,NY,NX) + WTSTBP(NB,NZ,NY,NX)=(1.0-FSNR)*WTSTBP(NB,NZ,NY,NX) + WTSTXB(NB,NZ,NY,NX)=(1.0-FSNR)*WTSTXB(NB,NZ,NY,NX) + WTSTXN(NB,NZ,NY,NX)=(1.0-FSNR)*WTSTXN(NB,NZ,NY,NX) + WTSTXP(NB,NZ,NY,NX)=(1.0-FSNR)*WTSTXP(NB,NZ,NY,NX) + DO 2010 K=0,25 +C HTNODE(K,NB,NZ,NY,NX)=(1.0-FSNR)*HTNODE(K,NB,NZ,NY,NX) + HTNODX(K,NB,NZ,NY,NX)=(1.0-FSNR)*HTNODX(K,NB,NZ,NY,NX) + WGNODE(K,NB,NZ,NY,NX)=(1.0-FSNR)*WGNODE(K,NB,NZ,NY,NX) + WGNODN(K,NB,NZ,NY,NX)=(1.0-FSNR)*WGNODN(K,NB,NZ,NY,NX) + WGNODP(K,NB,NZ,NY,NX)=(1.0-FSNR)*WGNODP(K,NB,NZ,NY,NX) +2010 CONTINUE + ENDIF +C +C SELF-SEEDING ANNUALS IF COLD OR DROUGHT DECIDUOUS +C + IF(J.EQ.INT(ZNOON(NY,NX)))THEN + IF(NB.EQ.NB1(NZ,NY,NX))THEN + IF(ISTYP(NZ,NY,NX).EQ.0.AND.IWTYP(NZ,NY,NX).NE.0)THEN + IDAYH(NZ,NY,NX)=I + IYRH(NZ,NY,NX)=IYRC + IHVST(NZ,I,NY,NX)=1 + JHVST(NZ,I,NY,NX)=2 + HVST(NZ,I,NY,NX)=0.0 + THIN(NZ,I,NY,NX)=0.0 + EHVST(1,1,NZ,I,NY,NX)=1.0 + EHVST(1,2,NZ,I,NY,NX)=1.0 + EHVST(1,3,NZ,I,NY,NX)=1.0 + EHVST(1,4,NZ,I,NY,NX)=1.0 + EHVST(2,1,NZ,I,NY,NX)=0.0 + EHVST(2,2,NZ,I,NY,NX)=1.0 + EHVST(2,3,NZ,I,NY,NX)=0.0 + EHVST(2,4,NZ,I,NY,NX)=0.0 + IDAY0(NZ,NY,NX)=-1E+06 + IYR0(NZ,NY,NX)=-1E+06 + IFLGI(NZ,NY,NX)=1 +C WRITE(*,3366)'HVST',I,J,IYRC,IDAYH(NZ,NY,NX),IYRH(NZ,NY,NX) +C 2,IHVST(NZ,I,NY,NX),JHVST(NZ,I,NY,NX),IFLGI(NZ,NY,NX) +3366 FORMAT(A8,8I8) + ENDIF + ENDIF + ENDIF + ENDIF +C +C TRANSFER C,N,P FROM SEASONAL STORAGE TO SHOOT AND ROOT +C NON-STRUCTURAL C DURING SEED GERMINATION OR LEAFOUT +C +C IF(NZ.EQ.1)THEN +C WRITE(*,2322)'VRNS',I,J,NX,NY,NZ,NB,NB1(NZ,NY,NX),IFLGZ +C 2,ISTYP(NZ,NY,NX),IFLGI(NZ,NY,NX),IDAY0(NZ,NY,NX),IYR0(NZ,NY,NX) +C 3,VRNS(NB1(NZ,NY,NX),NZ,NY,NX),VRNL(NB,NZ,NY,NX) +C 3,VRNF(NB,NZ,NY,NX),VRNX(NB,NZ,NY,NX) +2322 FORMAT(A8,12I4,20E12.4) +C ENDIF + IF((ISTYP(NZ,NY,NX).EQ.0.AND.IFLGI(NZ,NY,NX).EQ.0) + 2.OR.(I.GE.IDAY0(NZ,NY,NX).AND.IYRC.EQ.IYR0(NZ,NY,NX)) + 2.OR.(VRNS(NB1(NZ,NY,NX),NZ,NY,NX).GE.VRNL(NB,NZ,NY,NX) + 3.AND.VRNF(NB,NZ,NY,NX).LT.FVRN*VRNX(NB,NZ,NY,NX)))THEN + WTRTM=0.0 + CPOOLM=0.0 + DO 4 L=NU(NY,NX),NI(NZ,NY,NX) + WTRTM=WTRTM+AMAX1(0.0,WTRTD(1,L,NZ,NY,NX)) + CPOOLM=CPOOLM+AMAX1(0.0,CPOOLR(1,L,NZ,NY,NX)) +4 CONTINUE +C +C RESET TIME COUNTER +C + IF(IFLGA(NB,NZ,NY,NX).EQ.0)THEN + ATRP(NB,NZ,NY,NX)=0.0 + IFLGA(NB,NZ,NY,NX)=1 + ENDIF +C +C INCREMENT TIME COUNTER +C + IF(NB.EQ.NB1(NZ,NY,NX))THEN + IF(IPTYP(NZ,NY,NX).EQ.2 + 2.AND.(IWTYP(NZ,NY,NX).EQ.1.OR.IWTYP(NZ,NY,NX).EQ.3))THEN + PPDX=AMAX1(0.0,XDL(NZ,NY,NX)-XPPD(NZ,NY,NX)-DYLN(NY,NX)) + ATRPPD=EXP(-0.0*PPDX) + ELSE + ATRPPD=1.0 + ENDIF + DATRP=ATRPPD*TFN3(NZ,NY,NX)*WFNSG/AMIN1(1.0,ZTYP(NZ,NY,NX)) + ATRP(NB,NZ,NY,NX)=ATRP(NB,NZ,NY,NX)+DATRP +C IF(NZ.EQ.1)THEN +C WRITE(*,2323)'ATRP',I,J,NX,NY,NZ,NB,ATRP(NB,NZ,NY,NX),DATRP +C 2,ATRPPD,TFN3(NZ,NY,NX),WFNSG,PPDX,XDL(NZ,NY,NX),XPPD(NZ,NY,NX) +C 3,DYLN(NY,NX),WTLFB(NB,NZ,NY,NX),ARLFB(NB,NZ,NY,NX),HTCTL(NZ,NY,NX) +2323 FORMAT(A8,6I4,20E12.4) +C ENDIF + IF(ATRP(NB,NZ,NY,NX).LE.ATRPX + 2.OR.(ISTYP(NZ,NY,NX).EQ.0.AND.IWTYP(NZ,NY,NX).EQ.0))THEN + IF(WTRVC(NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + CPOOLT=CPOOLM+CPOOL(NB,NZ,NY,NX) +C +C REMOBILIZE C FROM SEASONAL STORAGE AT FIRST-ORDER RATE +C MODIFIED BY SOIL TEMPERATURE AT SEED DEPTH +C + GFNX=VMXS(ISTYP(NZ,NY,NX))*DATRP + CH2OH=AMAX1(0.0,GFNX*WTRVC(NZ,NY,NX)) +C IF(NZ.EQ.1.OR.NZ.EQ.4)THEN +C WRITE(*,2123)'GERM0',I,J,NX,NY,NZ,NB,GFNX,CH2OH,WTRVC(NZ,NY,NX) +C 2,CPOOL(NB,NZ,NY,NX),CPOOLR(1,NG(NZ,NY,NX),NZ,NY,NX) +C 3,FXSH(ISTYP(NZ,NY,NX)),FXRT(ISTYP(NZ,NY,NX)) +2123 FORMAT(A8,6I4,20E12.4) +C ENDIF + WTRVC(NZ,NY,NX)=WTRVC(NZ,NY,NX)-CH2OH + CPOOL(NB,NZ,NY,NX)=CPOOL(NB,NZ,NY,NX) + 2+CH2OH*FXSH(ISTYP(NZ,NY,NX)) + IF(WTRTM.GT.ZEROP(NZ,NY,NX).AND.CPOOLM.GT.ZEROP(NZ,NY,NX))THEN + DO 50 L=NU(NY,NX),NI(NZ,NY,NX) + FXFC=AMAX1(0.0,WTRTD(1,L,NZ,NY,NX))/WTRTM + CPOOLR(1,L,NZ,NY,NX)=CPOOLR(1,L,NZ,NY,NX) + 2+FXFC*CH2OH*FXRT(ISTYP(NZ,NY,NX)) +50 CONTINUE + ELSE + CPOOLR(1,NG(NZ,NY,NX),NZ,NY,NX)=CPOOLR(1,NG(NZ,NY,NX),NZ,NY,NX) + 2+CH2OH*FXRT(ISTYP(NZ,NY,NX)) + ENDIF + ELSE + CH2OH=0.0 + ENDIF + ELSE + CH2OH=0.0 + ENDIF +C +C REMOBILIZE N,P FROM SEASONAL STORAGE AT FIRST-ORDER RATE +C MODIFIED BY SOIL TEMPERATURE AT SEED DEPTH +C + IF(WTRVC(NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + IF(ISTYP(NZ,NY,NX).NE.0)THEN + CPOOLT=AMAX1(0.0,WTRVC(NZ,NY,NX)+CPOOL(NB,NZ,NY,NX)) + ZPOOLD=(WTRVN(NZ,NY,NX)*CPOOL(NB,NZ,NY,NX) + 2-ZPOOL(NB,NZ,NY,NX)*WTRVC(NZ,NY,NX))/CPOOLT + PPOOLD=(WTRVP(NZ,NY,NX)*CPOOL(NB,NZ,NY,NX) + 2-PPOOL(NB,NZ,NY,NX)*WTRVC(NZ,NY,NX))/CPOOLT + UPNH4B=AMAX1(0.0,FRSV(IBTYP(NZ,NY,NX))*ZPOOLD) + UPPO4B=AMAX1(0.0,FRSV(IBTYP(NZ,NY,NX))*PPOOLD) + ELSE + UPNH4B=AMAX1(0.0,FXSH(ISTYP(NZ,NY,NX)) + 2*CH2OH*WTRVN(NZ,NY,NX)/WTRVC(NZ,NY,NX)) + UPPO4B=AMAX1(0.0,FXSH(ISTYP(NZ,NY,NX)) + 2*CH2OH*WTRVP(NZ,NY,NX)/WTRVC(NZ,NY,NX)) + ENDIF + ELSE + UPNH4B=AMAX1(0.0,FXSH(ISTYP(NZ,NY,NX))*WTRVN(NZ,NY,NX)) + UPPO4B=AMAX1(0.0,FXSH(ISTYP(NZ,NY,NX))*WTRVP(NZ,NY,NX)) + ENDIF +C +C ADD TO NON-STRUCTURAL POOLS IN ROOT +C + CPOOLM=0.0 + ZPOOLM=0.0 + PPOOLM=0.0 + DO 3 L=NU(NY,NX),NI(NZ,NY,NX) + CPOOLM=CPOOLM+AMAX1(0.0,CPOOLR(1,L,NZ,NY,NX)) + ZPOOLM=ZPOOLM+AMAX1(0.0,ZPOOLR(1,L,NZ,NY,NX)) + PPOOLM=PPOOLM+AMAX1(0.0,PPOOLR(1,L,NZ,NY,NX)) +3 CONTINUE + IF(WTRVC(NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + IF(ISTYP(NZ,NY,NX).NE.0)THEN + CPOOLT=AMAX1(ZEROP(NZ,NY,NX),WTRVC(NZ,NY,NX)+CPOOLM) + ZPOOLD=(WTRVN(NZ,NY,NX)*CPOOLM + 2-ZPOOLM*WTRVC(NZ,NY,NX))/CPOOLT + PPOOLD=(WTRVP(NZ,NY,NX)*CPOOLM + 2-PPOOLM*WTRVC(NZ,NY,NX))/CPOOLT + UPNH4R=AMAX1(0.0,FRSV(IBTYP(NZ,NY,NX))*ZPOOLD) + UPPO4R=AMAX1(0.0,FRSV(IBTYP(NZ,NY,NX))*PPOOLD) +C IF(NZ.EQ.1.OR.NZ.EQ.4)THEN +C WRITE(*,9878)'GERM1',I,J,NZ,UPNH4R,FRSV(IBTYP(NZ,NY,NX)) +C 2,ZPOOLD,WTRVN(NZ,NY,NX),CPOOLM,ZPOOLM,WTRVC(NZ,NY,NX) +C 3,CPOOLT +9878 FORMAT(A8,3I4,12E24.16) +C ENDIF + ELSE + UPNH4R=AMAX1(0.0,FXRT(ISTYP(NZ,NY,NX)) + 2*CH2OH*WTRVN(NZ,NY,NX)/WTRVC(NZ,NY,NX)) + UPPO4R=AMAX1(0.0,FXRT(ISTYP(NZ,NY,NX)) + 2*CH2OH*WTRVP(NZ,NY,NX)/WTRVC(NZ,NY,NX)) + ENDIF + ELSE + UPNH4R=AMAX1(0.0,FXRT(ISTYP(NZ,NY,NX))*WTRVN(NZ,NY,NX)) + UPPO4R=AMAX1(0.0,FXRT(ISTYP(NZ,NY,NX))*WTRVP(NZ,NY,NX)) + ENDIF +C +C TRANSFER STORAGE FLUXES +C + WTRVN(NZ,NY,NX)=WTRVN(NZ,NY,NX)-UPNH4B-UPNH4R + WTRVP(NZ,NY,NX)=WTRVP(NZ,NY,NX)-UPPO4B-UPPO4R + ZPOOL(NB,NZ,NY,NX)=ZPOOL(NB,NZ,NY,NX)+UPNH4B + PPOOL(NB,NZ,NY,NX)=PPOOL(NB,NZ,NY,NX)+UPPO4B + IF(WTRTM.GT.ZEROP(NZ,NY,NX) + 2.AND.CPOOLM.GT.ZEROP(NZ,NY,NX))THEN + DO 51 L=NU(NY,NX),NI(NZ,NY,NX) + FXFN=AMAX1(0.0,CPOOLR(1,L,NZ,NY,NX))/CPOOLM +C IF(NZ.EQ.1.OR.NZ.EQ.4)THEN +C WRITE(*,9879)'GERM2',I,J,NZ,L,UPNH4R,FXFN +C 2,ZPOOLR(1,L,NZ,NY,NX),CPOOLR(1,L,NZ,NY,NX),CPOOLM +9879 FORMAT(A8,4I4,12E24.16) +C ENDIF + ZPOOLR(1,L,NZ,NY,NX)=ZPOOLR(1,L,NZ,NY,NX)+FXFN*UPNH4R + PPOOLR(1,L,NZ,NY,NX)=PPOOLR(1,L,NZ,NY,NX)+FXFN*UPPO4R +51 CONTINUE + ELSE +C IF(NZ.EQ.1.OR.NZ.EQ.4)THEN +C WRITE(*,9879)'GERM3',I,J,NZ,L,UPNH4R,FXFN +C 2,ZPOOLR(1,L,NZ,NY,NX),CPOOLR(1,L,NZ,NY,NX),CPOOLM +C ENDIF + ZPOOLR(1,NG(NZ,NY,NX),NZ,NY,NX)=ZPOOLR(1,NG(NZ,NY,NX),NZ,NY,NX) + 2+UPNH4R + PPOOLR(1,NG(NZ,NY,NX),NZ,NY,NX)=PPOOLR(1,NG(NZ,NY,NX),NZ,NY,NX) + 2+UPPO4R + ENDIF + ENDIF +C +C REDISTRIBUTE TRANFERRED C FROM MAIN STEM TO OTHER BRANCHES +C + IF(NB.NE.NB1(NZ,NY,NX).AND.ATRP(NB,NZ,NY,NX).LE.ATRPX)THEN + ATRP(NB,NZ,NY,NX)=ATRP(NB,NZ,NY,NX)+TFN3(NZ,NY,NX)*WFNG + XFRC=AMAX1(0.0,0.05*TFN3(NZ,NY,NX) + 2*(0.5*(CPOOL(NB1(NZ,NY,NX),NZ,NY,NX)+CPOOL(NB,NZ,NY,NX)) + 3-CPOOL(NB,NZ,NY,NX))) + XFRN=AMAX1(0.0,0.05*TFN3(NZ,NY,NX) + 2*(0.5*(ZPOOL(NB1(NZ,NY,NX),NZ,NY,NX)+ZPOOL(NB,NZ,NY,NX)) + 2-ZPOOL(NB,NZ,NY,NX))) + XFRP=AMAX1(0.0,0.05*TFN3(NZ,NY,NX) + 2*(0.5*(PPOOL(NB1(NZ,NY,NX),NZ,NY,NX)+PPOOL(NB,NZ,NY,NX)) + 3-PPOOL(NB,NZ,NY,NX))) + CPOOL(NB,NZ,NY,NX)=CPOOL(NB,NZ,NY,NX)+XFRC + ZPOOL(NB,NZ,NY,NX)=ZPOOL(NB,NZ,NY,NX)+XFRN + PPOOL(NB,NZ,NY,NX)=PPOOL(NB,NZ,NY,NX)+XFRP + CPOOL(NB1(NZ,NY,NX),NZ,NY,NX)=CPOOL(NB1(NZ,NY,NX),NZ,NY,NX)-XFRC + ZPOOL(NB1(NZ,NY,NX),NZ,NY,NX)=ZPOOL(NB1(NZ,NY,NX),NZ,NY,NX)-XFRN + PPOOL(NB1(NZ,NY,NX),NZ,NY,NX)=PPOOL(NB1(NZ,NY,NX),NZ,NY,NX)-XFRP + ENDIF + ENDIF +C +C TRANSFER LEAF AND STALK NON-STRUCTURAL C,N,P TO SEASONAL STORAGE +C IN PERENNIALS AFTER GRAIN FILL IN DETERMINATES, AFTER AUTUMNIZ'N +C IN INDETERMINATES, OR AFTER SUSTAINED WATER STRESS +C + IF(ISTYP(NZ,NY,NX).NE.0.AND.IFLGZ.EQ.1)THEN + IF(WVSTKB(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX) + 2.AND.WTRSVB(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + CWTRSV=AMAX1(0.0,WTRSVB(NB,NZ,NY,NX)/WVSTKB(NB,NZ,NY,NX)) + CWTRSN=AMAX1(0.0,WTRSBN(NB,NZ,NY,NX)/WVSTKB(NB,NZ,NY,NX)) + CWTRSP=AMAX1(0.0,WTRSBP(NB,NZ,NY,NX)/WVSTKB(NB,NZ,NY,NX)) + CNR=CWTRSV/(CWTRSV+CWTRSN*CNKI) + CPR=CWTRSV/(CWTRSV+CWTRSP*CPKI) + ELSE + CNR=0.0 + CPR=0.0 + ENDIF + XFRCX=FXFB(IBTYP(NZ,NY,NX)) + 2*AMAX1(0.0,WTRSVB(NB,NZ,NY,NX)) + XFRNX=FXFB(IBTYP(NZ,NY,NX)) + 2*AMAX1(0.0,WTRSBN(NB,NZ,NY,NX))*(1.0+CNR) + XFRPX=FXFB(IBTYP(NZ,NY,NX)) + 2*AMAX1(0.0,WTRSBP(NB,NZ,NY,NX))*(1.0+CPR) + XFRC=AMIN1(XFRCX,XFRNX/CNMN,XFRPX/CPMN) + XFRN=AMIN1(XFRNX,XFRC*CNMX,XFRPX*CNMX/CPMN*0.5) + XFRP=AMIN1(XFRPX,XFRC*CPMX,XFRNX*CPMX/CNMN*0.5) + WTRSVB(NB,NZ,NY,NX)=WTRSVB(NB,NZ,NY,NX)-XFRC + WTRVC(NZ,NY,NX)=WTRVC(NZ,NY,NX)+XFRC + WTRSBN(NB,NZ,NY,NX)=WTRSBN(NB,NZ,NY,NX)-XFRN + WTRVN(NZ,NY,NX)=WTRVN(NZ,NY,NX)+XFRN + WTRSBP(NB,NZ,NY,NX)=WTRSBP(NB,NZ,NY,NX)-XFRP + WTRVP(NZ,NY,NX)=WTRVP(NZ,NY,NX)+XFRP + IF(CPOOL(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + CNL=CCPOLB(NB,NZ,NY,NX)/(CCPOLB(NB,NZ,NY,NX) + 2+CZPOLB(NB,NZ,NY,NX)*CNKI) + CPL=CCPOLB(NB,NZ,NY,NX)/(CCPOLB(NB,NZ,NY,NX) + 2+CPPOLB(NB,NZ,NY,NX)*CPKI) + ELSE + CNL=0.0 + CPL=0.0 + ENDIF + XFRCX=FXFB(IBTYP(NZ,NY,NX)) + 2*AMAX1(0.0,CPOOL(NB,NZ,NY,NX)) + XFRNX=FXFB(IBTYP(NZ,NY,NX)) + 2*AMAX1(0.0,ZPOOL(NB,NZ,NY,NX))*(1.0+CNL) + XFRPX=FXFB(IBTYP(NZ,NY,NX)) + 2*AMAX1(0.0,PPOOL(NB,NZ,NY,NX))*(1.0+CPL) + XFRC=AMIN1(XFRCX,XFRNX/CNMN,XFRPX/CPMN) + XFRN=AMIN1(XFRNX,XFRC*CNMX,XFRPX*CNMX/CPMN*0.5) + XFRP=AMIN1(XFRPX,XFRC*CPMX,XFRNX*CPMX/CNMN*0.5) + CPOOL(NB,NZ,NY,NX)=CPOOL(NB,NZ,NY,NX)-XFRC + WTRVC(NZ,NY,NX)=WTRVC(NZ,NY,NX)+XFRC + ZPOOL(NB,NZ,NY,NX)=ZPOOL(NB,NZ,NY,NX)-XFRN + WTRVN(NZ,NY,NX)=WTRVN(NZ,NY,NX)+XFRN + PPOOL(NB,NZ,NY,NX)=PPOOL(NB,NZ,NY,NX)-XFRP + WTRVP(NZ,NY,NX)=WTRVP(NZ,NY,NX)+XFRP +C IF(NZ.EQ.1)THEN +C WRITE(*,4490)'RSV',I,J,NZ,NB,XFRC,XFRN,WTRSVB(NB,NZ,NY,NX) +C 2,WTRSBN(NB,NZ,NY,NX),WTRVC(NZ,NY,NX),WTRVN(NZ,NY,NX) +C 3,CNR,CNL,CPOOL(NB,NZ,NY,NX),ZPOOL(NB,NZ,NY,NX) +C 4,FXFB(IBTYP(NZ,NY,NX)) +4490 FORMAT(A8,4I4,20E12.4) +C ENDIF + ENDIF +C +C TRANSFER NON-STRUCTURAL C,N,P FROM LEAVES AND ROOTS TO RESERVES +C IN STALKS DURING GRAIN FILL IN ANNUALS OR BETWEEN STALK RESERVES +C AND LEAVES IN PERENNIALS ACCORDING TO CONCENTRATION DIFFERENCES +C + IF((ISTYP(NZ,NY,NX).EQ.0.AND.IDAY(8,NB,NZ,NY,NX).NE.0) + 2.OR.(ISTYP(NZ,NY,NX).EQ.1.AND.IDAY(3,NB,NZ,NY,NX).NE.0))THEN + WTPLTT=WTLSB(NB,NZ,NY,NX)+WVSTKB(NB,NZ,NY,NX) + CPOOLT=CPOOL(NB,NZ,NY,NX)+WTRSVB(NB,NZ,NY,NX) + IF(WTPLTT.GT.ZEROP(NZ,NY,NX))THEN + CPOOLD=(CPOOL(NB,NZ,NY,NX)*WVSTKB(NB,NZ,NY,NX) + 2-WTRSVB(NB,NZ,NY,NX)*WTLSB(NB,NZ,NY,NX))/WTPLTT + XFRC=FXFY(ISTYP(NZ,NY,NX))*CPOOLD + CPOOL(NB,NZ,NY,NX)=CPOOL(NB,NZ,NY,NX)-XFRC + WTRSVB(NB,NZ,NY,NX)=WTRSVB(NB,NZ,NY,NX)+XFRC + ENDIF + IF(CPOOLT.GT.ZEROP(NZ,NY,NX))THEN + ZPOOLD=(ZPOOL(NB,NZ,NY,NX)*WTRSVB(NB,NZ,NY,NX) + 2-WTRSBN(NB,NZ,NY,NX)*CPOOL(NB,NZ,NY,NX))/CPOOLT + PPOOLD=(PPOOL(NB,NZ,NY,NX)*WTRSVB(NB,NZ,NY,NX) + 2-WTRSBP(NB,NZ,NY,NX)*CPOOL(NB,NZ,NY,NX))/CPOOLT + XFRN=FXFZ(ISTYP(NZ,NY,NX))*ZPOOLD + XFRP=FXFZ(ISTYP(NZ,NY,NX))*PPOOLD + ZPOOL(NB,NZ,NY,NX)=ZPOOL(NB,NZ,NY,NX)-XFRN + WTRSBN(NB,NZ,NY,NX)=WTRSBN(NB,NZ,NY,NX)+XFRN + PPOOL(NB,NZ,NY,NX)=PPOOL(NB,NZ,NY,NX)-XFRP + WTRSBP(NB,NZ,NY,NX)=WTRSBP(NB,NZ,NY,NX)+XFRP + ENDIF +C IF(NZ.EQ.1)THEN +C WRITE(*,4488)'EXCHC',I,J,NX,NY,NZ,NB,NS,XFRC,XFRN +C 2,FXFZ(ISTYP(NZ,NY,NX)),WTRSVB(NB,NZ,NY,NX),CPOOL(NB,NZ,NY,NX) +C 3,WVSTKB(NB,NZ,NY,NX),WTLSB(NB,NZ,NY,NX) +C 4,CPOOLT,CPOOLD,ZPOOL(NB,NZ,NY,NX),WTRSBN(NB,NZ,NY,NX) +4488 FORMAT(A8,7I4,12E12.4) +C ENDIF + IF(ISTYP(NZ,NY,NX).EQ.0)THEN + DO 2050 L=NU(NY,NX),NI(NZ,NY,NX) + WTRTRX=AMAX1(ZEROP(NZ,NY,NX),WTRTL(1,L,NZ,NY,NX)*FWOOD(1)) + WTPLTX=WTRTRX+WVSTKB(NB,NZ,NY,NX) + IF(WTPLTX.GT.ZEROP(NZ,NY,NX))THEN + CPOOLD=(CPOOLR(1,L,NZ,NY,NX)*WVSTKB(NB,NZ,NY,NX) + 2-WTRSVB(NB,NZ,NY,NX)*WTRTRX)/WTPLTX + XFRC=AMAX1(0.0,FXFY(ISTYP(NZ,NY,NX))*CPOOLD) + CPOOLR(1,L,NZ,NY,NX)=CPOOLR(1,L,NZ,NY,NX)-XFRC + WTRSVB(NB,NZ,NY,NX)=WTRSVB(NB,NZ,NY,NX)+XFRC + CPOOLT=CPOOLR(1,L,NZ,NY,NX)+WTRSVB(NB,NZ,NY,NX) + IF(CPOOLT.GT.ZEROP(NZ,NY,NX))THEN + ZPOOLD=(ZPOOLR(1,L,NZ,NY,NX)*WTRSVB(NB,NZ,NY,NX) + 2-WTRSBN(NB,NZ,NY,NX)*CPOOLR(1,L,NZ,NY,NX))/CPOOLT + PPOOLD=(PPOOLR(1,L,NZ,NY,NX)*WTRSVB(NB,NZ,NY,NX) + 2-WTRSBP(NB,NZ,NY,NX)*CPOOLR(1,L,NZ,NY,NX))/CPOOLT + XFRN=AMAX1(0.0,FXFZ(ISTYP(NZ,NY,NX))*ZPOOLD) + XFRP=AMAX1(0.0,FXFZ(ISTYP(NZ,NY,NX))*PPOOLD) + ZPOOLR(1,L,NZ,NY,NX)=ZPOOLR(1,L,NZ,NY,NX)-XFRN + WTRSBN(NB,NZ,NY,NX)=WTRSBN(NB,NZ,NY,NX)+XFRN + PPOOLR(1,L,NZ,NY,NX)=PPOOLR(1,L,NZ,NY,NX)-XFRP + WTRSBP(NB,NZ,NY,NX)=WTRSBP(NB,NZ,NY,NX)+XFRP +C IF(NZ.EQ.1)THEN +C WRITE(*,4489)'EXCHC',I,J,NZ,NB,L,WTRSVB(NB,NZ,NY,NX) +C 2,WVSTKB(NB,NZ,NY,NX),CPOOLR(1,L,NZ,NY,NX) +C 3,WTRTL(1,L,NZ,NY,NX),FWOOD(1),WTRTRX,WTPLTX +C 4,CPOOLT,CPOOLD,XFRC,FXFZ(ISTYP(NZ,NY,NX)) +4489 FORMAT(A8,5I4,12E16.8) +C ENDIF +C IF(NZ.EQ.1.OR.NZ.EQ.4)THEN +C WRITE(*,4489)'EXCHN',I,J,NZ,NB,L,WTRSBN(NB,NZ,NY,NX) +C 2,WTRSVB(NB,NZ,NY,NX),ZPOOLR(1,L,NZ,NY,NX) +C 3,CPOOLR(1,L,NZ,NY,NX),FWOOD(1),ZPOOLD,XFRN +C ENDIF + ENDIF + ENDIF +2050 CONTINUE + ENDIF + ENDIF +C +C REPLENISH BRANCH NON-STRUCTURAL POOL FROM +C SEASONAL STORAGE POOL +C + IF(WVSTKB(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX) + 2.AND.WVSTK(NZ,NY,NX).GT.ZEROP(NZ,NY,NX) + 3.AND.WTRT(NZ,NY,NX).GT.ZEROP(NZ,NY,NX) + 4.AND.WTRSVB(NB,NZ,NY,NX).LE.XFRX*WVSTKB(NB,NZ,NY,NX))THEN + FWTBR=WVSTKB(NB,NZ,NY,NX)/WVSTK(NZ,NY,NX) + WVSTBX=WVSTKB(NB,NZ,NY,NX) + WTRTTX=WTRT(NZ,NY,NX)*FWTBR + WTPLTT=WVSTBX+WTRTTX + WTRSBX=AMAX1(0.0,WTRSVB(NB,NZ,NY,NX)) + WTRVCX=AMAX1(0.0,WTRVC(NZ,NY,NX)*FWTBR) + CPOOLD=(WTRVCX*WVSTBX-WTRSBX*WTRTTX)/WTPLTT + XFRC=AMAX1(0.0,XFRY*CPOOLD) + WTRSVB(NB,NZ,NY,NX)=WTRSVB(NB,NZ,NY,NX)+XFRC + WTRVC(NZ,NY,NX)=WTRVC(NZ,NY,NX)-XFRC + ENDIF +C +C CANOPY N2 FIXATION (CYANOBACTERIA) +C + IF(INTYP(NZ,NY,NX).GE.3)THEN +C +C INITIAL INFECTION +C + IF(WTNDB(NB,NZ,NY,NX).LE.0.0)THEN + WTNDB(NB,NZ,NY,NX)=WTNDB(NB,NZ,NY,NX) + 2+WTNDI*AREA(3,NU(NY,NX),NY,NX) + WTNDBN(NB,NZ,NY,NX)=WTNDBN(NB,NZ,NY,NX) + 2+WTNDI*AREA(3,NU(NY,NX),NY,NX)*CNND(NZ,NY,NX) + WTNDBP(NB,NZ,NY,NX)=WTNDBP(NB,NZ,NY,NX) + 2+WTNDI*AREA(3,NU(NY,NX),NY,NX)*CPND(NZ,NY,NX) + ENDIF +C +C O2-UNCONSTRAINED RESPIRATION RATES BY HETEROTROPHIC AEROBES +C IN NODULE FROM SPECIFIC OXIDATION RATE, ACTIVE BIOMASS, +C NON-STRUCTURAL C CONCENTRATION, MICROBIAL C:N:P FACTOR, +C AND TEMPERATURE +C + IF(WTNDB(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + CCPOLN=AMAX1(0.0,CPOLNB(NB,NZ,NY,NX)/WTNDB(NB,NZ,NY,NX)) + CZPOLN=AMAX1(0.0,ZPOLNB(NB,NZ,NY,NX)/WTNDB(NB,NZ,NY,NX)) + CPPOLN=AMAX1(0.0,PPOLNB(NB,NZ,NY,NX)/WTNDB(NB,NZ,NY,NX)) + ELSE + CCPOLN=1.0 + CZPOLN=1.0 + 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) + ELSE + CCC=0.0 + CNC=0.0 + CPC=0.0 + CNF=0.0 + ENDIF + IF(WTNDB(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + FCNPF=AMIN1(1.0,AMAX1(0.0 + 2,WTNDBN(NB,NZ,NY,NX)/(WTNDB(NB,NZ,NY,NX)*CNND(NZ,NY,NX)) + 3,WTNDBP(NB,NZ,NY,NX)/(WTNDB(NB,NZ,NY,NX)*CPND(NZ,NY,NX)))) + ELSE + FCNPF=1.0 + ENDIF + RDNDBX=CCPOLN/(CCPOLN+CCNKX) + RCNDL=AMAX1(0.0,AMIN1(CPOLNB(NB,NZ,NY,NX)*(1.0-DMND(NZ,NY,NX)) + 2,VMXO*WTNDB(NB,NZ,NY,NX)*CCPOLN/(CCPOLN+CCNKM) + 3*TFN3(NZ,NY,NX)*FCNPF*WFNG))*CNF +C +C NODULE MAINTENANCE RESPIRATION FROM SOIL TEMPERATURE, +C NODULE STRUCTURAL N +C + RMNDL=AMAX1(0.0,RMPLT*TFN5*WTNDBN(NB,NZ,NY,NX))*RDNDBX +C +C NODULE GROWTH RESPIRATION FROM TOTAL - MAINTENANCE +C IF > 0 DRIVES GROWTH, IF < 0 DRIVES REMOBILIZATION +C + RXNDL=RCNDL-RMNDL + RGNDL=AMAX1(0.0,RXNDL) + RSNDL=AMAX1(0.0,-RXNDL) +C +C NODULE N2 FIXATION FROM GROWTH RESPIRATION, FIXATION ENERGY +C REQUIREMENT AND NON-STRUCTURAL C:N:P PRODUCT INHIBITION, +C CONSTRAINED BY MICROBIAL N REQUIREMENT +C + RGN2P=AMAX1(0.0,WTNDB(NB,NZ,NY,NX)*CNND(NZ,NY,NX) + 2-WTNDBN(NB,NZ,NY,NX))/EN2F + RGN2F=AMIN1(RGNDL,RGN2P) + RUPNFB=RGN2F*EN2F + UPNFC(NZ,NY,NX)=UPNFC(NZ,NY,NX)+RUPNFB +C +C TOTAL NON-STRUCTURAL C,N,P USED IN NODULE GROWTH +C AND GROWTH RESPIRATION DEPENDS ON GROWTH YIELD ENTERED IN 'READQ' +C + CGNDL=(RGNDL-RGN2F)/(1.0-DMND(NZ,NY,NX)) + GRNDG=CGNDL*DMND(NZ,NY,NX) + ZADDN=AMAX1(0.0,AMIN1(ZPOLNB(NB,NZ,NY,NX) + 2,GRNDG*CNND(NZ,NY,NX))*CCC) + PADDN=AMAX1(0.0,AMIN1(PPOLNB(NB,NZ,NY,NX) + 2,GRNDG*CPND(NZ,NY,NX))*CCC) +C +C NODULE C,N,P REMOBILIZATION AND DECOMPOSITION AND LEAKAGE +C + RCCC=RCCZ(IBTYP(NZ,NY,NX))+CCC*RCCY(IBTYP(NZ,NY,NX)) + RCCN=CNC*RCCX(IGTYP(NZ,NY,NX)) + RCCP=CPC*RCCQ(IGTYP(NZ,NY,NX)) + SPNDX=SPNDL*RDNDBX + RXNDLC=SPNDX*WTNDB(NB,NZ,NY,NX)*WFNG + RXNDLN=SPNDX*WTNDBN(NB,NZ,NY,NX)*WFNG + RXNDLP=SPNDX*WTNDBP(NB,NZ,NY,NX)*WFNG + RDNDLC=RXNDLC*(1.0-RCCC) + RDNDLN=RXNDLN*(1.0-RCCN)*(1.0-RCCC) + RDNDLP=RXNDLP*(1.0-RCCP)*(1.0-RCCC) + RCNDLC=RXNDLC-RDNDLC + RCNDLN=RXNDLN-RDNDLN + RCNDLP=RXNDLP-RDNDLP +C +C NODULE SENESCENCE +C + IF(RSNDL.GT.0.0.AND.WTNDB(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX) + 2.AND.RCCC.GT.ZERO)THEN + RXNSNC=RSNDL/RCCC + RXNSNN=RXNSNC*WTNDBN(NB,NZ,NY,NX)/WTNDB(NB,NZ,NY,NX) + RXNSNP=RXNSNC*WTNDBP(NB,NZ,NY,NX)/WTNDB(NB,NZ,NY,NX) + RDNSNC=RXNSNC*(1.0-RCCC) + RDNSNN=RXNSNN*(1.0-RCCN)*(1.0-RCCC) + RDNSNP=RXNSNP*(1.0-RCCP)*(1.0-RCCC) + RCNSNC=RXNSNC-RDNSNC + RCNSNN=RXNSNN-RDNSNN + RCNSNP=RXNSNP-RDNSNP + ELSE + RXNSNC=0.0 + RXNSNN=0.0 + RXNSNP=0.0 + RDNSNC=0.0 + RDNSNN=0.0 + RDNSNP=0.0 + RCNSNC=0.0 + RCNSNN=0.0 + RCNSNP=0.0 + ENDIF +C +C TOTAL NODULE RESPIRATION +C + RCO2T=AMIN1(RMNDL,RCNDL)+RGNDL+RCNSNC + TCO2T(NZ,NY,NX)=TCO2T(NZ,NY,NX)-RCO2T + TCO2A(NZ,NY,NX)=TCO2A(NZ,NY,NX)-RCO2T + CNET(NZ,NY,NX)=CNET(NZ,NY,NX)-RCO2T + RECO(NY,NX)=RECO(NY,NX)-RCO2T + TRAU(NY,NX)=TRAU(NY,NX)-RCO2T +C +C NODULE LITTERFALL CAUSED BY REMOBILIZATION +C + DO 6470 M=1,4 + CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX)+CFOPC(1,M,NZ,NY,NX) + 2*(RDNDLC+RDNSNC) + ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX)+CFOPN(1,M,NZ,NY,NX) + 2*(RDNDLN+RDNSNN) + PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX)+CFOPP(1,M,NZ,NY,NX) + 2*(RDNDLP+RDNSNP) +6470 CONTINUE +C +C CONSUMPTION OF NON-STRUCTURAL C,N,P BY NODULE +C + CPOLNB(NB,NZ,NY,NX)=CPOLNB(NB,NZ,NY,NX)-AMIN1(RMNDL,RCNDL) + 2-RGN2F-CGNDL+RCNDLC + ZPOLNB(NB,NZ,NY,NX)=ZPOLNB(NB,NZ,NY,NX)-ZADDN+RCNDLN+RCNSNN + 2+RUPNFB + PPOLNB(NB,NZ,NY,NX)=PPOLNB(NB,NZ,NY,NX)-PADDN+RCNDLP+RCNSNP +C +C UPDATE STATE VARIABLES FOR NODULE C, N, P +C + WTNDB(NB,NZ,NY,NX)=WTNDB(NB,NZ,NY,NX)+GRNDG-RXNDLC-RXNSNC + WTNDBN(NB,NZ,NY,NX)=WTNDBN(NB,NZ,NY,NX)+ZADDN-RXNDLN-RXNSNN + WTNDBP(NB,NZ,NY,NX)=WTNDBP(NB,NZ,NY,NX)+PADDN-RXNDLP-RXNSNP +C +C TRANSFER NON-STRUCTURAL C,N,P BETWEEN BRANCH AND NODULES +C FROM NON-STRUCTURAL C,N,P CONCENTRATION DIFFERENCES +C + 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),WTNDB(NB,NZ,NY,NX)) + WTLSBT=WTLSB1+WTNDB1 + IF(WTLSBT.GT.ZEROP(NZ,NY,NX))THEN + CPOOLD=(CPOOL(NB,NZ,NY,NX)*WTNDB1 + 2-CPOLNB(NB,NZ,NY,NX)*WTLSB1)/WTLSBT + XFRC=FXRN(INTYP(NZ,NY,NX))*CPOOLD + CPOOL(NB,NZ,NY,NX)=CPOOL(NB,NZ,NY,NX)-XFRC + CPOLNB(NB,NZ,NY,NX)=CPOLNB(NB,NZ,NY,NX)+XFRC + CPOOLT=CPOOL(NB,NZ,NY,NX)+CPOLNB(NB,NZ,NY,NX) + IF(CPOOLT.GT.ZEROP(NZ,NY,NX))THEN + ZPOOLD=(ZPOOL(NB,NZ,NY,NX)*CPOLNB(NB,NZ,NY,NX) + 2-ZPOLNB(NB,NZ,NY,NX)*CPOOL(NB,NZ,NY,NX))/CPOOLT + XFRN=FXRN(INTYP(NZ,NY,NX))*ZPOOLD + PPOOLD=(PPOOL(NB,NZ,NY,NX)*CPOLNB(NB,NZ,NY,NX) + 2-PPOLNB(NB,NZ,NY,NX)*CPOOL(NB,NZ,NY,NX))/CPOOLT + XFRP=FXRN(INTYP(NZ,NY,NX))*PPOOLD + ZPOOL(NB,NZ,NY,NX)=ZPOOL(NB,NZ,NY,NX)-XFRN + PPOOL(NB,NZ,NY,NX)=PPOOL(NB,NZ,NY,NX)-XFRP + ZPOLNB(NB,NZ,NY,NX)=ZPOLNB(NB,NZ,NY,NX)+XFRN + PPOLNB(NB,NZ,NY,NX)=PPOLNB(NB,NZ,NY,NX)+XFRP +C IF((I/10)*10.EQ.I.AND.J.EQ.12.AND.NZ.EQ.4)THEN +C WRITE(*,2121)'NODEX',I,J,NZ,NB,XFRC,XFRN,XFRP +C 3,WTLSB(NB,NZ,NY,NX),WTNDB(NB,NZ,NY,NX),CPOOLT +C 4,CPOLNB(NB,NZ,NY,NX),ZPOLNB(NB,NZ,NY,NX),PPOLNB(NB,NZ,NY,NX) +C 4,CPOOL(NB,NZ,NY,NX),ZPOOL(NB,NZ,NY,NX),PPOOL(NB,NZ,NY,NX) +C ENDIF + ENDIF + ENDIF + ENDIF +C IF((I/10)*10.EQ.I.AND.J.EQ.12.AND.NY.EQ.5)THEN +C WRITE(*,2121)'NODGR',I,J,NZ,NB,RCNDL,RMNDL,RGNDL,RGN2P +C 2,RGN2F,CGNDL,SNCR,GRNDG,ZADDN,PADDN,FSNCN +C 8,RDNDLC,RDNDLN,RDNDLP,RCCC,RCCN,RCCP,TFN5 +C 3,WTNDB(NB,NZ,NY,NX),WTNDBN(NB,NZ,NY,NX),WTNDBP(NB,NZ,NY,NX) +C 4,CPOLNB(NB,NZ,NY,NX),ZPOLNB(NB,NZ,NY,NX),PPOLNB(NB,NZ,NY,NX) +C 5,CCPOLN,CZPOLN,TFN3(NZ,NY,NX),CNF,FCNPF,WFNG +C 6,CPOLNB(NB,NZ,NY,NX)*(1.0-DMND(NZ,NY,NX)) +C 6,VMXO*WTNDB(NB,NZ,NY,NX)*CCPOLN/(CCPOLN+CCNKM) +2121 FORMAT(A8,4I4,60E12.4) +C ENDIF + ENDIF + ENDIF + + +105 CONTINUE +C +C ROOT GROWTH +C + NIX(NZ,NY,NX)=NG(NZ,NY,NX) + IDTHRN=0 +C +C FOR ROOTS (N=1) AND MYCORRHIZAE (N=2) IN EACH SOIL LAYER +C + DO 4990 N=1,MY(NZ,NY,NX) + DO 4990 L=NU(NY,NX),NI(NZ,NY,NX) +C +C RESPIRATION FROM NUTRIENT UPTAKE CALCULATED IN 'UPTAKE': +C ACTUAL, O2-UNLIMITED AND C-UNLIMITED +C + CUPRL=0.86*(RUPNH4(N,L,NZ,NY,NX)+RUPNHB(N,L,NZ,NY,NX) + 2+RUPNO3(N,L,NZ,NY,NX)+RUPNOB(N,L,NZ,NY,NX)+RUPH2P(N,L,NZ,NY,NX) + 3+RUPH2B(N,L,NZ,NY,NX)) + CUPRO=0.86*(RUONH4(N,L,NZ,NY,NX)+RUONHB(N,L,NZ,NY,NX) + 2+RUONO3(N,L,NZ,NY,NX)+RUONOB(N,L,NZ,NY,NX)+RUOH2P(N,L,NZ,NY,NX) + 3+RUOH2B(N,L,NZ,NY,NX)) + CUPRC=0.86*(RUCNH4(N,L,NZ,NY,NX)+RUCNHB(N,L,NZ,NY,NX) + 2+RUCNO3(N,L,NZ,NY,NX)+RUCNOB(N,L,NZ,NY,NX)+RUCH2P(N,L,NZ,NY,NX) + 3+RUCH2B(N,L,NZ,NY,NX)) +C +C ACCUMULATE RESPIRATION IN FLUX ARRAYS +C + RCO2M(N,L,NZ,NY,NX)=RCO2M(N,L,NZ,NY,NX)+CUPRO + RCO2N(N,L,NZ,NY,NX)=RCO2N(N,L,NZ,NY,NX)+CUPRC + RCO2A(N,L,NZ,NY,NX)=RCO2A(N,L,NZ,NY,NX)-CUPRL + CPOOLR(N,L,NZ,NY,NX)=CPOOLR(N,L,NZ,NY,NX)-CUPRL +C +C EXUDATION AND UPTAKE OF C, N AND P TO/FROM SOIL AND ROOT +C OR MYCORRHIZAL NON-STRUCTURAL C,N,P POOLS +C + DO 195 K=0,4 + CPOOLR(N,L,NZ,NY,NX)=CPOOLR(N,L,NZ,NY,NX)+RDFOMC(N,K,L,NZ,NY,NX) + ZPOOLR(N,L,NZ,NY,NX)=ZPOOLR(N,L,NZ,NY,NX)+RDFOMN(N,K,L,NZ,NY,NX) + PPOOLR(N,L,NZ,NY,NX)=PPOOLR(N,L,NZ,NY,NX)+RDFOMP(N,K,L,NZ,NY,NX) +195 CONTINUE + ZPOOLR(N,L,NZ,NY,NX)=ZPOOLR(N,L,NZ,NY,NX) + 2+RUPNH4(N,L,NZ,NY,NX)+RUPNHB(N,L,NZ,NY,NX) + 2+RUPNO3(N,L,NZ,NY,NX)+RUPNOB(N,L,NZ,NY,NX) + PPOOLR(N,L,NZ,NY,NX)=PPOOLR(N,L,NZ,NY,NX) + 2+RUPH2P(N,L,NZ,NY,NX)+RUPH2B(N,L,NZ,NY,NX) +C IF(L.EQ.1)THEN +C WRITE(*,9881)'CUPNH4',I,J,NZ,L,N,CPOOLR(N,L,NZ,NY,NX) +C 2,ZPOOLR(N,L,NZ,NY,NX),PPOOLR(N,L,NZ,NY,NX),CUPRL +C 2,RDFOMC(N,L,NZ,NY,NX),RDFOMN(N,L,NZ,NY,NX),RDFOMP(N,L,NZ,NY,NX) +C 2,RUPNH4(N,L,NZ,NY,NX),RUPNHB(N,L,NZ,NY,NX),RUPNO3(N,L,NZ,NY,NX) +C 2,RUPNOB(N,L,NZ,NY,NX),RUPH2P(N,L,NZ,NY,NX),RUPH2B(N,L,NZ,NY,NX) +C 3,WFR(N,L,NZ,NY,NX) +9881 FORMAT(A8,5I4,30E24.16) +C ENDIF +C +C GROWTH OF EACH ROOT AXIS +C + DO 4985 NR=1,NRT(NZ,NY,NX) +C +C PRIMARY ROOT SINK STRENGTH FROM ROOT RADIUS AND ROOT DEPTH +C + IF(N.EQ.1)THEN + 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 + RTNT(N)=RTNT(N)+RTSK1(N,L,NR) + RLNT(N,L)=RLNT(N,L)+RTSK1(N,L,NR) + ENDIF + ENDIF + ENDIF +C +C SECONDARY ROOT SINK STRENGTH FROM ROOT RADIUS, ROOT AXIS NUMBER, +C AND ROOT LENGTH IN SERIES WITH PRIMARY ROOT SINK STRENGTH +C + IF(N.EQ.1)THEN + RTDPL(NR,L)=AMAX1(0.0,RTDP1(1,NR,NZ,NY,NX)-CDPTHZ(L-1,NY,NX) + 2-RTDPX) + RTDPL(NR,L)=AMAX1(0.0,AMIN1(DLYR(3,L,NY,NX),RTDPL(NR,L)) + 2-AMAX1(0.0,SDPTH(NZ,NY,NX)-CDPTHZ(L-1,NY,NX)-HTCTL(NZ,NY,NX))) + RTDPS=AMAX1(SDPTH(NZ,NY,NX),CDPTHZ(L-1,NY,NX)) + 2+0.5*RTDPL(NR,L)+HTSTZ(NZ,NY,NX) + IF(RTDPS.GT.ZERO)THEN + RTSKP=XRTN1*RRAD1(N,L,NZ,NY,NX)**2/RTDPS + RTSKS=RTN2(N,L,NR,NZ,NY,NX)*RRAD2(N,L,NZ,NY,NX)**2 + 2/RTLGA(N,L,NZ,NY,NX) + IF(RTSKP+RTSKS.GT.ZEROP(NZ,NY,NX))THEN + RTSK2(N,L,NR)=RTSKP*RTSKS/(RTSKP+RTSKS) + ELSE + RTSK2(N,L,NR)=0.0 + ENDIF + ELSE + RTSK2(N,L,NR)=0.0 + ENDIF + ELSE + RTSK2(N,L,NR)=RTN2(N,L,NR,NZ,NY,NX)*RRAD2(N,L,NZ,NY,NX)**2 + 2/RTLGA(N,L,NZ,NY,NX) + ENDIF + RTNT(N)=RTNT(N)+RTSK2(N,L,NR) + RLNT(N,L)=RLNT(N,L)+RTSK2(N,L,NR) +C IF(NZ.EQ.3)THEN +C WRITE(*,3341)'SINK',I,J,NX,NY,NZ,L,NR,N +C 2,RTSK1(N,L,NR),RTSK2(N,L,NR),RLNT(N,L),RTNT(N) +C 3,XRTN1,PP(NZ,NY,NX),RRAD1(N,L,NZ,NY,NX),RTDPP +C 4,RTN2(N,L,NR,NZ,NY,NX),RRAD2(N,L,NZ,NY,NX) +C 2,RTLGA(N,L,NZ,NY,NX) +3341 FORMAT(A8,8I4,20E12.4) +C ENDIF +4985 CONTINUE +4990 CONTINUE +C +C RESPIRATION AND GROWTH OF ROOT, MYCORRHIZAE IN EACH LAYER +C + DO 5010 N=1,MY(NZ,NY,NX) + DO 5000 L=NU(NY,NX),NI(NZ,NY,NX) +C +C WATER STRESS CONSTRAINT ON SECONDARY ROOT EXTENSION IMPOSED +C BY ROOT TURGOR AND SOIL PENETRATION RESISTANCE +C + RSCS2=RSCS(L,NY,NX)*RRAD2(N,L,NZ,NY,NX)/1.0E-03 + WFNR=AMIN1(1.0,AMAX1(0.0,PSIRG(N,L,NZ,NY,NX)-PSILM-RSCS2)) + WFNRG=WFNR**0.25 + WFNGR(N,L)=EXP(0.10*PSIRT(N,L,NZ,NY,NX)) + DMRTD=1.0-DMRT(NZ,NY,NX) + RTLGL=0.0 + RTLGZ=0.0 + WTRTX=0.0 + WTRTZ=0.0 +C +C FOR EACH ROOT AXIS +C + DO 5050 NR=1,NRT(NZ,NY,NX) +C +C SECONDARY ROOT EXTENSION +C + IF(L.LE.NINR(NR,NZ,NY,NX).AND.NRX(N,NR).EQ.0)THEN +C +C FRACTION OF SECONDARY ROOT SINK IN SOIL LAYER ATTRIBUTED +C TO CURRENT AXIS +C + IF(RLNT(N,L).GT.ZEROP(NZ,NY,NX))THEN + FRTN=RTSK2(N,L,NR)/RLNT(N,L) + ELSE + FRTN=1.0 + ENDIF +C +C N,P CONSTRAINT ON SECONDARY ROOT RESPIRATION FROM +C NON-STRUCTURAL C:N:P +C + IF(CCPOLR(N,L,NZ,NY,NX).GT.ZERO)THEN + CNPG=AMIN1(CZPOLR(N,L,NZ,NY,NX)/(CZPOLR(N,L,NZ,NY,NX) + 2+CCPOLR(N,L,NZ,NY,NX)/CNKI),CPPOLR(N,L,NZ,NY,NX) + 3/(CPPOLR(N,L,NZ,NY,NX)+CCPOLR(N,L,NZ,NY,NX)/CPKI)) + ELSE + CNPG=1.0 + ENDIF +C +C O2-UNLIMITED SECONDARY ROOT RESPIRATION FROM NON-STRUCTURAL C +C CONSTRAINED BY TEMPERATURE AND NON-STRUCTURAL C:N:P +C + RCO2RM=AMAX1(0.0,VMXC*FRTN*CPOOLR(N,L,NZ,NY,NX) + 2*TFN4(L,NZ,NY,NX))*CNPG*FDBKX(NB1(NZ,NY,NX),NZ,NY,NX) + 3*WFNGR(N,L) +C +C O2-LIMITED SECONDARY ROOT RESPIRATION FROM 'WFR' IN 'UPTAKE' +C + RCO2R=RCO2RM*WFR(N,L,NZ,NY,NX) +C +C SECONDARY ROOT MAINTENANCE RESPIRATION FROM SOIL TEMPERATURE, +C ROOT STRUCTURAL N +C + RMNCR=AMAX1(0.0,RMPLT*WTRT2N(N,L,NR,NZ,NY,NX))*TFN6(L) + IF(IWTYP(NZ,NY,NX).EQ.2)THEN + RMNCR=RMNCR*WFNGR(N,L) + ENDIF + RCO2XM=RCO2RM-RMNCR + RCO2X=RCO2R-RMNCR + RCO2YM=AMAX1(0.0,RCO2XM)*WFNRG + RCO2Y=AMAX1(0.0,RCO2X)*WFNRG +C +C SECONDARY ROOT GROWTH RESPIRATION MAY BE LIMITED BY +C NON-STRUCTURAL N,P AVAILABLE FOR GROWTH +C + DMRTR=DMRTD*FRTN + ZPOOLB=AMAX1(0.0,ZPOOLR(N,L,NZ,NY,NX)) + PPOOLB=AMAX1(0.0,PPOOLR(N,L,NZ,NY,NX)) + FNP=AMIN1(ZPOOLB*DMRTR/CNRTS(NZ,NY,NX) + 2,PPOOLB*DMRTR/CPRTS(NZ,NY,NX)) + IF(RCO2YM.GT.0.0)THEN + RCO2GM=AMIN1(RCO2YM,FNP) + ELSE + RCO2GM=0.0 + ENDIF + IF(RCO2Y.GT.0.0)THEN + RCO2G=AMIN1(RCO2Y,FNP*WFR(N,L,NZ,NY,NX)) + ELSE + RCO2G=0.0 + ENDIF +C +C TOTAL NON-STRUCTURAL C,N,P USED IN SECONDARY ROOT GROWTH +C AND GROWTH RESPIRATION DEPENDS ON GROWTH YIELD ENTERED IN 'READQ' +C + CGRORM=RCO2GM/DMRTD + CGROR=RCO2G/DMRTD + GRTWGM=CGRORM*DMRT(NZ,NY,NX) + GRTWTG=CGROR*DMRT(NZ,NY,NX) + ZADD2M=AMAX1(0.0,GRTWGM*CNRTW) + ZADD2=AMAX1(0.0,AMIN1(FRTN*ZPOOLR(N,L,NZ,NY,NX),GRTWTG*CNRTW)) + PADD2=AMAX1(0.0,AMIN1(FRTN*PPOOLR(N,L,NZ,NY,NX),GRTWTG*CPRTW)) + CNRDM=AMAX1(0.0,1.70*ZADD2M) + CNRDA=AMAX1(0.0,1.70*ZADD2) +C +C SECONDARY ROOT GROWTH RESPIRATION FROM TOTAL - MAINTENANCE +C IF > 0 DRIVES GROWTH, IF < 0 DRIVES REMOBILIZATION, ALSO +C SECONDARY ROOT C LOSS FROM REMOBILIZATION AND CONSEQUENT LITTERFALL +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) + 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) + ELSE + CCC=0.0 + CNC=0.0 + CPC=0.0 + ENDIF + RCCC=RCCZ(IBTYP(NZ,NY,NX))+CCC*RCCY(IBTYP(NZ,NY,NX)) + RCCN=CNC*RCCX(IGTYP(NZ,NY,NX)) + RCCP=CPC*RCCQ(IGTYP(NZ,NY,NX)) + IF(-RCO2XM.GT.0.0)THEN + IF(-RCO2XM.LT.WTRT2(N,L,NR,NZ,NY,NX)*RCCC)THEN + SNCRM=-RCO2XM + ELSE + SNCRM=AMAX1(0.0,WTRT2(N,L,NR,NZ,NY,NX)*RCCC) + ENDIF + ELSE + SNCRM=0.0 + ENDIF + IF(-RCO2X.GT.0.0)THEN + IF(-RCO2X.LT.WTRT2(N,L,NR,NZ,NY,NX)*RCCC)THEN + SNCR=-RCO2X + ELSE + SNCR=AMAX1(0.0,WTRT2(N,L,NR,NZ,NY,NX)*RCCC) + 2*WFR(N,L,NZ,NY,NX) + ENDIF + ELSE + SNCR=0.0 + ENDIF +C +C RECOVERY OF REMOBILIZABLE N,P FROM SECONDARY ROOT DURING +C REMOBILIZATION DEPENDS ON ROOT NON-STRUCTURAL C:N:P +C + IF(SNCR.GT.0.0.AND.WTRT2(N,L,NR,NZ,NY,NX) + 2.GT.ZEROP(NZ,NY,NX))THEN + RCCR=RCCC*WTRT2(N,L,NR,NZ,NY,NX) + RCZR=WTRT2N(N,L,NR,NZ,NY,NX)*(RCCN+(1.0-RCCN) + 2*RCCR/WTRT2(N,L,NR,NZ,NY,NX)) + RCPR=WTRT2P(N,L,NR,NZ,NY,NX)*(RCCP+(1.0-RCCP) + 2*RCCR/WTRT2(N,L,NR,NZ,NY,NX)) + IF(RCCR.GT.ZEROP(NZ,NY,NX))THEN + FSNC2=AMAX1(0.0,AMIN1(1.0,SNCR/RCCR)) + ELSE + FSNC2=1.0 + ENDIF + ELSE + RCCR=0.0 + RCZR=0.0 + RCPR=0.0 + FSNC2=0.0 + ENDIF +C +C SECONDARY ROOT LITTERFALL CAUSED BY REMOBILIZATION +C + DO 6350 M=1,4 + CSNC(M,0,L,NZ,NY,NX)=CSNC(M,0,L,NZ,NY,NX)+CFOPC(5,M,NZ,NY,NX) + 2*FSNC2*(WTRT2(N,L,NR,NZ,NY,NX)-RCCR)*FWOOD(0) + ZSNC(M,0,L,NZ,NY,NX)=ZSNC(M,0,L,NZ,NY,NX)+CFOPN(5,M,NZ,NY,NX) + 2*FSNC2*(WTRT2N(N,L,NR,NZ,NY,NX)-RCZR)*FWOODN(0) + PSNC(M,0,L,NZ,NY,NX)=PSNC(M,0,L,NZ,NY,NX)+CFOPP(5,M,NZ,NY,NX) + 2*FSNC2*(WTRT2P(N,L,NR,NZ,NY,NX)-RCPR)*FWOODP(0) + CSNC(M,1,L,NZ,NY,NX)=CSNC(M,1,L,NZ,NY,NX)+CFOPC(4,M,NZ,NY,NX) + 2*FSNC2*(WTRT2(N,L,NR,NZ,NY,NX)-RCCR)*FWOOD(1) + ZSNC(M,1,L,NZ,NY,NX)=ZSNC(M,1,L,NZ,NY,NX)+CFOPN(4,M,NZ,NY,NX) + 2*FSNC2*(WTRT2N(N,L,NR,NZ,NY,NX)-RCZR)*FWOODN(1) + PSNC(M,1,L,NZ,NY,NX)=PSNC(M,1,L,NZ,NY,NX)+CFOPP(4,M,NZ,NY,NX) + 2*FSNC2*(WTRT2P(N,L,NR,NZ,NY,NX)-RCPR)*FWOODP(1) +6350 CONTINUE +C +C CONSUMPTION OF NON-STRUCTURAL C,N,P BY SECONDARY ROOT +C + CPOOLR(N,L,NZ,NY,NX)=CPOOLR(N,L,NZ,NY,NX)-AMIN1(RMNCR,RCO2R) + 2-CGROR-CNRDA-SNCR+FSNC2*RCCR + ZPOOLR(N,L,NZ,NY,NX)=ZPOOLR(N,L,NZ,NY,NX)-ZADD2+FSNC2*RCZR + PPOOLR(N,L,NZ,NY,NX)=PPOOLR(N,L,NZ,NY,NX)-PADD2+FSNC2*RCPR +C +C TOTAL SECONDARY ROOT RESPIRATION +C + RCO2TM=AMIN1(RMNCR,RCO2RM)+RCO2GM+SNCRM+CNRDM + RCO2T=AMIN1(RMNCR,RCO2R)+RCO2G+SNCR+CNRDA + RCO2M(N,L,NZ,NY,NX)=RCO2M(N,L,NZ,NY,NX)+RCO2TM + RCO2N(N,L,NZ,NY,NX)=RCO2N(N,L,NZ,NY,NX)+RCO2T + RCO2A(N,L,NZ,NY,NX)=RCO2A(N,L,NZ,NY,NX)-RCO2T +C +C SECONDARY ROOT EXTENSION FROM ROOT GROWTH AND ROOT TURGOR +C + GRTLGL=GRTWTG*RTLG2X(N,NZ,NY,NX)*WFNR*FWOOD(1) + 2-FSNC2*RTLG2(N,L,NR,NZ,NY,NX) + GRTWTL=GRTWTG-FSNC2*WTRT2(N,L,NR,NZ,NY,NX) + GRTWTN=ZADD2-FSNC2*WTRT2N(N,L,NR,NZ,NY,NX) + GRTWTP=PADD2-FSNC2*WTRT2P(N,L,NR,NZ,NY,NX) +C +C UPDATE STATE VARIABLES FOR SECONDARY ROOT LENGTH, C, N, P +C AND AXIS NUMBER +C + RTLG2(N,L,NR,NZ,NY,NX)=RTLG2(N,L,NR,NZ,NY,NX)+GRTLGL + WTRT2(N,L,NR,NZ,NY,NX)=WTRT2(N,L,NR,NZ,NY,NX)+GRTWTL + WTRT2N(N,L,NR,NZ,NY,NX)=WTRT2N(N,L,NR,NZ,NY,NX)+GRTWTN + WTRT2P(N,L,NR,NZ,NY,NX)=WTRT2P(N,L,NR,NZ,NY,NX)+GRTWTP + WSRTL(N,L,NZ,NY,NX)=WSRTL(N,L,NZ,NY,NX) + 2+AMIN1(CNWS(NZ,NY,NX)*WTRT2N(N,L,NR,NZ,NY,NX) + 2,CPWS(NZ,NY,NX)*WTRT2P(N,L,NR,NZ,NY,NX)) + RTLGL=RTLGL+RTLG2(N,L,NR,NZ,NY,NX) + WTRTX=WTRTX+WTRT2(N,L,NR,NZ,NY,NX) + RTN2X=RTFQ(NZ,NY,NX)*XRTN1 + RTN2Y=RTFQ(NZ,NY,NX)*RTN2X + RTN2(N,L,NR,NZ,NY,NX)=RTN2X+RTN2Y + RTNL(N,L,NZ,NY,NX)=RTNL(N,L,NZ,NY,NX)+RTN2(N,L,NR,NZ,NY,NX) +C IF(L.EQ.1)THEN +C WRITE(*,9876)'RCO22',I,J,NZ,NR,L,N +C 2,RCO2TM,RCO2T,RMNCR,RCO2RM,RCO2R,RCO2GM,RCO2G +C 3,RCO2XM,RCO2X,CGROR,SNCRM,SNCR,CNRDA,CPOOLR(N,L,NZ,NY,NX),FRTN +C 4,TFN4(L,NZ,NY,NX),CNPG,FDBKX(NB1(NZ,NY,NX),NZ,NY,NX),WFNGR(N,L) +C 5,TFN6(L),GRTWTG,GRTWTL,GRTLGL,RTLG2(N,L,NR,NZ,NY,NX) +C 5,WTRT2(N,L,NR,NZ,NY,NX),RTLG2(N,L,NR,NZ,NY,NX) +C 4,RCO2M(N,L,NZ,NY,NX),RCO2A(N,L,NZ,NY,NX),WFR(N,L,NZ,NY,NX) +C 8,ZPOOLR(N,L,NZ,NY,NX),PPOOLR(N,L,NZ,NY,NX) +C 9,FSNC2,RLNT(N,L),RTSK1(N,L,NR),RTSK2(N,L,NR) +C 4,RTN2X,RTN2Y,XRTN1 +C 5,RTDPL(NR,L),RTDNP(N,L,NZ,NY,NX) +C 5,RTDP1(1,NR,NZ,NY,NX),CDPTHZ(L-1,NY,NX),DLYR(3,L,NY,NX) +C 6,SDPTH(NZ,NY,NX),HTCTL(NZ,NY,NX) +C 5,WFNRG,FNP,RTLGP(N,L,NZ,NY,NX),ZADD2,PADD2,CUPRO,CUPRL +C 7,RUPNH4(N,L,NZ,NY,NX),RUPNHB(N,L,NZ,NY,NX) +C 8,RUPNO3(N,L,NZ,NY,NX),RUPNOB(N,L,NZ,NY,NX) +C 9,RUPH2P(N,L,NZ,NY,NX),RUPH2B(N,L,NZ,NY,NX) +C 6,RDFOMN(N,L,NZ,NY,NX),RDFOMP(N,L,NZ,NY,NX) +C 2,RTN1(N,L,NZ,NY,NX),RTN2(N,L,NR,NZ,NY,NX) +C 3,RTNL(N,L,NZ,NY,NX) +9876 FORMAT(A8,6I4,100E12.4) +C ENDIF +C +C PRIMARY ROOT EXTENSION +C + IF(N.EQ.1)THEN + IF(RTDP1(N,NR,NZ,NY,NX).GT.CDPTHZ(L-1,NY,NX) + 2.AND.ICHK1(N,NR).EQ.0)THEN + RTN1(N,L,NZ,NY,NX)=RTN1(N,L,NZ,NY,NX)+XRTN1 + IF(RTDP1(N,NR,NZ,NY,NX).LE.CDPTHZ(L,NY,NX))THEN + ICHK1(N,NR)=1 +C +C FRACTION OF PRIMARY ROOT SINK IN SOIL LAYER ATTRIBUTED TO CURRENT AXIS +C + IF(RLNT(N,L).GT.ZEROP(NZ,NY,NX))THEN + FRTN=RTSK1(N,L,NR)/RLNT(N,L) + ELSE + FRTN=1.0 + ENDIF +C +C WATER STRESS CONSTRAINT ON SECONDARY ROOT EXTENSION IMPOSED +C BY ROOT TURGOR AND SOIL PENETRATION RESISTANCE +C + RSCS1=RSCS(L,NY,NX)*RRAD1(N,L,NZ,NY,NX)/1.0E-03 + WFNR=AMIN1(1.0,AMAX1(0.0,PSIRG(N,L,NZ,NY,NX)-PSILM-RSCS1)) + WFNRG=WFNR**0.25 +C +C N,P CONSTRAINT ON PRIMARY ROOT RESPIRATION FROM +C NON-STRUCTURAL C:N:P +C + IF(CCPOLR(N,L,NZ,NY,NX).GT.ZERO)THEN + CNPG=AMIN1(CZPOLR(N,L,NZ,NY,NX)/(CZPOLR(N,L,NZ,NY,NX) + 2+CCPOLR(N,L,NZ,NY,NX)/CNKI),CPPOLR(N,L,NZ,NY,NX) + 3/(CPPOLR(N,L,NZ,NY,NX)+CCPOLR(N,L,NZ,NY,NX)/CPKI)) + ELSE + CNPG=1.0 + ENDIF +C +C O2-UNLIMITED PRIMARY ROOT RESPIRATION FROM ROOT NON-STRUCTURAL C +C CONSTRAINED BY TEMPERATURE AND NON-STRUCTURAL C:N:P +C + RCO2RM=AMAX1(0.0,VMXC*FRTN*CPOOLR(N,L,NZ,NY,NX) + 2*TFN4(L,NZ,NY,NX))*CNPG*FDBKX(NB1(NZ,NY,NX),NZ,NY,NX) + 3*WFNGR(N,L) +C +C O2-LIMITED PRIMARY ROOT RESPIRATION FROM 'WFR' IN 'UPTAKE' +C + RCO2R=RCO2RM*WFR(N,L,NZ,NY,NX) +C +C PRIMARY ROOT MAINTENANCE RESPIRATION FROM SOIL TEMPERATURE, +C ROOT STRUCTURAL N +C + RMNCR=AMAX1(0.0,RMPLT*RTWT1N(N,NR,NZ,NY,NX))*TFN6(L) + IF(IWTYP(NZ,NY,NX).EQ.2)THEN + RMNCR=RMNCR*WFNGR(N,L) + ENDIF + RCO2XM=RCO2RM-RMNCR + RCO2X=RCO2R-RMNCR + RCO2YM=AMAX1(0.0,RCO2XM)*WFNRG + RCO2Y=AMAX1(0.0,RCO2X)*WFNRG +C +C PRIMARY ROOT GROWTH RESPIRATION MAY BE LIMITED BY +C NON-STRUCTURAL N,P AVAILABLE FOR GROWTH +C + DMRTR=DMRTD*FRTN + ZPOOLB=AMAX1(0.0,ZPOOLR(N,L,NZ,NY,NX)) + PPOOLB=AMAX1(0.0,PPOOLR(N,L,NZ,NY,NX)) + FNP=AMIN1(ZPOOLB*DMRTR/CNRTS(NZ,NY,NX) + 2,PPOOLB*DMRTR/CPRTS(NZ,NY,NX)) + IF(RCO2YM.GT.0.0)THEN + RCO2GM=AMIN1(RCO2YM,FNP) + ELSE + RCO2GM=0.0 + ENDIF + IF(RCO2Y.GT.0.0)THEN + RCO2G=AMIN1(RCO2Y,FNP*WFR(N,L,NZ,NY,NX)) + ELSE + RCO2G=0.0 + ENDIF +C +C TOTAL NON-STRUCTURAL C,N,P USED IN PRIMARY ROOT GROWTH +C AND GROWTH RESPIRATION DEPENDS ON GROWTH YIELD +C ENTERED IN 'READQ' +C + CGRORM=RCO2GM/DMRTD + CGROR=RCO2G/DMRTD + GRTWGM=CGRORM*DMRT(NZ,NY,NX) + GRTWTG=CGROR*DMRT(NZ,NY,NX) + ZADD1M=AMAX1(0.0,GRTWGM*CNRTW) + ZADD1=AMAX1(0.0,AMIN1(FRTN*ZPOOLR(N,L,NZ,NY,NX),GRTWTG*CNRTW)) + PADD1=AMAX1(0.0,AMIN1(FRTN*PPOOLR(N,L,NZ,NY,NX),GRTWTG*CPRTW)) + CNRDM=AMAX1(0.0,1.70*ZADD1M) + CNRDA=AMAX1(0.0,1.70*ZADD1) +C +C PRIMARY ROOT GROWTH RESPIRATION FROM TOTAL - MAINTENANCE +C IF > 0 DRIVES GROWTH, IF < 0 DRIVES REMOBILIZATION, ALSO +C PRIMARY ROOT C LOSS FROM REMOBILIZATION AND CONSEQUENT LITTERFALL +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) + 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) + ELSE + CCC=0.0 + CNC=0.0 + CPC=0.0 + ENDIF + RCCC=RCCZ(IBTYP(NZ,NY,NX))+CCC*RCCY(IBTYP(NZ,NY,NX)) + RCCN=CNC*RCCX(IGTYP(NZ,NY,NX)) + RCCP=CPC*RCCQ(IGTYP(NZ,NY,NX)) + IF(-RCO2XM.GT.0.0)THEN + IF(-RCO2XM.LT.RTWT1(N,NR,NZ,NY,NX)*RCCC)THEN + SNCRM=-RCO2XM + ELSE + SNCRM=AMAX1(0.0,RTWT1(N,NR,NZ,NY,NX)*RCCC) + ENDIF + ELSE + SNCRM=0.0 + ENDIF + IF(-RCO2X.GT.0.0)THEN + IF(-RCO2X.LT.RTWT1(N,NR,NZ,NY,NX)*RCCC)THEN + SNCR=-RCO2X + ELSE + SNCR=AMAX1(0.0,RTWT1(N,NR,NZ,NY,NX)*RCCC) + 2*WFR(N,L,NZ,NY,NX) + ENDIF + ELSE + SNCR=0.0 + ENDIF +C +C RECOVERY OF REMOBILIZABLE N,P DURING PRIMARY ROOT REMOBILIZATION +C DEPENDS ON ROOT NON-STRUCTURAL C:N:P +C + IF(SNCR.GT.0.0.AND.RTWT1(N,NR,NZ,NY,NX) + 2.GT.ZEROP(NZ,NY,NX))THEN + RCCR=RCCC*RTWT1(N,NR,NZ,NY,NX) + RCZR=RTWT1N(N,NR,NZ,NY,NX)*(RCCN+(1.0-RCCN) + 2*RCCR/RTWT1(N,NR,NZ,NY,NX)) + RCPR=RTWT1P(N,NR,NZ,NY,NX)*(RCCP+(1.0-RCCP) + 2*RCCR/RTWT1(N,NR,NZ,NY,NX)) + IF(RCCR.GT.ZEROP(NZ,NY,NX))THEN + FSNC1=AMAX1(0.0,AMIN1(1.0,SNCR/RCCR)) + ELSE + FSNC1=1.0 + ENDIF + ELSE + RCCR=0.0 + RCZR=0.0 + RCPR=0.0 + FSNC1=0.0 + ENDIF +C +C PRIMARY ROOT LITTERFALL CAUSED BY REMOBILIZATION +C + DO 6355 M=1,4 + CSNC(M,0,L,NZ,NY,NX)=CSNC(M,0,L,NZ,NY,NX)+CFOPC(5,M,NZ,NY,NX) + 2*FSNC1*(RTWT1(N,NR,NZ,NY,NX)-RCCR)*FWOOD(0) + ZSNC(M,0,L,NZ,NY,NX)=ZSNC(M,0,L,NZ,NY,NX)+CFOPN(5,M,NZ,NY,NX) + 2*FSNC1*(RTWT1N(N,NR,NZ,NY,NX)-RCZR)*FWOODN(0) + PSNC(M,0,L,NZ,NY,NX)=PSNC(M,0,L,NZ,NY,NX)+CFOPP(5,M,NZ,NY,NX) + 2*FSNC1*(RTWT1P(N,NR,NZ,NY,NX)-RCPR)*FWOODP(0) + CSNC(M,1,L,NZ,NY,NX)=CSNC(M,1,L,NZ,NY,NX)+CFOPC(4,M,NZ,NY,NX) + 2*FSNC1*(RTWT1(N,NR,NZ,NY,NX)-RCCR)*FWOOD(1) + ZSNC(M,1,L,NZ,NY,NX)=ZSNC(M,1,L,NZ,NY,NX)+CFOPN(4,M,NZ,NY,NX) + 2*FSNC1*(RTWT1N(N,NR,NZ,NY,NX)-RCZR)*FWOODN(1) + PSNC(M,1,L,NZ,NY,NX)=PSNC(M,1,L,NZ,NY,NX)+CFOPP(4,M,NZ,NY,NX) + 2*FSNC1*(RTWT1P(N,NR,NZ,NY,NX)-RCPR)*FWOODP(1) +6355 CONTINUE +C +C CONSUMPTION OF NON-STRUCTURAL C,N,P BY PRIMARY ROOTS +C + CPOOLR(N,L,NZ,NY,NX)=CPOOLR(N,L,NZ,NY,NX)-AMIN1(RMNCR,RCO2R) + 2-CGROR-CNRDA-SNCR+FSNC1*RCCR + ZPOOLR(N,L,NZ,NY,NX)=ZPOOLR(N,L,NZ,NY,NX)-ZADD1+FSNC1*RCZR + PPOOLR(N,L,NZ,NY,NX)=PPOOLR(N,L,NZ,NY,NX)-PADD1+FSNC1*RCPR +C +C TOTAL PRIMARY ROOT RESPIRATION +C + RCO2TM=AMIN1(RMNCR,RCO2RM)+RCO2GM+SNCRM+CNRDM + RCO2T=AMIN1(RMNCR,RCO2R)+RCO2G+SNCR+CNRDA +C +C ALLOCATE PRIMARY ROOT TOTAL RESPIRATION TO ALL SOIL LAYERS +C THROUGH WHICH PRIMARY ROOTS GROW +C + IF(RTDP1(N,NR,NZ,NY,NX).GT.CDPTHZ(NG(NZ,NY,NX),NY,NX))THEN + DO 5100 LL=NG(NZ,NY,NX),NINR(NR,NZ,NY,NX) + FRCO2=RTLG1(N,LL,NR,NZ,NY,NX)/(RTDP1(N,NR,NZ,NY,NX) + 2-SDPTH(NZ,NY,NX)) + RCO2M(N,LL,NZ,NY,NX)=RCO2M(N,LL,NZ,NY,NX)+RCO2TM*FRCO2 + RCO2N(N,LL,NZ,NY,NX)=RCO2N(N,LL,NZ,NY,NX)+RCO2T*FRCO2 + RCO2A(N,LL,NZ,NY,NX)=RCO2A(N,LL,NZ,NY,NX)-RCO2T*FRCO2 +5100 CONTINUE + ELSE + RCO2M(N,L,NZ,NY,NX)=RCO2M(N,L,NZ,NY,NX)+RCO2TM + RCO2N(N,L,NZ,NY,NX)=RCO2N(N,L,NZ,NY,NX)+RCO2T + RCO2A(N,L,NZ,NY,NX)=RCO2A(N,L,NZ,NY,NX)-RCO2T + ENDIF +C +C ALLOCATE ANY NEGATIVE PRIMARY ROOT C,N,P GROWTH TO SECONDARY +C ROOTS ON THE SAME AXIS IN THE SAME LAYER UNTIL SECONDARY ROOTS +C HAVE DISAPPEARED +C + GRTWTL=GRTWTG-FSNC1*RTWT1(N,NR,NZ,NY,NX) + GRTWTN=ZADD1-FSNC1*RTWT1N(N,NR,NZ,NY,NX) + GRTWTP=PADD1-FSNC1*RTWT1P(N,NR,NZ,NY,NX) + IF(GRTWTL.LT.0.0)THEN + LX=MAX(1,L-1) + DO 5105 LL=L,LX,-1 + GRTWTM=GRTWTL + IF(GRTWTL.LT.0.0)THEN + IF(GRTWTL.GT.-WTRT2(N,LL,NR,NZ,NY,NX))THEN + RTLG2(N,LL,NR,NZ,NY,NX)=RTLG2(N,LL,NR,NZ,NY,NX)+GRTWTL + 2*RTLG2(N,LL,NR,NZ,NY,NX)/WTRT2(N,LL,NR,NZ,NY,NX) + WTRT2(N,LL,NR,NZ,NY,NX)=WTRT2(N,LL,NR,NZ,NY,NX)+GRTWTL + GRTWTL=0.0 + ELSE + GRTWTL=GRTWTL+WTRT2(N,LL,NR,NZ,NY,NX) + RTLG2(N,LL,NR,NZ,NY,NX)=0.0 + WTRT2(N,LL,NR,NZ,NY,NX)=0.0 + ENDIF + ENDIF + IF(GRTWTN.LT.0.0)THEN + IF(GRTWTN.GT.-WTRT2N(N,LL,NR,NZ,NY,NX))THEN + WTRT2N(N,LL,NR,NZ,NY,NX)=WTRT2N(N,LL,NR,NZ,NY,NX)+GRTWTN + GRTWTN=0.0 + ELSE + GRTWTN=GRTWTN+WTRT2N(N,LL,NR,NZ,NY,NX) + WTRT2N(N,LL,NR,NZ,NY,NX)=0.0 + ENDIF + ENDIF + IF(GRTWTP.LT.0.0)THEN + IF(GRTWTP.GT.-WTRT2P(N,LL,NR,NZ,NY,NX))THEN + WTRT2P(N,LL,NR,NZ,NY,NX)=WTRT2P(N,LL,NR,NZ,NY,NX)+GRTWTP + GRTWTP=0.0 + ELSE + GRTWTP=GRTWTP+WTRT2P(N,LL,NR,NZ,NY,NX) + WTRT2P(N,LL,NR,NZ,NY,NX)=0.0 + ENDIF + ENDIF +C WRITE(*,9876)'WTRT2',I,J,NZ,NR,LL,N +C 2,GRTWTL,GRTWTM,GRTWTG,FSNC1,SNCR,RCCR,RTWT1(N,NR,NZ,NY,NX) +C 3,WTRT2(1,LL,NR,NZ,NY,NX),WTRTL(1,LL,NZ,NY,NX) +C 3,WTRT2(2,LL,NR,NZ,NY,NX),WTRTL(2,LL,NZ,NY,NX) +C 4,RTLG2(1,LL,NR,NZ,NY,NX),RTLG1(1,LL,NR,NZ,NY,NX) +C 4,RTLG2(2,LL,NR,NZ,NY,NX),RTLG1(2,LL,NR,NZ,NY,NX) +C +C CONCURRENT LOSS OF MYCORRHIZAE AND NODULES +C + IF(GRTWTM.LT.0.0)THEN + IF(WTRT2(1,LL,NR,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + FSNCM=AMIN1(1.0,ABS(GRTWTM)/WTRT2(1,LL,NR,NZ,NY,NX)) + ELSE + FSNCM=1.0 + ENDIF + IF(WTRTL(1,LL,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + FSNCP=AMIN1(1.0,ABS(GRTWTM)/WTRTL(1,LL,NZ,NY,NX)) + ELSE + FSNCP=1.0 + ENDIF + DO 6450 M=1,4 + CSNC(M,0,LL,NZ,NY,NX)=CSNC(M,0,LL,NZ,NY,NX)+CFOPC(5,M,NZ,NY,NX) + 2*FSNCM*AMAX1(0.0,WTRT2(2,LL,NR,NZ,NY,NX))*FWOOD(0) + ZSNC(M,0,LL,NZ,NY,NX)=ZSNC(M,0,LL,NZ,NY,NX)+CFOPN(5,M,NZ,NY,NX) + 2*FSNCM*AMAX1(0.0,WTRT2N(2,LL,NR,NZ,NY,NX))*FWOODN(0) + PSNC(M,0,LL,NZ,NY,NX)=PSNC(M,0,LL,NZ,NY,NX)+CFOPP(5,M,NZ,NY,NX) + 2*FSNCM*AMAX1(0.0,WTRT2P(2,LL,NR,NZ,NY,NX))*FWOODP(0) + CSNC(M,1,LL,NZ,NY,NX)=CSNC(M,1,LL,NZ,NY,NX)+CFOPC(4,M,NZ,NY,NX) + 2*FSNCM*AMAX1(0.0,WTRT2(2,LL,NR,NZ,NY,NX))*FWOOD(1) + ZSNC(M,1,LL,NZ,NY,NX)=ZSNC(M,1,LL,NZ,NY,NX)+CFOPN(4,M,NZ,NY,NX) + 2*FSNCM*AMAX1(0.0,WTRT2N(2,LL,NR,NZ,NY,NX))*FWOODN(1) + PSNC(M,1,LL,NZ,NY,NX)=PSNC(M,1,LL,NZ,NY,NX)+CFOPP(4,M,NZ,NY,NX) + 2*FSNCM*AMAX1(0.0,WTRT2P(2,LL,NR,NZ,NY,NX))*FWOODP(1) + CSNC(M,1,LL,NZ,NY,NX)=CSNC(M,1,LL,NZ,NY,NX)+CFOPC(0,M,NZ,NY,NX) + 2*FSNCP*AMAX1(0.0,CPOOLR(2,LL,NZ,NY,NX)) + ZSNC(M,1,LL,NZ,NY,NX)=ZSNC(M,1,LL,NZ,NY,NX)+CFOPN(0,M,NZ,NY,NX) + 2*FSNCP*AMAX1(0.0,ZPOOLR(2,LL,NZ,NY,NX)) + PSNC(M,1,LL,NZ,NY,NX)=PSNC(M,1,LL,NZ,NY,NX)+CFOPP(0,M,NZ,NY,NX) + 2*FSNCP*AMAX1(0.0,PPOOLR(2,LL,NZ,NY,NX)) +6450 CONTINUE + RTLG2(2,LL,NR,NZ,NY,NX)=AMAX1(0.0,RTLG2(2,LL,NR,NZ,NY,NX)) + 2*(1.0-FSNCM) + WTRT2(2,LL,NR,NZ,NY,NX)=AMAX1(0.0,WTRT2(2,LL,NR,NZ,NY,NX)) + 2*(1.0-FSNCM) + WTRT2N(2,LL,NR,NZ,NY,NX)=AMAX1(0.0,WTRT2N(2,LL,NR,NZ,NY,NX)) + 2*(1.0-FSNCM) + WTRT2P(2,LL,NR,NZ,NY,NX)=AMAX1(0.0,WTRT2P(2,LL,NR,NZ,NY,NX)) + 2*(1.0-FSNCM) + CPOOLR(2,LL,NZ,NY,NX)=AMAX1(0.0,CPOOLR(2,LL,NZ,NY,NX)) + 2*(1.0-FSNCP) + ZPOOLR(2,LL,NZ,NY,NX)=AMAX1(0.0,ZPOOLR(2,LL,NZ,NY,NX)) + 2*(1.0-FSNCP) + PPOOLR(2,LL,NZ,NY,NX)=AMAX1(0.0,PPOOLR(2,LL,NZ,NY,NX)) + 2*(1.0-FSNCP) + ENDIF +5105 CONTINUE + ENDIF +C +C PRIMARY ROOT EXTENSION FROM ROOT GROWTH AND ROOT TURGOR +C + IF(GRTWTL.LT.0.0.AND.RTWT1(N,NR,NZ,NY,NX) + 2.GT.ZEROP(NZ,NY,NX))THEN + GRTLGL=GRTWTG*RTLG1X(N,NZ,NY,NX)/PP(NZ,NY,NX)*WFNR*FWOOD(1) + 2+GRTWTL*(RTDP1(N,NR,NZ,NY,NX)-SDPTH(NZ,NY,NX)) + 3/RTWT1(N,NR,NZ,NY,NX) + ELSE + GRTLGL=GRTWTG*RTLG1X(N,NZ,NY,NX)/PP(NZ,NY,NX)*WFNR*FWOOD(1) + ENDIF + IF(L.LT.NJ(NY,NX))THEN + GRTLGL=AMIN1(DLYR(3,L+1,NY,NX),GRTLGL) + ENDIF +C +C ALLOCATE PRIMARY ROOT GROWTH TO CURRENT +C AND NEXT SOIL LAYER WHEN PRIMARY ROOTS EXTEND ACROSS LOWER +C BOUNDARY OF CURRENT LAYER +C + IF(GRTLGL.GT.ZEROP(NZ,NY,NX).AND.L.LT.NJ(NY,NX))THEN + FGROL=AMAX1(0.0,AMIN1(1.0,(CDPTHZ(L,NY,NX) + 2-RTDP1(N,NR,NZ,NY,NX))/GRTLGL)) + IF(FGROL.LT.1.0)FGROL=0.0 + FGROZ=AMAX1(0.0,1.0-FGROL) + ELSE + FGROL=1.0 + FGROZ=0.0 + ENDIF +C +C UPDATE STATE VARIABLES FOR PRIMARY ROOT LENGTH, GROWTH +C AND AXIS NUMBER +C + RTWT1(N,NR,NZ,NY,NX)=RTWT1(N,NR,NZ,NY,NX)+GRTWTL + RTWT1N(N,NR,NZ,NY,NX)=RTWT1N(N,NR,NZ,NY,NX)+GRTWTN + RTWT1P(N,NR,NZ,NY,NX)=RTWT1P(N,NR,NZ,NY,NX)+GRTWTP + RTDP1(N,NR,NZ,NY,NX)=RTDP1(N,NR,NZ,NY,NX)+GRTLGL + WTRT1(N,L,NR,NZ,NY,NX)=WTRT1(N,L,NR,NZ,NY,NX)+GRTWTL*FGROL + WTRT1N(N,L,NR,NZ,NY,NX)=WTRT1N(N,L,NR,NZ,NY,NX)+GRTWTN*FGROL + WTRT1P(N,L,NR,NZ,NY,NX)=WTRT1P(N,L,NR,NZ,NY,NX)+GRTWTP*FGROL + WSRTL(N,L,NZ,NY,NX)=WSRTL(N,L,NZ,NY,NX) + 2+AMIN1(CNWS(NZ,NY,NX)*WTRT1N(N,L,NR,NZ,NY,NX) + 2,CPWS(NZ,NY,NX)*WTRT1P(N,L,NR,NZ,NY,NX)) + RTLG1(N,L,NR,NZ,NY,NX)=RTLG1(N,L,NR,NZ,NY,NX)+GRTLGL*FGROL +C +C TRANSFER C,N,P INTO NEXT SOIL LAYER +C WHEN PRIMARY ROOT EXTENDS ACROSS LOWER BOUNDARY +C OF CURRENT SOIL LAYER +C + IF(FGROZ.GT.0.0)THEN + WTRT1(N,L+1,NR,NZ,NY,NX)=WTRT1(N,L+1,NR,NZ,NY,NX) + 2+GRTWTL*FGROZ + WTRT1N(N,L+1,NR,NZ,NY,NX)=WTRT1N(N,L+1,NR,NZ,NY,NX) + 2+GRTWTN*FGROZ + WTRT1P(N,L+1,NR,NZ,NY,NX)=WTRT1P(N,L+1,NR,NZ,NY,NX) + 2+GRTWTP*FGROZ + WSRTL(N,L+1,NZ,NY,NX)=WSRTL(N,L+1,NZ,NY,NX) + 2+AMIN1(CNWS(NZ,NY,NX)*WTRT1N(N,L+1,NR,NZ,NY,NX) + 2,CPWS(NZ,NY,NX)*WTRT1P(N,L+1,NR,NZ,NY,NX)) + WTRTD(N,L+1,NZ,NY,NX)=WTRTD(N,L+1,NZ,NY,NX) + 2+WTRT1(N,L+1,NR,NZ,NY,NX) + RTLG1(N,L+1,NR,NZ,NY,NX)=RTLG1(N,L+1,NR,NZ,NY,NX)+GRTLGL*FGROZ + RRAD1(N,L+1,NZ,NY,NX)=RRAD1(N,L,NZ,NY,NX) + RTLGZ=RTLGZ+RTLG1(N,L+1,NR,NZ,NY,NX) + WTRTZ=WTRTZ+WTRT1(N,L+1,NR,NZ,NY,NX) + XFRC=FRTN*CPOOLR(N,L,NZ,NY,NX) + XFRN=FRTN*ZPOOLR(N,L,NZ,NY,NX) + XFRP=FRTN*PPOOLR(N,L,NZ,NY,NX) + CPOOLR(N,L,NZ,NY,NX)=CPOOLR(N,L,NZ,NY,NX)-XFRC + ZPOOLR(N,L,NZ,NY,NX)=ZPOOLR(N,L,NZ,NY,NX)-XFRN + PPOOLR(N,L,NZ,NY,NX)=PPOOLR(N,L,NZ,NY,NX)-XFRP + CPOOLR(N,L+1,NZ,NY,NX)=CPOOLR(N,L+1,NZ,NY,NX)+XFRC + ZPOOLR(N,L+1,NZ,NY,NX)=ZPOOLR(N,L+1,NZ,NY,NX)+XFRN + PPOOLR(N,L+1,NZ,NY,NX)=PPOOLR(N,L+1,NZ,NY,NX)+XFRP + PSIRT(N,L+1,NZ,NY,NX)=PSIRT(N,L,NZ,NY,NX) + PSIRO(N,L+1,NZ,NY,NX)=PSIRO(N,L,NZ,NY,NX) + PSIRG(N,L+1,NZ,NY,NX)=PSIRG(N,L,NZ,NY,NX) + NINR(NR,NZ,NY,NX)=MAX(NG(NZ,NY,NX),L+1) +C WRITE(*,9877)'INFIL',I,J,NZ,NR,L,N,NINR(NR,NZ,NY,NX) +C 2,FRTN,WTRTD(N,L+1,NZ,NY,NX),CPOOLR(N,L+1,NZ,NY,NX) +C 2,FGROZ,RTDP1(N,NR,NZ,NY,NX),GRTLGL,CDPTHZ(L,NY,NX) + ENDIF +C IF((I/10)*10.EQ.I.AND.J.EQ.14.AND.NZ.EQ.1)THEN +C WRITE(*,9877)'RCO21',I,J,NZ,NR,L,N,NINR(NR,NZ,NY,NX) +C 2,RCO2TM,RCO2T,RMNCR,RCO2RM,RCO2R,RCO2GM,RCO2G +C 3,RCO2XM,RCO2X,CGROR,SNCRM,SNCR,CNRDA,CPOOLR(N,L,NZ,NY,NX),FRTN +C 4,TFN4(L,NZ,NY,NX),CNPG,FDBKX(NB1(NZ,NY,NX),NZ,NY,NX),WFNGR(N,L) +C 5,TFN6(L),GRTWTG,GRTWTL,GRTLGL,RTWT1N(N,NR,NZ,NY,NX) +C 6,WTRT1(N,L,NR,NZ,NY,NX),RTDP1(N,NR,NZ,NY,NX) +C 3,RCO2M(N,L,NZ,NY,NX),RCO2A(N,L,NZ,NY,NX),WFR(N,L,NZ,NY,NX) +C 4,RTSK1(N,L,NR),RRAD1(N,L,NZ,NY,NX),RTDPP +C 5,PSIRG(N,L,NZ,NY,NX),WFNR,WFNRG,FWOOD(1) +C 6,RTDP1(N,NR,NZ,NY,NX),FGROZ,RTWT1(N,NR,NZ,NY,NX),FSNC1 +C 9,ZADD1,PADD1,ZPOOLR(N,L,NZ,NY,NX),PPOOLR(N,L,NZ,NY,NX) +C 1,RUPNH4(N,L,NZ,NY,NX),RUPNO3(N,L,NZ,NY,NX) +9877 FORMAT(A8,7I4,100E12.4) +C ENDIF + ENDIF +C +C TRANSFER PRIMARY ROOT C,N,P TO NEXT SOIL LAYER ABOVE THE +C CURRENT SOIL LAYER WHEN NEGATIVE PRIMARY ROOT GROWTH FORCES +C WITHDRAWAL FROM THE CURRENT SOIL LAYER AND ALL SECONDARY ROOTS +C IN THE CURRENT SOIL LAYER HAVE BEEN LOST +C + IF(L.EQ.NINR(NR,NZ,NY,NX))THEN + DO 5115 LL=L,NG(NZ,NY,NX)+1,-1 + IF(RTDP1(N,NR,NZ,NY,NX).LT.CDPTHZ(LL-1,NY,NX) + 2.OR.RTDP1(N,NR,NZ,NY,NX).LT.SDPTH(NZ,NY,NX))THEN + IF(RLNT(N,LL).GT.ZEROP(NZ,NY,NX))THEN + FRTN=(RTSK1(N,LL,NR)+RTSK2(N,LL,NR))/RLNT(N,LL) + ELSE + FRTN=1.0 + ENDIF + DO 5110 NN=1,MY(NZ,NY,NX) + WTRT1(NN,LL-1,NR,NZ,NY,NX)=WTRT1(NN,LL-1,NR,NZ,NY,NX) + 2+WTRT1(NN,LL,NR,NZ,NY,NX) + WTRT1N(NN,LL-1,NR,NZ,NY,NX)=WTRT1N(NN,LL-1,NR,NZ,NY,NX) + 2+WTRT1N(NN,LL,NR,NZ,NY,NX) + WTRT1P(NN,LL-1,NR,NZ,NY,NX)=WTRT1P(NN,LL-1,NR,NZ,NY,NX) + 2+WTRT1P(NN,LL,NR,NZ,NY,NX) + WTRT2(NN,LL-1,NR,NZ,NY,NX)=WTRT2(NN,LL-1,NR,NZ,NY,NX) + 2+WTRT2(NN,LL,NR,NZ,NY,NX) + WTRT2N(NN,LL-1,NR,NZ,NY,NX)=WTRT2N(NN,LL-1,NR,NZ,NY,NX) + 2+WTRT2N(NN,LL,NR,NZ,NY,NX) + WTRT2P(NN,LL-1,NR,NZ,NY,NX)=WTRT2P(NN,LL-1,NR,NZ,NY,NX) + 2+WTRT2P(NN,LL,NR,NZ,NY,NX) + RTLG1(NN,LL-1,NR,NZ,NY,NX)=RTLG1(NN,LL-1,NR,NZ,NY,NX) + 2+RTLG1(NN,LL,NR,NZ,NY,NX) + WTRT1(NN,LL,NR,NZ,NY,NX)=0.0 + WTRT1N(NN,LL,NR,NZ,NY,NX)=0.0 + WTRT1P(NN,LL,NR,NZ,NY,NX)=0.0 + WTRT2(NN,LL,NR,NZ,NY,NX)=0.0 + WTRT2N(NN,LL,NR,NZ,NY,NX)=0.0 + WTRT2P(NN,LL,NR,NZ,NY,NX)=0.0 + RTLG1(NN,LL,NR,NZ,NY,NX)=0.0 + XFRC=FRTN*CPOOLR(NN,LL,NZ,NY,NX) + XFRN=FRTN*ZPOOLR(NN,LL,NZ,NY,NX) + XFRP=FRTN*PPOOLR(NN,LL,NZ,NY,NX) + XFRW=FRTN*WSRTL(NN,L,NZ,NY,NX) + XFRD=FRTN*WTRTD(NN,LL,NZ,NY,NX) + CPOOLR(NN,LL,NZ,NY,NX)=CPOOLR(NN,LL,NZ,NY,NX)-XFRC + ZPOOLR(NN,LL,NZ,NY,NX)=ZPOOLR(NN,LL,NZ,NY,NX)-XFRN + PPOOLR(NN,LL,NZ,NY,NX)=PPOOLR(NN,LL,NZ,NY,NX)-XFRP + WSRTL(NN,LL,NZ,NY,NX)=WSRTL(NN,LL,NZ,NY,NX)-XFRW + WTRTD(NN,LL,NZ,NY,NX)=WTRTD(NN,LL,NZ,NY,NX)-XFRD + CPOOLR(NN,LL-1,NZ,NY,NX)=CPOOLR(NN,LL-1,NZ,NY,NX)+XFRC + ZPOOLR(NN,LL-1,NZ,NY,NX)=ZPOOLR(NN,LL-1,NZ,NY,NX)+XFRN + PPOOLR(NN,LL-1,NZ,NY,NX)=PPOOLR(NN,LL-1,NZ,NY,NX)+XFRP + WSRTL(NN,LL-1,NZ,NY,NX)=WSRTL(NN,LL-1,NZ,NY,NX)+XFRW + WTRTD(NN,LL-1,NZ,NY,NX)=WTRTD(NN,LL-1,NZ,NY,NX)+XFRD +C +C WITHDRAW GASES IN PRIMARY ROOTS +C + RCO2Z(NZ,NY,NX)=RCO2Z(NZ,NY,NX)-FRTN*(CO2A(NN,LL,NZ,NY,NX) + 2+CO2P(NN,LL,NZ,NY,NX)) + ROXYZ(NZ,NY,NX)=ROXYZ(NZ,NY,NX)-FRTN*(OXYA(NN,LL,NZ,NY,NX) + 2+OXYP(NN,LL,NZ,NY,NX)) + RCH4Z(NZ,NY,NX)=RCH4Z(NZ,NY,NX)-FRTN*(CH4A(NN,LL,NZ,NY,NX) + 2+CH4P(NN,LL,NZ,NY,NX)) + RN2OZ(NZ,NY,NX)=RN2OZ(NZ,NY,NX)-FRTN*(Z2OA(NN,LL,NZ,NY,NX) + 2+Z2OP(NN,LL,NZ,NY,NX)) + RNH3Z(NZ,NY,NX)=RNH3Z(NZ,NY,NX)-FRTN*(ZH3A(NN,LL,NZ,NY,NX) + 2+ZH3P(NN,LL,NZ,NY,NX)) + RH2GZ(NZ,NY,NX)=RH2GZ(NZ,NY,NX)-FRTN*(H2GA(NN,LL,NZ,NY,NX) + 2+H2GP(NN,LL,NZ,NY,NX)) + CO2A(NN,LL,NZ,NY,NX)=(1.0-FRTN)*CO2A(NN,LL,NZ,NY,NX) + OXYA(NN,LL,NZ,NY,NX)=(1.0-FRTN)*OXYA(NN,LL,NZ,NY,NX) + CH4A(NN,LL,NZ,NY,NX)=(1.0-FRTN)*CH4A(NN,LL,NZ,NY,NX) + Z2OA(NN,LL,NZ,NY,NX)=(1.0-FRTN)*Z2OA(NN,LL,NZ,NY,NX) + ZH3A(NN,LL,NZ,NY,NX)=(1.0-FRTN)*ZH3A(NN,LL,NZ,NY,NX) + H2GA(NN,LL,NZ,NY,NX)=(1.0-FRTN)*H2GA(NN,LL,NZ,NY,NX) + CO2P(NN,LL,NZ,NY,NX)=(1.0-FRTN)*CO2P(NN,LL,NZ,NY,NX) + OXYP(NN,LL,NZ,NY,NX)=(1.0-FRTN)*OXYP(NN,LL,NZ,NY,NX) + CH4P(NN,LL,NZ,NY,NX)=(1.0-FRTN)*CH4P(NN,LL,NZ,NY,NX) + Z2OP(NN,LL,NZ,NY,NX)=(1.0-FRTN)*Z2OP(NN,LL,NZ,NY,NX) + ZH3P(NN,LL,NZ,NY,NX)=(1.0-FRTN)*ZH3P(NN,LL,NZ,NY,NX) + H2GP(NN,LL,NZ,NY,NX)=(1.0-FRTN)*H2GP(NN,LL,NZ,NY,NX) +C IF(NZ.EQ.1.OR.NZ.EQ.4)THEN +C WRITE(*,9868)'WITHDR',I,J,NZ,NR,LL,NN,NINR(NR,NZ,NY,NX) +C 2,FRTN,RTSK1(N,LL,NR),RTSK2(N,LL,NR),RLNT(N,LL) +C 2,WTRTD(NN,LL-1,NZ,NY,NX),WTRTD(NN,LL,NZ,NY,NX) +C 2,RTLG1(NN,LL-1,NR,NZ,NY,NX),RTLG1(NN,LL,NR,NZ,NY,NX) +C 2,RTLG2(NN,LL-1,NR,NZ,NY,NX),RTLG2(NN,LL,NR,NZ,NY,NX) +C 3,RTDP1(N,NR,NZ,NY,NX),RTDP1(NN,NR,NZ,NY,NX) +C 4,CPOOLR(NN,LL-1,NZ,NY,NX),CPOOLR(NN,LL,NZ,NY,NX) +C 4,WTRT1(NN,LL-1,NR,NZ,NY,NX),WTRT1(NN,LL,NR,NZ,NY,NX) +C 4,WTRT2(NN,LL-1,NR,NZ,NY,NX),WTRT2(NN,LL,NR,NZ,NY,NX) +9868 FORMAT(A8,7I4,100E24.16) +C ENDIF +5110 CONTINUE + RTNL(N,LL,NZ,NY,NX)=RTNL(N,LL,NZ,NY,NX) + 2-RTN2(N,LL,NR,NZ,NY,NX) + RTNL(N,LL-1,NZ,NY,NX)=RTNL(N,LL-1,NZ,NY,NX) + 2+RTN2(N,LL,NR,NZ,NY,NX) + RTN2(N,LL,NR,NZ,NY,NX)=0.0 + RTN1(N,LL,NZ,NY,NX)=RTN1(N,LL,NZ,NY,NX)-XRTN1 +C +C RESET PRIMARY ROOT LENGTH +C + IF(LL-1.GT.NG(NZ,NY,NX))THEN + RTLG1(N,LL-1,NR,NZ,NY,NX)=DLYR(3,LL-1,NY,NX) + 2-(CDPTHZ(LL-1,NY,NX)-RTDP1(N,NR,NZ,NY,NX)) + ELSE + RTLG1(N,LL-1,NR,NZ,NY,NX)=DLYR(3,LL-1,NY,NX) + 2-(CDPTHZ(LL-1,NY,NX)-RTDP1(N,NR,NZ,NY,NX)) + 3-(SDPTH(NZ,NY,NX)-CDPTHZ(LL-2,NY,NX)) + ENDIF +C +C REMOBILIZE C,N,P FROM ROOT NODULES IN LEGUMES +C + IF(INTYP(NZ,NY,NX).EQ.1.OR.INTYP(NZ,NY,NX).EQ.2)THEN + XFRC=FRTN*WTNDL(LL,NZ,NY,NX) + XFRN=FRTN*WTNDLN(LL,NZ,NY,NX) + XFRP=FRTN*WTNDLP(LL,NZ,NY,NX) + WTNDL(LL,NZ,NY,NX)=WTNDL(LL,NZ,NY,NX)-XFRC + WTNDLN(LL,NZ,NY,NX)=WTNDLN(LL,NZ,NY,NX)-XFRN + WTNDLP(LL,NZ,NY,NX)=WTNDLP(LL,NZ,NY,NX)-XFRP + WTNDL(LL-1,NZ,NY,NX)=WTNDL(LL-1,NZ,NY,NX)+XFRC + WTNDLN(LL-1,NZ,NY,NX)=WTNDLN(LL-1,NZ,NY,NX)+XFRN + WTNDLP(LL-1,NZ,NY,NX)=WTNDLP(LL-1,NZ,NY,NX)+XFRP + XFRC=FRTN*CPOOLN(LL,NZ,NY,NX) + XFRN=FRTN*ZPOOLN(LL,NZ,NY,NX) + XFRP=FRTN*PPOOLN(LL,NZ,NY,NX) + CPOOLN(LL,NZ,NY,NX)=CPOOLN(LL,NZ,NY,NX)-XFRC + ZPOOLN(LL,NZ,NY,NX)=ZPOOLN(LL,NZ,NY,NX)-XFRN + PPOOLN(LL,NZ,NY,NX)=PPOOLN(LL,NZ,NY,NX)-XFRP + CPOOLN(LL-1,NZ,NY,NX)=CPOOLN(LL-1,NZ,NY,NX)+XFRC + ZPOOLN(LL-1,NZ,NY,NX)=ZPOOLN(LL-1,NZ,NY,NX)+XFRN + PPOOLN(LL-1,NZ,NY,NX)=PPOOLN(LL-1,NZ,NY,NX)+XFRP +C WRITE(*,9868)'WITHDRN',I,J,NZ,NR,LL,NN,NINR(NR,NZ,NY,NX) +C 2,WTNDL(LL,NZ,NY,NX),CPOOLN(LL,NZ,NY,NX),RTDP1(N,NR,NZ,NY,NX) + ENDIF + NINR(NR,NZ,NY,NX)=MAX(NG(NZ,NY,NX),LL-1) + ELSE + GO TO 5120 + ENDIF +5115 CONTINUE + ENDIF +5120 CONTINUE + IF(WTRT1(N,L,NR,NZ,NY,NX).LT.0.0)THEN + CPOOLR(N,L,NZ,NY,NX)=CPOOLR(N,L,NZ,NY,NX)+WTRT1(N,L,NR,NZ,NY,NX) + WTRT1(N,L,NR,NZ,NY,NX)=0.0 + ENDIF + IF(WTRT2(N,L,NR,NZ,NY,NX).LT.0.0)THEN + CPOOLR(N,L,NZ,NY,NX)=CPOOLR(N,L,NZ,NY,NX)+WTRT2(N,L,NR,NZ,NY,NX) + WTRT2(N,L,NR,NZ,NY,NX)=0.0 + ENDIF +C +C TOTAL ROOT LENGTH AND MASS +C + RTLGZ=RTLGZ+RTLG1(N,L,NR,NZ,NY,NX) + WTRTZ=WTRTZ+WTRT1(N,L,NR,NZ,NY,NX) + NINR(NR,NZ,NY,NX)=MIN(NINR(NR,NZ,NY,NX),NJ(NY,NX)) + IF(L.EQ.NINR(NR,NZ,NY,NX))NRX(N,NR)=1 + ENDIF + ENDIF + RTLGZ=RTLGZ+RTLG1(N,L,NR,NZ,NY,NX) + WTRTZ=WTRTZ+WTRT1(N,L,NR,NZ,NY,NX) +C ENDIF + ENDIF + NIX(NZ,NY,NX)=MAX(NIX(NZ,NY,NX),NINR(NR,NZ,NY,NX)) +5050 CONTINUE +C +C DRAW FROM ROOT NON-STRUCTURAL POOL WHEN +C SEASONAL STORAGE POOL IS DEPLETED +C + IF(L.LE.NIX(NZ,NY,NX))THEN + IF(WTRTL(N,L,NZ,NY,NX).GT.ZEROP(NZ,NY,NX) + 2.AND.WTRT(NZ,NY,NX).GT.ZEROP(NZ,NY,NX) + 2.AND.WTRVC(NZ,NY,NX).LT.XFRX*WTRT(NZ,NY,NX))THEN + FWTRT=WTRTL(N,L,NZ,NY,NX)/WTRT(NZ,NY,NX) + WTRTLX=WTRTL(N,L,NZ,NY,NX) + WTRTTX=WTRT(NZ,NY,NX)*FWTRT + WTRTTT=WTRTLX+WTRTTX + CPOOLX=AMAX1(0.0,CPOOLR(N,L,NZ,NY,NX)) + WTRVCX=AMAX1(0.0,WTRVC(NZ,NY,NX)*FWTRT) + CPOOLD=(WTRVCX*WTRTLX-CPOOLX*WTRTTX)/WTRTTT + XFRC=AMIN1(0.0,XFRY*CPOOLD) + CPOOLR(N,L,NZ,NY,NX)=CPOOLR(N,L,NZ,NY,NX)+XFRC + WTRVC(NZ,NY,NX)=WTRVC(NZ,NY,NX)-XFRC +C WRITE(*,3471)'RVC',I,J,NX,NY,NZ,L +C 2,XFRC,CPOOLR(N,L,NZ,NY,NX),WTRTD(N,L,NZ,NY,NX) +C 3,WTRVC(NZ,NY,NX),WTRT(NZ,NY,NX),FWTRT +3471 FORMAT(A8,6I4,12E12.4) + ENDIF + ENDIF +C +C ROOT AND MYCORRHIZAL LENGTH, DENSITY, VOLUME, RADIUS, AREA +C TO CALCULATE WATER AND NUTRIENT UPTAKE IN 'UPTAKE' +C + IF(N.EQ.1)THEN + RTLGZ=RTLGZ*FWOOD(1) + RTLGL=RTLGL*FWOOD(1) + ENDIF + RTLGX=RTLGZ*PP(NZ,NY,NX) + RTLGT=RTLGL+RTLGX + WTRTT=WTRTX+WTRTZ + IF(RTLGT.GT.ZEROP(NZ,NY,NX).AND.WTRTT.GT.ZEROP(NZ,NY,NX) + 2.AND.PP(NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + RTLGP(N,L,NZ,NY,NX)=RTLGT/PP(NZ,NY,NX) + RTDNP(N,L,NZ,NY,NX)=RTLGP(N,L,NZ,NY,NX)/DLYR(3,L,NY,NX) + RTVL=AMAX1(RTAR1X(N,NZ,NY,NX)*RTLGX+RTAR2X(N,NZ,NY,NX)*RTLGL + 2,WTRTT*DMVL(N,NZ,NY,NX)*PSIRG(N,L,NZ,NY,NX)) + RTVLP(N,L,NZ,NY,NX)=PORT(N,NZ,NY,NX)*RTVL + RTVLW(N,L,NZ,NY,NX)=(1.0-PORT(N,NZ,NY,NX))*RTVL + RRAD1(N,L,NZ,NY,NX)=AMAX1(RRAD1X(N,NZ,NY,NX) + 2,(1.0+PSIRT(N,L,NZ,NY,NX)/EMODR)*RRAD1M(N,NZ,NY,NX)) + RRAD2(N,L,NZ,NY,NX)=AMAX1(RRAD2X(N,NZ,NY,NX) + 2,(1.0+PSIRT(N,L,NZ,NY,NX)/EMODR)*RRAD2M(N,NZ,NY,NX)) + RTAR=6.283*RRAD1(N,L,NZ,NY,NX)*RTLGX + 2+6.283*RRAD2(N,L,NZ,NY,NX)*RTLGL + RTARP(N,L,NZ,NY,NX)=RTAR/PP(NZ,NY,NX) + IF(RTNL(N,L,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + RTLGA(N,L,NZ,NY,NX)=AMAX1(RTLGAX,RTLGL/RTNL(N,L,NZ,NY,NX)) + ELSE + RTLGA(N,L,NZ,NY,NX)=RTLGAX + ENDIF + ELSE + RTLGP(N,L,NZ,NY,NX)=0.0 + RTDNP(N,L,NZ,NY,NX)=0.0 + RTVLP(N,L,NZ,NY,NX)=0.0 + RTVLW(N,L,NZ,NY,NX)=0.0 + RRAD1(N,L,NZ,NY,NX)=RRAD1M(N,NZ,NY,NX) + RRAD2(N,L,NZ,NY,NX)=RRAD2M(N,NZ,NY,NX) + RTARP(N,L,NZ,NY,NX)=0.0 + RTLGA(N,L,NZ,NY,NX)=RTLGAX + RCO2Z(NZ,NY,NX)=RCO2Z(NZ,NY,NX)-(CO2A(N,L,NZ,NY,NX) + 2+CO2P(N,L,NZ,NY,NX)) + ROXYZ(NZ,NY,NX)=ROXYZ(NZ,NY,NX)-(OXYA(N,L,NZ,NY,NX) + 2+OXYP(N,L,NZ,NY,NX)) + RCH4Z(NZ,NY,NX)=RCH4Z(NZ,NY,NX)-(CH4A(N,L,NZ,NY,NX) + 2+CH4P(N,L,NZ,NY,NX)) + RN2OZ(NZ,NY,NX)=RN2OZ(NZ,NY,NX)-(Z2OA(N,L,NZ,NY,NX) + 2+Z2OP(N,L,NZ,NY,NX)) + RNH3Z(NZ,NY,NX)=RNH3Z(NZ,NY,NX)-(ZH3A(N,L,NZ,NY,NX) + 2+ZH3P(N,L,NZ,NY,NX)) + RH2GZ(NZ,NY,NX)=RH2GZ(NZ,NY,NX)-(H2GA(N,L,NZ,NY,NX) + 2+H2GP(N,L,NZ,NY,NX)) + CO2A(N,L,NZ,NY,NX)=0.0 + OXYA(N,L,NZ,NY,NX)=0.0 + CH4A(N,L,NZ,NY,NX)=0.0 + Z2OA(N,L,NZ,NY,NX)=0.0 + ZH3A(N,L,NZ,NY,NX)=0.0 + H2GA(N,L,NZ,NY,NX)=0.0 + CO2P(N,L,NZ,NY,NX)=0.0 + OXYP(N,L,NZ,NY,NX)=0.0 + CH4P(N,L,NZ,NY,NX)=0.0 + Z2OP(N,L,NZ,NY,NX)=0.0 + ZH3P(N,L,NZ,NY,NX)=0.0 + H2GP(N,L,NZ,NY,NX)=0.0 + ENDIF +5000 CONTINUE +5010 CONTINUE +C +C ADD SEED DIMENSIONS TO ROOT DIMENSIONS (ONLY IMPORTANT DURING +C GERMINATION) +C + RTLGP(1,NG(NZ,NY,NX),NZ,NY,NX)=RTLGP(1,NG(NZ,NY,NX),NZ,NY,NX) + 2+SDLG(NZ,NY,NX) + RTDNP(1,NG(NZ,NY,NX),NZ,NY,NX)=RTLGP(1,NG(NZ,NY,NX),NZ,NY,NX) + 2/DLYR(3,NG(NZ,NY,NX),NY,NX) + RTVL=RTVLP(1,NG(NZ,NY,NX),NZ,NY,NX)+RTVLW(1,NG(NZ,NY,NX),NZ,NY,NX) + 2+SDVL(NZ,NY,NX)*PP(NZ,NY,NX) + RTVLP(1,NG(NZ,NY,NX),NZ,NY,NX)=PORT(1,NZ,NY,NX)*RTVL + RTVLW(1,NG(NZ,NY,NX),NZ,NY,NX)=(1.0-PORT(1,NZ,NY,NX))*RTVL + RTARP(1,NG(NZ,NY,NX),NZ,NY,NX)=RTARP(1,NG(NZ,NY,NX),NZ,NY,NX) + 2+SDAR(NZ,NY,NX) + IF(IDTHRN.EQ.NRT(NZ,NY,NX).OR.(WTRVC(NZ,NY,NX) + 2.LT.ZEROL(NZ,NY,NX).AND.ISTYP(NZ,NY,NX).NE.0))THEN + IDTHR(NZ,NY,NX)=1 + IDTHP(NZ,NY,NX)=1 + ENDIF +C +C ROOT N2 FIXATION (LEGUMES) +C + IF((INTYP(NZ,NY,NX).EQ.1.OR.INTYP(NZ,NY,NX).EQ.2))THEN + DO 5400 L=NU(NY,NX),NIX(NZ,NY,NX) + IF(WTRTD(1,L,NZ,NY,NX).GT.ZEROL(NZ,NY,NX))THEN +C +C INITIAL INFECTION +C + IF(WTNDL(L,NZ,NY,NX).LE.0.0)THEN + WTNDL(L,NZ,NY,NX)=WTNDL(L,NZ,NY,NX) + 2+WTNDI*AREA(3,NU(NY,NX),NY,NX) + WTNDLN(L,NZ,NY,NX)=WTNDLN(L,NZ,NY,NX) + 2+WTNDI*AREA(3,NU(NY,NX),NY,NX)*CNND(NZ,NY,NX) + WTNDLP(L,NZ,NY,NX)=WTNDLP(L,NZ,NY,NX) + 2+WTNDI*AREA(3,NU(NY,NX),NY,NX)*CPND(NZ,NY,NX) + ENDIF +C +C O2-UNCONSTRAINED RESPIRATION RATES BY HETEROTROPHIC AEROBES +C IN NODULE FROM SPECIFIC OXIDATION RATE, ACTIVE BIOMASS, +C NON-STRUCTURAL C CONCENTRATION, MICROBIAL C:N:P FACTOR, +C AND TEMPERATURE +C + IF(WTNDL(L,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + CCPOLN=AMAX1(0.0,CPOOLN(L,NZ,NY,NX)/WTNDL(L,NZ,NY,NX)) + CZPOLN=AMAX1(0.0,ZPOOLN(L,NZ,NY,NX)/WTNDL(L,NZ,NY,NX)) + CPPOLN=AMAX1(0.0,PPOOLN(L,NZ,NY,NX)/WTNDL(L,NZ,NY,NX)) + ELSE + CCPOLN=1.0 + CZPOLN=1.0 + 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) + ELSE + CCC=0.0 + CNC=0.0 + CPC=0.0 + CNF=0.0 + ENDIF + IF(WTNDL(L,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + FCNPF=AMIN1(1.0,AMAX1(0.0 + 2,WTNDLN(L,NZ,NY,NX)/(WTNDL(L,NZ,NY,NX)*CNND(NZ,NY,NX)) + 3,WTNDLP(L,NZ,NY,NX)/(WTNDL(L,NZ,NY,NX)*CPND(NZ,NY,NX)))) + ELSE + FCNPF=1.0 + ENDIF + RDNDLX=CCPOLN/(CCPOLN+CCNKX) + RCNDLM=AMAX1(0.0,AMIN1(CPOOLN(L,NZ,NY,NX)*(1.0-DMND(NZ,NY,NX)) + 2,VMXO*WTNDL(L,NZ,NY,NX)*CCPOLN/(CCPOLN+CCNKM) + 3*TFN4(L,NZ,NY,NX)*FCNPF*WFNGR(1,L)))*CNF +C +C O2-LIMITED NODULE RESPIRATION FROM 'WFR' IN 'UPTAKE' +C + RCNDL=RCNDLM*WFR(1,L,NZ,NY,NX) +C +C NODULE MAINTENANCE RESPIRATION FROM SOIL TEMPERATURE, +C NODULE STRUCTURAL N +C + RMNDL=AMAX1(0.0,RMPLT*WTNDLN(L,NZ,NY,NX))*TFN6(L)*RDNDLX +C +C NODULE GROWTH RESPIRATION FROM TOTAL - MAINTENANCE +C IF > 0 DRIVES GROWTH, IF < 0 DRIVES REMOBILIZATION +C + RXNDLM=RCNDLM-RMNDL + RXNDL=RCNDL-RMNDL + RGNDLM=AMAX1(0.0,RXNDLM) + RGNDL=AMAX1(0.0,RXNDL) + RSNDLM=AMAX1(0.0,-RXNDLM) + RSNDL=AMAX1(0.0,-RXNDL) +C +C NODULE N2 FIXATION FROM GROWTH RESPIRATION, FIXATION ENERGY +C REQUIREMENT AND NON-STRUCTURAL C:N:P PRODUCT INHIBITION, +C CONSTRAINED BY MICROBIAL N REQUIREMENT +C + RGN2P=AMAX1(0.0,WTNDL(L,NZ,NY,NX)*CNND(NZ,NY,NX) + 2-WTNDLN(L,NZ,NY,NX))/EN2F + RGN2F=AMIN1(RGNDL,RGN2P) + RUPNF(L,NZ,NY,NX)=RGN2F*EN2F + UPNF(NZ,NY,NX)=UPNF(NZ,NY,NX)+RUPNF(L,NZ,NY,NX) +C +C TOTAL NON-STRUCTURAL C,N,P USED IN NODULE GROWTH +C AND GROWTH RESPIRATION DEPENDS ON GROWTH YIELD ENTERED IN 'READQ' +C + CGNDL=(RGNDL-RGN2F)/(1.0-DMND(NZ,NY,NX)) + GRNDG=CGNDL*DMND(NZ,NY,NX) + ZADDN=AMAX1(0.0,AMIN1(ZPOOLN(L,NZ,NY,NX) + 2,GRNDG*CNND(NZ,NY,NX))*CCC) + PADDN=AMAX1(0.0,AMIN1(PPOOLN(L,NZ,NY,NX) + 2,GRNDG*CPND(NZ,NY,NX))*CCC) +C +C NODULE C,N,P REMOBILIZATION AND DECOMPOSITION +C + RCCC=RCCZ(IBTYP(NZ,NY,NX))+CCC*RCCY(IBTYP(NZ,NY,NX)) + RCCN=CNC*RCCX(IGTYP(NZ,NY,NX)) + RCCP=CPC*RCCQ(IGTYP(NZ,NY,NX)) + SPNDX=SPNDL*RDNDLX + RXNDLC=SPNDX*WTNDL(L,NZ,NY,NX)*WFNGR(1,L) + RXNDLN=SPNDX*WTNDLN(L,NZ,NY,NX)*WFNGR(1,L) + RXNDLP=SPNDX*WTNDLP(L,NZ,NY,NX)*WFNGR(1,L) + RDNDLC=RXNDLC*(1.0-RCCC) + RDNDLN=RXNDLN*(1.0-RCCN)*(1.0-RCCC) + RDNDLP=RXNDLP*(1.0-RCCP)*(1.0-RCCC) + RCNDLC=RXNDLC-RDNDLC + RCNDLN=RXNDLN-RDNDLN + RCNDLP=RXNDLP-RDNDLP +C +C NODULE SENESCENCE +C + IF(RSNDL.GT.0.0.AND.WTNDL(L,NZ,NY,NX).GT.ZEROP(NZ,NY,NX) + 2.AND.RCCC.GT.ZERO)THEN + RXNSNC=RSNDL/RCCC + RXNSNN=RXNSNC*WTNDLN(L,NZ,NY,NX)/WTNDL(L,NZ,NY,NX) + RXNSNP=RXNSNC*WTNDLP(L,NZ,NY,NX)/WTNDL(L,NZ,NY,NX) + RDNSNC=RXNSNC*(1.0-RCCC) + RDNSNN=RXNSNN*(1.0-RCCN)*(1.0-RCCC) + RDNSNP=RXNSNP*(1.0-RCCP)*(1.0-RCCC) + RCNSNC=RXNSNC-RDNSNC + RCNSNN=RXNSNN-RDNSNN + RCNSNP=RXNSNP-RDNSNP + ELSE + RXNSNC=0.0 + RXNSNN=0.0 + RXNSNP=0.0 + RDNSNC=0.0 + RDNSNN=0.0 + RDNSNP=0.0 + RCNSNC=0.0 + RCNSNN=0.0 + RCNSNP=0.0 + ENDIF +C +C TOTAL NODULE RESPIRATION +C + RCO2TM=AMIN1(RMNDL,RCNDLM)+RGNDLM+RCNSNC + RCO2T=AMIN1(RMNDL,RCNDL)+RGNDL+RCNSNC + RCO2M(1,L,NZ,NY,NX)=RCO2M(1,L,NZ,NY,NX)+RCO2TM + RCO2N(1,L,NZ,NY,NX)=RCO2N(1,L,NZ,NY,NX)+RCO2T + RCO2A(1,L,NZ,NY,NX)=RCO2A(1,L,NZ,NY,NX)-RCO2T +C +C NODULE LITTERFALL CAUSED BY REMOBILIZATION +C + DO 6370 M=1,4 + CSNC(M,1,L,NZ,NY,NX)=CSNC(M,1,L,NZ,NY,NX)+CFOPC(4,M,NZ,NY,NX) + 2*(RDNDLC+RDNSNC) + ZSNC(M,1,L,NZ,NY,NX)=ZSNC(M,1,L,NZ,NY,NX)+CFOPN(4,M,NZ,NY,NX) + 2*(RDNDLN+RDNSNN) + PSNC(M,1,L,NZ,NY,NX)=PSNC(M,1,L,NZ,NY,NX)+CFOPP(4,M,NZ,NY,NX) + 2*(RDNDLP+RDNSNP) +6370 CONTINUE +C +C CONSUMPTION OF NON-STRUCTURAL C,N,P BY NODULE +C + CPOOLN(L,NZ,NY,NX)=CPOOLN(L,NZ,NY,NX)-AMIN1(RMNDL,RCNDL) + 2-RGN2F-CGNDL+RCNDLC + ZPOOLN(L,NZ,NY,NX)=ZPOOLN(L,NZ,NY,NX)-ZADDN+RCNDLN+RCNSNN + 2+RUPNF(L,NZ,NY,NX) + PPOOLN(L,NZ,NY,NX)=PPOOLN(L,NZ,NY,NX)-PADDN+RCNDLP+RCNSNP +C +C UPDATE STATE VARIABLES FOR NODULE C, N, P +C + WTNDL(L,NZ,NY,NX)=WTNDL(L,NZ,NY,NX)+GRNDG-RXNDLC-RXNSNC + WTNDLN(L,NZ,NY,NX)=WTNDLN(L,NZ,NY,NX)+ZADDN-RXNDLN-RXNSNN + WTNDLP(L,NZ,NY,NX)=WTNDLP(L,NZ,NY,NX)+PADDN-RXNDLP-RXNSNP +C +C TRANSFER NON-STRUCTURAL C,N,P BETWEEN ROOT AND NODULES +C FROM NON-STRUCTURAL C,N,P CONCENTRATION DIFFERENCES +C + IF(CPOOLR(1,L,NZ,NY,NX).GT.ZEROP(NZ,NY,NX) + 2.AND.WTRTD(1,L,NZ,NY,NX).GT.ZEROL(NZ,NY,NX))THEN + WTRTD1=WTRTD(1,L,NZ,NY,NX) + WTNDL1=AMIN1(WTRTD(1,L,NZ,NY,NX),AMAX1(FSNKM + 2*WTRTD(1,L,NZ,NY,NX),WTNDL(L,NZ,NY,NX))) + WTRTDT=WTRTD1+WTRTD2 + IF(WTRTDT.GT.ZEROP(NZ,NY,NX))THEN + CPOOLD=(CPOOLR(1,L,NZ,NY,NX)*WTNDL1 + 2-CPOOLN(L,NZ,NY,NX)*WTRTD1)/WTRTDT + XFRC=FXRN(INTYP(NZ,NY,NX))*CPOOLD + CPOOLR(1,L,NZ,NY,NX)=CPOOLR(1,L,NZ,NY,NX)-XFRC + CPOOLN(L,NZ,NY,NX)=CPOOLN(L,NZ,NY,NX)+XFRC + CPOOLT=CPOOLR(1,L,NZ,NY,NX)+CPOOLN(L,NZ,NY,NX) + IF(CPOOLT.GT.ZEROP(NZ,NY,NX))THEN + ZPOOLD=(ZPOOLR(1,L,NZ,NY,NX)*CPOOLN(L,NZ,NY,NX) + 2-ZPOOLN(L,NZ,NY,NX)*CPOOLR(1,L,NZ,NY,NX))/CPOOLT + XFRN=FXRN(INTYP(NZ,NY,NX))*ZPOOLD + PPOOLD=(PPOOLR(1,L,NZ,NY,NX)*CPOOLN(L,NZ,NY,NX) + 2-PPOOLN(L,NZ,NY,NX)*CPOOLR(1,L,NZ,NY,NX))/CPOOLT + XFRP=FXRN(INTYP(NZ,NY,NX))*PPOOLD + ZPOOLR(1,L,NZ,NY,NX)=ZPOOLR(1,L,NZ,NY,NX)-XFRN + PPOOLR(1,L,NZ,NY,NX)=PPOOLR(1,L,NZ,NY,NX)-XFRP + ZPOOLN(L,NZ,NY,NX)=ZPOOLN(L,NZ,NY,NX)+XFRN + PPOOLN(L,NZ,NY,NX)=PPOOLN(L,NZ,NY,NX)+XFRP +C IF(L.EQ.1)THEN +C WRITE(*,2122)'NODEX',I,J,NZ,L,XFRC,XFRN,XFRP +C 3,WTRTD(1,L,NZ,NY,NX),WTRTDT,CPOOLT +C 4,WTNDL(L,NZ,NY,NX),WTNDLN(L,NZ,NY,NX),WTNDLP(L,NZ,NY,NX) +C 2,CPOOLN(L,NZ,NY,NX),ZPOOLN(L,NZ,NY,NX),PPOOLN(L,NZ,NY,NX) +C 3,CPOOLR(1,L,NZ,NY,NX),ZPOOLR(1,L,NZ,NY,NX),PPOOLR(1,L,NZ,NY,NX) +C ENDIF + ENDIF + ENDIF + ENDIF +C IF(L.EQ.1)THEN +C WRITE(*,2122)'NODGR',I,J,NZ,L,RCNDL,RMNDL,RGNDL,RGN2P +C 2,RGN2F,CGNDL,GRNDG,CCC,ZADDN,PADDN,SNCR,RCCC,RCCN,RCCP +C 8,FSNCN,RCCO,RDNDLC,RDNDLN,RDNDLP,WFR(1,L,NZ,NY,NX) +C 3,WTNDL(L,NZ,NY,NX),WTNDLN(L,NZ,NY,NX),WTNDLP(L,NZ,NY,NX) +C 2,CPOOLN(L,NZ,NY,NX),ZPOOLN(L,NZ,NY,NX),PPOOLN(L,NZ,NY,NX) +C 5,FCNPF,TFN4(L,NZ,NY,NX),WFNGR(1,L) +2122 FORMAT(A8,4I4,60E24.16) +C ENDIF + ENDIF +5400 CONTINUE + ENDIF +C +C TRANSFER NON-STRUCTURAL C,N,P AMONG BRANCH LEAVES +C FROM NON-STRUCTURAL C,N,P CONCENTRATION DIFFERENCES +C WHEN SEASONAL STORAGE C IS NOT BEING MOBILIZED +C + IF(NBR(NZ,NY,NX).GT.1)THEN + WTPLTT=0.0 + CPOOLT=0.0 + ZPOOLT=0.0 + PPOOLT=0.0 + DO 300 NB=1,NBR(NZ,NY,NX) + IF(IDTHB(NB,NZ,NY,NX).EQ.0)THEN + IF(ATRP(NB,NZ,NY,NX).GT.ATRPX)THEN + WTLSBZ(NB)=AMAX1(0.0,WTLSB(NB,NZ,NY,NX)) + CPOOLZ(NB)=AMAX1(0.0,CPOOL(NB,NZ,NY,NX)) + ZPOOLZ(NB)=AMAX1(0.0,ZPOOL(NB,NZ,NY,NX)) + PPOOLZ(NB)=AMAX1(0.0,PPOOL(NB,NZ,NY,NX)) + WTPLTT=WTPLTT+WTLSBZ(NB) + CPOOLT=CPOOLT+CPOOLZ(NB) + ZPOOLT=ZPOOLT+ZPOOLZ(NB) + PPOOLT=PPOOLT+PPOOLZ(NB) + ENDIF + ENDIF +300 CONTINUE + DO 305 NB=1,NBR(NZ,NY,NX) + IF(IDTHB(NB,NZ,NY,NX).EQ.0)THEN + IF(ATRP(NB,NZ,NY,NX).GT.ATRPX)THEN + IF(WTPLTT.GT.ZEROP(NZ,NY,NX) + 2.AND.CPOOLT.GT.ZEROP(NZ,NY,NX))THEN + CPOOLD=CPOOLT*WTLSBZ(NB)-CPOOLZ(NB)*WTPLTT + ZPOOLD=ZPOOLT*CPOOLZ(NB)-ZPOOLZ(NB)*CPOOLT + PPOOLD=PPOOLT*CPOOLZ(NB)-PPOOLZ(NB)*CPOOLT + XFRC=0.01*CPOOLD/WTPLTT + XFRN=0.01*ZPOOLD/CPOOLT + XFRP=0.01*PPOOLD/CPOOLT + CPOOL(NB,NZ,NY,NX)=CPOOL(NB,NZ,NY,NX)+XFRC + ZPOOL(NB,NZ,NY,NX)=ZPOOL(NB,NZ,NY,NX)+XFRN + PPOOL(NB,NZ,NY,NX)=PPOOL(NB,NZ,NY,NX)+XFRP + ENDIF + ENDIF + ENDIF +305 CONTINUE + ENDIF +C +C TRANSFER NON-STRUCTURAL C,N,P AMONG BRANCH STALK RESERVES +C FROM NON-STRUCTURAL C,N,P CONCENTRATION DIFFERENCES +C + IF(NBR(NZ,NY,NX).GT.1)THEN + WTSTKT=0.0 + WTRSVT=0.0 + WTRSNT=0.0 + WTRSPT=0.0 + DO 330 NB=1,NBR(NZ,NY,NX) + IF(IDTHB(NB,NZ,NY,NX).EQ.0)THEN + IF(IDAY(7,NB,NZ,NY,NX).NE.0)THEN + WTSTKT=WTSTKT+WVSTKB(NB,NZ,NY,NX) + WTRSVT=WTRSVT+WTRSVB(NB,NZ,NY,NX) + WTRSNT=WTRSNT+WTRSBN(NB,NZ,NY,NX) + WTRSPT=WTRSPT+WTRSBP(NB,NZ,NY,NX) + ENDIF + ENDIF +330 CONTINUE + IF(WTSTKT.GT.ZEROP(NZ,NY,NX) + 2.AND.WTRSVT.GT.ZEROP(NZ,NY,NX))THEN + DO 335 NB=1,NBR(NZ,NY,NX) + IF(IDTHB(NB,NZ,NY,NX).EQ.0)THEN + IF(IDAY(7,NB,NZ,NY,NX).NE.0)THEN + WTRSVD=WTRSVT*WVSTKB(NB,NZ,NY,NX) + 2-WTRSVB(NB,NZ,NY,NX)*WTSTKT + XFRC=0.1*WTRSVD/WTSTKT + WTRSVB(NB,NZ,NY,NX)=WTRSVB(NB,NZ,NY,NX)+XFRC + WTRSND=WTRSNT*WTRSVB(NB,NZ,NY,NX) + 2-WTRSBN(NB,NZ,NY,NX)*WTRSVT + XFRN=0.1*WTRSND/WTRSVT + WTRSBN(NB,NZ,NY,NX)=WTRSBN(NB,NZ,NY,NX)+XFRN + WTRSPD=WTRSPT*WTRSVB(NB,NZ,NY,NX) + 2-WTRSBP(NB,NZ,NY,NX)*WTRSVT + XFRP=0.1*WTRSPD/WTRSVT + WTRSBP(NB,NZ,NY,NX)=WTRSBP(NB,NZ,NY,NX)+XFRP + ENDIF + ENDIF +335 CONTINUE + ENDIF + ENDIF +C +C TRANSFER NON-STRUCTURAL C,N,P BWTWEEN ROOT AND MYCORRHIZAE +C IN EACH ROOTED SOIL LAYER FROM NON-STRUCTURAL C,N,P CONCENTRATION +C DIFFERENCES +C + IF(MY(NZ,NY,NX).EQ.2)THEN + DO 425 L=NU(NY,NX),NIX(NZ,NY,NX) + IF(CPOOLR(1,L,NZ,NY,NX).GT.ZEROP(NZ,NY,NX) + 2.AND.WTRTD(1,L,NZ,NY,NX).GT.ZEROL(NZ,NY,NX))THEN + WTRTD1=WTRTD(1,L,NZ,NY,NX) + WTRTD2=AMIN1(WTRTD(1,L,NZ,NY,NX),AMAX1(FSNKM + 2*WTRTD(1,L,NZ,NY,NX),WTRTD(2,L,NZ,NY,NX))) + WTPLTT=WTRTD1+WTRTD2 + IF(WTPLTT.GT.ZEROP(NZ,NY,NX))THEN + CPOOLD=(CPOOLR(1,L,NZ,NY,NX)*WTRTD2 + 2-CPOOLR(2,L,NZ,NY,NX)*WTRTD1)/WTPLTT + XFRC=FMYC*CPOOLD + CPOOLR(1,L,NZ,NY,NX)=CPOOLR(1,L,NZ,NY,NX)-XFRC + CPOOLR(2,L,NZ,NY,NX)=CPOOLR(2,L,NZ,NY,NX)+XFRC + CPOOLT=CPOOLR(1,L,NZ,NY,NX)+CPOOLR(2,L,NZ,NY,NX) + IF(CPOOLT.GT.ZEROP(NZ,NY,NX))THEN + ZPOOLD=(ZPOOLR(1,L,NZ,NY,NX)*CPOOLR(2,L,NZ,NY,NX) + 2-ZPOOLR(2,L,NZ,NY,NX)*CPOOLR(1,L,NZ,NY,NX))/CPOOLT + XFRN=FMYC*ZPOOLD + PPOOLD=(PPOOLR(1,L,NZ,NY,NX)*CPOOLR(2,L,NZ,NY,NX) + 2-PPOOLR(2,L,NZ,NY,NX)*CPOOLR(1,L,NZ,NY,NX))/CPOOLT + XFRP=FMYC*PPOOLD + ZPOOLR(1,L,NZ,NY,NX)=ZPOOLR(1,L,NZ,NY,NX)-XFRN + ZPOOLR(2,L,NZ,NY,NX)=ZPOOLR(2,L,NZ,NY,NX)+XFRN + PPOOLR(1,L,NZ,NY,NX)=PPOOLR(1,L,NZ,NY,NX)-XFRP + PPOOLR(2,L,NZ,NY,NX)=PPOOLR(2,L,NZ,NY,NX)+XFRP +C IF(L.EQ.NIX(NZ,NY,NX))THEN +C WRITE(*,9873)'MYCO',I,J,NZ,L,XFRC,XFRN,XFRP +C 2,CPOOLR(1,L,NZ,NY,NX),WTRTD(1,L,NZ,NY,NX) +C 3,CPOOLR(2,L,NZ,NY,NX),WTRTD2 +C 3,WTPLTT,ZPOOLR(1,L,NZ,NY,NX),ZPOOLR(2,L,NZ,NY,NX) +C 4,PPOOLR(1,L,NZ,NY,NX),PPOOLR(2,L,NZ,NY,NX),CPOOLT +9873 FORMAT(A8,4I4,20E24.16) +C ENDIF + ENDIF + ENDIF + ENDIF +425 CONTINUE + ENDIF +C +C TRANSFER NON-STRUCTURAL C,N,P BETWEEN ROOT AND STORAGE +C +C IF(IFLGZ.EQ.1.AND.ISTYP(NZ,NY,NX).NE.0)THEN +C DO 5545 N=1,MY(NZ,NY,NX) +C DO 5550 L=NU(NY,NX),NI(NZ,NY,NX) +C IF(CCPOLR(N,L,NZ,NY,NX).GT.ZERO)THEN +C CNL=CCPOLR(N,L,NZ,NY,NX)/(CCPOLR(N,L,NZ,NY,NX) +C 2+CZPOLR(N,L,NZ,NY,NX)*CNKI) +C CPL=CCPOLR(N,L,NZ,NY,NX)/(CCPOLR(N,L,NZ,NY,NX) +C 2+CPPOLR(N,L,NZ,NY,NX)*CPKI) +C ELSE +C CNL=0.0 +C CPL=0.0 +C ENDIF +C XFRCX=FXFB(IBTYP(NZ,NY,NX)) +C 2*AMAX1(0.0,CPOOLR(N,L,NZ,NY,NX)) +C XFRNX=FXFB(IBTYP(NZ,NY,NX)) +C 2*AMAX1(0.0,ZPOOLR(N,L,NZ,NY,NX))*(1.0+CNL) +C XFRPX=FXFB(IBTYP(NZ,NY,NX)) +C 2*AMAX1(0.0,PPOOLR(N,L,NZ,NY,NX))*(1.0+CPL) +C XFRC=AMIN1(XFRCX,XFRNX/CNMN,XFRPX/CPMN) +C XFRN=AMIN1(XFRNX,XFRC*CNMX,XFRPX*CNMX/CPMN*0.5) +C XFRP=AMIN1(XFRPX,XFRC*CPMX,XFRNX*CPMX/CNMN*0.5) +C CPOOLR(N,L,NZ,NY,NX)=CPOOLR(N,L,NZ,NY,NX)-XFRC +C WTRVC(NZ,NY,NX)=WTRVC(NZ,NY,NX)+XFRC +C ZPOOLR(N,L,NZ,NY,NX)=ZPOOLR(N,L,NZ,NY,NX)-XFRN +C WTRVN(NZ,NY,NX)=WTRVN(NZ,NY,NX)+XFRN +C PPOOLR(N,L,NZ,NY,NX)=PPOOLR(N,L,NZ,NY,NX)-XFRP +C WTRVP(NZ,NY,NX)=WTRVP(NZ,NY,NX)+XFRP +5550 CONTINUE +5545 CONTINUE +C ENDIF +C +C ROOT AND NODULE TOTALS +C + DO 5445 N=1,MY(NZ,NY,NX) + DO 5450 L=NU(NY,NX),NI(NZ,NY,NX) + WTRTL(N,L,NZ,NY,NX)=0.0 + WTRTD(N,L,NZ,NY,NX)=0.0 + DO 5460 NR=1,NRT(NZ,NY,NX) + WTRTL(N,L,NZ,NY,NX)=WTRTL(N,L,NZ,NY,NX)+WTRT2(N,L,NR,NZ,NY,NX) + WTRTD(N,L,NZ,NY,NX)=WTRTD(N,L,NZ,NY,NX)+WTRT2(N,L,NR,NZ,NY,NX) + 2+WTRT1(N,L,NR,NZ,NY,NX) +5460 CONTINUE + TCO2T(NZ,NY,NX)=TCO2T(NZ,NY,NX)+RCO2A(N,L,NZ,NY,NX) + RECO(NY,NX)=RECO(NY,NX)+RCO2A(N,L,NZ,NY,NX) + TRAU(NY,NX)=TRAU(NY,NX)+RCO2A(N,L,NZ,NY,NX) +5450 CONTINUE + DO 5470 NR=1,NRT(NZ,NY,NX) + WTRTL(N,NINR(NR,NZ,NY,NX),NZ,NY,NX) + 2=WTRTL(N,NINR(NR,NZ,NY,NX),NZ,NY,NX) + 3+RTWT1(N,NR,NZ,NY,NX) +5470 CONTINUE +5445 CONTINUE +C +C TRANSFER NON-STRUCTURAL C,N,P BETWEEN ROOT AND SHOOT +C +C SINK STRENGTH OF ROOTS IN EACH SOIL LAYER AS A FRACTION +C OF TOTAL SINK STRENGTH OF ROOTS IN ALL SOIL LAYERS +C + IF(ISTYP(NZ,NY,NX).EQ.1)THEN + IF(WTLS(NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + FWTC=AMIN1(1.0,0.667*WTRT(NZ,NY,NX)/WTLS(NZ,NY,NX)) + ELSE + FWTC=1.0 + ENDIF + IF(WTRT(NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + FWTS=AMIN1(1.0,WTLS(NZ,NY,NX)/(0.667*WTRT(NZ,NY,NX))) + ELSE + FWTS=1.0 + ENDIF + ELSE + FWTC=1.0 + FWTS=1.0 + ENDIF + DO 290 L=NU(NY,NX),NI(NZ,NY,NX) + IF(RTNT(1).GT.ZEROP(NZ,NY,NX))THEN + FWTR(L)=AMAX1(0.0,RLNT(1,L)/RTNT(1)) + ELSE + FWTR(L)=1.0 + ENDIF +290 CONTINUE +C +C RATE CONSTANT FOR TRANSFER IS SET FROM INPUT IN 'READQ' +C BUT IS NOT USED FOR ANNUALS DURING GRAIN FILL +C + WTLS(NZ,NY,NX)=0.0 + DO 309 NB=1,NBR(NZ,NY,NX) + WTLS(NZ,NY,NX)=WTLS(NZ,NY,NX)+WTLSB(NB,NZ,NY,NX) +309 CONTINUE + DO 310 NB=1,NBR(NZ,NY,NX) + IF(IDTHB(NB,NZ,NY,NX).EQ.0 + 2.AND.(ISTYP(NZ,NY,NX).NE.0.OR.IDAY(7,NB,NZ,NY,NX).EQ.0))THEN +C +C SINK STRENGTH OF BRANCHES IN EACH CANOPY AS A FRACTION +C OF TOTAL SINK STRENGTH OF THE CANOPY +C + IF(WTLS(NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + FWTB(NB)=AMAX1(0.0,WTLSB(NB,NZ,NY,NX)/WTLS(NZ,NY,NX)) + ELSE + FWTB(NB)=1.0 + ENDIF + PTSHTR=AMIN1(1.0,PTSHT(NZ,NY,NX)) + DO 415 L=NU(NY,NX),NI(NZ,NY,NX) + WTLSBX=WTLSB(NB,NZ,NY,NX)*FWODB(1)*FWTR(L)*FWTC + WTRTLX=WTRTL(1,L,NZ,NY,NX)*FWOOD(1)*FWTB(NB)*FWTS + WTLSBB=AMAX1(0.0,WTLSBX,FSNKM*WTRTLX) + WTRTLR=AMAX1(0.0,WTRTLX,FSNKM*WTLSBX) + WTPLTT=WTLSBB+WTRTLR + IF(WTPLTT.GT.ZEROP(NZ,NY,NX))THEN + CPOOLB=AMAX1(0.0,CPOOL(NB,NZ,NY,NX)*FWTR(L)) + CPOOLS=AMAX1(0.0,CPOOLR(1,L,NZ,NY,NX)*FWTB(NB)) + CPOOLD=(CPOOLB*WTRTLR-CPOOLS*WTLSBB)/WTPLTT + XFRC=PTSHTR*CPOOLD + CPOOL(NB,NZ,NY,NX)=CPOOL(NB,NZ,NY,NX)-XFRC + CPOOLR(1,L,NZ,NY,NX)=CPOOLR(1,L,NZ,NY,NX)+XFRC + CPOOLT=CPOOLS+CPOOLB + IF(CPOOLT.GT.ZEROP(NZ,NY,NX))THEN + ZPOOLB=AMAX1(0.0,ZPOOL(NB,NZ,NY,NX)*FWTR(L)) + ZPOOLS=AMAX1(0.0,ZPOOLR(1,L,NZ,NY,NX)*FWTB(NB)) + ZPOOLD=(ZPOOLB*CPOOLS-ZPOOLS*CPOOLB)/CPOOLT + XFRN=PTSHTR*ZPOOLD + PPOOLB=AMAX1(0.0,PPOOL(NB,NZ,NY,NX)*FWTR(L)) + PPOOLS=AMAX1(0.0,PPOOLR(1,L,NZ,NY,NX)*FWTB(NB)) + PPOOLD=(PPOOLB*CPOOLS-PPOOLS*CPOOLB)/CPOOLT + XFRP=PTSHTR*PPOOLD + ELSE + XFRN=0.0 + XFRP=0.0 + ENDIF + ZPOOL(NB,NZ,NY,NX)=ZPOOL(NB,NZ,NY,NX)-XFRN + ZPOOLR(1,L,NZ,NY,NX)=ZPOOLR(1,L,NZ,NY,NX)+XFRN + PPOOL(NB,NZ,NY,NX)=PPOOL(NB,NZ,NY,NX)-XFRP + PPOOLR(1,L,NZ,NY,NX)=PPOOLR(1,L,NZ,NY,NX)+XFRP +C IF((I/10)*10.EQ.I.AND.J.EQ.14.AND.NZ.EQ.1.AND.NB.EQ.1)THEN +C WRITE(*,3344)'ROOT',I,J,NX,NY,NZ,NB,L +C 2,FSNKR,FDBK(NB,NZ,NY,NX),CPOOL(NB,NZ,NY,NX) +C 3,CPOOLR(1,L,NZ,NY,NX),ZPOOL(NB,NZ,NY,NX) +C 3,ZPOOLR(1,L,NZ,NY,NX),FWTB(NB),FWTR(L) +C 3,FWTC,FWTS,XFRC,XFRN,XFRP,WTLSBX,WTRTLX +C 4,CPOOLD,CPOOLB,WTLSBB,CPOOLS,WTRTLR +C 5,FWOOD(1),FWODB(1),WTRTL(1,L,NZ,NY,NX) +C 6,WTLSB(NB,NZ,NY,NX),RLNT(1,L),RTNT(1) +3344 FORMAT(A8,7I4,30E12.4) +C ENDIF + ENDIF +415 CONTINUE + ENDIF +310 CONTINUE +C +C TOTAL C,N,P IN EACH BRANCH +C + DO 320 NB=1,NBR(NZ,NY,NX) + CPOOLK(NB,NZ,NY,NX)=0.0 + DO 325 K=1,25 + CPOOLK(NB,NZ,NY,NX)=CPOOLK(NB,NZ,NY,NX) + 2+CPOOL3(K,NB,NZ,NY,NX)+CPOOL4(K,NB,NZ,NY,NX) + 3+CO2B(K,NB,NZ,NY,NX)+HCOB(K,NB,NZ,NY,NX) +325 CONTINUE + WTSHTB(NB,NZ,NY,NX)=WTLFB(NB,NZ,NY,NX) + 2+WTSHEB(NB,NZ,NY,NX)+WTSTKB(NB,NZ,NY,NX)+WTRSVB(NB,NZ,NY,NX) + 3+WTHSKB(NB,NZ,NY,NX)+WTEARB(NB,NZ,NY,NX)+WTGRB(NB,NZ,NY,NX) + 4+CPOOL(NB,NZ,NY,NX)+CPOOLK(NB,NZ,NY,NX) + WTSHTN(NB,NZ,NY,NX)=WTLFBN(NB,NZ,NY,NX) + 2+WTSHBN(NB,NZ,NY,NX)+WTSTBN(NB,NZ,NY,NX)+WTRSBN(NB,NZ,NY,NX) + 3+WTHSBN(NB,NZ,NY,NX)+WTEABN(NB,NZ,NY,NX)+WTGRBN(NB,NZ,NY,NX) + 4+ZPOOL(NB,NZ,NY,NX) + WTSHTP(NB,NZ,NY,NX)=WTLFBP(NB,NZ,NY,NX) + 2+WTSHBP(NB,NZ,NY,NX)+WTSTBP(NB,NZ,NY,NX)+WTRSBP(NB,NZ,NY,NX) + 3+WTHSBP(NB,NZ,NY,NX)+WTEABP(NB,NZ,NY,NX)+WTGRBP(NB,NZ,NY,NX) + 4+PPOOL(NB,NZ,NY,NX) +320 CONTINUE +C +C TOTAL C,N,P IN ROOTS AND MYCORRHIZAE IN EACH SOIL LAYER +C + DO 345 N=1,MY(NZ,NY,NX) + DO 345 L=NU(NY,NX),NI(NZ,NY,NX) + WTRTD(N,L,NZ,NY,NX)=WTRTD(N,L,NZ,NY,NX)+CPOOLR(N,L,NZ,NY,NX) +345 CONTINUE + ELSE + HCUPTK(NZ,NY,NX)=UPOMC(NZ,NY,NX) + HZUPTK(NZ,NY,NX)=UPOMN(NZ,NY,NX)+UPNH4(NZ,NY,NX)+UPNO3(NZ,NY,NX) + 2+UPNF(NZ,NY,NX) + HPUPTK(NZ,NY,NX)=UPOMP(NZ,NY,NX)+UPH2P(NZ,NY,NX) + ENDIF +C +C TRANSFER ABOVE-GROUND C,N,P AT HARVEST OR DISTURBANCE +C + IF((IHVST(NZ,I,NY,NX).GE.0.AND.J.EQ.INT(ZNOON(NY,NX)) + 2.AND.IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6) + 3.OR.(IHVST(NZ,I,NY,NX).EQ.4.OR.IHVST(NZ,I,NY,NX).EQ.6))THEN +C +C ACCUMULATE ALL HARVESTED MATERIAL ABOVE CUTTING HEIGHT +C ACCOUNTING FOR HARVEST EFFICIENCY ENTERED IN 'READS' +C + IF(IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6)THEN + IF(JHVST(NZ,I,NY,NX).NE.2)THEN + PPX(NZ,NY,NX)=PPX(NZ,NY,NX)*(1.0-THIN(NZ,I,NY,NX)) + PP(NZ,NY,NX)=PP(NZ,NY,NX)*(1.0-THIN(NZ,I,NY,NX)) + ELSE +C PPI(NZ,NY,NX)=AMAX1(1.0,0.5*(PPI(NZ,NY,NX)+GRNO(NZ,NY,NX) +C 2/AREA(3,NU(NY,NX),NY,NX))) + PPX(NZ,NY,NX)=PPI(NZ,NY,NX) + PP(NZ,NY,NX)=PPX(NZ,NY,NX)*AREA(3,NU(NY,NX),NY,NX) + ENDIF + IF(IHVST(NZ,I,NY,NX).EQ.3)THEN + CF(NZ,NY,NX)=CF(NZ,NY,NX)*HVST(NZ,I,NY,NX) + ENDIF + IF(IHVST(NZ,I,NY,NX).LE.2.AND.HVST(NZ,I,NY,NX).LT.0.0)THEN + ARLFY=(1.0-ABS(HVST(NZ,I,NY,NX)))*ARLFC(NY,NX) + ARLFR=0.0 + DO 9875 L=1,JC + IF(ZL(L,NY,NX).GT.ZL(L-1,NY,NX) + 2.AND.ARLFT(L,NY,NX).GT.ZEROS(NY,NX) + 3.AND.ARLFR.LT.ARLFY)THEN + IF(ARLFR+ARLFT(L,NY,NX).GT.ARLFY)THEN + HVST(NZ,I,NY,NX)=ZL(L-1,NY,NX)+((ARLFY-ARLFR) + 2/ARLFT(L,NY,NX))*(ZL(L,NY,NX)-ZL(L-1,NY,NX)) + ENDIF + ARLFR=ARLFR+ARLFT(L,NY,NX) + ENDIF +C WRITE(*,6544)'HVST',I,J,L,NZ,IHVST(NZ,I,NY,NX),ARLFC(NY,NX) +C 2,ARLFT(L,NY,NX),ARLFY,ARLFR,ZL(L,NY,NX),ZL(L-1,NY,NX) +C 3,ARLFV(L,NZ,NY,NX),HVST(NZ,I,NY,NX) +6544 FORMAT(A8,5I4,20E12.4) +9875 CONTINUE + ENDIF + WHVSTT=0.0 + WHVSLF=0.0 + WHVHSH=0.0 + WHVEAH=0.0 + WHVGRH=0.0 + WHVSCP=0.0 + WHVSTH=0.0 + WHVRVH=0.0 + ELSE +C +C GRAZING REMOVAL +C + IF(WTSHTA(NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + WHVSTT=HVST(NZ,I,NY,NX)*THIN(NZ,I,NY,NX)*0.45/24.0 + 2*AREA(3,NU(NY,NX),NY,NX)*WTSHT(NZ,NY,NX)/WTSHTA(NZ,NY,NX) + ELSE + WHVSTT=0.0 + ENDIF + IF(IHVST(NZ,I,NY,NX).EQ.6)THEN + WHVSTT=WHVSTT*TFN3(NZ,NY,NX) + ENDIF + CCPOLX=CCPOLP(NZ,NY,NX)/(1.0+CCPOLP(NZ,NY,NX)) + CCPLNX=CCPLNP(NZ,NY,NX)/(1.0+CCPLNP(NZ,NY,NX)) + WHVSLX=WHVSTT*EHVST(1,1,NZ,I,NY,NX) + WHVSLY=AMIN1(WTLF(NZ,NY,NX),WHVSLX) + WHVSLF=WHVSLY*(1.0-CCPOLX) + WHVSCL=WHVSLY*CCPOLX + WHVSNL=WHVSLY*CCPLNX + WHVXXX=AMAX1(0.0,WHVSLX-WHVSLY) + WHVSSX=WHVSTT*EHVST(1,2,NZ,I,NY,NX) + WTSHTT=WTSHE(NZ,NY,NX)+WTHSK(NZ,NY,NX)+WTEAR(NZ,NY,NX) + 2+WTGR(NZ,NY,NX) + IF(WTSHTT.GT.ZEROP(NZ,NY,NX))THEN + WHVSHX=WHVSSX*WTSHE(NZ,NY,NX)/WTSHTT+WHVXXX + WHVSHY=AMIN1(WTSHE(NZ,NY,NX),WHVSHX) + WHVSHH=WHVSHY*(1.0-CCPOLX) + WHVSCS=WHVSHY*CCPOLX + WHVSNS=WHVSHY*CCPLNX + WHVXXX=AMAX1(0.0,WHVSHX-WHVSHY) + WHVHSX=WHVSSX*WTHSK(NZ,NY,NX)/WTSHTT+WHVXXX + WHVHSY=AMIN1(WTHSK(NZ,NY,NX),WHVHSX) + WHVHSH=WHVHSY + WHVXXX=AMAX1(0.0,WHVHSX-WHVHSY) + WHVEAX=WHVSSX*WTEAR(NZ,NY,NX)/WTSHTT+WHVXXX + WHVEAY=AMIN1(WTEAR(NZ,NY,NX),WHVEAX) + WHVEAH=WHVEAY + WHVXXX=AMAX1(0.0,WHVEAX-WHVEAY) + WHVGRX=WHVSSX*WTGR(NZ,NY,NX)/WTSHTT+WHVXXX + WHVGRY=AMIN1(WTGR(NZ,NY,NX),WHVGRX) + WHVGRH=WHVGRY + WHVXXX=AMAX1(0.0,WHVGRX-WHVGRY) + ELSE + WHVSHH=0.0 + WHVSCS=0.0 + WHVSNS=0.0 + WHVHSH=0.0 + WHVEAH=0.0 + WHVGRH=0.0 + WHVXXX=WHVXXX+WHVSSX + ENDIF + WHVSCP=WHVSCL+WHVSCS + WHVSNP=WHVSNL+WHVSNS + WHVSKX=WHVSTT*EHVST(1,3,NZ,I,NY,NX) + WTSTKT=WTSTK(NZ,NY,NX)+WTRSV(NZ,NY,NX) + IF(WTSTKT.GT.WHVSKX+WHVXXX)THEN + WHVSTX=WHVSKX*WTSTK(NZ,NY,NX)/WTSTKT+WHVXXX + WHVSTY=AMIN1(WTSTK(NZ,NY,NX),WHVSTX) + WHVSTH=WHVSTY + WHVXXX=AMAX1(0.0,WHVSTX-WHVSTY) + WHVRVX=WHVSKX*WTRSV(NZ,NY,NX)/WTSTKT+WHVXXX + WHVRVY=AMIN1(WTRSV(NZ,NY,NX),WHVRVX) + WHVRVH=WHVRVY + WHVXXX=AMAX1(0.0,WHVRVX-WHVRVY) + ELSE + WHVSTH=0.0 + WHVRVH=0.0 + WHVXXX=AMAX1(0.0,WHVSKX) + IF(WHVXXX.GT.0.0)THEN + WHVSLY=AMIN1(WTLF(NZ,NY,NX)-WHVSLF-WHVSCL,WHVXXX) + WHVSLF=WHVSLF+WHVSLY*(1.0-CCPOLX) + WHVSCL=WHVSCL+WHVSLY*CCPOLX + WHVSNL=WHVSNL+WHVSLY*CCPLNX + WHVXXX=AMAX1(0.0,WHVXXX-WHVSLY) + IF(WTSHTT.GT.ZEROP(NZ,NY,NX))THEN + WHVSHX=WHVXXX*WTSHE(NZ,NY,NX)/WTSHTT + WHVSHY=AMIN1(WTSHE(NZ,NY,NX),WHVSHX) + WHVSHH=WHVSHH+WHVSHY*(1.0-CCPOLX) + WHVSCS=WHVSCS+WHVSHY*CCPOLX + WHVSNS=WHVSNS+WHVSHY*CCPLNX + WHVXXX=AMAX1(0.0,WHVXXX-WHVSHY) + WHVHSX=WHVXXX*WTHSK(NZ,NY,NX)/WTSHTT + WHVHSY=AMIN1(WTHSK(NZ,NY,NX),WHVHSX) + WHVHSH=WHVHSH+WHVHSY + WHVXXX=AMAX1(0.0,WHVXXX-WHVHSY) + WHVEAX=WHVXXX*WTEAR(NZ,NY,NX)/WTSHTT + WHVEAY=AMIN1(WTEAR(NZ,NY,NX),WHVEAX) + WHVEAH=WHVEAH+WHVEAY + WHVXXX=AMAX1(0.0,WHVEAX-WHVEAY) + WHVGRX=WHVXXX*WTGR(NZ,NY,NX)/WTSHTT + WHVGRY=AMIN1(WTGR(NZ,NY,NX),WHVGRX) + WHVGRH=WHVGRH+WHVGRY + WHVXXX=AMAX1(0.0,WHVGRX-WHVGRY) + ENDIF + ENDIF + ENDIF +C +C ALL HARVEST REMOVALS +C + DO 9860 NB=1,NBR(NZ,NY,NX) + DO 9860 L=1,JC + DO 9860 K=0,25 + WGLFBL(L,NB,NZ,NY,NX)=0.0 +9860 CONTINUE + DO 9870 NB=1,NBR(NZ,NY,NX) + DO 9870 L=1,JC + DO 9870 K=0,25 + WGLFBL(L,NB,NZ,NY,NX)=WGLFBL(L,NB,NZ,NY,NX) + 2+WGLFL(L,K,NB,NZ,NY,NX) +9870 CONTINUE + ENDIF + DO 9865 L=JC,1,-1 + IF(IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6)THEN + IF(IHVST(NZ,I,NY,NX).NE.3)THEN + IF(ZL(L,NY,NX).GT.ZL(L-1,NY,NX))THEN + FHGT=AMAX1(0.0,AMIN1(1.0,1.0-((ZL(L,NY,NX)) + 2-HVST(NZ,I,NY,NX))/(ZL(L,NY,NX)-ZL(L-1,NY,NX)))) + ELSE + FHGT=1.0 + ENDIF + ELSE + FHGT=0.0 + ENDIF + IF(THIN(NZ,I,NY,NX).EQ.0.0)THEN + FHVST=AMAX1(0.0,1.0-(1.0-FHGT)*EHVST(1,1,NZ,I,NY,NX)) + FHVSH=FHVST + ELSE + FHVST=AMAX1(0.0,1.0-THIN(NZ,I,NY,NX)) + IF(IHVST(NZ,I,NY,NX).EQ.0)THEN + FHVSH=1.0-(1.0-FHGT)*EHVST(1,1,NZ,I,NY,NX)*THIN(NZ,I,NY,NX) + ELSE + FHVSH=FHVST + ENDIF + ENDIF + ELSE + FHVST=0.0 + FHVSH=0.0 + ENDIF +C +C CUT LEAVES AT HARVESTED NODES AND LAYERS +C + DO 9855 NB=1,NBR(NZ,NY,NX) + IF((IHVST(NZ,I,NY,NX).EQ.4.OR.IHVST(NZ,I,NY,NX).EQ.6) + 2.AND.WTLF(NZ,NY,NX).GT.ZEROL(NZ,NY,NX))THEN + WHVSBL=WHVSLF*AMAX1(0.0,WGLFBL(L,NB,NZ,NY,NX))/WTLF(NZ,NY,NX) + ELSE + WHVSBL=0.0 + ENDIF + DO 9845 K=25,0,-1 + IF((IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6) + 2.OR.WHVSBL.GT.0.0)THEN + IF(IHVST(NZ,I,NY,NX).EQ.4.OR.IHVST(NZ,I,NY,NX).EQ.6)THEN + IF(WGLFL(L,K,NB,NZ,NY,NX).GT.WHVSBL)THEN + FHVST=AMAX1(0.0,AMIN1(1.0,(WGLFL(L,K,NB,NZ,NY,NX)-WHVSBL) + 2/WGLFL(L,K,NB,NZ,NY,NX))) + FHVSH=FHVST + ELSE + FHVST=1.0 + FHVSH=1.0 + ENDIF + ENDIF +C +C HARVESTED LEAF AREA, C, N, P +C + WHVSBL=WHVSBL-(1.0-FHVST)*WGLFL(L,K,NB,NZ,NY,NX) + WTHTH1=WTHTH1+(1.0-FHVSH)*WGLFL(L,K,NB,NZ,NY,NX)*FWODB(1) + WTHNH1=WTHNH1+(1.0-FHVSH)*WGLFLN(L,K,NB,NZ,NY,NX)*FWODLN(1) + WTHPH1=WTHPH1+(1.0-FHVSH)*WGLFLP(L,K,NB,NZ,NY,NX)*FWODLP(1) + WTHTX1=WTHTX1+(FHVSH-FHVST)*WGLFL(L,K,NB,NZ,NY,NX)*FWODB(1) + WTHNX1=WTHNX1+(FHVSH-FHVST)*WGLFLN(L,K,NB,NZ,NY,NX)*FWODLN(1) + WTHPX1=WTHPX1+(FHVSH-FHVST)*WGLFLP(L,K,NB,NZ,NY,NX)*FWODLP(1) + WTHTH3=WTHTH3+(1.0-FHVSH)*WGLFL(L,K,NB,NZ,NY,NX)*FWODB(0) + WTHNH3=WTHNH3+(1.0-FHVSH)*WGLFLN(L,K,NB,NZ,NY,NX)*FWODLN(0) + WTHPH3=WTHPH3+(1.0-FHVSH)*WGLFLP(L,K,NB,NZ,NY,NX)*FWODLP(0) + WTHTX3=WTHTX3+(FHVSH-FHVST)*WGLFL(L,K,NB,NZ,NY,NX)*FWODB(0) + WTHNX3=WTHNX3+(FHVSH-FHVST)*WGLFLN(L,K,NB,NZ,NY,NX)*FWODLN(0) + WTHPX3=WTHPX3+(FHVSH-FHVST)*WGLFLP(L,K,NB,NZ,NY,NX)*FWODLP(0) +C +C REMAINING LEAF C,N,P AND AREA +C + WGLFL(L,K,NB,NZ,NY,NX)=FHVST*WGLFL(L,K,NB,NZ,NY,NX) + WGLFLN(L,K,NB,NZ,NY,NX)=FHVST*WGLFLN(L,K,NB,NZ,NY,NX) + WGLFLP(L,K,NB,NZ,NY,NX)=FHVST*WGLFLP(L,K,NB,NZ,NY,NX) + ARLFL(L,K,NB,NZ,NY,NX)=FHVST*ARLFL(L,K,NB,NZ,NY,NX) + IF(K.EQ.1)THEN + ARSTK(L,NB,NZ,NY,NX)=FHVST*ARSTK(L,NB,NZ,NY,NX) + ENDIF + ENDIF +C IF(I.EQ.262.AND.K.EQ.5)THEN +C WRITE(*,6543)'GRAZ',I,J,NZ,NB,K,L,IHVST(NZ,I,NY,NX) +C 2,ZL(L,NY,NX),ZL(L-1,NY,NX),HVST(NZ,I,NY,NX),FHVST,FHVSH +C 5,WGLFBL(L,NB,NZ,NY,NX),WTLF(NZ,NY,NX),CPOOLP(NZ,NY,NX) +C 6,ARLFL(L,K,NB,NZ,NY,NX),WGLF(K,NB,NZ,NY,NX),ARLF(K,NB,NZ,NY,NX) +C 7,HTNODE(K,NB,NZ,NY,NX) +C 7,WTSHTA(NZ,NY,NX),WHVSBL,WHVSTT,WHVSLF,WHVSHH +C 3,WHVHSH,WHVEAH,WHVGRH,WHVSCP,WHVSTH,WHVRVH,WHVXXX +C 4,WTSHTT,WHVSSX,CCPOLX +6543 FORMAT(A8,7I4,30E12.4) +C ENDIF +9845 CONTINUE +9855 CONTINUE + ARLFV(L,NZ,NY,NX)=0.0 + WGLFV(L,NZ,NY,NX)=0.0 + ARSTV(L,NZ,NY,NX)=ARSTV(L,NZ,NY,NX)*FHVST +9865 CONTINUE + DO 9835 NB=1,NBR(NZ,NY,NX) + CPOOLG=0.0 + ZPOOLG=0.0 + PPOOLG=0.0 + CPOLNG=0.0 + ZPOLNG=0.0 + PPOLNG=0.0 + WTNDG=0.0 + WTNDNG=0.0 + WTNDPG=0.0 + WGLFGX=0.0 + WGSHGX=0.0 + WGLFGY=0.0 + WGSHGY=0.0 + DO 9825 K=0,25 + ARLFG=0.0 + WGLFG=0.0 + WGLFNG=0.0 + WGLFPG=0.0 +C +C REMAINING LEAF AREA, C, N, P +C + DO 9815 L=1,JC + ARLFG=ARLFG+ARLFL(L,K,NB,NZ,NY,NX) + WGLFG=WGLFG+WGLFL(L,K,NB,NZ,NY,NX) + WGLFNG=WGLFNG+WGLFLN(L,K,NB,NZ,NY,NX) + WGLFPG=WGLFPG+WGLFLP(L,K,NB,NZ,NY,NX) + ARLFV(L,NZ,NY,NX)=ARLFV(L,NZ,NY,NX)+ARLFL(L,K,NB,NZ,NY,NX) + WGLFV(L,NZ,NY,NX)=WGLFV(L,NZ,NY,NX)+WGLFL(L,K,NB,NZ,NY,NX) +9815 CONTINUE +C +C ACCUMULATE REMAINING BRANCH LEAF AREA, C, N, P +C + IF(IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6)THEN + IF(WGLF(K,NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX) + 2.AND.EHVST(1,1,NZ,I,NY,NX).GT.0.0)THEN + FHVSTK(K)=AMAX1(0.0,AMIN1(1.0,(1.0-(1.0-AMAX1(0.0,WGLFG) + 2/WGLF(K,NB,NZ,NY,NX))*EHVST(1,2,NZ,I,NY,NX) + 3/EHVST(1,1,NZ,I,NY,NX)))) + FHVSHK(K)=FHVSTK(K) + ELSE + IF(THIN(NZ,I,NY,NX).EQ.0.0)THEN + FHVSTK(K)=1.0-EHVST(1,2,NZ,I,NY,NX) + FHVSHK(K)=FHVSTK(K) + ELSE + FHVSTK(K)=1.0-THIN(NZ,I,NY,NX) + IF(IHVST(NZ,I,NY,NX).EQ.0)THEN + FHVSHK(K)=1.0-EHVST(1,2,NZ,I,NY,NX)*THIN(NZ,I,NY,NX) + ELSE + FHVSHK(K)=FHVSTK(K) + ENDIF + ENDIF + ENDIF + ELSE + FHVSTK(K)=0.0 + FHVSHK(K)=0.0 + ENDIF + WGLFGY=WGLFGY+WGLF(K,NB,NZ,NY,NX) + WTLFB(NB,NZ,NY,NX)=WTLFB(NB,NZ,NY,NX) + 2-WGLF(K,NB,NZ,NY,NX)+WGLFG + WTLFBN(NB,NZ,NY,NX)=WTLFBN(NB,NZ,NY,NX) + 2-WGLFN(K,NB,NZ,NY,NX)+WGLFNG + WTLFBP(NB,NZ,NY,NX)=WTLFBP(NB,NZ,NY,NX) + 2-WGLFP(K,NB,NZ,NY,NX)+WGLFPG + ARLFB(NB,NZ,NY,NX)=ARLFB(NB,NZ,NY,NX)-ARLF(K,NB,NZ,NY,NX)+ARLFG + IF(ARLF(K,NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + WSLF(K,NB,NZ,NY,NX)=WSLF(K,NB,NZ,NY,NX)*ARLFG/ARLF(K,NB,NZ,NY,NX) + ELSE + WSLF(K,NB,NZ,NY,NX)=0.0 + ENDIF + ARLF(K,NB,NZ,NY,NX)=ARLFG + WGLF(K,NB,NZ,NY,NX)=WGLFG + WGLFN(K,NB,NZ,NY,NX)=WGLFNG + WGLFP(K,NB,NZ,NY,NX)=WGLFPG + WGLFGX=WGLFGX+WGLF(K,NB,NZ,NY,NX) +9825 CONTINUE +C +C CUT SHEATHS OR PETIOLES AND STALKS HARVESTED NODES AND LAYERS +C + HTSTKX=-1.0 + IF((IHVST(NZ,I,NY,NX).EQ.4.OR.IHVST(NZ,I,NY,NX).EQ.6) + 2.AND.WTSHE(NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + WHVSBS=WHVSHH*WTSHEB(NB,NZ,NY,NX)/WTSHE(NZ,NY,NX) + ELSE + WHVSBS=0.0 + ENDIF + DO 9805 K=25,0,-1 +C WRITE(*,112)'VSTG',I,J,NX,NY,NZ,NB,K,VSTG(NB,NZ,NY,NX),FHVSTK(K) +C 2,HTNODE(K,NB,NZ,NY,NX),HVST(NZ,I,NY,NX) +112 FORMAT(A8,7I4,12E12.4) + IF(HTNODE(K,NB,NZ,NY,NX).GT.0.0) + 2HTSTKX=AMAX1(HTSTKX,HTNODE(K,NB,NZ,NY,NX)) +C +C HARVESTED SHEATH OR PETIOLE C,N,P +C + IF((IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6) + 2.OR.WHVSBS.GT.0.0)THEN + IF(IHVST(NZ,I,NY,NX).EQ.4.OR.IHVST(NZ,I,NY,NX).EQ.6)THEN + IF(WGSHE(K,NB,NZ,NY,NX).GT.WHVSBS)THEN + FHVSTK(K)=AMAX1(0.0,AMIN1(1.0,(WGSHE(K,NB,NZ,NY,NX)-WHVSBS) + 2/WGSHE(K,NB,NZ,NY,NX))) + FHVSHK(K)=FHVSTK(K) + ELSE + FHVSTK(K)=0.0 + FHVSHK(K)=0.0 + ENDIF + ENDIF + WHVSBS=WHVSBS-(1.0-FHVSTK(K))*WGSHE(K,NB,NZ,NY,NX) + WTHTH2=WTHTH2+(1.0-FHVSHK(K))*WGSHE(K,NB,NZ,NY,NX)*FWODB(1) + WTHNH2=WTHNH2+(1.0-FHVSHK(K))*WGSHN(K,NB,NZ,NY,NX)*FWODSN(1) + WTHPH2=WTHPH2+(1.0-FHVSHK(K))*WGSHP(K,NB,NZ,NY,NX)*FWODSP(1) + WTHTX2=WTHTX2+(FHVSHK(K)-FHVSTK(K))*WGSHE(K,NB,NZ,NY,NX) + 2*FWODB(1) + WTHNX2=WTHNX2+(FHVSHK(K)-FHVSTK(K))*WGSHN(K,NB,NZ,NY,NX) + 2*FWODSN(1) + WTHPX2=WTHPX2+(FHVSHK(K)-FHVSTK(K))*WGSHP(K,NB,NZ,NY,NX) + 2*FWODSP(1) + WTHTH3=WTHTH3+(1.0-FHVSHK(K))*WGSHE(K,NB,NZ,NY,NX)*FWODB(0) + WTHNH3=WTHNH3+(1.0-FHVSHK(K))*WGSHN(K,NB,NZ,NY,NX)*FWODSN(0) + WTHPH3=WTHPH3+(1.0-FHVSHK(K))*WGSHP(K,NB,NZ,NY,NX)*FWODSP(0) + WTHTX3=WTHTX3+(FHVSHK(K)-FHVSTK(K))*WGSHE(K,NB,NZ,NY,NX) + 2*FWODB(0) + WTHNX3=WTHNX3+(FHVSHK(K)-FHVSTK(K))*WGSHN(K,NB,NZ,NY,NX) + 2*FWODSN(0) + WTHPX3=WTHPX3+(FHVSHK(K)-FHVSTK(K))*WGSHP(K,NB,NZ,NY,NX) + 2*FWODSP(0) +C +C REMAINING SHEATH OR PETIOLE C,N,P AND LENGTH +C + WGSHGY=WGSHGY+WGSHE(K,NB,NZ,NY,NX) + WTSHEB(NB,NZ,NY,NX)=WTSHEB(NB,NZ,NY,NX) + 2-(1.0-FHVSTK(K))*WGSHE(K,NB,NZ,NY,NX) + WTSHBN(NB,NZ,NY,NX)=WTSHBN(NB,NZ,NY,NX) + 2-(1.0-FHVSTK(K))*WGSHN(K,NB,NZ,NY,NX) + WTSHBP(NB,NZ,NY,NX)=WTSHBP(NB,NZ,NY,NX) + 2-(1.0-FHVSTK(K))*WGSHP(K,NB,NZ,NY,NX) + WGSHE(K,NB,NZ,NY,NX)=FHVSTK(K)*WGSHE(K,NB,NZ,NY,NX) + WSSHE(K,NB,NZ,NY,NX)=FHVSTK(K)*WSSHE(K,NB,NZ,NY,NX) + WGSHN(K,NB,NZ,NY,NX)=FHVSTK(K)*WGSHN(K,NB,NZ,NY,NX) + WGSHP(K,NB,NZ,NY,NX)=FHVSTK(K)*WGSHP(K,NB,NZ,NY,NX) + WSSHE(K,NB,NZ,NY,NX)=FHVSTK(K)*WSSHE(K,NB,NZ,NY,NX) + IF(IHVST(NZ,I,NY,NX).LE.2 + 2.AND.HTSHE(K,NB,NZ,NY,NX).GT.0.0)THEN + FHGT=AMAX1(0.0,AMIN1(1.0,(HTNODE(K,NB,NZ,NY,NX) + 2+HTSHE(K,NB,NZ,NY,NX)-HVST(NZ,I,NY,NX))/HTSHE(K,NB,NZ,NY,NX))) + HTSHE(K,NB,NZ,NY,NX)=(1.0-FHGT)*HTSHE(K,NB,NZ,NY,NX) + ELSE + HTSHE(K,NB,NZ,NY,NX)=FHVSTK(K)*HTSHE(K,NB,NZ,NY,NX) + ENDIF + WGSHGX=WGSHGX+WGSHE(K,NB,NZ,NY,NX) +C IF(IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6)THEN +C IF(HTNODE(K,NB,NZ,NY,NX).GT.HVST(NZ,I,NY,NX) +C 2.OR.IHVST(NZ,I,NY,NX).EQ.3)THEN +C IF(FHVSTK(K).EQ.0.0.AND.K.GT.0)THEN +C IF(IBTYP(NZ,NY,NX).EQ.0.OR.IGTYP(NZ,NY,NX).LE.1)THEN +C VSTG(NB,NZ,NY,NX)=AMAX1(0.0,VSTG(NB,NZ,NY,NX)-1.0) +C ELSE +C VSTG(NB,NZ,NY,NX)=AMAX1(0.0,VSTG(NB,NZ,NY,NX)-0.04) +C ENDIF +C ENDIF +C ENDIF +C ENDIF + ENDIF +9805 CONTINUE +C +C CUT NON-STRUCTURAL C,N,P IN HARVESTED BRANCHES +C + CPOOLX=AMAX1(0.0,CPOOL(NB,NZ,NY,NX)) + ZPOOLX=AMAX1(0.0,ZPOOL(NB,NZ,NY,NX)) + PPOOLX=AMAX1(0.0,PPOOL(NB,NZ,NY,NX)) + CPOLNX=AMAX1(0.0,CPOLNB(NB,NZ,NY,NX)) + ZPOLNX=AMAX1(0.0,ZPOLNB(NB,NZ,NY,NX)) + PPOLNX=AMAX1(0.0,PPOLNB(NB,NZ,NY,NX)) + IF(IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6)THEN + IF(WGLFGY+WGSHGY.GT.ZEROP(NZ,NY,NX))THEN + FHVST=AMAX1(0.0,AMIN1(1.0,(WGLFGX+WGSHGX) + 2/(WGLFGY+WGSHGY))) + CPOOLG=CPOOLX*FHVST + ZPOOLG=ZPOOLX*FHVST + PPOOLG=PPOOLX*FHVST + CPOLNG=CPOLNX*FHVST + ZPOLNG=ZPOLNX*FHVST + PPOLNG=PPOLNX*FHVST + WTNDG=WTNDB(NB,NZ,NY,NX)*FHVST + WTNDNG=WTNDBN(NB,NZ,NY,NX)*FHVST + WTNDPG=WTNDBP(NB,NZ,NY,NX)*FHVST + ELSE + CPOOLG=0.0 + ZPOOLG=0.0 + PPOOLG=0.0 + CPOLNG=0.0 + ZPOLNG=0.0 + PPOLNG=0.0 + WTNDG=0.0 + WTNDNG=0.0 + WTNDPG=0.0 + ENDIF + ELSE + IF(WTLS(NZ,NY,NX).GT.ZEROL(NZ,NY,NX))THEN + WTLSBX=AMAX1(0.0,WTLSB(NB,NZ,NY,NX)) + IF(CPOOL(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + WHVSCX=AMAX1(0.0,WHVSCP)*WTLSBX/WTLS(NZ,NY,NX) + CPOOLG=AMAX1(0.0,CPOOLX-WHVSCX) + ZPOOLG=AMAX1(0.0,ZPOOLX-WHVSCX*ZPOOLX/CPOOL(NB,NZ,NY,NX)) + PPOOLG=AMAX1(0.0,PPOOLX-WHVSCX*PPOOLX/CPOOL(NB,NZ,NY,NX)) + ELSE + CPOOLG=0.0 + ZPOOLG=0.0 + PPOOLG=0.0 + ENDIF + IF(CPOLNB(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + WHVSNX=AMAX1(0.0,WHVSNP)*WTLSBX/WTLS(NZ,NY,NX) + CPOLNG=AMAX1(0.0,CPOLNX-WHVSNX) + ZPOLNG=AMAX1(0.0,ZPOLNX-WHVSNX*ZPOLNX/CPOLNB(NB,NZ,NY,NX)) + PPOLNG=AMAX1(0.0,PPOLNX-WHVSNX*PPOLNX/CPOLNB(NB,NZ,NY,NX)) + WTNDG=WTNDB(NB,NZ,NY,NX)*(1.0-WHVSNX/CPOLNX) + WTNDNG=WTNDBN(NB,NZ,NY,NX)*(1.0-WHVSNX/CPOLNX) + WTNDPG=WTNDBP(NB,NZ,NY,NX)*(1.0-WHVSNX/CPOLNX) + ELSE + CPOLNG=0.0 + ZPOLNG=0.0 + PPOLNG=0.0 + WTNDG=0.0 + WTNDNG=0.0 + WTNDPG=0.0 + ENDIF + ELSE + CPOOLG=0.0 + ZPOOLG=0.0 + PPOOLG=0.0 + CPOLNG=0.0 + ZPOLNG=0.0 + PPOLNG=0.0 + WTNDG=0.0 + WTNDNG=0.0 + WTNDPG=0.0 + ENDIF + ENDIF +C +C HARVESTED NON-STRUCTURAL C, N, P +C + WTHTH0=WTHTH0+CPOOLX-CPOOLG+CPOLNX-CPOLNG + WTHNH0=WTHNH0+ZPOOLX-ZPOOLG+ZPOLNX-ZPOLNG + WTHPH0=WTHPH0+PPOOLX-PPOOLG+PPOLNX-PPOLNG + WTHTH0=WTHTH0+WTNDB(NB,NZ,NY,NX)-WTNDG + WTHNH0=WTHNH0+WTNDBN(NB,NZ,NY,NX)-WTNDNG + WTHPH0=WTHPH0+WTNDBP(NB,NZ,NY,NX)-WTNDPG +C +C REMAINING NON-STRUCTURAL C, N, P +C + CPOOL(NB,NZ,NY,NX)=CPOOLG + ZPOOL(NB,NZ,NY,NX)=ZPOOLG + PPOOL(NB,NZ,NY,NX)=PPOOLG + CPOLNB(NB,NZ,NY,NX)=CPOLNG + ZPOLNB(NB,NZ,NY,NX)=ZPOLNG + PPOLNB(NB,NZ,NY,NX)=PPOLNG + WTNDB(NB,NZ,NY,NX)=WTNDG + WTNDBN(NB,NZ,NY,NX)=WTNDNG + WTNDBP(NB,NZ,NY,NX)=WTNDPG +C +C REMOVE C4 NON-STRUCTURAL C +C + IF(ICTYP(NZ,NY,NX).EQ.4.AND.CPOOLX.GT.ZEROP(NZ,NY,NX))THEN + FHVST4=CPOOLG/CPOOLX + DO 9810 K=1,25 + WTHTH0=WTHTH0+(1.0-FHVST4)*CPOOL3(K,NB,NZ,NY,NX) + WTHTH0=WTHTH0+(1.0-FHVST4)*CPOOL4(K,NB,NZ,NY,NX) + WTHTH0=WTHTH0+(1.0-FHVST4)*CO2B(K,NB,NZ,NY,NX) + WTHTH0=WTHTH0+(1.0-FHVST4)*HCOB(K,NB,NZ,NY,NX) + CPOOL3(K,NB,NZ,NY,NX)=FHVST4*CPOOL3(K,NB,NZ,NY,NX) + CPOOL4(K,NB,NZ,NY,NX)=FHVST4*CPOOL4(K,NB,NZ,NY,NX) + CO2B(K,NB,NZ,NY,NX)=FHVST4*CO2B(K,NB,NZ,NY,NX) + HCOB(K,NB,NZ,NY,NX)=FHVST4*HCOB(K,NB,NZ,NY,NX) +9810 CONTINUE + ENDIF +C +C CUT STALKS +C + IF(IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6)THEN + IF(HTSTKX.GT.ZERO)THEN + IF(IHVST(NZ,I,NY,NX).NE.3)THEN + FHGT=AMAX1(0.0,AMIN1(1.0,HVST(NZ,I,NY,NX)/HTSTKX)) + ELSE + FHGT=0.0 + ENDIF + IF(THIN(NZ,I,NY,NX).EQ.0.0)THEN + FHVST=AMAX1(0.0,1.0-(1.0-FHGT)*EHVST(1,3,NZ,I,NY,NX)) + FHVSH=FHVST + ELSE + FHVST=AMAX1(0.0,1.0-THIN(NZ,I,NY,NX)) + IF(IHVST(NZ,I,NY,NX).EQ.0)THEN + FHVSH=1.0-(1.0-FHGT)*EHVST(1,3,NZ,I,NY,NX)*THIN(NZ,I,NY,NX) + ELSE + FHVSH=FHVST + ENDIF + ENDIF + ELSE + FHVST=1.0 + FHVSH=1.0 + ENDIF + ELSE + IF(WTSTK(NZ,NY,NX).GT.ZEROL(NZ,NY,NX))THEN + FHVST=AMAX1(0.0,AMIN1(1.0,1.0-WHVSTH/WTSTK(NZ,NY,NX))) + FHVSH=FHVST + ELSE + FHVST=1.0 + FHVSH=1.0 + ENDIF + ENDIF +C +C HARVESTED STALK C,N,P +C + WTHTH3=WTHTH3+(1.0-FHVSH)*WTSTKB(NB,NZ,NY,NX) + WTHNH3=WTHNH3+(1.0-FHVSH)*WTSTBN(NB,NZ,NY,NX) + WTHPH3=WTHPH3+(1.0-FHVSH)*WTSTBP(NB,NZ,NY,NX) + WTHTX3=WTHTX3+(FHVSH-FHVST)*WTSTKB(NB,NZ,NY,NX) + WTHNX3=WTHNX3+(FHVSH-FHVST)*WTSTBN(NB,NZ,NY,NX) + WTHPX3=WTHPX3+(FHVSH-FHVST)*WTSTBP(NB,NZ,NY,NX) +C +C REMAINING STALK C,N,P +C + WTSTKB(NB,NZ,NY,NX)=FHVST*WTSTKB(NB,NZ,NY,NX) + WTSTBN(NB,NZ,NY,NX)=FHVST*WTSTBN(NB,NZ,NY,NX) + WTSTBP(NB,NZ,NY,NX)=FHVST*WTSTBP(NB,NZ,NY,NX) + WVSTKB(NB,NZ,NY,NX)=FHVST*WVSTKB(NB,NZ,NY,NX) + WTSTXB(NB,NZ,NY,NX)=FHVST*WTSTXB(NB,NZ,NY,NX) + WTSTXN(NB,NZ,NY,NX)=FHVST*WTSTXN(NB,NZ,NY,NX) + WTSTXP(NB,NZ,NY,NX)=FHVST*WTSTXP(NB,NZ,NY,NX) + +C +C CUT STALK NODES +C + DO 9820 K=25,0,-1 + IF(IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6)THEN + IF(HTNODX(K,NB,NZ,NY,NX).GT.ZERO)THEN + IF(IHVST(NZ,I,NY,NX).NE.3)THEN + FHGT=AMAX1(0.0,AMIN1(1.0,(HTNODE(K,NB,NZ,NY,NX) + 2-HVST(NZ,I,NY,NX))/HTNODX(K,NB,NZ,NY,NX))) + ELSE + FHGT=0.0 + ENDIF + IF(THIN(NZ,I,NY,NX).EQ.0.0)THEN + FHVST=AMAX1(0.0,1.0-FHGT*EHVST(1,3,NZ,I,NY,NX)) + ELSE + FHVST=AMAX1(0.0,1.0-THIN(NZ,I,NY,NX)) + ENDIF + ELSE + FHVST=1.0 + ENDIF + ELSE + IF(WTSTK(NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + FHVST=AMAX1(0.0,AMIN1(1.0,1.0-WHVSTH/WTSTK(NZ,NY,NX))) + ELSE + FHVST=1.0 + ENDIF + ENDIF + WGNODE(K,NB,NZ,NY,NX)=FHVST*WGNODE(K,NB,NZ,NY,NX) + WGNODN(K,NB,NZ,NY,NX)=FHVST*WGNODN(K,NB,NZ,NY,NX) + WGNODP(K,NB,NZ,NY,NX)=FHVST*WGNODP(K,NB,NZ,NY,NX) + IF(IHVST(NZ,I,NY,NX).LE.2.AND.THIN(NZ,I,NY,NX).EQ.0.0)THEN + HTNODX(K,NB,NZ,NY,NX)=FHVST*HTNODX(K,NB,NZ,NY,NX) + HTNODE(K,NB,NZ,NY,NX)=AMIN1(HTNODE(K,NB,NZ,NY,NX) + 2,HVST(NZ,I,NY,NX)) + ENDIF +C IF(NZ.EQ.2)THEN +C WRITE(*,4811)'STK2',I,J,NZ,NB,K,IHVST(NZ,I,NY,NX) +C 2,HTNODX(K,NB,NZ,NY,NX),HTNODE(K,NB,NZ,NY,NX) +C 3,HVST(NZ,I,NY,NX),FHGT,FHVST,ARLF(K,NB,NZ,NY,NX) +C 4,EHVST(1,3,NZ,I,NY,NX),THIN(NZ,I,NY,NX) +4811 FORMAT(A8,6I4,12E12.4) +C ENDIF +9820 CONTINUE +C +C CUT STALK RESERVES +C + IF(IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6)THEN + IF(WTSTKB(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + FHVST=FHVST + FHVSH=FHVSH + ELSE + FHVST=0.0 + FHVSH=0.0 + ENDIF + ELSE + IF(WTRSV(NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + FHVST=AMAX1(0.0,AMIN1(1.0,1.0-WHVRVH/WTRSV(NZ,NY,NX))) + FHVSH=FHVST + ELSE + FHVST=0.0 + FHVSH=0.0 + ENDIF + ENDIF +C +C HARVESTED STALK RESERVE C,N,P +C + WTHTH3=WTHTH3+(1.0-FHVSH)*WTRSVB(NB,NZ,NY,NX) + WTHNH3=WTHNH3+(1.0-FHVSH)*WTRSBN(NB,NZ,NY,NX) + WTHPH3=WTHPH3+(1.0-FHVSH)*WTRSBP(NB,NZ,NY,NX) + WTHTX3=WTHTX3+(FHVSH-FHVST)*WTRSVB(NB,NZ,NY,NX) + WTHNX3=WTHNX3+(FHVSH-FHVST)*WTRSBN(NB,NZ,NY,NX) + WTHPX3=WTHPX3+(FHVSH-FHVST)*WTRSBP(NB,NZ,NY,NX) +C +C REMAINING STALK RESERVE C,N,P IF STALK REMAINING +C + WTRSVB(NB,NZ,NY,NX)=FHVST*WTRSVB(NB,NZ,NY,NX) + WTRSBN(NB,NZ,NY,NX)=FHVST*WTRSBN(NB,NZ,NY,NX) + WTRSBP(NB,NZ,NY,NX)=FHVST*WTRSBP(NB,NZ,NY,NX) +C +C CUT REPRODUCTIVE ORGANS +C + IF(IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6)THEN + IF(HVST(NZ,I,NY,NX).LT.HTSTKX + 2.OR.IHVST(NZ,I,NY,NX).EQ.3)THEN + IF(THIN(NZ,I,NY,NX).EQ.0.0)THEN + FHVSTG=1.0-EHVST(1,2,NZ,I,NY,NX) + FHVSHG=FHVSTG + ELSE + FHVSTG=1.0-THIN(NZ,I,NY,NX) + FHVSHG=1.0-EHVST(1,2,NZ,I,NY,NX)*THIN(NZ,I,NY,NX) + ENDIF + ELSE + FHVSTG=1.0-THIN(NZ,I,NY,NX) + FHVSHG=FHVSTG + ENDIF + FHVSTH=FHVSTG + FHVSTE=FHVSTG + FHVSHH=FHVSHG + FHVSHE=FHVSHG + ELSE + IF(WTHSK(NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + FHVSTH=AMAX1(0.0,AMIN1(1.0,1.0-WHVHSH/WTHSK(NZ,NY,NX))) + FHVSHH=FHVSTH + ELSE + FHVSTH=1.0 + FHVSHH=1.0 + ENDIF + IF(WTEAR(NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + FHVSTE=AMAX1(0.0,AMIN1(1.0,1.0-WHVEAH/WTEAR(NZ,NY,NX))) + FHVSHE=FHVSTE + ELSE + FHVSTE=1.0 + FHVSHE=1.0 + ENDIF + IF(WTGR(NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + FHVSTG=AMAX1(0.0,AMIN1(1.0,1.0-WHVGRH/WTGR(NZ,NY,NX))) + FHVSHG=FHVSTG + ELSE + FHVSTG=1.0 + FHVSHG=1.0 + ENDIF + ENDIF +C +C HARVESTED REPRODUCTIVE C,N,P +C + WTHTH2=WTHTH2+(1.0-FHVSHH)*WTHSKB(NB,NZ,NY,NX)+(1.0-FHVSHE) + 2*WTEARB(NB,NZ,NY,NX)+(1.0-FHVSHG)*WTGRB(NB,NZ,NY,NX) + WTHNH2=WTHNH2+(1.0-FHVSHH)*WTHSBN(NB,NZ,NY,NX)+(1.0-FHVSHE) + 2*WTEABN(NB,NZ,NY,NX)+(1.0-FHVSHG)*WTGRBN(NB,NZ,NY,NX) + WTHPH2=WTHPH2+(1.0-FHVSHH)*WTHSBP(NB,NZ,NY,NX)+(1.0-FHVSHE) + 2*WTEABP(NB,NZ,NY,NX)+(1.0-FHVSHG)*WTGRBP(NB,NZ,NY,NX) + WTHTX2=WTHTX2+(FHVSHH-FHVSTH)*WTHSKB(NB,NZ,NY,NX)+(FHVSHE-FHVSTE) + 2*WTEARB(NB,NZ,NY,NX)+(FHVSHG-FHVSTG)*WTGRB(NB,NZ,NY,NX) + WTHNX2=WTHNX2+(FHVSHH-FHVSTH)*WTHSBN(NB,NZ,NY,NX)+(FHVSHE-FHVSTE) + 2*WTEABN(NB,NZ,NY,NX)+(FHVSHG-FHVSTG)*WTGRBN(NB,NZ,NY,NX) + WTHPX2=WTHPX2+(FHVSHH-FHVSTH)*WTHSBP(NB,NZ,NY,NX)+(FHVSHE-FHVSTE) + 2*WTEABP(NB,NZ,NY,NX)+(FHVSHG-FHVSTG)*WTGRBP(NB,NZ,NY,NX) + WTHTG=WTHTG+(1.0-FHVSTG)*WTGRB(NB,NZ,NY,NX) + WTHNG=WTHNG+(1.0-FHVSTG)*WTGRBN(NB,NZ,NY,NX) + WTHPG=WTHPG+(1.0-FHVSTG)*WTGRBP(NB,NZ,NY,NX) +C +C REMAINING REPRODUCTIVE C,N,P +C + WTHSKB(NB,NZ,NY,NX)=FHVSTH*WTHSKB(NB,NZ,NY,NX) + WTEARB(NB,NZ,NY,NX)=FHVSTE*WTEARB(NB,NZ,NY,NX) + WTGRB(NB,NZ,NY,NX)=FHVSTG*WTGRB(NB,NZ,NY,NX) + WTHSBN(NB,NZ,NY,NX)=FHVSTH*WTHSBN(NB,NZ,NY,NX) + WTEABN(NB,NZ,NY,NX)=FHVSTE*WTEABN(NB,NZ,NY,NX) + WTGRBN(NB,NZ,NY,NX)=FHVSTG*WTGRBN(NB,NZ,NY,NX) + WTHSBP(NB,NZ,NY,NX)=FHVSTH*WTHSBP(NB,NZ,NY,NX) + WTEABP(NB,NZ,NY,NX)=FHVSTE*WTEABP(NB,NZ,NY,NX) + WTGRBP(NB,NZ,NY,NX)=FHVSTG*WTGRBP(NB,NZ,NY,NX) + GRNXB(NB,NZ,NY,NX)=FHVSTG*GRNXB(NB,NZ,NY,NX) + GRNOB(NB,NZ,NY,NX)=FHVSTG*GRNOB(NB,NZ,NY,NX) + GRWTB(NB,NZ,NY,NX)=FHVSTG*GRWTB(NB,NZ,NY,NX) +C +C REMAINING TOTAL BRANCH C,N,P AND LEAF, STALK AREA +C + CPOOLK(NB,NZ,NY,NX)=0.0 + DO 1325 K=1,25 + CPOOLK(NB,NZ,NY,NX)=CPOOLK(NB,NZ,NY,NX) + 2+CPOOL3(K,NB,NZ,NY,NX)+CPOOL4(K,NB,NZ,NY,NX) + 2+CO2B(K,NB,NZ,NY,NX)+HCOB(K,NB,NZ,NY,NX) +1325 CONTINUE + WTLSB(NB,NZ,NY,NX)=AMAX1(0.0,WTLFB(NB,NZ,NY,NX) + 2+WTSHEB(NB,NZ,NY,NX)) + WTSHTB(NB,NZ,NY,NX)=AMAX1(0.0,WTLFB(NB,NZ,NY,NX) + 2+WTSHEB(NB,NZ,NY,NX)+WTSTKB(NB,NZ,NY,NX)+WTRSVB(NB,NZ,NY,NX) + 3+WTHSKB(NB,NZ,NY,NX)+WTEARB(NB,NZ,NY,NX)+WTGRB(NB,NZ,NY,NX) + 4+CPOOL(NB,NZ,NY,NX)+CPOOLK(NB,NZ,NY,NX)) + WTSHTN(NB,NZ,NY,NX)=AMAX1(0.0,WTLFBN(NB,NZ,NY,NX) + 2+WTSHBN(NB,NZ,NY,NX)+WTSTBN(NB,NZ,NY,NX)+WTRSBN(NB,NZ,NY,NX) + 3+WTHSBN(NB,NZ,NY,NX)+WTEABN(NB,NZ,NY,NX)+WTGRBN(NB,NZ,NY,NX) + 4+ZPOOL(NB,NZ,NY,NX)) + WTSHTP(NB,NZ,NY,NX)=AMAX1(0.0,WTLFBP(NB,NZ,NY,NX) + 2+WTSHBP(NB,NZ,NY,NX)+WTSTBP(NB,NZ,NY,NX)+WTRSBP(NB,NZ,NY,NX) + 3+WTHSBP(NB,NZ,NY,NX)+WTEABP(NB,NZ,NY,NX)+WTGRBP(NB,NZ,NY,NX) + 4+PPOOL(NB,NZ,NY,NX)) + VOLWPX=VOLWP(NZ,NY,NX) + WVPLT=AMAX1(0.0,WTLS(NZ,NY,NX)+WVSTK(NZ,NY,NX)) + APSILT=ABS(PSILT(NZ,NY,NX)) + FDM=0.16+0.10*APSILT/(0.05*APSILT+2.0) + VOLWP(NZ,NY,NX)=1.0E-06*WVPLT/FDM + VOLWOU=VOLWOU+VOLWPX-VOLWP(NZ,NY,NX) + UVOLO(NY,NX)=UVOLO(NY,NX)+VOLWPX-VOLWP(NZ,NY,NX) +C +C RESET PHENOLOGY, GROWTH STAGE IF STALKS ARE CUT +C + IF((IBTYP(NZ,NY,NX).EQ.0.OR.IGTYP(NZ,NY,NX).LE.1) + 2.AND.(IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6) + 3.AND.ZC(NZ,NY,NX).GT.HVST(NZ,I,NY,NX))THEN + IF((IWTYP(NZ,NY,NX).NE.0 + 2.AND.VRNF(NB,NZ,NY,NX).LE.FVRN*VRNX(NB,NZ,NY,NX)) + 3.OR.(IWTYP(NZ,NY,NX).EQ.0 + 4.AND.IDAY(1,NB,NZ,NY,NX).NE.0))THEN + GROUP(NB,NZ,NY,NX)=GROUPI(NZ,NY,NX) + PSTGI(NB,NZ,NY,NX)=PSTG(NB,NZ,NY,NX) + PSTGF(NB,NZ,NY,NX)=0.0 + VSTGX(NB,NZ,NY,NX)=0.0 + TGSTGI(NB,NZ,NY,NX)=0.0 + TGSTGF(NB,NZ,NY,NX)=0.0 + FLG4(NB,NZ,NY,NX)=0.0 + IDAY(1,NB,NZ,NY,NX)=I + DO 3005 M=2,10 + IDAY(M,NB,NZ,NY,NX)=0 +3005 CONTINUE + IFLGA(NB,NZ,NY,NX)=0 + IF(NB.EQ.NB1(NZ,NY,NX))THEN + DO 3010 NBX=1,NBR(NZ,NY,NX) + IF(NBX.NE.NB1(NZ,NY,NX))THEN + GROUP(NBX,NZ,NY,NX)=GROUPI(NZ,NY,NX) + PSTGI(NBX,NZ,NY,NX)=PSTG(NBX,NZ,NY,NX) + PSTGF(NBX,NZ,NY,NX)=0.0 + VSTGX(NBX,NZ,NY,NX)=0.0 + TGSTGI(NBX,NZ,NY,NX)=0.0 + TGSTGF(NBX,NZ,NY,NX)=0.0 + FLG4(NBX,NZ,NY,NX)=0.0 + IDAY(1,NBX,NZ,NY,NX)=I + DO 3015 M=2,10 + IDAY(M,NBX,NZ,NY,NX)=0 +3015 CONTINUE + IFLGA(NBX,NZ,NY,NX)=0 + ENDIF +3010 CONTINUE + ENDIF + ENDIF + ENDIF +C +C DEATH OF BRANCH IF KILLING HARVEST ENTERED IN 'READQ' +C + IF(JHVST(NZ,I,NY,NX).NE.0)IDTHB(NB,NZ,NY,NX)=1 + IF(PP(NZ,NY,NX).LE.0.0)IDTHB(NB,NZ,NY,NX)=1 +9835 CONTINUE + WTLS(NZ,NY,NX)=0.0 + WTSTK(NZ,NY,NX)=0.0 + WVSTK(NZ,NY,NX)=0.0 + ARSTP(NZ,NY,NX)=0.0 + DO 9840 NB=1,NBR(NZ,NY,NX) + WTLS(NZ,NY,NX)=WTLS(NZ,NY,NX)+WTLSB(NB,NZ,NY,NX) + WTSTK(NZ,NY,NX)=WTSTK(NZ,NY,NX)+WTSTKB(NB,NZ,NY,NX) + WVSTK(NZ,NY,NX)=WVSTK(NZ,NY,NX)+WVSTKB(NB,NZ,NY,NX) + DO 9830 L=1,JC + ARSTP(NZ,NY,NX)=ARSTP(NZ,NY,NX)+ARSTK(L,NB,NZ,NY,NX) +9830 CONTINUE +9840 CONTINUE +C +C ROOT LITTERFALL FROM HARVESTING OR FIRE +C + IF(IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6)THEN + XHVST=1.0-THIN(NZ,I,NY,NX) + DO 3985 N=1,MY(NZ,NY,NX) + DO 3980 L=NU(NY,NX),NJ(NY,NX) + IF(IHVST(NZ,I,NY,NX).NE.5)THEN + XHVST=1.0-THIN(NZ,I,NY,NX) + XHVSN=XHVST + XHVSP=XHVST + FFIRE=0.0 + FFIRN=0.0 + FFIRP=0.0 + ELSE + IF(THETW(L,NY,NX).GT.FVLWB.OR.CORGC(L,NY,NX).LE.FORGC)THEN + XHVST=1.0 + XHVSN=XHVST + XHVSP=XHVST + FFIRE=0.0 + FFIRN=0.0 + FFIRP=0.0 + ELSE + XHVST=1.0-EHVST(1,3,NZ,I,NY,NX)*AMIN1(1.0,(CORGC(L,NY,NX)-FORGC) + 2/(0.5E+06-FORGC)) + XHVSN=XHVST + XHVSP=XHVST + FFIRE=EHVST(2,3,NZ,I,NY,NX) + FFIRN=FFIRE*EFIRE(1,IHVST(NZ,I,NY,NX)) + FFIRP=FFIRE*EFIRE(2,IHVST(NZ,I,NY,NX)) + ENDIF + ENDIF + DO 3385 M=1,4 + FHVST=(1.0-XHVST)*CFOPC(0,M,NZ,NY,NX)*CPOOLR(N,L,NZ,NY,NX) + FHVSN=(1.0-XHVSN)*CFOPN(0,M,NZ,NY,NX)*ZPOOLR(N,L,NZ,NY,NX) + FHVSP=(1.0-XHVSP)*CFOPP(0,M,NZ,NY,NX)*PPOOLR(N,L,NZ,NY,NX) + CSNC(M,1,L,NZ,NY,NX)=CSNC(M,1,L,NZ,NY,NX)+(1.0-FFIRE)*FHVST + ZSNC(M,1,L,NZ,NY,NX)=ZSNC(M,1,L,NZ,NY,NX)+(1.0-FFIRN)*FHVSN + PSNC(M,1,L,NZ,NY,NX)=PSNC(M,1,L,NZ,NY,NX)+(1.0-FFIRP)*FHVSP + VCO2F(NZ,NY,NX)=VCO2F(NZ,NY,NX)-(1.0-FCH4F)*FFIRE*FHVST + VCH4F(NZ,NY,NX)=VCH4F(NZ,NY,NX)-FCH4F*FFIRE*FHVST + VOXYF(NZ,NY,NX)=VOXYF(NZ,NY,NX)-(1.0-FCH4F)*FFIRE*FHVST*2.667 + VNH3F(NZ,NY,NX)=VNH3F(NZ,NY,NX)-FFIRN*FHVSN + VN2OF(NZ,NY,NX)=VN2OF(NZ,NY,NX)-0.0 + VPO4F(NZ,NY,NX)=VPO4F(NZ,NY,NX)-FFIRP*FHVSP + CNET(NZ,NY,NX)=CNET(NZ,NY,NX)-(1.0-FCH4F)*FFIRE*FHVST + TNBP(NY,NX)=TNBP(NY,NX)-FCH4F*FFIRE*FHVST + DO 3385 NR=1,NRT(NZ,NY,NX) + FHVST=(1.0-XHVST)*CFOPC(5,M,NZ,NY,NX)*(WTRT1(N,L,NR,NZ,NY,NX) + 3+WTRT2(N,L,NR,NZ,NY,NX))*FWOOD(0) + FHVSN=(1.0-XHVSN)*CFOPN(5,M,NZ,NY,NX)*(WTRT1N(N,L,NR,NZ,NY,NX) + 3+WTRT2N(N,L,NR,NZ,NY,NX))*FWOODN(0) + FHVSP=(1.0-XHVSP)*CFOPP(5,M,NZ,NY,NX)*(WTRT1P(N,L,NR,NZ,NY,NX) + 3+WTRT2P(N,L,NR,NZ,NY,NX))*FWOODP(0) + CSNC(M,1,L,NZ,NY,NX)=CSNC(M,1,L,NZ,NY,NX)+(1.0-FFIRE)*FHVST + ZSNC(M,1,L,NZ,NY,NX)=ZSNC(M,1,L,NZ,NY,NX)+(1.0-FFIRN)*FHVSN + PSNC(M,1,L,NZ,NY,NX)=PSNC(M,1,L,NZ,NY,NX)+(1.0-FFIRP)*FHVSP + VCO2F(NZ,NY,NX)=VCO2F(NZ,NY,NX)-(1.0-FCH4F)*FFIRE*FHVST + VCH4F(NZ,NY,NX)=VCH4F(NZ,NY,NX)-FCH4F*FFIRE*FHVST + VOXYF(NZ,NY,NX)=VOXYF(NZ,NY,NX)-(1.0-FCH4F)*FFIRE*FHVST*2.667 + VNH3F(NZ,NY,NX)=VNH3F(NZ,NY,NX)-FFIRN*FHVSN + VN2OF(NZ,NY,NX)=VN2OF(NZ,NY,NX)-0.0 + VPO4F(NZ,NY,NX)=VPO4F(NZ,NY,NX)-FFIRP*FHVSP + CNET(NZ,NY,NX)=CNET(NZ,NY,NX)-(1.0-FCH4F)*FFIRE*FHVST + TNBP(NY,NX)=TNBP(NY,NX)-FCH4F*FFIRE*FHVST + FHVST=(1.0-XHVST)*CFOPC(4,M,NZ,NY,NX)*(WTRT1(N,L,NR,NZ,NY,NX) + 3+WTRT2(N,L,NR,NZ,NY,NX))*FWOOD(1) + FHVSN=(1.0-XHVSN)*CFOPN(4,M,NZ,NY,NX)*(WTRT1N(N,L,NR,NZ,NY,NX) + 3+WTRT2N(N,L,NR,NZ,NY,NX))*FWOODN(1) + FHVSP=(1.0-XHVSP)*CFOPP(4,M,NZ,NY,NX)*(WTRT1P(N,L,NR,NZ,NY,NX) + 3+WTRT2P(N,L,NR,NZ,NY,NX))*FWOODP(1) + CSNC(M,1,L,NZ,NY,NX)=CSNC(M,1,L,NZ,NY,NX)+(1.0-FFIRE)*FHVST + ZSNC(M,1,L,NZ,NY,NX)=ZSNC(M,1,L,NZ,NY,NX)+(1.0-FFIRN)*FHVSN + PSNC(M,1,L,NZ,NY,NX)=PSNC(M,1,L,NZ,NY,NX)+(1.0-FFIRP)*FHVSP + VCO2F(NZ,NY,NX)=VCO2F(NZ,NY,NX)-(1.0-FCH4F)*FFIRE*FHVST + VCH4F(NZ,NY,NX)=VCH4F(NZ,NY,NX)-FCH4F*FFIRE*FHVST + VOXYF(NZ,NY,NX)=VOXYF(NZ,NY,NX)-(1.0-FCH4F)*FFIRE*FHVST*2.667 + VNH3F(NZ,NY,NX)=VNH3F(NZ,NY,NX)-FFIRN*FHVSN + VN2OF(NZ,NY,NX)=VN2OF(NZ,NY,NX)-0.0 + VPO4F(NZ,NY,NX)=VPO4F(NZ,NY,NX)-FFIRP*FHVSP + CNET(NZ,NY,NX)=CNET(NZ,NY,NX)-(1.0-FCH4F)*FFIRE*FHVST + TNBP(NY,NX)=TNBP(NY,NX)-FCH4F*FFIRE*FHVST +3385 CONTINUE +C WRITE(*,6161)'FIRE',I,J,NZ,L,N,M,VCO2F(NZ,NY,NX),FFIRE +C 2,FHVST,CFOPC(4,M,NZ,NY,NX),CPOOLR(N,L,NZ,NY,NX),THETW(L,NY,NX) +C 3,CORGC(L,NY,NX) +6161 FORMAT(A8,6I4,20E12.4) +C +C RELEASE ROOT GAS CONTENTS DURING HARVESTING +C + RCO2Z(NZ,NY,NX)=RCO2Z(NZ,NY,NX)-(1.0-XHVST) + 2*(CO2A(N,L,NZ,NY,NX)+CO2P(N,L,NZ,NY,NX)) + ROXYZ(NZ,NY,NX)=ROXYZ(NZ,NY,NX)-(1.0-XHVST) + 2*(OXYA(N,L,NZ,NY,NX)+OXYP(N,L,NZ,NY,NX)) + RCH4Z(NZ,NY,NX)=RCH4Z(NZ,NY,NX)-(1.0-XHVST) + 2*(CH4A(N,L,NZ,NY,NX)+CH4P(N,L,NZ,NY,NX)) + RN2OZ(NZ,NY,NX)=RN2OZ(NZ,NY,NX)-(1.0-XHVST) + 2*(Z2OA(N,L,NZ,NY,NX)+Z2OP(N,L,NZ,NY,NX)) + RNH3Z(NZ,NY,NX)=RNH3Z(NZ,NY,NX)-(1.0-XHVST) + 2*(ZH3A(N,L,NZ,NY,NX)+ZH3P(N,L,NZ,NY,NX)) + RH2GZ(NZ,NY,NX)=RH2GZ(NZ,NY,NX)-(1.0-XHVST) + 2*(H2GA(N,L,NZ,NY,NX)+H2GP(N,L,NZ,NY,NX)) + CO2A(N,L,NZ,NY,NX)=XHVST*CO2A(N,L,NZ,NY,NX) + OXYA(N,L,NZ,NY,NX)=XHVST*OXYA(N,L,NZ,NY,NX) + CH4A(N,L,NZ,NY,NX)=XHVST*CH4A(N,L,NZ,NY,NX) + Z2OA(N,L,NZ,NY,NX)=XHVST*Z2OA(N,L,NZ,NY,NX) + ZH3A(N,L,NZ,NY,NX)=XHVST*ZH3A(N,L,NZ,NY,NX) + H2GA(N,L,NZ,NY,NX)=XHVST*H2GA(N,L,NZ,NY,NX) + CO2P(N,L,NZ,NY,NX)=XHVST*CO2P(N,L,NZ,NY,NX) + OXYP(N,L,NZ,NY,NX)=XHVST*OXYP(N,L,NZ,NY,NX) + CH4P(N,L,NZ,NY,NX)=XHVST*CH4P(N,L,NZ,NY,NX) + Z2OP(N,L,NZ,NY,NX)=XHVST*Z2OP(N,L,NZ,NY,NX) + ZH3P(N,L,NZ,NY,NX)=XHVST*ZH3P(N,L,NZ,NY,NX) + H2GP(N,L,NZ,NY,NX)=XHVST*H2GP(N,L,NZ,NY,NX) +C +C REDUCE ROOT STATE VARIABLES DURING HARVESTING +C + DO 3960 NR=1,NRT(NZ,NY,NX) + WTRT1(N,L,NR,NZ,NY,NX)=WTRT1(N,L,NR,NZ,NY,NX)*XHVST + WTRT2(N,L,NR,NZ,NY,NX)=WTRT2(N,L,NR,NZ,NY,NX)*XHVST + WTRT1N(N,L,NR,NZ,NY,NX)=WTRT1N(N,L,NR,NZ,NY,NX)*XHVST + WTRT2N(N,L,NR,NZ,NY,NX)=WTRT2N(N,L,NR,NZ,NY,NX)*XHVST + WTRT1P(N,L,NR,NZ,NY,NX)=WTRT1P(N,L,NR,NZ,NY,NX)*XHVST + WTRT2P(N,L,NR,NZ,NY,NX)=WTRT2P(N,L,NR,NZ,NY,NX)*XHVST + RTWT1(N,NR,NZ,NY,NX)=RTWT1(N,NR,NZ,NY,NX)*XHVST + RTWT1N(N,NR,NZ,NY,NX)=RTWT1N(N,NR,NZ,NY,NX)*XHVST + RTWT1P(N,NR,NZ,NY,NX)=RTWT1P(N,NR,NZ,NY,NX)*XHVST + RTLG1(N,L,NR,NZ,NY,NX)=RTLG1(N,L,NR,NZ,NY,NX)*XHVST + RTLG2(N,L,NR,NZ,NY,NX)=RTLG2(N,L,NR,NZ,NY,NX)*XHVST + RTN2(N,L,NR,NZ,NY,NX)=RTN2(N,L,NR,NZ,NY,NX)*XHVST +3960 CONTINUE + CPOOLR(N,L,NZ,NY,NX)=CPOOLR(N,L,NZ,NY,NX)*XHVST + ZPOOLR(N,L,NZ,NY,NX)=ZPOOLR(N,L,NZ,NY,NX)*XHVST + PPOOLR(N,L,NZ,NY,NX)=PPOOLR(N,L,NZ,NY,NX)*XHVST + WTRTL(N,L,NZ,NY,NX)=WTRTL(N,L,NZ,NY,NX)*XHVST + WTRTD(N,L,NZ,NY,NX)=WTRTD(N,L,NZ,NY,NX)*XHVST + WSRTL(N,L,NZ,NY,NX)=WSRTL(N,L,NZ,NY,NX)*XHVST + RTN1(N,L,NZ,NY,NX)=RTN1(N,L,NZ,NY,NX)*XHVST + RTNL(N,L,NZ,NY,NX)=RTNL(N,L,NZ,NY,NX)*XHVST + RTLGP(N,L,NZ,NY,NX)=RTLGP(N,L,NZ,NY,NX)*XHVST + RTDNP(N,L,NZ,NY,NX)=RTDNP(N,L,NZ,NY,NX)*XHVST + RTVLP(N,L,NZ,NY,NX)=RTVLP(N,L,NZ,NY,NX)*XHVST + RTVLW(N,L,NZ,NY,NX)=RTVLW(N,L,NZ,NY,NX)*XHVST + RTARP(N,L,NZ,NY,NX)=RTARP(N,L,NZ,NY,NX)*XHVST + RCO2M(N,L,NZ,NY,NX)=RCO2M(N,L,NZ,NY,NX)*XHVST + RCO2N(N,L,NZ,NY,NX)=RCO2N(N,L,NZ,NY,NX)*XHVST + RCO2A(N,L,NZ,NY,NX)=RCO2A(N,L,NZ,NY,NX)*XHVST +C +C NODULE LITTERFALL AND STATE VARIABLES DURING HARVESTING +C + IF(INTYP(NZ,NY,NX).NE.0.AND.N.EQ.1)THEN + DO 3395 M=1,4 + CSNC(M,1,L,NZ,NY,NX)=CSNC(M,1,L,NZ,NY,NX)+(1.0-XHVST) + 2*(CFOPC(4,M,NZ,NY,NX)*WTNDL(L,NZ,NY,NX) + 3+CFOPC(0,M,NZ,NY,NX)*CPOOLN(L,NZ,NY,NX)) + ZSNC(M,1,L,NZ,NY,NX)=ZSNC(M,1,L,NZ,NY,NX)+(1.0-XHVST) + 2*(CFOPN(4,M,NZ,NY,NX)*WTNDLN(L,NZ,NY,NX) + 3+CFOPN(0,M,NZ,NY,NX)*ZPOOLN(L,NZ,NY,NX)) + PSNC(M,1,L,NZ,NY,NX)=PSNC(M,1,L,NZ,NY,NX)+(1.0-XHVST) + 2*(CFOPP(4,M,NZ,NY,NX)*WTNDLP(L,NZ,NY,NX) + 3+CFOPP(0,M,NZ,NY,NX)*PPOOLN(L,NZ,NY,NX)) +3395 CONTINUE + WTNDL(L,NZ,NY,NX)=WTNDL(L,NZ,NY,NX)*XHVST + WTNDLN(L,NZ,NY,NX)=WTNDLN(L,NZ,NY,NX)*XHVST + WTNDLP(L,NZ,NY,NX)=WTNDLP(L,NZ,NY,NX)*XHVST + CPOOLN(L,NZ,NY,NX)=CPOOLN(L,NZ,NY,NX)*XHVST + ZPOOLN(L,NZ,NY,NX)=ZPOOLN(L,NZ,NY,NX)*XHVST + PPOOLN(L,NZ,NY,NX)=PPOOLN(L,NZ,NY,NX)*XHVST + ENDIF +3980 CONTINUE +3985 CONTINUE +C +C STORAGE LITTERFALL AND STATE VARIABLES DURING HARVESTING +C + IF(ISTYP(NZ,NY,NX).NE.0)THEN + DO 3400 M=1,4 + CSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX)=CSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX) + 2+((1.0-XHVST)*CFOPC(0,M,NZ,NY,NX)*WTRVC(NZ,NY,NX))*FWOOD(0) + ZSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX)=ZSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX) + 2+((1.0-XHVST)*CFOPN(0,M,NZ,NY,NX)*WTRVN(NZ,NY,NX))*FWOODN(0) + PSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX)=PSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX) + 2+((1.0-XHVST)*CFOPP(0,M,NZ,NY,NX)*WTRVP(NZ,NY,NX))*FWOODP(0) + CSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX)=CSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX) + 2+((1.0-XHVST)*CFOPC(0,M,NZ,NY,NX)*WTRVC(NZ,NY,NX))*FWOOD(1) + ZSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX)=ZSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX) + 2+((1.0-XHVST)*CFOPN(0,M,NZ,NY,NX)*WTRVN(NZ,NY,NX))*FWOODN(1) + PSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX)=PSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX) + 2+((1.0-XHVST)*CFOPP(0,M,NZ,NY,NX)*WTRVP(NZ,NY,NX))*FWOODP(1) +3400 CONTINUE + WTRVC(NZ,NY,NX)=WTRVC(NZ,NY,NX)*XHVST + WTRVN(NZ,NY,NX)=WTRVN(NZ,NY,NX)*XHVST + WTRVP(NZ,NY,NX)=WTRVP(NZ,NY,NX)*XHVST + ENDIF + ENDIF + ENDIF +C +C REDUCE OR REMOVE PLANT POPULATIONS DURING TILLAGE +C + IF(J.EQ.INT(ZNOON(NY,NX)).AND.(IBTYP(NZ,NY,NX).EQ.0 + 2.OR.IGTYP(NZ,NY,NX).LE.1).AND.(I.NE.IDAY0(NZ,NY,NX) + 3.OR.IDATA(3).NE.IYR0(NZ,NY,NX)))THEN + IF(ITILL(I,NY,NX).LE.10.OR.NZ.NE.1)THEN + IF(I.GT.IDAY0(NZ,NY,NX).OR.IYRC.GT.IYR0(NZ,NY,NX))THEN + XHVST=XCORP(NY,NX) + PPX(NZ,NY,NX)=PPX(NZ,NY,NX)*XHVST + PP(NZ,NY,NX)=PP(NZ,NY,NX)*XHVST + FRADP(NZ,NY,NX)=FRADP(NZ,NY,NX)*XHVST + VHCPC(NZ,NY,NX)=VHCPC(NZ,NY,NX)*XHVST + WTLS(NZ,NY,NX)=0.0 + WVSTK(NZ,NY,NX)=0.0 +C +C TERMINATE BRANCHES IF TILLAGE IMPLEMENT 20 IS SELECTED +C + DO 8975 NB=1,NBR(NZ,NY,NX) + IF(IDTHB(NB,NZ,NY,NX).EQ.0)THEN + IF(XHVST.LE.1.0E-06)THEN + IDTHB(NB,NZ,NY,NX)=1 + ENDIF +C +C LITTERFALL FROM BRANCHES DURING TILLAGE +C + DO 6380 M=1,4 + CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX)+(1.0-XHVST) + 2*(CFOPC(0,M,NZ,NY,NX)*(CPOOL(NB,NZ,NY,NX)+CPOLNB(NB,NZ,NY,NX) + 3+CPOOLK(NB,NZ,NY,NX)+WTRSVB(NB,NZ,NY,NX)) + 4+CFOPC(1,M,NZ,NY,NX)*(WTLFB(NB,NZ,NY,NX)*FWODB(1) + 5+WTNDB(NB,NZ,NY,NX)) + 6+CFOPC(2,M,NZ,NY,NX)*(WTSHEB(NB,NZ,NY,NX)*FWODB(1) + 7+WTHSKB(NB,NZ,NY,NX)+WTEARB(NB,NZ,NY,NX))) + CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX)+(1.0-XHVST) + 2*CFOPC(5,M,NZ,NY,NX)*(WTLFB(NB,NZ,NY,NX)*FWODB(0) + 3+WTSHEB(NB,NZ,NY,NX)*FWODB(0)) + ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX)+(1.0-XHVST) + 2*(CFOPN(0,M,NZ,NY,NX)*(ZPOOL(NB,NZ,NY,NX)+ZPOLNB(NB,NZ,NY,NX) + 3+WTRSBN(NB,NZ,NY,NX)) + 4+CFOPN(1,M,NZ,NY,NX)*(WTLFBN(NB,NZ,NY,NX)*FWODLN(1) + 5+WTNDBN(NB,NZ,NY,NX)) + 6+CFOPN(2,M,NZ,NY,NX)*(WTSHBN(NB,NZ,NY,NX)*FWODSN(1) + 7+WTHSBN(NB,NZ,NY,NX)+WTEABN(NB,NZ,NY,NX))) + ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX)+(1.0-XHVST) + 2*CFOPN(5,M,NZ,NY,NX)*(WTLFBN(NB,NZ,NY,NX)*FWODLN(0) + 3+WTSHBN(NB,NZ,NY,NX)*FWODSN(0)) + PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX)+(1.0-XHVST) + 2*(CFOPP(0,M,NZ,NY,NX)*(PPOOL(NB,NZ,NY,NX)+PPOLNB(NB,NZ,NY,NX) + 3+WTRSBP(NB,NZ,NY,NX)) + 4+CFOPP(1,M,NZ,NY,NX)*(WTLFBP(NB,NZ,NY,NX)*FWODLP(1) + 5+WTNDBP(NB,NZ,NY,NX)) + 6+CFOPP(2,M,NZ,NY,NX)*(WTSHBP(NB,NZ,NY,NX)*FWODSP(1) + 7+WTHSBP(NB,NZ,NY,NX)+WTEABP(NB,NZ,NY,NX))) + PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX)+(1.0-XHVST) + 2*CFOPP(5,M,NZ,NY,NX)*(WTLFBP(NB,NZ,NY,NX)*FWODLP(0) + 3+WTSHBP(NB,NZ,NY,NX)*FWODSP(0)) + IF(ISTYP(NZ,NY,NX).EQ.0.AND.IWTYP(NZ,NY,NX).NE.0)THEN + WTRVC(NZ,NY,NX)=WTRVC(NZ,NY,NX)+(1.0-XHVST) + 2*CFOPC(2,M,NZ,NY,NX)*WTGRB(NB,NZ,NY,NX) + WTRVN(NZ,NY,NX)=WTRVN(NZ,NY,NX)+(1.0-XHVST) + 2*CFOPN(2,M,NZ,NY,NX)*WTGRBN(NB,NZ,NY,NX) + WTRVP(NZ,NY,NX)=WTRVP(NZ,NY,NX)+(1.0-XHVST) + 2*CFOPP(2,M,NZ,NY,NX)*WTGRBP(NB,NZ,NY,NX) + ELSE + CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX)+(1.0-XHVST) + 2*CFOPC(2,M,NZ,NY,NX)*WTGRB(NB,NZ,NY,NX) + ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX)+(1.0-XHVST) + 2*CFOPN(2,M,NZ,NY,NX)*WTGRBN(NB,NZ,NY,NX) + PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX)+(1.0-XHVST) + 2*CFOPP(2,M,NZ,NY,NX)*WTGRBP(NB,NZ,NY,NX) + ENDIF + IF(IBTYP(NZ,NY,NX).EQ.0.OR.IGTYP(NZ,NY,NX).LE.1)THEN + CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX)+(1.0-XHVST) + 2*CFOPC(3,M,NZ,NY,NX)*WTSTKB(NB,NZ,NY,NX) + ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX)+(1.0-XHVST) + 2*CFOPN(3,M,NZ,NY,NX)*WTSTBN(NB,NZ,NY,NX) + PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX)+(1.0-XHVST) + 2*CFOPP(3,M,NZ,NY,NX)*WTSTBP(NB,NZ,NY,NX) + ELSE + CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX)+(1.0-XHVST) + 2*CFOPC(5,M,NZ,NY,NX)*WTSTKB(NB,NZ,NY,NX) + ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX)+(1.0-XHVST) + 2*CFOPN(5,M,NZ,NY,NX)*WTSTBN(NB,NZ,NY,NX) + PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX)+(1.0-XHVST) + 2*CFOPP(5,M,NZ,NY,NX)*WTSTBP(NB,NZ,NY,NX) + ENDIF +6380 CONTINUE +C +C REDUCE PLANT STATE VARIABLES DURING TILLAGE +C + CPOOL(NB,NZ,NY,NX)=CPOOL(NB,NZ,NY,NX)*XHVST + CPOOLK(NB,NZ,NY,NX)=CPOOLK(NB,NZ,NY,NX)*XHVST + ZPOOL(NB,NZ,NY,NX)=ZPOOL(NB,NZ,NY,NX)*XHVST + PPOOL(NB,NZ,NY,NX)=PPOOL(NB,NZ,NY,NX)*XHVST + CPOLNB(NB,NZ,NY,NX)=CPOLNB(NB,NZ,NY,NX)*XHVST + ZPOLNB(NB,NZ,NY,NX)=ZPOLNB(NB,NZ,NY,NX)*XHVST + PPOLNB(NB,NZ,NY,NX)=PPOLNB(NB,NZ,NY,NX)*XHVST + WTSHTB(NB,NZ,NY,NX)=WTSHTB(NB,NZ,NY,NX)*XHVST + WTLFB(NB,NZ,NY,NX)=WTLFB(NB,NZ,NY,NX)*XHVST + WTNDB(NB,NZ,NY,NX)=WTNDB(NB,NZ,NY,NX)*XHVST + WTSHEB(NB,NZ,NY,NX)=WTSHEB(NB,NZ,NY,NX)*XHVST + WTSTKB(NB,NZ,NY,NX)=WTSTKB(NB,NZ,NY,NX)*XHVST + WVSTKB(NB,NZ,NY,NX)=WVSTKB(NB,NZ,NY,NX)*XHVST + WTRSVB(NB,NZ,NY,NX)=WTRSVB(NB,NZ,NY,NX)*XHVST + WTHSKB(NB,NZ,NY,NX)=WTHSKB(NB,NZ,NY,NX)*XHVST + WTEARB(NB,NZ,NY,NX)=WTEARB(NB,NZ,NY,NX)*XHVST + WTGRB(NB,NZ,NY,NX)=WTGRB(NB,NZ,NY,NX)*XHVST + WTSHTN(NB,NZ,NY,NX)=WTSHTN(NB,NZ,NY,NX)*XHVST + WTLFBN(NB,NZ,NY,NX)=WTLFBN(NB,NZ,NY,NX)*XHVST + WTNDBN(NB,NZ,NY,NX)=WTNDBN(NB,NZ,NY,NX)*XHVST + WTSHBN(NB,NZ,NY,NX)=WTSHBN(NB,NZ,NY,NX)*XHVST + WTSTBN(NB,NZ,NY,NX)=WTSTBN(NB,NZ,NY,NX)*XHVST + WTRSBN(NB,NZ,NY,NX)=WTRSBN(NB,NZ,NY,NX)*XHVST + WTHSBN(NB,NZ,NY,NX)=WTHSBN(NB,NZ,NY,NX)*XHVST + WTEABN(NB,NZ,NY,NX)=WTEABN(NB,NZ,NY,NX)*XHVST + WTGRBN(NB,NZ,NY,NX)=WTGRBN(NB,NZ,NY,NX)*XHVST + WTSHTP(NB,NZ,NY,NX)=WTSHTP(NB,NZ,NY,NX)*XHVST + WTLFBP(NB,NZ,NY,NX)=WTLFBP(NB,NZ,NY,NX)*XHVST + WTNDBP(NB,NZ,NY,NX)=WTNDBP(NB,NZ,NY,NX)*XHVST + WTSHBP(NB,NZ,NY,NX)=WTSHBP(NB,NZ,NY,NX)*XHVST + WTSTBP(NB,NZ,NY,NX)=WTSTBP(NB,NZ,NY,NX)*XHVST + WTRSBP(NB,NZ,NY,NX)=WTRSBP(NB,NZ,NY,NX)*XHVST + WTHSBP(NB,NZ,NY,NX)=WTHSBP(NB,NZ,NY,NX)*XHVST + WTEABP(NB,NZ,NY,NX)=WTEABP(NB,NZ,NY,NX)*XHVST + WTGRBP(NB,NZ,NY,NX)=WTGRBP(NB,NZ,NY,NX)*XHVST + GRNXB(NB,NZ,NY,NX)=GRNXB(NB,NZ,NY,NX)*XHVST + GRNOB(NB,NZ,NY,NX)=GRNOB(NB,NZ,NY,NX)*XHVST + GRWTB(NB,NZ,NY,NX)=GRWTB(NB,NZ,NY,NX)*XHVST + ARLFB(NB,NZ,NY,NX)=ARLFB(NB,NZ,NY,NX)*XHVST + WTLSB(NB,NZ,NY,NX)=AMAX1(0.0,WTLFB(NB,NZ,NY,NX) + 2+WTSHEB(NB,NZ,NY,NX)) + WTLS(NZ,NY,NX)=WTLS(NZ,NY,NX)+WTLSB(NB,NZ,NY,NX) + WTSTXB(NB,NZ,NY,NX)=WTSTXB(NB,NZ,NY,NX)*XHVST + WTSTXN(NB,NZ,NY,NX)=WTSTXN(NB,NZ,NY,NX)*XHVST + WTSTXP(NB,NZ,NY,NX)=WTSTXP(NB,NZ,NY,NX)*XHVST + WVSTK(NZ,NY,NX)=WVSTK(NZ,NY,NX)+WVSTKB(NB,NZ,NY,NX) + DO 8970 K=0,25 + IF(K.NE.0)THEN + CPOOL3(K,NB,NZ,NY,NX)=CPOOL3(K,NB,NZ,NY,NX)*XHVST + CPOOL4(K,NB,NZ,NY,NX)=CPOOL4(K,NB,NZ,NY,NX)*XHVST + CO2B(K,NB,NZ,NY,NX)=CO2B(K,NB,NZ,NY,NX)*XHVST + HCOB(K,NB,NZ,NY,NX)=HCOB(K,NB,NZ,NY,NX)*XHVST + ENDIF + ARLF(K,NB,NZ,NY,NX)=ARLF(K,NB,NZ,NY,NX)*XHVST + WGLF(K,NB,NZ,NY,NX)=WGLF(K,NB,NZ,NY,NX)*XHVST + WSLF(K,NB,NZ,NY,NX)=WSLF(K,NB,NZ,NY,NX)*XHVST +C HTSHE(K,NB,NZ,NY,NX)=HTSHE(K,NB,NZ,NY,NX)*XHVST + WGSHE(K,NB,NZ,NY,NX)=WGSHE(K,NB,NZ,NY,NX)*XHVST + WSSHE(K,NB,NZ,NY,NX)=WSSHE(K,NB,NZ,NY,NX)*XHVST +C HTNODE(K,NB,NZ,NY,NX)=HTNODE(K,NB,NZ,NY,NX)*XHVST +C HTNODX(K,NB,NZ,NY,NX)=HTNODX(K,NB,NZ,NY,NX)*XHVST + WGNODE(K,NB,NZ,NY,NX)=WGNODE(K,NB,NZ,NY,NX)*XHVST + WGLFN(K,NB,NZ,NY,NX)=WGLFN(K,NB,NZ,NY,NX)*XHVST + WGSHN(K,NB,NZ,NY,NX)=WGSHN(K,NB,NZ,NY,NX)*XHVST + WGNODN(K,NB,NZ,NY,NX)=WGNODN(K,NB,NZ,NY,NX)*XHVST + WGLFP(K,NB,NZ,NY,NX)=WGLFP(K,NB,NZ,NY,NX)*XHVST + WGSHP(K,NB,NZ,NY,NX)=WGSHP(K,NB,NZ,NY,NX)*XHVST + WGNODP(K,NB,NZ,NY,NX)=WGNODP(K,NB,NZ,NY,NX)*XHVST + DO 8965 L=1,JC + ARLFL(L,K,NB,NZ,NY,NX)=ARLFL(L,K,NB,NZ,NY,NX)*XHVST + WGLFL(L,K,NB,NZ,NY,NX)=WGLFL(L,K,NB,NZ,NY,NX)*XHVST + WGLFLN(L,K,NB,NZ,NY,NX)=WGLFLN(L,K,NB,NZ,NY,NX)*XHVST + WGLFLP(L,K,NB,NZ,NY,NX)=WGLFLP(L,K,NB,NZ,NY,NX)*XHVST +8965 CONTINUE +8970 CONTINUE + ENDIF +8975 CONTINUE + VOLWPX=VOLWP(NZ,NY,NX) + WVPLT=AMAX1(0.0,WTLS(NZ,NY,NX)+WVSTK(NZ,NY,NX)) + APSILT=ABS(PSILT(NZ,NY,NX)) + FDM=0.16+0.10*APSILT/(0.05*APSILT+2.0) + VOLWP(NZ,NY,NX)=1.0E-06*WVPLT/FDM + VOLWOU=VOLWOU+VOLWPX-VOLWP(NZ,NY,NX) + UVOLO(NY,NX)=UVOLO(NY,NX)+VOLWPX-VOLWP(NZ,NY,NX) +C +C TERMINATE ROOTS IF TILLAGE IMPLEMENT 20 IS SELECTED +C + IF(XHVST.LE.1.0E-06)THEN + IDTHR(NZ,NY,NX)=1 + IDTHP(NZ,NY,NX)=1 + JHVST(NZ,I,NY,NX)=1 + ENDIF +C +C LITTERFALL FROM ROOTS DURING TILLAGE +C + DO 8985 N=1,MY(NZ,NY,NX) + DO 8980 L=NU(NY,NX),NJ(NY,NX) + DO 6385 M=1,4 + CSNC(M,1,L,NZ,NY,NX)=CSNC(M,1,L,NZ,NY,NX)+(1.0-XHVST) + 2*CFOPC(0,M,NZ,NY,NX)*CPOOLR(N,L,NZ,NY,NX) + ZSNC(M,1,L,NZ,NY,NX)=ZSNC(M,1,L,NZ,NY,NX)+(1.0-XHVST) + 2*CFOPN(0,M,NZ,NY,NX)*ZPOOLR(N,L,NZ,NY,NX) + PSNC(M,1,L,NZ,NY,NX)=PSNC(M,1,L,NZ,NY,NX)+(1.0-XHVST) + 2*CFOPP(0,M,NZ,NY,NX)*PPOOLR(N,L,NZ,NY,NX) + DO 6385 NR=1,NRT(NZ,NY,NX) + CSNC(M,0,L,NZ,NY,NX)=CSNC(M,0,L,NZ,NY,NX)+(1.0-XHVST) + 2*CFOPC(5,M,NZ,NY,NX)*(WTRT1(N,L,NR,NZ,NY,NX) + 3+WTRT2(N,L,NR,NZ,NY,NX))*FWOOD(0) + ZSNC(M,0,L,NZ,NY,NX)=ZSNC(M,0,L,NZ,NY,NX)+(1.0-XHVST) + 2*CFOPN(5,M,NZ,NY,NX)*(WTRT1N(N,L,NR,NZ,NY,NX) + 3+WTRT2N(N,L,NR,NZ,NY,NX))*FWOODN(0) + PSNC(M,0,L,NZ,NY,NX)=PSNC(M,0,L,NZ,NY,NX)+(1.0-XHVST) + 2*CFOPP(5,M,NZ,NY,NX)*(WTRT1P(N,L,NR,NZ,NY,NX) + 3+WTRT2P(N,L,NR,NZ,NY,NX))*FWOODP(0) + CSNC(M,1,L,NZ,NY,NX)=CSNC(M,1,L,NZ,NY,NX)+(1.0-XHVST) + 2*CFOPC(4,M,NZ,NY,NX)*(WTRT1(N,L,NR,NZ,NY,NX) + 3+WTRT2(N,L,NR,NZ,NY,NX))*FWOOD(1) + ZSNC(M,1,L,NZ,NY,NX)=ZSNC(M,1,L,NZ,NY,NX)+(1.0-XHVST) + 2*CFOPN(4,M,NZ,NY,NX)*(WTRT1N(N,L,NR,NZ,NY,NX) + 3+WTRT2N(N,L,NR,NZ,NY,NX))*FWOODN(1) + PSNC(M,1,L,NZ,NY,NX)=PSNC(M,1,L,NZ,NY,NX)+(1.0-XHVST) + 2*CFOPP(4,M,NZ,NY,NX)*(WTRT1P(N,L,NR,NZ,NY,NX) + 3+WTRT2P(N,L,NR,NZ,NY,NX))*FWOODP(1) +6385 CONTINUE +C +C RELEASE ROOT GAS CONTENTS DURING TILLAGE +C + RCO2Z(NZ,NY,NX)=RCO2Z(NZ,NY,NX)-(1.0-XHVST) + 2*(CO2A(N,L,NZ,NY,NX)+CO2P(N,L,NZ,NY,NX)) + ROXYZ(NZ,NY,NX)=ROXYZ(NZ,NY,NX)-(1.0-XHVST) + 2*(OXYA(N,L,NZ,NY,NX)+OXYP(N,L,NZ,NY,NX)) + RCH4Z(NZ,NY,NX)=RCH4Z(NZ,NY,NX)-(1.0-XHVST) + 2*(CH4A(N,L,NZ,NY,NX)+CH4P(N,L,NZ,NY,NX)) + RN2OZ(NZ,NY,NX)=RN2OZ(NZ,NY,NX)-(1.0-XHVST) + 2*(Z2OA(N,L,NZ,NY,NX)+Z2OP(N,L,NZ,NY,NX)) + RNH3Z(NZ,NY,NX)=RNH3Z(NZ,NY,NX)-(1.0-XHVST) + 2*(ZH3A(N,L,NZ,NY,NX)+ZH3P(N,L,NZ,NY,NX)) + RH2GZ(NZ,NY,NX)=RH2GZ(NZ,NY,NX)-(1.0-XHVST) + 2*(H2GA(N,L,NZ,NY,NX)+H2GP(N,L,NZ,NY,NX)) + CO2A(N,L,NZ,NY,NX)=XHVST*CO2A(N,L,NZ,NY,NX) + OXYA(N,L,NZ,NY,NX)=XHVST*OXYA(N,L,NZ,NY,NX) + CH4A(N,L,NZ,NY,NX)=XHVST*CH4A(N,L,NZ,NY,NX) + Z2OA(N,L,NZ,NY,NX)=XHVST*Z2OA(N,L,NZ,NY,NX) + ZH3A(N,L,NZ,NY,NX)=XHVST*ZH3A(N,L,NZ,NY,NX) + H2GA(N,L,NZ,NY,NX)=XHVST*H2GA(N,L,NZ,NY,NX) + CO2P(N,L,NZ,NY,NX)=XHVST*CO2P(N,L,NZ,NY,NX) + OXYP(N,L,NZ,NY,NX)=XHVST*OXYP(N,L,NZ,NY,NX) + CH4P(N,L,NZ,NY,NX)=XHVST*CH4P(N,L,NZ,NY,NX) + Z2OP(N,L,NZ,NY,NX)=XHVST*Z2OP(N,L,NZ,NY,NX) + ZH3P(N,L,NZ,NY,NX)=XHVST*ZH3P(N,L,NZ,NY,NX) + H2GP(N,L,NZ,NY,NX)=XHVST*H2GP(N,L,NZ,NY,NX) +C +C REDUCE ROOT STATE VARIABLES DURING TILLAGE +C + DO 8960 NR=1,NRT(NZ,NY,NX) + WTRT1(N,L,NR,NZ,NY,NX)=WTRT1(N,L,NR,NZ,NY,NX)*XHVST + WTRT2(N,L,NR,NZ,NY,NX)=WTRT2(N,L,NR,NZ,NY,NX)*XHVST + WTRT1N(N,L,NR,NZ,NY,NX)=WTRT1N(N,L,NR,NZ,NY,NX)*XHVST + WTRT2N(N,L,NR,NZ,NY,NX)=WTRT2N(N,L,NR,NZ,NY,NX)*XHVST + WTRT1P(N,L,NR,NZ,NY,NX)=WTRT1P(N,L,NR,NZ,NY,NX)*XHVST + WTRT2P(N,L,NR,NZ,NY,NX)=WTRT2P(N,L,NR,NZ,NY,NX)*XHVST + RTWT1(N,NR,NZ,NY,NX)=RTWT1(N,NR,NZ,NY,NX)*XHVST + RTWT1N(N,NR,NZ,NY,NX)=RTWT1N(N,NR,NZ,NY,NX)*XHVST + RTWT1P(N,NR,NZ,NY,NX)=RTWT1P(N,NR,NZ,NY,NX)*XHVST + RTLG1(N,L,NR,NZ,NY,NX)=RTLG1(N,L,NR,NZ,NY,NX)*XHVST + RTLG2(N,L,NR,NZ,NY,NX)=RTLG2(N,L,NR,NZ,NY,NX)*XHVST + RTN2(N,L,NR,NZ,NY,NX)=RTN2(N,L,NR,NZ,NY,NX)*XHVST +8960 CONTINUE + CPOOLR(N,L,NZ,NY,NX)=CPOOLR(N,L,NZ,NY,NX)*XHVST + ZPOOLR(N,L,NZ,NY,NX)=ZPOOLR(N,L,NZ,NY,NX)*XHVST + PPOOLR(N,L,NZ,NY,NX)=PPOOLR(N,L,NZ,NY,NX)*XHVST + WTRTL(N,L,NZ,NY,NX)=WTRTL(N,L,NZ,NY,NX)*XHVST + WTRTD(N,L,NZ,NY,NX)=WTRTD(N,L,NZ,NY,NX)*XHVST + WSRTL(N,L,NZ,NY,NX)=WSRTL(N,L,NZ,NY,NX)*XHVST + RTN1(N,L,NZ,NY,NX)=RTN1(N,L,NZ,NY,NX)*XHVST + RTNL(N,L,NZ,NY,NX)=RTNL(N,L,NZ,NY,NX)*XHVST + RTLGP(N,L,NZ,NY,NX)=RTLGP(N,L,NZ,NY,NX)*XHVST + RTDNP(N,L,NZ,NY,NX)=RTDNP(N,L,NZ,NY,NX)*XHVST + RTVLP(N,L,NZ,NY,NX)=RTVLP(N,L,NZ,NY,NX)*XHVST + RTVLW(N,L,NZ,NY,NX)=RTVLW(N,L,NZ,NY,NX)*XHVST + RTARP(N,L,NZ,NY,NX)=RTARP(N,L,NZ,NY,NX)*XHVST + RCO2M(N,L,NZ,NY,NX)=RCO2M(N,L,NZ,NY,NX)*XHVST + RCO2N(N,L,NZ,NY,NX)=RCO2N(N,L,NZ,NY,NX)*XHVST + RCO2A(N,L,NZ,NY,NX)=RCO2A(N,L,NZ,NY,NX)*XHVST +C +C LITTERFALL AND STATE VARIABLES FOR NODULES DURING TILLAGE +C + IF(INTYP(NZ,NY,NX).NE.0.AND.N.EQ.1)THEN + DO 6395 M=1,4 + CSNC(M,1,L,NZ,NY,NX)=CSNC(M,1,L,NZ,NY,NX)+(1.0-XHVST) + 2*(CFOPC(4,M,NZ,NY,NX)*WTNDL(L,NZ,NY,NX) + 3+CFOPC(0,M,NZ,NY,NX)*CPOOLN(L,NZ,NY,NX)) + ZSNC(M,1,L,NZ,NY,NX)=ZSNC(M,1,L,NZ,NY,NX)+(1.0-XHVST) + 2*(CFOPN(4,M,NZ,NY,NX)*WTNDLN(L,NZ,NY,NX) + 3+CFOPN(0,M,NZ,NY,NX)*ZPOOLN(L,NZ,NY,NX)) + PSNC(M,1,L,NZ,NY,NX)=PSNC(M,1,L,NZ,NY,NX)+(1.0-XHVST) + 2*(CFOPP(4,M,NZ,NY,NX)*WTNDLP(L,NZ,NY,NX) + 3+CFOPP(0,M,NZ,NY,NX)*PPOOLN(L,NZ,NY,NX)) +6395 CONTINUE + WTNDL(L,NZ,NY,NX)=WTNDL(L,NZ,NY,NX)*XHVST + WTNDLN(L,NZ,NY,NX)=WTNDLN(L,NZ,NY,NX)*XHVST + WTNDLP(L,NZ,NY,NX)=WTNDLP(L,NZ,NY,NX)*XHVST + CPOOLN(L,NZ,NY,NX)=CPOOLN(L,NZ,NY,NX)*XHVST + ZPOOLN(L,NZ,NY,NX)=ZPOOLN(L,NZ,NY,NX)*XHVST + PPOOLN(L,NZ,NY,NX)=PPOOLN(L,NZ,NY,NX)*XHVST + ENDIF +8980 CONTINUE +8985 CONTINUE +C +C LITTERFALL AND STATE VARIABLES FOR SEASONAL STORAGE RESERVES +C DURING TILLAGE +C + DO 6400 M=1,4 + CSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX)=CSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX) + 2+((1.0-XHVST)*CFOPC(0,M,NZ,NY,NX)*WTRVC(NZ,NY,NX))*FWOOD(0) + ZSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX)=ZSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX) + 2+((1.0-XHVST)*CFOPN(0,M,NZ,NY,NX)*WTRVN(NZ,NY,NX))*FWOODN(0) + PSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX)=PSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX) + 2+((1.0-XHVST)*CFOPP(0,M,NZ,NY,NX)*WTRVP(NZ,NY,NX))*FWOODP(0) + CSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX)=CSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX) + 2+((1.0-XHVST)*CFOPC(0,M,NZ,NY,NX)*WTRVC(NZ,NY,NX))*FWOOD(1) + ZSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX)=ZSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX) + 2+((1.0-XHVST)*CFOPN(0,M,NZ,NY,NX)*WTRVN(NZ,NY,NX))*FWOODN(1) + PSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX)=PSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX) + 2+((1.0-XHVST)*CFOPP(0,M,NZ,NY,NX)*WTRVP(NZ,NY,NX))*FWOODP(1) +6400 CONTINUE + WTRVC(NZ,NY,NX)=WTRVC(NZ,NY,NX)*XHVST + WTRVN(NZ,NY,NX)=WTRVN(NZ,NY,NX)*XHVST + WTRVP(NZ,NY,NX)=WTRVP(NZ,NY,NX)*XHVST + ENDIF + ENDIF + ENDIF +C +C DEAD BRANCHES +C + IF(J.EQ.INT(ZNOON(NY,NX)).AND.IDAY(1,NB1(NZ,NY,NX),NZ,NY,NX).NE.0 + 2.AND.(ISTYP(NZ,NY,NX).NE.0.OR.(I.GE.IDAYH(NZ,NY,NX) + 3.AND.IYRC.GE.IYRH(NZ,NY,NX))))THEN + IDTHY=0 +C +C RESET PHENOLOGY AND GROWTH STAGE OF DEAD BRANCHES +C + DO 8845 NB=1,NBR(NZ,NY,NX) + IF(IDTHB(NB,NZ,NY,NX).EQ.1)THEN + GROUP(NB,NZ,NY,NX)=GROUPI(NZ,NY,NX) + PSTG(NB,NZ,NY,NX)=XTLI(NZ,NY,NX) + PSTGI(NB,NZ,NY,NX)=PSTG(NB,NZ,NY,NX) + PSTGF(NB,NZ,NY,NX)=0.0 + VSTG(NB,NZ,NY,NX)=0.0 + VSTGX(NB,NZ,NY,NX)=0.0 + KLEAF(NB,NZ,NY,NX)=1 + KVSTG(NB,NZ,NY,NX)=1 + TGSTGI(NB,NZ,NY,NX)=0.0 + TGSTGF(NB,NZ,NY,NX)=0.0 + VRNS(NB,NZ,NY,NX)=0.0 + VRNF(NB,NZ,NY,NX)=0.0 + VRNY(NB,NZ,NY,NX)=0.0 + VRNZ(NB,NZ,NY,NX)=0.0 + ATRP(NB,NZ,NY,NX)=0.0 + FLG4(NB,NZ,NY,NX)=0.0 + FDBK(NB,NZ,NY,NX)=1.0 + FDBKX(NB,NZ,NY,NX)=1.0 + IFLGA(NB,NZ,NY,NX)=0 + IFLGE(NB,NZ,NY,NX)=1 + IFLGF(NB,NZ,NY,NX)=0 + IFLGR(NB,NZ,NY,NX)=0 + IFLGQ(NB,NZ,NY,NX)=0 + IFLGD(NB,NZ,NY,NX)=0 + NBTB(NB,NZ,NY,NX)=0 + DO 8850 M=1,10 + IDAY(M,NB,NZ,NY,NX)=0 +8850 CONTINUE +C +C LITTERFALL FROM DEAD BRANCHES +C + DO 6405 M=1,4 + CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) + 2+CFOPC(0,M,NZ,NY,NX)*CPOLNB(NB,NZ,NY,NX) + 4+CFOPC(1,M,NZ,NY,NX)*(WTLFB(NB,NZ,NY,NX)*FWODB(1) + 5+WTNDB(NB,NZ,NY,NX)) + 6+CFOPC(2,M,NZ,NY,NX)*(WTSHEB(NB,NZ,NY,NX)*FWODB(1) + 7+WTHSKB(NB,NZ,NY,NX)+WTEARB(NB,NZ,NY,NX)) + CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX) + 2+CFOPC(5,M,NZ,NY,NX)*(WTLFB(NB,NZ,NY,NX)*FWODB(0) + 3+WTSHEB(NB,NZ,NY,NX)*FWODB(0)) + ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) + 2+CFOPN(0,M,NZ,NY,NX)*ZPOLNB(NB,NZ,NY,NX) + 4+CFOPN(1,M,NZ,NY,NX)*(WTLFBN(NB,NZ,NY,NX)*FWODLN(1) + 5+WTNDBN(NB,NZ,NY,NX)) + 6+CFOPN(2,M,NZ,NY,NX)*(WTSHBN(NB,NZ,NY,NX)*FWODSN(1) + 7+WTHSBN(NB,NZ,NY,NX)+WTEABN(NB,NZ,NY,NX)) + ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX) + 2+CFOPN(5,M,NZ,NY,NX)*(WTLFBN(NB,NZ,NY,NX)*FWODLN(0) + 3+WTSHBN(NB,NZ,NY,NX)*FWODSN(0)) + PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) + 2+CFOPP(0,M,NZ,NY,NX)*PPOLNB(NB,NZ,NY,NX) + 4+CFOPP(1,M,NZ,NY,NX)*(WTLFBP(NB,NZ,NY,NX)*FWODLP(1) + 5+WTNDBP(NB,NZ,NY,NX)) + 6+CFOPP(2,M,NZ,NY,NX)*(WTSHBP(NB,NZ,NY,NX)*FWODSP(1) + 7+WTHSBP(NB,NZ,NY,NX)+WTEABP(NB,NZ,NY,NX)) + PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX) + 2+CFOPP(5,M,NZ,NY,NX)*(WTLFBP(NB,NZ,NY,NX)*FWODLP(0) + 3+WTSHBP(NB,NZ,NY,NX)*FWODSP(0)) + IF(ISTYP(NZ,NY,NX).EQ.0.AND.IWTYP(NZ,NY,NX).NE.0)THEN + WTRVC(NZ,NY,NX)=WTRVC(NZ,NY,NX) + 2+CFOPC(2,M,NZ,NY,NX)*WTGRB(NB,NZ,NY,NX) + WTRVN(NZ,NY,NX)=WTRVN(NZ,NY,NX) + 2+CFOPN(2,M,NZ,NY,NX)*WTGRBN(NB,NZ,NY,NX) + WTRVP(NZ,NY,NX)=WTRVP(NZ,NY,NX) + 2+CFOPP(2,M,NZ,NY,NX)*WTGRBP(NB,NZ,NY,NX) + ELSE + CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) + 2+CFOPC(2,M,NZ,NY,NX)*WTGRB(NB,NZ,NY,NX) + ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) + 2+CFOPN(2,M,NZ,NY,NX)*WTGRBN(NB,NZ,NY,NX) + PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) + 2+CFOPP(2,M,NZ,NY,NX)*WTGRBP(NB,NZ,NY,NX) + ENDIF + IF(IBTYP(NZ,NY,NX).EQ.0.OR.IGTYP(NZ,NY,NX).LE.1)THEN + CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) + 5+CFOPC(3,M,NZ,NY,NX)*WTSTKB(NB,NZ,NY,NX) + ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) + 5+CFOPN(3,M,NZ,NY,NX)*WTSTBN(NB,NZ,NY,NX) + PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) + 5+CFOPP(3,M,NZ,NY,NX)*WTSTBP(NB,NZ,NY,NX) + ELSE + WTSTDG(M,NZ,NY,NX)=WTSTDG(M,NZ,NY,NX) + 5+CFOPC(5,M,NZ,NY,NX)*WTSTKB(NB,NZ,NY,NX) + WTSTDN(M,NZ,NY,NX)=WTSTDN(M,NZ,NY,NX) + 5+CFOPN(5,M,NZ,NY,NX)*WTSTBN(NB,NZ,NY,NX) + WTSTDP(M,NZ,NY,NX)=WTSTDP(M,NZ,NY,NX) + 5+CFOPP(5,M,NZ,NY,NX)*WTSTBP(NB,NZ,NY,NX) + ENDIF +6405 CONTINUE +C +C RECOVER NON-STRUCTURAL C,N,P FROM BRANCH TO +C SEASONAL STORAGE RESERVES +C + WTRVC(NZ,NY,NX)=WTRVC(NZ,NY,NX) + 2+CPOOL(NB,NZ,NY,NX)+CPOOLK(NB,NZ,NY,NX)+WTRSVB(NB,NZ,NY,NX) + WTRVN(NZ,NY,NX)=WTRVN(NZ,NY,NX) + 2+ZPOOL(NB,NZ,NY,NX)+WTRSBN(NB,NZ,NY,NX) + WTRVP(NZ,NY,NX)=WTRVP(NZ,NY,NX) + 2+PPOOL(NB,NZ,NY,NX)+WTRSBP(NB,NZ,NY,NX) +C +C RESET STATE VARIABLES FROM DEAD BRANCHES +C + CPOOL(NB,NZ,NY,NX)=0.0 + CPOOLK(NB,NZ,NY,NX)=0.0 + ZPOOL(NB,NZ,NY,NX)=0.0 + PPOOL(NB,NZ,NY,NX)=0.0 + CPOLNB(NB,NZ,NY,NX)=0.0 + ZPOLNB(NB,NZ,NY,NX)=0.0 + PPOLNB(NB,NZ,NY,NX)=0.0 + WTSHTB(NB,NZ,NY,NX)=0.0 + WTLFB(NB,NZ,NY,NX)=0.0 + WTNDB(NB,NZ,NY,NX)=0.0 + WTSHEB(NB,NZ,NY,NX)=0.0 + WTSTKB(NB,NZ,NY,NX)=0.0 + WVSTKB(NB,NZ,NY,NX)=0.0 + WTRSVB(NB,NZ,NY,NX)=0.0 + WTHSKB(NB,NZ,NY,NX)=0.0 + WTEARB(NB,NZ,NY,NX)=0.0 + WTGRB(NB,NZ,NY,NX)=0.0 + WTLSB(NB,NZ,NY,NX)=0.0 + WTSHTN(NB,NZ,NY,NX)=0.0 + WTLFBN(NB,NZ,NY,NX)=0.0 + WTNDBN(NB,NZ,NY,NX)=0.0 + WTSHBN(NB,NZ,NY,NX)=0.0 + WTSTBN(NB,NZ,NY,NX)=0.0 + WTRSBN(NB,NZ,NY,NX)=0.0 + WTHSBN(NB,NZ,NY,NX)=0.0 + WTEABN(NB,NZ,NY,NX)=0.0 + WTGRBN(NB,NZ,NY,NX)=0.0 + WTSHTP(NB,NZ,NY,NX)=0.0 + WTLFBP(NB,NZ,NY,NX)=0.0 + WTNDBP(NB,NZ,NY,NX)=0.0 + WTSHBP(NB,NZ,NY,NX)=0.0 + WTSTBP(NB,NZ,NY,NX)=0.0 + WTRSBP(NB,NZ,NY,NX)=0.0 + WTHSBP(NB,NZ,NY,NX)=0.0 + WTEABP(NB,NZ,NY,NX)=0.0 + WTGRBP(NB,NZ,NY,NX)=0.0 + GRNXB(NB,NZ,NY,NX)=0.0 + GRNOB(NB,NZ,NY,NX)=0.0 + GRWTB(NB,NZ,NY,NX)=0.0 + ARLFB(NB,NZ,NY,NX)=0.0 + WTSTXB(NB,NZ,NY,NX)=0.0 + WTSTXN(NB,NZ,NY,NX)=0.0 + WTSTXP(NB,NZ,NY,NX)=0.0 + DO 8855 K=0,25 + IF(K.NE.0)THEN + CPOOL3(K,NB,NZ,NY,NX)=0.0 + CPOOL4(K,NB,NZ,NY,NX)=0.0 + CO2B(K,NB,NZ,NY,NX)=0.0 + HCOB(K,NB,NZ,NY,NX)=0.0 + ENDIF + ARLF(K,NB,NZ,NY,NX)=0.0 + HTNODE(K,NB,NZ,NY,NX)=0.0 + HTNODX(K,NB,NZ,NY,NX)=0.0 + HTSHE(K,NB,NZ,NY,NX)=0.0 + WGLF(K,NB,NZ,NY,NX)=0.0 + WSLF(K,NB,NZ,NY,NX)=0.0 + WGLFN(K,NB,NZ,NY,NX)=0.0 + WGLFP(K,NB,NZ,NY,NX)=0.0 + WGSHE(K,NB,NZ,NY,NX)=0.0 + WSSHE(K,NB,NZ,NY,NX)=0.0 + WGSHN(K,NB,NZ,NY,NX)=0.0 + WGSHP(K,NB,NZ,NY,NX)=0.0 + WGNODE(K,NB,NZ,NY,NX)=0.0 + WGNODN(K,NB,NZ,NY,NX)=0.0 + WGNODP(K,NB,NZ,NY,NX)=0.0 + DO 8865 L=1,JC + ARLFV(L,NZ,NY,NX)=ARLFV(L,NZ,NY,NX)-ARLFL(L,K,NB,NZ,NY,NX) + WGLFV(L,NZ,NY,NX)=WGLFV(L,NZ,NY,NX)-WGLFL(L,K,NB,NZ,NY,NX) + ARLFL(L,K,NB,NZ,NY,NX)=0.0 + WGLFL(L,K,NB,NZ,NY,NX)=0.0 + WGLFLN(L,K,NB,NZ,NY,NX)=0.0 + WGLFLP(L,K,NB,NZ,NY,NX)=0.0 + IF(K.NE.0)THEN + DO 8860 N=1,4 + SURF(N,L,K,NB,NZ,NY,NX)=0.0 +8860 CONTINUE + ENDIF +8865 CONTINUE +8855 CONTINUE + DO 8875 L=1,JC + ARSTK(L,NB,NZ,NY,NX)=0.0 + DO 8875 N=1,4 + SURFB(N,L,NB,NZ,NY,NX)=0.0 +8875 CONTINUE + IDTHY=IDTHY+1 + ENDIF +8845 CONTINUE + IF(IDTHY.EQ.NBR(NZ,NY,NX))THEN + IDTHP(NZ,NY,NX)=1 + NBT(NZ,NY,NX)=0 + WSTR(NZ,NY,NX)=0.0 + IF(IFLGI(NZ,NY,NX).EQ.1)THEN + NBR(NZ,NY,NX)=1 + ELSE + NBR(NZ,NY,NX)=0 + ENDIF + HTCTL(NZ,NY,NX)=0.0 + VOLWOU=VOLWOU+VOLWP(NZ,NY,NX) + UVOLO(NY,NX)=UVOLO(NY,NX)+VOLWP(NZ,NY,NX) + VOLWP(NZ,NY,NX)=0.0 + IF(WTRVC(NZ,NY,NX).LT.1.0E-04*WTRT(NZ,NY,NX) + 2.AND.ISTYP(NZ,NY,NX).NE.0)IDTHR(NZ,NY,NX)=1 + IF(ISTYP(NZ,NY,NX).EQ.0)IDTHR(NZ,NY,NX)=1 + IF(JHVST(NZ,I,NY,NX).NE.0)IDTHR(NZ,NY,NX)=1 + IF(PP(NZ,NY,NX).LE.0.0)IDTHR(NZ,NY,NX)=1 + IF(IDTHR(NZ,NY,NX).EQ.1)IDTHP(NZ,NY,NX)=1 + ENDIF +C +C DEAD ROOTS +C +C +C LITTERFALL FROM DEAD ROOTS +C + IF(IDTHR(NZ,NY,NX).EQ.1)THEN + DO 8900 N=1,MY(NZ,NY,NX) + DO 8895 L=NU(NY,NX),NJ(NY,NX) + DO 6410 M=1,4 + CSNC(M,1,L,NZ,NY,NX)=CSNC(M,1,L,NZ,NY,NX)+CFOPC(0,M,NZ,NY,NX) + 2*CPOOLR(N,L,NZ,NY,NX) + ZSNC(M,1,L,NZ,NY,NX)=ZSNC(M,1,L,NZ,NY,NX)+CFOPN(0,M,NZ,NY,NX) + 2*ZPOOLR(N,L,NZ,NY,NX) + PSNC(M,1,L,NZ,NY,NX)=PSNC(M,1,L,NZ,NY,NX)+CFOPP(0,M,NZ,NY,NX) + 2*PPOOLR(N,L,NZ,NY,NX) + DO 6410 NR=1,NRT(NZ,NY,NX) + CSNC(M,0,L,NZ,NY,NX)=CSNC(M,0,L,NZ,NY,NX)+CFOPC(5,M,NZ,NY,NX) + 2*(WTRT1(N,L,NR,NZ,NY,NX)+WTRT2(N,L,NR,NZ,NY,NX))*FWOOD(0) + ZSNC(M,0,L,NZ,NY,NX)=ZSNC(M,0,L,NZ,NY,NX)+CFOPN(5,M,NZ,NY,NX) + 2*(WTRT1N(N,L,NR,NZ,NY,NX)+WTRT2N(N,L,NR,NZ,NY,NX))*FWOODN(0) + PSNC(M,0,L,NZ,NY,NX)=PSNC(M,0,L,NZ,NY,NX)+CFOPP(5,M,NZ,NY,NX) + 2*(WTRT1P(N,L,NR,NZ,NY,NX)+WTRT2P(N,L,NR,NZ,NY,NX))*FWOODP(0) + CSNC(M,1,L,NZ,NY,NX)=CSNC(M,1,L,NZ,NY,NX)+CFOPC(4,M,NZ,NY,NX) + 2*(WTRT1(N,L,NR,NZ,NY,NX)+WTRT2(N,L,NR,NZ,NY,NX))*FWOOD(1) + ZSNC(M,1,L,NZ,NY,NX)=ZSNC(M,1,L,NZ,NY,NX)+CFOPN(4,M,NZ,NY,NX) + 2*(WTRT1N(N,L,NR,NZ,NY,NX)+WTRT2N(N,L,NR,NZ,NY,NX))*FWOODN(1) + PSNC(M,1,L,NZ,NY,NX)=PSNC(M,1,L,NZ,NY,NX)+CFOPP(4,M,NZ,NY,NX) + 2*(WTRT1P(N,L,NR,NZ,NY,NX)+WTRT2P(N,L,NR,NZ,NY,NX))*FWOODP(1) +6410 CONTINUE +C +C RELEASE GAS CONTENTS OF DEAD ROOTS +C + RCO2Z(NZ,NY,NX)=RCO2Z(NZ,NY,NX)-CO2A(N,L,NZ,NY,NX) + 2-CO2P(N,L,NZ,NY,NX) + ROXYZ(NZ,NY,NX)=ROXYZ(NZ,NY,NX)-OXYA(N,L,NZ,NY,NX) + 2-OXYP(N,L,NZ,NY,NX) + RCH4Z(NZ,NY,NX)=RCH4Z(NZ,NY,NX)-CH4A(N,L,NZ,NY,NX) + 2-CH4P(N,L,NZ,NY,NX) + RN2OZ(NZ,NY,NX)=RN2OZ(NZ,NY,NX)-Z2OA(N,L,NZ,NY,NX) + 2-Z2OP(N,L,NZ,NY,NX) + RNH3Z(NZ,NY,NX)=RNH3Z(NZ,NY,NX)-ZH3A(N,L,NZ,NY,NX) + 2-ZH3P(N,L,NZ,NY,NX) + RH2GZ(NZ,NY,NX)=RH2GZ(NZ,NY,NX)-H2GA(N,L,NZ,NY,NX) + 2-H2GP(N,L,NZ,NY,NX) + CO2A(N,L,NZ,NY,NX)=0.0 + OXYA(N,L,NZ,NY,NX)=0.0 + CH4A(N,L,NZ,NY,NX)=0.0 + Z2OA(N,L,NZ,NY,NX)=0.0 + ZH3A(N,L,NZ,NY,NX)=0.0 + H2GA(N,L,NZ,NY,NX)=0.0 + CO2P(N,L,NZ,NY,NX)=0.0 + OXYP(N,L,NZ,NY,NX)=0.0 + CH4P(N,L,NZ,NY,NX)=0.0 + Z2OP(N,L,NZ,NY,NX)=0.0 + ZH3P(N,L,NZ,NY,NX)=0.0 + H2GP(N,L,NZ,NY,NX)=0.0 +C +C RESET STATE VARIABLES OF DEAD ROOTS +C + DO 8870 NR=1,NRT(NZ,NY,NX) + WTRT1(N,L,NR,NZ,NY,NX)=0.0 + WTRT1N(N,L,NR,NZ,NY,NX)=0.0 + WTRT1P(N,L,NR,NZ,NY,NX)=0.0 + WTRT2(N,L,NR,NZ,NY,NX)=0.0 + WTRT2N(N,L,NR,NZ,NY,NX)=0.0 + WTRT2P(N,L,NR,NZ,NY,NX)=0.0 + RTWT1(N,NR,NZ,NY,NX)=0.0 + RTWT1N(N,NR,NZ,NY,NX)=0.0 + RTWT1P(N,NR,NZ,NY,NX)=0.0 + RTLG1(N,L,NR,NZ,NY,NX)=0.0 + RTLG2(N,L,NR,NZ,NY,NX)=0.0 + RTN2(N,L,NR,NZ,NY,NX)=0.0 +8870 CONTINUE + CPOOLR(N,L,NZ,NY,NX)=0.0 + ZPOOLR(N,L,NZ,NY,NX)=0.0 + PPOOLR(N,L,NZ,NY,NX)=0.0 + WTRTL(N,L,NZ,NY,NX)=0.0 + WTRTD(N,L,NZ,NY,NX)=0.0 + WSRTL(N,L,NZ,NY,NX)=0.0 + RTN1(N,L,NZ,NY,NX)=0.0 + RTNL(N,L,NZ,NY,NX)=0.0 + RTLGP(N,L,NZ,NY,NX)=0.0 + RTDNP(N,L,NZ,NY,NX)=0.0 + RTVLP(N,L,NZ,NY,NX)=0.0 + RTVLW(N,L,NZ,NY,NX)=0.0 + RRAD1(N,L,NZ,NY,NX)=RRAD1M(N,NZ,NY,NX) + RRAD2(N,L,NZ,NY,NX)=RRAD2M(N,NZ,NY,NX) + RTARP(N,L,NZ,NY,NX)=0.0 + RTLGA(N,L,NZ,NY,NX)=RTLGAX +C +C LITTERFALL AND STATE VARIABLES FROM DEAD NODULES +C + IF(INTYP(NZ,NY,NX).NE.0.AND.N.EQ.1)THEN + DO 6420 M=1,4 + CSNC(M,1,L,NZ,NY,NX)=CSNC(M,1,L,NZ,NY,NX)+CFOPC(4,M,NZ,NY,NX) + 2*WTNDL(L,NZ,NY,NX)+CFOPC(0,M,NZ,NY,NX)*CPOOLN(L,NZ,NY,NX) + ZSNC(M,1,L,NZ,NY,NX)=ZSNC(M,1,L,NZ,NY,NX)+CFOPN(4,M,NZ,NY,NX) + 2*WTNDLN(L,NZ,NY,NX)+CFOPN(0,M,NZ,NY,NX)*ZPOOLN(L,NZ,NY,NX) + PSNC(M,1,L,NZ,NY,NX)=PSNC(M,1,L,NZ,NY,NX)+CFOPP(4,M,NZ,NY,NX) + 2*WTNDLP(L,NZ,NY,NX)+CFOPP(0,M,NZ,NY,NX)*PPOOLN(L,NZ,NY,NX) +6420 CONTINUE + WTNDL(L,NZ,NY,NX)=0.0 + WTNDLN(L,NZ,NY,NX)=0.0 + WTNDLP(L,NZ,NY,NX)=0.0 + CPOOLN(L,NZ,NY,NX)=0.0 + ZPOOLN(L,NZ,NY,NX)=0.0 + PPOOLN(L,NZ,NY,NX)=0.0 + ENDIF +8895 CONTINUE +8900 CONTINUE +C +C RESET DEPTH VARIABLES OF DEAD ROOTS +C + DO 8795 NR=1,NRT(NZ,NY,NX) + NINR(NR,NZ,NY,NX)=NG(NZ,NY,NX) + DO 8790 N=1,MY(NZ,NY,NX) + RTDP1(N,NR,NZ,NY,NX)=SDPTH(NZ,NY,NX) + RTWT1(N,NR,NZ,NY,NX)=0.0 + RTWT1N(N,NR,NZ,NY,NX)=0.0 + RTWT1P(N,NR,NZ,NY,NX)=0.0 +8790 CONTINUE +8795 CONTINUE + NIX(NZ,NY,NX)=NG(NZ,NY,NX) + NRT(NZ,NY,NX)=0 + ENDIF +C +C LITTERFALL AND STATE VARIABLES FOR SEASONAL STORAGE +C RESERVES AT DEATH +C + IF(IDTHP(NZ,NY,NX).EQ.1.AND.IDTHR(NZ,NY,NX).EQ.1)THEN + IF(IFLGI(NZ,NY,NX).EQ.0)THEN + DO 6425 M=1,4 + DO 8825 NB=1,NBR(NZ,NY,NX) + CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) + 2+CFOPC(0,M,NZ,NY,NX)*(CPOOL(NB,NZ,NY,NX)+CPOLNB(NB,NZ,NY,NX) + 3+CPOOLK(NB,NZ,NY,NX)+WTRSVB(NB,NZ,NY,NX)) + 4+CFOPC(1,M,NZ,NY,NX)*(WTLFB(NB,NZ,NY,NX)*FWODB(1) + 5+WTNDB(NB,NZ,NY,NX)) + 6+CFOPC(2,M,NZ,NY,NX)*(WTSHEB(NB,NZ,NY,NX)*FWODB(1) + 7+WTHSKB(NB,NZ,NY,NX)+WTEARB(NB,NZ,NY,NX)) + CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX) + 2+CFOPC(5,M,NZ,NY,NX)*(WTLFB(NB,NZ,NY,NX)*FWODB(0) + 3+WTSHEB(NB,NZ,NY,NX)*FWODB(0)) + ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) + 2+CFOPN(0,M,NZ,NY,NX)*(ZPOOL(NB,NZ,NY,NX)+ZPOLNB(NB,NZ,NY,NX) + 3+WTRSBN(NB,NZ,NY,NX)) + 4+CFOPN(1,M,NZ,NY,NX)*(WTLFBN(NB,NZ,NY,NX)*FWODLN(1) + 5+WTNDBN(NB,NZ,NY,NX)) + 6+CFOPN(2,M,NZ,NY,NX)*(WTSHBN(NB,NZ,NY,NX)*FWODSN(1) + 7+WTHSBN(NB,NZ,NY,NX)+WTEABN(NB,NZ,NY,NX)) + ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX) + 2+CFOPN(5,M,NZ,NY,NX)*(WTLFBN(NB,NZ,NY,NX)*FWODLN(0) + 3+WTSHBN(NB,NZ,NY,NX)*FWODSN(0)) + PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) + 2+CFOPP(0,M,NZ,NY,NX)*(PPOOL(NB,NZ,NY,NX)+PPOLNB(NB,NZ,NY,NX) + 3+WTRSBP(NB,NZ,NY,NX)) + 4+CFOPP(1,M,NZ,NY,NX)*(WTLFBP(NB,NZ,NY,NX)*FWODLP(1) + 5+WTNDBP(NB,NZ,NY,NX)) + 6+CFOPP(2,M,NZ,NY,NX)*(WTSHBP(NB,NZ,NY,NX)*FWODSP(1) + 7+WTHSBP(NB,NZ,NY,NX)+WTEABP(NB,NZ,NY,NX)) + PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX) + 2+CFOPP(5,M,NZ,NY,NX)*(WTLFBP(NB,NZ,NY,NX)*FWODLP(0) + 3+WTSHBP(NB,NZ,NY,NX)*FWODSP(0)) + IF(ISTYP(NZ,NY,NX).EQ.0.AND.IWTYP(NZ,NY,NX).NE.0)THEN + WTRVC(NZ,NY,NX)=WTRVC(NZ,NY,NX) + 2+CFOPC(2,M,NZ,NY,NX)*WTGRB(NB,NZ,NY,NX) + WTRVN(NZ,NY,NX)=WTRVN(NZ,NY,NX) + 2+CFOPN(2,M,NZ,NY,NX)*WTGRBN(NB,NZ,NY,NX) + WTRVP(NZ,NY,NX)=WTRVP(NZ,NY,NX) + 2+CFOPP(2,M,NZ,NY,NX)*WTGRBP(NB,NZ,NY,NX) + ELSE + CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) + 2+CFOPC(2,M,NZ,NY,NX)*WTGRB(NB,NZ,NY,NX) + ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) + 2+CFOPN(2,M,NZ,NY,NX)*WTGRBN(NB,NZ,NY,NX) + PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) + 2+CFOPP(2,M,NZ,NY,NX)*WTGRBP(NB,NZ,NY,NX) + ENDIF + IF(IBTYP(NZ,NY,NX).EQ.0.OR.IGTYP(NZ,NY,NX).LE.1)THEN + CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) + 5+CFOPC(3,M,NZ,NY,NX)*WTSTKB(NB,NZ,NY,NX) + ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) + 5+CFOPN(3,M,NZ,NY,NX)*WTSTBN(NB,NZ,NY,NX) + PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) + 5+CFOPP(3,M,NZ,NY,NX)*WTSTBP(NB,NZ,NY,NX) + ELSE + WTSTDG(M,NZ,NY,NX)=WTSTDG(M,NZ,NY,NX) + 5+CFOPC(5,M,NZ,NY,NX)*WTSTKB(NB,NZ,NY,NX) + WTSTDN(M,NZ,NY,NX)=WTSTDN(M,NZ,NY,NX) + 5+CFOPN(5,M,NZ,NY,NX)*WTSTBN(NB,NZ,NY,NX) + WTSTDP(M,NZ,NY,NX)=WTSTDP(M,NZ,NY,NX) + 5+CFOPP(5,M,NZ,NY,NX)*WTSTBP(NB,NZ,NY,NX) + ENDIF +8825 CONTINUE + DO 6415 L=NU(NY,NX),NJ(NY,NX) + DO 6415 N=1,MY(NZ,NY,NX) + CSNC(M,1,L,NZ,NY,NX)=CSNC(M,1,L,NZ,NY,NX)+CFOPC(0,M,NZ,NY,NX) + 2*CPOOLR(N,L,NZ,NY,NX) + ZSNC(M,1,L,NZ,NY,NX)=ZSNC(M,1,L,NZ,NY,NX)+CFOPN(0,M,NZ,NY,NX) + 2*ZPOOLR(N,L,NZ,NY,NX) + PSNC(M,1,L,NZ,NY,NX)=PSNC(M,1,L,NZ,NY,NX)+CFOPP(0,M,NZ,NY,NX) + 2*PPOOLR(N,L,NZ,NY,NX) + DO 6415 NR=1,NRT(NZ,NY,NX) + CSNC(M,0,L,NZ,NY,NX)=CSNC(M,0,L,NZ,NY,NX)+CFOPC(5,M,NZ,NY,NX) + 2*(WTRT1(N,L,NR,NZ,NY,NX)+WTRT2(N,L,NR,NZ,NY,NX))*FWOOD(0) + ZSNC(M,0,L,NZ,NY,NX)=ZSNC(M,0,L,NZ,NY,NX)+CFOPN(5,M,NZ,NY,NX) + 2*(WTRT1N(N,L,NR,NZ,NY,NX)+WTRT2N(N,L,NR,NZ,NY,NX))*FWOODN(0) + PSNC(M,0,L,NZ,NY,NX)=PSNC(M,0,L,NZ,NY,NX)+CFOPP(5,M,NZ,NY,NX) + 2*(WTRT1P(N,L,NR,NZ,NY,NX)+WTRT2P(N,L,NR,NZ,NY,NX))*FWOODP(0) + CSNC(M,1,L,NZ,NY,NX)=CSNC(M,1,L,NZ,NY,NX)+CFOPC(4,M,NZ,NY,NX) + 2*(WTRT1(N,L,NR,NZ,NY,NX)+WTRT2(N,L,NR,NZ,NY,NX))*FWOOD(1) + ZSNC(M,1,L,NZ,NY,NX)=ZSNC(M,1,L,NZ,NY,NX)+CFOPN(4,M,NZ,NY,NX) + 2*(WTRT1N(N,L,NR,NZ,NY,NX)+WTRT2N(N,L,NR,NZ,NY,NX))*FWOODN(1) + PSNC(M,1,L,NZ,NY,NX)=PSNC(M,1,L,NZ,NY,NX)+CFOPP(4,M,NZ,NY,NX) + 2*(WTRT1P(N,L,NR,NZ,NY,NX)+WTRT2P(N,L,NR,NZ,NY,NX))*FWOODP(1) +6415 CONTINUE + CSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX)=CSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX) + 2+CFOPC(0,M,NZ,NY,NX)*WTRVC(NZ,NY,NX)*FWOOD(0) + ZSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX)=ZSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX) + 2+CFOPN(0,M,NZ,NY,NX)*WTRVN(NZ,NY,NX)*FWOODN(0) + PSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX)=PSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX) + 2+CFOPP(0,M,NZ,NY,NX)*WTRVP(NZ,NY,NX)*FWOODP(0) + CSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX)=CSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX) + 2+CFOPC(0,M,NZ,NY,NX)*WTRVC(NZ,NY,NX)*FWOOD(1) + ZSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX)=ZSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX) + 2+CFOPN(0,M,NZ,NY,NX)*WTRVN(NZ,NY,NX)*FWOODN(1) + PSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX)=PSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX) + 2+CFOPP(0,M,NZ,NY,NX)*WTRVP(NZ,NY,NX)*FWOODP(1) +6425 CONTINUE + DO 8835 NB=1,NBR(NZ,NY,NX) + CPOOL(NB,NZ,NY,NX)=0.0 + CPOOLK(NB,NZ,NY,NX)=0.0 + ZPOOL(NB,NZ,NY,NX)=0.0 + PPOOL(NB,NZ,NY,NX)=0.0 + CPOLNB(NB,NZ,NY,NX)=0.0 + ZPOLNB(NB,NZ,NY,NX)=0.0 + PPOLNB(NB,NZ,NY,NX)=0.0 + WTSHTB(NB,NZ,NY,NX)=0.0 + WTLFB(NB,NZ,NY,NX)=0.0 + WTNDB(NB,NZ,NY,NX)=0.0 + WTSHEB(NB,NZ,NY,NX)=0.0 + WTSTKB(NB,NZ,NY,NX)=0.0 + WVSTKB(NB,NZ,NY,NX)=0.0 + WTRSVB(NB,NZ,NY,NX)=0.0 + WTHSKB(NB,NZ,NY,NX)=0.0 + WTEARB(NB,NZ,NY,NX)=0.0 + WTGRB(NB,NZ,NY,NX)=0.0 + WTLSB(NB,NZ,NY,NX)=0.0 + WTSHTN(NB,NZ,NY,NX)=0.0 + WTLFBN(NB,NZ,NY,NX)=0.0 + WTNDBN(NB,NZ,NY,NX)=0.0 + WTSHBN(NB,NZ,NY,NX)=0.0 + WTSTBN(NB,NZ,NY,NX)=0.0 + WTRSBN(NB,NZ,NY,NX)=0.0 + WTHSBN(NB,NZ,NY,NX)=0.0 + WTEABN(NB,NZ,NY,NX)=0.0 + WTGRBN(NB,NZ,NY,NX)=0.0 + WTSHTP(NB,NZ,NY,NX)=0.0 + WTLFBP(NB,NZ,NY,NX)=0.0 + WTNDBP(NB,NZ,NY,NX)=0.0 + WTSHBP(NB,NZ,NY,NX)=0.0 + WTSTBP(NB,NZ,NY,NX)=0.0 + WTRSBP(NB,NZ,NY,NX)=0.0 + WTHSBP(NB,NZ,NY,NX)=0.0 + WTEABP(NB,NZ,NY,NX)=0.0 + WTGRBP(NB,NZ,NY,NX)=0.0 + WTSTXB(NB,NZ,NY,NX)=0.0 + WTSTXN(NB,NZ,NY,NX)=0.0 + WTSTXP(NB,NZ,NY,NX)=0.0 +8835 CONTINUE + DO 6416 L=NU(NY,NX),NJ(NY,NX) + DO 6416 N=1,MY(NZ,NY,NX) + CPOOLR(N,L,NZ,NY,NX)=0.0 + ZPOOLR(N,L,NZ,NY,NX)=0.0 + PPOOLR(N,L,NZ,NY,NX)=0.0 + DO 6416 NR=1,NRT(NZ,NY,NX) + WTRT1(N,L,NR,NZ,NY,NX)=0.0 + WTRT1N(N,L,NR,NZ,NY,NX)=0.0 + WTRT1P(N,L,NR,NZ,NY,NX)=0.0 + WTRT2(N,L,NR,NZ,NY,NX)=0.0 + WTRT2N(N,L,NR,NZ,NY,NX)=0.0 + WTRT2P(N,L,NR,NZ,NY,NX)=0.0 + RTWT1(N,NR,NZ,NY,NX)=0.0 + RTWT1N(N,NR,NZ,NY,NX)=0.0 + RTWT1P(N,NR,NZ,NY,NX)=0.0 + RTLG1(N,L,NR,NZ,NY,NX)=0.0 + RTLG2(N,L,NR,NZ,NY,NX)=0.0 + RTN2(N,L,NR,NZ,NY,NX)=0.0 +6416 CONTINUE + WTRVC(NZ,NY,NX)=0.0 + WTRVN(NZ,NY,NX)=0.0 + WTRVP(NZ,NY,NX)=0.0 + IDTH(NZ,NY,NX)=1 + ENDIF +C +C RESEED DEAD PERENNIALS +C + IF(ISTYP(NZ,NY,NX).NE.0.AND.JHVST(NZ,I,NY,NX).EQ.0)THEN + IF(I.LT.LYRC)THEN + IDAY0(NZ,NY,NX)=I+1 + IYR0(NZ,NY,NX)=IDATA(3) + ELSE + IDAY0(NZ,NY,NX)=1 + IYR0(NZ,NY,NX)=IDATA(3)+1 + ENDIF + ENDIF + ENDIF + ENDIF +C +C CHECK PLANT C,N,P BALANCES +C + CPOOLP(NZ,NY,NX)=0.0 + ZPOOLP(NZ,NY,NX)=0.0 + PPOOLP(NZ,NY,NX)=0.0 + WTSHT(NZ,NY,NX)=0.0 + WTSHN(NZ,NY,NX)=0.0 + WTSHP(NZ,NY,NX)=0.0 + WTLF(NZ,NY,NX)=0.0 + WTSHE(NZ,NY,NX)=0.0 + WTSTK(NZ,NY,NX)=0.0 + WVSTK(NZ,NY,NX)=0.0 + WTRSV(NZ,NY,NX)=0.0 + WTHSK(NZ,NY,NX)=0.0 + WTEAR(NZ,NY,NX)=0.0 + WTGR(NZ,NY,NX)=0.0 + WTLS(NZ,NY,NX)=0.0 + WTRT(NZ,NY,NX)=0.0 + WTRTS(NZ,NY,NX)=0.0 + WTRTN(NZ,NY,NX)=0.0 + WTRTP(NZ,NY,NX)=0.0 + WTLFN(NZ,NY,NX)=0.0 + WTSHEN(NZ,NY,NX)=0.0 + WTSTKN(NZ,NY,NX)=0.0 + WTRSVN(NZ,NY,NX)=0.0 + WTHSKN(NZ,NY,NX)=0.0 + WTEARN(NZ,NY,NX)=0.0 + WTGRNN(NZ,NY,NX)=0.0 + WTLFP(NZ,NY,NX)=0.0 + WTSHEP(NZ,NY,NX)=0.0 + WTSTKP(NZ,NY,NX)=0.0 + WTRSVP(NZ,NY,NX)=0.0 + WTHSKP(NZ,NY,NX)=0.0 + WTEARP(NZ,NY,NX)=0.0 + WTGRNP(NZ,NY,NX)=0.0 + GRNO(NZ,NY,NX)=0.0 + ARLFP(NZ,NY,NX)=0.0 + ARSTP(NZ,NY,NX)=0.0 + DO 8940 L=1,JC + ARSTV(L,NZ,NY,NX)=0.0 +8940 CONTINUE +C +C ACCUMULATE PLANT STATE VARIABLES FROM BRANCH STATE VARIABLES +C + DO 8950 NB=1,NBR(NZ,NY,NX) + CPOOLP(NZ,NY,NX)=CPOOLP(NZ,NY,NX)+CPOOL(NB,NZ,NY,NX) + ZPOOLP(NZ,NY,NX)=ZPOOLP(NZ,NY,NX)+ZPOOL(NB,NZ,NY,NX) + PPOOLP(NZ,NY,NX)=PPOOLP(NZ,NY,NX)+PPOOL(NB,NZ,NY,NX) + WTSHT(NZ,NY,NX)=WTSHT(NZ,NY,NX)+WTSHTB(NB,NZ,NY,NX) + WTLF(NZ,NY,NX)=WTLF(NZ,NY,NX)+WTLFB(NB,NZ,NY,NX) + WTSHE(NZ,NY,NX)=WTSHE(NZ,NY,NX)+WTSHEB(NB,NZ,NY,NX) + WTSTK(NZ,NY,NX)=WTSTK(NZ,NY,NX)+WTSTKB(NB,NZ,NY,NX) + WVSTK(NZ,NY,NX)=WVSTK(NZ,NY,NX)+WVSTKB(NB,NZ,NY,NX) + WTRSV(NZ,NY,NX)=WTRSV(NZ,NY,NX)+WTRSVB(NB,NZ,NY,NX) + WTHSK(NZ,NY,NX)=WTHSK(NZ,NY,NX)+WTHSKB(NB,NZ,NY,NX) + WTEAR(NZ,NY,NX)=WTEAR(NZ,NY,NX)+WTEARB(NB,NZ,NY,NX) + WTGR(NZ,NY,NX)=WTGR(NZ,NY,NX)+WTGRB(NB,NZ,NY,NX) + WTLS(NZ,NY,NX)=WTLS(NZ,NY,NX)+WTLSB(NB,NZ,NY,NX) + WTSHN(NZ,NY,NX)=WTSHN(NZ,NY,NX)+WTSHTN(NB,NZ,NY,NX) + WTLFN(NZ,NY,NX)=WTLFN(NZ,NY,NX)+WTLFBN(NB,NZ,NY,NX) + WTSHEN(NZ,NY,NX)=WTSHEN(NZ,NY,NX)+WTSHBN(NB,NZ,NY,NX) + WTSTKN(NZ,NY,NX)=WTSTKN(NZ,NY,NX)+WTSTBN(NB,NZ,NY,NX) + WTRSVN(NZ,NY,NX)=WTRSVN(NZ,NY,NX)+WTRSBN(NB,NZ,NY,NX) + WTHSKN(NZ,NY,NX)=WTHSKN(NZ,NY,NX)+WTHSBN(NB,NZ,NY,NX) + WTEARN(NZ,NY,NX)=WTEARN(NZ,NY,NX)+WTEABN(NB,NZ,NY,NX) + WTGRNN(NZ,NY,NX)=WTGRNN(NZ,NY,NX)+WTGRBN(NB,NZ,NY,NX) + WTSHP(NZ,NY,NX)=WTSHP(NZ,NY,NX)+WTSHTP(NB,NZ,NY,NX) + WTLFP(NZ,NY,NX)=WTLFP(NZ,NY,NX)+WTLFBP(NB,NZ,NY,NX) + WTSHEP(NZ,NY,NX)=WTSHEP(NZ,NY,NX)+WTSHBP(NB,NZ,NY,NX) + WTSTKP(NZ,NY,NX)=WTSTKP(NZ,NY,NX)+WTSTBP(NB,NZ,NY,NX) + WTRSVP(NZ,NY,NX)=WTRSVP(NZ,NY,NX)+WTRSBP(NB,NZ,NY,NX) + WTHSKP(NZ,NY,NX)=WTHSKP(NZ,NY,NX)+WTHSBP(NB,NZ,NY,NX) + WTEARP(NZ,NY,NX)=WTEARP(NZ,NY,NX)+WTEABP(NB,NZ,NY,NX) + WTGRNP(NZ,NY,NX)=WTGRNP(NZ,NY,NX)+WTGRBP(NB,NZ,NY,NX) + ARLFP(NZ,NY,NX)=ARLFP(NZ,NY,NX)+ARLFB(NB,NZ,NY,NX) + GRNO(NZ,NY,NX)=GRNO(NZ,NY,NX)+GRNOB(NB,NZ,NY,NX) + DO 8945 L=1,JC + ARSTP(NZ,NY,NX)=ARSTP(NZ,NY,NX)+ARSTK(L,NB,NZ,NY,NX) + ARSTV(L,NZ,NY,NX)=ARSTV(L,NZ,NY,NX)+ARSTK(L,NB,NZ,NY,NX) +8945 CONTINUE +8950 CONTINUE +C +C ACCUMULATE ROOT STATE VARIABLES FROM ROOT LAYER STATE VARIABLES +C +C IF(WTLS(NZ,NY,NX).LE.0.0)ARLFP(NZ,NY,NX)=0.0 + DO 8925 N=1,MY(NZ,NY,NX) + DO 8930 L=NU(NY,NX),NJ(NY,NX) + WTRT(NZ,NY,NX)=WTRT(NZ,NY,NX)+CPOOLR(N,L,NZ,NY,NX) + WTRTN(NZ,NY,NX)=WTRTN(NZ,NY,NX)+ZPOOLR(N,L,NZ,NY,NX) + WTRTP(NZ,NY,NX)=WTRTP(NZ,NY,NX)+PPOOLR(N,L,NZ,NY,NX) + DO 8935 NR=1,NRT(NZ,NY,NX) + WTRT(NZ,NY,NX)=WTRT(NZ,NY,NX)+WTRT1(N,L,NR,NZ,NY,NX) + 2+WTRT2(N,L,NR,NZ,NY,NX) + WTRTS(NZ,NY,NX)=WTRTS(NZ,NY,NX)+WTRT1(N,L,NR,NZ,NY,NX) + 2+WTRT2(N,L,NR,NZ,NY,NX) + WTRTN(NZ,NY,NX)=WTRTN(NZ,NY,NX)+WTRT1N(N,L,NR,NZ,NY,NX) + 2+WTRT2N(N,L,NR,NZ,NY,NX) + WTRTP(NZ,NY,NX)=WTRTP(NZ,NY,NX)+WTRT1P(N,L,NR,NZ,NY,NX) + 2+WTRT2P(N,L,NR,NZ,NY,NX) +8935 CONTINUE +8930 CONTINUE +8925 CONTINUE +C +C ACCUMULATE NODULE STATE VATIABLES FROM NODULE LAYER VARIABLES +C + IF(INTYP(NZ,NY,NX).NE.0)THEN + WTND(NZ,NY,NX)=0.0 + WTNDN(NZ,NY,NX)=0.0 + WTNDP(NZ,NY,NX)=0.0 + IF(INTYP(NZ,NY,NX).GE.3)THEN + DO 7950 NB=1,NBR(NZ,NY,NX) + CPOLNP(NZ,NY,NX)=CPOLNP(NZ,NY,NX)+CPOLNB(NB,NZ,NY,NX) + ZPOLNP(NZ,NY,NX)=ZPOLNP(NZ,NY,NX)+ZPOLNB(NB,NZ,NY,NX) + PPOLNP(NZ,NY,NX)=PPOLNP(NZ,NY,NX)+PPOLNB(NB,NZ,NY,NX) + WTND(NZ,NY,NX)=WTND(NZ,NY,NX)+WTNDB(NB,NZ,NY,NX) + 2+CPOLNB(NB,NZ,NY,NX) + WTNDN(NZ,NY,NX)=WTNDN(NZ,NY,NX)+WTNDBN(NB,NZ,NY,NX) + 2+ZPOLNB(NB,NZ,NY,NX) + WTNDP(NZ,NY,NX)=WTNDP(NZ,NY,NX)+WTNDBP(NB,NZ,NY,NX) + 2+PPOLNB(NB,NZ,NY,NX) +7950 CONTINUE + ELSEIF(INTYP(NZ,NY,NX).EQ.1.OR.INTYP(NZ,NY,NX).EQ.2)THEN + DO 8920 L=NU(NY,NX),NI(NZ,NY,NX) + WTND(NZ,NY,NX)=WTND(NZ,NY,NX)+WTNDL(L,NZ,NY,NX) + 2+CPOOLN(L,NZ,NY,NX) + WTNDN(NZ,NY,NX)=WTNDN(NZ,NY,NX)+WTNDLN(L,NZ,NY,NX) + 2+ZPOOLN(L,NZ,NY,NX) + WTNDP(NZ,NY,NX)=WTNDP(NZ,NY,NX)+WTNDLP(L,NZ,NY,NX) + 2+PPOOLN(L,NZ,NY,NX) +8920 CONTINUE + ENDIF + ENDIF +C +C ACCUMULATE TOTAL SOIL-PLANT C,N,P EXCHANGE +C + HCUPTK(NZ,NY,NX)=UPOMC(NZ,NY,NX) + HZUPTK(NZ,NY,NX)=UPOMN(NZ,NY,NX)+UPNH4(NZ,NY,NX)+UPNO3(NZ,NY,NX) + 2+UPNF(NZ,NY,NX) + HPUPTK(NZ,NY,NX)=UPOMP(NZ,NY,NX)+UPH2P(NZ,NY,NX) + TCUPTK(NZ,NY,NX)=TCUPTK(NZ,NY,NX)+UPOMC(NZ,NY,NX) + TZUPTK(NZ,NY,NX)=TZUPTK(NZ,NY,NX)+UPOMN(NZ,NY,NX)+UPNH4(NZ,NY,NX) + 2+UPNO3(NZ,NY,NX) + TPUPTK(NZ,NY,NX)=TPUPTK(NZ,NY,NX)+UPOMP(NZ,NY,NX)+UPH2P(NZ,NY,NX) + TZUPFX(NZ,NY,NX)=TZUPFX(NZ,NY,NX)+UPNF(NZ,NY,NX)+UPNFC(NZ,NY,NX) + ENDIF +C +C HARVEST STANDING DEAD +C + IF(IHVST(NZ,I,NY,NX).GE.0)THEN + IF(J.EQ.INT(ZNOON(NY,NX)).AND.IHVST(NZ,I,NY,NX).NE.4 + 2.AND.IHVST(NZ,I,NY,NX).NE.6)THEN + IF(THIN(NZ,I,NY,NX).EQ.0.0)THEN + FHVST=AMAX1(0.0,1.0-EHVST(1,4,NZ,I,NY,NX)) + FHVSH=FHVST + ELSE + FHVST=AMAX1(0.0,1.0-THIN(NZ,I,NY,NX)) + IF(IHVST(NZ,I,NY,NX).EQ.0)THEN + FHVSH=AMAX1(0.0,1.0-EHVST(1,4,NZ,I,NY,NX)*THIN(NZ,I,NY,NX)) + ELSE + FHVSH=FHVST + ENDIF + ENDIF + ELSEIF(IHVST(NZ,I,NY,NX).EQ.4.OR.IHVST(NZ,I,NY,NX).EQ.6)THEN + IF(WTSTG(NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + WHVSTD=HVST(NZ,I,NY,NX)*THIN(NZ,I,NY,NX)*0.45/24.0 + 2*AREA(3,NU(NY,NX),NY,NX)*EHVST(1,4,NZ,I,NY,NX) + FHVST=AMAX1(0.0,1.0-WHVSTD/WTSTG(NZ,NY,NX)) + FHVSH=FHVST + ELSE + FHVST=1.0 + FHVSH=1.0 + ENDIF + ELSE + FHVST=1.0 + FHVSH=1.0 + ENDIF + DO 6475 M=1,4 + WTHTH4=WTHTH4+(1.0-FHVSH)*WTSTDG(M,NZ,NY,NX) + WTHNH4=WTHNH4+(1.0-FHVSH)*WTSTDN(M,NZ,NY,NX) + WTHPH4=WTHPH4+(1.0-FHVSH)*WTSTDP(M,NZ,NY,NX) + WTHTX4=WTHTX4+(FHVSH-FHVST)*WTSTDG(M,NZ,NY,NX) + WTHNX4=WTHNX4+(FHVSH-FHVST)*WTSTDN(M,NZ,NY,NX) + WTHPX4=WTHPX4+(FHVSH-FHVST)*WTSTDP(M,NZ,NY,NX) + WTSTDG(M,NZ,NY,NX)=FHVST*WTSTDG(M,NZ,NY,NX) + WTSTDN(M,NZ,NY,NX)=FHVST*WTSTDN(M,NZ,NY,NX) + WTSTDP(M,NZ,NY,NX)=FHVST*WTSTDP(M,NZ,NY,NX) +6475 CONTINUE +C +C IF NO PLANT C,N,P REMOVED AT HARVEST (ALL RESIDUE RETURNED) +C + IF(IHVST(NZ,I,NY,NX).EQ.0)THEN + WTHTR0=WTHTH0*(1.0-EHVST(2,1,NZ,I,NY,NX)) + WTHNR0=WTHNH0*(1.0-EHVST(2,1,NZ,I,NY,NX)) + WTHPR0=WTHPH0*(1.0-EHVST(2,1,NZ,I,NY,NX)) + WTHTR1=WTHTH1*(1.0-EHVST(2,1,NZ,I,NY,NX)) + WTHNR1=WTHNH1*(1.0-EHVST(2,1,NZ,I,NY,NX)) + WTHPR1=WTHPH1*(1.0-EHVST(2,1,NZ,I,NY,NX)) + WTHTR2=WTHTH2*(1.0-EHVST(2,2,NZ,I,NY,NX)) + WTHNR2=WTHNH2*(1.0-EHVST(2,2,NZ,I,NY,NX)) + WTHPR2=WTHPH2*(1.0-EHVST(2,2,NZ,I,NY,NX)) + WTHTR3=WTHTH3*(1.0-EHVST(2,3,NZ,I,NY,NX)) + WTHNR3=WTHNH3*(1.0-EHVST(2,3,NZ,I,NY,NX)) + WTHPR3=WTHPH3*(1.0-EHVST(2,3,NZ,I,NY,NX)) + WTHTR4=WTHTH4*(1.0-EHVST(2,4,NZ,I,NY,NX)) + WTHNR4=WTHNH4*(1.0-EHVST(2,4,NZ,I,NY,NX)) + WTHPR4=WTHPH4*(1.0-EHVST(2,4,NZ,I,NY,NX)) +C +C IF ONLY GRAIN C,N,P REMOVED AT HARVEST +C + ELSEIF(IHVST(NZ,I,NY,NX).EQ.1)THEN + WTHTR0=WTHTH0 + WTHNR0=WTHNH0 + WTHPR0=WTHPH0 + WTHTR1=WTHTH1 + WTHNR1=WTHNH1 + WTHPR1=WTHPH1 + WTHTR2=WTHTH2-WTHTG*EHVST(2,2,NZ,I,NY,NX) + WTHNR2=WTHNH2-WTHNG*EHVST(2,2,NZ,I,NY,NX) + WTHPR2=WTHPH2-WTHPG*EHVST(2,2,NZ,I,NY,NX) + WTHTR3=WTHTH3 + WTHNR3=WTHNH3 + WTHPR3=WTHPH3 + WTHTR4=WTHTH4 + WTHNR4=WTHNH4 + WTHPR4=WTHPH4 +C +C IF ONLY WOOD C,N,P REMOVED AT HARVEST +C + ELSEIF(IHVST(NZ,I,NY,NX).EQ.2)THEN + WTHTR0=WTHTH0*(1.0-EHVST(2,1,NZ,I,NY,NX)) + WTHNR0=WTHNH0*(1.0-EHVST(2,1,NZ,I,NY,NX)) + WTHPR0=WTHPH0*(1.0-EHVST(2,1,NZ,I,NY,NX)) + WTHTR1=WTHTH1*(1.0-EHVST(2,1,NZ,I,NY,NX)) + WTHNR1=WTHNH1*(1.0-EHVST(2,1,NZ,I,NY,NX)) + WTHPR1=WTHPH1*(1.0-EHVST(2,1,NZ,I,NY,NX)) + WTHTR2=WTHTH2*(1.0-EHVST(2,2,NZ,I,NY,NX)) + WTHNR2=WTHNH2*(1.0-EHVST(2,2,NZ,I,NY,NX)) + WTHPR2=WTHPH2*(1.0-EHVST(2,2,NZ,I,NY,NX)) + WTHTR3=WTHTH3*(1.0-EHVST(2,3,NZ,I,NY,NX)) + WTHNR3=WTHNH3*(1.0-EHVST(2,3,NZ,I,NY,NX)) + WTHPR3=WTHPH3*(1.0-EHVST(2,3,NZ,I,NY,NX)) + WTHTR4=WTHTH4*(1.0-EHVST(2,4,NZ,I,NY,NX)) + WTHNR4=WTHNH4*(1.0-EHVST(2,4,NZ,I,NY,NX)) + WTHPR4=WTHPH4*(1.0-EHVST(2,4,NZ,I,NY,NX)) +C +C IF ALL PLANT C,N,P REMOVED AT HARVEST (NO RESIDUE RETURNED) +C + ELSEIF(IHVST(NZ,I,NY,NX).EQ.3)THEN + WTHTR0=WTHTH0*(1.0-EHVST(2,1,NZ,I,NY,NX)) + WTHNR0=WTHNH0*(1.0-EHVST(2,1,NZ,I,NY,NX)) + WTHPR0=WTHPH0*(1.0-EHVST(2,1,NZ,I,NY,NX)) + WTHTR1=WTHTH1*(1.0-EHVST(2,1,NZ,I,NY,NX)) + WTHNR1=WTHNH1*(1.0-EHVST(2,1,NZ,I,NY,NX)) + WTHPR1=WTHPH1*(1.0-EHVST(2,1,NZ,I,NY,NX)) + WTHTR2=WTHTH2*(1.0-EHVST(2,2,NZ,I,NY,NX)) + WTHNR2=WTHNH2*(1.0-EHVST(2,2,NZ,I,NY,NX)) + WTHPR2=WTHPH2*(1.0-EHVST(2,2,NZ,I,NY,NX)) + WTHTR3=WTHTH3*(1.0-EHVST(2,3,NZ,I,NY,NX)) + WTHNR3=WTHNH3*(1.0-EHVST(2,3,NZ,I,NY,NX)) + WTHPR3=WTHPH3*(1.0-EHVST(2,3,NZ,I,NY,NX)) + WTHTR4=WTHTH4*(1.0-EHVST(2,4,NZ,I,NY,NX)) + WTHNR4=WTHNH4*(1.0-EHVST(2,4,NZ,I,NY,NX)) + WTHPR4=WTHPH4*(1.0-EHVST(2,4,NZ,I,NY,NX)) +C +C IF PLANT C,N,P REMOVED BY GRAZING +C + ELSEIF(IHVST(NZ,I,NY,NX).EQ.4.OR.IHVST(NZ,I,NY,NX).EQ.6)THEN + WTHTR0=WTHTH0*(1.0-EHVST(2,1,NZ,I,NY,NX)) + WTHNR0=WTHNH0*(1.0-EHVST(2,1,NZ,I,NY,NX)*0.5) + WTHPR0=WTHPH0*(1.0-EHVST(2,1,NZ,I,NY,NX)*0.5) + WTHTR1=WTHTH1*(1.0-EHVST(2,1,NZ,I,NY,NX)) + WTHNR1=WTHNH1*(1.0-EHVST(2,1,NZ,I,NY,NX)*0.5) + WTHPR1=WTHPH1*(1.0-EHVST(2,1,NZ,I,NY,NX)*0.5) + WTHTR2=WTHTH2*(1.0-EHVST(2,2,NZ,I,NY,NX)) + WTHNR2=WTHNH2*(1.0-EHVST(2,2,NZ,I,NY,NX)*0.5) + WTHPR2=WTHPH2*(1.0-EHVST(2,2,NZ,I,NY,NX)*0.5) + WTHTR3=WTHTH3*(1.0-EHVST(2,3,NZ,I,NY,NX)) + WTHNR3=WTHNH3*(1.0-EHVST(2,3,NZ,I,NY,NX)*0.5) + WTHPR3=WTHPH3*(1.0-EHVST(2,3,NZ,I,NY,NX)*0.5) + WTHTR4=WTHTH4*(1.0-EHVST(2,4,NZ,I,NY,NX)) + WTHNR4=WTHNH4*(1.0-EHVST(2,4,NZ,I,NY,NX)*0.5) + WTHPR4=WTHPH4*(1.0-EHVST(2,4,NZ,I,NY,NX)*0.5) +C +C ADD MANURE FROM GRAZING NEXT DAY +C + FERT(17,I+1,NY,NX)=FERT(17,I+1,NY,NX) + 2+(WTHTR1+WTHTR2+WTHTR3+WTHTR4)/AREA(3,NU(NY,NX),NY,NX) + FERT(18,I+1,NY,NX)=FERT(18,I+1,NY,NX) + 2+(WTHNR1+WTHNR2+WTHNR3+WTHNR4)/AREA(3,NU(NY,NX),NY,NX)*0.5 + FERT(3,I+1,NY,NX)=FERT(3,I+1,NY,NX) + 2+(WTHNR1+WTHNR2+WTHNR3+WTHNR4)/AREA(3,NU(NY,NX),NY,NX)*0.5 + FERT(19,I+1,NY,NX)=FERT(19,I+1,NY,NX) + 2+(WTHPR1+WTHPR2+WTHPR3+WTHPR4)/AREA(3,NU(NY,NX),NY,NX) + IYTYP(2,I+1,NY,NX)=3 +C IF(NX.EQ.2)THEN +C WRITE(*,6542)'MANURE',I,J,NX,NY,NZ,FERT(2,I+1,NY,NX) +C 2,WTHNR1,WTHNR2,WTHNR3,WTHNR4,WTHNH1,WTHNH2,WTHNH3 +C 3,WTHNH4 +6542 FORMAT(A8,5I4,20E12.4) +C ENDIF +C +C FIRE +C + ELSEIF(IHVST(NZ,I,NY,NX).EQ.5)THEN + WTHTR0=WTHTH0*(1.0-EHVST(2,1,NZ,I,NY,NX)) + WTHNR0=WTHNH0*(1.0-EFIRE(1,IHVST(NZ,I,NY,NX)) + 2*EHVST(2,1,NZ,I,NY,NX)) + WTHPR0=WTHPH0*(1.0-EFIRE(2,IHVST(NZ,I,NY,NX)) + 2*EHVST(2,1,NZ,I,NY,NX)) + WTHNL0=WTHNH0*(1.0-EHVST(2,1,NZ,I,NY,NX)) + WTHPL0=WTHPH0*(1.0-EHVST(2,1,NZ,I,NY,NX)) + WTHTR1=WTHTH1*(1.0-EHVST(2,1,NZ,I,NY,NX)) + WTHNR1=WTHNH1*(1.0-EFIRE(1,IHVST(NZ,I,NY,NX)) + 2*EHVST(2,1,NZ,I,NY,NX)) + WTHPR1=WTHPH1*(1.0-EFIRE(2,IHVST(NZ,I,NY,NX)) + 2*EHVST(2,1,NZ,I,NY,NX)) + WTHNL1=WTHNH1*(1.0-EHVST(2,1,NZ,I,NY,NX)) + WTHPL1=WTHPH1*(1.0-EHVST(2,1,NZ,I,NY,NX)) + WTHTR2=WTHTH2*(1.0-EHVST(2,2,NZ,I,NY,NX)) + WTHNR2=WTHNH2*(1.0-EFIRE(1,IHVST(NZ,I,NY,NX)) + 2*EHVST(2,2,NZ,I,NY,NX)) + WTHPR2=WTHPH2*(1.0-EFIRE(2,IHVST(NZ,I,NY,NX)) + 2*EHVST(2,2,NZ,I,NY,NX)) + WTHNL2=WTHNH2*(1.0-EHVST(2,2,NZ,I,NY,NX)) + WTHPL2=WTHPH2*(1.0-EHVST(2,2,NZ,I,NY,NX)) + WTHTR3=WTHTH3*(1.0-EHVST(2,3,NZ,I,NY,NX)) + WTHNR3=WTHNH3*(1.0-EFIRE(1,IHVST(NZ,I,NY,NX)) + 2*EHVST(2,3,NZ,I,NY,NX)) + WTHPR3=WTHPH3*(1.0-EFIRE(2,IHVST(NZ,I,NY,NX)) + 2*EHVST(2,3,NZ,I,NY,NX)) + WTHNL3=WTHNH3*(1.0-EHVST(2,3,NZ,I,NY,NX)) + WTHPL3=WTHPH3*(1.0-EHVST(2,3,NZ,I,NY,NX)) + WTHTR4=WTHTH4*(1.0-EHVST(2,4,NZ,I,NY,NX)) + WTHNR4=WTHNH4*(1.0-EFIRE(1,IHVST(NZ,I,NY,NX)) + 2*EHVST(2,4,NZ,I,NY,NX)) + WTHPR4=WTHPH4*(1.0-EFIRE(2,IHVST(NZ,I,NY,NX)) + 2*EHVST(2,4,NZ,I,NY,NX)) + WTHNL4=WTHNH4*(1.0-EHVST(2,4,NZ,I,NY,NX)) + WTHPL4=WTHPH4*(1.0-EHVST(2,4,NZ,I,NY,NX)) + ENDIF +C +C C,N,P REMOVED FROM HARVESTING +C + WTHTHT=WTHTH0+WTHTH1+WTHTH2+WTHTH3+WTHTH4 + WTHTRT=WTHTR0+WTHTR1+WTHTR2+WTHTR3+WTHTR4 + WTHNHT=WTHNH0+WTHNH1+WTHNH2+WTHNH3+WTHNH4 + WTHNRT=WTHNR0+WTHNR1+WTHNR2+WTHNR3+WTHNR4 + WTHPHT=WTHPH0+WTHPH1+WTHPH2+WTHPH3+WTHPH4 + WTHPRT=WTHPR0+WTHPR1+WTHPR2+WTHPR3+WTHPR4 + WTHTXT=WTHTX0+WTHTX1+WTHTX2+WTHTX3+WTHTX4 + WTHNXT=WTHNX0+WTHNX1+WTHNX2+WTHNX3+WTHNX4 + WTHPXT=WTHPX0+WTHPX1+WTHPX2+WTHPX3+WTHPX4 + IF(IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6)THEN + IF(IHVST(NZ,I,NY,NX).NE.5)THEN + IF(JHVST(NZ,I,NY,NX).NE.2)THEN + HVSTC(NZ,NY,NX)=HVSTC(NZ,NY,NX)+WTHTHT-WTHTRT + HVSTN(NZ,NY,NX)=HVSTN(NZ,NY,NX)+WTHNHT-WTHNRT + HVSTP(NZ,NY,NX)=HVSTP(NZ,NY,NX)+WTHPHT-WTHPRT + TNBP(NY,NX)=TNBP(NY,NX)+WTHTRT-WTHTHT + XHVSTC(NY,NX)=XHVSTC(NY,NX)+WTHTHT-WTHTRT + XHVSTN(NY,NX)=XHVSTN(NY,NX)+WTHNHT-WTHNRT + XHVSTP(NY,NX)=XHVSTP(NY,NX)+WTHPHT-WTHPRT + ELSE + WTRVC(NZ,NY,NX)=WTRVC(NZ,NY,NX)+WTHTHT-WTHTRT + WTRVN(NZ,NY,NX)=WTRVN(NZ,NY,NX)+WTHNHT-WTHNRT + WTRVP(NZ,NY,NX)=WTRVP(NZ,NY,NX)+WTHPHT-WTHPRT + ENDIF +C +C C,N,P LOST AS GAS IF FIRE +C + ELSE + VCO2F(NZ,NY,NX)=VCO2F(NZ,NY,NX)-(1.0-FCH4F)*(WTHTHT-WTHTRT) + VCH4F(NZ,NY,NX)=VCH4F(NZ,NY,NX)-FCH4F*(WTHTHT-WTHTRT) + VOXYF(NZ,NY,NX)=VOXYF(NZ,NY,NX)-(1.0-FCH4F)*(WTHTHT-WTHTRT)*2.667 + VNH3F(NZ,NY,NX)=VNH3F(NZ,NY,NX)-WTHNHT+WTHNRT + VN2OF(NZ,NY,NX)=VN2OF(NZ,NY,NX)-0.0 + VPO4F(NZ,NY,NX)=VPO4F(NZ,NY,NX)-WTHPHT+WTHPRT + CNET(NZ,NY,NX)=CNET(NZ,NY,NX)-(1.0-FCH4F)*(WTHTHT-WTHTRT) + TNBP(NY,NX)=TNBP(NY,NX)-FCH4F*(WTHTHT-WTHTRT) +C WRITE(*,5679)'FIRE2',I,J,NZ,VCO2F(NZ,NY,NX),FCH4F,WTHNH0,WTHNH1,WTHNH2 +C 3,WTHNH3,WTHNH4,WTHNR0,WTHNR1,WTHNR2,WTHNR3,WTHNR4,WTHNHT,WTHNRT +5679 FORMAT(A8,3I4,20E12.4) + ENDIF +C +C C,N,P REMOVED FROM GRAZING +C + ELSE + HVSTC(NZ,NY,NX)=HVSTC(NZ,NY,NX)+GY*(WTHTHT-WTHTRT) + TCO2T(NZ,NY,NX)=TCO2T(NZ,NY,NX)-GZ*(WTHTHT-WTHTRT) + TCO2A(NZ,NY,NX)=TCO2A(NZ,NY,NX)-GZ*(WTHTHT-WTHTRT) + HVSTN(NZ,NY,NX)=HVSTN(NZ,NY,NX)+WTHNHT-WTHNRT + HVSTP(NZ,NY,NX)=HVSTP(NZ,NY,NX)+WTHPHT-WTHPRT + TNBP(NY,NX)=TNBP(NY,NX)+GY*(WTHTRT-WTHTHT) + CNET(NZ,NY,NX)=CNET(NZ,NY,NX)+GZ*(WTHTRT-WTHTHT) + XHVSTC(NY,NX)=XHVSTC(NY,NX)+GY*(WTHTHT-WTHTRT) + XHVSTN(NY,NX)=XHVSTN(NY,NX)+WTHNHT-WTHNRT + XHVSTP(NY,NX)=XHVSTP(NY,NX)+WTHPHT-WTHPRT + RECO(NY,NX)=RECO(NY,NX)-GZ*(WTHTHT-WTHTRT) + TRAU(NY,NX)=TRAU(NY,NX)-GZ*(WTHTHT-WTHTRT) + ENDIF +C +C ABOVE-GROUND LITTERFALL FROM HARVESTING +C + IF(IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6)THEN + IF(IHVST(NZ,I,NY,NX).NE.5)THEN + DO 6375 M=1,4 + CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) + 2+CFOPC(0,M,NZ,NY,NX)*(WTHTR0+WTHTX0) + 3+CFOPC(1,M,NZ,NY,NX)*(WTHTR1+WTHTX1) + 4+CFOPC(2,M,NZ,NY,NX)*(WTHTR2+WTHTX2) + ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) + 2+CFOPN(0,M,NZ,NY,NX)*(WTHNR0+WTHNX0) + 3+CFOPN(1,M,NZ,NY,NX)*(WTHNR1+WTHNX1) + 4+CFOPN(2,M,NZ,NY,NX)*(WTHNR2+WTHNX2) + PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) + 2+CFOPP(0,M,NZ,NY,NX)*(WTHPR0+WTHPX0) + 3+CFOPP(1,M,NZ,NY,NX)*(WTHPR1+WTHPX1) + 4+CFOPP(2,M,NZ,NY,NX)*(WTHPR2+WTHPX2) + IF(IBTYP(NZ,NY,NX).EQ.0.OR.IGTYP(NZ,NY,NX).LE.1)THEN + CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) + 2+CFOPC(3,M,NZ,NY,NX)*(WTHTR3+WTHTX3+WTHTR4+WTHTX4) + ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) + 2+CFOPN(3,M,NZ,NY,NX)*(WTHNR3+WTHNX3+WTHNR4+WTHNX4) + PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) + 2+CFOPP(3,M,NZ,NY,NX)*(WTHPR3+WTHPX3+WTHPR4+WTHPX4) + ELSE + WTSTDG(M,NZ,NY,NX)=WTSTDG(M,NZ,NY,NX) + 2+CFOPC(5,M,NZ,NY,NX)*(WTHTX3+WTHTX4) + WTSTDN(M,NZ,NY,NX)=WTSTDN(M,NZ,NY,NX) + 2+CFOPN(5,M,NZ,NY,NX)*(WTHNX3+WTHNX4) + WTSTDP(M,NZ,NY,NX)=WTSTDP(M,NZ,NY,NX) + 2+CFOPP(5,M,NZ,NY,NX)*(WTHPX3+WTHPX4) + CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX) + 2+FRC*CFOPC(5,M,NZ,NY,NX)*(WTHTR3+WTHTR4) + ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX) + 2+FRC*CFOPN(5,M,NZ,NY,NX)*(WTHNR3+WTHNR4) + PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX) + 2+FRC*CFOPP(5,M,NZ,NY,NX)*(WTHPR3+WTHPR4) + CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) + 2+FRF*CFOPC(5,M,NZ,NY,NX)*(WTHTR3+WTHTR4) + ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) + 2+FRF*CFOPN(5,M,NZ,NY,NX)*(WTHNR3+WTHNR4) + PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) + 2+FRF*CFOPP(5,M,NZ,NY,NX)*(WTHPR3+WTHPR4) + ENDIF +6375 CONTINUE +C +C ABOVE-GROUND LITTERFALL FROM FIRE +C + ELSE + DO 6485 M=1,4 + CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) + 2+CFOPC(0,M,NZ,NY,NX)*(WTHTR0+WTHTX0) + 3+CFOPC(1,M,NZ,NY,NX)*(WTHTR1+WTHTX1) + 4+CFOPC(2,M,NZ,NY,NX)*(WTHTR2+WTHTX2) + ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) + 2+CFOPN(0,M,NZ,NY,NX)*WTHNL0 + 3+CFOPN(1,M,NZ,NY,NX)*WTHNL1 + 4+CFOPN(2,M,NZ,NY,NX)*WTHNL2 + PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) + 2+CFOPP(0,M,NZ,NY,NX)*WTHPL0 + 3+CFOPP(1,M,NZ,NY,NX)*WTHPL1 + 4+CFOPP(2,M,NZ,NY,NX)*WTHPL2 + ZSNC(4,1,0,NZ,NY,NX)=ZSNC(4,1,0,NZ,NY,NX) + 2+CFOPN(0,M,NZ,NY,NX)*(WTHNR0+WTHNX0-WTHNL0) + 3+CFOPN(1,M,NZ,NY,NX)*(WTHNR1+WTHNX1-WTHNL1) + 4+CFOPN(2,M,NZ,NY,NX)*(WTHNR2+WTHNX2-WTHNL2) + PSNC(4,1,0,NZ,NY,NX)=PSNC(4,1,0,NZ,NY,NX) + 2+CFOPP(0,M,NZ,NY,NX)*(WTHPR0+WTHPX0-WTHPL0) + 3+CFOPP(1,M,NZ,NY,NX)*(WTHPR1+WTHPX1-WTHPL1) + 4+CFOPP(2,M,NZ,NY,NX)*(WTHPR2+WTHPX2-WTHPL2) + IF(IBTYP(NZ,NY,NX).EQ.0.OR.IGTYP(NZ,NY,NX).LE.1)THEN + CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) + 2+CFOPC(3,M,NZ,NY,NX)*(WTHTR3+WTHTX3+WTHTR4+WTHTX4) + ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) + 2+CFOPN(3,M,NZ,NY,NX)*(WTHNL3+WTHNL4) + PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) + 2+CFOPP(3,M,NZ,NY,NX)*(WTHPL3+WTHPL4) + ZSNC(4,1,0,NZ,NY,NX)=ZSNC(4,1,0,NZ,NY,NX) + 2+CFOPN(3,M,NZ,NY,NX)*(WTHNR3+WTHNX3-WTHNL3+WTHNR4+WTHNX4-WTHNL4) + PSNC(4,1,0,NZ,NY,NX)=PSNC(4,1,0,NZ,NY,NX) + 2+CFOPP(3,M,NZ,NY,NX)*(WTHPR3+WTHPX3-WTHPL3+WTHPR4+WTHPX4-WTHPL4) + ELSE + WTSTDG(M,NZ,NY,NX)=WTSTDG(M,NZ,NY,NX) + 2+CFOPC(5,M,NZ,NY,NX)*(WTHTR3+WTHTX3) + WTSTDN(M,NZ,NY,NX)=WTSTDN(M,NZ,NY,NX) + 2+CFOPN(5,M,NZ,NY,NX)*WTHNL3 + WTSTDP(M,NZ,NY,NX)=WTSTDP(M,NZ,NY,NX) + 2+CFOPP(5,M,NZ,NY,NX)*WTHPL3 + CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX) + 2+FRC*CFOPC(3,M,NZ,NY,NX)*(WTHTR4+WTHTX4) + ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX) + 2+FRC*CFOPN(3,M,NZ,NY,NX)*WTHNL4 + PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX) + 2+FRC*CFOPP(3,M,NZ,NY,NX)*WTHPL4 + ZSNC(4,0,0,NZ,NY,NX)=ZSNC(4,0,0,NZ,NY,NX) + 2+FRC*CFOPN(5,M,NZ,NY,NX)*(WTHNR3+WTHNX3-WTHNL3 + 3+WTHNR4+WTHNX4-WTHNL4) + PSNC(4,0,0,NZ,NY,NX)=PSNC(4,0,0,NZ,NY,NX) + 2+FRC*CFOPP(5,M,NZ,NY,NX)*(WTHPR3+WTHPX3-WTHPL3 + 3+WTHPR4+WTHPX4-WTHPL4) + CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) + 2+FRF*CFOPC(3,M,NZ,NY,NX)*(WTHTR4+WTHTX4) + ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) + 2+FRF*CFOPN(3,M,NZ,NY,NX)*WTHNL4 + PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) + 2+FRF*CFOPP(3,M,NZ,NY,NX)*WTHPL4 + ZSNC(4,1,0,NZ,NY,NX)=ZSNC(4,1,0,NZ,NY,NX) + 2+FRF*CFOPN(5,M,NZ,NY,NX)*(WTHNR3+WTHNX3-WTHNL3 + 3+WTHNR4+WTHNX4-WTHNL4) + PSNC(4,1,0,NZ,NY,NX)=PSNC(4,1,0,NZ,NY,NX) + 2+FRF*CFOPP(5,M,NZ,NY,NX)*(WTHPR3+WTHPX3-WTHPL3 + 3+WTHPR4+WTHPX4-WTHPL4) + ENDIF +6485 CONTINUE + ENDIF + ELSE +C +C ABOVE-GROUND LITTERFALL FROM GRAZING +C + TCSNC(NZ,NY,NX)=TCSNC(NZ,NY,NX)+WTHTRT+WTHTXT + TZSNC(NZ,NY,NX)=TZSNC(NZ,NY,NX)+WTHNRT+WTHNXT + TPSNC(NZ,NY,NX)=TPSNC(NZ,NY,NX)+WTHPRT+WTHPXT + TCSN0(NZ,NY,NX)=TCSN0(NZ,NY,NX)+WTHTRT+WTHTXT + TZSN0(NZ,NY,NX)=TZSNC(NZ,NY,NX)+WTHNRT+WTHNXT + TPSN0(NZ,NY,NX)=TPSNC(NZ,NY,NX)+WTHPRT+WTHPXT + ENDIF + ZEROP(NZ,NY,NX)=ZERO*PP(NZ,NY,NX) + ZEROQ(NZ,NY,NX)=ZERO*PP(NZ,NY,NX)/AREA(3,NU(NY,NX),NY,NX) + ZEROL(NZ,NY,NX)=ZERO*PP(NZ,NY,NX)*1.0E+06 + ENDIF +9985 CONTINUE +C +C TRANSFORMATIONS IN LIVING OR DEAD PLANT POPULATIONS +C + DO 9975 NZ=1,NP0(NY,NX) +C +C ACTIVATE DORMANT SEEDS +C + DO 205 NB=1,NBR(NZ,NY,NX) + IF(IFLGI(NZ,NY,NX).EQ.1)THEN + IF(IFLGE(NB,NZ,NY,NX).EQ.0 + 2.AND.VRNS(NB,NZ,NY,NX).GE.VRNL(NB,NZ,NY,NX))THEN + IDAY0(NZ,NY,NX)=I + IYR0(NZ,NY,NX)=IYRC + SDPTHI(NZ,NY,NX)=0.005 + IFLGI(NZ,NY,NX)=0 + ENDIF + ENDIF +205 CONTINUE +C +C LITTERFALL FROM STANDING DEAD +C + DO 6235 M=1,4 + XFRC=1.5814E-05*TFN3(NZ,NY,NX)*WTSTDG(M,NZ,NY,NX) + XFRN=1.5814E-05*TFN3(NZ,NY,NX)*WTSTDN(M,NZ,NY,NX) + XFRP=1.5814E-05*TFN3(NZ,NY,NX)*WTSTDP(M,NZ,NY,NX) + IF(IBTYP(NZ,NY,NX).EQ.0.OR.IGTYP(NZ,NY,NX).LE.1)THEN + CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX)+XFRC + ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX)+XFRN + PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX)+XFRP + ELSE + CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX)+XFRC + ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX)+XFRN + PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX)+XFRP + ENDIF + WTSTDG(M,NZ,NY,NX)=WTSTDG(M,NZ,NY,NX)-XFRC + WTSTDN(M,NZ,NY,NX)=WTSTDN(M,NZ,NY,NX)-XFRN + WTSTDP(M,NZ,NY,NX)=WTSTDP(M,NZ,NY,NX)-XFRP +6235 CONTINUE +C +C ACCUMULATE TOTAL SURFACE, SUBSURFACE LITTERFALL +C + DO 6430 M=1,4 + DO 6430 K=0,1 + TCSN0(NZ,NY,NX)=TCSN0(NZ,NY,NX)+CSNC(M,K,0,NZ,NY,NX) + TZSN0(NZ,NY,NX)=TZSN0(NZ,NY,NX)+ZSNC(M,K,0,NZ,NY,NX) + TPSN0(NZ,NY,NX)=TPSN0(NZ,NY,NX)+PSNC(M,K,0,NZ,NY,NX) + DO 8955 L=0,NJ(NY,NX) + HCSNC(NZ,NY,NX)=HCSNC(NZ,NY,NX)+CSNC(M,K,L,NZ,NY,NX) + HZSNC(NZ,NY,NX)=HZSNC(NZ,NY,NX)+ZSNC(M,K,L,NZ,NY,NX) + HPSNC(NZ,NY,NX)=HPSNC(NZ,NY,NX)+PSNC(M,K,L,NZ,NY,NX) + TCSNC(NZ,NY,NX)=TCSNC(NZ,NY,NX)+CSNC(M,K,L,NZ,NY,NX) + TZSNC(NZ,NY,NX)=TZSNC(NZ,NY,NX)+ZSNC(M,K,L,NZ,NY,NX) + TPSNC(NZ,NY,NX)=TPSNC(NZ,NY,NX)+PSNC(M,K,L,NZ,NY,NX) +8955 CONTINUE +6430 CONTINUE +C +C TOTAL STANDING DEAD +C + WTSTG(NZ,NY,NX)=WTSTDG(1,NZ,NY,NX)+WTSTDG(2,NZ,NY,NX) + 4+WTSTDG(3,NZ,NY,NX)+WTSTDG(4,NZ,NY,NX) + WTSTGN(NZ,NY,NX)=WTSTDN(1,NZ,NY,NX)+WTSTDN(2,NZ,NY,NX) + 4+WTSTDN(3,NZ,NY,NX)+WTSTDN(4,NZ,NY,NX) + WTSTGP(NZ,NY,NX)=WTSTDP(1,NZ,NY,NX)+WTSTDP(2,NZ,NY,NX) + 4+WTSTDP(3,NZ,NY,NX)+WTSTDP(4,NZ,NY,NX) +C +C PLANT C BALANCE = TOTAL C STATE VARIABLES + TOTAL +C AUTOTROPHIC RESPIRATION + TOTAL LITTERFALL - TOTAL EXUDATION +C - TOTAL CO2 FIXATION +C + ZNPP(NZ,NY,NX)=CARBN(NZ,NY,NX)+TCO2T(NZ,NY,NX) + IF(IFLGC(NZ,NY,NX).EQ.1)THEN + BALC(NZ,NY,NX)=WTSHT(NZ,NY,NX)+WTRT(NZ,NY,NX)+WTND(NZ,NY,NX) + 2+WTRVC(NZ,NY,NX)-ZNPP(NZ,NY,NX)+TCSNC(NZ,NY,NX)-TCUPTK(NZ,NY,NX) + 3-RSETC(NZ,NY,NX)+WTSTG(NZ,NY,NX)+THVSTC(NZ,NY,NX) + 4+HVSTC(NZ,NY,NX)-VCO2F(NZ,NY,NX)-VCH4F(NZ,NY,NX) +C IF(NZ.EQ.1)THEN +C WRITE(*,1111)'BALC',I,J,NX,NY,NZ,BALC(NZ,NY,NX),WTSHT(NZ,NY,NX) +C 2,WTRT(NZ,NY,NX),WTND(NZ,NY,NX),WTRVC(NZ,NY,NX),TCO2T(NZ,NY,NX) +C 3,TCSNC(NZ,NY,NX),TCUPTK(NZ,NY,NX),CARBN(NZ,NY,NX) +C 2,RSETC(NZ,NY,NX),WTSTG(NZ,NY,NX),THVSTC(NZ,NY,NX) +C 3,HVSTC(NZ,NY,NX),CPOOLP(NZ,NY,NX) +C 3,WTLF(NZ,NY,NX),WTSHE(NZ,NY,NX),WTSTK(NZ,NY,NX),WTRSV(NZ,NY,NX) +C 3,WTHSK(NZ,NY,NX),WTEAR(NZ,NY,NX),WTGR(NZ,NY,NX) +C 5,VCO2F(NZ,NY,NX),VCH4F(NZ,NY,NX) +C 5,(WTLFB(NB,NZ,NY,NX),NB=1,5) +C 3,((CSNC(M,0,L,NZ,NY,NX),M=1,4),L=0,NL(NY,NX)) +C 4,((CPOOLR(N,L,NZ,NY,NX),L=1,NL(NY,NX)),N=1,2) +C 4,(CPOOLK(NB,NZ,NY,NX),NB=1,10) +1111 FORMAT(A8,5I4,200F18.6) +C ENDIF +C +C PLANT N BALANCE = TOTAL N STATE VARIABLES + TOTAL N LITTERFALL +C - TOTAL N UPTAKE FROM SOIL - TOTAL N ABSORPTION FROM ATMOSPHERE +C + BALN(NZ,NY,NX)=WTSHN(NZ,NY,NX)+WTRTN(NZ,NY,NX)+WTNDN(NZ,NY,NX) + 2+WTRVN(NZ,NY,NX)+TZSNC(NZ,NY,NX)-TZUPTK(NZ,NY,NX)-TNH3C(NZ,NY,NX) + 3-RSETN(NZ,NY,NX)+WTSTGN(NZ,NY,NX)+HVSTN(NZ,NY,NX)+THVSTN(NZ,NY,NX) + 4-VNH3F(NZ,NY,NX)-VN2OF(NZ,NY,NX)-TZUPFX(NZ,NY,NX) +C IF(NZ.EQ.1)THEN +C WRITE(*,1112)'BALN',I,J,NX,NY,NZ,BALN(NZ,NY,NX),WTSHN(NZ,NY,NX) +C 2,WTRTN(NZ,NY,NX),WTNDN(NZ,NY,NX),WTRVN(NZ,NY,NX),TZSNC(NZ,NY,NX) +C 3,TZUPTK(NZ,NY,NX),TNH3C(NZ,NY,NX),RSETN(NZ,NY,NX),HVSTN(NZ,NY,NX) +C 4,WTSTGN(NZ,NY,NX),WTLFN(NZ,NY,NX),WTSHEN(NZ,NY,NX) +C 5,WTSTKN(NZ,NY,NX),WTRSVN(NZ,NY,NX),WTHSKN(NZ,NY,NX) +C 3,WTEARN(NZ,NY,NX),WTGRNN(NZ,NY,NX),UPOMN(NZ,NY,NX),UPNH4(NZ,NY,NX) +C 2,UPNO3(NZ,NY,NX),VNH3F(NZ,NY,NX),VN2OF(NZ,NY,NX) +C 4,((RDFOMN(N,L,NZ,NY,NX),N=1,2),L=NU(NY,NX),NI(NZ,NY,NX)) +C 4,((ZPOOLR(N,L,NZ,NY,NX),N=1,2),L=NU(NY,NX),NI(NZ,NY,NX)) +1112 FORMAT(A8,5I4,200F18.6) +C ENDIF +C +C PLANT P BALANCE = TOTAL P STATE VARIABLES + TOTAL P LITTERFALL +C - TOTAL P UPTAKE FROM SOIL +C + BALP(NZ,NY,NX)=WTSHP(NZ,NY,NX)+WTRTP(NZ,NY,NX)+WTNDP(NZ,NY,NX) + 2+WTRVP(NZ,NY,NX)+TPSNC(NZ,NY,NX)-TPUPTK(NZ,NY,NX) + 3-RSETP(NZ,NY,NX)+WTSTDP(1,NZ,NY,NX)+WTSTGP(NZ,NY,NX) + 4+HVSTP(NZ,NY,NX)+THVSTP(NZ,NY,NX)-VPO4F(NZ,NY,NX) +C IF(NZ.EQ.4)THEN +C WRITE(*,1112)'BALP',I,J,NX,NY,NZ,BALP(NZ,NY,NX),WTSHP(NZ,NY,NX) +C 2,WTRTP(NZ,NY,NX),WTNDP(NZ,NY,NX),WTRVP(NZ,NY,NX),TPSNC(NZ,NY,NX) +C 3,TPUPTK(NZ,NY,NX),RSETP(NZ,NY,NX) +C 4,WTSTDP(1,NZ,NY,NX),WTSTGP(NZ,NY,NX),HVSTP(NZ,NY,NX) +C 5,THVSTP(NZ,NY,NX),VPO4F(NZ,NY,NX) +C ENDIF + ENDIF +9975 CONTINUE +9990 CONTINUE +9995 CONTINUE + RETURN + END diff --git a/f77src/hfunc.f b/f77src/hfunc.f index 8ce4cba..4584922 100755 --- a/f77src/hfunc.f +++ b/f77src/hfunc.f @@ -1,664 +1,670 @@ - - SUBROUTINE hfunc(I,J,NHW,NHE,NVN,NVS) -C -C THIS SUBROUTINE CALCULATES PLANT PHENOLOGY -C - include "parameters.h" - include "filec.h" - include "files.h" - include "blkc.h" - include "blk1cp.h" - include "blk1cr.h" - include "blk1g.h" - include "blk1n.h" - include "blk1p.h" - include "blk2a.h" - include "blk2b.h" - include "blk2c.h" - include "blk3.h" - include "blk8a.h" - include "blk8b.h" - include "blk9a.h" - include "blk9b.h" - include "blk9c.h" - include "blk11a.h" - include "blk11b.h" - include "blk12a.h" - include "blk12b.h" - include "blk16.h" - include "blk18a.h" - include "blk18b.h" - DIMENSION NBX(0:3),PSILY(0:2),FLG4Y(0:3) - 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 - PARAMETER (PSILM=0.1,PSILX=-0.2) - PARAMETER(GSTGG=2.00,GSTGR=0.667,FVRN=0.5,VRNE=3600.0) - DATA PSILY/-200.0,-2.0,-2.0/ - DATA FLG4Y/336.0,672.0,672.0,672.0/ - DATA NBX /5,1,1,1/ - DO 9995 NX=NHW,NHE - DO 9990 NY=NVN,NVS - DO 9985 NZ=1,NP(NY,NX) -C WRITE(*,4444)'IFLGC',I,NX,NY,NZ,DATAP(NZ,NY,NX),IFLGT(NY,NX) -C 2,IDAY0(NZ,NY,NX),IDAYH(NZ,NY,NX),IYRC,IYRH(NZ,NY,NX) -C 3,IDTH(NZ,NY,NX),IYR0(NZ,NY,NX),IFLGC(NZ,NY,NX) -4444 FORMAT(A8,4I8,A16,20I8) - IF(DATAP(NZ,NY,NX).NE.'NO')THEN - PPT(NY,NX)=PPT(NY,NX)+PP(NZ,NY,NX) -C -C SET CROP FLAG ACCORDING TO PLANTING, HARVEST DATES, DEATH, -C 1 = ALIVE, 0 = NOT ALIVE -C - IF(J.EQ.1)THEN - IF(IDAY0(NZ,NY,NX).LE.IDAYH(NZ,NY,NX) - 3.OR.IYR0(NZ,NY,NX).LT.IYRH(NZ,NY,NX))THEN - IF(I.GE.IDAY0(NZ,NY,NX).OR.IDATA(3).GT.IYR0(NZ,NY,NX))THEN - IF(I.GT.IDAYH(NZ,NY,NX).AND.IYRC.GE.IYRH(NZ,NY,NX) - 2.AND.IDTH(NZ,NY,NX).EQ.1)THEN - IFLGC(NZ,NY,NX)=0 - ELSE - IF(I.EQ.IDAY0(NZ,NY,NX).AND.IDATA(3).EQ.IYR0(NZ,NY,NX))THEN - IFLGC(NZ,NY,NX)=0 - IDTH(NZ,NY,NX)=0 - CALL STARTQ(NX,NX,NY,NY,NZ,NZ) - TNBP(NY,NX)=TNBP(NY,NX)+WTRVX(NZ,NY,NX) - ENDIF - IF(DATAP(NZ,NY,NX).NE.'NO'.AND.IDTH(NZ,NY,NX).EQ.0) - 2IFLGC(NZ,NY,NX)=1 - ENDIF - ELSE - IFLGC(NZ,NY,NX)=0 - ENDIF - ELSE - IF((I.LT.IDAY0(NZ,NY,NX).AND.I.GT.IDAYH(NZ,NY,NX) - 2.AND.IYRC.GE.IYRH(NZ,NY,NX).AND.IDTH(NZ,NY,NX).EQ.1) - 3.OR.(I.LT.IDAY0(NZ,NY,NX).AND.IYR0(NZ,NY,NX) - 4.GT.IYRH(NZ,NY,NX)))THEN - IFLGC(NZ,NY,NX)=0 - ELSE - IF(I.EQ.IDAY0(NZ,NY,NX).AND.IDATA(3).EQ.IYR0(NZ,NY,NX))THEN - IFLGC(NZ,NY,NX)=0 - IDTH(NZ,NY,NX)=0 - CALL STARTQ(NX,NX,NY,NY,NZ,NZ) - TNBP(NY,NX)=TNBP(NY,NX)+WTRVX(NZ,NY,NX) - ENDIF - IF(DATAP(NZ,NY,NX).NE.'NO'.AND.IDTH(NZ,NY,NX).EQ.0) - 2IFLGC(NZ,NY,NX)=1 - ENDIF - ENDIF - IFLGT(NY,NX)=IFLGT(NY,NX)+IFLGC(NZ,NY,NX) - ENDIF - IF(IFLGC(NZ,NY,NX).EQ.1)THEN - RCO2Z(NZ,NY,NX)=0.0 - ROXYZ(NZ,NY,NX)=0.0 - RCH4Z(NZ,NY,NX)=0.0 - RN2OZ(NZ,NY,NX)=0.0 - RNH3Z(NZ,NY,NX)=0.0 - RH2GZ(NZ,NY,NX)=0.0 - CPOOLP(NZ,NY,NX)=0.0 - ZPOOLP(NZ,NY,NX)=0.0 - PPOOLP(NZ,NY,NX)=0.0 - NI(NZ,NY,NX)=NIX(NZ,NY,NX) - NG(NZ,NY,NX)=MIN(NI(NZ,NY,NX),MAX(NG(NZ,NY,NX),NU(NY,NX))) - NB1(NZ,NY,NX)=1 - NBTX=1.0E+06 -C -C TOTAL PLANT NON-STRUCTURAL C, N, P -C - DO 140 NB=1,NBR(NZ,NY,NX) - IF(IDTHB(NB,NZ,NY,NX).EQ.0)THEN - CPOOLP(NZ,NY,NX)=CPOOLP(NZ,NY,NX)+CPOOL(NB,NZ,NY,NX) - ZPOOLP(NZ,NY,NX)=ZPOOLP(NZ,NY,NX)+ZPOOL(NB,NZ,NY,NX) - PPOOLP(NZ,NY,NX)=PPOOLP(NZ,NY,NX)+PPOOL(NB,NZ,NY,NX) - CPOLNP(NZ,NY,NX)=CPOLNP(NZ,NY,NX)+CPOLNB(NB,NZ,NY,NX) - ZPOLNP(NZ,NY,NX)=ZPOLNP(NZ,NY,NX)+ZPOLNB(NB,NZ,NY,NX) - PPOLNP(NZ,NY,NX)=PPOLNP(NZ,NY,NX)+PPOLNB(NB,NZ,NY,NX) - IF(NBTB(NB,NZ,NY,NX).LT.NBTX)THEN - NB1(NZ,NY,NX)=NB - NBTX=NBTB(NB,NZ,NY,NX) - ENDIF - ENDIF -140 CONTINUE -C -C NON-STRUCTURAL C, N, P CONCENTRATIONS IN ROOT -C - DO 180 N=1,MY(NZ,NY,NX) - DO 160 L=NU(NY,NX),NI(NZ,NY,NX) - IF(WTRTL(N,L,NZ,NY,NX).GT.ZEROL(NZ,NY,NX))THEN - CCPOLR(N,L,NZ,NY,NX)=AMAX1(0.0,CPOOLR(N,L,NZ,NY,NX) - 2/WTRTL(N,L,NZ,NY,NX)) - CZPOLR(N,L,NZ,NY,NX)=AMAX1(0.0,ZPOOLR(N,L,NZ,NY,NX) - 2/WTRTL(N,L,NZ,NY,NX)) - CPPOLR(N,L,NZ,NY,NX)=AMAX1(0.0,PPOOLR(N,L,NZ,NY,NX) - 2/WTRTL(N,L,NZ,NY,NX)) -C CCPOLR(N,L,NZ,NY,NX)=AMIN1(1.0,CCPOLR(N,L,NZ,NY,NX)) - ELSE - CCPOLR(N,L,NZ,NY,NX)=1.0 - CZPOLR(N,L,NZ,NY,NX)=1.0 - CPPOLR(N,L,NZ,NY,NX)=1.0 - ENDIF -160 CONTINUE -180 CONTINUE -C -C NON-STRUCTURAL C, N, P CONCENTRATIONS IN SHOOT -C - IF(WTLS(NZ,NY,NX).GT.ZEROL(NZ,NY,NX))THEN - CCPOLP(NZ,NY,NX)=AMAX1(0.0,AMIN1(1.0,CPOOLP(NZ,NY,NX) - 2/WTLS(NZ,NY,NX))) - CCPLNP(NZ,NY,NX)=AMAX1(0.0,AMIN1(1.0,CPOLNP(NZ,NY,NX) - 2/WTLS(NZ,NY,NX))) - CZPOLP(NZ,NY,NX)=AMAX1(0.0,AMIN1(1.0,ZPOOLP(NZ,NY,NX) - 2/WTLS(NZ,NY,NX))) - CPPOLP(NZ,NY,NX)=AMAX1(0.0,AMIN1(1.0,PPOOLP(NZ,NY,NX) - 2/WTLS(NZ,NY,NX))) - ELSE - CCPOLP(NZ,NY,NX)=1.0 - CCPLNP(NZ,NY,NX)=1.0 - CZPOLP(NZ,NY,NX)=1.0 - CPPOLP(NZ,NY,NX)=1.0 - ENDIF - DO 190 NB=1,NBR(NZ,NY,NX) - IF(WTLSB(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - CCPOLB(NB,NZ,NY,NX)=AMAX1(0.0,CPOOL(NB,NZ,NY,NX) - 2/WTLSB(NB,NZ,NY,NX)) - CZPOLB(NB,NZ,NY,NX)=AMAX1(0.0,ZPOOL(NB,NZ,NY,NX) - 2/WTLSB(NB,NZ,NY,NX)) - CPPOLB(NB,NZ,NY,NX)=AMAX1(0.0,PPOOL(NB,NZ,NY,NX) - 2/WTLSB(NB,NZ,NY,NX)) - ELSE - CCPOLB(NB,NZ,NY,NX)=1.0 - CZPOLB(NB,NZ,NY,NX)=1.0 - CPPOLB(NB,NZ,NY,NX)=1.0 - ENDIF -190 CONTINUE -C -C EMERGENCE DATE FROM COTYLEDON HEIGHT, LEAF AREA, ROOT DEPTH -C - IF(IDAY(1,NB1(NZ,NY,NX),NZ,NY,NX).EQ.0)THEN - ARLSP=ARLFP(NZ,NY,NX)+ARSTP(NZ,NY,NX) - IF((HTCTL(NZ,NY,NX).GT.SDPTH(NZ,NY,NX)) - 2.AND.(ARLSP.GT.ZEROL(NZ,NY,NX)) - 3.AND.(RTDP1(1,1,NZ,NY,NX).GT.SDPTH(NZ,NY,NX)+1.0E-06))THEN - IDAY(1,NB1(NZ,NY,NX),NZ,NY,NX)=I - VHCPC(NZ,NY,NX)=4.19*(WTSHT(NZ,NY,NX)*10.0E-06+VOLWC(NZ,NY,NX)) - ENDIF - ENDIF -C -C ADD BRANCH TO SHOOT IF PLANT GROWTH STAGE, SHOOT NON-STRUCTURAL C -C CONCENTRATION PERMIT -C -C WRITE(*,224)'HFUNC',I,J,IFLGI(NZ,NY,NX),PP(NZ,NY,NX) -C 2,TCG(NZ,NY,NX),PSIRG(1,NG(NZ,NY,NX),NZ,NY,NX) -C 3,PSILM,ISTYP(NZ,NY,NX),IDAY(2,NB1(NZ,NY,NX),NZ,NY,NX) -C 4,NBR(NZ,NY,NX),WTRVC(NZ,NY,NX),CCPOLP(NZ,NY,NX) -C 5,PB(NZ,NY,NX),IDTHB(NB,NZ,NY,NX),NB1(NZ,NY,NX) -C 6,PSTG(NB1(NZ,NY,NX),NZ,NY,NX),NBT(NZ,NY,NX) -C 7,NNOD(NZ,NY,NX),FNOD(NZ,NY,NX),XTLI(NZ,NY,NX) -224 FORMAT(A8,3I6,5E12.4,3I6,3E12.4,2I6,1E12.4,2I6,2E12.4) - IF(IFLGI(NZ,NY,NX).EQ.0)THEN - IF(J.EQ.1.AND.PP(NZ,NY,NX).GT.0.0)THEN - IF(PSIRG(1,NG(NZ,NY,NX),NZ,NY,NX).GT.PSILM)THEN - IF(ISTYP(NZ,NY,NX).NE.0 - 2.OR.IDAY(2,NB1(NZ,NY,NX),NZ,NY,NX).EQ.0)THEN - IF((NBR(NZ,NY,NX).EQ.0.AND.WTRVC(NZ,NY,NX).GT.0.0) - 2.OR.(CCPOLP(NZ,NY,NX).GT.PB(NZ,NY,NX) - 3.AND.PB(NZ,NY,NX).GT.0.0))THEN - DO 120 NB=1,10 - IF(IDTHB(NB,NZ,NY,NX).EQ.1)THEN - IF(NB.EQ.NB1(NZ,NY,NX) - 2.OR.PSTG(NB1(NZ,NY,NX),NZ,NY,NX).GT.NBT(NZ,NY,NX) - 2+NNOD(NZ,NY,NX)/FNOD(NZ,NY,NX)+XTLI(NZ,NY,NX))THEN - NBT(NZ,NY,NX)=NBT(NZ,NY,NX)+1 - NBR(NZ,NY,NX)=MIN(NBX(IBTYP(NZ,NY,NX)),MAX(NB,NBR(NZ,NY,NX))) - NBTB(NB,NZ,NY,NX)=NBT(NZ,NY,NX)-1 - IDTHP(NZ,NY,NX)=0 - IDTHB(NB,NZ,NY,NX)=0 - VRNS(NB,NZ,NY,NX)=VRNL(NB,NZ,NY,NX)+0.5 - IF(ISTYP(NZ,NY,NX).EQ.0)THEN - GROUP(NB,NZ,NY,NX)=AMAX1(0.0,GROUPI(NZ,NY,NX)-NBTB(NB,NZ,NY,NX)) - ELSE - GROUP(NB,NZ,NY,NX)=GROUPI(NZ,NY,NX) - ENDIF - GO TO 125 - ENDIF - ENDIF -120 CONTINUE -125 CONTINUE - ENDIF - ENDIF - ENDIF -C -C ADD AXIS TO ROOT IF PLANT GROWTH STAGE, ROOT NON-STRUCTURAL C -C CONCENTRATION PERMIT -C - IF(PSIRG(1,NG(NZ,NY,NX),NZ,NY,NX).GT.PSILM)THEN - IF(NRT(NZ,NY,NX).EQ.0.OR.PSTG(NB1(NZ,NY,NX),NZ,NY,NX) - 2.GT.NRT(NZ,NY,NX)/FNOD(NZ,NY,NX)+XTLI(NZ,NY,NX))THEN - IF((NRT(NZ,NY,NX).EQ.0.AND.WTRVC(NZ,NY,NX).GT.0.0) - 2.OR.(CCPOLP(NZ,NY,NX).GT.PR(NZ,NY,NX) - 3.AND.PR(NZ,NY,NX).GT.0.0))THEN - NRT(NZ,NY,NX)=MIN(10,NRT(NZ,NY,NX)+1) - IDTHR(NZ,NY,NX)=0 - ENDIF - ENDIF - ENDIF - ENDIF - ENDIF -C -C THE REST OF THE SUBROUTINE MODELS THE PHENOLOGY OF EACH BRANCH -C - IF(IDAY(1,NB1(NZ,NY,NX),NZ,NY,NX).NE.0 - 2.OR.IFLGI(NZ,NY,NX).EQ.1)THEN - DO 2010 NB=1,NBR(NZ,NY,NX) - IF(IDTHB(NB,NZ,NY,NX).EQ.0)THEN - IF(IDAY(1,NB,NZ,NY,NX).EQ.0)THEN - IDAY(1,NB,NZ,NY,NX)=I - ENDIF -C -C CALCULATE NODE INITIATION AND LEAF APPEARANCE RATES -C FROM TEMPERATURE FUNCTION CALCULATED IN 'UPTAKE' AND -C RATES AT 25C ENTERED IN 'READQ' EXCEPT WHEN DORMANT -C - IF(IWTYP(NZ,NY,NX).EQ.0 - 2.OR.VRNF(NB,NZ,NY,NX).LT.VRNX(NB,NZ,NY,NX))THEN - TKCO=TKG(NZ,NY,NX)+OFFST(NZ,NY,NX) - RTK=8.3143*TKCO - STK=710.0*TKCO - ACTV=1+EXP((197500-STK)/RTK)+EXP((STK-222500)/RTK) - TFNP=EXP(25.229-62500/RTK)/ACTV - RNI=AMAX1(0.0,TFNP*XRNI(NZ,NY,NX)) - RLA=AMAX1(0.0,TFNP*XRLA(NZ,NY,NX)) -C -C NODE INITIATION AND LEAF APPEARANCE RATES SLOWED BY LOW TURGOR -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 - RNI=RNI*WFNSP - RLA=RLA*WFNSP - ENDIF -C -C ACCUMULATE NODE INITIATION AND LEAF APPEARANCE RATES -C INTO TOTAL NUMBER OF NODES AND LEAVES -C - PSTG(NB,NZ,NY,NX)=PSTG(NB,NZ,NY,NX)+RNI - VSTG(NB,NZ,NY,NX)=VSTG(NB,NZ,NY,NX)+RLA -C -C USE TOTAL NUMBER OF NODES TO CALCULATE PROGRESSION THROUGH -C VEGETATIVE AND REPRODUCTIVE GROWTH STAGES. THIS PROGRESSION -C IS USED TO SET START AND END DATES FOR GROWTH STAGES BELOW -C - IF(IDAY(2,NB,NZ,NY,NX).NE.0)THEN - GSTGI(NB,NZ,NY,NX)=(PSTG(NB,NZ,NY,NX)-PSTGI(NB,NZ,NY,NX)) - 2/GROUPI(NZ,NY,NX) - DGSTGI(NB,NZ,NY,NX)=RNI/(GROUPI(NZ,NY,NX)*GSTGG) - TGSTGI(NB,NZ,NY,NX)=TGSTGI(NB,NZ,NY,NX)+DGSTGI(NB,NZ,NY,NX) - ENDIF - IF(IDAY(6,NB,NZ,NY,NX).NE.0)THEN - GSTGF(NB,NZ,NY,NX)=(PSTG(NB,NZ,NY,NX)-PSTGF(NB,NZ,NY,NX)) - 2/GROUPI(NZ,NY,NX) - DGSTGF(NB,NZ,NY,NX)=RNI/(GROUPI(NZ,NY,NX)*GSTGR) - TGSTGF(NB,NZ,NY,NX)=TGSTGF(NB,NZ,NY,NX)+DGSTGF(NB,NZ,NY,NX) - ENDIF - IFLGG(NB,NZ,NY,NX)=1 - ELSE - IFLGG(NB,NZ,NY,NX)=0 - ENDIF -C -C REPRODUCTIVE GROWTH STAGES ADVANCE WHEN THRESHOLD NUMBER -C OF NODES HAVE BEEN INITIATED. FIRST DETERMINE PHOTOPERIOD -C AND TEMPERATURE EFFECTS ON FINAL VEG NODE NUMBER FROM -C NUMBER OF INITIATED NODES -C - IF(IDAY(2,NB,NZ,NY,NX).EQ.0)THEN - IF(PSTG(NB,NZ,NY,NX).GT.GROUP(NB,NZ,NY,NX) - 2+PSTGI(NB,NZ,NY,NX).AND.VRNS(NB,NZ,NY,NX) - 2.GE.VRNL(NB,NZ,NY,NX))THEN -C -C FINAL VEGETATIVE NODE NUMBER DEPENDS ON PHOTOPERIOD FROM 'DAY' -C AND ON MATURITY GROUP, CRITICAL PHOTOPERIOD AND PHOTOPERIOD -C SENSITIVITY ENTERED IN 'READQ' -C - IF(IPTYP(NZ,NY,NX).EQ.0)THEN - PPD=0.0 - ELSE - PPD=AMAX1(0.0,XDL(NZ,NY,NX)-DYLN(NY,NX)) - IF(IPTYP(NZ,NY,NX).EQ.1.AND.DYLN(NY,NX).GE.DYLX(NY,NX))PPD=0.0 - ENDIF -C WRITE(*,333)'IDAY2',I,J,NZ,NB,IDAY(2,NB,NZ,NY,NX) -C 2,PPD,XDL(NZ,NY,NX),DYLN(NY,NX),DYLX(NY,NX),VRNS(NB,NZ,NY,NX) -C 3,VRNL(NB,NZ,NY,NX),PSTG(NB,NZ,NY,NX),GROUP(NB,NZ,NY,NX) -C 4,PSTGI(NB,NZ,NY,NX),XPPD(NZ,NY,NX) -333 FORMAT(A8,5I4,20E12.4) - IF(IPTYP(NZ,NY,NX).EQ.0 - 2.OR.(IPTYP(NZ,NY,NX).EQ.1.AND.PPD.GT.XPPD(NZ,NY,NX)) - 3.OR.(IPTYP(NZ,NY,NX).EQ.2.AND.PPD.LT.XPPD(NZ,NY,NX)) - 4.OR.((IWTYP(NZ,NY,NX).EQ.1.OR.IWTYP(NZ,NY,NX).EQ.3) - 5.AND.ISTYP(NZ,NY,NX).NE.0.AND.IPTYP(NZ,NY,NX).NE.1 - 6.AND.DYLN(NY,NX).LT.DYLX(NY,NX)))THEN - IF(IWTYP(NZ,NY,NX).EQ.0.OR.IPTYP(NZ,NY,NX).EQ.0 - 2.OR.(IPTYP(NZ,NY,NX).EQ.1.AND.DYLN(NY,NX).LE.DYLX(NY,NX)) - 3.OR.(IPTYP(NZ,NY,NX).EQ.2.AND.DYLN(NY,NX).GE.DYLX(NY,NX)) - 4.OR.((IWTYP(NZ,NY,NX).EQ.1.OR.IWTYP(NZ,NY,NX).EQ.3) - 5.AND.ISTYP(NZ,NY,NX).NE.0.AND.IPTYP(NZ,NY,NX).NE.1 - 6.AND.DYLN(NY,NX).LT.DYLX(NY,NX)))THEN - IDAY(2,NB,NZ,NY,NX)=I - PSTGI(NB,NZ,NY,NX)=PSTG(NB,NZ,NY,NX) - IF(ISTYP(NZ,NY,NX).EQ.0.AND.IDTYP(NZ,NY,NX).EQ.0)THEN - VSTGX(NB,NZ,NY,NX)=PSTG(NB,NZ,NY,NX) - ENDIF - ENDIF - ENDIF - ENDIF -C -C STEM ELONGATION -C - ELSEIF(IDAY(3,NB,NZ,NY,NX).EQ.0)THEN - IF(GSTGI(NB,NZ,NY,NX).GT.0.25*GSTGG - 2.OR.((IWTYP(NZ,NY,NX).EQ.1.OR.IWTYP(NZ,NY,NX).EQ.3) - 3.AND.ISTYP(NZ,NY,NX).NE.0.AND.IPTYP(NZ,NY,NX).NE.1 - 3.AND.DYLN(NY,NX).LT.DYLX(NY,NX).AND.IFLGE(NB,NZ,NY,NX).EQ.1 - 4.AND.VRNF(NB,NZ,NY,NX).GT.VRNX(NB,NZ,NY,NX)) - 5.OR.(IWTYP(NZ,NY,NX).EQ.2.AND.ISTYP(NZ,NY,NX).EQ.0) - 6.AND.IFLGE(NB,NZ,NY,NX).EQ.1 - 7.AND.VRNF(NB,NZ,NY,NX).GT.VRNX(NB,NZ,NY,NX))THEN - IDAY(3,NB,NZ,NY,NX)=I - ENDIF - ELSEIF(IDAY(4,NB,NZ,NY,NX).EQ.0)THEN - IF(GSTGI(NB,NZ,NY,NX).GT.0.50*GSTGG - 2.OR.((IWTYP(NZ,NY,NX).EQ.1.OR.IWTYP(NZ,NY,NX).EQ.3) - 3.AND.ISTYP(NZ,NY,NX).NE.0.AND.IPTYP(NZ,NY,NX).NE.1 - 3.AND.DYLN(NY,NX).LT.DYLX(NY,NX).AND.IFLGE(NB,NZ,NY,NX).EQ.1 - 4.AND.VRNF(NB,NZ,NY,NX).GT.VRNX(NB,NZ,NY,NX)) - 5.OR.(IWTYP(NZ,NY,NX).EQ.2.AND.ISTYP(NZ,NY,NX).EQ.0) - 6.AND.IFLGE(NB,NZ,NY,NX).EQ.1 - 7.AND.VRNF(NB,NZ,NY,NX).GT.VRNX(NB,NZ,NY,NX))THEN - IDAY(4,NB,NZ,NY,NX)=I - IF(ISTYP(NZ,NY,NX).EQ.0.AND.IDTYP(NZ,NY,NX).NE.0)THEN - VSTGX(NB,NZ,NY,NX)=PSTG(NB,NZ,NY,NX) - ENDIF - ENDIF - ELSEIF(IDAY(5,NB,NZ,NY,NX).EQ.0)THEN - IF(GSTGI(NB,NZ,NY,NX).GT.1.00*GSTGG - 2.OR.((IWTYP(NZ,NY,NX).EQ.1.OR.IWTYP(NZ,NY,NX).EQ.3) - 3.AND.ISTYP(NZ,NY,NX).NE.0.AND.IPTYP(NZ,NY,NX).NE.1 - 3.AND.DYLN(NY,NX).LT.DYLX(NY,NX).AND.IFLGE(NB,NZ,NY,NX).EQ.1 - 4.AND.VRNF(NB,NZ,NY,NX).GT.VRNX(NB,NZ,NY,NX)) - 5.OR.(IWTYP(NZ,NY,NX).EQ.2.AND.ISTYP(NZ,NY,NX).EQ.0) - 6.AND.IFLGE(NB,NZ,NY,NX).EQ.1 - 7.AND.VRNF(NB,NZ,NY,NX).GT.VRNX(NB,NZ,NY,NX))THEN - IDAY(5,NB,NZ,NY,NX)=I - ENDIF -C -C ANTHESIS OCCURS WHEN THE NUMBER OF LEAVES THAT HAVE APPEARED -C EQUALS THE NUMBER OF NODES INITIATED WHEN THE FINAL VEGETATIVE -C NODE NUMBER WAS SET ABOVE -C - ELSEIF(IDAY(6,NB,NZ,NY,NX).EQ.0)THEN - IF((ISTYP(NZ,NY,NX).EQ.0.AND.VSTG(NB,NZ,NY,NX) - 2.GT.PSTGI(NB,NZ,NY,NX)).OR.(ISTYP(NZ,NY,NX).NE.0 - 3.AND.IDAY(5,NB,NZ,NY,NX).NE.0) - 2.OR.((IWTYP(NZ,NY,NX).EQ.1.OR.IWTYP(NZ,NY,NX).EQ.3) - 3.AND.ISTYP(NZ,NY,NX).NE.0.AND.IPTYP(NZ,NY,NX).NE.1 - 3.AND.DYLN(NY,NX).LT.DYLX(NY,NX).AND.IFLGE(NB,NZ,NY,NX).EQ.1 - 4.AND.VRNF(NB,NZ,NY,NX).GT.VRNX(NB,NZ,NY,NX)) - 5.OR.(IWTYP(NZ,NY,NX).EQ.2.AND.ISTYP(NZ,NY,NX).EQ.0) - 6.AND.IFLGE(NB,NZ,NY,NX).EQ.1 - 7.AND.VRNF(NB,NZ,NY,NX).GT.VRNX(NB,NZ,NY,NX))THEN - IF(NB.EQ.NB1(NZ,NY,NX) - 2.OR.IDAY(6,NB1(NZ,NY,NX),NZ,NY,NX).NE.0)THEN - IDAY(6,NB,NZ,NY,NX)=I - PSTGF(NB,NZ,NY,NX)=PSTG(NB,NZ,NY,NX) - ENDIF - ENDIF -C -C START GRAIN FILL PERIOD -C - ELSEIF(IDAY(7,NB,NZ,NY,NX).EQ.0)THEN - IF(GSTGF(NB,NZ,NY,NX).GT.0.50*GSTGR - 2.OR.((IWTYP(NZ,NY,NX).EQ.1.OR.IWTYP(NZ,NY,NX).EQ.3) - 3.AND.ISTYP(NZ,NY,NX).NE.0.AND.IPTYP(NZ,NY,NX).NE.1 - 3.AND.DYLN(NY,NX).LT.DYLX(NY,NX).AND.IFLGE(NB,NZ,NY,NX).EQ.1 - 4.AND.VRNF(NB,NZ,NY,NX).GT.VRNX(NB,NZ,NY,NX)) - 5.OR.(IWTYP(NZ,NY,NX).EQ.2.AND.ISTYP(NZ,NY,NX).EQ.0) - 6.AND.IFLGE(NB,NZ,NY,NX).EQ.1 - 7.AND.VRNF(NB,NZ,NY,NX).GT.VRNX(NB,NZ,NY,NX))THEN - IDAY(7,NB,NZ,NY,NX)=I - IF(IWTYP(NZ,NY,NX).NE.0.AND.NB.EQ.NB1(NZ,NY,NX))THEN - DO 1500 NBB=1,NBR(NZ,NY,NX) - IF(NBB.NE.NB.AND.IDAY(5,NBB,NZ,NY,NX).EQ.0)THEN - IDAY(5,NBB,NZ,NY,NX)=I - PSTGF(NBB,NZ,NY,NX)=PSTG(NBB,NZ,NY,NX) - ENDIF -1500 CONTINUE - ENDIF - ENDIF -C -C END SEED NUMBER SET PERIOD -C - ELSEIF(IDAY(8,NB,NZ,NY,NX).EQ.0)THEN - IF(GSTGF(NB,NZ,NY,NX).GT.1.00*GSTGR)THEN - IDAY(8,NB,NZ,NY,NX)=I - IF(IWTYP(NZ,NY,NX).NE.0.AND.NB.EQ.NB1(NZ,NY,NX))THEN - DO 1495 NBB=1,NBR(NZ,NY,NX) - IF(NBB.NE.NB.AND.IDAY(6,NBB,NZ,NY,NX).EQ.0)THEN - IDAY(6,NBB,NZ,NY,NX)=I - ENDIF -1495 CONTINUE - ENDIF - ENDIF -C -C END SEED SIZE SET PERIOD -C - ELSEIF(IDAY(9,NB,NZ,NY,NX).EQ.0)THEN - IF(GSTGF(NB,NZ,NY,NX).GT.1.50*GSTGR)THEN - IDAY(9,NB,NZ,NY,NX)=I - ENDIF - ENDIF - ENDIF - KVSTGX=KVSTG(NB,NZ,NY,NX) - IF(VSTGX(NB,NZ,NY,NX).LE.1.0E-06)THEN - KVSTG(NB,NZ,NY,NX)=INT(VSTG(NB,NZ,NY,NX))+1 - ELSE - KVSTG(NB,NZ,NY,NX)=INT(AMIN1(VSTG(NB,NZ,NY,NX) - 2,VSTGX(NB,NZ,NY,NX)))+1 - ENDIF - KLEAF(NB,NZ,NY,NX)=MIN(24,KVSTG(NB,NZ,NY,NX)) - IF(KVSTG(NB,NZ,NY,NX).GT.KVSTGX)THEN - IFLGP(NB,NZ,NY,NX)=1 - ELSE - IFLGP(NB,NZ,NY,NX)=0 - ENDIF -C -C TERMINATE ANNUALS AFTER GRAIN FILL -C - IF(ISTYP(NZ,NY,NX).EQ.0.AND.IWTYP(NZ,NY,NX).NE.0 - 2.AND.FLG4(NB,NZ,NY,NX).GT.0.0)THEN - IF(FLG4(NB,NZ,NY,NX).GT.FLG4Y(IWTYP(NZ,NY,NX)))THEN - VRNF(NB,NZ,NY,NX)=VRNX(NB,NZ,NY,NX)+0.5 - ENDIF - ENDIF -C -C PHENOLOGY -C - IF(IDTHB(NB,NZ,NY,NX).EQ.0.OR.IFLGI(NZ,NY,NX).EQ.1)THEN - IF(DYLN(NY,NX).GE.DYLX(NY,NX))THEN - VRNY(NB,NZ,NY,NX)=VRNY(NB,NZ,NY,NX)+1.0 - VRNZ(NB,NZ,NY,NX)=0.0 - ELSE - VRNY(NB,NZ,NY,NX)=0.0 - VRNZ(NB,NZ,NY,NX)=VRNZ(NB,NZ,NY,NX)+1.0 - ENDIF -C -C CALCULATE EVERGREEN PHENOLOGY DURING LENGTHENING PHOTOPERIODS -C - IF(IWTYP(NZ,NY,NX).EQ.0.AND.ISTYP(NZ,NY,NX).NE.0)THEN - IF(DYLN(NY,NX).GE.DYLX(NY,NX))THEN - VRNS(NB,NZ,NY,NX)=VRNY(NB,NZ,NY,NX) - IF(VRNS(NB,NZ,NY,NX).GE.VRNL(NB,NZ,NY,NX).OR. - 2(ALAT(NY,NX).GT.0.0.AND.I.EQ.173) - 3.OR.(ALAT(NY,NX).LT.0.0.AND.I.EQ.355))THEN - VRNF(NB,NZ,NY,NX)=0.0 - IFLGF(NB,NZ,NY,NX)=0 - ENDIF - ENDIF -C -C CALCULATE EVERGREEN PHENOLOGY DURING SHORTENING PHOTOPERIODS -C - IF(DYLN(NY,NX).LT.DYLX(NY,NX))THEN - VRNF(NB,NZ,NY,NX)=VRNZ(NB,NZ,NY,NX) - IF(VRNF(NB,NZ,NY,NX).GE.VRNX(NB,NZ,NY,NX).OR. - 2(ALAT(NY,NX).GT.0.0.AND.I.EQ.355) - 3.OR.(ALAT(NY,NX).LT.0.0.AND.I.EQ.173))THEN - VRNS(NB,NZ,NY,NX)=0.0 - IFLGE(NB,NZ,NY,NX)=0 - ENDIF - ENDIF -C -C CALCULATE WINTER DECIDUOUS PHENOLOGY BY ACCUMULATING HOURS IN -C SPECIFIED TEMPERATURE RANGES DURING LENGTHENING PHOTOPERIODS -C - ELSEIF(IWTYP(NZ,NY,NX).EQ.1)THEN - IF((DYLN(NY,NX).GE.DYLX(NY,NX).OR.DYLN(NY,NX).GE.DYLM(NY,NX)-2.0) - 2.AND.IFLGE(NB,NZ,NY,NX).EQ.0)THEN - IF(TCG(NZ,NY,NX).GE.TCZ(NZ,NY,NX))THEN - VRNS(NB,NZ,NY,NX)=VRNS(NB,NZ,NY,NX)+1.0 - ENDIF - IF(VRNS(NB,NZ,NY,NX).LT.VRNL(NB,NZ,NY,NX))THEN - IF(TCG(NZ,NY,NX).LT.CTC(NZ,NY,NX))THEN - VRNS(NB,NZ,NY,NX)=AMAX1(0.0,VRNS(NB,NZ,NY,NX)-1.5) - ENDIF - ENDIF - IF(VRNS(NB,NZ,NY,NX).GE.VRNL(NB,NZ,NY,NX))THEN - VRNF(NB,NZ,NY,NX)=0.0 - IF(IDAY(2,NB,NZ,NY,NX).NE.0)IFLGF(NB,NZ,NY,NX)=0 - ENDIF - ENDIF - IF(IDAY(2,NB,NZ,NY,NX).NE.0)IFLGF(NB,NZ,NY,NX)=0 -C WRITE(*,4646)'VRNS',I,J,NZ,NB,VRNS(NB,NZ,NY,NX),TCG(NZ,NY,NX) -C 2,TCZ(NZ,NY,NX),PSILG(NZ,NY,NX),PSILM,CTC(NZ,NY,NX) -C 3,DYLN(NY,NX),DYLX(NY,NX),DYLM(NY,NX),VRNL(NB,NZ,NY,NX) -4646 FORMAT(A8,4I4,20E12.4) -C -C CALCULATE WINTER DECIDUOUS PHENOLOGY BY ACCUMULATING HOURS IN -C SPECIFIED TEMPERATURE RANGES DURING SHORTENING PHOTOPERIODS -C - IF((DYLN(NY,NX).LT.DYLX(NY,NX).OR.DYLN(NY,NX) - 2.LT.24.0-DYLM(NY,NX)+2.0).AND.IFLGF(NB,NZ,NY,NX).EQ.0)THEN - IF(TCG(NZ,NY,NX).LE.TCX(NZ,NY,NX))THEN - VRNF(NB,NZ,NY,NX)=VRNF(NB,NZ,NY,NX)+1.0 - ENDIF - IF(VRNF(NB,NZ,NY,NX).GE.VRNX(NB,NZ,NY,NX) - 2.AND.IFLGE(NB,NZ,NY,NX).EQ.1)THEN - VRNS(NB,NZ,NY,NX)=0.0 - IFLGE(NB,NZ,NY,NX)=0 - ENDIF - ENDIF -C -C CALCULATE DROUGHT DECIDUOUS PHENOLOGY BY ACCUMULATING HOURS IN -C SPECIFIED TURGOR RANGES IN DORMANT STATE -C - ELSEIF(IWTYP(NZ,NY,NX).EQ.2.OR.IWTYP(NZ,NY,NX).EQ.4 - 2.OR.IWTYP(NZ,NY,NX).EQ.5)THEN - IF(IFLGE(NB,NZ,NY,NX).EQ.0)THEN - IF(PSILT(NZ,NY,NX).GE.PSILX)THEN - VRNS(NB,NZ,NY,NX)=VRNS(NB,NZ,NY,NX)+1.0 - ENDIF - IF(VRNS(NB,NZ,NY,NX).LT.VRNL(NB,NZ,NY,NX))THEN - IF(PSILT(NZ,NY,NX).LT.PSILY(IGTYP(NZ,NY,NX)))THEN - VRNS(NB,NZ,NY,NX)=AMAX1(0.0,VRNS(NB,NZ,NY,NX)-12.0) - ENDIF - ENDIF - IF(VRNS(NB,NZ,NY,NX).GE.VRNL(NB,NZ,NY,NX))THEN - VRNF(NB,NZ,NY,NX)=0.0 - IF(IDAY(2,NB,NZ,NY,NX).NE.0)IFLGF(NB,NZ,NY,NX)=0 - ENDIF - ENDIF - IF(IDAY(2,NB,NZ,NY,NX).NE.0)IFLGF(NB,NZ,NY,NX)=0 -C -C CALCULATE DROUGHT DECIDUOUS PHENOLOGY BY ACCUMULATING HOURS IN -C SPECIFIED TURGOR RANGES IN DORMANT STATE -C - IF(IFLGE(NB,NZ,NY,NX).EQ.1 - 3.AND.IFLGF(NB,NZ,NY,NX).EQ.0)THEN - IF(PSILT(NZ,NY,NX).LT.PSILY(IGTYP(NZ,NY,NX)))THEN - VRNF(NB,NZ,NY,NX)=VRNF(NB,NZ,NY,NX)+1.0 - ENDIF - IF(IWTYP(NZ,NY,NX).EQ.4)THEN - IF(VRNZ(NB,NZ,NY,NX).GT.VRNE)THEN - VRNF(NB,NZ,NY,NX)=VRNZ(NB,NZ,NY,NX) - ENDIF - ELSEIF(IWTYP(NZ,NY,NX).EQ.5)THEN - IF(VRNY(NB,NZ,NY,NX).GT.VRNE)THEN - VRNF(NB,NZ,NY,NX)=VRNY(NB,NZ,NY,NX) - ENDIF - ENDIF - IF(VRNF(NB,NZ,NY,NX).GE.VRNX(NB,NZ,NY,NX) - 2.AND.IFLGE(NB,NZ,NY,NX).EQ.1)THEN - VRNS(NB,NZ,NY,NX)=0.0 - IFLGE(NB,NZ,NY,NX)=0 - ENDIF - ENDIF -C -C CALCULATE WINTER AND DROUGHT DECIDUOUS PHENOLOGY BY ACCUMULATING HOURS -C IN SPECIFIED TEMPERATURE RANGES DURING LENGTHENING PHOTOPERIODS -C - ELSEIF(IWTYP(NZ,NY,NX).EQ.3)THEN - IF((DYLN(NY,NX).GE.DYLX(NY,NX).OR.DYLN(NY,NX).GE.DYLM(NY,NX)-2.0) - 2.AND.IFLGE(NB,NZ,NY,NX).EQ.0)THEN - IF(TCG(NZ,NY,NX).GE.TCZ(NZ,NY,NX) - 2.AND.PSILG(NZ,NY,NX).GT.PSILM)THEN - VRNS(NB,NZ,NY,NX)=VRNS(NB,NZ,NY,NX)+1.0 - ENDIF - IF(VRNS(NB,NZ,NY,NX).LT.VRNL(NB,NZ,NY,NX))THEN - IF(TCG(NZ,NY,NX).LT.CTC(NZ,NY,NX) - 2.OR.PSILG(NZ,NY,NX).LT.PSILM)THEN - VRNS(NB,NZ,NY,NX)=AMAX1(0.0,VRNS(NB,NZ,NY,NX)-1.5) - ENDIF - ENDIF - IF(VRNS(NB,NZ,NY,NX).GE.VRNL(NB,NZ,NY,NX))THEN - VRNF(NB,NZ,NY,NX)=0.0 - IF(IDAY(2,NB,NZ,NY,NX).NE.0)IFLGF(NB,NZ,NY,NX)=0 - ENDIF - ENDIF - IF(IDAY(2,NB,NZ,NY,NX).NE.0)IFLGF(NB,NZ,NY,NX)=0 -C WRITE(*,4647)'VRNS',I,J,NZ,NB,VRNS(NB,NZ,NY,NX),TCG(NZ,NY,NX) -C 2,TCZ(NZ,NY,NX),PSILG(NZ,NY,NX),PSILM,CTC(NZ,NY,NX) -C 3,DYLN(NY,NX),DYLX(NY,NX),DYLM(NY,NX),VRNL(NB,NZ,NY,NX) -4647 FORMAT(A8,4I4,20E12.4) -C -C CALCULATE WINTER DECIDUOUS PHENOLOGY BY ACCUMULATING HOURS IN -C SPECIFIED TEMPERATURE RANGES DURING SHORTENING PHOTOPERIODS -C - IF((DYLN(NY,NX).LT.DYLX(NY,NX).OR.DYLN(NY,NX) - 2.LT.24.0-DYLM(NY,NX)+2.0).AND.IFLGF(NB,NZ,NY,NX).EQ.0)THEN - IF(TCG(NZ,NY,NX).LE.TCX(NZ,NY,NX) - 2.OR.PSILT(NZ,NY,NX).LT.PSILY(IGTYP(NZ,NY,NX)))THEN - VRNF(NB,NZ,NY,NX)=VRNF(NB,NZ,NY,NX)+1.0 - ENDIF - IF(VRNF(NB,NZ,NY,NX).GE.VRNX(NB,NZ,NY,NX) - 2.AND.IFLGE(NB,NZ,NY,NX).EQ.1)THEN - VRNS(NB,NZ,NY,NX)=0.0 - IFLGE(NB,NZ,NY,NX)=0 - ENDIF - ENDIF - ENDIF - ENDIF -2010 CONTINUE -C -C WATER STRESS INDICATOR -C - IF(PSILT(NZ,NY,NX).LT.PSILY(IGTYP(NZ,NY,NX)))THEN - WSTR(NZ,NY,NX)=WSTR(NZ,NY,NX)+1.0 - ENDIF - ENDIF - ENDIF - ENDIF -9985 CONTINUE -9990 CONTINUE -9995 CONTINUE - RETURN - END + + SUBROUTINE hfunc(I,J,NHW,NHE,NVN,NVS) +C +C THIS SUBROUTINE CALCULATES PLANT PHENOLOGY +C + include "parameters.h" + include "filec.h" + include "files.h" + include "blkc.h" + include "blk1cp.h" + include "blk1cr.h" + include "blk1g.h" + include "blk1n.h" + include "blk1p.h" + include "blk2a.h" + include "blk2b.h" + include "blk2c.h" + include "blk3.h" + include "blk8a.h" + include "blk8b.h" + include "blk9a.h" + include "blk9b.h" + include "blk9c.h" + include "blk11a.h" + include "blk11b.h" + include "blk12a.h" + include "blk12b.h" + include "blk16.h" + include "blk18a.h" + include "blk18b.h" + DIMENSION NBX(0:3),PSILY(0:2) + 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 + PARAMETER (PSILM=0.1,PSILX=-0.2) + PARAMETER(GSTGG=2.00,GSTGR=0.667,FVRN=0.5,VRNE=3600.0) + DATA PSILY/-200.0,-2.0,-2.0/ + DATA NBX /5,1,1,1/ + DO 9995 NX=NHW,NHE + DO 9990 NY=NVN,NVS + DO 9985 NZ=1,NP(NY,NX) +C WRITE(*,4444)'IFLGC',I,NX,NY,NZ,DATAP(NZ,NY,NX),IFLGT(NY,NX) +C 2,IDAY0(NZ,NY,NX),IDAYH(NZ,NY,NX),IYRC,IYRH(NZ,NY,NX) +C 3,IDTH(NZ,NY,NX),IYR0(NZ,NY,NX),IFLGC(NZ,NY,NX) +4444 FORMAT(A8,4I8,A16,20I8) + IF(DATAP(NZ,NY,NX).NE.'NO')THEN + PPT(NY,NX)=PPT(NY,NX)+PP(NZ,NY,NX) +C +C SET CROP FLAG ACCORDING TO PLANTING, HARVEST DATES, DEATH, +C 1 = ALIVE, 0 = NOT ALIVE +C + IF(J.EQ.1)THEN + IF(IDAY0(NZ,NY,NX).LE.IDAYH(NZ,NY,NX) + 3.OR.IYR0(NZ,NY,NX).LT.IYRH(NZ,NY,NX))THEN + IF(I.GE.IDAY0(NZ,NY,NX).OR.IDATA(3).GT.IYR0(NZ,NY,NX))THEN + IF(I.GT.IDAYH(NZ,NY,NX).AND.IYRC.GE.IYRH(NZ,NY,NX) + 2.AND.IDTH(NZ,NY,NX).EQ.1)THEN + IFLGC(NZ,NY,NX)=0 + ELSE + IF(I.EQ.IDAY0(NZ,NY,NX).AND.IDATA(3).EQ.IYR0(NZ,NY,NX))THEN + IFLGC(NZ,NY,NX)=0 + IDTH(NZ,NY,NX)=0 + CALL STARTQ(NX,NX,NY,NY,NZ,NZ) + TNBP(NY,NX)=TNBP(NY,NX)+WTRVX(NZ,NY,NX) + ENDIF + IF(DATAP(NZ,NY,NX).NE.'NO'.AND.IDTH(NZ,NY,NX).EQ.0) + 2IFLGC(NZ,NY,NX)=1 + ENDIF + ELSE + IFLGC(NZ,NY,NX)=0 + ENDIF + ELSE + IF((I.LT.IDAY0(NZ,NY,NX).AND.I.GT.IDAYH(NZ,NY,NX) + 2.AND.IYRC.GE.IYRH(NZ,NY,NX).AND.IDTH(NZ,NY,NX).EQ.1) + 3.OR.(I.LT.IDAY0(NZ,NY,NX).AND.IYR0(NZ,NY,NX) + 4.GT.IYRH(NZ,NY,NX)))THEN + IFLGC(NZ,NY,NX)=0 + ELSE + IF(I.EQ.IDAY0(NZ,NY,NX).AND.IDATA(3).EQ.IYR0(NZ,NY,NX))THEN + IFLGC(NZ,NY,NX)=0 + IDTH(NZ,NY,NX)=0 + CALL STARTQ(NX,NX,NY,NY,NZ,NZ) + TNBP(NY,NX)=TNBP(NY,NX)+WTRVX(NZ,NY,NX) + ENDIF + IF(DATAP(NZ,NY,NX).NE.'NO'.AND.IDTH(NZ,NY,NX).EQ.0) + 2IFLGC(NZ,NY,NX)=1 + ENDIF + ENDIF + IFLGT(NY,NX)=IFLGT(NY,NX)+IFLGC(NZ,NY,NX) + ENDIF + IF(IFLGC(NZ,NY,NX).EQ.1)THEN + RCO2Z(NZ,NY,NX)=0.0 + ROXYZ(NZ,NY,NX)=0.0 + RCH4Z(NZ,NY,NX)=0.0 + RN2OZ(NZ,NY,NX)=0.0 + RNH3Z(NZ,NY,NX)=0.0 + RH2GZ(NZ,NY,NX)=0.0 + CPOOLP(NZ,NY,NX)=0.0 + ZPOOLP(NZ,NY,NX)=0.0 + PPOOLP(NZ,NY,NX)=0.0 + NI(NZ,NY,NX)=NIX(NZ,NY,NX) + NG(NZ,NY,NX)=MIN(NI(NZ,NY,NX),MAX(NG(NZ,NY,NX),NU(NY,NX))) + NB1(NZ,NY,NX)=1 + NBTX=1.0E+06 +C +C TOTAL PLANT NON-STRUCTURAL C, N, P +C + DO 140 NB=1,NBR(NZ,NY,NX) + IF(IDTHB(NB,NZ,NY,NX).EQ.0)THEN + CPOOLP(NZ,NY,NX)=CPOOLP(NZ,NY,NX)+CPOOL(NB,NZ,NY,NX) + ZPOOLP(NZ,NY,NX)=ZPOOLP(NZ,NY,NX)+ZPOOL(NB,NZ,NY,NX) + PPOOLP(NZ,NY,NX)=PPOOLP(NZ,NY,NX)+PPOOL(NB,NZ,NY,NX) + CPOLNP(NZ,NY,NX)=CPOLNP(NZ,NY,NX)+CPOLNB(NB,NZ,NY,NX) + ZPOLNP(NZ,NY,NX)=ZPOLNP(NZ,NY,NX)+ZPOLNB(NB,NZ,NY,NX) + PPOLNP(NZ,NY,NX)=PPOLNP(NZ,NY,NX)+PPOLNB(NB,NZ,NY,NX) + IF(NBTB(NB,NZ,NY,NX).LT.NBTX)THEN + NB1(NZ,NY,NX)=NB + NBTX=NBTB(NB,NZ,NY,NX) + ENDIF + ENDIF +140 CONTINUE +C +C NON-STRUCTURAL C, N, P CONCENTRATIONS IN ROOT +C + DO 180 N=1,MY(NZ,NY,NX) + DO 160 L=NU(NY,NX),NI(NZ,NY,NX) + IF(WTRTL(N,L,NZ,NY,NX).GT.ZEROL(NZ,NY,NX))THEN + CCPOLR(N,L,NZ,NY,NX)=AMAX1(0.0,CPOOLR(N,L,NZ,NY,NX) + 2/WTRTL(N,L,NZ,NY,NX)) + CZPOLR(N,L,NZ,NY,NX)=AMAX1(0.0,ZPOOLR(N,L,NZ,NY,NX) + 2/WTRTL(N,L,NZ,NY,NX)) + CPPOLR(N,L,NZ,NY,NX)=AMAX1(0.0,PPOOLR(N,L,NZ,NY,NX) + 2/WTRTL(N,L,NZ,NY,NX)) +C CCPOLR(N,L,NZ,NY,NX)=AMIN1(1.0,CCPOLR(N,L,NZ,NY,NX)) + ELSE + CCPOLR(N,L,NZ,NY,NX)=1.0 + CZPOLR(N,L,NZ,NY,NX)=1.0 + CPPOLR(N,L,NZ,NY,NX)=1.0 + ENDIF +160 CONTINUE +180 CONTINUE +C +C NON-STRUCTURAL C, N, P CONCENTRATIONS IN SHOOT +C + IF(WTLS(NZ,NY,NX).GT.ZEROL(NZ,NY,NX))THEN + CCPOLP(NZ,NY,NX)=AMAX1(0.0,AMIN1(1.0,CPOOLP(NZ,NY,NX) + 2/WTLS(NZ,NY,NX))) + CCPLNP(NZ,NY,NX)=AMAX1(0.0,AMIN1(1.0,CPOLNP(NZ,NY,NX) + 2/WTLS(NZ,NY,NX))) + CZPOLP(NZ,NY,NX)=AMAX1(0.0,AMIN1(1.0,ZPOOLP(NZ,NY,NX) + 2/WTLS(NZ,NY,NX))) + CPPOLP(NZ,NY,NX)=AMAX1(0.0,AMIN1(1.0,PPOOLP(NZ,NY,NX) + 2/WTLS(NZ,NY,NX))) + ELSE + CCPOLP(NZ,NY,NX)=1.0 + CCPLNP(NZ,NY,NX)=1.0 + CZPOLP(NZ,NY,NX)=1.0 + CPPOLP(NZ,NY,NX)=1.0 + ENDIF + DO 190 NB=1,NBR(NZ,NY,NX) + IF(WTLSB(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + CCPOLB(NB,NZ,NY,NX)=AMAX1(0.0,CPOOL(NB,NZ,NY,NX) + 2/WTLSB(NB,NZ,NY,NX)) + CZPOLB(NB,NZ,NY,NX)=AMAX1(0.0,ZPOOL(NB,NZ,NY,NX) + 2/WTLSB(NB,NZ,NY,NX)) + CPPOLB(NB,NZ,NY,NX)=AMAX1(0.0,PPOOL(NB,NZ,NY,NX) + 2/WTLSB(NB,NZ,NY,NX)) + ELSE + CCPOLB(NB,NZ,NY,NX)=1.0 + CZPOLB(NB,NZ,NY,NX)=1.0 + CPPOLB(NB,NZ,NY,NX)=1.0 + ENDIF +190 CONTINUE +C +C EMERGENCE DATE FROM COTYLEDON HEIGHT, LEAF AREA, ROOT DEPTH +C + IF(IDAY(1,NB1(NZ,NY,NX),NZ,NY,NX).EQ.0)THEN + ARLSP=ARLFP(NZ,NY,NX)+ARSTP(NZ,NY,NX) + IF((HTCTL(NZ,NY,NX).GT.SDPTH(NZ,NY,NX)) + 2.AND.(ARLSP.GT.ZEROL(NZ,NY,NX)) + 3.AND.(RTDP1(1,1,NZ,NY,NX).GT.SDPTH(NZ,NY,NX)+1.0E-06))THEN + IDAY(1,NB1(NZ,NY,NX),NZ,NY,NX)=I + VHCPC(NZ,NY,NX)=4.19*(WTSHT(NZ,NY,NX)*10.0E-06+VOLWC(NZ,NY,NX)) + ENDIF + ENDIF +C +C ADD BRANCH TO SHOOT IF PLANT GROWTH STAGE, SHOOT NON-STRUCTURAL C +C CONCENTRATION PERMIT +C +C WRITE(*,224)'HFUNC',I,J,IFLGI(NZ,NY,NX),PP(NZ,NY,NX) +C 2,TCG(NZ,NY,NX),PSIRG(1,NG(NZ,NY,NX),NZ,NY,NX) +C 3,PSILM,ISTYP(NZ,NY,NX),IDAY(2,NB1(NZ,NY,NX),NZ,NY,NX) +C 4,NBR(NZ,NY,NX),WTRVC(NZ,NY,NX),CCPOLP(NZ,NY,NX) +C 5,PB(NZ,NY,NX),IDTHB(NB,NZ,NY,NX),NB1(NZ,NY,NX) +C 6,PSTG(NB1(NZ,NY,NX),NZ,NY,NX),NBT(NZ,NY,NX) +C 7,NNOD(NZ,NY,NX),FNOD(NZ,NY,NX),XTLI(NZ,NY,NX) +224 FORMAT(A8,3I6,5E12.4,3I6,3E12.4,2I6,1E12.4,2I6,2E12.4) + IF(IFLGI(NZ,NY,NX).EQ.0)THEN + IF(J.EQ.1.AND.PP(NZ,NY,NX).GT.0.0)THEN + IF(PSIRG(1,NG(NZ,NY,NX),NZ,NY,NX).GT.PSILM)THEN + IF(ISTYP(NZ,NY,NX).NE.0 + 2.OR.IDAY(2,NB1(NZ,NY,NX),NZ,NY,NX).EQ.0)THEN + IF((NBR(NZ,NY,NX).EQ.0.AND.WTRVC(NZ,NY,NX).GT.0.0) + 2.OR.(CCPOLP(NZ,NY,NX).GT.PB(NZ,NY,NX) + 3.AND.PB(NZ,NY,NX).GT.0.0))THEN + DO 120 NB=1,10 + IF(IDTHB(NB,NZ,NY,NX).EQ.1)THEN + IF(NB.EQ.NB1(NZ,NY,NX) + 2.OR.PSTG(NB1(NZ,NY,NX),NZ,NY,NX).GT.NBT(NZ,NY,NX) + 2+NNOD(NZ,NY,NX)/FNOD(NZ,NY,NX)+XTLI(NZ,NY,NX))THEN + NBT(NZ,NY,NX)=NBT(NZ,NY,NX)+1 + NBR(NZ,NY,NX)=MIN(NBX(IBTYP(NZ,NY,NX)),MAX(NB,NBR(NZ,NY,NX))) + NBTB(NB,NZ,NY,NX)=NBT(NZ,NY,NX)-1 + IDTHP(NZ,NY,NX)=0 + IDTHB(NB,NZ,NY,NX)=0 + VRNS(NB,NZ,NY,NX)=0.0 + IF(ISTYP(NZ,NY,NX).EQ.0)THEN + GROUP(NB,NZ,NY,NX)=AMAX1(0.0,GROUPI(NZ,NY,NX)-NBTB(NB,NZ,NY,NX)) + ELSE + GROUP(NB,NZ,NY,NX)=GROUPI(NZ,NY,NX) + ENDIF + GO TO 125 + ENDIF + ENDIF +120 CONTINUE +125 CONTINUE + ENDIF + ENDIF + ENDIF +C +C ADD AXIS TO ROOT IF PLANT GROWTH STAGE, ROOT NON-STRUCTURAL C +C CONCENTRATION PERMIT +C + IF(PSIRG(1,NG(NZ,NY,NX),NZ,NY,NX).GT.PSILM)THEN + IF(NRT(NZ,NY,NX).EQ.0.OR.PSTG(NB1(NZ,NY,NX),NZ,NY,NX) + 2.GT.NRT(NZ,NY,NX)/FNOD(NZ,NY,NX)+XTLI(NZ,NY,NX))THEN + IF((NRT(NZ,NY,NX).EQ.0.AND.WTRVC(NZ,NY,NX).GT.0.0) + 2.OR.(CCPOLP(NZ,NY,NX).GT.PR(NZ,NY,NX) + 3.AND.PR(NZ,NY,NX).GT.0.0))THEN + NRT(NZ,NY,NX)=MIN(10,NRT(NZ,NY,NX)+1) + IDTHR(NZ,NY,NX)=0 + ENDIF + ENDIF + ENDIF + ENDIF + ENDIF +2224 FORMAT(A8,6I4) +C +C THE REST OF THE SUBROUTINE MODELS THE PHENOLOGY OF EACH BRANCH +C + IF(IDAY(1,NB1(NZ,NY,NX),NZ,NY,NX).NE.0 + 2.OR.IFLGI(NZ,NY,NX).EQ.1)THEN + DO 2010 NB=1,NBR(NZ,NY,NX) + IF(IDTHB(NB,NZ,NY,NX).EQ.0)THEN + IF(IDAY(1,NB,NZ,NY,NX).EQ.0)THEN + IDAY(1,NB,NZ,NY,NX)=I + IFLGA(NB,NZ,NY,NX)=1 + IFLGE(NB,NZ,NY,NX)=0 + VRNS(NB,NZ,NY,NX)=0.5*VRNS(NB1(NZ,NY,NX),NZ,NY,NX) + ENDIF +C +C CALCULATE NODE INITIATION AND LEAF APPEARANCE RATES +C FROM TEMPERATURE FUNCTION CALCULATED IN 'UPTAKE' AND +C RATES AT 25C ENTERED IN 'READQ' EXCEPT WHEN DORMANT +C + IF(IWTYP(NZ,NY,NX).EQ.0 + 2.OR.VRNF(NB,NZ,NY,NX).LT.VRNX(NB,NZ,NY,NX))THEN + TKCO=TKG(NZ,NY,NX)+OFFST(NZ,NY,NX) + RTK=8.3143*TKCO + STK=710.0*TKCO + ACTV=1+EXP((197500-STK)/RTK)+EXP((STK-222500)/RTK) + TFNP=EXP(25.229-62500/RTK)/ACTV + RNI=AMAX1(0.0,TFNP*XRNI(NZ,NY,NX)) + RLA=AMAX1(0.0,TFNP*XRLA(NZ,NY,NX)) +C +C NODE INITIATION AND LEAF APPEARANCE RATES SLOWED BY LOW TURGOR +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 + RNI=RNI*WFNSP + RLA=RLA*WFNSP + ENDIF +C +C ACCUMULATE NODE INITIATION AND LEAF APPEARANCE RATES +C INTO TOTAL NUMBER OF NODES AND LEAVES +C + PSTG(NB,NZ,NY,NX)=PSTG(NB,NZ,NY,NX)+RNI + VSTG(NB,NZ,NY,NX)=VSTG(NB,NZ,NY,NX)+RLA +C +C USE TOTAL NUMBER OF NODES TO CALCULATE PROGRESSION THROUGH +C VEGETATIVE AND REPRODUCTIVE GROWTH STAGES. THIS PROGRESSION +C IS USED TO SET START AND END DATES FOR GROWTH STAGES BELOW +C + IF(IDAY(2,NB,NZ,NY,NX).NE.0)THEN + GSTGI(NB,NZ,NY,NX)=(PSTG(NB,NZ,NY,NX)-PSTGI(NB,NZ,NY,NX)) + 2/GROUPI(NZ,NY,NX) + DGSTGI(NB,NZ,NY,NX)=RNI/(GROUPI(NZ,NY,NX)*GSTGG) + TGSTGI(NB,NZ,NY,NX)=TGSTGI(NB,NZ,NY,NX)+DGSTGI(NB,NZ,NY,NX) + ENDIF + IF(IDAY(6,NB,NZ,NY,NX).NE.0)THEN + GSTGF(NB,NZ,NY,NX)=(PSTG(NB,NZ,NY,NX)-PSTGF(NB,NZ,NY,NX)) + 2/GROUPI(NZ,NY,NX) + DGSTGF(NB,NZ,NY,NX)=RNI/(GROUPI(NZ,NY,NX)*GSTGR) + TGSTGF(NB,NZ,NY,NX)=TGSTGF(NB,NZ,NY,NX)+DGSTGF(NB,NZ,NY,NX) + ENDIF + IFLGG(NB,NZ,NY,NX)=1 + ELSE + IFLGG(NB,NZ,NY,NX)=0 + ENDIF +C +C REPRODUCTIVE GROWTH STAGES ADVANCE WHEN THRESHOLD NUMBER +C OF NODES HAVE BEEN INITIATED. FIRST DETERMINE PHOTOPERIOD +C AND TEMPERATURE EFFECTS ON FINAL VEG NODE NUMBER FROM +C NUMBER OF INITIATED NODES +C + IF(IDAY(2,NB,NZ,NY,NX).EQ.0)THEN + IF(PSTG(NB,NZ,NY,NX).GT.GROUP(NB,NZ,NY,NX)+PSTGI(NB,NZ,NY,NX) + 2.AND.((VRNS(NB,NZ,NY,NX).GE.VRNL(NB,NZ,NY,NX)) + 2.OR.(I.GE.IDAY0(NZ,NY,NX).AND.IYRC.EQ.IYR0(NZ,NY,NX) + 2.AND.DYLN(NY,NX).GT.DYLX(NY,NX))) + 3.OR.(((ISTYP(NZ,NY,NX).EQ.1.AND.(IWTYP(NZ,NY,NX).EQ.1 + 4.OR.IWTYP(NZ,NY,NX).EQ.3)) + 5.OR.(ISTYP(NZ,NY,NX).EQ.0.AND.IWTYP(NZ,NY,NX).EQ.0)) + 6.AND.ZC(NZ,NY,NX).GT.DPTHS(NY,NX) + 7.AND.DYLN(NY,NX).LT.DYLX(NY,NX)))THEN +C +C FINAL VEGETATIVE NODE NUMBER DEPENDS ON PHOTOPERIOD FROM 'DAY' +C AND ON MATURITY GROUP, CRITICAL PHOTOPERIOD AND PHOTOPERIOD +C SENSITIVITY ENTERED IN 'READQ' +C + IF(IPTYP(NZ,NY,NX).EQ.0)THEN + PPD=0.0 + ELSE + PPD=AMAX1(0.0,XDL(NZ,NY,NX)-DYLN(NY,NX)) + IF(IPTYP(NZ,NY,NX).EQ.1.AND.DYLN(NY,NX).GE.DYLX(NY,NX))PPD=0.0 + ENDIF +C IF(NZ.EQ.1)THEN +C WRITE(*,333)'IDAY2',I,J,NZ,NB,IDAY(2,NB,NZ,NY,NX),IDAY0(NZ,NY,NX) +C 2,IYR0(NZ,NY,NX),IPTYP(NZ,NY,NX) +C 2,PPD,XDL(NZ,NY,NX),DYLN(NY,NX),DYLX(NY,NX),VRNS(NB,NZ,NY,NX) +C 3,VRNL(NB,NZ,NY,NX),PSTG(NB,NZ,NY,NX),GROUP(NB,NZ,NY,NX) +C 4,PSTGI(NB,NZ,NY,NX),XPPD(NZ,NY,NX) +333 FORMAT(A8,8I4,20E12.4) +C ENDIF + IF(IPTYP(NZ,NY,NX).EQ.0 + 2.OR.(IPTYP(NZ,NY,NX).EQ.1.AND.PPD.GT.XPPD(NZ,NY,NX)) + 3.OR.(IPTYP(NZ,NY,NX).EQ.2.AND.PPD.LT.XPPD(NZ,NY,NX)) + 3.OR.(((ISTYP(NZ,NY,NX).EQ.1.AND.(IWTYP(NZ,NY,NX).EQ.1 + 4.OR.IWTYP(NZ,NY,NX).EQ.3)) + 5.OR.(ISTYP(NZ,NY,NX).EQ.0.AND.IWTYP(NZ,NY,NX).EQ.0)) + 6.AND.ZC(NZ,NY,NX).GT.DPTHS(NY,NX) + 7.AND.DYLN(NY,NX).LT.DYLX(NY,NX)))THEN + IDAY(2,NB,NZ,NY,NX)=I + PSTGI(NB,NZ,NY,NX)=PSTG(NB,NZ,NY,NX) + IF(ISTYP(NZ,NY,NX).EQ.0.AND.IDTYP(NZ,NY,NX).EQ.0)THEN + VSTGX(NB,NZ,NY,NX)=PSTG(NB,NZ,NY,NX) + ENDIF + ENDIF + ENDIF +C +C STEM ELONGATION +C + ELSEIF(IDAY(3,NB,NZ,NY,NX).EQ.0)THEN + IF(GSTGI(NB,NZ,NY,NX).GT.0.25*GSTGG + 2.OR.((IWTYP(NZ,NY,NX).EQ.1.OR.IWTYP(NZ,NY,NX).EQ.3) + 3.AND.ISTYP(NZ,NY,NX).NE.0.AND.IPTYP(NZ,NY,NX).NE.1 + 3.AND.DYLN(NY,NX).LT.DYLX(NY,NX).AND.IFLGE(NB,NZ,NY,NX).EQ.1 + 4.AND.VRNF(NB,NZ,NY,NX).GT.VRNX(NB,NZ,NY,NX)) + 5.OR.(IWTYP(NZ,NY,NX).EQ.2.AND.ISTYP(NZ,NY,NX).EQ.0) + 6.AND.IFLGE(NB,NZ,NY,NX).EQ.1 + 7.AND.VRNF(NB,NZ,NY,NX).GT.VRNX(NB,NZ,NY,NX))THEN + IDAY(3,NB,NZ,NY,NX)=I + ENDIF + ELSEIF(IDAY(4,NB,NZ,NY,NX).EQ.0)THEN + IF(GSTGI(NB,NZ,NY,NX).GT.0.50*GSTGG + 2.OR.((IWTYP(NZ,NY,NX).EQ.1.OR.IWTYP(NZ,NY,NX).EQ.3) + 3.AND.ISTYP(NZ,NY,NX).NE.0.AND.IPTYP(NZ,NY,NX).NE.1 + 3.AND.DYLN(NY,NX).LT.DYLX(NY,NX).AND.IFLGE(NB,NZ,NY,NX).EQ.1 + 4.AND.VRNF(NB,NZ,NY,NX).GT.VRNX(NB,NZ,NY,NX)) + 5.OR.(IWTYP(NZ,NY,NX).EQ.2.AND.ISTYP(NZ,NY,NX).EQ.0) + 6.AND.IFLGE(NB,NZ,NY,NX).EQ.1 + 7.AND.VRNF(NB,NZ,NY,NX).GT.VRNX(NB,NZ,NY,NX))THEN + IDAY(4,NB,NZ,NY,NX)=I + IF(ISTYP(NZ,NY,NX).EQ.0.AND.IDTYP(NZ,NY,NX).NE.0)THEN + VSTGX(NB,NZ,NY,NX)=PSTG(NB,NZ,NY,NX) + ENDIF + ENDIF + ELSEIF(IDAY(5,NB,NZ,NY,NX).EQ.0)THEN + IF(GSTGI(NB,NZ,NY,NX).GT.1.00*GSTGG + 2.OR.((IWTYP(NZ,NY,NX).EQ.1.OR.IWTYP(NZ,NY,NX).EQ.3) + 3.AND.ISTYP(NZ,NY,NX).NE.0.AND.IPTYP(NZ,NY,NX).NE.1 + 3.AND.DYLN(NY,NX).LT.DYLX(NY,NX).AND.IFLGE(NB,NZ,NY,NX).EQ.1 + 4.AND.VRNF(NB,NZ,NY,NX).GT.VRNX(NB,NZ,NY,NX)) + 5.OR.(IWTYP(NZ,NY,NX).EQ.2.AND.ISTYP(NZ,NY,NX).EQ.0) + 6.AND.IFLGE(NB,NZ,NY,NX).EQ.1 + 7.AND.VRNF(NB,NZ,NY,NX).GT.VRNX(NB,NZ,NY,NX))THEN + IDAY(5,NB,NZ,NY,NX)=I + ENDIF +C +C ANTHESIS OCCURS WHEN THE NUMBER OF LEAVES THAT HAVE APPEARED +C EQUALS THE NUMBER OF NODES INITIATED WHEN THE FINAL VEGETATIVE +C NODE NUMBER WAS SET ABOVE +C + ELSEIF(IDAY(6,NB,NZ,NY,NX).EQ.0)THEN + IF((VSTG(NB,NZ,NY,NX).GT.PSTGI(NB,NZ,NY,NX)) + 2.OR.(ISTYP(NZ,NY,NX).NE.0.AND.IDAY(5,NB,NZ,NY,NX).NE.0) + 2.OR.((IWTYP(NZ,NY,NX).EQ.1.OR.IWTYP(NZ,NY,NX).EQ.3) + 3.AND.ISTYP(NZ,NY,NX).NE.0.AND.IPTYP(NZ,NY,NX).NE.1 + 3.AND.DYLN(NY,NX).LT.DYLX(NY,NX).AND.IFLGE(NB,NZ,NY,NX).EQ.1 + 4.AND.VRNF(NB,NZ,NY,NX).GT.VRNX(NB,NZ,NY,NX)) + 5.OR.(IWTYP(NZ,NY,NX).EQ.2.AND.ISTYP(NZ,NY,NX).EQ.0) + 6.AND.IFLGE(NB,NZ,NY,NX).EQ.1 + 7.AND.VRNF(NB,NZ,NY,NX).GT.VRNX(NB,NZ,NY,NX))THEN + IF(NB.EQ.NB1(NZ,NY,NX) + 2.OR.IDAY(6,NB1(NZ,NY,NX),NZ,NY,NX).NE.0)THEN + IDAY(6,NB,NZ,NY,NX)=I + PSTGF(NB,NZ,NY,NX)=PSTG(NB,NZ,NY,NX) + ENDIF + ENDIF +C +C START GRAIN FILL PERIOD +C + ELSEIF(IDAY(7,NB,NZ,NY,NX).EQ.0)THEN + IF(GSTGF(NB,NZ,NY,NX).GT.0.50*GSTGR + 2.OR.((IWTYP(NZ,NY,NX).EQ.1.OR.IWTYP(NZ,NY,NX).EQ.3) + 3.AND.ISTYP(NZ,NY,NX).NE.0.AND.IPTYP(NZ,NY,NX).NE.1 + 3.AND.DYLN(NY,NX).LT.DYLX(NY,NX).AND.IFLGE(NB,NZ,NY,NX).EQ.1 + 4.AND.VRNF(NB,NZ,NY,NX).GT.VRNX(NB,NZ,NY,NX)) + 5.OR.(IWTYP(NZ,NY,NX).EQ.2.AND.ISTYP(NZ,NY,NX).EQ.0) + 6.AND.IFLGE(NB,NZ,NY,NX).EQ.1 + 7.AND.VRNF(NB,NZ,NY,NX).GT.VRNX(NB,NZ,NY,NX))THEN + IDAY(7,NB,NZ,NY,NX)=I +C IF(IWTYP(NZ,NY,NX).NE.0.AND.NB.EQ.NB1(NZ,NY,NX))THEN +C DO 1500 NBB=1,NBR(NZ,NY,NX) +C IF(NBB.NE.NB.AND.IDAY(5,NBB,NZ,NY,NX).EQ.0)THEN +C IDAY(5,NBB,NZ,NY,NX)=I +C PSTGF(NBB,NZ,NY,NX)=PSTG(NBB,NZ,NY,NX) +C ENDIF +1500 CONTINUE +C ENDIF + ENDIF +C +C END SEED NUMBER SET PERIOD +C + ELSEIF(IDAY(8,NB,NZ,NY,NX).EQ.0)THEN + IF(GSTGF(NB,NZ,NY,NX).GT.1.00*GSTGR)THEN + IDAY(8,NB,NZ,NY,NX)=I +C IF(IWTYP(NZ,NY,NX).NE.0.AND.NB.EQ.NB1(NZ,NY,NX))THEN +C DO 1495 NBB=1,NBR(NZ,NY,NX) +C IF(NBB.NE.NB.AND.IDAY(6,NBB,NZ,NY,NX).EQ.0)THEN +C IDAY(6,NBB,NZ,NY,NX)=I +C ENDIF +1495 CONTINUE +C ENDIF + ENDIF +C +C END SEED SIZE SET PERIOD +C + ELSEIF(IDAY(9,NB,NZ,NY,NX).EQ.0)THEN + IF(GSTGF(NB,NZ,NY,NX).GT.1.50*GSTGR)THEN + IDAY(9,NB,NZ,NY,NX)=I + ENDIF + ENDIF + ENDIF + KVSTGX=KVSTG(NB,NZ,NY,NX) + IF(VSTGX(NB,NZ,NY,NX).LE.1.0E-06)THEN + KVSTG(NB,NZ,NY,NX)=INT(VSTG(NB,NZ,NY,NX))+1 + ELSE + KVSTG(NB,NZ,NY,NX)=INT(AMIN1(VSTG(NB,NZ,NY,NX) + 2,VSTGX(NB,NZ,NY,NX)))+1 + ENDIF + KLEAF(NB,NZ,NY,NX)=MIN(24,KVSTG(NB,NZ,NY,NX)) + IF(KVSTG(NB,NZ,NY,NX).GT.KVSTGX)THEN + IFLGP(NB,NZ,NY,NX)=1 + ELSE + IFLGP(NB,NZ,NY,NX)=0 + ENDIF +C +C PHENOLOGY +C + IF(IDTHB(NB,NZ,NY,NX).EQ.0.OR.IFLGI(NZ,NY,NX).EQ.1)THEN + IF(DYLN(NY,NX).GE.DYLX(NY,NX))THEN + VRNY(NB,NZ,NY,NX)=VRNY(NB,NZ,NY,NX)+1.0 + VRNZ(NB,NZ,NY,NX)=0.0 + ELSE + VRNY(NB,NZ,NY,NX)=0.0 + VRNZ(NB,NZ,NY,NX)=VRNZ(NB,NZ,NY,NX)+1.0 + ENDIF +C +C CALCULATE PHENOLOGY DURING LENGTHENING PHOTOPERIODS +C + IF(IWTYP(NZ,NY,NX).EQ.0)THEN + IF(DYLN(NY,NX).GE.DYLX(NY,NX))THEN + VRNS(NB,NZ,NY,NX)=VRNY(NB,NZ,NY,NX) + IF(VRNS(NB,NZ,NY,NX).GE.VRNL(NB,NZ,NY,NX) + 2.OR.(ALAT(NY,NX).GT.0.0.AND.I.EQ.173) + 3.OR.(ALAT(NY,NX).LT.0.0.AND.I.EQ.355))THEN + VRNF(NB,NZ,NY,NX)=0.0 + IFLGF(NB,NZ,NY,NX)=0 + ENDIF + ENDIF +C +C CALCULATE EVERGREEN PHENOLOGY DURING SHORTENING PHOTOPERIODS +C + IF(DYLN(NY,NX).LT.DYLX(NY,NX))THEN + VRNF(NB,NZ,NY,NX)=VRNZ(NB,NZ,NY,NX) + IF(VRNF(NB,NZ,NY,NX).GE.VRNX(NB,NZ,NY,NX) + 2.OR.(ALAT(NY,NX).GT.0.0.AND.I.EQ.355) + 3.OR.(ALAT(NY,NX).LT.0.0.AND.I.EQ.173))THEN + VRNS(NB,NZ,NY,NX)=0.0 + IFLGE(NB,NZ,NY,NX)=0 + ENDIF + ENDIF +C +C CALCULATE WINTER DECIDUOUS PHENOLOGY BY ACCUMULATING HOURS IN +C SPECIFIED TEMPERATURE RANGES DURING LENGTHENING PHOTOPERIODS +C + ELSEIF(IWTYP(NZ,NY,NX).EQ.1)THEN + IF((DYLN(NY,NX).GE.DYLX(NY,NX) + 2.OR.(DYLN(NY,NX).LT.DYLX(NY,NX) + 3.AND.VRNF(NB,NZ,NY,NX).LT.VRNX(NB,NZ,NY,NX))) + 4.AND.IFLGE(NB,NZ,NY,NX).EQ.0)THEN + IF(TCG(NZ,NY,NX).GE.TCZ(NZ,NY,NX))THEN + VRNS(NB,NZ,NY,NX)=VRNS(NB,NZ,NY,NX)+1.0 + ENDIF + IF(VRNS(NB,NZ,NY,NX).LT.VRNL(NB,NZ,NY,NX))THEN + IF(TCG(NZ,NY,NX).LT.CTC(NZ,NY,NX))THEN + VRNS(NB,NZ,NY,NX)=AMAX1(0.0,VRNS(NB,NZ,NY,NX)-1.0) + ENDIF + ENDIF + IF(VRNS(NB,NZ,NY,NX).GE.VRNL(NB,NZ,NY,NX) + 2.OR.(ALAT(NY,NX).GT.0.0.AND.I.EQ.173) + 3.OR.(ALAT(NY,NX).LT.0.0.AND.I.EQ.355))THEN + VRNF(NB,NZ,NY,NX)=0.0 + ENDIF + ENDIF + IF(IDAY(2,NB,NZ,NY,NX).NE.0.OR.(DYLN(NY,NX).LT.DYLX(NY,NX) + 2.AND.DYLN(NY,NX).LT.12.0))THEN + IFLGF(NB,NZ,NY,NX)=0 + ENDIF +C +C CALCULATE WINTER DECIDUOUS PHENOLOGY BY ACCUMULATING HOURS IN +C SPECIFIED TEMPERATURE RANGES DURING SHORTENING PHOTOPERIODS +C + IF(DYLN(NY,NX).LT.DYLX(NY,NX) + 2.AND.IFLGF(NB,NZ,NY,NX).EQ.0 + 2.AND.IDAY(2,NB,NZ,NY,NX).NE.0)THEN + IF(TCG(NZ,NY,NX).LE.TCX(NZ,NY,NX))THEN + VRNF(NB,NZ,NY,NX)=VRNF(NB,NZ,NY,NX)+1.0 + ENDIF + IF(VRNF(NB,NZ,NY,NX).GE.VRNX(NB,NZ,NY,NX) + 2.AND.IFLGE(NB,NZ,NY,NX).EQ.1)THEN + VRNS(NB,NZ,NY,NX)=0.0 + IFLGE(NB,NZ,NY,NX)=0 + ENDIF + ENDIF +C WRITE(*,4646)'VRNS',I,J,NZ,NB,IDAY(2,NB,NZ,NY,NX) +C 2,IFLGE(NB,NZ,NY,NX),IFLGF(NB,NZ,NY,NX),VRNS(NB,NZ,NY,NX) +C 2,TCG(NZ,NY,NX),TCZ(NZ,NY,NX),TCX(NZ,NY,NX),PSILG(NZ,NY,NX) +C 3,DYLN(NY,NX),DYLX(NY,NX),DYLM(NY,NX),VRNF(NB,NZ,NY,NX) +C 4,VRNL(NB,NZ,NY,NX),VRNX(NB,NZ,NY,NX) +4646 FORMAT(A8,7I4,20E12.4) +C +C CALCULATE DROUGHT DECIDUOUS PHENOLOGY BY ACCUMULATING HOURS IN +C SPECIFIED TURGOR RANGES IN DORMANT STATE +C + ELSEIF(IWTYP(NZ,NY,NX).EQ.2.OR.IWTYP(NZ,NY,NX).EQ.4 + 2.OR.IWTYP(NZ,NY,NX).EQ.5)THEN + IF(IFLGE(NB,NZ,NY,NX).EQ.0)THEN + IF(PSILT(NZ,NY,NX).GE.PSILX)THEN + VRNS(NB,NZ,NY,NX)=VRNS(NB,NZ,NY,NX)+1.0 + ENDIF + IF(VRNS(NB,NZ,NY,NX).LT.VRNL(NB,NZ,NY,NX))THEN + IF(PSILT(NZ,NY,NX).LT.PSILY(IGTYP(NZ,NY,NX)))THEN + VRNS(NB,NZ,NY,NX)=AMAX1(0.0,VRNS(NB,NZ,NY,NX)-12.0) + ENDIF + ENDIF + IF(VRNS(NB,NZ,NY,NX).GE.VRNL(NB,NZ,NY,NX))THEN + VRNF(NB,NZ,NY,NX)=0.0 + IF(IDAY(2,NB,NZ,NY,NX).NE.0)IFLGF(NB,NZ,NY,NX)=0 + ENDIF + ENDIF + IF(IDAY(2,NB,NZ,NY,NX).NE.0)IFLGF(NB,NZ,NY,NX)=0 +C +C CALCULATE DROUGHT DECIDUOUS PHENOLOGY BY ACCUMULATING HOURS IN +C SPECIFIED TURGOR RANGES IN DORMANT STATE +C + IF(IFLGE(NB,NZ,NY,NX).EQ.1 + 3.AND.IFLGF(NB,NZ,NY,NX).EQ.0)THEN + IF(PSILT(NZ,NY,NX).LT.PSILY(IGTYP(NZ,NY,NX)))THEN + VRNF(NB,NZ,NY,NX)=VRNF(NB,NZ,NY,NX)+1.0 + ENDIF + IF(IWTYP(NZ,NY,NX).EQ.4)THEN + IF(VRNZ(NB,NZ,NY,NX).GT.VRNE)THEN + VRNF(NB,NZ,NY,NX)=VRNZ(NB,NZ,NY,NX) + ENDIF + ELSEIF(IWTYP(NZ,NY,NX).EQ.5)THEN + IF(VRNY(NB,NZ,NY,NX).GT.VRNE)THEN + VRNF(NB,NZ,NY,NX)=VRNY(NB,NZ,NY,NX) + ENDIF + ENDIF + IF(VRNF(NB,NZ,NY,NX).GE.VRNX(NB,NZ,NY,NX) + 2.AND.IFLGE(NB,NZ,NY,NX).EQ.1)THEN + VRNS(NB,NZ,NY,NX)=0.0 + IFLGE(NB,NZ,NY,NX)=0 + ENDIF + ENDIF +C +C CALCULATE WINTER AND DROUGHT DECIDUOUS PHENOLOGY BY ACCUMULATING HOURS +C IN SPECIFIED TEMPERATURE RANGES DURING LENGTHENING PHOTOPERIODS +C + ELSEIF(IWTYP(NZ,NY,NX).EQ.3)THEN + IF((DYLN(NY,NX).GE.DYLX(NY,NX).OR.DYLN(NY,NX).GE.DYLM(NY,NX)-2.0) + 2.AND.IFLGE(NB,NZ,NY,NX).EQ.0)THEN + IF(TCG(NZ,NY,NX).GE.TCZ(NZ,NY,NX) + 2.AND.PSILG(NZ,NY,NX).GT.PSILM)THEN + VRNS(NB,NZ,NY,NX)=VRNS(NB,NZ,NY,NX)+1.0 + ENDIF + IF(VRNS(NB,NZ,NY,NX).LT.VRNL(NB,NZ,NY,NX))THEN + IF(TCG(NZ,NY,NX).LT.CTC(NZ,NY,NX) + 2.OR.PSILG(NZ,NY,NX).LT.PSILM)THEN + VRNS(NB,NZ,NY,NX)=AMAX1(0.0,VRNS(NB,NZ,NY,NX)-1.5) + ENDIF + ENDIF + IF(VRNS(NB,NZ,NY,NX).GE.VRNL(NB,NZ,NY,NX))THEN + VRNF(NB,NZ,NY,NX)=0.0 + IF(IDAY(2,NB,NZ,NY,NX).NE.0)IFLGF(NB,NZ,NY,NX)=0 + ENDIF + ENDIF + IF(IDAY(2,NB,NZ,NY,NX).NE.0)IFLGF(NB,NZ,NY,NX)=0 +C WRITE(*,4647)'VRNS',I,J,NZ,NB,VRNS(NB,NZ,NY,NX),TCG(NZ,NY,NX) +C 2,TCZ(NZ,NY,NX),PSILG(NZ,NY,NX),PSILM,CTC(NZ,NY,NX) +C 3,DYLN(NY,NX),DYLX(NY,NX),DYLM(NY,NX),VRNL(NB,NZ,NY,NX) +4647 FORMAT(A8,4I4,20E12.4) +C +C CALCULATE WINTER AND DROUGHT DECIDUOUS PHENOLOGY BY ACCUMULATING HOURS +C IN SPECIFIED TEMPERATURE RANGES DURING SHORTENING PHOTOPERIODS +C + IF((DYLN(NY,NX).LT.DYLX(NY,NX).OR.DYLN(NY,NX) + 2.LT.24.0-DYLM(NY,NX)+2.0).AND.IFLGF(NB,NZ,NY,NX).EQ.0)THEN + IF(TCG(NZ,NY,NX).LE.TCX(NZ,NY,NX) + 2.OR.PSILT(NZ,NY,NX).LT.PSILY(IGTYP(NZ,NY,NX)))THEN + VRNF(NB,NZ,NY,NX)=VRNF(NB,NZ,NY,NX)+1.0 + ENDIF + IF(VRNF(NB,NZ,NY,NX).GE.VRNX(NB,NZ,NY,NX) + 2.AND.IFLGE(NB,NZ,NY,NX).EQ.1)THEN + VRNS(NB,NZ,NY,NX)=0.0 + IFLGE(NB,NZ,NY,NX)=0 + ENDIF + ENDIF + ENDIF + ENDIF +2010 CONTINUE +C +C WATER STRESS INDICATOR +C + IF(PSILT(NZ,NY,NX).LT.PSILY(IGTYP(NZ,NY,NX)))THEN + WSTR(NZ,NY,NX)=WSTR(NZ,NY,NX)+1.0 + ENDIF + ENDIF + ENDIF + ENDIF +9985 CONTINUE +9990 CONTINUE +9995 CONTINUE + RETURN + END diff --git a/f77src/hour1.f b/f77src/hour1.f index aec5a13..22d5791 100755 --- a/f77src/hour1.f +++ b/f77src/hour1.f @@ -568,7 +568,7 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) 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)) - EHUM(L,NY,NX)=0.167+0.167*CCLAY(L,NY,NX) + EHUM(L,NY,NX)=0.200+0.200*AMIN1(0.5,CCLAY(L,NY,NX)) EPOC(L,NY,NX)=1.0 IF(CORGC(L,NY,NX).GT.FORGC)THEN SRP(L,NY,NX)=0.80 @@ -773,7 +773,7 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) C SOIL SURFACE WATER STORAGE CAPACITY C DS=AMAX1(0.001,0.112*ZS(NY,NX)+3.10*ZS(NY,NX)**2 - 2-0.012*ZS(NY,NX)*SL(NY,NX)/57.29578) + 2-0.012*ZS(NY,NX)*GSIN(NY,NX)) VOLWG(NY,NX)=AMAX1(DS,-DTBLX(NY,NX))*AREA(3,NU(NY,NX),NY,NX) DPTH(NU(NY,NX),NY,NX)=CDPTH(NU(NY,NX),NY,NX) 2-0.5*DLYR(3,NU(NY,NX),NY,NX) @@ -787,7 +787,7 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) CSILT(NU(NY,NX),NY,NX)=0.0 CSAND(NU(NY,NX),NY,NX)=0.0 ENDIF - EHUM(0,NY,NX)=0.167+0.167*CCLAY(NU(NY,NX),NY,NX) + EHUM(0,NY,NX)=0.200+0.200*AMIN1(0.5,CCLAY(NU(NY,NX),NY,NX)) EPOC(0,NY,NX)=0.150 C C PARAMETERS FOR SOIL COHESION, EROSIVITY, AND ROUGHNESS USED @@ -934,9 +934,13 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) XNBDFG(L,NY,NX)=0.0 XN34BQ(L,NY,NX)=0.0 XHGDFG(L,NY,NX)=0.0 - TDFOMC(L,NY,NX)=0.0 - TDFOMN(L,NY,NX)=0.0 - TDFOMP(L,NY,NX)=0.0 + IF(L.GE.NU(NY,NX))THEN + DO 195 K=0,4 + TDFOMC(K,L,NY,NX)=0.0 + TDFOMN(K,L,NY,NX)=0.0 + TDFOMP(K,L,NY,NX)=0.0 +195 CONTINUE + ENDIF DO 9795 M=1,NPH ROXSK(M,L,NY,NX)=0.0 9795 CONTINUE @@ -1185,14 +1189,6 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) 2*HYST(L,NY,NX) THETPZ(L,NY,NX)=AMAX1(0.0,POROS(L,NY,NX)-THETW(L,NY,NX) 2-THETI(L,NY,NX)) - TORT(L,NY,NX)=AMAX1(0.01,0.7*THETW(L,NY,NX)**2) - 2*(1.0-FHOL(L,NY,NX)) - IF(VOLAH(L,NY,NX).GT.ZEROS(NY,NX))THEN - THETWH=VOLWH(L,NY,NX)/VOLAH(L,NY,NX) - TORTH(L,NY,NX)=AMIN1(1.0,2.8*THETWH**3) - ELSE - TORTH(L,NY,NX)=0.0 - ENDIF IF(THETP(L,NY,NX).GT.THETX)THEN CCO2G(L,NY,NX)=AMAX1(0.0,CO2G(L,NY,NX)/VOLP(L,NY,NX)) CCH4G(L,NY,NX)=AMAX1(0.0,CH4G(L,NY,NX)/VOLP(L,NY,NX)) @@ -1575,16 +1571,24 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) IF(VOLT(0,NY,NX).GT.ZEROS(NY,NX))THEN VOLX(0,NY,NX)=VOLT(0,NY,NX) BKVL(0,NY,NX)=2.0E-06*ORGC(0,NY,NX) - VOLA(0,NY,NX)=AMAX1(0.0,VOLX(0,NY,NX)-BKVL(0,NY,NX)/1.30) + VOLA(0,NY,NX)=AMAX1(0.0,VOLR(NY,NX)-BKVL(0,NY,NX)/1.30) VOLP(0,NY,NX)=AMAX1(0.0,VOLA(0,NY,NX)-VOLW(0,NY,NX) 2-VOLI(0,NY,NX)) - POROS(0,NY,NX)=VOLA(0,NY,NX)/VOLX(0,NY,NX) + IF(VOLR(NY,NX).GT.ZEROS(NY,NX))THEN + POROS(0,NY,NX)=VOLA(0,NY,NX)/VOLR(NY,NX) + THETW(0,NY,NX)=AMAX1(0.0,AMIN1(1.0 + 2,VOLW(0,NY,NX)/VOLR(NY,NX))) + THETI(0,NY,NX)=AMAX1(0.0,AMIN1(1.0 + 2,VOLI(0,NY,NX)/VOLR(NY,NX))) + THETP(0,NY,NX)=AMAX1(0.0,AMIN1(1.0 + 2,VOLP(0,NY,NX)/VOLR(NY,NX))) + ELSE + POROS(0,NY,NX)=1.0 + THETW(0,NY,NX)=0.0 + THETI(0,NY,NX)=0.0 + THETP(0,NY,NX)=0.0 + ENDIF DLYR(3,0,NY,NX)=VOLX(0,NY,NX)/AREA(3,0,NY,NX) - THETW(0,NY,NX)=AMAX1(0.0,AMIN1(VOLA(0,NY,NX) - 2,VOLW(0,NY,NX))/VOLX(0,NY,NX)) - THETI(0,NY,NX)=AMAX1(0.0,AMIN1(VOLA(0,NY,NX) - 2,VOLI(0,NY,NX))/VOLX(0,NY,NX)) - THETP(0,NY,NX)=AMAX1(0.0,VOLP(0,NY,NX)/VOLX(0,NY,NX)) TRC0(NY,NX)=RC0(0,NY,NX)+RC0(1,NY,NX)+RC0(2,NY,NX) TRA0(NY,NX)=RA0(0,NY,NX)+RA0(1,NY,NX)+RA0(2,NY,NX) IF(TRC0(NY,NX).GT.ZEROS(NY,NX) @@ -1686,7 +1690,6 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) ONSGL(0,NY,NX)=ONSG*TFACL OPSGL(0,NY,NX)=OPSG*TFACL OASGL(0,NY,NX)=OASG*TFACL - TORT(0,NY,NX)=1.0 ROXYY(0,NY,NX)=ROXYX(0,NY,NX) RNH4Y(0,NY,NX)=RNH4X(0,NY,NX) RNO3Y(0,NY,NX)=RNO3X(0,NY,NX) @@ -1705,9 +1708,9 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) ROQCX(K,0,NY,NX)=0.0 ROQAX(K,0,NY,NX)=0.0 5055 CONTINUE - TFACW=(TKW(NY,NX)/273.15)**1.75 - TFACR=(TKS(0,NY,NX)/273.15)**1.75 - TFACA=(TKA(NY,NX)/273.15)**1.75 + TFACW=(TKW(NY,NX)/298.15)**1.75 + TFACR=(TKS(0,NY,NX)/298.15)**1.75 + TFACA=(TKA(NY,NX)/298.15)**1.75 WGSGW(NY,NX)=WGSG*TFACW WGSGR(NY,NX)=WGSG*TFACR WGSGA(NY,NX)=WGSG*TFACA diff --git a/f77src/main.f b/f77src/main.f index c22ef0c..31549d2 100755 --- a/f77src/main.f +++ b/f77src/main.f @@ -25,13 +25,13 @@ PROGRAM main CALL GETARG(2,BUF) CALL CHDIR(BUF) PREFIX='.\\' -C make output directory - outdir=trim(buf)//'\\outputs\\' +C make output directory + outdir=trim(buf)//'\\outputs\\' ELSE PREFIX='./' -C make output directory - outdir=trim(buf)//'/outputs/' - ENDIF +C make output directory + outdir=trim(buf)//'/outputs/' + ENDIF call system('mkdir -p '//trim(outdir)) C C READ INPUT FILES diff --git a/f77src/nitro.f b/f77src/nitro.f index dfc067a..a71ed01 100755 --- a/f77src/nitro.f +++ b/f77src/nitro.f @@ -1,2769 +1,2786 @@ - SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) -C -C THIS SUBROUTINE CALCULATES ALL SOIL BIOLOGICAL TRANSFORMATIONS -C - include "parameters.h" - include "blkc.h" - include "blk2a.h" - include "blk2b.h" - include "blk2c.h" - include "blk8a.h" - include "blk8b.h" - include "blk10.h" - include "blk11a.h" - include "blk11b.h" - include "blk13a.h" - include "blk13b.h" - include "blk13c.h" - include "blk13d.h" - include "blk15a.h" - include "blk15b.h" - include "blk18a.h" - include "blk18b.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) - 3,RHOSN(4,0:4),RHOSP(4,0:4),RCOSC(4,0:4),RCOSN(4,0:4),RCOSP(4,0:4) - 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),FOSRH(0:4),RUPOX(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),RIPB4(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) - 6,CGOMP(7,0:5),RDMMC(2,7,0:5),RHMMC(2,7,0:5),RCMMC(2,7,0:5) - 7,RDMMN(2,7,0:5),RHMMN(2,7,0:5),RCMMN(2,7,0:5),RDMMP(2,7,0:5) - 8,RHMMP(2,7,0:5),RCMMP(2,7,0:5),RCCMC(2,7,0:4) - 9,RCCMN(2,7,0:4),RCCMP(2,7,0:4),RN2FX(7,0:5),TOMK(0:5) - 1,TONK(0:5),TOPK(0:5),SPOMC(2),OMC2(7,0:5),TFNG(7,0:5),TFNR(7,0:5) - 2,OMN2(7,0:5),FOM2(7,0:5),FOCA(0:4),FOAA(0:4),RXOMC(2,7,0:5) - 3,RXOMN(2,7,0:5),RXOMP(2,7,0:5),R3OMC(2,7,0:5),R3OMN(2,7,0:5) - 4,R3OMP(2,7,0:5),RXMMC(2,7,0:5),RXMMN(2,7,0:5),RXMMP(2,7,0:5) - 4,R3MMC(2,7,0:5),R3MMN(2,7,0:5),R3MMP(2,7,0:5),WFN(7,0:5) - DIMENSION CGOQC(7,0:5),CGOAC(7,0:5),ROQCK(0:4),XOQCK(0:4) - 2,EN2F(7),ORCT(0:4),OSCT(0:4),OSAT(0:4),ZNH4T(0:JZ),ZNO3T(0:JZ) - 3,ZNO2T(0:JZ),H2P4T(0:JZ),RINH4R(7,0:5),RINO3R(7,0:5) - 4,RIPO4R(7,0:5),FNH4XR(7,0:5),FNO3XR(7,0:5),FPO4XR(7,0:5) - 5,RGOMY(7,0:5),CNQ(0:4),CPQ(0:4),CNH(0:4),CPH(0:4) - 6,CNS(4,0:4),CPS(4,0:4),DCKM(0:4),DCKX(0:4),ROQCD(7,0:4) - 7,DOSA(0:4),DOSX(0:4),DOSM(0:4),FORC(0:5),DOMX(0:5) - 8,CGOMS(2,7,0:5),CGONS(2,7,0:5),CGOPS(2,7,0:5) - 1,TONX(0:5),TOPX(0:5),FCNK(0:4),FCPK(0:4) - 2,RCO2X(7,0:5),RCH3X(7,0:5),RCH4X(7,0:5),RVOXA(7),RVOXB(7) - 2,TGROMC(0:7),XOQCZ(0:4),XOQNZ(0:4),XOQPZ(0:4),XOQAZ(0:4) - 3,XOMCZ(3,7,0:4),XOMNZ(3,7,0:4),XOMPZ(3,7,0:4) - 3,FCN(7,0:5),FCP(7,0:5),FCNP(7,0:5),FSBST(7,0:5) - 4,TCGOQC(0:4),TCGOAC(0:4),TCGOMN(0:4),TCGOMP(0:4) -C -C SUBSTRATE DECOMPOSITION BY MICROBIAL POPULATIONS -C - PARAMETER (ORAD=1.0E-06,BIOS=1.0E-06/(4.19*ORAD**3) - 2,BIOA=BIOS*12.57*ORAD**2,DCKI=2.5,RCCX=0.750 - 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,DOMK=2.5E+02 - 5,FOSCZ0=2.0E-02,FOSCZL=1.0E-06,FMN=1.0E-03 - 6,CNKI=1.0E+01,CPKI=1.0E+02) -C -C SPECIFIC RESPIRATION RATES, M-M UPTAKE CONSTANTS, -C STOICHIOMETRIC CONSTANTS FOR MICROBIAL REDOX REACTIONS -C - PARAMETER (VMXO=0.10,VMXF=0.10,VMXM=0.10,VMXH=0.25,VMXN=0.25 - 2,VMX4=0.25,VMXC=0.10,OQKM=1.2E+01,OQKA=1.2E+01,OQKAM=1.2E+01 - 3,CCKM=0.15,CCK4=1.2E-04,ZHKM=2.0E-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,C3KI=7.0,ECNH=0.30 - 7,ECNO=0.10,ECN3=0.857,ECN2=0.857,ECN1=0.429,RNFNI=0.00625 - 8,RNFNG=0.0125,ECHO=0.75,VMKI=2.50,OXKA=0.32 - 9,EDNH=1.00,EDNA=1.00) -C -C ENERGY REQUIREMENTS FOR MICROBIAL GROWTH AND -C ENERGY YIELDS FROM REDUCTION OF O2, OC, CH4, NO3, N2 -C - PARAMETER (EOMC=25.0,EOMD=37.5,EOMG=37.5,EOMF=25.0,EOMH=25.0 - 2,EOMN=75.0,GO2X=37.5,GCHX=4.50,GO2A=GO2X-GCHX,GC4X=3.00 - 3,GCOX=11.00,GNOX=10.0,GN2X=187.5,EN2X=GO2X/GN2X,EN2Y=GCHX/GN2X - 4,EO2X=1.0/(1.0+GO2X/EOMC),EO2G=1.0/(1.0+GO2X/EOMG) - 5,EO2D=1.0/(1.0+GO2X/EOMD),ENFX=1.0/(1.0+GO2X/EOMN) - 6,ENOX=1.0/(1.0+GNOX/EOMC),EO2A=1.0/(1.0+GO2A/EOMC)) -C -C SORPTION RATE CONSTANTS -C - PARAMETER (TSORP=0.5,HSORP=1.0) -C -C SPECIFIC DECOMPOSITION RATES -C - PARAMETER (SPOHC=0.25,SPOHA=0.25,RMOM=0.010) - DATA SPOSC/10.0,10.0,1.5,0.25,10.0,10.0,1.5,0.25 - 2,10.0,10.0,1.5,0.25,0.05,0.00,0.00,0.00 - 3,0.05,0.0167,0.00,0.00/ - DATA SPORC/10.0,1.5/ - DATA SPOMC/10.0E-03,5.0E-04/ - DATA DCKM/0.5E+03,0.5E+03,0.5E+03,1.0E+03,1.0E+03/ - DATA DOSA/5.0E+00,5.0E+00,5.0E+00,5.0E+00,5.0E+00/ - DATA DOSX/0.0500,0.0500,0.0500,0.0125,0.0125/ - DATA DOSM/0.0050,0.0050,0.0050,0.0025,0.0025/ - DATA DCKX/0.50,0.50,0.50,0.00,0.00/ - DATA DOMX/1.0,1.0,1.0,1.0,1.0,0.001/ -C -C MICROBIAL C:N:P RATIOS DURING HUMIFICATION -C - DATA EN2F/0.0,0.0,0.0,0.0,0.0,EN2X,EN2Y/ - REAL*4 WFNG,TFNX,TFNY,TFNG,TFNR,CNSHZ,CPSHZ,FRM -C REAL*16 B,C - DO 9995 NX=NHW,NHE - DO 9990 NY=NVN,NVS - DO 998 L=0,NL(NY,NX) - IF(L.EQ.0.OR.L.GE.NU(NY,NX))THEN - IF(L.EQ.0)THEN - KL=2 -C ZNH4T(NU(NY,NX))=AMAX1(0.0,ZNH4S(NU(NY,NX),NY,NX)) -C 2+AMAX1(0.0,ZNH4B(NU(NY,NX),NY,NX)) -C ZNO3T(NU(NY,NX))=AMAX1(0.0,ZNO3S(NU(NY,NX),NY,NX)) -C 2+AMAX1(0.0,ZNO3B(NU(NY,NX),NY,NX)) -C ZNO2T(NU(NY,NX))=AMAX1(0.0,ZNO2S(NU(NY,NX),NY,NX)) -C 2+AMAX1(0.0,ZNO2B(NU(NY,NX),NY,NX)) -C H2P4T(NU(NY,NX))=AMAX1(0.0,H2PO4(NU(NY,NX),NY,NX)) -C 2+AMAX1(0.0,H2POB(NU(NY,NX),NY,NX)) - 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)) - ELSE - VOLWZ=0.0 - ENDIF - ELSE - KL=4 - VOLWZ=AMAX1(0.0,(AMIN1(AMAX1(0.10,FC(L,NY,NX)),THETW(L,NY,NX)) - 2-THETY(L,NY,NX))*VOLX(L,NY,NX)) - ENDIF -C -C TEMPERATURE FUNCTIONS FOR GROWTH AND MAINTENANCE -C WITH OFFSET FOR THERMAL ADAPTATION -C - TKSO=TKS(L,NY,NX)+OFFSET(NY,NX) - RTK=8.3143*TKSO - STK=710.0*TKSO - ACTV=1+EXP((197500-STK)/RTK)+EXP((STK-222500)/RTK) - TFNX=EXP(25.229-62500/RTK)/ACTV - TKSM=AMAX1(258.15,TKS(L,NY,NX))+OFFSET(NY,NX) - RTK=8.3143*TKSM - STK=710.0*TKSM - ACTVM=1+EXP((195000-STK)/RTK)+EXP((STK-232500)/RTK) - TFNY=EXP(25.214-62500/RTK)/ACTVM - OXYI=1.0-1.0/(1.0+EXP(1.0*(-COXYS(L,NY,NX)+3.0))) -C -C NITRIFICATION INHIBITION -C - IF(ZNFN0(L,NY,NX).GT.ZEROS(NY,NX))THEN - ZNFNI(L,NY,NX)=ZNFNI(L,NY,NX)-RNFNI - 2*ZNFNI(L,NY,NX)*AMAX1(1.0E-02 - 3,1.0-SQRT(ZNFNI(L,NY,NX)/ZNFN0(L,NY,NX))) - ZNFNG(L,NY,NX)=ZNFNG(L,NY,NX)+RNFNG - 2*(1.0-SQRT(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)) - IF(ZNH4T(L).GT.ZEROS(NY,NX))THEN - FNH4S=AMAX1(0.0,ZNH4S(L,NY,NX))/ZNH4T(L) - FNHBS=AMAX1(0.0,ZNH4B(L,NY,NX))/ZNH4T(L) - ELSE - FNH4S=VLNH4(L,NY,NX) - FNHBS=VLNHB(L,NY,NX) - ENDIF - ZNO3T(L)=AMAX1(0.0,ZNO3S(L,NY,NX))+AMAX1(0.0,ZNO3B(L,NY,NX)) - IF(ZNO3T(L).GT.ZEROS(NY,NX))THEN - FNO3S=AMAX1(0.0,ZNO3S(L,NY,NX))/ZNO3T(L) - FNO3B=AMAX1(0.0,ZNO3B(L,NY,NX))/ZNO3T(L) - ELSE - FNO3S=VLNO3(L,NY,NX) - FNO3B=VLNOB(L,NY,NX) - ENDIF - ZNO2T(L)=AMAX1(0.0,ZNO2S(L,NY,NX))+AMAX1(0.0,ZNO2B(L,NY,NX)) - IF(ZNO2T(L).GT.ZEROS(NY,NX))THEN - FNO2S=AMAX1(0.0,ZNO2S(L,NY,NX))/ZNO2T(L) - FNO2B=AMAX1(0.0,ZNO2B(L,NY,NX))/ZNO2T(L) - ELSE - FNO2S=VLNO3(L,NY,NX) - FNO2B=VLNOB(L,NY,NX) - ENDIF - H2P4T(L)=AMAX1(0.0,H2PO4(L,NY,NX))+AMAX1(0.0,H2POB(L,NY,NX)) - IF(H2P4T (L).GT.ZEROS(NY,NX))THEN - FH2PS=AMAX1(0.0,H2PO4(L,NY,NX))/H2P4T (L) - FH2PB=AMAX1(0.0,H2POB(L,NY,NX))/H2P4T (L) - ELSE - FH2PS=VLPO4(L,NY,NX) - FH2PB=VLPOB(L,NY,NX) - ENDIF - COXYQ1=COXYG(L,NY,NX)*SOXYL(L,NY,NX) -C -C TOTAL SUBSTRATE -C - TOSC=0.0 - TOSA=0.0 - TORC=0.0 - TOHC=0.0 -C -C TOTAL SOLID SUBSTRATE -C - DO 870 K=0,KL - OSCT(K)=0.0 - OSAT(K)=0.0 - DO 865 M=1,4 - OSCT(K)=OSCT(K)+OSC(M,K,L,NY,NX) - OSAT(K)=OSAT(K)+OSA(M,K,L,NY,NX) -865 CONTINUE - TOSC=TOSC+OSCT(K) - TOSA=TOSA+OSAT(K) -870 CONTINUE -C -C TOTAL BIORESIDUE -C - DO 880 K=0,KL - ORCT(K)=0.0 - DO 875 M=1,2 - ORCT(K)=ORCT(K)+ORC(M,K,L,NY,NX) -C IF(L.EQ.4.AND.K.EQ.2)THEN -C WRITE(*,876)'ORCT',I,J,NX,NY,L,K,M,ORCT(K) -C 2,ORC(M,K,L,NY,NX) -876 FORMAT(A8,7I4,60E12.4) -C ENDIF -875 CONTINUE - TORC=TORC+ORCT(K) -C -C TOTAL ADSORBED AND DISSOLVED SUBSTRATE -C - TOHC=TOHC+OHC(K,L,NY,NX)+OHA(K,L,NY,NX) -880 CONTINUE - DO 860 K=0,KL - OSRH(K)=OSAT(K)+ORCT(K)+OHC(K,L,NY,NX)+OHA(K,L,NY,NX) -C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.EQ.4.AND.K.EQ.2)THEN -C WRITE(*,861)'OSRH',I,J,NX,NY,L,K,OSRH(K),OSCT(K) -C 2,OSAT(K),ORCT(K),OHC(K,L,NY,NX),OHA(K,L,NY,NX) -861 FORMAT(A8,6I4,20E12.4) -C ENDIF -860 CONTINUE - TSRH=TOSA+TORC+TOHC -C -C C:N AND C:P RATIOS OF TOTAL BIOMASS -C - TOMA=0.0 - TOMN=0.0 - DO 890 K=0,5 - IF(L.NE.0.OR.(K.NE.3.AND.K.NE.4))THEN - DO 895 N=1,7 - IF(K.NE.5.OR.(N.LE.3.OR.N.EQ.5))THEN - IF(OMC(1,N,K,L,NY,NX).GT.ZEROS(NY,NX))THEN - CNOMA(N,K)=AMAX1(0.0,OMN(1,N,K,L,NY,NX)/OMC(1,N,K,L,NY,NX)) - CPOMA(N,K)=AMAX1(0.0,OMP(1,N,K,L,NY,NX)/OMC(1,N,K,L,NY,NX)) - ELSE - CNOMA(N,K)=CNOMC(1,N,K) - CPOMA(N,K)=CPOMC(1,N,K) - ENDIF - OMA(N,K)=AMAX1(0.0,OMC(1,N,K,L,NY,NX)/FL(1)) - FCN(N,K)=AMIN1(1.0,AMAX1(0.50,SQRT(CNOMA(N,K)/CNOMC(1,N,K)))) - FCP(N,K)=AMIN1(1.0,AMAX1(0.50,SQRT(CPOMA(N,K)/CPOMC(1,N,K)))) - FCNP(N,K)=AMIN1(FCN(N,K),FCP(N,K)) -C -C TOTAL BIOMASS -C - IF(K.NE.5.OR.(N.LE.3.OR.N.EQ.5))THEN - TOMA=TOMA+OMA(N,K) - ENDIF - IF((K.LE.4.AND.N.EQ.2).OR.(K.EQ.5.AND.N.EQ.1))THEN - TOMN=TOMN+OMA(N,K) - ENDIF - OMC2(N,K)=AMAX1(0.0,AMIN1(OMA(N,K)*FL(2),OMC(2,N,K,L,NY,NX))) - IF(OMC(2,N,K,L,NY,NX).GT.ZEROS(NY,NX))THEN - FOM2(N,K)=AMAX1(0.0,OMC2(N,K)/OMC(2,N,K,L,NY,NX)) - OMN2(N,K)=AMAX1(0.0,FOM2(N,K)*OMN(2,N,K,L,NY,NX)) - ELSE - FOM2(N,K)=0.0 - OMN2(N,K)=0.0 - ENDIF - ENDIF -895 CONTINUE - ENDIF -890 CONTINUE - DO 690 K=0,KL - TOMK(K)=0.0 - TONK(K)=0.0 - TOPK(K)=0.0 - TONX(K)=0.0 - TOPX(K)=0.0 - DO 685 N=1,7 - TOMK(K)=TOMK(K)+OMA(N,K) - TONK(K)=TONK(K)+OMA(N,K)*CNOMA(N,K) - TOPK(K)=TOPK(K)+OMA(N,K)*CPOMA(N,K) - TONX(K)=TONX(K)+OMA(N,K)*CNOMC(1,N,K) - TOPX(K)=TOPX(K)+OMA(N,K)*CPOMC(1,N,K) -685 CONTINUE -690 CONTINUE - DO 790 K=0,KL - IF(TSRH.GT.ZEROS(NY,NX))THEN - FOSRH(K)=OSRH(K)/TSRH - ELSE - FOSRH(K)=1.0 - ENDIF -C -C DOC CONCENTRATIONS -C - IF(VOLWM(NPH,L,NY,NX).GT.ZEROS(NY,NX))THEN - IF(FOSRH(K).GT.ZERO)THEN - COQC(K,L,NY,NX)=AMAX1(0.0,OQC(K,L,NY,NX) - 2/(VOLWM(NPH,L,NY,NX)*FOSRH(K))) - COQA(K,L,NY,NX)=AMAX1(0.0,OQA(K,L,NY,NX) - 2/(VOLWM(NPH,L,NY,NX)*FOSRH(K))) - ELSE - COQC(K,L,NY,NX)=AMAX1(0.0,OQC(K,L,NY,NX)/VOLWM(NPH,L,NY,NX)) - COQA(K,L,NY,NX)=AMAX1(0.0,OQA(K,L,NY,NX)/VOLWM(NPH,L,NY,NX)) - ENDIF - ELSE - COQC(K,L,NY,NX)=0.0 - COQA(K,L,NY,NX)=0.0 - OHCQ=0.0 - ENDIF - IF(OQC(K,L,NY,NX).GT.ZEROS(NY,NX))THEN - CNQ(K)=AMAX1(0.0,OQN(K,L,NY,NX)/OQC(K,L,NY,NX)) - CPQ(K)=AMAX1(0.0,OQP(K,L,NY,NX)/OQC(K,L,NY,NX)) - ELSE - CNQ(K)=0.0 - CPQ(K)=0.0 - ENDIF - IF(OQC(K,L,NY,NX).GT.ZEROS(NY,NX).AND.OQA(K,L,NY,NX) - 2.GT.ZEROS(NY,NX))THEN - FOCA(K)=OQC(K,L,NY,NX)/(OQC(K,L,NY,NX)+OQA(K,L,NY,NX)) - FOAA(K)=1.0-FOCA(K) - ELSEIF(OQC(K,L,NY,NX).GT.ZEROS(NY,NX))THEN - FOCA(K)=1.0 - FOAA(K)=0.0 - ELSE - FOCA(K)=0.0 - FOAA(K)=1.0 - ENDIF -790 CONTINUE -C -C NITROUS ACID CONCN AND ENERGY YIELD OF HYDROGENOTROPHIC -C METHANOGENESIS AT AMBIENT H2 CONCENTRATION -C - CHY1=AMAX1(ZERO,10.0**(-(PH(L,NY,NX)-3.0))) - CHNO2=CNO2S(L,NY,NX)*CHY1/0.5 - CHNOB=CNO2B(L,NY,NX)*CHY1/0.5 - GH2X=8.3143E-03*TKS(L,NY,NX) - 2*LOG((AMAX1(1.0E-03,CH2GS(L,NY,NX))/H2KI)**4) -C -C RESPIRATION BY MICROBIAL POPULATIONS -C - TFOXYX=0.0 - TFNH4X=0.0 - TFNO3X=0.0 - TFNO2X=0.0 - TFN2OX=0.0 - TFPO4X=0.0 - TFNH4B=0.0 - TFNO3B=0.0 - TFNO2B=0.0 - TFPO4B=0.0 - TCH4H=0.0 - TCH4A=0.0 - TFOQC=0.0 - TFOQA=0.0 - TRH2G=0.0 - IF(L.NE.0)THEN - LL=L - 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.2,0.375+6.25*CNSHY) - FPSHY=AMIN1(1.2,0.375+62.5*CPSHY) - DO 760 K=0,5 - IF(L.NE.0.OR.(K.NE.3.AND.K.NE.4))THEN - TCGOQC(K)=0.0 - TCGOAC(K)=0.0 - TCGOMN(K)=0.0 - TCGOMP(K)=0.0 - DO 750 N=1,7 - IF(K.NE.5.OR.(N.LE.3.OR.N.EQ.5))THEN - IF(K.LE.4)THEN - IF(N.EQ.3)THEN - WFNG=EXP(0.1*PSISM(L,NY,NX)) - ELSE - WFNG=EXP(0.2*PSISM(L,NY,NX)) - ENDIF - OXKX=OXKM - ELSE - WFNG=EXP(0.2*PSISM(L,NY,NX)) - OXKX=OXKA - ENDIF - TFNG(N,K)=TFNX*WFNG - TFNR(N,K)=TFNY - IF(OMA(N,K).GT.0.0)THEN - IF(TOMA.GT.ZEROS(NY,NX))THEN - FOMA(N,K)=OMA(N,K)/TOMA - ELSE - FOMA(N,K)=1.0 - ENDIF - IF(TOMN.GT.ZEROS(NY,NX))THEN - FOMN(N,K)=OMA(N,K)/TOMN - ELSE - FOMN(N,K)=1.0 - ENDIF - IF(TOMK(K).GT.ZEROS(NY,NX))THEN - FOMK(N,K)=OMA(N,K)/TOMK(K) - ELSE - FOMK(N,K)=1.0 - ENDIF - IF(BKVL(L,NY,NX).GT.ZEROS(NY,NX))THEN - DOMA=OMA(N,K)/BKVL(L,NY,NX) - ELSEIF(VOLWZ.GT.ZEROS(NY,NX))THEN - DOMA=OMA(N,K)/VOLWZ - ELSE - DOMA=1.0E+06 - ENDIF - DOMA=AMAX1(0.0,DOMA-DOMX(K)) - SPOMC2=DOMA/(DOMA+DOMK) -C -C FACTORS CONSTRAINING DOC,ACETATE, O2, NH4, NO3, PO4 UPTAKE AMONG -C COMPETING MICROBIAL AND ROOT POPULATIONS IN SOIL LAYERS -C - IF(ROXYY(L,NY,NX).GT.ZEROS(NY,NX))THEN - FOXYX=AMAX1(FMN,ROXYS(N,K,L,NY,NX)/ROXYY(L,NY,NX)) - ELSE - FOXYX=AMAX1(FMN,FOMA(N,K)) - ENDIF - IF(RNH4Y(L,NY,NX).GT.ZEROS(NY,NX))THEN - FNH4X=AMAX1(FMN,RINHO(N,K,L,NY,NX)/RNH4Y(L,NY,NX)) - ELSE - FNH4X=AMAX1(FMN,FOMA(N,K)*VLNH4(L,NY,NX)) - ENDIF - IF(RNHBY(L,NY,NX).GT.ZEROS(NY,NX))THEN - FNB4X=AMAX1(FMN,RINHB(N,K,L,NY,NX)/RNHBY(L,NY,NX)) - ELSE - FNB4X=AMAX1(FMN,FOMA(N,K)*VLNHB(L,NY,NX)) - ENDIF - IF(RNO3Y(L,NY,NX).GT.ZEROS(NY,NX))THEN - FNO3X=AMAX1(FMN,RINOO(N,K,L,NY,NX)/RNO3Y(L,NY,NX)) - ELSE - FNO3X=AMAX1(FMN,FOMA(N,K)*VLNO3(L,NY,NX)) - ENDIF - IF(RN3BY(L,NY,NX).GT.ZEROS(NY,NX))THEN - FNB3X=AMAX1(FMN,RINOB(N,K,L,NY,NX)/RN3BY(L,NY,NX)) - ELSE - FNB3X=AMAX1(FMN,FOMA(N,K)*VLNOB(L,NY,NX)) - ENDIF - IF(RPO4Y(L,NY,NX).GT.ZEROS(NY,NX))THEN - FPO4X=AMAX1(FMN,RIPOO(N,K,L,NY,NX)/RPO4Y(L,NY,NX)) - ELSE - FPO4X=AMAX1(FMN,FOMA(N,K)*VLPO4(L,NY,NX)) - ENDIF - IF(RPOBY(L,NY,NX).GT.ZEROS(NY,NX))THEN - FPB4X=AMAX1(FMN,RIPOB(N,K,L,NY,NX)/RPOBY(L,NY,NX)) - ELSE - FPB4X=AMAX1(FMN,FOMA(N,K)*VLPOB(L,NY,NX)) - ENDIF - IF(K.LE.4)THEN - IF(ROQCY(K,L,NY,NX).GT.ZEROS(NY,NX))THEN - FOQC=AMAX1(FMN,ROQCS(N,K,L,NY,NX)/ROQCY(K,L,NY,NX)) - ELSE - FOQC=AMAX1(FMN,FOMK(N,K)) - ENDIF - TFOQC=TFOQC+FOQC - IF(ROQAY(K,L,NY,NX).GT.ZEROS(NY,NX))THEN - FOQA=AMAX1(FMN,ROQAS(N,K,L,NY,NX)/ROQAY(K,L,NY,NX)) - ELSE - FOQA=AMAX1(FMN,FOMK(N,K)) - ENDIF - TFOQA=TFOQA+FOQA - ENDIF - TFOXYX=TFOXYX+FOXYX - TFNH4X=TFNH4X+FNH4X - TFNO3X=TFNO3X+FNO3X - TFPO4X=TFPO4X+FPO4X - TFNH4B=TFNH4B+FNB4X - TFNO3B=TFNO3B+FNB3X - TFPO4B=TFPO4B+FPB4X -C -C FACTORS CONSTRAINING NH4, NO3, PO4 UPTAKE AMONG COMPETING -C MICROBIAL POPULATIONS IN SURFACE RESIDUE -C - IF(L.EQ.0)THEN - IF(RNH4Y(NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN - FNH4XR(N,K)=AMAX1(FMN,RINHOR(N,K,NY,NX) - 2/RNH4Y(NU(NY,NX),NY,NX)) - ELSE - FNH4XR(N,K)=0.0 - ENDIF - IF(RNO3Y(NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN - FNO3XR(N,K)=AMAX1(FMN,RINOOR(N,K,NY,NX) - 2/RNO3Y(NU(NY,NX),NY,NX)) - ELSE - FNO3XR(N,K)=0.0 - ENDIF - IF(RPO4Y(NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN - FPO4XR(N,K)=AMAX1(FMN,RIPOOR(N,K,NY,NX) - 2/RPO4Y(NU(NY,NX),NY,NX)) - ELSE - FPO4XR(N,K)=0.0 - ENDIF - ENDIF - IF(L.EQ.NU(NY,NX).AND.K.NE.3.AND.K.NE.4 - 2.AND.BKVL(0,NY,NX).GT.ZEROS(NY,NX))THEN - TFNH4X=TFNH4X+FNH4XR(N,K) - TFNO3X=TFNO3X+FNO3XR(N,K) - TFPO4X=TFPO4X+FPO4XR(N,K) - ENDIF -C -C HETEROTROPHIC BIOMASS RESPIRATION -C - IF(K.LE.4)THEN -C -C RESPIRATION BY HETEROTROPHIC AEROBES: -C N=(1)OBLIGATE AEROBES,(2)FACULTATIVE ANAEROBES,(3)FUNGI,(6)N2 FIXERS -C - IF(N.LE.3.OR.N.EQ.6)THEN -C -C ENERGY YIELDS OF REDOX REACTIONS -C - IF(N.EQ.1)THEN - EO2Q=EO2X - ELSEIF(N.EQ.2)THEN - EO2Q=EO2D - ELSEIF(N.EQ.3)THEN - EO2Q=EO2G - ELSEIF(N.EQ.6)THEN - EO2Q=ENFX - ENDIF -C -C O2-UNCONSTRAINED RESPIRATION RATES BY HETEROTROPHIC AEROBES 'RGO*Z' -C FROM SPECIFIC OXIDATION RATE, ACTIVE BIOMASS, DOC OR ACETATE - -C CONCENTRATION,MICROBIAL C:N:P FACTOR, AND TEMPERATURE FOLLOWED BY -C POTENTIAL RESPIRATION RATES 'RGO*P' WITH UNLIMITED SUBSTRATE USED -C FOR MICROBIAL COMPETITION FACTOR -C - FSBSTC=COQC(K,L,NY,NX)/(COQC(K,L,NY,NX)+OQKM) - FSBSTA=COQA(K,L,NY,NX)/(COQA(K,L,NY,NX)+OQKA) - FSBST(N,K)=FOCA(K)*FSBSTC+FOAA(K)*FSBSTA - RGOCY=AMAX1(0.0,FCNP(N,K)*VMXO*WFNG*OMA(N,K)) - RGOCZ=RGOCY*FSBSTC*FOCA(K)*TFNX - RGOAZ=RGOCY*FSBSTA*FOAA(K)*TFNX - RGOCX=AMAX1(0.0,OQC(K,L,NY,NX)*FOQC*EO2Q) - RGOAX=AMAX1(0.0,OQA(K,L,NY,NX)*FOQA*EO2A) - RGOCP=AMIN1(RGOCX,RGOCZ) - RGOAP=AMIN1(RGOAX,RGOAZ) - RGOMP=RGOCP+RGOAP - IF(RGOMP.GT.ZEROS(NY,NX))THEN - FGOCP=RGOCP/RGOMP - FGOAP=RGOAP/RGOMP - ELSE - FGOCP=1.0 - FGOAP=0.0 - ENDIF -C -C ENERGY YIELD AND O2 DEMAND FROM DOC AND ACETATE OXIDATION -C BY HETEROTROPHIC AEROBES -C - ECHZ=EO2Q*FGOCP+EO2A*FGOAP - ROXYM(N,K)=2.667*RGOMP - ROXYP(N,K)=ROXYM(N,K) - ROXYS(N,K,L,NY,NX)=ROXYP(N,K) - ROQCS(N,K,L,NY,NX)=RGOCZ - ROQAS(N,K,L,NY,NX)=RGOAZ - ROQCD(N,K)=RGOCY -C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.LE.1)THEN -C WRITE(*,5555)'RGOMP',I,J,NX,NY,L,K,N,RGOMP,RGOCX,RGOAX,RGOCZ -C 2,RGOAZ,RGOCX,RGOAX,FCNP(N,K),TFNG(N,K),VMXO,OMA(N,K),FOQC,FOQA -C 2,COQC(K,L,NY,NX),OQC(K,L,NY,NX),EO2Q,TKS(L,NY,NX),COXYS(L,NY,NX) -C 3,OQKM,OMC(1,N,K,L,NY,NX),OMC(2,N,K,L,NY,NX),OMC(3,N,K,L,NY,NX) -C 3,VOLWM(NPH,L,NY,NX),FOSRH(K),DOMA,SPOMC2,FSBST(N,K),ROQCD(N,K) -5555 FORMAT(A8,7I4,60E12.4) -C ENDIF -C -C RESPIRATION BY HETEROTROPHIC ANAEROBES: -C N=(4)ACETOGENIC FERMENTERS (7) ACETOGENIC N2 FIXERS -C -C -C ENERGY YIELD FROM FERMENTATION DEPENDS ON H2 CONCENTRATION -C - ELSEIF(N.EQ.4.OR.N.EQ.7)THEN - GH2F=GH2X/72.0 - GOAX=8.3143E-03*TKS(L,NY,NX) - 2*LOG((AMAX1(ZERO,COQA(K,L,NY,NX))/OAKI)**2) - GOAF=GOAX/72.0 - GHAX=GH2F+GOAF - IF(N.EQ.4)THEN - ECHZ=AMAX1(EO2X,AMIN1(1.0,1.0 - 2/(1.0+AMAX1(0.0,(GCHX-GHAX))/EOMF))) - ELSE - ECHZ=AMAX1(ENFX,AMIN1(1.0,1.0 - 2/(1.0+AMAX1(0.0,(GCHX-GHAX))/EOMN))) - ENDIF -C -C RESPIRATION RATES BY HETEROTROPHIC ANAEROBES 'RGOMP' FROM SPECIFIC -C OXIDATION RATE, ACTIVE BIOMASS, DOC CONCENTRATION, -C MICROBIAL C:N:P FACTOR, AND TEMPERATURE FOLLOWED BY POTENTIAL -C RESPIRATION RATES 'RGOMP' WITH UNLIMITED SUBSTRATE USED FOR MICROBIAL -C COMPETITION FACTOR -C - FSBST(N,K)=COQC(K,L,NY,NX)/(COQC(K,L,NY,NX)+OQKM)*OXYI - SPOMC2=SPOMC2*OXYI - RGOFY=AMAX1(0.0,FCNP(N,K)*VMXF*WFNG*OMA(N,K)) - RGOFZ=RGOFY*FSBST(N,K)*TFNX - RGOFX=AMAX1(0.0,OQC(K,L,NY,NX)*FOQC*ECHZ) - RGOMP=AMIN1(RGOFX,RGOFZ) - FGOCP=1.0 - FGOAP=0.0 - ROXYM(N,K)=0.0 - ROXYP(N,K)=0.0 - ROXYS(N,K,L,NY,NX)=0.0 - ROQCS(N,K,L,NY,NX)=RGOFZ - ROQAS(N,K,L,NY,NX)=0.0 - ROQCD(N,K)=RGOFY - TRH2G=TRH2G+RGOMP -C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.LE.4)THEN -C WRITE(*,5554)'FERM',I,J,NX,NY,L,K,N,RGOMP,RGOFX,RGOFZ,GHAX,GOAF -C 2,ECHZ,FCNP(N,K),TFNG(N,K),OMA(N,K),FOQC,COQC(K,L,NY,NX),OQC(K,L,NY,NX) -C 3,OQKM,OMC(1,N,K,L,NY,NX),OMC(2,N,K,L,NY,NX),OMC(3,N,K,L,NY,NX) -C 3,OMN(1,N,K,L,NY,NX),OMN(2,N,K,L,NY,NX),OMN(3,N,K,L,NY,NX) -C 5,VOLWM(NPH,L,NY,NX),PSISM(L,NY,NX),WFNG,COXYS(L,NY,NX),OXYI -C 6,FSBST(N,K),FOSRH(K),DOMA,SPOMC2,ROQCD(N,K) -5554 FORMAT(A8,7I4,60E12.4) -C ENDIF -C -C ENERGY YIELD FROM ACETOTROPHIC METHANOGENESIS -C - ELSEIF(N.EQ.5)THEN - GOMX=8.3143E-03*TKS(L,NY,NX) - 2*LOG((AMAX1(ZERO,COQA(K,L,NY,NX))/OAKI)) - GOMM=GOMX/24.0 - ECHZ=AMAX1(EO2X,AMIN1(1.0,1.0/(1.0+AMAX1(0.0,(GC4X+GOMM))/EOMH))) -C -C RESPIRATION RATES BY ACETOTROPHIC METHANOGENS 'RGOMP' FROM SPECIFIC -C OXIDATION RATE, ACTIVE BIOMASS, DOC CONCENTRATION, -C MICROBIAL C:N:P FACTOR, AND TEMPERATURE FOLLOWED BY POTENTIAL C -C RESPIRATION RATES 'RGOMP' WITH UNLIMITED SUBSTRATE USED FOR -C MICROBIAL COMPETITION FACTOR -C - FSBST(N,K)=COQA(K,L,NY,NX)/(COQA(K,L,NY,NX)+OQKAM) - RGOGY=AMAX1(0.0,FCNP(N,K)*VMXM*WFNG*OMA(N,K)) - RGOGZ=RGOGY*FSBST(N,K)*TFNX - RGOGX=AMAX1(0.0,OQA(K,L,NY,NX)*FOQA*ECHZ) - RGOMP=AMIN1(RGOGX,RGOGZ) - FGOCP=0.0 - FGOAP=1.0 - ROXYM(N,K)=0.0 - ROXYP(N,K)=0.0 - ROXYS(N,K,L,NY,NX)=0.0 - ROQCS(N,K,L,NY,NX)=0.0 - ROQAS(N,K,L,NY,NX)=RGOGZ - ROQCD(N,K)=0.0 - TCH4H=TCH4H+0.5*RGOMP -C IF((I/30)*30.EQ.I.AND.NX.EQ.3.AND.NY.EQ.1.AND.J.EQ.24)THEN -C WRITE(*,5552)'ACMETH',I,J,NX,NY,L,K,N,RGOMP,RGOGZ,RGOGX,GOMM -C 2,ECHZ,FCNP(N,K),TFNG(N,K),OMA(N,K),FOQA,COQA(K,L,NY,NX),OQA(K,L,NY,NX) -C 3,OMC(1,N,K,L,NY,NX),OMC(2,N,K,L,NY,NX),OMC(3,N,K,L,NY,NX) -C 3,OMN(1,N,K,L,NY,NX),OMN(2,N,K,L,NY,NX),OMN(3,N,K,L,NY,NX) -C 5,VOLWM(NPH,L,NY,NX),PSISM(L,NY,NX),WFNG,COXYS(L,NY,NX) -C 6,OHA(K,L,NY,NX),FSBST(N,K),SPOMC2 -5552 FORMAT(A8,7I4,40E12.4) -C ENDIF - ENDIF -C -C RESPIRATION RATES BY AUTOTROPHS 'RGOMP' FROM SPECIFIC -C OXIDATION RATE, ACTIVE BIOMASS, DOC CONCENTRATION, -C MICROBIAL C:N:P FACTOR, AND TEMPERATURE FOLLOWED BY POTENTIAL -C RESPIRATION RATES 'RGOMP' WITH UNLIMITED SUBSTRATE USED FOR MICROBIAL -C COMPETITION FACTOR. N=(1) NH4 OXIDIZERS (2) NO2 OXIDIZERS, -C (3) CH4 OXIDIZERS, (5) H2TROPHIC METHANOGENS -C - ELSEIF(K.EQ.5)THEN - XCO2=CCO2S(L,NY,NX)/(CCO2S(L,NY,NX)+CCKM) - CNH3SI=1.0+CNH3S(L,NY,NX)/C3KI - CNH3BI=1.0+CNH3B(L,NY,NX)/C3KI -C -C NH3 OXIDIZERS -C - IF(N.EQ.1)THEN -C -C FACTOR TO REGULATE COMPETITION FOR NH4 AMONG DIFFERENT -C MICROBIAL AND ROOT POPULATIONS -C - IF(RNH4Y(L,NY,NX).GT.ZEROS(NY,NX))THEN - FNH4=AMAX1(FMN,RVMX4(N,K,L,NY,NX)/RNH4Y(L,NY,NX)) - ELSE - FNH4=AMAX1(FMN,VLNH4(L,NY,NX)*FOMA(N,K)) - ENDIF - IF(RNHBY(L,NY,NX).GT.ZEROS(NY,NX))THEN - FNB4=AMAX1(FMN,RVMB4(N,K,L,NY,NX)/RNHBY(L,NY,NX)) - ELSE - FNB4=AMAX1(FMN,VLNHB(L,NY,NX)*FOMA(N,K)) - ENDIF - TFNH4X=TFNH4X+FNH4 - TFNH4B=TFNH4B+FNB4 -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)/CNH3SI - FCN3B=FNHBS*CNH3B(L,NY,NX)/(CNH3B(L,NY,NX)+ZHKM)/CNH3BI - FSBST(N,K)=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))) - 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 -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.4)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,RNFNG,ZNFNI(L,NY,NX),ZNFNG(L,NY,NX),ZNFNA -C 9,SPOMC2,DOMA,DOMX(K),DOMK,BKVL(L,NY,NX) -6666 FORMAT(A8,5I4,40E12.4) -C ENDIF -C -C NO2 OXIDIZERS -C - ELSEIF(N.EQ.2)THEN -C -C FACTOR TO REGULATE COMPETITION FOR NO2 AMONG DIFFERENT -C MICROBIAL POPULATIONS -C - IF(RNO2Y(L,NY,NX).GT.ZEROS(NY,NX))THEN - FNO2=AMAX1(FMN,RVMX2(N,K,L,NY,NX)/RNO2Y(L,NY,NX)) - ELSE - FNO2=AMAX1(FMN,FOMN(N,K)*VLNO3(L,NY,NX)) - ENDIF - IF(RN2BY(L,NY,NX).GT.ZEROS(NY,NX))THEN - FNB2=AMAX1(FMN,RVMB2(N,K,L,NY,NX)/RN2BY(L,NY,NX)) - ELSE - FNB2=AMAX1(FMN,FOMN(N,K)*VLNOB(L,NY,NX)) - ENDIF - TFNO2X=TFNO2X+FNO2 - TFNO2B=TFNO2B+FNB2 -C -C NO2 OXIDATION FROM SPECIFIC OXIDATION RATE, ENERGY YIELD, -C ACTIVE OXIDIZER BIOMASS, TEMPERATURE, AQUEOUS CO2 AND -C NO2 CONCENTRATIONS -C - ECHZ=EO2X - VMXA=TFNG(N,K)*FCNP(N,K)*XCO2*OMA(N,K)*VMXN - FCN2S=FNH4S*CNO2S(L,NY,NX)/(CNO2S(L,NY,NX)+ZNKM)/CNH3SI - FCN2B=FNHBS*CNO2B(L,NY,NX)/(CNO2B(L,NY,NX)+ZNKM)/CNH3BI - FSBST(N,K)=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))) - 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 -C -C O2 DEMAND FROM NO2 OXIDATION -C - ROXYM(N,K)=2.667*RGOMP - ROXYP(N,K)=ROXYM(N,K)+1.143*RVOXP - ROXYS(N,K,L,NY,NX)=ROXYP(N,K) -C IF((I/30)*30.EQ.I.AND.J.EQ.15.AND.L.LE.6)THEN -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 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) -C 7,DOMA,SPOMC2 -6667 FORMAT(A8,5I4,50E12.4) -C ENDIF -C -C H2TROPHIC METHANOGENS -C - ELSEIF(N.EQ.5)THEN -C -C CO2 REDUCTION FROM SPECIFIC REDUCTION RATE, ENERGY YIELD, -C ACTIVE OXIDIZER BIOMASS, TEMPERATURE, AQUEOUS CO2 AND -C - GH2H=GH2X/12.0 - ECHZ=AMAX1(EO2X,AMIN1(1.0,1.0/(1.0+AMAX1(0.0,(GCOX+GH2H))/EOMH))) - VMXA=TFNG(N,K)*FCNP(N,K)*XCO2*OMA(N,K)*VMXC - H2GSX=H2GS(L,NY,NX)+0.111*TRH2G - FSBST(N,K)=CH2GS(L,NY,NX)/(CH2GS(L,NY,NX)+H2KM) - RGOMP=AMAX1(0.0,AMIN1(1.5*H2GSX,VMXA*FSBST(N,K))) - ROXYM(N,K)=0.0 - ROXYM(N,K)=0.0 - ROXYS(N,K,L,NY,NX)=0.0 - TCH4A=TCH4A+RGOMP -C IF((I/30)*30.EQ.I.AND.NX.EQ.3.AND.NY.EQ.1.AND.J.EQ.24)THEN -C WRITE(*,5553)'H2METH',I,J,NX,NY,L,K,N,RGOMP,H2GS(L,NY,NX) -C 2,H2GSX,CH2GS(L,NY,NX),VMXA,TFNG(N,K),FCNP(N,K),XCO2 -C 3,OMA(N,K),VMXC,ECHZ,GCOX,GH2H,TKS(L,NY,NX),FSBST(N,K),SPOMC2 -5553 FORMAT(A8,7I4,20E12.4) -C ENDIF -C -C METHANOTROPHS -C - ELSEIF(N.EQ.3)THEN -C -C CH4 OXIDATION FROM SPECIFIC OXIDATION RATE, ENERGY YIELD, -C ACTIVE OXIDIZER BIOMASS, TEMPERATURE, AQUEOUS CO2 AND -C CH4 CONCENTRATIONS IN BAND AND NON-BAND SOIL ZONES -C - ECHZ=EO2X - VMXA=TFNG(N,K)*FCNP(N,K)*OMA(N,K)*VMX4 - RCH4L1=RCH4L(L,NY,NX)*XNPG - RCH4F1=RCH4F(L,NY,NX)*XNPG - RCH4S1=(TCH4H+TCH4A)*XNPG - IF(L.EQ.0)THEN - CH4G1=CCH4E(NY,NX)*VOLPM(1,L,NY,NX) - ELSE - CH4G1=CCH4G(L,NY,NX)*VOLPM(1,L,NY,NX) - ENDIF - CH4S1=CH4S(L,NY,NX) - VMXA1=VMXA*XNPG - RVOXP=0.0 - RGOMP=0.0 -C -C CH4 DISSOLUTION FROM GASEOUS PHASE SOLVED IN SHORTER TIME STEP -C TO MAINTAIN AQUEOUS CH4 CONCENTRATION DURING OXIDATION -C - DO 320 M=1,NPH - IF(VOLWM(M,L,NY,NX).GT.ZEROS(NY,NX))THEN - VOLWCH=VOLWM(M,L,NY,NX)*SCH4L(L,NY,NX) - VOLWPM=VOLWCH+VOLPM(M,L,NY,NX) - DO 325 MM=1,NPT - CH4G1=CH4G1+RCH4F1 - CH4S1=CH4S1+RCH4L1+RCH4S1 - CCH4S1=AMAX1(0.0,CH4S1/VOLWM(M,L,NY,NX)) - FSBST(N,K)=CCH4S1/(CCH4S1+CCK4) - RVOXP1=AMIN1(AMAX1(0.0,CH4S1)/(1.0+ECHO*ECHZ) - 2,VMXA1*FSBST(N,K)) - RGOMP1=RVOXP1*ECHO*ECHZ - CH4S1=CH4S1-RVOXP1-RGOMP1 - IF(THETPM(M,L,NY,NX).GT.THETX)THEN - RCHDF=DFGS(M,L,NY,NX)*(AMAX1(ZEROS(NY,NX),CH4G1)*VOLWCH - 2-CH4S1*VOLPM(M,L,NY,NX))/VOLWPM - ELSE - RCHDF=0.0 - ENDIF - CH4G1=CH4G1-RCHDF - CH4S1=CH4S1+RCHDF - RVOXP=RVOXP+RVOXP1 - RGOMP=RGOMP+RGOMP1 -C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.EQ.0 -C 2.AND.MM.EQ.NPT)THEN -C WRITE(*,5547)'CH4OX',I,J,NX,NY,L,K,N,M,MM,RVOXP1,RGOMP1,CH4G1 -C 2,CH4S1,VMXA1,RVOXP,RGOMP,RCHDF,RCH4L1,RCH4F1,RCH4S1,CCH4S1 -C 3,ECHO,ECHZ,OMA(N,K),VOLWM(M,L,NY,NX),VOLPM(M,L,NY,NX),VOLWCH -C 4,THETPM(M,L,NY,NX),SCH4L(L,NY,NX),DFGS(M,L,NY,NX) -C 5,COXYS(L,NY,NX),CCH4E(NY,NX),FSBST(N,K),SPOMC2 -C 6,CH4G1/VOLPM(M,L,NY,NX) -5547 FORMAT(A8,9I4,30E12.4) -C ENDIF -325 CONTINUE - ENDIF -320 CONTINUE - RVOXPA=RVOXP - RVOXPB=0.0 -C -C O2 DEMAND FROM CH4 OXIDATION -C - ROXYM(N,K)=2.667*RGOMP - ROXYP(N,K)=ROXYM(N,K)+4.00*RVOXP - ROXYS(N,K,L,NY,NX)=ROXYP(N,K) - ELSE - RGOMP=0.0 - ROXYM(N,K)=0.0 - ROXYP(N,K)=0.0 - ROXYS(N,K,L,NY,NX)=0.0 - ENDIF - ELSE - RGOMP=0.0 - ROXYM(N,K)=0.0 - ROXYP(N,K)=0.0 - ROXYS(N,K,L,NY,NX)=0.0 - ENDIF -C -C O2 UPTAKE BY AEROBES -C - RUPOX(N,K)=0.0 - IF(N.LE.3.OR.N.EQ.6)THEN - IF(ROXYP(N,K).GT.ZEROS(NY,NX).AND.FOXYX.GT.ZERO)THEN - IF(L.NE.0.OR.VOLX(L,NY,NX).GT.ZEROS(NY,NX))THEN -C -C MAXIMUM O2 UPAKE FROM POTENTIAL RESPIRATION OF EACH AEROBIC -C POPULATION -C - RUPMX=ROXYP(N,K)*XNPG - ROXYFX=ROXYF(L,NY,NX)*XNPG*FOXYX - OLSGL1=OLSGL(L,NY,NX)*XNPG - IF(L.NE.0)THEN - OXYG1=OXYG(L,NY,NX)*FOXYX - ROXYLX=ROXYL(L,NY,NX)*XNPG*FOXYX - ELSE - OXYG1=COXYG(L,NY,NX)*VOLPM(1,L,NY,NX)*FOXYX - ROXYLX=(ROXYL(L,NY,NX)+FLQRQ(NY,NX)*COXR(NY,NX) - 2+FLQRI(NY,NX)*COXQ(NY,NX))*XNPG*FOXYX - ENDIF - OXYS1=OXYS(L,NY,NX)*FOXYX -C -C O2 DISSOLUTION FROM GASEOUS PHASE SOLVED IN SHORTER TIME STEP -C TO MAINTAIN AQUEOUS O2 CONCENTRATION DURING REDUCTION -C - DO 420 M=1,NPH -C -C ACTUAL REDUCTION OF AQUEOUS BY AEROBES CALCULATED -C FROM MASS FLOW PLUS DIFFUSION = ACTIVE UPTAKE -C COUPLED WITH DISSOLUTION OF GASEOUS O2 DURING REDUCTION -C OF AQUEOUS O2 FROM DISSOLUTION RATE CONSTANT 'DFGS' -C CALCULATED IN 'WATSUB' -C - THETW1=AMAX1(0.0,VOLWM(M,L,NY,NX)/VOLX(L,NY,NX)) - RRADO=ORAD*(FILM(M,L,NY,NX)+ORAD)/FILM(M,L,NY,NX) - DIFOX=TORT(L,NY,NX)*OLSGL1*12.57*BIOS*OMA(N,K)*RRADO - VOLWOX=VOLWM(M,L,NY,NX)*SOXYL(L,NY,NX) - VOLPOX=VOLPM(M,L,NY,NX) - VOLWPM=VOLWOX+VOLPOX - DO 425 MX=1,NPT - OXYG1=OXYG1+ROXYFX - OXYS1=OXYS1+ROXYLX - COXYS1=AMIN1(COXYE(NY,NX)*SOXYL(L,NY,NX) - 2,AMAX1(0.0,OXYS1/(VOLWM(M,L,NY,NX)*FOXYX))) - X=DIFOX*COXYS1 - IF(X.GT.ZEROS(NY,NX).AND.OXYS1.GT.ZEROS(NY,NX))THEN - B=-RUPMX-DIFOX*OXKX-X - C=X*RUPMX - RMPOX=(-B-SQRT(B*B-4.0*C))/2.0 - ELSE - RMPOX=0.0 - ENDIF - OXYS1=OXYS1-RMPOX - IF(THETPM(M,L,NY,NX).GT.THETX.AND.VOLPOX.GT.ZEROS(NY,NX))THEN - ROXDFQ=DFGS(M,L,NY,NX)*(AMAX1(ZEROS(NY,NX),OXYG1)*VOLWOX - 2-OXYS1*VOLPOX)/VOLWPM - ELSE - ROXDFQ=0.0 - ENDIF - OXYG1=OXYG1-ROXDFQ - OXYS1=OXYS1+ROXDFQ - RUPOX(N,K)=RUPOX(N,K)+RMPOX - ROXSK(M,L,NY,NX)=ROXSK(M,L,NY,NX)+RMPOX -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 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) -C ENDIF -C IF((I/10)*10.EQ.I.AND.J.EQ.16.AND.L.EQ.NU(NY,NX) -C 2.AND.K.EQ.4.AND.N.EQ.2)THEN -C WRITE(*,5544)'OXY',I,J,L,K,N,M,MX,RUPOX(N,K),ROXYP(N,K) -C 2,ROXSK(M,L,NY,NX),RUPMX,RMPOX,DIFOX,OLSGL1,BIOS,OMA(N,K),X -C 2,ROXDFQ,ROXYLX,ROXYFX,FOXYX,COXYS1,OXYS1,OXYG1,OXYS1 -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 -5544 FORMAT(A8,7I4,50E12.4) -C ENDIF -425 CONTINUE -420 CONTINUE -C -C RATIO OF ACTUAL O2 UPAKE TO BIOLOGICAL DEMAND -C - WFN(N,K)=AMIN1(1.0,AMAX1(0.0,RUPOX(N,K)/ROXYP(N,K))) - IF(K.LE.4)THEN - ROQCS(N,K,L,NY,NX)=ROQCS(N,K,L,NY,NX)*WFN(N,K) - ROQAS(N,K,L,NY,NX)=ROQAS(N,K,L,NY,NX)*WFN(N,K) - ROQCD(N,K)=ROQCD(N,K)*WFN(N,K) - ENDIF - IF(K.EQ.5)THEN - IF(N.EQ.1)THEN - RVMX4(N,K,L,NY,NX)=RVMX4(N,K,L,NY,NX)*WFN(N,K) - RVMB4(N,K,L,NY,NX)=RVMB4(N,K,L,NY,NX)*WFN(N,K) - ELSEIF(N.EQ.2)THEN - RVMX2(N,K,L,NY,NX)=RVMX2(N,K,L,NY,NX)*WFN(N,K) - RVMB2(N,K,L,NY,NX)=RVMB2(N,K,L,NY,NX)*WFN(N,K) - ENDIF - ENDIF - ELSE - RUPOX(N,K)=ROXYP(N,K) - WFN(N,K)=1.0 - ENDIF - ELSE - RUPOX(N,K)=0.0 - WFN(N,K)=1.0 - ENDIF -C -C RESPIRATION PRODUCTS ALLOCATED TO O2, CO2, ACETATE, CH4, H2 -C - RGOMO(N,K)=RGOMP*WFN(N,K) - RCO2X(N,K)=RGOMO(N,K) - RCH3X(N,K)=0.0 - RCH4X(N,K)=0.0 - ROXYO(N,K)=ROXYM(N,K)*WFN(N,K) - RH2GX(N,K)=0.0 - IF(K.EQ.5)THEN - RVOXA(N)=RVOXPA*WFN(N,K) - RVOXB(N)=RVOXPB*WFN(N,K) - ENDIF - ELSEIF(N.EQ.4.OR.N.EQ.7)THEN - RGOMO(N,K)=RGOMP - RCO2X(N,K)=0.333*RGOMO(N,K) - RCH3X(N,K)=0.667*RGOMO(N,K) - RCH4X(N,K)=0.0 - ROXYO(N,K)=ROXYM(N,K) - IF(K.LE.4)THEN - RH2GX(N,K)=0.111*RGOMO(N,K) - ELSE - RH2GX(N,K)=0.0 - ENDIF - ELSEIF(N.EQ.5)THEN - RGOMO(N,K)=RGOMP - IF(K.LE.4)THEN - RCO2X(N,K)=0.50*RGOMO(N,K) - RCH3X(N,K)=0.00 - RCH4X(N,K)=0.50*RGOMO(N,K) - ROXYO(N,K)=ROXYM(N,K) - RH2GX(N,K)=0.0 - ELSEIF(K.EQ.5)THEN - RCO2X(N,K)=0.00 - RCH3X(N,K)=0.00 - RCH4X(N,K)=RGOMO(N,K) - ROXYO(N,K)=ROXYM(N,K) - RH2GX(N,K)=0.0 - RH2GZ=0.667*RGOMO(N,K) - ENDIF - ENDIF -C -C HETEROTROPHIC DENITRIFICATION -C - IF(K.LE.4.AND.N.EQ.2.AND.ROXYM(N,K).GT.0.0 - 2.AND.(L.NE.0.OR.VOLX(L,NY,NX).GT.ZEROS(NY,NX)))THEN -C -C FACTOR TO CONSTRAIN NO3 UPAKE AMONG COMPETING MICROBIAL -C AND ROOT POPULATIONS -C - IF(RNO3Y(L,NY,NX).GT.ZEROS(NY,NX))THEN - FNO3=AMAX1(FMN,RVMX3(N,K,L,NY,NX)/RNO3Y(L,NY,NX)) - ELSE - FNO3=AMAX1(FMN,FOMA(N,K)*VLNO3(L,NY,NX)) - ENDIF - IF(RN3BY(L,NY,NX).GT.ZEROS(NY,NX))THEN - FNB3=AMAX1(FMN,RVMB3(N,K,L,NY,NX)/RN3BY(L,NY,NX)) - ELSE - FNB3=AMAX1(FMN,FOMA(N,K)*VLNOB(L,NY,NX)) - ENDIF - TFNO3X=TFNO3X+FNO3 - TFNO3B=TFNO3B+FNB3 -C -C NO3 REDUCTION FROM SPECIFIC REDUCTION RATE, ENERGY YIELD, -C ACTIVE DENITRIFIER BIOMASS, TEMPERATURE, AQUEOUS NO3 -C CONCENTRATIONS AND STOICHIOMETRY OF REDOX ELECTRON TRANSFER -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).GT.ZERO)THEN - VMXD3=VMXDX/(1.0+VMKI*ROXYD/(VOLWZ*FOSRH(K))) - ELSE - VMXD3=0.0 - ENDIF - IF(CNO3S(L,NY,NX).GT.ZERO)THEN - VMXD3S=VMXD3*FNO3S*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 - ENDIF - IF(CNO3B(L,NY,NX).GT.ZERO)THEN - VMXD3B=VMXD3*FNO3B*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 - ENDIF - OQCZ3=AMAX1(0.0,OQC(K,L,NY,NX)*FOQC-RGOCP*WFN(N,K)) - OQCD3=OQCZ3/ECN3 - OQCD3S=OQCD3*FNO3S - OQCD3B=OQCD3*FNO3B - ZNO3SX=ZNO3S(L,NY,NX)*FNO3 - ZNO3BX=ZNO3B(L,NY,NX)*FNB3 - RDNO3X=AMAX1(0.0,AMIN1(ZNO3SX,VMXD3S)) - RDNOBX=AMAX1(0.0,AMIN1(ZNO3BX,VMXD3B)) - RDNO3(N,K)=AMAX1(0.0,AMIN1(VMXD3S,OQCD3S,ZNO3SX)) - RDNOB(N,K)=AMAX1(0.0,AMIN1(VMXD3B,OQCD3B,ZNO3BX)) - RDNOX=RDNO3X+RDNOBX - RDNOT=RDNO3(N,K)+RDNOB(N,K) - RGOM3X=ECN3*RDNOX - RGOMD3=ECN3*RDNOT - RVMX3(N,K,L,NY,NX)=VMXD3S - RVMB3(N,K,L,NY,NX)=VMXD3B -C -C FACTOR TO CONSTRAIN NO2 UPAKE AMONG COMPETING MICROBIAL -C POPULATIONS -C - IF(RNO2Y(L,NY,NX).GT.ZEROS(NY,NX))THEN - FNO2=AMAX1(FMN,RVMX2(N,K,L,NY,NX)/RNO2Y(L,NY,NX)) - ELSE - FNO2=AMAX1(FMN,FOMA(N,K)*VLNO3(L,NY,NX)) - ENDIF - IF(RN2BY(L,NY,NX).GT.ZEROS(NY,NX))THEN - FNB2=AMAX1(FMN,RVMB2(N,K,L,NY,NX)/RN2BY(L,NY,NX)) - ELSE - FNB2=AMAX1(FMN,FOMA(N,K)*VLNOB(L,NY,NX)) - ENDIF - TFNO2X=TFNO2X+FNO2 - TFNO2B=TFNO2B+FNB2 -C -C NO2 REDUCTION FROM SPECIFIC REDUCTION RATE, ENERGY YIELD, -C ACTIVE DENITRIFIER BIOMASS, TEMPERATURE, AQUEOUS NO2 -C CONCENTRATIONS AND STOICHIOMETRY OF REDOX ELECTRON TRANSFER -C NOT ACCEPTED BY O2 AND NO3 IN BAND AND NON-BAND SOIL ZONES -C - VMXD2=VMXD3-RDNOT - IF(CNO2S(L,NY,NX).GT.ZERO)THEN - VMXD2S=VMXD2*FNO3S*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 - ENDIF - IF(CNO2B(L,NY,NX).GT.ZERO)THEN - VMXD2B=VMXD2*FNO3B*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 - ENDIF - OQCZ2=AMAX1(0.0,OQCZ3-RGOMD3) - OQCD2=OQCZ2/ECN2 - OQCD2S=OQCD2*FNO3S - OQCD2B=OQCD2*FNO3B - ZNO2SX=(ZNO2S(L,NY,NX)+RDNO3(N,K))*FNO2 - ZNO2BX=(ZNO2B(L,NY,NX)+RDNOB(N,K))*FNB2 - RDNO2X=AMAX1(0.0,AMIN1(ZNO2SX,VMXD2S)) - RDNOBX=AMAX1(0.0,AMIN1(ZNO2BX,VMXD2B)) - RDNO2(N,K)=AMAX1(0.0,AMIN1(VMXD2S,OQCD2S,ZNO2SX)) - RDN2B(N,K)=AMAX1(0.0,AMIN1(VMXD2B,OQCD2B,ZNO2BX)) - RDN2X=RDNO2X+RDNOBX - RDN2T=RDNO2(N,K)+RDN2B(N,K) - RGOM2X=ECN2*RDN2X - RGOMD2=ECN2*RDN2T - RVMX2(N,K,L,NY,NX)=VMXD2S - RVMB2(N,K,L,NY,NX)=VMXD2B -C -C FACTOR TO CONSTRAIN N2O UPAKE AMONG COMPETING MICROBIAL -C AND ROOT POPULATIONS -C - IF(RN2OY(L,NY,NX).GT.ZEROS(NY,NX))THEN - FN2O=AMAX1(FMN,RVMX1(N,K,L,NY,NX)/RN2OY(L,NY,NX)) - ELSE - FN2O=AMAX1(FMN,FOMA(N,K)) - ENDIF - TFN2OX=TFN2OX+FN2O -C -C N2O REDUCTION FROM SPECIFIC REDUCTION RATE, ENERGY YIELD, -C ACTIVE DENITRIFIER BIOMASS, TEMPERATURE, AQUEOUS N2O -C CONCENTRATIONS AND STOICHIOMETRY OF REDOX ELECTRON TRANSFER -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) - OQCZ1=AMAX1(0.0,OQCZ2-RGOMD2) - OQCD1=OQCZ1/ECN1 - Z2OSX=(Z2OS(L,NY,NX)+RDN2T)*FN2O - RDN2OX=AMAX1(0.0,AMIN1(Z2OSX,VMXD1S)) - RDN2O(N,K)=AMAX1(0.0,AMIN1(VMXD1S,OQCD1,Z2OSX)) - RGOM1X=ECN1*RDN2OX - RGOMD1=ECN1*RDN2O(N,K) - RGOMY(N,K)=RGOM3X+RGOM2X+RGOM1X - RGOMD(N,K)=RGOMD3+RGOMD2+RGOMD1 - RVMX1(N,K,L,NY,NX)=VMXD1S -C IF(J.EQ.16)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),COXYS(L,NY,NX),COXYG(L,NY,NX),ROXYM(N,K) -C 3,ROXYO(N,K),OMA(N,K),VMXD,CNO3S(L,NY,NX),CNO3B(L,NY,NX) -C 4,CNO2S(L,NY,NX),CNO2B(L,NY,NX),CZ2OS(L,NY,NX),VLNO3(L,NY,NX) -C 5,VLNOB(L,NY,NX),THETW(L,NY,NX),THETI(L,NY,NX),FOMA(N,K) -C 5,ZNO3S(L,NY,NX),ZNO3B(L,NY,NX),ZNO2S(L,NY,NX),ZNO2B(L,NY,NX) -C 6,Z2OS(L,NY,NX),RGOMY(N,K),RGOMD(N,K),TOMA,FOXYX,FNO23S,FNO23B -C 7,OQC(K,L,NY,NX),FOQC,RGOCP,WFN(N,K),VOLWZ,FOSRH(K),ZERO -C 9,RGOM3X,RGOM2X,RGOM1X,FNO3,FNO2,FN2O,ZNO3SX,ZNO2SX,Z2OSX -C 3,OQCD3S,OQCD2S,OQCD1,VMXD3S,VMXD2S,VMXD1S,VMXD3,VMXD2,VMXD1 -C 4,ROXYD,VMXDX,TFNX,WFNG,TFNG(N,K),PSISM(L,NY,NX) -C 2,(1.0+(CNO2S(L,NY,NX)*Z3KM)/(CNO3S(L,NY,NX)*Z2KM)) -C 2,(1.0+(CZ2OS(L,NY,NX)*Z2KM)/(CNO2S(L,NY,NX)*Z1KM)) -2222 FORMAT(A8,5I4,70E12.4) -C ENDIF -C -C AUTOTROPHIC DENITRIFICATION -C - ELSEIF(K.EQ.5.AND.N.EQ.1.AND.ROXYM(N,K).GT.0.0 - 2.AND.(L.NE.0.OR.VOLX(L,NY,NX).GT.ZEROS(NY,NX)))THEN -C -C FACTOR TO CONSTRAIN NO2 UPAKE AMONG COMPETING MICROBIAL -C POPULATIONS -C - IF(RNO2Y(L,NY,NX).GT.ZEROS(NY,NX))THEN - FNO2=AMAX1(FMN,RVMX2(N,K,L,NY,NX)/RNO2Y(L,NY,NX)) - ELSE - FNO2=AMAX1(FMN,FOMN(N,K)*VLNO3(L,NY,NX)) - ENDIF - IF(RN2BY(L,NY,NX).GT.ZEROS(NY,NX))THEN - FNB2=AMAX1(FMN,RVMB2(N,K,L,NY,NX)/RN2BY(L,NY,NX)) - ELSE - FNB2=AMAX1(FMN,FOMN(N,K)*VLNOB(L,NY,NX)) - ENDIF - TFNO2X=TFNO2X+FNO2 - TFNO2B=TFNO2B+FNB2 -C -C NO2 REDUCTION FROM SPECIFIC REDUCTION RATE, ENERGY YIELD, -C ACTIVE NITRIFIER BIOMASS, TEMPERATURE, AQUEOUS NO2 AND CO2 -C CONCENTRATIONS AND STOICHIOMETRY OF REDOX ELECTRON TRANSFER -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)) - 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 - RVOXA(N)=RVOXA(N)+0.333*RDNO2(N,K) - RVOXB(N)=RVOXB(N)+0.333*RDN2B(N,K) -C IF((I/10)*10.EQ.I.AND.J.EQ.14)THEN -C WRITE(*,7777)'AUTO',I,J,L,K,N,RDNO2(N,K),RDN2B(N,K) -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,VMXD,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,VMXDX,VMXDA,RVOXA(N),RVOXB(N) -7777 FORMAT(A8,5I4,40E12.4) -C ENDIF - ELSE - RDNO3(N,K)=0.0 - RDNOB(N,K)=0.0 - RDNO2(N,K)=0.0 - RDN2B(N,K)=0.0 - RDN2O(N,K)=0.0 - RGOMY(N,K)=0.0 - RGOMD(N,K)=0.0 - ENDIF -C -C BIOMASS DECOMPOSITION AND MINERALIZATION -C -C -C MINERALIZATION-IMMOBILIZATION OF NH4 IN SOIL FROM MICROBIAL -C C:N AND NH4 CONCENTRATION IN BAND AND NON-BAND SOIL ZONES -C - RINHP=(OMC(3,N,K,L,NY,NX)*CNOMC(3,N,K)-OMN(3,N,K,L,NY,NX)) - IF(RINHP.GT.0.0)THEN - CNH4X=AMAX1(0.0,CNH4S(L,NY,NX)-Z4MN) - CNH4Y=AMAX1(0.0,CNH4B(L,NY,NX)-Z4MN) - RINHX=AMIN1(RINHP,BIOA*OMA(N,K)*TFNG(N,K)*Z4MX) - RINHO(N,K,L,NY,NX)=FNH4S*RINHX*CNH4X/(CNH4X+Z4KU) - RINHB(N,K,L,NY,NX)=FNHBS*RINHX*CNH4Y/(CNH4Y+Z4KU) - ZNH4M=Z4MN*VOLW(L,NY,NX)*FNH4S - ZNHBM=Z4MN*VOLW(L,NY,NX)*FNHBS - RINH4(N,K)=AMIN1(FNH4X*AMAX1(0.0,(ZNH4S(L,NY,NX)-ZNH4M)) - 2,RINHO(N,K,L,NY,NX)) - RINB4(N,K)=AMIN1(FNB4X*AMAX1(0.0,(ZNH4B(L,NY,NX)-ZNHBM)) - 2,RINHB(N,K,L,NY,NX)) - ELSE - RINHO(N,K,L,NY,NX)=0.0 - RINHB(N,K,L,NY,NX)=0.0 - RINH4(N,K)=RINHP*FNH4S - RINB4(N,K)=RINHP*FNHBS - ENDIF -C IF(M.EQ.1.AND.K.EQ.1.AND.N.EQ.1)THEN -C WRITE(*,7776)'RINH4',I,J,L,K,N,M,RINH4(N,K),RINHP -C 1,BIOA*OMA(N,K)*Z4MX*TFNG(N,K),BIOA,OMA(N,K),Z4MX,TFNG(N,K) -C 2,OMC(M,N,K,L,NY,NX),CNOMC(3,N,K),OMN(M,N,K,L,NY,NX) -C 3,RINHO(N,K,L,NY,NX),CNH4S(L,NY,NX),FNH4X -C 4,ZNH4T(L),OQN(K,L,NY,NX) -7776 FORMAT(A8,6I4,30E12.4) -C ENDIF -C -C MINERALIZATION-IMMOBILIZATION OF NO3 IN SOIL FROM MICROBIAL -C C:N AND NO3 CONCENTRATION IN BAND AND NON-BAND SOIL ZONES -C - RINOP=AMAX1(0.0,RINHP-RINH4(N,K)-RINB4(N,K)) - IF(RINOP.GT.0.0)THEN - CNO3X=AMAX1(0.0,CNO3S(L,NY,NX)-ZOMN) - CNO3Y=AMAX1(0.0,CNO3B(L,NY,NX)-ZOMN) - RINOX=AMIN1(RINOP,BIOA*OMA(N,K)*TFNG(N,K)*ZOMX) - RINOO(N,K,L,NY,NX)=FNO3S*RINOX*CNO3X/(CNO3X+ZOKU) - RINOB(N,K,L,NY,NX)=FNO3B*RINOX*CNO3Y/(CNO3Y+ZOKU) - ZNO3M=ZOMN*VOLW(L,NY,NX)*FNO3S - ZNOBM=ZOMN*VOLW(L,NY,NX)*FNO3B - RINO3(N,K)=AMIN1(FNO3X*AMAX1(0.0,(ZNO3S(L,NY,NX)-ZNO3M)) - 2,RINOO(N,K,L,NY,NX)) - RINB3(N,K)=AMIN1(FNB3X*AMAX1(0.0,(ZNO3B(L,NY,NX)-ZNOBM)) - 2,RINOB(N,K,L,NY,NX)) - ELSE - RINOO(N,K,L,NY,NX)=0.0 - RINOB(N,K,L,NY,NX)=0.0 - RINO3(N,K)=RINOP*FNO3S - RINB3(N,K)=RINOP*FNO3B - ENDIF -C -C MINERALIZATION-IMMOBILIZATION OF PO4 IN SOIL FROM MICROBIAL -C C:P AND PO4 CONCENTRATION IN BAND AND NON-BAND SOIL ZONES -C - RIPOP=(OMC(3,N,K,L,NY,NX)*CPOMC(3,N,K)-OMP(3,N,K,L,NY,NX)) - IF(RIPOP.GT.0.0)THEN - CH2PX=AMAX1(0.0,CH2P4(L,NY,NX)-HPMN) - CH2PY=AMAX1(0.0,CH2PB(L,NY,NX)-HPMN) - RIPOX=AMIN1(RIPOP,BIOA*OMA(N,K)*TFNG(N,K)*HPMX) - RIPOO(N,K,L,NY,NX)=FH2PS*RIPOX*CH2PX/(CH2PX+HPKU) - RIPOB(N,K,L,NY,NX)=FH2PB*RIPOX*CH2PY/(CH2PY+HPKU) - H2POM=HPMN*VOLW(L,NY,NX)*FH2PS - H2PBM=HPMN*VOLW(L,NY,NX)*FH2PB - RIPO4(N,K)=AMIN1(FPO4X*AMAX1(0.0,(H2PO4(L,NY,NX)-H2POM)) - 2,RIPOO(N,K,L,NY,NX)) - RIPB4(N,K)=AMIN1(FPB4X*AMAX1(0.0,(H2POB(L,NY,NX)-H2PBM)) - 2,RIPOB(N,K,L,NY,NX)) - ELSE - RIPOO(N,K,L,NY,NX)=0.0 - RIPOB(N,K,L,NY,NX)=0.0 - RIPO4(N,K)=RIPOP*FH2PS - RIPB4(N,K)=RIPOP*FH2PB - ENDIF -C IF(NY.EQ.5.AND.L.EQ.10.AND.K.EQ.3.AND.N.EQ.2)THEN -C WRITE(*,4322)'RIPO4',I,J,NX,NY,L,K,N,RIPO4(N,K),FPO4X,H2P4T(L) -C 2,RIPOO(N,K,L,NY,NX),RIPOP,BIOA,OMA(N,K),TFNG(N,K),HPMX,WFN(N,K) -C 2,VLPO4(L,NY,NX),CH2PX,HPKU,VLPOB(L,NY,NX),CH2PY -C 3,OMC(3,N,K,L,NY,NX),CPOMC(3,N,K),OMP(3,N,K,L,NY,NX),WFNG -4322 FORMAT(A8,7I4,30E12.4) -C ENDIF -C -C MINERALIZATION-IMMOBILIZATION OF NH4 IN SURFACE RESIDUE FROM -C MICROBIAL C:N AND NH4 CONCENTRATION IN BAND AND NON-BAND SOIL -C ZONES OF SOIL SURFACE -C - IF(L.EQ.0)THEN - RINHPR=RINHP-RINH4(N,K)-RINO3(N,K) - IF(RINHPR.GT.0.0)THEN - CNH4X=AMAX1(0.0,CNH4S(NU(NY,NX),NY,NX)-Z4MN) - CNH4Y=AMAX1(0.0,CNH4B(NU(NY,NX),NY,NX)-Z4MN) - RINHOR(N,K,NY,NX)=AMIN1(RINHPR,BIOA*OMA(N,K)*TFNG(N,K)*Z4MX) - 2*(FNH4S*CNH4X/(CNH4X+Z4KU)+FNHBS*CNH4Y - 3/(CNH4Y+Z4KU)) - ZNH4M=Z4MN*VOLW(NU(NY,NX),NY,NX) - RINH4R(N,K)=AMIN1(FNH4XR(N,K)*AMAX1(0.0,(ZNH4T(NU(NY,NX))-ZNH4M)) - 2,RINHOR(N,K,NY,NX)) - ELSE - RINHOR(N,K,NY,NX)=0.0 - RINH4R(N,K)=RINHPR - ENDIF -C IF(K.EQ.2.AND.N.EQ.1)THEN -C WRITE(*,7778)'RINH4R',I,J,NX,NY,L,K,N,RINH4R(N,K),RINHPR -C 2,BIOA*OMA(N,K)*Z4MX,RINHP,RINH4(N,K),RINO3(N,K) -C 3,RINHOR(N,K,NY,NX),CNH4S(NU(NY,NX),NY,NX),FNH4XR(N,K) -C 4,ZNH4T(NU(NY,NX)) -7778 FORMAT(A8,7I4,20E12.4) -C ENDIF -C -C MINERALIZATION-IMMOBILIZATION OF NO3 IN SURFACE RESIDUE FROM -C MICROBIAL C:N AND NO3 CONCENTRATION IN BAND AND NON-BAND SOIL -C ZONES OF SOIL SURFACE -C - RINOPR=AMAX1(0.0,RINHPR-RINH4R(N,K)) - IF(RINOPR.GT.0.0)THEN - CNO3X=AMAX1(0.0,CNO3S(NU(NY,NX),NY,NX)-ZOMN) - CNO3Y=AMAX1(0.0,CNO3B(NU(NY,NX),NY,NX)-ZOMN) - RINOOR(N,K,NY,NX)=AMAX1(RINOPR,BIOA*OMA(N,K)*TFNG(N,K)*ZOMX) - 2*(FNO3S*CNO3X/(CNO3X+ZOKU)+FNO3B*CNO3Y - 3/(CNO3Y+ZOKU)) - ZNO3M=ZOMN*VOLW(NU(NY,NX),NY,NX) - RINO3R(N,K)=AMIN1(FNO3XR(N,K)*AMAX1(0.0,(ZNO3T(NU(NY,NX))-ZNO3M)) - 2,RINOOR(N,K,NY,NX)) - ELSE - RINOOR(N,K,NY,NX)=0.0 - RINO3R(N,K)=RINOPR - ENDIF -C -C MINERALIZATION-IMMOBILIZATION OF PO4 IN SURFACE RESIDUE FROM -C MICROBIAL C:P AND PO4 CONCENTRATION IN BAND AND NON-BAND SOIL -C ZONES OF SOIL SURFACE -C - RIPOPR=RIPOP-RIPO4(N,K) - IF(RIPOPR.GT.0.0)THEN - CH2PX=AMAX1(0.0,CH2P4(NU(NY,NX),NY,NX)-HPMN) - CH2PY=AMAX1(0.0,CH2PB(NU(NY,NX),NY,NX)-HPMN) - RIPOOR(N,K,NY,NX)=AMIN1(RIPOPR,BIOA*OMA(N,K)*TFNG(N,K)*HPMX) - 2*(FH2PS*CH2PX/(CH2PX+HPKU)+FH2PB*CH2PY - 3/(CH2PY+HPKU)) - H2P4M=HPMN*VOLW(NU(NY,NX),NY,NX) - RIPO4R(N,K)=AMIN1(FPO4XR(N,K)*AMAX1(0.0,(H2P4T(NU(NY,NX))-H2P4M)) - 2,RIPOOR(N,K,NY,NX)) - ELSE - RIPOOR(N,K,NY,NX)=0.0 - RIPO4R(N,K)=RIPOPR - ENDIF -C WRITE(*,7778)'RIPO4R',I,J,NX,NY,L,K,N,RIPO4R(N,K),FPO4XR(N,K) -C 2,H2P4T(NU(NY,NX)),H2P4M,RIPOOR(N,K,NY,NX),RIPOPR - ENDIF -C -C pH EFFECT ON MAINTENANCE RESPIRATION -C - IF(SPOMC2.GT.0.0)THEN - FPH=1.0+AMAX1(0.0,0.25*(6.5-PH(L,NY,NX))) - RMOMX=RMOM*TFNR(N,K)*FPH - RMOMC(1,N,K)=OMN(1,N,K,L,NY,NX)*RMOMX - RMOMC(2,N,K)=OMN2(N,K)*RMOMX - ELSE - RMOMC(1,N,K)=0.0 - RMOMC(2,N,K)=0.0 - ENDIF -C -C MICROBIAL MAINTENANCE AND GROWTH RESPIRATION -C - RMOMT=RMOMC(1,N,K)+RMOMC(2,N,K) - RGOMT=AMAX1(0.0,RGOMO(N,K)-RMOMT) - RXOMT=AMAX1(0.0,RMOMT-RGOMO(N,K)) -C -C N2 FIXATION: N=(6) AEROBIC, (7) ANAEROBIC -C FROM GROWTH RESPIRATION, FIXATION ENERGY REQUIREMENT, -C MICROBIAL N REQUIREMENT IN LABILE (1) AND RESISTANT (2) FRACTIONS -C - IF(K.LE.4.AND.(N.EQ.6.OR.N.EQ.7))THEN - RGN2P=AMAX1(0.0,OMC(3,N,K,L,NY,NX)*CNOMC(3,N,K) - 2-OMN(3,N,K,L,NY,NX))/EN2F(N) - RGN2F=AMIN1(RGN2P,RGOMT) - 2*CZ2GS(L,NY,NX)/(CZ2GS(L,NY,NX)+ZFKM) - RN2FX(N,K)=RGN2F*EN2F(N) -C IF((I/30)*30.EQ.I.AND.J.EQ.12)THEN -C WRITE(*,5566)'N2 FIX',I,J,NX,NY,L,K,N,RN2FX(N,K),EN2F(N) -C 2,OMC(3,N,K,L,NY,NX)*CNOMC(3,N,K),OMN(3,N,K,L,NY,NX) -C 3,RINH4(N,K),RINO3(N,K),RGN2P,RGN2F,FNFX,RGOMT -C 4,CZ2GS(L,NY,NX) -5566 FORMAT(A8,7I4,30E12.4) -C ENDIF - ELSE - RN2FX(N,K)=0.0 - RGN2F=0.0 - ENDIF -C -C DOC, DON, DOP AND ACETATE UPTAKE DRIVEN BY GROWTH RESPIRATION -C FROM O2, NOX AND C REDUCTION -C - CGOMX=AMIN1(RMOMT,RGOMO(N,K))+RGN2F+(RGOMT-RGN2F)/ECHZ - CGOMD=RGOMD(N,K)/ENOX - CGOMC(N,K)=CGOMX+CGOMD - IF(K.LE.4)THEN - CGOQC(N,K)=CGOMX*FGOCP+CGOMD - CGOAC(N,K)=CGOMX*FGOAP - CGOXC=CGOQC(N,K)+CGOAC(N,K) - CGOMN(N,K)=AMAX1(0.0,AMIN1(OQN(K,L,NY,NX)*FOMK(N,K) - 2,CGOXC*CNQ(K)/FCN(N,K))) - CGOMP(N,K)=AMAX1(0.0,AMIN1(OQP(K,L,NY,NX)*FOMK(N,K) - 2,CGOXC*CPQ(K)/FCP(N,K))) - ELSE - CGOQC(N,K)=CGOMX+CGOMD - CGOAC(N,K)=0.0 - CGOMN(N,K)=0.0 - CGOMP(N,K)=0.0 - ENDIF - TCGOQC(K)=TCGOQC(K)+CGOQC(N,K) - TCGOAC(K)=TCGOAC(K)+CGOAC(N,K) - TCGOMN(K)=TCGOMN(K)+CGOMN(N,K) - TCGOMP(K)=TCGOMP(K)+CGOMP(N,K) -C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.EQ.3)THEN -C WRITE(*,5557)'CGOQC',I,J,NX,NY,L,K,N,CGOQC(N,K),CGOMX -C 2,FGOCP,FGOAP,CGOMD,RMOMT,RGN2F,ECHZ -C 3,RGOMD(N,K),ENOX,RGOMO(N,K),WFN(N,K),FOXYX -C WRITE(*,5557)'CGOMP',I,J,NX,NY,L,K,N,CGOMP(N,K),OQP(K,L,NY,NX) -C 2,FOMK(N,K),CGOXC,CPQ(K),FCP(N,K),CGOQC(N,K),CGOAC(N,K) -5557 FORMAT(A8,7I4,30E12.4) -C ENDIF -C -C TRANSFER UPTAKEN C,N,P FROM STORAGE TO ACTIVE BIOMASS -C - IF(OMC(3,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) - 2+OMC(3,N,K,L,NY,NX)/CNKI) - 3,OMP(3,N,K,L,NY,NX)/(OMP(3,N,K,L,NY,NX) - 4+OMC(3,N,K,L,NY,NX)/CPKI))) - 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)*CNKI)) - 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)*CPKI)) - RCCC=RCCZ+CCC*RCCY*(1.0-FSBST(N,K)) - RCCN=CNC*RCCX - RCCP=CPC*RCCQ - ELSE - RCCC=RCCZ - RCCN=0.0 - RCCP=0.0 - ENDIF - CGOMZ=TFNG(N,K)*OMGR*AMAX1(0.0,OMC(3,N,K,L,NY,NX)) - DO 745 M=1,2 - CGOMS(M,N,K)=FL(M)*CGOMZ - IF(OMC(3,N,K,L,NY,NX).GT.ZEROS(NY,NX))THEN - CGONS(M,N,K)=AMIN1(FL(M)*AMAX1(0.0,OMN(3,N,K,L,NY,NX)) - 2,CGOMS(M,N,K)*OMN(3,N,K,L,NY,NX)/OMC(3,N,K,L,NY,NX)) - CGOPS(M,N,K)=AMIN1(FL(M)*AMAX1(0.0,OMP(3,N,K,L,NY,NX)) - 2,CGOMS(M,N,K)*OMP(3,N,K,L,NY,NX)/OMC(3,N,K,L,NY,NX)) - ELSE - CGONS(M,N,K)=0.0 - CGOPS(M,N,K)=0.0 - ENDIF -C -C MICROBIAL DECOMPOSITION FROM BIOMASS, SPECIFIC DECOMPOSITION -C RATE, TEMPERATURE -C - SPOMX=SQRT(TFNG(N,K))*SPOMC(M)*SPOMC2 - RXOMC(M,N,K)=AMAX1(0.0,OMC(M,N,K,L,NY,NX)*SPOMX) - 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) - 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) -C -C HUMIFICATION OF MICROBIAL DECOMPOSITION PRODUCTS FROM -C DECOMPOSITION RATE, SOIL CLAY AND OC CONTENT '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 -C WRITE(*,8821)'RHOMC',I,J,L,K,N,M -C 3,CNSHY,CPSHY,FNSHY,FPSHY -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 -C NON-HUMIFIED PRODUCTS TO MICROBIAL RESIDUE -C - RCOMC(M,N,K)=RDOMC(M,N,K)-RHOMC(M,N,K) - RCOMN(M,N,K)=RDOMN(M,N,K)-RHOMN(M,N,K) - RCOMP(M,N,K)=RDOMP(M,N,K)-RHOMP(M,N,K) -745 CONTINUE -C -C MICROBIAL DECOMPOSITION WHEN MAINTENANCE RESPIRATION -C EXCEEDS UPTAKE -C - IF(RXOMT.GT.ZEROS(NY,NX).AND.RMOMT.GT.ZEROS(NY,NX) - 2.AND.RCCC.GT.ZERO)THEN - FRM=RXOMT/RMOMT - DO 730 M=1,2 - RXMMC(M,N,K)=AMIN1(OMC(M,N,K,L,NY,NX) - 2,AMAX1(0.0,FRM*RMOMC(M,N,K)/RCCC)) - RXMMN(M,N,K)=AMIN1(OMN(M,N,K,L,NY,NX) - 2,AMAX1(0.0,RXMMC(M,N,K)*CNOMA(N,K))) - RXMMP(M,N,K)=AMIN1(OMP(M,N,K,L,NY,NX) - 2,AMAX1(0.0,RXMMC(M,N,K)*CPOMA(N,K))) - RDMMC(M,N,K)=RXMMC(M,N,K)*(1.0-RCCC) - RDMMN(M,N,K)=RXMMN(M,N,K)*(1.0-RCCN)*(1.0-RCCC) - RDMMP(M,N,K)=RXMMP(M,N,K)*(1.0-RCCP)*(1.0-RCCC) - R3MMC(M,N,K)=RXMMC(M,N,K)-RDMMC(M,N,K) - R3MMN(M,N,K)=RXMMN(M,N,K)-RDMMN(M,N,K) - R3MMP(M,N,K)=RXMMP(M,N,K)-RDMMP(M,N,K) -C -C HUMIFICATION AND RECYCLING OF RESPIRATION DECOMPOSITION -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) - 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) -C IF(L.EQ.11.AND.K.EQ.1)THEN -C WRITE(*,8821)'RCMMC',I,J,L,K,N,M,RCMMC(M,N,K) -C 2,RDMMC(M,N,K),RHMMC(M,N,K),OMC(M,N,K,L,NY,NX) -C 3,FRM,RMOMC(M,N,K),OMN(1,N,K,L,NY,NX),OMN2(N,K) -C 4,RMOM,TFNR(N,K),FPH,RDMMN(M,N,K),CNSHZ,RDMMP(M,N,K) -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 ENDIF -730 CONTINUE - ELSE - DO 720 M=1,2 - RXMMC(M,N,K)=0.0 - RXMMN(M,N,K)=0.0 - RXMMP(M,N,K)=0.0 - RDMMC(M,N,K)=0.0 - RDMMN(M,N,K)=0.0 - RDMMP(M,N,K)=0.0 - R3MMC(M,N,K)=0.0 - R3MMN(M,N,K)=0.0 - R3MMP(M,N,K)=0.0 - RHMMC(M,N,K)=0.0 - RHMMN(M,N,K)=0.0 - RHMMP(M,N,K)=0.0 - RCMMC(M,N,K)=0.0 - RCMMN(M,N,K)=0.0 - RCMMP(M,N,K)=0.0 -720 CONTINUE - ENDIF - ELSE - RUPOX(N,K)=0.0 - RGOMO(N,K)=0.0 - RCO2X(N,K)=0.0 - RCH3X(N,K)=0.0 - RCH4X(N,K)=0.0 - RGOMY(N,K)=0.0 - RGOMD(N,K)=0.0 - CGOMC(N,K)=0.0 - CGOMN(N,K)=0.0 - CGOMP(N,K)=0.0 - CGOQC(N,K)=0.0 - CGOAC(N,K)=0.0 - RDNO3(N,K)=0.0 - RDNOB(N,K)=0.0 - RDNO2(N,K)=0.0 - RDN2B(N,K)=0.0 - RDN2O(N,K)=0.0 - RN2FX(N,K)=0.0 - RINH4(N,K)=0.0 - RINO3(N,K)=0.0 - RIPO4(N,K)=0.0 - RINB4(N,K)=0.0 - RINB3(N,K)=0.0 - RIPB4(N,K)=0.0 - IF(L.EQ.0)THEN - RINH4R(N,K)=0.0 - RINO3R(N,K)=0.0 - RIPO4R(N,K)=0.0 - FNH4XR(N,K)=0.0 - FNO3XR(N,K)=0.0 - FPO4XR(N,K)=0.0 - ENDIF - DO 725 M=1,2 - CGOMS(M,N,K)=0.0 - CGONS(M,N,K)=0.0 - CGOPS(M,N,K)=0.0 - RMOMC(M,N,K)=0.0 - RXMMC(M,N,K)=0.0 - RXMMN(M,N,K)=0.0 - RXMMP(M,N,K)=0.0 - RDMMC(M,N,K)=0.0 - RDMMN(M,N,K)=0.0 - RDMMP(M,N,K)=0.0 - R3MMC(M,N,K)=0.0 - R3MMN(M,N,K)=0.0 - R3MMP(M,N,K)=0.0 - RHMMC(M,N,K)=0.0 - RHMMN(M,N,K)=0.0 - RHMMP(M,N,K)=0.0 - RCMMC(M,N,K)=0.0 - RCMMN(M,N,K)=0.0 - RCMMP(M,N,K)=0.0 - RXOMC(M,N,K)=0.0 - RXOMN(M,N,K)=0.0 - RXOMP(M,N,K)=0.0 - RDOMC(M,N,K)=0.0 - RDOMN(M,N,K)=0.0 - RDOMP(M,N,K)=0.0 - R3OMC(M,N,K)=0.0 - R3OMN(M,N,K)=0.0 - R3OMP(M,N,K)=0.0 - RHOMC(M,N,K)=0.0 - RHOMN(M,N,K)=0.0 - RHOMP(M,N,K)=0.0 - RCOMC(M,N,K)=0.0 - RCOMN(M,N,K)=0.0 - RCOMP(M,N,K)=0.0 -725 CONTINUE - RH2GX(N,K)=0.0 - IF(K.EQ.5)THEN - RVOXA(N)=0.0 - RVOXB(N)=0.0 - IF(N.EQ.5)THEN - RH2GZ=0.0 - ENDIF - ENDIF - ENDIF - ENDIF -750 CONTINUE - ENDIF -760 CONTINUE -C -C CHEMODENITRIFICATION -C - IF(RNO2Y(L,NY,NX).GT.ZEROS(NY,NX))THEN - FNO2=AMAX1(FMN,RVMXC(L,NY,NX)/RNO2Y(L,NY,NX)) - ELSE - FNO2=FMN*VLNO3(L,NY,NX) - ENDIF - IF(RN2BY(L,NY,NX).GT.ZEROS(NY,NX))THEN - FNB2=AMAX1(FMN,RVMBC(L,NY,NX)/RN2BY(L,NY,NX)) - ELSE - FNB2=FMN*VLNOB(L,NY,NX) - 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)) - 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 -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) -7779 FORMAT(A8,3I4,30E12.4) -C ENDIF -C -C DECOMPOSITION -C - DO 1870 K=0,KL - ROQCK(K)=0.0 - DO 1875 N=1,7 - ROQCK(K)=ROQCK(K)+ROQCD(N,K) -1875 CONTINUE - XOQCK(K)=0.0 - XOQCZ(K)=0.0 - XOQNZ(K)=0.0 - XOQPZ(K)=0.0 - XOQAZ(K)=0.0 - DO 845 N=1,7 - DO 845 M=1,3 - XOMCZ(M,N,K)=0.0 - XOMNZ(M,N,K)=0.0 - XOMPZ(M,N,K)=0.0 -845 CONTINUE -C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.LE.1)THEN -C WRITE(*,4443)'PRIM1',I,J,NX,NY,L,K,ROQCK(K) -C 2,XOQCK(K),OQC(K,L,NY,NX),XOQCZ(K),OQN(K,L,NY,NX),XOQNZ(K) -C 3,OQP(K,L,NY,NX),XOQPZ(K),OQA(K,L,NY,NX),XOQAZ(K) -C ENDIF -1870 CONTINUE -C -C PRIMING BETWEEN LITTER AND NON-LITTER C -C - DO 795 K=0,KL - IF(K.LE.KL-1)THEN - DO 800 KK=K+1,KL - OSRT=OSRH(K)+OSRH(KK) - IF(OSRH(K).GT.ZEROS(NY,NX).AND.OSRH(KK).GT.ZEROS(NY,NX))THEN - XFRK=FPRIM*TFND(L,NY,NX)*(ROQCK(K)*OSRH(KK) - 2-ROQCK(KK)*OSRH(K))/OSRT - XFRC=FPRIM*TFND(L,NY,NX)*(OQC(K,L,NY,NX)*OSRH(KK) - 2-OQC(KK,L,NY,NX)*OSRH(K))/OSRT - XFRN=FPRIM*TFND(L,NY,NX)*(OQN(K,L,NY,NX)*OSRH(KK) - 2-OQN(KK,L,NY,NX)*OSRH(K))/OSRT - XFRP=FPRIM*TFND(L,NY,NX)*(OQP(K,L,NY,NX)*OSRH(KK) - 2-OQP(KK,L,NY,NX)*OSRH(K))/OSRT - XFRA=FPRIM*TFND(L,NY,NX)*(OQA(K,L,NY,NX)*OSRH(KK) - 2-OQA(KK,L,NY,NX)*OSRH(K))/OSRT - IF(ROQCK(K)+XOQCK(K)-XFRK.GT.0.0 - 2.AND.ROQCK(KK)+XOQCK(KK)+XFRK.GT.0.0)THEN - XOQCK(K)=XOQCK(K)-XFRK - XOQCK(KK)=XOQCK(KK)+XFRK -C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.LE.1)THEN -C WRITE(*,4442)'XOQCK',I,J,NX,NY,L,K,KK,XFRC,ROQCK(K) -C 2,OSRH(K),ROQCK(KK),OSRH(KK),XOQCK(K),XOQCK(KK) -4442 FORMAT(A8,7I4,12E12.4) -C ENDIF - ENDIF - IF(OQC(K,L,NY,NX)+XOQCZ(K)-XFRC.GT.0.0 - 2.AND.OQC(KK,L,NY,NX)+XOQCZ(KK)+XFRC.GT.0.0)THEN - XOQCZ(K)=XOQCZ(K)-XFRC - XOQCZ(KK)=XOQCZ(KK)+XFRC -C IF((I/1)*1.EQ.I.AND.L.EQ.3.AND.K.EQ.1)THEN -C WRITE(*,4442)'XOQCZ',I,J,NX,NY,L,K,KK,XFRC,OQC(K,L,NY,NX) -C 2,OSRH(K),OQC(KK,L,NY,NX),OSRH(KK),XOQCZ(K),XOQCZ(KK) -C ENDIF - ENDIF - IF(OQN(K,L,NY,NX)+XOQNZ(K)-XFRN.GT.0.0 - 2.AND.OQN(KK,L,NY,NX)+XOQNZ(KK)+XFRN.GT.0.0)THEN - XOQNZ(K)=XOQNZ(K)-XFRN - XOQNZ(KK)=XOQNZ(KK)+XFRN -C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.EQ.4)THEN -C WRITE(*,4442)'XOQNZ',I,J,NX,NY,L,K,KK,XFRN,OQN(K,L,NY,NX) -C 2,OSRH(K),OQN(KK,L,NY,NX),OSRH(KK),XOQNZ(K),XOQNZ(KK) -C ENDIF - ENDIF - IF(OQP(K,L,NY,NX)+XOQPZ(K)-XFRP.GT.0.0 - 2.AND.OQP(KK,L,NY,NX)+XOQPZ(KK)+XFRP.GT.0.0)THEN - XOQPZ(K)=XOQPZ(K)-XFRP - XOQPZ(KK)=XOQPZ(KK)+XFRP -C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.EQ.4)THEN -C WRITE(*,4442)'XOQPZ',I,J,NX,NY,L,K,KK,XFRP,OQP(K,L,NY,NX) -C 2,OSRH(K),OQP(KK,L,NY,NX),OSRH(KK),XOQPZ(K),XOQPZ(KK) -C ENDIF - ENDIF - IF(OQA(K,L,NY,NX)+XOQAZ(K)-XFRA.GT.0.0 - 2.AND.OQA(KK,L,NY,NX)+XOQAZ(KK)+XFRA.GT.0.0)THEN - XOQAZ(K)=XOQAZ(K)-XFRA - XOQAZ(KK)=XOQAZ(KK)+XFRA -C IF((I/1)*1.EQ.I.AND.L.EQ.3.AND.K.EQ.1)THEN -C WRITE(*,4442)'XOQAZ',I,J,NX,NY,L,K,KK,XFRA,OQA(K,L,NY,NX) -C 2,OSRH(K),OQA(KK,L,NY,NX),OSRH(KK),XOQAZ(K),XOQAZ(KK) -C ENDIF - ENDIF - DO 850 N=1,7 - DO 850 M=1,3 - XFMC=FPRIMM*TFNG(N,K)*(OMC(M,N,K,L,NY,NX)*OSRH(KK) - 2-OMC(M,N,KK,L,NY,NX)*OSRH(K))/OSRT - XFMN=FPRIMM*TFNG(N,K)*(OMN(M,N,K,L,NY,NX)*OSRH(KK) - 2-OMN(M,N,KK,L,NY,NX)*OSRH(K))/OSRT - XFMP=FPRIMM*TFNG(N,K)*(OMP(M,N,K,L,NY,NX)*OSRH(KK) - 2-OMP(M,N,KK,L,NY,NX)*OSRH(K))/OSRT - IF(OMC(M,N,K,L,NY,NX)+XOMCZ(M,N,K)-XFMC.GT.0.0 - 2.AND.OMC(M,N,KK,L,NY,NX)+XOMCZ(M,N,KK)+XFMC.GT.0.0)THEN - XOMCZ(M,N,K)=XOMCZ(M,N,K)-XFMC - XOMCZ(M,N,KK)=XOMCZ(M,N,KK)+XFMC -C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.EQ.4)THEN -C WRITE(*,4447)'XOMCZ',I,J,NX,NY,L,K,KK,N,M,XFMC,OMC(M,N,K,L,NY,NX) -C 2,OQC(K,L,NY,NX),OMC(M,N,KK,L,NY,NX),OQC(KK,L,NY,NX),OQCT -C 3,XOMCZ(M,N,K),XOMCZ(M,N,KK) -4447 FORMAT(A8,9I4,20E12.4) -C ENDIF - ENDIF - IF(OMN(M,N,K,L,NY,NX)+XOMNZ(M,N,K)-XFMN.GT.0.0 - 2.AND.OMN(M,N,KK,L,NY,NX)+XOMNZ(M,N,KK)+XFMN.GT.0.0)THEN - XOMNZ(M,N,K)=XOMNZ(M,N,K)-XFMN - XOMNZ(M,N,KK)=XOMNZ(M,N,KK)+XFMN -C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.EQ.4)THEN -C WRITE(*,4447)'XOMNZ',I,J,NX,NY,L,K,KK,N,M,XFMN,OMN(M,N,K,L,NY,NX) -C 2,OSRH(K),OMN(M,N,KK,L,NY,NX),OSRH(KK),XOMNZ(M,N,K),XOMNZ(M,N,KK) -C ENDIF - ENDIF - IF(OMP(M,N,K,L,NY,NX)+XOMPZ(M,N,K)-XFMP.GT.0.0 - 2.AND.OMP(M,N,KK,L,NY,NX)+XOMPZ(M,N,KK)+XFMP.GT.0.0)THEN - XOMPZ(M,N,K)=XOMPZ(M,N,K)-XFMP - XOMPZ(M,N,KK)=XOMPZ(M,N,KK)+XFMP -C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.EQ.4)THEN -C WRITE(*,4447)'XOMPZ',I,J,NX,NY,L,K,KK,N,M,XFMP,OMP(M,N,K,L,NY,NX) -C 2,OSRH(K),OMP(M,N,KK,L,NY,NX),OSRH(KK),XOMPZ(M,N,K),XOMPZ(M,N,KK) -C ENDIF - ENDIF -850 CONTINUE - ENDIF -800 CONTINUE - ENDIF -795 CONTINUE -C -C DECOMPOSITION OF ORGANIC SUBSTRATES -C - TOQCK(L,NY,NX)=0.0 - DO 1790 K=0,KL - ROQCK(K)=ROQCK(K)+XOQCK(K) - TOQCK(L,NY,NX)=TOQCK(L,NY,NX)+ROQCK(K) - OQC(K,L,NY,NX)=OQC(K,L,NY,NX)+XOQCZ(K) - OQN(K,L,NY,NX)=OQN(K,L,NY,NX)+XOQNZ(K) - OQP(K,L,NY,NX)=OQP(K,L,NY,NX)+XOQPZ(K) - OQA(K,L,NY,NX)=OQA(K,L,NY,NX)+XOQAZ(K) - DO 840 N=1,7 - DO 840 M=1,3 - OMC(M,N,K,L,NY,NX)=OMC(M,N,K,L,NY,NX)+XOMCZ(M,N,K) - OMN(M,N,K,L,NY,NX)=OMN(M,N,K,L,NY,NX)+XOMNZ(M,N,K) - OMP(M,N,K,L,NY,NX)=OMP(M,N,K,L,NY,NX)+XOMPZ(M,N,K) -840 CONTINUE - IF(TOMK(K).GT.ZEROS(NY,NX))THEN - CNOMX=TONK(K)/TONX(K) - CPOMX=TOPK(K)/TOPX(K) - FCNK(K)=AMIN1(1.0,AMAX1(0.50,CNOMX)) - FCPK(K)=AMIN1(1.0,AMAX1(0.50,CPOMX)) - ELSE - FCNK(K)=1.0 - FCPK(K)=1.0 - ENDIF -C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.EQ.4)THEN -C WRITE(*,4443)'PRIM2',I,J,NX,NY,L,K,ROQCK(K) -C 2,XOQCK(K),OQC(K,L,NY,NX),XOQCZ(K),OQN(K,L,NY,NX),XOQNZ(K) -C 3,OQP(K,L,NY,NX),XOQPZ(K),OQA(K,L,NY,NX),XOQAZ(K),TOMK(K) -C 3,TONK(K),TOPK(K),TONX(K),TOPX(K),CNOMX,CPOMX,FCNK(K),FCPK(K) -C 4,TOQCK(L,NY,NX) -4443 FORMAT(A8,6I4,20E12.4) -C ENDIF -C -C AQUEOUS CONCENTRATION OF BIOMASS TO CACULATE INHIBITION -C CONSTANT FOR DECOMPOSITION -C - IF(VOLWZ.GT.ZEROS(NY,NX))THEN - COQCK=AMIN1(0.1E+06,ROQCK(K)/VOLWZ) - ELSE - COQCK=0.1E+06 - ENDIF - DCKD=DCKM(K)*(1.0+COQCK/DCKI) - IF(OSRH(K).GT.ZEROS(NY,NX))THEN - COSC=OSRH(K)/VOLX(L,NY,NX) - DFNS=COSC/(COSC+DCKD) - OQCI=1.0/(1.0+COQC(K,L,NY,NX)/OQKI) -C IF(L.EQ.0)THEN -C WRITE(*,4242)'COSC',I,J,L,K,DFNS,COSC,COQCK,DCKD,OSRH(K) -C 2,OSAT(K),OSCT(K),ORCT(K),OHC(K,L,NY,NX),BKVL(L,NY,NX),ROQCK(K) -C 3,VOLWZ,VOLWRX(NY,NX),VOLW(0,NY,NX),FCR(NY,NX) -C 4,THETY(L,NY,NX) -4242 FORMAT(A8,4I4,30E12.4) -C ENDIF -C -C C, N, P DECOMPOSITION RATE OF SOLID SUBSTRATES 'RDOS*' FROM -C RATE CONSTANT, TOTAL ACTIVE BIOMASS, DENSITY FACTOR, -C TEMPERATURE, SUBSTRATE C:N, C:P -C - DO 785 M=1,4 - IF(OSC(M,K,L,NY,NX).GT.ZEROS(NY,NX))THEN - CNS(M,K)=AMAX1(0.0,OSN(M,K,L,NY,NX)/OSC(M,K,L,NY,NX)) - CPS(M,K)=AMAX1(0.0,OSP(M,K,L,NY,NX)/OSC(M,K,L,NY,NX)) - RDOSC(M,K)=AMAX1(0.0,AMIN1(OSA(M,K,L,NY,NX) - 2,SPOSC(M,K)*ROQCK(K)*DFNS*OQCI*TFNX*OSA(M,K,L,NY,NX)/OSRH(K))) -C 3*AMIN1(FCNK(K),FCPK(K)) - RDOSN(M,K)=AMAX1(0.0,AMIN1(OSN(M,K,L,NY,NX) - 2,CNS(M,K)*RDOSC(M,K)))/FCNK(K) - RDOSP(M,K)=AMAX1(0.0,AMIN1(OSP(M,K,L,NY,NX) - 2,CPS(M,K)*RDOSC(M,K)))/FCPK(K) -C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.LE.1)THEN -C WRITE(*,4444)'RDOSC',I,J,NX,NY,L,K,M,RDOSC(M,K),RDOSN(M,K) -C 2,RDOSP(M,K),CNS(M,K),CPS(M,K),SPOSC(M,K),ROQCK(K),DFNS,TFNX -C 3,OQCI,OSA(M,K,L,NY,NX),OSRH(K),COSC,COQCK,DCKD,VOLWZ -C 4,TFNX,WFNG,TKS(L,NY,NX),PSISM(L,NY,NX),THETW(L,NY,NX) -C 4,FOSRH(K),VOLX(L,NY,NX),ORGC(L,NY,NX),OSC(M,K,L,NY,NX) -C 2,OSN(M,K,L,NY,NX),OSP(M,K,L,NY,NX),TONK(K),TONX(K),FCNK(K) -C 6,FCPK(K),WFN(1,K),WFN(3,K),COQC(K,L,NY,NX),THETY(L,NY,NX) -4444 FORMAT(A8,7I4,40E12.4) -C ENDIF - ELSE - CNS(M,K)=CNOSC(M,K,L,NY,NX) - CPS(M,K)=CPOSC(M,K,L,NY,NX) - RDOSC(M,K)=0.0 - RDOSN(M,K)=0.0 - RDOSP(M,K)=0.0 - ENDIF -785 CONTINUE -C -C HUMIFICATION OF DECOMPOSED RESIDUE LIGNIN WITH PROTEIN, -C CH2O AND CELLULOSE 'RHOS*' WITH REMAINDER 'RCOS*' TO DOC,N,P -C - IF(K.LE.2)THEN - RHOSC(4,K)=AMAX1(0.0,AMIN1(RDOSN(4,K)/CNRH(3) - 2,RDOSP(4,K)/CPRH(3),EPOC(L,NY,NX)*RDOSC(4,K))) - RHOSCM=0.10*RHOSC(4,K) - RHOSC(1,K)=AMAX1(0.0,AMIN1(RDOSC(1,K),RDOSN(1,K)/CNRH(3) - 2,RDOSP(1,K)/CPRH(3),RHOSCM)) - RHOSC(2,K)=AMAX1(0.0,AMIN1(RDOSC(2,K),RDOSN(2,K)/CNRH(3) - 2,RDOSP(2,K)/CPRH(3),RHOSCM)) - RHOSC(3,K)=AMAX1(0.0,AMIN1(RDOSC(3,K),RDOSN(3,K)/CNRH(3) - 2,RDOSP(3,K)/CPRH(3),RHOSCM-RHOSC(2,K))) - DO 805 M=1,4 - RHOSN(M,K)=AMIN1(RDOSN(M,K),RHOSC(M,K)*CNRH(3)) - RHOSP(M,K)=AMIN1(RDOSP(M,K),RHOSC(M,K)*CPRH(3)) - RCOSC(M,K)=RDOSC(M,K)-RHOSC(M,K) - RCOSN(M,K)=RDOSN(M,K)-RHOSN(M,K) - RCOSP(M,K)=RDOSP(M,K)-RHOSP(M,K) -805 CONTINUE - ELSE - DO 810 M=1,4 - RHOSC(M,K)=0.0 - RHOSN(M,K)=0.0 - RHOSP(M,K)=0.0 - RCOSC(M,K)=RDOSC(M,K) - RCOSN(M,K)=RDOSN(M,K) - RCOSP(M,K)=RDOSP(M,K) -810 CONTINUE - ENDIF - ELSE - DO 780 M=1,4 - RDOSC(M,K)=0.0 - RDOSN(M,K)=0.0 - RDOSP(M,K)=0.0 - RHOSC(M,K)=0.0 - RHOSN(M,K)=0.0 - RHOSP(M,K)=0.0 - RCOSC(M,K)=0.0 - RCOSN(M,K)=0.0 - RCOSP(M,K)=0.0 -780 CONTINUE - ENDIF -C -C C, N, P DECOMPOSITION RATE OF BIORESIDUE 'RDOR*' FROM -C RATE CONSTANT, TOTAL ACTIVE BIOMASS, DENSITY FACTOR, -C TEMPERATURE, SUBSTRATE C:N, C:P -C - IF(OSRH(K).GT.ZEROS(NY,NX))THEN - DO 775 M=1,2 - IF(ORC(M,K,L,NY,NX).GT.ZEROS(NY,NX))THEN - CNR=AMAX1(0.0,ORN(M,K,L,NY,NX)/ORC(M,K,L,NY,NX)) - CPR=AMAX1(0.0,ORP(M,K,L,NY,NX)/ORC(M,K,L,NY,NX)) - RDORC(M,K)=AMAX1(0.0,AMIN1(ORC(M,K,L,NY,NX) - 2,SPORC(M)*ROQCK(K)*DFNS*OQCI*TFNX*ORC(M,K,L,NY,NX)/OSRH(K))) -C 3*AMIN1(FCNK(K),FCPK(K)) - RDORN(M,K)=AMAX1(0.0,AMIN1(ORN(M,K,L,NY,NX),CNR*RDORC(M,K))) - 2/FCNK(K) - RDORP(M,K)=AMAX1(0.0,AMIN1(ORP(M,K,L,NY,NX),CPR*RDORC(M,K))) - 2/FCPK(K) - ELSE - RDORC(M,K)=0.0 - RDORN(M,K)=0.0 - RDORP(M,K)=0.0 - ENDIF -775 CONTINUE - ELSE - DO 776 M=1,2 - RDORC(M,K)=0.0 - RDORN(M,K)=0.0 - RDORP(M,K)=0.0 -776 CONTINUE - ENDIF -C -C C, N, P DECOMPOSITION RATE OF SORBED SUBSTRATES 'RDOH*' FROM -C RATE CONSTANT, TOTAL ACTIVE BIOMASS, DENSITY FACTOR, -C TEMPERATURE, SUBSTRATE C:N, C:P -C - IF(OSRH(K).GT.ZEROS(NY,NX))THEN - IF(OHC(K,L,NY,NX).GT.ZEROS(NY,NX))THEN - CNH(K)=AMAX1(0.0,OHN(K,L,NY,NX)/OHC(K,L,NY,NX)) - CPH(K)=AMAX1(0.0,OHP(K,L,NY,NX)/OHC(K,L,NY,NX)) - RDOHC(K)=AMAX1(0.0,AMIN1(OHC(K,L,NY,NX) - 2,SPOHC*ROQCK(K)*DFNS*OQCI*TFNX*OHC(K,L,NY,NX)/OSRH(K))) -C 3*AMIN1(FCNK(K),FCPK(K)) - RDOHN(K)=AMAX1(0.0,AMIN1(OHN(K,L,NY,NX),CNH(K)*RDOHC(K))) - 2/FCNK(K) - RDOHP(K)=AMAX1(0.0,AMIN1(OHP(K,L,NY,NX),CPH(K)*RDOHC(K))) - 2/FCPK(K) - RDOHA(K)=AMAX1(0.0,AMIN1(OHA(K,L,NY,NX) - 2,SPOHA*ROQCK(K)*DFNS*TFNX*OHA(K,L,NY,NX)/OSRH(K))) -C 3*AMIN1(FCNK(K),FCPK(K)) - ELSE - CNH(K)=0.0 - CPH(K)=0.0 - RDOHC(K)=0.0 - RDOHN(K)=0.0 - RDOHP(K)=0.0 - RDOHA(K)=0.0 - ENDIF - ELSE - CNH(K)=0.0 - CPH(K)=0.0 - RDOHC(K)=0.0 - RDOHN(K)=0.0 - RDOHP(K)=0.0 - RDOHA(K)=0.0 - ENDIF -C -C DOC ADSORPTION - DESORPTION -C - IF(VOLWM(NPH,L,NY,NX).GT.ZEROS(NY,NX).AND.FOSRH(K).GT.ZERO)THEN - IF(L.EQ.0)THEN - AECX=50.0 - ELSE - AECX=AEC(L,NY,NX) - ENDIF - OQCX=AMAX1(ZEROS(NY,NX),OQC(K,L,NY,NX)-TCGOQC(K)) - OQNX=AMAX1(ZEROS(NY,NX),OQN(K,L,NY,NX)-TCGOAC(K)) - OQPX=AMAX1(ZEROS(NY,NX),OQP(K,L,NY,NX)-TCGOMN(K)) - OQAX=AMAX1(ZEROS(NY,NX),OQA(K,L,NY,NX)-TCGOMP(K)) - OHCX=AMAX1(ZEROS(NY,NX),OHC(K,L,NY,NX)) - OHNX=AMAX1(ZEROS(NY,NX),OHN(K,L,NY,NX)) - OHPX=AMAX1(ZEROS(NY,NX),OHP(K,L,NY,NX)) - OHAX=AMAX1(ZEROS(NY,NX),OHA(K,L,NY,NX)) - VOLXX=BKVL(L,NY,NX)*AECX*HSORP*FOSRH(K) - VOLXW=VOLWM(NPH,L,NY,NX)*FOSRH(K) - IF(FOCA(K).GT.ZERO)THEN - VOLCX=FOCA(K)*VOLXX - VOLCW=FOCA(K)*VOLXW - CSORP(K)=TSORP*(OQCX*VOLCX-OHCX*VOLCW)/(VOLCX+VOLCW) - ELSE - CSORP(K)=TSORP*(OQCX*VOLXX-OHCX*VOLXW)/(VOLXX+VOLXW) - ENDIF - IF(FOAA(K).GT.ZERO)THEN - VOLAX=FOAA(K)*VOLXX - VOLAW=FOAA(K)*VOLXW - CSORPA(K)=TSORP*(OQAX*VOLAX-OHAX*VOLAW)/(VOLAX+VOLAW) - ELSE - CSORPA(K)=TSORP*(OQAX*VOLXX-OHAX*VOLXW)/(VOLXX+VOLXW) - ENDIF - ZSORP(K)=TSORP*(OQNX*VOLXX-OHNX*VOLXW)/(VOLXX+VOLXW) - PSORP(K)=TSORP*(OQPX*VOLXX-OHPX*VOLXW)/(VOLXX+VOLXW) - ELSE - CSORP(K)=0.0 - CSORPA(K)=0.0 - ZSORP(K)=0.0 - PSORP(K)=0.0 - ENDIF -C IF(L.EQ.4.AND.K.EQ.1)THEN -C WRITE(*,591)'CSORP',I,J,NX,NY,L,K,CSORP(K),CSORPA(K) -C 1,OQC(K,L,NY,NX),OHC(K,L,NY,NX),OQA(K,L,NY,NX),OHA(K,L,NY,NX) -C 2,OQC(K,L,NY,NX)/VOLWM(NPH,L,NY,NX),OHC(K,L,NY,NX)/BKVL(L,NY,NX) -C 2,OQA(K,L,NY,NX)/VOLWM(NPH,L,NY,NX),OHA(K,L,NY,NX)/BKVL(L,NY,NX) -C 4,BKVL(L,NY,NX),VOLWM(NPH,L,NY,NX),FOCA(K),FOAA(K),FOSRH(K) -C 5,TCGOQC(K),OQCX -591 FORMAT(A8,6I4,40E12.4) -C ENDIF -1790 CONTINUE -C -C REDISTRIBUTE AUTOTROPHIC DECOMPOSITION PRODUCTS AMONG -C HETEROTROPHIC SUBSTRATE-MICROBE COMPLEXES -C - DO 1690 K=0,KL - IF(TORC.GT.ZEROS(NY,NX))THEN - FORC(K)=ORCT(K)/TORC - ELSE - IF(K.EQ.3)THEN - FORC(K)=1.0 - ELSE - FORC(K)=0.0 - ENDIF - ENDIF - DO 1685 N=1,7 - DO 1680 M=1,2 - RCCMC(M,N,K)=(RCOMC(M,N,5)+RCMMC(M,N,5))*FORC(K) - RCCMN(M,N,K)=(RCOMN(M,N,5)+RCMMN(M,N,5))*FORC(K) - RCCMP(M,N,K)=(RCOMP(M,N,5)+RCMMP(M,N,5))*FORC(K) -C IF(L.EQ.0)THEN -C WRITE(*,8821)'RCCMC',I,J,L,K,N,M,RCCMC(M,N,K) -C 2,RCOMC(M,N,5),RCMMC(M,N,5),FORC(K) -C ENDIF -1680 CONTINUE -1685 CONTINUE -1690 CONTINUE -C -C REDISTRIBUTE C,N AND P TRANSFORMATIONS AMONG STATE -C VARIABLES IN SUBSTRATE-MICROBE COMPLEXES -C - DO 590 K=0,KL - DO 580 M=1,4 -C -C SUBSTRATE DECOMPOSITION PRODUCTS -C - OSC(M,K,L,NY,NX)=OSC(M,K,L,NY,NX)-RDOSC(M,K) - OSA(M,K,L,NY,NX)=OSA(M,K,L,NY,NX)-RDOSC(M,K) - OSN(M,K,L,NY,NX)=OSN(M,K,L,NY,NX)-RDOSN(M,K) - OSP(M,K,L,NY,NX)=OSP(M,K,L,NY,NX)-RDOSP(M,K) - OQC(K,L,NY,NX)=OQC(K,L,NY,NX)+RCOSC(M,K) - OQN(K,L,NY,NX)=OQN(K,L,NY,NX)+RCOSN(M,K) - OQP(K,L,NY,NX)=OQP(K,L,NY,NX)+RCOSP(M,K) -C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.K.EQ.4)THEN -C WRITE(*,4444)'RDOSC',I,J,NX,NY,L,K,M,OSC(M,K,L,NY,NX) -C 2,RDOSC(M,K) -C ENDIF -C -C LIGNIFICATION PRODUCTS -C - IF(L.NE.0)THEN - OSC(1,3,L,NY,NX)=OSC(1,3,L,NY,NX)+RHOSC(M,K) - OSA(1,3,L,NY,NX)=OSA(1,3,L,NY,NX)+RHOSC(M,K) - OSN(1,3,L,NY,NX)=OSN(1,3,L,NY,NX)+RHOSN(M,K) - OSP(1,3,L,NY,NX)=OSP(1,3,L,NY,NX)+RHOSP(M,K) - ELSE - OSC(1,3,NU(NY,NX),NY,NX)=OSC(1,3,NU(NY,NX),NY,NX)+RHOSC(M,K) - OSA(1,3,NU(NY,NX),NY,NX)=OSA(1,3,NU(NY,NX),NY,NX)+RHOSC(M,K) - OSN(1,3,NU(NY,NX),NY,NX)=OSN(1,3,NU(NY,NX),NY,NX)+RHOSN(M,K) - OSP(1,3,NU(NY,NX),NY,NX)=OSP(1,3,NU(NY,NX),NY,NX)+RHOSP(M,K) - ENDIF -580 CONTINUE -C -C MICROBIAL RESIDUE DECOMPOSITION PRODUCTS -C - DO 575 M=1,2 - ORC(M,K,L,NY,NX)=ORC(M,K,L,NY,NX)-RDORC(M,K) - ORN(M,K,L,NY,NX)=ORN(M,K,L,NY,NX)-RDORN(M,K) - ORP(M,K,L,NY,NX)=ORP(M,K,L,NY,NX)-RDORP(M,K) - OQC(K,L,NY,NX)=OQC(K,L,NY,NX)+RDORC(M,K) - OQN(K,L,NY,NX)=OQN(K,L,NY,NX)+RDORN(M,K) - OQP(K,L,NY,NX)=OQP(K,L,NY,NX)+RDORP(M,K) -575 CONTINUE - OQC(K,L,NY,NX)=OQC(K,L,NY,NX)+RDOHC(K) - OQN(K,L,NY,NX)=OQN(K,L,NY,NX)+RDOHN(K)+RCOQN*FORC(K) - OQP(K,L,NY,NX)=OQP(K,L,NY,NX)+RDOHP(K) - OQA(K,L,NY,NX)=OQA(K,L,NY,NX)+RDOHA(K) - OHC(K,L,NY,NX)=OHC(K,L,NY,NX)-RDOHC(K) - OHN(K,L,NY,NX)=OHN(K,L,NY,NX)-RDOHN(K) - OHP(K,L,NY,NX)=OHP(K,L,NY,NX)-RDOHP(K) - OHA(K,L,NY,NX)=OHA(K,L,NY,NX)-RDOHA(K) -C -C MICROBIAL UPTAKE OF DISSOLVED C, N, P -C - DO 570 N=1,7 - OQC(K,L,NY,NX)=OQC(K,L,NY,NX)-CGOQC(N,K) - OQN(K,L,NY,NX)=OQN(K,L,NY,NX)-CGOMN(N,K) - OQP(K,L,NY,NX)=OQP(K,L,NY,NX)-CGOMP(N,K) - OQA(K,L,NY,NX)=OQA(K,L,NY,NX)-CGOAC(N,K)+RCH3X(N,K) -C -C MICROBIAL DECOMPOSITION PRODUCTS -C - DO 565 M=1,2 - ORC(M,K,L,NY,NX)=ORC(M,K,L,NY,NX)+RCOMC(M,N,K)+RCCMC(M,N,K) - 2+RCMMC(M,N,K) - ORN(M,K,L,NY,NX)=ORN(M,K,L,NY,NX)+RCOMN(M,N,K)+RCCMN(M,N,K) - 2+RCMMN(M,N,K) - ORP(M,K,L,NY,NX)=ORP(M,K,L,NY,NX)+RCOMP(M,N,K)+RCCMP(M,N,K) - 2+RCMMP(M,N,K) -C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.EQ.4.AND.K.EQ.2)THEN -C WRITE(*,8821)'ORC',I,J,L,K,N,M,ORC(M,K,L,NY,NX) -C 2,RCOMC(M,N,K),RCCMC(M,N,K),RCMMC(M,N,K),RDORC(M,K) -C WRITE(*,8821)'ORP',I,J,L,K,N,M,ORP(M,K,L,NY,NX) -C 2,RCOMP(M,N,K),RCCMP(M,N,K),RCMMP(M,N,K),RDORP(M,K) -8821 FORMAT(A8,6I4,30E12.4) -C ENDIF -565 CONTINUE -570 CONTINUE -C -C SORPTION PRODUCTS -C - OQC(K,L,NY,NX)=OQC(K,L,NY,NX)-CSORP(K) - OQN(K,L,NY,NX)=OQN(K,L,NY,NX)-ZSORP(K) - OQP(K,L,NY,NX)=OQP(K,L,NY,NX)-PSORP(K) - OQA(K,L,NY,NX)=OQA(K,L,NY,NX)-CSORPA(K) - OHC(K,L,NY,NX)=OHC(K,L,NY,NX)+CSORP(K) - OHN(K,L,NY,NX)=OHN(K,L,NY,NX)+ZSORP(K) - OHP(K,L,NY,NX)=OHP(K,L,NY,NX)+PSORP(K) - OHA(K,L,NY,NX)=OHA(K,L,NY,NX)+CSORPA(K) -C IF((I/1)*1.EQ.I.AND.L.EQ.3.AND.K.EQ.1)THEN -C WRITE(*,592)'OQC',I,J,NX,NY,L,K,OQC(K,L,NY,NX) -C 2,(RCOSC(M,K),M=1,4),(RDORC(M,K),M=1,2),RDOHC(K) -C 2,(CGOQC(N,K),N=1,7),CSORP(K),OHC(K,L,NY,NX),OQCI -C 4,(WFN(N,K),N=1,7),OQA(K,L,NY,NX),RDOHA(K),(RCH3X(N,K),N=1,7) -C 3,(CGOAC(N,K),N=1,7),CSORPA(K),OHA(K,L,NY,NX) -C WRITE(*,592)'OQN',I,J,NX,NY,L,K,OQN(K,L,NY,NX) -C 2,(RCOSN(M,K),M=1,4),(RDORN(M,K),M=1,2),RDOHN(K) -C 2,RCOQN*FORC(K),(CGOMN(N,K),N=1,7),ZSORP(K),OHN(K,L,NY,NX) -592 FORMAT(A8,6I4,80E12.4) -C ENDIF -590 CONTINUE -C -C MICROBIAL GROWTH FROM RESPIRATION, MINERALIZATION -C - DO 550 K=0,5 - TGROMC(K)=0.0 - IF(L.NE.0.OR.(K.NE.3.AND.K.NE.4))THEN - DO 545 N=1,7 - IF(K.NE.5.OR.(N.LE.3.OR.N.EQ.5))THEN - DO 540 M=1,2 - OMC(M,N,K,L,NY,NX)=OMC(M,N,K,L,NY,NX)+CGOMS(M,N,K) - 2-RXOMC(M,N,K)-RXMMC(M,N,K) - OMN(M,N,K,L,NY,NX)=OMN(M,N,K,L,NY,NX)+CGONS(M,N,K) - 2-RXOMN(M,N,K)-RXMMN(M,N,K) - OMP(M,N,K,L,NY,NX)=OMP(M,N,K,L,NY,NX)+CGOPS(M,N,K) - 2-RXOMP(M,N,K)-RXMMP(M,N,K) -C IF((I/30)*30.EQ.I.AND.J.EQ.15.AND.L.LE.6 -C 2.AND.K.EQ.5.AND.N.EQ.2)THEN -C WRITE(*,4488)'RDOMC',I,J,NX,NY,L,K,N,M,CGOMS(M,N,K),CGOQC(N,K) -C 4,CGOAC(N,K),RGOMO(N,K),RGOMD(N,K),RXOMC(M,N,K),RXMMC(M,N,K) -C 3,RMOMC(M,N,K),TFNX,OMGR,OMC(3,N,K,L,NY,NX),WFN(N,K) -C 3,OMC(M,N,K,L,NY,NX),OMA(N,K),TSRH -C 4,RCH3X(N,K),RH2GZ,RH2GX(4,K),FOCA(K),FOAA(K) -C 6,OQA(K,L,NY,NX),OHA(K,L,NY,NX),OQC(K,L,NY,NX),OHC(K,L,NY,NX) -C 7,OMP(M,N,K,L,NY,NX),CGOPS(M,N,K),RDOMP(M,N,K),RDMMP(M,N,K) -C 8,OMP(3,N,K,L,NY,NX),CGOMP(N,K),RIPO4(N,K) -4488 FORMAT(A8,8I4,40E12.4) -C ENDIF -C -C HUMIFICATION PRODUCTS -C - IF(L.NE.0)THEN - OSC(1,4,L,NY,NX)=OSC(1,4,L,NY,NX)+CFOMC(1,L,NY,NX) - 2*(RHOMC(M,N,K)+RHMMC(M,N,K)) - OSA(1,4,L,NY,NX)=OSA(1,4,L,NY,NX)+CFOMC(1,L,NY,NX) - 2*(RHOMC(M,N,K)+RHMMC(M,N,K)) - OSN(1,4,L,NY,NX)=OSN(1,4,L,NY,NX)+CFOMC(1,L,NY,NX) - 2*(RHOMN(M,N,K)+RHMMN(M,N,K)) - OSP(1,4,L,NY,NX)=OSP(1,4,L,NY,NX)+CFOMC(1,L,NY,NX) - 2*(RHOMP(M,N,K)+RHMMP(M,N,K)) - OSC(2,4,L,NY,NX)=OSC(2,4,L,NY,NX)+CFOMC(2,L,NY,NX) - 2*(RHOMC(M,N,K)+RHMMC(M,N,K)) - OSA(2,4,L,NY,NX)=OSA(2,4,L,NY,NX)+CFOMC(2,L,NY,NX) - 2*(RHOMC(M,N,K)+RHMMC(M,N,K)) - OSN(2,4,L,NY,NX)=OSN(2,4,L,NY,NX)+CFOMC(2,L,NY,NX) - 2*(RHOMN(M,N,K)+RHMMN(M,N,K)) - OSP(2,4,L,NY,NX)=OSP(2,4,L,NY,NX)+CFOMC(2,L,NY,NX) - 2*(RHOMP(M,N,K)+RHMMP(M,N,K)) -C IF((I/10)*10.EQ.I.AND.J.EQ.24)THEN -C WRITE(*,4445)'RHOMC',I,J,NX,NY,L,K,M,N,OSC(1,4,L,NY,NX) -C 2,OSC(2,4,L,NY,NX),CFOMC(1,L,NY,NX),CFOMC(2,L,NY,NX) -C 3,RHOMC(M,N,K),RHMMC(M,N,K) -4445 FORMAT(A8,8I4,40E12.4) -C ENDIF - ELSE - OSC(1,4,NU(NY,NX),NY,NX)=OSC(1,4,NU(NY,NX),NY,NX) - 2+CFOMC(1,NU(NY,NX),NY,NX)*(RHOMC(M,N,K)+RHMMC(M,N,K)) - OSA(1,4,NU(NY,NX),NY,NX)=OSA(1,4,NU(NY,NX),NY,NX) - 2+CFOMC(1,NU(NY,NX),NY,NX)*(RHOMC(M,N,K)+RHMMC(M,N,K)) - OSN(1,4,NU(NY,NX),NY,NX)=OSN(1,4,NU(NY,NX),NY,NX) - 2+CFOMC(1,NU(NY,NX),NY,NX)*(RHOMN(M,N,K)+RHMMN(M,N,K)) - OSP(1,4,NU(NY,NX),NY,NX)=OSP(1,4,NU(NY,NX),NY,NX) - 2+CFOMC(1,NU(NY,NX),NY,NX)*(RHOMP(M,N,K)+RHMMP(M,N,K)) - OSC(2,4,NU(NY,NX),NY,NX)=OSC(2,4,NU(NY,NX),NY,NX) - 2+CFOMC(2,NU(NY,NX),NY,NX)*(RHOMC(M,N,K)+RHMMC(M,N,K)) - OSA(2,4,NU(NY,NX),NY,NX)=OSA(2,4,NU(NY,NX),NY,NX) - 2+CFOMC(2,NU(NY,NX),NY,NX)*(RHOMC(M,N,K)+RHMMC(M,N,K)) - OSN(2,4,NU(NY,NX),NY,NX)=OSN(2,4,NU(NY,NX),NY,NX) - 2+CFOMC(2,NU(NY,NX),NY,NX)*(RHOMN(M,N,K)+RHMMN(M,N,K)) - OSP(2,4,NU(NY,NX),NY,NX)=OSP(2,4,NU(NY,NX),NY,NX) - 2+CFOMC(2,NU(NY,NX),NY,NX)*(RHOMP(M,N,K)+RHMMP(M,N,K)) - ENDIF -540 CONTINUE -C -C INPUTS TO NONSTRUCTURAL POOLS -C - CGROMC=CGOMC(N,K)-RGOMO(N,K)-RGOMD(N,K) - TGROMC(K)=TGROMC(K)+CGROMC - DO 555 M=1,2 - OMC(3,N,K,L,NY,NX)=OMC(3,N,K,L,NY,NX)-CGOMS(M,N,K) - 2+R3OMC(M,N,K) - OMN(3,N,K,L,NY,NX)=OMN(3,N,K,L,NY,NX)-CGONS(M,N,K) - 2+R3OMN(M,N,K)+R3MMN(M,N,K) - OMP(3,N,K,L,NY,NX)=OMP(3,N,K,L,NY,NX)-CGOPS(M,N,K) - 2+R3OMP(M,N,K)+R3MMP(M,N,K) - RCO2X(N,K)=RCO2X(N,K)+R3MMC(M,N,K) -555 CONTINUE - OMC(3,N,K,L,NY,NX)=OMC(3,N,K,L,NY,NX)+CGROMC - OMN(3,N,K,L,NY,NX)=OMN(3,N,K,L,NY,NX)+CGOMN(N,K) - 2+RINH4(N,K)+RINB4(N,K)+RINO3(N,K)+RINB3(N,K)+RN2FX(N,K) - OMP(3,N,K,L,NY,NX)=OMP(3,N,K,L,NY,NX)+CGOMP(N,K) - 2+RIPO4(N,K)+RIPB4(N,K) - IF(L.EQ.0)THEN - OMN(3,N,K,L,NY,NX)=OMN(3,N,K,L,NY,NX)+RINH4R(N,K)+RINO3R(N,K) - OMP(3,N,K,L,NY,NX)=OMP(3,N,K,L,NY,NX)+RIPO4R(N,K) - ENDIF -C IF(NY.EQ.5.AND.L.EQ.10.AND.K.EQ.3.AND.N.EQ.2)THEN -C WRITE(*,5556)'OMC3',I,J,NX,NY,L,K,N,OMC(3,N,K,L,NY,NX) -C 2,CGOMS(1,N,K),CGOMS(2,N,K),CGROMC,OMP(3,N,K,L,NY,NX) -C 3,CGOPS(1,N,K),CGOPS(2,N,K),CGOMP(N,K),RIPO4(N,K) -C 4,CGOMC(N,K),RGOMO(N,K),RGOMD(N,K),RMOMT,WFN(N,K) -5556 FORMAT(A8,7I4,20E12.4) -C ENDIF - ENDIF -545 CONTINUE - ENDIF -550 CONTINUE - DO 475 K=0,KL - OSCT(K)=0.0 - OSAT(K)=0.0 - DO 475 M=1,4 - OSCT(K)=OSCT(K)+OSC(M,K,L,NY,NX) - OSAT(K)=OSAT(K)+OSA(M,K,L,NY,NX) -475 CONTINUE - DO 480 K=0,KL - OSCX=OSCT(K)-OSAT(K) - IF(OSCX.GT.ZEROS(NY,NX))THEN - IF(OSAT(K).GT.ZEROS(NY,NX))THEN - COSC=OSCX/OSAT(K) - DFNA=COSC/(COSC+DCKX(K)) - ELSE - DFNA=1.0 - ENDIF - DO 485 M=1,4 - OSA(M,K,L,NY,NX)=AMIN1(OSC(M,K,L,NY,NX) - 2,OSA(M,K,L,NY,NX)+DOSA(K)*(AMAX1(DOSM(K),AMIN1(DOSX(K),TGROMC(K) - 3/AREA(3,L,NY,NX))))*AREA(3,L,NY,NX) - 3*(OSC(M,K,L,NY,NX)-OSA(M,K,L,NY,NX))/OSCX*DFNA) -C IF(INT(I/30)*30.EQ.I.AND.J.EQ.19.AND.K.LE.1)THEN -C WRITE(*,8822)'OSA',I,J,L,K,M,OSA(M,K,L,NY,NX),OSC(M,K,L,NY,NX) -C 3,OSAT(K),OSCT(K),(OSC(M,K,L,NY,NX)-OSA(M,K,L,NY,NX)) -C 3/OSCX,DOSA(K),ROQCK(K),TFNX,TFNX,WFNG,COSC,DFNA -C 4,(TGROMC(K)/AREA(3,L,NY,NX)) -C 5,(AMAX1(DOSM(K),AMIN1(DOSX(K) -C 3,TGROMC(K)/AREA(3,L,NY,NX)))),TGROMC(K) -C ENDIF -8822 FORMAT(A8,5I4,20E12.4) -485 CONTINUE - ELSE - DO 490 M=1,4 - OSA(M,K,L,NY,NX)=AMIN1(OSC(M,K,L,NY,NX),OSA(M,K,L,NY,NX)) -490 CONTINUE - ENDIF -C IF(L.EQ.0)THEN -C WRITE(*,8823)'OSC',I,J,L,K,((OMC(M,N,K,L,NY,NX),N=1,7),M=1,3) -C 2,(ORC(M,K,L,NY,NX),M=1,2),OQC(K,L,NY,NX),OQCH(K,L,NY,NX) -C 3,OHC(K,L,NY,NX),OQA(K,L,NY,NX),OQAH(K,L,NY,NX),OHA(K,L,NY,NX) -C 4,(OSC(M,K,L,NY,NX),M=1,4) -8823 FORMAT(A8,4I4,100E24.16) -C ENDIF -480 CONTINUE -C -C AGGREGATE TRANSFORMATIONS -C - TRINH=0.0 - TRINO=0.0 - TRIPO=0.0 - TRINB=0.0 - TRIOB=0.0 - TRIPB=0.0 - TRGOM=0.0 - TRGOC=0.0 - TRGOD=0.0 - TRGOA=0.0 - TRGOH=0.0 - TUPOX=0.0 - TRDN3=0.0 - TRDNB=0.0 - TRDN2=0.0 - TRD2B=0.0 - TRDNO=0.0 - TRN2F=0.0 - DO 650 K=0,5 - IF(L.NE.0.OR.(K.NE.3.AND.K.NE.4))THEN - DO 640 N=1,7 - IF(K.NE.5.OR.(N.LE.3.OR.N.EQ.5))THEN - TRINH=TRINH+RINH4(N,K) - TRINO=TRINO+RINO3(N,K) - TRIPO=TRIPO+RIPO4(N,K) - TRINB=TRINB+RINB4(N,K) - TRIOB=TRIOB+RINB3(N,K) - TRIPB=TRIPB+RIPB4(N,K) - TRN2F=TRN2F+RN2FX(N,K) - IF(L.EQ.NU(NY,NX))THEN - TRINH=TRINH+RINH4R(N,K) - TRINO=TRINO+RINO3R(N,K) - TRIPO=TRIPO+RIPO4R(N,K) - ENDIF -C IF(NY.EQ.5.AND.L.EQ.10.AND.K.EQ.3.AND.N.EQ.2)THEN -C WRITE(*,4469)'TRINH',I,J,NX,NY,L,K,N,TRINH,RINH4(N,K),RINH4R(N,K) -C WRITE(*,4469)'TRIPO',I,J,NX,NY,L,K,N,TRIPO,RIPO4(N,K),RIPO4R(N,K) -C 2,CGOMP(N,K) -4469 FORMAT(A8,7I4,20E12.4) -C ENDIF - TRGOM=TRGOM+RCO2X(N,K) - TRGOC=TRGOC+RCH4X(N,K) - TRGOD=TRGOD+RGOMD(N,K) - TUPOX=TUPOX+RUPOX(N,K) - TRDN3=TRDN3+RDNO3(N,K) - TRDNB=TRDNB+RDNOB(N,K) - TRDN2=TRDN2+RDNO2(N,K) - TRD2B=TRD2B+RDN2B(N,K) - TRDNO=TRDNO+RDN2O(N,K) - TRGOH=TRGOH+RH2GX(N,K) -C IF(L.EQ.NU(NY,NX))THEN -C WRITE(*,3333)'TUPOX',I,J,NX,NY,L,K,N,TUPOX,RUPOX(N,K) -C ENDIF -C IF(J.EQ.12.AND.L.LE.4)THEN -C WRITE(*,3333)'N2O',I,J,NX,NY,L,K,N,TRDN2,TRD2B,TRDNO -C 2,RDNO2(N,K),RDN2B(N,K),RDN2O(N,K),COXYS(L,NY,NX) -C 3,COXYG(L,NY,NX) -C WRITE(*,3333)'TRGOH',I,J,NX,NY,L,K,N,TRGOH,RH2GX(N,K) -C 2,RGOMO(N,K) -3333 FORMAT(A8,7I4,20E12.4) -C ENDIF - ENDIF -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 - TRGOA=TRGOA+CGOMC(N,5) - ENDIF - ENDIF -645 CONTINUE -C -C ALLOCATE AGGREGATED TRANSFORMATIONS INTO ARRAYS TO UPDATE -C STATE VARIABLES IN 'REDIST' -C - RCO2O(L,NY,NX)=TRGOA-TRGOM-TRGOD-RVOXA(3) - RCH4O(L,NY,NX)=RVOXA(3)+CGOMC(3,5)-TRGOC - RH2GO(L,NY,NX)=RH2GZ-TRGOH - 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 WRITE(*,2468)'RN2O',I,J,NX,NY,L -C 2,RN2O(L,NY,NX),TRDN2,TRD2B,RCN2O,RCN2B,TRDNO -C 2,RCH4O(L,NY,NX),RVOXA(3) -C 2,CGOMC(3,5),TRGOC,(OMA(N,1),N=1,7) -2468 FORMAT(A8,5I4,20E12.4) -C ENDIF - DO 655 K=0,4 - DO 660 M=1,4 - XOQCS(K,L,NY,NX)=XOQCS(K,L,NY,NX)+RCOSC(M,K) - XOQNS(K,L,NY,NX)=XOQNS(K,L,NY,NX)+RCOSN(M,K) - XOQPS(K,L,NY,NX)=XOQPS(K,L,NY,NX)+RCOSP(M,K) -660 CONTINUE - DO 665 M=1,2 - XOQCS(K,L,NY,NX)=XOQCS(K,L,NY,NX)+RDORC(M,K) - XOQNS(K,L,NY,NX)=XOQNS(K,L,NY,NX)+RDORN(M,K) - XOQPS(K,L,NY,NX)=XOQPS(K,L,NY,NX)+RDORP(M,K) -665 CONTINUE - XOQCS(K,L,NY,NX)=XOQCS(K,L,NY,NX)+RDOHC(K) - XOQNS(K,L,NY,NX)=XOQNS(K,L,NY,NX)+RDOHN(K) - XOQPS(K,L,NY,NX)=XOQPS(K,L,NY,NX)+RDOHP(K) - XOQAS(K,L,NY,NX)=XOQAS(K,L,NY,NX)+RDOHA(K) - DO 670 N=1,7 - XOQCS(K,L,NY,NX)=XOQCS(K,L,NY,NX)-CGOQC(N,K) - XOQNS(K,L,NY,NX)=XOQNS(K,L,NY,NX)-CGOMN(N,K) - XOQPS(K,L,NY,NX)=XOQPS(K,L,NY,NX)-CGOMP(N,K) - XOQAS(K,L,NY,NX)=XOQAS(K,L,NY,NX)-CGOAC(N,K)+RCH3X(N,K) -670 CONTINUE - XOQCS(K,L,NY,NX)=XOQCS(K,L,NY,NX)-CSORP(K) - XOQNS(K,L,NY,NX)=XOQNS(K,L,NY,NX)-ZSORP(K) - XOQPS(K,L,NY,NX)=XOQPS(K,L,NY,NX)-PSORP(K) - XOQAS(K,L,NY,NX)=XOQAS(K,L,NY,NX)-CSORPA(K) -655 CONTINUE - XNH4S(L,NY,NX)=-TRINH-RVOXA(1) - XNO3S(L,NY,NX)=-TRINO+RVOXA(2)-TRDN3+RCNO3 - XNO2S(L,NY,NX)=RVOXA(1)-RVOXA(2)+TRDN3-TRDN2-RCNO2 - XH2PS(L,NY,NX)=-TRIPO - XNH4B(L,NY,NX)=-TRINB-RVOXB(1) - XNO3B(L,NY,NX)=-TRIOB+RVOXB(2)-TRDNB+RCN3B - XNO2B(L,NY,NX)=RVOXB(1)-RVOXB(2)+TRDNB-TRD2B-RCNOB - XH2BS(L,NY,NX)=-TRIPB - XN2GS(L,NY,NX)=TRN2F - XZHYS(L,NY,NX)=0.1429*(RVOXA(1)+RVOXB(1)-TRDN3-TRDNB) - 2-0.0714*(TRDN2+TRD2B+TRDNO) - TFNQ(L,NY,NX)=TFNX - VOLQ(L,NY,NX)=VOLWZ -C IF(L.EQ.0)THEN -C WRITE(*,2323)'XNH4S',I,J,L,XNH4S(L,NY,NX) -C 2,TRINH,RVOXA(1),VLNH4(L,NY,NX) -C WRITE(*,2323)'XNO3S',I,J,L,XNO3S(L,NY,NX) -C 2,TRINO,RVOXA(2),VLNO3(L,NY,NX),TRDN3,RCNO3 -C WRITE(*,2323)'XH2PS',I,J,L,XH2PS(L,NY,NX) -C 2,RIPOT,TRIPO,VLPO4(L,NY,NX) -C WRITE(*,2323)'XNO2B',I,J,L,XNO2B(L,NY,NX),RVOXB(1) -C 2,VLNHB(L,NY,NX),RVOXB(2),VLNOB(L,NY,NX),TRDNB,TRD2B,RCNOB -2323 FORMAT(A8,3I4,12E12.4) -C ENDIF - ELSE - RCO2O(L,NY,NX)=0.0 - RCH4O(L,NY,NX)=0.0 - RH2GO(L,NY,NX)=0.0 - RUPOXO(L,NY,NX)=0.0 - RN2G(L,NY,NX)=0.0 - RN2O(L,NY,NX)=0.0 - XNH4S(L,NY,NX)=0.0 - XNO3S(L,NY,NX)=0.0 - XNO2S(L,NY,NX)=0.0 - XH2PS(L,NY,NX)=0.0 - XNH4B(L,NY,NX)=0.0 - XNO3B(L,NY,NX)=0.0 - XNO2B(L,NY,NX)=0.0 - XH2BS(L,NY,NX)=0.0 - XN2GS(L,NY,NX)=0.0 - XZHYS(L,NY,NX)=0.0 - ENDIF -C -C ADJUST LAYERING OF SOC -C - IF(L.EQ.0.OR.(L.GE.NU(NY,NX).AND.L.LT.NL(NY,NX)))THEN -C 2.AND.CDPTH(L,NY,NX).LE.CDPTH(NU(NY,NX)-1,NY,NX)+0.60)THEN - IF(L.EQ.0)THEN - LL=NU(NY,NX) - IF(ORGR(L,NY,NX).GT.0.0)THEN - FOSCXS=AMIN1(1.0,FOSCZ0/ORGR(L,NY,NX)*TOMA*TFNX) - ELSE - FOSCXS=0.0 - ENDIF - ELSE - LL=L+1 - OSCXD=(ORGR(L,NY,NX)*VOLT(LL,NY,NX)-ORGR(LL,NY,NX)*VOLT(L,NY,NX)) - 2/(VOLT(L,NY,NX)+VOLT(LL,NY,NX)) - IF(OSCXD.GT.0.0.AND.ORGR(L,NY,NX).GT.ZEROS(NY,NX))THEN - FOSCXD=OSCXD/ORGR(L,NY,NX) - ELSEIF(OSCXD.LT.0.0.AND.ORGR(LL,NY,NX).GT.ZEROS(NY,NX))THEN - FOSCXD=OSCXD/ORGR(LL,NY,NX) - ELSE - FOSCXD=0.0 - ENDIF - FOSCXS=FOSCZL*FOSCXD*TFNX*TOMA/VOLT(L,NY,NX) - ENDIF -C IF(L.EQ.3.AND.K.EQ.2)THEN -C WRITE(*,1115)'MIX',I,J,L,LL,FOSCXS,FOSCZ0,FOSCZL,OSCXD,TOMA -C 2,TFNX,ORGR(L,NY,NX),VOLT(LL,NY,NX),ORGR(LL,NY,NX),VOLT(L,NY,NX) -1115 FORMAT(A8,4I4,20E12.4) -C ENDIF - IF(FOSCXS.NE.0.0)THEN - DO 7971 K=1,2 - DO 7961 N=1,7 - DO 7962 M=1,3 - IF(FOSCXS.GT.0.0)THEN - OMCXS=FOSCXS*AMAX1(0.0,OMC(M,N,K,L,NY,NX)) - OMNXS=FOSCXS*AMAX1(0.0,OMN(M,N,K,L,NY,NX)) - OMPXS=FOSCXS*AMAX1(0.0,OMP(M,N,K,L,NY,NX)) - ELSE - OMCXS=FOSCXS*AMAX1(0.0,OMC(M,N,K,LL,NY,NX)) - OMNXS=FOSCXS*AMAX1(0.0,OMN(M,N,K,LL,NY,NX)) - OMPXS=FOSCXS*AMAX1(0.0,OMP(M,N,K,LL,NY,NX)) - ENDIF - OMC(M,N,K,L,NY,NX)=OMC(M,N,K,L,NY,NX)-OMCXS - OMN(M,N,K,L,NY,NX)=OMN(M,N,K,L,NY,NX)-OMNXS - OMP(M,N,K,L,NY,NX)=OMP(M,N,K,L,NY,NX)-OMPXS - OMC(M,N,K,LL,NY,NX)=OMC(M,N,K,LL,NY,NX)+OMCXS - OMN(M,N,K,LL,NY,NX)=OMN(M,N,K,LL,NY,NX)+OMNXS - OMP(M,N,K,LL,NY,NX)=OMP(M,N,K,LL,NY,NX)+OMPXS -7962 CONTINUE -7961 CONTINUE -7971 CONTINUE - DO 7901 K=1,2 - DO 7941 M=1,2 - IF(FOSCXS.GT.0.0)THEN - ORCXS=FOSCXS*AMAX1(0.0,ORC(M,K,L,NY,NX)) - ORNXS=FOSCXS*AMAX1(0.0,ORN(M,K,L,NY,NX)) - ORPXS=FOSCXS*AMAX1(0.0,ORP(M,K,L,NY,NX)) - ELSE - ORCXS=FOSCXS*AMAX1(0.0,ORC(M,K,LL,NY,NX)) - ORNXS=FOSCXS*AMAX1(0.0,ORN(M,K,LL,NY,NX)) - ORPXS=FOSCXS*AMAX1(0.0,ORP(M,K,LL,NY,NX)) - ENDIF - ORC(M,K,L,NY,NX)=ORC(M,K,L,NY,NX)-ORCXS - ORN(M,K,L,NY,NX)=ORN(M,K,L,NY,NX)-ORNXS - ORP(M,K,L,NY,NX)=ORP(M,K,L,NY,NX)-ORPXS - ORC(M,K,LL,NY,NX)=ORC(M,K,LL,NY,NX)+ORCXS - ORN(M,K,LL,NY,NX)=ORN(M,K,LL,NY,NX)+ORNXS - ORP(M,K,LL,NY,NX)=ORP(M,K,LL,NY,NX)+ORPXS -C IF(L.EQ.3.AND.K.EQ.2)THEN -C WRITE(*,7942)'ORC',I,J,L,LL,K,M,ORC(M,K,L,NY,NX) -C 2,ORC(M,K,LL,NY,NX),ORCXS,FOSCXS -7942 FORMAT(A8,6I4,20E12.4) -C ENDIF -7941 CONTINUE - IF(FOSCXS.GT.0.0)THEN - OQCXS=FOSCXS*AMAX1(0.0,OQC(K,L,NY,NX)) - OQCHXS=FOSCXS*AMAX1(0.0,OQCH(K,L,NY,NX)) - OHCXS=FOSCXS*AMAX1(0.0,OHC(K,L,NY,NX)) - OQAXS=FOSCXS*AMAX1(0.0,OQA(K,L,NY,NX)) - OQAHXS=FOSCXS*AMAX1(0.0,OQAH(K,L,NY,NX)) - OHAXS=FOSCXS*AMAX1(0.0,OHA(K,L,NY,NX)) - OQNXS=FOSCXS*AMAX1(0.0,OQN(K,L,NY,NX)) - OQNHXS=FOSCXS*AMAX1(0.0,OQNH(K,L,NY,NX)) - OHNXS=FOSCXS*AMAX1(0.0,OHN(K,L,NY,NX)) - OQPXS=FOSCXS*AMAX1(0.0,OQP(K,L,NY,NX)) - OQPHXS=FOSCXS*AMAX1(0.0,OQPH(K,L,NY,NX)) - OHPXS=FOSCXS*AMAX1(0.0,OHP(K,L,NY,NX)) - ELSE - OQCXS=FOSCXS*AMAX1(0.0,OQC(K,LL,NY,NX)) - OQCHXS=FOSCXS*AMAX1(0.0,OQCH(K,LL,NY,NX)) - OHCXS=FOSCXS*AMAX1(0.0,OHC(K,LL,NY,NX)) - OQAXS=FOSCXS*AMAX1(0.0,OQA(K,LL,NY,NX)) - OQAHXS=FOSCXS*AMAX1(0.0,OQAH(K,LL,NY,NX)) - OHAXS=FOSCXS*AMAX1(0.0,OHA(K,LL,NY,NX)) - OQNXS=FOSCXS*AMAX1(0.0,OQN(K,LL,NY,NX)) - OQNHXS=FOSCXS*AMAX1(0.0,OQNH(K,LL,NY,NX)) - OHNXS=FOSCXS*AMAX1(0.0,OHN(K,LL,NY,NX)) - OQPXS=FOSCXS*AMAX1(0.0,OQP(K,LL,NY,NX)) - OQPHXS=FOSCXS*AMAX1(0.0,OQPH(K,LL,NY,NX)) - OHPXS=FOSCXS*AMAX1(0.0,OHP(K,LL,NY,NX)) - ENDIF - OQC(K,L,NY,NX)=OQC(K,L,NY,NX)-OQCXS - OQCH(K,L,NY,NX)=OQCH(K,L,NY,NX)-OQCHXS - OHC(K,L,NY,NX)=OHC(K,L,NY,NX)-OHCXS - OQA(K,L,NY,NX)=OQA(K,L,NY,NX)-OQAXS - OQAH(K,L,NY,NX)=OQAH(K,L,NY,NX)-OQAHXS - OHA(K,L,NY,NX)=OHA(K,L,NY,NX)-OHAXS - OQN(K,L,NY,NX)=OQN(K,L,NY,NX)-OQNXS - OQNH(K,L,NY,NX)=OQNH(K,L,NY,NX)-OQNHXS - OHN(K,L,NY,NX)=OHN(K,L,NY,NX)-OHNXS - OQP(K,L,NY,NX)=OQP(K,L,NY,NX)-OQPXS - OQPH(K,L,NY,NX)=OQPH(K,L,NY,NX)-OQPHXS - OHP(K,L,NY,NX)=OHP(K,L,NY,NX)-OHPXS - OQC(K,LL,NY,NX)=OQC(K,LL,NY,NX)+OQCXS - OQCH(K,LL,NY,NX)=OQCH(K,LL,NY,NX)+OQCHXS - OHC(K,LL,NY,NX)=OHC(K,LL,NY,NX)+OHCXS - OQA(K,LL,NY,NX)=OQA(K,LL,NY,NX)+OQAXS - OQAH(K,LL,NY,NX)=OQAH(K,LL,NY,NX)+OQAHXS - OHA(K,LL,NY,NX)=OHA(K,LL,NY,NX)+OHAXS - OQN(K,LL,NY,NX)=OQN(K,LL,NY,NX)+OQNXS - OQNH(K,LL,NY,NX)=OQNH(K,LL,NY,NX)+OQNHXS - OHN(K,LL,NY,NX)=OHN(K,LL,NY,NX)+OHNXS - OQP(K,LL,NY,NX)=OQP(K,LL,NY,NX)+OQPXS - OQPH(K,LL,NY,NX)=OQPH(K,LL,NY,NX)+OQPHXS - OHP(K,LL,NY,NX)=OHP(K,LL,NY,NX)+OHPXS - DO 7931 M=1,4 - IF(FOSCXS.GT.0.0)THEN - OSCXS=FOSCXS*AMAX1(0.0,OSC(M,K,L,NY,NX)) - OSAXS=FOSCXS*AMAX1(0.0,OSA(M,K,L,NY,NX)) - OSNXS=FOSCXS*AMAX1(0.0,OSN(M,K,L,NY,NX)) - OSPXS=FOSCXS*AMAX1(0.0,OSP(M,K,L,NY,NX)) - ELSE - OSCXS=FOSCXS*AMAX1(0.0,OSC(M,K,LL,NY,NX)) - OSAXS=FOSCXS*AMAX1(0.0,OSA(M,K,LL,NY,NX)) - OSNXS=FOSCXS*AMAX1(0.0,OSN(M,K,LL,NY,NX)) - OSPXS=FOSCXS*AMAX1(0.0,OSP(M,K,LL,NY,NX)) - ENDIF - OSC(M,K,L,NY,NX)=OSC(M,K,L,NY,NX)-OSCXS - OSA(M,K,L,NY,NX)=OSA(M,K,L,NY,NX)-OSAXS - OSN(M,K,L,NY,NX)=OSN(M,K,L,NY,NX)-OSNXS - OSP(M,K,L,NY,NX)=OSP(M,K,L,NY,NX)-OSPXS - OSC(M,K,LL,NY,NX)=OSC(M,K,LL,NY,NX)+OSCXS - OSA(M,K,LL,NY,NX)=OSA(M,K,LL,NY,NX)+OSAXS - OSN(M,K,LL,NY,NX)=OSN(M,K,LL,NY,NX)+OSNXS - OSP(M,K,LL,NY,NX)=OSP(M,K,LL,NY,NX)+OSPXS -7931 CONTINUE -7901 CONTINUE - ENDIF -C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.EQ.3)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 -2123 FORMAT(A8,5I4,12E15.4) -C ENDIF - ENDIF -998 CONTINUE -C WRITE(20,3434)'RN2O',IYRC,I,J,(RN2O(L,NY,NX),L=0,NL(NY,NX)) -3434 FORMAT(A8,3I4,20E12.4) -9990 CONTINUE -9995 CONTINUE - RETURN - END + SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) +C +C THIS SUBROUTINE CALCULATES ALL SOIL BIOLOGICAL TRANSFORMATIONS +C + include "parameters.h" + include "blkc.h" + include "blk2a.h" + include "blk2b.h" + include "blk2c.h" + include "blk8a.h" + include "blk8b.h" + include "blk10.h" + include "blk11a.h" + include "blk11b.h" + include "blk13a.h" + include "blk13b.h" + include "blk13c.h" + include "blk13d.h" + include "blk15a.h" + include "blk15b.h" + include "blk18a.h" + include "blk18b.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) + 3,RHOSN(4,0:4),RHOSP(4,0:4),RCOSC(4,0:4),RCOSN(4,0:4),RCOSP(4,0:4) + 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),RIPB4(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) + 6,CGOMP(7,0:5),RDMMC(2,7,0:5),RHMMC(2,7,0:5),RCMMC(2,7,0:5) + 7,RDMMN(2,7,0:5),RHMMN(2,7,0:5),RCMMN(2,7,0:5),RDMMP(2,7,0:5) + 8,RHMMP(2,7,0:5),RCMMP(2,7,0:5),RCCMC(2,7,0:4) + 9,RCCMN(2,7,0:4),RCCMP(2,7,0:4),RN2FX(7,0:5),TOMK(0:5) + 1,TONK(0:5),TOPK(0:5),SPOMC(2),OMC2(7,0:5),TFNG(7,0:5),TFNR(7,0:5) + 2,OMN2(7,0:5),FOM2(7,0:5),FOCA(0:4),FOAA(0:4),RXOMC(2,7,0:5) + 3,RXOMN(2,7,0:5),RXOMP(2,7,0:5),R3OMC(2,7,0:5),R3OMN(2,7,0:5) + 4,R3OMP(2,7,0:5),RXMMC(2,7,0:5),RXMMN(2,7,0:5),RXMMP(2,7,0:5) + 4,R3MMC(2,7,0:5),R3MMN(2,7,0:5),R3MMP(2,7,0:5),WFN(7,0:5) + DIMENSION CGOQC(7,0:5),CGOAC(7,0:5),ROQCK(0:4),XOQCK(0:4) + 2,EN2F(7),ORCT(0:4),OSCT(0:4),OSAT(0:4),ZNH4T(0:JZ),ZNO3T(0:JZ) + 3,ZNO2T(0:JZ),H2P4T(0:JZ),RINH4R(7,0:5),RINO3R(7,0:5) + 4,RIPO4R(7,0:5),FNH4XR(7,0:5),FNO3XR(7,0:5),FPO4XR(7,0:5) + 5,RGOMY(7,0:5),CNQ(0:4),CPQ(0:4),CNH(0:4),CPH(0:4) + 6,CNS(4,0:4),CPS(4,0:4),DCKM(0:4),DCKX(0:4),ROQCD(7,0:4) + 7,DOSA(0:4),DOSX(0:4),DOSM(0:4),FORC(0:5),DOMX(0:5) + 8,CGOMS(2,7,0:5),CGONS(2,7,0:5),CGOPS(2,7,0:5) + 1,TONX(0:5),TOPX(0:5),FCNK(0:4),FCPK(0:4) + 2,RCO2X(7,0:5),RCH3X(7,0:5),RCH4X(7,0:5),RVOXA(7),RVOXB(7) + 2,TGROMC(0:7),XOQCZ(0:4),XOQNZ(0:4),XOQPZ(0:4),XOQAZ(0:4) + 3,XOMCZ(3,7,0:4),XOMNZ(3,7,0:4),XOMPZ(3,7,0:4) + 4,FCN(7,0:5),FCP(7,0:5),FCNP(7,0:5),FSBST(7,0:5) + 5,TCGOQC(0:5),TCGOAC(0:5),TCGOMN(0:5),TCGOMP(0:5),TRINH4(JY,JX) + 6,TRN2ON(JY,JX),TRN2OD(JY,JX),TRN2GD(JY,JX) +C +C SUBSTRATE DECOMPOSITION BY MICROBIAL POPULATIONS +C + PARAMETER (ORAD=1.0E-06,BIOS=1.0E-06/(4.19*ORAD**3) + 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,DOMK=2.5E+02 + 5,FOSCZ0=2.0E-02,FOSCZL=1.0E-06,FMN=1.0E-03) +C +C SPECIFIC RESPIRATION RATES, M-M UPTAKE CONSTANTS, +C STOICHIOMETRIC CONSTANTS FOR MICROBIAL REDOX REACTIONS +C + PARAMETER (VMXO=0.10,VMXF=0.10,VMXM=0.10,VMXH=0.25,VMXN=0.25 + 2,VMX4=0.25,VMXC=0.10,OQKM=1.2E+01,OQKA=1.2E+01,OQKAM=1.2E+01 + 3,CCKM=0.15,CCK4=1.2E-04,ZHKM=2.0E-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,C3KI=7.0,ECNH=0.30 + 7,ECNO=0.10,ECN3=0.857,ECN2=0.857,ECN1=0.429,RNFNI=1.25E-04 + 8,RNFNG=0.015,ECHO=0.75,VMKI=2.50,OXKA=0.32 + 9,EDNH=1.00,EDNA=1.00) +C +C ENERGY REQUIREMENTS FOR MICROBIAL GROWTH AND +C ENERGY YIELDS FROM REDUCTION OF O2, OC, CH4, NO3, N2 +C + PARAMETER (EOMC=25.0,EOMD=37.5,EOMG=37.5,EOMF=25.0,EOMH=25.0 + 2,EOMN=75.0,GO2X=37.5,GCHX=4.50,GO2A=GO2X-GCHX,GC4X=3.00 + 3,GCOX=11.00,GNOX=10.0,GN2X=187.5,EN2X=GO2X/GN2X,EN2Y=GCHX/GN2X + 4,EO2X=1.0/(1.0+GO2X/EOMC),EO2G=1.0/(1.0+GO2X/EOMG) + 5,EO2D=1.0/(1.0+GO2X/EOMD),ENFX=1.0/(1.0+GO2X/EOMN) + 6,ENOX=1.0/(1.0+GNOX/EOMC),EO2A=1.0/(1.0+GO2A/EOMC)) +C +C SORPTION RATE CONSTANTS +C + PARAMETER (TSORP=0.5,HSORP=1.0) +C +C SPECIFIC DECOMPOSITION RATES +C + PARAMETER (SPOHC=0.25,SPOHA=0.25,RMOM=0.010) + DATA SPOSC/10.0,10.0,1.5,0.25,10.0,10.0,1.5,0.25 + 2,10.0,10.0,1.5,0.25,0.05,0.00,0.00,0.00 + 3,0.05,0.0167,0.00,0.00/ + DATA SPORC/10.0,1.5/ + DATA SPOMC/10.0E-03,5.0E-04/ + DATA DCKM/0.25E+03,0.25E+03,0.25E+03,1.0E+03,1.0E+03/ + DATA DOSA/5.0E+00,5.0E+00,5.0E+00,5.0E+00,5.0E+00/ + DATA DOSX/0.0500,0.0500,0.0500,0.0125,0.0125/ + DATA DOSM/0.0050,0.0050,0.0050,0.0025,0.0025/ + DATA DCKX/0.50,0.50,0.50,0.00,0.00/ + DATA DOMX/1.0,1.0,1.0,1.0,1.0,0.001/ +C +C MICROBIAL C:N:P RATIOS DURING HUMIFICATION +C + DATA EN2F/0.0,0.0,0.0,0.0,0.0,EN2X,EN2Y/ + REAL*4 WFNG,TFNX,TFNY,TFNG,TFNR,CNSHZ,CPSHZ,FRM +C REAL*16 B,C + DO 9995 NX=NHW,NHE + DO 9990 NY=NVN,NVS +C IF(I.EQ.1.AND.J.EQ.1)THEN +C TRINH4(NY,NX)=0.0 +C TRN2ON(NY,NX)=0.0 +C TRN2OD(NY,NX)=0.0 +C TRN2GD(NY,NX)=0.0 +C ENDIF + DO 998 L=0,NL(NY,NX) + IF(L.EQ.0.OR.L.GE.NU(NY,NX))THEN + IF(L.EQ.0)THEN + KL=2 +C ZNH4T(NU(NY,NX))=AMAX1(0.0,ZNH4S(NU(NY,NX),NY,NX)) +C 2+AMAX1(0.0,ZNH4B(NU(NY,NX),NY,NX)) +C ZNO3T(NU(NY,NX))=AMAX1(0.0,ZNO3S(NU(NY,NX),NY,NX)) +C 2+AMAX1(0.0,ZNO3B(NU(NY,NX),NY,NX)) +C ZNO2T(NU(NY,NX))=AMAX1(0.0,ZNO2S(NU(NY,NX),NY,NX)) +C 2+AMAX1(0.0,ZNO2B(NU(NY,NX),NY,NX)) +C H2P4T(NU(NY,NX))=AMAX1(0.0,H2PO4(NU(NY,NX),NY,NX)) +C 2+AMAX1(0.0,H2POB(NU(NY,NX),NY,NX)) + 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)) + 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)) + ENDIF +C +C TEMPERATURE FUNCTIONS FOR GROWTH AND MAINTENANCE +C WITH OFFSET FOR THERMAL ADAPTATION +C + TKSO=TKS(L,NY,NX)+OFFSET(NY,NX) + RTK=8.3143*TKSO + STK=710.0*TKSO + ACTV=1+EXP((197500-STK)/RTK)+EXP((STK-222500)/RTK) + TFNX=EXP(25.229-62500/RTK)/ACTV +C TKSM=AMAX1(258.15,TKS(L,NY,NX))+OFFSET(NY,NX) +C RTK=8.3143*TKSM +C STK=710.0*TKSM + ACTVM=1+EXP((195000-STK)/RTK)+EXP((STK-232500)/RTK) + TFNY=EXP(25.214-62500/RTK)/ACTVM + OXYI=1.0-1.0/(1.0+EXP(1.0*(-COXYS(L,NY,NX)+3.0))) +C +C NITRIFICATION INHIBITION +C + IF(ZNFN0(L,NY,NX).GT.ZEROS(NY,NX))THEN + ZNFNI(L,NY,NX)=AMAX1(0.0,ZNFNI(L,NY,NX)-RNFNI*AMAX1(0.50,TFNX)) + ZNFNG(L,NY,NX)=ZNFNG(L,NY,NX)+RNFNG*TFNX + 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)) + IF(ZNH4T(L).GT.ZEROS(NY,NX))THEN + FNH4S=AMAX1(0.0,ZNH4S(L,NY,NX))/ZNH4T(L) + FNHBS=AMAX1(0.0,ZNH4B(L,NY,NX))/ZNH4T(L) + ELSE + FNH4S=VLNH4(L,NY,NX) + FNHBS=VLNHB(L,NY,NX) + ENDIF + ZNO3T(L)=AMAX1(0.0,ZNO3S(L,NY,NX))+AMAX1(0.0,ZNO3B(L,NY,NX)) + IF(ZNO3T(L).GT.ZEROS(NY,NX))THEN + FNO3S=AMAX1(0.0,ZNO3S(L,NY,NX))/ZNO3T(L) + FNO3B=AMAX1(0.0,ZNO3B(L,NY,NX))/ZNO3T(L) + ELSE + FNO3S=VLNO3(L,NY,NX) + FNO3B=VLNOB(L,NY,NX) + ENDIF + ZNO2T(L)=AMAX1(0.0,ZNO2S(L,NY,NX))+AMAX1(0.0,ZNO2B(L,NY,NX)) + IF(ZNO2T(L).GT.ZEROS(NY,NX))THEN + FNO2S=AMAX1(0.0,ZNO2S(L,NY,NX))/ZNO2T(L) + FNO2B=AMAX1(0.0,ZNO2B(L,NY,NX))/ZNO2T(L) + ELSE + FNO2S=VLNO3(L,NY,NX) + FNO2B=VLNOB(L,NY,NX) + ENDIF + H2P4T(L)=AMAX1(0.0,H2PO4(L,NY,NX))+AMAX1(0.0,H2POB(L,NY,NX)) + IF(H2P4T (L).GT.ZEROS(NY,NX))THEN + FH2PS=AMAX1(0.0,H2PO4(L,NY,NX))/H2P4T (L) + FH2PB=AMAX1(0.0,H2POB(L,NY,NX))/H2P4T (L) + ELSE + FH2PS=VLPO4(L,NY,NX) + FH2PB=VLPOB(L,NY,NX) + ENDIF + COXYQ1=COXYG(L,NY,NX)*SOXYL(L,NY,NX) +C +C TOTAL SUBSTRATE +C + TOSC=0.0 + TOSA=0.0 + TORC=0.0 + TOHC=0.0 +C +C TOTAL SOLID SUBSTRATE +C + DO 870 K=0,KL + OSCT(K)=0.0 + OSAT(K)=0.0 + DO 865 M=1,4 + OSCT(K)=OSCT(K)+OSC(M,K,L,NY,NX) + OSAT(K)=OSAT(K)+OSA(M,K,L,NY,NX) +865 CONTINUE + TOSC=TOSC+OSCT(K) + TOSA=TOSA+OSAT(K) +870 CONTINUE +C +C TOTAL BIORESIDUE +C + DO 880 K=0,KL + ORCT(K)=0.0 + DO 875 M=1,2 + ORCT(K)=ORCT(K)+ORC(M,K,L,NY,NX) +C IF(L.EQ.4.AND.K.EQ.2)THEN +C WRITE(*,876)'ORCT',I,J,NX,NY,L,K,M,ORCT(K) +C 2,ORC(M,K,L,NY,NX) +876 FORMAT(A8,7I4,60E12.4) +C ENDIF +875 CONTINUE + TORC=TORC+ORCT(K) +C +C TOTAL ADSORBED AND DISSOLVED SUBSTRATE +C + TOHC=TOHC+OHC(K,L,NY,NX)+OHA(K,L,NY,NX) +880 CONTINUE + DO 860 K=0,KL + OSRH(K)=OSAT(K)+ORCT(K)+OHC(K,L,NY,NX)+OHA(K,L,NY,NX) +C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.EQ.4.AND.K.EQ.2)THEN +C WRITE(*,861)'OSRH',I,J,NX,NY,L,K,OSRH(K),OSCT(K) +C 2,OSAT(K),ORCT(K),OHC(K,L,NY,NX),OHA(K,L,NY,NX) +861 FORMAT(A8,6I4,20E12.4) +C ENDIF +860 CONTINUE + TSRH=TOSA+TORC+TOHC +C +C C:N AND C:P RATIOS OF TOTAL BIOMASS +C + TOMA=0.0 + TOMN=0.0 + DO 890 K=0,5 + IF(L.NE.0.OR.(K.NE.3.AND.K.NE.4))THEN + DO 895 N=1,7 + IF(K.NE.5.OR.(N.LE.3.OR.N.EQ.5))THEN + IF(OMC(1,N,K,L,NY,NX).GT.ZEROS(NY,NX))THEN + CNOMA(N,K)=AMAX1(0.0,OMN(1,N,K,L,NY,NX)/OMC(1,N,K,L,NY,NX)) + CPOMA(N,K)=AMAX1(0.0,OMP(1,N,K,L,NY,NX)/OMC(1,N,K,L,NY,NX)) + ELSE + CNOMA(N,K)=CNOMC(1,N,K) + CPOMA(N,K)=CPOMC(1,N,K) + ENDIF + OMA(N,K)=AMAX1(0.0,OMC(1,N,K,L,NY,NX)/FL(1)) + FCN(N,K)=AMIN1(1.0,AMAX1(0.50,SQRT(CNOMA(N,K)/CNOMC(1,N,K)))) + FCP(N,K)=AMIN1(1.0,AMAX1(0.50,SQRT(CPOMA(N,K)/CPOMC(1,N,K)))) + FCNP(N,K)=AMIN1(FCN(N,K),FCP(N,K)) +C +C TOTAL BIOMASS +C + IF(K.NE.5.OR.(N.LE.3.OR.N.EQ.5))THEN + TOMA=TOMA+OMA(N,K) + ENDIF + IF((K.LE.4.AND.N.EQ.2).OR.(K.EQ.5.AND.N.EQ.1))THEN + TOMN=TOMN+OMA(N,K) + ENDIF + OMC2(N,K)=AMAX1(0.0,AMIN1(OMA(N,K)*FL(2),OMC(2,N,K,L,NY,NX))) + IF(OMC(2,N,K,L,NY,NX).GT.ZEROS(NY,NX))THEN + FOM2(N,K)=AMAX1(0.0,OMC2(N,K)/OMC(2,N,K,L,NY,NX)) + OMN2(N,K)=AMAX1(0.0,FOM2(N,K)*OMN(2,N,K,L,NY,NX)) + ELSE + FOM2(N,K)=0.0 + OMN2(N,K)=0.0 + ENDIF + ENDIF +895 CONTINUE + ENDIF +890 CONTINUE + DO 690 K=0,KL + TOMK(K)=0.0 + TONK(K)=0.0 + TOPK(K)=0.0 + TONX(K)=0.0 + TOPX(K)=0.0 + DO 685 N=1,7 + TOMK(K)=TOMK(K)+OMA(N,K) + TONK(K)=TONK(K)+OMA(N,K)*CNOMA(N,K) + TOPK(K)=TOPK(K)+OMA(N,K)*CPOMA(N,K) + TONX(K)=TONX(K)+OMA(N,K)*CNOMC(1,N,K) + TOPX(K)=TOPX(K)+OMA(N,K)*CPOMC(1,N,K) +685 CONTINUE +690 CONTINUE + DO 790 K=0,KL + IF(TSRH.GT.ZEROS(NY,NX))THEN + FOSRH(K,L,NY,NX)=OSRH(K)/TSRH + ELSE + FOSRH(K,L,NY,NX)=1.0 + ENDIF +C +C DOC CONCENTRATIONS +C + IF(VOLWM(NPH,L,NY,NX).GT.ZEROS(NY,NX))THEN + IF(FOSRH(K,L,NY,NX).GT.ZERO)THEN + COQC(K,L,NY,NX)=AMAX1(0.0,OQC(K,L,NY,NX) + 2/(VOLWM(NPH,L,NY,NX)*FOSRH(K,L,NY,NX))) + COQA(K,L,NY,NX)=AMAX1(0.0,OQA(K,L,NY,NX) + 2/(VOLWM(NPH,L,NY,NX)*FOSRH(K,L,NY,NX))) + ELSE + COQC(K,L,NY,NX)=AMAX1(0.0,OQC(K,L,NY,NX)/VOLWM(NPH,L,NY,NX)) + COQA(K,L,NY,NX)=AMAX1(0.0,OQA(K,L,NY,NX)/VOLWM(NPH,L,NY,NX)) + ENDIF + ELSE + COQC(K,L,NY,NX)=0.0 + COQA(K,L,NY,NX)=0.0 + OHCQ=0.0 + ENDIF + IF(OQC(K,L,NY,NX).GT.ZEROS(NY,NX))THEN + CNQ(K)=AMAX1(0.0,OQN(K,L,NY,NX)/OQC(K,L,NY,NX)) + CPQ(K)=AMAX1(0.0,OQP(K,L,NY,NX)/OQC(K,L,NY,NX)) + ELSE + CNQ(K)=0.0 + CPQ(K)=0.0 + ENDIF + IF(OQC(K,L,NY,NX).GT.ZEROS(NY,NX).AND.OQA(K,L,NY,NX) + 2.GT.ZEROS(NY,NX))THEN + FOCA(K)=OQC(K,L,NY,NX)/(OQC(K,L,NY,NX)+OQA(K,L,NY,NX)) + FOAA(K)=1.0-FOCA(K) + ELSEIF(OQC(K,L,NY,NX).GT.ZEROS(NY,NX))THEN + FOCA(K)=1.0 + FOAA(K)=0.0 + ELSE + FOCA(K)=0.0 + FOAA(K)=1.0 + ENDIF +790 CONTINUE +C +C NITROUS ACID CONCN AND ENERGY YIELD OF HYDROGENOTROPHIC +C METHANOGENESIS AT AMBIENT H2 CONCENTRATION +C + CHY1=AMAX1(ZERO,10.0**(-(PH(L,NY,NX)-3.0))) + CHNO2=CNO2S(L,NY,NX)*CHY1/0.5 + CHNOB=CNO2B(L,NY,NX)*CHY1/0.5 + GH2X=8.3143E-03*TKS(L,NY,NX) + 2*LOG((AMAX1(1.0E-03,CH2GS(L,NY,NX))/H2KI)**4) +C +C RESPIRATION BY MICROBIAL POPULATIONS +C + TFOXYX=0.0 + TFNH4X=0.0 + TFNO3X=0.0 + TFNO2X=0.0 + TFN2OX=0.0 + TFPO4X=0.0 + TFNH4B=0.0 + TFNO3B=0.0 + TFNO2B=0.0 + TFPO4B=0.0 + TCH4H=0.0 + TCH4A=0.0 + TFOQC=0.0 + TFOQA=0.0 + TRH2G=0.0 + IF(L.NE.0)THEN + LL=L + 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.333,0.750+8.00*CNSHY) + FPSHY=AMIN1(1.333,0.750+80.0*CPSHY) + DO 760 K=0,5 + IF(L.NE.0.OR.(K.NE.3.AND.K.NE.4))THEN + TCGOQC(K)=0.0 + TCGOAC(K)=0.0 + TCGOMN(K)=0.0 + TCGOMP(K)=0.0 + DO 750 N=1,7 + IF(K.NE.5.OR.(N.LE.3.OR.N.EQ.5))THEN + IF(K.LE.4)THEN + IF(N.EQ.3)THEN + WFNG=EXP(0.1*PSISM(L,NY,NX)) + ELSE + WFNG=EXP(0.2*PSISM(L,NY,NX)) + ENDIF + OXKX=OXKM + ELSE + WFNG=EXP(0.2*PSISM(L,NY,NX)) + OXKX=OXKA + ENDIF + TFNG(N,K)=TFNX*WFNG + TFNR(N,K)=TFNY + IF(OMA(N,K).GT.0.0)THEN + IF(TOMA.GT.ZEROS(NY,NX))THEN + FOMA(N,K)=OMA(N,K)/TOMA + ELSE + FOMA(N,K)=1.0 + ENDIF + IF(TOMN.GT.ZEROS(NY,NX))THEN + FOMN(N,K)=OMA(N,K)/TOMN + ELSE + FOMN(N,K)=1.0 + ENDIF + IF(TOMK(K).GT.ZEROS(NY,NX))THEN + FOMK(N,K)=OMA(N,K)/TOMK(K) + ELSE + FOMK(N,K)=1.0 + ENDIF + IF(BKVL(L,NY,NX).GT.ZEROS(NY,NX))THEN + DOMA=OMA(N,K)/BKVL(L,NY,NX) + ELSEIF(VOLWZ.GT.ZEROS(NY,NX))THEN + DOMA=OMA(N,K)/VOLWZ + ELSE + DOMA=1.0E+06 + ENDIF + DOMA=AMAX1(0.0,DOMA-DOMX(K)) + SPOMC2=DOMA/(DOMA+DOMK) +C +C FACTORS CONSTRAINING DOC,ACETATE, O2, NH4, NO3, PO4 UPTAKE AMONG +C COMPETING MICROBIAL AND ROOT POPULATIONS IN SOIL LAYERS +C + IF(ROXYY(L,NY,NX).GT.ZEROS(NY,NX))THEN + FOXYX=AMAX1(FMN,ROXYS(N,K,L,NY,NX)/ROXYY(L,NY,NX)) + ELSE + FOXYX=AMAX1(FMN,FOMA(N,K)) + ENDIF + IF(RNH4Y(L,NY,NX).GT.ZEROS(NY,NX))THEN + FNH4X=AMAX1(FMN,RINHO(N,K,L,NY,NX)/RNH4Y(L,NY,NX)) + ELSE + FNH4X=AMAX1(FMN,FOMA(N,K)*VLNH4(L,NY,NX)) + ENDIF + IF(RNHBY(L,NY,NX).GT.ZEROS(NY,NX))THEN + FNB4X=AMAX1(FMN,RINHB(N,K,L,NY,NX)/RNHBY(L,NY,NX)) + ELSE + FNB4X=AMAX1(FMN,FOMA(N,K)*VLNHB(L,NY,NX)) + ENDIF + IF(RNO3Y(L,NY,NX).GT.ZEROS(NY,NX))THEN + FNO3X=AMAX1(FMN,RINOO(N,K,L,NY,NX)/RNO3Y(L,NY,NX)) + ELSE + FNO3X=AMAX1(FMN,FOMA(N,K)*VLNO3(L,NY,NX)) + ENDIF + IF(RN3BY(L,NY,NX).GT.ZEROS(NY,NX))THEN + FNB3X=AMAX1(FMN,RINOB(N,K,L,NY,NX)/RN3BY(L,NY,NX)) + ELSE + FNB3X=AMAX1(FMN,FOMA(N,K)*VLNOB(L,NY,NX)) + ENDIF + IF(RPO4Y(L,NY,NX).GT.ZEROS(NY,NX))THEN + FPO4X=AMAX1(FMN,RIPOO(N,K,L,NY,NX)/RPO4Y(L,NY,NX)) + ELSE + FPO4X=AMAX1(FMN,FOMA(N,K)*VLPO4(L,NY,NX)) + ENDIF + IF(RPOBY(L,NY,NX).GT.ZEROS(NY,NX))THEN + FPB4X=AMAX1(FMN,RIPOB(N,K,L,NY,NX)/RPOBY(L,NY,NX)) + ELSE + FPB4X=AMAX1(FMN,FOMA(N,K)*VLPOB(L,NY,NX)) + ENDIF + IF(K.LE.4)THEN + IF(ROQCY(K,L,NY,NX).GT.ZEROS(NY,NX))THEN + FOQC=AMAX1(FMN,ROQCS(N,K,L,NY,NX)/ROQCY(K,L,NY,NX)) + ELSE + FOQC=AMAX1(FMN,FOMK(N,K)) + ENDIF + TFOQC=TFOQC+FOQC + IF(ROQAY(K,L,NY,NX).GT.ZEROS(NY,NX))THEN + FOQA=AMAX1(FMN,ROQAS(N,K,L,NY,NX)/ROQAY(K,L,NY,NX)) + ELSE + FOQA=AMAX1(FMN,FOMK(N,K)) + ENDIF + TFOQA=TFOQA+FOQA + ENDIF + TFOXYX=TFOXYX+FOXYX + TFNH4X=TFNH4X+FNH4X + TFNO3X=TFNO3X+FNO3X + TFPO4X=TFPO4X+FPO4X + TFNH4B=TFNH4B+FNB4X + TFNO3B=TFNO3B+FNB3X + TFPO4B=TFPO4B+FPB4X +C +C FACTORS CONSTRAINING NH4, NO3, PO4 UPTAKE AMONG COMPETING +C MICROBIAL POPULATIONS IN SURFACE RESIDUE +C + IF(L.EQ.0)THEN + IF(RNH4Y(NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN + FNH4XR(N,K)=AMAX1(FMN,RINHOR(N,K,NY,NX) + 2/RNH4Y(NU(NY,NX),NY,NX)) + ELSE + FNH4XR(N,K)=0.0 + ENDIF + IF(RNO3Y(NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN + FNO3XR(N,K)=AMAX1(FMN,RINOOR(N,K,NY,NX) + 2/RNO3Y(NU(NY,NX),NY,NX)) + ELSE + FNO3XR(N,K)=0.0 + ENDIF + IF(RPO4Y(NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN + FPO4XR(N,K)=AMAX1(FMN,RIPOOR(N,K,NY,NX) + 2/RPO4Y(NU(NY,NX),NY,NX)) + ELSE + FPO4XR(N,K)=0.0 + ENDIF + ENDIF + IF(L.EQ.NU(NY,NX).AND.K.NE.3.AND.K.NE.4 + 2.AND.BKVL(0,NY,NX).GT.ZEROS(NY,NX))THEN + TFNH4X=TFNH4X+FNH4XR(N,K) + TFNO3X=TFNO3X+FNO3XR(N,K) + TFPO4X=TFPO4X+FPO4XR(N,K) + ENDIF +C +C HETEROTROPHIC BIOMASS RESPIRATION +C + IF(K.LE.4)THEN +C +C RESPIRATION BY HETEROTROPHIC AEROBES: +C N=(1)OBLIGATE AEROBES,(2)FACULTATIVE ANAEROBES,(3)FUNGI,(6)N2 FIXERS +C + IF(N.LE.3.OR.N.EQ.6)THEN +C +C ENERGY YIELDS OF REDOX REACTIONS +C + IF(N.EQ.1)THEN + EO2Q=EO2X + ELSEIF(N.EQ.2)THEN + EO2Q=EO2D + ELSEIF(N.EQ.3)THEN + EO2Q=EO2G + ELSEIF(N.EQ.6)THEN + EO2Q=ENFX + ENDIF +C +C O2-UNCONSTRAINED RESPIRATION RATES BY HETEROTROPHIC AEROBES 'RGO*Z' +C FROM SPECIFIC OXIDATION RATE, ACTIVE BIOMASS, DOC OR ACETATE + +C CONCENTRATION,MICROBIAL C:N:P FACTOR, AND TEMPERATURE FOLLOWED BY +C POTENTIAL RESPIRATION RATES 'RGO*P' WITH UNLIMITED SUBSTRATE USED +C FOR MICROBIAL COMPETITION FACTOR +C + FSBSTC=COQC(K,L,NY,NX)/(COQC(K,L,NY,NX)+OQKM) + FSBSTA=COQA(K,L,NY,NX)/(COQA(K,L,NY,NX)+OQKA) + FSBST(N,K)=FOCA(K)*FSBSTC+FOAA(K)*FSBSTA + RGOCY=AMAX1(0.0,FCNP(N,K)*VMXO*WFNG*OMA(N,K)) + RGOCZ=RGOCY*FSBSTC*FOCA(K)*TFNX + RGOAZ=RGOCY*FSBSTA*FOAA(K)*TFNX + RGOCX=AMAX1(0.0,OQC(K,L,NY,NX)*FOQC*EO2Q) + RGOAX=AMAX1(0.0,OQA(K,L,NY,NX)*FOQA*EO2A) + RGOCP=AMIN1(RGOCX,RGOCZ) + RGOAP=AMIN1(RGOAX,RGOAZ) + RGOMP=RGOCP+RGOAP + IF(RGOMP.GT.ZEROS(NY,NX))THEN + FGOCP=RGOCP/RGOMP + FGOAP=RGOAP/RGOMP + ELSE + FGOCP=1.0 + FGOAP=0.0 + ENDIF +C +C ENERGY YIELD AND O2 DEMAND FROM DOC AND ACETATE OXIDATION +C BY HETEROTROPHIC AEROBES +C + ECHZ=EO2Q*FGOCP+EO2A*FGOAP + ROXYM(N,K)=2.667*RGOMP + ROXYP(N,K)=ROXYM(N,K) + ROXYS(N,K,L,NY,NX)=ROXYP(N,K) + ROQCS(N,K,L,NY,NX)=RGOCZ + ROQAS(N,K,L,NY,NX)=RGOAZ + ROQCD(N,K)=RGOCY +C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.LE.1)THEN +C WRITE(*,5555)'RGOMP',I,J,NX,NY,L,K,N,RGOMP,RGOCX,RGOAX,RGOCZ +C 2,RGOAZ,RGOCX,RGOAX,FCNP(N,K),TFNG(N,K),VMXO,OMA(N,K),FOQC,FOQA +C 2,COQC(K,L,NY,NX),OQC(K,L,NY,NX),EO2Q,TKS(L,NY,NX),COXYS(L,NY,NX) +C 3,OQKM,OMC(1,N,K,L,NY,NX),OMC(2,N,K,L,NY,NX),OMC(3,N,K,L,NY,NX) +C 3,VOLWM(NPH,L,NY,NX),FOSRH(K,L,NY,NX),DOMA,SPOMC2 +C 4,FSBST(N,K),ROQCD(N,K) +5555 FORMAT(A8,7I4,60E12.4) +C ENDIF +C +C RESPIRATION BY HETEROTROPHIC ANAEROBES: +C N=(4)ACETOGENIC FERMENTERS (7) ACETOGENIC N2 FIXERS +C +C +C ENERGY YIELD FROM FERMENTATION DEPENDS ON H2 CONCENTRATION +C + ELSEIF(N.EQ.4.OR.N.EQ.7)THEN + GH2F=GH2X/72.0 + GOAX=8.3143E-03*TKS(L,NY,NX) + 2*LOG((AMAX1(ZERO,COQA(K,L,NY,NX))/OAKI)**2) + GOAF=GOAX/72.0 + GHAX=GH2F+GOAF + IF(N.EQ.4)THEN + ECHZ=AMAX1(EO2X,AMIN1(1.0,1.0 + 2/(1.0+AMAX1(0.0,(GCHX-GHAX))/EOMF))) + ELSE + ECHZ=AMAX1(ENFX,AMIN1(1.0,1.0 + 2/(1.0+AMAX1(0.0,(GCHX-GHAX))/EOMN))) + ENDIF +C +C RESPIRATION RATES BY HETEROTROPHIC ANAEROBES 'RGOMP' FROM SPECIFIC +C OXIDATION RATE, ACTIVE BIOMASS, DOC CONCENTRATION, +C MICROBIAL C:N:P FACTOR, AND TEMPERATURE FOLLOWED BY POTENTIAL +C RESPIRATION RATES 'RGOMP' WITH UNLIMITED SUBSTRATE USED FOR MICROBIAL +C COMPETITION FACTOR +C + FSBST(N,K)=COQC(K,L,NY,NX)/(COQC(K,L,NY,NX)+OQKM)*OXYI + SPOMC2=SPOMC2*OXYI + RGOFY=AMAX1(0.0,FCNP(N,K)*VMXF*WFNG*OMA(N,K)) + RGOFZ=RGOFY*FSBST(N,K)*TFNX + RGOFX=AMAX1(0.0,OQC(K,L,NY,NX)*FOQC*ECHZ) + RGOMP=AMIN1(RGOFX,RGOFZ) + FGOCP=1.0 + FGOAP=0.0 + ROXYM(N,K)=0.0 + ROXYP(N,K)=0.0 + ROXYS(N,K,L,NY,NX)=0.0 + ROQCS(N,K,L,NY,NX)=RGOFZ + ROQAS(N,K,L,NY,NX)=0.0 + ROQCD(N,K)=RGOFY + TRH2G=TRH2G+RGOMP +C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.LE.4)THEN +C WRITE(*,5554)'FERM',I,J,NX,NY,L,K,N,RGOMP,RGOFX,RGOFZ,GHAX,GOAF +C 2,ECHZ,FCNP(N,K),TFNG(N,K),OMA(N,K),FOQC,COQC(K,L,NY,NX),OQC(K,L,NY,NX) +C 3,OQKM,OMC(1,N,K,L,NY,NX),OMC(2,N,K,L,NY,NX),OMC(3,N,K,L,NY,NX) +C 3,OMN(1,N,K,L,NY,NX),OMN(2,N,K,L,NY,NX),OMN(3,N,K,L,NY,NX) +C 5,VOLWM(NPH,L,NY,NX),PSISM(L,NY,NX),WFNG,COXYS(L,NY,NX),OXYI +C 6,FSBST(N,K),FOSRH(K,L,NY,NX),DOMA,SPOMC2,ROQCD(N,K) +5554 FORMAT(A8,7I4,60E12.4) +C ENDIF +C +C ENERGY YIELD FROM ACETOTROPHIC METHANOGENESIS +C + ELSEIF(N.EQ.5)THEN + GOMX=8.3143E-03*TKS(L,NY,NX) + 2*LOG((AMAX1(ZERO,COQA(K,L,NY,NX))/OAKI)) + GOMM=GOMX/24.0 + ECHZ=AMAX1(EO2X,AMIN1(1.0,1.0/(1.0+AMAX1(0.0,(GC4X+GOMM))/EOMH))) +C +C RESPIRATION RATES BY ACETOTROPHIC METHANOGENS 'RGOMP' FROM SPECIFIC +C OXIDATION RATE, ACTIVE BIOMASS, DOC CONCENTRATION, +C MICROBIAL C:N:P FACTOR, AND TEMPERATURE FOLLOWED BY POTENTIAL C +C RESPIRATION RATES 'RGOMP' WITH UNLIMITED SUBSTRATE USED FOR +C MICROBIAL COMPETITION FACTOR +C + FSBST(N,K)=COQA(K,L,NY,NX)/(COQA(K,L,NY,NX)+OQKAM) + RGOGY=AMAX1(0.0,FCNP(N,K)*VMXM*WFNG*OMA(N,K)) + RGOGZ=RGOGY*FSBST(N,K)*TFNX + RGOGX=AMAX1(0.0,OQA(K,L,NY,NX)*FOQA*ECHZ) + RGOMP=AMIN1(RGOGX,RGOGZ) + FGOCP=0.0 + FGOAP=1.0 + ROXYM(N,K)=0.0 + ROXYP(N,K)=0.0 + ROXYS(N,K,L,NY,NX)=0.0 + ROQCS(N,K,L,NY,NX)=0.0 + ROQAS(N,K,L,NY,NX)=RGOGZ + ROQCD(N,K)=0.0 + TCH4H=TCH4H+0.5*RGOMP +C IF((I/30)*30.EQ.I.AND.NX.EQ.3.AND.NY.EQ.1.AND.J.EQ.24)THEN +C WRITE(*,5552)'ACMETH',I,J,NX,NY,L,K,N,RGOMP,RGOGZ,RGOGX,GOMM +C 2,ECHZ,FCNP(N,K),TFNG(N,K),OMA(N,K),FOQA,COQA(K,L,NY,NX),OQA(K,L,NY,NX) +C 3,OMC(1,N,K,L,NY,NX),OMC(2,N,K,L,NY,NX),OMC(3,N,K,L,NY,NX) +C 3,OMN(1,N,K,L,NY,NX),OMN(2,N,K,L,NY,NX),OMN(3,N,K,L,NY,NX) +C 5,VOLWM(NPH,L,NY,NX),PSISM(L,NY,NX),WFNG,COXYS(L,NY,NX) +C 6,OHA(K,L,NY,NX),FSBST(N,K),SPOMC2 +5552 FORMAT(A8,7I4,40E12.4) +C ENDIF + ENDIF +C +C RESPIRATION RATES BY AUTOTROPHS 'RGOMP' FROM SPECIFIC +C OXIDATION RATE, ACTIVE BIOMASS, DOC CONCENTRATION, +C MICROBIAL C:N:P FACTOR, AND TEMPERATURE FOLLOWED BY POTENTIAL +C RESPIRATION RATES 'RGOMP' WITH UNLIMITED SUBSTRATE USED FOR MICROBIAL +C COMPETITION FACTOR. N=(1) NH4 OXIDIZERS (2) NO2 OXIDIZERS, +C (3) CH4 OXIDIZERS, (5) H2TROPHIC METHANOGENS +C + ELSEIF(K.EQ.5)THEN + XCO2=CCO2S(L,NY,NX)/(CCO2S(L,NY,NX)+CCKM) + CNH3SI=1.0+CNH3S(L,NY,NX)/C3KI + CNH3BI=1.0+CNH3B(L,NY,NX)/C3KI +C +C NH3 OXIDIZERS +C + IF(N.EQ.1)THEN +C +C FACTOR TO REGULATE COMPETITION FOR NH4 AMONG DIFFERENT +C MICROBIAL AND ROOT POPULATIONS +C + IF(RNH4Y(L,NY,NX).GT.ZEROS(NY,NX))THEN + FNH4=AMAX1(FMN,RVMX4(N,K,L,NY,NX)/RNH4Y(L,NY,NX)) + ELSE + FNH4=AMAX1(FMN,VLNH4(L,NY,NX)*FOMA(N,K)) + ENDIF + IF(RNHBY(L,NY,NX).GT.ZEROS(NY,NX))THEN + FNB4=AMAX1(FMN,RVMB4(N,K,L,NY,NX)/RNHBY(L,NY,NX)) + ELSE + FNB4=AMAX1(FMN,VLNHB(L,NY,NX)*FOMA(N,K)) + ENDIF + TFNH4X=TFNH4X+FNH4 + TFNH4B=TFNH4B+FNB4 +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)/CNH3SI + FCN3B=FNHBS*CNH3B(L,NY,NX)/(CNH3B(L,NY,NX)+ZHKM)/CNH3BI + FSBST(N,K)=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))) + 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 +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.4)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,RNFNG,ZNFNI(L,NY,NX),ZNFNG(L,NY,NX),ZNFNA +C 9,SPOMC2,DOMA,DOMX(K),DOMK,BKVL(L,NY,NX) +6666 FORMAT(A8,5I4,40E12.4) +C ENDIF +C +C NO2 OXIDIZERS +C + ELSEIF(N.EQ.2)THEN +C +C FACTOR TO REGULATE COMPETITION FOR NO2 AMONG DIFFERENT +C MICROBIAL POPULATIONS +C + IF(RNO2Y(L,NY,NX).GT.ZEROS(NY,NX))THEN + FNO2=AMAX1(FMN,RVMX2(N,K,L,NY,NX)/RNO2Y(L,NY,NX)) + ELSE + FNO2=AMAX1(FMN,FOMN(N,K)*VLNO3(L,NY,NX)) + ENDIF + IF(RN2BY(L,NY,NX).GT.ZEROS(NY,NX))THEN + FNB2=AMAX1(FMN,RVMB2(N,K,L,NY,NX)/RN2BY(L,NY,NX)) + ELSE + FNB2=AMAX1(FMN,FOMN(N,K)*VLNOB(L,NY,NX)) + ENDIF + TFNO2X=TFNO2X+FNO2 + TFNO2B=TFNO2B+FNB2 +C +C NO2 OXIDATION FROM SPECIFIC OXIDATION RATE, ENERGY YIELD, +C ACTIVE OXIDIZER BIOMASS, TEMPERATURE, AQUEOUS CO2 AND +C NO2 CONCENTRATIONS +C + ECHZ=EO2X + VMXA=TFNG(N,K)*FCNP(N,K)*XCO2*OMA(N,K)*VMXN + FCN2S=FNH4S*CNO2S(L,NY,NX)/(CNO2S(L,NY,NX)+ZNKM)/CNH3SI + FCN2B=FNHBS*CNO2B(L,NY,NX)/(CNO2B(L,NY,NX)+ZNKM)/CNH3BI + FSBST(N,K)=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))) + 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 +C +C O2 DEMAND FROM NO2 OXIDATION +C + ROXYM(N,K)=2.667*RGOMP + ROXYP(N,K)=ROXYM(N,K)+1.143*RVOXP + ROXYS(N,K,L,NY,NX)=ROXYP(N,K) +C IF((I/30)*30.EQ.I.AND.J.EQ.15.AND.L.LE.6)THEN +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 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) +C 7,DOMA,SPOMC2 +6667 FORMAT(A8,5I4,50E12.4) +C ENDIF +C +C H2TROPHIC METHANOGENS +C + ELSEIF(N.EQ.5)THEN +C +C CO2 REDUCTION FROM SPECIFIC REDUCTION RATE, ENERGY YIELD, +C ACTIVE OXIDIZER BIOMASS, TEMPERATURE, AQUEOUS CO2 AND +C + GH2H=GH2X/12.0 + ECHZ=AMAX1(EO2X,AMIN1(1.0,1.0/(1.0+AMAX1(0.0,(GCOX+GH2H))/EOMH))) + VMXA=TFNG(N,K)*FCNP(N,K)*XCO2*OMA(N,K)*VMXC + H2GSX=H2GS(L,NY,NX)+0.111*TRH2G + FSBST(N,K)=CH2GS(L,NY,NX)/(CH2GS(L,NY,NX)+H2KM) + RGOMP=AMAX1(0.0,AMIN1(1.5*H2GSX,VMXA*FSBST(N,K))) + ROXYM(N,K)=0.0 + ROXYM(N,K)=0.0 + ROXYS(N,K,L,NY,NX)=0.0 + TCH4A=TCH4A+RGOMP +C IF((I/30)*30.EQ.I.AND.NX.EQ.3.AND.NY.EQ.1.AND.J.EQ.24)THEN +C WRITE(*,5553)'H2METH',I,J,NX,NY,L,K,N,RGOMP,H2GS(L,NY,NX) +C 2,H2GSX,CH2GS(L,NY,NX),VMXA,TFNG(N,K),FCNP(N,K),XCO2 +C 3,OMA(N,K),VMXC,ECHZ,GCOX,GH2H,TKS(L,NY,NX),FSBST(N,K),SPOMC2 +5553 FORMAT(A8,7I4,20E12.4) +C ENDIF +C +C METHANOTROPHS +C + ELSEIF(N.EQ.3)THEN +C +C CH4 OXIDATION FROM SPECIFIC OXIDATION RATE, ENERGY YIELD, +C ACTIVE OXIDIZER BIOMASS, TEMPERATURE, AQUEOUS CO2 AND +C CH4 CONCENTRATIONS IN BAND AND NON-BAND SOIL ZONES +C + ECHZ=EO2X + VMXA=TFNG(N,K)*FCNP(N,K)*OMA(N,K)*VMX4 + RCH4L1=RCH4L(L,NY,NX)*XNPG + RCH4F1=RCH4F(L,NY,NX)*XNPG + RCH4S1=(TCH4H+TCH4A)*XNPG + IF(L.EQ.0)THEN + CH4G1=CCH4E(NY,NX)*VOLPM(1,L,NY,NX) + ELSE + CH4G1=CCH4G(L,NY,NX)*VOLPM(1,L,NY,NX) + ENDIF + CH4S1=CH4S(L,NY,NX) + VMXA1=VMXA*XNPG + RVOXP=0.0 + RGOMP=0.0 +C +C CH4 DISSOLUTION FROM GASEOUS PHASE SOLVED IN SHORTER TIME STEP +C TO MAINTAIN AQUEOUS CH4 CONCENTRATION DURING OXIDATION +C + DO 320 M=1,NPH + IF(VOLWM(M,L,NY,NX).GT.ZEROS(NY,NX))THEN + VOLWCH=VOLWM(M,L,NY,NX)*SCH4L(L,NY,NX) + VOLWPM=VOLWCH+VOLPM(M,L,NY,NX) + DO 325 MM=1,NPT + CH4G1=CH4G1+RCH4F1 + CH4S1=CH4S1+RCH4L1+RCH4S1 + CCH4S1=AMAX1(0.0,CH4S1/VOLWM(M,L,NY,NX)) + FSBST(N,K)=CCH4S1/(CCH4S1+CCK4) + RVOXP1=AMIN1(AMAX1(0.0,CH4S1)/(1.0+ECHO*ECHZ) + 2,VMXA1*FSBST(N,K)) + RGOMP1=RVOXP1*ECHO*ECHZ + CH4S1=CH4S1-RVOXP1-RGOMP1 + IF(THETPM(M,L,NY,NX).GT.THETX)THEN + RCHDF=DFGS(M,L,NY,NX)*(AMAX1(ZEROS(NY,NX),CH4G1)*VOLWCH + 2-CH4S1*VOLPM(M,L,NY,NX))/VOLWPM + ELSE + RCHDF=0.0 + ENDIF + CH4G1=CH4G1-RCHDF + CH4S1=CH4S1+RCHDF + RVOXP=RVOXP+RVOXP1 + RGOMP=RGOMP+RGOMP1 +C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.EQ.0 +C 2.AND.MM.EQ.NPT)THEN +C WRITE(*,5547)'CH4OX',I,J,NX,NY,L,K,N,M,MM,RVOXP1,RGOMP1,CH4G1 +C 2,CH4S1,VMXA1,RVOXP,RGOMP,RCHDF,RCH4L1,RCH4F1,RCH4S1,CCH4S1 +C 3,ECHO,ECHZ,OMA(N,K),VOLWM(M,L,NY,NX),VOLPM(M,L,NY,NX),VOLWCH +C 4,THETPM(M,L,NY,NX),SCH4L(L,NY,NX),DFGS(M,L,NY,NX) +C 5,COXYS(L,NY,NX),CCH4E(NY,NX),FSBST(N,K),SPOMC2 +C 6,CH4G1/VOLPM(M,L,NY,NX) +5547 FORMAT(A8,9I4,30E12.4) +C ENDIF +325 CONTINUE + ENDIF +320 CONTINUE + RVOXPA=RVOXP + RVOXPB=0.0 +C +C O2 DEMAND FROM CH4 OXIDATION +C + ROXYM(N,K)=2.667*RGOMP + ROXYP(N,K)=ROXYM(N,K)+4.00*RVOXP + ROXYS(N,K,L,NY,NX)=ROXYP(N,K) + ELSE + RGOMP=0.0 + ROXYM(N,K)=0.0 + ROXYP(N,K)=0.0 + ROXYS(N,K,L,NY,NX)=0.0 + ENDIF + ELSE + RGOMP=0.0 + ROXYM(N,K)=0.0 + ROXYP(N,K)=0.0 + ROXYS(N,K,L,NY,NX)=0.0 + ENDIF +C +C O2 UPTAKE BY AEROBES +C + RUPOX(N,K)=0.0 + IF(N.LE.3.OR.N.EQ.6)THEN + IF(ROXYP(N,K).GT.ZEROS(NY,NX).AND.FOXYX.GT.ZERO)THEN + IF(L.NE.0.OR.VOLX(L,NY,NX).GT.ZEROS(NY,NX))THEN +C +C MAXIMUM O2 UPAKE FROM POTENTIAL RESPIRATION OF EACH AEROBIC +C POPULATION +C + RUPMX=ROXYP(N,K)*XNPG + ROXYFX=ROXYF(L,NY,NX)*XNPG*FOXYX + OLSGL1=OLSGL(L,NY,NX)*XNPG + IF(L.NE.0)THEN + OXYG1=OXYG(L,NY,NX)*FOXYX + ROXYLX=ROXYL(L,NY,NX)*XNPG*FOXYX + ELSE + OXYG1=COXYG(L,NY,NX)*VOLPM(1,L,NY,NX)*FOXYX + ROXYLX=(ROXYL(L,NY,NX)+FLQRQ(NY,NX)*COXR(NY,NX) + 2+FLQRI(NY,NX)*COXQ(NY,NX))*XNPG*FOXYX + ENDIF + OXYS1=OXYS(L,NY,NX)*FOXYX +C +C O2 DISSOLUTION FROM GASEOUS PHASE SOLVED IN SHORTER TIME STEP +C TO MAINTAIN AQUEOUS O2 CONCENTRATION DURING REDUCTION +C + DO 420 M=1,NPH +C +C ACTUAL REDUCTION OF AQUEOUS BY AEROBES CALCULATED +C FROM MASS FLOW PLUS DIFFUSION = ACTIVE UPTAKE +C COUPLED WITH DISSOLUTION OF GASEOUS O2 DURING REDUCTION +C OF AQUEOUS O2 FROM DISSOLUTION RATE CONSTANT 'DFGS' +C CALCULATED IN 'WATSUB' +C + THETW1=AMAX1(0.0,VOLWM(M,L,NY,NX)/VOLX(L,NY,NX)) + RRADO=ORAD*(FILM(M,L,NY,NX)+ORAD)/FILM(M,L,NY,NX) + DIFOX=TORT(M,L,NY,NX)*OLSGL1*12.57*BIOS*OMA(N,K)*RRADO + VOLWOX=VOLWM(M,L,NY,NX)*SOXYL(L,NY,NX) + VOLPOX=VOLPM(M,L,NY,NX) + VOLWPM=VOLWOX+VOLPOX + DO 425 MX=1,NPT + OXYG1=OXYG1+ROXYFX + OXYS1=OXYS1+ROXYLX + COXYS1=AMIN1(COXYE(NY,NX)*SOXYL(L,NY,NX) + 2,AMAX1(0.0,OXYS1/(VOLWM(M,L,NY,NX)*FOXYX))) + X=DIFOX*COXYS1 + IF(X.GT.ZEROS(NY,NX).AND.OXYS1.GT.ZEROS(NY,NX))THEN + B=-RUPMX-DIFOX*OXKX-X + C=X*RUPMX + RMPOX=(-B-SQRT(B*B-4.0*C))/2.0 + ELSE + RMPOX=0.0 + ENDIF + OXYS1=OXYS1-RMPOX + IF(THETPM(M,L,NY,NX).GT.THETX.AND.VOLPOX.GT.ZEROS(NY,NX))THEN + ROXDFQ=DFGS(M,L,NY,NX)*(AMAX1(ZEROS(NY,NX),OXYG1)*VOLWOX + 2-OXYS1*VOLPOX)/VOLWPM + ELSE + ROXDFQ=0.0 + ENDIF + OXYG1=OXYG1-ROXDFQ + OXYS1=OXYS1+ROXDFQ + RUPOX(N,K)=RUPOX(N,K)+RMPOX + ROXSK(M,L,NY,NX)=ROXSK(M,L,NY,NX)+RMPOX +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 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) +C ENDIF +C IF((I/10)*10.EQ.I.AND.J.EQ.16.AND.L.EQ.NU(NY,NX) +C 2.AND.K.EQ.4.AND.N.EQ.2)THEN +C WRITE(*,5544)'OXY',I,J,L,K,N,M,MX,RUPOX(N,K),ROXYP(N,K) +C 2,ROXSK(M,L,NY,NX),RUPMX,RMPOX,DIFOX,OLSGL1,BIOS,OMA(N,K),X +C 2,ROXDFQ,ROXYLX,ROXYFX,FOXYX,COXYS1,OXYS1,OXYG1,OXYS1 +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 +5544 FORMAT(A8,7I4,50E12.4) +C ENDIF +425 CONTINUE +420 CONTINUE +C +C RATIO OF ACTUAL O2 UPAKE TO BIOLOGICAL DEMAND +C + WFN(N,K)=AMIN1(1.0,AMAX1(0.0,RUPOX(N,K)/ROXYP(N,K))) + IF(K.LE.4)THEN + ROQCS(N,K,L,NY,NX)=ROQCS(N,K,L,NY,NX)*WFN(N,K) + ROQAS(N,K,L,NY,NX)=ROQAS(N,K,L,NY,NX)*WFN(N,K) + ROQCD(N,K)=ROQCD(N,K)*WFN(N,K) + ENDIF + IF(K.EQ.5)THEN + IF(N.EQ.1)THEN + RVMX4(N,K,L,NY,NX)=RVMX4(N,K,L,NY,NX)*WFN(N,K) + RVMB4(N,K,L,NY,NX)=RVMB4(N,K,L,NY,NX)*WFN(N,K) + ELSEIF(N.EQ.2)THEN + RVMX2(N,K,L,NY,NX)=RVMX2(N,K,L,NY,NX)*WFN(N,K) + RVMB2(N,K,L,NY,NX)=RVMB2(N,K,L,NY,NX)*WFN(N,K) + ENDIF + ENDIF + ELSE + RUPOX(N,K)=ROXYP(N,K) + WFN(N,K)=1.0 + ENDIF + ELSE + RUPOX(N,K)=0.0 + WFN(N,K)=1.0 + ENDIF +C +C RESPIRATION PRODUCTS ALLOCATED TO O2, CO2, ACETATE, CH4, H2 +C + RGOMO(N,K)=RGOMP*WFN(N,K) + RCO2X(N,K)=RGOMO(N,K) + RCH3X(N,K)=0.0 + RCH4X(N,K)=0.0 + ROXYO(N,K)=ROXYM(N,K)*WFN(N,K) + RH2GX(N,K)=0.0 + IF(K.EQ.5)THEN + RVOXA(N)=RVOXPA*WFN(N,K) + RVOXB(N)=RVOXPB*WFN(N,K) + ENDIF + ELSEIF(N.EQ.4.OR.N.EQ.7)THEN + RGOMO(N,K)=RGOMP + RCO2X(N,K)=0.333*RGOMO(N,K) + RCH3X(N,K)=0.667*RGOMO(N,K) + RCH4X(N,K)=0.0 + ROXYO(N,K)=ROXYM(N,K) + IF(K.LE.4)THEN + RH2GX(N,K)=0.111*RGOMO(N,K) + ELSE + RH2GX(N,K)=0.0 + ENDIF + ELSEIF(N.EQ.5)THEN + RGOMO(N,K)=RGOMP + IF(K.LE.4)THEN + RCO2X(N,K)=0.50*RGOMO(N,K) + RCH3X(N,K)=0.00 + RCH4X(N,K)=0.50*RGOMO(N,K) + ROXYO(N,K)=ROXYM(N,K) + RH2GX(N,K)=0.0 + ELSEIF(K.EQ.5)THEN + RCO2X(N,K)=0.00 + RCH3X(N,K)=0.00 + RCH4X(N,K)=RGOMO(N,K) + ROXYO(N,K)=ROXYM(N,K) + RH2GX(N,K)=0.0 + RH2GZ=0.667*RGOMO(N,K) + ENDIF + ENDIF +C +C HETEROTROPHIC DENITRIFICATION +C + IF(K.LE.4.AND.N.EQ.2.AND.ROXYM(N,K).GT.0.0 + 2.AND.(L.NE.0.OR.VOLX(L,NY,NX).GT.ZEROS(NY,NX)))THEN +C +C FACTOR TO CONSTRAIN NO3 UPAKE AMONG COMPETING MICROBIAL +C AND ROOT POPULATIONS +C + IF(RNO3Y(L,NY,NX).GT.ZEROS(NY,NX))THEN + FNO3=AMAX1(FMN,RVMX3(N,K,L,NY,NX)/RNO3Y(L,NY,NX)) + ELSE + FNO3=AMAX1(FMN,FOMA(N,K)*VLNO3(L,NY,NX)) + ENDIF + IF(RN3BY(L,NY,NX).GT.ZEROS(NY,NX))THEN + FNB3=AMAX1(FMN,RVMB3(N,K,L,NY,NX)/RN3BY(L,NY,NX)) + ELSE + FNB3=AMAX1(FMN,FOMA(N,K)*VLNOB(L,NY,NX)) + ENDIF + TFNO3X=TFNO3X+FNO3 + TFNO3B=TFNO3B+FNB3 +C +C NO3 REDUCTION FROM SPECIFIC REDUCTION RATE, ENERGY YIELD, +C ACTIVE DENITRIFIER BIOMASS, TEMPERATURE, AQUEOUS NO3 +C CONCENTRATIONS AND STOICHIOMETRY OF REDOX ELECTRON TRANSFER +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 + IF(CNO3S(L,NY,NX).GT.ZERO)THEN + VMXD3S=VMXD3*FNO3S*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 + ENDIF + IF(CNO3B(L,NY,NX).GT.ZERO)THEN + VMXD3B=VMXD3*FNO3B*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 + ENDIF + OQCZ3=AMAX1(0.0,OQC(K,L,NY,NX)*FOQC-RGOCP*WFN(N,K)) + OQCD3=OQCZ3/ECN3 + OQCD3S=OQCD3*FNO3S + OQCD3B=OQCD3*FNO3B + ZNO3SX=ZNO3S(L,NY,NX)*FNO3 + ZNO3BX=ZNO3B(L,NY,NX)*FNB3 + RDNO3X=AMAX1(0.0,AMIN1(ZNO3SX,VMXD3S)) + RDNOBX=AMAX1(0.0,AMIN1(ZNO3BX,VMXD3B)) + RDNO3(N,K)=AMAX1(0.0,AMIN1(VMXD3S,OQCD3S,ZNO3SX)) + RDNOB(N,K)=AMAX1(0.0,AMIN1(VMXD3B,OQCD3B,ZNO3BX)) + RDNOX=RDNO3X+RDNOBX + RDNOT=RDNO3(N,K)+RDNOB(N,K) + RGOM3X=ECN3*RDNOX + RGOMD3=ECN3*RDNOT + RVMX3(N,K,L,NY,NX)=VMXD3S + RVMB3(N,K,L,NY,NX)=VMXD3B +C +C FACTOR TO CONSTRAIN NO2 UPAKE AMONG COMPETING MICROBIAL +C POPULATIONS +C + IF(RNO2Y(L,NY,NX).GT.ZEROS(NY,NX))THEN + FNO2=AMAX1(FMN,RVMX2(N,K,L,NY,NX)/RNO2Y(L,NY,NX)) + ELSE + FNO2=AMAX1(FMN,FOMA(N,K)*VLNO3(L,NY,NX)) + ENDIF + IF(RN2BY(L,NY,NX).GT.ZEROS(NY,NX))THEN + FNB2=AMAX1(FMN,RVMB2(N,K,L,NY,NX)/RN2BY(L,NY,NX)) + ELSE + FNB2=AMAX1(FMN,FOMA(N,K)*VLNOB(L,NY,NX)) + ENDIF + TFNO2X=TFNO2X+FNO2 + TFNO2B=TFNO2B+FNB2 +C +C NO2 REDUCTION FROM SPECIFIC REDUCTION RATE, ENERGY YIELD, +C ACTIVE DENITRIFIER BIOMASS, TEMPERATURE, AQUEOUS NO2 +C CONCENTRATIONS AND STOICHIOMETRY OF REDOX ELECTRON TRANSFER +C NOT ACCEPTED BY O2 AND NO3 IN BAND AND NON-BAND SOIL ZONES +C + VMXD2=VMXD3-RDNOT + IF(CNO2S(L,NY,NX).GT.ZERO)THEN + VMXD2S=VMXD2*FNO3S*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 + ENDIF + IF(CNO2B(L,NY,NX).GT.ZERO)THEN + VMXD2B=VMXD2*FNO3B*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 + ENDIF + OQCZ2=AMAX1(0.0,OQCZ3-RGOMD3) + OQCD2=OQCZ2/ECN2 + OQCD2S=OQCD2*FNO3S + OQCD2B=OQCD2*FNO3B + ZNO2SX=(ZNO2S(L,NY,NX)+RDNO3(N,K))*FNO2 + ZNO2BX=(ZNO2B(L,NY,NX)+RDNOB(N,K))*FNB2 + RDNO2X=AMAX1(0.0,AMIN1(ZNO2SX,VMXD2S)) + RDNOBX=AMAX1(0.0,AMIN1(ZNO2BX,VMXD2B)) + RDNO2(N,K)=AMAX1(0.0,AMIN1(VMXD2S,OQCD2S,ZNO2SX)) + RDN2B(N,K)=AMAX1(0.0,AMIN1(VMXD2B,OQCD2B,ZNO2BX)) + RDN2X=RDNO2X+RDNOBX + RDN2T=RDNO2(N,K)+RDN2B(N,K) + RGOM2X=ECN2*RDN2X + RGOMD2=ECN2*RDN2T + RVMX2(N,K,L,NY,NX)=VMXD2S + RVMB2(N,K,L,NY,NX)=VMXD2B +C +C FACTOR TO CONSTRAIN N2O UPAKE AMONG COMPETING MICROBIAL +C AND ROOT POPULATIONS +C + IF(RN2OY(L,NY,NX).GT.ZEROS(NY,NX))THEN + FN2O=AMAX1(FMN,RVMX1(N,K,L,NY,NX)/RN2OY(L,NY,NX)) + ELSE + FN2O=AMAX1(FMN,FOMA(N,K)) + ENDIF + TFN2OX=TFN2OX+FN2O +C +C N2O REDUCTION FROM SPECIFIC REDUCTION RATE, ENERGY YIELD, +C ACTIVE DENITRIFIER BIOMASS, TEMPERATURE, AQUEOUS N2O +C CONCENTRATIONS AND STOICHIOMETRY OF REDOX ELECTRON TRANSFER +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) + OQCZ1=AMAX1(0.0,OQCZ2-RGOMD2) + OQCD1=OQCZ1/ECN1 + Z2OSX=(Z2OS(L,NY,NX)+RDN2T)*FN2O + RDN2OX=AMAX1(0.0,AMIN1(Z2OSX,VMXD1S)) + RDN2O(N,K)=AMAX1(0.0,AMIN1(VMXD1S,OQCD1,Z2OSX)) + RGOM1X=ECN1*RDN2OX + RGOMD1=ECN1*RDN2O(N,K) + RGOMY(N,K)=RGOM3X+RGOM2X+RGOM1X + RGOMD(N,K)=RGOMD3+RGOMD2+RGOMD1 + 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 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) +C 3,ROXYO(N,K),OMA(N,K),VMXD,CNO3S(L,NY,NX),CNO3B(L,NY,NX) +C 4,CNO2S(L,NY,NX),CNO2B(L,NY,NX),CZ2OS(L,NY,NX),VLNO3(L,NY,NX) +C 5,VLNOB(L,NY,NX),THETW(L,NY,NX),THETI(L,NY,NX),FOMA(N,K) +C 5,ZNO3S(L,NY,NX),ZNO3B(L,NY,NX),ZNO2S(L,NY,NX),ZNO2B(L,NY,NX) +C 6,Z2OS(L,NY,NX),RGOMY(N,K),RGOMD(N,K),TOMA,FOXYX,FNO23S,FNO23B +C 7,OQC(K,L,NY,NX),FOQC,RGOCP,WFN(N,K),VOLWZ,FOSRH(K,L,NY,NX),ZERO +C 9,RGOM3X,RGOM2X,RGOM1X,FNO3,FNO2,FN2O,ZNO3SX,ZNO2SX,Z2OSX +C 3,OQCD3S,OQCD2S,OQCD1,VMXD3S,VMXD2S,VMXD1S,VMXD3,VMXD2,VMXD1 +C 4,ROXYD,VMXDX,TFNX,WFNG,TFNG(N,K),PSISM(L,NY,NX) +C 2,(1.0+(CNO2S(L,NY,NX)*Z3KM)/(CNO3S(L,NY,NX)*Z2KM)) +C 2,(1.0+(CZ2OS(L,NY,NX)*Z2KM)/(CNO2S(L,NY,NX)*Z1KM)) +2222 FORMAT(A8,5I4,70E12.4) +C ENDIF +C +C AUTOTROPHIC DENITRIFICATION +C + ELSEIF(K.EQ.5.AND.N.EQ.1.AND.ROXYM(N,K).GT.0.0 + 2.AND.(L.NE.0.OR.VOLX(L,NY,NX).GT.ZEROS(NY,NX)))THEN +C +C FACTOR TO CONSTRAIN NO2 UPAKE AMONG COMPETING MICROBIAL +C POPULATIONS +C + IF(RNO2Y(L,NY,NX).GT.ZEROS(NY,NX))THEN + FNO2=AMAX1(FMN,RVMX2(N,K,L,NY,NX)/RNO2Y(L,NY,NX)) + ELSE + FNO2=AMAX1(FMN,FOMN(N,K)*VLNO3(L,NY,NX)) + ENDIF + IF(RN2BY(L,NY,NX).GT.ZEROS(NY,NX))THEN + FNB2=AMAX1(FMN,RVMB2(N,K,L,NY,NX)/RN2BY(L,NY,NX)) + ELSE + FNB2=AMAX1(FMN,FOMN(N,K)*VLNOB(L,NY,NX)) + ENDIF + TFNO2X=TFNO2X+FNO2 + TFNO2B=TFNO2B+FNB2 +C +C NO2 REDUCTION FROM SPECIFIC REDUCTION RATE, ENERGY YIELD, +C ACTIVE NITRIFIER BIOMASS, TEMPERATURE, AQUEOUS NO2 AND CO2 +C CONCENTRATIONS AND STOICHIOMETRY OF REDOX ELECTRON TRANSFER +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)) + 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 + 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/10)*10.EQ.I.AND.J.EQ.14)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,VMXD,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,VMXDX,VMXDA,RVOXA(N),RVOXB(N) +7777 FORMAT(A8,5I4,40E12.4) +C ENDIF + ELSE + RDNO3(N,K)=0.0 + RDNOB(N,K)=0.0 + RDNO2(N,K)=0.0 + RDN2B(N,K)=0.0 + RDN2O(N,K)=0.0 + RGOMY(N,K)=0.0 + RGOMD(N,K)=0.0 + ENDIF +C +C BIOMASS DECOMPOSITION AND MINERALIZATION +C +C +C MINERALIZATION-IMMOBILIZATION OF NH4 IN SOIL FROM MICROBIAL +C C:N AND NH4 CONCENTRATION IN BAND AND NON-BAND SOIL ZONES +C + RINHP=(OMC(3,N,K,L,NY,NX)*CNOMC(3,N,K)-OMN(3,N,K,L,NY,NX)) + IF(RINHP.GT.0.0)THEN + CNH4X=AMAX1(0.0,CNH4S(L,NY,NX)-Z4MN) + CNH4Y=AMAX1(0.0,CNH4B(L,NY,NX)-Z4MN) + RINHX=AMIN1(RINHP,BIOA*OMA(N,K)*TFNG(N,K)*Z4MX) + RINHO(N,K,L,NY,NX)=FNH4S*RINHX*CNH4X/(CNH4X+Z4KU) + RINHB(N,K,L,NY,NX)=FNHBS*RINHX*CNH4Y/(CNH4Y+Z4KU) + ZNH4M=Z4MN*VOLW(L,NY,NX)*FNH4S + ZNHBM=Z4MN*VOLW(L,NY,NX)*FNHBS + RINH4(N,K)=AMIN1(FNH4X*AMAX1(0.0,(ZNH4S(L,NY,NX)-ZNH4M)) + 2,RINHO(N,K,L,NY,NX)) + RINB4(N,K)=AMIN1(FNB4X*AMAX1(0.0,(ZNH4B(L,NY,NX)-ZNHBM)) + 2,RINHB(N,K,L,NY,NX)) + ELSE + RINHO(N,K,L,NY,NX)=0.0 + RINHB(N,K,L,NY,NX)=0.0 + RINH4(N,K)=RINHP*FNH4S + RINB4(N,K)=RINHP*FNHBS + ENDIF +C TRINH4(NY,NX)=TRINH4(NY,NX)+(RINH4(N,K)+RINB4(N,K)) +C 2/AREA(3,L,NY,NX) +C IF(I.EQ.365.AND.J.EQ.24.AND.L.EQ.NJ(NY,NX) +C 2.AND.K.EQ.5.AND.N.EQ.3)THEN +C WRITE(*,7776)'RINH4',IYRC,I,J,NX,NY,L,K,N,TRINH4(NY,NX) +C 1,RINH4(N,K),RINHP +C 1,BIOA*OMA(N,K)*Z4MX*TFNG(N,K),BIOA,OMA(N,K),Z4MX,TFNG(N,K) +C 2,OMC(M,N,K,L,NY,NX),CNOMC(3,N,K),OMN(M,N,K,L,NY,NX) +C 3,RINHO(N,K,L,NY,NX),CNH4S(L,NY,NX),FNH4X +C 4,ZNH4T(L),OQN(K,L,NY,NX) +7776 FORMAT(A8,8I6,30E12.4) +C ENDIF +C +C MINERALIZATION-IMMOBILIZATION OF NO3 IN SOIL FROM MICROBIAL +C C:N AND NO3 CONCENTRATION IN BAND AND NON-BAND SOIL ZONES +C + RINOP=AMAX1(0.0,RINHP-RINH4(N,K)-RINB4(N,K)) + IF(RINOP.GT.0.0)THEN + CNO3X=AMAX1(0.0,CNO3S(L,NY,NX)-ZOMN) + CNO3Y=AMAX1(0.0,CNO3B(L,NY,NX)-ZOMN) + RINOX=AMIN1(RINOP,BIOA*OMA(N,K)*TFNG(N,K)*ZOMX) + RINOO(N,K,L,NY,NX)=FNO3S*RINOX*CNO3X/(CNO3X+ZOKU) + RINOB(N,K,L,NY,NX)=FNO3B*RINOX*CNO3Y/(CNO3Y+ZOKU) + ZNO3M=ZOMN*VOLW(L,NY,NX)*FNO3S + ZNOBM=ZOMN*VOLW(L,NY,NX)*FNO3B + RINO3(N,K)=AMIN1(FNO3X*AMAX1(0.0,(ZNO3S(L,NY,NX)-ZNO3M)) + 2,RINOO(N,K,L,NY,NX)) + RINB3(N,K)=AMIN1(FNB3X*AMAX1(0.0,(ZNO3B(L,NY,NX)-ZNOBM)) + 2,RINOB(N,K,L,NY,NX)) + ELSE + RINOO(N,K,L,NY,NX)=0.0 + RINOB(N,K,L,NY,NX)=0.0 + RINO3(N,K)=RINOP*FNO3S + RINB3(N,K)=RINOP*FNO3B + ENDIF +C +C MINERALIZATION-IMMOBILIZATION OF PO4 IN SOIL FROM MICROBIAL +C C:P AND PO4 CONCENTRATION IN BAND AND NON-BAND SOIL ZONES +C + RIPOP=(OMC(3,N,K,L,NY,NX)*CPOMC(3,N,K)-OMP(3,N,K,L,NY,NX)) + IF(RIPOP.GT.0.0)THEN + CH2PX=AMAX1(0.0,CH2P4(L,NY,NX)-HPMN) + CH2PY=AMAX1(0.0,CH2PB(L,NY,NX)-HPMN) + RIPOX=AMIN1(RIPOP,BIOA*OMA(N,K)*TFNG(N,K)*HPMX) + RIPOO(N,K,L,NY,NX)=FH2PS*RIPOX*CH2PX/(CH2PX+HPKU) + RIPOB(N,K,L,NY,NX)=FH2PB*RIPOX*CH2PY/(CH2PY+HPKU) + H2POM=HPMN*VOLW(L,NY,NX)*FH2PS + H2PBM=HPMN*VOLW(L,NY,NX)*FH2PB + RIPO4(N,K)=AMIN1(FPO4X*AMAX1(0.0,(H2PO4(L,NY,NX)-H2POM)) + 2,RIPOO(N,K,L,NY,NX)) + RIPB4(N,K)=AMIN1(FPB4X*AMAX1(0.0,(H2POB(L,NY,NX)-H2PBM)) + 2,RIPOB(N,K,L,NY,NX)) + ELSE + RIPOO(N,K,L,NY,NX)=0.0 + RIPOB(N,K,L,NY,NX)=0.0 + RIPO4(N,K)=RIPOP*FH2PS + RIPB4(N,K)=RIPOP*FH2PB + ENDIF +C IF(NY.EQ.5.AND.L.EQ.10.AND.K.EQ.3.AND.N.EQ.2)THEN +C WRITE(*,4322)'RIPO4',I,J,NX,NY,L,K,N,RIPO4(N,K),FPO4X,H2P4T(L) +C 2,RIPOO(N,K,L,NY,NX),RIPOP,BIOA,OMA(N,K),TFNG(N,K),HPMX,WFN(N,K) +C 2,VLPO4(L,NY,NX),CH2PX,HPKU,VLPOB(L,NY,NX),CH2PY +C 3,OMC(3,N,K,L,NY,NX),CPOMC(3,N,K),OMP(3,N,K,L,NY,NX),WFNG +4322 FORMAT(A8,7I4,30E12.4) +C ENDIF +C +C MINERALIZATION-IMMOBILIZATION OF NH4 IN SURFACE RESIDUE FROM +C MICROBIAL C:N AND NH4 CONCENTRATION IN BAND AND NON-BAND SOIL +C ZONES OF SOIL SURFACE +C + IF(L.EQ.0)THEN + RINHPR=RINHP-RINH4(N,K)-RINO3(N,K) + IF(RINHPR.GT.0.0)THEN + CNH4X=AMAX1(0.0,CNH4S(NU(NY,NX),NY,NX)-Z4MN) + CNH4Y=AMAX1(0.0,CNH4B(NU(NY,NX),NY,NX)-Z4MN) + RINHOR(N,K,NY,NX)=AMIN1(RINHPR,BIOA*OMA(N,K)*TFNG(N,K)*Z4MX) + 2*(FNH4S*CNH4X/(CNH4X+Z4KU)+FNHBS*CNH4Y + 3/(CNH4Y+Z4KU)) + ZNH4M=Z4MN*VOLW(NU(NY,NX),NY,NX) + RINH4R(N,K)=AMIN1(FNH4XR(N,K)*AMAX1(0.0,(ZNH4T(NU(NY,NX))-ZNH4M)) + 2,RINHOR(N,K,NY,NX)) + ELSE + RINHOR(N,K,NY,NX)=0.0 + RINH4R(N,K)=RINHPR + ENDIF +C TRINH4(NY,NX)=TRINH4(NY,NX)+RINH4R(N,K) +C 2/AREA(3,L,NY,NX) +C IF(K.EQ.2.AND.N.EQ.1)THEN +C WRITE(*,7778)'RINH4R',I,J,NX,NY,L,K,N,RINH4R(N,K),RINHPR +C 2,BIOA*OMA(N,K)*Z4MX,RINHP,RINH4(N,K),RINO3(N,K) +C 3,RINHOR(N,K,NY,NX),CNH4S(NU(NY,NX),NY,NX),FNH4XR(N,K) +C 4,ZNH4T(NU(NY,NX)) +7778 FORMAT(A8,7I4,20E12.4) +C ENDIF +C +C MINERALIZATION-IMMOBILIZATION OF NO3 IN SURFACE RESIDUE FROM +C MICROBIAL C:N AND NO3 CONCENTRATION IN BAND AND NON-BAND SOIL +C ZONES OF SOIL SURFACE +C + RINOPR=AMAX1(0.0,RINHPR-RINH4R(N,K)) + IF(RINOPR.GT.0.0)THEN + CNO3X=AMAX1(0.0,CNO3S(NU(NY,NX),NY,NX)-ZOMN) + CNO3Y=AMAX1(0.0,CNO3B(NU(NY,NX),NY,NX)-ZOMN) + RINOOR(N,K,NY,NX)=AMAX1(RINOPR,BIOA*OMA(N,K)*TFNG(N,K)*ZOMX) + 2*(FNO3S*CNO3X/(CNO3X+ZOKU)+FNO3B*CNO3Y + 3/(CNO3Y+ZOKU)) + ZNO3M=ZOMN*VOLW(NU(NY,NX),NY,NX) + RINO3R(N,K)=AMIN1(FNO3XR(N,K)*AMAX1(0.0,(ZNO3T(NU(NY,NX))-ZNO3M)) + 2,RINOOR(N,K,NY,NX)) + ELSE + RINOOR(N,K,NY,NX)=0.0 + RINO3R(N,K)=RINOPR + ENDIF +C +C MINERALIZATION-IMMOBILIZATION OF PO4 IN SURFACE RESIDUE FROM +C MICROBIAL C:P AND PO4 CONCENTRATION IN BAND AND NON-BAND SOIL +C ZONES OF SOIL SURFACE +C + RIPOPR=RIPOP-RIPO4(N,K) + IF(RIPOPR.GT.0.0)THEN + CH2PX=AMAX1(0.0,CH2P4(NU(NY,NX),NY,NX)-HPMN) + CH2PY=AMAX1(0.0,CH2PB(NU(NY,NX),NY,NX)-HPMN) + RIPOOR(N,K,NY,NX)=AMIN1(RIPOPR,BIOA*OMA(N,K)*TFNG(N,K)*HPMX) + 2*(FH2PS*CH2PX/(CH2PX+HPKU)+FH2PB*CH2PY + 3/(CH2PY+HPKU)) + H2P4M=HPMN*VOLW(NU(NY,NX),NY,NX) + RIPO4R(N,K)=AMIN1(FPO4XR(N,K)*AMAX1(0.0,(H2P4T(NU(NY,NX))-H2P4M)) + 2,RIPOOR(N,K,NY,NX)) + ELSE + RIPOOR(N,K,NY,NX)=0.0 + RIPO4R(N,K)=RIPOPR + ENDIF +C WRITE(*,7778)'RIPO4R',I,J,NX,NY,L,K,N,RIPO4R(N,K),FPO4XR(N,K) +C 2,H2P4T(NU(NY,NX)),H2P4M,RIPOOR(N,K,NY,NX),RIPOPR + ENDIF +C +C pH EFFECT ON MAINTENANCE RESPIRATION +C + IF(SPOMC2.GT.0.0)THEN + FPH=1.0+AMAX1(0.0,0.25*(6.5-PH(L,NY,NX))) + RMOMX=RMOM*TFNR(N,K)*FPH + RMOMC(1,N,K)=OMN(1,N,K,L,NY,NX)*RMOMX + RMOMC(2,N,K)=OMN2(N,K)*RMOMX + ELSE + RMOMC(1,N,K)=0.0 + RMOMC(2,N,K)=0.0 + ENDIF +C +C MICROBIAL MAINTENANCE AND GROWTH RESPIRATION +C + RMOMT=RMOMC(1,N,K)+RMOMC(2,N,K) + RGOMT=AMAX1(0.0,RGOMO(N,K)-RMOMT) + RXOMT=AMAX1(0.0,RMOMT-RGOMO(N,K)) +C +C N2 FIXATION: N=(6) AEROBIC, (7) ANAEROBIC +C FROM GROWTH RESPIRATION, FIXATION ENERGY REQUIREMENT, +C MICROBIAL N REQUIREMENT IN LABILE (1) AND RESISTANT (2) FRACTIONS +C + IF(K.LE.4.AND.(N.EQ.6.OR.N.EQ.7))THEN + RGN2P=AMAX1(0.0,OMC(3,N,K,L,NY,NX)*CNOMC(3,N,K) + 2-OMN(3,N,K,L,NY,NX))/EN2F(N) + RGN2F(N,K)=AMIN1(RGN2P,RGOMT) + 2*CZ2GS(L,NY,NX)/(CZ2GS(L,NY,NX)+ZFKM) + RN2FX(N,K)=RGN2F(N,K)*EN2F(N) +C IF((I/30)*30.EQ.I.AND.J.EQ.12)THEN +C WRITE(*,5566)'N2 FIX',I,J,NX,NY,L,K,N,RN2FX(N,K),EN2F(N) +C 2,OMC(3,N,K,L,NY,NX)*CNOMC(3,N,K),OMN(3,N,K,L,NY,NX) +C 3,RINH4(N,K),RINO3(N,K),RGN2P,RGN2F(N,K),FNFX,RGOMT +C 4,CZ2GS(L,NY,NX) +5566 FORMAT(A8,7I4,30E12.4) +C ENDIF + ELSE + RN2FX(N,K)=0.0 + RGN2F(N,K)=0.0 + ENDIF +C +C DOC, DON, DOP AND ACETATE UPTAKE DRIVEN BY GROWTH RESPIRATION +C FROM O2, NOX AND C REDUCTION +C + CGOMX=AMIN1(RMOMT,RGOMO(N,K))+RGN2F(N,K)+(RGOMT-RGN2F(N,K))/ECHZ + CGOMD=RGOMD(N,K)/ENOX + CGOMC(N,K)=CGOMX+CGOMD + IF(K.LE.4)THEN + CGOQC(N,K)=CGOMX*FGOCP+CGOMD + CGOAC(N,K)=CGOMX*FGOAP + CGOXC=CGOQC(N,K)+CGOAC(N,K) + CGOMN(N,K)=AMAX1(0.0,AMIN1(OQN(K,L,NY,NX)*FOMK(N,K) + 2,CGOXC*CNQ(K)/FCN(N,K))) + CGOMP(N,K)=AMAX1(0.0,AMIN1(OQP(K,L,NY,NX)*FOMK(N,K) + 2,CGOXC*CPQ(K)/FCP(N,K))) + ELSE + CGOQC(N,K)=CGOMX+CGOMD + CGOAC(N,K)=0.0 + CGOMN(N,K)=0.0 + CGOMP(N,K)=0.0 + ENDIF + TCGOQC(K)=TCGOQC(K)+CGOQC(N,K) + TCGOAC(K)=TCGOAC(K)+CGOAC(N,K) + TCGOMN(K)=TCGOMN(K)+CGOMN(N,K) + TCGOMP(K)=TCGOMP(K)+CGOMP(N,K) +C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.EQ.3)THEN +C WRITE(*,5557)'CGOQC',I,J,NX,NY,L,K,N,CGOQC(N,K),CGOMX +C 2,FGOCP,FGOAP,CGOMD,RMOMT,RGN2F(N,K),ECHZ +C 3,RGOMD(N,K),ENOX,RGOMO(N,K),WFN(N,K),FOXYX +C WRITE(*,5557)'CGOMP',I,J,NX,NY,L,K,N,CGOMP(N,K),OQP(K,L,NY,NX) +C 2,FOMK(N,K),CGOXC,CPQ(K),FCP(N,K),CGOQC(N,K),CGOAC(N,K) +5557 FORMAT(A8,7I4,30E12.4) +C ENDIF +C +C TRANSFER UPTAKEN C,N,P FROM STORAGE TO ACTIVE BIOMASS +C + IF(OMC(3,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) + 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)))) + 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))) + RCCC=RCCZ+CCC*RCCY*(1.0-FSBST(N,K)) + RCCN=CNC*RCCX + RCCP=CPC*RCCQ + ELSE + RCCC=RCCZ + RCCN=0.0 + RCCP=0.0 + ENDIF + CGOMZ=TFNG(N,K)*OMGR*AMAX1(0.0,OMC(3,N,K,L,NY,NX)) + DO 745 M=1,2 + CGOMS(M,N,K)=FL(M)*CGOMZ + IF(OMC(3,N,K,L,NY,NX).GT.ZEROS(NY,NX))THEN + CGONS(M,N,K)=AMIN1(FL(M)*AMAX1(0.0,OMN(3,N,K,L,NY,NX)) + 2,CGOMS(M,N,K)*OMN(3,N,K,L,NY,NX)/OMC(3,N,K,L,NY,NX)) + CGOPS(M,N,K)=AMIN1(FL(M)*AMAX1(0.0,OMP(3,N,K,L,NY,NX)) + 2,CGOMS(M,N,K)*OMP(3,N,K,L,NY,NX)/OMC(3,N,K,L,NY,NX)) + ELSE + CGONS(M,N,K)=0.0 + CGOPS(M,N,K)=0.0 + ENDIF +C +C MICROBIAL DECOMPOSITION FROM BIOMASS, SPECIFIC DECOMPOSITION +C RATE, TEMPERATURE +C + SPOMX=SQRT(TFNG(N,K))*SPOMC(M)*SPOMC2 + RXOMC(M,N,K)=AMAX1(0.0,OMC(M,N,K,L,NY,NX)*SPOMX) + 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) + 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) +C +C HUMIFICATION OF MICROBIAL DECOMPOSITION PRODUCTS FROM +C DECOMPOSITION RATE, SOIL CLAY AND OC CONTENT '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 +C WRITE(*,8821)'RHOMC',I,J,L,K,N,M +C 3,CNSHY,CPSHY,FNSHY,FPSHY +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 +C NON-HUMIFIED PRODUCTS TO MICROBIAL RESIDUE +C + RCOMC(M,N,K)=RDOMC(M,N,K)-RHOMC(M,N,K) + RCOMN(M,N,K)=RDOMN(M,N,K)-RHOMN(M,N,K) + RCOMP(M,N,K)=RDOMP(M,N,K)-RHOMP(M,N,K) +745 CONTINUE +C +C MICROBIAL DECOMPOSITION WHEN MAINTENANCE RESPIRATION +C EXCEEDS UPTAKE +C + IF(RXOMT.GT.ZEROS(NY,NX).AND.RMOMT.GT.ZEROS(NY,NX) + 2.AND.RCCC.GT.ZERO)THEN + FRM=RXOMT/RMOMT + DO 730 M=1,2 + RXMMC(M,N,K)=AMIN1(OMC(M,N,K,L,NY,NX) + 2,AMAX1(0.0,FRM*RMOMC(M,N,K)/RCCC)) + RXMMN(M,N,K)=AMIN1(OMN(M,N,K,L,NY,NX) + 2,AMAX1(0.0,RXMMC(M,N,K)*CNOMA(N,K))) + RXMMP(M,N,K)=AMIN1(OMP(M,N,K,L,NY,NX) + 2,AMAX1(0.0,RXMMC(M,N,K)*CPOMA(N,K))) + RDMMC(M,N,K)=RXMMC(M,N,K)*(1.0-RCCC) + RDMMN(M,N,K)=RXMMN(M,N,K)*(1.0-RCCN)*(1.0-RCCC) + RDMMP(M,N,K)=RXMMP(M,N,K)*(1.0-RCCP)*(1.0-RCCC) + R3MMC(M,N,K)=RXMMC(M,N,K)-RDMMC(M,N,K) + R3MMN(M,N,K)=RXMMN(M,N,K)-RDMMN(M,N,K) + R3MMP(M,N,K)=RXMMP(M,N,K)-RDMMP(M,N,K) +C +C HUMIFICATION AND RECYCLING OF RESPIRATION DECOMPOSITION +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) + 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) +C IF(L.EQ.11.AND.K.EQ.1)THEN +C WRITE(*,8821)'RCMMC',I,J,L,K,N,M,RCMMC(M,N,K) +C 2,RDMMC(M,N,K),RHMMC(M,N,K),OMC(M,N,K,L,NY,NX) +C 3,FRM,RMOMC(M,N,K),OMN(1,N,K,L,NY,NX),OMN2(N,K) +C 4,RMOM,TFNR(N,K),FPH,RDMMN(M,N,K),CNSHZ,RDMMP(M,N,K) +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 ENDIF +730 CONTINUE + ELSE + DO 720 M=1,2 + RXMMC(M,N,K)=0.0 + RXMMN(M,N,K)=0.0 + RXMMP(M,N,K)=0.0 + RDMMC(M,N,K)=0.0 + RDMMN(M,N,K)=0.0 + RDMMP(M,N,K)=0.0 + R3MMC(M,N,K)=0.0 + R3MMN(M,N,K)=0.0 + R3MMP(M,N,K)=0.0 + RHMMC(M,N,K)=0.0 + RHMMN(M,N,K)=0.0 + RHMMP(M,N,K)=0.0 + RCMMC(M,N,K)=0.0 + RCMMN(M,N,K)=0.0 + RCMMP(M,N,K)=0.0 +720 CONTINUE + ENDIF + ELSE + RUPOX(N,K)=0.0 + RGOMO(N,K)=0.0 + RCO2X(N,K)=0.0 + RCH3X(N,K)=0.0 + RCH4X(N,K)=0.0 + RGOMY(N,K)=0.0 + RGOMD(N,K)=0.0 + CGOMC(N,K)=0.0 + CGOMN(N,K)=0.0 + CGOMP(N,K)=0.0 + CGOQC(N,K)=0.0 + CGOAC(N,K)=0.0 + RDNO3(N,K)=0.0 + RDNOB(N,K)=0.0 + RDNO2(N,K)=0.0 + RDN2B(N,K)=0.0 + RDN2O(N,K)=0.0 + RN2FX(N,K)=0.0 + RINH4(N,K)=0.0 + RINO3(N,K)=0.0 + RIPO4(N,K)=0.0 + RINB4(N,K)=0.0 + RINB3(N,K)=0.0 + RIPB4(N,K)=0.0 + IF(L.EQ.0)THEN + RINH4R(N,K)=0.0 + RINO3R(N,K)=0.0 + RIPO4R(N,K)=0.0 + FNH4XR(N,K)=0.0 + FNO3XR(N,K)=0.0 + FPO4XR(N,K)=0.0 + ENDIF + DO 725 M=1,2 + CGOMS(M,N,K)=0.0 + CGONS(M,N,K)=0.0 + CGOPS(M,N,K)=0.0 + RMOMC(M,N,K)=0.0 + RXMMC(M,N,K)=0.0 + RXMMN(M,N,K)=0.0 + RXMMP(M,N,K)=0.0 + RDMMC(M,N,K)=0.0 + RDMMN(M,N,K)=0.0 + RDMMP(M,N,K)=0.0 + R3MMC(M,N,K)=0.0 + R3MMN(M,N,K)=0.0 + R3MMP(M,N,K)=0.0 + RHMMC(M,N,K)=0.0 + RHMMN(M,N,K)=0.0 + RHMMP(M,N,K)=0.0 + RCMMC(M,N,K)=0.0 + RCMMN(M,N,K)=0.0 + RCMMP(M,N,K)=0.0 + RXOMC(M,N,K)=0.0 + RXOMN(M,N,K)=0.0 + RXOMP(M,N,K)=0.0 + RDOMC(M,N,K)=0.0 + RDOMN(M,N,K)=0.0 + RDOMP(M,N,K)=0.0 + R3OMC(M,N,K)=0.0 + R3OMN(M,N,K)=0.0 + R3OMP(M,N,K)=0.0 + RHOMC(M,N,K)=0.0 + RHOMN(M,N,K)=0.0 + RHOMP(M,N,K)=0.0 + RCOMC(M,N,K)=0.0 + RCOMN(M,N,K)=0.0 + RCOMP(M,N,K)=0.0 +725 CONTINUE + RH2GX(N,K)=0.0 + IF(K.EQ.5)THEN + RVOXA(N)=0.0 + RVOXB(N)=0.0 + IF(N.EQ.5)THEN + RH2GZ=0.0 + ENDIF + ENDIF + ENDIF + ENDIF +750 CONTINUE + ENDIF +760 CONTINUE +C +C CHEMODENITRIFICATION +C + IF(RNO2Y(L,NY,NX).GT.ZEROS(NY,NX))THEN + FNO2=AMAX1(FMN,RVMXC(L,NY,NX)/RNO2Y(L,NY,NX)) + ELSE + FNO2=FMN*VLNO3(L,NY,NX) + ENDIF + IF(RN2BY(L,NY,NX).GT.ZEROS(NY,NX))THEN + FNB2=AMAX1(FMN,RVMBC(L,NY,NX)/RN2BY(L,NY,NX)) + ELSE + FNB2=FMN*VLNOB(L,NY,NX) + 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)) + 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 +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) +7779 FORMAT(A8,3I4,30E12.4) +C ENDIF +C +C DECOMPOSITION +C + DO 1870 K=0,KL + ROQCK(K)=0.0 + DO 1875 N=1,7 + ROQCK(K)=ROQCK(K)+ROQCD(N,K) +1875 CONTINUE + XOQCK(K)=0.0 + XOQCZ(K)=0.0 + XOQNZ(K)=0.0 + XOQPZ(K)=0.0 + XOQAZ(K)=0.0 + DO 845 N=1,7 + DO 845 M=1,3 + XOMCZ(M,N,K)=0.0 + XOMNZ(M,N,K)=0.0 + XOMPZ(M,N,K)=0.0 +845 CONTINUE +C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.LE.1)THEN +C WRITE(*,4443)'PRIM1',I,J,NX,NY,L,K,ROQCK(K) +C 2,XOQCK(K),OQC(K,L,NY,NX),XOQCZ(K),OQN(K,L,NY,NX),XOQNZ(K) +C 3,OQP(K,L,NY,NX),XOQPZ(K),OQA(K,L,NY,NX),XOQAZ(K) +C ENDIF +1870 CONTINUE +C +C PRIMING BETWEEN LITTER AND NON-LITTER C +C + DO 795 K=0,KL + IF(K.LE.KL-1)THEN + DO 800 KK=K+1,KL + OSRT=OSRH(K)+OSRH(KK) + IF(OSRH(K).GT.ZEROS(NY,NX).AND.OSRH(KK).GT.ZEROS(NY,NX))THEN + XFRK=FPRIM*TFND(L,NY,NX)*(ROQCK(K)*OSRH(KK) + 2-ROQCK(KK)*OSRH(K))/OSRT + XFRC=FPRIM*TFND(L,NY,NX)*(OQC(K,L,NY,NX)*OSRH(KK) + 2-OQC(KK,L,NY,NX)*OSRH(K))/OSRT + XFRN=FPRIM*TFND(L,NY,NX)*(OQN(K,L,NY,NX)*OSRH(KK) + 2-OQN(KK,L,NY,NX)*OSRH(K))/OSRT + XFRP=FPRIM*TFND(L,NY,NX)*(OQP(K,L,NY,NX)*OSRH(KK) + 2-OQP(KK,L,NY,NX)*OSRH(K))/OSRT + XFRA=FPRIM*TFND(L,NY,NX)*(OQA(K,L,NY,NX)*OSRH(KK) + 2-OQA(KK,L,NY,NX)*OSRH(K))/OSRT + IF(ROQCK(K)+XOQCK(K)-XFRK.GT.0.0 + 2.AND.ROQCK(KK)+XOQCK(KK)+XFRK.GT.0.0)THEN + XOQCK(K)=XOQCK(K)-XFRK + XOQCK(KK)=XOQCK(KK)+XFRK +C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.LE.1)THEN +C WRITE(*,4442)'XOQCK',I,J,NX,NY,L,K,KK,XFRC,ROQCK(K) +C 2,OSRH(K),ROQCK(KK),OSRH(KK),XOQCK(K),XOQCK(KK) +4442 FORMAT(A8,7I4,12E12.4) +C ENDIF + ENDIF + IF(OQC(K,L,NY,NX)+XOQCZ(K)-XFRC.GT.0.0 + 2.AND.OQC(KK,L,NY,NX)+XOQCZ(KK)+XFRC.GT.0.0)THEN + XOQCZ(K)=XOQCZ(K)-XFRC + XOQCZ(KK)=XOQCZ(KK)+XFRC +C IF((I/1)*1.EQ.I.AND.L.EQ.3.AND.K.EQ.1)THEN +C WRITE(*,4442)'XOQCZ',I,J,NX,NY,L,K,KK,XFRC,OQC(K,L,NY,NX) +C 2,OSRH(K),OQC(KK,L,NY,NX),OSRH(KK),XOQCZ(K),XOQCZ(KK) +C ENDIF + ENDIF + IF(OQN(K,L,NY,NX)+XOQNZ(K)-XFRN.GT.0.0 + 2.AND.OQN(KK,L,NY,NX)+XOQNZ(KK)+XFRN.GT.0.0)THEN + XOQNZ(K)=XOQNZ(K)-XFRN + XOQNZ(KK)=XOQNZ(KK)+XFRN +C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.EQ.4)THEN +C WRITE(*,4442)'XOQNZ',I,J,NX,NY,L,K,KK,XFRN,OQN(K,L,NY,NX) +C 2,OSRH(K),OQN(KK,L,NY,NX),OSRH(KK),XOQNZ(K),XOQNZ(KK) +C ENDIF + ENDIF + IF(OQP(K,L,NY,NX)+XOQPZ(K)-XFRP.GT.0.0 + 2.AND.OQP(KK,L,NY,NX)+XOQPZ(KK)+XFRP.GT.0.0)THEN + XOQPZ(K)=XOQPZ(K)-XFRP + XOQPZ(KK)=XOQPZ(KK)+XFRP +C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.EQ.4)THEN +C WRITE(*,4442)'XOQPZ',I,J,NX,NY,L,K,KK,XFRP,OQP(K,L,NY,NX) +C 2,OSRH(K),OQP(KK,L,NY,NX),OSRH(KK),XOQPZ(K),XOQPZ(KK) +C ENDIF + ENDIF + IF(OQA(K,L,NY,NX)+XOQAZ(K)-XFRA.GT.0.0 + 2.AND.OQA(KK,L,NY,NX)+XOQAZ(KK)+XFRA.GT.0.0)THEN + XOQAZ(K)=XOQAZ(K)-XFRA + XOQAZ(KK)=XOQAZ(KK)+XFRA +C IF((I/1)*1.EQ.I.AND.L.EQ.3.AND.K.EQ.1)THEN +C WRITE(*,4442)'XOQAZ',I,J,NX,NY,L,K,KK,XFRA,OQA(K,L,NY,NX) +C 2,OSRH(K),OQA(KK,L,NY,NX),OSRH(KK),XOQAZ(K),XOQAZ(KK) +C ENDIF + ENDIF + DO 850 N=1,7 + DO 850 M=1,3 + XFMC=FPRIMM*TFNG(N,K)*(OMC(M,N,K,L,NY,NX)*OSRH(KK) + 2-OMC(M,N,KK,L,NY,NX)*OSRH(K))/OSRT + XFMN=FPRIMM*TFNG(N,K)*(OMN(M,N,K,L,NY,NX)*OSRH(KK) + 2-OMN(M,N,KK,L,NY,NX)*OSRH(K))/OSRT + XFMP=FPRIMM*TFNG(N,K)*(OMP(M,N,K,L,NY,NX)*OSRH(KK) + 2-OMP(M,N,KK,L,NY,NX)*OSRH(K))/OSRT + IF(OMC(M,N,K,L,NY,NX)+XOMCZ(M,N,K)-XFMC.GT.0.0 + 2.AND.OMC(M,N,KK,L,NY,NX)+XOMCZ(M,N,KK)+XFMC.GT.0.0)THEN + XOMCZ(M,N,K)=XOMCZ(M,N,K)-XFMC + XOMCZ(M,N,KK)=XOMCZ(M,N,KK)+XFMC +C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.EQ.4)THEN +C WRITE(*,4447)'XOMCZ',I,J,NX,NY,L,K,KK,N,M,XFMC,OMC(M,N,K,L,NY,NX) +C 2,OQC(K,L,NY,NX),OMC(M,N,KK,L,NY,NX),OQC(KK,L,NY,NX),OQCT +C 3,XOMCZ(M,N,K),XOMCZ(M,N,KK) +4447 FORMAT(A8,9I4,20E12.4) +C ENDIF + ENDIF + IF(OMN(M,N,K,L,NY,NX)+XOMNZ(M,N,K)-XFMN.GT.0.0 + 2.AND.OMN(M,N,KK,L,NY,NX)+XOMNZ(M,N,KK)+XFMN.GT.0.0)THEN + XOMNZ(M,N,K)=XOMNZ(M,N,K)-XFMN + XOMNZ(M,N,KK)=XOMNZ(M,N,KK)+XFMN +C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.EQ.4)THEN +C WRITE(*,4447)'XOMNZ',I,J,NX,NY,L,K,KK,N,M,XFMN,OMN(M,N,K,L,NY,NX) +C 2,OSRH(K),OMN(M,N,KK,L,NY,NX),OSRH(KK),XOMNZ(M,N,K),XOMNZ(M,N,KK) +C ENDIF + ENDIF + IF(OMP(M,N,K,L,NY,NX)+XOMPZ(M,N,K)-XFMP.GT.0.0 + 2.AND.OMP(M,N,KK,L,NY,NX)+XOMPZ(M,N,KK)+XFMP.GT.0.0)THEN + XOMPZ(M,N,K)=XOMPZ(M,N,K)-XFMP + XOMPZ(M,N,KK)=XOMPZ(M,N,KK)+XFMP +C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.EQ.4)THEN +C WRITE(*,4447)'XOMPZ',I,J,NX,NY,L,K,KK,N,M,XFMP,OMP(M,N,K,L,NY,NX) +C 2,OSRH(K),OMP(M,N,KK,L,NY,NX),OSRH(KK),XOMPZ(M,N,K),XOMPZ(M,N,KK) +C ENDIF + ENDIF +850 CONTINUE + ENDIF +800 CONTINUE + ENDIF +795 CONTINUE +C +C DECOMPOSITION OF ORGANIC SUBSTRATES +C + TOQCK(L,NY,NX)=0.0 + DO 1790 K=0,KL + ROQCK(K)=ROQCK(K)+XOQCK(K) + TOQCK(L,NY,NX)=TOQCK(L,NY,NX)+ROQCK(K) + OQC(K,L,NY,NX)=OQC(K,L,NY,NX)+XOQCZ(K) + OQN(K,L,NY,NX)=OQN(K,L,NY,NX)+XOQNZ(K) + OQP(K,L,NY,NX)=OQP(K,L,NY,NX)+XOQPZ(K) + OQA(K,L,NY,NX)=OQA(K,L,NY,NX)+XOQAZ(K) + DO 840 N=1,7 + DO 840 M=1,3 + OMC(M,N,K,L,NY,NX)=OMC(M,N,K,L,NY,NX)+XOMCZ(M,N,K) + OMN(M,N,K,L,NY,NX)=OMN(M,N,K,L,NY,NX)+XOMNZ(M,N,K) + OMP(M,N,K,L,NY,NX)=OMP(M,N,K,L,NY,NX)+XOMPZ(M,N,K) +840 CONTINUE + IF(TOMK(K).GT.ZEROS(NY,NX))THEN + CNOMX=TONK(K)/TONX(K) + CPOMX=TOPK(K)/TOPX(K) + FCNK(K)=AMIN1(1.0,AMAX1(0.50,CNOMX)) + FCPK(K)=AMIN1(1.0,AMAX1(0.50,CPOMX)) + ELSE + FCNK(K)=1.0 + FCPK(K)=1.0 + ENDIF +C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.EQ.4)THEN +C WRITE(*,4443)'PRIM2',I,J,NX,NY,L,K,ROQCK(K) +C 2,XOQCK(K),OQC(K,L,NY,NX),XOQCZ(K),OQN(K,L,NY,NX),XOQNZ(K) +C 3,OQP(K,L,NY,NX),XOQPZ(K),OQA(K,L,NY,NX),XOQAZ(K),TOMK(K) +C 3,TONK(K),TOPK(K),TONX(K),TOPX(K),CNOMX,CPOMX,FCNK(K),FCPK(K) +C 4,TOQCK(L,NY,NX) +4443 FORMAT(A8,6I4,20E12.4) +C ENDIF +C +C AQUEOUS CONCENTRATION OF BIOMASS TO CACULATE INHIBITION +C CONSTANT FOR DECOMPOSITION +C + IF(VOLWZ.GT.ZEROS(NY,NX))THEN + COQCK=AMIN1(0.1E+06,ROQCK(K)/VOLWZ) + ELSE + COQCK=0.1E+06 + ENDIF + DCKD=DCKM(K)*(1.0+COQCK/DCKI) + IF(OSRH(K).GT.ZEROS(NY,NX))THEN + COSC=OSRH(K)/VOLX(L,NY,NX) + DFNS=COSC/(COSC+DCKD) + OQCI=1.0/(1.0+COQC(K,L,NY,NX)/OQKI) +C IF(L.EQ.0)THEN +C WRITE(*,4242)'COSC',I,J,L,K,DFNS,COSC,COQCK,DCKD,OSRH(K) +C 2,OSAT(K),OSCT(K),ORCT(K),OHC(K,L,NY,NX),BKVL(L,NY,NX),ROQCK(K) +C 3,VOLWZ,VOLWRX(NY,NX),VOLW(0,NY,NX),FCR(NY,NX) +C 4,THETY(L,NY,NX) +4242 FORMAT(A8,4I4,30E12.4) +C ENDIF +C +C C, N, P DECOMPOSITION RATE OF SOLID SUBSTRATES 'RDOS*' FROM +C RATE CONSTANT, TOTAL ACTIVE BIOMASS, DENSITY FACTOR, +C TEMPERATURE, SUBSTRATE C:N, C:P +C + DO 785 M=1,4 + IF(OSC(M,K,L,NY,NX).GT.ZEROS(NY,NX))THEN + CNS(M,K)=AMAX1(0.0,OSN(M,K,L,NY,NX)/OSC(M,K,L,NY,NX)) + CPS(M,K)=AMAX1(0.0,OSP(M,K,L,NY,NX)/OSC(M,K,L,NY,NX)) + RDOSC(M,K)=AMAX1(0.0,AMIN1(OSA(M,K,L,NY,NX) + 2,SPOSC(M,K)*ROQCK(K)*DFNS*OQCI*TFNX*OSA(M,K,L,NY,NX)/OSRH(K))) +C 3*AMIN1(FCNK(K),FCPK(K)) + RDOSN(M,K)=AMAX1(0.0,AMIN1(OSN(M,K,L,NY,NX) + 2,CNS(M,K)*RDOSC(M,K)))/FCNK(K) + RDOSP(M,K)=AMAX1(0.0,AMIN1(OSP(M,K,L,NY,NX) + 2,CPS(M,K)*RDOSC(M,K)))/FCPK(K) +C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.LE.1)THEN +C WRITE(*,4444)'RDOSC',I,J,NX,NY,L,K,M,RDOSC(M,K),RDOSN(M,K) +C 2,RDOSP(M,K),CNS(M,K),CPS(M,K),SPOSC(M,K),ROQCK(K),DFNS,TFNX +C 3,OQCI,OSA(M,K,L,NY,NX),OSRH(K),COSC,COQCK,DCKD,VOLWZ +C 4,TFNX,WFNG,TKS(L,NY,NX),PSISM(L,NY,NX),THETW(L,NY,NX) +C 4,FOSRH(K,L,NY,NX),VOLX(L,NY,NX),ORGC(L,NY,NX),OSC(M,K,L,NY,NX) +C 2,OSN(M,K,L,NY,NX),OSP(M,K,L,NY,NX),TONK(K),TONX(K),FCNK(K) +C 6,FCPK(K),WFN(1,K),WFN(3,K),COQC(K,L,NY,NX),THETY(L,NY,NX) +4444 FORMAT(A8,7I4,40E12.4) +C ENDIF + ELSE + CNS(M,K)=CNOSC(M,K,L,NY,NX) + CPS(M,K)=CPOSC(M,K,L,NY,NX) + RDOSC(M,K)=0.0 + RDOSN(M,K)=0.0 + RDOSP(M,K)=0.0 + ENDIF +785 CONTINUE +C +C HUMIFICATION OF DECOMPOSED RESIDUE LIGNIN WITH PROTEIN, +C CH2O AND CELLULOSE 'RHOS*' WITH REMAINDER 'RCOS*' TO DOC,N,P +C + IF(K.LE.2)THEN + RHOSC(4,K)=AMAX1(0.0,AMIN1(RDOSN(4,K)/CNRH(3) + 2,RDOSP(4,K)/CPRH(3),EPOC(L,NY,NX)*RDOSC(4,K))) + RHOSCM=0.10*RHOSC(4,K) + RHOSC(1,K)=AMAX1(0.0,AMIN1(RDOSC(1,K),RDOSN(1,K)/CNRH(3) + 2,RDOSP(1,K)/CPRH(3),RHOSCM)) + RHOSC(2,K)=AMAX1(0.0,AMIN1(RDOSC(2,K),RDOSN(2,K)/CNRH(3) + 2,RDOSP(2,K)/CPRH(3),RHOSCM)) + RHOSC(3,K)=AMAX1(0.0,AMIN1(RDOSC(3,K),RDOSN(3,K)/CNRH(3) + 2,RDOSP(3,K)/CPRH(3),RHOSCM-RHOSC(2,K))) + DO 805 M=1,4 + RHOSN(M,K)=AMIN1(RDOSN(M,K),RHOSC(M,K)*CNRH(3)) + RHOSP(M,K)=AMIN1(RDOSP(M,K),RHOSC(M,K)*CPRH(3)) + RCOSC(M,K)=RDOSC(M,K)-RHOSC(M,K) + RCOSN(M,K)=RDOSN(M,K)-RHOSN(M,K) + RCOSP(M,K)=RDOSP(M,K)-RHOSP(M,K) +805 CONTINUE + ELSE + DO 810 M=1,4 + RHOSC(M,K)=0.0 + RHOSN(M,K)=0.0 + RHOSP(M,K)=0.0 + RCOSC(M,K)=RDOSC(M,K) + RCOSN(M,K)=RDOSN(M,K) + RCOSP(M,K)=RDOSP(M,K) +810 CONTINUE + ENDIF + ELSE + DO 780 M=1,4 + RDOSC(M,K)=0.0 + RDOSN(M,K)=0.0 + RDOSP(M,K)=0.0 + RHOSC(M,K)=0.0 + RHOSN(M,K)=0.0 + RHOSP(M,K)=0.0 + RCOSC(M,K)=0.0 + RCOSN(M,K)=0.0 + RCOSP(M,K)=0.0 +780 CONTINUE + ENDIF +C +C C, N, P DECOMPOSITION RATE OF BIORESIDUE 'RDOR*' FROM +C RATE CONSTANT, TOTAL ACTIVE BIOMASS, DENSITY FACTOR, +C TEMPERATURE, SUBSTRATE C:N, C:P +C + IF(OSRH(K).GT.ZEROS(NY,NX))THEN + DO 775 M=1,2 + IF(ORC(M,K,L,NY,NX).GT.ZEROS(NY,NX))THEN + CNR=AMAX1(0.0,ORN(M,K,L,NY,NX)/ORC(M,K,L,NY,NX)) + CPR=AMAX1(0.0,ORP(M,K,L,NY,NX)/ORC(M,K,L,NY,NX)) + RDORC(M,K)=AMAX1(0.0,AMIN1(ORC(M,K,L,NY,NX) + 2,SPORC(M)*ROQCK(K)*DFNS*OQCI*TFNX*ORC(M,K,L,NY,NX)/OSRH(K))) +C 3*AMIN1(FCNK(K),FCPK(K)) + RDORN(M,K)=AMAX1(0.0,AMIN1(ORN(M,K,L,NY,NX),CNR*RDORC(M,K))) + 2/FCNK(K) + RDORP(M,K)=AMAX1(0.0,AMIN1(ORP(M,K,L,NY,NX),CPR*RDORC(M,K))) + 2/FCPK(K) + ELSE + RDORC(M,K)=0.0 + RDORN(M,K)=0.0 + RDORP(M,K)=0.0 + ENDIF +775 CONTINUE + ELSE + DO 776 M=1,2 + RDORC(M,K)=0.0 + RDORN(M,K)=0.0 + RDORP(M,K)=0.0 +776 CONTINUE + ENDIF +C +C C, N, P DECOMPOSITION RATE OF SORBED SUBSTRATES 'RDOH*' FROM +C RATE CONSTANT, TOTAL ACTIVE BIOMASS, DENSITY FACTOR, +C TEMPERATURE, SUBSTRATE C:N, C:P +C + IF(OSRH(K).GT.ZEROS(NY,NX))THEN + IF(OHC(K,L,NY,NX).GT.ZEROS(NY,NX))THEN + CNH(K)=AMAX1(0.0,OHN(K,L,NY,NX)/OHC(K,L,NY,NX)) + CPH(K)=AMAX1(0.0,OHP(K,L,NY,NX)/OHC(K,L,NY,NX)) + RDOHC(K)=AMAX1(0.0,AMIN1(OHC(K,L,NY,NX) + 2,SPOHC*ROQCK(K)*DFNS*OQCI*TFNX*OHC(K,L,NY,NX)/OSRH(K))) +C 3*AMIN1(FCNK(K),FCPK(K)) + RDOHN(K)=AMAX1(0.0,AMIN1(OHN(K,L,NY,NX),CNH(K)*RDOHC(K))) + 2/FCNK(K) + RDOHP(K)=AMAX1(0.0,AMIN1(OHP(K,L,NY,NX),CPH(K)*RDOHC(K))) + 2/FCPK(K) + RDOHA(K)=AMAX1(0.0,AMIN1(OHA(K,L,NY,NX) + 2,SPOHA*ROQCK(K)*DFNS*TFNX*OHA(K,L,NY,NX)/OSRH(K))) +C 3*AMIN1(FCNK(K),FCPK(K)) + ELSE + CNH(K)=0.0 + CPH(K)=0.0 + RDOHC(K)=0.0 + RDOHN(K)=0.0 + RDOHP(K)=0.0 + RDOHA(K)=0.0 + ENDIF + ELSE + CNH(K)=0.0 + CPH(K)=0.0 + RDOHC(K)=0.0 + RDOHN(K)=0.0 + RDOHP(K)=0.0 + RDOHA(K)=0.0 + ENDIF +C +C DOC ADSORPTION - DESORPTION +C + IF(VOLWM(NPH,L,NY,NX).GT.ZEROS(NY,NX) + 2.AND.FOSRH(K,L,NY,NX).GT.ZERO)THEN + IF(L.EQ.0)THEN + AECX=50.0 + ELSE + AECX=AEC(L,NY,NX) + ENDIF + OQCX=AMAX1(ZEROS(NY,NX),OQC(K,L,NY,NX)-TCGOQC(K)) + OQNX=AMAX1(ZEROS(NY,NX),OQN(K,L,NY,NX)-TCGOAC(K)) + OQPX=AMAX1(ZEROS(NY,NX),OQP(K,L,NY,NX)-TCGOMN(K)) + OQAX=AMAX1(ZEROS(NY,NX),OQA(K,L,NY,NX)-TCGOMP(K)) + OHCX=AMAX1(ZEROS(NY,NX),OHC(K,L,NY,NX)) + OHNX=AMAX1(ZEROS(NY,NX),OHN(K,L,NY,NX)) + OHPX=AMAX1(ZEROS(NY,NX),OHP(K,L,NY,NX)) + OHAX=AMAX1(ZEROS(NY,NX),OHA(K,L,NY,NX)) + VOLXX=BKVL(L,NY,NX)*AECX*HSORP*FOSRH(K,L,NY,NX) + VOLXW=VOLWM(NPH,L,NY,NX)*FOSRH(K,L,NY,NX) + IF(FOCA(K).GT.ZERO)THEN + VOLCX=FOCA(K)*VOLXX + VOLCW=FOCA(K)*VOLXW + CSORP(K)=TSORP*(OQCX*VOLCX-OHCX*VOLCW)/(VOLCX+VOLCW) + ELSE + CSORP(K)=TSORP*(OQCX*VOLXX-OHCX*VOLXW)/(VOLXX+VOLXW) + ENDIF + IF(FOAA(K).GT.ZERO)THEN + VOLAX=FOAA(K)*VOLXX + VOLAW=FOAA(K)*VOLXW + CSORPA(K)=TSORP*(OQAX*VOLAX-OHAX*VOLAW)/(VOLAX+VOLAW) + ELSE + CSORPA(K)=TSORP*(OQAX*VOLXX-OHAX*VOLXW)/(VOLXX+VOLXW) + ENDIF + ZSORP(K)=TSORP*(OQNX*VOLXX-OHNX*VOLXW)/(VOLXX+VOLXW) + PSORP(K)=TSORP*(OQPX*VOLXX-OHPX*VOLXW)/(VOLXX+VOLXW) + ELSE + CSORP(K)=0.0 + CSORPA(K)=0.0 + ZSORP(K)=0.0 + PSORP(K)=0.0 + ENDIF +C IF(L.EQ.4.AND.K.EQ.1)THEN +C WRITE(*,591)'CSORP',I,J,NX,NY,L,K,CSORP(K),CSORPA(K) +C 1,OQC(K,L,NY,NX),OHC(K,L,NY,NX),OQA(K,L,NY,NX),OHA(K,L,NY,NX) +C 2,OQC(K,L,NY,NX)/VOLWM(NPH,L,NY,NX),OHC(K,L,NY,NX)/BKVL(L,NY,NX) +C 2,OQA(K,L,NY,NX)/VOLWM(NPH,L,NY,NX),OHA(K,L,NY,NX)/BKVL(L,NY,NX) +C 4,BKVL(L,NY,NX),VOLWM(NPH,L,NY,NX),FOCA(K),FOAA(K) +C 5,FOSRH(K,L,NY,NX),TCGOQC(K),OQCX +591 FORMAT(A8,6I4,40E12.4) +C ENDIF +1790 CONTINUE +C +C REDISTRIBUTE AUTOTROPHIC DECOMPOSITION PRODUCTS AMONG +C HETEROTROPHIC SUBSTRATE-MICROBE COMPLEXES +C + DO 1690 K=0,KL + IF(TORC.GT.ZEROS(NY,NX))THEN + FORC(K)=ORCT(K)/TORC + ELSE + IF(K.EQ.3)THEN + FORC(K)=1.0 + ELSE + FORC(K)=0.0 + ENDIF + ENDIF + DO 1685 N=1,7 + DO 1680 M=1,2 + RCCMC(M,N,K)=(RCOMC(M,N,5)+RCMMC(M,N,5))*FORC(K) + RCCMN(M,N,K)=(RCOMN(M,N,5)+RCMMN(M,N,5))*FORC(K) + RCCMP(M,N,K)=(RCOMP(M,N,5)+RCMMP(M,N,5))*FORC(K) +C IF(L.EQ.0)THEN +C WRITE(*,8821)'RCCMC',I,J,L,K,N,M,RCCMC(M,N,K) +C 2,RCOMC(M,N,5),RCMMC(M,N,5),FORC(K) +C ENDIF +1680 CONTINUE +1685 CONTINUE +1690 CONTINUE +C +C REDISTRIBUTE C,N AND P TRANSFORMATIONS AMONG STATE +C VARIABLES IN SUBSTRATE-MICROBE COMPLEXES +C + DO 590 K=0,KL + DO 580 M=1,4 +C +C SUBSTRATE DECOMPOSITION PRODUCTS +C + OSC(M,K,L,NY,NX)=OSC(M,K,L,NY,NX)-RDOSC(M,K) + OSA(M,K,L,NY,NX)=OSA(M,K,L,NY,NX)-RDOSC(M,K) + OSN(M,K,L,NY,NX)=OSN(M,K,L,NY,NX)-RDOSN(M,K) + OSP(M,K,L,NY,NX)=OSP(M,K,L,NY,NX)-RDOSP(M,K) + OQC(K,L,NY,NX)=OQC(K,L,NY,NX)+RCOSC(M,K) + OQN(K,L,NY,NX)=OQN(K,L,NY,NX)+RCOSN(M,K) + OQP(K,L,NY,NX)=OQP(K,L,NY,NX)+RCOSP(M,K) +C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.K.EQ.4)THEN +C WRITE(*,4444)'RDOSC',I,J,NX,NY,L,K,M,OSC(M,K,L,NY,NX) +C 2,RDOSC(M,K) +C ENDIF +C +C LIGNIFICATION PRODUCTS +C + IF(L.NE.0)THEN + OSC(1,3,L,NY,NX)=OSC(1,3,L,NY,NX)+RHOSC(M,K) + OSA(1,3,L,NY,NX)=OSA(1,3,L,NY,NX)+RHOSC(M,K) + OSN(1,3,L,NY,NX)=OSN(1,3,L,NY,NX)+RHOSN(M,K) + OSP(1,3,L,NY,NX)=OSP(1,3,L,NY,NX)+RHOSP(M,K) + ELSE + OSC(1,3,NU(NY,NX),NY,NX)=OSC(1,3,NU(NY,NX),NY,NX)+RHOSC(M,K) + OSA(1,3,NU(NY,NX),NY,NX)=OSA(1,3,NU(NY,NX),NY,NX)+RHOSC(M,K) + OSN(1,3,NU(NY,NX),NY,NX)=OSN(1,3,NU(NY,NX),NY,NX)+RHOSN(M,K) + OSP(1,3,NU(NY,NX),NY,NX)=OSP(1,3,NU(NY,NX),NY,NX)+RHOSP(M,K) + ENDIF +580 CONTINUE +C +C MICROBIAL RESIDUE DECOMPOSITION PRODUCTS +C + DO 575 M=1,2 + ORC(M,K,L,NY,NX)=ORC(M,K,L,NY,NX)-RDORC(M,K) + ORN(M,K,L,NY,NX)=ORN(M,K,L,NY,NX)-RDORN(M,K) + ORP(M,K,L,NY,NX)=ORP(M,K,L,NY,NX)-RDORP(M,K) + OQC(K,L,NY,NX)=OQC(K,L,NY,NX)+RDORC(M,K) + OQN(K,L,NY,NX)=OQN(K,L,NY,NX)+RDORN(M,K) + OQP(K,L,NY,NX)=OQP(K,L,NY,NX)+RDORP(M,K) +575 CONTINUE + OQC(K,L,NY,NX)=OQC(K,L,NY,NX)+RDOHC(K) + OQN(K,L,NY,NX)=OQN(K,L,NY,NX)+RDOHN(K)+RCOQN*FORC(K) + OQP(K,L,NY,NX)=OQP(K,L,NY,NX)+RDOHP(K) + OQA(K,L,NY,NX)=OQA(K,L,NY,NX)+RDOHA(K) + OHC(K,L,NY,NX)=OHC(K,L,NY,NX)-RDOHC(K) + OHN(K,L,NY,NX)=OHN(K,L,NY,NX)-RDOHN(K) + OHP(K,L,NY,NX)=OHP(K,L,NY,NX)-RDOHP(K) + OHA(K,L,NY,NX)=OHA(K,L,NY,NX)-RDOHA(K) +C +C MICROBIAL UPTAKE OF DISSOLVED C, N, P +C + DO 570 N=1,7 + OQC(K,L,NY,NX)=OQC(K,L,NY,NX)-CGOQC(N,K) + OQN(K,L,NY,NX)=OQN(K,L,NY,NX)-CGOMN(N,K) + OQP(K,L,NY,NX)=OQP(K,L,NY,NX)-CGOMP(N,K) + OQA(K,L,NY,NX)=OQA(K,L,NY,NX)-CGOAC(N,K)+RCH3X(N,K) +C +C MICROBIAL DECOMPOSITION PRODUCTS +C + DO 565 M=1,2 + ORC(M,K,L,NY,NX)=ORC(M,K,L,NY,NX)+RCOMC(M,N,K)+RCCMC(M,N,K) + 2+RCMMC(M,N,K) + ORN(M,K,L,NY,NX)=ORN(M,K,L,NY,NX)+RCOMN(M,N,K)+RCCMN(M,N,K) + 2+RCMMN(M,N,K) + ORP(M,K,L,NY,NX)=ORP(M,K,L,NY,NX)+RCOMP(M,N,K)+RCCMP(M,N,K) + 2+RCMMP(M,N,K) +C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.EQ.4.AND.K.EQ.2)THEN +C WRITE(*,8821)'ORC',I,J,L,K,N,M,ORC(M,K,L,NY,NX) +C 2,RCOMC(M,N,K),RCCMC(M,N,K),RCMMC(M,N,K),RDORC(M,K) +C WRITE(*,8821)'ORP',I,J,L,K,N,M,ORP(M,K,L,NY,NX) +C 2,RCOMP(M,N,K),RCCMP(M,N,K),RCMMP(M,N,K),RDORP(M,K) +8821 FORMAT(A8,6I4,30E12.4) +C ENDIF +565 CONTINUE +570 CONTINUE +C +C SORPTION PRODUCTS +C + OQC(K,L,NY,NX)=OQC(K,L,NY,NX)-CSORP(K) + OQN(K,L,NY,NX)=OQN(K,L,NY,NX)-ZSORP(K) + OQP(K,L,NY,NX)=OQP(K,L,NY,NX)-PSORP(K) + OQA(K,L,NY,NX)=OQA(K,L,NY,NX)-CSORPA(K) + OHC(K,L,NY,NX)=OHC(K,L,NY,NX)+CSORP(K) + OHN(K,L,NY,NX)=OHN(K,L,NY,NX)+ZSORP(K) + OHP(K,L,NY,NX)=OHP(K,L,NY,NX)+PSORP(K) + OHA(K,L,NY,NX)=OHA(K,L,NY,NX)+CSORPA(K) +C IF((I/1)*1.EQ.I.AND.L.EQ.3.AND.K.EQ.1)THEN +C WRITE(*,592)'OQC',I,J,NX,NY,L,K,OQC(K,L,NY,NX) +C 2,(RCOSC(M,K),M=1,4),(RDORC(M,K),M=1,2),RDOHC(K) +C 2,(CGOQC(N,K),N=1,7),CSORP(K),OHC(K,L,NY,NX),OQCI +C 4,(WFN(N,K),N=1,7),OQA(K,L,NY,NX),RDOHA(K),(RCH3X(N,K),N=1,7) +C 3,(CGOAC(N,K),N=1,7),CSORPA(K),OHA(K,L,NY,NX) +C WRITE(*,592)'OQN',I,J,NX,NY,L,K,OQN(K,L,NY,NX) +C 2,(RCOSN(M,K),M=1,4),(RDORN(M,K),M=1,2),RDOHN(K) +C 2,RCOQN*FORC(K),(CGOMN(N,K),N=1,7),ZSORP(K),OHN(K,L,NY,NX) +592 FORMAT(A8,6I4,80E12.4) +C ENDIF +590 CONTINUE +C +C MICROBIAL GROWTH FROM RESPIRATION, MINERALIZATION +C + DO 550 K=0,5 + TGROMC(K)=0.0 + IF(L.NE.0.OR.(K.NE.3.AND.K.NE.4))THEN + DO 545 N=1,7 + IF(K.NE.5.OR.(N.LE.3.OR.N.EQ.5))THEN + DO 540 M=1,2 + OMC(M,N,K,L,NY,NX)=OMC(M,N,K,L,NY,NX)+CGOMS(M,N,K) + 2-RXOMC(M,N,K)-RXMMC(M,N,K) + OMN(M,N,K,L,NY,NX)=OMN(M,N,K,L,NY,NX)+CGONS(M,N,K) + 2-RXOMN(M,N,K)-RXMMN(M,N,K) + OMP(M,N,K,L,NY,NX)=OMP(M,N,K,L,NY,NX)+CGOPS(M,N,K) + 2-RXOMP(M,N,K)-RXMMP(M,N,K) +C IF((I/30)*30.EQ.I.AND.J.EQ.15.AND.L.LE.6 +C 2.AND.K.EQ.5.AND.N.EQ.2)THEN +C WRITE(*,4488)'RDOMC',I,J,NX,NY,L,K,N,M,CGOMS(M,N,K),CGOQC(N,K) +C 4,CGOAC(N,K),RGOMO(N,K),RGOMD(N,K),RXOMC(M,N,K),RXMMC(M,N,K) +C 3,RMOMC(M,N,K),TFNX,OMGR,OMC(3,N,K,L,NY,NX),WFN(N,K) +C 3,OMC(M,N,K,L,NY,NX),OMA(N,K),TSRH +C 4,RCH3X(N,K),RH2GZ,RH2GX(4,K),FOCA(K),FOAA(K) +C 6,OQA(K,L,NY,NX),OHA(K,L,NY,NX),OQC(K,L,NY,NX),OHC(K,L,NY,NX) +C 7,OMP(M,N,K,L,NY,NX),CGOPS(M,N,K),RDOMP(M,N,K),RDMMP(M,N,K) +C 8,OMP(3,N,K,L,NY,NX),CGOMP(N,K),RIPO4(N,K) +4488 FORMAT(A8,8I4,40E12.4) +C ENDIF +C +C HUMIFICATION PRODUCTS +C + IF(L.NE.0)THEN + OSC(1,4,L,NY,NX)=OSC(1,4,L,NY,NX)+CFOMC(1,L,NY,NX) + 2*(RHOMC(M,N,K)+RHMMC(M,N,K)) + OSA(1,4,L,NY,NX)=OSA(1,4,L,NY,NX)+CFOMC(1,L,NY,NX) + 2*(RHOMC(M,N,K)+RHMMC(M,N,K)) + OSN(1,4,L,NY,NX)=OSN(1,4,L,NY,NX)+CFOMC(1,L,NY,NX) + 2*(RHOMN(M,N,K)+RHMMN(M,N,K)) + OSP(1,4,L,NY,NX)=OSP(1,4,L,NY,NX)+CFOMC(1,L,NY,NX) + 2*(RHOMP(M,N,K)+RHMMP(M,N,K)) + OSC(2,4,L,NY,NX)=OSC(2,4,L,NY,NX)+CFOMC(2,L,NY,NX) + 2*(RHOMC(M,N,K)+RHMMC(M,N,K)) + OSA(2,4,L,NY,NX)=OSA(2,4,L,NY,NX)+CFOMC(2,L,NY,NX) + 2*(RHOMC(M,N,K)+RHMMC(M,N,K)) + OSN(2,4,L,NY,NX)=OSN(2,4,L,NY,NX)+CFOMC(2,L,NY,NX) + 2*(RHOMN(M,N,K)+RHMMN(M,N,K)) + OSP(2,4,L,NY,NX)=OSP(2,4,L,NY,NX)+CFOMC(2,L,NY,NX) + 2*(RHOMP(M,N,K)+RHMMP(M,N,K)) +C IF((I/10)*10.EQ.I.AND.J.EQ.24)THEN +C WRITE(*,4445)'RHOMC',I,J,NX,NY,L,K,M,N,OSC(1,4,L,NY,NX) +C 2,OSC(2,4,L,NY,NX),CFOMC(1,L,NY,NX),CFOMC(2,L,NY,NX) +C 3,RHOMC(M,N,K),RHMMC(M,N,K) +4445 FORMAT(A8,8I4,40E12.4) +C ENDIF + ELSE + OSC(1,4,NU(NY,NX),NY,NX)=OSC(1,4,NU(NY,NX),NY,NX) + 2+CFOMC(1,NU(NY,NX),NY,NX)*(RHOMC(M,N,K)+RHMMC(M,N,K)) + OSA(1,4,NU(NY,NX),NY,NX)=OSA(1,4,NU(NY,NX),NY,NX) + 2+CFOMC(1,NU(NY,NX),NY,NX)*(RHOMC(M,N,K)+RHMMC(M,N,K)) + OSN(1,4,NU(NY,NX),NY,NX)=OSN(1,4,NU(NY,NX),NY,NX) + 2+CFOMC(1,NU(NY,NX),NY,NX)*(RHOMN(M,N,K)+RHMMN(M,N,K)) + OSP(1,4,NU(NY,NX),NY,NX)=OSP(1,4,NU(NY,NX),NY,NX) + 2+CFOMC(1,NU(NY,NX),NY,NX)*(RHOMP(M,N,K)+RHMMP(M,N,K)) + OSC(2,4,NU(NY,NX),NY,NX)=OSC(2,4,NU(NY,NX),NY,NX) + 2+CFOMC(2,NU(NY,NX),NY,NX)*(RHOMC(M,N,K)+RHMMC(M,N,K)) + OSA(2,4,NU(NY,NX),NY,NX)=OSA(2,4,NU(NY,NX),NY,NX) + 2+CFOMC(2,NU(NY,NX),NY,NX)*(RHOMC(M,N,K)+RHMMC(M,N,K)) + OSN(2,4,NU(NY,NX),NY,NX)=OSN(2,4,NU(NY,NX),NY,NX) + 2+CFOMC(2,NU(NY,NX),NY,NX)*(RHOMN(M,N,K)+RHMMN(M,N,K)) + OSP(2,4,NU(NY,NX),NY,NX)=OSP(2,4,NU(NY,NX),NY,NX) + 2+CFOMC(2,NU(NY,NX),NY,NX)*(RHOMP(M,N,K)+RHMMP(M,N,K)) + ENDIF +540 CONTINUE +C +C INPUTS TO NONSTRUCTURAL POOLS +C + CGROMC=CGOMC(N,K)-RGOMO(N,K)-RGOMD(N,K)-RGN2F(N,K) + TGROMC(K)=TGROMC(K)+CGROMC + RCO2X(N,K)=RCO2X(N,K)+RGN2F(N,K) + DO 555 M=1,2 + OMC(3,N,K,L,NY,NX)=OMC(3,N,K,L,NY,NX)-CGOMS(M,N,K) + 2+R3OMC(M,N,K) + OMN(3,N,K,L,NY,NX)=OMN(3,N,K,L,NY,NX)-CGONS(M,N,K) + 2+R3OMN(M,N,K)+R3MMN(M,N,K) + OMP(3,N,K,L,NY,NX)=OMP(3,N,K,L,NY,NX)-CGOPS(M,N,K) + 2+R3OMP(M,N,K)+R3MMP(M,N,K) + RCO2X(N,K)=RCO2X(N,K)+R3MMC(M,N,K) +555 CONTINUE + OMC(3,N,K,L,NY,NX)=OMC(3,N,K,L,NY,NX)+CGROMC + OMN(3,N,K,L,NY,NX)=OMN(3,N,K,L,NY,NX)+CGOMN(N,K) + 2+RINH4(N,K)+RINB4(N,K)+RINO3(N,K)+RINB3(N,K)+RN2FX(N,K) + OMP(3,N,K,L,NY,NX)=OMP(3,N,K,L,NY,NX)+CGOMP(N,K) + 2+RIPO4(N,K)+RIPB4(N,K) + IF(L.EQ.0)THEN + OMN(3,N,K,L,NY,NX)=OMN(3,N,K,L,NY,NX)+RINH4R(N,K)+RINO3R(N,K) + OMP(3,N,K,L,NY,NX)=OMP(3,N,K,L,NY,NX)+RIPO4R(N,K) + ENDIF +C IF(NY.EQ.5.AND.L.EQ.10.AND.K.EQ.3.AND.N.EQ.2)THEN +C WRITE(*,5556)'OMC3',I,J,NX,NY,L,K,N,OMC(3,N,K,L,NY,NX) +C 2,CGOMS(1,N,K),CGOMS(2,N,K),CGROMC,OMP(3,N,K,L,NY,NX) +C 3,CGOPS(1,N,K),CGOPS(2,N,K),CGOMP(N,K),RIPO4(N,K) +C 4,CGOMC(N,K),RGOMO(N,K),RGOMD(N,K),RMOMT,WFN(N,K) +5556 FORMAT(A8,7I4,20E12.4) +C ENDIF + ENDIF +545 CONTINUE + ENDIF +550 CONTINUE + DO 475 K=0,KL + OSCT(K)=0.0 + OSAT(K)=0.0 + DO 475 M=1,4 + OSCT(K)=OSCT(K)+OSC(M,K,L,NY,NX) + OSAT(K)=OSAT(K)+OSA(M,K,L,NY,NX) +475 CONTINUE + DO 480 K=0,KL + OSCX=OSCT(K)-OSAT(K) + IF(OSCX.GT.ZEROS(NY,NX))THEN + IF(OSAT(K).GT.ZEROS(NY,NX))THEN + COSC=OSCX/OSAT(K) + DFNA=COSC/(COSC+DCKX(K)) + ELSE + DFNA=1.0 + ENDIF + DO 485 M=1,4 + OSA(M,K,L,NY,NX)=AMIN1(OSC(M,K,L,NY,NX) + 2,OSA(M,K,L,NY,NX)+DOSA(K)*(AMAX1(DOSM(K),AMIN1(DOSX(K),TGROMC(K) + 3/AREA(3,L,NY,NX))))*AREA(3,L,NY,NX) + 3*(OSC(M,K,L,NY,NX)-OSA(M,K,L,NY,NX))/OSCX*DFNA) +C IF(INT(I/30)*30.EQ.I.AND.J.EQ.19.AND.K.LE.1)THEN +C WRITE(*,8822)'OSA',I,J,L,K,M,OSA(M,K,L,NY,NX),OSC(M,K,L,NY,NX) +C 3,OSAT(K),OSCT(K),(OSC(M,K,L,NY,NX)-OSA(M,K,L,NY,NX)) +C 3/OSCX,DOSA(K),ROQCK(K),TFNX,TFNX,WFNG,COSC,DFNA +C 4,(TGROMC(K)/AREA(3,L,NY,NX)) +C 5,(AMAX1(DOSM(K),AMIN1(DOSX(K) +C 3,TGROMC(K)/AREA(3,L,NY,NX)))),TGROMC(K) +C ENDIF +8822 FORMAT(A8,5I4,20E12.4) +485 CONTINUE + ELSE + DO 490 M=1,4 + OSA(M,K,L,NY,NX)=AMIN1(OSC(M,K,L,NY,NX),OSA(M,K,L,NY,NX)) +490 CONTINUE + ENDIF +C IF(L.EQ.0)THEN +C WRITE(*,8823)'OSC',I,J,L,K,((OMC(M,N,K,L,NY,NX),N=1,7),M=1,3) +C 2,(ORC(M,K,L,NY,NX),M=1,2),OQC(K,L,NY,NX),OQCH(K,L,NY,NX) +C 3,OHC(K,L,NY,NX),OQA(K,L,NY,NX),OQAH(K,L,NY,NX),OHA(K,L,NY,NX) +C 4,(OSC(M,K,L,NY,NX),M=1,4) +8823 FORMAT(A8,4I4,100E24.16) +C ENDIF +480 CONTINUE +C +C AGGREGATE TRANSFORMATIONS +C + TRINH=0.0 + TRINO=0.0 + TRIPO=0.0 + TRINB=0.0 + TRIOB=0.0 + TRIPB=0.0 + TRGOM=0.0 + TRGOC=0.0 + TRGOD=0.0 + TRGOA=0.0 + TRGOH=0.0 + TUPOX=0.0 + TRDN3=0.0 + TRDNB=0.0 + TRDN2=0.0 + TRD2B=0.0 + TRDNO=0.0 + TRN2F=0.0 + DO 650 K=0,5 + IF(L.NE.0.OR.(K.NE.3.AND.K.NE.4))THEN + DO 640 N=1,7 + IF(K.NE.5.OR.(N.LE.3.OR.N.EQ.5))THEN + TRINH=TRINH+RINH4(N,K) + TRINO=TRINO+RINO3(N,K) + TRIPO=TRIPO+RIPO4(N,K) + TRINB=TRINB+RINB4(N,K) + TRIOB=TRIOB+RINB3(N,K) + TRIPB=TRIPB+RIPB4(N,K) + TRN2F=TRN2F+RN2FX(N,K) + IF(L.EQ.NU(NY,NX))THEN + TRINH=TRINH+RINH4R(N,K) + TRINO=TRINO+RINO3R(N,K) + TRIPO=TRIPO+RIPO4R(N,K) + ENDIF +C IF(NY.EQ.5.AND.L.EQ.10.AND.K.EQ.3.AND.N.EQ.2)THEN +C WRITE(*,4469)'TRINH',I,J,NX,NY,L,K,N,TRINH,RINH4(N,K),RINH4R(N,K) +C WRITE(*,4469)'TRIPO',I,J,NX,NY,L,K,N,TRIPO,RIPO4(N,K),RIPO4R(N,K) +C 2,CGOMP(N,K) +4469 FORMAT(A8,7I4,20E12.4) +C ENDIF + TRGOM=TRGOM+RCO2X(N,K) + TRGOC=TRGOC+RCH4X(N,K) + TRGOD=TRGOD+RGOMD(N,K) + TUPOX=TUPOX+RUPOX(N,K) + TRDN3=TRDN3+RDNO3(N,K) + TRDNB=TRDNB+RDNOB(N,K) + TRDN2=TRDN2+RDNO2(N,K) + TRD2B=TRD2B+RDN2B(N,K) + TRDNO=TRDNO+RDN2O(N,K) + TRGOH=TRGOH+RH2GX(N,K) +C IF(L.EQ.NU(NY,NX))THEN +C WRITE(*,3333)'TUPOX',I,J,NX,NY,L,K,N,TUPOX,RUPOX(N,K) +C ENDIF +C IF(J.EQ.12.AND.L.LE.4)THEN +C WRITE(*,3333)'N2O',I,J,NX,NY,L,K,N,TRDN2,TRD2B,TRDNO +C 2,RDNO2(N,K),RDN2B(N,K),RDN2O(N,K),COXYS(L,NY,NX) +C 3,COXYG(L,NY,NX) +C WRITE(*,3333)'TRGOH',I,J,NX,NY,L,K,N,TRGOH,RH2GX(N,K) +C 2,RGOMO(N,K) +3333 FORMAT(A8,7I4,20E12.4) +C ENDIF + ENDIF +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 + TRGOA=TRGOA+CGOMC(N,5) + ENDIF + ENDIF +645 CONTINUE +C +C ALLOCATE AGGREGATED TRANSFORMATIONS INTO ARRAYS TO UPDATE +C STATE VARIABLES IN 'REDIST' +C + RCO2O(L,NY,NX)=TRGOA-TRGOM-TRGOD-RVOXA(3) + RCH4O(L,NY,NX)=RVOXA(3)+CGOMC(3,5)-TRGOC + RH2GO(L,NY,NX)=RH2GZ-TRGOH + 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 WRITE(*,2468)'RN2O',I,J,NX,NY,L +C 2,RN2O(L,NY,NX),TRDN2,TRD2B,RCN2O,RCN2B,TRDNO +C 2,RCH4O(L,NY,NX),RVOXA(3) +C 2,CGOMC(3,5),TRGOC,(OMA(N,1),N=1,7) +2468 FORMAT(A8,5I4,20E12.4) +C ENDIF + DO 655 K=0,4 + DO 660 M=1,4 + XOQCS(K,L,NY,NX)=XOQCS(K,L,NY,NX)+RCOSC(M,K) + XOQNS(K,L,NY,NX)=XOQNS(K,L,NY,NX)+RCOSN(M,K) + XOQPS(K,L,NY,NX)=XOQPS(K,L,NY,NX)+RCOSP(M,K) +660 CONTINUE + DO 665 M=1,2 + XOQCS(K,L,NY,NX)=XOQCS(K,L,NY,NX)+RDORC(M,K) + XOQNS(K,L,NY,NX)=XOQNS(K,L,NY,NX)+RDORN(M,K) + XOQPS(K,L,NY,NX)=XOQPS(K,L,NY,NX)+RDORP(M,K) +665 CONTINUE + XOQCS(K,L,NY,NX)=XOQCS(K,L,NY,NX)+RDOHC(K) + XOQNS(K,L,NY,NX)=XOQNS(K,L,NY,NX)+RDOHN(K) + XOQPS(K,L,NY,NX)=XOQPS(K,L,NY,NX)+RDOHP(K) + XOQAS(K,L,NY,NX)=XOQAS(K,L,NY,NX)+RDOHA(K) + DO 670 N=1,7 + XOQCS(K,L,NY,NX)=XOQCS(K,L,NY,NX)-CGOQC(N,K) + XOQNS(K,L,NY,NX)=XOQNS(K,L,NY,NX)-CGOMN(N,K) + XOQPS(K,L,NY,NX)=XOQPS(K,L,NY,NX)-CGOMP(N,K) + XOQAS(K,L,NY,NX)=XOQAS(K,L,NY,NX)-CGOAC(N,K)+RCH3X(N,K) +670 CONTINUE + XOQCS(K,L,NY,NX)=XOQCS(K,L,NY,NX)-CSORP(K) + XOQNS(K,L,NY,NX)=XOQNS(K,L,NY,NX)-ZSORP(K) + XOQPS(K,L,NY,NX)=XOQPS(K,L,NY,NX)-PSORP(K) + XOQAS(K,L,NY,NX)=XOQAS(K,L,NY,NX)-CSORPA(K) +655 CONTINUE + XNH4S(L,NY,NX)=-TRINH-RVOXA(1) + XNO3S(L,NY,NX)=-TRINO+RVOXA(2)-TRDN3+RCNO3 + XNO2S(L,NY,NX)=RVOXA(1)-RVOXA(2)+TRDN3-TRDN2-RCNO2 + XH2PS(L,NY,NX)=-TRIPO + XNH4B(L,NY,NX)=-TRINB-RVOXB(1) + XNO3B(L,NY,NX)=-TRIOB+RVOXB(2)-TRDNB+RCN3B + XNO2B(L,NY,NX)=RVOXB(1)-RVOXB(2)+TRDNB-TRD2B-RCNOB + XH2BS(L,NY,NX)=-TRIPB + XN2GS(L,NY,NX)=TRN2F + XZHYS(L,NY,NX)=0.1429*(RVOXA(1)+RVOXB(1)-TRDN3-TRDNB) + 2-0.0714*(TRDN2+TRD2B+TRDNO) + TFNQ(L,NY,NX)=TFNX + VOLQ(L,NY,NX)=VOLWZ +C IF(L.EQ.0)THEN +C WRITE(*,2323)'XNH4S',I,J,L,XNH4S(L,NY,NX) +C 2,TRINH,RVOXA(1),VLNH4(L,NY,NX) +C WRITE(*,2323)'XNO3S',I,J,L,XNO3S(L,NY,NX) +C 2,TRINO,RVOXA(2),VLNO3(L,NY,NX),TRDN3,RCNO3 +C WRITE(*,2323)'XH2PS',I,J,L,XH2PS(L,NY,NX) +C 2,RIPOT,TRIPO,VLPO4(L,NY,NX) +C WRITE(*,2323)'XNO2B',I,J,L,XNO2B(L,NY,NX),RVOXB(1) +C 2,VLNHB(L,NY,NX),RVOXB(2),VLNOB(L,NY,NX),TRDNB,TRD2B,RCNOB +2323 FORMAT(A8,3I4,12E12.4) +C ENDIF + ELSE + RCO2O(L,NY,NX)=0.0 + RCH4O(L,NY,NX)=0.0 + RH2GO(L,NY,NX)=0.0 + RUPOXO(L,NY,NX)=0.0 + RN2G(L,NY,NX)=0.0 + RN2O(L,NY,NX)=0.0 + XNH4S(L,NY,NX)=0.0 + XNO3S(L,NY,NX)=0.0 + XNO2S(L,NY,NX)=0.0 + XH2PS(L,NY,NX)=0.0 + XNH4B(L,NY,NX)=0.0 + XNO3B(L,NY,NX)=0.0 + XNO2B(L,NY,NX)=0.0 + XH2BS(L,NY,NX)=0.0 + XN2GS(L,NY,NX)=0.0 + XZHYS(L,NY,NX)=0.0 + ENDIF +C +C ADJUST LAYERING OF SOC +C + IF(L.EQ.0.OR.(L.GE.NU(NY,NX).AND.L.LT.NL(NY,NX)))THEN +C 2.AND.CDPTH(L,NY,NX).LE.CDPTH(NU(NY,NX)-1,NY,NX)+0.60)THEN + IF(L.EQ.0)THEN + LL=NU(NY,NX) + IF(ORGR(L,NY,NX).GT.0.0)THEN + FOSCXS=AMIN1(1.0,FOSCZ0/ORGR(L,NY,NX)*TOMA*TFNX) + ELSE + FOSCXS=0.0 + ENDIF + ELSE + LL=L+1 + OSCXD=(ORGR(L,NY,NX)*VOLT(LL,NY,NX)-ORGR(LL,NY,NX)*VOLT(L,NY,NX)) + 2/(VOLT(L,NY,NX)+VOLT(LL,NY,NX)) + IF(OSCXD.GT.0.0.AND.ORGR(L,NY,NX).GT.ZEROS(NY,NX))THEN + FOSCXD=OSCXD/ORGR(L,NY,NX) + ELSEIF(OSCXD.LT.0.0.AND.ORGR(LL,NY,NX).GT.ZEROS(NY,NX))THEN + FOSCXD=OSCXD/ORGR(LL,NY,NX) + ELSE + FOSCXD=0.0 + ENDIF + FOSCXS=FOSCZL*FOSCXD*TFNX*TOMA/VOLT(L,NY,NX) + ENDIF +C IF(L.EQ.3.AND.K.EQ.2)THEN +C WRITE(*,1115)'MIX',I,J,L,LL,FOSCXS,FOSCZ0,FOSCZL,OSCXD,TOMA +C 2,TFNX,ORGR(L,NY,NX),VOLT(LL,NY,NX),ORGR(LL,NY,NX),VOLT(L,NY,NX) +1115 FORMAT(A8,4I4,20E12.4) +C ENDIF + IF(FOSCXS.NE.0.0)THEN + DO 7971 K=1,2 + DO 7961 N=1,7 + DO 7962 M=1,3 + IF(FOSCXS.GT.0.0)THEN + OMCXS=FOSCXS*AMAX1(0.0,OMC(M,N,K,L,NY,NX)) + OMNXS=FOSCXS*AMAX1(0.0,OMN(M,N,K,L,NY,NX)) + OMPXS=FOSCXS*AMAX1(0.0,OMP(M,N,K,L,NY,NX)) + ELSE + OMCXS=FOSCXS*AMAX1(0.0,OMC(M,N,K,LL,NY,NX)) + OMNXS=FOSCXS*AMAX1(0.0,OMN(M,N,K,LL,NY,NX)) + OMPXS=FOSCXS*AMAX1(0.0,OMP(M,N,K,LL,NY,NX)) + ENDIF + OMC(M,N,K,L,NY,NX)=OMC(M,N,K,L,NY,NX)-OMCXS + OMN(M,N,K,L,NY,NX)=OMN(M,N,K,L,NY,NX)-OMNXS + OMP(M,N,K,L,NY,NX)=OMP(M,N,K,L,NY,NX)-OMPXS + OMC(M,N,K,LL,NY,NX)=OMC(M,N,K,LL,NY,NX)+OMCXS + OMN(M,N,K,LL,NY,NX)=OMN(M,N,K,LL,NY,NX)+OMNXS + OMP(M,N,K,LL,NY,NX)=OMP(M,N,K,LL,NY,NX)+OMPXS +7962 CONTINUE +7961 CONTINUE +7971 CONTINUE + DO 7901 K=1,2 + DO 7941 M=1,2 + IF(FOSCXS.GT.0.0)THEN + ORCXS=FOSCXS*AMAX1(0.0,ORC(M,K,L,NY,NX)) + ORNXS=FOSCXS*AMAX1(0.0,ORN(M,K,L,NY,NX)) + ORPXS=FOSCXS*AMAX1(0.0,ORP(M,K,L,NY,NX)) + ELSE + ORCXS=FOSCXS*AMAX1(0.0,ORC(M,K,LL,NY,NX)) + ORNXS=FOSCXS*AMAX1(0.0,ORN(M,K,LL,NY,NX)) + ORPXS=FOSCXS*AMAX1(0.0,ORP(M,K,LL,NY,NX)) + ENDIF + ORC(M,K,L,NY,NX)=ORC(M,K,L,NY,NX)-ORCXS + ORN(M,K,L,NY,NX)=ORN(M,K,L,NY,NX)-ORNXS + ORP(M,K,L,NY,NX)=ORP(M,K,L,NY,NX)-ORPXS + ORC(M,K,LL,NY,NX)=ORC(M,K,LL,NY,NX)+ORCXS + ORN(M,K,LL,NY,NX)=ORN(M,K,LL,NY,NX)+ORNXS + ORP(M,K,LL,NY,NX)=ORP(M,K,LL,NY,NX)+ORPXS +C IF(L.EQ.3.AND.K.EQ.2)THEN +C WRITE(*,7942)'ORC',I,J,L,LL,K,M,ORC(M,K,L,NY,NX) +C 2,ORC(M,K,LL,NY,NX),ORCXS,FOSCXS +7942 FORMAT(A8,6I4,20E12.4) +C ENDIF +7941 CONTINUE + IF(FOSCXS.GT.0.0)THEN + OQCXS=FOSCXS*AMAX1(0.0,OQC(K,L,NY,NX)) + OQCHXS=FOSCXS*AMAX1(0.0,OQCH(K,L,NY,NX)) + OHCXS=FOSCXS*AMAX1(0.0,OHC(K,L,NY,NX)) + OQAXS=FOSCXS*AMAX1(0.0,OQA(K,L,NY,NX)) + OQAHXS=FOSCXS*AMAX1(0.0,OQAH(K,L,NY,NX)) + OHAXS=FOSCXS*AMAX1(0.0,OHA(K,L,NY,NX)) + OQNXS=FOSCXS*AMAX1(0.0,OQN(K,L,NY,NX)) + OQNHXS=FOSCXS*AMAX1(0.0,OQNH(K,L,NY,NX)) + OHNXS=FOSCXS*AMAX1(0.0,OHN(K,L,NY,NX)) + OQPXS=FOSCXS*AMAX1(0.0,OQP(K,L,NY,NX)) + OQPHXS=FOSCXS*AMAX1(0.0,OQPH(K,L,NY,NX)) + OHPXS=FOSCXS*AMAX1(0.0,OHP(K,L,NY,NX)) + ELSE + OQCXS=FOSCXS*AMAX1(0.0,OQC(K,LL,NY,NX)) + OQCHXS=FOSCXS*AMAX1(0.0,OQCH(K,LL,NY,NX)) + OHCXS=FOSCXS*AMAX1(0.0,OHC(K,LL,NY,NX)) + OQAXS=FOSCXS*AMAX1(0.0,OQA(K,LL,NY,NX)) + OQAHXS=FOSCXS*AMAX1(0.0,OQAH(K,LL,NY,NX)) + OHAXS=FOSCXS*AMAX1(0.0,OHA(K,LL,NY,NX)) + OQNXS=FOSCXS*AMAX1(0.0,OQN(K,LL,NY,NX)) + OQNHXS=FOSCXS*AMAX1(0.0,OQNH(K,LL,NY,NX)) + OHNXS=FOSCXS*AMAX1(0.0,OHN(K,LL,NY,NX)) + OQPXS=FOSCXS*AMAX1(0.0,OQP(K,LL,NY,NX)) + OQPHXS=FOSCXS*AMAX1(0.0,OQPH(K,LL,NY,NX)) + OHPXS=FOSCXS*AMAX1(0.0,OHP(K,LL,NY,NX)) + ENDIF + OQC(K,L,NY,NX)=OQC(K,L,NY,NX)-OQCXS + OQCH(K,L,NY,NX)=OQCH(K,L,NY,NX)-OQCHXS + OHC(K,L,NY,NX)=OHC(K,L,NY,NX)-OHCXS + OQA(K,L,NY,NX)=OQA(K,L,NY,NX)-OQAXS + OQAH(K,L,NY,NX)=OQAH(K,L,NY,NX)-OQAHXS + OHA(K,L,NY,NX)=OHA(K,L,NY,NX)-OHAXS + OQN(K,L,NY,NX)=OQN(K,L,NY,NX)-OQNXS + OQNH(K,L,NY,NX)=OQNH(K,L,NY,NX)-OQNHXS + OHN(K,L,NY,NX)=OHN(K,L,NY,NX)-OHNXS + OQP(K,L,NY,NX)=OQP(K,L,NY,NX)-OQPXS + OQPH(K,L,NY,NX)=OQPH(K,L,NY,NX)-OQPHXS + OHP(K,L,NY,NX)=OHP(K,L,NY,NX)-OHPXS + OQC(K,LL,NY,NX)=OQC(K,LL,NY,NX)+OQCXS + OQCH(K,LL,NY,NX)=OQCH(K,LL,NY,NX)+OQCHXS + OHC(K,LL,NY,NX)=OHC(K,LL,NY,NX)+OHCXS + OQA(K,LL,NY,NX)=OQA(K,LL,NY,NX)+OQAXS + OQAH(K,LL,NY,NX)=OQAH(K,LL,NY,NX)+OQAHXS + OHA(K,LL,NY,NX)=OHA(K,LL,NY,NX)+OHAXS + OQN(K,LL,NY,NX)=OQN(K,LL,NY,NX)+OQNXS + OQNH(K,LL,NY,NX)=OQNH(K,LL,NY,NX)+OQNHXS + OHN(K,LL,NY,NX)=OHN(K,LL,NY,NX)+OHNXS + OQP(K,LL,NY,NX)=OQP(K,LL,NY,NX)+OQPXS + OQPH(K,LL,NY,NX)=OQPH(K,LL,NY,NX)+OQPHXS + OHP(K,LL,NY,NX)=OHP(K,LL,NY,NX)+OHPXS + DO 7931 M=1,4 + IF(FOSCXS.GT.0.0)THEN + OSCXS=FOSCXS*AMAX1(0.0,OSC(M,K,L,NY,NX)) + OSAXS=FOSCXS*AMAX1(0.0,OSA(M,K,L,NY,NX)) + OSNXS=FOSCXS*AMAX1(0.0,OSN(M,K,L,NY,NX)) + OSPXS=FOSCXS*AMAX1(0.0,OSP(M,K,L,NY,NX)) + ELSE + OSCXS=FOSCXS*AMAX1(0.0,OSC(M,K,LL,NY,NX)) + OSAXS=FOSCXS*AMAX1(0.0,OSA(M,K,LL,NY,NX)) + OSNXS=FOSCXS*AMAX1(0.0,OSN(M,K,LL,NY,NX)) + OSPXS=FOSCXS*AMAX1(0.0,OSP(M,K,LL,NY,NX)) + ENDIF + OSC(M,K,L,NY,NX)=OSC(M,K,L,NY,NX)-OSCXS + OSA(M,K,L,NY,NX)=OSA(M,K,L,NY,NX)-OSAXS + OSN(M,K,L,NY,NX)=OSN(M,K,L,NY,NX)-OSNXS + OSP(M,K,L,NY,NX)=OSP(M,K,L,NY,NX)-OSPXS + OSC(M,K,LL,NY,NX)=OSC(M,K,LL,NY,NX)+OSCXS + OSA(M,K,LL,NY,NX)=OSA(M,K,LL,NY,NX)+OSAXS + OSN(M,K,LL,NY,NX)=OSN(M,K,LL,NY,NX)+OSNXS + OSP(M,K,LL,NY,NX)=OSP(M,K,LL,NY,NX)+OSPXS +7931 CONTINUE +7901 CONTINUE + ENDIF +C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.EQ.3)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 +2123 FORMAT(A8,5I4,12E15.4) +C ENDIF + ENDIF +998 CONTINUE +C WRITE(20,3434)'RN2O',IYRC,I,J,(RN2O(L,NY,NX),L=0,NL(NY,NX)) +3434 FORMAT(A8,3I4,20E12.4) +9990 CONTINUE +9995 CONTINUE + RETURN + END diff --git a/f77src/outpd.f b/f77src/outpd.f index 1017880..1fe928d 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)=ARLFP(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.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/outph.f b/f77src/outph.f index 06b9e3e..e658683 100755 --- a/f77src/outph.f +++ b/f77src/outph.f @@ -59,7 +59,7 @@ SUBROUTINE outph(I,J,NT,NE,NAX,NDX,NTX,NEX,NHW,NHE,NVN,NVS) IF(K.EQ.55)HEAD(M)=RC(NZ,NY,NX)*1.56*3600.0 IF(K.EQ.56)HEAD(M)=RA(NZ,NY,NX)*1.34*3600.0 IF(K.EQ.57)HEAD(M)=CO2Q(NZ,NY,NX) - IF(K.EQ.58)HEAD(M)=ARLFP(NZ,NY,NX)/AREA(3,NU(NY,NX),NY,NX) + IF(K.EQ.58)HEAD(M)=ARLFS(NZ,NY,NX)/AREA(3,NU(NY,NX),NY,NX) ENDIF 1021 CONTINUE WRITE(LUN,'(A16,F8.3,4X,A8,I8,50E16.7E3)')OUTFILP(N-20,NZ,NY,NX) diff --git a/f77src/readi.f b/f77src/readi.f index e5d62f0..5ae1533 100755 --- a/f77src/readi.f +++ b/f77src/readi.f @@ -1,475 +1,477 @@ - - 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) - 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)' 21 JUL 2018' -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 - ISALT(NY,NX)=ISALTG - 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 - 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 -C -C READ TOPOGRAPHY DATA AND SOIL FILE NAME FOR EACH GRID CELL -C -50 READ(7,*,END=20)NH1,NV1,NH2,NV2,ASPX,SLX,ZSX,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(NY,NX)=SLX - ZS(NY,NX)=AMAX1(0.005,ZSX) - 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 - DO 24 L=NU(NY,NX),NM(NY,NX) - 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 - CORGC(L,NY,NX)=CORGC(L,NY,NX)*1.0E+03 - CORGR(L,NY,NX)=CORGR(L,NY,NX)*1.0E+03 - IF(CORGN(L,NY,NX).LT.0.0)THEN - CORGN(L,NY,NX)=AMIN1(0.111*CORGC(L,NY,NX),CORGC(L,NY,NX)**0.73) - ENDIF - IF(CORGP(L,NY,NX).LT.0.0)THEN - CORGP(L,NY,NX)=0.10*CORGN(L,NY,NX) - ENDIF - IF(CEC(L,NY,NX).LT.0.0)THEN - CEC(L,NY,NX)=10.0*(200.0*2.0*CORGCR/1.0E+06 - 2+80.0*CCLAY(L,NY,NX)/1.0E+06) - ENDIF -24 CONTINUE -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.25*CORGC(L-1,NY,NX) - CORGR(L,NY,NX)=0.25*CORGR(L-1,NY,NX) - CORGN(L,NY,NX)=0.25*CORGN(L-1,NY,NX) - CORGP(L,NY,NX)=0.25*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))) - CORGCR=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-CORGCR/0.5E+06)) - CSILT(L,NY,NX)=CSILT(L,NY,NX) - 2*1.0E-03*AMAX1(0.0,(1.0-CORGCR/0.5E+06)) - CCLAY(L,NY,NX)=CCLAY(L,NY,NX) - 2*1.0E-03*AMAX1(0.0,(1.0-CORGCR/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 -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)' 27 OCT 2018' +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 + ISALT(NY,NX)=ISALTG + 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 +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 + DO 24 L=NU(NY,NX),NM(NY,NX) + 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 + CORGC(L,NY,NX)=CORGC(L,NY,NX)*1.0E+03 + CORGR(L,NY,NX)=CORGR(L,NY,NX)*1.0E+03 + IF(CORGN(L,NY,NX).LT.0.0)THEN + CORGN(L,NY,NX)=AMIN1(0.111*CORGC(L,NY,NX),CORGC(L,NY,NX)**0.73) + ENDIF + IF(CORGP(L,NY,NX).LT.0.0)THEN + CORGP(L,NY,NX)=0.10*CORGN(L,NY,NX) + ENDIF + IF(CEC(L,NY,NX).LT.0.0)THEN + CEC(L,NY,NX)=10.0*(200.0*2.0*CORGCR/1.0E+06 + 2+80.0*CCLAY(L,NY,NX)/1.0E+06) + ENDIF +24 CONTINUE +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.25*CORGC(L-1,NY,NX) + CORGR(L,NY,NX)=0.25*CORGR(L-1,NY,NX) + CORGN(L,NY,NX)=0.25*CORGN(L-1,NY,NX) + CORGP(L,NY,NX)=0.25*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))) + CORGCR=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-CORGCR/0.5E+06)) + CSILT(L,NY,NX)=CSILT(L,NY,NX) + 2*1.0E-03*AMAX1(0.0,(1.0-CORGCR/0.5E+06)) + CCLAY(L,NY,NX)=CCLAY(L,NY,NX) + 2*1.0E-03*AMAX1(0.0,(1.0-CORGCR/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 +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 b467ec5..5518bb9 100755 --- a/f77src/reads.f +++ b/f77src/reads.f @@ -81,16 +81,18 @@ SUBROUTINE reads(NA,ND,NT,NE,NAX,NDX,NTX,NEX,NF,NFX,NTZ 26 CONTINUE READ(4,*)NPX,NPY,JOUT,IOUT,KOUT,ICLM NTZX=NTZ - IF(IGO.NE.0.AND.IDATA(3).EQ.0)THEN + 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) - ELSE - 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) ENDIF IF(NE.EQ.1)THEN N1=IDATA(3) @@ -114,8 +116,9 @@ SUBROUTINE reads(NA,ND,NT,NE,NAX,NDX,NTX,NEX,NF,NFX,NTZ 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,NA(NEX),ND(NEX),NAX + 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 @@ -584,7 +587,6 @@ SUBROUTINE reads(NA,ND,NT,NE,NAX,NDX,NTX,NEX,NF,NFX,NTZ IFIN=MIN(IFIN,IEND) IDAYR=MIN(ISTART-1,ILAST) IYRR=IDATA(3) - IYRC=IDATA(3) NYR=0 IF(IDAYR.EQ.0)THEN IDAYR=LYRX diff --git a/f77src/redist.f b/f77src/redist.f index c9dcca4..5076d30 100755 --- a/f77src/redist.f +++ b/f77src/redist.f @@ -1,5612 +1,5624 @@ - - SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) -C -C THIS SUBROUTINE UPDATES SOIL STATE VARIABLES WITH WATER, HEAT, -C C, N, P, SOLUTE FLUXES CALCULATED IN EARLIER SUBROUTINES -C - include "parameters.h" - include "blkc.h" - include "blk2a.h" - include "blk2b.h" - include "blk2c.h" - include "blk5.h" - include "blk8a.h" - include "blk8b.h" - include "blk11a.h" - include "blk11b.h" - include "blk13a.h" - include "blk13b.h" - include "blk13c.h" - include "blk15a.h" - include "blk15b.h" - include "blk16.h" - include "blk18a.h" - include "blk18b.h" - include "blk19a.h" - include "blk19b.h" - include "blk19c.h" - include "blk19d.h" - include "blk20a.h" - include "blk20b.h" - include "blk20c.h" - include "blk20d.h" - include "blk20e.h" - include "blk20f.h" - include "blk21a.h" - include "blk21b.h" - include "blk22a.h" - include "blk22b.h" - include "blk22c.h" - include "blktest.h" - DIMENSION TFLW(JZ,JY,JX),TFLWX(JZ,JY,JX),THFLW(JZ,JY,JX) - 1,TFLWH(JZ,JY,JX),TOCFLS(0:4,JZ,JY,JX),TONFLS(0:4,JZ,JY,JX) - 2,TOPFLS(0:4,JZ,JY,JX),TOAFLS(0:4,JZ,JY,JX),TCOFLS(JZ,JY,JX) - 3,TCHFLS(JZ,JY,JX),TOXFLS(JZ,JY,JX),TNXFLB(JZ,JY,JX) - 4,TNGFLS(JZ,JY,JX),TN2FLS(JZ,JY,JX),TN4FLS(JZ,JY,JX) - 5,TN4FLB(JZ,JY,JX),TN3FLS(JZ,JY,JX),TN3FLB(JZ,JY,JX) - 6,TNOFLS(JZ,JY,JX),TNOFLB(JZ,JY,JX),TPOFLS(JZ,JY,JX) - 7,TH2BFB(JZ,JY,JX),TNXFLS(JZ,JY,JX),TOCFHS(0:4,JZ,JY,JX) - 8,TONFHS(0:4,JZ,JY,JX),TOPFHS(0:4,JZ,JY,JX),TOAFHS(0:4,JZ,JY,JX) - 9,TCOFHS(JZ,JY,JX),TCHFHS(JZ,JY,JX),TNXFHB(JZ,JY,JX) - 2,TOXFHS(JZ,JY,JX),TNGFHS(JZ,JY,JX),TN2FHS(JZ,JY,JX) - 2,TN4FHS(JZ,JY,JX),TN4FHB(JZ,JY,JX),TN3FHS(JZ,JY,JX) - 3,TN3FHB(JZ,JY,JX),TNOFHS(JZ,JY,JX),TNOFHB(JZ,JY,JX) - 4,TPOFHS(JZ,JY,JX),TH2BHB(JZ,JY,JX),TNXFHS(JZ,JY,JX) - 5,TCOFLG(JZ,JY,JX),TCHFLG(JZ,JY,JX),TOXFLG(JZ,JY,JX) - 6,TNGFLG(JZ,JY,JX),TN2FLG(JZ,JY,JX),TNHFLG(JZ,JY,JX) - 7,TTHAW(JZ,JY,JX),THTHAW(JZ,JY,JX),TTHAWH(JZ,JY,JX) - DIMENSION TQR(JY,JX),THQR(JY,JX),TQS(JY,JX) - 2,TQW(JY,JX),TQI(JY,JX),THQS(JY,JX),TOCQRS(0:4,JY,JX) - 1,TONQRS(0:4,JY,JX),TOPQRS(0:4,JY,JX),TOAQRS(0:4,JY,JX) - 2,TCOQRS(JY,JX),TCHQRS(JY,JX),TOXQRS(JY,JX) - 3,TNGQRS(JY,JX),TN2QRS(JY,JX),TN4QRS(JY,JX),TN3QRS(JY,JX) - 4,TNOQRS(JY,JX),TPOQRS(JY,JX),TNXQRS(JY,JX),TQRAL(JY,JX) - 6,TQRFE(JY,JX),TQRHY(JY,JX),TQRCA(JY,JX),TQRMG(JY,JX) - 7,TQRNA(JY,JX),TQRKA(JY,JX),TQROH(JY,JX),TQRSO(JY,JX) - 8,TQRCL(JY,JX),TQRC3(JY,JX),TQRHC(JY,JX),TQRAL1(JY,JX) - 9,TQRAL2(JY,JX),TQRAL3(JY,JX),TQRAL4(JY,JX),TQRALS(JY,JX) - 1,TQRFE1(JY,JX),TQRFE2(JY,JX),TQRFE3(JY,JX),TQRFE4(JY,JX) - 2,TQRFES(JY,JX),TQRCAO(JY,JX),TQRCAC(JY,JX),TQRCAH(JY,JX) - 3,TQRCAS(JY,JX),TQRMGO(JY,JX),TQRMGC(JY,JX),TQRMGH(JY,JX) - 4,TQRMGS(JY,JX),TQRNAC(JY,JX),TQRNAS(JY,JX),TQRKAS(JY,JX) - 5,TQRH0P(JY,JX),TQRH1P(JY,JX),TQRH3P(JY,JX),TQRF1P(JY,JX) - 6,TQRF2P(JY,JX),TQRC0P(JY,JX),TQRC1P(JY,JX),TQRC2P(JY,JX) - 7,TQRM1P(JY,JX),TCOQSS(JY,JX),TCHQSS(JY,JX),TOXQSS(JY,JX) - 3,TNGQSS(JY,JX),TN2QSS(JY,JX),TN4QSS(JY,JX),TN3QSS(JY,JX) - 4,TNOQSS(JY,JX),TPOQSS(JY,JX),TQSAL(JY,JX) - 6,TQSFE(JY,JX),TQSHY(JY,JX),TQSCA(JY,JX),TQSMG(JY,JX) - 7,TQSNA(JY,JX),TQSKA(JY,JX),TQSOH(JY,JX),TQSSO(JY,JX) - 8,TQSCL(JY,JX),TQSC3(JY,JX),TQSHC(JY,JX),TQSAL1(JY,JX) - 9,TQSAL2(JY,JX),TQSAL3(JY,JX),TQSAL4(JY,JX),TQSALS(JY,JX) - 1,TQSFE1(JY,JX),TQSFE2(JY,JX),TQSFE3(JY,JX),TQSFE4(JY,JX) - 2,TQSFES(JY,JX),TQSCAO(JY,JX),TQSCAC(JY,JX),TQSCAH(JY,JX) - 3,TQSCAS(JY,JX),TQSMGO(JY,JX),TQSMGC(JY,JX),TQSMGH(JY,JX) - 4,TQSMGS(JY,JX),TQSNAC(JY,JX),TQSNAS(JY,JX),TQSKAS(JY,JX) - 5,TQSH0P(JY,JX),TQSH1P(JY,JX),TQSH3P(JY,JX),TQSF1P(JY,JX) - 6,TQSF2P(JY,JX),TQSC0P(JY,JX),TQSC1P(JY,JX),TQSC2P(JY,JX) - 7,TQSM1P(JY,JX) - DIMENSION TALFLS(JZ,JY,JX),TFEFLS(JZ,JY,JX) - 1,TCAFLS(JZ,JY,JX),THYFLS(JZ,JY,JX),TMGFLS(JZ,JY,JX) - 2,TNAFLS(JZ,JY,JX),TKAFLS(JZ,JY,JX),TOHFLS(JZ,JY,JX) - 3,TSOFLS(JZ,JY,JX),TCLFLS(JZ,JY,JX),TC3FLS(JZ,JY,JX) - 4,THCFLS(JZ,JY,JX),TAL1FS(JZ,JY,JX),TAL2FS(JZ,JY,JX) - 5,TAL3FS(JZ,JY,JX),TAL4FS(JZ,JY,JX),TALSFS(JZ,JY,JX) - 6,TFE1FS(JZ,JY,JX),TFE2FS(JZ,JY,JX) - 7,TFE3FS(JZ,JY,JX),TFE4FS(JZ,JY,JX),TFESFS(JZ,JY,JX) - 8,TCAOFS(JZ,JY,JX),TCACFS(JZ,JY,JX),TCAHFS(JZ,JY,JX) - 9,TCASFS(JZ,JY,JX),TMGOFS(JZ,JY,JX),TMGCFS(JZ,JY,JX) - 1,TMGHFS(JZ,JY,JX),TMGSFS(JZ,JY,JX),TNACFS(JZ,JY,JX) - 2,TNASFS(JZ,JY,JX),TKASFS(JZ,JY,JX),TH0PFS(JZ,JY,JX) - 3,TH1PFS(JZ,JY,JX),TH3PFS(JZ,JY,JX),TF1PFS(JZ,JY,JX) - 4,TF2PFS(JZ,JY,JX),TC0PFS(JZ,JY,JX),TC1PFS(JZ,JY,JX) - 5,TC2PFS(JZ,JY,JX),TM1PFS(JZ,JY,JX),TH0BFB(JZ,JY,JX) - 6,TH1BFB(JZ,JY,JX),TH3BFB(JZ,JY,JX),TF1BFB(JZ,JY,JX) - 7,TF2BFB(JZ,JY,JX),TC0BFB(JZ,JY,JX),TC1BFB(JZ,JY,JX) - 8,TC2BFB(JZ,JY,JX),TM1BFB(JZ,JY,JX) - DIMENSION TALFHS(JZ,JY,JX),TFEFHS(JZ,JY,JX) - 1,THYFHS(JZ,JY,JX),TCAFHS(JZ,JY,JX),TMGFHS(JZ,JY,JX) - 2,TNAFHS(JZ,JY,JX),TKAFHS(JZ,JY,JX),TOHFHS(JZ,JY,JX) - 3,TSOFHS(JZ,JY,JX),TCLFHS(JZ,JY,JX),TC3FHS(JZ,JY,JX) - 4,THCFHS(JZ,JY,JX),TAL1HS(JZ,JY,JX),TAL2HS(JZ,JY,JX) - 5,TAL3HS(JZ,JY,JX),TAL4HS(JZ,JY,JX),TALSHS(JZ,JY,JX) - 6,TFE1HS(JZ,JY,JX),TFE2HS(JZ,JY,JX) - 7,TFE3HS(JZ,JY,JX),TFE4HS(JZ,JY,JX),TFESHS(JZ,JY,JX) - 8,TCAOHS(JZ,JY,JX),TCACHS(JZ,JY,JX),TCAHHS(JZ,JY,JX) - 9,TCASHS(JZ,JY,JX),TMGOHS(JZ,JY,JX),TMGCHS(JZ,JY,JX) - 1,TMGHHS(JZ,JY,JX),TMGSHS(JZ,JY,JX),TNACHS(JZ,JY,JX) - 2,TNASHS(JZ,JY,JX),TKASHS(JZ,JY,JX),TH0PHS(JZ,JY,JX) - 3,TH1PHS(JZ,JY,JX),TH3PHS(JZ,JY,JX),TF1PHS(JZ,JY,JX) - 4,TF2PHS(JZ,JY,JX),TC0PHS(JZ,JY,JX),TC1PHS(JZ,JY,JX) - 5,TC2PHS(JZ,JY,JX),TM1PHS(JZ,JY,JX),TH0BHB(JZ,JY,JX) - 6,TH1BHB(JZ,JY,JX),TH3BHB(JZ,JY,JX),TF1BHB(JZ,JY,JX) - 7,TF2BHB(JZ,JY,JX),TC0BHB(JZ,JY,JX),TC1BHB(JZ,JY,JX) - 8,TC2BHB(JZ,JY,JX),TM1BHB(JZ,JY,JX) - DIMENSION TSANER(JY,JX),TSILER(JY,JX),TCLAER(JY,JX) - 2,TCECER(JY,JX),TAECER(JY,JX),TNH4ER(JY,JX),TNH3ER(JY,JX) - 3,TNHUER(JY,JX),TNO3ER(JY,JX),TNH4EB(JY,JX),TNH3EB(JY,JX) - 4,TNHUEB(JY,JX),TNO3EB(JY,JX),TN4ER(JY,JX),TNBER(JY,JX) - 5,THYER(JY,JX),TALER(JY,JX),TCAER(JY,JX),TMGER(JY,JX) - 6,TNAER(JY,JX),TKAER(JY,JX),THCER(JY,JX),TAL2ER(JY,JX) - 7,TOH0ER(JY,JX),TOH1ER(JY,JX),TOH2ER(JY,JX),TH1PER(JY,JX) - 8,TH2PER(JY,JX),TOH0EB(JY,JX),TOH1EB(JY,JX),TOH2EB(JY,JX) - 9,TH1PEB(JY,JX),TH2PEB(JY,JX),TALOER(JY,JX),TFEOER(JY,JX) - 1,TCACER(JY,JX),TCASER(JY,JX),TALPER(JY,JX),TFEPER(JY,JX) - 2,TCPDER(JY,JX),TCPHER(JY,JX),TCPMER(JY,JX),TALPEB(JY,JX) - 3,TFEPEB(JY,JX),TCPDEB(JY,JX),TCPHEB(JY,JX),TCPMEB(JY,JX) - 4,TOMCER(3,7,0:5,JY,JX),TOMNER(3,7,0:5,JY,JX),TOMPER(3,7,0:5,JY,JX) - 5,TORCER(2,0:4,JY,JX),TORNER(2,0:4,JY,JX),TORPER(2,0:4,JY,JX) - 6,TOHCER(0:4,JY,JX),TOHNER(0:4,JY,JX),TOHPER(0:4,JY,JX) - 7,TOHAER(0:4,JY,JX),TOSCER(4,0:4,JY,JX),TOSAER(4,0:4,JY,JX) - 8,TOSNER(4,0:4,JY,JX),TOSPER(4,0:4,JY,JX),TSEDER(JY,JX) - DIMENSION TOMC(3,7,0:5),TOMN(3,7,0:5),TOMP(3,7,0:5),TORC(2,0:4) - 2,TORN(2,0:4),TORP(2,0:4),TOQC(0:4),TOQN(0:4),TOQP(0:4),TOQA(0:4) - 3,TOHC(0:4),TOHN(0:4),TOHP(0:4),TOHA(0:4),TOSC(4,0:4),TOSA(4,0:4) - 4,TOSN(4,0:4),TOSP(4,0:4),TOSGC(4,0:2),TOSGA(4,0:2),TOSGN(4,0:2) - 5,TOSGP(4,0:2),TOMGC(3,7,0:5),TOMGN(3,7,0:5),TOMGP(3,7,0:5) - 6,TORXC(2,0:2),TORXN(2,0:2),TORXP(2,0:2),TOQGC(0:2),TOQGN(0:2) - 7,TOQGP(0:2),TOQHC(0:2),TOQHN(0:2),TOQHP(0:2),TOHGC(0:2) - 8,TOHGN(0:2),TOHGP(0:2), TOHGA(0:2),TOQGA(0:2),TOQHA(0:2) - 9,THGQRS(JY,JX),THGFHS(JZ,JY,JX),THGFLG(JZ,JY,JX),THGFLS(JZ,JY,JX) - 1,OMCL(0:JZ,JY,JX),OMNL(0:JZ,JY,JX),EFIRE(2,21:22) - 2,ONL(4,0:4),OPL(4,0:4) - PARAMETER (DNUMN=0.001,DNUMX=0.025) - DATA SG/0.0/ - DATA EFIRE/1.0,1.0,0.917,0.167/ - TFLWT=0.0 - VOLPT=0.0 - VOLTT=0.0 - DO 9995 NX=NHW,NHE - DO 9990 NY=NVN,NVS - TNPP(NY,NX)=TGPP(NY,NX)+TRAU(NY,NX) -C -C ADD WATER, HEAT FLUXES FROM 'WATSUB' AND GAS, SOLUTE FLUXES -C FROM 'TRNSFR' AND 'TRNSFRS' TO SNOWPACK -C - IF(PRECW(NY,NX).GT.0.0.OR.FLQGM(NY,NX).GT.0.0.OR. - 2(PRECR(NY,NX).GT.0.0.AND.VHCPW(NY,NX).GT.VHCPWX(NY,NX)))THEN - CO2W(NY,NX)=CO2W(NY,NX)+XCOBLS(NY,NX) - CH4W(NY,NX)=CH4W(NY,NX)+XCHBLS(NY,NX) - OXYW(NY,NX)=OXYW(NY,NX)+XOXBLS(NY,NX) - ZNGW(NY,NX)=ZNGW(NY,NX)+XNGBLS(NY,NX) - ZN2W(NY,NX)=ZN2W(NY,NX)+XN2BLS(NY,NX) - H2GW(NY,NX)=H2GW(NY,NX)+XHGBLS(NY,NX) - ZN4W(NY,NX)=ZN4W(NY,NX)+XN4BLW(NY,NX) - ZN3W(NY,NX)=ZN3W(NY,NX)+XN3BLW(NY,NX) - ZNOW(NY,NX)=ZNOW(NY,NX)+XNOBLW(NY,NX) - ZHPW(NY,NX)=ZHPW(NY,NX)+XH2PBS(NY,NX) - IF(ISALT(NY,NX).NE.0)THEN - ZALW(NY,NX)=ZALW(NY,NX)+XALBLS(NY,NX) - ZFEW(NY,NX)=ZFEW(NY,NX)+XFEBLS(NY,NX) - ZHYW(NY,NX)=ZHYW(NY,NX)+XHYBLS(NY,NX) - ZCAW(NY,NX)=ZCAW(NY,NX)+XCABLS(NY,NX) - ZMGW(NY,NX)=ZMGW(NY,NX)+XMGBLS(NY,NX) - ZNAW(NY,NX)=ZNAW(NY,NX)+XNABLS(NY,NX) - ZKAW(NY,NX)=ZKAW(NY,NX)+XKABLS(NY,NX) - ZOHW(NY,NX)=ZOHW(NY,NX)+XOHBLS(NY,NX) - ZSO4W(NY,NX)=ZSO4W(NY,NX)+XSOBLS(NY,NX) - ZCLW(NY,NX)=ZCLW(NY,NX)+XCLBLS(NY,NX) - ZCO3W(NY,NX)=ZCO3W(NY,NX)+XC3BLS(NY,NX) - ZHCO3W(NY,NX)=ZHCO3W(NY,NX)+XHCBLS(NY,NX) - ZALH1W(NY,NX)=ZALH1W(NY,NX)+XAL1BS(NY,NX) - ZALH2W(NY,NX)=ZALH2W(NY,NX)+XAL2BS(NY,NX) - ZALH3W(NY,NX)=ZALH3W(NY,NX)+XAL3BS(NY,NX) - ZALH4W(NY,NX)=ZALH4W(NY,NX)+XAL4BS(NY,NX) - ZALSW(NY,NX)=ZALSW(NY,NX)+XALSBS(NY,NX) - ZFEH1W(NY,NX)=ZFEH1W(NY,NX)+XFE1BS(NY,NX) - ZFEH2W(NY,NX)=ZFEH2W(NY,NX)+XFE2BS(NY,NX) - ZFEH3W(NY,NX)=ZFEH3W(NY,NX)+XFE3BS(NY,NX) - ZFEH4W(NY,NX)=ZFEH4W(NY,NX)+XFE4BS(NY,NX) - ZFESW(NY,NX)=ZFESW(NY,NX)+XFESBS(NY,NX) - ZCAOW(NY,NX)=ZCAOW(NY,NX)+XCAOBS(NY,NX) - ZCACW(NY,NX)=ZCACW(NY,NX)+XCACBS(NY,NX) - ZCAHW(NY,NX)=ZCAHW(NY,NX)+XCAHBS(NY,NX) - ZCASW(NY,NX)=ZCASW(NY,NX)+XCASBS(NY,NX) - ZMGOW(NY,NX)=ZMGOW(NY,NX)+XMGOBS(NY,NX) - ZMGCW(NY,NX)=ZMGCW(NY,NX)+XMGCBS(NY,NX) - ZMGHW(NY,NX)=ZMGHW(NY,NX)+XMGHBS(NY,NX) - ZMGSW(NY,NX)=ZMGSW(NY,NX)+XMGSBS(NY,NX) - ZNACW(NY,NX)=ZNACW(NY,NX)+XNACBS(NY,NX) - ZNASW(NY,NX)=ZNASW(NY,NX)+XNASBS(NY,NX) - ZKASW(NY,NX)=ZKASW(NY,NX)+XKASBS(NY,NX) - H0PO4W(NY,NX)=H0PO4W(NY,NX)+XH0PBS(NY,NX) - H1PO4W(NY,NX)=H1PO4W(NY,NX)+XH1PBS(NY,NX) - H3PO4W(NY,NX)=H3PO4W(NY,NX)+XH3PBS(NY,NX) - ZFE1PW(NY,NX)=ZFE1PW(NY,NX)+XF1PBS(NY,NX) - ZFE2PW(NY,NX)=ZFE2PW(NY,NX)+XF2PBS(NY,NX) - ZCA0PW(NY,NX)=ZCA0PW(NY,NX)+XC0PBS(NY,NX) - ZCA1PW(NY,NX)=ZCA1PW(NY,NX)+XC1PBS(NY,NX) - ZCA2PW(NY,NX)=ZCA2PW(NY,NX)+XC2PBS(NY,NX) - ZMG1PW(NY,NX)=ZMG1PW(NY,NX)+XM1PBS(NY,NX) - ENDIF - ENDIF -C -C CALCULATE SNOWPACK TEMPERATURE FROM ITS CHANGE -C IN HEAT STORAGE -C - VHCPW(NY,NX)=2.095*VOLSS(NY,NX)+4.19*VOLWS(NY,NX) - 2+1.9274*VOLIS(NY,NX) -C VHCPX=VHCPW(NY,NX) - VOLSS(NY,NX)=VOLSS(NY,NX)+TFLWS(NY,NX)+TQS(NY,NX) - VOLWS(NY,NX)=VOLWS(NY,NX)+TFLWW(NY,NX)+TQW(NY,NX) - VOLIS(NY,NX)=VOLIS(NY,NX)+TFLWI(NY,NX)+TQI(NY,NX) - DENSS=AMIN1(0.6,DENS0(NY,NX)+DENS1(NY,NX)*VOLSS(NY,NX) - 2/AREA(3,NU(NY,NX),NY,NX)) - VOLS(NY,NX)=VOLSS(NY,NX)/DENSS+VOLWS(NY,NX)+VOLIS(NY,NX) - ENGYW=VHCPW(NY,NX)*TKW(NY,NX) - VHCPW(NY,NX)=2.095*VOLSS(NY,NX)+4.19*VOLWS(NY,NX) - 2+1.9274*VOLIS(NY,NX) - DPTHS(NY,NX)=AMAX1(0.0,VOLS(NY,NX))/AREA(3,NU(NY,NX),NY,NX) - IF(VHCPW(NY,NX).GT.VHCPWX(NY,NX))THEN - TKW(NY,NX)=(ENGYW+THFLWW(NY,NX)+THQS(NY,NX))/VHCPW(NY,NX) - ELSEIF(VHCPW(NY,NX).GT.ZEROS(NY,NX))THEN - TKWX=(ENGYW+THFLWW(NY,NX)+THQS(NY,NX))/VHCPW(NY,NX) - HFLXW=VHCPW(NY,NX)*(TKWX-TKA(NY,NX)) - HEATOU=HEATOU+HFLXW - TKW(NY,NX)=TKA(NY,NX) - ELSE - TKW(NY,NX)=TKA(NY,NX) - ENDIF - TCW(NY,NX)=TKW(NY,NX)-273.15 -C IF(NX.EQ.2.AND.NY.EQ.2)THEN -C WRITE(*,8483)'TKWH',I,J,NX,NY,TKW(NY,NX),ENGYW,THFLWW(NY,NX) -C 2,THQS(NY,NX),VHCPW(NY,NX),VHCPX,VOLSS(NY,NX),VOLWS(NY,NX) -C 2,VOLIS(NY,NX),TFLWS(NY,NX),TQS(NY,NX),TFLWW(NY,NX),TQW(NY,NX) -C 3,TFLWI(NY,NX),TQI(NY,NX),VOLS(NY,NX) -8483 FORMAT(A8,4I4,20E12.4) -C ENDIF -C -C SNOWPACK VARIABLES NEEDED FOR WATER, C, N, P, O, SOLUTE AND -C ENERGY BALANCES INCLUDING SUM OF ALL CURRENT STATE VARIABLES, -C CUMULATIVE SUMS OF ALL ADDITIONS AND REMOVALS SINCE START OF RUN -C -C IF(J.EQ.24)THEN - WS=VOLSS(NY,NX)+VOLWS(NY,NX)+VOLIS(NY,NX)*0.92 - VOLWSO=VOLWSO+WS - UVOLW(NY,NX)=UVOLW(NY,NX)+WS - HEATSO=HEATSO+VHCPW(NY,NX)*TKW(NY,NX) - TLCO2G=TLCO2G+CO2W(NY,NX)+CH4W(NY,NX) - UCO2S(NY,NX)=UCO2S(NY,NX)+CO2W(NY,NX)+CH4W(NY,NX) - OXYGSO=OXYGSO+OXYW(NY,NX) - TLN2G=TLN2G+ZNGW(NY,NX)+ZN2W(NY,NX) - TLNH4=TLNH4+ZN4W(NY,NX)+ZN3W(NY,NX) - TLNO3=TLNO3+ZNOW(NY,NX) - TLPO4=TLPO4+ZHPW(NY,NX) - TW=ZALW(NY,NX)+ZFEW(NY,NX)+ZHYW(NY,NX)+ZCAW(NY,NX) - 2+ZMGW(NY,NX)+ZNAW(NY,NX)+ZKAW(NY,NX)+ZOHW(NY,NX) - 3+ZSO4W(NY,NX)+ZCLW(NY,NX)+ZCO3W(NY,NX)+H0PO4W(NY,NX) - 4+2.0*(ZHCO3W(NY,NX)+ZALH1W(NY,NX) - 5+ZALSW(NY,NX)+ZFEH1W(NY,NX)+ZFESW(NY,NX)+ZCAOW(NY,NX) - 6+ZCACW(NY,NX)+ZCASW(NY,NX)+ZMGOW(NY,NX)+ZMGCW(NY,NX) - 7+ZMGSW(NY,NX)+ZNACW(NY,NX)+ZNASW(NY,NX)+ZKASW(NY,NX) - 8+H1PO4W(NY,NX)+ZCA0PW(NY,NX)) - 9+3.0*(ZALH2W(NY,NX)+ZFEH2W(NY,NX)+ZCAHW(NY,NX) - 1+ZMGHW(NY,NX)+ZFE1PW(NY,NX)+ZCA1PW(NY,NX)+ZMG1PW(NY,NX)) - 2+4.0*(ZALH3W(NY,NX)+ZFEH3W(NY,NX)+H3PO4W(NY,NX)+ZFE2PW(NY,NX) - 4+ZCA2PW(NY,NX))+5.0*(ZALH4W(NY,NX)+ZFEH4W(NY,NX))+H2GW(NY,NX) - TION=TION+TW -C ENDIF -C -C ADD ABOVE-GROUND LITTERFALL FROM 'EXTRACT' TO SURFACE RESIDUE -C - OSGX=ORGC(0,NY,NX) -C -C ADD PLANT C,N,P IN ABOVE-GROUND LITTERFALL TO C,N,P -C IN SURFACE RESIDUE -C - OQC(1,0,NY,NX)=OQC(1,0,NY,NX)+TDFOMC(0,NY,NX) - OQN(1,0,NY,NX)=OQN(1,0,NY,NX)+TDFOMN(0,NY,NX) - OQP(1,0,NY,NX)=OQP(1,0,NY,NX)+TDFOMP(0,NY,NX) - DO 6965 K=0,1 - DO 6965 M=1,4 - OSC(M,K,0,NY,NX)=OSC(M,K,0,NY,NX)+CSNT(M,K,0,NY,NX) - OSN(M,K,0,NY,NX)=OSN(M,K,0,NY,NX)+ZSNT(M,K,0,NY,NX) - OSP(M,K,0,NY,NX)=OSP(M,K,0,NY,NX)+PSNT(M,K,0,NY,NX) -C IF((I/30)*30.EQ.I.AND.J.EQ.15)THEN -C WRITE(*,8486)'OSC0',I,J,L,K,M,OSC(M,K,0,NY,NX) -C 2,OSN(M,K,0,NY,NX),OSP(M,K,0,NY,NX),CSNT(M,K,0,NY,NX) -C 3,ZSNT(M,K,0,NY,NX),PSNT(M,K,0,NY,NX) -8486 FORMAT(A8,5I4,12E12.4) -C ENDIF -6965 CONTINUE -C -C GAS AND SOLUTE EXCHANGE WITHIN SURFACE RESIDUE ADDED TO ECOSYSTEM -C TOTALS FOR CALCULATING COMPETITION CONSTRAINTS ON MICROBIAL -C AND ROOT POPULATIONS -C - DO 8990 K=0,5 - IF(K.NE.3.AND.K.NE.4)THEN - DO 8980 N=1,7 - ROXYX(0,NY,NX)=ROXYX(0,NY,NX)+ROXYS(N,K,0,NY,NX) - RNH4X(0,NY,NX)=RNH4X(0,NY,NX)+RVMX4(N,K,0,NY,NX) - RNO3X(0,NY,NX)=RNO3X(0,NY,NX)+RVMX3(N,K,0,NY,NX) - RNO2X(0,NY,NX)=RNO2X(0,NY,NX)+RVMX2(N,K,0,NY,NX) - RN2OX(0,NY,NX)=RN2OX(0,NY,NX)+RVMX1(N,K,0,NY,NX) - RNH4X(0,NY,NX)=RNH4X(0,NY,NX)+RINHO(N,K,0,NY,NX) - RNO3X(0,NY,NX)=RNO3X(0,NY,NX)+RINOO(N,K,0,NY,NX) - RPO4X(0,NY,NX)=RPO4X(0,NY,NX)+RIPOO(N,K,0,NY,NX) - RNH4X(NU(NY,NX),NY,NX)=RNH4X(NU(NY,NX),NY,NX)+RINHOR(N,K,NY,NX) - RNO3X(NU(NY,NX),NY,NX)=RNO3X(NU(NY,NX),NY,NX)+RINOOR(N,K,NY,NX) - RPO4X(NU(NY,NX),NY,NX)=RPO4X(NU(NY,NX),NY,NX)+RIPOOR(N,K,NY,NX) - IF(K.LE.4)THEN - ROQCX(K,0,NY,NX)=ROQCX(K,0,NY,NX)+ROQCS(N,K,0,NY,NX) - ROQAX(K,0,NY,NX)=ROQAX(K,0,NY,NX)+ROQAS(N,K,0,NY,NX) - ENDIF -8980 CONTINUE - ENDIF -8990 CONTINUE - RNO2X(0,NY,NX)=RNO2X(0,NY,NX)+RVMXC(0,NY,NX) -C -C ADD RESIDUE C,N,P TO SUBSURFACE SEDIMENT BELOW A POND SURFACE -C - IF(BKDS(NU(NY,NX),NY,NX).EQ.0.0.AND.ORGC(0,NY,NX).GT.0.0)THEN - OSGX=ORGC(0,NY,NX) - RC=0.0 - RN=0.0 - RP=0.0 - DO 1970 K=0,5 - IF(K.NE.3.AND.K.NE.4)THEN -C -C MICROBIAL C,N,P -C - DO 1960 N=1,7 - DO 1960 M=1,3 - OMC(M,N,K,NW(NY,NX),NY,NX)=OMC(M,N,K,NW(NY,NX),NY,NX) - 2+OMC(M,N,K,0,NY,NX) - OMN(M,N,K,NW(NY,NX),NY,NX)=OMN(M,N,K,NW(NY,NX),NY,NX) - 2+OMN(M,N,K,0,NY,NX) - OMP(M,N,K,NW(NY,NX),NY,NX)=OMP(M,N,K,NW(NY,NX),NY,NX) - 2+OMP(M,N,K,0,NY,NX) - RC=RC+OMC(M,N,K,0,NY,NX) - RN=RN+OMN(M,N,K,0,NY,NX) - RP=RP+OMP(M,N,K,0,NY,NX) - OMC(M,N,K,0,NY,NX)=0.0 - OMN(M,N,K,0,NY,NX)=0.0 - OMP(M,N,K,0,NY,NX)=0.0 -1960 CONTINUE - ENDIF -1970 CONTINUE -C -C MICROBIAL RESIDUE C,N,P -C - DO 1900 K=0,2 - DO 1940 M=1,2 - ORC(M,K,NW(NY,NX),NY,NX)=ORC(M,K,NW(NY,NX),NY,NX)+ORC(M,K,0,NY,NX) - ORN(M,K,NW(NY,NX),NY,NX)=ORN(M,K,NW(NY,NX),NY,NX)+ORN(M,K,0,NY,NX) - ORP(M,K,NW(NY,NX),NY,NX)=ORP(M,K,NW(NY,NX),NY,NX)+ORP(M,K,0,NY,NX) - RC=RC+ORC(M,K,0,NY,NX) - RN=RN+ORN(M,K,0,NY,NX) - RP=RP+ORP(M,K,0,NY,NX) - ORC(M,K,0,NY,NX)=0.0 - ORN(M,K,0,NY,NX)=0.0 - ORP(M,K,0,NY,NX)=0.0 -1940 CONTINUE -C -C DOC, DON, DOP -C - OQC(K,NW(NY,NX),NY,NX)=OQC(K,NW(NY,NX),NY,NX)+OQC(K,0,NY,NX) - OQN(K,NW(NY,NX),NY,NX)=OQN(K,NW(NY,NX),NY,NX)+OQN(K,0,NY,NX) - OQP(K,NW(NY,NX),NY,NX)=OQP(K,NW(NY,NX),NY,NX)+OQP(K,0,NY,NX) - OQA(K,NW(NY,NX),NY,NX)=OQA(K,NW(NY,NX),NY,NX)+OQA(K,0,NY,NX) - RC=RC+OQC(K,0,NY,NX)+OQA(K,0,NY,NX) - RN=RN+OQN(K,0,NY,NX) - RP=RP+OQP(K,0,NY,NX) - OQC(K,0,NY,NX)=0.0 - OQN(K,0,NY,NX)=0.0 - OQP(K,0,NY,NX)=0.0 - OQA(K,0,NY,NX)=0.0 - OQCH(K,NW(NY,NX),NY,NX)=OQCH(K,NW(NY,NX),NY,NX)+OQCH(K,0,NY,NX) - OQNH(K,NW(NY,NX),NY,NX)=OQNH(K,NW(NY,NX),NY,NX)+OQNH(K,0,NY,NX) - OQPH(K,NW(NY,NX),NY,NX)=OQPH(K,NW(NY,NX),NY,NX)+OQPH(K,0,NY,NX) - OQAH(K,NW(NY,NX),NY,NX)=OQAH(K,NW(NY,NX),NY,NX)+OQAH(K,0,NY,NX) - RC=RC+OQCH(K,0,NY,NX)+OQAH(K,0,NY,NX) - RN=RN+OQNH(K,0,NY,NX) - RP=RP+OQPH(K,0,NY,NX) - OQCH(K,0,NY,NX)=0.0 - OQNH(K,0,NY,NX)=0.0 - OQPH(K,0,NY,NX)=0.0 - OQAH(K,0,NY,NX)=0.0 -C -C ADSORBED C,N,P -C - OHC(K,NW(NY,NX),NY,NX)=OHC(K,NW(NY,NX),NY,NX)+OHC(K,0,NY,NX) - OHN(K,NW(NY,NX),NY,NX)=OHN(K,NW(NY,NX),NY,NX)+OHN(K,0,NY,NX) - OHP(K,NW(NY,NX),NY,NX)=OHP(K,NW(NY,NX),NY,NX)+OHP(K,0,NY,NX) - OHA(K,NW(NY,NX),NY,NX)=OHA(K,NW(NY,NX),NY,NX)+OHA(K,0,NY,NX) - RC=RC+OHC(K,0,NY,NX)+OHA(K,0,NY,NX) - RN=RN+OHN(K,0,NY,NX) - RP=RP+OHP(K,0,NY,NX) - OHC(K,0,NY,NX)=0.0 - OHN(K,0,NY,NX)=0.0 - OHP(K,0,NY,NX)=0.0 - OHA(K,0,NY,NX)=0.0 -C -C PLANT RESIDUE C,N,P -C - DO 1930 M=1,4 - OSC(M,K,NW(NY,NX),NY,NX)=OSC(M,K,NW(NY,NX),NY,NX)+OSC(M,K,0,NY,NX) - OSA(M,K,NW(NY,NX),NY,NX)=OSA(M,K,NW(NY,NX),NY,NX)+OSA(M,K,0,NY,NX) - OSN(M,K,NW(NY,NX),NY,NX)=OSN(M,K,NW(NY,NX),NY,NX)+OSN(M,K,0,NY,NX) - OSP(M,K,NW(NY,NX),NY,NX)=OSP(M,K,NW(NY,NX),NY,NX)+OSP(M,K,0,NY,NX) - RC=RC+OSC(M,K,0,NY,NX) - RN=RN+OSN(M,K,0,NY,NX) - RP=RP+OSP(M,K,0,NY,NX) - OSC(M,K,0,NY,NX)=0.0 - OSA(M,K,0,NY,NX)=0.0 - OSN(M,K,0,NY,NX)=0.0 - OSP(M,K,0,NY,NX)=0.0 -1930 CONTINUE -1900 CONTINUE - TLRSDC=TLRSDC-RC - TLRSDN=TLRSDN-RN - TLRSDP=TLRSDP-RP - URSDC(NY,NX)=URSDC(NY,NX)-RC - URSDN(NY,NX)=URSDN(NY,NX)-RN - URSDP(NY,NX)=URSDP(NY,NX)-RP - ORGC(0,NY,NX)=0.0 - ORGN(0,NY,NX)=0.0 - ORGR(0,NY,NX)=0.0 -C -C ADD RESIDUE SOLUTES TO SUBSURFACE SEDIMENT BELOW A POND SURFACE -C -C CO2S(NW(NY,NX),NY,NX)=CO2S(NW(NY,NX),NY,NX)+CO2S(0,NY,NX) -C CH4S(NW(NY,NX),NY,NX)=CH4S(NW(NY,NX),NY,NX)+CH4S(0,NY,NX) -C OXYS(NW(NY,NX),NY,NX)=OXYS(NW(NY,NX),NY,NX)+OXYS(0,NY,NX) -C Z2GS(NW(NY,NX),NY,NX)=Z2GS(NW(NY,NX),NY,NX)+Z2GS(0,NY,NX) -C Z2OS(NW(NY,NX),NY,NX)=Z2OS(NW(NY,NX),NY,NX)+Z2OS(0,NY,NX) -C H2GS(NW(NY,NX),NY,NX)=H2GS(NW(NY,NX),NY,NX)+H2GS(0,NY,NX) -C ZNH4S(NW(NY,NX),NY,NX)=ZNH4S(NW(NY,NX),NY,NX)+ZNH4S(0,NY,NX) -C ZNH3S(NW(NY,NX),NY,NX)=ZNH3S(NW(NY,NX),NY,NX)+ZNH3S(0,NY,NX) -C ZNO3S(NW(NY,NX),NY,NX)=ZNO3S(NW(NY,NX),NY,NX)+ZNO3S(0,NY,NX) -C H2PO4(NW(NY,NX),NY,NX)=H2PO4(NW(NY,NX),NY,NX)+H2PO4(0,NY,NX) -C ZNO2S(NW(NY,NX),NY,NX)=ZNO2S(NW(NY,NX),NY,NX)+ZNO2S(0,NY,NX) -C CS=CO2S(0,NY,NX)+CH4S(0,NY,NX) -C TLCO2G=TLCO2G-CS -C UCO2S(NY,NX)=UCO2S(NY,NX)-CS -C OS=OXYS(0,NY,NX) -C OXYGSO=OXYGSO-OS -C ZG=Z2GS(0,NY,NX)+Z2OS(0,NY,NX) -C TLN2G=TLN2G-ZG -C ZNH=ZNH4S(0,NY,NX)+ZNH3S(0,NY,NX) -C TLNH4=TLNH4-ZNH -C UNH4(NY,NX)=UNH4(NY,NX)-ZNH -C ZNO=ZNO3S(0,NY,NX)+ZNO2S(0,NY,NX) -C TLNO3=TLNO3-ZNO -C UNO3(NY,NX)=UNO3(NY,NX)-ZNO -C P4=H2PO4(0,NY,NX) -C TLPO4=TLPO4-P4 -C UPO4(NY,NX)=UPO4(NY,NX)-P4 -C CO2S(0,NY,NX)=0.0 -C CH4S(0,NY,NX)=0.0 -C OXYS(0,NY,NX)=0.0 -C Z2GS(0,NY,NX)=0.0 -C Z2OS(0,NY,NX)=0.0 -C H2GS(0,NY,NX)=0.0 -C ZNH4S(0,NY,NX)=0.0 -C ZNH3S(0,NY,NX)=0.0 -C ZNO3S(0,NY,NX)=0.0 -C H2PO4(0,NY,NX)=0.0 -C ZNO2S(0,NY,NX)=0.0 - ENDIF -C -C RUNOFF AND SUBSURFACE BOUNDARY FLUXES -C - DO 9985 L=NU(NY,NX),NL(NY,NX) -C -C LOCATE EXTERNAL BOUNDARIES -C - DO 9980 N=1,3 - DO 9975 NN=1,2 - IF(N.EQ.1)THEN - IF(NN.EQ.1)THEN - IF(NX.EQ.NHE)THEN - N4=NX+1 - N5=NY - N6=L - XN=-1.0 - ELSE - GO TO 9975 - ENDIF - ELSEIF(NN.EQ.2)THEN - IF(NX.EQ.NHW)THEN - N4=NX - N5=NY - N6=L - XN=1.0 - ELSE - GO TO 9975 - ENDIF - ENDIF - ELSEIF(N.EQ.2)THEN - IF(NN.EQ.1)THEN - IF(NY.EQ.NVS)THEN - N4=NX - N5=NY+1 - N6=L - XN=-1.0 - ELSE - GO TO 9975 - ENDIF - ELSEIF(NN.EQ.2)THEN - IF(NY.EQ.NVN)THEN - N4=NX - N5=NY - N6=L - XN=1.0 - ELSE - GO TO 9975 - ENDIF - ENDIF - ELSEIF(N.EQ.3)THEN - IF(NN.EQ.1)THEN - IF(L.EQ.NL(NY,NX))THEN - N4=NX - N5=NY - N6=L+1 - XN=-1.0 - ELSE - GO TO 9975 - ENDIF - ELSEIF(NN.EQ.2)THEN - GO TO 9975 - ENDIF - ENDIF -C -C RUNOFF BOUNDARY FLUXES OF WATER AND HEAT -C - IF(L.EQ.NU(NY,NX).AND.N.NE.3)THEN - WQ=XN*(QR(N,N5,N4)+QS(N,N5,N4)+QW(N,N5,N4)+QI(N,N5,N4)) - IF(WQ.NE.0.0)THEN - CRUN=CRUN-WQ - URUN(NY,NX)=URUN(NY,NX)-WQ - HEATOU=HEATOU-XN*(HQR(N,N5,N4)+HQS(N,N5,N4)) -C -C RUNOFF BOUNDARY FLUXES OF c, n AND p -C - CX=XN*(XCOQRS(N,N5,N4)+XCHQRS(N,N5,N4) - 2+XCOQSS(N,N5,N4)+XCHQSS(N,N5,N4)) - CQ=0.0 - DO 2575 K=0,4 - CQ=CQ+XN*(XOCQRS(K,N,N5,N4)+XOAQRS(K,N,N5,N4)) -2575 CONTINUE - TCOU=TCOU-CQ-CX - TNBP(NY,NX)=TNBP(NY,NX)+CQ+CX - UDOCQ(NY,NX)=UDOCQ(NY,NX)-CQ - UDICQ(NY,NX)=UDICQ(NY,NX)-CX - OX=XN*(XOXQRS(N,N5,N4)+XOXQSS(N,N5,N4)) - OXYGOU=OXYGOU-OX - ZX=XN*(XN4QRW(N,N5,N4)+XN3QRW(N,N5,N4) - 2+XNOQRW(N,N5,N4)+XNXQRS(N,N5,N4)+XN4QSS(N,N5,N4) - 3+XN3QSS(N,N5,N4)+XNOQSS(N,N5,N4)) - ZG=XN*(XN2QRS(N,N5,N4)+XNGQRS(N,N5,N4) - 2+XN2QSS(N,N5,N4)+XNGQSS(N,N5,N4)) - ZQ=0.0 - DO 2875 K=0,4 - ZQ=ZQ+XN*XONQRS(K,N,N5,N4) -2875 CONTINUE - TZOU=TZOU-ZQ-ZX-ZG - UDONQ(NY,NX)=UDONQ(NY,NX)-ZQ - UDINQ(NY,NX)=UDINQ(NY,NX)-ZX - PX=XN*(XP4QRW(N,N5,N4)+XP4QSS(N,N5,N4)) - PQ=0.0 - DO 2775 K=0,4 - PQ=PQ+XN*XOPQRS(K,N,N5,N4) -2775 CONTINUE - TPOU=TPOU-PQ-PX - UDOPQ(NY,NX)=UDOPQ(NY,NX)-PQ - UDIPQ(NY,NX)=UDIPQ(NY,NX)-PX -C -C RUNOFF BOUNDARY FLUXES OF SOLUTES -C - SQ1=XN*(XQRAL(N,N5,N4)+XQRFE(N,N5,N4)+XQRHY(N,N5,N4) - 2+XQRCA(N,N5,N4)+XQRMG(N,N5,N4)+XQRNA(N,N5,N4)+XQRKA(N,N5,N4) - 3+XQROH(N,N5,N4)+XQRSO(N,N5,N4)+XQRCL(N,N5,N4)+XQRC3(N,N5,N4) - 4+XQRH0P(N,N5,N4)+XHGQRS(N,N5,N4)+XQSAL(N,N5,N4)+XQSFE(N,N5,N4) - 5+XQSHY(N,N5,N4)+XQSCA(N,N5,N4)+XQSMG(N,N5,N4)+XQSNA(N,N5,N4) - 6+XQSKA(N,N5,N4)+XQSOH(N,N5,N4)+XQSSO(N,N5,N4)+XQSCL(N,N5,N4) - 3+XQSC3(N,N5,N4)+XQSH0P(N,N5,N4)) - SQ2=XN*2.0*(XQRHC(N,N5,N4)+XQRAL1(N,N5,N4)+XQRALS(N,N5,N4) - 2+XQRFE1(N,N5,N4)+XQRFES(N,N5,N4)+XQRCAO(N,N5,N4)+XQRCAC(N,N5,N4) - 3+XQRCAS(N,N5,N4)+XQRMGO(N,N5,N4)+XQRMGC(N,N5,N4)+XQRMGS(N,N5,N4) - 4+XQRNAC(N,N5,N4)+XQRNAS(N,N5,N4)+XQRKAS(N,N5,N4)+XQRH1P(N,N5,N4) - 5+XQRC0P(N,N5,N4)+XQSHC(N,N5,N4)+XQSAL1(N,N5,N4)+XQSALS(N,N5,N4) - 2+XQSFE1(N,N5,N4)+XQSFES(N,N5,N4)+XQSCAO(N,N5,N4)+XQSCAC(N,N5,N4) - 3+XQSCAS(N,N5,N4)+XQSMGO(N,N5,N4)+XQSMGC(N,N5,N4)+XQSMGS(N,N5,N4) - 4+XQSNAC(N,N5,N4)+XQSNAS(N,N5,N4)+XQSKAS(N,N5,N4)+XQSH1P(N,N5,N4) - 5+XQSC0P(N,N5,N4)) - SQ3=XN*3.0*(XQRAL2(N,N5,N4)+XQRFE2(N,N5,N4)+XQRCAH(N,N5,N4) - 2+XQRMGH(N,N5,N4)+XQRF1P(N,N5,N4)+XQRC1P(N,N5,N4)+XQRM1P(N,N5,N4) - 3+XQSAL2(N,N5,N4)+XQSFE2(N,N5,N4)+XQSCAH(N,N5,N4)+XQSMGH(N,N5,N4) - 2+XQSF1P(N,N5,N4)+XQSC1P(N,N5,N4)+XQSM1P(N,N5,N4)) - SQ4=XN*4.0*(XQRAL3(N,N5,N4)+XQRFE3(N,N5,N4)+XQRH3P(N,N5,N4) - 2+XQRF2P(N,N5,N4)+XQRC2P(N,N5,N4)+XQSAL3(N,N5,N4)+XQSFE3(N,N5,N4) - 3+XQSH3P(N,N5,N4)+XQSF2P(N,N5,N4)+XQSC2P(N,N5,N4)) - 5+XN*5.0*(XQRAL4(N,N5,N4)+XQRFE4(N,N5,N4) - 6+XQSAL4(N,N5,N4)+XQSFE4(N,N5,N4)) - SQ=SQ1+SQ2+SQ3+SQ4 - TIONOU=TIONOU-SQ - UIONOU(NY,NX)=UIONOU(NY,NX)-SQ -C -C SURFACE FLUX ELECTRICAL CONDUCTIVITY -C - WX=QR(N,N5,N4) - IF(WX.NE.0.0)THEN - ECHY=0.337*AMAX1(0.0,XQRHY(N,N5,N4)/WX) - ECOH=0.192*AMAX1(0.0,XQROH(N,N5,N4)/WX) - ECAL=0.056*AMAX1(0.0,XQRAL(N,N5,N4)*3.0/WX) - ECFE=0.051*AMAX1(0.0,XQRFE(N,N5,N4)*3.0/WX) - ECCA=0.060*AMAX1(0.0,XQRCA(N,N5,N4)*2.0/WX) - ECMG=0.053*AMAX1(0.0,XQRMG(N,N5,N4)*2.0/WX) - ECNA=0.050*AMAX1(0.0,XQRNA(N,N5,N4)/WX) - ECKA=0.070*AMAX1(0.0,XQRKA(N,N5,N4)/WX) - ECCO=0.072*AMAX1(0.0,XQRC3(N,N5,N4)*2.0/WX) - ECHC=0.044*AMAX1(0.0,XQRHC(N,N5,N4)/WX) - ECSO=0.080*AMAX1(0.0,XQRSO(N,N5,N4)*2.0/WX) - ECCL=0.076*AMAX1(0.0,XQRCL(N,N5,N4)/WX) - ECNO=0.071*AMAX1(0.0,XNOQRW(N,N5,N4)/(WX*14.0)) - ECNDQ=ECHY+ECOH+ECAL+ECFE+ECCA+ECMG+ECNA+ECKA - 2+ECCO+ECHC+ECSO+ECCL+ECNO -C WRITE(*,9991)'ECNDQ',IYRC,I,J,N4,N5,N6,N,WX,ECNDQ -9991 FORMAT(A8,7I4,2E12.4) - ELSE - ECNDQ=0.0 - ENDIF -C -C RUNOFF BOUNDARY FLUXES OF SEDIMENT -C - IF(IERSN(N5,N4).NE.0)THEN - ER=XN*(XSANER(N,N5,N4)+XSILER(N,N5,N4)+XCLAER(N,N5,N4)) - TSEDOU=TSEDOU-ER - USEDOU(NY,NX)=USEDOU(NY,NX)-ER -C -C MICROBIAL C IN RUNOFF SEDIMENT -C - CQ=0.0 - DO 3580 K=0,5 - DO 3580 NO=1,7 - DO 3580 M=1,3 - CQ=CQ+XN*OMCER(M,NO,K,N,N5,N4) -3580 CONTINUE -C -C MICROBIAL RESIDUE C IN RUNOFF SEDIMENT -C - DO 3575 K=0,4 - DO 3570 M=1,2 - CQ=CQ+XN*ORCER(M,K,N,N5,N4) -3570 CONTINUE -C -C DOC, ADSORBED AND HUMUS C IN RUNOFF SEDIMENT -C - CQ=CQ+XN*OHCER(K,N,N5,N4) - DO 3565 M=1,4 - CQ=CQ+XN*OSCER(M,K,N,N5,N4) -3565 CONTINUE -3575 CONTINUE - TCOU=TCOU-CQ-CX - UDOCQ(NY,NX)=UDOCQ(NY,NX)-CQ - UDICQ(NY,NX)=UDICQ(NY,NX)-CX - TSEDOU=TSEDOU-CQ*1.0E-06 - USEDOU(NY,NX)=USEDOU(NY,NX)-CQ*1.0E-06 - TNBP(NY,NX)=TNBP(NY,NX)+CQ+CX -C -C MICROBIAL N IN RUNOFF SEDIMENT -C - ZQ=0.0 - DO 6880 K=0,5 - DO 6880 NO=1,7 - DO 6880 M=1,2 - ZQ=ZQ+XN*OMNER(M,NO,K,N,N5,N4) -6880 CONTINUE -C -C MICROBIAL RESIDUE N IN RUNOFF SEDIMENT -C - DO 6875 K=0,4 - DO 6870 M=1,2 - ZQ=ZQ+XN*ORNER(M,K,N,N5,N4) -6870 CONTINUE -C -C DON, ADSORBED AND HUMUS N IN RUNOFF SEDIMENT -C - ZQ=ZQ+XN*OHNER(K,N,N5,N4) - DO 6865 M=1,4 - ZQ=ZQ+XN*OSNER(M,K,N,N5,N4) -6865 CONTINUE -6875 CONTINUE - TZOU=TZOU-ZQ-ZX-ZG - UDONQ(NY,NX)=UDONQ(NY,NX)-ZQ - UDINQ(NY,NX)=UDINQ(NY,NX)-ZX -C -C MICROBIAL P IN RUNOFF SEDIMENT -C - PQ=0.0 - DO 6780 K=0,5 - DO 6780 NO=1,7 - DO 6780 M=1,2 - PQ=PQ+XN*OMPER(M,NO,K,N,N5,N4) -6780 CONTINUE -C -C MICROBIAL RESIDUE P IN RUNOFF SEDIMENT -C - DO 6775 K=0,4 - DO 6770 M=1,2 - PQ=PQ+XN*ORPER(M,K,N,N5,N4) -6770 CONTINUE -C -C DOP, ADSORBED AND HUMUS P IN RUNOFF SEDIMENT -C - PQ=PQ+XN*OHPER(K,N,N5,N4) - DO 6765 M=1,4 - PQ=PQ+XN*OSPER(M,K,N,N5,N4) -6765 CONTINUE -6775 CONTINUE - TPOU=TPOU-PQ-PX - UDOPQ(NY,NX)=UDOPQ(NY,NX)-PQ - UDIPQ(NY,NX)=UDIPQ(NY,NX)-PX -C -C SOLUTES IN RUNOFF SEDIMENTS -C - SQ1=XN*(XOH0ER(N,N5,N4) - 5+XOH0EB(N,N5,N4)+XHYER(N,N5,N4)+XALER(N,N5,N4)+XCAER(N,N5,N4) - 6+XMGER(N,N5,N4)+XNAER(N,N5,N4)+XKAER(N,N5,N4)+XHCER(N,N5,N4) - 7+XNH3ER(N,N5,N4)+XNHUER(N,N5,N4)+XNO3ER(N,N5,N4)+XNH3EB(N,N5,N4) - 8+XNHUEB(N,N5,N4)+XNO3EB(N,N5,N4)) - SQ2=XN*2.0*(XN4ER(N,N5,N4) - 6+XNBER(N,N5,N4)+XOH1ER(N,N5,N4)+XOH1EB(N,N5,N4)+PCACER(N,N5,N4) - 7+PCASER(N,N5,N4)+PALPER(N,N5,N4)+PFEPER(N,N5,N4)+PALPEB(N,N5,N4) - 8+PFEPEB(N,N5,N4)+XNH4ER(N,N5,N4)+XNH4EB(N,N5,N4)) - SQ3=XN*3.0*(XAL2ER(N,N5,N4) - 4+XOH2ER(N,N5,N4)+XH1PER(N,N5,N4)+XOH2EB(N,N5,N4)+XH1PEB(N,N5,N4) - 5+PCPDER(N,N5,N4)+PCPDEB(N,N5,N4)) - SQ4=XN*4.0*(XH2PER(N,N5,N4)+XH2PEB(N,N5,N4)+PALOER(N,N5,N4) - 4+PFEOER(N,N5,N4)) - 6+XN*7.0*(PCPMER(N,N5,N4)+PCPMEB(N,N5,N4)) - 7+XN*9.0*(PCPHER(N,N5,N4)+PCPHEB(N,N5,N4)) - SQ=SQ1+SQ2+SQ3+SQ4 - TIONOU=TIONOU-SQ - UIONOU(NY,NX)=UIONOU(NY,NX)-SQ - ENDIF - ENDIF - ENDIF -C -C SUBSURFACE BOUNDARY FLUXES OF WATER AND HEAT -C - IF(NCN(NY,NX).NE.3.OR.N.EQ.3)THEN - WO=XN*(FLW(N,N6,N5,N4)+FLWH(N,N6,N5,N4)) - VOLWOU=VOLWOU-WO - HVOLO(NY,NX)=HVOLO(NY,NX)-WO - UVOLO(NY,NX)=UVOLO(NY,NX)-WO - HEATOU=HEATOU-XN*HFLW(N,N6,N5,N4) -C -C SUBSURFACE BOUNDARY FLUXES OF CO2 AND DOC -C - CO=0.0 - DO 450 K=0,4 - CO=CO+XN*(XOCFLS(K,N,N6,N5,N4)+XOAFLS(K,N,N6,N5,N4) - 4+XOCFHS(K,N,N6,N5,N4)+XOAFHS(K,N,N6,N5,N4)) -450 CONTINUE - CX=XN*(XCOFLS(N,N6,N5,N4)+XCOFHS(N,N6,N5,N4) - 2+XCOFLG(N,N6,N5,N4)+XCHFLS(N,N6,N5,N4) - 3+XCHFHS(N,N6,N5,N4)+XCHFLG(N,N6,N5,N4)) - TCOU=TCOU-CO-CX - UDOCD(NY,NX)=UDOCD(NY,NX)-CO - UDICD(NY,NX)=UDICD(NY,NX)-CX - TNBP(NY,NX)=TNBP(NY,NX)+CO+CX -C -C SUBSURFACE BOUNDARY FLUXES OF O2 -C - OO=XN*(XOXFLS(N,N6,N5,N4)+XOXFHS(N,N6,N5,N4)+XOXFLG(N,N6,N5,N4)) - OXYGOU=OXYGOU-OO -C -C SUBSURFACE BOUNDARY FLUXES OF N2O, N2, NH4, NH3, NO3, NO2 AND DON -C - ZO=0.0 - DO 455 K=0,4 - ZO=ZO+XN*(XONFLS(K,N,N6,N5,N4)+XONFHS(K,N,N6,N5,N4)) -455 CONTINUE - ZX=XN*(XN2FLS(N,N6,N5,N4)+XN4FLW(N,N6,N5,N4) - 2+XN3FLW(N,N6,N5,N4)+XNOFLW(N,N6,N5,N4)+XN4FLB(N,N6,N5,N4) - 3+XN3FLB(N,N6,N5,N4)+XNOFLB(N,N6,N5,N4)+XNXFLS(N,N6,N5,N4) - 4+XNXFLB(N,N6,N5,N4)+XN2FHS(N,N6,N5,N4) - 5+XN4FHW(N,N6,N5,N4)+XN3FHW(N,N6,N5,N4)+XNOFHW(N,N6,N5,N4) - 6+XN4FHB(N,N6,N5,N4)+XN3FHB(N,N6,N5,N4)+XNOFHB(N,N6,N5,N4) - 7+XNXFHS(N,N6,N5,N4)+XNXFHB(N,N6,N5,N4)+XN2FLG(N,N6,N5,N4) - 8+XN3FLG(N,N6,N5,N4)) - ZG=XN*(XNGFLS(N,N6,N5,N4)+XNGFLG(N,N6,N5,N4)+XNGFHS(N,N6,N5,N4)) - TZOU=TZOU-ZO-ZX-ZG - UDOND(NY,NX)=UDOND(NY,NX)-ZO - UDIND(NY,NX)=UDIND(NY,NX)-ZX -C -C SUBSURFACE BOUNDARY FLUXES OF PO4 AND DOP -C - PO=0.0 - DO 460 K=0,4 - PO=PO+XN*(XOPFLS(K,N,N6,N5,N4)+XOPFHS(K,N,N6,N5,N4)) -460 CONTINUE - PX=XN*(XH2PFS(N,N6,N5,N4)+XH2BFB(N,N6,N5,N4) - 2+XH2PHS(N,N6,N5,N4)+XH2BHB(N,N6,N5,N4)) - TPOU=TPOU-PO-PX - UDOPD(NY,NX)=UDOPD(NY,NX)-PO - UDIPD(NY,NX)=UDIPD(NY,NX)-PX -C -C SUBSURFACE BOUNDARY FLUXES OF SOLUTES -C - SS=XN*(XALFLS(N,N6,N5,N4)+XFEFLS(N,N6,N5,N4)+XHYFLS(N,N6,N5,N4) - 2+XCAFLS(N,N6,N5,N4)+XMGFLS(N,N6,N5,N4)+XNAFLS(N,N6,N5,N4) - 3+XKAFLS(N,N6,N5,N4)+XOHFLS(N,N6,N5,N4)+XSOFLS(N,N6,N5,N4) - 4+XCLFLS(N,N6,N5,N4)+XC3FLS(N,N6,N5,N4)+XH0PFS(N,N6,N5,N4) - 5+XH0BFB(N,N6,N5,N4)+2.0*(XHCFLS(N,N6,N5,N4)+XAL1FS(N,N6,N5,N4) - 6+XALSFS(N,N6,N5,N4)+XFE1FS(N,N6,N5,N4)+XFESFS(N,N6,N5,N4) - 7+XCAOFS(N,N6,N5,N4)+XCACFS(N,N6,N5,N4) - 8+XCASFS(N,N6,N5,N4)+XMGOFS(N,N6,N5,N4)+XMGCFS(N,N6,N5,N4) - 9+XMGSFS(N,N6,N5,N4)+XNACFS(N,N6,N5,N4)+XNASFS(N,N6,N5,N4) - 1+XKASFS(N,N6,N5,N4)+XH1PFS(N,N6,N5,N4)+XH1BFB(N,N6,N5,N4) - 2+XC0PFS(N,N6,N5,N4)+XC0BFB(N,N6,N5,N4))+3.0*(XAL2FS(N,N6,N5,N4) - 3+XFE2FS(N,N6,N5,N4)+XCAHFS(N,N6,N5,N4)+XMGHFS(N,N6,N5,N4) - 4+XF1PFS(N,N6,N5,N4)+XC1PFS(N,N6,N5,N4)+XM1PFS(N,N6,N5,N4) - 5+XF1BFB(N,N6,N5,N4)+XC1BFB(N,N6,N5,N4)+XM1BFB(N,N6,N5,N4)) - 6+4.0*(XAL3FS(N,N6,N5,N4)+XFE3FS(N,N6,N5,N4)+XH3PFS(N,N6,N5,N4) - 7+XF2PFS(N,N6,N5,N4)+XC2PFS(N,N6,N5,N4)+XH3BFB(N,N6,N5,N4) - 8+XF2BFB(N,N6,N5,N4)+XC2BFB(N,N6,N5,N4)) - 9+5.0*(XAL4FS(N,N6,N5,N4)+XFE4FS(N,N6,N5,N4))+XHGFLS(N,N6,N5,N4) - 1+XHGFLG(N,N6,N5,N4)) - SG=SG+XHGFLS(N,N6,N5,N4)+XHGFLG(N,N6,N5,N4) - SH=XN*(XALFHS(N,N6,N5,N4)+XFEFHS(N,N6,N5,N4)+XHYFHS(N,N6,N5,N4) - 2+XCAFHS(N,N6,N5,N4)+XMGFHS(N,N6,N5,N4)+XNAFHS(N,N6,N5,N4) - 3+XKAFHS(N,N6,N5,N4)+XOHFHS(N,N6,N5,N4)+XSOFHS(N,N6,N5,N4) - 4+XCLFHS(N,N6,N5,N4)+XC3FHS(N,N6,N5,N4)+XH0PHS(N,N6,N5,N4) - 5+XH0BHB(N,N6,N5,N4)+2.0*(XHCFHS(N,N6,N5,N4)+XAL1HS(N,N6,N5,N4) - 6+XALSHS(N,N6,N5,N4)+XFE1HS(N,N6,N5,N4)+XFESHS(N,N6,N5,N4) - 7+XCAOHS(N,N6,N5,N4)+XCACHS(N,N6,N5,N4) - 8+XCASHS(N,N6,N5,N4)+XMGOHS(N,N6,N5,N4)+XMGCHS(N,N6,N5,N4) - 9+XMGSHS(N,N6,N5,N4)+XNACHS(N,N6,N5,N4)+XNASHS(N,N6,N5,N4) - 1+XKASHS(N,N6,N5,N4)+XH1PHS(N,N6,N5,N4)+XH1BHB(N,N6,N5,N4) - 2+XC0PHS(N,N6,N5,N4)+XC0BHB(N,N6,N5,N4))+3.0*(XAL2HS(N,N6,N5,N4) - 3+XFE2HS(N,N6,N5,N4)+XCAHHS(N,N6,N5,N4)+XMGHHS(N,N6,N5,N4) - 4+XF1PHS(N,N6,N5,N4)+XC1PHS(N,N6,N5,N4)+XM1PHS(N,N6,N5,N4) - 5+XF1BHB(N,N6,N5,N4)+XC1BHB(N,N6,N5,N4)+XM1BHB(N,N6,N5,N4)) - 6+4.0*(XAL3HS(N,N6,N5,N4)+XFE3HS(N,N6,N5,N4)+XH3PHS(N,N6,N5,N4) - 7+XF2PHS(N,N6,N5,N4)+XC2PHS(N,N6,N5,N4)+XH3BHB(N,N6,N5,N4) - 8+XF2BHB(N,N6,N5,N4)+XC2BHB(N,N6,N5,N4)) - 9+5.0*(XAL4HS(N,N6,N5,N4)+XAL4HS(N,N6,N5,N4))+XHGFHS(N,N6,N5,N4)) - SO=SS+SH - TIONOU=TIONOU-SO - UIONOU(NY,NX)=UIONOU(NY,NX)-SO -C -C SUBSURFACE FLUX ELECTRICAL CONDUCTIVITY -C - WX=FLW(N,N6,N5,N4)+FLWH(N,N6,N5,N4) - IF(WX.NE.0.0)THEN - ECHY=0.337*AMAX1(0.0,(XHYFLS(N,N6,N5,N4) - 2+XHYFHS(N,N6,N5,N4))/WX) - ECOH=0.192*AMAX1(0.0,(XOHFLS(N,N6,N5,N4) - 2+XOHFHS(N,N6,N5,N4))/WX) - ECAL=0.056*AMAX1(0.0,(XALFLS(N,N6,N5,N4) - 2+XCAFHS(N,N6,N5,N4))*3.0/WX) - ECFE=0.051*AMAX1(0.0,(XFEFLS(N,N6,N5,N4) - 2+XFEFHS(N,N6,N5,N4))*3.0/WX) - ECCA=0.060*AMAX1(0.0,(XCAFLS(N,N6,N5,N4) - 2+XCAFHS(N,N6,N5,N4))*2.0/WX) - ECMG=0.053*AMAX1(0.0,(XMGFLS(N,N6,N5,N4) - 2+XMGFHS(N,N6,N5,N4))*2.0/WX) - ECNA=0.050*AMAX1(0.0,(XNAFLS(N,N6,N5,N4) - 2+XNAFHS(N,N6,N5,N4))/WX) - ECKA=0.070*AMAX1(0.0,(XKAFLS(N,N6,N5,N4) - 2+XKAFHS(N,N6,N5,N4))/WX) - ECCO=0.072*AMAX1(0.0,(XC3FLS(N,N6,N5,N4) - 2+XC3FHS(N,N6,N5,N4))*2.0/WX) - ECHC=0.044*AMAX1(0.0,(XHCFLS(N,N6,N5,N4) - 2+XHCFHS(N,N6,N5,N4))/WX) - ECSO=0.080*AMAX1(0.0,(XSOFLS(N,N6,N5,N4) - 2+XSOFHS(N,N6,N5,N4))*2.0/WX) - ECCL=0.076*AMAX1(0.0,(XCLFLS(N,N6,N5,N4) - 2+XCLFHS(N,N6,N5,N4))/WX) - ECNO=0.071*AMAX1(0.0,(XNOFLW(N,N6,N5,N4) - 2+XNOFHW(N,N6,N5,N4))/(WX*14.0)) - ECNDX=ECHY+ECOH+ECAL+ECFE+ECCA+ECMG+ECNA+ECKA - 2+ECCO+ECHC+ECSO+ECCL+ECNO -C IF((I/10)*10.EQ.I.AND.J.EQ.15)THEN -C WRITE(*,9992)'ECNDX',IYRC,I,J,N4,N5,N6,N,WX,ECNDX -C 2,FLW(N,N6,N5,N4),FLWH(N,N6,N5,N4) -9992 FORMAT(A8,7I4,4E12.4) -C ENDIF - ELSE - ECNDX=0.0 - ENDIF - ENDIF -9975 CONTINUE -9980 CONTINUE -9985 CONTINUE -C -C SET DEPTH OF EXTERNAL WATER TABLE -C - IF(IPRC(NY,NX).EQ.2)THEN - DTBLX(NY,NX)=DTBLX(NY,NX)-HVOLO(NY,NX)/AREA(3,NU(NY,NX),NY,NX) - 2-0.001*(DTBLX(NY,NX)-DTBLZ(NY,NX)) - ELSEIF(IPRC(NY,NX).EQ.3)THEN - DTBLX(NY,NX)=DTBLX(NY,NX)-HVOLO(NY,NX)/AREA(3,NU(NY,NX),NY,NX) - 2-0.001*(DTBLX(NY,NX)-DDRG(NY,NX)) - ENDIF -C -C TOTAL FLUXES FOR EACH GRID CELL FROM ALL INTERNAL AND BOUNDARY FLUXES -C CALCULATED IN 'WATSUB', NITRO', 'SOLUTE', 'EXTRACT', 'TRNSFR', -C 'TRNSFRS' AND 'REDIST' ABOVE -C - TQR(NY,NX)=0.0 - THQR(NY,NX)=0.0 - TQS(NY,NX)=0.0 - TQW(NY,NX)=0.0 - TQI(NY,NX)=0.0 - THQS(NY,NX)=0.0 - DO 9960 K=0,2 - TOCQRS(K,NY,NX)=0.0 - TONQRS(K,NY,NX)=0.0 - TOPQRS(K,NY,NX)=0.0 - TOAQRS(K,NY,NX)=0.0 -9960 CONTINUE - TCOQRS(NY,NX)=0.0 - TCHQRS(NY,NX)=0.0 - TOXQRS(NY,NX)=0.0 - TNGQRS(NY,NX)=0.0 - TN2QRS(NY,NX)=0.0 - THGQRS(NY,NX)=0.0 - TN4QRS(NY,NX)=0.0 - TN3QRS(NY,NX)=0.0 - TNOQRS(NY,NX)=0.0 - TNXQRS(NY,NX)=0.0 - TPOQRS(NY,NX)=0.0 - TCOQSS(NY,NX)=0.0 - TCHQSS(NY,NX)=0.0 - TOXQSS(NY,NX)=0.0 - TNGQSS(NY,NX)=0.0 - TN2QSS(NY,NX)=0.0 - TN4QSS(NY,NX)=0.0 - TN3QSS(NY,NX)=0.0 - TNOQSS(NY,NX)=0.0 - TPOQSS(NY,NX)=0.0 - IF(ISALT(NY,NX).NE.0)THEN - TQRAL(NY,NX)=0.0 - TQRFE(NY,NX)=0.0 - TQRHY(NY,NX)=0.0 - TQRCA(NY,NX)=0.0 - TQRMG(NY,NX)=0.0 - TQRNA(NY,NX)=0.0 - TQRKA(NY,NX)=0.0 - TQROH(NY,NX)=0.0 - TQRSO(NY,NX)=0.0 - TQRCL(NY,NX)=0.0 - TQRC3(NY,NX)=0.0 - TQRHC(NY,NX)=0.0 - TQRAL1(NY,NX)=0.0 - TQRAL2(NY,NX)=0.0 - TQRAL3(NY,NX)=0.0 - TQRAL4(NY,NX)=0.0 - TQRALS(NY,NX)=0.0 - TQRFE1(NY,NX)=0.0 - TQRFE2(NY,NX)=0.0 - TQRFE3(NY,NX)=0.0 - TQRFE4(NY,NX)=0.0 - TQRFES(NY,NX)=0.0 - TQRCAO(NY,NX)=0.0 - TQRCAC(NY,NX)=0.0 - TQRCAH(NY,NX)=0.0 - TQRCAS(NY,NX)=0.0 - TQRMGO(NY,NX)=0.0 - TQRMGC(NY,NX)=0.0 - TQRMGH(NY,NX)=0.0 - TQRMGS(NY,NX)=0.0 - TQRNAC(NY,NX)=0.0 - TQRNAS(NY,NX)=0.0 - TQRKAS(NY,NX)=0.0 - TQRH0P(NY,NX)=0.0 - TQRH1P(NY,NX)=0.0 - TQRH3P(NY,NX)=0.0 - TQRF1P(NY,NX)=0.0 - TQRF2P(NY,NX)=0.0 - TQRC0P(NY,NX)=0.0 - TQRC1P(NY,NX)=0.0 - TQRC2P(NY,NX)=0.0 - TQRM1P(NY,NX)=0.0 - TQSAL(NY,NX)=0.0 - TQSFE(NY,NX)=0.0 - TQSHY(NY,NX)=0.0 - TQSCA(NY,NX)=0.0 - TQSMG(NY,NX)=0.0 - TQSNA(NY,NX)=0.0 - TQSKA(NY,NX)=0.0 - TQSOH(NY,NX)=0.0 - TQSSO(NY,NX)=0.0 - TQSCL(NY,NX)=0.0 - TQSC3(NY,NX)=0.0 - TQSHC(NY,NX)=0.0 - TQSAL1(NY,NX)=0.0 - TQSAL2(NY,NX)=0.0 - TQSAL3(NY,NX)=0.0 - TQSAL4(NY,NX)=0.0 - TQSALS(NY,NX)=0.0 - TQSFE1(NY,NX)=0.0 - TQSFE2(NY,NX)=0.0 - TQSFE3(NY,NX)=0.0 - TQSFE4(NY,NX)=0.0 - TQSFES(NY,NX)=0.0 - TQSCAO(NY,NX)=0.0 - TQSCAC(NY,NX)=0.0 - TQSCAH(NY,NX)=0.0 - TQSCAS(NY,NX)=0.0 - TQSMGO(NY,NX)=0.0 - TQSMGC(NY,NX)=0.0 - TQSMGH(NY,NX)=0.0 - TQSMGS(NY,NX)=0.0 - TQSNAC(NY,NX)=0.0 - TQSNAS(NY,NX)=0.0 - TQSKAS(NY,NX)=0.0 - TQSH0P(NY,NX)=0.0 - TQSH1P(NY,NX)=0.0 - TQSH3P(NY,NX)=0.0 - TQSF1P(NY,NX)=0.0 - TQSF2P(NY,NX)=0.0 - TQSC0P(NY,NX)=0.0 - TQSC1P(NY,NX)=0.0 - TQSC2P(NY,NX)=0.0 - TQSM1P(NY,NX)=0.0 - ENDIF - IF(IERSN(NY,NX).NE.0)THEN - TSEDER(NY,NX)=0.0 - TSANER(NY,NX)=0.0 - TSILER(NY,NX)=0.0 - TCLAER(NY,NX)=0.0 - TCECER(NY,NX)=0.0 - TAECER(NY,NX)=0.0 - TNH4ER(NY,NX)=0.0 - TNH3ER(NY,NX)=0.0 - TNHUER(NY,NX)=0.0 - TNO3ER(NY,NX)=0.0 - TNH4EB(NY,NX)=0.0 - TNH3EB(NY,NX)=0.0 - TNHUEB(NY,NX)=0.0 - TNO3EB(NY,NX)=0.0 - TN4ER(NY,NX)=0.0 - TNBER(NY,NX)=0.0 - THYER(NY,NX)=0.0 - TALER(NY,NX)=0.0 - TCAER(NY,NX)=0.0 - TMGER(NY,NX)=0.0 - TNAER(NY,NX)=0.0 - TKAER(NY,NX)=0.0 - THCER(NY,NX)=0.0 - TAL2ER(NY,NX)=0.0 - TOH0ER(NY,NX)=0.0 - TOH1ER(NY,NX)=0.0 - TOH2ER(NY,NX)=0.0 - TH1PER(NY,NX)=0.0 - TH2PER(NY,NX)=0.0 - TOH0EB(NY,NX)=0.0 - TOH1EB(NY,NX)=0.0 - TOH2EB(NY,NX)=0.0 - TH1PEB(NY,NX)=0.0 - TH2PEB(NY,NX)=0.0 - TALOER(NY,NX)=0.0 - TFEOER(NY,NX)=0.0 - TCACER(NY,NX)=0.0 - TCASER(NY,NX)=0.0 - TALPER(NY,NX)=0.0 - TFEPER(NY,NX)=0.0 - TCPDER(NY,NX)=0.0 - TCPHER(NY,NX)=0.0 - TCPMER(NY,NX)=0.0 - TALPEB(NY,NX)=0.0 - TFEPEB(NY,NX)=0.0 - TCPDEB(NY,NX)=0.0 - TCPHEB(NY,NX)=0.0 - TCPMEB(NY,NX)=0.0 - DO 9480 K=0,5 - DO 9480 NN=1,7 - TOMCER(3,NN,K,NY,NX)=0.0 - DO 9480 M=1,2 - TOMCER(M,NN,K,NY,NX)=0.0 - TOMNER(M,NN,K,NY,NX)=0.0 - TOMPER(M,NN,K,NY,NX)=0.0 -9480 CONTINUE - DO 9475 K=0,4 - DO 9470 M=1,2 - TORCER(M,K,NY,NX)=0.0 - TORNER(M,K,NY,NX)=0.0 - TORPER(M,K,NY,NX)=0.0 -9470 CONTINUE - TOHCER(K,NY,NX)=0.0 - TOHNER(K,NY,NX)=0.0 - TOHPER(K,NY,NX)=0.0 - DO 9465 M=1,4 - TOSCER(M,K,NY,NX)=0.0 - TOSAER(M,K,NY,NX)=0.0 - TOSNER(M,K,NY,NX)=0.0 - TOSPER(M,K,NY,NX)=0.0 -9465 CONTINUE -9475 CONTINUE - ENDIF - LG=0 - LX=0 - DO 8575 L=NU(NY,NX),NL(NY,NX) - IF(THETP(L,NY,NX).LT.THETX)LX=1 - IF(THETP(L,NY,NX).GE.THETX.AND.LX.EQ.0)LG=L - TTHAW(L,NY,NX)=0.0 - TTHAWH(L,NY,NX)=0.0 - THTHAW(L,NY,NX)=0.0 - TFLW(L,NY,NX)=0.0 - TFLWX(L,NY,NX)=0.0 - TFLWH(L,NY,NX)=0.0 - THFLW(L,NY,NX)=0.0 - DO 8595 K=0,4 - TOCFLS(K,L,NY,NX)=0.0 - TONFLS(K,L,NY,NX)=0.0 - TOPFLS(K,L,NY,NX)=0.0 - TOAFLS(K,L,NY,NX)=0.0 - TOCFHS(K,L,NY,NX)=0.0 - TONFHS(K,L,NY,NX)=0.0 - TOPFHS(K,L,NY,NX)=0.0 - TOAFHS(K,L,NY,NX)=0.0 -8595 CONTINUE - TCOFLS(L,NY,NX)=0.0 - TCHFLS(L,NY,NX)=0.0 - TOXFLS(L,NY,NX)=0.0 - TNGFLS(L,NY,NX)=0.0 - TN2FLS(L,NY,NX)=0.0 - THGFLS(L,NY,NX)=0.0 - TN4FLS(L,NY,NX)=0.0 - TN3FLS(L,NY,NX)=0.0 - TNOFLS(L,NY,NX)=0.0 - TNXFLS(L,NY,NX)=0.0 - TPOFLS(L,NY,NX)=0.0 - TN4FLB(L,NY,NX)=0.0 - TN3FLB(L,NY,NX)=0.0 - TNOFLB(L,NY,NX)=0.0 - TNXFLB(L,NY,NX)=0.0 - TH2BFB(L,NY,NX)=0.0 - TCOFHS(L,NY,NX)=0.0 - TCHFHS(L,NY,NX)=0.0 - TOXFHS(L,NY,NX)=0.0 - TNGFHS(L,NY,NX)=0.0 - TN2FHS(L,NY,NX)=0.0 - THGFHS(L,NY,NX)=0.0 - TN4FHS(L,NY,NX)=0.0 - TN3FHS(L,NY,NX)=0.0 - TNOFHS(L,NY,NX)=0.0 - TNXFHS(L,NY,NX)=0.0 - TPOFHS(L,NY,NX)=0.0 - TN4FHB(L,NY,NX)=0.0 - TN3FHB(L,NY,NX)=0.0 - TNOFHB(L,NY,NX)=0.0 - TNXFHB(L,NY,NX)=0.0 - TH2BHB(L,NY,NX)=0.0 - TCOFLG(L,NY,NX)=0.0 - TCHFLG(L,NY,NX)=0.0 - TOXFLG(L,NY,NX)=0.0 - TNGFLG(L,NY,NX)=0.0 - TN2FLG(L,NY,NX)=0.0 - TNHFLG(L,NY,NX)=0.0 - THGFLG(L,NY,NX)=0.0 - IF(ISALT(NY,NX).NE.0)THEN - TALFLS(L,NY,NX)=0.0 - TFEFLS(L,NY,NX)=0.0 - THYFLS(L,NY,NX)=0.0 - TCAFLS(L,NY,NX)=0.0 - TMGFLS(L,NY,NX)=0.0 - TNAFLS(L,NY,NX)=0.0 - TKAFLS(L,NY,NX)=0.0 - TOHFLS(L,NY,NX)=0.0 - TSOFLS(L,NY,NX)=0.0 - TCLFLS(L,NY,NX)=0.0 - TC3FLS(L,NY,NX)=0.0 - THCFLS(L,NY,NX)=0.0 - TAL1FS(L,NY,NX)=0.0 - TAL2FS(L,NY,NX)=0.0 - TAL3FS(L,NY,NX)=0.0 - TAL4FS(L,NY,NX)=0.0 - TALSFS(L,NY,NX)=0.0 - TFE1FS(L,NY,NX)=0.0 - TFE2FS(L,NY,NX)=0.0 - TFE3FS(L,NY,NX)=0.0 - TFE4FS(L,NY,NX)=0.0 - TFESFS(L,NY,NX)=0.0 - TCAOFS(L,NY,NX)=0.0 - TCACFS(L,NY,NX)=0.0 - TCAHFS(L,NY,NX)=0.0 - TCASFS(L,NY,NX)=0.0 - TMGOFS(L,NY,NX)=0.0 - TMGCFS(L,NY,NX)=0.0 - TMGHFS(L,NY,NX)=0.0 - TMGSFS(L,NY,NX)=0.0 - TNACFS(L,NY,NX)=0.0 - TNASFS(L,NY,NX)=0.0 - TKASFS(L,NY,NX)=0.0 - TH0PFS(L,NY,NX)=0.0 - TH1PFS(L,NY,NX)=0.0 - TH3PFS(L,NY,NX)=0.0 - TF1PFS(L,NY,NX)=0.0 - TF2PFS(L,NY,NX)=0.0 - TC0PFS(L,NY,NX)=0.0 - TC1PFS(L,NY,NX)=0.0 - TC2PFS(L,NY,NX)=0.0 - TM1PFS(L,NY,NX)=0.0 - TH0BFB(L,NY,NX)=0.0 - TH1BFB(L,NY,NX)=0.0 - TH3BFB(L,NY,NX)=0.0 - TF1BFB(L,NY,NX)=0.0 - TF2BFB(L,NY,NX)=0.0 - TC0BFB(L,NY,NX)=0.0 - TC1BFB(L,NY,NX)=0.0 - TC2BFB(L,NY,NX)=0.0 - TM1BFB(L,NY,NX)=0.0 - TALFHS(L,NY,NX)=0.0 - TFEFHS(L,NY,NX)=0.0 - THYFHS(L,NY,NX)=0.0 - TCAFHS(L,NY,NX)=0.0 - TMGFHS(L,NY,NX)=0.0 - TNAFHS(L,NY,NX)=0.0 - TKAFHS(L,NY,NX)=0.0 - TOHFHS(L,NY,NX)=0.0 - TSOFHS(L,NY,NX)=0.0 - TCLFHS(L,NY,NX)=0.0 - TC3FHS(L,NY,NX)=0.0 - THCFHS(L,NY,NX)=0.0 - TAL1HS(L,NY,NX)=0.0 - TAL2HS(L,NY,NX)=0.0 - TAL3HS(L,NY,NX)=0.0 - TAL4HS(L,NY,NX)=0.0 - TALSHS(L,NY,NX)=0.0 - TFE1HS(L,NY,NX)=0.0 - TFE2HS(L,NY,NX)=0.0 - TFE3HS(L,NY,NX)=0.0 - TFE4HS(L,NY,NX)=0.0 - TFESHS(L,NY,NX)=0.0 - TCAOHS(L,NY,NX)=0.0 - TCACHS(L,NY,NX)=0.0 - TCAHHS(L,NY,NX)=0.0 - TCASHS(L,NY,NX)=0.0 - TMGOHS(L,NY,NX)=0.0 - TMGCHS(L,NY,NX)=0.0 - TMGHHS(L,NY,NX)=0.0 - TMGSHS(L,NY,NX)=0.0 - TNACHS(L,NY,NX)=0.0 - TNASHS(L,NY,NX)=0.0 - TKASHS(L,NY,NX)=0.0 - TH0PHS(L,NY,NX)=0.0 - TH1PHS(L,NY,NX)=0.0 - TH3PHS(L,NY,NX)=0.0 - TF1PHS(L,NY,NX)=0.0 - TF2PHS(L,NY,NX)=0.0 - TC0PHS(L,NY,NX)=0.0 - TC1PHS(L,NY,NX)=0.0 - TC2PHS(L,NY,NX)=0.0 - TM1PHS(L,NY,NX)=0.0 - TH0BHB(L,NY,NX)=0.0 - TH1BHB(L,NY,NX)=0.0 - TH3BHB(L,NY,NX)=0.0 - TF1BHB(L,NY,NX)=0.0 - TF2BHB(L,NY,NX)=0.0 - TC0BHB(L,NY,NX)=0.0 - TC1BHB(L,NY,NX)=0.0 - TC2BHB(L,NY,NX)=0.0 - TM1BHB(L,NY,NX)=0.0 - ENDIF - N1=NX - N2=NY - N3=L - DO 8580 N=1,3 - IF(N.EQ.1)THEN - N4=NX+1 - N5=NY - N6=L - ELSEIF(N.EQ.2)THEN - N4=NX - N5=NY+1 - N6=L - ELSEIF(N.EQ.3)THEN - N4=NX - N5=NY - N6=L+1 - ENDIF -C -C TOTAL FLUXES FROM OVERLAND FLOW -C - IF(L.EQ.NU(N2,N1).AND.N.NE.3)THEN - TQR(N2,N1)=TQR(N2,N1)+QR(N,N2,N1)-QR(N,N5,N4) - THQR(N2,N1)=THQR(N2,N1)+HQR(N,N2,N1)-HQR(N,N5,N4) - TQS(N2,N1)=TQS(N2,N1)+QS(N,N2,N1)-QS(N,N5,N4) - TQW(N2,N1)=TQW(N2,N1)+QW(N,N2,N1)-QW(N,N5,N4) - TQI(N2,N1)=TQI(N2,N1)+QI(N,N2,N1)-QI(N,N5,N4) - THQS(N2,N1)=THQS(N2,N1)+HQS(N,N2,N1)-HQS(N,N5,N4) - DO 8590 K=0,2 - TOCQRS(K,N2,N1)=TOCQRS(K,N2,N1)+XOCQRS(K,N,N2,N1) - 2-XOCQRS(K,N,N5,N4) - TONQRS(K,N2,N1)=TONQRS(K,N2,N1)+XONQRS(K,N,N2,N1) - 2-XONQRS(K,N,N5,N4) - TOPQRS(K,N2,N1)=TOPQRS(K,N2,N1)+XOPQRS(K,N,N2,N1) - 2-XOPQRS(K,N,N5,N4) - TOAQRS(K,N2,N1)=TOAQRS(K,N2,N1)+XOAQRS(K,N,N2,N1) - 2-XOAQRS(K,N,N5,N4) -8590 CONTINUE - TCOQRS(N2,N1)=TCOQRS(N2,N1)+XCOQRS(N,N2,N1)-XCOQRS(N,N5,N4) - TCHQRS(N2,N1)=TCHQRS(N2,N1)+XCHQRS(N,N2,N1)-XCHQRS(N,N5,N4) - TOXQRS(N2,N1)=TOXQRS(N2,N1)+XOXQRS(N,N2,N1)-XOXQRS(N,N5,N4) - TNGQRS(N2,N1)=TNGQRS(N2,N1)+XNGQRS(N,N2,N1)-XNGQRS(N,N5,N4) - TN2QRS(N2,N1)=TN2QRS(N2,N1)+XN2QRS(N,N2,N1)-XN2QRS(N,N5,N4) - THGQRS(N2,N1)=THGQRS(N2,N1)+XHGQRS(N,N2,N1)-XHGQRS(N,N5,N4) - TN4QRS(N2,N1)=TN4QRS(N2,N1)+XN4QRW(N,N2,N1)-XN4QRW(N,N5,N4) - TN3QRS(N2,N1)=TN3QRS(N2,N1)+XN3QRW(N,N2,N1)-XN3QRW(N,N5,N4) - TNOQRS(N2,N1)=TNOQRS(N2,N1)+XNOQRW(N,N2,N1)-XNOQRW(N,N5,N4) - TNXQRS(N2,N1)=TNXQRS(N2,N1)+XNXQRS(N,N2,N1)-XNXQRS(N,N5,N4) - TPOQRS(N2,N1)=TPOQRS(N2,N1)+XP4QRW(N,N2,N1)-XP4QRW(N,N5,N4) - TCOQSS(N2,N1)=TCOQSS(N2,N1)+XCOQSS(N,N2,N1)-XCOQSS(N,N5,N4) - TCHQSS(N2,N1)=TCHQSS(N2,N1)+XCHQSS(N,N2,N1)-XCHQSS(N,N5,N4) - TOXQSS(N2,N1)=TOXQSS(N2,N1)+XOXQSS(N,N2,N1)-XOXQSS(N,N5,N4) - TNGQSS(N2,N1)=TNGQSS(N2,N1)+XNGQSS(N,N2,N1)-XNGQSS(N,N5,N4) - TN2QSS(N2,N1)=TN2QSS(N2,N1)+XN2QSS(N,N2,N1)-XN2QSS(N,N5,N4) - TN4QSS(N2,N1)=TN4QSS(N2,N1)+XN4QSS(N,N2,N1)-XN4QSS(N,N5,N4) - TN3QSS(N2,N1)=TN3QSS(N2,N1)+XN3QSS(N,N2,N1)-XN3QSS(N,N5,N4) - TNOQSS(N2,N1)=TNOQSS(N2,N1)+XNOQSS(N,N2,N1)-XNOQSS(N,N5,N4) - TPOQSS(N2,N1)=TPOQSS(N2,N1)+XP4QSS(N,N2,N1)-XP4QSS(N,N5,N4) - IF(ISALT(NY,NX).NE.0)THEN - TQRAL(N2,N1)=TQRAL(N2,N1)+XQRAL(N,N2,N1)-XQRAL(N,N5,N4) - TQRFE(N2,N1)=TQRFE(N2,N1)+XQRFE(N,N2,N1)-XQRFE(N,N5,N4) - TQRHY(N2,N1)=TQRHY(N2,N1)+XQRHY(N,N2,N1)-XQRHY(N,N5,N4) - TQRCA(N2,N1)=TQRCA(N2,N1)+XQRCA(N,N2,N1)-XQRCA(N,N5,N4) - TQRMG(N2,N1)=TQRMG(N2,N1)+XQRMG(N,N2,N1)-XQRMG(N,N5,N4) - TQRNA(N2,N1)=TQRNA(N2,N1)+XQRNA(N,N2,N1)-XQRNA(N,N5,N4) - TQRKA(N2,N1)=TQRKA(N2,N1)+XQRKA(N,N2,N1)-XQRKA(N,N5,N4) - TQROH(N2,N1)=TQROH(N2,N1)+XQROH(N,N2,N1)-XQROH(N,N5,N4) - TQRSO(N2,N1)=TQRSO(N2,N1)+XQRSO(N,N2,N1)-XQRSO(N,N5,N4) - TQRCL(N2,N1)=TQRCL(N2,N1)+XQRCL(N,N2,N1)-XQRCL(N,N5,N4) - TQRC3(N2,N1)=TQRC3(N2,N1)+XQRC3(N,N2,N1)-XQRC3(N,N5,N4) - TQRHC(N2,N1)=TQRHC(N2,N1)+XQRHC(N,N2,N1)-XQRHC(N,N5,N4) - TQRAL1(N2,N1)=TQRAL1(N2,N1)+XQRAL1(N,N2,N1)-XQRAL1(N,N5,N4) - TQRAL2(N2,N1)=TQRAL2(N2,N1)+XQRAL2(N,N2,N1)-XQRAL2(N,N5,N4) - TQRAL3(N2,N1)=TQRAL3(N2,N1)+XQRAL3(N,N2,N1)-XQRAL3(N,N5,N4) - TQRAL4(N2,N1)=TQRAL4(N2,N1)+XQRAL4(N,N2,N1)-XQRAL4(N,N5,N4) - TQRALS(N2,N1)=TQRALS(N2,N1)+XQRALS(N,N2,N1)-XQRALS(N,N5,N4) - TQRFE1(N2,N1)=TQRFE1(N2,N1)+XQRFE1(N,N2,N1)-XQRFE1(N,N5,N4) - TQRFE2(N2,N1)=TQRFE2(N2,N1)+XQRFE2(N,N2,N1)-XQRFE2(N,N5,N4) - TQRFE3(N2,N1)=TQRFE3(N2,N1)+XQRFE3(N,N2,N1)-XQRFE3(N,N5,N4) - TQRFE4(N2,N1)=TQRFE4(N2,N1)+XQRFE4(N,N2,N1)-XQRFE4(N,N5,N4) - TQRFES(N2,N1)=TQRFES(N2,N1)+XQRFES(N,N2,N1)-XQRFES(N,N5,N4) - TQRCAO(N2,N1)=TQRCAO(N2,N1)+XQRCAO(N,N2,N1)-XQRCAO(N,N5,N4) - TQRCAC(N2,N1)=TQRCAC(N2,N1)+XQRCAC(N,N2,N1)-XQRCAC(N,N5,N4) - TQRCAH(N2,N1)=TQRCAH(N2,N1)+XQRCAH(N,N2,N1)-XQRCAH(N,N5,N4) - TQRCAS(N2,N1)=TQRCAS(N2,N1)+XQRCAS(N,N2,N1)-XQRCAS(N,N5,N4) - TQRMGO(N2,N1)=TQRMGO(N2,N1)+XQRMGO(N,N2,N1)-XQRMGO(N,N5,N4) - TQRMGC(N2,N1)=TQRMGC(N2,N1)+XQRMGC(N,N2,N1)-XQRMGC(N,N5,N4) - TQRMGH(N2,N1)=TQRMGH(N2,N1)+XQRMGH(N,N2,N1)-XQRMGH(N,N5,N4) - TQRMGS(N2,N1)=TQRMGS(N2,N1)+XQRMGS(N,N2,N1)-XQRMGS(N,N5,N4) - TQRNAC(N2,N1)=TQRNAC(N2,N1)+XQRNAC(N,N2,N1)-XQRNAC(N,N5,N4) - TQRNAS(N2,N1)=TQRNAS(N2,N1)+XQRNAS(N,N2,N1)-XQRNAS(N,N5,N4) - TQRKAS(N2,N1)=TQRKAS(N2,N1)+XQRKAS(N,N2,N1)-XQRKAS(N,N5,N4) - TQRH0P(N2,N1)=TQRH0P(N2,N1)+XQRH0P(N,N2,N1)-XQRH0P(N,N5,N4) - TQRH1P(N2,N1)=TQRH1P(N2,N1)+XQRH1P(N,N2,N1)-XQRH1P(N,N5,N4) - TQRH3P(N2,N1)=TQRH3P(N2,N1)+XQRH3P(N,N2,N1)-XQRH3P(N,N5,N4) - TQRF1P(N2,N1)=TQRF1P(N2,N1)+XQRF1P(N,N2,N1)-XQRF1P(N,N5,N4) - TQRF2P(N2,N1)=TQRF2P(N2,N1)+XQRF2P(N,N2,N1)-XQRF2P(N,N5,N4) - TQRC0P(N2,N1)=TQRC0P(N2,N1)+XQRC0P(N,N2,N1)-XQRC0P(N,N5,N4) - TQRC1P(N2,N1)=TQRC1P(N2,N1)+XQRC1P(N,N2,N1)-XQRC1P(N,N5,N4) - TQRC2P(N2,N1)=TQRC2P(N2,N1)+XQRC2P(N,N2,N1)-XQRC2P(N,N5,N4) - TQRM1P(N2,N1)=TQRM1P(N2,N1)+XQRM1P(N,N2,N1)-XQRM1P(N,N5,N4) - TQSAL(N2,N1)=TQSAL(N2,N1)+XQSAL(N,N2,N1)-XQSAL(N,N5,N4) - TQSFE(N2,N1)=TQSFE(N2,N1)+XQSFE(N,N2,N1)-XQSFE(N,N5,N4) - TQSHY(N2,N1)=TQSHY(N2,N1)+XQSHY(N,N2,N1)-XQSHY(N,N5,N4) - TQSCA(N2,N1)=TQSCA(N2,N1)+XQSCA(N,N2,N1)-XQSCA(N,N5,N4) - TQSMG(N2,N1)=TQSMG(N2,N1)+XQSMG(N,N2,N1)-XQSMG(N,N5,N4) - TQSNA(N2,N1)=TQSNA(N2,N1)+XQSNA(N,N2,N1)-XQSNA(N,N5,N4) - TQSKA(N2,N1)=TQSKA(N2,N1)+XQSKA(N,N2,N1)-XQSKA(N,N5,N4) - TQSOH(N2,N1)=TQSOH(N2,N1)+XQSOH(N,N2,N1)-XQSOH(N,N5,N4) - TQSSO(N2,N1)=TQSSO(N2,N1)+XQSSO(N,N2,N1)-XQSSO(N,N5,N4) - TQSCL(N2,N1)=TQSCL(N2,N1)+XQSCL(N,N2,N1)-XQSCL(N,N5,N4) - TQSC3(N2,N1)=TQSC3(N2,N1)+XQSC3(N,N2,N1)-XQSC3(N,N5,N4) - TQSHC(N2,N1)=TQSHC(N2,N1)+XQSHC(N,N2,N1)-XQSHC(N,N5,N4) - TQSAL1(N2,N1)=TQSAL1(N2,N1)+XQSAL1(N,N2,N1)-XQSAL1(N,N5,N4) - TQSAL2(N2,N1)=TQSAL2(N2,N1)+XQSAL2(N,N2,N1)-XQSAL2(N,N5,N4) - TQSAL3(N2,N1)=TQSAL3(N2,N1)+XQSAL3(N,N2,N1)-XQSAL3(N,N5,N4) - TQSAL4(N2,N1)=TQSAL4(N2,N1)+XQSAL4(N,N2,N1)-XQSAL4(N,N5,N4) - TQSALS(N2,N1)=TQSALS(N2,N1)+XQSALS(N,N2,N1)-XQSALS(N,N5,N4) - TQSFE1(N2,N1)=TQSFE1(N2,N1)+XQSFE1(N,N2,N1)-XQSFE1(N,N5,N4) - TQSFE2(N2,N1)=TQSFE2(N2,N1)+XQSFE2(N,N2,N1)-XQSFE2(N,N5,N4) - TQSFE3(N2,N1)=TQSFE3(N2,N1)+XQSFE3(N,N2,N1)-XQSFE3(N,N5,N4) - TQSFE4(N2,N1)=TQSFE4(N2,N1)+XQSFE4(N,N2,N1)-XQSFE4(N,N5,N4) - TQSFES(N2,N1)=TQSFES(N2,N1)+XQSFES(N,N2,N1)-XQSFES(N,N5,N4) - TQSCAO(N2,N1)=TQSCAO(N2,N1)+XQSCAO(N,N2,N1)-XQSCAO(N,N5,N4) - TQSCAC(N2,N1)=TQSCAC(N2,N1)+XQSCAC(N,N2,N1)-XQSCAC(N,N5,N4) - TQSCAH(N2,N1)=TQSCAH(N2,N1)+XQSCAH(N,N2,N1)-XQSCAH(N,N5,N4) - TQSCAS(N2,N1)=TQSCAS(N2,N1)+XQSCAS(N,N2,N1)-XQSCAS(N,N5,N4) - TQSMGO(N2,N1)=TQSMGO(N2,N1)+XQSMGO(N,N2,N1)-XQSMGO(N,N5,N4) - TQSMGC(N2,N1)=TQSMGC(N2,N1)+XQSMGC(N,N2,N1)-XQSMGC(N,N5,N4) - TQSMGH(N2,N1)=TQSMGH(N2,N1)+XQSMGH(N,N2,N1)-XQSMGH(N,N5,N4) - TQSMGS(N2,N1)=TQSMGS(N2,N1)+XQSMGS(N,N2,N1)-XQSMGS(N,N5,N4) - TQSNAC(N2,N1)=TQSNAC(N2,N1)+XQSNAC(N,N2,N1)-XQSNAC(N,N5,N4) - TQSNAS(N2,N1)=TQSNAS(N2,N1)+XQSNAS(N,N2,N1)-XQSNAS(N,N5,N4) - TQSKAS(N2,N1)=TQSKAS(N2,N1)+XQSKAS(N,N2,N1)-XQSKAS(N,N5,N4) - TQSH0P(N2,N1)=TQSH0P(N2,N1)+XQSH0P(N,N2,N1)-XQSH0P(N,N5,N4) - TQSH1P(N2,N1)=TQSH1P(N2,N1)+XQSH1P(N,N2,N1)-XQSH1P(N,N5,N4) - TQSH3P(N2,N1)=TQSH3P(N2,N1)+XQSH3P(N,N2,N1)-XQSH3P(N,N5,N4) - TQSF1P(N2,N1)=TQSF1P(N2,N1)+XQSF1P(N,N2,N1)-XQSF1P(N,N5,N4) - TQSF2P(N2,N1)=TQSF2P(N2,N1)+XQSF2P(N,N2,N1)-XQSF2P(N,N5,N4) - TQSC0P(N2,N1)=TQSC0P(N2,N1)+XQSC0P(N,N2,N1)-XQSC0P(N,N5,N4) - TQSC1P(N2,N1)=TQSC1P(N2,N1)+XQSC1P(N,N2,N1)-XQSC1P(N,N5,N4) - TQSC2P(N2,N1)=TQSC2P(N2,N1)+XQSC2P(N,N2,N1)-XQSC2P(N,N5,N4) - TQSM1P(N2,N1)=TQSM1P(N2,N1)+XQSM1P(N,N2,N1)-XQSM1P(N,N5,N4) - ENDIF -C -C TOTAL FLUXES FROM SEDIMENT TRANSPORT -C - IF(IERSN(NY,NX).NE.0)THEN - TSEDER(N2,N1)=TSEDER(N2,N1)+XSEDER(N,N2,N1)-XSEDER(N,N5,N4) - TSANER(N2,N1)=TSANER(N2,N1)+XSANER(N,N2,N1)-XSANER(N,N5,N4) - TSILER(N2,N1)=TSILER(N2,N1)+XSILER(N,N2,N1)-XSILER(N,N5,N4) - TCLAER(N2,N1)=TCLAER(N2,N1)+XCLAER(N,N2,N1)-XCLAER(N,N5,N4) - TCECER(N2,N1)=TCECER(N2,N1)+XCECER(N,N2,N1)-XCECER(N,N5,N4) - TAECER(N2,N1)=TAECER(N2,N1)+XAECER(N,N2,N1)-XAECER(N,N5,N4) - TNH4ER(N2,N1)=TNH4ER(N2,N1)+XNH4ER(N,N2,N1)-XNH4ER(N,N5,N4) - TNH3ER(N2,N1)=TNH3ER(N2,N1)+XNH3ER(N,N2,N1)-XNH3ER(N,N5,N4) - TNHUER(N2,N1)=TNHUER(N2,N1)+XNHUER(N,N2,N1)-XNHUER(N,N5,N4) - TNO3ER(N2,N1)=TNO3ER(N2,N1)+XNO3ER(N,N2,N1)-XNO3ER(N,N5,N4) - TNH4EB(N2,N1)=TNH4EB(N2,N1)+XNH4EB(N,N2,N1)-XNH4EB(N,N5,N4) - TNH3EB(N2,N1)=TNH3EB(N2,N1)+XNH3EB(N,N2,N1)-XNH3EB(N,N5,N4) - TNHUEB(N2,N1)=TNHUEB(N2,N1)+XNHUEB(N,N2,N1)-XNHUEB(N,N5,N4) - TNO3EB(N2,N1)=TNO3EB(N2,N1)+XNO3EB(N,N2,N1)-XNO3EB(N,N5,N4) - TN4ER(N2,N1)=TN4ER(N2,N1)+XN4ER(N,N2,N1)-XN4ER(N,N5,N4) - TNBER(N2,N1)=TNBER(N2,N1)+XNBER(N,N2,N1)-XNBER(N,N5,N4) - THYER(N2,N1)=THYER(N2,N1)+XHYER(N,N2,N1)-XHYER(N,N5,N4) - TALER(N2,N1)=TALER(N2,N1)+XALER(N,N2,N1)-XALER(N,N5,N4) - TCAER(N2,N1)=TCAER(N2,N1)+XCAER(N,N2,N1)-XCAER(N,N5,N4) - TMGER(N2,N1)=TMGER(N2,N1)+XMGER(N,N2,N1)-XMGER(N,N5,N4) - TNAER(N2,N1)=TNAER(N2,N1)+XNAER(N,N2,N1)-XNAER(N,N5,N4) - TKAER(N2,N1)=TKAER(N2,N1)+XKAER(N,N2,N1)-XKAER(N,N5,N4) - THCER(N2,N1)=THCER(N2,N1)+XHCER(N,N2,N1)-XHCER(N,N5,N4) - TAL2ER(N2,N1)=TAL2ER(N2,N1)+XAL2ER(N,N2,N1)-XAL2ER(N,N5,N4) - TOH0ER(N2,N1)=TOH0ER(N2,N1)+XOH0ER(N,N2,N1)-XOH0ER(N,N5,N4) - TOH1ER(N2,N1)=TOH1ER(N2,N1)+XOH1ER(N,N2,N1)-XOH1ER(N,N5,N4) - TOH2ER(N2,N1)=TOH2ER(N2,N1)+XOH2ER(N,N2,N1)-XOH2ER(N,N5,N4) - TH1PER(N2,N1)=TH1PER(N2,N1)+XH1PER(N,N2,N1)-XH1PER(N,N5,N4) - TH2PER(N2,N1)=TH2PER(N2,N1)+XH2PER(N,N2,N1)-XH2PER(N,N5,N4) - TOH0EB(N2,N1)=TOH0EB(N2,N1)+XOH0EB(N,N2,N1)-XOH0EB(N,N5,N4) - TOH1EB(N2,N1)=TOH1EB(N2,N1)+XOH1EB(N,N2,N1)-XOH1EB(N,N5,N4) - TOH2EB(N2,N1)=TOH2EB(N2,N1)+XOH2EB(N,N2,N1)-XOH2EB(N,N5,N4) - TH1PEB(N2,N1)=TH1PEB(N2,N1)+XH1PEB(N,N2,N1)-XH1PEB(N,N5,N4) - TH2PEB(N2,N1)=TH2PEB(N2,N1)+XH2PEB(N,N2,N1)-XH2PEB(N,N5,N4) - TALOER(N2,N1)=TALOER(N2,N1)+PALOER(N,N2,N1)-PALOER(N,N5,N4) - TFEOER(N2,N1)=TFEOER(N2,N1)+PFEOER(N,N2,N1)-PFEOER(N,N5,N4) - TCACER(N2,N1)=TCACER(N2,N1)+PCACER(N,N2,N1)-PCACER(N,N5,N4) - TCASER(N2,N1)=TCASER(N2,N1)+PCASER(N,N2,N1)-PCASER(N,N5,N4) - TALPER(N2,N1)=TALPER(N2,N1)+PALPER(N,N2,N1)-PALPER(N,N5,N4) - TFEPER(N2,N1)=TFEPER(N2,N1)+PFEPER(N,N2,N1)-PFEPER(N,N5,N4) - TCPDER(N2,N1)=TCPDER(N2,N1)+PCPDER(N,N2,N1)-PCPDER(N,N5,N4) - TCPHER(N2,N1)=TCPHER(N2,N1)+PCPHER(N,N2,N1)-PCPHER(N,N5,N4) - TCPMER(N2,N1)=TCPMER(N2,N1)+PCPMER(N,N2,N1)-PCPMER(N,N5,N4) - TALPEB(N2,N1)=TALPEB(N2,N1)+PALPEB(N,N2,N1)-PALPEB(N,N5,N4) - TFEPEB(N2,N1)=TFEPEB(N2,N1)+PFEPEB(N,N2,N1)-PFEPEB(N,N5,N4) - TCPDEB(N2,N1)=TCPDEB(N2,N1)+PCPDEB(N,N2,N1)-PCPDEB(N,N5,N4) - TCPHEB(N2,N1)=TCPHEB(N2,N1)+PCPHEB(N,N2,N1)-PCPHEB(N,N5,N4) - TCPMEB(N2,N1)=TCPMEB(N2,N1)+PCPMEB(N,N2,N1)-PCPMEB(N,N5,N4) - DO 9380 K=0,5 - DO 9380 NN=1,7 - TOMCER(3,NN,K,N2,N1)=TOMCER(3,NN,K,N2,N1) - 2+OMCER(3,NN,K,N,N2,N1)-OMCER(3,NN,K,N,N5,N4) - DO 9380 M=1,2 - TOMCER(M,NN,K,N2,N1)=TOMCER(M,NN,K,N2,N1) - 2+OMCER(M,NN,K,N,N2,N1)-OMCER(M,NN,K,N,N5,N4) - TOMNER(M,NN,K,N2,N1)=TOMNER(M,NN,K,N2,N1) - 2+OMNER(M,NN,K,N,N2,N1)-OMNER(M,NN,K,N,N5,N4) - TOMPER(M,NN,K,N2,N1)=TOMPER(M,NN,K,N2,N1) - 2+OMPER(M,NN,K,N,N2,N1)-OMPER(M,NN,K,N,N5,N4) -9380 CONTINUE - DO 9375 K=0,4 - DO 9370 M=1,2 - TORCER(M,K,N2,N1)=TORCER(M,K,N2,N1) - 2+ORCER(M,K,N,N2,N1)-ORCER(M,K,N,N5,N4) - TORNER(M,K,N2,N1)=TORNER(M,K,N2,N1) - 2+ORNER(M,K,N,N2,N1)-ORNER(M,K,N,N5,N4) - TORPER(M,K,N2,N1)=TORPER(M,K,N2,N1) - 2+ORPER(M,K,N,N2,N1)-ORPER(M,K,N,N5,N4) -9370 CONTINUE - TOHCER(K,N2,N1)=TOHCER(K,N2,N1) - 2+OHCER(K,N,N2,N1)-OHCER(K,N,N5,N4) - TOHNER(K,N2,N1)=TOHNER(K,N2,N1) - 2+OHNER(K,N,N2,N1)-OHNER(K,N,N5,N4) - TOHPER(K,N2,N1)=TOHPER(K,N2,N1) - 2+OHPER(K,N,N2,N1)-OHPER(K,N,N5,N4) - DO 9365 M=1,4 - TOSCER(M,K,N2,N1)=TOSCER(M,K,N2,N1) - 2+OSCER(M,K,N,N2,N1)-OSCER(M,K,N,N5,N4) - TOSAER(M,K,N2,N1)=TOSAER(M,K,N2,N1) - 2+OSAER(M,K,N,N2,N1)-OSAER(M,K,N,N5,N4) - TOSNER(M,K,N2,N1)=TOSNER(M,K,N2,N1) - 2+OSNER(M,K,N,N2,N1)-OSNER(M,K,N,N5,N4) - TOSPER(M,K,N2,N1)=TOSPER(M,K,N2,N1) - 2+OSPER(M,K,N,N2,N1)-OSPER(M,K,N,N5,N4) -9365 CONTINUE -9375 CONTINUE - ENDIF - ENDIF -C -C TOTAL HEAT, WATER, GAS AND SOLUTE FLUXES BETWEEN ADJACENT -C GRID CELLS -C - IF(NCN(N2,N1).NE.3.OR.N.EQ.3)THEN - TTHAW(N3,N2,N1)=TTHAW(N3,N2,N1)+THAW(N,N3,N2,N1) - TTHAWH(N3,N2,N1)=TTHAWH(N3,N2,N1)+THAWH(N,N3,N2,N1) - THTHAW(N3,N2,N1)=THTHAW(N3,N2,N1)+HTHAW(N,N3,N2,N1) - TFLW(N3,N2,N1)=TFLW(N3,N2,N1)+FLW(N,N3,N2,N1)-FLW(N,N6,N5,N4) - TFLWX(N3,N2,N1)=TFLWX(N3,N2,N1)+FLWX(N,N3,N2,N1)-FLWX(N,N6,N5,N4) - TFLWH(N3,N2,N1)=TFLWH(N3,N2,N1)+FLWH(N,N3,N2,N1)-FLWH(N,N6,N5,N4) - THFLW(N3,N2,N1)=THFLW(N3,N2,N1)+HFLW(N,N3,N2,N1)-HFLW(N,N6,N5,N4) - DO 8585 K=0,4 - TOCFLS(K,N3,N2,N1)=TOCFLS(K,N3,N2,N1)+XOCFLS(K,N,N3,N2,N1) - 2-XOCFLS(K,N,N6,N5,N4) - TONFLS(K,N3,N2,N1)=TONFLS(K,N3,N2,N1)+XONFLS(K,N,N3,N2,N1) - 2-XONFLS(K,N,N6,N5,N4) - TOPFLS(K,N3,N2,N1)=TOPFLS(K,N3,N2,N1)+XOPFLS(K,N,N3,N2,N1) - 2-XOPFLS(K,N,N6,N5,N4) - TOAFLS(K,N3,N2,N1)=TOAFLS(K,N3,N2,N1)+XOAFLS(K,N,N3,N2,N1) - 2-XOAFLS(K,N,N6,N5,N4) - TOCFHS(K,N3,N2,N1)=TOCFHS(K,N3,N2,N1)+XOCFHS(K,N,N3,N2,N1) - 2-XOCFHS(K,N,N6,N5,N4) - TONFHS(K,N3,N2,N1)=TONFHS(K,N3,N2,N1)+XONFHS(K,N,N3,N2,N1) - 2-XONFHS(K,N,N6,N5,N4) - TOPFHS(K,N3,N2,N1)=TOPFHS(K,N3,N2,N1)+XOPFHS(K,N,N3,N2,N1) - 2-XOPFHS(K,N,N6,N5,N4) - TOAFHS(K,N3,N2,N1)=TOAFHS(K,N3,N2,N1)+XOAFHS(K,N,N3,N2,N1) - 2-XOAFHS(K,N,N6,N5,N4) -8585 CONTINUE - TCOFLS(N3,N2,N1)=TCOFLS(N3,N2,N1)+XCOFLS(N,N3,N2,N1) - 2-XCOFLS(N,N6,N5,N4) - TCHFLS(N3,N2,N1)=TCHFLS(N3,N2,N1)+XCHFLS(N,N3,N2,N1) - 2-XCHFLS(N,N6,N5,N4) - TOXFLS(N3,N2,N1)=TOXFLS(N3,N2,N1)+XOXFLS(N,N3,N2,N1) - 2-XOXFLS(N,N6,N5,N4) - TNGFLS(N3,N2,N1)=TNGFLS(N3,N2,N1)+XNGFLS(N,N3,N2,N1) - 2-XNGFLS(N,N6,N5,N4) - TN2FLS(N3,N2,N1)=TN2FLS(N3,N2,N1)+XN2FLS(N,N3,N2,N1) - 2-XN2FLS(N,N6,N5,N4) - THGFLS(N3,N2,N1)=THGFLS(N3,N2,N1)+XHGFLS(N,N3,N2,N1) - 2-XHGFLS(N,N6,N5,N4) - TN4FLS(N3,N2,N1)=TN4FLS(N3,N2,N1)+XN4FLW(N,N3,N2,N1) - 2-XN4FLW(N,N6,N5,N4) - TN3FLS(N3,N2,N1)=TN3FLS(N3,N2,N1)+XN3FLW(N,N3,N2,N1) - 2-XN3FLW(N,N6,N5,N4) - TNOFLS(N3,N2,N1)=TNOFLS(N3,N2,N1)+XNOFLW(N,N3,N2,N1) - 2-XNOFLW(N,N6,N5,N4) - TNXFLS(N3,N2,N1)=TNXFLS(N3,N2,N1)+XNXFLS(N,N3,N2,N1) - 2-XNXFLS(N,N6,N5,N4) - TPOFLS(N3,N2,N1)=TPOFLS(N3,N2,N1)+XH2PFS(N,N3,N2,N1) - 2-XH2PFS(N,N6,N5,N4) - TN4FLB(N3,N2,N1)=TN4FLB(N3,N2,N1)+XN4FLB(N,N3,N2,N1) - 2-XN4FLB(N,N6,N5,N4) - TN3FLB(N3,N2,N1)=TN3FLB(N3,N2,N1)+XN3FLB(N,N3,N2,N1) - 2-XN3FLB(N,N6,N5,N4) - TNOFLB(N3,N2,N1)=TNOFLB(N3,N2,N1)+XNOFLB(N,N3,N2,N1) - 2-XNOFLB(N,N6,N5,N4) - TNXFLB(N3,N2,N1)=TNXFLB(N3,N2,N1)+XNXFLB(N,N3,N2,N1) - 2-XNXFLB(N,N6,N5,N4) - TH2BFB(N3,N2,N1)=TH2BFB(N3,N2,N1)+XH2BFB(N,N3,N2,N1) - 2-XH2BFB(N,N6,N5,N4) - TCOFHS(N3,N2,N1)=TCOFHS(N3,N2,N1)+XCOFHS(N,N3,N2,N1) - 2-XCOFHS(N,N6,N5,N4) - TCHFHS(N3,N2,N1)=TCHFHS(N3,N2,N1)+XCHFHS(N,N3,N2,N1) - 2-XCHFHS(N,N6,N5,N4) - TOXFHS(N3,N2,N1)=TOXFHS(N3,N2,N1)+XOXFHS(N,N3,N2,N1) - 2-XOXFHS(N,N6,N5,N4) - TNGFHS(N3,N2,N1)=TNGFHS(N3,N2,N1)+XNGFHS(N,N3,N2,N1) - 2-XNGFHS(N,N6,N5,N4) - TN2FHS(N3,N2,N1)=TN2FHS(N3,N2,N1)+XN2FHS(N,N3,N2,N1) - 2-XN2FHS(N,N6,N5,N4) - THGFHS(N3,N2,N1)=THGFHS(N3,N2,N1)+XHGFHS(N,N3,N2,N1) - 2-XHGFHS(N,N6,N5,N4) - TN4FHS(N3,N2,N1)=TN4FHS(N3,N2,N1)+XN4FHW(N,N3,N2,N1) - 2-XN4FHW(N,N6,N5,N4) - TN3FHS(N3,N2,N1)=TN3FHS(N3,N2,N1)+XN3FHW(N,N3,N2,N1) - 2-XN3FHW(N,N6,N5,N4) - TNOFHS(N3,N2,N1)=TNOFHS(N3,N2,N1)+XNOFHW(N,N3,N2,N1) - 2-XNOFHW(N,N6,N5,N4) - TNXFHS(N3,N2,N1)=TNXFHS(N3,N2,N1)+XNXFHS(N,N3,N2,N1) - 2-XNXFHS(N,N6,N5,N4) - TPOFHS(N3,N2,N1)=TPOFHS(N3,N2,N1)+XH2PHS(N,N3,N2,N1) - 2-XH2PHS(N,N6,N5,N4) - TN4FHB(N3,N2,N1)=TN4FHB(N3,N2,N1)+XN4FHB(N,N3,N2,N1) - 2-XN4FHB(N,N6,N5,N4) - TN3FHB(N3,N2,N1)=TN3FHB(N3,N2,N1)+XN3FHB(N,N3,N2,N1) - 2-XN3FHB(N,N6,N5,N4) - TNOFHB(N3,N2,N1)=TNOFHB(N3,N2,N1)+XNOFHB(N,N3,N2,N1) - 2-XNOFHB(N,N6,N5,N4) - TNXFHB(N3,N2,N1)=TNXFHB(N3,N2,N1)+XNXFHB(N,N3,N2,N1) - 2-XNXFHB(N,N6,N5,N4) - TH2BHB(N3,N2,N1)=TH2BHB(N3,N2,N1)+XH2BHB(N,N3,N2,N1) - 2-XH2BHB(N,N6,N5,N4) - TCOFLG(N3,N2,N1)=TCOFLG(N3,N2,N1)+XCOFLG(N,N3,N2,N1) - 2-XCOFLG(N,N6,N5,N4) - TCHFLG(N3,N2,N1)=TCHFLG(N3,N2,N1)+XCHFLG(N,N3,N2,N1) - 2-XCHFLG(N,N6,N5,N4) - TOXFLG(N3,N2,N1)=TOXFLG(N3,N2,N1)+XOXFLG(N,N3,N2,N1) - 2-XOXFLG(N,N6,N5,N4) - TNGFLG(N3,N2,N1)=TNGFLG(N3,N2,N1)+XNGFLG(N,N3,N2,N1) - 2-XNGFLG(N,N6,N5,N4) - TN2FLG(N3,N2,N1)=TN2FLG(N3,N2,N1)+XN2FLG(N,N3,N2,N1) - 2-XN2FLG(N,N6,N5,N4) - TNHFLG(N3,N2,N1)=TNHFLG(N3,N2,N1)+XN3FLG(N,N3,N2,N1) - 2-XN3FLG(N,N6,N5,N4) - THGFLG(N3,N2,N1)=THGFLG(N3,N2,N1)+XHGFLG(N,N3,N2,N1) - 2-XHGFLG(N,N6,N5,N4) - IF(ISALT(N2,N1).NE.0)THEN - TALFLS(N3,N2,N1)=TALFLS(N3,N2,N1)+XALFLS(N,N3,N2,N1) - 2-XALFLS(N,N6,N5,N4) - TFEFLS(N3,N2,N1)=TFEFLS(N3,N2,N1)+XFEFLS(N,N3,N2,N1) - 2-XFEFLS(N,N6,N5,N4) - THYFLS(N3,N2,N1)=THYFLS(N3,N2,N1)+XHYFLS(N,N3,N2,N1) - 2-XHYFLS(N,N6,N5,N4) - TCAFLS(N3,N2,N1)=TCAFLS(N3,N2,N1)+XCAFLS(N,N3,N2,N1) - 2-XCAFLS(N,N6,N5,N4) - TMGFLS(N3,N2,N1)=TMGFLS(N3,N2,N1)+XMGFLS(N,N3,N2,N1) - 2-XMGFLS(N,N6,N5,N4) - TNAFLS(N3,N2,N1)=TNAFLS(N3,N2,N1)+XNAFLS(N,N3,N2,N1) - 2-XNAFLS(N,N6,N5,N4) - TKAFLS(N3,N2,N1)=TKAFLS(N3,N2,N1)+XKAFLS(N,N3,N2,N1) - 2-XKAFLS(N,N6,N5,N4) - TOHFLS(N3,N2,N1)=TOHFLS(N3,N2,N1)+XOHFLS(N,N3,N2,N1) - 2-XOHFLS(N,N6,N5,N4) - TSOFLS(N3,N2,N1)=TSOFLS(N3,N2,N1)+XSOFLS(N,N3,N2,N1) - 2-XSOFLS(N,N6,N5,N4) - TCLFLS(N3,N2,N1)=TCLFLS(N3,N2,N1)+XCLFLS(N,N3,N2,N1) - 2-XCLFLS(N,N6,N5,N4) - TC3FLS(N3,N2,N1)=TC3FLS(N3,N2,N1)+XC3FLS(N,N3,N2,N1) - 2-XC3FLS(N,N6,N5,N4) - THCFLS(N3,N2,N1)=THCFLS(N3,N2,N1)+XHCFLS(N,N3,N2,N1) - 2-XHCFLS(N,N6,N5,N4) - TAL1FS(N3,N2,N1)=TAL1FS(N3,N2,N1)+XAL1FS(N,N3,N2,N1) - 2-XAL1FS(N,N6,N5,N4) - TAL2FS(N3,N2,N1)=TAL2FS(N3,N2,N1)+XAL2FS(N,N3,N2,N1) - 2-XAL2FS(N,N6,N5,N4) - TAL3FS(N3,N2,N1)=TAL3FS(N3,N2,N1)+XAL3FS(N,N3,N2,N1) - 2-XAL3FS(N,N6,N5,N4) - TAL4FS(N3,N2,N1)=TAL4FS(N3,N2,N1)+XAL4FS(N,N3,N2,N1) - 2-XAL4FS(N,N6,N5,N4) - TALSFS(N3,N2,N1)=TALSFS(N3,N2,N1)+XALSFS(N,N3,N2,N1) - 2-XALSFS(N,N6,N5,N4) - TFE1FS(N3,N2,N1)=TFE1FS(N3,N2,N1)+XFE1FS(N,N3,N2,N1) - 2-XFE1FS(N,N6,N5,N4) - TFE2FS(N3,N2,N1)=TFE2FS(N3,N2,N1)+XFE2FS(N,N3,N2,N1) - 2-XFE2FS(N,N6,N5,N4) - TFE3FS(N3,N2,N1)=TFE3FS(N3,N2,N1)+XFE3FS(N,N3,N2,N1) - 2-XFE3FS(N,N6,N5,N4) - TFE4FS(N3,N2,N1)=TFE4FS(N3,N2,N1)+XFE4FS(N,N3,N2,N1) - 2-XFE4FS(N,N6,N5,N4) - TFESFS(N3,N2,N1)=TFESFS(N3,N2,N1)+XFESFS(N,N3,N2,N1) - 2-XFESFS(N,N6,N5,N4) - TCAOFS(N3,N2,N1)=TCAOFS(N3,N2,N1)+XCAOFS(N,N3,N2,N1) - 2-XCAOFS(N,N6,N5,N4) - TCACFS(N3,N2,N1)=TCACFS(N3,N2,N1)+XCACFS(N,N3,N2,N1) - 2-XCACFS(N,N6,N5,N4) - TCAHFS(N3,N2,N1)=TCAHFS(N3,N2,N1)+XCAHFS(N,N3,N2,N1) - 2-XCAHFS(N,N6,N5,N4) - TCASFS(N3,N2,N1)=TCASFS(N3,N2,N1)+XCASFS(N,N3,N2,N1) - 2-XCASFS(N,N6,N5,N4) - TMGOFS(N3,N2,N1)=TMGOFS(N3,N2,N1)+XMGOFS(N,N3,N2,N1) - 2-XMGOFS(N,N6,N5,N4) - TMGCFS(N3,N2,N1)=TMGCFS(N3,N2,N1)+XMGCFS(N,N3,N2,N1) - 2-XMGCFS(N,N6,N5,N4) - TMGHFS(N3,N2,N1)=TMGHFS(N3,N2,N1)+XMGHFS(N,N3,N2,N1) - 2-XMGHFS(N,N6,N5,N4) - TMGSFS(N3,N2,N1)=TMGSFS(N3,N2,N1)+XMGSFS(N,N3,N2,N1) - 2-XMGSFS(N,N6,N5,N4) - TNACFS(N3,N2,N1)=TNACFS(N3,N2,N1)+XNACFS(N,N3,N2,N1) - 2-XNACFS(N,N6,N5,N4) - TNASFS(N3,N2,N1)=TNASFS(N3,N2,N1)+XNASFS(N,N3,N2,N1) - 2-XNASFS(N,N6,N5,N4) - TKASFS(N3,N2,N1)=TKASFS(N3,N2,N1)+XKASFS(N,N3,N2,N1) - 2-XKASFS(N,N6,N5,N4) - TH0PFS(N3,N2,N1)=TH0PFS(N3,N2,N1)+XH0PFS(N,N3,N2,N1) - 2-XH0PFS(N,N6,N5,N4) - TH1PFS(N3,N2,N1)=TH1PFS(N3,N2,N1)+XH1PFS(N,N3,N2,N1) - 2-XH1PFS(N,N6,N5,N4) - TH3PFS(N3,N2,N1)=TH3PFS(N3,N2,N1)+XH3PFS(N,N3,N2,N1) - 2-XH3PFS(N,N6,N5,N4) - TF1PFS(N3,N2,N1)=TF1PFS(N3,N2,N1)+XF1PFS(N,N3,N2,N1) - 2-XF1PFS(N,N6,N5,N4) - TF2PFS(N3,N2,N1)=TF2PFS(N3,N2,N1)+XF2PFS(N,N3,N2,N1) - 2-XF2PFS(N,N6,N5,N4) - TC0PFS(N3,N2,N1)=TC0PFS(N3,N2,N1)+XC0PFS(N,N3,N2,N1) - 2-XC0PFS(N,N6,N5,N4) - TC1PFS(N3,N2,N1)=TC1PFS(N3,N2,N1)+XC1PFS(N,N3,N2,N1) - 2-XC1PFS(N,N6,N5,N4) - TC2PFS(N3,N2,N1)=TC2PFS(N3,N2,N1)+XC2PFS(N,N3,N2,N1) - 2-XC2PFS(N,N6,N5,N4) - TM1PFS(N3,N2,N1)=TM1PFS(N3,N2,N1)+XM1PFS(N,N3,N2,N1) - 2-XM1PFS(N,N6,N5,N4) - TH0BFB(N3,N2,N1)=TH0BFB(N3,N2,N1)+XH0BFB(N,N3,N2,N1) - 2-XH0BFB(N,N6,N5,N4) - TH1BFB(N3,N2,N1)=TH1BFB(N3,N2,N1)+XH1BFB(N,N3,N2,N1) - 2-XH1BFB(N,N6,N5,N4) - TH3BFB(N3,N2,N1)=TH3BFB(N3,N2,N1)+XH3BFB(N,N3,N2,N1) - 2-XH3BFB(N,N6,N5,N4) - TF1BFB(N3,N2,N1)=TF1BFB(N3,N2,N1)+XF1BFB(N,N3,N2,N1) - 2-XF1BFB(N,N6,N5,N4) - TF2BFB(N3,N2,N1)=TF2BFB(N3,N2,N1)+XF2BFB(N,N3,N2,N1) - 2-XF2BFB(N,N6,N5,N4) - TC0BFB(N3,N2,N1)=TC0BFB(N3,N2,N1)+XC0BFB(N,N3,N2,N1) - 2-XC0BFB(N,N6,N5,N4) - TC1BFB(N3,N2,N1)=TC1BFB(N3,N2,N1)+XC1BFB(N,N3,N2,N1) - 2-XC1BFB(N,N6,N5,N4) - TC2BFB(N3,N2,N1)=TC2BFB(N3,N2,N1)+XC2BFB(N,N3,N2,N1) - 2-XC2BFB(N,N6,N5,N4) - TM1BFB(N3,N2,N1)=TM1BFB(N3,N2,N1)+XM1BFB(N,N3,N2,N1) - 2-XM1BFB(N,N6,N5,N4) - TALFHS(N3,N2,N1)=TALFHS(N3,N2,N1)+XALFHS(N,N3,N2,N1) - 2-XALFHS(N,N6,N5,N4) - TFEFHS(N3,N2,N1)=TFEFHS(N3,N2,N1)+XFEFHS(N,N3,N2,N1) - 2-XFEFHS(N,N6,N5,N4) - THYFHS(N3,N2,N1)=THYFHS(N3,N2,N1)+XHYFHS(N,N3,N2,N1) - 2-XHYFHS(N,N6,N5,N4) - TCAFHS(N3,N2,N1)=TCAFHS(N3,N2,N1)+XCAFHS(N,N3,N2,N1) - 2-XCAFHS(N,N6,N5,N4) - TMGFHS(N3,N2,N1)=TMGFHS(N3,N2,N1)+XMGFHS(N,N3,N2,N1) - 2-XMGFHS(N,N6,N5,N4) - TNAFHS(N3,N2,N1)=TNAFHS(N3,N2,N1)+XNAFHS(N,N3,N2,N1) - 2-XNAFHS(N,N6,N5,N4) - TKAFHS(N3,N2,N1)=TKAFHS(N3,N2,N1)+XKAFHS(N,N3,N2,N1) - 2-XKAFHS(N,N6,N5,N4) - TOHFHS(N3,N2,N1)=TOHFHS(N3,N2,N1)+XOHFHS(N,N3,N2,N1) - 2-XOHFHS(N,N6,N5,N4) - TSOFHS(N3,N2,N1)=TSOFHS(N3,N2,N1)+XSOFHS(N,N3,N2,N1) - 2-XSOFHS(N,N6,N5,N4) - TCLFHS(N3,N2,N1)=TCLFHS(N3,N2,N1)+XCLFHS(N,N3,N2,N1) - 2-XCLFHS(N,N6,N5,N4) - TC3FHS(N3,N2,N1)=TC3FHS(N3,N2,N1)+XC3FHS(N,N3,N2,N1) - 2-XC3FHS(N,N6,N5,N4) - THCFHS(N3,N2,N1)=THCFHS(N3,N2,N1)+XHCFHS(N,N3,N2,N1) - 2-XHCFHS(N,N6,N5,N4) - TAL1HS(N3,N2,N1)=TAL1HS(N3,N2,N1)+XAL1HS(N,N3,N2,N1) - 2-XAL1HS(N,N6,N5,N4) - TAL2HS(N3,N2,N1)=TAL2HS(N3,N2,N1)+XAL2HS(N,N3,N2,N1) - 2-XAL2HS(N,N6,N5,N4) - TAL3HS(N3,N2,N1)=TAL3HS(N3,N2,N1)+XAL3HS(N,N3,N2,N1) - 2-XAL3HS(N,N6,N5,N4) - TAL4HS(N3,N2,N1)=TAL4HS(N3,N2,N1)+XAL4HS(N,N3,N2,N1) - 2-XAL4HS(N,N6,N5,N4) - TALSHS(N3,N2,N1)=TALSHS(N3,N2,N1)+XALSHS(N,N3,N2,N1) - 2-XALSHS(N,N6,N5,N4) - TFE1HS(N3,N2,N1)=TFE1HS(N3,N2,N1)+XFE1HS(N,N3,N2,N1) - 2-XFE1HS(N,N6,N5,N4) - TFE2HS(N3,N2,N1)=TFE2HS(N3,N2,N1)+XFE2HS(N,N3,N2,N1) - 2-XFE2HS(N,N6,N5,N4) - TFE3HS(N3,N2,N1)=TFE3HS(N3,N2,N1)+XFE3HS(N,N3,N2,N1) - 2-XFE3HS(N,N6,N5,N4) - TFE4HS(N3,N2,N1)=TFE4HS(N3,N2,N1)+XFE4HS(N,N3,N2,N1) - 2-XFE4HS(N,N6,N5,N4) - TFESHS(N3,N2,N1)=TFESHS(N3,N2,N1)+XFESHS(N,N3,N2,N1) - 2-XFESHS(N,N6,N5,N4) - TCAOHS(N3,N2,N1)=TCAOHS(N3,N2,N1)+XCAOHS(N,N3,N2,N1) - 2-XCAOHS(N,N6,N5,N4) - TCACHS(N3,N2,N1)=TCACHS(N3,N2,N1)+XCACHS(N,N3,N2,N1) - 2-XCACHS(N,N6,N5,N4) - TCAHHS(N3,N2,N1)=TCAHHS(N3,N2,N1)+XCAHHS(N,N3,N2,N1) - 2-XCAHHS(N,N6,N5,N4) - TCASHS(N3,N2,N1)=TCASHS(N3,N2,N1)+XCASHS(N,N3,N2,N1) - 2-XCASHS(N,N6,N5,N4) - TMGOHS(N3,N2,N1)=TMGOHS(N3,N2,N1)+XMGOHS(N,N3,N2,N1) - 2-XMGOHS(N,N6,N5,N4) - TMGCHS(N3,N2,N1)=TMGCHS(N3,N2,N1)+XMGCHS(N,N3,N2,N1) - 2-XMGCHS(N,N6,N5,N4) - TMGHHS(N3,N2,N1)=TMGHHS(N3,N2,N1)+XMGHHS(N,N3,N2,N1) - 2-XMGHHS(N,N6,N5,N4) - TMGSHS(N3,N2,N1)=TMGSHS(N3,N2,N1)+XMGSHS(N,N3,N2,N1) - 2-XMGSHS(N,N6,N5,N4) - TNACHS(N3,N2,N1)=TNACHS(N3,N2,N1)+XNACHS(N,N3,N2,N1) - 2-XNACHS(N,N6,N5,N4) - TNASHS(N3,N2,N1)=TNASHS(N3,N2,N1)+XNASHS(N,N3,N2,N1) - 2-XNASHS(N,N6,N5,N4) - TKASHS(N3,N2,N1)=TKASHS(N3,N2,N1)+XKASHS(N,N3,N2,N1) - 2-XKASHS(N,N6,N5,N4) - TH0PHS(N3,N2,N1)=TH0PHS(N3,N2,N1)+XH0PHS(N,N3,N2,N1) - 2-XH0PHS(N,N6,N5,N4) - TH1PHS(N3,N2,N1)=TH1PHS(N3,N2,N1)+XH1PHS(N,N3,N2,N1) - 2-XH1PHS(N,N6,N5,N4) - TH3PHS(N3,N2,N1)=TH3PHS(N3,N2,N1)+XH3PHS(N,N3,N2,N1) - 2-XH3PHS(N,N6,N5,N4) - TF1PHS(N3,N2,N1)=TF1PHS(N3,N2,N1)+XF1PHS(N,N3,N2,N1) - 2-XF1PHS(N,N6,N5,N4) - TF2PHS(N3,N2,N1)=TF2PHS(N3,N2,N1)+XF2PHS(N,N3,N2,N1) - 2-XF2PHS(N,N6,N5,N4) - TC0PHS(N3,N2,N1)=TC0PHS(N3,N2,N1)+XC0PHS(N,N3,N2,N1) - 2-XC0PHS(N,N6,N5,N4) - TC1PHS(N3,N2,N1)=TC1PHS(N3,N2,N1)+XC1PHS(N,N3,N2,N1) - 2-XC1PHS(N,N6,N5,N4) - TC2PHS(N3,N2,N1)=TC2PHS(N3,N2,N1)+XC2PHS(N,N3,N2,N1) - 2-XC2PHS(N,N6,N5,N4) - TM1PHS(N3,N2,N1)=TM1PHS(N3,N2,N1)+XM1PHS(N,N3,N2,N1) - 2-XM1PHS(N,N6,N5,N4) - TH0BHB(N3,N2,N1)=TH0BHB(N3,N2,N1)+XH0BHB(N,N3,N2,N1) - 2-XH0BHB(N,N6,N5,N4) - TH1BHB(N3,N2,N1)=TH1BHB(N3,N2,N1)+XH1BHB(N,N3,N2,N1) - 2-XH1BHB(N,N6,N5,N4) - TH3BHB(N3,N2,N1)=TH3BHB(N3,N2,N1)+XH3BHB(N,N3,N2,N1) - 2-XH3BHB(N,N6,N5,N4) - TF1BHB(N3,N2,N1)=TF1BHB(N3,N2,N1)+XF1BHB(N,N3,N2,N1) - 2-XF1BHB(N,N6,N5,N4) - TF2BHB(N3,N2,N1)=TF2BHB(N3,N2,N1)+XF2BHB(N,N3,N2,N1) - 2-XF2BHB(N,N6,N5,N4) - TC0BHB(N3,N2,N1)=TC0BHB(N3,N2,N1)+XC0BHB(N,N3,N2,N1) - 2-XC0BHB(N,N6,N5,N4) - TC1BHB(N3,N2,N1)=TC1BHB(N3,N2,N1)+XC1BHB(N,N3,N2,N1) - 2-XC1BHB(N,N6,N5,N4) - TC2BHB(N3,N2,N1)=TC2BHB(N3,N2,N1)+XC2BHB(N,N3,N2,N1) - 2-XC2BHB(N,N6,N5,N4) - TM1BHB(N3,N2,N1)=TM1BHB(N3,N2,N1)+XM1BHB(N,N3,N2,N1) - 2-XM1BHB(N,N6,N5,N4) - ENDIF - ENDIF -8580 CONTINUE -8575 CONTINUE -C -C CALCULATE SURFACE RESIDUE TEMPERATURE FROM ITS CHANGE -C IN HEAT STORAGE -C - HFLXD=2.496E-06*(OSGX-ORGC(0,NY,NX))*TKS(0,NY,NX) - VOLW(0,NY,NX)=VOLW(0,NY,NX)+FLWR(NY,NX)+THAWR(NY,NX) - 2+TQR(NY,NX)+18.0E-06*TRH2O(0,NY,NX) - VOLI(0,NY,NX)=VOLI(0,NY,NX)-THAWR(NY,NX)/0.92 - ENGYR=VHCPR(NY,NX)*TKS(0,NY,NX)-HFLXD - VHCPR(NY,NX)=2.496E-06*ORGC(0,NY,NX)+4.19*VOLW(0,NY,NX) - 2+1.9274*VOLI(0,NY,NX) - IF(VHCPR(NY,NX).GT.ZEROS(NY,NX))THEN - TKS(0,NY,NX)=(ENGYR+HFLWR(NY,NX)+HTHAWR(NY,NX) - 2+THQR(NY,NX))/VHCPR(NY,NX) - ELSE - TKS(0,NY,NX)=TKS(NU(NY,NX),NY,NX) - ENDIF - IF(VHCPR(NY,NX).LT.VHCPRX(NY,NX))THEN - HFLXR=VHCPR(NY,NX)*(TKS(0,NY,NX)-TKS(NU(NY,NX),NY,NX)) - HEATOU=HEATOU+HFLXR - TKS(0,NY,NX)=TKS(NU(NY,NX),NY,NX) - ENDIF - HEATIN=HEATIN+HTHAWR(NY,NX)-HFLXD -C UVOLW(NY,NX)=UVOLW(NY,NX)-VOLW(0,NY,NX)-VOLI(0,NY,NX)*0.92 -C -C SURFACE BOUNDARY WATER FLUXES -C - WI=PRECQ(NY,NX)+PRECI(NY,NX) - CRAIN=CRAIN+WI - URAIN(NY,NX)=URAIN(NY,NX)+WI - WO=TEVAPG(NY,NX)+TEVAPP(NY,NX) - CEVAP=CEVAP-WO - UEVAP(NY,NX)=UEVAP(NY,NX)-WO - VOLWOU=VOLWOU-PRECU(NY,NX)-18.0E-06*TRH2O(0,NY,NX) - HVOLO(NY,NX)=HVOLO(NY,NX)-PRECU(NY,NX) - UVOLO(NY,NX)=UVOLO(NY,NX)-PRECU(NY,NX) - UDRAIN(NY,NX)=UDRAIN(NY,NX)+FLW(3,NK(NY,NX),NY,NX) -C -C SURFACE BOUNDARY HEAT FLUXES -C - HEATIN=HEATIN+4.19*TKA(NY,NX)*PRECA(NY,NX) - 2+2.095*TKA(NY,NX)*PRECW(NY,NX) - HEATIN=HEATIN+HEATH(NY,NX)+HTHAWW(NY,NX)+THFLXC(NY,NX) - HEATOU=HEATOU-4.19*TKA(NY,NX)*PRECU(NY,NX) -C WRITE(*,5151)'TK0',I,J,NX,NY,TKS(0,NY,NX),ENGYR -C 2,HFLWR(NY,NX),HFLXD,HTHAWR(NY,NX),VHCPR(NY,NX),VOLW(0,NY,NX) -C 3,VOLI(0,NY,NX),FLWR(NY,NX),THAWR(NY,NX),TRH2O(0,NY,NX) -C 3,ORGC(0,NY,NX),VHCPR(NY,NX)*TKS(0,NY,NX),TQR(NY,NX) -C 4,THQR(NY,NX),HEATH(NY,NX),HTHAWW(NY,NX),THFLXC(NY,NX),HEATIN -5151 FORMAT(A8,4I4,30F20.6) -C -C SURFACE BOUNDARY CO2, CH4 AND DOC FLUXES -C - CI=XCODFS(NY,NX)+XCOFLG(3,NU(NY,NX),NY,NX)+TCO2Z(NY,NX) - 2+(FLQGQ(NY,NX)+FLQRQ(NY,NX))*CCOR(NY,NX) - 3+(FLQGI(NY,NX)+FLQRI(NY,NX))*CCOQ(NY,NX) - 4+XCODFG(0,NY,NX)+XCODFR(NY,NX) - CH=XCHDFS(NY,NX)+XCHFLG(3,NU(NY,NX),NY,NX)+TCH4Z(NY,NX) - 2+(FLQGQ(NY,NX)+FLQRQ(NY,NX))*CCHR(NY,NX) - 3+(FLQGI(NY,NX)+FLQRI(NY,NX))*CCHQ(NY,NX) - 4+XCHDFG(0,NY,NX)+XCHDFR(NY,NX) - CO=-PRECU(NY,NX)*CCOQ(NY,NX) - CX=-PRECU(NY,NX)*CCHQ(NY,NX) - UCO2G(NY,NX)=UCO2G(NY,NX)+CI - HCO2G(NY,NX)=HCO2G(NY,NX)+CI - UCH4G(NY,NX)=UCH4G(NY,NX)+CH - HCH4G(NY,NX)=HCH4G(NY,NX)+CH - CO2GIN=CO2GIN+CI+CH - TCOU=TCOU+CO+CX - TNBP(NY,NX)=TNBP(NY,NX)+CH -C IF(NX.EQ.3.AND.NY.EQ.3)THEN -C WRITE(*,6644)'CO2',I,J,NX,NY,HCO2G(NY,NX),CI,XCODFS(NY,NX) -C 2,XCOFLG(3,NU(NY,NX),NY,NX),TCO2Z(NY,NX) -C 3,(FLQGQ(NY,NX)+FLQRQ(NY,NX))*CCOR(NY,NX) -C 4,(FLQGI(NY,NX)+FLQRI(NY,NX))*CCOQ(NY,NX) -C 5,XCODFG(0,NY,NX),XCODFR(NY,NX),VOLP(0,NY,NX) -C 6,VOLP(NU(NY,NX),NY,NX) -C WRITE(*,6644)'CH4',I,J,NX,NY,CH,XCHDFS(NY,NX) -C 2,XCHFLG(3,NU(NY,NX),NY,NX),TCH4Z(NY,NX),FLQGQ(NY,NX) -C 3,FLQRQ(NY,NX),FLQGI(NY,NX),FLQRI(NY,NX),CCHR(NY,NX),CCHQ(NY,NX) -C 4,XCHDFG(0,NY,NX),XCHDFR(NY,NX),CH4S(NU(NY,NX),NY,NX) -6644 FORMAT(A8,4I4,30E12.4) -C ENDIF -C -C SURFACE BOUNDARY O2 FLUXES -C - OI=XOXDFS(NY,NX)+XOXFLG(3,NU(NY,NX),NY,NX)+TOXYZ(NY,NX) - 2+(FLQGQ(NY,NX)+FLQRQ(NY,NX))*COXR(NY,NX) - 3+(FLQGI(NY,NX)+FLQRI(NY,NX))*COXQ(NY,NX) - 4+XOXDFG(0,NY,NX)+XOXDFR(NY,NX) - OO=RUPOXO(0,NY,NX)-PRECU(NY,NX)*COXQ(NY,NX) - UOXYG(NY,NX)=UOXYG(NY,NX)+OI - HOXYG(NY,NX)=HOXYG(NY,NX)+OI - OXYGIN=OXYGIN+OI - OXYGOU=OXYGOU+OO -C IF(NX.EQ.2.AND.NY.EQ.1)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) -C 3,(FLQGI(NY,NX)+FLQRI(NY,NX))*CCOQ(NY,NX) -C 4,XCODFG(0,NY,NX),XCODFR(NY,NX) -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) -6646 FORMAT(A8,4I4,60E12.4) -C ENDIF -C -C SURFACE BOUNDARY N2, N2O, NH3, NH4, NO3, AND DON FLUXES -C - ZN2GIN=ZN2GIN+XNGDFS(NY,NX)+XN2DFS(NY,NX)+XN3DFS(NY,NX) - 2+XNBDFS(NY,NX)+XNGFLG(3,NU(NY,NX),NY,NX)+XN2FLG(3,NU(NY,NX),NY,NX) - 3+XN3FLG(3,NU(NY,NX),NY,NX)+TN2OZ(NY,NX)+TNH3Z(NY,NX) - 4+(FLQGQ(NY,NX)+FLQRQ(NY,NX))*(CNNR(NY,NX)+CN2R(NY,NX)) - 5+(FLQGI(NY,NX)+FLQRI(NY,NX))*(CNNQ(NY,NX)+CN2Q(NY,NX)) - 6+XN2DFG(0,NY,NX)+XNGDFG(0,NY,NX)+XN3DFG(0,NY,NX) - 7+XNGDFR(NY,NX)+XN2DFR(NY,NX)+XN3DFR(NY,NX) - TZIN=TZIN+((FLQGQ(NY,NX)+FLQRQ(NY,NX)) - 2*(CN4R(NY,NX)+CN3R(NY,NX)+CNOR(NY,NX)) - 3+(FLQGI(NY,NX)+FLQRI(NY,NX))*(CN4Q(I,NY,NX)+CN3Q(I,NY,NX) - 4+CNOQ(I,NY,NX)))*14.0 - TZOU=TZOU-PRECU(NY,NX)*(CNNQ(NY,NX)+CN2Q(NY,NX))-PRECU(NY,NX) - 2*(CN4Q(I,NY,NX)+CN3Q(I,NY,NX)+CNOQ(I,NY,NX))*14.0 - ZDRAIN(NY,NX)=ZDRAIN(NY,NX)+XN4FLW(3,NK(NY,NX),NY,NX) - 2+XN3FLW(3,NK(NY,NX),NY,NX)+XNOFLW(3,NK(NY,NX),NY,NX) - 3+XNXFLS(3,NK(NY,NX),NY,NX)+XN4FLB(3,NK(NY,NX),NY,NX) - 4+XN3FLB(3,NK(NY,NX),NY,NX)+XNOFLB(3,NK(NY,NX),NY,NX) - 5+XNXFLB(3,NK(NY,NX),NY,NX) - ZNGGIN=XNGDFS(NY,NX)+XNGFLG(3,NU(NY,NX),NY,NX)+XNGDFG(0,NY,NX) - ZN2OIN=XN2DFS(NY,NX)+XN2FLG(3,NU(NY,NX),NY,NX)+XN2DFG(0,NY,NX) - ZNH3IN=XN3DFS(NY,NX)+XNBDFS(NY,NX)+XN3FLG(3,NU(NY,NX),NY,NX) - 2+XN3DFG(0,NY,NX) - TI=XHGDFS(NY,NX)+XHGFLG(3,NU(NY,NX),NY,NX)+TH2GZ(NY,NX) - 2+XHGDFG(0,NY,NX)+XHGDFR(NY,NX) -C UN2GG(NY,NX)=UN2GG(NY,NX)+ZNGGIN -C HN2GG(NY,NX)=HN2GG(NY,NX)+ZNGGIN - UN2OG(NY,NX)=UN2OG(NY,NX)+ZN2OIN - HN2OG(NY,NX)=HN2OG(NY,NX)+ZN2OIN - UNH3G(NY,NX)=UNH3G(NY,NX)+ZNH3IN - HNH3G(NY,NX)=HNH3G(NY,NX)+ZNH3IN - UN2GS(NY,NX)=UN2GS(NY,NX)+XN2GS(0,NY,NX) - UH2GG(NY,NX)=UH2GG(NY,NX)+TI -C WRITE(*,6644)'HNH3G',I,J,NX,NY,HNH3G(NY,NX),ZNH3IN -C 2,XN3DFS(NY,NX),XNBDFS(NY,NX),XN3FLG(3,NU(NY,NX),NY,NX) -C 2,XN3DFG(0,NY,NX) -C WRITE(*,6644)'ZN2GIN',I,J,NX,NY,ZN2GIN,XNGDFS(NY,NX) -C 3,XN2DFS(NY,NX),XN3DFS(NY,NX) -C 2,XNBDFS(NY,NX),XNGFLG(3,NU(NY,NX),NY,NX),XN2FLG(3,NU(NY,NX),NY,NX) -C 3,XN3FLG(3,NU(NY,NX),NY,NX),TN2OZ(NY,NX),TNH3Z(NY,NX) -C 4,(FLQGQ(NY,NX)+FLQRQ(NY,NX))*(CNNR(NY,NX)+CN2R(NY,NX)) -C 5,(FLQGI(NY,NX)+FLQRI(NY,NX))*(CNNQ(NY,NX)+CN2Q(NY,NX)) -C 6,XN2DFG(0,NY,NX)+XNGDFG(0,NY,NX),XN3DFG(0,NY,NX) -C 7,XNGDFR(NY,NX)+XN2DFR(NY,NX),XN3DFR(NY,NX) -C -C SURFACE BOUNDARY PO4 AND DOP FLUXES -C - TPIN=TPIN+((FLQGQ(NY,NX)+FLQRQ(NY,NX))*CPOR(NY,NX) - 2+(FLQGI(NY,NX)+FLQRI(NY,NX))*CPOQ(I,NY,NX))*31.0 - TPOU=TPOU-PRECU(NY,NX)*CPOQ(I,NY,NX)*31.0 - PDRAIN(NY,NX)=PDRAIN(NY,NX)+XH2PFS(3,NK(NY,NX),NY,NX) - 2+XH2BFB(3,NK(NY,NX),NY,NX) -C -C SURFACE BOUNDARY ION FLUXES -C - TZOU=TZOU-14.0*(TBNH4(0,NY,NX)+TBNO3(0,NY,NX)+TBNH3(0,NY,NX)) - TPOU=TPOU-31.0*TBH2P(0,NY,NX) - TO=2.0*TRH2O(0,NY,NX)+2.0*TBNH4(0,NY,NX) - 2+TBNH3(0,NY,NX)+TBNO3(0,NY,NX)+3.0*TBH2P(0,NY,NX) - 3+RH2GO(0,NY,NX)+TBION(0,NY,NX) - TIONIN=TIONIN+TI - TIONOU=TIONOU+TO -C UIONOU(NY,NX)=UIONOU(NY,NX)+TO -C -C ACCUMULATE PLANT LITTERFALL FLUXES -C - XCSN=XCSN+ZCSNC(NY,NX) - XZSN=XZSN+ZZSNC(NY,NX) - XPSN=XPSN+ZPSNC(NY,NX) - UXCSN(NY,NX)=UXCSN(NY,NX)+ZCSNC(NY,NX) - UXZSN(NY,NX)=UXZSN(NY,NX)+ZZSNC(NY,NX) - UXPSN(NY,NX)=UXPSN(NY,NX)+ZPSNC(NY,NX) -C -C SURFACE BOUNDARY SALT FLUXES FROM RAINFALL AND SURFACE IRRIGATION -C - IF(ISALT(NY,NX).NE.0)THEN - SR=PRECQ(NY,NX)*(CALR(NY,NX)+CFER(NY,NX)+CHYR(NY,NX)+CCAR(NY,NX) - 2+CMGR(NY,NX)+CNAR(NY,NX)+CKAR(NY,NX)+COHR(NY,NX)+CSOR(NY,NX) - 3+CCLR(NY,NX)+CC3R(NY,NX)+CH0PR(NY,NX) - 4+2.0*(CHCR(NY,NX)+CAL1R(NY,NX)+CALSR(NY,NX)+CFE1R(NY,NX) - 5+CFESR(NY,NX)+CCAOR(NY,NX)+CCACR(NY,NX)+CCASR(NY,NX)+CMGOR(NY,NX) - 6+CMGCR(NY,NX)+CMGSR(NY,NX)+CNACR(NY,NX)+CNASR(NY,NX) - 7+CKASR(NY,NX)+CH1PR(NY,NX)+CC0PR(NY,NX)) - 8+3.0*(CAL2R(NY,NX)+CFE2R(NY,NX)+CCAHR(NY,NX)+CMGHR(NY,NX) - 9+CF1PR(NY,NX)+CC1PR(NY,NX)+CM1PR(NY,NX)) - 1+4.0*(CAL3R(NY,NX)+CFE3R(NY,NX)+CH3PR(NY,NX)+CF2PR(NY,NX) - 2+CC2PR(NY,NX)) - 3+5.0*(CAL4R(NY,NX)+CFE4R(NY,NX))) - SI=PRECI(NY,NX)*(CALQ(I,NY,NX)+CFEQ(I,NY,NX)+CHYQ(I,NY,NX) - 2+CCAQ(I,NY,NX)+CMGQ(I,NY,NX)+CNAQ(I,NY,NX)+CKAQ(I,NY,NX) - 3+COHQ(I,NY,NX)+CSOQ(I,NY,NX)+CCLQ(I,NY,NX)+CC3Q(I,NY,NX) - 4+CH0PQ(I,NY,NX)+2.0*(CHCQ(I,NY,NX)+CAL1Q(I,NY,NX)+CALSQ(I,NY,NX) - 5+CFE1Q(I,NY,NX)+CFESQ(I,NY,NX)+CCAOQ(I,NY,NX)+CCACQ(I,NY,NX) - 6+CCASQ(I,NY,NX)+CMGOQ(I,NY,NX)+CMGCQ(I,NY,NX)+CMGSQ(I,NY,NX) - 7+CNACQ(I,NY,NX)+CNASQ(I,NY,NX)+CKASQ(I,NY,NX)+CH1PQ(I,NY,NX) - 8+CC0PQ(I,NY,NX))+3.0*(CAL2Q(I,NY,NX)+CFE2Q(I,NY,NX) - 9+CCAHQ(I,NY,NX)+CMGHQ(I,NY,NX)+CF1PQ(I,NY,NX)+CC1PQ(I,NY,NX) - 1+CM1PQ(I,NY,NX))+4.0*(CAL3Q(I,NY,NX)+CFE3Q(I,NY,NX) - 2+CH3PQ(I,NY,NX)+CF2PQ(I,NY,NX)+CC2PQ(I,NY,NX)) - 3+5.0*(CAL4Q(I,NY,NX)+CFE4Q(I,NY,NX))) - TIONIN=TIONIN+SR+SI -C -C SUBSURFACE BOUNDARY SALT FLUXES FROM SUBSURFACE IRRIGATION -C - SI=PRECU(NY,NX)*(CALQ(I,NY,NX)+CFEQ(I,NY,NX)+CHYQ(I,NY,NX) - 2+CCAQ(I,NY,NX)+CMGQ(I,NY,NX)+CNAQ(I,NY,NX)+CKAQ(I,NY,NX) - 3+COHQ(I,NY,NX)+CSOQ(I,NY,NX)+CCLQ(I,NY,NX)+CC3Q(I,NY,NX) - 4+CH0PQ(I,NY,NX)+2.0*(CHCQ(I,NY,NX)+CAL1Q(I,NY,NX)+CALSQ(I,NY,NX) - 5+CFE1Q(I,NY,NX)+CFESQ(I,NY,NX)+CCAOQ(I,NY,NX)+CCACQ(I,NY,NX) - 6+CCASQ(I,NY,NX)+CMGOQ(I,NY,NX)+CMGCQ(I,NY,NX)+CMGSQ(I,NY,NX) - 7+CNACQ(I,NY,NX)+CNASQ(I,NY,NX)+CKASQ(I,NY,NX)+CH1PQ(I,NY,NX) - 8+CC0PQ(I,NY,NX))+3.0*(CAL2Q(I,NY,NX)+CFE2Q(I,NY,NX) - 9+CCAHQ(I,NY,NX)+CMGHQ(I,NY,NX)+CF1PQ(I,NY,NX)+CC1PQ(I,NY,NX) - 1+CM1PQ(I,NY,NX))+4.0*(CAL3Q(I,NY,NX)+CFE3Q(I,NY,NX) - 2+CH3PQ(I,NY,NX)+CF2PQ(I,NY,NX)+CC2PQ(I,NY,NX)) - 3+5.0*(CAL4Q(I,NY,NX)+CFE4Q(I,NY,NX))) - TIONIN=TIONIN+SI - ENDIF -C -C GAS EXCHANGE FROM SURFACE VOLATILIZATION-DISSOLUTION -C - DO 9680 K=0,2 - OQC(K,0,NY,NX)=OQC(K,0,NY,NX)+XOCFLS(K,3,0,NY,NX) - OQN(K,0,NY,NX)=OQN(K,0,NY,NX)+XONFLS(K,3,0,NY,NX) - OQP(K,0,NY,NX)=OQP(K,0,NY,NX)+XOPFLS(K,3,0,NY,NX) - OQA(K,0,NY,NX)=OQA(K,0,NY,NX)+XOAFLS(K,3,0,NY,NX) -9680 CONTINUE - CO2S(0,NY,NX)=CO2S(0,NY,NX)+XCODFR(NY,NX)+XCOFLS(3,0,NY,NX) - 2+XCODFG(0,NY,NX)-RCO2O(0,NY,NX) - CH4S(0,NY,NX)=CH4S(0,NY,NX)+XCHDFR(NY,NX)+XCHFLS(3,0,NY,NX) - 2+XCHDFG(0,NY,NX)-RCH4O(0,NY,NX) - OXYS(0,NY,NX)=OXYS(0,NY,NX)+XOXDFR(NY,NX)+XOXFLS(3,0,NY,NX) - 2+XOXDFG(0,NY,NX)-RUPOXO(0,NY,NX) - Z2GS(0,NY,NX)=Z2GS(0,NY,NX)+XNGDFR(NY,NX)+XNGFLS(3,0,NY,NX) - 2+XNGDFG(0,NY,NX)-RN2G(0,NY,NX)-XN2GS(0,NY,NX) - Z2OS(0,NY,NX)=Z2OS(0,NY,NX)+XN2DFR(NY,NX)+XN2FLS(3,0,NY,NX) - 2+XN2DFG(0,NY,NX)-RN2O(0,NY,NX) - H2GS(0,NY,NX)=H2GS(0,NY,NX)+XHGDFR(NY,NX)+XHGFLS(3,0,NY,NX) - 2+XHGDFG(0,NY,NX)-RH2GO(0,NY,NX) - ZNH4S(0,NY,NX)=ZNH4S(0,NY,NX)+XN4FLW(3,0,NY,NX) - 2+XNH4S(0,NY,NX)+TRN4S(0,NY,NX)+XN34SQ(0,NY,NX) - ZNH3S(0,NY,NX)=ZNH3S(0,NY,NX)+XN3DFR(NY,NX)+XN3FLW(3,0,NY,NX) - 2+XN3DFG(0,NY,NX)+TRN3S(0,NY,NX)-XN34SQ(0,NY,NX) - ZNO3S(0,NY,NX)=ZNO3S(0,NY,NX)+XNOFLW(3,0,NY,NX) - 2+XNO3S(0,NY,NX)+TRNO3(0,NY,NX) - ZNO2S(0,NY,NX)=ZNO2S(0,NY,NX)+XNXFLS(3,0,NY,NX) - 2+XNO2S(0,NY,NX) - H2PO4(0,NY,NX)=H2PO4(0,NY,NX)+XH2PFS(3,0,NY,NX) - 2+XH2PS(0,NY,NX)+TRH2P(0,NY,NX) - CO2S(NU(NY,NX),NY,NX)=CO2S(NU(NY,NX),NY,NX)+XCODFS(NY,NX) - CH4S(NU(NY,NX),NY,NX)=CH4S(NU(NY,NX),NY,NX)+XCHDFS(NY,NX) - OXYS(NU(NY,NX),NY,NX)=OXYS(NU(NY,NX),NY,NX)+XOXDFS(NY,NX) - Z2GS(NU(NY,NX),NY,NX)=Z2GS(NU(NY,NX),NY,NX)+XNGDFS(NY,NX) - Z2OS(NU(NY,NX),NY,NX)=Z2OS(NU(NY,NX),NY,NX)+XN2DFS(NY,NX) - ZNH3S(NU(NY,NX),NY,NX)=ZNH3S(NU(NY,NX),NY,NX)+XN3DFS(NY,NX) - ZNH3B(NU(NY,NX),NY,NX)=ZNH3B(NU(NY,NX),NY,NX)+XNBDFS(NY,NX) - H2GS(NU(NY,NX),NY,NX)=H2GS(NU(NY,NX),NY,NX)+XHGDFS(NY,NX) - SED(NY,NX)=SED(NY,NX)+XDTSED(NY,NX) - THRE(NY,NX)=THRE(NY,NX)+RCO2O(0,NY,NX) - UN2GG(NY,NX)=UN2GG(NY,NX)+RN2G(0,NY,NX) - HN2GG(NY,NX)=HN2GG(NY,NX)+RN2G(0,NY,NX) - ROXYF(0,NY,NX)=XOXDFG(0,NY,NX) - RCO2F(0,NY,NX)=XCODFG(0,NY,NX) - RCH4F(0,NY,NX)=XCHDFG(0,NY,NX) - ROXYL(0,NY,NX)=XOXDFR(NY,NX)+XOXFLS(3,0,NY,NX) - 2-(FLQRQ(NY,NX)*COXR(NY,NX)+FLQRI(NY,NX)*COXQ(NY,NX)) - RCH4L(0,NY,NX)=XCHDFR(NY,NX)+XCHFLS(3,0,NY,NX) - 2-(FLQRQ(NY,NX)*CCHR(NY,NX)+FLQRI(NY,NX)*CCHQ(NY,NX)) - ROXYL(NU(NY,NX),NY,NX)=ROXYL(NU(NY,NX),NY,NX)+XOXDFS(NY,NX) - RCH4L(NU(NY,NX),NY,NX)=RCH4L(NU(NY,NX),NY,NX)+XCHDFS(NY,NX) -C IF(NX.EQ.1.AND.NY.EQ.6)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) -C WRITE(*,1119)'CH4S0',I,J,NX,NY,CH4S(0,NY,NX),XCHDFS(NY,NX) -C 2,XCHDFR(NY,NX),XCHFLS(3,0,NY,NX),RCH4O(0,NY,NX),XCHDFG(0,NY,NX) -C 3,RCH4L(0,NY,NX) -C WRITE(*,1119)'OXYS0',I,J,NX,NY,OXYS(0,NY,NX),XOXDFR(NY,NX) -C 2,XOXFLS(3,0,NY,NX),XOXDFG(0,NY,NX),RUPOXO(0,NY,NX) -C 3,ROXYL(0,NY,NX),TOXQRS(NY,NX) -1119 FORMAT(A8,4I4,12E12.4) -C ENDIF -C IF(NX.EQ.5)THEN -C WRITE(*,5533)'ZNH4S0',I,J,NX,NY,ZNH4S(0,NY,NX),XN4FLW(3,0,NY,NX) -C 2,XNH4S(0,NY,NX),XN3FLW(3,0,NY,NX),TRN4S(0,NY,NX) -C 3,ZNH3S(0,NY,NX),TRN3S(0,NY,NX),XN3DFG(0,NY,NX),XN34SQ(0,NY,NX) -C 4,ZNHUFA(0,NY,NX),XNO2S(0,NY,NX),XN4(0,NY,NX)*14.0 -C WRITE(*,5533)'ZNO3S0',I,J,NX,NY,ZNO3S(0,NY,NX),XNOFLW(3,0,NY,NX) -C 2,XNO3S(0,NY,NX),TRNO3(0,NY,NX),ZNO2S(0,NY,NX),XNXFLS(3,0,NY,NX) -C 3,XNO2S(0,NY,NX) -C WRITE(*,5533)'H2PO40',I,J,NX,NY,H2PO4(0,NY,NX) -C 2,XH2PFS(3,0,NY,NX),XH2PS(0,NY,NX),TRH2P(0,NY,NX) -5533 FORMAT(A8,4I4,20E12.4) -C ENDIF -C -C OVERLAND FLOW -C - IF(TQR(NY,NX).NE.0.0)THEN -C -C DOC, DON, DOP -C - DO 8570 K=0,2 - OQC(K,0,NY,NX)=OQC(K,0,NY,NX)+TOCQRS(K,NY,NX) - OQN(K,0,NY,NX)=OQN(K,0,NY,NX)+TONQRS(K,NY,NX) - OQP(K,0,NY,NX)=OQP(K,0,NY,NX)+TOPQRS(K,NY,NX) - OQA(K,0,NY,NX)=OQA(K,0,NY,NX)+TOAQRS(K,NY,NX) -C IF(NX.EQ.1.AND.NY.EQ.6)THEN -C WRITE(*,2626)'OQC0',I,J,NX,NY,K,OQC(K,0,NY,NX) -C 2,TOCQRS(K,NY,NX),OQN(K,0,NY,NX),TONQRS(K,NY,NX) -2626 FORMAT(A8,5I4,20E12.4) -C ENDIF -8570 CONTINUE -C -C SOLUTES -C - CO2S(0,NY,NX)=CO2S(0,NY,NX)+TCOQRS(NY,NX) - CH4S(0,NY,NX)=CH4S(0,NY,NX)+TCHQRS(NY,NX) - OXYS(0,NY,NX)=OXYS(0,NY,NX)+TOXQRS(NY,NX) - Z2GS(0,NY,NX)=Z2GS(0,NY,NX)+TNGQRS(NY,NX) - Z2OS(0,NY,NX)=Z2OS(0,NY,NX)+TN2QRS(NY,NX) - H2GS(0,NY,NX)=H2GS(0,NY,NX)+THGQRS(NY,NX) - ZNH4S(0,NY,NX)=ZNH4S(0,NY,NX)+TN4QRS(NY,NX) - ZNH3S(0,NY,NX)=ZNH3S(0,NY,NX)+TN3QRS(NY,NX) - ZNO3S(0,NY,NX)=ZNO3S(0,NY,NX)+TNOQRS(NY,NX) - ZNO2S(0,NY,NX)=ZNO2S(0,NY,NX)+TNXQRS(NY,NX) - H2PO4(0,NY,NX)=H2PO4(0,NY,NX)+TPOQRS(NY,NX) - IF(ISALT(NY,NX).NE.0)THEN - ZAL(0,NY,NX)=ZAL(0,NY,NX)+TQRAL(NY,NX) - ZFE(0,NY,NX)=ZFE(0,NY,NX)+TQRFE(NY,NX) - ZHY(0,NY,NX)=ZHY(0,NY,NX)+TQRHY(NY,NX) - ZCA(0,NY,NX)=ZCA(0,NY,NX)+TQRCA(NY,NX) - ZMG(0,NY,NX)=ZMG(0,NY,NX)+TQRMG(NY,NX) - ZNA(0,NY,NX)=ZNA(0,NY,NX)+TQRNA(NY,NX) - ZKA(0,NY,NX)=ZKA(0,NY,NX)+TQRKA(NY,NX) - ZOH(0,NY,NX)=ZOH(0,NY,NX)+TQROH(NY,NX) - ZSO4(0,NY,NX)=ZSO4(0,NY,NX)+TQRSO(NY,NX) - ZCL(0,NY,NX)=ZCL(0,NY,NX)+TQRCL(NY,NX) - ZCO3(0,NY,NX)=ZCO3(0,NY,NX)+TQRC3(NY,NX) - ZHCO3(0,NY,NX)=ZHCO3(0,NY,NX)+TQRHC(NY,NX) - ZALOH1(0,NY,NX)=ZALOH1(0,NY,NX)+TQRAL1(NY,NX) - ZALOH2(0,NY,NX)=ZALOH2(0,NY,NX)+TQRAL2(NY,NX) - ZALOH3(0,NY,NX)=ZALOH3(0,NY,NX)+TQRAL3(NY,NX) - ZALOH4(0,NY,NX)=ZALOH4(0,NY,NX)+TQRAL4(NY,NX) - ZALS(0,NY,NX)=ZALS(0,NY,NX)+TQRALS(NY,NX) - ZFEOH1(0,NY,NX)=ZFEOH1(0,NY,NX)+TQRFE1(NY,NX) - ZFEOH2(0,NY,NX)=ZFEOH2(0,NY,NX)+TQRFE2(NY,NX) - ZFEOH3(0,NY,NX)=ZFEOH3(0,NY,NX)+TQRFE3(NY,NX) - ZFEOH4(0,NY,NX)=ZFEOH4(0,NY,NX)+TQRFE4(NY,NX) - ZFES(0,NY,NX)=ZFES(0,NY,NX)+TQRFES(NY,NX) - ZCAO(0,NY,NX)=ZCAO(0,NY,NX)+TQRCAO(NY,NX) - ZCAC(0,NY,NX)=ZCAC(0,NY,NX)+TQRCAC(NY,NX) - ZCAH(0,NY,NX)=ZCAH(0,NY,NX)+TQRCAH(NY,NX) - ZCAS(0,NY,NX)=ZCAS(0,NY,NX)+TQRCAS(NY,NX) - ZMGO(0,NY,NX)=ZMGO(0,NY,NX)+TQRMGO(NY,NX) - ZMGC(0,NY,NX)=ZMGC(0,NY,NX)+TQRMGC(NY,NX) - ZMGH(0,NY,NX)=ZMGH(0,NY,NX)+TQRMGH(NY,NX) - ZMGS(0,NY,NX)=ZMGS(0,NY,NX)+TQRMGS(NY,NX) - ZNAC(0,NY,NX)=ZNAC(0,NY,NX)+TQRNAC(NY,NX) - ZNAS(0,NY,NX)=ZNAS(0,NY,NX)+TQRNAS(NY,NX) - ZKAS(0,NY,NX)=ZKAS(0,NY,NX)+TQRKAS(NY,NX) - H0PO4(0,NY,NX)=H0PO4(0,NY,NX)+TQRH0P(NY,NX) - H1PO4(0,NY,NX)=H1PO4(0,NY,NX)+TQRH1P(NY,NX) - H3PO4(0,NY,NX)=H3PO4(0,NY,NX)+TQRH3P(NY,NX) - ZFE1P(0,NY,NX)=ZFE1P(0,NY,NX)+TQRF1P(NY,NX) - ZFE2P(0,NY,NX)=ZFE2P(0,NY,NX)+TQRF2P(NY,NX) - ZCA0P(0,NY,NX)=ZCA0P(0,NY,NX)+TQRC0P(NY,NX) - ZCA1P(0,NY,NX)=ZCA1P(0,NY,NX)+TQRC1P(NY,NX) - ZCA2P(0,NY,NX)=ZCA2P(0,NY,NX)+TQRC2P(NY,NX) - ZMG1P(0,NY,NX)=ZMG1P(0,NY,NX)+TQRM1P(NY,NX) - ENDIF -C -C SURFACE SEDIMENT TRANSPORT -C - IF(IERSN(NY,NX).NE.0)THEN - IF(BKDS(NU(NY,NX),NY,NX).GT.ZERO)THEN - SED(NY,NX)=SED(NY,NX)+TSEDER(NY,NX) - DLYR(3,NU(NY,NX),NY,NX)=DLYR(3,NU(NY,NX),NY,NX)+TSEDER(NY,NX) - 2/(AREA(3,NU(NY,NX),NY,NX)*BKDS(NU(NY,NX),NY,NX)) - IF(TSEDER(NY,NX).GT.1.0E-06*BKVL(NU(NY,NX),NY,NX))IFLGS(NY,NX)=1 - ENDIF -C -C SOIL MINERAL FRACTIONS -C - SAND(NU(NY,NX),NY,NX)=SAND(NU(NY,NX),NY,NX)+TSANER(NY,NX) - SILT(NU(NY,NX),NY,NX)=SILT(NU(NY,NX),NY,NX)+TSILER(NY,NX) - CLAY(NU(NY,NX),NY,NX)=CLAY(NU(NY,NX),NY,NX)+TCLAER(NY,NX) - XCEC(NU(NY,NX),NY,NX)=XCEC(NU(NY,NX),NY,NX)+TCECER(NY,NX) - XAEC(NU(NY,NX),NY,NX)=XAEC(NU(NY,NX),NY,NX)+TAECER(NY,NX) -C -C FERTILIZER POOLS -C - ZNH4FA(NU(NY,NX),NY,NX)=ZNH4FA(NU(NY,NX),NY,NX)+TNH4ER(NY,NX) - ZNH3FA(NU(NY,NX),NY,NX)=ZNH3FA(NU(NY,NX),NY,NX)+TNH3ER(NY,NX) - ZNHUFA(NU(NY,NX),NY,NX)=ZNHUFA(NU(NY,NX),NY,NX)+TNHUER(NY,NX) - ZNO3FA(NU(NY,NX),NY,NX)=ZNO3FA(NU(NY,NX),NY,NX)+TNO3ER(NY,NX) - ZNH4FB(NU(NY,NX),NY,NX)=ZNH4FB(NU(NY,NX),NY,NX)+TNH4EB(NY,NX) - ZNH3FB(NU(NY,NX),NY,NX)=ZNH3FB(NU(NY,NX),NY,NX)+TNH3EB(NY,NX) - ZNHUFB(NU(NY,NX),NY,NX)=ZNHUFB(NU(NY,NX),NY,NX)+TNHUEB(NY,NX) - ZNO3FB(NU(NY,NX),NY,NX)=ZNO3FB(NU(NY,NX),NY,NX)+TNO3EB(NY,NX) -C -C EXCHANGEABLE CATIONS AND ANIONS -C - XN4(NU(NY,NX),NY,NX)=XN4(NU(NY,NX),NY,NX)+TN4ER(NY,NX) - XNB(NU(NY,NX),NY,NX)=XNB(NU(NY,NX),NY,NX)+TNBER(NY,NX) - XHY(NU(NY,NX),NY,NX)=XHY(NU(NY,NX),NY,NX)+THYER(NY,NX) - XAL(NU(NY,NX),NY,NX)=XAL(NU(NY,NX),NY,NX)+TALER(NY,NX) - XCA(NU(NY,NX),NY,NX)=XCA(NU(NY,NX),NY,NX)+TCAER(NY,NX) - XMG(NU(NY,NX),NY,NX)=XMG(NU(NY,NX),NY,NX)+TMGER(NY,NX) - XNA(NU(NY,NX),NY,NX)=XNA(NU(NY,NX),NY,NX)+TNAER(NY,NX) - XKA(NU(NY,NX),NY,NX)=XKA(NU(NY,NX),NY,NX)+TKAER(NY,NX) - XHC(NU(NY,NX),NY,NX)=XHC(NU(NY,NX),NY,NX)+THCER(NY,NX) - XALO2(NU(NY,NX),NY,NX)=XALO2(NU(NY,NX),NY,NX)+TAL2ER(NY,NX) - XOH0(NU(NY,NX),NY,NX)=XOH0(NU(NY,NX),NY,NX)+TOH0ER(NY,NX) - XOH1(NU(NY,NX),NY,NX)=XOH1(NU(NY,NX),NY,NX)+TOH1ER(NY,NX) - XOH2(NU(NY,NX),NY,NX)=XOH2(NU(NY,NX),NY,NX)+TOH2ER(NY,NX) - XH1P(NU(NY,NX),NY,NX)=XH1P(NU(NY,NX),NY,NX)+TH1PER(NY,NX) - XH2P(NU(NY,NX),NY,NX)=XH2P(NU(NY,NX),NY,NX)+TH2PER(NY,NX) - XOH0B(NU(NY,NX),NY,NX)=XOH0B(NU(NY,NX),NY,NX)+TOH0EB(NY,NX) - XOH1B(NU(NY,NX),NY,NX)=XOH1B(NU(NY,NX),NY,NX)+TOH1EB(NY,NX) - XOH2B(NU(NY,NX),NY,NX)=XOH2B(NU(NY,NX),NY,NX)+TOH2EB(NY,NX) - XH1PB(NU(NY,NX),NY,NX)=XH1PB(NU(NY,NX),NY,NX)+TH1PEB(NY,NX) - XH2PB(NU(NY,NX),NY,NX)=XH2PB(NU(NY,NX),NY,NX)+TH2PEB(NY,NX) -C -C PRECIPITATES -C - PALOH(NU(NY,NX),NY,NX)=PALOH(NU(NY,NX),NY,NX)+TALOER(NY,NX) - PFEOH(NU(NY,NX),NY,NX)=PFEOH(NU(NY,NX),NY,NX)+TFEOER(NY,NX) - PCACO(NU(NY,NX),NY,NX)=PCACO(NU(NY,NX),NY,NX)+TCACER(NY,NX) - PCASO(NU(NY,NX),NY,NX)=PCASO(NU(NY,NX),NY,NX)+TCASER(NY,NX) - PALPO(NU(NY,NX),NY,NX)=PALPO(NU(NY,NX),NY,NX)+TALPER(NY,NX) - PFEPO(NU(NY,NX),NY,NX)=PFEPO(NU(NY,NX),NY,NX)+TFEPER(NY,NX) - PCAPD(NU(NY,NX),NY,NX)=PCAPD(NU(NY,NX),NY,NX)+TCPDER(NY,NX) - PCAPH(NU(NY,NX),NY,NX)=PCAPH(NU(NY,NX),NY,NX)+TCPHER(NY,NX) - PCAPM(NU(NY,NX),NY,NX)=PCAPM(NU(NY,NX),NY,NX)+TCPMER(NY,NX) - PALPB(NU(NY,NX),NY,NX)=PALPB(NU(NY,NX),NY,NX)+TALPEB(NY,NX) - PFEPB(NU(NY,NX),NY,NX)=PFEPB(NU(NY,NX),NY,NX)+TFEPEB(NY,NX) - PCPDB(NU(NY,NX),NY,NX)=PCPDB(NU(NY,NX),NY,NX)+TCPDEB(NY,NX) - PCPHB(NU(NY,NX),NY,NX)=PCPHB(NU(NY,NX),NY,NX)+TCPHEB(NY,NX) - PCPMB(NU(NY,NX),NY,NX)=PCPMB(NU(NY,NX),NY,NX)+TCPMEB(NY,NX) -C -C ORGANIC CONSTITUENTS -C - DO 9280 K=0,5 - DO 9280 NN=1,7 - DO 9280 M=1,3 - OMC(M,NN,K,NU(NY,NX),NY,NX)=OMC(M,NN,K,NU(NY,NX),NY,NX) - 2+TOMCER(M,NN,K,NY,NX) - OMN(M,NN,K,NU(NY,NX),NY,NX)=OMN(M,NN,K,NU(NY,NX),NY,NX) - 2+TOMNER(M,NN,K,NY,NX) - OMP(M,NN,K,NU(NY,NX),NY,NX)=OMP(M,NN,K,NU(NY,NX),NY,NX) - 2+TOMPER(M,NN,K,NY,NX) -9280 CONTINUE - DO 9275 K=0,4 - DO 9270 M=1,2 - ORC(M,K,NU(NY,NX),NY,NX)=ORC(M,K,NU(NY,NX),NY,NX) - 2+TORCER(M,K,NY,NX) - ORN(M,K,NU(NY,NX),NY,NX)=ORN(M,K,NU(NY,NX),NY,NX) - 2+TORNER(M,K,NY,NX) - ORP(M,K,NU(NY,NX),NY,NX)=ORP(M,K,NU(NY,NX),NY,NX) - 2+TORPER(M,K,NY,NX) -9270 CONTINUE - OHC(K,NU(NY,NX),NY,NX)=OHC(K,NU(NY,NX),NY,NX)+TOHCER(K,NY,NX) - OHN(K,NU(NY,NX),NY,NX)=OHN(K,NU(NY,NX),NY,NX)+TOHNER(K,NY,NX) - OHP(K,NU(NY,NX),NY,NX)=OHP(K,NU(NY,NX),NY,NX)+TOHPER(K,NY,NX) - OHA(K,NU(NY,NX),NY,NX)=OHA(K,NU(NY,NX),NY,NX)+TOHAER(K,NY,NX) - DO 9265 M=1,4 - OSC(M,K,NU(NY,NX),NY,NX)=OSC(M,K,NU(NY,NX),NY,NX) - 2+TOSCER(M,K,NY,NX) - OSA(M,K,NU(NY,NX),NY,NX)=OSA(M,K,NU(NY,NX),NY,NX) - 2+TOSAER(M,K,NY,NX) - OSN(M,K,NU(NY,NX),NY,NX)=OSN(M,K,NU(NY,NX),NY,NX) - 2+TOSNER(M,K,NY,NX) - OSP(M,K,NU(NY,NX),NY,NX)=OSP(M,K,NU(NY,NX),NY,NX) - 2+TOSPER(M,K,NY,NX) -9265 CONTINUE -9275 CONTINUE - ENDIF - ENDIF -C -C OVERLAND SNOW REDISTRIBUTION -C - IF(TQS(NY,NX).NE.0.0)THEN - CO2W(NY,NX)=CO2W(NY,NX)+TCOQSS(NY,NX) - CH4W(NY,NX)=CH4W(NY,NX)+TCHQSS(NY,NX) - OXYW(NY,NX)=OXYW(NY,NX)+TOXQSS(NY,NX) - ZNGW(NY,NX)=ZNGW(NY,NX)+TNGQSS(NY,NX) - ZN2W(NY,NX)=ZN2W(NY,NX)+TN2QSS(NY,NX) - ZN4W(NY,NX)=ZN4W(NY,NX)+TN4QSS(NY,NX) - ZN3W(NY,NX)=ZN3W(NY,NX)+TN3QSS(NY,NX) - ZNOW(NY,NX)=ZNOW(NY,NX)+TNOQSS(NY,NX) - ZHPW(NY,NX)=ZHPW(NY,NX)+TPOQSS(NY,NX) - IF(ISALT(NY,NX).NE.0)THEN - ZALW(NY,NX)=ZALW(NY,NX)+TQSAL(NY,NX) - ZFEW(NY,NX)=ZFEW(NY,NX)+TQSFE(NY,NX) - ZHYW(NY,NX)=ZHYW(NY,NX)+TQSHY(NY,NX) - ZCAW(NY,NX)=ZCAW(NY,NX)+TQSCA(NY,NX) - ZMGW(NY,NX)=ZMGW(NY,NX)+TQSMG(NY,NX) - ZNAW(NY,NX)=ZNAW(NY,NX)+TQSNA(NY,NX) - ZKAW(NY,NX)=ZKAW(NY,NX)+TQSKA(NY,NX) - ZOHW(NY,NX)=ZOHW(NY,NX)+TQSOH(NY,NX) - ZSO4W(NY,NX)=ZSO4W(NY,NX)+TQSSO(NY,NX) - ZCLW(NY,NX)=ZCLW(NY,NX)+TQSCL(NY,NX) - ZCO3W(NY,NX)=ZCO3W(NY,NX)+TQSC3(NY,NX) - ZHCO3W(NY,NX)=ZHCO3W(NY,NX)+TQSHC(NY,NX) - ZALH1W(NY,NX)=ZALH1W(NY,NX)+TQSAL1(NY,NX) - ZALH2W(NY,NX)=ZALH2W(NY,NX)+TQSAL2(NY,NX) - ZALH3W(NY,NX)=ZALH3W(NY,NX)+TQSAL3(NY,NX) - ZALH4W(NY,NX)=ZALH4W(NY,NX)+TQSAL4(NY,NX) - ZALSW(NY,NX)=ZALSW(NY,NX)+TQSALS(NY,NX) - ZFEH1W(NY,NX)=ZFEH1W(NY,NX)+TQSFE1(NY,NX) - ZFEH2W(NY,NX)=ZFEH2W(NY,NX)+TQSFE2(NY,NX) - ZFEH3W(NY,NX)=ZFEH3W(NY,NX)+TQSFE3(NY,NX) - ZFEH4W(NY,NX)=ZFEH4W(NY,NX)+TQSFE4(NY,NX) - ZFESW(NY,NX)=ZFESW(NY,NX)+TQSFES(NY,NX) - ZCAOW(NY,NX)=ZCAOW(NY,NX)+TQSCAO(NY,NX) - ZCACW(NY,NX)=ZCACW(NY,NX)+TQSCAC(NY,NX) - ZCAHW(NY,NX)=ZCAHW(NY,NX)+TQSCAH(NY,NX) - ZCASW(NY,NX)=ZCASW(NY,NX)+TQSCAS(NY,NX) - ZMGOW(NY,NX)=ZMGOW(NY,NX)+TQSMGO(NY,NX) - ZMGCW(NY,NX)=ZMGCW(NY,NX)+TQSMGC(NY,NX) - ZMGHW(NY,NX)=ZMGHW(NY,NX)+TQSMGH(NY,NX) - ZMGSW(NY,NX)=ZMGSW(NY,NX)+TQSMGS(NY,NX) - ZNACW(NY,NX)=ZNACW(NY,NX)+TQSNAC(NY,NX) - ZNASW(NY,NX)=ZNASW(NY,NX)+TQSNAS(NY,NX) - ZKASW(NY,NX)=ZKASW(NY,NX)+TQSKAS(NY,NX) - H0PO4W(NY,NX)=H0PO4W(NY,NX)+TQSH0P(NY,NX) - H1PO4W(NY,NX)=H1PO4W(NY,NX)+TQSH1P(NY,NX) - H3PO4W(NY,NX)=H3PO4W(NY,NX)+TQSH3P(NY,NX) - ZFE1PW(NY,NX)=ZFE1PW(NY,NX)+TQSF1P(NY,NX) - ZFE2PW(NY,NX)=ZFE2PW(NY,NX)+TQSF2P(NY,NX) - ZCA0PW(NY,NX)=ZCA0PW(NY,NX)+TQSC0P(NY,NX) - ZCA1PW(NY,NX)=ZCA1PW(NY,NX)+TQSC1P(NY,NX) - ZCA2PW(NY,NX)=ZCA2PW(NY,NX)+TQSC2P(NY,NX) - ZMG1PW(NY,NX)=ZMG1PW(NY,NX)+TQSM1P(NY,NX) - ENDIF - ENDIF -C -C UPDATE STATE VARIABLES WITH TOTAL FLUXES CALCULATED ABOVE -C -C IF(J.EQ.24)THEN -C -C TOTAL C,N,P IN SURFACE RESIDUE -C - RC=0.0 - RN=0.0 - RP=0.0 - DO 6975 K=0,5 - RC0(K,NY,NX)=0.0 - RA0(K,NY,NX)=0.0 -6975 CONTINUE - OMCL(0,NY,NX)=0.0 - OMNL(0,NY,NX)=0.0 - DO 6970 K=0,5 - IF(K.NE.3.AND.K.NE.4)THEN -C -C TOTAL MICROBIAL C,N,P -C - DO 6960 N=1,7 - DO 6960 M=1,3 - RC=RC+OMC(M,N,K,0,NY,NX) - RN=RN+OMN(M,N,K,0,NY,NX) - RP=RP+OMP(M,N,K,0,NY,NX) - RC0(K,NY,NX)=RC0(K,NY,NX)+OMC(M,N,K,0,NY,NX) - RA0(K,NY,NX)=RA0(K,NY,NX)+OMC(M,N,K,0,NY,NX) - TOMT(NY,NX)=TOMT(NY,NX)+OMC(M,N,K,0,NY,NX) - TONT(NY,NX)=TONT(NY,NX)+OMN(M,N,K,0,NY,NX) - TOPT(NY,NX)=TOPT(NY,NX)+OMP(M,N,K,0,NY,NX) - OMCL(0,NY,NX)=OMCL(0,NY,NX)+OMC(M,N,K,0,NY,NX) - OMNL(0,NY,NX)=OMNL(0,NY,NX)+OMN(M,N,K,0,NY,NX) -6960 CONTINUE - ENDIF -6970 CONTINUE -C -C TOTAL MICROBIAL RESIDUE C,N,P -C - DO 6900 K=0,2 - DO 6940 M=1,2 - RC=RC+ORC(M,K,0,NY,NX) - RN=RN+ORN(M,K,0,NY,NX) - RP=RP+ORP(M,K,0,NY,NX) - RC0(K,NY,NX)=RC0(K,NY,NX)+ORC(M,K,0,NY,NX) - RA0(K,NY,NX)=RA0(K,NY,NX)+ORC(M,K,0,NY,NX) -6940 CONTINUE -C -C TOTAL DOC, DON, DOP -C - RC=RC+OQC(K,0,NY,NX)+OQCH(K,0,NY,NX)+OHC(K,0,NY,NX)+OQA(K,0,NY,NX) - 2+OQAH(K,0,NY,NX)+OHA(K,0,NY,NX) - RN=RN+OQN(K,0,NY,NX)+OQNH(K,0,NY,NX)+OHN(K,0,NY,NX) - RP=RP+OQP(K,0,NY,NX)+OQPH(K,0,NY,NX)+OHP(K,0,NY,NX) - RC0(K,NY,NX)=RC0(K,NY,NX)+OQC(K,0,NY,NX)+OQCH(K,0,NY,NX) - 2+OHC(K,0,NY,NX)+OQA(K,0,NY,NX)+OQAH(K,0,NY,NX)+OHA(K,0,NY,NX) - RA0(K,NY,NX)=RA0(K,NY,NX)+OQC(K,0,NY,NX)+OQCH(K,0,NY,NX) - 2+OHC(K,0,NY,NX)+OQA(K,0,NY,NX)+OQAH(K,0,NY,NX)+OHA(K,0,NY,NX) -C -C TOTAL PLANT RESIDUE C,N,P -C - DO 6930 M=1,4 - RC=RC+OSC(M,K,0,NY,NX) - RN=RN+OSN(M,K,0,NY,NX) - RP=RP+OSP(M,K,0,NY,NX) - RC0(K,NY,NX)=RC0(K,NY,NX)+OSC(M,K,0,NY,NX) - RA0(K,NY,NX)=RA0(K,NY,NX)+OSA(M,K,0,NY,NX) -6930 CONTINUE -6900 CONTINUE - ORGC(0,NY,NX)=RC - ORGN(0,NY,NX)=RN - ORGR(0,NY,NX)=RC - TLRSDC=TLRSDC+RC - URSDC(NY,NX)=URSDC(NY,NX)+RC - TLRSDN=TLRSDN+RN - URSDN(NY,NX)=URSDN(NY,NX)+RN - TLRSDP=TLRSDP+RP - URSDP(NY,NX)=URSDP(NY,NX)+RP - WS=TVOLWC(NY,NX)+TVOLWP(NY,NX)+VOLW(0,NY,NX)+VOLI(0,NY,NX)*0.92 - VOLWSO=VOLWSO+WS - UVOLW(NY,NX)=UVOLW(NY,NX)+WS - ENGYR=VHCPR(NY,NX)*TKS(0,NY,NX) - HEATSO=HEATSO+TENGYC(NY,NX)+ENGYR - CS=CO2S(0,NY,NX)+CH4S(0,NY,NX) - TLCO2G=TLCO2G+CS - UCO2S(NY,NX)=UCO2S(NY,NX)+CS - OS=OXYS(0,NY,NX) - OXYGSO=OXYGSO+OS - ZG=Z2GS(0,NY,NX)+Z2OS(0,NY,NX) - TLN2G=TLN2G+ZG - ZNH=ZNH4S(0,NY,NX)+ZNH3S(0,NY,NX) - TLNH4=TLNH4+ZNH - UNH4(NY,NX)=UNH4(NY,NX)+ZNH+14.0*(XN4(0,NY,NX)+XNB(0,NY,NX)) - XN4(0,NY,NX)=XN4(0,NY,NX)+TRXN4(0,NY,NX) - ZNO=ZNO3S(0,NY,NX)+ZNO2S(0,NY,NX) - TLNO3=TLNO3+ZNO - UNO3(NY,NX)=UNO3(NY,NX)+ZNO - P4=H2PO4(0,NY,NX) - TLPO4=TLPO4+P4 - UPO4(NY,NX)=UPO4(NY,NX)+P4+31.0*(XH1P(0,NY,NX)+XH2P(0,NY,NX)) - PALPO(0,NY,NX)=PALPO(0,NY,NX)+TRALPO(0,NY,NX) - PFEPO(0,NY,NX)=PFEPO(0,NY,NX)+TRFEPO(0,NY,NX) - PCAPD(0,NY,NX)=PCAPD(0,NY,NX)+TRCAPD(0,NY,NX) - PCAPH(0,NY,NX)=PCAPH(0,NY,NX)+TRCAPH(0,NY,NX) - PCAPM(0,NY,NX)=PCAPM(0,NY,NX)+TRCAPM(0,NY,NX) - UPP4(NY,NX)=UPP4(NY,NX)+31.0*(PALPO(0,NY,NX)+PFEPO(0,NY,NX) - 2+PCAPD(0,NY,NX))+93.0*PCAPH(0,NY,NX)+62.0*PCAPM(0,NY,NX) - TX=2.0*XN4(0,NY,NX)+XOH0(0,NY,NX) - 2+2.0*(PALPO(0,NY,NX)+PFEPO(0,NY,NX)+XOH1(0,NY,NX)) - 3+3.0*(PCAPD(0,NY,NX)+XOH2(0,NY,NX)+XH1P(0,NY,NX)) - 4+4.0*XH2P(0,NY,NX)+7.0*PCAPM(0,NY,NX)+9.0*PCAPH(0,NY,NX) - TF=2.0*ZNH4FA(0,NY,NX)+ZNHUFA(0,NY,NX)+ZNO3FA(0,NY,NX) - 2+ZNH3FA(0,NY,NX) - TG=H2GS(0,NY,NX) - TI=TX+TF+TG - TION=TION+TI - UION(NY,NX)=UION(NY,NX)+TI - - IF(ISALT(NY,NX).NE.0)THEN - ZAL(0,NY,NX)=ZAL(0,NY,NX)+XALFLS(3,0,NY,NX) - ZFE(0,NY,NX)=ZFE(0,NY,NX)+XFEFLS(3,0,NY,NX) - ZHY(0,NY,NX)=ZHY(0,NY,NX)+XHYFLS(3,0,NY,NX) - ZCA(0,NY,NX)=ZCA(0,NY,NX)+XCAFLS(3,0,NY,NX) - ZMG(0,NY,NX)=ZMG(0,NY,NX)+XMGFLS(3,0,NY,NX) - ZNA(0,NY,NX)=ZNA(0,NY,NX)+XNAFLS(3,0,NY,NX) - ZKA(0,NY,NX)=ZKA(0,NY,NX)+XKAFLS(3,0,NY,NX) - ZOH(0,NY,NX)=ZOH(0,NY,NX)+XOHFLS(3,0,NY,NX) - ZSO4(0,NY,NX)=ZSO4(0,NY,NX)+XSOFLS(3,0,NY,NX) - ZCL(0,NY,NX)=ZCL(0,NY,NX)+XCLFLS(3,0,NY,NX) - ZCO3(0,NY,NX)=ZCO3(0,NY,NX)+XC3FLS(3,0,NY,NX) - ZHCO3(0,NY,NX)=ZHCO3(0,NY,NX)+XHCFLS(3,0,NY,NX) - ZALOH1(0,NY,NX)=ZALOH1(0,NY,NX)+XAL1FS(3,0,NY,NX) - ZALOH2(0,NY,NX)=ZALOH2(0,NY,NX)+XAL2FS(3,0,NY,NX) - ZALOH3(0,NY,NX)=ZALOH3(0,NY,NX)+XAL3FS(3,0,NY,NX) - ZALOH4(0,NY,NX)=ZALOH4(0,NY,NX)+XAL4FS(3,0,NY,NX) - ZALS(0,NY,NX)=ZALS(0,NY,NX)+XALSFS(3,0,NY,NX) - ZFEOH1(0,NY,NX)=ZFEOH1(0,NY,NX)+XFE1FS(3,0,NY,NX) - ZFEOH2(0,NY,NX)=ZFEOH2(0,NY,NX)+XFE2FS(3,0,NY,NX) - ZFEOH3(0,NY,NX)=ZFEOH3(0,NY,NX)+XFE3FS(3,0,NY,NX) - ZFEOH4(0,NY,NX)=ZFEOH4(0,NY,NX)+XFE4FS(3,0,NY,NX) - ZFES(0,NY,NX)=ZFES(0,NY,NX)+XFESFS(3,0,NY,NX) - ZCAO(0,NY,NX)=ZCAO(0,NY,NX)+XCAOFS(3,0,NY,NX) - ZCAC(0,NY,NX)=ZCAC(0,NY,NX)+XCACFS(3,0,NY,NX) - ZCAH(0,NY,NX)=ZCAH(0,NY,NX)+XCAHFS(3,0,NY,NX) - ZCAS(0,NY,NX)=ZCAS(0,NY,NX)+XCASFS(3,0,NY,NX) - ZMGO(0,NY,NX)=ZMGO(0,NY,NX)+XMGOFS(3,0,NY,NX) - ZMGC(0,NY,NX)=ZMGC(0,NY,NX)+XMGCFS(3,0,NY,NX) - ZMGH(0,NY,NX)=ZMGH(0,NY,NX)+XMGHFS(3,0,NY,NX) - ZMGS(0,NY,NX)=ZMGS(0,NY,NX)+XMGSFS(3,0,NY,NX) - ZNAC(0,NY,NX)=ZNAC(0,NY,NX)+XNACFS(3,0,NY,NX) - ZNAS(0,NY,NX)=ZNAS(0,NY,NX)+XNASFS(3,0,NY,NX) - ZKAS(0,NY,NX)=ZKAS(0,NY,NX)+XKASFS(3,0,NY,NX) - H0PO4(0,NY,NX)=H0PO4(0,NY,NX)+XH0PFS(3,0,NY,NX) - H1PO4(0,NY,NX)=H1PO4(0,NY,NX)+XH1PFS(3,0,NY,NX) - H3PO4(0,NY,NX)=H3PO4(0,NY,NX)+XH3PFS(3,0,NY,NX) - ZFE1P(0,NY,NX)=ZFE1P(0,NY,NX)+XF1PFS(3,0,NY,NX) - ZFE2P(0,NY,NX)=ZFE2P(0,NY,NX)+XF2PFS(3,0,NY,NX) - ZCA0P(0,NY,NX)=ZCA0P(0,NY,NX)+XC0PFS(3,0,NY,NX) - ZCA1P(0,NY,NX)=ZCA1P(0,NY,NX)+XC1PFS(3,0,NY,NX) - ZCA2P(0,NY,NX)=ZCA2P(0,NY,NX)+XC2PFS(3,0,NY,NX) - ZMG1P(0,NY,NX)=ZMG1P(0,NY,NX)+XM1PFS(3,0,NY,NX) - TS=ZAL(0,NY,NX)+ZFE(0,NY,NX)+ZHY(0,NY,NX)+ZCA(0,NY,NX) - 2+ZMG(0,NY,NX)+ZNA(0,NY,NX)+ZKA(0,NY,NX)+ZOH(0,NY,NX) - 3+ZSO4(0,NY,NX)+ZCL(0,NY,NX)+ZCO3(0,NY,NX)+H0PO4(0,NY,NX) - 4+2.0*(ZHCO3(0,NY,NX)+ZALOH1(0,NY,NX) - 5+ZALS(0,NY,NX)+ZFEOH1(0,NY,NX)+ZFES(0,NY,NX)+ZCAO(0,NY,NX) - 6+ZCAC(0,NY,NX)+ZCAS(0,NY,NX)+ZMGO(0,NY,NX)+ZMGC(0,NY,NX) - 7+ZMGS(0,NY,NX)+ZNAC(0,NY,NX)+ZNAS(0,NY,NX)+ZKAS(0,NY,NX) - 8+H1PO4(0,NY,NX)+ZCA0P(0,NY,NX)) - 9+3.0*(ZALOH2(0,NY,NX)+ZFEOH2(0,NY,NX)+ZCAH(0,NY,NX) - 1+ZMGH(0,NY,NX)+ZFE1P(0,NY,NX)+ZCA1P(0,NY,NX)+ZMG1P(0,NY,NX)) - 2+4.0* - 3(ZALOH3(0,NY,NX)+ZFEOH3(0,NY,NX)+H3PO4(0,NY,NX)+ZFE2P(0,NY,NX) - 4+ZCA2P(0,NY,NX))+5.0*(ZALOH4(0,NY,NX)+ZFEOH4(0,NY,NX)) - TION=TION+TS - UION(NY,NX)=UION(NY,NX)+TS - ENDIF -C ENDIF -C -C IF SNOWPACK OR SURFACE RESIDUE DISAPPEARS -C - IF(FLWSI(NY,NX).GT.0.0)THEN - VHCP(NU(NY,NX),NY,NX)=VHCM(NU(NY,NX),NY,NX) - 2+4.19*(VOLW(NU(NY,NX),NY,NX)+VOLWH(NU(NY,NX),NY,NX)) - 2+1.9274*(VOLI(NU(NY,NX),NY,NX)+VOLIH(NU(NY,NX),NY,NX)) - VOLI(NU(NY,NX),NY,NX)=VOLI(NU(NY,NX),NY,NX)+FLWSI(NY,NX) - ENGY=VHCP(NU(NY,NX),NY,NX)*TKS(NU(NY,NX),NY,NX) - VHCP(NU(NY,NX),NY,NX)=VHCM(NU(NY,NX),NY,NX) - 2+4.19*(VOLW(NU(NY,NX),NY,NX)+VOLWH(NU(NY,NX),NY,NX)) - 2+1.9274*(VOLI(NU(NY,NX),NY,NX)+VOLIH(NU(NY,NX),NY,NX)) - TKS(NU(NY,NX),NY,NX)=(ENGY+HFLWSI(NY,NX))/VHCP(NU(NY,NX),NY,NX) - ENDIF - VOLWX(NU(NY,NX),NY,NX)=VOLW(NU(NY,NX),NY,NX) - TCS(0,NY,NX)=TKS(0,NY,NX)-273.15 - TSMX(0,NY,NX)=AMAX1(TSMX(0,NY,NX),TCS(0,NY,NX)) - TSMN(0,NY,NX)=AMIN1(TSMN(0,NY,NX),TCS(0,NY,NX)) -C -C UPDATE SOIL LAYER VARIABLES WITH TOTAL FLUXES -C - DO 125 L=NU(NY,NX),NL(NY,NX) -C -C WATER, ICE, HEAT, TEMPERATURE -C - VHCP(L,NY,NX)=VHCM(L,NY,NX)+4.19*(VOLW(L,NY,NX)+VOLWH(L,NY,NX)) - 2+1.9274*(VOLI(L,NY,NX)+VOLIH(L,NY,NX)) - VOLW1=VOLW(L,NY,NX) - VOLW(L,NY,NX)=VOLW(L,NY,NX)+TFLW(L,NY,NX)+FINH(L,NY,NX) - 2+TTHAW(L,NY,NX)+TUPWTR(L,NY,NX) - 3+FLU(L,NY,NX)+18.0E-06*TRH2O(L,NY,NX) - IF(VOLW(L,NY,NX).GT.ZEROS(NY,NX))THEN - VOLWX(L,NY,NX)=VOLWX(L,NY,NX)+TFLWX(L,NY,NX)+FINH(L,NY,NX) - 2+TTHAW(L,NY,NX)+TUPWTR(L,NY,NX)*VOLWX(L,NY,NX)/VOLW(L,NY,NX) - 3+FLU(L,NY,NX)+18.0E-06*TRH2O(L,NY,NX)+FLWV(L,NY,NX) - VOLWX(L,NY,NX)=AMAX1(THETY(L,NY,NX)*VOLX(L,NY,NX) - 2,AMIN1(VOLW(L,NY,NX),VOLWX(L,NY,NX))) - ELSE - VOLWX(L,NY,NX)=0.0 - ENDIF - VOLI(L,NY,NX)=VOLI(L,NY,NX)-TTHAW(L,NY,NX)/0.92 - VOLWH(L,NY,NX)=VOLWH(L,NY,NX)+TFLWH(L,NY,NX)-FINH(L,NY,NX) - 2+TTHAWH(L,NY,NX) - VOLIH(L,NY,NX)=VOLIH(L,NY,NX)-TTHAWH(L,NY,NX)/0.92 - 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)) - ENGY=VHCP(L,NY,NX)*TKS(L,NY,NX) - VHCP1=VHCP(L,NY,NX) - TKS1=TKS(L,NY,NX) - VHCP(L,NY,NX)=VHCM(L,NY,NX)+4.19*(VOLW(L,NY,NX)+VOLWH(L,NY,NX)) - 2+1.9274*(VOLI(L,NY,NX)+VOLIH(L,NY,NX)) -C -C ARTIFICIAL SOIL WARMING -C -C IF(NX.EQ.3.AND.NY.EQ.2.AND.L.GT.NU(NY,NX) -C 3.AND.L.LE.17.AND.I.GE.152.AND.I.LE.304)THEN -C THFLW(L,NY,NX)=THFLW(L,NY,NX) -C 2+(TKSZ(I,J,L)-TKS(L,NY,NX))*VHCP(L,NY,NX) -C WRITE(*,3379)'TKSZ',I,J,NX,NY,L,TKSZ(I,J,L) -C 2,TKS(L,NY,NX),VHCP(L,NY,NX),THFLW(L,NY,NX) -3379 FORMAT(A8,6I4,12E12.4) -C ENDIF -C -C 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) - TCS(L,NY,NX)=TKS(L,NY,NX)-273.15 - TSMX(L,NY,NX)=AMAX1(TSMX(L,NY,NX),TCS(L,NY,NX)) - TSMN(L,NY,NX)=AMIN1(TSMN(L,NY,NX),TCS(L,NY,NX)) - UN2GS(NY,NX)=UN2GS(NY,NX)+XN2GS(L,NY,NX) -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),18.0E-06*TRH2O(L,NY,NX),TQR(NY,NX) -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) -6547 FORMAT(A8,5I4,20E16.8) -C WRITE(*,6633)'TKS',I,J,NX,NY,L,TKS(L,NY,NX),ENGY,THFLW(L,NY,NX) -C 2,THTHAW(L,NY,NX),TUPHT(L,NY,NX),HWFLU(L,NY,NX),VHCP(L,NY,NX) -C 3,VHCP1,TKS1,VOLW(L,NY,NX),VOLWH(L,NY,NX),VOLI(L,NY,NX) -C 4,VOLIH(L,NY,NX),TFLW(L,NY,NX),FINH(L,NY,NX),TTHAW(L,NY,NX) -C 5,TUPWTR(L,NY,NX),FLU(L,NY,NX),TRH2O(L,NY,NX),TQR(NY,NX) -C 6,FLWSI(NY,NX),HFLWSI(NY,NX) -6633 FORMAT(A8,5I4,30F20.6) -C ENDIF -C -C RESIDUE FROM PLANT LITTERFALL -C - DO 8565 K=0,1 - DO 8565 M=1,4 - OSC(M,K,L,NY,NX)=OSC(M,K,L,NY,NX)+CSNT(M,K,L,NY,NX) - OSN(M,K,L,NY,NX)=OSN(M,K,L,NY,NX)+ZSNT(M,K,L,NY,NX) - OSP(M,K,L,NY,NX)=OSP(M,K,L,NY,NX)+PSNT(M,K,L,NY,NX) -C IF((I/30)*30.EQ.I.AND.J.EQ.15)THEN -C WRITE(*,8484)'OSC',I,J,L,K,M,OSC(M,K,L,NY,NX) -C 2,OSN(M,K,L,NY,NX),OSP(M,K,L,NY,NX),CSNT(M,K,L,NY,NX) -C 3,ZSNT(M,K,L,NY,NX),PSNT(M,K,L,NY,NX) -8484 FORMAT(A8,5I4,12E12.4) -C ENDIF -8565 CONTINUE -C -C DOC, DON, DOP FROM AQUEOUS TRANSPORT -C - DO 8560 K=0,4 - OQC(K,L,NY,NX)=OQC(K,L,NY,NX)+TOCFLS(K,L,NY,NX) - 2+XOCFXS(K,L,NY,NX) - OQN(K,L,NY,NX)=OQN(K,L,NY,NX)+TONFLS(K,L,NY,NX) - 2+XONFXS(K,L,NY,NX) - OQP(K,L,NY,NX)=OQP(K,L,NY,NX)+TOPFLS(K,L,NY,NX) - 2+XOPFXS(K,L,NY,NX) - OQA(K,L,NY,NX)=OQA(K,L,NY,NX)+TOAFLS(K,L,NY,NX) - 2+XOAFXS(K,L,NY,NX) - OQCH(K,L,NY,NX)=OQCH(K,L,NY,NX)+TOCFHS(K,L,NY,NX) - 2-XOCFXS(K,L,NY,NX) - OQNH(K,L,NY,NX)=OQNH(K,L,NY,NX)+TONFHS(K,L,NY,NX) - 2-XONFXS(K,L,NY,NX) - OQPH(K,L,NY,NX)=OQPH(K,L,NY,NX)+TOPFHS(K,L,NY,NX) - 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 WRITE(*,2627)'OQC',I,J,NX,NY,L,K,OQC(K,L,NY,NX) -C 2,TOCFLS(K,L,NY,NX),XOCFXS(K,L,NY,NX),OQN(K,L,NY,NX) -C 3,TONFLS(K,L,NY,NX),XONFXS(K,L,NY,NX),OQNH(K,L,NY,NX) -C 4,TONFHS(K,L,NY,NX),XONFXS(K,L,NY,NX) -2627 FORMAT(A8,6I4,20E12.4) -C ENDIF -8560 CONTINUE -C -C DOC, DON, DOP FROM PLANT EXUDATION -C - OQC(1,L,NY,NX)=OQC(1,L,NY,NX)+TDFOMC(L,NY,NX) - OQN(1,L,NY,NX)=OQN(1,L,NY,NX)+TDFOMN(L,NY,NX) - OQP(1,L,NY,NX)=OQP(1,L,NY,NX)+TDFOMP(L,NY,NX) -C -C SOIL SOLUTES FROM AQUEOUS TRANSPORT, MICROBIAL AND ROOT -C EXCHANGE, EQUILIBRIUM REACTIONS, GAS EXCHANGE, -C MICROPORE-MACROPORE EXCHANGE, -C - CO2S(L,NY,NX)=CO2S(L,NY,NX)+TCOFLS(L,NY,NX)+XCODFG(L,NY,NX) - 2-RCO2O(L,NY,NX)-TCO2S(L,NY,NX)+RCOFLU(L,NY,NX)+XCOFXS(L,NY,NX) - 3+TRCO2(L,NY,NX)+XCOBBL(L,NY,NX) - CH4S(L,NY,NX)=CH4S(L,NY,NX)+TCHFLS(L,NY,NX)+XCHDFG(L,NY,NX) - 2-RCH4O(L,NY,NX)-TUPCHS(L,NY,NX)+RCHFLU(L,NY,NX) - 3+XCHFXS(L,NY,NX)+XCHBBL(L,NY,NX) - 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 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 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 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) -5432 FORMAT(A8,5I4,20E16.6) -C ENDIF - Z2GS(L,NY,NX)=Z2GS(L,NY,NX)+TNGFLS(L,NY,NX)+XNGDFG(L,NY,NX) - 2-RN2G(L,NY,NX)-TUPNF(L,NY,NX)+RNGFLU(L,NY,NX)+XNGFXS(L,NY,NX) - 3-XN2GS(L,NY,NX)+XNGBBL(L,NY,NX) - Z2OS(L,NY,NX)=Z2OS(L,NY,NX)+TN2FLS(L,NY,NX)+XN2DFG(L,NY,NX) - 2-RN2O(L,NY,NX)-TUPN2S(L,NY,NX)+RN2FLU(L,NY,NX)+XN2FXS(L,NY,NX) - 3+XN2BBL(L,NY,NX) -C IF(I.GT.160.AND.I.LT.190)THEN -C WRITE(*,4444)'Z2OS',I,J,NX,NY,L,Z2OS(L,NY,NX),TN2FLS(L,NY,NX) -C 2,XN2DFG(L,NY,NX),RN2O(L,NY,NX),TUPN2S(L,NY,NX),RN2FLU(L,NY,NX) -C 3,XN2FXS(L,NY,NX),Z2GS(L,NY,NX),TNGFLS(L,NY,NX),XNGDFG(L,NY,NX) -C 4,RN2G(L,NY,NX),TUPNF(L,NY,NX),RNGFLU(L,NY,NX),XNGFXS(L,NY,NX) -C 5,XN2GS(L,NY,NX),XNGBBL(L,NY,NX) -C ENDIF - H2GS(L,NY,NX)=H2GS(L,NY,NX)+THGFLS(L,NY,NX)+XHGDFG(L,NY,NX) - 2-RH2GO(L,NY,NX)-TUPHGS(L,NY,NX)+RHGFLU(L,NY,NX) - 3+XHGFXS(L,NY,NX)+XHGBBL(L,NY,NX) - ZNH3S(L,NY,NX)=ZNH3S(L,NY,NX)+TN3FLS(L,NY,NX)+XN3DFG(L,NY,NX) - 2-XN34SQ(L,NY,NX)+TRN3S(L,NY,NX)-TUPN3S(L,NY,NX)+RN3FLU(L,NY,NX) - 3+XN3FXW(L,NY,NX)+XN3BBL(L,NY,NX) - ZNH4S(L,NY,NX)=ZNH4S(L,NY,NX)+TN4FLS(L,NY,NX)+XNH4S(L,NY,NX) - 2+TRN4S(L,NY,NX)-TUPNH4(L,NY,NX)+RN4FLU(L,NY,NX) - 3+XN4FXW(L,NY,NX)+XN34SQ(L,NY,NX) -C IF(L.EQ.1)THEN -C WRITE(*,4444)'NH3',I,J,NX,NY,L,ZNH3S(L,NY,NX),TN3FLS(L,NY,NX) -C 2,XN3DFG(L,NY,NX),XN34SQ(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),ZNH4S(L,NY,NX) -C 4,TN4FLS(L,NY,NX),XNH4S(L,NY,NX),TRN4S(L,NY,NX),TUPNH4(L,NY,NX) -C 5,RN4FLU(L,NY,NX),XN4FXW(L,NY,NX),TN4QRS(NY,NX),TN3QRS(NY,NX) -C 6,ZNH3SH(L,NY,NX),ZNH4SH(L,NY,NX) -4444 FORMAT(A8,5I4,30E12.4) -C ENDIF - ZNO3S(L,NY,NX)=ZNO3S(L,NY,NX)+TNOFLS(L,NY,NX)+XNO3S(L,NY,NX) - 2+TRNO3(L,NY,NX)-TUPNO3(L,NY,NX)+RNOFLU(L,NY,NX) - 3+XNOFXW(L,NY,NX) - ZNO2S(L,NY,NX)=ZNO2S(L,NY,NX)+TNXFLS(L,NY,NX)+XNO2S(L,NY,NX) - 2+TRNO2(L,NY,NX)+XNXFXS(L,NY,NX) -C IF(L.EQ.NU(NY,NX))THEN -C WRITE(*,5545)'NO3',I,J,NX,NY,L,ZNO3S(L,NY,NX),TNOFLS(L,NY,NX) -C 2,XNO3S(L,NY,NX),TRNO3(L,NY,NX),TUPNO3(L,NY,NX),RNOFLU(L,NY,NX) -C 3,XNOFXW(L,NY,NX),ZNO2S(L,NY,NX),TNXFLS(L,NY,NX) -C 4,XNO2S(L,NY,NX),TRNO2(L,NY,NX),XNXFXS(L,NY,NX),TNXQRS(NY,NX) -5545 FORMAT(A8,5I4,40E12.4) -C ENDIF - H2PO4(L,NY,NX)=H2PO4(L,NY,NX)+TPOFLS(L,NY,NX)+XH2PS(L,NY,NX) - 2+TRH2P(L,NY,NX)-TUPH2P(L,NY,NX)+RH2PFU(L,NY,NX) - 3+XH2PXS(L,NY,NX) - ZNH3B(L,NY,NX)=ZNH3B(L,NY,NX)+TN3FLB(L,NY,NX)+XNBDFG(L,NY,NX) - 2-XN34BQ(L,NY,NX)+TRN3B(L,NY,NX)-TUPN3B(L,NY,NX)+RN3FBU(L,NY,NX) - 3+XN3FXB(L,NY,NX)+XNBBBL(L,NY,NX) - ZNH4B(L,NY,NX)=ZNH4B(L,NY,NX)+TN4FLB(L,NY,NX)+XNH4B(L,NY,NX) - 2+TRN4B(L,NY,NX)-TUPNHB(L,NY,NX)+RN4FBU(L,NY,NX) - 3+XN4FXB(L,NY,NX)+XN34BQ(L,NY,NX) - ZNO3B(L,NY,NX)=ZNO3B(L,NY,NX)+TNOFLB(L,NY,NX)+XNO3B(L,NY,NX) - 2+TRNOB(L,NY,NX)-TUPNOB(L,NY,NX)+RNOFBU(L,NY,NX) - 3+XNOFXB(L,NY,NX) - ZNO2B(L,NY,NX)=ZNO2B(L,NY,NX)+TNXFLB(L,NY,NX)+XNO2B(L,NY,NX) - 2+TRN2B(L,NY,NX)+XNXFXB(L,NY,NX) - H2POB(L,NY,NX)=H2POB(L,NY,NX)+TH2BFB(L,NY,NX)+XH2BS(L,NY,NX) - 2+TRH2B(L,NY,NX)-TUPH2B(L,NY,NX)+RH2BBU(L,NY,NX) - 3+XH2BXB(L,NY,NX) - THRE(NY,NX)=THRE(NY,NX)+RCO2O(L,NY,NX) - UN2GG(NY,NX)=UN2GG(NY,NX)+RN2G(L,NY,NX) - HN2GG(NY,NX)=HN2GG(NY,NX)+RN2G(L,NY,NX) -C -C EXCHANGEABLE CATIONS AND ANIONS FROM EXCHANGE REACTIONS -C - XN4(L,NY,NX)=XN4(L,NY,NX)+TRXN4(L,NY,NX) - XNB(L,NY,NX)=XNB(L,NY,NX)+TRXNB(L,NY,NX) - XOH0(L,NY,NX)=XOH0(L,NY,NX)+TRXH0(L,NY,NX) - XOH1(L,NY,NX)=XOH1(L,NY,NX)+TRXH1(L,NY,NX) - XOH2(L,NY,NX)=XOH2(L,NY,NX)+TRXH2(L,NY,NX) - XH1P(L,NY,NX)=XH1P(L,NY,NX)+TRX1P(L,NY,NX) - XH2P(L,NY,NX)=XH2P(L,NY,NX)+TRX2P(L,NY,NX) - XOH0B(L,NY,NX)=XOH0B(L,NY,NX)+TRBH0(L,NY,NX) - XOH1B(L,NY,NX)=XOH1B(L,NY,NX)+TRBH1(L,NY,NX) - XOH2B(L,NY,NX)=XOH2B(L,NY,NX)+TRBH2(L,NY,NX) - XH1PB(L,NY,NX)=XH1PB(L,NY,NX)+TRB1P(L,NY,NX) - XH2PB(L,NY,NX)=XH2PB(L,NY,NX)+TRB2P(L,NY,NX) -C IF(J.EQ.12.AND.L.LE.4)THEN -C WRITE(*,4445)'NHB',I,J,NX,NY,L,ZNH3B(L,NY,NX),TN3FLB(L,NY,NX) -C 2,XNBDFG(L,NY,NX),XN34BQ(L,NY,NX),TRN3B(L,NY,NX),TUPN3B(L,NY,NX) -C 3,RN3FBU(L,NY,NX),XN3FXB(L,NY,NX),XNBBBL(L,NY,NX),TUPNHB(L,NY,NX) -C 4,ZNH4B(L,NY,NX),TN4FLB(L,NY,NX),XNH4B(L,NY,NX) -C 5,TRN4B(L,NY,NX),TUPNHB(L,NY,NX),RN4FBU(L,NY,NX),XNB(L,NY,NX)*14.0 -C WRITE(*,4445)'NOB',I,J,NX,NY,L,ZNO2B(L,NY,NX),TNXFLB(L,NY,NX) -C 2,XNO2B(L,NY,NX),TRN2B(L,NY,NX),XNXFXB(L,NY,NX) -4445 FORMAT(A8,5I4,20E12.4) -C ENDIF -C -C PRECIPITATES FROM PRECIPITATION-DISSOLUTION REACTIONS -C - PALPO(L,NY,NX)=PALPO(L,NY,NX)+TRALPO(L,NY,NX) - PFEPO(L,NY,NX)=PFEPO(L,NY,NX)+TRFEPO(L,NY,NX) - PCAPD(L,NY,NX)=PCAPD(L,NY,NX)+TRCAPD(L,NY,NX) - PCAPH(L,NY,NX)=PCAPH(L,NY,NX)+TRCAPH(L,NY,NX) - PCAPM(L,NY,NX)=PCAPM(L,NY,NX)+TRCAPM(L,NY,NX) - PALPB(L,NY,NX)=PALPB(L,NY,NX)+TRALPB(L,NY,NX) - PFEPB(L,NY,NX)=PFEPB(L,NY,NX)+TRFEPB(L,NY,NX) - PCPDB(L,NY,NX)=PCPDB(L,NY,NX)+TRCPDB(L,NY,NX) - PCPHB(L,NY,NX)=PCPHB(L,NY,NX)+TRCPHB(L,NY,NX) - PCPMB(L,NY,NX)=PCPMB(L,NY,NX)+TRCPMB(L,NY,NX) -C -C MACROPORE SOLUTES FROM MACROPORE-MICROPORE EXCHANGE -C - CO2SH(L,NY,NX)=CO2SH(L,NY,NX)+TCOFHS(L,NY,NX)-XCOFXS(L,NY,NX) - CH4SH(L,NY,NX)=CH4SH(L,NY,NX)+TCHFHS(L,NY,NX)-XCHFXS(L,NY,NX) - OXYSH(L,NY,NX)=OXYSH(L,NY,NX)+TOXFHS(L,NY,NX)-XOXFXS(L,NY,NX) - Z2GSH(L,NY,NX)=Z2GSH(L,NY,NX)+TNGFHS(L,NY,NX)-XNGFXS(L,NY,NX) - Z2OSH(L,NY,NX)=Z2OSH(L,NY,NX)+TN2FHS(L,NY,NX)-XN2FXS(L,NY,NX) - H2GSH(L,NY,NX)=H2GSH(L,NY,NX)+THGFHS(L,NY,NX)-XHGFXS(L,NY,NX) - ZNH4SH(L,NY,NX)=ZNH4SH(L,NY,NX)+TN4FHS(L,NY,NX)-XN4FXW(L,NY,NX) - ZNH3SH(L,NY,NX)=ZNH3SH(L,NY,NX)+TN3FHS(L,NY,NX)-XN3FXW(L,NY,NX) - ZNO3SH(L,NY,NX)=ZNO3SH(L,NY,NX)+TNOFHS(L,NY,NX)-XNOFXW(L,NY,NX) - ZNO2SH(L,NY,NX)=ZNO2SH(L,NY,NX)+TNXFHS(L,NY,NX)-XNXFXS(L,NY,NX) - H2PO4H(L,NY,NX)=H2PO4H(L,NY,NX)+TPOFHS(L,NY,NX)-XH2PXS(L,NY,NX) - ZNH4BH(L,NY,NX)=ZNH4BH(L,NY,NX)+TN4FHB(L,NY,NX)-XN4FXB(L,NY,NX) - ZNH3BH(L,NY,NX)=ZNH3BH(L,NY,NX)+TN3FHB(L,NY,NX)-XN3FXB(L,NY,NX) - ZNO3BH(L,NY,NX)=ZNO3BH(L,NY,NX)+TNOFHB(L,NY,NX)-XNOFXB(L,NY,NX) - ZNO2BH(L,NY,NX)=ZNO2BH(L,NY,NX)+TNXFHB(L,NY,NX)-XNXFXB(L,NY,NX) - H2POBH(L,NY,NX)=H2POBH(L,NY,NX)+TH2BHB(L,NY,NX)-XH2BXB(L,NY,NX) -C IF(NX.EQ.1)THEN -C WRITE(*,4747)'ZNO3SH',I,J,NX,NY,L,ZNO3SH(L,NY,NX) -C 2,TNOFHS(L,NY,NX),XNOFXW(L,NY,NX) -C 3,ZNO2SH(L,NY,NX),TNXFHS(L,NY,NX),XNXFXS(L,NY,NX) -4747 FORMAT(A8,5I4,12E12.4) -C ENDIF -C -C GASES FROM VOLATILIZATION-DISSOLUTION AND GAS TRANSFER -C - CO2G(L,NY,NX)=CO2G(L,NY,NX)+TCOFLG(L,NY,NX)-XCODFG(L,NY,NX) - CH4G(L,NY,NX)=CH4G(L,NY,NX)+TCHFLG(L,NY,NX)-XCHDFG(L,NY,NX) - OXYG(L,NY,NX)=OXYG(L,NY,NX)+TOXFLG(L,NY,NX)-XOXDFG(L,NY,NX) - Z2GG(L,NY,NX)=Z2GG(L,NY,NX)+TNGFLG(L,NY,NX)-XNGDFG(L,NY,NX) - Z2OG(L,NY,NX)=Z2OG(L,NY,NX)+TN2FLG(L,NY,NX)-XN2DFG(L,NY,NX) - ZNH3G(L,NY,NX)=ZNH3G(L,NY,NX)+TNHFLG(L,NY,NX)-XN3DFG(L,NY,NX) - 2-XNBDFG(L,NY,NX)+TRN3G(L,NY,NX) - H2GG(L,NY,NX)=H2GG(L,NY,NX)+THGFLG(L,NY,NX)-XHGDFG(L,NY,NX) - ROXYF(L,NY,NX)=TOXFLG(L,NY,NX) - RCO2F(L,NY,NX)=TCOFLG(L,NY,NX) - RCH4F(L,NY,NX)=TCHFLG(L,NY,NX) - ROXYL(L,NY,NX)=TOXFLS(L,NY,NX)+ROXFLU(L,NY,NX)+XOXFXS(L,NY,NX) - 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 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 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 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) -C 5,XCHFXS(L,NY,NX),XCHBBL(L,NY,NX) -C ENDIF -C -C SALT SOLUTES IFROM EQUILIBRIUM REACTIONS, MICROPORE-MACROPORE -C EXCHANGE, AQUEOUS FLUXES -C - IF(ISALT(NY,NX).NE.0)THEN - XZHYU=0.0714*(TUPNH4(L,NY,NX)+TUPNHB(L,NY,NX)) - XZOHU=0.0714*(TUPNO3(L,NY,NX)+TUPNOB(L,NY,NX)) - ZAL(L,NY,NX)=ZAL(L,NY,NX)+TRAL(L,NY,NX)+TALFLS(L,NY,NX) - 2+RALFLU(L,NY,NX)+XALFXS(L,NY,NX) - ZFE(L,NY,NX)=ZFE(L,NY,NX)+TRFE(L,NY,NX)+TFEFLS(L,NY,NX) - 2+RFEFLU(L,NY,NX)+XFEFXS(L,NY,NX) - ZHY(L,NY,NX)=ZHY(L,NY,NX)+TRHY(L,NY,NX)+THYFLS(L,NY,NX) - 2+RHYFLU(L,NY,NX)+XHYFXS(L,NY,NX)+XZHYS(L,NY,NX)+XZHYU - ZCA(L,NY,NX)=ZCA(L,NY,NX)+TRCA(L,NY,NX)+TCAFLS(L,NY,NX) - 2+RCAFLU(L,NY,NX)+XCAFXS(L,NY,NX) - ZMG(L,NY,NX)=ZMG(L,NY,NX)+TRMG(L,NY,NX)+TMGFLS(L,NY,NX) - 2+RMGFLU(L,NY,NX)+XMGFXS(L,NY,NX) - ZNA(L,NY,NX)=ZNA(L,NY,NX)+TRNA(L,NY,NX)+TNAFLS(L,NY,NX) - 2+RNAFLU(L,NY,NX)+XNAFXS(L,NY,NX) - ZKA(L,NY,NX)=ZKA(L,NY,NX)+TRKA(L,NY,NX)+TKAFLS(L,NY,NX) - 2+RKAFLU(L,NY,NX)+XKAFXS(L,NY,NX) - ZOH(L,NY,NX)=ZOH(L,NY,NX)+TROH(L,NY,NX)+TOHFLS(L,NY,NX) - 2+ROHFLU(L,NY,NX)+XOHFXS(L,NY,NX)+XZOHU - ZSO4(L,NY,NX)=ZSO4(L,NY,NX)+TRSO4(L,NY,NX)+TSOFLS(L,NY,NX) - 2+RSOFLU(L,NY,NX)+XSOFXS(L,NY,NX) - ZCL(L,NY,NX)=ZCL(L,NY,NX)+TCLFLS(L,NY,NX)+RCLFLU(L,NY,NX) - 2+XCLFXS(L,NY,NX) - ZCO3(L,NY,NX)=ZCO3(L,NY,NX)+TRCO3(L,NY,NX)+TC3FLS(L,NY,NX) - 2+XC3FXS(L,NY,NX) - ZHCO3(L,NY,NX)=ZHCO3(L,NY,NX)+TRHCO(L,NY,NX)+THCFLS(L,NY,NX) - 2+XHCFXS(L,NY,NX) - ZALOH1(L,NY,NX)=ZALOH1(L,NY,NX)+TRAL1(L,NY,NX)+TAL1FS(L,NY,NX) - 2+XAL1XS(L,NY,NX) - ZALOH2(L,NY,NX)=ZALOH2(L,NY,NX)+TRAL2(L,NY,NX)+TAL2FS(L,NY,NX) - 2+XAL2XS(L,NY,NX) - ZALOH3(L,NY,NX)=ZALOH3(L,NY,NX)+TRAL3(L,NY,NX)+TAL3FS(L,NY,NX) - 2+XAL3XS(L,NY,NX) - ZALOH4(L,NY,NX)=ZALOH4(L,NY,NX)+TRAL4(L,NY,NX)+TAL4FS(L,NY,NX) - 2+XAL4XS(L,NY,NX) - ZALS(L,NY,NX)=ZALS(L,NY,NX)+TRALS(L,NY,NX)+TALSFS(L,NY,NX) - 2+XALSXS(L,NY,NX) - ZFEOH1(L,NY,NX)=ZFEOH1(L,NY,NX)+TRFE1(L,NY,NX)+TFE1FS(L,NY,NX) - 2+XFE1XS(L,NY,NX) - ZFEOH2(L,NY,NX)=ZFEOH2(L,NY,NX)+TRFE2(L,NY,NX)+TFE2FS(L,NY,NX) - 2+XFE2XS(L,NY,NX) - ZFEOH3(L,NY,NX)=ZFEOH3(L,NY,NX)+TRFE3(L,NY,NX)+TFE3FS(L,NY,NX) - 2+XFE3XS(L,NY,NX) - ZFEOH4(L,NY,NX)=ZFEOH4(L,NY,NX)+TRFE4(L,NY,NX)+TFE4FS(L,NY,NX) - 2+XFE4XS(L,NY,NX) - ZFES(L,NY,NX)=ZFES(L,NY,NX)+TRFES(L,NY,NX)+TFESFS(L,NY,NX) - 2+XFESXS(L,NY,NX) - ZCAO(L,NY,NX)=ZCAO(L,NY,NX)+TRCAO(L,NY,NX)+TCAOFS(L,NY,NX) - 2+XCAOXS(L,NY,NX) - ZCAC(L,NY,NX)=ZCAC(L,NY,NX)+TRCAC(L,NY,NX)+TCACFS(L,NY,NX) - 2+XCACXS(L,NY,NX) - ZCAH(L,NY,NX)=ZCAH(L,NY,NX)+TRCAH(L,NY,NX)+TCAHFS(L,NY,NX) - 2+XCAHXS(L,NY,NX) - ZCAS(L,NY,NX)=ZCAS(L,NY,NX)+TRCAS(L,NY,NX)+TCASFS(L,NY,NX) - 2+XCASXS(L,NY,NX) - ZMGO(L,NY,NX)=ZMGO(L,NY,NX)+TRMGO(L,NY,NX)+TMGOFS(L,NY,NX) - 2+XMGOXS(L,NY,NX) - ZMGC(L,NY,NX)=ZMGC(L,NY,NX)+TRMGC(L,NY,NX)+TMGCFS(L,NY,NX) - 2+XMGCXS(L,NY,NX) - ZMGH(L,NY,NX)=ZMGH(L,NY,NX)+TRMGH(L,NY,NX)+TMGHFS(L,NY,NX) - 2+XMGHXS(L,NY,NX) - ZMGS(L,NY,NX)=ZMGS(L,NY,NX)+TRMGS(L,NY,NX)+TMGSFS(L,NY,NX) - 2+XMGSXS(L,NY,NX) - ZNAC(L,NY,NX)=ZNAC(L,NY,NX)+TRNAC(L,NY,NX)+TNACFS(L,NY,NX) - 2+XNACXS(L,NY,NX) - ZNAS(L,NY,NX)=ZNAS(L,NY,NX)+TRNAS(L,NY,NX)+TNASFS(L,NY,NX) - 2+XNASXS(L,NY,NX) - ZKAS(L,NY,NX)=ZKAS(L,NY,NX)+TRKAS(L,NY,NX)+TKASFS(L,NY,NX) - 2+XKASXS(L,NY,NX) - H0PO4(L,NY,NX)=H0PO4(L,NY,NX)+TRH0P(L,NY,NX)+TH0PFS(L,NY,NX) - 2+XH0PXS(L,NY,NX) - H1PO4(L,NY,NX)=H1PO4(L,NY,NX)+TRH1P(L,NY,NX)+TH1PFS(L,NY,NX) - 2+XH1PXS(L,NY,NX) - H3PO4(L,NY,NX)=H3PO4(L,NY,NX)+TRH3P(L,NY,NX)+TH3PFS(L,NY,NX) - 2+XH3PXS(L,NY,NX) - ZFE1P(L,NY,NX)=ZFE1P(L,NY,NX)+TRF1P(L,NY,NX)+TF1PFS(L,NY,NX) - 2+XF1PXS(L,NY,NX) - ZFE2P(L,NY,NX)=ZFE2P(L,NY,NX)+TRF2P(L,NY,NX)+TF2PFS(L,NY,NX) - 2+XF2PXS(L,NY,NX) - ZCA0P(L,NY,NX)=ZCA0P(L,NY,NX)+TRC0P(L,NY,NX)+TC0PFS(L,NY,NX) - 2+XC0PXS(L,NY,NX) - ZCA1P(L,NY,NX)=ZCA1P(L,NY,NX)+TRC1P(L,NY,NX)+TC1PFS(L,NY,NX) - 2+XC1PXS(L,NY,NX) - ZCA2P(L,NY,NX)=ZCA2P(L,NY,NX)+TRC2P(L,NY,NX)+TC2PFS(L,NY,NX) - 2+XC2PXS(L,NY,NX) - ZMG1P(L,NY,NX)=ZMG1P(L,NY,NX)+TRM1P(L,NY,NX)+TM1PFS(L,NY,NX) - 2+XM1PXS(L,NY,NX) - H0POB(L,NY,NX)=H0POB(L,NY,NX)+TRH0B(L,NY,NX)+TH0BFB(L,NY,NX) - 2+XH0BXB(L,NY,NX) - H1POB(L,NY,NX)=H1POB(L,NY,NX)+TRH1B(L,NY,NX)+TH1BFB(L,NY,NX) - 2+XH1BXB(L,NY,NX) - H3POB(L,NY,NX)=H3POB(L,NY,NX)+TRH3B(L,NY,NX)+TH3BFB(L,NY,NX) - 2+XH3BXB(L,NY,NX) - ZFE1PB(L,NY,NX)=ZFE1PB(L,NY,NX)+TRF1B(L,NY,NX)+TF1BFB(L,NY,NX) - 2+XF1BXB(L,NY,NX) - ZFE2PB(L,NY,NX)=ZFE2PB(L,NY,NX)+TRF2B(L,NY,NX)+TF2BFB(L,NY,NX) - 2+XF2BXB(L,NY,NX) - ZCA0PB(L,NY,NX)=ZCA0PB(L,NY,NX)+TRC0B(L,NY,NX)+TC0BFB(L,NY,NX) - 2+XC0BXB(L,NY,NX) - ZCA1PB(L,NY,NX)=ZCA1PB(L,NY,NX)+TRC1B(L,NY,NX)+TC1BFB(L,NY,NX) - 2+XC1BXB(L,NY,NX) - ZCA2PB(L,NY,NX)=ZCA2PB(L,NY,NX)+TRC2B(L,NY,NX)+TC2BFB(L,NY,NX) - 2+XC2BXB(L,NY,NX) - ZMG1PB(L,NY,NX)=ZMG1PB(L,NY,NX)+TRM1B(L,NY,NX)+TM1BFB(L,NY,NX) - 2+XM1BXB(L,NY,NX) - ZALH(L,NY,NX)=ZALH(L,NY,NX)+TALFHS(L,NY,NX)-XALFXS(L,NY,NX) - ZFEH(L,NY,NX)=ZFEH(L,NY,NX)+TFEFHS(L,NY,NX)-XFEFXS(L,NY,NX) - ZHYH(L,NY,NX)=ZHYH(L,NY,NX)+THYFHS(L,NY,NX)-XHYFXS(L,NY,NX) - ZCCH(L,NY,NX)=ZCCH(L,NY,NX)+TCAFHS(L,NY,NX)-XCAFXS(L,NY,NX) - ZMAH(L,NY,NX)=ZMAH(L,NY,NX)+TMGFHS(L,NY,NX)-XMGFXS(L,NY,NX) - ZNAH(L,NY,NX)=ZNAH(L,NY,NX)+TNAFHS(L,NY,NX)-XNAFXS(L,NY,NX) - ZKAH(L,NY,NX)=ZKAH(L,NY,NX)+TKAFHS(L,NY,NX)-XKAFXS(L,NY,NX) - ZOHH(L,NY,NX)=ZOHH(L,NY,NX)+TOHFHS(L,NY,NX)-XOHFXS(L,NY,NX) - ZSO4H(L,NY,NX)=ZSO4H(L,NY,NX)+TSOFHS(L,NY,NX)-XSOFXS(L,NY,NX) - ZCLH(L,NY,NX)=ZCLH(L,NY,NX)+TCLFHS(L,NY,NX)-XCLFXS(L,NY,NX) - ZCO3H(L,NY,NX)=ZCO3H(L,NY,NX)+TC3FHS(L,NY,NX)-XC3FXS(L,NY,NX) - ZHCO3H(L,NY,NX)=ZHCO3H(L,NY,NX)+THCFHS(L,NY,NX)-XHCFXS(L,NY,NX) - ZALO1H(L,NY,NX)=ZALO1H(L,NY,NX)+TAL1HS(L,NY,NX)-XAL1XS(L,NY,NX) - ZALO2H(L,NY,NX)=ZALO2H(L,NY,NX)+TAL2HS(L,NY,NX)-XAL2XS(L,NY,NX) - ZALO3H(L,NY,NX)=ZALO3H(L,NY,NX)+TAL3HS(L,NY,NX)-XAL3XS(L,NY,NX) - ZALO4H(L,NY,NX)=ZALO4H(L,NY,NX)+TAL4HS(L,NY,NX)-XAL4XS(L,NY,NX) - ZALSH(L,NY,NX)=ZALSH(L,NY,NX)+TALSHS(L,NY,NX)-XALSXS(L,NY,NX) - ZFEO1H(L,NY,NX)=ZFEO1H(L,NY,NX)+TFE1HS(L,NY,NX)-XFE1XS(L,NY,NX) - ZFEO2H(L,NY,NX)=ZFEO2H(L,NY,NX)+TFE2HS(L,NY,NX)-XFE2XS(L,NY,NX) - ZFEO3H(L,NY,NX)=ZFEO3H(L,NY,NX)+TFE3HS(L,NY,NX)-XFE3XS(L,NY,NX) - ZFEO4H(L,NY,NX)=ZFEO4H(L,NY,NX)+TFE4HS(L,NY,NX)-XFE4XS(L,NY,NX) - ZFESH(L,NY,NX)=ZFESH(L,NY,NX)+TFESHS(L,NY,NX)-XFESXS(L,NY,NX) - ZCAOH(L,NY,NX)=ZCAOH(L,NY,NX)+TCAOHS(L,NY,NX)-XCAOXS(L,NY,NX) - ZCACH(L,NY,NX)=ZCACH(L,NY,NX)+TCACHS(L,NY,NX)-XCACXS(L,NY,NX) - ZCAHH(L,NY,NX)=ZCAHH(L,NY,NX)+TCAHHS(L,NY,NX)-XCAHXS(L,NY,NX) - ZCASH(L,NY,NX)=ZCASH(L,NY,NX)+TCASHS(L,NY,NX)-XCASXS(L,NY,NX) - ZMGOH(L,NY,NX)=ZMGOH(L,NY,NX)+TMGOHS(L,NY,NX)-XMGOXS(L,NY,NX) - ZMGCH(L,NY,NX)=ZMGCH(L,NY,NX)+TMGCHS(L,NY,NX)-XMGCXS(L,NY,NX) - ZMGHH(L,NY,NX)=ZMGHH(L,NY,NX)+TMGHHS(L,NY,NX)-XMGHXS(L,NY,NX) - ZMGSH(L,NY,NX)=ZMGSH(L,NY,NX)+TMGSHS(L,NY,NX)-XMGSXS(L,NY,NX) - ZNACH(L,NY,NX)=ZNACH(L,NY,NX)+TNACHS(L,NY,NX)-XNACXS(L,NY,NX) - ZNASH(L,NY,NX)=ZNASH(L,NY,NX)+TNASHS(L,NY,NX)-XNASXS(L,NY,NX) - ZKASH(L,NY,NX)=ZKASH(L,NY,NX)+TKASHS(L,NY,NX)-XKASXS(L,NY,NX) - H0PO4H(L,NY,NX)=H0PO4H(L,NY,NX)+TH0PHS(L,NY,NX)-XH0PXS(L,NY,NX) - H1PO4H(L,NY,NX)=H1PO4H(L,NY,NX)+TH1PHS(L,NY,NX)-XH1PXS(L,NY,NX) - H3PO4H(L,NY,NX)=H3PO4H(L,NY,NX)+TH3PHS(L,NY,NX)-XH3PXS(L,NY,NX) - ZFE1PH(L,NY,NX)=ZFE1PH(L,NY,NX)+TF1PHS(L,NY,NX)-XF1PXS(L,NY,NX) - ZFE2PH(L,NY,NX)=ZFE2PH(L,NY,NX)+TF2PHS(L,NY,NX)-XF2PXS(L,NY,NX) - ZCA0PH(L,NY,NX)=ZCA0PH(L,NY,NX)+TC0PHS(L,NY,NX)-XC0PXS(L,NY,NX) - ZCA1PH(L,NY,NX)=ZCA1PH(L,NY,NX)+TC1PHS(L,NY,NX)-XC1PXS(L,NY,NX) - ZCA2PH(L,NY,NX)=ZCA2PH(L,NY,NX)+TC2PHS(L,NY,NX)-XC2PXS(L,NY,NX) - ZMG1PH(L,NY,NX)=ZMG1PH(L,NY,NX)+TM1PHS(L,NY,NX)-XM1PXS(L,NY,NX) - H0POBH(L,NY,NX)=H0POBH(L,NY,NX)+TH0BHB(L,NY,NX)-XH0BXB(L,NY,NX) - H1POBH(L,NY,NX)=H1POBH(L,NY,NX)+TH1BHB(L,NY,NX)-XH1BXB(L,NY,NX) - H3POBH(L,NY,NX)=H3POBH(L,NY,NX)+TH3BHB(L,NY,NX)-XH3BXB(L,NY,NX) - ZFE1BH(L,NY,NX)=ZFE1BH(L,NY,NX)+TF1BHB(L,NY,NX)-XF1BXB(L,NY,NX) - ZFE2BH(L,NY,NX)=ZFE2BH(L,NY,NX)+TF2BHB(L,NY,NX)-XF2BXB(L,NY,NX) - ZCA0BH(L,NY,NX)=ZCA0BH(L,NY,NX)+TC0BHB(L,NY,NX)-XC0BXB(L,NY,NX) - ZCA1BH(L,NY,NX)=ZCA1BH(L,NY,NX)+TC1BHB(L,NY,NX)-XC1BXB(L,NY,NX) - ZCA2BH(L,NY,NX)=ZCA2BH(L,NY,NX)+TC2BHB(L,NY,NX)-XC2BXB(L,NY,NX) - ZMG1BH(L,NY,NX)=ZMG1BH(L,NY,NX)+TM1BHB(L,NY,NX)-XM1BXB(L,NY,NX) - XHY(L,NY,NX)=XHY(L,NY,NX)+TRXHY(L,NY,NX) - XAL(L,NY,NX)=XAL(L,NY,NX)+TRXAL(L,NY,NX) - XCA(L,NY,NX)=XCA(L,NY,NX)+TRXCA(L,NY,NX) - XMG(L,NY,NX)=XMG(L,NY,NX)+TRXMG(L,NY,NX) - XNA(L,NY,NX)=XNA(L,NY,NX)+TRXNA(L,NY,NX) - XKA(L,NY,NX)=XKA(L,NY,NX)+TRXKA(L,NY,NX) - XHC(L,NY,NX)=XHC(L,NY,NX)+TRXHC(L,NY,NX) - XALO2(L,NY,NX)=XALO2(L,NY,NX)+TRXAL2(L,NY,NX) - PALOH(L,NY,NX)=PALOH(L,NY,NX)+TRALOH(L,NY,NX) - PFEOH(L,NY,NX)=PFEOH(L,NY,NX)+TRFEOH(L,NY,NX) - PCACO(L,NY,NX)=PCACO(L,NY,NX)+TRCACO(L,NY,NX) - PCASO(L,NY,NX)=PCASO(L,NY,NX)+TRCASO(L,NY,NX) -C -C SOIL ELECTRICAL CONDUCTIVITY -C - IF(VOLW(L,NY,NX).GT.0.0)THEN - ECHY=0.337*AMAX1(0.0,ZHY(L,NY,NX)/VOLW(L,NY,NX)) - ECOH=0.192*AMAX1(0.0,ZOH(L,NY,NX)/VOLW(L,NY,NX)) - ECAL=0.056*AMAX1(0.0,ZAL(L,NY,NX)*3.0/VOLW(L,NY,NX)) - ECFE=0.051*AMAX1(0.0,ZFE(L,NY,NX)*3.0/VOLW(L,NY,NX)) - ECCA=0.060*AMAX1(0.0,ZCA(L,NY,NX)*2.0/VOLW(L,NY,NX)) - ECMG=0.053*AMAX1(0.0,ZMG(L,NY,NX)*2.0/VOLW(L,NY,NX)) - ECNA=0.050*AMAX1(0.0,ZNA(L,NY,NX)/VOLW(L,NY,NX)) - ECKA=0.070*AMAX1(0.0,ZKA(L,NY,NX)/VOLW(L,NY,NX)) - ECCO=0.072*AMAX1(0.0,ZCO3(L,NY,NX)*2.0/VOLW(L,NY,NX)) - ECHC=0.044*AMAX1(0.0,ZHCO3(L,NY,NX)/VOLW(L,NY,NX)) - ECSO=0.080*AMAX1(0.0,ZSO4(L,NY,NX)*2.0/VOLW(L,NY,NX)) - ECCL=0.076*AMAX1(0.0,ZCL(L,NY,NX)/VOLW(L,NY,NX)) - ECNO=0.071*AMAX1(0.0,ZNO3S(L,NY,NX)/(VOLW(L,NY,NX)*14.0)) - ECND(L,NY,NX)=ECHY+ECOH+ECAL+ECFE+ECCA+ECMG+ECNA+ECKA - 2+ECCO+ECHC+ECSO+ECCL+ECNO - ELSE - ECND(L,NY,NX)=0.0 - ENDIF -C IF(NX.EQ.1.AND.NY.EQ.5)THEN -C WRITE(*,5656)'ECND',IYRC,I,J,NX,NY,L -C 2,ECND(L,NY,NX),VOLW(L,NY,NX),ECHY,ECOH,ECAL,ECFE,ECCA -C 3,ECMG,ECNA,ECKA,ECCO,ECHC,ECSO,ECCL,ECNO -5656 FORMAT(A8,6I4,30E12.4) -C ENDIF - ELSE - XZHYS(L,NY,NX)=0.0 - XZHYU=0.0 - XZOHU=0.0 - ENDIF -C -C GRID CELL BOUNDARY FLUXES FROM ROOT GAS TRANSFER -C - VOLWOU=VOLWOU-18.0E-06*TRH2O(L,NY,NX) - HEATIN=HEATIN+THTHAW(L,NY,NX)+TUPHT(L,NY,NX) - CI=TCOFLA(L,NY,NX) - CH=TCHFLA(L,NY,NX) - OI=TOXFLA(L,NY,NX) - ZGI=0.0 - Z2I=TN2FLA(L,NY,NX) - ZHI=TNHFLA(L,NY,NX) - TI=THGFLA(L,NY,NX) -C -C GRID CELL BOUNDARY FLUXES BUBBLING -C - IF(LG.EQ.0)THEN - CI=CI+XCOBBL(L,NY,NX) - CH=CH+XCHBBL(L,NY,NX) - OI=OI+XOXBBL(L,NY,NX) - ZGI=ZGI+XNGBBL(L,NY,NX) - Z2I=Z2I+XN2BBL(L,NY,NX) - ZHI=ZHI+XN3BBL(L,NY,NX)+XNBBBL(L,NY,NX) - TI=TI+XHGBBL(L,NY,NX) - ELSE - LL=MIN(L,LG) - CO2G(LL,NY,NX)=CO2G(LL,NY,NX)-XCOBBL(L,NY,NX) - CH4G(LL,NY,NX)=CH4G(LL,NY,NX)-XCHBBL(L,NY,NX) - OXYG(LL,NY,NX)=OXYG(LL,NY,NX)-XOXBBL(L,NY,NX) - Z2GG(LL,NY,NX)=Z2GG(LL,NY,NX)-XNGBBL(L,NY,NX) - Z2OG(LL,NY,NX)=Z2OG(LL,NY,NX)-XN2BBL(L,NY,NX) - ZNH3G(LL,NY,NX)=ZNH3G(LL,NY,NX)-XN3BBL(L,NY,NX)-XNBBBL(L,NY,NX) - H2GG(LL,NY,NX)=H2GG(LL,NY,NX)-XHGBBL(L,NY,NX) - IF(LG.LT.L)THEN - TLCO2G=TLCO2G-XCOBBL(L,NY,NX)-XCHBBL(L,NY,NX) - UCO2S(NY,NX)=UCO2S(NY,NX)-XCOBBL(L,NY,NX)-XCHBBL(L,NY,NX) - OXYGSO=OXYGSO-XOXBBL(L,NY,NX) - TLN2G=TLN2G-XNGBBL(L,NY,NX)-XN2BBL(L,NY,NX) - 2-XN3BBL(L,NY,NX)-XNBBBL(L,NY,NX) - TION=TION-XHGBBL(L,NY,NX) - ENDIF - ENDIF - CO2GIN=CO2GIN+CI+CH - CO=TCO2P(L,NY,NX)+TCO2S(L,NY,NX)-TRCO2(L,NY,NX) - HCO2G(NY,NX)=HCO2G(NY,NX)+CI - UCO2G(NY,NX)=UCO2G(NY,NX)+CI - HCH4G(NY,NX)=HCH4G(NY,NX)+CH - UCH4G(NY,NX)=UCH4G(NY,NX)+CH - TCOU=TCOU+CO - UCOP(NY,NX)=UCOP(NY,NX)+TCO2P(L,NY,NX)+TCO2S(L,NY,NX) - UDICD(NY,NX)=UDICD(NY,NX)-TRCO2(L,NY,NX) - TNBP(NY,NX)=TNBP(NY,NX)+CH+TRCO2(L,NY,NX) - OXYGIN=OXYGIN+OI - OO=RUPOXO(L,NY,NX)+TUPOXP(L,NY,NX)+TUPOXS(L,NY,NX) - UOXYG(NY,NX)=UOXYG(NY,NX)+OI - HOXYG(NY,NX)=HOXYG(NY,NX)+OI - OXYGOU=OXYGOU+OO - ZN2GIN=ZN2GIN+ZGI+Z2I+ZHI -C UN2GG(NY,NX)=UN2GG(NY,NX)+ZGI -C HN2GG(NY,NX)=HN2GG(NY,NX)+ZGI - UN2OG(NY,NX)=UN2OG(NY,NX)+Z2I - HN2OG(NY,NX)=HN2OG(NY,NX)+Z2I - UNH3G(NY,NX)=UNH3G(NY,NX)+ZHI - HNH3G(NY,NX)=HNH3G(NY,NX)+ZHI - UH2GG(NY,NX)=UH2GG(NY,NX)+TI -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 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,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) -C 6,CH4G(LL,NY,NX) -6645 FORMAT(A8,7I4,30E12.4) -C ENDIF -C -C GRID CELL BOUNDARY FLUXES FROM EQUILIBRIUM REACTIONS -C - TZOU=TZOU-14.0*(TBNH4(L,NY,NX)+TBNO3(L,NY,NX)+TBNH3(L,NY,NX)) - TPOU=TPOU-31.0*TBH2P(L,NY,NX) - TIONIN=TIONIN+TI - TO=2.0*TRH2O(L,NY,NX)+3.0*TBCO2(L,NY,NX)+2.0*TBNH4(L,NY,NX) - 2+TBNH3(L,NY,NX)+TBNO3(L,NY,NX)+3.0*TBH2P(L,NY,NX)-XZHYS(L,NY,NX) - 3+RH2GO(L,NY,NX)-XZHYU-XZOHU+TBION(L,NY,NX) - TIONOU=TIONOU+TO -C UIONOU(NY,NX)=UIONOU(NY,NX)+TO -C -C GAS AND SOLUTE EXCHANGE WITHIN GRID CELL ADDED TO ECOSYSTEM - -C TOTALS FOR CALCULATING COMPETITION CONSTRAINTS ON MICROBIAL -C AND ROOT POPULATIONS -C - DO 7990 K=0,5 - DO 7980 N=1,7 - ROXYX(L,NY,NX)=ROXYX(L,NY,NX)+ROXYS(N,K,L,NY,NX) - RNH4X(L,NY,NX)=RNH4X(L,NY,NX)+RVMX4(N,K,L,NY,NX) - 2+RINHO(N,K,L,NY,NX) - RNO3X(L,NY,NX)=RNO3X(L,NY,NX)+RVMX3(N,K,L,NY,NX) - 2+RINOO(N,K,L,NY,NX) - RNO2X(L,NY,NX)=RNO2X(L,NY,NX)+RVMX2(N,K,L,NY,NX) - RN2OX(L,NY,NX)=RN2OX(L,NY,NX)+RVMX1(N,K,L,NY,NX) - RPO4X(L,NY,NX)=RPO4X(L,NY,NX)+RIPOO(N,K,L,NY,NX) - RNHBX(L,NY,NX)=RNHBX(L,NY,NX)+RVMB4(N,K,L,NY,NX) - 2+RINHB(N,K,L,NY,NX) - RN3BX(L,NY,NX)=RN3BX(L,NY,NX)+RVMB3(N,K,L,NY,NX) - 2+RINOB(N,K,L,NY,NX) - RN2BX(L,NY,NX)=RN2BX(L,NY,NX)+RVMB2(N,K,L,NY,NX) - RPOBX(L,NY,NX)=RPOBX(L,NY,NX)+RIPOB(N,K,L,NY,NX) - IF(K.LE.4)THEN - ROQCX(K,L,NY,NX)=ROQCX(K,L,NY,NX)+ROQCS(N,K,L,NY,NX) - ROQAX(K,L,NY,NX)=ROQAX(K,L,NY,NX)+ROQAS(N,K,L,NY,NX) - ENDIF -7980 CONTINUE -7990 CONTINUE - RNO2X(L,NY,NX)=RNO2X(L,NY,NX)+RVMXC(L,NY,NX) - RN2BX(L,NY,NX)=RN2BX(L,NY,NX)+RVMBC(L,NY,NX) -C -C GRID CELL VARIABLES NEEDED FOR WATER, C, N, P, O, SOLUTE AND -C ENERGY BALANCES INCLUDING SUM OF ALL CURRENT STATE VARIABLES, -C CUMULATIVE SUMS OF ALL ADDITIONS AND REMOVALS SINCE START OF RUN -C -C IF(J.EQ.24)THEN - WS=VOLW(L,NY,NX)+VOLWH(L,NY,NX) - 2+(VOLI(L,NY,NX)+VOLIH(L,NY,NX))*0.92 - VOLWSO=VOLWSO+WS - UVOLW(NY,NX)=UVOLW(NY,NX)+WS -C 2-WP(L,NY,NX)*VOLX(L,NY,NX) - HEATSO=HEATSO+VHCP(L,NY,NX)*TKS(L,NY,NX) - SD=SAND(L,NY,NX)+SILT(L,NY,NX)+CLAY(L,NY,NX) - TSEDSO=TSEDSO+SD - CS=CO2G(L,NY,NX)+CO2S(L,NY,NX)+CO2SH(L,NY,NX)+TLCO2P(L,NY,NX) - 2+CH4G(L,NY,NX)+CH4S(L,NY,NX)+CH4SH(L,NY,NX)+TLCH4P(L,NY,NX) - TLCO2G=TLCO2G+CS - UCO2S(NY,NX)=UCO2S(NY,NX)+CS -C IF(NX.EQ.1.AND.NY.EQ.1)THEN -C WRITE(*,8642)'TLCO2G',I,J,L,TLCO2G,CS,CO2G(L,NY,NX),CO2S(L,NY,NX) -C 2,CO2SH(L,NY,NX),TLCO2P(L,NY,NX),CH4G(L,NY,NX),CH4S(L,NY,NX) -C 3,CH4SH(L,NY,NX),TLCH4P(L,NY,NX),UCO2S(NY,NX) -8642 FORMAT(A8,3I4,20F20.6) -C ENDIF - OS=OXYG(L,NY,NX)+OXYS(L,NY,NX)+OXYSH(L,NY,NX)+TLOXYP(L,NY,NX) - OXYGSO=OXYGSO+OS - ZG=Z2GG(L,NY,NX)+Z2GS(L,NY,NX)+Z2GSH(L,NY,NX)+TLN2OP(L,NY,NX) - 2+Z2OG(L,NY,NX)+Z2OS(L,NY,NX)+Z2OSH(L,NY,NX)+TLNH3P(L,NY,NX) - 3+ZNH3G(L,NY,NX) - TLN2G=TLN2G+ZG - ZNH=ZNH4S(L,NY,NX)+ZNH4SH(L,NY,NX)+ZNH4B(L,NY,NX)+ZNH4BH(L,NY,NX) - 2+ZNH3S(L,NY,NX)+ZNH3SH(L,NY,NX)+ZNH3B(L,NY,NX)+ZNH3BH(L,NY,NX) - TLNH4=TLNH4+ZNH - UNH4(NY,NX)=UNH4(NY,NX)+ZNH+14.0*(XN4(L,NY,NX)+XNB(L,NY,NX)) -C IF(NX.EQ.4)THEN -C WRITE(*,5455)'XNH4L',I,J,NX,NY,L,UNH4(NY,NX),ZNH,XN4(L,NY,NX) -C 2,XNB(L,NY,NX),ZNH4S(L,NY,NX),ZNH4SH(L,NY,NX) -C 3,ZNH4B(L,NY,NX),ZNH4BH(L,NY,NX),ZNH3S(L,NY,NX),ZNH3SH(L,NY,NX) -C 4,ZNH3B(L,NY,NX),ZNH3BH(L,NY,NX) -5455 FORMAT(A8,5I4,30E12.4) -C ENDIF - ZNO=ZNO3S(L,NY,NX)+ZNO3SH(L,NY,NX)+ZNO3B(L,NY,NX)+ZNO3BH(L,NY,NX) - 2+ZNO2S(L,NY,NX)+ZNO2SH(L,NY,NX)+ZNO2B(L,NY,NX)+ZNO2BH(L,NY,NX) - TLNO3=TLNO3+ZNO - UNO3(NY,NX)=UNO3(NY,NX)+ZNO - P4=H2PO4(L,NY,NX)+H2PO4H(L,NY,NX)+H2POB(L,NY,NX)+H2POBH(L,NY,NX) - TLPO4=TLPO4+P4 - UPO4(NY,NX)=UPO4(NY,NX)+P4+31.0*(XH1P(L,NY,NX)+XH2P(L,NY,NX) - 2+XH1PB(L,NY,NX)+XH2PB(L,NY,NX)) - UPP4(NY,NX)=UPP4(NY,NX)+31.0*(PALPO(L,NY,NX)+PFEPO(L,NY,NX) - 2+PCAPD(L,NY,NX)+PALPB(L,NY,NX)+PFEPB(L,NY,NX)+PCPDB(L,NY,NX)) - 3+93.0*(PCAPH(L,NY,NX)+PCPHB(L,NY,NX)) - 4+62.0*(PCAPM(L,NY,NX)+PCPMB(L,NY,NX)) -C -C TOTAL SON,SON,SOP -C - RC=0.0 - RN=0.0 - RP=0.0 - OC=0.0 - ON=0.0 - OP=0.0 - OMCL(L,NY,NX)=0.0 - OMNL(L,NY,NX)=0.0 - DO 7970 K=0,5 - IF(K.LE.2)THEN - DO 7960 N=1,7 - DO 7960 M=1,3 - RC=RC+OMC(M,N,K,L,NY,NX) - RN=RN+OMN(M,N,K,L,NY,NX) - RP=RP+OMP(M,N,K,L,NY,NX) - TOMT(NY,NX)=TOMT(NY,NX)+OMC(M,N,K,L,NY,NX) - TONT(NY,NX)=TONT(NY,NX)+OMN(M,N,K,L,NY,NX) - TOPT(NY,NX)=TOPT(NY,NX)+OMP(M,N,K,L,NY,NX) - OMCL(L,NY,NX)=OMCL(L,NY,NX)+OMC(M,N,K,L,NY,NX) - OMNL(L,NY,NX)=OMNL(L,NY,NX)+OMN(M,N,K,L,NY,NX) -7960 CONTINUE - ELSE - DO 7950 N=1,7 - DO 7950 M=1,3 - OC=OC+OMC(M,N,K,L,NY,NX) - ON=ON+OMN(M,N,K,L,NY,NX) - OP=OP+OMP(M,N,K,L,NY,NX) - TOMT(NY,NX)=TOMT(NY,NX)+OMC(M,N,K,L,NY,NX) - TONT(NY,NX)=TONT(NY,NX)+OMN(M,N,K,L,NY,NX) - TOPT(NY,NX)=TOPT(NY,NX)+OMP(M,N,K,L,NY,NX) - OMCL(L,NY,NX)=OMCL(L,NY,NX)+OMC(M,N,K,L,NY,NX) - OMNL(L,NY,NX)=OMNL(L,NY,NX)+OMN(M,N,K,L,NY,NX) -7950 CONTINUE - ENDIF -7970 CONTINUE - DO 7900 K=0,4 - IF(K.LE.2)THEN - DO 7940 M=1,2 - RC=RC+ORC(M,K,L,NY,NX) - RN=RN+ORN(M,K,L,NY,NX) - RP=RP+ORP(M,K,L,NY,NX) -7940 CONTINUE - RC=RC+OQC(K,L,NY,NX)+OQCH(K,L,NY,NX)+OHC(K,L,NY,NX) - 2+OQA(K,L,NY,NX)+OQAH(K,L,NY,NX)+OHA(K,L,NY,NX) - RN=RN+OQN(K,L,NY,NX)+OQNH(K,L,NY,NX)+OHN(K,L,NY,NX) - RP=RP+OQP(K,L,NY,NX)+OQPH(K,L,NY,NX)+OHP(K,L,NY,NX) - DO 7930 M=1,4 - RC=RC+OSC(M,K,L,NY,NX) - RN=RN+OSN(M,K,L,NY,NX) - RP=RP+OSP(M,K,L,NY,NX) -7930 CONTINUE - ELSE - DO 7920 M=1,2 - OC=OC+ORC(M,K,L,NY,NX) - ON=ON+ORN(M,K,L,NY,NX) - OP=OP+ORP(M,K,L,NY,NX) -7920 CONTINUE - OC=OC+OQC(K,L,NY,NX)+OQCH(K,L,NY,NX)+OHC(K,L,NY,NX) - 2+OQA(K,L,NY,NX)+OQAH(K,L,NY,NX)+OHA(K,L,NY,NX) - ON=ON+OQN(K,L,NY,NX)+OQNH(K,L,NY,NX)+OHN(K,L,NY,NX) - OP=OP+OQP(K,L,NY,NX)+OQPH(K,L,NY,NX)+OHP(K,L,NY,NX) - DO 7910 M=1,4 - OC=OC+OSC(M,K,L,NY,NX) - ON=ON+OSN(M,K,L,NY,NX) - OP=OP+OSP(M,K,L,NY,NX) -7910 CONTINUE - ENDIF -7900 CONTINUE - ORGC(L,NY,NX)=RC+OC - ORGN(L,NY,NX)=RN+ON - ORGR(L,NY,NX)=RC - TLRSDC=TLRSDC+RC - URSDC(NY,NX)=URSDC(NY,NX)+RC - TLRSDN=TLRSDN+RN - URSDN(NY,NX)=URSDN(NY,NX)+RN - TLRSDP=TLRSDP+RP - URSDP(NY,NX)=URSDP(NY,NX)+RP - TLORGC=TLORGC+OC - UORGC(NY,NX)=UORGC(NY,NX)+OC - TLORGN=TLORGN+ON - UORGN(NY,NX)=UORGN(NY,NX)+ON - TLORGP=TLORGP+OP - UORGP(NY,NX)=UORGP(NY,NX)+OP - TSEDSO=TSEDSO+(RC+OC)*1.0E-06 - TS=ZAL(L,NY,NX)+ZFE(L,NY,NX)+ZHY(L,NY,NX)+ZCA(L,NY,NX) - 2+ZMG(L,NY,NX)+ZNA(L,NY,NX)+ZKA(L,NY,NX)+ZOH(L,NY,NX) - 3+ZSO4(L,NY,NX)+ZCL(L,NY,NX)+ZCO3(L,NY,NX)+H0PO4(L,NY,NX) - 4+H0POB(L,NY,NX)+2.0*(ZHCO3(L,NY,NX)+ZALOH1(L,NY,NX) - 5+ZALS(L,NY,NX)+ZFEOH1(L,NY,NX)+ZFES(L,NY,NX)+ZCAO(L,NY,NX) - 6+ZCAC(L,NY,NX)+ZCAS(L,NY,NX)+ZMGO(L,NY,NX)+ZMGC(L,NY,NX) - 7+ZMGS(L,NY,NX)+ZNAC(L,NY,NX)+ZNAS(L,NY,NX)+ZKAS(L,NY,NX) - 8+H1PO4(L,NY,NX)+H1POB(L,NY,NX)+ZCA0P(L,NY,NX)+ZCA0PB(L,NY,NX)) - 9+3.0*(ZALOH2(L,NY,NX)+ZFEOH2(L,NY,NX)+ZCAH(L,NY,NX) - 1+ZMGH(L,NY,NX)+ZFE1P(L,NY,NX)+ZCA1P(L,NY,NX)+ZMG1P(L,NY,NX) - 2+ZFE1PB(L,NY,NX)+ZCA1PB(L,NY,NX)+ZMG1PB(L,NY,NX))+4.0* - 3(ZALOH3(L,NY,NX)+ZFEOH3(L,NY,NX)+H3PO4(L,NY,NX)+ZFE2P(L,NY,NX) - 4+ZCA2P(L,NY,NX)+H3POB(L,NY,NX)+ZFE2PB(L,NY,NX) - 5+ZCA2PB(L,NY,NX))+5.0*(ZALOH4(L,NY,NX)+ZFEOH4(L,NY,NX)) - TH=ZALH(L,NY,NX)+ZFEH(L,NY,NX)+ZHYH(L,NY,NX)+ZCCH(L,NY,NX) - 2+ZMAH(L,NY,NX)+ZNAH(L,NY,NX)+ZKAH(L,NY,NX)+ZOHH(L,NY,NX) - 3+ZSO4H(L,NY,NX)+ZCLH(L,NY,NX)+ZCO3H(L,NY,NX)+H0PO4H(L,NY,NX) - 4+H0POBH(L,NY,NX)+2.0*(ZHCO3H(L,NY,NX)+ZALO1H(L,NY,NX) - 5+ZALSH(L,NY,NX)+ZFEO1H(L,NY,NX)+ZFESH(L,NY,NX)+ZCAOH(L,NY,NX) - 6+ZCACH(L,NY,NX)+ZCASH(L,NY,NX)+ZMGOH(L,NY,NX)+ZMGCH(L,NY,NX) - 7+ZMGSH(L,NY,NX)+ZNACH(L,NY,NX)+ZNASH(L,NY,NX)+ZKASH(L,NY,NX) - 8+H1PO4H(L,NY,NX)+H1POBH(L,NY,NX)+ZCA0PH(L,NY,NX)+ZCA0BH(L,NY,NX)) - 9+3.0*(ZALO2H(L,NY,NX)+ZFEO2H(L,NY,NX)+ZCAHH(L,NY,NX) - 1+ZMGHH(L,NY,NX)+ZFE1PH(L,NY,NX)+ZCA1PH(L,NY,NX)+ZMG1PH(L,NY,NX) - 2+ZFE1BH(L,NY,NX)+ZCA1BH(L,NY,NX)+ZMG1BH(L,NY,NX))+4.0* - 3(ZALO3H(L,NY,NX)+ZFEO3H(L,NY,NX)+H3PO4H(L,NY,NX)+ZFE2PH(L,NY,NX) - 4+ZCA2PH(L,NY,NX)+H3POBH(L,NY,NX)+ZFE2BH(L,NY,NX) - 5+ZCA2BH(L,NY,NX))+5.0*(ZALO4H(L,NY,NX)+ZFEO4H(L,NY,NX)) - TX=2.0*(XN4(L,NY,NX)+XNB(L,NY,NX))+XHY(L,NY,NX)+XAL(L,NY,NX) - 2+XCA(L,NY,NX)+XMG(L,NY,NX)+XNA(L,NY,NX)+XKA(L,NY,NX)+XHC(L,NY,NX) - 3+XOH0(L,NY,NX)+XOH0B(L,NY,NX)+2.0*(PCACO(L,NY,NX)+PCASO(L,NY,NX) - 4+PALPO(L,NY,NX)+PFEPO(L,NY,NX)+PALPB(L,NY,NX)+PFEPB(L,NY,NX) - 5+XOH1(L,NY,NX)+XOH1B(L,NY,NX)) - 6+3.0*(PCAPD(L,NY,NX)+PCPDB(L,NY,NX)+XALO2(L,NY,NX) - 7+XOH2(L,NY,NX)+XOH2B(L,NY,NX)+XH1P(L,NY,NX)+XH1PB(L,NY,NX)) - 8+4.0*(PALOH(L,NY,NX)+PFEOH(L,NY,NX)+XH2P(L,NY,NX) - 9+XH2PB(L,NY,NX))+7.0*(PCAPM(L,NY,NX)+PCPMB(L,NY,NX)) - 1+9.0*(PCAPH(L,NY,NX)+PCPHB(L,NY,NX)) - TF=2.0*(ZNH4FA(L,NY,NX)+ZNH4FB(L,NY,NX))+ZNO3FA(L,NY,NX) - 2+ZNO3FB(L,NY,NX)+ZNH3FA(L,NY,NX)+ZNH3FB(L,NY,NX) - 3+ZNHUFA(L,NY,NX)+ZNHUFB(L,NY,NX) - TG=H2GG(L,NY,NX)+H2GS(L,NY,NX)+H2GSH(L,NY,NX)+TLH2GP(L,NY,NX) - TI=TS+TH+TX+TF+TG - TION=TION+TI - UION(NY,NX)=UION(NY,NX)+TI -C ENDIF -125 CONTINUE - TRN(NY,NX)=TRN(NY,NX)+HEATI(NY,NX) - TLE(NY,NX)=TLE(NY,NX)+HEATE(NY,NX) - TSH(NY,NX)=TSH(NY,NX)+HEATS(NY,NX) - TGH(NY,NX)=TGH(NY,NX)-(HEATH(NY,NX)-HEATV(NY,NX)) - TLEC(NY,NX)=TLEC(NY,NX)+HEATE(NY,NX)*RAC(NY,NX) - TSHC(NY,NX)=TSHC(NY,NX)+HEATS(NY,NX)*RAC(NY,NX) - TCNET(NY,NX)=TCNET(NY,NX)+HCO2G(NY,NX) - RECO(NY,NX)=RECO(NY,NX)+HCO2G(NY,NX) - TNBP(NY,NX)=TNBP(NY,NX)+TCNET(NY,NX) -C -C UPDATE STATE VARIABLES WHEN SURFACE SEDIMENT TRANSPORT -C FORCES SOIL RE-LAYERING IF SURFACE LAYER BECOMES TOO -C THIN OR TOO THICK -C - IF(DLYR(3,NU(NY,NX),NY,NX).LT.DNUMN - 2.OR.DLYR(3,NU(NY,NX),NY,NX).GT.DNUMX)THEN - L0=NU(NY,NX) - IF(DLYR(3,NU(NY,NX),NY,NX).LT.DNUMN)THEN - FX=1.0 - L1=NU(NY,NX)+1 - NU(NY,NX)=L1 - ELSE - IF(NU(NY,NX).EQ.1)THEN - FX=(DLYR(3,NU(NY,NX),NY,NX)-DNUMX)/DLYR(3,NU(NY,NX),NY,NX) - L1=NU(NY,NX)+1 - NU(NY,NX)=L0 - ELSE - FZ=DLYR(3,NU(NY,NX),NY,NX)-DNUMX - IF(FZ.GT.DNUMN)THEN - FX=(DLYR(3,NU(NY,NX),NY,NX)-DNUMX)/DLYR(3,NU(NY,NX),NY,NX) - L1=NU(NY,NX)-1 - NU(NY,NX)=L1 - ELSE - FX=0.0 - L1=NU(NY,NX) - ENDIF - ENDIF - ENDIF - WRITE(*,5599)'ERODE1',I,J,NX,NY,L0,L1,NU(NY,NX),DNUMN,DNUMX - 2,DLYR(3,L0,NY,NX),DLYR(3,L1,NY,NX),FX -5599 FORMAT(A8,7I4,12E12.4) - IF(FX.GT.0.0)THEN - FY=1.0-FX - BKDS(L1,NY,NX)=(BKDS(L1,NY,NX) - 2*DLYR(3,L1,NY,NX)+BKDS(L0,NY,NX) - 3*FX*DLYR(3,L0,NY,NX))/(DLYR(3,L1,NY,NX) - 4+FX*DLYR(3,L0,NY,NX)) - VLNHB(L1,NY,NX)=(VLNHB(L1,NY,NX) - 2*DLYR(3,L1,NY,NX)+VLNHB(L0,NY,NX) - 3*FX*DLYR(3,L0,NY,NX))/(DLYR(3,L1,NY,NX) - 4+FX*DLYR(3,L0,NY,NX)) - VLNOB(L1,NY,NX)=(VLNOB(L1,NY,NX) - 2*DLYR(3,L1,NY,NX)+VLNOB(L0,NY,NX) - 3*FX*DLYR(3,L0,NY,NX))/(DLYR(3,L1,NY,NX) - 4+FX*DLYR(3,L0,NY,NX)) - VLPOB(L1,NY,NX)=(VLPOB(L1,NY,NX) - 2*DLYR(3,L1,NY,NX)+VLPOB(L0,NY,NX) - 3*FX*DLYR(3,L0,NY,NX))/(DLYR(3,L1,NY,NX) - 4+FX*DLYR(3,L0,NY,NX)) - VLNH4(L1,NY,NX)=1.0-VLNHB(L1,NY,NX) - VLNO3(L1,NY,NX)=1.0-VLNOB(L1,NY,NX) - VLPO4(L1,NY,NX)=1.0-VLPOB(L1,NY,NX) - DLYR(3,L1,NY,NX)=DLYR(3,L1,NY,NX) - 2+FX*DLYR(3,L0,NY,NX) - VOLX(L1,NY,NX)=VOLX(L1,NY,NX) - 2+FX*VOLX(L0,NY,NX) - BKVL(L1,NY,NX)=BKVL(L1,NY,NX) - 2+FX*BKVL(L0,NY,NX) - SAND(L1,NY,NX)=SAND(L1,NY,NX) - 2+FX*SAND(L0,NY,NX) - SILT(L1,NY,NX)=SILT(L1,NY,NX) - 2+FX*SILT(L0,NY,NX) - CLAY(L1,NY,NX)=CLAY(L1,NY,NX) - 2+FX*CLAY(L0,NY,NX) - XCEC(L1,NY,NX)=XCEC(L1,NY,NX) - 2+FX*XCEC(L0,NY,NX) - XAEC(L1,NY,NX)=XAEC(L1,NY,NX) - 2+FX*XAEC(L0,NY,NX) - VOLW(L1,NY,NX)=VOLW(L1,NY,NX) - 2+FX*VOLW(L0,NY,NX) - VOLI(L1,NY,NX)=VOLI(L1,NY,NX) - 2+FX*VOLI(L0,NY,NX) - VOLIH(L1,NY,NX)=VOLIH(L1,NY,NX) - 2+FX*VOLIH(L0,NY,NX) - VOLP(L1,NY,NX)=VOLP(L1,NY,NX) - 2+FX*VOLP(L0,NY,NX) - VOLA(L1,NY,NX)=VOLA(L1,NY,NX) - 2+FX*VOLA(L0,NY,NX) - VOLWX(L1,NY,NX)=VOLW(L0,NY,NX) - VOLWH(L1,NY,NX)=VOLWH(L1,NY,NX) - 2+FX*VOLWH(L0,NY,NX) - VOLAH(L1,NY,NX)=VOLAH(L1,NY,NX) - 2+FX*VOLAH(L0,NY,NX) - VHCM(L1,NY,NX)=VHCM(L1,NY,NX) - 2+FX*VHCM(L0,NY,NX) - VHCP(L1,NY,NX)=VHCM(L1,NY,NX) - 2+4.19*(VOLW(L1,NY,NX)+VOLWH(L1,NY,NX)) - 3+1.9274*(VOLI(L1,NY,NX)+VOLIH(L1,NY,NX)) - ZNH4FA(L1,NY,NX)=ZNH4FA(L1,NY,NX) - 2+FX*ZNH4FA(L0,NY,NX) - ZNH3FA(L1,NY,NX)=ZNH3FA(L1,NY,NX) - 2+FX*ZNH3FA(L0,NY,NX) - ZNHUFA(L1,NY,NX)=ZNHUFA(L1,NY,NX) - 2+FX*ZNHUFA(L0,NY,NX) - ZNO3FA(L1,NY,NX)=ZNO3FA(L1,NY,NX) - 2+FX*ZNO3FA(L0,NY,NX) - ZNH4FB(L1,NY,NX)=ZNH4FB(L1,NY,NX) - 2+FX*ZNH4FB(L0,NY,NX) - ZNH3FB(L1,NY,NX)=ZNH3FB(L1,NY,NX) - 2+FX*ZNH3FB(L0,NY,NX) - ZNHUFB(L1,NY,NX)=ZNHUFB(L1,NY,NX) - 2+FX*ZNHUFB(L0,NY,NX) - ZNO3FB(L1,NY,NX)=ZNO3FB(L1,NY,NX) - 2+FX*ZNO3FB(L0,NY,NX) - ZNH4S(L1,NY,NX)=ZNH4S(L1,NY,NX) - 2+FX*ZNH4S(L0,NY,NX) - ZNH4B(L1,NY,NX)=ZNH4B(L1,NY,NX) - 2+FX*ZNH4B(L0,NY,NX) - ZNH3S(L1,NY,NX)=ZNH3S(L1,NY,NX) - 2+FX*ZNH3S(L0,NY,NX) - ZNH3B(L1,NY,NX)=ZNH3B(L1,NY,NX) - 2+FX*ZNH3B(L0,NY,NX) - ZNO3S(L1,NY,NX)=ZNO3S(L1,NY,NX) - 2+FX*ZNO3S(L0,NY,NX) - ZNO3B(L1,NY,NX)=ZNO3B(L1,NY,NX) - 2+FX*ZNO3B(L0,NY,NX) - ZNO2S(L1,NY,NX)=ZNO2S(L1,NY,NX) - 2+FX*ZNO2S(L0,NY,NX) - ZNO2B(L1,NY,NX)=ZNO2B(L1,NY,NX) - 2+FX*ZNO2B(L0,NY,NX) - ZAL(L1,NY,NX)=ZAL(L1,NY,NX) - 2+FX*ZAL(L0,NY,NX) - ZFE(L1,NY,NX)=ZFE(L1,NY,NX) - 2+FX*ZFE(L0,NY,NX) - ZHY(L1,NY,NX)=ZHY(L1,NY,NX) - 2+FX*ZHY(L0,NY,NX) - ZCA(L1,NY,NX)=ZCA(L1,NY,NX) - 2+FX*ZCA(L0,NY,NX) - ZMG(L1,NY,NX)=ZMG(L1,NY,NX) - 2+FX*ZMG(L0,NY,NX) - ZNA(L1,NY,NX)=ZNA(L1,NY,NX) - 2+FX*ZNA(L0,NY,NX) - ZKA(L1,NY,NX)=ZKA(L1,NY,NX) - 2+FX*ZKA(L0,NY,NX) - ZOH(L1,NY,NX)=ZOH(L1,NY,NX) - 2+FX*ZOH(L0,NY,NX) - ZSO4(L1,NY,NX)=ZSO4(L1,NY,NX) - 2+FX*ZSO4(L0,NY,NX) - ZCL(L1,NY,NX)=ZCL(L1,NY,NX) - 2+FX*ZCL(L0,NY,NX) - ZCO3(L1,NY,NX)=ZCO3(L1,NY,NX) - 2+FX*ZCO3(L0,NY,NX) - ZHCO3(L1,NY,NX)=ZHCO3(L1,NY,NX) - 2+FX*ZHCO3(L0,NY,NX) - ZALOH1(L1,NY,NX)=ZALOH1(L1,NY,NX) - 2+FX*ZALOH1(L0,NY,NX) - ZALOH2(L1,NY,NX)=ZALOH2(L1,NY,NX) - 2+FX*ZALOH2(L0,NY,NX) - ZALOH3(L1,NY,NX)=ZALOH3(L1,NY,NX) - 2+FX*ZALOH3(L0,NY,NX) - ZALOH4(L1,NY,NX)=ZALOH4(L1,NY,NX) - 2+FX*ZALOH4(L0,NY,NX) - ZALS(L1,NY,NX)=ZALS(L1,NY,NX) - 2+FX*ZALS(L0,NY,NX) - ZFEOH1(L1,NY,NX)=ZFEOH1(L1,NY,NX) - 2+FX*ZFEOH1(L0,NY,NX) - ZFEOH2(L1,NY,NX)=ZFEOH2(L1,NY,NX) - 2+FX*ZFEOH2(L0,NY,NX) - ZFEOH3(L1,NY,NX)=ZFEOH3(L1,NY,NX) - 2+FX*ZFEOH3(L0,NY,NX) - ZFEOH4(L1,NY,NX)=ZFEOH4(L1,NY,NX) - 2+FX*ZFEOH4(L0,NY,NX) - ZFES(L1,NY,NX)=ZFES(L1,NY,NX) - 2+FX*ZFES(L0,NY,NX) - ZCAO(L1,NY,NX)=ZCAO(L1,NY,NX) - 2+FX*ZCAO(L0,NY,NX) - ZCAC(L1,NY,NX)=ZCAC(L1,NY,NX) - 2+FX*ZCAC(L0,NY,NX) - ZCAH(L1,NY,NX)=ZCAH(L1,NY,NX) - 2+FX*ZCAH(L0,NY,NX) - ZCAS(L1,NY,NX)=ZCAS(L1,NY,NX) - 2+FX*ZCAS(L0,NY,NX) - ZMGO(L1,NY,NX)=ZMGO(L1,NY,NX) - 2+FX*ZMGO(L0,NY,NX) - ZMGC(L1,NY,NX)=ZMGC(L1,NY,NX) - 2+FX*ZMGC(L0,NY,NX) - ZMGH(L1,NY,NX)=ZMGH(L1,NY,NX) - 2+FX*ZMGH(L0,NY,NX) - ZMGS(L1,NY,NX)=ZMGS(L1,NY,NX) - 2+FX*ZMGS(L0,NY,NX) - ZNAC(L1,NY,NX)=ZNAC(L1,NY,NX) - 2+FX*ZNAC(L0,NY,NX) - ZNAS(L1,NY,NX)=ZNAS(L1,NY,NX) - 2+FX*ZNAS(L0,NY,NX) - ZKAS(L1,NY,NX)=ZKAS(L1,NY,NX) - 2+FX*ZKAS(L0,NY,NX) - H0PO4(L1,NY,NX)=H0PO4(L1,NY,NX) - 2+FX*H0PO4(L0,NY,NX) - H1PO4(L1,NY,NX)=H1PO4(L1,NY,NX) - 2+FX*H1PO4(L0,NY,NX) - H2PO4(L1,NY,NX)=H2PO4(L1,NY,NX) - 2+FX*H2PO4(L0,NY,NX) - H3PO4(L1,NY,NX)=H3PO4(L1,NY,NX) - 2+FX*H3PO4(L0,NY,NX) - ZFE1P(L1,NY,NX)=ZFE1P(L1,NY,NX) - 2+FX*ZFE1P(L0,NY,NX) - ZFE2P(L1,NY,NX)=ZFE2P(L1,NY,NX) - 2+FX*ZFE2P(L0,NY,NX) - ZCA0P(L1,NY,NX)=ZCA0P(L1,NY,NX) - 2+FX*ZCA0P(L0,NY,NX) - ZCA1P(L1,NY,NX)=ZCA1P(L1,NY,NX) - 2+FX*ZCA1P(L0,NY,NX) - ZCA2P(L1,NY,NX)=ZCA2P(L1,NY,NX) - 2+FX*ZCA2P(L0,NY,NX) - ZMG1P(L1,NY,NX)=ZMG1P(L1,NY,NX) - 2+FX*ZMG1P(L0,NY,NX) - H0POB(L1,NY,NX)=H0POB(L1,NY,NX) - 2+FX*H0POB(L0,NY,NX) - H1POB(L1,NY,NX)=H1POB(L1,NY,NX) - 2+FX*H1POB(L0,NY,NX) - H2POB(L1,NY,NX)=H2POB(L1,NY,NX) - 2+FX*H2POB(L0,NY,NX) - H3POB(L1,NY,NX)=H3POB(L1,NY,NX) - 2+FX*H3POB(L0,NY,NX) - ZFE1PB(L1,NY,NX)=ZFE1PB(L1,NY,NX) - 2+FX*ZFE1PB(L0,NY,NX) - ZFE2PB(L1,NY,NX)=ZFE2PB(L1,NY,NX) - 2+FX*ZFE2PB(L0,NY,NX) - ZCA0PB(L1,NY,NX)=ZCA0PB(L1,NY,NX) - 2+FX*ZCA0PB(L0,NY,NX) - ZCA1PB(L1,NY,NX)=ZCA1PB(L1,NY,NX) - 2+FX*ZCA1PB(L0,NY,NX) - ZCA2PB(L1,NY,NX)=ZCA2PB(L1,NY,NX) - 2+FX*ZCA2PB(L0,NY,NX) - ZMG1PB(L1,NY,NX)=ZMG1PB(L1,NY,NX) - 2+FX*ZMG1PB(L0,NY,NX) - XN4(L1,NY,NX)=XN4(L1,NY,NX) - 2+FX*XN4(L0,NY,NX) - XNB(L1,NY,NX)=XNB(L1,NY,NX) - 2+FX*XNB(L0,NY,NX) - XHY(L1,NY,NX)=XHY(L1,NY,NX) - 2+FX*XHY(L0,NY,NX) - XAL(L1,NY,NX)=XAL(L1,NY,NX) - 2+FX*XAL(L0,NY,NX) - XCA(L1,NY,NX)=XCA(L1,NY,NX) - 2+FX*XCA(L0,NY,NX) - XMG(L1,NY,NX)=XMG(L1,NY,NX) - 2+FX*XMG(L0,NY,NX) - XNA(L1,NY,NX)=XNA(L1,NY,NX) - 2+FX*XNA(L0,NY,NX) - XKA(L1,NY,NX)=XKA(L1,NY,NX) - 2+FX*XKA(L0,NY,NX) - XHC(L1,NY,NX)=XHC(L1,NY,NX) - 2+FX*XHC(L0,NY,NX) - XALO2(L1,NY,NX)=XALO2(L1,NY,NX) - 2+FX*XALO2(L0,NY,NX) - XOH0(L1,NY,NX)=XOH0(L1,NY,NX) - 2+FX*XOH0(L0,NY,NX) - XOH1(L1,NY,NX)=XOH1(L1,NY,NX) - 2+FX*XOH1(L0,NY,NX) - XOH2(L1,NY,NX)=XOH2(L1,NY,NX) - 2+FX*XOH2(L0,NY,NX) - XH1P(L1,NY,NX)=XH1P(L1,NY,NX) - 2+FX*XH1P(L0,NY,NX) - XH2P(L1,NY,NX)=XH2P(L1,NY,NX) - 2+FX*XH2P(L0,NY,NX) - XOH0B(L1,NY,NX)=XOH0B(L1,NY,NX) - 2+FX*XOH0B(L0,NY,NX) - XOH1B(L1,NY,NX)=XOH1B(L1,NY,NX) - 2+FX*XOH1B(L0,NY,NX) - XOH2B(L1,NY,NX)=XOH2B(L1,NY,NX) - 2+FX*XOH2B(L0,NY,NX) - XH1PB(L1,NY,NX)=XH1PB(L1,NY,NX) - 2+FX*XH1PB(L0,NY,NX) - XH2PB(L1,NY,NX)=XH2PB(L1,NY,NX) - 2+FX*XH2PB(L0,NY,NX) - PALOH(L1,NY,NX)=PALOH(L1,NY,NX) - 2+FX*PALOH(L0,NY,NX) - PFEOH(L1,NY,NX)=PFEOH(L1,NY,NX) - 2+FX*PFEOH(L0,NY,NX) - PCACO(L1,NY,NX)=PCACO(L1,NY,NX) - 2+FX*PCACO(L0,NY,NX) - PCASO(L1,NY,NX)=PCASO(L1,NY,NX) - 2+FX*PCASO(L0,NY,NX) - PALPO(L1,NY,NX)=PALPO(L1,NY,NX) - 2+FX*PALPO(L0,NY,NX) - PFEPO(L1,NY,NX)=PFEPO(L1,NY,NX) - 2+FX*PFEPO(L0,NY,NX) - PCAPD(L1,NY,NX)=PCAPD(L1,NY,NX) - 2+FX*PCAPD(L0,NY,NX) - PCAPH(L1,NY,NX)=PCAPH(L1,NY,NX) - 2+FX*PCAPH(L0,NY,NX) - PCAPM(L1,NY,NX)=PCAPM(L1,NY,NX) - 2+FX*PCAPM(L0,NY,NX) - PALPB(L1,NY,NX)=PALPB(L1,NY,NX) - 2+FX*PALPB(L0,NY,NX) - PFEPB(L1,NY,NX)=PFEPB(L1,NY,NX) - 2+FX*PFEPB(L0,NY,NX) - PCPDB(L1,NY,NX)=PCPDB(L1,NY,NX) - 2+FX*PCPDB(L0,NY,NX) - PCPHB(L1,NY,NX)=PCPHB(L1,NY,NX) - 2+FX*PCPHB(L0,NY,NX) - PCPMB(L1,NY,NX)=PCPMB(L1,NY,NX) - 2+FX*PCPMB(L0,NY,NX) - CO2G(L1,NY,NX)=CO2G(L1,NY,NX) - 2+FX*CO2G(L0,NY,NX) - CH4G(L1,NY,NX)=CH4G(L1,NY,NX) - 2+FX*CH4G(L0,NY,NX) - CO2S(L1,NY,NX)=CO2S(L1,NY,NX) - 2+FX*CO2S(L0,NY,NX) - CH4S(L1,NY,NX)=CH4S(L1,NY,NX) - 2+FX*CH4S(L0,NY,NX) - OXYG(L1,NY,NX)=OXYG(L1,NY,NX) - 2+FX*OXYG(L0,NY,NX) - OXYS(L1,NY,NX)=OXYS(L1,NY,NX) - 2+FX*OXYS(L0,NY,NX) - Z2GG(L1,NY,NX)=Z2GG(L1,NY,NX) - 2+FX*Z2GG(L0,NY,NX) - Z2GS(L1,NY,NX)=Z2GS(L1,NY,NX) - 2+FX*Z2GS(L0,NY,NX) - Z2OG(L1,NY,NX)=Z2OG(L1,NY,NX) - 2+FX*Z2OG(L0,NY,NX) - Z2OS(L1,NY,NX)=Z2OS(L1,NY,NX) - 2+FX*Z2OS(L0,NY,NX) - ZNH3G(L1,NY,NX)=ZNH3G(L1,NY,NX) - 2+FX*ZNH3G(L0,NY,NX) - H2GG(L1,NY,NX)=H2GG(L1,NY,NX) - 2+FX*H2GG(L0,NY,NX) - H2GS(L1,NY,NX)=H2GS(L1,NY,NX) - 2+FX*H2GS(L0,NY,NX) - ZNH4SH(L1,NY,NX)=ZNH4SH(L1,NY,NX) - 2+FX*ZNH4SH(L0,NY,NX) - ZNH3SH(L1,NY,NX)=ZNH3SH(L1,NY,NX) - 2+FX*ZNH3SH(L0,NY,NX) - ZNO3SH(L1,NY,NX)=ZNO3SH(L1,NY,NX) - 2+FX*ZNO3SH(L0,NY,NX) - ZNO2SH(L1,NY,NX)=ZNO2SH(L1,NY,NX) - 2+FX*ZNO2SH(L0,NY,NX) - H2PO4H(L1,NY,NX)=H2PO4H(L1,NY,NX) - 2+FX*H2PO4H(L0,NY,NX) - ZNH4BH(L1,NY,NX)=ZNH4BH(L1,NY,NX) - 2+FX*ZNH4BH(L0,NY,NX) - ZNH3BH(L1,NY,NX)=ZNH3BH(L1,NY,NX) - 2+FX*ZNH3BH(L0,NY,NX) - ZNO3BH(L1,NY,NX)=ZNO3BH(L1,NY,NX) - 2+FX*ZNO3BH(L0,NY,NX) - ZNO2BH(L1,NY,NX)=ZNO2BH(L1,NY,NX) - 2+FX*ZNO2BH(L0,NY,NX) - H2POBH(L1,NY,NX)=H2POBH(L1,NY,NX) - 2+FX*H2POBH(L0,NY,NX) - ZALH(L1,NY,NX)=ZALH(L1,NY,NX) - 2+FX*ZALH(L0,NY,NX) - ZFEH(L1,NY,NX)=ZFEH(L1,NY,NX) - 2+FX*ZFEH(L0,NY,NX) - ZHYH(L1,NY,NX)=ZHYH(L1,NY,NX) - 2+FX*ZHYH(L0,NY,NX) - ZCCH(L1,NY,NX)=ZCCH(L1,NY,NX) - 2+FX*ZCCH(L0,NY,NX) - ZMAH(L1,NY,NX)=ZMAH(L1,NY,NX) - 2+FX*ZMAH(L0,NY,NX) - ZNAH(L1,NY,NX)=ZNAH(L1,NY,NX) - 2+FX*ZNAH(L0,NY,NX) - ZKAH(L1,NY,NX)=ZKAH(L1,NY,NX) - 2+FX*ZKAH(L0,NY,NX) - ZOHH(L1,NY,NX)=ZOHH(L1,NY,NX) - 2+FX*ZOHH(L0,NY,NX) - ZSO4H(L1,NY,NX)=ZSO4H(L1,NY,NX) - 2+FX*ZSO4H(L0,NY,NX) - ZCLH(L1,NY,NX)=ZCLH(L1,NY,NX) - 2+FX*ZCLH(L0,NY,NX) - ZCO3H(L1,NY,NX)=ZCO3H(L1,NY,NX) - 2+FX*ZCO3H(L0,NY,NX) - ZHCO3H(L1,NY,NX)=ZHCO3H(L1,NY,NX) - 2+FX*ZHCO3H(L0,NY,NX) - ZALO1H(L1,NY,NX)=ZALO1H(L1,NY,NX) - 2+FX*ZALO1H(L0,NY,NX) - ZALO2H(L1,NY,NX)=ZALO2H(L1,NY,NX) - 2+FX*ZALO2H(L0,NY,NX) - ZALO3H(L1,NY,NX)=ZALO3H(L1,NY,NX) - 2+FX*ZALO3H(L0,NY,NX) - ZALO4H(L1,NY,NX)=ZALO4H(L1,NY,NX) - 2+FX*ZALO4H(L0,NY,NX) - ZALSH(L1,NY,NX)=ZALSH(L1,NY,NX) - 2+FX*ZALSH(L0,NY,NX) - ZFEO1H(L1,NY,NX)=ZFEO1H(L1,NY,NX) - 2+FX*ZFEO1H(L0,NY,NX) - ZFEO2H(L1,NY,NX)=ZFEO2H(L1,NY,NX) - 2+FX*ZFEO2H(L0,NY,NX) - ZFEO3H(L1,NY,NX)=ZFEO3H(L1,NY,NX) - 2+FX*ZFEO3H(L0,NY,NX) - ZFEO4H(L1,NY,NX)=ZFEO4H(L1,NY,NX) - 2+FX*ZFEO4H(L0,NY,NX) - ZFESH(L1,NY,NX)=ZFESH(L1,NY,NX) - 2+FX*ZFESH(L0,NY,NX) - ZCAOH(L1,NY,NX)=ZCAOH(L1,NY,NX) - 2+FX*ZCAOH(L0,NY,NX) - ZCACH(L1,NY,NX)=ZCACH(L1,NY,NX) - 2+FX*ZCACH(L0,NY,NX) - ZCAHH(L1,NY,NX)=ZCAHH(L1,NY,NX) - 2+FX*ZCAHH(L0,NY,NX) - ZCASH(L1,NY,NX)=ZCASH(L1,NY,NX) - 2+FX*ZCASH(L0,NY,NX) - ZMGOH(L1,NY,NX)=ZMGOH(L1,NY,NX) - 2+FX*ZMGOH(L0,NY,NX) - ZMGCH(L1,NY,NX)=ZMGCH(L1,NY,NX) - 2+FX*ZMGCH(L0,NY,NX) - ZMGHH(L1,NY,NX)=ZMGHH(L1,NY,NX) - 2+FX*ZMGHH(L0,NY,NX) - ZMGSH(L1,NY,NX)=ZMGSH(L1,NY,NX) - 2+FX*ZMGSH(L0,NY,NX) - ZNACH(L1,NY,NX)=ZNACH(L1,NY,NX) - 2+FX*ZNACH(L0,NY,NX) - ZNASH(L1,NY,NX)=ZNASH(L1,NY,NX) - 2+FX*ZNASH(L0,NY,NX) - ZKASH(L1,NY,NX)=ZKASH(L1,NY,NX) - 2+FX*ZKASH(L0,NY,NX) - H0PO4H(L1,NY,NX)=H0PO4H(L1,NY,NX) - 2+FX*H0PO4H(L0,NY,NX) - H1PO4H(L1,NY,NX)=H1PO4H(L1,NY,NX) - 2+FX*H1PO4H(L0,NY,NX) - H3PO4H(L1,NY,NX)=H3PO4H(L1,NY,NX) - 2+FX*H3PO4H(L0,NY,NX) - ZFE1PH(L1,NY,NX)=ZFE1PH(L1,NY,NX) - 2+FX*ZFE1PH(L0,NY,NX) - ZFE2PH(L1,NY,NX)=ZFE2PH(L1,NY,NX) - 2+FX*ZFE2PH(L0,NY,NX) - ZCA0PH(L1,NY,NX)=ZCA0PH(L1,NY,NX) - 2+FX*ZCA0PH(L0,NY,NX) - ZCA1PH(L1,NY,NX)=ZCA1PH(L1,NY,NX) - 2+FX*ZCA1PH(L0,NY,NX) - ZCA2PH(L1,NY,NX)=ZCA2PH(L1,NY,NX) - 2+FX*ZCA2PH(L0,NY,NX) - ZMG1PH(L1,NY,NX)=ZMG1PH(L1,NY,NX) - 2+FX*ZMG1PH(L0,NY,NX) - H0POBH(L1,NY,NX)=H0POBH(L1,NY,NX) - 2+FX*H0POBH(L0,NY,NX) - H1POBH(L1,NY,NX)=H1POBH(L1,NY,NX) - 2+FX*H1POBH(L0,NY,NX) - H3POBH(L1,NY,NX)=H3POBH(L1,NY,NX) - 2+FX*H3POBH(L0,NY,NX) - ZFE1BH(L1,NY,NX)=ZFE1BH(L1,NY,NX) - 2+FX*ZFE1BH(L0,NY,NX) - ZFE2BH(L1,NY,NX)=ZFE2BH(L1,NY,NX) - 2+FX*ZFE2BH(L0,NY,NX) - ZCA0BH(L1,NY,NX)=ZCA0BH(L1,NY,NX) - 2+FX*ZCA0BH(L0,NY,NX) - ZCA1BH(L1,NY,NX)=ZCA1BH(L1,NY,NX) - 2+FX*ZCA1BH(L0,NY,NX) - ZCA2BH(L1,NY,NX)=ZCA2BH(L1,NY,NX) - 2+FX*ZCA2BH(L0,NY,NX) - ZMG1BH(L1,NY,NX)=ZMG1BH(L1,NY,NX) - 2+FX*ZMG1BH(L0,NY,NX) - CO2SH(L1,NY,NX)=CO2SH(L1,NY,NX) - 2+FX*CO2SH(L0,NY,NX) - CH4SH(L1,NY,NX)=CH4SH(L1,NY,NX) - 2+FX*CH4SH(L0,NY,NX) - OXYSH(L1,NY,NX)=OXYSH(L1,NY,NX) - 2+FX*OXYSH(L0,NY,NX) - Z2GSH(L1,NY,NX)=Z2GSH(L1,NY,NX) - 2+FX*Z2GSH(L0,NY,NX) - Z2OSH(L1,NY,NX)=Z2OSH(L1,NY,NX) - 2+FX*Z2OSH(L0,NY,NX) - ORGC(L1,NY,NX)=ORGC(L1,NY,NX) - 2+FX*ORGC(L0,NY,NX) - ORGN(L1,NY,NX)=ORGN(L1,NY,NX) - 2+FX*ORGN(L0,NY,NX) - DO 7965 K=0,5 - DO 7965 N=1,7 - DO 7965 M=1,3 - OMC(M,N,K,L1,NY,NX)=OMC(M,N,K,L1,NY,NX) - 2+FX*OMC(M,N,K,L0,NY,NX) - OMN(M,N,K,L1,NY,NX)=OMN(M,N,K,L1,NY,NX) - 2+FX*OMN(M,N,K,L0,NY,NX) - OMP(M,N,K,L1,NY,NX)=OMP(M,N,K,L1,NY,NX) - 2+FX*OMP(M,N,K,L0,NY,NX) -7965 CONTINUE - DO 7780 K=0,4 - DO 7775 M=1,2 - ORC(M,K,L1,NY,NX)=ORC(M,K,L1,NY,NX) - 2+FX*ORC(M,K,L0,NY,NX) - ORN(M,K,L1,NY,NX)=ORN(M,K,L1,NY,NX) - 2+FX*ORN(M,K,L0,NY,NX) - ORP(M,K,L1,NY,NX)=ORP(M,K,L1,NY,NX) - 2+FX*ORP(M,K,L0,NY,NX) -7775 CONTINUE - OQC(K,L1,NY,NX)=OQC(K,L1,NY,NX) - 2+FX*OQC(K,L0,NY,NX) - OQN(K,L1,NY,NX)=OQN(K,L1,NY,NX) - 2+FX*OQN(K,L0,NY,NX) - OQP(K,L1,NY,NX)=OQP(K,L1,NY,NX) - 2+FX*OQP(K,L0,NY,NX) - OQA(K,L1,NY,NX)=OQA(K,L1,NY,NX) - 2+FX*OQA(K,L0,NY,NX) - OQCH(K,L1,NY,NX)=OQCH(K,L1,NY,NX) - 2+FX*OQCH(K,L0,NY,NX) - OQNH(K,L1,NY,NX)=OQNH(K,L1,NY,NX) - 2+FX*OQNH(K,L0,NY,NX) - OQPH(K,L1,NY,NX)=OQPH(K,L1,NY,NX) - 2+FX*OQPH(K,L0,NY,NX) - OQAH(K,L1,NY,NX)=OQAH(K,L1,NY,NX) - 2+FX*OQAH(K,L0,NY,NX) - OHC(K,L1,NY,NX)=OHC(K,L1,NY,NX) - 2+FX*OHC(K,L0,NY,NX) - OHN(K,L1,NY,NX)=OHN(K,L1,NY,NX) - 2+FX*OHN(K,L0,NY,NX) - OHP(K,L1,NY,NX)=OHP(K,L1,NY,NX) - 2+FX*OHP(K,L0,NY,NX) - OHA(K,L1,NY,NX)=OHA(K,L1,NY,NX) - 2+FX*OHA(K,L0,NY,NX) - DO 7770 M=1,4 - OSC(M,K,L1,NY,NX)=OSC(M,K,L1,NY,NX) - 2+FX*OSC(M,K,L0,NY,NX) - OSA(M,K,L1,NY,NX)=OSA(M,K,L1,NY,NX) - 2+FX*OSA(M,K,L0,NY,NX) - OSN(M,K,L1,NY,NX)=OSN(M,K,L1,NY,NX) - 2+FX*OSN(M,K,L0,NY,NX) - OSP(M,K,L1,NY,NX)=OSP(M,K,L1,NY,NX) - 2+FX*OSP(M,K,L0,NY,NX) -7770 CONTINUE -7780 CONTINUE - CDPTH(L0,NY,NX)=CDPTH(L0,NY,NX) - 2-FX*DLYR(3,L0,NY,NX) - DLYR(3,L0,NY,NX)=FY*DLYR(3,L0,NY,NX) - VOLX(L0,NY,NX)=FY*VOLX(L0,NY,NX) - BKVL(L0,NY,NX)=FY*BKVL(L0,NY,NX) - SAND(L0,NY,NX)=FY*SAND(L0,NY,NX) - SILT(L0,NY,NX)=FY*SILT(L0,NY,NX) - CLAY(L0,NY,NX)=FY*CLAY(L0,NY,NX) - XCEC(L0,NY,NX)=FY*XCEC(L0,NY,NX) - XAEC(L0,NY,NX)=FY*XAEC(L0,NY,NX) - VOLW(L0,NY,NX)=FY*VOLW(L0,NY,NX) - VOLI(L0,NY,NX)=FY*VOLI(L0,NY,NX) - VOLP(L0,NY,NX)=FY*VOLP(L0,NY,NX) - VOLA(L0,NY,NX)=FY*VOLA(L0,NY,NX) - VOLWX(L0,NY,NX)=FY*VOLWX(L0,NY,NX) - VOLWH(L0,NY,NX)=FY*VOLWH(L0,NY,NX) - VOLIH(L0,NY,NX)=FY*VOLIH(L0,NY,NX) - VOLAH(L0,NY,NX)=FY*VOLAH(L0,NY,NX) - VHCM(L0,NY,NX)=FY*VHCM(L0,NY,NX) - VHCP(L0,NY,NX)=FY*VHCP(L0,NY,NX) - VHCP(L0,NY,NX)=VHCM(L0,NY,NX) - 2+4.19*(VOLW(L0,NY,NX)+VOLWH(L0,NY,NX)) - 3+1.9274*(VOLI(L0,NY,NX)+VOLIH(L0,NY,NX)) - ZNH4FA(L0,NY,NX)=FY*ZNH4FA(L0,NY,NX) - ZNH3FA(L0,NY,NX)=FY*ZNH3FA(L0,NY,NX) - ZNHUFA(L0,NY,NX)=FY*ZNHUFA(L0,NY,NX) - ZNO3FA(L0,NY,NX)=FY*ZNO3FA(L0,NY,NX) - ZNH4FB(L0,NY,NX)=FY*ZNH4FB(L0,NY,NX) - ZNH3FB(L0,NY,NX)=FY*ZNH3FB(L0,NY,NX) - ZNHUFB(L0,NY,NX)=FY*ZNHUFB(L0,NY,NX) - ZNO3FB(L0,NY,NX)=FY*ZNO3FB(L0,NY,NX) - ZNH4S(L0,NY,NX)=FY*ZNH4S(L0,NY,NX) - ZNH4B(L0,NY,NX)=FY*ZNH4B(L0,NY,NX) - ZNH3S(L0,NY,NX)=FY*ZNH3S(L0,NY,NX) - ZNH3B(L0,NY,NX)=FY*ZNH3B(L0,NY,NX) - ZNO3S(L0,NY,NX)=FY*ZNO3S(L0,NY,NX) - ZNO3B(L0,NY,NX)=FY*ZNO3B(L0,NY,NX) - ZNO2S(L0,NY,NX)=FY*ZNO2S(L0,NY,NX) - ZNO2B(L0,NY,NX)=FY*ZNO2B(L0,NY,NX) - ZAL(L0,NY,NX)=FY*ZAL(L0,NY,NX) - ZFE(L0,NY,NX)=FY*ZFE(L0,NY,NX) - ZHY(L0,NY,NX)=FY*ZHY(L0,NY,NX) - ZCA(L0,NY,NX)=FY*ZCA(L0,NY,NX) - ZMG(L0,NY,NX)=FY*ZMG(L0,NY,NX) - ZNA(L0,NY,NX)=FY*ZNA(L0,NY,NX) - ZKA(L0,NY,NX)=FY*ZKA(L0,NY,NX) - ZOH(L0,NY,NX)=FY*ZOH(L0,NY,NX) - ZSO4(L0,NY,NX)=FY*ZSO4(L0,NY,NX) - ZCL(L0,NY,NX)=FY*ZCL(L0,NY,NX) - ZCO3(L0,NY,NX)=FY*ZCO3(L0,NY,NX) - ZHCO3(L0,NY,NX)=FY*ZHCO3(L0,NY,NX) - ZALOH1(L0,NY,NX)=FY*ZALOH1(L0,NY,NX) - ZALOH2(L0,NY,NX)=FY*ZALOH2(L0,NY,NX) - ZALOH3(L0,NY,NX)=FY*ZALOH3(L0,NY,NX) - ZALOH4(L0,NY,NX)=FY*ZALOH4(L0,NY,NX) - ZALS(L0,NY,NX)=FY*ZALS(L0,NY,NX) - ZFEOH1(L0,NY,NX)=FY*ZFEOH1(L0,NY,NX) - ZFEOH2(L0,NY,NX)=FY*ZFEOH2(L0,NY,NX) - ZFEOH3(L0,NY,NX)=FY*ZFEOH3(L0,NY,NX) - ZFEOH4(L0,NY,NX)=FY*ZFEOH4(L0,NY,NX) - ZFES(L0,NY,NX)=FY*ZFES(L0,NY,NX) - ZCAO(L0,NY,NX)=FY*ZCAO(L0,NY,NX) - ZCAC(L0,NY,NX)=FY*ZCAC(L0,NY,NX) - ZCAH(L0,NY,NX)=FY*ZCAH(L0,NY,NX) - ZCAS(L0,NY,NX)=FY*ZCAS(L0,NY,NX) - ZMGO(L0,NY,NX)=FY*ZMGO(L0,NY,NX) - ZMGC(L0,NY,NX)=FY*ZMGC(L0,NY,NX) - ZMGH(L0,NY,NX)=FY*ZMGH(L0,NY,NX) - ZMGS(L0,NY,NX)=FY*ZMGS(L0,NY,NX) - ZNAC(L0,NY,NX)=FY*ZNAC(L0,NY,NX) - ZNAS(L0,NY,NX)=FY*ZNAS(L0,NY,NX) - ZKAS(L0,NY,NX)=FY*ZKAS(L0,NY,NX) - H0PO4(L0,NY,NX)=FY*H0PO4(L0,NY,NX) - H1PO4(L0,NY,NX)=FY*H1PO4(L0,NY,NX) - H2PO4(L0,NY,NX)=FY*H2PO4(L0,NY,NX) - H3PO4(L0,NY,NX)=FY*H3PO4(L0,NY,NX) - ZFE1P(L0,NY,NX)=FY*ZFE1P(L0,NY,NX) - ZFE2P(L0,NY,NX)=FY*ZFE2P(L0,NY,NX) - ZCA0P(L0,NY,NX)=FY*ZCA0P(L0,NY,NX) - ZCA1P(L0,NY,NX)=FY*ZCA1P(L0,NY,NX) - ZCA2P(L0,NY,NX)=FY*ZCA2P(L0,NY,NX) - ZMG1P(L0,NY,NX)=FY*ZMG1P(L0,NY,NX) - H0POB(L0,NY,NX)=FY*H0POB(L0,NY,NX) - H1POB(L0,NY,NX)=FY*H1POB(L0,NY,NX) - H2POB(L0,NY,NX)=FY*H2POB(L0,NY,NX) - H3POB(L0,NY,NX)=FY*H3POB(L0,NY,NX) - ZFE1PB(L0,NY,NX)=FY*ZFE1PB(L0,NY,NX) - ZFE2PB(L0,NY,NX)=FY*ZFE2PB(L0,NY,NX) - ZCA0PB(L0,NY,NX)=FY*ZCA0PB(L0,NY,NX) - ZCA1PB(L0,NY,NX)=FY*ZCA1PB(L0,NY,NX) - ZCA2PB(L0,NY,NX)=FY*ZCA2PB(L0,NY,NX) - ZMG1PB(L0,NY,NX)=FY*ZMG1PB(L0,NY,NX) - XN4(L0,NY,NX)=FY*XN4(L0,NY,NX) - XNB(L0,NY,NX)=FY*XNB(L0,NY,NX) - XHY(L0,NY,NX)=FY*XHY(L0,NY,NX) - XAL(L0,NY,NX)=FY*XAL(L0,NY,NX) - XCA(L0,NY,NX)=FY*XCA(L0,NY,NX) - XMG(L0,NY,NX)=FY*XMG(L0,NY,NX) - XNA(L0,NY,NX)=FY*XNA(L0,NY,NX) - XKA(L0,NY,NX)=FY*XKA(L0,NY,NX) - XHC(L0,NY,NX)=FY*XHC(L0,NY,NX) - XALO2(L0,NY,NX)=FY*XALO2(L0,NY,NX) - XOH0(L0,NY,NX)=FY*XOH0(L0,NY,NX) - XOH1(L0,NY,NX)=FY*XOH1(L0,NY,NX) - XOH2(L0,NY,NX)=FY*XOH2(L0,NY,NX) - XH1P(L0,NY,NX)=FY*XH1P(L0,NY,NX) - XH2P(L0,NY,NX)=FY*XH2P(L0,NY,NX) - XOH0B(L0,NY,NX)=FY*XOH0B(L0,NY,NX) - XOH1B(L0,NY,NX)=FY*XOH1B(L0,NY,NX) - XOH2B(L0,NY,NX)=FY*XOH2B(L0,NY,NX) - XH1PB(L0,NY,NX)=FY*XH1PB(L0,NY,NX) - XH2PB(L0,NY,NX)=FY*XH2PB(L0,NY,NX) - PALOH(L0,NY,NX)=FY*PALOH(L0,NY,NX) - PFEOH(L0,NY,NX)=FY*PFEOH(L0,NY,NX) - PCACO(L0,NY,NX)=FY*PCACO(L0,NY,NX) - PCASO(L0,NY,NX)=FY*PCASO(L0,NY,NX) - PALPO(L0,NY,NX)=FY*PALPO(L0,NY,NX) - PFEPO(L0,NY,NX)=FY*PFEPO(L0,NY,NX) - PCAPD(L0,NY,NX)=FY*PCAPD(L0,NY,NX) - PCAPH(L0,NY,NX)=FY*PCAPH(L0,NY,NX) - PCAPM(L0,NY,NX)=FY*PCAPM(L0,NY,NX) - PALPB(L0,NY,NX)=FY*PALPB(L0,NY,NX) - PFEPB(L0,NY,NX)=FY*PFEPB(L0,NY,NX) - PCPDB(L0,NY,NX)=FY*PCPDB(L0,NY,NX) - PCPHB(L0,NY,NX)=FY*PCPHB(L0,NY,NX) - PCPMB(L0,NY,NX)=FY*PCPMB(L0,NY,NX) - CO2G(L0,NY,NX)=FY*CO2G(L0,NY,NX) - CH4G(L0,NY,NX)=FY*CH4G(L0,NY,NX) - CO2S(L0,NY,NX)=FY*CO2S(L0,NY,NX) - CH4S(L0,NY,NX)=FY*CH4S(L0,NY,NX) - OXYG(L0,NY,NX)=FY*OXYG(L0,NY,NX) - OXYS(L0,NY,NX)=FY*OXYS(L0,NY,NX) - Z2GG(L0,NY,NX)=FY*Z2GG(L0,NY,NX) - Z2GS(L0,NY,NX)=FY*Z2GS(L0,NY,NX) - Z2OG(L0,NY,NX)=FY*Z2OG(L0,NY,NX) - Z2OS(L0,NY,NX)=FY*Z2OS(L0,NY,NX) - ZNH3G(L0,NY,NX)=FY*ZNH3G(L0,NY,NX) - H2GG(L0,NY,NX)=FY*H2GG(L0,NY,NX) - H2GS(L0,NY,NX)=FY*H2GS(L0,NY,NX) - ZNH4SH(L0,NY,NX)=FY*ZNH4SH(L0,NY,NX) - ZNH3SH(L0,NY,NX)=FY*ZNH3SH(L0,NY,NX) - ZNO3SH(L0,NY,NX)=FY*ZNO3SH(L0,NY,NX) - ZNO2SH(L0,NY,NX)=FY*ZNO2SH(L0,NY,NX) - H2PO4H(L0,NY,NX)=FY*H2PO4H(L0,NY,NX) - ZNH4BH(L0,NY,NX)=FY*ZNH4BH(L0,NY,NX) - ZNH3BH(L0,NY,NX)=FY*ZNH3BH(L0,NY,NX) - ZNO3BH(L0,NY,NX)=FY*ZNO3BH(L0,NY,NX) - ZNO2BH(L0,NY,NX)=FY*ZNO2BH(L0,NY,NX) - H2POBH(L0,NY,NX)=FY*H2POBH(L0,NY,NX) - ZALH(L0,NY,NX)=FY*ZALH(L0,NY,NX) - ZFEH(L0,NY,NX)=FY*ZFEH(L0,NY,NX) - ZHYH(L0,NY,NX)=FY*ZHYH(L0,NY,NX) - ZCCH(L0,NY,NX)=FY*ZCCH(L0,NY,NX) - ZMAH(L0,NY,NX)=FY*ZMAH(L0,NY,NX) - ZNAH(L0,NY,NX)=FY*ZNAH(L0,NY,NX) - ZKAH(L0,NY,NX)=FY*ZKAH(L0,NY,NX) - ZOHH(L0,NY,NX)=FY*ZOHH(L0,NY,NX) - ZSO4H(L0,NY,NX)=FY*ZSO4H(L0,NY,NX) - ZCLH(L0,NY,NX)=FY*ZCLH(L0,NY,NX) - ZCO3H(L0,NY,NX)=FY*ZCO3H(L0,NY,NX) - ZHCO3H(L0,NY,NX)=FY*ZHCO3H(L0,NY,NX) - ZALO1H(L0,NY,NX)=FY*ZALO1H(L0,NY,NX) - ZALO2H(L0,NY,NX)=FY*ZALO2H(L0,NY,NX) - ZALO3H(L0,NY,NX)=FY*ZALO3H(L0,NY,NX) - ZALO4H(L0,NY,NX)=FY*ZALO4H(L0,NY,NX) - ZALSH(L0,NY,NX)=FY*ZALSH(L0,NY,NX) - ZFEO1H(L0,NY,NX)=FY*ZFEO1H(L0,NY,NX) - ZFEO2H(L0,NY,NX)=FY*ZFEO2H(L0,NY,NX) - ZFEO3H(L0,NY,NX)=FY*ZFEO3H(L0,NY,NX) - ZFEO4H(L0,NY,NX)=FY*ZFEO4H(L0,NY,NX) - ZFESH(L0,NY,NX)=FY*ZFESH(L0,NY,NX) - ZCAOH(L0,NY,NX)=FY*ZCAOH(L0,NY,NX) - ZCACH(L0,NY,NX)=FY*ZCACH(L0,NY,NX) - ZCAHH(L0,NY,NX)=FY*ZCAHH(L0,NY,NX) - ZCASH(L0,NY,NX)=FY*ZCASH(L0,NY,NX) - ZMGOH(L0,NY,NX)=FY*ZMGOH(L0,NY,NX) - ZMGCH(L0,NY,NX)=FY*ZMGCH(L0,NY,NX) - ZMGHH(L0,NY,NX)=FY*ZMGHH(L0,NY,NX) - ZMGSH(L0,NY,NX)=FY*ZMGSH(L0,NY,NX) - ZNACH(L0,NY,NX)=FY*ZNACH(L0,NY,NX) - ZNASH(L0,NY,NX)=FY*ZNASH(L0,NY,NX) - ZKASH(L0,NY,NX)=FY*ZKASH(L0,NY,NX) - H0PO4H(L0,NY,NX)=FY*H0PO4H(L0,NY,NX) - H1PO4H(L0,NY,NX)=FY*H1PO4H(L0,NY,NX) - H3PO4H(L0,NY,NX)=FY*H3PO4H(L0,NY,NX) - ZFE1PH(L0,NY,NX)=FY*ZFE1PH(L0,NY,NX) - ZFE2PH(L0,NY,NX)=FY*ZFE2PH(L0,NY,NX) - ZCA0PH(L0,NY,NX)=FY*ZCA0PH(L0,NY,NX) - ZCA1PH(L0,NY,NX)=FY*ZCA1PH(L0,NY,NX) - ZCA2PH(L0,NY,NX)=FY*ZCA2PH(L0,NY,NX) - ZMG1PH(L0,NY,NX)=FY*ZMG1PH(L0,NY,NX) - H0POBH(L0,NY,NX)=FY*H0POBH(L0,NY,NX) - H1POBH(L0,NY,NX)=FY*H1POBH(L0,NY,NX) - H3POBH(L0,NY,NX)=FY*H3POBH(L0,NY,NX) - ZFE1BH(L0,NY,NX)=FY*ZFE1BH(L0,NY,NX) - ZFE2BH(L0,NY,NX)=FY*ZFE2BH(L0,NY,NX) - ZCA0BH(L0,NY,NX)=FY*ZCA0BH(L0,NY,NX) - ZCA1BH(L0,NY,NX)=FY*ZCA1BH(L0,NY,NX) - ZCA2BH(L0,NY,NX)=FY*ZCA2BH(L0,NY,NX) - ZMG1BH(L0,NY,NX)=FY*ZMG1BH(L0,NY,NX) - CO2SH(L0,NY,NX)=FY*CO2SH(L0,NY,NX) - CH4SH(L0,NY,NX)=FY*CH4SH(L0,NY,NX) - OXYSH(L0,NY,NX)=FY*OXYSH(L0,NY,NX) - Z2GSH(L0,NY,NX)=FY*Z2GSH(L0,NY,NX) - Z2OSH(L0,NY,NX)=FY*Z2OSH(L0,NY,NX) - ORGC(L0,NY,NX)=FY*ORGC(L0,NY,NX) - ORGN(L0,NY,NX)=FY*ORGN(L0,NY,NX) - DO 7865 K=0,5 - DO 7865 N=1,7 - DO 7865 M=1,3 - OMC(M,N,K,L0,NY,NX)=FY*OMC(M,N,K,L0,NY,NX) - OMN(M,N,K,L0,NY,NX)=FY*OMN(M,N,K,L0,NY,NX) - OMP(M,N,K,L0,NY,NX)=FY*OMP(M,N,K,L0,NY,NX) -7865 CONTINUE - DO 7880 K=0,4 - DO 7875 M=1,2 - ORC(M,K,L0,NY,NX)=FY*ORC(M,K,L0,NY,NX) - ORN(M,K,L0,NY,NX)=FY*ORN(M,K,L0,NY,NX) - ORP(M,K,L0,NY,NX)=FY*ORP(M,K,L0,NY,NX) -7875 CONTINUE - OQC(K,L0,NY,NX)=FY*OQC(K,L0,NY,NX) - OQN(K,L0,NY,NX)=FY*OQN(K,L0,NY,NX) - OQP(K,L0,NY,NX)=FY*OQP(K,L0,NY,NX) - OQA(K,L0,NY,NX)=FY*OQA(K,L0,NY,NX) - OQCH(K,L0,NY,NX)=FY*OQCH(K,L0,NY,NX) - OQNH(K,L0,NY,NX)=FY*OQNH(K,L0,NY,NX) - OQPH(K,L0,NY,NX)=FY*OQPH(K,L0,NY,NX) - OQAH(K,L0,NY,NX)=FY*OQAH(K,L0,NY,NX) - OHC(K,L0,NY,NX)=FY*OHC(K,L0,NY,NX) - OHN(K,L0,NY,NX)=FY*OHN(K,L0,NY,NX) - OHP(K,L0,NY,NX)=FY*OHP(K,L0,NY,NX) - OHA(K,L0,NY,NX)=FY*OHA(K,L0,NY,NX) - DO 7870 M=1,4 - OSC(M,K,L0,NY,NX)=FY*OSC(M,K,L0,NY,NX) - OSA(M,K,L0,NY,NX)=FY*OSA(M,K,L0,NY,NX) - OSN(M,K,L0,NY,NX)=FY*OSN(M,K,L0,NY,NX) - OSP(M,K,L0,NY,NX)=FY*OSP(M,K,L0,NY,NX) -7870 CONTINUE -7880 CONTINUE - IF(FY.EQ.0.0)THEN - CCO2S(L0,NY,NX)=9999 - CCH4S(L0,NY,NX)=9999 - COXYS(L0,NY,NX)=9999 - THETW(L0,NY,NX)=9999 - THETI(L0,NY,NX)=9999 - PSISM(L0,NY,NX)=9999 - CZ2OS(L0,NY,NX)=9999 - CNH3S(L0,NY,NX)=9999 - TCS(L0,NY,NX)=9999 - ENDIF - IFLGS(NY,NX)=1 - WRITE(*,5599)'ERODE2',I,J,NX,NY,L0,L1,NU(NY,NX),DNUMN,DNUMX - 2,DLYR(3,L0,NY,NX),DLYR(3,L1,NY,NX),FX - ENDIF - ENDIF -C -C RESIDUE REMOVAL IF FIRE OR REMOVAL EVENT IS ENTERED IN DISTURBANCE FILE -C - IF(J.EQ.INT(ZNOON(NY,NX)).AND.(ITILL(I,NY,NX).EQ.21 - 2.OR.ITILL(I,NY,NX).EQ.22))THEN - IF(ITILL(I,NY,NX).EQ.22)THEN - IFLGQ=0 - NLL=-1 - DO 2945 L=0,NL(NY,NX) -C WRITE(*,9494)'FIRE',I,J,L,IFLGQ,NLL,THETW(L,NY,NX) -9494 FORMAT(A8,5I6,12E12.4) - IF(L.EQ.0.OR.L.GE.NU(NY,NX))THEN - IF(IFLGQ.EQ.1)THEN - GO TO 2946 - ELSEIF(THETW(L,NY,NX).GT.FVLWB.OR.CORGC(L,NY,NX).LE.FORGC - 2.OR.DPTH(L,NY,NX).GT.0.15)THEN - IFLGQ=1 - ELSE - NLL=L - ENDIF - ENDIF -2945 CONTINUE - ELSE - NLL=0 - ENDIF -2946 CONTINUE - DO 2950 L=0,NLL - IF(NLL.GE.0)THEN - IF(ITILL(I,NY,NX).EQ.22)THEN - DCORPC=AMIN1(0.999,DCORP(I,NY,NX))*(CORGC(L,NY,NX)-FORGC) - 2/(AMAX1(CORGC(L,NY,NX),0.5E+06)-FORGC) - ELSE - DCORPC=AMIN1(0.999,DCORP(I,NY,NX)) - ENDIF - VOLWOU=VOLWOU+DCORPC*VOLW(L,NY,NX) - HEATOU=HEATOU+DCORPC*4.19*TKS(L,NY,NX)*VOLW(L,NY,NX) - VOLW(L,NY,NX)=VOLW(L,NY,NX)-DCORPC*VOLW(L,NY,NX) -C WRITE(*,9696)'BURN',I,J,L,NLL,CORGC(L,NY,NX) -C 2,FORGC,DCORPC,DCORP(I,NY,NX),VOLW(L,NY,NX) -9696 FORMAT(A8,4I6,12E12.4) - OSGX=ORGC(L,NY,NX) - OC=0.0 - ON=0.0 - OP=0.0 - RC=0.0 - RN=0.0 - RP=0.0 - DO 2955 K=0,4 - DO 2955 M=1,4 - ONL(M,K)=0.0 - OPL(M,K)=0.0 -2955 CONTINUE - DO 2970 K=0,5 - IF(L.NE.0.OR.(K.NE.3.AND.K.NE.4))THEN -C -C REMOVE MICROBIAL BIOMASS -C - DO 2960 N=1,7 - DO 2960 M=1,3 - OCH=DCORPC*OMC(M,N,K,L,NY,NX) - ONH=DCORPC*OMN(M,N,K,L,NY,NX) - OPH=DCORPC*OMP(M,N,K,L,NY,NX) - ONX=EFIRE(1,ITILL(I,NY,NX))*ONH - OPX=EFIRE(2,ITILL(I,NY,NX))*OPH - IF(K.LE.2)THEN - ONL(4,K)=ONL(4,K)+ONH-ONX - OPL(4,K)=OPL(4,K)+OPH-OPX - ELSEIF(K.LE.4)THEN - ONL(1,K)=ONL(1,K)+ONH-ONX - OPL(1,K)=OPL(1,K)+OPH-OPX - ELSEIF(K.EQ.5)THEN - ONL(4,1)=ONL(4,1)+ONH-ONX - OPL(4,1)=OPL(4,1)+OPH-OPX - ENDIF - OMC(M,N,K,L,NY,NX)=OMC(M,N,K,L,NY,NX)-OCH - OMN(M,N,K,L,NY,NX)=OMN(M,N,K,L,NY,NX)-ONH - OMP(M,N,K,L,NY,NX)=OMP(M,N,K,L,NY,NX)-OPH - RC=RC+OMC(M,N,K,L,NY,NX) - RN=RN+OMN(M,N,K,L,NY,NX) - RP=RP+OMP(M,N,K,L,NY,NX) - TOMT(NY,NX)=TOMT(NY,NX)+OMC(M,N,K,L,NY,NX) - TONT(NY,NX)=TONT(NY,NX)+OMN(M,N,K,L,NY,NX) - TOPT(NY,NX)=TOPT(NY,NX)+OMP(M,N,K,L,NY,NX) - OMCL(L,NY,NX)=OMCL(L,NY,NX)+OMC(M,N,K,L,NY,NX) - OMNL(L,NY,NX)=OMNL(L,NY,NX)+OMN(M,N,K,L,NY,NX) - OC=OC+OCH - ON=ON+ONX - OP=OP+OPX -2960 CONTINUE - ENDIF -2970 CONTINUE -C -C REMOVE MICROBIAL RESIDUE -C - DO 2900 K=0,4 - IF(L.NE.0.OR.(K.NE.3.AND.K.NE.4))THEN - DO 2940 M=1,2 - OCH=DCORPC*ORC(M,K,L,NY,NX) - ONH=DCORPC*ORN(M,K,L,NY,NX) - OPH=DCORPC*ORP(M,K,L,NY,NX) - ONX=EFIRE(1,ITILL(I,NY,NX))*ONH - OPX=EFIRE(2,ITILL(I,NY,NX))*OPH - IF(K.LE.2)THEN - ONL(4,K)=ONL(4,K)+ONH-ONX - OPL(4,K)=OPL(4,K)+OPH-OPX - ELSE - ONL(1,K)=ONL(1,K)+ONH-ONX - OPL(1,K)=OPL(1,K)+OPH-OPX - ENDIF - ORC(M,K,L,NY,NX)=ORC(M,K,L,NY,NX)-OCH - ORN(M,K,L,NY,NX)=ORN(M,K,L,NY,NX)-ONH - ORP(M,K,L,NY,NX)=ORP(M,K,L,NY,NX)-OPH - RC=RC+ORC(M,K,L,NY,NX) - RN=RN+ORN(M,K,L,NY,NX) - RP=RP+ORP(M,K,L,NY,NX) - OC=OC+OCH - ON=ON+ONX - OP=OP+OPX -2940 CONTINUE -C -C REMOVE DOC, DON, DOP -C - OCH=DCORPC*OQC(K,L,NY,NX) - OCA=DCORPC*OQA(K,L,NY,NX) - ONH=DCORPC*OQN(K,L,NY,NX) - OPH=DCORPC*OQP(K,L,NY,NX) - ONX=EFIRE(1,ITILL(I,NY,NX))*ONH - OPX=EFIRE(2,ITILL(I,NY,NX))*OPH - IF(K.LE.2)THEN - ONL(4,K)=ONL(4,K)+ONH-ONX - OPL(4,K)=OPL(4,K)+OPH-OPX - ELSE - ONL(1,K)=ONL(1,K)+ONH-ONX - OPL(1,K)=OPL(1,K)+OPH-OPX - ENDIF - OQC(K,L,NY,NX)=OQC(K,L,NY,NX)-OCH - OQA(K,L,NY,NX)=OQA(K,L,NY,NX)-OCA - OQN(K,L,NY,NX)=OQN(K,L,NY,NX)-ONH - OQP(K,L,NY,NX)=OQP(K,L,NY,NX)-OPH - OC=OC+OCH+OCA - ON=ON+ONX - OP=OP+OPX - OCH=DCORPC*OQCH(K,L,NY,NX) - ONH=DCORPC*OQNH(K,L,NY,NX) - OPH=DCORPC*OQPH(K,L,NY,NX) - OAH=DCORPC*OQAH(K,L,NY,NX) - ONX=EFIRE(1,ITILL(I,NY,NX))*ONH - OPX=EFIRE(2,ITILL(I,NY,NX))*OPH - IF(K.LE.2)THEN - ONL(4,K)=ONL(4,K)+ONH-ONX - OPL(4,K)=OPL(4,K)+OPH-OPX - ELSE - ONL(1,K)=ONL(1,K)+ONH-ONX - OPL(1,K)=OPL(1,K)+OPH-OPX - ENDIF - OQCH(K,L,NY,NX)=OQCH(K,L,NY,NX)-OCH - OQNH(K,L,NY,NX)=OQNH(K,L,NY,NX)-ONH - OQPH(K,L,NY,NX)=OQPH(K,L,NY,NX)-OPH - OQAH(K,L,NY,NX)=OQAH(K,L,NY,NX)-OAH - OC=OC+OCH+OAH - ON=ON+ONX - OP=OP+OPX -C -C REMOVE ADSORBED OM -C - OCH=DCORPC*OHC(K,L,NY,NX) - ONH=DCORPC*OHN(K,L,NY,NX) - OPH=DCORPC*OHP(K,L,NY,NX) - OAH=DCORPC*OHA(K,L,NY,NX) - ONX=EFIRE(1,ITILL(I,NY,NX))*ONH - OPX=EFIRE(2,ITILL(I,NY,NX))*OPH - IF(K.LE.2)THEN - ONL(4,K)=ONL(4,K)+ONH-ONX - OPL(4,K)=OPL(4,K)+OPH-OPX - ELSE - ONL(1,K)=ONL(1,K)+ONH-ONX - OPL(1,K)=OPL(1,K)+OPH-OPX - ENDIF - OHC(K,L,NY,NX)=OHC(K,L,NY,NX)-OCH - OHN(K,L,NY,NX)=OHN(K,L,NY,NX)-ONH - OHP(K,L,NY,NX)=OHP(K,L,NY,NX)-OPH - OHA(K,L,NY,NX)=OHA(K,L,NY,NX)-OAH - RC=RC+OQC(K,L,NY,NX)+OQCH(K,L,NY,NX)+OHC(K,L,NY,NX) - 2+OQA(K,L,NY,NX)+OQAH(K,L,NY,NX)+OHA(K,L,NY,NX) - RN=RN+OQN(K,L,NY,NX)+OQNH(K,L,NY,NX)+OHN(K,L,NY,NX) - RP=RP+OQP(K,L,NY,NX)+OQPH(K,L,NY,NX)+OHP(K,L,NY,NX) - OC=OC+OCH - ON=ON+ONX - OP=OP+OPX -C -C REMOVE RESIDUE -C - DO 2930 M=1,4 - OCH=DCORPC*OSC(M,K,L,NY,NX) - OCA=DCORPC*OSA(M,K,L,NY,NX) - ONH=DCORPC*OSN(M,K,L,NY,NX) - OPH=DCORPC*OSP(M,K,L,NY,NX) - ONX=EFIRE(1,ITILL(I,NY,NX))*ONH - OPX=EFIRE(2,ITILL(I,NY,NX))*OPH - ONL(M,K)=ONL(M,K)+ONH-ONX - OPL(M,K)=OPL(M,K)+OPH-OPX - OSC(M,K,L,NY,NX)=OSC(M,K,L,NY,NX)-OCH - OSA(M,K,L,NY,NX)=OSA(M,K,L,NY,NX)-OCA - OSN(M,K,L,NY,NX)=OSN(M,K,L,NY,NX)-ONH - OSP(M,K,L,NY,NX)=OSP(M,K,L,NY,NX)-OPH - RC=RC+OSC(M,K,L,NY,NX) - RN=RN+OSN(M,K,L,NY,NX) - RP=RP+OSP(M,K,L,NY,NX) - OC=OC+OCH - ON=ON+ONX - OP=OP+OPX -2930 CONTINUE - ENDIF -2900 CONTINUE -C -C ADD UNBURNED N,P TO ORG N, ORG P -C - DO 2905 K=0,4 - DO 2905 M=1,4 - OSN(M,K,L,NY,NX)=OSN(M,K,L,NY,NX)+ONL(M,K) - OSP(M,K,L,NY,NX)=OSP(M,K,L,NY,NX)+OPL(M,K) - RN=RN+ONL(M,K) - RP=RP+OPL(M,K) -2905 CONTINUE -C -C REMOVE FERTILIZER IN RESIDUE -C - IF(ITILL(I,NY,NX).EQ.21)THEN - ON=ON+DCORPC*(ZNH4S(L,NY,NX)+ZNH3S(L,NY,NX) - 2+ZNO3S(L,NY,NX)+ZNO2S(L,NY,NX)) - OP=OP+DCORPC*H2PO4(L,NY,NX) - TIONOU=TIONOU+DCORPC*(ZNH3FA(L,NY,NX)+ZNO3FA(L,NY,NX) - 2+ZNHUFA(L,NY,NX)+2.0*(XN4(L,NY,NX)+PALPO(L,NY,NX)+PFEPO(L,NY,NX) - 2+ZNH4FA(L,NY,NX))+3.0*PCAPD(L,NY,NX)+7.0*PCAPM(L,NY,NX) - 3+9.0*PCAPH(L,NY,NX)) - ZNH4S(L,NY,NX)=(1.0-DCORPC)*ZNH4S(L,NY,NX) - ZNH3S(L,NY,NX)=(1.0-DCORPC)*ZNH3S(L,NY,NX) - ZNO3S(L,NY,NX)=(1.0-DCORPC)*ZNO3S(L,NY,NX) - ZNO2S(L,NY,NX)=(1.0-DCORPC)*ZNO2S(L,NY,NX) - H2PO4(L,NY,NX)=(1.0-DCORPC)*H2PO4(L,NY,NX) - XN4(L,NY,NX)=(1.0-DCORPC)*XN4(L,NY,NX) - PALPO(L,NY,NX)=(1.0-DCORPC)*PALPO(L,NY,NX) - PFEPO(L,NY,NX)=(1.0-DCORPC)*PFEPO(L,NY,NX) - PCAPD(L,NY,NX)=(1.0-DCORPC)*PCAPD(L,NY,NX) - PCAPH(L,NY,NX)=(1.0-DCORPC)*PCAPH(L,NY,NX) - PCAPM(L,NY,NX)=(1.0-DCORPC)*PCAPM(L,NY,NX) - ZNH4FA(L,NY,NX)=(1.0-DCORPC)*ZNH4FA(L,NY,NX) - ZNH3FA(L,NY,NX)=(1.0-DCORPC)*ZNH3FA(L,NY,NX) - ZNHUFA(L,NY,NX)=(1.0-DCORPC)*ZNHUFA(L,NY,NX) - ZNO3FA(L,NY,NX)=(1.0-DCORPC)*ZNO3FA(L,NY,NX) - ENDIF - ORGC(L,NY,NX)=RC - ORGN(L,NY,NX)=RN - HFLXD=4.19E-06*(OSGX-ORGC(L,NY,NX))*TKS(L,NY,NX) - HEATOU=HEATOU+HFLXD - IF(L.EQ.0)THEN - VHCPR(NY,NX)=2.496E-06*ORGC(0,NY,NX)+4.19*VOLW(0,NY,NX) - 2+1.9274*VOLI(0,NY,NX) - ELSE - VHCP(L,NY,NX)=VHCM(L,NY,NX)+4.19*(VOLW(L,NY,NX)+VOLWH(L,NY,NX)) - 2+1.9274*(VOLI(L,NY,NX)+VOLIH(L,NY,NX)) - ENDIF - IF(ITILL(I,NY,NX).EQ.21)THEN - TCOU=TCOU+OC - TZOU=TZOU+ON - TPOU=TPOU+OP - UDOCQ(NY,NX)=UDOCQ(NY,NX)+OC - UDONQ(NY,NX)=UDONQ(NY,NX)+ON - UDOPQ(NY,NX)=UDOPQ(NY,NX)+OP - TNBP(NY,NX)=TNBP(NY,NX)-OC - ELSEIF(ITILL(I,NY,NX).EQ.22)THEN - CO2GIN=CO2GIN-OC - OXYGIN=OXYGIN+2.667*OC - OXYGOU=OXYGOU+2.667*OC - TZOU=TZOU+ON - TPOU=TPOU+OP - UCO2F(NY,NX)=UCO2F(NY,NX)-(1.0-FCH4F)*OC - UCH4F(NY,NX)=UCH4F(NY,NX)-FCH4F*OC - UOXYF(NY,NX)=UOXYF(NY,NX)+(1.0-FCH4F)*2.667*OC - UNH3F(NY,NX)=UNH3F(NY,NX)-ON - UN2OF(NY,NX)=UN2OF(NY,NX)-0.0 - UPO4F(NY,NX)=UPO4F(NY,NX)-OP - TNBP(NY,NX)=TNBP(NY,NX)-OC - ENDIF - ENDIF -2950 CONTINUE -C IFLGS(NY,NX)=1 - ENDIF -C -C CHANGE EXTERNAL WATER TABLE DEPTH THROUGH DISTURBANCE -C - IF(J.EQ.INT(ZNOON(NY,NX)).AND.ITILL(I,NY,NX).EQ.23)THEN - DTBLI(NY,NX)=DCORP(I,NY,NX) - IF(BKDS(NU(NY,NX),NY,NX).GT.0.0)THEN - DTBLZ(NY,NX)=AMAX1(0.0,DTBLI(NY,NX)-(ALTZ(NY,NX)-ALT(NY,NX)) - 2*(1.0-DTBLG(NY,NX))) - ELSE - DTBLZ(NY,NX)=0.0 - ENDIF - DTBLX(NY,NX)=DTBLZ(NY,NX) - ENDIF - IF(J.EQ.INT(ZNOON(NY,NX)).AND.ITILL(I,NY,NX).EQ.24)THEN - DDRGI(NY,NX)=DCORP(I,NY,NX) - IF(BKDS(NU(NY,NX),NY,NX).GT.0.0)THEN - DDRG(NY,NX)=AMAX1(0.0,DDRGI(NY,NX)-(ALTZ(NY,NX)-ALT(NY,NX)) - 2*(1.0-DTBLG(NY,NX))) - ELSE - DDRG(NY,NX)=0.0 - ENDIF - DTBLX(NY,NX)=DDRG(NY,NX) - ENDIF -C -C MIX ALL SOIL STATE VARIABLES AND INCORPORATE ALL SURFACE -C RESIDUE STATE VARIABLES WITHIN THE TILLAGE ZONE TO THE EXTENT -C ASSOCIATED IN 'DAY' WITH EACH TILLAGE EVENT ENTERED IN THE -C TILLAGE FILE -C - IF(J.EQ.INT(ZNOON(NY,NX)).AND.XCORP(NY,NX).LT.1.0 - 2.AND.DCORP(I,NY,NX).GT.0.0)THEN -C -C EXTENT OF MIXING -C - CORP=1.0-XCORP(NY,NX) -C -C TEMPORARY ACCUMULATORS -C - TBKDS=0.0 - TFC=0.0 - TWP=0.0 - TSCNV=0.0 - TSCNH=0.0 - TSAND=0.0 - TSILT=0.0 - TCLAY=0.0 - TXCEC=0.0 - TXAEC=0.0 - TGKC4=0.0 - TGKCA=0.0 - TGKCM=0.0 - TGKCN=0.0 - TGKCK=0.0 - TVOLW=0.0 - TVOLI=0.0 - TVOLP=0.0 - TVOLA=0.0 - TENGY=0.0 - TVHCM=0.0 - TNFNIH=0.0 - TNH4FA=0.0 - TNH3FA=0.0 - TNHUFA=0.0 - TNO3FA=0.0 - TNH4FB=0.0 - TNH3FB=0.0 - TNHUFB=0.0 - TNO3FB=0.0 - TNH4S=0.0 - TNH4B=0.0 - TNH3S=0.0 - TNH3B=0.0 - TNO3S=0.0 - TNO3B=0.0 - TNO2S=0.0 - TNO2B=0.0 - TZAL=0.0 - TZFE=0.0 - TZHY=0.0 - TZCA=0.0 - TZMG=0.0 - TZNA=0.0 - TZKA=0.0 - TZOH=0.0 - TZSO4=0.0 - TZCL=0.0 - TZCO3=0.0 - TZHCO3=0.0 - TZALO1=0.0 - TZALO2=0.0 - TZALO3=0.0 - TZALO4=0.0 - TZALS=0.0 - TZFEO1=0.0 - TZFEO2=0.0 - TZFEO3=0.0 - TZFEO4=0.0 - TZFES=0.0 - TZCAO=0.0 - TZCAC=0.0 - TZCAH=0.0 - TZCAS=0.0 - TZMGO=0.0 - TZMGC=0.0 - TZMGH=0.0 - TZMGS=0.0 - TZNAC=0.0 - TZNAS=0.0 - TZKAS=0.0 - TH0PO4=0.0 - TH1PO4=0.0 - TH2PO4=0.0 - TH3PO4=0.0 - TZFE1P=0.0 - TZFE2P=0.0 - TZCA0P=0.0 - TZCA1P=0.0 - TZCA2P=0.0 - TZMG1P=0.0 - TH0POB=0.0 - TH1POB=0.0 - TH2POB=0.0 - TH3POB=0.0 - TFE1PB=0.0 - TFE2PB=0.0 - TCA0PB=0.0 - TCA1PB=0.0 - TCA2PB=0.0 - TMG1PB=0.0 - TXNH4=0.0 - TXNHB=0.0 - TXHY=0.0 - TXAL=0.0 - TXCA=0.0 - TXMG=0.0 - TXNA=0.0 - TXKA=0.0 - TXHC=0.0 - TXAL2=0.0 - TXOH0=0.0 - TXOH1=0.0 - TXOH2=0.0 - TXH1P=0.0 - TXH2P=0.0 - TXOH0B=0.0 - TXOH1B=0.0 - TXOH2B=0.0 - TXH1PB=0.0 - TXH2PB=0.0 - TPALOH=0.0 - TPFEOH=0.0 - TPCACO=0.0 - TPCASO=0.0 - TPALPO=0.0 - TPFEPO=0.0 - TPCAPD=0.0 - TPCAPH=0.0 - TPCAPM=0.0 - TPALPB=0.0 - TPFEPB=0.0 - TPCPDB=0.0 - TPCPHB=0.0 - TPCPMB=0.0 - TCO2G=0.0 - TCH4G=0.0 - TCOZS=0.0 - TCHFS=0.0 - TOXYG=0.0 - TOXYS=0.0 - TZ2GG=0.0 - TZ2GS=0.0 - TZ2OG=0.0 - TZ2OS=0.0 - 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 - TOMC(M,N,K)=0.0 - TOMN(M,N,K)=0.0 - TOMP(M,N,K)=0.0 -3990 CONTINUE - DO 3980 K=0,4 - DO 3975 M=1,2 - TORC(M,K)=0.0 - TORN(M,K)=0.0 - TORP(M,K)=0.0 -3975 CONTINUE - TOQC(K)=0.0 - TOQN(K)=0.0 - TOQP(K)=0.0 - TOQA(K)=0.0 - TOHC(K)=0.0 - TOHN(K)=0.0 - TOHP(K)=0.0 - TOHA(K)=0.0 - DO 3970 M=1,4 - TOSC(M,K)=0.0 - TOSA(M,K)=0.0 - TOSN(M,K)=0.0 - TOSP(M,K)=0.0 -3970 CONTINUE -3980 CONTINUE -C -C ACCUMULATE STATE VARIABLES IN SURFACE RESIDUE FOR ADDITION -C TO SOIL IN TILLAGE MIXING ZONE -C - RC=0.0 - RN=0.0 - RP=0.0 - DO 3950 K=0,5 - IF(K.NE.3.AND.K.NE.4)THEN - DO 3945 N=1,7 - DO 3945 M=1,3 - TOMGC(M,N,K)=OMC(M,N,K,0,NY,NX)*CORP - TOMGN(M,N,K)=OMN(M,N,K,0,NY,NX)*CORP - TOMGP(M,N,K)=OMP(M,N,K,0,NY,NX)*CORP - OMC(M,N,K,0,NY,NX)=OMC(M,N,K,0,NY,NX)*XCORP(NY,NX) - OMN(M,N,K,0,NY,NX)=OMN(M,N,K,0,NY,NX)*XCORP(NY,NX) - OMP(M,N,K,0,NY,NX)=OMP(M,N,K,0,NY,NX)*XCORP(NY,NX) - RC=RC+OMC(M,N,K,0,NY,NX) - RN=RN+OMN(M,N,K,0,NY,NX) - RP=RP+OMP(M,N,K,0,NY,NX) -3945 CONTINUE - ENDIF -3950 CONTINUE - DO 3940 K=0,2 - DO 3935 M=1,2 - TORXC(M,K)=ORC(M,K,0,NY,NX)*CORP - TORXN(M,K)=ORN(M,K,0,NY,NX)*CORP - TORXP(M,K)=ORP(M,K,0,NY,NX)*CORP - ORC(M,K,0,NY,NX)=ORC(M,K,0,NY,NX)*XCORP(NY,NX) - ORN(M,K,0,NY,NX)=ORN(M,K,0,NY,NX)*XCORP(NY,NX) - ORP(M,K,0,NY,NX)=ORP(M,K,0,NY,NX)*XCORP(NY,NX) - RC=RC+ORC(M,K,0,NY,NX) - RN=RN+ORN(M,K,0,NY,NX) - RP=RP+ORP(M,K,0,NY,NX) -3935 CONTINUE - TOQGC(K)=OQC(K,0,NY,NX)*CORP - TOQGN(K)=OQN(K,0,NY,NX)*CORP - TOQGP(K)=OQP(K,0,NY,NX)*CORP - TOQGA(K)=OQA(K,0,NY,NX)*CORP - TOQHC(K)=OQCH(K,0,NY,NX)*CORP - TOQHN(K)=OQNH(K,0,NY,NX)*CORP - TOQHP(K)=OQPH(K,0,NY,NX)*CORP - TOQHA(K)=OQAH(K,0,NY,NX)*CORP - TOHGC(K)=OHC(K,0,NY,NX)*CORP - TOHGN(K)=OHN(K,0,NY,NX)*CORP - TOHGP(K)=OHP(K,0,NY,NX)*CORP - TOHGA(K)=OHA(K,0,NY,NX)*CORP -C -C REDUCE SURFACE RESIDUE STATE VARIABLES FOR INCORPORATION -C - OQC(K,0,NY,NX)=OQC(K,0,NY,NX)*XCORP(NY,NX) - OQN(K,0,NY,NX)=OQN(K,0,NY,NX)*XCORP(NY,NX) - OQP(K,0,NY,NX)=OQP(K,0,NY,NX)*XCORP(NY,NX) - OQA(K,0,NY,NX)=OQA(K,0,NY,NX)*XCORP(NY,NX) - OQCH(K,0,NY,NX)=OQCH(K,0,NY,NX)*XCORP(NY,NX) - OQNH(K,0,NY,NX)=OQNH(K,0,NY,NX)*XCORP(NY,NX) - OQPH(K,0,NY,NX)=OQPH(K,0,NY,NX)*XCORP(NY,NX) - OQAH(K,0,NY,NX)=OQAH(K,0,NY,NX)*XCORP(NY,NX) - OHC(K,0,NY,NX)=OHC(K,0,NY,NX)*XCORP(NY,NX) - OHN(K,0,NY,NX)=OHN(K,0,NY,NX)*XCORP(NY,NX) - OHP(K,0,NY,NX)=OHP(K,0,NY,NX)*XCORP(NY,NX) - OHA(K,0,NY,NX)=OHA(K,0,NY,NX)*XCORP(NY,NX) - RC=RC+OQC(K,0,NY,NX)+OQCH(K,0,NY,NX)+OHC(K,0,NY,NX)+OQA(K,0,NY,NX) - 2+OQAH(K,0,NY,NX)+OHA(K,0,NY,NX) - RN=RN+OQN(K,0,NY,NX)+OQNH(K,0,NY,NX)+OHN(K,0,NY,NX) - RP=RP+OQP(K,0,NY,NX)+OQPH(K,0,NY,NX)+OHP(K,0,NY,NX) - DO 3965 M=1,4 - TOSGC(M,K)=OSC(M,K,0,NY,NX)*CORP - TOSGA(M,K)=OSA(M,K,0,NY,NX)*CORP - TOSGN(M,K)=OSN(M,K,0,NY,NX)*CORP - TOSGP(M,K)=OSP(M,K,0,NY,NX)*CORP - OSC(M,K,0,NY,NX)=OSC(M,K,0,NY,NX)*XCORP(NY,NX) - OSA(M,K,0,NY,NX)=OSA(M,K,0,NY,NX)*XCORP(NY,NX) - OSN(M,K,0,NY,NX)=OSN(M,K,0,NY,NX)*XCORP(NY,NX) - OSP(M,K,0,NY,NX)=OSP(M,K,0,NY,NX)*XCORP(NY,NX) - RC=RC+OSC(M,K,0,NY,NX) - RN=RN+OSN(M,K,0,NY,NX) - RP=RP+OSP(M,K,0,NY,NX) -3965 CONTINUE -3940 CONTINUE - TCO2GS=CO2S(0,NY,NX)*CORP - TCH4GS=CH4S(0,NY,NX)*CORP - TOXYGS=OXYS(0,NY,NX)*CORP - TZ2GSG=Z2GS(0,NY,NX)*CORP - TZ2OGS=Z2OS(0,NY,NX)*CORP - TH2GGS=H2GS(0,NY,NX)*CORP - TNH4GS=ZNH4S(0,NY,NX)*CORP - TNH3GS=ZNH3S(0,NY,NX)*CORP - TNO3GS=ZNO3S(0,NY,NX)*CORP - TNO2GS=ZNO2S(0,NY,NX)*CORP - TPO4GS=H2PO4(0,NY,NX)*CORP - TXN4G=XN4(0,NY,NX)*CORP - TXOH0G=XOH0(0,NY,NX)*CORP - TXOH1G=XOH1(0,NY,NX)*CORP - TXOH2G=XOH2(0,NY,NX)*CORP - TXH1PG=XH1P(0,NY,NX)*CORP - TXH2PG=XH2P(0,NY,NX)*CORP - TALPOG=PALPO(0,NY,NX)*CORP - TFEPOG=PFEPO(0,NY,NX)*CORP - TCAPDG=PCAPD(0,NY,NX)*CORP - TCAPHG=PCAPH(0,NY,NX)*CORP - TCAPMG=PCAPM(0,NY,NX)*CORP - TNH4FG=ZNH4FA(0,NY,NX)*CORP - TNH3FG=ZNH3FA(0,NY,NX)*CORP - TNHUFG=ZNHUFA(0,NY,NX)*CORP - TNO3FG=ZNO3FA(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) - HEATIN=HEATIN-HFLXD - HEATSO=HEATSO-HFLXD - TENGYR=(4.19*TVOLWR+1.9274*TVOLIR)*TKS(0,NY,NX) - ORGC(0,NY,NX)=RC - ORGN(0,NY,NX)=RN - ORGR(0,NY,NX)=RC - CO2S(0,NY,NX)=CO2S(0,NY,NX)*XCORP(NY,NX) - CH4S(0,NY,NX)=CH4S(0,NY,NX)*XCORP(NY,NX) - OXYS(0,NY,NX)=OXYS(0,NY,NX)*XCORP(NY,NX) - Z2GS(0,NY,NX)=Z2GS(0,NY,NX)*XCORP(NY,NX) - Z2OS(0,NY,NX)=Z2OS(0,NY,NX)*XCORP(NY,NX) - H2GS(0,NY,NX)=H2GS(0,NY,NX)*XCORP(NY,NX) - ZNH4S(0,NY,NX)=ZNH4S(0,NY,NX)*XCORP(NY,NX) - ZNH3S(0,NY,NX)=ZNH3S(0,NY,NX)*XCORP(NY,NX) - ZNO3S(0,NY,NX)=ZNO3S(0,NY,NX)*XCORP(NY,NX) - ZNO2S(0,NY,NX)=ZNO2S(0,NY,NX)*XCORP(NY,NX) - H2PO4(0,NY,NX)=H2PO4(0,NY,NX)*XCORP(NY,NX) - XN4(0,NY,NX)=XN4(0,NY,NX)*XCORP(NY,NX) - XOH0(0,NY,NX)=XOH0(0,NY,NX)*XCORP(NY,NX) - XOH1(0,NY,NX)=XOH1(0,NY,NX)*XCORP(NY,NX) - XOH2(0,NY,NX)=XOH2(0,NY,NX)*XCORP(NY,NX) - XH1P(0,NY,NX)=XH1P(0,NY,NX)*XCORP(NY,NX) - XH2P(0,NY,NX)=XH2P(0,NY,NX)*XCORP(NY,NX) - PALPO(0,NY,NX)=PALPO(0,NY,NX)*XCORP(NY,NX) - PFEPO(0,NY,NX)=PFEPO(0,NY,NX)*XCORP(NY,NX) - PCAPD(0,NY,NX)=PCAPD(0,NY,NX)*XCORP(NY,NX) - PCAPH(0,NY,NX)=PCAPH(0,NY,NX)*XCORP(NY,NX) - PCAPM(0,NY,NX)=PCAPM(0,NY,NX)*XCORP(NY,NX) - ZNH4FA(0,NY,NX)=ZNH4FA(0,NY,NX)*XCORP(NY,NX) - ZNH3FA(0,NY,NX)=ZNH3FA(0,NY,NX)*XCORP(NY,NX) - ZNHUFA(0,NY,NX)=ZNHUFA(0,NY,NX)*XCORP(NY,NX) - ZNO3FA(0,NY,NX)=ZNO3FA(0,NY,NX)*XCORP(NY,NX) - VOLW(0,NY,NX)=VOLW(0,NY,NX)*XCORP(NY,NX) - VOLI(0,NY,NX)=VOLI(0,NY,NX)*XCORP(NY,NX) - VHCPR(NY,NX)=VHCPR(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)) - ZNFNX0=AMAX1(ZNFNX0,ZNFN0(0,NY,NX)) - LL=NU(NY,NX) -C -C REDISTRIBUTE SOIL STATE VARIABLES DURING TILLAGE -C - DCORPZ=AMIN1(DCORP(I,NY,NX),CDPTH(NL(NY,NX),NY,NX)) - DCORPX=DCORPZ+(CDPTH(NU(NY,NX),NY,NX)-DLYR(3,NU(NY,NX),NY,NX)) -C -C ACCUMULATE SOIL STATE VARIABLES WITHIN TILLAGE MIXING ZONE -C - DO 1000 L=NU(NY,NX),NL(NY,NX) - IF(CDPTH(L,NY,NX)-DLYR(3,L,NY,NX).LT.DCORPX)THEN - TL=AMIN1(DLYR(3,L,NY,NX),DCORPX-(CDPTH(L,NY,NX) - 2-DLYR(3,L,NY,NX))) - FI=TL/DCORPZ - TI=TL/DLYR(3,L,NY,NX) - TBKDS=TBKDS+FI*BKDS(L,NY,NX) - TFC=TFC+FI*FC(L,NY,NX) - TWP=TWP+FI*WP(L,NY,NX) - TSCNV=TSCNV+FI*SCNV(L,NY,NX) - TSCNH=TSCNH+FI*SCNH(L,NY,NX) - TSAND=TSAND+TI*SAND(L,NY,NX) - TSILT=TSILT+TI*SILT(L,NY,NX) - TCLAY=TCLAY+TI*CLAY(L,NY,NX) - TXCEC=TXCEC+TI*XCEC(L,NY,NX) - TXAEC=TXAEC+TI*XAEC(L,NY,NX) - TGKC4=TGKC4+FI*GKC4(L,NY,NX) - TGKCA=TGKCA+FI*GKCA(L,NY,NX) - TGKCM=TGKCM+FI*GKCM(L,NY,NX) - TGKCN=TGKCN+FI*GKCN(L,NY,NX) - TGKCK=TGKCK+FI*GKCK(L,NY,NX) - TVOLW=TVOLW+TI*VOLW(L,NY,NX) - TVOLI=TVOLI+TI*VOLI(L,NY,NX) - TVOLP=TVOLP+TI*VOLP(L,NY,NX) - TVOLA=TVOLA+TI*VOLA(L,NY,NX) - TENGY=TENGY+TI*(4.19*(VOLW(L,NY,NX)+VOLWH(L,NY,NX)) - 2+1.9274*(VOLI(L,NY,NX)+VOLIH(L,NY,NX)))*TKS(L,NY,NX) - TNH4FA=TNH4FA+TI*ZNH4FA(L,NY,NX) - TNH3FA=TNH3FA+TI*ZNH3FA(L,NY,NX) - TNHUFA=TNHUFA+TI*ZNHUFA(L,NY,NX) - TNO3FA=TNO3FA+TI*ZNO3FA(L,NY,NX) - TNH4FB=TNH4FB+TI*ZNH4FB(L,NY,NX) - TNH3FB=TNH3FB+TI*ZNH3FB(L,NY,NX) - TNHUFB=TNHUFB+TI*ZNHUFB(L,NY,NX) - TNO3FB=TNO3FB+TI*ZNO3FB(L,NY,NX) - TNH4S=TNH4S+TI*ZNH4S(L,NY,NX) - TNH4B=TNH4B+TI*ZNH4B(L,NY,NX) - TNH3S=TNH3S+TI*ZNH3S(L,NY,NX) - TNH3B=TNH3B+TI*ZNH3B(L,NY,NX) - TNO3S=TNO3S+TI*ZNO3S(L,NY,NX) - TNO3B=TNO3B+TI*ZNO3B(L,NY,NX) - TNO2S=TNO2S+TI*ZNO2S(L,NY,NX) - TNO2B=TNO2B+TI*ZNO2B(L,NY,NX) - TZAL=TZAL+TI*ZAL(L,NY,NX) - TZFE=TZFE+TI*ZFE(L,NY,NX) - TZHY=TZHY+TI*ZHY(L,NY,NX) - TZCA=TZCA+TI*ZCA(L,NY,NX) - TZMG=TZMG+TI*ZMG(L,NY,NX) - TZNA=TZNA+TI*ZNA(L,NY,NX) - TZKA=TZKA+TI*ZKA(L,NY,NX) - TZOH=TZOH+TI*ZOH(L,NY,NX) - TZSO4=TZSO4+TI*ZSO4(L,NY,NX) - TZCL=TZCL+TI*ZCL(L,NY,NX) - TZCO3=TZCO3+TI*ZCO3(L,NY,NX) - TZHCO3=TZHCO3+TI*ZHCO3(L,NY,NX) - TZALO1=TZALO1+TI*ZALOH1(L,NY,NX) - TZALO2=TZALO2+TI*ZALOH2(L,NY,NX) - TZALO3=TZALO3+TI*ZALOH3(L,NY,NX) - TZALO4=TZALO4+TI*ZALOH4(L,NY,NX) - TZALS=TZALS+TI*ZALS(L,NY,NX) - TZFEO1=TZFEO1+TI*ZFEOH1(L,NY,NX) - TZFEO2=TZFEO2+TI*ZFEOH2(L,NY,NX) - TZFEO3=TZFEO3+TI*ZFEOH3(L,NY,NX) - TZFEO4=TZFEO4+TI*ZFEOH4(L,NY,NX) - TZFES=TZFES+TI*ZFES(L,NY,NX) - TZCAO=TZCAO+TI*ZCAO(L,NY,NX) - TZCAC=TZCAC+TI*ZCAC(L,NY,NX) - TZCAH=TZCAH+TI*ZCAH(L,NY,NX) - TZCAS=TZCAS+TI*ZCAS(L,NY,NX) - TZMGO=TZMGO+TI*ZMGO(L,NY,NX) - TZMGC=TZMGC+TI*ZMGC(L,NY,NX) - TZMGH=TZMGH+TI*ZMGH(L,NY,NX) - TZMGS=TZMGS+TI*ZMGS(L,NY,NX) - TZNAC=TZNAC+TI*ZNAC(L,NY,NX) - TZNAS=TZNAS+TI*ZNAS(L,NY,NX) - TZKAS=TZKAS+TI*ZKAS(L,NY,NX) - TH0PO4=TH0PO4+TI*H0PO4(L,NY,NX) - TH1PO4=TH1PO4+TI*H1PO4(L,NY,NX) - TH2PO4=TH2PO4+TI*H2PO4(L,NY,NX) - TH3PO4=TH3PO4+TI*H3PO4(L,NY,NX) - TZFE1P=TZFE1P+TI*ZFE1P(L,NY,NX) - TZFE2P=TZFE2P+TI*ZFE2P(L,NY,NX) - TZCA0P=TZCA0P+TI*ZCA0P(L,NY,NX) - TZCA1P=TZCA1P+TI*ZCA1P(L,NY,NX) - TZCA2P=TZCA2P+TI*ZCA2P(L,NY,NX) - TZMG1P=TZMG1P+TI*ZMG1P(L,NY,NX) - TH0POB=TH0POB+TI*H0POB(L,NY,NX) - TH1POB=TH1POB+TI*H1POB(L,NY,NX) - TH2POB=TH2POB+TI*H2POB(L,NY,NX) - TH3POB=TH3POB+TI*H3POB(L,NY,NX) - TFE1PB=TFE1PB+TI*ZFE1PB(L,NY,NX) - TFE2PB=TFE2PB+TI*ZFE2PB(L,NY,NX) - TCA0PB=TCA0PB+TI*ZCA0PB(L,NY,NX) - TCA1PB=TCA1PB+TI*ZCA1PB(L,NY,NX) - TCA2PB=TCA2PB+TI*ZCA2PB(L,NY,NX) - TMG1PB=TMG1PB+TI*ZMG1PB(L,NY,NX) - TXNH4=TXNH4+TI*XN4(L,NY,NX) - TXNHB=TXNHB+TI*XNB(L,NY,NX) - TXHY=TXHY+TI*XHY(L,NY,NX) - TXAL=TXAL+TI*XAL(L,NY,NX) - TXCA=TXCA+TI*XCA(L,NY,NX) - TXMG=TXMG+TI*XMG(L,NY,NX) - TXNA=TXNA+TI*XNA(L,NY,NX) - TXKA=TXKA+TI*XKA(L,NY,NX) - TXHC=TXHC+TI*XHC(L,NY,NX) - TXAL2=TXAL2+TI*XALO2(L,NY,NX) - TXOH0=TXOH0+TI*XOH0(L,NY,NX) - TXOH1=TXOH1+TI*XOH1(L,NY,NX) - TXOH2=TXOH2+TI*XOH2(L,NY,NX) - TXH1P=TXH1P+TI*XH1P(L,NY,NX) - TXH2P=TXH2P+TI*XH2P(L,NY,NX) - TXOH0B=TXOH0B+TI*XOH0B(L,NY,NX) - TXOH1B=TXOH1B+TI*XOH1B(L,NY,NX) - TXOH2B=TXOH2B+TI*XOH2B(L,NY,NX) - TXH1PB=TXH1PB+TI*XH1PB(L,NY,NX) - TXH2PB=TXH2PB+TI*XH2PB(L,NY,NX) - TPALOH=TPALOH+TI*PALOH(L,NY,NX) - TPFEOH=TPFEOH+TI*PFEOH(L,NY,NX) - TPCACO=TPCACO+TI*PCACO(L,NY,NX) - TPCASO=TPCASO+TI*PCASO(L,NY,NX) - TPALPO=TPALPO+TI*PALPO(L,NY,NX) - TPFEPO=TPFEPO+TI*PFEPO(L,NY,NX) - TPCAPD=TPCAPD+TI*PCAPD(L,NY,NX) - TPCAPH=TPCAPH+TI*PCAPH(L,NY,NX) - TPCAPM=TPCAPM+TI*PCAPM(L,NY,NX) - TPALPB=TPALPB+TI*PALPB(L,NY,NX) - TPFEPB=TPFEPB+TI*PFEPB(L,NY,NX) - TPCPDB=TPCPDB+TI*PCPDB(L,NY,NX) - TPCPHB=TPCPHB+TI*PCPHB(L,NY,NX) - TPCPMB=TPCPMB+TI*PCPMB(L,NY,NX) - TCO2G=TCO2G+TI*CO2G(L,NY,NX) - TCH4G=TCH4G+TI*CH4G(L,NY,NX) - TCOZS=TCOZS+TI*CO2S(L,NY,NX) - TCHFS=TCHFS+TI*CH4S(L,NY,NX) - TOXYG=TOXYG+TI*OXYG(L,NY,NX) - TOXYS=TOXYS+TI*OXYS(L,NY,NX) - TZ2GG=TZ2GG+TI*Z2GG(L,NY,NX) - TZ2GS=TZ2GS+TI*Z2GS(L,NY,NX) - TZ2OG=TZ2OG+TI*Z2OG(L,NY,NX) - TZ2OS=TZ2OS+TI*Z2OS(L,NY,NX) - TZNH3G=TZNH3G+TI*ZNH3G(L,NY,NX) - TH2GG=TH2GG+TI*H2GG(L,NY,NX) - TH2GS=TH2GS+TI*H2GS(L,NY,NX) - DO 4985 K=0,5 - DO 4985 N=1,7 - DO 4985 M=1,3 - TOMC(M,N,K)=TOMC(M,N,K)+TI*OMC(M,N,K,L,NY,NX) - TOMN(M,N,K)=TOMN(M,N,K)+TI*OMN(M,N,K,L,NY,NX) - TOMP(M,N,K)=TOMP(M,N,K)+TI*OMP(M,N,K,L,NY,NX) -4985 CONTINUE - DO 4980 K=0,4 - DO 4975 M=1,2 - TORC(M,K)=TORC(M,K)+TI*ORC(M,K,L,NY,NX) - TORN(M,K)=TORN(M,K)+TI*ORN(M,K,L,NY,NX) - TORP(M,K)=TORP(M,K)+TI*ORP(M,K,L,NY,NX) -4975 CONTINUE - TOQC(K)=TOQC(K)+TI*OQC(K,L,NY,NX) - TOQN(K)=TOQN(K)+TI*OQN(K,L,NY,NX) - TOQP(K)=TOQP(K)+TI*OQP(K,L,NY,NX) - TOQA(K)=TOQA(K)+TI*OQA(K,L,NY,NX) - TOHC(K)=TOHC(K)+TI*OHC(K,L,NY,NX) - TOHN(K)=TOHN(K)+TI*OHN(K,L,NY,NX) - TOHP(K)=TOHP(K)+TI*OHP(K,L,NY,NX) - TOHA(K)=TOHA(K)+TI*OHA(K,L,NY,NX) - DO 4970 M=1,4 - TOSC(M,K)=TOSC(M,K)+TI*OSC(M,K,L,NY,NX) - TOSA(M,K)=TOSA(M,K)+TI*OSA(M,K,L,NY,NX) - TOSN(M,K)=TOSN(M,K)+TI*OSN(M,K,L,NY,NX) - 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)) - ZNFNX0=AMAX1(ZNFNX0,ZNFN0(L,NY,NX)) - LL=L - ENDIF -1000 CONTINUE -C -C CHANGE SOIL STATE VARIABLES IN TILLAGE MIXING ZONE -C TO ACCOUNT FOR REDISTRIBUTION FROM MIXING -C - HEATSR=VHCPW(NY,NX)*TKW(NY,NX)+VHCPR(NY,NX)*TKS(0,NY,NX) - DO 2000 L=NU(NY,NX),LL - TL=AMIN1(DLYR(3,L,NY,NX),DCORPX-(CDPTH(L,NY,NX) - 2-DLYR(3,L,NY,NX))) - FI=TL/DCORPZ - TI=TL/DLYR(3,L,NY,NX) - TX=1.0-TI - BKDS(L,NY,NX)=TI*(BKDS(L,NY,NX)+CORP*(TBKDS-BKDS(L,NY,NX))) - 2+TX*BKDS(L,NY,NX) - FC(L,NY,NX)=TI*(FC(L,NY,NX)+CORP*(TFC-FC(L,NY,NX))) - 2+TX*FC(L,NY,NX) - WP(L,NY,NX)=TI*(WP(L,NY,NX)+CORP*(TWP-WP(L,NY,NX))) - 2+TX*WP(L,NY,NX) - SCNV(L,NY,NX)=TI*(SCNV(L,NY,NX)+CORP*(TSCNV-SCNV(L,NY,NX))) - 2+TX*SCNV(L,NY,NX) - SCNH(L,NY,NX)=TI*(SCNH(L,NY,NX)+CORP*(TSCNH-SCNH(L,NY,NX))) - 2+TX*SCNH(L,NY,NX) - SAND(L,NY,NX)=TI*SAND(L,NY,NX)+CORP*(FI*TSAND-TI*SAND(L,NY,NX)) - 2+TX*SAND(L,NY,NX) - SILT(L,NY,NX)=TI*SILT(L,NY,NX)+CORP*(FI*TSILT-TI*SILT(L,NY,NX)) - 2+TX*SILT(L,NY,NX) - CLAY(L,NY,NX)=TI*CLAY(L,NY,NX)+CORP*(FI*TCLAY-TI*CLAY(L,NY,NX)) - 2+TX*CLAY(L,NY,NX) - XCEC(L,NY,NX)=TI*XCEC(L,NY,NX)+CORP*(FI*TXCEC-TI*XCEC(L,NY,NX)) - 2+TX*XCEC(L,NY,NX) - XAEC(L,NY,NX)=TI*XAEC(L,NY,NX)+CORP*(FI*TXAEC-TI*XAEC(L,NY,NX)) - 2+TX*XAEC(L,NY,NX) - GKC4(L,NY,NX)=TI*(GKC4(L,NY,NX)+CORP*(TGKC4-GKC4(L,NY,NX))) - 2+TX*GKC4(L,NY,NX) - GKCA(L,NY,NX)=TI*(GKCA(L,NY,NX)+CORP*(TGKCA-GKCA(L,NY,NX))) - 2+TX*GKCA(L,NY,NX) - GKCM(L,NY,NX)=TI*(GKCM(L,NY,NX)+CORP*(TGKCM-GKCM(L,NY,NX))) - 2+TX*GKCM(L,NY,NX) - GKCN(L,NY,NX)=TI*(GKCN(L,NY,NX)+CORP*(TGKCN-GKCN(L,NY,NX))) - 2+TX*GKCN(L,NY,NX) - GKCK(L,NY,NX)=TI*(GKCK(L,NY,NX)+CORP*(TGKCK-GKCK(L,NY,NX))) - 2+TX*GKCK(L,NY,NX) - ENGYM=VHCM(L,NY,NX)*TKS(L,NY,NX) - ENGYW=(4.19*(VOLW(L,NY,NX)+VOLWH(L,NY,NX)) - 2+1.9274*(VOLI(L,NY,NX)+VOLIH(L,NY,NX)))*TKS(L,NY,NX) - VOLW(L,NY,NX)=TI*VOLW(L,NY,NX)+CORP*(FI*TVOLW-TI*VOLW(L,NY,NX)) - 2+TX*VOLW(L,NY,NX)+FI*TVOLWR - VOLI(L,NY,NX)=TI*VOLI(L,NY,NX)+CORP*(FI*TVOLI-TI*VOLI(L,NY,NX)) - 2+TX*VOLI(L,NY,NX)+FI*TVOLIR - VOLP(L,NY,NX)=TI*VOLP(L,NY,NX)+CORP*(FI*TVOLP-TI*VOLP(L,NY,NX)) - 2+TX*VOLP(L,NY,NX) - VOLA(L,NY,NX)=TI*VOLA(L,NY,NX)+CORP*(FI*TVOLA-TI*VOLA(L,NY,NX)) - 2+TX*VOLA(L,NY,NX) - VOLWX(L,NY,NX)=VOLW(L,NY,NX) -C VOLW(L,NY,NX)=VOLW(L,NY,NX)+CORP*VOLWH(L,NY,NX) -C VOLI(L,NY,NX)=VOLI(L,NY,NX)+CORP*VOLIH(L,NY,NX) -C VOLA(L,NY,NX)=VOLA(L,NY,NX)+CORP*VOLAH(L,NY,NX) -C VOLWH(L,NY,NX)=XCORP(NY,NX)*VOLWH(L,NY,NX) -C VOLWH(L,NY,NX)=XCORP(NY,NX)*VOLWH(L,NY,NX) -C VOLIH(L,NY,NX)=XCORP(NY,NX)*VOLIH(L,NY,NX) -C FHOL(L,NY,NX)=XCORP(NY,NX)*FHOL(L,NY,NX) - ENGYL=TI*ENGYW+CORP*(FI*TENGY-TI*ENGYW)+TX*ENGYW+FI*TENGYR - VHCP(L,NY,NX)=VHCM(L,NY,NX)+4.19*(VOLW(L,NY,NX)+VOLWH(L,NY,NX)) - 2+1.9274*(VOLI(L,NY,NX)+VOLIH(L,NY,NX)) - TKS(L,NY,NX)=(ENGYM+ENGYL)/VHCP(L,NY,NX) - TCS(L,NY,NX)=TKS(L,NY,NX)-273.15 - ZNH4FA(L,NY,NX)=TI*ZNH4FA(L,NY,NX)+CORP*(FI*TNH4FA - 2-TI*ZNH4FA(L,NY,NX))+TX*ZNH4FA(L,NY,NX) - ZNH3FA(L,NY,NX)=TI*ZNH3FA(L,NY,NX)+CORP*(FI*TNH3FA - 2-TI*ZNH3FA(L,NY,NX))+TX*ZNH3FA(L,NY,NX) - ZNHUFA(L,NY,NX)=TI*ZNHUFA(L,NY,NX)+CORP*(FI*TNHUFA - 2-TI*ZNHUFA(L,NY,NX))+TX*ZNHUFA(L,NY,NX) - ZNO3FA(L,NY,NX)=TI*ZNO3FA(L,NY,NX)+CORP*(FI*TNO3FA - 2-TI*ZNO3FA(L,NY,NX))+TX*ZNO3FA(L,NY,NX) - ZNH4FB(L,NY,NX)=TI*ZNH4FB(L,NY,NX)+CORP*(FI*TNH4FB - 2-TI*ZNH4FB(L,NY,NX))+TX*ZNH4FB(L,NY,NX) - ZNH3FB(L,NY,NX)=TI*ZNH3FB(L,NY,NX)+CORP*(FI*TNH3FB - 2-TI*ZNH3FB(L,NY,NX))+TX*ZNH3FB(L,NY,NX) - ZNHUFB(L,NY,NX)=TI*ZNHUFB(L,NY,NX)+CORP*(FI*TNHUFB - 2-TI*ZNHUFB(L,NY,NX))+TX*ZNHUFB(L,NY,NX) - ZNO3FB(L,NY,NX)=TI*ZNO3FB(L,NY,NX)+CORP*(FI*TNO3FB - 2-TI*ZNO3FB(L,NY,NX))+TX*ZNO3FB(L,NY,NX) - ZNH4S(L,NY,NX)=TI*ZNH4S(L,NY,NX)+CORP*(FI*TNH4S-TI*ZNH4S(L,NY,NX)) - 2+TX*ZNH4S(L,NY,NX)+CORP*ZNH4SH(L,NY,NX) - ZNH4B(L,NY,NX)=TI*ZNH4B(L,NY,NX)+CORP*(FI*TNH4B-TI*ZNH4B(L,NY,NX)) - 2+TX*ZNH4B(L,NY,NX)+CORP*ZNH4BH(L,NY,NX) - ZNH3S(L,NY,NX)=TI*ZNH3S(L,NY,NX)+CORP*(FI*TNH3S-TI*ZNH3S(L,NY,NX)) - 2+TX*ZNH3S(L,NY,NX)+CORP*ZNH3SH(L,NY,NX) - ZNH3B(L,NY,NX)=TI*ZNH3B(L,NY,NX)+CORP*(FI*TNH3B-TI*ZNH3B(L,NY,NX)) - 2+TX*ZNH3B(L,NY,NX)+CORP*ZNH3BH(L,NY,NX) - ZNO3S(L,NY,NX)=TI*ZNO3S(L,NY,NX)+CORP*(FI*TNO3S-TI*ZNO3S(L,NY,NX)) - 2+TX*ZNO3S(L,NY,NX)+CORP*ZNO3SH(L,NY,NX) - ZNO3B(L,NY,NX)=TI*ZNO3B(L,NY,NX)+CORP*(FI*TNO3B-TI*ZNO3B(L,NY,NX)) - 2+TX*ZNO3B(L,NY,NX)+CORP*ZNO3BH(L,NY,NX) - ZNO2S(L,NY,NX)=TI*ZNO2S(L,NY,NX)+CORP*(FI*TNO2S-TI*ZNO2S(L,NY,NX)) - 2+TX*ZNO2S(L,NY,NX)+CORP*ZNO2SH(L,NY,NX) - ZNO2B(L,NY,NX)=TI*ZNO2B(L,NY,NX)+CORP*(FI*TNO2B-TI*ZNO2B(L,NY,NX)) - 2+TX*ZNO2B(L,NY,NX)+CORP*ZNO2BH(L,NY,NX) - ZAL(L,NY,NX)=TI*ZAL(L,NY,NX)+CORP*(FI*TZAL-TI*ZAL(L,NY,NX)) - 2+TX*ZAL(L,NY,NX)+CORP*ZALH(L,NY,NX) - ZFE(L,NY,NX)=TI*ZFE(L,NY,NX)+CORP*(FI*TZFE-TI*ZFE(L,NY,NX)) - 2+TX*ZFE(L,NY,NX)+CORP*ZFEH(L,NY,NX) - ZHY(L,NY,NX)=TI*ZHY(L,NY,NX)+CORP*(FI*TZHY-TI*ZHY(L,NY,NX)) - 2+TX*ZHY(L,NY,NX)+CORP*ZHYH(L,NY,NX) - ZCA(L,NY,NX)=TI*ZCA(L,NY,NX)+CORP*(FI*TZCA-TI*ZCA(L,NY,NX)) - 2+TX*ZCA(L,NY,NX)+CORP*ZCCH(L,NY,NX) - ZMG(L,NY,NX)=TI*ZMG(L,NY,NX)+CORP*(FI*TZMG-TI*ZMG(L,NY,NX)) - 2+TX*ZMG(L,NY,NX)+CORP*ZMAH(L,NY,NX) - ZNA(L,NY,NX)=TI*ZNA(L,NY,NX)+CORP*(FI*TZNA-TI*ZNA(L,NY,NX)) - 2+TX*ZNA(L,NY,NX)+CORP*ZNAH(L,NY,NX) - ZKA(L,NY,NX)=TI*ZKA(L,NY,NX)+CORP*(FI*TZKA-TI*ZKA(L,NY,NX)) - 2+TX*ZKA(L,NY,NX)+CORP*ZKAH(L,NY,NX) - ZOH(L,NY,NX)=TI*ZOH(L,NY,NX)+CORP*(FI*TZOH-TI*ZOH(L,NY,NX)) - 2+TX*ZOH(L,NY,NX)+CORP*ZOHH(L,NY,NX) - ZSO4(L,NY,NX)=TI*ZSO4(L,NY,NX)+CORP*(FI*TZSO4-TI*ZSO4(L,NY,NX)) - 2+TX*ZSO4(L,NY,NX)+CORP*ZSO4H(L,NY,NX) - ZCL(L,NY,NX)=TI*ZCL(L,NY,NX)+CORP*(FI*TZCL-TI*ZCL(L,NY,NX)) - 2+TX*ZCL(L,NY,NX)+CORP*ZCLH(L,NY,NX) - ZCO3(L,NY,NX)=TI*ZCO3(L,NY,NX)+CORP*(FI*TZCO3-TI*ZCO3(L,NY,NX)) - 2+TX*ZCO3(L,NY,NX)+CORP*ZCO3H(L,NY,NX) - ZHCO3(L,NY,NX)=TI*ZHCO3(L,NY,NX)+CORP*(FI*TZHCO3 - 2-TI*ZHCO3(L,NY,NX))+TX*ZHCO3(L,NY,NX)+CORP*ZHCO3H(L,NY,NX) - ZALOH1(L,NY,NX)=TI*ZALOH1(L,NY,NX)+CORP*(FI*TZALO1 - 2-TI*ZALOH1(L,NY,NX))+TX*ZALOH1(L,NY,NX)+CORP*ZALO1H(L,NY,NX) - ZALOH2(L,NY,NX)=TI*ZALOH2(L,NY,NX)+CORP*(FI*TZALO2 - 2-TI*ZALOH2(L,NY,NX))+TX*ZALOH2(L,NY,NX)+CORP*ZALO2H(L,NY,NX) - ZALOH3(L,NY,NX)=TI*ZALOH3(L,NY,NX)+CORP*(FI*TZALO3 - 2-TI*ZALOH3(L,NY,NX))+TX*ZALOH3(L,NY,NX)+CORP*ZALO3H(L,NY,NX) - ZALOH4(L,NY,NX)=TI*ZALOH4(L,NY,NX)+CORP*(FI*TZALO4 - 2-TI*ZALOH4(L,NY,NX))+TX*ZALOH4(L,NY,NX)+CORP*ZALO4H(L,NY,NX) - ZALS(L,NY,NX)=TI*ZALS(L,NY,NX)+CORP*(FI*TZALS-TI*ZALS(L,NY,NX)) - 2+TX*ZALS(L,NY,NX)+CORP*ZALSH(L,NY,NX) - ZFEOH1(L,NY,NX)=TI*ZFEOH1(L,NY,NX)+CORP*(FI*TZFEO1 - 2-TI*ZFEOH1(L,NY,NX))+TX*ZFEOH1(L,NY,NX)+CORP*ZFEO1H(L,NY,NX) - ZFEOH2(L,NY,NX)=TI*ZFEOH2(L,NY,NX)+CORP*(FI*TZFEO2 - 2-TI*ZFEOH2(L,NY,NX))+TX*ZFEOH2(L,NY,NX)+CORP*ZFEO2H(L,NY,NX) - ZFEOH3(L,NY,NX)=TI*ZFEOH3(L,NY,NX)+CORP*(FI*TZFEO3 - 2-TI*ZFEOH3(L,NY,NX))+TX*ZFEOH3(L,NY,NX)+CORP*ZFEO3H(L,NY,NX) - ZFEOH4(L,NY,NX)=TI*ZFEOH4(L,NY,NX)+CORP*(FI*TZFEO4 - 2-TI*ZFEOH4(L,NY,NX))+TX*ZFEOH4(L,NY,NX)+CORP*ZFEO4H(L,NY,NX) - ZFES(L,NY,NX)=TI*ZFES(L,NY,NX)+CORP*(FI*TZFES-TI*ZFES(L,NY,NX)) - 2+TX*ZFES(L,NY,NX)+CORP*ZFESH(L,NY,NX) - ZCAO(L,NY,NX)=TI*ZCAO(L,NY,NX)+CORP*(FI*TZCAO-TI*ZCAO(L,NY,NX)) - 2+TX*ZCAO(L,NY,NX)+CORP*ZCAOH(L,NY,NX) - ZCAC(L,NY,NX)=TI*ZCAC(L,NY,NX)+CORP*(FI*TZCAC-TI*ZCAC(L,NY,NX)) - 2+TX*ZCAC(L,NY,NX)+CORP*ZCACH(L,NY,NX) - ZCAH(L,NY,NX)=TI*ZCAH(L,NY,NX)+CORP*(FI*TZCAH-TI*ZCAH(L,NY,NX)) - 2+TX*ZCAH(L,NY,NX)+CORP*ZCAHH(L,NY,NX) - ZCAS(L,NY,NX)=TI*ZCAS(L,NY,NX)+CORP*(FI*TZCAS-TI*ZCAS(L,NY,NX)) - 2+TX*ZCAS(L,NY,NX)+CORP*ZCASH(L,NY,NX) - ZMGO(L,NY,NX)=TI*ZMGO(L,NY,NX)+CORP*(FI*TZMGO-TI*ZMGO(L,NY,NX)) - 2+TX*ZMGO(L,NY,NX)+CORP*ZMGOH(L,NY,NX) - ZMGC(L,NY,NX)=TI*ZMGC(L,NY,NX)+CORP*(FI*TZMGC-TI*ZMGC(L,NY,NX)) - 2+TX*ZMGC(L,NY,NX)+CORP*ZMGCH(L,NY,NX) - ZMGH(L,NY,NX)=TI*ZMGH(L,NY,NX)+CORP*(FI*TZMGH-TI*ZMGH(L,NY,NX)) - 2+TX*ZMGH(L,NY,NX)+CORP*ZMGHH(L,NY,NX) - ZMGS(L,NY,NX)=TI*ZMGS(L,NY,NX)+CORP*(FI*TZMGS-TI*ZMGS(L,NY,NX)) - 2+TX*ZMGS(L,NY,NX)+CORP*ZMGSH(L,NY,NX) - ZNAC(L,NY,NX)=TI*ZNAC(L,NY,NX)+CORP*(FI*TZNAC-TI*ZNAC(L,NY,NX)) - 2+TX*ZNAC(L,NY,NX)+CORP*ZNACH(L,NY,NX) - ZNAS(L,NY,NX)=TI*ZNAS(L,NY,NX)+CORP*(FI*TZNAS-TI*ZNAS(L,NY,NX)) - 2+TX*ZNAS(L,NY,NX)+CORP*ZNASH(L,NY,NX) - ZKAS(L,NY,NX)=TI*ZKAS(L,NY,NX)+CORP*(FI*TZKAS-TI*ZKAS(L,NY,NX)) - 2+TX*ZKAS(L,NY,NX)+CORP*ZKASH(L,NY,NX) - H0PO4(L,NY,NX)=TI*H0PO4(L,NY,NX)+CORP*(FI*TH0PO4 - 2-TI*H0PO4(L,NY,NX))+TX*H0PO4(L,NY,NX)+CORP*H0PO4H(L,NY,NX) - H1PO4(L,NY,NX)=TI*H1PO4(L,NY,NX)+CORP*(FI*TH1PO4 - 2-TI*H1PO4(L,NY,NX))+TX*H1PO4(L,NY,NX)+CORP*H1PO4H(L,NY,NX) - H2PO4(L,NY,NX)=TI*H2PO4(L,NY,NX)+CORP*(FI*TH2PO4 - 2-TI*H2PO4(L,NY,NX))+TX*H2PO4(L,NY,NX)+CORP*H2PO4H(L,NY,NX) - H3PO4(L,NY,NX)=TI*H3PO4(L,NY,NX)+CORP*(FI*TH3PO4 - 2-TI*H3PO4(L,NY,NX))+TX*H3PO4(L,NY,NX)+CORP*H3PO4H(L,NY,NX) - ZFE1P(L,NY,NX)=TI*ZFE1P(L,NY,NX)+CORP*(FI*TZFE1P - 2-TI*ZFE1P(L,NY,NX))+TX*ZFE1P(L,NY,NX)+CORP*ZFE1PH(L,NY,NX) - ZFE2P(L,NY,NX)=TI*ZFE2P(L,NY,NX)+CORP*(FI*TZFE2P - 2-TI*ZFE2P(L,NY,NX))+TX*ZFE2P(L,NY,NX)+CORP*ZFE2PH(L,NY,NX) - ZCA0P(L,NY,NX)=TI*ZCA0P(L,NY,NX)+CORP*(FI*TZCA0P - 2-TI*ZCA0P(L,NY,NX))+TX*ZCA0P(L,NY,NX)+CORP*ZCA0PH(L,NY,NX) - ZCA1P(L,NY,NX)=TI*ZCA1P(L,NY,NX)+CORP*(FI*TZCA1P - 2-TI*ZCA1P(L,NY,NX))+TX*ZCA1P(L,NY,NX)+CORP*ZCA1PH(L,NY,NX) - ZCA2P(L,NY,NX)=TI*ZCA2P(L,NY,NX)+CORP*(FI*TZCA2P - 2-TI*ZCA2P(L,NY,NX))+TX*ZCA2P(L,NY,NX)+CORP*ZCA2PH(L,NY,NX) - ZMG1P(L,NY,NX)=TI*ZMG1P(L,NY,NX)+CORP*(FI*TZMG1P - 2-TI*ZMG1P(L,NY,NX))+TX*ZMG1P(L,NY,NX)+CORP*ZMG1PH(L,NY,NX) - H0POB(L,NY,NX)=TI*H0POB(L,NY,NX)+CORP*(FI*TH0POB - 2-TI*H0POB(L,NY,NX))+TX*H0POB(L,NY,NX)+CORP*H0POBH(L,NY,NX) - H1POB(L,NY,NX)=TI*H1POB(L,NY,NX)+CORP*(FI*TH1POB - 2-TI*H1POB(L,NY,NX))+TX*H1POB(L,NY,NX)+CORP*H1POBH(L,NY,NX) - H2POB(L,NY,NX)=TI*H2POB(L,NY,NX)+CORP*(FI*TH2POB - 2-TI*H2POB(L,NY,NX))+TX*H2POB(L,NY,NX)+CORP*H2POBH(L,NY,NX) - H3POB(L,NY,NX)=TI*H3POB(L,NY,NX)+CORP*(FI*TH3POB - 2-TI*H3POB(L,NY,NX))+TX*H3POB(L,NY,NX)+CORP*H3POBH(L,NY,NX) - ZFE1PB(L,NY,NX)=TI*ZFE1PB(L,NY,NX)+CORP*(FI*TFE1PB - 2-TI*ZFE1PB(L,NY,NX))+TX*ZFE1PB(L,NY,NX)+CORP*ZFE1BH(L,NY,NX) - ZFE2PB(L,NY,NX)=TI*ZFE2PB(L,NY,NX)+CORP*(FI*TFE2PB - 2-TI*ZFE2PB(L,NY,NX))+TX*ZFE2PB(L,NY,NX)+CORP*ZFE2BH(L,NY,NX) - ZCA0PB(L,NY,NX)=TI*ZCA0PB(L,NY,NX)+CORP*(FI*TCA0PB - 2-TI*ZCA0PB(L,NY,NX))+TX*ZCA0PB(L,NY,NX)+CORP*ZCA0BH(L,NY,NX) - ZCA1PB(L,NY,NX)=TI*ZCA1PB(L,NY,NX)+CORP*(FI*TCA1PB - 2-TI*ZCA1PB(L,NY,NX))+TX*ZCA1PB(L,NY,NX)+CORP*ZCA1BH(L,NY,NX) - ZCA2PB(L,NY,NX)=TI*ZCA2PB(L,NY,NX)+CORP*(FI*TCA2PB - 2-TI*ZCA2PB(L,NY,NX))+TX*ZCA2PB(L,NY,NX)+CORP*ZCA2BH(L,NY,NX) - ZMG1PB(L,NY,NX)=TI*ZMG1PB(L,NY,NX)+CORP*(FI*TMG1PB - 2-TI*ZMG1PB(L,NY,NX))+TX*ZMG1PB(L,NY,NX)+CORP*ZMG1BH(L,NY,NX) - XN4(L,NY,NX)=TI*XN4(L,NY,NX)+CORP*(FI*TXNH4-TI*XN4(L,NY,NX)) - 2+TX*XN4(L,NY,NX) - XNB(L,NY,NX)=TI*XNB(L,NY,NX)+CORP*(FI*TXNHB-TI*XNB(L,NY,NX)) - 2+TX*XNB(L,NY,NX) - XHY(L,NY,NX)=TI*XHY(L,NY,NX)+CORP*(FI*TXHY-TI*XHY(L,NY,NX)) - 2+TX*XHY(L,NY,NX) - XAL(L,NY,NX)=TI*XAL(L,NY,NX)+CORP*(FI*TXAL-TI*XAL(L,NY,NX)) - 2+TX*XAL(L,NY,NX) - XCA(L,NY,NX)=TI*XCA(L,NY,NX)+CORP*(FI*TXCA-TI*XCA(L,NY,NX)) - 2+TX*XCA(L,NY,NX) - XMG(L,NY,NX)=TI*XMG(L,NY,NX)+CORP*(FI*TXMG-TI*XMG(L,NY,NX)) - 2+TX*XMG(L,NY,NX) - XNA(L,NY,NX)=TI*XNA(L,NY,NX)+CORP*(FI*TXNA-TI*XNA(L,NY,NX)) - 2+TX*XNA(L,NY,NX) - XKA(L,NY,NX)=TI*XKA(L,NY,NX)+CORP*(FI*TXKA-TI*XKA(L,NY,NX)) - 2+TX*XKA(L,NY,NX) - XHC(L,NY,NX)=TI*XHC(L,NY,NX)+CORP*(FI*TXHC-TI*XHC(L,NY,NX)) - 2+TX*XHC(L,NY,NX) - XALO2(L,NY,NX)=TI*XALO2(L,NY,NX)+CORP*(FI*TXAL2-TI*XALO2(L,NY,NX)) - 2+TX*XALO2(L,NY,NX) - XOH0(L,NY,NX)=TI*XOH0(L,NY,NX)+CORP*(FI*TXOH0-TI*XOH0(L,NY,NX)) - 2+TX*XOH0(L,NY,NX) - XOH1(L,NY,NX)=TI*XOH1(L,NY,NX)+CORP*(FI*TXOH1-TI*XOH1(L,NY,NX)) - 2+TX*XOH1(L,NY,NX) - XOH2(L,NY,NX)=TI*XOH2(L,NY,NX)+CORP*(FI*TXOH2-TI*XOH2(L,NY,NX)) - 2+TX*XOH2(L,NY,NX) - XH1P(L,NY,NX)=TI*XH1P(L,NY,NX)+CORP*(FI*TXH1P-TI*XH1P(L,NY,NX)) - 2+TX*XH1P(L,NY,NX) - XH2P(L,NY,NX)=TI*XH2P(L,NY,NX)+CORP*(FI*TXH2P-TI*XH2P(L,NY,NX)) - 2+TX*XH2P(L,NY,NX) - XOH0B(L,NY,NX)=TI*XOH0B(L,NY,NX)+CORP*(FI*TXOH0B - 2-TI*XOH0B(L,NY,NX))+TX*XOH0B(L,NY,NX) - XOH1B(L,NY,NX)=TI*XOH1B(L,NY,NX)+CORP*(FI*TXOH1B - 2-TI*XOH1B(L,NY,NX))+TX*XOH1B(L,NY,NX) - XOH2B(L,NY,NX)=TI*XOH2B(L,NY,NX)+CORP*(FI*TXOH2B - 2-TI*XOH2B(L,NY,NX))+TX*XOH2B(L,NY,NX) - XH1PB(L,NY,NX)=TI*XH1PB(L,NY,NX)+CORP*(FI*TXH1PB - 2-TI*XH1PB(L,NY,NX))+TX*XH1PB(L,NY,NX) - XH2PB(L,NY,NX)=TI*XH2PB(L,NY,NX)+CORP*(FI*TXH2PB - 2-TI*XH2PB(L,NY,NX))+TX*XH2PB(L,NY,NX) - PALOH(L,NY,NX)=TI*PALOH(L,NY,NX)+CORP*(FI*TPALOH - 2-TI*PALOH(L,NY,NX))+TX*PALOH(L,NY,NX) - PFEOH(L,NY,NX)=TI*PFEOH(L,NY,NX)+CORP*(FI*TPFEOH - 2-TI*PFEOH(L,NY,NX))+TX*PFEOH(L,NY,NX) - PCACO(L,NY,NX)=TI*PCACO(L,NY,NX)+CORP*(FI*TPCACO - 2-TI*PCACO(L,NY,NX))+TX*PCACO(L,NY,NX) - PCASO(L,NY,NX)=TI*PCASO(L,NY,NX)+CORP*(FI*TPCASO - 2-TI*PCASO(L,NY,NX))+TX*PCASO(L,NY,NX) - PALPO(L,NY,NX)=TI*PALPO(L,NY,NX)+CORP*(FI*TPALPO - 2-TI*PALPO(L,NY,NX))+TX*PALPO(L,NY,NX) - PFEPO(L,NY,NX)=TI*PFEPO(L,NY,NX)+CORP*(FI*TPFEPO - 2-TI*PFEPO(L,NY,NX))+TX*PFEPO(L,NY,NX) - PCAPD(L,NY,NX)=TI*PCAPD(L,NY,NX)+CORP*(FI*TPCAPD - 2-TI*PCAPD(L,NY,NX))+TX*PCAPD(L,NY,NX) - PCAPH(L,NY,NX)=TI*PCAPH(L,NY,NX)+CORP*(FI*TPCAPH - 2-TI*PCAPH(L,NY,NX))+TX*PCAPH(L,NY,NX) - PCAPM(L,NY,NX)=TI*PCAPM(L,NY,NX)+CORP*(FI*TPCAPM - 2-TI*PCAPM(L,NY,NX))+TX*PCAPM(L,NY,NX) - PALPB(L,NY,NX)=TI*PALPB(L,NY,NX)+CORP*(FI*TPALPB - 2-TI*PALPB(L,NY,NX))+TX*PALPB(L,NY,NX) - PFEPB(L,NY,NX)=TI*PFEPB(L,NY,NX)+CORP*(FI*TPFEPB - 2-TI*PFEPB(L,NY,NX))+TX*PFEPB(L,NY,NX) - PCPDB(L,NY,NX)=TI*PCPDB(L,NY,NX)+CORP*(FI*TPCPDB - 2-TI*PCPDB(L,NY,NX))+TX*PCPDB(L,NY,NX) - PCPHB(L,NY,NX)=TI*PCPHB(L,NY,NX)+CORP*(FI*TPCPHB - 2-TI*PCPHB(L,NY,NX))+TX*PCPHB(L,NY,NX) - PCPMB(L,NY,NX)=TI*PCPMB(L,NY,NX)+CORP*(FI*TPCPMB - 2-TI*PCPMB(L,NY,NX))+TX*PCPMB(L,NY,NX) - CO2G(L,NY,NX)=TI*CO2G(L,NY,NX)+CORP*(FI*TCO2G-TI*CO2G(L,NY,NX)) - 2+TX*CO2G(L,NY,NX) - CH4G(L,NY,NX)=TI*CH4G(L,NY,NX)+CORP*(FI*TCH4G-TI*CH4G(L,NY,NX)) - 2+TX*CH4G(L,NY,NX) - CO2S(L,NY,NX)=TI*CO2S(L,NY,NX)+CORP*(FI*TCOZS-TI*CO2S(L,NY,NX)) - 2+TX*CO2S(L,NY,NX)+CORP*CO2SH(L,NY,NX) - CH4S(L,NY,NX)=TI*CH4S(L,NY,NX)+CORP*(FI*TCHFS-TI*CH4S(L,NY,NX)) - 2+TX*CH4S(L,NY,NX)+CORP*CH4SH(L,NY,NX) - OXYG(L,NY,NX)=TI*OXYG(L,NY,NX)+CORP*(FI*TOXYG-TI*OXYG(L,NY,NX)) - 2+TX*OXYG(L,NY,NX) - OXYS(L,NY,NX)=TI*OXYS(L,NY,NX)+CORP*(FI*TOXYS-TI*OXYS(L,NY,NX)) - 2+TX*OXYS(L,NY,NX)+CORP*OXYSH(L,NY,NX) - Z2GG(L,NY,NX)=TI*Z2GG(L,NY,NX)+CORP*(FI*TZ2GG-TI*Z2GG(L,NY,NX)) - 2+TX*Z2GG(L,NY,NX) - Z2GS(L,NY,NX)=TI*Z2GS(L,NY,NX)+CORP*(FI*TZ2GS-TI*Z2GS(L,NY,NX)) - 2+TX*Z2GS(L,NY,NX)+CORP*Z2GSH(L,NY,NX) - Z2OG(L,NY,NX)=TI*Z2OG(L,NY,NX)+CORP*(FI*TZ2OG-TI*Z2OG(L,NY,NX)) - 2+TX*Z2OG(L,NY,NX) - Z2OS(L,NY,NX)=TI*Z2OS(L,NY,NX)+CORP*(FI*TZ2OS-TI*Z2OS(L,NY,NX)) - 2+TX*Z2OS(L,NY,NX)+CORP*Z2OSH(L,NY,NX) - ZNH3G(L,NY,NX)=TI*ZNH3G(L,NY,NX)+CORP*(FI*TZNH3G - 2-TI*ZNH3G(L,NY,NX))+TX*ZNH3G(L,NY,NX) - H2GG(L,NY,NX)=TI*H2GG(L,NY,NX)+CORP*(FI*TH2GG-TI*H2GG(L,NY,NX)) - 2+TX*H2GG(L,NY,NX) - H2GS(L,NY,NX)=TI*H2GS(L,NY,NX)+CORP*(FI*TH2GS-TI*H2GS(L,NY,NX)) - 2+TX*H2GS(L,NY,NX)+CORP*H2GSH(L,NY,NX) - ZNH4SH(L,NY,NX)=XCORP(NY,NX)*ZNH4SH(L,NY,NX) - ZNH3SH(L,NY,NX)=XCORP(NY,NX)*ZNH3SH(L,NY,NX) - ZNO3SH(L,NY,NX)=XCORP(NY,NX)*ZNO3SH(L,NY,NX) - ZNO2SH(L,NY,NX)=XCORP(NY,NX)*ZNO2SH(L,NY,NX) - H2PO4H(L,NY,NX)=XCORP(NY,NX)*H2PO4H(L,NY,NX) - ZNH4BH(L,NY,NX)=XCORP(NY,NX)*ZNH4BH(L,NY,NX) - ZNH3BH(L,NY,NX)=XCORP(NY,NX)*ZNH3BH(L,NY,NX) - ZNO3BH(L,NY,NX)=XCORP(NY,NX)*ZNO3BH(L,NY,NX) - ZNO2BH(L,NY,NX)=XCORP(NY,NX)*ZNO2BH(L,NY,NX) - H2POBH(L,NY,NX)=XCORP(NY,NX)*H2POBH(L,NY,NX) - ZALH(L,NY,NX)=XCORP(NY,NX)*ZALH(L,NY,NX) - ZFEH(L,NY,NX)=XCORP(NY,NX)*ZFEH(L,NY,NX) - ZHYH(L,NY,NX)=XCORP(NY,NX)*ZHYH(L,NY,NX) - ZCCH(L,NY,NX)=XCORP(NY,NX)*ZCCH(L,NY,NX) - ZMAH(L,NY,NX)=XCORP(NY,NX)*ZMAH(L,NY,NX) - ZNAH(L,NY,NX)=XCORP(NY,NX)*ZNAH(L,NY,NX) - ZKAH(L,NY,NX)=XCORP(NY,NX)*ZKAH(L,NY,NX) - ZOHH(L,NY,NX)=XCORP(NY,NX)*ZOHH(L,NY,NX) - ZSO4H(L,NY,NX)=XCORP(NY,NX)*ZSO4H(L,NY,NX) - ZCLH(L,NY,NX)=XCORP(NY,NX)*ZCLH(L,NY,NX) - ZCO3H(L,NY,NX)=XCORP(NY,NX)*ZCO3H(L,NY,NX) - ZHCO3H(L,NY,NX)=XCORP(NY,NX)*ZHCO3H(L,NY,NX) - ZALO1H(L,NY,NX)=XCORP(NY,NX)*ZALO1H(L,NY,NX) - ZALO2H(L,NY,NX)=XCORP(NY,NX)*ZALO2H(L,NY,NX) - ZALO3H(L,NY,NX)=XCORP(NY,NX)*ZALO3H(L,NY,NX) - ZALO4H(L,NY,NX)=XCORP(NY,NX)*ZALO4H(L,NY,NX) - ZALSH(L,NY,NX)=XCORP(NY,NX)*ZALSH(L,NY,NX) - ZFEO1H(L,NY,NX)=XCORP(NY,NX)*ZFEO1H(L,NY,NX) - ZFEO2H(L,NY,NX)=XCORP(NY,NX)*ZFEO2H(L,NY,NX) - ZFEO3H(L,NY,NX)=XCORP(NY,NX)*ZFEO3H(L,NY,NX) - ZFEO4H(L,NY,NX)=XCORP(NY,NX)*ZFEO4H(L,NY,NX) - ZFESH(L,NY,NX)=XCORP(NY,NX)*ZFESH(L,NY,NX) - ZCAOH(L,NY,NX)=XCORP(NY,NX)*ZCAOH(L,NY,NX) - ZCACH(L,NY,NX)=XCORP(NY,NX)*ZCACH(L,NY,NX) - ZCAHH(L,NY,NX)=XCORP(NY,NX)*ZCAHH(L,NY,NX) - ZCASH(L,NY,NX)=XCORP(NY,NX)*ZCASH(L,NY,NX) - ZMGOH(L,NY,NX)=XCORP(NY,NX)*ZMGOH(L,NY,NX) - ZMGCH(L,NY,NX)=XCORP(NY,NX)*ZMGCH(L,NY,NX) - ZMGHH(L,NY,NX)=XCORP(NY,NX)*ZMGHH(L,NY,NX) - ZMGSH(L,NY,NX)=XCORP(NY,NX)*ZMGSH(L,NY,NX) - ZNACH(L,NY,NX)=XCORP(NY,NX)*ZNACH(L,NY,NX) - ZNASH(L,NY,NX)=XCORP(NY,NX)*ZNASH(L,NY,NX) - ZKASH(L,NY,NX)=XCORP(NY,NX)*ZKASH(L,NY,NX) - H0PO4H(L,NY,NX)=XCORP(NY,NX)*H0PO4H(L,NY,NX) - H1PO4H(L,NY,NX)=XCORP(NY,NX)*H1PO4H(L,NY,NX) - H3PO4H(L,NY,NX)=XCORP(NY,NX)*H3PO4H(L,NY,NX) - ZFE1PH(L,NY,NX)=XCORP(NY,NX)*ZFE1PH(L,NY,NX) - ZFE2PH(L,NY,NX)=XCORP(NY,NX)*ZFE2PH(L,NY,NX) - ZCA0PH(L,NY,NX)=XCORP(NY,NX)*ZCA0PH(L,NY,NX) - ZCA1PH(L,NY,NX)=XCORP(NY,NX)*ZCA1PH(L,NY,NX) - ZCA2PH(L,NY,NX)=XCORP(NY,NX)*ZCA2PH(L,NY,NX) - ZMG1PH(L,NY,NX)=XCORP(NY,NX)*ZMG1PH(L,NY,NX) - H0POBH(L,NY,NX)=XCORP(NY,NX)*H0POBH(L,NY,NX) - H1POBH(L,NY,NX)=XCORP(NY,NX)*H1POBH(L,NY,NX) - H3POBH(L,NY,NX)=XCORP(NY,NX)*H3POBH(L,NY,NX) - ZFE1BH(L,NY,NX)=XCORP(NY,NX)*ZFE1BH(L,NY,NX) - ZFE2BH(L,NY,NX)=XCORP(NY,NX)*ZFE2BH(L,NY,NX) - ZCA0BH(L,NY,NX)=XCORP(NY,NX)*ZCA0BH(L,NY,NX) - ZCA1BH(L,NY,NX)=XCORP(NY,NX)*ZCA1BH(L,NY,NX) - ZCA2BH(L,NY,NX)=XCORP(NY,NX)*ZCA2BH(L,NY,NX) - ZMG1BH(L,NY,NX)=XCORP(NY,NX)*ZMG1BH(L,NY,NX) - CO2SH(L,NY,NX)=XCORP(NY,NX)*CO2SH(L,NY,NX) - CH4SH(L,NY,NX)=XCORP(NY,NX)*CH4SH(L,NY,NX) - 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) - DO 5965 K=0,5 - DO 5965 N=1,7 - DO 5965 M=1,3 - OMC(M,N,K,L,NY,NX)=TI*OMC(M,N,K,L,NY,NX)+CORP*(FI*TOMC(M,N,K) - 2-TI*OMC(M,N,K,L,NY,NX))+TX*OMC(M,N,K,L,NY,NX) - OMN(M,N,K,L,NY,NX)=TI*OMN(M,N,K,L,NY,NX)+CORP*(FI*TOMN(M,N,K) - 2-TI*OMN(M,N,K,L,NY,NX))+TX*OMN(M,N,K,L,NY,NX) - OMP(M,N,K,L,NY,NX)=TI*OMP(M,N,K,L,NY,NX)+CORP*(FI*TOMP(M,N,K) - 2-TI*OMP(M,N,K,L,NY,NX))+TX*OMP(M,N,K,L,NY,NX) -5965 CONTINUE - DO 5980 K=0,4 - DO 5975 M=1,2 - ORC(M,K,L,NY,NX)=TI*ORC(M,K,L,NY,NX)+CORP*(FI*TORC(M,K) - 2-TI*ORC(M,K,L,NY,NX))+TX*ORC(M,K,L,NY,NX) - ORN(M,K,L,NY,NX)=TI*ORN(M,K,L,NY,NX)+CORP*(FI*TORN(M,K) - 2-TI*ORN(M,K,L,NY,NX))+TX*ORN(M,K,L,NY,NX) - ORP(M,K,L,NY,NX)=TI*ORP(M,K,L,NY,NX)+CORP*(FI*TORP(M,K) - 2-TI*ORP(M,K,L,NY,NX))+TX*ORP(M,K,L,NY,NX) -5975 CONTINUE - OQC(K,L,NY,NX)=TI*OQC(K,L,NY,NX)+CORP*(FI*TOQC(K) - 2-TI*OQC(K,L,NY,NX))+TX*OQC(K,L,NY,NX)+CORP*OQCH(K,L,NY,NX) - OQN(K,L,NY,NX)=TI*OQN(K,L,NY,NX)+CORP*(FI*TOQN(K) - 2-TI*OQN(K,L,NY,NX))+TX*OQN(K,L,NY,NX)+CORP*OQNH(K,L,NY,NX) - OQP(K,L,NY,NX)=TI*OQP(K,L,NY,NX)+CORP*(FI*TOQP(K) - 2-TI*OQP(K,L,NY,NX))+TX*OQP(K,L,NY,NX)+CORP*OQPH(K,L,NY,NX) - OQA(K,L,NY,NX)=TI*OQA(K,L,NY,NX)+CORP*(FI*TOQA(K) - 2-TI*OQA(K,L,NY,NX))+TX*OQA(K,L,NY,NX)+CORP*OQAH(K,L,NY,NX) - OQCH(K,L,NY,NX)=XCORP(NY,NX)*OQCH(K,L,NY,NX) - OQNH(K,L,NY,NX)=XCORP(NY,NX)*OQNH(K,L,NY,NX) - OQPH(K,L,NY,NX)=XCORP(NY,NX)*OQPH(K,L,NY,NX) - OQAH(K,L,NY,NX)=XCORP(NY,NX)*OQAH(K,L,NY,NX) - OHC(K,L,NY,NX)=TI*OHC(K,L,NY,NX)+CORP*(FI*TOHC(K) - 2-TI*OHC(K,L,NY,NX))+TX*OHC(K,L,NY,NX) - OHN(K,L,NY,NX)=TI*OHN(K,L,NY,NX)+CORP*(FI*TOHN(K) - 2-TI*OHN(K,L,NY,NX))+TX*OHN(K,L,NY,NX) - OHP(K,L,NY,NX)=TI*OHP(K,L,NY,NX)+CORP*(FI*TOHP(K) - 2-TI*OHP(K,L,NY,NX))+TX*OHP(K,L,NY,NX) - OHA(K,L,NY,NX)=TI*OHA(K,L,NY,NX)+CORP*(FI*TOHA(K) - 2-TI*OHA(K,L,NY,NX))+TX*OHA(K,L,NY,NX) - DO 5970 M=1,4 - OSC(M,K,L,NY,NX)=TI*OSC(M,K,L,NY,NX)+CORP*(FI*TOSC(M,K) - 2-TI*OSC(M,K,L,NY,NX))+TX*OSC(M,K,L,NY,NX) - OSA(M,K,L,NY,NX)=TI*OSA(M,K,L,NY,NX)+CORP*(FI*TOSA(M,K) - 2-TI*OSA(M,K,L,NY,NX))+TX*OSA(M,K,L,NY,NX) - OSN(M,K,L,NY,NX)=TI*OSN(M,K,L,NY,NX)+CORP*(FI*TOSN(M,K) - 2-TI*OSN(M,K,L,NY,NX))+TX*OSN(M,K,L,NY,NX) - OSP(M,K,L,NY,NX)=TI*OSP(M,K,L,NY,NX)+CORP*(FI*TOSP(M,K) - 2-TI*OSP(M,K,L,NY,NX))+TX*OSP(M,K,L,NY,NX) -5970 CONTINUE -5980 CONTINUE -C -C ADD STATE VARIABLES IN SURFACE RESIDUE INCORPORATED -C WITHIN TILLAGE MIXING ZONE -C - DO 5910 K=0,5 - IF(K.NE.3.AND.K.NE.4)THEN - DO 5915 N=1,7 - DO 5915 M=1,3 - OMC(M,N,K,L,NY,NX)=OMC(M,N,K,L,NY,NX)+FI*TOMGC(M,N,K) - OMN(M,N,K,L,NY,NX)=OMN(M,N,K,L,NY,NX)+FI*TOMGN(M,N,K) - OMP(M,N,K,L,NY,NX)=OMP(M,N,K,L,NY,NX)+FI*TOMGP(M,N,K) -5915 CONTINUE - ENDIF -5910 CONTINUE - DO 5920 K=0,2 - DO 5925 M=1,2 - ORC(M,K,L,NY,NX)=ORC(M,K,L,NY,NX)+FI*TORXC(M,K) - ORN(M,K,L,NY,NX)=ORN(M,K,L,NY,NX)+FI*TORXN(M,K) - ORP(M,K,L,NY,NX)=ORP(M,K,L,NY,NX)+FI*TORXP(M,K) -5925 CONTINUE - OQC(K,L,NY,NX)=OQC(K,L,NY,NX)+FI*TOQGC(K) - OQN(K,L,NY,NX)=OQN(K,L,NY,NX)+FI*TOQGN(K) - OQP(K,L,NY,NX)=OQP(K,L,NY,NX)+FI*TOQGP(K) - OQA(K,L,NY,NX)=OQA(K,L,NY,NX)+FI*TOQGA(K) - OQCH(K,L,NY,NX)=OQCH(K,L,NY,NX)+FI*TOQHC(K) - OQNH(K,L,NY,NX)=OQNH(K,L,NY,NX)+FI*TOQHN(K) - OQPH(K,L,NY,NX)=OQPH(K,L,NY,NX)+FI*TOQHP(K) - OQAH(K,L,NY,NX)=OQAH(K,L,NY,NX)+FI*TOQHA(K) - OHC(K,L,NY,NX)=OHC(K,L,NY,NX)+FI*TOHGC(K) - OHN(K,L,NY,NX)=OHN(K,L,NY,NX)+FI*TOHGN(K) - OHP(K,L,NY,NX)=OHP(K,L,NY,NX)+FI*TOHGP(K) - OHA(K,L,NY,NX)=OHA(K,L,NY,NX)+FI*TOHGA(K) - DO 5930 M=1,4 - OSC(M,K,L,NY,NX)=OSC(M,K,L,NY,NX)+FI*TOSGC(M,K) - OSA(M,K,L,NY,NX)=OSA(M,K,L,NY,NX)+FI*TOSGA(M,K) - OSN(M,K,L,NY,NX)=OSN(M,K,L,NY,NX)+FI*TOSGN(M,K) - OSP(M,K,L,NY,NX)=OSP(M,K,L,NY,NX)+FI*TOSGP(M,K) -5930 CONTINUE -5920 CONTINUE - OC=0.0 - ON=0.0 - OP=0.0 - RC=0.0 - DO 5985 K=0,5 - DO 5985 N=1,7 - DO 5985 M=1,3 - OC=OC+OMC(M,N,K,L,NY,NX) - ON=ON+OMN(M,N,K,L,NY,NX) - OP=OP+OMP(M,N,K,L,NY,NX) - IF(K.LE.2)THEN - RC=RC+OMC(M,N,K,L,NY,NX) - ENDIF -5985 CONTINUE - DO 6995 K=0,4 - DO 6985 M=1,2 - OC=OC+ORC(M,K,L,NY,NX) - ON=ON+ORN(M,K,L,NY,NX) - OP=OP+ORP(M,K,L,NY,NX) - IF(K.LE.2)THEN - RC=RC+ORC(M,K,L,NY,NX) - ENDIF -6985 CONTINUE - OC=OC+OQC(K,L,NY,NX)+OQCH(K,L,NY,NX)+OHC(K,L,NY,NX) - 2+OQA(K,L,NY,NX)+OQAH(K,L,NY,NX)+OHA(K,L,NY,NX) - ON=ON+OQN(K,L,NY,NX)+OQNH(K,L,NY,NX)+OHN(K,L,NY,NX) - OP=OP+OQP(K,L,NY,NX)+OQPH(K,L,NY,NX)+OHP(K,L,NY,NX) - IF(K.LE.2)THEN - RC=RC+OQC(K,L,NY,NX)+OQCH(K,L,NY,NX)+OHC(K,L,NY,NX) - 2+OQA(K,L,NY,NX)+OQAH(K,L,NY,NX)+OHA(K,L,NY,NX) - ENDIF - DO 6980 M=1,4 - OC=OC+OSC(M,K,L,NY,NX) - ON=ON+OSN(M,K,L,NY,NX) - OP=OP+OSP(M,K,L,NY,NX) - IF(K.LE.2)THEN - RC=RC+OSC(M,K,L,NY,NX) - ENDIF -6980 CONTINUE -6995 CONTINUE - ORGC(L,NY,NX)=OC - ORGN(L,NY,NX)=ON - ORGR(L,NY,NX)=RC - CO2S(L,NY,NX)=CO2S(L,NY,NX)+FI*TCO2GS - CH4S(L,NY,NX)=CH4S(L,NY,NX)+FI*TCH4GS - OXYS(L,NY,NX)=OXYS(L,NY,NX)+FI*TOXYGS - Z2GS(L,NY,NX)=Z2GS(L,NY,NX)+FI*TZ2GSG - Z2OS(L,NY,NX)=Z2OS(L,NY,NX)+FI*TZ2OGS - H2GS(L,NY,NX)=H2GS(L,NY,NX)+FI*TH2GGS - ZNH4S(L,NY,NX)=ZNH4S(L,NY,NX)+FI*TNH4GS - ZNH3S(L,NY,NX)=ZNH3S(L,NY,NX)+FI*TNH3GS - ZNO3S(L,NY,NX)=ZNO3S(L,NY,NX)+FI*TNO3GS - ZNO2S(L,NY,NX)=ZNO2S(L,NY,NX)+FI*TNO2GS - H2PO4(L,NY,NX)=H2PO4(L,NY,NX)+FI*TPO4GS - XN4(L,NY,NX)=XN4(L,NY,NX)+FI*TXN4G - XOH0(L,NY,NX)=XOH0(L,NY,NX)+FI*TXOH0G - XOH1(L,NY,NX)=XOH1(L,NY,NX)+FI*TXOH1G - XOH2(L,NY,NX)=XOH2(L,NY,NX)+FI*TXOH2G - XH1P(L,NY,NX)=XH1P(L,NY,NX)+FI*TXH1PG - XH2P(L,NY,NX)=XH2P(L,NY,NX)+FI*TXH2PG - PALPO(L,NY,NX)=PALPO(L,NY,NX)+FI*TALPOG - PFEPO(L,NY,NX)=PFEPO(L,NY,NX)+FI*TFEPOG - PCAPD(L,NY,NX)=PCAPD(L,NY,NX)+FI*TCAPDG - PCAPH(L,NY,NX)=PCAPH(L,NY,NX)+FI*TCAPHG - PCAPM(L,NY,NX)=PCAPM(L,NY,NX)+FI*TCAPMG - ZNH4FA(L,NY,NX)=ZNH4FA(L,NY,NX)+FI*TNH4FG - 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 - ZNFN0(L,NY,NX)=ZNFNX0 -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 - IFLGS(NY,NX)=1 - ENDIF -C -C CHECK MATERIAL BALANCES -C - IF(I.EQ.365.AND.J.EQ.24)THEN - WRITE(19,2221)'ORGC',I,J,IYRC,NX,NY - 2,(ORGC(L,NY,NX)/AREA(3,L,NY,NX),L=0,NL(NY,NX)) - WRITE(20,2221)'ORGN',I,J,IYRC,NX,NY - 2,(ORGN(L,NY,NX)/AREA(3,L,NY,NX),L=0,NL(NY,NX)) -2221 FORMAT(A8,5I4,21E12.4) - ENDIF -C IF(I.EQ.365.AND.J.EQ.24)THEN -C WRITE(20,2221)'OMCL',I,J,IYRC,NX,NY,(OMCL(L,NY,NX),L=0,NL(NY,NX)) -C WRITE(20,2221)'OMNL',I,J,IYRC,NX,NY,(OMNL(L,NY,NX),L=0,NL(NY,NX)) -C WRITE(20,2222)'TLC',I,J,IYRC,NX,NY,TLRSDC+TLORGC+TLCO2G-CO2GIN -C 2+TCOU-TORGF-XCSN,TLRSDC,TLORGC,TLCO2G,CO2GIN,TCOU,TORGF,XCSN -C 5,XCODFS(NY,NX),XCOFLG(3,NU(NY,NX),NY,NX),TCO2Z(NY,NX) -C 2,FLQGQ(NY,NX)*CCOR(NY,NX),FLQGI(NY,NX)*CCOQ(NY,NX),XCODFG(0,NY,NX) -C 3,XCODFR(NY,NX),XCHDFS(NY,NX),XCHFLG(3,NU(NY,NX),NY,NX) -C 2,FLQGQ(NY,NX)*CCHR(NY,NX),FLQGI(NY,NX)*CCHQ(NY,NX),XCHDFG(0,NY,NX) -C 3,XCHDFR(NY,NX),PRECU(NY,NX)*CCOQ(NY,NX),PRECU(NY,NX)*CCHQ(NY,NX) -C 6,TCOQRS(NY,NX),TCHQRS(NY,NX),XCOFLS(1,0,NY,NX+1) -C 7,XCOFLS(2,0,NY+1,NX) -C 3,UCOP(NY,NX),UDOCQ(NY,NX),UDICQ(NY,NX),UDOCD(NY,NX),UDICD(NY,NX) -C 2,(((CSNT(M,K,L,NY,NX),M=1,4),K=0,1),L=0,NJ(NY,NX)) -C 3,(TCO2P(L,NY,NX),L=1,NJ(NY,NX)),(TCO2S(L,NY,NX),L=1,NJ(NY,NX)) -C 4,CQ,ZCSNC(NY,NX) -C WRITE(20,2222)'TLW',I,J,IYRC,NX,NY,VOLWSO-CRAIN+CRUN+CEVAP+VOLWOU -C 2,VOLWSO,CRAIN,CRUN,CEVAP,VOLWOU,(TUPWTR(L,NY,NX),L=1,JZ) -C 3,TVOLWC(NY,NX),TVOLWP(NY,NX),VOLW(0,NY,NX),VOLI(0,NY,NX)*0.92 -C 4,TFLWC(NY,NX),TEVAPC(NY,NX),TEVAPG(NY,NX),TEVAPP(NY,NX) -C 5,VOLSS(NY,NX),VOLWS(NY,NX),VOLIS(NY,NX)*0.92,TQS(NY,NX) -C 6,TQW(NY,NX),TQI(NY,NX),TFLWS(NY,NX),TFLWW(NY,NX),TFLWI(NY,NX) -C 7,TVOLWC(NY,NX),TVOLWP(NY,NX) -C WRITE(19,2222)'TLH',I,J,IYRC,NX,NY,HEATSO-HEATIN+HEATOU -C 2,HEATSO,HEATIN,HEATOU,HTHAWR(NY,NX),HFLXD,4.19*TKA(NY,NX)*PRECA(NY,NX) -C 3+2.095*TKA(NY,NX)*PRECW(NY,NX),HEATH(NY,NX),HTHAWW(NY,NX) -C 4,THFLXC(NY,NX),(THTHAW(L,NY,NX),L=NU(NY,NX),NL(NY,NX)) -C 5,(VHCP(L,NY,NX)*TKS(L,NY,NX),L=NU(NY,NX),NL(NY,NX)) -C 5,4.19*TKA(NY,NX)*PRECU(NY,NX),TENGYC(NY,NX),ENGYR -C 6,VHCPW(NY,NX)*TKW(NY,NX),VHCPR(NY,NX)*TKS(0,NY,NX) -C WRITE(19,2222)'TLO',I,J,IYRC,NX,NY,OXYGSO-OXYGIN+OXYGOU,OXYGSO -C 2,OXYGIN,OXYGOU,XOXDFS(NY,NX),XOXFLG(3,NU(NY,NX),NY,NX) -C 3,XOXDFG(0,NY,NX),TOXYZ(NY,NX),FLQGQ(NY,NX)*COXR(NY,NX),FLQGI(NY,NX)*COXQ -C 2,PRECU(NY,NX)*COXQ,(RUPOXO(L,NY,NX),L=1,NJ(NY,NX)) -C 3,(TUPOXP(L,NY,NX),L=1,NJ(NY,NX)),(TOXFLA(L,NY,NX),L=1,NJ(NY,NX)) -C WRITE(20,2222)'TLN',I,J,IYRC,NX,NY,TLRSDN+TLORGN+TLN2G+TLNH4 -C 2+TLNO3-ZN2GIN-TZIN+TZOU-TORGN-XZSN,TLRSDN,TLORGN,TLN2G,TLNH4 -C 3,TLNO3,ZN2GIN,TZIN,TZOU,TORGN,XZSN,PRECQ(NY,NX),PRECR(NY,NX) -C 4,PRECW(NY,NX),PRECI(NY,NX),FLQGM(NY,NX),FLQRM(NY,NX) -C 4,(((ZSNT(M,K,L,NY,NX),M=1,4),K=0,1),L=0,JZ) -C 5,(TUPNH4(L,NY,NX),L=1,JZ) -C 6,(TUPNO3(L,NY,NX),L=1,JZ),(TNHFLA(L,NY,NX),L=1,JZ) -C 7,XN3DFS(NY,NX),XNBDFS(NY,NX) -C 8,XN3FLG(3,NU(NY,NX),NY,NX),TNH3Z(NY,NX),UN2GS(NY,NX) -C 9,(XN2GS(L,NY,NX),L=0,JZ) -C WRITE(*,2222)'TLI',I,J,IYRC,NX,NY,TION-TIONIN+TIONOU -C 2-TFERTN-TFERTP,TION,TIONIN,TIONOU,SG,TFERTN,TFERTP -C 3,PRECQ(NY,NX),XHGDFS(NY,NX),XHGFLG(3,NU(NY,NX),NY,NX),TH2GZ(NY,NX) -C 4,(XHGQRS(N,NY,NX),N=1,2),(RH2GO(L,NY,NX),L=1,JZ) -C 5,(THGFLA(L,NY,NX),L=1,JZ),H2GW(NY,NX),(H2GS(L,NY,NX),L=1,JZ) -C 6,(H2GG(L,NY,NX),L=1,JZ),(TLH2GP(L,NY,NX),L=1,JZ) -C WRITE(*,2223)'TLS',I,J,IYRC,NX,NY,NU(NY,NX),TSEDSO+TSEDOU -C 2,TSEDSO,TSEDOU,USEDOU(NY,NX),DLYR(3,NU(NY,NX),NY,NX) -C 3,BKVL(NU(NY,NX),NY,NX),SAND(NU(NY,NX),NY,NX),SILT(NU(NY,NX),NY,NX) -C 4,CLAY(NU(NY,NX),NY,NX),ORGC(NU(NY,NX),NY,NX) -2222 FORMAT(A8,5I6,240F20.6) -2223 FORMAT(A8,6I6,160F16.6) -C ENDIF -9990 CONTINUE -9995 CONTINUE - RETURN - END - + + SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) +C +C THIS SUBROUTINE UPDATES SOIL STATE VARIABLES WITH WATER, HEAT, +C C, N, P, SOLUTE FLUXES CALCULATED IN EARLIER SUBROUTINES +C + include "parameters.h" + include "blkc.h" + include "blk2a.h" + include "blk2b.h" + include "blk2c.h" + include "blk5.h" + include "blk8a.h" + include "blk8b.h" + include "blk11a.h" + include "blk11b.h" + include "blk13a.h" + include "blk13b.h" + include "blk13c.h" + include "blk15a.h" + include "blk15b.h" + include "blk16.h" + include "blk18a.h" + include "blk18b.h" + include "blk19a.h" + include "blk19b.h" + include "blk19c.h" + include "blk19d.h" + include "blk20a.h" + include "blk20b.h" + include "blk20c.h" + include "blk20d.h" + include "blk20e.h" + include "blk20f.h" + include "blk21a.h" + include "blk21b.h" + include "blk22a.h" + include "blk22b.h" + include "blk22c.h" + include "blktest.h" + DIMENSION TFLW(JZ,JY,JX),TFLWX(JZ,JY,JX),THFLW(JZ,JY,JX) + 1,TFLWH(JZ,JY,JX),TOCFLS(0:4,JZ,JY,JX),TONFLS(0:4,JZ,JY,JX) + 2,TOPFLS(0:4,JZ,JY,JX),TOAFLS(0:4,JZ,JY,JX),TCOFLS(JZ,JY,JX) + 3,TCHFLS(JZ,JY,JX),TOXFLS(JZ,JY,JX),TNXFLB(JZ,JY,JX) + 4,TNGFLS(JZ,JY,JX),TN2FLS(JZ,JY,JX),TN4FLS(JZ,JY,JX) + 5,TN4FLB(JZ,JY,JX),TN3FLS(JZ,JY,JX),TN3FLB(JZ,JY,JX) + 6,TNOFLS(JZ,JY,JX),TNOFLB(JZ,JY,JX),TPOFLS(JZ,JY,JX) + 7,TH2BFB(JZ,JY,JX),TNXFLS(JZ,JY,JX),TOCFHS(0:4,JZ,JY,JX) + 8,TONFHS(0:4,JZ,JY,JX),TOPFHS(0:4,JZ,JY,JX),TOAFHS(0:4,JZ,JY,JX) + 9,TCOFHS(JZ,JY,JX),TCHFHS(JZ,JY,JX),TNXFHB(JZ,JY,JX) + 2,TOXFHS(JZ,JY,JX),TNGFHS(JZ,JY,JX),TN2FHS(JZ,JY,JX) + 2,TN4FHS(JZ,JY,JX),TN4FHB(JZ,JY,JX),TN3FHS(JZ,JY,JX) + 3,TN3FHB(JZ,JY,JX),TNOFHS(JZ,JY,JX),TNOFHB(JZ,JY,JX) + 4,TPOFHS(JZ,JY,JX),TH2BHB(JZ,JY,JX),TNXFHS(JZ,JY,JX) + 5,TCOFLG(JZ,JY,JX),TCHFLG(JZ,JY,JX),TOXFLG(JZ,JY,JX) + 6,TNGFLG(JZ,JY,JX),TN2FLG(JZ,JY,JX),TNHFLG(JZ,JY,JX) + 7,TTHAW(JZ,JY,JX),THTHAW(JZ,JY,JX),TTHAWH(JZ,JY,JX) + DIMENSION TQR(JY,JX),THQR(JY,JX),TQS(JY,JX) + 2,TQW(JY,JX),TQI(JY,JX),THQS(JY,JX),TOCQRS(0:4,JY,JX) + 1,TONQRS(0:4,JY,JX),TOPQRS(0:4,JY,JX),TOAQRS(0:4,JY,JX) + 2,TCOQRS(JY,JX),TCHQRS(JY,JX),TOXQRS(JY,JX) + 3,TNGQRS(JY,JX),TN2QRS(JY,JX),TN4QRS(JY,JX),TN3QRS(JY,JX) + 4,TNOQRS(JY,JX),TPOQRS(JY,JX),TNXQRS(JY,JX),TQRAL(JY,JX) + 6,TQRFE(JY,JX),TQRHY(JY,JX),TQRCA(JY,JX),TQRMG(JY,JX) + 7,TQRNA(JY,JX),TQRKA(JY,JX),TQROH(JY,JX),TQRSO(JY,JX) + 8,TQRCL(JY,JX),TQRC3(JY,JX),TQRHC(JY,JX),TQRAL1(JY,JX) + 9,TQRAL2(JY,JX),TQRAL3(JY,JX),TQRAL4(JY,JX),TQRALS(JY,JX) + 1,TQRFE1(JY,JX),TQRFE2(JY,JX),TQRFE3(JY,JX),TQRFE4(JY,JX) + 2,TQRFES(JY,JX),TQRCAO(JY,JX),TQRCAC(JY,JX),TQRCAH(JY,JX) + 3,TQRCAS(JY,JX),TQRMGO(JY,JX),TQRMGC(JY,JX),TQRMGH(JY,JX) + 4,TQRMGS(JY,JX),TQRNAC(JY,JX),TQRNAS(JY,JX),TQRKAS(JY,JX) + 5,TQRH0P(JY,JX),TQRH1P(JY,JX),TQRH3P(JY,JX),TQRF1P(JY,JX) + 6,TQRF2P(JY,JX),TQRC0P(JY,JX),TQRC1P(JY,JX),TQRC2P(JY,JX) + 7,TQRM1P(JY,JX),TCOQSS(JY,JX),TCHQSS(JY,JX),TOXQSS(JY,JX) + 3,TNGQSS(JY,JX),TN2QSS(JY,JX),TN4QSS(JY,JX),TN3QSS(JY,JX) + 4,TNOQSS(JY,JX),TPOQSS(JY,JX),TQSAL(JY,JX) + 6,TQSFE(JY,JX),TQSHY(JY,JX),TQSCA(JY,JX),TQSMG(JY,JX) + 7,TQSNA(JY,JX),TQSKA(JY,JX),TQSOH(JY,JX),TQSSO(JY,JX) + 8,TQSCL(JY,JX),TQSC3(JY,JX),TQSHC(JY,JX),TQSAL1(JY,JX) + 9,TQSAL2(JY,JX),TQSAL3(JY,JX),TQSAL4(JY,JX),TQSALS(JY,JX) + 1,TQSFE1(JY,JX),TQSFE2(JY,JX),TQSFE3(JY,JX),TQSFE4(JY,JX) + 2,TQSFES(JY,JX),TQSCAO(JY,JX),TQSCAC(JY,JX),TQSCAH(JY,JX) + 3,TQSCAS(JY,JX),TQSMGO(JY,JX),TQSMGC(JY,JX),TQSMGH(JY,JX) + 4,TQSMGS(JY,JX),TQSNAC(JY,JX),TQSNAS(JY,JX),TQSKAS(JY,JX) + 5,TQSH0P(JY,JX),TQSH1P(JY,JX),TQSH3P(JY,JX),TQSF1P(JY,JX) + 6,TQSF2P(JY,JX),TQSC0P(JY,JX),TQSC1P(JY,JX),TQSC2P(JY,JX) + 7,TQSM1P(JY,JX) + DIMENSION TALFLS(JZ,JY,JX),TFEFLS(JZ,JY,JX) + 1,TCAFLS(JZ,JY,JX),THYFLS(JZ,JY,JX),TMGFLS(JZ,JY,JX) + 2,TNAFLS(JZ,JY,JX),TKAFLS(JZ,JY,JX),TOHFLS(JZ,JY,JX) + 3,TSOFLS(JZ,JY,JX),TCLFLS(JZ,JY,JX),TC3FLS(JZ,JY,JX) + 4,THCFLS(JZ,JY,JX),TAL1FS(JZ,JY,JX),TAL2FS(JZ,JY,JX) + 5,TAL3FS(JZ,JY,JX),TAL4FS(JZ,JY,JX),TALSFS(JZ,JY,JX) + 6,TFE1FS(JZ,JY,JX),TFE2FS(JZ,JY,JX) + 7,TFE3FS(JZ,JY,JX),TFE4FS(JZ,JY,JX),TFESFS(JZ,JY,JX) + 8,TCAOFS(JZ,JY,JX),TCACFS(JZ,JY,JX),TCAHFS(JZ,JY,JX) + 9,TCASFS(JZ,JY,JX),TMGOFS(JZ,JY,JX),TMGCFS(JZ,JY,JX) + 1,TMGHFS(JZ,JY,JX),TMGSFS(JZ,JY,JX),TNACFS(JZ,JY,JX) + 2,TNASFS(JZ,JY,JX),TKASFS(JZ,JY,JX),TH0PFS(JZ,JY,JX) + 3,TH1PFS(JZ,JY,JX),TH3PFS(JZ,JY,JX),TF1PFS(JZ,JY,JX) + 4,TF2PFS(JZ,JY,JX),TC0PFS(JZ,JY,JX),TC1PFS(JZ,JY,JX) + 5,TC2PFS(JZ,JY,JX),TM1PFS(JZ,JY,JX),TH0BFB(JZ,JY,JX) + 6,TH1BFB(JZ,JY,JX),TH3BFB(JZ,JY,JX),TF1BFB(JZ,JY,JX) + 7,TF2BFB(JZ,JY,JX),TC0BFB(JZ,JY,JX),TC1BFB(JZ,JY,JX) + 8,TC2BFB(JZ,JY,JX),TM1BFB(JZ,JY,JX) + DIMENSION TALFHS(JZ,JY,JX),TFEFHS(JZ,JY,JX) + 1,THYFHS(JZ,JY,JX),TCAFHS(JZ,JY,JX),TMGFHS(JZ,JY,JX) + 2,TNAFHS(JZ,JY,JX),TKAFHS(JZ,JY,JX),TOHFHS(JZ,JY,JX) + 3,TSOFHS(JZ,JY,JX),TCLFHS(JZ,JY,JX),TC3FHS(JZ,JY,JX) + 4,THCFHS(JZ,JY,JX),TAL1HS(JZ,JY,JX),TAL2HS(JZ,JY,JX) + 5,TAL3HS(JZ,JY,JX),TAL4HS(JZ,JY,JX),TALSHS(JZ,JY,JX) + 6,TFE1HS(JZ,JY,JX),TFE2HS(JZ,JY,JX) + 7,TFE3HS(JZ,JY,JX),TFE4HS(JZ,JY,JX),TFESHS(JZ,JY,JX) + 8,TCAOHS(JZ,JY,JX),TCACHS(JZ,JY,JX),TCAHHS(JZ,JY,JX) + 9,TCASHS(JZ,JY,JX),TMGOHS(JZ,JY,JX),TMGCHS(JZ,JY,JX) + 1,TMGHHS(JZ,JY,JX),TMGSHS(JZ,JY,JX),TNACHS(JZ,JY,JX) + 2,TNASHS(JZ,JY,JX),TKASHS(JZ,JY,JX),TH0PHS(JZ,JY,JX) + 3,TH1PHS(JZ,JY,JX),TH3PHS(JZ,JY,JX),TF1PHS(JZ,JY,JX) + 4,TF2PHS(JZ,JY,JX),TC0PHS(JZ,JY,JX),TC1PHS(JZ,JY,JX) + 5,TC2PHS(JZ,JY,JX),TM1PHS(JZ,JY,JX),TH0BHB(JZ,JY,JX) + 6,TH1BHB(JZ,JY,JX),TH3BHB(JZ,JY,JX),TF1BHB(JZ,JY,JX) + 7,TF2BHB(JZ,JY,JX),TC0BHB(JZ,JY,JX),TC1BHB(JZ,JY,JX) + 8,TC2BHB(JZ,JY,JX),TM1BHB(JZ,JY,JX) + DIMENSION TSANER(JY,JX),TSILER(JY,JX),TCLAER(JY,JX) + 2,TCECER(JY,JX),TAECER(JY,JX),TNH4ER(JY,JX),TNH3ER(JY,JX) + 3,TNHUER(JY,JX),TNO3ER(JY,JX),TNH4EB(JY,JX),TNH3EB(JY,JX) + 4,TNHUEB(JY,JX),TNO3EB(JY,JX),TN4ER(JY,JX),TNBER(JY,JX) + 5,THYER(JY,JX),TALER(JY,JX),TCAER(JY,JX),TMGER(JY,JX) + 6,TNAER(JY,JX),TKAER(JY,JX),THCER(JY,JX),TAL2ER(JY,JX) + 7,TOH0ER(JY,JX),TOH1ER(JY,JX),TOH2ER(JY,JX),TH1PER(JY,JX) + 8,TH2PER(JY,JX),TOH0EB(JY,JX),TOH1EB(JY,JX),TOH2EB(JY,JX) + 9,TH1PEB(JY,JX),TH2PEB(JY,JX),TALOER(JY,JX),TFEOER(JY,JX) + 1,TCACER(JY,JX),TCASER(JY,JX),TALPER(JY,JX),TFEPER(JY,JX) + 2,TCPDER(JY,JX),TCPHER(JY,JX),TCPMER(JY,JX),TALPEB(JY,JX) + 3,TFEPEB(JY,JX),TCPDEB(JY,JX),TCPHEB(JY,JX),TCPMEB(JY,JX) + 4,TOMCER(3,7,0:5,JY,JX),TOMNER(3,7,0:5,JY,JX),TOMPER(3,7,0:5,JY,JX) + 5,TORCER(2,0:4,JY,JX),TORNER(2,0:4,JY,JX),TORPER(2,0:4,JY,JX) + 6,TOHCER(0:4,JY,JX),TOHNER(0:4,JY,JX),TOHPER(0:4,JY,JX) + 7,TOHAER(0:4,JY,JX),TOSCER(4,0:4,JY,JX),TOSAER(4,0:4,JY,JX) + 8,TOSNER(4,0:4,JY,JX),TOSPER(4,0:4,JY,JX),TSEDER(JY,JX) + DIMENSION TOMC(3,7,0:5),TOMN(3,7,0:5),TOMP(3,7,0:5),TORC(2,0:4) + 2,TORN(2,0:4),TORP(2,0:4),TOQC(0:4),TOQN(0:4),TOQP(0:4),TOQA(0:4) + 3,TOHC(0:4),TOHN(0:4),TOHP(0:4),TOHA(0:4),TOSC(4,0:4),TOSA(4,0:4) + 4,TOSN(4,0:4),TOSP(4,0:4),TOSGC(4,0:2),TOSGA(4,0:2),TOSGN(4,0:2) + 5,TOSGP(4,0:2),TOMGC(3,7,0:5),TOMGN(3,7,0:5),TOMGP(3,7,0:5) + 6,TORXC(2,0:2),TORXN(2,0:2),TORXP(2,0:2),TOQGC(0:2),TOQGN(0:2) + 7,TOQGP(0:2),TOQHC(0:2),TOQHN(0:2),TOQHP(0:2),TOHGC(0:2) + 8,TOHGN(0:2),TOHGP(0:2), TOHGA(0:2),TOQGA(0:2),TOQHA(0:2) + 9,THGQRS(JY,JX),THGFHS(JZ,JY,JX),THGFLG(JZ,JY,JX),THGFLS(JZ,JY,JX) + 1,OMCL(0:JZ,JY,JX),OMNL(0:JZ,JY,JX),EFIRE(2,21:22) + 2,ONL(4,0:4),OPL(4,0:4) + PARAMETER (DNUMN=0.001,DNUMX=0.025) + DATA SG/0.0/ + DATA EFIRE/1.0,1.0,0.917,0.167/ + TFLWT=0.0 + VOLPT=0.0 + VOLTT=0.0 + DO 9995 NX=NHW,NHE + DO 9990 NY=NVN,NVS + TNPP(NY,NX)=TGPP(NY,NX)+TRAU(NY,NX) +C +C ADD WATER, HEAT FLUXES FROM 'WATSUB' AND GAS, SOLUTE FLUXES +C FROM 'TRNSFR' AND 'TRNSFRS' TO SNOWPACK +C + IF(PRECW(NY,NX).GT.0.0.OR.FLQGM(NY,NX).GT.0.0.OR. + 2(PRECR(NY,NX).GT.0.0.AND.VHCPW(NY,NX).GT.VHCPWX(NY,NX)))THEN + CO2W(NY,NX)=CO2W(NY,NX)+XCOBLS(NY,NX) + CH4W(NY,NX)=CH4W(NY,NX)+XCHBLS(NY,NX) + OXYW(NY,NX)=OXYW(NY,NX)+XOXBLS(NY,NX) + ZNGW(NY,NX)=ZNGW(NY,NX)+XNGBLS(NY,NX) + ZN2W(NY,NX)=ZN2W(NY,NX)+XN2BLS(NY,NX) + H2GW(NY,NX)=H2GW(NY,NX)+XHGBLS(NY,NX) + ZN4W(NY,NX)=ZN4W(NY,NX)+XN4BLW(NY,NX) + ZN3W(NY,NX)=ZN3W(NY,NX)+XN3BLW(NY,NX) + ZNOW(NY,NX)=ZNOW(NY,NX)+XNOBLW(NY,NX) + ZHPW(NY,NX)=ZHPW(NY,NX)+XH2PBS(NY,NX) + IF(ISALT(NY,NX).NE.0)THEN + ZALW(NY,NX)=ZALW(NY,NX)+XALBLS(NY,NX) + ZFEW(NY,NX)=ZFEW(NY,NX)+XFEBLS(NY,NX) + ZHYW(NY,NX)=ZHYW(NY,NX)+XHYBLS(NY,NX) + ZCAW(NY,NX)=ZCAW(NY,NX)+XCABLS(NY,NX) + ZMGW(NY,NX)=ZMGW(NY,NX)+XMGBLS(NY,NX) + ZNAW(NY,NX)=ZNAW(NY,NX)+XNABLS(NY,NX) + ZKAW(NY,NX)=ZKAW(NY,NX)+XKABLS(NY,NX) + ZOHW(NY,NX)=ZOHW(NY,NX)+XOHBLS(NY,NX) + ZSO4W(NY,NX)=ZSO4W(NY,NX)+XSOBLS(NY,NX) + ZCLW(NY,NX)=ZCLW(NY,NX)+XCLBLS(NY,NX) + ZCO3W(NY,NX)=ZCO3W(NY,NX)+XC3BLS(NY,NX) + ZHCO3W(NY,NX)=ZHCO3W(NY,NX)+XHCBLS(NY,NX) + ZALH1W(NY,NX)=ZALH1W(NY,NX)+XAL1BS(NY,NX) + ZALH2W(NY,NX)=ZALH2W(NY,NX)+XAL2BS(NY,NX) + ZALH3W(NY,NX)=ZALH3W(NY,NX)+XAL3BS(NY,NX) + ZALH4W(NY,NX)=ZALH4W(NY,NX)+XAL4BS(NY,NX) + ZALSW(NY,NX)=ZALSW(NY,NX)+XALSBS(NY,NX) + ZFEH1W(NY,NX)=ZFEH1W(NY,NX)+XFE1BS(NY,NX) + ZFEH2W(NY,NX)=ZFEH2W(NY,NX)+XFE2BS(NY,NX) + ZFEH3W(NY,NX)=ZFEH3W(NY,NX)+XFE3BS(NY,NX) + ZFEH4W(NY,NX)=ZFEH4W(NY,NX)+XFE4BS(NY,NX) + ZFESW(NY,NX)=ZFESW(NY,NX)+XFESBS(NY,NX) + ZCAOW(NY,NX)=ZCAOW(NY,NX)+XCAOBS(NY,NX) + ZCACW(NY,NX)=ZCACW(NY,NX)+XCACBS(NY,NX) + ZCAHW(NY,NX)=ZCAHW(NY,NX)+XCAHBS(NY,NX) + ZCASW(NY,NX)=ZCASW(NY,NX)+XCASBS(NY,NX) + ZMGOW(NY,NX)=ZMGOW(NY,NX)+XMGOBS(NY,NX) + ZMGCW(NY,NX)=ZMGCW(NY,NX)+XMGCBS(NY,NX) + ZMGHW(NY,NX)=ZMGHW(NY,NX)+XMGHBS(NY,NX) + ZMGSW(NY,NX)=ZMGSW(NY,NX)+XMGSBS(NY,NX) + ZNACW(NY,NX)=ZNACW(NY,NX)+XNACBS(NY,NX) + ZNASW(NY,NX)=ZNASW(NY,NX)+XNASBS(NY,NX) + ZKASW(NY,NX)=ZKASW(NY,NX)+XKASBS(NY,NX) + H0PO4W(NY,NX)=H0PO4W(NY,NX)+XH0PBS(NY,NX) + H1PO4W(NY,NX)=H1PO4W(NY,NX)+XH1PBS(NY,NX) + H3PO4W(NY,NX)=H3PO4W(NY,NX)+XH3PBS(NY,NX) + ZFE1PW(NY,NX)=ZFE1PW(NY,NX)+XF1PBS(NY,NX) + ZFE2PW(NY,NX)=ZFE2PW(NY,NX)+XF2PBS(NY,NX) + ZCA0PW(NY,NX)=ZCA0PW(NY,NX)+XC0PBS(NY,NX) + ZCA1PW(NY,NX)=ZCA1PW(NY,NX)+XC1PBS(NY,NX) + ZCA2PW(NY,NX)=ZCA2PW(NY,NX)+XC2PBS(NY,NX) + ZMG1PW(NY,NX)=ZMG1PW(NY,NX)+XM1PBS(NY,NX) + ENDIF + ENDIF +C +C CALCULATE SNOWPACK TEMPERATURE FROM ITS CHANGE +C IN HEAT STORAGE +C + VHCPW(NY,NX)=2.095*VOLSS(NY,NX)+4.19*VOLWS(NY,NX) + 2+1.9274*VOLIS(NY,NX) +C VHCPX=VHCPW(NY,NX) + VOLSS(NY,NX)=VOLSS(NY,NX)+TFLWS(NY,NX)+TQS(NY,NX) + VOLWS(NY,NX)=VOLWS(NY,NX)+TFLWW(NY,NX)+TQW(NY,NX) + VOLIS(NY,NX)=VOLIS(NY,NX)+TFLWI(NY,NX)+TQI(NY,NX) + DENSS=AMIN1(0.6,DENS0(NY,NX)+DENS1(NY,NX)*VOLSS(NY,NX) + 2/AREA(3,NU(NY,NX),NY,NX)) + VOLS(NY,NX)=VOLSS(NY,NX)/DENSS+VOLWS(NY,NX)+VOLIS(NY,NX) + ENGYW=VHCPW(NY,NX)*TKW(NY,NX) + VHCPW(NY,NX)=2.095*VOLSS(NY,NX)+4.19*VOLWS(NY,NX) + 2+1.9274*VOLIS(NY,NX) + DPTHS(NY,NX)=AMAX1(0.0,VOLS(NY,NX))/AREA(3,NU(NY,NX),NY,NX) + IF(VHCPW(NY,NX).GT.VHCPWX(NY,NX))THEN + TKW(NY,NX)=(ENGYW+THFLWW(NY,NX)+THQS(NY,NX))/VHCPW(NY,NX) + ELSEIF(VHCPW(NY,NX).GT.ZEROS(NY,NX))THEN + TKWX=(ENGYW+THFLWW(NY,NX)+THQS(NY,NX))/VHCPW(NY,NX) + HFLXW=VHCPW(NY,NX)*(TKWX-TKA(NY,NX)) + HEATOU=HEATOU+HFLXW + TKW(NY,NX)=TKA(NY,NX) + ELSE + TKW(NY,NX)=TKA(NY,NX) + ENDIF + TCW(NY,NX)=TKW(NY,NX)-273.15 +C IF(NX.EQ.2.AND.NY.EQ.2)THEN +C WRITE(*,8483)'TKWH',I,J,NX,NY,TKW(NY,NX),ENGYW,THFLWW(NY,NX) +C 2,THQS(NY,NX),VHCPW(NY,NX),VHCPX,VOLSS(NY,NX),VOLWS(NY,NX) +C 2,VOLIS(NY,NX),TFLWS(NY,NX),TQS(NY,NX),TFLWW(NY,NX),TQW(NY,NX) +C 3,TFLWI(NY,NX),TQI(NY,NX),VOLS(NY,NX) +8483 FORMAT(A8,4I4,20E12.4) +C ENDIF +C +C SNOWPACK VARIABLES NEEDED FOR WATER, C, N, P, O, SOLUTE AND +C ENERGY BALANCES INCLUDING SUM OF ALL CURRENT STATE VARIABLES, +C CUMULATIVE SUMS OF ALL ADDITIONS AND REMOVALS SINCE START OF RUN +C +C IF(J.EQ.24)THEN + WS=VOLSS(NY,NX)+VOLWS(NY,NX)+VOLIS(NY,NX)*0.92 + VOLWSO=VOLWSO+WS + UVOLW(NY,NX)=UVOLW(NY,NX)+WS + HEATSO=HEATSO+VHCPW(NY,NX)*TKW(NY,NX) + TLCO2G=TLCO2G+CO2W(NY,NX)+CH4W(NY,NX) + UCO2S(NY,NX)=UCO2S(NY,NX)+CO2W(NY,NX)+CH4W(NY,NX) + OXYGSO=OXYGSO+OXYW(NY,NX) + TLN2G=TLN2G+ZNGW(NY,NX)+ZN2W(NY,NX) + TLNH4=TLNH4+ZN4W(NY,NX)+ZN3W(NY,NX) + TLNO3=TLNO3+ZNOW(NY,NX) + TLPO4=TLPO4+ZHPW(NY,NX) + TW=ZALW(NY,NX)+ZFEW(NY,NX)+ZHYW(NY,NX)+ZCAW(NY,NX) + 2+ZMGW(NY,NX)+ZNAW(NY,NX)+ZKAW(NY,NX)+ZOHW(NY,NX) + 3+ZSO4W(NY,NX)+ZCLW(NY,NX)+ZCO3W(NY,NX)+H0PO4W(NY,NX) + 4+2.0*(ZHCO3W(NY,NX)+ZALH1W(NY,NX) + 5+ZALSW(NY,NX)+ZFEH1W(NY,NX)+ZFESW(NY,NX)+ZCAOW(NY,NX) + 6+ZCACW(NY,NX)+ZCASW(NY,NX)+ZMGOW(NY,NX)+ZMGCW(NY,NX) + 7+ZMGSW(NY,NX)+ZNACW(NY,NX)+ZNASW(NY,NX)+ZKASW(NY,NX) + 8+H1PO4W(NY,NX)+ZCA0PW(NY,NX)) + 9+3.0*(ZALH2W(NY,NX)+ZFEH2W(NY,NX)+ZCAHW(NY,NX) + 1+ZMGHW(NY,NX)+ZFE1PW(NY,NX)+ZCA1PW(NY,NX)+ZMG1PW(NY,NX)) + 2+4.0*(ZALH3W(NY,NX)+ZFEH3W(NY,NX)+H3PO4W(NY,NX)+ZFE2PW(NY,NX) + 4+ZCA2PW(NY,NX))+5.0*(ZALH4W(NY,NX)+ZFEH4W(NY,NX))+H2GW(NY,NX) + TION=TION+TW +C ENDIF +C +C ADD ABOVE-GROUND LITTERFALL FROM 'EXTRACT' TO SURFACE RESIDUE +C + OSGX=ORGC(0,NY,NX) +C +C ADD PLANT C,N,P IN ABOVE-GROUND LITTERFALL TO C,N,P +C IN SURFACE RESIDUE +C + DO 6965 K=0,1 + DO 6965 M=1,4 + OSC(M,K,0,NY,NX)=OSC(M,K,0,NY,NX)+CSNT(M,K,0,NY,NX) + OSN(M,K,0,NY,NX)=OSN(M,K,0,NY,NX)+ZSNT(M,K,0,NY,NX) + OSP(M,K,0,NY,NX)=OSP(M,K,0,NY,NX)+PSNT(M,K,0,NY,NX) +C IF((I/30)*30.EQ.I.AND.J.EQ.15)THEN +C WRITE(*,8486)'OSC0',I,J,L,K,M,OSC(M,K,0,NY,NX) +C 2,OSN(M,K,0,NY,NX),OSP(M,K,0,NY,NX),CSNT(M,K,0,NY,NX) +C 3,ZSNT(M,K,0,NY,NX),PSNT(M,K,0,NY,NX) +8486 FORMAT(A8,5I4,12E12.4) +C ENDIF +6965 CONTINUE +C +C GAS AND SOLUTE EXCHANGE WITHIN SURFACE RESIDUE ADDED TO ECOSYSTEM +C TOTALS FOR CALCULATING COMPETITION CONSTRAINTS ON MICROBIAL +C AND ROOT POPULATIONS +C + DO 8990 K=0,5 + IF(K.NE.3.AND.K.NE.4)THEN + DO 8980 N=1,7 + ROXYX(0,NY,NX)=ROXYX(0,NY,NX)+ROXYS(N,K,0,NY,NX) + RNH4X(0,NY,NX)=RNH4X(0,NY,NX)+RVMX4(N,K,0,NY,NX) + RNO3X(0,NY,NX)=RNO3X(0,NY,NX)+RVMX3(N,K,0,NY,NX) + RNO2X(0,NY,NX)=RNO2X(0,NY,NX)+RVMX2(N,K,0,NY,NX) + RN2OX(0,NY,NX)=RN2OX(0,NY,NX)+RVMX1(N,K,0,NY,NX) + RNH4X(0,NY,NX)=RNH4X(0,NY,NX)+RINHO(N,K,0,NY,NX) + RNO3X(0,NY,NX)=RNO3X(0,NY,NX)+RINOO(N,K,0,NY,NX) + RPO4X(0,NY,NX)=RPO4X(0,NY,NX)+RIPOO(N,K,0,NY,NX) + RNH4X(NU(NY,NX),NY,NX)=RNH4X(NU(NY,NX),NY,NX)+RINHOR(N,K,NY,NX) + RNO3X(NU(NY,NX),NY,NX)=RNO3X(NU(NY,NX),NY,NX)+RINOOR(N,K,NY,NX) + RPO4X(NU(NY,NX),NY,NX)=RPO4X(NU(NY,NX),NY,NX)+RIPOOR(N,K,NY,NX) + IF(K.LE.4)THEN + ROQCX(K,0,NY,NX)=ROQCX(K,0,NY,NX)+ROQCS(N,K,0,NY,NX) + ROQAX(K,0,NY,NX)=ROQAX(K,0,NY,NX)+ROQAS(N,K,0,NY,NX) + ENDIF +8980 CONTINUE + ENDIF +8990 CONTINUE + RNO2X(0,NY,NX)=RNO2X(0,NY,NX)+RVMXC(0,NY,NX) +C +C ADD RESIDUE C,N,P TO SUBSURFACE SEDIMENT BELOW A POND SURFACE +C + IF(BKDS(NU(NY,NX),NY,NX).EQ.0.0.AND.ORGC(0,NY,NX).GT.0.0)THEN + OSGX=ORGC(0,NY,NX) + RC=0.0 + RN=0.0 + RP=0.0 + DO 1970 K=0,5 + IF(K.NE.3.AND.K.NE.4)THEN +C +C MICROBIAL C,N,P +C + DO 1960 N=1,7 + DO 1960 M=1,3 + OMC(M,N,K,NW(NY,NX),NY,NX)=OMC(M,N,K,NW(NY,NX),NY,NX) + 2+OMC(M,N,K,0,NY,NX) + OMN(M,N,K,NW(NY,NX),NY,NX)=OMN(M,N,K,NW(NY,NX),NY,NX) + 2+OMN(M,N,K,0,NY,NX) + OMP(M,N,K,NW(NY,NX),NY,NX)=OMP(M,N,K,NW(NY,NX),NY,NX) + 2+OMP(M,N,K,0,NY,NX) + RC=RC+OMC(M,N,K,0,NY,NX) + RN=RN+OMN(M,N,K,0,NY,NX) + RP=RP+OMP(M,N,K,0,NY,NX) + OMC(M,N,K,0,NY,NX)=0.0 + OMN(M,N,K,0,NY,NX)=0.0 + OMP(M,N,K,0,NY,NX)=0.0 +1960 CONTINUE + ENDIF +1970 CONTINUE +C +C MICROBIAL RESIDUE C,N,P +C + DO 1900 K=0,2 + DO 1940 M=1,2 + ORC(M,K,NW(NY,NX),NY,NX)=ORC(M,K,NW(NY,NX),NY,NX)+ORC(M,K,0,NY,NX) + ORN(M,K,NW(NY,NX),NY,NX)=ORN(M,K,NW(NY,NX),NY,NX)+ORN(M,K,0,NY,NX) + ORP(M,K,NW(NY,NX),NY,NX)=ORP(M,K,NW(NY,NX),NY,NX)+ORP(M,K,0,NY,NX) + RC=RC+ORC(M,K,0,NY,NX) + RN=RN+ORN(M,K,0,NY,NX) + RP=RP+ORP(M,K,0,NY,NX) + ORC(M,K,0,NY,NX)=0.0 + ORN(M,K,0,NY,NX)=0.0 + ORP(M,K,0,NY,NX)=0.0 +1940 CONTINUE +C +C DOC, DON, DOP +C + OQC(K,NW(NY,NX),NY,NX)=OQC(K,NW(NY,NX),NY,NX)+OQC(K,0,NY,NX) + OQN(K,NW(NY,NX),NY,NX)=OQN(K,NW(NY,NX),NY,NX)+OQN(K,0,NY,NX) + OQP(K,NW(NY,NX),NY,NX)=OQP(K,NW(NY,NX),NY,NX)+OQP(K,0,NY,NX) + OQA(K,NW(NY,NX),NY,NX)=OQA(K,NW(NY,NX),NY,NX)+OQA(K,0,NY,NX) + RC=RC+OQC(K,0,NY,NX)+OQA(K,0,NY,NX) + RN=RN+OQN(K,0,NY,NX) + RP=RP+OQP(K,0,NY,NX) + OQC(K,0,NY,NX)=0.0 + OQN(K,0,NY,NX)=0.0 + OQP(K,0,NY,NX)=0.0 + OQA(K,0,NY,NX)=0.0 + OQCH(K,NW(NY,NX),NY,NX)=OQCH(K,NW(NY,NX),NY,NX)+OQCH(K,0,NY,NX) + OQNH(K,NW(NY,NX),NY,NX)=OQNH(K,NW(NY,NX),NY,NX)+OQNH(K,0,NY,NX) + OQPH(K,NW(NY,NX),NY,NX)=OQPH(K,NW(NY,NX),NY,NX)+OQPH(K,0,NY,NX) + OQAH(K,NW(NY,NX),NY,NX)=OQAH(K,NW(NY,NX),NY,NX)+OQAH(K,0,NY,NX) + RC=RC+OQCH(K,0,NY,NX)+OQAH(K,0,NY,NX) + RN=RN+OQNH(K,0,NY,NX) + RP=RP+OQPH(K,0,NY,NX) + OQCH(K,0,NY,NX)=0.0 + OQNH(K,0,NY,NX)=0.0 + OQPH(K,0,NY,NX)=0.0 + OQAH(K,0,NY,NX)=0.0 +C +C ADSORBED C,N,P +C + OHC(K,NW(NY,NX),NY,NX)=OHC(K,NW(NY,NX),NY,NX)+OHC(K,0,NY,NX) + OHN(K,NW(NY,NX),NY,NX)=OHN(K,NW(NY,NX),NY,NX)+OHN(K,0,NY,NX) + OHP(K,NW(NY,NX),NY,NX)=OHP(K,NW(NY,NX),NY,NX)+OHP(K,0,NY,NX) + OHA(K,NW(NY,NX),NY,NX)=OHA(K,NW(NY,NX),NY,NX)+OHA(K,0,NY,NX) + RC=RC+OHC(K,0,NY,NX)+OHA(K,0,NY,NX) + RN=RN+OHN(K,0,NY,NX) + RP=RP+OHP(K,0,NY,NX) + OHC(K,0,NY,NX)=0.0 + OHN(K,0,NY,NX)=0.0 + OHP(K,0,NY,NX)=0.0 + OHA(K,0,NY,NX)=0.0 +C +C PLANT RESIDUE C,N,P +C + DO 1930 M=1,4 + OSC(M,K,NW(NY,NX),NY,NX)=OSC(M,K,NW(NY,NX),NY,NX)+OSC(M,K,0,NY,NX) + OSA(M,K,NW(NY,NX),NY,NX)=OSA(M,K,NW(NY,NX),NY,NX)+OSA(M,K,0,NY,NX) + OSN(M,K,NW(NY,NX),NY,NX)=OSN(M,K,NW(NY,NX),NY,NX)+OSN(M,K,0,NY,NX) + OSP(M,K,NW(NY,NX),NY,NX)=OSP(M,K,NW(NY,NX),NY,NX)+OSP(M,K,0,NY,NX) + RC=RC+OSC(M,K,0,NY,NX) + RN=RN+OSN(M,K,0,NY,NX) + RP=RP+OSP(M,K,0,NY,NX) + OSC(M,K,0,NY,NX)=0.0 + OSA(M,K,0,NY,NX)=0.0 + OSN(M,K,0,NY,NX)=0.0 + OSP(M,K,0,NY,NX)=0.0 +1930 CONTINUE +1900 CONTINUE + TLRSDC=TLRSDC-RC + TLRSDN=TLRSDN-RN + TLRSDP=TLRSDP-RP + URSDC(NY,NX)=URSDC(NY,NX)-RC + URSDN(NY,NX)=URSDN(NY,NX)-RN + URSDP(NY,NX)=URSDP(NY,NX)-RP + ORGC(0,NY,NX)=0.0 + ORGN(0,NY,NX)=0.0 + ORGR(0,NY,NX)=0.0 +C +C ADD RESIDUE SOLUTES TO SUBSURFACE SEDIMENT BELOW A POND SURFACE +C +C CO2S(NW(NY,NX),NY,NX)=CO2S(NW(NY,NX),NY,NX)+CO2S(0,NY,NX) +C CH4S(NW(NY,NX),NY,NX)=CH4S(NW(NY,NX),NY,NX)+CH4S(0,NY,NX) +C OXYS(NW(NY,NX),NY,NX)=OXYS(NW(NY,NX),NY,NX)+OXYS(0,NY,NX) +C Z2GS(NW(NY,NX),NY,NX)=Z2GS(NW(NY,NX),NY,NX)+Z2GS(0,NY,NX) +C Z2OS(NW(NY,NX),NY,NX)=Z2OS(NW(NY,NX),NY,NX)+Z2OS(0,NY,NX) +C H2GS(NW(NY,NX),NY,NX)=H2GS(NW(NY,NX),NY,NX)+H2GS(0,NY,NX) +C ZNH4S(NW(NY,NX),NY,NX)=ZNH4S(NW(NY,NX),NY,NX)+ZNH4S(0,NY,NX) +C ZNH3S(NW(NY,NX),NY,NX)=ZNH3S(NW(NY,NX),NY,NX)+ZNH3S(0,NY,NX) +C ZNO3S(NW(NY,NX),NY,NX)=ZNO3S(NW(NY,NX),NY,NX)+ZNO3S(0,NY,NX) +C H2PO4(NW(NY,NX),NY,NX)=H2PO4(NW(NY,NX),NY,NX)+H2PO4(0,NY,NX) +C ZNO2S(NW(NY,NX),NY,NX)=ZNO2S(NW(NY,NX),NY,NX)+ZNO2S(0,NY,NX) +C CS=CO2S(0,NY,NX)+CH4S(0,NY,NX) +C TLCO2G=TLCO2G-CS +C UCO2S(NY,NX)=UCO2S(NY,NX)-CS +C OS=OXYS(0,NY,NX) +C OXYGSO=OXYGSO-OS +C ZG=Z2GS(0,NY,NX)+Z2OS(0,NY,NX) +C TLN2G=TLN2G-ZG +C ZNH=ZNH4S(0,NY,NX)+ZNH3S(0,NY,NX) +C TLNH4=TLNH4-ZNH +C UNH4(NY,NX)=UNH4(NY,NX)-ZNH +C ZNO=ZNO3S(0,NY,NX)+ZNO2S(0,NY,NX) +C TLNO3=TLNO3-ZNO +C UNO3(NY,NX)=UNO3(NY,NX)-ZNO +C P4=H2PO4(0,NY,NX) +C TLPO4=TLPO4-P4 +C UPO4(NY,NX)=UPO4(NY,NX)-P4 +C CO2S(0,NY,NX)=0.0 +C CH4S(0,NY,NX)=0.0 +C OXYS(0,NY,NX)=0.0 +C Z2GS(0,NY,NX)=0.0 +C Z2OS(0,NY,NX)=0.0 +C H2GS(0,NY,NX)=0.0 +C ZNH4S(0,NY,NX)=0.0 +C ZNH3S(0,NY,NX)=0.0 +C ZNO3S(0,NY,NX)=0.0 +C H2PO4(0,NY,NX)=0.0 +C ZNO2S(0,NY,NX)=0.0 + ENDIF +C +C RUNOFF AND SUBSURFACE BOUNDARY FLUXES +C + DO 9985 L=NU(NY,NX),NL(NY,NX) +C +C LOCATE EXTERNAL BOUNDARIES +C + DO 9980 N=1,3 + DO 9975 NN=1,2 + IF(N.EQ.1)THEN + IF(NN.EQ.1)THEN + IF(NX.EQ.NHE)THEN + N4=NX+1 + N5=NY + N6=L + XN=-1.0 + ELSE + GO TO 9975 + ENDIF + ELSEIF(NN.EQ.2)THEN + IF(NX.EQ.NHW)THEN + N4=NX + N5=NY + N6=L + XN=1.0 + ELSE + GO TO 9975 + ENDIF + ENDIF + ELSEIF(N.EQ.2)THEN + IF(NN.EQ.1)THEN + IF(NY.EQ.NVS)THEN + N4=NX + N5=NY+1 + N6=L + XN=-1.0 + ELSE + GO TO 9975 + ENDIF + ELSEIF(NN.EQ.2)THEN + IF(NY.EQ.NVN)THEN + N4=NX + N5=NY + N6=L + XN=1.0 + ELSE + GO TO 9975 + ENDIF + ENDIF + ELSEIF(N.EQ.3)THEN + IF(NN.EQ.1)THEN + IF(L.EQ.NL(NY,NX))THEN + N4=NX + N5=NY + N6=L+1 + XN=-1.0 + ELSE + GO TO 9975 + ENDIF + ELSEIF(NN.EQ.2)THEN + GO TO 9975 + ENDIF + ENDIF +C +C RUNOFF BOUNDARY FLUXES OF WATER AND HEAT +C + IF(L.EQ.NU(NY,NX).AND.N.NE.3)THEN + WQ=XN*(QR(N,N5,N4)+QS(N,N5,N4)+QW(N,N5,N4)+QI(N,N5,N4)) + IF(WQ.NE.0.0)THEN + CRUN=CRUN-WQ + URUN(NY,NX)=URUN(NY,NX)-WQ + HEATOU=HEATOU-XN*(HQR(N,N5,N4)+HQS(N,N5,N4)) +C +C RUNOFF BOUNDARY FLUXES OF c, n AND p +C + CX=XN*(XCOQRS(N,N5,N4)+XCHQRS(N,N5,N4) + 2+XCOQSS(N,N5,N4)+XCHQSS(N,N5,N4)) + CQ=0.0 + DO 2575 K=0,4 + CQ=CQ+XN*(XOCQRS(K,N,N5,N4)+XOAQRS(K,N,N5,N4)) +2575 CONTINUE + TCOU=TCOU-CQ-CX + TNBP(NY,NX)=TNBP(NY,NX)+CQ+CX + UDOCQ(NY,NX)=UDOCQ(NY,NX)-CQ + UDICQ(NY,NX)=UDICQ(NY,NX)-CX + OX=XN*(XOXQRS(N,N5,N4)+XOXQSS(N,N5,N4)) + OXYGOU=OXYGOU-OX + ZX=XN*(XN4QRW(N,N5,N4)+XN3QRW(N,N5,N4) + 2+XNOQRW(N,N5,N4)+XNXQRS(N,N5,N4)+XN4QSS(N,N5,N4) + 3+XN3QSS(N,N5,N4)+XNOQSS(N,N5,N4)) + ZG=XN*(XN2QRS(N,N5,N4)+XNGQRS(N,N5,N4) + 2+XN2QSS(N,N5,N4)+XNGQSS(N,N5,N4)) + ZQ=0.0 + DO 2875 K=0,4 + ZQ=ZQ+XN*XONQRS(K,N,N5,N4) +2875 CONTINUE + TZOU=TZOU-ZQ-ZX-ZG + UDONQ(NY,NX)=UDONQ(NY,NX)-ZQ + UDINQ(NY,NX)=UDINQ(NY,NX)-ZX + PX=XN*(XP4QRW(N,N5,N4)+XP4QSS(N,N5,N4)) + PQ=0.0 + DO 2775 K=0,4 + PQ=PQ+XN*XOPQRS(K,N,N5,N4) +2775 CONTINUE + TPOU=TPOU-PQ-PX + UDOPQ(NY,NX)=UDOPQ(NY,NX)-PQ + UDIPQ(NY,NX)=UDIPQ(NY,NX)-PX +C +C RUNOFF BOUNDARY FLUXES OF SOLUTES +C + SQ1=XN*(XQRAL(N,N5,N4)+XQRFE(N,N5,N4)+XQRHY(N,N5,N4) + 2+XQRCA(N,N5,N4)+XQRMG(N,N5,N4)+XQRNA(N,N5,N4)+XQRKA(N,N5,N4) + 3+XQROH(N,N5,N4)+XQRSO(N,N5,N4)+XQRCL(N,N5,N4)+XQRC3(N,N5,N4) + 4+XQRH0P(N,N5,N4)+XHGQRS(N,N5,N4)+XQSAL(N,N5,N4)+XQSFE(N,N5,N4) + 5+XQSHY(N,N5,N4)+XQSCA(N,N5,N4)+XQSMG(N,N5,N4)+XQSNA(N,N5,N4) + 6+XQSKA(N,N5,N4)+XQSOH(N,N5,N4)+XQSSO(N,N5,N4)+XQSCL(N,N5,N4) + 3+XQSC3(N,N5,N4)+XQSH0P(N,N5,N4)) + SQ2=XN*2.0*(XQRHC(N,N5,N4)+XQRAL1(N,N5,N4)+XQRALS(N,N5,N4) + 2+XQRFE1(N,N5,N4)+XQRFES(N,N5,N4)+XQRCAO(N,N5,N4)+XQRCAC(N,N5,N4) + 3+XQRCAS(N,N5,N4)+XQRMGO(N,N5,N4)+XQRMGC(N,N5,N4)+XQRMGS(N,N5,N4) + 4+XQRNAC(N,N5,N4)+XQRNAS(N,N5,N4)+XQRKAS(N,N5,N4)+XQRH1P(N,N5,N4) + 5+XQRC0P(N,N5,N4)+XQSHC(N,N5,N4)+XQSAL1(N,N5,N4)+XQSALS(N,N5,N4) + 2+XQSFE1(N,N5,N4)+XQSFES(N,N5,N4)+XQSCAO(N,N5,N4)+XQSCAC(N,N5,N4) + 3+XQSCAS(N,N5,N4)+XQSMGO(N,N5,N4)+XQSMGC(N,N5,N4)+XQSMGS(N,N5,N4) + 4+XQSNAC(N,N5,N4)+XQSNAS(N,N5,N4)+XQSKAS(N,N5,N4)+XQSH1P(N,N5,N4) + 5+XQSC0P(N,N5,N4)) + SQ3=XN*3.0*(XQRAL2(N,N5,N4)+XQRFE2(N,N5,N4)+XQRCAH(N,N5,N4) + 2+XQRMGH(N,N5,N4)+XQRF1P(N,N5,N4)+XQRC1P(N,N5,N4)+XQRM1P(N,N5,N4) + 3+XQSAL2(N,N5,N4)+XQSFE2(N,N5,N4)+XQSCAH(N,N5,N4)+XQSMGH(N,N5,N4) + 2+XQSF1P(N,N5,N4)+XQSC1P(N,N5,N4)+XQSM1P(N,N5,N4)) + SQ4=XN*4.0*(XQRAL3(N,N5,N4)+XQRFE3(N,N5,N4)+XQRH3P(N,N5,N4) + 2+XQRF2P(N,N5,N4)+XQRC2P(N,N5,N4)+XQSAL3(N,N5,N4)+XQSFE3(N,N5,N4) + 3+XQSH3P(N,N5,N4)+XQSF2P(N,N5,N4)+XQSC2P(N,N5,N4)) + 5+XN*5.0*(XQRAL4(N,N5,N4)+XQRFE4(N,N5,N4) + 6+XQSAL4(N,N5,N4)+XQSFE4(N,N5,N4)) + SQ=SQ1+SQ2+SQ3+SQ4 + TIONOU=TIONOU-SQ + UIONOU(NY,NX)=UIONOU(NY,NX)-SQ +C +C SURFACE FLUX ELECTRICAL CONDUCTIVITY +C + WX=QR(N,N5,N4) + IF(WX.NE.0.0)THEN + ECHY=0.337*AMAX1(0.0,XQRHY(N,N5,N4)/WX) + ECOH=0.192*AMAX1(0.0,XQROH(N,N5,N4)/WX) + ECAL=0.056*AMAX1(0.0,XQRAL(N,N5,N4)*3.0/WX) + ECFE=0.051*AMAX1(0.0,XQRFE(N,N5,N4)*3.0/WX) + ECCA=0.060*AMAX1(0.0,XQRCA(N,N5,N4)*2.0/WX) + ECMG=0.053*AMAX1(0.0,XQRMG(N,N5,N4)*2.0/WX) + ECNA=0.050*AMAX1(0.0,XQRNA(N,N5,N4)/WX) + ECKA=0.070*AMAX1(0.0,XQRKA(N,N5,N4)/WX) + ECCO=0.072*AMAX1(0.0,XQRC3(N,N5,N4)*2.0/WX) + ECHC=0.044*AMAX1(0.0,XQRHC(N,N5,N4)/WX) + ECSO=0.080*AMAX1(0.0,XQRSO(N,N5,N4)*2.0/WX) + ECCL=0.076*AMAX1(0.0,XQRCL(N,N5,N4)/WX) + ECNO=0.071*AMAX1(0.0,XNOQRW(N,N5,N4)/(WX*14.0)) + ECNDQ=ECHY+ECOH+ECAL+ECFE+ECCA+ECMG+ECNA+ECKA + 2+ECCO+ECHC+ECSO+ECCL+ECNO +C WRITE(*,9991)'ECNDQ',IYRC,I,J,N4,N5,N6,N,WX,ECNDQ +9991 FORMAT(A8,7I4,2E12.4) + ELSE + ECNDQ=0.0 + ENDIF +C +C RUNOFF BOUNDARY FLUXES OF SEDIMENT +C + IF(IERSN(N5,N4).NE.0)THEN + ER=XN*(XSANER(N,N5,N4)+XSILER(N,N5,N4)+XCLAER(N,N5,N4)) + TSEDOU=TSEDOU-ER + USEDOU(NY,NX)=USEDOU(NY,NX)-ER +C +C MICROBIAL C IN RUNOFF SEDIMENT +C + CQ=0.0 + DO 3580 K=0,5 + DO 3580 NO=1,7 + DO 3580 M=1,3 + CQ=CQ+XN*OMCER(M,NO,K,N,N5,N4) +3580 CONTINUE +C +C MICROBIAL RESIDUE C IN RUNOFF SEDIMENT +C + DO 3575 K=0,4 + DO 3570 M=1,2 + CQ=CQ+XN*ORCER(M,K,N,N5,N4) +3570 CONTINUE +C +C DOC, ADSORBED AND HUMUS C IN RUNOFF SEDIMENT +C + CQ=CQ+XN*OHCER(K,N,N5,N4) + DO 3565 M=1,4 + CQ=CQ+XN*OSCER(M,K,N,N5,N4) +3565 CONTINUE +3575 CONTINUE + TCOU=TCOU-CQ-CX + UDOCQ(NY,NX)=UDOCQ(NY,NX)-CQ + UDICQ(NY,NX)=UDICQ(NY,NX)-CX + TSEDOU=TSEDOU-CQ*1.0E-06 + USEDOU(NY,NX)=USEDOU(NY,NX)-CQ*1.0E-06 + TNBP(NY,NX)=TNBP(NY,NX)+CQ+CX +C +C MICROBIAL N IN RUNOFF SEDIMENT +C + ZQ=0.0 + DO 6880 K=0,5 + DO 6880 NO=1,7 + DO 6880 M=1,2 + ZQ=ZQ+XN*OMNER(M,NO,K,N,N5,N4) +6880 CONTINUE +C +C MICROBIAL RESIDUE N IN RUNOFF SEDIMENT +C + DO 6875 K=0,4 + DO 6870 M=1,2 + ZQ=ZQ+XN*ORNER(M,K,N,N5,N4) +6870 CONTINUE +C +C DON, ADSORBED AND HUMUS N IN RUNOFF SEDIMENT +C + ZQ=ZQ+XN*OHNER(K,N,N5,N4) + DO 6865 M=1,4 + ZQ=ZQ+XN*OSNER(M,K,N,N5,N4) +6865 CONTINUE +6875 CONTINUE + TZOU=TZOU-ZQ-ZX-ZG + UDONQ(NY,NX)=UDONQ(NY,NX)-ZQ + UDINQ(NY,NX)=UDINQ(NY,NX)-ZX +C +C MICROBIAL P IN RUNOFF SEDIMENT +C + PQ=0.0 + DO 6780 K=0,5 + DO 6780 NO=1,7 + DO 6780 M=1,2 + PQ=PQ+XN*OMPER(M,NO,K,N,N5,N4) +6780 CONTINUE +C +C MICROBIAL RESIDUE P IN RUNOFF SEDIMENT +C + DO 6775 K=0,4 + DO 6770 M=1,2 + PQ=PQ+XN*ORPER(M,K,N,N5,N4) +6770 CONTINUE +C +C DOP, ADSORBED AND HUMUS P IN RUNOFF SEDIMENT +C + PQ=PQ+XN*OHPER(K,N,N5,N4) + DO 6765 M=1,4 + PQ=PQ+XN*OSPER(M,K,N,N5,N4) +6765 CONTINUE +6775 CONTINUE + TPOU=TPOU-PQ-PX + UDOPQ(NY,NX)=UDOPQ(NY,NX)-PQ + UDIPQ(NY,NX)=UDIPQ(NY,NX)-PX +C +C SOLUTES IN RUNOFF SEDIMENTS +C + SQ1=XN*(XOH0ER(N,N5,N4) + 5+XOH0EB(N,N5,N4)+XHYER(N,N5,N4)+XALER(N,N5,N4)+XCAER(N,N5,N4) + 6+XMGER(N,N5,N4)+XNAER(N,N5,N4)+XKAER(N,N5,N4)+XHCER(N,N5,N4) + 7+XNH3ER(N,N5,N4)+XNHUER(N,N5,N4)+XNO3ER(N,N5,N4)+XNH3EB(N,N5,N4) + 8+XNHUEB(N,N5,N4)+XNO3EB(N,N5,N4)) + SQ2=XN*2.0*(XN4ER(N,N5,N4) + 6+XNBER(N,N5,N4)+XOH1ER(N,N5,N4)+XOH1EB(N,N5,N4)+PCACER(N,N5,N4) + 7+PCASER(N,N5,N4)+PALPER(N,N5,N4)+PFEPER(N,N5,N4)+PALPEB(N,N5,N4) + 8+PFEPEB(N,N5,N4)+XNH4ER(N,N5,N4)+XNH4EB(N,N5,N4)) + SQ3=XN*3.0*(XAL2ER(N,N5,N4) + 4+XOH2ER(N,N5,N4)+XH1PER(N,N5,N4)+XOH2EB(N,N5,N4)+XH1PEB(N,N5,N4) + 5+PCPDER(N,N5,N4)+PCPDEB(N,N5,N4)) + SQ4=XN*4.0*(XH2PER(N,N5,N4)+XH2PEB(N,N5,N4)+PALOER(N,N5,N4) + 4+PFEOER(N,N5,N4)) + 6+XN*7.0*(PCPMER(N,N5,N4)+PCPMEB(N,N5,N4)) + 7+XN*9.0*(PCPHER(N,N5,N4)+PCPHEB(N,N5,N4)) + SQ=SQ1+SQ2+SQ3+SQ4 + TIONOU=TIONOU-SQ + UIONOU(NY,NX)=UIONOU(NY,NX)-SQ + ENDIF + ENDIF + ENDIF +C +C SUBSURFACE BOUNDARY FLUXES OF WATER AND HEAT +C + IF(NCN(NY,NX).NE.3.OR.N.EQ.3)THEN + WO=XN*(FLW(N,N6,N5,N4)+FLWH(N,N6,N5,N4)) + VOLWOU=VOLWOU-WO + HVOLO(NY,NX)=HVOLO(NY,NX)-WO + UVOLO(NY,NX)=UVOLO(NY,NX)-WO + HEATOU=HEATOU-XN*HFLW(N,N6,N5,N4) +C +C SUBSURFACE BOUNDARY FLUXES OF CO2 AND DOC +C + CO=0.0 + DO 450 K=0,4 + CO=CO+XN*(XOCFLS(K,N,N6,N5,N4)+XOAFLS(K,N,N6,N5,N4) + 4+XOCFHS(K,N,N6,N5,N4)+XOAFHS(K,N,N6,N5,N4)) +450 CONTINUE + CX=XN*(XCOFLS(N,N6,N5,N4)+XCOFHS(N,N6,N5,N4) + 2+XCOFLG(N,N6,N5,N4)+XCHFLS(N,N6,N5,N4) + 3+XCHFHS(N,N6,N5,N4)+XCHFLG(N,N6,N5,N4)) + TCOU=TCOU-CO-CX + UDOCD(NY,NX)=UDOCD(NY,NX)-CO + UDICD(NY,NX)=UDICD(NY,NX)-CX + TNBP(NY,NX)=TNBP(NY,NX)+CO+CX +C +C SUBSURFACE BOUNDARY FLUXES OF O2 +C + OO=XN*(XOXFLS(N,N6,N5,N4)+XOXFHS(N,N6,N5,N4)+XOXFLG(N,N6,N5,N4)) + OXYGOU=OXYGOU-OO +C +C SUBSURFACE BOUNDARY FLUXES OF N2O, N2, NH4, NH3, NO3, NO2 AND DON +C + ZO=0.0 + DO 455 K=0,4 + ZO=ZO+XN*(XONFLS(K,N,N6,N5,N4)+XONFHS(K,N,N6,N5,N4)) +455 CONTINUE + ZX=XN*(XN2FLS(N,N6,N5,N4)+XN4FLW(N,N6,N5,N4) + 2+XN3FLW(N,N6,N5,N4)+XNOFLW(N,N6,N5,N4)+XN4FLB(N,N6,N5,N4) + 3+XN3FLB(N,N6,N5,N4)+XNOFLB(N,N6,N5,N4)+XNXFLS(N,N6,N5,N4) + 4+XNXFLB(N,N6,N5,N4)+XN2FHS(N,N6,N5,N4) + 5+XN4FHW(N,N6,N5,N4)+XN3FHW(N,N6,N5,N4)+XNOFHW(N,N6,N5,N4) + 6+XN4FHB(N,N6,N5,N4)+XN3FHB(N,N6,N5,N4)+XNOFHB(N,N6,N5,N4) + 7+XNXFHS(N,N6,N5,N4)+XNXFHB(N,N6,N5,N4)+XN2FLG(N,N6,N5,N4) + 8+XN3FLG(N,N6,N5,N4)) + ZG=XN*(XNGFLS(N,N6,N5,N4)+XNGFLG(N,N6,N5,N4)+XNGFHS(N,N6,N5,N4)) + TZOU=TZOU-ZO-ZX-ZG + UDOND(NY,NX)=UDOND(NY,NX)-ZO + UDIND(NY,NX)=UDIND(NY,NX)-ZX +C +C SUBSURFACE BOUNDARY FLUXES OF PO4 AND DOP +C + PO=0.0 + DO 460 K=0,4 + PO=PO+XN*(XOPFLS(K,N,N6,N5,N4)+XOPFHS(K,N,N6,N5,N4)) +460 CONTINUE + PX=XN*(XH2PFS(N,N6,N5,N4)+XH2BFB(N,N6,N5,N4) + 2+XH2PHS(N,N6,N5,N4)+XH2BHB(N,N6,N5,N4)) + TPOU=TPOU-PO-PX + UDOPD(NY,NX)=UDOPD(NY,NX)-PO + UDIPD(NY,NX)=UDIPD(NY,NX)-PX +C +C SUBSURFACE BOUNDARY FLUXES OF SOLUTES +C + SS=XN*(XALFLS(N,N6,N5,N4)+XFEFLS(N,N6,N5,N4)+XHYFLS(N,N6,N5,N4) + 2+XCAFLS(N,N6,N5,N4)+XMGFLS(N,N6,N5,N4)+XNAFLS(N,N6,N5,N4) + 3+XKAFLS(N,N6,N5,N4)+XOHFLS(N,N6,N5,N4)+XSOFLS(N,N6,N5,N4) + 4+XCLFLS(N,N6,N5,N4)+XC3FLS(N,N6,N5,N4)+XH0PFS(N,N6,N5,N4) + 5+XH0BFB(N,N6,N5,N4)+2.0*(XHCFLS(N,N6,N5,N4)+XAL1FS(N,N6,N5,N4) + 6+XALSFS(N,N6,N5,N4)+XFE1FS(N,N6,N5,N4)+XFESFS(N,N6,N5,N4) + 7+XCAOFS(N,N6,N5,N4)+XCACFS(N,N6,N5,N4) + 8+XCASFS(N,N6,N5,N4)+XMGOFS(N,N6,N5,N4)+XMGCFS(N,N6,N5,N4) + 9+XMGSFS(N,N6,N5,N4)+XNACFS(N,N6,N5,N4)+XNASFS(N,N6,N5,N4) + 1+XKASFS(N,N6,N5,N4)+XH1PFS(N,N6,N5,N4)+XH1BFB(N,N6,N5,N4) + 2+XC0PFS(N,N6,N5,N4)+XC0BFB(N,N6,N5,N4))+3.0*(XAL2FS(N,N6,N5,N4) + 3+XFE2FS(N,N6,N5,N4)+XCAHFS(N,N6,N5,N4)+XMGHFS(N,N6,N5,N4) + 4+XF1PFS(N,N6,N5,N4)+XC1PFS(N,N6,N5,N4)+XM1PFS(N,N6,N5,N4) + 5+XF1BFB(N,N6,N5,N4)+XC1BFB(N,N6,N5,N4)+XM1BFB(N,N6,N5,N4)) + 6+4.0*(XAL3FS(N,N6,N5,N4)+XFE3FS(N,N6,N5,N4)+XH3PFS(N,N6,N5,N4) + 7+XF2PFS(N,N6,N5,N4)+XC2PFS(N,N6,N5,N4)+XH3BFB(N,N6,N5,N4) + 8+XF2BFB(N,N6,N5,N4)+XC2BFB(N,N6,N5,N4)) + 9+5.0*(XAL4FS(N,N6,N5,N4)+XFE4FS(N,N6,N5,N4))+XHGFLS(N,N6,N5,N4) + 1+XHGFLG(N,N6,N5,N4)) + SG=SG+XHGFLS(N,N6,N5,N4)+XHGFLG(N,N6,N5,N4) + SH=XN*(XALFHS(N,N6,N5,N4)+XFEFHS(N,N6,N5,N4)+XHYFHS(N,N6,N5,N4) + 2+XCAFHS(N,N6,N5,N4)+XMGFHS(N,N6,N5,N4)+XNAFHS(N,N6,N5,N4) + 3+XKAFHS(N,N6,N5,N4)+XOHFHS(N,N6,N5,N4)+XSOFHS(N,N6,N5,N4) + 4+XCLFHS(N,N6,N5,N4)+XC3FHS(N,N6,N5,N4)+XH0PHS(N,N6,N5,N4) + 5+XH0BHB(N,N6,N5,N4)+2.0*(XHCFHS(N,N6,N5,N4)+XAL1HS(N,N6,N5,N4) + 6+XALSHS(N,N6,N5,N4)+XFE1HS(N,N6,N5,N4)+XFESHS(N,N6,N5,N4) + 7+XCAOHS(N,N6,N5,N4)+XCACHS(N,N6,N5,N4) + 8+XCASHS(N,N6,N5,N4)+XMGOHS(N,N6,N5,N4)+XMGCHS(N,N6,N5,N4) + 9+XMGSHS(N,N6,N5,N4)+XNACHS(N,N6,N5,N4)+XNASHS(N,N6,N5,N4) + 1+XKASHS(N,N6,N5,N4)+XH1PHS(N,N6,N5,N4)+XH1BHB(N,N6,N5,N4) + 2+XC0PHS(N,N6,N5,N4)+XC0BHB(N,N6,N5,N4))+3.0*(XAL2HS(N,N6,N5,N4) + 3+XFE2HS(N,N6,N5,N4)+XCAHHS(N,N6,N5,N4)+XMGHHS(N,N6,N5,N4) + 4+XF1PHS(N,N6,N5,N4)+XC1PHS(N,N6,N5,N4)+XM1PHS(N,N6,N5,N4) + 5+XF1BHB(N,N6,N5,N4)+XC1BHB(N,N6,N5,N4)+XM1BHB(N,N6,N5,N4)) + 6+4.0*(XAL3HS(N,N6,N5,N4)+XFE3HS(N,N6,N5,N4)+XH3PHS(N,N6,N5,N4) + 7+XF2PHS(N,N6,N5,N4)+XC2PHS(N,N6,N5,N4)+XH3BHB(N,N6,N5,N4) + 8+XF2BHB(N,N6,N5,N4)+XC2BHB(N,N6,N5,N4)) + 9+5.0*(XAL4HS(N,N6,N5,N4)+XAL4HS(N,N6,N5,N4))+XHGFHS(N,N6,N5,N4)) + SO=SS+SH + TIONOU=TIONOU-SO + UIONOU(NY,NX)=UIONOU(NY,NX)-SO +C +C SUBSURFACE FLUX ELECTRICAL CONDUCTIVITY +C + WX=FLW(N,N6,N5,N4)+FLWH(N,N6,N5,N4) + IF(WX.NE.0.0)THEN + ECHY=0.337*AMAX1(0.0,(XHYFLS(N,N6,N5,N4) + 2+XHYFHS(N,N6,N5,N4))/WX) + ECOH=0.192*AMAX1(0.0,(XOHFLS(N,N6,N5,N4) + 2+XOHFHS(N,N6,N5,N4))/WX) + ECAL=0.056*AMAX1(0.0,(XALFLS(N,N6,N5,N4) + 2+XCAFHS(N,N6,N5,N4))*3.0/WX) + ECFE=0.051*AMAX1(0.0,(XFEFLS(N,N6,N5,N4) + 2+XFEFHS(N,N6,N5,N4))*3.0/WX) + ECCA=0.060*AMAX1(0.0,(XCAFLS(N,N6,N5,N4) + 2+XCAFHS(N,N6,N5,N4))*2.0/WX) + ECMG=0.053*AMAX1(0.0,(XMGFLS(N,N6,N5,N4) + 2+XMGFHS(N,N6,N5,N4))*2.0/WX) + ECNA=0.050*AMAX1(0.0,(XNAFLS(N,N6,N5,N4) + 2+XNAFHS(N,N6,N5,N4))/WX) + ECKA=0.070*AMAX1(0.0,(XKAFLS(N,N6,N5,N4) + 2+XKAFHS(N,N6,N5,N4))/WX) + ECCO=0.072*AMAX1(0.0,(XC3FLS(N,N6,N5,N4) + 2+XC3FHS(N,N6,N5,N4))*2.0/WX) + ECHC=0.044*AMAX1(0.0,(XHCFLS(N,N6,N5,N4) + 2+XHCFHS(N,N6,N5,N4))/WX) + ECSO=0.080*AMAX1(0.0,(XSOFLS(N,N6,N5,N4) + 2+XSOFHS(N,N6,N5,N4))*2.0/WX) + ECCL=0.076*AMAX1(0.0,(XCLFLS(N,N6,N5,N4) + 2+XCLFHS(N,N6,N5,N4))/WX) + ECNO=0.071*AMAX1(0.0,(XNOFLW(N,N6,N5,N4) + 2+XNOFHW(N,N6,N5,N4))/(WX*14.0)) + ECNDX=ECHY+ECOH+ECAL+ECFE+ECCA+ECMG+ECNA+ECKA + 2+ECCO+ECHC+ECSO+ECCL+ECNO +C IF((I/10)*10.EQ.I.AND.J.EQ.15)THEN +C WRITE(*,9992)'ECNDX',IYRC,I,J,N4,N5,N6,N,WX,ECNDX +C 2,FLW(N,N6,N5,N4),FLWH(N,N6,N5,N4) +9992 FORMAT(A8,7I4,4E12.4) +C ENDIF + ELSE + ECNDX=0.0 + ENDIF + ENDIF +9975 CONTINUE +9980 CONTINUE +9985 CONTINUE +C +C SET DEPTH OF EXTERNAL WATER TABLE +C + IF(IPRC(NY,NX).EQ.2)THEN + DTBLX(NY,NX)=DTBLX(NY,NX)-HVOLO(NY,NX)/AREA(3,NU(NY,NX),NY,NX) + 2-0.001*(DTBLX(NY,NX)-DTBLZ(NY,NX)) + ELSEIF(IPRC(NY,NX).EQ.3)THEN + DTBLX(NY,NX)=DTBLX(NY,NX)-HVOLO(NY,NX)/AREA(3,NU(NY,NX),NY,NX) + 2-0.001*(DTBLX(NY,NX)-DDRG(NY,NX)) + ENDIF +C +C TOTAL FLUXES FOR EACH GRID CELL FROM ALL INTERNAL AND BOUNDARY FLUXES +C CALCULATED IN 'WATSUB', NITRO', 'SOLUTE', 'EXTRACT', 'TRNSFR', +C 'TRNSFRS' AND 'REDIST' ABOVE +C + TQR(NY,NX)=0.0 + THQR(NY,NX)=0.0 + TQS(NY,NX)=0.0 + TQW(NY,NX)=0.0 + TQI(NY,NX)=0.0 + THQS(NY,NX)=0.0 + DO 9960 K=0,2 + TOCQRS(K,NY,NX)=0.0 + TONQRS(K,NY,NX)=0.0 + TOPQRS(K,NY,NX)=0.0 + TOAQRS(K,NY,NX)=0.0 +9960 CONTINUE + TCOQRS(NY,NX)=0.0 + TCHQRS(NY,NX)=0.0 + TOXQRS(NY,NX)=0.0 + TNGQRS(NY,NX)=0.0 + TN2QRS(NY,NX)=0.0 + THGQRS(NY,NX)=0.0 + TN4QRS(NY,NX)=0.0 + TN3QRS(NY,NX)=0.0 + TNOQRS(NY,NX)=0.0 + TNXQRS(NY,NX)=0.0 + TPOQRS(NY,NX)=0.0 + TCOQSS(NY,NX)=0.0 + TCHQSS(NY,NX)=0.0 + TOXQSS(NY,NX)=0.0 + TNGQSS(NY,NX)=0.0 + TN2QSS(NY,NX)=0.0 + TN4QSS(NY,NX)=0.0 + TN3QSS(NY,NX)=0.0 + TNOQSS(NY,NX)=0.0 + TPOQSS(NY,NX)=0.0 + IF(ISALT(NY,NX).NE.0)THEN + TQRAL(NY,NX)=0.0 + TQRFE(NY,NX)=0.0 + TQRHY(NY,NX)=0.0 + TQRCA(NY,NX)=0.0 + TQRMG(NY,NX)=0.0 + TQRNA(NY,NX)=0.0 + TQRKA(NY,NX)=0.0 + TQROH(NY,NX)=0.0 + TQRSO(NY,NX)=0.0 + TQRCL(NY,NX)=0.0 + TQRC3(NY,NX)=0.0 + TQRHC(NY,NX)=0.0 + TQRAL1(NY,NX)=0.0 + TQRAL2(NY,NX)=0.0 + TQRAL3(NY,NX)=0.0 + TQRAL4(NY,NX)=0.0 + TQRALS(NY,NX)=0.0 + TQRFE1(NY,NX)=0.0 + TQRFE2(NY,NX)=0.0 + TQRFE3(NY,NX)=0.0 + TQRFE4(NY,NX)=0.0 + TQRFES(NY,NX)=0.0 + TQRCAO(NY,NX)=0.0 + TQRCAC(NY,NX)=0.0 + TQRCAH(NY,NX)=0.0 + TQRCAS(NY,NX)=0.0 + TQRMGO(NY,NX)=0.0 + TQRMGC(NY,NX)=0.0 + TQRMGH(NY,NX)=0.0 + TQRMGS(NY,NX)=0.0 + TQRNAC(NY,NX)=0.0 + TQRNAS(NY,NX)=0.0 + TQRKAS(NY,NX)=0.0 + TQRH0P(NY,NX)=0.0 + TQRH1P(NY,NX)=0.0 + TQRH3P(NY,NX)=0.0 + TQRF1P(NY,NX)=0.0 + TQRF2P(NY,NX)=0.0 + TQRC0P(NY,NX)=0.0 + TQRC1P(NY,NX)=0.0 + TQRC2P(NY,NX)=0.0 + TQRM1P(NY,NX)=0.0 + TQSAL(NY,NX)=0.0 + TQSFE(NY,NX)=0.0 + TQSHY(NY,NX)=0.0 + TQSCA(NY,NX)=0.0 + TQSMG(NY,NX)=0.0 + TQSNA(NY,NX)=0.0 + TQSKA(NY,NX)=0.0 + TQSOH(NY,NX)=0.0 + TQSSO(NY,NX)=0.0 + TQSCL(NY,NX)=0.0 + TQSC3(NY,NX)=0.0 + TQSHC(NY,NX)=0.0 + TQSAL1(NY,NX)=0.0 + TQSAL2(NY,NX)=0.0 + TQSAL3(NY,NX)=0.0 + TQSAL4(NY,NX)=0.0 + TQSALS(NY,NX)=0.0 + TQSFE1(NY,NX)=0.0 + TQSFE2(NY,NX)=0.0 + TQSFE3(NY,NX)=0.0 + TQSFE4(NY,NX)=0.0 + TQSFES(NY,NX)=0.0 + TQSCAO(NY,NX)=0.0 + TQSCAC(NY,NX)=0.0 + TQSCAH(NY,NX)=0.0 + TQSCAS(NY,NX)=0.0 + TQSMGO(NY,NX)=0.0 + TQSMGC(NY,NX)=0.0 + TQSMGH(NY,NX)=0.0 + TQSMGS(NY,NX)=0.0 + TQSNAC(NY,NX)=0.0 + TQSNAS(NY,NX)=0.0 + TQSKAS(NY,NX)=0.0 + TQSH0P(NY,NX)=0.0 + TQSH1P(NY,NX)=0.0 + TQSH3P(NY,NX)=0.0 + TQSF1P(NY,NX)=0.0 + TQSF2P(NY,NX)=0.0 + TQSC0P(NY,NX)=0.0 + TQSC1P(NY,NX)=0.0 + TQSC2P(NY,NX)=0.0 + TQSM1P(NY,NX)=0.0 + ENDIF + IF(IERSN(NY,NX).NE.0)THEN + TSEDER(NY,NX)=0.0 + TSANER(NY,NX)=0.0 + TSILER(NY,NX)=0.0 + TCLAER(NY,NX)=0.0 + TCECER(NY,NX)=0.0 + TAECER(NY,NX)=0.0 + TNH4ER(NY,NX)=0.0 + TNH3ER(NY,NX)=0.0 + TNHUER(NY,NX)=0.0 + TNO3ER(NY,NX)=0.0 + TNH4EB(NY,NX)=0.0 + TNH3EB(NY,NX)=0.0 + TNHUEB(NY,NX)=0.0 + TNO3EB(NY,NX)=0.0 + TN4ER(NY,NX)=0.0 + TNBER(NY,NX)=0.0 + THYER(NY,NX)=0.0 + TALER(NY,NX)=0.0 + TCAER(NY,NX)=0.0 + TMGER(NY,NX)=0.0 + TNAER(NY,NX)=0.0 + TKAER(NY,NX)=0.0 + THCER(NY,NX)=0.0 + TAL2ER(NY,NX)=0.0 + TOH0ER(NY,NX)=0.0 + TOH1ER(NY,NX)=0.0 + TOH2ER(NY,NX)=0.0 + TH1PER(NY,NX)=0.0 + TH2PER(NY,NX)=0.0 + TOH0EB(NY,NX)=0.0 + TOH1EB(NY,NX)=0.0 + TOH2EB(NY,NX)=0.0 + TH1PEB(NY,NX)=0.0 + TH2PEB(NY,NX)=0.0 + TALOER(NY,NX)=0.0 + TFEOER(NY,NX)=0.0 + TCACER(NY,NX)=0.0 + TCASER(NY,NX)=0.0 + TALPER(NY,NX)=0.0 + TFEPER(NY,NX)=0.0 + TCPDER(NY,NX)=0.0 + TCPHER(NY,NX)=0.0 + TCPMER(NY,NX)=0.0 + TALPEB(NY,NX)=0.0 + TFEPEB(NY,NX)=0.0 + TCPDEB(NY,NX)=0.0 + TCPHEB(NY,NX)=0.0 + TCPMEB(NY,NX)=0.0 + DO 9480 K=0,5 + DO 9480 NN=1,7 + TOMCER(3,NN,K,NY,NX)=0.0 + DO 9480 M=1,2 + TOMCER(M,NN,K,NY,NX)=0.0 + TOMNER(M,NN,K,NY,NX)=0.0 + TOMPER(M,NN,K,NY,NX)=0.0 +9480 CONTINUE + DO 9475 K=0,4 + DO 9470 M=1,2 + TORCER(M,K,NY,NX)=0.0 + TORNER(M,K,NY,NX)=0.0 + TORPER(M,K,NY,NX)=0.0 +9470 CONTINUE + TOHCER(K,NY,NX)=0.0 + TOHNER(K,NY,NX)=0.0 + TOHPER(K,NY,NX)=0.0 + DO 9465 M=1,4 + TOSCER(M,K,NY,NX)=0.0 + TOSAER(M,K,NY,NX)=0.0 + TOSNER(M,K,NY,NX)=0.0 + TOSPER(M,K,NY,NX)=0.0 +9465 CONTINUE +9475 CONTINUE + ENDIF + LG=0 + LX=0 + DO 8575 L=NU(NY,NX),NL(NY,NX) + IF(THETP(L,NY,NX).LT.THETX)LX=1 + IF(THETP(L,NY,NX).GE.THETX.AND.LX.EQ.0)LG=L + TTHAW(L,NY,NX)=0.0 + TTHAWH(L,NY,NX)=0.0 + THTHAW(L,NY,NX)=0.0 + TFLW(L,NY,NX)=0.0 + TFLWX(L,NY,NX)=0.0 + TFLWH(L,NY,NX)=0.0 + THFLW(L,NY,NX)=0.0 + DO 8595 K=0,4 + TOCFLS(K,L,NY,NX)=0.0 + TONFLS(K,L,NY,NX)=0.0 + TOPFLS(K,L,NY,NX)=0.0 + TOAFLS(K,L,NY,NX)=0.0 + TOCFHS(K,L,NY,NX)=0.0 + TONFHS(K,L,NY,NX)=0.0 + TOPFHS(K,L,NY,NX)=0.0 + TOAFHS(K,L,NY,NX)=0.0 +8595 CONTINUE + TCOFLS(L,NY,NX)=0.0 + TCHFLS(L,NY,NX)=0.0 + TOXFLS(L,NY,NX)=0.0 + TNGFLS(L,NY,NX)=0.0 + TN2FLS(L,NY,NX)=0.0 + THGFLS(L,NY,NX)=0.0 + TN4FLS(L,NY,NX)=0.0 + TN3FLS(L,NY,NX)=0.0 + TNOFLS(L,NY,NX)=0.0 + TNXFLS(L,NY,NX)=0.0 + TPOFLS(L,NY,NX)=0.0 + TN4FLB(L,NY,NX)=0.0 + TN3FLB(L,NY,NX)=0.0 + TNOFLB(L,NY,NX)=0.0 + TNXFLB(L,NY,NX)=0.0 + TH2BFB(L,NY,NX)=0.0 + TCOFHS(L,NY,NX)=0.0 + TCHFHS(L,NY,NX)=0.0 + TOXFHS(L,NY,NX)=0.0 + TNGFHS(L,NY,NX)=0.0 + TN2FHS(L,NY,NX)=0.0 + THGFHS(L,NY,NX)=0.0 + TN4FHS(L,NY,NX)=0.0 + TN3FHS(L,NY,NX)=0.0 + TNOFHS(L,NY,NX)=0.0 + TNXFHS(L,NY,NX)=0.0 + TPOFHS(L,NY,NX)=0.0 + TN4FHB(L,NY,NX)=0.0 + TN3FHB(L,NY,NX)=0.0 + TNOFHB(L,NY,NX)=0.0 + TNXFHB(L,NY,NX)=0.0 + TH2BHB(L,NY,NX)=0.0 + TCOFLG(L,NY,NX)=0.0 + TCHFLG(L,NY,NX)=0.0 + TOXFLG(L,NY,NX)=0.0 + TNGFLG(L,NY,NX)=0.0 + TN2FLG(L,NY,NX)=0.0 + TNHFLG(L,NY,NX)=0.0 + THGFLG(L,NY,NX)=0.0 + IF(ISALT(NY,NX).NE.0)THEN + TALFLS(L,NY,NX)=0.0 + TFEFLS(L,NY,NX)=0.0 + THYFLS(L,NY,NX)=0.0 + TCAFLS(L,NY,NX)=0.0 + TMGFLS(L,NY,NX)=0.0 + TNAFLS(L,NY,NX)=0.0 + TKAFLS(L,NY,NX)=0.0 + TOHFLS(L,NY,NX)=0.0 + TSOFLS(L,NY,NX)=0.0 + TCLFLS(L,NY,NX)=0.0 + TC3FLS(L,NY,NX)=0.0 + THCFLS(L,NY,NX)=0.0 + TAL1FS(L,NY,NX)=0.0 + TAL2FS(L,NY,NX)=0.0 + TAL3FS(L,NY,NX)=0.0 + TAL4FS(L,NY,NX)=0.0 + TALSFS(L,NY,NX)=0.0 + TFE1FS(L,NY,NX)=0.0 + TFE2FS(L,NY,NX)=0.0 + TFE3FS(L,NY,NX)=0.0 + TFE4FS(L,NY,NX)=0.0 + TFESFS(L,NY,NX)=0.0 + TCAOFS(L,NY,NX)=0.0 + TCACFS(L,NY,NX)=0.0 + TCAHFS(L,NY,NX)=0.0 + TCASFS(L,NY,NX)=0.0 + TMGOFS(L,NY,NX)=0.0 + TMGCFS(L,NY,NX)=0.0 + TMGHFS(L,NY,NX)=0.0 + TMGSFS(L,NY,NX)=0.0 + TNACFS(L,NY,NX)=0.0 + TNASFS(L,NY,NX)=0.0 + TKASFS(L,NY,NX)=0.0 + TH0PFS(L,NY,NX)=0.0 + TH1PFS(L,NY,NX)=0.0 + TH3PFS(L,NY,NX)=0.0 + TF1PFS(L,NY,NX)=0.0 + TF2PFS(L,NY,NX)=0.0 + TC0PFS(L,NY,NX)=0.0 + TC1PFS(L,NY,NX)=0.0 + TC2PFS(L,NY,NX)=0.0 + TM1PFS(L,NY,NX)=0.0 + TH0BFB(L,NY,NX)=0.0 + TH1BFB(L,NY,NX)=0.0 + TH3BFB(L,NY,NX)=0.0 + TF1BFB(L,NY,NX)=0.0 + TF2BFB(L,NY,NX)=0.0 + TC0BFB(L,NY,NX)=0.0 + TC1BFB(L,NY,NX)=0.0 + TC2BFB(L,NY,NX)=0.0 + TM1BFB(L,NY,NX)=0.0 + TALFHS(L,NY,NX)=0.0 + TFEFHS(L,NY,NX)=0.0 + THYFHS(L,NY,NX)=0.0 + TCAFHS(L,NY,NX)=0.0 + TMGFHS(L,NY,NX)=0.0 + TNAFHS(L,NY,NX)=0.0 + TKAFHS(L,NY,NX)=0.0 + TOHFHS(L,NY,NX)=0.0 + TSOFHS(L,NY,NX)=0.0 + TCLFHS(L,NY,NX)=0.0 + TC3FHS(L,NY,NX)=0.0 + THCFHS(L,NY,NX)=0.0 + TAL1HS(L,NY,NX)=0.0 + TAL2HS(L,NY,NX)=0.0 + TAL3HS(L,NY,NX)=0.0 + TAL4HS(L,NY,NX)=0.0 + TALSHS(L,NY,NX)=0.0 + TFE1HS(L,NY,NX)=0.0 + TFE2HS(L,NY,NX)=0.0 + TFE3HS(L,NY,NX)=0.0 + TFE4HS(L,NY,NX)=0.0 + TFESHS(L,NY,NX)=0.0 + TCAOHS(L,NY,NX)=0.0 + TCACHS(L,NY,NX)=0.0 + TCAHHS(L,NY,NX)=0.0 + TCASHS(L,NY,NX)=0.0 + TMGOHS(L,NY,NX)=0.0 + TMGCHS(L,NY,NX)=0.0 + TMGHHS(L,NY,NX)=0.0 + TMGSHS(L,NY,NX)=0.0 + TNACHS(L,NY,NX)=0.0 + TNASHS(L,NY,NX)=0.0 + TKASHS(L,NY,NX)=0.0 + TH0PHS(L,NY,NX)=0.0 + TH1PHS(L,NY,NX)=0.0 + TH3PHS(L,NY,NX)=0.0 + TF1PHS(L,NY,NX)=0.0 + TF2PHS(L,NY,NX)=0.0 + TC0PHS(L,NY,NX)=0.0 + TC1PHS(L,NY,NX)=0.0 + TC2PHS(L,NY,NX)=0.0 + TM1PHS(L,NY,NX)=0.0 + TH0BHB(L,NY,NX)=0.0 + TH1BHB(L,NY,NX)=0.0 + TH3BHB(L,NY,NX)=0.0 + TF1BHB(L,NY,NX)=0.0 + TF2BHB(L,NY,NX)=0.0 + TC0BHB(L,NY,NX)=0.0 + TC1BHB(L,NY,NX)=0.0 + TC2BHB(L,NY,NX)=0.0 + TM1BHB(L,NY,NX)=0.0 + ENDIF + N1=NX + N2=NY + N3=L + DO 8580 N=1,3 + IF(N.EQ.1)THEN + N4=NX+1 + N5=NY + N6=L + ELSEIF(N.EQ.2)THEN + N4=NX + N5=NY+1 + N6=L + ELSEIF(N.EQ.3)THEN + N4=NX + N5=NY + N6=L+1 + ENDIF +C +C TOTAL FLUXES FROM OVERLAND FLOW +C + IF(L.EQ.NU(N2,N1).AND.N.NE.3)THEN + TQR(N2,N1)=TQR(N2,N1)+QR(N,N2,N1)-QR(N,N5,N4) + THQR(N2,N1)=THQR(N2,N1)+HQR(N,N2,N1)-HQR(N,N5,N4) + TQS(N2,N1)=TQS(N2,N1)+QS(N,N2,N1)-QS(N,N5,N4) + TQW(N2,N1)=TQW(N2,N1)+QW(N,N2,N1)-QW(N,N5,N4) + TQI(N2,N1)=TQI(N2,N1)+QI(N,N2,N1)-QI(N,N5,N4) + THQS(N2,N1)=THQS(N2,N1)+HQS(N,N2,N1)-HQS(N,N5,N4) + DO 8590 K=0,2 + TOCQRS(K,N2,N1)=TOCQRS(K,N2,N1)+XOCQRS(K,N,N2,N1) + 2-XOCQRS(K,N,N5,N4) + TONQRS(K,N2,N1)=TONQRS(K,N2,N1)+XONQRS(K,N,N2,N1) + 2-XONQRS(K,N,N5,N4) + TOPQRS(K,N2,N1)=TOPQRS(K,N2,N1)+XOPQRS(K,N,N2,N1) + 2-XOPQRS(K,N,N5,N4) + TOAQRS(K,N2,N1)=TOAQRS(K,N2,N1)+XOAQRS(K,N,N2,N1) + 2-XOAQRS(K,N,N5,N4) +8590 CONTINUE + TCOQRS(N2,N1)=TCOQRS(N2,N1)+XCOQRS(N,N2,N1)-XCOQRS(N,N5,N4) + TCHQRS(N2,N1)=TCHQRS(N2,N1)+XCHQRS(N,N2,N1)-XCHQRS(N,N5,N4) + TOXQRS(N2,N1)=TOXQRS(N2,N1)+XOXQRS(N,N2,N1)-XOXQRS(N,N5,N4) + TNGQRS(N2,N1)=TNGQRS(N2,N1)+XNGQRS(N,N2,N1)-XNGQRS(N,N5,N4) + TN2QRS(N2,N1)=TN2QRS(N2,N1)+XN2QRS(N,N2,N1)-XN2QRS(N,N5,N4) + THGQRS(N2,N1)=THGQRS(N2,N1)+XHGQRS(N,N2,N1)-XHGQRS(N,N5,N4) + TN4QRS(N2,N1)=TN4QRS(N2,N1)+XN4QRW(N,N2,N1)-XN4QRW(N,N5,N4) + TN3QRS(N2,N1)=TN3QRS(N2,N1)+XN3QRW(N,N2,N1)-XN3QRW(N,N5,N4) + TNOQRS(N2,N1)=TNOQRS(N2,N1)+XNOQRW(N,N2,N1)-XNOQRW(N,N5,N4) + TNXQRS(N2,N1)=TNXQRS(N2,N1)+XNXQRS(N,N2,N1)-XNXQRS(N,N5,N4) + TPOQRS(N2,N1)=TPOQRS(N2,N1)+XP4QRW(N,N2,N1)-XP4QRW(N,N5,N4) + TCOQSS(N2,N1)=TCOQSS(N2,N1)+XCOQSS(N,N2,N1)-XCOQSS(N,N5,N4) + TCHQSS(N2,N1)=TCHQSS(N2,N1)+XCHQSS(N,N2,N1)-XCHQSS(N,N5,N4) + TOXQSS(N2,N1)=TOXQSS(N2,N1)+XOXQSS(N,N2,N1)-XOXQSS(N,N5,N4) + TNGQSS(N2,N1)=TNGQSS(N2,N1)+XNGQSS(N,N2,N1)-XNGQSS(N,N5,N4) + TN2QSS(N2,N1)=TN2QSS(N2,N1)+XN2QSS(N,N2,N1)-XN2QSS(N,N5,N4) + TN4QSS(N2,N1)=TN4QSS(N2,N1)+XN4QSS(N,N2,N1)-XN4QSS(N,N5,N4) + TN3QSS(N2,N1)=TN3QSS(N2,N1)+XN3QSS(N,N2,N1)-XN3QSS(N,N5,N4) + TNOQSS(N2,N1)=TNOQSS(N2,N1)+XNOQSS(N,N2,N1)-XNOQSS(N,N5,N4) + TPOQSS(N2,N1)=TPOQSS(N2,N1)+XP4QSS(N,N2,N1)-XP4QSS(N,N5,N4) + IF(ISALT(NY,NX).NE.0)THEN + TQRAL(N2,N1)=TQRAL(N2,N1)+XQRAL(N,N2,N1)-XQRAL(N,N5,N4) + TQRFE(N2,N1)=TQRFE(N2,N1)+XQRFE(N,N2,N1)-XQRFE(N,N5,N4) + TQRHY(N2,N1)=TQRHY(N2,N1)+XQRHY(N,N2,N1)-XQRHY(N,N5,N4) + TQRCA(N2,N1)=TQRCA(N2,N1)+XQRCA(N,N2,N1)-XQRCA(N,N5,N4) + TQRMG(N2,N1)=TQRMG(N2,N1)+XQRMG(N,N2,N1)-XQRMG(N,N5,N4) + TQRNA(N2,N1)=TQRNA(N2,N1)+XQRNA(N,N2,N1)-XQRNA(N,N5,N4) + TQRKA(N2,N1)=TQRKA(N2,N1)+XQRKA(N,N2,N1)-XQRKA(N,N5,N4) + TQROH(N2,N1)=TQROH(N2,N1)+XQROH(N,N2,N1)-XQROH(N,N5,N4) + TQRSO(N2,N1)=TQRSO(N2,N1)+XQRSO(N,N2,N1)-XQRSO(N,N5,N4) + TQRCL(N2,N1)=TQRCL(N2,N1)+XQRCL(N,N2,N1)-XQRCL(N,N5,N4) + TQRC3(N2,N1)=TQRC3(N2,N1)+XQRC3(N,N2,N1)-XQRC3(N,N5,N4) + TQRHC(N2,N1)=TQRHC(N2,N1)+XQRHC(N,N2,N1)-XQRHC(N,N5,N4) + TQRAL1(N2,N1)=TQRAL1(N2,N1)+XQRAL1(N,N2,N1)-XQRAL1(N,N5,N4) + TQRAL2(N2,N1)=TQRAL2(N2,N1)+XQRAL2(N,N2,N1)-XQRAL2(N,N5,N4) + TQRAL3(N2,N1)=TQRAL3(N2,N1)+XQRAL3(N,N2,N1)-XQRAL3(N,N5,N4) + TQRAL4(N2,N1)=TQRAL4(N2,N1)+XQRAL4(N,N2,N1)-XQRAL4(N,N5,N4) + TQRALS(N2,N1)=TQRALS(N2,N1)+XQRALS(N,N2,N1)-XQRALS(N,N5,N4) + TQRFE1(N2,N1)=TQRFE1(N2,N1)+XQRFE1(N,N2,N1)-XQRFE1(N,N5,N4) + TQRFE2(N2,N1)=TQRFE2(N2,N1)+XQRFE2(N,N2,N1)-XQRFE2(N,N5,N4) + TQRFE3(N2,N1)=TQRFE3(N2,N1)+XQRFE3(N,N2,N1)-XQRFE3(N,N5,N4) + TQRFE4(N2,N1)=TQRFE4(N2,N1)+XQRFE4(N,N2,N1)-XQRFE4(N,N5,N4) + TQRFES(N2,N1)=TQRFES(N2,N1)+XQRFES(N,N2,N1)-XQRFES(N,N5,N4) + TQRCAO(N2,N1)=TQRCAO(N2,N1)+XQRCAO(N,N2,N1)-XQRCAO(N,N5,N4) + TQRCAC(N2,N1)=TQRCAC(N2,N1)+XQRCAC(N,N2,N1)-XQRCAC(N,N5,N4) + TQRCAH(N2,N1)=TQRCAH(N2,N1)+XQRCAH(N,N2,N1)-XQRCAH(N,N5,N4) + TQRCAS(N2,N1)=TQRCAS(N2,N1)+XQRCAS(N,N2,N1)-XQRCAS(N,N5,N4) + TQRMGO(N2,N1)=TQRMGO(N2,N1)+XQRMGO(N,N2,N1)-XQRMGO(N,N5,N4) + TQRMGC(N2,N1)=TQRMGC(N2,N1)+XQRMGC(N,N2,N1)-XQRMGC(N,N5,N4) + TQRMGH(N2,N1)=TQRMGH(N2,N1)+XQRMGH(N,N2,N1)-XQRMGH(N,N5,N4) + TQRMGS(N2,N1)=TQRMGS(N2,N1)+XQRMGS(N,N2,N1)-XQRMGS(N,N5,N4) + TQRNAC(N2,N1)=TQRNAC(N2,N1)+XQRNAC(N,N2,N1)-XQRNAC(N,N5,N4) + TQRNAS(N2,N1)=TQRNAS(N2,N1)+XQRNAS(N,N2,N1)-XQRNAS(N,N5,N4) + TQRKAS(N2,N1)=TQRKAS(N2,N1)+XQRKAS(N,N2,N1)-XQRKAS(N,N5,N4) + TQRH0P(N2,N1)=TQRH0P(N2,N1)+XQRH0P(N,N2,N1)-XQRH0P(N,N5,N4) + TQRH1P(N2,N1)=TQRH1P(N2,N1)+XQRH1P(N,N2,N1)-XQRH1P(N,N5,N4) + TQRH3P(N2,N1)=TQRH3P(N2,N1)+XQRH3P(N,N2,N1)-XQRH3P(N,N5,N4) + TQRF1P(N2,N1)=TQRF1P(N2,N1)+XQRF1P(N,N2,N1)-XQRF1P(N,N5,N4) + TQRF2P(N2,N1)=TQRF2P(N2,N1)+XQRF2P(N,N2,N1)-XQRF2P(N,N5,N4) + TQRC0P(N2,N1)=TQRC0P(N2,N1)+XQRC0P(N,N2,N1)-XQRC0P(N,N5,N4) + TQRC1P(N2,N1)=TQRC1P(N2,N1)+XQRC1P(N,N2,N1)-XQRC1P(N,N5,N4) + TQRC2P(N2,N1)=TQRC2P(N2,N1)+XQRC2P(N,N2,N1)-XQRC2P(N,N5,N4) + TQRM1P(N2,N1)=TQRM1P(N2,N1)+XQRM1P(N,N2,N1)-XQRM1P(N,N5,N4) + TQSAL(N2,N1)=TQSAL(N2,N1)+XQSAL(N,N2,N1)-XQSAL(N,N5,N4) + TQSFE(N2,N1)=TQSFE(N2,N1)+XQSFE(N,N2,N1)-XQSFE(N,N5,N4) + TQSHY(N2,N1)=TQSHY(N2,N1)+XQSHY(N,N2,N1)-XQSHY(N,N5,N4) + TQSCA(N2,N1)=TQSCA(N2,N1)+XQSCA(N,N2,N1)-XQSCA(N,N5,N4) + TQSMG(N2,N1)=TQSMG(N2,N1)+XQSMG(N,N2,N1)-XQSMG(N,N5,N4) + TQSNA(N2,N1)=TQSNA(N2,N1)+XQSNA(N,N2,N1)-XQSNA(N,N5,N4) + TQSKA(N2,N1)=TQSKA(N2,N1)+XQSKA(N,N2,N1)-XQSKA(N,N5,N4) + TQSOH(N2,N1)=TQSOH(N2,N1)+XQSOH(N,N2,N1)-XQSOH(N,N5,N4) + TQSSO(N2,N1)=TQSSO(N2,N1)+XQSSO(N,N2,N1)-XQSSO(N,N5,N4) + TQSCL(N2,N1)=TQSCL(N2,N1)+XQSCL(N,N2,N1)-XQSCL(N,N5,N4) + TQSC3(N2,N1)=TQSC3(N2,N1)+XQSC3(N,N2,N1)-XQSC3(N,N5,N4) + TQSHC(N2,N1)=TQSHC(N2,N1)+XQSHC(N,N2,N1)-XQSHC(N,N5,N4) + TQSAL1(N2,N1)=TQSAL1(N2,N1)+XQSAL1(N,N2,N1)-XQSAL1(N,N5,N4) + TQSAL2(N2,N1)=TQSAL2(N2,N1)+XQSAL2(N,N2,N1)-XQSAL2(N,N5,N4) + TQSAL3(N2,N1)=TQSAL3(N2,N1)+XQSAL3(N,N2,N1)-XQSAL3(N,N5,N4) + TQSAL4(N2,N1)=TQSAL4(N2,N1)+XQSAL4(N,N2,N1)-XQSAL4(N,N5,N4) + TQSALS(N2,N1)=TQSALS(N2,N1)+XQSALS(N,N2,N1)-XQSALS(N,N5,N4) + TQSFE1(N2,N1)=TQSFE1(N2,N1)+XQSFE1(N,N2,N1)-XQSFE1(N,N5,N4) + TQSFE2(N2,N1)=TQSFE2(N2,N1)+XQSFE2(N,N2,N1)-XQSFE2(N,N5,N4) + TQSFE3(N2,N1)=TQSFE3(N2,N1)+XQSFE3(N,N2,N1)-XQSFE3(N,N5,N4) + TQSFE4(N2,N1)=TQSFE4(N2,N1)+XQSFE4(N,N2,N1)-XQSFE4(N,N5,N4) + TQSFES(N2,N1)=TQSFES(N2,N1)+XQSFES(N,N2,N1)-XQSFES(N,N5,N4) + TQSCAO(N2,N1)=TQSCAO(N2,N1)+XQSCAO(N,N2,N1)-XQSCAO(N,N5,N4) + TQSCAC(N2,N1)=TQSCAC(N2,N1)+XQSCAC(N,N2,N1)-XQSCAC(N,N5,N4) + TQSCAH(N2,N1)=TQSCAH(N2,N1)+XQSCAH(N,N2,N1)-XQSCAH(N,N5,N4) + TQSCAS(N2,N1)=TQSCAS(N2,N1)+XQSCAS(N,N2,N1)-XQSCAS(N,N5,N4) + TQSMGO(N2,N1)=TQSMGO(N2,N1)+XQSMGO(N,N2,N1)-XQSMGO(N,N5,N4) + TQSMGC(N2,N1)=TQSMGC(N2,N1)+XQSMGC(N,N2,N1)-XQSMGC(N,N5,N4) + TQSMGH(N2,N1)=TQSMGH(N2,N1)+XQSMGH(N,N2,N1)-XQSMGH(N,N5,N4) + TQSMGS(N2,N1)=TQSMGS(N2,N1)+XQSMGS(N,N2,N1)-XQSMGS(N,N5,N4) + TQSNAC(N2,N1)=TQSNAC(N2,N1)+XQSNAC(N,N2,N1)-XQSNAC(N,N5,N4) + TQSNAS(N2,N1)=TQSNAS(N2,N1)+XQSNAS(N,N2,N1)-XQSNAS(N,N5,N4) + TQSKAS(N2,N1)=TQSKAS(N2,N1)+XQSKAS(N,N2,N1)-XQSKAS(N,N5,N4) + TQSH0P(N2,N1)=TQSH0P(N2,N1)+XQSH0P(N,N2,N1)-XQSH0P(N,N5,N4) + TQSH1P(N2,N1)=TQSH1P(N2,N1)+XQSH1P(N,N2,N1)-XQSH1P(N,N5,N4) + TQSH3P(N2,N1)=TQSH3P(N2,N1)+XQSH3P(N,N2,N1)-XQSH3P(N,N5,N4) + TQSF1P(N2,N1)=TQSF1P(N2,N1)+XQSF1P(N,N2,N1)-XQSF1P(N,N5,N4) + TQSF2P(N2,N1)=TQSF2P(N2,N1)+XQSF2P(N,N2,N1)-XQSF2P(N,N5,N4) + TQSC0P(N2,N1)=TQSC0P(N2,N1)+XQSC0P(N,N2,N1)-XQSC0P(N,N5,N4) + TQSC1P(N2,N1)=TQSC1P(N2,N1)+XQSC1P(N,N2,N1)-XQSC1P(N,N5,N4) + TQSC2P(N2,N1)=TQSC2P(N2,N1)+XQSC2P(N,N2,N1)-XQSC2P(N,N5,N4) + TQSM1P(N2,N1)=TQSM1P(N2,N1)+XQSM1P(N,N2,N1)-XQSM1P(N,N5,N4) + ENDIF +C +C TOTAL FLUXES FROM SEDIMENT TRANSPORT +C + IF(IERSN(NY,NX).NE.0)THEN + TSEDER(N2,N1)=TSEDER(N2,N1)+XSEDER(N,N2,N1)-XSEDER(N,N5,N4) + TSANER(N2,N1)=TSANER(N2,N1)+XSANER(N,N2,N1)-XSANER(N,N5,N4) + TSILER(N2,N1)=TSILER(N2,N1)+XSILER(N,N2,N1)-XSILER(N,N5,N4) + TCLAER(N2,N1)=TCLAER(N2,N1)+XCLAER(N,N2,N1)-XCLAER(N,N5,N4) + TCECER(N2,N1)=TCECER(N2,N1)+XCECER(N,N2,N1)-XCECER(N,N5,N4) + TAECER(N2,N1)=TAECER(N2,N1)+XAECER(N,N2,N1)-XAECER(N,N5,N4) + TNH4ER(N2,N1)=TNH4ER(N2,N1)+XNH4ER(N,N2,N1)-XNH4ER(N,N5,N4) + TNH3ER(N2,N1)=TNH3ER(N2,N1)+XNH3ER(N,N2,N1)-XNH3ER(N,N5,N4) + TNHUER(N2,N1)=TNHUER(N2,N1)+XNHUER(N,N2,N1)-XNHUER(N,N5,N4) + TNO3ER(N2,N1)=TNO3ER(N2,N1)+XNO3ER(N,N2,N1)-XNO3ER(N,N5,N4) + TNH4EB(N2,N1)=TNH4EB(N2,N1)+XNH4EB(N,N2,N1)-XNH4EB(N,N5,N4) + TNH3EB(N2,N1)=TNH3EB(N2,N1)+XNH3EB(N,N2,N1)-XNH3EB(N,N5,N4) + TNHUEB(N2,N1)=TNHUEB(N2,N1)+XNHUEB(N,N2,N1)-XNHUEB(N,N5,N4) + TNO3EB(N2,N1)=TNO3EB(N2,N1)+XNO3EB(N,N2,N1)-XNO3EB(N,N5,N4) + TN4ER(N2,N1)=TN4ER(N2,N1)+XN4ER(N,N2,N1)-XN4ER(N,N5,N4) + TNBER(N2,N1)=TNBER(N2,N1)+XNBER(N,N2,N1)-XNBER(N,N5,N4) + THYER(N2,N1)=THYER(N2,N1)+XHYER(N,N2,N1)-XHYER(N,N5,N4) + TALER(N2,N1)=TALER(N2,N1)+XALER(N,N2,N1)-XALER(N,N5,N4) + TCAER(N2,N1)=TCAER(N2,N1)+XCAER(N,N2,N1)-XCAER(N,N5,N4) + TMGER(N2,N1)=TMGER(N2,N1)+XMGER(N,N2,N1)-XMGER(N,N5,N4) + TNAER(N2,N1)=TNAER(N2,N1)+XNAER(N,N2,N1)-XNAER(N,N5,N4) + TKAER(N2,N1)=TKAER(N2,N1)+XKAER(N,N2,N1)-XKAER(N,N5,N4) + THCER(N2,N1)=THCER(N2,N1)+XHCER(N,N2,N1)-XHCER(N,N5,N4) + TAL2ER(N2,N1)=TAL2ER(N2,N1)+XAL2ER(N,N2,N1)-XAL2ER(N,N5,N4) + TOH0ER(N2,N1)=TOH0ER(N2,N1)+XOH0ER(N,N2,N1)-XOH0ER(N,N5,N4) + TOH1ER(N2,N1)=TOH1ER(N2,N1)+XOH1ER(N,N2,N1)-XOH1ER(N,N5,N4) + TOH2ER(N2,N1)=TOH2ER(N2,N1)+XOH2ER(N,N2,N1)-XOH2ER(N,N5,N4) + TH1PER(N2,N1)=TH1PER(N2,N1)+XH1PER(N,N2,N1)-XH1PER(N,N5,N4) + TH2PER(N2,N1)=TH2PER(N2,N1)+XH2PER(N,N2,N1)-XH2PER(N,N5,N4) + TOH0EB(N2,N1)=TOH0EB(N2,N1)+XOH0EB(N,N2,N1)-XOH0EB(N,N5,N4) + TOH1EB(N2,N1)=TOH1EB(N2,N1)+XOH1EB(N,N2,N1)-XOH1EB(N,N5,N4) + TOH2EB(N2,N1)=TOH2EB(N2,N1)+XOH2EB(N,N2,N1)-XOH2EB(N,N5,N4) + TH1PEB(N2,N1)=TH1PEB(N2,N1)+XH1PEB(N,N2,N1)-XH1PEB(N,N5,N4) + TH2PEB(N2,N1)=TH2PEB(N2,N1)+XH2PEB(N,N2,N1)-XH2PEB(N,N5,N4) + TALOER(N2,N1)=TALOER(N2,N1)+PALOER(N,N2,N1)-PALOER(N,N5,N4) + TFEOER(N2,N1)=TFEOER(N2,N1)+PFEOER(N,N2,N1)-PFEOER(N,N5,N4) + TCACER(N2,N1)=TCACER(N2,N1)+PCACER(N,N2,N1)-PCACER(N,N5,N4) + TCASER(N2,N1)=TCASER(N2,N1)+PCASER(N,N2,N1)-PCASER(N,N5,N4) + TALPER(N2,N1)=TALPER(N2,N1)+PALPER(N,N2,N1)-PALPER(N,N5,N4) + TFEPER(N2,N1)=TFEPER(N2,N1)+PFEPER(N,N2,N1)-PFEPER(N,N5,N4) + TCPDER(N2,N1)=TCPDER(N2,N1)+PCPDER(N,N2,N1)-PCPDER(N,N5,N4) + TCPHER(N2,N1)=TCPHER(N2,N1)+PCPHER(N,N2,N1)-PCPHER(N,N5,N4) + TCPMER(N2,N1)=TCPMER(N2,N1)+PCPMER(N,N2,N1)-PCPMER(N,N5,N4) + TALPEB(N2,N1)=TALPEB(N2,N1)+PALPEB(N,N2,N1)-PALPEB(N,N5,N4) + TFEPEB(N2,N1)=TFEPEB(N2,N1)+PFEPEB(N,N2,N1)-PFEPEB(N,N5,N4) + TCPDEB(N2,N1)=TCPDEB(N2,N1)+PCPDEB(N,N2,N1)-PCPDEB(N,N5,N4) + TCPHEB(N2,N1)=TCPHEB(N2,N1)+PCPHEB(N,N2,N1)-PCPHEB(N,N5,N4) + TCPMEB(N2,N1)=TCPMEB(N2,N1)+PCPMEB(N,N2,N1)-PCPMEB(N,N5,N4) + DO 9380 K=0,5 + DO 9380 NN=1,7 + TOMCER(3,NN,K,N2,N1)=TOMCER(3,NN,K,N2,N1) + 2+OMCER(3,NN,K,N,N2,N1)-OMCER(3,NN,K,N,N5,N4) + DO 9380 M=1,2 + TOMCER(M,NN,K,N2,N1)=TOMCER(M,NN,K,N2,N1) + 2+OMCER(M,NN,K,N,N2,N1)-OMCER(M,NN,K,N,N5,N4) + TOMNER(M,NN,K,N2,N1)=TOMNER(M,NN,K,N2,N1) + 2+OMNER(M,NN,K,N,N2,N1)-OMNER(M,NN,K,N,N5,N4) + TOMPER(M,NN,K,N2,N1)=TOMPER(M,NN,K,N2,N1) + 2+OMPER(M,NN,K,N,N2,N1)-OMPER(M,NN,K,N,N5,N4) +9380 CONTINUE + DO 9375 K=0,4 + DO 9370 M=1,2 + TORCER(M,K,N2,N1)=TORCER(M,K,N2,N1) + 2+ORCER(M,K,N,N2,N1)-ORCER(M,K,N,N5,N4) + TORNER(M,K,N2,N1)=TORNER(M,K,N2,N1) + 2+ORNER(M,K,N,N2,N1)-ORNER(M,K,N,N5,N4) + TORPER(M,K,N2,N1)=TORPER(M,K,N2,N1) + 2+ORPER(M,K,N,N2,N1)-ORPER(M,K,N,N5,N4) +9370 CONTINUE + TOHCER(K,N2,N1)=TOHCER(K,N2,N1) + 2+OHCER(K,N,N2,N1)-OHCER(K,N,N5,N4) + TOHNER(K,N2,N1)=TOHNER(K,N2,N1) + 2+OHNER(K,N,N2,N1)-OHNER(K,N,N5,N4) + TOHPER(K,N2,N1)=TOHPER(K,N2,N1) + 2+OHPER(K,N,N2,N1)-OHPER(K,N,N5,N4) + DO 9365 M=1,4 + TOSCER(M,K,N2,N1)=TOSCER(M,K,N2,N1) + 2+OSCER(M,K,N,N2,N1)-OSCER(M,K,N,N5,N4) + TOSAER(M,K,N2,N1)=TOSAER(M,K,N2,N1) + 2+OSAER(M,K,N,N2,N1)-OSAER(M,K,N,N5,N4) + TOSNER(M,K,N2,N1)=TOSNER(M,K,N2,N1) + 2+OSNER(M,K,N,N2,N1)-OSNER(M,K,N,N5,N4) + TOSPER(M,K,N2,N1)=TOSPER(M,K,N2,N1) + 2+OSPER(M,K,N,N2,N1)-OSPER(M,K,N,N5,N4) +9365 CONTINUE +9375 CONTINUE + ENDIF + ENDIF +C +C TOTAL HEAT, WATER, GAS AND SOLUTE FLUXES BETWEEN ADJACENT +C GRID CELLS +C + IF(NCN(N2,N1).NE.3.OR.N.EQ.3)THEN + TTHAW(N3,N2,N1)=TTHAW(N3,N2,N1)+THAW(N,N3,N2,N1) + TTHAWH(N3,N2,N1)=TTHAWH(N3,N2,N1)+THAWH(N,N3,N2,N1) + THTHAW(N3,N2,N1)=THTHAW(N3,N2,N1)+HTHAW(N,N3,N2,N1) + TFLW(N3,N2,N1)=TFLW(N3,N2,N1)+FLW(N,N3,N2,N1)-FLW(N,N6,N5,N4) + TFLWX(N3,N2,N1)=TFLWX(N3,N2,N1)+FLWX(N,N3,N2,N1)-FLWX(N,N6,N5,N4) + TFLWH(N3,N2,N1)=TFLWH(N3,N2,N1)+FLWH(N,N3,N2,N1)-FLWH(N,N6,N5,N4) + THFLW(N3,N2,N1)=THFLW(N3,N2,N1)+HFLW(N,N3,N2,N1)-HFLW(N,N6,N5,N4) + DO 8585 K=0,4 + TOCFLS(K,N3,N2,N1)=TOCFLS(K,N3,N2,N1)+XOCFLS(K,N,N3,N2,N1) + 2-XOCFLS(K,N,N6,N5,N4) + TONFLS(K,N3,N2,N1)=TONFLS(K,N3,N2,N1)+XONFLS(K,N,N3,N2,N1) + 2-XONFLS(K,N,N6,N5,N4) + TOPFLS(K,N3,N2,N1)=TOPFLS(K,N3,N2,N1)+XOPFLS(K,N,N3,N2,N1) + 2-XOPFLS(K,N,N6,N5,N4) + TOAFLS(K,N3,N2,N1)=TOAFLS(K,N3,N2,N1)+XOAFLS(K,N,N3,N2,N1) + 2-XOAFLS(K,N,N6,N5,N4) + TOCFHS(K,N3,N2,N1)=TOCFHS(K,N3,N2,N1)+XOCFHS(K,N,N3,N2,N1) + 2-XOCFHS(K,N,N6,N5,N4) + TONFHS(K,N3,N2,N1)=TONFHS(K,N3,N2,N1)+XONFHS(K,N,N3,N2,N1) + 2-XONFHS(K,N,N6,N5,N4) + TOPFHS(K,N3,N2,N1)=TOPFHS(K,N3,N2,N1)+XOPFHS(K,N,N3,N2,N1) + 2-XOPFHS(K,N,N6,N5,N4) + TOAFHS(K,N3,N2,N1)=TOAFHS(K,N3,N2,N1)+XOAFHS(K,N,N3,N2,N1) + 2-XOAFHS(K,N,N6,N5,N4) +8585 CONTINUE + TCOFLS(N3,N2,N1)=TCOFLS(N3,N2,N1)+XCOFLS(N,N3,N2,N1) + 2-XCOFLS(N,N6,N5,N4) + TCHFLS(N3,N2,N1)=TCHFLS(N3,N2,N1)+XCHFLS(N,N3,N2,N1) + 2-XCHFLS(N,N6,N5,N4) + TOXFLS(N3,N2,N1)=TOXFLS(N3,N2,N1)+XOXFLS(N,N3,N2,N1) + 2-XOXFLS(N,N6,N5,N4) + TNGFLS(N3,N2,N1)=TNGFLS(N3,N2,N1)+XNGFLS(N,N3,N2,N1) + 2-XNGFLS(N,N6,N5,N4) + TN2FLS(N3,N2,N1)=TN2FLS(N3,N2,N1)+XN2FLS(N,N3,N2,N1) + 2-XN2FLS(N,N6,N5,N4) + THGFLS(N3,N2,N1)=THGFLS(N3,N2,N1)+XHGFLS(N,N3,N2,N1) + 2-XHGFLS(N,N6,N5,N4) + TN4FLS(N3,N2,N1)=TN4FLS(N3,N2,N1)+XN4FLW(N,N3,N2,N1) + 2-XN4FLW(N,N6,N5,N4) + TN3FLS(N3,N2,N1)=TN3FLS(N3,N2,N1)+XN3FLW(N,N3,N2,N1) + 2-XN3FLW(N,N6,N5,N4) + TNOFLS(N3,N2,N1)=TNOFLS(N3,N2,N1)+XNOFLW(N,N3,N2,N1) + 2-XNOFLW(N,N6,N5,N4) + TNXFLS(N3,N2,N1)=TNXFLS(N3,N2,N1)+XNXFLS(N,N3,N2,N1) + 2-XNXFLS(N,N6,N5,N4) + TPOFLS(N3,N2,N1)=TPOFLS(N3,N2,N1)+XH2PFS(N,N3,N2,N1) + 2-XH2PFS(N,N6,N5,N4) + TN4FLB(N3,N2,N1)=TN4FLB(N3,N2,N1)+XN4FLB(N,N3,N2,N1) + 2-XN4FLB(N,N6,N5,N4) + TN3FLB(N3,N2,N1)=TN3FLB(N3,N2,N1)+XN3FLB(N,N3,N2,N1) + 2-XN3FLB(N,N6,N5,N4) + TNOFLB(N3,N2,N1)=TNOFLB(N3,N2,N1)+XNOFLB(N,N3,N2,N1) + 2-XNOFLB(N,N6,N5,N4) + TNXFLB(N3,N2,N1)=TNXFLB(N3,N2,N1)+XNXFLB(N,N3,N2,N1) + 2-XNXFLB(N,N6,N5,N4) + TH2BFB(N3,N2,N1)=TH2BFB(N3,N2,N1)+XH2BFB(N,N3,N2,N1) + 2-XH2BFB(N,N6,N5,N4) + TCOFHS(N3,N2,N1)=TCOFHS(N3,N2,N1)+XCOFHS(N,N3,N2,N1) + 2-XCOFHS(N,N6,N5,N4) + TCHFHS(N3,N2,N1)=TCHFHS(N3,N2,N1)+XCHFHS(N,N3,N2,N1) + 2-XCHFHS(N,N6,N5,N4) + TOXFHS(N3,N2,N1)=TOXFHS(N3,N2,N1)+XOXFHS(N,N3,N2,N1) + 2-XOXFHS(N,N6,N5,N4) + TNGFHS(N3,N2,N1)=TNGFHS(N3,N2,N1)+XNGFHS(N,N3,N2,N1) + 2-XNGFHS(N,N6,N5,N4) + TN2FHS(N3,N2,N1)=TN2FHS(N3,N2,N1)+XN2FHS(N,N3,N2,N1) + 2-XN2FHS(N,N6,N5,N4) + THGFHS(N3,N2,N1)=THGFHS(N3,N2,N1)+XHGFHS(N,N3,N2,N1) + 2-XHGFHS(N,N6,N5,N4) + TN4FHS(N3,N2,N1)=TN4FHS(N3,N2,N1)+XN4FHW(N,N3,N2,N1) + 2-XN4FHW(N,N6,N5,N4) + TN3FHS(N3,N2,N1)=TN3FHS(N3,N2,N1)+XN3FHW(N,N3,N2,N1) + 2-XN3FHW(N,N6,N5,N4) + TNOFHS(N3,N2,N1)=TNOFHS(N3,N2,N1)+XNOFHW(N,N3,N2,N1) + 2-XNOFHW(N,N6,N5,N4) + TNXFHS(N3,N2,N1)=TNXFHS(N3,N2,N1)+XNXFHS(N,N3,N2,N1) + 2-XNXFHS(N,N6,N5,N4) + TPOFHS(N3,N2,N1)=TPOFHS(N3,N2,N1)+XH2PHS(N,N3,N2,N1) + 2-XH2PHS(N,N6,N5,N4) + TN4FHB(N3,N2,N1)=TN4FHB(N3,N2,N1)+XN4FHB(N,N3,N2,N1) + 2-XN4FHB(N,N6,N5,N4) + TN3FHB(N3,N2,N1)=TN3FHB(N3,N2,N1)+XN3FHB(N,N3,N2,N1) + 2-XN3FHB(N,N6,N5,N4) + TNOFHB(N3,N2,N1)=TNOFHB(N3,N2,N1)+XNOFHB(N,N3,N2,N1) + 2-XNOFHB(N,N6,N5,N4) + TNXFHB(N3,N2,N1)=TNXFHB(N3,N2,N1)+XNXFHB(N,N3,N2,N1) + 2-XNXFHB(N,N6,N5,N4) + TH2BHB(N3,N2,N1)=TH2BHB(N3,N2,N1)+XH2BHB(N,N3,N2,N1) + 2-XH2BHB(N,N6,N5,N4) + TCOFLG(N3,N2,N1)=TCOFLG(N3,N2,N1)+XCOFLG(N,N3,N2,N1) + 2-XCOFLG(N,N6,N5,N4) + TCHFLG(N3,N2,N1)=TCHFLG(N3,N2,N1)+XCHFLG(N,N3,N2,N1) + 2-XCHFLG(N,N6,N5,N4) + TOXFLG(N3,N2,N1)=TOXFLG(N3,N2,N1)+XOXFLG(N,N3,N2,N1) + 2-XOXFLG(N,N6,N5,N4) + TNGFLG(N3,N2,N1)=TNGFLG(N3,N2,N1)+XNGFLG(N,N3,N2,N1) + 2-XNGFLG(N,N6,N5,N4) + TN2FLG(N3,N2,N1)=TN2FLG(N3,N2,N1)+XN2FLG(N,N3,N2,N1) + 2-XN2FLG(N,N6,N5,N4) + TNHFLG(N3,N2,N1)=TNHFLG(N3,N2,N1)+XN3FLG(N,N3,N2,N1) + 2-XN3FLG(N,N6,N5,N4) + THGFLG(N3,N2,N1)=THGFLG(N3,N2,N1)+XHGFLG(N,N3,N2,N1) + 2-XHGFLG(N,N6,N5,N4) + IF(ISALT(N2,N1).NE.0)THEN + TALFLS(N3,N2,N1)=TALFLS(N3,N2,N1)+XALFLS(N,N3,N2,N1) + 2-XALFLS(N,N6,N5,N4) + TFEFLS(N3,N2,N1)=TFEFLS(N3,N2,N1)+XFEFLS(N,N3,N2,N1) + 2-XFEFLS(N,N6,N5,N4) + THYFLS(N3,N2,N1)=THYFLS(N3,N2,N1)+XHYFLS(N,N3,N2,N1) + 2-XHYFLS(N,N6,N5,N4) + TCAFLS(N3,N2,N1)=TCAFLS(N3,N2,N1)+XCAFLS(N,N3,N2,N1) + 2-XCAFLS(N,N6,N5,N4) + TMGFLS(N3,N2,N1)=TMGFLS(N3,N2,N1)+XMGFLS(N,N3,N2,N1) + 2-XMGFLS(N,N6,N5,N4) + TNAFLS(N3,N2,N1)=TNAFLS(N3,N2,N1)+XNAFLS(N,N3,N2,N1) + 2-XNAFLS(N,N6,N5,N4) + TKAFLS(N3,N2,N1)=TKAFLS(N3,N2,N1)+XKAFLS(N,N3,N2,N1) + 2-XKAFLS(N,N6,N5,N4) + TOHFLS(N3,N2,N1)=TOHFLS(N3,N2,N1)+XOHFLS(N,N3,N2,N1) + 2-XOHFLS(N,N6,N5,N4) + TSOFLS(N3,N2,N1)=TSOFLS(N3,N2,N1)+XSOFLS(N,N3,N2,N1) + 2-XSOFLS(N,N6,N5,N4) + TCLFLS(N3,N2,N1)=TCLFLS(N3,N2,N1)+XCLFLS(N,N3,N2,N1) + 2-XCLFLS(N,N6,N5,N4) + TC3FLS(N3,N2,N1)=TC3FLS(N3,N2,N1)+XC3FLS(N,N3,N2,N1) + 2-XC3FLS(N,N6,N5,N4) + THCFLS(N3,N2,N1)=THCFLS(N3,N2,N1)+XHCFLS(N,N3,N2,N1) + 2-XHCFLS(N,N6,N5,N4) + TAL1FS(N3,N2,N1)=TAL1FS(N3,N2,N1)+XAL1FS(N,N3,N2,N1) + 2-XAL1FS(N,N6,N5,N4) + TAL2FS(N3,N2,N1)=TAL2FS(N3,N2,N1)+XAL2FS(N,N3,N2,N1) + 2-XAL2FS(N,N6,N5,N4) + TAL3FS(N3,N2,N1)=TAL3FS(N3,N2,N1)+XAL3FS(N,N3,N2,N1) + 2-XAL3FS(N,N6,N5,N4) + TAL4FS(N3,N2,N1)=TAL4FS(N3,N2,N1)+XAL4FS(N,N3,N2,N1) + 2-XAL4FS(N,N6,N5,N4) + TALSFS(N3,N2,N1)=TALSFS(N3,N2,N1)+XALSFS(N,N3,N2,N1) + 2-XALSFS(N,N6,N5,N4) + TFE1FS(N3,N2,N1)=TFE1FS(N3,N2,N1)+XFE1FS(N,N3,N2,N1) + 2-XFE1FS(N,N6,N5,N4) + TFE2FS(N3,N2,N1)=TFE2FS(N3,N2,N1)+XFE2FS(N,N3,N2,N1) + 2-XFE2FS(N,N6,N5,N4) + TFE3FS(N3,N2,N1)=TFE3FS(N3,N2,N1)+XFE3FS(N,N3,N2,N1) + 2-XFE3FS(N,N6,N5,N4) + TFE4FS(N3,N2,N1)=TFE4FS(N3,N2,N1)+XFE4FS(N,N3,N2,N1) + 2-XFE4FS(N,N6,N5,N4) + TFESFS(N3,N2,N1)=TFESFS(N3,N2,N1)+XFESFS(N,N3,N2,N1) + 2-XFESFS(N,N6,N5,N4) + TCAOFS(N3,N2,N1)=TCAOFS(N3,N2,N1)+XCAOFS(N,N3,N2,N1) + 2-XCAOFS(N,N6,N5,N4) + TCACFS(N3,N2,N1)=TCACFS(N3,N2,N1)+XCACFS(N,N3,N2,N1) + 2-XCACFS(N,N6,N5,N4) + TCAHFS(N3,N2,N1)=TCAHFS(N3,N2,N1)+XCAHFS(N,N3,N2,N1) + 2-XCAHFS(N,N6,N5,N4) + TCASFS(N3,N2,N1)=TCASFS(N3,N2,N1)+XCASFS(N,N3,N2,N1) + 2-XCASFS(N,N6,N5,N4) + TMGOFS(N3,N2,N1)=TMGOFS(N3,N2,N1)+XMGOFS(N,N3,N2,N1) + 2-XMGOFS(N,N6,N5,N4) + TMGCFS(N3,N2,N1)=TMGCFS(N3,N2,N1)+XMGCFS(N,N3,N2,N1) + 2-XMGCFS(N,N6,N5,N4) + TMGHFS(N3,N2,N1)=TMGHFS(N3,N2,N1)+XMGHFS(N,N3,N2,N1) + 2-XMGHFS(N,N6,N5,N4) + TMGSFS(N3,N2,N1)=TMGSFS(N3,N2,N1)+XMGSFS(N,N3,N2,N1) + 2-XMGSFS(N,N6,N5,N4) + TNACFS(N3,N2,N1)=TNACFS(N3,N2,N1)+XNACFS(N,N3,N2,N1) + 2-XNACFS(N,N6,N5,N4) + TNASFS(N3,N2,N1)=TNASFS(N3,N2,N1)+XNASFS(N,N3,N2,N1) + 2-XNASFS(N,N6,N5,N4) + TKASFS(N3,N2,N1)=TKASFS(N3,N2,N1)+XKASFS(N,N3,N2,N1) + 2-XKASFS(N,N6,N5,N4) + TH0PFS(N3,N2,N1)=TH0PFS(N3,N2,N1)+XH0PFS(N,N3,N2,N1) + 2-XH0PFS(N,N6,N5,N4) + TH1PFS(N3,N2,N1)=TH1PFS(N3,N2,N1)+XH1PFS(N,N3,N2,N1) + 2-XH1PFS(N,N6,N5,N4) + TH3PFS(N3,N2,N1)=TH3PFS(N3,N2,N1)+XH3PFS(N,N3,N2,N1) + 2-XH3PFS(N,N6,N5,N4) + TF1PFS(N3,N2,N1)=TF1PFS(N3,N2,N1)+XF1PFS(N,N3,N2,N1) + 2-XF1PFS(N,N6,N5,N4) + TF2PFS(N3,N2,N1)=TF2PFS(N3,N2,N1)+XF2PFS(N,N3,N2,N1) + 2-XF2PFS(N,N6,N5,N4) + TC0PFS(N3,N2,N1)=TC0PFS(N3,N2,N1)+XC0PFS(N,N3,N2,N1) + 2-XC0PFS(N,N6,N5,N4) + TC1PFS(N3,N2,N1)=TC1PFS(N3,N2,N1)+XC1PFS(N,N3,N2,N1) + 2-XC1PFS(N,N6,N5,N4) + TC2PFS(N3,N2,N1)=TC2PFS(N3,N2,N1)+XC2PFS(N,N3,N2,N1) + 2-XC2PFS(N,N6,N5,N4) + TM1PFS(N3,N2,N1)=TM1PFS(N3,N2,N1)+XM1PFS(N,N3,N2,N1) + 2-XM1PFS(N,N6,N5,N4) + TH0BFB(N3,N2,N1)=TH0BFB(N3,N2,N1)+XH0BFB(N,N3,N2,N1) + 2-XH0BFB(N,N6,N5,N4) + TH1BFB(N3,N2,N1)=TH1BFB(N3,N2,N1)+XH1BFB(N,N3,N2,N1) + 2-XH1BFB(N,N6,N5,N4) + TH3BFB(N3,N2,N1)=TH3BFB(N3,N2,N1)+XH3BFB(N,N3,N2,N1) + 2-XH3BFB(N,N6,N5,N4) + TF1BFB(N3,N2,N1)=TF1BFB(N3,N2,N1)+XF1BFB(N,N3,N2,N1) + 2-XF1BFB(N,N6,N5,N4) + TF2BFB(N3,N2,N1)=TF2BFB(N3,N2,N1)+XF2BFB(N,N3,N2,N1) + 2-XF2BFB(N,N6,N5,N4) + TC0BFB(N3,N2,N1)=TC0BFB(N3,N2,N1)+XC0BFB(N,N3,N2,N1) + 2-XC0BFB(N,N6,N5,N4) + TC1BFB(N3,N2,N1)=TC1BFB(N3,N2,N1)+XC1BFB(N,N3,N2,N1) + 2-XC1BFB(N,N6,N5,N4) + TC2BFB(N3,N2,N1)=TC2BFB(N3,N2,N1)+XC2BFB(N,N3,N2,N1) + 2-XC2BFB(N,N6,N5,N4) + TM1BFB(N3,N2,N1)=TM1BFB(N3,N2,N1)+XM1BFB(N,N3,N2,N1) + 2-XM1BFB(N,N6,N5,N4) + TALFHS(N3,N2,N1)=TALFHS(N3,N2,N1)+XALFHS(N,N3,N2,N1) + 2-XALFHS(N,N6,N5,N4) + TFEFHS(N3,N2,N1)=TFEFHS(N3,N2,N1)+XFEFHS(N,N3,N2,N1) + 2-XFEFHS(N,N6,N5,N4) + THYFHS(N3,N2,N1)=THYFHS(N3,N2,N1)+XHYFHS(N,N3,N2,N1) + 2-XHYFHS(N,N6,N5,N4) + TCAFHS(N3,N2,N1)=TCAFHS(N3,N2,N1)+XCAFHS(N,N3,N2,N1) + 2-XCAFHS(N,N6,N5,N4) + TMGFHS(N3,N2,N1)=TMGFHS(N3,N2,N1)+XMGFHS(N,N3,N2,N1) + 2-XMGFHS(N,N6,N5,N4) + TNAFHS(N3,N2,N1)=TNAFHS(N3,N2,N1)+XNAFHS(N,N3,N2,N1) + 2-XNAFHS(N,N6,N5,N4) + TKAFHS(N3,N2,N1)=TKAFHS(N3,N2,N1)+XKAFHS(N,N3,N2,N1) + 2-XKAFHS(N,N6,N5,N4) + TOHFHS(N3,N2,N1)=TOHFHS(N3,N2,N1)+XOHFHS(N,N3,N2,N1) + 2-XOHFHS(N,N6,N5,N4) + TSOFHS(N3,N2,N1)=TSOFHS(N3,N2,N1)+XSOFHS(N,N3,N2,N1) + 2-XSOFHS(N,N6,N5,N4) + TCLFHS(N3,N2,N1)=TCLFHS(N3,N2,N1)+XCLFHS(N,N3,N2,N1) + 2-XCLFHS(N,N6,N5,N4) + TC3FHS(N3,N2,N1)=TC3FHS(N3,N2,N1)+XC3FHS(N,N3,N2,N1) + 2-XC3FHS(N,N6,N5,N4) + THCFHS(N3,N2,N1)=THCFHS(N3,N2,N1)+XHCFHS(N,N3,N2,N1) + 2-XHCFHS(N,N6,N5,N4) + TAL1HS(N3,N2,N1)=TAL1HS(N3,N2,N1)+XAL1HS(N,N3,N2,N1) + 2-XAL1HS(N,N6,N5,N4) + TAL2HS(N3,N2,N1)=TAL2HS(N3,N2,N1)+XAL2HS(N,N3,N2,N1) + 2-XAL2HS(N,N6,N5,N4) + TAL3HS(N3,N2,N1)=TAL3HS(N3,N2,N1)+XAL3HS(N,N3,N2,N1) + 2-XAL3HS(N,N6,N5,N4) + TAL4HS(N3,N2,N1)=TAL4HS(N3,N2,N1)+XAL4HS(N,N3,N2,N1) + 2-XAL4HS(N,N6,N5,N4) + TALSHS(N3,N2,N1)=TALSHS(N3,N2,N1)+XALSHS(N,N3,N2,N1) + 2-XALSHS(N,N6,N5,N4) + TFE1HS(N3,N2,N1)=TFE1HS(N3,N2,N1)+XFE1HS(N,N3,N2,N1) + 2-XFE1HS(N,N6,N5,N4) + TFE2HS(N3,N2,N1)=TFE2HS(N3,N2,N1)+XFE2HS(N,N3,N2,N1) + 2-XFE2HS(N,N6,N5,N4) + TFE3HS(N3,N2,N1)=TFE3HS(N3,N2,N1)+XFE3HS(N,N3,N2,N1) + 2-XFE3HS(N,N6,N5,N4) + TFE4HS(N3,N2,N1)=TFE4HS(N3,N2,N1)+XFE4HS(N,N3,N2,N1) + 2-XFE4HS(N,N6,N5,N4) + TFESHS(N3,N2,N1)=TFESHS(N3,N2,N1)+XFESHS(N,N3,N2,N1) + 2-XFESHS(N,N6,N5,N4) + TCAOHS(N3,N2,N1)=TCAOHS(N3,N2,N1)+XCAOHS(N,N3,N2,N1) + 2-XCAOHS(N,N6,N5,N4) + TCACHS(N3,N2,N1)=TCACHS(N3,N2,N1)+XCACHS(N,N3,N2,N1) + 2-XCACHS(N,N6,N5,N4) + TCAHHS(N3,N2,N1)=TCAHHS(N3,N2,N1)+XCAHHS(N,N3,N2,N1) + 2-XCAHHS(N,N6,N5,N4) + TCASHS(N3,N2,N1)=TCASHS(N3,N2,N1)+XCASHS(N,N3,N2,N1) + 2-XCASHS(N,N6,N5,N4) + TMGOHS(N3,N2,N1)=TMGOHS(N3,N2,N1)+XMGOHS(N,N3,N2,N1) + 2-XMGOHS(N,N6,N5,N4) + TMGCHS(N3,N2,N1)=TMGCHS(N3,N2,N1)+XMGCHS(N,N3,N2,N1) + 2-XMGCHS(N,N6,N5,N4) + TMGHHS(N3,N2,N1)=TMGHHS(N3,N2,N1)+XMGHHS(N,N3,N2,N1) + 2-XMGHHS(N,N6,N5,N4) + TMGSHS(N3,N2,N1)=TMGSHS(N3,N2,N1)+XMGSHS(N,N3,N2,N1) + 2-XMGSHS(N,N6,N5,N4) + TNACHS(N3,N2,N1)=TNACHS(N3,N2,N1)+XNACHS(N,N3,N2,N1) + 2-XNACHS(N,N6,N5,N4) + TNASHS(N3,N2,N1)=TNASHS(N3,N2,N1)+XNASHS(N,N3,N2,N1) + 2-XNASHS(N,N6,N5,N4) + TKASHS(N3,N2,N1)=TKASHS(N3,N2,N1)+XKASHS(N,N3,N2,N1) + 2-XKASHS(N,N6,N5,N4) + TH0PHS(N3,N2,N1)=TH0PHS(N3,N2,N1)+XH0PHS(N,N3,N2,N1) + 2-XH0PHS(N,N6,N5,N4) + TH1PHS(N3,N2,N1)=TH1PHS(N3,N2,N1)+XH1PHS(N,N3,N2,N1) + 2-XH1PHS(N,N6,N5,N4) + TH3PHS(N3,N2,N1)=TH3PHS(N3,N2,N1)+XH3PHS(N,N3,N2,N1) + 2-XH3PHS(N,N6,N5,N4) + TF1PHS(N3,N2,N1)=TF1PHS(N3,N2,N1)+XF1PHS(N,N3,N2,N1) + 2-XF1PHS(N,N6,N5,N4) + TF2PHS(N3,N2,N1)=TF2PHS(N3,N2,N1)+XF2PHS(N,N3,N2,N1) + 2-XF2PHS(N,N6,N5,N4) + TC0PHS(N3,N2,N1)=TC0PHS(N3,N2,N1)+XC0PHS(N,N3,N2,N1) + 2-XC0PHS(N,N6,N5,N4) + TC1PHS(N3,N2,N1)=TC1PHS(N3,N2,N1)+XC1PHS(N,N3,N2,N1) + 2-XC1PHS(N,N6,N5,N4) + TC2PHS(N3,N2,N1)=TC2PHS(N3,N2,N1)+XC2PHS(N,N3,N2,N1) + 2-XC2PHS(N,N6,N5,N4) + TM1PHS(N3,N2,N1)=TM1PHS(N3,N2,N1)+XM1PHS(N,N3,N2,N1) + 2-XM1PHS(N,N6,N5,N4) + TH0BHB(N3,N2,N1)=TH0BHB(N3,N2,N1)+XH0BHB(N,N3,N2,N1) + 2-XH0BHB(N,N6,N5,N4) + TH1BHB(N3,N2,N1)=TH1BHB(N3,N2,N1)+XH1BHB(N,N3,N2,N1) + 2-XH1BHB(N,N6,N5,N4) + TH3BHB(N3,N2,N1)=TH3BHB(N3,N2,N1)+XH3BHB(N,N3,N2,N1) + 2-XH3BHB(N,N6,N5,N4) + TF1BHB(N3,N2,N1)=TF1BHB(N3,N2,N1)+XF1BHB(N,N3,N2,N1) + 2-XF1BHB(N,N6,N5,N4) + TF2BHB(N3,N2,N1)=TF2BHB(N3,N2,N1)+XF2BHB(N,N3,N2,N1) + 2-XF2BHB(N,N6,N5,N4) + TC0BHB(N3,N2,N1)=TC0BHB(N3,N2,N1)+XC0BHB(N,N3,N2,N1) + 2-XC0BHB(N,N6,N5,N4) + TC1BHB(N3,N2,N1)=TC1BHB(N3,N2,N1)+XC1BHB(N,N3,N2,N1) + 2-XC1BHB(N,N6,N5,N4) + TC2BHB(N3,N2,N1)=TC2BHB(N3,N2,N1)+XC2BHB(N,N3,N2,N1) + 2-XC2BHB(N,N6,N5,N4) + TM1BHB(N3,N2,N1)=TM1BHB(N3,N2,N1)+XM1BHB(N,N3,N2,N1) + 2-XM1BHB(N,N6,N5,N4) + ENDIF + ENDIF +8580 CONTINUE +8575 CONTINUE +C +C CALCULATE SURFACE RESIDUE TEMPERATURE FROM ITS CHANGE +C IN HEAT STORAGE +C + HFLXD=2.496E-06*(OSGX-ORGC(0,NY,NX))*TKS(0,NY,NX) + VOLW(0,NY,NX)=VOLW(0,NY,NX)+FLWR(NY,NX)+THAWR(NY,NX) + 2+TQR(NY,NX)+18.0E-06*TRH2O(0,NY,NX) + VOLI(0,NY,NX)=VOLI(0,NY,NX)-THAWR(NY,NX)/0.92 + ENGYR=VHCPR(NY,NX)*TKS(0,NY,NX)-HFLXD + VHCPR(NY,NX)=2.496E-06*ORGC(0,NY,NX)+4.19*VOLW(0,NY,NX) + 2+1.9274*VOLI(0,NY,NX) + IF(VHCPR(NY,NX).GT.ZEROS(NY,NX))THEN + TKS(0,NY,NX)=(ENGYR+HFLWR(NY,NX)+HTHAWR(NY,NX) + 2+THQR(NY,NX))/VHCPR(NY,NX) + ELSE + TKS(0,NY,NX)=TKS(NU(NY,NX),NY,NX) + ENDIF + IF(VHCPR(NY,NX).LT.VHCPRX(NY,NX))THEN + HFLXR=VHCPR(NY,NX)*(TKS(0,NY,NX)-TKS(NU(NY,NX),NY,NX)) + HEATOU=HEATOU+HFLXR + TKS(0,NY,NX)=TKS(NU(NY,NX),NY,NX) + ENDIF + HEATIN=HEATIN+HTHAWR(NY,NX)-HFLXD +C UVOLW(NY,NX)=UVOLW(NY,NX)-VOLW(0,NY,NX)-VOLI(0,NY,NX)*0.92 +C +C SURFACE BOUNDARY WATER FLUXES +C + WI=PRECQ(NY,NX)+PRECI(NY,NX) + CRAIN=CRAIN+WI + URAIN(NY,NX)=URAIN(NY,NX)+WI + WO=TEVAPG(NY,NX)+TEVAPP(NY,NX) + CEVAP=CEVAP-WO + UEVAP(NY,NX)=UEVAP(NY,NX)-WO + VOLWOU=VOLWOU-PRECU(NY,NX)-18.0E-06*TRH2O(0,NY,NX) + HVOLO(NY,NX)=HVOLO(NY,NX)-PRECU(NY,NX) + UVOLO(NY,NX)=UVOLO(NY,NX)-PRECU(NY,NX) + UDRAIN(NY,NX)=UDRAIN(NY,NX)+FLW(3,NK(NY,NX),NY,NX) +C +C SURFACE BOUNDARY HEAT FLUXES +C + HEATIN=HEATIN+4.19*TKA(NY,NX)*PRECA(NY,NX) + 2+2.095*TKA(NY,NX)*PRECW(NY,NX) + HEATIN=HEATIN+HEATH(NY,NX)+HTHAWW(NY,NX)+THFLXC(NY,NX) + HEATOU=HEATOU-4.19*TKA(NY,NX)*PRECU(NY,NX) +C WRITE(*,5151)'TK0',I,J,NX,NY,TKS(0,NY,NX),ENGYR +C 2,HFLWR(NY,NX),HFLXD,HTHAWR(NY,NX),VHCPR(NY,NX),VOLW(0,NY,NX) +C 3,VOLI(0,NY,NX),FLWR(NY,NX),THAWR(NY,NX),TRH2O(0,NY,NX) +C 3,ORGC(0,NY,NX),VHCPR(NY,NX)*TKS(0,NY,NX),TQR(NY,NX) +C 4,THQR(NY,NX),HEATH(NY,NX),HTHAWW(NY,NX),THFLXC(NY,NX),HEATIN +5151 FORMAT(A8,4I4,30F20.6) +C +C SURFACE BOUNDARY CO2, CH4 AND DOC FLUXES +C + CI=XCODFS(NY,NX)+XCOFLG(3,NU(NY,NX),NY,NX)+TCO2Z(NY,NX) + 2+(FLQGQ(NY,NX)+FLQRQ(NY,NX))*CCOR(NY,NX) + 3+(FLQGI(NY,NX)+FLQRI(NY,NX))*CCOQ(NY,NX) + 4+XCODFG(0,NY,NX)+XCODFR(NY,NX) + CH=XCHDFS(NY,NX)+XCHFLG(3,NU(NY,NX),NY,NX)+TCH4Z(NY,NX) + 2+(FLQGQ(NY,NX)+FLQRQ(NY,NX))*CCHR(NY,NX) + 3+(FLQGI(NY,NX)+FLQRI(NY,NX))*CCHQ(NY,NX) + 4+XCHDFG(0,NY,NX)+XCHDFR(NY,NX) + CO=-PRECU(NY,NX)*CCOQ(NY,NX) + CX=-PRECU(NY,NX)*CCHQ(NY,NX) + UCO2G(NY,NX)=UCO2G(NY,NX)+CI + HCO2G(NY,NX)=HCO2G(NY,NX)+CI + UCH4G(NY,NX)=UCH4G(NY,NX)+CH + HCH4G(NY,NX)=HCH4G(NY,NX)+CH + CO2GIN=CO2GIN+CI+CH + TCOU=TCOU+CO+CX + TNBP(NY,NX)=TNBP(NY,NX)+CH +C IF(NX.EQ.3.AND.NY.EQ.3)THEN +C WRITE(*,6644)'CO2',I,J,NX,NY,HCO2G(NY,NX),CI,XCODFS(NY,NX) +C 2,XCOFLG(3,NU(NY,NX),NY,NX),TCO2Z(NY,NX) +C 3,(FLQGQ(NY,NX)+FLQRQ(NY,NX))*CCOR(NY,NX) +C 4,(FLQGI(NY,NX)+FLQRI(NY,NX))*CCOQ(NY,NX) +C 5,XCODFG(0,NY,NX),XCODFR(NY,NX),VOLP(0,NY,NX) +C 6,VOLP(NU(NY,NX),NY,NX) +C WRITE(*,6644)'CH4',I,J,NX,NY,CH,XCHDFS(NY,NX) +C 2,XCHFLG(3,NU(NY,NX),NY,NX),TCH4Z(NY,NX),FLQGQ(NY,NX) +C 3,FLQRQ(NY,NX),FLQGI(NY,NX),FLQRI(NY,NX),CCHR(NY,NX),CCHQ(NY,NX) +C 4,XCHDFG(0,NY,NX),XCHDFR(NY,NX),CH4S(NU(NY,NX),NY,NX) +6644 FORMAT(A8,4I4,30E12.4) +C ENDIF +C +C SURFACE BOUNDARY O2 FLUXES +C + OI=XOXDFS(NY,NX)+XOXFLG(3,NU(NY,NX),NY,NX)+TOXYZ(NY,NX) + 2+(FLQGQ(NY,NX)+FLQRQ(NY,NX))*COXR(NY,NX) + 3+(FLQGI(NY,NX)+FLQRI(NY,NX))*COXQ(NY,NX) + 4+XOXDFG(0,NY,NX)+XOXDFR(NY,NX) + OO=RUPOXO(0,NY,NX)-PRECU(NY,NX)*COXQ(NY,NX) + UOXYG(NY,NX)=UOXYG(NY,NX)+OI + HOXYG(NY,NX)=HOXYG(NY,NX)+OI + OXYGIN=OXYGIN+OI + OXYGOU=OXYGOU+OO +C IF(NX.EQ.2.AND.NY.EQ.1)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) +C 3,(FLQGI(NY,NX)+FLQRI(NY,NX))*CCOQ(NY,NX) +C 4,XCODFG(0,NY,NX),XCODFR(NY,NX) +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) +6646 FORMAT(A8,4I4,60E12.4) +C ENDIF +C +C SURFACE BOUNDARY N2, N2O, NH3, NH4, NO3, AND DON FLUXES +C + ZN2GIN=ZN2GIN+XNGDFS(NY,NX)+XN2DFS(NY,NX)+XN3DFS(NY,NX) + 2+XNBDFS(NY,NX)+XNGFLG(3,NU(NY,NX),NY,NX)+XN2FLG(3,NU(NY,NX),NY,NX) + 3+XN3FLG(3,NU(NY,NX),NY,NX)+TN2OZ(NY,NX)+TNH3Z(NY,NX) + 4+(FLQGQ(NY,NX)+FLQRQ(NY,NX))*(CNNR(NY,NX)+CN2R(NY,NX)) + 5+(FLQGI(NY,NX)+FLQRI(NY,NX))*(CNNQ(NY,NX)+CN2Q(NY,NX)) + 6+XN2DFG(0,NY,NX)+XNGDFG(0,NY,NX)+XN3DFG(0,NY,NX) + 7+XNGDFR(NY,NX)+XN2DFR(NY,NX)+XN3DFR(NY,NX) + TZIN=TZIN+((FLQGQ(NY,NX)+FLQRQ(NY,NX)) + 2*(CN4R(NY,NX)+CN3R(NY,NX)+CNOR(NY,NX)) + 3+(FLQGI(NY,NX)+FLQRI(NY,NX))*(CN4Q(I,NY,NX)+CN3Q(I,NY,NX) + 4+CNOQ(I,NY,NX)))*14.0 + TZOU=TZOU-PRECU(NY,NX)*(CNNQ(NY,NX)+CN2Q(NY,NX))-PRECU(NY,NX) + 2*(CN4Q(I,NY,NX)+CN3Q(I,NY,NX)+CNOQ(I,NY,NX))*14.0 + ZDRAIN(NY,NX)=ZDRAIN(NY,NX)+XN4FLW(3,NK(NY,NX),NY,NX) + 2+XN3FLW(3,NK(NY,NX),NY,NX)+XNOFLW(3,NK(NY,NX),NY,NX) + 3+XNXFLS(3,NK(NY,NX),NY,NX)+XN4FLB(3,NK(NY,NX),NY,NX) + 4+XN3FLB(3,NK(NY,NX),NY,NX)+XNOFLB(3,NK(NY,NX),NY,NX) + 5+XNXFLB(3,NK(NY,NX),NY,NX) + ZNGGIN=XNGDFS(NY,NX)+XNGFLG(3,NU(NY,NX),NY,NX)+XNGDFG(0,NY,NX) + ZN2OIN=XN2DFS(NY,NX)+XN2FLG(3,NU(NY,NX),NY,NX)+XN2DFG(0,NY,NX) + ZNH3IN=XN3DFS(NY,NX)+XNBDFS(NY,NX)+XN3FLG(3,NU(NY,NX),NY,NX) + 2+XN3DFG(0,NY,NX) + TI=XHGDFS(NY,NX)+XHGFLG(3,NU(NY,NX),NY,NX)+TH2GZ(NY,NX) + 2+XHGDFG(0,NY,NX)+XHGDFR(NY,NX) +C UN2GG(NY,NX)=UN2GG(NY,NX)+ZNGGIN +C HN2GG(NY,NX)=HN2GG(NY,NX)+ZNGGIN + UN2OG(NY,NX)=UN2OG(NY,NX)+ZN2OIN + HN2OG(NY,NX)=HN2OG(NY,NX)+ZN2OIN + UNH3G(NY,NX)=UNH3G(NY,NX)+ZNH3IN + HNH3G(NY,NX)=HNH3G(NY,NX)+ZNH3IN + UN2GS(NY,NX)=UN2GS(NY,NX)+XN2GS(0,NY,NX) + UH2GG(NY,NX)=UH2GG(NY,NX)+TI +C WRITE(*,6644)'HNH3G',I,J,NX,NY,HNH3G(NY,NX),ZNH3IN +C 2,XN3DFS(NY,NX),XNBDFS(NY,NX),XN3FLG(3,NU(NY,NX),NY,NX) +C 2,XN3DFG(0,NY,NX) +C WRITE(*,6644)'ZN2GIN',I,J,NX,NY,ZN2GIN,XNGDFS(NY,NX) +C 3,XN2DFS(NY,NX),XN3DFS(NY,NX) +C 2,XNBDFS(NY,NX),XNGFLG(3,NU(NY,NX),NY,NX),XN2FLG(3,NU(NY,NX),NY,NX) +C 3,XN3FLG(3,NU(NY,NX),NY,NX),TN2OZ(NY,NX),TNH3Z(NY,NX) +C 4,(FLQGQ(NY,NX)+FLQRQ(NY,NX))*(CNNR(NY,NX)+CN2R(NY,NX)) +C 5,(FLQGI(NY,NX)+FLQRI(NY,NX))*(CNNQ(NY,NX)+CN2Q(NY,NX)) +C 6,XN2DFG(0,NY,NX)+XNGDFG(0,NY,NX),XN3DFG(0,NY,NX) +C 7,XNGDFR(NY,NX)+XN2DFR(NY,NX),XN3DFR(NY,NX) +C +C SURFACE BOUNDARY PO4 AND DOP FLUXES +C + TPIN=TPIN+((FLQGQ(NY,NX)+FLQRQ(NY,NX))*CPOR(NY,NX) + 2+(FLQGI(NY,NX)+FLQRI(NY,NX))*CPOQ(I,NY,NX))*31.0 + TPOU=TPOU-PRECU(NY,NX)*CPOQ(I,NY,NX)*31.0 + PDRAIN(NY,NX)=PDRAIN(NY,NX)+XH2PFS(3,NK(NY,NX),NY,NX) + 2+XH2BFB(3,NK(NY,NX),NY,NX) +C +C SURFACE BOUNDARY ION FLUXES +C + TZOU=TZOU-14.0*(TBNH4(0,NY,NX)+TBNO3(0,NY,NX)+TBNH3(0,NY,NX)) + TPOU=TPOU-31.0*TBH2P(0,NY,NX) + TO=2.0*TRH2O(0,NY,NX)+2.0*TBNH4(0,NY,NX) + 2+TBNH3(0,NY,NX)+TBNO3(0,NY,NX)+3.0*TBH2P(0,NY,NX) + 3+RH2GO(0,NY,NX)+TBION(0,NY,NX) + TIONIN=TIONIN+TI + TIONOU=TIONOU+TO +C UIONOU(NY,NX)=UIONOU(NY,NX)+TO +C +C ACCUMULATE PLANT LITTERFALL FLUXES +C + XCSN=XCSN+ZCSNC(NY,NX) + XZSN=XZSN+ZZSNC(NY,NX) + XPSN=XPSN+ZPSNC(NY,NX) + UXCSN(NY,NX)=UXCSN(NY,NX)+ZCSNC(NY,NX) + UXZSN(NY,NX)=UXZSN(NY,NX)+ZZSNC(NY,NX) + UXPSN(NY,NX)=UXPSN(NY,NX)+ZPSNC(NY,NX) +C +C SURFACE BOUNDARY SALT FLUXES FROM RAINFALL AND SURFACE IRRIGATION +C + IF(ISALT(NY,NX).NE.0)THEN + SR=PRECQ(NY,NX)*(CALR(NY,NX)+CFER(NY,NX)+CHYR(NY,NX)+CCAR(NY,NX) + 2+CMGR(NY,NX)+CNAR(NY,NX)+CKAR(NY,NX)+COHR(NY,NX)+CSOR(NY,NX) + 3+CCLR(NY,NX)+CC3R(NY,NX)+CH0PR(NY,NX) + 4+2.0*(CHCR(NY,NX)+CAL1R(NY,NX)+CALSR(NY,NX)+CFE1R(NY,NX) + 5+CFESR(NY,NX)+CCAOR(NY,NX)+CCACR(NY,NX)+CCASR(NY,NX)+CMGOR(NY,NX) + 6+CMGCR(NY,NX)+CMGSR(NY,NX)+CNACR(NY,NX)+CNASR(NY,NX) + 7+CKASR(NY,NX)+CH1PR(NY,NX)+CC0PR(NY,NX)) + 8+3.0*(CAL2R(NY,NX)+CFE2R(NY,NX)+CCAHR(NY,NX)+CMGHR(NY,NX) + 9+CF1PR(NY,NX)+CC1PR(NY,NX)+CM1PR(NY,NX)) + 1+4.0*(CAL3R(NY,NX)+CFE3R(NY,NX)+CH3PR(NY,NX)+CF2PR(NY,NX) + 2+CC2PR(NY,NX)) + 3+5.0*(CAL4R(NY,NX)+CFE4R(NY,NX))) + SI=PRECI(NY,NX)*(CALQ(I,NY,NX)+CFEQ(I,NY,NX)+CHYQ(I,NY,NX) + 2+CCAQ(I,NY,NX)+CMGQ(I,NY,NX)+CNAQ(I,NY,NX)+CKAQ(I,NY,NX) + 3+COHQ(I,NY,NX)+CSOQ(I,NY,NX)+CCLQ(I,NY,NX)+CC3Q(I,NY,NX) + 4+CH0PQ(I,NY,NX)+2.0*(CHCQ(I,NY,NX)+CAL1Q(I,NY,NX)+CALSQ(I,NY,NX) + 5+CFE1Q(I,NY,NX)+CFESQ(I,NY,NX)+CCAOQ(I,NY,NX)+CCACQ(I,NY,NX) + 6+CCASQ(I,NY,NX)+CMGOQ(I,NY,NX)+CMGCQ(I,NY,NX)+CMGSQ(I,NY,NX) + 7+CNACQ(I,NY,NX)+CNASQ(I,NY,NX)+CKASQ(I,NY,NX)+CH1PQ(I,NY,NX) + 8+CC0PQ(I,NY,NX))+3.0*(CAL2Q(I,NY,NX)+CFE2Q(I,NY,NX) + 9+CCAHQ(I,NY,NX)+CMGHQ(I,NY,NX)+CF1PQ(I,NY,NX)+CC1PQ(I,NY,NX) + 1+CM1PQ(I,NY,NX))+4.0*(CAL3Q(I,NY,NX)+CFE3Q(I,NY,NX) + 2+CH3PQ(I,NY,NX)+CF2PQ(I,NY,NX)+CC2PQ(I,NY,NX)) + 3+5.0*(CAL4Q(I,NY,NX)+CFE4Q(I,NY,NX))) + TIONIN=TIONIN+SR+SI +C +C SUBSURFACE BOUNDARY SALT FLUXES FROM SUBSURFACE IRRIGATION +C + SI=PRECU(NY,NX)*(CALQ(I,NY,NX)+CFEQ(I,NY,NX)+CHYQ(I,NY,NX) + 2+CCAQ(I,NY,NX)+CMGQ(I,NY,NX)+CNAQ(I,NY,NX)+CKAQ(I,NY,NX) + 3+COHQ(I,NY,NX)+CSOQ(I,NY,NX)+CCLQ(I,NY,NX)+CC3Q(I,NY,NX) + 4+CH0PQ(I,NY,NX)+2.0*(CHCQ(I,NY,NX)+CAL1Q(I,NY,NX)+CALSQ(I,NY,NX) + 5+CFE1Q(I,NY,NX)+CFESQ(I,NY,NX)+CCAOQ(I,NY,NX)+CCACQ(I,NY,NX) + 6+CCASQ(I,NY,NX)+CMGOQ(I,NY,NX)+CMGCQ(I,NY,NX)+CMGSQ(I,NY,NX) + 7+CNACQ(I,NY,NX)+CNASQ(I,NY,NX)+CKASQ(I,NY,NX)+CH1PQ(I,NY,NX) + 8+CC0PQ(I,NY,NX))+3.0*(CAL2Q(I,NY,NX)+CFE2Q(I,NY,NX) + 9+CCAHQ(I,NY,NX)+CMGHQ(I,NY,NX)+CF1PQ(I,NY,NX)+CC1PQ(I,NY,NX) + 1+CM1PQ(I,NY,NX))+4.0*(CAL3Q(I,NY,NX)+CFE3Q(I,NY,NX) + 2+CH3PQ(I,NY,NX)+CF2PQ(I,NY,NX)+CC2PQ(I,NY,NX)) + 3+5.0*(CAL4Q(I,NY,NX)+CFE4Q(I,NY,NX))) + TIONIN=TIONIN+SI + ENDIF +C +C GAS EXCHANGE FROM SURFACE VOLATILIZATION-DISSOLUTION +C + DO 9680 K=0,2 + OQC(K,0,NY,NX)=OQC(K,0,NY,NX)+XOCFLS(K,3,0,NY,NX) + OQN(K,0,NY,NX)=OQN(K,0,NY,NX)+XONFLS(K,3,0,NY,NX) + OQP(K,0,NY,NX)=OQP(K,0,NY,NX)+XOPFLS(K,3,0,NY,NX) + OQA(K,0,NY,NX)=OQA(K,0,NY,NX)+XOAFLS(K,3,0,NY,NX) +9680 CONTINUE + CO2S(0,NY,NX)=CO2S(0,NY,NX)+XCODFR(NY,NX)+XCOFLS(3,0,NY,NX) + 2+XCODFG(0,NY,NX)-RCO2O(0,NY,NX) + CH4S(0,NY,NX)=CH4S(0,NY,NX)+XCHDFR(NY,NX)+XCHFLS(3,0,NY,NX) + 2+XCHDFG(0,NY,NX)-RCH4O(0,NY,NX) + OXYS(0,NY,NX)=OXYS(0,NY,NX)+XOXDFR(NY,NX)+XOXFLS(3,0,NY,NX) + 2+XOXDFG(0,NY,NX)-RUPOXO(0,NY,NX) + Z2GS(0,NY,NX)=Z2GS(0,NY,NX)+XNGDFR(NY,NX)+XNGFLS(3,0,NY,NX) + 2+XNGDFG(0,NY,NX)-RN2G(0,NY,NX)-XN2GS(0,NY,NX) + Z2OS(0,NY,NX)=Z2OS(0,NY,NX)+XN2DFR(NY,NX)+XN2FLS(3,0,NY,NX) + 2+XN2DFG(0,NY,NX)-RN2O(0,NY,NX) + H2GS(0,NY,NX)=H2GS(0,NY,NX)+XHGDFR(NY,NX)+XHGFLS(3,0,NY,NX) + 2+XHGDFG(0,NY,NX)-RH2GO(0,NY,NX) + ZNH4S(0,NY,NX)=ZNH4S(0,NY,NX)+XN4FLW(3,0,NY,NX) + 2+XNH4S(0,NY,NX)+TRN4S(0,NY,NX)+XN34SQ(0,NY,NX) + ZNH3S(0,NY,NX)=ZNH3S(0,NY,NX)+XN3DFR(NY,NX)+XN3FLW(3,0,NY,NX) + 2+XN3DFG(0,NY,NX)+TRN3S(0,NY,NX)-XN34SQ(0,NY,NX) + ZNO3S(0,NY,NX)=ZNO3S(0,NY,NX)+XNOFLW(3,0,NY,NX) + 2+XNO3S(0,NY,NX)+TRNO3(0,NY,NX) + ZNO2S(0,NY,NX)=ZNO2S(0,NY,NX)+XNXFLS(3,0,NY,NX) + 2+XNO2S(0,NY,NX) + H2PO4(0,NY,NX)=H2PO4(0,NY,NX)+XH2PFS(3,0,NY,NX) + 2+XH2PS(0,NY,NX)+TRH2P(0,NY,NX) + CO2S(NU(NY,NX),NY,NX)=CO2S(NU(NY,NX),NY,NX)+XCODFS(NY,NX) + CH4S(NU(NY,NX),NY,NX)=CH4S(NU(NY,NX),NY,NX)+XCHDFS(NY,NX) + OXYS(NU(NY,NX),NY,NX)=OXYS(NU(NY,NX),NY,NX)+XOXDFS(NY,NX) + Z2GS(NU(NY,NX),NY,NX)=Z2GS(NU(NY,NX),NY,NX)+XNGDFS(NY,NX) + Z2OS(NU(NY,NX),NY,NX)=Z2OS(NU(NY,NX),NY,NX)+XN2DFS(NY,NX) + ZNH3S(NU(NY,NX),NY,NX)=ZNH3S(NU(NY,NX),NY,NX)+XN3DFS(NY,NX) + ZNH3B(NU(NY,NX),NY,NX)=ZNH3B(NU(NY,NX),NY,NX)+XNBDFS(NY,NX) + H2GS(NU(NY,NX),NY,NX)=H2GS(NU(NY,NX),NY,NX)+XHGDFS(NY,NX) + SED(NY,NX)=SED(NY,NX)+XDTSED(NY,NX) + THRE(NY,NX)=THRE(NY,NX)+RCO2O(0,NY,NX) + UN2GG(NY,NX)=UN2GG(NY,NX)+RN2G(0,NY,NX) + HN2GG(NY,NX)=HN2GG(NY,NX)+RN2G(0,NY,NX) + ROXYF(0,NY,NX)=XOXDFG(0,NY,NX) + RCO2F(0,NY,NX)=XCODFG(0,NY,NX) + RCH4F(0,NY,NX)=XCHDFG(0,NY,NX) + ROXYL(0,NY,NX)=XOXDFR(NY,NX)+XOXFLS(3,0,NY,NX) + 2-(FLQRQ(NY,NX)*COXR(NY,NX)+FLQRI(NY,NX)*COXQ(NY,NX)) + RCH4L(0,NY,NX)=XCHDFR(NY,NX)+XCHFLS(3,0,NY,NX) + 2-(FLQRQ(NY,NX)*CCHR(NY,NX)+FLQRI(NY,NX)*CCHQ(NY,NX)) + ROXYL(NU(NY,NX),NY,NX)=ROXYL(NU(NY,NX),NY,NX)+XOXDFS(NY,NX) + RCH4L(NU(NY,NX),NY,NX)=RCH4L(NU(NY,NX),NY,NX)+XCHDFS(NY,NX) +C IF(NX.EQ.1.AND.NY.EQ.6)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) +C WRITE(*,1119)'CH4S0',I,J,NX,NY,CH4S(0,NY,NX),XCHDFS(NY,NX) +C 2,XCHDFR(NY,NX),XCHFLS(3,0,NY,NX),RCH4O(0,NY,NX),XCHDFG(0,NY,NX) +C 3,RCH4L(0,NY,NX) +C WRITE(*,1119)'OXYS0',I,J,NX,NY,OXYS(0,NY,NX),XOXDFR(NY,NX) +C 2,XOXFLS(3,0,NY,NX),XOXDFG(0,NY,NX),RUPOXO(0,NY,NX) +C 3,ROXYL(0,NY,NX),TOXQRS(NY,NX) +1119 FORMAT(A8,4I4,12E12.4) +C ENDIF +C IF(NX.EQ.5)THEN +C WRITE(*,5533)'ZNH4S0',I,J,NX,NY,ZNH4S(0,NY,NX),XN4FLW(3,0,NY,NX) +C 2,XNH4S(0,NY,NX),XN3FLW(3,0,NY,NX),TRN4S(0,NY,NX) +C 3,ZNH3S(0,NY,NX),TRN3S(0,NY,NX),XN3DFG(0,NY,NX),XN34SQ(0,NY,NX) +C 4,ZNHUFA(0,NY,NX),XNO2S(0,NY,NX),XN4(0,NY,NX)*14.0 +C WRITE(*,5533)'ZNO3S0',I,J,NX,NY,ZNO3S(0,NY,NX),XNOFLW(3,0,NY,NX) +C 2,XNO3S(0,NY,NX),TRNO3(0,NY,NX),ZNO2S(0,NY,NX),XNXFLS(3,0,NY,NX) +C 3,XNO2S(0,NY,NX) +C WRITE(*,5533)'H2PO40',I,J,NX,NY,H2PO4(0,NY,NX) +C 2,XH2PFS(3,0,NY,NX),XH2PS(0,NY,NX),TRH2P(0,NY,NX) +5533 FORMAT(A8,4I4,20E12.4) +C ENDIF +C +C OVERLAND FLOW +C + IF(TQR(NY,NX).NE.0.0)THEN +C +C DOC, DON, DOP +C + DO 8570 K=0,2 + OQC(K,0,NY,NX)=OQC(K,0,NY,NX)+TOCQRS(K,NY,NX) + OQN(K,0,NY,NX)=OQN(K,0,NY,NX)+TONQRS(K,NY,NX) + OQP(K,0,NY,NX)=OQP(K,0,NY,NX)+TOPQRS(K,NY,NX) + OQA(K,0,NY,NX)=OQA(K,0,NY,NX)+TOAQRS(K,NY,NX) +C IF(NX.EQ.1.AND.NY.EQ.6)THEN +C WRITE(*,2626)'OQC0',I,J,NX,NY,K,OQC(K,0,NY,NX) +C 2,TOCQRS(K,NY,NX),OQN(K,0,NY,NX),TONQRS(K,NY,NX) +2626 FORMAT(A8,5I4,20E12.4) +C ENDIF +8570 CONTINUE +C +C SOLUTES +C + CO2S(0,NY,NX)=CO2S(0,NY,NX)+TCOQRS(NY,NX) + CH4S(0,NY,NX)=CH4S(0,NY,NX)+TCHQRS(NY,NX) + OXYS(0,NY,NX)=OXYS(0,NY,NX)+TOXQRS(NY,NX) + Z2GS(0,NY,NX)=Z2GS(0,NY,NX)+TNGQRS(NY,NX) + Z2OS(0,NY,NX)=Z2OS(0,NY,NX)+TN2QRS(NY,NX) + H2GS(0,NY,NX)=H2GS(0,NY,NX)+THGQRS(NY,NX) + ZNH4S(0,NY,NX)=ZNH4S(0,NY,NX)+TN4QRS(NY,NX) + ZNH3S(0,NY,NX)=ZNH3S(0,NY,NX)+TN3QRS(NY,NX) + ZNO3S(0,NY,NX)=ZNO3S(0,NY,NX)+TNOQRS(NY,NX) + ZNO2S(0,NY,NX)=ZNO2S(0,NY,NX)+TNXQRS(NY,NX) + H2PO4(0,NY,NX)=H2PO4(0,NY,NX)+TPOQRS(NY,NX) + IF(ISALT(NY,NX).NE.0)THEN + ZAL(0,NY,NX)=ZAL(0,NY,NX)+TQRAL(NY,NX) + ZFE(0,NY,NX)=ZFE(0,NY,NX)+TQRFE(NY,NX) + ZHY(0,NY,NX)=ZHY(0,NY,NX)+TQRHY(NY,NX) + ZCA(0,NY,NX)=ZCA(0,NY,NX)+TQRCA(NY,NX) + ZMG(0,NY,NX)=ZMG(0,NY,NX)+TQRMG(NY,NX) + ZNA(0,NY,NX)=ZNA(0,NY,NX)+TQRNA(NY,NX) + ZKA(0,NY,NX)=ZKA(0,NY,NX)+TQRKA(NY,NX) + ZOH(0,NY,NX)=ZOH(0,NY,NX)+TQROH(NY,NX) + ZSO4(0,NY,NX)=ZSO4(0,NY,NX)+TQRSO(NY,NX) + ZCL(0,NY,NX)=ZCL(0,NY,NX)+TQRCL(NY,NX) + ZCO3(0,NY,NX)=ZCO3(0,NY,NX)+TQRC3(NY,NX) + ZHCO3(0,NY,NX)=ZHCO3(0,NY,NX)+TQRHC(NY,NX) + ZALOH1(0,NY,NX)=ZALOH1(0,NY,NX)+TQRAL1(NY,NX) + ZALOH2(0,NY,NX)=ZALOH2(0,NY,NX)+TQRAL2(NY,NX) + ZALOH3(0,NY,NX)=ZALOH3(0,NY,NX)+TQRAL3(NY,NX) + ZALOH4(0,NY,NX)=ZALOH4(0,NY,NX)+TQRAL4(NY,NX) + ZALS(0,NY,NX)=ZALS(0,NY,NX)+TQRALS(NY,NX) + ZFEOH1(0,NY,NX)=ZFEOH1(0,NY,NX)+TQRFE1(NY,NX) + ZFEOH2(0,NY,NX)=ZFEOH2(0,NY,NX)+TQRFE2(NY,NX) + ZFEOH3(0,NY,NX)=ZFEOH3(0,NY,NX)+TQRFE3(NY,NX) + ZFEOH4(0,NY,NX)=ZFEOH4(0,NY,NX)+TQRFE4(NY,NX) + ZFES(0,NY,NX)=ZFES(0,NY,NX)+TQRFES(NY,NX) + ZCAO(0,NY,NX)=ZCAO(0,NY,NX)+TQRCAO(NY,NX) + ZCAC(0,NY,NX)=ZCAC(0,NY,NX)+TQRCAC(NY,NX) + ZCAH(0,NY,NX)=ZCAH(0,NY,NX)+TQRCAH(NY,NX) + ZCAS(0,NY,NX)=ZCAS(0,NY,NX)+TQRCAS(NY,NX) + ZMGO(0,NY,NX)=ZMGO(0,NY,NX)+TQRMGO(NY,NX) + ZMGC(0,NY,NX)=ZMGC(0,NY,NX)+TQRMGC(NY,NX) + ZMGH(0,NY,NX)=ZMGH(0,NY,NX)+TQRMGH(NY,NX) + ZMGS(0,NY,NX)=ZMGS(0,NY,NX)+TQRMGS(NY,NX) + ZNAC(0,NY,NX)=ZNAC(0,NY,NX)+TQRNAC(NY,NX) + ZNAS(0,NY,NX)=ZNAS(0,NY,NX)+TQRNAS(NY,NX) + ZKAS(0,NY,NX)=ZKAS(0,NY,NX)+TQRKAS(NY,NX) + H0PO4(0,NY,NX)=H0PO4(0,NY,NX)+TQRH0P(NY,NX) + H1PO4(0,NY,NX)=H1PO4(0,NY,NX)+TQRH1P(NY,NX) + H3PO4(0,NY,NX)=H3PO4(0,NY,NX)+TQRH3P(NY,NX) + ZFE1P(0,NY,NX)=ZFE1P(0,NY,NX)+TQRF1P(NY,NX) + ZFE2P(0,NY,NX)=ZFE2P(0,NY,NX)+TQRF2P(NY,NX) + ZCA0P(0,NY,NX)=ZCA0P(0,NY,NX)+TQRC0P(NY,NX) + ZCA1P(0,NY,NX)=ZCA1P(0,NY,NX)+TQRC1P(NY,NX) + ZCA2P(0,NY,NX)=ZCA2P(0,NY,NX)+TQRC2P(NY,NX) + ZMG1P(0,NY,NX)=ZMG1P(0,NY,NX)+TQRM1P(NY,NX) + ENDIF +C +C SURFACE SEDIMENT TRANSPORT +C + IF(IERSN(NY,NX).NE.0)THEN + IF(BKDS(NU(NY,NX),NY,NX).GT.ZERO)THEN + SED(NY,NX)=SED(NY,NX)+TSEDER(NY,NX) + DLYR(3,NU(NY,NX),NY,NX)=DLYR(3,NU(NY,NX),NY,NX)+TSEDER(NY,NX) + 2/(AREA(3,NU(NY,NX),NY,NX)*BKDS(NU(NY,NX),NY,NX)) + IF(TSEDER(NY,NX).GT.1.0E-06*BKVL(NU(NY,NX),NY,NX))IFLGS(NY,NX)=1 + ENDIF +C +C SOIL MINERAL FRACTIONS +C + SAND(NU(NY,NX),NY,NX)=SAND(NU(NY,NX),NY,NX)+TSANER(NY,NX) + SILT(NU(NY,NX),NY,NX)=SILT(NU(NY,NX),NY,NX)+TSILER(NY,NX) + CLAY(NU(NY,NX),NY,NX)=CLAY(NU(NY,NX),NY,NX)+TCLAER(NY,NX) + XCEC(NU(NY,NX),NY,NX)=XCEC(NU(NY,NX),NY,NX)+TCECER(NY,NX) + XAEC(NU(NY,NX),NY,NX)=XAEC(NU(NY,NX),NY,NX)+TAECER(NY,NX) +C +C FERTILIZER POOLS +C + ZNH4FA(NU(NY,NX),NY,NX)=ZNH4FA(NU(NY,NX),NY,NX)+TNH4ER(NY,NX) + ZNH3FA(NU(NY,NX),NY,NX)=ZNH3FA(NU(NY,NX),NY,NX)+TNH3ER(NY,NX) + ZNHUFA(NU(NY,NX),NY,NX)=ZNHUFA(NU(NY,NX),NY,NX)+TNHUER(NY,NX) + ZNO3FA(NU(NY,NX),NY,NX)=ZNO3FA(NU(NY,NX),NY,NX)+TNO3ER(NY,NX) + ZNH4FB(NU(NY,NX),NY,NX)=ZNH4FB(NU(NY,NX),NY,NX)+TNH4EB(NY,NX) + ZNH3FB(NU(NY,NX),NY,NX)=ZNH3FB(NU(NY,NX),NY,NX)+TNH3EB(NY,NX) + ZNHUFB(NU(NY,NX),NY,NX)=ZNHUFB(NU(NY,NX),NY,NX)+TNHUEB(NY,NX) + ZNO3FB(NU(NY,NX),NY,NX)=ZNO3FB(NU(NY,NX),NY,NX)+TNO3EB(NY,NX) +C +C EXCHANGEABLE CATIONS AND ANIONS +C + XN4(NU(NY,NX),NY,NX)=XN4(NU(NY,NX),NY,NX)+TN4ER(NY,NX) + XNB(NU(NY,NX),NY,NX)=XNB(NU(NY,NX),NY,NX)+TNBER(NY,NX) + XHY(NU(NY,NX),NY,NX)=XHY(NU(NY,NX),NY,NX)+THYER(NY,NX) + XAL(NU(NY,NX),NY,NX)=XAL(NU(NY,NX),NY,NX)+TALER(NY,NX) + XCA(NU(NY,NX),NY,NX)=XCA(NU(NY,NX),NY,NX)+TCAER(NY,NX) + XMG(NU(NY,NX),NY,NX)=XMG(NU(NY,NX),NY,NX)+TMGER(NY,NX) + XNA(NU(NY,NX),NY,NX)=XNA(NU(NY,NX),NY,NX)+TNAER(NY,NX) + XKA(NU(NY,NX),NY,NX)=XKA(NU(NY,NX),NY,NX)+TKAER(NY,NX) + XHC(NU(NY,NX),NY,NX)=XHC(NU(NY,NX),NY,NX)+THCER(NY,NX) + XALO2(NU(NY,NX),NY,NX)=XALO2(NU(NY,NX),NY,NX)+TAL2ER(NY,NX) + XOH0(NU(NY,NX),NY,NX)=XOH0(NU(NY,NX),NY,NX)+TOH0ER(NY,NX) + XOH1(NU(NY,NX),NY,NX)=XOH1(NU(NY,NX),NY,NX)+TOH1ER(NY,NX) + XOH2(NU(NY,NX),NY,NX)=XOH2(NU(NY,NX),NY,NX)+TOH2ER(NY,NX) + XH1P(NU(NY,NX),NY,NX)=XH1P(NU(NY,NX),NY,NX)+TH1PER(NY,NX) + XH2P(NU(NY,NX),NY,NX)=XH2P(NU(NY,NX),NY,NX)+TH2PER(NY,NX) + XOH0B(NU(NY,NX),NY,NX)=XOH0B(NU(NY,NX),NY,NX)+TOH0EB(NY,NX) + XOH1B(NU(NY,NX),NY,NX)=XOH1B(NU(NY,NX),NY,NX)+TOH1EB(NY,NX) + XOH2B(NU(NY,NX),NY,NX)=XOH2B(NU(NY,NX),NY,NX)+TOH2EB(NY,NX) + XH1PB(NU(NY,NX),NY,NX)=XH1PB(NU(NY,NX),NY,NX)+TH1PEB(NY,NX) + XH2PB(NU(NY,NX),NY,NX)=XH2PB(NU(NY,NX),NY,NX)+TH2PEB(NY,NX) +C +C PRECIPITATES +C + PALOH(NU(NY,NX),NY,NX)=PALOH(NU(NY,NX),NY,NX)+TALOER(NY,NX) + PFEOH(NU(NY,NX),NY,NX)=PFEOH(NU(NY,NX),NY,NX)+TFEOER(NY,NX) + PCACO(NU(NY,NX),NY,NX)=PCACO(NU(NY,NX),NY,NX)+TCACER(NY,NX) + PCASO(NU(NY,NX),NY,NX)=PCASO(NU(NY,NX),NY,NX)+TCASER(NY,NX) + PALPO(NU(NY,NX),NY,NX)=PALPO(NU(NY,NX),NY,NX)+TALPER(NY,NX) + PFEPO(NU(NY,NX),NY,NX)=PFEPO(NU(NY,NX),NY,NX)+TFEPER(NY,NX) + PCAPD(NU(NY,NX),NY,NX)=PCAPD(NU(NY,NX),NY,NX)+TCPDER(NY,NX) + PCAPH(NU(NY,NX),NY,NX)=PCAPH(NU(NY,NX),NY,NX)+TCPHER(NY,NX) + PCAPM(NU(NY,NX),NY,NX)=PCAPM(NU(NY,NX),NY,NX)+TCPMER(NY,NX) + PALPB(NU(NY,NX),NY,NX)=PALPB(NU(NY,NX),NY,NX)+TALPEB(NY,NX) + PFEPB(NU(NY,NX),NY,NX)=PFEPB(NU(NY,NX),NY,NX)+TFEPEB(NY,NX) + PCPDB(NU(NY,NX),NY,NX)=PCPDB(NU(NY,NX),NY,NX)+TCPDEB(NY,NX) + PCPHB(NU(NY,NX),NY,NX)=PCPHB(NU(NY,NX),NY,NX)+TCPHEB(NY,NX) + PCPMB(NU(NY,NX),NY,NX)=PCPMB(NU(NY,NX),NY,NX)+TCPMEB(NY,NX) +C +C ORGANIC CONSTITUENTS +C + DO 9280 K=0,5 + DO 9280 NN=1,7 + DO 9280 M=1,3 + OMC(M,NN,K,NU(NY,NX),NY,NX)=OMC(M,NN,K,NU(NY,NX),NY,NX) + 2+TOMCER(M,NN,K,NY,NX) + OMN(M,NN,K,NU(NY,NX),NY,NX)=OMN(M,NN,K,NU(NY,NX),NY,NX) + 2+TOMNER(M,NN,K,NY,NX) + OMP(M,NN,K,NU(NY,NX),NY,NX)=OMP(M,NN,K,NU(NY,NX),NY,NX) + 2+TOMPER(M,NN,K,NY,NX) +9280 CONTINUE + DO 9275 K=0,4 + DO 9270 M=1,2 + ORC(M,K,NU(NY,NX),NY,NX)=ORC(M,K,NU(NY,NX),NY,NX) + 2+TORCER(M,K,NY,NX) + ORN(M,K,NU(NY,NX),NY,NX)=ORN(M,K,NU(NY,NX),NY,NX) + 2+TORNER(M,K,NY,NX) + ORP(M,K,NU(NY,NX),NY,NX)=ORP(M,K,NU(NY,NX),NY,NX) + 2+TORPER(M,K,NY,NX) +9270 CONTINUE + OHC(K,NU(NY,NX),NY,NX)=OHC(K,NU(NY,NX),NY,NX)+TOHCER(K,NY,NX) + OHN(K,NU(NY,NX),NY,NX)=OHN(K,NU(NY,NX),NY,NX)+TOHNER(K,NY,NX) + OHP(K,NU(NY,NX),NY,NX)=OHP(K,NU(NY,NX),NY,NX)+TOHPER(K,NY,NX) + OHA(K,NU(NY,NX),NY,NX)=OHA(K,NU(NY,NX),NY,NX)+TOHAER(K,NY,NX) + DO 9265 M=1,4 + OSC(M,K,NU(NY,NX),NY,NX)=OSC(M,K,NU(NY,NX),NY,NX) + 2+TOSCER(M,K,NY,NX) + OSA(M,K,NU(NY,NX),NY,NX)=OSA(M,K,NU(NY,NX),NY,NX) + 2+TOSAER(M,K,NY,NX) + OSN(M,K,NU(NY,NX),NY,NX)=OSN(M,K,NU(NY,NX),NY,NX) + 2+TOSNER(M,K,NY,NX) + OSP(M,K,NU(NY,NX),NY,NX)=OSP(M,K,NU(NY,NX),NY,NX) + 2+TOSPER(M,K,NY,NX) +9265 CONTINUE +9275 CONTINUE + ENDIF + ENDIF +C +C OVERLAND SNOW REDISTRIBUTION +C + IF(TQS(NY,NX).NE.0.0)THEN + CO2W(NY,NX)=CO2W(NY,NX)+TCOQSS(NY,NX) + CH4W(NY,NX)=CH4W(NY,NX)+TCHQSS(NY,NX) + OXYW(NY,NX)=OXYW(NY,NX)+TOXQSS(NY,NX) + ZNGW(NY,NX)=ZNGW(NY,NX)+TNGQSS(NY,NX) + ZN2W(NY,NX)=ZN2W(NY,NX)+TN2QSS(NY,NX) + ZN4W(NY,NX)=ZN4W(NY,NX)+TN4QSS(NY,NX) + ZN3W(NY,NX)=ZN3W(NY,NX)+TN3QSS(NY,NX) + ZNOW(NY,NX)=ZNOW(NY,NX)+TNOQSS(NY,NX) + ZHPW(NY,NX)=ZHPW(NY,NX)+TPOQSS(NY,NX) + IF(ISALT(NY,NX).NE.0)THEN + ZALW(NY,NX)=ZALW(NY,NX)+TQSAL(NY,NX) + ZFEW(NY,NX)=ZFEW(NY,NX)+TQSFE(NY,NX) + ZHYW(NY,NX)=ZHYW(NY,NX)+TQSHY(NY,NX) + ZCAW(NY,NX)=ZCAW(NY,NX)+TQSCA(NY,NX) + ZMGW(NY,NX)=ZMGW(NY,NX)+TQSMG(NY,NX) + ZNAW(NY,NX)=ZNAW(NY,NX)+TQSNA(NY,NX) + ZKAW(NY,NX)=ZKAW(NY,NX)+TQSKA(NY,NX) + ZOHW(NY,NX)=ZOHW(NY,NX)+TQSOH(NY,NX) + ZSO4W(NY,NX)=ZSO4W(NY,NX)+TQSSO(NY,NX) + ZCLW(NY,NX)=ZCLW(NY,NX)+TQSCL(NY,NX) + ZCO3W(NY,NX)=ZCO3W(NY,NX)+TQSC3(NY,NX) + ZHCO3W(NY,NX)=ZHCO3W(NY,NX)+TQSHC(NY,NX) + ZALH1W(NY,NX)=ZALH1W(NY,NX)+TQSAL1(NY,NX) + ZALH2W(NY,NX)=ZALH2W(NY,NX)+TQSAL2(NY,NX) + ZALH3W(NY,NX)=ZALH3W(NY,NX)+TQSAL3(NY,NX) + ZALH4W(NY,NX)=ZALH4W(NY,NX)+TQSAL4(NY,NX) + ZALSW(NY,NX)=ZALSW(NY,NX)+TQSALS(NY,NX) + ZFEH1W(NY,NX)=ZFEH1W(NY,NX)+TQSFE1(NY,NX) + ZFEH2W(NY,NX)=ZFEH2W(NY,NX)+TQSFE2(NY,NX) + ZFEH3W(NY,NX)=ZFEH3W(NY,NX)+TQSFE3(NY,NX) + ZFEH4W(NY,NX)=ZFEH4W(NY,NX)+TQSFE4(NY,NX) + ZFESW(NY,NX)=ZFESW(NY,NX)+TQSFES(NY,NX) + ZCAOW(NY,NX)=ZCAOW(NY,NX)+TQSCAO(NY,NX) + ZCACW(NY,NX)=ZCACW(NY,NX)+TQSCAC(NY,NX) + ZCAHW(NY,NX)=ZCAHW(NY,NX)+TQSCAH(NY,NX) + ZCASW(NY,NX)=ZCASW(NY,NX)+TQSCAS(NY,NX) + ZMGOW(NY,NX)=ZMGOW(NY,NX)+TQSMGO(NY,NX) + ZMGCW(NY,NX)=ZMGCW(NY,NX)+TQSMGC(NY,NX) + ZMGHW(NY,NX)=ZMGHW(NY,NX)+TQSMGH(NY,NX) + ZMGSW(NY,NX)=ZMGSW(NY,NX)+TQSMGS(NY,NX) + ZNACW(NY,NX)=ZNACW(NY,NX)+TQSNAC(NY,NX) + ZNASW(NY,NX)=ZNASW(NY,NX)+TQSNAS(NY,NX) + ZKASW(NY,NX)=ZKASW(NY,NX)+TQSKAS(NY,NX) + H0PO4W(NY,NX)=H0PO4W(NY,NX)+TQSH0P(NY,NX) + H1PO4W(NY,NX)=H1PO4W(NY,NX)+TQSH1P(NY,NX) + H3PO4W(NY,NX)=H3PO4W(NY,NX)+TQSH3P(NY,NX) + ZFE1PW(NY,NX)=ZFE1PW(NY,NX)+TQSF1P(NY,NX) + ZFE2PW(NY,NX)=ZFE2PW(NY,NX)+TQSF2P(NY,NX) + ZCA0PW(NY,NX)=ZCA0PW(NY,NX)+TQSC0P(NY,NX) + ZCA1PW(NY,NX)=ZCA1PW(NY,NX)+TQSC1P(NY,NX) + ZCA2PW(NY,NX)=ZCA2PW(NY,NX)+TQSC2P(NY,NX) + ZMG1PW(NY,NX)=ZMG1PW(NY,NX)+TQSM1P(NY,NX) + ENDIF + ENDIF +C +C UPDATE STATE VARIABLES WITH TOTAL FLUXES CALCULATED ABOVE +C +C IF(J.EQ.24)THEN +C +C TOTAL C,N,P IN SURFACE RESIDUE +C + RC=0.0 + RN=0.0 + RP=0.0 + DO 6975 K=0,5 + RC0(K,NY,NX)=0.0 + RA0(K,NY,NX)=0.0 +6975 CONTINUE + OMCL(0,NY,NX)=0.0 + OMNL(0,NY,NX)=0.0 + DO 6970 K=0,5 + IF(K.NE.3.AND.K.NE.4)THEN +C +C TOTAL MICROBIAL C,N,P +C + DO 6960 N=1,7 + DO 6960 M=1,3 + RC=RC+OMC(M,N,K,0,NY,NX) + RN=RN+OMN(M,N,K,0,NY,NX) + RP=RP+OMP(M,N,K,0,NY,NX) + RC0(K,NY,NX)=RC0(K,NY,NX)+OMC(M,N,K,0,NY,NX) + RA0(K,NY,NX)=RA0(K,NY,NX)+OMC(M,N,K,0,NY,NX) + TOMT(NY,NX)=TOMT(NY,NX)+OMC(M,N,K,0,NY,NX) + TONT(NY,NX)=TONT(NY,NX)+OMN(M,N,K,0,NY,NX) + TOPT(NY,NX)=TOPT(NY,NX)+OMP(M,N,K,0,NY,NX) + OMCL(0,NY,NX)=OMCL(0,NY,NX)+OMC(M,N,K,0,NY,NX) + OMNL(0,NY,NX)=OMNL(0,NY,NX)+OMN(M,N,K,0,NY,NX) +6960 CONTINUE + ENDIF +6970 CONTINUE +C +C TOTAL MICROBIAL RESIDUE C,N,P +C + DO 6900 K=0,2 + DO 6940 M=1,2 + RC=RC+ORC(M,K,0,NY,NX) + RN=RN+ORN(M,K,0,NY,NX) + RP=RP+ORP(M,K,0,NY,NX) + RC0(K,NY,NX)=RC0(K,NY,NX)+ORC(M,K,0,NY,NX) + RA0(K,NY,NX)=RA0(K,NY,NX)+ORC(M,K,0,NY,NX) +6940 CONTINUE +C +C TOTAL DOC, DON, DOP +C + RC=RC+OQC(K,0,NY,NX)+OQCH(K,0,NY,NX)+OHC(K,0,NY,NX)+OQA(K,0,NY,NX) + 2+OQAH(K,0,NY,NX)+OHA(K,0,NY,NX) + RN=RN+OQN(K,0,NY,NX)+OQNH(K,0,NY,NX)+OHN(K,0,NY,NX) + RP=RP+OQP(K,0,NY,NX)+OQPH(K,0,NY,NX)+OHP(K,0,NY,NX) + RC0(K,NY,NX)=RC0(K,NY,NX)+OQC(K,0,NY,NX)+OQCH(K,0,NY,NX) + 2+OHC(K,0,NY,NX)+OQA(K,0,NY,NX)+OQAH(K,0,NY,NX)+OHA(K,0,NY,NX) + RA0(K,NY,NX)=RA0(K,NY,NX)+OQC(K,0,NY,NX)+OQCH(K,0,NY,NX) + 2+OHC(K,0,NY,NX)+OQA(K,0,NY,NX)+OQAH(K,0,NY,NX)+OHA(K,0,NY,NX) +C +C TOTAL PLANT RESIDUE C,N,P +C + DO 6930 M=1,4 + RC=RC+OSC(M,K,0,NY,NX) + RN=RN+OSN(M,K,0,NY,NX) + RP=RP+OSP(M,K,0,NY,NX) + RC0(K,NY,NX)=RC0(K,NY,NX)+OSC(M,K,0,NY,NX) + RA0(K,NY,NX)=RA0(K,NY,NX)+OSA(M,K,0,NY,NX) +6930 CONTINUE +6900 CONTINUE + ORGC(0,NY,NX)=RC + ORGN(0,NY,NX)=RN + ORGR(0,NY,NX)=RC + TLRSDC=TLRSDC+RC + URSDC(NY,NX)=URSDC(NY,NX)+RC + TLRSDN=TLRSDN+RN + URSDN(NY,NX)=URSDN(NY,NX)+RN + TLRSDP=TLRSDP+RP + URSDP(NY,NX)=URSDP(NY,NX)+RP + WS=TVOLWC(NY,NX)+TVOLWP(NY,NX)+VOLW(0,NY,NX)+VOLI(0,NY,NX)*0.92 + VOLWSO=VOLWSO+WS + UVOLW(NY,NX)=UVOLW(NY,NX)+WS + ENGYR=VHCPR(NY,NX)*TKS(0,NY,NX) + HEATSO=HEATSO+TENGYC(NY,NX)+ENGYR + CS=CO2S(0,NY,NX)+CH4S(0,NY,NX) + TLCO2G=TLCO2G+CS + UCO2S(NY,NX)=UCO2S(NY,NX)+CS + OS=OXYS(0,NY,NX) + OXYGSO=OXYGSO+OS + ZG=Z2GS(0,NY,NX)+Z2OS(0,NY,NX) + TLN2G=TLN2G+ZG + ZNH=ZNH4S(0,NY,NX)+ZNH3S(0,NY,NX) + TLNH4=TLNH4+ZNH + UNH4(NY,NX)=UNH4(NY,NX)+ZNH+14.0*(XN4(0,NY,NX)+XNB(0,NY,NX)) + XN4(0,NY,NX)=XN4(0,NY,NX)+TRXN4(0,NY,NX) + ZNO=ZNO3S(0,NY,NX)+ZNO2S(0,NY,NX) + TLNO3=TLNO3+ZNO + UNO3(NY,NX)=UNO3(NY,NX)+ZNO + P4=H2PO4(0,NY,NX) + TLPO4=TLPO4+P4 + UPO4(NY,NX)=UPO4(NY,NX)+P4+31.0*(XH1P(0,NY,NX)+XH2P(0,NY,NX)) + PALPO(0,NY,NX)=PALPO(0,NY,NX)+TRALPO(0,NY,NX) + PFEPO(0,NY,NX)=PFEPO(0,NY,NX)+TRFEPO(0,NY,NX) + PCAPD(0,NY,NX)=PCAPD(0,NY,NX)+TRCAPD(0,NY,NX) + PCAPH(0,NY,NX)=PCAPH(0,NY,NX)+TRCAPH(0,NY,NX) + PCAPM(0,NY,NX)=PCAPM(0,NY,NX)+TRCAPM(0,NY,NX) + UPP4(NY,NX)=UPP4(NY,NX)+31.0*(PALPO(0,NY,NX)+PFEPO(0,NY,NX) + 2+PCAPD(0,NY,NX))+93.0*PCAPH(0,NY,NX)+62.0*PCAPM(0,NY,NX) + TX=2.0*XN4(0,NY,NX)+XOH0(0,NY,NX) + 2+2.0*(PALPO(0,NY,NX)+PFEPO(0,NY,NX)+XOH1(0,NY,NX)) + 3+3.0*(PCAPD(0,NY,NX)+XOH2(0,NY,NX)+XH1P(0,NY,NX)) + 4+4.0*XH2P(0,NY,NX)+7.0*PCAPM(0,NY,NX)+9.0*PCAPH(0,NY,NX) + TF=2.0*ZNH4FA(0,NY,NX)+ZNHUFA(0,NY,NX)+ZNO3FA(0,NY,NX) + 2+ZNH3FA(0,NY,NX) + TG=H2GS(0,NY,NX) + TI=TX+TF+TG + TION=TION+TI + UION(NY,NX)=UION(NY,NX)+TI + + IF(ISALT(NY,NX).NE.0)THEN + ZAL(0,NY,NX)=ZAL(0,NY,NX)+XALFLS(3,0,NY,NX) + ZFE(0,NY,NX)=ZFE(0,NY,NX)+XFEFLS(3,0,NY,NX) + ZHY(0,NY,NX)=ZHY(0,NY,NX)+XHYFLS(3,0,NY,NX) + ZCA(0,NY,NX)=ZCA(0,NY,NX)+XCAFLS(3,0,NY,NX) + ZMG(0,NY,NX)=ZMG(0,NY,NX)+XMGFLS(3,0,NY,NX) + ZNA(0,NY,NX)=ZNA(0,NY,NX)+XNAFLS(3,0,NY,NX) + ZKA(0,NY,NX)=ZKA(0,NY,NX)+XKAFLS(3,0,NY,NX) + ZOH(0,NY,NX)=ZOH(0,NY,NX)+XOHFLS(3,0,NY,NX) + ZSO4(0,NY,NX)=ZSO4(0,NY,NX)+XSOFLS(3,0,NY,NX) + ZCL(0,NY,NX)=ZCL(0,NY,NX)+XCLFLS(3,0,NY,NX) + ZCO3(0,NY,NX)=ZCO3(0,NY,NX)+XC3FLS(3,0,NY,NX) + ZHCO3(0,NY,NX)=ZHCO3(0,NY,NX)+XHCFLS(3,0,NY,NX) + ZALOH1(0,NY,NX)=ZALOH1(0,NY,NX)+XAL1FS(3,0,NY,NX) + ZALOH2(0,NY,NX)=ZALOH2(0,NY,NX)+XAL2FS(3,0,NY,NX) + ZALOH3(0,NY,NX)=ZALOH3(0,NY,NX)+XAL3FS(3,0,NY,NX) + ZALOH4(0,NY,NX)=ZALOH4(0,NY,NX)+XAL4FS(3,0,NY,NX) + ZALS(0,NY,NX)=ZALS(0,NY,NX)+XALSFS(3,0,NY,NX) + ZFEOH1(0,NY,NX)=ZFEOH1(0,NY,NX)+XFE1FS(3,0,NY,NX) + ZFEOH2(0,NY,NX)=ZFEOH2(0,NY,NX)+XFE2FS(3,0,NY,NX) + ZFEOH3(0,NY,NX)=ZFEOH3(0,NY,NX)+XFE3FS(3,0,NY,NX) + ZFEOH4(0,NY,NX)=ZFEOH4(0,NY,NX)+XFE4FS(3,0,NY,NX) + ZFES(0,NY,NX)=ZFES(0,NY,NX)+XFESFS(3,0,NY,NX) + ZCAO(0,NY,NX)=ZCAO(0,NY,NX)+XCAOFS(3,0,NY,NX) + ZCAC(0,NY,NX)=ZCAC(0,NY,NX)+XCACFS(3,0,NY,NX) + ZCAH(0,NY,NX)=ZCAH(0,NY,NX)+XCAHFS(3,0,NY,NX) + ZCAS(0,NY,NX)=ZCAS(0,NY,NX)+XCASFS(3,0,NY,NX) + ZMGO(0,NY,NX)=ZMGO(0,NY,NX)+XMGOFS(3,0,NY,NX) + ZMGC(0,NY,NX)=ZMGC(0,NY,NX)+XMGCFS(3,0,NY,NX) + ZMGH(0,NY,NX)=ZMGH(0,NY,NX)+XMGHFS(3,0,NY,NX) + ZMGS(0,NY,NX)=ZMGS(0,NY,NX)+XMGSFS(3,0,NY,NX) + ZNAC(0,NY,NX)=ZNAC(0,NY,NX)+XNACFS(3,0,NY,NX) + ZNAS(0,NY,NX)=ZNAS(0,NY,NX)+XNASFS(3,0,NY,NX) + ZKAS(0,NY,NX)=ZKAS(0,NY,NX)+XKASFS(3,0,NY,NX) + H0PO4(0,NY,NX)=H0PO4(0,NY,NX)+XH0PFS(3,0,NY,NX) + H1PO4(0,NY,NX)=H1PO4(0,NY,NX)+XH1PFS(3,0,NY,NX) + H3PO4(0,NY,NX)=H3PO4(0,NY,NX)+XH3PFS(3,0,NY,NX) + ZFE1P(0,NY,NX)=ZFE1P(0,NY,NX)+XF1PFS(3,0,NY,NX) + ZFE2P(0,NY,NX)=ZFE2P(0,NY,NX)+XF2PFS(3,0,NY,NX) + ZCA0P(0,NY,NX)=ZCA0P(0,NY,NX)+XC0PFS(3,0,NY,NX) + ZCA1P(0,NY,NX)=ZCA1P(0,NY,NX)+XC1PFS(3,0,NY,NX) + ZCA2P(0,NY,NX)=ZCA2P(0,NY,NX)+XC2PFS(3,0,NY,NX) + ZMG1P(0,NY,NX)=ZMG1P(0,NY,NX)+XM1PFS(3,0,NY,NX) + TS=ZAL(0,NY,NX)+ZFE(0,NY,NX)+ZHY(0,NY,NX)+ZCA(0,NY,NX) + 2+ZMG(0,NY,NX)+ZNA(0,NY,NX)+ZKA(0,NY,NX)+ZOH(0,NY,NX) + 3+ZSO4(0,NY,NX)+ZCL(0,NY,NX)+ZCO3(0,NY,NX)+H0PO4(0,NY,NX) + 4+2.0*(ZHCO3(0,NY,NX)+ZALOH1(0,NY,NX) + 5+ZALS(0,NY,NX)+ZFEOH1(0,NY,NX)+ZFES(0,NY,NX)+ZCAO(0,NY,NX) + 6+ZCAC(0,NY,NX)+ZCAS(0,NY,NX)+ZMGO(0,NY,NX)+ZMGC(0,NY,NX) + 7+ZMGS(0,NY,NX)+ZNAC(0,NY,NX)+ZNAS(0,NY,NX)+ZKAS(0,NY,NX) + 8+H1PO4(0,NY,NX)+ZCA0P(0,NY,NX)) + 9+3.0*(ZALOH2(0,NY,NX)+ZFEOH2(0,NY,NX)+ZCAH(0,NY,NX) + 1+ZMGH(0,NY,NX)+ZFE1P(0,NY,NX)+ZCA1P(0,NY,NX)+ZMG1P(0,NY,NX)) + 2+4.0* + 3(ZALOH3(0,NY,NX)+ZFEOH3(0,NY,NX)+H3PO4(0,NY,NX)+ZFE2P(0,NY,NX) + 4+ZCA2P(0,NY,NX))+5.0*(ZALOH4(0,NY,NX)+ZFEOH4(0,NY,NX)) + TION=TION+TS + UION(NY,NX)=UION(NY,NX)+TS + ENDIF +C ENDIF +C +C IF SNOWPACK OR SURFACE RESIDUE DISAPPEARS +C + IF(FLWSI(NY,NX).GT.0.0)THEN + VHCP(NU(NY,NX),NY,NX)=VHCM(NU(NY,NX),NY,NX) + 2+4.19*(VOLW(NU(NY,NX),NY,NX)+VOLWH(NU(NY,NX),NY,NX)) + 2+1.9274*(VOLI(NU(NY,NX),NY,NX)+VOLIH(NU(NY,NX),NY,NX)) + VOLI(NU(NY,NX),NY,NX)=VOLI(NU(NY,NX),NY,NX)+FLWSI(NY,NX) + ENGY=VHCP(NU(NY,NX),NY,NX)*TKS(NU(NY,NX),NY,NX) + VHCP(NU(NY,NX),NY,NX)=VHCM(NU(NY,NX),NY,NX) + 2+4.19*(VOLW(NU(NY,NX),NY,NX)+VOLWH(NU(NY,NX),NY,NX)) + 2+1.9274*(VOLI(NU(NY,NX),NY,NX)+VOLIH(NU(NY,NX),NY,NX)) + TKS(NU(NY,NX),NY,NX)=(ENGY+HFLWSI(NY,NX))/VHCP(NU(NY,NX),NY,NX) + ENDIF + VOLWX(NU(NY,NX),NY,NX)=VOLW(NU(NY,NX),NY,NX) + TCS(0,NY,NX)=TKS(0,NY,NX)-273.15 + TSMX(0,NY,NX)=AMAX1(TSMX(0,NY,NX),TCS(0,NY,NX)) + TSMN(0,NY,NX)=AMIN1(TSMN(0,NY,NX),TCS(0,NY,NX)) +C +C UPDATE SOIL LAYER VARIABLES WITH TOTAL FLUXES +C + DO 125 L=NU(NY,NX),NL(NY,NX) +C +C WATER, ICE, HEAT, TEMPERATURE +C + VHCP(L,NY,NX)=VHCM(L,NY,NX)+4.19*(VOLW(L,NY,NX)+VOLWH(L,NY,NX)) + 2+1.9274*(VOLI(L,NY,NX)+VOLIH(L,NY,NX)) + VOLW1=VOLW(L,NY,NX) + VOLW(L,NY,NX)=VOLW(L,NY,NX)+TFLW(L,NY,NX)+FINH(L,NY,NX) + 2+TTHAW(L,NY,NX)+TUPWTR(L,NY,NX) + 3+FLU(L,NY,NX)+18.0E-06*TRH2O(L,NY,NX) + IF(VOLW(L,NY,NX).GT.ZEROS(NY,NX))THEN + VOLWX(L,NY,NX)=VOLWX(L,NY,NX)+TFLWX(L,NY,NX)+FINH(L,NY,NX) + 2+TTHAW(L,NY,NX)+TUPWTR(L,NY,NX)*VOLWX(L,NY,NX)/VOLW(L,NY,NX) + 3+FLU(L,NY,NX)+18.0E-06*TRH2O(L,NY,NX)+FLWV(L,NY,NX) + VOLWX(L,NY,NX)=AMAX1(THETY(L,NY,NX)*VOLX(L,NY,NX) + 2,AMIN1(VOLW(L,NY,NX),VOLWX(L,NY,NX))) + ELSE + VOLWX(L,NY,NX)=0.0 + ENDIF + VOLI(L,NY,NX)=VOLI(L,NY,NX)-TTHAW(L,NY,NX)/0.92 + VOLWH(L,NY,NX)=VOLWH(L,NY,NX)+TFLWH(L,NY,NX)-FINH(L,NY,NX) + 2+TTHAWH(L,NY,NX) + VOLIH(L,NY,NX)=VOLIH(L,NY,NX)-TTHAWH(L,NY,NX)/0.92 + 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)) + ENGY=VHCP(L,NY,NX)*TKS(L,NY,NX) + VHCP1=VHCP(L,NY,NX) + TKS1=TKS(L,NY,NX) + VHCP(L,NY,NX)=VHCM(L,NY,NX)+4.19*(VOLW(L,NY,NX)+VOLWH(L,NY,NX)) + 2+1.9274*(VOLI(L,NY,NX)+VOLIH(L,NY,NX)) +C +C ARTIFICIAL SOIL WARMING +C +C IF(NX.EQ.3.AND.NY.EQ.2.AND.L.GT.NU(NY,NX) +C 3.AND.L.LE.17.AND.I.GE.152.AND.I.LE.304)THEN +C THFLW(L,NY,NX)=THFLW(L,NY,NX) +C 2+(TKSZ(I,J,L)-TKS(L,NY,NX))*VHCP(L,NY,NX) +C WRITE(*,3379)'TKSZ',I,J,NX,NY,L,TKSZ(I,J,L) +C 2,TKS(L,NY,NX),VHCP(L,NY,NX),THFLW(L,NY,NX) +3379 FORMAT(A8,6I4,12E12.4) +C ENDIF +C +C 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) + TCS(L,NY,NX)=TKS(L,NY,NX)-273.15 + TSMX(L,NY,NX)=AMAX1(TSMX(L,NY,NX),TCS(L,NY,NX)) + TSMN(L,NY,NX)=AMIN1(TSMN(L,NY,NX),TCS(L,NY,NX)) + UN2GS(NY,NX)=UN2GS(NY,NX)+XN2GS(L,NY,NX) +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),18.0E-06*TRH2O(L,NY,NX),TQR(NY,NX) +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) +6547 FORMAT(A8,5I4,20E16.8) +C WRITE(*,6633)'TKS',I,J,NX,NY,L,TKS(L,NY,NX),ENGY,THFLW(L,NY,NX) +C 2,THTHAW(L,NY,NX),TUPHT(L,NY,NX),HWFLU(L,NY,NX),VHCP(L,NY,NX) +C 3,VHCP1,TKS1,VOLW(L,NY,NX),VOLWH(L,NY,NX),VOLI(L,NY,NX) +C 4,VOLIH(L,NY,NX),TFLW(L,NY,NX),FINH(L,NY,NX),TTHAW(L,NY,NX) +C 5,TUPWTR(L,NY,NX),FLU(L,NY,NX),TRH2O(L,NY,NX),TQR(NY,NX) +C 6,FLWSI(NY,NX),HFLWSI(NY,NX) +6633 FORMAT(A8,5I4,30F20.6) +C ENDIF +C +C RESIDUE FROM PLANT LITTERFALL +C + DO 8565 K=0,1 + DO 8565 M=1,4 + OSC(M,K,L,NY,NX)=OSC(M,K,L,NY,NX)+CSNT(M,K,L,NY,NX) + OSN(M,K,L,NY,NX)=OSN(M,K,L,NY,NX)+ZSNT(M,K,L,NY,NX) + OSP(M,K,L,NY,NX)=OSP(M,K,L,NY,NX)+PSNT(M,K,L,NY,NX) +C IF((I/30)*30.EQ.I.AND.J.EQ.15)THEN +C WRITE(*,8484)'OSC',I,J,L,K,M,OSC(M,K,L,NY,NX) +C 2,OSN(M,K,L,NY,NX),OSP(M,K,L,NY,NX),CSNT(M,K,L,NY,NX) +C 3,ZSNT(M,K,L,NY,NX),PSNT(M,K,L,NY,NX) +8484 FORMAT(A8,5I4,12E12.4) +C ENDIF +8565 CONTINUE +C +C DOC, DON, DOP FROM AQUEOUS TRANSPORT +C + DO 8560 K=0,4 + OQC(K,L,NY,NX)=OQC(K,L,NY,NX)+TOCFLS(K,L,NY,NX) + 2+XOCFXS(K,L,NY,NX) + OQN(K,L,NY,NX)=OQN(K,L,NY,NX)+TONFLS(K,L,NY,NX) + 2+XONFXS(K,L,NY,NX) + OQP(K,L,NY,NX)=OQP(K,L,NY,NX)+TOPFLS(K,L,NY,NX) + 2+XOPFXS(K,L,NY,NX) + OQA(K,L,NY,NX)=OQA(K,L,NY,NX)+TOAFLS(K,L,NY,NX) + 2+XOAFXS(K,L,NY,NX) + OQCH(K,L,NY,NX)=OQCH(K,L,NY,NX)+TOCFHS(K,L,NY,NX) + 2-XOCFXS(K,L,NY,NX) + OQNH(K,L,NY,NX)=OQNH(K,L,NY,NX)+TONFHS(K,L,NY,NX) + 2-XONFXS(K,L,NY,NX) + OQPH(K,L,NY,NX)=OQPH(K,L,NY,NX)+TOPFHS(K,L,NY,NX) + 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 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,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) +C ENDIF +8560 CONTINUE +C +C DOC, DON, DOP FROM PLANT EXUDATION +C + DO 195 K=0,4 + OQC(K,L,NY,NX)=OQC(K,L,NY,NX)+TDFOMC(K,L,NY,NX) + OQN(K,L,NY,NX)=OQN(K,L,NY,NX)+TDFOMN(K,L,NY,NX) + OQP(K,L,NY,NX)=OQP(K,L,NY,NX)+TDFOMP(K,L,NY,NX) +195 CONTINUE +C +C SOIL SOLUTES FROM AQUEOUS TRANSPORT, MICROBIAL AND ROOT +C EXCHANGE, EQUILIBRIUM REACTIONS, GAS EXCHANGE, +C MICROPORE-MACROPORE EXCHANGE, +C + CO2S(L,NY,NX)=CO2S(L,NY,NX)+TCOFLS(L,NY,NX)+XCODFG(L,NY,NX) + 2-RCO2O(L,NY,NX)-TCO2S(L,NY,NX)+RCOFLU(L,NY,NX)+XCOFXS(L,NY,NX) + 3+TRCO2(L,NY,NX)+XCOBBL(L,NY,NX) + CH4S(L,NY,NX)=CH4S(L,NY,NX)+TCHFLS(L,NY,NX)+XCHDFG(L,NY,NX) + 2-RCH4O(L,NY,NX)-TUPCHS(L,NY,NX)+RCHFLU(L,NY,NX) + 3+XCHFXS(L,NY,NX)+XCHBBL(L,NY,NX) + 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 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 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 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) +5432 FORMAT(A8,5I4,20E16.6) +C ENDIF + Z2GS(L,NY,NX)=Z2GS(L,NY,NX)+TNGFLS(L,NY,NX)+XNGDFG(L,NY,NX) + 2-RN2G(L,NY,NX)-TUPNF(L,NY,NX)+RNGFLU(L,NY,NX)+XNGFXS(L,NY,NX) + 3-XN2GS(L,NY,NX)+XNGBBL(L,NY,NX) + Z2OS(L,NY,NX)=Z2OS(L,NY,NX)+TN2FLS(L,NY,NX)+XN2DFG(L,NY,NX) + 2-RN2O(L,NY,NX)-TUPN2S(L,NY,NX)+RN2FLU(L,NY,NX)+XN2FXS(L,NY,NX) + 3+XN2BBL(L,NY,NX) +C IF(I.GT.160.AND.I.LT.190)THEN +C WRITE(*,4444)'Z2OS',I,J,NX,NY,L,Z2OS(L,NY,NX),TN2FLS(L,NY,NX) +C 2,XN2DFG(L,NY,NX),RN2O(L,NY,NX),TUPN2S(L,NY,NX),RN2FLU(L,NY,NX) +C 3,XN2FXS(L,NY,NX),Z2GS(L,NY,NX),TNGFLS(L,NY,NX),XNGDFG(L,NY,NX) +C 4,RN2G(L,NY,NX),TUPNF(L,NY,NX),RNGFLU(L,NY,NX),XNGFXS(L,NY,NX) +C 5,XN2GS(L,NY,NX),XNGBBL(L,NY,NX) +C ENDIF + H2GS(L,NY,NX)=H2GS(L,NY,NX)+THGFLS(L,NY,NX)+XHGDFG(L,NY,NX) + 2-RH2GO(L,NY,NX)-TUPHGS(L,NY,NX)+RHGFLU(L,NY,NX) + 3+XHGFXS(L,NY,NX)+XHGBBL(L,NY,NX) + ZNH3S(L,NY,NX)=ZNH3S(L,NY,NX)+TN3FLS(L,NY,NX)+XN3DFG(L,NY,NX) + 2-XN34SQ(L,NY,NX)+TRN3S(L,NY,NX)-TUPN3S(L,NY,NX)+RN3FLU(L,NY,NX) + 3+XN3FXW(L,NY,NX)+XN3BBL(L,NY,NX) + ZNH4S(L,NY,NX)=ZNH4S(L,NY,NX)+TN4FLS(L,NY,NX)+XNH4S(L,NY,NX) + 2+TRN4S(L,NY,NX)-TUPNH4(L,NY,NX)+RN4FLU(L,NY,NX) + 3+XN4FXW(L,NY,NX)+XN34SQ(L,NY,NX) +C IF(L.EQ.1)THEN +C WRITE(*,4444)'NH3',I,J,NX,NY,L,ZNH3S(L,NY,NX),TN3FLS(L,NY,NX) +C 2,XN3DFG(L,NY,NX),XN34SQ(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),ZNH4S(L,NY,NX) +C 4,TN4FLS(L,NY,NX),XNH4S(L,NY,NX),TRN4S(L,NY,NX),TUPNH4(L,NY,NX) +C 5,RN4FLU(L,NY,NX),XN4FXW(L,NY,NX),TN4QRS(NY,NX),TN3QRS(NY,NX) +C 6,ZNH3SH(L,NY,NX),ZNH4SH(L,NY,NX) +4444 FORMAT(A8,5I4,30E12.4) +C ENDIF + ZNO3S(L,NY,NX)=ZNO3S(L,NY,NX)+TNOFLS(L,NY,NX)+XNO3S(L,NY,NX) + 2+TRNO3(L,NY,NX)-TUPNO3(L,NY,NX)+RNOFLU(L,NY,NX) + 3+XNOFXW(L,NY,NX) + ZNO2S(L,NY,NX)=ZNO2S(L,NY,NX)+TNXFLS(L,NY,NX)+XNO2S(L,NY,NX) + 2+TRNO2(L,NY,NX)+XNXFXS(L,NY,NX) +C IF(L.EQ.NU(NY,NX))THEN +C WRITE(*,5545)'NO3',I,J,NX,NY,L,ZNO3S(L,NY,NX),TNOFLS(L,NY,NX) +C 2,XNO3S(L,NY,NX),TRNO3(L,NY,NX),TUPNO3(L,NY,NX),RNOFLU(L,NY,NX) +C 3,XNOFXW(L,NY,NX),ZNO2S(L,NY,NX),TNXFLS(L,NY,NX) +C 4,XNO2S(L,NY,NX),TRNO2(L,NY,NX),XNXFXS(L,NY,NX),TNXQRS(NY,NX) +5545 FORMAT(A8,5I4,40E12.4) +C ENDIF + H2PO4(L,NY,NX)=H2PO4(L,NY,NX)+TPOFLS(L,NY,NX)+XH2PS(L,NY,NX) + 2+TRH2P(L,NY,NX)-TUPH2P(L,NY,NX)+RH2PFU(L,NY,NX) + 3+XH2PXS(L,NY,NX) + ZNH3B(L,NY,NX)=ZNH3B(L,NY,NX)+TN3FLB(L,NY,NX)+XNBDFG(L,NY,NX) + 2-XN34BQ(L,NY,NX)+TRN3B(L,NY,NX)-TUPN3B(L,NY,NX)+RN3FBU(L,NY,NX) + 3+XN3FXB(L,NY,NX)+XNBBBL(L,NY,NX) + ZNH4B(L,NY,NX)=ZNH4B(L,NY,NX)+TN4FLB(L,NY,NX)+XNH4B(L,NY,NX) + 2+TRN4B(L,NY,NX)-TUPNHB(L,NY,NX)+RN4FBU(L,NY,NX) + 3+XN4FXB(L,NY,NX)+XN34BQ(L,NY,NX) + ZNO3B(L,NY,NX)=ZNO3B(L,NY,NX)+TNOFLB(L,NY,NX)+XNO3B(L,NY,NX) + 2+TRNOB(L,NY,NX)-TUPNOB(L,NY,NX)+RNOFBU(L,NY,NX) + 3+XNOFXB(L,NY,NX) + ZNO2B(L,NY,NX)=ZNO2B(L,NY,NX)+TNXFLB(L,NY,NX)+XNO2B(L,NY,NX) + 2+TRN2B(L,NY,NX)+XNXFXB(L,NY,NX) + H2POB(L,NY,NX)=H2POB(L,NY,NX)+TH2BFB(L,NY,NX)+XH2BS(L,NY,NX) + 2+TRH2B(L,NY,NX)-TUPH2B(L,NY,NX)+RH2BBU(L,NY,NX) + 3+XH2BXB(L,NY,NX) + THRE(NY,NX)=THRE(NY,NX)+RCO2O(L,NY,NX) + UN2GG(NY,NX)=UN2GG(NY,NX)+RN2G(L,NY,NX) + HN2GG(NY,NX)=HN2GG(NY,NX)+RN2G(L,NY,NX) +C +C EXCHANGEABLE CATIONS AND ANIONS FROM EXCHANGE REACTIONS +C + XN4(L,NY,NX)=XN4(L,NY,NX)+TRXN4(L,NY,NX) + XNB(L,NY,NX)=XNB(L,NY,NX)+TRXNB(L,NY,NX) + XOH0(L,NY,NX)=XOH0(L,NY,NX)+TRXH0(L,NY,NX) + XOH1(L,NY,NX)=XOH1(L,NY,NX)+TRXH1(L,NY,NX) + XOH2(L,NY,NX)=XOH2(L,NY,NX)+TRXH2(L,NY,NX) + XH1P(L,NY,NX)=XH1P(L,NY,NX)+TRX1P(L,NY,NX) + XH2P(L,NY,NX)=XH2P(L,NY,NX)+TRX2P(L,NY,NX) + XOH0B(L,NY,NX)=XOH0B(L,NY,NX)+TRBH0(L,NY,NX) + XOH1B(L,NY,NX)=XOH1B(L,NY,NX)+TRBH1(L,NY,NX) + XOH2B(L,NY,NX)=XOH2B(L,NY,NX)+TRBH2(L,NY,NX) + XH1PB(L,NY,NX)=XH1PB(L,NY,NX)+TRB1P(L,NY,NX) + XH2PB(L,NY,NX)=XH2PB(L,NY,NX)+TRB2P(L,NY,NX) +C IF(J.EQ.12.AND.L.LE.4)THEN +C WRITE(*,4445)'NHB',I,J,NX,NY,L,ZNH3B(L,NY,NX),TN3FLB(L,NY,NX) +C 2,XNBDFG(L,NY,NX),XN34BQ(L,NY,NX),TRN3B(L,NY,NX),TUPN3B(L,NY,NX) +C 3,RN3FBU(L,NY,NX),XN3FXB(L,NY,NX),XNBBBL(L,NY,NX),TUPNHB(L,NY,NX) +C 4,ZNH4B(L,NY,NX),TN4FLB(L,NY,NX),XNH4B(L,NY,NX) +C 5,TRN4B(L,NY,NX),TUPNHB(L,NY,NX),RN4FBU(L,NY,NX),XNB(L,NY,NX)*14.0 +C WRITE(*,4445)'NOB',I,J,NX,NY,L,ZNO2B(L,NY,NX),TNXFLB(L,NY,NX) +C 2,XNO2B(L,NY,NX),TRN2B(L,NY,NX),XNXFXB(L,NY,NX) +4445 FORMAT(A8,5I4,20E12.4) +C ENDIF +C +C PRECIPITATES FROM PRECIPITATION-DISSOLUTION REACTIONS +C + PALPO(L,NY,NX)=PALPO(L,NY,NX)+TRALPO(L,NY,NX) + PFEPO(L,NY,NX)=PFEPO(L,NY,NX)+TRFEPO(L,NY,NX) + PCAPD(L,NY,NX)=PCAPD(L,NY,NX)+TRCAPD(L,NY,NX) + PCAPH(L,NY,NX)=PCAPH(L,NY,NX)+TRCAPH(L,NY,NX) + PCAPM(L,NY,NX)=PCAPM(L,NY,NX)+TRCAPM(L,NY,NX) + PALPB(L,NY,NX)=PALPB(L,NY,NX)+TRALPB(L,NY,NX) + PFEPB(L,NY,NX)=PFEPB(L,NY,NX)+TRFEPB(L,NY,NX) + PCPDB(L,NY,NX)=PCPDB(L,NY,NX)+TRCPDB(L,NY,NX) + PCPHB(L,NY,NX)=PCPHB(L,NY,NX)+TRCPHB(L,NY,NX) + PCPMB(L,NY,NX)=PCPMB(L,NY,NX)+TRCPMB(L,NY,NX) +C +C MACROPORE SOLUTES FROM MACROPORE-MICROPORE EXCHANGE +C + CO2SH(L,NY,NX)=CO2SH(L,NY,NX)+TCOFHS(L,NY,NX)-XCOFXS(L,NY,NX) + CH4SH(L,NY,NX)=CH4SH(L,NY,NX)+TCHFHS(L,NY,NX)-XCHFXS(L,NY,NX) + OXYSH(L,NY,NX)=OXYSH(L,NY,NX)+TOXFHS(L,NY,NX)-XOXFXS(L,NY,NX) + Z2GSH(L,NY,NX)=Z2GSH(L,NY,NX)+TNGFHS(L,NY,NX)-XNGFXS(L,NY,NX) + Z2OSH(L,NY,NX)=Z2OSH(L,NY,NX)+TN2FHS(L,NY,NX)-XN2FXS(L,NY,NX) + H2GSH(L,NY,NX)=H2GSH(L,NY,NX)+THGFHS(L,NY,NX)-XHGFXS(L,NY,NX) + ZNH4SH(L,NY,NX)=ZNH4SH(L,NY,NX)+TN4FHS(L,NY,NX)-XN4FXW(L,NY,NX) + ZNH3SH(L,NY,NX)=ZNH3SH(L,NY,NX)+TN3FHS(L,NY,NX)-XN3FXW(L,NY,NX) + ZNO3SH(L,NY,NX)=ZNO3SH(L,NY,NX)+TNOFHS(L,NY,NX)-XNOFXW(L,NY,NX) + ZNO2SH(L,NY,NX)=ZNO2SH(L,NY,NX)+TNXFHS(L,NY,NX)-XNXFXS(L,NY,NX) + H2PO4H(L,NY,NX)=H2PO4H(L,NY,NX)+TPOFHS(L,NY,NX)-XH2PXS(L,NY,NX) + ZNH4BH(L,NY,NX)=ZNH4BH(L,NY,NX)+TN4FHB(L,NY,NX)-XN4FXB(L,NY,NX) + ZNH3BH(L,NY,NX)=ZNH3BH(L,NY,NX)+TN3FHB(L,NY,NX)-XN3FXB(L,NY,NX) + ZNO3BH(L,NY,NX)=ZNO3BH(L,NY,NX)+TNOFHB(L,NY,NX)-XNOFXB(L,NY,NX) + ZNO2BH(L,NY,NX)=ZNO2BH(L,NY,NX)+TNXFHB(L,NY,NX)-XNXFXB(L,NY,NX) + H2POBH(L,NY,NX)=H2POBH(L,NY,NX)+TH2BHB(L,NY,NX)-XH2BXB(L,NY,NX) +C IF(NX.EQ.1)THEN +C WRITE(*,4747)'ZNO3SH',I,J,NX,NY,L,ZNO3SH(L,NY,NX) +C 2,TNOFHS(L,NY,NX),XNOFXW(L,NY,NX) +C 3,ZNO2SH(L,NY,NX),TNXFHS(L,NY,NX),XNXFXS(L,NY,NX) +4747 FORMAT(A8,5I4,12E12.4) +C ENDIF +C +C GASES FROM VOLATILIZATION-DISSOLUTION AND GAS TRANSFER +C + CO2G(L,NY,NX)=CO2G(L,NY,NX)+TCOFLG(L,NY,NX)-XCODFG(L,NY,NX) + CH4G(L,NY,NX)=CH4G(L,NY,NX)+TCHFLG(L,NY,NX)-XCHDFG(L,NY,NX) + OXYG(L,NY,NX)=OXYG(L,NY,NX)+TOXFLG(L,NY,NX)-XOXDFG(L,NY,NX) + Z2GG(L,NY,NX)=Z2GG(L,NY,NX)+TNGFLG(L,NY,NX)-XNGDFG(L,NY,NX) + Z2OG(L,NY,NX)=Z2OG(L,NY,NX)+TN2FLG(L,NY,NX)-XN2DFG(L,NY,NX) + ZNH3G(L,NY,NX)=ZNH3G(L,NY,NX)+TNHFLG(L,NY,NX)-XN3DFG(L,NY,NX) + 2-XNBDFG(L,NY,NX)+TRN3G(L,NY,NX) + H2GG(L,NY,NX)=H2GG(L,NY,NX)+THGFLG(L,NY,NX)-XHGDFG(L,NY,NX) + ROXYF(L,NY,NX)=TOXFLG(L,NY,NX) + RCO2F(L,NY,NX)=TCOFLG(L,NY,NX) + RCH4F(L,NY,NX)=TCHFLG(L,NY,NX) + ROXYL(L,NY,NX)=TOXFLS(L,NY,NX)+ROXFLU(L,NY,NX)+XOXFXS(L,NY,NX) + 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 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 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 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) +C 5,XCHFXS(L,NY,NX),XCHBBL(L,NY,NX) +C ENDIF +C +C SALT SOLUTES IFROM EQUILIBRIUM REACTIONS, MICROPORE-MACROPORE +C EXCHANGE, AQUEOUS FLUXES +C + IF(ISALT(NY,NX).NE.0)THEN + XZHYU=0.0714*(TUPNH4(L,NY,NX)+TUPNHB(L,NY,NX)) + XZOHU=0.0714*(TUPNO3(L,NY,NX)+TUPNOB(L,NY,NX)) + ZAL(L,NY,NX)=ZAL(L,NY,NX)+TRAL(L,NY,NX)+TALFLS(L,NY,NX) + 2+RALFLU(L,NY,NX)+XALFXS(L,NY,NX) + ZFE(L,NY,NX)=ZFE(L,NY,NX)+TRFE(L,NY,NX)+TFEFLS(L,NY,NX) + 2+RFEFLU(L,NY,NX)+XFEFXS(L,NY,NX) + ZHY(L,NY,NX)=ZHY(L,NY,NX)+TRHY(L,NY,NX)+THYFLS(L,NY,NX) + 2+RHYFLU(L,NY,NX)+XHYFXS(L,NY,NX)+XZHYS(L,NY,NX)+XZHYU + ZCA(L,NY,NX)=ZCA(L,NY,NX)+TRCA(L,NY,NX)+TCAFLS(L,NY,NX) + 2+RCAFLU(L,NY,NX)+XCAFXS(L,NY,NX) + ZMG(L,NY,NX)=ZMG(L,NY,NX)+TRMG(L,NY,NX)+TMGFLS(L,NY,NX) + 2+RMGFLU(L,NY,NX)+XMGFXS(L,NY,NX) + ZNA(L,NY,NX)=ZNA(L,NY,NX)+TRNA(L,NY,NX)+TNAFLS(L,NY,NX) + 2+RNAFLU(L,NY,NX)+XNAFXS(L,NY,NX) + ZKA(L,NY,NX)=ZKA(L,NY,NX)+TRKA(L,NY,NX)+TKAFLS(L,NY,NX) + 2+RKAFLU(L,NY,NX)+XKAFXS(L,NY,NX) + ZOH(L,NY,NX)=ZOH(L,NY,NX)+TROH(L,NY,NX)+TOHFLS(L,NY,NX) + 2+ROHFLU(L,NY,NX)+XOHFXS(L,NY,NX)+XZOHU + ZSO4(L,NY,NX)=ZSO4(L,NY,NX)+TRSO4(L,NY,NX)+TSOFLS(L,NY,NX) + 2+RSOFLU(L,NY,NX)+XSOFXS(L,NY,NX) + ZCL(L,NY,NX)=ZCL(L,NY,NX)+TCLFLS(L,NY,NX)+RCLFLU(L,NY,NX) + 2+XCLFXS(L,NY,NX) + ZCO3(L,NY,NX)=ZCO3(L,NY,NX)+TRCO3(L,NY,NX)+TC3FLS(L,NY,NX) + 2+XC3FXS(L,NY,NX) + ZHCO3(L,NY,NX)=ZHCO3(L,NY,NX)+TRHCO(L,NY,NX)+THCFLS(L,NY,NX) + 2+XHCFXS(L,NY,NX) + ZALOH1(L,NY,NX)=ZALOH1(L,NY,NX)+TRAL1(L,NY,NX)+TAL1FS(L,NY,NX) + 2+XAL1XS(L,NY,NX) + ZALOH2(L,NY,NX)=ZALOH2(L,NY,NX)+TRAL2(L,NY,NX)+TAL2FS(L,NY,NX) + 2+XAL2XS(L,NY,NX) + ZALOH3(L,NY,NX)=ZALOH3(L,NY,NX)+TRAL3(L,NY,NX)+TAL3FS(L,NY,NX) + 2+XAL3XS(L,NY,NX) + ZALOH4(L,NY,NX)=ZALOH4(L,NY,NX)+TRAL4(L,NY,NX)+TAL4FS(L,NY,NX) + 2+XAL4XS(L,NY,NX) + ZALS(L,NY,NX)=ZALS(L,NY,NX)+TRALS(L,NY,NX)+TALSFS(L,NY,NX) + 2+XALSXS(L,NY,NX) + ZFEOH1(L,NY,NX)=ZFEOH1(L,NY,NX)+TRFE1(L,NY,NX)+TFE1FS(L,NY,NX) + 2+XFE1XS(L,NY,NX) + ZFEOH2(L,NY,NX)=ZFEOH2(L,NY,NX)+TRFE2(L,NY,NX)+TFE2FS(L,NY,NX) + 2+XFE2XS(L,NY,NX) + ZFEOH3(L,NY,NX)=ZFEOH3(L,NY,NX)+TRFE3(L,NY,NX)+TFE3FS(L,NY,NX) + 2+XFE3XS(L,NY,NX) + ZFEOH4(L,NY,NX)=ZFEOH4(L,NY,NX)+TRFE4(L,NY,NX)+TFE4FS(L,NY,NX) + 2+XFE4XS(L,NY,NX) + ZFES(L,NY,NX)=ZFES(L,NY,NX)+TRFES(L,NY,NX)+TFESFS(L,NY,NX) + 2+XFESXS(L,NY,NX) + ZCAO(L,NY,NX)=ZCAO(L,NY,NX)+TRCAO(L,NY,NX)+TCAOFS(L,NY,NX) + 2+XCAOXS(L,NY,NX) + ZCAC(L,NY,NX)=ZCAC(L,NY,NX)+TRCAC(L,NY,NX)+TCACFS(L,NY,NX) + 2+XCACXS(L,NY,NX) + ZCAH(L,NY,NX)=ZCAH(L,NY,NX)+TRCAH(L,NY,NX)+TCAHFS(L,NY,NX) + 2+XCAHXS(L,NY,NX) + ZCAS(L,NY,NX)=ZCAS(L,NY,NX)+TRCAS(L,NY,NX)+TCASFS(L,NY,NX) + 2+XCASXS(L,NY,NX) + ZMGO(L,NY,NX)=ZMGO(L,NY,NX)+TRMGO(L,NY,NX)+TMGOFS(L,NY,NX) + 2+XMGOXS(L,NY,NX) + ZMGC(L,NY,NX)=ZMGC(L,NY,NX)+TRMGC(L,NY,NX)+TMGCFS(L,NY,NX) + 2+XMGCXS(L,NY,NX) + ZMGH(L,NY,NX)=ZMGH(L,NY,NX)+TRMGH(L,NY,NX)+TMGHFS(L,NY,NX) + 2+XMGHXS(L,NY,NX) + ZMGS(L,NY,NX)=ZMGS(L,NY,NX)+TRMGS(L,NY,NX)+TMGSFS(L,NY,NX) + 2+XMGSXS(L,NY,NX) + ZNAC(L,NY,NX)=ZNAC(L,NY,NX)+TRNAC(L,NY,NX)+TNACFS(L,NY,NX) + 2+XNACXS(L,NY,NX) + ZNAS(L,NY,NX)=ZNAS(L,NY,NX)+TRNAS(L,NY,NX)+TNASFS(L,NY,NX) + 2+XNASXS(L,NY,NX) + ZKAS(L,NY,NX)=ZKAS(L,NY,NX)+TRKAS(L,NY,NX)+TKASFS(L,NY,NX) + 2+XKASXS(L,NY,NX) + H0PO4(L,NY,NX)=H0PO4(L,NY,NX)+TRH0P(L,NY,NX)+TH0PFS(L,NY,NX) + 2+XH0PXS(L,NY,NX) + H1PO4(L,NY,NX)=H1PO4(L,NY,NX)+TRH1P(L,NY,NX)+TH1PFS(L,NY,NX) + 2+XH1PXS(L,NY,NX) + H3PO4(L,NY,NX)=H3PO4(L,NY,NX)+TRH3P(L,NY,NX)+TH3PFS(L,NY,NX) + 2+XH3PXS(L,NY,NX) + ZFE1P(L,NY,NX)=ZFE1P(L,NY,NX)+TRF1P(L,NY,NX)+TF1PFS(L,NY,NX) + 2+XF1PXS(L,NY,NX) + ZFE2P(L,NY,NX)=ZFE2P(L,NY,NX)+TRF2P(L,NY,NX)+TF2PFS(L,NY,NX) + 2+XF2PXS(L,NY,NX) + ZCA0P(L,NY,NX)=ZCA0P(L,NY,NX)+TRC0P(L,NY,NX)+TC0PFS(L,NY,NX) + 2+XC0PXS(L,NY,NX) + ZCA1P(L,NY,NX)=ZCA1P(L,NY,NX)+TRC1P(L,NY,NX)+TC1PFS(L,NY,NX) + 2+XC1PXS(L,NY,NX) + ZCA2P(L,NY,NX)=ZCA2P(L,NY,NX)+TRC2P(L,NY,NX)+TC2PFS(L,NY,NX) + 2+XC2PXS(L,NY,NX) + ZMG1P(L,NY,NX)=ZMG1P(L,NY,NX)+TRM1P(L,NY,NX)+TM1PFS(L,NY,NX) + 2+XM1PXS(L,NY,NX) + H0POB(L,NY,NX)=H0POB(L,NY,NX)+TRH0B(L,NY,NX)+TH0BFB(L,NY,NX) + 2+XH0BXB(L,NY,NX) + H1POB(L,NY,NX)=H1POB(L,NY,NX)+TRH1B(L,NY,NX)+TH1BFB(L,NY,NX) + 2+XH1BXB(L,NY,NX) + H3POB(L,NY,NX)=H3POB(L,NY,NX)+TRH3B(L,NY,NX)+TH3BFB(L,NY,NX) + 2+XH3BXB(L,NY,NX) + ZFE1PB(L,NY,NX)=ZFE1PB(L,NY,NX)+TRF1B(L,NY,NX)+TF1BFB(L,NY,NX) + 2+XF1BXB(L,NY,NX) + ZFE2PB(L,NY,NX)=ZFE2PB(L,NY,NX)+TRF2B(L,NY,NX)+TF2BFB(L,NY,NX) + 2+XF2BXB(L,NY,NX) + ZCA0PB(L,NY,NX)=ZCA0PB(L,NY,NX)+TRC0B(L,NY,NX)+TC0BFB(L,NY,NX) + 2+XC0BXB(L,NY,NX) + ZCA1PB(L,NY,NX)=ZCA1PB(L,NY,NX)+TRC1B(L,NY,NX)+TC1BFB(L,NY,NX) + 2+XC1BXB(L,NY,NX) + ZCA2PB(L,NY,NX)=ZCA2PB(L,NY,NX)+TRC2B(L,NY,NX)+TC2BFB(L,NY,NX) + 2+XC2BXB(L,NY,NX) + ZMG1PB(L,NY,NX)=ZMG1PB(L,NY,NX)+TRM1B(L,NY,NX)+TM1BFB(L,NY,NX) + 2+XM1BXB(L,NY,NX) + ZALH(L,NY,NX)=ZALH(L,NY,NX)+TALFHS(L,NY,NX)-XALFXS(L,NY,NX) + ZFEH(L,NY,NX)=ZFEH(L,NY,NX)+TFEFHS(L,NY,NX)-XFEFXS(L,NY,NX) + ZHYH(L,NY,NX)=ZHYH(L,NY,NX)+THYFHS(L,NY,NX)-XHYFXS(L,NY,NX) + ZCCH(L,NY,NX)=ZCCH(L,NY,NX)+TCAFHS(L,NY,NX)-XCAFXS(L,NY,NX) + ZMAH(L,NY,NX)=ZMAH(L,NY,NX)+TMGFHS(L,NY,NX)-XMGFXS(L,NY,NX) + ZNAH(L,NY,NX)=ZNAH(L,NY,NX)+TNAFHS(L,NY,NX)-XNAFXS(L,NY,NX) + ZKAH(L,NY,NX)=ZKAH(L,NY,NX)+TKAFHS(L,NY,NX)-XKAFXS(L,NY,NX) + ZOHH(L,NY,NX)=ZOHH(L,NY,NX)+TOHFHS(L,NY,NX)-XOHFXS(L,NY,NX) + ZSO4H(L,NY,NX)=ZSO4H(L,NY,NX)+TSOFHS(L,NY,NX)-XSOFXS(L,NY,NX) + ZCLH(L,NY,NX)=ZCLH(L,NY,NX)+TCLFHS(L,NY,NX)-XCLFXS(L,NY,NX) + ZCO3H(L,NY,NX)=ZCO3H(L,NY,NX)+TC3FHS(L,NY,NX)-XC3FXS(L,NY,NX) + ZHCO3H(L,NY,NX)=ZHCO3H(L,NY,NX)+THCFHS(L,NY,NX)-XHCFXS(L,NY,NX) + ZALO1H(L,NY,NX)=ZALO1H(L,NY,NX)+TAL1HS(L,NY,NX)-XAL1XS(L,NY,NX) + ZALO2H(L,NY,NX)=ZALO2H(L,NY,NX)+TAL2HS(L,NY,NX)-XAL2XS(L,NY,NX) + ZALO3H(L,NY,NX)=ZALO3H(L,NY,NX)+TAL3HS(L,NY,NX)-XAL3XS(L,NY,NX) + ZALO4H(L,NY,NX)=ZALO4H(L,NY,NX)+TAL4HS(L,NY,NX)-XAL4XS(L,NY,NX) + ZALSH(L,NY,NX)=ZALSH(L,NY,NX)+TALSHS(L,NY,NX)-XALSXS(L,NY,NX) + ZFEO1H(L,NY,NX)=ZFEO1H(L,NY,NX)+TFE1HS(L,NY,NX)-XFE1XS(L,NY,NX) + ZFEO2H(L,NY,NX)=ZFEO2H(L,NY,NX)+TFE2HS(L,NY,NX)-XFE2XS(L,NY,NX) + ZFEO3H(L,NY,NX)=ZFEO3H(L,NY,NX)+TFE3HS(L,NY,NX)-XFE3XS(L,NY,NX) + ZFEO4H(L,NY,NX)=ZFEO4H(L,NY,NX)+TFE4HS(L,NY,NX)-XFE4XS(L,NY,NX) + ZFESH(L,NY,NX)=ZFESH(L,NY,NX)+TFESHS(L,NY,NX)-XFESXS(L,NY,NX) + ZCAOH(L,NY,NX)=ZCAOH(L,NY,NX)+TCAOHS(L,NY,NX)-XCAOXS(L,NY,NX) + ZCACH(L,NY,NX)=ZCACH(L,NY,NX)+TCACHS(L,NY,NX)-XCACXS(L,NY,NX) + ZCAHH(L,NY,NX)=ZCAHH(L,NY,NX)+TCAHHS(L,NY,NX)-XCAHXS(L,NY,NX) + ZCASH(L,NY,NX)=ZCASH(L,NY,NX)+TCASHS(L,NY,NX)-XCASXS(L,NY,NX) + ZMGOH(L,NY,NX)=ZMGOH(L,NY,NX)+TMGOHS(L,NY,NX)-XMGOXS(L,NY,NX) + ZMGCH(L,NY,NX)=ZMGCH(L,NY,NX)+TMGCHS(L,NY,NX)-XMGCXS(L,NY,NX) + ZMGHH(L,NY,NX)=ZMGHH(L,NY,NX)+TMGHHS(L,NY,NX)-XMGHXS(L,NY,NX) + ZMGSH(L,NY,NX)=ZMGSH(L,NY,NX)+TMGSHS(L,NY,NX)-XMGSXS(L,NY,NX) + ZNACH(L,NY,NX)=ZNACH(L,NY,NX)+TNACHS(L,NY,NX)-XNACXS(L,NY,NX) + ZNASH(L,NY,NX)=ZNASH(L,NY,NX)+TNASHS(L,NY,NX)-XNASXS(L,NY,NX) + ZKASH(L,NY,NX)=ZKASH(L,NY,NX)+TKASHS(L,NY,NX)-XKASXS(L,NY,NX) + H0PO4H(L,NY,NX)=H0PO4H(L,NY,NX)+TH0PHS(L,NY,NX)-XH0PXS(L,NY,NX) + H1PO4H(L,NY,NX)=H1PO4H(L,NY,NX)+TH1PHS(L,NY,NX)-XH1PXS(L,NY,NX) + H3PO4H(L,NY,NX)=H3PO4H(L,NY,NX)+TH3PHS(L,NY,NX)-XH3PXS(L,NY,NX) + ZFE1PH(L,NY,NX)=ZFE1PH(L,NY,NX)+TF1PHS(L,NY,NX)-XF1PXS(L,NY,NX) + ZFE2PH(L,NY,NX)=ZFE2PH(L,NY,NX)+TF2PHS(L,NY,NX)-XF2PXS(L,NY,NX) + ZCA0PH(L,NY,NX)=ZCA0PH(L,NY,NX)+TC0PHS(L,NY,NX)-XC0PXS(L,NY,NX) + ZCA1PH(L,NY,NX)=ZCA1PH(L,NY,NX)+TC1PHS(L,NY,NX)-XC1PXS(L,NY,NX) + ZCA2PH(L,NY,NX)=ZCA2PH(L,NY,NX)+TC2PHS(L,NY,NX)-XC2PXS(L,NY,NX) + ZMG1PH(L,NY,NX)=ZMG1PH(L,NY,NX)+TM1PHS(L,NY,NX)-XM1PXS(L,NY,NX) + H0POBH(L,NY,NX)=H0POBH(L,NY,NX)+TH0BHB(L,NY,NX)-XH0BXB(L,NY,NX) + H1POBH(L,NY,NX)=H1POBH(L,NY,NX)+TH1BHB(L,NY,NX)-XH1BXB(L,NY,NX) + H3POBH(L,NY,NX)=H3POBH(L,NY,NX)+TH3BHB(L,NY,NX)-XH3BXB(L,NY,NX) + ZFE1BH(L,NY,NX)=ZFE1BH(L,NY,NX)+TF1BHB(L,NY,NX)-XF1BXB(L,NY,NX) + ZFE2BH(L,NY,NX)=ZFE2BH(L,NY,NX)+TF2BHB(L,NY,NX)-XF2BXB(L,NY,NX) + ZCA0BH(L,NY,NX)=ZCA0BH(L,NY,NX)+TC0BHB(L,NY,NX)-XC0BXB(L,NY,NX) + ZCA1BH(L,NY,NX)=ZCA1BH(L,NY,NX)+TC1BHB(L,NY,NX)-XC1BXB(L,NY,NX) + ZCA2BH(L,NY,NX)=ZCA2BH(L,NY,NX)+TC2BHB(L,NY,NX)-XC2BXB(L,NY,NX) + ZMG1BH(L,NY,NX)=ZMG1BH(L,NY,NX)+TM1BHB(L,NY,NX)-XM1BXB(L,NY,NX) + XHY(L,NY,NX)=XHY(L,NY,NX)+TRXHY(L,NY,NX) + XAL(L,NY,NX)=XAL(L,NY,NX)+TRXAL(L,NY,NX) + XCA(L,NY,NX)=XCA(L,NY,NX)+TRXCA(L,NY,NX) + XMG(L,NY,NX)=XMG(L,NY,NX)+TRXMG(L,NY,NX) + XNA(L,NY,NX)=XNA(L,NY,NX)+TRXNA(L,NY,NX) + XKA(L,NY,NX)=XKA(L,NY,NX)+TRXKA(L,NY,NX) + XHC(L,NY,NX)=XHC(L,NY,NX)+TRXHC(L,NY,NX) + XALO2(L,NY,NX)=XALO2(L,NY,NX)+TRXAL2(L,NY,NX) + PALOH(L,NY,NX)=PALOH(L,NY,NX)+TRALOH(L,NY,NX) + PFEOH(L,NY,NX)=PFEOH(L,NY,NX)+TRFEOH(L,NY,NX) + PCACO(L,NY,NX)=PCACO(L,NY,NX)+TRCACO(L,NY,NX) + PCASO(L,NY,NX)=PCASO(L,NY,NX)+TRCASO(L,NY,NX) +C +C SOIL ELECTRICAL CONDUCTIVITY +C + IF(VOLW(L,NY,NX).GT.0.0)THEN + ECHY=0.337*AMAX1(0.0,ZHY(L,NY,NX)/VOLW(L,NY,NX)) + ECOH=0.192*AMAX1(0.0,ZOH(L,NY,NX)/VOLW(L,NY,NX)) + ECAL=0.056*AMAX1(0.0,ZAL(L,NY,NX)*3.0/VOLW(L,NY,NX)) + ECFE=0.051*AMAX1(0.0,ZFE(L,NY,NX)*3.0/VOLW(L,NY,NX)) + ECCA=0.060*AMAX1(0.0,ZCA(L,NY,NX)*2.0/VOLW(L,NY,NX)) + ECMG=0.053*AMAX1(0.0,ZMG(L,NY,NX)*2.0/VOLW(L,NY,NX)) + ECNA=0.050*AMAX1(0.0,ZNA(L,NY,NX)/VOLW(L,NY,NX)) + ECKA=0.070*AMAX1(0.0,ZKA(L,NY,NX)/VOLW(L,NY,NX)) + ECCO=0.072*AMAX1(0.0,ZCO3(L,NY,NX)*2.0/VOLW(L,NY,NX)) + ECHC=0.044*AMAX1(0.0,ZHCO3(L,NY,NX)/VOLW(L,NY,NX)) + ECSO=0.080*AMAX1(0.0,ZSO4(L,NY,NX)*2.0/VOLW(L,NY,NX)) + ECCL=0.076*AMAX1(0.0,ZCL(L,NY,NX)/VOLW(L,NY,NX)) + ECNO=0.071*AMAX1(0.0,ZNO3S(L,NY,NX)/(VOLW(L,NY,NX)*14.0)) + ECND(L,NY,NX)=ECHY+ECOH+ECAL+ECFE+ECCA+ECMG+ECNA+ECKA + 2+ECCO+ECHC+ECSO+ECCL+ECNO + ELSE + ECND(L,NY,NX)=0.0 + ENDIF +C IF(NX.EQ.1.AND.NY.EQ.5)THEN +C WRITE(*,5656)'ECND',IYRC,I,J,NX,NY,L +C 2,ECND(L,NY,NX),VOLW(L,NY,NX),ECHY,ECOH,ECAL,ECFE,ECCA +C 3,ECMG,ECNA,ECKA,ECCO,ECHC,ECSO,ECCL,ECNO +5656 FORMAT(A8,6I4,30E12.4) +C ENDIF + ELSE + XZHYS(L,NY,NX)=0.0 + XZHYU=0.0 + XZOHU=0.0 + ENDIF +C +C GRID CELL BOUNDARY FLUXES FROM ROOT GAS TRANSFER +C + VOLWOU=VOLWOU-18.0E-06*TRH2O(L,NY,NX) + HEATIN=HEATIN+THTHAW(L,NY,NX)+TUPHT(L,NY,NX) + CI=TCOFLA(L,NY,NX) + CH=TCHFLA(L,NY,NX) + OI=TOXFLA(L,NY,NX) + ZGI=0.0 + Z2I=TN2FLA(L,NY,NX) + ZHI=TNHFLA(L,NY,NX) + TI=THGFLA(L,NY,NX) +C +C GRID CELL BOUNDARY FLUXES BUBBLING +C + IF(LG.EQ.0)THEN + CI=CI+XCOBBL(L,NY,NX) + CH=CH+XCHBBL(L,NY,NX) + OI=OI+XOXBBL(L,NY,NX) + ZGI=ZGI+XNGBBL(L,NY,NX) + Z2I=Z2I+XN2BBL(L,NY,NX) + ZHI=ZHI+XN3BBL(L,NY,NX)+XNBBBL(L,NY,NX) + TI=TI+XHGBBL(L,NY,NX) + ELSE + LL=MIN(L,LG) + CO2G(LL,NY,NX)=CO2G(LL,NY,NX)-XCOBBL(L,NY,NX) + CH4G(LL,NY,NX)=CH4G(LL,NY,NX)-XCHBBL(L,NY,NX) + OXYG(LL,NY,NX)=OXYG(LL,NY,NX)-XOXBBL(L,NY,NX) + Z2GG(LL,NY,NX)=Z2GG(LL,NY,NX)-XNGBBL(L,NY,NX) + Z2OG(LL,NY,NX)=Z2OG(LL,NY,NX)-XN2BBL(L,NY,NX) + ZNH3G(LL,NY,NX)=ZNH3G(LL,NY,NX)-XN3BBL(L,NY,NX)-XNBBBL(L,NY,NX) + H2GG(LL,NY,NX)=H2GG(LL,NY,NX)-XHGBBL(L,NY,NX) + IF(LG.LT.L)THEN + TLCO2G=TLCO2G-XCOBBL(L,NY,NX)-XCHBBL(L,NY,NX) + UCO2S(NY,NX)=UCO2S(NY,NX)-XCOBBL(L,NY,NX)-XCHBBL(L,NY,NX) + OXYGSO=OXYGSO-XOXBBL(L,NY,NX) + TLN2G=TLN2G-XNGBBL(L,NY,NX)-XN2BBL(L,NY,NX) + 2-XN3BBL(L,NY,NX)-XNBBBL(L,NY,NX) + TION=TION-XHGBBL(L,NY,NX) + ENDIF + ENDIF + CO2GIN=CO2GIN+CI+CH + CO=TCO2P(L,NY,NX)+TCO2S(L,NY,NX)-TRCO2(L,NY,NX) + HCO2G(NY,NX)=HCO2G(NY,NX)+CI + UCO2G(NY,NX)=UCO2G(NY,NX)+CI + HCH4G(NY,NX)=HCH4G(NY,NX)+CH + UCH4G(NY,NX)=UCH4G(NY,NX)+CH + TCOU=TCOU+CO + UCOP(NY,NX)=UCOP(NY,NX)+TCO2P(L,NY,NX)+TCO2S(L,NY,NX) + UDICD(NY,NX)=UDICD(NY,NX)-TRCO2(L,NY,NX) + TNBP(NY,NX)=TNBP(NY,NX)+CH+TRCO2(L,NY,NX) + OXYGIN=OXYGIN+OI + OO=RUPOXO(L,NY,NX)+TUPOXP(L,NY,NX)+TUPOXS(L,NY,NX) + UOXYG(NY,NX)=UOXYG(NY,NX)+OI + HOXYG(NY,NX)=HOXYG(NY,NX)+OI + OXYGOU=OXYGOU+OO + ZN2GIN=ZN2GIN+ZGI+Z2I+ZHI +C UN2GG(NY,NX)=UN2GG(NY,NX)+ZGI +C HN2GG(NY,NX)=HN2GG(NY,NX)+ZGI + UN2OG(NY,NX)=UN2OG(NY,NX)+Z2I + HN2OG(NY,NX)=HN2OG(NY,NX)+Z2I + UNH3G(NY,NX)=UNH3G(NY,NX)+ZHI + HNH3G(NY,NX)=HNH3G(NY,NX)+ZHI + UH2GG(NY,NX)=UH2GG(NY,NX)+TI +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 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,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) +C 6,CH4G(LL,NY,NX) +6645 FORMAT(A8,7I4,30E12.4) +C ENDIF +C +C GRID CELL BOUNDARY FLUXES FROM EQUILIBRIUM REACTIONS +C + TZOU=TZOU-14.0*(TBNH4(L,NY,NX)+TBNO3(L,NY,NX)+TBNH3(L,NY,NX)) + TPOU=TPOU-31.0*TBH2P(L,NY,NX) + TIONIN=TIONIN+TI + TO=2.0*TRH2O(L,NY,NX)+3.0*TBCO2(L,NY,NX)+2.0*TBNH4(L,NY,NX) + 2+TBNH3(L,NY,NX)+TBNO3(L,NY,NX)+3.0*TBH2P(L,NY,NX)-XZHYS(L,NY,NX) + 3+RH2GO(L,NY,NX)-XZHYU-XZOHU+TBION(L,NY,NX) + TIONOU=TIONOU+TO +C UIONOU(NY,NX)=UIONOU(NY,NX)+TO +C +C GAS AND SOLUTE EXCHANGE WITHIN GRID CELL ADDED TO ECOSYSTEM + +C TOTALS FOR CALCULATING COMPETITION CONSTRAINTS ON MICROBIAL +C AND ROOT POPULATIONS +C + DO 7990 K=0,5 + DO 7980 N=1,7 + ROXYX(L,NY,NX)=ROXYX(L,NY,NX)+ROXYS(N,K,L,NY,NX) + RNH4X(L,NY,NX)=RNH4X(L,NY,NX)+RVMX4(N,K,L,NY,NX) + 2+RINHO(N,K,L,NY,NX) + RNO3X(L,NY,NX)=RNO3X(L,NY,NX)+RVMX3(N,K,L,NY,NX) + 2+RINOO(N,K,L,NY,NX) + RNO2X(L,NY,NX)=RNO2X(L,NY,NX)+RVMX2(N,K,L,NY,NX) + RN2OX(L,NY,NX)=RN2OX(L,NY,NX)+RVMX1(N,K,L,NY,NX) + RPO4X(L,NY,NX)=RPO4X(L,NY,NX)+RIPOO(N,K,L,NY,NX) + RNHBX(L,NY,NX)=RNHBX(L,NY,NX)+RVMB4(N,K,L,NY,NX) + 2+RINHB(N,K,L,NY,NX) + RN3BX(L,NY,NX)=RN3BX(L,NY,NX)+RVMB3(N,K,L,NY,NX) + 2+RINOB(N,K,L,NY,NX) + RN2BX(L,NY,NX)=RN2BX(L,NY,NX)+RVMB2(N,K,L,NY,NX) + RPOBX(L,NY,NX)=RPOBX(L,NY,NX)+RIPOB(N,K,L,NY,NX) + IF(K.LE.4)THEN + ROQCX(K,L,NY,NX)=ROQCX(K,L,NY,NX)+ROQCS(N,K,L,NY,NX) + ROQAX(K,L,NY,NX)=ROQAX(K,L,NY,NX)+ROQAS(N,K,L,NY,NX) + ENDIF +7980 CONTINUE +7990 CONTINUE + RNO2X(L,NY,NX)=RNO2X(L,NY,NX)+RVMXC(L,NY,NX) + RN2BX(L,NY,NX)=RN2BX(L,NY,NX)+RVMBC(L,NY,NX) +C +C GRID CELL VARIABLES NEEDED FOR WATER, C, N, P, O, SOLUTE AND +C ENERGY BALANCES INCLUDING SUM OF ALL CURRENT STATE VARIABLES, +C CUMULATIVE SUMS OF ALL ADDITIONS AND REMOVALS SINCE START OF RUN +C +C IF(J.EQ.24)THEN + WS=VOLW(L,NY,NX)+VOLWH(L,NY,NX) + 2+(VOLI(L,NY,NX)+VOLIH(L,NY,NX))*0.92 + VOLWSO=VOLWSO+WS + UVOLW(NY,NX)=UVOLW(NY,NX)+WS +C 2-WP(L,NY,NX)*VOLX(L,NY,NX) + HEATSO=HEATSO+VHCP(L,NY,NX)*TKS(L,NY,NX) + SD=SAND(L,NY,NX)+SILT(L,NY,NX)+CLAY(L,NY,NX) + TSEDSO=TSEDSO+SD + CS=CO2G(L,NY,NX)+CO2S(L,NY,NX)+CO2SH(L,NY,NX)+TLCO2P(L,NY,NX) + 2+CH4G(L,NY,NX)+CH4S(L,NY,NX)+CH4SH(L,NY,NX)+TLCH4P(L,NY,NX) + TLCO2G=TLCO2G+CS + UCO2S(NY,NX)=UCO2S(NY,NX)+CS +C IF(NX.EQ.1.AND.NY.EQ.1)THEN +C WRITE(*,8642)'TLCO2G',I,J,L,TLCO2G,CS,CO2G(L,NY,NX),CO2S(L,NY,NX) +C 2,CO2SH(L,NY,NX),TLCO2P(L,NY,NX),CH4G(L,NY,NX),CH4S(L,NY,NX) +C 3,CH4SH(L,NY,NX),TLCH4P(L,NY,NX),UCO2S(NY,NX) +8642 FORMAT(A8,3I4,20F20.6) +C ENDIF + OS=OXYG(L,NY,NX)+OXYS(L,NY,NX)+OXYSH(L,NY,NX)+TLOXYP(L,NY,NX) + OXYGSO=OXYGSO+OS + ZG=Z2GG(L,NY,NX)+Z2GS(L,NY,NX)+Z2GSH(L,NY,NX)+TLN2OP(L,NY,NX) + 2+Z2OG(L,NY,NX)+Z2OS(L,NY,NX)+Z2OSH(L,NY,NX)+TLNH3P(L,NY,NX) + 3+ZNH3G(L,NY,NX) + TLN2G=TLN2G+ZG + ZNH=ZNH4S(L,NY,NX)+ZNH4SH(L,NY,NX)+ZNH4B(L,NY,NX)+ZNH4BH(L,NY,NX) + 2+ZNH3S(L,NY,NX)+ZNH3SH(L,NY,NX)+ZNH3B(L,NY,NX)+ZNH3BH(L,NY,NX) + TLNH4=TLNH4+ZNH + UNH4(NY,NX)=UNH4(NY,NX)+ZNH+14.0*(XN4(L,NY,NX)+XNB(L,NY,NX)) +C IF(NX.EQ.4)THEN +C WRITE(*,5455)'XNH4L',I,J,NX,NY,L,UNH4(NY,NX),ZNH,XN4(L,NY,NX) +C 2,XNB(L,NY,NX),ZNH4S(L,NY,NX),ZNH4SH(L,NY,NX) +C 3,ZNH4B(L,NY,NX),ZNH4BH(L,NY,NX),ZNH3S(L,NY,NX),ZNH3SH(L,NY,NX) +C 4,ZNH3B(L,NY,NX),ZNH3BH(L,NY,NX) +5455 FORMAT(A8,5I4,30E12.4) +C ENDIF + ZNO=ZNO3S(L,NY,NX)+ZNO3SH(L,NY,NX)+ZNO3B(L,NY,NX)+ZNO3BH(L,NY,NX) + 2+ZNO2S(L,NY,NX)+ZNO2SH(L,NY,NX)+ZNO2B(L,NY,NX)+ZNO2BH(L,NY,NX) + TLNO3=TLNO3+ZNO + UNO3(NY,NX)=UNO3(NY,NX)+ZNO + P4=H2PO4(L,NY,NX)+H2PO4H(L,NY,NX)+H2POB(L,NY,NX)+H2POBH(L,NY,NX) + TLPO4=TLPO4+P4 + UPO4(NY,NX)=UPO4(NY,NX)+P4+31.0*(XH1P(L,NY,NX)+XH2P(L,NY,NX) + 2+XH1PB(L,NY,NX)+XH2PB(L,NY,NX)) + UPP4(NY,NX)=UPP4(NY,NX)+31.0*(PALPO(L,NY,NX)+PFEPO(L,NY,NX) + 2+PCAPD(L,NY,NX)+PALPB(L,NY,NX)+PFEPB(L,NY,NX)+PCPDB(L,NY,NX)) + 3+93.0*(PCAPH(L,NY,NX)+PCPHB(L,NY,NX)) + 4+62.0*(PCAPM(L,NY,NX)+PCPMB(L,NY,NX)) +C +C TOTAL SON,SON,SOP +C + RC=0.0 + RN=0.0 + RP=0.0 + OC=0.0 + ON=0.0 + OP=0.0 + OMCL(L,NY,NX)=0.0 + OMNL(L,NY,NX)=0.0 + DO 7970 K=0,5 + IF(K.LE.2)THEN + DO 7960 N=1,7 + DO 7960 M=1,3 + RC=RC+OMC(M,N,K,L,NY,NX) + RN=RN+OMN(M,N,K,L,NY,NX) + RP=RP+OMP(M,N,K,L,NY,NX) + TOMT(NY,NX)=TOMT(NY,NX)+OMC(M,N,K,L,NY,NX) + TONT(NY,NX)=TONT(NY,NX)+OMN(M,N,K,L,NY,NX) + TOPT(NY,NX)=TOPT(NY,NX)+OMP(M,N,K,L,NY,NX) + OMCL(L,NY,NX)=OMCL(L,NY,NX)+OMC(M,N,K,L,NY,NX) + OMNL(L,NY,NX)=OMNL(L,NY,NX)+OMN(M,N,K,L,NY,NX) +7960 CONTINUE + ELSE + DO 7950 N=1,7 + DO 7950 M=1,3 + OC=OC+OMC(M,N,K,L,NY,NX) + ON=ON+OMN(M,N,K,L,NY,NX) + OP=OP+OMP(M,N,K,L,NY,NX) + TOMT(NY,NX)=TOMT(NY,NX)+OMC(M,N,K,L,NY,NX) + TONT(NY,NX)=TONT(NY,NX)+OMN(M,N,K,L,NY,NX) + TOPT(NY,NX)=TOPT(NY,NX)+OMP(M,N,K,L,NY,NX) + OMCL(L,NY,NX)=OMCL(L,NY,NX)+OMC(M,N,K,L,NY,NX) + OMNL(L,NY,NX)=OMNL(L,NY,NX)+OMN(M,N,K,L,NY,NX) +7950 CONTINUE + ENDIF +7970 CONTINUE + DO 7900 K=0,4 + IF(K.LE.2)THEN + DO 7940 M=1,2 + RC=RC+ORC(M,K,L,NY,NX) + RN=RN+ORN(M,K,L,NY,NX) + RP=RP+ORP(M,K,L,NY,NX) +7940 CONTINUE + RC=RC+OQC(K,L,NY,NX)+OQCH(K,L,NY,NX)+OHC(K,L,NY,NX) + 2+OQA(K,L,NY,NX)+OQAH(K,L,NY,NX)+OHA(K,L,NY,NX) + RN=RN+OQN(K,L,NY,NX)+OQNH(K,L,NY,NX)+OHN(K,L,NY,NX) + RP=RP+OQP(K,L,NY,NX)+OQPH(K,L,NY,NX)+OHP(K,L,NY,NX) + DO 7930 M=1,4 + RC=RC+OSC(M,K,L,NY,NX) + RN=RN+OSN(M,K,L,NY,NX) + RP=RP+OSP(M,K,L,NY,NX) +7930 CONTINUE + ELSE + DO 7920 M=1,2 + OC=OC+ORC(M,K,L,NY,NX) + ON=ON+ORN(M,K,L,NY,NX) + OP=OP+ORP(M,K,L,NY,NX) +7920 CONTINUE + OC=OC+OQC(K,L,NY,NX)+OQCH(K,L,NY,NX)+OHC(K,L,NY,NX) + 2+OQA(K,L,NY,NX)+OQAH(K,L,NY,NX)+OHA(K,L,NY,NX) + ON=ON+OQN(K,L,NY,NX)+OQNH(K,L,NY,NX)+OHN(K,L,NY,NX) + OP=OP+OQP(K,L,NY,NX)+OQPH(K,L,NY,NX)+OHP(K,L,NY,NX) + DO 7910 M=1,4 + OC=OC+OSC(M,K,L,NY,NX) + ON=ON+OSN(M,K,L,NY,NX) + OP=OP+OSP(M,K,L,NY,NX) +7910 CONTINUE + ENDIF +7900 CONTINUE + ORGC(L,NY,NX)=RC+OC + ORGN(L,NY,NX)=RN+ON + ORGR(L,NY,NX)=RC +C IF(L.EQ.1)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) +4343 FORMAT(A8,6I4,60E12.4) +4344 CONTINUE +C ENDIF + TLRSDC=TLRSDC+RC + URSDC(NY,NX)=URSDC(NY,NX)+RC + TLRSDN=TLRSDN+RN + URSDN(NY,NX)=URSDN(NY,NX)+RN + TLRSDP=TLRSDP+RP + URSDP(NY,NX)=URSDP(NY,NX)+RP + TLORGC=TLORGC+OC + UORGC(NY,NX)=UORGC(NY,NX)+OC + TLORGN=TLORGN+ON + UORGN(NY,NX)=UORGN(NY,NX)+ON + TLORGP=TLORGP+OP + UORGP(NY,NX)=UORGP(NY,NX)+OP + TSEDSO=TSEDSO+(RC+OC)*1.0E-06 + TS=ZAL(L,NY,NX)+ZFE(L,NY,NX)+ZHY(L,NY,NX)+ZCA(L,NY,NX) + 2+ZMG(L,NY,NX)+ZNA(L,NY,NX)+ZKA(L,NY,NX)+ZOH(L,NY,NX) + 3+ZSO4(L,NY,NX)+ZCL(L,NY,NX)+ZCO3(L,NY,NX)+H0PO4(L,NY,NX) + 4+H0POB(L,NY,NX)+2.0*(ZHCO3(L,NY,NX)+ZALOH1(L,NY,NX) + 5+ZALS(L,NY,NX)+ZFEOH1(L,NY,NX)+ZFES(L,NY,NX)+ZCAO(L,NY,NX) + 6+ZCAC(L,NY,NX)+ZCAS(L,NY,NX)+ZMGO(L,NY,NX)+ZMGC(L,NY,NX) + 7+ZMGS(L,NY,NX)+ZNAC(L,NY,NX)+ZNAS(L,NY,NX)+ZKAS(L,NY,NX) + 8+H1PO4(L,NY,NX)+H1POB(L,NY,NX)+ZCA0P(L,NY,NX)+ZCA0PB(L,NY,NX)) + 9+3.0*(ZALOH2(L,NY,NX)+ZFEOH2(L,NY,NX)+ZCAH(L,NY,NX) + 1+ZMGH(L,NY,NX)+ZFE1P(L,NY,NX)+ZCA1P(L,NY,NX)+ZMG1P(L,NY,NX) + 2+ZFE1PB(L,NY,NX)+ZCA1PB(L,NY,NX)+ZMG1PB(L,NY,NX))+4.0* + 3(ZALOH3(L,NY,NX)+ZFEOH3(L,NY,NX)+H3PO4(L,NY,NX)+ZFE2P(L,NY,NX) + 4+ZCA2P(L,NY,NX)+H3POB(L,NY,NX)+ZFE2PB(L,NY,NX) + 5+ZCA2PB(L,NY,NX))+5.0*(ZALOH4(L,NY,NX)+ZFEOH4(L,NY,NX)) + TH=ZALH(L,NY,NX)+ZFEH(L,NY,NX)+ZHYH(L,NY,NX)+ZCCH(L,NY,NX) + 2+ZMAH(L,NY,NX)+ZNAH(L,NY,NX)+ZKAH(L,NY,NX)+ZOHH(L,NY,NX) + 3+ZSO4H(L,NY,NX)+ZCLH(L,NY,NX)+ZCO3H(L,NY,NX)+H0PO4H(L,NY,NX) + 4+H0POBH(L,NY,NX)+2.0*(ZHCO3H(L,NY,NX)+ZALO1H(L,NY,NX) + 5+ZALSH(L,NY,NX)+ZFEO1H(L,NY,NX)+ZFESH(L,NY,NX)+ZCAOH(L,NY,NX) + 6+ZCACH(L,NY,NX)+ZCASH(L,NY,NX)+ZMGOH(L,NY,NX)+ZMGCH(L,NY,NX) + 7+ZMGSH(L,NY,NX)+ZNACH(L,NY,NX)+ZNASH(L,NY,NX)+ZKASH(L,NY,NX) + 8+H1PO4H(L,NY,NX)+H1POBH(L,NY,NX)+ZCA0PH(L,NY,NX)+ZCA0BH(L,NY,NX)) + 9+3.0*(ZALO2H(L,NY,NX)+ZFEO2H(L,NY,NX)+ZCAHH(L,NY,NX) + 1+ZMGHH(L,NY,NX)+ZFE1PH(L,NY,NX)+ZCA1PH(L,NY,NX)+ZMG1PH(L,NY,NX) + 2+ZFE1BH(L,NY,NX)+ZCA1BH(L,NY,NX)+ZMG1BH(L,NY,NX))+4.0* + 3(ZALO3H(L,NY,NX)+ZFEO3H(L,NY,NX)+H3PO4H(L,NY,NX)+ZFE2PH(L,NY,NX) + 4+ZCA2PH(L,NY,NX)+H3POBH(L,NY,NX)+ZFE2BH(L,NY,NX) + 5+ZCA2BH(L,NY,NX))+5.0*(ZALO4H(L,NY,NX)+ZFEO4H(L,NY,NX)) + TX=2.0*(XN4(L,NY,NX)+XNB(L,NY,NX))+XHY(L,NY,NX)+XAL(L,NY,NX) + 2+XCA(L,NY,NX)+XMG(L,NY,NX)+XNA(L,NY,NX)+XKA(L,NY,NX)+XHC(L,NY,NX) + 3+XOH0(L,NY,NX)+XOH0B(L,NY,NX)+2.0*(PCACO(L,NY,NX)+PCASO(L,NY,NX) + 4+PALPO(L,NY,NX)+PFEPO(L,NY,NX)+PALPB(L,NY,NX)+PFEPB(L,NY,NX) + 5+XOH1(L,NY,NX)+XOH1B(L,NY,NX)) + 6+3.0*(PCAPD(L,NY,NX)+PCPDB(L,NY,NX)+XALO2(L,NY,NX) + 7+XOH2(L,NY,NX)+XOH2B(L,NY,NX)+XH1P(L,NY,NX)+XH1PB(L,NY,NX)) + 8+4.0*(PALOH(L,NY,NX)+PFEOH(L,NY,NX)+XH2P(L,NY,NX) + 9+XH2PB(L,NY,NX))+7.0*(PCAPM(L,NY,NX)+PCPMB(L,NY,NX)) + 1+9.0*(PCAPH(L,NY,NX)+PCPHB(L,NY,NX)) + TF=2.0*(ZNH4FA(L,NY,NX)+ZNH4FB(L,NY,NX))+ZNO3FA(L,NY,NX) + 2+ZNO3FB(L,NY,NX)+ZNH3FA(L,NY,NX)+ZNH3FB(L,NY,NX) + 3+ZNHUFA(L,NY,NX)+ZNHUFB(L,NY,NX) + TG=H2GG(L,NY,NX)+H2GS(L,NY,NX)+H2GSH(L,NY,NX)+TLH2GP(L,NY,NX) + TI=TS+TH+TX+TF+TG + TION=TION+TI + UION(NY,NX)=UION(NY,NX)+TI +C ENDIF +125 CONTINUE + TRN(NY,NX)=TRN(NY,NX)+HEATI(NY,NX) + TLE(NY,NX)=TLE(NY,NX)+HEATE(NY,NX) + TSH(NY,NX)=TSH(NY,NX)+HEATS(NY,NX) + TGH(NY,NX)=TGH(NY,NX)-(HEATH(NY,NX)-HEATV(NY,NX)) + TLEC(NY,NX)=TLEC(NY,NX)+HEATE(NY,NX)*RAC(NY,NX) + TSHC(NY,NX)=TSHC(NY,NX)+HEATS(NY,NX)*RAC(NY,NX) + TCNET(NY,NX)=TCNET(NY,NX)+HCO2G(NY,NX) + RECO(NY,NX)=RECO(NY,NX)+HCO2G(NY,NX) + TNBP(NY,NX)=TNBP(NY,NX)+TCNET(NY,NX) +C +C UPDATE STATE VARIABLES WHEN SURFACE SEDIMENT TRANSPORT +C FORCES SOIL RE-LAYERING IF SURFACE LAYER BECOMES TOO +C THIN OR TOO THICK +C + IF(DLYR(3,NU(NY,NX),NY,NX).LT.DNUMN + 2.OR.DLYR(3,NU(NY,NX),NY,NX).GT.DNUMX)THEN + L0=NU(NY,NX) + IF(DLYR(3,NU(NY,NX),NY,NX).LT.DNUMN)THEN + FX=1.0 + L1=NU(NY,NX)+1 + NU(NY,NX)=L1 + ELSE + IF(NU(NY,NX).EQ.1)THEN + FX=(DLYR(3,NU(NY,NX),NY,NX)-DNUMX)/DLYR(3,NU(NY,NX),NY,NX) + L1=NU(NY,NX)+1 + NU(NY,NX)=L0 + ELSE + FZ=DLYR(3,NU(NY,NX),NY,NX)-DNUMX + IF(FZ.GT.DNUMN)THEN + FX=(DLYR(3,NU(NY,NX),NY,NX)-DNUMX)/DLYR(3,NU(NY,NX),NY,NX) + L1=NU(NY,NX)-1 + NU(NY,NX)=L1 + ELSE + FX=0.0 + L1=NU(NY,NX) + ENDIF + ENDIF + ENDIF + WRITE(*,5599)'ERODE1',I,J,NX,NY,L0,L1,NU(NY,NX),DNUMN,DNUMX + 2,DLYR(3,L0,NY,NX),DLYR(3,L1,NY,NX),FX +5599 FORMAT(A8,7I4,12E12.4) + IF(FX.GT.0.0)THEN + FY=1.0-FX + BKDS(L1,NY,NX)=(BKDS(L1,NY,NX) + 2*DLYR(3,L1,NY,NX)+BKDS(L0,NY,NX) + 3*FX*DLYR(3,L0,NY,NX))/(DLYR(3,L1,NY,NX) + 4+FX*DLYR(3,L0,NY,NX)) + VLNHB(L1,NY,NX)=(VLNHB(L1,NY,NX) + 2*DLYR(3,L1,NY,NX)+VLNHB(L0,NY,NX) + 3*FX*DLYR(3,L0,NY,NX))/(DLYR(3,L1,NY,NX) + 4+FX*DLYR(3,L0,NY,NX)) + VLNOB(L1,NY,NX)=(VLNOB(L1,NY,NX) + 2*DLYR(3,L1,NY,NX)+VLNOB(L0,NY,NX) + 3*FX*DLYR(3,L0,NY,NX))/(DLYR(3,L1,NY,NX) + 4+FX*DLYR(3,L0,NY,NX)) + VLPOB(L1,NY,NX)=(VLPOB(L1,NY,NX) + 2*DLYR(3,L1,NY,NX)+VLPOB(L0,NY,NX) + 3*FX*DLYR(3,L0,NY,NX))/(DLYR(3,L1,NY,NX) + 4+FX*DLYR(3,L0,NY,NX)) + VLNH4(L1,NY,NX)=1.0-VLNHB(L1,NY,NX) + VLNO3(L1,NY,NX)=1.0-VLNOB(L1,NY,NX) + VLPO4(L1,NY,NX)=1.0-VLPOB(L1,NY,NX) + DLYR(3,L1,NY,NX)=DLYR(3,L1,NY,NX) + 2+FX*DLYR(3,L0,NY,NX) + VOLX(L1,NY,NX)=VOLX(L1,NY,NX) + 2+FX*VOLX(L0,NY,NX) + BKVL(L1,NY,NX)=BKVL(L1,NY,NX) + 2+FX*BKVL(L0,NY,NX) + SAND(L1,NY,NX)=SAND(L1,NY,NX) + 2+FX*SAND(L0,NY,NX) + SILT(L1,NY,NX)=SILT(L1,NY,NX) + 2+FX*SILT(L0,NY,NX) + CLAY(L1,NY,NX)=CLAY(L1,NY,NX) + 2+FX*CLAY(L0,NY,NX) + XCEC(L1,NY,NX)=XCEC(L1,NY,NX) + 2+FX*XCEC(L0,NY,NX) + XAEC(L1,NY,NX)=XAEC(L1,NY,NX) + 2+FX*XAEC(L0,NY,NX) + VOLW(L1,NY,NX)=VOLW(L1,NY,NX) + 2+FX*VOLW(L0,NY,NX) + VOLI(L1,NY,NX)=VOLI(L1,NY,NX) + 2+FX*VOLI(L0,NY,NX) + VOLIH(L1,NY,NX)=VOLIH(L1,NY,NX) + 2+FX*VOLIH(L0,NY,NX) + VOLP(L1,NY,NX)=VOLP(L1,NY,NX) + 2+FX*VOLP(L0,NY,NX) + VOLA(L1,NY,NX)=VOLA(L1,NY,NX) + 2+FX*VOLA(L0,NY,NX) + VOLWX(L1,NY,NX)=VOLW(L0,NY,NX) + VOLWH(L1,NY,NX)=VOLWH(L1,NY,NX) + 2+FX*VOLWH(L0,NY,NX) + VOLAH(L1,NY,NX)=VOLAH(L1,NY,NX) + 2+FX*VOLAH(L0,NY,NX) + VHCM(L1,NY,NX)=VHCM(L1,NY,NX) + 2+FX*VHCM(L0,NY,NX) + VHCP(L1,NY,NX)=VHCM(L1,NY,NX) + 2+4.19*(VOLW(L1,NY,NX)+VOLWH(L1,NY,NX)) + 3+1.9274*(VOLI(L1,NY,NX)+VOLIH(L1,NY,NX)) + ZNH4FA(L1,NY,NX)=ZNH4FA(L1,NY,NX) + 2+FX*ZNH4FA(L0,NY,NX) + ZNH3FA(L1,NY,NX)=ZNH3FA(L1,NY,NX) + 2+FX*ZNH3FA(L0,NY,NX) + ZNHUFA(L1,NY,NX)=ZNHUFA(L1,NY,NX) + 2+FX*ZNHUFA(L0,NY,NX) + ZNO3FA(L1,NY,NX)=ZNO3FA(L1,NY,NX) + 2+FX*ZNO3FA(L0,NY,NX) + ZNH4FB(L1,NY,NX)=ZNH4FB(L1,NY,NX) + 2+FX*ZNH4FB(L0,NY,NX) + ZNH3FB(L1,NY,NX)=ZNH3FB(L1,NY,NX) + 2+FX*ZNH3FB(L0,NY,NX) + ZNHUFB(L1,NY,NX)=ZNHUFB(L1,NY,NX) + 2+FX*ZNHUFB(L0,NY,NX) + ZNO3FB(L1,NY,NX)=ZNO3FB(L1,NY,NX) + 2+FX*ZNO3FB(L0,NY,NX) + ZNH4S(L1,NY,NX)=ZNH4S(L1,NY,NX) + 2+FX*ZNH4S(L0,NY,NX) + ZNH4B(L1,NY,NX)=ZNH4B(L1,NY,NX) + 2+FX*ZNH4B(L0,NY,NX) + ZNH3S(L1,NY,NX)=ZNH3S(L1,NY,NX) + 2+FX*ZNH3S(L0,NY,NX) + ZNH3B(L1,NY,NX)=ZNH3B(L1,NY,NX) + 2+FX*ZNH3B(L0,NY,NX) + ZNO3S(L1,NY,NX)=ZNO3S(L1,NY,NX) + 2+FX*ZNO3S(L0,NY,NX) + ZNO3B(L1,NY,NX)=ZNO3B(L1,NY,NX) + 2+FX*ZNO3B(L0,NY,NX) + ZNO2S(L1,NY,NX)=ZNO2S(L1,NY,NX) + 2+FX*ZNO2S(L0,NY,NX) + ZNO2B(L1,NY,NX)=ZNO2B(L1,NY,NX) + 2+FX*ZNO2B(L0,NY,NX) + ZAL(L1,NY,NX)=ZAL(L1,NY,NX) + 2+FX*ZAL(L0,NY,NX) + ZFE(L1,NY,NX)=ZFE(L1,NY,NX) + 2+FX*ZFE(L0,NY,NX) + ZHY(L1,NY,NX)=ZHY(L1,NY,NX) + 2+FX*ZHY(L0,NY,NX) + ZCA(L1,NY,NX)=ZCA(L1,NY,NX) + 2+FX*ZCA(L0,NY,NX) + ZMG(L1,NY,NX)=ZMG(L1,NY,NX) + 2+FX*ZMG(L0,NY,NX) + ZNA(L1,NY,NX)=ZNA(L1,NY,NX) + 2+FX*ZNA(L0,NY,NX) + ZKA(L1,NY,NX)=ZKA(L1,NY,NX) + 2+FX*ZKA(L0,NY,NX) + ZOH(L1,NY,NX)=ZOH(L1,NY,NX) + 2+FX*ZOH(L0,NY,NX) + ZSO4(L1,NY,NX)=ZSO4(L1,NY,NX) + 2+FX*ZSO4(L0,NY,NX) + ZCL(L1,NY,NX)=ZCL(L1,NY,NX) + 2+FX*ZCL(L0,NY,NX) + ZCO3(L1,NY,NX)=ZCO3(L1,NY,NX) + 2+FX*ZCO3(L0,NY,NX) + ZHCO3(L1,NY,NX)=ZHCO3(L1,NY,NX) + 2+FX*ZHCO3(L0,NY,NX) + ZALOH1(L1,NY,NX)=ZALOH1(L1,NY,NX) + 2+FX*ZALOH1(L0,NY,NX) + ZALOH2(L1,NY,NX)=ZALOH2(L1,NY,NX) + 2+FX*ZALOH2(L0,NY,NX) + ZALOH3(L1,NY,NX)=ZALOH3(L1,NY,NX) + 2+FX*ZALOH3(L0,NY,NX) + ZALOH4(L1,NY,NX)=ZALOH4(L1,NY,NX) + 2+FX*ZALOH4(L0,NY,NX) + ZALS(L1,NY,NX)=ZALS(L1,NY,NX) + 2+FX*ZALS(L0,NY,NX) + ZFEOH1(L1,NY,NX)=ZFEOH1(L1,NY,NX) + 2+FX*ZFEOH1(L0,NY,NX) + ZFEOH2(L1,NY,NX)=ZFEOH2(L1,NY,NX) + 2+FX*ZFEOH2(L0,NY,NX) + ZFEOH3(L1,NY,NX)=ZFEOH3(L1,NY,NX) + 2+FX*ZFEOH3(L0,NY,NX) + ZFEOH4(L1,NY,NX)=ZFEOH4(L1,NY,NX) + 2+FX*ZFEOH4(L0,NY,NX) + ZFES(L1,NY,NX)=ZFES(L1,NY,NX) + 2+FX*ZFES(L0,NY,NX) + ZCAO(L1,NY,NX)=ZCAO(L1,NY,NX) + 2+FX*ZCAO(L0,NY,NX) + ZCAC(L1,NY,NX)=ZCAC(L1,NY,NX) + 2+FX*ZCAC(L0,NY,NX) + ZCAH(L1,NY,NX)=ZCAH(L1,NY,NX) + 2+FX*ZCAH(L0,NY,NX) + ZCAS(L1,NY,NX)=ZCAS(L1,NY,NX) + 2+FX*ZCAS(L0,NY,NX) + ZMGO(L1,NY,NX)=ZMGO(L1,NY,NX) + 2+FX*ZMGO(L0,NY,NX) + ZMGC(L1,NY,NX)=ZMGC(L1,NY,NX) + 2+FX*ZMGC(L0,NY,NX) + ZMGH(L1,NY,NX)=ZMGH(L1,NY,NX) + 2+FX*ZMGH(L0,NY,NX) + ZMGS(L1,NY,NX)=ZMGS(L1,NY,NX) + 2+FX*ZMGS(L0,NY,NX) + ZNAC(L1,NY,NX)=ZNAC(L1,NY,NX) + 2+FX*ZNAC(L0,NY,NX) + ZNAS(L1,NY,NX)=ZNAS(L1,NY,NX) + 2+FX*ZNAS(L0,NY,NX) + ZKAS(L1,NY,NX)=ZKAS(L1,NY,NX) + 2+FX*ZKAS(L0,NY,NX) + H0PO4(L1,NY,NX)=H0PO4(L1,NY,NX) + 2+FX*H0PO4(L0,NY,NX) + H1PO4(L1,NY,NX)=H1PO4(L1,NY,NX) + 2+FX*H1PO4(L0,NY,NX) + H2PO4(L1,NY,NX)=H2PO4(L1,NY,NX) + 2+FX*H2PO4(L0,NY,NX) + H3PO4(L1,NY,NX)=H3PO4(L1,NY,NX) + 2+FX*H3PO4(L0,NY,NX) + ZFE1P(L1,NY,NX)=ZFE1P(L1,NY,NX) + 2+FX*ZFE1P(L0,NY,NX) + ZFE2P(L1,NY,NX)=ZFE2P(L1,NY,NX) + 2+FX*ZFE2P(L0,NY,NX) + ZCA0P(L1,NY,NX)=ZCA0P(L1,NY,NX) + 2+FX*ZCA0P(L0,NY,NX) + ZCA1P(L1,NY,NX)=ZCA1P(L1,NY,NX) + 2+FX*ZCA1P(L0,NY,NX) + ZCA2P(L1,NY,NX)=ZCA2P(L1,NY,NX) + 2+FX*ZCA2P(L0,NY,NX) + ZMG1P(L1,NY,NX)=ZMG1P(L1,NY,NX) + 2+FX*ZMG1P(L0,NY,NX) + H0POB(L1,NY,NX)=H0POB(L1,NY,NX) + 2+FX*H0POB(L0,NY,NX) + H1POB(L1,NY,NX)=H1POB(L1,NY,NX) + 2+FX*H1POB(L0,NY,NX) + H2POB(L1,NY,NX)=H2POB(L1,NY,NX) + 2+FX*H2POB(L0,NY,NX) + H3POB(L1,NY,NX)=H3POB(L1,NY,NX) + 2+FX*H3POB(L0,NY,NX) + ZFE1PB(L1,NY,NX)=ZFE1PB(L1,NY,NX) + 2+FX*ZFE1PB(L0,NY,NX) + ZFE2PB(L1,NY,NX)=ZFE2PB(L1,NY,NX) + 2+FX*ZFE2PB(L0,NY,NX) + ZCA0PB(L1,NY,NX)=ZCA0PB(L1,NY,NX) + 2+FX*ZCA0PB(L0,NY,NX) + ZCA1PB(L1,NY,NX)=ZCA1PB(L1,NY,NX) + 2+FX*ZCA1PB(L0,NY,NX) + ZCA2PB(L1,NY,NX)=ZCA2PB(L1,NY,NX) + 2+FX*ZCA2PB(L0,NY,NX) + ZMG1PB(L1,NY,NX)=ZMG1PB(L1,NY,NX) + 2+FX*ZMG1PB(L0,NY,NX) + XN4(L1,NY,NX)=XN4(L1,NY,NX) + 2+FX*XN4(L0,NY,NX) + XNB(L1,NY,NX)=XNB(L1,NY,NX) + 2+FX*XNB(L0,NY,NX) + XHY(L1,NY,NX)=XHY(L1,NY,NX) + 2+FX*XHY(L0,NY,NX) + XAL(L1,NY,NX)=XAL(L1,NY,NX) + 2+FX*XAL(L0,NY,NX) + XCA(L1,NY,NX)=XCA(L1,NY,NX) + 2+FX*XCA(L0,NY,NX) + XMG(L1,NY,NX)=XMG(L1,NY,NX) + 2+FX*XMG(L0,NY,NX) + XNA(L1,NY,NX)=XNA(L1,NY,NX) + 2+FX*XNA(L0,NY,NX) + XKA(L1,NY,NX)=XKA(L1,NY,NX) + 2+FX*XKA(L0,NY,NX) + XHC(L1,NY,NX)=XHC(L1,NY,NX) + 2+FX*XHC(L0,NY,NX) + XALO2(L1,NY,NX)=XALO2(L1,NY,NX) + 2+FX*XALO2(L0,NY,NX) + XOH0(L1,NY,NX)=XOH0(L1,NY,NX) + 2+FX*XOH0(L0,NY,NX) + XOH1(L1,NY,NX)=XOH1(L1,NY,NX) + 2+FX*XOH1(L0,NY,NX) + XOH2(L1,NY,NX)=XOH2(L1,NY,NX) + 2+FX*XOH2(L0,NY,NX) + XH1P(L1,NY,NX)=XH1P(L1,NY,NX) + 2+FX*XH1P(L0,NY,NX) + XH2P(L1,NY,NX)=XH2P(L1,NY,NX) + 2+FX*XH2P(L0,NY,NX) + XOH0B(L1,NY,NX)=XOH0B(L1,NY,NX) + 2+FX*XOH0B(L0,NY,NX) + XOH1B(L1,NY,NX)=XOH1B(L1,NY,NX) + 2+FX*XOH1B(L0,NY,NX) + XOH2B(L1,NY,NX)=XOH2B(L1,NY,NX) + 2+FX*XOH2B(L0,NY,NX) + XH1PB(L1,NY,NX)=XH1PB(L1,NY,NX) + 2+FX*XH1PB(L0,NY,NX) + XH2PB(L1,NY,NX)=XH2PB(L1,NY,NX) + 2+FX*XH2PB(L0,NY,NX) + PALOH(L1,NY,NX)=PALOH(L1,NY,NX) + 2+FX*PALOH(L0,NY,NX) + PFEOH(L1,NY,NX)=PFEOH(L1,NY,NX) + 2+FX*PFEOH(L0,NY,NX) + PCACO(L1,NY,NX)=PCACO(L1,NY,NX) + 2+FX*PCACO(L0,NY,NX) + PCASO(L1,NY,NX)=PCASO(L1,NY,NX) + 2+FX*PCASO(L0,NY,NX) + PALPO(L1,NY,NX)=PALPO(L1,NY,NX) + 2+FX*PALPO(L0,NY,NX) + PFEPO(L1,NY,NX)=PFEPO(L1,NY,NX) + 2+FX*PFEPO(L0,NY,NX) + PCAPD(L1,NY,NX)=PCAPD(L1,NY,NX) + 2+FX*PCAPD(L0,NY,NX) + PCAPH(L1,NY,NX)=PCAPH(L1,NY,NX) + 2+FX*PCAPH(L0,NY,NX) + PCAPM(L1,NY,NX)=PCAPM(L1,NY,NX) + 2+FX*PCAPM(L0,NY,NX) + PALPB(L1,NY,NX)=PALPB(L1,NY,NX) + 2+FX*PALPB(L0,NY,NX) + PFEPB(L1,NY,NX)=PFEPB(L1,NY,NX) + 2+FX*PFEPB(L0,NY,NX) + PCPDB(L1,NY,NX)=PCPDB(L1,NY,NX) + 2+FX*PCPDB(L0,NY,NX) + PCPHB(L1,NY,NX)=PCPHB(L1,NY,NX) + 2+FX*PCPHB(L0,NY,NX) + PCPMB(L1,NY,NX)=PCPMB(L1,NY,NX) + 2+FX*PCPMB(L0,NY,NX) + CO2G(L1,NY,NX)=CO2G(L1,NY,NX) + 2+FX*CO2G(L0,NY,NX) + CH4G(L1,NY,NX)=CH4G(L1,NY,NX) + 2+FX*CH4G(L0,NY,NX) + CO2S(L1,NY,NX)=CO2S(L1,NY,NX) + 2+FX*CO2S(L0,NY,NX) + CH4S(L1,NY,NX)=CH4S(L1,NY,NX) + 2+FX*CH4S(L0,NY,NX) + OXYG(L1,NY,NX)=OXYG(L1,NY,NX) + 2+FX*OXYG(L0,NY,NX) + OXYS(L1,NY,NX)=OXYS(L1,NY,NX) + 2+FX*OXYS(L0,NY,NX) + Z2GG(L1,NY,NX)=Z2GG(L1,NY,NX) + 2+FX*Z2GG(L0,NY,NX) + Z2GS(L1,NY,NX)=Z2GS(L1,NY,NX) + 2+FX*Z2GS(L0,NY,NX) + Z2OG(L1,NY,NX)=Z2OG(L1,NY,NX) + 2+FX*Z2OG(L0,NY,NX) + Z2OS(L1,NY,NX)=Z2OS(L1,NY,NX) + 2+FX*Z2OS(L0,NY,NX) + ZNH3G(L1,NY,NX)=ZNH3G(L1,NY,NX) + 2+FX*ZNH3G(L0,NY,NX) + H2GG(L1,NY,NX)=H2GG(L1,NY,NX) + 2+FX*H2GG(L0,NY,NX) + H2GS(L1,NY,NX)=H2GS(L1,NY,NX) + 2+FX*H2GS(L0,NY,NX) + ZNH4SH(L1,NY,NX)=ZNH4SH(L1,NY,NX) + 2+FX*ZNH4SH(L0,NY,NX) + ZNH3SH(L1,NY,NX)=ZNH3SH(L1,NY,NX) + 2+FX*ZNH3SH(L0,NY,NX) + ZNO3SH(L1,NY,NX)=ZNO3SH(L1,NY,NX) + 2+FX*ZNO3SH(L0,NY,NX) + ZNO2SH(L1,NY,NX)=ZNO2SH(L1,NY,NX) + 2+FX*ZNO2SH(L0,NY,NX) + H2PO4H(L1,NY,NX)=H2PO4H(L1,NY,NX) + 2+FX*H2PO4H(L0,NY,NX) + ZNH4BH(L1,NY,NX)=ZNH4BH(L1,NY,NX) + 2+FX*ZNH4BH(L0,NY,NX) + ZNH3BH(L1,NY,NX)=ZNH3BH(L1,NY,NX) + 2+FX*ZNH3BH(L0,NY,NX) + ZNO3BH(L1,NY,NX)=ZNO3BH(L1,NY,NX) + 2+FX*ZNO3BH(L0,NY,NX) + ZNO2BH(L1,NY,NX)=ZNO2BH(L1,NY,NX) + 2+FX*ZNO2BH(L0,NY,NX) + H2POBH(L1,NY,NX)=H2POBH(L1,NY,NX) + 2+FX*H2POBH(L0,NY,NX) + ZALH(L1,NY,NX)=ZALH(L1,NY,NX) + 2+FX*ZALH(L0,NY,NX) + ZFEH(L1,NY,NX)=ZFEH(L1,NY,NX) + 2+FX*ZFEH(L0,NY,NX) + ZHYH(L1,NY,NX)=ZHYH(L1,NY,NX) + 2+FX*ZHYH(L0,NY,NX) + ZCCH(L1,NY,NX)=ZCCH(L1,NY,NX) + 2+FX*ZCCH(L0,NY,NX) + ZMAH(L1,NY,NX)=ZMAH(L1,NY,NX) + 2+FX*ZMAH(L0,NY,NX) + ZNAH(L1,NY,NX)=ZNAH(L1,NY,NX) + 2+FX*ZNAH(L0,NY,NX) + ZKAH(L1,NY,NX)=ZKAH(L1,NY,NX) + 2+FX*ZKAH(L0,NY,NX) + ZOHH(L1,NY,NX)=ZOHH(L1,NY,NX) + 2+FX*ZOHH(L0,NY,NX) + ZSO4H(L1,NY,NX)=ZSO4H(L1,NY,NX) + 2+FX*ZSO4H(L0,NY,NX) + ZCLH(L1,NY,NX)=ZCLH(L1,NY,NX) + 2+FX*ZCLH(L0,NY,NX) + ZCO3H(L1,NY,NX)=ZCO3H(L1,NY,NX) + 2+FX*ZCO3H(L0,NY,NX) + ZHCO3H(L1,NY,NX)=ZHCO3H(L1,NY,NX) + 2+FX*ZHCO3H(L0,NY,NX) + ZALO1H(L1,NY,NX)=ZALO1H(L1,NY,NX) + 2+FX*ZALO1H(L0,NY,NX) + ZALO2H(L1,NY,NX)=ZALO2H(L1,NY,NX) + 2+FX*ZALO2H(L0,NY,NX) + ZALO3H(L1,NY,NX)=ZALO3H(L1,NY,NX) + 2+FX*ZALO3H(L0,NY,NX) + ZALO4H(L1,NY,NX)=ZALO4H(L1,NY,NX) + 2+FX*ZALO4H(L0,NY,NX) + ZALSH(L1,NY,NX)=ZALSH(L1,NY,NX) + 2+FX*ZALSH(L0,NY,NX) + ZFEO1H(L1,NY,NX)=ZFEO1H(L1,NY,NX) + 2+FX*ZFEO1H(L0,NY,NX) + ZFEO2H(L1,NY,NX)=ZFEO2H(L1,NY,NX) + 2+FX*ZFEO2H(L0,NY,NX) + ZFEO3H(L1,NY,NX)=ZFEO3H(L1,NY,NX) + 2+FX*ZFEO3H(L0,NY,NX) + ZFEO4H(L1,NY,NX)=ZFEO4H(L1,NY,NX) + 2+FX*ZFEO4H(L0,NY,NX) + ZFESH(L1,NY,NX)=ZFESH(L1,NY,NX) + 2+FX*ZFESH(L0,NY,NX) + ZCAOH(L1,NY,NX)=ZCAOH(L1,NY,NX) + 2+FX*ZCAOH(L0,NY,NX) + ZCACH(L1,NY,NX)=ZCACH(L1,NY,NX) + 2+FX*ZCACH(L0,NY,NX) + ZCAHH(L1,NY,NX)=ZCAHH(L1,NY,NX) + 2+FX*ZCAHH(L0,NY,NX) + ZCASH(L1,NY,NX)=ZCASH(L1,NY,NX) + 2+FX*ZCASH(L0,NY,NX) + ZMGOH(L1,NY,NX)=ZMGOH(L1,NY,NX) + 2+FX*ZMGOH(L0,NY,NX) + ZMGCH(L1,NY,NX)=ZMGCH(L1,NY,NX) + 2+FX*ZMGCH(L0,NY,NX) + ZMGHH(L1,NY,NX)=ZMGHH(L1,NY,NX) + 2+FX*ZMGHH(L0,NY,NX) + ZMGSH(L1,NY,NX)=ZMGSH(L1,NY,NX) + 2+FX*ZMGSH(L0,NY,NX) + ZNACH(L1,NY,NX)=ZNACH(L1,NY,NX) + 2+FX*ZNACH(L0,NY,NX) + ZNASH(L1,NY,NX)=ZNASH(L1,NY,NX) + 2+FX*ZNASH(L0,NY,NX) + ZKASH(L1,NY,NX)=ZKASH(L1,NY,NX) + 2+FX*ZKASH(L0,NY,NX) + H0PO4H(L1,NY,NX)=H0PO4H(L1,NY,NX) + 2+FX*H0PO4H(L0,NY,NX) + H1PO4H(L1,NY,NX)=H1PO4H(L1,NY,NX) + 2+FX*H1PO4H(L0,NY,NX) + H3PO4H(L1,NY,NX)=H3PO4H(L1,NY,NX) + 2+FX*H3PO4H(L0,NY,NX) + ZFE1PH(L1,NY,NX)=ZFE1PH(L1,NY,NX) + 2+FX*ZFE1PH(L0,NY,NX) + ZFE2PH(L1,NY,NX)=ZFE2PH(L1,NY,NX) + 2+FX*ZFE2PH(L0,NY,NX) + ZCA0PH(L1,NY,NX)=ZCA0PH(L1,NY,NX) + 2+FX*ZCA0PH(L0,NY,NX) + ZCA1PH(L1,NY,NX)=ZCA1PH(L1,NY,NX) + 2+FX*ZCA1PH(L0,NY,NX) + ZCA2PH(L1,NY,NX)=ZCA2PH(L1,NY,NX) + 2+FX*ZCA2PH(L0,NY,NX) + ZMG1PH(L1,NY,NX)=ZMG1PH(L1,NY,NX) + 2+FX*ZMG1PH(L0,NY,NX) + H0POBH(L1,NY,NX)=H0POBH(L1,NY,NX) + 2+FX*H0POBH(L0,NY,NX) + H1POBH(L1,NY,NX)=H1POBH(L1,NY,NX) + 2+FX*H1POBH(L0,NY,NX) + H3POBH(L1,NY,NX)=H3POBH(L1,NY,NX) + 2+FX*H3POBH(L0,NY,NX) + ZFE1BH(L1,NY,NX)=ZFE1BH(L1,NY,NX) + 2+FX*ZFE1BH(L0,NY,NX) + ZFE2BH(L1,NY,NX)=ZFE2BH(L1,NY,NX) + 2+FX*ZFE2BH(L0,NY,NX) + ZCA0BH(L1,NY,NX)=ZCA0BH(L1,NY,NX) + 2+FX*ZCA0BH(L0,NY,NX) + ZCA1BH(L1,NY,NX)=ZCA1BH(L1,NY,NX) + 2+FX*ZCA1BH(L0,NY,NX) + ZCA2BH(L1,NY,NX)=ZCA2BH(L1,NY,NX) + 2+FX*ZCA2BH(L0,NY,NX) + ZMG1BH(L1,NY,NX)=ZMG1BH(L1,NY,NX) + 2+FX*ZMG1BH(L0,NY,NX) + CO2SH(L1,NY,NX)=CO2SH(L1,NY,NX) + 2+FX*CO2SH(L0,NY,NX) + CH4SH(L1,NY,NX)=CH4SH(L1,NY,NX) + 2+FX*CH4SH(L0,NY,NX) + OXYSH(L1,NY,NX)=OXYSH(L1,NY,NX) + 2+FX*OXYSH(L0,NY,NX) + Z2GSH(L1,NY,NX)=Z2GSH(L1,NY,NX) + 2+FX*Z2GSH(L0,NY,NX) + Z2OSH(L1,NY,NX)=Z2OSH(L1,NY,NX) + 2+FX*Z2OSH(L0,NY,NX) + ORGC(L1,NY,NX)=ORGC(L1,NY,NX) + 2+FX*ORGC(L0,NY,NX) + ORGN(L1,NY,NX)=ORGN(L1,NY,NX) + 2+FX*ORGN(L0,NY,NX) + DO 7965 K=0,5 + DO 7965 N=1,7 + DO 7965 M=1,3 + OMC(M,N,K,L1,NY,NX)=OMC(M,N,K,L1,NY,NX) + 2+FX*OMC(M,N,K,L0,NY,NX) + OMN(M,N,K,L1,NY,NX)=OMN(M,N,K,L1,NY,NX) + 2+FX*OMN(M,N,K,L0,NY,NX) + OMP(M,N,K,L1,NY,NX)=OMP(M,N,K,L1,NY,NX) + 2+FX*OMP(M,N,K,L0,NY,NX) +7965 CONTINUE + DO 7780 K=0,4 + DO 7775 M=1,2 + ORC(M,K,L1,NY,NX)=ORC(M,K,L1,NY,NX) + 2+FX*ORC(M,K,L0,NY,NX) + ORN(M,K,L1,NY,NX)=ORN(M,K,L1,NY,NX) + 2+FX*ORN(M,K,L0,NY,NX) + ORP(M,K,L1,NY,NX)=ORP(M,K,L1,NY,NX) + 2+FX*ORP(M,K,L0,NY,NX) +7775 CONTINUE + OQC(K,L1,NY,NX)=OQC(K,L1,NY,NX) + 2+FX*OQC(K,L0,NY,NX) + OQN(K,L1,NY,NX)=OQN(K,L1,NY,NX) + 2+FX*OQN(K,L0,NY,NX) + OQP(K,L1,NY,NX)=OQP(K,L1,NY,NX) + 2+FX*OQP(K,L0,NY,NX) + OQA(K,L1,NY,NX)=OQA(K,L1,NY,NX) + 2+FX*OQA(K,L0,NY,NX) + OQCH(K,L1,NY,NX)=OQCH(K,L1,NY,NX) + 2+FX*OQCH(K,L0,NY,NX) + OQNH(K,L1,NY,NX)=OQNH(K,L1,NY,NX) + 2+FX*OQNH(K,L0,NY,NX) + OQPH(K,L1,NY,NX)=OQPH(K,L1,NY,NX) + 2+FX*OQPH(K,L0,NY,NX) + OQAH(K,L1,NY,NX)=OQAH(K,L1,NY,NX) + 2+FX*OQAH(K,L0,NY,NX) + OHC(K,L1,NY,NX)=OHC(K,L1,NY,NX) + 2+FX*OHC(K,L0,NY,NX) + OHN(K,L1,NY,NX)=OHN(K,L1,NY,NX) + 2+FX*OHN(K,L0,NY,NX) + OHP(K,L1,NY,NX)=OHP(K,L1,NY,NX) + 2+FX*OHP(K,L0,NY,NX) + OHA(K,L1,NY,NX)=OHA(K,L1,NY,NX) + 2+FX*OHA(K,L0,NY,NX) + DO 7770 M=1,4 + OSC(M,K,L1,NY,NX)=OSC(M,K,L1,NY,NX) + 2+FX*OSC(M,K,L0,NY,NX) + OSA(M,K,L1,NY,NX)=OSA(M,K,L1,NY,NX) + 2+FX*OSA(M,K,L0,NY,NX) + OSN(M,K,L1,NY,NX)=OSN(M,K,L1,NY,NX) + 2+FX*OSN(M,K,L0,NY,NX) + OSP(M,K,L1,NY,NX)=OSP(M,K,L1,NY,NX) + 2+FX*OSP(M,K,L0,NY,NX) +7770 CONTINUE +7780 CONTINUE + CDPTH(L0,NY,NX)=CDPTH(L0,NY,NX) + 2-FX*DLYR(3,L0,NY,NX) + DLYR(3,L0,NY,NX)=FY*DLYR(3,L0,NY,NX) + VOLX(L0,NY,NX)=FY*VOLX(L0,NY,NX) + BKVL(L0,NY,NX)=FY*BKVL(L0,NY,NX) + SAND(L0,NY,NX)=FY*SAND(L0,NY,NX) + SILT(L0,NY,NX)=FY*SILT(L0,NY,NX) + CLAY(L0,NY,NX)=FY*CLAY(L0,NY,NX) + XCEC(L0,NY,NX)=FY*XCEC(L0,NY,NX) + XAEC(L0,NY,NX)=FY*XAEC(L0,NY,NX) + VOLW(L0,NY,NX)=FY*VOLW(L0,NY,NX) + VOLI(L0,NY,NX)=FY*VOLI(L0,NY,NX) + VOLP(L0,NY,NX)=FY*VOLP(L0,NY,NX) + VOLA(L0,NY,NX)=FY*VOLA(L0,NY,NX) + VOLWX(L0,NY,NX)=FY*VOLWX(L0,NY,NX) + VOLWH(L0,NY,NX)=FY*VOLWH(L0,NY,NX) + VOLIH(L0,NY,NX)=FY*VOLIH(L0,NY,NX) + VOLAH(L0,NY,NX)=FY*VOLAH(L0,NY,NX) + VHCM(L0,NY,NX)=FY*VHCM(L0,NY,NX) + VHCP(L0,NY,NX)=FY*VHCP(L0,NY,NX) + VHCP(L0,NY,NX)=VHCM(L0,NY,NX) + 2+4.19*(VOLW(L0,NY,NX)+VOLWH(L0,NY,NX)) + 3+1.9274*(VOLI(L0,NY,NX)+VOLIH(L0,NY,NX)) + ZNH4FA(L0,NY,NX)=FY*ZNH4FA(L0,NY,NX) + ZNH3FA(L0,NY,NX)=FY*ZNH3FA(L0,NY,NX) + ZNHUFA(L0,NY,NX)=FY*ZNHUFA(L0,NY,NX) + ZNO3FA(L0,NY,NX)=FY*ZNO3FA(L0,NY,NX) + ZNH4FB(L0,NY,NX)=FY*ZNH4FB(L0,NY,NX) + ZNH3FB(L0,NY,NX)=FY*ZNH3FB(L0,NY,NX) + ZNHUFB(L0,NY,NX)=FY*ZNHUFB(L0,NY,NX) + ZNO3FB(L0,NY,NX)=FY*ZNO3FB(L0,NY,NX) + ZNH4S(L0,NY,NX)=FY*ZNH4S(L0,NY,NX) + ZNH4B(L0,NY,NX)=FY*ZNH4B(L0,NY,NX) + ZNH3S(L0,NY,NX)=FY*ZNH3S(L0,NY,NX) + ZNH3B(L0,NY,NX)=FY*ZNH3B(L0,NY,NX) + ZNO3S(L0,NY,NX)=FY*ZNO3S(L0,NY,NX) + ZNO3B(L0,NY,NX)=FY*ZNO3B(L0,NY,NX) + ZNO2S(L0,NY,NX)=FY*ZNO2S(L0,NY,NX) + ZNO2B(L0,NY,NX)=FY*ZNO2B(L0,NY,NX) + ZAL(L0,NY,NX)=FY*ZAL(L0,NY,NX) + ZFE(L0,NY,NX)=FY*ZFE(L0,NY,NX) + ZHY(L0,NY,NX)=FY*ZHY(L0,NY,NX) + ZCA(L0,NY,NX)=FY*ZCA(L0,NY,NX) + ZMG(L0,NY,NX)=FY*ZMG(L0,NY,NX) + ZNA(L0,NY,NX)=FY*ZNA(L0,NY,NX) + ZKA(L0,NY,NX)=FY*ZKA(L0,NY,NX) + ZOH(L0,NY,NX)=FY*ZOH(L0,NY,NX) + ZSO4(L0,NY,NX)=FY*ZSO4(L0,NY,NX) + ZCL(L0,NY,NX)=FY*ZCL(L0,NY,NX) + ZCO3(L0,NY,NX)=FY*ZCO3(L0,NY,NX) + ZHCO3(L0,NY,NX)=FY*ZHCO3(L0,NY,NX) + ZALOH1(L0,NY,NX)=FY*ZALOH1(L0,NY,NX) + ZALOH2(L0,NY,NX)=FY*ZALOH2(L0,NY,NX) + ZALOH3(L0,NY,NX)=FY*ZALOH3(L0,NY,NX) + ZALOH4(L0,NY,NX)=FY*ZALOH4(L0,NY,NX) + ZALS(L0,NY,NX)=FY*ZALS(L0,NY,NX) + ZFEOH1(L0,NY,NX)=FY*ZFEOH1(L0,NY,NX) + ZFEOH2(L0,NY,NX)=FY*ZFEOH2(L0,NY,NX) + ZFEOH3(L0,NY,NX)=FY*ZFEOH3(L0,NY,NX) + ZFEOH4(L0,NY,NX)=FY*ZFEOH4(L0,NY,NX) + ZFES(L0,NY,NX)=FY*ZFES(L0,NY,NX) + ZCAO(L0,NY,NX)=FY*ZCAO(L0,NY,NX) + ZCAC(L0,NY,NX)=FY*ZCAC(L0,NY,NX) + ZCAH(L0,NY,NX)=FY*ZCAH(L0,NY,NX) + ZCAS(L0,NY,NX)=FY*ZCAS(L0,NY,NX) + ZMGO(L0,NY,NX)=FY*ZMGO(L0,NY,NX) + ZMGC(L0,NY,NX)=FY*ZMGC(L0,NY,NX) + ZMGH(L0,NY,NX)=FY*ZMGH(L0,NY,NX) + ZMGS(L0,NY,NX)=FY*ZMGS(L0,NY,NX) + ZNAC(L0,NY,NX)=FY*ZNAC(L0,NY,NX) + ZNAS(L0,NY,NX)=FY*ZNAS(L0,NY,NX) + ZKAS(L0,NY,NX)=FY*ZKAS(L0,NY,NX) + H0PO4(L0,NY,NX)=FY*H0PO4(L0,NY,NX) + H1PO4(L0,NY,NX)=FY*H1PO4(L0,NY,NX) + H2PO4(L0,NY,NX)=FY*H2PO4(L0,NY,NX) + H3PO4(L0,NY,NX)=FY*H3PO4(L0,NY,NX) + ZFE1P(L0,NY,NX)=FY*ZFE1P(L0,NY,NX) + ZFE2P(L0,NY,NX)=FY*ZFE2P(L0,NY,NX) + ZCA0P(L0,NY,NX)=FY*ZCA0P(L0,NY,NX) + ZCA1P(L0,NY,NX)=FY*ZCA1P(L0,NY,NX) + ZCA2P(L0,NY,NX)=FY*ZCA2P(L0,NY,NX) + ZMG1P(L0,NY,NX)=FY*ZMG1P(L0,NY,NX) + H0POB(L0,NY,NX)=FY*H0POB(L0,NY,NX) + H1POB(L0,NY,NX)=FY*H1POB(L0,NY,NX) + H2POB(L0,NY,NX)=FY*H2POB(L0,NY,NX) + H3POB(L0,NY,NX)=FY*H3POB(L0,NY,NX) + ZFE1PB(L0,NY,NX)=FY*ZFE1PB(L0,NY,NX) + ZFE2PB(L0,NY,NX)=FY*ZFE2PB(L0,NY,NX) + ZCA0PB(L0,NY,NX)=FY*ZCA0PB(L0,NY,NX) + ZCA1PB(L0,NY,NX)=FY*ZCA1PB(L0,NY,NX) + ZCA2PB(L0,NY,NX)=FY*ZCA2PB(L0,NY,NX) + ZMG1PB(L0,NY,NX)=FY*ZMG1PB(L0,NY,NX) + XN4(L0,NY,NX)=FY*XN4(L0,NY,NX) + XNB(L0,NY,NX)=FY*XNB(L0,NY,NX) + XHY(L0,NY,NX)=FY*XHY(L0,NY,NX) + XAL(L0,NY,NX)=FY*XAL(L0,NY,NX) + XCA(L0,NY,NX)=FY*XCA(L0,NY,NX) + XMG(L0,NY,NX)=FY*XMG(L0,NY,NX) + XNA(L0,NY,NX)=FY*XNA(L0,NY,NX) + XKA(L0,NY,NX)=FY*XKA(L0,NY,NX) + XHC(L0,NY,NX)=FY*XHC(L0,NY,NX) + XALO2(L0,NY,NX)=FY*XALO2(L0,NY,NX) + XOH0(L0,NY,NX)=FY*XOH0(L0,NY,NX) + XOH1(L0,NY,NX)=FY*XOH1(L0,NY,NX) + XOH2(L0,NY,NX)=FY*XOH2(L0,NY,NX) + XH1P(L0,NY,NX)=FY*XH1P(L0,NY,NX) + XH2P(L0,NY,NX)=FY*XH2P(L0,NY,NX) + XOH0B(L0,NY,NX)=FY*XOH0B(L0,NY,NX) + XOH1B(L0,NY,NX)=FY*XOH1B(L0,NY,NX) + XOH2B(L0,NY,NX)=FY*XOH2B(L0,NY,NX) + XH1PB(L0,NY,NX)=FY*XH1PB(L0,NY,NX) + XH2PB(L0,NY,NX)=FY*XH2PB(L0,NY,NX) + PALOH(L0,NY,NX)=FY*PALOH(L0,NY,NX) + PFEOH(L0,NY,NX)=FY*PFEOH(L0,NY,NX) + PCACO(L0,NY,NX)=FY*PCACO(L0,NY,NX) + PCASO(L0,NY,NX)=FY*PCASO(L0,NY,NX) + PALPO(L0,NY,NX)=FY*PALPO(L0,NY,NX) + PFEPO(L0,NY,NX)=FY*PFEPO(L0,NY,NX) + PCAPD(L0,NY,NX)=FY*PCAPD(L0,NY,NX) + PCAPH(L0,NY,NX)=FY*PCAPH(L0,NY,NX) + PCAPM(L0,NY,NX)=FY*PCAPM(L0,NY,NX) + PALPB(L0,NY,NX)=FY*PALPB(L0,NY,NX) + PFEPB(L0,NY,NX)=FY*PFEPB(L0,NY,NX) + PCPDB(L0,NY,NX)=FY*PCPDB(L0,NY,NX) + PCPHB(L0,NY,NX)=FY*PCPHB(L0,NY,NX) + PCPMB(L0,NY,NX)=FY*PCPMB(L0,NY,NX) + CO2G(L0,NY,NX)=FY*CO2G(L0,NY,NX) + CH4G(L0,NY,NX)=FY*CH4G(L0,NY,NX) + CO2S(L0,NY,NX)=FY*CO2S(L0,NY,NX) + CH4S(L0,NY,NX)=FY*CH4S(L0,NY,NX) + OXYG(L0,NY,NX)=FY*OXYG(L0,NY,NX) + OXYS(L0,NY,NX)=FY*OXYS(L0,NY,NX) + Z2GG(L0,NY,NX)=FY*Z2GG(L0,NY,NX) + Z2GS(L0,NY,NX)=FY*Z2GS(L0,NY,NX) + Z2OG(L0,NY,NX)=FY*Z2OG(L0,NY,NX) + Z2OS(L0,NY,NX)=FY*Z2OS(L0,NY,NX) + ZNH3G(L0,NY,NX)=FY*ZNH3G(L0,NY,NX) + H2GG(L0,NY,NX)=FY*H2GG(L0,NY,NX) + H2GS(L0,NY,NX)=FY*H2GS(L0,NY,NX) + ZNH4SH(L0,NY,NX)=FY*ZNH4SH(L0,NY,NX) + ZNH3SH(L0,NY,NX)=FY*ZNH3SH(L0,NY,NX) + ZNO3SH(L0,NY,NX)=FY*ZNO3SH(L0,NY,NX) + ZNO2SH(L0,NY,NX)=FY*ZNO2SH(L0,NY,NX) + H2PO4H(L0,NY,NX)=FY*H2PO4H(L0,NY,NX) + ZNH4BH(L0,NY,NX)=FY*ZNH4BH(L0,NY,NX) + ZNH3BH(L0,NY,NX)=FY*ZNH3BH(L0,NY,NX) + ZNO3BH(L0,NY,NX)=FY*ZNO3BH(L0,NY,NX) + ZNO2BH(L0,NY,NX)=FY*ZNO2BH(L0,NY,NX) + H2POBH(L0,NY,NX)=FY*H2POBH(L0,NY,NX) + ZALH(L0,NY,NX)=FY*ZALH(L0,NY,NX) + ZFEH(L0,NY,NX)=FY*ZFEH(L0,NY,NX) + ZHYH(L0,NY,NX)=FY*ZHYH(L0,NY,NX) + ZCCH(L0,NY,NX)=FY*ZCCH(L0,NY,NX) + ZMAH(L0,NY,NX)=FY*ZMAH(L0,NY,NX) + ZNAH(L0,NY,NX)=FY*ZNAH(L0,NY,NX) + ZKAH(L0,NY,NX)=FY*ZKAH(L0,NY,NX) + ZOHH(L0,NY,NX)=FY*ZOHH(L0,NY,NX) + ZSO4H(L0,NY,NX)=FY*ZSO4H(L0,NY,NX) + ZCLH(L0,NY,NX)=FY*ZCLH(L0,NY,NX) + ZCO3H(L0,NY,NX)=FY*ZCO3H(L0,NY,NX) + ZHCO3H(L0,NY,NX)=FY*ZHCO3H(L0,NY,NX) + ZALO1H(L0,NY,NX)=FY*ZALO1H(L0,NY,NX) + ZALO2H(L0,NY,NX)=FY*ZALO2H(L0,NY,NX) + ZALO3H(L0,NY,NX)=FY*ZALO3H(L0,NY,NX) + ZALO4H(L0,NY,NX)=FY*ZALO4H(L0,NY,NX) + ZALSH(L0,NY,NX)=FY*ZALSH(L0,NY,NX) + ZFEO1H(L0,NY,NX)=FY*ZFEO1H(L0,NY,NX) + ZFEO2H(L0,NY,NX)=FY*ZFEO2H(L0,NY,NX) + ZFEO3H(L0,NY,NX)=FY*ZFEO3H(L0,NY,NX) + ZFEO4H(L0,NY,NX)=FY*ZFEO4H(L0,NY,NX) + ZFESH(L0,NY,NX)=FY*ZFESH(L0,NY,NX) + ZCAOH(L0,NY,NX)=FY*ZCAOH(L0,NY,NX) + ZCACH(L0,NY,NX)=FY*ZCACH(L0,NY,NX) + ZCAHH(L0,NY,NX)=FY*ZCAHH(L0,NY,NX) + ZCASH(L0,NY,NX)=FY*ZCASH(L0,NY,NX) + ZMGOH(L0,NY,NX)=FY*ZMGOH(L0,NY,NX) + ZMGCH(L0,NY,NX)=FY*ZMGCH(L0,NY,NX) + ZMGHH(L0,NY,NX)=FY*ZMGHH(L0,NY,NX) + ZMGSH(L0,NY,NX)=FY*ZMGSH(L0,NY,NX) + ZNACH(L0,NY,NX)=FY*ZNACH(L0,NY,NX) + ZNASH(L0,NY,NX)=FY*ZNASH(L0,NY,NX) + ZKASH(L0,NY,NX)=FY*ZKASH(L0,NY,NX) + H0PO4H(L0,NY,NX)=FY*H0PO4H(L0,NY,NX) + H1PO4H(L0,NY,NX)=FY*H1PO4H(L0,NY,NX) + H3PO4H(L0,NY,NX)=FY*H3PO4H(L0,NY,NX) + ZFE1PH(L0,NY,NX)=FY*ZFE1PH(L0,NY,NX) + ZFE2PH(L0,NY,NX)=FY*ZFE2PH(L0,NY,NX) + ZCA0PH(L0,NY,NX)=FY*ZCA0PH(L0,NY,NX) + ZCA1PH(L0,NY,NX)=FY*ZCA1PH(L0,NY,NX) + ZCA2PH(L0,NY,NX)=FY*ZCA2PH(L0,NY,NX) + ZMG1PH(L0,NY,NX)=FY*ZMG1PH(L0,NY,NX) + H0POBH(L0,NY,NX)=FY*H0POBH(L0,NY,NX) + H1POBH(L0,NY,NX)=FY*H1POBH(L0,NY,NX) + H3POBH(L0,NY,NX)=FY*H3POBH(L0,NY,NX) + ZFE1BH(L0,NY,NX)=FY*ZFE1BH(L0,NY,NX) + ZFE2BH(L0,NY,NX)=FY*ZFE2BH(L0,NY,NX) + ZCA0BH(L0,NY,NX)=FY*ZCA0BH(L0,NY,NX) + ZCA1BH(L0,NY,NX)=FY*ZCA1BH(L0,NY,NX) + ZCA2BH(L0,NY,NX)=FY*ZCA2BH(L0,NY,NX) + ZMG1BH(L0,NY,NX)=FY*ZMG1BH(L0,NY,NX) + CO2SH(L0,NY,NX)=FY*CO2SH(L0,NY,NX) + CH4SH(L0,NY,NX)=FY*CH4SH(L0,NY,NX) + OXYSH(L0,NY,NX)=FY*OXYSH(L0,NY,NX) + Z2GSH(L0,NY,NX)=FY*Z2GSH(L0,NY,NX) + Z2OSH(L0,NY,NX)=FY*Z2OSH(L0,NY,NX) + ORGC(L0,NY,NX)=FY*ORGC(L0,NY,NX) + ORGN(L0,NY,NX)=FY*ORGN(L0,NY,NX) + DO 7865 K=0,5 + DO 7865 N=1,7 + DO 7865 M=1,3 + OMC(M,N,K,L0,NY,NX)=FY*OMC(M,N,K,L0,NY,NX) + OMN(M,N,K,L0,NY,NX)=FY*OMN(M,N,K,L0,NY,NX) + OMP(M,N,K,L0,NY,NX)=FY*OMP(M,N,K,L0,NY,NX) +7865 CONTINUE + DO 7880 K=0,4 + DO 7875 M=1,2 + ORC(M,K,L0,NY,NX)=FY*ORC(M,K,L0,NY,NX) + ORN(M,K,L0,NY,NX)=FY*ORN(M,K,L0,NY,NX) + ORP(M,K,L0,NY,NX)=FY*ORP(M,K,L0,NY,NX) +7875 CONTINUE + OQC(K,L0,NY,NX)=FY*OQC(K,L0,NY,NX) + OQN(K,L0,NY,NX)=FY*OQN(K,L0,NY,NX) + OQP(K,L0,NY,NX)=FY*OQP(K,L0,NY,NX) + OQA(K,L0,NY,NX)=FY*OQA(K,L0,NY,NX) + OQCH(K,L0,NY,NX)=FY*OQCH(K,L0,NY,NX) + OQNH(K,L0,NY,NX)=FY*OQNH(K,L0,NY,NX) + OQPH(K,L0,NY,NX)=FY*OQPH(K,L0,NY,NX) + OQAH(K,L0,NY,NX)=FY*OQAH(K,L0,NY,NX) + OHC(K,L0,NY,NX)=FY*OHC(K,L0,NY,NX) + OHN(K,L0,NY,NX)=FY*OHN(K,L0,NY,NX) + OHP(K,L0,NY,NX)=FY*OHP(K,L0,NY,NX) + OHA(K,L0,NY,NX)=FY*OHA(K,L0,NY,NX) + DO 7870 M=1,4 + OSC(M,K,L0,NY,NX)=FY*OSC(M,K,L0,NY,NX) + OSA(M,K,L0,NY,NX)=FY*OSA(M,K,L0,NY,NX) + OSN(M,K,L0,NY,NX)=FY*OSN(M,K,L0,NY,NX) + OSP(M,K,L0,NY,NX)=FY*OSP(M,K,L0,NY,NX) +7870 CONTINUE +7880 CONTINUE + IF(FY.EQ.0.0)THEN + CCO2S(L0,NY,NX)=9999 + CCH4S(L0,NY,NX)=9999 + COXYS(L0,NY,NX)=9999 + THETW(L0,NY,NX)=9999 + THETI(L0,NY,NX)=9999 + PSISM(L0,NY,NX)=9999 + CZ2OS(L0,NY,NX)=9999 + CNH3S(L0,NY,NX)=9999 + TCS(L0,NY,NX)=9999 + ENDIF + IFLGS(NY,NX)=1 + WRITE(*,5599)'ERODE2',I,J,NX,NY,L0,L1,NU(NY,NX),DNUMN,DNUMX + 2,DLYR(3,L0,NY,NX),DLYR(3,L1,NY,NX),FX + ENDIF + ENDIF +C +C RESIDUE REMOVAL IF FIRE OR REMOVAL EVENT IS ENTERED IN DISTURBANCE FILE +C + IF(J.EQ.INT(ZNOON(NY,NX)).AND.(ITILL(I,NY,NX).EQ.21 + 2.OR.ITILL(I,NY,NX).EQ.22))THEN + IF(ITILL(I,NY,NX).EQ.22)THEN + IFLGQ=0 + NLL=-1 + DO 2945 L=0,NL(NY,NX) +C WRITE(*,9494)'FIRE',I,J,L,IFLGQ,NLL,THETW(L,NY,NX) +9494 FORMAT(A8,5I6,12E12.4) + IF(L.EQ.0.OR.L.GE.NU(NY,NX))THEN + IF(IFLGQ.EQ.1)THEN + GO TO 2946 + ELSEIF(THETW(L,NY,NX).GT.FVLWB.OR.CORGC(L,NY,NX).LE.FORGC + 2.OR.DPTH(L,NY,NX).GT.0.15)THEN + IFLGQ=1 + ELSE + NLL=L + ENDIF + ENDIF +2945 CONTINUE + ELSE + NLL=0 + ENDIF +2946 CONTINUE + DO 2950 L=0,NLL + IF(NLL.GE.0)THEN + IF(ITILL(I,NY,NX).EQ.22)THEN + DCORPC=AMIN1(0.999,DCORP(I,NY,NX))*(CORGC(L,NY,NX)-FORGC) + 2/(AMAX1(CORGC(L,NY,NX),0.5E+06)-FORGC) + ELSE + DCORPC=AMIN1(0.999,DCORP(I,NY,NX)) + ENDIF + VOLWOU=VOLWOU+DCORPC*VOLW(L,NY,NX) + HEATOU=HEATOU+DCORPC*4.19*TKS(L,NY,NX)*VOLW(L,NY,NX) + VOLW(L,NY,NX)=VOLW(L,NY,NX)-DCORPC*VOLW(L,NY,NX) +C WRITE(*,9696)'BURN',I,J,L,NLL,CORGC(L,NY,NX) +C 2,FORGC,DCORPC,DCORP(I,NY,NX),VOLW(L,NY,NX) +9696 FORMAT(A8,4I6,12E12.4) + OSGX=ORGC(L,NY,NX) + OC=0.0 + ON=0.0 + OP=0.0 + RC=0.0 + RN=0.0 + RP=0.0 + DO 2955 K=0,4 + DO 2955 M=1,4 + ONL(M,K)=0.0 + OPL(M,K)=0.0 +2955 CONTINUE + DO 2970 K=0,5 + IF(L.NE.0.OR.(K.NE.3.AND.K.NE.4))THEN +C +C REMOVE MICROBIAL BIOMASS +C + DO 2960 N=1,7 + DO 2960 M=1,3 + OCH=DCORPC*OMC(M,N,K,L,NY,NX) + ONH=DCORPC*OMN(M,N,K,L,NY,NX) + OPH=DCORPC*OMP(M,N,K,L,NY,NX) + ONX=EFIRE(1,ITILL(I,NY,NX))*ONH + OPX=EFIRE(2,ITILL(I,NY,NX))*OPH + IF(K.LE.2)THEN + ONL(4,K)=ONL(4,K)+ONH-ONX + OPL(4,K)=OPL(4,K)+OPH-OPX + ELSEIF(K.LE.4)THEN + ONL(1,K)=ONL(1,K)+ONH-ONX + OPL(1,K)=OPL(1,K)+OPH-OPX + ELSEIF(K.EQ.5)THEN + ONL(4,1)=ONL(4,1)+ONH-ONX + OPL(4,1)=OPL(4,1)+OPH-OPX + ENDIF + OMC(M,N,K,L,NY,NX)=OMC(M,N,K,L,NY,NX)-OCH + OMN(M,N,K,L,NY,NX)=OMN(M,N,K,L,NY,NX)-ONH + OMP(M,N,K,L,NY,NX)=OMP(M,N,K,L,NY,NX)-OPH + RC=RC+OMC(M,N,K,L,NY,NX) + RN=RN+OMN(M,N,K,L,NY,NX) + RP=RP+OMP(M,N,K,L,NY,NX) + TOMT(NY,NX)=TOMT(NY,NX)+OMC(M,N,K,L,NY,NX) + TONT(NY,NX)=TONT(NY,NX)+OMN(M,N,K,L,NY,NX) + TOPT(NY,NX)=TOPT(NY,NX)+OMP(M,N,K,L,NY,NX) + OMCL(L,NY,NX)=OMCL(L,NY,NX)+OMC(M,N,K,L,NY,NX) + OMNL(L,NY,NX)=OMNL(L,NY,NX)+OMN(M,N,K,L,NY,NX) + OC=OC+OCH + ON=ON+ONX + OP=OP+OPX +2960 CONTINUE + ENDIF +2970 CONTINUE +C +C REMOVE MICROBIAL RESIDUE +C + DO 2900 K=0,4 + IF(L.NE.0.OR.(K.NE.3.AND.K.NE.4))THEN + DO 2940 M=1,2 + OCH=DCORPC*ORC(M,K,L,NY,NX) + ONH=DCORPC*ORN(M,K,L,NY,NX) + OPH=DCORPC*ORP(M,K,L,NY,NX) + ONX=EFIRE(1,ITILL(I,NY,NX))*ONH + OPX=EFIRE(2,ITILL(I,NY,NX))*OPH + IF(K.LE.2)THEN + ONL(4,K)=ONL(4,K)+ONH-ONX + OPL(4,K)=OPL(4,K)+OPH-OPX + ELSE + ONL(1,K)=ONL(1,K)+ONH-ONX + OPL(1,K)=OPL(1,K)+OPH-OPX + ENDIF + ORC(M,K,L,NY,NX)=ORC(M,K,L,NY,NX)-OCH + ORN(M,K,L,NY,NX)=ORN(M,K,L,NY,NX)-ONH + ORP(M,K,L,NY,NX)=ORP(M,K,L,NY,NX)-OPH + RC=RC+ORC(M,K,L,NY,NX) + RN=RN+ORN(M,K,L,NY,NX) + RP=RP+ORP(M,K,L,NY,NX) + OC=OC+OCH + ON=ON+ONX + OP=OP+OPX +2940 CONTINUE +C +C REMOVE DOC, DON, DOP +C + OCH=DCORPC*OQC(K,L,NY,NX) + OCA=DCORPC*OQA(K,L,NY,NX) + ONH=DCORPC*OQN(K,L,NY,NX) + OPH=DCORPC*OQP(K,L,NY,NX) + ONX=EFIRE(1,ITILL(I,NY,NX))*ONH + OPX=EFIRE(2,ITILL(I,NY,NX))*OPH + IF(K.LE.2)THEN + ONL(4,K)=ONL(4,K)+ONH-ONX + OPL(4,K)=OPL(4,K)+OPH-OPX + ELSE + ONL(1,K)=ONL(1,K)+ONH-ONX + OPL(1,K)=OPL(1,K)+OPH-OPX + ENDIF + OQC(K,L,NY,NX)=OQC(K,L,NY,NX)-OCH + OQA(K,L,NY,NX)=OQA(K,L,NY,NX)-OCA + OQN(K,L,NY,NX)=OQN(K,L,NY,NX)-ONH + OQP(K,L,NY,NX)=OQP(K,L,NY,NX)-OPH + OC=OC+OCH+OCA + ON=ON+ONX + OP=OP+OPX + OCH=DCORPC*OQCH(K,L,NY,NX) + ONH=DCORPC*OQNH(K,L,NY,NX) + OPH=DCORPC*OQPH(K,L,NY,NX) + OAH=DCORPC*OQAH(K,L,NY,NX) + ONX=EFIRE(1,ITILL(I,NY,NX))*ONH + OPX=EFIRE(2,ITILL(I,NY,NX))*OPH + IF(K.LE.2)THEN + ONL(4,K)=ONL(4,K)+ONH-ONX + OPL(4,K)=OPL(4,K)+OPH-OPX + ELSE + ONL(1,K)=ONL(1,K)+ONH-ONX + OPL(1,K)=OPL(1,K)+OPH-OPX + ENDIF + OQCH(K,L,NY,NX)=OQCH(K,L,NY,NX)-OCH + OQNH(K,L,NY,NX)=OQNH(K,L,NY,NX)-ONH + OQPH(K,L,NY,NX)=OQPH(K,L,NY,NX)-OPH + OQAH(K,L,NY,NX)=OQAH(K,L,NY,NX)-OAH + OC=OC+OCH+OAH + ON=ON+ONX + OP=OP+OPX +C +C REMOVE ADSORBED OM +C + OCH=DCORPC*OHC(K,L,NY,NX) + ONH=DCORPC*OHN(K,L,NY,NX) + OPH=DCORPC*OHP(K,L,NY,NX) + OAH=DCORPC*OHA(K,L,NY,NX) + ONX=EFIRE(1,ITILL(I,NY,NX))*ONH + OPX=EFIRE(2,ITILL(I,NY,NX))*OPH + IF(K.LE.2)THEN + ONL(4,K)=ONL(4,K)+ONH-ONX + OPL(4,K)=OPL(4,K)+OPH-OPX + ELSE + ONL(1,K)=ONL(1,K)+ONH-ONX + OPL(1,K)=OPL(1,K)+OPH-OPX + ENDIF + OHC(K,L,NY,NX)=OHC(K,L,NY,NX)-OCH + OHN(K,L,NY,NX)=OHN(K,L,NY,NX)-ONH + OHP(K,L,NY,NX)=OHP(K,L,NY,NX)-OPH + OHA(K,L,NY,NX)=OHA(K,L,NY,NX)-OAH + RC=RC+OQC(K,L,NY,NX)+OQCH(K,L,NY,NX)+OHC(K,L,NY,NX) + 2+OQA(K,L,NY,NX)+OQAH(K,L,NY,NX)+OHA(K,L,NY,NX) + RN=RN+OQN(K,L,NY,NX)+OQNH(K,L,NY,NX)+OHN(K,L,NY,NX) + RP=RP+OQP(K,L,NY,NX)+OQPH(K,L,NY,NX)+OHP(K,L,NY,NX) + OC=OC+OCH + ON=ON+ONX + OP=OP+OPX +C +C REMOVE RESIDUE +C + DO 2930 M=1,4 + OCH=DCORPC*OSC(M,K,L,NY,NX) + OCA=DCORPC*OSA(M,K,L,NY,NX) + ONH=DCORPC*OSN(M,K,L,NY,NX) + OPH=DCORPC*OSP(M,K,L,NY,NX) + ONX=EFIRE(1,ITILL(I,NY,NX))*ONH + OPX=EFIRE(2,ITILL(I,NY,NX))*OPH + ONL(M,K)=ONL(M,K)+ONH-ONX + OPL(M,K)=OPL(M,K)+OPH-OPX + OSC(M,K,L,NY,NX)=OSC(M,K,L,NY,NX)-OCH + OSA(M,K,L,NY,NX)=OSA(M,K,L,NY,NX)-OCA + OSN(M,K,L,NY,NX)=OSN(M,K,L,NY,NX)-ONH + OSP(M,K,L,NY,NX)=OSP(M,K,L,NY,NX)-OPH + RC=RC+OSC(M,K,L,NY,NX) + RN=RN+OSN(M,K,L,NY,NX) + RP=RP+OSP(M,K,L,NY,NX) + OC=OC+OCH + ON=ON+ONX + OP=OP+OPX +2930 CONTINUE + ENDIF +2900 CONTINUE +C +C ADD UNBURNED N,P TO ORG N, ORG P +C + DO 2905 K=0,4 + DO 2905 M=1,4 + OSN(M,K,L,NY,NX)=OSN(M,K,L,NY,NX)+ONL(M,K) + OSP(M,K,L,NY,NX)=OSP(M,K,L,NY,NX)+OPL(M,K) + RN=RN+ONL(M,K) + RP=RP+OPL(M,K) +2905 CONTINUE +C +C REMOVE FERTILIZER IN RESIDUE +C + IF(ITILL(I,NY,NX).EQ.21)THEN + ON=ON+DCORPC*(ZNH4S(L,NY,NX)+ZNH3S(L,NY,NX) + 2+ZNO3S(L,NY,NX)+ZNO2S(L,NY,NX)) + OP=OP+DCORPC*H2PO4(L,NY,NX) + TIONOU=TIONOU+DCORPC*(ZNH3FA(L,NY,NX)+ZNO3FA(L,NY,NX) + 2+ZNHUFA(L,NY,NX)+2.0*(XN4(L,NY,NX)+PALPO(L,NY,NX)+PFEPO(L,NY,NX) + 2+ZNH4FA(L,NY,NX))+3.0*PCAPD(L,NY,NX)+7.0*PCAPM(L,NY,NX) + 3+9.0*PCAPH(L,NY,NX)) + ZNH4S(L,NY,NX)=(1.0-DCORPC)*ZNH4S(L,NY,NX) + ZNH3S(L,NY,NX)=(1.0-DCORPC)*ZNH3S(L,NY,NX) + ZNO3S(L,NY,NX)=(1.0-DCORPC)*ZNO3S(L,NY,NX) + ZNO2S(L,NY,NX)=(1.0-DCORPC)*ZNO2S(L,NY,NX) + H2PO4(L,NY,NX)=(1.0-DCORPC)*H2PO4(L,NY,NX) + XN4(L,NY,NX)=(1.0-DCORPC)*XN4(L,NY,NX) + PALPO(L,NY,NX)=(1.0-DCORPC)*PALPO(L,NY,NX) + PFEPO(L,NY,NX)=(1.0-DCORPC)*PFEPO(L,NY,NX) + PCAPD(L,NY,NX)=(1.0-DCORPC)*PCAPD(L,NY,NX) + PCAPH(L,NY,NX)=(1.0-DCORPC)*PCAPH(L,NY,NX) + PCAPM(L,NY,NX)=(1.0-DCORPC)*PCAPM(L,NY,NX) + ZNH4FA(L,NY,NX)=(1.0-DCORPC)*ZNH4FA(L,NY,NX) + ZNH3FA(L,NY,NX)=(1.0-DCORPC)*ZNH3FA(L,NY,NX) + ZNHUFA(L,NY,NX)=(1.0-DCORPC)*ZNHUFA(L,NY,NX) + ZNO3FA(L,NY,NX)=(1.0-DCORPC)*ZNO3FA(L,NY,NX) + ENDIF + ORGC(L,NY,NX)=RC + ORGN(L,NY,NX)=RN + HFLXD=4.19E-06*(OSGX-ORGC(L,NY,NX))*TKS(L,NY,NX) + HEATOU=HEATOU+HFLXD + IF(L.EQ.0)THEN + VHCPR(NY,NX)=2.496E-06*ORGC(0,NY,NX)+4.19*VOLW(0,NY,NX) + 2+1.9274*VOLI(0,NY,NX) + ELSE + VHCP(L,NY,NX)=VHCM(L,NY,NX)+4.19*(VOLW(L,NY,NX)+VOLWH(L,NY,NX)) + 2+1.9274*(VOLI(L,NY,NX)+VOLIH(L,NY,NX)) + ENDIF + IF(ITILL(I,NY,NX).EQ.21)THEN + TCOU=TCOU+OC + TZOU=TZOU+ON + TPOU=TPOU+OP + UDOCQ(NY,NX)=UDOCQ(NY,NX)+OC + UDONQ(NY,NX)=UDONQ(NY,NX)+ON + UDOPQ(NY,NX)=UDOPQ(NY,NX)+OP + TNBP(NY,NX)=TNBP(NY,NX)-OC + ELSEIF(ITILL(I,NY,NX).EQ.22)THEN + CO2GIN=CO2GIN-OC + OXYGIN=OXYGIN+2.667*OC + OXYGOU=OXYGOU+2.667*OC + TZOU=TZOU+ON + TPOU=TPOU+OP + UCO2F(NY,NX)=UCO2F(NY,NX)-(1.0-FCH4F)*OC + UCH4F(NY,NX)=UCH4F(NY,NX)-FCH4F*OC + UOXYF(NY,NX)=UOXYF(NY,NX)+(1.0-FCH4F)*2.667*OC + UNH3F(NY,NX)=UNH3F(NY,NX)-ON + UN2OF(NY,NX)=UN2OF(NY,NX)-0.0 + UPO4F(NY,NX)=UPO4F(NY,NX)-OP + TNBP(NY,NX)=TNBP(NY,NX)-OC + ENDIF + ENDIF +2950 CONTINUE +C IFLGS(NY,NX)=1 + ENDIF +C +C CHANGE EXTERNAL WATER TABLE DEPTH THROUGH DISTURBANCE +C + IF(J.EQ.INT(ZNOON(NY,NX)).AND.ITILL(I,NY,NX).EQ.23)THEN + DTBLI(NY,NX)=DCORP(I,NY,NX) + IF(BKDS(NU(NY,NX),NY,NX).GT.0.0)THEN + DTBLZ(NY,NX)=AMAX1(0.0,DTBLI(NY,NX)-(ALTZ(NY,NX)-ALT(NY,NX)) + 2*(1.0-DTBLG(NY,NX))) + ELSE + DTBLZ(NY,NX)=0.0 + ENDIF + DTBLX(NY,NX)=DTBLZ(NY,NX) + ENDIF + IF(J.EQ.INT(ZNOON(NY,NX)).AND.ITILL(I,NY,NX).EQ.24)THEN + DDRGI(NY,NX)=DCORP(I,NY,NX) + IF(BKDS(NU(NY,NX),NY,NX).GT.0.0)THEN + DDRG(NY,NX)=AMAX1(0.0,DDRGI(NY,NX)-(ALTZ(NY,NX)-ALT(NY,NX)) + 2*(1.0-DTBLG(NY,NX))) + ELSE + DDRG(NY,NX)=0.0 + ENDIF + DTBLX(NY,NX)=DDRG(NY,NX) + ENDIF +C +C MIX ALL SOIL STATE VARIABLES AND INCORPORATE ALL SURFACE +C RESIDUE STATE VARIABLES WITHIN THE TILLAGE ZONE TO THE EXTENT +C ASSOCIATED IN 'DAY' WITH EACH TILLAGE EVENT ENTERED IN THE +C TILLAGE FILE +C + IF(J.EQ.INT(ZNOON(NY,NX)).AND.XCORP(NY,NX).LT.1.0 + 2.AND.DCORP(I,NY,NX).GT.0.0)THEN +C +C EXTENT OF MIXING +C + CORP=1.0-XCORP(NY,NX) +C +C TEMPORARY ACCUMULATORS +C + TBKDS=0.0 + TFC=0.0 + TWP=0.0 + TSCNV=0.0 + TSCNH=0.0 + TSAND=0.0 + TSILT=0.0 + TCLAY=0.0 + TXCEC=0.0 + TXAEC=0.0 + TGKC4=0.0 + TGKCA=0.0 + TGKCM=0.0 + TGKCN=0.0 + TGKCK=0.0 + TVOLW=0.0 + TVOLI=0.0 + TVOLP=0.0 + TVOLA=0.0 + TENGY=0.0 + TVHCM=0.0 + TNFNIH=0.0 + TNH4FA=0.0 + TNH3FA=0.0 + TNHUFA=0.0 + TNO3FA=0.0 + TNH4FB=0.0 + TNH3FB=0.0 + TNHUFB=0.0 + TNO3FB=0.0 + TNH4S=0.0 + TNH4B=0.0 + TNH3S=0.0 + TNH3B=0.0 + TNO3S=0.0 + TNO3B=0.0 + TNO2S=0.0 + TNO2B=0.0 + TZAL=0.0 + TZFE=0.0 + TZHY=0.0 + TZCA=0.0 + TZMG=0.0 + TZNA=0.0 + TZKA=0.0 + TZOH=0.0 + TZSO4=0.0 + TZCL=0.0 + TZCO3=0.0 + TZHCO3=0.0 + TZALO1=0.0 + TZALO2=0.0 + TZALO3=0.0 + TZALO4=0.0 + TZALS=0.0 + TZFEO1=0.0 + TZFEO2=0.0 + TZFEO3=0.0 + TZFEO4=0.0 + TZFES=0.0 + TZCAO=0.0 + TZCAC=0.0 + TZCAH=0.0 + TZCAS=0.0 + TZMGO=0.0 + TZMGC=0.0 + TZMGH=0.0 + TZMGS=0.0 + TZNAC=0.0 + TZNAS=0.0 + TZKAS=0.0 + TH0PO4=0.0 + TH1PO4=0.0 + TH2PO4=0.0 + TH3PO4=0.0 + TZFE1P=0.0 + TZFE2P=0.0 + TZCA0P=0.0 + TZCA1P=0.0 + TZCA2P=0.0 + TZMG1P=0.0 + TH0POB=0.0 + TH1POB=0.0 + TH2POB=0.0 + TH3POB=0.0 + TFE1PB=0.0 + TFE2PB=0.0 + TCA0PB=0.0 + TCA1PB=0.0 + TCA2PB=0.0 + TMG1PB=0.0 + TXNH4=0.0 + TXNHB=0.0 + TXHY=0.0 + TXAL=0.0 + TXCA=0.0 + TXMG=0.0 + TXNA=0.0 + TXKA=0.0 + TXHC=0.0 + TXAL2=0.0 + TXOH0=0.0 + TXOH1=0.0 + TXOH2=0.0 + TXH1P=0.0 + TXH2P=0.0 + TXOH0B=0.0 + TXOH1B=0.0 + TXOH2B=0.0 + TXH1PB=0.0 + TXH2PB=0.0 + TPALOH=0.0 + TPFEOH=0.0 + TPCACO=0.0 + TPCASO=0.0 + TPALPO=0.0 + TPFEPO=0.0 + TPCAPD=0.0 + TPCAPH=0.0 + TPCAPM=0.0 + TPALPB=0.0 + TPFEPB=0.0 + TPCPDB=0.0 + TPCPHB=0.0 + TPCPMB=0.0 + TCO2G=0.0 + TCH4G=0.0 + TCOZS=0.0 + TCHFS=0.0 + TOXYG=0.0 + TOXYS=0.0 + TZ2GG=0.0 + TZ2GS=0.0 + TZ2OG=0.0 + TZ2OS=0.0 + 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 + TOMC(M,N,K)=0.0 + TOMN(M,N,K)=0.0 + TOMP(M,N,K)=0.0 +3990 CONTINUE + DO 3980 K=0,4 + DO 3975 M=1,2 + TORC(M,K)=0.0 + TORN(M,K)=0.0 + TORP(M,K)=0.0 +3975 CONTINUE + TOQC(K)=0.0 + TOQN(K)=0.0 + TOQP(K)=0.0 + TOQA(K)=0.0 + TOHC(K)=0.0 + TOHN(K)=0.0 + TOHP(K)=0.0 + TOHA(K)=0.0 + DO 3970 M=1,4 + TOSC(M,K)=0.0 + TOSA(M,K)=0.0 + TOSN(M,K)=0.0 + TOSP(M,K)=0.0 +3970 CONTINUE +3980 CONTINUE +C +C ACCUMULATE STATE VARIABLES IN SURFACE RESIDUE FOR ADDITION +C TO SOIL IN TILLAGE MIXING ZONE +C + RC=0.0 + RN=0.0 + RP=0.0 + DO 3950 K=0,5 + IF(K.NE.3.AND.K.NE.4)THEN + DO 3945 N=1,7 + DO 3945 M=1,3 + TOMGC(M,N,K)=OMC(M,N,K,0,NY,NX)*CORP + TOMGN(M,N,K)=OMN(M,N,K,0,NY,NX)*CORP + TOMGP(M,N,K)=OMP(M,N,K,0,NY,NX)*CORP + OMC(M,N,K,0,NY,NX)=OMC(M,N,K,0,NY,NX)*XCORP(NY,NX) + OMN(M,N,K,0,NY,NX)=OMN(M,N,K,0,NY,NX)*XCORP(NY,NX) + OMP(M,N,K,0,NY,NX)=OMP(M,N,K,0,NY,NX)*XCORP(NY,NX) + RC=RC+OMC(M,N,K,0,NY,NX) + RN=RN+OMN(M,N,K,0,NY,NX) + RP=RP+OMP(M,N,K,0,NY,NX) +3945 CONTINUE + ENDIF +3950 CONTINUE + DO 3940 K=0,2 + DO 3935 M=1,2 + TORXC(M,K)=ORC(M,K,0,NY,NX)*CORP + TORXN(M,K)=ORN(M,K,0,NY,NX)*CORP + TORXP(M,K)=ORP(M,K,0,NY,NX)*CORP + ORC(M,K,0,NY,NX)=ORC(M,K,0,NY,NX)*XCORP(NY,NX) + ORN(M,K,0,NY,NX)=ORN(M,K,0,NY,NX)*XCORP(NY,NX) + ORP(M,K,0,NY,NX)=ORP(M,K,0,NY,NX)*XCORP(NY,NX) + RC=RC+ORC(M,K,0,NY,NX) + RN=RN+ORN(M,K,0,NY,NX) + RP=RP+ORP(M,K,0,NY,NX) +3935 CONTINUE + TOQGC(K)=OQC(K,0,NY,NX)*CORP + TOQGN(K)=OQN(K,0,NY,NX)*CORP + TOQGP(K)=OQP(K,0,NY,NX)*CORP + TOQGA(K)=OQA(K,0,NY,NX)*CORP + TOQHC(K)=OQCH(K,0,NY,NX)*CORP + TOQHN(K)=OQNH(K,0,NY,NX)*CORP + TOQHP(K)=OQPH(K,0,NY,NX)*CORP + TOQHA(K)=OQAH(K,0,NY,NX)*CORP + TOHGC(K)=OHC(K,0,NY,NX)*CORP + TOHGN(K)=OHN(K,0,NY,NX)*CORP + TOHGP(K)=OHP(K,0,NY,NX)*CORP + TOHGA(K)=OHA(K,0,NY,NX)*CORP +C +C REDUCE SURFACE RESIDUE STATE VARIABLES FOR INCORPORATION +C + OQC(K,0,NY,NX)=OQC(K,0,NY,NX)*XCORP(NY,NX) + OQN(K,0,NY,NX)=OQN(K,0,NY,NX)*XCORP(NY,NX) + OQP(K,0,NY,NX)=OQP(K,0,NY,NX)*XCORP(NY,NX) + OQA(K,0,NY,NX)=OQA(K,0,NY,NX)*XCORP(NY,NX) + OQCH(K,0,NY,NX)=OQCH(K,0,NY,NX)*XCORP(NY,NX) + OQNH(K,0,NY,NX)=OQNH(K,0,NY,NX)*XCORP(NY,NX) + OQPH(K,0,NY,NX)=OQPH(K,0,NY,NX)*XCORP(NY,NX) + OQAH(K,0,NY,NX)=OQAH(K,0,NY,NX)*XCORP(NY,NX) + OHC(K,0,NY,NX)=OHC(K,0,NY,NX)*XCORP(NY,NX) + OHN(K,0,NY,NX)=OHN(K,0,NY,NX)*XCORP(NY,NX) + OHP(K,0,NY,NX)=OHP(K,0,NY,NX)*XCORP(NY,NX) + OHA(K,0,NY,NX)=OHA(K,0,NY,NX)*XCORP(NY,NX) + RC=RC+OQC(K,0,NY,NX)+OQCH(K,0,NY,NX)+OHC(K,0,NY,NX)+OQA(K,0,NY,NX) + 2+OQAH(K,0,NY,NX)+OHA(K,0,NY,NX) + RN=RN+OQN(K,0,NY,NX)+OQNH(K,0,NY,NX)+OHN(K,0,NY,NX) + RP=RP+OQP(K,0,NY,NX)+OQPH(K,0,NY,NX)+OHP(K,0,NY,NX) + DO 3965 M=1,4 + TOSGC(M,K)=OSC(M,K,0,NY,NX)*CORP + TOSGA(M,K)=OSA(M,K,0,NY,NX)*CORP + TOSGN(M,K)=OSN(M,K,0,NY,NX)*CORP + TOSGP(M,K)=OSP(M,K,0,NY,NX)*CORP + OSC(M,K,0,NY,NX)=OSC(M,K,0,NY,NX)*XCORP(NY,NX) + OSA(M,K,0,NY,NX)=OSA(M,K,0,NY,NX)*XCORP(NY,NX) + OSN(M,K,0,NY,NX)=OSN(M,K,0,NY,NX)*XCORP(NY,NX) + OSP(M,K,0,NY,NX)=OSP(M,K,0,NY,NX)*XCORP(NY,NX) + RC=RC+OSC(M,K,0,NY,NX) + RN=RN+OSN(M,K,0,NY,NX) + RP=RP+OSP(M,K,0,NY,NX) +3965 CONTINUE +3940 CONTINUE + TCO2GS=CO2S(0,NY,NX)*CORP + TCH4GS=CH4S(0,NY,NX)*CORP + TOXYGS=OXYS(0,NY,NX)*CORP + TZ2GSG=Z2GS(0,NY,NX)*CORP + TZ2OGS=Z2OS(0,NY,NX)*CORP + TH2GGS=H2GS(0,NY,NX)*CORP + TNH4GS=ZNH4S(0,NY,NX)*CORP + TNH3GS=ZNH3S(0,NY,NX)*CORP + TNO3GS=ZNO3S(0,NY,NX)*CORP + TNO2GS=ZNO2S(0,NY,NX)*CORP + TPO4GS=H2PO4(0,NY,NX)*CORP + TXN4G=XN4(0,NY,NX)*CORP + TXOH0G=XOH0(0,NY,NX)*CORP + TXOH1G=XOH1(0,NY,NX)*CORP + TXOH2G=XOH2(0,NY,NX)*CORP + TXH1PG=XH1P(0,NY,NX)*CORP + TXH2PG=XH2P(0,NY,NX)*CORP + TALPOG=PALPO(0,NY,NX)*CORP + TFEPOG=PFEPO(0,NY,NX)*CORP + TCAPDG=PCAPD(0,NY,NX)*CORP + TCAPHG=PCAPH(0,NY,NX)*CORP + TCAPMG=PCAPM(0,NY,NX)*CORP + TNH4FG=ZNH4FA(0,NY,NX)*CORP + TNH3FG=ZNH3FA(0,NY,NX)*CORP + TNHUFG=ZNHUFA(0,NY,NX)*CORP + TNO3FG=ZNO3FA(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) + HEATIN=HEATIN-HFLXD + HEATSO=HEATSO-HFLXD + TENGYR=(4.19*TVOLWR+1.9274*TVOLIR)*TKS(0,NY,NX) + ORGC(0,NY,NX)=RC + ORGN(0,NY,NX)=RN + ORGR(0,NY,NX)=RC + CO2S(0,NY,NX)=CO2S(0,NY,NX)*XCORP(NY,NX) + CH4S(0,NY,NX)=CH4S(0,NY,NX)*XCORP(NY,NX) + OXYS(0,NY,NX)=OXYS(0,NY,NX)*XCORP(NY,NX) + Z2GS(0,NY,NX)=Z2GS(0,NY,NX)*XCORP(NY,NX) + Z2OS(0,NY,NX)=Z2OS(0,NY,NX)*XCORP(NY,NX) + H2GS(0,NY,NX)=H2GS(0,NY,NX)*XCORP(NY,NX) + ZNH4S(0,NY,NX)=ZNH4S(0,NY,NX)*XCORP(NY,NX) + ZNH3S(0,NY,NX)=ZNH3S(0,NY,NX)*XCORP(NY,NX) + ZNO3S(0,NY,NX)=ZNO3S(0,NY,NX)*XCORP(NY,NX) + ZNO2S(0,NY,NX)=ZNO2S(0,NY,NX)*XCORP(NY,NX) + H2PO4(0,NY,NX)=H2PO4(0,NY,NX)*XCORP(NY,NX) + XN4(0,NY,NX)=XN4(0,NY,NX)*XCORP(NY,NX) + XOH0(0,NY,NX)=XOH0(0,NY,NX)*XCORP(NY,NX) + XOH1(0,NY,NX)=XOH1(0,NY,NX)*XCORP(NY,NX) + XOH2(0,NY,NX)=XOH2(0,NY,NX)*XCORP(NY,NX) + XH1P(0,NY,NX)=XH1P(0,NY,NX)*XCORP(NY,NX) + XH2P(0,NY,NX)=XH2P(0,NY,NX)*XCORP(NY,NX) + PALPO(0,NY,NX)=PALPO(0,NY,NX)*XCORP(NY,NX) + PFEPO(0,NY,NX)=PFEPO(0,NY,NX)*XCORP(NY,NX) + PCAPD(0,NY,NX)=PCAPD(0,NY,NX)*XCORP(NY,NX) + PCAPH(0,NY,NX)=PCAPH(0,NY,NX)*XCORP(NY,NX) + PCAPM(0,NY,NX)=PCAPM(0,NY,NX)*XCORP(NY,NX) + ZNH4FA(0,NY,NX)=ZNH4FA(0,NY,NX)*XCORP(NY,NX) + ZNH3FA(0,NY,NX)=ZNH3FA(0,NY,NX)*XCORP(NY,NX) + ZNHUFA(0,NY,NX)=ZNHUFA(0,NY,NX)*XCORP(NY,NX) + ZNO3FA(0,NY,NX)=ZNO3FA(0,NY,NX)*XCORP(NY,NX) + VOLW(0,NY,NX)=VOLW(0,NY,NX)*XCORP(NY,NX) + VOLI(0,NY,NX)=VOLI(0,NY,NX)*XCORP(NY,NX) + 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)) + ZNFNX0=AMAX1(ZNFNX0,ZNFN0(0,NY,NX)) + LL=NU(NY,NX) +C +C REDISTRIBUTE SOIL STATE VARIABLES DURING TILLAGE +C + DCORPZ=AMIN1(DCORP(I,NY,NX),CDPTH(NL(NY,NX),NY,NX)) + DCORPX=DCORPZ+(CDPTH(NU(NY,NX),NY,NX)-DLYR(3,NU(NY,NX),NY,NX)) +C +C ACCUMULATE SOIL STATE VARIABLES WITHIN TILLAGE MIXING ZONE +C + DO 1000 L=NU(NY,NX),NL(NY,NX) + IF(CDPTH(L,NY,NX)-DLYR(3,L,NY,NX).LT.DCORPX)THEN + TL=AMIN1(DLYR(3,L,NY,NX),DCORPX-(CDPTH(L,NY,NX) + 2-DLYR(3,L,NY,NX))) + FI=TL/DCORPZ + TI=TL/DLYR(3,L,NY,NX) + TBKDS=TBKDS+FI*BKDS(L,NY,NX) + TFC=TFC+FI*FC(L,NY,NX) + TWP=TWP+FI*WP(L,NY,NX) + TSCNV=TSCNV+FI*SCNV(L,NY,NX) + TSCNH=TSCNH+FI*SCNH(L,NY,NX) + TSAND=TSAND+TI*SAND(L,NY,NX) + TSILT=TSILT+TI*SILT(L,NY,NX) + TCLAY=TCLAY+TI*CLAY(L,NY,NX) + TXCEC=TXCEC+TI*XCEC(L,NY,NX) + TXAEC=TXAEC+TI*XAEC(L,NY,NX) + TGKC4=TGKC4+FI*GKC4(L,NY,NX) + TGKCA=TGKCA+FI*GKCA(L,NY,NX) + TGKCM=TGKCM+FI*GKCM(L,NY,NX) + TGKCN=TGKCN+FI*GKCN(L,NY,NX) + TGKCK=TGKCK+FI*GKCK(L,NY,NX) + TVOLW=TVOLW+TI*VOLW(L,NY,NX) + TVOLI=TVOLI+TI*VOLI(L,NY,NX) + TVOLP=TVOLP+TI*VOLP(L,NY,NX) + TVOLA=TVOLA+TI*VOLA(L,NY,NX) + TENGY=TENGY+TI*(4.19*(VOLW(L,NY,NX)+VOLWH(L,NY,NX)) + 2+1.9274*(VOLI(L,NY,NX)+VOLIH(L,NY,NX)))*TKS(L,NY,NX) + TNH4FA=TNH4FA+TI*ZNH4FA(L,NY,NX) + TNH3FA=TNH3FA+TI*ZNH3FA(L,NY,NX) + TNHUFA=TNHUFA+TI*ZNHUFA(L,NY,NX) + TNO3FA=TNO3FA+TI*ZNO3FA(L,NY,NX) + TNH4FB=TNH4FB+TI*ZNH4FB(L,NY,NX) + TNH3FB=TNH3FB+TI*ZNH3FB(L,NY,NX) + TNHUFB=TNHUFB+TI*ZNHUFB(L,NY,NX) + TNO3FB=TNO3FB+TI*ZNO3FB(L,NY,NX) + TNH4S=TNH4S+TI*ZNH4S(L,NY,NX) + TNH4B=TNH4B+TI*ZNH4B(L,NY,NX) + TNH3S=TNH3S+TI*ZNH3S(L,NY,NX) + TNH3B=TNH3B+TI*ZNH3B(L,NY,NX) + TNO3S=TNO3S+TI*ZNO3S(L,NY,NX) + TNO3B=TNO3B+TI*ZNO3B(L,NY,NX) + TNO2S=TNO2S+TI*ZNO2S(L,NY,NX) + TNO2B=TNO2B+TI*ZNO2B(L,NY,NX) + TZAL=TZAL+TI*ZAL(L,NY,NX) + TZFE=TZFE+TI*ZFE(L,NY,NX) + TZHY=TZHY+TI*ZHY(L,NY,NX) + TZCA=TZCA+TI*ZCA(L,NY,NX) + TZMG=TZMG+TI*ZMG(L,NY,NX) + TZNA=TZNA+TI*ZNA(L,NY,NX) + TZKA=TZKA+TI*ZKA(L,NY,NX) + TZOH=TZOH+TI*ZOH(L,NY,NX) + TZSO4=TZSO4+TI*ZSO4(L,NY,NX) + TZCL=TZCL+TI*ZCL(L,NY,NX) + TZCO3=TZCO3+TI*ZCO3(L,NY,NX) + TZHCO3=TZHCO3+TI*ZHCO3(L,NY,NX) + TZALO1=TZALO1+TI*ZALOH1(L,NY,NX) + TZALO2=TZALO2+TI*ZALOH2(L,NY,NX) + TZALO3=TZALO3+TI*ZALOH3(L,NY,NX) + TZALO4=TZALO4+TI*ZALOH4(L,NY,NX) + TZALS=TZALS+TI*ZALS(L,NY,NX) + TZFEO1=TZFEO1+TI*ZFEOH1(L,NY,NX) + TZFEO2=TZFEO2+TI*ZFEOH2(L,NY,NX) + TZFEO3=TZFEO3+TI*ZFEOH3(L,NY,NX) + TZFEO4=TZFEO4+TI*ZFEOH4(L,NY,NX) + TZFES=TZFES+TI*ZFES(L,NY,NX) + TZCAO=TZCAO+TI*ZCAO(L,NY,NX) + TZCAC=TZCAC+TI*ZCAC(L,NY,NX) + TZCAH=TZCAH+TI*ZCAH(L,NY,NX) + TZCAS=TZCAS+TI*ZCAS(L,NY,NX) + TZMGO=TZMGO+TI*ZMGO(L,NY,NX) + TZMGC=TZMGC+TI*ZMGC(L,NY,NX) + TZMGH=TZMGH+TI*ZMGH(L,NY,NX) + TZMGS=TZMGS+TI*ZMGS(L,NY,NX) + TZNAC=TZNAC+TI*ZNAC(L,NY,NX) + TZNAS=TZNAS+TI*ZNAS(L,NY,NX) + TZKAS=TZKAS+TI*ZKAS(L,NY,NX) + TH0PO4=TH0PO4+TI*H0PO4(L,NY,NX) + TH1PO4=TH1PO4+TI*H1PO4(L,NY,NX) + TH2PO4=TH2PO4+TI*H2PO4(L,NY,NX) + TH3PO4=TH3PO4+TI*H3PO4(L,NY,NX) + TZFE1P=TZFE1P+TI*ZFE1P(L,NY,NX) + TZFE2P=TZFE2P+TI*ZFE2P(L,NY,NX) + TZCA0P=TZCA0P+TI*ZCA0P(L,NY,NX) + TZCA1P=TZCA1P+TI*ZCA1P(L,NY,NX) + TZCA2P=TZCA2P+TI*ZCA2P(L,NY,NX) + TZMG1P=TZMG1P+TI*ZMG1P(L,NY,NX) + TH0POB=TH0POB+TI*H0POB(L,NY,NX) + TH1POB=TH1POB+TI*H1POB(L,NY,NX) + TH2POB=TH2POB+TI*H2POB(L,NY,NX) + TH3POB=TH3POB+TI*H3POB(L,NY,NX) + TFE1PB=TFE1PB+TI*ZFE1PB(L,NY,NX) + TFE2PB=TFE2PB+TI*ZFE2PB(L,NY,NX) + TCA0PB=TCA0PB+TI*ZCA0PB(L,NY,NX) + TCA1PB=TCA1PB+TI*ZCA1PB(L,NY,NX) + TCA2PB=TCA2PB+TI*ZCA2PB(L,NY,NX) + TMG1PB=TMG1PB+TI*ZMG1PB(L,NY,NX) + TXNH4=TXNH4+TI*XN4(L,NY,NX) + TXNHB=TXNHB+TI*XNB(L,NY,NX) + TXHY=TXHY+TI*XHY(L,NY,NX) + TXAL=TXAL+TI*XAL(L,NY,NX) + TXCA=TXCA+TI*XCA(L,NY,NX) + TXMG=TXMG+TI*XMG(L,NY,NX) + TXNA=TXNA+TI*XNA(L,NY,NX) + TXKA=TXKA+TI*XKA(L,NY,NX) + TXHC=TXHC+TI*XHC(L,NY,NX) + TXAL2=TXAL2+TI*XALO2(L,NY,NX) + TXOH0=TXOH0+TI*XOH0(L,NY,NX) + TXOH1=TXOH1+TI*XOH1(L,NY,NX) + TXOH2=TXOH2+TI*XOH2(L,NY,NX) + TXH1P=TXH1P+TI*XH1P(L,NY,NX) + TXH2P=TXH2P+TI*XH2P(L,NY,NX) + TXOH0B=TXOH0B+TI*XOH0B(L,NY,NX) + TXOH1B=TXOH1B+TI*XOH1B(L,NY,NX) + TXOH2B=TXOH2B+TI*XOH2B(L,NY,NX) + TXH1PB=TXH1PB+TI*XH1PB(L,NY,NX) + TXH2PB=TXH2PB+TI*XH2PB(L,NY,NX) + TPALOH=TPALOH+TI*PALOH(L,NY,NX) + TPFEOH=TPFEOH+TI*PFEOH(L,NY,NX) + TPCACO=TPCACO+TI*PCACO(L,NY,NX) + TPCASO=TPCASO+TI*PCASO(L,NY,NX) + TPALPO=TPALPO+TI*PALPO(L,NY,NX) + TPFEPO=TPFEPO+TI*PFEPO(L,NY,NX) + TPCAPD=TPCAPD+TI*PCAPD(L,NY,NX) + TPCAPH=TPCAPH+TI*PCAPH(L,NY,NX) + TPCAPM=TPCAPM+TI*PCAPM(L,NY,NX) + TPALPB=TPALPB+TI*PALPB(L,NY,NX) + TPFEPB=TPFEPB+TI*PFEPB(L,NY,NX) + TPCPDB=TPCPDB+TI*PCPDB(L,NY,NX) + TPCPHB=TPCPHB+TI*PCPHB(L,NY,NX) + TPCPMB=TPCPMB+TI*PCPMB(L,NY,NX) + TCO2G=TCO2G+TI*CO2G(L,NY,NX) + TCH4G=TCH4G+TI*CH4G(L,NY,NX) + TCOZS=TCOZS+TI*CO2S(L,NY,NX) + TCHFS=TCHFS+TI*CH4S(L,NY,NX) + TOXYG=TOXYG+TI*OXYG(L,NY,NX) + TOXYS=TOXYS+TI*OXYS(L,NY,NX) + TZ2GG=TZ2GG+TI*Z2GG(L,NY,NX) + TZ2GS=TZ2GS+TI*Z2GS(L,NY,NX) + TZ2OG=TZ2OG+TI*Z2OG(L,NY,NX) + TZ2OS=TZ2OS+TI*Z2OS(L,NY,NX) + TZNH3G=TZNH3G+TI*ZNH3G(L,NY,NX) + TH2GG=TH2GG+TI*H2GG(L,NY,NX) + TH2GS=TH2GS+TI*H2GS(L,NY,NX) + DO 4985 K=0,5 + DO 4985 N=1,7 + DO 4985 M=1,3 + TOMC(M,N,K)=TOMC(M,N,K)+TI*OMC(M,N,K,L,NY,NX) + TOMN(M,N,K)=TOMN(M,N,K)+TI*OMN(M,N,K,L,NY,NX) + TOMP(M,N,K)=TOMP(M,N,K)+TI*OMP(M,N,K,L,NY,NX) +4985 CONTINUE + DO 4980 K=0,4 + DO 4975 M=1,2 + TORC(M,K)=TORC(M,K)+TI*ORC(M,K,L,NY,NX) + TORN(M,K)=TORN(M,K)+TI*ORN(M,K,L,NY,NX) + TORP(M,K)=TORP(M,K)+TI*ORP(M,K,L,NY,NX) +4975 CONTINUE + TOQC(K)=TOQC(K)+TI*OQC(K,L,NY,NX) + TOQN(K)=TOQN(K)+TI*OQN(K,L,NY,NX) + TOQP(K)=TOQP(K)+TI*OQP(K,L,NY,NX) + TOQA(K)=TOQA(K)+TI*OQA(K,L,NY,NX) + TOHC(K)=TOHC(K)+TI*OHC(K,L,NY,NX) + TOHN(K)=TOHN(K)+TI*OHN(K,L,NY,NX) + TOHP(K)=TOHP(K)+TI*OHP(K,L,NY,NX) + TOHA(K)=TOHA(K)+TI*OHA(K,L,NY,NX) + DO 4970 M=1,4 + TOSC(M,K)=TOSC(M,K)+TI*OSC(M,K,L,NY,NX) + TOSA(M,K)=TOSA(M,K)+TI*OSA(M,K,L,NY,NX) + TOSN(M,K)=TOSN(M,K)+TI*OSN(M,K,L,NY,NX) + 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)) + ZNFNX0=AMAX1(ZNFNX0,ZNFN0(L,NY,NX)) + LL=L + ENDIF +1000 CONTINUE +C +C CHANGE SOIL STATE VARIABLES IN TILLAGE MIXING ZONE +C TO ACCOUNT FOR REDISTRIBUTION FROM MIXING +C + HEATSR=VHCPW(NY,NX)*TKW(NY,NX)+VHCPR(NY,NX)*TKS(0,NY,NX) + DO 2000 L=NU(NY,NX),LL + TL=AMIN1(DLYR(3,L,NY,NX),DCORPX-(CDPTH(L,NY,NX) + 2-DLYR(3,L,NY,NX))) + FI=TL/DCORPZ + TI=TL/DLYR(3,L,NY,NX) + TX=1.0-TI + BKDS(L,NY,NX)=TI*(BKDS(L,NY,NX)+CORP*(TBKDS-BKDS(L,NY,NX))) + 2+TX*BKDS(L,NY,NX) + FC(L,NY,NX)=TI*(FC(L,NY,NX)+CORP*(TFC-FC(L,NY,NX))) + 2+TX*FC(L,NY,NX) + WP(L,NY,NX)=TI*(WP(L,NY,NX)+CORP*(TWP-WP(L,NY,NX))) + 2+TX*WP(L,NY,NX) + SCNV(L,NY,NX)=TI*(SCNV(L,NY,NX)+CORP*(TSCNV-SCNV(L,NY,NX))) + 2+TX*SCNV(L,NY,NX) + SCNH(L,NY,NX)=TI*(SCNH(L,NY,NX)+CORP*(TSCNH-SCNH(L,NY,NX))) + 2+TX*SCNH(L,NY,NX) + SAND(L,NY,NX)=TI*SAND(L,NY,NX)+CORP*(FI*TSAND-TI*SAND(L,NY,NX)) + 2+TX*SAND(L,NY,NX) + SILT(L,NY,NX)=TI*SILT(L,NY,NX)+CORP*(FI*TSILT-TI*SILT(L,NY,NX)) + 2+TX*SILT(L,NY,NX) + CLAY(L,NY,NX)=TI*CLAY(L,NY,NX)+CORP*(FI*TCLAY-TI*CLAY(L,NY,NX)) + 2+TX*CLAY(L,NY,NX) + XCEC(L,NY,NX)=TI*XCEC(L,NY,NX)+CORP*(FI*TXCEC-TI*XCEC(L,NY,NX)) + 2+TX*XCEC(L,NY,NX) + XAEC(L,NY,NX)=TI*XAEC(L,NY,NX)+CORP*(FI*TXAEC-TI*XAEC(L,NY,NX)) + 2+TX*XAEC(L,NY,NX) + GKC4(L,NY,NX)=TI*(GKC4(L,NY,NX)+CORP*(TGKC4-GKC4(L,NY,NX))) + 2+TX*GKC4(L,NY,NX) + GKCA(L,NY,NX)=TI*(GKCA(L,NY,NX)+CORP*(TGKCA-GKCA(L,NY,NX))) + 2+TX*GKCA(L,NY,NX) + GKCM(L,NY,NX)=TI*(GKCM(L,NY,NX)+CORP*(TGKCM-GKCM(L,NY,NX))) + 2+TX*GKCM(L,NY,NX) + GKCN(L,NY,NX)=TI*(GKCN(L,NY,NX)+CORP*(TGKCN-GKCN(L,NY,NX))) + 2+TX*GKCN(L,NY,NX) + GKCK(L,NY,NX)=TI*(GKCK(L,NY,NX)+CORP*(TGKCK-GKCK(L,NY,NX))) + 2+TX*GKCK(L,NY,NX) + ENGYM=VHCM(L,NY,NX)*TKS(L,NY,NX) + ENGYW=(4.19*(VOLW(L,NY,NX)+VOLWH(L,NY,NX)) + 2+1.9274*(VOLI(L,NY,NX)+VOLIH(L,NY,NX)))*TKS(L,NY,NX) + VOLW(L,NY,NX)=TI*VOLW(L,NY,NX)+CORP*(FI*TVOLW-TI*VOLW(L,NY,NX)) + 2+TX*VOLW(L,NY,NX)+FI*TVOLWR + VOLI(L,NY,NX)=TI*VOLI(L,NY,NX)+CORP*(FI*TVOLI-TI*VOLI(L,NY,NX)) + 2+TX*VOLI(L,NY,NX)+FI*TVOLIR + VOLP(L,NY,NX)=TI*VOLP(L,NY,NX)+CORP*(FI*TVOLP-TI*VOLP(L,NY,NX)) + 2+TX*VOLP(L,NY,NX) + VOLA(L,NY,NX)=TI*VOLA(L,NY,NX)+CORP*(FI*TVOLA-TI*VOLA(L,NY,NX)) + 2+TX*VOLA(L,NY,NX) + VOLWX(L,NY,NX)=VOLW(L,NY,NX) +C VOLW(L,NY,NX)=VOLW(L,NY,NX)+CORP*VOLWH(L,NY,NX) +C VOLI(L,NY,NX)=VOLI(L,NY,NX)+CORP*VOLIH(L,NY,NX) +C VOLA(L,NY,NX)=VOLA(L,NY,NX)+CORP*VOLAH(L,NY,NX) +C VOLWH(L,NY,NX)=XCORP(NY,NX)*VOLWH(L,NY,NX) +C VOLIH(L,NY,NX)=XCORP(NY,NX)*VOLIH(L,NY,NX) +C VOLAH(L,NY,NX)=XCORP(NY,NX)*VOLAH(L,NY,NX) +C FHOL(L,NY,NX)=XCORP(NY,NX)*FHOL(L,NY,NX) + ENGYL=TI*ENGYW+CORP*(FI*TENGY-TI*ENGYW)+TX*ENGYW+FI*TENGYR + VHCP(L,NY,NX)=VHCM(L,NY,NX)+4.19*(VOLW(L,NY,NX)+VOLWH(L,NY,NX)) + 2+1.9274*(VOLI(L,NY,NX)+VOLIH(L,NY,NX)) + TKS(L,NY,NX)=(ENGYM+ENGYL)/VHCP(L,NY,NX) + TCS(L,NY,NX)=TKS(L,NY,NX)-273.15 + ZNH4FA(L,NY,NX)=TI*ZNH4FA(L,NY,NX)+CORP*(FI*TNH4FA + 2-TI*ZNH4FA(L,NY,NX))+TX*ZNH4FA(L,NY,NX) + ZNH3FA(L,NY,NX)=TI*ZNH3FA(L,NY,NX)+CORP*(FI*TNH3FA + 2-TI*ZNH3FA(L,NY,NX))+TX*ZNH3FA(L,NY,NX) + ZNHUFA(L,NY,NX)=TI*ZNHUFA(L,NY,NX)+CORP*(FI*TNHUFA + 2-TI*ZNHUFA(L,NY,NX))+TX*ZNHUFA(L,NY,NX) + ZNO3FA(L,NY,NX)=TI*ZNO3FA(L,NY,NX)+CORP*(FI*TNO3FA + 2-TI*ZNO3FA(L,NY,NX))+TX*ZNO3FA(L,NY,NX) + ZNH4FB(L,NY,NX)=TI*ZNH4FB(L,NY,NX)+CORP*(FI*TNH4FB + 2-TI*ZNH4FB(L,NY,NX))+TX*ZNH4FB(L,NY,NX) + ZNH3FB(L,NY,NX)=TI*ZNH3FB(L,NY,NX)+CORP*(FI*TNH3FB + 2-TI*ZNH3FB(L,NY,NX))+TX*ZNH3FB(L,NY,NX) + ZNHUFB(L,NY,NX)=TI*ZNHUFB(L,NY,NX)+CORP*(FI*TNHUFB + 2-TI*ZNHUFB(L,NY,NX))+TX*ZNHUFB(L,NY,NX) + ZNO3FB(L,NY,NX)=TI*ZNO3FB(L,NY,NX)+CORP*(FI*TNO3FB + 2-TI*ZNO3FB(L,NY,NX))+TX*ZNO3FB(L,NY,NX) + ZNH4S(L,NY,NX)=TI*ZNH4S(L,NY,NX)+CORP*(FI*TNH4S-TI*ZNH4S(L,NY,NX)) + 2+TX*ZNH4S(L,NY,NX)+CORP*ZNH4SH(L,NY,NX) + ZNH4B(L,NY,NX)=TI*ZNH4B(L,NY,NX)+CORP*(FI*TNH4B-TI*ZNH4B(L,NY,NX)) + 2+TX*ZNH4B(L,NY,NX)+CORP*ZNH4BH(L,NY,NX) + ZNH3S(L,NY,NX)=TI*ZNH3S(L,NY,NX)+CORP*(FI*TNH3S-TI*ZNH3S(L,NY,NX)) + 2+TX*ZNH3S(L,NY,NX)+CORP*ZNH3SH(L,NY,NX) + ZNH3B(L,NY,NX)=TI*ZNH3B(L,NY,NX)+CORP*(FI*TNH3B-TI*ZNH3B(L,NY,NX)) + 2+TX*ZNH3B(L,NY,NX)+CORP*ZNH3BH(L,NY,NX) + ZNO3S(L,NY,NX)=TI*ZNO3S(L,NY,NX)+CORP*(FI*TNO3S-TI*ZNO3S(L,NY,NX)) + 2+TX*ZNO3S(L,NY,NX)+CORP*ZNO3SH(L,NY,NX) + ZNO3B(L,NY,NX)=TI*ZNO3B(L,NY,NX)+CORP*(FI*TNO3B-TI*ZNO3B(L,NY,NX)) + 2+TX*ZNO3B(L,NY,NX)+CORP*ZNO3BH(L,NY,NX) + ZNO2S(L,NY,NX)=TI*ZNO2S(L,NY,NX)+CORP*(FI*TNO2S-TI*ZNO2S(L,NY,NX)) + 2+TX*ZNO2S(L,NY,NX)+CORP*ZNO2SH(L,NY,NX) + ZNO2B(L,NY,NX)=TI*ZNO2B(L,NY,NX)+CORP*(FI*TNO2B-TI*ZNO2B(L,NY,NX)) + 2+TX*ZNO2B(L,NY,NX)+CORP*ZNO2BH(L,NY,NX) + ZAL(L,NY,NX)=TI*ZAL(L,NY,NX)+CORP*(FI*TZAL-TI*ZAL(L,NY,NX)) + 2+TX*ZAL(L,NY,NX)+CORP*ZALH(L,NY,NX) + ZFE(L,NY,NX)=TI*ZFE(L,NY,NX)+CORP*(FI*TZFE-TI*ZFE(L,NY,NX)) + 2+TX*ZFE(L,NY,NX)+CORP*ZFEH(L,NY,NX) + ZHY(L,NY,NX)=TI*ZHY(L,NY,NX)+CORP*(FI*TZHY-TI*ZHY(L,NY,NX)) + 2+TX*ZHY(L,NY,NX)+CORP*ZHYH(L,NY,NX) + ZCA(L,NY,NX)=TI*ZCA(L,NY,NX)+CORP*(FI*TZCA-TI*ZCA(L,NY,NX)) + 2+TX*ZCA(L,NY,NX)+CORP*ZCCH(L,NY,NX) + ZMG(L,NY,NX)=TI*ZMG(L,NY,NX)+CORP*(FI*TZMG-TI*ZMG(L,NY,NX)) + 2+TX*ZMG(L,NY,NX)+CORP*ZMAH(L,NY,NX) + ZNA(L,NY,NX)=TI*ZNA(L,NY,NX)+CORP*(FI*TZNA-TI*ZNA(L,NY,NX)) + 2+TX*ZNA(L,NY,NX)+CORP*ZNAH(L,NY,NX) + ZKA(L,NY,NX)=TI*ZKA(L,NY,NX)+CORP*(FI*TZKA-TI*ZKA(L,NY,NX)) + 2+TX*ZKA(L,NY,NX)+CORP*ZKAH(L,NY,NX) + ZOH(L,NY,NX)=TI*ZOH(L,NY,NX)+CORP*(FI*TZOH-TI*ZOH(L,NY,NX)) + 2+TX*ZOH(L,NY,NX)+CORP*ZOHH(L,NY,NX) + ZSO4(L,NY,NX)=TI*ZSO4(L,NY,NX)+CORP*(FI*TZSO4-TI*ZSO4(L,NY,NX)) + 2+TX*ZSO4(L,NY,NX)+CORP*ZSO4H(L,NY,NX) + ZCL(L,NY,NX)=TI*ZCL(L,NY,NX)+CORP*(FI*TZCL-TI*ZCL(L,NY,NX)) + 2+TX*ZCL(L,NY,NX)+CORP*ZCLH(L,NY,NX) + ZCO3(L,NY,NX)=TI*ZCO3(L,NY,NX)+CORP*(FI*TZCO3-TI*ZCO3(L,NY,NX)) + 2+TX*ZCO3(L,NY,NX)+CORP*ZCO3H(L,NY,NX) + ZHCO3(L,NY,NX)=TI*ZHCO3(L,NY,NX)+CORP*(FI*TZHCO3 + 2-TI*ZHCO3(L,NY,NX))+TX*ZHCO3(L,NY,NX)+CORP*ZHCO3H(L,NY,NX) + ZALOH1(L,NY,NX)=TI*ZALOH1(L,NY,NX)+CORP*(FI*TZALO1 + 2-TI*ZALOH1(L,NY,NX))+TX*ZALOH1(L,NY,NX)+CORP*ZALO1H(L,NY,NX) + ZALOH2(L,NY,NX)=TI*ZALOH2(L,NY,NX)+CORP*(FI*TZALO2 + 2-TI*ZALOH2(L,NY,NX))+TX*ZALOH2(L,NY,NX)+CORP*ZALO2H(L,NY,NX) + ZALOH3(L,NY,NX)=TI*ZALOH3(L,NY,NX)+CORP*(FI*TZALO3 + 2-TI*ZALOH3(L,NY,NX))+TX*ZALOH3(L,NY,NX)+CORP*ZALO3H(L,NY,NX) + ZALOH4(L,NY,NX)=TI*ZALOH4(L,NY,NX)+CORP*(FI*TZALO4 + 2-TI*ZALOH4(L,NY,NX))+TX*ZALOH4(L,NY,NX)+CORP*ZALO4H(L,NY,NX) + ZALS(L,NY,NX)=TI*ZALS(L,NY,NX)+CORP*(FI*TZALS-TI*ZALS(L,NY,NX)) + 2+TX*ZALS(L,NY,NX)+CORP*ZALSH(L,NY,NX) + ZFEOH1(L,NY,NX)=TI*ZFEOH1(L,NY,NX)+CORP*(FI*TZFEO1 + 2-TI*ZFEOH1(L,NY,NX))+TX*ZFEOH1(L,NY,NX)+CORP*ZFEO1H(L,NY,NX) + ZFEOH2(L,NY,NX)=TI*ZFEOH2(L,NY,NX)+CORP*(FI*TZFEO2 + 2-TI*ZFEOH2(L,NY,NX))+TX*ZFEOH2(L,NY,NX)+CORP*ZFEO2H(L,NY,NX) + ZFEOH3(L,NY,NX)=TI*ZFEOH3(L,NY,NX)+CORP*(FI*TZFEO3 + 2-TI*ZFEOH3(L,NY,NX))+TX*ZFEOH3(L,NY,NX)+CORP*ZFEO3H(L,NY,NX) + ZFEOH4(L,NY,NX)=TI*ZFEOH4(L,NY,NX)+CORP*(FI*TZFEO4 + 2-TI*ZFEOH4(L,NY,NX))+TX*ZFEOH4(L,NY,NX)+CORP*ZFEO4H(L,NY,NX) + ZFES(L,NY,NX)=TI*ZFES(L,NY,NX)+CORP*(FI*TZFES-TI*ZFES(L,NY,NX)) + 2+TX*ZFES(L,NY,NX)+CORP*ZFESH(L,NY,NX) + ZCAO(L,NY,NX)=TI*ZCAO(L,NY,NX)+CORP*(FI*TZCAO-TI*ZCAO(L,NY,NX)) + 2+TX*ZCAO(L,NY,NX)+CORP*ZCAOH(L,NY,NX) + ZCAC(L,NY,NX)=TI*ZCAC(L,NY,NX)+CORP*(FI*TZCAC-TI*ZCAC(L,NY,NX)) + 2+TX*ZCAC(L,NY,NX)+CORP*ZCACH(L,NY,NX) + ZCAH(L,NY,NX)=TI*ZCAH(L,NY,NX)+CORP*(FI*TZCAH-TI*ZCAH(L,NY,NX)) + 2+TX*ZCAH(L,NY,NX)+CORP*ZCAHH(L,NY,NX) + ZCAS(L,NY,NX)=TI*ZCAS(L,NY,NX)+CORP*(FI*TZCAS-TI*ZCAS(L,NY,NX)) + 2+TX*ZCAS(L,NY,NX)+CORP*ZCASH(L,NY,NX) + ZMGO(L,NY,NX)=TI*ZMGO(L,NY,NX)+CORP*(FI*TZMGO-TI*ZMGO(L,NY,NX)) + 2+TX*ZMGO(L,NY,NX)+CORP*ZMGOH(L,NY,NX) + ZMGC(L,NY,NX)=TI*ZMGC(L,NY,NX)+CORP*(FI*TZMGC-TI*ZMGC(L,NY,NX)) + 2+TX*ZMGC(L,NY,NX)+CORP*ZMGCH(L,NY,NX) + ZMGH(L,NY,NX)=TI*ZMGH(L,NY,NX)+CORP*(FI*TZMGH-TI*ZMGH(L,NY,NX)) + 2+TX*ZMGH(L,NY,NX)+CORP*ZMGHH(L,NY,NX) + ZMGS(L,NY,NX)=TI*ZMGS(L,NY,NX)+CORP*(FI*TZMGS-TI*ZMGS(L,NY,NX)) + 2+TX*ZMGS(L,NY,NX)+CORP*ZMGSH(L,NY,NX) + ZNAC(L,NY,NX)=TI*ZNAC(L,NY,NX)+CORP*(FI*TZNAC-TI*ZNAC(L,NY,NX)) + 2+TX*ZNAC(L,NY,NX)+CORP*ZNACH(L,NY,NX) + ZNAS(L,NY,NX)=TI*ZNAS(L,NY,NX)+CORP*(FI*TZNAS-TI*ZNAS(L,NY,NX)) + 2+TX*ZNAS(L,NY,NX)+CORP*ZNASH(L,NY,NX) + ZKAS(L,NY,NX)=TI*ZKAS(L,NY,NX)+CORP*(FI*TZKAS-TI*ZKAS(L,NY,NX)) + 2+TX*ZKAS(L,NY,NX)+CORP*ZKASH(L,NY,NX) + H0PO4(L,NY,NX)=TI*H0PO4(L,NY,NX)+CORP*(FI*TH0PO4 + 2-TI*H0PO4(L,NY,NX))+TX*H0PO4(L,NY,NX)+CORP*H0PO4H(L,NY,NX) + H1PO4(L,NY,NX)=TI*H1PO4(L,NY,NX)+CORP*(FI*TH1PO4 + 2-TI*H1PO4(L,NY,NX))+TX*H1PO4(L,NY,NX)+CORP*H1PO4H(L,NY,NX) + H2PO4(L,NY,NX)=TI*H2PO4(L,NY,NX)+CORP*(FI*TH2PO4 + 2-TI*H2PO4(L,NY,NX))+TX*H2PO4(L,NY,NX)+CORP*H2PO4H(L,NY,NX) + H3PO4(L,NY,NX)=TI*H3PO4(L,NY,NX)+CORP*(FI*TH3PO4 + 2-TI*H3PO4(L,NY,NX))+TX*H3PO4(L,NY,NX)+CORP*H3PO4H(L,NY,NX) + ZFE1P(L,NY,NX)=TI*ZFE1P(L,NY,NX)+CORP*(FI*TZFE1P + 2-TI*ZFE1P(L,NY,NX))+TX*ZFE1P(L,NY,NX)+CORP*ZFE1PH(L,NY,NX) + ZFE2P(L,NY,NX)=TI*ZFE2P(L,NY,NX)+CORP*(FI*TZFE2P + 2-TI*ZFE2P(L,NY,NX))+TX*ZFE2P(L,NY,NX)+CORP*ZFE2PH(L,NY,NX) + ZCA0P(L,NY,NX)=TI*ZCA0P(L,NY,NX)+CORP*(FI*TZCA0P + 2-TI*ZCA0P(L,NY,NX))+TX*ZCA0P(L,NY,NX)+CORP*ZCA0PH(L,NY,NX) + ZCA1P(L,NY,NX)=TI*ZCA1P(L,NY,NX)+CORP*(FI*TZCA1P + 2-TI*ZCA1P(L,NY,NX))+TX*ZCA1P(L,NY,NX)+CORP*ZCA1PH(L,NY,NX) + ZCA2P(L,NY,NX)=TI*ZCA2P(L,NY,NX)+CORP*(FI*TZCA2P + 2-TI*ZCA2P(L,NY,NX))+TX*ZCA2P(L,NY,NX)+CORP*ZCA2PH(L,NY,NX) + ZMG1P(L,NY,NX)=TI*ZMG1P(L,NY,NX)+CORP*(FI*TZMG1P + 2-TI*ZMG1P(L,NY,NX))+TX*ZMG1P(L,NY,NX)+CORP*ZMG1PH(L,NY,NX) + H0POB(L,NY,NX)=TI*H0POB(L,NY,NX)+CORP*(FI*TH0POB + 2-TI*H0POB(L,NY,NX))+TX*H0POB(L,NY,NX)+CORP*H0POBH(L,NY,NX) + H1POB(L,NY,NX)=TI*H1POB(L,NY,NX)+CORP*(FI*TH1POB + 2-TI*H1POB(L,NY,NX))+TX*H1POB(L,NY,NX)+CORP*H1POBH(L,NY,NX) + H2POB(L,NY,NX)=TI*H2POB(L,NY,NX)+CORP*(FI*TH2POB + 2-TI*H2POB(L,NY,NX))+TX*H2POB(L,NY,NX)+CORP*H2POBH(L,NY,NX) + H3POB(L,NY,NX)=TI*H3POB(L,NY,NX)+CORP*(FI*TH3POB + 2-TI*H3POB(L,NY,NX))+TX*H3POB(L,NY,NX)+CORP*H3POBH(L,NY,NX) + ZFE1PB(L,NY,NX)=TI*ZFE1PB(L,NY,NX)+CORP*(FI*TFE1PB + 2-TI*ZFE1PB(L,NY,NX))+TX*ZFE1PB(L,NY,NX)+CORP*ZFE1BH(L,NY,NX) + ZFE2PB(L,NY,NX)=TI*ZFE2PB(L,NY,NX)+CORP*(FI*TFE2PB + 2-TI*ZFE2PB(L,NY,NX))+TX*ZFE2PB(L,NY,NX)+CORP*ZFE2BH(L,NY,NX) + ZCA0PB(L,NY,NX)=TI*ZCA0PB(L,NY,NX)+CORP*(FI*TCA0PB + 2-TI*ZCA0PB(L,NY,NX))+TX*ZCA0PB(L,NY,NX)+CORP*ZCA0BH(L,NY,NX) + ZCA1PB(L,NY,NX)=TI*ZCA1PB(L,NY,NX)+CORP*(FI*TCA1PB + 2-TI*ZCA1PB(L,NY,NX))+TX*ZCA1PB(L,NY,NX)+CORP*ZCA1BH(L,NY,NX) + ZCA2PB(L,NY,NX)=TI*ZCA2PB(L,NY,NX)+CORP*(FI*TCA2PB + 2-TI*ZCA2PB(L,NY,NX))+TX*ZCA2PB(L,NY,NX)+CORP*ZCA2BH(L,NY,NX) + ZMG1PB(L,NY,NX)=TI*ZMG1PB(L,NY,NX)+CORP*(FI*TMG1PB + 2-TI*ZMG1PB(L,NY,NX))+TX*ZMG1PB(L,NY,NX)+CORP*ZMG1BH(L,NY,NX) + XN4(L,NY,NX)=TI*XN4(L,NY,NX)+CORP*(FI*TXNH4-TI*XN4(L,NY,NX)) + 2+TX*XN4(L,NY,NX) + XNB(L,NY,NX)=TI*XNB(L,NY,NX)+CORP*(FI*TXNHB-TI*XNB(L,NY,NX)) + 2+TX*XNB(L,NY,NX) + XHY(L,NY,NX)=TI*XHY(L,NY,NX)+CORP*(FI*TXHY-TI*XHY(L,NY,NX)) + 2+TX*XHY(L,NY,NX) + XAL(L,NY,NX)=TI*XAL(L,NY,NX)+CORP*(FI*TXAL-TI*XAL(L,NY,NX)) + 2+TX*XAL(L,NY,NX) + XCA(L,NY,NX)=TI*XCA(L,NY,NX)+CORP*(FI*TXCA-TI*XCA(L,NY,NX)) + 2+TX*XCA(L,NY,NX) + XMG(L,NY,NX)=TI*XMG(L,NY,NX)+CORP*(FI*TXMG-TI*XMG(L,NY,NX)) + 2+TX*XMG(L,NY,NX) + XNA(L,NY,NX)=TI*XNA(L,NY,NX)+CORP*(FI*TXNA-TI*XNA(L,NY,NX)) + 2+TX*XNA(L,NY,NX) + XKA(L,NY,NX)=TI*XKA(L,NY,NX)+CORP*(FI*TXKA-TI*XKA(L,NY,NX)) + 2+TX*XKA(L,NY,NX) + XHC(L,NY,NX)=TI*XHC(L,NY,NX)+CORP*(FI*TXHC-TI*XHC(L,NY,NX)) + 2+TX*XHC(L,NY,NX) + XALO2(L,NY,NX)=TI*XALO2(L,NY,NX)+CORP*(FI*TXAL2-TI*XALO2(L,NY,NX)) + 2+TX*XALO2(L,NY,NX) + XOH0(L,NY,NX)=TI*XOH0(L,NY,NX)+CORP*(FI*TXOH0-TI*XOH0(L,NY,NX)) + 2+TX*XOH0(L,NY,NX) + XOH1(L,NY,NX)=TI*XOH1(L,NY,NX)+CORP*(FI*TXOH1-TI*XOH1(L,NY,NX)) + 2+TX*XOH1(L,NY,NX) + XOH2(L,NY,NX)=TI*XOH2(L,NY,NX)+CORP*(FI*TXOH2-TI*XOH2(L,NY,NX)) + 2+TX*XOH2(L,NY,NX) + XH1P(L,NY,NX)=TI*XH1P(L,NY,NX)+CORP*(FI*TXH1P-TI*XH1P(L,NY,NX)) + 2+TX*XH1P(L,NY,NX) + XH2P(L,NY,NX)=TI*XH2P(L,NY,NX)+CORP*(FI*TXH2P-TI*XH2P(L,NY,NX)) + 2+TX*XH2P(L,NY,NX) + XOH0B(L,NY,NX)=TI*XOH0B(L,NY,NX)+CORP*(FI*TXOH0B + 2-TI*XOH0B(L,NY,NX))+TX*XOH0B(L,NY,NX) + XOH1B(L,NY,NX)=TI*XOH1B(L,NY,NX)+CORP*(FI*TXOH1B + 2-TI*XOH1B(L,NY,NX))+TX*XOH1B(L,NY,NX) + XOH2B(L,NY,NX)=TI*XOH2B(L,NY,NX)+CORP*(FI*TXOH2B + 2-TI*XOH2B(L,NY,NX))+TX*XOH2B(L,NY,NX) + XH1PB(L,NY,NX)=TI*XH1PB(L,NY,NX)+CORP*(FI*TXH1PB + 2-TI*XH1PB(L,NY,NX))+TX*XH1PB(L,NY,NX) + XH2PB(L,NY,NX)=TI*XH2PB(L,NY,NX)+CORP*(FI*TXH2PB + 2-TI*XH2PB(L,NY,NX))+TX*XH2PB(L,NY,NX) + PALOH(L,NY,NX)=TI*PALOH(L,NY,NX)+CORP*(FI*TPALOH + 2-TI*PALOH(L,NY,NX))+TX*PALOH(L,NY,NX) + PFEOH(L,NY,NX)=TI*PFEOH(L,NY,NX)+CORP*(FI*TPFEOH + 2-TI*PFEOH(L,NY,NX))+TX*PFEOH(L,NY,NX) + PCACO(L,NY,NX)=TI*PCACO(L,NY,NX)+CORP*(FI*TPCACO + 2-TI*PCACO(L,NY,NX))+TX*PCACO(L,NY,NX) + PCASO(L,NY,NX)=TI*PCASO(L,NY,NX)+CORP*(FI*TPCASO + 2-TI*PCASO(L,NY,NX))+TX*PCASO(L,NY,NX) + PALPO(L,NY,NX)=TI*PALPO(L,NY,NX)+CORP*(FI*TPALPO + 2-TI*PALPO(L,NY,NX))+TX*PALPO(L,NY,NX) + PFEPO(L,NY,NX)=TI*PFEPO(L,NY,NX)+CORP*(FI*TPFEPO + 2-TI*PFEPO(L,NY,NX))+TX*PFEPO(L,NY,NX) + PCAPD(L,NY,NX)=TI*PCAPD(L,NY,NX)+CORP*(FI*TPCAPD + 2-TI*PCAPD(L,NY,NX))+TX*PCAPD(L,NY,NX) + PCAPH(L,NY,NX)=TI*PCAPH(L,NY,NX)+CORP*(FI*TPCAPH + 2-TI*PCAPH(L,NY,NX))+TX*PCAPH(L,NY,NX) + PCAPM(L,NY,NX)=TI*PCAPM(L,NY,NX)+CORP*(FI*TPCAPM + 2-TI*PCAPM(L,NY,NX))+TX*PCAPM(L,NY,NX) + PALPB(L,NY,NX)=TI*PALPB(L,NY,NX)+CORP*(FI*TPALPB + 2-TI*PALPB(L,NY,NX))+TX*PALPB(L,NY,NX) + PFEPB(L,NY,NX)=TI*PFEPB(L,NY,NX)+CORP*(FI*TPFEPB + 2-TI*PFEPB(L,NY,NX))+TX*PFEPB(L,NY,NX) + PCPDB(L,NY,NX)=TI*PCPDB(L,NY,NX)+CORP*(FI*TPCPDB + 2-TI*PCPDB(L,NY,NX))+TX*PCPDB(L,NY,NX) + PCPHB(L,NY,NX)=TI*PCPHB(L,NY,NX)+CORP*(FI*TPCPHB + 2-TI*PCPHB(L,NY,NX))+TX*PCPHB(L,NY,NX) + PCPMB(L,NY,NX)=TI*PCPMB(L,NY,NX)+CORP*(FI*TPCPMB + 2-TI*PCPMB(L,NY,NX))+TX*PCPMB(L,NY,NX) + CO2G(L,NY,NX)=TI*CO2G(L,NY,NX)+CORP*(FI*TCO2G-TI*CO2G(L,NY,NX)) + 2+TX*CO2G(L,NY,NX) + CH4G(L,NY,NX)=TI*CH4G(L,NY,NX)+CORP*(FI*TCH4G-TI*CH4G(L,NY,NX)) + 2+TX*CH4G(L,NY,NX) + CO2S(L,NY,NX)=TI*CO2S(L,NY,NX)+CORP*(FI*TCOZS-TI*CO2S(L,NY,NX)) + 2+TX*CO2S(L,NY,NX)+CORP*CO2SH(L,NY,NX) + CH4S(L,NY,NX)=TI*CH4S(L,NY,NX)+CORP*(FI*TCHFS-TI*CH4S(L,NY,NX)) + 2+TX*CH4S(L,NY,NX)+CORP*CH4SH(L,NY,NX) + OXYG(L,NY,NX)=TI*OXYG(L,NY,NX)+CORP*(FI*TOXYG-TI*OXYG(L,NY,NX)) + 2+TX*OXYG(L,NY,NX) + OXYS(L,NY,NX)=TI*OXYS(L,NY,NX)+CORP*(FI*TOXYS-TI*OXYS(L,NY,NX)) + 2+TX*OXYS(L,NY,NX)+CORP*OXYSH(L,NY,NX) + Z2GG(L,NY,NX)=TI*Z2GG(L,NY,NX)+CORP*(FI*TZ2GG-TI*Z2GG(L,NY,NX)) + 2+TX*Z2GG(L,NY,NX) + Z2GS(L,NY,NX)=TI*Z2GS(L,NY,NX)+CORP*(FI*TZ2GS-TI*Z2GS(L,NY,NX)) + 2+TX*Z2GS(L,NY,NX)+CORP*Z2GSH(L,NY,NX) + Z2OG(L,NY,NX)=TI*Z2OG(L,NY,NX)+CORP*(FI*TZ2OG-TI*Z2OG(L,NY,NX)) + 2+TX*Z2OG(L,NY,NX) + Z2OS(L,NY,NX)=TI*Z2OS(L,NY,NX)+CORP*(FI*TZ2OS-TI*Z2OS(L,NY,NX)) + 2+TX*Z2OS(L,NY,NX)+CORP*Z2OSH(L,NY,NX) + ZNH3G(L,NY,NX)=TI*ZNH3G(L,NY,NX)+CORP*(FI*TZNH3G + 2-TI*ZNH3G(L,NY,NX))+TX*ZNH3G(L,NY,NX) + H2GG(L,NY,NX)=TI*H2GG(L,NY,NX)+CORP*(FI*TH2GG-TI*H2GG(L,NY,NX)) + 2+TX*H2GG(L,NY,NX) + H2GS(L,NY,NX)=TI*H2GS(L,NY,NX)+CORP*(FI*TH2GS-TI*H2GS(L,NY,NX)) + 2+TX*H2GS(L,NY,NX)+CORP*H2GSH(L,NY,NX) + ZNH4SH(L,NY,NX)=XCORP(NY,NX)*ZNH4SH(L,NY,NX) + ZNH3SH(L,NY,NX)=XCORP(NY,NX)*ZNH3SH(L,NY,NX) + ZNO3SH(L,NY,NX)=XCORP(NY,NX)*ZNO3SH(L,NY,NX) + ZNO2SH(L,NY,NX)=XCORP(NY,NX)*ZNO2SH(L,NY,NX) + H2PO4H(L,NY,NX)=XCORP(NY,NX)*H2PO4H(L,NY,NX) + ZNH4BH(L,NY,NX)=XCORP(NY,NX)*ZNH4BH(L,NY,NX) + ZNH3BH(L,NY,NX)=XCORP(NY,NX)*ZNH3BH(L,NY,NX) + ZNO3BH(L,NY,NX)=XCORP(NY,NX)*ZNO3BH(L,NY,NX) + ZNO2BH(L,NY,NX)=XCORP(NY,NX)*ZNO2BH(L,NY,NX) + H2POBH(L,NY,NX)=XCORP(NY,NX)*H2POBH(L,NY,NX) + ZALH(L,NY,NX)=XCORP(NY,NX)*ZALH(L,NY,NX) + ZFEH(L,NY,NX)=XCORP(NY,NX)*ZFEH(L,NY,NX) + ZHYH(L,NY,NX)=XCORP(NY,NX)*ZHYH(L,NY,NX) + ZCCH(L,NY,NX)=XCORP(NY,NX)*ZCCH(L,NY,NX) + ZMAH(L,NY,NX)=XCORP(NY,NX)*ZMAH(L,NY,NX) + ZNAH(L,NY,NX)=XCORP(NY,NX)*ZNAH(L,NY,NX) + ZKAH(L,NY,NX)=XCORP(NY,NX)*ZKAH(L,NY,NX) + ZOHH(L,NY,NX)=XCORP(NY,NX)*ZOHH(L,NY,NX) + ZSO4H(L,NY,NX)=XCORP(NY,NX)*ZSO4H(L,NY,NX) + ZCLH(L,NY,NX)=XCORP(NY,NX)*ZCLH(L,NY,NX) + ZCO3H(L,NY,NX)=XCORP(NY,NX)*ZCO3H(L,NY,NX) + ZHCO3H(L,NY,NX)=XCORP(NY,NX)*ZHCO3H(L,NY,NX) + ZALO1H(L,NY,NX)=XCORP(NY,NX)*ZALO1H(L,NY,NX) + ZALO2H(L,NY,NX)=XCORP(NY,NX)*ZALO2H(L,NY,NX) + ZALO3H(L,NY,NX)=XCORP(NY,NX)*ZALO3H(L,NY,NX) + ZALO4H(L,NY,NX)=XCORP(NY,NX)*ZALO4H(L,NY,NX) + ZALSH(L,NY,NX)=XCORP(NY,NX)*ZALSH(L,NY,NX) + ZFEO1H(L,NY,NX)=XCORP(NY,NX)*ZFEO1H(L,NY,NX) + ZFEO2H(L,NY,NX)=XCORP(NY,NX)*ZFEO2H(L,NY,NX) + ZFEO3H(L,NY,NX)=XCORP(NY,NX)*ZFEO3H(L,NY,NX) + ZFEO4H(L,NY,NX)=XCORP(NY,NX)*ZFEO4H(L,NY,NX) + ZFESH(L,NY,NX)=XCORP(NY,NX)*ZFESH(L,NY,NX) + ZCAOH(L,NY,NX)=XCORP(NY,NX)*ZCAOH(L,NY,NX) + ZCACH(L,NY,NX)=XCORP(NY,NX)*ZCACH(L,NY,NX) + ZCAHH(L,NY,NX)=XCORP(NY,NX)*ZCAHH(L,NY,NX) + ZCASH(L,NY,NX)=XCORP(NY,NX)*ZCASH(L,NY,NX) + ZMGOH(L,NY,NX)=XCORP(NY,NX)*ZMGOH(L,NY,NX) + ZMGCH(L,NY,NX)=XCORP(NY,NX)*ZMGCH(L,NY,NX) + ZMGHH(L,NY,NX)=XCORP(NY,NX)*ZMGHH(L,NY,NX) + ZMGSH(L,NY,NX)=XCORP(NY,NX)*ZMGSH(L,NY,NX) + ZNACH(L,NY,NX)=XCORP(NY,NX)*ZNACH(L,NY,NX) + ZNASH(L,NY,NX)=XCORP(NY,NX)*ZNASH(L,NY,NX) + ZKASH(L,NY,NX)=XCORP(NY,NX)*ZKASH(L,NY,NX) + H0PO4H(L,NY,NX)=XCORP(NY,NX)*H0PO4H(L,NY,NX) + H1PO4H(L,NY,NX)=XCORP(NY,NX)*H1PO4H(L,NY,NX) + H3PO4H(L,NY,NX)=XCORP(NY,NX)*H3PO4H(L,NY,NX) + ZFE1PH(L,NY,NX)=XCORP(NY,NX)*ZFE1PH(L,NY,NX) + ZFE2PH(L,NY,NX)=XCORP(NY,NX)*ZFE2PH(L,NY,NX) + ZCA0PH(L,NY,NX)=XCORP(NY,NX)*ZCA0PH(L,NY,NX) + ZCA1PH(L,NY,NX)=XCORP(NY,NX)*ZCA1PH(L,NY,NX) + ZCA2PH(L,NY,NX)=XCORP(NY,NX)*ZCA2PH(L,NY,NX) + ZMG1PH(L,NY,NX)=XCORP(NY,NX)*ZMG1PH(L,NY,NX) + H0POBH(L,NY,NX)=XCORP(NY,NX)*H0POBH(L,NY,NX) + H1POBH(L,NY,NX)=XCORP(NY,NX)*H1POBH(L,NY,NX) + H3POBH(L,NY,NX)=XCORP(NY,NX)*H3POBH(L,NY,NX) + ZFE1BH(L,NY,NX)=XCORP(NY,NX)*ZFE1BH(L,NY,NX) + ZFE2BH(L,NY,NX)=XCORP(NY,NX)*ZFE2BH(L,NY,NX) + ZCA0BH(L,NY,NX)=XCORP(NY,NX)*ZCA0BH(L,NY,NX) + ZCA1BH(L,NY,NX)=XCORP(NY,NX)*ZCA1BH(L,NY,NX) + ZCA2BH(L,NY,NX)=XCORP(NY,NX)*ZCA2BH(L,NY,NX) + ZMG1BH(L,NY,NX)=XCORP(NY,NX)*ZMG1BH(L,NY,NX) + CO2SH(L,NY,NX)=XCORP(NY,NX)*CO2SH(L,NY,NX) + CH4SH(L,NY,NX)=XCORP(NY,NX)*CH4SH(L,NY,NX) + 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) + DO 5965 K=0,5 + DO 5965 N=1,7 + DO 5965 M=1,3 + OMC(M,N,K,L,NY,NX)=TI*OMC(M,N,K,L,NY,NX)+CORP*(FI*TOMC(M,N,K) + 2-TI*OMC(M,N,K,L,NY,NX))+TX*OMC(M,N,K,L,NY,NX) + OMN(M,N,K,L,NY,NX)=TI*OMN(M,N,K,L,NY,NX)+CORP*(FI*TOMN(M,N,K) + 2-TI*OMN(M,N,K,L,NY,NX))+TX*OMN(M,N,K,L,NY,NX) + OMP(M,N,K,L,NY,NX)=TI*OMP(M,N,K,L,NY,NX)+CORP*(FI*TOMP(M,N,K) + 2-TI*OMP(M,N,K,L,NY,NX))+TX*OMP(M,N,K,L,NY,NX) +5965 CONTINUE + DO 5980 K=0,4 + DO 5975 M=1,2 + ORC(M,K,L,NY,NX)=TI*ORC(M,K,L,NY,NX)+CORP*(FI*TORC(M,K) + 2-TI*ORC(M,K,L,NY,NX))+TX*ORC(M,K,L,NY,NX) + ORN(M,K,L,NY,NX)=TI*ORN(M,K,L,NY,NX)+CORP*(FI*TORN(M,K) + 2-TI*ORN(M,K,L,NY,NX))+TX*ORN(M,K,L,NY,NX) + ORP(M,K,L,NY,NX)=TI*ORP(M,K,L,NY,NX)+CORP*(FI*TORP(M,K) + 2-TI*ORP(M,K,L,NY,NX))+TX*ORP(M,K,L,NY,NX) +5975 CONTINUE + OQC(K,L,NY,NX)=TI*OQC(K,L,NY,NX)+CORP*(FI*TOQC(K) + 2-TI*OQC(K,L,NY,NX))+TX*OQC(K,L,NY,NX)+CORP*OQCH(K,L,NY,NX) + OQN(K,L,NY,NX)=TI*OQN(K,L,NY,NX)+CORP*(FI*TOQN(K) + 2-TI*OQN(K,L,NY,NX))+TX*OQN(K,L,NY,NX)+CORP*OQNH(K,L,NY,NX) + OQP(K,L,NY,NX)=TI*OQP(K,L,NY,NX)+CORP*(FI*TOQP(K) + 2-TI*OQP(K,L,NY,NX))+TX*OQP(K,L,NY,NX)+CORP*OQPH(K,L,NY,NX) + OQA(K,L,NY,NX)=TI*OQA(K,L,NY,NX)+CORP*(FI*TOQA(K) + 2-TI*OQA(K,L,NY,NX))+TX*OQA(K,L,NY,NX)+CORP*OQAH(K,L,NY,NX) + OQCH(K,L,NY,NX)=XCORP(NY,NX)*OQCH(K,L,NY,NX) + OQNH(K,L,NY,NX)=XCORP(NY,NX)*OQNH(K,L,NY,NX) + OQPH(K,L,NY,NX)=XCORP(NY,NX)*OQPH(K,L,NY,NX) + OQAH(K,L,NY,NX)=XCORP(NY,NX)*OQAH(K,L,NY,NX) + OHC(K,L,NY,NX)=TI*OHC(K,L,NY,NX)+CORP*(FI*TOHC(K) + 2-TI*OHC(K,L,NY,NX))+TX*OHC(K,L,NY,NX) + OHN(K,L,NY,NX)=TI*OHN(K,L,NY,NX)+CORP*(FI*TOHN(K) + 2-TI*OHN(K,L,NY,NX))+TX*OHN(K,L,NY,NX) + OHP(K,L,NY,NX)=TI*OHP(K,L,NY,NX)+CORP*(FI*TOHP(K) + 2-TI*OHP(K,L,NY,NX))+TX*OHP(K,L,NY,NX) + OHA(K,L,NY,NX)=TI*OHA(K,L,NY,NX)+CORP*(FI*TOHA(K) + 2-TI*OHA(K,L,NY,NX))+TX*OHA(K,L,NY,NX) + DO 5970 M=1,4 + OSC(M,K,L,NY,NX)=TI*OSC(M,K,L,NY,NX)+CORP*(FI*TOSC(M,K) + 2-TI*OSC(M,K,L,NY,NX))+TX*OSC(M,K,L,NY,NX) + OSA(M,K,L,NY,NX)=TI*OSA(M,K,L,NY,NX)+CORP*(FI*TOSA(M,K) + 2-TI*OSA(M,K,L,NY,NX))+TX*OSA(M,K,L,NY,NX) + OSN(M,K,L,NY,NX)=TI*OSN(M,K,L,NY,NX)+CORP*(FI*TOSN(M,K) + 2-TI*OSN(M,K,L,NY,NX))+TX*OSN(M,K,L,NY,NX) + OSP(M,K,L,NY,NX)=TI*OSP(M,K,L,NY,NX)+CORP*(FI*TOSP(M,K) + 2-TI*OSP(M,K,L,NY,NX))+TX*OSP(M,K,L,NY,NX) +5970 CONTINUE +5980 CONTINUE +C +C ADD STATE VARIABLES IN SURFACE RESIDUE INCORPORATED +C WITHIN TILLAGE MIXING ZONE +C + DO 5910 K=0,5 + IF(K.NE.3.AND.K.NE.4)THEN + DO 5915 N=1,7 + DO 5915 M=1,3 + OMC(M,N,K,L,NY,NX)=OMC(M,N,K,L,NY,NX)+FI*TOMGC(M,N,K) + OMN(M,N,K,L,NY,NX)=OMN(M,N,K,L,NY,NX)+FI*TOMGN(M,N,K) + OMP(M,N,K,L,NY,NX)=OMP(M,N,K,L,NY,NX)+FI*TOMGP(M,N,K) +5915 CONTINUE + ENDIF +5910 CONTINUE + DO 5920 K=0,2 + DO 5925 M=1,2 + ORC(M,K,L,NY,NX)=ORC(M,K,L,NY,NX)+FI*TORXC(M,K) + ORN(M,K,L,NY,NX)=ORN(M,K,L,NY,NX)+FI*TORXN(M,K) + ORP(M,K,L,NY,NX)=ORP(M,K,L,NY,NX)+FI*TORXP(M,K) +5925 CONTINUE + OQC(K,L,NY,NX)=OQC(K,L,NY,NX)+FI*TOQGC(K) + OQN(K,L,NY,NX)=OQN(K,L,NY,NX)+FI*TOQGN(K) + OQP(K,L,NY,NX)=OQP(K,L,NY,NX)+FI*TOQGP(K) + OQA(K,L,NY,NX)=OQA(K,L,NY,NX)+FI*TOQGA(K) + OQCH(K,L,NY,NX)=OQCH(K,L,NY,NX)+FI*TOQHC(K) + OQNH(K,L,NY,NX)=OQNH(K,L,NY,NX)+FI*TOQHN(K) + OQPH(K,L,NY,NX)=OQPH(K,L,NY,NX)+FI*TOQHP(K) + OQAH(K,L,NY,NX)=OQAH(K,L,NY,NX)+FI*TOQHA(K) + OHC(K,L,NY,NX)=OHC(K,L,NY,NX)+FI*TOHGC(K) + OHN(K,L,NY,NX)=OHN(K,L,NY,NX)+FI*TOHGN(K) + OHP(K,L,NY,NX)=OHP(K,L,NY,NX)+FI*TOHGP(K) + OHA(K,L,NY,NX)=OHA(K,L,NY,NX)+FI*TOHGA(K) + DO 5930 M=1,4 + OSC(M,K,L,NY,NX)=OSC(M,K,L,NY,NX)+FI*TOSGC(M,K) + OSA(M,K,L,NY,NX)=OSA(M,K,L,NY,NX)+FI*TOSGA(M,K) + OSN(M,K,L,NY,NX)=OSN(M,K,L,NY,NX)+FI*TOSGN(M,K) + OSP(M,K,L,NY,NX)=OSP(M,K,L,NY,NX)+FI*TOSGP(M,K) +5930 CONTINUE +5920 CONTINUE + OC=0.0 + ON=0.0 + OP=0.0 + RC=0.0 + DO 5985 K=0,5 + DO 5985 N=1,7 + DO 5985 M=1,3 + OC=OC+OMC(M,N,K,L,NY,NX) + ON=ON+OMN(M,N,K,L,NY,NX) + OP=OP+OMP(M,N,K,L,NY,NX) + IF(K.LE.2)THEN + RC=RC+OMC(M,N,K,L,NY,NX) + ENDIF +5985 CONTINUE + DO 6995 K=0,4 + DO 6985 M=1,2 + OC=OC+ORC(M,K,L,NY,NX) + ON=ON+ORN(M,K,L,NY,NX) + OP=OP+ORP(M,K,L,NY,NX) + IF(K.LE.2)THEN + RC=RC+ORC(M,K,L,NY,NX) + ENDIF +6985 CONTINUE + OC=OC+OQC(K,L,NY,NX)+OQCH(K,L,NY,NX)+OHC(K,L,NY,NX) + 2+OQA(K,L,NY,NX)+OQAH(K,L,NY,NX)+OHA(K,L,NY,NX) + ON=ON+OQN(K,L,NY,NX)+OQNH(K,L,NY,NX)+OHN(K,L,NY,NX) + OP=OP+OQP(K,L,NY,NX)+OQPH(K,L,NY,NX)+OHP(K,L,NY,NX) + IF(K.LE.2)THEN + RC=RC+OQC(K,L,NY,NX)+OQCH(K,L,NY,NX)+OHC(K,L,NY,NX) + 2+OQA(K,L,NY,NX)+OQAH(K,L,NY,NX)+OHA(K,L,NY,NX) + ENDIF + DO 6980 M=1,4 + OC=OC+OSC(M,K,L,NY,NX) + ON=ON+OSN(M,K,L,NY,NX) + OP=OP+OSP(M,K,L,NY,NX) + IF(K.LE.2)THEN + RC=RC+OSC(M,K,L,NY,NX) + ENDIF +6980 CONTINUE +6995 CONTINUE + ORGC(L,NY,NX)=OC + ORGN(L,NY,NX)=ON + ORGR(L,NY,NX)=RC + CO2S(L,NY,NX)=CO2S(L,NY,NX)+FI*TCO2GS + CH4S(L,NY,NX)=CH4S(L,NY,NX)+FI*TCH4GS + OXYS(L,NY,NX)=OXYS(L,NY,NX)+FI*TOXYGS + Z2GS(L,NY,NX)=Z2GS(L,NY,NX)+FI*TZ2GSG + Z2OS(L,NY,NX)=Z2OS(L,NY,NX)+FI*TZ2OGS + H2GS(L,NY,NX)=H2GS(L,NY,NX)+FI*TH2GGS + ZNH4S(L,NY,NX)=ZNH4S(L,NY,NX)+FI*TNH4GS + ZNH3S(L,NY,NX)=ZNH3S(L,NY,NX)+FI*TNH3GS + ZNO3S(L,NY,NX)=ZNO3S(L,NY,NX)+FI*TNO3GS + ZNO2S(L,NY,NX)=ZNO2S(L,NY,NX)+FI*TNO2GS + H2PO4(L,NY,NX)=H2PO4(L,NY,NX)+FI*TPO4GS + XN4(L,NY,NX)=XN4(L,NY,NX)+FI*TXN4G + XOH0(L,NY,NX)=XOH0(L,NY,NX)+FI*TXOH0G + XOH1(L,NY,NX)=XOH1(L,NY,NX)+FI*TXOH1G + XOH2(L,NY,NX)=XOH2(L,NY,NX)+FI*TXOH2G + XH1P(L,NY,NX)=XH1P(L,NY,NX)+FI*TXH1PG + XH2P(L,NY,NX)=XH2P(L,NY,NX)+FI*TXH2PG + PALPO(L,NY,NX)=PALPO(L,NY,NX)+FI*TALPOG + PFEPO(L,NY,NX)=PFEPO(L,NY,NX)+FI*TFEPOG + PCAPD(L,NY,NX)=PCAPD(L,NY,NX)+FI*TCAPDG + PCAPH(L,NY,NX)=PCAPH(L,NY,NX)+FI*TCAPHG + PCAPM(L,NY,NX)=PCAPM(L,NY,NX)+FI*TCAPMG + ZNH4FA(L,NY,NX)=ZNH4FA(L,NY,NX)+FI*TNH4FG + 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 + ZNFN0(L,NY,NX)=ZNFNX0 +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 + IFLGS(NY,NX)=1 + ENDIF +C +C CHECK MATERIAL BALANCES +C + IF(I.EQ.365.AND.J.EQ.24)THEN + WRITE(19,2221)'ORGC',I,J,IYRC,NX,NY + 2,(ORGC(L,NY,NX)/AREA(3,L,NY,NX),L=0,NL(NY,NX)) + WRITE(20,2221)'ORGN',I,J,IYRC,NX,NY + 2,(ORGN(L,NY,NX)/AREA(3,L,NY,NX),L=0,NL(NY,NX)) +2221 FORMAT(A8,5I4,21E12.4) + ENDIF +C IF(I.EQ.365.AND.J.EQ.24)THEN +C WRITE(20,2221)'OMCL',I,J,IYRC,NX,NY,(OMCL(L,NY,NX),L=0,NL(NY,NX)) +C WRITE(20,2221)'OMNL',I,J,IYRC,NX,NY,(OMNL(L,NY,NX),L=0,NL(NY,NX)) +C WRITE(20,2222)'TLC',I,J,IYRC,NX,NY,TLRSDC+TLORGC+TLCO2G-CO2GIN +C 2+TCOU-TORGF-XCSN,TLRSDC,TLORGC,TLCO2G,CO2GIN,TCOU,TORGF,XCSN +C 5,XCODFS(NY,NX),XCOFLG(3,NU(NY,NX),NY,NX),TCO2Z(NY,NX) +C 2,FLQGQ(NY,NX)*CCOR(NY,NX),FLQGI(NY,NX)*CCOQ(NY,NX),XCODFG(0,NY,NX) +C 3,XCODFR(NY,NX),XCHDFS(NY,NX),XCHFLG(3,NU(NY,NX),NY,NX) +C 2,FLQGQ(NY,NX)*CCHR(NY,NX),FLQGI(NY,NX)*CCHQ(NY,NX),XCHDFG(0,NY,NX) +C 3,XCHDFR(NY,NX),PRECU(NY,NX)*CCOQ(NY,NX),PRECU(NY,NX)*CCHQ(NY,NX) +C 6,TCOQRS(NY,NX),TCHQRS(NY,NX),XCOFLS(1,0,NY,NX+1) +C 7,XCOFLS(2,0,NY+1,NX) +C 3,UCOP(NY,NX),UDOCQ(NY,NX),UDICQ(NY,NX),UDOCD(NY,NX),UDICD(NY,NX) +C 2,(((CSNT(M,K,L,NY,NX),M=1,4),K=0,1),L=0,NJ(NY,NX)) +C 3,(TCO2P(L,NY,NX),L=1,NJ(NY,NX)),(TCO2S(L,NY,NX),L=1,NJ(NY,NX)) +C 4,CQ,ZCSNC(NY,NX) +C WRITE(20,2222)'TLW',I,J,IYRC,NX,NY,VOLWSO-CRAIN+CRUN+CEVAP+VOLWOU +C 2,VOLWSO,CRAIN,CRUN,CEVAP,VOLWOU,(TUPWTR(L,NY,NX),L=1,JZ) +C 3,TVOLWC(NY,NX),TVOLWP(NY,NX),VOLW(0,NY,NX),VOLI(0,NY,NX)*0.92 +C 4,TFLWC(NY,NX),TEVAPC(NY,NX),TEVAPG(NY,NX),TEVAPP(NY,NX) +C 5,VOLSS(NY,NX),VOLWS(NY,NX),VOLIS(NY,NX)*0.92,TQS(NY,NX) +C 6,TQW(NY,NX),TQI(NY,NX),TFLWS(NY,NX),TFLWW(NY,NX),TFLWI(NY,NX) +C 7,TVOLWC(NY,NX),TVOLWP(NY,NX) +C WRITE(19,2222)'TLH',I,J,IYRC,NX,NY,HEATSO-HEATIN+HEATOU +C 2,HEATSO,HEATIN,HEATOU,HTHAWR(NY,NX),HFLXD,4.19*TKA(NY,NX)*PRECA(NY,NX) +C 3+2.095*TKA(NY,NX)*PRECW(NY,NX),HEATH(NY,NX),HTHAWW(NY,NX) +C 4,THFLXC(NY,NX),(THTHAW(L,NY,NX),L=NU(NY,NX),NL(NY,NX)) +C 5,(VHCP(L,NY,NX)*TKS(L,NY,NX),L=NU(NY,NX),NL(NY,NX)) +C 5,4.19*TKA(NY,NX)*PRECU(NY,NX),TENGYC(NY,NX),ENGYR +C 6,VHCPW(NY,NX)*TKW(NY,NX),VHCPR(NY,NX)*TKS(0,NY,NX) +C WRITE(19,2222)'TLO',I,J,IYRC,NX,NY,OXYGSO-OXYGIN+OXYGOU,OXYGSO +C 2,OXYGIN,OXYGOU,XOXDFS(NY,NX),XOXFLG(3,NU(NY,NX),NY,NX) +C 3,XOXDFG(0,NY,NX),TOXYZ(NY,NX),FLQGQ(NY,NX)*COXR(NY,NX),FLQGI(NY,NX)*COXQ +C 2,PRECU(NY,NX)*COXQ,(RUPOXO(L,NY,NX),L=1,NJ(NY,NX)) +C 3,(TUPOXP(L,NY,NX),L=1,NJ(NY,NX)),(TOXFLA(L,NY,NX),L=1,NJ(NY,NX)) +C WRITE(20,2222)'TLN',I,J,IYRC,NX,NY,TLRSDN+TLORGN+TLN2G+TLNH4 +C 2+TLNO3-ZN2GIN-TZIN+TZOU-TORGN-XZSN,TLRSDN,TLORGN,TLN2G,TLNH4 +C 3,TLNO3,ZN2GIN,TZIN,TZOU,TORGN,XZSN,PRECQ(NY,NX),PRECR(NY,NX) +C 4,PRECW(NY,NX),PRECI(NY,NX),FLQGM(NY,NX),FLQRM(NY,NX) +C 4,(((ZSNT(M,K,L,NY,NX),M=1,4),K=0,1),L=0,JZ) +C 5,(TUPNH4(L,NY,NX),L=1,JZ) +C 6,(TUPNO3(L,NY,NX),L=1,JZ),(TNHFLA(L,NY,NX),L=1,JZ) +C 7,XN3DFS(NY,NX),XNBDFS(NY,NX) +C 8,XN3FLG(3,NU(NY,NX),NY,NX),TNH3Z(NY,NX),UN2GS(NY,NX) +C 9,(XN2GS(L,NY,NX),L=0,JZ) +C WRITE(*,2222)'TLI',I,J,IYRC,NX,NY,TION-TIONIN+TIONOU +C 2-TFERTN-TFERTP,TION,TIONIN,TIONOU,SG,TFERTN,TFERTP +C 3,PRECQ(NY,NX),XHGDFS(NY,NX),XHGFLG(3,NU(NY,NX),NY,NX),TH2GZ(NY,NX) +C 4,(XHGQRS(N,NY,NX),N=1,2),(RH2GO(L,NY,NX),L=1,JZ) +C 5,(THGFLA(L,NY,NX),L=1,JZ),H2GW(NY,NX),(H2GS(L,NY,NX),L=1,JZ) +C 6,(H2GG(L,NY,NX),L=1,JZ),(TLH2GP(L,NY,NX),L=1,JZ) +C WRITE(*,2223)'TLS',I,J,IYRC,NX,NY,NU(NY,NX),TSEDSO+TSEDOU +C 2,TSEDSO,TSEDOU,USEDOU(NY,NX),DLYR(3,NU(NY,NX),NY,NX) +C 3,BKVL(NU(NY,NX),NY,NX),SAND(NU(NY,NX),NY,NX),SILT(NU(NY,NX),NY,NX) +C 4,CLAY(NU(NY,NX),NY,NX),ORGC(NU(NY,NX),NY,NX) +2222 FORMAT(A8,5I6,240F20.6) +2223 FORMAT(A8,6I6,160F16.6) +C ENDIF +9990 CONTINUE +9995 CONTINUE + RETURN + END + diff --git a/f77src/routs.f b/f77src/routs.f index 173e9da..fce6f81 100755 --- a/f77src/routs.f +++ b/f77src/routs.f @@ -72,7 +72,7 @@ SUBROUTINE routs(NHW,NHE,NVN,NVS) 6,(TDCNO(NY,NX,N),N=1,12) READ(21,93)IDATE,IYR,IFLGT(NY,NX),NU(NY,NX),IFNHB(NY,NX) 2,IFNOB(NY,NX),IFPOB(NY,NX),IUTYP(NY,NX),ZT(NY,NX),TFLWC(NY,NX) - 3,XTILL(NY,NX),ZS(NY,NX),THRMC(NY,NX),THRMG(NY,NX),TCNET(NY,NX) + 3,ZS(NY,NX),THRMC(NY,NX),THRMG(NY,NX),TCNET(NY,NX) 4,TVOLWC(NY,NX),VOLSS(NY,NX),VOLWS(NY,NX),VOLIS(NY,NX),VOLS(NY,NX) 5,DPTHS(NY,NX),TCW(NY,NX),TKW(NY,NX),VHCPW(NY,NX),VHCPR(NY,NX) 6,VOLWG(NY,NX),URAIN(NY,NX),ARLFC(NY,NX),ARSTC(NY,NX),PPT(NY,NX) diff --git a/f77src/soil.f b/f77src/soil.f index bff7b21..d7364c2 100755 --- a/f77src/soil.f +++ b/f77src/soil.f @@ -12,6 +12,8 @@ SUBROUTINE soil(NA,ND,NT,NE,NAX,NDX,NTX,NEX 3,OUTS(10),OUTP(10),OUTFILS(10,JY,JX),OUTFILP(10,JP,JY,JX) CHARACTER*3 CHOICE(102,20) CHARACTER*8 CDATE + SAVE NF,NX,NTZ,NTZX + DATA NF,NX,NTZ,NTZX/0,0,0,0/ C C READ INPUT DATA FOR SITE, SOILS AND MANAGEMENT IN 'READS' C AND SET UP OUTPUT AND CHECKPOINT FILES IN 'FOUTS' @@ -223,11 +225,11 @@ SUBROUTINE soil(NA,ND,NT,NE,NAX,NDX,NTX,NEX C C WRITE OUTPUT FILES FOR EACH GRID CELL IN 'SPLIT' C -#ifdef _WIN_ +Cifdef _WIN_ CALL SPLIT(NT,NE,NAX,NDX,NTX,NEX,NHW,NHE,NVN,NVS) -#else - CALL SPLITC(NT,NE,NAX,NDX,NTX,NEX,NHW,NHE,NVN,NVS) -#endif +Celse +C CALL SPLITC(NT,NE,NAX,NDX,NTX,NEX,NHW,NHE,NVN,NVS) +Cendif C WRITE(*,333)'SPLIT' RETURN END diff --git a/f77src/solute.f b/f77src/solute.f index 4e652e9..0c4060b 100755 --- a/f77src/solute.f +++ b/f77src/solute.f @@ -1,4615 +1,4615 @@ - - SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) -C -C THIS SUBROUTINE CALCULATES ALL SOLUTE TRANSFORMATIONS -C FROM THERMODYNAMIC EQUILIBRIA -C - include "parameters.h" - include "blkc.h" - include "blk2a.h" - include "blk2b.h" - include "blk2c.h" - include "blk8a.h" - include "blk8b.h" - include "blk10.h" - include "blk11a.h" - include "blk11b.h" - include "blk13a.h" - include "blk13b.h" - include "blk13c.h" - include "blk15a.h" - include "blk15b.h" - include "blk18a.h" - include "blk18b.h" - include "blk19a.h" - include "blk19b.h" - include "blk19c.h" - include "blk19d.h" - include "blk21a.h" - include "blk21b.h" -C -C EQUILIBRIUM CONSTANTS -C - DIMENSION RNHUI(2) - PARAMETER (DPH2O=6.5E-09,SYALO=4.0E-21,SYFEO=4.0E-26 - 2,SPCAC=4.0E-03,SPCAS=1.4E+01,SPALP=3.5E-15,SPFEP=3.0E-20 - 3,SPCAM=7.0E+07,SPCAD=1.0E-01,SPCAH=6.4E-32,SXOH2=4.5E-05 - 4,SXOH1=1.1E-06,SYH2P=1.6E+04,SHH2P=SYH2P*DPH2O,SYH1P=1.6E+04 - 5,SHH1P=SYH1P*DPH2O,DPCO2=4.2E-04,DPHCO=5.6E-08 - 6,DPN4=5.7E-07,DPAL1=8.6E-07,DPAL2=1.8E-08,DPAL3=2.0E-04 - 7,DPAL4=8.0E-03,DPALS=0.16,DPFE1=7.1E-10,DPFE2=1.45E-08 - 8,DPFE3=1.15E-04,DPFE4=1.45E-03,DPFES=7.1E-02,DPCAO=12.5 - 9,DPCAC=4.2E-02,DPCAH=13.5,DPCAS=1.2,DPMGO=0.7,DPMGC=0.3 - 1,DPMGH=67.0,DPMGS=2.1,DPNAC=0.45,DPNAS=3.3E+02,DPKAS=5.0E+01 - 2,DPH1P=4.5E-10,DPH2P=6.3E-05,DPH3P=7.1,DPF1P=4.5E-02 - 3,DPF2P=3.7E-03,DPC0P=3.5E-04,DPC1P=1.82,DPC2P=40.0 - 4,DPM1P=1.23,DPCOH=1.0E-02,DPALO=6.3E+04) - PARAMETER (DPCO3=DPCO2*DPHCO,SHALO=SYALO/DPH2O**3 - 2,SYAL1=SYALO/DPAL1,SHAL1=SYAL1/DPH2O**2,SYAL2=SYAL1/DPAL2 - 3,SHAL2=SYAL2/DPH2O,SPAL3=SYAL2/DPAL3,SYAL4=SPAL3/DPAL4 - 4,SHAL4=SYAL4*DPH2O,SHFEO=SYFEO/DPH2O**3,SYFE1=SYFEO/DPFE1 - 5,SHFE1=SYFE1/DPH2O**2,SYFE2=SYFE1/DPFE2,SHFE2=SYFE2/DPH2O - 6,SPFE3=SYFE2/DPFE3,SYFE4=SPFE3/DPFE4,SHFE4=SYFE4*DPH2O - 7,SHCAC1=SPCAC/DPHCO,SYCAC1=SHCAC1*DPH2O,SHCAC2=SHCAC1/DPCO2 - 8,SYCAC2=SHCAC2*DPH2O**2,SHA0P1=SPALP/DPH1P,SYA0P1=SHA0P1*DPH2O - 9,SPA1P1=SYA0P1/DPAL1,SYA2P1=SPA1P1/DPAL2,SHA2P1=SYA2P1*DPH2O - 1,SYA3P1=SYA2P1/DPAL3,SHA3P1=SYA3P1*DPH2O**2,SYA4P1=SYA3P1/DPAL4 - 2,SHA4P1=SYA4P1*DPH2O**3,SHA0P2=SHA0P1/DPH2P - 3,SYA0P2=SHA0P2*DPH2O**2,SYA1P2=SYA0P2/DPAL1,SHA1P2=SYA1P2/DPH2O - 4,SPA2P2=SYA1P2/DPAL2,SYA3P2=SPA2P2/DPAL3,SHA3P2=SYA3P2*DPH2O - 5,SYA4P2=SYA3P2/DPAL4,SHA4P2=SYA4P2*DPH2O**2) - PARAMETER (SHF0P1=SPFEP/DPH1P,SYF0P1=SHF0P1*DPH2O - 2,SPF1P1=SYF0P1/DPFE1,SYF2P1=SPF1P1/DPFE2,SHF2P1=SYF2P1*DPH2O - 3,SYF3P1=SYF2P1/DPFE3,SHF3P1=SYF3P1*DPH2O**2,SYF4P1=SYF3P1/DPFE4 - 4,SHF4P1=SYF4P1*DPH2O**3,SHF0P2=SHF0P1/DPH2P,SYF0P2=SHF0P2*DPH2O**2 - 5,SYF1P2=SYF0P2/DPFE1,SHF1P2=SYF1P2/DPH2O,SPF2P2=SYF1P2/DPFE2 - 6,SYF3P2=SPF2P2/DPFE3,SHF3P2=SYF3P2*DPH2O,SYF4P2=SYF3P2/DPFE4 - 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=5,TPD=1.0E-03,TPDX=TPD/MRXN,TADA=3.3E-01 - 2,TADAX=TADA/MRXN,TADC=3.3E-01,TADCX=TADC/MRXN - 3,TSL=1.0,TSLX=TSL/MRXN) - PARAMETER (DUKM=1.0,DUKI=2.5,A0=1.0,AE=10.0,COOH=2.5E-02 - 2,CCAMX=100.0) - PARAMETER (SPNH4=1.0E-00,SPNH3=1.0E-00,SPNHU=5.0E-01 - 2,SPNO3=1.0E-00,SPPO4=5.0E-03) - DATA RNHUI/5.0E-03,5.0E-04/ -C -C DUKM FROM SOIL SCI 136:56 -C - NPI=INT(NPH/2) - DO 9995 NX=NHW,NHE - DO 9990 NY=NVN,NVS - DO 9985 L=NU(NY,NX),NL(NY,NX) - IF(THETW(L,NY,NX).GT.ZEROS(NY,NX))THEN -C -C WATER VOLUME IN NON-BAND AND BAND SOIL ZONES -C - VOLWNH=VOLWM(NPH,L,NY,NX)*VLNH4(L,NY,NX) - VOLWNB=VOLWM(NPH,L,NY,NX)*VLNHB(L,NY,NX) - VOLWNO=VOLWM(NPH,L,NY,NX)*VLNO3(L,NY,NX) - VOLWNZ=VOLWM(NPH,L,NY,NX)*VLNOB(L,NY,NX) - VOLWPO=VOLWM(NPH,L,NY,NX)*VLPO4(L,NY,NX) - VOLWPB=VOLWM(NPH,L,NY,NX)*VLPOB(L,NY,NX) -C -C UREA HYDROLYSIS IN BAND AND NON-BAND SOIL ZONES -C - IF(VOLQ(L,NY,NX).GT.ZEROS(NY,NX))THEN - COMA=AMIN1(0.1E+06,TOQCK(L,NY,NX)/VOLQ(L,NY,NX)) - ELSE - COMA=0.1E+06 - ENDIF - DUKD=DUKM*(1.0+COMA/DUKI) -C -C UREA HYDROLYSIS INHIBITION -C - IF(ZNHU0(L,NY,NX).GT.ZEROS(NY,NX) - 2.AND.ZNHUI(L,NY,NX).GT.ZEROS(NY,NX))THEN - ZNHUI(L,NY,NX)=ZNHUI(L,NY,NX) - 2-RNHUI(IUTYP(NY,NX))*ZNHUI(L,NY,NX) - 3*AMAX1(RNHUI(IUTYP(NY,NX)),1.0-ZNHUI(L,NY,NX)/ZNHU0(L,NY,NX)) - ELSE - ZNHUI(L,NY,NX)=0.0 - ENDIF -C -C UREA CONCENTRATION AND HYDROLYSIS IN NON-BAND -C - 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) - 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) - 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 4,RNHUI(IUTYP(NY,NX)) -8888 FORMAT(A8,4I4,40E12.4) -C ENDIF -C -C NH4, NH3, UREA, NO3 DISSOLUTION IN BAND AND NON-BAND -C SOIL ZONES FROM FIRST-ORDER FUNCTIONS OF REMAINING -C FERTILIZER (NOTE: SUPERPHOSPHATE AND ROCK PHOSPHATE -C ARE REPRESENTED AS MONOCALCIUM PHOSPHATE AND HYDROXYAPATITE -C MODELLED IN PHOSPHORUS REACTIONS BELOW) -C - RSN4AA=SPNH4*ZNH4FA(L,NY,NX)*VLNH4(L,NY,NX) - 2*THETW(L,NY,NX) - RSN3AA=SPNH3*ZNH3FA(L,NY,NX)*VLNH4(L,NY,NX) - RSNUAA=RSNUA*VLNH4(L,NY,NX)*THETW(L,NY,NX) - RSNOAA=SPNO3*ZNO3FA(L,NY,NX)*VLNO3(L,NY,NX) - 2*THETW(L,NY,NX) - RSN4BA=SPNH4*ZNH4FA(L,NY,NX)*VLNHB(L,NY,NX) - 2*THETW(L,NY,NX) - RSN3BA=SPNH3*ZNH3FA(L,NY,NX)*VLNHB(L,NY,NX) - RSNUBA=RSNUA*VLNHB(L,NY,NX)*THETW(L,NY,NX) - RSNOBA=SPNO3*ZNO3FA(L,NY,NX)*VLNOB(L,NY,NX) - 2*THETW(L,NY,NX) - RSN4BB=SPNH4*ZNH4FB(L,NY,NX)*THETW(L,NY,NX) - RSN3BB=SPNH3*ZNH3FB(L,NY,NX) - RSNUBB=RSNUB*VLNHB(L,NY,NX)*THETW(L,NY,NX) - RSNOBB=SPNO3*ZNO3FB(L,NY,NX)*THETW(L,NY,NX) -C -C SOLUBLE AND EXCHANGEABLE NH4 CONCENTRATIONS -C IN NON-BAND AND BAND SOIL ZONES -C - IF(VOLWNH.GT.ZEROS(NY,NX))THEN - VOLWNX=14.0*VOLWNH - RN4X=(-TUPNH4(L,NY,NX)+XNH4S(L,NY,NX)+14.0*RSN4AA)/VOLWNX - RN3X=(-TUPN3S(L,NY,NX)+14.0*RSNUAA)/VOLWNX - CN41=AMAX1(0.0,ZNH4S(L,NY,NX)/VOLWNX+RN4X) - CN31=AMAX1(0.0,ZNH3S(L,NY,NX)/VOLWNX+RN3X) - XN41=AMAX1(0.0,XN4(L,NY,NX)/VOLWNH) - ELSE - RN4X=0.0 - RN3X=0.0 - CN41=0.0 - CN31=0.0 - XN41=0.0 - ENDIF - IF(VOLWNB.GT.ZEROS(NY,NX))THEN - VOLWNX=14.0*VOLWNB - RNBX=(-TUPNHB(L,NY,NX)+XNH4B(L,NY,NX)+14.0*(RSN4BA+RSN4BB)) - 2/VOLWNX - R3BX=(-TUPN3B(L,NY,NX)+14.0*(RSNUBA+RSNUBB)) - 2/VOLWNX - CN4B=AMAX1(0.0,ZNH4B(L,NY,NX)/VOLWNX+RNBX) - CN3B=AMAX1(0.0,ZNH3B(L,NY,NX)/VOLWNX+R3BX) - XN4B=AMAX1(0.0,XNB(L,NY,NX)/VOLWNB) - ELSE - RNBX=0.0 - R3BX=0.0 - CN4B=0.0 - CN3B=0.0 - XN4B=0.0 - ENDIF -C WRITE(*,4141)'RN4X',I,J,NX,NY,L,RN4X,RN3X,RNBX,R3BX -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 -4141 FORMAT(A8,5I4,30E12.4) -C -C SOLUBLE, EXCHANGEABLE AND PRECIPITATED PO4 CONCENTRATIONS IN -C NON-BAND AND BAND SOIL ZONES -C - IF(VOLWPO.GT.ZEROS(NY,NX))THEN - VOLWPX=31.0*VOLWPO - RH2PX=(XH2PS(L,NY,NX)-TUPH2P(L,NY,NX))/VOLWPX - CH2P1=AMAX1(0.0,H2PO4(L,NY,NX)/VOLWPX+RH2PX) - XOH01=AMAX1(0.0,XOH0(L,NY,NX))/VOLWPO - XOH11=AMAX1(0.0,XOH1(L,NY,NX))/VOLWPO - XOH21=AMAX1(0.0,XOH2(L,NY,NX))/VOLWPO - XH1P1=AMAX1(0.0,XH1P(L,NY,NX))/VOLWPO - XH2P1=AMAX1(0.0,XH2P(L,NY,NX))/VOLWPO - PCAPM1=AMAX1(0.0,PCAPM(L,NY,NX))/VOLWPO - PCAPD1=AMAX1(0.0,PCAPD(L,NY,NX))/VOLWPO - PCAPH1=AMAX1(0.0,PCAPH(L,NY,NX))/VOLWPO - PALPO1=AMAX1(0.0,PALPO(L,NY,NX))/VOLWPO - PFEPO1=AMAX1(0.0,PFEPO(L,NY,NX))/VOLWPO -C WRITE(*,8642)'CH2P1',I,J,L,CH2P1,H2PO4(L,NY,NX) -C 2,VOLWPX,RH2PX,XH2PS(L,NY,NX),TUPH2P(L,NY,NX) -8642 FORMAT(A8,3I4,20E12.4) - ELSE - RH2PX=0.0 - CH2P1=0.0 - XOH01=0.0 - XOH11=0.0 - XOH21=0.0 - XH1P1=0.0 - XH2P1=0.0 - PALPO1=0.0 - PFEPO1=0.0 - PCAPM1=0.0 - PCAPD1=0.0 - PCAPH1=0.0 - ENDIF - IF(VOLWPB.GT.ZEROS(NY,NX))THEN - VOLWPX=31.0*VOLWPB - RH2BX=(XH2BS(L,NY,NX)-TUPH2B(L,NY,NX))/VOLWPX - CH2B1=AMAX1(0.0,H2POB(L,NY,NX)/VOLWPX+RH2BX) - XH01B=AMAX1(0.0,XOH0B(L,NY,NX))/VOLWPB - XH11B=AMAX1(0.0,XOH1B(L,NY,NX))/VOLWPB - XH21B=AMAX1(0.0,XOH2B(L,NY,NX))/VOLWPB - X1P1B=AMAX1(0.0,XH1PB(L,NY,NX))/VOLWPB - X2P1B=AMAX1(0.0,XH2PB(L,NY,NX))/VOLWPB - PALPOB=AMAX1(0.0,PALPB(L,NY,NX))/VOLWPB - PFEPOB=AMAX1(0.0,PFEPB(L,NY,NX))/VOLWPB - PCAPMB=AMAX1(0.0,PCPMB(L,NY,NX))/VOLWPB - PCAPDB=AMAX1(0.0,PCPDB(L,NY,NX))/VOLWPB - PCAPHB=AMAX1(0.0,PCPHB(L,NY,NX))/VOLWPB - ELSE - RH2BX=0.0 - CH2B1=0.0 - XH01B=0.0 - XH11B=0.0 - XH21B=0.0 - X1P1B=0.0 - X2P1B=0.0 - PALPOB=0.0 - PFEPOB=0.0 - PCAPMB=0.0 - PCAPDB=0.0 - PCAPHB=0.0 - ENDIF -C -C IF SALT OPTION SELECTED IN SITE FILE -C THEN SOLVE FULL SET OF EQUILIBRIA REACTIONS -C - IF(ISALT(NY,NX).NE.0)THEN -C -C SOLUBLE NO3 CONCENTRATIONS -C IN NON-BAND AND BAND SOIL ZONES -C - IF(VOLWNO.GT.ZEROS(NY,NX))THEN - CNO1=AMAX1(0.0,ZNO3S(L,NY,NX)/(14.0*VOLWNO)) - ELSE - CNO1=0.0 - ENDIF - IF(VOLWNZ.GT.ZEROS(NY,NX))THEN - CNOB=AMAX1(0.0,ZNO3B(L,NY,NX)/(14.0*VOLWNZ)) - ELSE - CNOB=0.0 - ENDIF - RHY1=XZHYS(L,NY,NX)/VOLWM(NPH,L,NY,NX) - CHY1=AMAX1(0.0,ZHY(L,NY,NX))/VOLWM(NPH,L,NY,NX)+RHY1 -C -C SOLUTE ION AND ION PAIR CONCENTRATIONS -C - CCEC=AMAX1(ZERO,XCEC(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - COH1=AMAX1(0.0,ZOH(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CAL1=AMAX1(0.0,ZAL(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CFE1=AMAX1(0.0,ZFE(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CCA1=AMAX1(0.0,ZCA(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CMG1=AMAX1(0.0,ZMG(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CNA1=AMAX1(0.0,ZNA(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CKA1=AMAX1(0.0,ZKA(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CSO41=AMAX1(0.0,ZSO4(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CCL1=AMAX1(0.0,ZCL(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CCO31=AMAX1(0.0,ZCO3(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CHCO31=AMAX1(0.0,ZHCO3(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CCO21=AMAX1(0.0,CO2S(L,NY,NX)/(12.0*VOLWM(NPH,L,NY,NX))) - CALO1=AMAX1(0.0,ZALOH1(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CALO2=AMAX1(0.0,ZALOH2(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CALO3=AMAX1(0.0,ZALOH3(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CALO4=AMAX1(0.0,ZALOH4(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CALS1=AMAX1(0.0,ZALS(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CFEO1=AMAX1(0.0,ZFEOH1(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CFEO2=AMAX1(0.0,ZFEOH2(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CFEO3=AMAX1(0.0,ZFEOH3(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CFEO4=AMAX1(0.0,ZFEOH4(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CFES1=AMAX1(0.0,ZFES(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CCAO1=AMAX1(0.0,ZCAO(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CCAC1=AMAX1(0.0,ZCAC(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CCAH1=AMAX1(0.0,ZCAH(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CCAS1=AMAX1(0.0,ZCAS(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CMGO1=AMAX1(0.0,ZMGO(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CMGC1=AMAX1(0.0,ZMGC(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CMGH1=AMAX1(0.0,ZMGH(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CMGS1=AMAX1(0.0,ZMGS(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CNAC1=AMAX1(0.0,ZNAC(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CNAS1=AMAX1(0.0,ZNAS(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CKAS1=AMAX1(0.0,ZKAS(L,NY,NX)/VOLWM(NPH,L,NY,NX)) -C -C PO4 CONCENTRATIONS IN NON-BAND AND BAND SOIL ZONES -C - IF(VOLWPO.GT.ZEROS(NY,NX))THEN - CH0P1=AMAX1(0.0,H0PO4(L,NY,NX)/VOLWPO) - CH1P1=AMAX1(0.0,H1PO4(L,NY,NX)/VOLWPO) - CH3P1=AMAX1(0.0,H3PO4(L,NY,NX)/VOLWPO) - CF1P1=AMAX1(0.0,ZFE1P(L,NY,NX)/VOLWPO) - CF2P1=AMAX1(0.0,ZFE2P(L,NY,NX)/VOLWPO) - CC0P1=AMAX1(0.0,ZCA0P(L,NY,NX)/VOLWPO) - CC1P1=AMAX1(0.0,ZCA1P(L,NY,NX)/VOLWPO) - CC2P1=AMAX1(0.0,ZCA2P(L,NY,NX)/VOLWPO) - CM1P1=AMAX1(0.0,ZMG1P(L,NY,NX)/VOLWPO) - ELSE - CH0P1=0.0 - CH1P1=0.0 - CH3P1=0.0 - CF1P1=0.0 - CF2P1=0.0 - CC0P1=0.0 - CC1P1=0.0 - CC2P1=0.0 - CM1P1=0.0 - ENDIF - IF(VOLWPB.GT.ZEROS(NY,NX))THEN - CH0PB=AMAX1(0.0,H0POB(L,NY,NX)/VOLWPB) - CH1PB=AMAX1(0.0,H1POB(L,NY,NX)/VOLWPB) - CH3PB=AMAX1(0.0,H3POB(L,NY,NX)/VOLWPB) - CF1PB=AMAX1(0.0,ZFE1PB(L,NY,NX)/VOLWPB) - CF2PB=AMAX1(0.0,ZFE2PB(L,NY,NX)/VOLWPB) - CC0PB=AMAX1(0.0,ZCA0PB(L,NY,NX)/VOLWPB) - CC1PB=AMAX1(0.0,ZCA1PB(L,NY,NX)/VOLWPB) - CC2PB=AMAX1(0.0,ZCA2PB(L,NY,NX)/VOLWPB) - CM1PB=AMAX1(0.0,ZMG1PB(L,NY,NX)/VOLWPB) - ELSE - CH0PB=0.0 - CH1PB=0.0 - CH3PB=0.0 - CF1PB=0.0 - CF2PB=0.0 - CC0PB=0.0 - CC1PB=0.0 - CC2PB=0.0 - CM1PB=0.0 - ENDIF -C -C EXCHANGEABLE ION CONCENTRATIONS -C - XHY1=AMAX1(0.0,XHY(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - XAL1=AMAX1(0.0,XAL(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - XCA1=AMAX1(0.0,XCA(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - XMG1=AMAX1(0.0,XMG(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - XNA1=AMAX1(0.0,XNA(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - XKA1=AMAX1(0.0,XKA(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - XHC1=AMAX1(0.0,XHC(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - XALO21=AMAX1(0.0,XALO2(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - XCOOH=AMAX1(0.0,COOH*ORGC(L,NY,NX)/VOLWM(NPH,L,NY,NX)) -C -C PRECIPITATE CONCENTRATIONS -C - PALOH1=AMAX1(0.0,PALOH(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - PFEOH1=AMAX1(0.0,PFEOH(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - PCACO1=AMAX1(0.0,PCACO(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - PCASO1=AMAX1(0.0,PCASO(L,NY,NX)/VOLWM(NPH,L,NY,NX)) -C -C CONVERGENCE TOWARDS SOLUTE EQILIBRIA -C - DO 1000 M=1,MRXN - CN41=AMAX1(ZERO,CN41) - CN4B=AMAX1(ZERO,CN4B) - CN31=AMAX1(ZERO,CN31) - CN3B=AMAX1(ZERO,CN3B) - CAL1=AMAX1(ZERO,CAL1) - CFE1=AMAX1(ZERO,CFE1) - CHY1=AMAX1(ZERO,CHY1) - CCA1=AMAX1(ZERO,AMIN1(CCAMX,CCA1)) - CMG1=AMAX1(ZERO,CMG1) - CNA1=AMAX1(ZERO,CNA1) - CKA1=AMAX1(ZERO,CKA1) - COH1=AMAX1(ZERO,COH1) - CSO41=AMAX1(ZERO,CSO41) - CCO31=AMAX1(ZERO,CCO31) - CHCO31=AMAX1(ZERO,CHCO31) - CCO21=AMAX1(ZERO,CCO21) - CALO1=AMAX1(ZERO,CALO1) - CALO2=AMAX1(ZERO,CALO2) - CALO3=AMAX1(ZERO,CALO3) - CALO4=AMAX1(ZERO,CALO4) - CALS1=AMAX1(ZERO,CALS1) - CFEO1=AMAX1(ZERO,CFEO1) - CFEO2=AMAX1(ZERO,CFEO2) - CFEO3=AMAX1(ZERO,CFEO3) - CFEO4=AMAX1(ZERO,CFEO4) - CFES1=AMAX1(ZERO,CFES1) - CCAO1=AMAX1(ZERO,CCAO1) - CCAC1=AMAX1(ZERO,CCAC1) - CCAH1=AMAX1(ZERO,CCAH1) - CCAS1=AMAX1(ZERO,CCAS1) - CMGO1=AMAX1(ZERO,CMGO1) - CMGC1=AMAX1(ZERO,CMGC1) - CMGH1=AMAX1(ZERO,CMGH1) - CMGS1=AMAX1(ZERO,CMGS1) - CNAC1=AMAX1(ZERO,CNAC1) - CNAS1=AMAX1(ZERO,CNAS1) - CKAS1=AMAX1(ZERO,CKAS1) - CH0P1=AMAX1(ZERO,CH0P1) - CH1P1=AMAX1(ZERO,CH1P1) - CH2P1=AMAX1(ZERO,CH2P1) - CH3P1=AMAX1(ZERO,CH3P1) - CF1P1=AMAX1(ZERO,CF1P1) - CF2P1=AMAX1(ZERO,CF2P1) - CC0P1=AMAX1(ZERO,CC0P1) - CC1P1=AMAX1(ZERO,CC1P1) - CC2P1=AMAX1(ZERO,CC2P1) - CM1P1=AMAX1(ZERO,CM1P1) - CH0PB=AMAX1(ZERO,CH0PB) - CH1PB=AMAX1(ZERO,CH1PB) - CH2B1=AMAX1(ZERO,CH2B1) - CH3PB=AMAX1(ZERO,CH3PB) - CF1PB=AMAX1(ZERO,CF1PB) - CF2PB=AMAX1(ZERO,CF2PB) - CC0PB=AMAX1(ZERO,CC0PB) - CC1PB=AMAX1(ZERO,CC1PB) - CC2PB=AMAX1(ZERO,CC2PB) - CM1PB=AMAX1(ZERO,CM1PB) - XCOO=AMAX1(0.0,XCOOH-XHC1-XALO21) -C -C IONIC STRENGTH FROM SUMS OF ION CONCENTRATIONS -C - CC3=CAL1+CFE1 - CA3=CH0P1*VLPO4(L,NY,NX)+CH0PB*VLPOB(L,NY,NX) - CC2=CCA1+CMG1+CALO1+CFEO1+CF2P1*VLPO4(L,NY,NX) - 2+CF2PB*VLPOB(L,NY,NX) - CA2=CSO41+CCO31+CH1P1*VLPO4(L,NY,NX)+CH1PB*VLPOB(L,NY,NX) - CC1=CN41*VLNH4(L,NY,NX)+CN4B*VLNHB(L,NY,NX)+CHY1+CNA1+CKA1 - 2+CALO2+CFEO2+CALS1+CFES1+CCAO1+CCAH1+CMGO1+CMGH1 - 3+(CF1P1+CC2P1)*VLPO4(L,NY,NX)+(CF1PB+CC2PB)*VLPOB(L,NY,NX) - CA1=CNO1*VLNO3(L,NY,NX)+CNOB*VLNOB(L,NY,NX)+COH1+CHCO31+CCL1 - 2+CALO4+CFEO4+CNAC1+CNAS1+CKAS1+(CH2P1+CC0P1)*VLPO4(L,NY,NX) - 3+(CH2B1+CC0PB)*VLPOB(L,NY,NX) - CION1=ABS(3.0*(CC3-CA3)+2.0*(CC2-CA2)+CC1-CA1) - CSTR1=AMAX1(0.0,0.5E-03*(9.0*(CC3+CA3)+4.0*(CC2+CA2) - 2+CC1+CA1+CION1)) - CSTR2=SQRT(CSTR1) - FSTR2=CSTR2/(1.0+CSTR2) -C -C ACTIVITY COEFFICIENTS CALCULATED FROM ION STRENGTH -C - A1=AMIN1(1.0,10.0**(-0.509*1.0*FSTR2+0.20*CSTR2)) - A2=AMIN1(1.0,10.0**(-0.509*4.0*FSTR2+0.20*CSTR2)) - A3=AMIN1(1.0,10.0**(-0.509*9.0*FSTR2+0.20*CSTR2)) - A12=A1**2 - A13=A1**3 - A14=A1**4 - A22=A2**2 - A25=A2**5 - A28=A2**8 - A2Q=A2**0.500 - A3C=A3**0.333 - A0A2=A0*A2 - A0A12=A0/A12 - A0A22=A0/A22 - A0A1A2=A0*A12*A2 - A1A2=A1*A2 - A1A2D=A1/A2 - A1A2QD=A1/A2Q - A1A3=A1*A3 - A1A3D=A1/A3 - A12A2=A12*A2 - A12A2D=A12/A2 - A12A22=A12/A22 - A12A25=A12/A25 - A12A28=A12/A28 - A1202D=A12/A0A2 - A13A2=A13*A2 - A13A3=A13*A3 - A13A3D=A13/A3 - A14A0=A14/A0 - A14A2=A14*A2 - A14A2D=A14/A2 - A14A0A=A14/A0A2 - A14A5D=A14/A25 - A14A28=A14*A28 - A14A8D=A14/A28 - A1TA25=A1**10*A25 - A2A3=A2*A3 - A2A13D=A2/A1A3 - A1A2A3=A1*A2A3 - A1A23D=A1/A2A3 -C -C PRECIPITATION-DISSOLUTION CALCULATED FROM ACTIVITIES -C OF REACTANTS AND PRODUCTS THROUGH CONVERGENCE SOLUTIONS -C FOR THEIR EQUILIBRIUM CONSTANTS USING SOLUTE FORMS -C CURRENTLY AT HIGHEST CONCENTRATIONS -C - AHY1=CHY1*A1 - AOH1=COH1*A1 - AAL1=CAL1*A3 - AALO1=CALO1*A2 - AALO2=CALO2*A1 - AALO3=CALO3 - AALO4=CALO4*A1 - AFE1=CFE1*A3 - AFEO1=CFEO1*A2 - AFEO2=CFEO2*A1 - AFEO3=CFEO3 - AFEO4=CFEO4*A1 - ACO31=CCO31*A2 - AHCO31=CHCO31*A1 - ACO21=CCO21*A0 -C -C ALUMINUM HYDROXIDE (GIBBSITE) -C - PX=AMAX1(AAL1,AALO1,AALO2,AALO3,AALO4) - IF(PX.EQ.AAL1)THEN - R2=CHY1 - P2=COH1 - P1=CAL1 - IF(AOH1.GT.AHY1)THEN - NR2=0 - NP2=3 - SP=SYALO/A13A3 - ELSE - NR2=3 - NP2=0 - SP=SHALO*A13A3D - ENDIF - ELSEIF(PX.EQ.AALO1)THEN - R2=CHY1 - P2=COH1 - P1=CALO1 - IF(AOH1.GT.AHY1)THEN - NR2=0 - NP2=2 - SP=SYAL1/A12A2 - ELSE - NR2=2 - NP2=0 - SP=SHAL1*A12A2D - ENDIF - ELSEIF(PX.EQ.AALO2)THEN - R2=CHY1 - P2=COH1 - P1=CALO2 - IF(AOH1.GT.AHY1)THEN - NR2=0 - NP2=1 - SP=SYAL2/A12 - ELSE - NR2=1 - NP2=0 - SP=SHAL2 - ENDIF - ELSEIF(PX.EQ.AALO3)THEN - R2=CHY1 - P2=COH1 - P1=CALO3 - NR2=0 - NP2=0 - SP=SPAL3 - ELSEIF(PX.EQ.AALO4)THEN - R2=COH1 - P2=CHY1 - P1=CALO4 - IF(AOH1.GT.AHY1)THEN - NR2=1 - NP2=0 - SP=SYAL4 - ELSE - NR2=0 - NP2=1 - SP=SHAL4/A12 - ENDIF - ENDIF - RYAL1=0.0 - RYALO1=0.0 - RYALO2=0.0 - RYALO3=0.0 - RYALO4=0.0 - RHAL1=0.0 - RHALO1=0.0 - RHALO2=0.0 - RHALO3=0.0 - RHALO4=0.0 - X=0.0 - TX=0.0 - FX=1.0/(1+NR2+NP2) - DO 1010 MM=1,100 - R2=AMAX1(ZERO,R2+NR2*X) - P1=AMAX1(ZERO,P1-X) - P2=AMAX1(ZERO,P2-NP2*X) - Z=(P1*P2**NP2/R2**NR2)/SP - IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 1110 - IF(Z.LE.0.95.AND.PALOH1.LE.0.0)GO TO 1110 - IF(NR2.NE.0)THEN - Y=AMIN1(P1,R2/NR2) - ELSEIF(NP2.NE.0)THEN - Y=AMIN1(P1,P2/NP2) - ELSE - Y=P1 - ENDIF - IF(Z.GT.1.0)THEN - X=Y-Y/Z**FX - ELSE - X=Y*Z**FX-Y - ENDIF - TX=TX+X -1010 CONTINUE -1110 CONTINUE - RPALOX=AMAX1(-PALOH1,TPD*TX) - IF(PX.EQ.AAL1)THEN - IF(AOH1.GT.AHY1)THEN - RYAL1=RPALOX - ELSE - RHAL1=RPALOX - ENDIF - ELSEIF(PX.EQ.AALO1)THEN - IF(AOH1.GT.AHY1)THEN - RYALO1=RPALOX - ELSE - RHALO1=RPALOX - ENDIF - ELSEIF(PX.EQ.AALO2)THEN - IF(AOH1.GT.AHY1)THEN - RYALO2=RPALOX - ELSE - RHALO2=RPALOX - ENDIF - ELSEIF(PX.EQ.AALO3)THEN - IF(AOH1.GT.AHY1)THEN - RYALO3=RPALOX - ELSE - RHALO3=RPALOX - ENDIF - ELSEIF(PX.EQ.AALO4)THEN - IF(AOH1.GT.AHY1)THEN - RYALO4=RPALOX - ELSE - RHALO4=RPALOX - ENDIF - ENDIF -C IF((M/10)*10.EQ.M)THEN -C WRITE(*,1112)'GIBB',I,J,M,MM,PALOH1,CAL1,CALO1,CALO2,CALO3,CALO4 -C 2,COH1,R2,P1,P2,SP,Z,TX,RPALOX,RHAL1,RHALO1,RHALO2,RHALO3,RHALO4 -C 3,CAL1*A3*(COH1*A1)**3,SYALO -C ENDIF -C -C IRON HYDROXIDE -C - PX=AMAX1(AFE1,AFEO1,AFEO2,AFEO3,AFEO4) - IF(PX.EQ.AFE1)THEN - R2=CHY1 - P2=COH1 - P1=CFE1 - IF(AOH1.GT.AHY1)THEN - NR2=0 - NP2=3 - SP=SYFEO/A13A3 - ELSE - NR2=3 - NP2=0 - SP=SHFEO*A13A3D - ENDIF - ELSEIF(PX.EQ.AFEO1)THEN - R2=CHY1 - P2=COH1 - P1=CFEO1 - IF(AOH1.GT.AHY1)THEN - NR2=0 - NP2=2 - SP=SYFE1/A12A2 - ELSE - NR2=2 - NP2=0 - SP=SHFE1*A12A2D - ENDIF - ELSEIF(PX.EQ.AFEO2)THEN - R2=CHY1 - P2=COH1 - P1=CFEO2 - IF(AOH1.GT.AHY1)THEN - NR2=0 - NP2=1 - SP=SYFE2/A12 - ELSE - NR2=1 - NP2=0 - SP=SHFE2 - ENDIF - ELSEIF(PX.EQ.AFEO3)THEN - R2=CHY1 - P2=COH1 - P1=CFEO3 - NR2=0 - NP2=0 - SP=SPFE3 - ELSEIF(PX.EQ.AFEO4)THEN - R2=COH1 - P2=CHY1 - P1=CFEO4 - IF(AOH1.GT.AHY1)THEN - NR2=1 - NP2=0 - SP=SYFE4 - ELSE - NR2=0 - NP2=1 - SP=SHFE4/A12 - ENDIF - ENDIF - RYFE1=0.0 - RYFEO1=0.0 - RYFEO2=0.0 - RYFEO3=0.0 - RYFEO4=0.0 - RHFE1=0.0 - RHFEO1=0.0 - RHFEO2=0.0 - RHFEO3=0.0 - RHFEO4=0.0 - X=0.0 - TX=0.0 - FX=1.0/(1+NR2+NP2) - DO 1020 MM=1,100 - R2=AMAX1(ZERO,R2+NR2*X) - P1=AMAX1(ZERO,P1-X) - P2=AMAX1(ZERO,P2-NP2*X) - Z=(P1*P2**NP2/R2**NR2)/SP - IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 1120 - IF(Z.LE.0.95.AND.PFEOH1.LE.0.0)GO TO 1120 - IF(NR2.NE.0)THEN - Y=AMIN1(P1,R2/NR2) - ELSEIF(NP2.NE.0)THEN - Y=AMIN1(P1,P2/NP2) - ELSE - Y=P1 - ENDIF - IF(Z.GT.1.0)THEN - X=Y-Y/Z**FX - ELSE - X=Y*Z**FX-Y - ENDIF - TX=TX+X -1020 CONTINUE -1120 CONTINUE - RPFEOX=AMAX1(-PFEOH1,TPD*TX) - IF(PX.EQ.AFE1)THEN - IF(AOH1.GT.AHY1)THEN - RYFE1=RPFEOX - ELSE - RHFE1=RPFEOX - ENDIF - ELSEIF(PX.EQ.AFEO1)THEN - IF(AOH1.GT.AHY1)THEN - RYFEO1=RPFEOX - ELSE - RHFEO1=RPFEOX - ENDIF - ELSEIF(PX.EQ.AFEO2)THEN - IF(AOH1.GT.AHY1)THEN - RYFEO2=RPFEOX - ELSE - RHFEO2=RPFEOX - ENDIF - ELSEIF(PX.EQ.AFEO3)THEN - IF(AOH1.GT.AHY1)THEN - RYFEO3=RPFEOX - ELSE - RHFEO3=RPFEOX - ENDIF - ELSEIF(PX.EQ.AFEO4)THEN - IF(AOH1.GT.AHY1)THEN - RYFEO4=RPFEOX - ELSE - RHFEO4=RPFEOX - ENDIF - ENDIF -C IF((M/10)*10.EQ.M)THEN -C WRITE(*,1112)'IRON',I,J,M,MM,PFEOH1,CFE1,CFEO1,CFEO2,CFEO3,CFEO4 -C 2,COH1,R2,P1,P2,SP,Z,TX,RPFEOX,RHFE1,RHFEO1,RHFEO2,RHFEO3,RHFEO4 -C 3,CFE1*A3*(COH1*A1)**3,SYFEO -C ENDIF -C -C CALCITE AND GYPSUM -C - PX=AMAX1(ACO31,AHCO31,ACO21) - R2=CHY1 - P3=COH1 - P1=CCA1 - IF(PX.EQ.ACO31)THEN - P2=CCO31 - NR2=0 - NP3=0 - SP=SPCAC/A22 - ELSEIF(PX.EQ.AHCO31)THEN - P2=CHCO31 - IF(AOH1.GT.AHY1)THEN - NR2=0 - NP3=1 - SP=SYCAC1/A12A2 - ELSE - NR2=1 - NP3=0 - SP=SHCAC1/A2 - ENDIF - ELSEIF(PX.EQ.ACO21)THEN - P2=CCO21 - IF(AOH1.GT.AHY1)THEN - NR2=0 - NP3=2 - SP=SYCAC2/A0A1A2 - ELSE - NR2=2 - NP3=0 - SP=SHCAC2*A1202D - ENDIF - ENDIF - RYCAC3=0.0 - RYCACH=0.0 - RYCACO=0.0 - RHCAC3=0.0 - RHCACH=0.0 - RHCACO=0.0 - X=0.0 - TX=0.0 - FX=1.0/(2+NR2+NP3) - DO 1030 MM=1,100 - R2=AMAX1(ZERO,R2+NR2*X) - P1=AMAX1(ZERO,P1-X) - P2=AMAX1(ZERO,P2-X) - P3=AMAX1(ZERO,P3-NP3*X) - Z=(P1*P2*P3**NP3/R2**NR2)/SP - IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 1130 - IF(Z.LE.0.95.AND.PCACO1.LE.0.0)GO TO 1130 - IF(NR2.NE.0)THEN - Y=AMIN1(R2/NR2,P1,P2) - ELSEIF(NP3.NE.0)THEN - Y=AMIN1(P1,P2,P3/NP3) - ELSE - Y=AMIN1(P1,P2) - ENDIF - IF(Z.GT.1.0)THEN - X=Y-Y/Z**FX - ELSE - X=Y*Z**FX-Y - ENDIF - TX=TX+X -1030 CONTINUE -1130 CONTINUE - RPCACX=AMAX1(-PCACO1,TPD*TX) - IF(PX.EQ.ACO31)THEN - IF(AOH1.GT.AHY1)THEN - RYCAC3=RPCACX - ELSE - RHCAC3=RPCACX - ENDIF - ELSEIF(PX.EQ.AHCO31)THEN - IF(AOH1.GT.AHY1)THEN - RYCACH=RPCACX - ELSE - RHCACH=RPCACX - ENDIF - ELSEIF(PX.EQ.ACO21)THEN - IF(AOH1.GT.AHY1)THEN - RYCACO=RPCACX - ELSE - RHCACO=RPCACX - ENDIF - ENDIF - SP=SPCAS/A22 - S0=CCA1+CSO41 - S1=AMAX1(0.0,S0**2-4.0*(CCA1*CSO41-SP)) - RPCASO=AMAX1(-PCASO1,TPDX*(S0-SQRT(S1))) -C IF((M/10)*10.EQ.M)THEN -C WRITE(*,1112)'CALC',I,J,M,MM,PCASO1,ACO31,AHCO31,ACO21,CHY1 -C 2,COH1,R2,P1,P2,P3,SP,Z,TX,RPCACX,RHCAC3,RHCACH,RHCACO -C 3,CCA1*A2*CCO3*A2,SPCAC -C ENDIF -C -C PHOSPHORUS PRECIPITATION-DISSOLUTION IN NON-BAND SOIL ZONE -C - IF(VOLWPO.GT.ZEROS(NY,NX))THEN -C -C ALUMINUM PHOSPHATE (VARISCITE) -C - AH1P1=CH1P1*A2 - AH2P1=CH2P1*A1 - PX=AMAX1(AAL1,AALO1,AALO2,AALO3,AALO4) - PY=AMAX1(AH1P1,AH2P1) - R3=CHY1 - R4=COH1 - P3=CHY1 - P4=COH1 - IF(PY.EQ.AH1P1)THEN - P2=CH1P1 - IF(PX.EQ.AAL1)THEN - P1=CAL1 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=0 - NP3=0 - NP4=1 - SP=SYA0P1/A1A2A3 - ELSE - NR3=1 - NR4=0 - NP3=0 - NP4=0 - SP=SHA0P1*A1A23D - ENDIF - ELSEIF(PX.EQ.AALO1)THEN - P1=CALO1 - NR3=0 - NR4=0 - NP3=0 - NP4=0 - SP=SPA1P1/A22 - ELSEIF(PX.EQ.AALO2)THEN - P1=CALO2 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=1 - NP3=0 - NP4=0 - SP=SYA2P1/A2 - ELSE - NR3=0 - NR4=0 - NP3=1 - NP4=0 - SP=SHA2P1/A12A2 - ENDIF - ELSEIF(PX.EQ.AALO3)THEN - P1=CALO3 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=2 - NP3=0 - NP4=0 - SP=SYA3P1*A12A2D - ELSE - NR3=0 - NR4=0 - NP3=2 - NP4=0 - SP=SHA3P1/A13A2 - ENDIF - ELSEIF(PX.EQ.AALO4)THEN - P1=CALO4 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=3 - NP3=0 - NP4=0 - SP=SYA4P1*A12A2D - ELSE - NR3=0 - NR4=0 - NP3=3 - NP4=0 - SP=SHA4P1*A14A2 - ENDIF - ENDIF - ELSE - P2=CH2P1 - IF(PX.EQ.AAL1)THEN - P1=CAL1 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=0 - NP3=0 - NP4=2 - SP=SYA0P2/A13A3 - ELSE - NR3=2 - NR4=0 - NP3=0 - NP4=0 - SP=SHA0P2*A1A3D - ENDIF - ELSEIF(PX.EQ.AALO1)THEN - P1=CALO1 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=0 - NP3=0 - NP4=1 - SP=SYA1P2/A12A2 - ELSE - NR3=1 - NR4=0 - NP3=0 - NP4=0 - SP=SHA1P2/A2 - ENDIF - ELSEIF(PX.EQ.AALO2)THEN - P1=CALO2 - NR3=0 - NR4=0 - NP3=0 - NP4=0 - SP=SPA2P2/A12 - ELSEIF(PX.EQ.AALO3)THEN - P1=CALO3 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=1 - NP3=0 - NP4=0 - SP=SYA3P2 - ELSE - NR3=0 - NR4=0 - NP3=1 - NP4=0 - SP=SHA3P2/A22 - ENDIF - ELSEIF(PX.EQ.AALO4)THEN - P1=CALO4 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=2 - NP3=0 - NP4=0 - SP=SYA4P2 - ELSE - NR3=0 - NR4=0 - NP3=2 - NP4=0 - SP=SHA4P2/A14 - ENDIF - ENDIF - ENDIF - RYA0P1=0.0 - RYA1P1=0.0 - RYA2P1=0.0 - RYA3P1=0.0 - RYA4P1=0.0 - RYA0P2=0.0 - RYA1P2=0.0 - RYA2P2=0.0 - RYA3P2=0.0 - RYA4P2=0.0 - RHA0P1=0.0 - RHA1P1=0.0 - RHA2P1=0.0 - RHA3P1=0.0 - RHA4P1=0.0 - RHA0P2=0.0 - RHA1P2=0.0 - RHA2P2=0.0 - RHA3P2=0.0 - RHA4P2=0.0 - X=0.0 - TX=0.0 - FX=1.0/(2+NR3+NR4+NP3+NP4) - DO 1040 MM=1,100 - R3=AMAX1(ZERO,R3+NR3*X) - R4=AMAX1(ZERO,R4+NR4*X) - P1=AMAX1(ZERO,P1-X) - P2=AMAX1(ZERO,P2-X) - P3=AMAX1(ZERO,P3-NP3*X) - P4=AMAX1(ZERO,P4-NP4*X) - Z=(P1*P2*P3**NP3*P4**NP4/(R3**NR3*R4**NR4))/SP - IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 1140 - IF(Z.LE.0.95.AND.PALPO1.LE.0.0)GO TO 1140 - IF(NR3.NE.0)THEN - Y=AMIN1(R3/NR3,P1,P2) - ELSEIF(NR4.NE.0)THEN - Y=AMIN1(R4/NR4,P1,P2) - ELSEIF(NP3.NE.0)THEN - Y=AMIN1(P1,P2,P3/NP3) - ELSEIF(NP4.NE.0)THEN - Y=AMIN1(P1,P2,P4/NP4) - ELSE - Y=AMIN1(P1,P2) - ENDIF - IF(Z.GT.1.0)THEN - X=Y-Y/Z**FX - ELSE - X=Y*Z**FX-Y - ENDIF - TX=TX+X -1040 CONTINUE -1140 CONTINUE - RPALPX=AMAX1(-PALPO1,TPD*TX) - IF(PY.EQ.AH1P1)THEN - IF(PX.EQ.AAL1)THEN - IF(AOH1.GT.AHY1)THEN - RYA0P1=RPALPX - ELSE - RHA0P1=RPALPX - ENDIF - ELSEIF(PX.EQ.AALO1)THEN - IF(AOH1.GT.AHY1)THEN - RYA1P1=RPALPX - ELSE - RHA1P1=RPALPX - ENDIF - ELSEIF(PX.EQ.AALO2)THEN - IF(AOH1.GT.AHY1)THEN - RYA2P1=RPALPX - ELSE - RHA2P1=RPALPX - ENDIF - ELSEIF(PX.EQ.AALO3)THEN - IF(AOH1.GT.AHY1)THEN - RYA3P1=RPALPX - ELSE - RHA3P1=RPALPX - ENDIF - ELSEIF(PX.EQ.AALO4)THEN - IF(AOH1.GT.AHY1)THEN - RYA4P1=RPALPX - ELSE - RHA4P1=RPALPX - ENDIF - ENDIF - ELSE - IF(PX.EQ.AAL1)THEN - IF(AOH1.GT.AHY1)THEN - RYA0P2=RPALPX - ELSE - RHA0P2=RPALPX - ENDIF - ELSEIF(PX.EQ.AALO1)THEN - IF(AOH1.GT.AHY1)THEN - RYA1P2=RPALPX - ELSE - RHA1P2=RPALPX - ENDIF - ELSEIF(PX.EQ.AALO2)THEN - IF(AOH1.GT.AHY1)THEN - RYA2P2=RPALPX - ELSE - RHA2P2=RPALPX - ENDIF - ELSEIF(PX.EQ.AALO3)THEN - IF(AOH1.GT.AHY1)THEN - RYA3P2=RPALPX - ELSE - RHA3P2=RPALPX - ENDIF - ELSEIF(PX.EQ.AALO4)THEN - IF(AOH1.GT.AHY1)THEN - RYA4P2=RPALPX - ELSE - RHA4P2=RPALPX - ENDIF - ENDIF - ENDIF -C IF((M/10)*10.EQ.M)THEN -C WRITE(*,1112)'ALPO4',I,J,M,MM,PALPO1,CAL1,CALO1,CALO2,CALO3,CALO4 -C 2,CH1P1,CH2P1,CHY1,COH1,RPALPX,RHA0P1,RHA1P1,RHA2P1,RHA3P1,RHA4P1 -C 3,RHA0P2,RHA1P2,RHA2P2,RHA3P2,RHA4P2,R3,R4,P2,P3,P4,SP,Z,TX -1112 FORMAT(A8,4I4,80E12.4) -C ENDIF -C -C IRON PHOSPHATE (STRENGITE) -C - PX=AMAX1(AFE1,AFEO1,AFEO2,AFEO3,AFEO4) - PY=AMAX1(AH1P1,AH2P1) - R3=CHY1 - R4=COH1 - P3=CHY1 - P4=COH1 - IF(PY.EQ.AH1P1)THEN - P2=CH1P1 - IF(PX.EQ.AFE1)THEN - P1=CFE1 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=0 - NP3=0 - NP4=1 - SP=SYF0P1/A1A2A3 - ELSE - NR3=1 - NR4=0 - NP3=0 - NP4=0 - SP=SHF0P1*A1A23D - ENDIF - ELSEIF(PX.EQ.AFEO1)THEN - P1=CFEO1 - NR3=0 - NR4=0 - NP3=0 - NP4=0 - SP=SPF1P1/A22 - ELSEIF(PX.EQ.AFEO2)THEN - P1=CFEO2 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=1 - NP3=0 - NP4=0 - SP=SYF2P1/A2 - ELSE - NR3=0 - NR4=0 - NP3=1 - NP4=0 - SP=SHF2P1/A12A2 - ENDIF - ELSEIF(PX.EQ.AFEO3)THEN - P1=CFEO3 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=2 - NP3=0 - NP4=0 - SP=SYF3P1*A12A2D - ELSE - NR3=0 - NR4=0 - NP3=2 - NP4=0 - SP=SHF3P1/A13A2 - ENDIF - ELSEIF(PX.EQ.AFEO4)THEN - P1=CFEO4 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=3 - NP3=0 - NP4=0 - SP=SYF4P1*A12A2D - ELSE - NR3=0 - NR4=0 - NP3=3 - NP4=0 - SP=SHF4P1*A14A2 - ENDIF - ENDIF - ELSE - P2=CH2P1 - IF(PX.EQ.AFE1)THEN - P1=CFE1 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=0 - NP3=0 - NP4=2 - SP=SYF0P2/A13A3 - ELSE - NR3=2 - NR4=0 - NP3=0 - NP4=0 - SP=SHF0P2*A1A3D - ENDIF - ELSEIF(PX.EQ.AFEO1)THEN - P1=CFEO1 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=0 - NP3=0 - NP4=1 - SP=SYF1P2/A12A2 - ELSE - NR3=1 - NR4=0 - NP3=0 - NP4=0 - SP=SHF1P2/A2 - ENDIF - ELSEIF(PX.EQ.AFEO2)THEN - P1=CFEO2 - NR3=0 - NR4=0 - NP3=0 - NP4=0 - SP=SPF2P2/A12 - ELSEIF(PX.EQ.AFEO3)THEN - P1=CFEO3 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=1 - NP3=0 - NP4=0 - SP=SYF3P2 - ELSE - NR3=0 - NR4=0 - NP3=1 - NP4=0 - SP=SHF3P2/A22 - ENDIF - ELSEIF(PX.EQ.AFEO4)THEN - P1=CFEO4 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=2 - NP3=0 - NP4=0 - SP=SYF4P2 - ELSE - NR3=0 - NR4=0 - NP3=2 - NP4=0 - SP=SHF4P2/A14 - ENDIF - ENDIF - ENDIF - RYF0P1=0.0 - RYF1P1=0.0 - RYF2P1=0.0 - RYF3P1=0.0 - RYF4P1=0.0 - RYF0P2=0.0 - RYF1P2=0.0 - RYF2P2=0.0 - RYF3P2=0.0 - RYF4P2=0.0 - RHF0P1=0.0 - RHF1P1=0.0 - RHF2P1=0.0 - RHF3P1=0.0 - RHF4P1=0.0 - RHF0P2=0.0 - RHF1P2=0.0 - RHF2P2=0.0 - RHF3P2=0.0 - RHF4P2=0.0 - X=0.0 - TX=0.0 - FX=1.0/(2+NR3+NR4+NP3+NP4) - DO 1050 MM=1,100 - R3=AMAX1(ZERO,R3+NR3*X) - R4=AMAX1(ZERO,R4+NR4*X) - P1=AMAX1(ZERO,P1-X) - P2=AMAX1(ZERO,P2-X) - P3=AMAX1(ZERO,P3-NP3*X) - P4=AMAX1(ZERO,P4-NP4*X) - Z=(P1*P2*P3**NP3*P4**NP4/(R3**NR3*R4**NR4))/SP - IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 1150 - IF(Z.LE.0.95.AND.PFEPO1.LE.0.0)GO TO 1150 - IF(NR3.NE.0)THEN - Y=AMIN1(R3/NR3,P1,P2) - ELSEIF(NR4.NE.0)THEN - Y=AMIN1(R4/NR4,P1,P2) - ELSEIF(NP3.NE.0)THEN - Y=AMIN1(P1,P2,P3/NP3) - ELSEIF(NP4.NE.0)THEN - Y=AMIN1(P1,P2,P4/NP4) - ELSE - Y=AMIN1(P1,P2) - ENDIF - IF(Z.GT.1.0)THEN - X=Y-Y/Z**FX - ELSE - X=Y*Z**FX-Y - ENDIF - TX=TX+X -1050 CONTINUE -1150 CONTINUE - RPFEPX=AMAX1(-PFEPO1,TPD*TX) - IF(PY.EQ.AH1P1)THEN - IF(PX.EQ.AFE1)THEN - IF(AOH1.GT.AHY1)THEN - RYF0P1=RPFEPX - ELSE - RHF0P1=RPFEPX - ENDIF - ELSEIF(PX.EQ.AFEO1)THEN - IF(AOH1.GT.AHY1)THEN - RYF1P1=RPFEPX - ELSE - RHF1P1=RPFEPX - ENDIF - ELSEIF(PX.EQ.AFEO2)THEN - IF(AOH1.GT.AHY1)THEN - RYF2P1=RPFEPX - ELSE - RHF2P1=RPFEPX - ENDIF - ELSEIF(PX.EQ.AFEO3)THEN - IF(AOH1.GT.AHY1)THEN - RYF3P1=RPFEPX - ELSE - RHF3P1=RPFEPX - ENDIF - ELSEIF(PX.EQ.AFEO4)THEN - IF(AOH1.GT.AHY1)THEN - RYF4P1=RPFEPX - ELSE - RHF4P1=RPFEPX - ENDIF - ENDIF - ELSE - IF(PX.EQ.AFE1)THEN - IF(AOH1.GT.AHY1)THEN - RYF0P2=RPFEPX - ELSE - RHF0P2=RPFEPX - ENDIF - ELSEIF(PX.EQ.AFEO1)THEN - IF(AOH1.GT.AHY1)THEN - RYF1P2=RPFEPX - ELSE - RHF1P2=RPFEPX - ENDIF - ELSEIF(PX.EQ.AFEO2)THEN - IF(AOH1.GT.AHY1)THEN - RYF2P2=RPFEPX - ELSE - RHF2P2=RPFEPX - ENDIF - ELSEIF(PX.EQ.AFEO3)THEN - IF(AOH1.GT.AHY1)THEN - RYF3P2=RPFEPX - ELSE - RHF3P2=RPFEPX - ENDIF - ELSEIF(PX.EQ.AFEO4)THEN - IF(AOH1.GT.AHY1)THEN - RYF4P2=RPFEPX - ELSE - RHF4P2=RPFEPX - ENDIF - ENDIF - ENDIF -C IF((M/10)*10.EQ.M)THEN -C WRITE(*,1112)'FEPO4',I,J,M,MM,PFEPO1,CFE1,CFEO1,CFEO2,CFEO3,CFEO4 -C 2,CH1P1,CH2P1,CHY1,COH1,RPFEPX,RHF0P1,RHF1P1,RHF2P1,RHF3P1,RHF4P1 -C 3,RHF0P2,RHF1P2,RHF2P2,RHF3P2,RHF4P2,R3,R4,P2,P3,P4,SP,Z,TX -C ENDIF -C -C DICALCIUM PHOSPHATE -C - PX=AMAX1(AH1P1,AH2P1) - R2=CHY1 - P3=COH1 - P1=CCA1 - IF(PX.EQ.AH1P1)THEN - P2=CH1P1 - NR2=0 - NP3=0 - SP=SPCAD/A22 - ELSEIF(PX.EQ.AH2P1)THEN - P2=CH2P1 - IF(AOH1.GT.AHY1)THEN - NR2=0 - NP3=1 - SP=SYCAD2/A12A2 - ELSE - NR2=1 - NP3=0 - SP=SHCAD2/A2 - ENDIF - ENDIF - RPCAD1=0.0 - RYCAD2=0.0 - RHCAD2=0.0 - X=0.0 - TX=0.0 - FX=1.0/(2+NR2+NP3) - DO 1060 MM=1,100 - R2=AMAX1(ZERO,R2+NR2*X) - P1=AMAX1(ZERO,P1-X) - P2=AMAX1(ZERO,P2-X) - P3=AMAX1(ZERO,P3-NP3*X) - Z=(P1*P2*P3**NP3/R2**NR2)/SP - IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 1160 - IF(Z.LE.0.95.AND.PCAPD1.LE.0.0)GO TO 1160 - IF(NR2.NE.0)THEN - Y=AMIN1(R2/NR2,P1,P2) - ELSEIF(NP3.NE.0)THEN - Y=AMIN1(P1,P2,P3/NP3) - ELSE - Y=AMIN1(P1,P2) - ENDIF - IF(Z.GT.1.0)THEN - X=Y-Y/Z**FX - ELSE - X=Y*Z**FX-Y - ENDIF - TX=TX+X -1060 CONTINUE -1160 CONTINUE - RPCADX=AMAX1(-PCAPD1,TPD*TX) - IF(PX.EQ.AH1P1)THEN - RPCAD1=RPCADX - ELSEIF(PX.EQ.AH2P1)THEN - IF(AOH1.GT.AHY1)THEN - RYCAD2=RPCADX - ELSE - RHCAD2=RPCADX - ENDIF - ENDIF -C IF((M/10)*10.EQ.M)THEN -C WRITE(*,1112)'CAPO4',I,J,M,MM,PCAPM1,PCAPD1,CCA1 -C 2,CH1P1,CH2P1,CHY1,COH1,RPCADX,RPCAD1,RYCAD2,RHCAD2,R2,P1,P2,P3 -C 3,SP,Z,FX,Y,X,TX,A2,CCA1*A2*CH1P1*A2,SPCAD -C ENDIF -C -C HYDROXYAPATITE -C - PX=AMAX1(AH1P1,AH2P1) - R2=CHY1 - P3=COH1 - P1=CCA1 - IF(PX.EQ.AH1P1)THEN - P2=CH1P1 - IF(AOH1.GT.AHY1)THEN - NR2=0 - NP3=4 - SP=SYCAH1/A14A28 - ELSE - NR2=4 - NP3=0 - SP=SHCAH1*A14A8D - ENDIF - ELSEIF(PX.EQ.AH2P1)THEN - P2=CH2P1 - IF(AOH1.GT.AHY1)THEN - NR2=0 - NP3=7 - SP=SYCAH2/A1TA25 - ELSE - NR2=7 - NP3=0 - SP=SHCAH2*A14A5D - ENDIF - ENDIF - RYCAH1=0.0 - RYCAH2=0.0 - RHCAH1=0.0 - RHCAH2=0.0 - X=0.0 - TX=0.0 - FX=1.0/(6+NR2+NR3) - DO 1070 MM=1,100 - R2=AMAX1(ZERO,R2+NR2*X) - P1=AMAX1(ZERO,P1-5.0*X) - P2=AMAX1(ZERO,P2-3.0*X) - P3=AMAX1(ZERO,P3-NP3*X) - Z=(P1**5*P2**3*P3**NP3/R2**NR2)/SP - IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 1170 - IF(Z.LE.0.95.AND.PCAPH1.LE.0.0)GO TO 1170 - IF(NR2.GT.0)THEN - Y=AMIN1(R2/NR2,P1/5,P2/3) - ELSE - Y=AMIN1(P1/5,P2/3,P3/NP3) - ENDIF - IF(Z.GT.1.0)THEN - X=Y-Y/Z**FX - ELSE - X=Y*Z**FX-Y - ENDIF - TX=TX+X -1070 CONTINUE -1170 CONTINUE - RPCAHX=AMAX1(-PCAPH1,TPD*TX) - IF(PX.EQ.AH1P1)THEN - IF(AOH1.GT.AHY1)THEN - RYCAH1=RPCAHX - ELSE - RHCAH1=RPCAHX - ENDIF - ELSEIF(PX.EQ.AH2P1)THEN - IF(AOH1.GT.AHY1)THEN - RYCAH2=RPCAHX - ELSE - RHCAH2=RPCAHX - ENDIF - ENDIF -C IF((M/10)*10.EQ.M)THEN -C WRITE(*,1112)'APATITE',I,J,M,MM,PCAPH1,CCA1 -C 2,CH1P1,CH2P1,CHY1,RPCAHX,RHCAH1,RHCAH2,R2,P1,P2,P3 -C 3,SP,Z,(CCA1*A2)**5*(CH0P1*A3)**3*COH1*A1,SPCAH -C ENDIF -C -C MONOCALCIUM PHOSPHATE -C - P1=CCA1 - P2=CH2P1 - SP=SPCAM/A12A2 - X=0.0 - TX=0.0 - DO 1080 MM=1,100 - P1=AMAX1(ZERO,P1-X) - P2=AMAX1(ZERO,P2-2*X) - Z=P1*P2**2/SP - IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 1180 - IF(Z.LE.0.95.AND.PCAPM1.LE.0.0)GO TO 1180 - Y=AMIN1(P1,P2/2) - IF(Z.GT.1.0)THEN - X=Y-Y/Z**0.33 - ELSE - X=Y*Z**0.33-Y - ENDIF - TX=TX+X -1080 CONTINUE -1180 CONTINUE - RPCAMX=AMAX1(-PCAPM1*SPPO4,TPD*TX) - ELSE - RPALPX=0.0 - RPFEPX=0.0 - RPCADX=0.0 - RPCAHX=0.0 - RYA0P1=0.0 - RYA1P1=0.0 - RYA2P1=0.0 - RYA3P1=0.0 - RYA4P1=0.0 - RYA0P2=0.0 - RYA1P2=0.0 - RYA2P2=0.0 - RYA3P2=0.0 - RYA4P2=0.0 - RHA0P1=0.0 - RHA1P1=0.0 - RHA2P1=0.0 - RHA3P1=0.0 - RHA4P1=0.0 - RHA0P2=0.0 - RHA1P2=0.0 - RHA2P2=0.0 - RHA3P2=0.0 - RHA4P2=0.0 - RYF0P1=0.0 - RYF1P1=0.0 - RYF2P1=0.0 - RYF3P1=0.0 - RYF4P1=0.0 - RYF0P2=0.0 - RYF1P2=0.0 - RYF2P2=0.0 - RYF3P2=0.0 - RYF4P2=0.0 - RHF0P1=0.0 - RHF1P1=0.0 - RHF2P1=0.0 - RHF3P1=0.0 - RHF4P1=0.0 - RHF0P2=0.0 - RHF1P2=0.0 - RHF2P2=0.0 - RHF3P2=0.0 - RHF4P2=0.0 - RPCAD1=0.0 - RYCAD2=0.0 - RHCAD2=0.0 - RYCAH1=0.0 - RYCAH2=0.0 - RHCAH1=0.0 - RHCAH2=0.0 - RPCAMX=0.0 - ENDIF -C -C PHOSPHORUS PRECIPITATION-DISSOLUTION IN BAND SOIL ZONE -C - IF(VOLWPB.GT.ZEROS(NY,NX))THEN -C -C ALUMINUM PHOSPHATE (VARISCITE) -C - AH1PB=CH1PB*A2 - AH2PB=CH2B1*A1 - PX=AMAX1(AAL1,AALO1,AALO2,AALO3,AALO4) - PY=AMAX1(AH1PB,AH2PB) - R3=CHY1 - R4=COH1 - P3=CHY1 - P4=COH1 - IF(PY.EQ.AH1PB)THEN - P2=CH1PB - IF(PX.EQ.AAL1)THEN - P1=CAL1 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=0 - NP3=0 - NP4=1 - SP=SYA0P1/A1A2A3 - ELSE - NR3=1 - NR4=0 - NP3=0 - NP4=0 - SP=SHA0P1*A1A23D - ENDIF - ELSEIF(PX.EQ.AALO1)THEN - P1=CALO1 - NR3=0 - NR4=0 - NP3=0 - NP4=0 - SP=SPA1P1/A22 - ELSEIF(PX.EQ.AALO2)THEN - P1=CALO2 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=1 - NP3=0 - NP4=0 - SP=SYA2P1/A2 - ELSE - NR3=0 - NR4=0 - NP3=1 - NP4=0 - SP=SHA2P1/A12A2 - ENDIF - ELSEIF(PX.EQ.AALO3)THEN - P1=CALO3 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=2 - NP3=0 - NP4=0 - SP=SYA3P1*A12A2D - ELSE - NR3=0 - NR4=0 - NP3=2 - NP4=0 - SP=SHA3P1/A13A2 - ENDIF - ELSEIF(PX.EQ.AALO4)THEN - P1=CALO4 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=3 - NP3=0 - NP4=0 - SP=SYA4P1*A12A2D - ELSE - NR3=0 - NR4=0 - NP3=3 - NP4=0 - SP=SHA4P1*A14A2 - ENDIF - ENDIF - ELSE - P2=CH2B1 - IF(PX.EQ.AAL1)THEN - P1=CAL1 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=0 - NP3=0 - NP4=2 - SP=SYA0P2/A13A3 - ELSE - NR3=2 - NR4=0 - NP3=0 - NP4=0 - SP=SHA0P2*A1A3D - ENDIF - ELSEIF(PX.EQ.AALO1)THEN - P1=CALO1 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=0 - NP3=0 - NP4=1 - SP=SYA1P2/A12A2 - ELSE - NR3=1 - NR4=0 - NP3=0 - NP4=0 - SP=SHA1P2/A2 - ENDIF - ELSEIF(PX.EQ.AALO2)THEN - P1=CALO2 - NR3=0 - NR4=0 - NP3=0 - NP4=0 - SP=SPA2P2/A12 - ELSEIF(PX.EQ.AALO3)THEN - P1=CALO3 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=1 - NP3=0 - NP4=0 - SP=SYA3P2 - ELSE - NR3=0 - NR4=0 - NP3=1 - NP4=0 - SP=SHA3P2/A22 - ENDIF - ELSEIF(PX.EQ.AALO4)THEN - P1=CALO4 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=2 - NP3=0 - NP4=0 - SP=SYA4P2 - ELSE - NR3=0 - NR4=0 - NP3=2 - NP4=0 - SP=SHA4P2/A14 - ENDIF - ENDIF - ENDIF - RYA0B1=0.0 - RYA1B1=0.0 - RYA2B1=0.0 - RYA3B1=0.0 - RYA4B1=0.0 - RYA0B2=0.0 - RYA1B2=0.0 - RYA2B2=0.0 - RYA3B2=0.0 - RYA4B2=0.0 - RHA0B1=0.0 - RHA1B1=0.0 - RHA2B1=0.0 - RHA3B1=0.0 - RHA4B1=0.0 - RHA0B2=0.0 - RHA1B2=0.0 - RHA2B2=0.0 - RHA3B2=0.0 - RHA4B2=0.0 - X=0.0 - TX=0.0 - FX=1.0/(2+NR3+NR4+NP3+NP4) - DO 2040 MM=1,100 - R3=AMAX1(ZERO,R3+NR3*X) - R4=AMAX1(ZERO,R4+NR4*X) - P1=AMAX1(ZERO,P1-X) - P2=AMAX1(ZERO,P2-X) - P3=AMAX1(ZERO,P3-NP3*X) - P4=AMAX1(ZERO,P4-NP4*X) - Z=(P1*P2*P3**NP3*P4**NP4/(R3**NR3*R4**NR4))/SP - IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 2140 - IF(Z.LE.0.95.AND.PALPOB.LE.0.0)GO TO 2140 - IF(NR3.NE.0)THEN - Y=AMIN1(R3/NR3,P1,P2) - ELSEIF(NR4.NE.0)THEN - Y=AMIN1(R4/NR4,P1,P2) - ELSEIF(NP3.NE.0)THEN - Y=AMIN1(P1,P2,P3/NP3) - ELSEIF(NP4.NE.0)THEN - Y=AMIN1(P1,P2,P4/NP4) - ELSE - Y=AMIN1(P1,P2) - ENDIF - IF(Z.GT.1.0)THEN - X=Y-Y/Z**FX - ELSE - X=Y*Z**FX-Y - ENDIF - TX=TX+X -2040 CONTINUE -2140 CONTINUE - RPALBX=AMAX1(-PALPOB,TPD*TX) - IF(PY.EQ.AH1PB)THEN - IF(PX.EQ.AAL1)THEN - IF(AOH1.GT.AHY1)THEN - RYA0B1=RPALBX - ELSE - RHA0B1=RPALBX - ENDIF - ELSEIF(PX.EQ.AALO1)THEN - IF(AOH1.GT.AHY1)THEN - RYA1B1=RPALBX - ELSE - RHA1B1=RPALBX - ENDIF - ELSEIF(PX.EQ.AALO2)THEN - IF(AOH1.GT.AHY1)THEN - RYA2B1=RPALBX - ELSE - RHA2B1=RPALBX - ENDIF - ELSEIF(PX.EQ.AALO3)THEN - IF(AOH1.GT.AHY1)THEN - RYA3B1=RPALBX - ELSE - RHA3B1=RPALBX - ENDIF - ELSEIF(PX.EQ.AALO4)THEN - IF(AOH1.GT.AHY1)THEN - RYA4B1=RPALBX - ELSE - RHA4B1=RPALBX - ENDIF - ENDIF - ELSE - IF(PX.EQ.AAL1)THEN - IF(AOH1.GT.AHY1)THEN - RYA0B2=RPALBX - ELSE - RHA0B2=RPALBX - ENDIF - ELSEIF(PX.EQ.AALO1)THEN - IF(AOH1.GT.AHY1)THEN - RYA1B2=RPALBX - ELSE - RHA1B2=RPALBX - ENDIF - ELSEIF(PX.EQ.AALO2)THEN - IF(AOH1.GT.AHY1)THEN - RYA2B2=RPALBX - ELSE - RHA2B2=RPALBX - ENDIF - ELSEIF(PX.EQ.AALO3)THEN - IF(AOH1.GT.AHY1)THEN - RYA3B2=RPALBX - ELSE - RHA3B2=RPALBX - ENDIF - ELSEIF(PX.EQ.AALO4)THEN - IF(AOH1.GT.AHY1)THEN - RYA4B2=RPALBX - ELSE - RHA4B2=RPALBX - ENDIF - ENDIF - ENDIF -C -C IRON PHOSPHATE (STRENGITE) -C - PX=AMAX1(AFE1,AFEO1,AFEO2,AFEO3,AFEO4) - PY=AMAX1(AH1PB,AH2PB) - R3=CHY1 - R4=COH1 - P3=CHY1 - P4=COH1 - IF(PY.EQ.AH1PB)THEN - P2=CH1PB - IF(PX.EQ.AFE1)THEN - P1=CFE1 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=0 - NP3=0 - NP4=1 - SP=SYF0P1/A1A2A3 - ELSE - NR3=1 - NR4=0 - NP3=0 - NP4=0 - SP=SHF0P1*A1A23D - ENDIF - ELSEIF(PX.EQ.AFEO1)THEN - P1=CFEO1 - NR3=0 - NR4=0 - NP3=0 - NP4=0 - SP=SPF1P1/A22 - ELSEIF(PX.EQ.AFEO2)THEN - P1=CFEO2 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=1 - NP3=0 - NP4=0 - SP=SYF2P1/A2 - ELSE - NR3=0 - NR4=0 - NP3=1 - NP4=0 - SP=SHF2P1/A12A2 - ENDIF - ELSEIF(PX.EQ.AFEO3)THEN - P1=CFEO3 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=2 - NP3=0 - NP4=0 - SP=SYF3P1*A12A2D - ELSE - NR3=0 - NR4=0 - NP3=2 - NP4=0 - SP=SHF3P1/A13A2 - ENDIF - ELSEIF(PX.EQ.AFEO4)THEN - P1=CFEO4 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=3 - NP3=0 - NP4=0 - SP=SYF4P1*A12A2D - ELSE - NR3=0 - NR4=0 - NP3=3 - NP4=0 - SP=SHF4P1*A14A2 - ENDIF - ENDIF - ELSE - P2=CH2B1 - IF(PX.EQ.AFE1)THEN - P1=CFE1 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=0 - NP3=0 - NP4=2 - SP=SYF0P2/A13A3 - ELSE - NR3=2 - NR4=0 - NP3=0 - NP4=0 - SP=SHF0P2*A1A3D - ENDIF - ELSEIF(PX.EQ.AFEO1)THEN - P1=CFEO1 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=0 - NP3=0 - NP4=1 - SP=SYF1P2/A12A2 - ELSE - NR3=1 - NR4=0 - NP3=0 - NP4=0 - SP=SHF1P2/A2 - ENDIF - ELSEIF(PX.EQ.AFEO2)THEN - P1=CFEO2 - NR3=0 - NR4=0 - NP3=0 - NP4=0 - SP=SPF2P2/A12 - ELSEIF(PX.EQ.AFEO3)THEN - P1=CFEO3 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=1 - NP3=0 - NP4=0 - SP=SYF3P2 - ELSE - NR3=0 - NR4=0 - NP3=1 - NP4=0 - SP=SHF3P2/A22 - ENDIF - ELSEIF(PX.EQ.AFEO4)THEN - P1=CFEO4 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=2 - NP3=0 - NP4=0 - SP=SYF4P2 - ELSE - NR3=0 - NR4=0 - NP3=2 - NP4=0 - SP=SHF4P2/A14 - ENDIF - ENDIF - ENDIF - RYF0B1=0.0 - RYF1B1=0.0 - RYF2B1=0.0 - RYF3B1=0.0 - RYF4B1=0.0 - RYF0B2=0.0 - RYF1B2=0.0 - RYF2B2=0.0 - RYF3B2=0.0 - RYF4B2=0.0 - RHF0B1=0.0 - RHF1B1=0.0 - RHF2B1=0.0 - RHF3B1=0.0 - RHF4B1=0.0 - RHF0B2=0.0 - RHF1B2=0.0 - RHF2B2=0.0 - RHF3B2=0.0 - RHF4B2=0.0 - X=0.0 - TX=0.0 - FX=1.0/(2+NR3+NR4+NP3+NP4) - DO 2050 MM=1,100 - R3=AMAX1(ZERO,R3+NR3*X) - R4=AMAX1(ZERO,R4+NR4*X) - P1=AMAX1(ZERO,P1-X) - P2=AMAX1(ZERO,P2-X) - P3=AMAX1(ZERO,P3-NP3*X) - P4=AMAX1(ZERO,P4-NP4*X) - Z=(P1*P2*P3**NP3*P4**NP4/(R3**NR3*R4**NR4))/SP - IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 2150 - IF(Z.LE.0.95.AND.PFEPOB.LE.0.0)GO TO 2150 - IF(NR3.NE.0)THEN - Y=AMIN1(R3/NR3,P1,P2) - ELSEIF(NR4.NE.0)THEN - Y=AMIN1(R4/NR4,P1,P2) - ELSEIF(NP3.NE.0)THEN - Y=AMIN1(P1,P2,P3/NP3) - ELSEIF(NP4.NE.0)THEN - Y=AMIN1(P1,P2,P4/NP4) - ELSE - Y=AMIN1(P1,P2) - ENDIF - IF(Z.GT.1.0)THEN - X=Y-Y/Z**FX - ELSE - X=Y*Z**FX-Y - ENDIF - TX=TX+X -2050 CONTINUE -2150 CONTINUE - RPFEBX=AMAX1(-PFEPOB,TPD*TX) - IF(PY.EQ.AH1PB)THEN - IF(PX.EQ.AFE1)THEN - IF(AOH1.GT.AHY1)THEN - RYF0B1=RPFEBX - ELSE - RHF0B1=RPFEBX - ENDIF - ELSEIF(PX.EQ.AFEO1)THEN - IF(AOH1.GT.AHY1)THEN - RYF1B1=RPFEBX - ELSE - RHF1B1=RPFEBX - ENDIF - ELSEIF(PX.EQ.AFEO2)THEN - IF(AOH1.GT.AHY1)THEN - RYF2B1=RPFEBX - ELSE - RHF2B1=RPFEBX - ENDIF - ELSEIF(PX.EQ.AFEO3)THEN - IF(AOH1.GT.AHY1)THEN - RYF3B1=RPFEBX - ELSE - RHF3B1=RPFEBX - ENDIF - ELSEIF(PX.EQ.AFEO4)THEN - IF(AOH1.GT.AHY1)THEN - RYF4B1=RPFEBX - ELSE - RHF4B1=RPFEBX - ENDIF - ENDIF - ELSE - IF(PX.EQ.AFE1)THEN - IF(AOH1.GT.AHY1)THEN - RYF0B2=RPFEBX - ELSE - RHF0B2=RPFEBX - ENDIF - ELSEIF(PX.EQ.AFEO1)THEN - IF(AOH1.GT.AHY1)THEN - RYF1B2=RPFEBX - ELSE - RHF1B2=RPFEBX - ENDIF - ELSEIF(PX.EQ.AFEO2)THEN - IF(AOH1.GT.AHY1)THEN - RYF2B2=RPFEBX - ELSE - RHF2B2=RPFEBX - ENDIF - ELSEIF(PX.EQ.AFEO3)THEN - IF(AOH1.GT.AHY1)THEN - RYF3B2=RPFEBX - ELSE - RHF3B2=RPFEBX - ENDIF - ELSEIF(PX.EQ.AFEO4)THEN - IF(AOH1.GT.AHY1)THEN - RYF4B2=RPFEBX - ELSE - RHF4B2=RPFEBX - ENDIF - ENDIF - ENDIF -C -C DICALCIUM PHOSPHATE -C - PX=AMAX1(AH1PB,AH2PB) - R2=CHY1 - P3=COH1 - P1=CCA1 - IF(PX.EQ.AH1PB)THEN - P2=CH1PB - NR2=0 - NP3=0 - SP=SPCAD/A22 - ELSEIF(PX.EQ.AH2PB)THEN - P2=CH2B1 - IF(AOH1.GT.AHY1)THEN - NR2=0 - NP3=1 - SP=SYCAD2/A12A2 - ELSE - NR2=1 - NP3=0 - SP=SHCAD2/A2 - ENDIF - ENDIF - RPCDB1=0.0 - RYCDB2=0.0 - RHCDB2=0.0 - X=0.0 - TX=0.0 - FX=1.0/(2+NR2+NP3) - DO 2060 MM=1,100 - R2=AMAX1(ZERO,R2+NR2*X) - P1=AMAX1(ZERO,P1-X) - P2=AMAX1(ZERO,P2-X) - P3=AMAX1(ZERO,P3-NP3*X) - Z=(P1*P2*P3**NP3/R2**NR2)/SP - IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 2160 - IF(Z.LE.0.95.AND.PCAPDB.LE.0.0)GO TO 2160 - IF(NR2.NE.0)THEN - Y=AMIN1(R2/NR2,P1,P2) - ELSEIF(NP3.NE.0)THEN - Y=AMIN1(P1,P2,P3/NP3) - ELSE - Y=AMIN1(P1,P2) - ENDIF - IF(Z.GT.1.0)THEN - X=Y-Y/Z**FX - ELSE - X=Y*Z**FX-Y - ENDIF - TX=TX+X -2060 CONTINUE -2160 CONTINUE - RPCDBX=AMAX1(-PCAPDB,TPD*TX) - IF(PX.EQ.AH1PB)THEN - RPCDB1=RPCDBX - ELSEIF(PX.EQ.AH2PB)THEN - IF(AOH1.GT.AHY1)THEN - RYCDB2=RPCDBX - ELSE - RHCDB2=RPCDBX - ENDIF - ENDIF -C -C HYDROXYAPATITE -C - PX=AMAX1(AH1PB,AH2PB) - R2=CHY1 - P3=COH1 - P1=CCA1 - IF(PX.EQ.AH1PB)THEN - P2=CH1PB - IF(AOH1.GT.AHY1)THEN - NR2=0 - NP3=4 - SP=SYCAH1/A14A28 - ELSE - NR2=4 - NP3=0 - SP=SHCAH1*A14A8D - ENDIF - ELSEIF(PX.EQ.AH2PB)THEN - P2=CH2B1 - IF(AOH1.GT.AHY1)THEN - NR2=0 - NP3=7 - SP=SYCAH2/A1TA25 - ELSE - NR2=7 - NP3=0 - SP=SHCAH2*A14A5D - ENDIF - ENDIF - RYCHB1=0.0 - RYCHB2=0.0 - RHCHB1=0.0 - RHCHB2=0.0 - X=0.0 - TX=0.0 - FX=1.0/(6+NR2+NR3) - DO 2070 MM=1,100 - R2=AMAX1(ZERO,R2+NR2*X) - P1=AMAX1(ZERO,P1-5.0*X) - P2=AMAX1(ZERO,P2-3.0*X) - P3=AMAX1(ZERO,P3-NP3*X) - Z=(P1**5*P2**3*P3**NP3/R2**NR2)/SP - IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 2170 - IF(Z.LE.0.95.AND.PCAPHB.LE.0.0)GO TO 2170 - IF(NR2.GT.0)THEN - Y=AMIN1(R2/NR2,P1/5,P2/3) - ELSE - Y=AMIN1(P1/5,P2/3,P3/NP3) - ENDIF - IF(Z.GT.1.0)THEN - X=Y-Y/Z**FX - ELSE - X=Y*Z**FX-Y - ENDIF - TX=TX+X -2070 CONTINUE -2170 CONTINUE - RPCHBX=AMAX1(-PCAPHB,TPD*TX) - IF(PX.EQ.AH1PB)THEN - IF(AOH1.GT.AHY1)THEN - RYCHB1=RPCHBX - ELSE - RHCHB1=RPCHBX - ENDIF - ELSEIF(PX.EQ.AH2PB)THEN - IF(AOH1.GT.AHY1)THEN - RYCHB2=RPCHBX - ELSE - RHCHB2=RPCHBX - ENDIF - ENDIF -C -C MONOCALCIUM PHOSPHATE -C - P1=CCA1 - P2=CH2B1 - SP=SPCAM/A12A2 - X=0.0 - TX=0.0 - DO 2080 MM=1,100 - P1=AMAX1(ZERO,P1-X) - P2=AMAX1(ZERO,P2-2*X) - Z=P1*P2**2/SP - IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 2180 - IF(Z.LE.0.95.AND.PCAPMB.LE.0.0)GO TO 2180 - Y=AMIN1(P1,P2/2) - IF(Z.GT.1.0)THEN - X=Y-Y/Z**0.33 - ELSE - X=Y*Z**0.33-Y - ENDIF - TX=TX+X -2080 CONTINUE -2180 CONTINUE - RPCMBX=AMAX1(-PCAPMB*SPPO4,TPD*TX) - ELSE - RPALBX=0.0 - RPFEBX=0.0 - RPCDBX=0.0 - RPCHBX=0.0 - RPCMBX=0.0 - RYA0B1=0.0 - RYA1B1=0.0 - RYA2B1=0.0 - RYA3B1=0.0 - RYA4B1=0.0 - RYA0B2=0.0 - RYA1B2=0.0 - RYA2B2=0.0 - RYA3B2=0.0 - RYA4B2=0.0 - RHA0B1=0.0 - RHA1B1=0.0 - RHA2B1=0.0 - RHA3B1=0.0 - RHA4B1=0.0 - RHA0B2=0.0 - RHA1B2=0.0 - RHA2B2=0.0 - RHA3B2=0.0 - RHA4B2=0.0 - RYF0B1=0.0 - RYF1B1=0.0 - RYF2B1=0.0 - RYF3B1=0.0 - RYF4B1=0.0 - RYF0B2=0.0 - RYF1B2=0.0 - RYF2B2=0.0 - RYF3B2=0.0 - RYF4B2=0.0 - RHF0B1=0.0 - RHF1B1=0.0 - RHF2B1=0.0 - RHF3B1=0.0 - RHF4B1=0.0 - RHF0B2=0.0 - RHF1B2=0.0 - RHF2B2=0.0 - RHF3B2=0.0 - RHF4B2=0.0 - RPCDB1=0.0 - RYCDB2=0.0 - RHCDB2=0.0 - RYCHB1=0.0 - RYCHB2=0.0 - RHCHB1=0.0 - RHCHB2=0.0 - ENDIF -C -C PHOSPHORUS ANION EXCHANGE IN NON-BAND SOIL ZONE -C CALCULATED FROM EXCHANGE EQUILIBRIA AMONG H2PO4-, -C HPO4--, H+, OH- AND PROTONATED AND NON-PROTONATED -OH -C EXCHANGE SITES -C - IF(VOLWPO.GT.ZEROS(NY,NX) - 2.AND.AEC(L,NY,NX).GT.ZEROS(NY,NX))THEN -C - -C PROTONATION OF ANION EXCHANGE SITES IN NON-BAND SOIL ZONE -C - DCHG=AMAX1(-0.1E+05,XOH21-XOH01-XH1P1) - AEP=EXP(AE*DCHG/TKS(L,NY,NX)) - AEN=EXP(-AE*DCHG/TKS(L,NY,NX)) - SPOH2=SXOH2*AEP/A1 - X0=XOH11+CHY1+SPOH2 - X1=AMAX1(0.0,X0**2-4.0*(XOH11*CHY1-SPOH2*XOH21)) - RXOH2=TADAX*(X0-SQRT(X1)) - SPOH1=SXOH1/(AEN*A1) - X0=XOH01+CHY1+SPOH1 - X1=AMAX1(0.0,X0**2-4.0*(XOH01*CHY1-SPOH1*XOH11)) - RXOH1=TADAX*(X0-SQRT(X1)) -C -C H2PO4 EXCHANGE IN NON-BAND SOIL ZONE FROM CONVERGENCE -C SOLUTION FOR EQUILIBRIUM AMONG H2PO4-, H+, OH-, X-OH -C AND X-H2PO4 -C - SPH2P=SYH2P*DPH2O/(SXOH2*AEP*A1) - X0=XOH21+CH2P1+SPH2P - X1=AMAX1(0.0,X0**2-4.0*(XOH21*CH2P1-SPH2P*XH2P1)) - RXH2P=TADAX*(X0-SQRT(X1)) - R1=XH2P1 - R2=COH1 - P1=XOH11 - P2=CH2P1 - P3=CHY1 - IF(AOH1.GT.AHY1)THEN - NR2=1 - NP3=0 - SP=SYH2P - ELSE - NR2=0 - NP3=1 - SP=SHH2P/A12 - ENDIF - RYH2P=0.0 - RHH2P=0.0 - X=0.0 - TX=0.0 - DO 4010 MM=1,100 - R1=AMAX1(ZERO,R1+X) - R2=AMAX1(ZERO,R2+NR2*X) - P1=AMAX1(ZERO,P1-X) - P2=AMAX1(ZERO,P2-X) - P3=AMAX1(ZERO,P3-NP3*X) - Z=(P1*P2*P3**NP3/(R1*R2**NR2))/SP - IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 4110 - IF(NR2.GT.0)THEN - Y=AMIN1(R1,R2/NR2,P1,P2) - ELSE - Y=AMIN1(R1,P1,P2,P3/NP3) - ENDIF - IF(Z.GT.1.0)THEN - X=Y-Y/Z**0.25 - ELSE - X=Y*Z**0.25-Y - ENDIF - TX=TX+X -4010 CONTINUE -4110 CONTINUE - IF(AOH1.GT.AHY1)THEN - RYH2P=TADAX*TX - ELSE - RHH2P=TADAX*TX - ENDIF -C -C HPO4 EXCHANGE IN NON-BAND SOIL ZONE FROM CONVERGENCE -C SOLUTION FOR EQUILIBRIUM AMONG HPO4--, H+, OH-, X-OH -C AND X-HPO4 -C - R1=XH1P1 - R2=COH1 - P1=XOH11 - P2=CH1P1 - P3=CHY1 - IF(AOH1.GT.AHY1)THEN - NR2=1 - NP3=0 - SP=SYH1P*AEN*A1A2D - ELSE - NR2=0 - NP3=1 - SP=SHH1P*AEN/A1A2 - ENDIF - RYH1P=0.0 - RHH1P=0.0 - X=0.0 - TX=0.0 - DO 4020 MM=1,100 - R1=AMAX1(ZERO,R1+X) - R2=AMAX1(ZERO,R2+NR2*X) - P1=AMAX1(ZERO,P1-X) - P2=AMAX1(ZERO,P2-X) - P3=AMAX1(ZERO,P3-NP3*X) - Z=(P1*P2*P3**NP3/(R1*R2**NR2))/SP - IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 4120 - IF(NR2.GT.0)THEN - Y=AMIN1(R1,R2/NR2,P1,P2) - ELSE - Y=AMIN1(R1,P1,P2,P3/NP3) - ENDIF - IF(Z.GT.1.0)THEN - X=Y-Y/Z**0.25 - ELSE - X=Y*Z**0.25-Y - ENDIF - TX=TX+X -4020 CONTINUE -4120 CONTINUE - IF(AOH1.GT.AHY1)THEN - RYH1P=TADAX*TX - ELSE - RHH1P=TADAX*TX - ENDIF - ELSE - RXOH2=0.0 - RXOH1=0.0 - RXH2P=0.0 - RYH2P=0.0 - RYH1P=0.0 - RHH2P=0.0 - RHH1P=0.0 - ENDIF -C -C PHOSPHORUS ANION EXCHANGE IN BAND SOIL ZONE -C CALCULATED FROM EXCHANGE EQUILIBRIA AMONG H2PO4-, -C HPO4--, H+, OH- AND PROTONATED AND NON-PROTONATED -OH -C EXCHANGE SITES -C - IF(VOLWPB.GT.ZEROS(NY,NX) - 2.AND.AEC(L,NY,NX).GT.ZEROS(NY,NX))THEN -C -C PROTONATION OF EXCHANGE SITES IN BAND SOIL ZONE -C - DCHG=AMAX1(-0.1E+05,XH21B-XH01B-X1P1B) - AEP=EXP(AE*DCHG/TKS(L,NY,NX)) - AEN=EXP(-AE*DCHG/TKS(L,NY,NX)) - SPOH2=SXOH2*AEP/A1 - - X0=XH11B+CHY1+SPOH2 - X1=AMAX1(0.0,X0**2-4.0*(XH11B*CHY1-SPOH2*XH21B)) - RXO2B=TADAX*(X0-SQRT(X1)) - SPOH1=SXOH1/(AEN*A1) - X0=XH01B+CHY1+SPOH1 - X1=AMAX1(0.0,X0**2-4.0*(XH01B*CHY1-SPOH1*XH11B)) - RXO1B=TADAX*(X0-SQRT(X1)) -C -C H2PO4 EXCHANGE IN BAND SOIL ZONE FROM CONVERGENCE -C SOLUTION FOR EQUILIBRIUM AMONG H2PO4-, H+, OH-, X-OH -C AND X-H2PO4 -C - SPH2P=SYH2P*DPH2O/(SXOH2*AEP*A1) - X0=XH21B+CH2B1+SPH2P - X1=AMAX1(0.0,X0**2-4.0*(XH21B*CH2B1-SPH2P*X2P1B)) - RXH2B=TADAX*(X0-SQRT(X1)) - R1=X2P1B - R2=COH1 - P1=XH11B - P2=CH2B1 - P3=CHY1 - IF(AOH1.GT.AHY1)THEN - NR2=1 - NP3=0 - SP=SYH2P - ELSE - NR2=0 - NP3=1 - SP=SHH2P/A12 - ENDIF - RYH2B=0.0 - RHH2B=0.0 - X=0.0 - TX=0.0 - DO 5010 MM=1,100 - R1=AMAX1(ZERO,R1+X) - R2=AMAX1(ZERO,R2+NR2*X) - P1=AMAX1(ZERO,P1-X) - P2=AMAX1(ZERO,P2-X) - P3=AMAX1(ZERO,P3-NP3*X) - Z=(P1*P2*P3**NP3/(R1*R2**NR2))/SP - IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 5110 - IF(NR2.GT.0)THEN - Y=AMIN1(R1,R2/NR2,P1,P2) - ELSE - Y=AMIN1(R1,P1,P2,P3/NP3) - ENDIF - IF(Z.GT.1.0)THEN - X=Y-Y/Z**0.25 - ELSE - X=Y*Z**0.25-Y - ENDIF - TX=TX+X -5010 CONTINUE -5110 CONTINUE - IF(AOH1.GT.AHY1)THEN - RYH2B=TADAX*TX - ELSE - RHH2B=TADAX*TX - ENDIF -C -C HPO4 EXCHANGE IN BAND SOIL ZONE FROM CONVERGENCE -C SOLUTION FOR EQUILIBRIUM AMONG HPO4--, H+, OH-, X-OH -C AND X-HPO4 -C - R1=X1P1B - R2=COH1 - P1=XH11B - P2=CH1PB - P3=CHY1 - IF(AOH1.GT.AHY1)THEN - NR2=1 - NP3=0 - SP=SYH1P*AEN*A1A2D - ELSE - NR2=0 - NP3=1 - SP=SHH1P*AEN/A1A2 - ENDIF - RYH1B=0.0 - RHH1B=0.0 - X=0.0 - TX=0.0 - DO 5020 MM=1,100 - R1=AMAX1(ZERO,R1+X) - R2=AMAX1(ZERO,R2+NR2*X) - P1=AMAX1(ZERO,P1-X) - P2=AMAX1(ZERO,P2-X) - P3=AMAX1(ZERO,P3-NP3*X) - Z=(P1*P2*P3**NP3/(R1*R2**NR2))/SP - IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 5120 - IF(NR2.GT.0)THEN - Y=AMIN1(R1,R2/NR2,P1,P2) - ELSE - Y=AMIN1(R1,P1,P2,P3/NP3) - ENDIF - IF(Z.GT.1.0)THEN - X=Y-Y/Z**0.25 - ELSE - X=Y*Z**0.25-Y - ENDIF - TX=TX+X -5020 CONTINUE -5120 CONTINUE - IF(AOH1.GT.AHY1)THEN - RYH1B=TADAX*TX - ELSE - RHH1B=TADAX*TX - ENDIF - ELSE - RXO2B=0.0 - RXO1B=0.0 - RXH2B=0.0 - RYH2B=0.0 - RYH1B=0.0 - RHH2B=0.0 - RHH1B=0.0 - ENDIF -C -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 -C -C CATION CONCENTRATIONS -C - CN4X=CN41 - CNBX=CN4B - CHYX=CHY1 - CALX=CAL1**0.333 - CCAX=CCA1**0.500 - CMGX=CMG1**0.500 - CNAX=CNA1 - CKAX=CKA1 -C -C GAPON COEFFICIENTS FROM SOIL FILE ADJUSTED -C FOR ACTIVITY COEFFICIENTS -C - GKCHX=GKCH(L,NY,NX)*A1A2QD - GKC4X=GKC4(L,NY,NX)*A1A2QD - GKCAX=GKCA(L,NY,NX)*A3C/A2Q - GKCMX=GKCM(L,NY,NX) - GKCNX=GKCN(L,NY,NX)*A1A2QD - GKCKX=GKCK(L,NY,NX)*A1A2QD -C -C EQUILIBRIUM X-CA CONCENTRATION FROM CEC AND CATION -C CONCENTRATIONS -C - XCAQ=CCEC/(1.0+GKC4X*CN4X/CCAX*VLNH4(L,NY,NX)+GKC4X*CNBX/CCAX - 2*VLNHB(L,NY,NX)+GKCHX*CHYX/CCAX+GKCAX*CALX/CCAX+GKCMX*CMGX/CCAX - 3+GKCNX*CNAX/CCAX+GKCKX*CKAX/CCAX) - FCAQ=XCAQ/CCAX - FN4X=FCAQ*GKC4X - FHYX=FCAQ*GKCHX - FALX=FCAQ*GKCAX/3.0 - FCAX=FCAQ*0.5 - FMGX=FCAQ*GKCMX*0.5 - FNAX=FCAQ*GKCNX - FKAX=FCAQ*GKCKX -C -C NH4 EXCHANGE IN NON-BAND AND BAND SOIL ZONES -C - RXN4=TADCX*(FN4X*CN4X-XN41)/(1.0+FN4X) - RXNB=TADCX*(FN4X*CNBX-XN4B)/(1.0+FN4X) -C -C H EXCHANGE -C - RXHY=TADCX*(FHYX*CHYX-XHY1)/(1.0+FHYX) -C -C AL EXCHANGE -C - E=XAL1 - C=CAL1 - X=0.0 - TX=0.0 - DO 3010 MM=1,100 - E=AMAX1(ZERO,E+X) - C=AMAX1(ZERO,C-X) - Z=(C**0.333/E)*FALX - IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 3110 - Y=AMIN1(E,C) - IF(Z.GT.1.0)THEN - X=Y-Y/Z**0.75 - ELSE - X=Y*Z**0.75-Y - ENDIF - TX=TX+X -3010 CONTINUE -3110 CONTINUE - RXAL=TADCX*TX -C -C CA EXCHANGE -C - E=XCA1 - C=CCA1 - X=0.0 - TX=0.0 - DO 3020 MM=1,100 - E=AMAX1(ZERO,E+X) - C=AMAX1(ZERO,C-X) - Z=(C**0.50/E)*FCAX - IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 3120 - Y=AMIN1(E,C) - IF(Z.GT.1.0)THEN - X=Y-Y/Z**0.67 - ELSE - X=Y*Z**0.67-Y - ENDIF - TX=TX+X -3020 CONTINUE -3120 CONTINUE - RXCA=TADCX*TX -C -C MG EXCHANGE -C - E=XMG1 - C=CMG1 - X=0.0 - TX=0.0 - DO 3030 MM=1,100 - E=AMAX1(ZERO,E+X) - C=AMAX1(ZERO,C-X) - Z=(C**0.50/E)*FMGX - IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 3130 - Y=AMIN1(E,C) - IF(Z.GT.1.0)THEN - X=Y-Y/Z**0.67 - ELSE - X=Y*Z**0.67-Y - ENDIF - TX=TX+X -3030 CONTINUE -3130 CONTINUE - RXMG=TADCX*TX -C -C NA EXCHANGE -C - RXNA=TADCX*(FNAX*CNAX-XNA1)/(1.0+FNAX) -C -C K EXCHANGE -C - RXKA=TADCX*(FKAX*CKAX-XKA1)/(1.0+FKAX) - ELSE - RXN4=0.0 - RXNB=0.0 - RXHY=0.0 - RXAL=0.0 - RXCA=0.0 - RXMG=0.0 - RXNA=0.0 - RXKA=0.0 - ENDIF -C -C DISSOCIATION OF CARBOXYL RADICALS AND ADSORPTION OF AL(OH)2 -C - DP=DPCOH/A1 - S0=CHY1+XCOO+DP - S1=AMAX1(0.0,S0**2-4.0*(CHY1*XCOO-DP*XHC1)) - RXHC=TADCX*(S0-SQRT(S1)) - DP=DPALO/A1 - S0=CALO2+XCOO+DP - S1=AMAX1(0.0,S0**2-4.0*(CALO2*XCOO-DP*XALO21)) - RXALO2=TADAX*(S0-SQRT(S1)) -C -C NH4-NH3+H IN NON-BAND AND BAND SOIL ZONES -C - IF(VOLWNH.GT.ZEROS(NY,NX))THEN - DP=DPN4/A0 - S0=CHY1+CN31+DP - S1=AMAX1(0.0,S0**2-4.0*(CHY1*CN31-DP*CN41)) - RNH4=TSLX*(S0-SQRT(S1)) - ELSE - RNH4=0.0 - ENDIF - IF(VOLWNB.GT.ZEROS(NY,NX))THEN - DP=DPN4/A0 - S0=CHY1+CN3B+DP - S1=AMAX1(0.0,S0**2-4.0*(CHY1*CN3B-DP*CN4B)) - RNHB=TSLX*(S0-SQRT(S1)) - ELSE - RNHB=0.0 - ENDIF -C -C CO2-H+HCO3 -C - DP=DPCO2*A0A12 - S0=CHY1+CHCO31+DP - S1=AMAX1(0.0,S0**2-4.0*(CHY1*CHCO31-DP*CCO21)) - RCO2Q=TSLX*(S0-SQRT(S1)) -C -C HCO3-H+CO3 -C - DP=DPHCO/A2 - S0=CHY1+CCO31+DP - S1=AMAX1(0.0,S0**2-4.0*(CHY1*CCO31-DP*CHCO31)) - RHCO3=TSLX*(S0-SQRT(S1)) -C -C ALOH-AL+OH -C - DP=DPAL1*A2A13D - S0=CAL1+COH1+DP - S1=AMAX1(0.0,S0**2-4.0*(CAL1*COH1-DP*CALO1)) - RALO1=TSLX*(S0-SQRT(S1)) -C -C AL(OH)2-ALOH+OH -C - DP=DPAL2/A2 - S0=CALO1+COH1+DP - S1=AMAX1(0.0,S0**2-4.0*(CALO1*COH1-DP*CALO2)) - RALO2=TSLX*(S0-SQRT(S1)) -C -C AL(OH)3-AL(OH)2+OH -C - DP=DPAL3*A0A12 - S0=CALO2+COH1+DP - S1=AMAX1(0.0,S0**2-4.0*(CALO2*COH1-DP*CALO3)) - RALO3=TSLX*(S0-SQRT(S1)) -C -C AL(OH)4-AL(OH)3+OH -C - DP=DPAL4/A0 - S0=CALO3+COH1+DP - S1=AMAX1(0.0,S0**2-4.0*(CALO3*COH1-DP*CALO4)) - RALO4=TSLX*(S0-SQRT(S1)) -C -C ALSO4-AL+SO4 -C - DP=DPALS*A1A23D - S0=CAL1+CSO41+DP - S1=AMAX1(0.0,S0**2-4.0*(CAL1*CSO41-DP*CALS1)) - RALS=TSLX*(S0-SQRT(S1)) -C -C FEOH-FE+OH -C - DP=DPFE1*A2A13D - S0=CFE1+COH1+DP - S1=AMAX1(0.0,S0**2-4.0*(CFE1*COH1-DP*CFEO1)) - RFEO1=TSLX*(S0-SQRT(S1)) -C -C FE(OH)2-FEOH+OH -C - DP=DPFE2/A2 - S0=CFEO1+COH1+DP - S1=AMAX1(0.0,S0**2-4.0*(CFEO1*COH1-DP*CFEO2)) - RFEO2=TSLX*(S0-SQRT(S1)) -C -C FE(OH)3-FE(OH)2+OH -C - DP=DPFE3*A0A12 - S0=CFEO2+COH1+DP - S1=AMAX1(0.0,S0**2-4.0*(CFEO2*COH1-DP*CFEO3)) - RFEO3=TSLX*(S0-SQRT(S1)) -C -C AL(OH)4-AL(OH)3+OH -C - DP=DPFE4/A0 - S0=CFEO3+COH1+DP - S1=AMAX1(0.0,S0**2-4.0*(CFEO3*COH1-DP*CFEO4)) - RFEO4=TSLX*(S0-SQRT(S1)) -C -C FESO4-FE+SO4 -C - DP=DPFES*A1A23D - S0=CFE1+CSO41+DP - S1=AMAX1(0.0,S0**2-4.0*(CFE1*CSO41-DP*CFES1)) - RFES=TSLX*(S0-SQRT(S1)) -C -C CAOH-CA+OH -C - DP=DPCAO/A2 - S0=CCA1+COH1+DP - S1=AMAX1(0.0,S0**2-4.0*(CCA1*COH1-DP*CCAO1)) - RCAO=TSLX*(S0-SQRT(S1)) -C -C CACO3-CA+CO3 -C - DP=DPCAC*A0A22 - S0=CCA1+CCO31+DP - S1=AMAX1(0.0,S0**2-4.0*(CCA1*CCO31-DP*CCAC1)) - RCAC=TSLX*(S0-SQRT(S1)) -C -C CAHCO3-CA+HCO3 -C - DP=DPCAH/A2 - S0=CCA1+CHCO31+DP - S1=AMAX1(0.0,S0**2-4.0*(CCA1*CHCO31-DP*CCAH1)) - RCAH=TSLX*(S0-SQRT(S1)) -C -C CASO4-CA+SO4 -C - DP=DPCAS*A0A22 - S0=CCA1+CSO41+DP - S1=AMAX1(0.0,S0**2-4.0*(CCA1*CSO41-DP*CCAS1)) - RCAS=TSLX*(S0-SQRT(S1)) -C -C MGOH-MG+OH -C - DP=DPMGO/A2 - S0=CMG1+COH1+DP - S1=AMAX1(0.0,S0**2-4.0*(CMG1*COH1-DP*CMGO1)) - RMGO=TSLX*(S0-SQRT(S1)) -C -C MGCO3-MG+CO3 -C - DP=DPMGC*A0A22 - S0=CMG1+CCO31+DP - S1=AMAX1(0.0,S0**2-4.0*(CMG1*CCO31-DP*CMGC1)) - RMGC=TSLX*(S0-SQRT(S1)) -C -C MGHCO3-MG+HCO3 -C - DP=DPMGH/A2 - S0=CMG1+CHCO31+DP - S1=AMAX1(0.0,S0**2-4.0*(CMG1*CHCO31-DP*CMGH1)) - RMGH=TSLX*(S0-SQRT(S1)) -C -C MGSO4-MG+SO4 -C - DP=DPMGS*A0A22 - S0=CMG1+CSO41+DP - S1=AMAX1(0.0,S0**2-4.0*(CMG1*CSO41-DP*CMGS1)) - RMGS=TSLX*(S0-SQRT(S1)) -C -C NACO3-NA+CO3 -C - DP=DPNAC/A2 - S0=CNA1+CCO31+DP - S1=AMAX1(0.0,S0**2-4.0*(CNA1*CCO31-DP*CNAC1)) - RNAC=TSLX*(S0-SQRT(S1)) -C -C NASO4-NA+SO4 -C - DP=DPNAS/A2 - S0=CNA1+CSO41+DP - S1=AMAX1(0.0,S0**2-4.0*(CNA1*CSO41-DP*CNAS1)) - RNAS=TSLX*(S0-SQRT(S1)) -C -C KSO4-K+SO4 -C - DP=DPKAS/A2 - S0=CKA1+CSO41+DP - S1=AMAX1(0.0,S0**2-4.0*(CKA1*CSO41-DP*CKAS1)) - RKAS=TSLX*(S0-SQRT(S1)) -C -C PHOSPHORUS IN NON-BAND SOIL ZONE -C - IF(VOLWPO.GT.ZEROS(NY,NX))THEN -C -C HPO4-H+PO4 -C - DP=DPH1P*A2A13D - S0=CH0P1+CHY1+DP - S1=AMAX1(0.0,S0**2-4.0*(CH0P1*CHY1-DP*CH1P1)) - RH1P=TSLX*(S0-SQRT(S1)) -C -C H2PO4-H+HPO4 -C - DP=DPH2P/A2 - S0=CH1P1+CHY1+DP - S1=AMAX1(0.0,S0**2-4.0*(CH1P1*CHY1-DP*CH2P1)) - RH2P=TSLX*(S0-SQRT(S1)) -C IF(NY.EQ.5.AND.L.EQ.10)THEN -C WRITE(*,22)'RH2P',I,J,NX,NY,L,M,RH2P,TSLX,S0,S1,DP,DPH2P,A2 -C 2,CH1P1,CHY1,CH2P1,H2PO4(L,NY,NX),VOLWPX,RH2PX,XH2PS(L,NY,NX) -C 3,TUPH2P(L,NY,NX) -22 FORMAT(A8,6I4,60E12.4) -C ENDIF -C -C H3PO4-H+H2PO4 -C - DP=DPH3P*A0A12 - S0=CH2P1+CHY1+DP - S1=AMAX1(0.0,S0**2-4.0*(CH2P1*CHY1-DP*CH3P1)) - RH3P=TSLX*(S0-SQRT(S1)) -C -C FEHPO4-FE+HPO4 -C - DP=DPF1P*A1A23D - S0=CFE1+CH1P1+DP - S1=AMAX1(0.0,S0**2-4.0*(CFE1*CH1P1-DP*CF1P1)) - RF1P=TSLX*(S0-SQRT(S1)) -C -C FEH2PO4-FE+H2PO4 -C - DP=DPF2P*A2A13D - S0=CFE1+CH2P1+DP - S1=AMAX1(0.0,S0**2-4.0*(CFE1*CH2P1-DP*CF2P1)) - RF2P=TSLX*(S0-SQRT(S1)) -C -C CAPO4-CA+PO4 -C - DP=DPC0P*A1A23D - S0=CCA1+CH0P1+DP - S1=AMAX1(0.0,S0**2-4.0*(CCA1*CH0P1-DP*CC0P1)) - RC0P=TSLX*(S0-SQRT(S1)) -C -C CAHPO4-CA+HPO4 -C - DP=DPC1P*A0A22 - S0=CCA1+CH1P1+DP - S1=AMAX1(0.0,S0**2-4.0*(CCA1*CH1P1-DP*CC1P1)) - RC1P=TSLX*(S0-SQRT(S1)) -C -C CAH2PO4-CA+H2PO4 -C - DP=DPC2P/A2 - S0=CCA1+CH2P1+DP - S1=AMAX1(0.0,S0**2-4.0*(CCA1*CH2P1-DP*CC2P1)) - RC2P=TSLX*(S0-SQRT(S1)) -C -C MGHPO4-MG+HPO4 -C - DP=DPM1P*A0A22 - S0=CMG1+CH1P1+DP - S1=AMAX1(0.0,S0**2-4.0*(CMG1*CH1P1-DP*CM1P1)) - RM1P=TSLX*(S0-SQRT(S1)) - ELSE - RH1P=0.0 - RH2P=0.0 - RH3P=0.0 - RF1P=0.0 - RF2P=0.0 - RC0P=0.0 - RC1P=0.0 - RC2P=0.0 - RM1P=0.0 - ENDIF -C -C PHOSPHORUS IN BAND SOIL ZONE -C - IF(VOLWPB.GT.ZEROS(NY,NX))THEN -C -C HPO4-H+PO4 -C - DP=DPH1P*A2A13D - S0=CH0PB+CHY1+DP - S1=AMAX1(0.0,S0**2-4.0*(CH0PB*CHY1-DP*CH1PB)) - RH1B=TSLX*(S0-SQRT(S1)) -C -C H2PO4-H+HPO4 -C - DP=DPH2P/A2 - S0=CH1PB+CHY1+DP - S1=AMAX1(0.0,S0**2-4.0*(CH1PB*CHY1-DP*CH2B1)) - RH2B=TSLX*(S0-SQRT(S1)) -C -C H3PO4-H+H2PO4 -C - DP=DPH3P*A0A12 - S0=CH2B1+CHY1+DP - S1=AMAX1(0.0,S0**2-4.0*(CH2B1*CHY1-DP*CH3PB)) - RH3B=TSLX*(S0-SQRT(S1)) -C -C FEHPO4-FE+HPO4 -C - DP=DPF1P*A1A23D - S0=CFE1+CH1PB+DP - S1=AMAX1(0.0,S0**2-4.0*(CFE1*CH1PB-DP*CF1PB)) - RF1B=TSLX*(S0-SQRT(S1)) -C -C FEH2PO4-FE+H2PO4 -C - DP=DPF2P*A2A13D - S0=CFE1+CH2B1+DP - S1=AMAX1(0.0,S0**2-4.0*(CFE1*CH2B1-DP*CF2PB)) - RF2B=TSLX*(S0-SQRT(S1)) -C -C CAPO4-CA+PO4 -C - DP=DPC0P*A1A23D - S0=CCA1+CH0PB+DP - S1=AMAX1(0.0,S0**2-4.0*(CCA1*CH0PB-DP*CC0PB)) - RC0B=TSLX*(S0-SQRT(S1)) -C -C CAHPO4-CA+HPO4 -C - DP=DPC1P*A0A22 - S0=CCA1+CH1PB+DP - S1=AMAX1(0.0,S0**2-4.0*(CCA1*CH1PB-DP*CC1PB)) - RC1B=TSLX*(S0-SQRT(S1)) -C -C CAH2PO4-CA+H2PO4 -C - DP=DPC2P/A2 - S0=CCA1+CH2B1+DP - S1=AMAX1(0.0,S0**2-4.0*(CCA1*CH2B1-DP*CC2PB)) - RC2B=TSLX*(S0-SQRT(S1)) -C -C MGHPO4-MG+HPO4 -C - DP=DPM1P*A0A22 - S0=CMG1+CH1PB+DP - S1=AMAX1(0.0,S0**2-4.0*(CMG1*CH1PB-DP*CM1PB)) - RM1B=TSLX*(S0-SQRT(S1)) - ELSE - RH1B=0.0 - RH2B=0.0 - RH3B=0.0 - RF1B=0.0 - RF2B=0.0 - RC0B=0.0 - RC1B=0.0 - RC2B=0.0 - RM1B=0.0 - ENDIF -C -C TOTAL ION FLUXES FOR CURRENT ITERATION -C FROM ALL REACTIONS ABOVE -C - RN4S=RNH4-RXN4 - RN4B=RNHB-RXNB - RN3S=-RNH4 - RN3B=-RNHB - RAL=-RYAL1-RHAL1-RXAL-RALO1-RALS - 2-(RYA0P1+RHA0P1+RYA0P2+RHA0P2)*VLPO4(L,NY,NX) - 3-(RYA0B1+RHA0B1+RYA0B2+RHA0B2)*VLPOB(L,NY,NX) - RFE=-RYFE1-RHFE1-RFEO1-RFES - 2-(RYF0P1+RHF0P1+RYF0P2+RHF0P2+RF1P+RF2P)*VLPO4(L,NY,NX) - 2-(RYF0B1+RHF0B1+RYF0B2+RHF0B2+RF1B+RF2B)*VLPOB(L,NY,NX) - RHY=-RXHY-RXHC+2.0*(RHALO1+RHFEO1+RHCACO - 2+(RHA0P2+RHF0P2-RHA3P1-RHA4P2-RHF3P1-RHF4P2)*VLPO4(L,NY,NX) - 3+(RHA0B2+RHF0B2-RHA3B1-RHA4B2-RHF3B1-RHF4B2)*VLPOB(L,NY,NX)) - 4+3.0*(RHAL1+RHFE1 - 5-(RHA4P1+RHF4P1)*VLPO4(L,NY,NX) - 6-(RHF4B1+RHA4B1)*VLPOB(L,NY,NX)) - 7+4.0*(RHCAH1*VLPO4(L,NY,NX)+RHCHB1*VLPOB(L,NY,NX)) - 8+7.0*(RHCAH2*VLPO4(L,NY,NX)+RHCHB2*VLPOB(L,NY,NX)) - 9+RHALO2+RHFEO2-RHALO4-RHFEO4+RHCACH-RCO2Q-RHCO3 - 1+(RHA0P1-RHA2P1+RHA1P2-RHA3P2+RHF0P1-RHF2P1+RHF1P2-RHF3P2 - 2+RHCAD2-RXOH2-RXOH1-RHH2P-RHH1P-RH1P-RH2P-RH3P)*VLPO4(L,NY,NX) - 3+(RHA0B1-RHA2B1+RHA1B2-RHA3B2+RHF0B1-RHF2B1+RHF1B2-RHF3B2 - 4+RHCDB2-RXO2B-RXO1B-RHH2B-RHH1B-RH1B-RH2B-RH3B)*VLPOB(L,NY,NX) - 5-RNH4*VLNH4(L,NY,NX)-RNHB*VLNHB(L,NY,NX) - RCA=-RPCACX-RPCASO-RXCA-RCAO-RCAC-RCAH-RCAS - 2-(RPCADX+RPCAMX+RC0P+RC1P+RC2P)*VLPO4(L,NY,NX) - 3-(RPCDBX+RPCMBX+RC0B+RC1B+RC2B)*VLPOB(L,NY,NX) - 4-5.0*(RPCAHX*VLPO4(L,NY,NX)+RPCHBX*VLPOB(L,NY,NX)) - RMG=-RXMG-RMGO-RMGC-RMGH-RMGS - 2-RM1P*VLPO4(L,NY,NX)-RM1B*VLPOB(L,NY,NX) - RNA=-RXNA-RNAC-RNAS - RKA=-RXKA-RKAS - ROH=2.0*(-RYALO1-RYFEO1-RYCACO - 2+(RYA3P1+RYA4P2-RYA0P2+RYF3P1+RYF4P2-RYF0P2)*VLPO4(L,NY,NX) - 3+(RYA3B1+RYA4B2-RYA0B2+RYF3B1+RYF4B2-RYF0B2)*VLPOB(L,NY,NX)) - 4+3.0*(-RYAL1-RYFE1+(RYA4P1+RYF4P1)*VLPO4(L,NY,NX) - 5+(RYA4B1+RYF4B1)*VLPOB(L,NY,NX)) - 6-4.0*(RYCAH1*VLPO4(L,NY,NX)+RYCHB1*VLPOB(L,NY,NX)) - 7-7.0*(RYCAH2*VLPO4(L,NY,NX)+RYCHB2*VLPOB(L,NY,NX)) - 8+RYALO4-RYALO2+RYFEO4-RYFEO2-RYCACH-RCAO-RMGO-RALO1 - 9-RALO2-RALO3-RALO4-RFEO1-RFEO2-RFEO3-RFEO4 - 1-(RYA0P1-RYA2P1+RYA1P2-RYA3P2+RYF0P1-RYF2P1+RYF1P2-RYF3P2 - 2+RYCAD2-RYH2P-RYH1P)*VLPO4(L,NY,NX) - 3-(RYA0B1-RYA2B1+RYA1B2-RYA3B2+RYF0B1-RYF2B1+RYF1B2-RYF3B2 - 4+RYCDB2-RYH2B-RYH1B)*VLPOB(L,NY,NX) - RSO4=-RPCASO-RALS-RFES-RCAS-RMGS-RNAS-RKAS - RCO3=-RYCAC3-RHCAC3-RHCO3-RCAC-RMGC-RNAC - RHCO=-RYCACH-RHCACH-RCO2Q-RCAH-RMGH+RHCO3 - RCO2=-RHCACO-RYCACO+RCO2Q - RH2O=2.0*(-RHALO1-RHFEO1+RYCACO - 2+(RHA2P1+RYA0P2+RYA1P2+RYA2P2+RHA2P2+RYA3P2+RYA4P2 - 3+RHF2P1+RYF0P2+RYF1P2+RYF2P2+RHF2P2+RYF3P2+RYF4P2)*VLPO4(L,NY,NX) - 4+(RHA2B1+RYA0B2+RYA1B2+RYA2B2+RHA2B2+RYA3B2+RYA4B2 - 5+RHF2B1+RYF0B2+RYF1B2+RYF2B2+RHF2B2+RYF3B2+RYF4B2)*VLPOB(L,NY,NX)) - 6+3.0*(-RHAL1-RHFE1 - 7+(RHA3P1+RHA3P2+RHF3P1+RHF3P2+RYCAH1)*VLPO4(L,NY,NX) - 8+(RHA3B1+RHA3B2+RHF3B1+RHF3B2+RYCHB1)*VLPOB(L,NY,NX)) - 9+4.0*((RHA4P1+RHA4P2+RHF4P1+RHF4P2)*VLPO4(L,NY,NX) - 1+(RHA4B1+RHA4B2+RHF4B1+RHF4B2)*VLPOB(L,NY,NX)) - 2+6.0*(RYCAH2*VLPO4(L,NY,NX)+RYCHB2*VLPOB(L,NY,NX)) - 3-RHALO2-RHFEO2+RHALO4+RHFEO4+RYCACH - 4+(RYA0P1+RYA1P1+RHA1P1+RYA2P1+RYA3P1+RYA4P1+RHA1P2 - 5+RYF0P1+RYF1P1+RHF1P1+RYF2P1+RYF3P1+RYF4P1+RHF1P2 - 6+RYCAD2-RHCAH1-RHCAH2+RXH2P+RHH2P+RHH1P)*VLPO4(L,NY,NX) - 7+(RYA0B1+RYA1B1+RHA1B1+RYA2B1+RYA3B1+RYA4B1+RHA1B2 - 8+RYF0B1+RYF1B1+RHF1B1+RYF2B1+RYF3B1+RYF4B1+RHF1B2 - 9+RYCDB2-RHCHB1-RHCHB2+RXH2B+RHH2B+RHH1B)*VLPOB(L,NY,NX) - RAL1=-RYALO1-RHALO1+RALO1-RALO2 - 2-(RYA1P1+RHA1P1+RYA1P2+RHA1P2)*VLPO4(L,NY,NX) - 3-(RYA1B1+RHA1B1+RYA1B2+RHA1B2)*VLPOB(L,NY,NX) - RAL2=-RYALO2-RHALO2+RALO2-RALO3 - 2-(RYA2P1+RHA2P1+RYA2P2+RHA2P2)*VLPO4(L,NY,NX) - 3-(RYA2B1+RHA2B1+RYA2B2+RHA2B2)*VLPOB(L,NY,NX)-RXALO2 - RAL3=-RYALO3-RHALO3+RALO3-RALO4 - 2-(RYA3P1+RHA3P1+RYA3P2+RHA3P2)*VLPO4(L,NY,NX) - 3-(RYA3B1+RHA3B1+RYA3B2+RHA3B2)*VLPOB(L,NY,NX) - RAL4=-RYALO4-RHALO4+RALO4 - 2-(RYA4P1+RHA4P1+RYA4P2+RHA4P2)*VLPO4(L,NY,NX) - 3-(RYA4B1+RHA4B1+RYA4B2+RHA4B2)*VLPOB(L,NY,NX) - RFE1=-RYFEO1-RHFEO1+RFEO1-RFEO2 - 2-(RYF1P1+RHF1P1+RYF1P2+RHF1P2)*VLPO4(L,NY,NX) - 3-(RYF1B1+RHF1B1+RYF1B2+RHF1B2)*VLPOB(L,NY,NX) - RFE2=-RYFEO2-RHFEO2+RFEO2-RFEO3 - 2-(RYF2P1+RHF2P1+RYF2P2+RHF2P2)*VLPO4(L,NY,NX) - 3-(RYF2B1+RHF2B1+RYF2B2+RHF2B2)*VLPOB(L,NY,NX) - RFE3=-RYFEO3-RHFEO3+RFEO3-RFEO4 - 2-(RYF3P1+RHF3P1+RYF3P2+RHF3P2)*VLPO4(L,NY,NX) - 3-(RYF3B1+RHF3B1+RYF3B2+RHF3B2)*VLPOB(L,NY,NX) - RFE4=-RYFEO4-RHFEO4+RFEO4 - 2-(RYF4P1+RHF4P1+RYF4P2+RHF4P2)*VLPO4(L,NY,NX) - 3-(RYF4B1+RHF4B1+RYF4B2+RHF4B2)*VLPOB(L,NY,NX) - RHP0=-RH1P-RC0P - RHP1=-RYA0P1-RHA0P1-RYA1P1-RHA1P1-RYA2P1-RHA2P1-RYA3P1-RHA3P1 - 2-RYA4P1-RHA4P1-RYF0P1-RHF0P1-RYF1P1-RHF1P1-RYF2P1-RHF2P1-RYF3P1 - 3-RHF3P1-RYF4P1-RHF4P1-RPCAD1-3.0*(RYCAH1+RHCAH1)-RYH1P-RHH1P - 4+RH1P-RH2P-RF1P-RC1P-RM1P - RHP2=-RYA0P2-RHA0P2-RYA1P2-RHA1P2-RYA2P2-RHA2P2-RYA3P2-RHA3P2 - 2-RYA4P2-RHA4P2-RYF0P2-RHF0P2-RYF1P2-RHF1P2-RYF2P2-RHF2P2-RYF3P2 - 3-RHF3P2-RYF4P2-RHF4P2-RHCAD2-RYCAD2-3.0*(RYCAH2+RHCAH2) - 4-2.0*RPCAMX-RXH2P-RYH2P-RHH2P+RH2P-RH3P-RF2P-RC2P - RHP3=RH3P - RXH0=-RXOH1 - RXH1=RXOH1-RXOH2-RYH2P-RYH1P-RHH2P-RHH1P - RXH2=RXOH2-RXH2P - RX1P=RYH1P+RHH1P - RX2P=RXH2P+RYH2P+RHH2P -C IF(NY.EQ.5.AND.L.EQ.10)THEN -C WRITE(*,23)'HP2',I,J,NX,NY,L,M,RHP2,RYA0P2,RHA0P2,RYA1P2,RHA1P2 -C 2,RYA2P2,RHA2P2,RYA3P2,RHA3P2,RYA4P2,RHA4P2,RYF0P2,RHF0P2,RYF1P2 -C 3,RHF1P2,RYF2P2,RHF2P2,RYF3P2,RHF3P2,RYF4P2,RHF4P2,RHCAD2,RYCAD2 -C 4,RYCAH2,RHCAH2,RPCAMX,RXH2P,RYH2P,RHH2P,RH2P,RH3P,RF2P,RC2P -23 FORMAT(A8,6I4,60E12.4) -C ENDIF - RHB0=-RH1B-RC0B - RHB1=-RYA0B1-RHA0B1-RYA1B1-RHA1B1-RYA2B1-RHA2B1-RYA3B1-RHA3B1 - 2-RYA4B1-RHA4B1-RYF0B1-RHF0B1-RYF1B1-RHF1B1-RYF2B1-RHF2B1-RYF3B1 - 3-RHF3B1-RYF4B1-RHF4B1-RPCDB1-3.0*(RYCHB1+RHCHB1)-RYH1B-RHH1B - 4+RH1B-RH2B-RF1B-RC1B-RM1B - RHB2=-RYA0B2-RHA0B2-RYA1B2-RHA1B2-RYA2B2-RHA2B2-RYA3B2-RHA3B2 - 2-RYA4B2-RHA4B2-RYF0B2-RHF0B2-RYF1B2-RHF1B2-RYF2B2-RHF2B2-RYF3B2 - 3-RHF3B2-RYF4B2-RHF4B2-RHCDB2-RYCDB2-3.0*(RYCHB2+RHCHB2) - 4-2.0*RPCMBX-RXH2B-RYH2B-RHH2B+RH2B-RH3B-RF2B-RC2B - RHB3=RH3B - RBH0=-RXO1B - RBH1=RXO1B-RXO2B-RYH2B-RYH1B-RHH2B-RHH1B - RBH2=RXO2B-RXH2B - RB1P=RYH1B+RHH1B - RB2P=RXH2B+RYH2B+RHH2B - BNH4=-RXN4*VLNH4(L,NY,NX)-RXNB*VLNHB(L,NY,NX) - BH2P=RHP2*VLPO4(L,NY,NX)+RHB2*VLPOB(L,NY,NX) - BION=RNH4*VLNH4(L,NY,NX)+RNHB*VLNHB(L,NY,NX) -C -C UPDATE ION CONCENTRATIONS FOR CURRENT ITERATION -C FROM TOTAL ION FLUXES -C - CN41=CN41+RN4S - CN4B=CN4B+RN4B - CN31=CN31+RN3S - CN3B=CN3B+RN3B - CAL1=CAL1+RAL - CFE1=CFE1+RFE - CHY1=CHY1+RHY - CCA1=CCA1+RCA - CMG1=CMG1+RMG - CNA1=CNA1+RNA - CKA1=CKA1+RKA - COH1=COH1+ROH - CSO41=CSO41+RSO4 - CCO31=CCO31+RCO3 - CHCO31=CHCO31+RHCO - CCO21=CCO21+RCO2 - CALO1=CALO1+RAL1 - CALO2=CALO2+RAL2 - CALO3=CALO3+RAL3 - CALO4=CALO4+RAL4 - CALS1=CALS1+RALS - CFEO1=CFEO1+RFE1 - CFEO2=CFEO2+RFE2 - CFEO3=CFEO3+RFE3 - CFEO4=CFEO4+RFE4 - CFES1=CFES1+RFES - CCAO1=CCAO1+RCAO - CCAC1=CCAC1+RCAC - CCAH1=CCAH1+RCAH - CCAS1=CCAS1+RCAS - CMGO1=CMGO1+RMGO - CMGC1=CMGC1+RMGC - CMGH1=CMGH1+RMGH - CMGS1=CMGS1+RMGS - CNAC1=CNAC1+RNAC - CNAS1=CNAS1+RNAS - CKAS1=CKAS1+RKAS - CH0P1=CH0P1+RHP0 - CH1P1=CH1P1+RHP1 - CH2P1=CH2P1+RHP2 - CH3P1=CH3P1+RHP3 - CF1P1=CF1P1+RF1P - CF2P1=CF2P1+RF2P - CC0P1=CC0P1+RC0P - CC1P1=CC1P1+RC1P - CC2P1=CC2P1+RC2P - CM1P1=CM1P1+RM1P - CH0PB=CH0PB+RHB0 - CH1PB=CH1PB+RHB1 - CH2B1=CH2B1+RHB2 - CH3PB=CH3PB+RHB3 - CF1PB=CF1PB+RF1B - CF2PB=CF2PB+RF2B - CC0PB=CC0PB+RC0B - CC1PB=CC1PB+RC1B - CC2PB=CC2PB+RC2B - CM1PB=CM1PB+RM1B -C -C REQUILIBRATE H2O-H+OH -C - CHY2=AMAX1(ZERO,CHY1) - COH2=AMAX1(ZERO,COH1) - DP=DPH2O/A1**2 - S0=CHY2+COH2 - S1=AMAX1(0.0,S0**2-4.0*(CHY2*COH2-DP)) - RHOH=0.5*(S0-SQRT(S1)) - RHY=RHY-RHOH - ROH=ROH-RHOH - RH2O=RH2O+RHOH - CHY1=CHY1-RHOH - COH1=COH1-RHOH -C IF((I/10)*10.EQ.I.AND.J.EQ.12.AND.L.LE.3)THEN -C WRITE(*,1111)'CCA1',I,J,L,M,CCA1,CHY1,CH1P1,CH2P1,SPCAD/A22,SPCAD2/A2 -C 2,RCA,RPCACX,RPCASO,RPCADX,RPCDBX,5.0*(RPCAHX+RPCHBX),RPCAMX -C 2,RPCMBX,RXCA,RCAO,RCAC,RCAH,RCAS,RC0P,RC1P,RC2P,RC0B,RC1B,RC2B -C WRITE(*,1111)'CAL1',I,J,L,M,CAL1,CAL1*A3 -C 2,RAL,RYAL1,RYA0P1,RYA0P2,RYA0B1,RYA0B2,RXAL,RALO1,RALS -C 3,CSO41,CALS1,DPALS,A1A23D -C WRITE(*,1111)'CFEO2',I,J,L,M,CFEO2,CFEO2*A1 -C 2,RFE2,RYFEO2,RHFEO2,RYF2P1,RHF2P1,RYF2P2,RHF2P2,RYF2B1,RHF2B1 -C 2,RYF2B2,RHF2B2,RFEO2,RFEO3 -C WRITE(*,1112)'CHY1',I,J,L,M,CHY1,COH1,CHY1*A1,CHYX,COHX,RHOH,RHY1 -C 2,RHY,RXHY,RXHC,RHALO1,RHFEO1,RHCACO,RHA0P2,RHA0B2,RHF0P2,RHF0B2 -C 2,RHA3P1,RHA4P2,RHA3B1,RHA4B2,RHF3P1,RHF4P2,RHF3B1,RHF4B2 -C 3,RHAL1,RHFE1,RHA4P1,RHA4B1,RHF4P1,RHF4B1,RHCAH1 -C 4,RHCHB1,RHCAH2,RHCHB2,RHALO2,RHFEO2,RHALO4,RHFEO4 -C 5,RHCACH,RHA0P1,RHA2P1,RHA1P2,RHA3P2,RHA0B1,RHA2B1,RHA1B2 -C 6,RHA3B2,RHF0P1,RHF2P1,RHF1P2,RHF3P2,RHF0B1,RHF2B1,RHF1B2 -C 7,RHF3B2,RHCAD2,RHCDB2,RXOH2,RXOH1,RXO2B,RXO1B,RHH2P,RHH2B -C 8,RHH1P,RHH1B,RCO2Q,RHCO3,RNH4,RNHB,RH1P,RH2P,RH3P,RH1B,RH2B -C 9,RH3B,(CHY2-RHOH)*(COH2-RHOH),DP -C ENDIF -C WRITE(*,1111)'COH1',I,J,L,M,COH1,COH1*A1 -C 2,ROH,RHOH,RYH2P,RYH2B,RYH1P,RYH1B,RPALPX,RYFEPX,RCAO,RMGO -C 2,RPCAHX,RALO1,RALO2,RALO3,RALO4,RFEO1,RFEO2,RFEO3,RFEO4 -1111 FORMAT(A8,4I4,80E12.4) -C -C UPDATE EXCHANGEABLE ION CONCENTRATIONS IN CURRENT -C ITERATION FROM TOTAL ION FLUXES -C - XN41=XN41+RXN4 - XN4B=XN4B+RXNB - XHY1=XHY1+RXHY - XAL1=XAL1+RXAL - XCA1=XCA1+RXCA - XMG1=XMG1+RXMG - XNA1=XNA1+RXNA - XKA1=XKA1+RXKA - XHC1=XHC1+RXHC - XALO21=XALO21+RXALO2 - XOH01=XOH01+RXH0 - XOH11=XOH11+RXH1 - XOH21=XOH21+RXH2 - XH1P1=XH1P1+RX1P - XH2P1=XH2P1+RX2P - XH01B=XH01B+RBH0 - XH11B=XH11B+RBH1 - XH21B=XH21B+RBH2 - X1P1B=X1P1B+RB1P - X2P1B=X2P1B+RB2P -C -C UPDATE PRECIPITATE CONCENTRATIONS IN CURRENT -C ITERATION FROM TOTAL ION FLUXES -C - PALOH1=PALOH1+RPALOX - PFEOH1=PFEOH1+RPFEOX - PCACO1=PCACO1+RPCACX - PCASO1=PCASO1+RPCASO - PALPO1=PALPO1+RPALPX - PFEPO1=PFEPO1+RPFEPX - PCAPD1=PCAPD1+RPCADX - PCAPH1=PCAPH1+RPCAHX - PCAPM1=PCAPM1+RPCAMX - PALPOB=PALPOB+RPALBX - PFEPOB=PFEPOB+RPFEBX - PCAPDB=PCAPDB+RPCDBX - PCAPHB=PCAPHB+RPCHBX - PCAPMB=PCAPMB+RPCMBX -C -C ACCUMULATE TOTAL ION FLUXES FOR ALL ITERATIONS -C - TRN4S(L,NY,NX)=TRN4S(L,NY,NX)+RN4S - TRN4B(L,NY,NX)=TRN4B(L,NY,NX)+RN4B - TRN3S(L,NY,NX)=TRN3S(L,NY,NX)+RN3S - TRN3B(L,NY,NX)=TRN3B(L,NY,NX)+RN3B - TRAL(L,NY,NX)=TRAL(L,NY,NX)+RAL - TRFE(L,NY,NX)=TRFE(L,NY,NX)+RFE - TRHY(L,NY,NX)=TRHY(L,NY,NX)+RHY - TRCA(L,NY,NX)=TRCA(L,NY,NX)+RCA - TRMG(L,NY,NX)=TRMG(L,NY,NX)+RMG - TRNA(L,NY,NX)=TRNA(L,NY,NX)+RNA - TRKA(L,NY,NX)=TRKA(L,NY,NX)+RKA - TROH(L,NY,NX)=TROH(L,NY,NX)+ROH - TRSO4(L,NY,NX)=TRSO4(L,NY,NX)+RSO4 - TRCO3(L,NY,NX)=TRCO3(L,NY,NX)+RCO3 - TRHCO(L,NY,NX)=TRHCO(L,NY,NX)+RHCO - TBCO2(L,NY,NX)=TBCO2(L,NY,NX)+RCO2 - TRH2O(L,NY,NX)=TRH2O(L,NY,NX)+RH2O - TRAL1(L,NY,NX)=TRAL1(L,NY,NX)+RAL1 - TRAL2(L,NY,NX)=TRAL2(L,NY,NX)+RAL2 - TRAL3(L,NY,NX)=TRAL3(L,NY,NX)+RAL3 - TRAL4(L,NY,NX)=TRAL4(L,NY,NX)+RAL4 - TRALS(L,NY,NX)=TRALS(L,NY,NX)+RALS - TRFE1(L,NY,NX)=TRFE1(L,NY,NX)+RFE1 - TRFE2(L,NY,NX)=TRFE2(L,NY,NX)+RFE2 - TRFE3(L,NY,NX)=TRFE3(L,NY,NX)+RFE3 - TRFE4(L,NY,NX)=TRFE4(L,NY,NX)+RFE4 - TRFES(L,NY,NX)=TRFES(L,NY,NX)+RFES - TRCAO(L,NY,NX)=TRCAO(L,NY,NX)+RCAO - TRCAC(L,NY,NX)=TRCAC(L,NY,NX)+RCAC - TRCAH(L,NY,NX)=TRCAH(L,NY,NX)+RCAH - TRCAS(L,NY,NX)=TRCAS(L,NY,NX)+RCAS - TRMGO(L,NY,NX)=TRMGO(L,NY,NX)+RMGO - TRMGC(L,NY,NX)=TRMGC(L,NY,NX)+RMGC - TRMGH(L,NY,NX)=TRMGH(L,NY,NX)+RMGH - TRMGS(L,NY,NX)=TRMGS(L,NY,NX)+RMGS - TRNAC(L,NY,NX)=TRNAC(L,NY,NX)+RNAC - TRNAS(L,NY,NX)=TRNAS(L,NY,NX)+RNAS - TRKAS(L,NY,NX)=TRKAS(L,NY,NX)+RKAS - TRH0P(L,NY,NX)=TRH0P(L,NY,NX)+RHP0 - TRH1P(L,NY,NX)=TRH1P(L,NY,NX)+RHP1 - TRH2P(L,NY,NX)=TRH2P(L,NY,NX)+RHP2 - TRH3P(L,NY,NX)=TRH3P(L,NY,NX)+RHP3 - TRF1P(L,NY,NX)=TRF1P(L,NY,NX)+RF1P - TRF2P(L,NY,NX)=TRF2P(L,NY,NX)+RF2P - TRC0P(L,NY,NX)=TRC0P(L,NY,NX)+RC0P - TRC1P(L,NY,NX)=TRC1P(L,NY,NX)+RC1P - TRC2P(L,NY,NX)=TRC2P(L,NY,NX)+RC2P - TRM1P(L,NY,NX)=TRM1P(L,NY,NX)+RM1P - TRH0B(L,NY,NX)=TRH0B(L,NY,NX)+RHB0 - TRH1B(L,NY,NX)=TRH1B(L,NY,NX)+RHB1 - TRH2B(L,NY,NX)=TRH2B(L,NY,NX)+RHB2 - TRH3B(L,NY,NX)=TRH3B(L,NY,NX)+RHB3 - TRF1B(L,NY,NX)=TRF1B(L,NY,NX)+RF1B - TRF2B(L,NY,NX)=TRF2B(L,NY,NX)+RF2B - TRC0B(L,NY,NX)=TRC0B(L,NY,NX)+RC0B - TRC1B(L,NY,NX)=TRC1B(L,NY,NX)+RC1B - TRC2B(L,NY,NX)=TRC2B(L,NY,NX)+RC2B - TRM1B(L,NY,NX)=TRM1B(L,NY,NX)+RM1B - TRXN4(L,NY,NX)=TRXN4(L,NY,NX)+RXN4 - TRXNB(L,NY,NX)=TRXNB(L,NY,NX)+RXNB - TRXHY(L,NY,NX)=TRXHY(L,NY,NX)+RXHY - TRXAL(L,NY,NX)=TRXAL(L,NY,NX)+RXAL - TRXCA(L,NY,NX)=TRXCA(L,NY,NX)+RXCA - TRXMG(L,NY,NX)=TRXMG(L,NY,NX)+RXMG - TRXNA(L,NY,NX)=TRXNA(L,NY,NX)+RXNA - TRXKA(L,NY,NX)=TRXKA(L,NY,NX)+RXKA - TRXHC(L,NY,NX)=TRXHC(L,NY,NX)+RXHC - TRXAL2(L,NY,NX)=TRXAL2(L,NY,NX)+RXALO2 - TRXH0(L,NY,NX)=TRXH0(L,NY,NX)+RXH0 - TRXH1(L,NY,NX)=TRXH1(L,NY,NX)+RXH1 - TRXH2(L,NY,NX)=TRXH2(L,NY,NX)+RXH2 - TRX1P(L,NY,NX)=TRX1P(L,NY,NX)+RX1P - TRX2P(L,NY,NX)=TRX2P(L,NY,NX)+RX2P - TRBH0(L,NY,NX)=TRBH0(L,NY,NX)+RBH0 - TRBH1(L,NY,NX)=TRBH1(L,NY,NX)+RBH1 - TRBH2(L,NY,NX)=TRBH2(L,NY,NX)+RBH2 - TRB1P(L,NY,NX)=TRB1P(L,NY,NX)+RB1P - TRB2P(L,NY,NX)=TRB2P(L,NY,NX)+RB2P - TRALOH(L,NY,NX)=TRALOH(L,NY,NX)+RPALOX - TRFEOH(L,NY,NX)=TRFEOH(L,NY,NX)+RPFEOX - TRCACO(L,NY,NX)=TRCACO(L,NY,NX)+RPCACX - TRCASO(L,NY,NX)=TRCASO(L,NY,NX)+RPCASO - TRALPO(L,NY,NX)=TRALPO(L,NY,NX)+RPALPX - TRFEPO(L,NY,NX)=TRFEPO(L,NY,NX)+RPFEPX - TRCAPD(L,NY,NX)=TRCAPD(L,NY,NX)+RPCADX - TRCAPH(L,NY,NX)=TRCAPH(L,NY,NX)+RPCAHX - TRCAPM(L,NY,NX)=TRCAPM(L,NY,NX)+RPCAMX - TRALPB(L,NY,NX)=TRALPB(L,NY,NX)+RPALBX - TRFEPB(L,NY,NX)=TRFEPB(L,NY,NX)+RPFEBX - TRCPDB(L,NY,NX)=TRCPDB(L,NY,NX)+RPCDBX - TRCPHB(L,NY,NX)=TRCPHB(L,NY,NX)+RPCHBX - TRCPMB(L,NY,NX)=TRCPMB(L,NY,NX)+RPCMBX - TBNH4(L,NY,NX)=TBNH4(L,NY,NX)+BNH4 - TBH2P(L,NY,NX)=TBH2P(L,NY,NX)+BH2P - TBION(L,NY,NX)=TBION(L,NY,NX)+BION -C -C GO TO NEXT ITERATION -C -1000 CONTINUE -C -C ITERATIONS COMPLETED -C -C IF(J.EQ.24)THEN -C WRITE(*,1119)'GAPON',I,J,L,M,CH0P1,CAL1,CFE1,CH0P1*A3*CAL1*A3 -C 2,SPALP,CH0P1*A3*CFE1*A3,SPFEP -C 6,SPOH2,XOH11*CHY1*A1/XOH21,SPOH1,XOH01*CHY1*A1/XOH11 -C 7,SPH2P,XOH21*CH2P1*A1/XH2P1,SYH2P,XOH11*CH2P1/(XH2P1*COH1) -C 8,SYH1P,XOH11*CH1P1*A2/(XH1P1*COH1*A1) -C 9,COH1*A1,CHY1*A1 -1119 FORMAT(A8,4I4,24E11.3) -C WRITE(*,1119)'CATION',I,J,L,M,CCEC,XN41+XHY1+3*XAL1+2*(XCA1+XMG1) -C 2+XNA1+XKA1,XN41,XHY1,XAL1,XCA1,XMG1,XNA1,XKA1,CN41,CHY1,CAL1,CCA1 -C 2,CMG1,CNA1,CKA1,(CCA1*A2)**0.5*XN41/(CN41*A1*XCA1*2) -C 3,(CCA1*A2)**0.5*XHY1/(CHY1*A1*XCA1*2) -C 2,(CCA1*A2)**0.5*XAL1*3/((CAL1*A3)**0.333*XCA1*2) -C 3,(CCA1*A2)**0.5*XMG1*2/((CMG1*A2)**0.5*XCA1*2) -C 3,(CCA1*A2)**0.5*XNA1/(CNA1*A1*XCA1*2) -C 5,(CCA1*A2)**0.5*XKA1/(CKA1*A1*XCA1*2) -C 6,CHY1*A1*XCOO/XHC1,CALO2*A1*XCOO/XALO21 -C ENDIF -C -C CONVERT TOTAL ION FLUXES FROM CHANGES IN CONCENTRATION -C TO CHANGES IN MASS PER UNIT AREA FOR USE IN 'REDIST' -C - TRN4S(L,NY,NX)=TRN4S(L,NY,NX)*VOLWNH - TRN4B(L,NY,NX)=TRN4B(L,NY,NX)*VOLWNB - TRN3S(L,NY,NX)=TRN3S(L,NY,NX)*VOLWNH - TRN3B(L,NY,NX)=TRN3B(L,NY,NX)*VOLWNB - TRAL(L,NY,NX)=TRAL(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRFE(L,NY,NX)=TRFE(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRHY(L,NY,NX)=TRHY(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRCA(L,NY,NX)=TRCA(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRMG(L,NY,NX)=TRMG(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRNA(L,NY,NX)=TRNA(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRKA(L,NY,NX)=TRKA(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TROH(L,NY,NX)=TROH(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRSO4(L,NY,NX)=TRSO4(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRCO3(L,NY,NX)=TRCO3(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRHCO(L,NY,NX)=TRHCO(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TBCO2(L,NY,NX)=TBCO2(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRH2O(L,NY,NX)=TRH2O(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRAL1(L,NY,NX)=TRAL1(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRAL2(L,NY,NX)=TRAL2(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRAL3(L,NY,NX)=TRAL3(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRAL4(L,NY,NX)=TRAL4(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRALS(L,NY,NX)=TRALS(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRFE1(L,NY,NX)=TRFE1(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRFE2(L,NY,NX)=TRFE2(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRFE3(L,NY,NX)=TRFE3(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRFE4(L,NY,NX)=TRFE4(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRFES(L,NY,NX)=TRFES(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRCAO(L,NY,NX)=TRCAO(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRCAC(L,NY,NX)=TRCAC(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRCAH(L,NY,NX)=TRCAH(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRCAS(L,NY,NX)=TRCAS(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRMGO(L,NY,NX)=TRMGO(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRMGC(L,NY,NX)=TRMGC(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRMGH(L,NY,NX)=TRMGH(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRMGS(L,NY,NX)=TRMGS(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRNAC(L,NY,NX)=TRNAC(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRNAS(L,NY,NX)=TRNAS(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRKAS(L,NY,NX)=TRKAS(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRH0P(L,NY,NX)=TRH0P(L,NY,NX)*VOLWPO - TRH1P(L,NY,NX)=TRH1P(L,NY,NX)*VOLWPO - TRH2P(L,NY,NX)=TRH2P(L,NY,NX)*VOLWPO - TRH3P(L,NY,NX)=TRH3P(L,NY,NX)*VOLWPO - TRF1P(L,NY,NX)=TRF1P(L,NY,NX)*VOLWPO - TRF2P(L,NY,NX)=TRF2P(L,NY,NX)*VOLWPO - TRC0P(L,NY,NX)=TRC0P(L,NY,NX)*VOLWPO - TRC1P(L,NY,NX)=TRC1P(L,NY,NX)*VOLWPO - TRC2P(L,NY,NX)=TRC2P(L,NY,NX)*VOLWPO - TRM1P(L,NY,NX)=TRM1P(L,NY,NX)*VOLWPO - TRH0B(L,NY,NX)=TRH0B(L,NY,NX)*VOLWPB - TRH1B(L,NY,NX)=TRH1B(L,NY,NX)*VOLWPB - TRH2B(L,NY,NX)=TRH2B(L,NY,NX)*VOLWPB - TRH3B(L,NY,NX)=TRH3B(L,NY,NX)*VOLWPB - TRF1B(L,NY,NX)=TRF1B(L,NY,NX)*VOLWPB - TRF2B(L,NY,NX)=TRF2B(L,NY,NX)*VOLWPB - TRC0B(L,NY,NX)=TRC0B(L,NY,NX)*VOLWPB - TRC1B(L,NY,NX)=TRC1B(L,NY,NX)*VOLWPB - TRC2B(L,NY,NX)=TRC2B(L,NY,NX)*VOLWPB - TRM1B(L,NY,NX)=TRM1B(L,NY,NX)*VOLWPB - TRXN4(L,NY,NX)=TRXN4(L,NY,NX)*VOLWNH - TRXNB(L,NY,NX)=TRXNB(L,NY,NX)*VOLWNB - TRXHY(L,NY,NX)=TRXHY(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRXAL(L,NY,NX)=TRXAL(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRXCA(L,NY,NX)=TRXCA(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRXMG(L,NY,NX)=TRXMG(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRXNA(L,NY,NX)=TRXNA(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRXKA(L,NY,NX)=TRXKA(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRXHC(L,NY,NX)=TRXHC(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRXAL2(L,NY,NX)=TRXAL2(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRXH0(L,NY,NX)=TRXH0(L,NY,NX)*VOLWPO - TRXH1(L,NY,NX)=TRXH1(L,NY,NX)*VOLWPO - TRXH2(L,NY,NX)=TRXH2(L,NY,NX)*VOLWPO - TRX1P(L,NY,NX)=TRX1P(L,NY,NX)*VOLWPO - TRX2P(L,NY,NX)=TRX2P(L,NY,NX)*VOLWPO - TRBH0(L,NY,NX)=TRBH0(L,NY,NX)*VOLWPB - TRBH1(L,NY,NX)=TRBH1(L,NY,NX)*VOLWPB - TRBH2(L,NY,NX)=TRBH2(L,NY,NX)*VOLWPB - TRB1P(L,NY,NX)=TRB1P(L,NY,NX)*VOLWPB - TRB2P(L,NY,NX)=TRB2P(L,NY,NX)*VOLWPB - TRALOH(L,NY,NX)=TRALOH(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRFEOH(L,NY,NX)=TRFEOH(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRCACO(L,NY,NX)=TRCACO(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRCASO(L,NY,NX)=TRCASO(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRALPO(L,NY,NX)=TRALPO(L,NY,NX)*VOLWPO - TRFEPO(L,NY,NX)=TRFEPO(L,NY,NX)*VOLWPO - TRCAPD(L,NY,NX)=TRCAPD(L,NY,NX)*VOLWPO - TRCAPH(L,NY,NX)=TRCAPH(L,NY,NX)*VOLWPO - TRCAPM(L,NY,NX)=TRCAPM(L,NY,NX)*VOLWPO - TRALPB(L,NY,NX)=TRALPB(L,NY,NX)*VOLWPB - TRFEPB(L,NY,NX)=TRFEPB(L,NY,NX)*VOLWPB - TRCPDB(L,NY,NX)=TRCPDB(L,NY,NX)*VOLWPB - TRCPHB(L,NY,NX)=TRCPHB(L,NY,NX)*VOLWPB - TRCPMB(L,NY,NX)=TRCPMB(L,NY,NX)*VOLWPB - TBNH4(L,NY,NX)=TBNH4(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TBH2P(L,NY,NX)=TBH2P(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TBION(L,NY,NX)=TBION(L,NY,NX)*VOLWM(NPH,L,NY,NX) -C -C IF NO SALTS IS SELECTED IN SITE FILE THEN A SUBSET -C OF THE EQUILIBRIA REACTIONS ARE SOLVED: MOSTLY THOSE -C FOR PHOSPHORUS -C - ELSE -C -C PRECIPITATION-DISSOLUTION CALCULATED FROM ACTIVITIES -C OF REACTANTS AND PRODUCTS THROUGH SOLUTIONS -C FOR THEIR EQUILIBRIUM CONSTANTS USING CURRENT -C ION CONCENTRATION -C - CCEC=AMAX1(ZERO,XCEC(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CHY1=AMAX1(ZERO,10.0**(-(PH(L,NY,NX)-3.0))) - COH1=AMAX1(ZERO,DPH2O/CHY1) - IF(CAL(L,NY,NX).LT.0.0)THEN - CAL1=AMAX1(ZERO,SYALO/COH1**3) - ELSE - CAL1=AMAX1(ZERO,AMIN1(CAL(L,NY,NX),SYALO/COH1**3)) - ENDIF - IF(CFE(L,NY,NX).LT.0.0)THEN - CFE1=AMAX1(ZERO,SYFEO/COH1**3) - ELSE - CFE1=AMAX1(ZERO,AMIN1(CFE(L,NY,NX),SYFEO/COH1**3)) - ENDIF - CMG1=AMAX1(0.0,ZMG(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CNA1=AMAX1(0.0,ZNA(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CKA1=AMAX1(0.0,ZKA(L,NY,NX)/VOLWM(NPH,L,NY,NX)) -C -C CA CONCENTRATION FROM CURRENT CO2 CONCENTRATION -C - CCO21=AMAX1(ZERO,CCO2S(L,NY,NX)/12.0) - CCO31=AMAX1(ZERO,CCO21*DPCO3/CHY1**2) - IF(CCA(L,NY,NX).LT.0.0)THEN - CCA1=AMAX1(ZERO,AMIN1(CCAMX,SPCAC/CCO31)) - ELSE - CCA1=AMAX1(ZERO,AMIN1(CCA(L,NY,NX),SPCAC/CCO31)) - ENDIF -C -C PHOSPHORUS TRANSFORMATIONS IN NON-BAND SOIL ZONE -C - IF(VOLWPO.GT.ZEROS(NY,NX))THEN -C -C ALUMINUM PHOSPHATE (VARISCITE) -C - CH2PA=SYA0P2/(CAL1*COH1**2) - RPALPX=AMAX1(-PALPO1,TPD*(CH2P1-CH2PA)) -C -C IRON PHOSPHATE (STRENGITE) -C - CH2PF=SYF0P2/(CFE1*COH1**2) - RPFEPX=AMAX1(-PFEPO1,TPD*(CH2P1-CH2PF)) -C IF(I.EQ.180.AND.J.EQ.12)THEN -C WRITE(*,1117)'RPFEPX',I,J,L,CH2PA,SYA0P2,CAL1,COH1,PALPO1 -C 2,CH2P1,CH2PF,SYF0P2,CFE1,COH1,PFEPO1,CH2P1,RPALPX,RPFEPX -C 3,CAL(L,NY,NX),CFE(L,NY,NX) -C ENDIF -C -C DICALCIUM PHOSPHATE -C - CH2PD=SYCAD2/(CCA1*COH1) - RPCADX=AMAX1(-PCAPD1,TPD*(CH2P1-CH2PD)) -C -C HYDROXYAPATITE -C - CH2PH=(SYCAH2/(CCA1**5*COH1**7))**0.333 - RPCAHX=AMAX1(-PCAPH1,TPD*(CH2P1-CH2PH)) -C -C MONOCALCIUM PHOSPHATE -C - CH2PM=SQRT(SPCAM/CCA1) - RPCAMX=AMAX1(-PCAPM1*SPPO4,TPD*(CH2P1-CH2PM)) -C IF(I.GT.315)THEN -C WRITE(*,1117)'RPPO4',I,J,L,RPCADX,CH2P1,CH2PD,PCAPD1,RPCAHX -C 2,CH2PA,CH2PH,SYA0P2,CAL1,COH1,SYCAH2,CCA1,CCO21,CCO31,PCAPH1 -C 3,VOLWPO,SPCAC/CCO31,CCA(L,NY,NX),H2PO4(L,NY,NX) -C 4,VOLWM(NPH,L,NY,NX),ZCA(L,NY,NX),CCO2S(L,NY,NX) -1117 FORMAT(A8,3I4,30E12.4) -C ENDIF -C -C PHOSPHORUS ANION EXCHANGE IN NON-BAND SOIL ZONE -C CALCULATED FROM EXCHANGE EQUILIBRIA AMONG H2PO4-, -C HPO4--, H+, OH- AND PROTONATED AND NON-PROTONATED -OH -C EXCHANGE SITES -C - IF(AEC(L,NY,NX).GT.0.0)THEN -C -C PROTONATION OF ANION EXCHANGE SITES IN NON-BAND SOIL ZONE -C - DCHG=AMAX1(-1.0E+02,XOH21-XOH01-XH1P1) - AEP=EXP(AE*DCHG/TKS(L,NY,NX)) - AEN=EXP(-AE*DCHG/TKS(L,NY,NX)) -C -C H2PO4 EXCHANGE IN NON-BAND SOIL ZONE FROM CONVERGENCE -C SOLUTION FOR EQUILIBRIUM AMONG H2PO4-, H+, OH-, X-OH -C AND X-H2PO4 -C - SPH2P=SYH2P*DPH2O/(SXOH2*AEP) - X0=XOH21+CH2P1+SPH2P - X1=AMAX1(0.0,X0**2-4.0*(XOH21*CH2P1-SPH2P*XH2P1)) - RXH2P=TADA*(X0-SQRT(X1)) - X0=XOH11+CH2P1+SYH2P*COH1 - X1=AMAX1(0.0,X0**2-4.0*(XOH11*CH2P1-SYH2P*COH1*XH2P1)) - RYH2P=TADA*(X0-SQRT(X1)) -C -C HPO4 EXCHANGE IN NON-BAND SOIL ZONE FROM CONVERGENCE -C SOLUTION FOR EQUILIBRIUM AMONG HPO4--, H+, OH-, X-OH -C AND X-HPO4 -C - SPH1P=SYH1P*DPH2O*AEN/DPH2P - X0=XOH11+CH2P1+SPH1P - X1=AMAX1(0.0,X0**2-4.0*(XOH11*CH2P1-SPH1P*XH1P1)) - RXH1P=TADA*(X0-SQRT(X1)) -C WRITE(*,1116)'RXH2P',I,J,NX,NY,L,RXH2P -C 2,XOH21,CH2P1,XH2P1,XOH21*(CH2P1-RXH2P)/(XH2P1+RXH2P),SPH2P -C 3,H2PO4(L,NY,NX),RH2PX,VOLWPO,AEP -C WRITE(*,1116)'RYH2P',I,J,NX,NY,L,RYH2P -C 2,XOH11,CH2P1,XH2P1,COH1,(XOH11*(CH2P1-RYH2P)) -C 3/((XH2P1+RYH2P)*COH1),SYH2P -C WRITE(*,1116)'RXH1P',I,J,NX,NY,L,RXH1P,X0,X1 -C 2,XOH11,CH2P1,XH1P1,XOH11*(CH2P1-RXH1P)/(XH1P1+RXH1P),SPH1P -C 3,SYH1P,DPH2O,AEN,DPH2P,XOH1(L,NY,NX),VLPO4(L,NY,NX),VLPOB(L,NY,NX) -C 4,AE,DCHG,TKS(L,NY,NX),XOH21,XOH01 -1116 FORMAT(A8,5I4,40E12.4) - ELSE - RXH2P=0.0 - RYH2P=0.0 - RXH1P=0.0 - ENDIF - ELSE - RPALPX=0.0 - RPFEPX=0.0 - RPCADX=0.0 - RPCAHX=0.0 - RPCAMX=0.0 - RXH2P=0.0 - RYH2P=0.0 - RXH1P=0.0 - ENDIF -C IF(J.EQ.1)THEN -C WRITE(*,2222)'PO4',I,J,L,CH2P1,PALPO1,PFEPO1,PCAPD1,PCAPH1,PCAPM1 -C 2,CH2PA,CH2PF,CH2PD,CH2PH,CH2PM,RPALPX,RPFEPX,RPCADX,RPCAHX,RPCAMX -C 3,XH2P1,RXH2P,RYH2P -C 3,CAL1,CFE1,CCA1,CHY1,COH1 -2222 FORMAT(A8,3I4,40E12.4) -C ENDIF -C -C PHOSPHORUS PRECIPITATION-DISSOLUTION IN BAND SOIL ZONE -C - IF(VOLWPB.GT.ZEROS(NY,NX))THEN -C -C ALUMINUM PHOSPHATE (VARISCITE) -C - CH2PA=SYA0P2/(CAL1*COH1**2) - RPALBX=AMAX1(-PALPOB,TPD*(CH2B1-CH2PA)) -C -C IRON PHOSPHATE (STRENGITE) -C - CH2PF=SYF0P2/(CFE1*COH1**2) - RPFEBX=AMAX1(-PFEPOB,TPD*(CH2B1-CH2PF)) -C -C DICALCIUM PHOSPHATE -C - CH2PD=SYCAD2/(CCA1*COH1) - RPCDBX=AMAX1(-PCAPDB,TPD*(CH2B1-CH2PD)) -C -C HYDROXYAPATITE -C - CH2PH=(SYCAH2/(CCA1**5*COH1**7))**0.333 - RPCHBX=AMAX1(-PCAPHB,TPD*(CH2B1-CH2PH)) -C -C MONOCALCIUM PHOSPHATE -C - CH2PM=SQRT(SPCAM/CCA1) - RPCMBX=AMAX1(-PCAPMB*SPPO4,TPD*(CH2B1-CH2PM)) -C -C PHOSPHORUS ANION EXCHANGE IN BAND SOIL ZONE -C CALCULATED FROM EXCHANGE EQUILIBRIA AMONG H2PO4-, -C HPO4--, H+, OH- AND PROTONATED AND NON-PROTONATED -OH -C EXCHANGE SITES -C - IF(AEC(L,NY,NX).GT.0.0)THEN -C -C PROTONATION OF EXCHANGE SITES IN BAND SOIL ZONE -C - DCHG=AMAX1(-0.1E+05,XH21B-XH01B-X1P1B) - AEP=EXP(AE*DCHG/TKS(L,NY,NX)) - AEN=EXP(-AE*DCHG/TKS(L,NY,NX)) -C -C H2PO4 EXCHANGE IN BAND SOIL ZONE FROM CONVERGENCE -C SOLUTION FOR EQUILIBRIUM AMONG H2PO4-, H+, OH-, X-OH -C AND X-H2PO4 -C - RXH2B=TADA*(XH21B*CH2B1-SPH2P*X2P1B)/(SPH2P+XH21B) - RYH2B=TADA*(XH11B*CH2B1-SYH2P*X2P1B*COH1)/(SYH2P*COH1+XH11B) -C -C HPO4 EXCHANGE IN BAND SOIL ZONE FROM CONVERGENCE -C SOLUTION FOR EQUILIBRIUM AMONG HPO4--, H+, OH-, X-OH -C AND X-HPO4 -C - SPH1P=SYH1P*DPH2O*AEN/DPH2P - RXH1B=TADA*(XH11B*CH2B1-SPH1P*X1P1B)/(SPH1P+XH11B) -C WRITE(*,2224)'RXH2B',I,J,L,RXH2B,RXH1B,XH21B,CH2B1,SPH2P,X2P1B -C 2,SPH2P,XH21B,XH11B,CH2B1,SPH1P,X1P1B,SPH1P,XH11B,H2POB(L,NY,NX) -2224 FORMAT(A8,3I4,40E12.4) - ELSE - RXH2B=0.0 - RYH2B=0.0 - RXH1B=0.0 - ENDIF - ELSE - RPALBX=0.0 - RPFEBX=0.0 - RPCDBX=0.0 - RPCHBX=0.0 - RPCMBX=0.0 - RXH2B=0.0 - RYH2B=0.0 - RXH1B=0.0 - ENDIF -C -C CATION EXCHANGE FROM GAPON SELECTIVITY COEFFICIENTS -C FOR CA-NH4, CA-H, CA-AL -C - CALX=AMAX1(ZERO,CAL1)**0.333 - CCAX=AMAX1(ZERO,CCA1)**0.500 - CMGX=AMAX1(ZERO,CMG1)**0.500 -C -C EQUILIBRIUM X-CA CONCENTRATION FROM CEC AND CATION -C CONCENTRATIONS -C - XCAQ=CCEC/(1.0+GKC4(L,NY,NX)*CN41/CCAX*VLNH4(L,NY,NX) - 2+GKC4(L,NY,NX)*CN4B/CCAX*VLNHB(L,NY,NX)+GKCH(L,NY,NX)*CHY1/CCAX - 3+GKCA(L,NY,NX)*CALX/CCAX+GKCM(L,NY,NX)*CMGX/CCAX - 3+GKCN(L,NY,NX)*CNA1/CCAX+GKCK(L,NY,NX)*CKA1/CCAX) - FCAQ=XCAQ/CCAX - FN4X=FCAQ*GKC4(L,NY,NX) -C -C NH4 EXCHANGE IN NON-BAND AND BAND SOIL ZONES -C - RXN4=TADC*(FN4X*CN41-XN41)/(1.0+FN4X) - RXNB=TADC*(FN4X*CN4B-XN4B)/(1.0+FN4X) -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) -C 3,(CCA1)**0.5*XN41/(CN41*XCAQ),ZCA(L,NY,NX) -C ENDIF -C -C NH4-NH3+H IN NON-BAND AND BAND SOIL ZONES -C - IF(VOLWNH.GT.ZEROS(NY,NX))THEN - RNH4=(CHY1*CN31-DPN4*CN41)/(DPN4+CHY1) - ELSE - RNH4=0.0 - ENDIF - IF(VOLWNB.GT.ZEROS(NY,NX))THEN - RNHB=(CHY1*CN3B-DPN4*CN4B)/(DPN4+CHY1) - ELSE - RNHB=0.0 - ENDIF -C IF(J.EQ.12.AND.L.LE.6)THEN -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) -C 4,RN4X,RN3X,RNBX,R3BX -C ENDIF -C -C TOTAL ION FLUXES FOR ALL REACTIONS ABOVE -C - RN4S=RNH4-RXN4 - RN4B=RNHB-RXNB - RN3S=-RNH4 - RN3B=-RNHB - RHP2=-RXH2P-RYH2P-RXH1P-RPALPX-RPFEPX-RPCADX-2.0*RPCAMX-3.0*RPCAHX - RHB2=-RXH2B-RYH2B-RXH1B-RPALBX-RPFEBX-RPCDBX-2.0*RPCMBX-3.0*RPCHBX - RXH1=-RYH2P-RXH1P - RXH2=-RXH2P - RX1P=RXH1P - RX2P=RXH2P+RYH2P - RBH1=-RYH2B-RXH1B - RBH2=-RXH2B - RB1P=RXH1B - RB2P=RXH2B+RYH2B - RH2O=(RXH2P+RXH1P+RPCADX)*VLPO4(L,NY,NX)+(RXH2B+RXH1B+RPCDBX) - 2*VLPOB(L,NY,NX)+2.0*((RPALPX+RPFEPX)*VLPO4(L,NY,NX) - 3+(RPALBX+RPFEBX)*VLPOB(L,NY,NX))+6.0*(RPCAHX*VLPO4(L,NY,NX) - 4+RPCHBX*VLPOB(L,NY,NX)) - BNH4=-RXN4*VLNH4(L,NY,NX)-RXNB*VLNHB(L,NY,NX) - BH2P=RHP2*VLPO4(L,NY,NX)+RHB2*VLPOB(L,NY,NX) - BION=(RYH2P-RPCAMX)*VLPO4(L,NY,NX)+(RYH2B-RPCMBX)*VLPOB(L,NY,NX) - 2-3.0*((RPALPX+RPFEPX)*VLPO4(L,NY,NX) - 3+(RPALBX+RPFEBX)*VLPOB(L,NY,NX)) - 4-2.0*(RPCADX*VLPO4(L,NY,NX)+RPCDBX*VLPOB(L,NY,NX)) - 5-12.0*(RPCAHX*VLPO4(L,NY,NX)+RPCHBX*VLPOB(L,NY,NX)) -C -C CONVERT TOTAL ION FLUXES FROM CHANGES IN CONCENTRATION -C TO CHANGES IN MASS PER UNIT AREA FOR USE IN 'REDIST' -C - TRN4S(L,NY,NX)=TRN4S(L,NY,NX)+RN4S*VOLWNH - TRN4B(L,NY,NX)=TRN4B(L,NY,NX)+RN4B*VOLWNB - TRN3S(L,NY,NX)=TRN3S(L,NY,NX)+RN3S*VOLWNH - TRN3B(L,NY,NX)=TRN3B(L,NY,NX)+RN3B*VOLWNB - TRH2P(L,NY,NX)=TRH2P(L,NY,NX)+RHP2*VOLWPO - TRH2B(L,NY,NX)=TRH2B(L,NY,NX)+RHB2*VOLWPB - TRXN4(L,NY,NX)=TRXN4(L,NY,NX)+RXN4*VOLWNH - TRXNB(L,NY,NX)=TRXNB(L,NY,NX)+RXNB*VOLWNB - TRXH1(L,NY,NX)=TRXH1(L,NY,NX)+RXH1*VOLWPO - TRXH2(L,NY,NX)=TRXH2(L,NY,NX)+RXH2*VOLWPO - TRX1P(L,NY,NX)=TRX1P(L,NY,NX)+RX1P*VOLWPO - TRX2P(L,NY,NX)=TRX2P(L,NY,NX)+RX2P*VOLWPO - TRBH1(L,NY,NX)=TRBH1(L,NY,NX)+RBH1*VOLWPB - TRBH2(L,NY,NX)=TRBH2(L,NY,NX)+RBH2*VOLWPB - TRB1P(L,NY,NX)=TRB1P(L,NY,NX)+RB1P*VOLWPB - TRB2P(L,NY,NX)=TRB2P(L,NY,NX)+RB2P*VOLWPB - TRALPO(L,NY,NX)=TRALPO(L,NY,NX)+RPALPX*VOLWPO - TRFEPO(L,NY,NX)=TRFEPO(L,NY,NX)+RPFEPX*VOLWPO - TRCAPD(L,NY,NX)=TRCAPD(L,NY,NX)+RPCADX*VOLWPO - TRCAPH(L,NY,NX)=TRCAPH(L,NY,NX)+RPCAHX*VOLWPO - TRCAPM(L,NY,NX)=TRCAPM(L,NY,NX)+RPCAMX*VOLWPO - TRALPB(L,NY,NX)=TRALPB(L,NY,NX)+RPALBX*VOLWPB - TRFEPB(L,NY,NX)=TRFEPB(L,NY,NX)+RPFEBX*VOLWPB - TRCPDB(L,NY,NX)=TRCPDB(L,NY,NX)+RPCDBX*VOLWPB - TRCPHB(L,NY,NX)=TRCPHB(L,NY,NX)+RPCHBX*VOLWPB - TRCPMB(L,NY,NX)=TRCPMB(L,NY,NX)+RPCMBX*VOLWPB - TRH2O(L,NY,NX)=TRH2O(L,NY,NX)+RH2O*VOLWM(NPH,L,NY,NX) - TBNH4(L,NY,NX)=TBNH4(L,NY,NX)+BNH4*VOLWM(NPH,L,NY,NX) - TBH2P(L,NY,NX)=TBH2P(L,NY,NX)+BH2P*VOLWM(NPH,L,NY,NX) - TBION(L,NY,NX)=TBION(L,NY,NX)+BION*VOLWM(NPH,L,NY,NX) -C IF(L.EQ.1)THEN -C WRITE(*,4334)'RH2O',I,J,L,TRH2O(L,NY,NX),RH2O,RXH2P,RXH1P,RPCADX -C 2,VLPO4(L,NY,NX),RXH2B,RXH1B,RPCDBX -C 2,VLPOB(L,NY,NX),RPALPX,RPFEPX,VLPO4(L,NY,NX) -C 3,RPALBX,RPFEBX,VLPOB(L,NY,NX),RPCAHX,VLPO4(L,NY,NX) -C 4,RPCHBX,VLPOB(L,NY,NX),VOLWM(NPH,L,NY,NX) -C 5,TADA,XOH21,CH2P1,SPH2P,XH2P1,H2PO4(L,NY,NX),VOLWPX,RH2PX -C 6,VOLWPO,XH2PS(L,NY,NX),TUPH2P(L,NY,NX) -4334 FORMAT(A8,3I4,40E12.4) -C ENDIF - ENDIF -C -C CHANGE IN WIDTHS AND DEPTHS OF FERTILIZER BANDS FROM -C VERTICAL AND HORIZONTAL DIFFUSION DRIVEN BY CONCENTRATION -C DIFFERENCES BETWEEN BAND AND NON-BAND SOIL ZONES -C -C IF(ROWI(I,NY,NX).GT.0.0)THEN - FLWD=0.5*(FLW(3,L,NY,NX)+FLW(3,L+1,NY,NX))/AREA(3,L,NY,NX) -C -C NH4 FERTILIZER BAND -C - IF(IFNHB(NY,NX).EQ.1.AND.ROWN(NY,NX).GT.0.0)THEN - IF(L.EQ.NU(NY,NX).OR.CDPTH(L-1,NY,NX).LT.DPNH4(NY,NX))THEN -C -C NH4 BAND WIDTH -C - DWNH4=0.5*SQRT(ZNSGL(L,NY,NX))*TORT(L,NY,NX) - WDNHB(L,NY,NX)=AMIN1(ROWN(NY,NX) - 2,AMAX1(0.025,WDNHB(L,NY,NX))+DWNH4) -C -C NH4 BAND DEPTH -C - IF(CDPTH(L,NY,NX).GE.DPNH4(NY,NX))THEN - DPFLW=FLWD+DWNH4 - DPNH4(NY,NX)=DPNH4(NY,NX)+DPFLW - DPNHB(L,NY,NX)=DPNHB(L,NY,NX)+DPFLW - IF(DPNHB(L,NY,NX).GT.DLYR(3,L,NY,NX))THEN - DPNHB(L+1,NY,NX)=DPNHB(L+1,NY,NX)+(DPNHB(L,NY,NX)-DLYR(3,L,NY,NX)) - WDNHB(L+1,NY,NX)=WDNHB(L,NY,NX) - DPNHB(L,NY,NX)=DLYR(3,L,NY,NX) - ELSEIF(DPNHB(L,NY,NX).LT.0.0)THEN - DPNHB(L-1,NY,NX)=DPNHB(L-1,NY,NX)+DPNHB(L,NY,NX) - DPNHB(L,NY,NX)=0.0 - WDNHB(L,NY,NX)=0.0 - ENDIF - ENDIF -C -C FRACTION OF SOIL LAYER OCCUPIED BY NH4 BAND -C FROM BAND WIDTH X DEPTH -C - XVLNH4=VLNH4(L,NY,NX) - VLNHB(L,NY,NX)=AMIN1(0.999,WDNHB(L,NY,NX)/ROWN(NY,NX) - 2*DPNHB(L,NY,NX)/DLYR(3,L,NY,NX)) - VLNH4(L,NY,NX)=1.0-VLNHB(L,NY,NX) - FVLNH4=AMIN1(0.0,(VLNH4(L,NY,NX)-XVLNH4)/XVLNH4) -C -C TRANSFER NH4, NH3 FROM NON-BAND TO BAND -C DURING BAND GROWTH -C - DNH4S=FVLNH4*ZNH4S(L,NY,NX)/14.0 - DNH3S=FVLNH4*ZNH3S(L,NY,NX)/14.0 - DXNH4=FVLNH4*XN4(L,NY,NX) - TRN4S(L,NY,NX)=TRN4S(L,NY,NX)+DNH4S - TRN4B(L,NY,NX)=TRN4B(L,NY,NX)-DNH4S - TRN3S(L,NY,NX)=TRN3S(L,NY,NX)+DNH3S - TRN3B(L,NY,NX)=TRN3B(L,NY,NX)-DNH3S - TRXN4(L,NY,NX)=TRXN4(L,NY,NX)+DXNH4 - TRXNB(L,NY,NX)=TRXNB(L,NY,NX)-DXNH4 - ELSE -C -C AMALGAMATE NH4 BAND WITH NON-BAND -C - DPNHB(L,NY,NX)=0.0 - WDNHB(L,NY,NX)=0.0 - VLNH4(L,NY,NX)=1.0 - VLNHB(L,NY,NX)=0.0 - ZNH4S(L,NY,NX)=ZNH4S(L,NY,NX)+ZNH4B(L,NY,NX) - ZNH3S(L,NY,NX)=ZNH3S(L,NY,NX)+ZNH3B(L,NY,NX) - ZNH4B(L,NY,NX)=0.0 - ZNH3B(L,NY,NX)=0.0 - XN4(L,NY,NX)=XN4(L,NY,NX)+XNB(L,NY,NX) - XNB(L,NY,NX)=0.0 - ENDIF - ENDIF -C -C NO3 FERTILIZER BAND -C - IF(IFNOB(NY,NX).EQ.1.AND.ROWO(NY,NX).GT.0.0)THEN - IF(L.EQ.NU(NY,NX).OR.CDPTH(L-1,NY,NX).LT.DPNO3(NY,NX))THEN -C -C NO3 BAND WIDTH -C - DWNO3=0.5*SQRT(ZOSGL(L,NY,NX))*TORT(L,NY,NX) - WDNOB(L,NY,NX)=AMIN1(ROWO(NY,NX),WDNOB(L,NY,NX)+DWNO3) -C -C NO3 BAND DEPTH -C - IF(CDPTH(L,NY,NX).GE.DPNO3(NY,NX))THEN - DPFLW=FLWD+DWNO3 - DPNO3(NY,NX)=DPNO3(NY,NX)+DPFLW - DPNOB(L,NY,NX)=DPNOB(L,NY,NX)+DPFLW - IF(DPNOB(L,NY,NX).GT.DLYR(3,L,NY,NX))THEN - DPNOB(L+1,NY,NX)=DPNOB(L+1,NY,NX)+(DPNOB(L,NY,NX)-DLYR(3,L,NY,NX)) - WDNOB(L+1,NY,NX)=WDNOB(L,NY,NX) - DPNOB(L,NY,NX)=DLYR(3,L,NY,NX) - ELSE IF(DPNOB(L,NY,NX).LT.0.0)THEN - DPNOB(L-1,NY,NX)=DPNOB(L-1,NY,NX)+DPNOB(L,NY,NX) - DPNOB(L,NY,NX)=0.0 - WDNOB(L,NY,NX)=0.0 - ENDIF - ENDIF -C -C FRACTION OF SOIL LAYER OCCUPIED BY NO3 BAND -C FROM BAND WIDTH X DEPTH -C - XVLNO3=VLNO3(L,NY,NX) - VLNOB(L,NY,NX)=AMIN1(0.999,WDNOB(L,NY,NX)/ROWO(NY,NX) - 2*DPNOB(L,NY,NX)/DLYR(3,L,NY,NX)) - VLNO3(L,NY,NX)=1.0-VLNOB(L,NY,NX) - FVLNO3=AMIN1(0.0,(VLNO3(L,NY,NX)-XVLNO3)/XVLNO3) -C -C TRANSFER NO3 FROM NON-BAND TO BAND -C DURING BAND GROWTH -C - DNO3S=FVLNO3*ZNO3S(L,NY,NX)/14.0 - DNO2S=FVLNO3*ZNO2S(L,NY,NX)/14.0 - TRNO3(L,NY,NX)=TRNO3(L,NY,NX)+DNO3S - TRNO2(L,NY,NX)=TRNO2(L,NY,NX)+DNO2S - TRNOB(L,NY,NX)=TRNOB(L,NY,NX)-DNO3S - TRN2B(L,NY,NX)=TRN2B(L,NY,NX)-DNO2S - ELSE -C -C AMALGAMATE NO3 BAND WITH NON-BAND -C - DPNOB(L,NY,NX)=0.0 - WDNOB(L,NY,NX)=0.0 - VLNO3(L,NY,NX)=1.0 - VLNOB(L,NY,NX)=0.0 - ZNO3S(L,NY,NX)=ZNO3S(L,NY,NX)+ZNO3B(L,NY,NX) - ZNO2S(L,NY,NX)=ZNO2S(L,NY,NX)+ZNO2B(L,NY,NX) - ZNO3B(L,NY,NX)=0.0 - ZNO2B(L,NY,NX)=0.0 - ENDIF - ENDIF -C -C PO4 FERTILIZER BAND -C - IF(IFPOB(NY,NX).EQ.1.AND.ROWP(NY,NX).GT.0.0)THEN - IF(L.EQ.NU(NY,NX).OR.CDPTH(L-1,NY,NX).LT.DPPO4(NY,NX))THEN -C -C PO4 BAND WIDTH -C - DWPO4=0.5*SQRT(POSGL(L,NY,NX))*TORT(L,NY,NX) - WDPOB(L,NY,NX)=AMIN1(ROWP(NY,NX),WDPOB(L,NY,NX)+DWPO4) -C -C PO4 BAND DEPTH -C - IF(CDPTH(L,NY,NX).GE.DPPO4(NY,NX))THEN - DPFLW=FLWD+DWPO4 - DPPO4(NY,NX)=DPPO4(NY,NX)+DPFLW - DPPOB(L,NY,NX)=DPPOB(L,NY,NX)+DPFLW - IF(DPPOB(L,NY,NX).GT.DLYR(3,L,NY,NX))THEN - DPPOB(L+1,NY,NX)=DPPOB(L+1,NY,NX)+(DPPOB(L,NY,NX)-DLYR(3,L,NY,NX)) - WDPOB(L+1,NY,NX)=WDPOB(L,NY,NX) - DPPOB(L,NY,NX)=DLYR(3,L,NY,NX) - ELSE IF(DPPOB(L,NY,NX).LT.0.0)THEN - DPPOB(L-1,NY,NX)=DPPOB(L-1,NY,NX)+DPPOB(L,NY,NX) - DPPOB(L,NY,NX)=0.0 - WDPOB(L,NY,NX)=0.0 - ENDIF - ENDIF -C -C FRACTION OF SOIL LAYER OCCUPIED BY PO4 BAND -C FROM BAND WIDTH X DEPTH -C - XVLPO4=VLPO4(L,NY,NX) - VLPOB(L,NY,NX)=AMIN1(0.999,WDPOB(L,NY,NX)/ROWP(NY,NX) - 2*DPPOB(L,NY,NX)/DLYR(3,L,NY,NX)) - VLPO4(L,NY,NX)=1.0-VLPOB(L,NY,NX) - FVLPO4=AMIN1(0.0,(VLPO4(L,NY,NX)-XVLPO4)/XVLPO4) -C -C TRANSFER NO3 FROM NON-BAND TO BAND -C DURING BAND GROWTH DEPENDING ON SALT -C VS. NON-SALT OPTION -C - IF(ISALT(NY,NX).NE.0)THEN - DZH0P=FVLPO4*H0PO4(L,NY,NX) - DZH1P=FVLPO4*H1PO4(L,NY,NX) - DZH2P=FVLPO4*H2PO4(L,NY,NX)/31.0 - DZH3P=FVLPO4*H3PO4(L,NY,NX) - DZF1P=FVLPO4*ZFE1P(L,NY,NX) - DZF2P=FVLPO4*ZFE2P(L,NY,NX) - DZC0P=FVLPO4*ZCA0P(L,NY,NX) - DZC1P=FVLPO4*ZCA1P(L,NY,NX) - DZC2P=FVLPO4*ZCA2P(L,NY,NX) - DZM1P=FVLPO4*ZMG1P(L,NY,NX) - DXOH0=FVLPO4*XOH0(L,NY,NX) - DXOH1=FVLPO4*XOH1(L,NY,NX) - DXOH2=FVLPO4*XOH2(L,NY,NX) - DXH1P=FVLPO4*XH1P(L,NY,NX) - DXH2P=FVLPO4*XH2P(L,NY,NX) - DPALP=FVLPO4*PALPO(L,NY,NX) - DPFEP=FVLPO4*PFEPO(L,NY,NX) - DPCDP=FVLPO4*PCAPD(L,NY,NX) - DPCHP=FVLPO4*PCAPH(L,NY,NX) - DPCMP=FVLPO4*PCAPM(L,NY,NX) - TRH0P(L,NY,NX)=TRH0P(L,NY,NX)+DZH0P - TRH1P(L,NY,NX)=TRH1P(L,NY,NX)+DZH1P - TRH2P(L,NY,NX)=TRH2P(L,NY,NX)+DZH2P - TRH3P(L,NY,NX)=TRH3P(L,NY,NX)+DZH3P - TRF1P(L,NY,NX)=TRF1P(L,NY,NX)+DZF1P - TRF2P(L,NY,NX)=TRF2P(L,NY,NX)+DZF2P - TRC0P(L,NY,NX)=TRC0P(L,NY,NX)+DZC0P - TRC1P(L,NY,NX)=TRC1P(L,NY,NX)+DZC1P - TRC2P(L,NY,NX)=TRC2P(L,NY,NX)+DZC2P - TRM1P(L,NY,NX)=TRM1P(L,NY,NX)+DZM1P - TRH0B(L,NY,NX)=TRH0B(L,NY,NX)-DZH0P - TRH1B(L,NY,NX)=TRH1B(L,NY,NX)-DZH1P - TRH2B(L,NY,NX)=TRH2B(L,NY,NX)-DZH2P - TRH3B(L,NY,NX)=TRH3B(L,NY,NX)-DZH3P - TRF1B(L,NY,NX)=TRF1B(L,NY,NX)-DZF1P - TRF2B(L,NY,NX)=TRF2B(L,NY,NX)-DZF2P - TRC0B(L,NY,NX)=TRC0B(L,NY,NX)-DZC0P - TRC1B(L,NY,NX)=TRC1B(L,NY,NX)-DZC1P - TRC2B(L,NY,NX)=TRC2B(L,NY,NX)-DZC2P - TRM1B(L,NY,NX)=TRM1B(L,NY,NX)-DZM1P - TRXH0(L,NY,NX)=TRXH0(L,NY,NX)+DXOH0 - TRXH1(L,NY,NX)=TRXH1(L,NY,NX)+DXOH1 - TRXH2(L,NY,NX)=TRXH2(L,NY,NX)+DXOH2 - TRX1P(L,NY,NX)=TRX1P(L,NY,NX)+DXH1P - TRX2P(L,NY,NX)=TRX2P(L,NY,NX)+DXH2P - TRBH0(L,NY,NX)=TRBH0(L,NY,NX)-DXOH0 - TRBH1(L,NY,NX)=TRBH1(L,NY,NX)-DXOH1 - TRBH2(L,NY,NX)=TRBH2(L,NY,NX)-DXOH2 - TRB1P(L,NY,NX)=TRB1P(L,NY,NX)-DXH1P - TRB2P(L,NY,NX)=TRB2P(L,NY,NX)-DXH2P - TRALPO(L,NY,NX)=TRALPO(L,NY,NX)+DPALP - TRFEPO(L,NY,NX)=TRFEPO(L,NY,NX)+DPFEP - TRCAPD(L,NY,NX)=TRCAPD(L,NY,NX)+DPCDP - TRCAPH(L,NY,NX)=TRCAPH(L,NY,NX)+DPCHP - TRCAPM(L,NY,NX)=TRCAPM(L,NY,NX)+DPCMP - TRALPB(L,NY,NX)=TRALPB(L,NY,NX)-DPALP - TRFEPB(L,NY,NX)=TRFEPB(L,NY,NX)-DPFEP - TRCPDB(L,NY,NX)=TRCPDB(L,NY,NX)-DPCDP - TRCPHB(L,NY,NX)=TRCPHB(L,NY,NX)-DPCHP - TRCPMB(L,NY,NX)=TRCPMB(L,NY,NX)-DPCMP - ELSE - DZH2P=FVLPO4*H2PO4(L,NY,NX)/31.0 - DXOH1=FVLPO4*XOH1(L,NY,NX) - DXOH2=FVLPO4*XOH2(L,NY,NX) - DXH2P=FVLPO4*XH2P(L,NY,NX) - DPALP=FVLPO4*PALPO(L,NY,NX) - DPFEP=FVLPO4*PFEPO(L,NY,NX) - DPCDP=FVLPO4*PCAPD(L,NY,NX) - DPCHP=FVLPO4*PCAPH(L,NY,NX) - DPCMP=FVLPO4*PCAPM(L,NY,NX) - TRH2P(L,NY,NX)=TRH2P(L,NY,NX)+DZH2P - TRXH1(L,NY,NX)=TRXH1(L,NY,NX)+DXOH1 - TRXH2(L,NY,NX)=TRXH2(L,NY,NX)+DXOH2 - TRX2P(L,NY,NX)=TRX2P(L,NY,NX)+DXH2P - TRH2B(L,NY,NX)=TRH2B(L,NY,NX)-DZH2P - TRBH1(L,NY,NX)=TRBH1(L,NY,NX)-DXOH1 - TRBH2(L,NY,NX)=TRBH2(L,NY,NX)-DXOH2 - TRB2P(L,NY,NX)=TRB2P(L,NY,NX)-DXH2P - TRALPO(L,NY,NX)=TRALPO(L,NY,NX)+DPALP - TRFEPO(L,NY,NX)=TRFEPO(L,NY,NX)+DPFEP - TRCAPD(L,NY,NX)=TRCAPD(L,NY,NX)+DPCDP - TRCAPH(L,NY,NX)=TRCAPH(L,NY,NX)+DPCHP - TRCAPM(L,NY,NX)=TRCAPM(L,NY,NX)+DPCMP - TRALPB(L,NY,NX)=TRALPB(L,NY,NX)-DPALP - TRFEPB(L,NY,NX)=TRFEPB(L,NY,NX)-DPFEP - TRCPDB(L,NY,NX)=TRCPDB(L,NY,NX)-DPCDP - TRCPHB(L,NY,NX)=TRCPHB(L,NY,NX)-DPCHP - TRCPMB(L,NY,NX)=TRCPMB(L,NY,NX)-DPCMP - ENDIF - ELSE -C -C AMALGAMATE PO4 BAND WITH NON-BAND -C - DPPOB(L,NY,NX)=0.0 - WDPOB(L,NY,NX)=0.0 - VLPOB(L,NY,NX)=0.0 - VLPO4(L,NY,NX)=1.0 - H0PO4(L,NY,NX)=H0PO4(L,NY,NX)+H0POB(L,NY,NX) - H1PO4(L,NY,NX)=H1PO4(L,NY,NX)+H1POB(L,NY,NX) - H2PO4(L,NY,NX)=H2PO4(L,NY,NX)+H2POB(L,NY,NX) - H3PO4(L,NY,NX)=H3PO4(L,NY,NX)+H3POB(L,NY,NX) - ZFE1P(L,NY,NX)=ZFE1P(L,NY,NX)+ZFE1PB(L,NY,NX) - ZFE2P(L,NY,NX)=ZFE2P(L,NY,NX)+ZFE2PB(L,NY,NX) - ZCA0P(L,NY,NX)=ZCA0P(L,NY,NX)+ZCA0PB(L,NY,NX) - ZCA1P(L,NY,NX)=ZCA1P(L,NY,NX)+ZCA1PB(L,NY,NX) - ZCA2P(L,NY,NX)=ZCA2P(L,NY,NX)+ZCA2PB(L,NY,NX) - ZMG1P(L,NY,NX)=ZMG1P(L,NY,NX)+ZMG1PB(L,NY,NX) - H0POB(L,NY,NX)=0.0 - H1POB(L,NY,NX)=0.0 - H2POB(L,NY,NX)=0.0 - H3POB(L,NY,NX)=0.0 - ZFE1PB(L,NY,NX)=0.0 - ZFE2PB(L,NY,NX)=0.0 - ZCA0PB(L,NY,NX)=0.0 - ZCA1PB(L,NY,NX)=0.0 - ZCA2PB(L,NY,NX)=0.0 - ZMG1PB(L,NY,NX)=0.0 - XOH0(L,NY,NX)=XOH0(L,NY,NX)+XOH0B(L,NY,NX) - XOH1(L,NY,NX)=XOH1(L,NY,NX)+XOH1B(L,NY,NX) - XOH2(L,NY,NX)=XOH2(L,NY,NX)+XOH2B(L,NY,NX) - XH1P(L,NY,NX)=XH1P(L,NY,NX)+XH1PB(L,NY,NX) - XH2P(L,NY,NX)=XH2P(L,NY,NX)+XH2PB(L,NY,NX) - XOH0B(L,NY,NX)=0.0 - XOH1B(L,NY,NX)=0.0 - XOH2B(L,NY,NX)=0.0 - XH1PB(L,NY,NX)=0.0 - XH2PB(L,NY,NX)=0.0 - PALPO(L,NY,NX)=PALPO(L,NY,NX)+PALPB(L,NY,NX) - PFEPO(L,NY,NX)=PFEPO(L,NY,NX)+PFEPB(L,NY,NX) - PCAPD(L,NY,NX)=PCAPD(L,NY,NX)+PCPDB(L,NY,NX) - PCAPH(L,NY,NX)=PCAPH(L,NY,NX)+PCPHB(L,NY,NX) - PCAPM(L,NY,NX)=PCAPM(L,NY,NX)+PCPMB(L,NY,NX) - PALPB(L,NY,NX)=0.0 - PFEPB(L,NY,NX)=0.0 - PCPDB(L,NY,NX)=0.0 - PCPHB(L,NY,NX)=0.0 - PCPMB(L,NY,NX)=0.0 - ENDIF - ENDIF -C ENDIF -C -C SUBTRACT FERTILIZER DISSOLUTION FROM FERTILIZER POOLS -C - ZNH4FA(L,NY,NX)=ZNH4FA(L,NY,NX)-RSN4AA-RSN4BA - ZNH3FA(L,NY,NX)=ZNH3FA(L,NY,NX)-RSN3AA-RSN3BA - ZNHUFA(L,NY,NX)=ZNHUFA(L,NY,NX)-RSNUAA-RSNUBA - ZNO3FA(L,NY,NX)=ZNO3FA(L,NY,NX)-RSNOAA-RSNOBA - ZNH4FB(L,NY,NX)=ZNH4FB(L,NY,NX)-RSN4BB - ZNH3FB(L,NY,NX)=ZNH3FB(L,NY,NX)-RSN3BB - ZNHUFB(L,NY,NX)=ZNHUFB(L,NY,NX)-RSNUBB - ZNO3FB(L,NY,NX)=ZNO3FB(L,NY,NX)-RSNOBB -C -C ADD FERTILIZER DISSOLUTION TO ION FLUXES -C - TRN3G(L,NY,NX)=TRN3G(L,NY,NX)+RSN3AA+RSN3BA+RSN3BB - TRN4S(L,NY,NX)=TRN4S(L,NY,NX)+RSN4AA - TRN4B(L,NY,NX)=TRN4B(L,NY,NX)+RSN4BA+RSN4BB - TRN3S(L,NY,NX)=TRN3S(L,NY,NX)+RSNUAA - TRN3B(L,NY,NX)=TRN3B(L,NY,NX)+RSNUBA+RSNUBB - TRNO3(L,NY,NX)=TRNO3(L,NY,NX)+RSNOAA - TRNOB(L,NY,NX)=TRNOB(L,NY,NX)+RSNOBA+RSNOBB - TBNH4(L,NY,NX)=TBNH4(L,NY,NX)+RSN4AA+RSN4BA+RSN4BB - TBNH3(L,NY,NX)=TBNH3(L,NY,NX)+RSN3AA+RSN3BA+RSN3BB - 2+RSNUAA+RSNUBA+RSNUBB - TBNO3(L,NY,NX)=TBNO3(L,NY,NX)+RSNOAA+RSNOBA+RSNOBB - TRN3G(L,NY,NX)=TRN3G(L,NY,NX)*14.0 - TRN4S(L,NY,NX)=TRN4S(L,NY,NX)*14.0 - TRN4B(L,NY,NX)=TRN4B(L,NY,NX)*14.0 - TRN3S(L,NY,NX)=TRN3S(L,NY,NX)*14.0 - TRN3B(L,NY,NX)=TRN3B(L,NY,NX)*14.0 - TRNO3(L,NY,NX)=TRNO3(L,NY,NX)*14.0 - TRNOB(L,NY,NX)=TRNOB(L,NY,NX)*14.0 - TRNO2(L,NY,NX)=TRNO2(L,NY,NX)*14.0 - TRN2B(L,NY,NX)=TRN2B(L,NY,NX)*14.0 - TRH2P(L,NY,NX)=TRH2P(L,NY,NX)*31.0 - TRH2B(L,NY,NX)=TRH2B(L,NY,NX)*31.0 - TRCO2(L,NY,NX)=TBCO2(L,NY,NX)*12.0 -C IF(L.EQ.1)THEN -C WRITE(*,9984)'TRN4S',I,J,L,TRN4S(L,NY,NX) -C 2,RN4S,VOLWNH,RSN4AA,ZNH4FA(L,NY,NX),VLNH4(L,NY,NX) -C 3,TRN4B(L,NY,NX),RN4B,VOLWNB,RSN4BA,RSN4BB,DNH4S -9984 FORMAT(A8,3I4,20E12.4) -C ENDIF - ENDIF -9985 CONTINUE -C -C SURFACE RESIDUE -C - IF(VOLWM(NPH,0,NY,NX).GT.ZEROS(NY,NX))THEN -C -C UREA HYDROLYSIS IN SURFACE RESIDUE -C - IF(VOLQ(0,NY,NX).GT.ZEROS(NY,NX))THEN - COMA=AMIN1(0.1E+06,TOQCK(0,NY,NX)/VOLQ(0,NY,NX)) - ELSE - COMA=0.1E+06 - ENDIF - DUKD=DUKM*(1.0+COMA/DUKI) -C -C UREA HYDROLYSIS INHIBITION -C - IF(ZNHU0(0,NY,NX).GT.ZEROS(NY,NX) - 2.AND.ZNHUI(0,NY,NX).GT.ZEROS(NY,NX))THEN - ZNHUI(0,NY,NX)=ZNHUI(0,NY,NX)-TFNQ(0,NY,NX)**0.25 - 2*RNHUI(IUTYP(NY,NX))*ZNHUI(0,NY,NX) - 3*AMAX1(RNHUI(IUTYP(NY,NX)),1.0-ZNHUI(0,NY,NX)/ZNHU0(0,NY,NX)) - ELSE - ZNHUI(0,NY,NX)=0.0 - ENDIF -C -C UREA CONCENTRATION AND HYDROLYSIS IN SURFACE RESIDUE -C - IF(ZNHUFA(0,NY,NX).GT.ZEROS(NY,NX) - 2.AND.BKVL(0,NY,NX).GT.ZEROS(NY,NX))THEN - CNHUA=ZNHUFA(0,NY,NX)/BKVL(0,NY,NX) - DFNSA=CNHUA/(CNHUA+DUKD) - RSNUA=AMIN1(ZNHUFA(0,NY,NX) - 2,SPNHU*TOQCK(0,NY,NX)*DFNSA*TFNQ(0,NY,NX))*(1.0-ZNHUI(0,NY,NX)) - ELSE - RSNUA=0.0 - ENDIF -C IF(J.EQ.13)THEN -C WRITE(*,8778)'UREA0',I,J,IUTYP(NY,NX) -C 2,ZNHUFA(0,NY,NX),RSNUA -C 2,DFNSA,TFNQ(0,NY,NX),CNHUA,DUKD,DUKM,DUKI,TOQCK(0,NY,NX) -C 3,BKVL(0,NY,NX),TFNQ(0,NY,NX),SPNHU,ZNHU0(0,NY,NX),ZNHUI(0,NY,NX) -C 4,RNHUI(IUTYP(NY,NX)) -8778 FORMAT(A8,3I4,40E12.4) -C ENDIF -C -C NH4, NH3, UREA, NO3 DISSOLUTION IN SURFACE RESIDUE -C FROM FIRST-ORDER FUNCTIONS OF REMAINING -C FERTILIZER (NOTE: SUPERPHOSPHATE AND ROCK PHOSPHATE -C ARE REPRESENTED AS MONOCALCIUM PHOSPHATE AND HYDROXYAPATITE -C MODELLED IN PHOSPHORUS REACTIONS BELOW) -C - RSN4AA=SPNH4*ZNH4FA(0,NY,NX)*THETW(0,NY,NX) - RSN3AA=SPNH3*ZNH3FA(0,NY,NX) - RSNUAA=RSNUA*THETW(0,NY,NX) - RSNOAA=SPNO3*ZNO3FA(0,NY,NX)*THETW(0,NY,NX) - IF(VOLWM(NPH,0,NY,NX).GT.ZEROS(NY,NX))THEN - VOLWMX=14.0*VOLWM(NPH,0,NY,NX) - RN4X=(XNH4S(0,NY,NX)+14.0*RSN4AA)/VOLWMX - RN3X=14.0*RSNUAA/VOLWMX - CN41=AMAX1(0.0,ZNH4S(0,NY,NX)/VOLWMX+RN4X) - CN31=AMAX1(0.0,ZNH3S(0,NY,NX)/VOLWMX+RN3X) - XN41=AMAX1(0.0,XN4(0,NY,NX)/VOLWM(NPH,0,NY,NX)) - VOLWMP=31.0*VOLWM(NPH,0,NY,NX) - RH2PX=XH2PS(0,NY,NX)/VOLWMP - CH2P1=AMAX1(0.0,H2PO4(0,NY,NX)/VOLWMP+RH2PX) - ELSE - RN4X=0.0 - RN3X=0.0 - CN41=0.0 - CN31=0.0 - XN41=0.0 - RH2PX=0.0 - CH2P1=0.0 - ENDIF -C -C PHOSPHORUS TRANSFORMATIONS IN SURFACE RESIDUE -C - PCAPM1=AMAX1(0.0,PCAPM(0,NY,NX)/VOLWM(NPH,0,NY,NX)) - PCAPD1=AMAX1(0.0,PCAPD(0,NY,NX)/VOLWM(NPH,0,NY,NX)) - PCAPH1=AMAX1(0.0,PCAPH(0,NY,NX)/VOLWM(NPH,0,NY,NX)) - PALPO1=AMAX1(0.0,PALPO(0,NY,NX)/VOLWM(NPH,0,NY,NX)) - PFEPO1=AMAX1(0.0,PFEPO(0,NY,NX)/VOLWM(NPH,0,NY,NX)) - CHY1=AMAX1(ZERO,10.0**(-(PH(0,NY,NX)-3.0))) - COH1=AMAX1(ZERO,DPH2O/CHY1) - CAL1=AMAX1(ZERO,SYALO/COH1**3) - CFE1=AMAX1(ZERO,SYFEO/COH1**3) - CCO20=AMAX1(ZERO,CCO2S(0,NY,NX)/12.0) - CCO31=AMAX1(ZERO,CCO20*DPCO3/CHY1**2) - CCA1=AMAX1(ZERO,AMIN1(CCAMX,SPCAC/CCO31)) - CALX=AMAX1(ZERO,CAL1)**0.333 - CCAX=AMAX1(ZERO,CCA1)**0.500 -C -C ALUMINUM PHOSPHATE (VARISCITE) -C - CH2PA=SYA0P2/(CAL1*COH1**2) - RPALPX=AMIN1(AMAX1(0.0,4.0E-08*ORGC(0,NY,NX)-PALPO1) - 2,AMAX1(-PALPO1,TPD*(CH2P1-CH2PA))) -C -C IRON PHOSPHATE (STRENGITE) -C - CH2PF=SYF0P2/(CFE1*COH1**2) - RPFEPX=AMIN1(AMAX1(0.0,2.0E-06*ORGC(0,NY,NX)-PFEPO1) - 2,AMAX1(-PFEPO1,TPD*(CH2P1-CH2PF))) -C -C DICALCIUM PHOSPHATE -C - CH2PD=SYCAD2/(CCA1*COH1) - RPCADX=AMIN1(AMAX1(0-.0,5.0E-05*ORGC(0,NY,NX)-PCAPD1) - 2,AMAX1(-PCAPD1,TPD*(CH2P1-CH2PD))) -C -C HYDROXYAPATITE -C - CH2PH=(SYCAH2/(CCA1**5*COH1**7))**0.333 - RPCAHX=AMIN1(AMAX1(0.0,5.0E-05*ORGC(0,NY,NX)-PCAPH1) - 2,AMAX1(-PCAPH1,TPD*(CH2P1-CH2PH))) -C -C MONOCALCIUM PHOSPHATE -C - CH2PM=SQRT(SPCAM/CCA1) - RPCAMX=AMIN1(AMAX1(0.0,5.0E-05*ORGC(0,NY,NX)-PCAPM1) - 2,AMAX1(-PCAPM1*SPPO4,TPD*(CH2P1-CH2PM))) -C IF(I.GT.315)THEN -C WRITE(*,2227)'RPPO4',I,J,L,RPCAHX,CH2P1,CH2PA,CH2PH -C 2,SYA0P2,CAL1,COH1,SYCAH2,CCA1,CCO21,CCO31,PCAPH1 -C 3,VOLWM(NPH,0,NY,NX),SPCAC/CCO31,H2PO4(0,NY,NX) -C 4,CCO20,DPCO3,CHY1,CCO2S(0,NY,NX) -2227 FORMAT(A8,3I4,20E12.4) -C ENDIF -C -C PHOSPHORUS ANION EXCHANGE IN SURFACE REDISUE -C CALCULATED FROM EXCHANGE EQUILIBRIA AMONG H2PO4-, -C HPO4--, H+, OH- AND PROTONATED AND NON-PROTONATED -OH -C EXCHANGE SITES (NOT CALCULATED) -C -C EQUILIBRIUM X-CA CONCENTRATION FROM CEC AND CATION -C CONCENTRATIONS -C - IF(VOLWM(NPH,0,NY,NX).GT.ZEROS(NY,NX))THEN - CCEC0=AMAX1(0.0,COOH*ORGC(0,NY,NX)/VOLWM(NPH,0,NY,NX)) - ELSE - CCEC0=0.0 - ENDIF - XCAQ=CCEC0/(1.0+GKC4(NU(NY,NX),NY,NX)*CN41/CCAX - 2+GKCH(NU(NY,NX),NY,NX)*CHY1/CCAX+GKCA(NU(NY,NX),NY,NX)*CALX/CCAX) - FCAQ=XCAQ/CCAX - FN4X=FCAQ*GKC4(NU(NY,NX),NY,NX) -C -C NH4 AND NH3 EXCHANGE IN SURFACE RESIDUE -C - RXN4=TADC*(FN4X*CN41-XN41)/(1.0+FN4X) - RNH4=(CHY1*CN31-DPN4*CN41)/(DPN4+CHY1) -C IF(J.EQ.12)THEN -C WRITE(*,2223)'RXN4',I,J,NX,NY,RXN4,CN41,XN41,CCAX,CCA1,CCO20,CCO31 -C 2,XCAQ,CCEC0,FN4X,FCAQ,GKC4(NU(NY,NX),NY,NX),PH(0,NY,NX),CHY1,RNH4 -C 3,CN31,DPN4,ZNH4S(0,NY,NX),XNH4S(0,NY,NX),14.0*RSN4AA,RN4X -2223 FORMAT(A8,4I4,30E12.4) -C ENDIF - ELSE - RSN4AA=0.0 - RSN3AA=0.0 - RSNUAA=0.0 - RSNOAA=0.0 - RPALPX=0.0 - RPFEPX=0.0 - RPCADX=0.0 - RPCAHX=0.0 - RPCAMX=0.0 - RXN4=0.0 - RNH4=0.0 - ENDIF -C -C TOTAL ION FLUXES FOR ALL REACTIONS ABOVE -C - RN4S=RNH4-RXN4 - RN3S=-RNH4 - RHP2=-RPALPX-RPFEPX-RPCADX-2.0*RPCAMX-3.0*RPCAHX - RH2O=RPCADX+2.0*(RPALPX+RPFEPX)+6.0*RPCAHX - BNH4=-RXN4 - BH2P=RHP2 - BION=-RPCAMX-3.0*(RPALPX+RPFEPX)-2.0*RPCADX-12.0*RPCAHX -C -C CONVERT TOTAL ION FLUXES FROM CHANGES IN CONCENTRATION -C TO CHANGES IN MASS PER UNIT AREA FOR USE IN 'REDIST' -C - TRN4S(0,NY,NX)=TRN4S(0,NY,NX)+RN4S*VOLWM(NPH,0,NY,NX) - TRN3S(0,NY,NX)=TRN3S(0,NY,NX)+RN3S*VOLWM(NPH,0,NY,NX) - TRH2P(0,NY,NX)=TRH2P(0,NY,NX)+RHP2*VOLWM(NPH,0,NY,NX) - TRXN4(0,NY,NX)=TRXN4(0,NY,NX)+RXN4*VOLWM(NPH,0,NY,NX) - TRALPO(0,NY,NX)=TRALPO(0,NY,NX)+RPALPX*VOLWM(NPH,0,NY,NX) - TRFEPO(0,NY,NX)=TRFEPO(0,NY,NX)+RPFEPX*VOLWM(NPH,0,NY,NX) - TRCAPD(0,NY,NX)=TRCAPD(0,NY,NX)+RPCADX*VOLWM(NPH,0,NY,NX) - TRCAPH(0,NY,NX)=TRCAPH(0,NY,NX)+RPCAHX*VOLWM(NPH,0,NY,NX) - TRCAPM(0,NY,NX)=TRCAPM(0,NY,NX)+RPCAMX*VOLWM(NPH,0,NY,NX) - TRH2O(0,NY,NX)=TRH2O(0,NY,NX)+RH2O*VOLWM(NPH,0,NY,NX) - TBNH4(0,NY,NX)=TBNH4(0,NY,NX)+BNH4*VOLWM(NPH,0,NY,NX) - TBH2P(0,NY,NX)=TBH2P(0,NY,NX)+BH2P*VOLWM(NPH,0,NY,NX) - TBION(0,NY,NX)=TBION(0,NY,NX)+BION*VOLWM(NPH,0,NY,NX) - ZNH4FA(0,NY,NX)=ZNH4FA(0,NY,NX)-RSN4AA - ZNH3FA(0,NY,NX)=ZNH3FA(0,NY,NX)-RSN3AA - ZNHUFA(0,NY,NX)=ZNHUFA(0,NY,NX)-RSNUAA - ZNO3FA(0,NY,NX)=ZNO3FA(0,NY,NX)-RSNOAA - TRN4S(0,NY,NX)=TRN4S(0,NY,NX)+RSN4AA - TRN3S(0,NY,NX)=TRN3S(0,NY,NX)+RSN3AA+RSNUAA - TRNO3(0,NY,NX)=TRNO3(0,NY,NX)+RSNOAA - TBNH4(0,NY,NX)=TBNH4(0,NY,NX)+RSN4AA - TBNH3(0,NY,NX)=TBNH3(0,NY,NX)+RSN3AA+RSNUAA - TBNO3(0,NY,NX)=TBNO3(0,NY,NX)+RSNOAA - TRN4S(0,NY,NX)=TRN4S(0,NY,NX)*14.0 - TRN3S(0,NY,NX)=TRN3S(0,NY,NX)*14.0 - TRNO3(0,NY,NX)=TRNO3(0,NY,NX)*14.0 - TRH2P(0,NY,NX)=TRH2P(0,NY,NX)*31.0 -C WRITE(*,9989)'TRH2O',I,J,TRH2O(0,NY,NX) -C 2,RH2O,VOLWM(NPH,0,NY,NX),RPCADX,RPALPX,RPFEPX,RPCAHX -C WRITE(*,9989)'TRN4S',I,J,TRN4S(0,NY,NX) -C 2,RN4S,RNH4,RXN4,RSN4AA,VOLWM(NPH,0,NY,NX) -C 3,SPNH4,ZNH4FA(0,NY,NX) -C 4,THETW(0,NY,NX) -9989 FORMAT(A8,2I4,12E12.4) -9990 CONTINUE -9995 CONTINUE - RETURN - END + + SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) +C +C THIS SUBROUTINE CALCULATES ALL SOLUTE TRANSFORMATIONS +C FROM THERMODYNAMIC EQUILIBRIA +C + include "parameters.h" + include "blkc.h" + include "blk2a.h" + include "blk2b.h" + include "blk2c.h" + include "blk8a.h" + include "blk8b.h" + include "blk10.h" + include "blk11a.h" + include "blk11b.h" + include "blk13a.h" + include "blk13b.h" + include "blk13c.h" + include "blk15a.h" + include "blk15b.h" + include "blk18a.h" + include "blk18b.h" + include "blk19a.h" + include "blk19b.h" + include "blk19c.h" + include "blk19d.h" + include "blk21a.h" + include "blk21b.h" +C +C EQUILIBRIUM CONSTANTS +C + DIMENSION RNHUI(2) + PARAMETER (DPH2O=6.5E-09,SYALO=4.0E-21,SYFEO=4.0E-26 + 2,SPCAC=4.0E-03,SPCAS=1.4E+01,SPALP=3.5E-15,SPFEP=3.0E-20 + 3,SPCAM=7.0E+07,SPCAD=1.0E-01,SPCAH=6.4E-32,SXOH2=4.5E-05 + 4,SXOH1=1.1E-06,SYH2P=1.6E+04,SHH2P=SYH2P*DPH2O,SYH1P=1.6E+04 + 5,SHH1P=SYH1P*DPH2O,DPCO2=4.2E-04,DPHCO=5.6E-08 + 6,DPN4=5.7E-07,DPAL1=8.6E-07,DPAL2=1.8E-08,DPAL3=2.0E-04 + 7,DPAL4=8.0E-03,DPALS=0.16,DPFE1=7.1E-10,DPFE2=1.45E-08 + 8,DPFE3=1.15E-04,DPFE4=1.45E-03,DPFES=7.1E-02,DPCAO=12.5 + 9,DPCAC=4.2E-02,DPCAH=13.5,DPCAS=1.2,DPMGO=0.7,DPMGC=0.3 + 1,DPMGH=67.0,DPMGS=2.1,DPNAC=0.45,DPNAS=3.3E+02,DPKAS=5.0E+01 + 2,DPH1P=4.5E-10,DPH2P=6.3E-05,DPH3P=7.1,DPF1P=4.5E-02 + 3,DPF2P=3.7E-03,DPC0P=3.5E-04,DPC1P=1.82,DPC2P=40.0 + 4,DPM1P=1.23,DPCOH=1.0E-02,DPALO=6.3E+04) + PARAMETER (DPCO3=DPCO2*DPHCO,SHALO=SYALO/DPH2O**3 + 2,SYAL1=SYALO/DPAL1,SHAL1=SYAL1/DPH2O**2,SYAL2=SYAL1/DPAL2 + 3,SHAL2=SYAL2/DPH2O,SPAL3=SYAL2/DPAL3,SYAL4=SPAL3/DPAL4 + 4,SHAL4=SYAL4*DPH2O,SHFEO=SYFEO/DPH2O**3,SYFE1=SYFEO/DPFE1 + 5,SHFE1=SYFE1/DPH2O**2,SYFE2=SYFE1/DPFE2,SHFE2=SYFE2/DPH2O + 6,SPFE3=SYFE2/DPFE3,SYFE4=SPFE3/DPFE4,SHFE4=SYFE4*DPH2O + 7,SHCAC1=SPCAC/DPHCO,SYCAC1=SHCAC1*DPH2O,SHCAC2=SHCAC1/DPCO2 + 8,SYCAC2=SHCAC2*DPH2O**2,SHA0P1=SPALP/DPH1P,SYA0P1=SHA0P1*DPH2O + 9,SPA1P1=SYA0P1/DPAL1,SYA2P1=SPA1P1/DPAL2,SHA2P1=SYA2P1*DPH2O + 1,SYA3P1=SYA2P1/DPAL3,SHA3P1=SYA3P1*DPH2O**2,SYA4P1=SYA3P1/DPAL4 + 2,SHA4P1=SYA4P1*DPH2O**3,SHA0P2=SHA0P1/DPH2P + 3,SYA0P2=SHA0P2*DPH2O**2,SYA1P2=SYA0P2/DPAL1,SHA1P2=SYA1P2/DPH2O + 4,SPA2P2=SYA1P2/DPAL2,SYA3P2=SPA2P2/DPAL3,SHA3P2=SYA3P2*DPH2O + 5,SYA4P2=SYA3P2/DPAL4,SHA4P2=SYA4P2*DPH2O**2) + PARAMETER (SHF0P1=SPFEP/DPH1P,SYF0P1=SHF0P1*DPH2O + 2,SPF1P1=SYF0P1/DPFE1,SYF2P1=SPF1P1/DPFE2,SHF2P1=SYF2P1*DPH2O + 3,SYF3P1=SYF2P1/DPFE3,SHF3P1=SYF3P1*DPH2O**2,SYF4P1=SYF3P1/DPFE4 + 4,SHF4P1=SYF4P1*DPH2O**3,SHF0P2=SHF0P1/DPH2P,SYF0P2=SHF0P2*DPH2O**2 + 5,SYF1P2=SYF0P2/DPFE1,SHF1P2=SYF1P2/DPH2O,SPF2P2=SYF1P2/DPFE2 + 6,SYF3P2=SPF2P2/DPFE3,SHF3P2=SYF3P2*DPH2O,SYF4P2=SYF3P2/DPFE4 + 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=5,TPD=1.0E-03,TPDX=TPD/MRXN,TADA=3.3E-01 + 2,TADAX=TADA/MRXN,TADC=3.3E-01,TADCX=TADC/MRXN + 3,TSL=1.0,TSLX=TSL/MRXN) + PARAMETER (DUKM=1.0,DUKI=2.5,A0=1.0,AE=10.0,COOH=2.5E-02 + 2,CCAMX=100.0) + PARAMETER (SPNH4=1.0E-00,SPNH3=1.0E-00,SPNHU=5.0E-01 + 2,SPNO3=1.0E-00,SPPO4=5.0E-03) + DATA RNHUI/5.0E-03,5.0E-04/ +C +C DUKM FROM SOIL SCI 136:56 +C + NPI=INT(NPH/2) + DO 9995 NX=NHW,NHE + DO 9990 NY=NVN,NVS + DO 9985 L=NU(NY,NX),NL(NY,NX) + IF(THETW(L,NY,NX).GT.ZEROS(NY,NX))THEN +C +C WATER VOLUME IN NON-BAND AND BAND SOIL ZONES +C + VOLWNH=VOLWM(NPH,L,NY,NX)*VLNH4(L,NY,NX) + VOLWNB=VOLWM(NPH,L,NY,NX)*VLNHB(L,NY,NX) + VOLWNO=VOLWM(NPH,L,NY,NX)*VLNO3(L,NY,NX) + VOLWNZ=VOLWM(NPH,L,NY,NX)*VLNOB(L,NY,NX) + VOLWPO=VOLWM(NPH,L,NY,NX)*VLPO4(L,NY,NX) + VOLWPB=VOLWM(NPH,L,NY,NX)*VLPOB(L,NY,NX) +C +C UREA HYDROLYSIS IN BAND AND NON-BAND SOIL ZONES +C + IF(VOLQ(L,NY,NX).GT.ZEROS(NY,NX))THEN + COMA=AMIN1(0.1E+06,TOQCK(L,NY,NX)/VOLQ(L,NY,NX)) + ELSE + COMA=0.1E+06 + ENDIF + DUKD=DUKM*(1.0+COMA/DUKI) +C +C UREA HYDROLYSIS INHIBITION +C + IF(ZNHU0(L,NY,NX).GT.ZEROS(NY,NX) + 2.AND.ZNHUI(L,NY,NX).GT.ZEROS(NY,NX))THEN + ZNHUI(L,NY,NX)=ZNHUI(L,NY,NX) + 2-RNHUI(IUTYP(NY,NX))*ZNHUI(L,NY,NX) + 3*AMAX1(RNHUI(IUTYP(NY,NX)),1.0-ZNHUI(L,NY,NX)/ZNHU0(L,NY,NX)) + ELSE + ZNHUI(L,NY,NX)=0.0 + ENDIF +C +C UREA CONCENTRATION AND HYDROLYSIS IN NON-BAND +C + 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) + 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) + 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 4,RNHUI(IUTYP(NY,NX)) +8888 FORMAT(A8,4I4,40E12.4) +C ENDIF +C +C NH4, NH3, UREA, NO3 DISSOLUTION IN BAND AND NON-BAND +C SOIL ZONES FROM FIRST-ORDER FUNCTIONS OF REMAINING +C FERTILIZER (NOTE: SUPERPHOSPHATE AND ROCK PHOSPHATE +C ARE REPRESENTED AS MONOCALCIUM PHOSPHATE AND HYDROXYAPATITE +C MODELLED IN PHOSPHORUS REACTIONS BELOW) +C + RSN4AA=SPNH4*ZNH4FA(L,NY,NX)*VLNH4(L,NY,NX) + 2*THETW(L,NY,NX) + RSN3AA=SPNH3*ZNH3FA(L,NY,NX)*VLNH4(L,NY,NX) + RSNUAA=RSNUA*VLNH4(L,NY,NX)*THETW(L,NY,NX) + RSNOAA=SPNO3*ZNO3FA(L,NY,NX)*VLNO3(L,NY,NX) + 2*THETW(L,NY,NX) + RSN4BA=SPNH4*ZNH4FA(L,NY,NX)*VLNHB(L,NY,NX) + 2*THETW(L,NY,NX) + RSN3BA=SPNH3*ZNH3FA(L,NY,NX)*VLNHB(L,NY,NX) + RSNUBA=RSNUA*VLNHB(L,NY,NX)*THETW(L,NY,NX) + RSNOBA=SPNO3*ZNO3FA(L,NY,NX)*VLNOB(L,NY,NX) + 2*THETW(L,NY,NX) + RSN4BB=SPNH4*ZNH4FB(L,NY,NX)*THETW(L,NY,NX) + RSN3BB=SPNH3*ZNH3FB(L,NY,NX) + RSNUBB=RSNUB*VLNHB(L,NY,NX)*THETW(L,NY,NX) + RSNOBB=SPNO3*ZNO3FB(L,NY,NX)*THETW(L,NY,NX) +C +C SOLUBLE AND EXCHANGEABLE NH4 CONCENTRATIONS +C IN NON-BAND AND BAND SOIL ZONES +C + IF(VOLWNH.GT.ZEROS(NY,NX))THEN + VOLWNX=14.0*VOLWNH + RN4X=(-TUPNH4(L,NY,NX)+XNH4S(L,NY,NX)+14.0*RSN4AA)/VOLWNX + RN3X=(-TUPN3S(L,NY,NX)+14.0*RSNUAA)/VOLWNX + CN41=AMAX1(0.0,ZNH4S(L,NY,NX)/VOLWNX+RN4X) + CN31=AMAX1(0.0,ZNH3S(L,NY,NX)/VOLWNX+RN3X) + XN41=AMAX1(0.0,XN4(L,NY,NX)/VOLWNH) + ELSE + RN4X=0.0 + RN3X=0.0 + CN41=0.0 + CN31=0.0 + XN41=0.0 + ENDIF + IF(VOLWNB.GT.ZEROS(NY,NX))THEN + VOLWNX=14.0*VOLWNB + RNBX=(-TUPNHB(L,NY,NX)+XNH4B(L,NY,NX)+14.0*(RSN4BA+RSN4BB)) + 2/VOLWNX + R3BX=(-TUPN3B(L,NY,NX)+14.0*(RSNUBA+RSNUBB)) + 2/VOLWNX + CN4B=AMAX1(0.0,ZNH4B(L,NY,NX)/VOLWNX+RNBX) + CN3B=AMAX1(0.0,ZNH3B(L,NY,NX)/VOLWNX+R3BX) + XN4B=AMAX1(0.0,XNB(L,NY,NX)/VOLWNB) + ELSE + RNBX=0.0 + R3BX=0.0 + CN4B=0.0 + CN3B=0.0 + XN4B=0.0 + ENDIF +C WRITE(*,4141)'RN4X',I,J,NX,NY,L,RN4X,RN3X,RNBX,R3BX +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 +4141 FORMAT(A8,5I4,30E12.4) +C +C SOLUBLE, EXCHANGEABLE AND PRECIPITATED PO4 CONCENTRATIONS IN +C NON-BAND AND BAND SOIL ZONES +C + IF(VOLWPO.GT.ZEROS(NY,NX))THEN + VOLWPX=31.0*VOLWPO + RH2PX=(XH2PS(L,NY,NX)-TUPH2P(L,NY,NX))/VOLWPX + CH2P1=AMAX1(0.0,H2PO4(L,NY,NX)/VOLWPX+RH2PX) + XOH01=AMAX1(0.0,XOH0(L,NY,NX))/VOLWPO + XOH11=AMAX1(0.0,XOH1(L,NY,NX))/VOLWPO + XOH21=AMAX1(0.0,XOH2(L,NY,NX))/VOLWPO + XH1P1=AMAX1(0.0,XH1P(L,NY,NX))/VOLWPO + XH2P1=AMAX1(0.0,XH2P(L,NY,NX))/VOLWPO + PCAPM1=AMAX1(0.0,PCAPM(L,NY,NX))/VOLWPO + PCAPD1=AMAX1(0.0,PCAPD(L,NY,NX))/VOLWPO + PCAPH1=AMAX1(0.0,PCAPH(L,NY,NX))/VOLWPO + PALPO1=AMAX1(0.0,PALPO(L,NY,NX))/VOLWPO + PFEPO1=AMAX1(0.0,PFEPO(L,NY,NX))/VOLWPO +C WRITE(*,8642)'CH2P1',I,J,L,CH2P1,H2PO4(L,NY,NX) +C 2,VOLWPX,RH2PX,XH2PS(L,NY,NX),TUPH2P(L,NY,NX) +8642 FORMAT(A8,3I4,20E12.4) + ELSE + RH2PX=0.0 + CH2P1=0.0 + XOH01=0.0 + XOH11=0.0 + XOH21=0.0 + XH1P1=0.0 + XH2P1=0.0 + PALPO1=0.0 + PFEPO1=0.0 + PCAPM1=0.0 + PCAPD1=0.0 + PCAPH1=0.0 + ENDIF + IF(VOLWPB.GT.ZEROS(NY,NX))THEN + VOLWPX=31.0*VOLWPB + RH2BX=(XH2BS(L,NY,NX)-TUPH2B(L,NY,NX))/VOLWPX + CH2B1=AMAX1(0.0,H2POB(L,NY,NX)/VOLWPX+RH2BX) + XH01B=AMAX1(0.0,XOH0B(L,NY,NX))/VOLWPB + XH11B=AMAX1(0.0,XOH1B(L,NY,NX))/VOLWPB + XH21B=AMAX1(0.0,XOH2B(L,NY,NX))/VOLWPB + X1P1B=AMAX1(0.0,XH1PB(L,NY,NX))/VOLWPB + X2P1B=AMAX1(0.0,XH2PB(L,NY,NX))/VOLWPB + PALPOB=AMAX1(0.0,PALPB(L,NY,NX))/VOLWPB + PFEPOB=AMAX1(0.0,PFEPB(L,NY,NX))/VOLWPB + PCAPMB=AMAX1(0.0,PCPMB(L,NY,NX))/VOLWPB + PCAPDB=AMAX1(0.0,PCPDB(L,NY,NX))/VOLWPB + PCAPHB=AMAX1(0.0,PCPHB(L,NY,NX))/VOLWPB + ELSE + RH2BX=0.0 + CH2B1=0.0 + XH01B=0.0 + XH11B=0.0 + XH21B=0.0 + X1P1B=0.0 + X2P1B=0.0 + PALPOB=0.0 + PFEPOB=0.0 + PCAPMB=0.0 + PCAPDB=0.0 + PCAPHB=0.0 + ENDIF +C +C IF SALT OPTION SELECTED IN SITE FILE +C THEN SOLVE FULL SET OF EQUILIBRIA REACTIONS +C + IF(ISALT(NY,NX).NE.0)THEN +C +C SOLUBLE NO3 CONCENTRATIONS +C IN NON-BAND AND BAND SOIL ZONES +C + IF(VOLWNO.GT.ZEROS(NY,NX))THEN + CNO1=AMAX1(0.0,ZNO3S(L,NY,NX)/(14.0*VOLWNO)) + ELSE + CNO1=0.0 + ENDIF + IF(VOLWNZ.GT.ZEROS(NY,NX))THEN + CNOB=AMAX1(0.0,ZNO3B(L,NY,NX)/(14.0*VOLWNZ)) + ELSE + CNOB=0.0 + ENDIF + RHY1=XZHYS(L,NY,NX)/VOLWM(NPH,L,NY,NX) + CHY1=AMAX1(0.0,ZHY(L,NY,NX))/VOLWM(NPH,L,NY,NX)+RHY1 +C +C SOLUTE ION AND ION PAIR CONCENTRATIONS +C + CCEC=AMAX1(ZERO,XCEC(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + COH1=AMAX1(0.0,ZOH(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CAL1=AMAX1(0.0,ZAL(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CFE1=AMAX1(0.0,ZFE(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CCA1=AMAX1(0.0,ZCA(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CMG1=AMAX1(0.0,ZMG(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CNA1=AMAX1(0.0,ZNA(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CKA1=AMAX1(0.0,ZKA(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CSO41=AMAX1(0.0,ZSO4(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CCL1=AMAX1(0.0,ZCL(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CCO31=AMAX1(0.0,ZCO3(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CHCO31=AMAX1(0.0,ZHCO3(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CCO21=AMAX1(0.0,CO2S(L,NY,NX)/(12.0*VOLWM(NPH,L,NY,NX))) + CALO1=AMAX1(0.0,ZALOH1(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CALO2=AMAX1(0.0,ZALOH2(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CALO3=AMAX1(0.0,ZALOH3(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CALO4=AMAX1(0.0,ZALOH4(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CALS1=AMAX1(0.0,ZALS(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CFEO1=AMAX1(0.0,ZFEOH1(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CFEO2=AMAX1(0.0,ZFEOH2(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CFEO3=AMAX1(0.0,ZFEOH3(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CFEO4=AMAX1(0.0,ZFEOH4(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CFES1=AMAX1(0.0,ZFES(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CCAO1=AMAX1(0.0,ZCAO(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CCAC1=AMAX1(0.0,ZCAC(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CCAH1=AMAX1(0.0,ZCAH(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CCAS1=AMAX1(0.0,ZCAS(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CMGO1=AMAX1(0.0,ZMGO(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CMGC1=AMAX1(0.0,ZMGC(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CMGH1=AMAX1(0.0,ZMGH(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CMGS1=AMAX1(0.0,ZMGS(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CNAC1=AMAX1(0.0,ZNAC(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CNAS1=AMAX1(0.0,ZNAS(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CKAS1=AMAX1(0.0,ZKAS(L,NY,NX)/VOLWM(NPH,L,NY,NX)) +C +C PO4 CONCENTRATIONS IN NON-BAND AND BAND SOIL ZONES +C + IF(VOLWPO.GT.ZEROS(NY,NX))THEN + CH0P1=AMAX1(0.0,H0PO4(L,NY,NX)/VOLWPO) + CH1P1=AMAX1(0.0,H1PO4(L,NY,NX)/VOLWPO) + CH3P1=AMAX1(0.0,H3PO4(L,NY,NX)/VOLWPO) + CF1P1=AMAX1(0.0,ZFE1P(L,NY,NX)/VOLWPO) + CF2P1=AMAX1(0.0,ZFE2P(L,NY,NX)/VOLWPO) + CC0P1=AMAX1(0.0,ZCA0P(L,NY,NX)/VOLWPO) + CC1P1=AMAX1(0.0,ZCA1P(L,NY,NX)/VOLWPO) + CC2P1=AMAX1(0.0,ZCA2P(L,NY,NX)/VOLWPO) + CM1P1=AMAX1(0.0,ZMG1P(L,NY,NX)/VOLWPO) + ELSE + CH0P1=0.0 + CH1P1=0.0 + CH3P1=0.0 + CF1P1=0.0 + CF2P1=0.0 + CC0P1=0.0 + CC1P1=0.0 + CC2P1=0.0 + CM1P1=0.0 + ENDIF + IF(VOLWPB.GT.ZEROS(NY,NX))THEN + CH0PB=AMAX1(0.0,H0POB(L,NY,NX)/VOLWPB) + CH1PB=AMAX1(0.0,H1POB(L,NY,NX)/VOLWPB) + CH3PB=AMAX1(0.0,H3POB(L,NY,NX)/VOLWPB) + CF1PB=AMAX1(0.0,ZFE1PB(L,NY,NX)/VOLWPB) + CF2PB=AMAX1(0.0,ZFE2PB(L,NY,NX)/VOLWPB) + CC0PB=AMAX1(0.0,ZCA0PB(L,NY,NX)/VOLWPB) + CC1PB=AMAX1(0.0,ZCA1PB(L,NY,NX)/VOLWPB) + CC2PB=AMAX1(0.0,ZCA2PB(L,NY,NX)/VOLWPB) + CM1PB=AMAX1(0.0,ZMG1PB(L,NY,NX)/VOLWPB) + ELSE + CH0PB=0.0 + CH1PB=0.0 + CH3PB=0.0 + CF1PB=0.0 + CF2PB=0.0 + CC0PB=0.0 + CC1PB=0.0 + CC2PB=0.0 + CM1PB=0.0 + ENDIF +C +C EXCHANGEABLE ION CONCENTRATIONS +C + XHY1=AMAX1(0.0,XHY(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + XAL1=AMAX1(0.0,XAL(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + XCA1=AMAX1(0.0,XCA(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + XMG1=AMAX1(0.0,XMG(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + XNA1=AMAX1(0.0,XNA(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + XKA1=AMAX1(0.0,XKA(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + XHC1=AMAX1(0.0,XHC(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + XALO21=AMAX1(0.0,XALO2(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + XCOOH=AMAX1(0.0,COOH*ORGC(L,NY,NX)/VOLWM(NPH,L,NY,NX)) +C +C PRECIPITATE CONCENTRATIONS +C + PALOH1=AMAX1(0.0,PALOH(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + PFEOH1=AMAX1(0.0,PFEOH(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + PCACO1=AMAX1(0.0,PCACO(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + PCASO1=AMAX1(0.0,PCASO(L,NY,NX)/VOLWM(NPH,L,NY,NX)) +C +C CONVERGENCE TOWARDS SOLUTE EQILIBRIA +C + DO 1000 M=1,MRXN + CN41=AMAX1(ZERO,CN41) + CN4B=AMAX1(ZERO,CN4B) + CN31=AMAX1(ZERO,CN31) + CN3B=AMAX1(ZERO,CN3B) + CAL1=AMAX1(ZERO,CAL1) + CFE1=AMAX1(ZERO,CFE1) + CHY1=AMAX1(ZERO,CHY1) + CCA1=AMAX1(ZERO,AMIN1(CCAMX,CCA1)) + CMG1=AMAX1(ZERO,CMG1) + CNA1=AMAX1(ZERO,CNA1) + CKA1=AMAX1(ZERO,CKA1) + COH1=AMAX1(ZERO,COH1) + CSO41=AMAX1(ZERO,CSO41) + CCO31=AMAX1(ZERO,CCO31) + CHCO31=AMAX1(ZERO,CHCO31) + CCO21=AMAX1(ZERO,CCO21) + CALO1=AMAX1(ZERO,CALO1) + CALO2=AMAX1(ZERO,CALO2) + CALO3=AMAX1(ZERO,CALO3) + CALO4=AMAX1(ZERO,CALO4) + CALS1=AMAX1(ZERO,CALS1) + CFEO1=AMAX1(ZERO,CFEO1) + CFEO2=AMAX1(ZERO,CFEO2) + CFEO3=AMAX1(ZERO,CFEO3) + CFEO4=AMAX1(ZERO,CFEO4) + CFES1=AMAX1(ZERO,CFES1) + CCAO1=AMAX1(ZERO,CCAO1) + CCAC1=AMAX1(ZERO,CCAC1) + CCAH1=AMAX1(ZERO,CCAH1) + CCAS1=AMAX1(ZERO,CCAS1) + CMGO1=AMAX1(ZERO,CMGO1) + CMGC1=AMAX1(ZERO,CMGC1) + CMGH1=AMAX1(ZERO,CMGH1) + CMGS1=AMAX1(ZERO,CMGS1) + CNAC1=AMAX1(ZERO,CNAC1) + CNAS1=AMAX1(ZERO,CNAS1) + CKAS1=AMAX1(ZERO,CKAS1) + CH0P1=AMAX1(ZERO,CH0P1) + CH1P1=AMAX1(ZERO,CH1P1) + CH2P1=AMAX1(ZERO,CH2P1) + CH3P1=AMAX1(ZERO,CH3P1) + CF1P1=AMAX1(ZERO,CF1P1) + CF2P1=AMAX1(ZERO,CF2P1) + CC0P1=AMAX1(ZERO,CC0P1) + CC1P1=AMAX1(ZERO,CC1P1) + CC2P1=AMAX1(ZERO,CC2P1) + CM1P1=AMAX1(ZERO,CM1P1) + CH0PB=AMAX1(ZERO,CH0PB) + CH1PB=AMAX1(ZERO,CH1PB) + CH2B1=AMAX1(ZERO,CH2B1) + CH3PB=AMAX1(ZERO,CH3PB) + CF1PB=AMAX1(ZERO,CF1PB) + CF2PB=AMAX1(ZERO,CF2PB) + CC0PB=AMAX1(ZERO,CC0PB) + CC1PB=AMAX1(ZERO,CC1PB) + CC2PB=AMAX1(ZERO,CC2PB) + CM1PB=AMAX1(ZERO,CM1PB) + XCOO=AMAX1(0.0,XCOOH-XHC1-XALO21) +C +C IONIC STRENGTH FROM SUMS OF ION CONCENTRATIONS +C + CC3=CAL1+CFE1 + CA3=CH0P1*VLPO4(L,NY,NX)+CH0PB*VLPOB(L,NY,NX) + CC2=CCA1+CMG1+CALO1+CFEO1+CF2P1*VLPO4(L,NY,NX) + 2+CF2PB*VLPOB(L,NY,NX) + CA2=CSO41+CCO31+CH1P1*VLPO4(L,NY,NX)+CH1PB*VLPOB(L,NY,NX) + CC1=CN41*VLNH4(L,NY,NX)+CN4B*VLNHB(L,NY,NX)+CHY1+CNA1+CKA1 + 2+CALO2+CFEO2+CALS1+CFES1+CCAO1+CCAH1+CMGO1+CMGH1 + 3+(CF1P1+CC2P1)*VLPO4(L,NY,NX)+(CF1PB+CC2PB)*VLPOB(L,NY,NX) + CA1=CNO1*VLNO3(L,NY,NX)+CNOB*VLNOB(L,NY,NX)+COH1+CHCO31+CCL1 + 2+CALO4+CFEO4+CNAC1+CNAS1+CKAS1+(CH2P1+CC0P1)*VLPO4(L,NY,NX) + 3+(CH2B1+CC0PB)*VLPOB(L,NY,NX) + CION1=ABS(3.0*(CC3-CA3)+2.0*(CC2-CA2)+CC1-CA1) + CSTR1=AMAX1(0.0,0.5E-03*(9.0*(CC3+CA3)+4.0*(CC2+CA2) + 2+CC1+CA1+CION1)) + CSTR2=SQRT(CSTR1) + FSTR2=CSTR2/(1.0+CSTR2) +C +C ACTIVITY COEFFICIENTS CALCULATED FROM ION STRENGTH +C + A1=AMIN1(1.0,10.0**(-0.509*1.0*FSTR2+0.20*CSTR2)) + A2=AMIN1(1.0,10.0**(-0.509*4.0*FSTR2+0.20*CSTR2)) + A3=AMIN1(1.0,10.0**(-0.509*9.0*FSTR2+0.20*CSTR2)) + A12=A1**2 + A13=A1**3 + A14=A1**4 + A22=A2**2 + A25=A2**5 + A28=A2**8 + A2Q=A2**0.500 + A3C=A3**0.333 + A0A2=A0*A2 + A0A12=A0/A12 + A0A22=A0/A22 + A0A1A2=A0*A12*A2 + A1A2=A1*A2 + A1A2D=A1/A2 + A1A2QD=A1/A2Q + A1A3=A1*A3 + A1A3D=A1/A3 + A12A2=A12*A2 + A12A2D=A12/A2 + A12A22=A12/A22 + A12A25=A12/A25 + A12A28=A12/A28 + A1202D=A12/A0A2 + A13A2=A13*A2 + A13A3=A13*A3 + A13A3D=A13/A3 + A14A0=A14/A0 + A14A2=A14*A2 + A14A2D=A14/A2 + A14A0A=A14/A0A2 + A14A5D=A14/A25 + A14A28=A14*A28 + A14A8D=A14/A28 + A1TA25=A1**10*A25 + A2A3=A2*A3 + A2A13D=A2/A1A3 + A1A2A3=A1*A2A3 + A1A23D=A1/A2A3 +C +C PRECIPITATION-DISSOLUTION CALCULATED FROM ACTIVITIES +C OF REACTANTS AND PRODUCTS THROUGH CONVERGENCE SOLUTIONS +C FOR THEIR EQUILIBRIUM CONSTANTS USING SOLUTE FORMS +C CURRENTLY AT HIGHEST CONCENTRATIONS +C + AHY1=CHY1*A1 + AOH1=COH1*A1 + AAL1=CAL1*A3 + AALO1=CALO1*A2 + AALO2=CALO2*A1 + AALO3=CALO3 + AALO4=CALO4*A1 + AFE1=CFE1*A3 + AFEO1=CFEO1*A2 + AFEO2=CFEO2*A1 + AFEO3=CFEO3 + AFEO4=CFEO4*A1 + ACO31=CCO31*A2 + AHCO31=CHCO31*A1 + ACO21=CCO21*A0 +C +C ALUMINUM HYDROXIDE (GIBBSITE) +C + PX=AMAX1(AAL1,AALO1,AALO2,AALO3,AALO4) + IF(PX.EQ.AAL1)THEN + R2=CHY1 + P2=COH1 + P1=CAL1 + IF(AOH1.GT.AHY1)THEN + NR2=0 + NP2=3 + SP=SYALO/A13A3 + ELSE + NR2=3 + NP2=0 + SP=SHALO*A13A3D + ENDIF + ELSEIF(PX.EQ.AALO1)THEN + R2=CHY1 + P2=COH1 + P1=CALO1 + IF(AOH1.GT.AHY1)THEN + NR2=0 + NP2=2 + SP=SYAL1/A12A2 + ELSE + NR2=2 + NP2=0 + SP=SHAL1*A12A2D + ENDIF + ELSEIF(PX.EQ.AALO2)THEN + R2=CHY1 + P2=COH1 + P1=CALO2 + IF(AOH1.GT.AHY1)THEN + NR2=0 + NP2=1 + SP=SYAL2/A12 + ELSE + NR2=1 + NP2=0 + SP=SHAL2 + ENDIF + ELSEIF(PX.EQ.AALO3)THEN + R2=CHY1 + P2=COH1 + P1=CALO3 + NR2=0 + NP2=0 + SP=SPAL3 + ELSEIF(PX.EQ.AALO4)THEN + R2=COH1 + P2=CHY1 + P1=CALO4 + IF(AOH1.GT.AHY1)THEN + NR2=1 + NP2=0 + SP=SYAL4 + ELSE + NR2=0 + NP2=1 + SP=SHAL4/A12 + ENDIF + ENDIF + RYAL1=0.0 + RYALO1=0.0 + RYALO2=0.0 + RYALO3=0.0 + RYALO4=0.0 + RHAL1=0.0 + RHALO1=0.0 + RHALO2=0.0 + RHALO3=0.0 + RHALO4=0.0 + X=0.0 + TX=0.0 + FX=1.0/(1+NR2+NP2) + DO 1010 MM=1,100 + R2=AMAX1(ZERO,R2+NR2*X) + P1=AMAX1(ZERO,P1-X) + P2=AMAX1(ZERO,P2-NP2*X) + Z=(P1*P2**NP2/R2**NR2)/SP + IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 1110 + IF(Z.LE.0.95.AND.PALOH1.LE.0.0)GO TO 1110 + IF(NR2.NE.0)THEN + Y=AMIN1(P1,R2/NR2) + ELSEIF(NP2.NE.0)THEN + Y=AMIN1(P1,P2/NP2) + ELSE + Y=P1 + ENDIF + IF(Z.GT.1.0)THEN + X=Y-Y/Z**FX + ELSE + X=Y*Z**FX-Y + ENDIF + TX=TX+X +1010 CONTINUE +1110 CONTINUE + RPALOX=AMAX1(-PALOH1,TPD*TX) + IF(PX.EQ.AAL1)THEN + IF(AOH1.GT.AHY1)THEN + RYAL1=RPALOX + ELSE + RHAL1=RPALOX + ENDIF + ELSEIF(PX.EQ.AALO1)THEN + IF(AOH1.GT.AHY1)THEN + RYALO1=RPALOX + ELSE + RHALO1=RPALOX + ENDIF + ELSEIF(PX.EQ.AALO2)THEN + IF(AOH1.GT.AHY1)THEN + RYALO2=RPALOX + ELSE + RHALO2=RPALOX + ENDIF + ELSEIF(PX.EQ.AALO3)THEN + IF(AOH1.GT.AHY1)THEN + RYALO3=RPALOX + ELSE + RHALO3=RPALOX + ENDIF + ELSEIF(PX.EQ.AALO4)THEN + IF(AOH1.GT.AHY1)THEN + RYALO4=RPALOX + ELSE + RHALO4=RPALOX + ENDIF + ENDIF +C IF((M/10)*10.EQ.M)THEN +C WRITE(*,1112)'GIBB',I,J,M,MM,PALOH1,CAL1,CALO1,CALO2,CALO3,CALO4 +C 2,COH1,R2,P1,P2,SP,Z,TX,RPALOX,RHAL1,RHALO1,RHALO2,RHALO3,RHALO4 +C 3,CAL1*A3*(COH1*A1)**3,SYALO +C ENDIF +C +C IRON HYDROXIDE +C + PX=AMAX1(AFE1,AFEO1,AFEO2,AFEO3,AFEO4) + IF(PX.EQ.AFE1)THEN + R2=CHY1 + P2=COH1 + P1=CFE1 + IF(AOH1.GT.AHY1)THEN + NR2=0 + NP2=3 + SP=SYFEO/A13A3 + ELSE + NR2=3 + NP2=0 + SP=SHFEO*A13A3D + ENDIF + ELSEIF(PX.EQ.AFEO1)THEN + R2=CHY1 + P2=COH1 + P1=CFEO1 + IF(AOH1.GT.AHY1)THEN + NR2=0 + NP2=2 + SP=SYFE1/A12A2 + ELSE + NR2=2 + NP2=0 + SP=SHFE1*A12A2D + ENDIF + ELSEIF(PX.EQ.AFEO2)THEN + R2=CHY1 + P2=COH1 + P1=CFEO2 + IF(AOH1.GT.AHY1)THEN + NR2=0 + NP2=1 + SP=SYFE2/A12 + ELSE + NR2=1 + NP2=0 + SP=SHFE2 + ENDIF + ELSEIF(PX.EQ.AFEO3)THEN + R2=CHY1 + P2=COH1 + P1=CFEO3 + NR2=0 + NP2=0 + SP=SPFE3 + ELSEIF(PX.EQ.AFEO4)THEN + R2=COH1 + P2=CHY1 + P1=CFEO4 + IF(AOH1.GT.AHY1)THEN + NR2=1 + NP2=0 + SP=SYFE4 + ELSE + NR2=0 + NP2=1 + SP=SHFE4/A12 + ENDIF + ENDIF + RYFE1=0.0 + RYFEO1=0.0 + RYFEO2=0.0 + RYFEO3=0.0 + RYFEO4=0.0 + RHFE1=0.0 + RHFEO1=0.0 + RHFEO2=0.0 + RHFEO3=0.0 + RHFEO4=0.0 + X=0.0 + TX=0.0 + FX=1.0/(1+NR2+NP2) + DO 1020 MM=1,100 + R2=AMAX1(ZERO,R2+NR2*X) + P1=AMAX1(ZERO,P1-X) + P2=AMAX1(ZERO,P2-NP2*X) + Z=(P1*P2**NP2/R2**NR2)/SP + IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 1120 + IF(Z.LE.0.95.AND.PFEOH1.LE.0.0)GO TO 1120 + IF(NR2.NE.0)THEN + Y=AMIN1(P1,R2/NR2) + ELSEIF(NP2.NE.0)THEN + Y=AMIN1(P1,P2/NP2) + ELSE + Y=P1 + ENDIF + IF(Z.GT.1.0)THEN + X=Y-Y/Z**FX + ELSE + X=Y*Z**FX-Y + ENDIF + TX=TX+X +1020 CONTINUE +1120 CONTINUE + RPFEOX=AMAX1(-PFEOH1,TPD*TX) + IF(PX.EQ.AFE1)THEN + IF(AOH1.GT.AHY1)THEN + RYFE1=RPFEOX + ELSE + RHFE1=RPFEOX + ENDIF + ELSEIF(PX.EQ.AFEO1)THEN + IF(AOH1.GT.AHY1)THEN + RYFEO1=RPFEOX + ELSE + RHFEO1=RPFEOX + ENDIF + ELSEIF(PX.EQ.AFEO2)THEN + IF(AOH1.GT.AHY1)THEN + RYFEO2=RPFEOX + ELSE + RHFEO2=RPFEOX + ENDIF + ELSEIF(PX.EQ.AFEO3)THEN + IF(AOH1.GT.AHY1)THEN + RYFEO3=RPFEOX + ELSE + RHFEO3=RPFEOX + ENDIF + ELSEIF(PX.EQ.AFEO4)THEN + IF(AOH1.GT.AHY1)THEN + RYFEO4=RPFEOX + ELSE + RHFEO4=RPFEOX + ENDIF + ENDIF +C IF((M/10)*10.EQ.M)THEN +C WRITE(*,1112)'IRON',I,J,M,MM,PFEOH1,CFE1,CFEO1,CFEO2,CFEO3,CFEO4 +C 2,COH1,R2,P1,P2,SP,Z,TX,RPFEOX,RHFE1,RHFEO1,RHFEO2,RHFEO3,RHFEO4 +C 3,CFE1*A3*(COH1*A1)**3,SYFEO +C ENDIF +C +C CALCITE AND GYPSUM +C + PX=AMAX1(ACO31,AHCO31,ACO21) + R2=CHY1 + P3=COH1 + P1=CCA1 + IF(PX.EQ.ACO31)THEN + P2=CCO31 + NR2=0 + NP3=0 + SP=SPCAC/A22 + ELSEIF(PX.EQ.AHCO31)THEN + P2=CHCO31 + IF(AOH1.GT.AHY1)THEN + NR2=0 + NP3=1 + SP=SYCAC1/A12A2 + ELSE + NR2=1 + NP3=0 + SP=SHCAC1/A2 + ENDIF + ELSEIF(PX.EQ.ACO21)THEN + P2=CCO21 + IF(AOH1.GT.AHY1)THEN + NR2=0 + NP3=2 + SP=SYCAC2/A0A1A2 + ELSE + NR2=2 + NP3=0 + SP=SHCAC2*A1202D + ENDIF + ENDIF + RYCAC3=0.0 + RYCACH=0.0 + RYCACO=0.0 + RHCAC3=0.0 + RHCACH=0.0 + RHCACO=0.0 + X=0.0 + TX=0.0 + FX=1.0/(2+NR2+NP3) + DO 1030 MM=1,100 + R2=AMAX1(ZERO,R2+NR2*X) + P1=AMAX1(ZERO,P1-X) + P2=AMAX1(ZERO,P2-X) + P3=AMAX1(ZERO,P3-NP3*X) + Z=(P1*P2*P3**NP3/R2**NR2)/SP + IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 1130 + IF(Z.LE.0.95.AND.PCACO1.LE.0.0)GO TO 1130 + IF(NR2.NE.0)THEN + Y=AMIN1(R2/NR2,P1,P2) + ELSEIF(NP3.NE.0)THEN + Y=AMIN1(P1,P2,P3/NP3) + ELSE + Y=AMIN1(P1,P2) + ENDIF + IF(Z.GT.1.0)THEN + X=Y-Y/Z**FX + ELSE + X=Y*Z**FX-Y + ENDIF + TX=TX+X +1030 CONTINUE +1130 CONTINUE + RPCACX=AMAX1(-PCACO1,TPD*TX) + IF(PX.EQ.ACO31)THEN + IF(AOH1.GT.AHY1)THEN + RYCAC3=RPCACX + ELSE + RHCAC3=RPCACX + ENDIF + ELSEIF(PX.EQ.AHCO31)THEN + IF(AOH1.GT.AHY1)THEN + RYCACH=RPCACX + ELSE + RHCACH=RPCACX + ENDIF + ELSEIF(PX.EQ.ACO21)THEN + IF(AOH1.GT.AHY1)THEN + RYCACO=RPCACX + ELSE + RHCACO=RPCACX + ENDIF + ENDIF + SP=SPCAS/A22 + S0=CCA1+CSO41 + S1=AMAX1(0.0,S0**2-4.0*(CCA1*CSO41-SP)) + RPCASO=AMAX1(-PCASO1,TPDX*(S0-SQRT(S1))) +C IF((M/10)*10.EQ.M)THEN +C WRITE(*,1112)'CALC',I,J,M,MM,PCASO1,ACO31,AHCO31,ACO21,CHY1 +C 2,COH1,R2,P1,P2,P3,SP,Z,TX,RPCACX,RHCAC3,RHCACH,RHCACO +C 3,CCA1*A2*CCO3*A2,SPCAC +C ENDIF +C +C PHOSPHORUS PRECIPITATION-DISSOLUTION IN NON-BAND SOIL ZONE +C + IF(VOLWPO.GT.ZEROS(NY,NX))THEN +C +C ALUMINUM PHOSPHATE (VARISCITE) +C + AH1P1=CH1P1*A2 + AH2P1=CH2P1*A1 + PX=AMAX1(AAL1,AALO1,AALO2,AALO3,AALO4) + PY=AMAX1(AH1P1,AH2P1) + R3=CHY1 + R4=COH1 + P3=CHY1 + P4=COH1 + IF(PY.EQ.AH1P1)THEN + P2=CH1P1 + IF(PX.EQ.AAL1)THEN + P1=CAL1 + IF(AOH1.GT.AHY1)THEN + NR3=0 + NR4=0 + NP3=0 + NP4=1 + SP=SYA0P1/A1A2A3 + ELSE + NR3=1 + NR4=0 + NP3=0 + NP4=0 + SP=SHA0P1*A1A23D + ENDIF + ELSEIF(PX.EQ.AALO1)THEN + P1=CALO1 + NR3=0 + NR4=0 + NP3=0 + NP4=0 + SP=SPA1P1/A22 + ELSEIF(PX.EQ.AALO2)THEN + P1=CALO2 + IF(AOH1.GT.AHY1)THEN + NR3=0 + NR4=1 + NP3=0 + NP4=0 + SP=SYA2P1/A2 + ELSE + NR3=0 + NR4=0 + NP3=1 + NP4=0 + SP=SHA2P1/A12A2 + ENDIF + ELSEIF(PX.EQ.AALO3)THEN + P1=CALO3 + IF(AOH1.GT.AHY1)THEN + NR3=0 + NR4=2 + NP3=0 + NP4=0 + SP=SYA3P1*A12A2D + ELSE + NR3=0 + NR4=0 + NP3=2 + NP4=0 + SP=SHA3P1/A13A2 + ENDIF + ELSEIF(PX.EQ.AALO4)THEN + P1=CALO4 + IF(AOH1.GT.AHY1)THEN + NR3=0 + NR4=3 + NP3=0 + NP4=0 + SP=SYA4P1*A12A2D + ELSE + NR3=0 + NR4=0 + NP3=3 + NP4=0 + SP=SHA4P1*A14A2 + ENDIF + ENDIF + ELSE + P2=CH2P1 + IF(PX.EQ.AAL1)THEN + P1=CAL1 + IF(AOH1.GT.AHY1)THEN + NR3=0 + NR4=0 + NP3=0 + NP4=2 + SP=SYA0P2/A13A3 + ELSE + NR3=2 + NR4=0 + NP3=0 + NP4=0 + SP=SHA0P2*A1A3D + ENDIF + ELSEIF(PX.EQ.AALO1)THEN + P1=CALO1 + IF(AOH1.GT.AHY1)THEN + NR3=0 + NR4=0 + NP3=0 + NP4=1 + SP=SYA1P2/A12A2 + ELSE + NR3=1 + NR4=0 + NP3=0 + NP4=0 + SP=SHA1P2/A2 + ENDIF + ELSEIF(PX.EQ.AALO2)THEN + P1=CALO2 + NR3=0 + NR4=0 + NP3=0 + NP4=0 + SP=SPA2P2/A12 + ELSEIF(PX.EQ.AALO3)THEN + P1=CALO3 + IF(AOH1.GT.AHY1)THEN + NR3=0 + NR4=1 + NP3=0 + NP4=0 + SP=SYA3P2 + ELSE + NR3=0 + NR4=0 + NP3=1 + NP4=0 + SP=SHA3P2/A22 + ENDIF + ELSEIF(PX.EQ.AALO4)THEN + P1=CALO4 + IF(AOH1.GT.AHY1)THEN + NR3=0 + NR4=2 + NP3=0 + NP4=0 + SP=SYA4P2 + ELSE + NR3=0 + NR4=0 + NP3=2 + NP4=0 + SP=SHA4P2/A14 + ENDIF + ENDIF + ENDIF + RYA0P1=0.0 + RYA1P1=0.0 + RYA2P1=0.0 + RYA3P1=0.0 + RYA4P1=0.0 + RYA0P2=0.0 + RYA1P2=0.0 + RYA2P2=0.0 + RYA3P2=0.0 + RYA4P2=0.0 + RHA0P1=0.0 + RHA1P1=0.0 + RHA2P1=0.0 + RHA3P1=0.0 + RHA4P1=0.0 + RHA0P2=0.0 + RHA1P2=0.0 + RHA2P2=0.0 + RHA3P2=0.0 + RHA4P2=0.0 + X=0.0 + TX=0.0 + FX=1.0/(2+NR3+NR4+NP3+NP4) + DO 1040 MM=1,100 + R3=AMAX1(ZERO,R3+NR3*X) + R4=AMAX1(ZERO,R4+NR4*X) + P1=AMAX1(ZERO,P1-X) + P2=AMAX1(ZERO,P2-X) + P3=AMAX1(ZERO,P3-NP3*X) + P4=AMAX1(ZERO,P4-NP4*X) + Z=(P1*P2*P3**NP3*P4**NP4/(R3**NR3*R4**NR4))/SP + IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 1140 + IF(Z.LE.0.95.AND.PALPO1.LE.0.0)GO TO 1140 + IF(NR3.NE.0)THEN + Y=AMIN1(R3/NR3,P1,P2) + ELSEIF(NR4.NE.0)THEN + Y=AMIN1(R4/NR4,P1,P2) + ELSEIF(NP3.NE.0)THEN + Y=AMIN1(P1,P2,P3/NP3) + ELSEIF(NP4.NE.0)THEN + Y=AMIN1(P1,P2,P4/NP4) + ELSE + Y=AMIN1(P1,P2) + ENDIF + IF(Z.GT.1.0)THEN + X=Y-Y/Z**FX + ELSE + X=Y*Z**FX-Y + ENDIF + TX=TX+X +1040 CONTINUE +1140 CONTINUE + RPALPX=AMAX1(-PALPO1,TPD*TX) + IF(PY.EQ.AH1P1)THEN + IF(PX.EQ.AAL1)THEN + IF(AOH1.GT.AHY1)THEN + RYA0P1=RPALPX + ELSE + RHA0P1=RPALPX + ENDIF + ELSEIF(PX.EQ.AALO1)THEN + IF(AOH1.GT.AHY1)THEN + RYA1P1=RPALPX + ELSE + RHA1P1=RPALPX + ENDIF + ELSEIF(PX.EQ.AALO2)THEN + IF(AOH1.GT.AHY1)THEN + RYA2P1=RPALPX + ELSE + RHA2P1=RPALPX + ENDIF + ELSEIF(PX.EQ.AALO3)THEN + IF(AOH1.GT.AHY1)THEN + RYA3P1=RPALPX + ELSE + RHA3P1=RPALPX + ENDIF + ELSEIF(PX.EQ.AALO4)THEN + IF(AOH1.GT.AHY1)THEN + RYA4P1=RPALPX + ELSE + RHA4P1=RPALPX + ENDIF + ENDIF + ELSE + IF(PX.EQ.AAL1)THEN + IF(AOH1.GT.AHY1)THEN + RYA0P2=RPALPX + ELSE + RHA0P2=RPALPX + ENDIF + ELSEIF(PX.EQ.AALO1)THEN + IF(AOH1.GT.AHY1)THEN + RYA1P2=RPALPX + ELSE + RHA1P2=RPALPX + ENDIF + ELSEIF(PX.EQ.AALO2)THEN + IF(AOH1.GT.AHY1)THEN + RYA2P2=RPALPX + ELSE + RHA2P2=RPALPX + ENDIF + ELSEIF(PX.EQ.AALO3)THEN + IF(AOH1.GT.AHY1)THEN + RYA3P2=RPALPX + ELSE + RHA3P2=RPALPX + ENDIF + ELSEIF(PX.EQ.AALO4)THEN + IF(AOH1.GT.AHY1)THEN + RYA4P2=RPALPX + ELSE + RHA4P2=RPALPX + ENDIF + ENDIF + ENDIF +C IF((M/10)*10.EQ.M)THEN +C WRITE(*,1112)'ALPO4',I,J,M,MM,PALPO1,CAL1,CALO1,CALO2,CALO3,CALO4 +C 2,CH1P1,CH2P1,CHY1,COH1,RPALPX,RHA0P1,RHA1P1,RHA2P1,RHA3P1,RHA4P1 +C 3,RHA0P2,RHA1P2,RHA2P2,RHA3P2,RHA4P2,R3,R4,P2,P3,P4,SP,Z,TX +1112 FORMAT(A8,4I4,80E12.4) +C ENDIF +C +C IRON PHOSPHATE (STRENGITE) +C + PX=AMAX1(AFE1,AFEO1,AFEO2,AFEO3,AFEO4) + PY=AMAX1(AH1P1,AH2P1) + R3=CHY1 + R4=COH1 + P3=CHY1 + P4=COH1 + IF(PY.EQ.AH1P1)THEN + P2=CH1P1 + IF(PX.EQ.AFE1)THEN + P1=CFE1 + IF(AOH1.GT.AHY1)THEN + NR3=0 + NR4=0 + NP3=0 + NP4=1 + SP=SYF0P1/A1A2A3 + ELSE + NR3=1 + NR4=0 + NP3=0 + NP4=0 + SP=SHF0P1*A1A23D + ENDIF + ELSEIF(PX.EQ.AFEO1)THEN + P1=CFEO1 + NR3=0 + NR4=0 + NP3=0 + NP4=0 + SP=SPF1P1/A22 + ELSEIF(PX.EQ.AFEO2)THEN + P1=CFEO2 + IF(AOH1.GT.AHY1)THEN + NR3=0 + NR4=1 + NP3=0 + NP4=0 + SP=SYF2P1/A2 + ELSE + NR3=0 + NR4=0 + NP3=1 + NP4=0 + SP=SHF2P1/A12A2 + ENDIF + ELSEIF(PX.EQ.AFEO3)THEN + P1=CFEO3 + IF(AOH1.GT.AHY1)THEN + NR3=0 + NR4=2 + NP3=0 + NP4=0 + SP=SYF3P1*A12A2D + ELSE + NR3=0 + NR4=0 + NP3=2 + NP4=0 + SP=SHF3P1/A13A2 + ENDIF + ELSEIF(PX.EQ.AFEO4)THEN + P1=CFEO4 + IF(AOH1.GT.AHY1)THEN + NR3=0 + NR4=3 + NP3=0 + NP4=0 + SP=SYF4P1*A12A2D + ELSE + NR3=0 + NR4=0 + NP3=3 + NP4=0 + SP=SHF4P1*A14A2 + ENDIF + ENDIF + ELSE + P2=CH2P1 + IF(PX.EQ.AFE1)THEN + P1=CFE1 + IF(AOH1.GT.AHY1)THEN + NR3=0 + NR4=0 + NP3=0 + NP4=2 + SP=SYF0P2/A13A3 + ELSE + NR3=2 + NR4=0 + NP3=0 + NP4=0 + SP=SHF0P2*A1A3D + ENDIF + ELSEIF(PX.EQ.AFEO1)THEN + P1=CFEO1 + IF(AOH1.GT.AHY1)THEN + NR3=0 + NR4=0 + NP3=0 + NP4=1 + SP=SYF1P2/A12A2 + ELSE + NR3=1 + NR4=0 + NP3=0 + NP4=0 + SP=SHF1P2/A2 + ENDIF + ELSEIF(PX.EQ.AFEO2)THEN + P1=CFEO2 + NR3=0 + NR4=0 + NP3=0 + NP4=0 + SP=SPF2P2/A12 + ELSEIF(PX.EQ.AFEO3)THEN + P1=CFEO3 + IF(AOH1.GT.AHY1)THEN + NR3=0 + NR4=1 + NP3=0 + NP4=0 + SP=SYF3P2 + ELSE + NR3=0 + NR4=0 + NP3=1 + NP4=0 + SP=SHF3P2/A22 + ENDIF + ELSEIF(PX.EQ.AFEO4)THEN + P1=CFEO4 + IF(AOH1.GT.AHY1)THEN + NR3=0 + NR4=2 + NP3=0 + NP4=0 + SP=SYF4P2 + ELSE + NR3=0 + NR4=0 + NP3=2 + NP4=0 + SP=SHF4P2/A14 + ENDIF + ENDIF + ENDIF + RYF0P1=0.0 + RYF1P1=0.0 + RYF2P1=0.0 + RYF3P1=0.0 + RYF4P1=0.0 + RYF0P2=0.0 + RYF1P2=0.0 + RYF2P2=0.0 + RYF3P2=0.0 + RYF4P2=0.0 + RHF0P1=0.0 + RHF1P1=0.0 + RHF2P1=0.0 + RHF3P1=0.0 + RHF4P1=0.0 + RHF0P2=0.0 + RHF1P2=0.0 + RHF2P2=0.0 + RHF3P2=0.0 + RHF4P2=0.0 + X=0.0 + TX=0.0 + FX=1.0/(2+NR3+NR4+NP3+NP4) + DO 1050 MM=1,100 + R3=AMAX1(ZERO,R3+NR3*X) + R4=AMAX1(ZERO,R4+NR4*X) + P1=AMAX1(ZERO,P1-X) + P2=AMAX1(ZERO,P2-X) + P3=AMAX1(ZERO,P3-NP3*X) + P4=AMAX1(ZERO,P4-NP4*X) + Z=(P1*P2*P3**NP3*P4**NP4/(R3**NR3*R4**NR4))/SP + IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 1150 + IF(Z.LE.0.95.AND.PFEPO1.LE.0.0)GO TO 1150 + IF(NR3.NE.0)THEN + Y=AMIN1(R3/NR3,P1,P2) + ELSEIF(NR4.NE.0)THEN + Y=AMIN1(R4/NR4,P1,P2) + ELSEIF(NP3.NE.0)THEN + Y=AMIN1(P1,P2,P3/NP3) + ELSEIF(NP4.NE.0)THEN + Y=AMIN1(P1,P2,P4/NP4) + ELSE + Y=AMIN1(P1,P2) + ENDIF + IF(Z.GT.1.0)THEN + X=Y-Y/Z**FX + ELSE + X=Y*Z**FX-Y + ENDIF + TX=TX+X +1050 CONTINUE +1150 CONTINUE + RPFEPX=AMAX1(-PFEPO1,TPD*TX) + IF(PY.EQ.AH1P1)THEN + IF(PX.EQ.AFE1)THEN + IF(AOH1.GT.AHY1)THEN + RYF0P1=RPFEPX + ELSE + RHF0P1=RPFEPX + ENDIF + ELSEIF(PX.EQ.AFEO1)THEN + IF(AOH1.GT.AHY1)THEN + RYF1P1=RPFEPX + ELSE + RHF1P1=RPFEPX + ENDIF + ELSEIF(PX.EQ.AFEO2)THEN + IF(AOH1.GT.AHY1)THEN + RYF2P1=RPFEPX + ELSE + RHF2P1=RPFEPX + ENDIF + ELSEIF(PX.EQ.AFEO3)THEN + IF(AOH1.GT.AHY1)THEN + RYF3P1=RPFEPX + ELSE + RHF3P1=RPFEPX + ENDIF + ELSEIF(PX.EQ.AFEO4)THEN + IF(AOH1.GT.AHY1)THEN + RYF4P1=RPFEPX + ELSE + RHF4P1=RPFEPX + ENDIF + ENDIF + ELSE + IF(PX.EQ.AFE1)THEN + IF(AOH1.GT.AHY1)THEN + RYF0P2=RPFEPX + ELSE + RHF0P2=RPFEPX + ENDIF + ELSEIF(PX.EQ.AFEO1)THEN + IF(AOH1.GT.AHY1)THEN + RYF1P2=RPFEPX + ELSE + RHF1P2=RPFEPX + ENDIF + ELSEIF(PX.EQ.AFEO2)THEN + IF(AOH1.GT.AHY1)THEN + RYF2P2=RPFEPX + ELSE + RHF2P2=RPFEPX + ENDIF + ELSEIF(PX.EQ.AFEO3)THEN + IF(AOH1.GT.AHY1)THEN + RYF3P2=RPFEPX + ELSE + RHF3P2=RPFEPX + ENDIF + ELSEIF(PX.EQ.AFEO4)THEN + IF(AOH1.GT.AHY1)THEN + RYF4P2=RPFEPX + ELSE + RHF4P2=RPFEPX + ENDIF + ENDIF + ENDIF +C IF((M/10)*10.EQ.M)THEN +C WRITE(*,1112)'FEPO4',I,J,M,MM,PFEPO1,CFE1,CFEO1,CFEO2,CFEO3,CFEO4 +C 2,CH1P1,CH2P1,CHY1,COH1,RPFEPX,RHF0P1,RHF1P1,RHF2P1,RHF3P1,RHF4P1 +C 3,RHF0P2,RHF1P2,RHF2P2,RHF3P2,RHF4P2,R3,R4,P2,P3,P4,SP,Z,TX +C ENDIF +C +C DICALCIUM PHOSPHATE +C + PX=AMAX1(AH1P1,AH2P1) + R2=CHY1 + P3=COH1 + P1=CCA1 + IF(PX.EQ.AH1P1)THEN + P2=CH1P1 + NR2=0 + NP3=0 + SP=SPCAD/A22 + ELSEIF(PX.EQ.AH2P1)THEN + P2=CH2P1 + IF(AOH1.GT.AHY1)THEN + NR2=0 + NP3=1 + SP=SYCAD2/A12A2 + ELSE + NR2=1 + NP3=0 + SP=SHCAD2/A2 + ENDIF + ENDIF + RPCAD1=0.0 + RYCAD2=0.0 + RHCAD2=0.0 + X=0.0 + TX=0.0 + FX=1.0/(2+NR2+NP3) + DO 1060 MM=1,100 + R2=AMAX1(ZERO,R2+NR2*X) + P1=AMAX1(ZERO,P1-X) + P2=AMAX1(ZERO,P2-X) + P3=AMAX1(ZERO,P3-NP3*X) + Z=(P1*P2*P3**NP3/R2**NR2)/SP + IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 1160 + IF(Z.LE.0.95.AND.PCAPD1.LE.0.0)GO TO 1160 + IF(NR2.NE.0)THEN + Y=AMIN1(R2/NR2,P1,P2) + ELSEIF(NP3.NE.0)THEN + Y=AMIN1(P1,P2,P3/NP3) + ELSE + Y=AMIN1(P1,P2) + ENDIF + IF(Z.GT.1.0)THEN + X=Y-Y/Z**FX + ELSE + X=Y*Z**FX-Y + ENDIF + TX=TX+X +1060 CONTINUE +1160 CONTINUE + RPCADX=AMAX1(-PCAPD1,TPD*TX) + IF(PX.EQ.AH1P1)THEN + RPCAD1=RPCADX + ELSEIF(PX.EQ.AH2P1)THEN + IF(AOH1.GT.AHY1)THEN + RYCAD2=RPCADX + ELSE + RHCAD2=RPCADX + ENDIF + ENDIF +C IF((M/10)*10.EQ.M)THEN +C WRITE(*,1112)'CAPO4',I,J,M,MM,PCAPM1,PCAPD1,CCA1 +C 2,CH1P1,CH2P1,CHY1,COH1,RPCADX,RPCAD1,RYCAD2,RHCAD2,R2,P1,P2,P3 +C 3,SP,Z,FX,Y,X,TX,A2,CCA1*A2*CH1P1*A2,SPCAD +C ENDIF +C +C HYDROXYAPATITE +C + PX=AMAX1(AH1P1,AH2P1) + R2=CHY1 + P3=COH1 + P1=CCA1 + IF(PX.EQ.AH1P1)THEN + P2=CH1P1 + IF(AOH1.GT.AHY1)THEN + NR2=0 + NP3=4 + SP=SYCAH1/A14A28 + ELSE + NR2=4 + NP3=0 + SP=SHCAH1*A14A8D + ENDIF + ELSEIF(PX.EQ.AH2P1)THEN + P2=CH2P1 + IF(AOH1.GT.AHY1)THEN + NR2=0 + NP3=7 + SP=SYCAH2/A1TA25 + ELSE + NR2=7 + NP3=0 + SP=SHCAH2*A14A5D + ENDIF + ENDIF + RYCAH1=0.0 + RYCAH2=0.0 + RHCAH1=0.0 + RHCAH2=0.0 + X=0.0 + TX=0.0 + FX=1.0/(6+NR2+NR3) + DO 1070 MM=1,100 + R2=AMAX1(ZERO,R2+NR2*X) + P1=AMAX1(ZERO,P1-5.0*X) + P2=AMAX1(ZERO,P2-3.0*X) + P3=AMAX1(ZERO,P3-NP3*X) + Z=(P1**5*P2**3*P3**NP3/R2**NR2)/SP + IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 1170 + IF(Z.LE.0.95.AND.PCAPH1.LE.0.0)GO TO 1170 + IF(NR2.GT.0)THEN + Y=AMIN1(R2/NR2,P1/5,P2/3) + ELSE + Y=AMIN1(P1/5,P2/3,P3/NP3) + ENDIF + IF(Z.GT.1.0)THEN + X=Y-Y/Z**FX + ELSE + X=Y*Z**FX-Y + ENDIF + TX=TX+X +1070 CONTINUE +1170 CONTINUE + RPCAHX=AMAX1(-PCAPH1,TPD*TX) + IF(PX.EQ.AH1P1)THEN + IF(AOH1.GT.AHY1)THEN + RYCAH1=RPCAHX + ELSE + RHCAH1=RPCAHX + ENDIF + ELSEIF(PX.EQ.AH2P1)THEN + IF(AOH1.GT.AHY1)THEN + RYCAH2=RPCAHX + ELSE + RHCAH2=RPCAHX + ENDIF + ENDIF +C IF((M/10)*10.EQ.M)THEN +C WRITE(*,1112)'APATITE',I,J,M,MM,PCAPH1,CCA1 +C 2,CH1P1,CH2P1,CHY1,RPCAHX,RHCAH1,RHCAH2,R2,P1,P2,P3 +C 3,SP,Z,(CCA1*A2)**5*(CH0P1*A3)**3*COH1*A1,SPCAH +C ENDIF +C +C MONOCALCIUM PHOSPHATE +C + P1=CCA1 + P2=CH2P1 + SP=SPCAM/A12A2 + X=0.0 + TX=0.0 + DO 1080 MM=1,100 + P1=AMAX1(ZERO,P1-X) + P2=AMAX1(ZERO,P2-2*X) + Z=P1*P2**2/SP + IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 1180 + IF(Z.LE.0.95.AND.PCAPM1.LE.0.0)GO TO 1180 + Y=AMIN1(P1,P2/2) + IF(Z.GT.1.0)THEN + X=Y-Y/Z**0.33 + ELSE + X=Y*Z**0.33-Y + ENDIF + TX=TX+X +1080 CONTINUE +1180 CONTINUE + RPCAMX=AMAX1(-PCAPM1*SPPO4,TPD*TX) + ELSE + RPALPX=0.0 + RPFEPX=0.0 + RPCADX=0.0 + RPCAHX=0.0 + RYA0P1=0.0 + RYA1P1=0.0 + RYA2P1=0.0 + RYA3P1=0.0 + RYA4P1=0.0 + RYA0P2=0.0 + RYA1P2=0.0 + RYA2P2=0.0 + RYA3P2=0.0 + RYA4P2=0.0 + RHA0P1=0.0 + RHA1P1=0.0 + RHA2P1=0.0 + RHA3P1=0.0 + RHA4P1=0.0 + RHA0P2=0.0 + RHA1P2=0.0 + RHA2P2=0.0 + RHA3P2=0.0 + RHA4P2=0.0 + RYF0P1=0.0 + RYF1P1=0.0 + RYF2P1=0.0 + RYF3P1=0.0 + RYF4P1=0.0 + RYF0P2=0.0 + RYF1P2=0.0 + RYF2P2=0.0 + RYF3P2=0.0 + RYF4P2=0.0 + RHF0P1=0.0 + RHF1P1=0.0 + RHF2P1=0.0 + RHF3P1=0.0 + RHF4P1=0.0 + RHF0P2=0.0 + RHF1P2=0.0 + RHF2P2=0.0 + RHF3P2=0.0 + RHF4P2=0.0 + RPCAD1=0.0 + RYCAD2=0.0 + RHCAD2=0.0 + RYCAH1=0.0 + RYCAH2=0.0 + RHCAH1=0.0 + RHCAH2=0.0 + RPCAMX=0.0 + ENDIF +C +C PHOSPHORUS PRECIPITATION-DISSOLUTION IN BAND SOIL ZONE +C + IF(VOLWPB.GT.ZEROS(NY,NX))THEN +C +C ALUMINUM PHOSPHATE (VARISCITE) +C + AH1PB=CH1PB*A2 + AH2PB=CH2B1*A1 + PX=AMAX1(AAL1,AALO1,AALO2,AALO3,AALO4) + PY=AMAX1(AH1PB,AH2PB) + R3=CHY1 + R4=COH1 + P3=CHY1 + P4=COH1 + IF(PY.EQ.AH1PB)THEN + P2=CH1PB + IF(PX.EQ.AAL1)THEN + P1=CAL1 + IF(AOH1.GT.AHY1)THEN + NR3=0 + NR4=0 + NP3=0 + NP4=1 + SP=SYA0P1/A1A2A3 + ELSE + NR3=1 + NR4=0 + NP3=0 + NP4=0 + SP=SHA0P1*A1A23D + ENDIF + ELSEIF(PX.EQ.AALO1)THEN + P1=CALO1 + NR3=0 + NR4=0 + NP3=0 + NP4=0 + SP=SPA1P1/A22 + ELSEIF(PX.EQ.AALO2)THEN + P1=CALO2 + IF(AOH1.GT.AHY1)THEN + NR3=0 + NR4=1 + NP3=0 + NP4=0 + SP=SYA2P1/A2 + ELSE + NR3=0 + NR4=0 + NP3=1 + NP4=0 + SP=SHA2P1/A12A2 + ENDIF + ELSEIF(PX.EQ.AALO3)THEN + P1=CALO3 + IF(AOH1.GT.AHY1)THEN + NR3=0 + NR4=2 + NP3=0 + NP4=0 + SP=SYA3P1*A12A2D + ELSE + NR3=0 + NR4=0 + NP3=2 + NP4=0 + SP=SHA3P1/A13A2 + ENDIF + ELSEIF(PX.EQ.AALO4)THEN + P1=CALO4 + IF(AOH1.GT.AHY1)THEN + NR3=0 + NR4=3 + NP3=0 + NP4=0 + SP=SYA4P1*A12A2D + ELSE + NR3=0 + NR4=0 + NP3=3 + NP4=0 + SP=SHA4P1*A14A2 + ENDIF + ENDIF + ELSE + P2=CH2B1 + IF(PX.EQ.AAL1)THEN + P1=CAL1 + IF(AOH1.GT.AHY1)THEN + NR3=0 + NR4=0 + NP3=0 + NP4=2 + SP=SYA0P2/A13A3 + ELSE + NR3=2 + NR4=0 + NP3=0 + NP4=0 + SP=SHA0P2*A1A3D + ENDIF + ELSEIF(PX.EQ.AALO1)THEN + P1=CALO1 + IF(AOH1.GT.AHY1)THEN + NR3=0 + NR4=0 + NP3=0 + NP4=1 + SP=SYA1P2/A12A2 + ELSE + NR3=1 + NR4=0 + NP3=0 + NP4=0 + SP=SHA1P2/A2 + ENDIF + ELSEIF(PX.EQ.AALO2)THEN + P1=CALO2 + NR3=0 + NR4=0 + NP3=0 + NP4=0 + SP=SPA2P2/A12 + ELSEIF(PX.EQ.AALO3)THEN + P1=CALO3 + IF(AOH1.GT.AHY1)THEN + NR3=0 + NR4=1 + NP3=0 + NP4=0 + SP=SYA3P2 + ELSE + NR3=0 + NR4=0 + NP3=1 + NP4=0 + SP=SHA3P2/A22 + ENDIF + ELSEIF(PX.EQ.AALO4)THEN + P1=CALO4 + IF(AOH1.GT.AHY1)THEN + NR3=0 + NR4=2 + NP3=0 + NP4=0 + SP=SYA4P2 + ELSE + NR3=0 + NR4=0 + NP3=2 + NP4=0 + SP=SHA4P2/A14 + ENDIF + ENDIF + ENDIF + RYA0B1=0.0 + RYA1B1=0.0 + RYA2B1=0.0 + RYA3B1=0.0 + RYA4B1=0.0 + RYA0B2=0.0 + RYA1B2=0.0 + RYA2B2=0.0 + RYA3B2=0.0 + RYA4B2=0.0 + RHA0B1=0.0 + RHA1B1=0.0 + RHA2B1=0.0 + RHA3B1=0.0 + RHA4B1=0.0 + RHA0B2=0.0 + RHA1B2=0.0 + RHA2B2=0.0 + RHA3B2=0.0 + RHA4B2=0.0 + X=0.0 + TX=0.0 + FX=1.0/(2+NR3+NR4+NP3+NP4) + DO 2040 MM=1,100 + R3=AMAX1(ZERO,R3+NR3*X) + R4=AMAX1(ZERO,R4+NR4*X) + P1=AMAX1(ZERO,P1-X) + P2=AMAX1(ZERO,P2-X) + P3=AMAX1(ZERO,P3-NP3*X) + P4=AMAX1(ZERO,P4-NP4*X) + Z=(P1*P2*P3**NP3*P4**NP4/(R3**NR3*R4**NR4))/SP + IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 2140 + IF(Z.LE.0.95.AND.PALPOB.LE.0.0)GO TO 2140 + IF(NR3.NE.0)THEN + Y=AMIN1(R3/NR3,P1,P2) + ELSEIF(NR4.NE.0)THEN + Y=AMIN1(R4/NR4,P1,P2) + ELSEIF(NP3.NE.0)THEN + Y=AMIN1(P1,P2,P3/NP3) + ELSEIF(NP4.NE.0)THEN + Y=AMIN1(P1,P2,P4/NP4) + ELSE + Y=AMIN1(P1,P2) + ENDIF + IF(Z.GT.1.0)THEN + X=Y-Y/Z**FX + ELSE + X=Y*Z**FX-Y + ENDIF + TX=TX+X +2040 CONTINUE +2140 CONTINUE + RPALBX=AMAX1(-PALPOB,TPD*TX) + IF(PY.EQ.AH1PB)THEN + IF(PX.EQ.AAL1)THEN + IF(AOH1.GT.AHY1)THEN + RYA0B1=RPALBX + ELSE + RHA0B1=RPALBX + ENDIF + ELSEIF(PX.EQ.AALO1)THEN + IF(AOH1.GT.AHY1)THEN + RYA1B1=RPALBX + ELSE + RHA1B1=RPALBX + ENDIF + ELSEIF(PX.EQ.AALO2)THEN + IF(AOH1.GT.AHY1)THEN + RYA2B1=RPALBX + ELSE + RHA2B1=RPALBX + ENDIF + ELSEIF(PX.EQ.AALO3)THEN + IF(AOH1.GT.AHY1)THEN + RYA3B1=RPALBX + ELSE + RHA3B1=RPALBX + ENDIF + ELSEIF(PX.EQ.AALO4)THEN + IF(AOH1.GT.AHY1)THEN + RYA4B1=RPALBX + ELSE + RHA4B1=RPALBX + ENDIF + ENDIF + ELSE + IF(PX.EQ.AAL1)THEN + IF(AOH1.GT.AHY1)THEN + RYA0B2=RPALBX + ELSE + RHA0B2=RPALBX + ENDIF + ELSEIF(PX.EQ.AALO1)THEN + IF(AOH1.GT.AHY1)THEN + RYA1B2=RPALBX + ELSE + RHA1B2=RPALBX + ENDIF + ELSEIF(PX.EQ.AALO2)THEN + IF(AOH1.GT.AHY1)THEN + RYA2B2=RPALBX + ELSE + RHA2B2=RPALBX + ENDIF + ELSEIF(PX.EQ.AALO3)THEN + IF(AOH1.GT.AHY1)THEN + RYA3B2=RPALBX + ELSE + RHA3B2=RPALBX + ENDIF + ELSEIF(PX.EQ.AALO4)THEN + IF(AOH1.GT.AHY1)THEN + RYA4B2=RPALBX + ELSE + RHA4B2=RPALBX + ENDIF + ENDIF + ENDIF +C +C IRON PHOSPHATE (STRENGITE) +C + PX=AMAX1(AFE1,AFEO1,AFEO2,AFEO3,AFEO4) + PY=AMAX1(AH1PB,AH2PB) + R3=CHY1 + R4=COH1 + P3=CHY1 + P4=COH1 + IF(PY.EQ.AH1PB)THEN + P2=CH1PB + IF(PX.EQ.AFE1)THEN + P1=CFE1 + IF(AOH1.GT.AHY1)THEN + NR3=0 + NR4=0 + NP3=0 + NP4=1 + SP=SYF0P1/A1A2A3 + ELSE + NR3=1 + NR4=0 + NP3=0 + NP4=0 + SP=SHF0P1*A1A23D + ENDIF + ELSEIF(PX.EQ.AFEO1)THEN + P1=CFEO1 + NR3=0 + NR4=0 + NP3=0 + NP4=0 + SP=SPF1P1/A22 + ELSEIF(PX.EQ.AFEO2)THEN + P1=CFEO2 + IF(AOH1.GT.AHY1)THEN + NR3=0 + NR4=1 + NP3=0 + NP4=0 + SP=SYF2P1/A2 + ELSE + NR3=0 + NR4=0 + NP3=1 + NP4=0 + SP=SHF2P1/A12A2 + ENDIF + ELSEIF(PX.EQ.AFEO3)THEN + P1=CFEO3 + IF(AOH1.GT.AHY1)THEN + NR3=0 + NR4=2 + NP3=0 + NP4=0 + SP=SYF3P1*A12A2D + ELSE + NR3=0 + NR4=0 + NP3=2 + NP4=0 + SP=SHF3P1/A13A2 + ENDIF + ELSEIF(PX.EQ.AFEO4)THEN + P1=CFEO4 + IF(AOH1.GT.AHY1)THEN + NR3=0 + NR4=3 + NP3=0 + NP4=0 + SP=SYF4P1*A12A2D + ELSE + NR3=0 + NR4=0 + NP3=3 + NP4=0 + SP=SHF4P1*A14A2 + ENDIF + ENDIF + ELSE + P2=CH2B1 + IF(PX.EQ.AFE1)THEN + P1=CFE1 + IF(AOH1.GT.AHY1)THEN + NR3=0 + NR4=0 + NP3=0 + NP4=2 + SP=SYF0P2/A13A3 + ELSE + NR3=2 + NR4=0 + NP3=0 + NP4=0 + SP=SHF0P2*A1A3D + ENDIF + ELSEIF(PX.EQ.AFEO1)THEN + P1=CFEO1 + IF(AOH1.GT.AHY1)THEN + NR3=0 + NR4=0 + NP3=0 + NP4=1 + SP=SYF1P2/A12A2 + ELSE + NR3=1 + NR4=0 + NP3=0 + NP4=0 + SP=SHF1P2/A2 + ENDIF + ELSEIF(PX.EQ.AFEO2)THEN + P1=CFEO2 + NR3=0 + NR4=0 + NP3=0 + NP4=0 + SP=SPF2P2/A12 + ELSEIF(PX.EQ.AFEO3)THEN + P1=CFEO3 + IF(AOH1.GT.AHY1)THEN + NR3=0 + NR4=1 + NP3=0 + NP4=0 + SP=SYF3P2 + ELSE + NR3=0 + NR4=0 + NP3=1 + NP4=0 + SP=SHF3P2/A22 + ENDIF + ELSEIF(PX.EQ.AFEO4)THEN + P1=CFEO4 + IF(AOH1.GT.AHY1)THEN + NR3=0 + NR4=2 + NP3=0 + NP4=0 + SP=SYF4P2 + ELSE + NR3=0 + NR4=0 + NP3=2 + NP4=0 + SP=SHF4P2/A14 + ENDIF + ENDIF + ENDIF + RYF0B1=0.0 + RYF1B1=0.0 + RYF2B1=0.0 + RYF3B1=0.0 + RYF4B1=0.0 + RYF0B2=0.0 + RYF1B2=0.0 + RYF2B2=0.0 + RYF3B2=0.0 + RYF4B2=0.0 + RHF0B1=0.0 + RHF1B1=0.0 + RHF2B1=0.0 + RHF3B1=0.0 + RHF4B1=0.0 + RHF0B2=0.0 + RHF1B2=0.0 + RHF2B2=0.0 + RHF3B2=0.0 + RHF4B2=0.0 + X=0.0 + TX=0.0 + FX=1.0/(2+NR3+NR4+NP3+NP4) + DO 2050 MM=1,100 + R3=AMAX1(ZERO,R3+NR3*X) + R4=AMAX1(ZERO,R4+NR4*X) + P1=AMAX1(ZERO,P1-X) + P2=AMAX1(ZERO,P2-X) + P3=AMAX1(ZERO,P3-NP3*X) + P4=AMAX1(ZERO,P4-NP4*X) + Z=(P1*P2*P3**NP3*P4**NP4/(R3**NR3*R4**NR4))/SP + IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 2150 + IF(Z.LE.0.95.AND.PFEPOB.LE.0.0)GO TO 2150 + IF(NR3.NE.0)THEN + Y=AMIN1(R3/NR3,P1,P2) + ELSEIF(NR4.NE.0)THEN + Y=AMIN1(R4/NR4,P1,P2) + ELSEIF(NP3.NE.0)THEN + Y=AMIN1(P1,P2,P3/NP3) + ELSEIF(NP4.NE.0)THEN + Y=AMIN1(P1,P2,P4/NP4) + ELSE + Y=AMIN1(P1,P2) + ENDIF + IF(Z.GT.1.0)THEN + X=Y-Y/Z**FX + ELSE + X=Y*Z**FX-Y + ENDIF + TX=TX+X +2050 CONTINUE +2150 CONTINUE + RPFEBX=AMAX1(-PFEPOB,TPD*TX) + IF(PY.EQ.AH1PB)THEN + IF(PX.EQ.AFE1)THEN + IF(AOH1.GT.AHY1)THEN + RYF0B1=RPFEBX + ELSE + RHF0B1=RPFEBX + ENDIF + ELSEIF(PX.EQ.AFEO1)THEN + IF(AOH1.GT.AHY1)THEN + RYF1B1=RPFEBX + ELSE + RHF1B1=RPFEBX + ENDIF + ELSEIF(PX.EQ.AFEO2)THEN + IF(AOH1.GT.AHY1)THEN + RYF2B1=RPFEBX + ELSE + RHF2B1=RPFEBX + ENDIF + ELSEIF(PX.EQ.AFEO3)THEN + IF(AOH1.GT.AHY1)THEN + RYF3B1=RPFEBX + ELSE + RHF3B1=RPFEBX + ENDIF + ELSEIF(PX.EQ.AFEO4)THEN + IF(AOH1.GT.AHY1)THEN + RYF4B1=RPFEBX + ELSE + RHF4B1=RPFEBX + ENDIF + ENDIF + ELSE + IF(PX.EQ.AFE1)THEN + IF(AOH1.GT.AHY1)THEN + RYF0B2=RPFEBX + ELSE + RHF0B2=RPFEBX + ENDIF + ELSEIF(PX.EQ.AFEO1)THEN + IF(AOH1.GT.AHY1)THEN + RYF1B2=RPFEBX + ELSE + RHF1B2=RPFEBX + ENDIF + ELSEIF(PX.EQ.AFEO2)THEN + IF(AOH1.GT.AHY1)THEN + RYF2B2=RPFEBX + ELSE + RHF2B2=RPFEBX + ENDIF + ELSEIF(PX.EQ.AFEO3)THEN + IF(AOH1.GT.AHY1)THEN + RYF3B2=RPFEBX + ELSE + RHF3B2=RPFEBX + ENDIF + ELSEIF(PX.EQ.AFEO4)THEN + IF(AOH1.GT.AHY1)THEN + RYF4B2=RPFEBX + ELSE + RHF4B2=RPFEBX + ENDIF + ENDIF + ENDIF +C +C DICALCIUM PHOSPHATE +C + PX=AMAX1(AH1PB,AH2PB) + R2=CHY1 + P3=COH1 + P1=CCA1 + IF(PX.EQ.AH1PB)THEN + P2=CH1PB + NR2=0 + NP3=0 + SP=SPCAD/A22 + ELSEIF(PX.EQ.AH2PB)THEN + P2=CH2B1 + IF(AOH1.GT.AHY1)THEN + NR2=0 + NP3=1 + SP=SYCAD2/A12A2 + ELSE + NR2=1 + NP3=0 + SP=SHCAD2/A2 + ENDIF + ENDIF + RPCDB1=0.0 + RYCDB2=0.0 + RHCDB2=0.0 + X=0.0 + TX=0.0 + FX=1.0/(2+NR2+NP3) + DO 2060 MM=1,100 + R2=AMAX1(ZERO,R2+NR2*X) + P1=AMAX1(ZERO,P1-X) + P2=AMAX1(ZERO,P2-X) + P3=AMAX1(ZERO,P3-NP3*X) + Z=(P1*P2*P3**NP3/R2**NR2)/SP + IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 2160 + IF(Z.LE.0.95.AND.PCAPDB.LE.0.0)GO TO 2160 + IF(NR2.NE.0)THEN + Y=AMIN1(R2/NR2,P1,P2) + ELSEIF(NP3.NE.0)THEN + Y=AMIN1(P1,P2,P3/NP3) + ELSE + Y=AMIN1(P1,P2) + ENDIF + IF(Z.GT.1.0)THEN + X=Y-Y/Z**FX + ELSE + X=Y*Z**FX-Y + ENDIF + TX=TX+X +2060 CONTINUE +2160 CONTINUE + RPCDBX=AMAX1(-PCAPDB,TPD*TX) + IF(PX.EQ.AH1PB)THEN + RPCDB1=RPCDBX + ELSEIF(PX.EQ.AH2PB)THEN + IF(AOH1.GT.AHY1)THEN + RYCDB2=RPCDBX + ELSE + RHCDB2=RPCDBX + ENDIF + ENDIF +C +C HYDROXYAPATITE +C + PX=AMAX1(AH1PB,AH2PB) + R2=CHY1 + P3=COH1 + P1=CCA1 + IF(PX.EQ.AH1PB)THEN + P2=CH1PB + IF(AOH1.GT.AHY1)THEN + NR2=0 + NP3=4 + SP=SYCAH1/A14A28 + ELSE + NR2=4 + NP3=0 + SP=SHCAH1*A14A8D + ENDIF + ELSEIF(PX.EQ.AH2PB)THEN + P2=CH2B1 + IF(AOH1.GT.AHY1)THEN + NR2=0 + NP3=7 + SP=SYCAH2/A1TA25 + ELSE + NR2=7 + NP3=0 + SP=SHCAH2*A14A5D + ENDIF + ENDIF + RYCHB1=0.0 + RYCHB2=0.0 + RHCHB1=0.0 + RHCHB2=0.0 + X=0.0 + TX=0.0 + FX=1.0/(6+NR2+NR3) + DO 2070 MM=1,100 + R2=AMAX1(ZERO,R2+NR2*X) + P1=AMAX1(ZERO,P1-5.0*X) + P2=AMAX1(ZERO,P2-3.0*X) + P3=AMAX1(ZERO,P3-NP3*X) + Z=(P1**5*P2**3*P3**NP3/R2**NR2)/SP + IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 2170 + IF(Z.LE.0.95.AND.PCAPHB.LE.0.0)GO TO 2170 + IF(NR2.GT.0)THEN + Y=AMIN1(R2/NR2,P1/5,P2/3) + ELSE + Y=AMIN1(P1/5,P2/3,P3/NP3) + ENDIF + IF(Z.GT.1.0)THEN + X=Y-Y/Z**FX + ELSE + X=Y*Z**FX-Y + ENDIF + TX=TX+X +2070 CONTINUE +2170 CONTINUE + RPCHBX=AMAX1(-PCAPHB,TPD*TX) + IF(PX.EQ.AH1PB)THEN + IF(AOH1.GT.AHY1)THEN + RYCHB1=RPCHBX + ELSE + RHCHB1=RPCHBX + ENDIF + ELSEIF(PX.EQ.AH2PB)THEN + IF(AOH1.GT.AHY1)THEN + RYCHB2=RPCHBX + ELSE + RHCHB2=RPCHBX + ENDIF + ENDIF +C +C MONOCALCIUM PHOSPHATE +C + P1=CCA1 + P2=CH2B1 + SP=SPCAM/A12A2 + X=0.0 + TX=0.0 + DO 2080 MM=1,100 + P1=AMAX1(ZERO,P1-X) + P2=AMAX1(ZERO,P2-2*X) + Z=P1*P2**2/SP + IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 2180 + IF(Z.LE.0.95.AND.PCAPMB.LE.0.0)GO TO 2180 + Y=AMIN1(P1,P2/2) + IF(Z.GT.1.0)THEN + X=Y-Y/Z**0.33 + ELSE + X=Y*Z**0.33-Y + ENDIF + TX=TX+X +2080 CONTINUE +2180 CONTINUE + RPCMBX=AMAX1(-PCAPMB*SPPO4,TPD*TX) + ELSE + RPALBX=0.0 + RPFEBX=0.0 + RPCDBX=0.0 + RPCHBX=0.0 + RPCMBX=0.0 + RYA0B1=0.0 + RYA1B1=0.0 + RYA2B1=0.0 + RYA3B1=0.0 + RYA4B1=0.0 + RYA0B2=0.0 + RYA1B2=0.0 + RYA2B2=0.0 + RYA3B2=0.0 + RYA4B2=0.0 + RHA0B1=0.0 + RHA1B1=0.0 + RHA2B1=0.0 + RHA3B1=0.0 + RHA4B1=0.0 + RHA0B2=0.0 + RHA1B2=0.0 + RHA2B2=0.0 + RHA3B2=0.0 + RHA4B2=0.0 + RYF0B1=0.0 + RYF1B1=0.0 + RYF2B1=0.0 + RYF3B1=0.0 + RYF4B1=0.0 + RYF0B2=0.0 + RYF1B2=0.0 + RYF2B2=0.0 + RYF3B2=0.0 + RYF4B2=0.0 + RHF0B1=0.0 + RHF1B1=0.0 + RHF2B1=0.0 + RHF3B1=0.0 + RHF4B1=0.0 + RHF0B2=0.0 + RHF1B2=0.0 + RHF2B2=0.0 + RHF3B2=0.0 + RHF4B2=0.0 + RPCDB1=0.0 + RYCDB2=0.0 + RHCDB2=0.0 + RYCHB1=0.0 + RYCHB2=0.0 + RHCHB1=0.0 + RHCHB2=0.0 + ENDIF +C +C PHOSPHORUS ANION EXCHANGE IN NON-BAND SOIL ZONE +C CALCULATED FROM EXCHANGE EQUILIBRIA AMONG H2PO4-, +C HPO4--, H+, OH- AND PROTONATED AND NON-PROTONATED -OH +C EXCHANGE SITES +C + IF(VOLWPO.GT.ZEROS(NY,NX) + 2.AND.AEC(L,NY,NX).GT.ZEROS(NY,NX))THEN +C + +C PROTONATION OF ANION EXCHANGE SITES IN NON-BAND SOIL ZONE +C + DCHG=AMAX1(-0.1E+05,XOH21-XOH01-XH1P1) + AEP=EXP(AE*DCHG/TKS(L,NY,NX)) + AEN=EXP(-AE*DCHG/TKS(L,NY,NX)) + SPOH2=SXOH2*AEP/A1 + X0=XOH11+CHY1+SPOH2 + X1=AMAX1(0.0,X0**2-4.0*(XOH11*CHY1-SPOH2*XOH21)) + RXOH2=TADAX*(X0-SQRT(X1)) + SPOH1=SXOH1/(AEN*A1) + X0=XOH01+CHY1+SPOH1 + X1=AMAX1(0.0,X0**2-4.0*(XOH01*CHY1-SPOH1*XOH11)) + RXOH1=TADAX*(X0-SQRT(X1)) +C +C H2PO4 EXCHANGE IN NON-BAND SOIL ZONE FROM CONVERGENCE +C SOLUTION FOR EQUILIBRIUM AMONG H2PO4-, H+, OH-, X-OH +C AND X-H2PO4 +C + SPH2P=SYH2P*DPH2O/(SXOH2*AEP*A1) + X0=XOH21+CH2P1+SPH2P + X1=AMAX1(0.0,X0**2-4.0*(XOH21*CH2P1-SPH2P*XH2P1)) + RXH2P=TADAX*(X0-SQRT(X1)) + R1=XH2P1 + R2=COH1 + P1=XOH11 + P2=CH2P1 + P3=CHY1 + IF(AOH1.GT.AHY1)THEN + NR2=1 + NP3=0 + SP=SYH2P + ELSE + NR2=0 + NP3=1 + SP=SHH2P/A12 + ENDIF + RYH2P=0.0 + RHH2P=0.0 + X=0.0 + TX=0.0 + DO 4010 MM=1,100 + R1=AMAX1(ZERO,R1+X) + R2=AMAX1(ZERO,R2+NR2*X) + P1=AMAX1(ZERO,P1-X) + P2=AMAX1(ZERO,P2-X) + P3=AMAX1(ZERO,P3-NP3*X) + Z=(P1*P2*P3**NP3/(R1*R2**NR2))/SP + IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 4110 + IF(NR2.GT.0)THEN + Y=AMIN1(R1,R2/NR2,P1,P2) + ELSE + Y=AMIN1(R1,P1,P2,P3/NP3) + ENDIF + IF(Z.GT.1.0)THEN + X=Y-Y/Z**0.25 + ELSE + X=Y*Z**0.25-Y + ENDIF + TX=TX+X +4010 CONTINUE +4110 CONTINUE + IF(AOH1.GT.AHY1)THEN + RYH2P=TADAX*TX + ELSE + RHH2P=TADAX*TX + ENDIF +C +C HPO4 EXCHANGE IN NON-BAND SOIL ZONE FROM CONVERGENCE +C SOLUTION FOR EQUILIBRIUM AMONG HPO4--, H+, OH-, X-OH +C AND X-HPO4 +C + R1=XH1P1 + R2=COH1 + P1=XOH11 + P2=CH1P1 + P3=CHY1 + IF(AOH1.GT.AHY1)THEN + NR2=1 + NP3=0 + SP=SYH1P*AEN*A1A2D + ELSE + NR2=0 + NP3=1 + SP=SHH1P*AEN/A1A2 + ENDIF + RYH1P=0.0 + RHH1P=0.0 + X=0.0 + TX=0.0 + DO 4020 MM=1,100 + R1=AMAX1(ZERO,R1+X) + R2=AMAX1(ZERO,R2+NR2*X) + P1=AMAX1(ZERO,P1-X) + P2=AMAX1(ZERO,P2-X) + P3=AMAX1(ZERO,P3-NP3*X) + Z=(P1*P2*P3**NP3/(R1*R2**NR2))/SP + IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 4120 + IF(NR2.GT.0)THEN + Y=AMIN1(R1,R2/NR2,P1,P2) + ELSE + Y=AMIN1(R1,P1,P2,P3/NP3) + ENDIF + IF(Z.GT.1.0)THEN + X=Y-Y/Z**0.25 + ELSE + X=Y*Z**0.25-Y + ENDIF + TX=TX+X +4020 CONTINUE +4120 CONTINUE + IF(AOH1.GT.AHY1)THEN + RYH1P=TADAX*TX + ELSE + RHH1P=TADAX*TX + ENDIF + ELSE + RXOH2=0.0 + RXOH1=0.0 + RXH2P=0.0 + RYH2P=0.0 + RYH1P=0.0 + RHH2P=0.0 + RHH1P=0.0 + ENDIF +C +C PHOSPHORUS ANION EXCHANGE IN BAND SOIL ZONE +C CALCULATED FROM EXCHANGE EQUILIBRIA AMONG H2PO4-, +C HPO4--, H+, OH- AND PROTONATED AND NON-PROTONATED -OH +C EXCHANGE SITES +C + IF(VOLWPB.GT.ZEROS(NY,NX) + 2.AND.AEC(L,NY,NX).GT.ZEROS(NY,NX))THEN +C +C PROTONATION OF EXCHANGE SITES IN BAND SOIL ZONE +C + DCHG=AMAX1(-0.1E+05,XH21B-XH01B-X1P1B) + AEP=EXP(AE*DCHG/TKS(L,NY,NX)) + AEN=EXP(-AE*DCHG/TKS(L,NY,NX)) + SPOH2=SXOH2*AEP/A1 + + X0=XH11B+CHY1+SPOH2 + X1=AMAX1(0.0,X0**2-4.0*(XH11B*CHY1-SPOH2*XH21B)) + RXO2B=TADAX*(X0-SQRT(X1)) + SPOH1=SXOH1/(AEN*A1) + X0=XH01B+CHY1+SPOH1 + X1=AMAX1(0.0,X0**2-4.0*(XH01B*CHY1-SPOH1*XH11B)) + RXO1B=TADAX*(X0-SQRT(X1)) +C +C H2PO4 EXCHANGE IN BAND SOIL ZONE FROM CONVERGENCE +C SOLUTION FOR EQUILIBRIUM AMONG H2PO4-, H+, OH-, X-OH +C AND X-H2PO4 +C + SPH2P=SYH2P*DPH2O/(SXOH2*AEP*A1) + X0=XH21B+CH2B1+SPH2P + X1=AMAX1(0.0,X0**2-4.0*(XH21B*CH2B1-SPH2P*X2P1B)) + RXH2B=TADAX*(X0-SQRT(X1)) + R1=X2P1B + R2=COH1 + P1=XH11B + P2=CH2B1 + P3=CHY1 + IF(AOH1.GT.AHY1)THEN + NR2=1 + NP3=0 + SP=SYH2P + ELSE + NR2=0 + NP3=1 + SP=SHH2P/A12 + ENDIF + RYH2B=0.0 + RHH2B=0.0 + X=0.0 + TX=0.0 + DO 5010 MM=1,100 + R1=AMAX1(ZERO,R1+X) + R2=AMAX1(ZERO,R2+NR2*X) + P1=AMAX1(ZERO,P1-X) + P2=AMAX1(ZERO,P2-X) + P3=AMAX1(ZERO,P3-NP3*X) + Z=(P1*P2*P3**NP3/(R1*R2**NR2))/SP + IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 5110 + IF(NR2.GT.0)THEN + Y=AMIN1(R1,R2/NR2,P1,P2) + ELSE + Y=AMIN1(R1,P1,P2,P3/NP3) + ENDIF + IF(Z.GT.1.0)THEN + X=Y-Y/Z**0.25 + ELSE + X=Y*Z**0.25-Y + ENDIF + TX=TX+X +5010 CONTINUE +5110 CONTINUE + IF(AOH1.GT.AHY1)THEN + RYH2B=TADAX*TX + ELSE + RHH2B=TADAX*TX + ENDIF +C +C HPO4 EXCHANGE IN BAND SOIL ZONE FROM CONVERGENCE +C SOLUTION FOR EQUILIBRIUM AMONG HPO4--, H+, OH-, X-OH +C AND X-HPO4 +C + R1=X1P1B + R2=COH1 + P1=XH11B + P2=CH1PB + P3=CHY1 + IF(AOH1.GT.AHY1)THEN + NR2=1 + NP3=0 + SP=SYH1P*AEN*A1A2D + ELSE + NR2=0 + NP3=1 + SP=SHH1P*AEN/A1A2 + ENDIF + RYH1B=0.0 + RHH1B=0.0 + X=0.0 + TX=0.0 + DO 5020 MM=1,100 + R1=AMAX1(ZERO,R1+X) + R2=AMAX1(ZERO,R2+NR2*X) + P1=AMAX1(ZERO,P1-X) + P2=AMAX1(ZERO,P2-X) + P3=AMAX1(ZERO,P3-NP3*X) + Z=(P1*P2*P3**NP3/(R1*R2**NR2))/SP + IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 5120 + IF(NR2.GT.0)THEN + Y=AMIN1(R1,R2/NR2,P1,P2) + ELSE + Y=AMIN1(R1,P1,P2,P3/NP3) + ENDIF + IF(Z.GT.1.0)THEN + X=Y-Y/Z**0.25 + ELSE + X=Y*Z**0.25-Y + ENDIF + TX=TX+X +5020 CONTINUE +5120 CONTINUE + IF(AOH1.GT.AHY1)THEN + RYH1B=TADAX*TX + ELSE + RHH1B=TADAX*TX + ENDIF + ELSE + RXO2B=0.0 + RXO1B=0.0 + RXH2B=0.0 + RYH2B=0.0 + RYH1B=0.0 + RHH2B=0.0 + RHH1B=0.0 + ENDIF +C +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 +C +C CATION CONCENTRATIONS +C + CN4X=CN41 + CNBX=CN4B + CHYX=CHY1 + CALX=CAL1**0.333 + CCAX=CCA1**0.500 + CMGX=CMG1**0.500 + CNAX=CNA1 + CKAX=CKA1 +C +C GAPON COEFFICIENTS FROM SOIL FILE ADJUSTED +C FOR ACTIVITY COEFFICIENTS +C + GKCHX=GKCH(L,NY,NX)*A1A2QD + GKC4X=GKC4(L,NY,NX)*A1A2QD + GKCAX=GKCA(L,NY,NX)*A3C/A2Q + GKCMX=GKCM(L,NY,NX) + GKCNX=GKCN(L,NY,NX)*A1A2QD + GKCKX=GKCK(L,NY,NX)*A1A2QD +C +C EQUILIBRIUM X-CA CONCENTRATION FROM CEC AND CATION +C CONCENTRATIONS +C + XCAQ=CCEC/(1.0+GKC4X*CN4X/CCAX*VLNH4(L,NY,NX)+GKC4X*CNBX/CCAX + 2*VLNHB(L,NY,NX)+GKCHX*CHYX/CCAX+GKCAX*CALX/CCAX+GKCMX*CMGX/CCAX + 3+GKCNX*CNAX/CCAX+GKCKX*CKAX/CCAX) + FCAQ=XCAQ/CCAX + FN4X=FCAQ*GKC4X + FHYX=FCAQ*GKCHX + FALX=FCAQ*GKCAX/3.0 + FCAX=FCAQ*0.5 + FMGX=FCAQ*GKCMX*0.5 + FNAX=FCAQ*GKCNX + FKAX=FCAQ*GKCKX +C +C NH4 EXCHANGE IN NON-BAND AND BAND SOIL ZONES +C + RXN4=TADCX*(FN4X*CN4X-XN41)/(1.0+FN4X) + RXNB=TADCX*(FN4X*CNBX-XN4B)/(1.0+FN4X) +C +C H EXCHANGE +C + RXHY=TADCX*(FHYX*CHYX-XHY1)/(1.0+FHYX) +C +C AL EXCHANGE +C + E=XAL1 + C=CAL1 + X=0.0 + TX=0.0 + DO 3010 MM=1,100 + E=AMAX1(ZERO,E+X) + C=AMAX1(ZERO,C-X) + Z=(C**0.333/E)*FALX + IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 3110 + Y=AMIN1(E,C) + IF(Z.GT.1.0)THEN + X=Y-Y/Z**0.75 + ELSE + X=Y*Z**0.75-Y + ENDIF + TX=TX+X +3010 CONTINUE +3110 CONTINUE + RXAL=TADCX*TX +C +C CA EXCHANGE +C + E=XCA1 + C=CCA1 + X=0.0 + TX=0.0 + DO 3020 MM=1,100 + E=AMAX1(ZERO,E+X) + C=AMAX1(ZERO,C-X) + Z=(C**0.50/E)*FCAX + IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 3120 + Y=AMIN1(E,C) + IF(Z.GT.1.0)THEN + X=Y-Y/Z**0.67 + ELSE + X=Y*Z**0.67-Y + ENDIF + TX=TX+X +3020 CONTINUE +3120 CONTINUE + RXCA=TADCX*TX +C +C MG EXCHANGE +C + E=XMG1 + C=CMG1 + X=0.0 + TX=0.0 + DO 3030 MM=1,100 + E=AMAX1(ZERO,E+X) + C=AMAX1(ZERO,C-X) + Z=(C**0.50/E)*FMGX + IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 3130 + Y=AMIN1(E,C) + IF(Z.GT.1.0)THEN + X=Y-Y/Z**0.67 + ELSE + X=Y*Z**0.67-Y + ENDIF + TX=TX+X +3030 CONTINUE +3130 CONTINUE + RXMG=TADCX*TX +C +C NA EXCHANGE +C + RXNA=TADCX*(FNAX*CNAX-XNA1)/(1.0+FNAX) +C +C K EXCHANGE +C + RXKA=TADCX*(FKAX*CKAX-XKA1)/(1.0+FKAX) + ELSE + RXN4=0.0 + RXNB=0.0 + RXHY=0.0 + RXAL=0.0 + RXCA=0.0 + RXMG=0.0 + RXNA=0.0 + RXKA=0.0 + ENDIF +C +C DISSOCIATION OF CARBOXYL RADICALS AND ADSORPTION OF AL(OH)2 +C + DP=DPCOH/A1 + S0=CHY1+XCOO+DP + S1=AMAX1(0.0,S0**2-4.0*(CHY1*XCOO-DP*XHC1)) + RXHC=TADCX*(S0-SQRT(S1)) + DP=DPALO/A1 + S0=CALO2+XCOO+DP + S1=AMAX1(0.0,S0**2-4.0*(CALO2*XCOO-DP*XALO21)) + RXALO2=TADAX*(S0-SQRT(S1)) +C +C NH4-NH3+H IN NON-BAND AND BAND SOIL ZONES +C + IF(VOLWNH.GT.ZEROS(NY,NX))THEN + DP=DPN4/A0 + S0=CHY1+CN31+DP + S1=AMAX1(0.0,S0**2-4.0*(CHY1*CN31-DP*CN41)) + RNH4=TSLX*(S0-SQRT(S1)) + ELSE + RNH4=0.0 + ENDIF + IF(VOLWNB.GT.ZEROS(NY,NX))THEN + DP=DPN4/A0 + S0=CHY1+CN3B+DP + S1=AMAX1(0.0,S0**2-4.0*(CHY1*CN3B-DP*CN4B)) + RNHB=TSLX*(S0-SQRT(S1)) + ELSE + RNHB=0.0 + ENDIF +C +C CO2-H+HCO3 +C + DP=DPCO2*A0A12 + S0=CHY1+CHCO31+DP + S1=AMAX1(0.0,S0**2-4.0*(CHY1*CHCO31-DP*CCO21)) + RCO2Q=TSLX*(S0-SQRT(S1)) +C +C HCO3-H+CO3 +C + DP=DPHCO/A2 + S0=CHY1+CCO31+DP + S1=AMAX1(0.0,S0**2-4.0*(CHY1*CCO31-DP*CHCO31)) + RHCO3=TSLX*(S0-SQRT(S1)) +C +C ALOH-AL+OH +C + DP=DPAL1*A2A13D + S0=CAL1+COH1+DP + S1=AMAX1(0.0,S0**2-4.0*(CAL1*COH1-DP*CALO1)) + RALO1=TSLX*(S0-SQRT(S1)) +C +C AL(OH)2-ALOH+OH +C + DP=DPAL2/A2 + S0=CALO1+COH1+DP + S1=AMAX1(0.0,S0**2-4.0*(CALO1*COH1-DP*CALO2)) + RALO2=TSLX*(S0-SQRT(S1)) +C +C AL(OH)3-AL(OH)2+OH +C + DP=DPAL3*A0A12 + S0=CALO2+COH1+DP + S1=AMAX1(0.0,S0**2-4.0*(CALO2*COH1-DP*CALO3)) + RALO3=TSLX*(S0-SQRT(S1)) +C +C AL(OH)4-AL(OH)3+OH +C + DP=DPAL4/A0 + S0=CALO3+COH1+DP + S1=AMAX1(0.0,S0**2-4.0*(CALO3*COH1-DP*CALO4)) + RALO4=TSLX*(S0-SQRT(S1)) +C +C ALSO4-AL+SO4 +C + DP=DPALS*A1A23D + S0=CAL1+CSO41+DP + S1=AMAX1(0.0,S0**2-4.0*(CAL1*CSO41-DP*CALS1)) + RALS=TSLX*(S0-SQRT(S1)) +C +C FEOH-FE+OH +C + DP=DPFE1*A2A13D + S0=CFE1+COH1+DP + S1=AMAX1(0.0,S0**2-4.0*(CFE1*COH1-DP*CFEO1)) + RFEO1=TSLX*(S0-SQRT(S1)) +C +C FE(OH)2-FEOH+OH +C + DP=DPFE2/A2 + S0=CFEO1+COH1+DP + S1=AMAX1(0.0,S0**2-4.0*(CFEO1*COH1-DP*CFEO2)) + RFEO2=TSLX*(S0-SQRT(S1)) +C +C FE(OH)3-FE(OH)2+OH +C + DP=DPFE3*A0A12 + S0=CFEO2+COH1+DP + S1=AMAX1(0.0,S0**2-4.0*(CFEO2*COH1-DP*CFEO3)) + RFEO3=TSLX*(S0-SQRT(S1)) +C +C AL(OH)4-AL(OH)3+OH +C + DP=DPFE4/A0 + S0=CFEO3+COH1+DP + S1=AMAX1(0.0,S0**2-4.0*(CFEO3*COH1-DP*CFEO4)) + RFEO4=TSLX*(S0-SQRT(S1)) +C +C FESO4-FE+SO4 +C + DP=DPFES*A1A23D + S0=CFE1+CSO41+DP + S1=AMAX1(0.0,S0**2-4.0*(CFE1*CSO41-DP*CFES1)) + RFES=TSLX*(S0-SQRT(S1)) +C +C CAOH-CA+OH +C + DP=DPCAO/A2 + S0=CCA1+COH1+DP + S1=AMAX1(0.0,S0**2-4.0*(CCA1*COH1-DP*CCAO1)) + RCAO=TSLX*(S0-SQRT(S1)) +C +C CACO3-CA+CO3 +C + DP=DPCAC*A0A22 + S0=CCA1+CCO31+DP + S1=AMAX1(0.0,S0**2-4.0*(CCA1*CCO31-DP*CCAC1)) + RCAC=TSLX*(S0-SQRT(S1)) +C +C CAHCO3-CA+HCO3 +C + DP=DPCAH/A2 + S0=CCA1+CHCO31+DP + S1=AMAX1(0.0,S0**2-4.0*(CCA1*CHCO31-DP*CCAH1)) + RCAH=TSLX*(S0-SQRT(S1)) +C +C CASO4-CA+SO4 +C + DP=DPCAS*A0A22 + S0=CCA1+CSO41+DP + S1=AMAX1(0.0,S0**2-4.0*(CCA1*CSO41-DP*CCAS1)) + RCAS=TSLX*(S0-SQRT(S1)) +C +C MGOH-MG+OH +C + DP=DPMGO/A2 + S0=CMG1+COH1+DP + S1=AMAX1(0.0,S0**2-4.0*(CMG1*COH1-DP*CMGO1)) + RMGO=TSLX*(S0-SQRT(S1)) +C +C MGCO3-MG+CO3 +C + DP=DPMGC*A0A22 + S0=CMG1+CCO31+DP + S1=AMAX1(0.0,S0**2-4.0*(CMG1*CCO31-DP*CMGC1)) + RMGC=TSLX*(S0-SQRT(S1)) +C +C MGHCO3-MG+HCO3 +C + DP=DPMGH/A2 + S0=CMG1+CHCO31+DP + S1=AMAX1(0.0,S0**2-4.0*(CMG1*CHCO31-DP*CMGH1)) + RMGH=TSLX*(S0-SQRT(S1)) +C +C MGSO4-MG+SO4 +C + DP=DPMGS*A0A22 + S0=CMG1+CSO41+DP + S1=AMAX1(0.0,S0**2-4.0*(CMG1*CSO41-DP*CMGS1)) + RMGS=TSLX*(S0-SQRT(S1)) +C +C NACO3-NA+CO3 +C + DP=DPNAC/A2 + S0=CNA1+CCO31+DP + S1=AMAX1(0.0,S0**2-4.0*(CNA1*CCO31-DP*CNAC1)) + RNAC=TSLX*(S0-SQRT(S1)) +C +C NASO4-NA+SO4 +C + DP=DPNAS/A2 + S0=CNA1+CSO41+DP + S1=AMAX1(0.0,S0**2-4.0*(CNA1*CSO41-DP*CNAS1)) + RNAS=TSLX*(S0-SQRT(S1)) +C +C KSO4-K+SO4 +C + DP=DPKAS/A2 + S0=CKA1+CSO41+DP + S1=AMAX1(0.0,S0**2-4.0*(CKA1*CSO41-DP*CKAS1)) + RKAS=TSLX*(S0-SQRT(S1)) +C +C PHOSPHORUS IN NON-BAND SOIL ZONE +C + IF(VOLWPO.GT.ZEROS(NY,NX))THEN +C +C HPO4-H+PO4 +C + DP=DPH1P*A2A13D + S0=CH0P1+CHY1+DP + S1=AMAX1(0.0,S0**2-4.0*(CH0P1*CHY1-DP*CH1P1)) + RH1P=TSLX*(S0-SQRT(S1)) +C +C H2PO4-H+HPO4 +C + DP=DPH2P/A2 + S0=CH1P1+CHY1+DP + S1=AMAX1(0.0,S0**2-4.0*(CH1P1*CHY1-DP*CH2P1)) + RH2P=TSLX*(S0-SQRT(S1)) +C IF(NY.EQ.5.AND.L.EQ.10)THEN +C WRITE(*,22)'RH2P',I,J,NX,NY,L,M,RH2P,TSLX,S0,S1,DP,DPH2P,A2 +C 2,CH1P1,CHY1,CH2P1,H2PO4(L,NY,NX),VOLWPX,RH2PX,XH2PS(L,NY,NX) +C 3,TUPH2P(L,NY,NX) +22 FORMAT(A8,6I4,60E12.4) +C ENDIF +C +C H3PO4-H+H2PO4 +C + DP=DPH3P*A0A12 + S0=CH2P1+CHY1+DP + S1=AMAX1(0.0,S0**2-4.0*(CH2P1*CHY1-DP*CH3P1)) + RH3P=TSLX*(S0-SQRT(S1)) +C +C FEHPO4-FE+HPO4 +C + DP=DPF1P*A1A23D + S0=CFE1+CH1P1+DP + S1=AMAX1(0.0,S0**2-4.0*(CFE1*CH1P1-DP*CF1P1)) + RF1P=TSLX*(S0-SQRT(S1)) +C +C FEH2PO4-FE+H2PO4 +C + DP=DPF2P*A2A13D + S0=CFE1+CH2P1+DP + S1=AMAX1(0.0,S0**2-4.0*(CFE1*CH2P1-DP*CF2P1)) + RF2P=TSLX*(S0-SQRT(S1)) +C +C CAPO4-CA+PO4 +C + DP=DPC0P*A1A23D + S0=CCA1+CH0P1+DP + S1=AMAX1(0.0,S0**2-4.0*(CCA1*CH0P1-DP*CC0P1)) + RC0P=TSLX*(S0-SQRT(S1)) +C +C CAHPO4-CA+HPO4 +C + DP=DPC1P*A0A22 + S0=CCA1+CH1P1+DP + S1=AMAX1(0.0,S0**2-4.0*(CCA1*CH1P1-DP*CC1P1)) + RC1P=TSLX*(S0-SQRT(S1)) +C +C CAH2PO4-CA+H2PO4 +C + DP=DPC2P/A2 + S0=CCA1+CH2P1+DP + S1=AMAX1(0.0,S0**2-4.0*(CCA1*CH2P1-DP*CC2P1)) + RC2P=TSLX*(S0-SQRT(S1)) +C +C MGHPO4-MG+HPO4 +C + DP=DPM1P*A0A22 + S0=CMG1+CH1P1+DP + S1=AMAX1(0.0,S0**2-4.0*(CMG1*CH1P1-DP*CM1P1)) + RM1P=TSLX*(S0-SQRT(S1)) + ELSE + RH1P=0.0 + RH2P=0.0 + RH3P=0.0 + RF1P=0.0 + RF2P=0.0 + RC0P=0.0 + RC1P=0.0 + RC2P=0.0 + RM1P=0.0 + ENDIF +C +C PHOSPHORUS IN BAND SOIL ZONE +C + IF(VOLWPB.GT.ZEROS(NY,NX))THEN +C +C HPO4-H+PO4 +C + DP=DPH1P*A2A13D + S0=CH0PB+CHY1+DP + S1=AMAX1(0.0,S0**2-4.0*(CH0PB*CHY1-DP*CH1PB)) + RH1B=TSLX*(S0-SQRT(S1)) +C +C H2PO4-H+HPO4 +C + DP=DPH2P/A2 + S0=CH1PB+CHY1+DP + S1=AMAX1(0.0,S0**2-4.0*(CH1PB*CHY1-DP*CH2B1)) + RH2B=TSLX*(S0-SQRT(S1)) +C +C H3PO4-H+H2PO4 +C + DP=DPH3P*A0A12 + S0=CH2B1+CHY1+DP + S1=AMAX1(0.0,S0**2-4.0*(CH2B1*CHY1-DP*CH3PB)) + RH3B=TSLX*(S0-SQRT(S1)) +C +C FEHPO4-FE+HPO4 +C + DP=DPF1P*A1A23D + S0=CFE1+CH1PB+DP + S1=AMAX1(0.0,S0**2-4.0*(CFE1*CH1PB-DP*CF1PB)) + RF1B=TSLX*(S0-SQRT(S1)) +C +C FEH2PO4-FE+H2PO4 +C + DP=DPF2P*A2A13D + S0=CFE1+CH2B1+DP + S1=AMAX1(0.0,S0**2-4.0*(CFE1*CH2B1-DP*CF2PB)) + RF2B=TSLX*(S0-SQRT(S1)) +C +C CAPO4-CA+PO4 +C + DP=DPC0P*A1A23D + S0=CCA1+CH0PB+DP + S1=AMAX1(0.0,S0**2-4.0*(CCA1*CH0PB-DP*CC0PB)) + RC0B=TSLX*(S0-SQRT(S1)) +C +C CAHPO4-CA+HPO4 +C + DP=DPC1P*A0A22 + S0=CCA1+CH1PB+DP + S1=AMAX1(0.0,S0**2-4.0*(CCA1*CH1PB-DP*CC1PB)) + RC1B=TSLX*(S0-SQRT(S1)) +C +C CAH2PO4-CA+H2PO4 +C + DP=DPC2P/A2 + S0=CCA1+CH2B1+DP + S1=AMAX1(0.0,S0**2-4.0*(CCA1*CH2B1-DP*CC2PB)) + RC2B=TSLX*(S0-SQRT(S1)) +C +C MGHPO4-MG+HPO4 +C + DP=DPM1P*A0A22 + S0=CMG1+CH1PB+DP + S1=AMAX1(0.0,S0**2-4.0*(CMG1*CH1PB-DP*CM1PB)) + RM1B=TSLX*(S0-SQRT(S1)) + ELSE + RH1B=0.0 + RH2B=0.0 + RH3B=0.0 + RF1B=0.0 + RF2B=0.0 + RC0B=0.0 + RC1B=0.0 + RC2B=0.0 + RM1B=0.0 + ENDIF +C +C TOTAL ION FLUXES FOR CURRENT ITERATION +C FROM ALL REACTIONS ABOVE +C + RN4S=RNH4-RXN4 + RN4B=RNHB-RXNB + RN3S=-RNH4 + RN3B=-RNHB + RAL=-RYAL1-RHAL1-RXAL-RALO1-RALS + 2-(RYA0P1+RHA0P1+RYA0P2+RHA0P2)*VLPO4(L,NY,NX) + 3-(RYA0B1+RHA0B1+RYA0B2+RHA0B2)*VLPOB(L,NY,NX) + RFE=-RYFE1-RHFE1-RFEO1-RFES + 2-(RYF0P1+RHF0P1+RYF0P2+RHF0P2+RF1P+RF2P)*VLPO4(L,NY,NX) + 2-(RYF0B1+RHF0B1+RYF0B2+RHF0B2+RF1B+RF2B)*VLPOB(L,NY,NX) + RHY=-RXHY-RXHC+2.0*(RHALO1+RHFEO1+RHCACO + 2+(RHA0P2+RHF0P2-RHA3P1-RHA4P2-RHF3P1-RHF4P2)*VLPO4(L,NY,NX) + 3+(RHA0B2+RHF0B2-RHA3B1-RHA4B2-RHF3B1-RHF4B2)*VLPOB(L,NY,NX)) + 4+3.0*(RHAL1+RHFE1 + 5-(RHA4P1+RHF4P1)*VLPO4(L,NY,NX) + 6-(RHF4B1+RHA4B1)*VLPOB(L,NY,NX)) + 7+4.0*(RHCAH1*VLPO4(L,NY,NX)+RHCHB1*VLPOB(L,NY,NX)) + 8+7.0*(RHCAH2*VLPO4(L,NY,NX)+RHCHB2*VLPOB(L,NY,NX)) + 9+RHALO2+RHFEO2-RHALO4-RHFEO4+RHCACH-RCO2Q-RHCO3 + 1+(RHA0P1-RHA2P1+RHA1P2-RHA3P2+RHF0P1-RHF2P1+RHF1P2-RHF3P2 + 2+RHCAD2-RXOH2-RXOH1-RHH2P-RHH1P-RH1P-RH2P-RH3P)*VLPO4(L,NY,NX) + 3+(RHA0B1-RHA2B1+RHA1B2-RHA3B2+RHF0B1-RHF2B1+RHF1B2-RHF3B2 + 4+RHCDB2-RXO2B-RXO1B-RHH2B-RHH1B-RH1B-RH2B-RH3B)*VLPOB(L,NY,NX) + 5-RNH4*VLNH4(L,NY,NX)-RNHB*VLNHB(L,NY,NX) + RCA=-RPCACX-RPCASO-RXCA-RCAO-RCAC-RCAH-RCAS + 2-(RPCADX+RPCAMX+RC0P+RC1P+RC2P)*VLPO4(L,NY,NX) + 3-(RPCDBX+RPCMBX+RC0B+RC1B+RC2B)*VLPOB(L,NY,NX) + 4-5.0*(RPCAHX*VLPO4(L,NY,NX)+RPCHBX*VLPOB(L,NY,NX)) + RMG=-RXMG-RMGO-RMGC-RMGH-RMGS + 2-RM1P*VLPO4(L,NY,NX)-RM1B*VLPOB(L,NY,NX) + RNA=-RXNA-RNAC-RNAS + RKA=-RXKA-RKAS + ROH=2.0*(-RYALO1-RYFEO1-RYCACO + 2+(RYA3P1+RYA4P2-RYA0P2+RYF3P1+RYF4P2-RYF0P2)*VLPO4(L,NY,NX) + 3+(RYA3B1+RYA4B2-RYA0B2+RYF3B1+RYF4B2-RYF0B2)*VLPOB(L,NY,NX)) + 4+3.0*(-RYAL1-RYFE1+(RYA4P1+RYF4P1)*VLPO4(L,NY,NX) + 5+(RYA4B1+RYF4B1)*VLPOB(L,NY,NX)) + 6-4.0*(RYCAH1*VLPO4(L,NY,NX)+RYCHB1*VLPOB(L,NY,NX)) + 7-7.0*(RYCAH2*VLPO4(L,NY,NX)+RYCHB2*VLPOB(L,NY,NX)) + 8+RYALO4-RYALO2+RYFEO4-RYFEO2-RYCACH-RCAO-RMGO-RALO1 + 9-RALO2-RALO3-RALO4-RFEO1-RFEO2-RFEO3-RFEO4 + 1-(RYA0P1-RYA2P1+RYA1P2-RYA3P2+RYF0P1-RYF2P1+RYF1P2-RYF3P2 + 2+RYCAD2-RYH2P-RYH1P)*VLPO4(L,NY,NX) + 3-(RYA0B1-RYA2B1+RYA1B2-RYA3B2+RYF0B1-RYF2B1+RYF1B2-RYF3B2 + 4+RYCDB2-RYH2B-RYH1B)*VLPOB(L,NY,NX) + RSO4=-RPCASO-RALS-RFES-RCAS-RMGS-RNAS-RKAS + RCO3=-RYCAC3-RHCAC3-RHCO3-RCAC-RMGC-RNAC + RHCO=-RYCACH-RHCACH-RCO2Q-RCAH-RMGH+RHCO3 + RCO2=-RHCACO-RYCACO+RCO2Q + RH2O=2.0*(-RHALO1-RHFEO1+RYCACO + 2+(RHA2P1+RYA0P2+RYA1P2+RYA2P2+RHA2P2+RYA3P2+RYA4P2 + 3+RHF2P1+RYF0P2+RYF1P2+RYF2P2+RHF2P2+RYF3P2+RYF4P2)*VLPO4(L,NY,NX) + 4+(RHA2B1+RYA0B2+RYA1B2+RYA2B2+RHA2B2+RYA3B2+RYA4B2 + 5+RHF2B1+RYF0B2+RYF1B2+RYF2B2+RHF2B2+RYF3B2+RYF4B2)*VLPOB(L,NY,NX)) + 6+3.0*(-RHAL1-RHFE1 + 7+(RHA3P1+RHA3P2+RHF3P1+RHF3P2+RYCAH1)*VLPO4(L,NY,NX) + 8+(RHA3B1+RHA3B2+RHF3B1+RHF3B2+RYCHB1)*VLPOB(L,NY,NX)) + 9+4.0*((RHA4P1+RHA4P2+RHF4P1+RHF4P2)*VLPO4(L,NY,NX) + 1+(RHA4B1+RHA4B2+RHF4B1+RHF4B2)*VLPOB(L,NY,NX)) + 2+6.0*(RYCAH2*VLPO4(L,NY,NX)+RYCHB2*VLPOB(L,NY,NX)) + 3-RHALO2-RHFEO2+RHALO4+RHFEO4+RYCACH + 4+(RYA0P1+RYA1P1+RHA1P1+RYA2P1+RYA3P1+RYA4P1+RHA1P2 + 5+RYF0P1+RYF1P1+RHF1P1+RYF2P1+RYF3P1+RYF4P1+RHF1P2 + 6+RYCAD2-RHCAH1-RHCAH2+RXH2P+RHH2P+RHH1P)*VLPO4(L,NY,NX) + 7+(RYA0B1+RYA1B1+RHA1B1+RYA2B1+RYA3B1+RYA4B1+RHA1B2 + 8+RYF0B1+RYF1B1+RHF1B1+RYF2B1+RYF3B1+RYF4B1+RHF1B2 + 9+RYCDB2-RHCHB1-RHCHB2+RXH2B+RHH2B+RHH1B)*VLPOB(L,NY,NX) + RAL1=-RYALO1-RHALO1+RALO1-RALO2 + 2-(RYA1P1+RHA1P1+RYA1P2+RHA1P2)*VLPO4(L,NY,NX) + 3-(RYA1B1+RHA1B1+RYA1B2+RHA1B2)*VLPOB(L,NY,NX) + RAL2=-RYALO2-RHALO2+RALO2-RALO3 + 2-(RYA2P1+RHA2P1+RYA2P2+RHA2P2)*VLPO4(L,NY,NX) + 3-(RYA2B1+RHA2B1+RYA2B2+RHA2B2)*VLPOB(L,NY,NX)-RXALO2 + RAL3=-RYALO3-RHALO3+RALO3-RALO4 + 2-(RYA3P1+RHA3P1+RYA3P2+RHA3P2)*VLPO4(L,NY,NX) + 3-(RYA3B1+RHA3B1+RYA3B2+RHA3B2)*VLPOB(L,NY,NX) + RAL4=-RYALO4-RHALO4+RALO4 + 2-(RYA4P1+RHA4P1+RYA4P2+RHA4P2)*VLPO4(L,NY,NX) + 3-(RYA4B1+RHA4B1+RYA4B2+RHA4B2)*VLPOB(L,NY,NX) + RFE1=-RYFEO1-RHFEO1+RFEO1-RFEO2 + 2-(RYF1P1+RHF1P1+RYF1P2+RHF1P2)*VLPO4(L,NY,NX) + 3-(RYF1B1+RHF1B1+RYF1B2+RHF1B2)*VLPOB(L,NY,NX) + RFE2=-RYFEO2-RHFEO2+RFEO2-RFEO3 + 2-(RYF2P1+RHF2P1+RYF2P2+RHF2P2)*VLPO4(L,NY,NX) + 3-(RYF2B1+RHF2B1+RYF2B2+RHF2B2)*VLPOB(L,NY,NX) + RFE3=-RYFEO3-RHFEO3+RFEO3-RFEO4 + 2-(RYF3P1+RHF3P1+RYF3P2+RHF3P2)*VLPO4(L,NY,NX) + 3-(RYF3B1+RHF3B1+RYF3B2+RHF3B2)*VLPOB(L,NY,NX) + RFE4=-RYFEO4-RHFEO4+RFEO4 + 2-(RYF4P1+RHF4P1+RYF4P2+RHF4P2)*VLPO4(L,NY,NX) + 3-(RYF4B1+RHF4B1+RYF4B2+RHF4B2)*VLPOB(L,NY,NX) + RHP0=-RH1P-RC0P + RHP1=-RYA0P1-RHA0P1-RYA1P1-RHA1P1-RYA2P1-RHA2P1-RYA3P1-RHA3P1 + 2-RYA4P1-RHA4P1-RYF0P1-RHF0P1-RYF1P1-RHF1P1-RYF2P1-RHF2P1-RYF3P1 + 3-RHF3P1-RYF4P1-RHF4P1-RPCAD1-3.0*(RYCAH1+RHCAH1)-RYH1P-RHH1P + 4+RH1P-RH2P-RF1P-RC1P-RM1P + RHP2=-RYA0P2-RHA0P2-RYA1P2-RHA1P2-RYA2P2-RHA2P2-RYA3P2-RHA3P2 + 2-RYA4P2-RHA4P2-RYF0P2-RHF0P2-RYF1P2-RHF1P2-RYF2P2-RHF2P2-RYF3P2 + 3-RHF3P2-RYF4P2-RHF4P2-RHCAD2-RYCAD2-3.0*(RYCAH2+RHCAH2) + 4-2.0*RPCAMX-RXH2P-RYH2P-RHH2P+RH2P-RH3P-RF2P-RC2P + RHP3=RH3P + RXH0=-RXOH1 + RXH1=RXOH1-RXOH2-RYH2P-RYH1P-RHH2P-RHH1P + RXH2=RXOH2-RXH2P + RX1P=RYH1P+RHH1P + RX2P=RXH2P+RYH2P+RHH2P +C IF(NY.EQ.5.AND.L.EQ.10)THEN +C WRITE(*,23)'HP2',I,J,NX,NY,L,M,RHP2,RYA0P2,RHA0P2,RYA1P2,RHA1P2 +C 2,RYA2P2,RHA2P2,RYA3P2,RHA3P2,RYA4P2,RHA4P2,RYF0P2,RHF0P2,RYF1P2 +C 3,RHF1P2,RYF2P2,RHF2P2,RYF3P2,RHF3P2,RYF4P2,RHF4P2,RHCAD2,RYCAD2 +C 4,RYCAH2,RHCAH2,RPCAMX,RXH2P,RYH2P,RHH2P,RH2P,RH3P,RF2P,RC2P +23 FORMAT(A8,6I4,60E12.4) +C ENDIF + RHB0=-RH1B-RC0B + RHB1=-RYA0B1-RHA0B1-RYA1B1-RHA1B1-RYA2B1-RHA2B1-RYA3B1-RHA3B1 + 2-RYA4B1-RHA4B1-RYF0B1-RHF0B1-RYF1B1-RHF1B1-RYF2B1-RHF2B1-RYF3B1 + 3-RHF3B1-RYF4B1-RHF4B1-RPCDB1-3.0*(RYCHB1+RHCHB1)-RYH1B-RHH1B + 4+RH1B-RH2B-RF1B-RC1B-RM1B + RHB2=-RYA0B2-RHA0B2-RYA1B2-RHA1B2-RYA2B2-RHA2B2-RYA3B2-RHA3B2 + 2-RYA4B2-RHA4B2-RYF0B2-RHF0B2-RYF1B2-RHF1B2-RYF2B2-RHF2B2-RYF3B2 + 3-RHF3B2-RYF4B2-RHF4B2-RHCDB2-RYCDB2-3.0*(RYCHB2+RHCHB2) + 4-2.0*RPCMBX-RXH2B-RYH2B-RHH2B+RH2B-RH3B-RF2B-RC2B + RHB3=RH3B + RBH0=-RXO1B + RBH1=RXO1B-RXO2B-RYH2B-RYH1B-RHH2B-RHH1B + RBH2=RXO2B-RXH2B + RB1P=RYH1B+RHH1B + RB2P=RXH2B+RYH2B+RHH2B + BNH4=-RXN4*VLNH4(L,NY,NX)-RXNB*VLNHB(L,NY,NX) + BH2P=RHP2*VLPO4(L,NY,NX)+RHB2*VLPOB(L,NY,NX) + BION=RNH4*VLNH4(L,NY,NX)+RNHB*VLNHB(L,NY,NX) +C +C UPDATE ION CONCENTRATIONS FOR CURRENT ITERATION +C FROM TOTAL ION FLUXES +C + CN41=CN41+RN4S + CN4B=CN4B+RN4B + CN31=CN31+RN3S + CN3B=CN3B+RN3B + CAL1=CAL1+RAL + CFE1=CFE1+RFE + CHY1=CHY1+RHY + CCA1=CCA1+RCA + CMG1=CMG1+RMG + CNA1=CNA1+RNA + CKA1=CKA1+RKA + COH1=COH1+ROH + CSO41=CSO41+RSO4 + CCO31=CCO31+RCO3 + CHCO31=CHCO31+RHCO + CCO21=CCO21+RCO2 + CALO1=CALO1+RAL1 + CALO2=CALO2+RAL2 + CALO3=CALO3+RAL3 + CALO4=CALO4+RAL4 + CALS1=CALS1+RALS + CFEO1=CFEO1+RFE1 + CFEO2=CFEO2+RFE2 + CFEO3=CFEO3+RFE3 + CFEO4=CFEO4+RFE4 + CFES1=CFES1+RFES + CCAO1=CCAO1+RCAO + CCAC1=CCAC1+RCAC + CCAH1=CCAH1+RCAH + CCAS1=CCAS1+RCAS + CMGO1=CMGO1+RMGO + CMGC1=CMGC1+RMGC + CMGH1=CMGH1+RMGH + CMGS1=CMGS1+RMGS + CNAC1=CNAC1+RNAC + CNAS1=CNAS1+RNAS + CKAS1=CKAS1+RKAS + CH0P1=CH0P1+RHP0 + CH1P1=CH1P1+RHP1 + CH2P1=CH2P1+RHP2 + CH3P1=CH3P1+RHP3 + CF1P1=CF1P1+RF1P + CF2P1=CF2P1+RF2P + CC0P1=CC0P1+RC0P + CC1P1=CC1P1+RC1P + CC2P1=CC2P1+RC2P + CM1P1=CM1P1+RM1P + CH0PB=CH0PB+RHB0 + CH1PB=CH1PB+RHB1 + CH2B1=CH2B1+RHB2 + CH3PB=CH3PB+RHB3 + CF1PB=CF1PB+RF1B + CF2PB=CF2PB+RF2B + CC0PB=CC0PB+RC0B + CC1PB=CC1PB+RC1B + CC2PB=CC2PB+RC2B + CM1PB=CM1PB+RM1B +C +C REQUILIBRATE H2O-H+OH +C + CHY2=AMAX1(ZERO,CHY1) + COH2=AMAX1(ZERO,COH1) + DP=DPH2O/A1**2 + S0=CHY2+COH2 + S1=AMAX1(0.0,S0**2-4.0*(CHY2*COH2-DP)) + RHOH=0.5*(S0-SQRT(S1)) + RHY=RHY-RHOH + ROH=ROH-RHOH + RH2O=RH2O+RHOH + CHY1=CHY1-RHOH + COH1=COH1-RHOH +C IF((I/10)*10.EQ.I.AND.J.EQ.12.AND.L.LE.3)THEN +C WRITE(*,1111)'CCA1',I,J,L,M,CCA1,CHY1,CH1P1,CH2P1,SPCAD/A22,SPCAD2/A2 +C 2,RCA,RPCACX,RPCASO,RPCADX,RPCDBX,5.0*(RPCAHX+RPCHBX),RPCAMX +C 2,RPCMBX,RXCA,RCAO,RCAC,RCAH,RCAS,RC0P,RC1P,RC2P,RC0B,RC1B,RC2B +C WRITE(*,1111)'CAL1',I,J,L,M,CAL1,CAL1*A3 +C 2,RAL,RYAL1,RYA0P1,RYA0P2,RYA0B1,RYA0B2,RXAL,RALO1,RALS +C 3,CSO41,CALS1,DPALS,A1A23D +C WRITE(*,1111)'CFEO2',I,J,L,M,CFEO2,CFEO2*A1 +C 2,RFE2,RYFEO2,RHFEO2,RYF2P1,RHF2P1,RYF2P2,RHF2P2,RYF2B1,RHF2B1 +C 2,RYF2B2,RHF2B2,RFEO2,RFEO3 +C WRITE(*,1112)'CHY1',I,J,L,M,CHY1,COH1,CHY1*A1,CHYX,COHX,RHOH,RHY1 +C 2,RHY,RXHY,RXHC,RHALO1,RHFEO1,RHCACO,RHA0P2,RHA0B2,RHF0P2,RHF0B2 +C 2,RHA3P1,RHA4P2,RHA3B1,RHA4B2,RHF3P1,RHF4P2,RHF3B1,RHF4B2 +C 3,RHAL1,RHFE1,RHA4P1,RHA4B1,RHF4P1,RHF4B1,RHCAH1 +C 4,RHCHB1,RHCAH2,RHCHB2,RHALO2,RHFEO2,RHALO4,RHFEO4 +C 5,RHCACH,RHA0P1,RHA2P1,RHA1P2,RHA3P2,RHA0B1,RHA2B1,RHA1B2 +C 6,RHA3B2,RHF0P1,RHF2P1,RHF1P2,RHF3P2,RHF0B1,RHF2B1,RHF1B2 +C 7,RHF3B2,RHCAD2,RHCDB2,RXOH2,RXOH1,RXO2B,RXO1B,RHH2P,RHH2B +C 8,RHH1P,RHH1B,RCO2Q,RHCO3,RNH4,RNHB,RH1P,RH2P,RH3P,RH1B,RH2B +C 9,RH3B,(CHY2-RHOH)*(COH2-RHOH),DP +C ENDIF +C WRITE(*,1111)'COH1',I,J,L,M,COH1,COH1*A1 +C 2,ROH,RHOH,RYH2P,RYH2B,RYH1P,RYH1B,RPALPX,RYFEPX,RCAO,RMGO +C 2,RPCAHX,RALO1,RALO2,RALO3,RALO4,RFEO1,RFEO2,RFEO3,RFEO4 +1111 FORMAT(A8,4I4,80E12.4) +C +C UPDATE EXCHANGEABLE ION CONCENTRATIONS IN CURRENT +C ITERATION FROM TOTAL ION FLUXES +C + XN41=XN41+RXN4 + XN4B=XN4B+RXNB + XHY1=XHY1+RXHY + XAL1=XAL1+RXAL + XCA1=XCA1+RXCA + XMG1=XMG1+RXMG + XNA1=XNA1+RXNA + XKA1=XKA1+RXKA + XHC1=XHC1+RXHC + XALO21=XALO21+RXALO2 + XOH01=XOH01+RXH0 + XOH11=XOH11+RXH1 + XOH21=XOH21+RXH2 + XH1P1=XH1P1+RX1P + XH2P1=XH2P1+RX2P + XH01B=XH01B+RBH0 + XH11B=XH11B+RBH1 + XH21B=XH21B+RBH2 + X1P1B=X1P1B+RB1P + X2P1B=X2P1B+RB2P +C +C UPDATE PRECIPITATE CONCENTRATIONS IN CURRENT +C ITERATION FROM TOTAL ION FLUXES +C + PALOH1=PALOH1+RPALOX + PFEOH1=PFEOH1+RPFEOX + PCACO1=PCACO1+RPCACX + PCASO1=PCASO1+RPCASO + PALPO1=PALPO1+RPALPX + PFEPO1=PFEPO1+RPFEPX + PCAPD1=PCAPD1+RPCADX + PCAPH1=PCAPH1+RPCAHX + PCAPM1=PCAPM1+RPCAMX + PALPOB=PALPOB+RPALBX + PFEPOB=PFEPOB+RPFEBX + PCAPDB=PCAPDB+RPCDBX + PCAPHB=PCAPHB+RPCHBX + PCAPMB=PCAPMB+RPCMBX +C +C ACCUMULATE TOTAL ION FLUXES FOR ALL ITERATIONS +C + TRN4S(L,NY,NX)=TRN4S(L,NY,NX)+RN4S + TRN4B(L,NY,NX)=TRN4B(L,NY,NX)+RN4B + TRN3S(L,NY,NX)=TRN3S(L,NY,NX)+RN3S + TRN3B(L,NY,NX)=TRN3B(L,NY,NX)+RN3B + TRAL(L,NY,NX)=TRAL(L,NY,NX)+RAL + TRFE(L,NY,NX)=TRFE(L,NY,NX)+RFE + TRHY(L,NY,NX)=TRHY(L,NY,NX)+RHY + TRCA(L,NY,NX)=TRCA(L,NY,NX)+RCA + TRMG(L,NY,NX)=TRMG(L,NY,NX)+RMG + TRNA(L,NY,NX)=TRNA(L,NY,NX)+RNA + TRKA(L,NY,NX)=TRKA(L,NY,NX)+RKA + TROH(L,NY,NX)=TROH(L,NY,NX)+ROH + TRSO4(L,NY,NX)=TRSO4(L,NY,NX)+RSO4 + TRCO3(L,NY,NX)=TRCO3(L,NY,NX)+RCO3 + TRHCO(L,NY,NX)=TRHCO(L,NY,NX)+RHCO + TBCO2(L,NY,NX)=TBCO2(L,NY,NX)+RCO2 + TRH2O(L,NY,NX)=TRH2O(L,NY,NX)+RH2O + TRAL1(L,NY,NX)=TRAL1(L,NY,NX)+RAL1 + TRAL2(L,NY,NX)=TRAL2(L,NY,NX)+RAL2 + TRAL3(L,NY,NX)=TRAL3(L,NY,NX)+RAL3 + TRAL4(L,NY,NX)=TRAL4(L,NY,NX)+RAL4 + TRALS(L,NY,NX)=TRALS(L,NY,NX)+RALS + TRFE1(L,NY,NX)=TRFE1(L,NY,NX)+RFE1 + TRFE2(L,NY,NX)=TRFE2(L,NY,NX)+RFE2 + TRFE3(L,NY,NX)=TRFE3(L,NY,NX)+RFE3 + TRFE4(L,NY,NX)=TRFE4(L,NY,NX)+RFE4 + TRFES(L,NY,NX)=TRFES(L,NY,NX)+RFES + TRCAO(L,NY,NX)=TRCAO(L,NY,NX)+RCAO + TRCAC(L,NY,NX)=TRCAC(L,NY,NX)+RCAC + TRCAH(L,NY,NX)=TRCAH(L,NY,NX)+RCAH + TRCAS(L,NY,NX)=TRCAS(L,NY,NX)+RCAS + TRMGO(L,NY,NX)=TRMGO(L,NY,NX)+RMGO + TRMGC(L,NY,NX)=TRMGC(L,NY,NX)+RMGC + TRMGH(L,NY,NX)=TRMGH(L,NY,NX)+RMGH + TRMGS(L,NY,NX)=TRMGS(L,NY,NX)+RMGS + TRNAC(L,NY,NX)=TRNAC(L,NY,NX)+RNAC + TRNAS(L,NY,NX)=TRNAS(L,NY,NX)+RNAS + TRKAS(L,NY,NX)=TRKAS(L,NY,NX)+RKAS + TRH0P(L,NY,NX)=TRH0P(L,NY,NX)+RHP0 + TRH1P(L,NY,NX)=TRH1P(L,NY,NX)+RHP1 + TRH2P(L,NY,NX)=TRH2P(L,NY,NX)+RHP2 + TRH3P(L,NY,NX)=TRH3P(L,NY,NX)+RHP3 + TRF1P(L,NY,NX)=TRF1P(L,NY,NX)+RF1P + TRF2P(L,NY,NX)=TRF2P(L,NY,NX)+RF2P + TRC0P(L,NY,NX)=TRC0P(L,NY,NX)+RC0P + TRC1P(L,NY,NX)=TRC1P(L,NY,NX)+RC1P + TRC2P(L,NY,NX)=TRC2P(L,NY,NX)+RC2P + TRM1P(L,NY,NX)=TRM1P(L,NY,NX)+RM1P + TRH0B(L,NY,NX)=TRH0B(L,NY,NX)+RHB0 + TRH1B(L,NY,NX)=TRH1B(L,NY,NX)+RHB1 + TRH2B(L,NY,NX)=TRH2B(L,NY,NX)+RHB2 + TRH3B(L,NY,NX)=TRH3B(L,NY,NX)+RHB3 + TRF1B(L,NY,NX)=TRF1B(L,NY,NX)+RF1B + TRF2B(L,NY,NX)=TRF2B(L,NY,NX)+RF2B + TRC0B(L,NY,NX)=TRC0B(L,NY,NX)+RC0B + TRC1B(L,NY,NX)=TRC1B(L,NY,NX)+RC1B + TRC2B(L,NY,NX)=TRC2B(L,NY,NX)+RC2B + TRM1B(L,NY,NX)=TRM1B(L,NY,NX)+RM1B + TRXN4(L,NY,NX)=TRXN4(L,NY,NX)+RXN4 + TRXNB(L,NY,NX)=TRXNB(L,NY,NX)+RXNB + TRXHY(L,NY,NX)=TRXHY(L,NY,NX)+RXHY + TRXAL(L,NY,NX)=TRXAL(L,NY,NX)+RXAL + TRXCA(L,NY,NX)=TRXCA(L,NY,NX)+RXCA + TRXMG(L,NY,NX)=TRXMG(L,NY,NX)+RXMG + TRXNA(L,NY,NX)=TRXNA(L,NY,NX)+RXNA + TRXKA(L,NY,NX)=TRXKA(L,NY,NX)+RXKA + TRXHC(L,NY,NX)=TRXHC(L,NY,NX)+RXHC + TRXAL2(L,NY,NX)=TRXAL2(L,NY,NX)+RXALO2 + TRXH0(L,NY,NX)=TRXH0(L,NY,NX)+RXH0 + TRXH1(L,NY,NX)=TRXH1(L,NY,NX)+RXH1 + TRXH2(L,NY,NX)=TRXH2(L,NY,NX)+RXH2 + TRX1P(L,NY,NX)=TRX1P(L,NY,NX)+RX1P + TRX2P(L,NY,NX)=TRX2P(L,NY,NX)+RX2P + TRBH0(L,NY,NX)=TRBH0(L,NY,NX)+RBH0 + TRBH1(L,NY,NX)=TRBH1(L,NY,NX)+RBH1 + TRBH2(L,NY,NX)=TRBH2(L,NY,NX)+RBH2 + TRB1P(L,NY,NX)=TRB1P(L,NY,NX)+RB1P + TRB2P(L,NY,NX)=TRB2P(L,NY,NX)+RB2P + TRALOH(L,NY,NX)=TRALOH(L,NY,NX)+RPALOX + TRFEOH(L,NY,NX)=TRFEOH(L,NY,NX)+RPFEOX + TRCACO(L,NY,NX)=TRCACO(L,NY,NX)+RPCACX + TRCASO(L,NY,NX)=TRCASO(L,NY,NX)+RPCASO + TRALPO(L,NY,NX)=TRALPO(L,NY,NX)+RPALPX + TRFEPO(L,NY,NX)=TRFEPO(L,NY,NX)+RPFEPX + TRCAPD(L,NY,NX)=TRCAPD(L,NY,NX)+RPCADX + TRCAPH(L,NY,NX)=TRCAPH(L,NY,NX)+RPCAHX + TRCAPM(L,NY,NX)=TRCAPM(L,NY,NX)+RPCAMX + TRALPB(L,NY,NX)=TRALPB(L,NY,NX)+RPALBX + TRFEPB(L,NY,NX)=TRFEPB(L,NY,NX)+RPFEBX + TRCPDB(L,NY,NX)=TRCPDB(L,NY,NX)+RPCDBX + TRCPHB(L,NY,NX)=TRCPHB(L,NY,NX)+RPCHBX + TRCPMB(L,NY,NX)=TRCPMB(L,NY,NX)+RPCMBX + TBNH4(L,NY,NX)=TBNH4(L,NY,NX)+BNH4 + TBH2P(L,NY,NX)=TBH2P(L,NY,NX)+BH2P + TBION(L,NY,NX)=TBION(L,NY,NX)+BION +C +C GO TO NEXT ITERATION +C +1000 CONTINUE +C +C ITERATIONS COMPLETED +C +C IF(J.EQ.24)THEN +C WRITE(*,1119)'GAPON',I,J,L,M,CH0P1,CAL1,CFE1,CH0P1*A3*CAL1*A3 +C 2,SPALP,CH0P1*A3*CFE1*A3,SPFEP +C 6,SPOH2,XOH11*CHY1*A1/XOH21,SPOH1,XOH01*CHY1*A1/XOH11 +C 7,SPH2P,XOH21*CH2P1*A1/XH2P1,SYH2P,XOH11*CH2P1/(XH2P1*COH1) +C 8,SYH1P,XOH11*CH1P1*A2/(XH1P1*COH1*A1) +C 9,COH1*A1,CHY1*A1 +1119 FORMAT(A8,4I4,24E11.3) +C WRITE(*,1119)'CATION',I,J,L,M,CCEC,XN41+XHY1+3*XAL1+2*(XCA1+XMG1) +C 2+XNA1+XKA1,XN41,XHY1,XAL1,XCA1,XMG1,XNA1,XKA1,CN41,CHY1,CAL1,CCA1 +C 2,CMG1,CNA1,CKA1,(CCA1*A2)**0.5*XN41/(CN41*A1*XCA1*2) +C 3,(CCA1*A2)**0.5*XHY1/(CHY1*A1*XCA1*2) +C 2,(CCA1*A2)**0.5*XAL1*3/((CAL1*A3)**0.333*XCA1*2) +C 3,(CCA1*A2)**0.5*XMG1*2/((CMG1*A2)**0.5*XCA1*2) +C 3,(CCA1*A2)**0.5*XNA1/(CNA1*A1*XCA1*2) +C 5,(CCA1*A2)**0.5*XKA1/(CKA1*A1*XCA1*2) +C 6,CHY1*A1*XCOO/XHC1,CALO2*A1*XCOO/XALO21 +C ENDIF +C +C CONVERT TOTAL ION FLUXES FROM CHANGES IN CONCENTRATION +C TO CHANGES IN MASS PER UNIT AREA FOR USE IN 'REDIST' +C + TRN4S(L,NY,NX)=TRN4S(L,NY,NX)*VOLWNH + TRN4B(L,NY,NX)=TRN4B(L,NY,NX)*VOLWNB + TRN3S(L,NY,NX)=TRN3S(L,NY,NX)*VOLWNH + TRN3B(L,NY,NX)=TRN3B(L,NY,NX)*VOLWNB + TRAL(L,NY,NX)=TRAL(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRFE(L,NY,NX)=TRFE(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRHY(L,NY,NX)=TRHY(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRCA(L,NY,NX)=TRCA(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRMG(L,NY,NX)=TRMG(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRNA(L,NY,NX)=TRNA(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRKA(L,NY,NX)=TRKA(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TROH(L,NY,NX)=TROH(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRSO4(L,NY,NX)=TRSO4(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRCO3(L,NY,NX)=TRCO3(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRHCO(L,NY,NX)=TRHCO(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TBCO2(L,NY,NX)=TBCO2(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRH2O(L,NY,NX)=TRH2O(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRAL1(L,NY,NX)=TRAL1(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRAL2(L,NY,NX)=TRAL2(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRAL3(L,NY,NX)=TRAL3(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRAL4(L,NY,NX)=TRAL4(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRALS(L,NY,NX)=TRALS(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRFE1(L,NY,NX)=TRFE1(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRFE2(L,NY,NX)=TRFE2(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRFE3(L,NY,NX)=TRFE3(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRFE4(L,NY,NX)=TRFE4(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRFES(L,NY,NX)=TRFES(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRCAO(L,NY,NX)=TRCAO(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRCAC(L,NY,NX)=TRCAC(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRCAH(L,NY,NX)=TRCAH(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRCAS(L,NY,NX)=TRCAS(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRMGO(L,NY,NX)=TRMGO(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRMGC(L,NY,NX)=TRMGC(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRMGH(L,NY,NX)=TRMGH(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRMGS(L,NY,NX)=TRMGS(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRNAC(L,NY,NX)=TRNAC(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRNAS(L,NY,NX)=TRNAS(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRKAS(L,NY,NX)=TRKAS(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRH0P(L,NY,NX)=TRH0P(L,NY,NX)*VOLWPO + TRH1P(L,NY,NX)=TRH1P(L,NY,NX)*VOLWPO + TRH2P(L,NY,NX)=TRH2P(L,NY,NX)*VOLWPO + TRH3P(L,NY,NX)=TRH3P(L,NY,NX)*VOLWPO + TRF1P(L,NY,NX)=TRF1P(L,NY,NX)*VOLWPO + TRF2P(L,NY,NX)=TRF2P(L,NY,NX)*VOLWPO + TRC0P(L,NY,NX)=TRC0P(L,NY,NX)*VOLWPO + TRC1P(L,NY,NX)=TRC1P(L,NY,NX)*VOLWPO + TRC2P(L,NY,NX)=TRC2P(L,NY,NX)*VOLWPO + TRM1P(L,NY,NX)=TRM1P(L,NY,NX)*VOLWPO + TRH0B(L,NY,NX)=TRH0B(L,NY,NX)*VOLWPB + TRH1B(L,NY,NX)=TRH1B(L,NY,NX)*VOLWPB + TRH2B(L,NY,NX)=TRH2B(L,NY,NX)*VOLWPB + TRH3B(L,NY,NX)=TRH3B(L,NY,NX)*VOLWPB + TRF1B(L,NY,NX)=TRF1B(L,NY,NX)*VOLWPB + TRF2B(L,NY,NX)=TRF2B(L,NY,NX)*VOLWPB + TRC0B(L,NY,NX)=TRC0B(L,NY,NX)*VOLWPB + TRC1B(L,NY,NX)=TRC1B(L,NY,NX)*VOLWPB + TRC2B(L,NY,NX)=TRC2B(L,NY,NX)*VOLWPB + TRM1B(L,NY,NX)=TRM1B(L,NY,NX)*VOLWPB + TRXN4(L,NY,NX)=TRXN4(L,NY,NX)*VOLWNH + TRXNB(L,NY,NX)=TRXNB(L,NY,NX)*VOLWNB + TRXHY(L,NY,NX)=TRXHY(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRXAL(L,NY,NX)=TRXAL(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRXCA(L,NY,NX)=TRXCA(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRXMG(L,NY,NX)=TRXMG(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRXNA(L,NY,NX)=TRXNA(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRXKA(L,NY,NX)=TRXKA(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRXHC(L,NY,NX)=TRXHC(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRXAL2(L,NY,NX)=TRXAL2(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRXH0(L,NY,NX)=TRXH0(L,NY,NX)*VOLWPO + TRXH1(L,NY,NX)=TRXH1(L,NY,NX)*VOLWPO + TRXH2(L,NY,NX)=TRXH2(L,NY,NX)*VOLWPO + TRX1P(L,NY,NX)=TRX1P(L,NY,NX)*VOLWPO + TRX2P(L,NY,NX)=TRX2P(L,NY,NX)*VOLWPO + TRBH0(L,NY,NX)=TRBH0(L,NY,NX)*VOLWPB + TRBH1(L,NY,NX)=TRBH1(L,NY,NX)*VOLWPB + TRBH2(L,NY,NX)=TRBH2(L,NY,NX)*VOLWPB + TRB1P(L,NY,NX)=TRB1P(L,NY,NX)*VOLWPB + TRB2P(L,NY,NX)=TRB2P(L,NY,NX)*VOLWPB + TRALOH(L,NY,NX)=TRALOH(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRFEOH(L,NY,NX)=TRFEOH(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRCACO(L,NY,NX)=TRCACO(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRCASO(L,NY,NX)=TRCASO(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRALPO(L,NY,NX)=TRALPO(L,NY,NX)*VOLWPO + TRFEPO(L,NY,NX)=TRFEPO(L,NY,NX)*VOLWPO + TRCAPD(L,NY,NX)=TRCAPD(L,NY,NX)*VOLWPO + TRCAPH(L,NY,NX)=TRCAPH(L,NY,NX)*VOLWPO + TRCAPM(L,NY,NX)=TRCAPM(L,NY,NX)*VOLWPO + TRALPB(L,NY,NX)=TRALPB(L,NY,NX)*VOLWPB + TRFEPB(L,NY,NX)=TRFEPB(L,NY,NX)*VOLWPB + TRCPDB(L,NY,NX)=TRCPDB(L,NY,NX)*VOLWPB + TRCPHB(L,NY,NX)=TRCPHB(L,NY,NX)*VOLWPB + TRCPMB(L,NY,NX)=TRCPMB(L,NY,NX)*VOLWPB + TBNH4(L,NY,NX)=TBNH4(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TBH2P(L,NY,NX)=TBH2P(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TBION(L,NY,NX)=TBION(L,NY,NX)*VOLWM(NPH,L,NY,NX) +C +C IF NO SALTS IS SELECTED IN SITE FILE THEN A SUBSET +C OF THE EQUILIBRIA REACTIONS ARE SOLVED: MOSTLY THOSE +C FOR PHOSPHORUS +C + ELSE +C +C PRECIPITATION-DISSOLUTION CALCULATED FROM ACTIVITIES +C OF REACTANTS AND PRODUCTS THROUGH SOLUTIONS +C FOR THEIR EQUILIBRIUM CONSTANTS USING CURRENT +C ION CONCENTRATION +C + CCEC=AMAX1(ZERO,XCEC(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CHY1=AMAX1(ZERO,10.0**(-(PH(L,NY,NX)-3.0))) + COH1=AMAX1(ZERO,DPH2O/CHY1) + IF(CAL(L,NY,NX).LT.0.0)THEN + CAL1=AMAX1(ZERO,SYALO/COH1**3) + ELSE + CAL1=AMAX1(ZERO,AMIN1(CAL(L,NY,NX),SYALO/COH1**3)) + ENDIF + IF(CFE(L,NY,NX).LT.0.0)THEN + CFE1=AMAX1(ZERO,SYFEO/COH1**3) + ELSE + CFE1=AMAX1(ZERO,AMIN1(CFE(L,NY,NX),SYFEO/COH1**3)) + ENDIF + CMG1=AMAX1(0.0,ZMG(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CNA1=AMAX1(0.0,ZNA(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CKA1=AMAX1(0.0,ZKA(L,NY,NX)/VOLWM(NPH,L,NY,NX)) +C +C CA CONCENTRATION FROM CURRENT CO2 CONCENTRATION +C + CCO21=AMAX1(ZERO,CCO2S(L,NY,NX)/12.0) + CCO31=AMAX1(ZERO,CCO21*DPCO3/CHY1**2) + IF(CCA(L,NY,NX).LT.0.0)THEN + CCA1=AMAX1(ZERO,AMIN1(CCAMX,SPCAC/CCO31)) + ELSE + CCA1=AMAX1(ZERO,AMIN1(CCA(L,NY,NX),SPCAC/CCO31)) + ENDIF +C +C PHOSPHORUS TRANSFORMATIONS IN NON-BAND SOIL ZONE +C + IF(VOLWPO.GT.ZEROS(NY,NX))THEN +C +C ALUMINUM PHOSPHATE (VARISCITE) +C + CH2PA=SYA0P2/(CAL1*COH1**2) + RPALPX=AMAX1(-PALPO1,TPD*(CH2P1-CH2PA)) +C +C IRON PHOSPHATE (STRENGITE) +C + CH2PF=SYF0P2/(CFE1*COH1**2) + RPFEPX=AMAX1(-PFEPO1,TPD*(CH2P1-CH2PF)) +C IF(I.EQ.180.AND.J.EQ.12)THEN +C WRITE(*,1117)'RPFEPX',I,J,L,CH2PA,SYA0P2,CAL1,COH1,PALPO1 +C 2,CH2P1,CH2PF,SYF0P2,CFE1,COH1,PFEPO1,CH2P1,RPALPX,RPFEPX +C 3,CAL(L,NY,NX),CFE(L,NY,NX) +C ENDIF +C +C DICALCIUM PHOSPHATE +C + CH2PD=SYCAD2/(CCA1*COH1) + RPCADX=AMAX1(-PCAPD1,TPD*(CH2P1-CH2PD)) +C +C HYDROXYAPATITE +C + CH2PH=(SYCAH2/(CCA1**5*COH1**7))**0.333 + RPCAHX=AMAX1(-PCAPH1,TPD*(CH2P1-CH2PH)) +C +C MONOCALCIUM PHOSPHATE +C + CH2PM=SQRT(SPCAM/CCA1) + RPCAMX=AMAX1(-PCAPM1*SPPO4,TPD*(CH2P1-CH2PM)) +C IF(I.GT.315)THEN +C WRITE(*,1117)'RPPO4',I,J,L,RPCADX,CH2P1,CH2PD,PCAPD1,RPCAHX +C 2,CH2PA,CH2PH,SYA0P2,CAL1,COH1,SYCAH2,CCA1,CCO21,CCO31,PCAPH1 +C 3,VOLWPO,SPCAC/CCO31,CCA(L,NY,NX),H2PO4(L,NY,NX) +C 4,VOLWM(NPH,L,NY,NX),ZCA(L,NY,NX),CCO2S(L,NY,NX) +1117 FORMAT(A8,3I4,30E12.4) +C ENDIF +C +C PHOSPHORUS ANION EXCHANGE IN NON-BAND SOIL ZONE +C CALCULATED FROM EXCHANGE EQUILIBRIA AMONG H2PO4-, +C HPO4--, H+, OH- AND PROTONATED AND NON-PROTONATED -OH +C EXCHANGE SITES +C + IF(AEC(L,NY,NX).GT.0.0)THEN +C +C PROTONATION OF ANION EXCHANGE SITES IN NON-BAND SOIL ZONE +C + DCHG=AMAX1(-1.0E+02,XOH21-XOH01-XH1P1) + AEP=EXP(AE*DCHG/TKS(L,NY,NX)) + AEN=EXP(-AE*DCHG/TKS(L,NY,NX)) +C +C H2PO4 EXCHANGE IN NON-BAND SOIL ZONE FROM CONVERGENCE +C SOLUTION FOR EQUILIBRIUM AMONG H2PO4-, H+, OH-, X-OH +C AND X-H2PO4 +C + SPH2P=SYH2P*DPH2O/(SXOH2*AEP) + X0=XOH21+CH2P1+SPH2P + X1=AMAX1(0.0,X0**2-4.0*(XOH21*CH2P1-SPH2P*XH2P1)) + RXH2P=TADA*(X0-SQRT(X1)) + X0=XOH11+CH2P1+SYH2P*COH1 + X1=AMAX1(0.0,X0**2-4.0*(XOH11*CH2P1-SYH2P*COH1*XH2P1)) + RYH2P=TADA*(X0-SQRT(X1)) +C +C HPO4 EXCHANGE IN NON-BAND SOIL ZONE FROM CONVERGENCE +C SOLUTION FOR EQUILIBRIUM AMONG HPO4--, H+, OH-, X-OH +C AND X-HPO4 +C + SPH1P=SYH1P*DPH2O*AEN/DPH2P + X0=XOH11+CH2P1+SPH1P + X1=AMAX1(0.0,X0**2-4.0*(XOH11*CH2P1-SPH1P*XH1P1)) + RXH1P=TADA*(X0-SQRT(X1)) +C WRITE(*,1116)'RXH2P',I,J,NX,NY,L,RXH2P +C 2,XOH21,CH2P1,XH2P1,XOH21*(CH2P1-RXH2P)/(XH2P1+RXH2P),SPH2P +C 3,H2PO4(L,NY,NX),RH2PX,VOLWPO,AEP +C WRITE(*,1116)'RYH2P',I,J,NX,NY,L,RYH2P +C 2,XOH11,CH2P1,XH2P1,COH1,(XOH11*(CH2P1-RYH2P)) +C 3/((XH2P1+RYH2P)*COH1),SYH2P +C WRITE(*,1116)'RXH1P',I,J,NX,NY,L,RXH1P,X0,X1 +C 2,XOH11,CH2P1,XH1P1,XOH11*(CH2P1-RXH1P)/(XH1P1+RXH1P),SPH1P +C 3,SYH1P,DPH2O,AEN,DPH2P,XOH1(L,NY,NX),VLPO4(L,NY,NX),VLPOB(L,NY,NX) +C 4,AE,DCHG,TKS(L,NY,NX),XOH21,XOH01 +1116 FORMAT(A8,5I4,40E12.4) + ELSE + RXH2P=0.0 + RYH2P=0.0 + RXH1P=0.0 + ENDIF + ELSE + RPALPX=0.0 + RPFEPX=0.0 + RPCADX=0.0 + RPCAHX=0.0 + RPCAMX=0.0 + RXH2P=0.0 + RYH2P=0.0 + RXH1P=0.0 + ENDIF +C IF(J.EQ.1)THEN +C WRITE(*,2222)'PO4',I,J,L,CH2P1,PALPO1,PFEPO1,PCAPD1,PCAPH1,PCAPM1 +C 2,CH2PA,CH2PF,CH2PD,CH2PH,CH2PM,RPALPX,RPFEPX,RPCADX,RPCAHX,RPCAMX +C 3,XH2P1,RXH2P,RYH2P +C 3,CAL1,CFE1,CCA1,CHY1,COH1 +2222 FORMAT(A8,3I4,40E12.4) +C ENDIF +C +C PHOSPHORUS PRECIPITATION-DISSOLUTION IN BAND SOIL ZONE +C + IF(VOLWPB.GT.ZEROS(NY,NX))THEN +C +C ALUMINUM PHOSPHATE (VARISCITE) +C + CH2PA=SYA0P2/(CAL1*COH1**2) + RPALBX=AMAX1(-PALPOB,TPD*(CH2B1-CH2PA)) +C +C IRON PHOSPHATE (STRENGITE) +C + CH2PF=SYF0P2/(CFE1*COH1**2) + RPFEBX=AMAX1(-PFEPOB,TPD*(CH2B1-CH2PF)) +C +C DICALCIUM PHOSPHATE +C + CH2PD=SYCAD2/(CCA1*COH1) + RPCDBX=AMAX1(-PCAPDB,TPD*(CH2B1-CH2PD)) +C +C HYDROXYAPATITE +C + CH2PH=(SYCAH2/(CCA1**5*COH1**7))**0.333 + RPCHBX=AMAX1(-PCAPHB,TPD*(CH2B1-CH2PH)) +C +C MONOCALCIUM PHOSPHATE +C + CH2PM=SQRT(SPCAM/CCA1) + RPCMBX=AMAX1(-PCAPMB*SPPO4,TPD*(CH2B1-CH2PM)) +C +C PHOSPHORUS ANION EXCHANGE IN BAND SOIL ZONE +C CALCULATED FROM EXCHANGE EQUILIBRIA AMONG H2PO4-, +C HPO4--, H+, OH- AND PROTONATED AND NON-PROTONATED -OH +C EXCHANGE SITES +C + IF(AEC(L,NY,NX).GT.0.0)THEN +C +C PROTONATION OF EXCHANGE SITES IN BAND SOIL ZONE +C + DCHG=AMAX1(-0.1E+05,XH21B-XH01B-X1P1B) + AEP=EXP(AE*DCHG/TKS(L,NY,NX)) + AEN=EXP(-AE*DCHG/TKS(L,NY,NX)) +C +C H2PO4 EXCHANGE IN BAND SOIL ZONE FROM CONVERGENCE +C SOLUTION FOR EQUILIBRIUM AMONG H2PO4-, H+, OH-, X-OH +C AND X-H2PO4 +C + RXH2B=TADA*(XH21B*CH2B1-SPH2P*X2P1B)/(SPH2P+XH21B) + RYH2B=TADA*(XH11B*CH2B1-SYH2P*X2P1B*COH1)/(SYH2P*COH1+XH11B) +C +C HPO4 EXCHANGE IN BAND SOIL ZONE FROM CONVERGENCE +C SOLUTION FOR EQUILIBRIUM AMONG HPO4--, H+, OH-, X-OH +C AND X-HPO4 +C + SPH1P=SYH1P*DPH2O*AEN/DPH2P + RXH1B=TADA*(XH11B*CH2B1-SPH1P*X1P1B)/(SPH1P+XH11B) +C WRITE(*,2224)'RXH2B',I,J,L,RXH2B,RXH1B,XH21B,CH2B1,SPH2P,X2P1B +C 2,SPH2P,XH21B,XH11B,CH2B1,SPH1P,X1P1B,SPH1P,XH11B,H2POB(L,NY,NX) +2224 FORMAT(A8,3I4,40E12.4) + ELSE + RXH2B=0.0 + RYH2B=0.0 + RXH1B=0.0 + ENDIF + ELSE + RPALBX=0.0 + RPFEBX=0.0 + RPCDBX=0.0 + RPCHBX=0.0 + RPCMBX=0.0 + RXH2B=0.0 + RYH2B=0.0 + RXH1B=0.0 + ENDIF +C +C CATION EXCHANGE FROM GAPON SELECTIVITY COEFFICIENTS +C FOR CA-NH4, CA-H, CA-AL +C + CALX=AMAX1(ZERO,CAL1)**0.333 + CCAX=AMAX1(ZERO,CCA1)**0.500 + CMGX=AMAX1(ZERO,CMG1)**0.500 +C +C EQUILIBRIUM X-CA CONCENTRATION FROM CEC AND CATION +C CONCENTRATIONS +C + XCAQ=CCEC/(1.0+GKC4(L,NY,NX)*CN41/CCAX*VLNH4(L,NY,NX) + 2+GKC4(L,NY,NX)*CN4B/CCAX*VLNHB(L,NY,NX)+GKCH(L,NY,NX)*CHY1/CCAX + 3+GKCA(L,NY,NX)*CALX/CCAX+GKCM(L,NY,NX)*CMGX/CCAX + 3+GKCN(L,NY,NX)*CNA1/CCAX+GKCK(L,NY,NX)*CKA1/CCAX) + FCAQ=XCAQ/CCAX + FN4X=FCAQ*GKC4(L,NY,NX) +C +C NH4 EXCHANGE IN NON-BAND AND BAND SOIL ZONES +C + RXN4=TADC*(FN4X*CN41-XN41)/(1.0+FN4X) + RXNB=TADC*(FN4X*CN4B-XN4B)/(1.0+FN4X) +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) +C 3,(CCA1)**0.5*XN41/(CN41*XCAQ),ZCA(L,NY,NX) +C ENDIF +C +C NH4-NH3+H IN NON-BAND AND BAND SOIL ZONES +C + IF(VOLWNH.GT.ZEROS(NY,NX))THEN + RNH4=(CHY1*CN31-DPN4*CN41)/(DPN4+CHY1) + ELSE + RNH4=0.0 + ENDIF + IF(VOLWNB.GT.ZEROS(NY,NX))THEN + RNHB=(CHY1*CN3B-DPN4*CN4B)/(DPN4+CHY1) + ELSE + RNHB=0.0 + ENDIF +C IF(J.EQ.12.AND.L.LE.6)THEN +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) +C 4,RN4X,RN3X,RNBX,R3BX +C ENDIF +C +C TOTAL ION FLUXES FOR ALL REACTIONS ABOVE +C + RN4S=RNH4-RXN4 + RN4B=RNHB-RXNB + RN3S=-RNH4 + RN3B=-RNHB + RHP2=-RXH2P-RYH2P-RXH1P-RPALPX-RPFEPX-RPCADX-2.0*RPCAMX-3.0*RPCAHX + RHB2=-RXH2B-RYH2B-RXH1B-RPALBX-RPFEBX-RPCDBX-2.0*RPCMBX-3.0*RPCHBX + RXH1=-RYH2P-RXH1P + RXH2=-RXH2P + RX1P=RXH1P + RX2P=RXH2P+RYH2P + RBH1=-RYH2B-RXH1B + RBH2=-RXH2B + RB1P=RXH1B + RB2P=RXH2B+RYH2B + RH2O=(RXH2P+RXH1P+RPCADX)*VLPO4(L,NY,NX)+(RXH2B+RXH1B+RPCDBX) + 2*VLPOB(L,NY,NX)+2.0*((RPALPX+RPFEPX)*VLPO4(L,NY,NX) + 3+(RPALBX+RPFEBX)*VLPOB(L,NY,NX))+6.0*(RPCAHX*VLPO4(L,NY,NX) + 4+RPCHBX*VLPOB(L,NY,NX)) + BNH4=-RXN4*VLNH4(L,NY,NX)-RXNB*VLNHB(L,NY,NX) + BH2P=RHP2*VLPO4(L,NY,NX)+RHB2*VLPOB(L,NY,NX) + BION=(RYH2P-RPCAMX)*VLPO4(L,NY,NX)+(RYH2B-RPCMBX)*VLPOB(L,NY,NX) + 2-3.0*((RPALPX+RPFEPX)*VLPO4(L,NY,NX) + 3+(RPALBX+RPFEBX)*VLPOB(L,NY,NX)) + 4-2.0*(RPCADX*VLPO4(L,NY,NX)+RPCDBX*VLPOB(L,NY,NX)) + 5-12.0*(RPCAHX*VLPO4(L,NY,NX)+RPCHBX*VLPOB(L,NY,NX)) +C +C CONVERT TOTAL ION FLUXES FROM CHANGES IN CONCENTRATION +C TO CHANGES IN MASS PER UNIT AREA FOR USE IN 'REDIST' +C + TRN4S(L,NY,NX)=TRN4S(L,NY,NX)+RN4S*VOLWNH + TRN4B(L,NY,NX)=TRN4B(L,NY,NX)+RN4B*VOLWNB + TRN3S(L,NY,NX)=TRN3S(L,NY,NX)+RN3S*VOLWNH + TRN3B(L,NY,NX)=TRN3B(L,NY,NX)+RN3B*VOLWNB + TRH2P(L,NY,NX)=TRH2P(L,NY,NX)+RHP2*VOLWPO + TRH2B(L,NY,NX)=TRH2B(L,NY,NX)+RHB2*VOLWPB + TRXN4(L,NY,NX)=TRXN4(L,NY,NX)+RXN4*VOLWNH + TRXNB(L,NY,NX)=TRXNB(L,NY,NX)+RXNB*VOLWNB + TRXH1(L,NY,NX)=TRXH1(L,NY,NX)+RXH1*VOLWPO + TRXH2(L,NY,NX)=TRXH2(L,NY,NX)+RXH2*VOLWPO + TRX1P(L,NY,NX)=TRX1P(L,NY,NX)+RX1P*VOLWPO + TRX2P(L,NY,NX)=TRX2P(L,NY,NX)+RX2P*VOLWPO + TRBH1(L,NY,NX)=TRBH1(L,NY,NX)+RBH1*VOLWPB + TRBH2(L,NY,NX)=TRBH2(L,NY,NX)+RBH2*VOLWPB + TRB1P(L,NY,NX)=TRB1P(L,NY,NX)+RB1P*VOLWPB + TRB2P(L,NY,NX)=TRB2P(L,NY,NX)+RB2P*VOLWPB + TRALPO(L,NY,NX)=TRALPO(L,NY,NX)+RPALPX*VOLWPO + TRFEPO(L,NY,NX)=TRFEPO(L,NY,NX)+RPFEPX*VOLWPO + TRCAPD(L,NY,NX)=TRCAPD(L,NY,NX)+RPCADX*VOLWPO + TRCAPH(L,NY,NX)=TRCAPH(L,NY,NX)+RPCAHX*VOLWPO + TRCAPM(L,NY,NX)=TRCAPM(L,NY,NX)+RPCAMX*VOLWPO + TRALPB(L,NY,NX)=TRALPB(L,NY,NX)+RPALBX*VOLWPB + TRFEPB(L,NY,NX)=TRFEPB(L,NY,NX)+RPFEBX*VOLWPB + TRCPDB(L,NY,NX)=TRCPDB(L,NY,NX)+RPCDBX*VOLWPB + TRCPHB(L,NY,NX)=TRCPHB(L,NY,NX)+RPCHBX*VOLWPB + TRCPMB(L,NY,NX)=TRCPMB(L,NY,NX)+RPCMBX*VOLWPB + TRH2O(L,NY,NX)=TRH2O(L,NY,NX)+RH2O*VOLWM(NPH,L,NY,NX) + TBNH4(L,NY,NX)=TBNH4(L,NY,NX)+BNH4*VOLWM(NPH,L,NY,NX) + TBH2P(L,NY,NX)=TBH2P(L,NY,NX)+BH2P*VOLWM(NPH,L,NY,NX) + TBION(L,NY,NX)=TBION(L,NY,NX)+BION*VOLWM(NPH,L,NY,NX) +C IF(L.EQ.1)THEN +C WRITE(*,4334)'RH2O',I,J,L,TRH2O(L,NY,NX),RH2O,RXH2P,RXH1P,RPCADX +C 2,VLPO4(L,NY,NX),RXH2B,RXH1B,RPCDBX +C 2,VLPOB(L,NY,NX),RPALPX,RPFEPX,VLPO4(L,NY,NX) +C 3,RPALBX,RPFEBX,VLPOB(L,NY,NX),RPCAHX,VLPO4(L,NY,NX) +C 4,RPCHBX,VLPOB(L,NY,NX),VOLWM(NPH,L,NY,NX) +C 5,TADA,XOH21,CH2P1,SPH2P,XH2P1,H2PO4(L,NY,NX),VOLWPX,RH2PX +C 6,VOLWPO,XH2PS(L,NY,NX),TUPH2P(L,NY,NX) +4334 FORMAT(A8,3I4,40E12.4) +C ENDIF + ENDIF +C +C CHANGE IN WIDTHS AND DEPTHS OF FERTILIZER BANDS FROM +C VERTICAL AND HORIZONTAL DIFFUSION DRIVEN BY CONCENTRATION +C DIFFERENCES BETWEEN BAND AND NON-BAND SOIL ZONES +C +C IF(ROWI(I,NY,NX).GT.0.0)THEN + FLWD=0.5*(FLW(3,L,NY,NX)+FLW(3,L+1,NY,NX))/AREA(3,L,NY,NX) +C +C NH4 FERTILIZER BAND +C + IF(IFNHB(NY,NX).EQ.1.AND.ROWN(NY,NX).GT.0.0)THEN + IF(L.EQ.NU(NY,NX).OR.CDPTH(L-1,NY,NX).LT.DPNH4(NY,NX))THEN +C +C NH4 BAND WIDTH +C + DWNH4=0.5*SQRT(ZNSGL(L,NY,NX))*TORT(NPH,L,NY,NX) + WDNHB(L,NY,NX)=AMIN1(ROWN(NY,NX) + 2,AMAX1(0.025,WDNHB(L,NY,NX))+DWNH4) +C +C NH4 BAND DEPTH +C + IF(CDPTH(L,NY,NX).GE.DPNH4(NY,NX))THEN + DPFLW=FLWD+DWNH4 + DPNH4(NY,NX)=DPNH4(NY,NX)+DPFLW + DPNHB(L,NY,NX)=DPNHB(L,NY,NX)+DPFLW + IF(DPNHB(L,NY,NX).GT.DLYR(3,L,NY,NX))THEN + DPNHB(L+1,NY,NX)=DPNHB(L+1,NY,NX)+(DPNHB(L,NY,NX)-DLYR(3,L,NY,NX)) + WDNHB(L+1,NY,NX)=WDNHB(L,NY,NX) + DPNHB(L,NY,NX)=DLYR(3,L,NY,NX) + ELSEIF(DPNHB(L,NY,NX).LT.0.0)THEN + DPNHB(L-1,NY,NX)=DPNHB(L-1,NY,NX)+DPNHB(L,NY,NX) + DPNHB(L,NY,NX)=0.0 + WDNHB(L,NY,NX)=0.0 + ENDIF + ENDIF +C +C FRACTION OF SOIL LAYER OCCUPIED BY NH4 BAND +C FROM BAND WIDTH X DEPTH +C + XVLNH4=VLNH4(L,NY,NX) + VLNHB(L,NY,NX)=AMIN1(0.999,WDNHB(L,NY,NX)/ROWN(NY,NX) + 2*DPNHB(L,NY,NX)/DLYR(3,L,NY,NX)) + VLNH4(L,NY,NX)=1.0-VLNHB(L,NY,NX) + FVLNH4=AMIN1(0.0,(VLNH4(L,NY,NX)-XVLNH4)/XVLNH4) +C +C TRANSFER NH4, NH3 FROM NON-BAND TO BAND +C DURING BAND GROWTH +C + DNH4S=FVLNH4*ZNH4S(L,NY,NX)/14.0 + DNH3S=FVLNH4*ZNH3S(L,NY,NX)/14.0 + DXNH4=FVLNH4*XN4(L,NY,NX) + TRN4S(L,NY,NX)=TRN4S(L,NY,NX)+DNH4S + TRN4B(L,NY,NX)=TRN4B(L,NY,NX)-DNH4S + TRN3S(L,NY,NX)=TRN3S(L,NY,NX)+DNH3S + TRN3B(L,NY,NX)=TRN3B(L,NY,NX)-DNH3S + TRXN4(L,NY,NX)=TRXN4(L,NY,NX)+DXNH4 + TRXNB(L,NY,NX)=TRXNB(L,NY,NX)-DXNH4 + ELSE +C +C AMALGAMATE NH4 BAND WITH NON-BAND +C + DPNHB(L,NY,NX)=0.0 + WDNHB(L,NY,NX)=0.0 + VLNH4(L,NY,NX)=1.0 + VLNHB(L,NY,NX)=0.0 + ZNH4S(L,NY,NX)=ZNH4S(L,NY,NX)+ZNH4B(L,NY,NX) + ZNH3S(L,NY,NX)=ZNH3S(L,NY,NX)+ZNH3B(L,NY,NX) + ZNH4B(L,NY,NX)=0.0 + ZNH3B(L,NY,NX)=0.0 + XN4(L,NY,NX)=XN4(L,NY,NX)+XNB(L,NY,NX) + XNB(L,NY,NX)=0.0 + ENDIF + ENDIF +C +C NO3 FERTILIZER BAND +C + IF(IFNOB(NY,NX).EQ.1.AND.ROWO(NY,NX).GT.0.0)THEN + IF(L.EQ.NU(NY,NX).OR.CDPTH(L-1,NY,NX).LT.DPNO3(NY,NX))THEN +C +C NO3 BAND WIDTH +C + DWNO3=0.5*SQRT(ZOSGL(L,NY,NX))*TORT(NPH,L,NY,NX) + WDNOB(L,NY,NX)=AMIN1(ROWO(NY,NX),WDNOB(L,NY,NX)+DWNO3) +C +C NO3 BAND DEPTH +C + IF(CDPTH(L,NY,NX).GE.DPNO3(NY,NX))THEN + DPFLW=FLWD+DWNO3 + DPNO3(NY,NX)=DPNO3(NY,NX)+DPFLW + DPNOB(L,NY,NX)=DPNOB(L,NY,NX)+DPFLW + IF(DPNOB(L,NY,NX).GT.DLYR(3,L,NY,NX))THEN + DPNOB(L+1,NY,NX)=DPNOB(L+1,NY,NX)+(DPNOB(L,NY,NX)-DLYR(3,L,NY,NX)) + WDNOB(L+1,NY,NX)=WDNOB(L,NY,NX) + DPNOB(L,NY,NX)=DLYR(3,L,NY,NX) + ELSE IF(DPNOB(L,NY,NX).LT.0.0)THEN + DPNOB(L-1,NY,NX)=DPNOB(L-1,NY,NX)+DPNOB(L,NY,NX) + DPNOB(L,NY,NX)=0.0 + WDNOB(L,NY,NX)=0.0 + ENDIF + ENDIF +C +C FRACTION OF SOIL LAYER OCCUPIED BY NO3 BAND +C FROM BAND WIDTH X DEPTH +C + XVLNO3=VLNO3(L,NY,NX) + VLNOB(L,NY,NX)=AMIN1(0.999,WDNOB(L,NY,NX)/ROWO(NY,NX) + 2*DPNOB(L,NY,NX)/DLYR(3,L,NY,NX)) + VLNO3(L,NY,NX)=1.0-VLNOB(L,NY,NX) + FVLNO3=AMIN1(0.0,(VLNO3(L,NY,NX)-XVLNO3)/XVLNO3) +C +C TRANSFER NO3 FROM NON-BAND TO BAND +C DURING BAND GROWTH +C + DNO3S=FVLNO3*ZNO3S(L,NY,NX)/14.0 + DNO2S=FVLNO3*ZNO2S(L,NY,NX)/14.0 + TRNO3(L,NY,NX)=TRNO3(L,NY,NX)+DNO3S + TRNO2(L,NY,NX)=TRNO2(L,NY,NX)+DNO2S + TRNOB(L,NY,NX)=TRNOB(L,NY,NX)-DNO3S + TRN2B(L,NY,NX)=TRN2B(L,NY,NX)-DNO2S + ELSE +C +C AMALGAMATE NO3 BAND WITH NON-BAND +C + DPNOB(L,NY,NX)=0.0 + WDNOB(L,NY,NX)=0.0 + VLNO3(L,NY,NX)=1.0 + VLNOB(L,NY,NX)=0.0 + ZNO3S(L,NY,NX)=ZNO3S(L,NY,NX)+ZNO3B(L,NY,NX) + ZNO2S(L,NY,NX)=ZNO2S(L,NY,NX)+ZNO2B(L,NY,NX) + ZNO3B(L,NY,NX)=0.0 + ZNO2B(L,NY,NX)=0.0 + ENDIF + ENDIF +C +C PO4 FERTILIZER BAND +C + IF(IFPOB(NY,NX).EQ.1.AND.ROWP(NY,NX).GT.0.0)THEN + IF(L.EQ.NU(NY,NX).OR.CDPTH(L-1,NY,NX).LT.DPPO4(NY,NX))THEN +C +C PO4 BAND WIDTH +C + DWPO4=0.5*SQRT(POSGL(L,NY,NX))*TORT(NPH,L,NY,NX) + WDPOB(L,NY,NX)=AMIN1(ROWP(NY,NX),WDPOB(L,NY,NX)+DWPO4) +C +C PO4 BAND DEPTH +C + IF(CDPTH(L,NY,NX).GE.DPPO4(NY,NX))THEN + DPFLW=FLWD+DWPO4 + DPPO4(NY,NX)=DPPO4(NY,NX)+DPFLW + DPPOB(L,NY,NX)=DPPOB(L,NY,NX)+DPFLW + IF(DPPOB(L,NY,NX).GT.DLYR(3,L,NY,NX))THEN + DPPOB(L+1,NY,NX)=DPPOB(L+1,NY,NX)+(DPPOB(L,NY,NX)-DLYR(3,L,NY,NX)) + WDPOB(L+1,NY,NX)=WDPOB(L,NY,NX) + DPPOB(L,NY,NX)=DLYR(3,L,NY,NX) + ELSE IF(DPPOB(L,NY,NX).LT.0.0)THEN + DPPOB(L-1,NY,NX)=DPPOB(L-1,NY,NX)+DPPOB(L,NY,NX) + DPPOB(L,NY,NX)=0.0 + WDPOB(L,NY,NX)=0.0 + ENDIF + ENDIF +C +C FRACTION OF SOIL LAYER OCCUPIED BY PO4 BAND +C FROM BAND WIDTH X DEPTH +C + XVLPO4=VLPO4(L,NY,NX) + VLPOB(L,NY,NX)=AMIN1(0.999,WDPOB(L,NY,NX)/ROWP(NY,NX) + 2*DPPOB(L,NY,NX)/DLYR(3,L,NY,NX)) + VLPO4(L,NY,NX)=1.0-VLPOB(L,NY,NX) + FVLPO4=AMIN1(0.0,(VLPO4(L,NY,NX)-XVLPO4)/XVLPO4) +C +C TRANSFER NO3 FROM NON-BAND TO BAND +C DURING BAND GROWTH DEPENDING ON SALT +C VS. NON-SALT OPTION +C + IF(ISALT(NY,NX).NE.0)THEN + DZH0P=FVLPO4*H0PO4(L,NY,NX) + DZH1P=FVLPO4*H1PO4(L,NY,NX) + DZH2P=FVLPO4*H2PO4(L,NY,NX)/31.0 + DZH3P=FVLPO4*H3PO4(L,NY,NX) + DZF1P=FVLPO4*ZFE1P(L,NY,NX) + DZF2P=FVLPO4*ZFE2P(L,NY,NX) + DZC0P=FVLPO4*ZCA0P(L,NY,NX) + DZC1P=FVLPO4*ZCA1P(L,NY,NX) + DZC2P=FVLPO4*ZCA2P(L,NY,NX) + DZM1P=FVLPO4*ZMG1P(L,NY,NX) + DXOH0=FVLPO4*XOH0(L,NY,NX) + DXOH1=FVLPO4*XOH1(L,NY,NX) + DXOH2=FVLPO4*XOH2(L,NY,NX) + DXH1P=FVLPO4*XH1P(L,NY,NX) + DXH2P=FVLPO4*XH2P(L,NY,NX) + DPALP=FVLPO4*PALPO(L,NY,NX) + DPFEP=FVLPO4*PFEPO(L,NY,NX) + DPCDP=FVLPO4*PCAPD(L,NY,NX) + DPCHP=FVLPO4*PCAPH(L,NY,NX) + DPCMP=FVLPO4*PCAPM(L,NY,NX) + TRH0P(L,NY,NX)=TRH0P(L,NY,NX)+DZH0P + TRH1P(L,NY,NX)=TRH1P(L,NY,NX)+DZH1P + TRH2P(L,NY,NX)=TRH2P(L,NY,NX)+DZH2P + TRH3P(L,NY,NX)=TRH3P(L,NY,NX)+DZH3P + TRF1P(L,NY,NX)=TRF1P(L,NY,NX)+DZF1P + TRF2P(L,NY,NX)=TRF2P(L,NY,NX)+DZF2P + TRC0P(L,NY,NX)=TRC0P(L,NY,NX)+DZC0P + TRC1P(L,NY,NX)=TRC1P(L,NY,NX)+DZC1P + TRC2P(L,NY,NX)=TRC2P(L,NY,NX)+DZC2P + TRM1P(L,NY,NX)=TRM1P(L,NY,NX)+DZM1P + TRH0B(L,NY,NX)=TRH0B(L,NY,NX)-DZH0P + TRH1B(L,NY,NX)=TRH1B(L,NY,NX)-DZH1P + TRH2B(L,NY,NX)=TRH2B(L,NY,NX)-DZH2P + TRH3B(L,NY,NX)=TRH3B(L,NY,NX)-DZH3P + TRF1B(L,NY,NX)=TRF1B(L,NY,NX)-DZF1P + TRF2B(L,NY,NX)=TRF2B(L,NY,NX)-DZF2P + TRC0B(L,NY,NX)=TRC0B(L,NY,NX)-DZC0P + TRC1B(L,NY,NX)=TRC1B(L,NY,NX)-DZC1P + TRC2B(L,NY,NX)=TRC2B(L,NY,NX)-DZC2P + TRM1B(L,NY,NX)=TRM1B(L,NY,NX)-DZM1P + TRXH0(L,NY,NX)=TRXH0(L,NY,NX)+DXOH0 + TRXH1(L,NY,NX)=TRXH1(L,NY,NX)+DXOH1 + TRXH2(L,NY,NX)=TRXH2(L,NY,NX)+DXOH2 + TRX1P(L,NY,NX)=TRX1P(L,NY,NX)+DXH1P + TRX2P(L,NY,NX)=TRX2P(L,NY,NX)+DXH2P + TRBH0(L,NY,NX)=TRBH0(L,NY,NX)-DXOH0 + TRBH1(L,NY,NX)=TRBH1(L,NY,NX)-DXOH1 + TRBH2(L,NY,NX)=TRBH2(L,NY,NX)-DXOH2 + TRB1P(L,NY,NX)=TRB1P(L,NY,NX)-DXH1P + TRB2P(L,NY,NX)=TRB2P(L,NY,NX)-DXH2P + TRALPO(L,NY,NX)=TRALPO(L,NY,NX)+DPALP + TRFEPO(L,NY,NX)=TRFEPO(L,NY,NX)+DPFEP + TRCAPD(L,NY,NX)=TRCAPD(L,NY,NX)+DPCDP + TRCAPH(L,NY,NX)=TRCAPH(L,NY,NX)+DPCHP + TRCAPM(L,NY,NX)=TRCAPM(L,NY,NX)+DPCMP + TRALPB(L,NY,NX)=TRALPB(L,NY,NX)-DPALP + TRFEPB(L,NY,NX)=TRFEPB(L,NY,NX)-DPFEP + TRCPDB(L,NY,NX)=TRCPDB(L,NY,NX)-DPCDP + TRCPHB(L,NY,NX)=TRCPHB(L,NY,NX)-DPCHP + TRCPMB(L,NY,NX)=TRCPMB(L,NY,NX)-DPCMP + ELSE + DZH2P=FVLPO4*H2PO4(L,NY,NX)/31.0 + DXOH1=FVLPO4*XOH1(L,NY,NX) + DXOH2=FVLPO4*XOH2(L,NY,NX) + DXH2P=FVLPO4*XH2P(L,NY,NX) + DPALP=FVLPO4*PALPO(L,NY,NX) + DPFEP=FVLPO4*PFEPO(L,NY,NX) + DPCDP=FVLPO4*PCAPD(L,NY,NX) + DPCHP=FVLPO4*PCAPH(L,NY,NX) + DPCMP=FVLPO4*PCAPM(L,NY,NX) + TRH2P(L,NY,NX)=TRH2P(L,NY,NX)+DZH2P + TRXH1(L,NY,NX)=TRXH1(L,NY,NX)+DXOH1 + TRXH2(L,NY,NX)=TRXH2(L,NY,NX)+DXOH2 + TRX2P(L,NY,NX)=TRX2P(L,NY,NX)+DXH2P + TRH2B(L,NY,NX)=TRH2B(L,NY,NX)-DZH2P + TRBH1(L,NY,NX)=TRBH1(L,NY,NX)-DXOH1 + TRBH2(L,NY,NX)=TRBH2(L,NY,NX)-DXOH2 + TRB2P(L,NY,NX)=TRB2P(L,NY,NX)-DXH2P + TRALPO(L,NY,NX)=TRALPO(L,NY,NX)+DPALP + TRFEPO(L,NY,NX)=TRFEPO(L,NY,NX)+DPFEP + TRCAPD(L,NY,NX)=TRCAPD(L,NY,NX)+DPCDP + TRCAPH(L,NY,NX)=TRCAPH(L,NY,NX)+DPCHP + TRCAPM(L,NY,NX)=TRCAPM(L,NY,NX)+DPCMP + TRALPB(L,NY,NX)=TRALPB(L,NY,NX)-DPALP + TRFEPB(L,NY,NX)=TRFEPB(L,NY,NX)-DPFEP + TRCPDB(L,NY,NX)=TRCPDB(L,NY,NX)-DPCDP + TRCPHB(L,NY,NX)=TRCPHB(L,NY,NX)-DPCHP + TRCPMB(L,NY,NX)=TRCPMB(L,NY,NX)-DPCMP + ENDIF + ELSE +C +C AMALGAMATE PO4 BAND WITH NON-BAND +C + DPPOB(L,NY,NX)=0.0 + WDPOB(L,NY,NX)=0.0 + VLPOB(L,NY,NX)=0.0 + VLPO4(L,NY,NX)=1.0 + H0PO4(L,NY,NX)=H0PO4(L,NY,NX)+H0POB(L,NY,NX) + H1PO4(L,NY,NX)=H1PO4(L,NY,NX)+H1POB(L,NY,NX) + H2PO4(L,NY,NX)=H2PO4(L,NY,NX)+H2POB(L,NY,NX) + H3PO4(L,NY,NX)=H3PO4(L,NY,NX)+H3POB(L,NY,NX) + ZFE1P(L,NY,NX)=ZFE1P(L,NY,NX)+ZFE1PB(L,NY,NX) + ZFE2P(L,NY,NX)=ZFE2P(L,NY,NX)+ZFE2PB(L,NY,NX) + ZCA0P(L,NY,NX)=ZCA0P(L,NY,NX)+ZCA0PB(L,NY,NX) + ZCA1P(L,NY,NX)=ZCA1P(L,NY,NX)+ZCA1PB(L,NY,NX) + ZCA2P(L,NY,NX)=ZCA2P(L,NY,NX)+ZCA2PB(L,NY,NX) + ZMG1P(L,NY,NX)=ZMG1P(L,NY,NX)+ZMG1PB(L,NY,NX) + H0POB(L,NY,NX)=0.0 + H1POB(L,NY,NX)=0.0 + H2POB(L,NY,NX)=0.0 + H3POB(L,NY,NX)=0.0 + ZFE1PB(L,NY,NX)=0.0 + ZFE2PB(L,NY,NX)=0.0 + ZCA0PB(L,NY,NX)=0.0 + ZCA1PB(L,NY,NX)=0.0 + ZCA2PB(L,NY,NX)=0.0 + ZMG1PB(L,NY,NX)=0.0 + XOH0(L,NY,NX)=XOH0(L,NY,NX)+XOH0B(L,NY,NX) + XOH1(L,NY,NX)=XOH1(L,NY,NX)+XOH1B(L,NY,NX) + XOH2(L,NY,NX)=XOH2(L,NY,NX)+XOH2B(L,NY,NX) + XH1P(L,NY,NX)=XH1P(L,NY,NX)+XH1PB(L,NY,NX) + XH2P(L,NY,NX)=XH2P(L,NY,NX)+XH2PB(L,NY,NX) + XOH0B(L,NY,NX)=0.0 + XOH1B(L,NY,NX)=0.0 + XOH2B(L,NY,NX)=0.0 + XH1PB(L,NY,NX)=0.0 + XH2PB(L,NY,NX)=0.0 + PALPO(L,NY,NX)=PALPO(L,NY,NX)+PALPB(L,NY,NX) + PFEPO(L,NY,NX)=PFEPO(L,NY,NX)+PFEPB(L,NY,NX) + PCAPD(L,NY,NX)=PCAPD(L,NY,NX)+PCPDB(L,NY,NX) + PCAPH(L,NY,NX)=PCAPH(L,NY,NX)+PCPHB(L,NY,NX) + PCAPM(L,NY,NX)=PCAPM(L,NY,NX)+PCPMB(L,NY,NX) + PALPB(L,NY,NX)=0.0 + PFEPB(L,NY,NX)=0.0 + PCPDB(L,NY,NX)=0.0 + PCPHB(L,NY,NX)=0.0 + PCPMB(L,NY,NX)=0.0 + ENDIF + ENDIF +C ENDIF +C +C SUBTRACT FERTILIZER DISSOLUTION FROM FERTILIZER POOLS +C + ZNH4FA(L,NY,NX)=ZNH4FA(L,NY,NX)-RSN4AA-RSN4BA + ZNH3FA(L,NY,NX)=ZNH3FA(L,NY,NX)-RSN3AA-RSN3BA + ZNHUFA(L,NY,NX)=ZNHUFA(L,NY,NX)-RSNUAA-RSNUBA + ZNO3FA(L,NY,NX)=ZNO3FA(L,NY,NX)-RSNOAA-RSNOBA + ZNH4FB(L,NY,NX)=ZNH4FB(L,NY,NX)-RSN4BB + ZNH3FB(L,NY,NX)=ZNH3FB(L,NY,NX)-RSN3BB + ZNHUFB(L,NY,NX)=ZNHUFB(L,NY,NX)-RSNUBB + ZNO3FB(L,NY,NX)=ZNO3FB(L,NY,NX)-RSNOBB +C +C ADD FERTILIZER DISSOLUTION TO ION FLUXES +C + TRN3G(L,NY,NX)=TRN3G(L,NY,NX)+RSN3AA+RSN3BA+RSN3BB + TRN4S(L,NY,NX)=TRN4S(L,NY,NX)+RSN4AA + TRN4B(L,NY,NX)=TRN4B(L,NY,NX)+RSN4BA+RSN4BB + TRN3S(L,NY,NX)=TRN3S(L,NY,NX)+RSNUAA + TRN3B(L,NY,NX)=TRN3B(L,NY,NX)+RSNUBA+RSNUBB + TRNO3(L,NY,NX)=TRNO3(L,NY,NX)+RSNOAA + TRNOB(L,NY,NX)=TRNOB(L,NY,NX)+RSNOBA+RSNOBB + TBNH4(L,NY,NX)=TBNH4(L,NY,NX)+RSN4AA+RSN4BA+RSN4BB + TBNH3(L,NY,NX)=TBNH3(L,NY,NX)+RSN3AA+RSN3BA+RSN3BB + 2+RSNUAA+RSNUBA+RSNUBB + TBNO3(L,NY,NX)=TBNO3(L,NY,NX)+RSNOAA+RSNOBA+RSNOBB + TRN3G(L,NY,NX)=TRN3G(L,NY,NX)*14.0 + TRN4S(L,NY,NX)=TRN4S(L,NY,NX)*14.0 + TRN4B(L,NY,NX)=TRN4B(L,NY,NX)*14.0 + TRN3S(L,NY,NX)=TRN3S(L,NY,NX)*14.0 + TRN3B(L,NY,NX)=TRN3B(L,NY,NX)*14.0 + TRNO3(L,NY,NX)=TRNO3(L,NY,NX)*14.0 + TRNOB(L,NY,NX)=TRNOB(L,NY,NX)*14.0 + TRNO2(L,NY,NX)=TRNO2(L,NY,NX)*14.0 + TRN2B(L,NY,NX)=TRN2B(L,NY,NX)*14.0 + TRH2P(L,NY,NX)=TRH2P(L,NY,NX)*31.0 + TRH2B(L,NY,NX)=TRH2B(L,NY,NX)*31.0 + TRCO2(L,NY,NX)=TBCO2(L,NY,NX)*12.0 +C IF(L.EQ.1)THEN +C WRITE(*,9984)'TRN4S',I,J,L,TRN4S(L,NY,NX) +C 2,RN4S,VOLWNH,RSN4AA,ZNH4FA(L,NY,NX),VLNH4(L,NY,NX) +C 3,TRN4B(L,NY,NX),RN4B,VOLWNB,RSN4BA,RSN4BB,DNH4S +9984 FORMAT(A8,3I4,20E12.4) +C ENDIF + ENDIF +9985 CONTINUE +C +C SURFACE RESIDUE +C + IF(VOLWM(NPH,0,NY,NX).GT.ZEROS(NY,NX))THEN +C +C UREA HYDROLYSIS IN SURFACE RESIDUE +C + IF(VOLQ(0,NY,NX).GT.ZEROS(NY,NX))THEN + COMA=AMIN1(0.1E+06,TOQCK(0,NY,NX)/VOLQ(0,NY,NX)) + ELSE + COMA=0.1E+06 + ENDIF + DUKD=DUKM*(1.0+COMA/DUKI) +C +C UREA HYDROLYSIS INHIBITION +C + IF(ZNHU0(0,NY,NX).GT.ZEROS(NY,NX) + 2.AND.ZNHUI(0,NY,NX).GT.ZEROS(NY,NX))THEN + ZNHUI(0,NY,NX)=ZNHUI(0,NY,NX)-TFNQ(0,NY,NX)**0.25 + 2*RNHUI(IUTYP(NY,NX))*ZNHUI(0,NY,NX) + 3*AMAX1(RNHUI(IUTYP(NY,NX)),1.0-ZNHUI(0,NY,NX)/ZNHU0(0,NY,NX)) + ELSE + ZNHUI(0,NY,NX)=0.0 + ENDIF +C +C UREA CONCENTRATION AND HYDROLYSIS IN SURFACE RESIDUE +C + IF(ZNHUFA(0,NY,NX).GT.ZEROS(NY,NX) + 2.AND.BKVL(0,NY,NX).GT.ZEROS(NY,NX))THEN + CNHUA=ZNHUFA(0,NY,NX)/BKVL(0,NY,NX) + DFNSA=CNHUA/(CNHUA+DUKD) + RSNUA=AMIN1(ZNHUFA(0,NY,NX) + 2,SPNHU*TOQCK(0,NY,NX)*DFNSA*TFNQ(0,NY,NX))*(1.0-ZNHUI(0,NY,NX)) + ELSE + RSNUA=0.0 + ENDIF +C IF(J.EQ.13)THEN +C WRITE(*,8778)'UREA0',I,J,IUTYP(NY,NX) +C 2,ZNHUFA(0,NY,NX),RSNUA +C 2,DFNSA,TFNQ(0,NY,NX),CNHUA,DUKD,DUKM,DUKI,TOQCK(0,NY,NX) +C 3,BKVL(0,NY,NX),TFNQ(0,NY,NX),SPNHU,ZNHU0(0,NY,NX),ZNHUI(0,NY,NX) +C 4,RNHUI(IUTYP(NY,NX)) +8778 FORMAT(A8,3I4,40E12.4) +C ENDIF +C +C NH4, NH3, UREA, NO3 DISSOLUTION IN SURFACE RESIDUE +C FROM FIRST-ORDER FUNCTIONS OF REMAINING +C FERTILIZER (NOTE: SUPERPHOSPHATE AND ROCK PHOSPHATE +C ARE REPRESENTED AS MONOCALCIUM PHOSPHATE AND HYDROXYAPATITE +C MODELLED IN PHOSPHORUS REACTIONS BELOW) +C + RSN4AA=SPNH4*ZNH4FA(0,NY,NX)*THETW(0,NY,NX) + RSN3AA=SPNH3*ZNH3FA(0,NY,NX) + RSNUAA=RSNUA*THETW(0,NY,NX) + RSNOAA=SPNO3*ZNO3FA(0,NY,NX)*THETW(0,NY,NX) + IF(VOLWM(NPH,0,NY,NX).GT.ZEROS(NY,NX))THEN + VOLWMX=14.0*VOLWM(NPH,0,NY,NX) + RN4X=(XNH4S(0,NY,NX)+14.0*RSN4AA)/VOLWMX + RN3X=14.0*RSNUAA/VOLWMX + CN41=AMAX1(0.0,ZNH4S(0,NY,NX)/VOLWMX+RN4X) + CN31=AMAX1(0.0,ZNH3S(0,NY,NX)/VOLWMX+RN3X) + XN41=AMAX1(0.0,XN4(0,NY,NX)/VOLWM(NPH,0,NY,NX)) + VOLWMP=31.0*VOLWM(NPH,0,NY,NX) + RH2PX=XH2PS(0,NY,NX)/VOLWMP + CH2P1=AMAX1(0.0,H2PO4(0,NY,NX)/VOLWMP+RH2PX) + ELSE + RN4X=0.0 + RN3X=0.0 + CN41=0.0 + CN31=0.0 + XN41=0.0 + RH2PX=0.0 + CH2P1=0.0 + ENDIF +C +C PHOSPHORUS TRANSFORMATIONS IN SURFACE RESIDUE +C + PCAPM1=AMAX1(0.0,PCAPM(0,NY,NX)/VOLWM(NPH,0,NY,NX)) + PCAPD1=AMAX1(0.0,PCAPD(0,NY,NX)/VOLWM(NPH,0,NY,NX)) + PCAPH1=AMAX1(0.0,PCAPH(0,NY,NX)/VOLWM(NPH,0,NY,NX)) + PALPO1=AMAX1(0.0,PALPO(0,NY,NX)/VOLWM(NPH,0,NY,NX)) + PFEPO1=AMAX1(0.0,PFEPO(0,NY,NX)/VOLWM(NPH,0,NY,NX)) + CHY1=AMAX1(ZERO,10.0**(-(PH(0,NY,NX)-3.0))) + COH1=AMAX1(ZERO,DPH2O/CHY1) + CAL1=AMAX1(ZERO,SYALO/COH1**3) + CFE1=AMAX1(ZERO,SYFEO/COH1**3) + CCO20=AMAX1(ZERO,CCO2S(0,NY,NX)/12.0) + CCO31=AMAX1(ZERO,CCO20*DPCO3/CHY1**2) + CCA1=AMAX1(ZERO,AMIN1(CCAMX,SPCAC/CCO31)) + CALX=AMAX1(ZERO,CAL1)**0.333 + CCAX=AMAX1(ZERO,CCA1)**0.500 +C +C ALUMINUM PHOSPHATE (VARISCITE) +C + CH2PA=SYA0P2/(CAL1*COH1**2) + RPALPX=AMIN1(AMAX1(0.0,4.0E-08*ORGC(0,NY,NX)-PALPO1) + 2,AMAX1(-PALPO1,TPD*(CH2P1-CH2PA))) +C +C IRON PHOSPHATE (STRENGITE) +C + CH2PF=SYF0P2/(CFE1*COH1**2) + RPFEPX=AMIN1(AMAX1(0.0,2.0E-06*ORGC(0,NY,NX)-PFEPO1) + 2,AMAX1(-PFEPO1,TPD*(CH2P1-CH2PF))) +C +C DICALCIUM PHOSPHATE +C + CH2PD=SYCAD2/(CCA1*COH1) + RPCADX=AMIN1(AMAX1(0-.0,5.0E-05*ORGC(0,NY,NX)-PCAPD1) + 2,AMAX1(-PCAPD1,TPD*(CH2P1-CH2PD))) +C +C HYDROXYAPATITE +C + CH2PH=(SYCAH2/(CCA1**5*COH1**7))**0.333 + RPCAHX=AMIN1(AMAX1(0.0,5.0E-05*ORGC(0,NY,NX)-PCAPH1) + 2,AMAX1(-PCAPH1,TPD*(CH2P1-CH2PH))) +C +C MONOCALCIUM PHOSPHATE +C + CH2PM=SQRT(SPCAM/CCA1) + RPCAMX=AMIN1(AMAX1(0.0,5.0E-05*ORGC(0,NY,NX)-PCAPM1) + 2,AMAX1(-PCAPM1*SPPO4,TPD*(CH2P1-CH2PM))) +C IF(I.GT.315)THEN +C WRITE(*,2227)'RPPO4',I,J,L,RPCAHX,CH2P1,CH2PA,CH2PH +C 2,SYA0P2,CAL1,COH1,SYCAH2,CCA1,CCO21,CCO31,PCAPH1 +C 3,VOLWM(NPH,0,NY,NX),SPCAC/CCO31,H2PO4(0,NY,NX) +C 4,CCO20,DPCO3,CHY1,CCO2S(0,NY,NX) +2227 FORMAT(A8,3I4,20E12.4) +C ENDIF +C +C PHOSPHORUS ANION EXCHANGE IN SURFACE REDISUE +C CALCULATED FROM EXCHANGE EQUILIBRIA AMONG H2PO4-, +C HPO4--, H+, OH- AND PROTONATED AND NON-PROTONATED -OH +C EXCHANGE SITES (NOT CALCULATED) +C +C EQUILIBRIUM X-CA CONCENTRATION FROM CEC AND CATION +C CONCENTRATIONS +C + IF(VOLWM(NPH,0,NY,NX).GT.ZEROS(NY,NX))THEN + CCEC0=AMAX1(0.0,COOH*ORGC(0,NY,NX)/VOLWM(NPH,0,NY,NX)) + ELSE + CCEC0=0.0 + ENDIF + XCAQ=CCEC0/(1.0+GKC4(NU(NY,NX),NY,NX)*CN41/CCAX + 2+GKCH(NU(NY,NX),NY,NX)*CHY1/CCAX+GKCA(NU(NY,NX),NY,NX)*CALX/CCAX) + FCAQ=XCAQ/CCAX + FN4X=FCAQ*GKC4(NU(NY,NX),NY,NX) +C +C NH4 AND NH3 EXCHANGE IN SURFACE RESIDUE +C + RXN4=TADC*(FN4X*CN41-XN41)/(1.0+FN4X) + RNH4=(CHY1*CN31-DPN4*CN41)/(DPN4+CHY1) +C IF(J.EQ.12)THEN +C WRITE(*,2223)'RXN4',I,J,NX,NY,RXN4,CN41,XN41,CCAX,CCA1,CCO20,CCO31 +C 2,XCAQ,CCEC0,FN4X,FCAQ,GKC4(NU(NY,NX),NY,NX),PH(0,NY,NX),CHY1,RNH4 +C 3,CN31,DPN4,ZNH4S(0,NY,NX),XNH4S(0,NY,NX),14.0*RSN4AA,RN4X +2223 FORMAT(A8,4I4,30E12.4) +C ENDIF + ELSE + RSN4AA=0.0 + RSN3AA=0.0 + RSNUAA=0.0 + RSNOAA=0.0 + RPALPX=0.0 + RPFEPX=0.0 + RPCADX=0.0 + RPCAHX=0.0 + RPCAMX=0.0 + RXN4=0.0 + RNH4=0.0 + ENDIF +C +C TOTAL ION FLUXES FOR ALL REACTIONS ABOVE +C + RN4S=RNH4-RXN4 + RN3S=-RNH4 + RHP2=-RPALPX-RPFEPX-RPCADX-2.0*RPCAMX-3.0*RPCAHX + RH2O=RPCADX+2.0*(RPALPX+RPFEPX)+6.0*RPCAHX + BNH4=-RXN4 + BH2P=RHP2 + BION=-RPCAMX-3.0*(RPALPX+RPFEPX)-2.0*RPCADX-12.0*RPCAHX +C +C CONVERT TOTAL ION FLUXES FROM CHANGES IN CONCENTRATION +C TO CHANGES IN MASS PER UNIT AREA FOR USE IN 'REDIST' +C + TRN4S(0,NY,NX)=TRN4S(0,NY,NX)+RN4S*VOLWM(NPH,0,NY,NX) + TRN3S(0,NY,NX)=TRN3S(0,NY,NX)+RN3S*VOLWM(NPH,0,NY,NX) + TRH2P(0,NY,NX)=TRH2P(0,NY,NX)+RHP2*VOLWM(NPH,0,NY,NX) + TRXN4(0,NY,NX)=TRXN4(0,NY,NX)+RXN4*VOLWM(NPH,0,NY,NX) + TRALPO(0,NY,NX)=TRALPO(0,NY,NX)+RPALPX*VOLWM(NPH,0,NY,NX) + TRFEPO(0,NY,NX)=TRFEPO(0,NY,NX)+RPFEPX*VOLWM(NPH,0,NY,NX) + TRCAPD(0,NY,NX)=TRCAPD(0,NY,NX)+RPCADX*VOLWM(NPH,0,NY,NX) + TRCAPH(0,NY,NX)=TRCAPH(0,NY,NX)+RPCAHX*VOLWM(NPH,0,NY,NX) + TRCAPM(0,NY,NX)=TRCAPM(0,NY,NX)+RPCAMX*VOLWM(NPH,0,NY,NX) + TRH2O(0,NY,NX)=TRH2O(0,NY,NX)+RH2O*VOLWM(NPH,0,NY,NX) + TBNH4(0,NY,NX)=TBNH4(0,NY,NX)+BNH4*VOLWM(NPH,0,NY,NX) + TBH2P(0,NY,NX)=TBH2P(0,NY,NX)+BH2P*VOLWM(NPH,0,NY,NX) + TBION(0,NY,NX)=TBION(0,NY,NX)+BION*VOLWM(NPH,0,NY,NX) + ZNH4FA(0,NY,NX)=ZNH4FA(0,NY,NX)-RSN4AA + ZNH3FA(0,NY,NX)=ZNH3FA(0,NY,NX)-RSN3AA + ZNHUFA(0,NY,NX)=ZNHUFA(0,NY,NX)-RSNUAA + ZNO3FA(0,NY,NX)=ZNO3FA(0,NY,NX)-RSNOAA + TRN4S(0,NY,NX)=TRN4S(0,NY,NX)+RSN4AA + TRN3S(0,NY,NX)=TRN3S(0,NY,NX)+RSN3AA+RSNUAA + TRNO3(0,NY,NX)=TRNO3(0,NY,NX)+RSNOAA + TBNH4(0,NY,NX)=TBNH4(0,NY,NX)+RSN4AA + TBNH3(0,NY,NX)=TBNH3(0,NY,NX)+RSN3AA+RSNUAA + TBNO3(0,NY,NX)=TBNO3(0,NY,NX)+RSNOAA + TRN4S(0,NY,NX)=TRN4S(0,NY,NX)*14.0 + TRN3S(0,NY,NX)=TRN3S(0,NY,NX)*14.0 + TRNO3(0,NY,NX)=TRNO3(0,NY,NX)*14.0 + TRH2P(0,NY,NX)=TRH2P(0,NY,NX)*31.0 +C WRITE(*,9989)'TRH2O',I,J,TRH2O(0,NY,NX) +C 2,RH2O,VOLWM(NPH,0,NY,NX),RPCADX,RPALPX,RPFEPX,RPCAHX +C WRITE(*,9989)'TRN4S',I,J,TRN4S(0,NY,NX) +C 2,RN4S,RNH4,RXN4,RSN4AA,VOLWM(NPH,0,NY,NX) +C 3,SPNH4,ZNH4FA(0,NY,NX) +C 4,THETW(0,NY,NX) +9989 FORMAT(A8,2I4,12E12.4) +9990 CONTINUE +9995 CONTINUE + RETURN + END diff --git a/f77src/splitc.f b/f77src/splitc.f index 56c6be9..77aa47e 100755 --- a/f77src/splitc.f +++ b/f77src/splitc.f @@ -12,8 +12,7 @@ SUBROUTINE splitc(NT,NE,NAX,NDX,NTX,NEX,NHW,NHE,NVN,NVS) character*1024 str integer nz,nx,ny,n integer :: failure - character(len=*), parameter :: modfile=__FILE__ - + character(len=*), parameter :: modfile=__FILE__ nz=1 do nx=nhw,nhe do ny=nvn,nvs @@ -24,16 +23,16 @@ SUBROUTINE splitc(NT,NE,NAX,NDX,NTX,NEX,NHW,NHE,NVN,NVS) if(datac(N+20,NE,NEX) .NE. 'NO')then close((N+30)) close((N+40)) +C call splits(NHW,NHE,NVN,NVS,OUTS(N)) call splits(NHW,NHE,NVN,NVS,outdir,OUTS(N), failure) if(failure==1)call endrun('Fail to process file '// - 2trim(outdir)//trim(OUTS(N))//' in '//trim(modfile),__LINE__) -C call splits(NHW,NHE,NVN,NVS,OUTS(N)) + 2trim(outdir)//trim(OUTS(N))//' in '//trim(modfile),__LINE__) str='rm -f ' // OUTS(N) call system (str) - call splitp(NHW,NHE,NVN,NVS,nz,outdir, OUTP(N), failure) +C call splitp(NHW,NHE,NVN,NVS,nz,OUTP(N)) + call splitp(NHW,NHE,NVN,NVS,nz,outdir, OUTP(N), failure) if(failure==1)call endrun('Fail to process file '// 2trim(outdir)//trim(OUTP(N))//' in '//trim(modfile),__LINE__) -C call splitp(NHW,NHE,NVN,NVS,nz,OUTP(N)) str = 'rm -f ' // OUTP(N) call system (str) endif diff --git a/f77src/startq.f b/f77src/startq.f index 2fb70c9..91c0e56 100755 --- a/f77src/startq.f +++ b/f77src/startq.f @@ -1,736 +1,736 @@ - SUBROUTINE startq(NHWQ,NHEQ,NVNQ,NVSQ,NZ1Q,NZ2Q) -C -C THIS SUBROUTINE INITIALIZES ALL PLANT VARIABLES -C - include "parameters.h" - include "filec.h" - include "files.h" - include "blkc.h" - include "blk1cp.h" - include "blk1cr.h" - include "blk1g.h" - include "blk1n.h" - include "blk1p.h" - include "blk1s.h" - include "blk2a.h" - include "blk2b.h" - include "blk2c.h" - include "blk3.h" - include "blk5.h" - include "blk8a.h" - include "blk8b.h" - include "blk9a.h" - include "blk9b.h" - include "blk9c.h" - include "blk11a.h" - include "blk11b.h" - include "blk12a.h" - include "blk12b.h" - include "blk14.h" - include "blk16.h" - include "blk18a.h" - include "blk18b.h" - CHARACTER*16 DATA(30),DATAP(JP,JY,JX) - CHARACTER*3 CHOICE(102,20) - CHARACTER*8 CDATE - DIMENSION CNOPC(4),CPOPC(4) -C -C INITIALIZE SHOOT GROWTH VARIABLES -C - DO 9995 NX=NHWQ,NHEQ - DO 9990 NY=NVNQ,NVSQ - NZ2X=MIN(NZ2Q,NP(NY,NX)) - DO 9985 NZ=NZ1Q,NZ2X - IF(IFLGC(NZ,NY,NX).EQ.0)THEN - IYR0(NZ,NY,NX)=IYRX(NZ,NY,NX) - IDAY0(NZ,NY,NX)=IDAYX(NZ,NY,NX) - IYRH(NZ,NY,NX)=IYRY(NZ,NY,NX) - IDAYH(NZ,NY,NX)=IDAYY(NZ,NY,NX) - PPI(NZ,NY,NX)=PPZ(NZ,NY,NX) - PPX(NZ,NY,NX)=PPI(NZ,NY,NX) - CF(NZ,NY,NX)=CFI(NZ,NY,NX) -C WRITE(*,3232)'STARTQ',IYRC,NX,NY,NZ -C 2,IDAY0(NZ,NY,NX),IYR0(NZ,NY,NX) -C 3,IDAYH(NZ,NY,NX),IYRH(NZ,NY,NX) -C 4,IYRC,IDAYX(NZ,NY,NX),IDAYY(NZ,NY,NX) -C 5,IYRX(NZ,NY,NX),IYRY(NZ,NY,NX),IFLGC(NZ,NY,NX) -C 5,PPI(NZ,NY,NX),PPX(NZ,NY,NX),CFI(NZ,NY,NX),CF(NZ,NY,NX) -3232 FORMAT(A8,15I8,20E12.4) -C IF(DATAP(NZ,NY,NX).NE.'NO')THEN - RSMH(NZ,NY,NX)=RSMX(NZ,NY,NX)/3600.0 - RCMX(NZ,NY,NX)=RSMX(NZ,NY,NX)*1.56 - CNWS(NZ,NY,NX)=2.5 - CPWS(NZ,NY,NX)=25.0 - CWSRT(NZ,NY,NX)=AMIN1(CNRT(NZ,NY,NX)*CNWS(NZ,NY,NX) - 2,CPRT(NZ,NY,NX)*CPWS(NZ,NY,NX)) - IF(ICTYP(NZ,NY,NX).EQ.3)THEN - O2I(NZ,NY,NX)=2.10E+05 - ELSE - O2I(NZ,NY,NX)=3.96E+05 - ENDIF -C -C FRACTIONS OF FOLIAR AND NON-FOLIAR LITTER ALLOCATED -C TO PROTEIN, CH2O, CELLULOSE, LIGNIN -C -C NONSTRUCTURAL -C - CFOPC(0,1,NZ,NY,NX)=0.00 - CFOPC(0,2,NZ,NY,NX)=0.67 - CFOPC(0,3,NZ,NY,NX)=0.33 - CFOPC(0,4,NZ,NY,NX)=0.00 -C -C NON-VASCULAR (E.G. MOSSES) -C - IF(IGTYP(NZ,NY,NX).EQ.0)THEN - CFOPC(1,1,NZ,NY,NX)=0.07 - CFOPC(1,2,NZ,NY,NX)=0.25 - CFOPC(1,3,NZ,NY,NX)=0.30 - CFOPC(1,4,NZ,NY,NX)=0.38 - CFOPC(2,1,NZ,NY,NX)=0.07 - CFOPC(2,2,NZ,NY,NX)=0.25 - CFOPC(2,3,NZ,NY,NX)=0.30 - CFOPC(2,4,NZ,NY,NX)=0.38 -C -C LEGUMES -C - ELSEIF(INTYP(NZ,NY,NX).NE.0)THEN - CFOPC(1,1,NZ,NY,NX)=0.16 - CFOPC(1,2,NZ,NY,NX)=0.38 - CFOPC(1,3,NZ,NY,NX)=0.34 - CFOPC(1,4,NZ,NY,NX)=0.12 - CFOPC(2,1,NZ,NY,NX)=0.07 - CFOPC(2,2,NZ,NY,NX)=0.41 - CFOPC(2,3,NZ,NY,NX)=0.37 - CFOPC(2,4,NZ,NY,NX)=0.15 -C -C ANNUALS, GRASSES, SHRUBS -C - ELSEIF(IBTYP(NZ,NY,NX).EQ.0.OR.IGTYP(NZ,NY,NX).LE.1)THEN - CFOPC(1,1,NZ,NY,NX)=0.08 - CFOPC(1,2,NZ,NY,NX)=0.41 - CFOPC(1,3,NZ,NY,NX)=0.36 - CFOPC(1,4,NZ,NY,NX)=0.15 - CFOPC(2,1,NZ,NY,NX)=0.07 - CFOPC(2,2,NZ,NY,NX)=0.41 - CFOPC(2,3,NZ,NY,NX)=0.36 - CFOPC(2,4,NZ,NY,NX)=0.16 -C -C DECIDUOUS TREES -C - ELSEIF(IBTYP(NZ,NY,NX).EQ.1.OR.IBTYP(NZ,NY,NX).EQ.3)THEN - CFOPC(1,1,NZ,NY,NX)=0.07 - CFOPC(1,2,NZ,NY,NX)=0.34 - CFOPC(1,3,NZ,NY,NX)=0.36 - CFOPC(1,4,NZ,NY,NX)=0.23 - CFOPC(2,1,NZ,NY,NX)=0.000 - CFOPC(2,2,NZ,NY,NX)=0.045 - CFOPC(2,3,NZ,NY,NX)=0.660 - CFOPC(2,4,NZ,NY,NX)=0.295 -C -C CONIFEROUS TREES -C - ELSE - CFOPC(1,1,NZ,NY,NX)=0.07 - CFOPC(1,2,NZ,NY,NX)=0.25 - CFOPC(1,3,NZ,NY,NX)=0.38 - CFOPC(1,4,NZ,NY,NX)=0.30 - CFOPC(2,1,NZ,NY,NX)=0.000 - CFOPC(2,2,NZ,NY,NX)=0.045 - CFOPC(2,3,NZ,NY,NX)=0.660 - CFOPC(2,4,NZ,NY,NX)=0.295 - ENDIF -C -C FRACTIONS OF WOODY LITTER ALLOCATED TO -C PROTEIN, CH2O, CELLULOSE, LIGNIN -C -C -C NON-VASCULAR -C - IF(IGTYP(NZ,NY,NX).EQ.0)THEN - CFOPC(3,1,NZ,NY,NX)=0.07 - CFOPC(3,2,NZ,NY,NX)=0.25 - CFOPC(3,3,NZ,NY,NX)=0.30 - CFOPC(3,4,NZ,NY,NX)=0.38 -C -C ANNUALS, GRASSES, SHRUBS -C - ELSEIF(IBTYP(NZ,NY,NX).EQ.0.OR.IGTYP(NZ,NY,NX).LE.1)THEN - CFOPC(3,1,NZ,NY,NX)=0.03 - CFOPC(3,2,NZ,NY,NX)=0.25 - CFOPC(3,3,NZ,NY,NX)=0.57 - CFOPC(3,4,NZ,NY,NX)=0.15 -C -C DECIDUOUS AND CONIFEROUS TREES -C - ELSE - CFOPC(3,1,NZ,NY,NX)=0.00 - CFOPC(3,2,NZ,NY,NX)=0.045 - CFOPC(3,3,NZ,NY,NX)=0.660 - CFOPC(3,4,NZ,NY,NX)=0.295 - ENDIF -C -C FRACTIONS OF FINE ROOT LITTER ALLOCATED TO -C PROTEIN, CH2O, CELLULOSE, LIGNIN PC&E 25:601-608 -C -C -C NON-VASCULAR -C - IF(IGTYP(NZ,NY,NX).EQ.0)THEN - CFOPC(4,1,NZ,NY,NX)=0.07 - CFOPC(4,2,NZ,NY,NX)=0.25 - CFOPC(4,3,NZ,NY,NX)=0.30 - CFOPC(4,4,NZ,NY,NX)=0.38 -C -C ANNUALS, GRASSES, SHRUBS -C - ELSEIF(IBTYP(NZ,NY,NX).EQ.0.OR.IGTYP(NZ,NY,NX).LE.1)THEN - CFOPC(4,1,NZ,NY,NX)=0.057 - CFOPC(4,2,NZ,NY,NX)=0.263 - CFOPC(4,3,NZ,NY,NX)=0.542 - CFOPC(4,4,NZ,NY,NX)=0.138 -C -C DECIDUOUS TREES -C - ELSEIF(IBTYP(NZ,NY,NX).EQ.1.OR.IBTYP(NZ,NY,NX).EQ.3)THEN - CFOPC(4,1,NZ,NY,NX)=0.059 - CFOPC(4,2,NZ,NY,NX)=0.308 - CFOPC(4,3,NZ,NY,NX)=0.464 - CFOPC(4,4,NZ,NY,NX)=0.169 -C -C CONIFEROUS TREES -C - ELSE - CFOPC(4,1,NZ,NY,NX)=0.059 - CFOPC(4,2,NZ,NY,NX)=0.308 - CFOPC(4,3,NZ,NY,NX)=0.464 - CFOPC(4,4,NZ,NY,NX)=0.169 - ENDIF -C -C COARSE WOODY LITTER FROM BOLES AND ROOTS -C - CFOPC(5,1,NZ,NY,NX)=0.00 - CFOPC(5,2,NZ,NY,NX)=0.045 - CFOPC(5,3,NZ,NY,NX)=0.660 - CFOPC(5,4,NZ,NY,NX)=0.295 -C -C N AND P FRACTIONS IN PLANT LITTER -C - CNOPC(1)=0.020 - CNOPC(2)=0.010 - CNOPC(3)=0.010 - CNOPC(4)=0.020 - CPOPC(1)=0.0020 - CPOPC(2)=0.0010 - CPOPC(3)=0.0010 - CPOPC(4)=0.0020 - DO 110 N=0,5 - CNOPCT=0.0 - CPOPCT=0.0 - DO 100 M=1,4 - CNOPCT=CNOPCT+CFOPC(N,M,NZ,NY,NX)*CNOPC(M) - CPOPCT=CPOPCT+CFOPC(N,M,NZ,NY,NX)*CPOPC(M) -100 CONTINUE - DO 105 M=1,4 - CFOPN(N,M,NZ,NY,NX)=CFOPC(N,M,NZ,NY,NX)*CNOPC(M)/CNOPCT - CFOPP(N,M,NZ,NY,NX)=CFOPC(N,M,NZ,NY,NX)*CPOPC(M)/CPOPCT -105 CONTINUE -110 CONTINUE -C -C CONCURRENT NODE GROWTH -C - IF(IBTYP(NZ,NY,NX).EQ.0.OR.IGTYP(NZ,NY,NX).LE.1)THEN - FNOD(NZ,NY,NX)=1.0 - IF(GROUPI(NZ,NY,NX).LE.10)THEN - NNOD(NZ,NY,NX)=3 - ELSEIF(GROUPI(NZ,NY,NX).LE.15)THEN - NNOD(NZ,NY,NX)=4 - ELSE - NNOD(NZ,NY,NX)=5 - ENDIF - ELSE - FNOD(NZ,NY,NX)=AMAX1(1.0,0.04/XRLA(NZ,NY,NX)) - NNOD(NZ,NY,NX)=24 - ENDIF - TCZD=5.00 - TCXD=7.50 - ZTYP(NZ,NY,NX)=ZTYPI(NZ,NY,NX) - OFFST(NZ,NY,NX)=2.667*(2.5-ZTYP(NZ,NY,NX)) - TCZ(NZ,NY,NX)=TCZD-OFFST(NZ,NY,NX) - TCX(NZ,NY,NX)=AMIN1(15.0,TCZ(NZ,NY,NX)+TCXD) - 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) - 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) - ENDIF -C -C SEED CHARACTERISTICS -C - SDVL(NZ,NY,NX)=GRDM(NZ,NY,NX)*5.0E-06 - SDLG(NZ,NY,NX)=2.0*(0.75*SDVL(NZ,NY,NX)/3.1416)**0.33 - SDAR(NZ,NY,NX)=4.0*3.1416*(SDLG(NZ,NY,NX)/2.0)**2 -C -C INITIALIZE ROOT DIMENSIONS, UPTAKE PARAMETERS -C -C IF(DATAM(NZ,NY,NX).NE.'NO')THEN - SDPTH(NZ,NY,NX)=SDPTHI(NZ,NY,NX) - DO 9795 L=NU(NY,NX),NL(NY,NX) - IF(SDPTH(NZ,NY,NX).GE.CDPTHZ(L-1,NY,NX) - 2.AND.SDPTH(NZ,NY,NX).LT.CDPTHZ(L,NY,NX))THEN - NG(NZ,NY,NX)=L - NIX(NZ,NY,NX)=L - DO 9790 NR=1,10 - NINR(NR,NZ,NY,NX)=L -9790 CONTINUE - ENDIF -9795 CONTINUE -C ELSE -C NG(NZ,NY,NX)=NU(NY,NX) -C NIX(NZ,NY,NX)=NU(NY,NX) -C DO 9785 NR=1,10 -C NINR(NR,NZ,NY,NX)=NU(NY,NX) -9785 CONTINUE -C ENDIF - CNRTS(NZ,NY,NX)=CNRT(NZ,NY,NX)*DMRT(NZ,NY,NX) - CPRTS(NZ,NY,NX)=CPRT(NZ,NY,NX)*DMRT(NZ,NY,NX) - RRAD1M(2,NZ,NY,NX)=5.0E-06 - RRAD2M(2,NZ,NY,NX)=5.0E-06 - PORT(2,NZ,NY,NX)=PORT(1,NZ,NY,NX) - UPMXZH(2,NZ,NY,NX)=UPMXZH(1,NZ,NY,NX) - UPKMZH(2,NZ,NY,NX)=UPKMZH(1,NZ,NY,NX) - UPMNZH(2,NZ,NY,NX)=UPMNZH(1,NZ,NY,NX) - UPMXZO(2,NZ,NY,NX)=UPMXZO(1,NZ,NY,NX) - UPKMZO(2,NZ,NY,NX)=UPKMZO(1,NZ,NY,NX) - UPMNZO(2,NZ,NY,NX)=UPMNZO(1,NZ,NY,NX) - UPMXPO(2,NZ,NY,NX)=UPMXPO(1,NZ,NY,NX) - UPKMPO(2,NZ,NY,NX)=UPKMPO(1,NZ,NY,NX) - UPMNPO(2,NZ,NY,NX)=UPMNPO(1,NZ,NY,NX) - RSRR(2,NZ,NY,NX)=2.5E+03 - RSRA(2,NZ,NY,NX)=1.0E+12 - DO 500 N=1,2 - PORTX(N,NZ,NY,NX)=PORT(N,NZ,NY,NX)**1.33 - RRADP(N,NZ,NY,NX)=LOG(1.0/SQRT(AMAX1(0.01,PORT(N,NZ,NY,NX)))) - DMVL(N,NZ,NY,NX)=1.0E-06/(0.05*(1.0-PORT(N,NZ,NY,NX))) - RTLG1X(N,NZ,NY,NX)=DMVL(N,NZ,NY,NX)/(3.142*RRAD1M(N,NZ,NY,NX)**2) - RTLG2X(N,NZ,NY,NX)=DMVL(N,NZ,NY,NX)/(3.142*RRAD2M(N,NZ,NY,NX)**2) - RRAD1X(N,NZ,NY,NX)=RRAD1M(N,NZ,NY,NX) - 2*SQRT(0.25*(1.0-PORT(N,NZ,NY,NX))) - RRAD2X(N,NZ,NY,NX)=RRAD2M(N,NZ,NY,NX) - 2*SQRT(0.25*(1.0-PORT(N,NZ,NY,NX))) - RTAR1X(N,NZ,NY,NX)=3.142*RRAD1X(N,NZ,NY,NX)**2 - RTAR2X(N,NZ,NY,NX)=3.142*RRAD2X(N,NZ,NY,NX)**2 -500 CONTINUE -C -C INITIALIZE PLANT PHENOLOGY -C - PP(NZ,NY,NX)=PPX(NZ,NY,NX)*AREA(3,NU(NY,NX),NY,NX) - IFLGI(NZ,NY,NX)=0 - IDTHP(NZ,NY,NX)=0 - IDTHR(NZ,NY,NX)=0 - NBT(NZ,NY,NX)=0 - NBR(NZ,NY,NX)=0 - HTCTL(NZ,NY,NX)=0.0 - ZC(NZ,NY,NX)=0.0 - DO 10 NB=1,10 - IFLGA(NB,NZ,NY,NX)=0 - IFLGE(NB,NZ,NY,NX)=1 - IFLGF(NB,NZ,NY,NX)=0 - IFLGR(NB,NZ,NY,NX)=0 - IFLGQ(NB,NZ,NY,NX)=0 - IFLGD(NB,NZ,NY,NX)=0 - GROUP(NB,NZ,NY,NX)=GROUPI(NZ,NY,NX) - PSTG(NB,NZ,NY,NX)=XTLI(NZ,NY,NX) - PSTGI(NB,NZ,NY,NX)=PSTG(NB,NZ,NY,NX) - PSTGF(NB,NZ,NY,NX)=0.0 - VSTG(NB,NZ,NY,NX)=0.0 - VSTGX(NB,NZ,NY,NX)=0.0 - KLEAF(NB,NZ,NY,NX)=1 - KLEAFX(NB,NZ,NY,NX)=1 - KVSTG(NB,NZ,NY,NX)=1 - KVSTGN(NB,NZ,NY,NX)=0 - GSTGI(NB,NZ,NY,NX)=0.0 - GSTGF(NB,NZ,NY,NX)=0.0 - TGSTGI(NB,NZ,NY,NX)=0.0 - TGSTGF(NB,NZ,NY,NX)=0.0 - VRNY(NB,NZ,NY,NX)=VRNL(NB,NZ,NY,NX)+0.5 - VRNZ(NB,NZ,NY,NX)=0.0 - VRNS(NB,NZ,NY,NX)=VRNY(NB,NZ,NY,NX) - VRNF(NB,NZ,NY,NX)=VRNZ(NB,NZ,NY,NX) - ATRP(NB,NZ,NY,NX)=0.0 - FDBK(NB,NZ,NY,NX)=1.0 - FDBKX(NB,NZ,NY,NX)=1.0 - FLG4(NB,NZ,NY,NX)=0 - FLGZ(NB,NZ,NY,NX)=0 - NBTB(NB,NZ,NY,NX)=0 - IDTHB(NB,NZ,NY,NX)=1 - DO 15 M=1,10 - IDAY(M,NB,NZ,NY,NX)=0 -15 CONTINUE -10 CONTINUE -C -C INITIALIZE PLANT MORPHOLOGY AND BIOMASS -C - WSTR(NZ,NY,NX)=0.0 - CHILL(NZ,NY,NX)=0.0 - DO 25 NB=1,10 - CPOOL(NB,NZ,NY,NX)=0.0 - ZPOOL(NB,NZ,NY,NX)=0.0 - PPOOL(NB,NZ,NY,NX)=0.0 - CPOLNB(NB,NZ,NY,NX)=0.0 - ZPOLNB(NB,NZ,NY,NX)=0.0 - PPOLNB(NB,NZ,NY,NX)=0.0 - WTSHTB(NB,NZ,NY,NX)=0.0 - WTLFB(NB,NZ,NY,NX)=0.0 - WTNDB(NB,NZ,NY,NX)=0.0 - WTSHEB(NB,NZ,NY,NX)=0.0 - WTSTKB(NB,NZ,NY,NX)=0.0 - WVSTKB(NB,NZ,NY,NX)=0.0 - WTRSVB(NB,NZ,NY,NX)=0.0 - WTHSKB(NB,NZ,NY,NX)=0.0 - WTEARB(NB,NZ,NY,NX)=0.0 - WTGRB(NB,NZ,NY,NX)=0.0 - WTLSB(NB,NZ,NY,NX)=0.0 - WTSHTN(NB,NZ,NY,NX)=0.0 - WTLFBN(NB,NZ,NY,NX)=0.0 - WTNDBN(NB,NZ,NY,NX)=0.0 - WTSHBN(NB,NZ,NY,NX)=0.0 - WTSTBN(NB,NZ,NY,NX)=0.0 - WTRSBN(NB,NZ,NY,NX)=0.0 - WTHSBN(NB,NZ,NY,NX)=0.0 - WTEABN(NB,NZ,NY,NX)=0.0 - WTGRBN(NB,NZ,NY,NX)=0.0 - WTSHTP(NB,NZ,NY,NX)=0.0 - WTLFBP(NB,NZ,NY,NX)=0.0 - WTNDBP(NB,NZ,NY,NX)=0.0 - WTSHBP(NB,NZ,NY,NX)=0.0 - WTSTBP(NB,NZ,NY,NX)=0.0 - WTRSBP(NB,NZ,NY,NX)=0.0 - WTHSBP(NB,NZ,NY,NX)=0.0 - WTEABP(NB,NZ,NY,NX)=0.0 - WTGRBP(NB,NZ,NY,NX)=0.0 - GRNXB(NB,NZ,NY,NX)=0.0 - GRNOB(NB,NZ,NY,NX)=0.0 - GRWTB(NB,NZ,NY,NX)=0.0 - ARLFB(NB,NZ,NY,NX)=0.0 - RNH3B(NB,NZ,NY,NX)=0.0 - RCZLX(NB,NZ,NY,NX)=0.0 - RCPLX(NB,NZ,NY,NX)=0.0 - RCCLX(NB,NZ,NY,NX)=0.0 - WGLFX(NB,NZ,NY,NX)=0.0 - WGLFNX(NB,NZ,NY,NX)=0.0 - WGLFPX(NB,NZ,NY,NX)=0.0 - ARLFZ(NB,NZ,NY,NX)=0.0 - RCZSX(NB,NZ,NY,NX)=0.0 - RCPSX(NB,NZ,NY,NX)=0.0 - RCCSX(NB,NZ,NY,NX)=0.0 - WTSTXB(NB,NZ,NY,NX)=0.0 - WTSTXN(NB,NZ,NY,NX)=0.0 - WTSTXP(NB,NZ,NY,NX)=0.0 - WGSHEX(NB,NZ,NY,NX)=0.0 - WGSHNX(NB,NZ,NY,NX)=0.0 - WGSHPX(NB,NZ,NY,NX)=0.0 - HTSHEX(NB,NZ,NY,NX)=0.0 - DO 5 L=1,NL(NY,NX) - ARSTK(L,NB,NZ,NY,NX)=0.0 - DO 5 N=1,4 - SURFB(N,L,NB,NZ,NY,NX)=0.0 -5 CONTINUE - DO 25 K=0,25 - ARLF(K,NB,NZ,NY,NX)=0.0 - HTNODE(K,NB,NZ,NY,NX)=0.0 - HTNODX(K,NB,NZ,NY,NX)=0.0 - HTSHE(K,NB,NZ,NY,NX)=0.0 - WGLF(K,NB,NZ,NY,NX)=0.0 - WSLF(K,NB,NZ,NY,NX)=0.0 - WGLFN(K,NB,NZ,NY,NX)=0.0 - WGLFP(K,NB,NZ,NY,NX)=0.0 - WGSHE(K,NB,NZ,NY,NX)=0.0 - WSSHE(K,NB,NZ,NY,NX)=0.0 - WGSHN(K,NB,NZ,NY,NX)=0.0 - WGSHP(K,NB,NZ,NY,NX)=0.0 - WGNODE(K,NB,NZ,NY,NX)=0.0 - WGNODN(K,NB,NZ,NY,NX)=0.0 - WGNODP(K,NB,NZ,NY,NX)=0.0 - DO 55 L=1,NL(NY,NX) - ARLFL(L,K,NB,NZ,NY,NX)=0.0 - WGLFL(L,K,NB,NZ,NY,NX)=0.0 - WGLFLN(L,K,NB,NZ,NY,NX)=0.0 - WGLFLP(L,K,NB,NZ,NY,NX)=0.0 -55 CONTINUE - IF(K.NE.0)THEN - CPOOL3(K,NB,NZ,NY,NX)=0.0 - CO2B(K,NB,NZ,NY,NX)=0.0 - HCOB(K,NB,NZ,NY,NX)=0.0 - CPOOL4(K,NB,NZ,NY,NX)=0.0 - DO 45 L=1,JC - DO 45 N=1,4 - SURF(N,L,K,NB,NZ,NY,NX)=0.0 -45 CONTINUE - ENDIF -25 CONTINUE - DO 35 L=1,NL(NY,NX) - ARLFV(L,NZ,NY,NX)=0.0 - WGLFV(L,NZ,NY,NX)=0.0 - ARSTV(L,NZ,NY,NX)=0.0 -35 CONTINUE - CPOOLP(NZ,NY,NX)=0.0 - ZPOOLP(NZ,NY,NX)=0.0 - PPOOLP(NZ,NY,NX)=0.0 - CCPOLP(NZ,NY,NX)=0.0 - CCPLNP(NZ,NY,NX)=0.0 - CZPOLP(NZ,NY,NX)=0.0 - CPPOLP(NZ,NY,NX)=0.0 - WTSHT(NZ,NY,NX)=0.0 - WTLF(NZ,NY,NX)=0.0 - WTSHE(NZ,NY,NX)=0.0 - WTSTK(NZ,NY,NX)=0.0 - WVSTK(NZ,NY,NX)=0.0 - WTRSV(NZ,NY,NX)=0.0 - WTHSK(NZ,NY,NX)=0.0 - WTEAR(NZ,NY,NX)=0.0 - WTGR(NZ,NY,NX)=0.0 - WTRT(NZ,NY,NX)=0.0 - WTRTS(NZ,NY,NX)=0.0 - WTND(NZ,NY,NX)=0.0 - WTLS(NZ,NY,NX)=0.0 - WTSHN(NZ,NY,NX)=0.0 - WTLFN(NZ,NY,NX)=0.0 - WTSHEN(NZ,NY,NX)=0.0 - WTSTKN(NZ,NY,NX)=0.0 - WTRSVN(NZ,NY,NX)=0.0 - WTHSKN(NZ,NY,NX)=0.0 - WTEARN(NZ,NY,NX)=0.0 - WTGRNN(NZ,NY,NX)=0.0 - WTNDN(NZ,NY,NX)=0.0 - WTSHP(NZ,NY,NX)=0.0 - WTLFP(NZ,NY,NX)=0.0 - WTSHEP(NZ,NY,NX)=0.0 - WTSTKP(NZ,NY,NX)=0.0 - WTRSVP(NZ,NY,NX)=0.0 - WTHSKP(NZ,NY,NX)=0.0 - WTEARP(NZ,NY,NX)=0.0 - WTGRNP(NZ,NY,NX)=0.0 - WTNDP(NZ,NY,NX)=0.0 - ARLFP(NZ,NY,NX)=0.0 - WTRTA(NZ,NY,NX)=0.0 - ARSTP(NZ,NY,NX)=0.0 -C -C INITIALIZE MASS BALANCE CHECKS -C - IF(DATA(20).EQ.'NO'.AND.IGO.EQ.0)THEN - CARBN(NZ,NY,NX)=0.0 - TCSN0(NZ,NY,NX)=0.0 - TZSN0(NZ,NY,NX)=0.0 - TPSN0(NZ,NY,NX)=0.0 - TCO2T(NZ,NY,NX)=0.0 - TCO2A(NZ,NY,NX)=0.0 - TCUPTK(NZ,NY,NX)=0.0 - TCSNC(NZ,NY,NX)=0.0 - TZUPTK(NZ,NY,NX)=0.0 - TZSNC(NZ,NY,NX)=0.0 - TPUPTK(NZ,NY,NX)=0.0 - TPSNC(NZ,NY,NX)=0.0 - TZUPFX(NZ,NY,NX)=0.0 - RNH3C(NZ,NY,NX)=0.0 - TNH3C(NZ,NY,NX)=0.0 - VCO2F(NZ,NY,NX)=0.0 - VCH4F(NZ,NY,NX)=0.0 - VOXYF(NZ,NY,NX)=0.0 - VNH3F(NZ,NY,NX)=0.0 - VN2OF(NZ,NY,NX)=0.0 - VPO4F(NZ,NY,NX)=0.0 - THVSTC(NZ,NY,NX)=0.0 - THVSTN(NZ,NY,NX)=0.0 - THVSTP(NZ,NY,NX)=0.0 - HVSTC(NZ,NY,NX)=0.0 - HVSTN(NZ,NY,NX)=0.0 - HVSTP(NZ,NY,NX)=0.0 - RSETC(NZ,NY,NX)=0.0 - RSETN(NZ,NY,NX)=0.0 - RSETP(NZ,NY,NX)=0.0 - CTRAN(NZ,NY,NX)=0.0 - WTSTG(NZ,NY,NX)=0.0 - WTSTGN(NZ,NY,NX)=0.0 - WTSTGP(NZ,NY,NX)=0.0 - WTSTDX=WTSTDI(NZ,NY,NX)*AREA(3,NU(NY,NX),NY,NX) - DO 155 M=1,4 - WTSTDG(M,NZ,NY,NX)=WTSTDX*CFOPC(5,M,NZ,NY,NX) - WTSTDN(M,NZ,NY,NX)=WTSTDX*CNSTK(NZ,NY,NX) - 2*CFOPN(5,M,NZ,NY,NX) - WTSTDP(M,NZ,NY,NX)=WTSTDX*CPSTK(NZ,NY,NX) - 2*CFOPP(5,M,NZ,NY,NX) - WTSTG(NZ,NY,NX)=WTSTG(NZ,NY,NX)+WTSTDG(M,NZ,NY,NX) - WTSTGN(NZ,NY,NX)=WTSTGN(NZ,NY,NX)+WTSTDN(M,NZ,NY,NX) - WTSTGP(NZ,NY,NX)=WTSTGP(NZ,NY,NX)+WTSTDP(M,NZ,NY,NX) -155 CONTINUE - ENDIF -C -C INITIALIZE PLANT HEAT AND WATER STATUS -C - VHCPC(NZ,NY,NX)=4.19*WTSHT(NZ,NY,NX)*10.0E-06 - ENGYX(NZ,NY,NX)=0.0 - DTKC(NZ,NY,NX)=0.0 - TCC(NZ,NY,NX)=ATCA(NY,NX) - TKC(NZ,NY,NX)=TCC(NZ,NY,NX)+273.15 - TCG(NZ,NY,NX)=TCC(NZ,NY,NX) - TKG(NZ,NY,NX)=TCG(NZ,NY,NX)+273.15 - TFN3(NZ,NY,NX)=1.0 - PSILT(NZ,NY,NX)=-1.0E-03 - PSILO(NZ,NY,NX)=OSMO(NZ,NY,NX)+PSILT(NZ,NY,NX) - PSILG(NZ,NY,NX)=AMAX1(0.0,PSILT(NZ,NY,NX)-PSILO(NZ,NY,NX)) - EP(NZ,NY,NX)=0.0 - FRADP(NZ,NY,NX)=0.0 -C -C INITIALIZE ROOT MORPHOLOGY AND BIOMASS -C - NRT(NZ,NY,NX)=0 - UPNH4(NZ,NY,NX)=0.0 - UPNO3(NZ,NY,NX)=0.0 - UPH2P(NZ,NY,NX)=0.0 - UPNF(NZ,NY,NX)=0.0 - DO 40 N=1,2 - DO 20 L=1,NL(NY,NX) - UPWTR(N,L,NZ,NY,NX)=0.0 - PSIRT(N,L,NZ,NY,NX)=-0.01 - PSIRO(N,L,NZ,NY,NX)=OSMO(NZ,NY,NX)+PSIRT(N,L,NZ,NY,NX) - PSIRG(N,L,NZ,NY,NX)=AMAX1(0.0,PSIRT(N,L,NZ,NY,NX) - 2-PSIRO(N,L,NZ,NY,NX)) - CPOOLR(N,L,NZ,NY,NX)=0.0 - ZPOOLR(N,L,NZ,NY,NX)=0.0 - PPOOLR(N,L,NZ,NY,NX)=0.0 - CCPOLR(N,L,NZ,NY,NX)=0.0 - CZPOLR(N,L,NZ,NY,NX)=0.0 - CPPOLR(N,L,NZ,NY,NX)=0.0 - CWSRTL(N,L,NZ,NY,NX)=CWSRT(NZ,NY,NX) - WTRTL(N,L,NZ,NY,NX)=0.0 - WTRTD(N,L,NZ,NY,NX)=0.0 - WSRTL(N,L,NZ,NY,NX)=0.0 - RTN1(N,L,NZ,NY,NX)=0.0 - RTNL(N,L,NZ,NY,NX)=0.0 - RTLGP(N,L,NZ,NY,NX)=0.0 - RTDNP(N,L,NZ,NY,NX)=0.0 - RTVLP(N,L,NZ,NY,NX)=0.0 - RTVLW(N,L,NZ,NY,NX)=0.0 - RRAD1(N,L,NZ,NY,NX)=RRAD1M(N,NZ,NY,NX) - RRAD2(N,L,NZ,NY,NX)=RRAD2M(N,NZ,NY,NX) - RTARP(N,L,NZ,NY,NX)=0.0 - RTLGA(N,L,NZ,NY,NX)=1.0E-03 - RUPNH4(N,L,NZ,NY,NX)=0.0 - RUPNO3(N,L,NZ,NY,NX)=0.0 - RUPH2P(N,L,NZ,NY,NX)=0.0 - RUPNHB(N,L,NZ,NY,NX)=0.0 - RUPNOB(N,L,NZ,NY,NX)=0.0 - RUPH2B(N,L,NZ,NY,NX)=0.0 - ROXYP(N,L,NZ,NY,NX)=0.0 - RUNNHP(N,L,NZ,NY,NX)=0.0 - RUNNBP(N,L,NZ,NY,NX)=0.0 - RUNNOP(N,L,NZ,NY,NX)=0.0 - RUNNXP(N,L,NZ,NY,NX)=0.0 - RUPPOP(N,L,NZ,NY,NX)=0.0 - RUPPBP(N,L,NZ,NY,NX)=0.0 - CCO2A=CCO2EI(NY,NX) - CCO2P=0.030*EXP(-2.621-0.0317*ATCA(NY,NX))*CO2EI(NY,NX) - CO2A(N,L,NZ,NY,NX)=CCO2A*RTVLP(N,L,NZ,NY,NX) - CO2P(N,L,NZ,NY,NX)=CCO2P*RTVLW(N,L,NZ,NY,NX) - RCOFLA(N,L,NZ,NY,NX)=0.0 - RCODFA(N,L,NZ,NY,NX)=0.0 - RCO2S(N,L,NZ,NY,NX)=0.0 - RCO2P(N,L,NZ,NY,NX)=0.0 - COXYA=COXYE(NY,NX) - COXYP=0.032*EXP(-6.175-0.0211*ATCA(NY,NX))*OXYE(NY,NX) - OXYA(N,L,NZ,NY,NX)=COXYA*RTVLP(N,L,NZ,NY,NX) - OXYP(N,L,NZ,NY,NX)=COXYP*RTVLW(N,L,NZ,NY,NX) - WFR(N,L,NZ,NY,NX)=1.0 - DO 30 NR=1,10 - RTN2(N,L,NR,NZ,NY,NX)=0.0 - RTLG1(N,L,NR,NZ,NY,NX)=0.0 - WTRT1(N,L,NR,NZ,NY,NX)=0.0 - WTRT1N(N,L,NR,NZ,NY,NX)=0.0 - WTRT1P(N,L,NR,NZ,NY,NX)=0.0 - RTLG2(N,L,NR,NZ,NY,NX)=0.0 - WTRT2(N,L,NR,NZ,NY,NX)=0.0 - WTRT2N(N,L,NR,NZ,NY,NX)=0.0 - WTRT2P(N,L,NR,NZ,NY,NX)=0.0 - RTDP1(N,NR,NZ,NY,NX)=SDPTH(NZ,NY,NX) - RTWT1(N,NR,NZ,NY,NX)=0.0 - RTWT1N(N,NR,NZ,NY,NX)=0.0 - RTWT1P(N,NR,NZ,NY,NX)=0.0 -30 CONTINUE - IF(N.EQ.1)THEN - DO 6400 K=0,1 - DO 6400 M=1,4 - CSNC(M,K,L,NZ,NY,NX)=0.0 - ZSNC(M,K,L,NZ,NY,NX)=0.0 - PSNC(M,K,L,NZ,NY,NX)=0.0 -6400 CONTINUE - CPOOLN(L,NZ,NY,NX)=0.0 - ZPOOLN(L,NZ,NY,NX)=0.0 - PPOOLN(L,NZ,NY,NX)=0.0 - WTNDL(L,NZ,NY,NX)=0.0 - WTNDLN(L,NZ,NY,NX)=0.0 - WTNDLP(L,NZ,NY,NX)=0.0 - RUPNF(L,NZ,NY,NX)=0.0 - ENDIF -20 CONTINUE -40 CONTINUE -C -C INITIALIZE SEED MORPHOLOGY AND BIOMASS -C - WTRVX(NZ,NY,NX)=GRDM(NZ,NY,NX)*PP(NZ,NY,NX) - WTRVC(NZ,NY,NX)=WTRVX(NZ,NY,NX) - WTRVN(NZ,NY,NX)=CNGR(NZ,NY,NX)*WTRVC(NZ,NY,NX) - WTRVP(NZ,NY,NX)=CPGR(NZ,NY,NX)*WTRVC(NZ,NY,NX) - WTLFBN(1,NZ,NY,NX)=CNGR(NZ,NY,NX)*WTLFB(1,NZ,NY,NX) - WTLFBP(1,NZ,NY,NX)=CPGR(NZ,NY,NX)*WTLFB(1,NZ,NY,NX) - WTLSB(1,NZ,NY,NX)=WTLFB(1,NZ,NY,NX)+WTSHEB(1,NZ,NY,NX) - WTLS(NZ,NY,NX)=WTLS(NZ,NY,NX)+WTLSB(1,NZ,NY,NX) - FDM=AMIN1(1.0,0.16-0.045*PSILT(NZ,NY,NX)) - VOLWP(NZ,NY,NX)=1.0E-06*WTLS(NZ,NY,NX)/FDM - VOLWC(NZ,NY,NX)=0.0 - ZPOOL(1,NZ,NY,NX)=CNGR(NZ,NY,NX)*CPOOL(1,NZ,NY,NX) - PPOOL(1,NZ,NY,NX)=CPGR(NZ,NY,NX)*CPOOL(1,NZ,NY,NX) - WTRT1N(1,NG(NZ,NY,NX),1,NZ,NY,NX)=CNGR(NZ,NY,NX) - 2*WTRT1(1,NG(NZ,NY,NX),1,NZ,NY,NX) - WTRT1P(1,NG(NZ,NY,NX),1,NZ,NY,NX)=CPGR(NZ,NY,NX) - 2*WTRT1(1,NG(NZ,NY,NX),1,NZ,NY,NX) - RTWT1N(1,1,NZ,NY,NX)=CNGR(NZ,NY,NX)*RTWT1(1,1,NZ,NY,NX) - RTWT1P(1,1,NZ,NY,NX)=CPGR(NZ,NY,NX)*RTWT1(1,1,NZ,NY,NX) - WTRTL(1,NG(NZ,NY,NX),NZ,NY,NX)=WTRT1(1,NG(NZ,NY,NX),1,NZ,NY,NX) - WTRTD(1,NG(NZ,NY,NX),NZ,NY,NX)=WTRT1(1,NG(NZ,NY,NX),1,NZ,NY,NX) - WSRTL(1,NG(NZ,NY,NX),NZ,NY,NX)=WTRTL(1,NG(NZ,NY,NX),NZ,NY,NX) - 2*CWSRT(NZ,NY,NX) - ZPOOLR(1,NG(NZ,NY,NX),NZ,NY,NX)=CNGR(NZ,NY,NX) - 2*CPOOLR(1,NG(NZ,NY,NX),NZ,NY,NX) - PPOOLR(1,NG(NZ,NY,NX),NZ,NY,NX)=CPGR(NZ,NY,NX) - 2*CPOOLR(1,NG(NZ,NY,NX),NZ,NY,NX) -C ENDIF - ENDIF - ZEROP(NZ,NY,NX)=ZERO*PP(NZ,NY,NX) - ZEROQ(NZ,NY,NX)=ZERO*PP(NZ,NY,NX)/AREA(3,NU(NY,NX),NY,NX) - ZEROL(NZ,NY,NX)=ZERO*PP(NZ,NY,NX)*1.0E+06 -9985 CONTINUE - DO 9986 NZ=NP(NY,NX)+1,5 - TCSN0(NZ,NY,NX)=0.0 - TZSN0(NZ,NY,NX)=0.0 - TPSN0(NZ,NY,NX)=0.0 - TCSNC(NZ,NY,NX)=0.0 - TZSNC(NZ,NY,NX)=0.0 - TPSNC(NZ,NY,NX)=0.0 - WTSTG(NZ,NY,NX)=0.0 - WTSTGN(NZ,NY,NX)=0.0 - WTSTGP(NZ,NY,NX)=0.0 - DO 6401 L=1,NL(NY,NX) - DO 6401 K=0,1 - DO 6401 M=1,4 - CSNC(M,K,L,NZ,NY,NX)=0.0 - ZSNC(M,K,L,NZ,NY,NX)=0.0 - PSNC(M,K,L,NZ,NY,NX)=0.0 -6401 CONTINUE -9986 CONTINUE -9990 CONTINUE -9995 CONTINUE - RETURN - END + SUBROUTINE startq(NHWQ,NHEQ,NVNQ,NVSQ,NZ1Q,NZ2Q) +C +C THIS SUBROUTINE INITIALIZES ALL PLANT VARIABLES +C + include "parameters.h" + include "filec.h" + include "files.h" + include "blkc.h" + include "blk1cp.h" + include "blk1cr.h" + include "blk1g.h" + include "blk1n.h" + include "blk1p.h" + include "blk1s.h" + include "blk2a.h" + include "blk2b.h" + include "blk2c.h" + include "blk3.h" + include "blk5.h" + include "blk8a.h" + include "blk8b.h" + include "blk9a.h" + include "blk9b.h" + include "blk9c.h" + include "blk11a.h" + include "blk11b.h" + include "blk12a.h" + include "blk12b.h" + include "blk14.h" + include "blk16.h" + include "blk18a.h" + include "blk18b.h" + CHARACTER*16 DATA(30),DATAP(JP,JY,JX) + CHARACTER*3 CHOICE(102,20) + CHARACTER*8 CDATE + DIMENSION CNOPC(4),CPOPC(4) +C +C INITIALIZE SHOOT GROWTH VARIABLES +C + DO 9995 NX=NHWQ,NHEQ + DO 9990 NY=NVNQ,NVSQ + NZ2X=MIN(NZ2Q,NP(NY,NX)) + DO 9985 NZ=NZ1Q,NZ2X + IF(IFLGC(NZ,NY,NX).EQ.0)THEN + IYR0(NZ,NY,NX)=IYRX(NZ,NY,NX) + IDAY0(NZ,NY,NX)=IDAYX(NZ,NY,NX) + IYRH(NZ,NY,NX)=IYRY(NZ,NY,NX) + IDAYH(NZ,NY,NX)=IDAYY(NZ,NY,NX) + PPI(NZ,NY,NX)=PPZ(NZ,NY,NX) + PPX(NZ,NY,NX)=PPI(NZ,NY,NX) + CF(NZ,NY,NX)=CFI(NZ,NY,NX) +C WRITE(*,3232)'STARTQ',IYRC,NX,NY,NZ +C 2,IDAY0(NZ,NY,NX),IYR0(NZ,NY,NX) +C 3,IDAYH(NZ,NY,NX),IYRH(NZ,NY,NX) +C 4,IYRC,IDAYX(NZ,NY,NX),IDAYY(NZ,NY,NX) +C 5,IYRX(NZ,NY,NX),IYRY(NZ,NY,NX),IFLGC(NZ,NY,NX) +C 5,PPI(NZ,NY,NX),PPX(NZ,NY,NX),CFI(NZ,NY,NX),CF(NZ,NY,NX) +3232 FORMAT(A8,15I8,20E12.4) +C IF(DATAP(NZ,NY,NX).NE.'NO')THEN + RSMH(NZ,NY,NX)=RSMX(NZ,NY,NX)/3600.0 + RCMX(NZ,NY,NX)=RSMX(NZ,NY,NX)*1.56 + CNWS(NZ,NY,NX)=2.5 + CPWS(NZ,NY,NX)=25.0 + CWSRT(NZ,NY,NX)=AMIN1(CNRT(NZ,NY,NX)*CNWS(NZ,NY,NX) + 2,CPRT(NZ,NY,NX)*CPWS(NZ,NY,NX)) + IF(ICTYP(NZ,NY,NX).EQ.3)THEN + O2I(NZ,NY,NX)=2.10E+05 + ELSE + O2I(NZ,NY,NX)=3.96E+05 + ENDIF +C +C FRACTIONS OF FOLIAR AND NON-FOLIAR LITTER ALLOCATED +C TO PROTEIN, CH2O, CELLULOSE, LIGNIN +C +C NONSTRUCTURAL +C + CFOPC(0,1,NZ,NY,NX)=0.00 + CFOPC(0,2,NZ,NY,NX)=0.67 + CFOPC(0,3,NZ,NY,NX)=0.33 + CFOPC(0,4,NZ,NY,NX)=0.00 +C +C NON-VASCULAR (E.G. MOSSES) +C + IF(IGTYP(NZ,NY,NX).EQ.0)THEN + CFOPC(1,1,NZ,NY,NX)=0.07 + CFOPC(1,2,NZ,NY,NX)=0.25 + CFOPC(1,3,NZ,NY,NX)=0.30 + CFOPC(1,4,NZ,NY,NX)=0.38 + CFOPC(2,1,NZ,NY,NX)=0.07 + CFOPC(2,2,NZ,NY,NX)=0.25 + CFOPC(2,3,NZ,NY,NX)=0.30 + CFOPC(2,4,NZ,NY,NX)=0.38 +C +C LEGUMES +C + ELSEIF(INTYP(NZ,NY,NX).NE.0)THEN + CFOPC(1,1,NZ,NY,NX)=0.16 + CFOPC(1,2,NZ,NY,NX)=0.38 + CFOPC(1,3,NZ,NY,NX)=0.34 + CFOPC(1,4,NZ,NY,NX)=0.12 + CFOPC(2,1,NZ,NY,NX)=0.07 + CFOPC(2,2,NZ,NY,NX)=0.41 + CFOPC(2,3,NZ,NY,NX)=0.37 + CFOPC(2,4,NZ,NY,NX)=0.15 +C +C ANNUALS, GRASSES, SHRUBS +C + ELSEIF(IBTYP(NZ,NY,NX).EQ.0.OR.IGTYP(NZ,NY,NX).LE.1)THEN + CFOPC(1,1,NZ,NY,NX)=0.08 + CFOPC(1,2,NZ,NY,NX)=0.41 + CFOPC(1,3,NZ,NY,NX)=0.36 + CFOPC(1,4,NZ,NY,NX)=0.15 + CFOPC(2,1,NZ,NY,NX)=0.07 + CFOPC(2,2,NZ,NY,NX)=0.41 + CFOPC(2,3,NZ,NY,NX)=0.36 + CFOPC(2,4,NZ,NY,NX)=0.16 +C +C DECIDUOUS TREES +C + ELSEIF(IBTYP(NZ,NY,NX).EQ.1.OR.IBTYP(NZ,NY,NX).EQ.3)THEN + CFOPC(1,1,NZ,NY,NX)=0.07 + CFOPC(1,2,NZ,NY,NX)=0.34 + CFOPC(1,3,NZ,NY,NX)=0.36 + CFOPC(1,4,NZ,NY,NX)=0.23 + CFOPC(2,1,NZ,NY,NX)=0.000 + CFOPC(2,2,NZ,NY,NX)=0.045 + CFOPC(2,3,NZ,NY,NX)=0.660 + CFOPC(2,4,NZ,NY,NX)=0.295 +C +C CONIFEROUS TREES +C + ELSE + CFOPC(1,1,NZ,NY,NX)=0.07 + CFOPC(1,2,NZ,NY,NX)=0.25 + CFOPC(1,3,NZ,NY,NX)=0.38 + CFOPC(1,4,NZ,NY,NX)=0.30 + CFOPC(2,1,NZ,NY,NX)=0.000 + CFOPC(2,2,NZ,NY,NX)=0.045 + CFOPC(2,3,NZ,NY,NX)=0.660 + CFOPC(2,4,NZ,NY,NX)=0.295 + ENDIF +C +C FRACTIONS OF WOODY LITTER ALLOCATED TO +C PROTEIN, CH2O, CELLULOSE, LIGNIN +C +C +C NON-VASCULAR +C + IF(IGTYP(NZ,NY,NX).EQ.0)THEN + CFOPC(3,1,NZ,NY,NX)=0.07 + CFOPC(3,2,NZ,NY,NX)=0.25 + CFOPC(3,3,NZ,NY,NX)=0.30 + CFOPC(3,4,NZ,NY,NX)=0.38 +C +C ANNUALS, GRASSES, SHRUBS +C + ELSEIF(IBTYP(NZ,NY,NX).EQ.0.OR.IGTYP(NZ,NY,NX).LE.1)THEN + CFOPC(3,1,NZ,NY,NX)=0.03 + CFOPC(3,2,NZ,NY,NX)=0.25 + CFOPC(3,3,NZ,NY,NX)=0.57 + CFOPC(3,4,NZ,NY,NX)=0.15 +C +C DECIDUOUS AND CONIFEROUS TREES +C + ELSE + CFOPC(3,1,NZ,NY,NX)=0.00 + CFOPC(3,2,NZ,NY,NX)=0.045 + CFOPC(3,3,NZ,NY,NX)=0.660 + CFOPC(3,4,NZ,NY,NX)=0.295 + ENDIF +C +C FRACTIONS OF FINE ROOT LITTER ALLOCATED TO +C PROTEIN, CH2O, CELLULOSE, LIGNIN PC&E 25:601-608 +C +C +C NON-VASCULAR +C + IF(IGTYP(NZ,NY,NX).EQ.0)THEN + CFOPC(4,1,NZ,NY,NX)=0.07 + CFOPC(4,2,NZ,NY,NX)=0.25 + CFOPC(4,3,NZ,NY,NX)=0.30 + CFOPC(4,4,NZ,NY,NX)=0.38 +C +C ANNUALS, GRASSES, SHRUBS +C + ELSEIF(IBTYP(NZ,NY,NX).EQ.0.OR.IGTYP(NZ,NY,NX).LE.1)THEN + CFOPC(4,1,NZ,NY,NX)=0.057 + CFOPC(4,2,NZ,NY,NX)=0.263 + CFOPC(4,3,NZ,NY,NX)=0.542 + CFOPC(4,4,NZ,NY,NX)=0.138 +C +C DECIDUOUS TREES +C + ELSEIF(IBTYP(NZ,NY,NX).EQ.1.OR.IBTYP(NZ,NY,NX).EQ.3)THEN + CFOPC(4,1,NZ,NY,NX)=0.059 + CFOPC(4,2,NZ,NY,NX)=0.308 + CFOPC(4,3,NZ,NY,NX)=0.464 + CFOPC(4,4,NZ,NY,NX)=0.169 +C +C CONIFEROUS TREES +C + ELSE + CFOPC(4,1,NZ,NY,NX)=0.059 + CFOPC(4,2,NZ,NY,NX)=0.308 + CFOPC(4,3,NZ,NY,NX)=0.464 + CFOPC(4,4,NZ,NY,NX)=0.169 + ENDIF +C +C COARSE WOODY LITTER FROM BOLES AND ROOTS +C + CFOPC(5,1,NZ,NY,NX)=0.00 + CFOPC(5,2,NZ,NY,NX)=0.045 + CFOPC(5,3,NZ,NY,NX)=0.660 + CFOPC(5,4,NZ,NY,NX)=0.295 +C +C N AND P FRACTIONS IN PLANT LITTER +C + CNOPC(1)=0.020 + CNOPC(2)=0.010 + CNOPC(3)=0.010 + CNOPC(4)=0.020 + CPOPC(1)=0.0020 + CPOPC(2)=0.0010 + CPOPC(3)=0.0010 + CPOPC(4)=0.0020 + DO 110 N=0,5 + CNOPCT=0.0 + CPOPCT=0.0 + DO 100 M=1,4 + CNOPCT=CNOPCT+CFOPC(N,M,NZ,NY,NX)*CNOPC(M) + CPOPCT=CPOPCT+CFOPC(N,M,NZ,NY,NX)*CPOPC(M) +100 CONTINUE + DO 105 M=1,4 + CFOPN(N,M,NZ,NY,NX)=CFOPC(N,M,NZ,NY,NX)*CNOPC(M)/CNOPCT + CFOPP(N,M,NZ,NY,NX)=CFOPC(N,M,NZ,NY,NX)*CPOPC(M)/CPOPCT +105 CONTINUE +110 CONTINUE +C +C CONCURRENT NODE GROWTH +C + IF(IBTYP(NZ,NY,NX).EQ.0.OR.IGTYP(NZ,NY,NX).LE.1)THEN + FNOD(NZ,NY,NX)=1.0 + IF(GROUPI(NZ,NY,NX).LE.10)THEN + NNOD(NZ,NY,NX)=3 + ELSEIF(GROUPI(NZ,NY,NX).LE.15)THEN + NNOD(NZ,NY,NX)=4 + ELSE + NNOD(NZ,NY,NX)=5 + ENDIF + ELSE + FNOD(NZ,NY,NX)=AMAX1(1.0,0.04/XRLA(NZ,NY,NX)) + NNOD(NZ,NY,NX)=24 + ENDIF + TCZD=5.00 + TCXD=12.00 + ZTYP(NZ,NY,NX)=ZTYPI(NZ,NY,NX) + OFFST(NZ,NY,NX)=2.667*(2.5-ZTYP(NZ,NY,NX)) + TCZ(NZ,NY,NX)=TCZD-OFFST(NZ,NY,NX) + 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) + 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) + ENDIF +C +C SEED CHARACTERISTICS +C + SDVL(NZ,NY,NX)=GRDM(NZ,NY,NX)*5.0E-06 + SDLG(NZ,NY,NX)=2.0*(0.75*SDVL(NZ,NY,NX)/3.1416)**0.33 + SDAR(NZ,NY,NX)=4.0*3.1416*(SDLG(NZ,NY,NX)/2.0)**2 +C +C INITIALIZE ROOT DIMENSIONS, UPTAKE PARAMETERS +C +C IF(DATAM(NZ,NY,NX).NE.'NO')THEN + SDPTH(NZ,NY,NX)=SDPTHI(NZ,NY,NX) + DO 9795 L=NU(NY,NX),NL(NY,NX) + IF(SDPTH(NZ,NY,NX).GE.CDPTHZ(L-1,NY,NX) + 2.AND.SDPTH(NZ,NY,NX).LT.CDPTHZ(L,NY,NX))THEN + NG(NZ,NY,NX)=L + NIX(NZ,NY,NX)=L + DO 9790 NR=1,10 + NINR(NR,NZ,NY,NX)=L +9790 CONTINUE + ENDIF +9795 CONTINUE +C ELSE +C NG(NZ,NY,NX)=NU(NY,NX) +C NIX(NZ,NY,NX)=NU(NY,NX) +C DO 9785 NR=1,10 +C NINR(NR,NZ,NY,NX)=NU(NY,NX) +9785 CONTINUE +C ENDIF + CNRTS(NZ,NY,NX)=CNRT(NZ,NY,NX)*DMRT(NZ,NY,NX) + CPRTS(NZ,NY,NX)=CPRT(NZ,NY,NX)*DMRT(NZ,NY,NX) + RRAD1M(2,NZ,NY,NX)=5.0E-06 + RRAD2M(2,NZ,NY,NX)=5.0E-06 + PORT(2,NZ,NY,NX)=PORT(1,NZ,NY,NX) + UPMXZH(2,NZ,NY,NX)=UPMXZH(1,NZ,NY,NX) + UPKMZH(2,NZ,NY,NX)=UPKMZH(1,NZ,NY,NX) + UPMNZH(2,NZ,NY,NX)=UPMNZH(1,NZ,NY,NX) + UPMXZO(2,NZ,NY,NX)=UPMXZO(1,NZ,NY,NX) + UPKMZO(2,NZ,NY,NX)=UPKMZO(1,NZ,NY,NX) + UPMNZO(2,NZ,NY,NX)=UPMNZO(1,NZ,NY,NX) + UPMXPO(2,NZ,NY,NX)=UPMXPO(1,NZ,NY,NX) + UPKMPO(2,NZ,NY,NX)=UPKMPO(1,NZ,NY,NX) + UPMNPO(2,NZ,NY,NX)=UPMNPO(1,NZ,NY,NX) + RSRR(2,NZ,NY,NX)=2.5E+03 + RSRA(2,NZ,NY,NX)=1.0E+12 + DO 500 N=1,2 + PORTX(N,NZ,NY,NX)=PORT(N,NZ,NY,NX)**1.33 + RRADP(N,NZ,NY,NX)=LOG(1.0/SQRT(AMAX1(0.01,PORT(N,NZ,NY,NX)))) + DMVL(N,NZ,NY,NX)=1.0E-06/(0.05*(1.0-PORT(N,NZ,NY,NX))) + RTLG1X(N,NZ,NY,NX)=DMVL(N,NZ,NY,NX)/(3.142*RRAD1M(N,NZ,NY,NX)**2) + RTLG2X(N,NZ,NY,NX)=DMVL(N,NZ,NY,NX)/(3.142*RRAD2M(N,NZ,NY,NX)**2) + RRAD1X(N,NZ,NY,NX)=RRAD1M(N,NZ,NY,NX) +C 2*SQRT(0.25*(1.0-PORT(N,NZ,NY,NX))) + RRAD2X(N,NZ,NY,NX)=RRAD2M(N,NZ,NY,NX) +C 2*SQRT(0.25*(1.0-PORT(N,NZ,NY,NX))) + RTAR1X(N,NZ,NY,NX)=3.142*RRAD1X(N,NZ,NY,NX)**2 + RTAR2X(N,NZ,NY,NX)=3.142*RRAD2X(N,NZ,NY,NX)**2 +500 CONTINUE +C +C INITIALIZE PLANT PHENOLOGY +C + PP(NZ,NY,NX)=PPX(NZ,NY,NX)*AREA(3,NU(NY,NX),NY,NX) + IFLGI(NZ,NY,NX)=0 + IDTHP(NZ,NY,NX)=0 + IDTHR(NZ,NY,NX)=0 + NBT(NZ,NY,NX)=0 + NBR(NZ,NY,NX)=0 + HTCTL(NZ,NY,NX)=0.0 + ZC(NZ,NY,NX)=0.0 + DO 10 NB=1,10 + IFLGA(NB,NZ,NY,NX)=0 + IFLGE(NB,NZ,NY,NX)=0 + IFLGF(NB,NZ,NY,NX)=0 + IFLGR(NB,NZ,NY,NX)=0 + IFLGQ(NB,NZ,NY,NX)=0 + IFLGD(NB,NZ,NY,NX)=0 + GROUP(NB,NZ,NY,NX)=GROUPI(NZ,NY,NX) + PSTG(NB,NZ,NY,NX)=XTLI(NZ,NY,NX) + PSTGI(NB,NZ,NY,NX)=PSTG(NB,NZ,NY,NX) + PSTGF(NB,NZ,NY,NX)=0.0 + VSTG(NB,NZ,NY,NX)=0.0 + VSTGX(NB,NZ,NY,NX)=0.0 + KLEAF(NB,NZ,NY,NX)=1 + KLEAFX(NB,NZ,NY,NX)=1 + KVSTG(NB,NZ,NY,NX)=1 + KVSTGN(NB,NZ,NY,NX)=0 + GSTGI(NB,NZ,NY,NX)=0.0 + GSTGF(NB,NZ,NY,NX)=0.0 + TGSTGI(NB,NZ,NY,NX)=0.0 + TGSTGF(NB,NZ,NY,NX)=0.0 + VRNY(NB,NZ,NY,NX)=0.0 + VRNZ(NB,NZ,NY,NX)=0.0 + VRNS(NB,NZ,NY,NX)=VRNY(NB,NZ,NY,NX) + VRNF(NB,NZ,NY,NX)=VRNZ(NB,NZ,NY,NX) + ATRP(NB,NZ,NY,NX)=0.0 + FDBK(NB,NZ,NY,NX)=1.0 + FDBKX(NB,NZ,NY,NX)=1.0 + FLG4(NB,NZ,NY,NX)=0 + FLGZ(NB,NZ,NY,NX)=0 + NBTB(NB,NZ,NY,NX)=0 + IDTHB(NB,NZ,NY,NX)=1 + DO 15 M=1,10 + IDAY(M,NB,NZ,NY,NX)=0 +15 CONTINUE +10 CONTINUE +C +C INITIALIZE PLANT MORPHOLOGY AND BIOMASS +C + WSTR(NZ,NY,NX)=0.0 + CHILL(NZ,NY,NX)=0.0 + DO 25 NB=1,10 + CPOOL(NB,NZ,NY,NX)=0.0 + ZPOOL(NB,NZ,NY,NX)=0.0 + PPOOL(NB,NZ,NY,NX)=0.0 + CPOLNB(NB,NZ,NY,NX)=0.0 + ZPOLNB(NB,NZ,NY,NX)=0.0 + PPOLNB(NB,NZ,NY,NX)=0.0 + WTSHTB(NB,NZ,NY,NX)=0.0 + WTLFB(NB,NZ,NY,NX)=0.0 + WTNDB(NB,NZ,NY,NX)=0.0 + WTSHEB(NB,NZ,NY,NX)=0.0 + WTSTKB(NB,NZ,NY,NX)=0.0 + WVSTKB(NB,NZ,NY,NX)=0.0 + WTRSVB(NB,NZ,NY,NX)=0.0 + WTHSKB(NB,NZ,NY,NX)=0.0 + WTEARB(NB,NZ,NY,NX)=0.0 + WTGRB(NB,NZ,NY,NX)=0.0 + WTLSB(NB,NZ,NY,NX)=0.0 + WTSHTN(NB,NZ,NY,NX)=0.0 + WTLFBN(NB,NZ,NY,NX)=0.0 + WTNDBN(NB,NZ,NY,NX)=0.0 + WTSHBN(NB,NZ,NY,NX)=0.0 + WTSTBN(NB,NZ,NY,NX)=0.0 + WTRSBN(NB,NZ,NY,NX)=0.0 + WTHSBN(NB,NZ,NY,NX)=0.0 + WTEABN(NB,NZ,NY,NX)=0.0 + WTGRBN(NB,NZ,NY,NX)=0.0 + WTSHTP(NB,NZ,NY,NX)=0.0 + WTLFBP(NB,NZ,NY,NX)=0.0 + WTNDBP(NB,NZ,NY,NX)=0.0 + WTSHBP(NB,NZ,NY,NX)=0.0 + WTSTBP(NB,NZ,NY,NX)=0.0 + WTRSBP(NB,NZ,NY,NX)=0.0 + WTHSBP(NB,NZ,NY,NX)=0.0 + WTEABP(NB,NZ,NY,NX)=0.0 + WTGRBP(NB,NZ,NY,NX)=0.0 + GRNXB(NB,NZ,NY,NX)=0.0 + GRNOB(NB,NZ,NY,NX)=0.0 + GRWTB(NB,NZ,NY,NX)=0.0 + ARLFB(NB,NZ,NY,NX)=0.0 + RNH3B(NB,NZ,NY,NX)=0.0 + RCZLX(NB,NZ,NY,NX)=0.0 + RCPLX(NB,NZ,NY,NX)=0.0 + RCCLX(NB,NZ,NY,NX)=0.0 + WGLFX(NB,NZ,NY,NX)=0.0 + WGLFNX(NB,NZ,NY,NX)=0.0 + WGLFPX(NB,NZ,NY,NX)=0.0 + ARLFZ(NB,NZ,NY,NX)=0.0 + RCZSX(NB,NZ,NY,NX)=0.0 + RCPSX(NB,NZ,NY,NX)=0.0 + RCCSX(NB,NZ,NY,NX)=0.0 + WTSTXB(NB,NZ,NY,NX)=0.0 + WTSTXN(NB,NZ,NY,NX)=0.0 + WTSTXP(NB,NZ,NY,NX)=0.0 + WGSHEX(NB,NZ,NY,NX)=0.0 + WGSHNX(NB,NZ,NY,NX)=0.0 + WGSHPX(NB,NZ,NY,NX)=0.0 + HTSHEX(NB,NZ,NY,NX)=0.0 + DO 5 L=1,NL(NY,NX) + ARSTK(L,NB,NZ,NY,NX)=0.0 + DO 5 N=1,4 + SURFB(N,L,NB,NZ,NY,NX)=0.0 +5 CONTINUE + DO 25 K=0,25 + ARLF(K,NB,NZ,NY,NX)=0.0 + HTNODE(K,NB,NZ,NY,NX)=0.0 + HTNODX(K,NB,NZ,NY,NX)=0.0 + HTSHE(K,NB,NZ,NY,NX)=0.0 + WGLF(K,NB,NZ,NY,NX)=0.0 + WSLF(K,NB,NZ,NY,NX)=0.0 + WGLFN(K,NB,NZ,NY,NX)=0.0 + WGLFP(K,NB,NZ,NY,NX)=0.0 + WGSHE(K,NB,NZ,NY,NX)=0.0 + WSSHE(K,NB,NZ,NY,NX)=0.0 + WGSHN(K,NB,NZ,NY,NX)=0.0 + WGSHP(K,NB,NZ,NY,NX)=0.0 + WGNODE(K,NB,NZ,NY,NX)=0.0 + WGNODN(K,NB,NZ,NY,NX)=0.0 + WGNODP(K,NB,NZ,NY,NX)=0.0 + DO 55 L=1,NL(NY,NX) + ARLFL(L,K,NB,NZ,NY,NX)=0.0 + WGLFL(L,K,NB,NZ,NY,NX)=0.0 + WGLFLN(L,K,NB,NZ,NY,NX)=0.0 + WGLFLP(L,K,NB,NZ,NY,NX)=0.0 +55 CONTINUE + IF(K.NE.0)THEN + CPOOL3(K,NB,NZ,NY,NX)=0.0 + CO2B(K,NB,NZ,NY,NX)=0.0 + HCOB(K,NB,NZ,NY,NX)=0.0 + CPOOL4(K,NB,NZ,NY,NX)=0.0 + DO 45 L=1,JC + DO 45 N=1,4 + SURF(N,L,K,NB,NZ,NY,NX)=0.0 +45 CONTINUE + ENDIF +25 CONTINUE + DO 35 L=1,NL(NY,NX) + ARLFV(L,NZ,NY,NX)=0.0 + WGLFV(L,NZ,NY,NX)=0.0 + ARSTV(L,NZ,NY,NX)=0.0 +35 CONTINUE + CPOOLP(NZ,NY,NX)=0.0 + ZPOOLP(NZ,NY,NX)=0.0 + PPOOLP(NZ,NY,NX)=0.0 + CCPOLP(NZ,NY,NX)=0.0 + CCPLNP(NZ,NY,NX)=0.0 + CZPOLP(NZ,NY,NX)=0.0 + CPPOLP(NZ,NY,NX)=0.0 + WTSHT(NZ,NY,NX)=0.0 + WTLF(NZ,NY,NX)=0.0 + WTSHE(NZ,NY,NX)=0.0 + WTSTK(NZ,NY,NX)=0.0 + WVSTK(NZ,NY,NX)=0.0 + WTRSV(NZ,NY,NX)=0.0 + WTHSK(NZ,NY,NX)=0.0 + WTEAR(NZ,NY,NX)=0.0 + WTGR(NZ,NY,NX)=0.0 + WTRT(NZ,NY,NX)=0.0 + WTRTS(NZ,NY,NX)=0.0 + WTND(NZ,NY,NX)=0.0 + WTLS(NZ,NY,NX)=0.0 + WTSHN(NZ,NY,NX)=0.0 + WTLFN(NZ,NY,NX)=0.0 + WTSHEN(NZ,NY,NX)=0.0 + WTSTKN(NZ,NY,NX)=0.0 + WTRSVN(NZ,NY,NX)=0.0 + WTHSKN(NZ,NY,NX)=0.0 + WTEARN(NZ,NY,NX)=0.0 + WTGRNN(NZ,NY,NX)=0.0 + WTNDN(NZ,NY,NX)=0.0 + WTSHP(NZ,NY,NX)=0.0 + WTLFP(NZ,NY,NX)=0.0 + WTSHEP(NZ,NY,NX)=0.0 + WTSTKP(NZ,NY,NX)=0.0 + WTRSVP(NZ,NY,NX)=0.0 + WTHSKP(NZ,NY,NX)=0.0 + WTEARP(NZ,NY,NX)=0.0 + WTGRNP(NZ,NY,NX)=0.0 + WTNDP(NZ,NY,NX)=0.0 + ARLFP(NZ,NY,NX)=0.0 + WTRTA(NZ,NY,NX)=0.0 + ARSTP(NZ,NY,NX)=0.0 +C +C INITIALIZE MASS BALANCE CHECKS +C + IF(DATA(20).EQ.'NO'.AND.IGO.EQ.0)THEN + CARBN(NZ,NY,NX)=0.0 + TCSN0(NZ,NY,NX)=0.0 + TZSN0(NZ,NY,NX)=0.0 + TPSN0(NZ,NY,NX)=0.0 + TCO2T(NZ,NY,NX)=0.0 + TCO2A(NZ,NY,NX)=0.0 + TCUPTK(NZ,NY,NX)=0.0 + TCSNC(NZ,NY,NX)=0.0 + TZUPTK(NZ,NY,NX)=0.0 + TZSNC(NZ,NY,NX)=0.0 + TPUPTK(NZ,NY,NX)=0.0 + TPSNC(NZ,NY,NX)=0.0 + TZUPFX(NZ,NY,NX)=0.0 + RNH3C(NZ,NY,NX)=0.0 + TNH3C(NZ,NY,NX)=0.0 + VCO2F(NZ,NY,NX)=0.0 + VCH4F(NZ,NY,NX)=0.0 + VOXYF(NZ,NY,NX)=0.0 + VNH3F(NZ,NY,NX)=0.0 + VN2OF(NZ,NY,NX)=0.0 + VPO4F(NZ,NY,NX)=0.0 + THVSTC(NZ,NY,NX)=0.0 + THVSTN(NZ,NY,NX)=0.0 + THVSTP(NZ,NY,NX)=0.0 + HVSTC(NZ,NY,NX)=0.0 + HVSTN(NZ,NY,NX)=0.0 + HVSTP(NZ,NY,NX)=0.0 + RSETC(NZ,NY,NX)=0.0 + RSETN(NZ,NY,NX)=0.0 + RSETP(NZ,NY,NX)=0.0 + CTRAN(NZ,NY,NX)=0.0 + WTSTG(NZ,NY,NX)=0.0 + WTSTGN(NZ,NY,NX)=0.0 + WTSTGP(NZ,NY,NX)=0.0 + WTSTDX=WTSTDI(NZ,NY,NX)*AREA(3,NU(NY,NX),NY,NX) + DO 155 M=1,4 + WTSTDG(M,NZ,NY,NX)=WTSTDX*CFOPC(5,M,NZ,NY,NX) + WTSTDN(M,NZ,NY,NX)=WTSTDX*CNSTK(NZ,NY,NX) + 2*CFOPN(5,M,NZ,NY,NX) + WTSTDP(M,NZ,NY,NX)=WTSTDX*CPSTK(NZ,NY,NX) + 2*CFOPP(5,M,NZ,NY,NX) + WTSTG(NZ,NY,NX)=WTSTG(NZ,NY,NX)+WTSTDG(M,NZ,NY,NX) + WTSTGN(NZ,NY,NX)=WTSTGN(NZ,NY,NX)+WTSTDN(M,NZ,NY,NX) + WTSTGP(NZ,NY,NX)=WTSTGP(NZ,NY,NX)+WTSTDP(M,NZ,NY,NX) +155 CONTINUE + ENDIF +C +C INITIALIZE PLANT HEAT AND WATER STATUS +C + VHCPC(NZ,NY,NX)=4.19*WTSHT(NZ,NY,NX)*10.0E-06 + ENGYX(NZ,NY,NX)=0.0 + DTKC(NZ,NY,NX)=0.0 + TCC(NZ,NY,NX)=ATCA(NY,NX) + TKC(NZ,NY,NX)=TCC(NZ,NY,NX)+273.15 + TCG(NZ,NY,NX)=TCC(NZ,NY,NX) + TKG(NZ,NY,NX)=TCG(NZ,NY,NX)+273.15 + TFN3(NZ,NY,NX)=1.0 + PSILT(NZ,NY,NX)=-1.0E-03 + PSILO(NZ,NY,NX)=OSMO(NZ,NY,NX)+PSILT(NZ,NY,NX) + PSILG(NZ,NY,NX)=AMAX1(0.0,PSILT(NZ,NY,NX)-PSILO(NZ,NY,NX)) + EP(NZ,NY,NX)=0.0 + FRADP(NZ,NY,NX)=0.0 +C +C INITIALIZE ROOT MORPHOLOGY AND BIOMASS +C + NRT(NZ,NY,NX)=0 + UPNH4(NZ,NY,NX)=0.0 + UPNO3(NZ,NY,NX)=0.0 + UPH2P(NZ,NY,NX)=0.0 + UPNF(NZ,NY,NX)=0.0 + DO 40 N=1,2 + DO 20 L=1,NL(NY,NX) + UPWTR(N,L,NZ,NY,NX)=0.0 + PSIRT(N,L,NZ,NY,NX)=-0.01 + PSIRO(N,L,NZ,NY,NX)=OSMO(NZ,NY,NX)+PSIRT(N,L,NZ,NY,NX) + PSIRG(N,L,NZ,NY,NX)=AMAX1(0.0,PSIRT(N,L,NZ,NY,NX) + 2-PSIRO(N,L,NZ,NY,NX)) + CPOOLR(N,L,NZ,NY,NX)=0.0 + ZPOOLR(N,L,NZ,NY,NX)=0.0 + PPOOLR(N,L,NZ,NY,NX)=0.0 + CCPOLR(N,L,NZ,NY,NX)=0.0 + CZPOLR(N,L,NZ,NY,NX)=0.0 + CPPOLR(N,L,NZ,NY,NX)=0.0 + CWSRTL(N,L,NZ,NY,NX)=CWSRT(NZ,NY,NX) + WTRTL(N,L,NZ,NY,NX)=0.0 + WTRTD(N,L,NZ,NY,NX)=0.0 + WSRTL(N,L,NZ,NY,NX)=0.0 + RTN1(N,L,NZ,NY,NX)=0.0 + RTNL(N,L,NZ,NY,NX)=0.0 + RTLGP(N,L,NZ,NY,NX)=0.0 + RTDNP(N,L,NZ,NY,NX)=0.0 + RTVLP(N,L,NZ,NY,NX)=0.0 + RTVLW(N,L,NZ,NY,NX)=0.0 + RRAD1(N,L,NZ,NY,NX)=RRAD1M(N,NZ,NY,NX) + RRAD2(N,L,NZ,NY,NX)=RRAD2M(N,NZ,NY,NX) + RTARP(N,L,NZ,NY,NX)=0.0 + RTLGA(N,L,NZ,NY,NX)=1.0E-03 + RUPNH4(N,L,NZ,NY,NX)=0.0 + RUPNO3(N,L,NZ,NY,NX)=0.0 + RUPH2P(N,L,NZ,NY,NX)=0.0 + RUPNHB(N,L,NZ,NY,NX)=0.0 + RUPNOB(N,L,NZ,NY,NX)=0.0 + RUPH2B(N,L,NZ,NY,NX)=0.0 + ROXYP(N,L,NZ,NY,NX)=0.0 + RUNNHP(N,L,NZ,NY,NX)=0.0 + RUNNBP(N,L,NZ,NY,NX)=0.0 + RUNNOP(N,L,NZ,NY,NX)=0.0 + RUNNXP(N,L,NZ,NY,NX)=0.0 + RUPPOP(N,L,NZ,NY,NX)=0.0 + RUPPBP(N,L,NZ,NY,NX)=0.0 + CCO2A=CCO2EI(NY,NX) + CCO2P=0.030*EXP(-2.621-0.0317*ATCA(NY,NX))*CO2EI(NY,NX) + CO2A(N,L,NZ,NY,NX)=CCO2A*RTVLP(N,L,NZ,NY,NX) + CO2P(N,L,NZ,NY,NX)=CCO2P*RTVLW(N,L,NZ,NY,NX) + RCOFLA(N,L,NZ,NY,NX)=0.0 + RCODFA(N,L,NZ,NY,NX)=0.0 + RCO2S(N,L,NZ,NY,NX)=0.0 + RCO2P(N,L,NZ,NY,NX)=0.0 + COXYA=COXYE(NY,NX) + COXYP=0.032*EXP(-6.175-0.0211*ATCA(NY,NX))*OXYE(NY,NX) + OXYA(N,L,NZ,NY,NX)=COXYA*RTVLP(N,L,NZ,NY,NX) + OXYP(N,L,NZ,NY,NX)=COXYP*RTVLW(N,L,NZ,NY,NX) + WFR(N,L,NZ,NY,NX)=1.0 + DO 30 NR=1,10 + RTN2(N,L,NR,NZ,NY,NX)=0.0 + RTLG1(N,L,NR,NZ,NY,NX)=0.0 + WTRT1(N,L,NR,NZ,NY,NX)=0.0 + WTRT1N(N,L,NR,NZ,NY,NX)=0.0 + WTRT1P(N,L,NR,NZ,NY,NX)=0.0 + RTLG2(N,L,NR,NZ,NY,NX)=0.0 + WTRT2(N,L,NR,NZ,NY,NX)=0.0 + WTRT2N(N,L,NR,NZ,NY,NX)=0.0 + WTRT2P(N,L,NR,NZ,NY,NX)=0.0 + RTDP1(N,NR,NZ,NY,NX)=SDPTH(NZ,NY,NX) + RTWT1(N,NR,NZ,NY,NX)=0.0 + RTWT1N(N,NR,NZ,NY,NX)=0.0 + RTWT1P(N,NR,NZ,NY,NX)=0.0 +30 CONTINUE + IF(N.EQ.1)THEN + DO 6400 K=0,1 + DO 6400 M=1,4 + CSNC(M,K,L,NZ,NY,NX)=0.0 + ZSNC(M,K,L,NZ,NY,NX)=0.0 + PSNC(M,K,L,NZ,NY,NX)=0.0 +6400 CONTINUE + CPOOLN(L,NZ,NY,NX)=0.0 + ZPOOLN(L,NZ,NY,NX)=0.0 + PPOOLN(L,NZ,NY,NX)=0.0 + WTNDL(L,NZ,NY,NX)=0.0 + WTNDLN(L,NZ,NY,NX)=0.0 + WTNDLP(L,NZ,NY,NX)=0.0 + RUPNF(L,NZ,NY,NX)=0.0 + ENDIF +20 CONTINUE +40 CONTINUE +C +C INITIALIZE SEED MORPHOLOGY AND BIOMASS +C + WTRVX(NZ,NY,NX)=GRDM(NZ,NY,NX)*PP(NZ,NY,NX) + WTRVC(NZ,NY,NX)=WTRVX(NZ,NY,NX) + WTRVN(NZ,NY,NX)=CNGR(NZ,NY,NX)*WTRVC(NZ,NY,NX) + WTRVP(NZ,NY,NX)=CPGR(NZ,NY,NX)*WTRVC(NZ,NY,NX) + WTLFBN(1,NZ,NY,NX)=CNGR(NZ,NY,NX)*WTLFB(1,NZ,NY,NX) + WTLFBP(1,NZ,NY,NX)=CPGR(NZ,NY,NX)*WTLFB(1,NZ,NY,NX) + WTLSB(1,NZ,NY,NX)=WTLFB(1,NZ,NY,NX)+WTSHEB(1,NZ,NY,NX) + WTLS(NZ,NY,NX)=WTLS(NZ,NY,NX)+WTLSB(1,NZ,NY,NX) + FDM=AMIN1(1.0,0.16-0.045*PSILT(NZ,NY,NX)) + VOLWP(NZ,NY,NX)=1.0E-06*WTLS(NZ,NY,NX)/FDM + VOLWC(NZ,NY,NX)=0.0 + ZPOOL(1,NZ,NY,NX)=CNGR(NZ,NY,NX)*CPOOL(1,NZ,NY,NX) + PPOOL(1,NZ,NY,NX)=CPGR(NZ,NY,NX)*CPOOL(1,NZ,NY,NX) + WTRT1N(1,NG(NZ,NY,NX),1,NZ,NY,NX)=CNGR(NZ,NY,NX) + 2*WTRT1(1,NG(NZ,NY,NX),1,NZ,NY,NX) + WTRT1P(1,NG(NZ,NY,NX),1,NZ,NY,NX)=CPGR(NZ,NY,NX) + 2*WTRT1(1,NG(NZ,NY,NX),1,NZ,NY,NX) + RTWT1N(1,1,NZ,NY,NX)=CNGR(NZ,NY,NX)*RTWT1(1,1,NZ,NY,NX) + RTWT1P(1,1,NZ,NY,NX)=CPGR(NZ,NY,NX)*RTWT1(1,1,NZ,NY,NX) + WTRTL(1,NG(NZ,NY,NX),NZ,NY,NX)=WTRT1(1,NG(NZ,NY,NX),1,NZ,NY,NX) + WTRTD(1,NG(NZ,NY,NX),NZ,NY,NX)=WTRT1(1,NG(NZ,NY,NX),1,NZ,NY,NX) + WSRTL(1,NG(NZ,NY,NX),NZ,NY,NX)=WTRTL(1,NG(NZ,NY,NX),NZ,NY,NX) + 2*CWSRT(NZ,NY,NX) + ZPOOLR(1,NG(NZ,NY,NX),NZ,NY,NX)=CNGR(NZ,NY,NX) + 2*CPOOLR(1,NG(NZ,NY,NX),NZ,NY,NX) + PPOOLR(1,NG(NZ,NY,NX),NZ,NY,NX)=CPGR(NZ,NY,NX) + 2*CPOOLR(1,NG(NZ,NY,NX),NZ,NY,NX) +C ENDIF + ENDIF + ZEROP(NZ,NY,NX)=ZERO*PP(NZ,NY,NX) + ZEROQ(NZ,NY,NX)=ZERO*PP(NZ,NY,NX)/AREA(3,NU(NY,NX),NY,NX) + ZEROL(NZ,NY,NX)=ZERO*PP(NZ,NY,NX)*1.0E+06 +9985 CONTINUE + DO 9986 NZ=NP(NY,NX)+1,5 + TCSN0(NZ,NY,NX)=0.0 + TZSN0(NZ,NY,NX)=0.0 + TPSN0(NZ,NY,NX)=0.0 + TCSNC(NZ,NY,NX)=0.0 + TZSNC(NZ,NY,NX)=0.0 + TPSNC(NZ,NY,NX)=0.0 + WTSTG(NZ,NY,NX)=0.0 + WTSTGN(NZ,NY,NX)=0.0 + WTSTGP(NZ,NY,NX)=0.0 + DO 6401 L=1,NL(NY,NX) + DO 6401 K=0,1 + DO 6401 M=1,4 + CSNC(M,K,L,NZ,NY,NX)=0.0 + ZSNC(M,K,L,NZ,NY,NX)=0.0 + PSNC(M,K,L,NZ,NY,NX)=0.0 +6401 CONTINUE +9986 CONTINUE +9990 CONTINUE +9995 CONTINUE + RETURN + END diff --git a/f77src/starts.f b/f77src/starts.f index 930c214..4bd1ba2 100755 --- a/f77src/starts.f +++ b/f77src/starts.f @@ -1,1262 +1,1228 @@ - - SUBROUTINE starts(NHW,NHE,NVN,NVS) -C -C THIS SUBROUTINE INITIALIZES ALL SOIL VARIABLES -C - include "parameters.h" - include "blkc.h" - include "blk2a.h" - include "blk2b.h" - include "blk2c.h" - include "blk5.h" - include "blk8a.h" - include "blk8b.h" - include "blk11a.h" - include "blk11b.h" - include "blk13a.h" - include "blk13b.h" - include "blk13c.h" - include "blk16.h" - include "blk18a.h" - include "blk18b.h" - DIMENSION YSIN(4),YCOS(4),YAZI(4),ZAZI(4),OSCI(0:4),OSNI(0:4) - 2,ORCI(2,0:4),OSPI(0:4),OSCM(0:4),CORGCX(0:4) - 3,CORGNX(0:4),CORGPX(0:4),CNOSCT(0:4),CPOSCT(0:4),GSINX(JY,JX) - 4,GSINY(JY,JX),GSINA(JY,JX),GCOSA(JY,JX),ALTX(JV,JH) - 5,OSCX(0:4),OSNX(0:4),OSPX(0:4),OMCK(0:4),ORCK(0:4),OQCK(0:4) - 6,OHCK(0:4),TOSCK(0:4),TOSNK(0:4),TOSPK(0:4),TORGL(JZ) - PARAMETER (OQKM=12.0,DCKR=0.25,DCKM=2.5E+04,PSIPS=-0.5E-03) - DATA OMCI/0.005,0.050,0.005,0.050,0.050,0.005,0.050,0.050,0.005 - 2,0.005,0.050,0.005,0.005,0.050,0.005/ - DATA ORCI/0.01,0.05,0.01,0.05,0.01,0.05 - 2,0.001,0.005,0.001,0.005/ - DATA OMCK/0.01,0.01,0.01,0.01,0.01/ - DATA ORCK/0.25,0.25,0.25,0.25,0.25/ - DATA OQCK/0.005,0.005,0.005,0.005,0.005/ - DATA OHCK/0.05,0.05,0.05,0.05,0.05/ - DATA OMCF/0.20,0.20,0.30,0.20,0.050,0.025,0.025/ - DATA OMCA/0.06,0.02,0.01,0.0,0.01,0.0,0.0/ - DATA CNRH/3.33E-02,3.33E-02,3.33E-02,5.00E-02,12.50E-02/ - 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/ - NDIM=1 - IF(NHE.GT.NHW)NDIM=NDIM+1 - IF(NVS.GT.NVN)NDIM=NDIM+1 - XDIM=1.0/NDIM - ZERO=1.0E-16 - TAREA=0.0 - THETX=2.5E-03 -C -C INITIALIZE MASS BALANCE CHECKS -C - CRAIN=0.0 - HEATIN=0.0 - CO2GIN=0.0 - OXYGIN=0.0 - TZIN=0.0 - ZN2GIN=0.0 - TPIN=0.0 - TORGF=0.0 - TORGN=0.0 - TORGP=0.0 - TFERTN=0.0 - TFERTP=0.0 - VOLWOU=0.0 - CEVAP=0.0 - CRUN=0.0 - HEATOU=0.0 - OXYGOU=0.0 - TSEDOU=0.0 - TCOU=0.0 - TZOU=0.0 - TPOU=0.0 - XCSN=0.0 - XZSN=0.0 - XPSN=0.0 - TIONIN=0.0 - TIONOU=0.0 - VAP=2465.0 - VAPW=2834.0 - OXKM=0.064 - TYSIN=0.0 - ZSIN(1)=0.195 - ZSIN(2)=0.556 - ZSIN(3)=0.831 - ZSIN(4)=0.981 - ZCOS(1)=0.981 - ZCOS(2)=0.831 - ZCOS(3)=0.556 - ZCOS(4)=0.195 - DO 205 L=1,4 - ZAZI(L)=(L-0.5)*3.1416/4.0 -205 CONTINUE - DO 230 N=1,4 - YAZI(N)=3.1416*(2*N-1)/4.0 - YAGL=3.1416/4.0 - YSIN(N)=SIN(YAGL) - YCOS(N)=COS(YAGL) - TYSIN=TYSIN+YSIN(N) - DO 225 L=1,4 - DAZI=COS(ZAZI(L)-YAZI(N)) - DO 225 M=1,4 - OMEGY=ZCOS(M)*YSIN(N)+ZSIN(M)*YCOS(N)*DAZI - OMEGA(N,M,L)=ABS(OMEGY) - OMEGX(N,M,L)=OMEGA(N,M,L)/YSIN(N) - IF(ZCOS(M).GT.YSIN(N))THEN - OMEGZ=ACOS(OMEGY) - ELSE - OMEGZ=-ACOS(OMEGY) - ENDIF - IF(OMEGZ.GT.-1.5708)THEN - ZAGL=YAGL+2.0*OMEGZ - ELSE - ZAGL=YAGL-2.0*(3.1416+OMEGZ) - ENDIF - IF(ZAGL.GT.0.0.AND.ZAGL.LT.3.1416)THEN - IALBY(N,M,L)=1 - ELSE - IALBY(N,M,L)=2 - ENDIF -225 CONTINUE -230 CONTINUE -C -C INITIALIZE C-N AND C-P RATIOS OF RESIDUE AND SOIL -C - CNOFC(1,0)=0.005 - CNOFC(2,0)=0.005 - CNOFC(3,0)=0.005 - CNOFC(4,0)=0.020 - CPOFC(1,0)=0.0005 - CPOFC(2,0)=0.0005 - CPOFC(3,0)=0.0005 - CPOFC(4,0)=0.0020 - CNOFC(1,1)=0.020 - CNOFC(2,1)=0.020 - CNOFC(3,1)=0.020 - CNOFC(4,1)=0.020 - CPOFC(1,1)=0.0020 - CPOFC(2,1)=0.0020 - CPOFC(3,1)=0.0020 - CPOFC(4,1)=0.0020 - CNOFC(1,2)=0.005 - CNOFC(2,2)=0.005 - CNOFC(3,2)=0.005 - CNOFC(4,2)=0.020 - CPOFC(1,2)=0.0005 - CPOFC(2,2)=0.0005 - CPOFC(3,2)=0.0005 - CPOFC(4,2)=0.0020 - FL(1)=0.55 - FL(2)=0.45 - DO 95 K=0,5 - DO 95 N=1,7 - IF(K.LE.4.AND.N.EQ.3)THEN - CNOMC(1,N,K)=0.15 - CNOMC(2,N,K)=0.09 - CPOMC(1,N,K)=0.015 - CPOMC(2,N,K)=0.009 - ELSE - CNOMC(1,N,K)=0.225 - CNOMC(2,N,K)=0.135 - CPOMC(1,N,K)=0.0225 - CPOMC(2,N,K)=0.0135 - ENDIF - CNOMC(3,N,K)=FL(1)*CNOMC(1,N,K)+FL(2)*CNOMC(2,N,K) - CPOMC(3,N,K)=FL(1)*CPOMC(1,N,K)+FL(2)*CPOMC(2,N,K) -95 CONTINUE -C -C CALCULATE ELEVATION OF EACH GRID CELL -C - ALTY=0.0 - DO 9985 NX=NHW,NHE - DO 9980 NY=NVN,NVS - DYLN(NY,NX)=12.0 - DH(NY,NX)=DHI(NX) - DV(NY,NX)=DVI(NY) - ZEROS(NY,NX)=ZERO*DH(NY,NX)*DV(NY,NX) - GSIN(NY,NX)=SIN(SL(NY,NX)/57.29577951) - GCOS(NY,NX)=SQRT(1.0-GSIN(NY,NX)**2) - GAZI(NY,NX)=ASP(NY,NX)/57.29577951 - DO 240 N=1,4 - DGAZI=COS(GAZI(NY,NX)-YAZI(N)) - OMEGAG(N,NY,NX)=AMAX1(0.0,AMIN1(1.0,GCOS(NY,NX)*YSIN(N) - 2+GSIN(NY,NX)*YCOS(N)*DGAZI)) -240 CONTINUE - GSINA(NY,NX)=ABS(SIN(GAZI(NY,NX))) - GCOSA(NY,NX)=ABS(COS(GAZI(NY,NX))) - IF(ASP(NY,NX).GT.90.0.AND.ASP(NY,NX).LT.270.0)THEN - GSINX(NY,NX)=GSIN(NY,NX) - ELSE - GSINX(NY,NX)=-GSIN(NY,NX) - ENDIF - IF(ASP(NY,NX).GT.0.0.AND.ASP(NY,NX).LT.180.0)THEN - GSINY(NY,NX)=GSIN(NY,NX) - ELSE - GSINY(NY,NX)=-GSIN(NY,NX) - ENDIF - SLOPE(1,NY,NX)=GSINX(NY,NX)*GCOSA(NY,NX) - SLOPE(2,NY,NX)=GSINY(NY,NX)*GSINA(NY,NX) - SLOPE(3,NY,NX)=-1.0 - IF(NX.EQ.NHW)THEN - IF(NY.EQ.NVN)THEN - ALT(NY,NX)=0.5*DH(NY,NX)*GSINX(NY,NX)*GCOSA(NY,NX) - 2+0.5*DV(NY,NX)*GSINY(NY,NX)*GSINA(NY,NX) - ALTX(NY,NX)=0.0 - ELSE - ALT(NY,NX)=ALT(NY-1,NX) - 2+0.5*DV(NY,NX)*(GSINY(NY,NX)*GSINA(NY,NX)) - 3+0.5*DV(NY-1,NX)*(GSINY(NY-1,NX)*GSINA(NY-1,NX)) - 4+0.5*DH(NY,NX)*(GSINX(NY,NX)*GCOSA(NY,NX)) - 5-0.5*DH(NY-1,NX)*(GSINX(NY-1,NX)*GCOSA(NY-1,NX)) - ALTX(NY,NX)=ALTX(NY-1,NX) - 2+DV(NY-1,NX)*(GSINY(NY-1,NX)*GSINA(NY-1,NX)) - ENDIF - IF(NY.EQ.NVS)THEN - ALTX(NY+1,NX)=ALTX(NY,NX) - 2+DV(NY,NX)*(GSINY(NY,NX)*GSINA(NY,NX)) - ENDIF - ELSE - IF(NY.EQ.NVN)THEN - ALT(NY,NX)=ALT(NY,NX-1) - 2+0.5*DH(NY,NX)*(GSINX(NY,NX)*GCOSA(NY,NX)) - 3+0.5*DH(NY,NX-1)*(GSINX(NY,NX-1)*GCOSA(NY,NX-1)) - 4+0.5*DV(NY,NX)*(GSINY(NY,NX)*GSINA(NY,NX)) - 5-0.5*DV(NY,NX-1)*(GSINY(NY,NX-1)*GSINA(NY,NX-1)) - ALTX(NY,NX)=ALTX(NY,NX-1) - 2+DH(NY,NX-1)*(GSINX(NY,NX-1)*GCOSA(NY,NX-1)) - ELSE - ALT(NY,NX)=ALT(NY-1,NX) - 2+0.5*DV(NY,NX)*(GSINY(NY,NX)*GSINA(NY,NX)) - 3+0.5*DV(NY-1,NX)*(GSINY(NY-1,NX)*GSINA(NY-1,NX)) - 4+0.5*DH(NY,NX)*(GSINX(NY,NX)*GCOSA(NY,NX)) - 5-0.5*DH(NY-1,NX)*(GSINX(NY-1,NX)*GCOSA(NY-1,NX)) - ALTX(NY,NX)=ALTX(NY-1,NX) - 2+DV(NY-1,NX)*(GSINY(NY-1,NX)*GSINA(NY-1,NX)) - ENDIF - IF(NX.EQ.NHE)THEN - ALTX(NY,NX+1)=ALTX(NY,NX) - 2+DH(NY,NX)*(GSINX(NY,NX)*GCOSA(NY,NX)) - ENDIF - IF(NY.EQ.NVS)THEN - ALTX(NY+1,NX)=ALTX(NY,NX) - 2+DV(NY,NX)*(GSINY(NY,NX)*GSINA(NY,NX)) - ENDIF - IF(NX.EQ.NHE.AND.NY.EQ.NVS)THEN - ALTX(NY+1,NX+1)=ALTX(NY,NX) - 2+DV(NY,NX)*(GSINY(NY,NX)*GSINA(NY,NX)) - 2+DH(NY,NX)*(GSINX(NY,NX)*GCOSA(NY,NX)) - ENDIF - ENDIF - IF(NX.EQ.NHW.AND.NY.EQ.NVN)THEN - ALTY=ALT(NY,NX) - ELSE - ALTY=MAX(ALTY,ALT(NY,NX)) - ENDIF -9980 CONTINUE -9985 CONTINUE -C -C INITIALIZE ACCUMULATORS AND MASS BALANCE CHECKS -C OF EACH GRID CELL -C - ALTZG=0.0 - CDPTHG=0.0 - DO 9995 NX=NHW,NHE - DO 9990 NY=NVN,NVS - DO 600 N=1,12 - TDTPX(NY,NX,N)=0.0 - TDTPN(NY,NX,N)=0.0 - TDRAD(NY,NX,N)=1.0 - TDWND(NY,NX,N)=1.0 - TDHUM(NY,NX,N)=1.0 - TDPRC(NY,NX,N)=1.0 - TDIRI(NY,NX,N)=1.0 - TDCO2(NY,NX,N)=1.0 - TDCN4(NY,NX,N)=1.0 - TDCNO(NY,NX,N)=1.0 -600 CONTINUE - IUTYP(NY,NX)=0 - IFNHB(NY,NX)=0 - IFNOB(NY,NX)=0 - IFPOB(NY,NX)=0 - IFLGS(NY,NX)=1 - IFLGT(NY,NX)=0 - ATCA(NY,NX)=ATCAI(NY,NX) - ATCS(NY,NX)=ATCAI(NY,NX) - ATKA(NY,NX)=ATCA(NY,NX)+273.15 - ATKS(NY,NX)=ATCS(NY,NX)+273.15 - URAIN(NY,NX)=0.0 - UCO2G(NY,NX)=0.0 - UCH4G(NY,NX)=0.0 - UOXYG(NY,NX)=0.0 - UN2GG(NY,NX)=0.0 - UN2OG(NY,NX)=0.0 - UNH3G(NY,NX)=0.0 - UN2GS(NY,NX)=0.0 - UCO2F(NY,NX)=0.0 - UCH4F(NY,NX)=0.0 - UOXYF(NY,NX)=0.0 - UN2OF(NY,NX)=0.0 - UNH3F(NY,NX)=0.0 - UPO4F(NY,NX)=0.0 - UORGF(NY,NX)=0.0 - UFERTN(NY,NX)=0.0 - UFERTP(NY,NX)=0.0 - UVOLO(NY,NX)=0.0 - UEVAP(NY,NX)=0.0 - URUN(NY,NX)=0.0 - USEDOU(NY,NX)=0.0 - UCOP(NY,NX)=0.0 - UDOCQ(NY,NX)=0.0 - UDOCD(NY,NX)=0.0 - UDONQ(NY,NX)=0.0 - UDOND(NY,NX)=0.0 - UDOPQ(NY,NX)=0.0 - UDOPD(NY,NX)=0.0 - UDICQ(NY,NX)=0.0 - UDICD(NY,NX)=0.0 - UDINQ(NY,NX)=0.0 - UDIND(NY,NX)=0.0 - UDIPQ(NY,NX)=0.0 - UDIPD(NY,NX)=0.0 - UIONOU(NY,NX)=0.0 - UXCSN(NY,NX)=0.0 - UXZSN(NY,NX)=0.0 - UXPSN(NY,NX)=0.0 - UDRAIN(NY,NX)=0.0 - ZDRAIN(NY,NX)=0.0 - PDRAIN(NY,NX)=0.0 - DPNH4(NY,NX)=0.0 - DPNO3(NY,NX)=0.0 - DPPO4(NY,NX)=0.0 - TCS(0,NY,NX)=ATCS(NY,NX) - TKS(0,NY,NX)=TCS(0,NY,NX)+273.15 - OXYS(0,NY,NX)=0.0 - FRADG(NY,NX)=1.0 - THRMG(NY,NX)=0.0 - THRMC(NY,NX)=0.0 - TRN(NY,NX)=0.0 - TLE(NY,NX)=0.0 - TSH(NY,NX)=0.0 - TGH(NY,NX)=0.0 - TLEC(NY,NX)=0.0 - TSHC(NY,NX)=0.0 - TLEX(NY,NX)=0.0 - TSHX(NY,NX)=0.0 - TCNET(NY,NX)=0.0 - TVOLWC(NY,NX)=0.0 - ARLFC(NY,NX)=0.0 - ARSTC(NY,NX)=0.0 - TFLWC(NY,NX)=0.0 - PPT(NY,NX)=0.0 - DENS0(NY,NX)=0.100 - DENS1(NY,NX)=1.0 - VOLSS(NY,NX)=DPTHS(NY,NX)*DENS0(NY,NX)*DH(NY,NX)*DV(NY,NX) - VOLWS(NY,NX)=0.0 - VOLIS(NY,NX)=0.0 - VOLS(NY,NX)=VOLSS(NY,NX)/DENS0(NY,NX)+VOLWS(NY,NX)+VOLIS(NY,NX) - DPTHA(NY,NX)=9999.0 - TCW(NY,NX)=0.0 - TKW(NY,NX)=TCW(NY,NX)+273.15 - ALBX(NY,NX)=ALBS(NY,NX) - XTILL(NY,NX)=0.0 - XHVSTC(NY,NX)=0.0 - XHVSTN(NY,NX)=0.0 - XHVSTP(NY,NX)=0.0 - ALT(NY,NX)=ALT(NY,NX)-ALTY - IF(NX.EQ.NHW.AND.NY.EQ.NVN)THEN - ALTZG=ALT(NY,NX) - ELSE - ALTZG=MIN(ALTZG,ALT(NY,NX)) - ENDIF - CDPTHG=AMAX1(CDPTHG,CDPTH(NU(NY,NX),NY,NX)) -C -C INITIALIZE ATMOSPHERE VARIABLES -C - CCO2EI(NY,NX)=CO2EI(NY,NX)*5.36E-04*273.15/ATKA(NY,NX) - CCO2E(NY,NX)=CO2E(NY,NX)*5.36E-04*273.15/ATKA(NY,NX) - CCH4E(NY,NX)=CH4E(NY,NX)*5.36E-04*273.15/ATKA(NY,NX) - COXYE(NY,NX)=OXYE(NY,NX)*1.43E-03*273.15/ATKA(NY,NX) - CZ2GE(NY,NX)=Z2GE(NY,NX)*1.25E-03*273.15/ATKA(NY,NX) - CZ2OE(NY,NX)=Z2OE(NY,NX)*1.25E-03*273.15/ATKA(NY,NX) - CNH3E(NY,NX)=ZNH3E(NY,NX)*6.25E-04*273.15/ATKA(NY,NX) - CH2GE(NY,NX)=H2GE(NY,NX)*8.92E-05*273.15/ATKA(NY,NX) -C -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) -2222 FORMAT(A8,2E12.4) -C -C CALCULATE WHETHER BOUNDARY SLOPES ALLOW RUNOFF -C - DO 9575 N=1,2 - DO 9575 NN=1,2 - IF(N.EQ.1)THEN - IF(NN.EQ.1)THEN - IF(NX.EQ.NHE)THEN - IF(ASP(NY,NX).GT.90.0.AND.ASP(NY,NX).LT.270.0 - 2.AND.SL(NY,NX).GT.0.0)THEN - IRCHG(NN,N,NY,NX)=0 - ELSE - IRCHG(NN,N,NY,NX)=1 - ENDIF - ELSE - GO TO 9575 - ENDIF - ELSEIF(NN.EQ.2)THEN - IF(NX.EQ.NHW)THEN - IF(ASP(NY,NX).LT.90.0.OR.ASP(NY,NX).GT.270.0 - 2.AND.SL(NY,NX).GT.0.0)THEN - IRCHG(NN,N,NY,NX)=0 - ELSE - IRCHG(NN,N,NY,NX)=1 - ENDIF - ELSE - GO TO 9575 - ENDIF - ENDIF - ELSEIF(N.EQ.2)THEN - IF(NN.EQ.1)THEN - IF(NY.EQ.NVS)THEN - IF(ASP(NY,NX).LT.180.0.AND.ASP(NY,NX).GT.0.0 - 2.AND.SL(NY,NX).GT.0.0)THEN - IRCHG(NN,N,NY,NX)=0 - ELSE - IRCHG(NN,N,NY,NX)=1 - ENDIF - ELSE - GO TO 9575 - ENDIF - ELSEIF(NN.EQ.2)THEN - IF(NY.EQ.NVN)THEN - IF(ASP(NY,NX).EQ.0)THEN - ASP2=360.0 - ELSE - ASP2=ASP(NY,NX) - ENDIF - IF(ASP2.GT.180.0.AND.ASP2.LT.360.0 - 2.AND.SL(NY,NX).GT.0.0)THEN - IRCHG(NN,N,NY,NX)=0 - ELSE - IRCHG(NN,N,NY,NX)=1 - ENDIF - ELSE - GO TO 9575 - ENDIF - ENDIF - ENDIF -9575 CONTINUE -C -C INITIALIZE WATER AND TEMPERATURE VARIABLES FOR SOIL LAYERS -C - PSIMS(NY,NX)=LOG(-PSIPS) - PSIMX(NY,NX)=LOG(-PSIFC(NY,NX)) - PSIMN(NY,NX)=LOG(-PSIWP(NY,NX)) - PSISD(NY,NX)=PSIMX(NY,NX)-PSIMS(NY,NX) - PSIMD(NY,NX)=PSIMN(NY,NX)-PSIMX(NY,NX) - NW(NY,NX)=0 - CORGC(0,NY,NX)=0.5E+06 -C -C DISTRIBUTION OF OM AMONG FRACTIONS OF DIFFERING -C BIOLOGICAL ACTIVITY -C - DO 1195 L=0,NL(NY,NX) -C -C LAYER DEPTHS AND THEIR PHYSICAL PROPOERTIES -C - DLYR(1,L,NY,NX)=DH(NY,NX) - DLYR(2,L,NY,NX)=DV(NY,NX) - AREA(3,L,NY,NX)=DLYR(1,L,NY,NX)*DLYR(2,L,NY,NX) - IF(L.EQ.0)THEN - TAREA=TAREA+AREA(3,L,NY,NX) - CDPTH(L,NY,NX)=0.0 - CDPTHZ(L,NY,NX)=0.0 - ORGC(L,NY,NX)=(RSC(0,L,NY,NX)+RSC(1,L,NY,NX)+RSC(2,L,NY,NX)) - 2*AREA(3,L,NY,NX) - VOLR(NY,NX)=(RSC(0,L,NY,NX)*1.0E-06/BKRS(0) - 2+RSC(1,L,NY,NX)*1.0E-06/BKRS(1)+RSC(2,L,NY,NX)*1.0E-06/BKRS(2)) - 2*AREA(3,L,NY,NX) - VOLT(L,NY,NX)=VOLR(NY,NX) - VOLX(L,NY,NX)=VOLT(L,NY,NX) - BKVL(L,NY,NX)=2.00E-06*ORGC(L,NY,NX) - DLYR(3,L,NY,NX)=VOLX(L,NY,NX)/AREA(3,L,NY,NX) - ELSE - DLYR(3,L,NY,NX)=(CDPTH(L,NY,NX)-CDPTH(L-1,NY,NX)) - DPTH(L,NY,NX)=0.5*(CDPTH(L,NY,NX)+CDPTH(L-1,NY,NX)) - CDPTHZ(L,NY,NX)=CDPTH(L,NY,NX)-CDPTH(NU(NY,NX),NY,NX) - 2+DLYR(3,NU(NY,NX),NY,NX) - DPTHZ(L,NY,NX)=0.5*(CDPTHZ(L,NY,NX)+CDPTHZ(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) - BKVL(L,NY,NX)=BKDS(L,NY,NX)*VOLX(L,NY,NX) - YDPTH(L,NY,NX)=ALT(NY,NX)-DPTH(L,NY,NX) - RTDNT(L,NY,NX)=0.0 - IF(BKDS(L,NY,NX).GT.0.0.AND.NW(NY,NX).EQ.0)NW(NY,NX)=L - ENDIF - AREA(1,L,NY,NX)=DLYR(3,L,NY,NX)*DLYR(2,L,NY,NX) - AREA(2,L,NY,NX)=DLYR(3,L,NY,NX)*DLYR(1,L,NY,NX) -1195 CONTINUE -C -C SURFACE WATER STORAGE AND LOWER HEAT SINK -C - DS=AMAX1(0.0,0.112*ZS(NY,NX)+3.10*ZS(NY,NX)**2 - 2-0.012*ZS(NY,NX)*SL(NY,NX)/57.29578) - VOLWG(NY,NX)=VOLA(NU(NY,NX),NY,NX)+VOLAH(NU(NY,NX),NY,NX) - 2+DS*AREA(3,NU(NY,NX),NY,NX) - VHCPW(NY,NX)=2.095*VOLSS(NY,NX)+4.19*VOLWS(NY,NX) - 2+1.9274*VOLIS(NY,NX) - VHCPWX(NY,NX)=10.5E-03*AREA(3,NU(NY,NX),NY,NX) - VHCPRX(NY,NX)=10.5E-05*AREA(3,NU(NY,NX),NY,NX) - DPTHSK(NY,NX)=AMAX1(10.0,CDPTH(NL(NY,NX),NY,NX)+1.0) - TCNDG=8.1E-03 - TKSD(NY,NX)=ATKS(NY,NX)+2.052E-04*DPTHSK(NY,NX)/TCNDG -C -C INITIALIZE COMMUNITY CANOPY -C - ZT(NY,NX)=0.0 - ZL(0,NY,NX)=0.0 - DO 1925 L=1,JC - ZL(L,NY,NX)=0.0 - ARLFT(L,NY,NX)=0.0 - ARSTT(L,NY,NX)=0.0 - WGLFT(L,NY,NX)=0.0 -1925 CONTINUE -9990 CONTINUE -9995 CONTINUE -C -C INITIALIZE GRID CELL DIMENSIONS -C - DO 9895 NX=NHW,NHE - DO 9890 NY=NVN,NVS - ALTZ(NY,NX)=ALTZG - IF(BKDS(NU(NY,NX),NY,NX).GT.0.0)THEN - DTBLZ(NY,NX)=DTBLI(NY,NX)-(ALTZ(NY,NX)-ALT(NY,NX)) - 2*(1.0-DTBLG(NY,NX)) - DDRG(NY,NX)=AMAX1(0.0,DDRGI(NY,NX)-(ALTZ(NY,NX)-ALT(NY,NX)) - 2*(1.0-DTBLG(NY,NX))) - ELSE - DTBLZ(NY,NX)=0.0 - DDRG(NY,NX)=0.0 - ENDIF - DPTHT(NY,NX)=DTBLZ(NY,NX) - WRITE(18,1111)'ALT',NX,NY,ALTX(NY,NX),ALT(NY,NX),SLOPE(1,NY,NX) - 2,SLOPE(2,NY,NX),ASP(NY,NX),GSINX(NY,NX),GSINY(NY,NX),GCOSA(NY,NX) - 3,GSINA(NY,NX),DTBLZ(NY,NX),DDRG(NY,NX),DTBLI(NY,NX),ALTY - 4,ALTZ(NY,NX),DTBLG(NY,NX) -1111 FORMAT(A8,2I4,20E12.4) - DO 4400 L=1,NL(NY,NX) - N1=NX - N2=NY - N3=L - DO 4320 N=NCN(N2,N1),3 - IF(N.EQ.1)THEN - IF(NX.EQ.NHE)THEN - GO TO 4320 - ELSE - N4=NX+1 - N5=NY - N6=L - ENDIF - ELSEIF(N.EQ.2)THEN - IF(NY.EQ.NVS)THEN - GO TO 4320 - ELSE - N4=NX - N5=NY+1 - N6=L - ENDIF - ELSEIF(N.EQ.3)THEN - IF(L.EQ.NL(NY,NX))THEN - GO TO 4320 - ELSE - N4=NX - N5=NY - N6=L+1 - ENDIF - ENDIF - DIST(N,N6,N5,N4)=0.5*(DLYR(N,N3,N2,N1)+DLYR(N,N6,N5,N4)) - XDPTH(N,N6,N5,N4)=AREA(N,N3,N2,N1)/DIST(N,N6,N5,N4) - DISP(N,N6,N5,N4)=0.20*DIST(N,N6,N5,N4)**1.07 -4320 CONTINUE - IF(L.EQ.NU(NY,NX))THEN - DIST(3,N3,N2,N1)=0.5*DLYR(3,N3,N2,N1) - XDPTH(3,N3,N2,N1)=AREA(3,N3,N2,N1)/DIST(3,N3,N2,N1) - DISP(3,N3,N2,N1)=0.20*DIST(3,N3,N2,N1)**1.07 - ENDIF -4400 CONTINUE -C -C INITIALIZE SOM FROM ORGANIC INPUTS IN SOIL FILE FROM 'READS' -C - TORGC=0.0 - DO 1190 L=0,NL(NY,NX) - IF(L.GE.NU(NY,NX))THEN - CORGCZ=CORGC(L,NY,NX) - CORGRZ=CORGR(L,NY,NX) - CORGNZ=CORGN(L,NY,NX) - CORGPZ=CORGP(L,NY,NX) - CORGCX(3)=CORGRZ - CORGCX(4)=AMAX1(0.0,CORGCZ-CORGCX(3)) - CORGNX(3)=AMIN1(CNRH(3)*CORGCX(3),CORGNZ) - CORGNX(4)=AMAX1(0.0,CORGNZ-CORGNX(3)) - CORGPX(3)=AMIN1(CPRH(3)*CORGCX(3),CORGPZ) - CORGPX(4)=AMAX1(0.0,CORGPZ-CORGPX(3)) - CORGL=AMAX1(0.0,CORGC(L,NY,NX)-CORGR(L,NY,NX)) - ELSE - CORGL=0.0 - ENDIF - 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))) - IF(TORGM.GT.ZERO)THEN - HCX=LOG(0.5)/TORGM - ELSE - HCX=0.0 - ENDIF - DO 1200 L=0,NL(NY,NX) - IF(BKVL(L,NY,NX).GT.0.0)THEN - CORGCX(0)=RSC(0,L,NY,NX)*AREA(3,L,NY,NX)/BKVL(L,NY,NX) - CORGCX(1)=RSC(1,L,NY,NX)*AREA(3,L,NY,NX)/BKVL(L,NY,NX) - CORGCX(2)=RSC(2,L,NY,NX)*AREA(3,L,NY,NX)/BKVL(L,NY,NX) - CORGNX(0)=RSN(0,L,NY,NX)*AREA(3,L,NY,NX)/BKVL(L,NY,NX) - CORGNX(1)=RSN(1,L,NY,NX)*AREA(3,L,NY,NX)/BKVL(L,NY,NX) - CORGNX(2)=RSN(2,L,NY,NX)*AREA(3,L,NY,NX)/BKVL(L,NY,NX) - CORGPX(0)=RSP(0,L,NY,NX)*AREA(3,L,NY,NX)/BKVL(L,NY,NX) - CORGPX(1)=RSP(1,L,NY,NX)*AREA(3,L,NY,NX)/BKVL(L,NY,NX) - CORGPX(2)=RSP(2,L,NY,NX)*AREA(3,L,NY,NX)/BKVL(L,NY,NX) - ELSE - CORGCX(0)=0.5E+06 - CORGCX(1)=0.5E+06 - CORGCX(2)=0.5E+06 - CORGNX(0)=0.5E+05 - CORGNX(1)=0.5E+05 - CORGNX(2)=0.5E+05 - CORGPX(0)=0.5E+04 - CORGPX(1)=0.5E+04 - CORGPX(2)=0.5E+04 - ENDIF - IF(L.GT.0)THEN - CORGCZ=CORGC(L,NY,NX) - CORGRZ=CORGR(L,NY,NX) - CORGNZ=CORGN(L,NY,NX) - CORGPZ=CORGP(L,NY,NX) - IF(CORGCZ.GT.ZERO)THEN - CORGCX(3)=CORGRZ - CORGCX(4)=AMAX1(0.0,CORGCZ-CORGCX(3)) - CORGNX(3)=AMIN1(CNRH(3)*CORGCX(3),CORGNZ) - CORGNX(4)=AMAX1(0.0,CORGNZ-CORGNX(3)) - CORGPX(3)=AMIN1(CPRH(3)*CORGCX(3),CORGPZ) - CORGPX(4)=AMAX1(0.0,CORGPZ-CORGPX(3)) - ELSE - CORGCX(3)=0.0 - CORGCX(4)=0.0 - CORGNX(3)=0.0 - CORGNX(4)=0.0 - CORGPX(3)=0.0 - CORGPX(4)=0.0 - ENDIF - ELSE - CORGCX(3)=0.0 - CORGCX(4)=0.0 - CORGNX(3)=0.0 - CORGNX(4)=0.0 - CORGPX(3)=0.0 - CORGPX(4)=0.0 - ENDIF -C -C SURFACE RESIDUE -C - IF(L.EQ.0)THEN -C -C PREVIOUS COARSE WOODY RESIDUE -C - CFOSC(1,0,L,NY,NX)=0.000 - CFOSC(2,0,L,NY,NX)=0.045 - CFOSC(3,0,L,NY,NX)=0.660 - CFOSC(4,0,L,NY,NX)=0.295 -C -C MAIZE -C - IF(IXTYP(1,NY,NX).EQ.1)THEN - CFOSC(1,1,L,NY,NX)=0.080 - CFOSC(2,1,L,NY,NX)=0.245 - CFOSC(3,1,L,NY,NX)=0.613 - CFOSC(4,1,L,NY,NX)=0.062 -C -C WHEAT -C - ELSEIF(IXTYP(1,NY,NX).EQ.2)THEN - CFOSC(1,1,L,NY,NX)=0.125 - CFOSC(2,1,L,NY,NX)=0.171 - CFOSC(3,1,L,NY,NX)=0.560 - CFOSC(4,1,L,NY,NX)=0.144 -C -C SOYBEAN -C - ELSEIF(IXTYP(1,NY,NX).EQ.3)THEN - CFOSC(1,1,L,NY,NX)=0.138 - CFOSC(2,1,L,NY,NX)=0.426 - CFOSC(3,1,L,NY,NX)=0.316 - CFOSC(4,1,L,NY,NX)=0.120 -C -C NEW STRAW -C - ELSEIF(IXTYP(1,NY,NX).EQ.4)THEN - CFOSC(1,1,L,NY,NX)=0.036 - CFOSC(2,1,L,NY,NX)=0.044 - CFOSC(3,1,L,NY,NX)=0.767 - CFOSC(4,1,L,NY,NX)=0.153 -C -C OLD STRAW -C - ELSEIF(IXTYP(1,NY,NX).EQ.5)THEN - CFOSC(1,1,L,NY,NX)=0.075 - CFOSC(2,1,L,NY,NX)=0.125 - CFOSC(3,1,L,NY,NX)=0.550 - CFOSC(4,1,L,NY,NX)=0.250 -C -C COMPOST -C - ELSEIF(IXTYP(1,NY,NX).EQ.6)THEN - CFOSC(1,1,L,NY,NX)=0.143 - CFOSC(2,1,L,NY,NX)=0.015 - CFOSC(3,1,L,NY,NX)=0.640 - CFOSC(4,1,L,NY,NX)=0.202 -C -C GREEN MANURE -C - ELSEIF(IXTYP(1,NY,NX).EQ.7)THEN - CFOSC(1,1,L,NY,NX)=0.202 - CFOSC(2,1,L,NY,NX)=0.013 - CFOSC(3,1,L,NY,NX)=0.560 - CFOSC(4,1,L,NY,NX)=0.225 -C -C NEW DECIDUOUS FOREST -C - ELSEIF(IXTYP(1,NY,NX).EQ.8)THEN - CFOSC(1,1,L,NY,NX)=0.07 - CFOSC(2,1,L,NY,NX)=0.41 - CFOSC(3,1,L,NY,NX)=0.36 - CFOSC(4,1,L,NY,NX)=0.16 -C -C NEW CONIFEROUS FOREST -C - ELSEIF(IXTYP(1,NY,NX).EQ.9)THEN - CFOSC(1,1,L,NY,NX)=0.07 - CFOSC(2,1,L,NY,NX)=0.25 - CFOSC(3,1,L,NY,NX)=0.38 - CFOSC(4,1,L,NY,NX)=0.30 -C -C OLD DECIDUOUS FOREST -C - ELSEIF(IXTYP(1,NY,NX).EQ.10)THEN - CFOSC(1,1,L,NY,NX)=0.02 - CFOSC(2,1,L,NY,NX)=0.06 - CFOSC(3,1,L,NY,NX)=0.34 - CFOSC(4,1,L,NY,NX)=0.58 -C -C OLD CONIFEROUS FOREST -C - ELSEIF(IXTYP(1,NY,NX).EQ.11)THEN - CFOSC(1,1,L,NY,NX)=0.02 - CFOSC(2,1,L,NY,NX)=0.06 - CFOSC(3,1,L,NY,NX)=0.34 - CFOSC(4,1,L,NY,NX)=0.58 -C -C DEFAULT -C - ELSE - CFOSC(1,1,L,NY,NX)=0.075 - CFOSC(2,1,L,NY,NX)=0.125 - CFOSC(3,1,L,NY,NX)=0.550 - CFOSC(4,1,L,NY,NX)=0.250 - ENDIF -C -C PREVIOUS COARSE (K=0) AND FINE (K=1) ROOTS -C - ELSE - CFOSC(1,0,L,NY,NX)=0.00 - CFOSC(2,0,L,NY,NX)=0.00 - CFOSC(3,0,L,NY,NX)=0.20 - CFOSC(4,0,L,NY,NX)=0.80 - CFOSC(1,1,L,NY,NX)=0.02 - CFOSC(2,1,L,NY,NX)=0.06 - CFOSC(3,1,L,NY,NX)=0.34 - CFOSC(4,1,L,NY,NX)=0.58 - ENDIF -C -C ANIMAL MANURE -C -C -C RUMINANT -C - IF(IXTYP(2,NY,NX).EQ.1)THEN - CFOSC(1,2,L,NY,NX)=0.036 - CFOSC(2,2,L,NY,NX)=0.044 - CFOSC(3,2,L,NY,NX)=0.630 - CFOSC(4,2,L,NY,NX)=0.290 -C -C NON-RUMINANT -C - ELSEIF(IXTYP(2,NY,NX).EQ.2)THEN - CFOSC(1,2,L,NY,NX)=0.138 - CFOSC(2,2,L,NY,NX)=0.401 - CFOSC(3,2,L,NY,NX)=0.316 - CFOSC(4,2,L,NY,NX)=0.145 -C -C OTHER -C - ELSE - CFOSC(1,2,L,NY,NX)=0.138 - CFOSC(2,2,L,NY,NX)=0.401 - CFOSC(3,2,L,NY,NX)=0.316 - CFOSC(4,2,L,NY,NX)=0.145 - ENDIF -C -C POM -C - IF(L.NE.0)THEN - CFOSC(1,3,L,NY,NX)=1.00 - CFOSC(2,3,L,NY,NX)=0.00 - CFOSC(3,3,L,NY,NX)=0.00 - CFOSC(4,3,L,NY,NX)=0.00 -C -C HUMUS PARTITIONED TO DIFFERENT FRACTIONS -C BASED ON SOC ACCUMULATION -C - IF(CORGCX(4).GT.1.0E-32)THEN - FC0=0.60*EXP(-5.0*(AMIN1(CORGNX(4),10.0*CORGPX(4)) - 2/CORGCX(4))) - ELSE - FC0=0.60 - ENDIF - IF(ISOILR(NY,NX).NE.0)THEN - FCX=0.75 - ELSEIF(DPTH(L,NY,NX).GT.DTBLZ(NY,NX) - 2+CDPTH(NU(NY,NX),NY,NX)-CDPTHG)THEN - FCX=(EXP(HCX*TORGL(L)))**0.25 - ELSE - FCX=EXP(HCX*TORGL(L)) - ENDIF - FC1=FC0*FCX - CFOSC(1,4,L,NY,NX)=FC1 - CFOSC(2,4,L,NY,NX)=1.0-FC1 - CFOSC(3,4,L,NY,NX)=0.00 - CFOSC(4,4,L,NY,NX)=0.00 -C -C MICROBIAL DETRITUS TO HUMUS MAINTAINS EXISTING PARTITIONING -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 - 2,CORGCX(4),CORGNX(4),CORGPX(4),DPTH(L,NY,NX),DTBLZ(NY,NX) - 3,CDPTH(NU(NY,NX),NY,NX),CDPTHG -5432 FORMAT(A8,I4,20E12.4) - ENDIF -C -C LAYER SOIL, HEAT, WATER, ICE, GAS AND AIR CONTENTS -C - PSISE(L,NY,NX)=PSIPS - ROXYF(L,NY,NX)=0.0 - RCO2F(L,NY,NX)=0.0 - ROXYL(L,NY,NX)=0.0 - RCH4F(L,NY,NX)=0.0 - RCH4L(L,NY,NX)=0.0 - IF(L.GT.0)THEN - HYST(L,NY,NX)=1.0 - 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) - 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 - 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) - ELSEIF(THW(L,NY,NX).EQ.1.0)THEN - THW(L,NY,NX)=FC(L,NY,NX) - ELSEIF(THW(L,NY,NX).LE.0.0)THEN - THW(L,NY,NX)=WP(L,NY,NX) - ENDIF - IF(THI(L,NY,NX).GT.1.0.OR.DPTH(L,NY,NX).GE.DTBLZ(NY,NX))THEN - THI(L,NY,NX)=AMAX1(0.0,AMIN1(POROS(L,NY,NX) - 2,POROS(L,NY,NX)-THW(L,NY,NX))) - ELSEIF(THI(L,NY,NX).EQ.1.0)THEN - THI(L,NY,NX)=AMAX1(0.0,AMIN1(FC(L,NY,NX) - 2,POROS(L,NY,NX)-THW(L,NY,NX))) - ELSEIF(THI(L,NY,NX).LT.0.0)THEN - THI(L,NY,NX)=AMAX1(0.0,AMIN1(WP(L,NY,NX) - 2,POROS(L,NY,NX)-THW(L,NY,NX))) - ENDIF - THETW(L,NY,NX)=THW(L,NY,NX) - VOLW(L,NY,NX)=THETW(L,NY,NX)*VOLX(L,NY,NX) - VOLWX(L,NY,NX)=VOLW(L,NY,NX) - VOLWH(L,NY,NX)=THETW(L,NY,NX)*VOLAH(L,NY,NX) - THETI(L,NY,NX)=THI(L,NY,NX) - VOLI(L,NY,NX)=THETI(L,NY,NX)*VOLX(L,NY,NX) - VOLIH(L,NY,NX)=THETI(L,NY,NX)*VOLAH(L,NY,NX) - ENDIF - 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)) - 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) - 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) - 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) - TKS(L,NY,NX)=TCS(L,NY,NX)+273.15 - PSISA(L,NY,NX)=-2.5E-03 - ELSE - VOLW(L,NY,NX)=1.0E-06*ORGC(L,NY,NX) - VOLWX(L,NY,NX)=VOLW(L,NY,NX) - VOLI(L,NY,NX)=0.0 - IF(VOLX(L,NY,NX).GT.0.0)THEN - THETW(L,NY,NX)=AMAX1(0.001,VOLW(L,NY,NX)/VOLX(L,NY,NX)) - ELSE - THETW(L,NY,NX)=0.001 - ENDIF - THETP(L,NY,NX)=0.95-THETW(L,NY,NX) - THETI(L,NY,NX)=0.0 - VHCPR(NY,NX)=2.496E-06*ORGC(L,NY,NX)+4.19*VOLW(L,NY,NX) - 2+1.9274*VOLI(L,NY,NX) - ENDIF -C -C INITIALIZE SOM VARIABLES -C - DO 975 K=0,2 - CNOSCT(K)=0.0 - CPOSCT(K)=0.0 - IF(RSC(K,L,NY,NX).GT.ZEROS(NY,NX))THEN - RNT=0.0 - RPT=0.0 - DO 970 M=1,4 - RNT=RNT+RSC(K,L,NY,NX)*CFOSC(M,K,L,NY,NX)*CNOFC(M,K) - RPT=RPT+RSC(K,L,NY,NX)*CFOSC(M,K,L,NY,NX)*CPOFC(M,K) -970 CONTINUE - FRNT=RSN(K,L,NY,NX)/RNT - FRPT=RSP(K,L,NY,NX)/RPT - DO 960 M=1,4 - CNOSC(M,K,L,NY,NX)=CNOFC(M,K)*FRNT - CPOSC(M,K,L,NY,NX)=CPOFC(M,K)*FRPT - CNOSCT(K)=CNOSCT(K)+CFOSC(M,K,L,NY,NX)*CNOSC(M,K,L,NY,NX) - CPOSCT(K)=CPOSCT(K)+CFOSC(M,K,L,NY,NX)*CPOSC(M,K,L,NY,NX) -960 CONTINUE - ELSE - DO 965 M=1,4 - CNOSC(M,K,L,NY,NX)=CNRH(K) - CPOSC(M,K,L,NY,NX)=CPRH(K) -965 CONTINUE - CNOSCT(K)=CNRH(K) - CPOSCT(K)=CPRH(K) - ENDIF -975 CONTINUE - DO 990 K=3,4 - CNOSCT(K)=0.0 - CPOSCT(K)=0.0 - IF(CORGCX(K).GT.ZERO)THEN - DO 985 M=1,4 - CNOSC(M,K,L,NY,NX)=CORGNX(K)/CORGCX(K) - CPOSC(M,K,L,NY,NX)=CORGPX(K)/CORGCX(K) - CNOSCT(K)=CNOSCT(K)+CFOSC(M,K,L,NY,NX)*CNOSC(M,K,L,NY,NX) - CPOSCT(K)=CPOSCT(K)+CFOSC(M,K,L,NY,NX)*CPOSC(M,K,L,NY,NX) -985 CONTINUE - ELSE - DO 980 M=1,4 - CNOSC(M,K,L,NY,NX)=CNRH(K) - CPOSC(M,K,L,NY,NX)=CPRH(K) -980 CONTINUE - CNOSCT(K)=CNRH(K) - CPOSCT(K)=CPRH(K) - ENDIF -990 CONTINUE - TOSCI=0.0 - TOSNI=0.0 - TOSPI=0.0 - DO 995 K=0,4 - IF(L.EQ.0)THEN - KK=K - ELSE - KK=4 - ENDIF - OSCI(K)=CORGCX(K)*BKVL(L,NY,NX) - OSNI(K)=CORGNX(K)*BKVL(L,NY,NX) - OSPI(K)=CORGPX(K)*BKVL(L,NY,NX) - TOSCK(K)=OMCK(K)+ORCK(K)+OQCK(K)+OHCK(K) - TOSNK(K)=OMCI(1,K)*CNOMC(1,1,K)+OMCI(2,K)*CNOMC(2,1,K) - 2+ORCK(K)*CNRH(K)+OQCK(K)*CNOSCT(KK)+OHCK(K)*CNOSCT(KK) - TOSPK(K)=OMCI(1,K)*CPOMC(1,1,K)+OMCI(2,K)*CPOMC(2,1,K) - 2+ORCK(K)*CPRH(K)+OQCK(K)*CPOSCT(KK)+OHCK(K)*CPOSCT(KK) - TOSCI=TOSCI+OSCI(K)*TOSCK(K) - TOSNI=TOSNI+OSCI(K)*TOSNK(K) - TOSPI=TOSPI+OSCI(K)*TOSPK(K) - OSCX(K)=0.0 - OSNX(K)=0.0 - OSPX(K)=0.0 -995 CONTINUE - TOMC=0.0 - DO 8995 K=0,4 - IF(L.EQ.0)THEN - OSCM(K)=DCKR*CORGCX(K)*BKVL(L,NY,NX) - X=0.0 - KK=K - FOSCI=1.0 - FOSNI=1.0 - FOSPI=1.0 -C WRITE(*,2424)'OSCM',NX,NY,L,K,OSCM(K),CORGCX(K) -C 2,BKVL(L,NY,NX),CORGCX(K)*BKVL(L,NY,NX),FCX - ELSE - IF(K.LE.2)THEN - OSCM(K)=DCKR*CORGCX(K)*BKVL(L,NY,NX) - ELSE - OSCM(K)=FCX*CORGCX(K)*BKVL(L,NY,NX)*DCKM/(CORGCX(4)+DCKM) - ENDIF -2424 FORMAT(A8,4I4,12E12.4) - X=1.0 - KK=4 - IF(TOSCI.GT.ZEROS(NY,NX))THEN - FOSCI=AMIN1(1.0,OSCI(KK)/TOSCI) - FOSNI=AMIN1(1.0,OSCI(KK)*CNOSCT(KK)/TOSNI) - FOSPI=AMIN1(1.0,OSCI(KK)*CPOSCT(KK)/TOSPI) - ELSE - FOSCI=0.0 - FOSNI=0.0 - FOSPI=0.0 - ENDIF - ENDIF -C -C MICROBIAL C, N AND P -C - DO 7990 N=1,7 - DO 7985 M=1,3 - OMC(M,N,5,L,NY,NX)=0.0 - OMN(M,N,5,L,NY,NX)=0.0 - OMP(M,N,5,L,NY,NX)=0.0 -7985 CONTINUE -7990 CONTINUE - DO 8990 N=1,7 - DO 8991 M=1,3 - OMC1=AMAX1(0.0,OSCM(K)*OMCI(M,K)*OMCF(N)*FOSCI) - OMN1=AMAX1(0.0,OMC1*CNOMC(M,N,K)*FOSNI) - OMP1=AMAX1(0.0,OMC1*CPOMC(M,N,K)*FOSPI) - OMC(M,N,K,L,NY,NX)=OMC1 - OMN(M,N,K,L,NY,NX)=OMN1 - OMP(M,N,K,L,NY,NX)=OMP1 - OSCX(KK)=OSCX(KK)+OMC1 - OSNX(KK)=OSNX(KK)+OMN1 - OSPX(KK)=OSPX(KK)+OMP1 - DO 8992 NN=1,7 - OMC(M,NN,5,L,NY,NX)=OMC(M,NN,5,L,NY,NX)+OMC1*OMCA(NN) - OMN(M,NN,5,L,NY,NX)=OMN(M,NN,5,L,NY,NX)+OMN1*OMCA(NN) - OMP(M,NN,5,L,NY,NX)=OMP(M,NN,5,L,NY,NX)+OMP1*OMCA(NN) - OSCX(KK)=OSCX(KK)+OMC1*OMCA(NN) - OSNX(KK)=OSNX(KK)+OMN1*OMCA(NN) - OSPX(KK)=OSPX(KK)+OMP1*OMCA(NN) -8992 CONTINUE -8991 CONTINUE -8990 CONTINUE -C -C MICROBIAL RESIDUE C, N AND P -C - DO 8985 M=1,2 - ORC(M,K,L,NY,NX)=X*AMAX1(0.0,OSCM(K)*ORCI(M,K)*FOSCI) - ORN(M,K,L,NY,NX)=AMAX1(0.0,ORC(M,K,L,NY,NX)*CNOMC(M,1,K)*FOSNI) - ORP(M,K,L,NY,NX)=AMAX1(0.0,ORC(M,K,L,NY,NX)*CPOMC(M,1,K)*FOSPI) - OSCX(KK)=OSCX(KK)+ORC(M,K,L,NY,NX) - OSNX(KK)=OSNX(KK)+ORN(M,K,L,NY,NX) - OSPX(KK)=OSPX(KK)+ORP(M,K,L,NY,NX) -8985 CONTINUE -C -C DOC, DON AND DOP -C - OQC(K,L,NY,NX)=X*AMAX1(0.0,OSCM(K)*OQCK(K)*FOSCI) - OQN(K,L,NY,NX)=AMAX1(0.0,OQC(K,L,NY,NX)*CNOSCT(KK)*FOSNI) - OQP(K,L,NY,NX)=AMAX1(0.0,OQC(K,L,NY,NX)*CPOSCT(KK)*FOSPI) - OQA(K,L,NY,NX)=0.0 - OQCH(K,L,NY,NX)=0.0 - OQNH(K,L,NY,NX)=0.0 - OQPH(K,L,NY,NX)=0.0 - OQAH(K,L,NY,NX)=0.0 - OSCX(KK)=OSCX(KK)+OQC(K,L,NY,NX) - OSNX(KK)=OSNX(KK)+OQN(K,L,NY,NX) - OSPX(KK)=OSPX(KK)+OQP(K,L,NY,NX) -C -C ADSORBED C, N AND P -C - OHC(K,L,NY,NX)=X*AMAX1(0.0,OSCM(K)*OHCK(K)*FOSCI) - OHN(K,L,NY,NX)=AMAX1(0.0,OHC(K,L,NY,NX)*CNOSCT(KK)*FOSNI) - OHP(K,L,NY,NX)=AMAX1(0.0,OHC(K,L,NY,NX)*CPOSCT(KK)*FOSPI) - OHA(K,L,NY,NX)=0.0 - OSCX(KK)=OSCX(KK)+OHC(K,L,NY,NX)+OHA(K,L,NY,NX) - OSNX(KK)=OSNX(KK)+OHN(K,L,NY,NX) - OSPX(KK)=OSPX(KK)+OHP(K,L,NY,NX) -C -C HUMUS C, N AND P -C - DO 8980 M=1,4 - OSC(M,K,L,NY,NX)=AMAX1(0.0,CFOSC(M,K,L,NY,NX)*(OSCI(K)-OSCX(K))) - IF(CNOSCT(K).GT.ZERO)THEN - OSN(M,K,L,NY,NX)=AMAX1(0.0,CFOSC(M,K,L,NY,NX)*CNOSC(M,K,L,NY,NX) - 2/CNOSCT(K)*(OSNI(K)-OSNX(K))) - ELSE - OSN(M,K,L,NY,NX)=0.0 - ENDIF - IF(CPOSCT(K).GT.ZERO)THEN - OSP(M,K,L,NY,NX)=AMAX1(0.0,CFOSC(M,K,L,NY,NX)*CPOSC(M,K,L,NY,NX) - 2/CPOSCT(K)*(OSPI(K)-OSPX(K))) - ELSE - OSP(M,K,L,NY,NX)=0.0 - ENDIF - IF(K.EQ.0)THEN - OSA(M,K,L,NY,NX)=0.0 - ELSE - OSA(M,K,L,NY,NX)=OSC(M,K,L,NY,NX) - ENDIF -8980 CONTINUE -8995 CONTINUE - OC=0.0 - ON=0.0 - OP=0.0 - RC=0.0 - IF(L.EQ.0)THEN - DO 6975 K=0,5 - RC0(K,NY,NX)=0.0 - RA0(K,NY,NX)=0.0 -6975 CONTINUE - ENDIF - DO 6990 K=0,5 - DO 6990 N=1,7 - OC=OC+OMC(3,N,K,L,NY,NX) - ON=ON+OMN(3,N,K,L,NY,NX) - OP=OP+OMP(3,N,K,L,NY,NX) - IF(K.LE.2)THEN - RC=RC+OMC(3,N,K,L,NY,NX) - ENDIF - ROXYS(N,K,L,NY,NX)=0.0 - RVMX4(N,K,L,NY,NX)=0.0 - RVMX3(N,K,L,NY,NX)=0.0 - RVMX2(N,K,L,NY,NX)=0.0 - RVMX1(N,K,L,NY,NX)=0.0 - RINHO(N,K,L,NY,NX)=0.0 - RINOO(N,K,L,NY,NX)=0.0 - RIPOO(N,K,L,NY,NX)=0.0 - IF(L.EQ.0)THEN - RINHOR(N,K,NY,NX)=0.0 - RINOOR(N,K,NY,NX)=0.0 - RIPOOR(N,K,NY,NX)=0.0 - ENDIF - DO 6990 M=1,3 - OC=OC+OMC(M,N,K,L,NY,NX) - ON=ON+OMN(M,N,K,L,NY,NX) - OP=OP+OMP(M,N,K,L,NY,NX) - IF(K.LE.2)THEN - RC=RC+OMC(M,N,K,L,NY,NX) - ENDIF - RC0(K,NY,NX)=RC0(K,NY,NX)+OMC(M,N,K,L,NY,NX) - RA0(K,NY,NX)=RA0(K,NY,NX)+OMC(M,N,K,L,NY,NX) -6990 CONTINUE - DO 6995 K=0,4 - DO 6985 M=1,2 - OC=OC+ORC(M,K,L,NY,NX) - ON=ON+ORN(M,K,L,NY,NX) - OP=OP+ORP(M,K,L,NY,NX) - IF(K.LE.2)THEN - RC=RC+ORC(M,K,L,NY,NX) - ENDIF - IF(L.EQ.0)THEN - RC0(K,NY,NX)=RC0(K,NY,NX)+ORC(M,K,L,NY,NX) - RA0(K,NY,NX)=RA0(K,NY,NX)+ORC(M,K,L,NY,NX) - ENDIF -6985 CONTINUE - OC=OC+OQC(K,L,NY,NX)+OQCH(K,L,NY,NX)+OHC(K,L,NY,NX) - 2+OQA(K,L,NY,NX)+OQAH(K,L,NY,NX)+OHA(K,L,NY,NX) - ON=ON+OQN(K,L,NY,NX)+OQNH(K,L,NY,NX)+OHN(K,L,NY,NX) - OP=OP+OQP(K,L,NY,NX)+OQPH(K,L,NY,NX)+OHP(K,L,NY,NX) - OC=OC+OQA(K,L,NY,NX)+OQAH(K,L,NY,NX) - IF(K.LE.2)THEN - RC=RC+OQC(K,L,NY,NX)+OQCH(K,L,NY,NX)+OHC(K,L,NY,NX) - 2+OQA(K,L,NY,NX)+OQAH(K,L,NY,NX)+OHA(K,L,NY,NX) - RC=RC+OQA(K,L,NY,NX)+OQAH(K,L,NY,NX) - ENDIF - IF(L.EQ.0)THEN - RC0(K,NY,NX)=RC0(K,NY,NX)+OQC(K,L,NY,NX)+OQCH(K,L,NY,NX) - 2+OHC(K,L,NY,NX)+OQA(K,L,NY,NX)+OQAH(K,L,NY,NX)+OHA(K,L,NY,NX) - RA0(K,NY,NX)=RA0(K,NY,NX)+OQC(K,L,NY,NX)+OQCH(K,L,NY,NX) - 2+OHC(K,L,NY,NX)+OQA(K,L,NY,NX)+OQAH(K,L,NY,NX)+OHA(K,L,NY,NX) - ENDIF - DO 6980 M=1,4 - OC=OC+OSC(M,K,L,NY,NX) - ON=ON+OSN(M,K,L,NY,NX) - OP=OP+OSP(M,K,L,NY,NX) - IF(K.LE.2)THEN - RC=RC+OSC(M,K,L,NY,NX) - ENDIF - IF(L.EQ.0)THEN - RC0(K,NY,NX)=RC0(K,NY,NX)+OSC(M,K,L,NY,NX) - RA0(K,NY,NX)=RA0(K,NY,NX)+OSA(M,K,L,NY,NX) - ENDIF -6980 CONTINUE -6995 CONTINUE - ORGC(L,NY,NX)=OC - ORGR(L,NY,NX)=RC -C -C INITIALIZE FERTILIZER ARRAYS -C - ZNH4FA(L,NY,NX)=0.0 - ZNH3FA(L,NY,NX)=0.0 - ZNHUFA(L,NY,NX)=0.0 - ZNO3FA(L,NY,NX)=0.0 - IF(L.GT.0)THEN - ZNH4FB(L,NY,NX)=0.0 - ZNH3FB(L,NY,NX)=0.0 - ZNHUFB(L,NY,NX)=0.0 - ZNO3FB(L,NY,NX)=0.0 - WDNHB(L,NY,NX)=0.0 - DPNHB(L,NY,NX)=0.0 - WDNOB(L,NY,NX)=0.0 - DPNOB(L,NY,NX)=0.0 - WDPOB(L,NY,NX)=0.0 - DPPOB(L,NY,NX)=0.0 - ENDIF - VLNH4(L,NY,NX)=1.0 - VLNO3(L,NY,NX)=1.0 - VLPO4(L,NY,NX)=1.0 - VLNHB(L,NY,NX)=0.0 - VLNOB(L,NY,NX)=0.0 - VLPOB(L,NY,NX)=0.0 - ROXYX(L,NY,NX)=0.0 - RNH4X(L,NY,NX)=0.0 - RNO3X(L,NY,NX)=0.0 - RNO2X(L,NY,NX)=0.0 - RN2OX(L,NY,NX)=0.0 - RPO4X(L,NY,NX)=0.0 - RVMXC(L,NY,NX)=0.0 - RNHBX(L,NY,NX)=0.0 - RN3BX(L,NY,NX)=0.0 - RN2BX(L,NY,NX)=0.0 - RPOBX(L,NY,NX)=0.0 - RVMBC(L,NY,NX)=0.0 - DO 1250 K=0,4 - IF(L.GT.0)THEN - COCU(K,L,NY,NX)=0.0 - CONU(K,L,NY,NX)=0.0 - COPU(K,L,NY,NX)=0.0 - COAU(K,L,NY,NX)=0.0 - ENDIF -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 -9890 CONTINUE -9895 CONTINUE - RETURN - END + + SUBROUTINE starts(NHW,NHE,NVN,NVS) +C +C THIS SUBROUTINE INITIALIZES ALL SOIL VARIABLES +C + include "parameters.h" + include "blkc.h" + include "blk2a.h" + include "blk2b.h" + include "blk2c.h" + include "blk5.h" + include "blk8a.h" + include "blk8b.h" + include "blk11a.h" + include "blk11b.h" + include "blk13a.h" + include "blk13b.h" + include "blk13c.h" + include "blk16.h" + include "blk18a.h" + include "blk18b.h" + DIMENSION YSIN(4),YCOS(4),YAZI(4),ZAZI(4),OSCI(0:4),OSNI(0:4) + 2,ORCI(2,0:4),OSPI(0:4),OSCM(0:4),CORGCX(0:4) + 3,CORGNX(0:4),CORGPX(0:4),CNOSCT(0:4),CPOSCT(0:4) + 4,GSINA(JY,JX),GCOSA(JY,JX),ALTX(JV,JH) + 5,OSCX(0:4),OSNX(0:4),OSPX(0:4),OMCK(0:4),ORCK(0:4),OQCK(0:4) + 6,OHCK(0:4),TOSCK(0:4),TOSNK(0:4),TOSPK(0:4),TORGL(JZ) + PARAMETER (OQKM=12.0,DCKR=0.25,DCKM=2.5E+04,PSIPS=-0.5E-03) + DATA OMCI/0.005,0.050,0.005,0.050,0.050,0.005,0.050,0.050,0.005 + 2,0.005,0.050,0.005,0.005,0.050,0.005/ + DATA ORCI/0.01,0.05,0.01,0.05,0.01,0.05 + 2,0.001,0.005,0.001,0.005/ + DATA OMCK/0.01,0.01,0.01,0.01,0.01/ + DATA ORCK/0.25,0.25,0.25,0.25,0.25/ + DATA OQCK/0.005,0.005,0.005,0.005,0.005/ + DATA OHCK/0.05,0.05,0.05,0.05,0.05/ + DATA OMCF/0.20,0.20,0.30,0.20,0.050,0.025,0.025/ + DATA OMCA/0.06,0.02,0.01,0.0,0.01,0.0,0.0/ + DATA CNRH/3.33E-02,3.33E-02,3.33E-02,5.00E-02,12.50E-02/ + 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/ + NDIM=1 + IF(NHE.GT.NHW)NDIM=NDIM+1 + IF(NVS.GT.NVN)NDIM=NDIM+1 + XDIM=1.0/NDIM + ZERO=1.0E-16 + TAREA=0.0 + THETX=2.5E-03 +C +C INITIALIZE MASS BALANCE CHECKS +C + CRAIN=0.0 + HEATIN=0.0 + CO2GIN=0.0 + OXYGIN=0.0 + TZIN=0.0 + ZN2GIN=0.0 + TPIN=0.0 + TORGF=0.0 + TORGN=0.0 + TORGP=0.0 + TFERTN=0.0 + TFERTP=0.0 + VOLWOU=0.0 + CEVAP=0.0 + CRUN=0.0 + HEATOU=0.0 + OXYGOU=0.0 + TSEDOU=0.0 + TCOU=0.0 + TZOU=0.0 + TPOU=0.0 + XCSN=0.0 + XZSN=0.0 + XPSN=0.0 + TIONIN=0.0 + TIONOU=0.0 + VAP=2465.0 + VAPW=2834.0 + OXKM=0.064 + TYSIN=0.0 + ZSIN(1)=0.195 + ZSIN(2)=0.556 + ZSIN(3)=0.831 + ZSIN(4)=0.981 + ZCOS(1)=0.981 + ZCOS(2)=0.831 + ZCOS(3)=0.556 + ZCOS(4)=0.195 + DO 205 L=1,4 + ZAZI(L)=(L-0.5)*3.1416/4.0 +205 CONTINUE + DO 230 N=1,4 + YAZI(N)=3.1416*(2*N-1)/4.0 + YAGL=3.1416/4.0 + YSIN(N)=SIN(YAGL) + YCOS(N)=COS(YAGL) + TYSIN=TYSIN+YSIN(N) + DO 225 L=1,4 + DAZI=COS(ZAZI(L)-YAZI(N)) + DO 225 M=1,4 + OMEGY=ZCOS(M)*YSIN(N)+ZSIN(M)*YCOS(N)*DAZI + OMEGA(N,M,L)=ABS(OMEGY) + OMEGX(N,M,L)=OMEGA(N,M,L)/YSIN(N) + IF(ZCOS(M).GT.YSIN(N))THEN + OMEGZ=ACOS(OMEGY) + ELSE + OMEGZ=-ACOS(OMEGY) + ENDIF + IF(OMEGZ.GT.-1.5708)THEN + ZAGL=YAGL+2.0*OMEGZ + ELSE + ZAGL=YAGL-2.0*(3.1416+OMEGZ) + ENDIF + IF(ZAGL.GT.0.0.AND.ZAGL.LT.3.1416)THEN + IALBY(N,M,L)=1 + ELSE + IALBY(N,M,L)=2 + ENDIF +225 CONTINUE +230 CONTINUE +C +C INITIALIZE C-N AND C-P RATIOS OF RESIDUE AND SOIL +C + CNOFC(1,0)=0.005 + CNOFC(2,0)=0.005 + CNOFC(3,0)=0.005 + CNOFC(4,0)=0.020 + CPOFC(1,0)=0.0005 + CPOFC(2,0)=0.0005 + CPOFC(3,0)=0.0005 + CPOFC(4,0)=0.0020 + CNOFC(1,1)=0.020 + CNOFC(2,1)=0.020 + CNOFC(3,1)=0.020 + CNOFC(4,1)=0.020 + CPOFC(1,1)=0.0020 + CPOFC(2,1)=0.0020 + CPOFC(3,1)=0.0020 + CPOFC(4,1)=0.0020 + CNOFC(1,2)=0.005 + CNOFC(2,2)=0.005 + CNOFC(3,2)=0.005 + CNOFC(4,2)=0.020 + CPOFC(1,2)=0.0005 + CPOFC(2,2)=0.0005 + CPOFC(3,2)=0.0005 + CPOFC(4,2)=0.0020 + FL(1)=0.55 + FL(2)=0.45 + DO 95 K=0,5 + DO 95 N=1,7 + IF(K.LE.4.AND.N.EQ.3)THEN + CNOMC(1,N,K)=0.15 + CNOMC(2,N,K)=0.09 + CPOMC(1,N,K)=0.015 + CPOMC(2,N,K)=0.009 + ELSE + CNOMC(1,N,K)=0.225 + CNOMC(2,N,K)=0.135 + CPOMC(1,N,K)=0.0225 + CPOMC(2,N,K)=0.0135 + ENDIF + CNOMC(3,N,K)=FL(1)*CNOMC(1,N,K)+FL(2)*CNOMC(2,N,K) + CPOMC(3,N,K)=FL(1)*CPOMC(1,N,K)+FL(2)*CPOMC(2,N,K) +95 CONTINUE +C +C CALCULATE ELEVATION OF EACH GRID CELL +C + ALTY=0.0 + DO 9985 NX=NHW,NHE + DO 9980 NY=NVN,NVS + ZEROS(NY,NX)=ZERO*DH(NY,NX)*DV(NY,NX) + GAZI(NY,NX)=ASP(NY,NX)/57.29577951 + GSINA(NY,NX)=ABS(SIN(GAZI(NY,NX))) + GCOSA(NY,NX)=ABS(COS(GAZI(NY,NX))) + GSIN(NY,NX)=SIN(SL(1,NY,NX)/57.29577951)*GCOSA(NY,NX) + 2+SIN(SL(2,NY,NX)/57.29577951)*GSINA(NY,NX) + GCOS(NY,NX)=SQRT(1.0-GSIN(NY,NX)**2) + DO 240 N=1,4 + DGAZI=COS(GAZI(NY,NX)-YAZI(N)) + OMEGAG(N,NY,NX)=AMAX1(0.0,AMIN1(1.0,GCOS(NY,NX)*YSIN(N) + 2+GSIN(NY,NX)*YCOS(N)*DGAZI)) +240 CONTINUE + IF(ASP(NY,NX).GT.90.0.AND.ASP(NY,NX).LT.270.0)THEN + SLOPE(1,NY,NX)=SIN(SL(1,NY,NX)/57.29577951) + ELSE + SLOPE(1,NY,NX)=-SIN(SL(1,NY,NX)/57.29577951) + ENDIF + IF(ASP(NY,NX).GT.0.0.AND.ASP(NY,NX).LT.180.0)THEN + SLOPE(2,NY,NX)=SIN(SL(2,NY,NX)/57.29577951) + ELSE + SLOPE(2,NY,NX)=-SIN(SL(2,NY,NX)/57.29577951) + ENDIF + SLOPE(3,NY,NX)=-1.0 + IF(NX.EQ.NHW)THEN + IF(NY.EQ.NVN)THEN + ALT(NY,NX)=0.5*DH(NY,NX)*SLOPE(1,NY,NX) + 2+0.5*DV(NY,NX)*SLOPE(2,NY,NX) + ELSE + ALT(NY,NX)=ALT(NY-1,NX) + 2+0.5*DH(NY,NX)*SLOPE(1,NY,NX) + 4+0.5*DV(NY,NX)*(SLOPE(2,NY,NX)) + 5+0.5*DV(NY-1,NX)*SLOPE(2,NY-1,NX) + ENDIF + ELSE + IF(NY.EQ.NVN)THEN + ALT(NY,NX)=ALT(NY,NX-1) + 2+0.5*DH(NY,NX)*SLOPE(1,NY,NX) + 3+0.5*DH(NY,NX-1)*SLOPE(1,NY,NX-1) + ELSE + ALT(NY,NX)=(ALT(NY,NX-1) + 2+0.5*DH(NY,NX)*SLOPE(1,NY,NX) + 3+0.5*DH(NY,NX-1)*SLOPE(1,NY,NX-1) + 4+ALT(NY-1,NX) + 4+0.5*DV(NY,NX)*SLOPE(2,NY,NX) + 5+0.5*DV(NY-1,N)*SLOPE(2,NY-1,NX))/2.0 + ENDIF + ENDIF + IF(NX.EQ.NHW.AND.NY.EQ.NVN)THEN + ALTY=ALT(NY,NX) + 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) +1111 FORMAT(A8,2I4,20E12.4) +9980 CONTINUE +9985 CONTINUE +C +C INITIALIZE ACCUMULATORS AND MASS BALANCE CHECKS +C OF EACH GRID CELL +C + ALTZG=0.0 + CDPTHG=0.0 + DO 9995 NX=NHW,NHE + DO 9990 NY=NVN,NVS + DO 600 N=1,12 + TDTPX(NY,NX,N)=0.0 + TDTPN(NY,NX,N)=0.0 + TDRAD(NY,NX,N)=1.0 + TDWND(NY,NX,N)=1.0 + TDHUM(NY,NX,N)=1.0 + TDPRC(NY,NX,N)=1.0 + TDIRI(NY,NX,N)=1.0 + TDCO2(NY,NX,N)=1.0 + TDCN4(NY,NX,N)=1.0 + TDCNO(NY,NX,N)=1.0 +600 CONTINUE + IUTYP(NY,NX)=0 + IFNHB(NY,NX)=0 + IFNOB(NY,NX)=0 + IFPOB(NY,NX)=0 + IFLGS(NY,NX)=1 + IFLGT(NY,NX)=0 + ATCA(NY,NX)=ATCAI(NY,NX) + ATCS(NY,NX)=ATCAI(NY,NX) + ATKA(NY,NX)=ATCA(NY,NX)+273.15 + ATKS(NY,NX)=ATCS(NY,NX)+273.15 + URAIN(NY,NX)=0.0 + UCO2G(NY,NX)=0.0 + UCH4G(NY,NX)=0.0 + UOXYG(NY,NX)=0.0 + UN2GG(NY,NX)=0.0 + UN2OG(NY,NX)=0.0 + UNH3G(NY,NX)=0.0 + UN2GS(NY,NX)=0.0 + UCO2F(NY,NX)=0.0 + UCH4F(NY,NX)=0.0 + UOXYF(NY,NX)=0.0 + UN2OF(NY,NX)=0.0 + UNH3F(NY,NX)=0.0 + UPO4F(NY,NX)=0.0 + UORGF(NY,NX)=0.0 + UFERTN(NY,NX)=0.0 + UFERTP(NY,NX)=0.0 + UVOLO(NY,NX)=0.0 + UEVAP(NY,NX)=0.0 + URUN(NY,NX)=0.0 + USEDOU(NY,NX)=0.0 + UCOP(NY,NX)=0.0 + UDOCQ(NY,NX)=0.0 + UDOCD(NY,NX)=0.0 + UDONQ(NY,NX)=0.0 + UDOND(NY,NX)=0.0 + UDOPQ(NY,NX)=0.0 + UDOPD(NY,NX)=0.0 + UDICQ(NY,NX)=0.0 + UDICD(NY,NX)=0.0 + UDINQ(NY,NX)=0.0 + UDIND(NY,NX)=0.0 + UDIPQ(NY,NX)=0.0 + UDIPD(NY,NX)=0.0 + UIONOU(NY,NX)=0.0 + UXCSN(NY,NX)=0.0 + UXZSN(NY,NX)=0.0 + UXPSN(NY,NX)=0.0 + UDRAIN(NY,NX)=0.0 + ZDRAIN(NY,NX)=0.0 + PDRAIN(NY,NX)=0.0 + DPNH4(NY,NX)=0.0 + DPNO3(NY,NX)=0.0 + DPPO4(NY,NX)=0.0 + TCS(0,NY,NX)=ATCS(NY,NX) + TKS(0,NY,NX)=TCS(0,NY,NX)+273.15 + OXYS(0,NY,NX)=0.0 + FRADG(NY,NX)=1.0 + THRMG(NY,NX)=0.0 + THRMC(NY,NX)=0.0 + TRN(NY,NX)=0.0 + TLE(NY,NX)=0.0 + TSH(NY,NX)=0.0 + TGH(NY,NX)=0.0 + TLEC(NY,NX)=0.0 + TSHC(NY,NX)=0.0 + TLEX(NY,NX)=0.0 + TSHX(NY,NX)=0.0 + TCNET(NY,NX)=0.0 + TVOLWC(NY,NX)=0.0 + ARLFC(NY,NX)=0.0 + ARSTC(NY,NX)=0.0 + TFLWC(NY,NX)=0.0 + PPT(NY,NX)=0.0 + DYLN(NY,NX)=12.0 + DENS0(NY,NX)=0.100 + DENS1(NY,NX)=1.0 + VOLSS(NY,NX)=DPTHS(NY,NX)*DENS0(NY,NX)*DH(NY,NX)*DV(NY,NX) + VOLWS(NY,NX)=0.0 + VOLIS(NY,NX)=0.0 + VOLS(NY,NX)=VOLSS(NY,NX)/DENS0(NY,NX)+VOLWS(NY,NX)+VOLIS(NY,NX) + DPTHA(NY,NX)=9999.0 + TCW(NY,NX)=0.0 + TKW(NY,NX)=TCW(NY,NX)+273.15 + ALBX(NY,NX)=ALBS(NY,NX) + XHVSTC(NY,NX)=0.0 + XHVSTN(NY,NX)=0.0 + XHVSTP(NY,NX)=0.0 + ALT(NY,NX)=ALT(NY,NX)-ALTY + IF(NX.EQ.NHW.AND.NY.EQ.NVN)THEN + ALTZG=ALT(NY,NX) + ELSE + ALTZG=MIN(ALTZG,ALT(NY,NX)) + ENDIF + CDPTHG=AMAX1(CDPTHG,CDPTH(NU(NY,NX),NY,NX)) +C +C INITIALIZE ATMOSPHERE VARIABLES +C + CCO2EI(NY,NX)=CO2EI(NY,NX)*5.36E-04*273.15/ATKA(NY,NX) + CCO2E(NY,NX)=CO2E(NY,NX)*5.36E-04*273.15/ATKA(NY,NX) + CCH4E(NY,NX)=CH4E(NY,NX)*5.36E-04*273.15/ATKA(NY,NX) + COXYE(NY,NX)=OXYE(NY,NX)*1.43E-03*273.15/ATKA(NY,NX) + CZ2GE(NY,NX)=Z2GE(NY,NX)*1.25E-03*273.15/ATKA(NY,NX) + CZ2OE(NY,NX)=Z2OE(NY,NX)*1.25E-03*273.15/ATKA(NY,NX) + CNH3E(NY,NX)=ZNH3E(NY,NX)*6.25E-04*273.15/ATKA(NY,NX) + CH2GE(NY,NX)=H2GE(NY,NX)*8.92E-05*273.15/ATKA(NY,NX) +C +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) +2222 FORMAT(A8,2E12.4) +C +C CALCULATE WHETHER BOUNDARY SLOPES ALLOW RUNOFF +C + DO 9575 N=1,2 + DO 9575 NN=1,2 + IF(N.EQ.1)THEN + IF(NN.EQ.1)THEN + IF(NX.EQ.NHE)THEN + IF(ASP(NY,NX).GT.90.0.AND.ASP(NY,NX).LT.270.0 + 2.AND.SL(2,NY,NX).GT.0.0)THEN + IRCHG(NN,N,NY,NX)=0 + ELSE + IRCHG(NN,N,NY,NX)=1 + ENDIF + ELSE + GO TO 9575 + ENDIF + ELSEIF(NN.EQ.2)THEN + IF(NX.EQ.NHW)THEN + IF(ASP(NY,NX).LT.90.0.OR.ASP(NY,NX).GT.270.0 + 2.AND.SL(2,NY,NX).GT.0.0)THEN + IRCHG(NN,N,NY,NX)=0 + ELSE + IRCHG(NN,N,NY,NX)=1 + ENDIF + ELSE + GO TO 9575 + ENDIF + ENDIF + ELSEIF(N.EQ.2)THEN + IF(NN.EQ.1)THEN + IF(NY.EQ.NVS)THEN + IF(ASP(NY,NX).LT.180.0.AND.ASP(NY,NX).GT.0.0 + 2.AND.SL(1,NY,NX).GT.0.0)THEN + IRCHG(NN,N,NY,NX)=0 + ELSE + IRCHG(NN,N,NY,NX)=1 + ENDIF + ELSE + GO TO 9575 + ENDIF + ELSEIF(NN.EQ.2)THEN + IF(NY.EQ.NVN)THEN + IF(ASP(NY,NX).EQ.0)THEN + ASP2=360.0 + ELSE + ASP2=ASP(NY,NX) + ENDIF + IF(ASP2.GT.180.0.AND.ASP2.LT.360.0 + 2.AND.SL(1,NY,NX).GT.0.0)THEN + IRCHG(NN,N,NY,NX)=0 + ELSE + IRCHG(NN,N,NY,NX)=1 + ENDIF + ELSE + GO TO 9575 + ENDIF + ENDIF + ENDIF +9575 CONTINUE +C +C INITIALIZE WATER AND TEMPERATURE VARIABLES FOR SOIL LAYERS +C + PSIMS(NY,NX)=LOG(-PSIPS) + PSIMX(NY,NX)=LOG(-PSIFC(NY,NX)) + PSIMN(NY,NX)=LOG(-PSIWP(NY,NX)) + PSISD(NY,NX)=PSIMX(NY,NX)-PSIMS(NY,NX) + PSIMD(NY,NX)=PSIMN(NY,NX)-PSIMX(NY,NX) + NW(NY,NX)=0 + CORGC(0,NY,NX)=0.5E+06 +C +C DISTRIBUTION OF OM AMONG FRACTIONS OF DIFFERING +C BIOLOGICAL ACTIVITY +C + DO 1195 L=0,NL(NY,NX) +C +C LAYER DEPTHS AND THEIR PHYSICAL PROPOERTIES +C + DLYR(1,L,NY,NX)=DH(NY,NX) + DLYR(2,L,NY,NX)=DV(NY,NX) + AREA(3,L,NY,NX)=DLYR(1,L,NY,NX)*DLYR(2,L,NY,NX) + IF(L.EQ.0)THEN + TAREA=TAREA+AREA(3,L,NY,NX) + CDPTH(L,NY,NX)=0.0 + CDPTHZ(L,NY,NX)=0.0 + ORGC(L,NY,NX)=(RSC(0,L,NY,NX)+RSC(1,L,NY,NX)+RSC(2,L,NY,NX)) + 2*AREA(3,L,NY,NX) + VOLR(NY,NX)=(RSC(0,L,NY,NX)*1.0E-06/BKRS(0) + 2+RSC(1,L,NY,NX)*1.0E-06/BKRS(1)+RSC(2,L,NY,NX)*1.0E-06/BKRS(2)) + 2*AREA(3,L,NY,NX) + VOLT(L,NY,NX)=VOLR(NY,NX) + VOLX(L,NY,NX)=VOLT(L,NY,NX) + BKVL(L,NY,NX)=2.00E-06*ORGC(L,NY,NX) + DLYR(3,L,NY,NX)=VOLX(L,NY,NX)/AREA(3,L,NY,NX) + ELSE + DLYR(3,L,NY,NX)=(CDPTH(L,NY,NX)-CDPTH(L-1,NY,NX)) + DPTH(L,NY,NX)=0.5*(CDPTH(L,NY,NX)+CDPTH(L-1,NY,NX)) + CDPTHZ(L,NY,NX)=CDPTH(L,NY,NX)-CDPTH(NU(NY,NX),NY,NX) + 2+DLYR(3,NU(NY,NX),NY,NX) + DPTHZ(L,NY,NX)=0.5*(CDPTHZ(L,NY,NX)+CDPTHZ(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) + BKVL(L,NY,NX)=BKDS(L,NY,NX)*VOLX(L,NY,NX) + YDPTH(L,NY,NX)=ALT(NY,NX)-DPTH(L,NY,NX) + RTDNT(L,NY,NX)=0.0 + IF(BKDS(L,NY,NX).GT.0.0.AND.NW(NY,NX).EQ.0)NW(NY,NX)=L + ENDIF + AREA(1,L,NY,NX)=DLYR(3,L,NY,NX)*DLYR(2,L,NY,NX) + AREA(2,L,NY,NX)=DLYR(3,L,NY,NX)*DLYR(1,L,NY,NX) +1195 CONTINUE +C +C SURFACE WATER STORAGE AND LOWER HEAT SINK +C + ZS(NY,NX)=0.025 + DS=AMAX1(0.0,0.112*ZS(NY,NX)+3.10*ZS(NY,NX)**2 + 2-0.012*ZS(NY,NX)*GSIN(NY,NX)) + VOLWG(NY,NX)=VOLA(NU(NY,NX),NY,NX)+VOLAH(NU(NY,NX),NY,NX) + 2+DS*AREA(3,NU(NY,NX),NY,NX) + VHCPW(NY,NX)=2.095*VOLSS(NY,NX)+4.19*VOLWS(NY,NX) + 2+1.9274*VOLIS(NY,NX) + VHCPWX(NY,NX)=10.5E-03*AREA(3,NU(NY,NX),NY,NX) + VHCPRX(NY,NX)=10.5E-05*AREA(3,NU(NY,NX),NY,NX) + DPTHSK(NY,NX)=AMAX1(10.0,CDPTH(NL(NY,NX),NY,NX)+1.0) + TCNDG=8.1E-03 + TKSD(NY,NX)=ATKS(NY,NX)+2.052E-04*DPTHSK(NY,NX)/TCNDG +C +C INITIALIZE COMMUNITY CANOPY +C + ZT(NY,NX)=0.0 + ZL(0,NY,NX)=0.0 + DO 1925 L=1,JC + ZL(L,NY,NX)=0.0 + ARLFT(L,NY,NX)=0.0 + ARSTT(L,NY,NX)=0.0 + WGLFT(L,NY,NX)=0.0 +1925 CONTINUE +9990 CONTINUE +9995 CONTINUE +C +C INITIALIZE GRID CELL DIMENSIONS +C + DO 9895 NX=NHW,NHE + DO 9890 NY=NVN,NVS + ALTZ(NY,NX)=ALTZG + IF(BKDS(NU(NY,NX),NY,NX).GT.0.0)THEN + DTBLZ(NY,NX)=DTBLI(NY,NX)-(ALTZ(NY,NX)-ALT(NY,NX)) + 2*(1.0-DTBLG(NY,NX)) + DDRG(NY,NX)=AMAX1(0.0,DDRGI(NY,NX)-(ALTZ(NY,NX)-ALT(NY,NX)) + 2*(1.0-DTBLG(NY,NX))) + ELSE + DTBLZ(NY,NX)=0.0 + DDRG(NY,NX)=0.0 + ENDIF + DPTHT(NY,NX)=DTBLZ(NY,NX) + DO 4400 L=1,NL(NY,NX) + N1=NX + N2=NY + N3=L + DO 4320 N=NCN(N2,N1),3 + IF(N.EQ.1)THEN + IF(NX.EQ.NHE)THEN + GO TO 4320 + ELSE + N4=NX+1 + N5=NY + N6=L + ENDIF + ELSEIF(N.EQ.2)THEN + IF(NY.EQ.NVS)THEN + GO TO 4320 + ELSE + N4=NX + N5=NY+1 + N6=L + ENDIF + ELSEIF(N.EQ.3)THEN + IF(L.EQ.NL(NY,NX))THEN + GO TO 4320 + ELSE + N4=NX + N5=NY + N6=L+1 + ENDIF + ENDIF + DIST(N,N6,N5,N4)=0.5*(DLYR(N,N3,N2,N1)+DLYR(N,N6,N5,N4)) + XDPTH(N,N6,N5,N4)=AREA(N,N3,N2,N1)/DIST(N,N6,N5,N4) + DISP(N,N6,N5,N4)=0.20*DIST(N,N6,N5,N4)**1.07 +4320 CONTINUE + IF(L.EQ.NU(NY,NX))THEN + DIST(3,N3,N2,N1)=0.5*DLYR(3,N3,N2,N1) + XDPTH(3,N3,N2,N1)=AREA(3,N3,N2,N1)/DIST(3,N3,N2,N1) + DISP(3,N3,N2,N1)=0.20*DIST(3,N3,N2,N1)**1.07 + ENDIF +4400 CONTINUE +C +C INITIALIZE SOM FROM ORGANIC INPUTS IN SOIL FILE FROM 'READS' +C + TORGC=0.0 + DO 1190 L=NU(NY,NX),NL(NY,NX) + CORGCZ=CORGC(L,NY,NX) + CORGRZ=CORGR(L,NY,NX) + CORGNZ=CORGN(L,NY,NX) + CORGPZ=CORGP(L,NY,NX) + CORGCX(3)=CORGRZ + CORGCX(4)=AMAX1(0.0,CORGCZ-CORGCX(3)) + CORGNX(3)=AMIN1(CNRH(3)*CORGCX(3),CORGNZ) + CORGNX(4)=AMAX1(0.0,CORGNZ-CORGNX(3)) + CORGPX(3)=AMIN1(CPRH(3)*CORGCX(3),CORGPZ) + CORGPX(4)=AMAX1(0.0,CORGPZ-CORGPX(3)) + CORGL=AMAX1(0.0,CORGC(L,NY,NX)-CORGR(L,NY,NX)) + 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))) + IF(TORGM.GT.ZERO)THEN + HCX=LOG(0.5)/TORGM + ELSE + HCX=0.0 + ENDIF + DO 1200 L=0,NL(NY,NX) + IF(BKVL(L,NY,NX).GT.0.0)THEN + CORGCX(0)=RSC(0,L,NY,NX)*AREA(3,L,NY,NX)/BKVL(L,NY,NX) + CORGCX(1)=RSC(1,L,NY,NX)*AREA(3,L,NY,NX)/BKVL(L,NY,NX) + CORGCX(2)=RSC(2,L,NY,NX)*AREA(3,L,NY,NX)/BKVL(L,NY,NX) + CORGNX(0)=RSN(0,L,NY,NX)*AREA(3,L,NY,NX)/BKVL(L,NY,NX) + CORGNX(1)=RSN(1,L,NY,NX)*AREA(3,L,NY,NX)/BKVL(L,NY,NX) + CORGNX(2)=RSN(2,L,NY,NX)*AREA(3,L,NY,NX)/BKVL(L,NY,NX) + CORGPX(0)=RSP(0,L,NY,NX)*AREA(3,L,NY,NX)/BKVL(L,NY,NX) + CORGPX(1)=RSP(1,L,NY,NX)*AREA(3,L,NY,NX)/BKVL(L,NY,NX) + CORGPX(2)=RSP(2,L,NY,NX)*AREA(3,L,NY,NX)/BKVL(L,NY,NX) + ELSE + CORGCX(0)=0.5E+06 + CORGCX(1)=0.5E+06 + CORGCX(2)=0.5E+06 + CORGNX(0)=0.5E+05 + CORGNX(1)=0.5E+05 + CORGNX(2)=0.5E+05 + CORGPX(0)=0.5E+04 + CORGPX(1)=0.5E+04 + CORGPX(2)=0.5E+04 + ENDIF + IF(L.GT.0)THEN + CORGCZ=CORGC(L,NY,NX) + CORGRZ=CORGR(L,NY,NX) + CORGNZ=CORGN(L,NY,NX) + CORGPZ=CORGP(L,NY,NX) + IF(CORGCZ.GT.ZERO)THEN + CORGCX(3)=CORGRZ + CORGCX(4)=AMAX1(0.0,CORGCZ-CORGCX(3)) + CORGNX(3)=AMIN1(CNRH(3)*CORGCX(3),CORGNZ) + CORGNX(4)=AMAX1(0.0,CORGNZ-CORGNX(3)) + CORGPX(3)=AMIN1(CPRH(3)*CORGCX(3),CORGPZ) + CORGPX(4)=AMAX1(0.0,CORGPZ-CORGPX(3)) + ELSE + CORGCX(3)=0.0 + CORGCX(4)=0.0 + CORGNX(3)=0.0 + CORGNX(4)=0.0 + CORGPX(3)=0.0 + CORGPX(4)=0.0 + ENDIF + ELSE + CORGCX(3)=0.0 + CORGCX(4)=0.0 + CORGNX(3)=0.0 + CORGNX(4)=0.0 + CORGPX(3)=0.0 + CORGPX(4)=0.0 + ENDIF +C +C SURFACE RESIDUE +C + IF(L.EQ.0)THEN +C +C PREVIOUS COARSE WOODY RESIDUE +C + CFOSC(1,0,L,NY,NX)=0.000 + CFOSC(2,0,L,NY,NX)=0.045 + CFOSC(3,0,L,NY,NX)=0.660 + CFOSC(4,0,L,NY,NX)=0.295 +C +C MAIZE +C + IF(IXTYP(1,NY,NX).EQ.1)THEN + CFOSC(1,1,L,NY,NX)=0.080 + CFOSC(2,1,L,NY,NX)=0.245 + CFOSC(3,1,L,NY,NX)=0.613 + CFOSC(4,1,L,NY,NX)=0.062 +C +C WHEAT +C + ELSEIF(IXTYP(1,NY,NX).EQ.2)THEN + CFOSC(1,1,L,NY,NX)=0.125 + CFOSC(2,1,L,NY,NX)=0.171 + CFOSC(3,1,L,NY,NX)=0.560 + CFOSC(4,1,L,NY,NX)=0.144 +C +C SOYBEAN +C + ELSEIF(IXTYP(1,NY,NX).EQ.3)THEN + CFOSC(1,1,L,NY,NX)=0.138 + CFOSC(2,1,L,NY,NX)=0.426 + CFOSC(3,1,L,NY,NX)=0.316 + CFOSC(4,1,L,NY,NX)=0.120 +C +C NEW STRAW +C + ELSEIF(IXTYP(1,NY,NX).EQ.4)THEN + CFOSC(1,1,L,NY,NX)=0.036 + CFOSC(2,1,L,NY,NX)=0.044 + CFOSC(3,1,L,NY,NX)=0.767 + CFOSC(4,1,L,NY,NX)=0.153 +C +C OLD STRAW +C + ELSEIF(IXTYP(1,NY,NX).EQ.5)THEN + CFOSC(1,1,L,NY,NX)=0.075 + CFOSC(2,1,L,NY,NX)=0.125 + CFOSC(3,1,L,NY,NX)=0.550 + CFOSC(4,1,L,NY,NX)=0.250 +C +C COMPOST +C + ELSEIF(IXTYP(1,NY,NX).EQ.6)THEN + CFOSC(1,1,L,NY,NX)=0.143 + CFOSC(2,1,L,NY,NX)=0.015 + CFOSC(3,1,L,NY,NX)=0.640 + CFOSC(4,1,L,NY,NX)=0.202 +C +C GREEN MANURE +C + ELSEIF(IXTYP(1,NY,NX).EQ.7)THEN + CFOSC(1,1,L,NY,NX)=0.202 + CFOSC(2,1,L,NY,NX)=0.013 + CFOSC(3,1,L,NY,NX)=0.560 + CFOSC(4,1,L,NY,NX)=0.225 +C +C NEW DECIDUOUS FOREST +C + ELSEIF(IXTYP(1,NY,NX).EQ.8)THEN + CFOSC(1,1,L,NY,NX)=0.07 + CFOSC(2,1,L,NY,NX)=0.41 + CFOSC(3,1,L,NY,NX)=0.36 + CFOSC(4,1,L,NY,NX)=0.16 +C +C NEW CONIFEROUS FOREST +C + ELSEIF(IXTYP(1,NY,NX).EQ.9)THEN + CFOSC(1,1,L,NY,NX)=0.07 + CFOSC(2,1,L,NY,NX)=0.25 + CFOSC(3,1,L,NY,NX)=0.38 + CFOSC(4,1,L,NY,NX)=0.30 +C +C OLD DECIDUOUS FOREST +C + ELSEIF(IXTYP(1,NY,NX).EQ.10)THEN + CFOSC(1,1,L,NY,NX)=0.02 + CFOSC(2,1,L,NY,NX)=0.06 + CFOSC(3,1,L,NY,NX)=0.34 + CFOSC(4,1,L,NY,NX)=0.58 +C +C OLD CONIFEROUS FOREST +C + ELSEIF(IXTYP(1,NY,NX).EQ.11)THEN + CFOSC(1,1,L,NY,NX)=0.02 + CFOSC(2,1,L,NY,NX)=0.06 + CFOSC(3,1,L,NY,NX)=0.34 + CFOSC(4,1,L,NY,NX)=0.58 +C +C DEFAULT +C + ELSE + CFOSC(1,1,L,NY,NX)=0.075 + CFOSC(2,1,L,NY,NX)=0.125 + CFOSC(3,1,L,NY,NX)=0.550 + CFOSC(4,1,L,NY,NX)=0.250 + ENDIF +C +C PREVIOUS COARSE (K=0) AND FINE (K=1) ROOTS +C + ELSE + CFOSC(1,0,L,NY,NX)=0.00 + CFOSC(2,0,L,NY,NX)=0.00 + CFOSC(3,0,L,NY,NX)=0.20 + CFOSC(4,0,L,NY,NX)=0.80 + CFOSC(1,1,L,NY,NX)=0.02 + CFOSC(2,1,L,NY,NX)=0.06 + CFOSC(3,1,L,NY,NX)=0.34 + CFOSC(4,1,L,NY,NX)=0.58 + ENDIF +C +C ANIMAL MANURE +C +C +C RUMINANT +C + IF(IXTYP(2,NY,NX).EQ.1)THEN + CFOSC(1,2,L,NY,NX)=0.036 + CFOSC(2,2,L,NY,NX)=0.044 + CFOSC(3,2,L,NY,NX)=0.630 + CFOSC(4,2,L,NY,NX)=0.290 +C +C NON-RUMINANT +C + ELSEIF(IXTYP(2,NY,NX).EQ.2)THEN + CFOSC(1,2,L,NY,NX)=0.138 + CFOSC(2,2,L,NY,NX)=0.401 + CFOSC(3,2,L,NY,NX)=0.316 + CFOSC(4,2,L,NY,NX)=0.145 +C +C OTHER +C + ELSE + CFOSC(1,2,L,NY,NX)=0.138 + CFOSC(2,2,L,NY,NX)=0.401 + CFOSC(3,2,L,NY,NX)=0.316 + CFOSC(4,2,L,NY,NX)=0.145 + ENDIF +C +C POM +C + IF(L.NE.0)THEN + CFOSC(1,3,L,NY,NX)=1.00 + CFOSC(2,3,L,NY,NX)=0.00 + CFOSC(3,3,L,NY,NX)=0.00 + CFOSC(4,3,L,NY,NX)=0.00 +C +C HUMUS PARTITIONED TO DIFFERENT FRACTIONS +C BASED ON SOC ACCUMULATION +C + IF(CORGCX(4).GT.1.0E-32)THEN + FC0=0.60*EXP(-5.0*(AMIN1(CORGNX(4),10.0*CORGPX(4)) + 2/CORGCX(4))) + ELSE + FC0=0.60 + ENDIF + IF(ISOILR(NY,NX).NE.0)THEN + FCX=0.0 + ELSEIF(DPTH(L,NY,NX).GT.DTBLZ(NY,NX) + 2+CDPTH(NU(NY,NX),NY,NX)-CDPTHG)THEN + FCX=(EXP(HCX*TORGL(L)))**0.25 + ELSE + FCX=EXP(HCX*TORGL(L)) + ENDIF + FC1=FC0*FCX + CFOSC(1,4,L,NY,NX)=FC1 + CFOSC(2,4,L,NY,NX)=1.0-FC1 + CFOSC(3,4,L,NY,NX)=0.00 + CFOSC(4,4,L,NY,NX)=0.00 +C +C MICROBIAL DETRITUS TO HUMUS MAINTAINS EXISTING PARTITIONING +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 + 2,CORGCX(4),CORGNX(4),CORGPX(4),DPTH(L,NY,NX),DTBLZ(NY,NX) + 3,CDPTH(NU(NY,NX),NY,NX),CDPTHG +5432 FORMAT(A8,I4,20E12.4) + ENDIF +C +C LAYER SOIL, HEAT, WATER, ICE, GAS AND AIR CONTENTS +C + PSISE(L,NY,NX)=PSIPS + ROXYF(L,NY,NX)=0.0 + RCO2F(L,NY,NX)=0.0 + ROXYL(L,NY,NX)=0.0 + RCH4F(L,NY,NX)=0.0 + RCH4L(L,NY,NX)=0.0 + IF(L.GT.0)THEN + HYST(L,NY,NX)=1.0 + 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) + 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 + 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) + ELSEIF(THW(L,NY,NX).EQ.1.0)THEN + THW(L,NY,NX)=FC(L,NY,NX) + ELSEIF(THW(L,NY,NX).LE.0.0)THEN + THW(L,NY,NX)=WP(L,NY,NX) + ENDIF + IF(THI(L,NY,NX).GT.1.0.OR.DPTH(L,NY,NX).GE.DTBLZ(NY,NX))THEN + THI(L,NY,NX)=AMAX1(0.0,AMIN1(POROS(L,NY,NX) + 2,POROS(L,NY,NX)-THW(L,NY,NX))) + ELSEIF(THI(L,NY,NX).EQ.1.0)THEN + THI(L,NY,NX)=AMAX1(0.0,AMIN1(FC(L,NY,NX) + 2,POROS(L,NY,NX)-THW(L,NY,NX))) + ELSEIF(THI(L,NY,NX).LT.0.0)THEN + THI(L,NY,NX)=AMAX1(0.0,AMIN1(WP(L,NY,NX) + 2,POROS(L,NY,NX)-THW(L,NY,NX))) + ENDIF + THETW(L,NY,NX)=THW(L,NY,NX) + VOLW(L,NY,NX)=THETW(L,NY,NX)*VOLX(L,NY,NX) + VOLWX(L,NY,NX)=VOLW(L,NY,NX) + VOLWH(L,NY,NX)=THETW(L,NY,NX)*VOLAH(L,NY,NX) + THETI(L,NY,NX)=THI(L,NY,NX) + VOLI(L,NY,NX)=THETI(L,NY,NX)*VOLX(L,NY,NX) + VOLIH(L,NY,NX)=THETI(L,NY,NX)*VOLAH(L,NY,NX) + ENDIF + 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)) + 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) + 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) + 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) + TKS(L,NY,NX)=TCS(L,NY,NX)+273.15 + PSISA(L,NY,NX)=-2.5E-03 + ELSE + VOLW(L,NY,NX)=1.0E-06*ORGC(L,NY,NX) + VOLWX(L,NY,NX)=VOLW(L,NY,NX) + VOLI(L,NY,NX)=0.0 + IF(VOLX(L,NY,NX).GT.0.0)THEN + THETW(L,NY,NX)=AMAX1(0.001,VOLW(L,NY,NX)/VOLX(L,NY,NX)) + ELSE + THETW(L,NY,NX)=0.001 + ENDIF + THETP(L,NY,NX)=0.95-THETW(L,NY,NX) + THETI(L,NY,NX)=0.0 + VHCPR(NY,NX)=2.496E-06*ORGC(L,NY,NX)+4.19*VOLW(L,NY,NX) + 2+1.9274*VOLI(L,NY,NX) + ENDIF +C +C INITIALIZE SOM VARIABLES +C + DO 975 K=0,2 + CNOSCT(K)=0.0 + CPOSCT(K)=0.0 + IF(RSC(K,L,NY,NX).GT.ZEROS(NY,NX))THEN + RNT=0.0 + RPT=0.0 + DO 970 M=1,4 + RNT=RNT+RSC(K,L,NY,NX)*CFOSC(M,K,L,NY,NX)*CNOFC(M,K) + RPT=RPT+RSC(K,L,NY,NX)*CFOSC(M,K,L,NY,NX)*CPOFC(M,K) +970 CONTINUE + FRNT=RSN(K,L,NY,NX)/RNT + FRPT=RSP(K,L,NY,NX)/RPT + DO 960 M=1,4 + CNOSC(M,K,L,NY,NX)=CNOFC(M,K)*FRNT + CPOSC(M,K,L,NY,NX)=CPOFC(M,K)*FRPT + CNOSCT(K)=CNOSCT(K)+CFOSC(M,K,L,NY,NX)*CNOSC(M,K,L,NY,NX) + CPOSCT(K)=CPOSCT(K)+CFOSC(M,K,L,NY,NX)*CPOSC(M,K,L,NY,NX) +960 CONTINUE + ELSE + DO 965 M=1,4 + CNOSC(M,K,L,NY,NX)=CNRH(K) + CPOSC(M,K,L,NY,NX)=CPRH(K) +965 CONTINUE + CNOSCT(K)=CNRH(K) + CPOSCT(K)=CPRH(K) + ENDIF +975 CONTINUE + DO 990 K=3,4 + CNOSCT(K)=0.0 + CPOSCT(K)=0.0 + IF(CORGCX(K).GT.ZERO)THEN + DO 985 M=1,4 + CNOSC(M,K,L,NY,NX)=CORGNX(K)/CORGCX(K) + CPOSC(M,K,L,NY,NX)=CORGPX(K)/CORGCX(K) + CNOSCT(K)=CNOSCT(K)+CFOSC(M,K,L,NY,NX)*CNOSC(M,K,L,NY,NX) + CPOSCT(K)=CPOSCT(K)+CFOSC(M,K,L,NY,NX)*CPOSC(M,K,L,NY,NX) +985 CONTINUE + ELSE + DO 980 M=1,4 + CNOSC(M,K,L,NY,NX)=CNRH(K) + CPOSC(M,K,L,NY,NX)=CPRH(K) +980 CONTINUE + CNOSCT(K)=CNRH(K) + CPOSCT(K)=CPRH(K) + ENDIF +990 CONTINUE + TOSCI=0.0 + TOSNI=0.0 + TOSPI=0.0 + DO 995 K=0,4 + IF(L.EQ.0)THEN + KK=K + ELSE + KK=4 + ENDIF + OSCI(K)=CORGCX(K)*BKVL(L,NY,NX) + OSNI(K)=CORGNX(K)*BKVL(L,NY,NX) + OSPI(K)=CORGPX(K)*BKVL(L,NY,NX) + TOSCK(K)=OMCK(K)+ORCK(K)+OQCK(K)+OHCK(K) + TOSNK(K)=OMCI(1,K)*CNOMC(1,1,K)+OMCI(2,K)*CNOMC(2,1,K) + 2+ORCK(K)*CNRH(K)+OQCK(K)*CNOSCT(KK)+OHCK(K)*CNOSCT(KK) + TOSPK(K)=OMCI(1,K)*CPOMC(1,1,K)+OMCI(2,K)*CPOMC(2,1,K) + 2+ORCK(K)*CPRH(K)+OQCK(K)*CPOSCT(KK)+OHCK(K)*CPOSCT(KK) + TOSCI=TOSCI+OSCI(K)*TOSCK(K) + TOSNI=TOSNI+OSCI(K)*TOSNK(K) + TOSPI=TOSPI+OSCI(K)*TOSPK(K) + OSCX(K)=0.0 + OSNX(K)=0.0 + OSPX(K)=0.0 +995 CONTINUE + TOMC=0.0 + DO 8995 K=0,4 + IF(L.EQ.0)THEN + OSCM(K)=DCKR*CORGCX(K)*BKVL(L,NY,NX) + X=0.0 + KK=K + FOSCI=1.0 + FOSNI=1.0 + FOSPI=1.0 +C WRITE(*,2424)'OSCM',NX,NY,L,K,OSCM(K),CORGCX(K) +C 2,BKVL(L,NY,NX),CORGCX(K)*BKVL(L,NY,NX),FCX + ELSE + IF(K.LE.2)THEN + OSCM(K)=DCKR*CORGCX(K)*BKVL(L,NY,NX) + ELSE + OSCM(K)=FCX*CORGCX(K)*BKVL(L,NY,NX)*DCKM/(CORGCX(4)+DCKM) + ENDIF +2424 FORMAT(A8,4I4,12E12.4) + X=1.0 + KK=4 + IF(TOSCI.GT.ZEROS(NY,NX))THEN + FOSCI=AMIN1(1.0,OSCI(KK)/TOSCI) + FOSNI=AMIN1(1.0,OSCI(KK)*CNOSCT(KK)/TOSNI) + FOSPI=AMIN1(1.0,OSCI(KK)*CPOSCT(KK)/TOSPI) + ELSE + FOSCI=0.0 + FOSNI=0.0 + FOSPI=0.0 + ENDIF + ENDIF +C +C MICROBIAL C, N AND P +C + DO 7990 N=1,7 + DO 7985 M=1,3 + OMC(M,N,5,L,NY,NX)=0.0 + OMN(M,N,5,L,NY,NX)=0.0 + OMP(M,N,5,L,NY,NX)=0.0 +7985 CONTINUE +7990 CONTINUE + DO 8990 N=1,7 + DO 8991 M=1,3 + OMC1=AMAX1(0.0,OSCM(K)*OMCI(M,K)*OMCF(N)*FOSCI) + OMN1=AMAX1(0.0,OMC1*CNOMC(M,N,K)*FOSNI) + OMP1=AMAX1(0.0,OMC1*CPOMC(M,N,K)*FOSPI) + OMC(M,N,K,L,NY,NX)=OMC1 + OMN(M,N,K,L,NY,NX)=OMN1 + OMP(M,N,K,L,NY,NX)=OMP1 + OSCX(KK)=OSCX(KK)+OMC1 + OSNX(KK)=OSNX(KK)+OMN1 + OSPX(KK)=OSPX(KK)+OMP1 + DO 8992 NN=1,7 + OMC(M,NN,5,L,NY,NX)=OMC(M,NN,5,L,NY,NX)+OMC1*OMCA(NN) + OMN(M,NN,5,L,NY,NX)=OMN(M,NN,5,L,NY,NX)+OMN1*OMCA(NN) + OMP(M,NN,5,L,NY,NX)=OMP(M,NN,5,L,NY,NX)+OMP1*OMCA(NN) + OSCX(KK)=OSCX(KK)+OMC1*OMCA(NN) + OSNX(KK)=OSNX(KK)+OMN1*OMCA(NN) + OSPX(KK)=OSPX(KK)+OMP1*OMCA(NN) +8992 CONTINUE +8991 CONTINUE +8990 CONTINUE +C +C MICROBIAL RESIDUE C, N AND P +C + DO 8985 M=1,2 + ORC(M,K,L,NY,NX)=X*AMAX1(0.0,OSCM(K)*ORCI(M,K)*FOSCI) + ORN(M,K,L,NY,NX)=AMAX1(0.0,ORC(M,K,L,NY,NX)*CNOMC(M,1,K)*FOSNI) + ORP(M,K,L,NY,NX)=AMAX1(0.0,ORC(M,K,L,NY,NX)*CPOMC(M,1,K)*FOSPI) + OSCX(KK)=OSCX(KK)+ORC(M,K,L,NY,NX) + OSNX(KK)=OSNX(KK)+ORN(M,K,L,NY,NX) + OSPX(KK)=OSPX(KK)+ORP(M,K,L,NY,NX) +8985 CONTINUE +C +C DOC, DON AND DOP +C + OQC(K,L,NY,NX)=X*AMAX1(0.0,OSCM(K)*OQCK(K)*FOSCI) + OQN(K,L,NY,NX)=AMAX1(0.0,OQC(K,L,NY,NX)*CNOSCT(KK)*FOSNI) + OQP(K,L,NY,NX)=AMAX1(0.0,OQC(K,L,NY,NX)*CPOSCT(KK)*FOSPI) + OQA(K,L,NY,NX)=0.0 + OQCH(K,L,NY,NX)=0.0 + OQNH(K,L,NY,NX)=0.0 + OQPH(K,L,NY,NX)=0.0 + OQAH(K,L,NY,NX)=0.0 + OSCX(KK)=OSCX(KK)+OQC(K,L,NY,NX) + OSNX(KK)=OSNX(KK)+OQN(K,L,NY,NX) + OSPX(KK)=OSPX(KK)+OQP(K,L,NY,NX) +C +C ADSORBED C, N AND P +C + OHC(K,L,NY,NX)=X*AMAX1(0.0,OSCM(K)*OHCK(K)*FOSCI) + OHN(K,L,NY,NX)=AMAX1(0.0,OHC(K,L,NY,NX)*CNOSCT(KK)*FOSNI) + OHP(K,L,NY,NX)=AMAX1(0.0,OHC(K,L,NY,NX)*CPOSCT(KK)*FOSPI) + OHA(K,L,NY,NX)=0.0 + OSCX(KK)=OSCX(KK)+OHC(K,L,NY,NX)+OHA(K,L,NY,NX) + OSNX(KK)=OSNX(KK)+OHN(K,L,NY,NX) + OSPX(KK)=OSPX(KK)+OHP(K,L,NY,NX) +C +C HUMUS C, N AND P +C + DO 8980 M=1,4 + OSC(M,K,L,NY,NX)=AMAX1(0.0,CFOSC(M,K,L,NY,NX)*(OSCI(K)-OSCX(K))) + IF(CNOSCT(K).GT.ZERO)THEN + OSN(M,K,L,NY,NX)=AMAX1(0.0,CFOSC(M,K,L,NY,NX)*CNOSC(M,K,L,NY,NX) + 2/CNOSCT(K)*(OSNI(K)-OSNX(K))) + ELSE + OSN(M,K,L,NY,NX)=0.0 + ENDIF + IF(CPOSCT(K).GT.ZERO)THEN + OSP(M,K,L,NY,NX)=AMAX1(0.0,CFOSC(M,K,L,NY,NX)*CPOSC(M,K,L,NY,NX) + 2/CPOSCT(K)*(OSPI(K)-OSPX(K))) + ELSE + OSP(M,K,L,NY,NX)=0.0 + ENDIF + IF(K.EQ.0)THEN + OSA(M,K,L,NY,NX)=0.0 + ELSE + OSA(M,K,L,NY,NX)=OSC(M,K,L,NY,NX) + ENDIF +8980 CONTINUE +8995 CONTINUE + OC=0.0 + ON=0.0 + OP=0.0 + RC=0.0 + IF(L.EQ.0)THEN + DO 6975 K=0,5 + RC0(K,NY,NX)=0.0 + RA0(K,NY,NX)=0.0 +6975 CONTINUE + ENDIF + DO 6990 K=0,5 + DO 6990 N=1,7 + OC=OC+OMC(3,N,K,L,NY,NX) + ON=ON+OMN(3,N,K,L,NY,NX) + OP=OP+OMP(3,N,K,L,NY,NX) + IF(K.LE.2)THEN + RC=RC+OMC(3,N,K,L,NY,NX) + ENDIF + ROXYS(N,K,L,NY,NX)=0.0 + RVMX4(N,K,L,NY,NX)=0.0 + RVMX3(N,K,L,NY,NX)=0.0 + RVMX2(N,K,L,NY,NX)=0.0 + RVMX1(N,K,L,NY,NX)=0.0 + RINHO(N,K,L,NY,NX)=0.0 + RINOO(N,K,L,NY,NX)=0.0 + RIPOO(N,K,L,NY,NX)=0.0 + IF(L.EQ.0)THEN + RINHOR(N,K,NY,NX)=0.0 + RINOOR(N,K,NY,NX)=0.0 + RIPOOR(N,K,NY,NX)=0.0 + ENDIF + DO 6990 M=1,3 + OC=OC+OMC(M,N,K,L,NY,NX) + ON=ON+OMN(M,N,K,L,NY,NX) + OP=OP+OMP(M,N,K,L,NY,NX) + IF(K.LE.2)THEN + RC=RC+OMC(M,N,K,L,NY,NX) + ENDIF + RC0(K,NY,NX)=RC0(K,NY,NX)+OMC(M,N,K,L,NY,NX) + RA0(K,NY,NX)=RA0(K,NY,NX)+OMC(M,N,K,L,NY,NX) +6990 CONTINUE + DO 6995 K=0,4 + DO 6985 M=1,2 + OC=OC+ORC(M,K,L,NY,NX) + ON=ON+ORN(M,K,L,NY,NX) + OP=OP+ORP(M,K,L,NY,NX) + IF(K.LE.2)THEN + RC=RC+ORC(M,K,L,NY,NX) + ENDIF + IF(L.EQ.0)THEN + RC0(K,NY,NX)=RC0(K,NY,NX)+ORC(M,K,L,NY,NX) + RA0(K,NY,NX)=RA0(K,NY,NX)+ORC(M,K,L,NY,NX) + ENDIF +6985 CONTINUE + OC=OC+OQC(K,L,NY,NX)+OQCH(K,L,NY,NX)+OHC(K,L,NY,NX) + 2+OQA(K,L,NY,NX)+OQAH(K,L,NY,NX)+OHA(K,L,NY,NX) + ON=ON+OQN(K,L,NY,NX)+OQNH(K,L,NY,NX)+OHN(K,L,NY,NX) + OP=OP+OQP(K,L,NY,NX)+OQPH(K,L,NY,NX)+OHP(K,L,NY,NX) + OC=OC+OQA(K,L,NY,NX)+OQAH(K,L,NY,NX) + IF(K.LE.2)THEN + RC=RC+OQC(K,L,NY,NX)+OQCH(K,L,NY,NX)+OHC(K,L,NY,NX) + 2+OQA(K,L,NY,NX)+OQAH(K,L,NY,NX)+OHA(K,L,NY,NX) + RC=RC+OQA(K,L,NY,NX)+OQAH(K,L,NY,NX) + ENDIF + IF(L.EQ.0)THEN + RC0(K,NY,NX)=RC0(K,NY,NX)+OQC(K,L,NY,NX)+OQCH(K,L,NY,NX) + 2+OHC(K,L,NY,NX)+OQA(K,L,NY,NX)+OQAH(K,L,NY,NX)+OHA(K,L,NY,NX) + RA0(K,NY,NX)=RA0(K,NY,NX)+OQC(K,L,NY,NX)+OQCH(K,L,NY,NX) + 2+OHC(K,L,NY,NX)+OQA(K,L,NY,NX)+OQAH(K,L,NY,NX)+OHA(K,L,NY,NX) + ENDIF + DO 6980 M=1,4 + OC=OC+OSC(M,K,L,NY,NX) + ON=ON+OSN(M,K,L,NY,NX) + OP=OP+OSP(M,K,L,NY,NX) + IF(K.LE.2)THEN + RC=RC+OSC(M,K,L,NY,NX) + ENDIF + IF(L.EQ.0)THEN + RC0(K,NY,NX)=RC0(K,NY,NX)+OSC(M,K,L,NY,NX) + RA0(K,NY,NX)=RA0(K,NY,NX)+OSA(M,K,L,NY,NX) + ENDIF +6980 CONTINUE +6995 CONTINUE + ORGC(L,NY,NX)=OC + ORGR(L,NY,NX)=RC +C +C INITIALIZE FERTILIZER ARRAYS +C + ZNH4FA(L,NY,NX)=0.0 + ZNH3FA(L,NY,NX)=0.0 + ZNHUFA(L,NY,NX)=0.0 + ZNO3FA(L,NY,NX)=0.0 + IF(L.GT.0)THEN + ZNH4FB(L,NY,NX)=0.0 + ZNH3FB(L,NY,NX)=0.0 + ZNHUFB(L,NY,NX)=0.0 + ZNO3FB(L,NY,NX)=0.0 + WDNHB(L,NY,NX)=0.0 + DPNHB(L,NY,NX)=0.0 + WDNOB(L,NY,NX)=0.0 + DPNOB(L,NY,NX)=0.0 + WDPOB(L,NY,NX)=0.0 + DPPOB(L,NY,NX)=0.0 + ENDIF + VLNH4(L,NY,NX)=1.0 + VLNO3(L,NY,NX)=1.0 + VLPO4(L,NY,NX)=1.0 + VLNHB(L,NY,NX)=0.0 + VLNOB(L,NY,NX)=0.0 + VLPOB(L,NY,NX)=0.0 + ROXYX(L,NY,NX)=0.0 + RNH4X(L,NY,NX)=0.0 + RNO3X(L,NY,NX)=0.0 + RNO2X(L,NY,NX)=0.0 + RN2OX(L,NY,NX)=0.0 + RPO4X(L,NY,NX)=0.0 + RVMXC(L,NY,NX)=0.0 + RNHBX(L,NY,NX)=0.0 + RN3BX(L,NY,NX)=0.0 + RN2BX(L,NY,NX)=0.0 + RPOBX(L,NY,NX)=0.0 + RVMBC(L,NY,NX)=0.0 + DO 1250 K=0,4 + IF(L.GT.0)THEN + COCU(K,L,NY,NX)=0.0 + CONU(K,L,NY,NX)=0.0 + COPU(K,L,NY,NX)=0.0 + COAU(K,L,NY,NX)=0.0 + ENDIF +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 +9890 CONTINUE +9895 CONTINUE + RETURN + END diff --git a/f77src/stomate.f b/f77src/stomate.f index 5a7e13b..f37b47b 100755 --- a/f77src/stomate.f +++ b/f77src/stomate.f @@ -1,379 +1,377 @@ - - SUBROUTINE stomate(I,J,NZ,NY,NX) -C -C THIS SUBROUTINE CALCULATES CANOPY STOMATAL RESISTANCE AT MAXIMUM -C CANOPY TURGOR FOR USE IN ENERGY BALANCE EQUATIONS IN 'UPTAKE' -C - include "parameters.h" - include "blkc.h" - include "blk1cp.h" - include "blk1g.h" - include "blk1n.h" - include "blk1p.h" - include "blk2a.h" - include "blk3.h" - include "blk5.h" - include "blk8a.h" - include "blk8b.h" - include "blk9a.h" - include "blk9b.h" - include "blk9c.h" - include "blk1u.h" - DIMENSION FLG4Y(0:5) - PARAMETER (QNTM=0.45,CURV=0.70,CURV2=2.0*CURV,CURV4=4.0*CURV - 2,ELEC3=4.5,ELEC4=3.0) - PARAMETER (CNKI=1.0E+02,CPKI=1.0E+03) - PARAMETER (RSMY=2.78E-03) - PARAMETER (COMP4=0.5,FDML=6.0,FBS=0.2*FDML,FMP=0.8*FDML - 2,C4KI=5.0E+06,FVRN=0.5) - DATA FLG4Y/336.0,672.0,672.0,672.0,672.0,672.0/ -C -C CANOPY TEMPERATURE + OFFSET FOR THERMAL ADAPTATION FROM 'READQ' -C -C -C CANOPY BOUNDARY LAYER RESISTANCE -C - RI=AMAX1(-0.3,AMIN1(0.075,RIB(NY,NX)*(TKA(NY,NX)-TKCZ(NZ,NY,NX)))) - RAC=1.34*AMAX1(5.56E-03,RAZ(NZ,NY,NX)/(1.0-10.0*RI)) - FMOL(NZ,NY,NX)=1.2194E+04/TKCZ(NZ,NY,NX) -C -C CANOPY CO2 CONCENTRATION FROM CO2 INFLUXES AND EFFLUXES -C - CO2Q(NZ,NY,NX)=CO2E(NY,NX)-8.33E+04*CNETX(NY,NX) - 2*RAC/FMOL(NZ,NY,NX) - CO2Q(NZ,NY,NX)=AMIN1(CO2E(NY,NX)+200.0 - 2,AMAX1(0.0,CO2E(NY,NX)-200.0,CO2Q(NZ,NY,NX))) -C -C MESOPHYLL CO2 CONCENTRATION FROM CI:CA RATIO ENTERED IN 'READQ' -C - CO2I(NZ,NY,NX)=FCO2(NZ,NY,NX)*CO2Q(NZ,NY,NX) - IF(SSIN(NY,NX).GT.0.0.AND.ARLFP(NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN -C -C CO2 AND O2 AQUEOUS SOLUBILITY -C - TCCZ=TKCZ(NZ,NY,NX)-273.15 - SCO2(NZ,NY,NX)=EXP(-2.621-0.0317*TCCZ) - SO2(NZ,NY,NX)=EXP(-6.175-0.0211*TCCZ) - CO2L(NZ,NY,NX)=CO2I(NZ,NY,NX)*SCO2(NZ,NY,NX) - O2L(NZ,NY,NX)=O2I(NZ,NY,NX)*SO2(NZ,NY,NX) -C -C CO2 CONCENTRATION DIFFERENCE -C - DCO2(NZ,NY,NX)=FMOL(NZ,NY,NX)*(CO2Q(NZ,NY,NX)-CO2I(NZ,NY,NX)) - CH2O=0.0 - TKCO=TKCZ(NZ,NY,NX)+OFFST(NZ,NY,NX) - RTK=8.3143*TKCO - STK=710.0*TKCO -C -C ARRHENIUS FUNCTIONS FOR CARBOXYLATION AND OXYGENATION -C - ACTV=1+EXP((197500-STK)/RTK)+EXP((STK-222500)/RTK) - TFN1=EXP(26.237-65000/RTK)/ACTV - TFN2=EXP(24.220-60000/RTK)/ACTV - TFNE=EXP(17.362-43000/RTK)/ACTV -C -C M-M CONSTANT FOR CARBOXYLATION FROM 'READQ' ADJUSTED FOR TEMPERATURE -C - XKCO2L(NZ,NY,NX)=XKCO2(NZ,NY,NX)*EXP(16.136-40000/RTK) - XKO2L=XKO2(NZ,NY,NX)*EXP(8.067-20000/RTK) - XKCO2O(NZ,NY,NX)=XKCO2L(NZ,NY,NX)*(1.0+O2L(NZ,NY,NX)/XKO2L) -C -C FOR EACH BRANCH -C - DO 2900 NB=1,NBR(NZ,NY,NX) -C IF(NZ.EQ.1.OR.NZ.EQ.4)THEN -C WRITE(*,4242)'FDBK',I,J,NZ,NB,IDTHB(NB,NZ,NY,NX),FDBK(NB,NZ,NY,NX) -C 2,VRNS(NB,NZ,NY,NX),VRNF(NB,NZ,NY,NX),CCPOLB(NB,NZ,NY,NX) -C 3,CZPOLB(NB,NZ,NY,NX),CCPOLB(NB,NZ,NY,NX) -4242 FORMAT(A8,5I4,12E12.4) -C ENDIF -C -C FEEDBACK ON CO2 FIXATION -C - IF(IWTYP(NZ,NY,NX).EQ.0 - 2.OR.VRNS(NB,NZ,NY,NX).GE.VRNL(NB,NZ,NY,NX) - 3.OR.VRNF(NB,NZ,NY,NX).LT.VRNX(NB,NZ,NY,NX))THEN -C -C FEEDBACK ON C3 CARBOXYLATION FROM NON-STRUCTURAL C:N:P -C - IF(CCPOLB(NB,NZ,NY,NX).GT.ZERO)THEN - FDBK(NB,NZ,NY,NX)=AMIN1(CZPOLB(NB,NZ,NY,NX) - 3/(CZPOLB(NB,NZ,NY,NX)+CCPOLB(NB,NZ,NY,NX)/CNKI) - 4,CPPOLB(NB,NZ,NY,NX) - 5/(CPPOLB(NB,NZ,NY,NX)+CCPOLB(NB,NZ,NY,NX)/CPKI)) - ELSE - FDBK(NB,NZ,NY,NX)=1.0 - ENDIF -C -C CHILLING -C -C FDBK(NB,NZ,NY,NX)=FDBK(NB,NZ,NY,NX)/(1.0+0.25*CHILL(NZ,NY,NX)) -C -C DEHARDENING OF CONIFERS IN SPRING -C - IF((IWTYP(NZ,NY,NX).EQ.1.OR.IWTYP(NZ,NY,NX).EQ.3) - 2.AND.IBTYP(NZ,NY,NX).GE.2)THEN - FDBK(NB,NZ,NY,NX)=FDBK(NB,NZ,NY,NX)*AMAX1(0.0 - 2,AMIN1(1.0,0.333*ATRP(NB,NZ,NY,NX) - 3/AMIN1(120.0,VRNL(NB,NZ,NY,NX)))) - ENDIF -C -C TERMINATION OF ANNUALS -C - IF(ISTYP(NZ,NY,NX).EQ.0.AND.FLG4(NB,NZ,NY,NX).GT.0.0)THEN - FDBKX(NB,NZ,NY,NX)=AMAX1(0.0 - 2,1.0-FLG4(NB,NZ,NY,NX)/FLG4Y(IWTYP(NZ,NY,NX))) - ELSE - FDBKX(NB,NZ,NY,NX)=1.0 - ENDIF - FDBK(NB,NZ,NY,NX)=FDBK(NB,NZ,NY,NX)*FDBKX(NB,NZ,NY,NX) -C -C FOR EACH NODE -C - IF(IDTHB(NB,NZ,NY,NX).EQ.0)THEN - DO 2800 K=1,25 - IF(ARLF(K,NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX) - 2.AND.WGLF(K,NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - WSDN=WSLF(K,NB,NZ,NY,NX)/ARLF(K,NB,NZ,NY,NX) - ELSE - WSDN=0.0 - ENDIF -C IF((I/10)*10.EQ.I.AND.J.EQ.15)THEN -C WRITE(*,2125)'WSDN',I,J,NX,NY,NZ,NB,K,WSDX,WSDN -C 2,WSDM,WGLF(K,NB,NZ,NY,NX),WSLF(K,NB,NZ,NY,NX) -C 3,ARLF(K,NB,NZ,NY,NX) -2125 FORMAT(A8,7I4,12E12.4) -C ENDIF - IF(WSDN.GT.ZERO)THEN -C -C C4 PHOTOSYNTHESIS -C - IF(ICTYP(NZ,NY,NX).EQ.4)THEN -C -C FEEDBACK ON C4 CARBOXYLATION FROM C4 NON-STRUCTURAL C -C - CC4M=AMAX1(0.0,0.021E+09*CPOOL4(K,NB,NZ,NY,NX) - 2/(WGLF(K,NB,NZ,NY,NX)*FMP)) - CCBS=AMAX1(0.0,0.083E+09*CO2B(K,NB,NZ,NY,NX) - 2/(WGLF(K,NB,NZ,NY,NX)*FBS)) - FDBK4(K,NB,NZ,NY,NX)=1.0/(1.0+CC4M/C4KI) - FDBK4(K,NB,NZ,NY,NX)=FDBK4(K,NB,NZ,NY,NX)*FDBKX(NB,NZ,NY,NX) -C -C SURFICIAL DENSITY OF PEPC AND ITS CHLOROPHYLL -C - VCDN4=PEPC(NZ,NY,NX)*WSDN - ETDN4=CHL4(NZ,NY,NX)*WSDN -C -C CO2-LIMITED C4 CARBOXYLATION RATES -C - VCGR4(K,NB,NZ,NY,NX)=VCMX4(NZ,NY,NX)*TFN1*VCDN4 - VGRO4(K,NB,NZ,NY,NX)=AMAX1(0.0,VCGR4(K,NB,NZ,NY,NX) - 2*(CO2L(NZ,NY,NX)-COMP4)/(CO2L(NZ,NY,NX)+XKCO24(NZ,NY,NX))) -C -C C4 ELECTRON TRANSFER RATES -C - ETGR4(K,NB,NZ,NY,NX)=ETMX(NZ,NY,NX)*TFNE*ETDN4 - CBXN4(K,NB,NZ,NY,NX)=AMAX1(0.0,(CO2L(NZ,NY,NX)-COMP4) - 2/(ELEC4*CO2L(NZ,NY,NX)+10.5*COMP4)) -C -C FOR EACH CANOPY LAYER -C - DO 2700 L=JC,1,-1 - IF(ARLFL(L,K,NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN -C -C FOR EACH INCLINATION AND AZIMUTH CLASS -C - DO 2600 N=1,4 - DO 2500 M=1,4 - IF(SURFX(N,L,K,NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN -C -C SUNLIT LEAVES -C - IF(PAR(N,M,L,NZ,NY,NX).GT.0.0)THEN -C -C LIGHT-LIMITED CARBOXYLATION RATES -C - PARX=QNTM*PAR(N,M,L,NZ,NY,NX) - PARJ=PARX+ETGR4(K,NB,NZ,NY,NX) - ETLF4=(PARJ-SQRT(PARJ**2-CURV4*PARX*ETGR4(K,NB,NZ,NY,NX)))/CURV2 - EGRO4=ETLF4*CBXN4(K,NB,NZ,NY,NX) -C -C C4 CARBOXYLATION RATE AND ACCUMULATED PRODUCT -C - VL=AMIN1(VGRO4(K,NB,NZ,NY,NX),EGRO4)*FDBK4(K,NB,NZ,NY,NX) - CH2O=CH2O+VL*SURFX(N,L,K,NB,NZ,NY,NX)*TAUS(L+1,NY,NX) -C IF(L.GT.NC-4.AND.NB.EQ.1.AND.M.EQ.1.AND.N.EQ.3)THEN -C WRITE(*,6789)'STO',I,J,L,M,N,K,VL,PAR(N,M,L,NZ,NY,NX),RAPS -C 2,TKCZ(NZ,NY,NX),CO2Q(NZ,NY,NX),ETGR4(K,NB,NZ,NY,NX) -C 3,CBXN4(K,NB,NZ,NY,NX),VGRO4(K,NB,NZ,NY,NX),EGRO4 -C 3,FDBK4(K,NB,NZ,NY,NX),CH2O,VGRO4(K,NB,NZ,NY,NX),EGRO4 -C 3,VCGR4(K,NB,NZ,NY,NX),CO2I(NZ,NY,NX),CO2L(NZ,NY,NX),TFN1,TFN2 -C 4,TFNE,WSDX,WSDN,VCDN4 -6789 FORMAT(A8,6I4,40E12.4) -C ENDIF - ENDIF -C -C SHADED LEAVES -C - IF(PARDIF(N,M,L,NZ,NY,NX).GT.0.0)THEN -C -C LIGHT-LIMITED CARBOXYLATION RATES -C - PARX=QNTM*PARDIF(N,M,L,NZ,NY,NX) - PARJ=PARX+ETGR4(K,NB,NZ,NY,NX) - ETLF4=(PARJ-SQRT(PARJ**2-CURV4*PARX*ETGR4(K,NB,NZ,NY,NX)))/CURV2 - EGRO4=ETLF4*CBXN4(K,NB,NZ,NY,NX) -C -C C4 CARBOXYLATION RATE AND ACCUMULATED PRODUCT -C - VL=AMIN1(VGRO4(K,NB,NZ,NY,NX),EGRO4)*FDBK4(K,NB,NZ,NY,NX) - CH2O=CH2O+VL*SURFX(N,L,K,NB,NZ,NY,NX)*TAU0(L+1,NY,NX) -C WRITE(*,6799)'STB',I,J,L,M,N,K,VL,PAR(N,M,L,NZ,NY,NX),RAPS -C 2,TKCZ(NZ,NY,NX),CO2Q(NZ,NY,NX),ETGR4(K,NB,NZ,NY,NX) -C 3,CBXN4(K,NB,NZ,NY,NX),VGRO4(K,NB,NZ,NY,NX),EGRO4 -C 3,FDBK4(K,NB,NZ,NY,NX),CH2O,VGRO4(K,NB,NZ,NY,NX),EGRO4 -C 3,VCGR4(K,NB,NZ,NY,NX),CO2I(NZ,NY,NX),CO2L(NZ,NY,NX) -6799 FORMAT(A8,6I4,40E12.4) - ENDIF - ENDIF -2500 CONTINUE -2600 CONTINUE - ENDIF -2700 CONTINUE -C -C VARIABLES FOR C3 PHOTOSYNTHESIS DRIVEN BY C4 -C - VCDN=RUBP(NZ,NY,NX)*WSDN - ETDN=CHL(NZ,NY,NX)*WSDN - VCGRO(K,NB,NZ,NY,NX)=VCMX(NZ,NY,NX)*TFN1*VCDN - VOGRO=VOMX(NZ,NY,NX)*TFN2*VCDN - COMPL(K,NB,NZ,NY,NX)=0.5*O2L(NZ,NY,NX)*VOGRO*XKCO2L(NZ,NY,NX) - 2/(VCGRO(K,NB,NZ,NY,NX)*XKO2L) - VGRO(K,NB,NZ,NY,NX)=AMAX1(0.0,VCGRO(K,NB,NZ,NY,NX) - 2*(CCBS-COMPL(K,NB,NZ,NY,NX))/(CCBS+XKCO2O(NZ,NY,NX))) - ETGRO(K,NB,NZ,NY,NX)=ETMX(NZ,NY,NX)*TFNE*ETDN - CBXN(K,NB,NZ,NY,NX)=AMAX1(0.0,(CCBS-COMPL(K,NB,NZ,NY,NX)) - 2/(ELEC3*CCBS+10.5*COMPL(K,NB,NZ,NY,NX))) -C -C C3 PHOTOSYNTHESIS -C - ELSE -C -C SURFICIAL DENSITY OF RUBISCO AND ITS CHLOROPHYLL -C - VCDN=RUBP(NZ,NY,NX)*WSDN - ETDN=CHL(NZ,NY,NX)*WSDN -C -C CO2-LIMITED C3 CARBOXYLATION RATES -C - VCGRO(K,NB,NZ,NY,NX)=VCMX(NZ,NY,NX)*TFN1*VCDN - VOGRO=VOMX(NZ,NY,NX)*TFN2*VCDN - COMPL(K,NB,NZ,NY,NX)=0.5*O2L(NZ,NY,NX)*VOGRO*XKCO2L(NZ,NY,NX) - 2/(VCGRO(K,NB,NZ,NY,NX)*XKO2L) - VGRO(K,NB,NZ,NY,NX)=AMAX1(0.0,VCGRO(K,NB,NZ,NY,NX) - 2*(CO2L(NZ,NY,NX)-COMPL(K,NB,NZ,NY,NX)) - 5/(CO2L(NZ,NY,NX)+XKCO2O(NZ,NY,NX))) -C -C C3 ELECTRON TRANSFER RATES -C - ETGRO(K,NB,NZ,NY,NX)=ETMX(NZ,NY,NX)*TFNE*ETDN - CBXN(K,NB,NZ,NY,NX)=AMAX1(0.0,(CO2L(NZ,NY,NX) - 2-COMPL(K,NB,NZ,NY,NX))/(ELEC3*CO2L(NZ,NY,NX) - 3+10.5*COMPL(K,NB,NZ,NY,NX))) -C -C FOR EACH CANOPY LAYER -C - DO 3700 L=JC,1,-1 - IF(ARLFL(L,K,NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN -C -C FOR EACH INCLINATION AND AZIMUTH CLASS -C - DO 3600 N=1,4 - DO 3500 M=1,4 - IF(SURFX(N,L,K,NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN -C -C SUNLIT LEAVES -C - IF(PAR(N,M,L,NZ,NY,NX).GT.0.0)THEN -C -C LIGHT-LIMITED CARBOXYLATION RATES -C - PARX=QNTM*PAR(N,M,L,NZ,NY,NX) - PARJ=PARX+ETGRO(K,NB,NZ,NY,NX) - ETLF=(PARJ-SQRT(PARJ**2-CURV4*PARX*ETGRO(K,NB,NZ,NY,NX)))/CURV2 - EGRO=ETLF*CBXN(K,NB,NZ,NY,NX) -C -C C3 CARBOXYLATION RATE AND ACCUMULATED PRODUCT -C - VL=AMIN1(VGRO(K,NB,NZ,NY,NX),EGRO)*FDBK(NB,NZ,NY,NX) - CH2O=CH2O+VL*SURFX(N,L,K,NB,NZ,NY,NX)*TAUS(L+1,NY,NX) -C IF(NB.EQ.1.AND.M.EQ.1.AND.N.EQ.1.AND.K.EQ.KLEAF(NB,NZ,NY,NX)-1 -C 2.AND.J.EQ.14)THEN -C WRITE(20,6798)'STD',I,J,L,M,N,K,NB,VL,PAR(N,M,L,NZ,NY,NX),RAPS -C 2,TKCZ(NZ,NY,NX),CO2Q(NZ,NY,NX),ETGRO(K,NB,NZ,NY,NX) -C 3,CBXN(K,NB,NZ,NY,NX),VGRO(K,NB,NZ,NY,NX),EGRO -C 3,FDBK(NB,NZ,NY,NX),CH2O,TFN1,TFN2,TFNE,WSDX,WSDN -C 3,VCGRO(K,NB,NZ,NY,NX),VCDN,CO2I(NZ,NY,NX),CO2L(NZ,NY,NX) -6798 FORMAT(A8,7I4,40E12.4) -C ENDIF - ENDIF -C -C SHADED LEAVES -C - IF(PARDIF(N,M,L,NZ,NY,NX).GT.0.0)THEN -C -C LIGHT-LIMITED CARBOXYLATION RATES -C - PARX=QNTM*PARDIF(N,M,L,NZ,NY,NX) - PARJ=PARX+ETGRO(K,NB,NZ,NY,NX) - ETLF=(PARJ-SQRT(PARJ**2-CURV4*PARX*ETGRO(K,NB,NZ,NY,NX)))/CURV2 - EGRO=ETLF*CBXN(K,NB,NZ,NY,NX) -C -C C3 CARBOXYLATION RATE AND ACCUMULATED PRODUCT -C - VL=AMIN1(VGRO(K,NB,NZ,NY,NX),EGRO)*FDBK(NB,NZ,NY,NX) - CH2O=CH2O+VL*SURFX(N,L,K,NB,NZ,NY,NX)*TAU0(L+1,NY,NX) - ENDIF - ENDIF -3500 CONTINUE -3600 CONTINUE - ENDIF -3700 CONTINUE - ENDIF - ELSE - VCGR4(K,NB,NZ,NY,NX)=0.0 - VCGRO(K,NB,NZ,NY,NX)=0.0 - ENDIF -2800 CONTINUE - ENDIF - ELSE - FDBK(NB,NZ,NY,NX)=0.0 - FDBKX(NB,NZ,NY,NX)=1.0 - DO 2805 K=1,25 - VCGR4(K,NB,NZ,NY,NX)=0.0 - VCGRO(K,NB,NZ,NY,NX)=0.0 -2805 CONTINUE - ENDIF -2900 CONTINUE -C -C MINIMUM CANOPY STOMATAL RESISTANCE FROM CO2 CONCENTRATION -C DIFFERENCE DIVIDED BY TOTAL CO2 FIXATION -C - IF(CH2O.GT.ZEROP(NZ,NY,NX))THEN - RSX=FRADP(NZ,NY,NX)*DCO2(NZ,NY,NX) - 2*AREA(3,NU(NY,NX),NY,NX)/(CH2O*3600.0) - ELSE - RSX=RSMH(NZ,NY,NX)*1.56 - ENDIF - RSMN(NZ,NY,NX)=AMIN1(RSMH(NZ,NY,NX),AMAX1(RSMY,RSX*0.641)) - ELSE - RSMN(NZ,NY,NX)=RSMH(NZ,NY,NX) - ENDIF -C IF(ICTYP(NZ,NY,NX).EQ.3)THEN -C WRITE(19,3010)'CH2O',I,J,CH2O -C ELSEIF(ICTYP(NZ,NY,NX).EQ.4)THEN -C WRITE(20,3010)'CH2O',I,J,CH2O -C ENDIF -3010 FORMAT(A8,2I4,1E12.4) - RETURN - END + + SUBROUTINE stomate(I,J,NZ,NY,NX) +C +C THIS SUBROUTINE CALCULATES CANOPY STOMATAL RESISTANCE AT MAXIMUM +C CANOPY TURGOR FOR USE IN ENERGY BALANCE EQUATIONS IN 'UPTAKE' +C + include "parameters.h" + include "blkc.h" + include "blk1cp.h" + include "blk1g.h" + include "blk1n.h" + include "blk1p.h" + include "blk2a.h" + include "blk3.h" + include "blk5.h" + include "blk8a.h" + include "blk8b.h" + include "blk9a.h" + include "blk9b.h" + include "blk9c.h" + include "blk1u.h" + DIMENSION FLG4Y(0:5) + PARAMETER (QNTM=0.45,CURV=0.70,CURV2=2.0*CURV,CURV4=4.0*CURV + 2,ELEC3=4.5,ELEC4=3.0) + PARAMETER (CNKI=1.0E+02,CPKI=1.0E+03) + PARAMETER (RSMY=2.78E-03,ATRPZ=276.9) + PARAMETER (COMP4=0.5,FDML=6.0,FBS=0.2*FDML,FMP=0.8*FDML + 2,C4KI=5.0E+06,FVRN=0.5) + DATA FLG4Y/336.0,672.0,672.0,672.0,672.0,672.0/ +C +C CANOPY TEMPERATURE + OFFSET FOR THERMAL ADAPTATION FROM 'READQ' +C +C +C CANOPY BOUNDARY LAYER RESISTANCE +C + RI=AMAX1(-0.3,AMIN1(0.075,RIB(NY,NX)*(TKA(NY,NX)-TKCZ(NZ,NY,NX)))) + RAC=1.34*AMAX1(5.56E-03,RAZ(NZ,NY,NX)/(1.0-10.0*RI)) + FMOL(NZ,NY,NX)=1.2194E+04/TKCZ(NZ,NY,NX) +C +C CANOPY CO2 CONCENTRATION FROM CO2 INFLUXES AND EFFLUXES +C + CO2Q(NZ,NY,NX)=CO2E(NY,NX)-8.33E+04*CNETX(NY,NX) + 2*RAC/FMOL(NZ,NY,NX) + CO2Q(NZ,NY,NX)=AMIN1(CO2E(NY,NX)+200.0 + 2,AMAX1(0.0,CO2E(NY,NX)-200.0,CO2Q(NZ,NY,NX))) +C +C MESOPHYLL CO2 CONCENTRATION FROM CI:CA RATIO ENTERED IN 'READQ' +C + CO2I(NZ,NY,NX)=FCO2(NZ,NY,NX)*CO2Q(NZ,NY,NX) + IF(SSIN(NY,NX).GT.0.0.AND.ARLFP(NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN +C +C CO2 AND O2 AQUEOUS SOLUBILITY +C + TCCZ=TKCZ(NZ,NY,NX)-273.15 + SCO2(NZ,NY,NX)=EXP(-2.621-0.0317*TCCZ) + SO2(NZ,NY,NX)=EXP(-6.175-0.0211*TCCZ) + CO2L(NZ,NY,NX)=CO2I(NZ,NY,NX)*SCO2(NZ,NY,NX) + O2L(NZ,NY,NX)=O2I(NZ,NY,NX)*SO2(NZ,NY,NX) +C +C CO2 CONCENTRATION DIFFERENCE +C + DCO2(NZ,NY,NX)=FMOL(NZ,NY,NX)*(CO2Q(NZ,NY,NX)-CO2I(NZ,NY,NX)) + CH2O=0.0 + TKCO=TKCZ(NZ,NY,NX)+OFFST(NZ,NY,NX) + RTK=8.3143*TKCO + STK=710.0*TKCO +C +C ARRHENIUS FUNCTIONS FOR CARBOXYLATION AND OXYGENATION +C + ACTV=1+EXP((197500-STK)/RTK)+EXP((STK-222500)/RTK) + TFN1=EXP(26.237-65000/RTK)/ACTV + TFN2=EXP(24.220-60000/RTK)/ACTV + TFNE=EXP(17.362-43000/RTK)/ACTV +C +C M-M CONSTANT FOR CARBOXYLATION FROM 'READQ' ADJUSTED FOR TEMPERATURE +C + XKCO2L(NZ,NY,NX)=XKCO2(NZ,NY,NX)*EXP(16.136-40000/RTK) + XKO2L=XKO2(NZ,NY,NX)*EXP(8.067-20000/RTK) + XKCO2O(NZ,NY,NX)=XKCO2L(NZ,NY,NX)*(1.0+O2L(NZ,NY,NX)/XKO2L) +C +C FOR EACH BRANCH +C + DO 2900 NB=1,NBR(NZ,NY,NX) +C IF(NZ.EQ.1.OR.NZ.EQ.4)THEN +C WRITE(*,4242)'FDBK',I,J,NZ,NB,IDTHB(NB,NZ,NY,NX),FDBK(NB,NZ,NY,NX) +C 2,VRNS(NB,NZ,NY,NX),VRNF(NB,NZ,NY,NX),CCPOLB(NB,NZ,NY,NX) +C 3,CZPOLB(NB,NZ,NY,NX),CCPOLB(NB,NZ,NY,NX) +4242 FORMAT(A8,5I4,12E12.4) +C ENDIF +C +C FEEDBACK ON CO2 FIXATION +C + IF(IWTYP(NZ,NY,NX).EQ.0 + 2.OR.VRNS(NB,NZ,NY,NX).GE.VRNL(NB,NZ,NY,NX) + 3.OR.VRNF(NB,NZ,NY,NX).LT.VRNX(NB,NZ,NY,NX))THEN +C +C FEEDBACK ON C3 CARBOXYLATION FROM NON-STRUCTURAL C:N:P +C + IF(CCPOLB(NB,NZ,NY,NX).GT.ZERO)THEN + FDBK(NB,NZ,NY,NX)=AMIN1(CZPOLB(NB,NZ,NY,NX) + 3/(CZPOLB(NB,NZ,NY,NX)+CCPOLB(NB,NZ,NY,NX)/CNKI) + 4,CPPOLB(NB,NZ,NY,NX) + 5/(CPPOLB(NB,NZ,NY,NX)+CCPOLB(NB,NZ,NY,NX)/CPKI)) + ELSE + FDBK(NB,NZ,NY,NX)=1.0 + ENDIF +C +C CHILLING +C +C FDBK(NB,NZ,NY,NX)=FDBK(NB,NZ,NY,NX)/(1.0+0.25*CHILL(NZ,NY,NX)) +C +C DEHARDENING OF EVERGREENS IN SPRING +C + IF(IWTYP(NZ,NY,NX).NE.0.AND.IBTYP(NZ,NY,NX).GE.2)THEN + FDBK(NB,NZ,NY,NX)=FDBK(NB,NZ,NY,NX)*AMAX1(0.0,AMIN1(1.0 + 2,ATRP(NB,NZ,NY,NX)/(0.9*ATRPZ))) + ENDIF +C +C TERMINATION OF ANNUALS +C + IF(ISTYP(NZ,NY,NX).EQ.0.AND.FLG4(NB,NZ,NY,NX).GT.0.0)THEN + FDBKX(NB,NZ,NY,NX)=AMAX1(0.0 + 2,1.0-FLG4(NB,NZ,NY,NX)/FLG4Y(IWTYP(NZ,NY,NX))) + ELSE + FDBKX(NB,NZ,NY,NX)=1.0 + ENDIF + FDBK(NB,NZ,NY,NX)=FDBK(NB,NZ,NY,NX)*FDBKX(NB,NZ,NY,NX) +C +C FOR EACH NODE +C + IF(IDTHB(NB,NZ,NY,NX).EQ.0)THEN + DO 2800 K=1,25 + IF(ARLF(K,NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX) + 2.AND.WGLF(K,NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + WSDN=WSLF(K,NB,NZ,NY,NX)/ARLF(K,NB,NZ,NY,NX) + ELSE + WSDN=0.0 + ENDIF +C IF((I/10)*10.EQ.I.AND.J.EQ.15)THEN +C WRITE(*,2125)'WSDN',I,J,NX,NY,NZ,NB,K,WSDX,WSDN +C 2,WSDM,WGLF(K,NB,NZ,NY,NX),WSLF(K,NB,NZ,NY,NX) +C 3,ARLF(K,NB,NZ,NY,NX) +2125 FORMAT(A8,7I4,12E12.4) +C ENDIF + IF(WSDN.GT.ZERO)THEN +C +C C4 PHOTOSYNTHESIS +C + IF(ICTYP(NZ,NY,NX).EQ.4)THEN +C +C FEEDBACK ON C4 CARBOXYLATION FROM C4 NON-STRUCTURAL C +C + CC4M=AMAX1(0.0,0.021E+09*CPOOL4(K,NB,NZ,NY,NX) + 2/(WGLF(K,NB,NZ,NY,NX)*FMP)) + CCBS=AMAX1(0.0,0.083E+09*CO2B(K,NB,NZ,NY,NX) + 2/(WGLF(K,NB,NZ,NY,NX)*FBS)) + FDBK4(K,NB,NZ,NY,NX)=1.0/(1.0+CC4M/C4KI) + FDBK4(K,NB,NZ,NY,NX)=FDBK4(K,NB,NZ,NY,NX)*FDBKX(NB,NZ,NY,NX) +C +C SURFICIAL DENSITY OF PEPC AND ITS CHLOROPHYLL +C + VCDN4=PEPC(NZ,NY,NX)*WSDN + ETDN4=CHL4(NZ,NY,NX)*WSDN +C +C CO2-LIMITED C4 CARBOXYLATION RATES +C + VCGR4(K,NB,NZ,NY,NX)=VCMX4(NZ,NY,NX)*TFN1*VCDN4 + VGRO4(K,NB,NZ,NY,NX)=AMAX1(0.0,VCGR4(K,NB,NZ,NY,NX) + 2*(CO2L(NZ,NY,NX)-COMP4)/(CO2L(NZ,NY,NX)+XKCO24(NZ,NY,NX))) +C +C C4 ELECTRON TRANSFER RATES +C + ETGR4(K,NB,NZ,NY,NX)=ETMX(NZ,NY,NX)*TFNE*ETDN4 + CBXN4(K,NB,NZ,NY,NX)=AMAX1(0.0,(CO2L(NZ,NY,NX)-COMP4) + 2/(ELEC4*CO2L(NZ,NY,NX)+10.5*COMP4)) +C +C FOR EACH CANOPY LAYER +C + DO 2700 L=JC,1,-1 + IF(ARLFL(L,K,NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN +C +C FOR EACH INCLINATION AND AZIMUTH CLASS +C + DO 2600 N=1,4 + DO 2500 M=1,4 + IF(SURFX(N,L,K,NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN +C +C SUNLIT LEAVES +C + IF(PAR(N,M,L,NZ,NY,NX).GT.0.0)THEN +C +C LIGHT-LIMITED CARBOXYLATION RATES +C + PARX=QNTM*PAR(N,M,L,NZ,NY,NX) + PARJ=PARX+ETGR4(K,NB,NZ,NY,NX) + ETLF4=(PARJ-SQRT(PARJ**2-CURV4*PARX*ETGR4(K,NB,NZ,NY,NX)))/CURV2 + EGRO4=ETLF4*CBXN4(K,NB,NZ,NY,NX) +C +C C4 CARBOXYLATION RATE AND ACCUMULATED PRODUCT +C + VL=AMIN1(VGRO4(K,NB,NZ,NY,NX),EGRO4)*FDBK4(K,NB,NZ,NY,NX) + CH2O=CH2O+VL*SURFX(N,L,K,NB,NZ,NY,NX)*TAUS(L+1,NY,NX) +C IF(L.GT.NC-4.AND.NB.EQ.1.AND.M.EQ.1.AND.N.EQ.3)THEN +C WRITE(*,6789)'STO',I,J,L,M,N,K,VL,PAR(N,M,L,NZ,NY,NX),RAPS +C 2,TKCZ(NZ,NY,NX),CO2Q(NZ,NY,NX),ETGR4(K,NB,NZ,NY,NX) +C 3,CBXN4(K,NB,NZ,NY,NX),VGRO4(K,NB,NZ,NY,NX),EGRO4 +C 3,FDBK4(K,NB,NZ,NY,NX),CH2O,VGRO4(K,NB,NZ,NY,NX),EGRO4 +C 3,VCGR4(K,NB,NZ,NY,NX),CO2I(NZ,NY,NX),CO2L(NZ,NY,NX),TFN1,TFN2 +C 4,TFNE,WSDX,WSDN,VCDN4 +6789 FORMAT(A8,6I4,40E12.4) +C ENDIF + ENDIF +C +C SHADED LEAVES +C + IF(PARDIF(N,M,L,NZ,NY,NX).GT.0.0)THEN +C +C LIGHT-LIMITED CARBOXYLATION RATES +C + PARX=QNTM*PARDIF(N,M,L,NZ,NY,NX) + PARJ=PARX+ETGR4(K,NB,NZ,NY,NX) + ETLF4=(PARJ-SQRT(PARJ**2-CURV4*PARX*ETGR4(K,NB,NZ,NY,NX)))/CURV2 + EGRO4=ETLF4*CBXN4(K,NB,NZ,NY,NX) +C +C C4 CARBOXYLATION RATE AND ACCUMULATED PRODUCT +C + VL=AMIN1(VGRO4(K,NB,NZ,NY,NX),EGRO4)*FDBK4(K,NB,NZ,NY,NX) + CH2O=CH2O+VL*SURFX(N,L,K,NB,NZ,NY,NX)*TAU0(L+1,NY,NX) +C WRITE(*,6799)'STB',I,J,L,M,N,K,VL,PAR(N,M,L,NZ,NY,NX),RAPS +C 2,TKCZ(NZ,NY,NX),CO2Q(NZ,NY,NX),ETGR4(K,NB,NZ,NY,NX) +C 3,CBXN4(K,NB,NZ,NY,NX),VGRO4(K,NB,NZ,NY,NX),EGRO4 +C 3,FDBK4(K,NB,NZ,NY,NX),CH2O,VGRO4(K,NB,NZ,NY,NX),EGRO4 +C 3,VCGR4(K,NB,NZ,NY,NX),CO2I(NZ,NY,NX),CO2L(NZ,NY,NX) +6799 FORMAT(A8,6I4,40E12.4) + ENDIF + ENDIF +2500 CONTINUE +2600 CONTINUE + ENDIF +2700 CONTINUE +C +C VARIABLES FOR C3 PHOTOSYNTHESIS DRIVEN BY C4 +C + VCDN=RUBP(NZ,NY,NX)*WSDN + ETDN=CHL(NZ,NY,NX)*WSDN + VCGRO(K,NB,NZ,NY,NX)=VCMX(NZ,NY,NX)*TFN1*VCDN + VOGRO=VOMX(NZ,NY,NX)*TFN2*VCDN + COMPL(K,NB,NZ,NY,NX)=0.5*O2L(NZ,NY,NX)*VOGRO*XKCO2L(NZ,NY,NX) + 2/(VCGRO(K,NB,NZ,NY,NX)*XKO2L) + VGRO(K,NB,NZ,NY,NX)=AMAX1(0.0,VCGRO(K,NB,NZ,NY,NX) + 2*(CCBS-COMPL(K,NB,NZ,NY,NX))/(CCBS+XKCO2O(NZ,NY,NX))) + ETGRO(K,NB,NZ,NY,NX)=ETMX(NZ,NY,NX)*TFNE*ETDN + CBXN(K,NB,NZ,NY,NX)=AMAX1(0.0,(CCBS-COMPL(K,NB,NZ,NY,NX)) + 2/(ELEC3*CCBS+10.5*COMPL(K,NB,NZ,NY,NX))) +C +C C3 PHOTOSYNTHESIS +C + ELSE +C +C SURFICIAL DENSITY OF RUBISCO AND ITS CHLOROPHYLL +C + VCDN=RUBP(NZ,NY,NX)*WSDN + ETDN=CHL(NZ,NY,NX)*WSDN +C +C CO2-LIMITED C3 CARBOXYLATION RATES +C + VCGRO(K,NB,NZ,NY,NX)=VCMX(NZ,NY,NX)*TFN1*VCDN + VOGRO=VOMX(NZ,NY,NX)*TFN2*VCDN + COMPL(K,NB,NZ,NY,NX)=0.5*O2L(NZ,NY,NX)*VOGRO*XKCO2L(NZ,NY,NX) + 2/(VCGRO(K,NB,NZ,NY,NX)*XKO2L) + VGRO(K,NB,NZ,NY,NX)=AMAX1(0.0,VCGRO(K,NB,NZ,NY,NX) + 2*(CO2L(NZ,NY,NX)-COMPL(K,NB,NZ,NY,NX)) + 5/(CO2L(NZ,NY,NX)+XKCO2O(NZ,NY,NX))) +C +C C3 ELECTRON TRANSFER RATES +C + ETGRO(K,NB,NZ,NY,NX)=ETMX(NZ,NY,NX)*TFNE*ETDN + CBXN(K,NB,NZ,NY,NX)=AMAX1(0.0,(CO2L(NZ,NY,NX) + 2-COMPL(K,NB,NZ,NY,NX))/(ELEC3*CO2L(NZ,NY,NX) + 3+10.5*COMPL(K,NB,NZ,NY,NX))) +C +C FOR EACH CANOPY LAYER +C + DO 3700 L=JC,1,-1 + IF(ARLFL(L,K,NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN +C +C FOR EACH INCLINATION AND AZIMUTH CLASS +C + DO 3600 N=1,4 + DO 3500 M=1,4 + IF(SURFX(N,L,K,NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN +C +C SUNLIT LEAVES +C + IF(PAR(N,M,L,NZ,NY,NX).GT.0.0)THEN +C +C LIGHT-LIMITED CARBOXYLATION RATES +C + PARX=QNTM*PAR(N,M,L,NZ,NY,NX) + PARJ=PARX+ETGRO(K,NB,NZ,NY,NX) + ETLF=(PARJ-SQRT(PARJ**2-CURV4*PARX*ETGRO(K,NB,NZ,NY,NX)))/CURV2 + EGRO=ETLF*CBXN(K,NB,NZ,NY,NX) +C +C C3 CARBOXYLATION RATE AND ACCUMULATED PRODUCT +C + VL=AMIN1(VGRO(K,NB,NZ,NY,NX),EGRO)*FDBK(NB,NZ,NY,NX) + CH2O=CH2O+VL*SURFX(N,L,K,NB,NZ,NY,NX)*TAUS(L+1,NY,NX) +C IF(NB.EQ.1.AND.M.EQ.1.AND.N.EQ.1.AND.K.EQ.KLEAF(NB,NZ,NY,NX)-1 +C 2.AND.J.EQ.14)THEN +C WRITE(20,6798)'STD',I,J,L,M,N,K,NB,VL,PAR(N,M,L,NZ,NY,NX),RAPS +C 2,TKCZ(NZ,NY,NX),CO2Q(NZ,NY,NX),ETGRO(K,NB,NZ,NY,NX) +C 3,CBXN(K,NB,NZ,NY,NX),VGRO(K,NB,NZ,NY,NX),EGRO +C 3,FDBK(NB,NZ,NY,NX),CH2O,TFN1,TFN2,TFNE,WSDX,WSDN +C 3,VCGRO(K,NB,NZ,NY,NX),VCDN,CO2I(NZ,NY,NX),CO2L(NZ,NY,NX) +6798 FORMAT(A8,7I4,40E12.4) +C ENDIF + ENDIF +C +C SHADED LEAVES +C + IF(PARDIF(N,M,L,NZ,NY,NX).GT.0.0)THEN +C +C LIGHT-LIMITED CARBOXYLATION RATES +C + PARX=QNTM*PARDIF(N,M,L,NZ,NY,NX) + PARJ=PARX+ETGRO(K,NB,NZ,NY,NX) + ETLF=(PARJ-SQRT(PARJ**2-CURV4*PARX*ETGRO(K,NB,NZ,NY,NX)))/CURV2 + EGRO=ETLF*CBXN(K,NB,NZ,NY,NX) +C +C C3 CARBOXYLATION RATE AND ACCUMULATED PRODUCT +C + VL=AMIN1(VGRO(K,NB,NZ,NY,NX),EGRO)*FDBK(NB,NZ,NY,NX) + CH2O=CH2O+VL*SURFX(N,L,K,NB,NZ,NY,NX)*TAU0(L+1,NY,NX) + ENDIF + ENDIF +3500 CONTINUE +3600 CONTINUE + ENDIF +3700 CONTINUE + ENDIF + ELSE + VCGR4(K,NB,NZ,NY,NX)=0.0 + VCGRO(K,NB,NZ,NY,NX)=0.0 + ENDIF +2800 CONTINUE + ENDIF + ELSE + FDBK(NB,NZ,NY,NX)=0.0 + FDBKX(NB,NZ,NY,NX)=1.0 + DO 2805 K=1,25 + VCGR4(K,NB,NZ,NY,NX)=0.0 + VCGRO(K,NB,NZ,NY,NX)=0.0 +2805 CONTINUE + ENDIF +2900 CONTINUE +C +C MINIMUM CANOPY STOMATAL RESISTANCE FROM CO2 CONCENTRATION +C DIFFERENCE DIVIDED BY TOTAL CO2 FIXATION +C + IF(CH2O.GT.ZEROP(NZ,NY,NX))THEN + RSX=FRADP(NZ,NY,NX)*DCO2(NZ,NY,NX) + 2*AREA(3,NU(NY,NX),NY,NX)/(CH2O*3600.0) + ELSE + RSX=RSMH(NZ,NY,NX)*1.56 + ENDIF + RSMN(NZ,NY,NX)=AMIN1(RSMH(NZ,NY,NX),AMAX1(RSMY,RSX*0.641)) + ELSE + RSMN(NZ,NY,NX)=RSMH(NZ,NY,NX) + ENDIF +C IF(ICTYP(NZ,NY,NX).EQ.3)THEN +C WRITE(19,3010)'CH2O',I,J,CH2O +C ELSEIF(ICTYP(NZ,NY,NX).EQ.4)THEN +C WRITE(20,3010)'CH2O',I,J,CH2O +C ENDIF +3010 FORMAT(A8,2I4,1E12.4) + RETURN + END diff --git a/f77src/trnsfr.f b/f77src/trnsfr.f index 5b09fc8..4526b31 100755 --- a/f77src/trnsfr.f +++ b/f77src/trnsfr.f @@ -1,4607 +1,4603 @@ - SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) -C -C THIS SUBROUTINE CALCULATES 3-DIMENSIONAL FLUXES OF ALL SOIL -C NON-SALT SOLUTES AND GASES -C - include "parameters.h" - include "blkc.h" - include "blk2a.h" - include "blk2b.h" - include "blk2c.h" - include "blk8a.h" - include "blk8b.h" - include "blk10.h" - include "blk11a.h" - include "blk11b.h" - include "blk13a.h" - include "blk13b.h" - include "blk13c.h" - include "blk15a.h" - include "blk15b.h" - include "blk18a.h" - include "blk18b.h" - include "blk19d.h" - include "blk20d.h" - include "blk20e.h" - include "blk21a.h" - include "blk21b.h" - include "blk22a.h" - include "blk22b.h" - include "blk22c.h" - DIMENSION CO2G2(JZ,JY,JX),CO2S2(0:JZ,JY,JX) - 2,CH4G2(JZ,JY,JX),CH4S2(0:JZ,JY,JX),OXYG2(JZ,JY,JX) - 3,OXYS2(0:JZ,JY,JX),Z2GG2(JZ,JY,JX),Z2GS2(0:JZ,JY,JX) - 4,Z2OG2(JZ,JY,JX),Z2OS2(0:JZ,JY,JX),ZN3G2(0:JZ,JY,JX) - 5,ZNH4S2(0:JZ,JY,JX),ZNH4B2(0:JZ,JY,JX),ZN3S2(0:JZ,JY,JX) - 6,ZNBS2(0:JZ,JY,JX),ZNO3S2(0:JZ,JY,JX),ZNO3B2(0:JZ,JY,JX) - 7,H2PO42(0:JZ,JY,JX),H2POB2(0:JZ,JY,JX),ZNO2S2(0:JZ,JY,JX) - 8,CGSGL2(JZ,JY,JX),CHSGL2(JZ,JY,JX),OGSGL2(JZ,JY,JX) - 9,ZGSGL2(JZ,JY,JX),Z2SGL2(JZ,JY,JX),ZHSGL2(JZ,JY,JX) - 7,OQC2(0:4,0:JZ,JY,JX),OQN2(0:4,0:JZ,JY,JX),OQP2(0:4,0:JZ,JY,JX) - 8,OQA2(0:4,0:JZ,JY,JX),OCSGL2(0:JZ,JY,JX),ONSGL2(0:JZ,JY,JX) - 9,OPSGL2(0:JZ,JY,JX),OASGL2(0:JZ,JY,JX),CHY0(0:JZ,JY,JX) - 1,CO2W2(JY,JX),CH4W2(JY,JX),OXYW2(JY,JX),ZNGW2(JY,JX) - 2,ZN2W2(JY,JX),ZN4W2(JY,JX),ZN3W2(JY,JX),ZNOW2(JY,JX) - 3,ZHPW2(JY,JX) - DIMENSION ROCSK2(0:4,0:JZ,JY,JX),RONSK2(0:4,0:JZ,JY,JX) - 2,ROPSK2(0:4,0:JZ,JY,JX),ROASK2(0:4,0:JZ,JY,JX) - 3,RCOSK2(0:JZ,JY,JX),ROXSK2(0:JZ,JY,JX),RCHSK2(0:JZ,JY,JX) - 4,RNGSK2(0:JZ,JY,JX),RN2SK2(0:JZ,JY,JX),RN4SK2(0:JZ,JY,JX) - 5,RN3SK2(0:JZ,JY,JX),RNOSK2(0:JZ,JY,JX),RHPSK2(0:JZ,JY,JX) - 6,R4BSK2(JZ,JY,JX),R3BSK2(JZ,JY,JX),RNBSK2(JZ,JY,JX) - 7,RHBSK2(JZ,JY,JX),RNXSK2(0:JZ,JY,JX),RNZSK2(JZ,JY,JX) - 8,RHGSK2(0:JZ,JY,JX),RNHSK2(0:JZ,JY,JX) - DIMENSION CLSGL2(0:JZ,JY,JX),CQSGL2(0:JZ,JY,JX),OLSGL2(0:JZ,JY,JX) - 2,ZNSGL2(0:JZ,JY,JX),ZLSGL2(0:JZ,JY,JX),ZVSGL2(0:JZ,JY,JX) - 3,HLSGL2(0:JZ,JY,JX),ZOSGL2(0:JZ,JY,JX),POSGL2(0:JZ,JY,JX) - 4,RCODFS(JY,JX),RCHDFS(JY,JX),ROXDFS(JY,JX),RNGDFS(JY,JX) - 5,RN2DFS(JY,JX),RN3DFS(JY,JX),RNBDFS(JY,JX),RHGDFS(JY,JX) - 6,RCODFR(JY,JX),RCHDFR(JY,JX),ROXDFR(JY,JX),RNGDFR(JY,JX) - 7,RN2DFR(JY,JX),RN3DFR(JY,JX),RHGDFR(JY,JX) - 8,RQROC(0:4,2,JV,JH),RQRON(0:4,2,JV,JH),RQROP(0:4,2,JV,JH) - 9,RQROA(0:4,2,JV,JH),RQRCOS(2,JV,JH),RQRCHS(2,JV,JH) - 1,RQROXS(2,JV,JH),RQRNGS(2,JV,JH),RQRN2S(2,JV,JH),RQRNH4(2,JV,JH) - 2,RQRNH3(2,JV,JH),RQRNO3(2,JV,JH),RQRH2P(2,JV,JH) - 3,RQRNO2(2,JV,JH),RQRHGS(2,JV,JH),FLWU(JZ,JY,JX) - 4,RQSCOS(2,JV,JH),RQSCHS(2,JV,JH),RQSOXS(2,JV,JH) - 5,RQSNGS(2,JV,JH),RQSN2S(2,JV,JH),RQSNH4(2,JV,JH) - 6,RQSNH3(2,JV,JH),RQSNO3(2,JV,JH),RQSH2P(2,JV,JH) - DIMENSION RCOFLS(3,0:JD,JV,JH),RCHFLS(3,0:JD,JV,JH) - 2,ROXFLS(3,0:JD,JV,JH),RNGFLS(3,0:JD,JV,JH),RN2FLS(3,0:JD,JV,JH) - 3,RHGFLS(3,0:JD,JV,JH),RN4FLW(3,0:JD,JV,JH),RN3FLW(3,0:JD,JV,JH) - 4,RNOFLW(3,0:JD,JV,JH),RNXFLS(3,0:JD,JV,JH),RH2PFS(3,0:JD,JV,JH) - 5,RN4FLB(3,0:JD,JV,JH),RN3FLB(3,0:JD,JV,JH),RNOFLB(3,0:JD,JV,JH) - 6,RNXFLB(3,0:JD,JV,JH),RH2BFB(3,0:JD,JV,JH),RCOFHS(3,JD,JV,JH) - 7,RCHFHS(3,JD,JV,JH),ROXFHS(3,JD,JV,JH),RNGFHS(3,JD,JV,JH) - 8,RN2FHS(3,JD,JV,JH),RN4FHW(3,JD,JV,JH),RN3FHW(3,JD,JV,JH) - 9,RNOFHW(3,JD,JV,JH),RH2PHS(3,JD,JV,JH),RN4FHB(3,JD,JV,JH) - 1,RN3FHB(3,JD,JV,JH),RNOFHB(3,JD,JV,JH),RH2BHB(3,JD,JV,JH) - 2,ROCFLS(0:4,3,0:JD,JV,JH),RONFLS(0:4,3,0:JD,JV,JH) - 3,ROPFLS(0:4,3,0:JD,JV,JH),ROAFLS(0:4,3,0:JD,JV,JH) - 4,ROCFHS(0:4,3,JD,JV,JH),RONFHS(0:4,3,JD,JV,JH) - 5,ROPFHS(0:4,3,JD,JV,JH),ROAFHS(0:4,3,JD,JV,JH) - 6,ROXFLG(3,JD,JV,JH),RN3FLG(3,JD,JV,JH),RCOFLG(3,JD,JV,JH) - 7,RCHFLG(3,JD,JV,JH),RNGFLG(3,JD,JV,JH),RN2FLG(3,JD,JV,JH) - 8,RNXFHS(3,JD,JV,JH),RNXFHB(3,JD,JV,JH) - DIMENSION RCODFG(0:JZ,JY,JX),RCHDFG(0:JZ,JY,JX) - 1,ROXDFG(0:JZ,JY,JX),RNGDFG(0:JZ,JY,JX),RN2DFG(0:JZ,JY,JX) - 2,RN3DFG(0:JZ,JY,JX),RNBDFG(0:JZ,JY,JX),TQROC(0:4,JY,JX) - 3,TQRON(0:4,JY,JX),TQROP(0:4,JY,JX),TQROA(0:4,JY,JX),TQRCOS(JY,JX) - 4,TQRCHS(JY,JX),TQROXS(JY,JX),TQRNGS(JY,JX),TQRN2S(JY,JX) - 5,TQRNH4(JY,JX),TQRNH3(JY,JX),TQRNO3(JY,JX),TQRH2P(JY,JX) - 7,TQRNO2(JY,JX),TQRHGS(JY,JX),TQSCOS(JY,JX) - 4,TQSCHS(JY,JX),TQSOXS(JY,JX),TQSNGS(JY,JX),TQSN2S(JY,JX) - 5,TQSNH4(JY,JX),TQSNH3(JY,JX),TQSNO3(JY,JX),TQSH2P(JY,JX) - 8,TOCFLS(0:4,JZ,JY,JX),TONFLS(0:4,JZ,JY,JX) - 8,TOPFLS(0:4,JZ,JY,JX),TOAFLS(0:4,JZ,JY,JX),TCOFLS(JZ,JY,JX) - 9,TCHFLS(JZ,JY,JX),TOXFLS(JZ,JY,JX),TNGFLS(JZ,JY,JX) - 1,TN2FLS(JZ,JY,JX),TN4FLW(JZ,JY,JX),TN3FLW(JZ,JY,JX) - 2,TNOFLW(JZ,JY,JX),TH2PFS(JZ,JY,JX),TN4FLB(JZ,JY,JX) - 3,TN3FLB(JZ,JY,JX),TNOFLB(JZ,JY,JX),TH2BFB(JZ,JY,JX) - 4,TNXFLS(JZ,JY,JX),TCOFLG(JZ,JY,JX),TCHFLG(JZ,JY,JX) - 5,TOXFLG(JZ,JY,JX),TNGFLG(JZ,JY,JX),TN2FLG(JZ,JY,JX) - 6,RN34SQ(0:JZ,JY,JX),RN34BQ(0:JZ,JY,JX) - DIMENSION TN3FLG(JZ,JY,JX),RCOBBL(JZ,JY,JX) - 4,RCHBBL(JZ,JY,JX),ROXBBL(JZ,JY,JX),RNGBBL(JZ,JY,JX) - 5,RN2BBL(JZ,JY,JX),RN3BBL(JZ,JY,JX),RNBBBL(JZ,JY,JX) - 6,RHGBBL(JZ,JY,JX) - DIMENSION CO2SH2(JZ,JY,JX),CH4SH2(JZ,JY,JX),OXYSH2(JZ,JY,JX) - 2,Z2GSH2(JZ,JY,JX),Z2OSH2(JZ,JY,JX),ZNH4H2(JZ,JY,JX) - 3,ZN4BH2(JZ,JY,JX),ZNH3H2(JZ,JY,JX),ZN3BH2(JZ,JY,JX) - 4,ZNO3H2(JZ,JY,JX),ZNOBH2(JZ,JY,JX),H2P4H2(JZ,JY,JX) - 5,H2PBH2(JZ,JY,JX),ZNO2H2(JZ,JY,JX),OQCH2(0:4,JZ,JY,JX) - 6,OQNH2(0:4,JZ,JY,JX),OQPH2(0:4,JZ,JY,JX),OQAH2(0:4,JZ,JY,JX) - 7,TOCFHS(0:4,JZ,JY,JX),TONFHS(0:4,JZ,JY,JX),TOPFHS(0:4,JZ,JY,JX) - 8,TOAFHS(0:4,JZ,JY,JX),TCOFHS(JZ,JY,JX),TCHFHS(JZ,JY,JX) - 9,TOXFHS(JZ,JY,JX),TNGFHS(JZ,JY,JX),TN2FHS(JZ,JY,JX) - 1,TN4FHW(JZ,JY,JX),TN3FHW(JZ,JY,JX),TNOFHW(JZ,JY,JX) - 2,TH2PHS(JZ,JY,JX),TN4FHB(JZ,JY,JX),TN3FHB(JZ,JY,JX) - 3,TNOFHB(JZ,JY,JX),TH2BHB(JZ,JY,JX),TNXFHS(JZ,JY,JX) - 4,ZNO2B2(JZ,JY,JX),ZN2BH2(JZ,JY,JX),TNXFLB(JZ,JY,JX) - 5,TNXFHB(JZ,JY,JX) - DIMENSION RCOFLZ(JZ,JY,JX),RCHFLZ(JZ,JY,JX) - 1,ROXFLZ(JZ,JY,JX),RNGFLZ(JZ,JY,JX) - 2,RN2FLZ(JZ,JY,JX),RN4FLZ(JZ,JY,JX),RN3FLZ(JZ,JY,JX) - 3,RNOFLZ(JZ,JY,JX),RH2PFZ(JZ,JY,JX),RN4FBZ(JZ,JY,JX) - 4,RN3FBZ(JZ,JY,JX),RNOFBZ(JZ,JY,JX),RH2BBZ(JZ,JY,JX) - DIMENSION ROCFXS(0:4,JZ,JY,JX),RONFXS(0:4,JZ,JY,JX) - 1,ROPFXS(0:4,JZ,JY,JX),ROAFXS(0:4,JZ,JY,JX),RCOFXS(JZ,JY,JX) - 2,RCHFXS(JZ,JY,JX),ROXFXS(JZ,JY,JX) - 3,RNGFXS(JZ,JY,JX),RN2FXS(JZ,JY,JX),RN4FXW(JZ,JY,JX) - 4,RN3FXW(JZ,JY,JX),RNOFXW(JZ,JY,JX),RH2PXS(JZ,JY,JX) - 5,RN4FXB(JZ,JY,JX),RN3FXB(JZ,JY,JX),RNOFXB(JZ,JY,JX) - 6,RH2BXB(JZ,JY,JX),RNXFXS(JZ,JY,JX),RNXFXB(JZ,JY,JX) - DIMENSION RFLOC(0:4),RFLON(0:4),RFLOP(0:4),RFLOA(0:4) - 2,RFHOC(0:4),RFHON(0:4),RFHOP(0:4),RFHOA(0:4) ,COQC1(0:4) - 3,COQC2(0:4),COQN1(0:4),COQN2(0:4),COQP1(0:4),COQP2(0:4) - 4,COQA1(0:4),COQA2(0:4),COQCH1(0:4),COQCH2(0:4) - 3,COQNH1(0:4),COQNH2(0:4),COQPH1(0:4),COQPH2(0:4) - 4,COQAH1(0:4),COQAH2(0:4),DFVOC(0:4),DFVON(0:4),DFVOP(0:4) - 5,DFVOA(0:4),DFHOC(0:4),DFHON(0:4),DFHOP(0:4),DFHOA(0:4) - DIMENSION THETW1(0:JZ,JY,JX) - 2,DCO2G(3,JZ,JY,JX),DCH4G(3,JZ,JY,JX) - 3,DOXYG(3,JZ,JY,JX),DZ2GG(3,JZ,JY,JX),DZ2OG(3,JZ,JY,JX) - 4,DNH3G(3,JZ,JY,JX),VOLWCO(0:JZ,JY,JX),VOLWCH(0:JZ,JY,JX) - 5,VOLWOX(0:JZ,JY,JX),VOLWNG(0:JZ,JY,JX),VOLWN2(0:JZ,JY,JX) - 6,VOLWN3(0:JZ,JY,JX),VOLWNB(0:JZ,JY,JX),VOLWHG(0:JZ,JY,JX) - 7,H2GG2(JZ,JY,JX),H2GS2(0:JZ,JY,JX),H2GSH2(JZ,JY,JX) - 8,HGSGL2(JZ,JY,JX),DH2GG(3,JZ,JY,JX),RHGFXS(JZ,JY,JX) - 2,RHGFLZ(JZ,JY,JX),RHGFLG(3,JD,JV,JH),THGFLS(JZ,JY,JX) - 3,THGFHS(JZ,JY,JX),RHGDFG(0:JZ,JY,JX),FLQM(3,JD,JV,JH) - 4,RHGFHS(3,JD,JV,JH),THGFLG(JZ,JY,JX),FLVM(JZ,JY,JX) - 5,THETH2(JZ,JY,JX),THETHL(JZ,JY,JX),VOLPMA(JZ,JY,JX) - 6,VOLPMB(JZ,JY,JX),VOLWMA(JZ,JY,JX),VOLWMB(JZ,JY,JX) - 7,VOLWXA(0:JZ,JY,JX),VOLWXB(JZ,JY,JX),PARGCO(JY,JX) - 8,PARGCH(JY,JX),PARGOX(JY,JX),PARGNG(JY,JX) - 9,PARGN2(JY,JX),PARGN3(JY,JX),PARGH2(JY,JX) - DIMENSION ROCFL0(0:2,JY,JX),RONFL0(0:2,JY,JX),ROPFL0(0:2,JY,JX) - 2,ROAFL0(0:2,JY,JX),ROCFL1(0:2,JY,JX),RONFL1(0:2,JY,JX) - 3,ROPFL1(0:2,JY,JX),ROAFL1(0:2,JY,JX),RCOFL0(JY,JX),RCHFL0(JY,JX) - 4,ROXFL0(JY,JX),RNGFL0(JY,JX),RN2FL0(JY,JX),RHGFL0(JY,JX) - 5,RN4FL0(JY,JX),RN3FL0(JY,JX),RNOFL0(JY,JX),RNXFL0(JY,JX) - 6,RH2PF0(JY,JX),RCOFL1(JY,JX),RCHFL1(JY,JX),ROXFL1(JY,JX) - 7,RNGFL1(JY,JX),RN2FL1(JY,JX),RHGFL1(JY,JX),RN4FL1(JY,JX) - 8,RN3FL1(JY,JX),RNOFL1(JY,JX),RNXFL1(JY,JX),RH2PF1(JY,JX) - 9,RN4FL2(JY,JX),RN3FL2(JY,JX),RNOFL2(JY,JX),RNXFL2(JY,JX) - 1,RH2BF2(JY,JX) - DIMENSION VOLCOR(JY,JX),VOLCHR(JY,JX),VOLOXR(JY,JX),VOLNGR(JY,JX) - 2,VOLN2R(JY,JX),VOLN3R(JY,JX),VOLHGR(JY,JX),VOLCOT(JY,JX) - 3,VOLCHT(JY,JX),VOLOXT(JY,JX),VOLNGT(JY,JX),VOLN2T(JY,JX) - 4,VOLN3T(JY,JX),VOLNBT(JY,JX),VOLHGT(JY,JX) - PARAMETER(DPN4=5.7E-07,XFRX=0.5,XFRS=0.05) - REAL*4 CCO2SQ,CCH4SQ,COXYSQ,CZ2GSQ,CZ2OSQ,CNH3SQ - 2,CNH3BQ,CH2GSQ -C -C TIME STEPS FOR SOLUTE AND GAS FLUX CALCULATIONS -C - XNPX=1.0*XNPH - DO 9995 NX=NHW,NHE - DO 9990 NY=NVN,NVS -C -C GAS AND SOLUTE SINKS AND SOURCES IN SURFACE RESIDUE FROM MICROBIAL -C TRANSFORMATIONS IN 'NITRO' + ROOT EXCHANGE IN 'EXTRACT' -C + EQUILIBRIA REACTIONS IN 'SOLUTE' AT SUB-HOURLY TIME STEP -C - RCOSK2(0,NY,NX)=RCO2O(0,NY,NX)*XNPG - RCHSK2(0,NY,NX)=RCH4O(0,NY,NX)*XNPG - RNGSK2(0,NY,NX)=(RN2G(0,NY,NX)+XN2GS(0,NY,NX))*XNPG - 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 - 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 - ROASK2(K,0,NY,NX)=-XOQAS(K,0,NY,NX)*XNPH -14 CONTINUE - RN4SK2(0,NY,NX)=(-XNH4S(0,NY,NX)-TRN4S(0,NY,NX))*XNPH - RN3SK2(0,NY,NX)=-TRN3S(0,NY,NX)*XNPH - RNOSK2(0,NY,NX)=(-XNO3S(0,NY,NX)-TRNO3(0,NY,NX))*XNPH - RNXSK2(0,NY,NX)=(-XNO2S(0,NY,NX)-TRNO2(0,NY,NX))*XNPH - RHPSK2(0,NY,NX)=(-XH2PS(0,NY,NX)-TRH2P(0,NY,NX))*XNPH - CO2S2(0,NY,NX)=CO2S(0,NY,NX) - CH4S2(0,NY,NX)=CH4S(0,NY,NX) - OXYS2(0,NY,NX)=OXYS(0,NY,NX) - 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 - 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) - OQA2(K,0,NY,NX)=OQA(K,0,NY,NX)-XOQAS(K,0,NY,NX) -9979 CONTINUE - ZNH4S2(0,NY,NX)=ZNH4S(0,NY,NX) - ZN3S2(0,NY,NX)=ZNH3S(0,NY,NX) - ZNO3S2(0,NY,NX)=ZNO3S(0,NY,NX) - ZNO2S2(0,NY,NX)=ZNO2S(0,NY,NX) - H2PO42(0,NY,NX)=H2PO4(0,NY,NX) - CHY0(0,NY,NX)=10.0**(-(PH(0,NY,NX)-3.0)) -C -C SURFACE SOLUTE FLUXES FROM ATMOSPHERE -C - DO 8855 K=0,4 - IF(K.LE.2)THEN - XOCFLS(K,3,0,NY,NX)=0.0 - XONFLS(K,3,0,NY,NX)=0.0 - XOPFLS(K,3,0,NY,NX)=0.0 - XOAFLS(K,3,0,NY,NX)=0.0 - ENDIF - XOCFLS(K,3,NU(NY,NX),NY,NX)=0.0 - XONFLS(K,3,NU(NY,NX),NY,NX)=0.0 - XOPFLS(K,3,NU(NY,NX),NY,NX)=0.0 - XOAFLS(K,3,NU(NY,NX),NY,NX)=0.0 - XOCFHS(K,3,NU(NY,NX),NY,NX)=0.0 - XONFHS(K,3,NU(NY,NX),NY,NX)=0.0 - XOPFHS(K,3,NU(NY,NX),NY,NX)=0.0 - XOAFHS(K,3,NU(NY,NX),NY,NX)=0.0 -8855 CONTINUE -C -C HOURLY SOLUTE FLUXES FROM ATMOSPHERE TO SNOWPACK -C IN SNOWFALL AND IRRIGATION ACCORDING TO CONCENTRATIONS -C ENTERED IN WEATHER AND IRRIGATION FILES -C - IF(PRECW(NY,NX).GT.0.0.OR.(PRECR(NY,NX).GT.0.0 - 2.AND.VHCPW(NY,NX).GT.VHCPWX(NY,NX)))THEN - XCOBLS(NY,NX)=FLQGQ(NY,NX)*CCOR(NY,NX)+FLQGI(NY,NX)*CCOQ(NY,NX) - XCHBLS(NY,NX)=FLQGQ(NY,NX)*CCHR(NY,NX)+FLQGI(NY,NX)*CCHQ(NY,NX) - XOXBLS(NY,NX)=FLQGQ(NY,NX)*COXR(NY,NX)+FLQGI(NY,NX)*COXQ(NY,NX) - XNGBLS(NY,NX)=FLQGQ(NY,NX)*CNNR(NY,NX)+FLQGI(NY,NX)*CNNQ(NY,NX) - XN2BLS(NY,NX)=FLQGQ(NY,NX)*CN2R(NY,NX)+FLQGI(NY,NX)*CN2Q(NY,NX) - XHGBLS(NY,NX)=0.0 - XN4BLW(NY,NX)=(FLQGQ(NY,NX)*CN4R(NY,NX)+FLQGI(NY,NX) - 2*CN4Q(I,NY,NX))*14.0 - XN3BLW(NY,NX)=(FLQGQ(NY,NX)*CN3R(NY,NX)+FLQGI(NY,NX) - 2*CN3Q(I,NY,NX))*14.0 - XNOBLW(NY,NX)=(FLQGQ(NY,NX)*CNOR(NY,NX)+FLQGI(NY,NX) - 2*CNOQ(I,NY,NX))*14.0 - XH2PBS(NY,NX)=(FLQGQ(NY,NX)*CPOR(NY,NX)+FLQGI(NY,NX) - 2*CPOQ(I,NY,NX))*31.0 -C -C HOURLY SOLUTE FLUXES FROM ATMOSPHERE TO SOIL SURFACE -C IF RAINFALL AND IRRIGATION IS ZERO IF SNOWPACK IS PRESENT -C - XCOFLS(3,0,NY,NX)=0.0 - XCHFLS(3,0,NY,NX)=0.0 - XOXFLS(3,0,NY,NX)=0.0 - XNGFLS(3,0,NY,NX)=0.0 - XN2FLS(3,0,NY,NX)=0.0 - XHGFLS(3,0,NY,NX)=0.0 - XN4FLW(3,0,NY,NX)=0.0 - XN3FLW(3,0,NY,NX)=0.0 - XNOFLW(3,0,NY,NX)=0.0 - XNXFLS(3,0,NY,NX)=0.0 - XH2PFS(3,0,NY,NX)=0.0 - XCOFLS(3,NU(NY,NX),NY,NX)=0.0 - XCHFLS(3,NU(NY,NX),NY,NX)=0.0 - XOXFLS(3,NU(NY,NX),NY,NX)=0.0 - XNGFLS(3,NU(NY,NX),NY,NX)=0.0 - XN2FLS(3,NU(NY,NX),NY,NX)=0.0 - XHGFLS(3,NU(NY,NX),NY,NX)=0.0 - XN4FLW(3,NU(NY,NX),NY,NX)=0.0 - XN3FLW(3,NU(NY,NX),NY,NX)=0.0 - XNOFLW(3,NU(NY,NX),NY,NX)=0.0 - XNXFLS(3,NU(NY,NX),NY,NX)=0.0 - XH2PFS(3,NU(NY,NX),NY,NX)=0.0 - XN4FLB(3,NU(NY,NX),NY,NX)=0.0 - XN3FLB(3,NU(NY,NX),NY,NX)=0.0 - XNOFLB(3,NU(NY,NX),NY,NX)=0.0 - XNXFLB(3,NU(NY,NX),NY,NX)=0.0 - XH2BFB(3,NU(NY,NX),NY,NX)=0.0 -C -C HOURLY SOLUTE FLUXES FROM ATMOSPHERE TO SOIL SURFACE -C IN RAINFALL AND IRRIGATION ACCORDING TO CONCENTRATIONS -C ENTERED IN WEATHER AND IRRIGATION FILES -C - ELSEIF((PRECQ(NY,NX).GT.0.0.OR.PRECI(NY,NX).GT.0.0) - 2.AND.VHCPW(NY,NX).LE.VHCPWX(NY,NX))THEN -C -C HOURLY SOLUTE FLUXES FROM ATMOSPHERE TO SNOWPACK -C IF SNOWFALL AND IRRIGATION IS ZERO AND SNOWPACK IS ABSENT -C - XCOBLS(NY,NX)=0.0 - XCHBLS(NY,NX)=0.0 - XOXBLS(NY,NX)=0.0 - XNGBLS(NY,NX)=0.0 - XN2BLS(NY,NX)=0.0 - XHGBLS(NY,NX)=0.0 - XN4BLW(NY,NX)=0.0 - XN3BLW(NY,NX)=0.0 - XNOBLW(NY,NX)=0.0 - XH2PBS(NY,NX)=0.0 - XCOFLS(3,0,NY,NX)=FLQRQ(NY,NX)*CCOR(NY,NX) - 2+FLQRI(NY,NX)*CCOQ(NY,NX) - XCHFLS(3,0,NY,NX)=FLQRQ(NY,NX)*CCHR(NY,NX) - 2+FLQRI(NY,NX)*CCHQ(NY,NX) - XOXFLS(3,0,NY,NX)=FLQRQ(NY,NX)*COXR(NY,NX) - 2+FLQRI(NY,NX)*COXQ(NY,NX) - XNGFLS(3,0,NY,NX)=FLQRQ(NY,NX)*CNNR(NY,NX) - 2+FLQRI(NY,NX)*CNNQ(NY,NX) - XN2FLS(3,0,NY,NX)=FLQRQ(NY,NX)*CN2R(NY,NX) - 2+FLQRI(NY,NX)*CN2Q(NY,NX) - XHGFLS(3,0,NY,NX)=0.0 - XN4FLW(3,0,NY,NX)=(FLQRQ(NY,NX)*CN4R(NY,NX)+FLQRI(NY,NX) - 2*CN4Q(I,NY,NX))*14.0 - XN3FLW(3,0,NY,NX)=(FLQRQ(NY,NX)*CN3R(NY,NX)+FLQRI(NY,NX) - 2*CN3Q(I,NY,NX))*14.0 - XNOFLW(3,0,NY,NX)=(FLQRQ(NY,NX)*CNOR(NY,NX)+FLQRI(NY,NX) - 2*CNOQ(I,NY,NX))*14.0 - XNXFLS(3,0,NY,NX)=0.0 - XH2PFS(3,0,NY,NX)=(FLQRQ(NY,NX)*CPOR(NY,NX)+FLQRI(NY,NX) - 2*CPOQ(I,NY,NX))*31.0 - XCOFLS(3,NU(NY,NX),NY,NX)=FLQGQ(NY,NX)*CCOR(NY,NX) - 2+FLQGI(NY,NX)*CCOQ(NY,NX) - XCHFLS(3,NU(NY,NX),NY,NX)=FLQGQ(NY,NX)*CCHR(NY,NX) - 2+FLQGI(NY,NX)*CCHQ(NY,NX) - XOXFLS(3,NU(NY,NX),NY,NX)=FLQGQ(NY,NX)*COXR(NY,NX) - 2+FLQGI(NY,NX)*COXQ(NY,NX) - XNGFLS(3,NU(NY,NX),NY,NX)=FLQGQ(NY,NX)*CNNR(NY,NX) - 2+FLQGI(NY,NX)*CNNQ(NY,NX) - XN2FLS(3,NU(NY,NX),NY,NX)=FLQGQ(NY,NX)*CN2R(NY,NX) - 2+FLQGI(NY,NX)*CN2Q(NY,NX) - XHGFLS(3,NU(NY,NX),NY,NX)=0.0 - XN4FLW(3,NU(NY,NX),NY,NX)=((FLQGQ(NY,NX)*CN4R(NY,NX)+FLQGI(NY,NX) - 2*CN4Q(I,NY,NX))*14.0)*VLNH4(NU(NY,NX),NY,NX) - XN3FLW(3,NU(NY,NX),NY,NX)=((FLQGQ(NY,NX)*CN3R(NY,NX)+FLQGI(NY,NX) - 2*CN3Q(I,NY,NX))*14.0)*VLNH4(NU(NY,NX),NY,NX) - XNOFLW(3,NU(NY,NX),NY,NX)=((FLQGQ(NY,NX)*CNOR(NY,NX)+FLQGI(NY,NX) - 2*CNOQ(I,NY,NX))*14.0)*VLNO3(NU(NY,NX),NY,NX) - XNXFLS(3,NU(NY,NX),NY,NX)=0.0 - XH2PFS(3,NU(NY,NX),NY,NX)=((FLQGQ(NY,NX)*CPOR(NY,NX)+FLQGI(NY,NX) - 2*CPOQ(I,NY,NX))*31.0)*VLPO4(NU(NY,NX),NY,NX) - XN4FLB(3,NU(NY,NX),NY,NX)=((FLQGQ(NY,NX)*CN4R(NY,NX)+FLQGI(NY,NX) - 2*CN4Q(I,NY,NX))*14.0)*VLNHB(NU(NY,NX),NY,NX) - XN3FLB(3,NU(NY,NX),NY,NX)=((FLQGQ(NY,NX)*CN3R(NY,NX)+FLQGI(NY,NX) - 2*CN3Q(I,NY,NX))*14.0)*VLNHB(NU(NY,NX),NY,NX) - XNOFLB(3,NU(NY,NX),NY,NX)=((FLQGQ(NY,NX)*CNOR(NY,NX)+FLQGI(NY,NX) - 2*CNOQ(I,NY,NX))*14.0)*VLNOB(NU(NY,NX),NY,NX) - XNXFLB(3,NU(NY,NX),NY,NX)=0.0 - XH2BFB(3,NU(NY,NX),NY,NX)=((FLQGQ(NY,NX)*CPOR(NY,NX)+FLQGI(NY,NX) - 2*CPOQ(I,NY,NX))*31.0)*VLPOB(NU(NY,NX),NY,NX) -C -C NO SOLUTE FLUXES FROM ATMOSPHERE -C - ELSE - XCOBLS(NY,NX)=0.0 - XCHBLS(NY,NX)=0.0 - XOXBLS(NY,NX)=0.0 - XNGBLS(NY,NX)=0.0 - XN2BLS(NY,NX)=0.0 - XHGBLS(NY,NX)=0.0 - XN4BLW(NY,NX)=0.0 - XN3BLW(NY,NX)=0.0 - XNOBLW(NY,NX)=0.0 - XH2PBS(NY,NX)=0.0 - XCOFLS(3,0,NY,NX)=0.0 - XCHFLS(3,0,NY,NX)=0.0 - XOXFLS(3,0,NY,NX)=0.0 - XNGFLS(3,0,NY,NX)=0.0 - XN2FLS(3,0,NY,NX)=0.0 - XHGFLS(3,0,NY,NX)=0.0 - XN4FLW(3,0,NY,NX)=0.0 - XN3FLW(3,0,NY,NX)=0.0 - XNOFLW(3,0,NY,NX)=0.0 - XNXFLS(3,0,NY,NX)=0.0 - XH2PFS(3,0,NY,NX)=0.0 - XCOFLS(3,NU(NY,NX),NY,NX)=0.0 - XCHFLS(3,NU(NY,NX),NY,NX)=0.0 - XOXFLS(3,NU(NY,NX),NY,NX)=0.0 - XNGFLS(3,NU(NY,NX),NY,NX)=0.0 - XN2FLS(3,NU(NY,NX),NY,NX)=0.0 - XHGFLS(3,NU(NY,NX),NY,NX)=0.0 - XN4FLW(3,NU(NY,NX),NY,NX)=0.0 - XN3FLW(3,NU(NY,NX),NY,NX)=0.0 - XNOFLW(3,NU(NY,NX),NY,NX)=0.0 - XNXFLS(3,NU(NY,NX),NY,NX)=0.0 - XH2PFS(3,NU(NY,NX),NY,NX)=0.0 - XN4FLB(3,NU(NY,NX),NY,NX)=0.0 - XN3FLB(3,NU(NY,NX),NY,NX)=0.0 - XNOFLB(3,NU(NY,NX),NY,NX)=0.0 - XNXFLB(3,NU(NY,NX),NY,NX)=0.0 - XH2BFB(3,NU(NY,NX),NY,NX)=0.0 - ENDIF -C -C HOURLY SOLUTE FLUXES FROM MELTING SNOWPACK TO -C RESIDUE AND SOIL SURFACE FROM SNOWMELT IN 'WATSUB' AND -C CONCENTRATIONS IN SNOWPACK -C - FLQTM=FLQGM(NY,NX)+FLQRM(NY,NX) - IF(FLQTM.GT.ZEROS(NY,NX))THEN - VOLWW=VOLWS(NY,NX)+VOLSS(NY,NX)+VOLIS(NY,NX)*0.92 - IF(VOLWW.GT.ZEROS(NY,NX))THEN - VFLWW=AMAX1(0.0,AMIN1(1.0,FLQTM/VOLWW)) - ELSE - VFLWW=1.0 - ENDIF - VFLWG=VFLWW*FLQGM(NY,NX)/FLQTM - VFLWR=VFLWW*FLQRM(NY,NX)/FLQTM - XCOBLS(NY,NX)=XCOBLS(NY,NX)-CO2W(NY,NX)*VFLWW - XCHBLS(NY,NX)=XCHBLS(NY,NX)-CH4W(NY,NX)*VFLWW - XOXBLS(NY,NX)=XOXBLS(NY,NX)-OXYW(NY,NX)*VFLWW - XNGBLS(NY,NX)=XNGBLS(NY,NX)-ZNGW(NY,NX)*VFLWW - XN2BLS(NY,NX)=XN2BLS(NY,NX)-ZN2W(NY,NX)*VFLWW - XN4BLW(NY,NX)=XN4BLW(NY,NX)-ZN4W(NY,NX)*VFLWW - XN3BLW(NY,NX)=XN3BLW(NY,NX)-ZN3W(NY,NX)*VFLWW - XNOBLW(NY,NX)=XNOBLW(NY,NX)-ZNOW(NY,NX)*VFLWW - XH2PBS(NY,NX)=XH2PBS(NY,NX)-ZHPW(NY,NX)*VFLWW - XCOFLS(3,0,NY,NX)=XCOFLS(3,0,NY,NX)+CO2W(NY,NX)*VFLWR - XCHFLS(3,0,NY,NX)=XCHFLS(3,0,NY,NX)+CH4W(NY,NX)*VFLWR - XOXFLS(3,0,NY,NX)=XOXFLS(3,0,NY,NX)+OXYW(NY,NX)*VFLWR - XNGFLS(3,0,NY,NX)=XNGFLS(3,0,NY,NX)+ZNGW(NY,NX)*VFLWR - XN2FLS(3,0,NY,NX)=XN2FLS(3,0,NY,NX)+ZN2W(NY,NX)*VFLWR - XN4FLW(3,0,NY,NX)=XN4FLW(3,0,NY,NX)+ZN4W(NY,NX)*VFLWR - XN3FLW(3,0,NY,NX)=XN3FLW(3,0,NY,NX)+ZN3W(NY,NX)*VFLWR - XNOFLW(3,0,NY,NX)=XNOFLW(3,0,NY,NX)+ZNOW(NY,NX)*VFLWR - XH2PFS(3,0,NY,NX)=XH2PFS(3,0,NY,NX)+ZHPW(NY,NX)*VFLWR - XCOFLS(3,NU(NY,NX),NY,NX)=XCOFLS(3,NU(NY,NX),NY,NX) - 2+CO2W(NY,NX)*VFLWG - XCHFLS(3,NU(NY,NX),NY,NX)=XCHFLS(3,NU(NY,NX),NY,NX) - 2+CH4W(NY,NX)*VFLWG - XOXFLS(3,NU(NY,NX),NY,NX)=XOXFLS(3,NU(NY,NX),NY,NX) - 2+OXYW(NY,NX)*VFLWG - XNGFLS(3,NU(NY,NX),NY,NX)=XNGFLS(3,NU(NY,NX),NY,NX) - 2+ZNGW(NY,NX)*VFLWG - XN2FLS(3,NU(NY,NX),NY,NX)=XN2FLS(3,NU(NY,NX),NY,NX) - 2+ZN2W(NY,NX)*VFLWG - XN4FLW(3,NU(NY,NX),NY,NX)=XN4FLW(3,NU(NY,NX),NY,NX) - 2+ZN4W(NY,NX)*VFLWG*VLNH4(NU(NY,NX),NY,NX) - XN3FLW(3,NU(NY,NX),NY,NX)=XN3FLW(3,NU(NY,NX),NY,NX) - 2+ZN3W(NY,NX)*VFLWG*VLNH4(NU(NY,NX),NY,NX) - XNOFLW(3,NU(NY,NX),NY,NX)=XNOFLW(3,NU(NY,NX),NY,NX) - 2+ZNOW(NY,NX)*VFLWG*VLNO3(NU(NY,NX),NY,NX) - XH2PFS(3,NU(NY,NX),NY,NX)=XH2PFS(3,NU(NY,NX),NY,NX) - 2+ZHPW(NY,NX)*VFLWG*VLPO4(NU(NY,NX),NY,NX) - XN4FLB(3,NU(NY,NX),NY,NX)=XN4FLB(3,NU(NY,NX),NY,NX) - 2+ZN4W(NY,NX)*VFLWG*VLNHB(NU(NY,NX),NY,NX) - XN3FLB(3,NU(NY,NX),NY,NX)=XN3FLB(3,NU(NY,NX),NY,NX) - 2+ZN3W(NY,NX)*VFLWG*VLNHB(NU(NY,NX),NY,NX) - XNOFLB(3,NU(NY,NX),NY,NX)=XNOFLB(3,NU(NY,NX),NY,NX) - 2+ZNOW(NY,NX)*VFLWG*VLNOB(NU(NY,NX),NY,NX) - XH2BFB(3,NU(NY,NX),NY,NX)=XH2BFB(3,NU(NY,NX),NY,NX) - 2+ZHPW(NY,NX)*VFLWG*VLPOB(NU(NY,NX),NY,NX) - ENDIF - XCOFHS(3,NU(NY,NX),NY,NX)=0.0 - XCHFHS(3,NU(NY,NX),NY,NX)=0.0 - XOXFHS(3,NU(NY,NX),NY,NX)=0.0 - XNGFHS(3,NU(NY,NX),NY,NX)=0.0 - XN2FHS(3,NU(NY,NX),NY,NX)=0.0 - XHGFHS(3,NU(NY,NX),NY,NX)=0.0 - XN4FHW(3,NU(NY,NX),NY,NX)=0.0 - XN3FHW(3,NU(NY,NX),NY,NX)=0.0 - XNOFHW(3,NU(NY,NX),NY,NX)=0.0 - XH2PHS(3,NU(NY,NX),NY,NX)=0.0 - XN4FHB(3,NU(NY,NX),NY,NX)=0.0 - XN3FHB(3,NU(NY,NX),NY,NX)=0.0 - XNOFHB(3,NU(NY,NX),NY,NX)=0.0 - XNXFHB(3,NU(NY,NX),NY,NX)=0.0 - XH2BHB(3,NU(NY,NX),NY,NX)=0.0 - XNXFHS(3,NU(NY,NX),NY,NX)=0.0 - CO2W2(NY,NX)=CO2W(NY,NX)+XCOBLS(NY,NX) - CH4W2(NY,NX)=CH4W(NY,NX)+XCHBLS(NY,NX) - OXYW2(NY,NX)=OXYW(NY,NX)+XOXBLS(NY,NX) - ZNGW2(NY,NX)=ZNGW(NY,NX)+XNGBLS(NY,NX) - ZN2W2(NY,NX)=ZN2W(NY,NX)+XN2BLS(NY,NX) - ZN4W2(NY,NX)=ZN4W(NY,NX)+XN4BLW(NY,NX) - ZN3W2(NY,NX)=ZN3W(NY,NX)+XN3BLW(NY,NX) - ZNOW2(NY,NX)=ZNOW(NY,NX)+XNOBLW(NY,NX) - ZHPW2(NY,NX)=ZHPW(NY,NX)+XH2PBS(NY,NX) -C -C GAS AND SOLUTE FLUXES AT SUB-HOURLY FLUX TIME STEP -C ENTERED IN SITE FILE -C - DO 9845 K=0,2 - ROCFL0(K,NY,NX)=XOCFLS(K,3,0,NY,NX)*XNPH - RONFL0(K,NY,NX)=XONFLS(K,3,0,NY,NX)*XNPH - ROPFL0(K,NY,NX)=XOPFLS(K,3,0,NY,NX)*XNPH - ROAFL0(K,NY,NX)=XOAFLS(K,3,0,NY,NX)*XNPH - ROCFL1(K,NY,NX)=XOCFLS(K,3,NU(NY,NX),NY,NX)*XNPH - RONFL1(K,NY,NX)=XONFLS(K,3,NU(NY,NX),NY,NX)*XNPH - ROPFL1(K,NY,NX)=XOPFLS(K,3,NU(NY,NX),NY,NX)*XNPH - ROAFL1(K,NY,NX)=XOAFLS(K,3,NU(NY,NX),NY,NX)*XNPH -9845 CONTINUE - RCOFL0(NY,NX)=XCOFLS(3,0,NY,NX)*XNPH - RCHFL0(NY,NX)=XCHFLS(3,0,NY,NX)*XNPH - ROXFL0(NY,NX)=XOXFLS(3,0,NY,NX)*XNPH - RNGFL0(NY,NX)=XNGFLS(3,0,NY,NX)*XNPH - RN2FL0(NY,NX)=XN2FLS(3,0,NY,NX)*XNPH - RHGFL0(NY,NX)=XHGFLS(3,0,NY,NX)*XNPH - RN4FL0(NY,NX)=XN4FLW(3,0,NY,NX)*XNPH - RN3FL0(NY,NX)=XN3FLW(3,0,NY,NX)*XNPH - RNOFL0(NY,NX)=XNOFLW(3,0,NY,NX)*XNPH - RNXFL0(NY,NX)=XNXFLS(3,0,NY,NX)*XNPH - RH2PF0(NY,NX)=XH2PFS(3,0,NY,NX)*XNPH - RCOFL1(NY,NX)=XCOFLS(3,NU(NY,NX),NY,NX)*XNPH - RCHFL1(NY,NX)=XCHFLS(3,NU(NY,NX),NY,NX)*XNPH - ROXFL1(NY,NX)=XOXFLS(3,NU(NY,NX),NY,NX)*XNPH - RNGFL1(NY,NX)=XNGFLS(3,NU(NY,NX),NY,NX)*XNPH - RN2FL1(NY,NX)=XN2FLS(3,NU(NY,NX),NY,NX)*XNPH - RHGFL1(NY,NX)=XHGFLS(3,NU(NY,NX),NY,NX)*XNPH - RN4FL1(NY,NX)=XN4FLW(3,NU(NY,NX),NY,NX)*XNPH - RN3FL1(NY,NX)=XN3FLW(3,NU(NY,NX),NY,NX)*XNPH - RNOFL1(NY,NX)=XNOFLW(3,NU(NY,NX),NY,NX)*XNPH - RNXFL1(NY,NX)=XNXFLS(3,NU(NY,NX),NY,NX)*XNPH - RH2PF1(NY,NX)=XH2PFS(3,NU(NY,NX),NY,NX)*XNPH - RN4FL2(NY,NX)=XN4FLB(3,NU(NY,NX),NY,NX)*XNPH - RN3FL2(NY,NX)=XN3FLB(3,NU(NY,NX),NY,NX)*XNPH - RNOFL2(NY,NX)=XNOFLB(3,NU(NY,NX),NY,NX)*XNPH - RNXFL2(NY,NX)=XNXFLB(3,NU(NY,NX),NY,NX)*XNPH - RH2BF2(NY,NX)=XH2BFB(3,NU(NY,NX),NY,NX)*XNPH -C IF(I.EQ.118.AND.NX.EQ.3.AND.NY.EQ.4)THEN -C WRITE(*,6767)'ROXFL0',I,J,NX,NY,ROXFL0(NY,NX),XOXFLS(3,0,NY,NX) -C 2,OXYW(NY,NX),VFLWR -6767 FORMAT(A8,4I4,12E12.4) -C ENDIF -C -C GAS AND SOLUTE SINKS AND SOURCES IN SOIL LAYERS FROM MICROBIAL -C TRANSFORMATIONS IN 'NITRO' + ROOT EXCHANGE IN 'EXTRACT' -C + EQUILIBRIA REACTIONS IN 'SOLUTE' AT SUB-HOURLY TIME STEP -C - CLSGL2(0,NY,NX)=CLSGL(0,NY,NX)*XNPH - CQSGL2(0,NY,NX)=CQSGL(0,NY,NX)*XNPH - OLSGL2(0,NY,NX)=OLSGL(0,NY,NX)*XNPH - ZLSGL2(0,NY,NX)=ZLSGL(0,NY,NX)*XNPH - ZNSGL2(0,NY,NX)=ZNSGL(0,NY,NX)*XNPH - ZVSGL2(0,NY,NX)=ZVSGL(0,NY,NX)*XNPH - HLSGL2(0,NY,NX)=HLSGL(0,NY,NX)*XNPH - OCSGL2(0,NY,NX)=OCSGL(0,NY,NX)*XNPH - ONSGL2(0,NY,NX)=ONSGL(0,NY,NX)*XNPH - OPSGL2(0,NY,NX)=OPSGL(0,NY,NX)*XNPH - OASGL2(0,NY,NX)=OASGL(0,NY,NX)*XNPH - ZOSGL2(0,NY,NX)=ZOSGL(0,NY,NX)*XNPH - POSGL2(0,NY,NX)=POSGL(0,NY,NX)*XNPH - PARGM=PARG(NY,NX)*XNPT - PARGCO(NY,NX)=PARGM*0.74 - PARGCH(NY,NX)=PARGM*1.04 - PARGOX(NY,NX)=PARGM*0.83 - PARGNG(NY,NX)=PARGM*0.86 - PARGN2(NY,NX)=PARGM*0.74 - PARGN3(NY,NX)=PARGM*1.02 - PARGH2(NY,NX)=PARGM*2.08 - DO 10 L=NU(NY,NX),NL(NY,NX) - CHY0(L,NY,NX)=10.0**(-(PH(L,NY,NX)-3.0)) - FLWU(L,NY,NX)=TUPWTR(L,NY,NX)*XNPH - RCOSK2(L,NY,NX)=(RCO2O(L,NY,NX)+TCO2S(L,NY,NX)+TRCO2(L,NY,NX)) - 2*XNPG - RCHSK2(L,NY,NX)=(RCH4O(L,NY,NX)+TUPCHS(L,NY,NX))*XNPG - RNGSK2(L,NY,NX)=(RN2G(L,NY,NX)+XN2GS(L,NY,NX)+TUPNF(L,NY,NX)) - 2*XNPG - RN2SK2(L,NY,NX)=(RN2O(L,NY,NX)+TUPN2S(L,NY,NX))*XNPG - RNHSK2(L,NY,NX)=-TRN3G(L,NY,NX)*XNPG - RHGSK2(L,NY,NX)=(RH2GO(L,NY,NX)+TUPHGS(L,NY,NX))*XNPG - DO 15 K=0,4 - ROCSK2(K,L,NY,NX)=-XOQCS(K,L,NY,NX)*XNPH - RONSK2(K,L,NY,NX)=-XOQNS(K,L,NY,NX)*XNPH - ROPSK2(K,L,NY,NX)=-XOQPS(K,L,NY,NX)*XNPH - ROASK2(K,L,NY,NX)=-XOQAS(K,L,NY,NX)*XNPH -15 CONTINUE - RN4SK2(L,NY,NX)=(-XNH4S(L,NY,NX)-TRN4S(L,NY,NX) - 2+TUPNH4(L,NY,NX))*XNPH - RN3SK2(L,NY,NX)=(-TRN3S(L,NY,NX)+TUPN3S(L,NY,NX))*XNPH - RNOSK2(L,NY,NX)=(-XNO3S(L,NY,NX)-TRNO3(L,NY,NX) - 2+TUPNO3(L,NY,NX))*XNPH - RNXSK2(L,NY,NX)=(-XNO2S(L,NY,NX)-TRNO2(L,NY,NX))*XNPH - RHPSK2(L,NY,NX)=(-XH2PS(L,NY,NX)-TRH2P(L,NY,NX) - 2+TUPH2P(L,NY,NX))*XNPH - R4BSK2(L,NY,NX)=(-XNH4B(L,NY,NX)-TRN4B(L,NY,NX) - 2+TUPNHB(L,NY,NX))*XNPH - R3BSK2(L,NY,NX)=(-TRN3B(L,NY,NX)+TUPN3B(L,NY,NX))*XNPH - RNBSK2(L,NY,NX)=(-XNO3B(L,NY,NX)-TRNOB(L,NY,NX) - 2+TUPNOB(L,NY,NX))*XNPH - RNZSK2(L,NY,NX)=(-XNO2B(L,NY,NX)-TRN2B(L,NY,NX))*XNPH - RHBSK2(L,NY,NX)=(-XH2BS(L,NY,NX)-TRH2B(L,NY,NX) - 2+TUPH2B(L,NY,NX))*XNPH -C -C HOURLY SOLUTE FLUXES FROM SUBSURFACE IRRIGATION -C - RCOFLU(L,NY,NX)=FLU(L,NY,NX)*CCOQ(NY,NX) - RCHFLU(L,NY,NX)=FLU(L,NY,NX)*CCHQ(NY,NX) - ROXFLU(L,NY,NX)=FLU(L,NY,NX)*COXQ(NY,NX) - RNGFLU(L,NY,NX)=FLU(L,NY,NX)*CNNQ(NY,NX) - RN2FLU(L,NY,NX)=FLU(L,NY,NX)*CN2Q(NY,NX) - RHGFLU(L,NY,NX)=0.0 - RN4FLU(L,NY,NX)=FLU(L,NY,NX)*CN4Q(I,NY,NX)*VLNH4(L,NY,NX)*14.0 - RN3FLU(L,NY,NX)=FLU(L,NY,NX)*CN3Q(I,NY,NX)*VLNH4(L,NY,NX)*14.0 - RNOFLU(L,NY,NX)=FLU(L,NY,NX)*CNOQ(I,NY,NX)*VLNO3(L,NY,NX)*14.0 - RH2PFU(L,NY,NX)=FLU(L,NY,NX)*CPOQ(I,NY,NX)*VLPO4(L,NY,NX)*31.0 - RN4FBU(L,NY,NX)=FLU(L,NY,NX)*CN4Q(I,NY,NX)*VLNHB(L,NY,NX)*14.0 - RN3FBU(L,NY,NX)=FLU(L,NY,NX)*CN3Q(I,NY,NX)*VLNHB(L,NY,NX)*14.0 - RNOFBU(L,NY,NX)=FLU(L,NY,NX)*CNOQ(I,NY,NX)*VLNOB(L,NY,NX)*14.0 - RH2BBU(L,NY,NX)=FLU(L,NY,NX)*CPOQ(I,NY,NX)*VLPOB(L,NY,NX)*31.0 -C -C SUB-HOURLY SOLUTE FLUXES FROM SUBSURFACE IRRIGATION -C - RCOFLZ(L,NY,NX)=RCOFLU(L,NY,NX)*XNPH - RCHFLZ(L,NY,NX)=RCHFLU(L,NY,NX)*XNPH - ROXFLZ(L,NY,NX)=ROXFLU(L,NY,NX)*XNPH - RNGFLZ(L,NY,NX)=RNGFLU(L,NY,NX)*XNPH - RN2FLZ(L,NY,NX)=RN2FLU(L,NY,NX)*XNPH - RHGFLZ(L,NY,NX)=RHGFLU(L,NY,NX)*XNPH - RN4FLZ(L,NY,NX)=RN4FLU(L,NY,NX)*XNPH - RN3FLZ(L,NY,NX)=RN3FLU(L,NY,NX)*XNPH - RNOFLZ(L,NY,NX)=RNOFLU(L,NY,NX)*XNPH - RH2PFZ(L,NY,NX)=RH2PFU(L,NY,NX)*XNPH - RN4FBZ(L,NY,NX)=RN4FBU(L,NY,NX)*XNPH - RN3FBZ(L,NY,NX)=RN3FBU(L,NY,NX)*XNPH - RNOFBZ(L,NY,NX)=RNOFBU(L,NY,NX)*XNPH - RH2BBZ(L,NY,NX)=RH2BBU(L,NY,NX)*XNPH -C -C GAS AND SOLUTE DIFFUSIVITIES AT SUB-HOURLY TIME STEP -C - OCSGL2(L,NY,NX)=OCSGL(L,NY,NX)*XNPH - ONSGL2(L,NY,NX)=ONSGL(L,NY,NX)*XNPH - OPSGL2(L,NY,NX)=OPSGL(L,NY,NX)*XNPH - OASGL2(L,NY,NX)=OASGL(L,NY,NX)*XNPH - CLSGL2(L,NY,NX)=CLSGL(L,NY,NX)*XNPH - CQSGL2(L,NY,NX)=CQSGL(L,NY,NX)*XNPH - OLSGL2(L,NY,NX)=OLSGL(L,NY,NX)*XNPH - ZLSGL2(L,NY,NX)=ZLSGL(L,NY,NX)*XNPH - ZVSGL2(L,NY,NX)=ZVSGL(L,NY,NX)*XNPH - ZNSGL2(L,NY,NX)=ZNSGL(L,NY,NX)*XNPH - HLSGL2(L,NY,NX)=HLSGL(L,NY,NX)*XNPH - ZOSGL2(L,NY,NX)=ZOSGL(L,NY,NX)*XNPH - POSGL2(L,NY,NX)=POSGL(L,NY,NX)*XNPH - CGSGL2(L,NY,NX)=CGSGL(L,NY,NX)*XNPG - CHSGL2(L,NY,NX)=CHSGL(L,NY,NX)*XNPG - OGSGL2(L,NY,NX)=OGSGL(L,NY,NX)*XNPG - ZGSGL2(L,NY,NX)=ZGSGL(L,NY,NX)*XNPG - Z2SGL2(L,NY,NX)=Z2SGL(L,NY,NX)*XNPG - ZHSGL2(L,NY,NX)=ZHSGL(L,NY,NX)*XNPG - HGSGL2(L,NY,NX)=HGSGL(L,NY,NX)*XNPG -C -C STATE VARIABLES FOR GASES AND SOLUTES USED IN 'TRNSFR' -C TO STORE SUB-HOURLY CHANGES DURING FLUX CALCULATIONS -C INCLUDING TRANSFORMATIONS FROM 'NITRO', 'UPTAKE' AND 'SOLUTE' -C - CO2G2(L,NY,NX)=CO2G(L,NY,NX) - CH4G2(L,NY,NX)=CH4G(L,NY,NX) - OXYG2(L,NY,NX)=OXYG(L,NY,NX) - ZN3G2(L,NY,NX)=ZNH3G(L,NY,NX) - Z2GG2(L,NY,NX)=Z2GG(L,NY,NX) - Z2OG2(L,NY,NX)=Z2OG(L,NY,NX) - H2GG2(L,NY,NX)=H2GG(L,NY,NX) - CO2S2(L,NY,NX)=CO2S(L,NY,NX) - CH4S2(L,NY,NX)=CH4S(L,NY,NX) - OXYS2(L,NY,NX)=OXYS(L,NY,NX) - Z2GS2(L,NY,NX)=Z2GS(L,NY,NX) - Z2OS2(L,NY,NX)=Z2OS(L,NY,NX) - H2GS2(L,NY,NX)=H2GS(L,NY,NX) - DO 9980 K=0,4 - OQC2(K,L,NY,NX)=OQC(K,L,NY,NX)-XOQCS(K,L,NY,NX) - OQN2(K,L,NY,NX)=OQN(K,L,NY,NX)-XOQNS(K,L,NY,NX) - OQP2(K,L,NY,NX)=OQP(K,L,NY,NX)-XOQPS(K,L,NY,NX) - OQA2(K,L,NY,NX)=OQA(K,L,NY,NX)-XOQAS(K,L,NY,NX) - OQCH2(K,L,NY,NX)=OQCH(K,L,NY,NX) - OQNH2(K,L,NY,NX)=OQNH(K,L,NY,NX) - OQPH2(K,L,NY,NX)=OQPH(K,L,NY,NX) - OQAH2(K,L,NY,NX)=OQAH(K,L,NY,NX) -9980 CONTINUE - ZNH4S2(L,NY,NX)=ZNH4S(L,NY,NX) - ZN3S2(L,NY,NX)=ZNH3S(L,NY,NX) - ZNO3S2(L,NY,NX)=ZNO3S(L,NY,NX) - ZNO2S2(L,NY,NX)=ZNO2S(L,NY,NX) - H2PO42(L,NY,NX)=H2PO4(L,NY,NX) - ZNH4B2(L,NY,NX)=ZNH4B(L,NY,NX) - ZNBS2(L,NY,NX)=ZNH3B(L,NY,NX) - ZNO3B2(L,NY,NX)=ZNO3B(L,NY,NX) - ZNO2B2(L,NY,NX)=ZNO2B(L,NY,NX) - H2POB2(L,NY,NX)=H2POB(L,NY,NX) - CO2SH2(L,NY,NX)=CO2SH(L,NY,NX) - CH4SH2(L,NY,NX)=CH4SH(L,NY,NX) - OXYSH2(L,NY,NX)=OXYSH(L,NY,NX) - Z2GSH2(L,NY,NX)=Z2GSH(L,NY,NX) - Z2OSH2(L,NY,NX)=Z2OSH(L,NY,NX) - H2GSH2(L,NY,NX)=H2GSH(L,NY,NX) - ZNH4H2(L,NY,NX)=ZNH4SH(L,NY,NX) - ZNH3H2(L,NY,NX)=ZNH3SH(L,NY,NX) - ZNO3H2(L,NY,NX)=ZNO3SH(L,NY,NX) - ZNO2H2(L,NY,NX)=ZNO2SH(L,NY,NX) - H2P4H2(L,NY,NX)=H2PO4H(L,NY,NX) - ZN4BH2(L,NY,NX)=ZNH4BH(L,NY,NX) - ZN3BH2(L,NY,NX)=ZNH3BH(L,NY,NX) - ZNOBH2(L,NY,NX)=ZNO3BH(L,NY,NX) - ZN2BH2(L,NY,NX)=ZNO2BH(L,NY,NX) - H2PBH2(L,NY,NX)=H2POBH(L,NY,NX) -C IF(CDPTH(L,NY,NX).LT.DPNH4(NY,NX).AND.ROWN(NY,NX).GT.0.0)THEN -C VLNHB(L,NY,NX)=WDNHB(L,NY,NX)/ROWN(NY,NX) -C ELSE -C VLNHB(L,NY,NX)=0.0 -C ENDIF -C VLNH4(L,NY,NX)=1.0-VLNHB(L,NY,NX) -C IF(CDPTH(L-1,NY,NX).LT.DPNO3(NY,NX).AND.ROWO(NY,NX).GT.0.0)THEN -C VLNOB(L,NY,NX)=WDNOB(L,NY,NX)/ROWO(NY,NX) -C ELSE -C VLNOB(L,NY,NX)=0.0 -C ENDIF -C VLNO3(L,NY,NX)=1.0-VLNOB(L,NY,NX) -C IF(CDPTH(L,NY,NX).LT.DPPO4(NY,NX).AND.ROWP(NY,NX).GT.0.0)THEN -C VLPOB(L,NY,NX)=WDPOB(L,NY,NX)/ROWP(NY,NX) -C ELSE -C VLPOB(L,NY,NX)=0.0 -C ENDIF -C VLPO4(L,NY,NX)=1.0-VLPOB(L,NY,NX) -10 CONTINUE -9990 CONTINUE - -9995 CONTINUE -C -C TIME STEP USED IN GAS AND SOLUTE FLUX CALCULATIONS -C - MX=0 - DO 30 MM=1,NPG - M=MIN(NPH,INT((MM-1)*XNPT)+1) - DO 9895 NX=NHW,NHE - DO 9890 NY=NVN,NVS - IF(M.NE.MX)THEN -C -C RESET RUNOFF SOLUTE FLUX ACCUMULATORS -C - DO 9880 K=0,2 - TQROC(K,NY,NX)=0.0 - TQRON(K,NY,NX)=0.0 - TQROP(K,NY,NX)=0.0 - TQROA(K,NY,NX)=0.0 - OQC2(K,0,NY,NX)=OQC2(K,0,NY,NX)-ROCSK2(K,0,NY,NX) - OQN2(K,0,NY,NX)=OQN2(K,0,NY,NX)-RONSK2(K,0,NY,NX) - OQP2(K,0,NY,NX)=OQP2(K,0,NY,NX)-ROPSK2(K,0,NY,NX) - OQA2(K,0,NY,NX)=OQA2(K,0,NY,NX)-ROASK2(K,0,NY,NX) -9880 CONTINUE - TQRCOS(NY,NX)=0.0 - TQRCHS(NY,NX)=0.0 - TQROXS(NY,NX)=0.0 - TQRNGS(NY,NX)=0.0 - TQRN2S(NY,NX)=0.0 - TQRHGS(NY,NX)=0.0 - TQRNH4(NY,NX)=0.0 - TQRNH3(NY,NX)=0.0 - TQRNO3(NY,NX)=0.0 - TQRNO2(NY,NX)=0.0 - TQRH2P(NY,NX)=0.0 - TQSCOS(NY,NX)=0.0 - TQSCHS(NY,NX)=0.0 - TQSOXS(NY,NX)=0.0 - TQSNGS(NY,NX)=0.0 - TQSN2S(NY,NX)=0.0 - TQSNH4(NY,NX)=0.0 - TQSNH3(NY,NX)=0.0 - TQSNO3(NY,NX)=0.0 - TQSH2P(NY,NX)=0.0 - ZNH4S2(0,NY,NX)=ZNH4S2(0,NY,NX)-RN4SK2(0,NY,NX) - ZN3S2(0,NY,NX)=ZN3S2(0,NY,NX)-RN3SK2(0,NY,NX) - ZNO3S2(0,NY,NX)=ZNO3S2(0,NY,NX)-RNOSK2(0,NY,NX) - ZNO2S2(0,NY,NX)=ZNO2S2(0,NY,NX)-RNXSK2(0,NY,NX) - H2PO42(0,NY,NX)=H2PO42(0,NY,NX)-RHPSK2(0,NY,NX) - ROXSK2(0,NY,NX)=ROXSK(M,0,NY,NX)*XNPT - ENDIF - CO2S2(0,NY,NX)=CO2S2(0,NY,NX)-RCOSK2(0,NY,NX) - CH4S2(0,NY,NX)=CH4S2(0,NY,NX)-RCHSK2(0,NY,NX) - OXYS2(0,NY,NX)=OXYS2(0,NY,NX)-ROXSK2(0,NY,NX) - Z2GS2(0,NY,NX)=Z2GS2(0,NY,NX)-RNGSK2(0,NY,NX) - Z2OS2(0,NY,NX)=Z2OS2(0,NY,NX)-RN2SK2(0,NY,NX) - H2GS2(0,NY,NX)=H2GS2(0,NY,NX)-RHGSK2(0,NY,NX) - ZN3G2(0,NY,NX)=ZN3G2(0,NY,NX)-RNHSK2(0,NY,NX) -C -C RESET SOIL SOLUTE FLUX ACCUMULATORS -C - DO 9885 L=NU(NY,NX),NL(NY,NX) - IF(M.NE.MX)THEN - DO 9875 K=0,4 - TOCFLS(K,L,NY,NX)=0.0 - TONFLS(K,L,NY,NX)=0.0 - TOPFLS(K,L,NY,NX)=0.0 - TOAFLS(K,L,NY,NX)=0.0 - TOCFHS(K,L,NY,NX)=0.0 - TONFHS(K,L,NY,NX)=0.0 - TOPFHS(K,L,NY,NX)=0.0 - TOAFHS(K,L,NY,NX)=0.0 - OQC2(K,L,NY,NX)=OQC2(K,L,NY,NX)-ROCSK2(K,L,NY,NX) - OQN2(K,L,NY,NX)=OQN2(K,L,NY,NX)-RONSK2(K,L,NY,NX) - OQP2(K,L,NY,NX)=OQP2(K,L,NY,NX)-ROPSK2(K,L,NY,NX) - OQA2(K,L,NY,NX)=OQA2(K,L,NY,NX)-ROASK2(K,L,NY,NX) -9875 CONTINUE - TCOFLS(L,NY,NX)=0.0 - TCHFLS(L,NY,NX)=0.0 - TOXFLS(L,NY,NX)=0.0 - TNGFLS(L,NY,NX)=0.0 - TN2FLS(L,NY,NX)=0.0 - THGFLS(L,NY,NX)=0.0 - TN4FLW(L,NY,NX)=0.0 - TN3FLW(L,NY,NX)=0.0 - TNOFLW(L,NY,NX)=0.0 - TNXFLS(L,NY,NX)=0.0 - TH2PFS(L,NY,NX)=0.0 - TN4FLB(L,NY,NX)=0.0 - TN3FLB(L,NY,NX)=0.0 - TNOFLB(L,NY,NX)=0.0 - TNXFLB(L,NY,NX)=0.0 - TH2BFB(L,NY,NX)=0.0 - TCOFHS(L,NY,NX)=0.0 - TCHFHS(L,NY,NX)=0.0 - TOXFHS(L,NY,NX)=0.0 - TNGFHS(L,NY,NX)=0.0 - TN2FHS(L,NY,NX)=0.0 - THGFHS(L,NY,NX)=0.0 - TN4FHW(L,NY,NX)=0.0 - TN3FHW(L,NY,NX)=0.0 - TNOFHW(L,NY,NX)=0.0 - TNXFHS(L,NY,NX)=0.0 - TH2PHS(L,NY,NX)=0.0 - TN4FHB(L,NY,NX)=0.0 - TN3FHB(L,NY,NX)=0.0 - TNOFHB(L,NY,NX)=0.0 - TNXFHB(L,NY,NX)=0.0 - TH2BHB(L,NY,NX)=0.0 - ZNH4S2(L,NY,NX)=ZNH4S2(L,NY,NX)-RN4SK2(L,NY,NX) - ZN3S2(L,NY,NX)=ZN3S2(L,NY,NX)-RN3SK2(L,NY,NX) - ZNO3S2(L,NY,NX)=ZNO3S2(L,NY,NX)-RNOSK2(L,NY,NX) - ZNO2S2(L,NY,NX)=ZNO2S2(L,NY,NX)-RNXSK2(L,NY,NX) - H2PO42(L,NY,NX)=H2PO42(L,NY,NX)-RHPSK2(L,NY,NX) - ZNH4B2(L,NY,NX)=ZNH4B2(L,NY,NX)-R4BSK2(L,NY,NX) - ZNBS2(L,NY,NX)=ZNBS2(L,NY,NX)-R3BSK2(L,NY,NX) - ZNO3B2(L,NY,NX)=ZNO3B2(L,NY,NX)-RNBSK2(L,NY,NX) - ZNO2B2(L,NY,NX)=ZNO2B2(L,NY,NX)-RNZSK2(L,NY,NX) - H2POB2(L,NY,NX)=H2POB2(L,NY,NX)-RHBSK2(L,NY,NX) - ROXSK2(L,NY,NX)=ROXSK(M,L,NY,NX)*XNPT - ENDIF -C -C SOIL GAS FLUX ACCUMULATORS -C - TCOFLG(L,NY,NX)=0.0 - TCHFLG(L,NY,NX)=0.0 - TOXFLG(L,NY,NX)=0.0 - TNGFLG(L,NY,NX)=0.0 - TN2FLG(L,NY,NX)=0.0 - TN3FLG(L,NY,NX)=0.0 - THGFLG(L,NY,NX)=0.0 - CO2S2(L,NY,NX)=CO2S2(L,NY,NX)-RCOSK2(L,NY,NX) - CH4S2(L,NY,NX)=CH4S2(L,NY,NX)-RCHSK2(L,NY,NX) - OXYS2(L,NY,NX)=OXYS2(L,NY,NX)-ROXSK2(L,NY,NX) - Z2GS2(L,NY,NX)=Z2GS2(L,NY,NX)-RNGSK2(L,NY,NX) - 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) -9885 CONTINUE -C -C SOLUTE FLUXES AT SOIL SURFACE FROM SURFACE WATER -C CONTENTS, WATER FLUXES 'FLQM' AND ATMOSPHERE BOUNDARY -C LAYER RESISTANCES 'PARGM' FROM 'WATSUB' -C - IF(M.NE.MX)THEN - VOLWMA(NU(NY,NX),NY,NX)=VOLWM(M,NU(NY,NX),NY,NX) - 2*VLNH4(NU(NY,NX),NY,NX) - VOLWMB(NU(NY,NX),NY,NX)=VOLWM(M,NU(NY,NX),NY,NX) - 2*VLNHB(NU(NY,NX),NY,NX) - VOLWXA(NU(NY,NX),NY,NX)=14.0*VOLWMA(NU(NY,NX),NY,NX) - VOLWXB(NU(NY,NX),NY,NX)=14.0*VOLWMB(NU(NY,NX),NY,NX) - VOLWOA=VOLWM(M,NU(NY,NX),NY,NX)*VLNO3(NU(NY,NX),NY,NX) - VOLWOB=VOLWM(M,NU(NY,NX),NY,NX)*VLNOB(NU(NY,NX),NY,NX) - VOLWPA=VOLWM(M,NU(NY,NX),NY,NX)*VLPO4(NU(NY,NX),NY,NX) - VOLWPB=VOLWM(M,NU(NY,NX),NY,NX)*VLPOB(NU(NY,NX),NY,NX) - VOLPMA(NU(NY,NX),NY,NX)=VOLPM(M,NU(NY,NX),NY,NX) - 2*VLNH4(NU(NY,NX),NY,NX) - VOLPMB(NU(NY,NX),NY,NX)=VOLPM(M,NU(NY,NX),NY,NX) - 2*VLNHB(NU(NY,NX),NY,NX) - THETW1(NU(NY,NX),NY,NX)=AMAX1(0.0,VOLWM(M,NU(NY,NX),NY,NX) - 2/VOLX(NU(NY,NX),NY,NX)) - FLVM(NU(NY,NX),NY,NX)=FLPM(M,NU(NY,NX),NY,NX)*XNPT - FLQM(3,NU(NY,NX),NY,NX)=(FLWM(M,3,NU(NY,NX),NY,NX) - 2+FLWHM(M,3,NU(NY,NX),NY,NX))*XNPT -C -C SURFACE EXCHANGE OF AQUEOUS CO2, CH4, O2, N2, NH3 -C THROUGH VOLATILIZATION-DISSOLUTION FROM AQUEOUS -C DIFFUSIVITIES IN SURFACE RESIDUE -C - IF(VOLWM(M,0,NY,NX).GT.ZEROS(NY,NX))THEN - 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) - VOLWNG(0,NY,NX)=VOLWM(M,0,NY,NX)*SN2GL(0,NY,NX) - VOLWN2(0,NY,NX)=VOLWM(M,0,NY,NX)*SN2OL(0,NY,NX) - VOLWN3(0,NY,NX)=VOLWM(M,0,NY,NX)*SNH3L(0,NY,NX) - VOLWHG(0,NY,NX)=VOLWM(M,0,NY,NX)*SH2GL(0,NY,NX) - VOLWXA(0,NY,NX)=14.0*VOLWM(M,0,NY,NX) - DPTH0=0.5*VOLWM(M,0,NY,NX)/AREA(3,0,NY,NX) - DFGSCO=CLSGL2(0,NY,NX)/DPTH0 - DFGSCH=CQSGL2(0,NY,NX)/DPTH0 - DFGSOX=OLSGL2(0,NY,NX)/DPTH0 - DFGSNG=ZLSGL2(0,NY,NX)/DPTH0 - DFGSN2=ZNSGL2(0,NY,NX)/DPTH0 - DFGSN3=ZVSGL2(0,NY,NX)/DPTH0 - DFGSHL=HLSGL2(0,NY,NX)/DPTH0 - CO2S2X=AMAX1(0.0,CO2S2(0,NY,NX)) - CH4S2X=AMAX1(0.0,CH4S2(0,NY,NX)) - OXYS2X=AMAX1(0.0,OXYS2(0,NY,NX)) - Z2GS2X=AMAX1(0.0,Z2GS2(0,NY,NX)) - Z2OS2X=AMAX1(0.0,Z2OS2(0,NY,NX)) - ZN3S2X=AMAX1(0.0,ZN3S2(0,NY,NX)) - H2GS2X=AMAX1(0.0,H2GS2(0,NY,NX)) -C -C EQUILIBRIUM CONCENTRATIONS AT RESIDUE SURFACE AT WHICH -C AQUEOUS DIFFUSION THROUGH RESIDUE SURFACE LAYER = GASEOUS -C DIFFUSION THROUGH ATMOSPHERE BOUNDARY LAYER CALCULATED -C FROM AQUEOUS DIFFUSIVITY AND BOUNDARY LAYER CONDUCTANCE -C - CO2GQ=(PARR(NY,NX)*CCO2E(NY,NX)*VOLWCO(0,NY,NX)+DFGSCO - 2*CO2S2X)/(DFGSCO+PARR(NY,NX)) - CH4GQ=(PARR(NY,NX)*CCH4E(NY,NX)*VOLWCH(0,NY,NX)+DFGSCH - 2*CH4S2X)/(DFGSCH+PARR(NY,NX)) - OXYGQ=(PARR(NY,NX)*COXYE(NY,NX)*VOLWOX(0,NY,NX)+DFGSOX - 2*OXYS2X)/(DFGSOX+PARR(NY,NX)) - Z2GGQ=(PARR(NY,NX)*CZ2GE(NY,NX)*VOLWNG(0,NY,NX)+DFGSNG - 2*Z2GS2X)/(DFGSNG+PARR(NY,NX)) - Z2OGQ=(PARR(NY,NX)*CZ2OE(NY,NX)*VOLWN2(0,NY,NX)+DFGSN2 - 2*Z2OS2X)/(DFGSN2+PARR(NY,NX)) - ZN3GQ=(PARR(NY,NX)*CNH3E(NY,NX)*VOLWN3(0,NY,NX)+DFGSN3 - 2*ZN3S2X)/(DFGSN3+PARR(NY,NX)) - H2GGQ=(PARR(NY,NX)*CH2GE(NY,NX)*VOLWHG(0,NY,NX)+DFGSHL - 2*H2GS2X)/(DFGSHL+PARR(NY,NX)) -C -C SURFACE VOLATILIZATION-DISSOLUTION FROM DIFFERENCES -C BETWEEN ATMOSPHERIC AND RESIDUE SURFACE EQUILIBRIUM -C CONCENTRATIONS -C - RCODFR(NY,NX)=CO2GQ-CO2S2X - RCHDFR(NY,NX)=CH4GQ-CH4S2X - ROXDFR(NY,NX)=OXYGQ-OXYS2X - RNGDFR(NY,NX)=Z2GGQ-Z2GS2X - RN2DFR(NY,NX)=Z2OGQ-Z2OS2X - RN3DFR(NY,NX)=ZN3GQ-ZN3S2X - RHGDFR(NY,NX)=H2GGQ-H2GS2X -C IF(I.EQ.87)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) -C 4,DLYR(3,0,NY,NX),VOLWM(M,0,NY,NX) -C WRITE(*,1118)'RCHDFR',I,J,NX,NY,M,MM,RCHDFR(NY,NX) -C 2,CH4GQ,CH4S2(0,NY,NX),PARR(NY,NX),CCH4E(NY,NX) -C 3,VOLWCH(0,NY,NX),DFGSCH,DPTH0 -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,DPTH0 -1118 FORMAT(A8,6I4,20E12.4) -C ENDIF -C -C ACCUMULATE HOURLY FLUXES -C - XCODFR(NY,NX)=XCODFR(NY,NX)+RCODFR(NY,NX) - XCHDFR(NY,NX)=XCHDFR(NY,NX)+RCHDFR(NY,NX) - XOXDFR(NY,NX)=XOXDFR(NY,NX)+ROXDFR(NY,NX) - XNGDFR(NY,NX)=XNGDFR(NY,NX)+RNGDFR(NY,NX) - 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) - ELSE - RCODFR(NY,NX)=0.0 - RCHDFR(NY,NX)=0.0 - ROXDFR(NY,NX)=0.0 - RNGDFR(NY,NX)=0.0 - RN2DFR(NY,NX)=0.0 - RN3DFR(NY,NX)=0.0 - RHGDFR(NY,NX)=0.0 - ENDIF - RCODXR=RCODFR(NY,NX)*XNPT - RCHDXR=RCHDFR(NY,NX)*XNPT - ROXDXR=ROXDFR(NY,NX)*XNPT - RNGDXR=RNGDFR(NY,NX)*XNPT - RN2DXR=RN2DFR(NY,NX)*XNPT - RN3DXR=RN3DFR(NY,NX)*XNPT - RHGDXR=RHGDFR(NY,NX)*XNPT -C -C SURFACE EXCHANGE OF AQUEOUS CO2, CH4, O2, N2, NH3 -C THROUGH VOLATILIZATION-DISSOLUTION FROM AQUEOUS -C DIFFUSIVITIES IN SURFACE SOIL LAYER -C - IF(VOLWM(M,NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN - VOLWCO(NU(NY,NX),NY,NX)=VOLWM(M,NU(NY,NX),NY,NX) - 2*SCO2L(NU(NY,NX),NY,NX) - VOLWCH(NU(NY,NX),NY,NX)=VOLWM(M,NU(NY,NX),NY,NX) - 2*SCH4L(NU(NY,NX),NY,NX) - VOLWOX(NU(NY,NX),NY,NX)=VOLWM(M,NU(NY,NX),NY,NX) - 2*SOXYL(NU(NY,NX),NY,NX) - VOLWNG(NU(NY,NX),NY,NX)=VOLWM(M,NU(NY,NX),NY,NX) - 2*SN2GL(NU(NY,NX),NY,NX) - VOLWN2(NU(NY,NX),NY,NX)=VOLWM(M,NU(NY,NX),NY,NX) - 2*SN2OL(NU(NY,NX),NY,NX) - VOLWN3(NU(NY,NX),NY,NX)=VOLWMA(NU(NY,NX),NY,NX) - 2*SNH3L(NU(NY,NX),NY,NX) - VOLWNB(NU(NY,NX),NY,NX)=VOLWMB(NU(NY,NX),NY,NX) - 2*SNH3L(NU(NY,NX),NY,NX) - VOLWHG(NU(NY,NX),NY,NX)=VOLWM(M,NU(NY,NX),NY,NX) - 2*SH2GL(NU(NY,NX),NY,NX) - DPTH1=0.5*VOLWM(M,NU(NY,NX),NY,NX)/AREA(3,NU(NY,NX),NY,NX) - DFGSCO=CLSGL2(NU(NY,NX),NY,NX)/DPTH1 - DFGSCH=CQSGL2(NU(NY,NX),NY,NX)/DPTH1 - DFGSOX=OLSGL2(NU(NY,NX),NY,NX)/DPTH1 - DFGSNG=ZLSGL2(NU(NY,NX),NY,NX)/DPTH1 - DFGSN2=ZNSGL2(NU(NY,NX),NY,NX)/DPTH1 - DFGSN3=ZVSGL2(NU(NY,NX),NY,NX)/DPTH1 - DFGSHL=HLSGL2(NU(NY,NX),NY,NX)/DPTH1 - CO2S2X=AMAX1(0.0,CO2S2(NU(NY,NX),NY,NX)) - CH4S2X=AMAX1(0.0,CH4S2(NU(NY,NX),NY,NX)) - OXYS2X=AMAX1(0.0,OXYS2(NU(NY,NX),NY,NX)) - Z2GS2X=AMAX1(0.0,Z2GS2(NU(NY,NX),NY,NX)) - Z2OS2X=AMAX1(0.0,Z2OS2(NU(NY,NX),NY,NX)) - ZN3S2X=AMAX1(0.0,ZN3S2(NU(NY,NX),NY,NX)) - ZNBS2X=AMAX1(0.0,ZNBS2(NU(NY,NX),NY,NX)) - H2GS2X=AMAX1(0.0,H2GS2(NU(NY,NX),NY,NX)) -C -C EQUILIBRIUM CONCENTRATIONS AT SOIL SURFACE AT WHICH -C AQUEOUS DIFFUSION THROUGH SOIL SURFACE LAYER = GASEOUS -C DIFFUSION THROUGH ATMOSPHERE BOUNDARY LAYER CALCULATED -C FROM AQUEOUS DIFFUSIVITY AND BOUNDARY LAYER CONDUCTANCE -C - CO2GQ=(PARG(NY,NX)*CCO2E(NY,NX)*VOLWCO(NU(NY,NX),NY,NX) - 2+DFGSCO*CO2S2X)/(DFGSCO+PARG(NY,NX)) - CH4GQ=(PARG(NY,NX)*CCH4E(NY,NX)*VOLWCH(NU(NY,NX),NY,NX) - 2+DFGSCH*CH4S2X)/(DFGSCH+PARG(NY,NX)) - OXYGQ=(PARG(NY,NX)*COXYE(NY,NX)*VOLWOX(NU(NY,NX),NY,NX) - 2+DFGSOX*OXYS2X)/(DFGSOX+PARG(NY,NX)) - Z2GGQ=(PARG(NY,NX)*CZ2GE(NY,NX)*VOLWNG(NU(NY,NX),NY,NX) - 2+DFGSNG*Z2GS2X)/(DFGSNG+PARG(NY,NX)) - Z2OGQ=(PARG(NY,NX)*CZ2OE(NY,NX)*VOLWN2(NU(NY,NX),NY,NX) - 2+DFGSN2*Z2OS2X)/(DFGSN2+PARG(NY,NX)) - ZN3GQ=(PARG(NY,NX)*CNH3E(NY,NX)*VOLWN3(NU(NY,NX),NY,NX) - 2+DFGSN3*ZN3S2X)/(DFGSN3+PARG(NY,NX)) - ZNBGQ=(PARG(NY,NX)*CNH3E(NY,NX)*VOLWNB(NU(NY,NX),NY,NX) - 2+DFGSN3*ZNBS2X)/(DFGSN3+PARG(NY,NX)) - H2GGQ=(PARG(NY,NX)*CH2GE(NY,NX)*VOLWHG(NU(NY,NX),NY,NX) - 2+DFGSHL*H2GS2X)/(DFGSHL+PARG(NY,NX)) -C -C SURFACE VOLATILIZATION-DISSOLUTION FROM DIFFERENCES -C BETWEEN ATMOSPHERIC AND SOIL SURFACE EQUILIBRIUM -C CONCENTRATIONS -C - RCODFS(NY,NX)=CO2GQ-CO2S2X - RCHDFS(NY,NX)=CH4GQ-CH4S2X - ROXDFS(NY,NX)=OXYGQ-OXYS2X - RNGDFS(NY,NX)=Z2GGQ-Z2GS2X - RN2DFS(NY,NX)=Z2OGQ-Z2OS2X - RN3DFS(NY,NX)=ZN3GQ-ZN3S2X - RNBDFS(NY,NX)=ZNBGQ-ZNBS2X - RHGDFS(NY,NX)=H2GGQ-H2GS2X -C IF(I.EQ.87)THEN -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 3,CCH4E(NY,NX),VOLWCH(NU(NY,NX),NY,NX),DFGSCH,DPTH1 -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 3,COXYE(NY,NX),VOLWOX(NU(NY,NX),NY,NX),DFGSOX,DPTH1 -C ENDIF -C -C ACCUMULATE HOURLY FLUXES -C - XCODFS(NY,NX)=XCODFS(NY,NX)+RCODFS(NY,NX) - XCHDFS(NY,NX)=XCHDFS(NY,NX)+RCHDFS(NY,NX) - XOXDFS(NY,NX)=XOXDFS(NY,NX)+ROXDFS(NY,NX) - XNGDFS(NY,NX)=XNGDFS(NY,NX)+RNGDFS(NY,NX) - XN2DFS(NY,NX)=XN2DFS(NY,NX)+RN2DFS(NY,NX) - XN3DFS(NY,NX)=XN3DFS(NY,NX)+RN3DFS(NY,NX) - XNBDFS(NY,NX)=XNBDFS(NY,NX)+RNBDFS(NY,NX) - XHGDFS(NY,NX)=XHGDFS(NY,NX)+RHGDFS(NY,NX) - ELSE - RCODFS(NY,NX)=0.0 - RCHDFS(NY,NX)=0.0 - ROXDFS(NY,NX)=0.0 - RNGDFS(NY,NX)=0.0 - RN2DFS(NY,NX)=0.0 - RN3DFS(NY,NX)=0.0 - RNBDFS(NY,NX)=0.0 - RHGDFS(NY,NX)=0.0 - ENDIF - RCODXS=RCODFS(NY,NX)*XNPT - RCHDXS=RCHDFS(NY,NX)*XNPT - ROXDXS=ROXDFS(NY,NX)*XNPT - RNGDXS=RNGDFS(NY,NX)*XNPT - RN2DXS=RN2DFS(NY,NX)*XNPT - RN3DXS=RN3DFS(NY,NX)*XNPT - RNBDXS=RNBDFS(NY,NX)*XNPT - RHGDXS=RHGDFS(NY,NX)*XNPT -C -C CONVECTIVE SOLUTE EXCHANGE BETWEEN RESIDUE AND SOIL SURFACE -C - FLWRM1=FLWRM(M,NY,NX) -C -C IF WATER FLUX FROM 'WATSUB' IS FROM RESIDUE TO -C SOIL SURFACE THEN CONVECTIVE TRANSPORT IS THE PRODUCT -C OF WATER FLUX AND MICROPORE GAS OR SOLUTE CONCENTRATIONS -C IN RESIDUE -C - IF(FLWRM1.GT.0.0)THEN - IF(VOLWM(M,0,NY,NX).GT.ZEROS(NY,NX))THEN - VFLW=AMAX1(0.0,AMIN1(XFRX,FLWRM1/VOLWM(M,0,NY,NX))) - ELSE - VFLW=XFRX - ENDIF - DO 8820 K=0,2 - 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)) - RFLOA(K)=VFLW*AMAX1(0.0,OQA2(K,0,NY,NX)) -8820 CONTINUE - RFLCOS=VFLW*AMAX1(0.0,CO2S2(0,NY,NX)) - RFLCHS=VFLW*AMAX1(0.0,CH4S2(0,NY,NX)) - RFLOXS=VFLW*AMAX1(0.0,OXYS2(0,NY,NX)) - RFLNGS=VFLW*AMAX1(0.0,Z2GS2(0,NY,NX)) - RFLN2S=VFLW*AMAX1(0.0,Z2OS2(0,NY,NX)) - RFLHGS=VFLW*AMAX1(0.0,H2GS2(0,NY,NX)) - RFLNH4=VFLW*AMAX1(0.0,ZNH4S2(0,NY,NX))*VLNH4(NU(NY,NX),NY,NX) - RFLNH3=VFLW*AMAX1(0.0,ZN3S2(0,NY,NX))*VLNH4(NU(NY,NX),NY,NX) - RFLNO3=VFLW*AMAX1(0.0,ZNO3S2(0,NY,NX))*VLNO3(NU(NY,NX),NY,NX) - RFLNO2=VFLW*AMAX1(0.0,ZNO2S2(0,NY,NX))*VLNO3(NU(NY,NX),NY,NX) - RFLPO4=VFLW*AMAX1(0.0,H2PO42(0,NY,NX))*VLPO4(NU(NY,NX),NY,NX) - RFLN4B=VFLW*AMAX1(0.0,ZNH4S2(0,NY,NX))*VLNHB(NU(NY,NX),NY,NX) - RFLN3B=VFLW*AMAX1(0.0,ZN3S2(0,NY,NX))*VLNHB(NU(NY,NX),NY,NX) - RFLNOB=VFLW*AMAX1(0.0,ZNO3S2(0,NY,NX))*VLNOB(NU(NY,NX),NY,NX) - RFLN2B=VFLW*AMAX1(0.0,ZNO2S2(0,NY,NX))*VLNOB(NU(NY,NX),NY,NX) - RFLPOB=VFLW*AMAX1(0.0,H2PO42(0,NY,NX))*VLPOB(NU(NY,NX),NY,NX) -C -C IF WATER FLUX FROM 'WATSUB' IS TO RESIDUE FROM -C SOIL SURFACE THEN CONVECTIVE TRANSPORT IS THE PRODUCT -C OF WATER FLUX AND MICROPORE GAS OR SOLUTE CONCENTRATIONS -C IN SOIL SURFACE -C - ELSE - IF(VOLWM(M,NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN - VFLW=AMIN1(0.0,AMAX1(-XFRX,FLWRM1/VOLWM(M,NU(NY,NX),NY,NX))) - ELSE - VFLW=-XFRX - ENDIF - DO 8815 K=0,2 - 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)) - RFLOA(K)=VFLW*AMAX1(0.0,OQA2(K,NU(NY,NX),NY,NX)) -8815 CONTINUE - RFLCOS=VFLW*AMAX1(0.0,CO2S2(NU(NY,NX),NY,NX)) - RFLCHS=VFLW*AMAX1(0.0,CH4S2(NU(NY,NX),NY,NX)) - RFLOXS=VFLW*AMAX1(0.0,OXYS2(NU(NY,NX),NY,NX)) - RFLNGS=VFLW*AMAX1(0.0,Z2GS2(NU(NY,NX),NY,NX)) - RFLN2S=VFLW*AMAX1(0.0,Z2OS2(NU(NY,NX),NY,NX)) - RFLHGS=VFLW*AMAX1(0.0,H2GS2(NU(NY,NX),NY,NX)) - RFLNH4=VFLW*AMAX1(0.0,ZNH4S2(NU(NY,NX),NY,NX)) - RFLNH3=VFLW*AMAX1(0.0,ZN3S2(NU(NY,NX),NY,NX)) - RFLNO3=VFLW*AMAX1(0.0,ZNO3S2(NU(NY,NX),NY,NX)) - RFLNO2=VFLW*AMAX1(0.0,ZNO2S2(NU(NY,NX),NY,NX)) - RFLPO4=VFLW*AMAX1(0.0,H2PO42(NU(NY,NX),NY,NX)) - RFLN4B=VFLW*AMAX1(0.0,ZNH4B2(NU(NY,NX),NY,NX)) - RFLN3B=VFLW*AMAX1(0.0,ZNBS2(NU(NY,NX),NY,NX)) - RFLNOB=VFLW*AMAX1(0.0,ZNO3B2(NU(NY,NX),NY,NX)) - RFLN2B=VFLW*AMAX1(0.0,ZNO2B2(NU(NY,NX),NY,NX)) - RFLPOB=VFLW*AMAX1(0.0,H2POB2(NU(NY,NX),NY,NX)) - ENDIF -C -C DIFFUSIVE FLUXES OF GASES AND SOLUTES BETWEEN RESIDUE AND -C SOIL SURFACE FROM AQUEOUS DIFFUSIVITIES -C AND CONCENTRATION DIFFERENCES -C - IF(THETW1(0,NY,NX).GT.THETY(0,NY,NX) - 2.AND.THETW1(NU(NY,NX),NY,NX).GT.THETY(NU(NY,NX),NY,NX))THEN -C -C MICROPORE CONCENTRATIONS FROM WATER IN RESIDUE AND SOIL SURFACE -C - DO 8810 K=0,2 - 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)) - COQA1(K)=AMAX1(0.0,OQA2(K,0,NY,NX)/VOLWM(M,0,NY,NX)) - COQC2(K)=AMAX1(0.0,OQC2(K,NU(NY,NX),NY,NX) - 2/VOLWM(M,NU(NY,NX),NY,NX)) - COQN2(K)=AMAX1(0.0,OQN2(K,NU(NY,NX),NY,NX) - 2/VOLWM(M,NU(NY,NX),NY,NX)) - COQP2(K)=AMAX1(0.0,OQP2(K,NU(NY,NX),NY,NX) - 2/VOLWM(M,NU(NY,NX),NY,NX)) - COQA2(K)=AMAX1(0.0,OQA2(K,NU(NY,NX),NY,NX) - 2/VOLWM(M,NU(NY,NX),NY,NX)) -8810 CONTINUE - CCO2S1=AMAX1(0.0,CO2S2(0,NY,NX)/VOLWM(M,0,NY,NX)) - CCH4S1=AMAX1(0.0,CH4S2(0,NY,NX)/VOLWM(M,0,NY,NX)) - COXYS1=AMAX1(0.0,OXYS2(0,NY,NX)/VOLWM(M,0,NY,NX)) - CZ2GS1=AMAX1(0.0,Z2GS2(0,NY,NX)/VOLWM(M,0,NY,NX)) - CZ2OS1=AMAX1(0.0,Z2OS2(0,NY,NX)/VOLWM(M,0,NY,NX)) - CH2GS1=AMAX1(0.0,H2GS2(0,NY,NX)/VOLWM(M,0,NY,NX)) - CNH4S1=AMAX1(0.0,ZNH4S2(0,NY,NX)/VOLWM(M,0,NY,NX)) - CNH3S1=AMAX1(0.0,ZN3S2(0,NY,NX)/VOLWM(M,0,NY,NX)) - CNO3S1=AMAX1(0.0,ZNO3S2(0,NY,NX)/VOLWM(M,0,NY,NX)) - CNO2S1=AMAX1(0.0,ZNO2S2(0,NY,NX)/VOLWM(M,0,NY,NX)) - CPO4S1=AMAX1(0.0,H2PO42(0,NY,NX)/VOLWM(M,0,NY,NX)) - CCO2S2=AMAX1(0.0,CO2S2(NU(NY,NX),NY,NX)/VOLWM(M,NU(NY,NX),NY,NX)) - CCH4S2=AMAX1(0.0,CH4S2(NU(NY,NX),NY,NX)/VOLWM(M,NU(NY,NX),NY,NX)) - COXYS2=AMAX1(0.0,OXYS2(NU(NY,NX),NY,NX)/VOLWM(M,NU(NY,NX),NY,NX)) - CZ2GS2=AMAX1(0.0,Z2GS2(NU(NY,NX),NY,NX)/VOLWM(M,NU(NY,NX),NY,NX)) - CZ2OS2=AMAX1(0.0,Z2OS2(NU(NY,NX),NY,NX)/VOLWM(M,NU(NY,NX),NY,NX)) - CH2GS2=AMAX1(0.0,H2GS2(NU(NY,NX),NY,NX)/VOLWM(M,NU(NY,NX),NY,NX)) - IF(VOLWMA(NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN - CNH3S2=AMAX1(0.0,ZN3S2(NU(NY,NX),NY,NX)/VOLWMA(NU(NY,NX),NY,NX)) - CNH4S2=AMAX1(0.0,ZNH4S2(NU(NY,NX),NY,NX)/VOLWMA(NU(NY,NX),NY,NX)) - ELSE - CNH3S2=0.0 - CNH4S2=0.0 - ENDIF - IF(VOLWOA.GT.ZEROS(NY,NX))THEN - CNO3S2=AMAX1(0.0,ZNO3S2(NU(NY,NX),NY,NX)/VOLWOA) - CNO2S2=AMAX1(0.0,ZNO2S2(NU(NY,NX),NY,NX)/VOLWOA) - ELSE - CNO3S2=0.0 - CNO2S2=0.0 - ENDIF - IF(VOLWPA.GT.ZEROS(NY,NX))THEN - CPO4S2=AMAX1(0.0,H2PO42(NU(NY,NX),NY,NX)/VOLWPA) - ELSE - CPO4S2=0.0 - ENDIF - IF(VOLWMB(NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN - CNH3B2=AMAX1(0.0,ZNBS2(NU(NY,NX),NY,NX)/VOLWMB(NU(NY,NX),NY,NX)) - CNH4B2=AMAX1(0.0,ZNH4B2(NU(NY,NX),NY,NX)/VOLWMB(NU(NY,NX),NY,NX)) - ELSE - CNH3B2=CNH3S2 - CNH4B2=CNH4S2 - ENDIF - IF(VOLWOB.GT.ZEROS(NY,NX))THEN - CNO3B2=AMAX1(0.0,ZNO3B2(NU(NY,NX),NY,NX)/VOLWOB) - CNO2B2=AMAX1(0.0,ZNO2B2(NU(NY,NX),NY,NX)/VOLWOB) - ELSE - CNO3B2=CNO3S2 - CNO2B2=CNO2S2 - ENDIF - IF(VOLWPB.GT.ZEROS(NY,NX))THEN - CPO4B2=AMAX1(0.0,H2POB2(NU(NY,NX),NY,NX)/VOLWPB) - ELSE - CPO4B2=CPO4S2 - ENDIF -C -C DIFFUSIVITIES IN RESIDUE AND SOIL SURFACE -C - TORT0=TORT(0,NY,NX)*AREA(3,NU(NY,NX),NY,NX) - 2/DLYR(3,0,NY,NX) - TORT1=TORT(NU(NY,NX),NY,NX)*AREA(3,NU(NY,NX),NY,NX) - 2/DLYR(3,NU(NY,NX),NY,NX) - DISPN=DISP(3,NU(NY,NX),NY,NX)*ABS(FLWRM1/AREA(3,NU(NY,NX),NY,NX)) - DIFOC0=(OCSGL2(0,NY,NX)*TORT0+DISPN) - DIFON0=(ONSGL2(0,NY,NX)*TORT0+DISPN) - DIFOP0=(OPSGL2(0,NY,NX)*TORT0+DISPN) - DIFOA0=(OASGL2(0,NY,NX)*TORT0+DISPN) - DIFNH0=(ZNSGL2(0,NY,NX)*TORT0+DISPN) - DIFNO0=(ZOSGL2(0,NY,NX)*TORT0+DISPN) - DIFPO0=(POSGL2(0,NY,NX)*TORT0+DISPN) - DIFCS0=(CLSGL2(0,NY,NX)*TORT0+DISPN) - DIFCQ0=(CQSGL2(0,NY,NX)*TORT0+DISPN) - DIFOS0=(OLSGL2(0,NY,NX)*TORT0+DISPN) - DIFNG0=(ZLSGL2(0,NY,NX)*TORT0+DISPN) - DIFN20=(ZVSGL2(0,NY,NX)*TORT0+DISPN) - DIFHG0=(HLSGL2(0,NY,NX)*TORT0+DISPN) - DIFOC1=(OCSGL2(NU(NY,NX),NY,NX)*TORT1+DISPN) - DIFON1=(ONSGL2(NU(NY,NX),NY,NX)*TORT1+DISPN) - DIFOP1=(OPSGL2(NU(NY,NX),NY,NX)*TORT1+DISPN) - DIFOA1=(OASGL2(NU(NY,NX),NY,NX)*TORT1+DISPN) - DIFNH1=(ZNSGL2(NU(NY,NX),NY,NX)*TORT1+DISPN) - DIFNO1=(ZOSGL2(NU(NY,NX),NY,NX)*TORT1+DISPN) - DIFPO1=(POSGL2(NU(NY,NX),NY,NX)*TORT1+DISPN) - DIFCS1=(CLSGL2(NU(NY,NX),NY,NX)*TORT1+DISPN) - DIFCQ1=(CQSGL2(NU(NY,NX),NY,NX)*TORT1+DISPN) - DIFOS1=(OLSGL2(NU(NY,NX),NY,NX)*TORT1+DISPN) - DIFNG1=(ZLSGL2(NU(NY,NX),NY,NX)*TORT1+DISPN) - DIFN21=(ZVSGL2(NU(NY,NX),NY,NX)*TORT1+DISPN) - DIFHG1=(HLSGL2(NU(NY,NX),NY,NX)*TORT1+DISPN) - DIFOC=DIFOC0*DIFOC1/(DIFOC0+DIFOC1) - DIFON=DIFON0*DIFON1/(DIFON0+DIFON1) - DIFOP=DIFOP0*DIFOP1/(DIFOP0+DIFOP1) - DIFOA=DIFOA0*DIFOA1/(DIFOA0+DIFOA1) - DIFNH=DIFNH0*DIFNH1/(DIFNH0+DIFNH1) - DIFNO=DIFNO0*DIFNO1/(DIFNO0+DIFNO1) - DIFPO=DIFPO0*DIFPO1/(DIFPO0+DIFPO1) - DIFCS=DIFCS0*DIFCS1/(DIFCS0+DIFCS1) - DIFCQ=DIFCQ0*DIFCQ1/(DIFCQ0+DIFCQ1) - DIFOS=DIFOS0*DIFOS1/(DIFOS0+DIFOS1) - DIFNG=DIFNG0*DIFNG1/(DIFNG0+DIFNG1) - DIFN2=DIFN20*DIFN21/(DIFN20+DIFN21) - DIFHG=DIFHG0*DIFHG1/(DIFHG0+DIFHG1) -C -C DIFFUSIVE FLUXES BETWEEN CURRENT AND ADJACENT GRID CELL -C MICROPORES -C - DO 8805 K=0,2 - DFVOC(K)=DIFOC*(COQC1(K)-COQC2(K)) - DFVON(K)=DIFON*(COQN1(K)-COQN2(K)) - DFVOP(K)=DIFOP*(COQP1(K)-COQP2(K)) - DFVOA(K)=DIFOA*(COQA1(K)-COQA2(K)) -8805 CONTINUE - DFVCOS=DIFCS*(CCO2S1-CCO2S2) - DFVCHS=DIFCQ*(CCH4S1-CCH4S2) - DFVOXS=DIFOS*(COXYS1-COXYS2) - DFVNGS=DIFNG*(CZ2GS1-CZ2GS2) - DFVN2S=DIFN2*(CZ2OS1-CZ2OS2) - DFVHGS=DIFHG*(CH2GS1-CH2GS2) - DFVNH4=DIFNH*(CNH4S1-CNH4S2)*VLNH4(NU(NY,NX),NY,NX) - DFVNH3=DIFNH*(CNH3S1-CNH3S2)*VLNH4(NU(NY,NX),NY,NX) - DFVNO3=DIFNO*(CNO3S1-CNO3S2)*VLNO3(NU(NY,NX),NY,NX) - DFVNO2=DIFNO*(CNO2S1-CNO2S2)*VLNO3(NU(NY,NX),NY,NX) - DFVPO4=DIFPO*(CPO4S1-CPO4S2)*VLPO4(NU(NY,NX),NY,NX) - DFVN4B=DIFNH*(CNH4S1-CNH4B2)*VLNHB(NU(NY,NX),NY,NX) - DFVN3B=DIFNH*(CNH3S1-CNH3B2)*VLNHB(NU(NY,NX),NY,NX) - DFVNOB=DIFNO*(CNO3S1-CNO3B2)*VLNOB(NU(NY,NX),NY,NX) - DFVN2B=DIFNO*(CNO2S1-CNO2B2)*VLNOB(NU(NY,NX),NY,NX) - DFVPOB=DIFPO*(CPO4S1-CPO4B2)*VLPOB(NU(NY,NX),NY,NX) - ELSE - DO 8905 K=0,2 - DFVOC(K)=0.0 - DFVON(K)=0.0 - DFVOP(K)=0.0 - DFVOA(K)=0.0 -8905 CONTINUE - DFVCOS=0.0 - DFVCHS=0.0 - DFVOXS=0.0 - DFVNGS=0.0 - DFVN2S=0.0 - DFVHGS=0.0 - DFVNH4=0.0 - DFVNH3=0.0 - DFVNO3=0.0 - DFVNO2=0.0 - DFVPO4=0.0 - DFVN4B=0.0 - DFVN3B=0.0 - DFVNOB=0.0 - DFVN2B=0.0 - DFVPOB=0.0 - ENDIF -C -C TOTAL MICROPORE AND MACROPORE SOLUTE TRANSPORT FLUXES BETWEEN -C ADJACENT GRID CELLS = CONVECTIVE + DIFFUSIVE FLUXES -C - DO 9760 K=0,2 - ROCFLS(K,3,0,NY,NX)=ROCFL0(K,NY,NX)-RFLOC(K)-DFVOC(K) - RONFLS(K,3,0,NY,NX)=RONFL0(K,NY,NX)-RFLON(K)-DFVON(K) - ROPFLS(K,3,0,NY,NX)=ROPFL0(K,NY,NX)-RFLOP(K)-DFVOP(K) - ROAFLS(K,3,0,NY,NX)=ROAFL0(K,NY,NX)-RFLOA(K)-DFVOA(K) - ROCFLS(K,3,NU(NY,NX),NY,NX)=ROCFL1(K,NY,NX)+RFLOC(K)+DFVOC(K) - 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 - ROXFLS(3,0,NY,NX)=ROXFL0(NY,NX)-RFLOXS-DFVOXS - RNGFLS(3,0,NY,NX)=RNGFL0(NY,NX)-RFLNGS-DFVNGS - RN2FLS(3,0,NY,NX)=RN2FL0(NY,NX)-RFLN2S-DFVN2S - RHGFLS(3,0,NY,NX)=RHGFL0(NY,NX)-RFLHGS-DFVHGS - RN4FLW(3,0,NY,NX)=RN4FL0(NY,NX)-RFLNH4-DFVNH4-RFLN4B-DFVN4B - RN3FLW(3,0,NY,NX)=RN3FL0(NY,NX)-RFLNH3-DFVNH3-RFLN3B-DFVN3B - RNOFLW(3,0,NY,NX)=RNOFL0(NY,NX)-RFLNO3-DFVNO3-RFLNOB-DFVNOB - RNXFLS(3,0,NY,NX)=RNXFL0(NY,NX)-RFLNO2-DFVNO2-RFLN2B-DFVN2B - RH2PFS(3,0,NY,NX)=RH2PF0(NY,NX)-RFLPO4-DFVPO4-RFLPOB-DFVPOB - RCOFLS(3,NU(NY,NX),NY,NX)=RCOFL1(NY,NX)+RFLCOS+DFVCOS - RCHFLS(3,NU(NY,NX),NY,NX)=RCHFL1(NY,NX)+RFLCHS+DFVCHS - ROXFLS(3,NU(NY,NX),NY,NX)=ROXFL1(NY,NX)+RFLOXS+DFVOXS - RNGFLS(3,NU(NY,NX),NY,NX)=RNGFL1(NY,NX)+RFLNGS+DFVNGS - RN2FLS(3,NU(NY,NX),NY,NX)=RN2FL1(NY,NX)+RFLN2S+DFVN2S - RHGFLS(3,NU(NY,NX),NY,NX)=RHGFL1(NY,NX)+RFLHGS+DFVHGS - RN4FLW(3,NU(NY,NX),NY,NX)=RN4FL1(NY,NX)+RFLNH4+DFVNH4 - RN3FLW(3,NU(NY,NX),NY,NX)=RN3FL1(NY,NX)+RFLNH3+DFVNH3 - RNOFLW(3,NU(NY,NX),NY,NX)=RNOFL1(NY,NX)+RFLNO3+DFVNO3 - RNXFLS(3,NU(NY,NX),NY,NX)=RNXFL1(NY,NX)+RFLNO2+DFVNO2 - RH2PFS(3,NU(NY,NX),NY,NX)=RH2PF1(NY,NX)+RFLPO4+DFVPO4 - RN4FLB(3,NU(NY,NX),NY,NX)=RN4FL2(NY,NX)+RFLN4B+DFVN4B - RN3FLB(3,NU(NY,NX),NY,NX)=RN3FL2(NY,NX)+RFLN3B+DFVN3B - RNOFLB(3,NU(NY,NX),NY,NX)=RNOFL2(NY,NX)+RFLNOB+DFVNOB - RNXFLB(3,NU(NY,NX),NY,NX)=RNXFL2(NY,NX)+RFLN2B+DFVN2B - RH2BFB(3,NU(NY,NX),NY,NX)=RH2BF2(NY,NX)+RFLPOB+DFVPOB - 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 - XNGFLS(3,0,NY,NX)=XNGFLS(3,0,NY,NX)-RFLNGS-DFVNGS - XN2FLS(3,0,NY,NX)=XN2FLS(3,0,NY,NX)-RFLN2S-DFVN2S - XHGFLS(3,0,NY,NX)=XHGFLS(3,0,NY,NX)-RFLHGS-DFVHGS - XN4FLW(3,0,NY,NX)=XN4FLW(3,0,NY,NX)-RFLNH4-DFVNH4-RFLN4B-DFVN4B - XN3FLW(3,0,NY,NX)=XN3FLW(3,0,NY,NX)-RFLNH3-DFVNH3-RFLN3B-DFVN3B - XNOFLW(3,0,NY,NX)=XNOFLW(3,0,NY,NX)-RFLNO3-DFVNO3-RFLNOB-DFVNOB - XNXFLS(3,0,NY,NX)=XNXFLS(3,0,NY,NX)-RFLNO2-DFVNO2-RFLN2B-DFVN2B - XH2PFS(3,0,NY,NX)=XH2PFS(3,0,NY,NX)-RFLPO4-DFVPO4-RFLPOB-DFVPOB - XCOFLS(3,NU(NY,NX),NY,NX)=XCOFLS(3,NU(NY,NX),NY,NX)+RFLCOS+DFVCOS - XCHFLS(3,NU(NY,NX),NY,NX)=XCHFLS(3,NU(NY,NX),NY,NX)+RFLCHS+DFVCHS - XOXFLS(3,NU(NY,NX),NY,NX)=XOXFLS(3,NU(NY,NX),NY,NX)+RFLOXS+DFVOXS - XNGFLS(3,NU(NY,NX),NY,NX)=XNGFLS(3,NU(NY,NX),NY,NX)+RFLNGS+DFVNGS - XN2FLS(3,NU(NY,NX),NY,NX)=XN2FLS(3,NU(NY,NX),NY,NX)+RFLN2S+DFVN2S - XHGFLS(3,NU(NY,NX),NY,NX)=XHGFLS(3,NU(NY,NX),NY,NX)+RFLHGS+DFVHGS - XN4FLW(3,NU(NY,NX),NY,NX)=XN4FLW(3,NU(NY,NX),NY,NX)+RFLNH4+DFVNH4 - XN3FLW(3,NU(NY,NX),NY,NX)=XN3FLW(3,NU(NY,NX),NY,NX)+RFLNH3+DFVNH3 - XNOFLW(3,NU(NY,NX),NY,NX)=XNOFLW(3,NU(NY,NX),NY,NX)+RFLNO3+DFVNO3 - XNXFLS(3,NU(NY,NX),NY,NX)=XNXFLS(3,NU(NY,NX),NY,NX)+RFLNO2+DFVNO2 - XH2PFS(3,NU(NY,NX),NY,NX)=XH2PFS(3,NU(NY,NX),NY,NX)+RFLPO4+DFVPO4 - XN4FLB(3,NU(NY,NX),NY,NX)=XN4FLB(3,NU(NY,NX),NY,NX)+RFLN4B+DFVN4B - XN3FLB(3,NU(NY,NX),NY,NX)=XN3FLB(3,NU(NY,NX),NY,NX)+RFLN3B+DFVN3B - XNOFLB(3,NU(NY,NX),NY,NX)=XNOFLB(3,NU(NY,NX),NY,NX)+RFLNOB+DFVNOB - XNXFLB(3,NU(NY,NX),NY,NX)=XNXFLB(3,NU(NY,NX),NY,NX)+RFLN2B+DFVN2B - XH2BFB(3,NU(NY,NX),NY,NX)=XH2BFB(3,NU(NY,NX),NY,NX)+RFLPOB+DFVPOB -C IF(I.EQ.118.AND.NX.EQ.3.AND.NY.EQ.4)THEN -C WRITE(*,3434)'ROXFLS',I,J,NX,NY,M,MM,ROXFLS(3,0,NY,NX) -C 2,XOXFLS(3,0,NY,NX),ROXFL0(NY,NX),RFLOXS,DFVOXS -3434 FORMAT(A8,6I4,12E12.4) -C ENDIF -C -C MACROPORE-MICROPORE SOLUTE EXCHANGE IN SOIL -C SURFACE LAYER FROM WATER EXCHANGE IN 'WATSUB' AND -C FROM MACROPORE OR MICROPORE SOLUTE CONCENTRATIONS -C -C -C MACROPORE TO MICROPORE TRANSFER -C - IF(FINHM(M,NU(NY,NX),NY,NX).GT.0.0)THEN - IF(VOLWHM(M,NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN - VFLW=AMAX1(0.0,AMIN1(XFRX,FINHM(M,NU(NY,NX),NY,NX) - 2/VOLWHM(M,NU(NY,NX),NY,NX))) - ELSE - VFLW=XFRX - ENDIF - DO 9870 K=0,4 - RFLOC(K)=VFLW*AMAX1(0.0,OQCH2(K,NU(NY,NX),NY,NX)) - RFLON(K)=VFLW*AMAX1(0.0,OQNH2(K,NU(NY,NX),NY,NX)) - RFLOP(K)=VFLW*AMAX1(0.0,OQPH2(K,NU(NY,NX),NY,NX)) - RFLOA(K)=VFLW*AMAX1(0.0,OQAH2(K,NU(NY,NX),NY,NX)) -9870 CONTINUE - RFLCOS=VFLW*AMAX1(0.0,CO2SH2(NU(NY,NX),NY,NX)) - RFLCHS=VFLW*AMAX1(0.0,CH4SH2(NU(NY,NX),NY,NX)) - RFLOXS=VFLW*AMAX1(0.0,OXYSH2(NU(NY,NX),NY,NX)) - RFLNGS=VFLW*AMAX1(0.0,Z2GSH2(NU(NY,NX),NY,NX)) - RFLN2S=VFLW*AMAX1(0.0,Z2OSH2(NU(NY,NX),NY,NX)) - RFLHGS=VFLW*AMAX1(0.0,H2GSH2(NU(NY,NX),NY,NX)) - RFLNH4=VFLW*AMAX1(0.0,ZNH4H2(NU(NY,NX),NY,NX)) - 2*VLNH4(NU(NY,NX),NY,NX) - RFLNH3=VFLW*AMAX1(0.0,ZNH3H2(NU(NY,NX),NY,NX)) - 2*VLNH4(NU(NY,NX),NY,NX) - RFLNO3=VFLW*AMAX1(0.0,ZNO3H2(NU(NY,NX),NY,NX)) - 2*VLNO3(NU(NY,NX),NY,NX) - RFLNO2=VFLW*AMAX1(0.0,ZNO2H2(NU(NY,NX),NY,NX)) - 2*VLNO3(NU(NY,NX),NY,NX) - RFLPO4=VFLW*AMAX1(0.0,H2P4H2(NU(NY,NX),NY,NX)) - 2*VLPO4(NU(NY,NX),NY,NX) - RFLN4B=VFLW*AMAX1(0.0,ZN4BH2(NU(NY,NX),NY,NX)) - 2*VLNHB(NU(NY,NX),NY,NX) - RFLN3B=VFLW*AMAX1(0.0,ZN3BH2(NU(NY,NX),NY,NX)) - 2*VLNHB(NU(NY,NX),NY,NX) - RFLNOB=VFLW*AMAX1(0.0,ZNOBH2(NU(NY,NX),NY,NX)) - 2*VLNOB(NU(NY,NX),NY,NX) - RFLN2B=VFLW*AMAX1(0.0,ZN2BH2(NU(NY,NX),NY,NX)) - 2*VLNOB(NU(NY,NX),NY,NX) - RFLPOB=VFLW*AMAX1(0.0,H2PBH2(NU(NY,NX),NY,NX)) - 2*VLPOB(NU(NY,NX),NY,NX) -C -C MICROPORE TO MACROPORE TRANSFER -C - ELSEIF(FINHM(M,NU(NY,NX),NY,NX).LT.0.0)THEN - IF(VOLWM(M,NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN - VFLW=AMIN1(0.0,AMAX1(-XFRX,FINHM(M,NU(NY,NX),NY,NX) - 2/VOLWM(M,NU(NY,NX),NY,NX))) - ELSE - VFLW=-XFRX - ENDIF - DO 9865 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)) - RFLOA(K)=VFLW*AMAX1(0.0,OQA2(K,NU(NY,NX),NY,NX)) -9865 CONTINUE - RFLCOS=VFLW*AMAX1(0.0,CO2S2(NU(NY,NX),NY,NX)) - RFLCHS=VFLW*AMAX1(0.0,CH4S2(NU(NY,NX),NY,NX)) - RFLOXS=VFLW*AMAX1(0.0,OXYS2(NU(NY,NX),NY,NX)) - RFLNGS=VFLW*AMAX1(0.0,Z2GS2(NU(NY,NX),NY,NX)) - RFLN2S=VFLW*AMAX1(0.0,Z2OS2(NU(NY,NX),NY,NX)) - RFLHGS=VFLW*AMAX1(0.0,H2GS2(NU(NY,NX),NY,NX)) - RFLNH4=VFLW*AMAX1(0.0,ZNH4S2(NU(NY,NX),NY,NX)) - 2*VLNH4(NU(NY,NX),NY,NX) - RFLNH3=VFLW*AMAX1(0.0,ZN3S2(NU(NY,NX),NY,NX)) - 2*VLNH4(NU(NY,NX),NY,NX) - RFLNO3=VFLW*AMAX1(0.0,ZNO3S2(NU(NY,NX),NY,NX)) - 2*VLNO3(NU(NY,NX),NY,NX) - RFLNO2=VFLW*AMAX1(0.0,ZNO2S2(NU(NY,NX),NY,NX)) - 2*VLNO3(NU(NY,NX),NY,NX) - RFLPO4=VFLW*AMAX1(0.0,H2PO42(NU(NY,NX),NY,NX)) - 2*VLPO4(NU(NY,NX),NY,NX) - RFLN4B=VFLW*AMAX1(0.0,ZNH4B2(NU(NY,NX),NY,NX)) - 2*VLNHB(NU(NY,NX),NY,NX) - RFLN3B=VFLW*AMAX1(0.0,ZNBS2(NU(NY,NX),NY,NX)) - 2*VLNHB(NU(NY,NX),NY,NX) - RFLNOB=VFLW*AMAX1(0.0,ZNO3B2(NU(NY,NX),NY,NX)) - 2*VLNOB(NU(NY,NX),NY,NX) - RFLN2B=VFLW*AMAX1(0.0,ZNO2B2(NU(NY,NX),NY,NX)) - 2*VLNOB(NU(NY,NX),NY,NX) - RFLPOB=VFLW*AMAX1(0.0,H2POB2(NU(NY,NX),NY,NX)) - 2*VLPOB(NU(NY,NX),NY,NX) -C -C NO MACROPORE TO MICROPORE TRANSFER -C - ELSE - DO 9860 K=0,4 - RFLOC(K)=0.0 - RFLON(K)=0.0 - RFLOP(K)=0.0 - RFLOA(K)=0.0 -9860 CONTINUE - RFLCOS=0.0 - RFLCHS=0.0 - RFLOXS=0.0 - RFLNGS=0.0 - RFLN2S=0.0 - RFLHGS=0.0 - RFLNH4=0.0 - RFLNH3=0.0 - RFLNO3=0.0 - RFLNO2=0.0 - RFLPO4=0.0 - RFLN4B=0.0 - RFLN3B=0.0 - RFLNOB=0.0 - RFLN2B=0.0 - RFLPOB=0.0 - ENDIF -C -C DIFFUSIVE FLUXES OF SOLUTES BETWEEN MICROPORES AND -C MACROPORES FROM AQUEOUS DIFFUSIVITIES AND CONCENTRATION DIFFERENCES -C -C -C DIFFUSIVE FLUXES OF SOLUTES BETWEEN MICROPORES AND -C MACROPORES FROM AQUEOUS DIFFUSIVITIES AND CONCENTRATION DIFFERENCES -C - IF(VOLWHM(M,NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN - 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 - DFVOC(K)=XNPX*(OQCH2(K,NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-OQC2(K,NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - DFVON(K)=XNPX*(OQNH2(K,NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-OQN2(K,NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - DFVOP(K)=XNPX*(OQPH2(K,NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-OQP2(K,NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - DFVOA(K)=XNPX*(OQAH2(K,NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-OQA2(K,NU(NY,NX),NY,NX)*VOLWHS)/VOLWT -8835 CONTINUE - DFVCOS=XNPX*(CO2SH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-CO2S2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - DFVCHS=XNPX*(CH4SH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-CH4S2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - DFVOXS=XNPX*(OXYSH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-OXYS2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - DFVNGS=XNPX*(Z2GSH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-Z2GS2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - DFVN2S=XNPX*(Z2OSH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-Z2OS2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - DFVHGS=XNPX*(H2GSH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-H2GS2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - DFVNH4=XNPX*(ZNH4H2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZNH4S2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - 3*VLNH4(NU(NY,NX),NY,NX) - DFVNH3=XNPX*(ZNH3H2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZN3S2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - 3*VLNH4(NU(NY,NX),NY,NX) - DFVNO3=XNPX*(ZNO3H2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZNO3S2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - 3*VLNO3(NU(NY,NX),NY,NX) - DFVNO2=XNPX*(ZNO2H2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZNO2S2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - 3*VLNO3(NU(NY,NX),NY,NX) - DFVPO4=XNPX*(H2P4H2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-H2PO42(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - 3*VLPO4(NU(NY,NX),NY,NX) - DFVN4B=XNPX*(ZN4BH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZNH4B2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - 3*VLNHB(NU(NY,NX),NY,NX) - DFVN3B=XNPX*(ZN3BH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZNBS2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - 3*VLNHB(NU(NY,NX),NY,NX) - DFVNOB=XNPX*(ZNOBH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZNO3B2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - 3*VLNOB(NU(NY,NX),NY,NX) - DFVN2B=XNPX*(ZN2BH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZNO2B2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - 3*VLNOB(NU(NY,NX),NY,NX) - DFVPOB=XNPX*(H2PBH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-H2POB2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - 3*VLPOB(NU(NY,NX),NY,NX) - ELSE - DO 8935 K=0,2 - DFVOC(K)=0.0 - DFVON(K)=0.0 - DFVOP(K)=0.0 - DFVOA(K)=0.0 -8935 CONTINUE - DFVCOS=0.0 - DFVCHS=0.0 - DFVOXS=0.0 - DFVNGS=0.0 - DFVN2S=0.0 - DFVHGS=0.0 - DFVNH4=0.0 - DFVNH3=0.0 - DFVNO3=0.0 - DFVNO2=0.0 - DFVPO4=0.0 - DFVN4B=0.0 - DFVN3B=0.0 - DFVNOB=0.0 - DFVN2B=0.0 - DFVPOB=0.0 - ENDIF -C -C TOTAL CONVECTIVE +DIFFUSIVE TRANSFER BETWEEN MACROPOES AND MICROPORES -C - DO 9940 K=0,4 - ROCFXS(K,NU(NY,NX),NY,NX)=RFLOC(K)+DFVOC(K) - 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 - ROXFXS(NU(NY,NX),NY,NX)=RFLOXS+DFVOXS - RNGFXS(NU(NY,NX),NY,NX)=RFLNGS+DFVNGS - RN2FXS(NU(NY,NX),NY,NX)=RFLN2S+DFVN2S - RHGFXS(NU(NY,NX),NY,NX)=RFLHGS+DFVHGS - RN4FXW(NU(NY,NX),NY,NX)=RFLNH4+DFVNH4 - RN3FXW(NU(NY,NX),NY,NX)=RFLNH3+DFVNH3 - RNOFXW(NU(NY,NX),NY,NX)=RFLNO3+DFVNO3 - RNXFXS(NU(NY,NX),NY,NX)=RFLNO2+DFVNO2 - RH2PXS(NU(NY,NX),NY,NX)=RFLPO4+DFVPO4 - RN4FXB(NU(NY,NX),NY,NX)=RFLN4B+DFVN4B - RN3FXB(NU(NY,NX),NY,NX)=RFLN3B+DFVN3B - RNOFXB(NU(NY,NX),NY,NX)=RFLNOB+DFVNOB - RNXFXB(NU(NY,NX),NY,NX)=RFLN2B+DFVN2B - RH2BXB(NU(NY,NX),NY,NX)=RFLPOB+DFVPOB -C -C ACCUMULATE HOURLY FLUXES -C - DO 9935 K=0,4 - 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) -9935 CONTINUE - XCOFXS(NU(NY,NX),NY,NX)=XCOFXS(NU(NY,NX),NY,NX) - 2+RCOFXS(NU(NY,NX),NY,NX) - XCHFXS(NU(NY,NX),NY,NX)=XCHFXS(NU(NY,NX),NY,NX) - 2+RCHFXS(NU(NY,NX),NY,NX) - XOXFXS(NU(NY,NX),NY,NX)=XOXFXS(NU(NY,NX),NY,NX) - 2+ROXFXS(NU(NY,NX),NY,NX) - XNGFXS(NU(NY,NX),NY,NX)=XNGFXS(NU(NY,NX),NY,NX) - 2+RNGFXS(NU(NY,NX),NY,NX) - XN2FXS(NU(NY,NX),NY,NX)=XN2FXS(NU(NY,NX),NY,NX) - 2+RN2FXS(NU(NY,NX),NY,NX) - XHGFXS(NU(NY,NX),NY,NX)=XHGFXS(NU(NY,NX),NY,NX) - 2+RHGFXS(NU(NY,NX),NY,NX) - XN4FXW(NU(NY,NX),NY,NX)=XN4FXW(NU(NY,NX),NY,NX) - 2+RN4FXW(NU(NY,NX),NY,NX) - XN3FXW(NU(NY,NX),NY,NX)=XN3FXW(NU(NY,NX),NY,NX) - 2+RN3FXW(NU(NY,NX),NY,NX) - XNOFXW(NU(NY,NX),NY,NX)=XNOFXW(NU(NY,NX),NY,NX) - 2+RNOFXW(NU(NY,NX),NY,NX) - XNXFXS(NU(NY,NX),NY,NX)=XNXFXS(NU(NY,NX),NY,NX) - 2+RNXFXS(NU(NY,NX),NY,NX) - XH2PXS(NU(NY,NX),NY,NX)=XH2PXS(NU(NY,NX),NY,NX) - 2+RH2PXS(NU(NY,NX),NY,NX) - XN4FXB(NU(NY,NX),NY,NX)=XN4FXB(NU(NY,NX),NY,NX) - 2+RN4FXB(NU(NY,NX),NY,NX) - XN3FXB(NU(NY,NX),NY,NX)=XN3FXB(NU(NY,NX),NY,NX) - 2+RN3FXB(NU(NY,NX),NY,NX) - XNOFXB(NU(NY,NX),NY,NX)=XNOFXB(NU(NY,NX),NY,NX) - 2+RNOFXB(NU(NY,NX),NY,NX) - XNXFXB(NU(NY,NX),NY,NX)=XNXFXB(NU(NY,NX),NY,NX) - 2+RNXFXB(NU(NY,NX),NY,NX) - XH2BXB(NU(NY,NX),NY,NX)=XH2BXB(NU(NY,NX),NY,NX) - 2+RH2BXB(NU(NY,NX),NY,NX) -C -C SOLUTE TRANSPORT FROM WATER OVERLAND FLOW -C IN 'WATSUB' AND FROM SOLUTE CONCENTRATIONS -C IN SOIL SURFACE LAYER -C - N1=NX - N2=NY -C -C LOCATE INTERNAL BOUNDARIES BETWEEN ADJACENT GRID CELLS -C - DO 4310 N=1,2 - IF(N.EQ.1)THEN - IF(NX.EQ.NHE)THEN - GO TO 4310 - ELSE - N4=NX+1 - N5=NY - ENDIF - ELSEIF(N.EQ.2)THEN - IF(NY.EQ.NVS)THEN - GO TO 4310 - ELSE - N4=NX - N5=NY+1 - ENDIF - ENDIF -C -C IF NO OVERLAND FLOW THEN NO TRANSPORT -C - IF(QRM(M,N,N5,N4).EQ.0.0)THEN - DO 9840 K=0,2 - RQROC(K,N,N5,N4)=0.0 - RQRON(K,N,N5,N4)=0.0 - RQROP(K,N,N5,N4)=0.0 - RQROA(K,N,N5,N4)=0.0 -9840 CONTINUE - RQRCOS(N,N5,N4)=0.0 - RQRCHS(N,N5,N4)=0.0 - RQROXS(N,N5,N4)=0.0 - RQRNGS(N,N5,N4)=0.0 - RQRN2S(N,N5,N4)=0.0 - RQRHGS(N,N5,N4)=0.0 - RQRNH4(N,N5,N4)=0.0 - RQRNH3(N,N5,N4)=0.0 - RQRNO3(N,N5,N4)=0.0 - RQRNO2(N,N5,N4)=0.0 - RQRH2P(N,N5,N4)=0.0 -C -C IF OVERLAND FLOW IS FROM CURRENT TO ADJACENT GRID CELL -C - ELSEIF(QRM(M,N,N5,N4).GT.0.0)THEN - IF(VOLWM(M,0,N2,N1).GT.ZEROS(N2,N1))THEN - VFLW=AMAX1(0.0,AMIN1(XFRX,QRM(M,N,N5,N4)/VOLWM(M,0,N2,N1))) - ELSE - VFLW=XFRX - ENDIF - DO 9835 K=0,2 - 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)) - RQROA(K,N,N5,N4)=VFLW*AMAX1(0.0,OQA2(K,0,N2,N1)) -9835 CONTINUE - RQRCOS(N,N5,N4)=VFLW*AMAX1(0.0,CO2S2(0,N2,N1)) - RQRCHS(N,N5,N4)=VFLW*AMAX1(0.0,CH4S2(0,N2,N1)) - RQROXS(N,N5,N4)=VFLW*AMAX1(0.0,OXYS2(0,N2,N1)) - RQRNGS(N,N5,N4)=VFLW*AMAX1(0.0,Z2GS2(0,N2,N1)) - RQRN2S(N,N5,N4)=VFLW*AMAX1(0.0,Z2OS2(0,N2,N1)) - RQRHGS(N,N5,N4)=VFLW*AMAX1(0.0,H2GS2(0,N2,N1)) - RQRNH4(N,N5,N4)=VFLW*AMAX1(0.0,ZNH4S2(0,N2,N1)) - RQRNH3(N,N5,N4)=VFLW*AMAX1(0.0,ZN3S2(0,N2,N1)) - RQRNO3(N,N5,N4)=VFLW*AMAX1(0.0,ZNO3S2(0,N2,N1)) - RQRNO2(N,N5,N4)=VFLW*AMAX1(0.0,ZNO2S2(0,N2,N1)) - RQRH2P(N,N5,N4)=VFLW*AMAX1(0.0,H2PO42(0,N2,N1)) -C -C IF OVERLAND FLOW IS TO CURRENT FROM ADJACENT GRID CELL -C - ELSEIF(QRM(M,N,N5,N4).LT.0.0)THEN - IF(VOLWM(M,0,N5,N4).GT.ZEROS(N5,N4))THEN - VFLW=AMIN1(0.0,AMAX1(-XFRX,QRM(M,N,N5,N4)/VOLWM(M,0,N5,N4))) - ELSE - VFLW=-XFRX - ENDIF - DO 9830 K=0,2 - 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)) - RQROA(K,N,N5,N4)=VFLW*AMAX1(0.0,OQA2(K,0,N5,N4)) -9830 CONTINUE - RQRCOS(N,N5,N4)=VFLW*AMAX1(0.0,CO2S2(0,N5,N4)) - RQRCHS(N,N5,N4)=VFLW*AMAX1(0.0,CH4S2(0,N5,N4)) - RQROXS(N,N5,N4)=VFLW*AMAX1(0.0,OXYS2(0,N5,N4)) - RQRNGS(N,N5,N4)=VFLW*AMAX1(0.0,Z2GS2(0,N5,N4)) - RQRN2S(N,N5,N4)=VFLW*AMAX1(0.0,Z2OS2(0,N5,N4)) - RQRHGS(N,N5,N4)=VFLW*AMAX1(0.0,H2GS2(0,N5,N4)) - RQRNH4(N,N5,N4)=VFLW*AMAX1(0.0,ZNH4S2(0,N5,N4)) - RQRNH3(N,N5,N4)=VFLW*AMAX1(0.0,ZN3S2(0,N5,N4)) - RQRNO3(N,N5,N4)=VFLW*AMAX1(0.0,ZNO3S2(0,N5,N4)) - RQRNO2(N,N5,N4)=VFLW*AMAX1(0.0,ZNO2S2(0,N5,N4)) - RQRH2P(N,N5,N4)=VFLW*AMAX1(0.0,H2PO42(0,N5,N4)) - ENDIF -C -C ACCUMULATE HOURLY FLUXES -C - DO 9825 K=0,2 - 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) - XOAQRS(K,N,N5,N4)=XOAQRS(K,N,N5,N4)+RQROA(K,N,N5,N4) -9825 CONTINUE - XCOQRS(N,N5,N4)=XCOQRS(N,N5,N4)+RQRCOS(N,N5,N4) - XCHQRS(N,N5,N4)=XCHQRS(N,N5,N4)+RQRCHS(N,N5,N4) - XOXQRS(N,N5,N4)=XOXQRS(N,N5,N4)+RQROXS(N,N5,N4) - XNGQRS(N,N5,N4)=XNGQRS(N,N5,N4)+RQRNGS(N,N5,N4) - XN2QRS(N,N5,N4)=XN2QRS(N,N5,N4)+RQRN2S(N,N5,N4) - XHGQRS(N,N5,N4)=XHGQRS(N,N5,N4)+RQRHGS(N,N5,N4) - XN4QRW(N,N5,N4)=XN4QRW(N,N5,N4)+RQRNH4(N,N5,N4) - XN3QRW(N,N5,N4)=XN3QRW(N,N5,N4)+RQRNH3(N,N5,N4) - XNOQRW(N,N5,N4)=XNOQRW(N,N5,N4)+RQRNO3(N,N5,N4) - XNXQRS(N,N5,N4)=XNXQRS(N,N5,N4)+RQRNO2(N,N5,N4) - XP4QRW(N,N5,N4)=XP4QRW(N,N5,N4)+RQRH2P(N,N5,N4) -C -C IF NO SNOW DRIFT THEN NO TRANSPORT -C - IF(QSM(M,N,N5,N4).EQ.0.0)THEN - RQSCOS(N,N5,N4)=0.0 - RQSCHS(N,N5,N4)=0.0 - RQSOXS(N,N5,N4)=0.0 - RQSNGS(N,N5,N4)=0.0 - RQSN2S(N,N5,N4)=0.0 - RQSNH4(N,N5,N4)=0.0 - RQSNH3(N,N5,N4)=0.0 - RQSNO3(N,N5,N4)=0.0 - RQSH2P(N,N5,N4)=0.0 -C -C IF DRIFT IS FROM CURRENT TO ADJACENT GRID CELL -C - ELSEIF(QSM(M,N,N5,N4).GT.0.0)THEN - IF(VOLS(N2,N1).GT.ZEROS(N2,N1))THEN - VFLW=AMAX1(0.0,AMIN1(XFRX,QSM(M,N,N5,N4)/VOLS(N2,N1))) - ELSE - VFLW=XFRX - ENDIF - RQSCOS(N,N5,N4)=VFLW*AMAX1(0.0,CO2W2(N2,N1)) - RQSCHS(N,N5,N4)=VFLW*AMAX1(0.0,CH4W2(N2,N1)) - RQSOXS(N,N5,N4)=VFLW*AMAX1(0.0,OXYW2(N2,N1)) - RQSNGS(N,N5,N4)=VFLW*AMAX1(0.0,ZNGW2(N2,N1)) - RQSN2S(N,N5,N4)=VFLW*AMAX1(0.0,ZN2W2(N2,N1)) - RQSNH4(N,N5,N4)=VFLW*AMAX1(0.0,ZN4W2(N2,N1)) - RQSNH3(N,N5,N4)=VFLW*AMAX1(0.0,ZN3W2(N2,N1)) - RQSNO3(N,N5,N4)=VFLW*AMAX1(0.0,ZNOW2(N2,N1)) - RQSH2P(N,N5,N4)=VFLW*AMAX1(0.0,ZHPW2(N2,N1)) -C -C IF DRIFT IS TO CURRENT FROM ADJACENT GRID CELL -C - ELSEIF(QSM(M,N,N5,N4).LT.0.0)THEN - IF(VOLS(N5,N4).GT.ZEROS(N5,N4))THEN - VFLW=AMIN1(0.0,AMAX1(-XFRX,QSM(M,N,N5,N4)/VOLS(N5,N4))) - ELSE - VFLW=-XFRX - ENDIF - RQSCOS(N,N5,N4)=VFLW*AMAX1(0.0,CO2W2(N5,N4)) - RQSCHS(N,N5,N4)=VFLW*AMAX1(0.0,CH4W2(N5,N4)) - RQSOXS(N,N5,N4)=VFLW*AMAX1(0.0,OXYW2(N5,N4)) - RQSNGS(N,N5,N4)=VFLW*AMAX1(0.0,ZNGW2(N5,N4)) - RQSN2S(N,N5,N4)=VFLW*AMAX1(0.0,ZN2W2(N5,N4)) - RQSNH4(N,N5,N4)=VFLW*AMAX1(0.0,ZN4W2(N5,N4)) - RQSNH3(N,N5,N4)=VFLW*AMAX1(0.0,ZN3W2(N5,N4)) - RQSNO3(N,N5,N4)=VFLW*AMAX1(0.0,ZNOW2(N5,N4)) - RQSH2P(N,N5,N4)=VFLW*AMAX1(0.0,ZHPW2(N5,N4)) - ENDIF -C -C ACCUMULATE HOURLY FLUXES -C - XCOQSS(N,N5,N4)=XCOQSS(N,N5,N4)+RQSCOS(N,N5,N4) - XCHQSS(N,N5,N4)=XCHQSS(N,N5,N4)+RQSCHS(N,N5,N4) - XOXQSS(N,N5,N4)=XOXQSS(N,N5,N4)+RQSOXS(N,N5,N4) - XNGQSS(N,N5,N4)=XNGQSS(N,N5,N4)+RQSNGS(N,N5,N4) - XN2QSS(N,N5,N4)=XN2QSS(N,N5,N4)+RQSN2S(N,N5,N4) - XN4QSS(N,N5,N4)=XN4QSS(N,N5,N4)+RQSNH4(N,N5,N4) - XN3QSS(N,N5,N4)=XN3QSS(N,N5,N4)+RQSNH3(N,N5,N4) - XNOQSS(N,N5,N4)=XNOQSS(N,N5,N4)+RQSNO3(N,N5,N4) - XP4QSS(N,N5,N4)=XP4QSS(N,N5,N4)+RQSH2P(N,N5,N4) -C IF(I.EQ.118.AND.NX.EQ.3.AND.NY.EQ.4)THEN -C WRITE(*,6969)'XOXQSS',I,J,N4,N5,N,M,MM,XOXQSS(N,N5,N4) -C 2,RQSOXS(N,N5,N4),VFLW,OXYW2(N2,N1),OXYW2(N5,N4) -C 3,QSM(M,N,N5,N4),VOLS(N2,N1),VOLS(N5,N4) -6969 FORMAT(A8,7I4,20E12.4) -C ENDIF -4310 CONTINUE - ENDIF -C -C VOLATILIZATION-DISSOLUTION OF GASES IN RESIDUE AND SOIL SURFACE -C LAYERS FROM GASEOUS CONCENTRATIONS VS. THEIR AQUEOUS -C EQUIVALENTS DEPENDING ON SOLUBILITY FROM 'HOUR1' -C AND TRANSFER COEFFICIENT 'DFGS' FROM 'WATSUB' -C - IF(VOLWM(M,0,NY,NX).GT.ZEROS(NY,NX))THEN - CO2G0=CCO2G(0,NY,NX)*VOLPM(M,0,NY,NX) - CH4G0=CCH4G(0,NY,NX)*VOLPM(M,0,NY,NX) - OXYG0=COXYG(0,NY,NX)*VOLPM(M,0,NY,NX) - Z2GG0=CZ2GG(0,NY,NX)*VOLPM(M,0,NY,NX) - Z2OG0=CZ2OG(0,NY,NX)*VOLPM(M,0,NY,NX) - ZN3G0=CNH3G(0,NY,NX)*VOLPM(M,0,NY,NX) - H2GG0=CH2GG(0,NY,NX)*VOLPM(M,0,NY,NX) - VOLCOR(NY,NX)=VOLWCO(0,NY,NX)+VOLPM(M,0,NY,NX) - VOLCHR(NY,NX)=VOLWCH(0,NY,NX)+VOLPM(M,0,NY,NX) - VOLOXR(NY,NX)=VOLWOX(0,NY,NX)+VOLPM(M,0,NY,NX) - VOLNGR(NY,NX)=VOLWNG(0,NY,NX)+VOLPM(M,0,NY,NX) - VOLN2R(NY,NX)=VOLWN2(0,NY,NX)+VOLPM(M,0,NY,NX) - VOLN3R(NY,NX)=VOLWN3(0,NY,NX)+VOLPM(M,0,NY,NX) - VOLHGR(NY,NX)=VOLWHG(0,NY,NX)+VOLPM(M,0,NY,NX) - RCODFG(0,NY,NX)=DFGS(M,0,NY,NX) - 2*(AMAX1(ZEROS(NY,NX),CO2G0)*VOLWCO(0,NY,NX) - 3-AMAX1(ZEROS(NY,NX),CO2S2(0,NY,NX)+RCODXR) - 4*VOLPM(M,0,NY,NX))/VOLCOR(NY,NX) - RCHDFG(0,NY,NX)=DFGS(M,0,NY,NX) - 2*(AMAX1(ZEROS(NY,NX),CH4G0)*VOLWCH(0,NY,NX) - 3-AMAX1(ZEROS(NY,NX),CH4S2(0,NY,NX)+RCHDXR) - 4*VOLPM(M,0,NY,NX))/VOLCHR(NY,NX) - ROXDFG(0,NY,NX)=DFGS(M,0,NY,NX) - 2*(AMAX1(ZEROS(NY,NX),OXYG0)*VOLWOX(0,NY,NX) - 3-AMAX1(ZEROS(NY,NX),OXYS2(0,NY,NX)+ROXDXR) - 4*VOLPM(M,0,NY,NX))/VOLOXR(NY,NX) - RNGDFG(0,NY,NX)=DFGS(M,0,NY,NX) - 2*(AMAX1(ZEROS(NY,NX),Z2GG0)*VOLWNG(0,NY,NX) - 3-AMAX1(ZEROS(NY,NX),Z2GS2(0,NY,NX)+RNGDXR) - 4*VOLPM(M,0,NY,NX))/VOLNGR(NY,NX) - RN2DFG(0,NY,NX)=DFGS(M,0,NY,NX) - 2*(AMAX1(ZEROS(NY,NX),Z2OG0)*VOLWN2(0,NY,NX) - 3-AMAX1(ZEROS(NY,NX),Z2OS2(0,NY,NX)+RN2DXR) - 4*VOLPM(M,0,NY,NX))/VOLN2R(NY,NX) - RN3DFG(0,NY,NX)=DFGS(M,0,NY,NX) - 2*(AMAX1(ZEROS(NY,NX),ZN3G0)*VOLWN3(0,NY,NX) - 3-AMAX1(ZEROS(NY,NX),ZN3S2(0,NY,NX)+RN3DXR) - 4*VOLPM(M,0,NY,NX))/VOLN3R(NY,NX) - CNH3S0=AMAX1(0.0,(ZN3S2(0,NY,NX)+RN3DFG(0,NY,NX))) - 2/VOLWXA(0,NY,NX) - CNH4S0=AMAX1(0.0,ZNH4S2(0,NY,NX)) - 2/VOLWXA(0,NY,NX) - RN34SQ(0,NY,NX)=VOLWXA(0,NY,NX) - 2*(CHY0(0,NY,NX)*CNH3S0-DPN4*CNH4S0)/(DPN4+CHY0(0,NY,NX)) - RHGDFG(0,NY,NX)=DFGS(M,0,NY,NX) - 2*(AMAX1(ZEROS(NY,NX),H2GG0)*VOLWHG(0,NY,NX) - 3-AMAX1(ZEROS(NY,NX),H2GS2(0,NY,NX)+RHGDXR) - 4*VOLPM(M,0,NY,NX))/VOLHGR(NY,NX) -C IF(I.EQ.87)THEN -C WRITE(*,323)'RCHDFG',I,J,NX,NY,M,MM,RCHDFG(0,NY,NX) -C 2,DFGS(M,0,NY,NX),CH4G0,VOLWCH(0,NY,NX),CH4S2(0,NY,NX) -C 3,VOLPM(M,0,NY,NX),VOLCHR(NY,NX),RCHDXR -C WRITE(*,323)'ROXDFG',I,J,NX,NY,M,MM,ROXDFG(0,NY,NX) -C 2,DFGS(M,0,NY,NX),OXYG0,VOLWOX(0,NY,NX),OXYS2(0,NY,NX) -C 3,VOLPM(M,0,NY,NX),VOLOXR(NY,NX),ROXDXR -323 FORMAT(A8,6I4,30E12.4) -C ENDIF -C -C ACCUMULATE HOURLY FLUXES -C - XCODFG(0,NY,NX)=XCODFG(0,NY,NX)+RCODFG(0,NY,NX) - XCHDFG(0,NY,NX)=XCHDFG(0,NY,NX)+RCHDFG(0,NY,NX) - XOXDFG(0,NY,NX)=XOXDFG(0,NY,NX)+ROXDFG(0,NY,NX) - XNGDFG(0,NY,NX)=XNGDFG(0,NY,NX)+RNGDFG(0,NY,NX) - XN2DFG(0,NY,NX)=XN2DFG(0,NY,NX)+RN2DFG(0,NY,NX) - XN3DFG(0,NY,NX)=XN3DFG(0,NY,NX)+RN3DFG(0,NY,NX) - XN34SQ(0,NY,NX)=XN34SQ(0,NY,NX)+RN34SQ(0,NY,NX) - XHGDFG(0,NY,NX)=XHGDFG(0,NY,NX)+RHGDFG(0,NY,NX) - ELSE - RCODFG(0,NY,NX)=0.0 - RCHDFG(0,NY,NX)=0.0 - ROXDFG(0,NY,NX)=0.0 - RNGDFG(0,NY,NX)=0.0 - RN2DFG(0,NY,NX)=0.0 - RN3DFG(0,NY,NX)=0.0 - RN34SQ(0,NY,NX)=0.0 - RHGDFG(0,NY,NX)=0.0 - ENDIF -C -C SURFACE GAS EXCHANGE FROM GAS DIFFUSIVITY THROUGH -C SOIL SURFACE LAYER AND THROUGH ATMOSPHERE BOUNDARY -C LAYER -C - IF(THETPM(M,NU(NY,NX),NY,NX).GT.THETX - 2.AND.BKDS(NU(NY,NX),NY,NX).GT.0.0)THEN -C -C GASEOUS DIFFUSIVITIES -C - DFLG2=AMAX1(0.0,THETPM(M,NU(NY,NX),NY,NX))**2 - 2/POROQ(NU(NY,NX),NY,NX)*AREA(3,NU(NY,NX),NY,NX) - 3/AMAX1(0.001,DLYR(3,NU(NY,NX),NY,NX)) - DCO2G(3,NU(NY,NX),NY,NX)=DFLG2*CGSGL2(NU(NY,NX),NY,NX) - DCH4G(3,NU(NY,NX),NY,NX)=DFLG2*CHSGL2(NU(NY,NX),NY,NX) - DOXYG(3,NU(NY,NX),NY,NX)=DFLG2*OGSGL2(NU(NY,NX),NY,NX) - DZ2GG(3,NU(NY,NX),NY,NX)=DFLG2*ZGSGL2(NU(NY,NX),NY,NX) - DZ2OG(3,NU(NY,NX),NY,NX)=DFLG2*Z2SGL2(NU(NY,NX),NY,NX) - DNH3G(3,NU(NY,NX),NY,NX)=DFLG2*ZHSGL2(NU(NY,NX),NY,NX) - DH2GG(3,NU(NY,NX),NY,NX)=DFLG2*HGSGL2(NU(NY,NX),NY,NX) -C -C SURFACE GAS CONCENTRATIONS -C - CCO2G2=AMAX1(0.0,CO2G2(NU(NY,NX),NY,NX) - 2/VOLPM(M,NU(NY,NX),NY,NX)) - CCH4G2=AMAX1(0.0,CH4G2(NU(NY,NX),NY,NX) - 2/VOLPM(M,NU(NY,NX),NY,NX)) - COXYG2=AMAX1(0.0,OXYG2(NU(NY,NX),NY,NX) - 2/VOLPM(M,NU(NY,NX),NY,NX)) - CZ2GG2=AMAX1(0.0,Z2GG2(NU(NY,NX),NY,NX) - 2/VOLPM(M,NU(NY,NX),NY,NX)) - CZ2OG2=AMAX1(0.0,Z2OG2(NU(NY,NX),NY,NX) - 2/VOLPM(M,NU(NY,NX),NY,NX)) - CNH3G2=AMAX1(0.0,ZN3G2(NU(NY,NX),NY,NX) - 2/VOLPM(M,NU(NY,NX),NY,NX)) - CH2GG2=AMAX1(0.0,H2GG2(NU(NY,NX),NY,NX) - 2/VOLPM(M,NU(NY,NX),NY,NX)) -C -C EQUILIBRIUM CONCENTRATIONS AT SOIL SURFACE AT WHICH -C GASEOUS DIFFUSION THROUGH SOIL SURFACE LAYER = GASEOUS -C DIFFUSION THROUGH ATMOSPHERE BOUNDARY LAYER CALCULATED -C FROM GASEOUS DIFFUSIVITY AND BOUNDARY LAYER CONDUCTANCE -C - DCO2GQ=DCO2G(3,NU(NY,NX),NY,NX)*PARGCO(NY,NX) - 2/(DCO2G(3,NU(NY,NX),NY,NX)+PARGCO(NY,NX)) - DCH4GQ=DCH4G(3,NU(NY,NX),NY,NX)*PARGCH(NY,NX) - 2/(DCH4G(3,NU(NY,NX),NY,NX)+PARGCH(NY,NX)) - DOXYGQ=DOXYG(3,NU(NY,NX),NY,NX)*PARGOX(NY,NX) - 2/(DOXYG(3,NU(NY,NX),NY,NX)+PARGOX(NY,NX)) - DZ2GGQ=DZ2GG(3,NU(NY,NX),NY,NX)*PARGNG(NY,NX) - 2/(DZ2GG(3,NU(NY,NX),NY,NX)+PARGNG(NY,NX)) - DZ2OGQ=DZ2OG(3,NU(NY,NX),NY,NX)*PARGN2(NY,NX) - 2/(DZ2OG(3,NU(NY,NX),NY,NX)+PARGN2(NY,NX)) - DNH3GQ=DNH3G(3,NU(NY,NX),NY,NX)*PARGN3(NY,NX) - 2/(DNH3G(3,NU(NY,NX),NY,NX)+PARGN3(NY,NX)) - DH2GGQ=DH2GG(3,NU(NY,NX),NY,NX)*PARGH2(NY,NX) - 2/(DH2GG(3,NU(NY,NX),NY,NX)+PARGH2(NY,NX)) - DFVCOG=DCO2GQ*(CCO2E(NY,NX)-CCO2G2) - DFVCHG=DCH4GQ*(CCH4E(NY,NX)-CCH4G2) - DFVOXG=DOXYGQ*(COXYE(NY,NX)-COXYG2) - DFVNGG=DZ2GGQ*(CZ2GE(NY,NX)-CZ2GG2) - DFVN2G=DZ2OGQ*(CZ2OE(NY,NX)-CZ2OG2) - DFVN3G=DNH3GQ*(CNH3E(NY,NX)-CNH3G2) - DFVHGG=DH2GGQ*(CH2GE(NY,NX)-CH2GG2) -C -C CONVECTIVE GAS TRANSFER DRIVEN BY SURFACE WATER FLUXES -C FROM 'WATSUB' AND GAS CONCENTRATIONS IN THE SOIL SURFACE -C OR THE ATMOSPHERE DEPENDING ON WATER FLUX DIRECTION -C - IF(FLQM(3,NU(NY,NX),NY,NX).GT.0.0)THEN - IF(VOLPM(M,NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN - VFLW=-AMAX1(0.0,AMIN1(XFRX,FLQM(3,NU(NY,NX),NY,NX) - 2/VOLPM(M,NU(NY,NX),NY,NX))) - ELSE - VFLW=-XFRX - ENDIF - RFLCOG=VFLW*AMAX1(0.0,CO2G2(NU(NY,NX),NY,NX)) - RFLCHG=VFLW*AMAX1(0.0,CH4G2(NU(NY,NX),NY,NX)) - RFLOXG=VFLW*AMAX1(0.0,OXYG2(NU(NY,NX),NY,NX)) - RFLNGG=VFLW*AMAX1(0.0,Z2GG2(NU(NY,NX),NY,NX)) - RFLN2G=VFLW*AMAX1(0.0,Z2OG2(NU(NY,NX),NY,NX)) - RFLN3G=VFLW*AMAX1(0.0,ZN3G2(NU(NY,NX),NY,NX)) - RFLH2G=VFLW*AMAX1(0.0,H2GG2(NU(NY,NX),NY,NX)) - ELSE - RFLCOG=-FLQM(3,NU(NY,NX),NY,NX)*CCO2E(NY,NX) - RFLCHG=-FLQM(3,NU(NY,NX),NY,NX)*CCH4E(NY,NX) - RFLOXG=-FLQM(3,NU(NY,NX),NY,NX)*COXYE(NY,NX) - RFLNGG=-FLQM(3,NU(NY,NX),NY,NX)*CZ2GE(NY,NX) - RFLN2G=-FLQM(3,NU(NY,NX),NY,NX)*CZ2OE(NY,NX) - RFLN3G=-FLQM(3,NU(NY,NX),NY,NX)*CNH3E(NY,NX) - RFLH2G=-FLQM(3,NU(NY,NX),NY,NX)*CH2GE(NY,NX) - ENDIF -C -C SURFACE GAS FLUX FROM DIFFERENCES -C BETWEEN ATMOSPHERIC AND SOIL SURFACE EQUILIBRIUM -C CONCENTRATIONS + CONVECTIVE FLUX -C - RCOFLG(3,NU(NY,NX),NY,NX)=DFVCOG+RFLCOG - RCHFLG(3,NU(NY,NX),NY,NX)=DFVCHG+RFLCHG - ROXFLG(3,NU(NY,NX),NY,NX)=DFVOXG+RFLOXG - RNGFLG(3,NU(NY,NX),NY,NX)=DFVNGG+RFLNGG - RN2FLG(3,NU(NY,NX),NY,NX)=DFVN2G+RFLN2G - RN3FLG(3,NU(NY,NX),NY,NX)=DFVN3G+RFLN3G - RHGFLG(3,NU(NY,NX),NY,NX)=DFVHGG+RFLH2G -C -C ACCUMULATE HOURLY FLUXES -C - XCOFLG(3,NU(NY,NX),NY,NX)=XCOFLG(3,NU(NY,NX),NY,NX) - 2+RCOFLG(3,NU(NY,NX),NY,NX) - XCHFLG(3,NU(NY,NX),NY,NX)=XCHFLG(3,NU(NY,NX),NY,NX) - 2+RCHFLG(3,NU(NY,NX),NY,NX) - XOXFLG(3,NU(NY,NX),NY,NX)=XOXFLG(3,NU(NY,NX),NY,NX) - 2+ROXFLG(3,NU(NY,NX),NY,NX) - XNGFLG(3,NU(NY,NX),NY,NX)=XNGFLG(3,NU(NY,NX),NY,NX) - 2+RNGFLG(3,NU(NY,NX),NY,NX) - XN2FLG(3,NU(NY,NX),NY,NX)=XN2FLG(3,NU(NY,NX),NY,NX) - 2+RN2FLG(3,NU(NY,NX),NY,NX) - XN3FLG(3,NU(NY,NX),NY,NX)=XN3FLG(3,NU(NY,NX),NY,NX) - 2+RN3FLG(3,NU(NY,NX),NY,NX) - XHGFLG(3,NU(NY,NX),NY,NX)=XHGFLG(3,NU(NY,NX),NY,NX) - 2+RHGFLG(3,NU(NY,NX),NY,NX) -C IF(I.EQ.43)THEN -C WRITE(*,3131)'ROXFLG',I,J,NX,NY,M,MM,XOXFLG(3,NU(NY,NX),NY,NX) -C 2,ROXFLG(3,NU(NY,NX),NY,NX),DFVOXG,RFLOXG,COXYE(NY,NX) -C 2,COXYG2,DOXYGQ,OXYG2(NU(NY,NX),NY,NX),FLQM(3,NU(NY,NX),NY,NX) -C 3,VFLW,DOXYG(3,NU(NY,NX),NY,NX),PARGOX(NY,NX) -C 4,THETPM(M,NU(NY,NX),NY,NX),VOLPM(M,NU(NY,NX),NY,NX) -C WRITE(*,3131)'RNGFLG',I,J,NX,NY,M,MM,XNGFLG(3,NU(NY,NX),NY,NX) -C 2,RNGFLG(3,NU(NY,NX),NY,NX),DFVNGG,RFLNGG,CZ2GE(NY,NX) -C 2,CZ2GG2,DZ2GGQ,Z2GG2(NU(NY,NX),NY,NX),FLQM(3,NU(NY,NX),NY,NX) -C 3,VFLW,DZ2GG(3,NU(NY,NX),NY,NX),PARGNG(NY,NX) -C 4,THETPM(M,NU(NY,NX),NY,NX),VOLPM(M,NU(NY,NX),NY,NX) -3131 FORMAT(A8,6I4,30E12.4) -C ENDIF -C -C SOIL SURFACE -C - IF(THETW1(NU(NY,NX),NY,NX).GT.THETY(NU(NY,NX),NY,NX))THEN - VOLCOT(NY,NX)=VOLWCO(NU(NY,NX),NY,NX)+VOLPM(M,NU(NY,NX),NY,NX) - VOLCHT(NY,NX)=VOLWCH(NU(NY,NX),NY,NX)+VOLPM(M,NU(NY,NX),NY,NX) - VOLOXT(NY,NX)=VOLWOX(NU(NY,NX),NY,NX)+VOLPM(M,NU(NY,NX),NY,NX) - VOLNGT(NY,NX)=VOLWNG(NU(NY,NX),NY,NX)+VOLPM(M,NU(NY,NX),NY,NX) - VOLN2T(NY,NX)=VOLWN2(NU(NY,NX),NY,NX)+VOLPM(M,NU(NY,NX),NY,NX) - VOLN3T(NY,NX)=VOLWN3(NU(NY,NX),NY,NX)+VOLPMA(NU(NY,NX),NY,NX) - VOLNBT(NY,NX)=VOLWNB(NU(NY,NX),NY,NX)+VOLPMB(NU(NY,NX),NY,NX) - VOLHGT(NY,NX)=VOLWHG(NU(NY,NX),NY,NX)+VOLPM(M,NU(NY,NX),NY,NX) - RCODFG(NU(NY,NX),NY,NX)=DFGS(M,NU(NY,NX),NY,NX) - 2*(AMAX1(ZEROS(NY,NX),CO2G2(NU(NY,NX),NY,NX)) - 3*VOLWCO(NU(NY,NX),NY,NX)-AMAX1(ZEROS(NY,NX) - 2,CO2S2(NU(NY,NX),NY,NX)+RCODXS) - 4*VOLPM(M,NU(NY,NX),NY,NX))/VOLCOT(NY,NX) - RCHDFG(NU(NY,NX),NY,NX)=DFGS(M,NU(NY,NX),NY,NX) - 2*(AMAX1(ZEROS(NY,NX),CH4G2(NU(NY,NX),NY,NX)) - 3*VOLWCH(NU(NY,NX),NY,NX)-AMAX1(ZEROS(NY,NX) - 2,CH4S2(NU(NY,NX),NY,NX)+RCHDXS) - 4*VOLPM(M,NU(NY,NX),NY,NX))/VOLCHT(NY,NX) - ROXDFG(NU(NY,NX),NY,NX)=DFGS(M,NU(NY,NX),NY,NX) - 2*(AMAX1(ZEROS(NY,NX),OXYG2(NU(NY,NX),NY,NX)) - 3*VOLWOX(NU(NY,NX),NY,NX)-AMAX1(ZEROS(NY,NX) - 2,OXYS2(NU(NY,NX),NY,NX)+ROXDXS) - 4*VOLPM(M,NU(NY,NX),NY,NX))/VOLOXT(NY,NX) - RNGDFG(NU(NY,NX),NY,NX)=DFGS(M,NU(NY,NX),NY,NX) - 2*(AMAX1(ZEROS(NY,NX),Z2GG2(NU(NY,NX),NY,NX)) - 3*VOLWNG(NU(NY,NX),NY,NX)-AMAX1(ZEROS(NY,NX) - 4,Z2GS2(NU(NY,NX),NY,NX)+RNGDXS) - 4*VOLPM(M,NU(NY,NX),NY,NX))/VOLNGT(NY,NX) - RN2DFG(NU(NY,NX),NY,NX)=DFGS(M,NU(NY,NX),NY,NX) - 2*(AMAX1(ZEROS(NY,NX),Z2OG2(NU(NY,NX),NY,NX)) - 3*VOLWN2(NU(NY,NX),NY,NX)-AMAX1(ZEROS(NY,NX) - 2,Z2OS2(NU(NY,NX),NY,NX)+RN2DXS) - 4*VOLPM(M,NU(NY,NX),NY,NX))/VOLN2T(NY,NX) - IF(VOLN3T(NY,NX).GT.ZEROS(NY,NX) - 2.AND.VOLWXA(NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN - RN3DFG(NU(NY,NX),NY,NX)=DFGS(M,NU(NY,NX),NY,NX) - 2*(AMAX1(ZEROS(NY,NX),ZN3G2(NU(NY,NX),NY,NX)) - 3*VOLWN3(NU(NY,NX),NY,NX)-AMAX1(ZEROS(NY,NX) - 4,ZN3S2(NU(NY,NX),NY,NX)+RN3DXS) - 5*VOLPMA(NU(NY,NX),NY,NX))/VOLN3T(NY,NX) - CNH3S0=AMAX1(0.0,(ZN3S2(NU(NY,NX),NY,NX) - 2+RN3DFG(NU(NY,NX),NY,NX))/VOLWXA(NU(NY,NX),NY,NX)) - CNH4S0=AMAX1(0.0,ZNH4S2(NU(NY,NX),NY,NX)) - 2/VOLWXA(NU(NY,NX),NY,NX) - RN34SQ(NU(NY,NX),NY,NX)=VOLWXA(NU(NY,NX),NY,NX) - 2*(CHY0(NU(NY,NX),NY,NX)*CNH3S0-DPN4*CNH4S0) - 3/(DPN4+CHY0(NU(NY,NX),NY,NX)) - ELSE - RN3DFG(NU(NY,NX),NY,NX)=0.0 - RN34SQ(NU(NY,NX),NY,NX)=0.0 - ENDIF - IF(VOLNBT(NY,NX).GT.ZEROS(NY,NX) - 2.AND.VOLWXB(NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN - RNBDFG(NU(NY,NX),NY,NX)=DFGS(M,NU(NY,NX),NY,NX) - 2*(AMAX1(ZEROS(NY,NX),ZN3G2(NU(NY,NX),NY,NX)) - 3*VOLWNB(NU(NY,NX),NY,NX)-AMAX1(ZEROS(NY,NX) - 4,ZNBS2(NU(NY,NX),NY,NX)+RNBDXS) - 5*VOLPMB(NU(NY,NX),NY,NX))/VOLNBT(NY,NX) - CNH3B0=AMAX1(0.0,(ZNBS2(NU(NY,NX),NY,NX) - 2+RNBDFG(NU(NY,NX),NY,NX))/VOLWXB(NU(NY,NX),NY,NX)) - CNH4B0=AMAX1(0.0,ZNH4B2(NU(NY,NX),NY,NX)) - 2/VOLWXB(NU(NY,NX),NY,NX) - RN34BQ(NU(NY,NX),NY,NX)=VOLWXB(NU(NY,NX),NY,NX) - 2*(CHY0(NU(NY,NX),NY,NX)*CNH3B0-DPN4*CNH4B0) - 3/(DPN4+CHY0(NU(NY,NX),NY,NX)) - ELSE - RNBDFG(NU(NY,NX),NY,NX)=0.0 - RN34BQ(NU(NY,NX),NY,NX)=0.0 - ENDIF - RHGDFG(NU(NY,NX),NY,NX)=DFGS(M,NU(NY,NX),NY,NX) - 2*(AMAX1(ZEROS(NY,NX),H2GG2(NU(NY,NX),NY,NX)) - 3*VOLWHG(NU(NY,NX),NY,NX)-AMAX1(ZEROS(NY,NX) - 4,H2GS2(NU(NY,NX),NY,NX)+RHGDXS) - 4*VOLPM(M,NU(NY,NX),NY,NX))/VOLHGT(NY,NX) -C IF(J.EQ.12)THEN -C WRITE(*,323)'RN3FLG',I,J,NX,NY,M,MM,RN3FLG(3,NU(NY,NX),NY,NX) -C 2,DNH3GQ,CNH3E(NY,NX),CNH3G2,FLQM(3,NU(NY,NX),NY,NX),CNH3GV -C 2,CNH3B2,ZNBS2(NU(NY,NX),NY,NX),RNBDFG(NU(NY,NX),NY,NX) -C 3,DFGS(M,NU(NY,NX),NY,NX),ZN3G2B,VOLPMB(NU(NY,NX),NY,NX) -C 4,ZNBS2(NU(NY,NX),NY,NX),VOLWNB(NU(NY,NX),NY,NX) -C 5,VOLWMB,SNH3L(NU(NY,NX),NY,NX) -C WRITE(*,323)'RNGDFG',I,J,NX,NY,M,MM,RNGDFG(NU(NY,NX),NY,NX) -C 2,DFGS(M,NU(NY,NX),NY,NX),Z2GG2(NU(NY,NX),NY,NX) -C 3,VOLWNG(NU(NY,NX),NY,NX),Z2GS2(NU(NY,NX),NY,NX) -C 4,RNGDFS(NY,NX),VOLPM(M,NU(NY,NX),NY,NX),VOLNGT(NY,NX) -C ENDIF -C -C ACCUMULATE HOURLY FLUXES -C - XCODFG(NU(NY,NX),NY,NX)=XCODFG(NU(NY,NX),NY,NX) - 2+RCODFG(NU(NY,NX),NY,NX) - XCHDFG(NU(NY,NX),NY,NX)=XCHDFG(NU(NY,NX),NY,NX) - 2+RCHDFG(NU(NY,NX),NY,NX) - XOXDFG(NU(NY,NX),NY,NX)=XOXDFG(NU(NY,NX),NY,NX) - 2+ROXDFG(NU(NY,NX),NY,NX) - XNGDFG(NU(NY,NX),NY,NX)=XNGDFG(NU(NY,NX),NY,NX) - 2+RNGDFG(NU(NY,NX),NY,NX) - XN2DFG(NU(NY,NX),NY,NX)=XN2DFG(NU(NY,NX),NY,NX) - 2+RN2DFG(NU(NY,NX),NY,NX) - XN3DFG(NU(NY,NX),NY,NX)=XN3DFG(NU(NY,NX),NY,NX) - 2+RN3DFG(NU(NY,NX),NY,NX) - XN34SQ(NU(NY,NX),NY,NX)=XN34SQ(NU(NY,NX),NY,NX) - 2+RN34SQ(NU(NY,NX),NY,NX) - XNBDFG(NU(NY,NX),NY,NX)=XNBDFG(NU(NY,NX),NY,NX) - 2+RNBDFG(NU(NY,NX),NY,NX) - XN34BQ(NU(NY,NX),NY,NX)=XN34BQ(NU(NY,NX),NY,NX) - 2+RN34BQ(NU(NY,NX),NY,NX) - XHGDFG(NU(NY,NX),NY,NX)=XHGDFG(NU(NY,NX),NY,NX) - 2+RHGDFG(NU(NY,NX),NY,NX) -C WRITE(*,3131)'ROXDFG',I,J,NX,NY,M,MM,XOXDFG(NU(NY,NX),NY,NX) -C 2,ROXDFG(NU(NY,NX),NY,NX),DFGS(M,NU(NY,NX),NY,NX) -C 2,AMAX1(ZEROS(NY,NX),OXYG2(NU(NY,NX),NY,NX)) -C 3,VOLWOX(NU(NY,NX),NY,NX),AMAX1(ZEROS(NY,NX) -C 4,OXYS2(NU(NY,NX),NY,NX)),VOLPM(M,NU(NY,NX),NY,NX) - ELSE - RCODFG(NU(NY,NX),NY,NX)=0.0 - RCHDFG(NU(NY,NX),NY,NX)=0.0 - ROXDFG(NU(NY,NX),NY,NX)=0.0 - RNGDFG(NU(NY,NX),NY,NX)=0.0 - RN2DFG(NU(NY,NX),NY,NX)=0.0 - RN3DFG(NU(NY,NX),NY,NX)=0.0 - RN34SQ(NU(NY,NX),NY,NX)=0.0 - RNBDFG(NU(NY,NX),NY,NX)=0.0 - RN34BQ(NU(NY,NX),NY,NX)=0.0 - RHGDFG(NU(NY,NX),NY,NX)=0.0 - ENDIF - ELSE - RCOFLG(3,NU(NY,NX),NY,NX)=0.0 - RCHFLG(3,NU(NY,NX),NY,NX)=0.0 - ROXFLG(3,NU(NY,NX),NY,NX)=0.0 - RNGFLG(3,NU(NY,NX),NY,NX)=0.0 - RN2FLG(3,NU(NY,NX),NY,NX)=0.0 - RN3FLG(3,NU(NY,NX),NY,NX)=0.0 - RHGFLG(3,NU(NY,NX),NY,NX)=0.0 - RCODFG(NU(NY,NX),NY,NX)=0.0 - RCHDFG(NU(NY,NX),NY,NX)=0.0 - ROXDFG(NU(NY,NX),NY,NX)=0.0 - RN2DFG(NU(NY,NX),NY,NX)=0.0 - RNGDFG(NU(NY,NX),NY,NX)=0.0 - RN3DFG(NU(NY,NX),NY,NX)=0.0 - RN34SQ(NU(NY,NX),NY,NX)=0.0 - RNBDFG(NU(NY,NX),NY,NX)=0.0 - RN34BQ(NU(NY,NX),NY,NX)=0.0 - RHGDFG(NU(NY,NX),NY,NX)=0.0 - ENDIF -C -C SOLUTE FLUXES BETWEEN ADJACENT GRID CELLS -C - IFLGB=0 - DO 125 L=1,NL(NY,NX) - N1=NX - N2=NY - N3=L -C -C LOCATE INTERNAL BOUNDARIES BETWEEN ADJACENT GRID CELLS -C - DO 120 N=NCN(N2,N1),3 - IF(N.EQ.1)THEN - IF(NX.EQ.NHE)THEN - GO TO 120 - ELSE - N4=NX+1 - N5=NY - N6=L - ENDIF - ELSEIF(N.EQ.2)THEN - IF(NY.EQ.NVS)THEN - GO TO 120 - ELSE - N4=NX - N5=NY+1 - N6=L - ENDIF - ELSEIF(N.EQ.3)THEN - IF(L.EQ.NL(NY,NX))THEN - GO TO 120 - ELSE - N4=NX - N5=NY - N6=L+1 - ENDIF - ENDIF - IF(N3.GE.NU(N2,N1).AND.N6.GE.NU(N5,N4))THEN - IF(M.NE.MX)THEN -C -C SOLUTE FLUXES BETWEEN ADJACENT GRID CELLS FROM -C WATER CONTENTS AND WATER FLUXES 'FLQM' FROM 'WATSUB' -C - VOLW4A=VOLWM(M,N3,N2,N1)*VLNH4(N3,N2,N1) - VOLW4B=VOLWM(M,N3,N2,N1)*VLNHB(N3,N2,N1) - VOLH4A=VOLWHM(M,N3,N2,N1)*VLNH4(N3,N2,N1) - VOLH4B=VOLWHM(M,N3,N2,N1)*VLNHB(N3,N2,N1) - VOLW3A=VOLWM(M,N3,N2,N1)*VLNO3(N3,N2,N1) - VOLW3B=VOLWM(M,N3,N2,N1)*VLNOB(N3,N2,N1) - VOLH3A=VOLWHM(M,N3,N2,N1)*VLNO3(N3,N2,N1) - VOLH3B=VOLWHM(M,N3,N2,N1)*VLNOB(N3,N2,N1) - VOLW2A=VOLWM(M,N3,N2,N1)*VLPO4(N3,N2,N1) - VOLW2B=VOLWM(M,N3,N2,N1)*VLPOB(N3,N2,N1) - VOLH2A=VOLWHM(M,N3,N2,N1)*VLPO4(N3,N2,N1) - VOLH2B=VOLWHM(M,N3,N2,N1)*VLPOB(N3,N2,N1) - VOLWMA(N6,N5,N4)=VOLWM(M,N6,N5,N4)*VLNH4(N6,N5,N4) - VOLWMB(N6,N5,N4)=VOLWM(M,N6,N5,N4)*VLNHB(N6,N5,N4) - VOLWXA(N6,N5,N4)=14.0*VOLWMA(N6,N5,N4) - VOLWXB(N6,N5,N4)=14.0*VOLWMB(N6,N5,N4) - VOLWOA=VOLWM(M,N6,N5,N4)*VLNO3(N6,N5,N4) - VOLWOB=VOLWM(M,N6,N5,N4)*VLNOB(N6,N5,N4) - VOLHOA=VOLWHM(M,N6,N5,N4)*VLNO3(N6,N5,N4) - VOLHOB=VOLWHM(M,N6,N5,N4)*VLNOB(N6,N5,N4) - VOLWPA=VOLWM(M,N6,N5,N4)*VLPO4(N6,N5,N4) - VOLWPB=VOLWM(M,N6,N5,N4)*VLPOB(N6,N5,N4) - VOLHPA=VOLWHM(M,N6,N5,N4)*VLPO4(N6,N5,N4) - VOLHPB=VOLWHM(M,N6,N5,N4)*VLPOB(N6,N5,N4) - VOLPMA(N6,N5,N4)=VOLPM(M,N6,N5,N4)*VLNH4(N6,N5,N4) - VOLPMB(N6,N5,N4)=VOLPM(M,N6,N5,N4)*VLNHB(N6,N5,N4) - THETW1(N3,N2,N1)=AMAX1(0.0,VOLWM(M,N3,N2,N1)/VOLX(N3,N2,N1)) - THETW1(N6,N5,N4)=AMAX1(0.0,VOLWM(M,N6,N5,N4)/VOLX(N6,N5,N4)) - FLVM(N6,N5,N4)=FLPM(M,N6,N5,N4)*XNPT -C -C GASEOUS SOLUBILITIES -C - IF(N.EQ.3)THEN - VOLWCO(N6,N5,N4)=VOLWM(M,N6,N5,N4)*SCO2L(N6,N5,N4) - VOLWCH(N6,N5,N4)=VOLWM(M,N6,N5,N4)*SCH4L(N6,N5,N4) - VOLWOX(N6,N5,N4)=VOLWM(M,N6,N5,N4)*SOXYL(N6,N5,N4) - VOLWNG(N6,N5,N4)=VOLWM(M,N6,N5,N4)*SN2GL(N6,N5,N4) - VOLWN2(N6,N5,N4)=VOLWM(M,N6,N5,N4)*SN2OL(N6,N5,N4) - VOLWN3(N6,N5,N4)=VOLWMA(N6,N5,N4)*SNH3L(N6,N5,N4) - VOLWNB(N6,N5,N4)=VOLWMB(N6,N5,N4)*SNH3L(N6,N5,N4) - VOLWHG(N6,N5,N4)=VOLWM(M,N6,N5,N4)*SH2GL(N6,N5,N4) - ENDIF - FLQM(N,N6,N5,N4)=(FLWM(M,N,N6,N5,N4)+FLWHM(M,N,N6,N5,N4))*XNPT -C -C SOLUTE TRANSPORT IN MICROPORES -C - IF(FLWM(M,N,N6,N5,N4).GT.0.0)THEN -C -C IF MICROPORE WATER FLUX FROM 'WATSUB' IS FROM CURRENT TO -C ADJACENT GRID CELL THEN CONVECTIVE TRANSPORT IS THE PRODUCT -C OF WATER FLUX AND MICROPORE GAS OR SOLUTE CONCENTRATIONS -C IN CURRENT GRID CELL -C - IF(VOLWM(M,N3,N2,N1).GT.ZEROS(N2,N1))THEN - VFLW=AMAX1(0.0,AMIN1(XFRX,FLWM(M,N,N6,N5,N4) - 2/VOLWM(M,N3,N2,N1))) - ELSE - VFLW=XFRX - ENDIF - DO 9820 K=0,4 - RFLOC(K)=VFLW*AMAX1(0.0,OQC2(K,N3,N2,N1)) - RFLON(K)=VFLW*AMAX1(0.0,OQN2(K,N3,N2,N1)) - RFLOP(K)=VFLW*AMAX1(0.0,OQP2(K,N3,N2,N1)) - RFLOA(K)=VFLW*AMAX1(0.0,OQA2(K,N3,N2,N1)) -9820 CONTINUE - RFLCOS=VFLW*AMAX1(0.0,CO2S2(N3,N2,N1)) - RFLCHS=VFLW*AMAX1(0.0,CH4S2(N3,N2,N1)) - RFLOXS=VFLW*AMAX1(0.0,OXYS2(N3,N2,N1)) - RFLNGS=VFLW*AMAX1(0.0,Z2GS2(N3,N2,N1)) - RFLN2S=VFLW*AMAX1(0.0,Z2OS2(N3,N2,N1)) - RFLHGS=VFLW*AMAX1(0.0,H2GS2(N3,N2,N1)) - RFLNH4=VFLW*AMAX1(0.0,ZNH4S2(N3,N2,N1)) - RFLNH3=VFLW*AMAX1(0.0,ZN3S2(N3,N2,N1)) - RFLNO3=VFLW*AMAX1(0.0,ZNO3S2(N3,N2,N1)) - RFLNO2=VFLW*AMAX1(0.0,ZNO2S2(N3,N2,N1)) - RFLPO4=VFLW*AMAX1(0.0,H2PO42(N3,N2,N1)) - RFLN4B=VFLW*AMAX1(0.0,ZNH4B2(N3,N2,N1)) - RFLN3B=VFLW*AMAX1(0.0,ZNBS2(N3,N2,N1)) - RFLNOB=VFLW*AMAX1(0.0,ZNO3B2(N3,N2,N1)) - RFLN2B=VFLW*AMAX1(0.0,ZNO2B2(N3,N2,N1)) - RFLPOB=VFLW*AMAX1(0.0,H2POB2(N3,N2,N1)) - ELSE -C -C IF MICROPORE WATER FLUX FROM 'WATSUB' IS TO CURRENT FROM -C ADJACENT GRID CELL THEN CONVECTIVE TRANSPORT IS THE PRODUCT -C OF WATER FLUX AND MICROPORE GAS OR SOLUTE CONCENTRATIONS -C IN ADJACENT GRID CELL -C - IF(VOLWM(M,N6,N5,N4).GT.ZEROS(N5,N4))THEN - VFLW=AMIN1(0.0,AMAX1(-XFRX,FLWM(M,N,N6,N5,N4) - 2/VOLWM(M,N6,N5,N4))) - ELSE - VFLW=-XFRX - ENDIF - DO 9815 K=0,4 - RFLOC(K)=VFLW*AMAX1(0.0,OQC2(K,N6,N5,N4)) - RFLON(K)=VFLW*AMAX1(0.0,OQN2(K,N6,N5,N4)) - RFLOP(K)=VFLW*AMAX1(0.0,OQP2(K,N6,N5,N4)) - RFLOA(K)=VFLW*AMAX1(0.0,OQA2(K,N6,N5,N4)) -9815 CONTINUE - RFLCOS=VFLW*AMAX1(0.0,CO2S2(N6,N5,N4)) - RFLCHS=VFLW*AMAX1(0.0,CH4S2(N6,N5,N4)) - RFLOXS=VFLW*AMAX1(0.0,OXYS2(N6,N5,N4)) - RFLNGS=VFLW*AMAX1(0.0,Z2GS2(N6,N5,N4)) - RFLN2S=VFLW*AMAX1(0.0,Z2OS2(N6,N5,N4)) - RFLHGS=VFLW*AMAX1(0.0,H2GS2(N6,N5,N4)) - RFLNH4=VFLW*AMAX1(0.0,ZNH4S2(N6,N5,N4)) - RFLNH3=VFLW*AMAX1(0.0,ZN3S2(N6,N5,N4)) - RFLNO3=VFLW*AMAX1(0.0,ZNO3S2(N6,N5,N4)) - RFLNO2=VFLW*AMAX1(0.0,ZNO2S2(N6,N5,N4)) - RFLPO4=VFLW*AMAX1(0.0,H2PO42(N6,N5,N4)) - RFLN4B=VFLW*AMAX1(0.0,ZNH4B2(N6,N5,N4)) - RFLN3B=VFLW*AMAX1(0.0,ZNBS2(N6,N5,N4)) - RFLNOB=VFLW*AMAX1(0.0,ZNO3B2(N6,N5,N4)) - RFLN2B=VFLW*AMAX1(0.0,ZNO2B2(N6,N5,N4)) - RFLPOB=VFLW*AMAX1(0.0,H2POB2(N6,N5,N4)) - ENDIF -C -C DIFFUSIVE FLUXES OF GASES AND SOLUTES BETWEEN CURRENT AND -C ADJACENT GRID CELL MICROPORES FROM AQUEOUS DIFFUSIVITIES -C AND CONCENTRATION DIFFERENCES -C - IF(THETW1(N3,N2,N1).GT.THETY(N3,N2,N1) - 2.AND.THETW1(N6,N5,N4).GT.THETY(N6,N5,N4))THEN -C -C MICROPORE CONCENTRATIONS FROM WATER-FILLED POROSITY -C IN CURRENT AND ADJACENT GRID CELLS -C - DO 9810 K=0,4 - COQC1(K)=AMAX1(0.0,OQC2(K,N3,N2,N1)/VOLWM(M,N3,N2,N1)) - COQN1(K)=AMAX1(0.0,OQN2(K,N3,N2,N1)/VOLWM(M,N3,N2,N1)) - COQP1(K)=AMAX1(0.0,OQP2(K,N3,N2,N1)/VOLWM(M,N3,N2,N1)) - COQA1(K)=AMAX1(0.0,OQA2(K,N3,N2,N1)/VOLWM(M,N3,N2,N1)) - COQC2(K)=AMAX1(0.0,OQC2(K,N6,N5,N4)/VOLWM(M,N6,N5,N4)) - COQN2(K)=AMAX1(0.0,OQN2(K,N6,N5,N4)/VOLWM(M,N6,N5,N4)) - COQP2(K)=AMAX1(0.0,OQP2(K,N6,N5,N4)/VOLWM(M,N6,N5,N4)) - COQA2(K)=AMAX1(0.0,OQA2(K,N6,N5,N4)/VOLWM(M,N6,N5,N4)) -9810 CONTINUE - CCO2S1=AMAX1(0.0,CO2S2(N3,N2,N1)/VOLWM(M,N3,N2,N1)) - CCH4S1=AMAX1(0.0,CH4S2(N3,N2,N1)/VOLWM(M,N3,N2,N1)) - COXYS1=AMAX1(0.0,OXYS2(N3,N2,N1)/VOLWM(M,N3,N2,N1)) - CZ2GS1=AMAX1(0.0,Z2GS2(N3,N2,N1)/VOLWM(M,N3,N2,N1)) - CZ2OS1=AMAX1(0.0,Z2OS2(N3,N2,N1)/VOLWM(M,N3,N2,N1)) - CH2GS1=AMAX1(0.0,H2GS2(N3,N2,N1)/VOLWM(M,N3,N2,N1)) - IF(VOLW4A.GT.ZEROS(N2,N1))THEN - CNH4S1=AMAX1(0.0,ZNH4S2(N3,N2,N1)/VOLW4A) - CNH3S1=AMAX1(0.0,ZN3S2(N3,N2,N1)/VOLW4A) - ELSE - CNH4S1=0.0 - CNH3S1=0.0 - ENDIF - IF(VOLW3A.GT.ZEROS(N2,N1))THEN - CNO3S1=AMAX1(0.0,ZNO3S2(N3,N2,N1)/VOLW3A) - CNO2S1=AMAX1(0.0,ZNO2S2(N3,N2,N1)/VOLW3A) - ELSE - CNO3S1=0.0 - CNO2S1=0.0 - ENDIF - IF(VOLW2A.GT.ZEROS(N2,N1))THEN - CPO4S1=AMAX1(0.0,H2PO42(N3,N2,N1)/VOLW2A) - ELSE - CPO4S1=0.0 - ENDIF - IF(VOLW4B.GT.ZEROS(N2,N1))THEN - CNH4B1=AMAX1(0.0,ZNH4B2(N3,N2,N1)/VOLW4B) - CNH3B1=AMAX1(0.0,ZNBS2(N3,N2,N1)/VOLW4B) - ELSE - CNH4B1=0.0 - CNH3B1=0.0 - ENDIF - IF(VOLW3B.GT.ZEROS(N2,N1))THEN - CNO3B1=AMAX1(0.0,ZNO3B2(N3,N2,N1)/VOLW3B) - CNO2B1=AMAX1(0.0,ZNO2B2(N3,N2,N1)/VOLW3B) - ELSE - CNO3B1=CNO3S1 - CNO2B1=CNO2S1 - ENDIF - IF(VOLW2B.GT.ZEROS(N2,N1))THEN - CPO4B1=AMAX1(0.0,H2POB2(N3,N2,N1)/VOLW2B) - ELSE - CPO4B1=CPO4S1 - ENDIF - CCO2S2=AMAX1(0.0,CO2S2(N6,N5,N4)/VOLWM(M,N6,N5,N4)) - CCH4S2=AMAX1(0.0,CH4S2(N6,N5,N4)/VOLWM(M,N6,N5,N4)) - COXYS2=AMAX1(0.0,OXYS2(N6,N5,N4)/VOLWM(M,N6,N5,N4)) - CZ2GS2=AMAX1(0.0,Z2GS2(N6,N5,N4)/VOLWM(M,N6,N5,N4)) - CZ2OS2=AMAX1(0.0,Z2OS2(N6,N5,N4)/VOLWM(M,N6,N5,N4)) - CH2GS2=AMAX1(0.0,H2GS2(N6,N5,N4)/VOLWM(M,N6,N5,N4)) - IF(VOLWMA(N6,N5,N4).GT.ZEROS(N5,N4))THEN - CNH3S2=AMAX1(0.0,ZN3S2(N6,N5,N4)/VOLWMA(N6,N5,N4)) - CNH4S2=AMAX1(0.0,ZNH4S2(N6,N5,N4)/VOLWMA(N6,N5,N4)) - ELSE - CNH3S2=0.0 - CNH4S2=0.0 - ENDIF - IF(VOLWOA.GT.ZEROS(N5,N4))THEN - CNO3S2=AMAX1(0.0,ZNO3S2(N6,N5,N4)/VOLWOA) - CNO2S2=AMAX1(0.0,ZNO2S2(N6,N5,N4)/VOLWOA) - ELSE - CNO3S2=0.0 - CNO2S2=0.0 - ENDIF - IF(VOLWPA.GT.ZEROS(N5,N4))THEN - CPO4S2=AMAX1(0.0,H2PO42(N6,N5,N4)/VOLWPA) - ELSE - CPO4S2=0.0 - ENDIF - IF(VOLWMB(N6,N5,N4).GT.ZEROS(N5,N4))THEN - CNH3B2=AMAX1(0.0,ZNBS2(N6,N5,N4)/VOLWMB(N6,N5,N4)) - CNH4B2=AMAX1(0.0,ZNH4B2(N6,N5,N4)/VOLWMB(N6,N5,N4)) - ELSE - CNH3B2=CNH3S2 - CNH4B2=CNH4S2 - ENDIF - IF(VOLWOB.GT.ZEROS(N5,N4))THEN - CNO3B2=AMAX1(0.0,ZNO3B2(N6,N5,N4)/VOLWOB) - CNO2B2=AMAX1(0.0,ZNO2B2(N6,N5,N4)/VOLWOB) - ELSE - CNO3B2=CNO3S2 - CNO2B2=CNO2S2 - ENDIF - IF(VOLWPB.GT.ZEROS(N5,N4))THEN - CPO4B2=AMAX1(0.0,H2POB2(N6,N5,N4)/VOLWPB) - ELSE - CPO4B2=CPO4S2 - ENDIF -C -C DIFFUSIVITIES IN CURRENT AND ADJACENT GRID CELL MICROPORES -C - TORTL=(TORT(N3,N2,N1)*DLYR(N,N3,N2,N1) - 2+TORT(N6,N5,N4)*DLYR(N,N6,N5,N4)) - 3/(DLYR(N,N3,N2,N1)+DLYR(N,N6,N5,N4))*(1.0-FMPR(N6,N5,N4)) - DISPN=DISP(N,N6,N5,N4)*ABS(FLWM(M,N,N6,N5,N4)/AREA(N,N6,N5,N4)) - XDPTHM=XDPTH(N,N6,N5,N4)*(1.0-FMPR(N6,N5,N4)) - DIFOC=(OCSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTHM - DIFON=(ONSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTHM - DIFOP=(OPSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTHM - DIFOA=(OASGL2(N6,N5,N4)*TORTL+DISPN)*XDPTHM - DIFNH=(ZNSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTHM - DIFNO=(ZOSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTHM - DIFPO=(POSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTHM - DIFCS=(CLSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTHM - DIFCQ=(CQSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTHM - DIFOS=(OLSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTHM - DIFNG=(ZLSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTHM - DIFN2=(ZVSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTHM - DIFHG=(HLSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTHM -C -C DIFFUSIVE FLUXES BETWEEN CURRENT AND ADJACENT GRID CELL -C MICROPORES -C - DO 9805 K=0,4 - DFVOC(K)=DIFOC*(COQC1(K)-COQC2(K)) - DFVON(K)=DIFON*(COQN1(K)-COQN2(K)) - DFVOP(K)=DIFOP*(COQP1(K)-COQP2(K)) - DFVOA(K)=DIFOA*(COQA1(K)-COQA2(K)) -9805 CONTINUE - DFVCOS=DIFCS*(CCO2S1-CCO2S2) - DFVCHS=DIFCQ*(CCH4S1-CCH4S2) - DFVOXS=DIFOS*(COXYS1-COXYS2) - DFVNGS=DIFNG*(CZ2GS1-CZ2GS2) - DFVN2S=DIFN2*(CZ2OS1-CZ2OS2) - DFVHGS=DIFHG*(CH2GS1-CH2GS2) - DFVNH4=DIFNH*(CNH4S1-CNH4S2)*AMIN1(VLNH4(N3,N2,N1) - 2,VLNH4(N6,N5,N4)) - DFVNH3=DIFNH*(CNH3S1-CNH3S2)*AMIN1(VLNH4(N3,N2,N1) - 2,VLNH4(N6,N5,N4)) - DFVNO3=DIFNO*(CNO3S1-CNO3S2)*AMIN1(VLNO3(N3,N2,N1) - 2,VLNO3(N6,N5,N4)) - DFVNO2=DIFNO*(CNO2S1-CNO2S2)*AMIN1(VLNO3(N3,N2,N1) - 2,VLNO3(N6,N5,N4)) - DFVPO4=DIFPO*(CPO4S1-CPO4S2)*AMIN1(VLPO4(N3,N2,N1) - 2,VLPO4(N6,N5,N4)) - DFVN4B=DIFNH*(CNH4B1-CNH4B2)*AMIN1(VLNHB(N3,N2,N1) - 2,VLNHB(N6,N5,N4)) - DFVN3B=DIFNH*(CNH3B1-CNH3B2)*AMIN1(VLNHB(N3,N2,N1) - 2,VLNHB(N6,N5,N4)) - DFVNOB=DIFNO*(CNO3B1-CNO3B2)*AMIN1(VLNOB(N3,N2,N1) - 2,VLNOB(N6,N5,N4)) - DFVN2B=DIFNO*(CNO2B1-CNO2B2)*AMIN1(VLNOB(N3,N2,N1) - 2,VLNOB(N6,N5,N4)) - DFVPOB=DIFPO*(CPO4B1-CPO4B2)*AMIN1(VLPOB(N3,N2,N1) - 2,VLPOB(N6,N5,N4)) - ELSE - DO 9905 K=0,4 - DFVOC(K)=0.0 - DFVON(K)=0.0 - DFVOP(K)=0.0 - DFVOA(K)=0.0 -9905 CONTINUE - DFVCOS=0.0 - DFVCHS=0.0 - DFVOXS=0.0 - DFVNGS=0.0 - DFVN2S=0.0 - DFVHGS=0.0 - DFVNH4=0.0 - DFVNH3=0.0 - DFVNO3=0.0 - DFVNO2=0.0 - DFVPO4=0.0 - DFVN4B=0.0 - DFVN3B=0.0 - DFVNOB=0.0 - DFVN2B=0.0 - DFVPOB=0.0 - ENDIF -C -C SOLUTE TRANSPORT IN MACROPORES -C - IF(FLWHM(M,N,N6,N5,N4).GT.0.0)THEN -C -C IF MACROPORE WATER FLUX FROM 'WATSUB' IS FROM CURRENT TO -C ADJACENT GRID CELL THEN CONVECTIVE TRANSPORT IS THE PRODUCT -C OF WATER FLUX AND MACROPORE SOLUTE CONCENTRATIONS IN CURRENT -C GRID CELL -C - IF(VOLWHM(M,N3,N2,N1).GT.ZEROS(N2,N1))THEN - VFLW=AMAX1(0.0,AMIN1(XFRX,FLWHM(M,N,N6,N5,N4) - 2/VOLWHM(M,N3,N2,N1))) - ELSE - VFLW=XFRX - ENDIF -C -C ACCOUNT FOR OVERLAND TRANSPORT IN THE SURFACE SOIL LAYER -C - IF(N.EQ.3.AND.VOLAH(N6,N5,N4).GT.VOLWHM(M,N6,N5,N4))THEN - DO 9800 K=0,4 - RFHOC(K)=VFLW*AMAX1(0.0,(OQCH2(K,N3,N2,N1) - 2-AMIN1(0.0,ROCFXS(K,NU(N2,N1),N2,N1)))) - RFHON(K)=VFLW*AMAX1(0.0,(OQNH2(K,N3,N2,N1) - 2-AMIN1(0.0,RONFXS(K,NU(N2,N1),N2,N1)))) - RFHOP(K)=VFLW*AMAX1(0.0,(OQPH2(K,N3,N2,N1) - 2-AMIN1(0.0,ROPFXS(K,NU(N2,N1),N2,N1)))) - RFHOA(K)=VFLW*AMAX1(0.0,(OQAH2(K,N3,N2,N1) - 2-AMIN1(0.0,ROAFXS(K,NU(N2,N1),N2,N1)))) -9800 CONTINUE - RFHCOS=VFLW*AMAX1(0.0,(CO2SH2(N3,N2,N1) - 2-AMIN1(0.0,RCOFXS(NU(N2,N1),N2,N1)))) - RFHCHS=VFLW*AMAX1(0.0,(CH4SH2(N3,N2,N1) - 2-AMIN1(0.0,RCHFXS(NU(N2,N1),N2,N1)))) - RFHOXS=VFLW*AMAX1(0.0,(OXYSH2(N3,N2,N1) - 2-AMIN1(0.0,ROXFXS(NU(N2,N1),N2,N1)))) - RFHNGS=VFLW*AMAX1(0.0,(Z2GSH2(N3,N2,N1) - 2-AMIN1(0.0,RNGFXS(NU(N2,N1),N2,N1)))) - RFHN2S=VFLW*AMAX1(0.0,(Z2OSH2(N3,N2,N1) - 2-AMIN1(0.0,RN2FXS(NU(N2,N1),N2,N1)))) - RFHHGS=VFLW*AMAX1(0.0,(H2GSH2(N3,N2,N1) - 2-AMIN1(0.0,RHGFXS(NU(N2,N1),N2,N1)))) - RFHNH4=VFLW*AMAX1(0.0,(ZNH4H2(N3,N2,N1) - 2-AMIN1(0.0,RN4FXW(NU(N2,N1),N2,N1)*VLNH4(N3,N2,N1)))) - 3*VLNH4(N6,N5,N4) - RFHNH3=VFLW*AMAX1(0.0,(ZNH3H2(N3,N2,N1) - 2-AMIN1(0.0,RN3FXW(NU(N2,N1),N2,N1)*VLNH4(N3,N2,N1)))) - 3*VLNH4(N6,N5,N4) - RFHNO3=VFLW*AMAX1(0.0,(ZNO3H2(N3,N2,N1) - 2-AMIN1(0.0,RNOFXW(NU(N2,N1),N2,N1)*VLNO3(N3,N2,N1)))) - 3*VLNO3(N6,N5,N4) - RFHNO2=VFLW*AMAX1(0.0,(ZNO2H2(N3,N2,N1) - 2-AMIN1(0.0,RNXFXS(NU(N2,N1),N2,N1)*VLNO3(N3,N2,N1)))) - 3*VLNO3(N6,N5,N4) - RFHPO4=VFLW*AMAX1(0.0,(H2P4H2(N3,N2,N1) - 2-AMIN1(0.0,RH2PXS(NU(N2,N1),N2,N1)*VLPO4(N3,N2,N1)))) - 3*VLPO4(N6,N5,N4) - RFHN4B=VFLW*AMAX1(0.0,(ZN4BH2(N3,N2,N1) - 2-AMIN1(0.0,RN4FXB(NU(N2,N1),N2,N1)*VLNHB(N3,N2,N1)))) - 3*VLNHB(N6,N5,N4) - RFHN3B=VFLW*AMAX1(0.0,(ZN3BH2(N3,N2,N1) - 2-AMIN1(0.0,RN3FXB(NU(N2,N1),N2,N1)*VLNHB(N3,N2,N1)))) - 3*VLNHB(N6,N5,N4) - RFHNOB=VFLW*AMAX1(0.0,(ZNOBH2(N3,N2,N1) - 2-AMIN1(0.0,RNOFXB(NU(N2,N1),N2,N1)*VLNOB(N3,N2,N1)))) - 3*VLNOB(N6,N5,N4) - RFHN2B=VFLW*AMAX1(0.0,(ZN2BH2(N3,N2,N1) - 2-AMIN1(0.0,RNXFXB(NU(N2,N1),N2,N1)*VLNOB(N3,N2,N1)))) - 3*VLNOB(N6,N5,N4) - RFHPOB=VFLW*AMAX1(0.0,(H2PBH2(N3,N2,N1) - 2-AMIN1(0.0,RH2BXB(NU(N2,N1),N2,N1)*VLPOB(N3,N2,N1)))) - 3*VLPOB(N6,N5,N4) -C -C IF NOT IN THE SURFACE LAYER -C - ELSE - DO 9850 K=0,4 - RFHOC(K)=VFLW*AMAX1(0.0,OQCH2(K,N3,N2,N1)) - RFHON(K)=VFLW*AMAX1(0.0,OQNH2(K,N3,N2,N1)) - RFHOP(K)=VFLW*AMAX1(0.0,OQPH2(K,N3,N2,N1)) - RFHOA(K)=VFLW*AMAX1(0.0,OQAH2(K,N3,N2,N1)) -9850 CONTINUE - RFHCOS=VFLW*AMAX1(0.0,CO2SH2(N3,N2,N1)) - RFHCHS=VFLW*AMAX1(0.0,CH4SH2(N3,N2,N1)) - RFHOXS=VFLW*AMAX1(0.0,OXYSH2(N3,N2,N1)) - RFHNGS=VFLW*AMAX1(0.0,Z2GSH2(N3,N2,N1)) - RFHN2S=VFLW*AMAX1(0.0,Z2OSH2(N3,N2,N1)) - RFHHGS=VFLW*AMAX1(0.0,H2GSH2(N3,N2,N1)) - RFHNH4=VFLW*AMAX1(0.0,ZNH4H2(N3,N2,N1))*VLNH4(N6,N5,N4) - RFHNH3=VFLW*AMAX1(0.0,ZNH3H2(N3,N2,N1))*VLNH4(N6,N5,N4) - RFHNO3=VFLW*AMAX1(0.0,ZNO3H2(N3,N2,N1))*VLNO3(N6,N5,N4) - RFHNO2=VFLW*AMAX1(0.0,ZNO2H2(N3,N2,N1))*VLNO3(N6,N5,N4) - RFHPO4=VFLW*AMAX1(0.0,H2P4H2(N3,N2,N1))*VLPO4(N6,N5,N4) - RFHN4B=VFLW*AMAX1(0.0,ZN4BH2(N3,N2,N1))*VLNHB(N6,N5,N4) - RFHN3B=VFLW*AMAX1(0.0,ZN3BH2(N3,N2,N1))*VLNHB(N6,N5,N4) - RFHNOB=VFLW*AMAX1(0.0,ZNOBH2(N3,N2,N1))*VLNOB(N6,N5,N4) - RFHN2B=VFLW*AMAX1(0.0,ZN2BH2(N3,N2,N1))*VLNOB(N6,N5,N4) - RFHPOB=VFLW*AMAX1(0.0,H2PBH2(N3,N2,N1))*VLPOB(N6,N5,N4) - ENDIF - ELSEIF(FLWHM(M,N,N6,N5,N4).LT.0.0)THEN -C -C IF MACROPORE WATER FLUX FROM 'WATSUB' IS FROM ADJACENT TO -C CURRENT GRID CELL THEN CONVECTIVE TRANSPORT IS THE PRODUCT -C OF WATER FLUX AND MACROPORE SOLUTE CONCENTRATIONS IN ADJACENT -C GRID CELL -C - IF(VOLWHM(M,N6,N5,N4).GT.ZEROS(N5,N4))THEN - VFLW=AMIN1(0.0,AMAX1(-XFRX,FLWHM(M,N,N6,N5,N4) - 2/VOLWHM(M,N6,N5,N4))) - ELSE - VFLW=-XFRX - ENDIF - DO 9665 K=0,4 - RFHOC(K)=VFLW*AMAX1(0.0,OQCH2(K,N6,N5,N4)) - RFHON(K)=VFLW*AMAX1(0.0,OQNH2(K,N6,N5,N4)) - RFHOP(K)=VFLW*AMAX1(0.0,OQPH2(K,N6,N5,N4)) - RFHOA(K)=VFLW*AMAX1(0.0,OQAH2(K,N6,N5,N4)) -9665 CONTINUE - RFHCOS=VFLW*AMAX1(0.0,CO2SH2(N6,N5,N4)) - RFHCHS=VFLW*AMAX1(0.0,CH4SH2(N6,N5,N4)) - RFHOXS=VFLW*AMAX1(0.0,OXYSH2(N6,N5,N4)) - RFHNGS=VFLW*AMAX1(0.0,Z2GSH2(N6,N5,N4)) - RFHN2S=VFLW*AMAX1(0.0,Z2OSH2(N6,N5,N4)) - RFHHGS=VFLW*AMAX1(0.0,H2GSH2(N6,N5,N4)) - RFHNH4=VFLW*AMAX1(0.0,ZNH4H2(N6,N5,N4))*VLNH4(N6,N5,N4) - RFHNH3=VFLW*AMAX1(0.0,ZNH3H2(N6,N5,N4))*VLNH4(N6,N5,N4) - RFHNO3=VFLW*AMAX1(0.0,ZNO3H2(N6,N5,N4))*VLNO3(N6,N5,N4) - RFHNO2=VFLW*AMAX1(0.0,ZNO2H2(N6,N5,N4))*VLNO3(N6,N5,N4) - RFHPO4=VFLW*AMAX1(0.0,H2P4H2(N6,N5,N4))*VLPO4(N6,N5,N4) - RFHN4B=VFLW*AMAX1(0.0,ZN4BH2(N6,N5,N4))*VLNHB(N6,N5,N4) - RFHN3B=VFLW*AMAX1(0.0,ZN3BH2(N6,N5,N4))*VLNHB(N6,N5,N4) - RFHNOB=VFLW*AMAX1(0.0,ZNOBH2(N6,N5,N4))*VLNOB(N6,N5,N4) - RFHN2B=VFLW*AMAX1(0.0,ZN2BH2(N6,N5,N4))*VLNOB(N6,N5,N4) - RFHPOB=VFLW*AMAX1(0.0,H2PBH2(N6,N5,N4))*VLPOB(N6,N5,N4) - ELSE -C -C NO MACROPORE FLUX -C - DO 9795 K=0,4 - RFHOC(K)=0.0 - RFHON(K)=0.0 - RFHOP(K)=0.0 - RFHOA(K)=0.0 -9795 CONTINUE - RFHCOS=0.0 - RFHCHS=0.0 - RFHOXS=0.0 - RFHNGS=0.0 - RFHN2S=0.0 - RFHHGS=0.0 - RFHNH4=0.0 - RFHNH3=0.0 - RFHNO3=0.0 - RFHNO2=0.0 - RFHPO4=0.0 - RFHN4B=0.0 - RFHN3B=0.0 - RFHNOB=0.0 - RFHN2B=0.0 - RFHPOB=0.0 - ENDIF -C -C DIFFUSIVE FLUXES OF GASES AND SOLUTES BETWEEN CURRENT AND -C ADJACENT GRID CELL MACROPORES FROM AQUEOUS DIFFUSIVITIES -C AND CONCENTRATION DIFFERENCES -C - IF(VOLWHM(M,N3,N2,N1).GT.THETY(N3,N2,N1)*VOLAH(N3,N2,N1) - 2.AND.VOLWHM(M,N6,N5,N4).GT.THETY(N6,N5,N4)*VOLAH(N6,N5,N4))THEN -C -C MACROPORE CONCENTRATIONS IN CURRENT AND ADJACENT GRID CELLS -C - DO 9790 K=0,4 - COQCH1(K)=AMAX1(0.0,OQCH2(K,N3,N2,N1)/VOLWHM(M,N3,N2,N1)) - COQNH1(K)=AMAX1(0.0,OQNH2(K,N3,N2,N1)/VOLWHM(M,N3,N2,N1)) - COQPH1(K)=AMAX1(0.0,OQPH2(K,N3,N2,N1)/VOLWHM(M,N3,N2,N1)) - COQAH1(K)=AMAX1(0.0,OQAH2(K,N3,N2,N1)/VOLWHM(M,N3,N2,N1)) - COQCH2(K)=AMAX1(0.0,OQCH2(K,N6,N5,N4)/VOLWHM(M,N6,N5,N4)) - COQNH2(K)=AMAX1(0.0,OQNH2(K,N6,N5,N4)/VOLWHM(M,N6,N5,N4)) - COQPH2(K)=AMAX1(0.0,OQPH2(K,N6,N5,N4)/VOLWHM(M,N6,N5,N4)) - COQAH2(K)=AMAX1(0.0,OQAH2(K,N6,N5,N4)/VOLWHM(M,N6,N5,N4)) -9790 CONTINUE - CCO2SH1=AMAX1(0.0,CO2SH2(N3,N2,N1)/VOLWHM(M,N3,N2,N1)) - CCH4SH1=AMAX1(0.0,CH4SH2(N3,N2,N1)/VOLWHM(M,N3,N2,N1)) - COXYSH1=AMAX1(0.0,OXYSH2(N3,N2,N1)/VOLWHM(M,N3,N2,N1)) - CZ2GSH1=AMAX1(0.0,Z2GSH2(N3,N2,N1)/VOLWHM(M,N3,N2,N1)) - CZ2OSH1=AMAX1(0.0,Z2OSH2(N3,N2,N1)/VOLWHM(M,N3,N2,N1)) - CH2GSH1=AMAX1(0.0,H2GSH2(N3,N2,N1)/VOLWHM(M,N3,N2,N1)) - IF(VOLH4A.GT.ZEROS(N2,N1))THEN - CNH4SH1=AMAX1(0.0,ZNH4H2(N3,N2,N1)/VOLH4A) - CNH3SH1=AMAX1(0.0,ZNH3H2(N3,N2,N1)/VOLH4A) - ELSE - CNH4SH1=0.0 - CNH3SH1=0.0 - ENDIF - IF(VOLH3A.GT.ZEROS(N2,N1))THEN - CNO3SH1=AMAX1(0.0,ZNO3H2(N3,N2,N1)/VOLH3A) - CNO2SH1=AMAX1(0.0,ZNO2H2(N3,N2,N1)/VOLH3A) - ELSE - CNO3SH1=0.0 - CNO2SH1=0.0 - ENDIF - IF(VOLH2A.GT.ZEROS(N2,N1))THEN - CPO4SH1=AMAX1(0.0,H2P4H2(N3,N2,N1)/VOLH2A) - ELSE - CPO4SH1=0.0 - ENDIF - IF(VOLH4B.GT.ZEROS(N2,N1))THEN - CNH4BH1=AMAX1(0.0,ZN4BH2(N3,N2,N1)/VOLH4B) - CNH3BH1=AMAX1(0.0,ZN3BH2(N3,N2,N1)/VOLH4B) - ELSE - CNH4BH1=CNH4SH1 - CNH3BH1=CNH3SH1 - ENDIF - IF(VOLH3B.GT.ZEROS(N2,N1))THEN - CNO3BH1=AMAX1(0.0,ZNOBH2(N3,N2,N1)/VOLH3B) - CNO2BH1=AMAX1(0.0,ZN2BH2(N3,N2,N1)/VOLH3B) - ELSE - CNO3BH1=CNO3SH1 - CNO2BH1=CNO2SH1 - ENDIF - IF(VOLH2B.GT.ZEROS(N2,N1))THEN - CPO4BH1=AMAX1(0.0,H2PBH2(N3,N2,N1)/VOLH2B) - ELSE - CPO4BH1=CPO4SH1 - ENDIF - CCO2SH2=AMAX1(0.0,CO2SH2(N6,N5,N4)/VOLWHM(M,N6,N5,N4)) - CCH4SH2=AMAX1(0.0,CH4SH2(N6,N5,N4)/VOLWHM(M,N6,N5,N4)) - COXYSH2=AMAX1(0.0,OXYSH2(N6,N5,N4)/VOLWHM(M,N6,N5,N4)) - CZ2GSH2=AMAX1(0.0,Z2GSH2(N6,N5,N4)/VOLWHM(M,N6,N5,N4)) - CZ2OSH2=AMAX1(0.0,Z2OSH2(N6,N5,N4)/VOLWHM(M,N6,N5,N4)) - CH2GSH2=AMAX1(0.0,H2GSH2(N6,N5,N4)/VOLWHM(M,N6,N5,N4)) - VOLHMA=VOLWHM(M,N6,N5,N4)*VLNH4(N6,N5,N4) - IF(VOLHMA.GT.ZEROS(N5,N4))THEN - CNH4SH2=AMAX1(0.0,ZNH4H2(N6,N5,N4)/VOLHMA) - CNH3SH2=AMAX1(0.0,ZNH3H2(N6,N5,N4)/VOLHMA) - ELSE - CNH4SH2=0.0 - CNH3SH2=0.0 - ENDIF - VOLHOA=VOLWHM(M,N6,N5,N4)*VLNO3(N6,N5,N4) - IF(VOLHOA.GT.ZEROS(N5,N4))THEN - CNO3SH2=AMAX1(0.0,ZNO3H2(N6,N5,N4)/VOLHOA) - CNO2SH2=AMAX1(0.0,ZNO2H2(N6,N5,N4)/VOLHOA) - ELSE - CNO3SH2=0.0 - CNO2SH2=0.0 - ENDIF - VOLHPA=VOLWHM(M,N6,N5,N4)*VLPO4(N6,N5,N4) - IF(VOLHPA.GT.ZEROS(N5,N4))THEN - CPO4SH2=AMAX1(0.0,H2P4H2(N6,N5,N4)/VOLHPA) - ELSE - CPO4SH2=0.0 - ENDIF - VOLHMB=VOLWHM(M,N6,N5,N4)*VLNHB(N6,N5,N4) - IF(VOLHMB.GT.ZEROS(N5,N4))THEN - CNH4BH2=AMAX1(0.0,ZN4BH2(N6,N5,N4)/VOLHMB) - CNH3BH2=AMAX1(0.0,ZN3BH2(N6,N5,N4)/VOLHMB) - ELSE - CNH4BH2=CNH4SH2 - CNH3BH2=CNH3SH2 - ENDIF - VOLHOB=VOLWHM(M,N6,N5,N4)*VLNOB(N6,N5,N4) - IF(VOLHOB.GT.ZEROS(N5,N4))THEN - CNO3BH2=AMAX1(0.0,ZNOBH2(N6,N5,N4)/VOLHOB) - CNO2BH2=AMAX1(0.0,ZN2BH2(N6,N5,N4)/VOLHOB) - ELSE - CNO3BH2=CNO3SH2 - CNO2BH2=CNO2SH2 - ENDIF - VOLHPB=VOLWHM(M,N6,N5,N4)*VLPOB(N6,N5,N4) - IF(VOLHPB.GT.ZEROS(N5,N4))THEN - CPO4BH2=AMAX1(0.0,H2PBH2(N6,N5,N4)/VOLHPB) - ELSE - CPO4BH2=CPO4SH2 - ENDIF -C -C DIFFUSIVITIES IN CURRENT AND ADJACENT GRID CELL MACROPORES -C - TORTL=(TORTH(N3,N2,N1)*DLYR(N,N3,N2,N1) - 2+TORTH(N6,N5,N4)*DLYR(N,N6,N5,N4)) - 3/(DLYR(N,N3,N2,N1)+DLYR(N,N6,N5,N4)) - DISPN=DISP(N,N6,N5,N4)*ABS(FLWHM(M,N,N6,N5,N4)/AREA(N,N6,N5,N4)) - XDPTHM=XDPTH(N,N6,N5,N4)*FHOL(N6,N5,N4) - DIFOC=(OCSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTHM - DIFON=(ONSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTHM - DIFOP=(OPSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTHM - DIFOA=(OASGL2(N6,N5,N4)*TORTL+DISPN)*XDPTHM - DIFNH=(ZNSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTHM - DIFNO=(ZOSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTHM - DIFPO=(POSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTHM - DIFCS=(CLSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTHM - DIFCQ=(CQSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTHM - DIFOS=(OLSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTHM - DIFNG=(ZLSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTHM - DIFN2=(ZVSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTHM - DIFHG=(HLSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTHM -C -C DIFFUSIVE FLUXES BETWEEN CURRENT AND ADJACENT GRID CELL -C MACROPORES -C - DO 9785 K=0,4 - DFHOC(K)=DIFOC*(COQCH1(K)-COQCH2(K)) - DFHON(K)=DIFON*(COQNH1(K)-COQNH2(K)) - DFHOP(K)=DIFOP*(COQPH1(K)-COQPH2(K)) - DFHOA(K)=DIFOA*(COQAH1(K)-COQAH2(K)) -9785 CONTINUE - DFHCOS=DIFCS*(CCO2SH1-CCO2SH2) - DFHCHS=DIFCQ*(CCH4SH1-CCH4SH2) - DFHOXS=DIFOS*(COXYSH1-COXYSH2) - DFHNGS=DIFNG*(CZ2GSH1-CZ2GSH2) - DFHN2S=DIFN2*(CZ2OSH1-CZ2OSH2) - DFHHGS=DIFNH*(CH2GSH1-CH2GSH2) - DFHNH4=DIFNH*(CNH4SH1-CNH4SH2)*AMIN1(VLNH4(N3,N2,N1) - 2,VLNH4(N6,N5,N4)) - DFHNH3=DIFNH*(CNH3SH1-CNH3SH2)*AMIN1(VLNH4(N3,N2,N1) - 2,VLNH4(N6,N5,N4)) - DFHNO3=DIFNO*(CNO3SH1-CNO3SH2)*AMIN1(VLNO3(N3,N2,N1) - 2,VLNO3(N6,N5,N4)) - DFHNO2=DIFNO*(CNO2SH1-CNO2SH2)*AMIN1(VLNO3(N3,N2,N1) - 2,VLNO3(N6,N5,N4)) - DFHPO4=DIFPO*(CPO4SH1-CPO4SH2)*AMIN1(VLPO4(N3,N2,N1) - 2,VLPO4(N6,N5,N4)) - DFHN4B=DIFNH*(CNH4BH1-CNH4BH2)*AMIN1(VLNHB(N3,N2,N1) - 2,VLNHB(N6,N5,N4)) - DFHN3B=DIFNH*(CNH3BH1-CNH3BH2)*AMIN1(VLNHB(N3,N2,N1) - 2,VLNHB(N6,N5,N4)) - DFHNOB=DIFNO*(CNO3BH1-CNO3BH2)*AMIN1(VLNOB(N3,N2,N1) - 2,VLNOB(N6,N5,N4)) - DFHN2B=DIFNO*(CNO2BH1-CNO2BH2)*AMIN1(VLNOB(N3,N2,N1) - 2,VLNOB(N6,N5,N4)) - DFHPOB=DIFPO*(CPO4BH1-CPO4BH2)*AMIN1(VLPOB(N3,N2,N1) - 2,VLPOB(N6,N5,N4)) - ELSE - DO 9780 K=0,4 - DFHOC(K)=0.0 - DFHON(K)=0.0 - DFHOP(K)=0.0 - DFHOA(K)=0.0 -9780 CONTINUE - DFHCOS=0.0 - DFHCHS=0.0 - DFHOXS=0.0 - DFHNGS=0.0 - DFHN2S=0.0 - DFHHGS=0.0 - DFHNH4=0.0 - DFHNH3=0.0 - DFHNO3=0.0 - DFHNO2=0.0 - DFHPO4=0.0 - DFHN4B=0.0 - DFHN3B=0.0 - DFHNOB=0.0 - DFHN2B=0.0 - DFHPOB=0.0 - ENDIF -C -C TOTAL MICROPORE AND MACROPORE SOLUTE TRANSPORT FLUXES BETWEEN -C ADJACENT GRID CELLS = CONVECTIVE + DIFFUSIVE FLUXES -C - DO 9765 K=0,4 - ROCFLS(K,N,N6,N5,N4)=RFLOC(K)+DFVOC(K) - RONFLS(K,N,N6,N5,N4)=RFLON(K)+DFVON(K) - ROPFLS(K,N,N6,N5,N4)=RFLOP(K)+DFVOP(K) - ROAFLS(K,N,N6,N5,N4)=RFLOA(K)+DFVOA(K) - ROCFHS(K,N,N6,N5,N4)=RFHOC(K)+DFHOC(K) - RONFHS(K,N,N6,N5,N4)=RFHON(K)+DFHON(K) - ROPFHS(K,N,N6,N5,N4)=RFHOP(K)+DFHOP(K) - ROAFHS(K,N,N6,N5,N4)=RFHOA(K)+DFHOA(K) -9765 CONTINUE - RCOFLS(N,N6,N5,N4)=RFLCOS+DFVCOS - RCHFLS(N,N6,N5,N4)=RFLCHS+DFVCHS - ROXFLS(N,N6,N5,N4)=RFLOXS+DFVOXS - RNGFLS(N,N6,N5,N4)=RFLNGS+DFVNGS - RN2FLS(N,N6,N5,N4)=RFLN2S+DFVN2S - RHGFLS(N,N6,N5,N4)=RFLHGS+DFVHGS - RN4FLW(N,N6,N5,N4)=RFLNH4+DFVNH4 - RN3FLW(N,N6,N5,N4)=RFLNH3+DFVNH3 - RNOFLW(N,N6,N5,N4)=RFLNO3+DFVNO3 - RNXFLS(N,N6,N5,N4)=RFLNO2+DFVNO2 - RH2PFS(N,N6,N5,N4)=RFLPO4+DFVPO4 - RN4FLB(N,N6,N5,N4)=RFLN4B+DFVN4B - RN3FLB(N,N6,N5,N4)=RFLN3B+DFVN3B - RNOFLB(N,N6,N5,N4)=RFLNOB+DFVNOB - RNXFLB(N,N6,N5,N4)=RFLN2B+DFVN2B - RH2BFB(N,N6,N5,N4)=RFLPOB+DFVPOB - RCOFHS(N,N6,N5,N4)=RFHCOS+DFHCOS - RCHFHS(N,N6,N5,N4)=RFHCHS+DFHCHS - ROXFHS(N,N6,N5,N4)=RFHOXS+DFHOXS - RNGFHS(N,N6,N5,N4)=RFHNGS+DFHNGS - RN2FHS(N,N6,N5,N4)=RFHN2S+DFHN2S - RHGFHS(N,N6,N5,N4)=RFHHGS+DFHHGS - RN4FHW(N,N6,N5,N4)=RFHNH4+DFHNH4 - RN3FHW(N,N6,N5,N4)=RFHNH3+DFHNH3 - RNOFHW(N,N6,N5,N4)=RFHNO3+DFHNO3 - RNXFHS(N,N6,N5,N4)=RFHNO2+DFHNO2 - RH2PHS(N,N6,N5,N4)=RFHPO4+DFHPO4 - RN4FHB(N,N6,N5,N4)=RFHN4B+DFHN4B - RN3FHB(N,N6,N5,N4)=RFHN3B+DFHN3B - RNOFHB(N,N6,N5,N4)=RFHNOB+DFHNOB - RNXFHB(N,N6,N5,N4)=RFHN2B+DFHN2B - RH2BHB(N,N6,N5,N4)=RFHPOB+DFHPOB -C IF(M.NE.MX.AND.I.EQ.22.AND.J.EQ.12.AND.N6.EQ.2)THEN -C WRITE(*,443)'DFVCO2',I,J,NX,NY,L,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)'DFHCO2',I,J,M,MM,N4,N5,N6,N -C 2,RCOFHS(N,N6,N5,N4),RFHCOS,DFHCOS,DIFCS,CCO2SH1,CCO2SH2 -C 3,VFLW,CO2SH2(N6,N5,N4),VOLWHM(M,N6,N5,N4) -C 4,TORTL,DISPN,XDPTH(N,N6,N5,N4),FHOL(N6,N5,N4) -C WRITE(*,443)'RH2PFS',I,J,NX,NY,L,M,MM,N -C 2,RH2PFS(N,N6,N5,N4),RFLPO4,DFVPO4,DIFPO,CPO4S1,CPO4S2 -C 3,VLPO4(N3,N2,N1),VLPO4(N6,N5,N4),VOLW2A,VOLWPA -C 4,H2PO42(N3,N2,N1),H2PO42(N6,N5,N4) -443 FORMAT(A8,8I4,20E12.4) -C ENDIF -C -C ACCUMULATE HOURLY FLUXES -C - DO 9755 K=0,4 - XOCFLS(K,N,N6,N5,N4)=XOCFLS(K,N,N6,N5,N4)+ROCFLS(K,N,N6,N5,N4) - XONFLS(K,N,N6,N5,N4)=XONFLS(K,N,N6,N5,N4)+RONFLS(K,N,N6,N5,N4) - XOPFLS(K,N,N6,N5,N4)=XOPFLS(K,N,N6,N5,N4)+ROPFLS(K,N,N6,N5,N4) - XOAFLS(K,N,N6,N5,N4)=XOAFLS(K,N,N6,N5,N4)+ROAFLS(K,N,N6,N5,N4) - XOCFHS(K,N,N6,N5,N4)=XOCFHS(K,N,N6,N5,N4)+ROCFHS(K,N,N6,N5,N4) - XONFHS(K,N,N6,N5,N4)=XONFHS(K,N,N6,N5,N4)+RONFHS(K,N,N6,N5,N4) - XOPFHS(K,N,N6,N5,N4)=XOPFHS(K,N,N6,N5,N4)+ROPFHS(K,N,N6,N5,N4) - XOAFHS(K,N,N6,N5,N4)=XOAFHS(K,N,N6,N5,N4)+ROAFHS(K,N,N6,N5,N4) -9755 CONTINUE - XCOFLS(N,N6,N5,N4)=XCOFLS(N,N6,N5,N4)+RCOFLS(N,N6,N5,N4) - XCHFLS(N,N6,N5,N4)=XCHFLS(N,N6,N5,N4)+RCHFLS(N,N6,N5,N4) - XOXFLS(N,N6,N5,N4)=XOXFLS(N,N6,N5,N4)+ROXFLS(N,N6,N5,N4) - XNGFLS(N,N6,N5,N4)=XNGFLS(N,N6,N5,N4)+RNGFLS(N,N6,N5,N4) - XN2FLS(N,N6,N5,N4)=XN2FLS(N,N6,N5,N4)+RN2FLS(N,N6,N5,N4) - XHGFLS(N,N6,N5,N4)=XHGFLS(N,N6,N5,N4)+RHGFLS(N,N6,N5,N4) - XN4FLW(N,N6,N5,N4)=XN4FLW(N,N6,N5,N4)+RN4FLW(N,N6,N5,N4) - XN3FLW(N,N6,N5,N4)=XN3FLW(N,N6,N5,N4)+RN3FLW(N,N6,N5,N4) - XNOFLW(N,N6,N5,N4)=XNOFLW(N,N6,N5,N4)+RNOFLW(N,N6,N5,N4) - XNXFLS(N,N6,N5,N4)=XNXFLS(N,N6,N5,N4)+RNXFLS(N,N6,N5,N4) - XH2PFS(N,N6,N5,N4)=XH2PFS(N,N6,N5,N4)+RH2PFS(N,N6,N5,N4) - XN4FLB(N,N6,N5,N4)=XN4FLB(N,N6,N5,N4)+RN4FLB(N,N6,N5,N4) - XN3FLB(N,N6,N5,N4)=XN3FLB(N,N6,N5,N4)+RN3FLB(N,N6,N5,N4) - XNOFLB(N,N6,N5,N4)=XNOFLB(N,N6,N5,N4)+RNOFLB(N,N6,N5,N4) - XNXFLB(N,N6,N5,N4)=XNXFLB(N,N6,N5,N4)+RNXFLB(N,N6,N5,N4) - XH2BFB(N,N6,N5,N4)=XH2BFB(N,N6,N5,N4)+RH2BFB(N,N6,N5,N4) - XCOFHS(N,N6,N5,N4)=XCOFHS(N,N6,N5,N4)+RCOFHS(N,N6,N5,N4) - XCHFHS(N,N6,N5,N4)=XCHFHS(N,N6,N5,N4)+RCHFHS(N,N6,N5,N4) - XOXFHS(N,N6,N5,N4)=XOXFHS(N,N6,N5,N4)+ROXFHS(N,N6,N5,N4) - XNGFHS(N,N6,N5,N4)=XNGFHS(N,N6,N5,N4)+RNGFHS(N,N6,N5,N4) - XN2FHS(N,N6,N5,N4)=XN2FHS(N,N6,N5,N4)+RN2FHS(N,N6,N5,N4) - XHGFHS(N,N6,N5,N4)=XHGFHS(N,N6,N5,N4)+RHGFHS(N,N6,N5,N4) - XN4FHW(N,N6,N5,N4)=XN4FHW(N,N6,N5,N4)+RN4FHW(N,N6,N5,N4) - XN3FHW(N,N6,N5,N4)=XN3FHW(N,N6,N5,N4)+RN3FHW(N,N6,N5,N4) - XNOFHW(N,N6,N5,N4)=XNOFHW(N,N6,N5,N4)+RNOFHW(N,N6,N5,N4) - XNXFHS(N,N6,N5,N4)=XNXFHS(N,N6,N5,N4)+RNXFHS(N,N6,N5,N4) - XH2PHS(N,N6,N5,N4)=XH2PHS(N,N6,N5,N4)+RH2PHS(N,N6,N5,N4) - XN4FHB(N,N6,N5,N4)=XN4FHB(N,N6,N5,N4)+RN4FHB(N,N6,N5,N4) - XN3FHB(N,N6,N5,N4)=XN3FHB(N,N6,N5,N4)+RN3FHB(N,N6,N5,N4) - XNOFHB(N,N6,N5,N4)=XNOFHB(N,N6,N5,N4)+RNOFHB(N,N6,N5,N4) - XNXFHB(N,N6,N5,N4)=XNXFHB(N,N6,N5,N4)+RNXFHB(N,N6,N5,N4) - XH2BHB(N,N6,N5,N4)=XH2BHB(N,N6,N5,N4)+RH2BHB(N,N6,N5,N4) -C -C MACROPORE-MICROPORE SOLUTE EXCHANGE WITHIN SOIL -C LAYER FROM WATER EXCHANGE IN 'WATSUB' AND -C FROM MACROPORE OR MICROPORE SOLUTE CONCENTRATIONS -C - IF(N.EQ.3)THEN -C -C MACROPORE TO MICROPORE TRANSFER -C - IF(FINHM(M,N6,N5,N4).GT.0.0)THEN - IF(VOLWHM(M,N6,N5,N4).GT.ZEROS(N5,N4))THEN - VFLW=AMAX1(0.0,AMIN1(XFRX,FINHM(M,N6,N5,N4) - 2/VOLWHM(M,N6,N5,N4))) - ELSE - VFLW=XFRX - ENDIF - DO 9970 K=0,4 - RFLOC(K)=VFLW*AMAX1(0.0,OQCH2(K,N6,N5,N4)) - RFLON(K)=VFLW*AMAX1(0.0,OQNH2(K,N6,N5,N4)) - RFLOP(K)=VFLW*AMAX1(0.0,OQPH2(K,N6,N5,N4)) - RFLOA(K)=VFLW*AMAX1(0.0,OQAH2(K,N6,N5,N4)) -9970 CONTINUE - RFLCOS=VFLW*AMAX1(0.0,CO2SH2(N6,N5,N4)) - RFLCHS=VFLW*AMAX1(0.0,CH4SH2(N6,N5,N4)) - RFLOXS=VFLW*AMAX1(0.0,OXYSH2(N6,N5,N4)) - RFLNGS=VFLW*AMAX1(0.0,Z2GSH2(N6,N5,N4)) - RFLN2S=VFLW*AMAX1(0.0,Z2OSH2(N6,N5,N4)) - RFLHGS=VFLW*AMAX1(0.0,H2GSH2(N6,N5,N4)) - RFLNH4=VFLW*AMAX1(0.0,ZNH4H2(N6,N5,N4))*VLNH4(N6,N5,N4) - RFLNH3=VFLW*AMAX1(0.0,ZNH3H2(N6,N5,N4))*VLNH4(N6,N5,N4) - RFLNO3=VFLW*AMAX1(0.0,ZNO3H2(N6,N5,N4))*VLNO3(N6,N5,N4) - RFLNO2=VFLW*AMAX1(0.0,ZNO2H2(N6,N5,N4))*VLNO3(N6,N5,N4) - RFLPO4=VFLW*AMAX1(0.0,H2P4H2(N6,N5,N4))*VLPO4(N6,N5,N4) - RFLN4B=VFLW*AMAX1(0.0,ZN4BH2(N6,N5,N4))*VLNHB(N6,N5,N4) - RFLN3B=VFLW*AMAX1(0.0,ZN3BH2(N6,N5,N4))*VLNHB(N6,N5,N4) - RFLNOB=VFLW*AMAX1(0.0,ZNOBH2(N6,N5,N4))*VLNOB(N6,N5,N4) - RFLN2B=VFLW*AMAX1(0.0,ZN2BH2(N6,N5,N4))*VLNOB(N6,N5,N4) - RFLPOB=VFLW*AMAX1(0.0,H2PBH2(N6,N5,N4))*VLPOB(N6,N5,N4) -C -C MICROPORE TO MACROPORE TRANSFER -C - ELSEIF(FINHM(M,N6,N5,N4).LT.0.0)THEN - IF(VOLWM(M,N6,N5,N4).GT.ZEROS(N5,N4))THEN - VFLW=AMIN1(0.0,AMAX1(-XFRX,FINHM(M,N6,N5,N4) - 2/VOLWM(M,N6,N5,N4))) - ELSE - VFLW=-XFRX - ENDIF - DO 9965 K=0,4 - RFLOC(K)=VFLW*AMAX1(0.0,OQC2(K,N6,N5,N4)) - RFLON(K)=VFLW*AMAX1(0.0,OQN2(K,N6,N5,N4)) - RFLOP(K)=VFLW*AMAX1(0.0,OQP2(K,N6,N5,N4)) - RFLOA(K)=VFLW*AMAX1(0.0,OQA2(K,N6,N5,N4)) -9965 CONTINUE - RFLCOS=VFLW*AMAX1(0.0,CO2S2(N6,N5,N4)) - RFLCHS=VFLW*AMAX1(0.0,CH4S2(N6,N5,N4)) - RFLOXS=VFLW*AMAX1(0.0,OXYS2(N6,N5,N4)) - RFLNGS=VFLW*AMAX1(0.0,Z2GS2(N6,N5,N4)) - RFLN2S=VFLW*AMAX1(0.0,Z2OS2(N6,N5,N4)) - RFLHGS=VFLW*AMAX1(0.0,H2GS2(N6,N5,N4)) - RFLNH4=VFLW*AMAX1(0.0,ZNH4S2(N6,N5,N4))*VLNH4(N6,N5,N4) - RFLNH3=VFLW*AMAX1(0.0,ZN3S2(N6,N5,N4))*VLNH4(N6,N5,N4) - RFLNO3=VFLW*AMAX1(0.0,ZNO3S2(N6,N5,N4))*VLNO3(N6,N5,N4) - RFLNO2=VFLW*AMAX1(0.0,ZNO2S2(N6,N5,N4))*VLNO3(N6,N5,N4) - RFLPO4=VFLW*AMAX1(0.0,H2PO42(N6,N5,N4))*VLPO4(N6,N5,N4) - RFLN4B=VFLW*AMAX1(0.0,ZNH4B2(N6,N5,N4))*VLNHB(N6,N5,N4) - RFLN3B=VFLW*AMAX1(0.0,ZNBS2(N6,N5,N4))*VLNHB(N6,N5,N4) - RFLNOB=VFLW*AMAX1(0.0,ZNO3B2(N6,N5,N4))*VLNOB(N6,N5,N4) - RFLN2B=VFLW*AMAX1(0.0,ZNO2B2(N6,N5,N4))*VLNOB(N6,N5,N4) - RFLPOB=VFLW*AMAX1(0.0,H2POB2(N6,N5,N4))*VLPOB(N6,N5,N4) -C -C NO MACROPORE TO MICROPORE TRANSFER -C - ELSE - DO 9960 K=0,4 - RFLOC(K)=0.0 - RFLON(K)=0.0 - RFLOP(K)=0.0 - RFLOA(K)=0.0 -9960 CONTINUE - RFLCOS=0.0 - RFLCHS=0.0 - RFLOXS=0.0 - RFLNGS=0.0 - RFLN2S=0.0 - RFLHGS=0.0 - RFLNH4=0.0 - RFLNH3=0.0 - RFLNO3=0.0 - RFLNO2=0.0 - RFLPO4=0.0 - RFLN4B=0.0 - RFLN3B=0.0 - RFLNOB=0.0 - RFLN2B=0.0 - RFLPOB=0.0 - ENDIF -C -C DIFFUSIVE FLUXES OF SOLUTES BETWEEN MICROPORES AND -C MACROPORES FROM AQUEOUS DIFFUSIVITIES AND CONCENTRATION 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*(OQCH2(K,N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-OQC2(K,N6,N5,N4)*VOLWHS)/VOLWT - DFVON(K)=XNPX*(OQNH2(K,N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-OQN2(K,N6,N5,N4)*VOLWHS)/VOLWT - DFVOP(K)=XNPX*(OQPH2(K,N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-OQP2(K,N6,N5,N4)*VOLWHS)/VOLWT - DFVOA(K)=XNPX*(OQAH2(K,N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-OQA2(K,N6,N5,N4)*VOLWHS)/VOLWT -9955 CONTINUE - DFVCOS=XNPX*(CO2SH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-CO2S2(N6,N5,N4)*VOLWHS)/VOLWT - DFVCHS=XNPX*(CH4SH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-CH4S2(N6,N5,N4)*VOLWHS)/VOLWT - DFVOXS=XNPX*(OXYSH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-OXYS2(N6,N5,N4)*VOLWHS)/VOLWT - DFVNGS=XNPX*(Z2GSH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-Z2GS2(N6,N5,N4)*VOLWHS)/VOLWT - DFVN2S=XNPX*(Z2OSH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-Z2OS2(N6,N5,N4)*VOLWHS)/VOLWT - DFVHGS=XNPX*(H2GSH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-H2GS2(N6,N5,N4)*VOLWHS)/VOLWT - DFVNH4=XNPX*(ZNH4H2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZNH4S2(N6,N5,N4)*VOLWHS)/VOLWT - 3*VLNH4(N6,N5,N4) - DFVNH3=XNPX*(ZNH3H2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZN3S2(N6,N5,N4)*VOLWHS)/VOLWT - 3*VLNH4(N6,N5,N4) - DFVNO3=XNPX*(ZNO3H2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZNO3S2(N6,N5,N4)*VOLWHS)/VOLWT - 3*VLNO3(N6,N5,N4) - DFVNO2=XNPX*(ZNO2H2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZNO2S2(N6,N5,N4)*VOLWHS)/VOLWT - 3*VLNO3(N6,N5,N4) - DFVPO4=XNPX*(H2P4H2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-H2PO42(N6,N5,N4)*VOLWHS)/VOLWT - 3*VLPO4(N6,N5,N4) - DFVN4B=XNPX*(ZN4BH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZNH4B2(N6,N5,N4)*VOLWHS)/VOLWT - 3*VLNHB(N6,N5,N4) - DFVN3B=XNPX*(ZN3BH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZNBS2(N6,N5,N4)*VOLWHS)/VOLWT - 3*VLNHB(N6,N5,N4) - DFVNOB=XNPX*(ZNOBH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZNO3B2(N6,N5,N4)*VOLWHS)/VOLWT - 3*VLNOB(N6,N5,N4) - DFVN2B=XNPX*(ZN2BH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZNO2B2(N6,N5,N4)*VOLWHS)/VOLWT - 3*VLNOB(N6,N5,N4) - DFVPOB=XNPX*(H2PBH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-H2POB2(N6,N5,N4)*VOLWHS)/VOLWT - 3*VLPOB(N6,N5,N4) - ELSE - DO 9975 K=0,2 - DFVOC(K)=0.0 - DFVON(K)=0.0 - DFVOP(K)=0.0 - DFVOA(K)=0.0 -9975 CONTINUE - DFVCOS=0.0 - DFVCHS=0.0 - DFVOXS=0.0 - DFVNGS=0.0 - DFVN2S=0.0 - DFVHGS=0.0 - DFVNH4=0.0 - DFVNH3=0.0 - DFVNO3=0.0 - DFVNO2=0.0 - DFVPO4=0.0 - DFVN4B=0.0 - DFVN3B=0.0 - DFVNOB=0.0 - DFVN2B=0.0 - DFVPOB=0.0 - ENDIF -C -C TOTAL CONVECTIVE +DIFFUSIVE TRANSFER BETWEEN MACROPOES AND MICROPORES -C - DO 9950 K=0,4 - ROCFXS(K,N6,N5,N4)=RFLOC(K)+DFVOC(K) - 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 - ROXFXS(N6,N5,N4)=RFLOXS+DFVOXS - RNGFXS(N6,N5,N4)=RFLNGS+DFVNGS - RN2FXS(N6,N5,N4)=RFLN2S+DFVN2S - RHGFXS(N6,N5,N4)=RFLHGS+DFVHGS - RN4FXW(N6,N5,N4)=RFLNH4+DFVNH4 - RN3FXW(N6,N5,N4)=RFLNH3+DFVNH3 - RNOFXW(N6,N5,N4)=RFLNO3+DFVNO3 - RNXFXS(N6,N5,N4)=RFLNO2+DFVNO2 - RH2PXS(N6,N5,N4)=RFLPO4+DFVPO4 - RN4FXB(N6,N5,N4)=RFLN4B+DFVN4B - RN3FXB(N6,N5,N4)=RFLN3B+DFVN3B - RNOFXB(N6,N5,N4)=RFLNOB+DFVNOB - RNXFXB(N6,N5,N4)=RFLN2B+DFVN2B - RH2BXB(N6,N5,N4)=RFLPOB+DFVPOB -C -C ACCUMULATE HOURLY FLUXES -C - DO 9945 K=0,4 - XOCFXS(K,N6,N5,N4)=XOCFXS(K,N6,N5,N4)+ROCFXS(K,N6,N5,N4) - XONFXS(K,N6,N5,N4)=XONFXS(K,N6,N5,N4)+RONFXS(K,N6,N5,N4) - XOPFXS(K,N6,N5,N4)=XOPFXS(K,N6,N5,N4)+ROPFXS(K,N6,N5,N4) - XOAFXS(K,N6,N5,N4)=XOAFXS(K,N6,N5,N4)+ROAFXS(K,N6,N5,N4) -9945 CONTINUE - XCOFXS(N6,N5,N4)=XCOFXS(N6,N5,N4)+RCOFXS(N6,N5,N4) - XCHFXS(N6,N5,N4)=XCHFXS(N6,N5,N4)+RCHFXS(N6,N5,N4) - XOXFXS(N6,N5,N4)=XOXFXS(N6,N5,N4)+ROXFXS(N6,N5,N4) - XNGFXS(N6,N5,N4)=XNGFXS(N6,N5,N4)+RNGFXS(N6,N5,N4) - XN2FXS(N6,N5,N4)=XN2FXS(N6,N5,N4)+RN2FXS(N6,N5,N4) - XHGFXS(N6,N5,N4)=XHGFXS(N6,N5,N4)+RHGFXS(N6,N5,N4) - XN4FXW(N6,N5,N4)=XN4FXW(N6,N5,N4)+RN4FXW(N6,N5,N4) - XN3FXW(N6,N5,N4)=XN3FXW(N6,N5,N4)+RN3FXW(N6,N5,N4) - XNOFXW(N6,N5,N4)=XNOFXW(N6,N5,N4)+RNOFXW(N6,N5,N4) - XNXFXS(N6,N5,N4)=XNXFXS(N6,N5,N4)+RNXFXS(N6,N5,N4) - XH2PXS(N6,N5,N4)=XH2PXS(N6,N5,N4)+RH2PXS(N6,N5,N4) - XN4FXB(N6,N5,N4)=XN4FXB(N6,N5,N4)+RN4FXB(N6,N5,N4) - XN3FXB(N6,N5,N4)=XN3FXB(N6,N5,N4)+RN3FXB(N6,N5,N4) - XNOFXB(N6,N5,N4)=XNOFXB(N6,N5,N4)+RNOFXB(N6,N5,N4) - XNXFXB(N6,N5,N4)=XNXFXB(N6,N5,N4)+RNXFXB(N6,N5,N4) - XH2BXB(N6,N5,N4)=XH2BXB(N6,N5,N4)+RH2BXB(N6,N5,N4) -C IF(I.EQ.22.AND.J.EQ.12.AND.N6.EQ.2)THEN -C WRITE(*,7777)'RCOFXS',I,J,M,MM,N4,N5,N6 -C 2,RCOFXS(N6,N5,N4),RFLCOS,DFVCOS,CO2S2(N6,N5,N4) -C 3,CO2SH2(N6,N5,N4),XCOFXS(N6,N5,N4) -7777 FORMAT(A8,7I4,12E12.4) -C ENDIF - ENDIF - ENDIF -C -C GASEOUS TRANSPORT FROM GASEOUS DIFFUSIVITY AND CONCENTRATION -C DIFFERENCES BETWEEN ADJACENT GRID CELLS -C -C -C GASEOUS DIFFUSIVITIES -C - IF(THETPM(M,N3,N2,N1).GT.THETX - 2.AND.THETPM(M,N6,N5,N4).GT.THETX - 3.AND.VOLPM(M,N3,N2,N1).GT.ZEROS(N2,N1) - 4.AND.VOLPM(M,N6,N5,N4).GT.ZEROS(N5,N4))THEN - DFLG2=2.0*AMAX1(0.0,THETPM(M,N3,N2,N1))**2/POROQ(N3,N2,N1) - 2*AREA(N,N3,N2,N1)/DLYR(N,N3,N2,N1) - DFLGL=2.0*AMAX1(0.0,THETPM(M,N6,N5,N4))**2/POROQ(N6,N5,N4) - 2*AREA(N,N6,N5,N4)/DLYR(N,N6,N5,N4) - CNDC1=DFLG2*CGSGL2(N3,N2,N1) - CND41=DFLG2*CHSGL2(N3,N2,N1) - CNDO1=DFLG2*OGSGL2(N3,N2,N1) - CNDG1=DFLG2*ZGSGL2(N3,N2,N1) - CND21=DFLG2*Z2SGL2(N3,N2,N1) - CNDH1=DFLG2*ZHSGL2(N3,N2,N1) - CNHG1=DFLG2*HGSGL2(N3,N2,N1) - CNDC2=DFLGL*CGSGL2(N6,N5,N4) - CND42=DFLGL*CHSGL2(N6,N5,N4) - CNDO2=DFLGL*OGSGL2(N6,N5,N4) - CNDG2=DFLGL*ZGSGL2(N6,N5,N4) - CND22=DFLGL*Z2SGL2(N6,N5,N4) - CNDH2=DFLGL*ZHSGL2(N6,N5,N4) - CNHG2=DFLGL*HGSGL2(N6,N5,N4) -C -C GASOUS CONDUCTANCES -C - DCO2G(N,N6,N5,N4)=(CNDC1*CNDC2)/(CNDC1+CNDC2) - DCH4G(N,N6,N5,N4)=(CND41*CND42)/(CND41+CND42) - DOXYG(N,N6,N5,N4)=(CNDO1*CNDO2)/(CNDO1+CNDO2) - DZ2GG(N,N6,N5,N4)=(CNDG1*CNDG2)/(CNDG1+CNDG2) - DZ2OG(N,N6,N5,N4)=(CND21*CND22)/(CND21+CND22) - DNH3G(N,N6,N5,N4)=(CNDH1*CNDH2)/(CNDH1+CNDH2) - DH2GG(N,N6,N5,N4)=(CNHG1*CNHG2)/(CNHG1+CNHG2) -C -C GASEOUS CONCENTRATIONS FROM AIR-FILLED POROSITY -C IN CURRENT AND ADJACENT GRID CELLS -C - CCO2G1=AMAX1(0.0,CO2G2(N3,N2,N1)/VOLPM(M,N3,N2,N1)) - CCH4G1=AMAX1(0.0,CH4G2(N3,N2,N1)/VOLPM(M,N3,N2,N1)) - COXYG1=AMAX1(0.0,OXYG2(N3,N2,N1)/VOLPM(M,N3,N2,N1)) - CZ2GG1=AMAX1(0.0,Z2GG2(N3,N2,N1)/VOLPM(M,N3,N2,N1)) - CZ2OG1=AMAX1(0.0,Z2OG2(N3,N2,N1)/VOLPM(M,N3,N2,N1)) - CNH3G1=AMAX1(0.0,ZN3G2(N3,N2,N1)/VOLPM(M,N3,N2,N1)) - CH2GG1=AMAX1(0.0,H2GG2(N3,N2,N1)/VOLPM(M,N3,N2,N1)) - CCO2G2=AMAX1(0.0,CO2G2(N6,N5,N4)/VOLPM(M,N6,N5,N4)) - CCH4G2=AMAX1(0.0,CH4G2(N6,N5,N4)/VOLPM(M,N6,N5,N4)) - COXYG2=AMAX1(0.0,OXYG2(N6,N5,N4)/VOLPM(M,N6,N5,N4)) - CZ2GG2=AMAX1(0.0,Z2GG2(N6,N5,N4)/VOLPM(M,N6,N5,N4)) - CZ2OG2=AMAX1(0.0,Z2OG2(N6,N5,N4)/VOLPM(M,N6,N5,N4)) - CNH3G2=AMAX1(0.0,ZN3G2(N6,N5,N4)/VOLPM(M,N6,N5,N4)) - CH2GG2=AMAX1(0.0,H2GG2(N6,N5,N4)/VOLPM(M,N6,N5,N4)) -C -C CONVECTIVE GAS TRANSFER DRIVEN BY SOIL WATER FLUXES -C FROM 'WATSUB' AND GAS CONCENTRATIONS IN THE ADJACENT GRID CELLS -C DEPENDING ON WATER FLUX DIRECTION -C - DFVCOG=DCO2G(N,N6,N5,N4)*(CCO2G1-CCO2G2) - DFVCHG=DCH4G(N,N6,N5,N4)*(CCH4G1-CCH4G2) - DFVOXG=DOXYG(N,N6,N5,N4)*(COXYG1-COXYG2) - DFVNGG=DZ2GG(N,N6,N5,N4)*(CZ2GG1-CZ2GG2) - DFVN2G=DZ2OG(N,N6,N5,N4)*(CZ2OG1-CZ2OG2) - DFVN3G=DNH3G(N,N6,N5,N4)*(CNH3G1-CNH3G2) - DFVHGG=DH2GG(N,N6,N5,N4)*(CH2GG1-CH2GG2) - IF(FLQM(N,N6,N5,N4).GT.0.0)THEN - IF(VOLPM(M,N6,N5,N4).GT.ZEROS(N5,N4))THEN - VFLW=-AMAX1(0.0,AMIN1(XFRX,FLQM(N,N6,N5,N4) - 2/VOLPM(M,N6,N5,N4))) - ELSE - VFLW=-XFRX - ENDIF - RFLCOG=VFLW*AMAX1(0.0,CO2G2(N6,N5,N4)) - RFLCHG=VFLW*AMAX1(0.0,CH4G2(N6,N5,N4)) - RFLOXG=VFLW*AMAX1(0.0,OXYG2(N6,N5,N4)) - RFLNGG=VFLW*AMAX1(0.0,Z2GG2(N6,N5,N4)) - RFLN2G=VFLW*AMAX1(0.0,Z2OG2(N6,N5,N4)) - RFLN3G=VFLW*AMAX1(0.0,ZN3G2(N6,N5,N4)) - RFLH2G=VFLW*AMAX1(0.0,H2GG2(N6,N5,N4)) - ELSE - IF(VOLPM(M,N3,N2,N1).GT.ZEROS(N2,N1))THEN - VFLW=-AMIN1(0.0,AMAX1(-XFRX,FLQM(N,N6,N5,N4) - 2/VOLPM(M,N3,N2,N1))) - ELSE - VFLW=XFRX - ENDIF - RFLCOG=VFLW*AMAX1(0.0,CO2G2(N3,N2,N1)) - RFLCHG=VFLW*AMAX1(0.0,CH4G2(N3,N2,N1)) - RFLOXG=VFLW*AMAX1(0.0,OXYG2(N3,N2,N1)) - RFLNGG=VFLW*AMAX1(0.0,Z2GG2(N3,N2,N1)) - RFLN2G=VFLW*AMAX1(0.0,Z2OG2(N3,N2,N1)) - RFLN3G=VFLW*AMAX1(0.0,ZN3G2(N3,N2,N1)) - RFLH2G=VFLW*AMAX1(0.0,H2GG2(N3,N2,N1)) - ENDIF -C -C SOIL GAS FLUX FROM DIFFERENCES -C BETWEEN CURRENT AND EQUILIBRIUM -C CONCENTRATIONS + CONVECTIVE FLUX -C - RCOFLG(N,N6,N5,N4)=DFVCOG+RFLCOG - RCHFLG(N,N6,N5,N4)=DFVCHG+RFLCHG - ROXFLG(N,N6,N5,N4)=DFVOXG+RFLOXG - RNGFLG(N,N6,N5,N4)=DFVNGG+RFLNGG - RN2FLG(N,N6,N5,N4)=DFVN2G+RFLN2G - RN3FLG(N,N6,N5,N4)=DFVN3G+RFLN3G - RHGFLG(N,N6,N5,N4)=DFVHGG+RFLH2G -C IF(I.EQ.43)THEN -C WRITE(*,3133)'ROXFL2',I,J,M,MM,N1,N2,N3,N,XOXFLG(N,N6,N5,N4) -C 2,ROXFLG(N,N6,N5,N4),DFVOXG,RFLOXG,COXYG1,COXYG2 -C 3,OXYG2(N3,N2,N1),OXYG2(N6,N5,N4) -C 4,FLQM(N,N6,N5,N4),VFLW,DOXYG(N,N6,N5,N4) -C 5,THETPM(M,N3,N2,N1),THETPM(M,N6,N5,N4) -C 5,VOLPM(M,N3,N2,N1),VOLPM(M,N6,N5,N4) -C WRITE(*,3133)'RNGFLG',I,J,M,MM,N4,N4,N6,N,RNGFLG(N,N6,N5,N4) -C 2,DFVNGG,RFLNGG,DZ2GG(N,N6,N5,N4),CZ2GG1,CZ2GG2 -3133 FORMAT(A8,8I4,20E12.4) -C ENDIF -C -C ACCUMULATE HOURLY FLUXES -C - XCOFLG(N,N6,N5,N4)=XCOFLG(N,N6,N5,N4)+RCOFLG(N,N6,N5,N4) - XCHFLG(N,N6,N5,N4)=XCHFLG(N,N6,N5,N4)+RCHFLG(N,N6,N5,N4) - XOXFLG(N,N6,N5,N4)=XOXFLG(N,N6,N5,N4)+ROXFLG(N,N6,N5,N4) - XNGFLG(N,N6,N5,N4)=XNGFLG(N,N6,N5,N4)+RNGFLG(N,N6,N5,N4) - XN2FLG(N,N6,N5,N4)=XN2FLG(N,N6,N5,N4)+RN2FLG(N,N6,N5,N4) - XN3FLG(N,N6,N5,N4)=XN3FLG(N,N6,N5,N4)+RN3FLG(N,N6,N5,N4) - XHGFLG(N,N6,N5,N4)=XHGFLG(N,N6,N5,N4)+RHGFLG(N,N6,N5,N4) - ELSE - RCOFLG(N,N6,N5,N4)=0.0 - RCHFLG(N,N6,N5,N4)=0.0 - ROXFLG(N,N6,N5,N4)=0.0 - RNGFLG(N,N6,N5,N4)=0.0 - RN2FLG(N,N6,N5,N4)=0.0 - RN3FLG(N,N6,N5,N4)=0.0 - RHGFLG(N,N6,N5,N4)=0.0 - ENDIF -C -C VOLATILIZATION-DISSOLUTION OF GASES IN SOIL -C LAYER FROM GASEOUS CONCENTRATIONS VS. THEIR AQUEOUS -C EQUIVALENTS DEPENDING ON SOLUBILITY FROM 'HOUR1' -C AND TRANSFER COEFFICIENT 'DFGS' FROM 'WATSUB' -C - IF(N.EQ.3)THEN - IF(THETPM(M,N6,N5,N4).GT.THETX)THEN - RCODFG(N6,N5,N4)=DFGS(M,N6,N5,N4)*(AMAX1(ZEROS(N5,N4) - 2,CO2G2(N6,N5,N4))*VOLWCO(N6,N5,N4) - 3-CO2S2(N6,N5,N4)*VOLPM(M,N6,N5,N4)) - 4/(VOLWCO(N6,N5,N4)+VOLPM(M,N6,N5,N4)) - RCHDFG(N6,N5,N4)=DFGS(M,N6,N5,N4)*(AMAX1(ZEROS(N5,N4) - 2,CH4G2(N6,N5,N4))*VOLWCH(N6,N5,N4) - 3-CH4S2(N6,N5,N4)*VOLPM(M,N6,N5,N4)) - 4/(VOLWCH(N6,N5,N4)+VOLPM(M,N6,N5,N4)) - ROXDFG(N6,N5,N4)=DFGS(M,N6,N5,N4)*(AMAX1(ZEROS(N5,N4) - 2,OXYG2(N6,N5,N4))*VOLWOX(N6,N5,N4) - 3-OXYS2(N6,N5,N4)*VOLPM(M,N6,N5,N4)) - 4/(VOLWOX(N6,N5,N4)+VOLPM(M,N6,N5,N4)) - RNGDFG(N6,N5,N4)=DFGS(M,N6,N5,N4)*(AMAX1(ZEROS(N5,N4) - 2,Z2GG2(N6,N5,N4))*VOLWNG(N6,N5,N4) - 3-Z2GS2(N6,N5,N4)*VOLPM(M,N6,N5,N4)) - 4/(VOLWNG(N6,N5,N4)+VOLPM(M,N6,N5,N4)) - RN2DFG(N6,N5,N4)=DFGS(M,N6,N5,N4)*(AMAX1(ZEROS(N5,N4) - 2,Z2OG2(N6,N5,N4))*VOLWN2(N6,N5,N4) - 3-Z2OS2(N6,N5,N4)*VOLPM(M,N6,N5,N4)) - 3/(VOLWN2(N6,N5,N4)+VOLPM(M,N6,N5,N4)) - IF(VOLPMA(N6,N5,N4).GT.ZEROS(N5,N4) - 2.AND.VOLWXA(N6,N5,N4).GT.ZEROS(N5,N4))THEN - RN3DFG(N6,N5,N4)=DFGS(M,N6,N5,N4)*(AMAX1(ZEROS(N5,N4) - 2,ZN3G2(N6,N5,N4))*VOLWN3(N6,N5,N4) - 3-ZN3S2(N6,N5,N4)*VOLPMA(N6,N5,N4)) - 4/(VOLWN3(N6,N5,N4)+VOLPMA(N6,N5,N4)) - CNH3S0=AMAX1(0.0,(ZN3S2(N6,N5,N4)+RN3DFG(N6,N5,N4)) - 2/VOLWXA(N6,N5,N4)) - CNH4S0=AMAX1(0.0,ZNH4S2(N6,N5,N4)) - 2/VOLWXA(N6,N5,N4) - RN34SQ(N6,N5,N4)=VOLWXA(N6,N5,N4) - 2*(CHY0(N6,N5,N4)*CNH3S0-DPN4*CNH4S0)/(DPN4+CHY0(N6,N5,N4)) - ELSE - RN3DFG(N6,N5,N4)=0.0 - RN34SQ(N6,N5,N4)=0.0 - ENDIF - IF(VOLPMB(N6,N5,N4).GT.ZEROS(N5,N4) - 2.AND.VOLWXB(N6,N5,N4).GT.ZEROS(N5,N4))THEN - RNBDFG(N6,N5,N4)=DFGS(M,N6,N5,N4)*(AMAX1(ZEROS(N5,N4) - 2,ZN3G2(N6,N5,N4))*VOLWNB(N6,N5,N4) - 3-ZNBS2(N6,N5,N4)*VOLPMB(N6,N5,N4)) - 4/(VOLWNB(N6,N5,N4)+VOLPMB(N6,N5,N4)) - CNH3B0=AMAX1(0.0,(ZNBS2(N6,N5,N4)+RNBDFG(N6,N5,N4)) - 2/VOLWXB(N6,N5,N4)) - CNH4B0=AMAX1(0.0,ZNH4B2(N6,N5,N4))/VOLWXB(N6,N5,N4) - RN34BQ(N6,N5,N4)=VOLWXB(N6,N5,N4) - 2*(CHY0(N6,N5,N4)*CNH3B0-DPN4*CNH4B0)/(DPN4+CHY0(N6,N5,N4)) - ELSE - RNBDFG(N6,N5,N4)=0.0 - RN34BQ(N6,N5,N4)=0.0 - ENDIF - RHGDFG(N6,N5,N4)=DFGS(M,N6,N5,N4)*(AMAX1(ZEROS(N5,N4) - 2,H2GG2(N6,N5,N4))*VOLWHG(N6,N5,N4) - 3-H2GS2(N6,N5,N4)*VOLPM(M,N6,N5,N4)) - 4/(VOLWHG(N6,N5,N4)+VOLPM(M,N6,N5,N4)) -C IF(I.EQ.43)THEN -C WRITE(*,6666)'RN3DFG',I,J,M,MM,N4,N5,N6,RN3DFG(N6,N5,N4) -C 2,DFGS(M,N6,N5,N4),ZN3S2A,VOLWN3(N6,N5,N4),ZN3S2(N6,N5,N4) -C 3,VOLPMA(N6,N5,N4),RNBDFG(N6,N5,N4),ZN3S2B -C 4,VOLWNB(N6,N5,N4),ZNBS2(N6,N5,N4),VOLPMB(N6,N5,N4) -C WRITE(*,6666)'RCHDFG',I,J,M,MM,N4,N5,N6,RCHDFG(N6,N5,N4) -C 2,DFGS(M,N6,N5,N4),CH4G2(N6,N5,N4),VOLWCH(N6,N5,N4) -C 3,CH4S2(N6,N5,N4),VOLWM(M,N6,N5,N4),THETPM(M,N6,N5,N4) -C 4,SCH4L(N6,N5,N4),XCHDFG(N6,N5,N4) -C WRITE(*,6666)'RNGDFG',I,J,M,MM,N4,N5,N6 -C 2,RNGDFG(N6,N5,N4),DFGS(M,N6,N5,N4),Z2GG2(N6,N5,N4) -C 3,VOLWNG(N6,N5,N4),Z2GS2(N6,N5,N4),VOLPM(M,N6,N5,N4) -C 4,VOLWNG(N6,N5,N4),VOLPM(M,N6,N5,N4) -6666 FORMAT(A8,7I4,20E12.4) -C ENDIF -C -C ACCUMULATE HOURLY FLUXES -C - XCODFG(N6,N5,N4)=XCODFG(N6,N5,N4)+RCODFG(N6,N5,N4) - XCHDFG(N6,N5,N4)=XCHDFG(N6,N5,N4)+RCHDFG(N6,N5,N4) - XOXDFG(N6,N5,N4)=XOXDFG(N6,N5,N4)+ROXDFG(N6,N5,N4) - XNGDFG(N6,N5,N4)=XNGDFG(N6,N5,N4)+RNGDFG(N6,N5,N4) - XN2DFG(N6,N5,N4)=XN2DFG(N6,N5,N4)+RN2DFG(N6,N5,N4) - XN3DFG(N6,N5,N4)=XN3DFG(N6,N5,N4)+RN3DFG(N6,N5,N4) - XN34SQ(N6,N5,N4)=XN34SQ(N6,N5,N4)+RN34SQ(N6,N5,N4) - XNBDFG(N6,N5,N4)=XNBDFG(N6,N5,N4)+RNBDFG(N6,N5,N4) - XN34BQ(N6,N5,N4)=XN34BQ(N6,N5,N4)+RN34BQ(N6,N5,N4) - XHGDFG(N6,N5,N4)=XHGDFG(N6,N5,N4)+RHGDFG(N6,N5,N4) - ELSE - RCODFG(N6,N5,N4)=0.0 - RCHDFG(N6,N5,N4)=0.0 - ROXDFG(N6,N5,N4)=0.0 - RNGDFG(N6,N5,N4)=0.0 - RN2DFG(N6,N5,N4)=0.0 - RN3DFG(N6,N5,N4)=0.0 - RN34SQ(N6,N5,N4)=0.0 - RNBDFG(N6,N5,N4)=0.0 - RN34BQ(N6,N5,N4)=0.0 - RHGDFG(N6,N5,N4)=0.0 - ENDIF - ENDIF - ELSEIF(N.NE.3)THEN - DCO2G(N,N6,N5,N4)=0.0 - DCH4G(N,N6,N5,N4)=0.0 - DOXYG(N,N6,N5,N4)=0.0 - DZ2GG(N,N6,N5,N4)=0.0 - DZ2OG(N,N6,N5,N4)=0.0 - DNH3G(N,N6,N5,N4)=0.0 - DH2GG(N,N6,N5,N4)=0.0 - DO 9750 K=0,4 - ROCFLS(K,N,N6,N5,N4)=0.0 - RONFLS(K,N,N6,N5,N4)=0.0 - ROPFLS(K,N,N6,N5,N4)=0.0 - ROAFLS(K,N,N6,N5,N4)=0.0 - ROCFHS(K,N,N6,N5,N4)=0.0 - RONFHS(K,N,N6,N5,N4)=0.0 - ROPFHS(K,N,N6,N5,N4)=0.0 - ROAFHS(K,N,N6,N5,N4)=0.0 -9750 CONTINUE - RCOFLS(N,N6,N5,N4)=0.0 - RCHFLS(N,N6,N5,N4)=0.0 - ROXFLS(N,N6,N5,N4)=0.0 - RNGFLS(N,N6,N5,N4)=0.0 - RN2FLS(N,N6,N5,N4)=0.0 - RHGFLS(N,N6,N5,N4)=0.0 - RN4FLW(N,N6,N5,N4)=0.0 - RN3FLW(N,N6,N5,N4)=0.0 - RNOFLW(N,N6,N5,N4)=0.0 - RNXFLS(N,N6,N5,N4)=0.0 - RH2PFS(N,N6,N5,N4)=0.0 - RN4FLB(N,N6,N5,N4)=0.0 - RN3FLB(N,N6,N5,N4)=0.0 - RNOFLB(N,N6,N5,N4)=0.0 - RNXFLB(N,N6,N5,N4)=0.0 - RH2BFB(N,N6,N5,N4)=0.0 - RCOFHS(N,N6,N5,N4)=0.0 - RCHFHS(N,N6,N5,N4)=0.0 - ROXFHS(N,N6,N5,N4)=0.0 - RNGFHS(N,N6,N5,N4)=0.0 - RN2FHS(N,N6,N5,N4)=0.0 - RHGFHS(N,N6,N5,N4)=0.0 - RN4FHW(N,N6,N5,N4)=0.0 - RN3FHW(N,N6,N5,N4)=0.0 - RNOFHW(N,N6,N5,N4)=0.0 - RNXFHS(N,N6,N5,N4)=0.0 - RH2PHS(N,N6,N5,N4)=0.0 - RN4FHB(N,N6,N5,N4)=0.0 - RN3FHB(N,N6,N5,N4)=0.0 - RNOFHB(N,N6,N5,N4)=0.0 - RNXFHB(N,N6,N5,N4)=0.0 - RH2BHB(N,N6,N5,N4)=0.0 - RCOFLG(N,N6,N5,N4)=0.0 - RCHFLG(N,N6,N5,N4)=0.0 - ROXFLG(N,N6,N5,N4)=0.0 - RNGFLG(N,N6,N5,N4)=0.0 - RN2FLG(N,N6,N5,N4)=0.0 - RN3FLG(N,N6,N5,N4)=0.0 - RHGFLG(N,N6,N5,N4)=0.0 - ENDIF -120 CONTINUE -C -C CHECK FOR BUBBLING IF THE SUM OF ALL GASEOUS EQUIVALENT -C PARTIAL CONCENTRATIONS EXCEEDS ATMOSPHERIC PRESSURE -C - IF(N3.GE.NU(N2,N1).AND.M.NE.MX)THEN - THETW1(N3,N2,N1)=AMAX1(0.0,VOLWM(M,N3,N2,N1)/VOLX(N3,N2,N1)) - IF(THETW1(N3,N2,N1).GT.THETY(N3,N2,N1).AND.IFLGB.EQ.0)THEN - SCO2X=12.0*SCO2L(N3,N2,N1) - SCH4X=12.0*SCH4L(N3,N2,N1) - SOXYX=32.0*SOXYL(N3,N2,N1) - SN2GX=28.0*SN2GL(N3,N2,N1) - SN2OX=28.0*SN2OL(N3,N2,N1) - SNH3X=14.0*SNH3L(N3,N2,N1) - SH2GX=1.0*SH2GL(N3,N2,N1) -C -C GASEOUS EQUIVALENT PARTIAL CONCENTRATIONS -C - VCO2G2=CO2S2(N3,N2,N1)/SCO2X - VCH4G2=CH4S2(N3,N2,N1)/SCH4X - VOXYG2=OXYS2(N3,N2,N1)/SOXYX - VZ2GG2=Z2GS2(N3,N2,N1)/SN2GX - VZ2OG2=Z2OS2(N3,N2,N1)/SN2OX - VNH3G2=ZN3S2(N3,N2,N1)/SNH3X - VNHBG2=ZNBS2(N3,N2,N1)/SNH3X - VH2GG2=H2GS2(N3,N2,N1)/SH2GX -C -C GASEOUS EQUIVALENT ATMOSPHERIC CONCENTRATION -C - VTATM=AMAX1(0.0,1.2194E+04*VOLWM(M,N3,N2,N1)/TKS(N3,N2,N1)) - VTGAS=VCO2G2+VCH4G2+VOXYG2+VZ2GG2+VZ2OG2+VNH3G2+VNHBG2+VH2GG2 -C -C PROPORTIONAL REMOVAL OF EXCESS AQUEOUS GASES -C - IF(VTGAS.GT.VTATM)THEN - DVTGAS=VTATM-VTGAS - RCOBBL(N3,N2,N1)=AMIN1(0.0,DVTGAS*VCO2G2/VTGAS)*SCO2X - RCHBBL(N3,N2,N1)=AMIN1(0.0,DVTGAS*VCH4G2/VTGAS)*SCH4X - ROXBBL(N3,N2,N1)=AMIN1(0.0,DVTGAS*VOXYG2/VTGAS)*SOXYX - RNGBBL(N3,N2,N1)=AMIN1(0.0,DVTGAS*VZ2GG2/VTGAS)*SN2GX - RN2BBL(N3,N2,N1)=AMIN1(0.0,DVTGAS*VZ2OG2/VTGAS)*SN2OX - RN3BBL(N3,N2,N1)=AMIN1(0.0,DVTGAS*VNH3G2/VTGAS)*SNH3X - RNBBBL(N3,N2,N1)=AMIN1(0.0,DVTGAS*VNHBG2/VTGAS)*SNH3X - RHGBBL(N3,N2,N1)=AMIN1(0.0,DVTGAS*VH2GG2/VTGAS)*SH2GX -C -C ACCUMULATE HOURLY FLUXES -C - XCOBBL(N3,N2,N1)=XCOBBL(N3,N2,N1)+RCOBBL(N3,N2,N1) - XCHBBL(N3,N2,N1)=XCHBBL(N3,N2,N1)+RCHBBL(N3,N2,N1) - XOXBBL(N3,N2,N1)=XOXBBL(N3,N2,N1)+ROXBBL(N3,N2,N1) - XNGBBL(N3,N2,N1)=XNGBBL(N3,N2,N1)+RNGBBL(N3,N2,N1) - XN2BBL(N3,N2,N1)=XN2BBL(N3,N2,N1)+RN2BBL(N3,N2,N1) - XN3BBL(N3,N2,N1)=XN3BBL(N3,N2,N1)+RN3BBL(N3,N2,N1) - XNBBBL(N3,N2,N1)=XNBBBL(N3,N2,N1)+RNBBBL(N3,N2,N1) - XHGBBL(N3,N2,N1)=XHGBBL(N3,N2,N1)+RHGBBL(N3,N2,N1) - ELSE - RCOBBL(N3,N2,N1)=0.0 - RCHBBL(N3,N2,N1)=0.0 - ROXBBL(N3,N2,N1)=0.0 - RNGBBL(N3,N2,N1)=0.0 - RN2BBL(N3,N2,N1)=0.0 - RN3BBL(N3,N2,N1)=0.0 - RNBBBL(N3,N2,N1)=0.0 - RHGBBL(N3,N2,N1)=0.0 - ENDIF - ELSE - IFLGB=1 - RCOBBL(N3,N2,N1)=0.0 - RCHBBL(N3,N2,N1)=0.0 - ROXBBL(N3,N2,N1)=0.0 - RNGBBL(N3,N2,N1)=0.0 - RN2BBL(N3,N2,N1)=0.0 - RN3BBL(N3,N2,N1)=0.0 - RNBBBL(N3,N2,N1)=0.0 - RHGBBL(N3,N2,N1)=0.0 - ENDIF -C IF(N1.EQ.2.AND.N2.EQ.1.AND.N3.EQ.13)THEN -C WRITE(*,6688)'BUBBL',I,J,N1,N2,N3,M,MM,IFLGB,VTGAS,VTATM -C 2,DVTGAS,SOXYX,VCO2G2,VCH4G2,VOXYG2,VZ2GG2,VZ2OG2 -C 3,VNH3G2,VNHBG2,VH2GG2,ROXBBL(N3,N2,N1),XOXBBL(N3,N2,N1) -C 4,OXYS2(N3,N2,N1),VOLWM(M,N3,N2,N1) -6688 FORMAT(A8,8I4,20E12.4) -C ENDIF - ENDIF -125 CONTINUE -9890 CONTINUE -9895 CONTINUE -C -C BOUNDARY SOLUTE AND GAS FLUXES -C - DO 9595 NX=NHW,NHE - DO 9590 NY=NVN,NVS - DO 9585 L=NU(NY,NX),NL(NY,NX) - N1=NX - N2=NY - N3=L -C -C LOCATE ALL EXTERNAL BOUNDARIES AND SET BOUNDARY CONDITIONS -C ENTERED IN 'READS' -C - DO 9580 N=1,3 - DO 9575 NN=1,2 - IF(N.EQ.1)THEN - N4=NX+1 - N5=NY - N6=L - IF(NN.EQ.1)THEN - IF(NX.EQ.NHE)THEN - M1=NX - M2=NY - M3=L - M4=NX+1 - M5=NY - M6=L - XN=-1.0 - ELSE - GO TO 9575 - ENDIF - ELSEIF(NN.EQ.2)THEN - IF(NX.EQ.NHW)THEN - M1=NX - M2=NY - M3=L - M4=NX - M5=NY - M6=L - XN=1.0 - ELSE - GO TO 9575 - ENDIF - ENDIF - ELSEIF(N.EQ.2)THEN - N4=NX - N5=NY+1 - N6=L - IF(NN.EQ.1)THEN - IF(NY.EQ.NVS)THEN - M1=NX - M2=NY - M3=L - M4=NX - M5=NY+1 - M6=L - XN=-1.0 - ELSE - GO TO 9575 - ENDIF - ELSEIF(NN.EQ.2)THEN - IF(NY.EQ.NVN)THEN - M1=NX - M2=NY - M3=L - M4=NX - M5=NY - M6=L - XN=1.0 - ELSE - GO TO 9575 - ENDIF - ENDIF - ELSEIF(N.EQ.3)THEN - N1=NX - N2=NY - N3=L - N4=NX - N5=NY - N6=L+1 - IF(NN.EQ.1)THEN - IF(L.EQ.NL(NY,NX))THEN - M1=NX - M2=NY - M3=L - M4=NX - M5=NY - M6=L+1 - XN=-1.0 - ELSE - GO TO 9575 - ENDIF - ELSEIF(NN.EQ.2)THEN - GO TO 9575 - ENDIF - ENDIF -C -C SURFACE SOLUTE TRANSPORT FROM BOUNDARY SURFACE -C RUNOFF IN 'WATSUB' AND CONCENTRATIONS IN THE SURFACE SOIL LAYER -C - IF(M.NE.MX)THEN - IF(M3.EQ.NU(M2,M1).AND.N.NE.3)THEN -C -C NO RUNOFF -C - IF(QRM(M,N,M5,M4).EQ.0.0)THEN - DO 9570 K=0,2 - RQROC(K,N,M5,M4)=0.0 - RQRON(K,N,M5,M4)=0.0 - RQROP(K,N,M5,M4)=0.0 - RQROA(K,N,M5,M4)=0.0 -9570 CONTINUE - RQRCOS(N,M5,M4)=0.0 - RQRCHS(N,M5,M4)=0.0 - RQROXS(N,M5,M4)=0.0 - RQRNGS(N,M5,M4)=0.0 - RQRN2S(N,M5,M4)=0.0 - RQRHGS(N,M5,M4)=0.0 - RQRNH4(N,M5,M4)=0.0 - RQRNH3(N,M5,M4)=0.0 - RQRNO3(N,M5,M4)=0.0 - RQRNO2(N,M5,M4)=0.0 - RQRH2P(N,M5,M4)=0.0 -C -C SOLUTE LOSS FROM RUNOFF DEPENDING ON ASPECT -C AND BOUNDARY CONDITIONS SET IN SITE FILE -C - ELSEIF(NN.EQ.1.AND.QRM(M,N,M5,M4).GT.0.0 - 2.OR.NN.EQ.2.AND.QRM(M,N,M5,M4).LT.0.0)THEN - IF(VOLWM(M,0,M2,M1).GT.ZEROS(M2,M1))THEN - VFLW=AMAX1(-XFRX,AMIN1(XFRX,QRM(M,N,M5,M4) - 2/VOLWM(M,0,M2,M1))) - ELSE - VFLW=0.0 - ENDIF - DO 9540 K=0,2 - 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)) - RQROA(K,N,M5,M4)=VFLW*AMAX1(0.0,OQA2(K,0,M2,M1)) -9540 CONTINUE - RQRCOS(N,M5,M4)=VFLW*AMAX1(0.0,CO2S2(0,M2,M1)) - RQRCHS(N,M5,M4)=VFLW*AMAX1(0.0,CH4S2(0,M2,M1)) - RQROXS(N,M5,M4)=VFLW*AMAX1(0.0,OXYS2(0,M2,M1)) - RQRNGS(N,M5,M4)=VFLW*AMAX1(0.0,Z2GS2(0,M2,M1)) - RQRN2S(N,M5,M4)=VFLW*AMAX1(0.0,Z2OS2(0,M2,M1)) - RQRHGS(N,M5,M4)=VFLW*AMAX1(0.0,H2GS2(0,M2,M1)) - RQRNH4(N,M5,M4)=VFLW*AMAX1(0.0,ZNH4S2(0,M2,M1)) - RQRNH3(N,M5,M4)=VFLW*AMAX1(0.0,ZN3S2(0,M2,M1)) - RQRNO3(N,M5,M4)=VFLW*AMAX1(0.0,ZNO3S2(0,M2,M1)) - RQRNO2(N,M5,M4)=VFLW*AMAX1(0.0,ZNO2S2(0,M2,M1)) - RQRH2P(N,M5,M4)=VFLW*AMAX1(0.0,H2PO42(0,M2,M1)) -C WRITE(18,1114)'RUNX',I,J,M,M1,M2,M3,N,QRM(M,N,M5,M4) -C 2,RQRH2P(N,M5,M4),(RQROP(K,N,M5,M4),K=1,4) -1114 FORMAT(A8,7I4,20E12.4) -C -C SOLUTE GAIN FROM RUNON DEPENDING ON ASPECT -C AND BOUNDARY CONDITIONS SET IN SITE FILE -C - ELSE - DO 9640 K=0,2 - RQROC(K,N,M5,M4)=0.0 - RQRON(K,N,M5,M4)=0.0 - RQROP(K,N,M5,M4)=0.0 - RQROA(K,N,M5,M4)=0.0 -9640 CONTINUE - RQRCOS(N,M5,M4)=QRM(M,N,M5,M4)*CCOU - RQRCHS(N,M5,M4)=QRM(M,N,M5,M4)*CCHU - RQROXS(N,M5,M4)=QRM(M,N,M5,M4)*COXU - RQRNGS(N,M5,M4)=QRM(M,N,M5,M4)*CNNU - RQRN2S(N,M5,M4)=QRM(M,N,M5,M4)*CN2U - RQRHGS(N,M5,M4)=0.0 - RQRNH4(N,M5,M4)=0.0 - RQRNH3(N,M5,M4)=0.0 - RQRNO3(N,M5,M4)=0.0 - RQRNO2(N,M5,M4)=0.0 - RQRH2P(N,M5,M4)=0.0 - ENDIF - RQSCOS(N,M5,M4)=0.0 - RQSCHS(N,M5,M4)=0.0 - RQSOXS(N,M5,M4)=0.0 - RQSNGS(N,M5,M4)=0.0 - RQSN2S(N,M5,M4)=0.0 - RQSNH4(N,M5,M4)=0.0 - RQSNH3(N,M5,M4)=0.0 - RQSNO3(N,M5,M4)=0.0 - RQSH2P(N,M5,M4)=0.0 -C -C ACCUMULATE HOURLY FLUXES -C - DO 9565 K=0,2 - 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) - XOAQRS(K,N,M5,M4)=XOAQRS(K,N,M5,M4)+RQROA(K,N,M5,M4) -9565 CONTINUE - XCOQRS(N,M5,M4)=XCOQRS(N,M5,M4)+RQRCOS(N,M5,M4) - XCHQRS(N,M5,M4)=XCHQRS(N,M5,M4)+RQRCHS(N,M5,M4) - XOXQRS(N,M5,M4)=XOXQRS(N,M5,M4)+RQROXS(N,M5,M4) - XNGQRS(N,M5,M4)=XNGQRS(N,M5,M4)+RQRNGS(N,M5,M4) - XN2QRS(N,M5,M4)=XN2QRS(N,M5,M4)+RQRN2S(N,M5,M4) - XHGQRS(N,M5,M4)=XHGQRS(N,M5,M4)+RQRHGS(N,M5,M4) - XN4QRW(N,M5,M4)=XN4QRW(N,M5,M4)+RQRNH4(N,M5,M4) - XN3QRW(N,M5,M4)=XN3QRW(N,M5,M4)+RQRNH3(N,M5,M4) - XNOQRW(N,M5,M4)=XNOQRW(N,M5,M4)+RQRNO3(N,M5,M4) - XNXQRS(N,M5,M4)=XNXQRS(N,M5,M4)+RQRNO2(N,M5,M4) - XP4QRW(N,M5,M4)=XP4QRW(N,M5,M4)+RQRH2P(N,M5,M4) - XCOQSS(N,M5,M4)=XCOQSS(N,M5,M4)+RQSCOS(N,M5,M4) - XCHQSS(N,M5,M4)=XCHQSS(N,M5,M4)+RQSCHS(N,M5,M4) - XOXQSS(N,M5,M4)=XOXQSS(N,M5,M4)+RQSOXS(N,M5,M4) - XNGQSS(N,M5,M4)=XNGQSS(N,M5,M4)+RQSNGS(N,M5,M4) - XN2QSS(N,M5,M4)=XN2QSS(N,M5,M4)+RQSN2S(N,M5,M4) - XN4QSS(N,M5,M4)=XN4QSS(N,M5,M4)+RQSNH4(N,M5,M4) - XN3QSS(N,M5,M4)=XN3QSS(N,M5,M4)+RQSNH3(N,M5,M4) - XNOQSS(N,M5,M4)=XNOQSS(N,M5,M4)+RQSNO3(N,M5,M4) - XP4QSS(N,M5,M4)=XP4QSS(N,M5,M4)+RQSH2P(N,M5,M4) - ENDIF -C -C SOLUTE LOSS WITH SUBSURFACE MICROPORE WATER LOSS -C - IF(NCN(M2,M1).NE.3.OR.N.EQ.3)THEN - IF(NN.EQ.1.AND.FLWM(M,N,M6,M5,M4).GT.0.0 - 2.OR.NN.EQ.2.AND.FLWM(M,N,M6,M5,M4).LT.0.0)THEN - IF(VOLWM(M,M3,M2,M1).GT.ZEROS(M2,M1))THEN - VFLW=AMAX1(-XFRX,AMIN1(XFRX,FLWM(M,N,M6,M5,M4) - 2/VOLWM(M,M3,M2,M1))) - ELSE - VFLW=0.0 - ENDIF - DO 9520 K=0,4 - ROCFLS(K,N,M6,M5,M4)=VFLW*AMAX1(0.0,OQC2(K,M3,M2,M1)) - RONFLS(K,N,M6,M5,M4)=VFLW*AMAX1(0.0,OQN2(K,M3,M2,M1)) - ROPFLS(K,N,M6,M5,M4)=VFLW*AMAX1(0.0,OQP2(K,M3,M2,M1)) - ROAFLS(K,N,M6,M5,M4)=VFLW*AMAX1(0.0,OQA2(K,M3,M2,M1)) -9520 CONTINUE - RCOFLS(N,M6,M5,M4)=VFLW*AMAX1(0.0,CO2S2(M3,M2,M1)) - RCHFLS(N,M6,M5,M4)=VFLW*AMAX1(0.0,CH4S2(M3,M2,M1)) - ROXFLS(N,M6,M5,M4)=VFLW*AMAX1(0.0,OXYS2(M3,M2,M1)) - RNGFLS(N,M6,M5,M4)=VFLW*AMAX1(0.0,Z2GS2(M3,M2,M1)) - RN2FLS(N,M6,M5,M4)=VFLW*AMAX1(0.0,Z2OS2(M3,M2,M1)) - RHGFLS(N,M6,M5,M4)=VFLW*AMAX1(0.0,H2GS2(M3,M2,M1)) - RN4FLW(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZNH4S2(M3,M2,M1)) - 2*VLNH4(M3,M2,M1) - RN3FLW(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZN3S2(M3,M2,M1)) - 2*VLNH4(M3,M2,M1) - RNOFLW(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZNO3S2(M3,M2,M1)) - 2*VLNO3(M3,M2,M1) - RNXFLS(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZNO2S2(M3,M2,M1)) - 2*VLNO3(M3,M2,M1) - RH2PFS(N,M6,M5,M4)=VFLW*AMAX1(0.0,H2PO42(M3,M2,M1)) - 2*VLPO4(M3,M2,M1) - RN4FLB(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZNH4B2(M3,M2,M1)) - 2*VLNHB(M3,M2,M1) - RN3FLB(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZNBS2(M3,M2,M1)) - 2*VLNHB(M3,M2,M1) - RNOFLB(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZNO3B2(M3,M2,M1)) - 2*VLNOB(M3,M2,M1) - RNXFLB(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZNO2B2(M3,M2,M1)) - 2*VLNOB(M3,M2,M1) - RH2BFB(N,M6,M5,M4)=VFLW*AMAX1(0.0,H2POB2(M3,M2,M1)) - 2*VLPOB(M3,M2,M1) -C IF(J.EQ.15)THEN -C WRITE(*,8765)'LEACH',I,J,M,M6,M5,M4,RNOFLW(N,M6,M5,M4) -C 2,VFLW,ZNO3S2(M3,M2,M1),VLNO3(M3,M2,M1),FLWM(M,N,M6,M5,M4) -C 3,VOLWM(M,M3,M2,M1) -8765 FORMAT(A8,6I4,20E12.4) -C ENDIF -C -C NO SOLUTE GAIN WITH SUBSURFACE MICROPORE WATER GAIN -C - ELSE - DO 9515 K=0,4 - ROCFLS(K,N,M6,M5,M4)=0.0 - RONFLS(K,N,M6,M5,M4)=0.0 - ROPFLS(K,N,M6,M5,M4)=0.0 - ROAFLS(K,N,M6,M5,M4)=0.0 -9515 CONTINUE - RCOFLS(N,M6,M5,M4)=0.0 - RCHFLS(N,M6,M5,M4)=0.0 - ROXFLS(N,M6,M5,M4)=0.0 - RNGFLS(N,M6,M5,M4)=0.0 - RN2FLS(N,M6,M5,M4)=0.0 - RHGFLS(N,M6,M5,M4)=0.0 - RN4FLW(N,M6,M5,M4)=0.0 - RN3FLW(N,M6,M5,M4)=0.0 - RNOFLW(N,M6,M5,M4)=0.0 - RNXFLS(N,M6,M5,M4)=0.0 - RH2PFS(N,M6,M5,M4)=0.0 - RN4FLB(N,M6,M5,M4)=0.0 - RN3FLB(N,M6,M5,M4)=0.0 - RNOFLB(N,M6,M5,M4)=0.0 - RNXFLB(N,M6,M5,M4)=0.0 - RH2BFB(N,M6,M5,M4)=0.0 - ENDIF -C IF(M.NE.MX.AND.I.GE.180.AND.I.LE.200)THEN -C WRITE(*,1115)'LEACHX',I,J,M1,M2,M3,M,MM,N -C 1,RCOFLS(N,M6,M5,M4),VFLW,CO2S2(M3,M2,M1) -C 2,RH2PFS(N,M6,M5,M4),(ROPFLS(K,N,M6,M5,M4),K=1,4) -C 4,VOLWM(M,M3,M2,M1),FLWM(M,N,M6,M5,M4),VFLW -1115 FORMAT(A8,8I4,20E12.4) -C ENDIF -C -C SOLUTE LOSS WITH SUBSURFACE MACROPORE WATER LOSS -C - IF(NN.EQ.1.AND.FLWHM(M,N,M6,M5,M4).GT.0.0 - 2.OR.NN.EQ.2.AND.FLWHM(M,N,M6,M5,M4).LT.0.0)THEN - IF(VOLWHM(M,M3,M2,M1).GT.ZEROS(M2,M1))THEN - VFLW=AMAX1(-XFRX,AMIN1(XFRX,FLWHM(M,N,M6,M5,M4) - 2/VOLWHM(M,M3,M2,M1))) - ELSE - VFLW=0.0 - ENDIF - DO 9535 K=0,4 - ROCFHS(K,N,M6,M5,M4)=VFLW*AMAX1(0.0,OQCH2(K,M3,M2,M1)) - RONFHS(K,N,M6,M5,M4)=VFLW*AMAX1(0.0,OQNH2(K,M3,M2,M1)) - ROPFHS(K,N,M6,M5,M4)=VFLW*AMAX1(0.0,OQPH2(K,M3,M2,M1)) - ROAFHS(K,N,M6,M5,M4)=VFLW*AMAX1(0.0,OQAH2(K,M3,M2,M1)) -9535 CONTINUE - RCOFHS(N,M6,M5,M4)=VFLW*AMAX1(0.0,CO2SH2(M3,M2,M1)) - RCHFHS(N,M6,M5,M4)=VFLW*AMAX1(0.0,CH4SH2(M3,M2,M1)) - ROXFHS(N,M6,M5,M4)=VFLW*AMAX1(0.0,OXYSH2(M3,M2,M1)) - RNGFHS(N,M6,M5,M4)=VFLW*AMAX1(0.0,Z2GSH2(M3,M2,M1)) - RN2FHS(N,M6,M5,M4)=VFLW*AMAX1(0.0,Z2OSH2(M3,M2,M1)) - RHGFHS(N,M6,M5,M4)=VFLW*AMAX1(0.0,H2GSH2(M3,M2,M1)) - RN4FHW(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZNH4H2(M3,M2,M1)) - 2*VLNH4(M3,M2,M1) - RN3FHW(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZNH3H2(M3,M2,M1)) - 2*VLNH4(M3,M2,M1) - RNOFHW(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZNO3H2(M3,M2,M1)) - 2*VLNO3(M3,M2,M1) - RNXFHS(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZNO2H2(M3,M2,M1)) - 2*VLNO3(M3,M2,M1) - RH2PHS(N,M6,M5,M4)=VFLW*AMAX1(0.0,H2P4H2(M3,M2,M1)) - 2*VLPO4(M3,M2,M1) - RN4FHB(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZN4BH2(M3,M2,M1)) - 2*VLNHB(M3,M2,M1) - RN3FHB(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZN3BH2(M3,M2,M1)) - 2*VLNHB(M3,M2,M1) - RNOFHB(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZNOBH2(M3,M2,M1)) - 2*VLNOB(M3,M2,M1) - RNXFHB(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZN2BH2(M3,M2,M1)) - 2*VLNOB(M3,M2,M1) - RH2BHB(N,M6,M5,M4)=VFLW*AMAX1(0.0,H2PBH2(M3,M2,M1)) - 2*VLPOB(M3,M2,M1) -C -C NO SOLUTE GAIN IN SUBSURFACE MACROPORES -C - ELSE - DO 9530 K=0,4 - ROCFHS(K,N,M6,M5,M4)=0.0 - RONFHS(K,N,M6,M5,M4)=0.0 - ROPFHS(K,N,M6,M5,M4)=0.0 - ROAFHS(K,N,M6,M5,M4)=0.0 -9530 CONTINUE - RCOFHS(N,M6,M5,M4)=0.0 - RCHFHS(N,M6,M5,M4)=0.0 - ROXFHS(N,M6,M5,M4)=0.0 - RNGFHS(N,M6,M5,M4)=0.0 - RN2FHS(N,M6,M5,M4)=0.0 - RN4FHW(N,M6,M5,M4)=0.0 - RHGFHS(N,M6,M5,M4)=0.0 - RN3FHW(N,M6,M5,M4)=0.0 - RNOFHW(N,M6,M5,M4)=0.0 - RNXFHS(N,M6,M5,M4)=0.0 - RH2PHS(N,M6,M5,M4)=0.0 - RN4FHB(N,M6,M5,M4)=0.0 - RN3FHB(N,M6,M5,M4)=0.0 - RNOFHB(N,M6,M5,M4)=0.0 - RNXFHB(N,M6,M5,M4)=0.0 - RH2BHB(N,M6,M5,M4)=0.0 - ENDIF -C -C ACCUMULATE HOURLY FLUXES -C - DO 9555 K=0,4 - XOCFLS(K,N,M6,M5,M4)=XOCFLS(K,N,M6,M5,M4)+ROCFLS(K,N,M6,M5,M4) - XONFLS(K,N,M6,M5,M4)=XONFLS(K,N,M6,M5,M4)+RONFLS(K,N,M6,M5,M4) - XOPFLS(K,N,M6,M5,M4)=XOPFLS(K,N,M6,M5,M4)+ROPFLS(K,N,M6,M5,M4) - XOAFLS(K,N,M6,M5,M4)=XOAFLS(K,N,M6,M5,M4)+ROAFLS(K,N,M6,M5,M4) - XOCFHS(K,N,M6,M5,M4)=XOCFHS(K,N,M6,M5,M4)+ROCFHS(K,N,M6,M5,M4) - XONFHS(K,N,M6,M5,M4)=XONFHS(K,N,M6,M5,M4)+RONFHS(K,N,M6,M5,M4) - XOPFHS(K,N,M6,M5,M4)=XOPFHS(K,N,M6,M5,M4)+ROPFHS(K,N,M6,M5,M4) - XOAFHS(K,N,M6,M5,M4)=XOAFHS(K,N,M6,M5,M4)+ROAFHS(K,N,M6,M5,M4) -9555 CONTINUE - XCOFLS(N,M6,M5,M4)=XCOFLS(N,M6,M5,M4)+RCOFLS(N,M6,M5,M4) - XCHFLS(N,M6,M5,M4)=XCHFLS(N,M6,M5,M4)+RCHFLS(N,M6,M5,M4) - XOXFLS(N,M6,M5,M4)=XOXFLS(N,M6,M5,M4)+ROXFLS(N,M6,M5,M4) - XNGFLS(N,M6,M5,M4)=XNGFLS(N,M6,M5,M4)+RNGFLS(N,M6,M5,M4) - XN2FLS(N,M6,M5,M4)=XN2FLS(N,M6,M5,M4)+RN2FLS(N,M6,M5,M4) - XHGFLS(N,M6,M5,M4)=XHGFLS(N,M6,M5,M4)+RHGFLS(N,M6,M5,M4) - XN4FLW(N,M6,M5,M4)=XN4FLW(N,M6,M5,M4)+RN4FLW(N,M6,M5,M4) - XN3FLW(N,M6,M5,M4)=XN3FLW(N,M6,M5,M4)+RN3FLW(N,M6,M5,M4) - XNOFLW(N,M6,M5,M4)=XNOFLW(N,M6,M5,M4)+RNOFLW(N,M6,M5,M4) - XNXFLS(N,M6,M5,M4)=XNXFLS(N,M6,M5,M4)+RNXFLS(N,M6,M5,M4) - XH2PFS(N,M6,M5,M4)=XH2PFS(N,M6,M5,M4)+RH2PFS(N,M6,M5,M4) - XN4FLB(N,M6,M5,M4)=XN4FLB(N,M6,M5,M4)+RN4FLB(N,M6,M5,M4) - XN3FLB(N,M6,M5,M4)=XN3FLB(N,M6,M5,M4)+RN3FLB(N,M6,M5,M4) - XNOFLB(N,M6,M5,M4)=XNOFLB(N,M6,M5,M4)+RNOFLB(N,M6,M5,M4) - XNXFLB(N,M6,M5,M4)=XNXFLB(N,M6,M5,M4)+RNXFLB(N,M6,M5,M4) - XH2BFB(N,M6,M5,M4)=XH2BFB(N,M6,M5,M4)+RH2BFB(N,M6,M5,M4) - XCOFHS(N,M6,M5,M4)=XCOFHS(N,M6,M5,M4)+RCOFHS(N,M6,M5,M4) - XCHFHS(N,M6,M5,M4)=XCHFHS(N,M6,M5,M4)+RCHFHS(N,M6,M5,M4) - XOXFHS(N,M6,M5,M4)=XOXFHS(N,M6,M5,M4)+ROXFHS(N,M6,M5,M4) - XNGFHS(N,M6,M5,M4)=XNGFHS(N,M6,M5,M4)+RNGFHS(N,M6,M5,M4) - XN2FHS(N,M6,M5,M4)=XN2FHS(N,M6,M5,M4)+RN2FHS(N,M6,M5,M4) - XHGFHS(N,M6,M5,M4)=XHGFHS(N,M6,M5,M4)+RHGFHS(N,M6,M5,M4) - XN4FHW(N,M6,M5,M4)=XN4FHW(N,M6,M5,M4)+RN4FHW(N,M6,M5,M4) - XN3FHW(N,M6,M5,M4)=XN3FHW(N,M6,M5,M4)+RN3FHW(N,M6,M5,M4) - XNOFHW(N,M6,M5,M4)=XNOFHW(N,M6,M5,M4)+RNOFHW(N,M6,M5,M4) - XNXFHS(N,M6,M5,M4)=XNXFHS(N,M6,M5,M4)+RNXFHS(N,M6,M5,M4) - XH2PHS(N,M6,M5,M4)=XH2PHS(N,M6,M5,M4)+RH2PHS(N,M6,M5,M4) - XN4FHB(N,M6,M5,M4)=XN4FHB(N,M6,M5,M4)+RN4FHB(N,M6,M5,M4) - XN3FHB(N,M6,M5,M4)=XN3FHB(N,M6,M5,M4)+RN3FHB(N,M6,M5,M4) - XNOFHB(N,M6,M5,M4)=XNOFHB(N,M6,M5,M4)+RNOFHB(N,M6,M5,M4) - XNXFHB(N,M6,M5,M4)=XNXFHB(N,M6,M5,M4)+RNXFHB(N,M6,M5,M4) - XH2BHB(N,M6,M5,M4)=XH2BHB(N,M6,M5,M4)+RH2BHB(N,M6,M5,M4) - ENDIF - ENDIF -C -C NO GASOUS GAIN WITH SUBSURFACE MICROPORE WATER LOSS -C - FLGM=(FLWM(M,N,M6,M5,M4)+FLWHM(M,N,M6,M5,M4))*XNPT -C IF(NN.EQ.1.AND.FLGM.GT.0.0 -C 2.OR.NN.EQ.2.AND.FLGM.LT.0.0)THEN -C IF(VOLPM(M,M3,M2,M1).GT.ZEROS(M2,M1))THEN -C VFLW=-AMAX1(-XFRX,AMIN1(XFRX,FLGM -C 2/VOLPM(M,M3,M2,M1))) -C ELSE -C VFLW=0.0 -C ENDIF -C RCOFLG(N,M6,M5,M4)=VFLW*AMAX1(0.0,CO2G2(M3,M2,M1)) -C RCHFLG(N,M6,M5,M4)=VFLW*AMAX1(0.0,CH4G2(M3,M2,M1)) -C ROXFLG(N,M6,M5,M4)=VFLW*AMAX1(0.0,OXYG2(M3,M2,M1)) -C RNGFLG(N,M6,M5,M4)=VFLW*AMAX1(0.0,Z2GG2(M3,M2,M1)) -C RN2FLG(N,M6,M5,M4)=VFLW*AMAX1(0.0,Z2OG2(M3,M2,M1)) -C RN3FLG(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZN3G2(M3,M2,M1)) -C RHGFLG(N,M6,M5,M4)=VFLW*AMAX1(0.0,H2GG2(M3,M2,M1)) -C XCOFLG(N,M6,M5,M4)=XCOFLG(N,M6,M5,M4)+RCOFLG(N,M6,M5,M4) -C XCHFLG(N,M6,M5,M4)=XCHFLG(N,M6,M5,M4)+RCHFLG(N,M6,M5,M4) -C XOXFLG(N,M6,M5,M4)=XOXFLG(N,M6,M5,M4)+ROXFLG(N,M6,M5,M4) -C XNGFLG(N,M6,M5,M4)=XNGFLG(N,M6,M5,M4)+RNGFLG(N,M6,M5,M4) -C XN2FLG(N,M6,M5,M4)=XN2FLG(N,M6,M5,M4)+RN2FLG(N,M6,M5,M4) -C XN3FLG(N,M6,M5,M4)=XN3FLG(N,M6,M5,M4)+RN3FLG(N,M6,M5,M4) -C XHGFLG(N,M6,M5,M4)=XHGFLG(N,M6,M5,M4)+RHGFLG(N,M6,M5,M4) -C IF(FLGM.NE.0.0)THEN -C WRITE(*,8766)'GAS IN',I,J,M,MM,N,NN,M3,M2,M1,M6,M5,M4 -C 2,VFLW,VOLPM(M,M3,M2,M1),ROXFLG(N,M6,M5,M4) -C 3,OXYG2(M3,M2,M1),FLGM,FLWM(M,N,M6,M5,M4) -C 4,FLWHM(M,N,M6,M5,M4) -8766 FORMAT(A8,12I4,20E12.4) -C ENDIF -C -C GASOUS LOSS WITH SUBSURFACE MICROPORE WATER GAIN -C - IF(NN.EQ.1.AND.FLGM.LT.0.0 - 2.OR.NN.EQ.2.AND.FLGM.GT.0.0)THEN - IF(VOLPM(M,M3,M2,M1).GT.ZEROS(M2,M1))THEN - VFLW=-AMAX1(-XFRX,AMIN1(XFRX,FLGM - 2/VOLPM(M,M3,M2,M1))) - ELSE - VFLW=0.0 - ENDIF - RCOFLG(N,M6,M5,M4)=VFLW*AMAX1(0.0,CO2G2(M3,M2,M1)) - RCHFLG(N,M6,M5,M4)=VFLW*AMAX1(0.0,CH4G2(M3,M2,M1)) - ROXFLG(N,M6,M5,M4)=VFLW*AMAX1(0.0,OXYG2(M3,M2,M1)) - RNGFLG(N,M6,M5,M4)=VFLW*AMAX1(0.0,Z2GG2(M3,M2,M1)) - RN2FLG(N,M6,M5,M4)=VFLW*AMAX1(0.0,Z2OG2(M3,M2,M1)) - RN3FLG(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZN3G2(M3,M2,M1)) - RHGFLG(N,M6,M5,M4)=VFLW*AMAX1(0.0,H2GG2(M3,M2,M1)) - XCOFLG(N,M6,M5,M4)=XCOFLG(N,M6,M5,M4)+RCOFLG(N,M6,M5,M4) - XCHFLG(N,M6,M5,M4)=XCHFLG(N,M6,M5,M4)+RCHFLG(N,M6,M5,M4) - XOXFLG(N,M6,M5,M4)=XOXFLG(N,M6,M5,M4)+ROXFLG(N,M6,M5,M4) - XNGFLG(N,M6,M5,M4)=XNGFLG(N,M6,M5,M4)+RNGFLG(N,M6,M5,M4) - XN2FLG(N,M6,M5,M4)=XN2FLG(N,M6,M5,M4)+RN2FLG(N,M6,M5,M4) - XN3FLG(N,M6,M5,M4)=XN3FLG(N,M6,M5,M4)+RN3FLG(N,M6,M5,M4) - XHGFLG(N,M6,M5,M4)=XHGFLG(N,M6,M5,M4)+RHGFLG(N,M6,M5,M4) -C IF(FLGM.NE.0.0)THEN -C WRITE(*,8766)'GAS OUT',I,J,M,MM,N,NN,M3,M2,M1,M6,M5,M4 -C 2,VFLW,VOLPM(M,M3,M2,M1),ROXFLG(N,M6,M5,M4) -C 3,OXYG2(M3,M2,M1),FLGM,FLWM(M,N,M6,M5,M4) -C 4,FLWHM(M,N,M6,M5,M4) -C ENDIF - ELSE - RCOFLG(N,M6,M5,M4)=0.0 - RCHFLG(N,M6,M5,M4)=0.0 - ROXFLG(N,M6,M5,M4)=0.0 - RNGFLG(N,M6,M5,M4)=0.0 - RN2FLG(N,M6,M5,M4)=0.0 - RN3FLG(N,M6,M5,M4)=0.0 - RHGFLG(N,M6,M5,M4)=0.0 - ENDIF -9575 CONTINUE -C -C TOTAL GAS AND SOLUTE FLUXES IN EACH GRID CELL -C - IF(M.NE.MX)THEN - IF(L.EQ.NU(N2,N1).AND.N.NE.3)THEN -C -C TOTAL OVERLAND FLUX -C - DO 9550 K=0,2 - 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) - TQROA(K,N2,N1)=TQROA(K,N2,N1)+RQROA(K,N,N2,N1)-RQROA(K,N,N5,N4) -9550 CONTINUE - TQRCOS(N2,N1)=TQRCOS(N2,N1)+RQRCOS(N,N2,N1)-RQRCOS(N,N5,N4) - TQRCHS(N2,N1)=TQRCHS(N2,N1)+RQRCHS(N,N2,N1)-RQRCHS(N,N5,N4) - TQROXS(N2,N1)=TQROXS(N2,N1)+RQROXS(N,N2,N1)-RQROXS(N,N5,N4) - TQRNGS(N2,N1)=TQRNGS(N2,N1)+RQRNGS(N,N2,N1)-RQRNGS(N,N5,N4) - TQRN2S(N2,N1)=TQRN2S(N2,N1)+RQRN2S(N,N2,N1)-RQRN2S(N,N5,N4) - TQRHGS(N2,N1)=TQRHGS(N2,N1)+RQRHGS(N,N2,N1)-RQRHGS(N,N5,N4) - TQRNH4(N2,N1)=TQRNH4(N2,N1)+RQRNH4(N,N2,N1)-RQRNH4(N,N5,N4) - TQRNH3(N2,N1)=TQRNH3(N2,N1)+RQRNH3(N,N2,N1)-RQRNH3(N,N5,N4) - TQRNO3(N2,N1)=TQRNO3(N2,N1)+RQRNO3(N,N2,N1)-RQRNO3(N,N5,N4) - TQRNO2(N2,N1)=TQRNO2(N2,N1)+RQRNO2(N,N2,N1)-RQRNO2(N,N5,N4) - TQRH2P(N2,N1)=TQRH2P(N2,N1)+RQRH2P(N,N2,N1)-RQRH2P(N,N5,N4) - TQSCOS(N2,N1)=TQSCOS(N2,N1)+RQSCOS(N,N2,N1)-RQSCOS(N,N5,N4) - TQSCHS(N2,N1)=TQSCHS(N2,N1)+RQSCHS(N,N2,N1)-RQSCHS(N,N5,N4) - TQSOXS(N2,N1)=TQSOXS(N2,N1)+RQSOXS(N,N2,N1)-RQSOXS(N,N5,N4) - TQSNGS(N2,N1)=TQSNGS(N2,N1)+RQSNGS(N,N2,N1)-RQSNGS(N,N5,N4) - TQSN2S(N2,N1)=TQSN2S(N2,N1)+RQSN2S(N,N2,N1)-RQSN2S(N,N5,N4) - TQSNH4(N2,N1)=TQSNH4(N2,N1)+RQSNH4(N,N2,N1)-RQSNH4(N,N5,N4) - TQSNH3(N2,N1)=TQSNH3(N2,N1)+RQSNH3(N,N2,N1)-RQSNH3(N,N5,N4) - TQSNO3(N2,N1)=TQSNO3(N2,N1)+RQSNO3(N,N2,N1)-RQSNO3(N,N5,N4) - TQSH2P(N2,N1)=TQSH2P(N2,N1)+RQSH2P(N,N2,N1)-RQSH2P(N,N5,N4) - ENDIF - ENDIF -C -C TOTAL SOLUTE FLUX IN MICROPORES AND MACROPORES -C - IF(M.NE.MX)THEN - IF(NCN(N2,N1).NE.3.OR.N.EQ.3)THEN - DO 9545 K=0,4 - TOCFLS(K,N3,N2,N1)=TOCFLS(K,N3,N2,N1)+ROCFLS(K,N,N3,N2,N1) - 2-ROCFLS(K,N,N6,N5,N4) - TONFLS(K,N3,N2,N1)=TONFLS(K,N3,N2,N1)+RONFLS(K,N,N3,N2,N1) - 2-RONFLS(K,N,N6,N5,N4) - TOPFLS(K,N3,N2,N1)=TOPFLS(K,N3,N2,N1)+ROPFLS(K,N,N3,N2,N1) - 2-ROPFLS(K,N,N6,N5,N4) - TOAFLS(K,N3,N2,N1)=TOAFLS(K,N3,N2,N1)+ROAFLS(K,N,N3,N2,N1) - 2-ROAFLS(K,N,N6,N5,N4) - TOCFHS(K,N3,N2,N1)=TOCFHS(K,N3,N2,N1)+ROCFHS(K,N,N3,N2,N1) - 2-ROCFHS(K,N,N6,N5,N4) - TONFHS(K,N3,N2,N1)=TONFHS(K,N3,N2,N1)+RONFHS(K,N,N3,N2,N1) - 2-RONFHS(K,N,N6,N5,N4) - TOPFHS(K,N3,N2,N1)=TOPFHS(K,N3,N2,N1)+ROPFHS(K,N,N3,N2,N1) - 2-ROPFHS(K,N,N6,N5,N4) - TOAFHS(K,N3,N2,N1)=TOAFHS(K,N3,N2,N1)+ROAFHS(K,N,N3,N2,N1) - 2-ROAFHS(K,N,N6,N5,N4) -9545 CONTINUE - TCOFLS(N3,N2,N1)=TCOFLS(N3,N2,N1)+RCOFLS(N,N3,N2,N1) - 2-RCOFLS(N,N6,N5,N4) - TCHFLS(N3,N2,N1)=TCHFLS(N3,N2,N1)+RCHFLS(N,N3,N2,N1) - 2-RCHFLS(N,N6,N5,N4) - TOXFLS(N3,N2,N1)=TOXFLS(N3,N2,N1)+ROXFLS(N,N3,N2,N1) - 2-ROXFLS(N,N6,N5,N4) - TNGFLS(N3,N2,N1)=TNGFLS(N3,N2,N1)+RNGFLS(N,N3,N2,N1) - 2-RNGFLS(N,N6,N5,N4) - TN2FLS(N3,N2,N1)=TN2FLS(N3,N2,N1)+RN2FLS(N,N3,N2,N1) - 2-RN2FLS(N,N6,N5,N4) - THGFLS(N3,N2,N1)=THGFLS(N3,N2,N1)+RHGFLS(N,N3,N2,N1) - 2-RHGFLS(N,N6,N5,N4) - TN4FLW(N3,N2,N1)=TN4FLW(N3,N2,N1)+RN4FLW(N,N3,N2,N1) - 2-RN4FLW(N,N6,N5,N4) - TN3FLW(N3,N2,N1)=TN3FLW(N3,N2,N1)+RN3FLW(N,N3,N2,N1) - 2-RN3FLW(N,N6,N5,N4) - TNOFLW(N3,N2,N1)=TNOFLW(N3,N2,N1)+RNOFLW(N,N3,N2,N1) - 2-RNOFLW(N,N6,N5,N4) - TNXFLS(N3,N2,N1)=TNXFLS(N3,N2,N1)+RNXFLS(N,N3,N2,N1) - 2-RNXFLS(N,N6,N5,N4) - TH2PFS(N3,N2,N1)=TH2PFS(N3,N2,N1)+RH2PFS(N,N3,N2,N1) - 2-RH2PFS(N,N6,N5,N4) - TN4FLB(N3,N2,N1)=TN4FLB(N3,N2,N1)+RN4FLB(N,N3,N2,N1) - 2-RN4FLB(N,N6,N5,N4) - TN3FLB(N3,N2,N1)=TN3FLB(N3,N2,N1)+RN3FLB(N,N3,N2,N1) - 2-RN3FLB(N,N6,N5,N4) - TNOFLB(N3,N2,N1)=TNOFLB(N3,N2,N1)+RNOFLB(N,N3,N2,N1) - 2-RNOFLB(N,N6,N5,N4) - TNXFLB(N3,N2,N1)=TNXFLB(N3,N2,N1)+RNXFLB(N,N3,N2,N1) - 2-RNXFLB(N,N6,N5,N4) - TH2BFB(N3,N2,N1)=TH2BFB(N3,N2,N1)+RH2BFB(N,N3,N2,N1) - 2-RH2BFB(N,N6,N5,N4) - TCOFHS(N3,N2,N1)=TCOFHS(N3,N2,N1)+RCOFHS(N,N3,N2,N1) - 2-RCOFHS(N,N6,N5,N4) - TCHFHS(N3,N2,N1)=TCHFHS(N3,N2,N1)+RCHFHS(N,N3,N2,N1) - 2-RCHFHS(N,N6,N5,N4) - TOXFHS(N3,N2,N1)=TOXFHS(N3,N2,N1)+ROXFHS(N,N3,N2,N1) - 2-ROXFHS(N,N6,N5,N4) - TNGFHS(N3,N2,N1)=TNGFHS(N3,N2,N1)+RNGFHS(N,N3,N2,N1) - 2-RNGFHS(N,N6,N5,N4) - TN2FHS(N3,N2,N1)=TN2FHS(N3,N2,N1)+RN2FHS(N,N3,N2,N1) - 2-RN2FHS(N,N6,N5,N4) - THGFHS(N3,N2,N1)=THGFHS(N3,N2,N1)+RHGFHS(N,N3,N2,N1) - 2-RHGFHS(N,N6,N5,N4) - TN4FHW(N3,N2,N1)=TN4FHW(N3,N2,N1)+RN4FHW(N,N3,N2,N1) - 2-RN4FHW(N,N6,N5,N4) - TN3FHW(N3,N2,N1)=TN3FHW(N3,N2,N1)+RN3FHW(N,N3,N2,N1) - 2-RN3FHW(N,N6,N5,N4) - TNOFHW(N3,N2,N1)=TNOFHW(N3,N2,N1)+RNOFHW(N,N3,N2,N1) - 2-RNOFHW(N,N6,N5,N4) - TNXFHS(N3,N2,N1)=TNXFHS(N3,N2,N1)+RNXFHS(N,N3,N2,N1) - 2-RNXFHS(N,N6,N5,N4) - TH2PHS(N3,N2,N1)=TH2PHS(N3,N2,N1)+RH2PHS(N,N3,N2,N1) - 2-RH2PHS(N,N6,N5,N4) - TN4FHB(N3,N2,N1)=TN4FHB(N3,N2,N1)+RN4FHB(N,N3,N2,N1) - 2-RN4FHB(N,N6,N5,N4) - TN3FHB(N3,N2,N1)=TN3FHB(N3,N2,N1)+RN3FHB(N,N3,N2,N1) - 2-RN3FHB(N,N6,N5,N4) - TNOFHB(N3,N2,N1)=TNOFHB(N3,N2,N1)+RNOFHB(N,N3,N2,N1) - 2-RNOFHB(N,N6,N5,N4) - TNXFHB(N3,N2,N1)=TNXFHB(N3,N2,N1)+RNXFHB(N,N3,N2,N1) - 2-RNXFHB(N,N6,N5,N4) - TH2BHB(N3,N2,N1)=TH2BHB(N3,N2,N1)+RH2BHB(N,N3,N2,N1) - 2-RH2BHB(N,N6,N5,N4) - ENDIF - ENDIF -C -C TOTAL GAS FLUX -C -C IF(NCN(N2,N1).NE.3.OR.N.EQ.3)THEN - TCOFLG(N3,N2,N1)=TCOFLG(N3,N2,N1)+RCOFLG(N,N3,N2,N1) - 2-RCOFLG(N,N6,N5,N4) - TCHFLG(N3,N2,N1)=TCHFLG(N3,N2,N1)+RCHFLG(N,N3,N2,N1) - 2-RCHFLG(N,N6,N5,N4) - TOXFLG(N3,N2,N1)=TOXFLG(N3,N2,N1)+ROXFLG(N,N3,N2,N1) - 2-ROXFLG(N,N6,N5,N4) - TNGFLG(N3,N2,N1)=TNGFLG(N3,N2,N1)+RNGFLG(N,N3,N2,N1) - 2-RNGFLG(N,N6,N5,N4) - TN2FLG(N3,N2,N1)=TN2FLG(N3,N2,N1)+RN2FLG(N,N3,N2,N1) - 2-RN2FLG(N,N6,N5,N4) - TN3FLG(N3,N2,N1)=TN3FLG(N3,N2,N1)+RN3FLG(N,N3,N2,N1) - 2-RN3FLG(N,N6,N5,N4) - THGFLG(N3,N2,N1)=THGFLG(N3,N2,N1)+RHGFLG(N,N3,N2,N1) - 2-RHGFLG(N,N6,N5,N4) -C ENDIF -9580 CONTINUE -9585 CONTINUE -9590 CONTINUE -9595 CONTINUE -C -C UPDATE STATE VARIABLES FROM TOTAL FLUXES CALCULATED ABOVE -C - IF(MM.NE.NPG)THEN - DO 9695 NX=NHW,NHE - DO 9690 NY=NVN,NVS - IF(M.NE.MX)THEN -C -C STATE VARIABLES FOR SOLUTES IN MICROPORES AND MACROPORES IN -C SOIL SURFACE LAYER FROM OVERLAND FLOW AND SURFACE VOLATILIZATION- -C DISSOLUTION -C - DO 9681 K=0,2 - 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) - OQA2(K,0,NY,NX)=OQA2(K,0,NY,NX)+ROAFLS(K,3,0,NY,NX) -9681 CONTINUE - CO2S2(0,NY,NX)=CO2S2(0,NY,NX)+RCODFR(NY,NX)+RCOFLS(3,0,NY,NX) - CH4S2(0,NY,NX)=CH4S2(0,NY,NX)+RCHDFR(NY,NX)+RCHFLS(3,0,NY,NX) - OXYS2(0,NY,NX)=OXYS2(0,NY,NX)+ROXDFR(NY,NX)+ROXFLS(3,0,NY,NX) - Z2GS2(0,NY,NX)=Z2GS2(0,NY,NX)+RNGDFR(NY,NX)+RNGFLS(3,0,NY,NX) - Z2OS2(0,NY,NX)=Z2OS2(0,NY,NX)+RN2DFR(NY,NX)+RN2FLS(3,0,NY,NX) - H2GS2(0,NY,NX)=H2GS2(0,NY,NX)+RHGDFR(NY,NX)+RHGFLS(3,0,NY,NX) - ZNH4S2(0,NY,NX)=ZNH4S2(0,NY,NX)+RN4FLW(3,0,NY,NX) - ZN3S2(0,NY,NX)=ZN3S2(0,NY,NX)+RN3DFR(NY,NX)+RN3FLW(3,0,NY,NX) - ZNO3S2(0,NY,NX)=ZNO3S2(0,NY,NX)+RNOFLW(3,0,NY,NX) - ZNO2S2(0,NY,NX)=ZNO2S2(0,NY,NX)+RNXFLS(3,0,NY,NX) - H2PO42(0,NY,NX)=H2PO42(0,NY,NX)+RH2PFS(3,0,NY,NX) - CO2S2(NU(NY,NX),NY,NX)=CO2S2(NU(NY,NX),NY,NX)+RCODFS(NY,NX) - CH4S2(NU(NY,NX),NY,NX)=CH4S2(NU(NY,NX),NY,NX)+RCHDFS(NY,NX) - OXYS2(NU(NY,NX),NY,NX)=OXYS2(NU(NY,NX),NY,NX)+ROXDFS(NY,NX) - Z2GS2(NU(NY,NX),NY,NX)=Z2GS2(NU(NY,NX),NY,NX)+RNGDFS(NY,NX) - Z2OS2(NU(NY,NX),NY,NX)=Z2OS2(NU(NY,NX),NY,NX)+RN2DFS(NY,NX) - 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) - DO 9680 K=0,2 - 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) - OQA2(K,0,NY,NX)=OQA2(K,0,NY,NX)+TQROA(K,NY,NX) -9680 CONTINUE - CO2S2(0,NY,NX)=CO2S2(0,NY,NX)+TQRCOS(NY,NX) - CH4S2(0,NY,NX)=CH4S2(0,NY,NX)+TQRCHS(NY,NX) - OXYS2(0,NY,NX)=OXYS2(0,NY,NX)+TQROXS(NY,NX) - Z2GS2(0,NY,NX)=Z2GS2(0,NY,NX)+TQRNGS(NY,NX) - Z2OS2(0,NY,NX)=Z2OS2(0,NY,NX)+TQRN2S(NY,NX) - H2GS2(0,NY,NX)=H2GS2(0,NY,NX)+TQRHGS(NY,NX) - ZNH4S2(0,NY,NX)=ZNH4S2(0,NY,NX)+TQRNH4(NY,NX) - ZN3S2(0,NY,NX)=ZN3S2(0,NY,NX)+TQRNH3(NY,NX) - ZNO3S2(0,NY,NX)=ZNO3S2(0,NY,NX)+TQRNO3(NY,NX) - ZNO2S2(0,NY,NX)=ZNO2S2(0,NY,NX)+TQRNO2(NY,NX) - H2PO42(0,NY,NX)=H2PO42(0,NY,NX)+TQRH2P(NY,NX) -C IF(I.EQ.87)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) -C WRITE(*,8787)'OXYS20',I,J,NX,NY,M,MM,OXYS2(0,NY,NX) -C 2,ROXDFR(NY,NX),ROXFLS(3,0,NY,NX),ROXSK2(0,NY,NX) -C 3,TQROXS(NY,NX),ROXDFG(0,NY,NX),XOXFLS(3,0,NY,NX) -8787 FORMAT(A8,6I4,12E12.4) -C ENDIF - CO2W2(NY,NX)=CO2W2(NY,NX)+TQSCOS(NY,NX) - CH4W2(NY,NX)=CH4W2(NY,NX)+TQSCHS(NY,NX) - OXYW2(NY,NX)=OXYW2(NY,NX)+TQSOXS(NY,NX) - ZNGW2(NY,NX)=ZNGW2(NY,NX)+TQSNGS(NY,NX) - ZN2W2(NY,NX)=ZN2W2(NY,NX)+TQSN2S(NY,NX) - ZN4W2(NY,NX)=ZN4W2(NY,NX)+TQSNH4(NY,NX) - ZN3W2(NY,NX)=ZN3W2(NY,NX)+TQSNH3(NY,NX) - ZNOW2(NY,NX)=ZNOW2(NY,NX)+TQSNO3(NY,NX) - ZHPW2(NY,NX)=ZHPW2(NY,NX)+TQSH2P(NY,NX) -C IF(I.EQ.118.AND.NX.EQ.3.AND.NY.EQ.4)THEN -C WRITE(*,6868)'OXYW2',I,J,NX,NY,M,MM,OXYW2(NY,NX) -C 2,TQSOXS(NY,NX),XOXBLS(NY,NX) -6868 FORMAT(A8,6I4,12E12.4) -C ENDIF - ENDIF -C -C STATE VARIABLES FOR GASES AND FOR SOLUTES IN MICROPORES AND -C MACROPORES IN SOIL LAYERS FROM SUBSURFACE FLOW, MICROBIAL -C AND ROOT EXCHANGE IN 'NITRO' AND 'UPTAKE', AND EQUILIBRIUM -C REACTIONS IN 'SOLUTE' -C - DO 9685 L=NU(NY,NX),NL(NY,NX) - IF(M.NE.MX)THEN - CO2S2(L,NY,NX)=CO2S2(L,NY,NX)+TCOFLS(L,NY,NX)+RCOFXS(L,NY,NX) - 2+RCOFLZ(L,NY,NX)+RCOBBL(L,NY,NX) - CH4S2(L,NY,NX)=CH4S2(L,NY,NX)+TCHFLS(L,NY,NX)+RCHFXS(L,NY,NX) - 2+RCHFLZ(L,NY,NX)+RCHBBL(L,NY,NX) - OXYS2(L,NY,NX)=OXYS2(L,NY,NX)+TOXFLS(L,NY,NX)+ROXFXS(L,NY,NX) - 2+ROXFLZ(L,NY,NX)+ROXBBL(L,NY,NX) - Z2GS2(L,NY,NX)=Z2GS2(L,NY,NX)+TNGFLS(L,NY,NX)+RNGFXS(L,NY,NX) - 2+RNGFLZ(L,NY,NX)+RNGBBL(L,NY,NX) - Z2OS2(L,NY,NX)=Z2OS2(L,NY,NX)+TN2FLS(L,NY,NX)+RN2FXS(L,NY,NX) - 2+RN2FLZ(L,NY,NX)+RN2BBL(L,NY,NX) - ZN3S2(L,NY,NX)=ZN3S2(L,NY,NX)+TN3FLW(L,NY,NX)+RN3FXW(L,NY,NX) - 2+RN3FLZ(L,NY,NX)+RN3BBL(L,NY,NX) - ZNBS2(L,NY,NX)=ZNBS2(L,NY,NX)+TN3FLB(L,NY,NX)+RN3FXB(L,NY,NX) - 2+RN3FBZ(L,NY,NX)+RNBBBL(L,NY,NX) - H2GS2(L,NY,NX)=H2GS2(L,NY,NX)+THGFLS(L,NY,NX)+RHGFXS(L,NY,NX) - 2+RHGFLZ(L,NY,NX)+RHGBBL(L,NY,NX) - DO 9675 K=0,4 - OQC2(K,L,NY,NX)=OQC2(K,L,NY,NX)+TOCFLS(K,L,NY,NX) - 2+ROCFXS(K,L,NY,NX) - OQN2(K,L,NY,NX)=OQN2(K,L,NY,NX)+TONFLS(K,L,NY,NX) - 2+RONFXS(K,L,NY,NX) - OQP2(K,L,NY,NX)=OQP2(K,L,NY,NX)+TOPFLS(K,L,NY,NX) - 2+ROPFXS(K,L,NY,NX) - OQA2(K,L,NY,NX)=OQA2(K,L,NY,NX)+TOAFLS(K,L,NY,NX) - 2+ROAFXS(K,L,NY,NX) - OQCH2(K,L,NY,NX)=OQCH2(K,L,NY,NX)+TOCFHS(K,L,NY,NX) - 2-ROCFXS(K,L,NY,NX) - OQNH2(K,L,NY,NX)=OQNH2(K,L,NY,NX)+TONFHS(K,L,NY,NX) - 2-RONFXS(K,L,NY,NX) - OQPH2(K,L,NY,NX)=OQPH2(K,L,NY,NX)+TOPFHS(K,L,NY,NX) - 2-ROPFXS(K,L,NY,NX) - OQAH2(K,L,NY,NX)=OQAH2(K,L,NY,NX)+TOAFHS(K,L,NY,NX) - 2-ROAFXS(K,L,NY,NX) -9675 CONTINUE - ZNH4S2(L,NY,NX)=ZNH4S2(L,NY,NX)+TN4FLW(L,NY,NX)+RN4FXW(L,NY,NX) - 2+RN4FLZ(L,NY,NX) - ZNO3S2(L,NY,NX)=ZNO3S2(L,NY,NX)+TNOFLW(L,NY,NX)+RNOFXW(L,NY,NX) - 2+RNOFLZ(L,NY,NX) - ZNO2S2(L,NY,NX)=ZNO2S2(L,NY,NX)+TNXFLS(L,NY,NX)+RNXFXS(L,NY,NX) - H2PO42(L,NY,NX)=H2PO42(L,NY,NX)+TH2PFS(L,NY,NX)+RH2PXS(L,NY,NX) - 2+RH2PFZ(L,NY,NX) - ZNH4B2(L,NY,NX)=ZNH4B2(L,NY,NX)+TN4FLB(L,NY,NX)+RN4FXB(L,NY,NX) - 2+RN4FBZ(L,NY,NX) - ZNO3B2(L,NY,NX)=ZNO3B2(L,NY,NX)+TNOFLB(L,NY,NX)+RNOFXB(L,NY,NX) - 2+RNOFBZ(L,NY,NX) - ZNO2B2(L,NY,NX)=ZNO2B2(L,NY,NX)+TNXFLB(L,NY,NX)+RNXFXB(L,NY,NX) - H2POB2(L,NY,NX)=H2POB2(L,NY,NX)+TH2BFB(L,NY,NX)+RH2BXB(L,NY,NX) - 2+RH2BBZ(L,NY,NX) - CO2SH2(L,NY,NX)=CO2SH2(L,NY,NX)+TCOFHS(L,NY,NX)-RCOFXS(L,NY,NX) - CH4SH2(L,NY,NX)=CH4SH2(L,NY,NX)+TCHFHS(L,NY,NX)-RCHFXS(L,NY,NX) - OXYSH2(L,NY,NX)=OXYSH2(L,NY,NX)+TOXFHS(L,NY,NX)-ROXFXS(L,NY,NX) - Z2GSH2(L,NY,NX)=Z2GSH2(L,NY,NX)+TNGFHS(L,NY,NX)-RNGFXS(L,NY,NX) - Z2OSH2(L,NY,NX)=Z2OSH2(L,NY,NX)+TN2FHS(L,NY,NX)-RN2FXS(L,NY,NX) - H2GSH2(L,NY,NX)=H2GSH2(L,NY,NX)+THGFHS(L,NY,NX)-RHGFXS(L,NY,NX) - ZNH4H2(L,NY,NX)=ZNH4H2(L,NY,NX)+TN4FHW(L,NY,NX)-RN4FXW(L,NY,NX) - ZNH3H2(L,NY,NX)=ZNH3H2(L,NY,NX)+TN3FHW(L,NY,NX)-RN3FXW(L,NY,NX) - ZNO3H2(L,NY,NX)=ZNO3H2(L,NY,NX)+TNOFHW(L,NY,NX)-RNOFXW(L,NY,NX) - ZNO2H2(L,NY,NX)=ZNO2H2(L,NY,NX)+TNXFHS(L,NY,NX)-RNXFXS(L,NY,NX) - H2P4H2(L,NY,NX)=H2P4H2(L,NY,NX)+TH2PHS(L,NY,NX)-RH2PXS(L,NY,NX) - ZN4BH2(L,NY,NX)=ZN4BH2(L,NY,NX)+TN4FHB(L,NY,NX)-RN4FXB(L,NY,NX) - ZN3BH2(L,NY,NX)=ZN3BH2(L,NY,NX)+TN3FHB(L,NY,NX)-RN3FXB(L,NY,NX) - ZNOBH2(L,NY,NX)=ZNOBH2(L,NY,NX)+TNOFHB(L,NY,NX)-RNOFXB(L,NY,NX) - ZN2BH2(L,NY,NX)=ZN2BH2(L,NY,NX)+TNXFHB(L,NY,NX)-RNXFXB(L,NY,NX) - H2PBH2(L,NY,NX)=H2PBH2(L,NY,NX)+TH2BHB(L,NY,NX)-RH2BXB(L,NY,NX) - ENDIF - CO2S2(L,NY,NX)=CO2S2(L,NY,NX)+RCODFG(L,NY,NX) - CH4S2(L,NY,NX)=CH4S2(L,NY,NX)+RCHDFG(L,NY,NX) - OXYS2(L,NY,NX)=OXYS2(L,NY,NX)+ROXDFG(L,NY,NX) - Z2GS2(L,NY,NX)=Z2GS2(L,NY,NX)+RNGDFG(L,NY,NX) - Z2OS2(L,NY,NX)=Z2OS2(L,NY,NX)+RN2DFG(L,NY,NX) - ZN3S2(L,NY,NX)=ZN3S2(L,NY,NX)+RN3DFG(L,NY,NX)-RN34SQ(L,NY,NX) - ZNH4S2(L,NY,NX)=ZNH4S2(L,NY,NX)+RN34SQ(L,NY,NX) - ZNBS2(L,NY,NX)=ZNBS2(L,NY,NX)+RNBDFG(L,NY,NX)-RN34BQ(L,NY,NX) - ZNH4B2(L,NY,NX)=ZNH4B2(L,NY,NX)+RN34BQ(L,NY,NX) - H2GS2(L,NY,NX)=H2GS2(L,NY,NX)+RHGDFG(L,NY,NX) - CO2G2(L,NY,NX)=CO2G2(L,NY,NX)+TCOFLG(L,NY,NX)-RCODFG(L,NY,NX) - CH4G2(L,NY,NX)=CH4G2(L,NY,NX)+TCHFLG(L,NY,NX)-RCHDFG(L,NY,NX) - OXYG2(L,NY,NX)=OXYG2(L,NY,NX)+TOXFLG(L,NY,NX)-ROXDFG(L,NY,NX) - Z2GG2(L,NY,NX)=Z2GG2(L,NY,NX)+TNGFLG(L,NY,NX)-RNGDFG(L,NY,NX) - Z2OG2(L,NY,NX)=Z2OG2(L,NY,NX)+TN2FLG(L,NY,NX)-RN2DFG(L,NY,NX) - 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(I.EQ.22.AND.J.EQ.12.AND.L.EQ.2)THEN -C WRITE(*,444)'CO2S2',I,J,M,MM,NX,NY,L -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) -C 3,RCODFS(NY,NX),PARG(NY,NX),CCO2E(NY,NX),CCO2SQ -C 4,CO2S2(L,NY,NX)/VOLWM(M,L,NY,NX) -C 7,CO2SH2(L,NY,NX),TCOFHS(L,NY,NX) -C WRITE(*,444)'OXYS2',I,J,M,MX,NX,NY,L -C 2,OXYS2(L,NY,NX),TOXFLS(L,NY,NX),ROXFXS(L,NY,NX) -C 3,ROXFLZ(L,NY,NX),ROXBBL(L,NY,NX),ROXDFG(L,NY,NX) -C 4,ROXSK(M,L,NY,NX),OXYG2(L,NY,NX),ROXFLS(3,L,NY,NX) -C 5,ROXFLS(3,L+1,NY,NX),ROXDFS(NY,NX),ROXSK2(L,NY,NX) -C 6,ROXSK(M,L,NY,NX),VOLWM(M,L,NY,NX) -C WRITE(*,444)'OXYSH2',I,J,M,MX,NX,NY,L -C 2,OXYSH2(L,NY,NX),TOXFHS(L,NY,NX),ROXFXS(L,NY,NX) -C WRITE(*,444)'CH4S2',I,J,NX,NY,L,M,MM,CH4S2(L,NY,NX) -C 2,TCHFLS(L,NY,NX),RCHFXS(L,NY,NX),RCHFLZ(L,NY,NX) -C 3,RCHBBL(L,NY,NX),RCHDFG(L,NY,NX),RCHSK2(L,NY,NX) -C 4,RCHFLS(3,L,NY,NX),RCHFLS(3,L+1,NY,NX) -C 5,RCHDFR(NY,NX),RCHFLS(3,L,NY,NX),RCHSK2(L,NY,NX) -C 3,TQRCHS(NY,NX),RCHDFG(L,NY,NX),XCHFLS(3,L,NY,NX) -C 6,CH4G2(L,NY,NX),TCHFLG(L,NY,NX) -C WRITE(*,444)'Z2GS2',I,J,M,MX,NX,NY,L -C 2,Z2GS2(L,NY,NX),RNGDFG(L,NY,NX),RNGSK2(L,NY,NX) -C 3,RNGDFS(NY,NX),RNGFLS(3,0,NY,NX),TQRNGS(NY,NX) -C 4,TNGFLS(L,NY,NX),RNGFXS(L,NY,NX),RNGFLZ(L,NY,NX) -C 2,RNGBBL(L,NY,NX),Z2GG2(L,NY,NX),TNGFLG(L,NY,NX) -C WRITE(*,444)'ZN3G2',I,J,M,MM,NX,NY,L,ZN3G2(L,NY,NX) -C 2,TN3FLG(L,NY,NX),RN3DFG(L,NY,NX),RN34SQ(L,NY,NX),RNBDFG(L,NY,NX) -C 3,RN34BQ(L,NY,NX),ZN3S2(L,NY,NX),ZNBS2(L,NY,NX) -C 3,ZNH4S2(L,NY,NX),ZNH4B2(L,NY,NX),RNHSK2(L,NY,NX) -C WRITE(*,444)'OXYG2',I,J,M,MM,NX,NY,L,OXYG2(L,NY,NX) -C 2,TOXFLG(L,NY,NX),ROXDFG(L,NY,NX),OXYS2(L,NY,NX) -C 3,ROXFLG(3,L,NY,NX),ROXFLG(3,L+1,NY,NX),DOXYG(3,L,NY,NX) -C 4,THETPM(M,L,NY,NX),PARGOX(NY,NX) -C 6,XOXFLG(3,L,NY,NX),XOXFLG(3,L+1,NY,NX) -C 7,COXYE(NY,NX),FLQM(N,L,NY,NX) -C WRITE(*,444)'N2OG2',I,J,M,MM,NX,NY,L,Z2OG2(L,NY,NX) -C 2,Z2OS2(L,NY,NX),Z2OSH2(L,NY,NX),TN2FLG(L,NY,NX),RN2DFG(L,NY,NX) -C 3,TN2FLS(L,NY,NX),RN2FXS(L,NY,NX),RN2FLZ(L,NY,NX),RN2BBL(L,NY,NX) -C 2,TN2FHS(L,NY,NX),RN2SK2(L,NY,NX),RN2O(L,NY,NX),TUPN2S(L,NY,NX) -C WRITE(*,444)'H2GS2',I,J,NX,NY,M,MM,L,H2GS2(L,NY,NX) -C 2,THGFLS(L,NY,NX),RHGFXS(L,NY,NX),RHGFLZ(L,NY,NX),RHGBBL(L,NY,NX) -C 3,H2GSH2(L,NY,NX),THGFHS(L,NY,NX),RHGDFG(L,NY,NX),RHGSK2(L,NY,NX) -C 4,RH2GO(L,NY,NX),TUPHGS(L,NY,NX) -444 FORMAT(A8,7I4,20E16.6) -C ENDIF -9685 CONTINUE - CO2S2(0,NY,NX)=CO2S2(0,NY,NX)+RCODFG(0,NY,NX) - CH4S2(0,NY,NX)=CH4S2(0,NY,NX)+RCHDFG(0,NY,NX) - OXYS2(0,NY,NX)=OXYS2(0,NY,NX)+ROXDFG(0,NY,NX) - Z2GS2(0,NY,NX)=Z2GS2(0,NY,NX)+RNGDFG(0,NY,NX) - Z2OS2(0,NY,NX)=Z2OS2(0,NY,NX)+RN2DFG(0,NY,NX) - ZN3S2(0,NY,NX)=ZN3S2(0,NY,NX)+RN3DFG(0,NY,NX) - H2GS2(0,NY,NX)=H2GS2(0,NY,NX)+RHGDFG(0,NY,NX) - ZN3S2(0,NY,NX)=ZN3S2(0,NY,NX)-RN34SQ(0,NY,NX) - ZNH4S2(0,NY,NX)=ZNH4S2(0,NY,NX)+RN34SQ(0,NY,NX) -C IF(I.EQ.87)THEN -C WRITE(*,1119)'OXYS20',I,J,NX,NY,M,MM,OXYS2(0,NY,NX) -C 2,ROXDFG(0,NY,NX),ROXDFR(NY,NX),ROXFLS(3,0,NY,NX) -C 3,TQROXS(NY,NX),ROXSK2(0,NY,NX),OXYS2(0,NY,NX)/VOLWM(M,0,NY,NX) -C 4,VOLWM(M,0,NY,NX)/VOLA(0,NY,NX),VOLPM(M,0,NY,NX)/VOLA(0,NY,NX) -C 5,VOLWM(M,0,NY,NX),VOLA(0,NY,NX),VOLWG(NY,NX),DFGS(M,0,NY,NX) -C 6,VOLPM(M,NU(NY,NX),NY,NX),VOLWM(M,NU(NY,NX),NY,NX) -C 7,VOLWHM(M,NU(NY,NX),NY,NX) -C WRITE(*,1119)'CH4S2G',I,J,NX,NY,M,MM,CH4S2(0,NY,NX) -C 2,RCHDFG(0,NY,NX) -1119 FORMAT(A8,6I4,20E12.4) -C ENDIF -9690 CONTINUE -9695 CONTINUE - ENDIF - MX=M -30 CONTINUE - RETURN - END + SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) +C +C THIS SUBROUTINE CALCULATES 3-DIMENSIONAL FLUXES OF ALL SOIL +C NON-SALT SOLUTES AND GASES +C + include "parameters.h" + include "blkc.h" + include "blk2a.h" + include "blk2b.h" + include "blk2c.h" + include "blk8a.h" + include "blk8b.h" + include "blk10.h" + include "blk11a.h" + include "blk11b.h" + include "blk13a.h" + include "blk13b.h" + include "blk13c.h" + include "blk15a.h" + include "blk15b.h" + include "blk18a.h" + include "blk18b.h" + include "blk19d.h" + include "blk20d.h" + include "blk20e.h" + include "blk21a.h" + include "blk21b.h" + include "blk22a.h" + include "blk22b.h" + include "blk22c.h" + DIMENSION CO2G2(JZ,JY,JX),CO2S2(0:JZ,JY,JX) + 2,CH4G2(JZ,JY,JX),CH4S2(0:JZ,JY,JX),OXYG2(JZ,JY,JX) + 3,OXYS2(0:JZ,JY,JX),Z2GG2(JZ,JY,JX),Z2GS2(0:JZ,JY,JX) + 4,Z2OG2(JZ,JY,JX),Z2OS2(0:JZ,JY,JX),ZN3G2(0:JZ,JY,JX) + 5,ZNH4S2(0:JZ,JY,JX),ZNH4B2(0:JZ,JY,JX),ZN3S2(0:JZ,JY,JX) + 6,ZNBS2(0:JZ,JY,JX),ZNO3S2(0:JZ,JY,JX),ZNO3B2(0:JZ,JY,JX) + 7,H2PO42(0:JZ,JY,JX),H2POB2(0:JZ,JY,JX),ZNO2S2(0:JZ,JY,JX) + 8,CGSGL2(JZ,JY,JX),CHSGL2(JZ,JY,JX),OGSGL2(JZ,JY,JX) + 9,ZGSGL2(JZ,JY,JX),Z2SGL2(JZ,JY,JX),ZHSGL2(JZ,JY,JX) + 7,OQC2(0:4,0:JZ,JY,JX),OQN2(0:4,0:JZ,JY,JX),OQP2(0:4,0:JZ,JY,JX) + 8,OQA2(0:4,0:JZ,JY,JX),OCSGL2(0:JZ,JY,JX),ONSGL2(0:JZ,JY,JX) + 9,OPSGL2(0:JZ,JY,JX),OASGL2(0:JZ,JY,JX),CHY0(0:JZ,JY,JX) + 1,CO2W2(JY,JX),CH4W2(JY,JX),OXYW2(JY,JX),ZNGW2(JY,JX) + 2,ZN2W2(JY,JX),ZN4W2(JY,JX),ZN3W2(JY,JX),ZNOW2(JY,JX) + 3,ZHPW2(JY,JX) + DIMENSION ROCSK2(0:4,0:JZ,JY,JX),RONSK2(0:4,0:JZ,JY,JX) + 2,ROPSK2(0:4,0:JZ,JY,JX),ROASK2(0:4,0:JZ,JY,JX) + 3,RCOSK2(0:JZ,JY,JX),ROXSK2(0:JZ,JY,JX),RCHSK2(0:JZ,JY,JX) + 4,RNGSK2(0:JZ,JY,JX),RN2SK2(0:JZ,JY,JX),RN4SK2(0:JZ,JY,JX) + 5,RN3SK2(0:JZ,JY,JX),RNOSK2(0:JZ,JY,JX),RHPSK2(0:JZ,JY,JX) + 6,R4BSK2(JZ,JY,JX),R3BSK2(JZ,JY,JX),RNBSK2(JZ,JY,JX) + 7,RHBSK2(JZ,JY,JX),RNXSK2(0:JZ,JY,JX),RNZSK2(JZ,JY,JX) + 8,RHGSK2(0:JZ,JY,JX),RNHSK2(0:JZ,JY,JX) + DIMENSION CLSGL2(0:JZ,JY,JX),CQSGL2(0:JZ,JY,JX),OLSGL2(0:JZ,JY,JX) + 2,ZNSGL2(0:JZ,JY,JX),ZLSGL2(0:JZ,JY,JX),ZVSGL2(0:JZ,JY,JX) + 3,HLSGL2(0:JZ,JY,JX),ZOSGL2(0:JZ,JY,JX),POSGL2(0:JZ,JY,JX) + 4,RCODFS(JY,JX),RCHDFS(JY,JX),ROXDFS(JY,JX),RNGDFS(JY,JX) + 5,RN2DFS(JY,JX),RN3DFS(JY,JX),RNBDFS(JY,JX),RHGDFS(JY,JX) + 6,RCODFR(JY,JX),RCHDFR(JY,JX),ROXDFR(JY,JX),RNGDFR(JY,JX) + 7,RN2DFR(JY,JX),RN3DFR(JY,JX),RHGDFR(JY,JX) + 8,RQROC(0:4,2,JV,JH),RQRON(0:4,2,JV,JH),RQROP(0:4,2,JV,JH) + 9,RQROA(0:4,2,JV,JH),RQRCOS(2,JV,JH),RQRCHS(2,JV,JH) + 1,RQROXS(2,JV,JH),RQRNGS(2,JV,JH),RQRN2S(2,JV,JH),RQRNH4(2,JV,JH) + 2,RQRNH3(2,JV,JH),RQRNO3(2,JV,JH),RQRH2P(2,JV,JH) + 3,RQRNO2(2,JV,JH),RQRHGS(2,JV,JH),FLWU(JZ,JY,JX) + 4,RQSCOS(2,JV,JH),RQSCHS(2,JV,JH),RQSOXS(2,JV,JH) + 5,RQSNGS(2,JV,JH),RQSN2S(2,JV,JH),RQSNH4(2,JV,JH) + 6,RQSNH3(2,JV,JH),RQSNO3(2,JV,JH),RQSH2P(2,JV,JH) + DIMENSION RCOFLS(3,0:JD,JV,JH),RCHFLS(3,0:JD,JV,JH) + 2,ROXFLS(3,0:JD,JV,JH),RNGFLS(3,0:JD,JV,JH),RN2FLS(3,0:JD,JV,JH) + 3,RHGFLS(3,0:JD,JV,JH),RN4FLW(3,0:JD,JV,JH),RN3FLW(3,0:JD,JV,JH) + 4,RNOFLW(3,0:JD,JV,JH),RNXFLS(3,0:JD,JV,JH),RH2PFS(3,0:JD,JV,JH) + 5,RN4FLB(3,0:JD,JV,JH),RN3FLB(3,0:JD,JV,JH),RNOFLB(3,0:JD,JV,JH) + 6,RNXFLB(3,0:JD,JV,JH),RH2BFB(3,0:JD,JV,JH),RCOFHS(3,JD,JV,JH) + 7,RCHFHS(3,JD,JV,JH),ROXFHS(3,JD,JV,JH),RNGFHS(3,JD,JV,JH) + 8,RN2FHS(3,JD,JV,JH),RN4FHW(3,JD,JV,JH),RN3FHW(3,JD,JV,JH) + 9,RNOFHW(3,JD,JV,JH),RH2PHS(3,JD,JV,JH),RN4FHB(3,JD,JV,JH) + 1,RN3FHB(3,JD,JV,JH),RNOFHB(3,JD,JV,JH),RH2BHB(3,JD,JV,JH) + 2,ROCFLS(0:4,3,0:JD,JV,JH),RONFLS(0:4,3,0:JD,JV,JH) + 3,ROPFLS(0:4,3,0:JD,JV,JH),ROAFLS(0:4,3,0:JD,JV,JH) + 4,ROCFHS(0:4,3,JD,JV,JH),RONFHS(0:4,3,JD,JV,JH) + 5,ROPFHS(0:4,3,JD,JV,JH),ROAFHS(0:4,3,JD,JV,JH) + 6,ROXFLG(3,JD,JV,JH),RN3FLG(3,JD,JV,JH),RCOFLG(3,JD,JV,JH) + 7,RCHFLG(3,JD,JV,JH),RNGFLG(3,JD,JV,JH),RN2FLG(3,JD,JV,JH) + 8,RNXFHS(3,JD,JV,JH),RNXFHB(3,JD,JV,JH) + DIMENSION RCODFG(0:JZ,JY,JX),RCHDFG(0:JZ,JY,JX) + 1,ROXDFG(0:JZ,JY,JX),RNGDFG(0:JZ,JY,JX),RN2DFG(0:JZ,JY,JX) + 2,RN3DFG(0:JZ,JY,JX),RNBDFG(0:JZ,JY,JX),TQROC(0:4,JY,JX) + 3,TQRON(0:4,JY,JX),TQROP(0:4,JY,JX),TQROA(0:4,JY,JX),TQRCOS(JY,JX) + 4,TQRCHS(JY,JX),TQROXS(JY,JX),TQRNGS(JY,JX),TQRN2S(JY,JX) + 5,TQRNH4(JY,JX),TQRNH3(JY,JX),TQRNO3(JY,JX),TQRH2P(JY,JX) + 7,TQRNO2(JY,JX),TQRHGS(JY,JX),TQSCOS(JY,JX) + 4,TQSCHS(JY,JX),TQSOXS(JY,JX),TQSNGS(JY,JX),TQSN2S(JY,JX) + 5,TQSNH4(JY,JX),TQSNH3(JY,JX),TQSNO3(JY,JX),TQSH2P(JY,JX) + 8,TOCFLS(0:4,JZ,JY,JX),TONFLS(0:4,JZ,JY,JX) + 8,TOPFLS(0:4,JZ,JY,JX),TOAFLS(0:4,JZ,JY,JX),TCOFLS(JZ,JY,JX) + 9,TCHFLS(JZ,JY,JX),TOXFLS(JZ,JY,JX),TNGFLS(JZ,JY,JX) + 1,TN2FLS(JZ,JY,JX),TN4FLW(JZ,JY,JX),TN3FLW(JZ,JY,JX) + 2,TNOFLW(JZ,JY,JX),TH2PFS(JZ,JY,JX),TN4FLB(JZ,JY,JX) + 3,TN3FLB(JZ,JY,JX),TNOFLB(JZ,JY,JX),TH2BFB(JZ,JY,JX) + 4,TNXFLS(JZ,JY,JX),TCOFLG(JZ,JY,JX),TCHFLG(JZ,JY,JX) + 5,TOXFLG(JZ,JY,JX),TNGFLG(JZ,JY,JX),TN2FLG(JZ,JY,JX) + 6,RN34SQ(0:JZ,JY,JX),RN34BQ(0:JZ,JY,JX) + DIMENSION TN3FLG(JZ,JY,JX),RCOBBL(JZ,JY,JX) + 4,RCHBBL(JZ,JY,JX),ROXBBL(JZ,JY,JX),RNGBBL(JZ,JY,JX) + 5,RN2BBL(JZ,JY,JX),RN3BBL(JZ,JY,JX),RNBBBL(JZ,JY,JX) + 6,RHGBBL(JZ,JY,JX) + DIMENSION CO2SH2(JZ,JY,JX),CH4SH2(JZ,JY,JX),OXYSH2(JZ,JY,JX) + 2,Z2GSH2(JZ,JY,JX),Z2OSH2(JZ,JY,JX),ZNH4H2(JZ,JY,JX) + 3,ZN4BH2(JZ,JY,JX),ZNH3H2(JZ,JY,JX),ZN3BH2(JZ,JY,JX) + 4,ZNO3H2(JZ,JY,JX),ZNOBH2(JZ,JY,JX),H2P4H2(JZ,JY,JX) + 5,H2PBH2(JZ,JY,JX),ZNO2H2(JZ,JY,JX),OQCH2(0:4,JZ,JY,JX) + 6,OQNH2(0:4,JZ,JY,JX),OQPH2(0:4,JZ,JY,JX),OQAH2(0:4,JZ,JY,JX) + 7,TOCFHS(0:4,JZ,JY,JX),TONFHS(0:4,JZ,JY,JX),TOPFHS(0:4,JZ,JY,JX) + 8,TOAFHS(0:4,JZ,JY,JX),TCOFHS(JZ,JY,JX),TCHFHS(JZ,JY,JX) + 9,TOXFHS(JZ,JY,JX),TNGFHS(JZ,JY,JX),TN2FHS(JZ,JY,JX) + 1,TN4FHW(JZ,JY,JX),TN3FHW(JZ,JY,JX),TNOFHW(JZ,JY,JX) + 2,TH2PHS(JZ,JY,JX),TN4FHB(JZ,JY,JX),TN3FHB(JZ,JY,JX) + 3,TNOFHB(JZ,JY,JX),TH2BHB(JZ,JY,JX),TNXFHS(JZ,JY,JX) + 4,ZNO2B2(JZ,JY,JX),ZN2BH2(JZ,JY,JX),TNXFLB(JZ,JY,JX) + 5,TNXFHB(JZ,JY,JX) + DIMENSION RCOFLZ(JZ,JY,JX),RCHFLZ(JZ,JY,JX) + 1,ROXFLZ(JZ,JY,JX),RNGFLZ(JZ,JY,JX) + 2,RN2FLZ(JZ,JY,JX),RN4FLZ(JZ,JY,JX),RN3FLZ(JZ,JY,JX) + 3,RNOFLZ(JZ,JY,JX),RH2PFZ(JZ,JY,JX),RN4FBZ(JZ,JY,JX) + 4,RN3FBZ(JZ,JY,JX),RNOFBZ(JZ,JY,JX),RH2BBZ(JZ,JY,JX) + DIMENSION ROCFXS(0:4,JZ,JY,JX),RONFXS(0:4,JZ,JY,JX) + 1,ROPFXS(0:4,JZ,JY,JX),ROAFXS(0:4,JZ,JY,JX),RCOFXS(JZ,JY,JX) + 2,RCHFXS(JZ,JY,JX),ROXFXS(JZ,JY,JX) + 3,RNGFXS(JZ,JY,JX),RN2FXS(JZ,JY,JX),RN4FXW(JZ,JY,JX) + 4,RN3FXW(JZ,JY,JX),RNOFXW(JZ,JY,JX),RH2PXS(JZ,JY,JX) + 5,RN4FXB(JZ,JY,JX),RN3FXB(JZ,JY,JX),RNOFXB(JZ,JY,JX) + 6,RH2BXB(JZ,JY,JX),RNXFXS(JZ,JY,JX),RNXFXB(JZ,JY,JX) + DIMENSION RFLOC(0:4),RFLON(0:4),RFLOP(0:4),RFLOA(0:4) + 2,RFHOC(0:4),RFHON(0:4),RFHOP(0:4),RFHOA(0:4) ,COQC1(0:4) + 3,COQC2(0:4),COQN1(0:4),COQN2(0:4),COQP1(0:4),COQP2(0:4) + 4,COQA1(0:4),COQA2(0:4),COQCH1(0:4),COQCH2(0:4) + 3,COQNH1(0:4),COQNH2(0:4),COQPH1(0:4),COQPH2(0:4) + 4,COQAH1(0:4),COQAH2(0:4),DFVOC(0:4),DFVON(0:4),DFVOP(0:4) + 5,DFVOA(0:4),DFHOC(0:4),DFHON(0:4),DFHOP(0:4),DFHOA(0:4) + DIMENSION THETW1(0:JZ,JY,JX) + 2,DCO2G(3,JZ,JY,JX),DCH4G(3,JZ,JY,JX) + 3,DOXYG(3,JZ,JY,JX),DZ2GG(3,JZ,JY,JX),DZ2OG(3,JZ,JY,JX) + 4,DNH3G(3,JZ,JY,JX),VOLWCO(0:JZ,JY,JX),VOLWCH(0:JZ,JY,JX) + 5,VOLWOX(0:JZ,JY,JX),VOLWNG(0:JZ,JY,JX),VOLWN2(0:JZ,JY,JX) + 6,VOLWN3(0:JZ,JY,JX),VOLWNB(0:JZ,JY,JX),VOLWHG(0:JZ,JY,JX) + 7,H2GG2(JZ,JY,JX),H2GS2(0:JZ,JY,JX),H2GSH2(JZ,JY,JX) + 8,HGSGL2(JZ,JY,JX),DH2GG(3,JZ,JY,JX),RHGFXS(JZ,JY,JX) + 2,RHGFLZ(JZ,JY,JX),RHGFLG(3,JD,JV,JH),THGFLS(JZ,JY,JX) + 3,THGFHS(JZ,JY,JX),RHGDFG(0:JZ,JY,JX),FLQM(3,JD,JV,JH) + 4,RHGFHS(3,JD,JV,JH),THGFLG(JZ,JY,JX),FLVM(JZ,JY,JX) + 5,THETH2(JZ,JY,JX),THETHL(JZ,JY,JX),VOLPMA(JZ,JY,JX) + 6,VOLPMB(JZ,JY,JX),VOLWMA(JZ,JY,JX),VOLWMB(JZ,JY,JX) + 7,VOLWXA(0:JZ,JY,JX),VOLWXB(JZ,JY,JX),PARGCO(JY,JX) + 8,PARGCH(JY,JX),PARGOX(JY,JX),PARGNG(JY,JX) + 9,PARGN2(JY,JX),PARGN3(JY,JX),PARGH2(JY,JX) + DIMENSION ROCFL0(0:2,JY,JX),RONFL0(0:2,JY,JX),ROPFL0(0:2,JY,JX) + 2,ROAFL0(0:2,JY,JX),ROCFL1(0:2,JY,JX),RONFL1(0:2,JY,JX) + 3,ROPFL1(0:2,JY,JX),ROAFL1(0:2,JY,JX),RCOFL0(JY,JX),RCHFL0(JY,JX) + 4,ROXFL0(JY,JX),RNGFL0(JY,JX),RN2FL0(JY,JX),RHGFL0(JY,JX) + 5,RN4FL0(JY,JX),RN3FL0(JY,JX),RNOFL0(JY,JX),RNXFL0(JY,JX) + 6,RH2PF0(JY,JX),RCOFL1(JY,JX),RCHFL1(JY,JX),ROXFL1(JY,JX) + 7,RNGFL1(JY,JX),RN2FL1(JY,JX),RHGFL1(JY,JX),RN4FL1(JY,JX) + 8,RN3FL1(JY,JX),RNOFL1(JY,JX),RNXFL1(JY,JX),RH2PF1(JY,JX) + 9,RN4FL2(JY,JX),RN3FL2(JY,JX),RNOFL2(JY,JX),RNXFL2(JY,JX) + 1,RH2BF2(JY,JX) + DIMENSION VOLCOR(JY,JX),VOLCHR(JY,JX),VOLOXR(JY,JX),VOLNGR(JY,JX) + 2,VOLN2R(JY,JX),VOLN3R(JY,JX),VOLHGR(JY,JX),VOLCOT(JY,JX) + 3,VOLCHT(JY,JX),VOLOXT(JY,JX),VOLNGT(JY,JX),VOLN2T(JY,JX) + 4,VOLN3T(JY,JX),VOLNBT(JY,JX),VOLHGT(JY,JX) + PARAMETER(DPN4=5.7E-07,XFRX=0.5,XFRS=0.05) + REAL*4 CCO2SQ,CCH4SQ,COXYSQ,CZ2GSQ,CZ2OSQ,CNH3SQ + 2,CNH3BQ,CH2GSQ +C +C TIME STEPS FOR SOLUTE AND GAS FLUX CALCULATIONS +C + XNPX=1.0*XNPH + DO 9995 NX=NHW,NHE + DO 9990 NY=NVN,NVS +C +C GAS AND SOLUTE SINKS AND SOURCES IN SURFACE RESIDUE FROM MICROBIAL +C TRANSFORMATIONS IN 'NITRO' + ROOT EXCHANGE IN 'EXTRACT' +C + EQUILIBRIA REACTIONS IN 'SOLUTE' AT SUB-HOURLY TIME STEP +C + RCOSK2(0,NY,NX)=RCO2O(0,NY,NX)*XNPG + RCHSK2(0,NY,NX)=RCH4O(0,NY,NX)*XNPG + RNGSK2(0,NY,NX)=(RN2G(0,NY,NX)+XN2GS(0,NY,NX))*XNPG + 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 + 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 + ROASK2(K,0,NY,NX)=-XOQAS(K,0,NY,NX)*XNPH +14 CONTINUE + RN4SK2(0,NY,NX)=(-XNH4S(0,NY,NX)-TRN4S(0,NY,NX))*XNPH + RN3SK2(0,NY,NX)=-TRN3S(0,NY,NX)*XNPH + RNOSK2(0,NY,NX)=(-XNO3S(0,NY,NX)-TRNO3(0,NY,NX))*XNPH + RNXSK2(0,NY,NX)=(-XNO2S(0,NY,NX)-TRNO2(0,NY,NX))*XNPH + RHPSK2(0,NY,NX)=(-XH2PS(0,NY,NX)-TRH2P(0,NY,NX))*XNPH + CO2S2(0,NY,NX)=CO2S(0,NY,NX) + CH4S2(0,NY,NX)=CH4S(0,NY,NX) + OXYS2(0,NY,NX)=OXYS(0,NY,NX) + 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 + 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) + OQA2(K,0,NY,NX)=OQA(K,0,NY,NX)-XOQAS(K,0,NY,NX) +9979 CONTINUE + ZNH4S2(0,NY,NX)=ZNH4S(0,NY,NX) + ZN3S2(0,NY,NX)=ZNH3S(0,NY,NX) + ZNO3S2(0,NY,NX)=ZNO3S(0,NY,NX) + ZNO2S2(0,NY,NX)=ZNO2S(0,NY,NX) + H2PO42(0,NY,NX)=H2PO4(0,NY,NX) + CHY0(0,NY,NX)=10.0**(-(PH(0,NY,NX)-3.0)) +C +C SURFACE SOLUTE FLUXES FROM ATMOSPHERE +C + DO 8855 K=0,4 + IF(K.LE.2)THEN + XOCFLS(K,3,0,NY,NX)=0.0 + XONFLS(K,3,0,NY,NX)=0.0 + XOPFLS(K,3,0,NY,NX)=0.0 + XOAFLS(K,3,0,NY,NX)=0.0 + ENDIF + XOCFLS(K,3,NU(NY,NX),NY,NX)=0.0 + XONFLS(K,3,NU(NY,NX),NY,NX)=0.0 + XOPFLS(K,3,NU(NY,NX),NY,NX)=0.0 + XOAFLS(K,3,NU(NY,NX),NY,NX)=0.0 + XOCFHS(K,3,NU(NY,NX),NY,NX)=0.0 + XONFHS(K,3,NU(NY,NX),NY,NX)=0.0 + XOPFHS(K,3,NU(NY,NX),NY,NX)=0.0 + XOAFHS(K,3,NU(NY,NX),NY,NX)=0.0 +8855 CONTINUE +C +C HOURLY SOLUTE FLUXES FROM ATMOSPHERE TO SNOWPACK +C IN SNOWFALL AND IRRIGATION ACCORDING TO CONCENTRATIONS +C ENTERED IN WEATHER AND IRRIGATION FILES +C + IF(PRECW(NY,NX).GT.0.0.OR.(PRECR(NY,NX).GT.0.0 + 2.AND.VHCPW(NY,NX).GT.VHCPWX(NY,NX)))THEN + XCOBLS(NY,NX)=FLQGQ(NY,NX)*CCOR(NY,NX)+FLQGI(NY,NX)*CCOQ(NY,NX) + XCHBLS(NY,NX)=FLQGQ(NY,NX)*CCHR(NY,NX)+FLQGI(NY,NX)*CCHQ(NY,NX) + XOXBLS(NY,NX)=FLQGQ(NY,NX)*COXR(NY,NX)+FLQGI(NY,NX)*COXQ(NY,NX) + XNGBLS(NY,NX)=FLQGQ(NY,NX)*CNNR(NY,NX)+FLQGI(NY,NX)*CNNQ(NY,NX) + XN2BLS(NY,NX)=FLQGQ(NY,NX)*CN2R(NY,NX)+FLQGI(NY,NX)*CN2Q(NY,NX) + XHGBLS(NY,NX)=0.0 + XN4BLW(NY,NX)=(FLQGQ(NY,NX)*CN4R(NY,NX)+FLQGI(NY,NX) + 2*CN4Q(I,NY,NX))*14.0 + XN3BLW(NY,NX)=(FLQGQ(NY,NX)*CN3R(NY,NX)+FLQGI(NY,NX) + 2*CN3Q(I,NY,NX))*14.0 + XNOBLW(NY,NX)=(FLQGQ(NY,NX)*CNOR(NY,NX)+FLQGI(NY,NX) + 2*CNOQ(I,NY,NX))*14.0 + XH2PBS(NY,NX)=(FLQGQ(NY,NX)*CPOR(NY,NX)+FLQGI(NY,NX) + 2*CPOQ(I,NY,NX))*31.0 +C +C HOURLY SOLUTE FLUXES FROM ATMOSPHERE TO SOIL SURFACE +C IF RAINFALL AND IRRIGATION IS ZERO IF SNOWPACK IS PRESENT +C + XCOFLS(3,0,NY,NX)=0.0 + XCHFLS(3,0,NY,NX)=0.0 + XOXFLS(3,0,NY,NX)=0.0 + XNGFLS(3,0,NY,NX)=0.0 + XN2FLS(3,0,NY,NX)=0.0 + XHGFLS(3,0,NY,NX)=0.0 + XN4FLW(3,0,NY,NX)=0.0 + XN3FLW(3,0,NY,NX)=0.0 + XNOFLW(3,0,NY,NX)=0.0 + XNXFLS(3,0,NY,NX)=0.0 + XH2PFS(3,0,NY,NX)=0.0 + XCOFLS(3,NU(NY,NX),NY,NX)=0.0 + XCHFLS(3,NU(NY,NX),NY,NX)=0.0 + XOXFLS(3,NU(NY,NX),NY,NX)=0.0 + XNGFLS(3,NU(NY,NX),NY,NX)=0.0 + XN2FLS(3,NU(NY,NX),NY,NX)=0.0 + XHGFLS(3,NU(NY,NX),NY,NX)=0.0 + XN4FLW(3,NU(NY,NX),NY,NX)=0.0 + XN3FLW(3,NU(NY,NX),NY,NX)=0.0 + XNOFLW(3,NU(NY,NX),NY,NX)=0.0 + XNXFLS(3,NU(NY,NX),NY,NX)=0.0 + XH2PFS(3,NU(NY,NX),NY,NX)=0.0 + XN4FLB(3,NU(NY,NX),NY,NX)=0.0 + XN3FLB(3,NU(NY,NX),NY,NX)=0.0 + XNOFLB(3,NU(NY,NX),NY,NX)=0.0 + XNXFLB(3,NU(NY,NX),NY,NX)=0.0 + XH2BFB(3,NU(NY,NX),NY,NX)=0.0 +C +C HOURLY SOLUTE FLUXES FROM ATMOSPHERE TO SOIL SURFACE +C IN RAINFALL AND IRRIGATION ACCORDING TO CONCENTRATIONS +C ENTERED IN WEATHER AND IRRIGATION FILES +C + ELSEIF((PRECQ(NY,NX).GT.0.0.OR.PRECI(NY,NX).GT.0.0) + 2.AND.VHCPW(NY,NX).LE.VHCPWX(NY,NX))THEN +C +C HOURLY SOLUTE FLUXES FROM ATMOSPHERE TO SNOWPACK +C IF SNOWFALL AND IRRIGATION IS ZERO AND SNOWPACK IS ABSENT +C + XCOBLS(NY,NX)=0.0 + XCHBLS(NY,NX)=0.0 + XOXBLS(NY,NX)=0.0 + XNGBLS(NY,NX)=0.0 + XN2BLS(NY,NX)=0.0 + XHGBLS(NY,NX)=0.0 + XN4BLW(NY,NX)=0.0 + XN3BLW(NY,NX)=0.0 + XNOBLW(NY,NX)=0.0 + XH2PBS(NY,NX)=0.0 + XCOFLS(3,0,NY,NX)=FLQRQ(NY,NX)*CCOR(NY,NX) + 2+FLQRI(NY,NX)*CCOQ(NY,NX) + XCHFLS(3,0,NY,NX)=FLQRQ(NY,NX)*CCHR(NY,NX) + 2+FLQRI(NY,NX)*CCHQ(NY,NX) + XOXFLS(3,0,NY,NX)=FLQRQ(NY,NX)*COXR(NY,NX) + 2+FLQRI(NY,NX)*COXQ(NY,NX) + XNGFLS(3,0,NY,NX)=FLQRQ(NY,NX)*CNNR(NY,NX) + 2+FLQRI(NY,NX)*CNNQ(NY,NX) + XN2FLS(3,0,NY,NX)=FLQRQ(NY,NX)*CN2R(NY,NX) + 2+FLQRI(NY,NX)*CN2Q(NY,NX) + XHGFLS(3,0,NY,NX)=0.0 + XN4FLW(3,0,NY,NX)=(FLQRQ(NY,NX)*CN4R(NY,NX)+FLQRI(NY,NX) + 2*CN4Q(I,NY,NX))*14.0 + XN3FLW(3,0,NY,NX)=(FLQRQ(NY,NX)*CN3R(NY,NX)+FLQRI(NY,NX) + 2*CN3Q(I,NY,NX))*14.0 + XNOFLW(3,0,NY,NX)=(FLQRQ(NY,NX)*CNOR(NY,NX)+FLQRI(NY,NX) + 2*CNOQ(I,NY,NX))*14.0 + XNXFLS(3,0,NY,NX)=0.0 + XH2PFS(3,0,NY,NX)=(FLQRQ(NY,NX)*CPOR(NY,NX)+FLQRI(NY,NX) + 2*CPOQ(I,NY,NX))*31.0 + XCOFLS(3,NU(NY,NX),NY,NX)=FLQGQ(NY,NX)*CCOR(NY,NX) + 2+FLQGI(NY,NX)*CCOQ(NY,NX) + XCHFLS(3,NU(NY,NX),NY,NX)=FLQGQ(NY,NX)*CCHR(NY,NX) + 2+FLQGI(NY,NX)*CCHQ(NY,NX) + XOXFLS(3,NU(NY,NX),NY,NX)=FLQGQ(NY,NX)*COXR(NY,NX) + 2+FLQGI(NY,NX)*COXQ(NY,NX) + XNGFLS(3,NU(NY,NX),NY,NX)=FLQGQ(NY,NX)*CNNR(NY,NX) + 2+FLQGI(NY,NX)*CNNQ(NY,NX) + XN2FLS(3,NU(NY,NX),NY,NX)=FLQGQ(NY,NX)*CN2R(NY,NX) + 2+FLQGI(NY,NX)*CN2Q(NY,NX) + XHGFLS(3,NU(NY,NX),NY,NX)=0.0 + XN4FLW(3,NU(NY,NX),NY,NX)=((FLQGQ(NY,NX)*CN4R(NY,NX)+FLQGI(NY,NX) + 2*CN4Q(I,NY,NX))*14.0)*VLNH4(NU(NY,NX),NY,NX) + XN3FLW(3,NU(NY,NX),NY,NX)=((FLQGQ(NY,NX)*CN3R(NY,NX)+FLQGI(NY,NX) + 2*CN3Q(I,NY,NX))*14.0)*VLNH4(NU(NY,NX),NY,NX) + XNOFLW(3,NU(NY,NX),NY,NX)=((FLQGQ(NY,NX)*CNOR(NY,NX)+FLQGI(NY,NX) + 2*CNOQ(I,NY,NX))*14.0)*VLNO3(NU(NY,NX),NY,NX) + XNXFLS(3,NU(NY,NX),NY,NX)=0.0 + XH2PFS(3,NU(NY,NX),NY,NX)=((FLQGQ(NY,NX)*CPOR(NY,NX)+FLQGI(NY,NX) + 2*CPOQ(I,NY,NX))*31.0)*VLPO4(NU(NY,NX),NY,NX) + XN4FLB(3,NU(NY,NX),NY,NX)=((FLQGQ(NY,NX)*CN4R(NY,NX)+FLQGI(NY,NX) + 2*CN4Q(I,NY,NX))*14.0)*VLNHB(NU(NY,NX),NY,NX) + XN3FLB(3,NU(NY,NX),NY,NX)=((FLQGQ(NY,NX)*CN3R(NY,NX)+FLQGI(NY,NX) + 2*CN3Q(I,NY,NX))*14.0)*VLNHB(NU(NY,NX),NY,NX) + XNOFLB(3,NU(NY,NX),NY,NX)=((FLQGQ(NY,NX)*CNOR(NY,NX)+FLQGI(NY,NX) + 2*CNOQ(I,NY,NX))*14.0)*VLNOB(NU(NY,NX),NY,NX) + XNXFLB(3,NU(NY,NX),NY,NX)=0.0 + XH2BFB(3,NU(NY,NX),NY,NX)=((FLQGQ(NY,NX)*CPOR(NY,NX)+FLQGI(NY,NX) + 2*CPOQ(I,NY,NX))*31.0)*VLPOB(NU(NY,NX),NY,NX) +C +C NO SOLUTE FLUXES FROM ATMOSPHERE +C + ELSE + XCOBLS(NY,NX)=0.0 + XCHBLS(NY,NX)=0.0 + XOXBLS(NY,NX)=0.0 + XNGBLS(NY,NX)=0.0 + XN2BLS(NY,NX)=0.0 + XHGBLS(NY,NX)=0.0 + XN4BLW(NY,NX)=0.0 + XN3BLW(NY,NX)=0.0 + XNOBLW(NY,NX)=0.0 + XH2PBS(NY,NX)=0.0 + XCOFLS(3,0,NY,NX)=0.0 + XCHFLS(3,0,NY,NX)=0.0 + XOXFLS(3,0,NY,NX)=0.0 + XNGFLS(3,0,NY,NX)=0.0 + XN2FLS(3,0,NY,NX)=0.0 + XHGFLS(3,0,NY,NX)=0.0 + XN4FLW(3,0,NY,NX)=0.0 + XN3FLW(3,0,NY,NX)=0.0 + XNOFLW(3,0,NY,NX)=0.0 + XNXFLS(3,0,NY,NX)=0.0 + XH2PFS(3,0,NY,NX)=0.0 + XCOFLS(3,NU(NY,NX),NY,NX)=0.0 + XCHFLS(3,NU(NY,NX),NY,NX)=0.0 + XOXFLS(3,NU(NY,NX),NY,NX)=0.0 + XNGFLS(3,NU(NY,NX),NY,NX)=0.0 + XN2FLS(3,NU(NY,NX),NY,NX)=0.0 + XHGFLS(3,NU(NY,NX),NY,NX)=0.0 + XN4FLW(3,NU(NY,NX),NY,NX)=0.0 + XN3FLW(3,NU(NY,NX),NY,NX)=0.0 + XNOFLW(3,NU(NY,NX),NY,NX)=0.0 + XNXFLS(3,NU(NY,NX),NY,NX)=0.0 + XH2PFS(3,NU(NY,NX),NY,NX)=0.0 + XN4FLB(3,NU(NY,NX),NY,NX)=0.0 + XN3FLB(3,NU(NY,NX),NY,NX)=0.0 + XNOFLB(3,NU(NY,NX),NY,NX)=0.0 + XNXFLB(3,NU(NY,NX),NY,NX)=0.0 + XH2BFB(3,NU(NY,NX),NY,NX)=0.0 + ENDIF +C +C HOURLY SOLUTE FLUXES FROM MELTING SNOWPACK TO +C RESIDUE AND SOIL SURFACE FROM SNOWMELT IN 'WATSUB' AND +C CONCENTRATIONS IN SNOWPACK +C + FLQTM=FLQGM(NY,NX)+FLQRM(NY,NX) + IF(FLQTM.GT.ZEROS(NY,NX))THEN + VOLWW=VOLWS(NY,NX)+VOLSS(NY,NX)+VOLIS(NY,NX)*0.92 + IF(VOLWW.GT.ZEROS(NY,NX))THEN + VFLWW=AMAX1(0.0,AMIN1(1.0,FLQTM/VOLWW)) + ELSE + VFLWW=1.0 + ENDIF + VFLWG=VFLWW*FLQGM(NY,NX)/FLQTM + VFLWR=VFLWW*FLQRM(NY,NX)/FLQTM + XCOBLS(NY,NX)=XCOBLS(NY,NX)-CO2W(NY,NX)*VFLWW + XCHBLS(NY,NX)=XCHBLS(NY,NX)-CH4W(NY,NX)*VFLWW + XOXBLS(NY,NX)=XOXBLS(NY,NX)-OXYW(NY,NX)*VFLWW + XNGBLS(NY,NX)=XNGBLS(NY,NX)-ZNGW(NY,NX)*VFLWW + XN2BLS(NY,NX)=XN2BLS(NY,NX)-ZN2W(NY,NX)*VFLWW + XN4BLW(NY,NX)=XN4BLW(NY,NX)-ZN4W(NY,NX)*VFLWW + XN3BLW(NY,NX)=XN3BLW(NY,NX)-ZN3W(NY,NX)*VFLWW + XNOBLW(NY,NX)=XNOBLW(NY,NX)-ZNOW(NY,NX)*VFLWW + XH2PBS(NY,NX)=XH2PBS(NY,NX)-ZHPW(NY,NX)*VFLWW + XCOFLS(3,0,NY,NX)=XCOFLS(3,0,NY,NX)+CO2W(NY,NX)*VFLWR + XCHFLS(3,0,NY,NX)=XCHFLS(3,0,NY,NX)+CH4W(NY,NX)*VFLWR + XOXFLS(3,0,NY,NX)=XOXFLS(3,0,NY,NX)+OXYW(NY,NX)*VFLWR + XNGFLS(3,0,NY,NX)=XNGFLS(3,0,NY,NX)+ZNGW(NY,NX)*VFLWR + XN2FLS(3,0,NY,NX)=XN2FLS(3,0,NY,NX)+ZN2W(NY,NX)*VFLWR + XN4FLW(3,0,NY,NX)=XN4FLW(3,0,NY,NX)+ZN4W(NY,NX)*VFLWR + XN3FLW(3,0,NY,NX)=XN3FLW(3,0,NY,NX)+ZN3W(NY,NX)*VFLWR + XNOFLW(3,0,NY,NX)=XNOFLW(3,0,NY,NX)+ZNOW(NY,NX)*VFLWR + XH2PFS(3,0,NY,NX)=XH2PFS(3,0,NY,NX)+ZHPW(NY,NX)*VFLWR + XCOFLS(3,NU(NY,NX),NY,NX)=XCOFLS(3,NU(NY,NX),NY,NX) + 2+CO2W(NY,NX)*VFLWG + XCHFLS(3,NU(NY,NX),NY,NX)=XCHFLS(3,NU(NY,NX),NY,NX) + 2+CH4W(NY,NX)*VFLWG + XOXFLS(3,NU(NY,NX),NY,NX)=XOXFLS(3,NU(NY,NX),NY,NX) + 2+OXYW(NY,NX)*VFLWG + XNGFLS(3,NU(NY,NX),NY,NX)=XNGFLS(3,NU(NY,NX),NY,NX) + 2+ZNGW(NY,NX)*VFLWG + XN2FLS(3,NU(NY,NX),NY,NX)=XN2FLS(3,NU(NY,NX),NY,NX) + 2+ZN2W(NY,NX)*VFLWG + XN4FLW(3,NU(NY,NX),NY,NX)=XN4FLW(3,NU(NY,NX),NY,NX) + 2+ZN4W(NY,NX)*VFLWG*VLNH4(NU(NY,NX),NY,NX) + XN3FLW(3,NU(NY,NX),NY,NX)=XN3FLW(3,NU(NY,NX),NY,NX) + 2+ZN3W(NY,NX)*VFLWG*VLNH4(NU(NY,NX),NY,NX) + XNOFLW(3,NU(NY,NX),NY,NX)=XNOFLW(3,NU(NY,NX),NY,NX) + 2+ZNOW(NY,NX)*VFLWG*VLNO3(NU(NY,NX),NY,NX) + XH2PFS(3,NU(NY,NX),NY,NX)=XH2PFS(3,NU(NY,NX),NY,NX) + 2+ZHPW(NY,NX)*VFLWG*VLPO4(NU(NY,NX),NY,NX) + XN4FLB(3,NU(NY,NX),NY,NX)=XN4FLB(3,NU(NY,NX),NY,NX) + 2+ZN4W(NY,NX)*VFLWG*VLNHB(NU(NY,NX),NY,NX) + XN3FLB(3,NU(NY,NX),NY,NX)=XN3FLB(3,NU(NY,NX),NY,NX) + 2+ZN3W(NY,NX)*VFLWG*VLNHB(NU(NY,NX),NY,NX) + XNOFLB(3,NU(NY,NX),NY,NX)=XNOFLB(3,NU(NY,NX),NY,NX) + 2+ZNOW(NY,NX)*VFLWG*VLNOB(NU(NY,NX),NY,NX) + XH2BFB(3,NU(NY,NX),NY,NX)=XH2BFB(3,NU(NY,NX),NY,NX) + 2+ZHPW(NY,NX)*VFLWG*VLPOB(NU(NY,NX),NY,NX) + ENDIF + XCOFHS(3,NU(NY,NX),NY,NX)=0.0 + XCHFHS(3,NU(NY,NX),NY,NX)=0.0 + XOXFHS(3,NU(NY,NX),NY,NX)=0.0 + XNGFHS(3,NU(NY,NX),NY,NX)=0.0 + XN2FHS(3,NU(NY,NX),NY,NX)=0.0 + XHGFHS(3,NU(NY,NX),NY,NX)=0.0 + XN4FHW(3,NU(NY,NX),NY,NX)=0.0 + XN3FHW(3,NU(NY,NX),NY,NX)=0.0 + XNOFHW(3,NU(NY,NX),NY,NX)=0.0 + XH2PHS(3,NU(NY,NX),NY,NX)=0.0 + XN4FHB(3,NU(NY,NX),NY,NX)=0.0 + XN3FHB(3,NU(NY,NX),NY,NX)=0.0 + XNOFHB(3,NU(NY,NX),NY,NX)=0.0 + XNXFHB(3,NU(NY,NX),NY,NX)=0.0 + XH2BHB(3,NU(NY,NX),NY,NX)=0.0 + XNXFHS(3,NU(NY,NX),NY,NX)=0.0 + CO2W2(NY,NX)=CO2W(NY,NX)+XCOBLS(NY,NX) + CH4W2(NY,NX)=CH4W(NY,NX)+XCHBLS(NY,NX) + OXYW2(NY,NX)=OXYW(NY,NX)+XOXBLS(NY,NX) + ZNGW2(NY,NX)=ZNGW(NY,NX)+XNGBLS(NY,NX) + ZN2W2(NY,NX)=ZN2W(NY,NX)+XN2BLS(NY,NX) + ZN4W2(NY,NX)=ZN4W(NY,NX)+XN4BLW(NY,NX) + ZN3W2(NY,NX)=ZN3W(NY,NX)+XN3BLW(NY,NX) + ZNOW2(NY,NX)=ZNOW(NY,NX)+XNOBLW(NY,NX) + ZHPW2(NY,NX)=ZHPW(NY,NX)+XH2PBS(NY,NX) +C +C GAS AND SOLUTE FLUXES AT SUB-HOURLY FLUX TIME STEP +C ENTERED IN SITE FILE +C + DO 9845 K=0,2 + ROCFL0(K,NY,NX)=XOCFLS(K,3,0,NY,NX)*XNPH + RONFL0(K,NY,NX)=XONFLS(K,3,0,NY,NX)*XNPH + ROPFL0(K,NY,NX)=XOPFLS(K,3,0,NY,NX)*XNPH + ROAFL0(K,NY,NX)=XOAFLS(K,3,0,NY,NX)*XNPH + ROCFL1(K,NY,NX)=XOCFLS(K,3,NU(NY,NX),NY,NX)*XNPH + RONFL1(K,NY,NX)=XONFLS(K,3,NU(NY,NX),NY,NX)*XNPH + ROPFL1(K,NY,NX)=XOPFLS(K,3,NU(NY,NX),NY,NX)*XNPH + ROAFL1(K,NY,NX)=XOAFLS(K,3,NU(NY,NX),NY,NX)*XNPH +9845 CONTINUE + RCOFL0(NY,NX)=XCOFLS(3,0,NY,NX)*XNPH + RCHFL0(NY,NX)=XCHFLS(3,0,NY,NX)*XNPH + ROXFL0(NY,NX)=XOXFLS(3,0,NY,NX)*XNPH + RNGFL0(NY,NX)=XNGFLS(3,0,NY,NX)*XNPH + RN2FL0(NY,NX)=XN2FLS(3,0,NY,NX)*XNPH + RHGFL0(NY,NX)=XHGFLS(3,0,NY,NX)*XNPH + RN4FL0(NY,NX)=XN4FLW(3,0,NY,NX)*XNPH + RN3FL0(NY,NX)=XN3FLW(3,0,NY,NX)*XNPH + RNOFL0(NY,NX)=XNOFLW(3,0,NY,NX)*XNPH + RNXFL0(NY,NX)=XNXFLS(3,0,NY,NX)*XNPH + RH2PF0(NY,NX)=XH2PFS(3,0,NY,NX)*XNPH + RCOFL1(NY,NX)=XCOFLS(3,NU(NY,NX),NY,NX)*XNPH + RCHFL1(NY,NX)=XCHFLS(3,NU(NY,NX),NY,NX)*XNPH + ROXFL1(NY,NX)=XOXFLS(3,NU(NY,NX),NY,NX)*XNPH + RNGFL1(NY,NX)=XNGFLS(3,NU(NY,NX),NY,NX)*XNPH + RN2FL1(NY,NX)=XN2FLS(3,NU(NY,NX),NY,NX)*XNPH + RHGFL1(NY,NX)=XHGFLS(3,NU(NY,NX),NY,NX)*XNPH + RN4FL1(NY,NX)=XN4FLW(3,NU(NY,NX),NY,NX)*XNPH + RN3FL1(NY,NX)=XN3FLW(3,NU(NY,NX),NY,NX)*XNPH + RNOFL1(NY,NX)=XNOFLW(3,NU(NY,NX),NY,NX)*XNPH + RNXFL1(NY,NX)=XNXFLS(3,NU(NY,NX),NY,NX)*XNPH + RH2PF1(NY,NX)=XH2PFS(3,NU(NY,NX),NY,NX)*XNPH + RN4FL2(NY,NX)=XN4FLB(3,NU(NY,NX),NY,NX)*XNPH + RN3FL2(NY,NX)=XN3FLB(3,NU(NY,NX),NY,NX)*XNPH + RNOFL2(NY,NX)=XNOFLB(3,NU(NY,NX),NY,NX)*XNPH + RNXFL2(NY,NX)=XNXFLB(3,NU(NY,NX),NY,NX)*XNPH + RH2BF2(NY,NX)=XH2BFB(3,NU(NY,NX),NY,NX)*XNPH +C IF(I.EQ.118.AND.NX.EQ.3.AND.NY.EQ.4)THEN +C WRITE(*,6767)'ROXFL0',I,J,NX,NY,ROXFL0(NY,NX),XOXFLS(3,0,NY,NX) +C 2,OXYW(NY,NX),VFLWR +6767 FORMAT(A8,4I4,12E12.4) +C ENDIF +C +C GAS AND SOLUTE SINKS AND SOURCES IN SOIL LAYERS FROM MICROBIAL +C TRANSFORMATIONS IN 'NITRO' + ROOT EXCHANGE IN 'EXTRACT' +C + EQUILIBRIA REACTIONS IN 'SOLUTE' AT SUB-HOURLY TIME STEP +C + CLSGL2(0,NY,NX)=CLSGL(0,NY,NX)*XNPH + CQSGL2(0,NY,NX)=CQSGL(0,NY,NX)*XNPH + OLSGL2(0,NY,NX)=OLSGL(0,NY,NX)*XNPH + ZLSGL2(0,NY,NX)=ZLSGL(0,NY,NX)*XNPH + ZNSGL2(0,NY,NX)=ZNSGL(0,NY,NX)*XNPH + ZVSGL2(0,NY,NX)=ZVSGL(0,NY,NX)*XNPH + HLSGL2(0,NY,NX)=HLSGL(0,NY,NX)*XNPH + OCSGL2(0,NY,NX)=OCSGL(0,NY,NX)*XNPH + ONSGL2(0,NY,NX)=ONSGL(0,NY,NX)*XNPH + OPSGL2(0,NY,NX)=OPSGL(0,NY,NX)*XNPH + OASGL2(0,NY,NX)=OASGL(0,NY,NX)*XNPH + ZOSGL2(0,NY,NX)=ZOSGL(0,NY,NX)*XNPH + POSGL2(0,NY,NX)=POSGL(0,NY,NX)*XNPH + PARGM=PARG(NY,NX)*XNPT + PARGCO(NY,NX)=PARGM*0.74 + PARGCH(NY,NX)=PARGM*1.04 + PARGOX(NY,NX)=PARGM*0.83 + PARGNG(NY,NX)=PARGM*0.86 + PARGN2(NY,NX)=PARGM*0.74 + PARGN3(NY,NX)=PARGM*1.02 + PARGH2(NY,NX)=PARGM*2.08 + DO 10 L=NU(NY,NX),NL(NY,NX) + CHY0(L,NY,NX)=10.0**(-(PH(L,NY,NX)-3.0)) + FLWU(L,NY,NX)=TUPWTR(L,NY,NX)*XNPH + RCOSK2(L,NY,NX)=(RCO2O(L,NY,NX)+TCO2S(L,NY,NX)+TRCO2(L,NY,NX)) + 2*XNPG + RCHSK2(L,NY,NX)=(RCH4O(L,NY,NX)+TUPCHS(L,NY,NX))*XNPG + RNGSK2(L,NY,NX)=(RN2G(L,NY,NX)+XN2GS(L,NY,NX)+TUPNF(L,NY,NX)) + 2*XNPG + RN2SK2(L,NY,NX)=(RN2O(L,NY,NX)+TUPN2S(L,NY,NX))*XNPG + RNHSK2(L,NY,NX)=-TRN3G(L,NY,NX)*XNPG + RHGSK2(L,NY,NX)=(RH2GO(L,NY,NX)+TUPHGS(L,NY,NX))*XNPG + DO 15 K=0,4 + ROCSK2(K,L,NY,NX)=-XOQCS(K,L,NY,NX)*XNPH + RONSK2(K,L,NY,NX)=-XOQNS(K,L,NY,NX)*XNPH + ROPSK2(K,L,NY,NX)=-XOQPS(K,L,NY,NX)*XNPH + ROASK2(K,L,NY,NX)=-XOQAS(K,L,NY,NX)*XNPH +15 CONTINUE + RN4SK2(L,NY,NX)=(-XNH4S(L,NY,NX)-TRN4S(L,NY,NX) + 2+TUPNH4(L,NY,NX))*XNPH + RN3SK2(L,NY,NX)=(-TRN3S(L,NY,NX)+TUPN3S(L,NY,NX))*XNPH + RNOSK2(L,NY,NX)=(-XNO3S(L,NY,NX)-TRNO3(L,NY,NX) + 2+TUPNO3(L,NY,NX))*XNPH + RNXSK2(L,NY,NX)=(-XNO2S(L,NY,NX)-TRNO2(L,NY,NX))*XNPH + RHPSK2(L,NY,NX)=(-XH2PS(L,NY,NX)-TRH2P(L,NY,NX) + 2+TUPH2P(L,NY,NX))*XNPH + R4BSK2(L,NY,NX)=(-XNH4B(L,NY,NX)-TRN4B(L,NY,NX) + 2+TUPNHB(L,NY,NX))*XNPH + R3BSK2(L,NY,NX)=(-TRN3B(L,NY,NX)+TUPN3B(L,NY,NX))*XNPH + RNBSK2(L,NY,NX)=(-XNO3B(L,NY,NX)-TRNOB(L,NY,NX) + 2+TUPNOB(L,NY,NX))*XNPH + RNZSK2(L,NY,NX)=(-XNO2B(L,NY,NX)-TRN2B(L,NY,NX))*XNPH + RHBSK2(L,NY,NX)=(-XH2BS(L,NY,NX)-TRH2B(L,NY,NX) + 2+TUPH2B(L,NY,NX))*XNPH +C +C HOURLY SOLUTE FLUXES FROM SUBSURFACE IRRIGATION +C + RCOFLU(L,NY,NX)=FLU(L,NY,NX)*CCOQ(NY,NX) + RCHFLU(L,NY,NX)=FLU(L,NY,NX)*CCHQ(NY,NX) + ROXFLU(L,NY,NX)=FLU(L,NY,NX)*COXQ(NY,NX) + RNGFLU(L,NY,NX)=FLU(L,NY,NX)*CNNQ(NY,NX) + RN2FLU(L,NY,NX)=FLU(L,NY,NX)*CN2Q(NY,NX) + RHGFLU(L,NY,NX)=0.0 + RN4FLU(L,NY,NX)=FLU(L,NY,NX)*CN4Q(I,NY,NX)*VLNH4(L,NY,NX)*14.0 + RN3FLU(L,NY,NX)=FLU(L,NY,NX)*CN3Q(I,NY,NX)*VLNH4(L,NY,NX)*14.0 + RNOFLU(L,NY,NX)=FLU(L,NY,NX)*CNOQ(I,NY,NX)*VLNO3(L,NY,NX)*14.0 + RH2PFU(L,NY,NX)=FLU(L,NY,NX)*CPOQ(I,NY,NX)*VLPO4(L,NY,NX)*31.0 + RN4FBU(L,NY,NX)=FLU(L,NY,NX)*CN4Q(I,NY,NX)*VLNHB(L,NY,NX)*14.0 + RN3FBU(L,NY,NX)=FLU(L,NY,NX)*CN3Q(I,NY,NX)*VLNHB(L,NY,NX)*14.0 + RNOFBU(L,NY,NX)=FLU(L,NY,NX)*CNOQ(I,NY,NX)*VLNOB(L,NY,NX)*14.0 + RH2BBU(L,NY,NX)=FLU(L,NY,NX)*CPOQ(I,NY,NX)*VLPOB(L,NY,NX)*31.0 +C +C SUB-HOURLY SOLUTE FLUXES FROM SUBSURFACE IRRIGATION +C + RCOFLZ(L,NY,NX)=RCOFLU(L,NY,NX)*XNPH + RCHFLZ(L,NY,NX)=RCHFLU(L,NY,NX)*XNPH + ROXFLZ(L,NY,NX)=ROXFLU(L,NY,NX)*XNPH + RNGFLZ(L,NY,NX)=RNGFLU(L,NY,NX)*XNPH + RN2FLZ(L,NY,NX)=RN2FLU(L,NY,NX)*XNPH + RHGFLZ(L,NY,NX)=RHGFLU(L,NY,NX)*XNPH + RN4FLZ(L,NY,NX)=RN4FLU(L,NY,NX)*XNPH + RN3FLZ(L,NY,NX)=RN3FLU(L,NY,NX)*XNPH + RNOFLZ(L,NY,NX)=RNOFLU(L,NY,NX)*XNPH + RH2PFZ(L,NY,NX)=RH2PFU(L,NY,NX)*XNPH + RN4FBZ(L,NY,NX)=RN4FBU(L,NY,NX)*XNPH + RN3FBZ(L,NY,NX)=RN3FBU(L,NY,NX)*XNPH + RNOFBZ(L,NY,NX)=RNOFBU(L,NY,NX)*XNPH + RH2BBZ(L,NY,NX)=RH2BBU(L,NY,NX)*XNPH +C +C GAS AND SOLUTE DIFFUSIVITIES AT SUB-HOURLY TIME STEP +C + OCSGL2(L,NY,NX)=OCSGL(L,NY,NX)*XNPH + ONSGL2(L,NY,NX)=ONSGL(L,NY,NX)*XNPH + OPSGL2(L,NY,NX)=OPSGL(L,NY,NX)*XNPH + OASGL2(L,NY,NX)=OASGL(L,NY,NX)*XNPH + CLSGL2(L,NY,NX)=CLSGL(L,NY,NX)*XNPH + CQSGL2(L,NY,NX)=CQSGL(L,NY,NX)*XNPH + OLSGL2(L,NY,NX)=OLSGL(L,NY,NX)*XNPH + ZLSGL2(L,NY,NX)=ZLSGL(L,NY,NX)*XNPH + ZVSGL2(L,NY,NX)=ZVSGL(L,NY,NX)*XNPH + ZNSGL2(L,NY,NX)=ZNSGL(L,NY,NX)*XNPH + HLSGL2(L,NY,NX)=HLSGL(L,NY,NX)*XNPH + ZOSGL2(L,NY,NX)=ZOSGL(L,NY,NX)*XNPH + POSGL2(L,NY,NX)=POSGL(L,NY,NX)*XNPH + CGSGL2(L,NY,NX)=CGSGL(L,NY,NX)*XNPG + CHSGL2(L,NY,NX)=CHSGL(L,NY,NX)*XNPG + OGSGL2(L,NY,NX)=OGSGL(L,NY,NX)*XNPG + ZGSGL2(L,NY,NX)=ZGSGL(L,NY,NX)*XNPG + Z2SGL2(L,NY,NX)=Z2SGL(L,NY,NX)*XNPG + ZHSGL2(L,NY,NX)=ZHSGL(L,NY,NX)*XNPG + HGSGL2(L,NY,NX)=HGSGL(L,NY,NX)*XNPG +C +C STATE VARIABLES FOR GASES AND SOLUTES USED IN 'TRNSFR' +C TO STORE SUB-HOURLY CHANGES DURING FLUX CALCULATIONS +C INCLUDING TRANSFORMATIONS FROM 'NITRO', 'UPTAKE' AND 'SOLUTE' +C + CO2G2(L,NY,NX)=CO2G(L,NY,NX) + CH4G2(L,NY,NX)=CH4G(L,NY,NX) + OXYG2(L,NY,NX)=OXYG(L,NY,NX) + ZN3G2(L,NY,NX)=ZNH3G(L,NY,NX) + Z2GG2(L,NY,NX)=Z2GG(L,NY,NX) + Z2OG2(L,NY,NX)=Z2OG(L,NY,NX) + H2GG2(L,NY,NX)=H2GG(L,NY,NX) + CO2S2(L,NY,NX)=CO2S(L,NY,NX) + CH4S2(L,NY,NX)=CH4S(L,NY,NX) + OXYS2(L,NY,NX)=OXYS(L,NY,NX) + Z2GS2(L,NY,NX)=Z2GS(L,NY,NX) + Z2OS2(L,NY,NX)=Z2OS(L,NY,NX) + H2GS2(L,NY,NX)=H2GS(L,NY,NX) + DO 9980 K=0,4 + OQC2(K,L,NY,NX)=OQC(K,L,NY,NX)-XOQCS(K,L,NY,NX) + OQN2(K,L,NY,NX)=OQN(K,L,NY,NX)-XOQNS(K,L,NY,NX) + OQP2(K,L,NY,NX)=OQP(K,L,NY,NX)-XOQPS(K,L,NY,NX) + OQA2(K,L,NY,NX)=OQA(K,L,NY,NX)-XOQAS(K,L,NY,NX) + OQCH2(K,L,NY,NX)=OQCH(K,L,NY,NX) + OQNH2(K,L,NY,NX)=OQNH(K,L,NY,NX) + OQPH2(K,L,NY,NX)=OQPH(K,L,NY,NX) + OQAH2(K,L,NY,NX)=OQAH(K,L,NY,NX) +9980 CONTINUE + ZNH4S2(L,NY,NX)=ZNH4S(L,NY,NX) + ZN3S2(L,NY,NX)=ZNH3S(L,NY,NX) + ZNO3S2(L,NY,NX)=ZNO3S(L,NY,NX) + ZNO2S2(L,NY,NX)=ZNO2S(L,NY,NX) + H2PO42(L,NY,NX)=H2PO4(L,NY,NX) + ZNH4B2(L,NY,NX)=ZNH4B(L,NY,NX) + ZNBS2(L,NY,NX)=ZNH3B(L,NY,NX) + ZNO3B2(L,NY,NX)=ZNO3B(L,NY,NX) + ZNO2B2(L,NY,NX)=ZNO2B(L,NY,NX) + H2POB2(L,NY,NX)=H2POB(L,NY,NX) + CO2SH2(L,NY,NX)=CO2SH(L,NY,NX) + CH4SH2(L,NY,NX)=CH4SH(L,NY,NX) + OXYSH2(L,NY,NX)=OXYSH(L,NY,NX) + Z2GSH2(L,NY,NX)=Z2GSH(L,NY,NX) + Z2OSH2(L,NY,NX)=Z2OSH(L,NY,NX) + H2GSH2(L,NY,NX)=H2GSH(L,NY,NX) + ZNH4H2(L,NY,NX)=ZNH4SH(L,NY,NX) + ZNH3H2(L,NY,NX)=ZNH3SH(L,NY,NX) + ZNO3H2(L,NY,NX)=ZNO3SH(L,NY,NX) + ZNO2H2(L,NY,NX)=ZNO2SH(L,NY,NX) + H2P4H2(L,NY,NX)=H2PO4H(L,NY,NX) + ZN4BH2(L,NY,NX)=ZNH4BH(L,NY,NX) + ZN3BH2(L,NY,NX)=ZNH3BH(L,NY,NX) + ZNOBH2(L,NY,NX)=ZNO3BH(L,NY,NX) + ZN2BH2(L,NY,NX)=ZNO2BH(L,NY,NX) + H2PBH2(L,NY,NX)=H2POBH(L,NY,NX) +C IF(CDPTH(L,NY,NX).LT.DPNH4(NY,NX).AND.ROWN(NY,NX).GT.0.0)THEN +C VLNHB(L,NY,NX)=WDNHB(L,NY,NX)/ROWN(NY,NX) +C ELSE +C VLNHB(L,NY,NX)=0.0 +C ENDIF +C VLNH4(L,NY,NX)=1.0-VLNHB(L,NY,NX) +C IF(CDPTH(L-1,NY,NX).LT.DPNO3(NY,NX).AND.ROWO(NY,NX).GT.0.0)THEN +C VLNOB(L,NY,NX)=WDNOB(L,NY,NX)/ROWO(NY,NX) +C ELSE +C VLNOB(L,NY,NX)=0.0 +C ENDIF +C VLNO3(L,NY,NX)=1.0-VLNOB(L,NY,NX) +C IF(CDPTH(L,NY,NX).LT.DPPO4(NY,NX).AND.ROWP(NY,NX).GT.0.0)THEN +C VLPOB(L,NY,NX)=WDPOB(L,NY,NX)/ROWP(NY,NX) +C ELSE +C VLPOB(L,NY,NX)=0.0 +C ENDIF +C VLPO4(L,NY,NX)=1.0-VLPOB(L,NY,NX) +10 CONTINUE +9990 CONTINUE + +9995 CONTINUE +C +C TIME STEP USED IN GAS AND SOLUTE FLUX CALCULATIONS +C + MX=0 + DO 30 MM=1,NPG + M=MIN(NPH,INT((MM-1)*XNPT)+1) + DO 9895 NX=NHW,NHE + DO 9890 NY=NVN,NVS + IF(M.NE.MX)THEN +C +C RESET RUNOFF SOLUTE FLUX ACCUMULATORS +C + DO 9880 K=0,2 + TQROC(K,NY,NX)=0.0 + TQRON(K,NY,NX)=0.0 + TQROP(K,NY,NX)=0.0 + TQROA(K,NY,NX)=0.0 + OQC2(K,0,NY,NX)=OQC2(K,0,NY,NX)-ROCSK2(K,0,NY,NX) + OQN2(K,0,NY,NX)=OQN2(K,0,NY,NX)-RONSK2(K,0,NY,NX) + OQP2(K,0,NY,NX)=OQP2(K,0,NY,NX)-ROPSK2(K,0,NY,NX) + OQA2(K,0,NY,NX)=OQA2(K,0,NY,NX)-ROASK2(K,0,NY,NX) +9880 CONTINUE + TQRCOS(NY,NX)=0.0 + TQRCHS(NY,NX)=0.0 + TQROXS(NY,NX)=0.0 + TQRNGS(NY,NX)=0.0 + TQRN2S(NY,NX)=0.0 + TQRHGS(NY,NX)=0.0 + TQRNH4(NY,NX)=0.0 + TQRNH3(NY,NX)=0.0 + TQRNO3(NY,NX)=0.0 + TQRNO2(NY,NX)=0.0 + TQRH2P(NY,NX)=0.0 + TQSCOS(NY,NX)=0.0 + TQSCHS(NY,NX)=0.0 + TQSOXS(NY,NX)=0.0 + TQSNGS(NY,NX)=0.0 + TQSN2S(NY,NX)=0.0 + TQSNH4(NY,NX)=0.0 + TQSNH3(NY,NX)=0.0 + TQSNO3(NY,NX)=0.0 + TQSH2P(NY,NX)=0.0 + ZNH4S2(0,NY,NX)=ZNH4S2(0,NY,NX)-RN4SK2(0,NY,NX) + ZN3S2(0,NY,NX)=ZN3S2(0,NY,NX)-RN3SK2(0,NY,NX) + ZNO3S2(0,NY,NX)=ZNO3S2(0,NY,NX)-RNOSK2(0,NY,NX) + ZNO2S2(0,NY,NX)=ZNO2S2(0,NY,NX)-RNXSK2(0,NY,NX) + H2PO42(0,NY,NX)=H2PO42(0,NY,NX)-RHPSK2(0,NY,NX) + ROXSK2(0,NY,NX)=ROXSK(M,0,NY,NX)*XNPT + ENDIF + CO2S2(0,NY,NX)=CO2S2(0,NY,NX)-RCOSK2(0,NY,NX) + CH4S2(0,NY,NX)=CH4S2(0,NY,NX)-RCHSK2(0,NY,NX) + OXYS2(0,NY,NX)=OXYS2(0,NY,NX)-ROXSK2(0,NY,NX) + Z2GS2(0,NY,NX)=Z2GS2(0,NY,NX)-RNGSK2(0,NY,NX) + Z2OS2(0,NY,NX)=Z2OS2(0,NY,NX)-RN2SK2(0,NY,NX) + H2GS2(0,NY,NX)=H2GS2(0,NY,NX)-RHGSK2(0,NY,NX) + ZN3G2(0,NY,NX)=ZN3G2(0,NY,NX)-RNHSK2(0,NY,NX) +C +C RESET SOIL SOLUTE FLUX ACCUMULATORS +C + DO 9885 L=NU(NY,NX),NL(NY,NX) + IF(M.NE.MX)THEN + DO 9875 K=0,4 + TOCFLS(K,L,NY,NX)=0.0 + TONFLS(K,L,NY,NX)=0.0 + TOPFLS(K,L,NY,NX)=0.0 + TOAFLS(K,L,NY,NX)=0.0 + TOCFHS(K,L,NY,NX)=0.0 + TONFHS(K,L,NY,NX)=0.0 + TOPFHS(K,L,NY,NX)=0.0 + TOAFHS(K,L,NY,NX)=0.0 + OQC2(K,L,NY,NX)=OQC2(K,L,NY,NX)-ROCSK2(K,L,NY,NX) + OQN2(K,L,NY,NX)=OQN2(K,L,NY,NX)-RONSK2(K,L,NY,NX) + OQP2(K,L,NY,NX)=OQP2(K,L,NY,NX)-ROPSK2(K,L,NY,NX) + OQA2(K,L,NY,NX)=OQA2(K,L,NY,NX)-ROASK2(K,L,NY,NX) +9875 CONTINUE + TCOFLS(L,NY,NX)=0.0 + TCHFLS(L,NY,NX)=0.0 + TOXFLS(L,NY,NX)=0.0 + TNGFLS(L,NY,NX)=0.0 + TN2FLS(L,NY,NX)=0.0 + THGFLS(L,NY,NX)=0.0 + TN4FLW(L,NY,NX)=0.0 + TN3FLW(L,NY,NX)=0.0 + TNOFLW(L,NY,NX)=0.0 + TNXFLS(L,NY,NX)=0.0 + TH2PFS(L,NY,NX)=0.0 + TN4FLB(L,NY,NX)=0.0 + TN3FLB(L,NY,NX)=0.0 + TNOFLB(L,NY,NX)=0.0 + TNXFLB(L,NY,NX)=0.0 + TH2BFB(L,NY,NX)=0.0 + TCOFHS(L,NY,NX)=0.0 + TCHFHS(L,NY,NX)=0.0 + TOXFHS(L,NY,NX)=0.0 + TNGFHS(L,NY,NX)=0.0 + TN2FHS(L,NY,NX)=0.0 + THGFHS(L,NY,NX)=0.0 + TN4FHW(L,NY,NX)=0.0 + TN3FHW(L,NY,NX)=0.0 + TNOFHW(L,NY,NX)=0.0 + TNXFHS(L,NY,NX)=0.0 + TH2PHS(L,NY,NX)=0.0 + TN4FHB(L,NY,NX)=0.0 + TN3FHB(L,NY,NX)=0.0 + TNOFHB(L,NY,NX)=0.0 + TNXFHB(L,NY,NX)=0.0 + TH2BHB(L,NY,NX)=0.0 + ZNH4S2(L,NY,NX)=ZNH4S2(L,NY,NX)-RN4SK2(L,NY,NX) + ZN3S2(L,NY,NX)=ZN3S2(L,NY,NX)-RN3SK2(L,NY,NX) + ZNO3S2(L,NY,NX)=ZNO3S2(L,NY,NX)-RNOSK2(L,NY,NX) + ZNO2S2(L,NY,NX)=ZNO2S2(L,NY,NX)-RNXSK2(L,NY,NX) + H2PO42(L,NY,NX)=H2PO42(L,NY,NX)-RHPSK2(L,NY,NX) + ZNH4B2(L,NY,NX)=ZNH4B2(L,NY,NX)-R4BSK2(L,NY,NX) + ZNBS2(L,NY,NX)=ZNBS2(L,NY,NX)-R3BSK2(L,NY,NX) + ZNO3B2(L,NY,NX)=ZNO3B2(L,NY,NX)-RNBSK2(L,NY,NX) + ZNO2B2(L,NY,NX)=ZNO2B2(L,NY,NX)-RNZSK2(L,NY,NX) + H2POB2(L,NY,NX)=H2POB2(L,NY,NX)-RHBSK2(L,NY,NX) + ROXSK2(L,NY,NX)=ROXSK(M,L,NY,NX)*XNPT + ENDIF +C +C SOIL GAS FLUX ACCUMULATORS +C + TCOFLG(L,NY,NX)=0.0 + TCHFLG(L,NY,NX)=0.0 + TOXFLG(L,NY,NX)=0.0 + TNGFLG(L,NY,NX)=0.0 + TN2FLG(L,NY,NX)=0.0 + TN3FLG(L,NY,NX)=0.0 + THGFLG(L,NY,NX)=0.0 + CO2S2(L,NY,NX)=CO2S2(L,NY,NX)-RCOSK2(L,NY,NX) + CH4S2(L,NY,NX)=CH4S2(L,NY,NX)-RCHSK2(L,NY,NX) + OXYS2(L,NY,NX)=OXYS2(L,NY,NX)-ROXSK2(L,NY,NX) + Z2GS2(L,NY,NX)=Z2GS2(L,NY,NX)-RNGSK2(L,NY,NX) + 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) +9885 CONTINUE +C +C SOLUTE FLUXES AT SOIL SURFACE FROM SURFACE WATER +C CONTENTS, WATER FLUXES 'FLQM' AND ATMOSPHERE BOUNDARY +C LAYER RESISTANCES 'PARGM' FROM 'WATSUB' +C + IF(M.NE.MX)THEN + VOLWMA(NU(NY,NX),NY,NX)=VOLWM(M,NU(NY,NX),NY,NX) + 2*VLNH4(NU(NY,NX),NY,NX) + VOLWMB(NU(NY,NX),NY,NX)=VOLWM(M,NU(NY,NX),NY,NX) + 2*VLNHB(NU(NY,NX),NY,NX) + VOLWXA(NU(NY,NX),NY,NX)=14.0*VOLWMA(NU(NY,NX),NY,NX) + VOLWXB(NU(NY,NX),NY,NX)=14.0*VOLWMB(NU(NY,NX),NY,NX) + VOLWOA=VOLWM(M,NU(NY,NX),NY,NX)*VLNO3(NU(NY,NX),NY,NX) + VOLWOB=VOLWM(M,NU(NY,NX),NY,NX)*VLNOB(NU(NY,NX),NY,NX) + VOLWPA=VOLWM(M,NU(NY,NX),NY,NX)*VLPO4(NU(NY,NX),NY,NX) + VOLWPB=VOLWM(M,NU(NY,NX),NY,NX)*VLPOB(NU(NY,NX),NY,NX) + VOLPMA(NU(NY,NX),NY,NX)=VOLPM(M,NU(NY,NX),NY,NX) + 2*VLNH4(NU(NY,NX),NY,NX) + VOLPMB(NU(NY,NX),NY,NX)=VOLPM(M,NU(NY,NX),NY,NX) + 2*VLNHB(NU(NY,NX),NY,NX) + THETW1(NU(NY,NX),NY,NX)=AMAX1(0.0,VOLWM(M,NU(NY,NX),NY,NX) + 2/VOLX(NU(NY,NX),NY,NX)) + FLVM(NU(NY,NX),NY,NX)=FLPM(M,NU(NY,NX),NY,NX)*XNPT + FLQM(3,NU(NY,NX),NY,NX)=(FLWM(M,3,NU(NY,NX),NY,NX) + 2+FLWHM(M,3,NU(NY,NX),NY,NX))*XNPT +C +C SURFACE EXCHANGE OF AQUEOUS CO2, CH4, O2, N2, NH3 +C THROUGH VOLATILIZATION-DISSOLUTION FROM AQUEOUS +C DIFFUSIVITIES IN SURFACE RESIDUE +C + IF(VOLWM(M,0,NY,NX).GT.ZEROS(NY,NX))THEN + 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) + VOLWNG(0,NY,NX)=VOLWM(M,0,NY,NX)*SN2GL(0,NY,NX) + VOLWN2(0,NY,NX)=VOLWM(M,0,NY,NX)*SN2OL(0,NY,NX) + VOLWN3(0,NY,NX)=VOLWM(M,0,NY,NX)*SNH3L(0,NY,NX) + VOLWHG(0,NY,NX)=VOLWM(M,0,NY,NX)*SH2GL(0,NY,NX) + VOLWXA(0,NY,NX)=14.0*VOLWM(M,0,NY,NX) + TORT0=TORT(M,0,NY,NX)*AREA(3,NU(NY,NX),NY,NX) + 2/(0.5*DLYR(3,0,NY,NX)) + DFGSCO=CLSGL2(0,NY,NX)*TORT0 + DFGSCH=CQSGL2(0,NY,NX)*TORT0 + DFGSOX=OLSGL2(0,NY,NX)*TORT0 + DFGSNG=ZLSGL2(0,NY,NX)*TORT0 + DFGSN2=ZNSGL2(0,NY,NX)*TORT0 + DFGSN3=ZVSGL2(0,NY,NX)*TORT0 + DFGSHL=HLSGL2(0,NY,NX)*TORT0 + CO2S2X=AMAX1(0.0,CO2S2(0,NY,NX)) + CH4S2X=AMAX1(0.0,CH4S2(0,NY,NX)) + OXYS2X=AMAX1(0.0,OXYS2(0,NY,NX)) + Z2GS2X=AMAX1(0.0,Z2GS2(0,NY,NX)) + Z2OS2X=AMAX1(0.0,Z2OS2(0,NY,NX)) + ZN3S2X=AMAX1(0.0,ZN3S2(0,NY,NX)) + H2GS2X=AMAX1(0.0,H2GS2(0,NY,NX)) +C +C EQUILIBRIUM CONCENTRATIONS AT RESIDUE SURFACE AT WHICH +C AQUEOUS DIFFUSION THROUGH RESIDUE SURFACE LAYER = GASEOUS +C DIFFUSION THROUGH ATMOSPHERE BOUNDARY LAYER CALCULATED +C FROM AQUEOUS DIFFUSIVITY AND BOUNDARY LAYER CONDUCTANCE +C + CO2GQ=(PARR(NY,NX)*CCO2E(NY,NX)*VOLWCO(0,NY,NX)+DFGSCO + 2*CO2S2X)/(DFGSCO+PARR(NY,NX)) + CH4GQ=(PARR(NY,NX)*CCH4E(NY,NX)*VOLWCH(0,NY,NX)+DFGSCH + 2*CH4S2X)/(DFGSCH+PARR(NY,NX)) + OXYGQ=(PARR(NY,NX)*COXYE(NY,NX)*VOLWOX(0,NY,NX)+DFGSOX + 2*OXYS2X)/(DFGSOX+PARR(NY,NX)) + Z2GGQ=(PARR(NY,NX)*CZ2GE(NY,NX)*VOLWNG(0,NY,NX)+DFGSNG + 2*Z2GS2X)/(DFGSNG+PARR(NY,NX)) + Z2OGQ=(PARR(NY,NX)*CZ2OE(NY,NX)*VOLWN2(0,NY,NX)+DFGSN2 + 2*Z2OS2X)/(DFGSN2+PARR(NY,NX)) + ZN3GQ=(PARR(NY,NX)*CNH3E(NY,NX)*VOLWN3(0,NY,NX)+DFGSN3 + 2*ZN3S2X)/(DFGSN3+PARR(NY,NX)) + H2GGQ=(PARR(NY,NX)*CH2GE(NY,NX)*VOLWHG(0,NY,NX)+DFGSHL + 2*H2GS2X)/(DFGSHL+PARR(NY,NX)) +C +C SURFACE VOLATILIZATION-DISSOLUTION FROM DIFFERENCES +C BETWEEN ATMOSPHERIC AND RESIDUE SURFACE EQUILIBRIUM +C CONCENTRATIONS +C + RCODFR(NY,NX)=CO2GQ-CO2S2X + RCHDFR(NY,NX)=CH4GQ-CH4S2X + ROXDFR(NY,NX)=OXYGQ-OXYS2X + RNGDFR(NY,NX)=Z2GGQ-Z2GS2X + RN2DFR(NY,NX)=Z2OGQ-Z2OS2X + RN3DFR(NY,NX)=ZN3GQ-ZN3S2X + RHGDFR(NY,NX)=H2GGQ-H2GS2X +C +C ACCUMULATE HOURLY FLUXES +C + XCODFR(NY,NX)=XCODFR(NY,NX)+RCODFR(NY,NX) + XCHDFR(NY,NX)=XCHDFR(NY,NX)+RCHDFR(NY,NX) + XOXDFR(NY,NX)=XOXDFR(NY,NX)+ROXDFR(NY,NX) + XNGDFR(NY,NX)=XNGDFR(NY,NX)+RNGDFR(NY,NX) + 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 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) +C 4,DLYR(3,0,NY,NX),VOLWM(M,0,NY,NX) +C WRITE(*,1118)'RCHDFR',I,J,NX,NY,M,MM,RCHDFR(NY,NX) +C 2,CH4GQ,CH4S2(0,NY,NX),PARR(NY,NX),CCH4E(NY,NX) +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) +1118 FORMAT(A8,6I4,20E12.4) +C ENDIF + ELSE + RCODFR(NY,NX)=0.0 + RCHDFR(NY,NX)=0.0 + ROXDFR(NY,NX)=0.0 + RNGDFR(NY,NX)=0.0 + RN2DFR(NY,NX)=0.0 + RN3DFR(NY,NX)=0.0 + RHGDFR(NY,NX)=0.0 + ENDIF + RCODXR=RCODFR(NY,NX)*XNPT + RCHDXR=RCHDFR(NY,NX)*XNPT + ROXDXR=ROXDFR(NY,NX)*XNPT + RNGDXR=RNGDFR(NY,NX)*XNPT + RN2DXR=RN2DFR(NY,NX)*XNPT + RN3DXR=RN3DFR(NY,NX)*XNPT + RHGDXR=RHGDFR(NY,NX)*XNPT +C +C SURFACE EXCHANGE OF AQUEOUS CO2, CH4, O2, N2, NH3 +C THROUGH VOLATILIZATION-DISSOLUTION FROM AQUEOUS +C DIFFUSIVITIES IN SURFACE SOIL LAYER +C + IF(VOLWM(M,NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN + VOLWCO(NU(NY,NX),NY,NX)=VOLWM(M,NU(NY,NX),NY,NX) + 2*SCO2L(NU(NY,NX),NY,NX) + VOLWCH(NU(NY,NX),NY,NX)=VOLWM(M,NU(NY,NX),NY,NX) + 2*SCH4L(NU(NY,NX),NY,NX) + VOLWOX(NU(NY,NX),NY,NX)=VOLWM(M,NU(NY,NX),NY,NX) + 2*SOXYL(NU(NY,NX),NY,NX) + VOLWNG(NU(NY,NX),NY,NX)=VOLWM(M,NU(NY,NX),NY,NX) + 2*SN2GL(NU(NY,NX),NY,NX) + VOLWN2(NU(NY,NX),NY,NX)=VOLWM(M,NU(NY,NX),NY,NX) + 2*SN2OL(NU(NY,NX),NY,NX) + VOLWN3(NU(NY,NX),NY,NX)=VOLWMA(NU(NY,NX),NY,NX) + 2*SNH3L(NU(NY,NX),NY,NX) + VOLWNB(NU(NY,NX),NY,NX)=VOLWMB(NU(NY,NX),NY,NX) + 2*SNH3L(NU(NY,NX),NY,NX) + VOLWHG(NU(NY,NX),NY,NX)=VOLWM(M,NU(NY,NX),NY,NX) + 2*SH2GL(NU(NY,NX),NY,NX) + TORT1=TORT(M,NU(NY,NX),NY,NX)*AREA(3,NU(NY,NX),NY,NX) + 2/(0.5*DLYR(3,NU(NY,NX),NY,NX)) + DFGSCO=CLSGL2(NU(NY,NX),NY,NX)*TORT1 + DFGSCH=CQSGL2(NU(NY,NX),NY,NX)*TORT1 + DFGSOX=OLSGL2(NU(NY,NX),NY,NX)*TORT1 + DFGSNG=ZLSGL2(NU(NY,NX),NY,NX)*TORT1 + DFGSN2=ZNSGL2(NU(NY,NX),NY,NX)*TORT1 + DFGSN3=ZVSGL2(NU(NY,NX),NY,NX)*TORT1 + DFGSHL=HLSGL2(NU(NY,NX),NY,NX)*TORT1 + CO2S2X=AMAX1(0.0,CO2S2(NU(NY,NX),NY,NX)) + CH4S2X=AMAX1(0.0,CH4S2(NU(NY,NX),NY,NX)) + OXYS2X=AMAX1(0.0,OXYS2(NU(NY,NX),NY,NX)) + Z2GS2X=AMAX1(0.0,Z2GS2(NU(NY,NX),NY,NX)) + Z2OS2X=AMAX1(0.0,Z2OS2(NU(NY,NX),NY,NX)) + ZN3S2X=AMAX1(0.0,ZN3S2(NU(NY,NX),NY,NX)) + ZNBS2X=AMAX1(0.0,ZNBS2(NU(NY,NX),NY,NX)) + H2GS2X=AMAX1(0.0,H2GS2(NU(NY,NX),NY,NX)) +C +C EQUILIBRIUM CONCENTRATIONS AT SOIL SURFACE AT WHICH +C AQUEOUS DIFFUSION THROUGH SOIL SURFACE LAYER = GASEOUS +C DIFFUSION THROUGH ATMOSPHERE BOUNDARY LAYER CALCULATED +C FROM AQUEOUS DIFFUSIVITY AND BOUNDARY LAYER CONDUCTANCE +C + CO2GQ=(PARG(NY,NX)*CCO2E(NY,NX)*VOLWCO(NU(NY,NX),NY,NX) + 2+DFGSCO*CO2S2X)/(DFGSCO+PARG(NY,NX)) + CH4GQ=(PARG(NY,NX)*CCH4E(NY,NX)*VOLWCH(NU(NY,NX),NY,NX) + 2+DFGSCH*CH4S2X)/(DFGSCH+PARG(NY,NX)) + OXYGQ=(PARG(NY,NX)*COXYE(NY,NX)*VOLWOX(NU(NY,NX),NY,NX) + 2+DFGSOX*OXYS2X)/(DFGSOX+PARG(NY,NX)) + Z2GGQ=(PARG(NY,NX)*CZ2GE(NY,NX)*VOLWNG(NU(NY,NX),NY,NX) + 2+DFGSNG*Z2GS2X)/(DFGSNG+PARG(NY,NX)) + Z2OGQ=(PARG(NY,NX)*CZ2OE(NY,NX)*VOLWN2(NU(NY,NX),NY,NX) + 2+DFGSN2*Z2OS2X)/(DFGSN2+PARG(NY,NX)) + ZN3GQ=(PARG(NY,NX)*CNH3E(NY,NX)*VOLWN3(NU(NY,NX),NY,NX) + 2+DFGSN3*ZN3S2X)/(DFGSN3+PARG(NY,NX)) + ZNBGQ=(PARG(NY,NX)*CNH3E(NY,NX)*VOLWNB(NU(NY,NX),NY,NX) + 2+DFGSN3*ZNBS2X)/(DFGSN3+PARG(NY,NX)) + H2GGQ=(PARG(NY,NX)*CH2GE(NY,NX)*VOLWHG(NU(NY,NX),NY,NX) + 2+DFGSHL*H2GS2X)/(DFGSHL+PARG(NY,NX)) +C +C SURFACE VOLATILIZATION-DISSOLUTION FROM DIFFERENCES +C BETWEEN ATMOSPHERIC AND SOIL SURFACE EQUILIBRIUM +C CONCENTRATIONS +C + RCODFS(NY,NX)=CO2GQ-CO2S2X + RCHDFS(NY,NX)=CH4GQ-CH4S2X + ROXDFS(NY,NX)=OXYGQ-OXYS2X + RNGDFS(NY,NX)=Z2GGQ-Z2GS2X + RN2DFS(NY,NX)=Z2OGQ-Z2OS2X + RN3DFS(NY,NX)=ZN3GQ-ZN3S2X + RNBDFS(NY,NX)=ZNBGQ-ZNBS2X + RHGDFS(NY,NX)=H2GGQ-H2GS2X +C +C ACCUMULATE HOURLY FLUXES +C + XCODFS(NY,NX)=XCODFS(NY,NX)+RCODFS(NY,NX) + XCHDFS(NY,NX)=XCHDFS(NY,NX)+RCHDFS(NY,NX) + XOXDFS(NY,NX)=XOXDFS(NY,NX)+ROXDFS(NY,NX) + XNGDFS(NY,NX)=XNGDFS(NY,NX)+RNGDFS(NY,NX) + XN2DFS(NY,NX)=XN2DFS(NY,NX)+RN2DFS(NY,NX) + XN3DFS(NY,NX)=XN3DFS(NY,NX)+RN3DFS(NY,NX) + 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)'RCHDFS',I,J,NX,NY,M,MM,RCHDFS(NY,NX) +C 2,CH4GQ,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 3,COXYE(NY,NX),VOLWOX(NU(NY,NX),NY,NX),DFGSOX,TORT(M,0,NY,NX) +C 4,XOXDFS(NY,NX) +C ENDIF + ELSE + RCODFS(NY,NX)=0.0 + RCHDFS(NY,NX)=0.0 + ROXDFS(NY,NX)=0.0 + RNGDFS(NY,NX)=0.0 + RN2DFS(NY,NX)=0.0 + RN3DFS(NY,NX)=0.0 + RNBDFS(NY,NX)=0.0 + RHGDFS(NY,NX)=0.0 + ENDIF + RCODXS=RCODFS(NY,NX)*XNPT + RCHDXS=RCHDFS(NY,NX)*XNPT + ROXDXS=ROXDFS(NY,NX)*XNPT + RNGDXS=RNGDFS(NY,NX)*XNPT + RN2DXS=RN2DFS(NY,NX)*XNPT + RN3DXS=RN3DFS(NY,NX)*XNPT + RNBDXS=RNBDFS(NY,NX)*XNPT + RHGDXS=RHGDFS(NY,NX)*XNPT +C +C CONVECTIVE SOLUTE EXCHANGE BETWEEN RESIDUE AND SOIL SURFACE +C + FLWRM1=FLWRM(M,NY,NX) +C +C IF WATER FLUX FROM 'WATSUB' IS FROM RESIDUE TO +C SOIL SURFACE THEN CONVECTIVE TRANSPORT IS THE PRODUCT +C OF WATER FLUX AND MICROPORE GAS OR SOLUTE CONCENTRATIONS +C IN RESIDUE +C + IF(FLWRM1.GT.0.0)THEN + IF(VOLWM(M,0,NY,NX).GT.ZEROS(NY,NX))THEN + VFLW=AMAX1(0.0,AMIN1(XFRX,FLWRM1/VOLWM(M,0,NY,NX))) + ELSE + VFLW=XFRX + ENDIF + DO 8820 K=0,2 + 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)) + RFLOA(K)=VFLW*AMAX1(0.0,OQA2(K,0,NY,NX)) +8820 CONTINUE + RFLCOS=VFLW*AMAX1(0.0,CO2S2(0,NY,NX)) + RFLCHS=VFLW*AMAX1(0.0,CH4S2(0,NY,NX)) + RFLOXS=VFLW*AMAX1(0.0,OXYS2(0,NY,NX)) + RFLNGS=VFLW*AMAX1(0.0,Z2GS2(0,NY,NX)) + RFLN2S=VFLW*AMAX1(0.0,Z2OS2(0,NY,NX)) + RFLHGS=VFLW*AMAX1(0.0,H2GS2(0,NY,NX)) + RFLNH4=VFLW*AMAX1(0.0,ZNH4S2(0,NY,NX))*VLNH4(NU(NY,NX),NY,NX) + RFLNH3=VFLW*AMAX1(0.0,ZN3S2(0,NY,NX))*VLNH4(NU(NY,NX),NY,NX) + RFLNO3=VFLW*AMAX1(0.0,ZNO3S2(0,NY,NX))*VLNO3(NU(NY,NX),NY,NX) + RFLNO2=VFLW*AMAX1(0.0,ZNO2S2(0,NY,NX))*VLNO3(NU(NY,NX),NY,NX) + RFLPO4=VFLW*AMAX1(0.0,H2PO42(0,NY,NX))*VLPO4(NU(NY,NX),NY,NX) + RFLN4B=VFLW*AMAX1(0.0,ZNH4S2(0,NY,NX))*VLNHB(NU(NY,NX),NY,NX) + RFLN3B=VFLW*AMAX1(0.0,ZN3S2(0,NY,NX))*VLNHB(NU(NY,NX),NY,NX) + RFLNOB=VFLW*AMAX1(0.0,ZNO3S2(0,NY,NX))*VLNOB(NU(NY,NX),NY,NX) + RFLN2B=VFLW*AMAX1(0.0,ZNO2S2(0,NY,NX))*VLNOB(NU(NY,NX),NY,NX) + RFLPOB=VFLW*AMAX1(0.0,H2PO42(0,NY,NX))*VLPOB(NU(NY,NX),NY,NX) +C +C IF WATER FLUX FROM 'WATSUB' IS TO RESIDUE FROM +C SOIL SURFACE THEN CONVECTIVE TRANSPORT IS THE PRODUCT +C OF WATER FLUX AND MICROPORE GAS OR SOLUTE CONCENTRATIONS +C IN SOIL SURFACE +C + ELSE + IF(VOLWM(M,NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN + VFLW=AMIN1(0.0,AMAX1(-XFRX,FLWRM1/VOLWM(M,NU(NY,NX),NY,NX))) + ELSE + VFLW=-XFRX + ENDIF + DO 8815 K=0,2 + 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)) + RFLOA(K)=VFLW*AMAX1(0.0,OQA2(K,NU(NY,NX),NY,NX)) +8815 CONTINUE + RFLCOS=VFLW*AMAX1(0.0,CO2S2(NU(NY,NX),NY,NX)) + RFLCHS=VFLW*AMAX1(0.0,CH4S2(NU(NY,NX),NY,NX)) + RFLOXS=VFLW*AMAX1(0.0,OXYS2(NU(NY,NX),NY,NX)) + RFLNGS=VFLW*AMAX1(0.0,Z2GS2(NU(NY,NX),NY,NX)) + RFLN2S=VFLW*AMAX1(0.0,Z2OS2(NU(NY,NX),NY,NX)) + RFLHGS=VFLW*AMAX1(0.0,H2GS2(NU(NY,NX),NY,NX)) + RFLNH4=VFLW*AMAX1(0.0,ZNH4S2(NU(NY,NX),NY,NX)) + RFLNH3=VFLW*AMAX1(0.0,ZN3S2(NU(NY,NX),NY,NX)) + RFLNO3=VFLW*AMAX1(0.0,ZNO3S2(NU(NY,NX),NY,NX)) + RFLNO2=VFLW*AMAX1(0.0,ZNO2S2(NU(NY,NX),NY,NX)) + RFLPO4=VFLW*AMAX1(0.0,H2PO42(NU(NY,NX),NY,NX)) + RFLN4B=VFLW*AMAX1(0.0,ZNH4B2(NU(NY,NX),NY,NX)) + RFLN3B=VFLW*AMAX1(0.0,ZNBS2(NU(NY,NX),NY,NX)) + RFLNOB=VFLW*AMAX1(0.0,ZNO3B2(NU(NY,NX),NY,NX)) + RFLN2B=VFLW*AMAX1(0.0,ZNO2B2(NU(NY,NX),NY,NX)) + RFLPOB=VFLW*AMAX1(0.0,H2POB2(NU(NY,NX),NY,NX)) + ENDIF +C +C DIFFUSIVE FLUXES OF GASES AND SOLUTES BETWEEN RESIDUE AND +C SOIL SURFACE FROM AQUEOUS DIFFUSIVITIES +C AND CONCENTRATION DIFFERENCES +C + IF(THETW1(0,NY,NX).GT.THETY(0,NY,NX) + 2.AND.THETW1(NU(NY,NX),NY,NX).GT.THETY(NU(NY,NX),NY,NX))THEN +C +C MICROPORE CONCENTRATIONS FROM WATER IN RESIDUE AND SOIL SURFACE +C + DO 8810 K=0,2 + 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)) + COQA1(K)=AMAX1(0.0,OQA2(K,0,NY,NX)/VOLWM(M,0,NY,NX)) + COQC2(K)=AMAX1(0.0,OQC2(K,NU(NY,NX),NY,NX) + 2/VOLWM(M,NU(NY,NX),NY,NX)) + COQN2(K)=AMAX1(0.0,OQN2(K,NU(NY,NX),NY,NX) + 2/VOLWM(M,NU(NY,NX),NY,NX)) + COQP2(K)=AMAX1(0.0,OQP2(K,NU(NY,NX),NY,NX) + 2/VOLWM(M,NU(NY,NX),NY,NX)) + COQA2(K)=AMAX1(0.0,OQA2(K,NU(NY,NX),NY,NX) + 2/VOLWM(M,NU(NY,NX),NY,NX)) +8810 CONTINUE + CCO2S1=AMAX1(0.0,CO2S2(0,NY,NX)/VOLWM(M,0,NY,NX)) + CCH4S1=AMAX1(0.0,CH4S2(0,NY,NX)/VOLWM(M,0,NY,NX)) + COXYS1=AMAX1(0.0,OXYS2(0,NY,NX)/VOLWM(M,0,NY,NX)) + CZ2GS1=AMAX1(0.0,Z2GS2(0,NY,NX)/VOLWM(M,0,NY,NX)) + CZ2OS1=AMAX1(0.0,Z2OS2(0,NY,NX)/VOLWM(M,0,NY,NX)) + CH2GS1=AMAX1(0.0,H2GS2(0,NY,NX)/VOLWM(M,0,NY,NX)) + CNH4S1=AMAX1(0.0,ZNH4S2(0,NY,NX)/VOLWM(M,0,NY,NX)) + CNH3S1=AMAX1(0.0,ZN3S2(0,NY,NX)/VOLWM(M,0,NY,NX)) + CNO3S1=AMAX1(0.0,ZNO3S2(0,NY,NX)/VOLWM(M,0,NY,NX)) + CNO2S1=AMAX1(0.0,ZNO2S2(0,NY,NX)/VOLWM(M,0,NY,NX)) + CPO4S1=AMAX1(0.0,H2PO42(0,NY,NX)/VOLWM(M,0,NY,NX)) + CCO2S2=AMAX1(0.0,CO2S2(NU(NY,NX),NY,NX)/VOLWM(M,NU(NY,NX),NY,NX)) + CCH4S2=AMAX1(0.0,CH4S2(NU(NY,NX),NY,NX)/VOLWM(M,NU(NY,NX),NY,NX)) + COXYS2=AMAX1(0.0,OXYS2(NU(NY,NX),NY,NX)/VOLWM(M,NU(NY,NX),NY,NX)) + CZ2GS2=AMAX1(0.0,Z2GS2(NU(NY,NX),NY,NX)/VOLWM(M,NU(NY,NX),NY,NX)) + CZ2OS2=AMAX1(0.0,Z2OS2(NU(NY,NX),NY,NX)/VOLWM(M,NU(NY,NX),NY,NX)) + CH2GS2=AMAX1(0.0,H2GS2(NU(NY,NX),NY,NX)/VOLWM(M,NU(NY,NX),NY,NX)) + IF(VOLWMA(NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN + CNH3S2=AMAX1(0.0,ZN3S2(NU(NY,NX),NY,NX)/VOLWMA(NU(NY,NX),NY,NX)) + CNH4S2=AMAX1(0.0,ZNH4S2(NU(NY,NX),NY,NX)/VOLWMA(NU(NY,NX),NY,NX)) + ELSE + CNH3S2=0.0 + CNH4S2=0.0 + ENDIF + IF(VOLWOA.GT.ZEROS(NY,NX))THEN + CNO3S2=AMAX1(0.0,ZNO3S2(NU(NY,NX),NY,NX)/VOLWOA) + CNO2S2=AMAX1(0.0,ZNO2S2(NU(NY,NX),NY,NX)/VOLWOA) + ELSE + CNO3S2=0.0 + CNO2S2=0.0 + ENDIF + IF(VOLWPA.GT.ZEROS(NY,NX))THEN + CPO4S2=AMAX1(0.0,H2PO42(NU(NY,NX),NY,NX)/VOLWPA) + ELSE + CPO4S2=0.0 + ENDIF + IF(VOLWMB(NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN + CNH3B2=AMAX1(0.0,ZNBS2(NU(NY,NX),NY,NX)/VOLWMB(NU(NY,NX),NY,NX)) + CNH4B2=AMAX1(0.0,ZNH4B2(NU(NY,NX),NY,NX)/VOLWMB(NU(NY,NX),NY,NX)) + ELSE + CNH3B2=CNH3S2 + CNH4B2=CNH4S2 + ENDIF + IF(VOLWOB.GT.ZEROS(NY,NX))THEN + CNO3B2=AMAX1(0.0,ZNO3B2(NU(NY,NX),NY,NX)/VOLWOB) + CNO2B2=AMAX1(0.0,ZNO2B2(NU(NY,NX),NY,NX)/VOLWOB) + ELSE + CNO3B2=CNO3S2 + CNO2B2=CNO2S2 + ENDIF + IF(VOLWPB.GT.ZEROS(NY,NX))THEN + CPO4B2=AMAX1(0.0,H2POB2(NU(NY,NX),NY,NX)/VOLWPB) + ELSE + CPO4B2=CPO4S2 + ENDIF +C +C DIFFUSIVITIES IN RESIDUE AND SOIL SURFACE +C + TORT0=TORT(M,0,NY,NX)*AREA(3,NU(NY,NX),NY,NX) + 2/DLYR(3,0,NY,NX) + TORT1=TORT(M,NU(NY,NX),NY,NX)*AREA(3,NU(NY,NX),NY,NX) + 2/DLYR(3,NU(NY,NX),NY,NX) + DISPN=DISP(3,NU(NY,NX),NY,NX)*ABS(FLWRM1/AREA(3,NU(NY,NX),NY,NX)) + DIFOC0=(OCSGL2(0,NY,NX)*TORT0+DISPN) + DIFON0=(ONSGL2(0,NY,NX)*TORT0+DISPN) + DIFOP0=(OPSGL2(0,NY,NX)*TORT0+DISPN) + DIFOA0=(OASGL2(0,NY,NX)*TORT0+DISPN) + DIFNH0=(ZNSGL2(0,NY,NX)*TORT0+DISPN) + DIFNO0=(ZOSGL2(0,NY,NX)*TORT0+DISPN) + DIFPO0=(POSGL2(0,NY,NX)*TORT0+DISPN) + DIFCS0=(CLSGL2(0,NY,NX)*TORT0+DISPN) + DIFCQ0=(CQSGL2(0,NY,NX)*TORT0+DISPN) + DIFOS0=(OLSGL2(0,NY,NX)*TORT0+DISPN) + DIFNG0=(ZLSGL2(0,NY,NX)*TORT0+DISPN) + DIFN20=(ZVSGL2(0,NY,NX)*TORT0+DISPN) + DIFHG0=(HLSGL2(0,NY,NX)*TORT0+DISPN) + DIFOC1=(OCSGL2(NU(NY,NX),NY,NX)*TORT1+DISPN) + DIFON1=(ONSGL2(NU(NY,NX),NY,NX)*TORT1+DISPN) + DIFOP1=(OPSGL2(NU(NY,NX),NY,NX)*TORT1+DISPN) + DIFOA1=(OASGL2(NU(NY,NX),NY,NX)*TORT1+DISPN) + DIFNH1=(ZNSGL2(NU(NY,NX),NY,NX)*TORT1+DISPN) + DIFNO1=(ZOSGL2(NU(NY,NX),NY,NX)*TORT1+DISPN) + DIFPO1=(POSGL2(NU(NY,NX),NY,NX)*TORT1+DISPN) + DIFCS1=(CLSGL2(NU(NY,NX),NY,NX)*TORT1+DISPN) + DIFCQ1=(CQSGL2(NU(NY,NX),NY,NX)*TORT1+DISPN) + DIFOS1=(OLSGL2(NU(NY,NX),NY,NX)*TORT1+DISPN) + DIFNG1=(ZLSGL2(NU(NY,NX),NY,NX)*TORT1+DISPN) + DIFN21=(ZVSGL2(NU(NY,NX),NY,NX)*TORT1+DISPN) + DIFHG1=(HLSGL2(NU(NY,NX),NY,NX)*TORT1+DISPN) + DIFOC=DIFOC0*DIFOC1/(DIFOC0+DIFOC1) + DIFON=DIFON0*DIFON1/(DIFON0+DIFON1) + DIFOP=DIFOP0*DIFOP1/(DIFOP0+DIFOP1) + DIFOA=DIFOA0*DIFOA1/(DIFOA0+DIFOA1) + DIFNH=DIFNH0*DIFNH1/(DIFNH0+DIFNH1) + DIFNO=DIFNO0*DIFNO1/(DIFNO0+DIFNO1) + DIFPO=DIFPO0*DIFPO1/(DIFPO0+DIFPO1) + DIFCS=DIFCS0*DIFCS1/(DIFCS0+DIFCS1) + DIFCQ=DIFCQ0*DIFCQ1/(DIFCQ0+DIFCQ1) + DIFOS=DIFOS0*DIFOS1/(DIFOS0+DIFOS1) + DIFNG=DIFNG0*DIFNG1/(DIFNG0+DIFNG1) + DIFN2=DIFN20*DIFN21/(DIFN20+DIFN21) + DIFHG=DIFHG0*DIFHG1/(DIFHG0+DIFHG1) +C +C DIFFUSIVE FLUXES BETWEEN CURRENT AND ADJACENT GRID CELL +C MICROPORES +C + DO 8805 K=0,2 + DFVOC(K)=DIFOC*(COQC1(K)-COQC2(K)) + DFVON(K)=DIFON*(COQN1(K)-COQN2(K)) + DFVOP(K)=DIFOP*(COQP1(K)-COQP2(K)) + DFVOA(K)=DIFOA*(COQA1(K)-COQA2(K)) +8805 CONTINUE + DFVCOS=DIFCS*(CCO2S1-CCO2S2) + DFVCHS=DIFCQ*(CCH4S1-CCH4S2) + DFVOXS=DIFOS*(COXYS1-COXYS2) + DFVNGS=DIFNG*(CZ2GS1-CZ2GS2) + DFVN2S=DIFN2*(CZ2OS1-CZ2OS2) + DFVHGS=DIFHG*(CH2GS1-CH2GS2) + DFVNH4=DIFNH*(CNH4S1-CNH4S2)*VLNH4(NU(NY,NX),NY,NX) + DFVNH3=DIFNH*(CNH3S1-CNH3S2)*VLNH4(NU(NY,NX),NY,NX) + DFVNO3=DIFNO*(CNO3S1-CNO3S2)*VLNO3(NU(NY,NX),NY,NX) + DFVNO2=DIFNO*(CNO2S1-CNO2S2)*VLNO3(NU(NY,NX),NY,NX) + DFVPO4=DIFPO*(CPO4S1-CPO4S2)*VLPO4(NU(NY,NX),NY,NX) + DFVN4B=DIFNH*(CNH4S1-CNH4B2)*VLNHB(NU(NY,NX),NY,NX) + DFVN3B=DIFNH*(CNH3S1-CNH3B2)*VLNHB(NU(NY,NX),NY,NX) + DFVNOB=DIFNO*(CNO3S1-CNO3B2)*VLNOB(NU(NY,NX),NY,NX) + DFVN2B=DIFNO*(CNO2S1-CNO2B2)*VLNOB(NU(NY,NX),NY,NX) + DFVPOB=DIFPO*(CPO4S1-CPO4B2)*VLPOB(NU(NY,NX),NY,NX) + ELSE + DO 8905 K=0,2 + DFVOC(K)=0.0 + DFVON(K)=0.0 + DFVOP(K)=0.0 + DFVOA(K)=0.0 +8905 CONTINUE + DFVCOS=0.0 + DFVCHS=0.0 + DFVOXS=0.0 + DFVNGS=0.0 + DFVN2S=0.0 + DFVHGS=0.0 + DFVNH4=0.0 + DFVNH3=0.0 + DFVNO3=0.0 + DFVNO2=0.0 + DFVPO4=0.0 + DFVN4B=0.0 + DFVN3B=0.0 + DFVNOB=0.0 + DFVN2B=0.0 + DFVPOB=0.0 + ENDIF +C +C TOTAL MICROPORE AND MACROPORE SOLUTE TRANSPORT FLUXES BETWEEN +C ADJACENT GRID CELLS = CONVECTIVE + DIFFUSIVE FLUXES +C + DO 9760 K=0,2 + ROCFLS(K,3,0,NY,NX)=ROCFL0(K,NY,NX)-RFLOC(K)-DFVOC(K) + RONFLS(K,3,0,NY,NX)=RONFL0(K,NY,NX)-RFLON(K)-DFVON(K) + ROPFLS(K,3,0,NY,NX)=ROPFL0(K,NY,NX)-RFLOP(K)-DFVOP(K) + ROAFLS(K,3,0,NY,NX)=ROAFL0(K,NY,NX)-RFLOA(K)-DFVOA(K) + ROCFLS(K,3,NU(NY,NX),NY,NX)=ROCFL1(K,NY,NX)+RFLOC(K)+DFVOC(K) + 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 + ROXFLS(3,0,NY,NX)=ROXFL0(NY,NX)-RFLOXS-DFVOXS + RNGFLS(3,0,NY,NX)=RNGFL0(NY,NX)-RFLNGS-DFVNGS + RN2FLS(3,0,NY,NX)=RN2FL0(NY,NX)-RFLN2S-DFVN2S + RHGFLS(3,0,NY,NX)=RHGFL0(NY,NX)-RFLHGS-DFVHGS + RN4FLW(3,0,NY,NX)=RN4FL0(NY,NX)-RFLNH4-DFVNH4-RFLN4B-DFVN4B + RN3FLW(3,0,NY,NX)=RN3FL0(NY,NX)-RFLNH3-DFVNH3-RFLN3B-DFVN3B + RNOFLW(3,0,NY,NX)=RNOFL0(NY,NX)-RFLNO3-DFVNO3-RFLNOB-DFVNOB + RNXFLS(3,0,NY,NX)=RNXFL0(NY,NX)-RFLNO2-DFVNO2-RFLN2B-DFVN2B + RH2PFS(3,0,NY,NX)=RH2PF0(NY,NX)-RFLPO4-DFVPO4-RFLPOB-DFVPOB + RCOFLS(3,NU(NY,NX),NY,NX)=RCOFL1(NY,NX)+RFLCOS+DFVCOS + RCHFLS(3,NU(NY,NX),NY,NX)=RCHFL1(NY,NX)+RFLCHS+DFVCHS + ROXFLS(3,NU(NY,NX),NY,NX)=ROXFL1(NY,NX)+RFLOXS+DFVOXS + RNGFLS(3,NU(NY,NX),NY,NX)=RNGFL1(NY,NX)+RFLNGS+DFVNGS + RN2FLS(3,NU(NY,NX),NY,NX)=RN2FL1(NY,NX)+RFLN2S+DFVN2S + RHGFLS(3,NU(NY,NX),NY,NX)=RHGFL1(NY,NX)+RFLHGS+DFVHGS + RN4FLW(3,NU(NY,NX),NY,NX)=RN4FL1(NY,NX)+RFLNH4+DFVNH4 + RN3FLW(3,NU(NY,NX),NY,NX)=RN3FL1(NY,NX)+RFLNH3+DFVNH3 + RNOFLW(3,NU(NY,NX),NY,NX)=RNOFL1(NY,NX)+RFLNO3+DFVNO3 + RNXFLS(3,NU(NY,NX),NY,NX)=RNXFL1(NY,NX)+RFLNO2+DFVNO2 + RH2PFS(3,NU(NY,NX),NY,NX)=RH2PF1(NY,NX)+RFLPO4+DFVPO4 + RN4FLB(3,NU(NY,NX),NY,NX)=RN4FL2(NY,NX)+RFLN4B+DFVN4B + RN3FLB(3,NU(NY,NX),NY,NX)=RN3FL2(NY,NX)+RFLN3B+DFVN3B + RNOFLB(3,NU(NY,NX),NY,NX)=RNOFL2(NY,NX)+RFLNOB+DFVNOB + RNXFLB(3,NU(NY,NX),NY,NX)=RNXFL2(NY,NX)+RFLN2B+DFVN2B + RH2BFB(3,NU(NY,NX),NY,NX)=RH2BF2(NY,NX)+RFLPOB+DFVPOB + 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 + XNGFLS(3,0,NY,NX)=XNGFLS(3,0,NY,NX)-RFLNGS-DFVNGS + XN2FLS(3,0,NY,NX)=XN2FLS(3,0,NY,NX)-RFLN2S-DFVN2S + XHGFLS(3,0,NY,NX)=XHGFLS(3,0,NY,NX)-RFLHGS-DFVHGS + XN4FLW(3,0,NY,NX)=XN4FLW(3,0,NY,NX)-RFLNH4-DFVNH4-RFLN4B-DFVN4B + XN3FLW(3,0,NY,NX)=XN3FLW(3,0,NY,NX)-RFLNH3-DFVNH3-RFLN3B-DFVN3B + XNOFLW(3,0,NY,NX)=XNOFLW(3,0,NY,NX)-RFLNO3-DFVNO3-RFLNOB-DFVNOB + XNXFLS(3,0,NY,NX)=XNXFLS(3,0,NY,NX)-RFLNO2-DFVNO2-RFLN2B-DFVN2B + XH2PFS(3,0,NY,NX)=XH2PFS(3,0,NY,NX)-RFLPO4-DFVPO4-RFLPOB-DFVPOB + XCOFLS(3,NU(NY,NX),NY,NX)=XCOFLS(3,NU(NY,NX),NY,NX)+RFLCOS+DFVCOS + XCHFLS(3,NU(NY,NX),NY,NX)=XCHFLS(3,NU(NY,NX),NY,NX)+RFLCHS+DFVCHS + XOXFLS(3,NU(NY,NX),NY,NX)=XOXFLS(3,NU(NY,NX),NY,NX)+RFLOXS+DFVOXS + XNGFLS(3,NU(NY,NX),NY,NX)=XNGFLS(3,NU(NY,NX),NY,NX)+RFLNGS+DFVNGS + XN2FLS(3,NU(NY,NX),NY,NX)=XN2FLS(3,NU(NY,NX),NY,NX)+RFLN2S+DFVN2S + XHGFLS(3,NU(NY,NX),NY,NX)=XHGFLS(3,NU(NY,NX),NY,NX)+RFLHGS+DFVHGS + XN4FLW(3,NU(NY,NX),NY,NX)=XN4FLW(3,NU(NY,NX),NY,NX)+RFLNH4+DFVNH4 + XN3FLW(3,NU(NY,NX),NY,NX)=XN3FLW(3,NU(NY,NX),NY,NX)+RFLNH3+DFVNH3 + XNOFLW(3,NU(NY,NX),NY,NX)=XNOFLW(3,NU(NY,NX),NY,NX)+RFLNO3+DFVNO3 + XNXFLS(3,NU(NY,NX),NY,NX)=XNXFLS(3,NU(NY,NX),NY,NX)+RFLNO2+DFVNO2 + XH2PFS(3,NU(NY,NX),NY,NX)=XH2PFS(3,NU(NY,NX),NY,NX)+RFLPO4+DFVPO4 + XN4FLB(3,NU(NY,NX),NY,NX)=XN4FLB(3,NU(NY,NX),NY,NX)+RFLN4B+DFVN4B + XN3FLB(3,NU(NY,NX),NY,NX)=XN3FLB(3,NU(NY,NX),NY,NX)+RFLN3B+DFVN3B + XNOFLB(3,NU(NY,NX),NY,NX)=XNOFLB(3,NU(NY,NX),NY,NX)+RFLNOB+DFVNOB + XNXFLB(3,NU(NY,NX),NY,NX)=XNXFLB(3,NU(NY,NX),NY,NX)+RFLN2B+DFVN2B + XH2BFB(3,NU(NY,NX),NY,NX)=XH2BFB(3,NU(NY,NX),NY,NX)+RFLPOB+DFVPOB +C IF(I.EQ.118.AND.NX.EQ.3.AND.NY.EQ.4)THEN +C WRITE(*,3434)'ROXFLS',I,J,NX,NY,M,MM,ROXFLS(3,0,NY,NX) +C 2,XOXFLS(3,0,NY,NX),ROXFL0(NY,NX),RFLOXS,DFVOXS +3434 FORMAT(A8,6I4,12E12.4) +C ENDIF +C +C MACROPORE-MICROPORE SOLUTE EXCHANGE IN SOIL +C SURFACE LAYER FROM WATER EXCHANGE IN 'WATSUB' AND +C FROM MACROPORE OR MICROPORE SOLUTE CONCENTRATIONS +C +C +C MACROPORE TO MICROPORE TRANSFER +C + IF(FINHM(M,NU(NY,NX),NY,NX).GT.0.0)THEN + IF(VOLWHM(M,NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN + VFLW=AMAX1(0.0,AMIN1(XFRX,FINHM(M,NU(NY,NX),NY,NX) + 2/VOLWHM(M,NU(NY,NX),NY,NX))) + ELSE + VFLW=XFRX + ENDIF + DO 9870 K=0,4 + RFLOC(K)=VFLW*AMAX1(0.0,OQCH2(K,NU(NY,NX),NY,NX)) + RFLON(K)=VFLW*AMAX1(0.0,OQNH2(K,NU(NY,NX),NY,NX)) + RFLOP(K)=VFLW*AMAX1(0.0,OQPH2(K,NU(NY,NX),NY,NX)) + RFLOA(K)=VFLW*AMAX1(0.0,OQAH2(K,NU(NY,NX),NY,NX)) +9870 CONTINUE + RFLCOS=VFLW*AMAX1(0.0,CO2SH2(NU(NY,NX),NY,NX)) + RFLCHS=VFLW*AMAX1(0.0,CH4SH2(NU(NY,NX),NY,NX)) + RFLOXS=VFLW*AMAX1(0.0,OXYSH2(NU(NY,NX),NY,NX)) + RFLNGS=VFLW*AMAX1(0.0,Z2GSH2(NU(NY,NX),NY,NX)) + RFLN2S=VFLW*AMAX1(0.0,Z2OSH2(NU(NY,NX),NY,NX)) + RFLHGS=VFLW*AMAX1(0.0,H2GSH2(NU(NY,NX),NY,NX)) + RFLNH4=VFLW*AMAX1(0.0,ZNH4H2(NU(NY,NX),NY,NX)) + 2*VLNH4(NU(NY,NX),NY,NX) + RFLNH3=VFLW*AMAX1(0.0,ZNH3H2(NU(NY,NX),NY,NX)) + 2*VLNH4(NU(NY,NX),NY,NX) + RFLNO3=VFLW*AMAX1(0.0,ZNO3H2(NU(NY,NX),NY,NX)) + 2*VLNO3(NU(NY,NX),NY,NX) + RFLNO2=VFLW*AMAX1(0.0,ZNO2H2(NU(NY,NX),NY,NX)) + 2*VLNO3(NU(NY,NX),NY,NX) + RFLPO4=VFLW*AMAX1(0.0,H2P4H2(NU(NY,NX),NY,NX)) + 2*VLPO4(NU(NY,NX),NY,NX) + RFLN4B=VFLW*AMAX1(0.0,ZN4BH2(NU(NY,NX),NY,NX)) + 2*VLNHB(NU(NY,NX),NY,NX) + RFLN3B=VFLW*AMAX1(0.0,ZN3BH2(NU(NY,NX),NY,NX)) + 2*VLNHB(NU(NY,NX),NY,NX) + RFLNOB=VFLW*AMAX1(0.0,ZNOBH2(NU(NY,NX),NY,NX)) + 2*VLNOB(NU(NY,NX),NY,NX) + RFLN2B=VFLW*AMAX1(0.0,ZN2BH2(NU(NY,NX),NY,NX)) + 2*VLNOB(NU(NY,NX),NY,NX) + RFLPOB=VFLW*AMAX1(0.0,H2PBH2(NU(NY,NX),NY,NX)) + 2*VLPOB(NU(NY,NX),NY,NX) +C +C MICROPORE TO MACROPORE TRANSFER +C + ELSEIF(FINHM(M,NU(NY,NX),NY,NX).LT.0.0)THEN + IF(VOLWM(M,NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN + VFLW=AMIN1(0.0,AMAX1(-XFRX,FINHM(M,NU(NY,NX),NY,NX) + 2/VOLWM(M,NU(NY,NX),NY,NX))) + ELSE + VFLW=-XFRX + ENDIF + DO 9865 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)) + RFLOA(K)=VFLW*AMAX1(0.0,OQA2(K,NU(NY,NX),NY,NX)) +9865 CONTINUE + RFLCOS=VFLW*AMAX1(0.0,CO2S2(NU(NY,NX),NY,NX)) + RFLCHS=VFLW*AMAX1(0.0,CH4S2(NU(NY,NX),NY,NX)) + RFLOXS=VFLW*AMAX1(0.0,OXYS2(NU(NY,NX),NY,NX)) + RFLNGS=VFLW*AMAX1(0.0,Z2GS2(NU(NY,NX),NY,NX)) + RFLN2S=VFLW*AMAX1(0.0,Z2OS2(NU(NY,NX),NY,NX)) + RFLHGS=VFLW*AMAX1(0.0,H2GS2(NU(NY,NX),NY,NX)) + RFLNH4=VFLW*AMAX1(0.0,ZNH4S2(NU(NY,NX),NY,NX)) + 2*VLNH4(NU(NY,NX),NY,NX) + RFLNH3=VFLW*AMAX1(0.0,ZN3S2(NU(NY,NX),NY,NX)) + 2*VLNH4(NU(NY,NX),NY,NX) + RFLNO3=VFLW*AMAX1(0.0,ZNO3S2(NU(NY,NX),NY,NX)) + 2*VLNO3(NU(NY,NX),NY,NX) + RFLNO2=VFLW*AMAX1(0.0,ZNO2S2(NU(NY,NX),NY,NX)) + 2*VLNO3(NU(NY,NX),NY,NX) + RFLPO4=VFLW*AMAX1(0.0,H2PO42(NU(NY,NX),NY,NX)) + 2*VLPO4(NU(NY,NX),NY,NX) + RFLN4B=VFLW*AMAX1(0.0,ZNH4B2(NU(NY,NX),NY,NX)) + 2*VLNHB(NU(NY,NX),NY,NX) + RFLN3B=VFLW*AMAX1(0.0,ZNBS2(NU(NY,NX),NY,NX)) + 2*VLNHB(NU(NY,NX),NY,NX) + RFLNOB=VFLW*AMAX1(0.0,ZNO3B2(NU(NY,NX),NY,NX)) + 2*VLNOB(NU(NY,NX),NY,NX) + RFLN2B=VFLW*AMAX1(0.0,ZNO2B2(NU(NY,NX),NY,NX)) + 2*VLNOB(NU(NY,NX),NY,NX) + RFLPOB=VFLW*AMAX1(0.0,H2POB2(NU(NY,NX),NY,NX)) + 2*VLPOB(NU(NY,NX),NY,NX) +C +C NO MACROPORE TO MICROPORE TRANSFER +C + ELSE + DO 9860 K=0,4 + RFLOC(K)=0.0 + RFLON(K)=0.0 + RFLOP(K)=0.0 + RFLOA(K)=0.0 +9860 CONTINUE + RFLCOS=0.0 + RFLCHS=0.0 + RFLOXS=0.0 + RFLNGS=0.0 + RFLN2S=0.0 + RFLHGS=0.0 + RFLNH4=0.0 + RFLNH3=0.0 + RFLNO3=0.0 + RFLNO2=0.0 + RFLPO4=0.0 + RFLN4B=0.0 + RFLN3B=0.0 + RFLNOB=0.0 + RFLN2B=0.0 + RFLPOB=0.0 + ENDIF +C +C DIFFUSIVE FLUXES OF SOLUTES BETWEEN MICROPORES AND +C MACROPORES FROM AQUEOUS DIFFUSIVITIES AND CONCENTRATION DIFFERENCES +C +C +C DIFFUSIVE FLUXES OF SOLUTES BETWEEN MICROPORES AND +C MACROPORES FROM AQUEOUS DIFFUSIVITIES AND CONCENTRATION DIFFERENCES +C + IF(VOLWHM(M,NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN + 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 + DFVOC(K)=XNPX*(OQCH2(K,NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) + 2-OQC2(K,NU(NY,NX),NY,NX)*VOLWHS)/VOLWT + DFVON(K)=XNPX*(OQNH2(K,NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) + 2-OQN2(K,NU(NY,NX),NY,NX)*VOLWHS)/VOLWT + DFVOP(K)=XNPX*(OQPH2(K,NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) + 2-OQP2(K,NU(NY,NX),NY,NX)*VOLWHS)/VOLWT + DFVOA(K)=XNPX*(OQAH2(K,NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) + 2-OQA2(K,NU(NY,NX),NY,NX)*VOLWHS)/VOLWT +8835 CONTINUE + DFVCOS=XNPX*(CO2SH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) + 2-CO2S2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT + DFVCHS=XNPX*(CH4SH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) + 2-CH4S2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT + DFVOXS=XNPX*(OXYSH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) + 2-OXYS2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT + DFVNGS=XNPX*(Z2GSH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) + 2-Z2GS2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT + DFVN2S=XNPX*(Z2OSH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) + 2-Z2OS2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT + DFVHGS=XNPX*(H2GSH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) + 2-H2GS2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT + DFVNH4=XNPX*(ZNH4H2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) + 2-ZNH4S2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT + 3*VLNH4(NU(NY,NX),NY,NX) + DFVNH3=XNPX*(ZNH3H2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) + 2-ZN3S2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT + 3*VLNH4(NU(NY,NX),NY,NX) + DFVNO3=XNPX*(ZNO3H2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) + 2-ZNO3S2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT + 3*VLNO3(NU(NY,NX),NY,NX) + DFVNO2=XNPX*(ZNO2H2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) + 2-ZNO2S2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT + 3*VLNO3(NU(NY,NX),NY,NX) + DFVPO4=XNPX*(H2P4H2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) + 2-H2PO42(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT + 3*VLPO4(NU(NY,NX),NY,NX) + DFVN4B=XNPX*(ZN4BH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) + 2-ZNH4B2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT + 3*VLNHB(NU(NY,NX),NY,NX) + DFVN3B=XNPX*(ZN3BH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) + 2-ZNBS2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT + 3*VLNHB(NU(NY,NX),NY,NX) + DFVNOB=XNPX*(ZNOBH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) + 2-ZNO3B2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT + 3*VLNOB(NU(NY,NX),NY,NX) + DFVN2B=XNPX*(ZN2BH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) + 2-ZNO2B2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT + 3*VLNOB(NU(NY,NX),NY,NX) + DFVPOB=XNPX*(H2PBH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) + 2-H2POB2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT + 3*VLPOB(NU(NY,NX),NY,NX) + ELSE + DO 8935 K=0,2 + DFVOC(K)=0.0 + DFVON(K)=0.0 + DFVOP(K)=0.0 + DFVOA(K)=0.0 +8935 CONTINUE + DFVCOS=0.0 + DFVCHS=0.0 + DFVOXS=0.0 + DFVNGS=0.0 + DFVN2S=0.0 + DFVHGS=0.0 + DFVNH4=0.0 + DFVNH3=0.0 + DFVNO3=0.0 + DFVNO2=0.0 + DFVPO4=0.0 + DFVN4B=0.0 + DFVN3B=0.0 + DFVNOB=0.0 + DFVN2B=0.0 + DFVPOB=0.0 + ENDIF +C +C TOTAL CONVECTIVE +DIFFUSIVE TRANSFER BETWEEN MACROPOES AND MICROPORES +C + DO 9940 K=0,4 + ROCFXS(K,NU(NY,NX),NY,NX)=RFLOC(K)+DFVOC(K) + 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 + ROXFXS(NU(NY,NX),NY,NX)=RFLOXS+DFVOXS + RNGFXS(NU(NY,NX),NY,NX)=RFLNGS+DFVNGS + RN2FXS(NU(NY,NX),NY,NX)=RFLN2S+DFVN2S + RHGFXS(NU(NY,NX),NY,NX)=RFLHGS+DFVHGS + RN4FXW(NU(NY,NX),NY,NX)=RFLNH4+DFVNH4 + RN3FXW(NU(NY,NX),NY,NX)=RFLNH3+DFVNH3 + RNOFXW(NU(NY,NX),NY,NX)=RFLNO3+DFVNO3 + RNXFXS(NU(NY,NX),NY,NX)=RFLNO2+DFVNO2 + RH2PXS(NU(NY,NX),NY,NX)=RFLPO4+DFVPO4 + RN4FXB(NU(NY,NX),NY,NX)=RFLN4B+DFVN4B + RN3FXB(NU(NY,NX),NY,NX)=RFLN3B+DFVN3B + RNOFXB(NU(NY,NX),NY,NX)=RFLNOB+DFVNOB + RNXFXB(NU(NY,NX),NY,NX)=RFLN2B+DFVN2B + RH2BXB(NU(NY,NX),NY,NX)=RFLPOB+DFVPOB +C +C ACCUMULATE HOURLY FLUXES +C + DO 9935 K=0,4 + 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) +9935 CONTINUE + XCOFXS(NU(NY,NX),NY,NX)=XCOFXS(NU(NY,NX),NY,NX) + 2+RCOFXS(NU(NY,NX),NY,NX) + XCHFXS(NU(NY,NX),NY,NX)=XCHFXS(NU(NY,NX),NY,NX) + 2+RCHFXS(NU(NY,NX),NY,NX) + XOXFXS(NU(NY,NX),NY,NX)=XOXFXS(NU(NY,NX),NY,NX) + 2+ROXFXS(NU(NY,NX),NY,NX) + XNGFXS(NU(NY,NX),NY,NX)=XNGFXS(NU(NY,NX),NY,NX) + 2+RNGFXS(NU(NY,NX),NY,NX) + XN2FXS(NU(NY,NX),NY,NX)=XN2FXS(NU(NY,NX),NY,NX) + 2+RN2FXS(NU(NY,NX),NY,NX) + XHGFXS(NU(NY,NX),NY,NX)=XHGFXS(NU(NY,NX),NY,NX) + 2+RHGFXS(NU(NY,NX),NY,NX) + XN4FXW(NU(NY,NX),NY,NX)=XN4FXW(NU(NY,NX),NY,NX) + 2+RN4FXW(NU(NY,NX),NY,NX) + XN3FXW(NU(NY,NX),NY,NX)=XN3FXW(NU(NY,NX),NY,NX) + 2+RN3FXW(NU(NY,NX),NY,NX) + XNOFXW(NU(NY,NX),NY,NX)=XNOFXW(NU(NY,NX),NY,NX) + 2+RNOFXW(NU(NY,NX),NY,NX) + XNXFXS(NU(NY,NX),NY,NX)=XNXFXS(NU(NY,NX),NY,NX) + 2+RNXFXS(NU(NY,NX),NY,NX) + XH2PXS(NU(NY,NX),NY,NX)=XH2PXS(NU(NY,NX),NY,NX) + 2+RH2PXS(NU(NY,NX),NY,NX) + XN4FXB(NU(NY,NX),NY,NX)=XN4FXB(NU(NY,NX),NY,NX) + 2+RN4FXB(NU(NY,NX),NY,NX) + XN3FXB(NU(NY,NX),NY,NX)=XN3FXB(NU(NY,NX),NY,NX) + 2+RN3FXB(NU(NY,NX),NY,NX) + XNOFXB(NU(NY,NX),NY,NX)=XNOFXB(NU(NY,NX),NY,NX) + 2+RNOFXB(NU(NY,NX),NY,NX) + XNXFXB(NU(NY,NX),NY,NX)=XNXFXB(NU(NY,NX),NY,NX) + 2+RNXFXB(NU(NY,NX),NY,NX) + XH2BXB(NU(NY,NX),NY,NX)=XH2BXB(NU(NY,NX),NY,NX) + 2+RH2BXB(NU(NY,NX),NY,NX) +C +C SOLUTE TRANSPORT FROM WATER OVERLAND FLOW +C IN 'WATSUB' AND FROM SOLUTE CONCENTRATIONS +C IN SOIL SURFACE LAYER +C + N1=NX + N2=NY +C +C LOCATE INTERNAL BOUNDARIES BETWEEN ADJACENT GRID CELLS +C + DO 4310 N=1,2 + IF(N.EQ.1)THEN + IF(NX.EQ.NHE)THEN + GO TO 4310 + ELSE + N4=NX+1 + N5=NY + ENDIF + ELSEIF(N.EQ.2)THEN + IF(NY.EQ.NVS)THEN + GO TO 4310 + ELSE + N4=NX + N5=NY+1 + ENDIF + ENDIF +C +C IF NO OVERLAND FLOW THEN NO TRANSPORT +C + IF(QRM(M,N,N5,N4).EQ.0.0)THEN + DO 9840 K=0,2 + RQROC(K,N,N5,N4)=0.0 + RQRON(K,N,N5,N4)=0.0 + RQROP(K,N,N5,N4)=0.0 + RQROA(K,N,N5,N4)=0.0 +9840 CONTINUE + RQRCOS(N,N5,N4)=0.0 + RQRCHS(N,N5,N4)=0.0 + RQROXS(N,N5,N4)=0.0 + RQRNGS(N,N5,N4)=0.0 + RQRN2S(N,N5,N4)=0.0 + RQRHGS(N,N5,N4)=0.0 + RQRNH4(N,N5,N4)=0.0 + RQRNH3(N,N5,N4)=0.0 + RQRNO3(N,N5,N4)=0.0 + RQRNO2(N,N5,N4)=0.0 + RQRH2P(N,N5,N4)=0.0 +C +C IF OVERLAND FLOW IS FROM CURRENT TO ADJACENT GRID CELL +C + ELSEIF(QRM(M,N,N5,N4).GT.0.0)THEN + IF(VOLWM(M,0,N2,N1).GT.ZEROS(N2,N1))THEN + VFLW=AMAX1(0.0,AMIN1(XFRX,QRM(M,N,N5,N4)/VOLWM(M,0,N2,N1))) + ELSE + VFLW=XFRX + ENDIF + DO 9835 K=0,2 + 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)) + RQROA(K,N,N5,N4)=VFLW*AMAX1(0.0,OQA2(K,0,N2,N1)) +9835 CONTINUE + RQRCOS(N,N5,N4)=VFLW*AMAX1(0.0,CO2S2(0,N2,N1)) + RQRCHS(N,N5,N4)=VFLW*AMAX1(0.0,CH4S2(0,N2,N1)) + RQROXS(N,N5,N4)=VFLW*AMAX1(0.0,OXYS2(0,N2,N1)) + RQRNGS(N,N5,N4)=VFLW*AMAX1(0.0,Z2GS2(0,N2,N1)) + RQRN2S(N,N5,N4)=VFLW*AMAX1(0.0,Z2OS2(0,N2,N1)) + RQRHGS(N,N5,N4)=VFLW*AMAX1(0.0,H2GS2(0,N2,N1)) + RQRNH4(N,N5,N4)=VFLW*AMAX1(0.0,ZNH4S2(0,N2,N1)) + RQRNH3(N,N5,N4)=VFLW*AMAX1(0.0,ZN3S2(0,N2,N1)) + RQRNO3(N,N5,N4)=VFLW*AMAX1(0.0,ZNO3S2(0,N2,N1)) + RQRNO2(N,N5,N4)=VFLW*AMAX1(0.0,ZNO2S2(0,N2,N1)) + RQRH2P(N,N5,N4)=VFLW*AMAX1(0.0,H2PO42(0,N2,N1)) +C +C IF OVERLAND FLOW IS TO CURRENT FROM ADJACENT GRID CELL +C + ELSEIF(QRM(M,N,N5,N4).LT.0.0)THEN + IF(VOLWM(M,0,N5,N4).GT.ZEROS(N5,N4))THEN + VFLW=AMIN1(0.0,AMAX1(-XFRX,QRM(M,N,N5,N4)/VOLWM(M,0,N5,N4))) + ELSE + VFLW=-XFRX + ENDIF + DO 9830 K=0,2 + 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)) + RQROA(K,N,N5,N4)=VFLW*AMAX1(0.0,OQA2(K,0,N5,N4)) +9830 CONTINUE + RQRCOS(N,N5,N4)=VFLW*AMAX1(0.0,CO2S2(0,N5,N4)) + RQRCHS(N,N5,N4)=VFLW*AMAX1(0.0,CH4S2(0,N5,N4)) + RQROXS(N,N5,N4)=VFLW*AMAX1(0.0,OXYS2(0,N5,N4)) + RQRNGS(N,N5,N4)=VFLW*AMAX1(0.0,Z2GS2(0,N5,N4)) + RQRN2S(N,N5,N4)=VFLW*AMAX1(0.0,Z2OS2(0,N5,N4)) + RQRHGS(N,N5,N4)=VFLW*AMAX1(0.0,H2GS2(0,N5,N4)) + RQRNH4(N,N5,N4)=VFLW*AMAX1(0.0,ZNH4S2(0,N5,N4)) + RQRNH3(N,N5,N4)=VFLW*AMAX1(0.0,ZN3S2(0,N5,N4)) + RQRNO3(N,N5,N4)=VFLW*AMAX1(0.0,ZNO3S2(0,N5,N4)) + RQRNO2(N,N5,N4)=VFLW*AMAX1(0.0,ZNO2S2(0,N5,N4)) + RQRH2P(N,N5,N4)=VFLW*AMAX1(0.0,H2PO42(0,N5,N4)) + ENDIF +C +C ACCUMULATE HOURLY FLUXES +C + DO 9825 K=0,2 + 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) + XOAQRS(K,N,N5,N4)=XOAQRS(K,N,N5,N4)+RQROA(K,N,N5,N4) +9825 CONTINUE + XCOQRS(N,N5,N4)=XCOQRS(N,N5,N4)+RQRCOS(N,N5,N4) + XCHQRS(N,N5,N4)=XCHQRS(N,N5,N4)+RQRCHS(N,N5,N4) + XOXQRS(N,N5,N4)=XOXQRS(N,N5,N4)+RQROXS(N,N5,N4) + XNGQRS(N,N5,N4)=XNGQRS(N,N5,N4)+RQRNGS(N,N5,N4) + XN2QRS(N,N5,N4)=XN2QRS(N,N5,N4)+RQRN2S(N,N5,N4) + XHGQRS(N,N5,N4)=XHGQRS(N,N5,N4)+RQRHGS(N,N5,N4) + XN4QRW(N,N5,N4)=XN4QRW(N,N5,N4)+RQRNH4(N,N5,N4) + XN3QRW(N,N5,N4)=XN3QRW(N,N5,N4)+RQRNH3(N,N5,N4) + XNOQRW(N,N5,N4)=XNOQRW(N,N5,N4)+RQRNO3(N,N5,N4) + XNXQRS(N,N5,N4)=XNXQRS(N,N5,N4)+RQRNO2(N,N5,N4) + XP4QRW(N,N5,N4)=XP4QRW(N,N5,N4)+RQRH2P(N,N5,N4) +C +C IF NO SNOW DRIFT THEN NO TRANSPORT +C + IF(QSM(M,N,N5,N4).EQ.0.0)THEN + RQSCOS(N,N5,N4)=0.0 + RQSCHS(N,N5,N4)=0.0 + RQSOXS(N,N5,N4)=0.0 + RQSNGS(N,N5,N4)=0.0 + RQSN2S(N,N5,N4)=0.0 + RQSNH4(N,N5,N4)=0.0 + RQSNH3(N,N5,N4)=0.0 + RQSNO3(N,N5,N4)=0.0 + RQSH2P(N,N5,N4)=0.0 +C +C IF DRIFT IS FROM CURRENT TO ADJACENT GRID CELL +C + ELSEIF(QSM(M,N,N5,N4).GT.0.0)THEN + IF(VOLS(N2,N1).GT.ZEROS(N2,N1))THEN + VFLW=AMAX1(0.0,AMIN1(XFRX,QSM(M,N,N5,N4)/VOLS(N2,N1))) + ELSE + VFLW=XFRX + ENDIF + RQSCOS(N,N5,N4)=VFLW*AMAX1(0.0,CO2W2(N2,N1)) + RQSCHS(N,N5,N4)=VFLW*AMAX1(0.0,CH4W2(N2,N1)) + RQSOXS(N,N5,N4)=VFLW*AMAX1(0.0,OXYW2(N2,N1)) + RQSNGS(N,N5,N4)=VFLW*AMAX1(0.0,ZNGW2(N2,N1)) + RQSN2S(N,N5,N4)=VFLW*AMAX1(0.0,ZN2W2(N2,N1)) + RQSNH4(N,N5,N4)=VFLW*AMAX1(0.0,ZN4W2(N2,N1)) + RQSNH3(N,N5,N4)=VFLW*AMAX1(0.0,ZN3W2(N2,N1)) + RQSNO3(N,N5,N4)=VFLW*AMAX1(0.0,ZNOW2(N2,N1)) + RQSH2P(N,N5,N4)=VFLW*AMAX1(0.0,ZHPW2(N2,N1)) +C +C IF DRIFT IS TO CURRENT FROM ADJACENT GRID CELL +C + ELSEIF(QSM(M,N,N5,N4).LT.0.0)THEN + IF(VOLS(N5,N4).GT.ZEROS(N5,N4))THEN + VFLW=AMIN1(0.0,AMAX1(-XFRX,QSM(M,N,N5,N4)/VOLS(N5,N4))) + ELSE + VFLW=-XFRX + ENDIF + RQSCOS(N,N5,N4)=VFLW*AMAX1(0.0,CO2W2(N5,N4)) + RQSCHS(N,N5,N4)=VFLW*AMAX1(0.0,CH4W2(N5,N4)) + RQSOXS(N,N5,N4)=VFLW*AMAX1(0.0,OXYW2(N5,N4)) + RQSNGS(N,N5,N4)=VFLW*AMAX1(0.0,ZNGW2(N5,N4)) + RQSN2S(N,N5,N4)=VFLW*AMAX1(0.0,ZN2W2(N5,N4)) + RQSNH4(N,N5,N4)=VFLW*AMAX1(0.0,ZN4W2(N5,N4)) + RQSNH3(N,N5,N4)=VFLW*AMAX1(0.0,ZN3W2(N5,N4)) + RQSNO3(N,N5,N4)=VFLW*AMAX1(0.0,ZNOW2(N5,N4)) + RQSH2P(N,N5,N4)=VFLW*AMAX1(0.0,ZHPW2(N5,N4)) + ENDIF +C +C ACCUMULATE HOURLY FLUXES +C + XCOQSS(N,N5,N4)=XCOQSS(N,N5,N4)+RQSCOS(N,N5,N4) + XCHQSS(N,N5,N4)=XCHQSS(N,N5,N4)+RQSCHS(N,N5,N4) + XOXQSS(N,N5,N4)=XOXQSS(N,N5,N4)+RQSOXS(N,N5,N4) + XNGQSS(N,N5,N4)=XNGQSS(N,N5,N4)+RQSNGS(N,N5,N4) + XN2QSS(N,N5,N4)=XN2QSS(N,N5,N4)+RQSN2S(N,N5,N4) + XN4QSS(N,N5,N4)=XN4QSS(N,N5,N4)+RQSNH4(N,N5,N4) + XN3QSS(N,N5,N4)=XN3QSS(N,N5,N4)+RQSNH3(N,N5,N4) + XNOQSS(N,N5,N4)=XNOQSS(N,N5,N4)+RQSNO3(N,N5,N4) + XP4QSS(N,N5,N4)=XP4QSS(N,N5,N4)+RQSH2P(N,N5,N4) +C IF(I.EQ.118.AND.NX.EQ.3.AND.NY.EQ.4)THEN +C WRITE(*,6969)'XOXQSS',I,J,N4,N5,N,M,MM,XOXQSS(N,N5,N4) +C 2,RQSOXS(N,N5,N4),VFLW,OXYW2(N2,N1),OXYW2(N5,N4) +C 3,QSM(M,N,N5,N4),VOLS(N2,N1),VOLS(N5,N4) +6969 FORMAT(A8,7I4,20E12.4) +C ENDIF +4310 CONTINUE + ENDIF +C +C VOLATILIZATION-DISSOLUTION OF GASES IN RESIDUE AND SOIL SURFACE +C LAYERS FROM GASEOUS CONCENTRATIONS VS. THEIR AQUEOUS +C EQUIVALENTS DEPENDING ON SOLUBILITY FROM 'HOUR1' +C AND TRANSFER COEFFICIENT 'DFGS' FROM 'WATSUB' +C + IF(VOLWM(M,0,NY,NX).GT.ZEROS(NY,NX))THEN + CO2G0=CCO2G(0,NY,NX)*VOLPM(M,0,NY,NX) + CH4G0=CCH4G(0,NY,NX)*VOLPM(M,0,NY,NX) + OXYG0=COXYG(0,NY,NX)*VOLPM(M,0,NY,NX) + Z2GG0=CZ2GG(0,NY,NX)*VOLPM(M,0,NY,NX) + Z2OG0=CZ2OG(0,NY,NX)*VOLPM(M,0,NY,NX) + ZN3G0=CNH3G(0,NY,NX)*VOLPM(M,0,NY,NX) + H2GG0=CH2GG(0,NY,NX)*VOLPM(M,0,NY,NX) + VOLCOR(NY,NX)=VOLWCO(0,NY,NX)+VOLPM(M,0,NY,NX) + VOLCHR(NY,NX)=VOLWCH(0,NY,NX)+VOLPM(M,0,NY,NX) + VOLOXR(NY,NX)=VOLWOX(0,NY,NX)+VOLPM(M,0,NY,NX) + VOLNGR(NY,NX)=VOLWNG(0,NY,NX)+VOLPM(M,0,NY,NX) + VOLN2R(NY,NX)=VOLWN2(0,NY,NX)+VOLPM(M,0,NY,NX) + VOLN3R(NY,NX)=VOLWN3(0,NY,NX)+VOLPM(M,0,NY,NX) + VOLHGR(NY,NX)=VOLWHG(0,NY,NX)+VOLPM(M,0,NY,NX) + RCODFG(0,NY,NX)=DFGS(M,0,NY,NX) + 2*(AMAX1(ZEROS(NY,NX),CO2G0)*VOLWCO(0,NY,NX) + 3-AMAX1(ZEROS(NY,NX),CO2S2(0,NY,NX)+RCODXR) + 4*VOLPM(M,0,NY,NX))/VOLCOR(NY,NX) + RCHDFG(0,NY,NX)=DFGS(M,0,NY,NX) + 2*(AMAX1(ZEROS(NY,NX),CH4G0)*VOLWCH(0,NY,NX) + 3-AMAX1(ZEROS(NY,NX),CH4S2(0,NY,NX)+RCHDXR) + 4*VOLPM(M,0,NY,NX))/VOLCHR(NY,NX) + ROXDFG(0,NY,NX)=DFGS(M,0,NY,NX) + 2*(AMAX1(ZEROS(NY,NX),OXYG0)*VOLWOX(0,NY,NX) + 3-AMAX1(ZEROS(NY,NX),OXYS2(0,NY,NX)+ROXDXR) + 4*VOLPM(M,0,NY,NX))/VOLOXR(NY,NX) + RNGDFG(0,NY,NX)=DFGS(M,0,NY,NX) + 2*(AMAX1(ZEROS(NY,NX),Z2GG0)*VOLWNG(0,NY,NX) + 3-AMAX1(ZEROS(NY,NX),Z2GS2(0,NY,NX)+RNGDXR) + 4*VOLPM(M,0,NY,NX))/VOLNGR(NY,NX) + RN2DFG(0,NY,NX)=DFGS(M,0,NY,NX) + 2*(AMAX1(ZEROS(NY,NX),Z2OG0)*VOLWN2(0,NY,NX) + 3-AMAX1(ZEROS(NY,NX),Z2OS2(0,NY,NX)+RN2DXR) + 4*VOLPM(M,0,NY,NX))/VOLN2R(NY,NX) + RN3DFG(0,NY,NX)=DFGS(M,0,NY,NX) + 2*(AMAX1(ZEROS(NY,NX),ZN3G0)*VOLWN3(0,NY,NX) + 3-AMAX1(ZEROS(NY,NX),ZN3S2(0,NY,NX)+RN3DXR) + 4*VOLPM(M,0,NY,NX))/VOLN3R(NY,NX) + CNH3S0=AMAX1(0.0,(ZN3S2(0,NY,NX)+RN3DFG(0,NY,NX))) + 2/VOLWXA(0,NY,NX) + CNH4S0=AMAX1(0.0,ZNH4S2(0,NY,NX)) + 2/VOLWXA(0,NY,NX) + RN34SQ(0,NY,NX)=VOLWXA(0,NY,NX) + 2*(CHY0(0,NY,NX)*CNH3S0-DPN4*CNH4S0)/(DPN4+CHY0(0,NY,NX)) + RHGDFG(0,NY,NX)=DFGS(M,0,NY,NX) + 2*(AMAX1(ZEROS(NY,NX),H2GG0)*VOLWHG(0,NY,NX) + 3-AMAX1(ZEROS(NY,NX),H2GS2(0,NY,NX)+RHGDXR) + 4*VOLPM(M,0,NY,NX))/VOLHGR(NY,NX) +C +C ACCUMULATE HOURLY FLUXES +C + XCODFG(0,NY,NX)=XCODFG(0,NY,NX)+RCODFG(0,NY,NX) + XCHDFG(0,NY,NX)=XCHDFG(0,NY,NX)+RCHDFG(0,NY,NX) + XOXDFG(0,NY,NX)=XOXDFG(0,NY,NX)+ROXDFG(0,NY,NX) + XNGDFG(0,NY,NX)=XNGDFG(0,NY,NX)+RNGDFG(0,NY,NX) + XN2DFG(0,NY,NX)=XN2DFG(0,NY,NX)+RN2DFG(0,NY,NX) + XN3DFG(0,NY,NX)=XN3DFG(0,NY,NX)+RN3DFG(0,NY,NX) + XN34SQ(0,NY,NX)=XN34SQ(0,NY,NX)+RN34SQ(0,NY,NX) + XHGDFG(0,NY,NX)=XHGDFG(0,NY,NX)+RHGDFG(0,NY,NX) +C IF(J.EQ.24)THEN +C WRITE(*,323)'RCHDFG',I,J,NX,NY,M,MM,RCHDFG(0,NY,NX) +C 2,DFGS(M,0,NY,NX),CH4G0,VOLWCH(0,NY,NX),CH4S2(0,NY,NX) +C 3,VOLPM(M,0,NY,NX),VOLCHR(NY,NX),RCHDXR +C WRITE(*,323)'ROXDFG',I,J,NX,NY,M,MM,ROXDFG(0,NY,NX) +C 2,DFGS(M,0,NY,NX),OXYG0,VOLWOX(0,NY,NX),OXYS2(0,NY,NX) +C 3,VOLPM(M,0,NY,NX),VOLOXR(NY,NX),ROXDXR,XOXDFG(0,NY,NX) +323 FORMAT(A8,6I4,30E12.4) +C ENDIF + ELSE + RCODFG(0,NY,NX)=0.0 + RCHDFG(0,NY,NX)=0.0 + ROXDFG(0,NY,NX)=0.0 + RNGDFG(0,NY,NX)=0.0 + RN2DFG(0,NY,NX)=0.0 + RN3DFG(0,NY,NX)=0.0 + RN34SQ(0,NY,NX)=0.0 + RHGDFG(0,NY,NX)=0.0 + ENDIF +C +C SURFACE GAS EXCHANGE FROM GAS DIFFUSIVITY THROUGH +C SOIL SURFACE LAYER AND THROUGH ATMOSPHERE BOUNDARY +C LAYER +C + IF(THETPM(M,NU(NY,NX),NY,NX).GT.THETX + 2.AND.BKDS(NU(NY,NX),NY,NX).GT.0.0)THEN +C +C GASEOUS DIFFUSIVITIES +C + DFLG2=AMAX1(0.0,THETPM(M,NU(NY,NX),NY,NX))**2 + 2/POROQ(NU(NY,NX),NY,NX)*AREA(3,NU(NY,NX),NY,NX) + 3/AMAX1(0.001,DLYR(3,NU(NY,NX),NY,NX)) + DCO2G(3,NU(NY,NX),NY,NX)=DFLG2*CGSGL2(NU(NY,NX),NY,NX) + DCH4G(3,NU(NY,NX),NY,NX)=DFLG2*CHSGL2(NU(NY,NX),NY,NX) + DOXYG(3,NU(NY,NX),NY,NX)=DFLG2*OGSGL2(NU(NY,NX),NY,NX) + DZ2GG(3,NU(NY,NX),NY,NX)=DFLG2*ZGSGL2(NU(NY,NX),NY,NX) + DZ2OG(3,NU(NY,NX),NY,NX)=DFLG2*Z2SGL2(NU(NY,NX),NY,NX) + DNH3G(3,NU(NY,NX),NY,NX)=DFLG2*ZHSGL2(NU(NY,NX),NY,NX) + DH2GG(3,NU(NY,NX),NY,NX)=DFLG2*HGSGL2(NU(NY,NX),NY,NX) +C +C SURFACE GAS CONCENTRATIONS +C + CCO2G2=AMAX1(0.0,CO2G2(NU(NY,NX),NY,NX) + 2/VOLPM(M,NU(NY,NX),NY,NX)) + CCH4G2=AMAX1(0.0,CH4G2(NU(NY,NX),NY,NX) + 2/VOLPM(M,NU(NY,NX),NY,NX)) + COXYG2=AMAX1(0.0,OXYG2(NU(NY,NX),NY,NX) + 2/VOLPM(M,NU(NY,NX),NY,NX)) + CZ2GG2=AMAX1(0.0,Z2GG2(NU(NY,NX),NY,NX) + 2/VOLPM(M,NU(NY,NX),NY,NX)) + CZ2OG2=AMAX1(0.0,Z2OG2(NU(NY,NX),NY,NX) + 2/VOLPM(M,NU(NY,NX),NY,NX)) + CNH3G2=AMAX1(0.0,ZN3G2(NU(NY,NX),NY,NX) + 2/VOLPM(M,NU(NY,NX),NY,NX)) + CH2GG2=AMAX1(0.0,H2GG2(NU(NY,NX),NY,NX) + 2/VOLPM(M,NU(NY,NX),NY,NX)) +C +C EQUILIBRIUM CONCENTRATIONS AT SOIL SURFACE AT WHICH +C GASEOUS DIFFUSION THROUGH SOIL SURFACE LAYER = GASEOUS +C DIFFUSION THROUGH ATMOSPHERE BOUNDARY LAYER CALCULATED +C FROM GASEOUS DIFFUSIVITY AND BOUNDARY LAYER CONDUCTANCE +C + DCO2GQ=DCO2G(3,NU(NY,NX),NY,NX)*PARGCO(NY,NX) + 2/(DCO2G(3,NU(NY,NX),NY,NX)+PARGCO(NY,NX)) + DCH4GQ=DCH4G(3,NU(NY,NX),NY,NX)*PARGCH(NY,NX) + 2/(DCH4G(3,NU(NY,NX),NY,NX)+PARGCH(NY,NX)) + DOXYGQ=DOXYG(3,NU(NY,NX),NY,NX)*PARGOX(NY,NX) + 2/(DOXYG(3,NU(NY,NX),NY,NX)+PARGOX(NY,NX)) + DZ2GGQ=DZ2GG(3,NU(NY,NX),NY,NX)*PARGNG(NY,NX) + 2/(DZ2GG(3,NU(NY,NX),NY,NX)+PARGNG(NY,NX)) + DZ2OGQ=DZ2OG(3,NU(NY,NX),NY,NX)*PARGN2(NY,NX) + 2/(DZ2OG(3,NU(NY,NX),NY,NX)+PARGN2(NY,NX)) + DNH3GQ=DNH3G(3,NU(NY,NX),NY,NX)*PARGN3(NY,NX) + 2/(DNH3G(3,NU(NY,NX),NY,NX)+PARGN3(NY,NX)) + DH2GGQ=DH2GG(3,NU(NY,NX),NY,NX)*PARGH2(NY,NX) + 2/(DH2GG(3,NU(NY,NX),NY,NX)+PARGH2(NY,NX)) + DFVCOG=DCO2GQ*(CCO2E(NY,NX)-CCO2G2) + DFVCHG=DCH4GQ*(CCH4E(NY,NX)-CCH4G2) + DFVOXG=DOXYGQ*(COXYE(NY,NX)-COXYG2) + DFVNGG=DZ2GGQ*(CZ2GE(NY,NX)-CZ2GG2) + DFVN2G=DZ2OGQ*(CZ2OE(NY,NX)-CZ2OG2) + DFVN3G=DNH3GQ*(CNH3E(NY,NX)-CNH3G2) + DFVHGG=DH2GGQ*(CH2GE(NY,NX)-CH2GG2) +C +C CONVECTIVE GAS TRANSFER DRIVEN BY SURFACE WATER FLUXES +C FROM 'WATSUB' AND GAS CONCENTRATIONS IN THE SOIL SURFACE +C OR THE ATMOSPHERE DEPENDING ON WATER FLUX DIRECTION +C + IF(FLQM(3,NU(NY,NX),NY,NX).GT.0.0)THEN + IF(VOLPM(M,NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN + VFLW=-AMAX1(0.0,AMIN1(XFRX,FLQM(3,NU(NY,NX),NY,NX) + 2/VOLPM(M,NU(NY,NX),NY,NX))) + ELSE + VFLW=-XFRX + ENDIF + RFLCOG=VFLW*AMAX1(0.0,CO2G2(NU(NY,NX),NY,NX)) + RFLCHG=VFLW*AMAX1(0.0,CH4G2(NU(NY,NX),NY,NX)) + RFLOXG=VFLW*AMAX1(0.0,OXYG2(NU(NY,NX),NY,NX)) + RFLNGG=VFLW*AMAX1(0.0,Z2GG2(NU(NY,NX),NY,NX)) + RFLN2G=VFLW*AMAX1(0.0,Z2OG2(NU(NY,NX),NY,NX)) + RFLN3G=VFLW*AMAX1(0.0,ZN3G2(NU(NY,NX),NY,NX)) + RFLH2G=VFLW*AMAX1(0.0,H2GG2(NU(NY,NX),NY,NX)) + ELSE + RFLCOG=-FLQM(3,NU(NY,NX),NY,NX)*CCO2E(NY,NX) + RFLCHG=-FLQM(3,NU(NY,NX),NY,NX)*CCH4E(NY,NX) + RFLOXG=-FLQM(3,NU(NY,NX),NY,NX)*COXYE(NY,NX) + RFLNGG=-FLQM(3,NU(NY,NX),NY,NX)*CZ2GE(NY,NX) + RFLN2G=-FLQM(3,NU(NY,NX),NY,NX)*CZ2OE(NY,NX) + RFLN3G=-FLQM(3,NU(NY,NX),NY,NX)*CNH3E(NY,NX) + RFLH2G=-FLQM(3,NU(NY,NX),NY,NX)*CH2GE(NY,NX) + ENDIF +C +C SURFACE GAS FLUX FROM DIFFERENCES +C BETWEEN ATMOSPHERIC AND SOIL SURFACE EQUILIBRIUM +C CONCENTRATIONS + CONVECTIVE FLUX +C + RCOFLG(3,NU(NY,NX),NY,NX)=DFVCOG+RFLCOG + RCHFLG(3,NU(NY,NX),NY,NX)=DFVCHG+RFLCHG + ROXFLG(3,NU(NY,NX),NY,NX)=DFVOXG+RFLOXG + RNGFLG(3,NU(NY,NX),NY,NX)=DFVNGG+RFLNGG + RN2FLG(3,NU(NY,NX),NY,NX)=DFVN2G+RFLN2G + RN3FLG(3,NU(NY,NX),NY,NX)=DFVN3G+RFLN3G + RHGFLG(3,NU(NY,NX),NY,NX)=DFVHGG+RFLH2G +C +C ACCUMULATE HOURLY FLUXES +C + XCOFLG(3,NU(NY,NX),NY,NX)=XCOFLG(3,NU(NY,NX),NY,NX) + 2+RCOFLG(3,NU(NY,NX),NY,NX) + XCHFLG(3,NU(NY,NX),NY,NX)=XCHFLG(3,NU(NY,NX),NY,NX) + 2+RCHFLG(3,NU(NY,NX),NY,NX) + XOXFLG(3,NU(NY,NX),NY,NX)=XOXFLG(3,NU(NY,NX),NY,NX) + 2+ROXFLG(3,NU(NY,NX),NY,NX) + XNGFLG(3,NU(NY,NX),NY,NX)=XNGFLG(3,NU(NY,NX),NY,NX) + 2+RNGFLG(3,NU(NY,NX),NY,NX) + XN2FLG(3,NU(NY,NX),NY,NX)=XN2FLG(3,NU(NY,NX),NY,NX) + 2+RN2FLG(3,NU(NY,NX),NY,NX) + XN3FLG(3,NU(NY,NX),NY,NX)=XN3FLG(3,NU(NY,NX),NY,NX) + 2+RN3FLG(3,NU(NY,NX),NY,NX) + XHGFLG(3,NU(NY,NX),NY,NX)=XHGFLG(3,NU(NY,NX),NY,NX) + 2+RHGFLG(3,NU(NY,NX),NY,NX) +C IF(J.EQ.24)THEN +C WRITE(*,3131)'ROXFLG',I,J,NX,NY,M,MM,XOXFLG(3,NU(NY,NX),NY,NX) +C 2,ROXFLG(3,NU(NY,NX),NY,NX),DFVOXG,RFLOXG,COXYE(NY,NX) +C 2,COXYG2,DOXYGQ,OXYG2(NU(NY,NX),NY,NX),FLQM(3,NU(NY,NX),NY,NX) +C 3,VFLW,DOXYG(3,NU(NY,NX),NY,NX),PARGOX(NY,NX) +C 4,THETPM(M,NU(NY,NX),NY,NX),VOLPM(M,NU(NY,NX),NY,NX) +C 5,DFGS(M,NU(NY,NX),NY,NX) +C WRITE(*,3131)'RNGFLG',I,J,NX,NY,M,MM,XNGFLG(3,NU(NY,NX),NY,NX) +C 2,RNGFLG(3,NU(NY,NX),NY,NX),DFVNGG,RFLNGG,CZ2GE(NY,NX) +C 2,CZ2GG2,DZ2GGQ,Z2GG2(NU(NY,NX),NY,NX),FLQM(3,NU(NY,NX),NY,NX) +C 3,VFLW,DZ2GG(3,NU(NY,NX),NY,NX),PARGNG(NY,NX) +C 4,THETPM(M,NU(NY,NX),NY,NX),VOLPM(M,NU(NY,NX),NY,NX) +3131 FORMAT(A8,6I4,30E12.4) +C ENDIF +C +C SOIL SURFACE +C + IF(THETW1(NU(NY,NX),NY,NX).GT.THETY(NU(NY,NX),NY,NX))THEN + VOLCOT(NY,NX)=VOLWCO(NU(NY,NX),NY,NX)+VOLPM(M,NU(NY,NX),NY,NX) + VOLCHT(NY,NX)=VOLWCH(NU(NY,NX),NY,NX)+VOLPM(M,NU(NY,NX),NY,NX) + VOLOXT(NY,NX)=VOLWOX(NU(NY,NX),NY,NX)+VOLPM(M,NU(NY,NX),NY,NX) + VOLNGT(NY,NX)=VOLWNG(NU(NY,NX),NY,NX)+VOLPM(M,NU(NY,NX),NY,NX) + VOLN2T(NY,NX)=VOLWN2(NU(NY,NX),NY,NX)+VOLPM(M,NU(NY,NX),NY,NX) + VOLN3T(NY,NX)=VOLWN3(NU(NY,NX),NY,NX)+VOLPMA(NU(NY,NX),NY,NX) + VOLNBT(NY,NX)=VOLWNB(NU(NY,NX),NY,NX)+VOLPMB(NU(NY,NX),NY,NX) + VOLHGT(NY,NX)=VOLWHG(NU(NY,NX),NY,NX)+VOLPM(M,NU(NY,NX),NY,NX) + RCODFG(NU(NY,NX),NY,NX)=DFGS(M,NU(NY,NX),NY,NX) + 2*(AMAX1(ZEROS(NY,NX),CO2G2(NU(NY,NX),NY,NX)) + 3*VOLWCO(NU(NY,NX),NY,NX)-AMAX1(ZEROS(NY,NX) + 2,CO2S2(NU(NY,NX),NY,NX)+RCODXS) + 4*VOLPM(M,NU(NY,NX),NY,NX))/VOLCOT(NY,NX) + RCHDFG(NU(NY,NX),NY,NX)=DFGS(M,NU(NY,NX),NY,NX) + 2*(AMAX1(ZEROS(NY,NX),CH4G2(NU(NY,NX),NY,NX)) + 3*VOLWCH(NU(NY,NX),NY,NX)-AMAX1(ZEROS(NY,NX) + 2,CH4S2(NU(NY,NX),NY,NX)+RCHDXS) + 4*VOLPM(M,NU(NY,NX),NY,NX))/VOLCHT(NY,NX) + ROXDFG(NU(NY,NX),NY,NX)=DFGS(M,NU(NY,NX),NY,NX) + 2*(AMAX1(ZEROS(NY,NX),OXYG2(NU(NY,NX),NY,NX)) + 3*VOLWOX(NU(NY,NX),NY,NX)-AMAX1(ZEROS(NY,NX) + 2,OXYS2(NU(NY,NX),NY,NX)+ROXDXS) + 4*VOLPM(M,NU(NY,NX),NY,NX))/VOLOXT(NY,NX) + RNGDFG(NU(NY,NX),NY,NX)=DFGS(M,NU(NY,NX),NY,NX) + 2*(AMAX1(ZEROS(NY,NX),Z2GG2(NU(NY,NX),NY,NX)) + 3*VOLWNG(NU(NY,NX),NY,NX)-AMAX1(ZEROS(NY,NX) + 4,Z2GS2(NU(NY,NX),NY,NX)+RNGDXS) + 4*VOLPM(M,NU(NY,NX),NY,NX))/VOLNGT(NY,NX) + RN2DFG(NU(NY,NX),NY,NX)=DFGS(M,NU(NY,NX),NY,NX) + 2*(AMAX1(ZEROS(NY,NX),Z2OG2(NU(NY,NX),NY,NX)) + 3*VOLWN2(NU(NY,NX),NY,NX)-AMAX1(ZEROS(NY,NX) + 2,Z2OS2(NU(NY,NX),NY,NX)+RN2DXS) + 4*VOLPM(M,NU(NY,NX),NY,NX))/VOLN2T(NY,NX) + IF(VOLN3T(NY,NX).GT.ZEROS(NY,NX) + 2.AND.VOLWXA(NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN + RN3DFG(NU(NY,NX),NY,NX)=DFGS(M,NU(NY,NX),NY,NX) + 2*(AMAX1(ZEROS(NY,NX),ZN3G2(NU(NY,NX),NY,NX)) + 3*VOLWN3(NU(NY,NX),NY,NX)-AMAX1(ZEROS(NY,NX) + 4,ZN3S2(NU(NY,NX),NY,NX)+RN3DXS) + 5*VOLPMA(NU(NY,NX),NY,NX))/VOLN3T(NY,NX) + CNH3S0=AMAX1(0.0,(ZN3S2(NU(NY,NX),NY,NX) + 2+RN3DFG(NU(NY,NX),NY,NX))/VOLWXA(NU(NY,NX),NY,NX)) + CNH4S0=AMAX1(0.0,ZNH4S2(NU(NY,NX),NY,NX)) + 2/VOLWXA(NU(NY,NX),NY,NX) + RN34SQ(NU(NY,NX),NY,NX)=VOLWXA(NU(NY,NX),NY,NX) + 2*(CHY0(NU(NY,NX),NY,NX)*CNH3S0-DPN4*CNH4S0) + 3/(DPN4+CHY0(NU(NY,NX),NY,NX)) + ELSE + RN3DFG(NU(NY,NX),NY,NX)=0.0 + RN34SQ(NU(NY,NX),NY,NX)=0.0 + ENDIF + IF(VOLNBT(NY,NX).GT.ZEROS(NY,NX) + 2.AND.VOLWXB(NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN + RNBDFG(NU(NY,NX),NY,NX)=DFGS(M,NU(NY,NX),NY,NX) + 2*(AMAX1(ZEROS(NY,NX),ZN3G2(NU(NY,NX),NY,NX)) + 3*VOLWNB(NU(NY,NX),NY,NX)-AMAX1(ZEROS(NY,NX) + 4,ZNBS2(NU(NY,NX),NY,NX)+RNBDXS) + 5*VOLPMB(NU(NY,NX),NY,NX))/VOLNBT(NY,NX) + CNH3B0=AMAX1(0.0,(ZNBS2(NU(NY,NX),NY,NX) + 2+RNBDFG(NU(NY,NX),NY,NX))/VOLWXB(NU(NY,NX),NY,NX)) + CNH4B0=AMAX1(0.0,ZNH4B2(NU(NY,NX),NY,NX)) + 2/VOLWXB(NU(NY,NX),NY,NX) + RN34BQ(NU(NY,NX),NY,NX)=VOLWXB(NU(NY,NX),NY,NX) + 2*(CHY0(NU(NY,NX),NY,NX)*CNH3B0-DPN4*CNH4B0) + 3/(DPN4+CHY0(NU(NY,NX),NY,NX)) + ELSE + RNBDFG(NU(NY,NX),NY,NX)=0.0 + RN34BQ(NU(NY,NX),NY,NX)=0.0 + ENDIF + RHGDFG(NU(NY,NX),NY,NX)=DFGS(M,NU(NY,NX),NY,NX) + 2*(AMAX1(ZEROS(NY,NX),H2GG2(NU(NY,NX),NY,NX)) + 3*VOLWHG(NU(NY,NX),NY,NX)-AMAX1(ZEROS(NY,NX) + 4,H2GS2(NU(NY,NX),NY,NX)+RHGDXS) + 4*VOLPM(M,NU(NY,NX),NY,NX))/VOLHGT(NY,NX) +C IF(J.EQ.12)THEN +C WRITE(*,323)'RN3FLG',I,J,NX,NY,M,MM,RN3FLG(3,NU(NY,NX),NY,NX) +C 2,DNH3GQ,CNH3E(NY,NX),CNH3G2,FLQM(3,NU(NY,NX),NY,NX),CNH3GV +C 2,CNH3B2,ZNBS2(NU(NY,NX),NY,NX),RNBDFG(NU(NY,NX),NY,NX) +C 3,DFGS(M,NU(NY,NX),NY,NX),ZN3G2B,VOLPMB(NU(NY,NX),NY,NX) +C 4,ZNBS2(NU(NY,NX),NY,NX),VOLWNB(NU(NY,NX),NY,NX) +C 5,VOLWMB,SNH3L(NU(NY,NX),NY,NX) +C WRITE(*,323)'RNGDFG',I,J,NX,NY,M,MM,RNGDFG(NU(NY,NX),NY,NX) +C 2,DFGS(M,NU(NY,NX),NY,NX),Z2GG2(NU(NY,NX),NY,NX) +C 3,VOLWNG(NU(NY,NX),NY,NX),Z2GS2(NU(NY,NX),NY,NX) +C 4,RNGDFS(NY,NX),VOLPM(M,NU(NY,NX),NY,NX),VOLNGT(NY,NX) +C ENDIF +C +C ACCUMULATE HOURLY FLUXES +C + XCODFG(NU(NY,NX),NY,NX)=XCODFG(NU(NY,NX),NY,NX) + 2+RCODFG(NU(NY,NX),NY,NX) + XCHDFG(NU(NY,NX),NY,NX)=XCHDFG(NU(NY,NX),NY,NX) + 2+RCHDFG(NU(NY,NX),NY,NX) + XOXDFG(NU(NY,NX),NY,NX)=XOXDFG(NU(NY,NX),NY,NX) + 2+ROXDFG(NU(NY,NX),NY,NX) + XNGDFG(NU(NY,NX),NY,NX)=XNGDFG(NU(NY,NX),NY,NX) + 2+RNGDFG(NU(NY,NX),NY,NX) + XN2DFG(NU(NY,NX),NY,NX)=XN2DFG(NU(NY,NX),NY,NX) + 2+RN2DFG(NU(NY,NX),NY,NX) + XN3DFG(NU(NY,NX),NY,NX)=XN3DFG(NU(NY,NX),NY,NX) + 2+RN3DFG(NU(NY,NX),NY,NX) + XN34SQ(NU(NY,NX),NY,NX)=XN34SQ(NU(NY,NX),NY,NX) + 2+RN34SQ(NU(NY,NX),NY,NX) + XNBDFG(NU(NY,NX),NY,NX)=XNBDFG(NU(NY,NX),NY,NX) + 2+RNBDFG(NU(NY,NX),NY,NX) + XN34BQ(NU(NY,NX),NY,NX)=XN34BQ(NU(NY,NX),NY,NX) + 2+RN34BQ(NU(NY,NX),NY,NX) + XHGDFG(NU(NY,NX),NY,NX)=XHGDFG(NU(NY,NX),NY,NX) + 2+RHGDFG(NU(NY,NX),NY,NX) +C WRITE(*,3131)'ROXDFG',I,J,NX,NY,M,MM,XOXDFG(NU(NY,NX),NY,NX) +C 2,ROXDFG(NU(NY,NX),NY,NX),DFGS(M,NU(NY,NX),NY,NX) +C 2,AMAX1(ZEROS(NY,NX),OXYG2(NU(NY,NX),NY,NX)) +C 3,VOLWOX(NU(NY,NX),NY,NX),AMAX1(ZEROS(NY,NX) +C 4,OXYS2(NU(NY,NX),NY,NX)),VOLPM(M,NU(NY,NX),NY,NX) + ELSE + RCODFG(NU(NY,NX),NY,NX)=0.0 + RCHDFG(NU(NY,NX),NY,NX)=0.0 + ROXDFG(NU(NY,NX),NY,NX)=0.0 + RNGDFG(NU(NY,NX),NY,NX)=0.0 + RN2DFG(NU(NY,NX),NY,NX)=0.0 + RN3DFG(NU(NY,NX),NY,NX)=0.0 + RN34SQ(NU(NY,NX),NY,NX)=0.0 + RNBDFG(NU(NY,NX),NY,NX)=0.0 + RN34BQ(NU(NY,NX),NY,NX)=0.0 + RHGDFG(NU(NY,NX),NY,NX)=0.0 + ENDIF + ELSE + RCOFLG(3,NU(NY,NX),NY,NX)=0.0 + RCHFLG(3,NU(NY,NX),NY,NX)=0.0 + ROXFLG(3,NU(NY,NX),NY,NX)=0.0 + RNGFLG(3,NU(NY,NX),NY,NX)=0.0 + RN2FLG(3,NU(NY,NX),NY,NX)=0.0 + RN3FLG(3,NU(NY,NX),NY,NX)=0.0 + RHGFLG(3,NU(NY,NX),NY,NX)=0.0 + RCODFG(NU(NY,NX),NY,NX)=0.0 + RCHDFG(NU(NY,NX),NY,NX)=0.0 + ROXDFG(NU(NY,NX),NY,NX)=0.0 + RN2DFG(NU(NY,NX),NY,NX)=0.0 + RNGDFG(NU(NY,NX),NY,NX)=0.0 + RN3DFG(NU(NY,NX),NY,NX)=0.0 + RN34SQ(NU(NY,NX),NY,NX)=0.0 + RNBDFG(NU(NY,NX),NY,NX)=0.0 + RN34BQ(NU(NY,NX),NY,NX)=0.0 + RHGDFG(NU(NY,NX),NY,NX)=0.0 + ENDIF +C +C SOLUTE FLUXES BETWEEN ADJACENT GRID CELLS +C + IFLGB=0 + DO 125 L=1,NL(NY,NX) + N1=NX + N2=NY + N3=L +C +C LOCATE INTERNAL BOUNDARIES BETWEEN ADJACENT GRID CELLS +C + DO 120 N=NCN(N2,N1),3 + IF(N.EQ.1)THEN + IF(NX.EQ.NHE)THEN + GO TO 120 + ELSE + N4=NX+1 + N5=NY + N6=L + ENDIF + ELSEIF(N.EQ.2)THEN + IF(NY.EQ.NVS)THEN + GO TO 120 + ELSE + N4=NX + N5=NY+1 + N6=L + ENDIF + ELSEIF(N.EQ.3)THEN + IF(L.EQ.NL(NY,NX))THEN + GO TO 120 + ELSE + N4=NX + N5=NY + N6=L+1 + ENDIF + ENDIF + IF(N3.GE.NU(N2,N1).AND.N6.GE.NU(N5,N4))THEN + IF(M.NE.MX)THEN +C +C SOLUTE FLUXES BETWEEN ADJACENT GRID CELLS FROM +C WATER CONTENTS AND WATER FLUXES 'FLQM' FROM 'WATSUB' +C + VOLW4A=VOLWM(M,N3,N2,N1)*VLNH4(N3,N2,N1) + VOLW4B=VOLWM(M,N3,N2,N1)*VLNHB(N3,N2,N1) + VOLH4A=VOLWHM(M,N3,N2,N1)*VLNH4(N3,N2,N1) + VOLH4B=VOLWHM(M,N3,N2,N1)*VLNHB(N3,N2,N1) + VOLW3A=VOLWM(M,N3,N2,N1)*VLNO3(N3,N2,N1) + VOLW3B=VOLWM(M,N3,N2,N1)*VLNOB(N3,N2,N1) + VOLH3A=VOLWHM(M,N3,N2,N1)*VLNO3(N3,N2,N1) + VOLH3B=VOLWHM(M,N3,N2,N1)*VLNOB(N3,N2,N1) + VOLW2A=VOLWM(M,N3,N2,N1)*VLPO4(N3,N2,N1) + VOLW2B=VOLWM(M,N3,N2,N1)*VLPOB(N3,N2,N1) + VOLH2A=VOLWHM(M,N3,N2,N1)*VLPO4(N3,N2,N1) + VOLH2B=VOLWHM(M,N3,N2,N1)*VLPOB(N3,N2,N1) + VOLWMA(N6,N5,N4)=VOLWM(M,N6,N5,N4)*VLNH4(N6,N5,N4) + VOLWMB(N6,N5,N4)=VOLWM(M,N6,N5,N4)*VLNHB(N6,N5,N4) + VOLWXA(N6,N5,N4)=14.0*VOLWMA(N6,N5,N4) + VOLWXB(N6,N5,N4)=14.0*VOLWMB(N6,N5,N4) + VOLWOA=VOLWM(M,N6,N5,N4)*VLNO3(N6,N5,N4) + VOLWOB=VOLWM(M,N6,N5,N4)*VLNOB(N6,N5,N4) + VOLHOA=VOLWHM(M,N6,N5,N4)*VLNO3(N6,N5,N4) + VOLHOB=VOLWHM(M,N6,N5,N4)*VLNOB(N6,N5,N4) + VOLWPA=VOLWM(M,N6,N5,N4)*VLPO4(N6,N5,N4) + VOLWPB=VOLWM(M,N6,N5,N4)*VLPOB(N6,N5,N4) + VOLHPA=VOLWHM(M,N6,N5,N4)*VLPO4(N6,N5,N4) + VOLHPB=VOLWHM(M,N6,N5,N4)*VLPOB(N6,N5,N4) + VOLPMA(N6,N5,N4)=VOLPM(M,N6,N5,N4)*VLNH4(N6,N5,N4) + VOLPMB(N6,N5,N4)=VOLPM(M,N6,N5,N4)*VLNHB(N6,N5,N4) + THETW1(N3,N2,N1)=AMAX1(0.0,VOLWM(M,N3,N2,N1)/VOLX(N3,N2,N1)) + THETW1(N6,N5,N4)=AMAX1(0.0,VOLWM(M,N6,N5,N4)/VOLX(N6,N5,N4)) + FLVM(N6,N5,N4)=FLPM(M,N6,N5,N4)*XNPT +C +C GASEOUS SOLUBILITIES +C + IF(N.EQ.3)THEN + VOLWCO(N6,N5,N4)=VOLWM(M,N6,N5,N4)*SCO2L(N6,N5,N4) + VOLWCH(N6,N5,N4)=VOLWM(M,N6,N5,N4)*SCH4L(N6,N5,N4) + VOLWOX(N6,N5,N4)=VOLWM(M,N6,N5,N4)*SOXYL(N6,N5,N4) + VOLWNG(N6,N5,N4)=VOLWM(M,N6,N5,N4)*SN2GL(N6,N5,N4) + VOLWN2(N6,N5,N4)=VOLWM(M,N6,N5,N4)*SN2OL(N6,N5,N4) + VOLWN3(N6,N5,N4)=VOLWMA(N6,N5,N4)*SNH3L(N6,N5,N4) + VOLWNB(N6,N5,N4)=VOLWMB(N6,N5,N4)*SNH3L(N6,N5,N4) + VOLWHG(N6,N5,N4)=VOLWM(M,N6,N5,N4)*SH2GL(N6,N5,N4) + ENDIF + FLQM(N,N6,N5,N4)=(FLWM(M,N,N6,N5,N4)+FLWHM(M,N,N6,N5,N4))*XNPT +C +C SOLUTE TRANSPORT IN MICROPORES +C + IF(FLWM(M,N,N6,N5,N4).GT.0.0)THEN +C +C IF MICROPORE WATER FLUX FROM 'WATSUB' IS FROM CURRENT TO +C ADJACENT GRID CELL THEN CONVECTIVE TRANSPORT IS THE PRODUCT +C OF WATER FLUX AND MICROPORE GAS OR SOLUTE CONCENTRATIONS +C IN CURRENT GRID CELL +C + IF(VOLWM(M,N3,N2,N1).GT.ZEROS(N2,N1))THEN + VFLW=AMAX1(0.0,AMIN1(XFRX,FLWM(M,N,N6,N5,N4) + 2/VOLWM(M,N3,N2,N1))) + ELSE + VFLW=XFRX + ENDIF + DO 9820 K=0,4 + RFLOC(K)=VFLW*AMAX1(0.0,OQC2(K,N3,N2,N1)) + RFLON(K)=VFLW*AMAX1(0.0,OQN2(K,N3,N2,N1)) + RFLOP(K)=VFLW*AMAX1(0.0,OQP2(K,N3,N2,N1)) + RFLOA(K)=VFLW*AMAX1(0.0,OQA2(K,N3,N2,N1)) +9820 CONTINUE + RFLCOS=VFLW*AMAX1(0.0,CO2S2(N3,N2,N1)) + RFLCHS=VFLW*AMAX1(0.0,CH4S2(N3,N2,N1)) + RFLOXS=VFLW*AMAX1(0.0,OXYS2(N3,N2,N1)) + RFLNGS=VFLW*AMAX1(0.0,Z2GS2(N3,N2,N1)) + RFLN2S=VFLW*AMAX1(0.0,Z2OS2(N3,N2,N1)) + RFLHGS=VFLW*AMAX1(0.0,H2GS2(N3,N2,N1)) + RFLNH4=VFLW*AMAX1(0.0,ZNH4S2(N3,N2,N1)) + RFLNH3=VFLW*AMAX1(0.0,ZN3S2(N3,N2,N1)) + RFLNO3=VFLW*AMAX1(0.0,ZNO3S2(N3,N2,N1)) + RFLNO2=VFLW*AMAX1(0.0,ZNO2S2(N3,N2,N1)) + RFLPO4=VFLW*AMAX1(0.0,H2PO42(N3,N2,N1)) + RFLN4B=VFLW*AMAX1(0.0,ZNH4B2(N3,N2,N1)) + RFLN3B=VFLW*AMAX1(0.0,ZNBS2(N3,N2,N1)) + RFLNOB=VFLW*AMAX1(0.0,ZNO3B2(N3,N2,N1)) + RFLN2B=VFLW*AMAX1(0.0,ZNO2B2(N3,N2,N1)) + RFLPOB=VFLW*AMAX1(0.0,H2POB2(N3,N2,N1)) + ELSE +C +C IF MICROPORE WATER FLUX FROM 'WATSUB' IS TO CURRENT FROM +C ADJACENT GRID CELL THEN CONVECTIVE TRANSPORT IS THE PRODUCT +C OF WATER FLUX AND MICROPORE GAS OR SOLUTE CONCENTRATIONS +C IN ADJACENT GRID CELL +C + IF(VOLWM(M,N6,N5,N4).GT.ZEROS(N5,N4))THEN + VFLW=AMIN1(0.0,AMAX1(-XFRX,FLWM(M,N,N6,N5,N4) + 2/VOLWM(M,N6,N5,N4))) + ELSE + VFLW=-XFRX + ENDIF + DO 9815 K=0,4 + RFLOC(K)=VFLW*AMAX1(0.0,OQC2(K,N6,N5,N4)) + RFLON(K)=VFLW*AMAX1(0.0,OQN2(K,N6,N5,N4)) + RFLOP(K)=VFLW*AMAX1(0.0,OQP2(K,N6,N5,N4)) + RFLOA(K)=VFLW*AMAX1(0.0,OQA2(K,N6,N5,N4)) +9815 CONTINUE + RFLCOS=VFLW*AMAX1(0.0,CO2S2(N6,N5,N4)) + RFLCHS=VFLW*AMAX1(0.0,CH4S2(N6,N5,N4)) + RFLOXS=VFLW*AMAX1(0.0,OXYS2(N6,N5,N4)) + RFLNGS=VFLW*AMAX1(0.0,Z2GS2(N6,N5,N4)) + RFLN2S=VFLW*AMAX1(0.0,Z2OS2(N6,N5,N4)) + RFLHGS=VFLW*AMAX1(0.0,H2GS2(N6,N5,N4)) + RFLNH4=VFLW*AMAX1(0.0,ZNH4S2(N6,N5,N4)) + RFLNH3=VFLW*AMAX1(0.0,ZN3S2(N6,N5,N4)) + RFLNO3=VFLW*AMAX1(0.0,ZNO3S2(N6,N5,N4)) + RFLNO2=VFLW*AMAX1(0.0,ZNO2S2(N6,N5,N4)) + RFLPO4=VFLW*AMAX1(0.0,H2PO42(N6,N5,N4)) + RFLN4B=VFLW*AMAX1(0.0,ZNH4B2(N6,N5,N4)) + RFLN3B=VFLW*AMAX1(0.0,ZNBS2(N6,N5,N4)) + RFLNOB=VFLW*AMAX1(0.0,ZNO3B2(N6,N5,N4)) + RFLN2B=VFLW*AMAX1(0.0,ZNO2B2(N6,N5,N4)) + RFLPOB=VFLW*AMAX1(0.0,H2POB2(N6,N5,N4)) + ENDIF +C +C DIFFUSIVE FLUXES OF GASES AND SOLUTES BETWEEN CURRENT AND +C ADJACENT GRID CELL MICROPORES FROM AQUEOUS DIFFUSIVITIES +C AND CONCENTRATION DIFFERENCES +C + IF(THETW1(N3,N2,N1).GT.THETY(N3,N2,N1) + 2.AND.THETW1(N6,N5,N4).GT.THETY(N6,N5,N4))THEN +C +C MICROPORE CONCENTRATIONS FROM WATER-FILLED POROSITY +C IN CURRENT AND ADJACENT GRID CELLS +C + DO 9810 K=0,4 + COQC1(K)=AMAX1(0.0,OQC2(K,N3,N2,N1)/VOLWM(M,N3,N2,N1)) + COQN1(K)=AMAX1(0.0,OQN2(K,N3,N2,N1)/VOLWM(M,N3,N2,N1)) + COQP1(K)=AMAX1(0.0,OQP2(K,N3,N2,N1)/VOLWM(M,N3,N2,N1)) + COQA1(K)=AMAX1(0.0,OQA2(K,N3,N2,N1)/VOLWM(M,N3,N2,N1)) + COQC2(K)=AMAX1(0.0,OQC2(K,N6,N5,N4)/VOLWM(M,N6,N5,N4)) + COQN2(K)=AMAX1(0.0,OQN2(K,N6,N5,N4)/VOLWM(M,N6,N5,N4)) + COQP2(K)=AMAX1(0.0,OQP2(K,N6,N5,N4)/VOLWM(M,N6,N5,N4)) + COQA2(K)=AMAX1(0.0,OQA2(K,N6,N5,N4)/VOLWM(M,N6,N5,N4)) +9810 CONTINUE + CCO2S1=AMAX1(0.0,CO2S2(N3,N2,N1)/VOLWM(M,N3,N2,N1)) + CCH4S1=AMAX1(0.0,CH4S2(N3,N2,N1)/VOLWM(M,N3,N2,N1)) + COXYS1=AMAX1(0.0,OXYS2(N3,N2,N1)/VOLWM(M,N3,N2,N1)) + CZ2GS1=AMAX1(0.0,Z2GS2(N3,N2,N1)/VOLWM(M,N3,N2,N1)) + CZ2OS1=AMAX1(0.0,Z2OS2(N3,N2,N1)/VOLWM(M,N3,N2,N1)) + CH2GS1=AMAX1(0.0,H2GS2(N3,N2,N1)/VOLWM(M,N3,N2,N1)) + IF(VOLW4A.GT.ZEROS(N2,N1))THEN + CNH4S1=AMAX1(0.0,ZNH4S2(N3,N2,N1)/VOLW4A) + CNH3S1=AMAX1(0.0,ZN3S2(N3,N2,N1)/VOLW4A) + ELSE + CNH4S1=0.0 + CNH3S1=0.0 + ENDIF + IF(VOLW3A.GT.ZEROS(N2,N1))THEN + CNO3S1=AMAX1(0.0,ZNO3S2(N3,N2,N1)/VOLW3A) + CNO2S1=AMAX1(0.0,ZNO2S2(N3,N2,N1)/VOLW3A) + ELSE + CNO3S1=0.0 + CNO2S1=0.0 + ENDIF + IF(VOLW2A.GT.ZEROS(N2,N1))THEN + CPO4S1=AMAX1(0.0,H2PO42(N3,N2,N1)/VOLW2A) + ELSE + CPO4S1=0.0 + ENDIF + IF(VOLW4B.GT.ZEROS(N2,N1))THEN + CNH4B1=AMAX1(0.0,ZNH4B2(N3,N2,N1)/VOLW4B) + CNH3B1=AMAX1(0.0,ZNBS2(N3,N2,N1)/VOLW4B) + ELSE + CNH4B1=0.0 + CNH3B1=0.0 + ENDIF + IF(VOLW3B.GT.ZEROS(N2,N1))THEN + CNO3B1=AMAX1(0.0,ZNO3B2(N3,N2,N1)/VOLW3B) + CNO2B1=AMAX1(0.0,ZNO2B2(N3,N2,N1)/VOLW3B) + ELSE + CNO3B1=CNO3S1 + CNO2B1=CNO2S1 + ENDIF + IF(VOLW2B.GT.ZEROS(N2,N1))THEN + CPO4B1=AMAX1(0.0,H2POB2(N3,N2,N1)/VOLW2B) + ELSE + CPO4B1=CPO4S1 + ENDIF + CCO2S2=AMAX1(0.0,CO2S2(N6,N5,N4)/VOLWM(M,N6,N5,N4)) + CCH4S2=AMAX1(0.0,CH4S2(N6,N5,N4)/VOLWM(M,N6,N5,N4)) + COXYS2=AMAX1(0.0,OXYS2(N6,N5,N4)/VOLWM(M,N6,N5,N4)) + CZ2GS2=AMAX1(0.0,Z2GS2(N6,N5,N4)/VOLWM(M,N6,N5,N4)) + CZ2OS2=AMAX1(0.0,Z2OS2(N6,N5,N4)/VOLWM(M,N6,N5,N4)) + CH2GS2=AMAX1(0.0,H2GS2(N6,N5,N4)/VOLWM(M,N6,N5,N4)) + IF(VOLWMA(N6,N5,N4).GT.ZEROS(N5,N4))THEN + CNH3S2=AMAX1(0.0,ZN3S2(N6,N5,N4)/VOLWMA(N6,N5,N4)) + CNH4S2=AMAX1(0.0,ZNH4S2(N6,N5,N4)/VOLWMA(N6,N5,N4)) + ELSE + CNH3S2=0.0 + CNH4S2=0.0 + ENDIF + IF(VOLWOA.GT.ZEROS(N5,N4))THEN + CNO3S2=AMAX1(0.0,ZNO3S2(N6,N5,N4)/VOLWOA) + CNO2S2=AMAX1(0.0,ZNO2S2(N6,N5,N4)/VOLWOA) + ELSE + CNO3S2=0.0 + CNO2S2=0.0 + ENDIF + IF(VOLWPA.GT.ZEROS(N5,N4))THEN + CPO4S2=AMAX1(0.0,H2PO42(N6,N5,N4)/VOLWPA) + ELSE + CPO4S2=0.0 + ENDIF + IF(VOLWMB(N6,N5,N4).GT.ZEROS(N5,N4))THEN + CNH3B2=AMAX1(0.0,ZNBS2(N6,N5,N4)/VOLWMB(N6,N5,N4)) + CNH4B2=AMAX1(0.0,ZNH4B2(N6,N5,N4)/VOLWMB(N6,N5,N4)) + ELSE + CNH3B2=CNH3S2 + CNH4B2=CNH4S2 + ENDIF + IF(VOLWOB.GT.ZEROS(N5,N4))THEN + CNO3B2=AMAX1(0.0,ZNO3B2(N6,N5,N4)/VOLWOB) + CNO2B2=AMAX1(0.0,ZNO2B2(N6,N5,N4)/VOLWOB) + ELSE + CNO3B2=CNO3S2 + CNO2B2=CNO2S2 + ENDIF + IF(VOLWPB.GT.ZEROS(N5,N4))THEN + CPO4B2=AMAX1(0.0,H2POB2(N6,N5,N4)/VOLWPB) + ELSE + CPO4B2=CPO4S2 + ENDIF +C +C DIFFUSIVITIES IN CURRENT AND ADJACENT GRID CELL MICROPORES +C + TORTL=(TORT(M,N3,N2,N1)*DLYR(N,N3,N2,N1) + 2+TORT(M,N6,N5,N4)*DLYR(N,N6,N5,N4)) + 3/(DLYR(N,N3,N2,N1)+DLYR(N,N6,N5,N4)) + DISPN=DISP(N,N6,N5,N4)*ABS(FLWM(M,N,N6,N5,N4)/AREA(N,N6,N5,N4)) + DIFOC=(OCSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFON=(ONSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFOP=(OPSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFOA=(OASGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFNH=(ZNSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFNO=(ZOSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFPO=(POSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFCS=(CLSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFCQ=(CQSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFOS=(OLSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFNG=(ZLSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFN2=(ZVSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFHG=(HLSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) +C +C DIFFUSIVE FLUXES BETWEEN CURRENT AND ADJACENT GRID CELL +C MICROPORES +C + DO 9805 K=0,4 + DFVOC(K)=DIFOC*(COQC1(K)-COQC2(K)) + DFVON(K)=DIFON*(COQN1(K)-COQN2(K)) + DFVOP(K)=DIFOP*(COQP1(K)-COQP2(K)) + DFVOA(K)=DIFOA*(COQA1(K)-COQA2(K)) +9805 CONTINUE + DFVCOS=DIFCS*(CCO2S1-CCO2S2) + DFVCHS=DIFCQ*(CCH4S1-CCH4S2) + DFVOXS=DIFOS*(COXYS1-COXYS2) + DFVNGS=DIFNG*(CZ2GS1-CZ2GS2) + DFVN2S=DIFN2*(CZ2OS1-CZ2OS2) + DFVHGS=DIFHG*(CH2GS1-CH2GS2) + DFVNH4=DIFNH*(CNH4S1-CNH4S2)*AMIN1(VLNH4(N3,N2,N1) + 2,VLNH4(N6,N5,N4)) + DFVNH3=DIFNH*(CNH3S1-CNH3S2)*AMIN1(VLNH4(N3,N2,N1) + 2,VLNH4(N6,N5,N4)) + DFVNO3=DIFNO*(CNO3S1-CNO3S2)*AMIN1(VLNO3(N3,N2,N1) + 2,VLNO3(N6,N5,N4)) + DFVNO2=DIFNO*(CNO2S1-CNO2S2)*AMIN1(VLNO3(N3,N2,N1) + 2,VLNO3(N6,N5,N4)) + DFVPO4=DIFPO*(CPO4S1-CPO4S2)*AMIN1(VLPO4(N3,N2,N1) + 2,VLPO4(N6,N5,N4)) + DFVN4B=DIFNH*(CNH4B1-CNH4B2)*AMIN1(VLNHB(N3,N2,N1) + 2,VLNHB(N6,N5,N4)) + DFVN3B=DIFNH*(CNH3B1-CNH3B2)*AMIN1(VLNHB(N3,N2,N1) + 2,VLNHB(N6,N5,N4)) + DFVNOB=DIFNO*(CNO3B1-CNO3B2)*AMIN1(VLNOB(N3,N2,N1) + 2,VLNOB(N6,N5,N4)) + DFVN2B=DIFNO*(CNO2B1-CNO2B2)*AMIN1(VLNOB(N3,N2,N1) + 2,VLNOB(N6,N5,N4)) + DFVPOB=DIFPO*(CPO4B1-CPO4B2)*AMIN1(VLPOB(N3,N2,N1) + 2,VLPOB(N6,N5,N4)) + ELSE + DO 9905 K=0,4 + DFVOC(K)=0.0 + DFVON(K)=0.0 + DFVOP(K)=0.0 + DFVOA(K)=0.0 +9905 CONTINUE + DFVCOS=0.0 + DFVCHS=0.0 + DFVOXS=0.0 + DFVNGS=0.0 + DFVN2S=0.0 + DFVHGS=0.0 + DFVNH4=0.0 + DFVNH3=0.0 + DFVNO3=0.0 + DFVNO2=0.0 + DFVPO4=0.0 + DFVN4B=0.0 + DFVN3B=0.0 + DFVNOB=0.0 + DFVN2B=0.0 + DFVPOB=0.0 + ENDIF +C +C SOLUTE TRANSPORT IN MACROPORES +C + IF(FLWHM(M,N,N6,N5,N4).GT.0.0)THEN +C +C IF MACROPORE WATER FLUX FROM 'WATSUB' IS FROM CURRENT TO +C ADJACENT GRID CELL THEN CONVECTIVE TRANSPORT IS THE PRODUCT +C OF WATER FLUX AND MACROPORE SOLUTE CONCENTRATIONS IN CURRENT +C GRID CELL +C + IF(VOLWHM(M,N3,N2,N1).GT.ZEROS(N2,N1))THEN + VFLW=AMAX1(0.0,AMIN1(XFRX,FLWHM(M,N,N6,N5,N4) + 2/VOLWHM(M,N3,N2,N1))) + ELSE + VFLW=XFRX + ENDIF +C +C ACCOUNT FOR OVERLAND TRANSPORT IN THE SURFACE SOIL LAYER +C + IF(N.EQ.3.AND.VOLAH(N6,N5,N4).GT.VOLWHM(M,N6,N5,N4))THEN + DO 9800 K=0,4 + RFHOC(K)=VFLW*AMAX1(0.0,(OQCH2(K,N3,N2,N1) + 2-AMIN1(0.0,ROCFXS(K,NU(N2,N1),N2,N1)))) + RFHON(K)=VFLW*AMAX1(0.0,(OQNH2(K,N3,N2,N1) + 2-AMIN1(0.0,RONFXS(K,NU(N2,N1),N2,N1)))) + RFHOP(K)=VFLW*AMAX1(0.0,(OQPH2(K,N3,N2,N1) + 2-AMIN1(0.0,ROPFXS(K,NU(N2,N1),N2,N1)))) + RFHOA(K)=VFLW*AMAX1(0.0,(OQAH2(K,N3,N2,N1) + 2-AMIN1(0.0,ROAFXS(K,NU(N2,N1),N2,N1)))) +9800 CONTINUE + RFHCOS=VFLW*AMAX1(0.0,(CO2SH2(N3,N2,N1) + 2-AMIN1(0.0,RCOFXS(NU(N2,N1),N2,N1)))) + RFHCHS=VFLW*AMAX1(0.0,(CH4SH2(N3,N2,N1) + 2-AMIN1(0.0,RCHFXS(NU(N2,N1),N2,N1)))) + RFHOXS=VFLW*AMAX1(0.0,(OXYSH2(N3,N2,N1) + 2-AMIN1(0.0,ROXFXS(NU(N2,N1),N2,N1)))) + RFHNGS=VFLW*AMAX1(0.0,(Z2GSH2(N3,N2,N1) + 2-AMIN1(0.0,RNGFXS(NU(N2,N1),N2,N1)))) + RFHN2S=VFLW*AMAX1(0.0,(Z2OSH2(N3,N2,N1) + 2-AMIN1(0.0,RN2FXS(NU(N2,N1),N2,N1)))) + RFHHGS=VFLW*AMAX1(0.0,(H2GSH2(N3,N2,N1) + 2-AMIN1(0.0,RHGFXS(NU(N2,N1),N2,N1)))) + RFHNH4=VFLW*AMAX1(0.0,(ZNH4H2(N3,N2,N1) + 2-AMIN1(0.0,RN4FXW(NU(N2,N1),N2,N1)*VLNH4(N3,N2,N1)))) + 3*VLNH4(N6,N5,N4) + RFHNH3=VFLW*AMAX1(0.0,(ZNH3H2(N3,N2,N1) + 2-AMIN1(0.0,RN3FXW(NU(N2,N1),N2,N1)*VLNH4(N3,N2,N1)))) + 3*VLNH4(N6,N5,N4) + RFHNO3=VFLW*AMAX1(0.0,(ZNO3H2(N3,N2,N1) + 2-AMIN1(0.0,RNOFXW(NU(N2,N1),N2,N1)*VLNO3(N3,N2,N1)))) + 3*VLNO3(N6,N5,N4) + RFHNO2=VFLW*AMAX1(0.0,(ZNO2H2(N3,N2,N1) + 2-AMIN1(0.0,RNXFXS(NU(N2,N1),N2,N1)*VLNO3(N3,N2,N1)))) + 3*VLNO3(N6,N5,N4) + RFHPO4=VFLW*AMAX1(0.0,(H2P4H2(N3,N2,N1) + 2-AMIN1(0.0,RH2PXS(NU(N2,N1),N2,N1)*VLPO4(N3,N2,N1)))) + 3*VLPO4(N6,N5,N4) + RFHN4B=VFLW*AMAX1(0.0,(ZN4BH2(N3,N2,N1) + 2-AMIN1(0.0,RN4FXB(NU(N2,N1),N2,N1)*VLNHB(N3,N2,N1)))) + 3*VLNHB(N6,N5,N4) + RFHN3B=VFLW*AMAX1(0.0,(ZN3BH2(N3,N2,N1) + 2-AMIN1(0.0,RN3FXB(NU(N2,N1),N2,N1)*VLNHB(N3,N2,N1)))) + 3*VLNHB(N6,N5,N4) + RFHNOB=VFLW*AMAX1(0.0,(ZNOBH2(N3,N2,N1) + 2-AMIN1(0.0,RNOFXB(NU(N2,N1),N2,N1)*VLNOB(N3,N2,N1)))) + 3*VLNOB(N6,N5,N4) + RFHN2B=VFLW*AMAX1(0.0,(ZN2BH2(N3,N2,N1) + 2-AMIN1(0.0,RNXFXB(NU(N2,N1),N2,N1)*VLNOB(N3,N2,N1)))) + 3*VLNOB(N6,N5,N4) + RFHPOB=VFLW*AMAX1(0.0,(H2PBH2(N3,N2,N1) + 2-AMIN1(0.0,RH2BXB(NU(N2,N1),N2,N1)*VLPOB(N3,N2,N1)))) + 3*VLPOB(N6,N5,N4) +C +C IF NOT IN THE SURFACE LAYER +C + ELSE + DO 9850 K=0,4 + RFHOC(K)=VFLW*AMAX1(0.0,OQCH2(K,N3,N2,N1)) + RFHON(K)=VFLW*AMAX1(0.0,OQNH2(K,N3,N2,N1)) + RFHOP(K)=VFLW*AMAX1(0.0,OQPH2(K,N3,N2,N1)) + RFHOA(K)=VFLW*AMAX1(0.0,OQAH2(K,N3,N2,N1)) +9850 CONTINUE + RFHCOS=VFLW*AMAX1(0.0,CO2SH2(N3,N2,N1)) + RFHCHS=VFLW*AMAX1(0.0,CH4SH2(N3,N2,N1)) + RFHOXS=VFLW*AMAX1(0.0,OXYSH2(N3,N2,N1)) + RFHNGS=VFLW*AMAX1(0.0,Z2GSH2(N3,N2,N1)) + RFHN2S=VFLW*AMAX1(0.0,Z2OSH2(N3,N2,N1)) + RFHHGS=VFLW*AMAX1(0.0,H2GSH2(N3,N2,N1)) + RFHNH4=VFLW*AMAX1(0.0,ZNH4H2(N3,N2,N1))*VLNH4(N6,N5,N4) + RFHNH3=VFLW*AMAX1(0.0,ZNH3H2(N3,N2,N1))*VLNH4(N6,N5,N4) + RFHNO3=VFLW*AMAX1(0.0,ZNO3H2(N3,N2,N1))*VLNO3(N6,N5,N4) + RFHNO2=VFLW*AMAX1(0.0,ZNO2H2(N3,N2,N1))*VLNO3(N6,N5,N4) + RFHPO4=VFLW*AMAX1(0.0,H2P4H2(N3,N2,N1))*VLPO4(N6,N5,N4) + RFHN4B=VFLW*AMAX1(0.0,ZN4BH2(N3,N2,N1))*VLNHB(N6,N5,N4) + RFHN3B=VFLW*AMAX1(0.0,ZN3BH2(N3,N2,N1))*VLNHB(N6,N5,N4) + RFHNOB=VFLW*AMAX1(0.0,ZNOBH2(N3,N2,N1))*VLNOB(N6,N5,N4) + RFHN2B=VFLW*AMAX1(0.0,ZN2BH2(N3,N2,N1))*VLNOB(N6,N5,N4) + RFHPOB=VFLW*AMAX1(0.0,H2PBH2(N3,N2,N1))*VLPOB(N6,N5,N4) + ENDIF + ELSEIF(FLWHM(M,N,N6,N5,N4).LT.0.0)THEN +C +C IF MACROPORE WATER FLUX FROM 'WATSUB' IS FROM ADJACENT TO +C CURRENT GRID CELL THEN CONVECTIVE TRANSPORT IS THE PRODUCT +C OF WATER FLUX AND MACROPORE SOLUTE CONCENTRATIONS IN ADJACENT +C GRID CELL +C + IF(VOLWHM(M,N6,N5,N4).GT.ZEROS(N5,N4))THEN + VFLW=AMIN1(0.0,AMAX1(-XFRX,FLWHM(M,N,N6,N5,N4) + 2/VOLWHM(M,N6,N5,N4))) + ELSE + VFLW=-XFRX + ENDIF + DO 9665 K=0,4 + RFHOC(K)=VFLW*AMAX1(0.0,OQCH2(K,N6,N5,N4)) + RFHON(K)=VFLW*AMAX1(0.0,OQNH2(K,N6,N5,N4)) + RFHOP(K)=VFLW*AMAX1(0.0,OQPH2(K,N6,N5,N4)) + RFHOA(K)=VFLW*AMAX1(0.0,OQAH2(K,N6,N5,N4)) +9665 CONTINUE + RFHCOS=VFLW*AMAX1(0.0,CO2SH2(N6,N5,N4)) + RFHCHS=VFLW*AMAX1(0.0,CH4SH2(N6,N5,N4)) + RFHOXS=VFLW*AMAX1(0.0,OXYSH2(N6,N5,N4)) + RFHNGS=VFLW*AMAX1(0.0,Z2GSH2(N6,N5,N4)) + RFHN2S=VFLW*AMAX1(0.0,Z2OSH2(N6,N5,N4)) + RFHHGS=VFLW*AMAX1(0.0,H2GSH2(N6,N5,N4)) + RFHNH4=VFLW*AMAX1(0.0,ZNH4H2(N6,N5,N4))*VLNH4(N6,N5,N4) + RFHNH3=VFLW*AMAX1(0.0,ZNH3H2(N6,N5,N4))*VLNH4(N6,N5,N4) + RFHNO3=VFLW*AMAX1(0.0,ZNO3H2(N6,N5,N4))*VLNO3(N6,N5,N4) + RFHNO2=VFLW*AMAX1(0.0,ZNO2H2(N6,N5,N4))*VLNO3(N6,N5,N4) + RFHPO4=VFLW*AMAX1(0.0,H2P4H2(N6,N5,N4))*VLPO4(N6,N5,N4) + RFHN4B=VFLW*AMAX1(0.0,ZN4BH2(N6,N5,N4))*VLNHB(N6,N5,N4) + RFHN3B=VFLW*AMAX1(0.0,ZN3BH2(N6,N5,N4))*VLNHB(N6,N5,N4) + RFHNOB=VFLW*AMAX1(0.0,ZNOBH2(N6,N5,N4))*VLNOB(N6,N5,N4) + RFHN2B=VFLW*AMAX1(0.0,ZN2BH2(N6,N5,N4))*VLNOB(N6,N5,N4) + RFHPOB=VFLW*AMAX1(0.0,H2PBH2(N6,N5,N4))*VLPOB(N6,N5,N4) + ELSE +C +C NO MACROPORE FLUX +C + DO 9795 K=0,4 + RFHOC(K)=0.0 + RFHON(K)=0.0 + RFHOP(K)=0.0 + RFHOA(K)=0.0 +9795 CONTINUE + RFHCOS=0.0 + RFHCHS=0.0 + RFHOXS=0.0 + RFHNGS=0.0 + RFHN2S=0.0 + RFHHGS=0.0 + RFHNH4=0.0 + RFHNH3=0.0 + RFHNO3=0.0 + RFHNO2=0.0 + RFHPO4=0.0 + RFHN4B=0.0 + RFHN3B=0.0 + RFHNOB=0.0 + RFHN2B=0.0 + RFHPOB=0.0 + ENDIF +C +C DIFFUSIVE FLUXES OF GASES AND SOLUTES BETWEEN CURRENT AND +C ADJACENT GRID CELL MACROPORES FROM AQUEOUS DIFFUSIVITIES +C AND CONCENTRATION DIFFERENCES +C + IF(VOLWHM(M,N3,N2,N1).GT.THETY(N3,N2,N1)*VOLAH(N3,N2,N1) + 2.AND.VOLWHM(M,N6,N5,N4).GT.THETY(N6,N5,N4)*VOLAH(N6,N5,N4))THEN +C +C MACROPORE CONCENTRATIONS IN CURRENT AND ADJACENT GRID CELLS +C + DO 9790 K=0,4 + COQCH1(K)=AMAX1(0.0,OQCH2(K,N3,N2,N1)/VOLWHM(M,N3,N2,N1)) + COQNH1(K)=AMAX1(0.0,OQNH2(K,N3,N2,N1)/VOLWHM(M,N3,N2,N1)) + COQPH1(K)=AMAX1(0.0,OQPH2(K,N3,N2,N1)/VOLWHM(M,N3,N2,N1)) + COQAH1(K)=AMAX1(0.0,OQAH2(K,N3,N2,N1)/VOLWHM(M,N3,N2,N1)) + COQCH2(K)=AMAX1(0.0,OQCH2(K,N6,N5,N4)/VOLWHM(M,N6,N5,N4)) + COQNH2(K)=AMAX1(0.0,OQNH2(K,N6,N5,N4)/VOLWHM(M,N6,N5,N4)) + COQPH2(K)=AMAX1(0.0,OQPH2(K,N6,N5,N4)/VOLWHM(M,N6,N5,N4)) + COQAH2(K)=AMAX1(0.0,OQAH2(K,N6,N5,N4)/VOLWHM(M,N6,N5,N4)) +9790 CONTINUE + CCO2SH1=AMAX1(0.0,CO2SH2(N3,N2,N1)/VOLWHM(M,N3,N2,N1)) + CCH4SH1=AMAX1(0.0,CH4SH2(N3,N2,N1)/VOLWHM(M,N3,N2,N1)) + COXYSH1=AMAX1(0.0,OXYSH2(N3,N2,N1)/VOLWHM(M,N3,N2,N1)) + CZ2GSH1=AMAX1(0.0,Z2GSH2(N3,N2,N1)/VOLWHM(M,N3,N2,N1)) + CZ2OSH1=AMAX1(0.0,Z2OSH2(N3,N2,N1)/VOLWHM(M,N3,N2,N1)) + CH2GSH1=AMAX1(0.0,H2GSH2(N3,N2,N1)/VOLWHM(M,N3,N2,N1)) + IF(VOLH4A.GT.ZEROS(N2,N1))THEN + CNH4SH1=AMAX1(0.0,ZNH4H2(N3,N2,N1)/VOLH4A) + CNH3SH1=AMAX1(0.0,ZNH3H2(N3,N2,N1)/VOLH4A) + ELSE + CNH4SH1=0.0 + CNH3SH1=0.0 + ENDIF + IF(VOLH3A.GT.ZEROS(N2,N1))THEN + CNO3SH1=AMAX1(0.0,ZNO3H2(N3,N2,N1)/VOLH3A) + CNO2SH1=AMAX1(0.0,ZNO2H2(N3,N2,N1)/VOLH3A) + ELSE + CNO3SH1=0.0 + CNO2SH1=0.0 + ENDIF + IF(VOLH2A.GT.ZEROS(N2,N1))THEN + CPO4SH1=AMAX1(0.0,H2P4H2(N3,N2,N1)/VOLH2A) + ELSE + CPO4SH1=0.0 + ENDIF + IF(VOLH4B.GT.ZEROS(N2,N1))THEN + CNH4BH1=AMAX1(0.0,ZN4BH2(N3,N2,N1)/VOLH4B) + CNH3BH1=AMAX1(0.0,ZN3BH2(N3,N2,N1)/VOLH4B) + ELSE + CNH4BH1=CNH4SH1 + CNH3BH1=CNH3SH1 + ENDIF + IF(VOLH3B.GT.ZEROS(N2,N1))THEN + CNO3BH1=AMAX1(0.0,ZNOBH2(N3,N2,N1)/VOLH3B) + CNO2BH1=AMAX1(0.0,ZN2BH2(N3,N2,N1)/VOLH3B) + ELSE + CNO3BH1=CNO3SH1 + CNO2BH1=CNO2SH1 + ENDIF + IF(VOLH2B.GT.ZEROS(N2,N1))THEN + CPO4BH1=AMAX1(0.0,H2PBH2(N3,N2,N1)/VOLH2B) + ELSE + CPO4BH1=CPO4SH1 + ENDIF + CCO2SH2=AMAX1(0.0,CO2SH2(N6,N5,N4)/VOLWHM(M,N6,N5,N4)) + CCH4SH2=AMAX1(0.0,CH4SH2(N6,N5,N4)/VOLWHM(M,N6,N5,N4)) + COXYSH2=AMAX1(0.0,OXYSH2(N6,N5,N4)/VOLWHM(M,N6,N5,N4)) + CZ2GSH2=AMAX1(0.0,Z2GSH2(N6,N5,N4)/VOLWHM(M,N6,N5,N4)) + CZ2OSH2=AMAX1(0.0,Z2OSH2(N6,N5,N4)/VOLWHM(M,N6,N5,N4)) + CH2GSH2=AMAX1(0.0,H2GSH2(N6,N5,N4)/VOLWHM(M,N6,N5,N4)) + VOLHMA=VOLWHM(M,N6,N5,N4)*VLNH4(N6,N5,N4) + IF(VOLHMA.GT.ZEROS(N5,N4))THEN + CNH4SH2=AMAX1(0.0,ZNH4H2(N6,N5,N4)/VOLHMA) + CNH3SH2=AMAX1(0.0,ZNH3H2(N6,N5,N4)/VOLHMA) + ELSE + CNH4SH2=0.0 + CNH3SH2=0.0 + ENDIF + VOLHOA=VOLWHM(M,N6,N5,N4)*VLNO3(N6,N5,N4) + IF(VOLHOA.GT.ZEROS(N5,N4))THEN + CNO3SH2=AMAX1(0.0,ZNO3H2(N6,N5,N4)/VOLHOA) + CNO2SH2=AMAX1(0.0,ZNO2H2(N6,N5,N4)/VOLHOA) + ELSE + CNO3SH2=0.0 + CNO2SH2=0.0 + ENDIF + VOLHPA=VOLWHM(M,N6,N5,N4)*VLPO4(N6,N5,N4) + IF(VOLHPA.GT.ZEROS(N5,N4))THEN + CPO4SH2=AMAX1(0.0,H2P4H2(N6,N5,N4)/VOLHPA) + ELSE + CPO4SH2=0.0 + ENDIF + VOLHMB=VOLWHM(M,N6,N5,N4)*VLNHB(N6,N5,N4) + IF(VOLHMB.GT.ZEROS(N5,N4))THEN + CNH4BH2=AMAX1(0.0,ZN4BH2(N6,N5,N4)/VOLHMB) + CNH3BH2=AMAX1(0.0,ZN3BH2(N6,N5,N4)/VOLHMB) + ELSE + CNH4BH2=CNH4SH2 + CNH3BH2=CNH3SH2 + ENDIF + VOLHOB=VOLWHM(M,N6,N5,N4)*VLNOB(N6,N5,N4) + IF(VOLHOB.GT.ZEROS(N5,N4))THEN + CNO3BH2=AMAX1(0.0,ZNOBH2(N6,N5,N4)/VOLHOB) + CNO2BH2=AMAX1(0.0,ZN2BH2(N6,N5,N4)/VOLHOB) + ELSE + CNO3BH2=CNO3SH2 + CNO2BH2=CNO2SH2 + ENDIF + VOLHPB=VOLWHM(M,N6,N5,N4)*VLPOB(N6,N5,N4) + IF(VOLHPB.GT.ZEROS(N5,N4))THEN + CPO4BH2=AMAX1(0.0,H2PBH2(N6,N5,N4)/VOLHPB) + ELSE + CPO4BH2=CPO4SH2 + ENDIF +C +C DIFFUSIVITIES IN CURRENT AND ADJACENT GRID CELL MACROPORES +C + TORTL=(TORTH(M,N3,N2,N1)*DLYR(N,N3,N2,N1) + 2+TORTH(M,N6,N5,N4)*DLYR(N,N6,N5,N4)) + 3/(DLYR(N,N3,N2,N1)+DLYR(N,N6,N5,N4)) + DISPN=DISP(N,N6,N5,N4)*ABS(FLWHM(M,N,N6,N5,N4)/AREA(N,N6,N5,N4)) + DIFOC=(OCSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFON=(ONSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFOP=(OPSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFOA=(OASGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFNH=(ZNSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFNO=(ZOSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFPO=(POSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFCS=(CLSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFCQ=(CQSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFOS=(OLSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFNG=(ZLSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFN2=(ZVSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFHG=(HLSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) +C +C DIFFUSIVE FLUXES BETWEEN CURRENT AND ADJACENT GRID CELL +C MACROPORES +C + DO 9785 K=0,4 + DFHOC(K)=DIFOC*(COQCH1(K)-COQCH2(K)) + DFHON(K)=DIFON*(COQNH1(K)-COQNH2(K)) + DFHOP(K)=DIFOP*(COQPH1(K)-COQPH2(K)) + DFHOA(K)=DIFOA*(COQAH1(K)-COQAH2(K)) +C WRITE(*,2121)'DFHOC',I,J,M,N4,N5,N6,K,DFHOC(K),OQCH2(K,N3,N2,N1) +C 2,OQCH2(K,N6,N5,N4),DIFOC,COQCH1(K),COQCH2(K) +2121 FORMAT(A8,7I4,20E12.4) +9785 CONTINUE + DFHCOS=DIFCS*(CCO2SH1-CCO2SH2) + DFHCHS=DIFCQ*(CCH4SH1-CCH4SH2) + DFHOXS=DIFOS*(COXYSH1-COXYSH2) + DFHNGS=DIFNG*(CZ2GSH1-CZ2GSH2) + DFHN2S=DIFN2*(CZ2OSH1-CZ2OSH2) + DFHHGS=DIFNH*(CH2GSH1-CH2GSH2) + DFHNH4=DIFNH*(CNH4SH1-CNH4SH2)*AMIN1(VLNH4(N3,N2,N1) + 2,VLNH4(N6,N5,N4)) + DFHNH3=DIFNH*(CNH3SH1-CNH3SH2)*AMIN1(VLNH4(N3,N2,N1) + 2,VLNH4(N6,N5,N4)) + DFHNO3=DIFNO*(CNO3SH1-CNO3SH2)*AMIN1(VLNO3(N3,N2,N1) + 2,VLNO3(N6,N5,N4)) + DFHNO2=DIFNO*(CNO2SH1-CNO2SH2)*AMIN1(VLNO3(N3,N2,N1) + 2,VLNO3(N6,N5,N4)) + DFHPO4=DIFPO*(CPO4SH1-CPO4SH2)*AMIN1(VLPO4(N3,N2,N1) + 2,VLPO4(N6,N5,N4)) + DFHN4B=DIFNH*(CNH4BH1-CNH4BH2)*AMIN1(VLNHB(N3,N2,N1) + 2,VLNHB(N6,N5,N4)) + DFHN3B=DIFNH*(CNH3BH1-CNH3BH2)*AMIN1(VLNHB(N3,N2,N1) + 2,VLNHB(N6,N5,N4)) + DFHNOB=DIFNO*(CNO3BH1-CNO3BH2)*AMIN1(VLNOB(N3,N2,N1) + 2,VLNOB(N6,N5,N4)) + DFHN2B=DIFNO*(CNO2BH1-CNO2BH2)*AMIN1(VLNOB(N3,N2,N1) + 2,VLNOB(N6,N5,N4)) + DFHPOB=DIFPO*(CPO4BH1-CPO4BH2)*AMIN1(VLPOB(N3,N2,N1) + 2,VLPOB(N6,N5,N4)) + ELSE + DO 9780 K=0,4 + DFHOC(K)=0.0 + DFHON(K)=0.0 + DFHOP(K)=0.0 + DFHOA(K)=0.0 +9780 CONTINUE + DFHCOS=0.0 + DFHCHS=0.0 + DFHOXS=0.0 + DFHNGS=0.0 + DFHN2S=0.0 + DFHHGS=0.0 + DFHNH4=0.0 + DFHNH3=0.0 + DFHNO3=0.0 + DFHNO2=0.0 + DFHPO4=0.0 + DFHN4B=0.0 + DFHN3B=0.0 + DFHNOB=0.0 + DFHN2B=0.0 + DFHPOB=0.0 + ENDIF +C +C TOTAL MICROPORE AND MACROPORE SOLUTE TRANSPORT FLUXES BETWEEN +C ADJACENT GRID CELLS = CONVECTIVE + DIFFUSIVE FLUXES +C + DO 9765 K=0,4 + ROCFLS(K,N,N6,N5,N4)=RFLOC(K)+DFVOC(K) + RONFLS(K,N,N6,N5,N4)=RFLON(K)+DFVON(K) + ROPFLS(K,N,N6,N5,N4)=RFLOP(K)+DFVOP(K) + ROAFLS(K,N,N6,N5,N4)=RFLOA(K)+DFVOA(K) + ROCFHS(K,N,N6,N5,N4)=RFHOC(K)+DFHOC(K) + RONFHS(K,N,N6,N5,N4)=RFHON(K)+DFHON(K) + ROPFHS(K,N,N6,N5,N4)=RFHOP(K)+DFHOP(K) + ROAFHS(K,N,N6,N5,N4)=RFHOA(K)+DFHOA(K) +9765 CONTINUE + RCOFLS(N,N6,N5,N4)=RFLCOS+DFVCOS + RCHFLS(N,N6,N5,N4)=RFLCHS+DFVCHS + ROXFLS(N,N6,N5,N4)=RFLOXS+DFVOXS + RNGFLS(N,N6,N5,N4)=RFLNGS+DFVNGS + RN2FLS(N,N6,N5,N4)=RFLN2S+DFVN2S + RHGFLS(N,N6,N5,N4)=RFLHGS+DFVHGS + RN4FLW(N,N6,N5,N4)=RFLNH4+DFVNH4 + RN3FLW(N,N6,N5,N4)=RFLNH3+DFVNH3 + RNOFLW(N,N6,N5,N4)=RFLNO3+DFVNO3 + RNXFLS(N,N6,N5,N4)=RFLNO2+DFVNO2 + RH2PFS(N,N6,N5,N4)=RFLPO4+DFVPO4 + RN4FLB(N,N6,N5,N4)=RFLN4B+DFVN4B + RN3FLB(N,N6,N5,N4)=RFLN3B+DFVN3B + RNOFLB(N,N6,N5,N4)=RFLNOB+DFVNOB + RNXFLB(N,N6,N5,N4)=RFLN2B+DFVN2B + RH2BFB(N,N6,N5,N4)=RFLPOB+DFVPOB + RCOFHS(N,N6,N5,N4)=RFHCOS+DFHCOS + RCHFHS(N,N6,N5,N4)=RFHCHS+DFHCHS + ROXFHS(N,N6,N5,N4)=RFHOXS+DFHOXS + RNGFHS(N,N6,N5,N4)=RFHNGS+DFHNGS + RN2FHS(N,N6,N5,N4)=RFHN2S+DFHN2S + RHGFHS(N,N6,N5,N4)=RFHHGS+DFHHGS + RN4FHW(N,N6,N5,N4)=RFHNH4+DFHNH4 + RN3FHW(N,N6,N5,N4)=RFHNH3+DFHNH3 + RNOFHW(N,N6,N5,N4)=RFHNO3+DFHNO3 + RNXFHS(N,N6,N5,N4)=RFHNO2+DFHNO2 + RH2PHS(N,N6,N5,N4)=RFHPO4+DFHPO4 + RN4FHB(N,N6,N5,N4)=RFHN4B+DFHN4B + RN3FHB(N,N6,N5,N4)=RFHN3B+DFHN3B + RNOFHB(N,N6,N5,N4)=RFHNOB+DFHNOB + RNXFHB(N,N6,N5,N4)=RFHN2B+DFHN2B + RH2BHB(N,N6,N5,N4)=RFHPOB+DFHPOB +C IF(M.NE.MX.AND.I.GE.180.AND.I.LE.200)THEN +C WRITE(*,443)'DFVCO2',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)'RH2PFS',I,J,N4,N5,N6,M,MM,N +C 2,RH2PFS(N,N6,N5,N4),RFLPO4,DFVPO4,DIFPO,CPO4S1,CPO4S2 +C 3,VLPO4(N3,N2,N1),VLPO4(N6,N5,N4),VOLW2A,VOLWPA +C 4,H2PO42(N3,N2,N1),H2PO42(N6,N5,N4) +443 FORMAT(A8,8I4,20E12.4) +C ENDIF +C +C ACCUMULATE HOURLY FLUXES +C + DO 9755 K=0,4 + XOCFLS(K,N,N6,N5,N4)=XOCFLS(K,N,N6,N5,N4)+ROCFLS(K,N,N6,N5,N4) + XONFLS(K,N,N6,N5,N4)=XONFLS(K,N,N6,N5,N4)+RONFLS(K,N,N6,N5,N4) + XOPFLS(K,N,N6,N5,N4)=XOPFLS(K,N,N6,N5,N4)+ROPFLS(K,N,N6,N5,N4) + XOAFLS(K,N,N6,N5,N4)=XOAFLS(K,N,N6,N5,N4)+ROAFLS(K,N,N6,N5,N4) + XOCFHS(K,N,N6,N5,N4)=XOCFHS(K,N,N6,N5,N4)+ROCFHS(K,N,N6,N5,N4) + XONFHS(K,N,N6,N5,N4)=XONFHS(K,N,N6,N5,N4)+RONFHS(K,N,N6,N5,N4) + XOPFHS(K,N,N6,N5,N4)=XOPFHS(K,N,N6,N5,N4)+ROPFHS(K,N,N6,N5,N4) + XOAFHS(K,N,N6,N5,N4)=XOAFHS(K,N,N6,N5,N4)+ROAFHS(K,N,N6,N5,N4) +9755 CONTINUE + XCOFLS(N,N6,N5,N4)=XCOFLS(N,N6,N5,N4)+RCOFLS(N,N6,N5,N4) + XCHFLS(N,N6,N5,N4)=XCHFLS(N,N6,N5,N4)+RCHFLS(N,N6,N5,N4) + XOXFLS(N,N6,N5,N4)=XOXFLS(N,N6,N5,N4)+ROXFLS(N,N6,N5,N4) + XNGFLS(N,N6,N5,N4)=XNGFLS(N,N6,N5,N4)+RNGFLS(N,N6,N5,N4) + XN2FLS(N,N6,N5,N4)=XN2FLS(N,N6,N5,N4)+RN2FLS(N,N6,N5,N4) + XHGFLS(N,N6,N5,N4)=XHGFLS(N,N6,N5,N4)+RHGFLS(N,N6,N5,N4) + XN4FLW(N,N6,N5,N4)=XN4FLW(N,N6,N5,N4)+RN4FLW(N,N6,N5,N4) + XN3FLW(N,N6,N5,N4)=XN3FLW(N,N6,N5,N4)+RN3FLW(N,N6,N5,N4) + XNOFLW(N,N6,N5,N4)=XNOFLW(N,N6,N5,N4)+RNOFLW(N,N6,N5,N4) + XNXFLS(N,N6,N5,N4)=XNXFLS(N,N6,N5,N4)+RNXFLS(N,N6,N5,N4) + XH2PFS(N,N6,N5,N4)=XH2PFS(N,N6,N5,N4)+RH2PFS(N,N6,N5,N4) + XN4FLB(N,N6,N5,N4)=XN4FLB(N,N6,N5,N4)+RN4FLB(N,N6,N5,N4) + XN3FLB(N,N6,N5,N4)=XN3FLB(N,N6,N5,N4)+RN3FLB(N,N6,N5,N4) + XNOFLB(N,N6,N5,N4)=XNOFLB(N,N6,N5,N4)+RNOFLB(N,N6,N5,N4) + XNXFLB(N,N6,N5,N4)=XNXFLB(N,N6,N5,N4)+RNXFLB(N,N6,N5,N4) + XH2BFB(N,N6,N5,N4)=XH2BFB(N,N6,N5,N4)+RH2BFB(N,N6,N5,N4) + XCOFHS(N,N6,N5,N4)=XCOFHS(N,N6,N5,N4)+RCOFHS(N,N6,N5,N4) + XCHFHS(N,N6,N5,N4)=XCHFHS(N,N6,N5,N4)+RCHFHS(N,N6,N5,N4) + XOXFHS(N,N6,N5,N4)=XOXFHS(N,N6,N5,N4)+ROXFHS(N,N6,N5,N4) + XNGFHS(N,N6,N5,N4)=XNGFHS(N,N6,N5,N4)+RNGFHS(N,N6,N5,N4) + XN2FHS(N,N6,N5,N4)=XN2FHS(N,N6,N5,N4)+RN2FHS(N,N6,N5,N4) + XHGFHS(N,N6,N5,N4)=XHGFHS(N,N6,N5,N4)+RHGFHS(N,N6,N5,N4) + XN4FHW(N,N6,N5,N4)=XN4FHW(N,N6,N5,N4)+RN4FHW(N,N6,N5,N4) + XN3FHW(N,N6,N5,N4)=XN3FHW(N,N6,N5,N4)+RN3FHW(N,N6,N5,N4) + XNOFHW(N,N6,N5,N4)=XNOFHW(N,N6,N5,N4)+RNOFHW(N,N6,N5,N4) + XNXFHS(N,N6,N5,N4)=XNXFHS(N,N6,N5,N4)+RNXFHS(N,N6,N5,N4) + XH2PHS(N,N6,N5,N4)=XH2PHS(N,N6,N5,N4)+RH2PHS(N,N6,N5,N4) + XN4FHB(N,N6,N5,N4)=XN4FHB(N,N6,N5,N4)+RN4FHB(N,N6,N5,N4) + XN3FHB(N,N6,N5,N4)=XN3FHB(N,N6,N5,N4)+RN3FHB(N,N6,N5,N4) + XNOFHB(N,N6,N5,N4)=XNOFHB(N,N6,N5,N4)+RNOFHB(N,N6,N5,N4) + XNXFHB(N,N6,N5,N4)=XNXFHB(N,N6,N5,N4)+RNXFHB(N,N6,N5,N4) + XH2BHB(N,N6,N5,N4)=XH2BHB(N,N6,N5,N4)+RH2BHB(N,N6,N5,N4) +C +C MACROPORE-MICROPORE SOLUTE EXCHANGE WITHIN SOIL +C LAYER FROM WATER EXCHANGE IN 'WATSUB' AND +C FROM MACROPORE OR MICROPORE SOLUTE CONCENTRATIONS +C + IF(N.EQ.3)THEN +C +C MACROPORE TO MICROPORE TRANSFER +C + IF(FINHM(M,N6,N5,N4).GT.0.0)THEN + IF(VOLWHM(M,N6,N5,N4).GT.ZEROS(N5,N4))THEN + VFLW=AMAX1(0.0,AMIN1(XFRX,FINHM(M,N6,N5,N4) + 2/VOLWHM(M,N6,N5,N4))) + ELSE + VFLW=XFRX + ENDIF + DO 9970 K=0,4 + RFLOC(K)=VFLW*AMAX1(0.0,OQCH2(K,N6,N5,N4)) + RFLON(K)=VFLW*AMAX1(0.0,OQNH2(K,N6,N5,N4)) + RFLOP(K)=VFLW*AMAX1(0.0,OQPH2(K,N6,N5,N4)) + RFLOA(K)=VFLW*AMAX1(0.0,OQAH2(K,N6,N5,N4)) +9970 CONTINUE + RFLCOS=VFLW*AMAX1(0.0,CO2SH2(N6,N5,N4)) + RFLCHS=VFLW*AMAX1(0.0,CH4SH2(N6,N5,N4)) + RFLOXS=VFLW*AMAX1(0.0,OXYSH2(N6,N5,N4)) + RFLNGS=VFLW*AMAX1(0.0,Z2GSH2(N6,N5,N4)) + RFLN2S=VFLW*AMAX1(0.0,Z2OSH2(N6,N5,N4)) + RFLHGS=VFLW*AMAX1(0.0,H2GSH2(N6,N5,N4)) + RFLNH4=VFLW*AMAX1(0.0,ZNH4H2(N6,N5,N4))*VLNH4(N6,N5,N4) + RFLNH3=VFLW*AMAX1(0.0,ZNH3H2(N6,N5,N4))*VLNH4(N6,N5,N4) + RFLNO3=VFLW*AMAX1(0.0,ZNO3H2(N6,N5,N4))*VLNO3(N6,N5,N4) + RFLNO2=VFLW*AMAX1(0.0,ZNO2H2(N6,N5,N4))*VLNO3(N6,N5,N4) + RFLPO4=VFLW*AMAX1(0.0,H2P4H2(N6,N5,N4))*VLPO4(N6,N5,N4) + RFLN4B=VFLW*AMAX1(0.0,ZN4BH2(N6,N5,N4))*VLNHB(N6,N5,N4) + RFLN3B=VFLW*AMAX1(0.0,ZN3BH2(N6,N5,N4))*VLNHB(N6,N5,N4) + RFLNOB=VFLW*AMAX1(0.0,ZNOBH2(N6,N5,N4))*VLNOB(N6,N5,N4) + RFLN2B=VFLW*AMAX1(0.0,ZN2BH2(N6,N5,N4))*VLNOB(N6,N5,N4) + RFLPOB=VFLW*AMAX1(0.0,H2PBH2(N6,N5,N4))*VLPOB(N6,N5,N4) +C +C MICROPORE TO MACROPORE TRANSFER +C + ELSEIF(FINHM(M,N6,N5,N4).LT.0.0)THEN + IF(VOLWM(M,N6,N5,N4).GT.ZEROS(N5,N4))THEN + VFLW=AMIN1(0.0,AMAX1(-XFRX,FINHM(M,N6,N5,N4) + 2/VOLWM(M,N6,N5,N4))) + ELSE + VFLW=-XFRX + ENDIF + DO 9965 K=0,4 + RFLOC(K)=VFLW*AMAX1(0.0,OQC2(K,N6,N5,N4)) + RFLON(K)=VFLW*AMAX1(0.0,OQN2(K,N6,N5,N4)) + RFLOP(K)=VFLW*AMAX1(0.0,OQP2(K,N6,N5,N4)) + RFLOA(K)=VFLW*AMAX1(0.0,OQA2(K,N6,N5,N4)) +9965 CONTINUE + RFLCOS=VFLW*AMAX1(0.0,CO2S2(N6,N5,N4)) + RFLCHS=VFLW*AMAX1(0.0,CH4S2(N6,N5,N4)) + RFLOXS=VFLW*AMAX1(0.0,OXYS2(N6,N5,N4)) + RFLNGS=VFLW*AMAX1(0.0,Z2GS2(N6,N5,N4)) + RFLN2S=VFLW*AMAX1(0.0,Z2OS2(N6,N5,N4)) + RFLHGS=VFLW*AMAX1(0.0,H2GS2(N6,N5,N4)) + RFLNH4=VFLW*AMAX1(0.0,ZNH4S2(N6,N5,N4))*VLNH4(N6,N5,N4) + RFLNH3=VFLW*AMAX1(0.0,ZN3S2(N6,N5,N4))*VLNH4(N6,N5,N4) + RFLNO3=VFLW*AMAX1(0.0,ZNO3S2(N6,N5,N4))*VLNO3(N6,N5,N4) + RFLNO2=VFLW*AMAX1(0.0,ZNO2S2(N6,N5,N4))*VLNO3(N6,N5,N4) + RFLPO4=VFLW*AMAX1(0.0,H2PO42(N6,N5,N4))*VLPO4(N6,N5,N4) + RFLN4B=VFLW*AMAX1(0.0,ZNH4B2(N6,N5,N4))*VLNHB(N6,N5,N4) + RFLN3B=VFLW*AMAX1(0.0,ZNBS2(N6,N5,N4))*VLNHB(N6,N5,N4) + RFLNOB=VFLW*AMAX1(0.0,ZNO3B2(N6,N5,N4))*VLNOB(N6,N5,N4) + RFLN2B=VFLW*AMAX1(0.0,ZNO2B2(N6,N5,N4))*VLNOB(N6,N5,N4) + RFLPOB=VFLW*AMAX1(0.0,H2POB2(N6,N5,N4))*VLPOB(N6,N5,N4) +C +C NO MACROPORE TO MICROPORE TRANSFER +C + ELSE + DO 9960 K=0,4 + RFLOC(K)=0.0 + RFLON(K)=0.0 + RFLOP(K)=0.0 + RFLOA(K)=0.0 +9960 CONTINUE + RFLCOS=0.0 + RFLCHS=0.0 + RFLOXS=0.0 + RFLNGS=0.0 + RFLN2S=0.0 + RFLHGS=0.0 + RFLNH4=0.0 + RFLNH3=0.0 + RFLNO3=0.0 + RFLNO2=0.0 + RFLPO4=0.0 + RFLN4B=0.0 + RFLN3B=0.0 + RFLNOB=0.0 + RFLN2B=0.0 + RFLPOB=0.0 + ENDIF +C +C DIFFUSIVE FLUXES OF SOLUTES BETWEEN MICROPORES AND +C MACROPORES FROM AQUEOUS DIFFUSIVITIES AND CONCENTRATION 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*(OQCH2(K,N6,N5,N4)*VOLWM(M,N6,N5,N4) + 2-OQC2(K,N6,N5,N4)*VOLWHS)/VOLWT + DFVON(K)=XNPX*(OQNH2(K,N6,N5,N4)*VOLWM(M,N6,N5,N4) + 2-OQN2(K,N6,N5,N4)*VOLWHS)/VOLWT + DFVOP(K)=XNPX*(OQPH2(K,N6,N5,N4)*VOLWM(M,N6,N5,N4) + 2-OQP2(K,N6,N5,N4)*VOLWHS)/VOLWT + DFVOA(K)=XNPX*(OQAH2(K,N6,N5,N4)*VOLWM(M,N6,N5,N4) + 2-OQA2(K,N6,N5,N4)*VOLWHS)/VOLWT +9955 CONTINUE + DFVCOS=XNPX*(CO2SH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) + 2-CO2S2(N6,N5,N4)*VOLWHS)/VOLWT + DFVCHS=XNPX*(CH4SH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) + 2-CH4S2(N6,N5,N4)*VOLWHS)/VOLWT + DFVOXS=XNPX*(OXYSH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) + 2-OXYS2(N6,N5,N4)*VOLWHS)/VOLWT + DFVNGS=XNPX*(Z2GSH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) + 2-Z2GS2(N6,N5,N4)*VOLWHS)/VOLWT + DFVN2S=XNPX*(Z2OSH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) + 2-Z2OS2(N6,N5,N4)*VOLWHS)/VOLWT + DFVHGS=XNPX*(H2GSH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) + 2-H2GS2(N6,N5,N4)*VOLWHS)/VOLWT + DFVNH4=XNPX*(ZNH4H2(N6,N5,N4)*VOLWM(M,N6,N5,N4) + 2-ZNH4S2(N6,N5,N4)*VOLWHS)/VOLWT + 3*VLNH4(N6,N5,N4) + DFVNH3=XNPX*(ZNH3H2(N6,N5,N4)*VOLWM(M,N6,N5,N4) + 2-ZN3S2(N6,N5,N4)*VOLWHS)/VOLWT + 3*VLNH4(N6,N5,N4) + DFVNO3=XNPX*(ZNO3H2(N6,N5,N4)*VOLWM(M,N6,N5,N4) + 2-ZNO3S2(N6,N5,N4)*VOLWHS)/VOLWT + 3*VLNO3(N6,N5,N4) + DFVNO2=XNPX*(ZNO2H2(N6,N5,N4)*VOLWM(M,N6,N5,N4) + 2-ZNO2S2(N6,N5,N4)*VOLWHS)/VOLWT + 3*VLNO3(N6,N5,N4) + DFVPO4=XNPX*(H2P4H2(N6,N5,N4)*VOLWM(M,N6,N5,N4) + 2-H2PO42(N6,N5,N4)*VOLWHS)/VOLWT + 3*VLPO4(N6,N5,N4) + DFVN4B=XNPX*(ZN4BH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) + 2-ZNH4B2(N6,N5,N4)*VOLWHS)/VOLWT + 3*VLNHB(N6,N5,N4) + DFVN3B=XNPX*(ZN3BH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) + 2-ZNBS2(N6,N5,N4)*VOLWHS)/VOLWT + 3*VLNHB(N6,N5,N4) + DFVNOB=XNPX*(ZNOBH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) + 2-ZNO3B2(N6,N5,N4)*VOLWHS)/VOLWT + 3*VLNOB(N6,N5,N4) + DFVN2B=XNPX*(ZN2BH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) + 2-ZNO2B2(N6,N5,N4)*VOLWHS)/VOLWT + 3*VLNOB(N6,N5,N4) + DFVPOB=XNPX*(H2PBH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) + 2-H2POB2(N6,N5,N4)*VOLWHS)/VOLWT + 3*VLPOB(N6,N5,N4) + ELSE + DO 9975 K=0,2 + DFVOC(K)=0.0 + DFVON(K)=0.0 + DFVOP(K)=0.0 + DFVOA(K)=0.0 +9975 CONTINUE + DFVCOS=0.0 + DFVCHS=0.0 + DFVOXS=0.0 + DFVNGS=0.0 + DFVN2S=0.0 + DFVHGS=0.0 + DFVNH4=0.0 + DFVNH3=0.0 + DFVNO3=0.0 + DFVNO2=0.0 + DFVPO4=0.0 + DFVN4B=0.0 + DFVN3B=0.0 + DFVNOB=0.0 + DFVN2B=0.0 + DFVPOB=0.0 + ENDIF +C +C TOTAL CONVECTIVE +DIFFUSIVE TRANSFER BETWEEN MACROPOES AND MICROPORES +C + DO 9950 K=0,4 + ROCFXS(K,N6,N5,N4)=RFLOC(K)+DFVOC(K) + 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 + ROXFXS(N6,N5,N4)=RFLOXS+DFVOXS + RNGFXS(N6,N5,N4)=RFLNGS+DFVNGS + RN2FXS(N6,N5,N4)=RFLN2S+DFVN2S + RHGFXS(N6,N5,N4)=RFLHGS+DFVHGS + RN4FXW(N6,N5,N4)=RFLNH4+DFVNH4 + RN3FXW(N6,N5,N4)=RFLNH3+DFVNH3 + RNOFXW(N6,N5,N4)=RFLNO3+DFVNO3 + RNXFXS(N6,N5,N4)=RFLNO2+DFVNO2 + RH2PXS(N6,N5,N4)=RFLPO4+DFVPO4 + RN4FXB(N6,N5,N4)=RFLN4B+DFVN4B + RN3FXB(N6,N5,N4)=RFLN3B+DFVN3B + RNOFXB(N6,N5,N4)=RFLNOB+DFVNOB + RNXFXB(N6,N5,N4)=RFLN2B+DFVN2B + RH2BXB(N6,N5,N4)=RFLPOB+DFVPOB +C +C ACCUMULATE HOURLY FLUXES +C + DO 9945 K=0,4 + XOCFXS(K,N6,N5,N4)=XOCFXS(K,N6,N5,N4)+ROCFXS(K,N6,N5,N4) + XONFXS(K,N6,N5,N4)=XONFXS(K,N6,N5,N4)+RONFXS(K,N6,N5,N4) + XOPFXS(K,N6,N5,N4)=XOPFXS(K,N6,N5,N4)+ROPFXS(K,N6,N5,N4) + XOAFXS(K,N6,N5,N4)=XOAFXS(K,N6,N5,N4)+ROAFXS(K,N6,N5,N4) +9945 CONTINUE + XCOFXS(N6,N5,N4)=XCOFXS(N6,N5,N4)+RCOFXS(N6,N5,N4) + XCHFXS(N6,N5,N4)=XCHFXS(N6,N5,N4)+RCHFXS(N6,N5,N4) + XOXFXS(N6,N5,N4)=XOXFXS(N6,N5,N4)+ROXFXS(N6,N5,N4) + XNGFXS(N6,N5,N4)=XNGFXS(N6,N5,N4)+RNGFXS(N6,N5,N4) + XN2FXS(N6,N5,N4)=XN2FXS(N6,N5,N4)+RN2FXS(N6,N5,N4) + XHGFXS(N6,N5,N4)=XHGFXS(N6,N5,N4)+RHGFXS(N6,N5,N4) + XN4FXW(N6,N5,N4)=XN4FXW(N6,N5,N4)+RN4FXW(N6,N5,N4) + XN3FXW(N6,N5,N4)=XN3FXW(N6,N5,N4)+RN3FXW(N6,N5,N4) + XNOFXW(N6,N5,N4)=XNOFXW(N6,N5,N4)+RNOFXW(N6,N5,N4) + XNXFXS(N6,N5,N4)=XNXFXS(N6,N5,N4)+RNXFXS(N6,N5,N4) + XH2PXS(N6,N5,N4)=XH2PXS(N6,N5,N4)+RH2PXS(N6,N5,N4) + XN4FXB(N6,N5,N4)=XN4FXB(N6,N5,N4)+RN4FXB(N6,N5,N4) + XN3FXB(N6,N5,N4)=XN3FXB(N6,N5,N4)+RN3FXB(N6,N5,N4) + XNOFXB(N6,N5,N4)=XNOFXB(N6,N5,N4)+RNOFXB(N6,N5,N4) + XNXFXB(N6,N5,N4)=XNXFXB(N6,N5,N4)+RNXFXB(N6,N5,N4) + XH2BXB(N6,N5,N4)=XH2BXB(N6,N5,N4)+RH2BXB(N6,N5,N4) + ENDIF + ENDIF +C +C GASEOUS TRANSPORT FROM GASEOUS DIFFUSIVITY AND CONCENTRATION +C DIFFERENCES BETWEEN ADJACENT GRID CELLS +C +C +C GASEOUS DIFFUSIVITIES +C + IF(THETPM(M,N3,N2,N1).GT.THETX + 2.AND.THETPM(M,N6,N5,N4).GT.THETX + 3.AND.VOLPM(M,N3,N2,N1).GT.ZEROS(N2,N1) + 4.AND.VOLPM(M,N6,N5,N4).GT.ZEROS(N5,N4))THEN + DFLG2=2.0*AMAX1(0.0,THETPM(M,N3,N2,N1))**2/POROQ(N3,N2,N1) + 2*AREA(N,N3,N2,N1)/DLYR(N,N3,N2,N1) + DFLGL=2.0*AMAX1(0.0,THETPM(M,N6,N5,N4))**2/POROQ(N6,N5,N4) + 2*AREA(N,N6,N5,N4)/DLYR(N,N6,N5,N4) + CNDC1=DFLG2*CGSGL2(N3,N2,N1) + CND41=DFLG2*CHSGL2(N3,N2,N1) + CNDO1=DFLG2*OGSGL2(N3,N2,N1) + CNDG1=DFLG2*ZGSGL2(N3,N2,N1) + CND21=DFLG2*Z2SGL2(N3,N2,N1) + CNDH1=DFLG2*ZHSGL2(N3,N2,N1) + CNHG1=DFLG2*HGSGL2(N3,N2,N1) + CNDC2=DFLGL*CGSGL2(N6,N5,N4) + CND42=DFLGL*CHSGL2(N6,N5,N4) + CNDO2=DFLGL*OGSGL2(N6,N5,N4) + CNDG2=DFLGL*ZGSGL2(N6,N5,N4) + CND22=DFLGL*Z2SGL2(N6,N5,N4) + CNDH2=DFLGL*ZHSGL2(N6,N5,N4) + CNHG2=DFLGL*HGSGL2(N6,N5,N4) +C +C GASOUS CONDUCTANCES +C + DCO2G(N,N6,N5,N4)=(CNDC1*CNDC2)/(CNDC1+CNDC2) + DCH4G(N,N6,N5,N4)=(CND41*CND42)/(CND41+CND42) + DOXYG(N,N6,N5,N4)=(CNDO1*CNDO2)/(CNDO1+CNDO2) + DZ2GG(N,N6,N5,N4)=(CNDG1*CNDG2)/(CNDG1+CNDG2) + DZ2OG(N,N6,N5,N4)=(CND21*CND22)/(CND21+CND22) + DNH3G(N,N6,N5,N4)=(CNDH1*CNDH2)/(CNDH1+CNDH2) + DH2GG(N,N6,N5,N4)=(CNHG1*CNHG2)/(CNHG1+CNHG2) +C +C GASEOUS CONCENTRATIONS FROM AIR-FILLED POROSITY +C IN CURRENT AND ADJACENT GRID CELLS +C + CCO2G1=AMAX1(0.0,CO2G2(N3,N2,N1)/VOLPM(M,N3,N2,N1)) + CCH4G1=AMAX1(0.0,CH4G2(N3,N2,N1)/VOLPM(M,N3,N2,N1)) + COXYG1=AMAX1(0.0,OXYG2(N3,N2,N1)/VOLPM(M,N3,N2,N1)) + CZ2GG1=AMAX1(0.0,Z2GG2(N3,N2,N1)/VOLPM(M,N3,N2,N1)) + CZ2OG1=AMAX1(0.0,Z2OG2(N3,N2,N1)/VOLPM(M,N3,N2,N1)) + CNH3G1=AMAX1(0.0,ZN3G2(N3,N2,N1)/VOLPM(M,N3,N2,N1)) + CH2GG1=AMAX1(0.0,H2GG2(N3,N2,N1)/VOLPM(M,N3,N2,N1)) + CCO2G2=AMAX1(0.0,CO2G2(N6,N5,N4)/VOLPM(M,N6,N5,N4)) + CCH4G2=AMAX1(0.0,CH4G2(N6,N5,N4)/VOLPM(M,N6,N5,N4)) + COXYG2=AMAX1(0.0,OXYG2(N6,N5,N4)/VOLPM(M,N6,N5,N4)) + CZ2GG2=AMAX1(0.0,Z2GG2(N6,N5,N4)/VOLPM(M,N6,N5,N4)) + CZ2OG2=AMAX1(0.0,Z2OG2(N6,N5,N4)/VOLPM(M,N6,N5,N4)) + CNH3G2=AMAX1(0.0,ZN3G2(N6,N5,N4)/VOLPM(M,N6,N5,N4)) + CH2GG2=AMAX1(0.0,H2GG2(N6,N5,N4)/VOLPM(M,N6,N5,N4)) +C +C CONVECTIVE GAS TRANSFER DRIVEN BY SOIL WATER FLUXES +C FROM 'WATSUB' AND GAS CONCENTRATIONS IN THE ADJACENT GRID CELLS +C DEPENDING ON WATER FLUX DIRECTION +C + DFVCOG=DCO2G(N,N6,N5,N4)*(CCO2G1-CCO2G2) + DFVCHG=DCH4G(N,N6,N5,N4)*(CCH4G1-CCH4G2) + DFVOXG=DOXYG(N,N6,N5,N4)*(COXYG1-COXYG2) + DFVNGG=DZ2GG(N,N6,N5,N4)*(CZ2GG1-CZ2GG2) + DFVN2G=DZ2OG(N,N6,N5,N4)*(CZ2OG1-CZ2OG2) + DFVN3G=DNH3G(N,N6,N5,N4)*(CNH3G1-CNH3G2) + DFVHGG=DH2GG(N,N6,N5,N4)*(CH2GG1-CH2GG2) + IF(FLQM(N,N6,N5,N4).GT.0.0)THEN + IF(VOLPM(M,N6,N5,N4).GT.ZEROS(N5,N4))THEN + VFLW=-AMAX1(0.0,AMIN1(XFRX,FLQM(N,N6,N5,N4) + 2/VOLPM(M,N6,N5,N4))) + ELSE + VFLW=-XFRX + ENDIF + RFLCOG=VFLW*AMAX1(0.0,CO2G2(N6,N5,N4)) + RFLCHG=VFLW*AMAX1(0.0,CH4G2(N6,N5,N4)) + RFLOXG=VFLW*AMAX1(0.0,OXYG2(N6,N5,N4)) + RFLNGG=VFLW*AMAX1(0.0,Z2GG2(N6,N5,N4)) + RFLN2G=VFLW*AMAX1(0.0,Z2OG2(N6,N5,N4)) + RFLN3G=VFLW*AMAX1(0.0,ZN3G2(N6,N5,N4)) + RFLH2G=VFLW*AMAX1(0.0,H2GG2(N6,N5,N4)) + ELSE + IF(VOLPM(M,N3,N2,N1).GT.ZEROS(N2,N1))THEN + VFLW=-AMIN1(0.0,AMAX1(-XFRX,FLQM(N,N6,N5,N4) + 2/VOLPM(M,N3,N2,N1))) + ELSE + VFLW=XFRX + ENDIF + RFLCOG=VFLW*AMAX1(0.0,CO2G2(N3,N2,N1)) + RFLCHG=VFLW*AMAX1(0.0,CH4G2(N3,N2,N1)) + RFLOXG=VFLW*AMAX1(0.0,OXYG2(N3,N2,N1)) + RFLNGG=VFLW*AMAX1(0.0,Z2GG2(N3,N2,N1)) + RFLN2G=VFLW*AMAX1(0.0,Z2OG2(N3,N2,N1)) + RFLN3G=VFLW*AMAX1(0.0,ZN3G2(N3,N2,N1)) + RFLH2G=VFLW*AMAX1(0.0,H2GG2(N3,N2,N1)) + ENDIF +C +C SOIL GAS FLUX FROM DIFFERENCES +C BETWEEN CURRENT AND EQUILIBRIUM +C CONCENTRATIONS + CONVECTIVE FLUX +C + RCOFLG(N,N6,N5,N4)=DFVCOG+RFLCOG + RCHFLG(N,N6,N5,N4)=DFVCHG+RFLCHG + ROXFLG(N,N6,N5,N4)=DFVOXG+RFLOXG + RNGFLG(N,N6,N5,N4)=DFVNGG+RFLNGG + RN2FLG(N,N6,N5,N4)=DFVN2G+RFLN2G + RN3FLG(N,N6,N5,N4)=DFVN3G+RFLN3G + RHGFLG(N,N6,N5,N4)=DFVHGG+RFLH2G +C IF(I.EQ.43)THEN +C WRITE(*,3133)'ROXFL2',I,J,M,MM,N1,N2,N3,N,XOXFLG(N,N6,N5,N4) +C 2,ROXFLG(N,N6,N5,N4),DFVOXG,RFLOXG,COXYG1,COXYG2 +C 3,OXYG2(N3,N2,N1),OXYG2(N6,N5,N4) +C 4,FLQM(N,N6,N5,N4),VFLW,DOXYG(N,N6,N5,N4) +C 5,THETPM(M,N3,N2,N1),THETPM(M,N6,N5,N4) +C 5,VOLPM(M,N3,N2,N1),VOLPM(M,N6,N5,N4) +C WRITE(*,3133)'RNGFLG',I,J,M,MM,N4,N4,N6,N,RNGFLG(N,N6,N5,N4) +C 2,DFVNGG,RFLNGG,DZ2GG(N,N6,N5,N4),CZ2GG1,CZ2GG2 +3133 FORMAT(A8,8I4,20E12.4) +C ENDIF +C +C ACCUMULATE HOURLY FLUXES +C + XCOFLG(N,N6,N5,N4)=XCOFLG(N,N6,N5,N4)+RCOFLG(N,N6,N5,N4) + XCHFLG(N,N6,N5,N4)=XCHFLG(N,N6,N5,N4)+RCHFLG(N,N6,N5,N4) + XOXFLG(N,N6,N5,N4)=XOXFLG(N,N6,N5,N4)+ROXFLG(N,N6,N5,N4) + XNGFLG(N,N6,N5,N4)=XNGFLG(N,N6,N5,N4)+RNGFLG(N,N6,N5,N4) + XN2FLG(N,N6,N5,N4)=XN2FLG(N,N6,N5,N4)+RN2FLG(N,N6,N5,N4) + XN3FLG(N,N6,N5,N4)=XN3FLG(N,N6,N5,N4)+RN3FLG(N,N6,N5,N4) + XHGFLG(N,N6,N5,N4)=XHGFLG(N,N6,N5,N4)+RHGFLG(N,N6,N5,N4) + ELSE + RCOFLG(N,N6,N5,N4)=0.0 + RCHFLG(N,N6,N5,N4)=0.0 + ROXFLG(N,N6,N5,N4)=0.0 + RNGFLG(N,N6,N5,N4)=0.0 + RN2FLG(N,N6,N5,N4)=0.0 + RN3FLG(N,N6,N5,N4)=0.0 + RHGFLG(N,N6,N5,N4)=0.0 + ENDIF +C +C VOLATILIZATION-DISSOLUTION OF GASES IN SOIL +C LAYER FROM GASEOUS CONCENTRATIONS VS. THEIR AQUEOUS +C EQUIVALENTS DEPENDING ON SOLUBILITY FROM 'HOUR1' +C AND TRANSFER COEFFICIENT 'DFGS' FROM 'WATSUB' +C + IF(N.EQ.3)THEN + IF(THETPM(M,N6,N5,N4).GT.THETX)THEN + RCODFG(N6,N5,N4)=DFGS(M,N6,N5,N4)*(AMAX1(ZEROS(N5,N4) + 2,CO2G2(N6,N5,N4))*VOLWCO(N6,N5,N4) + 3-CO2S2(N6,N5,N4)*VOLPM(M,N6,N5,N4)) + 4/(VOLWCO(N6,N5,N4)+VOLPM(M,N6,N5,N4)) + RCHDFG(N6,N5,N4)=DFGS(M,N6,N5,N4)*(AMAX1(ZEROS(N5,N4) + 2,CH4G2(N6,N5,N4))*VOLWCH(N6,N5,N4) + 3-CH4S2(N6,N5,N4)*VOLPM(M,N6,N5,N4)) + 4/(VOLWCH(N6,N5,N4)+VOLPM(M,N6,N5,N4)) + ROXDFG(N6,N5,N4)=DFGS(M,N6,N5,N4)*(AMAX1(ZEROS(N5,N4) + 2,OXYG2(N6,N5,N4))*VOLWOX(N6,N5,N4) + 3-OXYS2(N6,N5,N4)*VOLPM(M,N6,N5,N4)) + 4/(VOLWOX(N6,N5,N4)+VOLPM(M,N6,N5,N4)) + RNGDFG(N6,N5,N4)=DFGS(M,N6,N5,N4)*(AMAX1(ZEROS(N5,N4) + 2,Z2GG2(N6,N5,N4))*VOLWNG(N6,N5,N4) + 3-Z2GS2(N6,N5,N4)*VOLPM(M,N6,N5,N4)) + 4/(VOLWNG(N6,N5,N4)+VOLPM(M,N6,N5,N4)) + RN2DFG(N6,N5,N4)=DFGS(M,N6,N5,N4)*(AMAX1(ZEROS(N5,N4) + 2,Z2OG2(N6,N5,N4))*VOLWN2(N6,N5,N4) + 3-Z2OS2(N6,N5,N4)*VOLPM(M,N6,N5,N4)) + 3/(VOLWN2(N6,N5,N4)+VOLPM(M,N6,N5,N4)) + IF(VOLPMA(N6,N5,N4).GT.ZEROS(N5,N4) + 2.AND.VOLWXA(N6,N5,N4).GT.ZEROS(N5,N4))THEN + RN3DFG(N6,N5,N4)=DFGS(M,N6,N5,N4)*(AMAX1(ZEROS(N5,N4) + 2,ZN3G2(N6,N5,N4))*VOLWN3(N6,N5,N4) + 3-ZN3S2(N6,N5,N4)*VOLPMA(N6,N5,N4)) + 4/(VOLWN3(N6,N5,N4)+VOLPMA(N6,N5,N4)) + CNH3S0=AMAX1(0.0,(ZN3S2(N6,N5,N4)+RN3DFG(N6,N5,N4)) + 2/VOLWXA(N6,N5,N4)) + CNH4S0=AMAX1(0.0,ZNH4S2(N6,N5,N4)) + 2/VOLWXA(N6,N5,N4) + RN34SQ(N6,N5,N4)=VOLWXA(N6,N5,N4) + 2*(CHY0(N6,N5,N4)*CNH3S0-DPN4*CNH4S0)/(DPN4+CHY0(N6,N5,N4)) + ELSE + RN3DFG(N6,N5,N4)=0.0 + RN34SQ(N6,N5,N4)=0.0 + ENDIF + IF(VOLPMB(N6,N5,N4).GT.ZEROS(N5,N4) + 2.AND.VOLWXB(N6,N5,N4).GT.ZEROS(N5,N4))THEN + RNBDFG(N6,N5,N4)=DFGS(M,N6,N5,N4)*(AMAX1(ZEROS(N5,N4) + 2,ZN3G2(N6,N5,N4))*VOLWNB(N6,N5,N4) + 3-ZNBS2(N6,N5,N4)*VOLPMB(N6,N5,N4)) + 4/(VOLWNB(N6,N5,N4)+VOLPMB(N6,N5,N4)) + CNH3B0=AMAX1(0.0,(ZNBS2(N6,N5,N4)+RNBDFG(N6,N5,N4)) + 2/VOLWXB(N6,N5,N4)) + CNH4B0=AMAX1(0.0,ZNH4B2(N6,N5,N4))/VOLWXB(N6,N5,N4) + RN34BQ(N6,N5,N4)=VOLWXB(N6,N5,N4) + 2*(CHY0(N6,N5,N4)*CNH3B0-DPN4*CNH4B0)/(DPN4+CHY0(N6,N5,N4)) + ELSE + RNBDFG(N6,N5,N4)=0.0 + RN34BQ(N6,N5,N4)=0.0 + ENDIF + RHGDFG(N6,N5,N4)=DFGS(M,N6,N5,N4)*(AMAX1(ZEROS(N5,N4) + 2,H2GG2(N6,N5,N4))*VOLWHG(N6,N5,N4) + 3-H2GS2(N6,N5,N4)*VOLPM(M,N6,N5,N4)) + 4/(VOLWHG(N6,N5,N4)+VOLPM(M,N6,N5,N4)) +C IF(I.EQ.43)THEN +C WRITE(*,6666)'RN3DFG',I,J,M,MM,N4,N5,N6,RN3DFG(N6,N5,N4) +C 2,DFGS(M,N6,N5,N4),ZN3S2A,VOLWN3(N6,N5,N4),ZN3S2(N6,N5,N4) +C 3,VOLPMA(N6,N5,N4),RNBDFG(N6,N5,N4),ZN3S2B +C 4,VOLWNB(N6,N5,N4),ZNBS2(N6,N5,N4),VOLPMB(N6,N5,N4) +C WRITE(*,6666)'RCHDFG',I,J,M,MM,N4,N5,N6,RCHDFG(N6,N5,N4) +C 2,DFGS(M,N6,N5,N4),CH4G2(N6,N5,N4),VOLWCH(N6,N5,N4) +C 3,CH4S2(N6,N5,N4),VOLWM(M,N6,N5,N4),THETPM(M,N6,N5,N4) +C 4,SCH4L(N6,N5,N4),XCHDFG(N6,N5,N4) +C WRITE(*,6666)'RNGDFG',I,J,M,MM,N4,N5,N6 +C 2,RNGDFG(N6,N5,N4),DFGS(M,N6,N5,N4),Z2GG2(N6,N5,N4) +C 3,VOLWNG(N6,N5,N4),Z2GS2(N6,N5,N4),VOLPM(M,N6,N5,N4) +C 4,VOLWNG(N6,N5,N4),VOLPM(M,N6,N5,N4) +6666 FORMAT(A8,7I4,20E12.4) +C ENDIF +C +C ACCUMULATE HOURLY FLUXES +C + XCODFG(N6,N5,N4)=XCODFG(N6,N5,N4)+RCODFG(N6,N5,N4) + XCHDFG(N6,N5,N4)=XCHDFG(N6,N5,N4)+RCHDFG(N6,N5,N4) + XOXDFG(N6,N5,N4)=XOXDFG(N6,N5,N4)+ROXDFG(N6,N5,N4) + XNGDFG(N6,N5,N4)=XNGDFG(N6,N5,N4)+RNGDFG(N6,N5,N4) + XN2DFG(N6,N5,N4)=XN2DFG(N6,N5,N4)+RN2DFG(N6,N5,N4) + XN3DFG(N6,N5,N4)=XN3DFG(N6,N5,N4)+RN3DFG(N6,N5,N4) + XN34SQ(N6,N5,N4)=XN34SQ(N6,N5,N4)+RN34SQ(N6,N5,N4) + XNBDFG(N6,N5,N4)=XNBDFG(N6,N5,N4)+RNBDFG(N6,N5,N4) + XN34BQ(N6,N5,N4)=XN34BQ(N6,N5,N4)+RN34BQ(N6,N5,N4) + XHGDFG(N6,N5,N4)=XHGDFG(N6,N5,N4)+RHGDFG(N6,N5,N4) + ELSE + RCODFG(N6,N5,N4)=0.0 + RCHDFG(N6,N5,N4)=0.0 + ROXDFG(N6,N5,N4)=0.0 + RNGDFG(N6,N5,N4)=0.0 + RN2DFG(N6,N5,N4)=0.0 + RN3DFG(N6,N5,N4)=0.0 + RN34SQ(N6,N5,N4)=0.0 + RNBDFG(N6,N5,N4)=0.0 + RN34BQ(N6,N5,N4)=0.0 + RHGDFG(N6,N5,N4)=0.0 + ENDIF + ENDIF + ELSEIF(N.NE.3)THEN + DCO2G(N,N6,N5,N4)=0.0 + DCH4G(N,N6,N5,N4)=0.0 + DOXYG(N,N6,N5,N4)=0.0 + DZ2GG(N,N6,N5,N4)=0.0 + DZ2OG(N,N6,N5,N4)=0.0 + DNH3G(N,N6,N5,N4)=0.0 + DH2GG(N,N6,N5,N4)=0.0 + DO 9750 K=0,4 + ROCFLS(K,N,N6,N5,N4)=0.0 + RONFLS(K,N,N6,N5,N4)=0.0 + ROPFLS(K,N,N6,N5,N4)=0.0 + ROAFLS(K,N,N6,N5,N4)=0.0 + ROCFHS(K,N,N6,N5,N4)=0.0 + RONFHS(K,N,N6,N5,N4)=0.0 + ROPFHS(K,N,N6,N5,N4)=0.0 + ROAFHS(K,N,N6,N5,N4)=0.0 +9750 CONTINUE + RCOFLS(N,N6,N5,N4)=0.0 + RCHFLS(N,N6,N5,N4)=0.0 + ROXFLS(N,N6,N5,N4)=0.0 + RNGFLS(N,N6,N5,N4)=0.0 + RN2FLS(N,N6,N5,N4)=0.0 + RHGFLS(N,N6,N5,N4)=0.0 + RN4FLW(N,N6,N5,N4)=0.0 + RN3FLW(N,N6,N5,N4)=0.0 + RNOFLW(N,N6,N5,N4)=0.0 + RNXFLS(N,N6,N5,N4)=0.0 + RH2PFS(N,N6,N5,N4)=0.0 + RN4FLB(N,N6,N5,N4)=0.0 + RN3FLB(N,N6,N5,N4)=0.0 + RNOFLB(N,N6,N5,N4)=0.0 + RNXFLB(N,N6,N5,N4)=0.0 + RH2BFB(N,N6,N5,N4)=0.0 + RCOFHS(N,N6,N5,N4)=0.0 + RCHFHS(N,N6,N5,N4)=0.0 + ROXFHS(N,N6,N5,N4)=0.0 + RNGFHS(N,N6,N5,N4)=0.0 + RN2FHS(N,N6,N5,N4)=0.0 + RHGFHS(N,N6,N5,N4)=0.0 + RN4FHW(N,N6,N5,N4)=0.0 + RN3FHW(N,N6,N5,N4)=0.0 + RNOFHW(N,N6,N5,N4)=0.0 + RNXFHS(N,N6,N5,N4)=0.0 + RH2PHS(N,N6,N5,N4)=0.0 + RN4FHB(N,N6,N5,N4)=0.0 + RN3FHB(N,N6,N5,N4)=0.0 + RNOFHB(N,N6,N5,N4)=0.0 + RNXFHB(N,N6,N5,N4)=0.0 + RH2BHB(N,N6,N5,N4)=0.0 + RCOFLG(N,N6,N5,N4)=0.0 + RCHFLG(N,N6,N5,N4)=0.0 + ROXFLG(N,N6,N5,N4)=0.0 + RNGFLG(N,N6,N5,N4)=0.0 + RN2FLG(N,N6,N5,N4)=0.0 + RN3FLG(N,N6,N5,N4)=0.0 + RHGFLG(N,N6,N5,N4)=0.0 + ENDIF +120 CONTINUE +C +C CHECK FOR BUBBLING IF THE SUM OF ALL GASEOUS EQUIVALENT +C PARTIAL CONCENTRATIONS EXCEEDS ATMOSPHERIC PRESSURE +C + IF(N3.GE.NU(N2,N1).AND.M.NE.MX)THEN + THETW1(N3,N2,N1)=AMAX1(0.0,VOLWM(M,N3,N2,N1)/VOLX(N3,N2,N1)) + IF(THETW1(N3,N2,N1).GT.THETY(N3,N2,N1).AND.IFLGB.EQ.0)THEN + SCO2X=12.0*SCO2L(N3,N2,N1) + SCH4X=12.0*SCH4L(N3,N2,N1) + SOXYX=32.0*SOXYL(N3,N2,N1) + SN2GX=28.0*SN2GL(N3,N2,N1) + SN2OX=28.0*SN2OL(N3,N2,N1) + SNH3X=14.0*SNH3L(N3,N2,N1) + SH2GX=2.0*SH2GL(N3,N2,N1) +C +C GASEOUS EQUIVALENT PARTIAL CONCENTRATIONS +C + VCO2G2=CO2S2(N3,N2,N1)/SCO2X + VCH4G2=CH4S2(N3,N2,N1)/SCH4X + VOXYG2=OXYS2(N3,N2,N1)/SOXYX + VZ2GG2=Z2GS2(N3,N2,N1)/SN2GX + VZ2OG2=Z2OS2(N3,N2,N1)/SN2OX + VNH3G2=ZN3S2(N3,N2,N1)/SNH3X + VNHBG2=ZNBS2(N3,N2,N1)/SNH3X + VH2GG2=H2GS2(N3,N2,N1)/SH2GX +C +C GASEOUS EQUIVALENT ATMOSPHERIC CONCENTRATION +C + VTATM=AMAX1(0.0,1.2194E+04*VOLWM(M,N3,N2,N1)/TKS(N3,N2,N1)) + VTGAS=VCO2G2+VCH4G2+VOXYG2+VZ2GG2+VZ2OG2+VNH3G2+VNHBG2+VH2GG2 +C +C PROPORTIONAL REMOVAL OF EXCESS AQUEOUS GASES +C + IF(VTGAS.GT.VTATM)THEN + DVTGAS=VTATM-VTGAS + RCOBBL(N3,N2,N1)=AMIN1(0.0,DVTGAS*VCO2G2/VTGAS)*SCO2X + RCHBBL(N3,N2,N1)=AMIN1(0.0,DVTGAS*VCH4G2/VTGAS)*SCH4X + ROXBBL(N3,N2,N1)=AMIN1(0.0,DVTGAS*VOXYG2/VTGAS)*SOXYX + RNGBBL(N3,N2,N1)=AMIN1(0.0,DVTGAS*VZ2GG2/VTGAS)*SN2GX + RN2BBL(N3,N2,N1)=AMIN1(0.0,DVTGAS*VZ2OG2/VTGAS)*SN2OX + RN3BBL(N3,N2,N1)=AMIN1(0.0,DVTGAS*VNH3G2/VTGAS)*SNH3X + RNBBBL(N3,N2,N1)=AMIN1(0.0,DVTGAS*VNHBG2/VTGAS)*SNH3X + RHGBBL(N3,N2,N1)=AMIN1(0.0,DVTGAS*VH2GG2/VTGAS)*SH2GX +C +C ACCUMULATE HOURLY FLUXES +C + XCOBBL(N3,N2,N1)=XCOBBL(N3,N2,N1)+RCOBBL(N3,N2,N1) + XCHBBL(N3,N2,N1)=XCHBBL(N3,N2,N1)+RCHBBL(N3,N2,N1) + XOXBBL(N3,N2,N1)=XOXBBL(N3,N2,N1)+ROXBBL(N3,N2,N1) + XNGBBL(N3,N2,N1)=XNGBBL(N3,N2,N1)+RNGBBL(N3,N2,N1) + XN2BBL(N3,N2,N1)=XN2BBL(N3,N2,N1)+RN2BBL(N3,N2,N1) + XN3BBL(N3,N2,N1)=XN3BBL(N3,N2,N1)+RN3BBL(N3,N2,N1) + XNBBBL(N3,N2,N1)=XNBBBL(N3,N2,N1)+RNBBBL(N3,N2,N1) + XHGBBL(N3,N2,N1)=XHGBBL(N3,N2,N1)+RHGBBL(N3,N2,N1) + ELSE + RCOBBL(N3,N2,N1)=0.0 + RCHBBL(N3,N2,N1)=0.0 + ROXBBL(N3,N2,N1)=0.0 + RNGBBL(N3,N2,N1)=0.0 + RN2BBL(N3,N2,N1)=0.0 + RN3BBL(N3,N2,N1)=0.0 + RNBBBL(N3,N2,N1)=0.0 + RHGBBL(N3,N2,N1)=0.0 + ENDIF + ELSE + IFLGB=1 + RCOBBL(N3,N2,N1)=0.0 + RCHBBL(N3,N2,N1)=0.0 + ROXBBL(N3,N2,N1)=0.0 + RNGBBL(N3,N2,N1)=0.0 + RN2BBL(N3,N2,N1)=0.0 + RN3BBL(N3,N2,N1)=0.0 + RNBBBL(N3,N2,N1)=0.0 + RHGBBL(N3,N2,N1)=0.0 + ENDIF +C IF(N1.EQ.2.AND.N2.EQ.1.AND.N3.EQ.13)THEN +C WRITE(*,6688)'BUBBL',I,J,N1,N2,N3,M,MM,IFLGB,VTGAS,VTATM +C 2,DVTGAS,SOXYX,VCO2G2,VCH4G2,VOXYG2,VZ2GG2,VZ2OG2 +C 3,VNH3G2,VNHBG2,VH2GG2,ROXBBL(N3,N2,N1),XOXBBL(N3,N2,N1) +C 4,OXYS2(N3,N2,N1),VOLWM(M,N3,N2,N1) +6688 FORMAT(A8,8I4,20E12.4) +C ENDIF + ENDIF +125 CONTINUE +9890 CONTINUE +9895 CONTINUE +C +C BOUNDARY SOLUTE AND GAS FLUXES +C + DO 9595 NX=NHW,NHE + DO 9590 NY=NVN,NVS + DO 9585 L=NU(NY,NX),NL(NY,NX) + N1=NX + N2=NY + N3=L +C +C LOCATE ALL EXTERNAL BOUNDARIES AND SET BOUNDARY CONDITIONS +C ENTERED IN 'READS' +C + DO 9580 N=1,3 + DO 9575 NN=1,2 + IF(N.EQ.1)THEN + N4=NX+1 + N5=NY + N6=L + IF(NN.EQ.1)THEN + IF(NX.EQ.NHE)THEN + M1=NX + M2=NY + M3=L + M4=NX+1 + M5=NY + M6=L + XN=-1.0 + ELSE + GO TO 9575 + ENDIF + ELSEIF(NN.EQ.2)THEN + IF(NX.EQ.NHW)THEN + M1=NX + M2=NY + M3=L + M4=NX + M5=NY + M6=L + XN=1.0 + ELSE + GO TO 9575 + ENDIF + ENDIF + ELSEIF(N.EQ.2)THEN + N4=NX + N5=NY+1 + N6=L + IF(NN.EQ.1)THEN + IF(NY.EQ.NVS)THEN + M1=NX + M2=NY + M3=L + M4=NX + M5=NY+1 + M6=L + XN=-1.0 + ELSE + GO TO 9575 + ENDIF + ELSEIF(NN.EQ.2)THEN + IF(NY.EQ.NVN)THEN + M1=NX + M2=NY + M3=L + M4=NX + M5=NY + M6=L + XN=1.0 + ELSE + GO TO 9575 + ENDIF + ENDIF + ELSEIF(N.EQ.3)THEN + N1=NX + N2=NY + N3=L + N4=NX + N5=NY + N6=L+1 + IF(NN.EQ.1)THEN + IF(L.EQ.NL(NY,NX))THEN + M1=NX + M2=NY + M3=L + M4=NX + M5=NY + M6=L+1 + XN=-1.0 + ELSE + GO TO 9575 + ENDIF + ELSEIF(NN.EQ.2)THEN + GO TO 9575 + ENDIF + ENDIF +C +C SURFACE SOLUTE TRANSPORT FROM BOUNDARY SURFACE +C RUNOFF IN 'WATSUB' AND CONCENTRATIONS IN THE SURFACE SOIL LAYER +C + IF(M.NE.MX)THEN + IF(M3.EQ.NU(M2,M1).AND.N.NE.3)THEN +C +C NO RUNOFF +C + IF(QRM(M,N,M5,M4).EQ.0.0)THEN + DO 9570 K=0,2 + RQROC(K,N,M5,M4)=0.0 + RQRON(K,N,M5,M4)=0.0 + RQROP(K,N,M5,M4)=0.0 + RQROA(K,N,M5,M4)=0.0 +9570 CONTINUE + RQRCOS(N,M5,M4)=0.0 + RQRCHS(N,M5,M4)=0.0 + RQROXS(N,M5,M4)=0.0 + RQRNGS(N,M5,M4)=0.0 + RQRN2S(N,M5,M4)=0.0 + RQRHGS(N,M5,M4)=0.0 + RQRNH4(N,M5,M4)=0.0 + RQRNH3(N,M5,M4)=0.0 + RQRNO3(N,M5,M4)=0.0 + RQRNO2(N,M5,M4)=0.0 + RQRH2P(N,M5,M4)=0.0 +C +C SOLUTE LOSS FROM RUNOFF DEPENDING ON ASPECT +C AND BOUNDARY CONDITIONS SET IN SITE FILE +C + ELSEIF(NN.EQ.1.AND.QRM(M,N,M5,M4).GT.0.0 + 2.OR.NN.EQ.2.AND.QRM(M,N,M5,M4).LT.0.0)THEN + IF(VOLWM(M,0,M2,M1).GT.ZEROS(M2,M1))THEN + VFLW=AMAX1(-XFRX,AMIN1(XFRX,QRM(M,N,M5,M4) + 2/VOLWM(M,0,M2,M1))) + ELSE + VFLW=0.0 + ENDIF + DO 9540 K=0,2 + 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)) + RQROA(K,N,M5,M4)=VFLW*AMAX1(0.0,OQA2(K,0,M2,M1)) +9540 CONTINUE + RQRCOS(N,M5,M4)=VFLW*AMAX1(0.0,CO2S2(0,M2,M1)) + RQRCHS(N,M5,M4)=VFLW*AMAX1(0.0,CH4S2(0,M2,M1)) + RQROXS(N,M5,M4)=VFLW*AMAX1(0.0,OXYS2(0,M2,M1)) + RQRNGS(N,M5,M4)=VFLW*AMAX1(0.0,Z2GS2(0,M2,M1)) + RQRN2S(N,M5,M4)=VFLW*AMAX1(0.0,Z2OS2(0,M2,M1)) + RQRHGS(N,M5,M4)=VFLW*AMAX1(0.0,H2GS2(0,M2,M1)) + RQRNH4(N,M5,M4)=VFLW*AMAX1(0.0,ZNH4S2(0,M2,M1)) + RQRNH3(N,M5,M4)=VFLW*AMAX1(0.0,ZN3S2(0,M2,M1)) + RQRNO3(N,M5,M4)=VFLW*AMAX1(0.0,ZNO3S2(0,M2,M1)) + RQRNO2(N,M5,M4)=VFLW*AMAX1(0.0,ZNO2S2(0,M2,M1)) + RQRH2P(N,M5,M4)=VFLW*AMAX1(0.0,H2PO42(0,M2,M1)) +C WRITE(18,1114)'RUNX',I,J,M,M1,M2,M3,N,QRM(M,N,M5,M4) +C 2,RQRH2P(N,M5,M4),(RQROP(K,N,M5,M4),K=1,4) +1114 FORMAT(A8,7I4,20E12.4) +C +C SOLUTE GAIN FROM RUNON DEPENDING ON ASPECT +C AND BOUNDARY CONDITIONS SET IN SITE FILE +C + ELSE + DO 9640 K=0,2 + RQROC(K,N,M5,M4)=0.0 + RQRON(K,N,M5,M4)=0.0 + RQROP(K,N,M5,M4)=0.0 + RQROA(K,N,M5,M4)=0.0 +9640 CONTINUE + RQRCOS(N,M5,M4)=QRM(M,N,M5,M4)*CCOU + RQRCHS(N,M5,M4)=QRM(M,N,M5,M4)*CCHU + RQROXS(N,M5,M4)=QRM(M,N,M5,M4)*COXU + RQRNGS(N,M5,M4)=QRM(M,N,M5,M4)*CNNU + RQRN2S(N,M5,M4)=QRM(M,N,M5,M4)*CN2U + RQRHGS(N,M5,M4)=0.0 + RQRNH4(N,M5,M4)=0.0 + RQRNH3(N,M5,M4)=0.0 + RQRNO3(N,M5,M4)=0.0 + RQRNO2(N,M5,M4)=0.0 + RQRH2P(N,M5,M4)=0.0 + ENDIF + RQSCOS(N,M5,M4)=0.0 + RQSCHS(N,M5,M4)=0.0 + RQSOXS(N,M5,M4)=0.0 + RQSNGS(N,M5,M4)=0.0 + RQSN2S(N,M5,M4)=0.0 + RQSNH4(N,M5,M4)=0.0 + RQSNH3(N,M5,M4)=0.0 + RQSNO3(N,M5,M4)=0.0 + RQSH2P(N,M5,M4)=0.0 +C +C ACCUMULATE HOURLY FLUXES +C + DO 9565 K=0,2 + 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) + XOAQRS(K,N,M5,M4)=XOAQRS(K,N,M5,M4)+RQROA(K,N,M5,M4) +9565 CONTINUE + XCOQRS(N,M5,M4)=XCOQRS(N,M5,M4)+RQRCOS(N,M5,M4) + XCHQRS(N,M5,M4)=XCHQRS(N,M5,M4)+RQRCHS(N,M5,M4) + XOXQRS(N,M5,M4)=XOXQRS(N,M5,M4)+RQROXS(N,M5,M4) + XNGQRS(N,M5,M4)=XNGQRS(N,M5,M4)+RQRNGS(N,M5,M4) + XN2QRS(N,M5,M4)=XN2QRS(N,M5,M4)+RQRN2S(N,M5,M4) + XHGQRS(N,M5,M4)=XHGQRS(N,M5,M4)+RQRHGS(N,M5,M4) + XN4QRW(N,M5,M4)=XN4QRW(N,M5,M4)+RQRNH4(N,M5,M4) + XN3QRW(N,M5,M4)=XN3QRW(N,M5,M4)+RQRNH3(N,M5,M4) + XNOQRW(N,M5,M4)=XNOQRW(N,M5,M4)+RQRNO3(N,M5,M4) + XNXQRS(N,M5,M4)=XNXQRS(N,M5,M4)+RQRNO2(N,M5,M4) + XP4QRW(N,M5,M4)=XP4QRW(N,M5,M4)+RQRH2P(N,M5,M4) + XCOQSS(N,M5,M4)=XCOQSS(N,M5,M4)+RQSCOS(N,M5,M4) + XCHQSS(N,M5,M4)=XCHQSS(N,M5,M4)+RQSCHS(N,M5,M4) + XOXQSS(N,M5,M4)=XOXQSS(N,M5,M4)+RQSOXS(N,M5,M4) + XNGQSS(N,M5,M4)=XNGQSS(N,M5,M4)+RQSNGS(N,M5,M4) + XN2QSS(N,M5,M4)=XN2QSS(N,M5,M4)+RQSN2S(N,M5,M4) + XN4QSS(N,M5,M4)=XN4QSS(N,M5,M4)+RQSNH4(N,M5,M4) + XN3QSS(N,M5,M4)=XN3QSS(N,M5,M4)+RQSNH3(N,M5,M4) + XNOQSS(N,M5,M4)=XNOQSS(N,M5,M4)+RQSNO3(N,M5,M4) + XP4QSS(N,M5,M4)=XP4QSS(N,M5,M4)+RQSH2P(N,M5,M4) + ENDIF +C +C SOLUTE LOSS WITH SUBSURFACE MICROPORE WATER LOSS +C + IF(NCN(M2,M1).NE.3.OR.N.EQ.3)THEN + IF(NN.EQ.1.AND.FLWM(M,N,M6,M5,M4).GT.0.0 + 2.OR.NN.EQ.2.AND.FLWM(M,N,M6,M5,M4).LT.0.0)THEN + IF(VOLWM(M,M3,M2,M1).GT.ZEROS(M2,M1))THEN + VFLW=AMAX1(-XFRX,AMIN1(XFRX,FLWM(M,N,M6,M5,M4) + 2/VOLWM(M,M3,M2,M1))) + ELSE + VFLW=0.0 + ENDIF + DO 9520 K=0,4 + ROCFLS(K,N,M6,M5,M4)=VFLW*AMAX1(0.0,OQC2(K,M3,M2,M1)) + RONFLS(K,N,M6,M5,M4)=VFLW*AMAX1(0.0,OQN2(K,M3,M2,M1)) + ROPFLS(K,N,M6,M5,M4)=VFLW*AMAX1(0.0,OQP2(K,M3,M2,M1)) + ROAFLS(K,N,M6,M5,M4)=VFLW*AMAX1(0.0,OQA2(K,M3,M2,M1)) +9520 CONTINUE + RCOFLS(N,M6,M5,M4)=VFLW*AMAX1(0.0,CO2S2(M3,M2,M1)) + RCHFLS(N,M6,M5,M4)=VFLW*AMAX1(0.0,CH4S2(M3,M2,M1)) + ROXFLS(N,M6,M5,M4)=VFLW*AMAX1(0.0,OXYS2(M3,M2,M1)) + RNGFLS(N,M6,M5,M4)=VFLW*AMAX1(0.0,Z2GS2(M3,M2,M1)) + RN2FLS(N,M6,M5,M4)=VFLW*AMAX1(0.0,Z2OS2(M3,M2,M1)) + RHGFLS(N,M6,M5,M4)=VFLW*AMAX1(0.0,H2GS2(M3,M2,M1)) + RN4FLW(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZNH4S2(M3,M2,M1)) + 2*VLNH4(M3,M2,M1) + RN3FLW(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZN3S2(M3,M2,M1)) + 2*VLNH4(M3,M2,M1) + RNOFLW(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZNO3S2(M3,M2,M1)) + 2*VLNO3(M3,M2,M1) + RNXFLS(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZNO2S2(M3,M2,M1)) + 2*VLNO3(M3,M2,M1) + RH2PFS(N,M6,M5,M4)=VFLW*AMAX1(0.0,H2PO42(M3,M2,M1)) + 2*VLPO4(M3,M2,M1) + RN4FLB(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZNH4B2(M3,M2,M1)) + 2*VLNHB(M3,M2,M1) + RN3FLB(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZNBS2(M3,M2,M1)) + 2*VLNHB(M3,M2,M1) + RNOFLB(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZNO3B2(M3,M2,M1)) + 2*VLNOB(M3,M2,M1) + RNXFLB(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZNO2B2(M3,M2,M1)) + 2*VLNOB(M3,M2,M1) + RH2BFB(N,M6,M5,M4)=VFLW*AMAX1(0.0,H2POB2(M3,M2,M1)) + 2*VLPOB(M3,M2,M1) +C IF(J.EQ.15)THEN +C WRITE(*,8765)'LEACH',I,J,M,M6,M5,M4,RNOFLW(N,M6,M5,M4) +C 2,VFLW,ZNO3S2(M3,M2,M1),VLNO3(M3,M2,M1),FLWM(M,N,M6,M5,M4) +C 3,VOLWM(M,M3,M2,M1) +8765 FORMAT(A8,6I4,20E12.4) +C ENDIF +C +C NO SOLUTE GAIN WITH SUBSURFACE MICROPORE WATER GAIN +C + ELSE + DO 9515 K=0,4 + ROCFLS(K,N,M6,M5,M4)=0.0 + RONFLS(K,N,M6,M5,M4)=0.0 + ROPFLS(K,N,M6,M5,M4)=0.0 + ROAFLS(K,N,M6,M5,M4)=0.0 +9515 CONTINUE + RCOFLS(N,M6,M5,M4)=0.0 + RCHFLS(N,M6,M5,M4)=0.0 + ROXFLS(N,M6,M5,M4)=0.0 + RNGFLS(N,M6,M5,M4)=0.0 + RN2FLS(N,M6,M5,M4)=0.0 + RHGFLS(N,M6,M5,M4)=0.0 + RN4FLW(N,M6,M5,M4)=0.0 + RN3FLW(N,M6,M5,M4)=0.0 + RNOFLW(N,M6,M5,M4)=0.0 + RNXFLS(N,M6,M5,M4)=0.0 + RH2PFS(N,M6,M5,M4)=0.0 + RN4FLB(N,M6,M5,M4)=0.0 + RN3FLB(N,M6,M5,M4)=0.0 + RNOFLB(N,M6,M5,M4)=0.0 + RNXFLB(N,M6,M5,M4)=0.0 + RH2BFB(N,M6,M5,M4)=0.0 + ENDIF +C IF(M.NE.MX.AND.I.GE.180.AND.I.LE.200)THEN +C WRITE(*,1115)'LEACHX',I,J,M1,M2,M3,M,MM,N +C 1,RCOFLS(N,M6,M5,M4),VFLW,CO2S2(M3,M2,M1) +C 2,RH2PFS(N,M6,M5,M4),(ROPFLS(K,N,M6,M5,M4),K=1,4) +C 4,VOLWM(M,M3,M2,M1),FLWM(M,N,M6,M5,M4),VFLW +1115 FORMAT(A8,8I4,20E12.4) +C ENDIF +C +C SOLUTE LOSS WITH SUBSURFACE MACROPORE WATER LOSS +C + IF(NN.EQ.1.AND.FLWHM(M,N,M6,M5,M4).GT.0.0 + 2.OR.NN.EQ.2.AND.FLWHM(M,N,M6,M5,M4).LT.0.0)THEN + IF(VOLWHM(M,M3,M2,M1).GT.ZEROS(M2,M1))THEN + VFLW=AMAX1(-XFRX,AMIN1(XFRX,FLWHM(M,N,M6,M5,M4) + 2/VOLWHM(M,M3,M2,M1))) + ELSE + VFLW=0.0 + ENDIF + DO 9535 K=0,4 + ROCFHS(K,N,M6,M5,M4)=VFLW*AMAX1(0.0,OQCH2(K,M3,M2,M1)) + RONFHS(K,N,M6,M5,M4)=VFLW*AMAX1(0.0,OQNH2(K,M3,M2,M1)) + ROPFHS(K,N,M6,M5,M4)=VFLW*AMAX1(0.0,OQPH2(K,M3,M2,M1)) + ROAFHS(K,N,M6,M5,M4)=VFLW*AMAX1(0.0,OQAH2(K,M3,M2,M1)) +9535 CONTINUE + RCOFHS(N,M6,M5,M4)=VFLW*AMAX1(0.0,CO2SH2(M3,M2,M1)) + RCHFHS(N,M6,M5,M4)=VFLW*AMAX1(0.0,CH4SH2(M3,M2,M1)) + ROXFHS(N,M6,M5,M4)=VFLW*AMAX1(0.0,OXYSH2(M3,M2,M1)) + RNGFHS(N,M6,M5,M4)=VFLW*AMAX1(0.0,Z2GSH2(M3,M2,M1)) + RN2FHS(N,M6,M5,M4)=VFLW*AMAX1(0.0,Z2OSH2(M3,M2,M1)) + RHGFHS(N,M6,M5,M4)=VFLW*AMAX1(0.0,H2GSH2(M3,M2,M1)) + RN4FHW(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZNH4H2(M3,M2,M1)) + 2*VLNH4(M3,M2,M1) + RN3FHW(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZNH3H2(M3,M2,M1)) + 2*VLNH4(M3,M2,M1) + RNOFHW(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZNO3H2(M3,M2,M1)) + 2*VLNO3(M3,M2,M1) + RNXFHS(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZNO2H2(M3,M2,M1)) + 2*VLNO3(M3,M2,M1) + RH2PHS(N,M6,M5,M4)=VFLW*AMAX1(0.0,H2P4H2(M3,M2,M1)) + 2*VLPO4(M3,M2,M1) + RN4FHB(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZN4BH2(M3,M2,M1)) + 2*VLNHB(M3,M2,M1) + RN3FHB(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZN3BH2(M3,M2,M1)) + 2*VLNHB(M3,M2,M1) + RNOFHB(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZNOBH2(M3,M2,M1)) + 2*VLNOB(M3,M2,M1) + RNXFHB(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZN2BH2(M3,M2,M1)) + 2*VLNOB(M3,M2,M1) + RH2BHB(N,M6,M5,M4)=VFLW*AMAX1(0.0,H2PBH2(M3,M2,M1)) + 2*VLPOB(M3,M2,M1) +C +C NO SOLUTE GAIN IN SUBSURFACE MACROPORES +C + ELSE + DO 9530 K=0,4 + ROCFHS(K,N,M6,M5,M4)=0.0 + RONFHS(K,N,M6,M5,M4)=0.0 + ROPFHS(K,N,M6,M5,M4)=0.0 + ROAFHS(K,N,M6,M5,M4)=0.0 +9530 CONTINUE + RCOFHS(N,M6,M5,M4)=0.0 + RCHFHS(N,M6,M5,M4)=0.0 + ROXFHS(N,M6,M5,M4)=0.0 + RNGFHS(N,M6,M5,M4)=0.0 + RN2FHS(N,M6,M5,M4)=0.0 + RN4FHW(N,M6,M5,M4)=0.0 + RHGFHS(N,M6,M5,M4)=0.0 + RN3FHW(N,M6,M5,M4)=0.0 + RNOFHW(N,M6,M5,M4)=0.0 + RNXFHS(N,M6,M5,M4)=0.0 + RH2PHS(N,M6,M5,M4)=0.0 + RN4FHB(N,M6,M5,M4)=0.0 + RN3FHB(N,M6,M5,M4)=0.0 + RNOFHB(N,M6,M5,M4)=0.0 + RNXFHB(N,M6,M5,M4)=0.0 + RH2BHB(N,M6,M5,M4)=0.0 + ENDIF +C +C ACCUMULATE HOURLY FLUXES +C + DO 9555 K=0,4 + XOCFLS(K,N,M6,M5,M4)=XOCFLS(K,N,M6,M5,M4)+ROCFLS(K,N,M6,M5,M4) + XONFLS(K,N,M6,M5,M4)=XONFLS(K,N,M6,M5,M4)+RONFLS(K,N,M6,M5,M4) + XOPFLS(K,N,M6,M5,M4)=XOPFLS(K,N,M6,M5,M4)+ROPFLS(K,N,M6,M5,M4) + XOAFLS(K,N,M6,M5,M4)=XOAFLS(K,N,M6,M5,M4)+ROAFLS(K,N,M6,M5,M4) + XOCFHS(K,N,M6,M5,M4)=XOCFHS(K,N,M6,M5,M4)+ROCFHS(K,N,M6,M5,M4) + XONFHS(K,N,M6,M5,M4)=XONFHS(K,N,M6,M5,M4)+RONFHS(K,N,M6,M5,M4) + XOPFHS(K,N,M6,M5,M4)=XOPFHS(K,N,M6,M5,M4)+ROPFHS(K,N,M6,M5,M4) + XOAFHS(K,N,M6,M5,M4)=XOAFHS(K,N,M6,M5,M4)+ROAFHS(K,N,M6,M5,M4) +9555 CONTINUE + XCOFLS(N,M6,M5,M4)=XCOFLS(N,M6,M5,M4)+RCOFLS(N,M6,M5,M4) + XCHFLS(N,M6,M5,M4)=XCHFLS(N,M6,M5,M4)+RCHFLS(N,M6,M5,M4) + XOXFLS(N,M6,M5,M4)=XOXFLS(N,M6,M5,M4)+ROXFLS(N,M6,M5,M4) + XNGFLS(N,M6,M5,M4)=XNGFLS(N,M6,M5,M4)+RNGFLS(N,M6,M5,M4) + XN2FLS(N,M6,M5,M4)=XN2FLS(N,M6,M5,M4)+RN2FLS(N,M6,M5,M4) + XHGFLS(N,M6,M5,M4)=XHGFLS(N,M6,M5,M4)+RHGFLS(N,M6,M5,M4) + XN4FLW(N,M6,M5,M4)=XN4FLW(N,M6,M5,M4)+RN4FLW(N,M6,M5,M4) + XN3FLW(N,M6,M5,M4)=XN3FLW(N,M6,M5,M4)+RN3FLW(N,M6,M5,M4) + XNOFLW(N,M6,M5,M4)=XNOFLW(N,M6,M5,M4)+RNOFLW(N,M6,M5,M4) + XNXFLS(N,M6,M5,M4)=XNXFLS(N,M6,M5,M4)+RNXFLS(N,M6,M5,M4) + XH2PFS(N,M6,M5,M4)=XH2PFS(N,M6,M5,M4)+RH2PFS(N,M6,M5,M4) + XN4FLB(N,M6,M5,M4)=XN4FLB(N,M6,M5,M4)+RN4FLB(N,M6,M5,M4) + XN3FLB(N,M6,M5,M4)=XN3FLB(N,M6,M5,M4)+RN3FLB(N,M6,M5,M4) + XNOFLB(N,M6,M5,M4)=XNOFLB(N,M6,M5,M4)+RNOFLB(N,M6,M5,M4) + XNXFLB(N,M6,M5,M4)=XNXFLB(N,M6,M5,M4)+RNXFLB(N,M6,M5,M4) + XH2BFB(N,M6,M5,M4)=XH2BFB(N,M6,M5,M4)+RH2BFB(N,M6,M5,M4) + XCOFHS(N,M6,M5,M4)=XCOFHS(N,M6,M5,M4)+RCOFHS(N,M6,M5,M4) + XCHFHS(N,M6,M5,M4)=XCHFHS(N,M6,M5,M4)+RCHFHS(N,M6,M5,M4) + XOXFHS(N,M6,M5,M4)=XOXFHS(N,M6,M5,M4)+ROXFHS(N,M6,M5,M4) + XNGFHS(N,M6,M5,M4)=XNGFHS(N,M6,M5,M4)+RNGFHS(N,M6,M5,M4) + XN2FHS(N,M6,M5,M4)=XN2FHS(N,M6,M5,M4)+RN2FHS(N,M6,M5,M4) + XHGFHS(N,M6,M5,M4)=XHGFHS(N,M6,M5,M4)+RHGFHS(N,M6,M5,M4) + XN4FHW(N,M6,M5,M4)=XN4FHW(N,M6,M5,M4)+RN4FHW(N,M6,M5,M4) + XN3FHW(N,M6,M5,M4)=XN3FHW(N,M6,M5,M4)+RN3FHW(N,M6,M5,M4) + XNOFHW(N,M6,M5,M4)=XNOFHW(N,M6,M5,M4)+RNOFHW(N,M6,M5,M4) + XNXFHS(N,M6,M5,M4)=XNXFHS(N,M6,M5,M4)+RNXFHS(N,M6,M5,M4) + XH2PHS(N,M6,M5,M4)=XH2PHS(N,M6,M5,M4)+RH2PHS(N,M6,M5,M4) + XN4FHB(N,M6,M5,M4)=XN4FHB(N,M6,M5,M4)+RN4FHB(N,M6,M5,M4) + XN3FHB(N,M6,M5,M4)=XN3FHB(N,M6,M5,M4)+RN3FHB(N,M6,M5,M4) + XNOFHB(N,M6,M5,M4)=XNOFHB(N,M6,M5,M4)+RNOFHB(N,M6,M5,M4) + XNXFHB(N,M6,M5,M4)=XNXFHB(N,M6,M5,M4)+RNXFHB(N,M6,M5,M4) + XH2BHB(N,M6,M5,M4)=XH2BHB(N,M6,M5,M4)+RH2BHB(N,M6,M5,M4) + ENDIF + ENDIF +C +C NO GASOUS GAIN WITH SUBSURFACE MICROPORE WATER LOSS +C + FLGM=(FLWM(M,N,M6,M5,M4)+FLWHM(M,N,M6,M5,M4))*XNPT +C IF(NN.EQ.1.AND.FLGM.GT.0.0 +C 2.OR.NN.EQ.2.AND.FLGM.LT.0.0)THEN +C IF(VOLPM(M,M3,M2,M1).GT.ZEROS(M2,M1))THEN +C VFLW=-AMAX1(-XFRX,AMIN1(XFRX,FLGM +C 2/VOLPM(M,M3,M2,M1))) +C ELSE +C VFLW=0.0 +C ENDIF +C RCOFLG(N,M6,M5,M4)=VFLW*AMAX1(0.0,CO2G2(M3,M2,M1)) +C RCHFLG(N,M6,M5,M4)=VFLW*AMAX1(0.0,CH4G2(M3,M2,M1)) +C ROXFLG(N,M6,M5,M4)=VFLW*AMAX1(0.0,OXYG2(M3,M2,M1)) +C RNGFLG(N,M6,M5,M4)=VFLW*AMAX1(0.0,Z2GG2(M3,M2,M1)) +C RN2FLG(N,M6,M5,M4)=VFLW*AMAX1(0.0,Z2OG2(M3,M2,M1)) +C RN3FLG(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZN3G2(M3,M2,M1)) +C RHGFLG(N,M6,M5,M4)=VFLW*AMAX1(0.0,H2GG2(M3,M2,M1)) +C XCOFLG(N,M6,M5,M4)=XCOFLG(N,M6,M5,M4)+RCOFLG(N,M6,M5,M4) +C XCHFLG(N,M6,M5,M4)=XCHFLG(N,M6,M5,M4)+RCHFLG(N,M6,M5,M4) +C XOXFLG(N,M6,M5,M4)=XOXFLG(N,M6,M5,M4)+ROXFLG(N,M6,M5,M4) +C XNGFLG(N,M6,M5,M4)=XNGFLG(N,M6,M5,M4)+RNGFLG(N,M6,M5,M4) +C XN2FLG(N,M6,M5,M4)=XN2FLG(N,M6,M5,M4)+RN2FLG(N,M6,M5,M4) +C XN3FLG(N,M6,M5,M4)=XN3FLG(N,M6,M5,M4)+RN3FLG(N,M6,M5,M4) +C XHGFLG(N,M6,M5,M4)=XHGFLG(N,M6,M5,M4)+RHGFLG(N,M6,M5,M4) +C IF(FLGM.NE.0.0)THEN +C WRITE(*,8766)'GAS IN',I,J,M,MM,N,NN,M3,M2,M1,M6,M5,M4 +C 2,VFLW,VOLPM(M,M3,M2,M1),ROXFLG(N,M6,M5,M4) +C 3,OXYG2(M3,M2,M1),FLGM,FLWM(M,N,M6,M5,M4) +C 4,FLWHM(M,N,M6,M5,M4) +8766 FORMAT(A8,12I4,20E12.4) +C ENDIF +C +C GASOUS LOSS WITH SUBSURFACE MICROPORE WATER GAIN +C + IF(NN.EQ.1.AND.FLGM.LT.0.0 + 2.OR.NN.EQ.2.AND.FLGM.GT.0.0)THEN + IF(VOLPM(M,M3,M2,M1).GT.ZEROS(M2,M1))THEN + VFLW=-AMAX1(-XFRX,AMIN1(XFRX,FLGM + 2/VOLPM(M,M3,M2,M1))) + ELSE + VFLW=0.0 + ENDIF + RCOFLG(N,M6,M5,M4)=VFLW*AMAX1(0.0,CO2G2(M3,M2,M1)) + RCHFLG(N,M6,M5,M4)=VFLW*AMAX1(0.0,CH4G2(M3,M2,M1)) + ROXFLG(N,M6,M5,M4)=VFLW*AMAX1(0.0,OXYG2(M3,M2,M1)) + RNGFLG(N,M6,M5,M4)=VFLW*AMAX1(0.0,Z2GG2(M3,M2,M1)) + RN2FLG(N,M6,M5,M4)=VFLW*AMAX1(0.0,Z2OG2(M3,M2,M1)) + RN3FLG(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZN3G2(M3,M2,M1)) + RHGFLG(N,M6,M5,M4)=VFLW*AMAX1(0.0,H2GG2(M3,M2,M1)) + XCOFLG(N,M6,M5,M4)=XCOFLG(N,M6,M5,M4)+RCOFLG(N,M6,M5,M4) + XCHFLG(N,M6,M5,M4)=XCHFLG(N,M6,M5,M4)+RCHFLG(N,M6,M5,M4) + XOXFLG(N,M6,M5,M4)=XOXFLG(N,M6,M5,M4)+ROXFLG(N,M6,M5,M4) + XNGFLG(N,M6,M5,M4)=XNGFLG(N,M6,M5,M4)+RNGFLG(N,M6,M5,M4) + XN2FLG(N,M6,M5,M4)=XN2FLG(N,M6,M5,M4)+RN2FLG(N,M6,M5,M4) + XN3FLG(N,M6,M5,M4)=XN3FLG(N,M6,M5,M4)+RN3FLG(N,M6,M5,M4) + XHGFLG(N,M6,M5,M4)=XHGFLG(N,M6,M5,M4)+RHGFLG(N,M6,M5,M4) +C IF(FLGM.NE.0.0)THEN +C WRITE(*,8766)'GAS OUT',I,J,M,MM,N,NN,M3,M2,M1,M6,M5,M4 +C 2,VFLW,VOLPM(M,M3,M2,M1),ROXFLG(N,M6,M5,M4) +C 3,OXYG2(M3,M2,M1),FLGM,FLWM(M,N,M6,M5,M4) +C 4,FLWHM(M,N,M6,M5,M4) +C ENDIF + ELSE + RCOFLG(N,M6,M5,M4)=0.0 + RCHFLG(N,M6,M5,M4)=0.0 + ROXFLG(N,M6,M5,M4)=0.0 + RNGFLG(N,M6,M5,M4)=0.0 + RN2FLG(N,M6,M5,M4)=0.0 + RN3FLG(N,M6,M5,M4)=0.0 + RHGFLG(N,M6,M5,M4)=0.0 + ENDIF +9575 CONTINUE +C +C TOTAL GAS AND SOLUTE FLUXES IN EACH GRID CELL +C + IF(M.NE.MX)THEN + IF(L.EQ.NU(N2,N1).AND.N.NE.3)THEN +C +C TOTAL OVERLAND FLUX +C + DO 9550 K=0,2 + 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) + TQROA(K,N2,N1)=TQROA(K,N2,N1)+RQROA(K,N,N2,N1)-RQROA(K,N,N5,N4) +9550 CONTINUE + TQRCOS(N2,N1)=TQRCOS(N2,N1)+RQRCOS(N,N2,N1)-RQRCOS(N,N5,N4) + TQRCHS(N2,N1)=TQRCHS(N2,N1)+RQRCHS(N,N2,N1)-RQRCHS(N,N5,N4) + TQROXS(N2,N1)=TQROXS(N2,N1)+RQROXS(N,N2,N1)-RQROXS(N,N5,N4) + TQRNGS(N2,N1)=TQRNGS(N2,N1)+RQRNGS(N,N2,N1)-RQRNGS(N,N5,N4) + TQRN2S(N2,N1)=TQRN2S(N2,N1)+RQRN2S(N,N2,N1)-RQRN2S(N,N5,N4) + TQRHGS(N2,N1)=TQRHGS(N2,N1)+RQRHGS(N,N2,N1)-RQRHGS(N,N5,N4) + TQRNH4(N2,N1)=TQRNH4(N2,N1)+RQRNH4(N,N2,N1)-RQRNH4(N,N5,N4) + TQRNH3(N2,N1)=TQRNH3(N2,N1)+RQRNH3(N,N2,N1)-RQRNH3(N,N5,N4) + TQRNO3(N2,N1)=TQRNO3(N2,N1)+RQRNO3(N,N2,N1)-RQRNO3(N,N5,N4) + TQRNO2(N2,N1)=TQRNO2(N2,N1)+RQRNO2(N,N2,N1)-RQRNO2(N,N5,N4) + TQRH2P(N2,N1)=TQRH2P(N2,N1)+RQRH2P(N,N2,N1)-RQRH2P(N,N5,N4) + TQSCOS(N2,N1)=TQSCOS(N2,N1)+RQSCOS(N,N2,N1)-RQSCOS(N,N5,N4) + TQSCHS(N2,N1)=TQSCHS(N2,N1)+RQSCHS(N,N2,N1)-RQSCHS(N,N5,N4) + TQSOXS(N2,N1)=TQSOXS(N2,N1)+RQSOXS(N,N2,N1)-RQSOXS(N,N5,N4) + TQSNGS(N2,N1)=TQSNGS(N2,N1)+RQSNGS(N,N2,N1)-RQSNGS(N,N5,N4) + TQSN2S(N2,N1)=TQSN2S(N2,N1)+RQSN2S(N,N2,N1)-RQSN2S(N,N5,N4) + TQSNH4(N2,N1)=TQSNH4(N2,N1)+RQSNH4(N,N2,N1)-RQSNH4(N,N5,N4) + TQSNH3(N2,N1)=TQSNH3(N2,N1)+RQSNH3(N,N2,N1)-RQSNH3(N,N5,N4) + TQSNO3(N2,N1)=TQSNO3(N2,N1)+RQSNO3(N,N2,N1)-RQSNO3(N,N5,N4) + TQSH2P(N2,N1)=TQSH2P(N2,N1)+RQSH2P(N,N2,N1)-RQSH2P(N,N5,N4) + ENDIF + ENDIF +C +C TOTAL SOLUTE FLUX IN MICROPORES AND MACROPORES +C + IF(M.NE.MX)THEN + IF(NCN(N2,N1).NE.3.OR.N.EQ.3)THEN + DO 9545 K=0,4 + TOCFLS(K,N3,N2,N1)=TOCFLS(K,N3,N2,N1)+ROCFLS(K,N,N3,N2,N1) + 2-ROCFLS(K,N,N6,N5,N4) + TONFLS(K,N3,N2,N1)=TONFLS(K,N3,N2,N1)+RONFLS(K,N,N3,N2,N1) + 2-RONFLS(K,N,N6,N5,N4) + TOPFLS(K,N3,N2,N1)=TOPFLS(K,N3,N2,N1)+ROPFLS(K,N,N3,N2,N1) + 2-ROPFLS(K,N,N6,N5,N4) + TOAFLS(K,N3,N2,N1)=TOAFLS(K,N3,N2,N1)+ROAFLS(K,N,N3,N2,N1) + 2-ROAFLS(K,N,N6,N5,N4) + TOCFHS(K,N3,N2,N1)=TOCFHS(K,N3,N2,N1)+ROCFHS(K,N,N3,N2,N1) + 2-ROCFHS(K,N,N6,N5,N4) + TONFHS(K,N3,N2,N1)=TONFHS(K,N3,N2,N1)+RONFHS(K,N,N3,N2,N1) + 2-RONFHS(K,N,N6,N5,N4) + TOPFHS(K,N3,N2,N1)=TOPFHS(K,N3,N2,N1)+ROPFHS(K,N,N3,N2,N1) + 2-ROPFHS(K,N,N6,N5,N4) + TOAFHS(K,N3,N2,N1)=TOAFHS(K,N3,N2,N1)+ROAFHS(K,N,N3,N2,N1) + 2-ROAFHS(K,N,N6,N5,N4) +9545 CONTINUE + TCOFLS(N3,N2,N1)=TCOFLS(N3,N2,N1)+RCOFLS(N,N3,N2,N1) + 2-RCOFLS(N,N6,N5,N4) + TCHFLS(N3,N2,N1)=TCHFLS(N3,N2,N1)+RCHFLS(N,N3,N2,N1) + 2-RCHFLS(N,N6,N5,N4) + TOXFLS(N3,N2,N1)=TOXFLS(N3,N2,N1)+ROXFLS(N,N3,N2,N1) + 2-ROXFLS(N,N6,N5,N4) + TNGFLS(N3,N2,N1)=TNGFLS(N3,N2,N1)+RNGFLS(N,N3,N2,N1) + 2-RNGFLS(N,N6,N5,N4) + TN2FLS(N3,N2,N1)=TN2FLS(N3,N2,N1)+RN2FLS(N,N3,N2,N1) + 2-RN2FLS(N,N6,N5,N4) + THGFLS(N3,N2,N1)=THGFLS(N3,N2,N1)+RHGFLS(N,N3,N2,N1) + 2-RHGFLS(N,N6,N5,N4) + TN4FLW(N3,N2,N1)=TN4FLW(N3,N2,N1)+RN4FLW(N,N3,N2,N1) + 2-RN4FLW(N,N6,N5,N4) + TN3FLW(N3,N2,N1)=TN3FLW(N3,N2,N1)+RN3FLW(N,N3,N2,N1) + 2-RN3FLW(N,N6,N5,N4) + TNOFLW(N3,N2,N1)=TNOFLW(N3,N2,N1)+RNOFLW(N,N3,N2,N1) + 2-RNOFLW(N,N6,N5,N4) + TNXFLS(N3,N2,N1)=TNXFLS(N3,N2,N1)+RNXFLS(N,N3,N2,N1) + 2-RNXFLS(N,N6,N5,N4) + TH2PFS(N3,N2,N1)=TH2PFS(N3,N2,N1)+RH2PFS(N,N3,N2,N1) + 2-RH2PFS(N,N6,N5,N4) + TN4FLB(N3,N2,N1)=TN4FLB(N3,N2,N1)+RN4FLB(N,N3,N2,N1) + 2-RN4FLB(N,N6,N5,N4) + TN3FLB(N3,N2,N1)=TN3FLB(N3,N2,N1)+RN3FLB(N,N3,N2,N1) + 2-RN3FLB(N,N6,N5,N4) + TNOFLB(N3,N2,N1)=TNOFLB(N3,N2,N1)+RNOFLB(N,N3,N2,N1) + 2-RNOFLB(N,N6,N5,N4) + TNXFLB(N3,N2,N1)=TNXFLB(N3,N2,N1)+RNXFLB(N,N3,N2,N1) + 2-RNXFLB(N,N6,N5,N4) + TH2BFB(N3,N2,N1)=TH2BFB(N3,N2,N1)+RH2BFB(N,N3,N2,N1) + 2-RH2BFB(N,N6,N5,N4) + TCOFHS(N3,N2,N1)=TCOFHS(N3,N2,N1)+RCOFHS(N,N3,N2,N1) + 2-RCOFHS(N,N6,N5,N4) + TCHFHS(N3,N2,N1)=TCHFHS(N3,N2,N1)+RCHFHS(N,N3,N2,N1) + 2-RCHFHS(N,N6,N5,N4) + TOXFHS(N3,N2,N1)=TOXFHS(N3,N2,N1)+ROXFHS(N,N3,N2,N1) + 2-ROXFHS(N,N6,N5,N4) + TNGFHS(N3,N2,N1)=TNGFHS(N3,N2,N1)+RNGFHS(N,N3,N2,N1) + 2-RNGFHS(N,N6,N5,N4) + TN2FHS(N3,N2,N1)=TN2FHS(N3,N2,N1)+RN2FHS(N,N3,N2,N1) + 2-RN2FHS(N,N6,N5,N4) + THGFHS(N3,N2,N1)=THGFHS(N3,N2,N1)+RHGFHS(N,N3,N2,N1) + 2-RHGFHS(N,N6,N5,N4) + TN4FHW(N3,N2,N1)=TN4FHW(N3,N2,N1)+RN4FHW(N,N3,N2,N1) + 2-RN4FHW(N,N6,N5,N4) + TN3FHW(N3,N2,N1)=TN3FHW(N3,N2,N1)+RN3FHW(N,N3,N2,N1) + 2-RN3FHW(N,N6,N5,N4) + TNOFHW(N3,N2,N1)=TNOFHW(N3,N2,N1)+RNOFHW(N,N3,N2,N1) + 2-RNOFHW(N,N6,N5,N4) + TNXFHS(N3,N2,N1)=TNXFHS(N3,N2,N1)+RNXFHS(N,N3,N2,N1) + 2-RNXFHS(N,N6,N5,N4) + TH2PHS(N3,N2,N1)=TH2PHS(N3,N2,N1)+RH2PHS(N,N3,N2,N1) + 2-RH2PHS(N,N6,N5,N4) + TN4FHB(N3,N2,N1)=TN4FHB(N3,N2,N1)+RN4FHB(N,N3,N2,N1) + 2-RN4FHB(N,N6,N5,N4) + TN3FHB(N3,N2,N1)=TN3FHB(N3,N2,N1)+RN3FHB(N,N3,N2,N1) + 2-RN3FHB(N,N6,N5,N4) + TNOFHB(N3,N2,N1)=TNOFHB(N3,N2,N1)+RNOFHB(N,N3,N2,N1) + 2-RNOFHB(N,N6,N5,N4) + TNXFHB(N3,N2,N1)=TNXFHB(N3,N2,N1)+RNXFHB(N,N3,N2,N1) + 2-RNXFHB(N,N6,N5,N4) + TH2BHB(N3,N2,N1)=TH2BHB(N3,N2,N1)+RH2BHB(N,N3,N2,N1) + 2-RH2BHB(N,N6,N5,N4) + ENDIF + ENDIF +C +C TOTAL GAS FLUX +C +C IF(NCN(N2,N1).NE.3.OR.N.EQ.3)THEN + TCOFLG(N3,N2,N1)=TCOFLG(N3,N2,N1)+RCOFLG(N,N3,N2,N1) + 2-RCOFLG(N,N6,N5,N4) + TCHFLG(N3,N2,N1)=TCHFLG(N3,N2,N1)+RCHFLG(N,N3,N2,N1) + 2-RCHFLG(N,N6,N5,N4) + TOXFLG(N3,N2,N1)=TOXFLG(N3,N2,N1)+ROXFLG(N,N3,N2,N1) + 2-ROXFLG(N,N6,N5,N4) + TNGFLG(N3,N2,N1)=TNGFLG(N3,N2,N1)+RNGFLG(N,N3,N2,N1) + 2-RNGFLG(N,N6,N5,N4) + TN2FLG(N3,N2,N1)=TN2FLG(N3,N2,N1)+RN2FLG(N,N3,N2,N1) + 2-RN2FLG(N,N6,N5,N4) + TN3FLG(N3,N2,N1)=TN3FLG(N3,N2,N1)+RN3FLG(N,N3,N2,N1) + 2-RN3FLG(N,N6,N5,N4) + THGFLG(N3,N2,N1)=THGFLG(N3,N2,N1)+RHGFLG(N,N3,N2,N1) + 2-RHGFLG(N,N6,N5,N4) +C ENDIF +9580 CONTINUE +9585 CONTINUE +9590 CONTINUE +9595 CONTINUE +C +C UPDATE STATE VARIABLES FROM TOTAL FLUXES CALCULATED ABOVE +C + IF(MM.NE.NPG)THEN + DO 9695 NX=NHW,NHE + DO 9690 NY=NVN,NVS + IF(M.NE.MX)THEN +C +C STATE VARIABLES FOR SOLUTES IN MICROPORES AND MACROPORES IN +C SOIL SURFACE LAYER FROM OVERLAND FLOW AND SURFACE VOLATILIZATION- +C DISSOLUTION +C + DO 9681 K=0,2 + 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) + OQA2(K,0,NY,NX)=OQA2(K,0,NY,NX)+ROAFLS(K,3,0,NY,NX) +9681 CONTINUE + CO2S2(0,NY,NX)=CO2S2(0,NY,NX)+RCODFR(NY,NX)+RCOFLS(3,0,NY,NX) + CH4S2(0,NY,NX)=CH4S2(0,NY,NX)+RCHDFR(NY,NX)+RCHFLS(3,0,NY,NX) + OXYS2(0,NY,NX)=OXYS2(0,NY,NX)+ROXDFR(NY,NX)+ROXFLS(3,0,NY,NX) + Z2GS2(0,NY,NX)=Z2GS2(0,NY,NX)+RNGDFR(NY,NX)+RNGFLS(3,0,NY,NX) + Z2OS2(0,NY,NX)=Z2OS2(0,NY,NX)+RN2DFR(NY,NX)+RN2FLS(3,0,NY,NX) + H2GS2(0,NY,NX)=H2GS2(0,NY,NX)+RHGDFR(NY,NX)+RHGFLS(3,0,NY,NX) + ZNH4S2(0,NY,NX)=ZNH4S2(0,NY,NX)+RN4FLW(3,0,NY,NX) + ZN3S2(0,NY,NX)=ZN3S2(0,NY,NX)+RN3DFR(NY,NX)+RN3FLW(3,0,NY,NX) + ZNO3S2(0,NY,NX)=ZNO3S2(0,NY,NX)+RNOFLW(3,0,NY,NX) + ZNO2S2(0,NY,NX)=ZNO2S2(0,NY,NX)+RNXFLS(3,0,NY,NX) + H2PO42(0,NY,NX)=H2PO42(0,NY,NX)+RH2PFS(3,0,NY,NX) + CO2S2(NU(NY,NX),NY,NX)=CO2S2(NU(NY,NX),NY,NX)+RCODFS(NY,NX) + CH4S2(NU(NY,NX),NY,NX)=CH4S2(NU(NY,NX),NY,NX)+RCHDFS(NY,NX) + OXYS2(NU(NY,NX),NY,NX)=OXYS2(NU(NY,NX),NY,NX)+ROXDFS(NY,NX) + Z2GS2(NU(NY,NX),NY,NX)=Z2GS2(NU(NY,NX),NY,NX)+RNGDFS(NY,NX) + Z2OS2(NU(NY,NX),NY,NX)=Z2OS2(NU(NY,NX),NY,NX)+RN2DFS(NY,NX) + 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) + DO 9680 K=0,2 + 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) + OQA2(K,0,NY,NX)=OQA2(K,0,NY,NX)+TQROA(K,NY,NX) +9680 CONTINUE + CO2S2(0,NY,NX)=CO2S2(0,NY,NX)+TQRCOS(NY,NX) + CH4S2(0,NY,NX)=CH4S2(0,NY,NX)+TQRCHS(NY,NX) + OXYS2(0,NY,NX)=OXYS2(0,NY,NX)+TQROXS(NY,NX) + Z2GS2(0,NY,NX)=Z2GS2(0,NY,NX)+TQRNGS(NY,NX) + Z2OS2(0,NY,NX)=Z2OS2(0,NY,NX)+TQRN2S(NY,NX) + H2GS2(0,NY,NX)=H2GS2(0,NY,NX)+TQRHGS(NY,NX) + ZNH4S2(0,NY,NX)=ZNH4S2(0,NY,NX)+TQRNH4(NY,NX) + ZN3S2(0,NY,NX)=ZN3S2(0,NY,NX)+TQRNH3(NY,NX) + ZNO3S2(0,NY,NX)=ZNO3S2(0,NY,NX)+TQRNO3(NY,NX) + ZNO2S2(0,NY,NX)=ZNO2S2(0,NY,NX)+TQRNO2(NY,NX) + H2PO42(0,NY,NX)=H2PO42(0,NY,NX)+TQRH2P(NY,NX) +C IF(I.EQ.87)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) +C WRITE(*,8787)'OXYS20',I,J,NX,NY,M,MM,OXYS2(0,NY,NX) +C 2,ROXDFR(NY,NX),ROXFLS(3,0,NY,NX),ROXSK2(0,NY,NX) +C 3,TQROXS(NY,NX),ROXDFG(0,NY,NX),XOXFLS(3,0,NY,NX) +8787 FORMAT(A8,6I4,12E12.4) +C ENDIF + CO2W2(NY,NX)=CO2W2(NY,NX)+TQSCOS(NY,NX) + CH4W2(NY,NX)=CH4W2(NY,NX)+TQSCHS(NY,NX) + OXYW2(NY,NX)=OXYW2(NY,NX)+TQSOXS(NY,NX) + ZNGW2(NY,NX)=ZNGW2(NY,NX)+TQSNGS(NY,NX) + ZN2W2(NY,NX)=ZN2W2(NY,NX)+TQSN2S(NY,NX) + ZN4W2(NY,NX)=ZN4W2(NY,NX)+TQSNH4(NY,NX) + ZN3W2(NY,NX)=ZN3W2(NY,NX)+TQSNH3(NY,NX) + ZNOW2(NY,NX)=ZNOW2(NY,NX)+TQSNO3(NY,NX) + ZHPW2(NY,NX)=ZHPW2(NY,NX)+TQSH2P(NY,NX) +C IF(I.EQ.118.AND.NX.EQ.3.AND.NY.EQ.4)THEN +C WRITE(*,6868)'OXYW2',I,J,NX,NY,M,MM,OXYW2(NY,NX) +C 2,TQSOXS(NY,NX),XOXBLS(NY,NX) +6868 FORMAT(A8,6I4,12E12.4) +C ENDIF + ENDIF +C +C STATE VARIABLES FOR GASES AND FOR SOLUTES IN MICROPORES AND +C MACROPORES IN SOIL LAYERS FROM SUBSURFACE FLOW, MICROBIAL +C AND ROOT EXCHANGE IN 'NITRO' AND 'UPTAKE', AND EQUILIBRIUM +C REACTIONS IN 'SOLUTE' +C + DO 9685 L=NU(NY,NX),NL(NY,NX) + IF(M.NE.MX)THEN + CO2S2(L,NY,NX)=CO2S2(L,NY,NX)+TCOFLS(L,NY,NX)+RCOFXS(L,NY,NX) + 2+RCOFLZ(L,NY,NX)+RCOBBL(L,NY,NX) + CH4S2(L,NY,NX)=CH4S2(L,NY,NX)+TCHFLS(L,NY,NX)+RCHFXS(L,NY,NX) + 2+RCHFLZ(L,NY,NX)+RCHBBL(L,NY,NX) + OXYS2(L,NY,NX)=OXYS2(L,NY,NX)+TOXFLS(L,NY,NX)+ROXFXS(L,NY,NX) + 2+ROXFLZ(L,NY,NX)+ROXBBL(L,NY,NX) + Z2GS2(L,NY,NX)=Z2GS2(L,NY,NX)+TNGFLS(L,NY,NX)+RNGFXS(L,NY,NX) + 2+RNGFLZ(L,NY,NX)+RNGBBL(L,NY,NX) + Z2OS2(L,NY,NX)=Z2OS2(L,NY,NX)+TN2FLS(L,NY,NX)+RN2FXS(L,NY,NX) + 2+RN2FLZ(L,NY,NX)+RN2BBL(L,NY,NX) + ZN3S2(L,NY,NX)=ZN3S2(L,NY,NX)+TN3FLW(L,NY,NX)+RN3FXW(L,NY,NX) + 2+RN3FLZ(L,NY,NX)+RN3BBL(L,NY,NX) + ZNBS2(L,NY,NX)=ZNBS2(L,NY,NX)+TN3FLB(L,NY,NX)+RN3FXB(L,NY,NX) + 2+RN3FBZ(L,NY,NX)+RNBBBL(L,NY,NX) + H2GS2(L,NY,NX)=H2GS2(L,NY,NX)+THGFLS(L,NY,NX)+RHGFXS(L,NY,NX) + 2+RHGFLZ(L,NY,NX)+RHGBBL(L,NY,NX) + DO 9675 K=0,4 + OQC2(K,L,NY,NX)=OQC2(K,L,NY,NX)+TOCFLS(K,L,NY,NX) + 2+ROCFXS(K,L,NY,NX) + OQN2(K,L,NY,NX)=OQN2(K,L,NY,NX)+TONFLS(K,L,NY,NX) + 2+RONFXS(K,L,NY,NX) + OQP2(K,L,NY,NX)=OQP2(K,L,NY,NX)+TOPFLS(K,L,NY,NX) + 2+ROPFXS(K,L,NY,NX) + OQA2(K,L,NY,NX)=OQA2(K,L,NY,NX)+TOAFLS(K,L,NY,NX) + 2+ROAFXS(K,L,NY,NX) + OQCH2(K,L,NY,NX)=OQCH2(K,L,NY,NX)+TOCFHS(K,L,NY,NX) + 2-ROCFXS(K,L,NY,NX) + OQNH2(K,L,NY,NX)=OQNH2(K,L,NY,NX)+TONFHS(K,L,NY,NX) + 2-RONFXS(K,L,NY,NX) + OQPH2(K,L,NY,NX)=OQPH2(K,L,NY,NX)+TOPFHS(K,L,NY,NX) + 2-ROPFXS(K,L,NY,NX) + OQAH2(K,L,NY,NX)=OQAH2(K,L,NY,NX)+TOAFHS(K,L,NY,NX) + 2-ROAFXS(K,L,NY,NX) +9675 CONTINUE + ZNH4S2(L,NY,NX)=ZNH4S2(L,NY,NX)+TN4FLW(L,NY,NX)+RN4FXW(L,NY,NX) + 2+RN4FLZ(L,NY,NX) + ZNO3S2(L,NY,NX)=ZNO3S2(L,NY,NX)+TNOFLW(L,NY,NX)+RNOFXW(L,NY,NX) + 2+RNOFLZ(L,NY,NX) + ZNO2S2(L,NY,NX)=ZNO2S2(L,NY,NX)+TNXFLS(L,NY,NX)+RNXFXS(L,NY,NX) + H2PO42(L,NY,NX)=H2PO42(L,NY,NX)+TH2PFS(L,NY,NX)+RH2PXS(L,NY,NX) + 2+RH2PFZ(L,NY,NX) + ZNH4B2(L,NY,NX)=ZNH4B2(L,NY,NX)+TN4FLB(L,NY,NX)+RN4FXB(L,NY,NX) + 2+RN4FBZ(L,NY,NX) + ZNO3B2(L,NY,NX)=ZNO3B2(L,NY,NX)+TNOFLB(L,NY,NX)+RNOFXB(L,NY,NX) + 2+RNOFBZ(L,NY,NX) + ZNO2B2(L,NY,NX)=ZNO2B2(L,NY,NX)+TNXFLB(L,NY,NX)+RNXFXB(L,NY,NX) + H2POB2(L,NY,NX)=H2POB2(L,NY,NX)+TH2BFB(L,NY,NX)+RH2BXB(L,NY,NX) + 2+RH2BBZ(L,NY,NX) + CO2SH2(L,NY,NX)=CO2SH2(L,NY,NX)+TCOFHS(L,NY,NX)-RCOFXS(L,NY,NX) + CH4SH2(L,NY,NX)=CH4SH2(L,NY,NX)+TCHFHS(L,NY,NX)-RCHFXS(L,NY,NX) + OXYSH2(L,NY,NX)=OXYSH2(L,NY,NX)+TOXFHS(L,NY,NX)-ROXFXS(L,NY,NX) + Z2GSH2(L,NY,NX)=Z2GSH2(L,NY,NX)+TNGFHS(L,NY,NX)-RNGFXS(L,NY,NX) + Z2OSH2(L,NY,NX)=Z2OSH2(L,NY,NX)+TN2FHS(L,NY,NX)-RN2FXS(L,NY,NX) + H2GSH2(L,NY,NX)=H2GSH2(L,NY,NX)+THGFHS(L,NY,NX)-RHGFXS(L,NY,NX) + ZNH4H2(L,NY,NX)=ZNH4H2(L,NY,NX)+TN4FHW(L,NY,NX)-RN4FXW(L,NY,NX) + ZNH3H2(L,NY,NX)=ZNH3H2(L,NY,NX)+TN3FHW(L,NY,NX)-RN3FXW(L,NY,NX) + ZNO3H2(L,NY,NX)=ZNO3H2(L,NY,NX)+TNOFHW(L,NY,NX)-RNOFXW(L,NY,NX) + ZNO2H2(L,NY,NX)=ZNO2H2(L,NY,NX)+TNXFHS(L,NY,NX)-RNXFXS(L,NY,NX) + H2P4H2(L,NY,NX)=H2P4H2(L,NY,NX)+TH2PHS(L,NY,NX)-RH2PXS(L,NY,NX) + ZN4BH2(L,NY,NX)=ZN4BH2(L,NY,NX)+TN4FHB(L,NY,NX)-RN4FXB(L,NY,NX) + ZN3BH2(L,NY,NX)=ZN3BH2(L,NY,NX)+TN3FHB(L,NY,NX)-RN3FXB(L,NY,NX) + ZNOBH2(L,NY,NX)=ZNOBH2(L,NY,NX)+TNOFHB(L,NY,NX)-RNOFXB(L,NY,NX) + ZN2BH2(L,NY,NX)=ZN2BH2(L,NY,NX)+TNXFHB(L,NY,NX)-RNXFXB(L,NY,NX) + H2PBH2(L,NY,NX)=H2PBH2(L,NY,NX)+TH2BHB(L,NY,NX)-RH2BXB(L,NY,NX) + ENDIF + CO2S2(L,NY,NX)=CO2S2(L,NY,NX)+RCODFG(L,NY,NX) + CH4S2(L,NY,NX)=CH4S2(L,NY,NX)+RCHDFG(L,NY,NX) + OXYS2(L,NY,NX)=OXYS2(L,NY,NX)+ROXDFG(L,NY,NX) + Z2GS2(L,NY,NX)=Z2GS2(L,NY,NX)+RNGDFG(L,NY,NX) + Z2OS2(L,NY,NX)=Z2OS2(L,NY,NX)+RN2DFG(L,NY,NX) + ZN3S2(L,NY,NX)=ZN3S2(L,NY,NX)+RN3DFG(L,NY,NX)-RN34SQ(L,NY,NX) + ZNH4S2(L,NY,NX)=ZNH4S2(L,NY,NX)+RN34SQ(L,NY,NX) + ZNBS2(L,NY,NX)=ZNBS2(L,NY,NX)+RNBDFG(L,NY,NX)-RN34BQ(L,NY,NX) + ZNH4B2(L,NY,NX)=ZNH4B2(L,NY,NX)+RN34BQ(L,NY,NX) + H2GS2(L,NY,NX)=H2GS2(L,NY,NX)+RHGDFG(L,NY,NX) + CO2G2(L,NY,NX)=CO2G2(L,NY,NX)+TCOFLG(L,NY,NX)-RCODFG(L,NY,NX) + CH4G2(L,NY,NX)=CH4G2(L,NY,NX)+TCHFLG(L,NY,NX)-RCHDFG(L,NY,NX) + OXYG2(L,NY,NX)=OXYG2(L,NY,NX)+TOXFLG(L,NY,NX)-ROXDFG(L,NY,NX) + Z2GG2(L,NY,NX)=Z2GG2(L,NY,NX)+TNGFLG(L,NY,NX)-RNGDFG(L,NY,NX) + Z2OG2(L,NY,NX)=Z2OG2(L,NY,NX)+TN2FLG(L,NY,NX)-RN2DFG(L,NY,NX) + 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(I.EQ.87.AND.L.EQ.NU(NY,NX))THEN +C WRITE(*,444)'CO2S2',I,J,M,MM,NX,NY,L +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) +C 3,RCODFS(NY,NX),PARG(NY,NX),CCO2E(NY,NX),CCO2SQ +C 4,CO2S2(L,NY,NX)/VOLWM(M,L,NY,NX) +C WRITE(*,444)'OXYS2',I,J,M,MX,NX,NY,L +C 2,OXYS2(L,NY,NX),TOXFLS(L,NY,NX),ROXFXS(L,NY,NX) +C 3,ROXFLZ(L,NY,NX),ROXBBL(L,NY,NX),ROXDFG(L,NY,NX) +C 4,ROXSK(M,L,NY,NX),OXYG2(L,NY,NX),ROXFLS(3,L,NY,NX) +C 5,ROXFLS(3,L+1,NY,NX),ROXDFS(NY,NX),ROXSK2(L,NY,NX) +C 6,ROXSK(M,L,NY,NX),VOLWM(M,L,NY,NX) +C WRITE(*,444)'OXYSH2',I,J,M,MX,NX,NY,L +C 2,OXYSH2(L,NY,NX),TOXFHS(L,NY,NX),ROXFXS(L,NY,NX) +C WRITE(*,444)'CH4S2',I,J,NX,NY,L,M,MM,CH4S2(L,NY,NX) +C 2,TCHFLS(L,NY,NX),RCHFXS(L,NY,NX),RCHFLZ(L,NY,NX) +C 3,RCHBBL(L,NY,NX),RCHDFG(L,NY,NX),RCHSK2(L,NY,NX) +C 4,RCHFLS(3,L,NY,NX),RCHFLS(3,L+1,NY,NX) +C 5,RCHDFR(NY,NX),RCHFLS(3,L,NY,NX),RCHSK2(L,NY,NX) +C 3,TQRCHS(NY,NX),RCHDFG(L,NY,NX),XCHFLS(3,L,NY,NX) +C 6,CH4G2(L,NY,NX),TCHFLG(L,NY,NX) +C WRITE(*,444)'Z2GS2',I,J,M,MX,NX,NY,L +C 2,Z2GS2(L,NY,NX),RNGDFG(L,NY,NX),RNGSK2(L,NY,NX) +C 3,RNGDFS(NY,NX),RNGFLS(3,0,NY,NX),TQRNGS(NY,NX) +C 4,TNGFLS(L,NY,NX),RNGFXS(L,NY,NX),RNGFLZ(L,NY,NX) +C 2,RNGBBL(L,NY,NX),Z2GG2(L,NY,NX),TNGFLG(L,NY,NX) +C WRITE(*,444)'ZN3G2',I,J,M,MM,NX,NY,L,ZN3G2(L,NY,NX) +C 2,TN3FLG(L,NY,NX),RN3DFG(L,NY,NX),RN34SQ(L,NY,NX),RNBDFG(L,NY,NX) +C 3,RN34BQ(L,NY,NX),ZN3S2(L,NY,NX),ZNBS2(L,NY,NX) +C 3,ZNH4S2(L,NY,NX),ZNH4B2(L,NY,NX),RNHSK2(L,NY,NX) +C WRITE(*,444)'OXYG2',I,J,M,MM,NX,NY,L,OXYG2(L,NY,NX) +C 2,TOXFLG(L,NY,NX),ROXDFG(L,NY,NX),OXYS2(L,NY,NX) +C 3,ROXFLG(3,L,NY,NX),ROXFLG(3,L+1,NY,NX),DOXYG(3,L,NY,NX) +C 4,THETPM(M,L,NY,NX),PARGOX(NY,NX) +C 6,XOXFLG(3,L,NY,NX),XOXFLG(3,L+1,NY,NX) +C 7,COXYE(NY,NX),FLQM(N,L,NY,NX) +C WRITE(*,444)'N2OG2',I,J,M,MM,NX,NY,L,Z2OG2(L,NY,NX) +C 2,Z2OS2(L,NY,NX),Z2OSH2(L,NY,NX),TN2FLG(L,NY,NX),RN2DFG(L,NY,NX) +C 3,TN2FLS(L,NY,NX),RN2FXS(L,NY,NX),RN2FLZ(L,NY,NX),RN2BBL(L,NY,NX) +C 2,TN2FHS(L,NY,NX),RN2SK2(L,NY,NX),RN2O(L,NY,NX),TUPN2S(L,NY,NX) +C WRITE(*,444)'H2GS2',I,J,NX,NY,M,MM,L,H2GS2(L,NY,NX) +C 2,THGFLS(L,NY,NX),RHGFXS(L,NY,NX),RHGFLZ(L,NY,NX),RHGBBL(L,NY,NX) +C 3,H2GSH2(L,NY,NX),THGFHS(L,NY,NX),RHGDFG(L,NY,NX),RHGSK2(L,NY,NX) +C 4,RH2GO(L,NY,NX),TUPHGS(L,NY,NX) +444 FORMAT(A8,7I4,20E16.6) +C ENDIF +9685 CONTINUE + CO2S2(0,NY,NX)=CO2S2(0,NY,NX)+RCODFG(0,NY,NX) + CH4S2(0,NY,NX)=CH4S2(0,NY,NX)+RCHDFG(0,NY,NX) + OXYS2(0,NY,NX)=OXYS2(0,NY,NX)+ROXDFG(0,NY,NX) + Z2GS2(0,NY,NX)=Z2GS2(0,NY,NX)+RNGDFG(0,NY,NX) + Z2OS2(0,NY,NX)=Z2OS2(0,NY,NX)+RN2DFG(0,NY,NX) + ZN3S2(0,NY,NX)=ZN3S2(0,NY,NX)+RN3DFG(0,NY,NX) + H2GS2(0,NY,NX)=H2GS2(0,NY,NX)+RHGDFG(0,NY,NX) + ZN3S2(0,NY,NX)=ZN3S2(0,NY,NX)-RN34SQ(0,NY,NX) + ZNH4S2(0,NY,NX)=ZNH4S2(0,NY,NX)+RN34SQ(0,NY,NX) +C IF(I.EQ.87)THEN +C WRITE(*,1119)'OXYS20',I,J,NX,NY,M,MM,OXYS2(0,NY,NX) +C 2,ROXDFG(0,NY,NX),ROXDFR(NY,NX),ROXFLS(3,0,NY,NX) +C 3,TQROXS(NY,NX),ROXSK2(0,NY,NX),OXYS2(0,NY,NX)/VOLWM(M,0,NY,NX) +C 4,VOLWM(M,0,NY,NX)/VOLA(0,NY,NX),VOLPM(M,0,NY,NX)/VOLA(0,NY,NX) +C 5,VOLWM(M,0,NY,NX),VOLA(0,NY,NX),VOLWG(NY,NX),DFGS(M,0,NY,NX) +C 6,VOLPM(M,NU(NY,NX),NY,NX),VOLWM(M,NU(NY,NX),NY,NX) +C 7,VOLWHM(M,NU(NY,NX),NY,NX) +C WRITE(*,1119)'CH4S2G',I,J,NX,NY,M,MM,CH4S2(0,NY,NX) +C 2,RCHDFG(0,NY,NX) +1119 FORMAT(A8,6I4,20E12.4) +C ENDIF +9690 CONTINUE +9695 CONTINUE + ENDIF + MX=M +30 CONTINUE + RETURN + END + + diff --git a/f77src/trnsfrs.f b/f77src/trnsfrs.f index aee637d..e66a88e 100755 --- a/f77src/trnsfrs.f +++ b/f77src/trnsfrs.f @@ -1957,8 +1957,8 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) C C DIFFUSIVITIES IN CURRENT AND ADJACENT GRID CELL MICROPORES C - TORTL=AMIN1(1.0,(TORT(0,NY,NX)*DLYR(3,0,NY,NX) - 2+TORT(NU(NY,NX),NY,NX)*DLYR(3,NU(NY,NX),NY,NX)) + TORTL=AMIN1(1.0,(TORT(M,0,NY,NX)*DLYR(3,0,NY,NX) + 2+TORT(M,NU(NY,NX),NY,NX)*DLYR(3,NU(NY,NX),NY,NX)) 3/(DLYR(3,0,NY,NX)+DLYR(3,NU(NY,NX),NY,NX))) DISPN=DISP(3,NU(NY,NX),NY,NX)*ABS(FLWRM1/AREA(3,NU(NY,NX),NY,NX)) XDPTHM=XDPTH(3,NU(NY,NX),NY,NX)*(1.0-FMPR(NU(NY,NX),NY,NX)) @@ -3606,8 +3606,8 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) C C DIFFUSIVITIES IN CURRENT AND ADJACENT GRID CELL MICROPORES C - TORTL=(TORT(N3,N2,N1)*DLYR(N,N3,N2,N1) - 2+TORT(N6,N5,N4)*DLYR(N,N6,N5,N4)) + TORTL=(TORT(M,N3,N2,N1)*DLYR(N,N3,N2,N1) + 2+TORT(M,N6,N5,N4)*DLYR(N,N6,N5,N4)) 3/(DLYR(N,N3,N2,N1)+DLYR(N,N6,N5,N4)) DISPN=DISP(N,N6,N5,N4)*ABS(FLWM(M,N,N6,N5,N4)/AREA(N,N6,N5,N4)) XDPTHM=XDPTH(N,N6,N5,N4)*(1.0-FMPR(N6,N5,N4)) @@ -4145,8 +4145,8 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) C C DIFFUSIVITIES IN CURRENT AND ADJACENT GRID CELL MACROPORES C - TORTL=(TORTH(N3,N2,N1)*DLYR(N,N3,N2,N1) - 2+TORTH(N6,N5,N4)*DLYR(N,N6,N5,N4)) + TORTL=(TORTH(M,N3,N2,N1)*DLYR(N,N3,N2,N1) + 2+TORTH(M,N6,N5,N4)*DLYR(N,N6,N5,N4)) 3/(DLYR(N,N3,N2,N1)+DLYR(N,N6,N5,N4)) DISPN=DISP(N,N6,N5,N4)*ABS(FLWHM(M,N,N6,N5,N4)/AREA(N,N6,N5,N4)) XDPTHM=XDPTH(N,N6,N5,N4)*FHOL(N6,N5,N4) diff --git a/f77src/uptake.f b/f77src/uptake.f index ae10478..192669e 100755 --- a/f77src/uptake.f +++ b/f77src/uptake.f @@ -46,7 +46,7 @@ SUBROUTINE uptake(I,J,NHW,NHE,NVN,NVS) PARAMETER(SNH3X=2.852E+02,EMMC=0.98) PARAMETER(ZCKI=1.0E-01,PCKI=1.0E-02,ZPKI=ZCKI/PCKI 2,PZKI=PCKI/ZCKI) - PARAMETER(EXUDR=-0.50E-03,CNKER=1.0E+00,CPKER=1.0E+01 + PARAMETER(FEXUC=0.5E-03,FEXUN=1.0E-02,FEXUP=1.0E-02 2,CNMX=0.20,CPMX=0.020) REAL*4 RI,TKGO,TKSO C REAL*16 B,C @@ -1029,7 +1029,7 @@ SUBROUTINE uptake(I,J,NHW,NHE,NVN,NVS) THETW1=AMAX1(0.0,VOLWM(M,L,NY,NX)/VOLX(L,NY,NX)) IF(THETW1.GT.THETY(L,NY,NX) 2.AND.FPQ(L,NZ).GT.ZEROQ(NZ,NY,NX))THEN - THETM=TORT(L,NY,NX)*THETW1 + THETM=TORT(M,L,NY,NX)*THETW1 RRADS=LOG((FILM(M,L,NY,NX)+RRADL(N,L))/RRADL(N,L)) RTARSX=RTARS(N,L)/RRADS DIFOL=THETM*OLSGL1*RTARSX @@ -1423,40 +1423,52 @@ SUBROUTINE uptake(I,J,NHW,NHE,NVN,NVS) C ROOT EXUDATION OF C, N AND P DEPENDS ON CONCENTRATION DIFFERENCES C BETWEEN ROOT NON-STRUCTURAL POOLS AND SOIL DISSOLVED POOLS C - IF(CCPOLR(N,L,NZ,NY,NX).GT.ZERO - 3.AND.CPOOLR(N,L,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - CCR=AMAX1(CCPOLR(N,L,NZ,NY,NX)/(CCPOLR(N,L,NZ,NY,NX) - 2+CZPOLR(N,L,NZ,NY,NX)*CNKER) - 3,CCPOLR(N,L,NZ,NY,NX)/(CCPOLR(N,L,NZ,NY,NX) - 2+CPPOLR(N,L,NZ,NY,NX)*CPKER)) - CNR=CZPOLR(N,L,NZ,NY,NX)/(CZPOLR(N,L,NZ,NY,NX) - 2+CCPOLR(N,L,NZ,NY,NX)/CNKER) - CPR=CPPOLR(N,L,NZ,NY,NX)/(CPPOLR(N,L,NZ,NY,NX) - 2+CCPOLR(N,L,NZ,NY,NX)/CPKER) - RDFOMC(N,L,NZ,NY,NX)=EXUDR*CCR*TFND(L,NY,NX) - 2*AMAX1(0.0,CPOOLR(N,L,NZ,NY,NX)) - 3/(1.0+(COQC(1,L,NY,NX)+COQA(1,L,NY,NX))/1.0E+03) - RDFOMN(N,L,NZ,NY,NX)=RDFOMC(N,L,NZ,NY,NX) - 2*AMIN1(CNMX,CNR*ZPOOLR(N,L,NZ,NY,NX)/CPOOLR(N,L,NZ,NY,NX)) - RDFOMP(N,L,NZ,NY,NX)=RDFOMC(N,L,NZ,NY,NX) - 2*AMIN1(CPMX,CPR*PPOOLR(N,L,NZ,NY,NX)/CPOOLR(N,L,NZ,NY,NX)) - ELSE - RDFOMC(N,L,NZ,NY,NX)=0.0 - RDFOMN(N,L,NZ,NY,NX)=0.0 - RDFOMP(N,L,NZ,NY,NX)=0.0 - ENDIF -C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.NZ.EQ.3)THEN -C WRITE(*,2224)'RDFOMC',I,J,NX,NY,NZ,L,N,RDFOMC(N,L,NZ,NY,NX) -C 2,RDFOMN(N,L,NZ,NY,NX),RDFOMP(N,L,NZ,NY,NX) + DO 195 K=0,4 + VOLWK=VOLWM(NPH,L,NY,NX)*FOSRH(K,L,NY,NX) + IF(VOLWK.GT.ZEROS(NY,NX) + 2.AND.RTVLW(N,L,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + VOLWT=VOLWK+RTVLW(N,L,NZ,NY,NX) + CPOOLX=AMIN1(1.25E+03*RTVLW(N,L,NZ,NY,NX),CPOOLR(N,L,NZ,NY,NX)) + XFRC=(OQC(K,L,NY,NX)*RTVLW(N,L,NZ,NY,NX) + 2-CPOOLX*VOLWK)/VOLWT + RDFOMC(N,K,L,NZ,NY,NX)=FEXUC*XFRC + IF(OQC(K,L,NY,NX).GT.ZEROS(NY,NX) + 2.AND.CPOOLR(N,L,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + CPOOLT=OQC(K,L,NY,NX)+CPOOLR(N,L,NZ,NY,NX) + ZPOOLX=0.1*ZPOOLR(N,L,NZ,NY,NX) + PPOOLX=0.1*PPOOLR(N,L,NZ,NY,NX) + XFRN=(OQN(K,L,NY,NX)*CPOOLR(N,L,NZ,NY,NX) + 2-ZPOOLX*OQC(K,L,NY,NX))/CPOOLT + XFRP=(OQP(K,L,NY,NX)*CPOOLR(N,L,NZ,NY,NX) + 2-PPOOLX*OQC(K,L,NY,NX))/CPOOLT + RDFOMN(N,K,L,NZ,NY,NX)=FEXUN*XFRN + RDFOMP(N,K,L,NZ,NY,NX)=FEXUP*XFRP +C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.NZ.EQ.1)THEN +C WRITE(*,2224)'RDFOMC',I,J,NX,NY,NZ,K,L,N,RDFOMC(N,K,L,NZ,NY,NX) +C 2,RDFOMN(N,K,L,NZ,NY,NX),RDFOMP(N,K,L,NZ,NY,NX) +C 3,OQC(K,L,NY,NX),OQN(K,L,NY,NX),OQP(K,L,NY,NX) C 2,CPOOLR(N,L,NZ,NY,NX),ZPOOLR(N,L,NZ,NY,NX),PPOOLR(N,L,NZ,NY,NX) -C 3,CCR,CNR,CPR,COQC(1,L,NY,NX),COQA(1,L,NY,NX) -C 4,COQC(1,L,NY,NX),COQA(1,L,NY,NX) -C 5,OQN(1,L,NY,NX)/VOLWM(NPH,L,NY,NX) -C 5,OQP(1,L,NY,NX)/VOLWM(NPH,L,NY,NX) -C 6,ZPOOLR(N,L,NZ,NY,NX)/RTVLW(N,L,NZ,NY,NX) -C 6,PPOOLR(N,L,NZ,NY,NX)/RTVLW(N,L,NZ,NY,NX) -2224 FORMAT(A8,7I4,20E12.4) +C 3,VOLWM(NPH,L,NY,NX),RTVLW(N,L,NZ,NY,NX),RTAR1X(N,NZ,NY,NX) +C 4,RTAR2X(N,NZ,NY,NX),RTLGP(N,L,NZ,NY,NX)*PP(NZ,NY,NX) +C 4,WTRTD(N,L,NZ,NY,NX) +C 5,OQC(K,L,NY,NX)/VOLWK +C 5,OQN(K,L,NY,NX)/OQC(K,L,NY,NX) +C 5,OQP(K,L,NY,NX)/OQC(K,L,NY,NX) +C 6,CPOOLR(N,L,NZ,NY,NX)/RTVLW(N,L,NZ,NY,NX) +C 6,ZPOOLX/CPOOLR(N,L,NZ,NY,NX) +C 6,PPOOLX/CPOOLR(N,L,NZ,NY,NX) +2224 FORMAT(A8,8I4,30E12.4) C ENDIF + ELSE + RDFOMN(N,K,L,NZ,NY,NX)=0.0 + RDFOMP(N,K,L,NZ,NY,NX)=0.0 + ENDIF + ELSE + RDFOMC(N,K,L,NZ,NY,NX)=0.0 + RDFOMN(N,K,L,NZ,NY,NX)=0.0 + RDFOMP(N,K,L,NZ,NY,NX)=0.0 + ENDIF +195 CONTINUE C C NUTRIENT UPTAKE C @@ -1467,7 +1479,7 @@ SUBROUTINE uptake(I,J,NHW,NHE,NVN,NVS) C PARAMETERS FOR RADIAL MASS FLOW AND DIFFUSION OF NH4 C FROM SOIL TO ROOT C - ZNSGX=ZNSGL(L,NY,NX)*TORT(L,NY,NX) + ZNSGX=ZNSGL(L,NY,NX)*TORT(NPH,L,NY,NX) PATHL=AMIN1(PATH(N,L),RRADL(N,L)+SQRT(2.0*ZNSGX)) DIFFL=ZNSGX*RTARR(N,L)/LOG(PATHL/RRADL(N,L)) C @@ -1569,7 +1581,7 @@ SUBROUTINE uptake(I,J,NHW,NHE,NVN,NVS) C PARAMETERS FOR RADIAL MASS FLOW AND DIFFUSION OF NO3 C FROM SOIL TO ROOT C - ZOSGX=ZOSGL(L,NY,NX)*TORT(L,NY,NX) + ZOSGX=ZOSGL(L,NY,NX)*TORT(NPH,L,NY,NX) PATHL=AMIN1(PATH(N,L),RRADL(N,L)+SQRT(2.0*ZOSGX)) DIFFL=ZOSGX*RTARR(N,L)/LOG(PATHL/RRADL(N,L)) C @@ -1689,7 +1701,7 @@ SUBROUTINE uptake(I,J,NHW,NHE,NVN,NVS) C PARAMETERS FOR RADIAL MASS FLOW AND DIFFUSION OF PO4 C FROM SOIL TO ROOT C - POSGX=POSGL(L,NY,NX)*TORT(L,NY,NX) + POSGX=POSGL(L,NY,NX)*TORT(NPH,L,NY,NX) PATHL=AMIN1(PATH(N,L),RRADL(N,L)+SQRT(2.0*POSGX)) DIFFL=POSGX*RTARR(N,L)/LOG(PATHL/RRADL(N,L)) C @@ -1838,9 +1850,11 @@ SUBROUTINE uptake(I,J,NHW,NHE,NVN,NVS) RUPN3S(N,L,NZ,NY,NX)=0.0 RCO2P(N,L,NZ,NY,NX)=0.0 RUPOXP(N,L,NZ,NY,NX)=0.0 - RDFOMC(N,L,NZ,NY,NX)=0.0 - RDFOMN(N,L,NZ,NY,NX)=0.0 - RDFOMP(N,L,NZ,NY,NX)=0.0 + DO 395 K=0,4 + RDFOMC(N,K,L,NZ,NY,NX)=0.0 + RDFOMN(N,K,L,NZ,NY,NX)=0.0 + RDFOMP(N,K,L,NZ,NY,NX)=0.0 +395 CONTINUE WFR(N,L,NZ,NY,NX)=1.0 RUNNHP(N,L,NZ,NY,NX)=0.0 RUPNH4(N,L,NZ,NY,NX)=0.0 @@ -1871,18 +1885,20 @@ SUBROUTINE uptake(I,J,NHW,NHE,NVN,NVS) C C TOTAL C,N,P EXCHANGE BETWEEN ROOTS AND SOIL C - UPOMC(NZ,NY,NX)=UPOMC(NZ,NY,NX)+RDFOMC(N,L,NZ,NY,NX) - UPOMN(NZ,NY,NX)=UPOMN(NZ,NY,NX)+RDFOMN(N,L,NZ,NY,NX) - UPOMP(NZ,NY,NX)=UPOMP(NZ,NY,NX)+RDFOMP(N,L,NZ,NY,NX) + DO 295 K=0,4 + UPOMC(NZ,NY,NX)=UPOMC(NZ,NY,NX)+RDFOMC(N,K,L,NZ,NY,NX) + UPOMN(NZ,NY,NX)=UPOMN(NZ,NY,NX)+RDFOMN(N,K,L,NZ,NY,NX) + UPOMP(NZ,NY,NX)=UPOMP(NZ,NY,NX)+RDFOMP(N,K,L,NZ,NY,NX) + XOQCS(K,L,NY,NX)=XOQCS(K,L,NY,NX)-RDFOMC(N,K,L,NZ,NY,NX) + XOQNS(K,L,NY,NX)=XOQNS(K,L,NY,NX)-RDFOMN(N,K,L,NZ,NY,NX) + XOQPS(K,L,NY,NX)=XOQPS(K,L,NY,NX)-RDFOMP(N,K,L,NZ,NY,NX) +295 CONTINUE UPNH4(NZ,NY,NX)=UPNH4(NZ,NY,NX)+RUPNH4(N,L,NZ,NY,NX) 2+RUPNHB(N,L,NZ,NY,NX) UPNO3(NZ,NY,NX)=UPNO3(NZ,NY,NX)+RUPNO3(N,L,NZ,NY,NX) 2+RUPNOB(N,L,NZ,NY,NX) UPH2P(NZ,NY,NX)=UPH2P(NZ,NY,NX)+RUPH2P(N,L,NZ,NY,NX) 2+RUPH2B(N,L,NZ,NY,NX) - XOQCS(1,L,NY,NX)=XOQCS(1,L,NY,NX)-RDFOMC(N,L,NZ,NY,NX) - XOQNS(1,L,NY,NX)=XOQNS(1,L,NY,NX)-RDFOMN(N,L,NZ,NY,NX) - XOQPS(1,L,NY,NX)=XOQPS(1,L,NY,NX)-RDFOMP(N,L,NZ,NY,NX) C IF(J.EQ.12)THEN C WRITE(*,8765)'PLANT',I,J,NX,NY,L,NZ,N,TFOXYX,TFNH4X C 2,TFNO3X,TFPO4X,TFNHBX,TFNOBX,TFPOBX @@ -1903,3 +1919,4 @@ SUBROUTINE uptake(I,J,NHW,NHE,NVN,NVS) 9995 CONTINUE RETURN END + diff --git a/f77src/watsub.f b/f77src/watsub.f index 728adef..8e617fd 100755 --- a/f77src/watsub.f +++ b/f77src/watsub.f @@ -1,3064 +1,3098 @@ - - SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) -C -C THIS SUBROUTINE CACULATES ENERGY BALANCES OF SNOW, RESIDUE -C AND SOIL SURFACES, FREEZING, THAWING, AND HEAT AND WATER -C TRANSFER THROUGH SOIL PROFILES -C - include "parameters.h" - include "blkc.h" - include "blk2a.h" - include "blk2b.h" - include "blk2c.h" - include "blk5.h" - include "blk8a.h" - include "blk8b.h" - include "blk10.h" - include "blk11a.h" - include "blk11b.h" - include "blk13a.h" - include "blk13b.h" - include "blk13c.h" - include "blk15a.h" - include "blk15b.h" - include "blk22a.h" - include "blk22b.h" - include "blk22c.h" - include "blktest.h" - DIMENSION VOLWX1(JZ,JY,JX) - 2,TVOL1(JY,JX),TVOLW(JY,JX),FMAC(JZ,JY,JX),FGRD(JZ,JY,JX) - 3,VOLW1(0:JZ,JY,JX),VOLI1(0:JZ,JY,JX),VOLPX1(JZ,JY,JX) - 4,VHCP1(JZ,JY,JX),TK1(0:JZ,JY,JX),TWFLXL(JZ,JY,JX),TTFLXL(JZ,JY,JX) - 5,VOLP1(0:JZ,JY,JX),WGSG1(JZ,JY,JX),TWFLXH(JZ,JY,JX) - 6,VOLS0(JY,JX),VOLI0(JY,JX),VOLW0(JY,JX),VOLS1(JY,JX) - 7,DPTHS0(JY,JX),VHCP0(JY,JX),TK0(JY,JX),AREAU(JZ,JY,JX) - 8,FLQ0S(JY,JX),FLQ0W(JY,JX),FLQ1(JY,JX),FLH1(JY,JX) - 9,FLY1(JY,JX),HWFLQ0(JY,JX),HWFLQ1(JY,JX),HWFLY1(JY,JX) - 1,RAR(JY,JX),RAGS(JY,JX),WGSG0(JY,JX),WRP(0:JZ,JY,JX),RARG(JY,JX) - 2,RAGR(JY,JX),RAGW(JY,JX),BARE(JY,JX),CVRD(JY,JX),PAREG(JY,JX) - 3,RAG(JY,JX),PARSG(JY,JX),PARER(JY,JX),PARSR(JY,JX),WGSGR0(JY,JX) - 4,VPQ(JY,JX),TKQ(JY,JX),VHCPR1(JY,JX),QR1(2,JV,JH),HQR1(2,JV,JH) - 5,QS1(2,JV,JH),QW1(2,JV,JH),QI1(2,JV,JH),HQS1(2,JV,JH) - 6,TQR1(JY,JX),THQR1(JY,JX),TQS1(JY,JX),TQW1(JY,JX) - 7,TQI1(JY,JX),THQS1(JY,JX),EVAP(JY,JX),DENSS(JY,JX) - 8,EVAPS(JY,JX),EVAPR(JY,JX),TFLX0(JY,JX),WFLXA(JY,JX),WFLXB(JY,JX) - 9,FLW0L(JY,JX),FLW0S(JY,JX),HFLW0L(JY,JX),RFLWV(JY,JX),FLWRL(JY,JX) - 1,HFLWRL(JY,JX),FINHL(JZ,JY,JX),FLWVL(JZ,JY,JX),FLWL(3,JD,JV,JH) - DIMENSION FLWHL(3,JD,JV,JH),HFLWL(3,JD,JV,JH),AVCNHL(3,JD,JV,JH) - 2,TFLWL(JZ,JY,JX),TFLWHL(JZ,JY,JX),THFLWL(JZ,JY,JX) - 3,WFLXL(3,JZ,JY,JX),TFLXL(3,JZ,JY,JX),FLWZ1(JY,JX),FLWS1(JY,JX) - 4,FLWI1(JY,JX),FLSI1(JY,JX),HFLWZ1(JY,JX),HFLSI1(JY,JX) - 5,THRYW(JY,JX),THRMW(JY,JX),THRMS(JY,JX),THRMR(JY,JX) - 6,THRYG(JY,JX),THRYR(JY,JX),RADXW(JY,JX),RADXG(JY,JX) - 7,RADXR(JY,JX),FLWLX(3,JD,JV,JH),TFLWLX(JZ,JY,JX) - 8,FLU1(JZ,JY,JX),HWFLU1(JZ,JY,JX),PSISM1(0:JZ,JY,JX) - 4,ALTG(JY,JX),WFLXLH(3,JZ,JY,JX),DLYRR(JY,JX),WFLXR(JY,JX) - 6,TFLXR(JY,JX),HCNDR(JY,JX),CNDH1(JZ,JY,JX) - 7,THETWX(0:JZ,JY,JX),THETIX(0:JZ,JY,JX),THETPX(0:JZ,JY,JX) - 8,VOLAH1(JZ,JY,JX),VOLWH1(JZ,JY,JX),VOLPH1(JZ,JY,JX) - 9,VOLIH1(JZ,JY,JX),THETPY(0:JZ,JY,JX) - PARAMETER (THETPI=0.00,EMMS=0.98,EMMW=0.98,EMMR=0.98 - 2,RACX=0.0278,RARX=0.0139,RZ=0.0278,RZR=0.0278,RZW=0.0278 - 3,RAM=1.39E-03,HYSTK=1.00,FQS=1.0E-00,DPTHSX=0.05,FPSISR=-4.0) - PARAMETER (Z1S=0.0175,Z2SW=12.0,Z2SD=12.0,Z3SX=0.50 - 2,Z1R=0.0175,Z2RW=3.0,Z2RD=12.0,Z3R=0.50) - PARAMETER (VISCW=1.18E-06,VISCA=1.44E-05,DIFFW=1.45E-07 - 2,DIFFA=2.01E-05,EXPNW=2.07E-04,EXPNA=3.66E-03,GRAV=9.8 - 3,RYLXW=GRAV*EXPNW/(VISCW*DIFFW),RYLXA=GRAV*EXPNA/(VISCA*DIFFA) - 4,PRNTW=VISCW/DIFFW,PRNTA=VISCA/DIFFA - 5,DNUSW=(1.0+(0.492/PRNTW)**0.5625)**0.4444 - 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 - 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 - FQSM=FQS*XNPH - DO 9995 NX=NHW,NHE - DO 9990 NY=NVN,NVS -C -C SET INTERNAL TIME STEPS FROM CYCLES PER HOUR ENTERED IN 'READS' -C XNPH = INTERNAL TIME STEP FOR SNOWPACK, SOIL PROFILE -C XNPR = INTERNAL TIME STEP FOR SURFACE RESIDUE -C - XNPHR=XNPH*XNPR - HYSTX=HYSTK -C -C ADJUST SURFACE ELEVATION USED IN RUNOFF FOR EROSION -C - ALTG(NY,NX)=ALT(NY,NX)-CDPTH(NU(NY,NX),NY,NX) - 2+DLYR(3,NU(NY,NX),NY,NX) -C -C ENTER STATE VARIABLES AND DRIVERS INTO LOCAL ARRAYS -C FOR USE AT INTERNAL TIME STEP -C - VOLS0(NY,NX)=VOLSS(NY,NX) - VOLI0(NY,NX)=VOLIS(NY,NX) - VOLW0(NY,NX)=VOLWS(NY,NX) - VOLS1(NY,NX)=VOLS(NY,NX) - DPTHS0(NY,NX)=DPTHS(NY,NX) - VHCP0(NY,NX)=VHCPW(NY,NX) - TK0(NY,NX)=TKW(NY,NX) - WFLXR(NY,NX)=0.0 - TFLXR(NY,NX)=0.0 - DO 65 L=NU(NY,NX),NL(NY,NX) - IF(CDPTH(L,NY,NX).GE.WDPTH(I,NY,NX))THEN - LWDPTH=L - GO TO 55 - ENDIF -65 CONTINUE -55 CONTINUE -C -C SET INITIAL SOIL VALUES -C - DO 30 L=NU(NY,NX),NL(NY,NX) -C -C ENTER STATE VARIABLES AND DRIVERS INTO LOCAL ARRAYS -C FOR USE AT INTERNAL TIME STEP -C - PSISM1(L,NY,NX)=PSISM(L,NY,NX) - VOLW1(L,NY,NX)=VOLW(L,NY,NX) - VOLWX1(L,NY,NX)=VOLWX(L,NY,NX) - VOLI1(L,NY,NX)=VOLI(L,NY,NX) - VOLWH1(L,NY,NX)=VOLWH(L,NY,NX) - VOLIH1(L,NY,NX)=VOLIH(L,NY,NX) - VOLP1(L,NY,NX)=AMAX1(0.0,VOLA(L,NY,NX)-VOLW1(L,NY,NX) - 2-VOLI1(L,NY,NX)) - VOLAH1(L,NY,NX)=AMAX1(0.0,VOLAH(L,NY,NX)-FVOLAH*CCLAY(L,NY,NX) - 2*(VOLW1(L,NY,NX)/VOLX(L,NY,NX)-WP(L,NY,NX))*VOLT(L,NY,NX)) - VOLPH1(L,NY,NX)=AMAX1(0.0,VOLAH1(L,NY,NX)-VOLWH1(L,NY,NX) - 2-VOLIH1(L,NY,NX)) - VOLPX1(L,NY,NX)=VOLP1(L,NY,NX)*HYST(L,NY,NX) - VOLWM(1,L,NY,NX)=VOLW1(L,NY,NX) - VOLWHM(1,L,NY,NX)=VOLWH1(L,NY,NX) - VOLPM(1,L,NY,NX)=VOLP1(L,NY,NX)+VOLPH1(L,NY,NX) - 2+THETPI*(VOLI1(L,NY,NX)+VOLIH1(L,NY,NX)) - THETWX(L,NY,NX)=AMAX1(0.0,(VOLW1(L,NY,NX)+VOLWH1(L,NY,NX)) - 2/VOLT(L,NY,NX)) - THETIX(L,NY,NX)=AMAX1(0.0,(VOLI1(L,NY,NX)+VOLIH1(L,NY,NX)) - 2/VOLT(L,NY,NX)) - THETPX(L,NY,NX)=AMAX1(0.0,(VOLP1(L,NY,NX)+VOLPH1(L,NY,NX)) - 2/VOLT(L,NY,NX)) - THETPM(1,L,NY,NX)=THETPX(L,NY,NX) - VHCP1(L,NY,NX)=VHCM(L,NY,NX)+4.19*(VOLW1(L,NY,NX) - 2+VOLWH1(L,NY,NX))+1.9274*(VOLI1(L,NY,NX)+VOLIH1(L,NY,NX)) - IF(VOLA(L,NY,NX)+VOLAH(L,NY,NX).GT.ZEROS(NY,NX))THEN - THETPY(L,NY,NX)=AMAX1(0.0,(VOLP1(L,NY,NX)+VOLPH1(L,NY,NX)) - 2/(VOLA(L,NY,NX)+VOLAH(L,NY,NX))) - ELSE - THETPY(L,NY,NX)=0.0 - ENDIF -C -C MACROPOROSITY -C - IF(VOLAH(L,NY,NX).GT.ZEROS(NY,NX))THEN - FMAC(L,NY,NX)=FHOL(L,NY,NX)*VOLAH1(L,NY,NX)/VOLAH(L,NY,NX) - CNDH1(L,NY,NX)=XNPH*NHOL(L,NY,NX)*CNDH(L,NY,NX) - 2*(VOLAH1(L,NY,NX)/VOLAH(L,NY,NX))**2 - ELSE - FMAC(L,NY,NX)=0.0 - CNDH1(L,NY,NX)=0.0 - ENDIF - FGRD(L,NY,NX)=1.0-FMAC(L,NY,NX) - TK1(L,NY,NX)=TKS(L,NY,NX) - IF(L.EQ.LWDPTH)THEN - FLU(L,NY,NX)=PRECU(NY,NX) - HWFLU(L,NY,NX)=4.19*TKA(NY,NX)*PRECU(NY,NX) - FLU1(L,NY,NX)=FLU(L,NY,NX)*XNPH - HWFLU1(L,NY,NX)=HWFLU(L,NY,NX)*XNPH - ELSE - FLU(L,NY,NX)=0.0 - HWFLU(L,NY,NX)=0.0 - FLU1(L,NY,NX)=0.0 - HWFLU1(L,NY,NX)=0.0 - ENDIF - IF(CDPTH(L,NY,NX).GE.DTBLX(NY,NX))THEN - AREAU(L,NY,NX)=AMIN1(1.0,AMAX1(0.0 - 2,(CDPTH(L,NY,NX)-DTBLX(NY,NX)) - 2/DLYR(3,L,NY,NX))) - ELSE - AREAU(L,NY,NX)=0.0 - ENDIF -30 CONTINUE -C -C ENTER STATE VARIABLES AND DRIVERS INTO LOCAL ARRAYS -C FOR USE AT INTERNAL TIME STEP -C - THRMG(NY,NX)=0.0 - FLQGM(NY,NX)=0.0 -C -C INITIALIZE SNOW AND SOIL-RESIDUE THERMAL CONDUCTIVITIES -C - VHCPR1(NY,NX)=2.496E-06*ORGC(0,NY,NX)+4.19*VOLW(0,NY,NX) - 2+1.9274*VOLI(0,NY,NX) - VOLW1(0,NY,NX)=AMAX1(0.0,VOLW(0,NY,NX)) - VOLI1(0,NY,NX)=AMAX1(0.0,VOLI(0,NY,NX)) - VOLP1(0,NY,NX)=AMAX1(0.0,VOLA(0,NY,NX)-VOLW1(0,NY,NX) - 2-VOLI1(0,NY,NX)) - VOLWM(1,0,NY,NX)=VOLW1(0,NY,NX) - VOLPM(1,0,NY,NX)=VOLP1(0,NY,NX) - TVOL1(NY,NX)=AMAX1(0.0,VOLW1(0,NY,NX)+VOLI1(0,NY,NX) - 2-VOLWRX(NY,NX)) - TVOLW(NY,NX)=AMAX1(0.0,VOLW1(0,NY,NX)-VOLWRX(NY,NX)) - VOLGM(1,NY,NX)=AMAX1(0.0,TVOL1(NY,NX)) - THETWX(0,NY,NX)=AMAX1(0.0,VOLW1(0,NY,NX)/VOLT(0,NY,NX)) - THETIX(0,NY,NX)=AMAX1(0.0,VOLI1(0,NY,NX)/VOLT(0,NY,NX)) - THETPX(0,NY,NX)=AMAX1(0.0,VOLP1(0,NY,NX)/VOLT(0,NY,NX)) - THETPM(1,0,NY,NX)=THETPX(0,NY,NX) - PSISM1(0,NY,NX)=PSISM(0,NY,NX) - TK1(0,NY,NX)=TKS(0,NY,NX) -C -C RESIDUE COVERAGE OF SOIL SURFACE -C - IF(BKDS(NU(NY,NX),NY,NX).GT.ZERO)THEN - BARE(NY,NX)=AMAX1(0.0,EXP(-0.8E-02*(TRC0(NY,NX)/AREA(3,0,NY,NX))) - 2-AMIN1(1.0,TVOLW(NY,NX)/VOLWG(NY,NX))) - ELSE - BARE(NY,NX)=0.0 - ENDIF - CVRD(NY,NX)=1.0-BARE(NY,NX) - PRECD(NY,NX)=PRECA(NY,NX)*FRADG(NY,NX)*BARE(NY,NX) - PRECB(NY,NX)=(PRECA(NY,NX)-PRECD(NY,NX)-TFLWC(NY,NX))*BARE(NY,NX) -C -C VARIABLES TO TRANSFER SNOWPACK INTO SOIL SURFACE AT FINAL MELT -C - IF(VHCPW(NY,NX).LE.VHCPWX(NY,NX).AND.DPTHS(NY,NX).GT.0.0 - 2.AND.TKA(NY,NX).GT.273.15)THEN - FLWZ=VOLWS(NY,NX) - FLWS=VOLSS(NY,NX)/0.92 - FLWI=VOLIS(NY,NX) - FLWSI(NY,NX)=FLWS+FLWI - HFLWZ=4.19*FLWZ*TKW(NY,NX) - HFLWSI(NY,NX)=1.9274*(FLWS+FLWI)*TKW(NY,NX) - WDISP=VOLWS(NY,NX)+VOLSS(NY,NX)+VOLIS(NY,NX)*0.92 - ELSE - FLWZ=0.0 - FLWS=0.0 - FLWI=0.0 - HFLWZ=0.0 - FLWSI(NY,NX)=0.0 - HFLWSI(NY,NX)=0.0 - WDISP=0.0 - ENDIF -C -C RESIDUE WATER ABSORPTION CAPACITY -C - HCNDRX=HCNDRR*CVRD(NY,NX) - HCNDR(NY,NX)=HCNDRX*XNPH - DLYRR(NY,NX)=AMIN1(5.0E-02,AMAX1(1.0E-06,DLYR(3,0,NY,NX))) -C -C DISCHARGE OF MELTWATER AND ITS HEAT FROM SNOWPACK -C TO RESIDUE, SOIL SURFACE AND MACROPORES -C - IF(VHCPW(NY,NX).GT.VHCPWX(NY,NX))THEN - WMELT=AMAX1(0.0,AMAX1(0.0,VOLWS(NY,NX)) - 2-0.05*AMAX1(0.0,VOLSS(NY,NX))) - FLWQR=WMELT*CVRD(NY,NX) - HFLWQR=4.19*TKW(NY,NX)*FLWQR - FLWQG=WMELT-FLWQR - HFLWQG=4.19*TKW(NY,NX)*FLWQG - FLWQGS=FLWQG*FGRD(NU(NY,NX),NY,NX) - FLWQGH=FLWQG*FMAC(NU(NY,NX),NY,NX) - ELSE - WMELT=0.0 - FLWQR=0.0 - HFLWQR=0.0 - FLWQG=0.0 - HFLWQG=0.0 - FLWQGS=0.0 - FLWQGH=0.0 - ENDIF - FLQRM(NY,NX)=FLWQR - FLQGM(NY,NX)=FLWQG+WDISP -C -C DISTRIBUTION OF PRECIPITATION AND ITS HEAT AMONG SURFACE -C RESIDUE, SOIL SURFACE, AND MACROPORES -C - IF(PRECA(NY,NX).GT.0.0.OR.PRECW(NY,NX).GT.0.0)THEN - IF(VHCPW(NY,NX).GT.VHCPWX(NY,NX))THEN - FLWQW=PRECA(NY,NX)-TFLWC(NY,NX) - FLWSW=PRECW(NY,NX) - HFLWSW=2.095*TKA(NY,NX)*FLWSW+4.19*TKA(NY,NX)*FLWQW - FLWQBX=0.0 - HFLWQB=0.0 - FLWQAX=0.0 - HFLWQA=0.0 - FLWQAS=0.0 - FLWQAH=0.0 - ELSE - FLWQW=0.0 - FLWSW=PRECW(NY,NX) - HFLWSW=2.095*TKA(NY,NX)*FLWSW - FLWQBX=(PRECA(NY,NX)-TFLWC(NY,NX))*CVRD(NY,NX) - HFLWQB=4.19*TKA(NY,NX)*FLWQBX - FLWQAX=PRECA(NY,NX)-TFLWC(NY,NX)-FLWQBX - HFLWQA=4.19*TKA(NY,NX)*FLWQAX - FLWQAS=FLWQAX*FGRD(NU(NY,NX),NY,NX) - FLWQAH=FLWQAX*FMAC(NU(NY,NX),NY,NX) - ENDIF - ELSE - IF(VHCPW(NY,NX).GT.VHCPWX(NY,NX))THEN - FLWQW=-TFLWC(NY,NX) - FLWSW=0.0 - HFLWSW=4.19*TKA(NY,NX)*FLWQW - FLWQBX=0.0 - HFLWQB=0.0 - FLWQAX=0.0 - HFLWQA=0.0 - FLWQAS=0.0 - FLWQAH=0.0 - ELSE - FLWQW=0.0 - FLWSW=0.0 - HFLWSW=0.0 - FLWQBX=-TFLWC(NY,NX)*CVRD(NY,NX) - HFLWQB=4.19*TKA(NY,NX)*FLWQBX - FLWQAX=-TFLWC(NY,NX)-FLWQBX - HFLWQA=4.19*TKA(NY,NX)*FLWQAX - FLWQAS=FLWQAX*FGRD(NU(NY,NX),NY,NX) - FLWQAH=FLWQAX*FMAC(NU(NY,NX),NY,NX) - ENDIF - ENDIF -C -C PRECIP ON SNOW -C - IF(PRECW(NY,NX).GT.0.0.OR.(PRECR(NY,NX).GT.0.0 - 2.AND.VHCPW(NY,NX).GT.VHCPWX(NY,NX)))THEN - FLQRQ(NY,NX)=0.0 - FLQRI(NY,NX)=0.0 - FLQGQ(NY,NX)=PRECQ(NY,NX) - FLQGI(NY,NX)=PRECI(NY,NX) - ELSEIF((PRECQ(NY,NX).GT.0.0.OR.PRECI(NY,NX).GT.0.0) - 2.AND.VHCPW(NY,NX).LE.VHCPWX(NY,NX))THEN - FLQRQ(NY,NX)=FLWQBX*PRECQ(NY,NX)/(PRECQ(NY,NX)+PRECI(NY,NX)) - FLQRI(NY,NX)=FLWQBX*PRECI(NY,NX)/(PRECQ(NY,NX)+PRECI(NY,NX)) - FLQGQ(NY,NX)=PRECQ(NY,NX)-FLQRQ(NY,NX) - FLQGI(NY,NX)=PRECI(NY,NX)-FLQRI(NY,NX) - ELSE - FLQRQ(NY,NX)=0.0 - FLQRI(NY,NX)=0.0 - FLQGQ(NY,NX)=0.0 - FLQGI(NY,NX)=0.0 - ENDIF -C -C GATHER PRECIPITATION AND MELTWATER FLUXES AND THEIR HEATS -C AMONG ATMOSPHERE, SNOWPACK, RESIDUE AND SOIL SURFACES -C INTO LOCAL ARRAYS FOR USE IN MASS AND ENERGY EXCHANGE -C ALGORITHMS -C - FLQ0W(NY,NX)=(FLWQW-FLWQR-FLWQGS-FLWQGH)*XNPH - FLQ0S(NY,NX)=FLWSW*XNPH - HWFLQ0(NY,NX)=(HFLWSW-HFLWQG-HFLWQR)*XNPH - FLQ1(NY,NX)=(FLWQAS+FLWQGS+FLWZ)*XNPH - FLH1(NY,NX)=(FLWQAH+FLWQGH)*XNPH - FLY1(NY,NX)=(FLWQBX+FLWQR)*XNPH - HWFLQ1(NY,NX)=(HFLWQA+HFLWQG+HFLWZ)*XNPH - HWFLY1(NY,NX)=(HFLWQB+HFLWQR)*XNPH - FLWZ1(NY,NX)=FLWZ*XNPH - FLWS1(NY,NX)=FLWS*0.92*XNPH - FLWI1(NY,NX)=FLWI*XNPH - HFLWZ1(NY,NX)=HFLWZ*XNPH - FLSI1(NY,NX)=FLWSI(NY,NX)*XNPH - HFLSI1(NY,NX)=HFLWSI(NY,NX)*XNPH - RFLWV(NY,NX)=1.0E-02*XNPH -C IF(I.EQ.118.AND.NX.EQ.3.AND.NY.EQ.4)THEN -C WRITE(*,4422)'FLQ0W',I,J,FLQ0W(NY,NX),FLWQW -C 2,FLWQR,FLWQGS,FLWQGH,XNPH -C WRITE(*,4422)'FLY',I,J,PRECA(NY,NX),TFLWC(NY,NX),FLY1(NY,NX) -C 2,PSISM1(0,NY,NX),PSISM(0,NY,NX) -C 2,FLQ1(NY,NX),FLH1(NY,NX),FLWQBX,FLWQR -C 2,FLWQAS,FLWQGS,FLWZ,FLWQAH,FLWQGH -C 3,FGRD(NU(NY,NX),NY,NX),FMAC(NU(NY,NX),NY,NX) -C 4,FHOL(L,NY,NX),VOLAH1(L,NY,NX),VOLAH(L,NY,NX) -C 5,FLWQAX,PRECA(NY,NX),TFLWC(NY,NX),FLWQBX,CVRD(NY,NX) -C 6,BARE(NY,NX),TRC0(NY,NX),TVOLW(NY,NX),VOLWG(NY,NX) -C 7,VOLW1(0,NY,NX),VOLWRX(NY,NX) -4422 FORMAT(A8,2I4,40E12.4) -C ENDIF -C -C INITIALIZE PARAMETERS, FLUXES FOR ENERGY EXCHANGE -C AT SNOW, RESIDUE AND SOIL SURFACES -C - RADXW(NY,NX)=RADG(NY,NX)*XNPH - RADXG(NY,NX)=RADXW(NY,NX)*BARE(NY,NX) - RADXR(NY,NX)=RADXW(NY,NX)*CVRD(NY,NX)*XNPR - THRYW(NY,NX)=(THS(NY,NX)*FRADG(NY,NX)+THRMCX(NY,NX))*XNPH - THRYG(NY,NX)=THRYW(NY,NX)*BARE(NY,NX) - THRYR(NY,NX)=THRYW(NY,NX)*CVRD(NY,NX)*XNPR - THRMW(NY,NX)=EMMW*2.04E-10*AREA(3,NU(NY,NX),NY,NX)*XNPH - THRMS(NY,NX)=EMMS*2.04E-10*AREA(3,NU(NY,NX),NY,NX)*XNPH - 2*BARE(NY,NX) - THRMR(NY,NX)=EMMR*2.04E-10*AREA(3,NU(NY,NX),NY,NX)*XNPHR - 2*CVRD(NY,NX) -C -C AERODYNAMIC RESISTANCE OF CANOPY TO SNOW/RESIDUE/SOIL -C SURFACE ENERGY EXCHANGE WITH ATMOSPHERE -C - ALFZ=2.0*(1.0-FRADG(NY,NX)) - IF(RAB(NY,NX).GT.ZERO.AND.ZT(NY,NX).GT.ZS(NY,NX) - 2.AND.ALFZ.GT.ZERO)THEN - RAC(NY,NX)=AMIN1(RACX,AMAX1(0.0,ZT(NY,NX)*EXP(ALFZ) - 2/(ALFZ/RAB(NY,NX))*AMAX1(0.0,EXP(-ALFZ*ZS(NY,NX)/ZT(NY,NX)) - 3-EXP(-ALFZ*(ZD(NY,NX)+ZR(NY,NX))/ZT(NY,NX))))) - UAG=UA(NY,NX)*EXP(-ALFZ) - ELSE - RAC(NY,NX)=0.0 - UAG=UA(NY,NX) - ENDIF - VPQ(NY,NX)=VPA(NY,NX)-1.0*TLEX(NY,NX) - 2/(VAP*AREA(3,NU(NY,NX),NY,NX)) - TKQ(NY,NX)=TKA(NY,NX)-1.0*TSHX(NY,NX) - 2/(1.25E-03*AREA(3,NU(NY,NX),NY,NX)) -C -C AERODYNAMIC RESISTANCE OF RESIDUE TO SOIL -C SURFACE ENERGY EXCHANGE WITH ATMOSPHERE -C Soil Sci. Soc. Am. J. 48:25-32 -C - WGSG0(NY,NX)=WGSGW(NY,NX)*XNPH - WGSGR0(NY,NX)=WGSGR(NY,NX)*XNPH - DO 25 L=NU(NY,NX),NL(NY,NX) - IF(POROS(L,NY,NX).GT.0.0)THEN - WFPS=THETW(L,NY,NX)/POROS(L,NY,NX) - ELSE - WFPS=1.0 - ENDIF - FWGWP=AMAX1(1.0,10.0-50.0*WP(L,NY,NX)) - FWGSG=9.5+2.0*WFPS-8.5*EXP(-((FWGWP*WFPS)**3)) - WGSG1(L,NY,NX)=FWGSG*WGSGL(L,NY,NX)*XNPH -25 CONTINUE - RAR(NY,NX)=DLYRR(NY,NX)/WGSGR(NY,NX) - RAR1=RAR(NY,NX)/AMAX1(ZERO,THETPX(0,NY,NX))**2.33 - RAG(NY,NX)=RAC(NY,NX)+RAB(NY,NX) - RAGW(NY,NX)=RAG(NY,NX) - RAGR(NY,NX)=RAG(NY,NX)+RARX - RARG(NY,NX)=RAGR(NY,NX) - RAGS(NY,NX)=RAG(NY,NX)+RAR1 - PARG(NY,NX)=AREA(3,NU(NY,NX),NY,NX)*XNPH/RAGS(NY,NX) - PARR(NY,NX)=AREA(3,NU(NY,NX),NY,NX)*XNPH/RAGR(NY,NX) - PAREG(NY,NX)=AREA(3,NU(NY,NX),NY,NX)*XNPH - PARER(NY,NX)=PAREG(NY,NX)*XNPR*CVRD(NY,NX) - PARSG(NY,NX)=1.25E-03*AREA(3,NU(NY,NX),NY,NX)*XNPH - PARSR(NY,NX)=PARSG(NY,NX)*XNPR*CVRD(NY,NX) -C IF(I.EQ.287)THEN -C WRITE(*,3111)'RAC',I,J,ALFZ,RAC(NY,NX),ZT(NY,NX),RAB(NY,NX) -C 2,RAR(NY,NX),RAR1,PARG(NY,NX),PARR(NY,NX) -C 3,DLYRR(NY,NX),RAG(NY,NX),RAGS(NY,NX),RAGR(NY,NX) -C 4,THETPX(0,NY,NX),WGSGR(NY,NX) -C 4,TLEX(NY,NX),TSHX(NY,NX),RADG(NY,NX),THS(NY,NX) -C 5,FRADG(NY,NX),THRMCX(NY,NX),ZS(NY,NX) -3111 FORMAT(A8,2I4,30E12.4) -C ENDIF -9990 CONTINUE -9995 CONTINUE -C -C INITIALIZE SOIL HYDRAULIC PARAMETERS IN LOCAL ARRAYS -C FOR LATER USE IN WATER TRANSFER ALGORITHMS -C - DO 9985 NX=NHW,NHE - DO 9980 NY=NVN,NVS - DO 35 L=NU(NY,NX),NL(NY,NX) - DO 40 N=NCN(NY,NX),3 - TFLXL(N,L,NY,NX)=0.0 - WFLXL(N,L,NY,NX)=0.0 - WFLXLH(N,L,NY,NX)=0.0 - N1=NX - N2=NY - N3=L - IF(N.EQ.1)THEN - IF(NX.EQ.NHE)THEN - GO TO 50 - ELSE - N4=NX+1 - N5=NY - N6=L - ENDIF - ELSEIF(N.EQ.2)THEN - IF(NY.EQ.NVS)THEN - GO TO 50 - ELSE - N4=NX - N5=NY+1 - N6=L - ENDIF - ELSEIF(N.EQ.3)THEN - IF(L.EQ.NL(NY,NX))THEN - GO TO 50 - ELSE - N4=NX - N5=NY - N6=L+1 - ENDIF - ENDIF -C -C MACROPORE CONDUCTIVITY FROM 'HOUR1' AND GRAVITATIONAL -C GRADIENT USED TO CALCULATE MACROPORE FLOW FOR USE BELOW -C - IF(CNDH1(N3,N2,N1).GT.ZERO.AND.CNDH1(N6,N5,N4) - 2.GT.ZERO)THEN - AVCNHL(N,N6,N5,N4)=2.0*CNDH1(N3,N2,N1)*CNDH1(N6,N5,N4) - 2/(CNDH1(N3,N2,N1)*DLYR(N,N6,N5,N4)+CNDH1(N6,N5,N4) - 3*DLYR(N,N3,N2,N1)) - ELSE - AVCNHL(N,N6,N5,N4)=0.0 - ENDIF -50 CONTINUE -40 CONTINUE -35 CONTINUE -9980 CONTINUE -9985 CONTINUE -C -C DYNAMIC LOOP FOR FLUX CALCULATIONS -C - DO 3320 M=1,NPH - DO 9895 NX=NHW,NHE - DO 9890 NY=NVN,NVS - TQR1(NY,NX)=0.0 - THQR1(NY,NX)=0.0 - TQS1(NY,NX)=0.0 - TQW1(NY,NX)=0.0 - TQI1(NY,NX)=0.0 - THQS1(NY,NX)=0.0 -C -C WATER REPELLENCY AND GAS EXCHANGE COEFFICIENTS -C - WRP(0,NY,NX)=1.0/(1.0+(AMAX1(-1.5 - 2,PSISM1(0,NY,NX))/PSISXR)**3) - IF(VOLA(0,NY,NX).GT.VOLI1(0,NY,NX) - 2.AND.VOLW1(0,NY,NX).GT.ZEROS(NY,NX))THEN - THETWA=AMIN1(1.0,VOLW1(0,NY,NX)/(VOLA(0,NY,NX)-VOLI1(0,NY,NX))) - TFND1=(TK1(0,NY,NX)/298.15)**6 - IF(THETWA.GT.Z3R)THEN - DFGS(M,0,NY,NX)=AMAX1(0.0 - 2,TFND1*XNPD/((Z1R**-1)*EXP(Z2RW*(THETWA-Z3R)))) - ELSE - DFGS(M,0,NY,NX)=AMIN1(1.0 - 2,TFND1*XNPD/((Z1R**-1)*EXP(Z2RD*(THETWA-Z3R)))) - ENDIF - ELSE - DFGS(M,0,NY,NX)=0.0 - ENDIF - DO 9885 L=NU(NY,NX),NL(NY,NX) - TWFLXL(L,NY,NX)=0.0 - TWFLXH(L,NY,NX)=0.0 - TTFLXL(L,NY,NX)=0.0 - TFLWL(L,NY,NX)=0.0 - TFLWLX(L,NY,NX)=0.0 - TFLWHL(L,NY,NX)=0.0 - THFLWL(L,NY,NX)=0.0 - WRP(L,NY,NX)=1.0/(1.0+(AMAX1(-1.5 - 2,PSISM1(L,NY,NX))/PSISX)**3) - VOLWT=VOLW1(L,NY,NX)+VOLWH1(L,NY,NX) - VOLAT=VOLA(L,NY,NX)+VOLAH(L,NY,NX) - 2-VOLI1(L,NY,NX)-VOLIH1(L,NY,NX) - IF(VOLWT.GT.ZEROS(NY,NX).AND.VOLAT.GT.ZEROS(NY,NX))THEN - THETWA=VOLWT/VOLAT - TFND1=(TK1(L,NY,NX)/298.15)**6 - Z3S=AMAX1(Z3SX,FC(L,NY,NX)/POROS(L,NY,NX)) - IF(THETWA.GT.Z3S)THEN - DFGS(M,L,NY,NX)=AMAX1(0.0 - 2,TFND1*XNPD/((Z1S**-1)*EXP(Z2SW*(THETWA-Z3S)))) - ELSE - DFGS(M,L,NY,NX)=AMIN1(1.0 - 2,TFND1*XNPD/((Z1S**-1)*EXP(Z2SD*(THETWA-Z3S)))) - ENDIF - ELSE - DFGS(M,L,NY,NX)=0.0 - ENDIF -C IF(L.EQ.NU(NY,NX))THEN -C WRITE(*,3377)'DFGS',I,J,M,NX,NY,L,DFGS(M+1,L,NY,NX) -C 2,XNPD,TFACL,Z1S,Z2S,THETWA,Z3S,Z2S*(THETWA-Z3S) -C 3,EXP(Z2S*(THETWA-Z3S)),Z1S**-1 -C 4,(Z1S**-1)*EXP(Z2S*(THETWA-Z3S)) -9885 CONTINUE -C -C REDISTRIBUTE INCOMING MELTWATER OR PRECIPITATION -C BETWEEN RESIDUE AND SOIL SURFACE -C - VOLWRM=AMAX1(0.0,VOLWRX(NY,NX)-VOLW1(0,NY,NX)-VOLI1(0,NY,NX)) - FLWR1=AMAX1(0.0,FLY1(NY,NX)-VOLWRM) - HFLWR1=4.19*TKA(NY,NX)*FLWR1 - FLYM=FLY1(NY,NX)-FLWR1 - HWFLYM=HWFLY1(NY,NX)-HFLWR1 - FLQM=FLQ1(NY,NX)+FLWR1*FGRD(NU(NY,NX),NY,NX) - FLHM=FLH1(NY,NX)+FLWR1*FMAC(NU(NY,NX),NY,NX) - HWFLQM=HWFLQ1(NY,NX)+HFLWR1 -C -C REDISTRIBUTE SURFACE WATER FROM WATER REPELLANCY -C -C FLWPR=FLYM*(1.0-WRP(0,NY,NX)) -C HFLWPR=4.19*TKA(NY,NX)*FLWPR -C FLYM=FLYM-FLWPR -C HWFLYM=HWFLYM-HFLWPR -C FLQM=FLQM+FLWPR*FGRD(NU(NY,NX),NY,NX) -C FLHM=FLHM+FLWPR*FMAC(NU(NY,NX),NY,NX) -C HWFLQM=HWFLQM+HFLWPR -C FLWP1=FLQM*(1.0-WRP(NU(NY,NX),NY,NX)) -C FLQM=FLQM-FLWP1 -C FLHM=FLHM+FLWP1 - FLYM2=FLYM*XNPR - HWFLM2=HWFLYM*XNPR -C IF(NX.EQ.4.AND.NY.EQ.5)THEN -C WRITE(*,3132)'FLWR1',I,J,M,NX,NY,FLY1(NY,NX),FLQ1(NY,NX) -C 2,VHCP0(NY,NX),VHCPWX(NY,NX) -C 2,FLH1(NY,NX),FLYM,FLQM,FLHM,VOLWRM,FLWR1 -C 3,FMAC(NU(NY,NX),NY,NX),FGRD(NU(NY,NX),NY,NX) -C 5,VOLAH(NU(NY,NX),NY,NX),FVOLAH,CCLAY(NU(NY,NX),NY,NX) -C 4,VOLW1(NU(NY,NX),NY,NX),VOLX(NU(NY,NX),NY,NX),WP(L,NY,NX) -C 2,VOLT(NU(NY,NX),NY,NX),VOLAH1(NU(NY,NX),NY,NX) -C 5,VOLWRX(NY,NX),VOLW1(0,NY,NX),VOLI1(0,NY,NX) -C 6,WRP(0,NY,NX),WRP(NU(NY,NX),NY,NX),PSISM1(0,NY,NX) -C 7,PSISM1(NU(NY,NX),NY,NX) -3132 FORMAT(A8,5I4,40E12.4) -C ENDIF -C -C ENERGY EXCHANGE AT SNOW SURFACE IF PRESENT -C - IF(VHCP0(NY,NX).GT.VHCPWX(NY,NX))THEN -C -C PHYSICAL AND HYDRAULIC PROPERTIES OF SNOWPACK INCLUDING -C AIR AND WATER-FILLED POROSITY, WATER POTENTIAL OF UNDERLYING -C SOIL SURFACE USED IN FLUX CALCULATIONS -C - DENSS(NY,NX)=AMIN1(0.6,DENS0(NY,NX)+DENS1(NY,NX)*VOLS0(NY,NX) - 2/AREA(3,NU(NY,NX),NY,NX)) - VOLS1(NY,NX)=VOLS0(NY,NX)/DENSS(NY,NX)+VOLW0(NY,NX)+VOLI0(NY,NX) - DPTHS0(NY,NX)=VOLS1(NY,NX)/AREA(3,NU(NY,NX),NY,NX) - THETP0=AMAX1(THETPI,1.0-(VOLS0(NY,NX)+VOLI0(NY,NX) - 2+VOLW0(NY,NX))/VOLS1(NY,NX)) - 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))) -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) - 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 - PSISM1(NU(NY,NX),NY,NX)=-EXP(PSIMS(NY,NX) - 2+(((PSL(NU(NY,NX),NY,NX)-LOG(THETW1)) - 3/PSD(NU(NY,NX),NY,NX))**SRP(NU(NY,NX),NY,NX)*PSISD(NY,NX))) - ELSE - PSISM1(NU(NY,NX),NY,NX)=PSISE(NU(NY,NX),NY,NX) - ENDIF -C ELSE -C PSISM1(NU(NY,NX),NY,NX)=PSISE(NU(NY,NX),NY,NX) -C ENDIF - PSISV1=PSISM1(NU(NY,NX),NY,NX)+PSISO(NU(NY,NX),NY,NX) -C -C SNOWPACK ALBEDO, NET RADIATION -C - ALBW=(0.85*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) - RFLX1=(1.0-ALBG)*RADXW(NY,NX)+THRYW(NY,NX) - THRMX=THRMW(NY,NX)*TKW(NY,NX)**4 - RFLX=RFLX1-THRMX -C -C AERODYNAMIC RESISTANCE ABOVE SNOWPACK INCLUDING -C RESISTANCE IMPOSED BY PLANT CANOPY -C - RI=AMAX1(-0.3,AMIN1(0.075,RIB(NY,NX)*(TKQ(NY,NX)-TKW(NY,NX)))) - RAGX=AMAX1(RAM,0.75*RAGW(NY,NX),AMIN1(1.33*RAGW(NY,NX) - 2,RAG(NY,NX)/(1.0-10.0*RI))) - RAGW(NY,NX)=RAGX - RA=RAGX -C -C PARAMETERS FOR CALCULATING LATENT AND SENSIBLE HEAT FLUXES -C - PARE=PAREG(NY,NX)/(RA+RZW) - PARS=PARSG(NY,NX)/RA - TKW1=TK0(NY,NX) - TK11=TK1(NU(NY,NX),NY,NX) - VP0=2.173E-03/TKW1 - 2*0.61*EXP(5360.0*(3.661E-03-1.0/TKW1)) - VP1=2.173E-03/TK11 - 2*0.61*EXP(5360.0*(3.661E-03-1.0/TK11)) - 3*EXP(18.0*PSISV1/(8.3143*TK11)) - EVAPT=PARE*(VPQ(NY,NX)-VP0) - EVAP(NY,NX)=AMAX1(EVAPT,-AMAX1(0.0,VOLW0(NY,NX))) - EVAPX=AMIN1(0.0,EVAPT-EVAP(NY,NX)) - EVAPS(NY,NX)=AMAX1(EVAPX,-AMAX1(0.0,VOLS0(NY,NX))) - EFLX=EVAP(NY,NX)*VAP+EVAPS(NY,NX)*(VAP+333.0) - IF(EVAPT.LT.0.0)THEN - VFLX=(EVAP(NY,NX)*4.19+EVAPS(NY,NX)*2.095)*TK0(NY,NX) - ELSE - VFLX=(EVAP(NY,NX)*4.19+EVAPS(NY,NX)*2.095)*TKQ(NY,NX) - ENDIF -C -C SOLVE FOR SNOWPACK SURFACE TEMPERATURE AT WHICH ENERGY -C BALANCE OCCURS, SOLVE LATENT, SENSIBLE AND STORAGE HEAT FLUXES -C - SFLX=PARS*(TKQ(NY,NX)-TK0(NY,NX)) - HFLW0=RFLX+EFLX+SFLX+VFLX -C -C VAPOR PRESSURES AND CONDUCTIVITY BETWEEN SNOWPACK -C AND SOIL SURFACE -C - CNV0=THETP0**1.33*WGSG0(NY,NX) - CNV1=THETPX(NU(NY,NX),NY,NX)**2/POROQ(NU(NY,NX),NY,NX) - 2*WGSG1(NU(NY,NX),NY,NX) - IF(CNV0.GT.ZERO.AND.CNV1.GT.ZERO)THEN - AVCNV1=2.0*CNV0*CNV1 - 2/(CNV0*DLYR(3,NU(NY,NX),NY,NX)+CNV1*DPTHS0(NY,NX)) - ELSE - AVCNV1=2.0*CNV0 - 2/(DLYR(3,NU(NY,NX),NY,NX)+DPTHS0(NY,NX)) - ENDIF -C -C HEAT AND VAPOR FLUXES BETWEEN SNOWPACK AND SOIL SURFACE -C - TKY=(TK0(NY,NX)*VHCP0(NY,NX)+TK1(NU(NY,NX),NY,NX) - 2*VHCP1(NU(NY,NX),NY,NX))/(VHCP0(NY,NX)+VHCP1(NU(NY,NX),NY,NX)) - HFLWX=(TK0(NY,NX)-TKY)*VHCP0(NY,NX)*FHFLX*XDIM - FLVX=AVCNV1*(VP0-VP1)*AREA(3,NU(NY,NX),NY,NX)*BARE(NY,NX) - IF(FLVX.GE.0.0)THEN - FLV1=AMIN1(FLVX,VOLW0(NY,NX)*XNPH) - IF(HFLWX.GE.0.0)THEN - FLV1=AMIN1(FLV1,HFLWX/(4.19*TK0(NY,NX)+VAP)) - ENDIF - HWFLV1=(4.19*TK0(NY,NX)+VAP)*FLV1 - ELSE - FLV1=AMAX1(FLVX,-VOLW1(NU(NY,NX),NY,NX)*XNPH) - IF(HFLWX.LT.0.0)THEN - FLV1=AMAX1(FLV1,HFLWX/(4.19*TK1(NU(NY,NX),NY,NX)+VAP)) - ENDIF - HWFLV1=(4.19*TK1(NU(NY,NX),NY,NX)+VAP)*FLV1 - ENDIF - IF(VOLS1(NY,NX).GT.ZEROS(NY,NX))THEN - DENSW=(VOLS0(NY,NX)+VOLW0(NY,NX)+VOLI0(NY,NX))/VOLS1(NY,NX) - ELSE - DENSW=DENS0(NY,NX) - ENDIF -C -C J GLACIOL 43:26-41 -C - IF(DENSW.LT.0.156)THEN - TCNDW=8.28E-05+8.42E-04*DENSW - ELSE - TCNDW=4.97E-04-3.64E-03*DENSW+1.16E-02*DENSW**2 - ENDIF - WTHET1=1.467-0.467*THETPY(NU(NY,NX),NY,NX) - TCND1=(STC(NU(NY,NX),NY,NX)+THETWX(NU(NY,NX),NY,NX)*2.067E-03 - 2+0.611*THETIX(NU(NY,NX),NY,NX)*7.844E-03 - 3+WTHET1*THETPX(NU(NY,NX),NY,NX)*9.050E-05) - 4/(DTC(NU(NY,NX),NY,NX)+THETWX(NU(NY,NX),NY,NX) - 5+0.611*THETIX(NU(NY,NX),NY,NX)+WTHET1*THETPX(NU(NY,NX),NY,NX)) - IF(BARE(NY,NX).GT.ZERO)THEN - TCNDW1=TCNDW*XNPH - TCND1W=TCND1*XNPH - ATCND0=2.0*TCNDW1*TCND1W/(TCNDW1*DLYR(3,NU(NY,NX),NY,NX) - 2+TCND1W*DPTHS0(NY,NX))*BARE(NY,NX) - ELSE - ATCND0=0.0 - ENDIF - TK0X=TK0(NY,NX)-HWFLV1/VHCP0(NY,NX) - TK1X=TK1(NU(NY,NX),NY,NX)+HWFLV1/VHCP1(NU(NY,NX),NY,NX) - TKY=(TK0X*VHCP0(NY,NX)+TK1X*VHCP1(NU(NY,NX),NY,NX)) - 2/(VHCP0(NY,NX)+VHCP1(NU(NY,NX),NY,NX)) - HFLWX=(TK0X-TKY)*VHCP0(NY,NX)*FHFLX*XDIM - HFLWC=ATCND0*(TK0X-TK1X)*AREA(3,NU(NY,NX),NY,NX) - IF(HFLWC.GE.0.0)THEN - HFLC01=AMAX1(0.0,AMIN1(HFLWX,HFLWC)) - ELSE - HFLC01=AMIN1(0.0,AMAX1(HFLWX,HFLWC)) - ENDIF -C IF(NX.EQ.4.AND.NY.EQ.4)THEN -C WRITE(*,1113)'EFLX0',I,J,M,NX,NY,RFLX,EFLX,SFLX,VFLX,HFLW0 -C 2,RADXW(NY,NX),THRYW(NY,NX),ALBG,RADG(NY,NX),THS(NY,NX) -C 3,FRADG(NY,NX),THRMCX(NY,NX),TK0(NY,NX) -C 2,TKA(NY,NX),TKQ(NY,NX),VPQ(NY,NX),VP0,VP1,PARE,PARS,EVAPT -C 3,VHCP0(NY,NX),RA,RI,RZ,RAGX,RAGW(NY,NX),RAG(NY,NX),RAB(NY,NX) -C 4,WFLXA(NY,NX),WFLXB(NY,NX),CNV0,PARG(NY,NX),UA(NY,NX),UAG,ALFZ -C 5,THETP0,VOLS0(NY,NX),VOLI0(NY,NX),VOLW0(NY,NX),VOLS1(NY,NX) -C 6,WGSG0(NY,NX),WGSG1(NU(NY,NX),NY,NX),DPTHS0(NY,NX) -C 7,VOLW1(NU(NY,NX),NY,NX),FLQM,FLYM,WMELT -C 8,HWFLQM,HWFLV1,HFLC01,HFLCR1 -C 9,WGSG0(NY,NX),THETPY(NU(NY,NX),NY,NX) -C 1,DENSS(NY,NX),VOLS0(NY,NX),VOLS1(NY,NX),TCNDW -1113 FORMAT(A8,5I4,60E12.4) -C ENDIF -C -C HEAT FLUX BETWEEN SNOWPACK AND SURFACE RESIDUE -C - FLVR=0.0 - HWFLVR=0.0 - FLVS=0.0 - HWFLVS=0.0 - HFLC0R=0.0 - HFLCR1=0.0 - IF(VHCPR1(NY,NX).GT.VHCPRX(NY,NX))THEN - TK0X=TK0(NY,NX) - TKXR=TK1(0,NY,NX) - TK1X=TK1(NU(NY,NX),NY,NX) - CNV01=CNV0*XNPR - CNV11=CNV1*XNPR - CNVR1=THETPX(0,NY,NX)**2/POROQ(0,NY,NX)*WGSGR0(NY,NX)*XNPR - IF(CVRD(NY,NX).GT.ZERO)THEN - IF(CNV01.GT.ZERO.AND.CNVR1.GT.ZERO)THEN - AVCNVR=2.0*CNVR1*CNV01 - 2/(CNV01*DLYRR(NY,NX)+CNVR1*DPTHS0(NY,NX))*CVRD(NY,NX) - ELSE - AVCNVR=2.0*CNV01 - 2/(DLYRR(NY,NX)+DPTHS0(NY,NX))*CVRD(NY,NX) - ENDIF - IF(CNVR1.GT.ZERO.AND.CNV11.GT.ZERO)THEN - AVCNVS=2.0*CNVR1*CNV11 - 2/(CNVR1*DLYR(3,NU(NY,NX),NY,NX)+CNV11*DLYRR(NY,NX))*CVRD(NY,NX) - ELSE - AVCNVS=2.0*CNV11 - 2/(DLYR(3,NU(NY,NX),NY,NX)+DLYRR(NY,NX))*CVRD(NY,NX) - ENDIF - THETRR=AMAX1(0.0,1.0-THETPX(0,NY,NX)-THETWX(0,NY,NX) - 2-THETIX(0,NY,NX)) - TCNDR=(0.779*THETRR*9.050E-04+0.622*THETWX(0,NY,NX) - 2*2.067E-03+0.380*THETIX(0,NY,NX)*7.844E-03+THETPX(0,NY,NX) - 3*9.050E-05)/(0.779*THETRR+0.622*THETWX(0,NY,NX) - 4+0.380*THETIX(0,NY,NX)+THETPX(0,NY,NX)) - IF(TCNDW.GT.ZERO.AND.TCNDR.GT.ZERO)THEN - TCNDW1=TCNDW*XNPHR - TCNDR1=TCNDR*XNPHR - ATCNDR=2.0*TCNDW1*TCNDR1 - 2/(TCNDW1*DLYRR(NY,NX)+TCNDR1*DPTHS0(NY,NX))*CVRD(NY,NX) - ELSE - ATCNDR=0.0 - ENDIF - IF(TCNDR.GT.ZERO.AND.TCND1.GT.ZERO)THEN - TCND11=TCND1*XNPHR - ATCNDS=2.0*TCNDR1*TCND11 - 2/(TCNDR1*DLYR(3,NU(NY,NX),NY,NX)+TCND11*DLYRR(NY,NX))*CVRD(NY,NX) - ELSE - ATCNDS=0.0 - ENDIF - ELSE - AVCNVR=0.0 - AVCNVS=0.0 - ATCNDR=0.0 - ATCNDS=0.0 - ENDIF - DO 4000 N=1,NPR - VP0=2.173E-03/TK0X - 2*0.61*EXP(5360.0*(3.661E-03-1.0/TK0X)) - VPR=2.173E-03/TKXR - 2*0.61*EXP(5360.0*(3.661E-03-1.0/TKXR)) - 3*EXP(18.0*PSISM1(0,NY,NX)/(8.3143*TKXR)) - TKY=(TKXR*VHCPR1(NY,NX)+TK0X*VHCP0(NY,NX)) - 2/(VHCPR1(NY,NX)+VHCP0(NY,NX)) - HFLWX=(TKY-TKXR)*VHCPR1(NY,NX)*FHFLX*XDIM - FLVX=AVCNVR*(VP0-VPR)*AREA(3,NU(NY,NX),NY,NX) - IF(FLVX.GE.0.0)THEN - FLVR1=AMIN1(FLVX,VOLW0(NY,NX)*XNPHR) - IF(HFLWX.GE.0.0)THEN - FLVR1=AMIN1(FLVR1,HFLWX/(4.19*TK0X+VAP)) - ENDIF - HWFLVR1=(4.19*TK0X+VAP)*FLVR1 - ELSE - FLVR1=AMAX1(FLVX,-VOLW1(0,NY,NX)*XNPHR) - IF(HFLWX.LT.0.0)THEN - FLVR1=AMAX1(FLVR1,HFLWX/(4.19*TKXR+VAP)) - ENDIF - HWFLVR1=(4.19*TKXR+VAP)*FLVR1 - ENDIF - TK0X=TK0X-HWFLVR1/VHCP0(NY,NX) - TKXR=TKXR+HWFLVR1/VHCPR1(NY,NX) - TKY=(TKXR*VHCPR1(NY,NX)+TK0X*VHCP0(NY,NX)) - 2/(VHCPR1(NY,NX)+VHCP0(NY,NX)) - HFLWX=(TKY-TKXR)*VHCPR1(NY,NX)*FHFLX*XDIM - HFLWC=ATCNDR*(TK0X-TKXR)*AREA(3,NU(NY,NX),NY,NX) - IF(HFLWC.GE.0.0)THEN - HFLC0R1=AMAX1(0.0,AMIN1(HFLWX,HFLWC)) - ELSE - HFLC0R1=AMIN1(0.0,AMAX1(HFLWX,HFLWC)) - ENDIF - TK0X=TK0X-HFLC0R1/VHCP0(NY,NX) - TKXR=TKXR+HFLC0R1/VHCPR1(NY,NX) -C -C HEAT FLUX BETWEEN SURFACE RESIDUE AND SOIL SURFACE UNDER SNOWPACK -C - VP1=2.173E-03/TK1X - 2*0.61*EXP(5360.0*(3.661E-03-1.0/TK1X)) - 3*EXP(18.0*PSISV1/(8.3143*TK1X)) - TKY=(TKXR*VHCPR1(NY,NX)+TK1X*VHCP1(NU(NY,NX),NY,NX)) - 2/(VHCPR1(NY,NX)+VHCP1(NU(NY,NX),NY,NX)) - HFLWX=(TKXR-TKY)*VHCPR1(NY,NX)*FHFLX*XDIM - FLVX=AVCNVS*(VPR-VP1)*AREA(3,NU(NY,NX),NY,NX) - IF(FLVX.GE.0.0)THEN - FLVS1=AMIN1(FLVX,VOLW1(0,NY,NX)*XNPHR) - IF(HFLWX.GE.0.0)THEN - FLVS1=AMIN1(FLVS1,HFLWX/(4.19*TKXR+VAP)) - ENDIF - HWFLVS1=(4.19*TKXR+VAP)*FLVS1 - ELSE - FLVS1=AMAX1(FLVX,-VOLW1(NU(NY,NX),NY,NX)*XNPHR) - IF(HFLWX.LT.0.0)THEN - FLVS1=AMAX1(FLVS1,HFLWX/(4.19*TK1X+VAP)) - ENDIF - HWFLVS1=(4.19*TK1X+VAP)*FLVS1 - ENDIF - TKXR=TKXR-HWFLVS1/VHCPR1(NY,NX) - TK1X=TK1X+HWFLVS1/VHCP1(NU(NY,NX),NY,NX) - TKY=(TKXR*VHCPR1(NY,NX)+TK1X*VHCP1(NU(NY,NX),NY,NX)) - 2/(VHCPR1(NY,NX)+VHCP1(NU(NY,NX),NY,NX)) - HFLWX=(TKXR-TKY)*VHCPR1(NY,NX)*FHFLX*XDIM - HFLWC=ATCNDS*(TKXR-TK1X)*AREA(3,NU(NY,NX),NY,NX) - IF(HFLWC.GE.0.0)THEN - HFLCR11=AMAX1(0.0,AMIN1(HFLWX,HFLWC)) - ELSE - HFLCR11=AMIN1(0.0,AMAX1(HFLWX,HFLWC)) - ENDIF - TKXR=TKXR-HFLCR11/VHCPR1(NY,NX) - TK1X=TK1X+HFLCR11/VHCP1(NU(NY,NX),NY,NX) - FLVR=FLVR+FLVR1 - HWFLVR=HWFLVR+HWFLVR1 - FLVS=FLVS+FLVS1 - HWFLVS=HWFLVS+HWFLVS1 - HFLC0R=HFLC0R+HFLC0R1 - HFLCR1=HFLCR1+HFLCR11 -C IF(NX.EQ.4.AND.NY.EQ.5)THEN -C WRITE(*,1114)'FLVR0',I,J,M,NX,NY,N,TK0(NY,NX),TK1(0,NY,NX) -C 2,TK1(NU(NY,NX),NY,NX),TK0X,TKXR,TK1X,FLVR1,HWFLVR1,FLVS1 -C 4,HWFLVS1,HFLC0R1,HFLCR11,FLVR,HWFLVR,FLVS,HWFLVS -C 3,HFLC0R,HFLCR1,VPQ(NY,NX),VP0,VPR,VP1,PSISM1(0,NY,NX),PSISV1 -C 5,AVCNVR,ATCNDR,AVCNVS,ATCNDS,VHCP0(NY,NX),VHCPR1(NY,NX) -C 6,VHCP1(NU(NY,NX),NY,NX),DLYRR(NY,NX),DPTHS0(NY,NX),CNV01,CNVR1 -C 7,CNV11,CNV1,THETPX(NU(NY,NX),NY,NX),POROQ(NU(NY,NX),NY,NX) -C 2,WGSG1(NU(NY,NX),NY,NX),CVRD(NY,NX) -1114 FORMAT(A8,6I4,60E12.4) -C ENDIF -4000 CONTINUE - IF(VOLWRX(NY,NX).GT.ZEROS(NY,NX))THEN - THETWR=AMAX1(0.01,AMIN1(1.0,VOLW1(0,NY,NX)/VOLWRX(NY,NX))) - ELSE - THETWR=1.0 - ENDIF - PSISM1(0,NY,NX)=PSISE(0,NY,NX)*THETWR**FPSISR - ELSE - PSISM1(0,NY,NX)=PSISM1(NU(NY,NX),NY,NX) - ENDIF - EVAPR(NY,NX)=0.0 - RFLXR=0.0 - EFLXR=0.0 - VFLXR=0.0 - SFLXR=0.0 -C -C GATHER WATER, VAPOR AND HEAT FLUXES INTO FLUX ARRAYS -C FOR LATER UPDATES TO STATE VARIABLES -C - FLW0S(NY,NX)=FLQ0S(NY,NX)+EVAPS(NY,NX) - FLW0L(NY,NX)=FLQ0W(NY,NX)+EVAP(NY,NX)-FLV1-FLVR - HFLW0L(NY,NX)=HWFLQ0(NY,NX)+HFLW0-HWFLV1-HWFLVR-HFLC01-HFLC0R - FLWL(3,NU(NY,NX),NY,NX)=FLQM+FLV1+FLVS - FLWLX(3,NU(NY,NX),NY,NX)=FLQM+FLV1 - FLWHL(3,NU(NY,NX),NY,NX)=FLHM - HFLWL(3,NU(NY,NX),NY,NX)=HWFLQM+HWFLV1+HWFLVS+HFLC01+HFLCR1 - FLWRL(NY,NX)=FLYM+FLVR-FLVS - HFLWRL(NY,NX)=HWFLYM+HFLC0R-HFLCR1+HWFLVR-HWFLVS - FLWVL(NU(NY,NX),NY,NX)=0.0 - FLWV(NU(NY,NX),NY,NX)=FLWV(NU(NY,NX),NY,NX) - 2+FLWVL(NU(NY,NX),NY,NX) -C IF(NX.EQ.2.AND.NY.EQ.2)THEN -C WRITE(*,7753)'FLW0L',I,J,M,NX,NY,FLW0L(NY,NX) -C 2,FLQ0W(NY,NX),EVAP(NY,NX),FLV1,FLVR,VOLW0(NY,NX) -C 2,FLW0S(NY,NX),FLQ0S(NY,NX),EVAPS(NY,NX) -C 3,EVAPT,PARE,VPQ(NY,NX),VP0,TK0(NY,NX),HFLW0L(NY,NX) -C 4,HWFLQ0(NY,NX),HFLW0,HWFLV1,HWFLVR,HFLC01,HFLC0R -C WRITE(*,7753)'FLWRL',I,J,M,NX,NY,FLWRL(NY,NX) -C 3,PSISM1(0,NY,NX),PSISE(0,NY,NX) -C 2,FLYM,FLVR,FLVS,HFLWRL(NY,NX),VOLW1(0,NY,NX) -C 2,HWFLYM,HFLC0R,HFLCR1,HWFLVR,HWFLVS -7753 FORMAT(A8,5I4,30E12.4) -C ENDIF -C -C FREEZE-THAW IN SNOWPACK FROM NET CHANGE IN SNOWPACK -C HEAT STORAGE -C - TFLX=3.6785E-01*(273.15*(2.095*FLW0S(NY,NX)+4.19*FLW0L(NY,NX)) - 2+VHCP0(NY,NX)*(273.15-TK0(NY,NX))-HFLW0L(NY,NX)) - IF(TFLX.LT.0.0)THEN - TVOLWS=VOLS0(NY,NX)+0.92*VOLI0(NY,NX) - IF(TVOLWS.GT.ZEROS(NY,NX))THEN - FVOLS0=VOLS0(NY,NX)/TVOLWS - FVOLI0=0.92*VOLI0(NY,NX)/TVOLWS - ELSE - FVOLS0=0.0 - FVOLI0=0.0 - ENDIF - TFLX0(NY,NX)=AMAX1(-333.0*TVOLWS*XNPH,TFLX) - WFLXA(NY,NX)=-TFLX0(NY,NX)*FVOLS0/333.0 - WFLXB(NY,NX)=-TFLX0(NY,NX)*FVOLI0/333.0 - ELSE - TFLX0(NY,NX)=AMIN1(333.0*VOLW0(NY,NX)*XNPH,TFLX) - WFLXA(NY,NX)=0.0 - WFLXB(NY,NX)=-TFLX0(NY,NX)/333.0 - ENDIF -C -C TOTAL SNOWPACK WATER, VAPOR AND HEAT FLUXES -C - TFLWS(NY,NX)=TFLWS(NY,NX)+FLW0S(NY,NX) - 2-WFLXA(NY,NX)-FLWS1(NY,NX) - TFLWW(NY,NX)=TFLWW(NY,NX)+FLW0L(NY,NX) - 2+WFLXA(NY,NX)+WFLXB(NY,NX)-FLWZ1(NY,NX) - TFLWI(NY,NX)=TFLWI(NY,NX)-WFLXB(NY,NX)/0.92-FLWI1(NY,NX) - THFLWW(NY,NX)=THFLWW(NY,NX)+HFLW0L(NY,NX)+TFLX0(NY,NX) - 2-HFLWZ1(NY,NX)-HFLSI1(NY,NX) - HTHAWW(NY,NX)=HTHAWW(NY,NX)+TFLX0(NY,NX) - THRMG(NY,NX)=THRMG(NY,NX)+THRMX -C IF(NX.EQ.4.AND.NY.EQ.4)THEN -C WRITE(*,7754)'THFLWW',I,J,M,NX,NY,THFLWW(NY,NX) -C 2,HFLW0L(NY,NX),TFLX0(NY,NX) -C 2,HFLWZ1(NY,NX),HFLSI1(NY,NX) -C ENDIF -C -C ENERGY EXCHANGE AT SOIL SURFACE IF EXPOSED -C - ELSE -C -C PHYSICAL AND HYDRAULIC PROPERTIES OF SOIL SURFACE INCLUDING -C AIR AND WATER-FILLED POROSITY, AND WATER POTENTIAL USED IN -C FLUX CALCULATIONS -C -C IF(BKVL(NU(NY,NX),NY,NX).GT.0.0)THEN - 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) - 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 - PSISM1(NU(NY,NX),NY,NX)=-EXP(PSIMS(NY,NX) - 2+(((PSL(NU(NY,NX),NY,NX)-LOG(THETW1)) - 3/PSD(NU(NY,NX),NY,NX))**SRP(NU(NY,NX),NY,NX)*PSISD(NY,NX))) - ELSE - PSISM1(NU(NY,NX),NY,NX)=PSISE(NU(NY,NX),NY,NX) - ENDIF -C ELSE -C PSISM1(NU(NY,NX),NY,NX)=PSISE(NU(NY,NX),NY,NX) -C ENDIF - PSISV1=PSISM1(NU(NY,NX),NY,NX)+PSISO(NU(NY,NX),NY,NX) -C IF(NX.EQ.4.AND.NY.EQ.5)THEN -C WRITE(*,3232)'PSISV1',I,J,M,NX,NY,NU(NY,NX),PSISV1 -C 2,PSISM1(NU(NY,NX),NY,NX),PSISO(NU(NY,NX),NY,NX) -C 3,THETWX(NU(NY,NX),NY,NX),THETW1,POROS(NU(NY,NX),NY,NX) -C 4,PSL(NU(NY,NX),NY,NX),LOG(THETW1),PSD(NU(NY,NX),NY,NX) -C 5,SRP(NU(NY,NX),NY,NX) -3232 FORMAT(A8,6I4,12E12.4) -C ENDIF -C -C SOIL SURFACE ALBEDO, NET RADIATION -C - VOLWXG=VOLW1(NU(NY,NX),NY,NX)+VOLWH1(NU(NY,NX),NY,NX) - VOLIXG=VOLI1(NU(NY,NX),NY,NX)+VOLIH1(NU(NY,NX),NY,NX) - ALBG=(ALBS(NY,NX)*BKVL(NU(NY,NX),NY,NX)+0.06*VOLWXG - 2+0.30*VOLIXG)/(BKVL(NU(NY,NX),NY,NX)+VOLWXG+VOLIXG) - RFLX1=(1.0-ALBG)*RADXG(NY,NX)+THRYG(NY,NX) - THRMA=THRMS(NY,NX)*TK1(NU(NY,NX),NY,NX)**4 - RFLX=RFLX1-THRMA -C -C AERODYNAMIC RESISTANCE ABOVE SOIL SURFACE INCLUDING -C RESISTANCE IMPOSED BY PLANT CANOPY -C - RAR1=RAR(NY,NX)/AMAX1(0.1,THETPX(0,NY,NX))**2.33 - RAGZ=RAG(NY,NX)+RAR1 - RI=AMAX1(-0.3,AMIN1(0.075,RIB(NY,NX)*(TKQ(NY,NX) - 2-TK1(NU(NY,NX),NY,NX)))) - RAGX=AMAX1(RAM,0.75*RAGS(NY,NX),AMIN1(1.33*RAGS(NY,NX) - 2,RAGZ/(1.0-10.0*RI))) - RAGS(NY,NX)=RAGX - RA=RAGX -C -C PARAMETERS FOR CALCULATING LATENT AND SENSIBLE HEAT FLUXES -C - PARE=PAREG(NY,NX)/(RA+RZ) - PARS=PARSG(NY,NX)/RA - TKX1=TK1(NU(NY,NX),NY,NX) - VP1=2.173E-03/TKX1 - 2*0.61*EXP(5360.0*(3.661E-03-1.0/TKX1)) - 3*EXP(18.0*PSISV1/(8.3143*TKX1)) - EVAP(NY,NX)=AMAX1(PARE*(VPQ(NY,NX)-VP1) - 2,-AMAX1(0.0,VOLW1(NU(NY,NX),NY,NX))*XNPH) - EVAPS(NY,NX)=0.0 - EFLX=EVAP(NY,NX)*VAP - IF(EVAP(NY,NX).LT.0.0)THEN - VFLX=EVAP(NY,NX)*4.19*TK1(NU(NY,NX),NY,NX) - ELSE - VFLX=EVAP(NY,NX)*4.19*TKQ(NY,NX) - ENDIF -C IF(NX.EQ.4.AND.NY.EQ.5)THEN -C WRITE(*,3376)'EVAP',I,J,M,NX,NY,EVAP(NY,NX),RFLX,RFLX1,THRMA -C 3,THETPX(0,NY,NX),VHCPR1(NY,NX),CVRD(NY,NX) -C 2,PARE,VPQ(NY,NX),VP1,RA,RAZ,RAGS(NY,NX),RI,RAR1,RAR(NY,NX),RAGZ -C 3,RAG(NY,NX),RIB(NY,NX),TKX1,PSISV1,VOLW1(NU(NY,NX),NY,NX) -C 4,DLYRR(NY,NX),WGSGR(NY,NX),VOLX(0,NY,NX),ORGC(0,NY,NX) -C 5,VOLA(0,NY,NX),VOLW1(0,NY,NX),VOLI1(0,NY,NX),VOLP1(0,NY,NX) -C ENDIF -C -C SOLVE FOR SOIL SURFACE TEMPERATURE AT WHICH ENERGY -C BALANCE OCCURS, SOLVE LATENT, SENSIBLE AND STORAGE HEAT FLUXES -C - SFLX=PARS*(TKQ(NY,NX)-TK1(NU(NY,NX),NY,NX)) - HFLW1=RFLX+EFLX+SFLX+VFLX -C IF(I.EQ.208)THEN -C WRITE(*,1112)'EFLX',I,J,M,NX,NY,TK1(NU(NY,NX),NY,NX) -C 2,RFLX,EFLX,SFLX,VFLX,HFLW1,RA,RAC(NY,NX),RAG(NY,NX),RAS1,RAGZ,RAR1 -C 3,RAGX,RI,RAGS(NY,NX),VOLW1(NU(NY,NX),NY,NX),VOLI1(NU(NY,NX),NY,NX) -C 4,RADXG(NY,NX),THRYG(NY,NX),THRMA,THRYW(NY,NX),THS(NY,NX) -C 5,BARE(NY,NX),PARG(NY,NX),VPQ(NY,NX),VP1,FRADG(NY,NX),THRMCX(NY,NX) -C 5,PSISM1(NU(NY,NX),NY,NX),PSISO(NU(NY,NX),NY,NX) -C 6,FLQM,EVAP(NY,NX),PARE,HFLW1,PARS,PARSG(NY,NX),HWFLQM -C 7,ATCNDS,TCND1,THETPY(NU(NY,NX),NY,NX),RAR(NY,NX),THETPY(0,NY,NX) -C 8,VHCP1(NU(NY,NX),NY,NX),PARS -C 3,TKQ(NY,NX) -1112 FORMAT(A8,5I4,60E12.4) -C ENDIF -C -C ENERGY BALANCE AT RESIDUE SURFACE -C - IF(VHCPR1(NY,NX).GT.VHCPRX(NY,NX))THEN -C -C PARAMETERS FOR CALCULATING LATENT AND SENSIBLE HEAT FLUXES -C - EVAPR(NY,NX)=0.0 - RFLXR=0.0 - EFLXR=0.0 - VFLXR=0.0 - SFLXR=0.0 - HFLR1=0.0 - FLV1=0.0 - HWFLV1=0.0 - HFLCR1=0.0 - THRMZ=0.0 -C -C NET RADIATION AT RESIDUE SURFACE -C - ALBR=(0.20*BKVL(0,NY,NX)+0.06*VOLW1(0,NY,NX)+0.30 - 2*VOLI1(0,NY,NX))/(BKVL(0,NY,NX)+VOLW1(0,NY,NX)+VOLI1(0,NY,NX)) - RFLX1=(1.0-ALBR)*RADXR(NY,NX)+THRYR(NY,NX) - TKR1=TK1(0,NY,NX) - VOLWR2=VOLW1(0,NY,NX) - VHCPR2=VHCPR1(NY,NX) - TKS1=TK1(NU(NY,NX),NY,NX) - HFLW2=HFLW1*XNPR - VOLW12=VOLW1(NU(NY,NX),NY,NX) - VHCP12=VHCP1(NU(NY,NX),NY,NX) -C -C THERMAL CONDUCTIVITY BETWEEN SURFACE RESIDUE AND SOIL SURFACE -C - CNVR=THETPX(0,NY,NX)**2/POROQ(0,NY,NX)*WGSGR0(NY,NX)*XNPR - CNV1=THETPX(NU(NY,NX),NY,NX)**2/POROQ(NU(NY,NX),NY,NX)*XNPR - 2*WGSG1(NU(NY,NX),NY,NX) - IF(CVRD(NY,NX).GT.ZERO)THEN - IF(CNVR.GT.ZERO.AND.CNV1.GT.ZERO)THEN - AVCNVS=2.0*CNVR*CNV1 - 2/(CNVR*DLYR(3,NU(NY,NX),NY,NX)+CNV1*DLYRR(NY,NX))*CVRD(NY,NX) - ELSE - AVCNVS=2.0*CNVR - 2/(DLYR(3,NU(NY,NX),NY,NX)+DLYRR(NY,NX))*CVRD(NY,NX) - ENDIF - ELSE - AVCNVS=0.0 - ENDIF - THETRR=AMAX1(0.0,1.0-THETPX(0,NY,NX)-THETWX(0,NY,NX) - 2-THETIX(0,NY,NX)) - DTKX=ABS(TK1(0,NY,NX)-TK1(NU(NY,NX),NY,NX))*1.0E-06 - DTHW0=AMAX1(0.0,THETWX(0,NY,NX)-TRBW)**3 - DTHA0=AMAX1(0.0,THETPX(0,NY,NX)-TRBA)**3 - DTHW1=AMAX1(0.0,THETWX(NU(NY,NX),NY,NX)-TRBW)**3 - DTHA1=AMAX1(0.0,THETPX(NU(NY,NX),NY,NX)-TRBA)**3 - RYLXW0=DTKX*DTHW0 - RYLXA0=DTKX*DTHA0 - RYLXW1=DTKX*DTHW1 - RYLXA1=DTKX*DTHA1 - RYLNW0=AMIN1(1.0E+04,RYLXW*RYLXW0) - RYLNA0=AMIN1(1.0E+04,RYLXA*RYLXA0) - RYLNW1=AMIN1(1.0E+04,RYLXW*RYLXW1) - RYLNA1=AMIN1(1.0E+04,RYLXA*RYLXA1) - XNUSW0=AMAX1(1.0,0.68+0.67*RYLNW0**0.25/DNUSW) - XNUSA0=AMAX1(1.0,0.68+0.67*RYLNA0**0.25/DNUSA) - XNUSW1=AMAX1(1.0,0.68+0.67*RYLNW1**0.25/DNUSW) - XNUSA1=AMAX1(1.0,0.68+0.67*RYLNA1**0.25/DNUSA) - TCNDW0=2.067E-03*XNUSW0 - TCNDA0=9.050E-05*XNUSA0 - TCNDW1=2.067E-03*XNUSW1 - TCNDA1=9.050E-05*XNUSA1 - WTHET0=1.467-0.467*THETPY(0,NY,NX) - TCNDR=(0.779*THETRR*9.050E-04+0.622*THETWX(0,NY,NX)*TCNDW0 - 2+0.380*THETIX(0,NY,NX)*7.844E-03 - 3+WTHET0*THETPX(0,NY,NX)*TCNDA0) - 4/(0.779*THETRR+0.622*THETWX(0,NY,NX) - 5+0.380*THETIX(0,NY,NX)+WTHET0*THETPX(0,NY,NX)) - TCNDR1=TCNDR*XNPHR - WTHET1=1.467-0.467*THETPY(NU(NY,NX),NY,NX) - TCND1=(STC(NU(NY,NX),NY,NX)+THETWX(NU(NY,NX),NY,NX)*TCNDW1 - 2+0.611*THETIX(NU(NY,NX),NY,NX)*7.844E-03 - 3+WTHET1*THETPX(NU(NY,NX),NY,NX)*TCNDA1) - 4/(DTC(NU(NY,NX),NY,NX)+THETWX(NU(NY,NX),NY,NX) - 5+0.611*THETIX(NU(NY,NX),NY,NX)+WTHET1*THETPX(NU(NY,NX),NY,NX)) - TCND1R=TCND1*XNPHR - ATCNDR=2.0*TCNDR1*TCND1R/(TCNDR1*DLYR(3,NU(NY,NX),NY,NX) - 2+TCND1R*DLYRR(NY,NX))*CVRD(NY,NX) -C -C SMALLER TIME STEP FOR SOLVING SURFACE RESIDUE ENERGY EXCHANGE -C - DO 5000 N=1,NPR - IF(VHCPR2.GT.VHCPRX(NY,NX))THEN -C -C AERODYNAMIC RESISTANCE ABOVE RESIDUE INCLUDING -C RESISTANCE IMPOSED BY PLANT CANOPY -C - RI=AMAX1(-0.3,AMIN1(0.075,RIB(NY,NX)*(TKQ(NY,NX)-TKR1))) - RAGX=AMAX1(RAM,0.75*RAGR(NY,NX),AMIN1(1.33*RAGR(NY,NX) - 2,RARG(NY,NX)/(1.0-10.0*RI))) - RAGR(NY,NX)=RAGX - RA=RAGX - PARE=PARER(NY,NX)/(RA+RZR) - PARS=PARSR(NY,NX)/RA -C -C NET RADIATION AT RESIDUE SURFACE -C - THRMZ2=THRMR(NY,NX)*TKR1**4 - RFLXR2=RFLX1-THRMZ2 - IF(VOLWRX(NY,NX).GT.ZEROS(NY,NX))THEN - THETWR=AMAX1(0.01,AMIN1(1.0,VOLWR2/VOLWRX(NY,NX))) - ELSE - THETWR=1.0 - ENDIF - PSISM1(0,NY,NX)=PSISE(0,NY,NX)*THETWR**-4.0 -C -C VAPOR FLUX AT RESIDUE SURFACE -C - VPR=2.173E-03/TKR1 - 2*0.61*EXP(5360.0*(3.661E-03-1.0/TKR1)) - 3*EXP(18.0*PSISM1(0,NY,NX)/(8.3143*TKR1)) - VP1=2.173E-03/TKS1 - 2*0.61*EXP(5360.0*(3.661E-03-1.0/TKS1)) - 3*EXP(18.0*PSISV1/(8.3143*TKS1)) - EVAPR2=AMIN1(VOLWRM*XNPHR,AMAX1(-AMAX1(0.0,VOLWR2)*XNPHR - 2,PARE*(VPQ(NY,NX)-VPR))) - EFLXR2=EVAPR2*VAP - VFLXR2=EVAPR2*4.19*TKR1 -C -C SOLVE FOR RESIDUE SURFACE TEMPERATURE AT WHICH ENERGY -C BALANCE OCCURS, SOLVE LATENT, SENSIBLE AND STORAGE HEAT FLUXES -C - TKY=(TKR1*VHCPR2+TKS1*VHCP12)/(VHCPR2+VHCP12) - HFLWX=(TKR1-TKY)*VHCPR2*FHFLX*XDIM - FLVX=AVCNVS*(VPR-VP1)*AREA(3,NU(NY,NX),NY,NX) - IF(FLVX.GE.0.0)THEN - FLV2=AMIN1(FLVX,VOLWR2*XNPHR) - IF(HFLWX.GE.0.0)THEN - FLV2=AMIN1(FLV2,HFLWX/(4.19*TKR1+VAP)) - ENDIF - HWFLV2=(4.19*TKR1+VAP)*FLV2 - ELSE - FLV2=AMAX1(FLVX,-VOLW12*XNPHR) - IF(HFLWX.LT.0.0)THEN - FLV2=AMAX1(FLV2,HFLWX/(4.19*TKS1+VAP)) - ENDIF - HWFLV2=(4.19*TKS1+VAP)*FLV2 - ENDIF - TKXR=TKR1-HWFLV2/VHCPR2 - TK1X=TKS1+HWFLV2/VHCP12 - TKY=(TKXR*VHCPR2+TK1X*VHCP12)/(VHCPR2+VHCP12) - HFLWX=(TKXR-TKY)*VHCPR2*FHFLX*XDIM - HFLWC=ATCNDR*(TKXR-TK1X)*AREA(3,0,NY,NX) - IF(HFLWC.GE.0.0)THEN - HFLCR2=AMAX1(0.0,AMIN1(HFLWX,HFLWC)) - ELSE - HFLCR2=AMIN1(0.0,AMAX1(HFLWX,HFLWC)) - ENDIF - SFLXR2=PARS*(TKQ(NY,NX)-TKR1) - HFLR2=RFLXR2+EFLXR2+SFLXR2+VFLXR2 -C -C AGGREGATE WATER AND ENERGY FLUXES FROM RESIDUE TIME STEP -C TO MODEL TIME STEP -C - EVAPR(NY,NX)=EVAPR(NY,NX)+EVAPR2 - RFLXR=RFLXR+RFLXR2 - EFLXR=EFLXR+EFLXR2 - VFLXR=VFLXR+VFLXR2 - SFLXR=SFLXR+SFLXR2 - HFLR1=HFLR1+HFLR2 - FLV1=FLV1+FLV2 - HWFLV1=HWFLV1+HWFLV2 - HFLCR1=HFLCR1+HFLCR2 - THRMZ=THRMZ+THRMZ2 - ELSE - EVAPR2=0.0 - RFLXR2=0.0 - EFLXR2=0.0 - VFLXR2=0.0 - SFLXR2=0.0 - HFLR2=0.0 - FLV2=0.0 - HWFLV2=0.0 - HFLCR2=0.0 - THRMZ2=0.0 - ENDIF - VOLWR2=VOLWR2+FLYM2+EVAPR2-FLV2 - VOLW12=VOLW12+FLV2 - ENGYR=VHCPR2*TKR1 - VHCPR2=2.496E-06*ORGC(0,NY,NX)+4.19*VOLWR2 - 2+1.9274*VOLI1(0,NY,NX) - VHCP12=VHCP12+4.19*FLV2 - TKR1=(ENGYR+HWFLM2+HFLR2-HWFLV2-HFLCR2)/VHCPR2 - TKS1X=TKS1 - TKS1=TKS1+(HFLW2+HWFLV2+HFLCR2)/VHCP12 -C IF(NX.EQ.1.AND.NY.EQ.6)THEN -C WRITE(*,1111)'EFLXR2',I,J,M,NX,NY,N,TKR1,TKS1,TKQ(NY,NX) -C 2,EFLXR2,SFLXR2,VFLXR2,FLV2,FLVX,VPR,VP1,AVCNVS,PSISE(0,NY,NX) -C 3,PSISM1(0,NY,NX),PSISV1,THETWR,VOLWR2,VOLWRX(NY,NX),TRC0(NY,NX) -C 4,PARS,PARE,RA,RZR,RI,TKQ(NY,NX),VOLWR2,VOLW12,HFLWX,FLV1 -C 5,VOLW1(NU(NY,NX),NY,NX),THRMZ2,VOLW1(0,NY,NX) -C 3,HWFLV2,HFLCR2,HWFLM2,RA,RAGX,RAG(NY,NX),RAB(NY,NX),RAC(NY,NX) -C 4,RZR,RZ,PARS -C 4,RAR1,PARE,VPQ(NY,NX),EVAPR(NY,NX),EVAPR2 -C 5,VHCPR2,VHCP12,CNVR,CNV1,VOLX(0,NY,NX) -C 5,ATCNDR,TCNDR,TCNDR1,TCND1R,DLYR(3,NU(NY,NX),NY,NX) -C 6,DLYRR(NY,NX),DLYR(3,0,NY,NX),POROQ(0,NY,NX),WGSGR(NY,NX) -C 7,THETWX(0,NY,NX),THETIX(0,NY,NX),THETPY(0,NY,NX),ORGC(0,NY,NX) -C 8,CVRD(NY,NX),EFLXR,EFLX,TRA0(NY,NX),ATCNDR*(TKR1-TKS1),TKS1X -1111 FORMAT(A8,6I4,100E12.4) -C ENDIF -5000 CONTINUE -C -C IF NO SURFACE RESIDUE -C - ELSE - TK1(0,NY,NX)=TK1(NU(NY,NX),NY,NX) - EVAPR(NY,NX)=0.0 - RFLXR=0.0 - EFLXR=0.0 - VFLXR=0.0 - SFLXR=0.0 - HFLR1=0.0 - FLV1=0.0 - HWFLV1=0.0 - HFLCR1=0.0 - THRMZ=0.0 - ENDIF -C -C GATHER WATER, VAPOR AND HEAT FLUXES INTO FLUX ARRAYS -C FOR LATER UPDATES TO STATE VARIABLES -C - FLWL(3,NU(NY,NX),NY,NX)=FLQM+EVAP(NY,NX)+FLV1 - FLWLX(3,NU(NY,NX),NY,NX)=FLQM+EVAP(NY,NX)+FLV1 - FLWHL(3,NU(NY,NX),NY,NX)=FLHM - HFLWL(3,NU(NY,NX),NY,NX)=HWFLQM+HFLW1+HWFLV1+HFLCR1 - FLWRL(NY,NX)=FLYM+EVAPR(NY,NX)-FLV1 - HFLWRL(NY,NX)=HWFLYM+HFLR1-HWFLV1-HFLCR1 - FLWVL(NU(NY,NX),NY,NX)=RFLWV(NY,NX)*(VOLW1(NU(NY,NX),NY,NX) - 2-VOLWX1(NU(NY,NX),NY,NX)) - FLWV(NU(NY,NX),NY,NX)=FLWV(NU(NY,NX),NY,NX) - 2+FLWVL(NU(NY,NX),NY,NX) -C IF(NX.EQ.1.AND.NY.EQ.6)THEN -C WRITE(*,3376)'FLW1',I,J,M,NX,NY,FLWL(3,NU(NY,NX),NY,NX) -C 2,PSISM1(0,NY,NX),PSISM1(NU(NY,NX),NY,NX),VOLWRX(NY,NX) -C 3,VOLW1(0,NY,NX),VOLW1(NU(NY,NX),NY,NX),THETWX(NU(NY,NX),NY,NX) -C 2,FLQM,EVAP(NY,NX),PARE,VPQ(NY,NX),VP1 -C 4,FLWRL(NY,NX),FLYM,EVAPR(NY,NX),FLV1 -C WRITE(*,3376)'HFLW1',I,J,M,NX,NY,HFLWL(3,NU(NY,NX),NY,NX) -C 2,HWFLQM,HFLW1,HWFLV1,HFLCR1,HFLWRL(NY,NX),HWFLYM -C 3,HFLR1,HWFLV1,HFLCR1 -3376 FORMAT(A8,5I4,40E12.4) -C ENDIF -C -C HEAT AND WATER TRANSFER WITH RESIDUAL SNOWPACK -C - TFLWS(NY,NX)=TFLWS(NY,NX)+FLQ0S(NY,NX)-FLWS1(NY,NX) - TFLWW(NY,NX)=TFLWW(NY,NX)+FLQ0W(NY,NX)-FLWZ1(NY,NX) - TFLWI(NY,NX)=TFLWI(NY,NX)-FLWI1(NY,NX) - THFLWW(NY,NX)=THFLWW(NY,NX)+HWFLQ0(NY,NX)-HFLWZ1(NY,NX) - 2-HFLSI1(NY,NX) - THRMG(NY,NX)=THRMG(NY,NX)+THRMA+THRMZ -C IF(NX.EQ.4.AND.NY.EQ.4)THEN -C WRITE(*,7754)'THFLWS',I,J,M,NX,NY,THFLWW(NY,NX) -C 2,HWFLQ0(NY,NX),HFLWZ1(NY,NX) -C 2-HFLSI1(NY,NX) -C ENDIF - ENDIF -C -C CAPILLARY EXCHANGE OF WATER BETWEEN SOIL SURFACE AND RESIDUE -C - CNDR=HCNDR(NY,NX)*(PSISE(0,NY,NX)/PSISM1(0,NY,NX))**3 - IF(VOLW1(0,NY,NX).GE.VOLWRX(NY,NX))THEN - CND1=HCND(3,1,NU(NY,NX),NY,NX)*XNPH - ELSE - K1=MIN(100,INT(100.0*(AMAX1(0.0,POROS(NU(NY,NX),NY,NX) - 2-THETWX(NU(NY,NX),NY,NX)))/POROS(NU(NY,NX),NY,NX))+1) - CND1=HCND(3,K1,NU(NY,NX),NY,NX)*XNPH - ENDIF - AVCND1=2.0*CNDR*CND1/(CNDR*DLYR(3,NU(NY,NX),NY,NX) - 2+CND1*DLYRR(NY,NX)) - FLXQR=AVCND1*(PSISM1(0,NY,NX)-PSISM1(NU(NY,NX),NY,NX)) - 2*AREA(3,NU(NY,NX),NY,NX) - IF(FLXQR.LT.0.0)THEN - FLXSR=AMAX1(FLXQR,-XNPH*AMIN1(VOLW1(NU(NY,NX),NY,NX) - 2,AMAX1(0.0,VOLWRX(NY,NX)-VOLW1(0,NY,NX)-VOLI1(0,NY,NX)))) - ELSE - FLXSR=AMIN1(FLXQR,XNPH*VOLW1(0,NY,NX)) - FLXSR=AMIN1(FLXSR,XNPH*VOLP1(NU(NY,NX),NY,NX)) - ENDIF - IF(FLXSR.GT.0.0)THEN - HFLXSR=4.19*TK1(0,NY,NX)*FLXSR - ELSE - HFLXSR=4.19*TK1(NU(NY,NX),NY,NX)*FLXSR - ENDIF - FLWL(3,NU(NY,NX),NY,NX)=FLWL(3,NU(NY,NX),NY,NX)+FLXSR - HFLWL(3,NU(NY,NX),NY,NX)=HFLWL(3,NU(NY,NX),NY,NX)+HFLXSR - FLWRL(NY,NX)=FLWRL(NY,NX)-FLXSR - HFLWRL(NY,NX)=HFLWRL(NY,NX)-HFLXSR - FLWRM(M,NY,NX)=FLXSR -C IF(NX.EQ.1.AND.NY.EQ.6)THEN -C WRITE(*,4322)'FLWLY',I,J,M,NX,NY,FLWRL(NY,NX),FLWLY,FLWLYR -C 2,FLWLYH,FLXSR,VOLX(NU(NY,NX),NY,NX),VOLA(NU(NY,NX),NY,NX) -C 3,VOLP1(NU(NY,NX),NY,NX),VOLW1(NU(NY,NX),NY,NX) -C 3,VOLI1(NU(NY,NX),NY,NX),VOLP1(0,NY,NX),VOLW1(0,NY,NX) -C 3,VOLI1(0,NY,NX),FLXQR,PSISM1(0,NY,NX) -C 4,PSISM1(NU(NY,NX),NY,NX),AVCND1 -C 2,VOLAH1(NU(NY,NX),NY,NX),VOLPH1(NU(NY,NX),NY,NX) -C 2,VOLWH1(NU(NY,NX),NY,NX),VOLIH1(NU(NY,NX),NY,NX) -4322 FORMAT(A8,5I4,40E12.4) -C ENDIF -C -C MOVE WATER UP DURING PRECIPITATION OR FREEZING -C - IF(VOLW1(NU(NY,NX),NY,NX)+VOLI1(NU(NY,NX),NY,NX) - 2.GT.VOLA(NU(NY,NX),NY,NX))THEN - FLWLY=AMIN1(0.0,AMAX1(-XNPH*VOLW1(NU(NY,NX),NY,NX) - 2,VOLA(NU(NY,NX),NY,NX)-VOLW1(NU(NY,NX),NY,NX) - 3-VOLI1(NU(NY,NX),NY,NX))) - HFLWLY=FLWLY*4.19*TK1(NU(NY,NX),NY,NX) - FLWL(3,NU(NY,NX),NY,NX)=FLWL(3,NU(NY,NX),NY,NX)+FLWLY - HFLWL(3,NU(NY,NX),NY,NX)=HFLWL(3,NU(NY,NX),NY,NX)+HFLWLY - FLWLYR=AMIN1(0.0,FLWLY+VOLPH1(NU(NY,NX),NY,NX)) - HFLWYR=FLWLYR*4.19*TK1(NU(NY,NX),NY,NX) - FLWLYH=FLWLY-FLWLYR - HFLWYH=FLWLYH*4.19*TK1(NU(NY,NX),NY,NX) - FLWRL(NY,NX)=FLWRL(NY,NX)-FLWLYR - HFLWRL(NY,NX)=HFLWRL(NY,NX)-HFLWYR - FLWHL(3,NU(NY,NX),NY,NX)=FLWHL(3,NU(NY,NX),NY,NX)-FLWLYH - HFLWL(3,NU(NY,NX),NY,NX)=HFLWL(3,NU(NY,NX),NY,NX)-HFLWYH - ENDIF - IF(VOLWH1(NU(NY,NX),NY,NX)+VOLIH1(NU(NY,NX),NY,NX) - 2.GT.VOLAH1(NU(NY,NX),NY,NX))THEN - FLWHY=AMIN1(0.0,AMAX1(-XNPH*VOLWH1(NU(NY,NX),NY,NX) - 2,VOLAH1(NU(NY,NX),NY,NX)-VOLWH1(NU(NY,NX),NY,NX) - 3-VOLIH1(NU(NY,NX),NY,NX))) - HFLWHY=FLWHY*4.19*TK1(NU(NY,NX),NY,NX) - FLWHL(3,NU(NY,NX),NY,NX)=FLWHL(3,NU(NY,NX),NY,NX)+FLWHY - HFLWL(3,NU(NY,NX),NY,NX)=HFLWL(3,NU(NY,NX),NY,NX)+HFLWHY - FLWRL(NY,NX)=FLWRL(NY,NX)-FLWHY - HFLWRL(NY,NX)=HFLWRL(NY,NX)-HFLWHY -C IF(NX.EQ.1.AND.NY.EQ.6)THEN -C WRITE(*,4324)'FLWHY',I,J,M,NX,NY,FLWRL(NY,NX),FLWHY -C 2,VOLAH1(NU(NY,NX),NY,NX),VOLPH1(NU(NY,NX),NY,NX) -C 2,VOLWH1(NU(NY,NX),NY,NX),VOLIH1(NU(NY,NX),NY,NX) -C 2,VOLAH1(NU(NY,NX)+1,NY,NX),VOLPH1(NU(NY,NX)+1,NY,NX) -C 2,VOLWH1(NU(NY,NX)+1,NY,NX),VOLIH1(NU(NY,NX)+1,NY,NX) -C 3,VOLW1(0,NY,NX) -4324 FORMAT(A8,5I4,30E12.4) -C ENDIF - ENDIF -C IF((I/10)*10.EQ.I)THEN -C WRITE(*,4321)'HCNDR',I,J,M,NX,NY,K1,AVCND1,CNDR,CND1,DLYRR(NY,NX) -C 2,PSISM1(0,NY,NX),PSISM1(NU(NY,NX),NY,NX),FLXQR,FLXSR,HFLXSR -C 3,VOLWR2,TRA0(NY,NX),EVAPR(NY,NX),VOLWRX(NY,NX)-VOLW1(0,NY,NX) -C 2-VOLI1(0,NY,NX),VOLW1(NU(NY,NX),NY,NX),VOLW1(0,NY,NX) -C 4,VOLP1(NU(NY,NX),NY,NX),POROS(NU(NY,NX),NY,NX) -C 5,VOLWG(NY,NX),FLYM,HCNDR(NY,NX),PSISE(0,NY,NX),PSISM1(0,NY,NX) -C 6,THETWR,VHCPR1(NY,NX),VHCPRX(NY,NX) -4321 FORMAT(A8,6I4,30E12.4) -C ENDIF -C -C OVERLAND FLOW INTO MACROPORES WHEN WATER STORAGE CAPACITY -C OF THE SOIL SURFACE IS EXCEEDED -C - IF(VOLPH1(NU(NY,NX),NY,NX).GT.0.0)THEN - IF(VOLW1(0,NY,NX).GT.VOLWRX(NY,NX))THEN - AVCNH1=2.0*CNDH1(NU(NY,NX),NY,NX)/DLYR(3,NU(NY,NX),NY,NX) - FLWHX=AVCNH1*0.0098*DPTH(NU(NY,NX),NY,NX)*AREA(3,NU(NY,NX),NY,NX) - FINHR=AMIN1(VOLPH1(NU(NY,NX),NY,NX) - 2,VOLW1(0,NY,NX)-VOLWRX(NY,NX),FLWHX) - HFINHR=FINHR*4.19*TK1(0,NY,NX) - FLWRL(NY,NX)=FLWRL(NY,NX)-FINHR - HFLWRL(NY,NX)=HFLWRL(NY,NX)-HFINHR - FLWHL(3,NU(NY,NX),NY,NX)=FLWHL(3,NU(NY,NX),NY,NX)+FINHR - HFLWL(3,NU(NY,NX),NY,NX)=HFLWL(3,NU(NY,NX),NY,NX)+HFINHR -C IF(NX.EQ.1.AND.NY.EQ.6)THEN -C WRITE(*,4357)'FINHR',I,J,M,NX,NY,FLWRL(NY,NX),FINHR -C 2,VOLPH1(NU(NY,NX),NY,NX),TVOLW(NY,NX),FLWHX,VOLW1(0,NY,NX) -C 3,VOLWRX(NY,NX),FLWHL(3,NU(NY,NX),NY,NX) -C 4,HFINHR,TK1(0,NY,NX),HFLWRL(NY,NX),HFLWL(3,NU(NY,NX),NY,NX) -4357 FORMAT(A8,5I4,40E12.4) -C ENDIF - ENDIF - ENDIF -C -C FREEZE-THAW IN RESIDUE SURFACE FROM NET CHANGE IN RESIDUE -C SURFACE HEAT STORAGE -C - TFREEZ=-9.0959E+04/(PSISM1(0,NY,NX)-333.0) - IF((TK1(0,NY,NX).LT.TFREEZ - 2.AND.VOLW1(0,NY,NX).GT.ZERO*VOLA(0,NY,NX)) - 3.OR.(TK1(0,NY,NX).GT.TFREEZ - 4.AND.VOLI1(0,NY,NX).GT.ZERO*VOLA(0,NY,NX)))THEN - TFLX1=1.0/(1.0+TFREEZ*6.2913E-03) - 2*(TFREEZ*4.19*FLWRL(NY,NX) - 3+VHCPR1(NY,NX)*(TFREEZ-TK1(0,NY,NX)) - 4-HFLWRL(NY,NX)) - IF(TFLX1.LT.0.0)THEN - TFLX=AMAX1(-333.0*0.92*VOLI1(0,NY,NX)*XNPH - 2,-VHCPR1(NY,NX)*XNPH*10.0,TFLX1) - ELSE - TFLX=AMIN1(333.0*VOLW1(0,NY,NX)*XNPH - 2,VHCPR1(NY,NX)*XNPH*10.0,TFLX1) - ENDIF - WFLX=-TFLX/333.0 - IF(WFLX.GT.0.0.AND.VOLI1(0,NY,NX) - 2.GT.ZEROS(NY,NX))THEN - WFLXR(NY,NX)=WFLX - TFLXR(NY,NX)=TFLX - ELSEIF(WFLX.LT.0.0.AND.VOLW1(0,NY,NX) - 2.GT.ZEROS(NY,NX))THEN - WFLXR(NY,NX)=WFLX - TFLXR(NY,NX)=TFLX - ELSE - WFLXR(NY,NX)=0.0 - TFLXR(NY,NX)=0.0 - ENDIF - ELSE - WFLXR(NY,NX)=0.0 - TFLXR(NY,NX)=0.0 - ENDIF -C WRITE(*,5352)'TFLXR',I,J,M,WFLXR(NY,NX),TFLXR(NY,NX) -C 2,PSISV0,THETWR,TFLX,WFLX,VOLI1(0,NY,NX),VOLW1(0,NY,NX) -C 3,TKXR,TFREEZ,PSISV0 -5352 FORMAT(A8,3I4,20E12.4) -C -C FREEZE-THAW IN SOIL SURFACE MICROPORE FROM NET CHANGE IN SOIL -C SURFACE HEAT STORAGE -C - TFREEZ=-9.0959E+04/(PSISV1-333.0) - IF((TK1(NU(NY,NX),NY,NX).LT.TFREEZ - 2.AND.VOLW1(NU(NY,NX),NY,NX).GT.ZERO*VOLA(NU(NY,NX),NY,NX) - 3.AND.VOLI1(NU(NY,NX),NY,NX).LT.VOLA(NU(NY,NX),NY,NX)) - 4.OR.(TK1(NU(NY,NX),NY,NX).GT.TFREEZ - 5.AND.VOLI1(NU(NY,NX),NY,NX).GT.ZERO*VOLA(NU(NY,NX),NY,NX)))THEN - TFLX1=FGRD(NU(NY,NX),NY,NX)*(1.0/(1.0+TFREEZ*6.2913E-03) - 2*(TFREEZ*4.19*(FLWL(3,NU(NY,NX),NY,NX)+FLWHL(3,NU(NY,NX),NY,NX)) - 3+VHCP1(NU(NY,NX),NY,NX)*(TFREEZ-TK1(NU(NY,NX),NY,NX)) - 4-HFLWL(3,NU(NY,NX),NY,NX))) - IF(TFLX1.LT.0.0)THEN - TFLX=AMAX1(-333.0*0.92*VOLI1(NU(NY,NX),NY,NX)*XNPH,TFLX1) - ELSE - TFLX=AMIN1(333.0*VOLW1(NU(NY,NX),NY,NX)*XNPH,TFLX1) - ENDIF - WFLX=-TFLX/333.0 - IF(WFLX.GT.0.0.AND.VOLI1(NU(NY,NX),NY,NX) - 2.GT.ZEROS(NY,NX))THEN - WFLXL(3,NU(NY,NX),NY,NX)=WFLX - ELSEIF(WFLX.LT.0.0.AND.VOLW1(NU(NY,NX),NY,NX) - 2.GT.ZEROS(NY,NX))THEN - WFLXL(3,NU(NY,NX),NY,NX)=WFLX - ELSE - TFLX=0.0 - WFLXL(3,NU(NY,NX),NY,NX)=0.0 - ENDIF - ELSE - TFLX=0.0 - WFLXL(3,NU(NY,NX),NY,NX)=0.0 - ENDIF -C -C FREEZE-THAW IN SOIL SURFACE MACROPORE FROM NET CHANGE IN SOIL -C SURFACE HEAT STORAGE -C - IF((TK1(NU(NY,NX),NY,NX).LT.273.15.AND.VOLWH1(NU(NY,NX),NY,NX) - 2.GT.ZERO*VOLT(NU(NY,NX),NY,NX)).OR.(TK1(NU(NY,NX),NY,NX) - 3.GT.273.15.AND.VOLIH1(NU(NY,NX),NY,NX) - 4.GT.ZERO*VOLT(NU(NY,NX),NY,NX)))THEN - TFLX1=FMAC(NU(NY,NX),NY,NX)*(1.0/(1.0+273.15*6.2913E-03) - 2*(273.15*4.19*(FLWL(3,NU(NY,NX),NY,NX)+FLWHL(3,NU(NY,NX),NY,NX)) - 3+VHCP1(NU(NY,NX),NY,NX)*(273.15-TK1(NU(NY,NX),NY,NX)) - 4-HFLWL(3,NU(NY,NX),NY,NX))) - IF(TFLX1.LT.0.0)THEN - TFLXH=AMAX1(-333.0*0.92*VOLIH1(NU(NY,NX),NY,NX)*XNPH,TFLX1) - ELSE - TFLXH=AMIN1(333.0*VOLWH1(NU(NY,NX),NY,NX)*XNPH,TFLX1) - ENDIF - WFLXH=-TFLXH/333.0 - IF(WFLXH.GT.0.0.AND.VOLIH1(NU(NY,NX),NY,NX) - 2.GT.ZEROS(NY,NX))THEN - WFLXLH(3,NU(NY,NX),NY,NX)=WFLXH - ELSEIF(WFLXH.LT.0.0.AND.VOLWH1(NU(NY,NX),NY,NX) - 2.GT.ZEROS(NY,NX))THEN - WFLXLH(3,NU(NY,NX),NY,NX)=WFLXH - ELSE - TFLXH=0.0 - WFLXLH(3,NU(NY,NX),NY,NX)=0.0 - ENDIF - ELSE - TFLXH=0.0 - WFLXLH(3,NU(NY,NX),NY,NX)=0.0 - ENDIF - TFLXL(3,NU(NY,NX),NY,NX)=TFLX+TFLXH -C IF(NY.EQ.1)THEN -C WRITE(*,4358)'TFLX',I,J,M,TFREEZ,TK1(NU(NY,NX),NY,NX),PSISV1 -C 2,TFLX,TFLXH,TFLXL(3,NU(NY,NX),NY,NX),WFLX,WFLXH -C 2,WFLXL(3,NU(NY,NX),NY,NX),WFLXLH(3,NU(NY,NX),NY,NX) -C 4,VOLW1(NU(NY,NX),NY,NX),VOLWH1(NU(NY,NX),NY,NX) -C 4,VOLI1(NU(NY,NX),NY,NX),VOLIH1(NU(NY,NX),NY,NX) -C 5,FGRD(NU(NY,NX),NY,NX),FMAC(NU(NY,NX),NY,NX) -4358 FORMAT(A8,3I4,20E12.4) -C ENDIF -C -C -C THICKNESS OF WATER FILMS FOR GAS EXCHANGE IN 'TRNSFR' -C - IF(VHCPR1(NY,NX).GT.VHCPRX(NY,NX))THEN - FILM(M,0,NY,NX)=AMAX1(1.0E-06 - 2,EXP(-13.650-0.857*LOG(-PSISM1(0,NY,NX)))) - ELSE - FILM(M,0,NY,NX)=1.0E-03 - ENDIF -C IF(BKVL(NU(NY,NX),NY,NX).GT.0.0)THEN - FILM(M,NU(NY,NX),NY,NX)=AMAX1(1.0E-06 - 2,EXP(-13.650-0.857*LOG(-PSISM1(NU(NY,NX),NY,NX)))) -C ELSE -C FILM(M,NU(NY,NX),NY,NX)=DLYR(3,NU(NY,NX),NY,NX) -C ENDIF -C -C OVERLAND FLOW WHEN WATER STORAGE CAPACITY -C OF THE SOIL SURFACE PLUS MACROPORES IS EXCEEDED -C - N1=NX - N2=NY - TVOLZ1=AMAX1(0.0,VOLW1(0,N2,N1)+VOLI1(0,N2,N1)-VOLWRX(N2,N1)) - VOLWZ1=AMAX1(0.0,VOLW1(0,N2,N1)-VOLWRX(N2,N1)) -C -C LOCATE INTERNAL BOUNDARIES BETWEEN ADJACENT GRID CELLS -C - DO 4310 N=1,2 - IF(N.EQ.1)THEN - IF(NX.EQ.NHE)THEN - GO TO 4310 - ELSE - N4=NX+1 - N5=NY - WDTH=DLYR(2,NU(NY,NX),NY,NX) - ENDIF - ELSEIF(N.EQ.2)THEN - IF(NY.EQ.NVS)THEN - GO TO 4310 - ELSE - N4=NX - N5=NY+1 - WDTH=DLYR(1,NU(NY,NX),NY,NX) - ENDIF - ENDIF -C -C ELEVATION OF EACH PAIR OF ADJACENT GRID CELLS -C - TVOLZ2=AMAX1(0.0,VOLW1(0,N5,N4)+VOLI1(0,N5,N4)-VOLWRX(N5,N4)) - VOLWZ2=AMAX1(0.0,VOLW1(0,N5,N4)-VOLWRX(N5,N4)) - ALT1=ALTG(N2,N1)+TVOLZ1/AREA(3,NU(N2,N1),N2,N1) - ALT2=ALTG(N5,N4)+TVOLZ2/AREA(3,NU(N5,N4),N5,N4) -C -C EXCESS SURFACE WATER DEPTH, WETTED PERIMETER, SLOPE, VELOCITY -C - IF(ALT1.GT.ALT2.AND.TVOLZ1.GT.VOLWG(N2,N1))THEN - QRX1=TVOLZ1-VOLWG(N2,N1) - D=QRX1/AREA(3,NU(N2,N1),N2,N1) - R=D/2.828 - S=(ALT1-ALT2)/DIST(N,NU(N5,N4),N5,N4) - V=R**0.67*SQRT(S)/ZM(N2,N1) -C -C RUNOFF -C - Q=V*D*AMIN1(1.0,D/ZS(N2,N1))*WDTH*3.6E+03*XNPH - QRQ1=AMAX1(0.0,((ALT1-ALT2)*AREA(3,NU(N2,N1),N2,N1) - 2*AREA(3,NU(N5,N4),N5,N4)-TVOLZ2*AREA(3,NU(N2,N1),N2,N1) - 3+TVOLZ1*AREA(3,NU(N5,N4),N5,N4)) - 4/(AREA(3,NU(N2,N1),N2,N1)+AREA(3,NU(N5,N4),N5,N4))) - QR1(N,N5,N4)=AMIN1(Q,0.25*QRQ1,0.25*QRX1)*VOLWZ1/TVOLZ1 - HQR1(N,N5,N4)=4.19*TK1(0,N2,N1)*QR1(N,N5,N4) -C -C EXCESS SURFACE WATER DEPTH, WETTED PERIMETER, SLOPE, VELOCITY -C - ELSEIF(ALT1.LT.ALT2.AND.TVOLZ2.GT.VOLWG(N5,N4))THEN - QRX1=TVOLZ2-VOLWG(N5,N4) - D=QRX1/AREA(3,NU(N5,N4),N5,N4) - R=D/2.828 - S=(ALT2-ALT1)/DIST(N,NU(N5,N4),N5,N4) - V=R**0.67*SQRT(S)/ZM(N5,N4) -C -C RUNON -C - Q=V*D*AMIN1(1.0,D/ZS(N5,N4))*DLYR(N,NU(N5,N4),N5,N4) - 2*3.6E+03*XNPH - QRQ1=AMIN1(0.0,((ALT1-ALT2)*AREA(3,NU(N2,N1),N2,N1) - 2*AREA(3,NU(N5,N4),N5,N4)-TVOLZ2*AREA(3,NU(N2,N1),N2,N1) - 3+TVOLZ1*AREA(3,NU(N5,N4),N5,N4)) - 4/(AREA(3,NU(N2,N1),N2,N1)+AREA(3,NU(N5,N4),N5,N4))) - QR1(N,N5,N4)=AMAX1(-Q,0.25*QRQ1,-0.25*QRX1)*VOLWZ2/TVOLZ2 - HQR1(N,N5,N4)=4.19*TK1(0,N5,N4)*QR1(N,N5,N4) - ELSE - QR1(N,N5,N4)=0.0 - HQR1(N,N5,N4)=0.0 - V=0.0 - ENDIF - QR(N,N5,N4)=QR(N,N5,N4)+QR1(N,N5,N4) - HQR(N,N5,N4)=HQR(N,N5,N4)+HQR1(N,N5,N4) - QRM(M,N,N5,N4)=QR1(N,N5,N4) - QRV(M,N,N5,N4)=V -C IF(I.EQ.186)THEN -C WRITE(*,5555)'QR1',I,J,M,N1,N2,N4,N5,N,QR1(N,N5,N4) -C 2,ALT1,ALT2,ALTG(N2,N1),ALTG(N5,N4),QRX1,D,R,S,V,Q,QRQ1 -C 2,VOLW1(0,N2,N1),VOLI1(0,N2,N1) -C 3,VOLW1(0,N5,N4),VOLI1(0,N5,N4) -C 4,VOLWZ1,VOLWZ2,TVOLZ1,TVOLZ2,VOLWG(N2,N1),VOLWG(N5,N4) -C 5,QR(N,N5,N4),TVOLW(N5,N4),FVOLW2,FVOLH2 -C 6,DIST(N,NU(N5,N4),N5,N4) -5555 FORMAT(A8,8I4,30E12.4) -C ENDIF -C -C SNOW REDISTRIBUTION -C - ALTS1=ALTG(N2,N1)+DPTHS0(N2,N1) - ALTS2=ALTG(N5,N4)+DPTHS0(N5,N4) - SS=(ALTS1-ALTS2)/DIST(N,NU(N5,N4),N5,N4) - QSX=FQSM*SS/AMAX1(1.0,DIST(N,NU(N5,N4),N5,N4)**2) - QSM(M,N,N5,N4)=QSX - IF(SS.GT.0.0.AND.DPTHS0(N2,N1).GT.DPTHSX)THEN - QS1(N,N5,N4)=QSX*VOLS0(N2,N1) - QW1(N,N5,N4)=QSX*VOLW0(N2,N1) - QI1(N,N5,N4)=QSX*VOLI0(N2,N1) - HQS1(N,N5,N4)=TK0(N2,N1)*(2.095*QS1(N,N5,N4) - 2+4.19*QW1(N,N5,N4)+1.9274*QI1(N,N5,N4)) - ELSEIF(SS.LT.0.0.AND.DPTHS0(N5,N4).GT.DPTHSX)THEN - QS1(N,N5,N4)=QSX*VOLS0(N5,N4) - QW1(N,N5,N4)=QSX*VOLW0(N5,N4) - QI1(N,N5,N4)=QSX*VOLI0(N5,N4) - HQS1(N,N5,N4)=TK0(N5,N4)*(2.095*QS1(N,N5,N4) - 2+4.19*QW1(N,N5,N4)+1.9274*QI1(N,N5,N4)) - ELSE - QS1(N,N5,N4)=0.0 - QW1(N,N5,N4)=0.0 - QI1(N,N5,N4)=0.0 - HQS1(N,N5,N4)=0.0 - ENDIF - QS(N,N5,N4)=QS(N,N5,N4)+QS1(N,N5,N4) - QW(N,N5,N4)=QW(N,N5,N4)+QW1(N,N5,N4) - QI(N,N5,N4)=QI(N,N5,N4)+QI1(N,N5,N4) - HQS(N,N5,N4)=HQS(N,N5,N4)+HQS1(N,N5,N4) - QSM(M,N,N5,N4)=QST1 -C IF(NX.EQ.2.AND.NY.EQ.5)THEN -C WRITE(*,5556)'QS1',I,J,M,N1,N2,N4,N5,N,QSX,QS1(N,N5,N4) -C 2,QW1(N,N5,N4),QI1(N,N5,N4),VOLS0(N2,N1),VOLW0(N2,N1) -C 3,VOLI0(N2,N1),ALTS1,ALTS2,ALTG(N2,N1),ALTG(N5,N4) -C 4,DIST(N,NU(N5,N4),N5,N4),SS,DPTHS0(N2,N1),DPTHS0(N5,N4) -C 5,VOLS1(N2,N1),VOLS1(N5,N4),VOLWG(N2,N1),VOLWG(N5,N4) -5556 FORMAT(A8,8I4,30E12.4) -C ENDIF -4310 CONTINUE -C -C TOTAL WATER, VAPOR AND HEAT FLUXES THROUGH SURFACE RESIDUE -C AND SOIL SURFACE -C - THAWR(NY,NX)=THAWR(NY,NX)+WFLXR(NY,NX) - HTHAWR(NY,NX)=HTHAWR(NY,NX)+TFLXR(NY,NX) - THAW(3,NU(NY,NX),NY,NX)=THAW(3,NU(NY,NX),NY,NX) - 2+WFLXL(3,NU(NY,NX),NY,NX) - THAWH(3,NU(NY,NX),NY,NX)=THAWH(3,NU(NY,NX),NY,NX) - 2+WFLXLH(3,NU(NY,NX),NY,NX) - HTHAW(3,NU(NY,NX),NY,NX)=HTHAW(3,NU(NY,NX),NY,NX) - 2+TFLXL(3,NU(NY,NX),NY,NX) - FLW(3,NU(NY,NX),NY,NX)=FLW(3,NU(NY,NX),NY,NX) - 2+FLWL(3,NU(NY,NX),NY,NX) - FLWX(3,NU(NY,NX),NY,NX)=FLWX(3,NU(NY,NX),NY,NX) - 2+FLWLX(3,NU(NY,NX),NY,NX) - FLWH(3,NU(NY,NX),NY,NX)=FLWH(3,NU(NY,NX),NY,NX) - 2+FLWHL(3,NU(NY,NX),NY,NX) - HFLW(3,NU(NY,NX),NY,NX)=HFLW(3,NU(NY,NX),NY,NX) - 2+HFLWL(3,NU(NY,NX),NY,NX) - FLWR(NY,NX)=FLWR(NY,NX)+FLWRL(NY,NX) - HFLWR(NY,NX)=HFLWR(NY,NX)+HFLWRL(NY,NX) - HEATI(NY,NX)=HEATI(NY,NX)+RFLX+RFLXR - HEATS(NY,NX)=HEATS(NY,NX)+SFLX+SFLXR - HEATE(NY,NX)=HEATE(NY,NX)+EFLX+EFLXR - HEATV(NY,NX)=HEATV(NY,NX)+VFLX+VFLXR - HEATH(NY,NX)=HEATH(NY,NX)+RFLX+RFLXR - 2+SFLX+SFLXR+EFLX+EFLXR+VFLX+VFLXR - TEVAPG(NY,NX)=TEVAPG(NY,NX)+EVAP(NY,NX)+EVAPS(NY,NX)+EVAPR(NY,NX) - VOLWX1(NU(NY,NX),NY,NX)=VOLW1(NU(NY,NX),NY,NX) - HYSM(M,NU(NY,NX),NY,NX)=HYST(NU(NY,NX),NY,NX) - FLWM(M,3,NU(NY,NX),NY,NX)=FLWL(3,NU(NY,NX),NY,NX) - FLWHM(M,3,NU(NY,NX),NY,NX)=FLWHL(3,NU(NY,NX),NY,NX) -C -C DELAYED MIGRATION OF PRECIPITATION OR MELTWATER INTO MICROPORES -C - IF(FLQM.GT.0.0.AND.VOLPX1(NU(NY,NX),NY,NX).GT.ZEROS(NY,NX) - 2.AND.HYST(NU(NY,NX),NY,NX).GT.ZERO)THEN - HYST(NU(NY,NX),NY,NX)=AMIN1(1.0,AMAX1(0.0,HYST(NU(NY,NX),NY,NX) - 2-FLQM/VOLPX1(NU(NY,NX),NY,NX))) - ENDIF - HYST(NU(NY,NX),NY,NX)=HYST(NU(NY,NX),NY,NX) - 2+(1.0-HYST(NU(NY,NX),NY,NX))*HYSTX -C -C INFILTRATION OF WATER FROM MACROPORES INTO MICROPORES -C - IF(VOLWH1(NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN - FINHX=XNPH*6.283*HCND(2,1,NU(NY,NX),NY,NX)*AREA(3,NU(NY,NX),NY,NX) - 2*(PSISE(NU(NY,NX),NY,NX)-PSISM1(NU(NY,NX),NY,NX)) - 3/LOG(PHOL(NU(NY,NX),NY,NX)/HRAD(NU(NY,NX),NY,NX)) - IF(FINHX.GT.0.0)THEN - FINHL(NU(NY,NX),NY,NX)=AMAX1(0.0,AMIN1(FINHX - 2,XNPH*VOLWH1(NU(NY,NX),NY,NX),VOLPX1(NU(NY,NX),NY,NX))) - ELSE - FINHL(NU(NY,NX),NY,NX)=AMIN1(0.0,AMAX1(FINHX - 2,-VOLPH1(NU(NY,NX),NY,NX),-XNPH*VOLW1(NU(NY,NX),NY,NX))) - ENDIF - FINHM(M,NU(NY,NX),NY,NX)=FINHL(NU(NY,NX),NY,NX) - FINH(NU(NY,NX),NY,NX)=FINH(NU(NY,NX),NY,NX)+FINHL(NU(NY,NX),NY,NX) -C IF(J.EQ.12.AND.M.EQ.1)THEN -C WRITE(*,3367)'HOLE',I,J,M,NX,NY -C 2,FINHL(NU(NY,NX),NY,NX),FINHX -C 2,VOLWH1(NU(NY,NX),NY,NX),VOLPH1(NU(NY,NX),NY,NX) -C 3,VOLAH1(NU(NY,NX),NY,NX),PSISE(NU(NY,NX),NY,NX) -C 4,PSISM1(NU(NY,NX),NY,NX),VOLW1(NU(NY,NX),NY,NX) -C 5,HCND(2,1,NU(NY,NX),NY,NX),PHOL(NU(NY,NX),NY,NX) -C 5,HRAD(NU(NY,NX),NY,NX) -3367 FORMAT(A8,5I4,20E12.4) -C ENDIF - ELSE - FINHM(M,NU(NY,NX),NY,NX)=0.0 - FINHL(NU(NY,NX),NY,NX)=0.0 - ENDIF -C -C WATER AND ENERGY TRANSFER THROUGH SOIL PROFILE -C - IFLGH=0 - DO 4400 L=1,NL(NY,NX) -C -C CALCULATE CHANGE IN THICKNESS OF ICE LAYER -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 -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) -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 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) -C 3,CDPTH(L,NY,NX),DPTH(L,NY,NX),YDPTH(L,NY,NX),DLYR(3,L,NY,NX) -C 4,VOLP1(L,NY,NX) -910 FORMAT(A8,5I4,12E16.8) -C ENDIF - ENDIF - ENDIF -C -C END THICKNESS -C - N1=NX - N2=NY - N3=L -C -C LOCATE INTERNAL BOUNDARIES BETWEEN ADJACENT GRID CELLS -C - DO 4320 N=NCN(N2,N1),3 - IF(N.EQ.1)THEN - IF(NX.EQ.NHE)THEN - GO TO 4320 - ELSE - N4=NX+1 - N5=NY - N6=L -C -C ARTIFICIAL SOIL WARMING – PREVENT LATERAL FLOW -C -C IF(N2.EQ.2.AND.(N1.EQ.2.OR.N1.EQ.3).AND.L.LE.15)THEN -C GO TO 4320 -C ENDIF - ENDIF - ELSEIF(N.EQ.2)THEN - IF(NY.EQ.NVS)THEN - GO TO 4320 - ELSE - N4=NX - N5=NY+1 - N6=L -C -C ARTIFICIAL SOIL WARMING – PREVENT LATERAL FLOW -C -C IF(N1.EQ.3.AND.(N2.EQ.1.OR.N2.EQ.2).AND.L.LE.15)THEN -C GO TO 4320 -C ENDIF - ENDIF - ELSEIF(N.EQ.3)THEN - IF(L.EQ.NL(NY,NX))THEN - GO TO 4320 - ELSE - N4=NX - N5=NY - N6=L+1 - ENDIF - ENDIF -C -C POROSITIES 'THETP*', WATER CONTENTS 'THETA*', AND POTENTIALS -C 'PSIS*' FOR EACH GRID CELL -C - IF(N3.GE.NU(N2,N1).AND.N6.GE.NU(N5,N4) - 2.AND.N3.LE.NL(N2,N1).AND.N6.LE.NL(N5,N4))THEN - THETP1=AMAX1(0.0,VOLPX1(N3,N2,N1)/VOLX(N3,N2,N1)) - THETPL=AMAX1(0.0,VOLPX1(N6,N5,N4)/VOLX(N6,N5,N4)) - THETA1=AMAX1(THETY(N3,N2,N1),AMIN1(POROS(N3,N2,N1) - 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 - IF(THETA1.LT.FC(N3,N2,N1))THEN - PSISA1=AMAX1(HYGR,-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 - PSISA1=-EXP(PSIMS(N2,N1) - 2+(((PSL(N3,N2,N1)-LOG(THETA1)) - 3/PSD(N3,N2,N1))**SRP(N3,N2,N1)*PSISD(N2,N1))) - ELSE - PSISA1=PSISE(N3,N2,N1) - ENDIF -C ELSE -C PSISA1=PSISE(N3,N2,N1) -C ENDIF -C IF(BKVL(N6,N5,N4).GT.0.0)THEN - IF(THETAL.LT.FC(N6,N5,N4))THEN - PSISAL=AMAX1(HYGR,-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 - PSISAL=-EXP(PSIMS(N5,N4) - 2+(((PSL(N6,N5,N4)-LOG(THETAL)) - 3/PSD(N6,N5,N4))**SRP(N6,N5,N4)*PSISD(N5,N4))) - ELSE - PSISAL=PSISE(N6,N5,N4) - ENDIF -C ELSE -C PSISAL=PSISE(N6,N5,N4) -C ENDIF -C IF(J.GE.20)THEN -C WRITE(*,7272)'PSIM',I,J,N1,N2,N3,N4,N5,N6,M,PSISM1(N6,N5,N4) -C 2,PSIMX(N5,N4),FCL(N6,N5,N4),THETWL,FCD(N6,N5,N4),PSIMD(N5,N4) -C 3,POROS(N6,N5,N4),PSIMS(N5,N4),PSL(N6,N5,N4),PSD(N6,N5,N4) -C 4,SRP(N6,N5,N4),PSISD(N5,N4),THETAL,PSISE(N6,N5,N4) -C 5,THETAL-POROS(N6,N5,N4),PSISA1,PSISAL -7272 FORMAT(A8,9I4,20E12.4) -C ENDIF -C -C DARCY FLOW IF BOTH CELLS ARE SATURATED -C (CURRENT WATER POTENTIAL > AIR ENTRY WATER POTENTIAL) -C - IF(PSISA1.GT.PSISA(N3,N2,N1) - 2.AND.PSISAL.GT.PSISA(N6,N5,N4))THEN - THETW1=THETA1 - THETWL=THETAL - CND1=HCND(N,1,N3,N2,N1)*XNPH - CNDL=HCND(N,1,N6,N5,N4)*XNPH - PSISM1(N3,N2,N1)=PSISA1 - PSISM1(N6,N5,N4)=PSISAL - IF(PSISM1(N3,N2,N1).GE.PSISM1(N6,N5,N4) - 2.AND.VOLW1(N3,N2,N1).GT.ZEROS(N2,N1))THEN - FLGX=VOLWX1(N3,N2,N1)/VOLW1(N3,N2,N1) - ELSEIF(VOLW1(N6,N5,N4).GT.ZEROS(N5,N4))THEN - FLGX=VOLWX1(N6,N5,N4)/VOLW1(N6,N5,N4) - ELSE - FLGX=0.0 - ENDIF -C -C GREEN-AMPT FLOW IF ONE LAYER IS SATURATED -C (CURRENT WATER POTENTIAL < AIR ENTRY WATER POENTIAL) -C -C -C GREEN-AMPT FLOW IF SOURCE CELL SATURATED -C - ELSEIF(PSISA1.GT.PSISA(N3,N2,N1))THEN - THETW1=THETA1 - THETWL=AMAX1(THETY(N6,N5,N4),AMIN1(POROS(N6,N5,N4) - 2,VOLWX1(N6,N5,N4)/VOLX(N6,N5,N4))) - 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 - IF(THETWL.LT.FC(N6,N5,N4))THEN - PSISM1(N6,N5,N4)=AMAX1(HYGR,-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 - PSISM1(N6,N5,N4)=-EXP(PSIMS(N5,N4) - 2+(((PSL(N6,N5,N4)-LOG(THETWL)) - 3/PSD(N6,N5,N4))**SRP(N6,N5,N4)*PSISD(N5,N4))) - ELSE - PSISM1(N6,N5,N4)=PSISE(N6,N5,N4) - ENDIF -C ELSE -C PSISM1(N6,N5,N4)=PSISE(N6,N5,N4) -C ENDIF - FLGX=0.0 -C -C GREEN-AMPT FLOW IF ADJACENT CELL SATURATED -C - ELSEIF(PSISAL.GT.PSISA(N6,N5,N4))THEN - THETW1=AMAX1(THETY(N3,N2,N1),AMIN1(POROS(N3,N2,N1) - 2,VOLWX1(N3,N2,N1)/VOLX(N3,N2,N1))) - 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 - IF(THETW1.LT.FC(N3,N2,N1))THEN - PSISM1(N3,N2,N1)=AMAX1(HYGR,-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 - PSISM1(N3,N2,N1)=-EXP(PSIMS(N2,N1) - 2+(((PSL(N3,N2,N1)-LOG(THETW1)) - 3/PSD(N3,N2,N1))**SRP(N3,N2,N1)*PSISD(N2,N1))) - ELSE - PSISM1(N3,N2,N1)=PSISE(N3,N2,N1) - ENDIF -C ELSE -C PSISM1(N3,N2,N1)=PSISE(N3,N2,N1) -C ENDIF - FLGX=0.0 -C -C RICHARDS FLOW IF NEITHER CELL IS SATURATED -C (CURRENT WATER POTENTIAL < AIR ENTRY WATER POTENTIAL) -C - ELSE - THETW1=THETA1 - THETWL=THETAL - K1=MIN(100,INT(100.0*(POROS(N3,N2,N1)-THETA1)/POROS(N3,N2,N1))+1) - CND1=HCND(N,K1,N3,N2,N1)*XNPH - KL=MIN(100,INT(100.0*(POROS(N6,N5,N4)-THETAL)/POROS(N6,N5,N4))+1) - CNDL=HCND(N,KL,N6,N5,N4)*XNPH - PSISM1(N3,N2,N1)=PSISA1 - PSISM1(N6,N5,N4)=PSISAL - IF(PSISM1(N3,N2,N1).GE.PSISM1(N6,N5,N4) - 2.AND.VOLW1(N3,N2,N1).GT.ZEROS(N2,N1))THEN - FLGX=VOLWX1(N3,N2,N1)/VOLW1(N3,N2,N1) - ELSEIF(VOLW1(N6,N5,N4).GT.ZEROS(N5,N4))THEN - FLGX=VOLWX1(N6,N5,N4)/VOLW1(N6,N5,N4) - ELSE - FLGX=0.0 - ENDIF - ENDIF -C -C TOTAL SOIL WATER POTENTIAL = MATRIC, GRAVIMETRIC + OSMOTIC -C - PSIST1=PSISM1(N3,N2,N1)+PSISH(N3,N2,N1)+0.03*PSISO(N3,N2,N1) - PSISTL=PSISM1(N6,N5,N4)+PSISH(N6,N5,N4)+0.03*PSISO(N6,N5,N4) - PSISV1=PSISM1(N3,N2,N1)+PSISO(N3,N2,N1) - PSISVL=PSISM1(N6,N5,N4)+PSISO(N6,N5,N4) -C -C HYDRAULIC CONDUCTIVITY FROM CURRENT WATER CONTENT -C AND LOOKUP ARRAY GENERATED IN 'HOUR1' -C - IF(CND1.GT.ZERO.AND.CNDL.GT.ZERO)THEN - AVCNDL=2.0*CND1*CNDL/(CND1*DLYR(N,N6,N5,N4) - 2+CNDL*DLYR(N,N3,N2,N1)) - ELSE - AVCNDL=0.0 - ENDIF -C -C WATER FLUX FROM WATER POTENTIALS, HYDRAULIC CONDUCTIVITY -C CONSTRAINED BY WATER POTENTIAL GRADIENT, COUPLED WITH -C CONVECTIVE HEAT FLUX FROM WATER FLUX -C - FLQX=AVCNDL*(PSIST1-PSISTL)*AREA(N,N3,N2,N1) - IF(FLQX.GE.0.0)THEN - FLQL=AMAX1(0.0,AMIN1(FLQX,VOLW1(N3,N2,N1)*XNPH)) - FLQL=AMIN1(FLQL,VOLP1(N6,N5,N4)*XNPH) - HWFLQL=4.19*TK1(N3,N2,N1)*FLQL - ELSE - FLQL=AMIN1(0.0,AMAX1(FLQX,-VOLW1(N6,N5,N4)*XNPH)) - FLQL=AMAX1(FLQL,-VOLP1(N3,N2,N1)*XNPH) - HWFLQL=4.19*TK1(N6,N5,N4)*FLQL - ENDIF - FLQ2=FLGX*FLQL -C -C INFILTRATION OF WATER FROM MACROPORES INTO MICROPORES -C - IF(N.EQ.3.AND.VOLWH1(N6,N5,N4).GT.ZEROS(N5,N4))THEN - FINHX=XNPH*6.283*HCND(2,1,N6,N5,N4)*AREA(3,N6,N5,N4) - 2*(PSISE(N6,N5,N4)-PSISM1(N6,N5,N4)) - 3/LOG(PHOL(N6,N5,N4)/HRAD(N6,N5,N4)) - IF(FINHX.GT.0.0)THEN - FINHL(N6,N5,N4)=AMAX1(0.0,AMIN1(FINHX,XNPH*VOLWH1(N6,N5,N4) - 2,VOLPX1(N6,N5,N4))) - ELSE - FINHL(N6,N5,N4)=AMIN1(0.0,AMAX1(FINHX,-VOLPH1(N6,N5,N4) - 2,-XNPH*VOLW1(N6,N5,N4))) - ENDIF - FINHM(M,N6,N5,N4)=FINHL(N6,N5,N4) - FINH(N6,N5,N4)=FINH(N6,N5,N4)+FINHL(N6,N5,N4) -C IF(NX.EQ.1.AND.NY.EQ.1)THEN -C WRITE(*,3366)'FINHL',I,J,M,N4,N5,N6,IFLGH,FINHL(N6,N5,N4) -C 3,FINHX,VOLWH1(N6,N5,N4),VOLPH1(N6,N5,N4),VOLP1(N6,N5,N4) -C 4,PSISM1(N6,N5,N4),HCND(2,1,N6,N5,N4),PHOL(N6,N5,N4) -C 5,HRAD(N6,N5,N4) -3366 FORMAT(A8,7I4,20E12.4) -C ENDIF - ELSE - FINHL(N6,N5,N4)=0.0 - FINHM(M,N6,N5,N4)=0.0 - ENDIF -C -C MACROPORE FLOW FROM POISEUILLE FLOW IF MACROPORES PRESENT -C - IF(VOLAH1(N3,N2,N1).GT.ZEROS(N2,N1) - 2.AND.VOLAH1(N6,N5,N4).GT.ZEROS(N5,N4).AND.IFLGH.EQ.0)THEN - PSISH1=PSISH(N3,N2,N1)+0.0098*DLYR(3,N3,N2,N1) - 2*(AMIN1(1.0,AMAX1(0.0,VOLWH1(N3,N2,N1)/VOLAH1(N3,N2,N1)))-0.5) - PSISHL=PSISH(N6,N5,N4)+0.0098*DLYR(3,N6,N5,N4) - 2*(AMIN1(1.0,AMAX1(0.0,VOLWH1(N6,N5,N4)/VOLAH1(N6,N5,N4)))-0.5) - FLWHX=AVCNHL(N,N6,N5,N4)*(PSISH1-PSISHL)*AREA(N,N3,N2,N1) -C -C MACROPORE FLOW IF GRAVITATIONAL GRADIENT IS POSITIVE -C AND MACROPORE POROSITY EXISTS IN ADJACENT CELL -C - IF(N.NE.3)THEN - IF(PSISH1.GT.PSISHL)THEN - FLWHL(N,N6,N5,N4)=AMAX1(0.0,AMIN1(AMIN1(VOLWH1(N3,N2,N1) - 2,VOLPH1(N6,N5,N4))*0.5*XDIM,FLWHX)) - ELSEIF(PSISH1.LT.PSISHL)THEN - FLWHL(N,N6,N5,N4)=AMIN1(0.0,AMAX1(AMAX1(-VOLWH1(N6,N5,N4) - 2,-VOLPH1(N3,N2,N1))*0.5*XDIM,FLWHX)) - ELSE - FLWHL(N,N6,N5,N4)=0.0 - ENDIF - ELSE - FLWHL(N,N6,N5,N4)=AMAX1(0.0,AMIN1(AMIN1(VOLWH1(N3,N2,N1) - 2+FLWHL(N,N3,N2,N1)-FINHL(N3,N2,N1) - 3,VOLPH1(N6,N5,N4))*XDIM,FLWHX)) - ENDIF - FLWHM(M,N,N6,N5,N4)=FLWHL(N,N6,N5,N4) -C IF(N4.EQ.1)THEN -C WRITE(*,5478)'FLWH',I,J,M,N1,N2,N3,IFLGH -C 2,FINHL(N3,N2,N1),FLHM,FLWHX,FLWHL(N,N3,N2,N1),FLWHL(N,N6,N5,N4) -C 2,AVCNHL(N,N6,N5,N4),PSISH(N3,N2,N1),PSISH(N6,N5,N4) -C 3,VOLPH1(N3,N2,N1),VOLPH1(N6,N5,N4),VOLWH1(N3,N2,N1) -C 4,VOLWH1(N6,N5,N4),VOLAH1(N3,N2,N1),VOLAH1(N6,N5,N4) -C 5,DLYR(N,N6,N5,N4),DLYR(N,N3,N2,N1),AREA(N,N3,N2,N1) -C 7,CNDH1(N3,N2,N1),CNDH1(N6,N5,N4),XNPH,XDIM,HWFLHL -5478 FORMAT(A8,7I4,30E12.4) -C ENDIF - ELSE - FLWHL(N,N6,N5,N4)=0.0 - FLWHM(M,N,N6,N5,N4)=0.0 - IF(VOLPH1(N6,N5,N4).LE.0.0)IFLGH=1 - ENDIF -C -C CONVECTIVE HEAT FLOW FROM MACROPORE FLOW -C - IF(FLWHL(N,N6,N5,N4).GT.0.0)THEN - HWFLHL=4.19*TK1(N3,N2,N1)*FLWHL(N,N6,N5,N4) - ELSE - HWFLHL=4.19*TK1(N6,N5,N4)*FLWHL(N,N6,N5,N4) - ENDIF -C -C VAPOR PRESSURE AND DIFFUSIVITY IN EACH GRID CELL -C - TK11=TK1(N3,N2,N1) - TK12=TK1(N6,N5,N4) - VP1=2.173E-03/TK11 - 2*0.61*EXP(5360.0*(3.661E-03-1.0/TK11)) - 3*EXP(18.0*PSISV1/(8.3143*TK11)) - VPL=2.173E-03/TK12 - 2*0.61*EXP(5360.0*(3.661E-03-1.0/TK12)) - 3*EXP(18.0*PSISVL/(8.3143*TK12)) - CNV1=THETP1**2/POROQ(N3,N2,N1)*WGSG1(N3,N2,N1) - CNVL=THETPL**2/POROQ(N6,N5,N4)*WGSG1(N6,N5,N4) - IF(CNV1.GT.ZERO.AND.CNVL.GT.ZERO)THEN - AVCNVL=2.0*CNV1*CNVL - 2/(CNV1*DLYR(N,N6,N5,N4)+CNVL*DLYR(N,N3,N2,N1)) - ELSE - AVCNVL=0.0 - ENDIF -C -C VAPOR FLUX FROM VAPOR PRESSURE AND DIFFUSIVITY, -C AND CONVECTIVE HEAT FLUX FROM VAPOR FLUX -C - TKY=(VHCP1(N3,N2,N1)*TK1(N3,N2,N1)+VHCP1(N6,N5,N4)*TK1(N6,N5,N4)) - 2/(VHCP1(N3,N2,N1)+VHCP1(N6,N5,N4)) - HFLWX=(TKY-TK1(N6,N5,N4))*VHCP1(N6,N5,N4)*FHFLX*XDIM - FLVX=AVCNVL*(VP1-VPL)*AREA(N,N3,N2,N1) - IF(FLVX.GE.0.0)THEN - FLVL=AMIN1(FLVX,VOLW1(N3,N2,N1)*XNPH) - IF(HFLWX.GE.0.0)THEN - FLVL=AMIN1(FLVL,HFLWX/(4.19*TK1(N3,N2,N1)+VAP)) - ENDIF - HWFLVL=(4.19*TK1(N3,N2,N1)+VAP)*FLVL - ELSE - FLVL=AMAX1(FLVX,-VOLW1(N6,N5,N4)*XNPH) - IF(HFLWX.LT.0.0)THEN - FLVL=AMAX1(FLVL,HFLWX/(4.19*TK1(N6,N5,N4)+VAP)) - ENDIF - HWFLVL=(4.19*TK1(N6,N5,N4)+VAP)*FLVL - ENDIF - 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 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 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 ENDIF -C -C THERMAL CONDUCTIVITY -C - DTKX=ABS(TK1(N3,N2,N1)-TK1(N6,N5,N4))*1.0E-06 - DTHW1=AMAX1(0.0,THETWX(N3,N2,N1)-TRBW)**3 - DTHA1=AMAX1(0.0,THETPX(N3,N2,N1)-TRBA)**3 - DTHW2=AMAX1(0.0,THETWX(N6,N5,N4)-TRBW)**3 - DTHA2=AMAX1(0.0,THETPX(N6,N5,N4)-TRBA)**3 - RYLXW1=DTKX*DTHW1 - RYLXA1=DTKX*DTHA1 - RYLXW2=DTKX*DTHW2 - RYLXA2=DTKX*DTHA2 - RYLNW1=AMIN1(1.0E+04,RYLXW*RYLXW1) - RYLNA1=AMIN1(1.0E+04,RYLXA*RYLXA1) - RYLNW2=AMIN1(1.0E+04,RYLXW*RYLXW2) - RYLNA2=AMIN1(1.0E+04,RYLXA*RYLXA2) - XNUSW1=AMAX1(1.0,0.68+0.67*RYLNW1**0.25/DNUSW) - XNUSA1=AMAX1(1.0,0.68+0.67*RYLNA1**0.25/DNUSA) - XNUSW2=AMAX1(1.0,0.68+0.67*RYLNW2**0.25/DNUSW) - XNUSA2=AMAX1(1.0,0.68+0.67*RYLNA2**0.25/DNUSA) - TCNDW1=2.067E-03*XNUSW1 - TCNDA1=9.050E-05*XNUSA1 - TCNDW2=2.067E-03*XNUSW2 - TCNDA2=9.050E-05*XNUSA2 - WTHET1=1.467-0.467*THETPY(N3,N2,N1) - TCND1=(STC(N3,N2,N1)+THETWX(N3,N2,N1)*TCNDW1 - 2+0.611*THETIX(N3,N2,N1)*7.844E-03 - 3+WTHET1*THETPX(N3,N2,N1)*TCNDA1) - 4/(DTC(N3,N2,N1)+THETWX(N3,N2,N1)+0.611*THETIX(N3,N2,N1) - 5+WTHET1*THETPX(N3,N2,N1)) - WTHET2=1.467-0.467*THETPY(N6,N5,N4) - TCND2=(STC(N6,N5,N4)+THETWX(N6,N5,N4)*TCNDW2 - 2+0.611*THETIX(N6,N5,N4)*7.844E-03 - 3+WTHET2*THETPX(N6,N5,N4)*TCNDA2) - 4/(DTC(N6,N5,N4)+THETWX(N6,N5,N4)+0.611*THETIX(N6,N5,N4) - 5+WTHET2*THETPX(N6,N5,N4)) - ATCND1=(2.0*TCND1*TCND2)/(TCND1*DLYR(N,N6,N5,N4) - 3+TCND2*DLYR(N,N3,N2,N1))*XNPH -C -C HEAT FLOW FROM THERMAL CONDUCTIVITY AND TEMPERATURE GRADIENT -C - TK1X=TK1(N3,N2,N1)-HWFLVL/VHCP1(N3,N2,N1) - TKLX=TK1(N6,N5,N4)+HWFLVL/VHCP1(N6,N5,N4) - TKY=(VHCP1(N3,N2,N1)*TK1X+VHCP1(N6,N5,N4)*TKLX) - 2/(VHCP1(N3,N2,N1)+VHCP1(N6,N5,N4)) - HFLWX=(TKY-TKLX)*VHCP1(N6,N5,N4)*FHFLX*XDIM - HFLWC=ATCND1*(TK1X-TKLX)*AREA(N,N3,N2,N1) - IF(HFLWC.GE.0.0)THEN - HFLWC=AMAX1(0.0,AMIN1(HFLWC,HFLWX)) - ELSE - HFLWC=AMIN1(0.0,AMAX1(HFLWC,HFLWX)) - ENDIF - HFLWL(N,N6,N5,N4)=HWFLWL+HWFLHL+HFLWC -C IF((I/10)*10.EQ.I.AND.N5.EQ.2.AND.J.EQ.15.AND.N.EQ.3)THEN -C WRITE(*,8765)'HFLWL',I,J,N4,N5,N6,N,M,HFLWL(N,N6,N5,N4) -C 2,TCND1,TCND2,ATCND1,DTKX,DTHP1,DTHP2,THETPX(N3,N2,N1) -C 3,THETPX(N6,N5,N4),RYLNA1,RYLNA2,DNUSA,XNUSA1,XNUSA2 -C 4,TCNDA1,TCNDA2,RYLNW1,RYLNW2,DNUSW,XNUSW1,XNUSW2 -C 5,TCNDW1,TCNDW2 -8765 FORMAT(A8,7I4,60E12.4) -C ENDIF -C -C MOVE WATER UP DURING PRECIPITATION OR FREEZING -C - IF(N.EQ.3)THEN - IF(VOLW1(N6,N5,N4)+VOLI1(N6,N5,N4).GT.VOLA(N6,N5,N4))THEN - FLWLY=AMIN1(0.0,AMAX1(-XNPH*VOLW1(N6,N5,N4) - 2,VOLA(N6,N5,N4)-VOLW1(N6,N5,N4)-VOLI1(N6,N5,N4))) - FLWLY=AMAX1(FLWLY,-VOLP1(N3,N2,N1)) - HFLWLY=FLWLY*4.19*TK1(N6,N5,N4) - FLWL(N,N6,N5,N4)=FLWL(N,N6,N5,N4)+FLWLY - HFLWL(N,N6,N5,N4)=HFLWL(N,N6,N5,N4)+HFLWLY - ENDIF - IF(VOLWH1(N6,N5,N4)+VOLIH1(N6,N5,N4).GT.VOLAH1(N6,N5,N4))THEN - FLWHY=AMIN1(0.0,AMAX1(-XNPH*VOLWH1(N6,N5,N4),-VOLPH1(N3,N2,N1) - 2,VOLAH1(N6,N5,N4)-VOLWH1(N6,N5,N4)-VOLIH1(N6,N5,N4))) - HFLWHY=FLWHY*4.19*TK1(N6,N5,N4) - FLWHL(N,N6,N5,N4)=FLWHL(N,N6,N5,N4)+FLWHY - HFLWL(N,N6,N5,N4)=HFLWL(N,N6,N5,N4)+HFLWHY - ENDIF - IF(PSISAL.GT.PSISA(N6,N5,N4))THEN - FLWVL(N6,N5,N4)=VOLW1(N6,N5,N4)-VOLWX1(N6,N5,N4) - ELSE - FLWVL(N6,N5,N4)=RFLWV(N5,N4)*(VOLW1(N6,N5,N4)-VOLWX1(N6,N5,N4)) - ENDIF - FLWV(N6,N5,N4)=FLWV(N6,N5,N4)+FLWVL(N6,N5,N4) - ENDIF -C -C FREEZE-THAW IN SOIL LAYER MICROPORE FROM NET CHANGE IN SOIL -C LAYER HEAT STORAGE -C - IF(N.EQ.3)THEN - TFREEZ=-9.0959E+04/(PSISVL-333.0) - IF((TK1(N6,N5,N4).LT.TFREEZ - 2.AND.VOLW1(N6,N5,N4).GT.ZERO*VOLA(N6,N5,N4) - 3.AND.VOLI1(N6,N5,N4).LT.VOLA(N6,N5,N4)) - 4.OR.(TK1(N6,N5,N4).GT.TFREEZ - 5.AND.VOLI1(N6,N5,N4).GT.ZERO*VOLT(N6,N5,N4)))THEN - TFLX1=FGRD(N6,N5,N4)*(1.0/(1.0+TFREEZ*6.2913E-03) - 2*(TFREEZ*4.19*(FLWL(N,N6,N5,N4)+FLWHL(N,N6,N5,N4)) - 2+VHCP1(N6,N5,N4)*(TFREEZ-TK1(N6,N5,N4)) - 3-HFLWL(N,N6,N5,N4))) - IF(TFLX1.LT.0.0)THEN - TFLX=AMAX1(-333.0*0.92*VOLI1(N6,N5,N4)*XNPH,TFLX1) - ELSE - TFLX=AMIN1(333.0*VOLW1(N6,N5,N4)*XNPH,TFLX1) - ENDIF - WFLX=-TFLX/333.0 - IF(WFLX.GT.0.0.AND.VOLI1(N6,N5,N4).GT.ZEROS(N5,N4))THEN - WFLXL(N,N6,N5,N4)=WFLX - ELSEIF(WFLX.LT.0.0.AND.VOLW1(N6,N5,N4).GT.ZEROS(N5,N4))THEN - WFLXL(N,N6,N5,N4)=WFLX - ELSE - TFLX=0.0 - WFLXL(N,N6,N5,N4)=0.0 - ENDIF - ELSE - TFLX=0.0 - WFLXL(N,N6,N5,N4)=0.0 - ENDIF -C -C FREEZE-THAW IN SOIL LAYER MACROPORE FROM NET CHANGE IN SOIL -C LAYER HEAT STORAGE -C - IF((TK1(N6,N5,N4).LT.273.15.AND.VOLWH1(N6,N5,N4) - 2.GT.ZERO*VOLT(N6,N5,N4)).OR.(TK1(N6,N5,N4).GT.273.15 - 3.AND.VOLIH1(N6,N5,N4).GT.ZERO*VOLT(N6,N5,N4)))THEN - TFLX1=FMAC(N6,N5,N4)*(1.0/(1.0+273.15*6.2913E-03) - 2*(273.15*4.19*(FLWL(N,N6,N5,N4)+FLWHL(N,N6,N5,N4)) - 2+VHCP1(N6,N5,N4)*(273.15-TK1(N6,N5,N4)) - 3-HFLWL(N,N6,N5,N4))) - IF(TFLX1.LT.0.0)THEN - TFLXH=AMAX1(-333.0*0.92*VOLIH1(N6,N5,N4)*XNPH,TFLX1) - ELSE - TFLXH=AMIN1(333.0*VOLWH1(N6,N5,N4)*XNPH,TFLX1) - ENDIF - WFLXH=-TFLXH/333.0 - IF(WFLXH.GT.0.0.AND.VOLIH1(N6,N5,N4).GT.ZEROS(N5,N4))THEN - WFLXLH(N,N6,N5,N4)=WFLXH - ELSEIF(WFLXH.LT.0.0.AND.VOLWH1(N6,N5,N4).GT.ZEROS(N5,N4))THEN - WFLXLH(N,N6,N5,N4)=WFLXH - ELSE - TFLXH=0.0 - WFLXLH(N,N6,N5,N4)=0.0 - ENDIF - ELSE - TFLXH=0.0 - WFLXLH(N,N6,N5,N4)=0.0 - ENDIF - TFLXL(N,N6,N5,N4)=TFLX+TFLXH -C IF(NY.EQ.1)THEN -C WRITE(*,4359)'TFLX',I,J,M,N4,N5,N6,TFREEZ,TK1(N6,N5,N4),PSISVL -C 2,TFLX,TFLXH,TFLXL(N,N6,N5,N4),WFLX,WFLXH -C 2,WFLXL(N,N6,N5,N4),WFLXLH(N,N6,N5,N4) -C 4,VOLW1(N6,N5,N4),VOLWH1(N6,N5,N4) -C 4,VOLI1(N6,N5,N4),VOLIH1(N6,N5,N4) -C 5,FGRD(N6,N5,N4),FMAC(N6,N5,N4) -4359 FORMAT(A8,6I4,20E12.4) -C ENDIF - ENDIF -C -C TOTAL WATER, VAPOR AND HEAT FLUXES -C - THAW(N,N6,N5,N4)=THAW(N,N6,N5,N4)+WFLXL(N,N6,N5,N4) - THAWH(N,N6,N5,N4)=THAWH(N,N6,N5,N4)+WFLXLH(N,N6,N5,N4) - HTHAW(N,N6,N5,N4)=HTHAW(N,N6,N5,N4)+TFLXL(N,N6,N5,N4) - FLW(N,N6,N5,N4)=FLW(N,N6,N5,N4)+FLWL(N,N6,N5,N4) - FLWX(N,N6,N5,N4)=FLWX(N,N6,N5,N4)+FLWLX(N,N6,N5,N4) - FLWH(N,N6,N5,N4)=FLWH(N,N6,N5,N4)+FLWHL(N,N6,N5,N4) - HFLW(N,N6,N5,N4)=HFLW(N,N6,N5,N4)+HFLWL(N,N6,N5,N4) - FLWM(M,N,N6,N5,N4)=FLWL(N,N6,N5,N4) - IF(N.EQ.3)THEN - HYSM(M,N6,N5,N4)=HYST(N6,N5,N4) - IF(PSISA1.GT.PSISA(N3,N2,N1).AND.VOLPX1(N6,N5,N4).GT.ZEROS(N5,N4) - 2.AND.HYST(N6,N5,N4).GT.ZERO)THEN - HYST(N6,N5,N4)=AMIN1(1.0,AMAX1(0.0,HYST(N6,N5,N4) - 2-FLWL(N,N6,N5,N4)/VOLPX1(N6,N5,N4))) - ENDIF -C -C WATER FILM THICKNESS FOR CALCULATING GAS EXCHANGE IN 'TRNSFR' -C -C IF(BKVL(N6,N5,N4).GT.0.0)THEN - FILM(M,N6,N5,N4)=AMAX1(1.0E-06 - 2,EXP(-13.833-0.857*LOG(-PSISM1(N6,N5,N4)))) -C ELSE -C FILM(M,N6,N5,N4)=DLYR(3,N6,N5,N4) -C ENDIF - HYST(N6,N5,N4)=HYST(N6,N5,N4)+(1.0-HYST(N6,N5,N4))*HYSTX - ENDIF - ELSEIF(N.NE.3)THEN - FLWL(N,N6,N5,N4)=0.0 - FLWLX(N,N6,N5,N4)=0.0 - FLWHL(N,N6,N5,N4)=0.0 - HFLWL(N,N6,N5,N4)=0.0 - FLWHM(M,N,N6,N5,N4)=0.0 - ENDIF -4320 CONTINUE -4400 CONTINUE -9890 CONTINUE -9895 CONTINUE -C -C BOUNDARY WATER AND HEAT FLUXES -C - DO 9595 NX=NHW,NHE - DO 9590 NY=NVN,NVS - DO 9585 L=NU(NY,NX),NL(NY,NX) - TVOLZ1=TVOL1(NY,NX) - VOLWZ1=TVOLW(NY,NX) - VOLP2=VOLP1(L,NY,NX) - VOLPX2=VOLPX1(L,NY,NX) - VOLPH2=VOLPH1(L,NY,NX) -C -C IDENTIFY CONDITIONS FOR MICROPORE DISCHARGE TO WATER TABLE -C - IF(IPRC(NY,NX).NE.0.AND.DPTH(L,NY,NX).LT.DTBLX(NY,NX))THEN - IF(PSISM1(L,NY,NX).GE.PSISE(L,NY,NX) - 2+0.0098*(DPTH(L,NY,NX)-DTBLX(NY,NX)))THEN - IFLGU=0 - DO 9565 LL=MIN(L+1,NL(NY,NX)),NL(NY,NX) - IF(DPTH(LL,NY,NX).LT.DTBLX(NY,NX))THEN - IF((PSISM1(LL,NY,NX).LT.PSISA(LL,NY,NX).AND.L.NE.NL(NY,NX)) - 2.OR.DPTH(LL,NY,NX).GT.DPTHA(NY,NX))THEN - IFLGU=1 - ENDIF - ENDIF -9565 CONTINUE - ELSE - IFLGU=1 - ENDIF - ELSE - IFLGU=1 - ENDIF -C -C IDENTIFY CONDITIONS FOR MACROPORE DISCHARGE TO WATER TABLE -C - IF(VOLAH1(L,NY,NX).GT.ZEROS(NY,NX))THEN - DPTHH=CDPTH(L,NY,NX)-(VOLWH1(L,NY,NX)+VOLIH1(L,NY,NX)) - 2/VOLAH1(L,NY,NX)*DLYR(3,L,NY,NX) - ELSE - DPTHH=CDPTH(L,NY,NX) - ENDIF - IF(IPRC(NY,NX).NE.0.AND.DPTHH.LT.DTBLX(NY,NX) - 2.AND.VOLWH1(L,NY,NX).GT.ZEROS(NY,NX))THEN - IFLGUH=0 - DO 9566 LL=MIN(L+1,NL(NY,NX)),NL(NY,NX) - IF(DPTH(LL,NY,NX).LT.DTBLX(NY,NX))THEN - IF(VOLAH1(LL,NY,NX).LE.ZEROS(NY,NX))THEN - IFLGUH=1 - ENDIF - ENDIF -9566 CONTINUE - ELSE - IFLGUH=1 - ENDIF -C IF((I/30)*30.EQ.I.AND.M.EQ.1)THEN -C WRITE(*,9567)'IFLGU',I,J,M,NX,NY,L,IFLGU,IFLGUH,PSISM1(L,NY,NX) -C 2,PSISE(L,NY,NX),DPTH(L,NY,NX),DTBLX(NY,NX),PSISE(L,NY,NX) -C 2+0.0098*(DPTH(L,NY,NX)-DTBLX(NY,NX)),THETX -C 3,VOLAH1(L,NY,NX),VOLWH1(L,NY,NX),VOLIH1(L,NY,NX),CDPTH(L,NY,NX) -C 4,DLYR(3,L,NY,NX),DTBLZ(NY,NX),DPTHH -9567 FORMAT(A8,8I4,20E12.4) -C ENDIF -C -C LOCATE ALL EXTERNAL BOUNDARIES AND SET BOUNDARY CONDITIONS -C ENTERED IN 'READS' -C - N1=NX - N2=NY - N3=L - DO 9580 N=1,3 - DO 9575 NN=1,2 - IF(N.EQ.1)THEN - N4=NX+1 - N5=NY - N6=L - WDTH=DLYR(2,NU(NY,NX),NY,NX) - IF(NN.EQ.1)THEN - IF(NX.EQ.NHE)THEN - M1=NX - M2=NY - M3=L - M4=NX+1 - M5=NY - M6=L - XN=-1.0 - RCHQF=RCHQE(M2,M1) - RCHGFU=RCHGEU(M2,M1) - RCHGFT=RCHGET(M2,M1) - ELSE - GO TO 9575 - ENDIF - ELSEIF(NN.EQ.2)THEN - IF(NX.EQ.NHW)THEN - M1=NX+1 - M2=NY - M3=L - M4=NX - M5=NY - M6=L - XN=1.0 - RCHQF=RCHQW(M5,M4) - RCHGFU=RCHGWU(M5,M4) - RCHGFT=RCHGWT(M5,M4) - ELSE - GO TO 9575 - ENDIF - ENDIF - ELSEIF(N.EQ.2)THEN - N4=NX - N5=NY+1 - N6=L - WDTH=DLYR(1,NU(NY,NX),NY,NX) - IF(NN.EQ.1)THEN - IF(NY.EQ.NVS)THEN - M1=NX - M2=NY - M3=L - M4=NX - M5=NY+1 - M6=L - XN=-1.0 - RCHQF=RCHQS(M2,M1) - RCHGFU=RCHGSU(M2,M1) - RCHGFT=RCHGST(M2,M1) - ELSE - GO TO 9575 - ENDIF - ELSEIF(NN.EQ.2)THEN - IF(NY.EQ.NVN)THEN - M1=NX - M2=NY+1 - M3=L - M4=NX - M5=NY - M6=L - XN=1.0 - RCHQF=RCHQN(M5,M4) - RCHGFU=RCHGNU(M5,M4) - RCHGFT=RCHGNT(M5,M4) - ELSE - GO TO 9575 - ENDIF - ENDIF - ELSEIF(N.EQ.3)THEN - N4=NX - N5=NY - N6=L+1 - IF(NN.EQ.1)THEN - IF(L.EQ.NL(NY,NX))THEN - M1=NX - M2=NY - M3=L - M4=NX - M5=NY - M6=L+1 - XN=-1.0 - RCHGFU=RCHGD(M2,M1) - RCHGFT=1.0 - ELSE - GO TO 9575 - ENDIF - ELSEIF(NN.EQ.2)THEN - GO TO 9575 - ENDIF - ENDIF -C -C BOUNDARY SURFACE RUNOFF DEPENDING ON ASPECT, SLOPE -C VELOCITY, HYDRAULIC RADIUS AND SURFACE WATER STORAGE -C - IF(L.EQ.NU(N2,N1).AND.N.NE.3)THEN - IF(IRCHG(NN,N,N2,N1).EQ.0.OR.RCHQF.EQ.0.0)THEN - V=0.0 - QR1(N,M5,M4)=0.0 - HQR1(N,M5,M4)=0.0 - ELSE -C -C RUNOFF -C - ALT1=ALTG(N2,N1)+TVOLZ1/AREA(3,NU(N2,N1),N2,N1) - ALT2=ALTG(N2,N1)+VOLWG(N2,N1)/AREA(3,NU(N2,N1),N2,N1) - 2-GSIN(N2,N1)*DLYR(N,NU(N2,N1),N2,N1) - IF(ALT1.GT.ALT2.AND.TVOLZ1.GT.VOLWG(N2,N1))THEN - QRX1=TVOLZ1-VOLWG(N2,N1) - D=QRX1/AREA(3,0,N2,N1) - R=D/2.828 - S=(ALT1-ALT2)/DLYR(N,NU(N2,N1),N2,N1) - V=R**0.67*SQRT(S)/ZM(N2,N1) - Q=V*D*AMIN1(1.0,D/ZS(N2,N1))*WDTH*3.6E+03*XNPH*RCHQF - QR1(N,M5,M4)=-XN*AMIN1(Q,0.25*QRX1)*VOLWZ1/TVOLZ1*RCHQF - HQR1(N,M5,M4)=4.19*TK1(0,N2,N1)*QR1(N,M5,M4) - VOLWZ1=VOLWZ1+XN*QR1(N,M5,M4) - TVOLZ1=TVOLZ1+XN*QR1(N,M5,M4) - ELSEIF(DTBLX(N2,N1).LT.0.0)THEN -C -C RUNON -C - QRX1=AMIN1(0.0,DTBLX(N2,N1)+TVOLZ1/AREA(3,NU(N2,N1),N2,N1)) - 2*AREA(3,NU(N2,N1),N2,N1) - QR1(N,M5,M4)=-XN*0.25*QRX1*RCHQF - HQR1(N,M5,M4)=4.19*TK1(0,N2,N1)*QR1(N,M5,M4) - VOLWZ1=VOLWZ1+XN*QR1(N,M5,M4) - TVOLZ1=TVOLZ1+XN*QR1(N,M5,M4) - ELSE - V=0.0 - QR1(N,M5,M4)=0.0 - HQR1(N,M5,M4)=0.0 - ENDIF - QR(N,M5,M4)=QR(N,M5,M4)+QR1(N,M5,M4) - HQR(N,M5,M4)=HQR(N,M5,M4)+HQR1(N,M5,M4) - QRM(M,N,M5,M4)=QR1(N,M5,M4) - QRV(M,N,M5,M4)=V - QS1(N,M5,M4)=0.0 - QW1(N,M5,M4)=0.0 - QI1(N,M5,M4)=0.0 - HQS1(N,M5,M4)=0.0 - QS(N,M5,M4)=QS(N,M5,M4)+QS1(N,M5,M4) - QW(N,M5,M4)=QW(N,M5,M4)+QW1(N,M5,M4) - QI(N,M5,M4)=QI(N,M5,M4)+QI1(N,M5,M4) - HQS(N,M5,M4)=HQS(N,M5,M4)+HQS1(N,M5,M4) - QSM(M,N,M5,M4)=QS1(N,M5,M4) -C IF((I/10)*10.EQ.I.AND.M.EQ.NPH)THEN -C WRITE(*,7744)'QRB',I,J,M,N1,N2,N3,M4,M5,M6,N,NN,IRCHG(NN,N,N2,N1) -C 2,QR(N,M5,M4),QR1(N,M5,M4),Q,QRX1,V,S,D,ALT1,ALT2,ZM(N2,N1) -C 3,ZS(N2,N1),VOLWZ1,TVOLZ1,RCHQF,VOLWG(N2,N1),VOLW1(0,N2,N1) -C 4,VOLI1(0,N2,N1),TVOLW(N2,N1),FVOLW1,FVOLH1,PSISM1(0,N2,N1) -C 7,VOLWRX(N2,N1),FLWL(3,0,N2,N1),FLWRL(N2,N1) -7744 FORMAT(A8,12I4,30E12.4) -C ENDIF - ENDIF - ENDIF -C -C BOUNDARY SUBSURFACE WATER AND HEAT TRANSFER DEPENDING -C ON LEVEL OF WATER TABLE -C - IF(NCN(N2,N1).NE.3.OR.N.EQ.3)THEN -C -C IF NO WATER TABLE -C - IF(IPRC(N2,N1).EQ.0.OR.N.EQ.3)THEN - THETA1=AMAX1(THETY(N3,N2,N1),AMIN1(POROS(N3,N2,N1) - 2,VOLW1(N3,N2,N1)/VOLX(N3,N2,N1))) - THETAX=AMAX1(THETY(N3,N2,N1),AMIN1(POROS(N3,N2,N1) - 2,VOLWX1(N3,N2,N1)/VOLX(N3,N2,N1))) - K1=MIN(100,INT(100.0*(POROS(N3,N2,N1) - 2-THETA1)/POROS(N3,N2,N1))+1) - KX=MIN(100,INT(100.0*(POROS(N3,N2,N1) - 2-THETAX)/POROS(N3,N2,N1))+1) - CND1=HCND(N,K1,N3,N2,N1)*XNPH - CNDX=HCND(N,KX,N3,N2,N1)*XNPH - FLWL(N,M6,M5,M4)=AMIN1(VOLW1(N3,N2,N1)*XNPH - 2,XN*0.0098*-ABS(SLOPE(N,N2,N1))*CND1*AREA(3,N3,N2,N1)) - 3*RCHGFU*RCHGFT - FLWLX(N,M6,M5,M4)=AMIN1(VOLWX1(N3,N2,N1)*XNPH - 2,XN*0.0098*-ABS(SLOPE(N,N2,N1))*CNDX*AREA(3,N3,N2,N1)) - 3*RCHGFU*RCHGFT - FLWHL(N,M6,M5,M4)=AMIN1(VOLWH1(L,NY,NX) - 2,XN*0.0098*-ABS(SLOPE(N,N2,N1))*CNDH1(L,NY,NX)*AREA(3,N3,N2,N1)) - 3*RCHGFU*RCHGFT - HFLWL(N,M6,M5,M4)=4.19*TK1(N3,N2,N1) - 2*(FLWL(N,M6,M5,M4)+FLWHL(N,M6,M5,M4)) -C IF(J.EQ.12.AND.M.EQ.1)THEN -C WRITE(*,4443)'ABV',I,J,M,N,NN,M4,M5,M6,XN,FLWL(N,M6,M5,M4) -C 2,VOLP2,RCHGFU,VOLX(N3,N2,N1),VOLW1(N3,N2,N1) -C 3,VOLWH1(N3,N2,N1),VOLPH1(N3,N2,N1),VOLPH2,VOLI1(N3,N2,N1) -C 4,VOLIH1(N3,N2,N1),VOLP1(N3,N2,N1),HFLWL(N,M6,M5,M4) -C 5,PSISM1(N3,N2,N1),PSISE(N3,N2,N1),FLWHL(N,M6,M5,M4),DDRG(N2,N1) -C 6,SLOPE(N,N2,N1) -4443 FORMAT(A8,8I4,30E12.4) -C ENDIF - ELSE -C -C MICROPORE DISCHARGE ABOVE WATER TABLE -C - IF(IFLGU.EQ.0.AND.RCHGFT.NE.0.0)THEN - PSISWD=XN*0.005*SLOPE(N,N2,N1)*DLYR(N,N3,N2,N1) - 2*(1.0-DTBLG(N2,N1)) - PSISWT=AMIN1(0.0,PSISE(N3,N2,N1)-PSISM1(N3,N2,N1) - 2+0.0098*(DPTH(N3,N2,N1)-DTBLX(N2,N1)) - 3-0.0098*AMAX1(0.0,DPTH(N3,N2,N1)-DPTHT(N2,N1))) - IF(PSISWT.LT.0.0)PSISWT=PSISWT-PSISWD - FLWT=PSISWT*HCND(N,1,N3,N2,N1)*XNPH*AREA(N,N3,N2,N1) - 2*(1.0-AREAU(N3,N2,N1))/(RCHGFU+1.0)*RCHGFT - FLWL(N,M6,M5,M4)=XN*FLWT - FLWLX(N,M6,M5,M4)=XN*FLWT - HFLWL(N,M6,M5,M4)=4.19*TK1(N3,N2,N1)*XN*FLWT -C WRITE(*,4445)'DISCHMI',I,J,M,N1,N2,N3,M4,M5,M6,N,NN,XN -C 2,FLWL(N,M6,M5,M4),FLWT,PSISWT,HCND(N,1,N3,N2,N1) -C 3,AREA(N,N3,N2,N1),AREAU(N3,N2,N1),RCHGFU,RCHGFT -4445 FORMAT(A8,11I4,30E12.4) - ELSE - FLWL(N,M6,M5,M4)=0.0 - FLWLX(N,M6,M5,M4)=0.0 - HFLWL(N,M6,M5,M4)=0.0 - ENDIF -C -C MACROPORE DISCHARGE ABOVE WATER TABLE -C - IF(IFLGUH.EQ.0.AND.RCHGFT.NE.0.0)THEN - PSISWD=XN*0.005*SLOPE(N,N2,N1)*DLYR(N,N3,N2,N1) - 2*(1.0-DTBLG(N2,N1)) - PSISWTH=0.0098*(DPTHH-DTBLX(N2,N1)) - 2-0.0098*AMAX1(0.0,DPTHH-DPTHT(N2,N1)) - IF(PSISWTH.LT.0.0)PSISWTH=PSISWTH-PSISWD - FLWTH=PSISWTH*CNDH1(N3,N2,N1)*AREA(N,N3,N2,N1) - 2*(1.0-AREAU(N3,N2,N1))/(RCHGFU+1.0)*RCHGFT - FLWTHL=AMAX1(FLWTH,AMIN1(0.0,-XNPH*(VOLWH1(N3,N2,N1) - 2+FLWHL(3,N3,N2,N1)-FLWHL(3,N3+1,N2,N1)-FINHL(N3,N2,N1)))) - FLWHL(N,M6,M5,M4)=XN*FLWTHL - HFLWL(N,M6,M5,M4)=HFLWL(N,M6,M5,M4)+4.19*TK1(N3,N2,N1)*XN*FLWTHL -C WRITE(*,4446)'DISCHMA',I,J,M,N1,N2,N3,M4,M5,M6,N,NN,XN -C 2,FLWHL(N,M6,M5,M4),FLWTHL,FLWTH,PSISWTH,CNDH1(N3,N2,N1) -C 3,DPTH(N3,N2,N1),DLYR(3,N3,N2,N1),DPTHH,VOLWH1(N3,N2,N1) -C 4,VOLIH1(L,NY,NX),VOLAH1(N3,N2,N1),DTBLX(N2,N1),PSISWD -4446 FORMAT(A8,11I4,30E12.4) - ELSE - FLWHL(N,M6,M5,M4)=0.0 - ENDIF -C -C MICROPORE RECHARGE BELOW WATER TABLE -C - IF(IPRC(N2,N1).NE.3.AND.DPTH(N3,N2,N1).GT.DTBLX(N2,N1) - 2.AND.DPTHA(N2,N1).GT.DTBLX(N2,N1) - 2.AND.(BKDS(N3,N2,N1).EQ.0.0.OR.VOLP2.GT.0.0))THEN - PSISWD=XN*0.005*SLOPE(N,N2,N1)*DLYR(N,N3,N2,N1) - 2*(1.0-DTBLG(N2,N1)) - PSISUT=AMAX1(0.0,PSISE(N3,N2,N1)-PSISM1(N3,N2,N1) - 2+0.0098*(DPTH(N3,N2,N1)-DTBLX(N2,N1))) - IF(PSISUT.GT.0.0)PSISUT=PSISUT+PSISWD - FLWU=PSISUT*HCND(N,1,N3,N2,N1)*XNPH*AREA(N,N3,N2,N1) - 2*AREAU(N3,N2,N1)/(RCHGFU+1.0)*RCHGFT - FLWUL=AMIN1(FLWU,AMAX1(0.0,VOLP2)) - FLWUX=AMIN1(FLWU,AMAX1(0.0,VOLPX2)) - FLWL(N,M6,M5,M4)=FLWL(N,M6,M5,M4)+XN*FLWUL - FLWLX(N,M6,M5,M4)=FLWLX(N,M6,M5,M4)+XN*FLWUX - HFLWL(N,M6,M5,M4)=HFLWL(N,M6,M5,M4)+4.19*TK1(N3,N2,N1) - 2*XN*FLWUL -C IF((I/30)*30.EQ.I.AND.J.EQ.15)THEN -C WRITE(*,4444)'RECHGMI',I,J,M,N1,N2,N3,M4,M5,M6,N,NN,IFLGU,XN -C 2,FLWL(N,M6,M5,M4),AREAU(N3,N2,N1),RCHGFT,VOLP2,FLWT -C 3,FLWU,FLWUL,PSISM1(N3,N2,N1),PSISA(N3,N2,N1) -C 4,PSISWT,PSISUT,PSISUTH,HCND(N,1,N3,N2,N1) -C 5,DTBLX(N2,N1),CDPTH(N3,N2,N1),DPTHT(N2,N1) -C 6,DDRG(N2,N1),DPTH(N3,N2,N1),VOLW1(N3,N2,N1),VOLI1(N3,N2,N1) -C 7,VOLX(N3,N2,N1),VOLP1(N3,N2,N1) -C 8,RCHGFU,AREA(N,N3,N2,N1) -C 9,FINHL(N3,N2,N1),DLYR(N,N3,N2,N1),DLYR(3,N3,N2,N1),PSISWD -C 1,SLOPE(N,N2,N1) -4444 FORMAT(A8,12I4,40E12.4) -C ENDIF - ENDIF -C -C MACROPORE RECHARGE BELOW WATER TABLE -C - IF(IPRC(N2,N1).NE.3.AND.DPTHH.GT.DTBLX(N2,N1) - 2.AND.DPTHA(N2,N1).GT.DTBLX(N2,N1) - 2.AND.VOLPH2.GT.0.0)THEN - PSISWD=XN*0.005*SLOPE(N,N2,N1)*DLYR(N,N3,N2,N1) - 2*(1.0-DTBLG(N2,N1)) - PSISUTH=0.0098*(DPTHH-DTBLX(N2,N1)) - IF(PSISUTH.GT.0.0)PSISUTH=PSISUTH+PSISWD - FLWUH=PSISUTH*CNDH1(N3,N2,N1)*AREA(N,N3,N2,N1) - 2*AREAU(N3,N2,N1)/(RCHGFU+1.0)*RCHGFT - FLWUHL=AMIN1(FLWUH,AMAX1(0.0,XNPH*(VOLPH2 - 2-FLWHL(3,N3,N2,N1)+FLWHL(3,N3+1,N2,N1)+FINHL(N3,N2,N1)))) - FLWHL(N,M6,M5,M4)=FLWHL(N,M6,M5,M4)+XN*FLWUHL - HFLWL(N,M6,M5,M4)=HFLWL(N,M6,M5,M4)+4.19*TK1(N3,N2,N1) - 2*XN*FLWUHL -C IF(I.GT.208.AND.J.EQ.21)THEN -C WRITE(*,4447)'RECHGMA',I,J,M,N1,N2,N3,M4,M5,M6,N,NN,IFLGU,XN -C 2,AREAU(N3,N2,N1),FLWUH,FLWUHL,DPTHH,PSISUTH,CNDH1(N3,N2,N1) -C 5,FLWHL(N,M6,M5,M4),DTBLX(N2,N1),CDPTH(N3,N2,N1),DPTHT(N2,N1) -C 6,DDRG(N2,N1),DPTH(N3,N2,N1),VOLWH1(N3,N2,N1),VOLPH1(N3,N2,N1) -C 8,FLWHL(3,N3,N2,N1),FLWHL(3,N3+1,N2,N1),RCHGFU,AREA(N,N3,N2,N1) -C 9,FINHL(N3,N2,N1),DLYR(N,N3,N2,N1),DLYR(3,N3,N2,N1),PSISWD -C 1,SLOPE(N,N2,N1) -4447 FORMAT(A8,12I4,40E12.4) -C ENDIF - ENDIF - ENDIF -C -C SUBSURFACE HEAT SOURCE/SINK -C - IF(N.EQ.3.AND.IETYP(N2,N1).NE.-2)THEN - HFLWL(N,M6,M5,M4)=HFLWL(N,M6,M5,M4)+(TK1(N3,N2,N1) - 2-TKSD(N2,N1))*TCNDG/(DPTHSK(N2,N1)-CDPTH(N3,N2,N1)) - 3*AREA(N,N3,N2,N1)*XNPH - ENDIF - VOLP2=VOLP2-XN*FLWL(N,M6,M5,M4) - VOLPX2=VOLPX2-XN*FLWLX(N,M6,M5,M4) - VOLPH2=VOLPH2-XN*FLWHL(N,M6,M5,M4) - FLWLD=0.0 - FLWLXD=0.0 - FLWHLD=0.0 - FLW(N,M6,M5,M4)=FLW(N,M6,M5,M4)+FLWL(N,M6,M5,M4) - FLWX(N,M6,M5,M4)=FLWX(N,M6,M5,M4)+FLWLX(N,M6,M5,M4) - FLWH(N,M6,M5,M4)=FLWH(N,M6,M5,M4)+FLWHL(N,M6,M5,M4) - HFLW(N,M6,M5,M4)=HFLW(N,M6,M5,M4)+HFLWL(N,M6,M5,M4) - FLWM(M,N,M6,M5,M4)=FLWL(N,M6,M5,M4) - FLWHM(M,N,M6,M5,M4)=FLWHL(N,M6,M5,M4) - ENDIF -9575 CONTINUE -C -C TOTAL WATER AND HEAT FLUXES IN EACH GRID CELL -C - IF(L.EQ.NU(N2,N1).AND.N.NE.3)THEN - TQR1(N2,N1)=TQR1(N2,N1)+QR1(N,N2,N1)-QR1(N,N5,N4) - THQR1(N2,N1)=THQR1(N2,N1)+HQR1(N,N2,N1)-HQR1(N,N5,N4) - TQS1(N2,N1)=TQS1(N2,N1)+QS1(N,N2,N1)-QS1(N,N5,N4) - TQW1(N2,N1)=TQW1(N2,N1)+QW1(N,N2,N1)-QW1(N,N5,N4) - TQI1(N2,N1)=TQI1(N2,N1)+QI1(N,N2,N1)-QI1(N,N5,N4) - THQS1(N2,N1)=THQS1(N2,N1)+HQS1(N,N2,N1)-HQS1(N,N5,N4) - ENDIF - IF(NCN(N2,N1).NE.3.OR.N.EQ.3)THEN - TFLWL(N3,N2,N1)=TFLWL(N3,N2,N1)+FLWL(N,N3,N2,N1) - 2-FLWL(N,N6,N5,N4) - TFLWLX(N3,N2,N1)=TFLWLX(N3,N2,N1)+FLWLX(N,N3,N2,N1) - 2-FLWLX(N,N6,N5,N4) - TFLWHL(N3,N2,N1)=TFLWHL(N3,N2,N1)+FLWHL(N,N3,N2,N1) - 2-FLWHL(N,N6,N5,N4) - THFLWL(N3,N2,N1)=THFLWL(N3,N2,N1)+HFLWL(N,N3,N2,N1) - 2-HFLWL(N,N6,N5,N4) - TWFLXL(N3,N2,N1)=TWFLXL(N3,N2,N1)+WFLXL(N,N3,N2,N1) - TWFLXH(N3,N2,N1)=TWFLXH(N3,N2,N1)+WFLXLH(N,N3,N2,N1) - TTFLXL(N3,N2,N1)=TTFLXL(N3,N2,N1)+TFLXL(N,N3,N2,N1) -C IF(L.EQ.NU(NY,NX))THEN -C WRITE(*,3378)'THFLWL',I,J,M,N1,N2,N3,N4,N5,N6,N,THFLWL(N3,N2,N1) -C 3,HFLWL(N,N3,N2,N1),HFLWL(N,N6,N5,N4),TFLWL(N3,N2,N1) -C 3,FLWL(N,N3,N2,N1),FLWL(N,N6,N5,N4),TFLWHL(N3,N2,N1) -C 3,FLWHL(N,N3,N2,N1),FLWHL(N,N6,N5,N4) -3378 FORMAT(A8,10I4,20E12.4) -C ENDIF - ENDIF -9580 CONTINUE -9585 CONTINUE -9590 CONTINUE -9595 CONTINUE -C -C UPDATE STATE VARIABLES FROM FLUXES CALCULATED ABOVE -C - IF(M.NE.NPH)THEN - DO 9795 NX=NHW,NHE - DO 9790 NY=NVN,NVS -C -C SNOWPACK WATER, ICE, SNOW AND TEMPERATURE -C - IF(VHCP0(NY,NX).GT.VHCPWX(NY,NX))THEN - VOLS0(NY,NX)=VOLS0(NY,NX)+FLW0S(NY,NX) - 2-WFLXA(NY,NX)-FLWS1(NY,NX)+TQS1(NY,NX) - VOLW0(NY,NX)=VOLW0(NY,NX)+FLW0L(NY,NX) - 2+WFLXA(NY,NX)+WFLXB(NY,NX)-FLWZ1(NY,NX)+TQW1(NY,NX) - VOLI0(NY,NX)=VOLI0(NY,NX) - 2-WFLXB(NY,NX)/0.92-FLWI1(NY,NX)+TQI1(NY,NX) - ENGY0=VHCP0(NY,NX)*TK0(NY,NX) - VHCP0(NY,NX)=2.095*VOLS0(NY,NX)+4.19*VOLW0(NY,NX) - 2+1.9274*VOLI0(NY,NX) - TK0(NY,NX)=(ENGY0+HFLW0L(NY,NX)+TFLX0(NY,NX)-HFLWZ1(NY,NX) - 2-HFLSI1(NY,NX)+THQS1(NY,NX))/VHCP0(NY,NX) - ELSE - VOLS0(NY,NX)=VOLS0(NY,NX)+FLQ0S(NY,NX)-FLWS1(NY,NX)+TQS1(NY,NX) - VOLW0(NY,NX)=VOLW0(NY,NX)+FLQ0W(NY,NX)-FLWZ1(NY,NX)+TQW1(NY,NX) - VOLI0(NY,NX)=VOLI0(NY,NX)-FLWI1(NY,NX)+TQI1(NY,NX) - VHCP0(NY,NX)=2.095*VOLS0(NY,NX)+4.19*VOLW0(NY,NX) - 2+1.9274*VOLI0(NY,NX) - TK0(NY,NX)=TKQ(NY,NX) - ENDIF -C IF(NX.EQ.2.AND.NY.EQ.2)THEN -C WRITE(*,7754)'TKW',I,J,M,NX,NY,TK0(NY,NX) -C 3,VOLS0(NY,NX),VOLW0(NY,NX),VOLI0(NY,NX),VOLS1(NY,NX) -C 3,FLW0S(NY,NX),WFLXA(NY,NX),FLWS1(NY,NX),TQS1(NY,NX) -C 4,FLW0L(NY,NX),WFLXB(NY,NX),FLWZ1(NY,NX),TQW1(NY,NX) -C 5,FLWI1(NY,NX),TQI1(NY,NX),THFLWW(NY,NX),HWFLQ0(NY,NX) -C 2,HFLW0L(NY,NX),TFLX0(NY,NX),HFLWZ1(NY,NX),HFLSI1(NY,NX) -C 4,THQS1(NY,NX),VHCP0(NY,NX),VHCPWX(NY,NX) -C ENDIF -C -C SURFACE RESIDUE WATER AND TEMPERATURE -C - TVOL1(NY,NX)=AMAX1(0.0,VOLW1(0,NY,NX)+VOLI1(0,NY,NX) - 2-VOLWRX(NY,NX)) - TVOLW(NY,NX)=AMAX1(0.0,VOLW1(0,NY,NX)-VOLWRX(NY,NX)) - VOLGM(M+1,NY,NX)=AMAX1(0.0,TVOL1(NY,NX)) -C VOLXP2=(VOLP1(NU(NY,NX),NY,NX)+VOLPH1(NU(NY,NX),NY,NX)) -C 2*AMIN1(1.0,(VOLA(NU(NY,NX),NY,NX)+VOLAH1(NU(NY,NX),NY,NX)) -C 3/TVOL1(NY,NX)) -C VOLPX1(NU(NY,NX),NY,NX)=VOLXP2*HYST(NU(NY,NX),NY,NX) - VOLW1(0,NY,NX)=AMAX1(0.0,VOLW1(0,NY,NX)+FLWRL(NY,NX)+WFLXR(NY,NX) - 2+TQR1(NY,NX)) - VOLI1(0,NY,NX)=AMAX1(0.0,VOLI1(0,NY,NX)-WFLXR(NY,NX)/0.92) - VOLP1(0,NY,NX)=AMAX1(0.0,VOLA(0,NY,NX)-VOLW1(0,NY,NX) - 2-VOLI1(0,NY,NX)) - VOLWM(M+1,0,NY,NX)=VOLW1(0,NY,NX) - VOLPM(M+1,0,NY,NX)=VOLP1(0,NY,NX) - THETWX(0,NY,NX)=AMAX1(0.0,VOLW1(0,NY,NX)/VOLT(0,NY,NX)) - THETIX(0,NY,NX)=AMAX1(0.0,VOLI1(0,NY,NX)/VOLT(0,NY,NX)) - THETPX(0,NY,NX)=AMAX1(0.0,VOLP1(0,NY,NX)/VOLT(0,NY,NX)) - THETPM(M+1,0,NY,NX)=THETPX(0,NY,NX) -C IF(NX.EQ.1.AND.NY.EQ.6)THEN -C WRITE(*,7752)'VOLW10',I,J,M,NX,NY,VOLW1(0,NY,NX) -C 2,VOLI1(0,NY,NX),VOLP1(0,NY,NX),FLWRL(NY,NX),WFLXR(NY,NX) -C 2,TQR1(NY,NX),TRC0(NY,NX),VHCPR1(NY,NX),VHCPRX(NY,NX),CVRD(NY,NX) -C 4,FLWR(NY,NX),VOLA(0,NY,NX),VOLWRX(NY,NX),VOLR(NY,NX) -C 2,ORGC(0,NY,NX),PSISM1(0,NY,NX) -7752 FORMAT(A8,5I4,20E12.4) -C ENDIF - ENGYR=VHCPR1(NY,NX)*TK1(0,NY,NX) - VHCPR1(NY,NX)=2.496E-06*ORGC(0,NY,NX)+4.19*VOLW1(0,NY,NX) - 2+1.9274*VOLI1(0,NY,NX) - IF(VHCPR1(NY,NX).GT.VHCPRX(NY,NX))THEN - TK1(0,NY,NX)=(ENGYR+HFLWRL(NY,NX)+TFLXR(NY,NX) - 2+THQR1(NY,NX))/VHCPR1(NY,NX) -C WRITE(*,7754)'TKR',I,J,M,NX,NY,TK1(0,NY,NX),ENGYR,HFLWRL(NY,NX) -C 2,TFLXR(NY,NX),THQR1(NY,NX),VHCPR1(NY,NX),VOLW1(0,NY,NX) -7754 FORMAT(A8,5I4,30E12.4) - ELSE - TK1(0,NY,NX)=TK1(NU(NY,NX),NY,NX) - ENDIF -C -C SOIL SURFACE WATER FROM RUNOFF -C - VOLI1(NU(NY,NX),NY,NX)=VOLI1(NU(NY,NX),NY,NX)+FLSI1(NY,NX) - ENGY1=VHCP1(NU(NY,NX),NY,NX)*TK1(NU(NY,NX),NY,NX) - VHCP1(NU(NY,NX),NY,NX)=VHCM(NU(NY,NX),NY,NX) - 2+4.19*(VOLW1(NU(NY,NX),NY,NX)+VOLWH1(NU(NY,NX),NY,NX)) - 3+1.9274*(VOLI1(NU(NY,NX),NY,NX)+VOLIH1(NU(NY,NX),NY,NX)) - TK1(NU(NY,NX),NY,NX)=(ENGY1+HFLSI1(NY,NX)) - 2/VHCP1(NU(NY,NX),NY,NX) -C WRITE(*,7755)'TQR',I,J,M,NX,NY,VOLW1(NU(NY,NX),NY,NX) -C 2,VOLWH1(NU(NY,NX),NY,NX),TQR1(NY,NX) -C WRITE(*,7755)'TK1',I,J,M,NX,NY,TK1(NU(NY,NX),NY,NX) -C 2,VHCP1(NU(NY,NX),NY,NX),VHCM(NU(NY,NX),NY,NX) -C 2,ENGY1,THQR1(NY,NX),HFLSI1(NY,NX),TQR1(NY,NX) -C 3,VOLW1(NU(NY,NX),NY,NX),VOLWH1(NU(NY,NX),NY,NX) -C 4,VOLI1(NU(NY,NX),NY,NX),FLSI1(NY,NX) -7755 FORMAT(A8,5I4,20E12.4) -C -C SOIL LAYER WATER, ICE AND TEMPERATURE -C - DO 9785 L=NU(NY,NX),NL(NY,NX) - VOLW1(L,NY,NX)=VOLW1(L,NY,NX)+TFLWL(L,NY,NX) - 2+FINHL(L,NY,NX)+TWFLXL(L,NY,NX)+FLU1(L,NY,NX) - VOLWX1(L,NY,NX)=VOLWX1(L,NY,NX)+TFLWLX(L,NY,NX) - 2+FINHL(L,NY,NX)+TWFLXL(L,NY,NX)+FLU1(L,NY,NX)+FLWVL(L,NY,NX) - VOLWX1(L,NY,NX)=AMIN1(VOLW1(L,NY,NX),VOLWX1(L,NY,NX)) - VOLI1(L,NY,NX)=VOLI1(L,NY,NX)-TWFLXL(L,NY,NX)/0.92 - VOLWH1(L,NY,NX)=VOLWH1(L,NY,NX)+TFLWHL(L,NY,NX) - 2-FINHL(L,NY,NX)+TWFLXH(L,NY,NX) - VOLIH1(L,NY,NX)=VOLIH1(L,NY,NX)-TWFLXH(L,NY,NX)/0.92 - VOLP1(L,NY,NX)=AMAX1(0.0,VOLA(L,NY,NX)-VOLW1(L,NY,NX) - 2-VOLI1(L,NY,NX)) - VOLAH1(L,NY,NX)=AMAX1(0.0,VOLAH(L,NY,NX)-FVOLAH*CCLAY(L,NY,NX) - 2*(VOLW1(L,NY,NX)/VOLX(L,NY,NX)-WP(L,NY,NX))*VOLT(L,NY,NX)) - VOLPH1(L,NY,NX)=AMAX1(0.0,VOLAH1(L,NY,NX)-VOLWH1(L,NY,NX) - 2-VOLIH1(L,NY,NX)) - VOLPX1(L,NY,NX)=VOLP1(L,NY,NX)*HYST(L,NY,NX) - VOLWM(M+1,L,NY,NX)=VOLW1(L,NY,NX) - VOLWHM(M+1,L,NY,NX)=VOLWH1(L,NY,NX) - VOLPM(M+1,L,NY,NX)=VOLP1(L,NY,NX)+VOLPH1(L,NY,NX) - 2+THETPI*(VOLI1(L,NY,NX)+VOLIH1(L,NY,NX)) - FLPM(M,L,NY,NX)=VOLPM(M,L,NY,NX)-VOLPM(M+1,L,NY,NX) - THETWX(L,NY,NX)=AMAX1(0.0,(VOLW1(L,NY,NX)+VOLWH1(L,NY,NX)) - 2/VOLT(L,NY,NX)) - THETIX(L,NY,NX)=AMAX1(0.0,(VOLI1(L,NY,NX)+VOLIH1(L,NY,NX)) - 2/VOLT(L,NY,NX)) - THETPX(L,NY,NX)=AMAX1(0.0,(VOLP1(L,NY,NX)+VOLPH1(L,NY,NX)) - 2/VOLT(L,NY,NX)) - THETPM(M+1,L,NY,NX)=THETPX(L,NY,NX) - IF(VOLA(L,NY,NX)+VOLAH(L,NY,NX).GT.ZEROS(NY,NX))THEN - THETPY(L,NY,NX)=AMAX1(0.0,(VOLP1(L,NY,NX)+VOLPH1(L,NY,NX)) - 2/(VOLA(L,NY,NX)+VOLAH(L,NY,NX))) - ELSE - THETPY(L,NY,NX)=0.0 - ENDIF - IF(VOLAH(L,NY,NX).GT.ZEROS(NY,NX))THEN - FMAC(L,NY,NX)=FHOL(L,NY,NX)*VOLAH1(L,NY,NX)/VOLAH(L,NY,NX) - CNDH1(L,NY,NX)=XNPH*NHOL(L,NY,NX)*CNDH(L,NY,NX) - 2*(VOLAH1(L,NY,NX)/VOLAH(L,NY,NX))**2 - ELSE - FMAC(L,NY,NX)=0.0 - CNDH1(L,NY,NX)=0.0 - ENDIF - FGRD(L,NY,NX)=1.0-FMAC(L,NY,NX) - TKXX=TK1(L,NY,NX) - VHXX=VHCP1(L,NY,NX) - ENGY1=VHCP1(L,NY,NX)*TK1(L,NY,NX) - VHCP1(L,NY,NX)=VHCM(L,NY,NX)+4.19*(VOLW1(L,NY,NX) - 2+VOLWH1(L,NY,NX))+1.9274*(VOLI1(L,NY,NX)+VOLIH1(L,NY,NX)) -C -C ARTIFICIAL SOIL WARMING -C -C IF(NX.EQ.3.AND.NY.EQ.2.AND.L.GT.NU(NY,NX) -C 3.AND.L.LE.17.AND.I.GE.152.AND.I.LE.304)THEN -C THFLWL(L,NY,NX)=THFLWL(L,NY,NX) -C 2+(TKSZ(I,J,L)-TK1(L,NY,NX))*VHCP1(L,NY,NX)*XNPH -C WRITE(*,3379)'TKSZ',I,J,M,NX,NY,L,TKSZ(I,J,L) -C 2,TK1(L,NY,NX),VHCP1(L,NY,NX),THFLWL(L,NY,NX) -3379 FORMAT(A8,6I4,12E12.4) -C ENDIF -C -C ARTIFICIAL SOIL WARMING -C - TK1(L,NY,NX)=(ENGY1+THFLWL(L,NY,NX)+TTFLXL(L,NY,NX) - 2+HWFLU1(L,NY,NX))/VHCP1(L,NY,NX) -C IF(L.EQ.NU(NY,NX))THEN -C WRITE(*,3377)'VOLW1',I,J,M,NX,NY,L,VOLW1(L,NY,NX) -C 2,TFLWL(L,NY,NX),FINHL(L,NY,NX),TWFLXL(L,NY,NX),FLU1(L,NY,NX) -C 3,TQR1(NY,NX),VOLP1(L,NY,NX),VOLA(L,NY,NX) -C 5,VOLI1(L,NY,NX),VOLPX1(L,NY,NX),HYST(L,NY,NX),PSISM1(L,NY,NX) -C 6,FLWL(3,L,NY,NX),FLWL(3,L+1,NY,NX) -C 7,FLWL(2,L,NY,NX),FLWL(2,L,NY+1,NX) -C 8,FLWL(1,L,NY,NX),FLWL(1,L,NY,NX+1) -C 9,FLPM(M,L,NY,NX),VOLPM(M,L,NY,NX),VOLPM(M+1,L,NY,NX) -C WRITE(*,3377)'VOLWH1',I,J,M,NX,NY,L,VOLWH1(L,NY,NX) -C 2,TFLWHL(L,NY,NX),FINHL(L,NY,NX),VOLIH1(L,NY,NX) -C 4,TWFLXH(L,NY,NX),TQR1(NY,NX),VOLPH1(L,NY,NX) -C 5,FLWHL(2,L,NY,NX),FLWHL(2,L,NY+1,NX) -C WRITE(*,3377)'TKL',I,J,M,NX,NY,L,TK1(L,NY,NX),ENGY1 -C 2,THFLWL(L,NY,NX),TTFLXL(L,NY,NX),HWFLU1(L,NY,NX),VHCP1(L,NY,NX) -C 3,VHCM(L,NY,NX),VOLW1(L,NY,NX),VOLWH1(L,NY,NX),VOLI1(L,NY,NX) -C 4,THETW(L,NY,NX),THETI(L,NY,NX),FINHL(L,NY,NX),THQR1(NY,NX) -C 5,HFLSI1(NY,NX),HFLWL(2,L,NY,NX),HFLWL(2,L,NY+1,NX) -3377 FORMAT(A8,6I4,40E12.4) -C ENDIF -9785 CONTINUE -9790 CONTINUE -9795 CONTINUE - ENDIF -3320 CONTINUE - RETURN - END + + SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) +C +C THIS SUBROUTINE CACULATES ENERGY BALANCES OF SNOW, RESIDUE +C AND SOIL SURFACES, FREEZING, THAWING, AND HEAT AND WATER +C TRANSFER THROUGH SOIL PROFILES +C + include "parameters.h" + include "blkc.h" + include "blk2a.h" + include "blk2b.h" + include "blk2c.h" + include "blk5.h" + include "blk8a.h" + include "blk8b.h" + include "blk10.h" + include "blk11a.h" + include "blk11b.h" + include "blk13a.h" + include "blk13b.h" + include "blk13c.h" + include "blk15a.h" + include "blk15b.h" + include "blk22a.h" + include "blk22b.h" + include "blk22c.h" + include "blktest.h" + DIMENSION VOLWX1(JZ,JY,JX) + 2,TVOL1(JY,JX),TVOLW(JY,JX),FMAC(JZ,JY,JX),FGRD(JZ,JY,JX) + 3,VOLW1(0:JZ,JY,JX),VOLI1(0:JZ,JY,JX),VOLPX1(JZ,JY,JX) + 4,VHCP1(JZ,JY,JX),TK1(0:JZ,JY,JX),TWFLXL(JZ,JY,JX),TTFLXL(JZ,JY,JX) + 5,VOLP1(0:JZ,JY,JX),WGSG1(JZ,JY,JX),TWFLXH(JZ,JY,JX) + 6,VOLS0(JY,JX),VOLI0(JY,JX),VOLW0(JY,JX),VOLS1(JY,JX) + 7,DPTHS0(JY,JX),VHCP0(JY,JX),TK0(JY,JX),AREAU(JZ,JY,JX) + 8,FLQ0S(JY,JX),FLQ0W(JY,JX),FLQ1(JY,JX),FLH1(JY,JX) + 9,FLY1(JY,JX),HWFLQ0(JY,JX),HWFLQ1(JY,JX),HWFLY1(JY,JX) + 1,RAR(JY,JX),RAGS(JY,JX),WGSG0(JY,JX),WRP(0:JZ,JY,JX),RARG(JY,JX) + 2,RAGR(JY,JX),RAGW(JY,JX),BARE(JY,JX),CVRD(JY,JX),PAREG(JY,JX) + 3,RAG(JY,JX),PARSG(JY,JX),PARER(JY,JX),PARSR(JY,JX),WGSGR0(JY,JX) + 4,VPQ(JY,JX),TKQ(JY,JX),VHCPR1(JY,JX),QR1(2,JV,JH),HQR1(2,JV,JH) + 5,QS1(2,JV,JH),QW1(2,JV,JH),QI1(2,JV,JH),HQS1(2,JV,JH) + 6,TQR1(JY,JX),THQR1(JY,JX),TQS1(JY,JX),TQW1(JY,JX) + 7,TQI1(JY,JX),THQS1(JY,JX),EVAP(JY,JX) + 8,EVAPS(JY,JX),EVAPR(JY,JX),TFLX0(JY,JX),WFLXA(JY,JX),WFLXB(JY,JX) + 9,FLW0L(JY,JX),FLW0S(JY,JX),HFLW0L(JY,JX),RFLWV(JY,JX),FLWRL(JY,JX) + 1,HFLWRL(JY,JX),FINHL(JZ,JY,JX),FLWVL(JZ,JY,JX),FLWL(3,JD,JV,JH) + DIMENSION FLWHL(3,JD,JV,JH),HFLWL(3,JD,JV,JH),AVCNHL(3,JD,JV,JH) + 2,TFLWL(JZ,JY,JX),TFLWHL(JZ,JY,JX),THFLWL(JZ,JY,JX) + 3,WFLXL(3,JZ,JY,JX),TFLXL(3,JZ,JY,JX),FLWZ1(JY,JX),FLWS1(JY,JX) + 4,FLWI1(JY,JX),FLSI1(JY,JX),HFLWZ1(JY,JX),HFLSI1(JY,JX) + 5,THRYW(JY,JX),THRMW(JY,JX),THRMS(JY,JX),THRMR(JY,JX) + 6,THRYG(JY,JX),THRYR(JY,JX),RADXW(JY,JX),RADXG(JY,JX) + 7,RADXR(JY,JX),FLWLX(3,JD,JV,JH),TFLWLX(JZ,JY,JX) + 8,FLU1(JZ,JY,JX),HWFLU1(JZ,JY,JX),PSISM1(0:JZ,JY,JX) + 4,ALTG(JY,JX),WFLXLH(3,JZ,JY,JX),DLYRR(JY,JX),WFLXR(JY,JX) + 6,TFLXR(JY,JX),HCNDR(JY,JX),CNDH1(JZ,JY,JX) + 7,THETWX(0:JZ,JY,JX),THETIX(0:JZ,JY,JX),THETPX(0:JZ,JY,JX) + 8,VOLAH1(JZ,JY,JX),VOLWH1(JZ,JY,JX),VOLPH1(JZ,JY,JX) + 9,VOLIH1(JZ,JY,JX),THETPY(0:JZ,JY,JX) + PARAMETER (THETPI=0.00,EMMS=0.98,EMMW=0.98,EMMR=0.98 + 2,RACX=0.0278,RARX=0.0139,RZ=0.0278,RZR=0.0278,RZW=0.0278 + 3,RAM=1.39E-03,HYSTK=1.00,FQS=1.0E-00,DPTHSX=0.05,FPSISR=-4.0) + PARAMETER (Z1S=0.0175,Z2SW=12.0,Z2SD=12.0,Z3SX=0.50 + 2,Z1R=0.0175,Z2RW=3.0,Z2RD=12.0,Z3R=0.50) + PARAMETER (VISCW=1.18E-06,VISCA=1.44E-05,DIFFW=1.45E-07 + 2,DIFFA=2.01E-05,EXPNW=2.07E-04,EXPNA=3.66E-03,GRAV=9.8 + 3,RYLXW=GRAV*EXPNW/(VISCW*DIFFW),RYLXA=GRAV*EXPNA/(VISCA*DIFFA) + 4,PRNTW=VISCW/DIFFW,PRNTA=VISCA/DIFFA + 5,DNUSW=(1.0+(0.492/PRNTW)**0.5625)**0.4444 + 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 + 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 + FQSM=FQS*XNPH + DO 9995 NX=NHW,NHE + DO 9990 NY=NVN,NVS +C +C SET INTERNAL TIME STEPS FROM CYCLES PER HOUR ENTERED IN 'READS' +C XNPH = INTERNAL TIME STEP FOR SNOWPACK, SOIL PROFILE +C XNPR = INTERNAL TIME STEP FOR SURFACE RESIDUE +C + XNPHR=XNPH*XNPR + HYSTX=HYSTK +C +C ADJUST SURFACE ELEVATION USED IN RUNOFF FOR EROSION +C + ALTG(NY,NX)=ALT(NY,NX)-CDPTH(NU(NY,NX),NY,NX) + 2+DLYR(3,NU(NY,NX),NY,NX) +C +C ENTER STATE VARIABLES AND DRIVERS INTO LOCAL ARRAYS +C FOR USE AT INTERNAL TIME STEP +C + VOLS0(NY,NX)=VOLSS(NY,NX) + VOLI0(NY,NX)=VOLIS(NY,NX) + VOLW0(NY,NX)=VOLWS(NY,NX) + VOLS1(NY,NX)=VOLS(NY,NX) + DPTHS0(NY,NX)=DPTHS(NY,NX) + VHCP0(NY,NX)=VHCPW(NY,NX) + TK0(NY,NX)=TKW(NY,NX) + WFLXR(NY,NX)=0.0 + TFLXR(NY,NX)=0.0 + DO 65 L=NU(NY,NX),NL(NY,NX) + IF(CDPTH(L,NY,NX).GE.WDPTH(I,NY,NX))THEN + LWDPTH=L + GO TO 55 + ENDIF +65 CONTINUE +55 CONTINUE +C +C SET INITIAL SOIL VALUES +C + DO 30 L=NU(NY,NX),NL(NY,NX) +C +C ENTER STATE VARIABLES AND DRIVERS INTO LOCAL ARRAYS +C FOR USE AT INTERNAL TIME STEP +C + PSISM1(L,NY,NX)=PSISM(L,NY,NX) + VOLW1(L,NY,NX)=VOLW(L,NY,NX) + VOLWX1(L,NY,NX)=VOLWX(L,NY,NX) + VOLI1(L,NY,NX)=VOLI(L,NY,NX) + VOLWH1(L,NY,NX)=VOLWH(L,NY,NX) + VOLIH1(L,NY,NX)=VOLIH(L,NY,NX) + VOLP1(L,NY,NX)=AMAX1(0.0,VOLA(L,NY,NX)-VOLW1(L,NY,NX) + 2-VOLI1(L,NY,NX)) + VOLAH1(L,NY,NX)=AMAX1(0.0,VOLAH(L,NY,NX)-FVOLAH*CCLAY(L,NY,NX) + 2*(VOLW1(L,NY,NX)/VOLX(L,NY,NX)-WP(L,NY,NX))*VOLT(L,NY,NX)) + VOLPH1(L,NY,NX)=AMAX1(0.0,VOLAH1(L,NY,NX)-VOLWH1(L,NY,NX) + 2-VOLIH1(L,NY,NX)) + VOLPX1(L,NY,NX)=VOLP1(L,NY,NX)*HYST(L,NY,NX) + VOLWM(1,L,NY,NX)=VOLW1(L,NY,NX) + VOLWHM(1,L,NY,NX)=VOLWH1(L,NY,NX) + VOLPM(1,L,NY,NX)=VOLP1(L,NY,NX)+VOLPH1(L,NY,NX) + 2+THETPI*(VOLI1(L,NY,NX)+VOLIH1(L,NY,NX)) + THETWX(L,NY,NX)=AMAX1(0.0,(VOLW1(L,NY,NX)+VOLWH1(L,NY,NX)) + 2/VOLT(L,NY,NX)) + THETIX(L,NY,NX)=AMAX1(0.0,(VOLI1(L,NY,NX)+VOLIH1(L,NY,NX)) + 2/VOLT(L,NY,NX)) + THETPX(L,NY,NX)=AMAX1(0.0,(VOLP1(L,NY,NX)+VOLPH1(L,NY,NX)) + 2/VOLT(L,NY,NX)) + THETPM(1,L,NY,NX)=THETPX(L,NY,NX) + VHCP1(L,NY,NX)=VHCM(L,NY,NX)+4.19*(VOLW1(L,NY,NX) + 2+VOLWH1(L,NY,NX))+1.9274*(VOLI1(L,NY,NX)+VOLIH1(L,NY,NX)) + IF(VOLA(L,NY,NX)+VOLAH(L,NY,NX).GT.ZEROS(NY,NX))THEN + THETPY(L,NY,NX)=AMAX1(0.0,(VOLP1(L,NY,NX)+VOLPH1(L,NY,NX)) + 2/(VOLA(L,NY,NX)+VOLAH(L,NY,NX))) + ELSE + THETPY(L,NY,NX)=0.0 + ENDIF +C +C MACROPOROSITY +C + IF(VOLAH(L,NY,NX).GT.ZEROS(NY,NX))THEN + FMAC(L,NY,NX)=FHOL(L,NY,NX)*VOLAH1(L,NY,NX)/VOLAH(L,NY,NX) + CNDH1(L,NY,NX)=XNPH*NHOL(L,NY,NX)*CNDH(L,NY,NX) + 2*(VOLAH1(L,NY,NX)/VOLAH(L,NY,NX))**2 + ELSE + FMAC(L,NY,NX)=0.0 + CNDH1(L,NY,NX)=0.0 + ENDIF + FGRD(L,NY,NX)=1.0-FMAC(L,NY,NX) + TK1(L,NY,NX)=TKS(L,NY,NX) + IF(L.EQ.LWDPTH)THEN + FLU(L,NY,NX)=PRECU(NY,NX) + HWFLU(L,NY,NX)=4.19*TKA(NY,NX)*PRECU(NY,NX) + FLU1(L,NY,NX)=FLU(L,NY,NX)*XNPH + HWFLU1(L,NY,NX)=HWFLU(L,NY,NX)*XNPH + ELSE + FLU(L,NY,NX)=0.0 + HWFLU(L,NY,NX)=0.0 + FLU1(L,NY,NX)=0.0 + HWFLU1(L,NY,NX)=0.0 + ENDIF + IF(CDPTH(L,NY,NX).GE.DTBLX(NY,NX))THEN + AREAU(L,NY,NX)=AMIN1(1.0,AMAX1(0.0 + 2,(CDPTH(L,NY,NX)-DTBLX(NY,NX)) + 2/DLYR(3,L,NY,NX))) + ELSE + AREAU(L,NY,NX)=0.0 + ENDIF +30 CONTINUE +C +C ENTER STATE VARIABLES AND DRIVERS INTO LOCAL ARRAYS +C FOR USE AT INTERNAL TIME STEP +C + THRMG(NY,NX)=0.0 + FLQGM(NY,NX)=0.0 +C +C INITIALIZE SNOW AND SOIL-RESIDUE THERMAL CONDUCTIVITIES +C + VHCPR1(NY,NX)=2.496E-06*ORGC(0,NY,NX)+4.19*VOLW(0,NY,NX) + 2+1.9274*VOLI(0,NY,NX) + VOLW1(0,NY,NX)=AMAX1(0.0,VOLW(0,NY,NX)) + VOLI1(0,NY,NX)=AMAX1(0.0,VOLI(0,NY,NX)) + VOLP1(0,NY,NX)=AMAX1(0.0,VOLA(0,NY,NX)-VOLW1(0,NY,NX) + 2-VOLI1(0,NY,NX)) + VOLWM(1,0,NY,NX)=VOLW1(0,NY,NX) + VOLPM(1,0,NY,NX)=VOLP1(0,NY,NX) + TVOL1(NY,NX)=AMAX1(0.0,VOLW1(0,NY,NX)+VOLI1(0,NY,NX) + 2-VOLWRX(NY,NX)) + TVOLW(NY,NX)=AMAX1(0.0,VOLW1(0,NY,NX)-VOLWRX(NY,NX)) + VOLGM(1,NY,NX)=AMAX1(0.0,TVOL1(NY,NX)) + IF(VOLR(NY,NX).GT.ZEROS(NY,NX))THEN + THETWX(0,NY,NX)=AMAX1(0.0,VOLW1(0,NY,NX)/VOLR(NY,NX)) + THETIX(0,NY,NX)=AMAX1(0.0,VOLI1(0,NY,NX)/VOLR(NY,NX)) + THETPX(0,NY,NX)=AMAX1(0.0,VOLP1(0,NY,NX)/VOLR(NY,NX)) + ELSE + THETWX(0,NY,NX)=0.0 + THETIX(0,NY,NX)=0.0 + THETPX(0,NY,NX)=0.0 + ENDIF + THETPM(1,0,NY,NX)=THETPX(0,NY,NX) + PSISM1(0,NY,NX)=PSISM(0,NY,NX) + TK1(0,NY,NX)=TKS(0,NY,NX) +C +C RESIDUE COVERAGE OF SOIL SURFACE +C + IF(BKDS(NU(NY,NX),NY,NX).GT.ZERO)THEN + BARE(NY,NX)=AMAX1(0.0,EXP(-0.8E-02*(TRC0(NY,NX)/AREA(3,0,NY,NX))) + 2-AMIN1(1.0,TVOLW(NY,NX)/VOLWG(NY,NX))) + ELSE + BARE(NY,NX)=0.0 + ENDIF + CVRD(NY,NX)=1.0-BARE(NY,NX) + PRECD(NY,NX)=PRECA(NY,NX)*FRADG(NY,NX)*BARE(NY,NX) + PRECB(NY,NX)=(PRECA(NY,NX)-PRECD(NY,NX)-TFLWC(NY,NX))*BARE(NY,NX) +C +C VARIABLES TO TRANSFER SNOWPACK INTO SOIL SURFACE AT FINAL MELT +C + IF(VHCPW(NY,NX).LE.VHCPWX(NY,NX).AND.DPTHS(NY,NX).GT.0.0 + 2.AND.TKA(NY,NX).GT.273.15)THEN + FLWZ=VOLWS(NY,NX) + FLWS=VOLSS(NY,NX)/0.92 + FLWI=VOLIS(NY,NX) + FLWSI(NY,NX)=FLWS+FLWI + HFLWZ=4.19*FLWZ*TKW(NY,NX) + HFLWSI(NY,NX)=1.9274*(FLWS+FLWI)*TKW(NY,NX) + WDISP=VOLWS(NY,NX)+VOLSS(NY,NX)+VOLIS(NY,NX)*0.92 + ELSE + FLWZ=0.0 + FLWS=0.0 + FLWI=0.0 + HFLWZ=0.0 + FLWSI(NY,NX)=0.0 + HFLWSI(NY,NX)=0.0 + WDISP=0.0 + ENDIF +C +C RESIDUE WATER ABSORPTION CAPACITY +C + HCNDRX=HCNDRR*CVRD(NY,NX) + HCNDR(NY,NX)=HCNDRX*XNPH + DLYRR(NY,NX)=AMIN1(5.0E-02,AMAX1(1.0E-06,DLYR(3,0,NY,NX))) +C +C DISCHARGE OF MELTWATER AND ITS HEAT FROM SNOWPACK +C TO RESIDUE, SOIL SURFACE AND MACROPORES +C + IF(VHCPW(NY,NX).GT.VHCPWX(NY,NX))THEN + WMELT=AMAX1(0.0,AMAX1(0.0,VOLWS(NY,NX)) + 2-0.05*AMAX1(0.0,VOLSS(NY,NX))) + FLWQR=WMELT*CVRD(NY,NX) + HFLWQR=4.19*TKW(NY,NX)*FLWQR + FLWQG=WMELT-FLWQR + HFLWQG=4.19*TKW(NY,NX)*FLWQG + FLWQGS=FLWQG*FGRD(NU(NY,NX),NY,NX) + FLWQGH=FLWQG*FMAC(NU(NY,NX),NY,NX) + ELSE + WMELT=0.0 + FLWQR=0.0 + HFLWQR=0.0 + FLWQG=0.0 + HFLWQG=0.0 + FLWQGS=0.0 + FLWQGH=0.0 + ENDIF + FLQRM(NY,NX)=FLWQR + FLQGM(NY,NX)=FLWQG+WDISP +C +C DISTRIBUTION OF PRECIPITATION AND ITS HEAT AMONG SURFACE +C RESIDUE, SOIL SURFACE, AND MACROPORES +C + IF(PRECA(NY,NX).GT.0.0.OR.PRECW(NY,NX).GT.0.0)THEN + IF(VHCPW(NY,NX).GT.VHCPWX(NY,NX))THEN + FLWQW=PRECA(NY,NX)-TFLWC(NY,NX) + FLWSW=PRECW(NY,NX) + HFLWSW=2.095*TKA(NY,NX)*FLWSW+4.19*TKA(NY,NX)*FLWQW + FLWQBX=0.0 + HFLWQB=0.0 + FLWQAX=0.0 + HFLWQA=0.0 + FLWQAS=0.0 + FLWQAH=0.0 + ELSE + FLWQW=0.0 + FLWSW=PRECW(NY,NX) + HFLWSW=2.095*TKA(NY,NX)*FLWSW + FLWQBX=(PRECA(NY,NX)-TFLWC(NY,NX))*CVRD(NY,NX) + HFLWQB=4.19*TKA(NY,NX)*FLWQBX + FLWQAX=PRECA(NY,NX)-TFLWC(NY,NX)-FLWQBX + HFLWQA=4.19*TKA(NY,NX)*FLWQAX + FLWQAS=FLWQAX*FGRD(NU(NY,NX),NY,NX) + FLWQAH=FLWQAX*FMAC(NU(NY,NX),NY,NX) + ENDIF + ELSE + IF(VHCPW(NY,NX).GT.VHCPWX(NY,NX))THEN + FLWQW=-TFLWC(NY,NX) + FLWSW=0.0 + HFLWSW=4.19*TKA(NY,NX)*FLWQW + FLWQBX=0.0 + HFLWQB=0.0 + FLWQAX=0.0 + HFLWQA=0.0 + FLWQAS=0.0 + FLWQAH=0.0 + ELSE + FLWQW=0.0 + FLWSW=0.0 + HFLWSW=0.0 + FLWQBX=-TFLWC(NY,NX)*CVRD(NY,NX) + HFLWQB=4.19*TKA(NY,NX)*FLWQBX + FLWQAX=-TFLWC(NY,NX)-FLWQBX + HFLWQA=4.19*TKA(NY,NX)*FLWQAX + FLWQAS=FLWQAX*FGRD(NU(NY,NX),NY,NX) + FLWQAH=FLWQAX*FMAC(NU(NY,NX),NY,NX) + ENDIF + ENDIF +C +C PRECIP ON SNOW +C + IF(PRECW(NY,NX).GT.0.0.OR.(PRECR(NY,NX).GT.0.0 + 2.AND.VHCPW(NY,NX).GT.VHCPWX(NY,NX)))THEN + FLQRQ(NY,NX)=0.0 + FLQRI(NY,NX)=0.0 + FLQGQ(NY,NX)=PRECQ(NY,NX) + FLQGI(NY,NX)=PRECI(NY,NX) + ELSEIF((PRECQ(NY,NX).GT.0.0.OR.PRECI(NY,NX).GT.0.0) + 2.AND.VHCPW(NY,NX).LE.VHCPWX(NY,NX))THEN + FLQRQ(NY,NX)=FLWQBX*PRECQ(NY,NX)/(PRECQ(NY,NX)+PRECI(NY,NX)) + FLQRI(NY,NX)=FLWQBX*PRECI(NY,NX)/(PRECQ(NY,NX)+PRECI(NY,NX)) + FLQGQ(NY,NX)=PRECQ(NY,NX)-FLQRQ(NY,NX) + FLQGI(NY,NX)=PRECI(NY,NX)-FLQRI(NY,NX) + ELSE + FLQRQ(NY,NX)=0.0 + FLQRI(NY,NX)=0.0 + FLQGQ(NY,NX)=0.0 + FLQGI(NY,NX)=0.0 + ENDIF +C +C GATHER PRECIPITATION AND MELTWATER FLUXES AND THEIR HEATS +C AMONG ATMOSPHERE, SNOWPACK, RESIDUE AND SOIL SURFACES +C INTO LOCAL ARRAYS FOR USE IN MASS AND ENERGY EXCHANGE +C ALGORITHMS +C + FLQ0W(NY,NX)=(FLWQW-FLWQR-FLWQGS-FLWQGH)*XNPH + FLQ0S(NY,NX)=FLWSW*XNPH + HWFLQ0(NY,NX)=(HFLWSW-HFLWQG-HFLWQR)*XNPH + FLQ1(NY,NX)=(FLWQAS+FLWQGS+FLWZ)*XNPH + FLH1(NY,NX)=(FLWQAH+FLWQGH)*XNPH + FLY1(NY,NX)=(FLWQBX+FLWQR)*XNPH + HWFLQ1(NY,NX)=(HFLWQA+HFLWQG+HFLWZ)*XNPH + HWFLY1(NY,NX)=(HFLWQB+HFLWQR)*XNPH + FLWZ1(NY,NX)=FLWZ*XNPH + FLWS1(NY,NX)=FLWS*0.92*XNPH + FLWI1(NY,NX)=FLWI*XNPH + HFLWZ1(NY,NX)=HFLWZ*XNPH + FLSI1(NY,NX)=FLWSI(NY,NX)*XNPH + HFLSI1(NY,NX)=HFLWSI(NY,NX)*XNPH + RFLWV(NY,NX)=1.0E-02*XNPH +C IF(I.EQ.118.AND.NX.EQ.3.AND.NY.EQ.4)THEN +C WRITE(*,4422)'FLQ0W',I,J,FLQ0W(NY,NX),FLWQW +C 2,FLWQR,FLWQGS,FLWQGH,XNPH +C WRITE(*,4422)'FLY',I,J,PRECA(NY,NX),TFLWC(NY,NX),FLY1(NY,NX) +C 2,PSISM1(0,NY,NX),PSISM(0,NY,NX) +C 2,FLQ1(NY,NX),FLH1(NY,NX),FLWQBX,FLWQR +C 2,FLWQAS,FLWQGS,FLWZ,FLWQAH,FLWQGH +C 3,FGRD(NU(NY,NX),NY,NX),FMAC(NU(NY,NX),NY,NX) +C 4,FHOL(L,NY,NX),VOLAH1(L,NY,NX),VOLAH(L,NY,NX) +C 5,FLWQAX,PRECA(NY,NX),TFLWC(NY,NX),FLWQBX,CVRD(NY,NX) +C 6,BARE(NY,NX),TRC0(NY,NX),TVOLW(NY,NX),VOLWG(NY,NX) +C 7,VOLW1(0,NY,NX),VOLWRX(NY,NX) +4422 FORMAT(A8,2I4,40E12.4) +C ENDIF +C +C INITIALIZE PARAMETERS, FLUXES FOR ENERGY EXCHANGE +C AT SNOW, RESIDUE AND SOIL SURFACES +C + RADXW(NY,NX)=RADG(NY,NX)*XNPH + RADXG(NY,NX)=RADXW(NY,NX)*BARE(NY,NX) + RADXR(NY,NX)=RADXW(NY,NX)*CVRD(NY,NX)*XNPR + THRYW(NY,NX)=(THS(NY,NX)*FRADG(NY,NX)+THRMCX(NY,NX))*XNPH + THRYG(NY,NX)=THRYW(NY,NX)*BARE(NY,NX) + THRYR(NY,NX)=THRYW(NY,NX)*CVRD(NY,NX)*XNPR + THRMW(NY,NX)=EMMW*2.04E-10*AREA(3,NU(NY,NX),NY,NX)*XNPH + THRMS(NY,NX)=EMMS*2.04E-10*AREA(3,NU(NY,NX),NY,NX)*XNPH + 2*BARE(NY,NX) + THRMR(NY,NX)=EMMR*2.04E-10*AREA(3,NU(NY,NX),NY,NX)*XNPHR + 2*CVRD(NY,NX) +C +C AERODYNAMIC RESISTANCE OF CANOPY TO SNOW/RESIDUE/SOIL +C SURFACE ENERGY EXCHANGE WITH ATMOSPHERE +C + ALFZ=2.0*(1.0-FRADG(NY,NX)) + IF(RAB(NY,NX).GT.ZERO.AND.ZT(NY,NX).GT.ZS(NY,NX) + 2.AND.ALFZ.GT.ZERO)THEN + RAC(NY,NX)=AMIN1(RACX,AMAX1(0.0,ZT(NY,NX)*EXP(ALFZ) + 2/(ALFZ/RAB(NY,NX))*AMAX1(0.0,EXP(-ALFZ*ZS(NY,NX)/ZT(NY,NX)) + 3-EXP(-ALFZ*(ZD(NY,NX)+ZR(NY,NX))/ZT(NY,NX))))) + UAG=UA(NY,NX)*EXP(-ALFZ) + ELSE + RAC(NY,NX)=0.0 + UAG=UA(NY,NX) + ENDIF + VPQ(NY,NX)=VPA(NY,NX)-1.0*TLEX(NY,NX) + 2/(VAP*AREA(3,NU(NY,NX),NY,NX)) + TKQ(NY,NX)=TKA(NY,NX)-1.0*TSHX(NY,NX) + 2/(1.25E-03*AREA(3,NU(NY,NX),NY,NX)) +C +C AERODYNAMIC RESISTANCE OF RESIDUE AND SOIL +C SURFACE TO ENERGY EXCHANGE WITH ATMOSPHERE +C Soil Sci. Soc. Am. J. 48:25-32 +C + WGSG0(NY,NX)=WGSGW(NY,NX)*XNPH + WGSGR0(NY,NX)=WGSGR(NY,NX)*XNPH + DO 25 L=NU(NY,NX),NL(NY,NX) + IF(POROS(L,NY,NX).GT.0.0)THEN + WFPS=THETW(L,NY,NX)/POROS(L,NY,NX) + ELSE + WFPS=1.0 + ENDIF + FWGWP=AMAX1(1.0,10.0-50.0*WP(L,NY,NX)) + FWGSG=9.5+2.0*WFPS-8.5*EXP(-((FWGWP*WFPS)**3)) + WGSG1(L,NY,NX)=FWGSG*WGSGL(L,NY,NX)*XNPH +25 CONTINUE + RAR(NY,NX)=DLYRR(NY,NX)/WGSGR(NY,NX) + RAG(NY,NX)=RAC(NY,NX)+RAB(NY,NX) + RAGW(NY,NX)=RAG(NY,NX) + RAGR(NY,NX)=RAG(NY,NX)+RARX + RARG(NY,NX)=RAGR(NY,NX) + RAR1=RAR(NY,NX)/AMAX1(THETX,THETPX(0,NY,NX))**2.33 + RAGS(NY,NX)=RAG(NY,NX)+RAR1 + PARR(NY,NX)=AREA(3,NU(NY,NX),NY,NX)*XNPH/RAGR(NY,NX) + PARG(NY,NX)=AREA(3,NU(NY,NX),NY,NX)*XNPH/RAGS(NY,NX) + PAREG(NY,NX)=AREA(3,NU(NY,NX),NY,NX)*XNPH + PARER(NY,NX)=PAREG(NY,NX)*XNPR*CVRD(NY,NX) + PARSG(NY,NX)=1.25E-03*AREA(3,NU(NY,NX),NY,NX)*XNPH + PARSR(NY,NX)=PARSG(NY,NX)*XNPR*CVRD(NY,NX) +C IF(J.EQ.24)THEN +C WRITE(*,3111)'RAC',I,J,ALFZ,RAC(NY,NX),ZT(NY,NX),RAB(NY,NX) +C 2,RAR(NY,NX),RAR1,PARG(NY,NX),PARR(NY,NX) +C 3,DLYRR(NY,NX),RAG(NY,NX),RAGS(NY,NX),RAGR(NY,NX) +C 4,THETPX(0,NY,NX),WGSGR(NY,NX),VOLW1(0,NY,NX) +C 5,VOLI1(0,NY,NX),VOLP1(0,NY,NX),VOLR(NY,NX),VOLA(0,NY,NX) +C 4,TLEX(NY,NX),TSHX(NY,NX),RADG(NY,NX),THS(NY,NX) +C 5,FRADG(NY,NX),THRMCX(NY,NX),ZS(NY,NX) +3111 FORMAT(A8,2I4,30E12.4) +C ENDIF +9990 CONTINUE +9995 CONTINUE +C +C INITIALIZE SOIL HYDRAULIC PARAMETERS IN LOCAL ARRAYS +C FOR LATER USE IN WATER TRANSFER ALGORITHMS +C + DO 9985 NX=NHW,NHE + DO 9980 NY=NVN,NVS + DO 35 L=NU(NY,NX),NL(NY,NX) + DO 40 N=NCN(NY,NX),3 + TFLXL(N,L,NY,NX)=0.0 + WFLXL(N,L,NY,NX)=0.0 + WFLXLH(N,L,NY,NX)=0.0 + N1=NX + N2=NY + N3=L + IF(N.EQ.1)THEN + IF(NX.EQ.NHE)THEN + GO TO 50 + ELSE + N4=NX+1 + N5=NY + N6=L + ENDIF + ELSEIF(N.EQ.2)THEN + IF(NY.EQ.NVS)THEN + GO TO 50 + ELSE + N4=NX + N5=NY+1 + N6=L + ENDIF + ELSEIF(N.EQ.3)THEN + IF(L.EQ.NL(NY,NX))THEN + GO TO 50 + ELSE + N4=NX + N5=NY + N6=L+1 + ENDIF + ENDIF +C +C MACROPORE CONDUCTIVITY FROM 'HOUR1' AND GRAVITATIONAL +C GRADIENT USED TO CALCULATE MACROPORE FLOW FOR USE BELOW +C + IF(CNDH1(N3,N2,N1).GT.ZERO.AND.CNDH1(N6,N5,N4) + 2.GT.ZERO)THEN + AVCNHL(N,N6,N5,N4)=2.0*CNDH1(N3,N2,N1)*CNDH1(N6,N5,N4) + 2/(CNDH1(N3,N2,N1)*DLYR(N,N6,N5,N4)+CNDH1(N6,N5,N4) + 3*DLYR(N,N3,N2,N1)) + ELSE + AVCNHL(N,N6,N5,N4)=0.0 + ENDIF +50 CONTINUE +40 CONTINUE +35 CONTINUE +9980 CONTINUE +9985 CONTINUE +C +C DYNAMIC LOOP FOR FLUX CALCULATIONS +C + DO 3320 M=1,NPH + DO 9895 NX=NHW,NHE + DO 9890 NY=NVN,NVS + TQR1(NY,NX)=0.0 + THQR1(NY,NX)=0.0 + TQS1(NY,NX)=0.0 + TQW1(NY,NX)=0.0 + TQI1(NY,NX)=0.0 + THQS1(NY,NX)=0.0 +C +C WATER REPELLENCY AND GAS EXCHANGE COEFFICIENTS +C + WRP(0,NY,NX)=1.0/(1.0+(AMAX1(-1.5 + 2,PSISM1(0,NY,NX))/PSISXR)**3) + IF(VOLA(0,NY,NX).GT.VOLI1(0,NY,NX) + 2.AND.VOLP1(0,NY,NX).GT.ZEROS(NY,NX))THEN + THETWA=AMAX1(0.0,AMIN1(1.0 + 2,VOLW1(0,NY,NX)/(VOLA(0,NY,NX)-VOLI1(0,NY,NX)))) + TFND1=(TK1(0,NY,NX)/298.15)**6 + IF(THETWA.GT.Z3R)THEN + DFGS(M,0,NY,NX)=AMAX1(0.0 + 2,TFND1*XNPD/((Z1R**-1)*EXP(Z2RW*(THETWA-Z3R)))) + ELSE + DFGS(M,0,NY,NX)=AMIN1(1.0 + 2,TFND1*XNPD/((Z1R**-1)*EXP(Z2RD*(THETWA-Z3R)))) + ENDIF + 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) + ELSE + THETWT=0.0 + ENDIF + TORT(M,0,NY,NX)=0.7*THETWT**2 + DO 9885 L=NU(NY,NX),NL(NY,NX) + TWFLXL(L,NY,NX)=0.0 + TWFLXH(L,NY,NX)=0.0 + TTFLXL(L,NY,NX)=0.0 + TFLWL(L,NY,NX)=0.0 + TFLWLX(L,NY,NX)=0.0 + TFLWHL(L,NY,NX)=0.0 + THFLWL(L,NY,NX)=0.0 + WRP(L,NY,NX)=1.0/(1.0+(AMAX1(-1.5 + 2,PSISM1(L,NY,NX))/PSISX)**3) + VOLWT=VOLW1(L,NY,NX)+VOLWH1(L,NY,NX) + VOLAT=VOLA(L,NY,NX)+VOLAH(L,NY,NX) + 2-VOLI1(L,NY,NX)-VOLIH1(L,NY,NX) + IF(VOLAT.GT.ZEROS(NY,NX) + 2.AND.VOLP1(L,NY,NX).GT.ZEROS(NY,NX))THEN + THETWA=AMAX1(0.0,AMIN1(1.0,VOLWT/VOLAT)) + TFND1=(TK1(L,NY,NX)/298.15)**6 + Z3S=AMAX1(Z3SX,FC(L,NY,NX)/POROS(L,NY,NX)) + IF(THETWA.GT.Z3S)THEN + DFGS(M,L,NY,NX)=AMAX1(0.0 + 2,TFND1*XNPD/((Z1S**-1)*EXP(Z2SW*(THETWA-Z3S)))) + ELSE + DFGS(M,L,NY,NX)=AMIN1(1.0 + 2,TFND1*XNPD/((Z1S**-1)*EXP(Z2SD*(THETWA-Z3S)))) + ENDIF + ELSE + DFGS(M,L,NY,NX)=0.0 + ENDIF +C IF(L.EQ.NU(NY,NX))THEN +C WRITE(*,3377)'DFGS',I,J,M,NX,NY,L,DFGS(M+1,L,NY,NX) +C 2,XNPD,TFACL,Z1S,Z2S,THETWA,Z3S,Z2S*(THETWA-Z3S) +C 3,EXP(Z2S*(THETWA-Z3S)),Z1S**-1 +C 4,(Z1S**-1)*EXP(Z2S*(THETWA-Z3S)) + THETWT=VOLWM(M,L,NY,NX)/VOLX(L,NY,NX) + TORT(M,L,NY,NX)=XDIM*0.7*THETWT**2*(1.0-FHOL(L,NY,NX)) + IF(VOLAH(L,NY,NX).GT.ZEROS(NY,NX))THEN + THETWH=VOLWHM(M,L,NY,NX)/VOLAH(L,NY,NX) + TORTH(M,L,NY,NX)=XDIM*AMIN1(1.0,2.8*THETWH**3)*FHOL(L,NY,NX) + ELSE + TORTH(M,L,NY,NX)=0.0 + ENDIF +9885 CONTINUE +C +C REDISTRIBUTE INCOMING MELTWATER OR PRECIPITATION +C BETWEEN RESIDUE AND SOIL SURFACE +C + VOLWRM=AMAX1(0.0,VOLWRX(NY,NX)-VOLW1(0,NY,NX)-VOLI1(0,NY,NX)) + FLWR1=AMAX1(0.0,FLY1(NY,NX)-VOLWRM) + HFLWR1=4.19*TKA(NY,NX)*FLWR1 + FLYM=FLY1(NY,NX)-FLWR1 + HWFLYM=HWFLY1(NY,NX)-HFLWR1 + FLQM=FLQ1(NY,NX)+FLWR1*FGRD(NU(NY,NX),NY,NX) + FLHM=FLH1(NY,NX)+FLWR1*FMAC(NU(NY,NX),NY,NX) + HWFLQM=HWFLQ1(NY,NX)+HFLWR1 +C +C REDISTRIBUTE SURFACE WATER FROM WATER REPELLANCY +C +C FLWPR=FLYM*(1.0-WRP(0,NY,NX)) +C HFLWPR=4.19*TKA(NY,NX)*FLWPR +C FLYM=FLYM-FLWPR +C HWFLYM=HWFLYM-HFLWPR +C FLQM=FLQM+FLWPR*FGRD(NU(NY,NX),NY,NX) +C FLHM=FLHM+FLWPR*FMAC(NU(NY,NX),NY,NX) +C HWFLQM=HWFLQM+HFLWPR +C FLWP1=FLQM*(1.0-WRP(NU(NY,NX),NY,NX)) +C FLQM=FLQM-FLWP1 +C FLHM=FLHM+FLWP1 + FLYM2=FLYM*XNPR + HWFLM2=HWFLYM*XNPR +C IF(NX.EQ.4.AND.NY.EQ.5)THEN +C WRITE(*,3132)'FLWR1',I,J,M,NX,NY,FLY1(NY,NX),FLQ1(NY,NX) +C 2,VHCP0(NY,NX),VHCPWX(NY,NX) +C 2,FLH1(NY,NX),FLYM,FLQM,FLHM,VOLWRM,FLWR1 +C 3,FMAC(NU(NY,NX),NY,NX),FGRD(NU(NY,NX),NY,NX) +C 5,VOLAH(NU(NY,NX),NY,NX),FVOLAH,CCLAY(NU(NY,NX),NY,NX) +C 4,VOLW1(NU(NY,NX),NY,NX),VOLX(NU(NY,NX),NY,NX),WP(L,NY,NX) +C 2,VOLT(NU(NY,NX),NY,NX),VOLAH1(NU(NY,NX),NY,NX) +C 5,VOLWRX(NY,NX),VOLW1(0,NY,NX),VOLI1(0,NY,NX) +C 6,WRP(0,NY,NX),WRP(NU(NY,NX),NY,NX),PSISM1(0,NY,NX) +C 7,PSISM1(NU(NY,NX),NY,NX) +3132 FORMAT(A8,5I4,40E12.4) +C ENDIF +C +C ENERGY EXCHANGE AT SNOW SURFACE IF PRESENT +C + IF(VHCP0(NY,NX).GT.VHCPWX(NY,NX))THEN +C +C PHYSICAL AND HYDRAULIC PROPERTIES OF SNOWPACK INCLUDING +C AIR AND WATER-FILLED POROSITY, WATER POTENTIAL OF UNDERLYING +C SOIL SURFACE USED IN FLUX CALCULATIONS +C + DENSS=AMIN1(0.6,DENS0(NY,NX)+DENS1(NY,NX)*VOLS0(NY,NX) + 2/AREA(3,NU(NY,NX),NY,NX)) + VOLS1(NY,NX)=VOLS0(NY,NX)/DENSS+VOLW0(NY,NX)+VOLI0(NY,NX) + DPTHS0(NY,NX)=VOLS1(NY,NX)/AREA(3,NU(NY,NX),NY,NX) + THETP0=AMAX1(THETPI,1.0-(VOLS0(NY,NX)+VOLI0(NY,NX) + 2+VOLW0(NY,NX))/VOLS1(NY,NX)) + 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))) +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) + 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 + PSISM1(NU(NY,NX),NY,NX)=-EXP(PSIMS(NY,NX) + 2+(((PSL(NU(NY,NX),NY,NX)-LOG(THETW1)) + 3/PSD(NU(NY,NX),NY,NX))**SRP(NU(NY,NX),NY,NX)*PSISD(NY,NX))) + ELSE + PSISM1(NU(NY,NX),NY,NX)=PSISE(NU(NY,NX),NY,NX) + ENDIF +C ELSE +C PSISM1(NU(NY,NX),NY,NX)=PSISE(NU(NY,NX),NY,NX) +C ENDIF + PSISV1=PSISM1(NU(NY,NX),NY,NX)+PSISO(NU(NY,NX),NY,NX) +C +C SNOWPACK ALBEDO, NET RADIATION +C + ALBW=(0.85*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) + RFLX1=(1.0-ALBG)*RADXW(NY,NX)+THRYW(NY,NX) + THRMX=THRMW(NY,NX)*TKW(NY,NX)**4 + RFLX=RFLX1-THRMX +C +C AERODYNAMIC RESISTANCE ABOVE SNOWPACK INCLUDING +C RESISTANCE IMPOSED BY PLANT CANOPY +C + RI=AMAX1(-0.3,AMIN1(0.075,RIB(NY,NX)*(TKQ(NY,NX)-TKW(NY,NX)))) + RAGX=AMAX1(RAM,0.75*RAGW(NY,NX),AMIN1(1.33*RAGW(NY,NX) + 2,RAG(NY,NX)/(1.0-10.0*RI))) + RAGW(NY,NX)=RAGX + RA=RAGX +C +C PARAMETERS FOR CALCULATING LATENT AND SENSIBLE HEAT FLUXES +C + PARE=PAREG(NY,NX)/(RA+RZW) + PARS=PARSG(NY,NX)/RA + TKW1=TK0(NY,NX) + TK11=TK1(NU(NY,NX),NY,NX) + VP0=2.173E-03/TKW1 + 2*0.61*EXP(5360.0*(3.661E-03-1.0/TKW1)) + VP1=2.173E-03/TK11 + 2*0.61*EXP(5360.0*(3.661E-03-1.0/TK11)) + 3*EXP(18.0*PSISV1/(8.3143*TK11)) + EVAPT=PARE*(VPQ(NY,NX)-VP0) + EVAP(NY,NX)=AMAX1(EVAPT,-AMAX1(0.0,VOLW0(NY,NX))) + EVAPX=AMIN1(0.0,EVAPT-EVAP(NY,NX)) + EVAPS(NY,NX)=AMAX1(EVAPX,-AMAX1(0.0,VOLS0(NY,NX))) + EFLX=EVAP(NY,NX)*VAP+EVAPS(NY,NX)*(VAP+333.0) + IF(EVAPT.LT.0.0)THEN + VFLX=(EVAP(NY,NX)*4.19+EVAPS(NY,NX)*2.095)*TK0(NY,NX) + ELSE + VFLX=(EVAP(NY,NX)*4.19+EVAPS(NY,NX)*2.095)*TKQ(NY,NX) + ENDIF +C +C SOLVE FOR SNOWPACK SURFACE TEMPERATURE AT WHICH ENERGY +C BALANCE OCCURS, SOLVE LATENT, SENSIBLE AND STORAGE HEAT FLUXES +C + SFLX=PARS*(TKQ(NY,NX)-TK0(NY,NX)) + HFLW0=RFLX+EFLX+SFLX+VFLX +C +C VAPOR PRESSURES AND CONDUCTIVITY BETWEEN SNOWPACK +C AND SOIL SURFACE +C + CNV0=THETP0**1.33*WGSG0(NY,NX) + CNV1=THETPX(NU(NY,NX),NY,NX)**2/POROQ(NU(NY,NX),NY,NX) + 2*WGSG1(NU(NY,NX),NY,NX) + IF(CNV0.GT.ZERO.AND.CNV1.GT.ZERO)THEN + AVCNV1=2.0*CNV0*CNV1 + 2/(CNV0*DLYR(3,NU(NY,NX),NY,NX)+CNV1*DPTHS0(NY,NX)) + ELSE + AVCNV1=2.0*CNV0 + 2/(DLYR(3,NU(NY,NX),NY,NX)+DPTHS0(NY,NX)) + ENDIF +C +C HEAT AND VAPOR FLUXES BETWEEN SNOWPACK AND SOIL SURFACE +C + TKY=(TK0(NY,NX)*VHCP0(NY,NX)+TK1(NU(NY,NX),NY,NX) + 2*VHCP1(NU(NY,NX),NY,NX))/(VHCP0(NY,NX)+VHCP1(NU(NY,NX),NY,NX)) + HFLWX=(TK0(NY,NX)-TKY)*VHCP0(NY,NX)*FHFLX*XDIM + FLVX=AVCNV1*(VP0-VP1)*AREA(3,NU(NY,NX),NY,NX)*BARE(NY,NX) + IF(FLVX.GE.0.0)THEN + FLV1=AMIN1(FLVX,VOLW0(NY,NX)*XNPH) + IF(HFLWX.GE.0.0)THEN + FLV1=AMIN1(FLV1,HFLWX/(4.19*TK0(NY,NX)+VAP)) + ENDIF + HWFLV1=(4.19*TK0(NY,NX)+VAP)*FLV1 + ELSE + FLV1=AMAX1(FLVX,-VOLW1(NU(NY,NX),NY,NX)*XNPH) + IF(HFLWX.LT.0.0)THEN + FLV1=AMAX1(FLV1,HFLWX/(4.19*TK1(NU(NY,NX),NY,NX)+VAP)) + ENDIF + HWFLV1=(4.19*TK1(NU(NY,NX),NY,NX)+VAP)*FLV1 + ENDIF + IF(VOLS1(NY,NX).GT.ZEROS(NY,NX))THEN + DENSW=(VOLS0(NY,NX)+VOLW0(NY,NX)+VOLI0(NY,NX))/VOLS1(NY,NX) + ELSE + DENSW=DENS0(NY,NX) + ENDIF +C +C J GLACIOL 43:26-41 +C + IF(DENSW.LT.0.156)THEN + TCNDW=8.28E-05+8.42E-04*DENSW + ELSE + TCNDW=4.97E-04-3.64E-03*DENSW+1.16E-02*DENSW**2 + ENDIF + WTHET1=1.467-0.467*THETPY(NU(NY,NX),NY,NX) + TCND1=(STC(NU(NY,NX),NY,NX)+THETWX(NU(NY,NX),NY,NX)*2.067E-03 + 2+0.611*THETIX(NU(NY,NX),NY,NX)*7.844E-03 + 3+WTHET1*THETPX(NU(NY,NX),NY,NX)*9.050E-05) + 4/(DTC(NU(NY,NX),NY,NX)+THETWX(NU(NY,NX),NY,NX) + 5+0.611*THETIX(NU(NY,NX),NY,NX)+WTHET1*THETPX(NU(NY,NX),NY,NX)) + IF(BARE(NY,NX).GT.ZERO)THEN + TCNDW1=TCNDW*XNPH + TCND1W=TCND1*XNPH + ATCND0=2.0*TCNDW1*TCND1W/(TCNDW1*DLYR(3,NU(NY,NX),NY,NX) + 2+TCND1W*DPTHS0(NY,NX))*BARE(NY,NX) + ELSE + ATCND0=0.0 + ENDIF + TK0X=TK0(NY,NX)-HWFLV1/VHCP0(NY,NX) + TK1X=TK1(NU(NY,NX),NY,NX)+HWFLV1/VHCP1(NU(NY,NX),NY,NX) + TKY=(TK0X*VHCP0(NY,NX)+TK1X*VHCP1(NU(NY,NX),NY,NX)) + 2/(VHCP0(NY,NX)+VHCP1(NU(NY,NX),NY,NX)) + HFLWX=(TK0X-TKY)*VHCP0(NY,NX)*FHFLX*XDIM + HFLWC=ATCND0*(TK0X-TK1X)*AREA(3,NU(NY,NX),NY,NX) + IF(HFLWC.GE.0.0)THEN + HFLC01=AMAX1(0.0,AMIN1(HFLWX,HFLWC)) + ELSE + HFLC01=AMIN1(0.0,AMAX1(HFLWX,HFLWC)) + ENDIF +C IF(NX.EQ.4.AND.NY.EQ.4)THEN +C WRITE(*,1113)'EFLX0',I,J,M,NX,NY,RFLX,EFLX,SFLX,VFLX,HFLW0 +C 2,RADXW(NY,NX),THRYW(NY,NX),ALBG,RADG(NY,NX),THS(NY,NX) +C 3,FRADG(NY,NX),THRMCX(NY,NX),TK0(NY,NX) +C 2,TKA(NY,NX),TKQ(NY,NX),VPQ(NY,NX),VP0,VP1,PARE,PARS,EVAPT +C 3,VHCP0(NY,NX),RA,RI,RZ,RAGX,RAGW(NY,NX),RAG(NY,NX),RAB(NY,NX) +C 4,WFLXA(NY,NX),WFLXB(NY,NX),CNV0,PARG(NY,NX),UA(NY,NX),UAG,ALFZ +C 5,THETP0,VOLS0(NY,NX),VOLI0(NY,NX),VOLW0(NY,NX),VOLS1(NY,NX) +C 6,WGSG0(NY,NX),WGSG1(NU(NY,NX),NY,NX),DPTHS0(NY,NX) +C 7,VOLW1(NU(NY,NX),NY,NX),FLQM,FLYM,WMELT +C 8,HWFLQM,HWFLV1,HFLC01,HFLCR1 +C 9,WGSG0(NY,NX),THETPY(NU(NY,NX),NY,NX) +C 1,DENSS(NY,NX),VOLS0(NY,NX),VOLS1(NY,NX),TCNDW +1113 FORMAT(A8,5I4,60E12.4) +C ENDIF +C +C HEAT FLUX BETWEEN SNOWPACK AND SURFACE RESIDUE +C + FLVR=0.0 + HWFLVR=0.0 + FLVS=0.0 + HWFLVS=0.0 + HFLC0R=0.0 + HFLCR1=0.0 + IF(VHCPR1(NY,NX).GT.VHCPRX(NY,NX))THEN + TK0X=TK0(NY,NX) + TKXR=TK1(0,NY,NX) + TK1X=TK1(NU(NY,NX),NY,NX) + CNV01=CNV0*XNPR + CNV11=CNV1*XNPR + CNVR1=THETPX(0,NY,NX)**2/POROQ(0,NY,NX)*WGSGR0(NY,NX)*XNPR + IF(CVRD(NY,NX).GT.ZERO)THEN + IF(CNV01.GT.ZERO.AND.CNVR1.GT.ZERO)THEN + AVCNVR=2.0*CNVR1*CNV01 + 2/(CNV01*DLYRR(NY,NX)+CNVR1*DPTHS0(NY,NX))*CVRD(NY,NX) + ELSE + AVCNVR=2.0*CNV01 + 2/(DLYRR(NY,NX)+DPTHS0(NY,NX))*CVRD(NY,NX) + ENDIF + IF(CNVR1.GT.ZERO.AND.CNV11.GT.ZERO)THEN + AVCNVS=2.0*CNVR1*CNV11 + 2/(CNVR1*DLYR(3,NU(NY,NX),NY,NX)+CNV11*DLYRR(NY,NX))*CVRD(NY,NX) + ELSE + AVCNVS=2.0*CNV11 + 2/(DLYR(3,NU(NY,NX),NY,NX)+DLYRR(NY,NX))*CVRD(NY,NX) + ENDIF + THETRR=AMAX1(0.0,1.0-THETPX(0,NY,NX)-THETWX(0,NY,NX) + 2-THETIX(0,NY,NX)) + TCNDR=(0.779*THETRR*9.050E-04+0.622*THETWX(0,NY,NX) + 2*2.067E-03+0.380*THETIX(0,NY,NX)*7.844E-03+THETPX(0,NY,NX) + 3*9.050E-05)/(0.779*THETRR+0.622*THETWX(0,NY,NX) + 4+0.380*THETIX(0,NY,NX)+THETPX(0,NY,NX)) + IF(TCNDW.GT.ZERO.AND.TCNDR.GT.ZERO)THEN + TCNDW1=TCNDW*XNPHR + TCNDR1=TCNDR*XNPHR + ATCNDR=2.0*TCNDW1*TCNDR1 + 2/(TCNDW1*DLYRR(NY,NX)+TCNDR1*DPTHS0(NY,NX))*CVRD(NY,NX) + ELSE + ATCNDR=0.0 + ENDIF + IF(TCNDR.GT.ZERO.AND.TCND1.GT.ZERO)THEN + TCND11=TCND1*XNPHR + ATCNDS=2.0*TCNDR1*TCND11 + 2/(TCNDR1*DLYR(3,NU(NY,NX),NY,NX)+TCND11*DLYRR(NY,NX))*CVRD(NY,NX) + ELSE + ATCNDS=0.0 + ENDIF + ELSE + AVCNVR=0.0 + AVCNVS=0.0 + ATCNDR=0.0 + ATCNDS=0.0 + ENDIF + DO 4000 N=1,NPR + VP0=2.173E-03/TK0X + 2*0.61*EXP(5360.0*(3.661E-03-1.0/TK0X)) + VPR=2.173E-03/TKXR + 2*0.61*EXP(5360.0*(3.661E-03-1.0/TKXR)) + 3*EXP(18.0*PSISM1(0,NY,NX)/(8.3143*TKXR)) + TKY=(TKXR*VHCPR1(NY,NX)+TK0X*VHCP0(NY,NX)) + 2/(VHCPR1(NY,NX)+VHCP0(NY,NX)) + HFLWX=(TKY-TKXR)*VHCPR1(NY,NX)*FHFLX*XDIM + FLVX=AVCNVR*(VP0-VPR)*AREA(3,NU(NY,NX),NY,NX) + IF(FLVX.GE.0.0)THEN + FLVR1=AMIN1(FLVX,VOLW0(NY,NX)*XNPHR) + IF(HFLWX.GE.0.0)THEN + FLVR1=AMIN1(FLVR1,HFLWX/(4.19*TK0X+VAP)) + ENDIF + HWFLVR1=(4.19*TK0X+VAP)*FLVR1 + ELSE + FLVR1=AMAX1(FLVX,-VOLW1(0,NY,NX)*XNPHR) + IF(HFLWX.LT.0.0)THEN + FLVR1=AMAX1(FLVR1,HFLWX/(4.19*TKXR+VAP)) + ENDIF + HWFLVR1=(4.19*TKXR+VAP)*FLVR1 + ENDIF + TK0X=TK0X-HWFLVR1/VHCP0(NY,NX) + TKXR=TKXR+HWFLVR1/VHCPR1(NY,NX) + TKY=(TKXR*VHCPR1(NY,NX)+TK0X*VHCP0(NY,NX)) + 2/(VHCPR1(NY,NX)+VHCP0(NY,NX)) + HFLWX=(TKY-TKXR)*VHCPR1(NY,NX)*FHFLX*XDIM + HFLWC=ATCNDR*(TK0X-TKXR)*AREA(3,NU(NY,NX),NY,NX) + IF(HFLWC.GE.0.0)THEN + HFLC0R1=AMAX1(0.0,AMIN1(HFLWX,HFLWC)) + ELSE + HFLC0R1=AMIN1(0.0,AMAX1(HFLWX,HFLWC)) + ENDIF + TK0X=TK0X-HFLC0R1/VHCP0(NY,NX) + TKXR=TKXR+HFLC0R1/VHCPR1(NY,NX) +C +C HEAT FLUX BETWEEN SURFACE RESIDUE AND SOIL SURFACE UNDER SNOWPACK +C + VP1=2.173E-03/TK1X + 2*0.61*EXP(5360.0*(3.661E-03-1.0/TK1X)) + 3*EXP(18.0*PSISV1/(8.3143*TK1X)) + TKY=(TKXR*VHCPR1(NY,NX)+TK1X*VHCP1(NU(NY,NX),NY,NX)) + 2/(VHCPR1(NY,NX)+VHCP1(NU(NY,NX),NY,NX)) + HFLWX=(TKXR-TKY)*VHCPR1(NY,NX)*FHFLX*XDIM + FLVX=AVCNVS*(VPR-VP1)*AREA(3,NU(NY,NX),NY,NX) + IF(FLVX.GE.0.0)THEN + FLVS1=AMIN1(FLVX,VOLW1(0,NY,NX)*XNPHR) + IF(HFLWX.GE.0.0)THEN + FLVS1=AMIN1(FLVS1,HFLWX/(4.19*TKXR+VAP)) + ENDIF + HWFLVS1=(4.19*TKXR+VAP)*FLVS1 + ELSE + FLVS1=AMAX1(FLVX,-VOLW1(NU(NY,NX),NY,NX)*XNPHR) + IF(HFLWX.LT.0.0)THEN + FLVS1=AMAX1(FLVS1,HFLWX/(4.19*TK1X+VAP)) + ENDIF + HWFLVS1=(4.19*TK1X+VAP)*FLVS1 + ENDIF + TKXR=TKXR-HWFLVS1/VHCPR1(NY,NX) + TK1X=TK1X+HWFLVS1/VHCP1(NU(NY,NX),NY,NX) + TKY=(TKXR*VHCPR1(NY,NX)+TK1X*VHCP1(NU(NY,NX),NY,NX)) + 2/(VHCPR1(NY,NX)+VHCP1(NU(NY,NX),NY,NX)) + HFLWX=(TKXR-TKY)*VHCPR1(NY,NX)*FHFLX*XDIM + HFLWC=ATCNDS*(TKXR-TK1X)*AREA(3,NU(NY,NX),NY,NX) + IF(HFLWC.GE.0.0)THEN + HFLCR11=AMAX1(0.0,AMIN1(HFLWX,HFLWC)) + ELSE + HFLCR11=AMIN1(0.0,AMAX1(HFLWX,HFLWC)) + ENDIF + TKXR=TKXR-HFLCR11/VHCPR1(NY,NX) + TK1X=TK1X+HFLCR11/VHCP1(NU(NY,NX),NY,NX) + FLVR=FLVR+FLVR1 + HWFLVR=HWFLVR+HWFLVR1 + FLVS=FLVS+FLVS1 + HWFLVS=HWFLVS+HWFLVS1 + HFLC0R=HFLC0R+HFLC0R1 + HFLCR1=HFLCR1+HFLCR11 +C IF(NX.EQ.4.AND.NY.EQ.5)THEN +C WRITE(*,1114)'FLVR0',I,J,M,NX,NY,N,TK0(NY,NX),TK1(0,NY,NX) +C 2,TK1(NU(NY,NX),NY,NX),TK0X,TKXR,TK1X,FLVR1,HWFLVR1,FLVS1 +C 4,HWFLVS1,HFLC0R1,HFLCR11,FLVR,HWFLVR,FLVS,HWFLVS +C 3,HFLC0R,HFLCR1,VPQ(NY,NX),VP0,VPR,VP1,PSISM1(0,NY,NX),PSISV1 +C 5,AVCNVR,ATCNDR,AVCNVS,ATCNDS,VHCP0(NY,NX),VHCPR1(NY,NX) +C 6,VHCP1(NU(NY,NX),NY,NX),DLYRR(NY,NX),DPTHS0(NY,NX),CNV01,CNVR1 +C 7,CNV11,CNV1,THETPX(NU(NY,NX),NY,NX),POROQ(NU(NY,NX),NY,NX) +C 2,WGSG1(NU(NY,NX),NY,NX),CVRD(NY,NX) +1114 FORMAT(A8,6I4,60E12.4) +C ENDIF +4000 CONTINUE + IF(VOLWRX(NY,NX).GT.ZEROS(NY,NX))THEN + THETWR=AMAX1(0.01,AMIN1(1.0,VOLW1(0,NY,NX)/VOLWRX(NY,NX))) + ELSE + THETWR=1.0 + ENDIF + PSISM1(0,NY,NX)=PSISE(0,NY,NX)*THETWR**FPSISR + ELSE + PSISM1(0,NY,NX)=PSISM1(NU(NY,NX),NY,NX) + ENDIF + EVAPR(NY,NX)=0.0 + RFLXR=0.0 + EFLXR=0.0 + VFLXR=0.0 + SFLXR=0.0 +C +C GATHER WATER, VAPOR AND HEAT FLUXES INTO FLUX ARRAYS +C FOR LATER UPDATES TO STATE VARIABLES +C + FLW0S(NY,NX)=FLQ0S(NY,NX)+EVAPS(NY,NX) + FLW0L(NY,NX)=FLQ0W(NY,NX)+EVAP(NY,NX)-FLV1-FLVR + HFLW0L(NY,NX)=HWFLQ0(NY,NX)+HFLW0-HWFLV1-HWFLVR-HFLC01-HFLC0R + FLWL(3,NU(NY,NX),NY,NX)=FLQM+FLV1+FLVS + FLWLX(3,NU(NY,NX),NY,NX)=FLQM+FLV1 + FLWHL(3,NU(NY,NX),NY,NX)=FLHM + HFLWL(3,NU(NY,NX),NY,NX)=HWFLQM+HWFLV1+HWFLVS+HFLC01+HFLCR1 + FLWRL(NY,NX)=FLYM+FLVR-FLVS + HFLWRL(NY,NX)=HWFLYM+HFLC0R-HFLCR1+HWFLVR-HWFLVS + FLWVL(NU(NY,NX),NY,NX)=0.0 + FLWV(NU(NY,NX),NY,NX)=FLWV(NU(NY,NX),NY,NX) + 2+FLWVL(NU(NY,NX),NY,NX) +C IF(NX.EQ.2.AND.NY.EQ.2)THEN +C WRITE(*,7753)'FLW0L',I,J,M,NX,NY,FLW0L(NY,NX) +C 2,FLQ0W(NY,NX),EVAP(NY,NX),FLV1,FLVR,VOLW0(NY,NX) +C 2,FLW0S(NY,NX),FLQ0S(NY,NX),EVAPS(NY,NX) +C 3,EVAPT,PARE,VPQ(NY,NX),VP0,TK0(NY,NX),HFLW0L(NY,NX) +C 4,HWFLQ0(NY,NX),HFLW0,HWFLV1,HWFLVR,HFLC01,HFLC0R +C WRITE(*,7753)'FLWRL',I,J,M,NX,NY,FLWRL(NY,NX) +C 3,PSISM1(0,NY,NX),PSISE(0,NY,NX) +C 2,FLYM,FLVR,FLVS,HFLWRL(NY,NX),VOLW1(0,NY,NX) +C 2,HWFLYM,HFLC0R,HFLCR1,HWFLVR,HWFLVS +7753 FORMAT(A8,5I4,30E12.4) +C ENDIF +C +C FREEZE-THAW IN SNOWPACK FROM NET CHANGE IN SNOWPACK +C HEAT STORAGE +C + TFLX=3.6785E-01*(273.15*(2.095*FLW0S(NY,NX)+4.19*FLW0L(NY,NX)) + 2+VHCP0(NY,NX)*(273.15-TK0(NY,NX))-HFLW0L(NY,NX)) + IF(TFLX.LT.0.0)THEN + TVOLWS=VOLS0(NY,NX)+0.92*VOLI0(NY,NX) + IF(TVOLWS.GT.ZEROS(NY,NX))THEN + FVOLS0=VOLS0(NY,NX)/TVOLWS + FVOLI0=0.92*VOLI0(NY,NX)/TVOLWS + ELSE + FVOLS0=0.0 + FVOLI0=0.0 + ENDIF + TFLX0(NY,NX)=AMAX1(-333.0*TVOLWS*XNPH,TFLX) + WFLXA(NY,NX)=-TFLX0(NY,NX)*FVOLS0/333.0 + WFLXB(NY,NX)=-TFLX0(NY,NX)*FVOLI0/333.0 + ELSE + TFLX0(NY,NX)=AMIN1(333.0*VOLW0(NY,NX)*XNPH,TFLX) + WFLXA(NY,NX)=0.0 + WFLXB(NY,NX)=-TFLX0(NY,NX)/333.0 + ENDIF +C +C TOTAL SNOWPACK WATER, VAPOR AND HEAT FLUXES +C + TFLWS(NY,NX)=TFLWS(NY,NX)+FLW0S(NY,NX) + 2-WFLXA(NY,NX)-FLWS1(NY,NX) + TFLWW(NY,NX)=TFLWW(NY,NX)+FLW0L(NY,NX) + 2+WFLXA(NY,NX)+WFLXB(NY,NX)-FLWZ1(NY,NX) + TFLWI(NY,NX)=TFLWI(NY,NX)-WFLXB(NY,NX)/0.92-FLWI1(NY,NX) + THFLWW(NY,NX)=THFLWW(NY,NX)+HFLW0L(NY,NX)+TFLX0(NY,NX) + 2-HFLWZ1(NY,NX)-HFLSI1(NY,NX) + HTHAWW(NY,NX)=HTHAWW(NY,NX)+TFLX0(NY,NX) + THRMG(NY,NX)=THRMG(NY,NX)+THRMX +C IF(NX.EQ.4.AND.NY.EQ.4)THEN +C WRITE(*,7754)'THFLWW',I,J,M,NX,NY,THFLWW(NY,NX) +C 2,HFLW0L(NY,NX),TFLX0(NY,NX) +C 2,HFLWZ1(NY,NX),HFLSI1(NY,NX) +C ENDIF +C +C ENERGY EXCHANGE AT SOIL SURFACE IF EXPOSED +C + ELSE +C +C PHYSICAL AND HYDRAULIC PROPERTIES OF SOIL SURFACE INCLUDING +C AIR AND WATER-FILLED POROSITY, AND WATER POTENTIAL USED IN +C FLUX CALCULATIONS +C +C IF(BKVL(NU(NY,NX),NY,NX).GT.0.0)THEN + 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) + 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 + PSISM1(NU(NY,NX),NY,NX)=-EXP(PSIMS(NY,NX) + 2+(((PSL(NU(NY,NX),NY,NX)-LOG(THETW1)) + 3/PSD(NU(NY,NX),NY,NX))**SRP(NU(NY,NX),NY,NX)*PSISD(NY,NX))) + ELSE + PSISM1(NU(NY,NX),NY,NX)=PSISE(NU(NY,NX),NY,NX) + ENDIF +C ELSE +C PSISM1(NU(NY,NX),NY,NX)=PSISE(NU(NY,NX),NY,NX) +C ENDIF + PSISV1=PSISM1(NU(NY,NX),NY,NX)+PSISO(NU(NY,NX),NY,NX) +C IF(NX.EQ.4.AND.NY.EQ.5)THEN +C WRITE(*,3232)'PSISV1',I,J,M,NX,NY,NU(NY,NX),PSISV1 +C 2,PSISM1(NU(NY,NX),NY,NX),PSISO(NU(NY,NX),NY,NX) +C 3,THETWX(NU(NY,NX),NY,NX),THETW1,POROS(NU(NY,NX),NY,NX) +C 4,PSL(NU(NY,NX),NY,NX),LOG(THETW1),PSD(NU(NY,NX),NY,NX) +C 5,SRP(NU(NY,NX),NY,NX) +3232 FORMAT(A8,6I4,12E12.4) +C ENDIF +C +C SOIL SURFACE ALBEDO, NET RADIATION +C + VOLWXG=VOLW1(NU(NY,NX),NY,NX)+VOLWH1(NU(NY,NX),NY,NX) + VOLIXG=VOLI1(NU(NY,NX),NY,NX)+VOLIH1(NU(NY,NX),NY,NX) + ALBG=(ALBS(NY,NX)*BKVL(NU(NY,NX),NY,NX)+0.06*VOLWXG + 2+0.30*VOLIXG)/(BKVL(NU(NY,NX),NY,NX)+VOLWXG+VOLIXG) + RFLX1=(1.0-ALBG)*RADXG(NY,NX)+THRYG(NY,NX) + THRMA=THRMS(NY,NX)*TK1(NU(NY,NX),NY,NX)**4 + RFLX=RFLX1-THRMA +C +C AERODYNAMIC RESISTANCE ABOVE SOIL SURFACE INCLUDING +C RESISTANCE IMPOSED BY PLANT CANOPY +C + RAR1=RAR(NY,NX)/AMAX1(THETX,THETPX(0,NY,NX))**2.33 + RAGZ=RAG(NY,NX)+RAR1 + RI=AMAX1(-0.3,AMIN1(0.075,RIB(NY,NX)*(TKQ(NY,NX) + 2-TK1(NU(NY,NX),NY,NX)))) + RAGX=AMAX1(RAM,0.75*RAGS(NY,NX),AMIN1(1.33*RAGS(NY,NX) + 2,RAGZ/(1.0-10.0*RI))) + RAGS(NY,NX)=RAGX + RA=RAGX +C +C PARAMETERS FOR CALCULATING LATENT AND SENSIBLE HEAT FLUXES +C + PARE=PAREG(NY,NX)/(RA+RZ) + PARS=PARSG(NY,NX)/RA + TKX1=TK1(NU(NY,NX),NY,NX) + VP1=2.173E-03/TKX1 + 2*0.61*EXP(5360.0*(3.661E-03-1.0/TKX1)) + 3*EXP(18.0*PSISV1/(8.3143*TKX1)) + EVAP(NY,NX)=AMAX1(PARE*(VPQ(NY,NX)-VP1) + 2,-AMAX1(0.0,VOLW1(NU(NY,NX),NY,NX))*XNPH) + EVAPS(NY,NX)=0.0 + EFLX=EVAP(NY,NX)*VAP + IF(EVAP(NY,NX).LT.0.0)THEN + VFLX=EVAP(NY,NX)*4.19*TK1(NU(NY,NX),NY,NX) + ELSE + VFLX=EVAP(NY,NX)*4.19*TKQ(NY,NX) + ENDIF +C IF(NX.EQ.4.AND.NY.EQ.5)THEN +C WRITE(*,3376)'EVAP',I,J,M,NX,NY,EVAP(NY,NX),RFLX,RFLX1,THRMA +C 3,THETPX(0,NY,NX),VHCPR1(NY,NX),CVRD(NY,NX) +C 2,PARE,VPQ(NY,NX),VP1,RA,RAZ,RAGS(NY,NX),RI,RAR1,RAR(NY,NX),RAGZ +C 3,RAG(NY,NX),RIB(NY,NX),TKX1,PSISV1,VOLW1(NU(NY,NX),NY,NX) +C 4,DLYRR(NY,NX),WGSGR(NY,NX),VOLX(0,NY,NX),ORGC(0,NY,NX) +C 5,VOLA(0,NY,NX),VOLW1(0,NY,NX),VOLI1(0,NY,NX),VOLP1(0,NY,NX) +C ENDIF +C +C SOLVE FOR SOIL SURFACE TEMPERATURE AT WHICH ENERGY +C BALANCE OCCURS, SOLVE LATENT, SENSIBLE AND STORAGE HEAT FLUXES +C + SFLX=PARS*(TKQ(NY,NX)-TK1(NU(NY,NX),NY,NX)) + HFLW1=RFLX+EFLX+SFLX+VFLX +C IF(I.EQ.208)THEN +C WRITE(*,1112)'EFLX',I,J,M,NX,NY,TK1(NU(NY,NX),NY,NX) +C 2,RFLX,EFLX,SFLX,VFLX,HFLW1,RA,RAC(NY,NX),RAG(NY,NX),RAS1,RAGZ,RAR1 +C 3,RAGX,RI,RAGS(NY,NX),VOLW1(NU(NY,NX),NY,NX),VOLI1(NU(NY,NX),NY,NX) +C 4,RADXG(NY,NX),THRYG(NY,NX),THRMA,THRYW(NY,NX),THS(NY,NX) +C 5,BARE(NY,NX),PARG(NY,NX),VPQ(NY,NX),VP1,FRADG(NY,NX),THRMCX(NY,NX) +C 5,PSISM1(NU(NY,NX),NY,NX),PSISO(NU(NY,NX),NY,NX) +C 6,FLQM,EVAP(NY,NX),PARE,HFLW1,PARS,PARSG(NY,NX),HWFLQM +C 7,ATCNDS,TCND1,THETPY(NU(NY,NX),NY,NX),RAR(NY,NX),THETPY(0,NY,NX) +C 8,VHCP1(NU(NY,NX),NY,NX),PARS +C 3,TKQ(NY,NX) +1112 FORMAT(A8,5I4,60E12.4) +C ENDIF +C +C ENERGY BALANCE AT RESIDUE SURFACE +C + IF(VHCPR1(NY,NX).GT.VHCPRX(NY,NX))THEN +C +C PARAMETERS FOR CALCULATING LATENT AND SENSIBLE HEAT FLUXES +C + EVAPR(NY,NX)=0.0 + RFLXR=0.0 + EFLXR=0.0 + VFLXR=0.0 + SFLXR=0.0 + HFLR1=0.0 + FLV1=0.0 + HWFLV1=0.0 + HFLCR1=0.0 + THRMZ=0.0 +C +C NET RADIATION AT RESIDUE SURFACE +C + ALBR=(0.20*BKVL(0,NY,NX)+0.06*VOLW1(0,NY,NX)+0.30 + 2*VOLI1(0,NY,NX))/(BKVL(0,NY,NX)+VOLW1(0,NY,NX)+VOLI1(0,NY,NX)) + RFLX1=(1.0-ALBR)*RADXR(NY,NX)+THRYR(NY,NX) + TKR1=TK1(0,NY,NX) + VOLWR2=VOLW1(0,NY,NX) + VHCPR2=VHCPR1(NY,NX) + TKS1=TK1(NU(NY,NX),NY,NX) + HFLW2=HFLW1*XNPR + VOLW12=VOLW1(NU(NY,NX),NY,NX) + VHCP12=VHCP1(NU(NY,NX),NY,NX) +C +C THERMAL CONDUCTIVITY BETWEEN SURFACE RESIDUE AND SOIL SURFACE +C + CNVR=THETPX(0,NY,NX)**2/POROQ(0,NY,NX)*WGSGR0(NY,NX)*XNPR + CNV1=THETPX(NU(NY,NX),NY,NX)**2/POROQ(NU(NY,NX),NY,NX)*XNPR + 2*WGSG1(NU(NY,NX),NY,NX) + IF(CVRD(NY,NX).GT.ZERO)THEN + IF(CNVR.GT.ZERO.AND.CNV1.GT.ZERO)THEN + AVCNVS=2.0*CNVR*CNV1 + 2/(CNVR*DLYR(3,NU(NY,NX),NY,NX)+CNV1*DLYRR(NY,NX))*CVRD(NY,NX) + ELSE + AVCNVS=2.0*CNVR + 2/(DLYR(3,NU(NY,NX),NY,NX)+DLYRR(NY,NX))*CVRD(NY,NX) + ENDIF + ELSE + AVCNVS=0.0 + ENDIF + THETRR=AMAX1(0.0,1.0-THETPX(0,NY,NX)-THETWX(0,NY,NX) + 2-THETIX(0,NY,NX)) + DTKX=ABS(TK1(0,NY,NX)-TK1(NU(NY,NX),NY,NX))*1.0E-06 + DTHW0=AMAX1(0.0,THETWX(0,NY,NX)-TRBW)**3 + DTHA0=AMAX1(0.0,THETPX(0,NY,NX)-TRBA)**3 + DTHW1=AMAX1(0.0,THETWX(NU(NY,NX),NY,NX)-TRBW)**3 + DTHA1=AMAX1(0.0,THETPX(NU(NY,NX),NY,NX)-TRBA)**3 + RYLXW0=DTKX*DTHW0 + RYLXA0=DTKX*DTHA0 + RYLXW1=DTKX*DTHW1 + RYLXA1=DTKX*DTHA1 + RYLNW0=AMIN1(1.0E+04,RYLXW*RYLXW0) + RYLNA0=AMIN1(1.0E+04,RYLXA*RYLXA0) + RYLNW1=AMIN1(1.0E+04,RYLXW*RYLXW1) + RYLNA1=AMIN1(1.0E+04,RYLXA*RYLXA1) + XNUSW0=AMAX1(1.0,0.68+0.67*RYLNW0**0.25/DNUSW) + XNUSA0=AMAX1(1.0,0.68+0.67*RYLNA0**0.25/DNUSA) + XNUSW1=AMAX1(1.0,0.68+0.67*RYLNW1**0.25/DNUSW) + XNUSA1=AMAX1(1.0,0.68+0.67*RYLNA1**0.25/DNUSA) + TCNDW0=2.067E-03*XNUSW0 + TCNDA0=9.050E-05*XNUSA0 + TCNDW1=2.067E-03*XNUSW1 + TCNDA1=9.050E-05*XNUSA1 + WTHET0=1.467-0.467*THETPY(0,NY,NX) + TCNDR=(0.779*THETRR*9.050E-04+0.622*THETWX(0,NY,NX)*TCNDW0 + 2+0.380*THETIX(0,NY,NX)*7.844E-03 + 3+WTHET0*THETPX(0,NY,NX)*TCNDA0) + 4/(0.779*THETRR+0.622*THETWX(0,NY,NX) + 5+0.380*THETIX(0,NY,NX)+WTHET0*THETPX(0,NY,NX)) + TCNDR1=TCNDR*XNPHR + WTHET1=1.467-0.467*THETPY(NU(NY,NX),NY,NX) + TCND1=(STC(NU(NY,NX),NY,NX)+THETWX(NU(NY,NX),NY,NX)*TCNDW1 + 2+0.611*THETIX(NU(NY,NX),NY,NX)*7.844E-03 + 3+WTHET1*THETPX(NU(NY,NX),NY,NX)*TCNDA1) + 4/(DTC(NU(NY,NX),NY,NX)+THETWX(NU(NY,NX),NY,NX) + 5+0.611*THETIX(NU(NY,NX),NY,NX)+WTHET1*THETPX(NU(NY,NX),NY,NX)) + TCND1R=TCND1*XNPHR + ATCNDR=2.0*TCNDR1*TCND1R/(TCNDR1*DLYR(3,NU(NY,NX),NY,NX) + 2+TCND1R*DLYRR(NY,NX))*CVRD(NY,NX) +C +C SMALLER TIME STEP FOR SOLVING SURFACE RESIDUE ENERGY EXCHANGE +C + DO 5000 N=1,NPR + IF(VHCPR2.GT.VHCPRX(NY,NX))THEN +C +C AERODYNAMIC RESISTANCE ABOVE RESIDUE INCLUDING +C RESISTANCE IMPOSED BY PLANT CANOPY +C + RI=AMAX1(-0.3,AMIN1(0.075,RIB(NY,NX)*(TKQ(NY,NX)-TKR1))) + RAGX=AMAX1(RAM,0.75*RAGR(NY,NX),AMIN1(1.33*RAGR(NY,NX) + 2,RARG(NY,NX)/(1.0-10.0*RI))) + RAGR(NY,NX)=RAGX + RA=RAGX + PARE=PARER(NY,NX)/(RA+RZR) + PARS=PARSR(NY,NX)/RA +C +C NET RADIATION AT RESIDUE SURFACE +C + THRMZ2=THRMR(NY,NX)*TKR1**4 + RFLXR2=RFLX1-THRMZ2 + IF(VOLWRX(NY,NX).GT.ZEROS(NY,NX))THEN + THETWR=AMAX1(0.01,AMIN1(1.0,VOLWR2/VOLWRX(NY,NX))) + ELSE + THETWR=1.0 + ENDIF + PSISM1(0,NY,NX)=PSISE(0,NY,NX)*THETWR**-4.0 +C +C VAPOR FLUX AT RESIDUE SURFACE +C + VPR=2.173E-03/TKR1 + 2*0.61*EXP(5360.0*(3.661E-03-1.0/TKR1)) + 3*EXP(18.0*PSISM1(0,NY,NX)/(8.3143*TKR1)) + VP1=2.173E-03/TKS1 + 2*0.61*EXP(5360.0*(3.661E-03-1.0/TKS1)) + 3*EXP(18.0*PSISV1/(8.3143*TKS1)) + EVAPR2=AMIN1(VOLWRM*XNPHR,AMAX1(-AMAX1(0.0,VOLWR2)*XNPHR + 2,PARE*(VPQ(NY,NX)-VPR))) + EFLXR2=EVAPR2*VAP + VFLXR2=EVAPR2*4.19*TKR1 +C +C SOLVE FOR RESIDUE SURFACE TEMPERATURE AT WHICH ENERGY +C BALANCE OCCURS, SOLVE LATENT, SENSIBLE AND STORAGE HEAT FLUXES +C + TKY=(TKR1*VHCPR2+TKS1*VHCP12)/(VHCPR2+VHCP12) + HFLWX=(TKR1-TKY)*VHCPR2*FHFLX*XDIM + FLVX=AVCNVS*(VPR-VP1)*AREA(3,NU(NY,NX),NY,NX) + IF(FLVX.GE.0.0)THEN + FLV2=AMIN1(FLVX,VOLWR2*XNPHR) + IF(HFLWX.GE.0.0)THEN + FLV2=AMIN1(FLV2,HFLWX/(4.19*TKR1+VAP)) + ENDIF + HWFLV2=(4.19*TKR1+VAP)*FLV2 + ELSE + FLV2=AMAX1(FLVX,-VOLW12*XNPHR) + IF(HFLWX.LT.0.0)THEN + FLV2=AMAX1(FLV2,HFLWX/(4.19*TKS1+VAP)) + ENDIF + HWFLV2=(4.19*TKS1+VAP)*FLV2 + ENDIF + TKXR=TKR1-HWFLV2/VHCPR2 + TK1X=TKS1+HWFLV2/VHCP12 + TKY=(TKXR*VHCPR2+TK1X*VHCP12)/(VHCPR2+VHCP12) + HFLWX=(TKXR-TKY)*VHCPR2*FHFLX*XDIM + HFLWC=ATCNDR*(TKXR-TK1X)*AREA(3,0,NY,NX) + IF(HFLWC.GE.0.0)THEN + HFLCR2=AMAX1(0.0,AMIN1(HFLWX,HFLWC)) + ELSE + HFLCR2=AMIN1(0.0,AMAX1(HFLWX,HFLWC)) + ENDIF + SFLXR2=PARS*(TKQ(NY,NX)-TKR1) + HFLR2=RFLXR2+EFLXR2+SFLXR2+VFLXR2 +C +C AGGREGATE WATER AND ENERGY FLUXES FROM RESIDUE TIME STEP +C TO MODEL TIME STEP +C + EVAPR(NY,NX)=EVAPR(NY,NX)+EVAPR2 + RFLXR=RFLXR+RFLXR2 + EFLXR=EFLXR+EFLXR2 + VFLXR=VFLXR+VFLXR2 + SFLXR=SFLXR+SFLXR2 + HFLR1=HFLR1+HFLR2 + FLV1=FLV1+FLV2 + HWFLV1=HWFLV1+HWFLV2 + HFLCR1=HFLCR1+HFLCR2 + THRMZ=THRMZ+THRMZ2 + ELSE + EVAPR2=0.0 + RFLXR2=0.0 + EFLXR2=0.0 + VFLXR2=0.0 + SFLXR2=0.0 + HFLR2=0.0 + FLV2=0.0 + HWFLV2=0.0 + HFLCR2=0.0 + THRMZ2=0.0 + ENDIF + VOLWR2=VOLWR2+FLYM2+EVAPR2-FLV2 + VOLW12=VOLW12+FLV2 + ENGYR=VHCPR2*TKR1 + VHCPR2=2.496E-06*ORGC(0,NY,NX)+4.19*VOLWR2 + 2+1.9274*VOLI1(0,NY,NX) + VHCP12=VHCP12+4.19*FLV2 + TKR1=(ENGYR+HWFLM2+HFLR2-HWFLV2-HFLCR2)/VHCPR2 + TKS1X=TKS1 + TKS1=TKS1+(HFLW2+HWFLV2+HFLCR2)/VHCP12 +C IF(NX.EQ.1.AND.NY.EQ.6)THEN +C WRITE(*,1111)'EFLXR2',I,J,M,NX,NY,N,TKR1,TKS1,TKQ(NY,NX) +C 2,EFLXR2,SFLXR2,VFLXR2,FLV2,FLVX,VPR,VP1,AVCNVS,PSISE(0,NY,NX) +C 3,PSISM1(0,NY,NX),PSISV1,THETWR,VOLWR2,VOLWRX(NY,NX),TRC0(NY,NX) +C 4,PARS,PARE,RA,RZR,RI,TKQ(NY,NX),VOLWR2,VOLW12,HFLWX,FLV1 +C 5,VOLW1(NU(NY,NX),NY,NX),THRMZ2,VOLW1(0,NY,NX) +C 3,HWFLV2,HFLCR2,HWFLM2,RA,RAGX,RAG(NY,NX),RAB(NY,NX),RAC(NY,NX) +C 4,RZR,RZ,PARS +C 4,RAR1,PARE,VPQ(NY,NX),EVAPR(NY,NX),EVAPR2 +C 5,VHCPR2,VHCP12,CNVR,CNV1,VOLX(0,NY,NX) +C 5,ATCNDR,TCNDR,TCNDR1,TCND1R,DLYR(3,NU(NY,NX),NY,NX) +C 6,DLYRR(NY,NX),DLYR(3,0,NY,NX),POROQ(0,NY,NX),WGSGR(NY,NX) +C 7,THETWX(0,NY,NX),THETIX(0,NY,NX),THETPY(0,NY,NX),ORGC(0,NY,NX) +C 8,CVRD(NY,NX),EFLXR,EFLX,TRA0(NY,NX),ATCNDR*(TKR1-TKS1),TKS1X +1111 FORMAT(A8,6I4,100E12.4) +C ENDIF +5000 CONTINUE +C +C IF NO SURFACE RESIDUE +C + ELSE + TK1(0,NY,NX)=TK1(NU(NY,NX),NY,NX) + EVAPR(NY,NX)=0.0 + RFLXR=0.0 + EFLXR=0.0 + VFLXR=0.0 + SFLXR=0.0 + HFLR1=0.0 + FLV1=0.0 + HWFLV1=0.0 + HFLCR1=0.0 + THRMZ=0.0 + ENDIF +C +C GATHER WATER, VAPOR AND HEAT FLUXES INTO FLUX ARRAYS +C FOR LATER UPDATES TO STATE VARIABLES +C + FLWL(3,NU(NY,NX),NY,NX)=FLQM+EVAP(NY,NX)+FLV1 + FLWLX(3,NU(NY,NX),NY,NX)=FLQM+EVAP(NY,NX)+FLV1 + FLWHL(3,NU(NY,NX),NY,NX)=FLHM + HFLWL(3,NU(NY,NX),NY,NX)=HWFLQM+HFLW1+HWFLV1+HFLCR1 + FLWRL(NY,NX)=FLYM+EVAPR(NY,NX)-FLV1 + HFLWRL(NY,NX)=HWFLYM+HFLR1-HWFLV1-HFLCR1 + FLWVL(NU(NY,NX),NY,NX)=RFLWV(NY,NX)*(VOLW1(NU(NY,NX),NY,NX) + 2-VOLWX1(NU(NY,NX),NY,NX)) + FLWV(NU(NY,NX),NY,NX)=FLWV(NU(NY,NX),NY,NX) + 2+FLWVL(NU(NY,NX),NY,NX) +C IF(NX.EQ.1.AND.NY.EQ.6)THEN +C WRITE(*,3376)'FLW1',I,J,M,NX,NY,FLWL(3,NU(NY,NX),NY,NX) +C 2,PSISM1(0,NY,NX),PSISM1(NU(NY,NX),NY,NX),VOLWRX(NY,NX) +C 3,VOLW1(0,NY,NX),VOLW1(NU(NY,NX),NY,NX),THETWX(NU(NY,NX),NY,NX) +C 2,FLQM,EVAP(NY,NX),PARE,VPQ(NY,NX),VP1 +C 4,FLWRL(NY,NX),FLYM,EVAPR(NY,NX),FLV1 +C WRITE(*,3376)'HFLW1',I,J,M,NX,NY,HFLWL(3,NU(NY,NX),NY,NX) +C 2,HWFLQM,HFLW1,HWFLV1,HFLCR1,HFLWRL(NY,NX),HWFLYM +C 3,HFLR1,HWFLV1,HFLCR1 +3376 FORMAT(A8,5I4,40E12.4) +C ENDIF +C +C HEAT AND WATER TRANSFER WITH RESIDUAL SNOWPACK +C + TFLWS(NY,NX)=TFLWS(NY,NX)+FLQ0S(NY,NX)-FLWS1(NY,NX) + TFLWW(NY,NX)=TFLWW(NY,NX)+FLQ0W(NY,NX)-FLWZ1(NY,NX) + TFLWI(NY,NX)=TFLWI(NY,NX)-FLWI1(NY,NX) + THFLWW(NY,NX)=THFLWW(NY,NX)+HWFLQ0(NY,NX)-HFLWZ1(NY,NX) + 2-HFLSI1(NY,NX) + THRMG(NY,NX)=THRMG(NY,NX)+THRMA+THRMZ +C IF(NX.EQ.4.AND.NY.EQ.4)THEN +C WRITE(*,7754)'THFLWS',I,J,M,NX,NY,THFLWW(NY,NX) +C 2,HWFLQ0(NY,NX),HFLWZ1(NY,NX) +C 2-HFLSI1(NY,NX) +C ENDIF + ENDIF +C +C CAPILLARY EXCHANGE OF WATER BETWEEN SOIL SURFACE AND RESIDUE +C + CNDR=HCNDR(NY,NX)*(PSISE(0,NY,NX)/PSISM1(0,NY,NX))**3 + IF(VOLW1(0,NY,NX).GE.VOLWRX(NY,NX))THEN + CND1=HCND(3,1,NU(NY,NX),NY,NX)*XNPH + ELSE + K1=MAX(1,MIN(100,INT(100.0*(AMAX1(0.0,POROS(NU(NY,NX),NY,NX) + 2-THETWX(NU(NY,NX),NY,NX)))/POROS(NU(NY,NX),NY,NX))+1)) + CND1=HCND(3,K1,NU(NY,NX),NY,NX)*XNPH + ENDIF + AVCND1=2.0*CNDR*CND1/(CNDR*DLYR(3,NU(NY,NX),NY,NX) + 2+CND1*DLYRR(NY,NX)) + FLXQR=AVCND1*(PSISM1(0,NY,NX)-PSISM1(NU(NY,NX),NY,NX)) + 2*AREA(3,NU(NY,NX),NY,NX) + IF(FLXQR.LT.0.0)THEN + FLXSR=AMAX1(FLXQR,-XNPH*AMIN1(VOLW1(NU(NY,NX),NY,NX) + 2,AMAX1(0.0,VOLWRX(NY,NX)-VOLW1(0,NY,NX)-VOLI1(0,NY,NX)))) + ELSE + FLXSR=AMIN1(FLXQR,XNPH*VOLW1(0,NY,NX)) + FLXSR=AMIN1(FLXSR,XNPH*VOLP1(NU(NY,NX),NY,NX)) + ENDIF + IF(FLXSR.GT.0.0)THEN + HFLXSR=4.19*TK1(0,NY,NX)*FLXSR + ELSE + HFLXSR=4.19*TK1(NU(NY,NX),NY,NX)*FLXSR + ENDIF + FLWL(3,NU(NY,NX),NY,NX)=FLWL(3,NU(NY,NX),NY,NX)+FLXSR + HFLWL(3,NU(NY,NX),NY,NX)=HFLWL(3,NU(NY,NX),NY,NX)+HFLXSR + FLWRL(NY,NX)=FLWRL(NY,NX)-FLXSR + HFLWRL(NY,NX)=HFLWRL(NY,NX)-HFLXSR + FLWRM(M,NY,NX)=FLXSR +C IF(NX.EQ.1.AND.NY.EQ.6)THEN +C WRITE(*,4322)'FLWLY',I,J,M,NX,NY,FLWRL(NY,NX),FLWLY,FLWLYR +C 2,FLWLYH,FLXSR,VOLX(NU(NY,NX),NY,NX),VOLA(NU(NY,NX),NY,NX) +C 3,VOLP1(NU(NY,NX),NY,NX),VOLW1(NU(NY,NX),NY,NX) +C 3,VOLI1(NU(NY,NX),NY,NX),VOLP1(0,NY,NX),VOLW1(0,NY,NX) +C 3,VOLI1(0,NY,NX),FLXQR,PSISM1(0,NY,NX) +C 4,PSISM1(NU(NY,NX),NY,NX),AVCND1 +C 2,VOLAH1(NU(NY,NX),NY,NX),VOLPH1(NU(NY,NX),NY,NX) +C 2,VOLWH1(NU(NY,NX),NY,NX),VOLIH1(NU(NY,NX),NY,NX) +4322 FORMAT(A8,5I4,40E12.4) +C ENDIF +C +C MOVE WATER UP DURING PRECIPITATION OR FREEZING +C + IF(VOLW1(NU(NY,NX),NY,NX)+VOLI1(NU(NY,NX),NY,NX) + 2.GT.VOLA(NU(NY,NX),NY,NX))THEN + FLWLY=AMIN1(0.0,AMAX1(-XNPH*VOLW1(NU(NY,NX),NY,NX) + 2,VOLA(NU(NY,NX),NY,NX)-VOLW1(NU(NY,NX),NY,NX) + 3-VOLI1(NU(NY,NX),NY,NX))) + HFLWLY=FLWLY*4.19*TK1(NU(NY,NX),NY,NX) + FLWL(3,NU(NY,NX),NY,NX)=FLWL(3,NU(NY,NX),NY,NX)+FLWLY + HFLWL(3,NU(NY,NX),NY,NX)=HFLWL(3,NU(NY,NX),NY,NX)+HFLWLY + FLWLYR=AMIN1(0.0,FLWLY+VOLPH1(NU(NY,NX),NY,NX)) + HFLWYR=FLWLYR*4.19*TK1(NU(NY,NX),NY,NX) + FLWLYH=FLWLY-FLWLYR + HFLWYH=FLWLYH*4.19*TK1(NU(NY,NX),NY,NX) + FLWRL(NY,NX)=FLWRL(NY,NX)-FLWLYR + HFLWRL(NY,NX)=HFLWRL(NY,NX)-HFLWYR + FLWHL(3,NU(NY,NX),NY,NX)=FLWHL(3,NU(NY,NX),NY,NX)-FLWLYH + HFLWL(3,NU(NY,NX),NY,NX)=HFLWL(3,NU(NY,NX),NY,NX)-HFLWYH + ENDIF + IF(VOLWH1(NU(NY,NX),NY,NX)+VOLIH1(NU(NY,NX),NY,NX) + 2.GT.VOLAH1(NU(NY,NX),NY,NX))THEN + FLWHY=AMIN1(0.0,AMAX1(-XNPH*VOLWH1(NU(NY,NX),NY,NX) + 2,VOLAH1(NU(NY,NX),NY,NX)-VOLWH1(NU(NY,NX),NY,NX) + 3-VOLIH1(NU(NY,NX),NY,NX))) + HFLWHY=FLWHY*4.19*TK1(NU(NY,NX),NY,NX) + FLWHL(3,NU(NY,NX),NY,NX)=FLWHL(3,NU(NY,NX),NY,NX)+FLWHY + HFLWL(3,NU(NY,NX),NY,NX)=HFLWL(3,NU(NY,NX),NY,NX)+HFLWHY + FLWRL(NY,NX)=FLWRL(NY,NX)-FLWHY + HFLWRL(NY,NX)=HFLWRL(NY,NX)-HFLWHY +C IF(NX.EQ.1.AND.NY.EQ.6)THEN +C WRITE(*,4324)'FLWHY',I,J,M,NX,NY,FLWRL(NY,NX),FLWHY +C 2,VOLAH1(NU(NY,NX),NY,NX),VOLPH1(NU(NY,NX),NY,NX) +C 2,VOLWH1(NU(NY,NX),NY,NX),VOLIH1(NU(NY,NX),NY,NX) +C 2,VOLAH1(NU(NY,NX)+1,NY,NX),VOLPH1(NU(NY,NX)+1,NY,NX) +C 2,VOLWH1(NU(NY,NX)+1,NY,NX),VOLIH1(NU(NY,NX)+1,NY,NX) +C 3,VOLW1(0,NY,NX) +4324 FORMAT(A8,5I4,30E12.4) +C ENDIF + ENDIF +C IF((I/10)*10.EQ.I)THEN +C WRITE(*,4321)'HCNDR',I,J,M,NX,NY,K1,AVCND1,CNDR,CND1,DLYRR(NY,NX) +C 2,PSISM1(0,NY,NX),PSISM1(NU(NY,NX),NY,NX),FLXQR,FLXSR,HFLXSR +C 3,VOLWR2,TRA0(NY,NX),EVAPR(NY,NX),VOLWRX(NY,NX)-VOLW1(0,NY,NX) +C 2-VOLI1(0,NY,NX),VOLW1(NU(NY,NX),NY,NX),VOLW1(0,NY,NX) +C 4,VOLP1(NU(NY,NX),NY,NX),POROS(NU(NY,NX),NY,NX) +C 5,VOLWG(NY,NX),FLYM,HCNDR(NY,NX),PSISE(0,NY,NX),PSISM1(0,NY,NX) +C 6,THETWR,VHCPR1(NY,NX),VHCPRX(NY,NX) +4321 FORMAT(A8,6I4,30E12.4) +C ENDIF +C +C OVERLAND FLOW INTO MACROPORES WHEN WATER STORAGE CAPACITY +C OF THE SOIL SURFACE IS EXCEEDED +C + IF(VOLPH1(NU(NY,NX),NY,NX).GT.0.0)THEN + IF(VOLW1(0,NY,NX).GT.VOLWRX(NY,NX))THEN + AVCNH1=2.0*CNDH1(NU(NY,NX),NY,NX)/DLYR(3,NU(NY,NX),NY,NX) + FLWHX=AVCNH1*0.0098*DPTH(NU(NY,NX),NY,NX)*AREA(3,NU(NY,NX),NY,NX) + FINHR=AMIN1(VOLPH1(NU(NY,NX),NY,NX) + 2,VOLW1(0,NY,NX)-VOLWRX(NY,NX),FLWHX) + HFINHR=FINHR*4.19*TK1(0,NY,NX) + FLWRL(NY,NX)=FLWRL(NY,NX)-FINHR + HFLWRL(NY,NX)=HFLWRL(NY,NX)-HFINHR + FLWHL(3,NU(NY,NX),NY,NX)=FLWHL(3,NU(NY,NX),NY,NX)+FINHR + HFLWL(3,NU(NY,NX),NY,NX)=HFLWL(3,NU(NY,NX),NY,NX)+HFINHR +C IF(NX.EQ.1.AND.NY.EQ.6)THEN +C WRITE(*,4357)'FINHR',I,J,M,NX,NY,FLWRL(NY,NX),FINHR +C 2,VOLPH1(NU(NY,NX),NY,NX),TVOLW(NY,NX),FLWHX,VOLW1(0,NY,NX) +C 3,VOLWRX(NY,NX),FLWHL(3,NU(NY,NX),NY,NX) +C 4,HFINHR,TK1(0,NY,NX),HFLWRL(NY,NX),HFLWL(3,NU(NY,NX),NY,NX) +4357 FORMAT(A8,5I4,40E12.4) +C ENDIF + ENDIF + ENDIF +C +C FREEZE-THAW IN RESIDUE SURFACE FROM NET CHANGE IN RESIDUE +C SURFACE HEAT STORAGE +C + TFREEZ=-9.0959E+04/(PSISM1(0,NY,NX)-333.0) + IF((TK1(0,NY,NX).LT.TFREEZ + 2.AND.VOLW1(0,NY,NX).GT.ZERO*VOLA(0,NY,NX)) + 3.OR.(TK1(0,NY,NX).GT.TFREEZ + 4.AND.VOLI1(0,NY,NX).GT.ZERO*VOLA(0,NY,NX)))THEN + TFLX1=1.0/(1.0+TFREEZ*6.2913E-03) + 2*(TFREEZ*4.19*FLWRL(NY,NX) + 3+VHCPR1(NY,NX)*(TFREEZ-TK1(0,NY,NX)) + 4-HFLWRL(NY,NX)) + IF(TFLX1.LT.0.0)THEN + TFLX=AMAX1(-333.0*0.92*VOLI1(0,NY,NX)*XNPH + 2,-VHCPR1(NY,NX)*XNPH,TFLX1) + ELSE + TFLX=AMIN1(333.0*VOLW1(0,NY,NX)*XNPH + 2,VHCPR1(NY,NX)*XNPH,TFLX1) + ENDIF + WFLX=-TFLX/333.0 + IF(WFLX.GT.0.0.AND.VOLI1(0,NY,NX) + 2.GT.ZEROS(NY,NX))THEN + WFLXR(NY,NX)=WFLX + TFLXR(NY,NX)=TFLX + ELSEIF(WFLX.LT.0.0.AND.VOLW1(0,NY,NX) + 2.GT.ZEROS(NY,NX))THEN + WFLXR(NY,NX)=WFLX + TFLXR(NY,NX)=TFLX + ELSE + WFLXR(NY,NX)=0.0 + TFLXR(NY,NX)=0.0 + ENDIF + ELSE + WFLXR(NY,NX)=0.0 + TFLXR(NY,NX)=0.0 + ENDIF +C WRITE(*,5352)'TFLXR',I,J,M,WFLXR(NY,NX),TFLXR(NY,NX) +C 2,PSISV0,THETWR,TFLX,WFLX,VOLI1(0,NY,NX),VOLW1(0,NY,NX) +C 3,TKXR,TFREEZ,PSISV0 +5352 FORMAT(A8,3I4,20E12.4) +C +C FREEZE-THAW IN SOIL SURFACE MICROPORE FROM NET CHANGE IN SOIL +C SURFACE HEAT STORAGE +C + TFREEZ=-9.0959E+04/(PSISV1-333.0) + IF((TK1(NU(NY,NX),NY,NX).LT.TFREEZ + 2.AND.VOLW1(NU(NY,NX),NY,NX).GT.ZERO*VOLA(NU(NY,NX),NY,NX) + 3.AND.VOLI1(NU(NY,NX),NY,NX).LT.VOLA(NU(NY,NX),NY,NX)) + 4.OR.(TK1(NU(NY,NX),NY,NX).GT.TFREEZ + 5.AND.VOLI1(NU(NY,NX),NY,NX).GT.ZERO*VOLA(NU(NY,NX),NY,NX)))THEN + TFLX1=FGRD(NU(NY,NX),NY,NX)*(1.0/(1.0+TFREEZ*6.2913E-03) + 2*(TFREEZ*4.19*(FLWL(3,NU(NY,NX),NY,NX)+FLWHL(3,NU(NY,NX),NY,NX)) + 3+VHCP1(NU(NY,NX),NY,NX)*(TFREEZ-TK1(NU(NY,NX),NY,NX)) + 4-HFLWL(3,NU(NY,NX),NY,NX))) + IF(TFLX1.LT.0.0)THEN + TFLX=AMAX1(-333.0*0.92*VOLI1(NU(NY,NX),NY,NX)*XNPH,TFLX1) + ELSE + TFLX=AMIN1(333.0*VOLW1(NU(NY,NX),NY,NX)*XNPH,TFLX1) + ENDIF + WFLX=-TFLX/333.0 + IF(WFLX.GT.0.0.AND.VOLI1(NU(NY,NX),NY,NX) + 2.GT.ZEROS(NY,NX))THEN + WFLXL(3,NU(NY,NX),NY,NX)=WFLX + ELSEIF(WFLX.LT.0.0.AND.VOLW1(NU(NY,NX),NY,NX) + 2.GT.ZEROS(NY,NX))THEN + WFLXL(3,NU(NY,NX),NY,NX)=WFLX + ELSE + TFLX=0.0 + WFLXL(3,NU(NY,NX),NY,NX)=0.0 + ENDIF + ELSE + TFLX=0.0 + WFLXL(3,NU(NY,NX),NY,NX)=0.0 + ENDIF +C +C FREEZE-THAW IN SOIL SURFACE MACROPORE FROM NET CHANGE IN SOIL +C SURFACE HEAT STORAGE +C + IF((TK1(NU(NY,NX),NY,NX).LT.273.15.AND.VOLWH1(NU(NY,NX),NY,NX) + 2.GT.ZERO*VOLT(NU(NY,NX),NY,NX)).OR.(TK1(NU(NY,NX),NY,NX) + 3.GT.273.15.AND.VOLIH1(NU(NY,NX),NY,NX) + 4.GT.ZERO*VOLT(NU(NY,NX),NY,NX)))THEN + TFLX1=FMAC(NU(NY,NX),NY,NX)*(1.0/(1.0+273.15*6.2913E-03) + 2*(273.15*4.19*(FLWL(3,NU(NY,NX),NY,NX)+FLWHL(3,NU(NY,NX),NY,NX)) + 3+VHCP1(NU(NY,NX),NY,NX)*(273.15-TK1(NU(NY,NX),NY,NX)) + 4-HFLWL(3,NU(NY,NX),NY,NX))) + IF(TFLX1.LT.0.0)THEN + TFLXH=AMAX1(-333.0*0.92*VOLIH1(NU(NY,NX),NY,NX)*XNPH,TFLX1) + ELSE + TFLXH=AMIN1(333.0*VOLWH1(NU(NY,NX),NY,NX)*XNPH,TFLX1) + ENDIF + WFLXH=-TFLXH/333.0 + IF(WFLXH.GT.0.0.AND.VOLIH1(NU(NY,NX),NY,NX) + 2.GT.ZEROS(NY,NX))THEN + WFLXLH(3,NU(NY,NX),NY,NX)=WFLXH + ELSEIF(WFLXH.LT.0.0.AND.VOLWH1(NU(NY,NX),NY,NX) + 2.GT.ZEROS(NY,NX))THEN + WFLXLH(3,NU(NY,NX),NY,NX)=WFLXH + ELSE + TFLXH=0.0 + WFLXLH(3,NU(NY,NX),NY,NX)=0.0 + ENDIF + ELSE + TFLXH=0.0 + WFLXLH(3,NU(NY,NX),NY,NX)=0.0 + ENDIF + TFLXL(3,NU(NY,NX),NY,NX)=TFLX+TFLXH +C IF(NY.EQ.1)THEN +C WRITE(*,4358)'TFLX',I,J,M,TFREEZ,TK1(NU(NY,NX),NY,NX),PSISV1 +C 2,TFLX,TFLXH,TFLXL(3,NU(NY,NX),NY,NX),WFLX,WFLXH +C 2,WFLXL(3,NU(NY,NX),NY,NX),WFLXLH(3,NU(NY,NX),NY,NX) +C 4,VOLW1(NU(NY,NX),NY,NX),VOLWH1(NU(NY,NX),NY,NX) +C 4,VOLI1(NU(NY,NX),NY,NX),VOLIH1(NU(NY,NX),NY,NX) +C 5,FGRD(NU(NY,NX),NY,NX),FMAC(NU(NY,NX),NY,NX) +4358 FORMAT(A8,3I4,20E12.4) +C ENDIF +C +C +C THICKNESS OF WATER FILMS FOR GAS EXCHANGE IN 'TRNSFR' +C + IF(VHCPR1(NY,NX).GT.VHCPRX(NY,NX))THEN + FILM(M,0,NY,NX)=AMAX1(1.0E-06 + 2,EXP(-13.650-0.857*LOG(-PSISM1(0,NY,NX)))) + ELSE + FILM(M,0,NY,NX)=1.0E-03 + ENDIF +C IF(BKVL(NU(NY,NX),NY,NX).GT.0.0)THEN + FILM(M,NU(NY,NX),NY,NX)=AMAX1(1.0E-06 + 2,EXP(-13.650-0.857*LOG(-PSISM1(NU(NY,NX),NY,NX)))) +C ELSE +C FILM(M,NU(NY,NX),NY,NX)=DLYR(3,NU(NY,NX),NY,NX) +C ENDIF +C +C OVERLAND FLOW WHEN WATER STORAGE CAPACITY +C OF THE SOIL SURFACE PLUS MACROPORES IS EXCEEDED +C + N1=NX + N2=NY + TVOLZ1=AMAX1(0.0,VOLW1(0,N2,N1)+VOLI1(0,N2,N1)-VOLWRX(N2,N1)) + VOLWZ1=AMAX1(0.0,VOLW1(0,N2,N1)-VOLWRX(N2,N1)) +C +C LOCATE INTERNAL BOUNDARIES BETWEEN ADJACENT GRID CELLS +C + DO 4310 N=1,2 + IF(N.EQ.1)THEN + IF(NX.EQ.NHE)THEN + GO TO 4310 + ELSE + N4=NX+1 + N5=NY + WDTH=DLYR(2,NU(NY,NX),NY,NX) + ENDIF + ELSEIF(N.EQ.2)THEN + IF(NY.EQ.NVS)THEN + GO TO 4310 + ELSE + N4=NX + N5=NY+1 + WDTH=DLYR(1,NU(NY,NX),NY,NX) + ENDIF + ENDIF +C +C ELEVATION OF EACH PAIR OF ADJACENT GRID CELLS +C + TVOLZ2=AMAX1(0.0,VOLW1(0,N5,N4)+VOLI1(0,N5,N4)-VOLWRX(N5,N4)) + VOLWZ2=AMAX1(0.0,VOLW1(0,N5,N4)-VOLWRX(N5,N4)) + ALT1=ALTG(N2,N1)+TVOLZ1/AREA(3,NU(N2,N1),N2,N1) + ALT2=ALTG(N5,N4)+TVOLZ2/AREA(3,NU(N5,N4),N5,N4) +C +C EXCESS SURFACE WATER DEPTH, WETTED PERIMETER, SLOPE, VELOCITY +C + IF(ALT1.GT.ALT2.AND.TVOLZ1.GT.VOLWG(N2,N1))THEN + QRX1=TVOLZ1-VOLWG(N2,N1) + D=QRX1/AREA(3,NU(N2,N1),N2,N1) + R=D/2.828 + S=(ALT1-ALT2)/DIST(N,NU(N5,N4),N5,N4) + V=R**0.67*SQRT(S)/ZM(N2,N1) +C +C RUNOFF +C + Q=V*D*AMIN1(1.0,D/ZS(N2,N1))*WDTH*3.6E+03*XNPH + QRQ1=AMAX1(0.0,((ALT1-ALT2)*AREA(3,NU(N2,N1),N2,N1) + 2*AREA(3,NU(N5,N4),N5,N4)-TVOLZ2*AREA(3,NU(N2,N1),N2,N1) + 3+TVOLZ1*AREA(3,NU(N5,N4),N5,N4)) + 4/(AREA(3,NU(N2,N1),N2,N1)+AREA(3,NU(N5,N4),N5,N4))) + QR1(N,N5,N4)=AMIN1(Q,0.25*QRQ1,0.25*QRX1)*VOLWZ1/TVOLZ1 + HQR1(N,N5,N4)=4.19*TK1(0,N2,N1)*QR1(N,N5,N4) +C +C EXCESS SURFACE WATER DEPTH, WETTED PERIMETER, SLOPE, VELOCITY +C + ELSEIF(ALT1.LT.ALT2.AND.TVOLZ2.GT.VOLWG(N5,N4))THEN + QRX1=TVOLZ2-VOLWG(N5,N4) + D=QRX1/AREA(3,NU(N5,N4),N5,N4) + R=D/2.828 + S=(ALT2-ALT1)/DIST(N,NU(N5,N4),N5,N4) + V=R**0.67*SQRT(S)/ZM(N5,N4) +C +C RUNON +C + Q=V*D*AMIN1(1.0,D/ZS(N5,N4))*DLYR(N,NU(N5,N4),N5,N4) + 2*3.6E+03*XNPH + QRQ1=AMIN1(0.0,((ALT1-ALT2)*AREA(3,NU(N2,N1),N2,N1) + 2*AREA(3,NU(N5,N4),N5,N4)-TVOLZ2*AREA(3,NU(N2,N1),N2,N1) + 3+TVOLZ1*AREA(3,NU(N5,N4),N5,N4)) + 4/(AREA(3,NU(N2,N1),N2,N1)+AREA(3,NU(N5,N4),N5,N4))) + QR1(N,N5,N4)=AMAX1(-Q,0.25*QRQ1,-0.25*QRX1)*VOLWZ2/TVOLZ2 + HQR1(N,N5,N4)=4.19*TK1(0,N5,N4)*QR1(N,N5,N4) + ELSE + QR1(N,N5,N4)=0.0 + HQR1(N,N5,N4)=0.0 + V=0.0 + ENDIF + QR(N,N5,N4)=QR(N,N5,N4)+QR1(N,N5,N4) + HQR(N,N5,N4)=HQR(N,N5,N4)+HQR1(N,N5,N4) + QRM(M,N,N5,N4)=QR1(N,N5,N4) + QRV(M,N,N5,N4)=V +C IF(I.EQ.186)THEN +C WRITE(*,5555)'QR1',I,J,M,N1,N2,N4,N5,N,QR1(N,N5,N4) +C 2,ALT1,ALT2,ALTG(N2,N1),ALTG(N5,N4),QRX1,D,R,S,V,Q,QRQ1 +C 2,VOLW1(0,N2,N1),VOLI1(0,N2,N1) +C 3,VOLW1(0,N5,N4),VOLI1(0,N5,N4) +C 4,VOLWZ1,VOLWZ2,TVOLZ1,TVOLZ2,VOLWG(N2,N1),VOLWG(N5,N4) +C 5,QR(N,N5,N4),TVOLW(N5,N4),FVOLW2,FVOLH2 +C 6,DIST(N,NU(N5,N4),N5,N4) +5555 FORMAT(A8,8I4,30E12.4) +C ENDIF +C +C SNOW REDISTRIBUTION +C + ALTS1=ALTG(N2,N1)+DPTHS0(N2,N1) + ALTS2=ALTG(N5,N4)+DPTHS0(N5,N4) + SS=(ALTS1-ALTS2)/DIST(N,NU(N5,N4),N5,N4) + QSX=FQSM*SS/AMAX1(1.0,DIST(N,NU(N5,N4),N5,N4)**2) + IF(SS.GT.0.0.AND.DPTHS0(N2,N1).GT.DPTHSX)THEN + QS1(N,N5,N4)=QSX*VOLS0(N2,N1) + QW1(N,N5,N4)=QSX*VOLW0(N2,N1) + QI1(N,N5,N4)=QSX*VOLI0(N2,N1) + HQS1(N,N5,N4)=TK0(N2,N1)*(2.095*QS1(N,N5,N4) + 2+4.19*QW1(N,N5,N4)+1.9274*QI1(N,N5,N4)) + ELSEIF(SS.LT.0.0.AND.DPTHS0(N5,N4).GT.DPTHSX)THEN + QS1(N,N5,N4)=QSX*VOLS0(N5,N4) + QW1(N,N5,N4)=QSX*VOLW0(N5,N4) + QI1(N,N5,N4)=QSX*VOLI0(N5,N4) + HQS1(N,N5,N4)=TK0(N5,N4)*(2.095*QS1(N,N5,N4) + 2+4.19*QW1(N,N5,N4)+1.9274*QI1(N,N5,N4)) + ELSE + QS1(N,N5,N4)=0.0 + QW1(N,N5,N4)=0.0 + QI1(N,N5,N4)=0.0 + HQS1(N,N5,N4)=0.0 + ENDIF + QS(N,N5,N4)=QS(N,N5,N4)+QS1(N,N5,N4) + QW(N,N5,N4)=QW(N,N5,N4)+QW1(N,N5,N4) + QI(N,N5,N4)=QI(N,N5,N4)+QI1(N,N5,N4) + HQS(N,N5,N4)=HQS(N,N5,N4)+HQS1(N,N5,N4) + QSM(M,N,N5,N4)=QS1(N,N5,N4) +C IF(NX.EQ.2.AND.NY.EQ.5)THEN +C WRITE(*,5556)'QS1',I,J,M,N1,N2,N4,N5,N,QSX,QS1(N,N5,N4) +C 2,QW1(N,N5,N4),QI1(N,N5,N4),VOLS0(N2,N1),VOLW0(N2,N1) +C 3,VOLI0(N2,N1),ALTS1,ALTS2,ALTG(N2,N1),ALTG(N5,N4) +C 4,DIST(N,NU(N5,N4),N5,N4),SS,DPTHS0(N2,N1),DPTHS0(N5,N4) +C 5,VOLS1(N2,N1),VOLS1(N5,N4),VOLWG(N2,N1),VOLWG(N5,N4) +5556 FORMAT(A8,8I4,30E12.4) +C ENDIF +4310 CONTINUE +C +C TOTAL WATER, VAPOR AND HEAT FLUXES THROUGH SURFACE RESIDUE +C AND SOIL SURFACE +C + THAWR(NY,NX)=THAWR(NY,NX)+WFLXR(NY,NX) + HTHAWR(NY,NX)=HTHAWR(NY,NX)+TFLXR(NY,NX) + THAW(3,NU(NY,NX),NY,NX)=THAW(3,NU(NY,NX),NY,NX) + 2+WFLXL(3,NU(NY,NX),NY,NX) + THAWH(3,NU(NY,NX),NY,NX)=THAWH(3,NU(NY,NX),NY,NX) + 2+WFLXLH(3,NU(NY,NX),NY,NX) + HTHAW(3,NU(NY,NX),NY,NX)=HTHAW(3,NU(NY,NX),NY,NX) + 2+TFLXL(3,NU(NY,NX),NY,NX) + FLW(3,NU(NY,NX),NY,NX)=FLW(3,NU(NY,NX),NY,NX) + 2+FLWL(3,NU(NY,NX),NY,NX) + FLWX(3,NU(NY,NX),NY,NX)=FLWX(3,NU(NY,NX),NY,NX) + 2+FLWLX(3,NU(NY,NX),NY,NX) + FLWH(3,NU(NY,NX),NY,NX)=FLWH(3,NU(NY,NX),NY,NX) + 2+FLWHL(3,NU(NY,NX),NY,NX) + HFLW(3,NU(NY,NX),NY,NX)=HFLW(3,NU(NY,NX),NY,NX) + 2+HFLWL(3,NU(NY,NX),NY,NX) + FLWR(NY,NX)=FLWR(NY,NX)+FLWRL(NY,NX) + HFLWR(NY,NX)=HFLWR(NY,NX)+HFLWRL(NY,NX) + HEATI(NY,NX)=HEATI(NY,NX)+RFLX+RFLXR + HEATS(NY,NX)=HEATS(NY,NX)+SFLX+SFLXR + HEATE(NY,NX)=HEATE(NY,NX)+EFLX+EFLXR + HEATV(NY,NX)=HEATV(NY,NX)+VFLX+VFLXR + HEATH(NY,NX)=HEATH(NY,NX)+RFLX+RFLXR + 2+SFLX+SFLXR+EFLX+EFLXR+VFLX+VFLXR + TEVAPG(NY,NX)=TEVAPG(NY,NX)+EVAP(NY,NX)+EVAPS(NY,NX)+EVAPR(NY,NX) + VOLWX1(NU(NY,NX),NY,NX)=VOLW1(NU(NY,NX),NY,NX) + HYSM(M,NU(NY,NX),NY,NX)=HYST(NU(NY,NX),NY,NX) + FLWM(M,3,NU(NY,NX),NY,NX)=FLWL(3,NU(NY,NX),NY,NX) + FLWHM(M,3,NU(NY,NX),NY,NX)=FLWHL(3,NU(NY,NX),NY,NX) +C +C DELAYED MIGRATION OF PRECIPITATION OR MELTWATER INTO MICROPORES +C + IF(FLQM.GT.0.0.AND.VOLPX1(NU(NY,NX),NY,NX).GT.ZEROS(NY,NX) + 2.AND.HYST(NU(NY,NX),NY,NX).GT.ZERO)THEN + HYST(NU(NY,NX),NY,NX)=AMIN1(1.0,AMAX1(0.0,HYST(NU(NY,NX),NY,NX) + 2-FLQM/VOLPX1(NU(NY,NX),NY,NX))) + ENDIF + HYST(NU(NY,NX),NY,NX)=HYST(NU(NY,NX),NY,NX) + 2+(1.0-HYST(NU(NY,NX),NY,NX))*HYSTX +C +C INFILTRATION OF WATER FROM MACROPORES INTO MICROPORES +C + IF(VOLWH1(NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN + FINHX=XNPH*6.283*HCND(2,1,NU(NY,NX),NY,NX)*AREA(3,NU(NY,NX),NY,NX) + 2*(PSISE(NU(NY,NX),NY,NX)-PSISM1(NU(NY,NX),NY,NX)) + 3/LOG(PHOL(NU(NY,NX),NY,NX)/HRAD(NU(NY,NX),NY,NX)) + IF(FINHX.GT.0.0)THEN + FINHL(NU(NY,NX),NY,NX)=AMAX1(0.0,AMIN1(FINHX + 2,XNPH*VOLWH1(NU(NY,NX),NY,NX),VOLPX1(NU(NY,NX),NY,NX))) + ELSE + FINHL(NU(NY,NX),NY,NX)=AMIN1(0.0,AMAX1(FINHX + 2,-VOLPH1(NU(NY,NX),NY,NX),-XNPH*VOLW1(NU(NY,NX),NY,NX))) + ENDIF + FINHM(M,NU(NY,NX),NY,NX)=FINHL(NU(NY,NX),NY,NX) + FINH(NU(NY,NX),NY,NX)=FINH(NU(NY,NX),NY,NX)+FINHL(NU(NY,NX),NY,NX) +C IF(J.EQ.12.AND.M.EQ.1)THEN +C WRITE(*,3367)'HOLE',I,J,M,NX,NY +C 2,FINHL(NU(NY,NX),NY,NX),FINHX +C 2,VOLWH1(NU(NY,NX),NY,NX),VOLPH1(NU(NY,NX),NY,NX) +C 3,VOLAH1(NU(NY,NX),NY,NX),PSISE(NU(NY,NX),NY,NX) +C 4,PSISM1(NU(NY,NX),NY,NX),VOLW1(NU(NY,NX),NY,NX) +C 5,HCND(2,1,NU(NY,NX),NY,NX),PHOL(NU(NY,NX),NY,NX) +C 5,HRAD(NU(NY,NX),NY,NX) +3367 FORMAT(A8,5I4,20E12.4) +C ENDIF + ELSE + FINHM(M,NU(NY,NX),NY,NX)=0.0 + FINHL(NU(NY,NX),NY,NX)=0.0 + ENDIF +C +C WATER AND ENERGY TRANSFER THROUGH SOIL PROFILE +C + IFLGH=0 + DO 4400 L=1,NL(NY,NX) +C +C CALCULATE CHANGE IN THICKNESS OF ICE LAYER +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 +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) +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 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) +C 3,CDPTH(L,NY,NX),DPTH(L,NY,NX),YDPTH(L,NY,NX),DLYR(3,L,NY,NX) +C 4,VOLP1(L,NY,NX) +910 FORMAT(A8,5I4,12E16.8) +C ENDIF + ENDIF + ENDIF +C +C END THICKNESS +C + N1=NX + N2=NY + N3=L +C +C LOCATE INTERNAL BOUNDARIES BETWEEN ADJACENT GRID CELLS +C + DO 4320 N=NCN(N2,N1),3 + IF(N.EQ.1)THEN + IF(NX.EQ.NHE)THEN + GO TO 4320 + ELSE + N4=NX+1 + N5=NY + N6=L +C +C ARTIFICIAL SOIL WARMING – PREVENT LATERAL FLOW +C +C IF(N2.EQ.2.AND.(N1.EQ.2.OR.N1.EQ.3).AND.L.LE.15)THEN +C GO TO 4320 +C ENDIF + ENDIF + ELSEIF(N.EQ.2)THEN + IF(NY.EQ.NVS)THEN + GO TO 4320 + ELSE + N4=NX + N5=NY+1 + N6=L +C +C ARTIFICIAL SOIL WARMING – PREVENT LATERAL FLOW +C +C IF(N1.EQ.3.AND.(N2.EQ.1.OR.N2.EQ.2).AND.L.LE.15)THEN +C GO TO 4320 +C ENDIF + ENDIF + ELSEIF(N.EQ.3)THEN + IF(L.EQ.NL(NY,NX))THEN + GO TO 4320 + ELSE + N4=NX + N5=NY + N6=L+1 + ENDIF + ENDIF +C +C POROSITIES 'THETP*', WATER CONTENTS 'THETA*', AND POTENTIALS +C 'PSIS*' FOR EACH GRID CELL +C + IF(N3.GE.NU(N2,N1).AND.N6.GE.NU(N5,N4) + 2.AND.N3.LE.NL(N2,N1).AND.N6.LE.NL(N5,N4))THEN + THETP1=AMAX1(0.0,VOLPX1(N3,N2,N1)/VOLX(N3,N2,N1)) + THETPL=AMAX1(0.0,VOLPX1(N6,N5,N4)/VOLX(N6,N5,N4)) + THETA1=AMAX1(THETY(N3,N2,N1),AMIN1(POROS(N3,N2,N1) + 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 + IF(THETA1.LT.FC(N3,N2,N1))THEN + PSISA1=AMAX1(HYGR,-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 + PSISA1=-EXP(PSIMS(N2,N1) + 2+(((PSL(N3,N2,N1)-LOG(THETA1)) + 3/PSD(N3,N2,N1))**SRP(N3,N2,N1)*PSISD(N2,N1))) + ELSE + PSISA1=PSISE(N3,N2,N1) + ENDIF +C ELSE +C PSISA1=PSISE(N3,N2,N1) +C ENDIF +C IF(BKVL(N6,N5,N4).GT.0.0)THEN + IF(THETAL.LT.FC(N6,N5,N4))THEN + PSISAL=AMAX1(HYGR,-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 + PSISAL=-EXP(PSIMS(N5,N4) + 2+(((PSL(N6,N5,N4)-LOG(THETAL)) + 3/PSD(N6,N5,N4))**SRP(N6,N5,N4)*PSISD(N5,N4))) + ELSE + PSISAL=PSISE(N6,N5,N4) + ENDIF +C ELSE +C PSISAL=PSISE(N6,N5,N4) +C ENDIF +C IF(J.GE.20)THEN +C WRITE(*,7272)'PSIM',I,J,N1,N2,N3,N4,N5,N6,M,PSISM1(N6,N5,N4) +C 2,PSIMX(N5,N4),FCL(N6,N5,N4),THETWL,FCD(N6,N5,N4),PSIMD(N5,N4) +C 3,POROS(N6,N5,N4),PSIMS(N5,N4),PSL(N6,N5,N4),PSD(N6,N5,N4) +C 4,SRP(N6,N5,N4),PSISD(N5,N4),THETAL,PSISE(N6,N5,N4) +C 5,THETAL-POROS(N6,N5,N4),PSISA1,PSISAL +7272 FORMAT(A8,9I4,20E12.4) +C ENDIF +C +C DARCY FLOW IF BOTH CELLS ARE SATURATED +C (CURRENT WATER POTENTIAL > AIR ENTRY WATER POTENTIAL) +C + IF(PSISA1.GT.PSISA(N3,N2,N1) + 2.AND.PSISAL.GT.PSISA(N6,N5,N4))THEN + THETW1=THETA1 + THETWL=THETAL + CND1=HCND(N,1,N3,N2,N1)*XNPH + CNDL=HCND(N,1,N6,N5,N4)*XNPH + PSISM1(N3,N2,N1)=PSISA1 + PSISM1(N6,N5,N4)=PSISAL + IF(PSISM1(N3,N2,N1).GE.PSISM1(N6,N5,N4) + 2.AND.VOLW1(N3,N2,N1).GT.ZEROS(N2,N1))THEN + FLGX=VOLWX1(N3,N2,N1)/VOLW1(N3,N2,N1) + ELSEIF(VOLW1(N6,N5,N4).GT.ZEROS(N5,N4))THEN + FLGX=VOLWX1(N6,N5,N4)/VOLW1(N6,N5,N4) + ELSE + FLGX=0.0 + ENDIF +C +C GREEN-AMPT FLOW IF ONE LAYER IS SATURATED +C (CURRENT WATER POTENTIAL < AIR ENTRY WATER POENTIAL) +C +C +C GREEN-AMPT FLOW IF SOURCE CELL SATURATED +C + ELSEIF(PSISA1.GT.PSISA(N3,N2,N1))THEN + THETW1=THETA1 + THETWL=AMAX1(THETY(N6,N5,N4),AMIN1(POROS(N6,N5,N4) + 2,VOLWX1(N6,N5,N4)/VOLX(N6,N5,N4))) + 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 + IF(THETWL.LT.FC(N6,N5,N4))THEN + PSISM1(N6,N5,N4)=AMAX1(HYGR,-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 + PSISM1(N6,N5,N4)=-EXP(PSIMS(N5,N4) + 2+(((PSL(N6,N5,N4)-LOG(THETWL)) + 3/PSD(N6,N5,N4))**SRP(N6,N5,N4)*PSISD(N5,N4))) + ELSE + PSISM1(N6,N5,N4)=PSISE(N6,N5,N4) + ENDIF +C ELSE +C PSISM1(N6,N5,N4)=PSISE(N6,N5,N4) +C ENDIF + FLGX=0.0 +C +C GREEN-AMPT FLOW IF ADJACENT CELL SATURATED +C + ELSEIF(PSISAL.GT.PSISA(N6,N5,N4))THEN + THETW1=AMAX1(THETY(N3,N2,N1),AMIN1(POROS(N3,N2,N1) + 2,VOLWX1(N3,N2,N1)/VOLX(N3,N2,N1))) + 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 + IF(THETW1.LT.FC(N3,N2,N1))THEN + PSISM1(N3,N2,N1)=AMAX1(HYGR,-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 + PSISM1(N3,N2,N1)=-EXP(PSIMS(N2,N1) + 2+(((PSL(N3,N2,N1)-LOG(THETW1)) + 3/PSD(N3,N2,N1))**SRP(N3,N2,N1)*PSISD(N2,N1))) + ELSE + PSISM1(N3,N2,N1)=PSISE(N3,N2,N1) + ENDIF +C ELSE +C PSISM1(N3,N2,N1)=PSISE(N3,N2,N1) +C ENDIF + FLGX=0.0 +C +C RICHARDS FLOW IF NEITHER CELL IS SATURATED +C (CURRENT WATER POTENTIAL < AIR ENTRY WATER POTENTIAL) +C + ELSE + THETW1=THETA1 + THETWL=THETAL + K1=MAX(1,MIN(100,INT(100.0*(POROS(N3,N2,N1)-THETA1) + 2/POROS(N3,N2,N1))+1)) + CND1=HCND(N,K1,N3,N2,N1)*XNPH + KL=MAX(1,MIN(100,INT(100.0*(POROS(N6,N5,N4)-THETAL) + 2/POROS(N6,N5,N4))+1)) + CNDL=HCND(N,KL,N6,N5,N4)*XNPH + PSISM1(N3,N2,N1)=PSISA1 + PSISM1(N6,N5,N4)=PSISAL + IF(PSISM1(N3,N2,N1).GE.PSISM1(N6,N5,N4) + 2.AND.VOLW1(N3,N2,N1).GT.ZEROS(N2,N1))THEN + FLGX=VOLWX1(N3,N2,N1)/VOLW1(N3,N2,N1) + ELSEIF(VOLW1(N6,N5,N4).GT.ZEROS(N5,N4))THEN + FLGX=VOLWX1(N6,N5,N4)/VOLW1(N6,N5,N4) + ELSE + FLGX=0.0 + ENDIF + ENDIF +C +C TOTAL SOIL WATER POTENTIAL = MATRIC, GRAVIMETRIC + OSMOTIC +C + PSIST1=PSISM1(N3,N2,N1)+PSISH(N3,N2,N1)+0.03*PSISO(N3,N2,N1) + PSISTL=PSISM1(N6,N5,N4)+PSISH(N6,N5,N4)+0.03*PSISO(N6,N5,N4) + PSISV1=PSISM1(N3,N2,N1)+PSISO(N3,N2,N1) + PSISVL=PSISM1(N6,N5,N4)+PSISO(N6,N5,N4) +C +C HYDRAULIC CONDUCTIVITY FROM CURRENT WATER CONTENT +C AND LOOKUP ARRAY GENERATED IN 'HOUR1' +C + IF(CND1.GT.ZERO.AND.CNDL.GT.ZERO)THEN + AVCNDL=2.0*CND1*CNDL/(CND1*DLYR(N,N6,N5,N4) + 2+CNDL*DLYR(N,N3,N2,N1)) + ELSE + AVCNDL=0.0 + ENDIF +C +C WATER FLUX FROM WATER POTENTIALS, HYDRAULIC CONDUCTIVITY +C CONSTRAINED BY WATER POTENTIAL GRADIENT, COUPLED WITH +C CONVECTIVE HEAT FLUX FROM WATER FLUX +C + FLQX=AVCNDL*(PSIST1-PSISTL)*AREA(N,N3,N2,N1) + IF(FLQX.GE.0.0)THEN + FLQL=AMAX1(0.0,AMIN1(FLQX,VOLW1(N3,N2,N1)*XNPH)) + FLQL=AMIN1(FLQL,VOLP1(N6,N5,N4)*XNPH) + HWFLQL=4.19*TK1(N3,N2,N1)*FLQL + ELSE + FLQL=AMIN1(0.0,AMAX1(FLQX,-VOLW1(N6,N5,N4)*XNPH)) + FLQL=AMAX1(FLQL,-VOLP1(N3,N2,N1)*XNPH) + HWFLQL=4.19*TK1(N6,N5,N4)*FLQL + ENDIF + FLQ2=FLGX*FLQL +C +C INFILTRATION OF WATER FROM MACROPORES INTO MICROPORES +C + IF(N.EQ.3.AND.VOLWH1(N6,N5,N4).GT.ZEROS(N5,N4))THEN + FINHX=XNPH*6.283*HCND(2,1,N6,N5,N4)*AREA(3,N6,N5,N4) + 2*(PSISE(N6,N5,N4)-PSISM1(N6,N5,N4)) + 3/LOG(PHOL(N6,N5,N4)/HRAD(N6,N5,N4)) + IF(FINHX.GT.0.0)THEN + FINHL(N6,N5,N4)=AMAX1(0.0,AMIN1(FINHX,XNPH*VOLWH1(N6,N5,N4) + 2,VOLPX1(N6,N5,N4))) + ELSE + FINHL(N6,N5,N4)=AMIN1(0.0,AMAX1(FINHX,-VOLPH1(N6,N5,N4) + 2,-XNPH*VOLW1(N6,N5,N4))) + ENDIF + FINHM(M,N6,N5,N4)=FINHL(N6,N5,N4) + FINH(N6,N5,N4)=FINH(N6,N5,N4)+FINHL(N6,N5,N4) +C IF(NX.EQ.1.AND.NY.EQ.1)THEN +C WRITE(*,3366)'FINHL',I,J,M,N4,N5,N6,IFLGH,FINHL(N6,N5,N4) +C 3,FINHX,VOLWH1(N6,N5,N4),VOLPH1(N6,N5,N4),VOLP1(N6,N5,N4) +C 4,PSISM1(N6,N5,N4),HCND(2,1,N6,N5,N4),PHOL(N6,N5,N4) +C 5,HRAD(N6,N5,N4) +3366 FORMAT(A8,7I4,20E12.4) +C ENDIF + ELSE + FINHL(N6,N5,N4)=0.0 + FINHM(M,N6,N5,N4)=0.0 + ENDIF +C +C MACROPORE FLOW FROM POISEUILLE FLOW IF MACROPORES PRESENT +C + IF(VOLAH1(N3,N2,N1).GT.ZEROS(N2,N1) + 2.AND.VOLAH1(N6,N5,N4).GT.ZEROS(N5,N4).AND.IFLGH.EQ.0)THEN + PSISH1=PSISH(N3,N2,N1)+0.0098*DLYR(3,N3,N2,N1) + 2*(AMIN1(1.0,AMAX1(0.0,VOLWH1(N3,N2,N1)/VOLAH1(N3,N2,N1)))-0.5) + PSISHL=PSISH(N6,N5,N4)+0.0098*DLYR(3,N6,N5,N4) + 2*(AMIN1(1.0,AMAX1(0.0,VOLWH1(N6,N5,N4)/VOLAH1(N6,N5,N4)))-0.5) + FLWHX=AVCNHL(N,N6,N5,N4)*(PSISH1-PSISHL)*AREA(N,N3,N2,N1) +C +C MACROPORE FLOW IF GRAVITATIONAL GRADIENT IS POSITIVE +C AND MACROPORE POROSITY EXISTS IN ADJACENT CELL +C + IF(N.NE.3)THEN + IF(PSISH1.GT.PSISHL)THEN + FLWHL(N,N6,N5,N4)=AMAX1(0.0,AMIN1(AMIN1(VOLWH1(N3,N2,N1) + 2,VOLPH1(N6,N5,N4))*0.5*XDIM,FLWHX)) + ELSEIF(PSISH1.LT.PSISHL)THEN + FLWHL(N,N6,N5,N4)=AMIN1(0.0,AMAX1(AMAX1(-VOLWH1(N6,N5,N4) + 2,-VOLPH1(N3,N2,N1))*0.5*XDIM,FLWHX)) + ELSE + FLWHL(N,N6,N5,N4)=0.0 + ENDIF + ELSE + FLWHL(N,N6,N5,N4)=AMAX1(0.0,AMIN1(AMIN1(VOLWH1(N3,N2,N1) + 2+FLWHL(N,N3,N2,N1)-FINHL(N3,N2,N1) + 3,VOLPH1(N6,N5,N4))*XDIM,FLWHX)) + ENDIF + FLWHM(M,N,N6,N5,N4)=FLWHL(N,N6,N5,N4) +C IF(N4.EQ.1)THEN +C WRITE(*,5478)'FLWH',I,J,M,N1,N2,N3,IFLGH +C 2,FINHL(N3,N2,N1),FLHM,FLWHX,FLWHL(N,N3,N2,N1),FLWHL(N,N6,N5,N4) +C 2,AVCNHL(N,N6,N5,N4),PSISH(N3,N2,N1),PSISH(N6,N5,N4) +C 3,VOLPH1(N3,N2,N1),VOLPH1(N6,N5,N4),VOLWH1(N3,N2,N1) +C 4,VOLWH1(N6,N5,N4),VOLAH1(N3,N2,N1),VOLAH1(N6,N5,N4) +C 5,DLYR(N,N6,N5,N4),DLYR(N,N3,N2,N1),AREA(N,N3,N2,N1) +C 7,CNDH1(N3,N2,N1),CNDH1(N6,N5,N4),XNPH,XDIM,HWFLHL +5478 FORMAT(A8,7I4,30E12.4) +C ENDIF + ELSE + FLWHL(N,N6,N5,N4)=0.0 + FLWHM(M,N,N6,N5,N4)=0.0 + IF(VOLPH1(N6,N5,N4).LE.0.0)IFLGH=1 + ENDIF +C +C CONVECTIVE HEAT FLOW FROM MACROPORE FLOW +C + IF(FLWHL(N,N6,N5,N4).GT.0.0)THEN + HWFLHL=4.19*TK1(N3,N2,N1)*FLWHL(N,N6,N5,N4) + ELSE + HWFLHL=4.19*TK1(N6,N5,N4)*FLWHL(N,N6,N5,N4) + ENDIF +C +C VAPOR PRESSURE AND DIFFUSIVITY IN EACH GRID CELL +C + TK11=TK1(N3,N2,N1) + TK12=TK1(N6,N5,N4) + VP1=2.173E-03/TK11 + 2*0.61*EXP(5360.0*(3.661E-03-1.0/TK11)) + 3*EXP(18.0*PSISV1/(8.3143*TK11)) + VPL=2.173E-03/TK12 + 2*0.61*EXP(5360.0*(3.661E-03-1.0/TK12)) + 3*EXP(18.0*PSISVL/(8.3143*TK12)) + CNV1=THETP1**2/POROQ(N3,N2,N1)*WGSG1(N3,N2,N1) + CNVL=THETPL**2/POROQ(N6,N5,N4)*WGSG1(N6,N5,N4) + IF(CNV1.GT.ZERO.AND.CNVL.GT.ZERO)THEN + AVCNVL=2.0*CNV1*CNVL + 2/(CNV1*DLYR(N,N6,N5,N4)+CNVL*DLYR(N,N3,N2,N1)) + ELSE + AVCNVL=0.0 + ENDIF +C +C VAPOR FLUX FROM VAPOR PRESSURE AND DIFFUSIVITY, +C AND CONVECTIVE HEAT FLUX FROM VAPOR FLUX +C + TKY=(VHCP1(N3,N2,N1)*TK1(N3,N2,N1)+VHCP1(N6,N5,N4)*TK1(N6,N5,N4)) + 2/(VHCP1(N3,N2,N1)+VHCP1(N6,N5,N4)) + HFLWX=(TKY-TK1(N6,N5,N4))*VHCP1(N6,N5,N4)*FHFLX*XDIM + FLVX=AVCNVL*(VP1-VPL)*AREA(N,N3,N2,N1) + IF(FLVX.GE.0.0)THEN + FLVL=AMIN1(FLVX,VOLW1(N3,N2,N1)*XNPH) + IF(HFLWX.GE.0.0)THEN + FLVL=AMIN1(FLVL,HFLWX/(4.19*TK1(N3,N2,N1)+VAP)) + ENDIF + HWFLVL=(4.19*TK1(N3,N2,N1)+VAP)*FLVL + ELSE + FLVL=AMAX1(FLVX,-VOLW1(N6,N5,N4)*XNPH) + IF(HFLWX.LT.0.0)THEN + FLVL=AMAX1(FLVL,HFLWX/(4.19*TK1(N6,N5,N4)+VAP)) + ENDIF + HWFLVL=(4.19*TK1(N6,N5,N4)+VAP)*FLVL + ENDIF + 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 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 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 ENDIF +C +C THERMAL CONDUCTIVITY +C + DTKX=ABS(TK1(N3,N2,N1)-TK1(N6,N5,N4))*1.0E-06 + DTHW1=AMAX1(0.0,THETWX(N3,N2,N1)-TRBW)**3 + DTHA1=AMAX1(0.0,THETPX(N3,N2,N1)-TRBA)**3 + DTHW2=AMAX1(0.0,THETWX(N6,N5,N4)-TRBW)**3 + DTHA2=AMAX1(0.0,THETPX(N6,N5,N4)-TRBA)**3 + RYLXW1=DTKX*DTHW1 + RYLXA1=DTKX*DTHA1 + RYLXW2=DTKX*DTHW2 + RYLXA2=DTKX*DTHA2 + RYLNW1=AMIN1(1.0E+04,RYLXW*RYLXW1) + RYLNA1=AMIN1(1.0E+04,RYLXA*RYLXA1) + RYLNW2=AMIN1(1.0E+04,RYLXW*RYLXW2) + RYLNA2=AMIN1(1.0E+04,RYLXA*RYLXA2) + XNUSW1=AMAX1(1.0,0.68+0.67*RYLNW1**0.25/DNUSW) + XNUSA1=AMAX1(1.0,0.68+0.67*RYLNA1**0.25/DNUSA) + XNUSW2=AMAX1(1.0,0.68+0.67*RYLNW2**0.25/DNUSW) + XNUSA2=AMAX1(1.0,0.68+0.67*RYLNA2**0.25/DNUSA) + TCNDW1=2.067E-03*XNUSW1 + TCNDA1=9.050E-05*XNUSA1 + TCNDW2=2.067E-03*XNUSW2 + TCNDA2=9.050E-05*XNUSA2 + WTHET1=1.467-0.467*THETPY(N3,N2,N1) + TCND1=(STC(N3,N2,N1)+THETWX(N3,N2,N1)*TCNDW1 + 2+0.611*THETIX(N3,N2,N1)*7.844E-03 + 3+WTHET1*THETPX(N3,N2,N1)*TCNDA1) + 4/(DTC(N3,N2,N1)+THETWX(N3,N2,N1)+0.611*THETIX(N3,N2,N1) + 5+WTHET1*THETPX(N3,N2,N1)) + WTHET2=1.467-0.467*THETPY(N6,N5,N4) + TCND2=(STC(N6,N5,N4)+THETWX(N6,N5,N4)*TCNDW2 + 2+0.611*THETIX(N6,N5,N4)*7.844E-03 + 3+WTHET2*THETPX(N6,N5,N4)*TCNDA2) + 4/(DTC(N6,N5,N4)+THETWX(N6,N5,N4)+0.611*THETIX(N6,N5,N4) + 5+WTHET2*THETPX(N6,N5,N4)) + ATCND1=(2.0*TCND1*TCND2)/(TCND1*DLYR(N,N6,N5,N4) + 3+TCND2*DLYR(N,N3,N2,N1))*XNPH +C +C HEAT FLOW FROM THERMAL CONDUCTIVITY AND TEMPERATURE GRADIENT +C + TK1X=TK1(N3,N2,N1)-HWFLVL/VHCP1(N3,N2,N1) + TKLX=TK1(N6,N5,N4)+HWFLVL/VHCP1(N6,N5,N4) + TKY=(VHCP1(N3,N2,N1)*TK1X+VHCP1(N6,N5,N4)*TKLX) + 2/(VHCP1(N3,N2,N1)+VHCP1(N6,N5,N4)) + HFLWX=(TKY-TKLX)*VHCP1(N6,N5,N4)*FHFLX*XDIM + HFLWC=ATCND1*(TK1X-TKLX)*AREA(N,N3,N2,N1) + IF(HFLWC.GE.0.0)THEN + HFLWC=AMAX1(0.0,AMIN1(HFLWC,HFLWX)) + ELSE + HFLWC=AMIN1(0.0,AMAX1(HFLWC,HFLWX)) + ENDIF + HFLWL(N,N6,N5,N4)=HWFLWL+HWFLHL+HFLWC +C IF((I/10)*10.EQ.I.AND.N5.EQ.2.AND.J.EQ.15.AND.N.EQ.3)THEN +C WRITE(*,8765)'HFLWL',I,J,N4,N5,N6,N,M,HFLWL(N,N6,N5,N4) +C 2,TCND1,TCND2,ATCND1,DTKX,DTHP1,DTHP2,THETPX(N3,N2,N1) +C 3,THETPX(N6,N5,N4),RYLNA1,RYLNA2,DNUSA,XNUSA1,XNUSA2 +C 4,TCNDA1,TCNDA2,RYLNW1,RYLNW2,DNUSW,XNUSW1,XNUSW2 +C 5,TCNDW1,TCNDW2 +8765 FORMAT(A8,7I4,60E12.4) +C ENDIF +C +C MOVE WATER UP DURING PRECIPITATION OR FREEZING +C + IF(N.EQ.3)THEN + IF(VOLW1(N6,N5,N4)+VOLI1(N6,N5,N4).GT.VOLA(N6,N5,N4))THEN + FLWLY=AMIN1(0.0,AMAX1(-XNPH*VOLW1(N6,N5,N4) + 2,VOLA(N6,N5,N4)-VOLW1(N6,N5,N4)-VOLI1(N6,N5,N4))) + FLWLY=AMAX1(FLWLY,-VOLP1(N3,N2,N1)) + HFLWLY=FLWLY*4.19*TK1(N6,N5,N4) + FLWL(N,N6,N5,N4)=FLWL(N,N6,N5,N4)+FLWLY + HFLWL(N,N6,N5,N4)=HFLWL(N,N6,N5,N4)+HFLWLY + ENDIF + IF(VOLWH1(N6,N5,N4)+VOLIH1(N6,N5,N4).GT.VOLAH1(N6,N5,N4))THEN + FLWHY=AMIN1(0.0,AMAX1(-XNPH*VOLWH1(N6,N5,N4),-VOLPH1(N3,N2,N1) + 2,VOLAH1(N6,N5,N4)-VOLWH1(N6,N5,N4)-VOLIH1(N6,N5,N4))) + HFLWHY=FLWHY*4.19*TK1(N6,N5,N4) + FLWHL(N,N6,N5,N4)=FLWHL(N,N6,N5,N4)+FLWHY + HFLWL(N,N6,N5,N4)=HFLWL(N,N6,N5,N4)+HFLWHY + ENDIF + IF(PSISAL.GT.PSISA(N6,N5,N4))THEN + FLWVL(N6,N5,N4)=VOLW1(N6,N5,N4)-VOLWX1(N6,N5,N4) + ELSE + FLWVL(N6,N5,N4)=RFLWV(N5,N4)*(VOLW1(N6,N5,N4)-VOLWX1(N6,N5,N4)) + ENDIF + FLWV(N6,N5,N4)=FLWV(N6,N5,N4)+FLWVL(N6,N5,N4) + ENDIF +C +C FREEZE-THAW IN SOIL LAYER MICROPORE FROM NET CHANGE IN SOIL +C LAYER HEAT STORAGE +C + IF(N.EQ.3)THEN + TFREEZ=-9.0959E+04/(PSISVL-333.0) + IF((TK1(N6,N5,N4).LT.TFREEZ + 2.AND.VOLW1(N6,N5,N4).GT.ZERO*VOLA(N6,N5,N4) + 3.AND.VOLI1(N6,N5,N4).LT.VOLA(N6,N5,N4)) + 4.OR.(TK1(N6,N5,N4).GT.TFREEZ + 5.AND.VOLI1(N6,N5,N4).GT.ZERO*VOLT(N6,N5,N4)))THEN + TFLX1=FGRD(N6,N5,N4)*(1.0/(1.0+TFREEZ*6.2913E-03) + 2*(TFREEZ*4.19*(FLWL(N,N6,N5,N4)+FLWHL(N,N6,N5,N4)) + 2+VHCP1(N6,N5,N4)*(TFREEZ-TK1(N6,N5,N4)) + 3-HFLWL(N,N6,N5,N4))) + IF(TFLX1.LT.0.0)THEN + TFLX=AMAX1(-333.0*0.92*VOLI1(N6,N5,N4)*XNPH,TFLX1) + ELSE + TFLX=AMIN1(333.0*VOLW1(N6,N5,N4)*XNPH,TFLX1) + ENDIF + WFLX=-TFLX/333.0 + IF(WFLX.GT.0.0.AND.VOLI1(N6,N5,N4).GT.ZEROS(N5,N4))THEN + WFLXL(N,N6,N5,N4)=WFLX + ELSEIF(WFLX.LT.0.0.AND.VOLW1(N6,N5,N4).GT.ZEROS(N5,N4))THEN + WFLXL(N,N6,N5,N4)=WFLX + ELSE + TFLX=0.0 + WFLXL(N,N6,N5,N4)=0.0 + ENDIF + ELSE + TFLX=0.0 + WFLXL(N,N6,N5,N4)=0.0 + ENDIF +C +C FREEZE-THAW IN SOIL LAYER MACROPORE FROM NET CHANGE IN SOIL +C LAYER HEAT STORAGE +C + IF((TK1(N6,N5,N4).LT.273.15.AND.VOLWH1(N6,N5,N4) + 2.GT.ZERO*VOLT(N6,N5,N4)).OR.(TK1(N6,N5,N4).GT.273.15 + 3.AND.VOLIH1(N6,N5,N4).GT.ZERO*VOLT(N6,N5,N4)))THEN + TFLX1=FMAC(N6,N5,N4)*(1.0/(1.0+273.15*6.2913E-03) + 2*(273.15*4.19*(FLWL(N,N6,N5,N4)+FLWHL(N,N6,N5,N4)) + 2+VHCP1(N6,N5,N4)*(273.15-TK1(N6,N5,N4)) + 3-HFLWL(N,N6,N5,N4))) + IF(TFLX1.LT.0.0)THEN + TFLXH=AMAX1(-333.0*0.92*VOLIH1(N6,N5,N4)*XNPH,TFLX1) + ELSE + TFLXH=AMIN1(333.0*VOLWH1(N6,N5,N4)*XNPH,TFLX1) + ENDIF + WFLXH=-TFLXH/333.0 + IF(WFLXH.GT.0.0.AND.VOLIH1(N6,N5,N4).GT.ZEROS(N5,N4))THEN + WFLXLH(N,N6,N5,N4)=WFLXH + ELSEIF(WFLXH.LT.0.0.AND.VOLWH1(N6,N5,N4).GT.ZEROS(N5,N4))THEN + WFLXLH(N,N6,N5,N4)=WFLXH + ELSE + TFLXH=0.0 + WFLXLH(N,N6,N5,N4)=0.0 + ENDIF + ELSE + TFLXH=0.0 + WFLXLH(N,N6,N5,N4)=0.0 + ENDIF + TFLXL(N,N6,N5,N4)=TFLX+TFLXH +C IF(NY.EQ.1)THEN +C WRITE(*,4359)'TFLX',I,J,M,N4,N5,N6,TFREEZ,TK1(N6,N5,N4),PSISVL +C 2,TFLX,TFLXH,TFLXL(N,N6,N5,N4),WFLX,WFLXH +C 2,WFLXL(N,N6,N5,N4),WFLXLH(N,N6,N5,N4) +C 4,VOLW1(N6,N5,N4),VOLWH1(N6,N5,N4) +C 4,VOLI1(N6,N5,N4),VOLIH1(N6,N5,N4) +C 5,FGRD(N6,N5,N4),FMAC(N6,N5,N4) +4359 FORMAT(A8,6I4,20E12.4) +C ENDIF + ENDIF +C +C TOTAL WATER, VAPOR AND HEAT FLUXES +C + THAW(N,N6,N5,N4)=THAW(N,N6,N5,N4)+WFLXL(N,N6,N5,N4) + THAWH(N,N6,N5,N4)=THAWH(N,N6,N5,N4)+WFLXLH(N,N6,N5,N4) + HTHAW(N,N6,N5,N4)=HTHAW(N,N6,N5,N4)+TFLXL(N,N6,N5,N4) + FLW(N,N6,N5,N4)=FLW(N,N6,N5,N4)+FLWL(N,N6,N5,N4) + FLWX(N,N6,N5,N4)=FLWX(N,N6,N5,N4)+FLWLX(N,N6,N5,N4) + FLWH(N,N6,N5,N4)=FLWH(N,N6,N5,N4)+FLWHL(N,N6,N5,N4) + HFLW(N,N6,N5,N4)=HFLW(N,N6,N5,N4)+HFLWL(N,N6,N5,N4) + FLWM(M,N,N6,N5,N4)=FLWL(N,N6,N5,N4) + IF(N.EQ.3)THEN + HYSM(M,N6,N5,N4)=HYST(N6,N5,N4) + IF(PSISA1.GT.PSISA(N3,N2,N1).AND.VOLPX1(N6,N5,N4).GT.ZEROS(N5,N4) + 2.AND.HYST(N6,N5,N4).GT.ZERO)THEN + HYST(N6,N5,N4)=AMIN1(1.0,AMAX1(0.0,HYST(N6,N5,N4) + 2-FLWL(N,N6,N5,N4)/VOLPX1(N6,N5,N4))) + ENDIF +C +C WATER FILM THICKNESS FOR CALCULATING GAS EXCHANGE IN 'TRNSFR' +C +C IF(BKVL(N6,N5,N4).GT.0.0)THEN + FILM(M,N6,N5,N4)=AMAX1(1.0E-06 + 2,EXP(-13.833-0.857*LOG(-PSISM1(N6,N5,N4)))) +C ELSE +C FILM(M,N6,N5,N4)=DLYR(3,N6,N5,N4) +C ENDIF + HYST(N6,N5,N4)=HYST(N6,N5,N4)+(1.0-HYST(N6,N5,N4))*HYSTX + ENDIF + ELSEIF(N.NE.3)THEN + FLWL(N,N6,N5,N4)=0.0 + FLWLX(N,N6,N5,N4)=0.0 + FLWHL(N,N6,N5,N4)=0.0 + HFLWL(N,N6,N5,N4)=0.0 + FLWHM(M,N,N6,N5,N4)=0.0 + ENDIF +4320 CONTINUE +4400 CONTINUE +9890 CONTINUE +9895 CONTINUE +C +C BOUNDARY WATER AND HEAT FLUXES +C + DO 9595 NX=NHW,NHE + DO 9590 NY=NVN,NVS + DO 9585 L=NU(NY,NX),NL(NY,NX) + TVOLZ1=TVOL1(NY,NX) + VOLWZ1=TVOLW(NY,NX) + VOLP2=VOLP1(L,NY,NX) + VOLPX2=VOLPX1(L,NY,NX) + VOLPH2=VOLPH1(L,NY,NX) +C +C IDENTIFY CONDITIONS FOR MICROPRE DISCHARGE TO WATER TABLE +C + IF(IPRC(NY,NX).NE.0.AND.DPTH(L,NY,NX).LT.DTBLX(NY,NX))THEN + IF(PSISM1(L,NY,NX).GE.PSISE(L,NY,NX) + 2+0.0098*(DPTH(L,NY,NX)-DTBLX(NY,NX)))THEN + IFLGU=0 + DO 9565 LL=MIN(L+1,NL(NY,NX)),NL(NY,NX) + IF(DPTH(LL,NY,NX).LT.DTBLX(NY,NX))THEN + IF((PSISM1(LL,NY,NX).LT.PSISA(LL,NY,NX).AND.L.NE.NL(NY,NX)) + 2.OR.DPTH(LL,NY,NX).GT.DPTHA(NY,NX))THEN + IFLGU=1 + ENDIF + ENDIF +9565 CONTINUE + ELSE + IFLGU=1 + ENDIF + ELSE + IFLGU=1 + ENDIF +C +C IDENTIFY CONDITIONS FOR MACROPORE DISCHARGE TO WATER TABLE +C + IF(VOLAH1(L,NY,NX).GT.ZEROS(NY,NX))THEN + DPTHH=CDPTH(L,NY,NX)-(VOLWH1(L,NY,NX)+VOLIH1(L,NY,NX)) + 2/VOLAH1(L,NY,NX)*DLYR(3,L,NY,NX) + ELSE + DPTHH=CDPTH(L,NY,NX) + ENDIF + IF(IPRC(NY,NX).NE.0.AND.DPTHH.LT.DTBLX(NY,NX) + 2.AND.VOLWH1(L,NY,NX).GT.ZEROS(NY,NX))THEN + IFLGUH=0 + DO 9566 LL=MIN(L+1,NL(NY,NX)),NL(NY,NX) + IF(DPTH(LL,NY,NX).LT.DTBLX(NY,NX))THEN + IF(VOLAH1(LL,NY,NX).LE.ZEROS(NY,NX))THEN + IFLGUH=1 + ENDIF + ENDIF +9566 CONTINUE + ELSE + IFLGUH=1 + ENDIF +C IF((I/30)*30.EQ.I.AND.M.EQ.1)THEN +C WRITE(*,9567)'IFLGU',I,J,M,NX,NY,L,IFLGU,IFLGUH,PSISM1(L,NY,NX) +C 2,PSISE(L,NY,NX),DPTH(L,NY,NX),DTBLX(NY,NX),PSISE(L,NY,NX) +C 2+0.0098*(DPTH(L,NY,NX)-DTBLX(NY,NX)),THETX +C 3,VOLAH1(L,NY,NX),VOLWH1(L,NY,NX),VOLIH1(L,NY,NX),CDPTH(L,NY,NX) +C 4,DLYR(3,L,NY,NX),DTBLZ(NY,NX),DPTHH +9567 FORMAT(A8,8I4,20E12.4) +C ENDIF +C +C LOCATE ALL EXTERNAL BOUNDARIES AND SET BOUNDARY CONDITIONS +C ENTERED IN 'READS' +C + N1=NX + N2=NY + N3=L + DO 9580 N=1,3 + DO 9575 NN=1,2 + IF(N.EQ.1)THEN + N4=NX+1 + N5=NY + N6=L + WDTH=DLYR(2,NU(NY,NX),NY,NX) + IF(NN.EQ.1)THEN + IF(NX.EQ.NHE)THEN + M1=NX + M2=NY + M3=L + M4=NX+1 + M5=NY + M6=L + XN=-1.0 + RCHQF=RCHQE(M2,M1) + RCHGFU=RCHGEU(M2,M1) + RCHGFT=RCHGET(M2,M1) + ELSE + GO TO 9575 + ENDIF + ELSEIF(NN.EQ.2)THEN + IF(NX.EQ.NHW)THEN + M1=NX+1 + M2=NY + M3=L + M4=NX + M5=NY + M6=L + XN=1.0 + RCHQF=RCHQW(M5,M4) + RCHGFU=RCHGWU(M5,M4) + RCHGFT=RCHGWT(M5,M4) + ELSE + GO TO 9575 + ENDIF + ENDIF + ELSEIF(N.EQ.2)THEN + N4=NX + N5=NY+1 + N6=L + WDTH=DLYR(1,NU(NY,NX),NY,NX) + IF(NN.EQ.1)THEN + IF(NY.EQ.NVS)THEN + M1=NX + M2=NY + M3=L + M4=NX + M5=NY+1 + M6=L + XN=-1.0 + RCHQF=RCHQS(M2,M1) + RCHGFU=RCHGSU(M2,M1) + RCHGFT=RCHGST(M2,M1) + ELSE + GO TO 9575 + ENDIF + ELSEIF(NN.EQ.2)THEN + IF(NY.EQ.NVN)THEN + M1=NX + M2=NY+1 + M3=L + M4=NX + M5=NY + M6=L + XN=1.0 + RCHQF=RCHQN(M5,M4) + RCHGFU=RCHGNU(M5,M4) + RCHGFT=RCHGNT(M5,M4) + ELSE + GO TO 9575 + ENDIF + ENDIF + ELSEIF(N.EQ.3)THEN + N4=NX + N5=NY + N6=L+1 + IF(NN.EQ.1)THEN + IF(L.EQ.NL(NY,NX))THEN + M1=NX + M2=NY + M3=L + M4=NX + M5=NY + M6=L+1 + XN=-1.0 + RCHGFU=RCHGD(M2,M1) + RCHGFT=1.0 + ELSE + GO TO 9575 + ENDIF + ELSEIF(NN.EQ.2)THEN + GO TO 9575 + ENDIF + ENDIF +C +C BOUNDARY SURFACE RUNOFF DEPENDING ON ASPECT, SLOPE +C VELOCITY, HYDRAULIC RADIUS AND SURFACE WATER STORAGE +C + IF(L.EQ.NU(N2,N1).AND.N.NE.3)THEN + IF(IRCHG(NN,N,N2,N1).EQ.0.OR.RCHQF.EQ.0.0)THEN + V=0.0 + QR1(N,M5,M4)=0.0 + HQR1(N,M5,M4)=0.0 + ELSE +C +C RUNOFF +C + ALT1=ALTG(N2,N1)+TVOLZ1/AREA(3,NU(N2,N1),N2,N1) + ALT2=ALTG(N2,N1)+VOLWG(N2,N1)/AREA(3,NU(N2,N1),N2,N1) + 2-GSIN(N2,N1)*DLYR(N,NU(N2,N1),N2,N1) + IF(ALT1.GT.ALT2.AND.TVOLZ1.GT.VOLWG(N2,N1))THEN + QRX1=TVOLZ1-VOLWG(N2,N1) + D=QRX1/AREA(3,0,N2,N1) + R=D/2.828 + S=(ALT1-ALT2)/DLYR(N,NU(N2,N1),N2,N1) + V=R**0.67*SQRT(S)/ZM(N2,N1) + Q=V*D*AMIN1(1.0,D/ZS(N2,N1))*WDTH*3.6E+03*XNPH*RCHQF + QR1(N,M5,M4)=-XN*AMIN1(Q,0.25*QRX1)*VOLWZ1/TVOLZ1*RCHQF + HQR1(N,M5,M4)=4.19*TK1(0,N2,N1)*QR1(N,M5,M4) + VOLWZ1=VOLWZ1+XN*QR1(N,M5,M4) + TVOLZ1=TVOLZ1+XN*QR1(N,M5,M4) + ELSEIF(DTBLX(N2,N1).LT.0.0)THEN +C +C RUNON +C + QRX1=AMIN1(0.0,DTBLX(N2,N1)+TVOLZ1/AREA(3,NU(N2,N1),N2,N1)) + 2*AREA(3,NU(N2,N1),N2,N1) + QR1(N,M5,M4)=-XN*0.25*QRX1*RCHQF + HQR1(N,M5,M4)=4.19*TK1(0,N2,N1)*QR1(N,M5,M4) + VOLWZ1=VOLWZ1+XN*QR1(N,M5,M4) + TVOLZ1=TVOLZ1+XN*QR1(N,M5,M4) + ELSE + V=0.0 + QR1(N,M5,M4)=0.0 + HQR1(N,M5,M4)=0.0 + ENDIF + QR(N,M5,M4)=QR(N,M5,M4)+QR1(N,M5,M4) + HQR(N,M5,M4)=HQR(N,M5,M4)+HQR1(N,M5,M4) + QRM(M,N,M5,M4)=QR1(N,M5,M4) + QRV(M,N,M5,M4)=V + QS1(N,M5,M4)=0.0 + QW1(N,M5,M4)=0.0 + QI1(N,M5,M4)=0.0 + HQS1(N,M5,M4)=0.0 + QS(N,M5,M4)=QS(N,M5,M4)+QS1(N,M5,M4) + QW(N,M5,M4)=QW(N,M5,M4)+QW1(N,M5,M4) + QI(N,M5,M4)=QI(N,M5,M4)+QI1(N,M5,M4) + HQS(N,M5,M4)=HQS(N,M5,M4)+HQS1(N,M5,M4) + QSM(M,N,M5,M4)=QS1(N,M5,M4) +C IF((I/10)*10.EQ.I.AND.M.EQ.NPH)THEN +C WRITE(*,7744)'QRB',I,J,M,N1,N2,N3,M4,M5,M6,N,NN,IRCHG(NN,N,N2,N1) +C 2,QR(N,M5,M4),QR1(N,M5,M4),Q,QRX1,V,S,D,ALT1,ALT2,ZM(N2,N1) +C 3,ZS(N2,N1),VOLWZ1,TVOLZ1,RCHQF,VOLWG(N2,N1),VOLW1(0,N2,N1) +C 4,VOLI1(0,N2,N1),TVOLW(N2,N1),FVOLW1,FVOLH1,PSISM1(0,N2,N1) +C 7,VOLWRX(N2,N1),FLWL(3,0,N2,N1),FLWRL(N2,N1) +7744 FORMAT(A8,12I4,30E12.4) +C ENDIF + ENDIF + ENDIF +C +C BOUNDARY SUBSURFACE WATER AND HEAT TRANSFER DEPENDING +C ON LEVEL OF WATER TABLE +C + IF(NCN(N2,N1).NE.3.OR.N.EQ.3)THEN +C +C IF NO WATER TABLE +C + IF(IPRC(N2,N1).EQ.0.OR.N.EQ.3)THEN + THETA1=AMAX1(THETY(N3,N2,N1),AMIN1(POROS(N3,N2,N1) + 2,VOLW1(N3,N2,N1)/VOLX(N3,N2,N1))) + THETAX=AMAX1(THETY(N3,N2,N1),AMIN1(POROS(N3,N2,N1) + 2,VOLWX1(N3,N2,N1)/VOLX(N3,N2,N1))) + K1=MAX(1,MIN(100,INT(100.0*(POROS(N3,N2,N1) + 2-THETA1)/POROS(N3,N2,N1))+1)) + KX=MAX(1,MIN(100,INT(100.0*(POROS(N3,N2,N1) + 2-THETAX)/POROS(N3,N2,N1))+1)) + CND1=HCND(N,K1,N3,N2,N1)*XNPH + CNDX=HCND(N,KX,N3,N2,N1)*XNPH + FLWL(N,M6,M5,M4)=AMIN1(VOLW1(N3,N2,N1)*XNPH + 2,XN*0.0098*-ABS(SLOPE(N,N2,N1))*CND1*AREA(3,N3,N2,N1)) + 3*RCHGFU*RCHGFT + FLWLX(N,M6,M5,M4)=AMIN1(VOLWX1(N3,N2,N1)*XNPH + 2,XN*0.0098*-ABS(SLOPE(N,N2,N1))*CNDX*AREA(3,N3,N2,N1)) + 3*RCHGFU*RCHGFT + FLWHL(N,M6,M5,M4)=AMIN1(VOLWH1(L,NY,NX) + 2,XN*0.0098*-ABS(SLOPE(N,N2,N1))*CNDH1(L,NY,NX)*AREA(3,N3,N2,N1)) + 3*RCHGFU*RCHGFT + HFLWL(N,M6,M5,M4)=4.19*TK1(N3,N2,N1) + 2*(FLWL(N,M6,M5,M4)+FLWHL(N,M6,M5,M4)) +C IF(J.EQ.12.AND.M.EQ.1)THEN +C WRITE(*,4443)'ABV',I,J,M,N,NN,M4,M5,M6,XN,FLWL(N,M6,M5,M4) +C 2,VOLP2,RCHGFU,VOLX(N3,N2,N1),VOLW1(N3,N2,N1) +C 3,VOLWH1(N3,N2,N1),VOLPH1(N3,N2,N1),VOLPH2,VOLI1(N3,N2,N1) +C 4,VOLIH1(N3,N2,N1),VOLP1(N3,N2,N1),HFLWL(N,M6,M5,M4) +C 5,PSISM1(N3,N2,N1),PSISE(N3,N2,N1),FLWHL(N,M6,M5,M4),DDRG(N2,N1) +C 6,SLOPE(N,N2,N1) +4443 FORMAT(A8,8I4,30E12.4) +C ENDIF + ELSE +C +C MICROPORE DISCHARGE ABOVE WATER TABLE +C + IF(IFLGU.EQ.0.AND.RCHGFT.NE.0.0)THEN + PSISWD=XN*0.005*SLOPE(N,N2,N1)*DLYR(N,N3,N2,N1) + 2*(1.0-DTBLG(N2,N1)) + PSISWT=AMIN1(0.0,PSISE(N3,N2,N1)-PSISM1(N3,N2,N1) + 2+0.0098*(DPTH(N3,N2,N1)-DTBLX(N2,N1)) + 3-0.0098*AMAX1(0.0,DPTH(N3,N2,N1)-DPTHT(N2,N1))) + IF(PSISWT.LT.0.0)PSISWT=PSISWT-PSISWD + FLWT=PSISWT*HCND(N,1,N3,N2,N1)*XNPH*AREA(N,N3,N2,N1) + 2*(1.0-AREAU(N3,N2,N1))/(RCHGFU+1.0)*RCHGFT + FLWL(N,M6,M5,M4)=XN*FLWT + FLWLX(N,M6,M5,M4)=XN*FLWT + HFLWL(N,M6,M5,M4)=4.19*TK1(N3,N2,N1)*XN*FLWT +C WRITE(*,4445)'DISCHMI',I,J,M,N1,N2,N3,M4,M5,M6,N,NN,XN +C 2,FLWL(N,M6,M5,M4),FLWT,PSISWT,HCND(N,1,N3,N2,N1) +C 3,AREA(N,N3,N2,N1),AREAU(N3,N2,N1),RCHGFU,RCHGFT +4445 FORMAT(A8,11I4,30E12.4) + ELSE + FLWL(N,M6,M5,M4)=0.0 + FLWLX(N,M6,M5,M4)=0.0 + HFLWL(N,M6,M5,M4)=0.0 + ENDIF +C +C MACROPORE DISCHARGE ABOVE WATER TABLE +C + IF(IFLGUH.EQ.0.AND.RCHGFT.NE.0.0)THEN + PSISWD=XN*0.005*SLOPE(N,N2,N1)*DLYR(N,N3,N2,N1) + 2*(1.0-DTBLG(N2,N1)) + PSISWTH=0.0098*(DPTHH-DTBLX(N2,N1)) + 2-0.0098*AMAX1(0.0,DPTHH-DPTHT(N2,N1)) + IF(PSISWTH.LT.0.0)PSISWTH=PSISWTH-PSISWD + FLWTH=PSISWTH*CNDH1(N3,N2,N1)*AREA(N,N3,N2,N1) + 2*(1.0-AREAU(N3,N2,N1))/(RCHGFU+1.0)*RCHGFT + FLWTHL=AMAX1(FLWTH,AMIN1(0.0,-XNPH*(VOLWH1(N3,N2,N1) + 2+FLWHL(3,N3,N2,N1)-FLWHL(3,N3+1,N2,N1)-FINHL(N3,N2,N1)))) + FLWHL(N,M6,M5,M4)=XN*FLWTHL + HFLWL(N,M6,M5,M4)=HFLWL(N,M6,M5,M4)+4.19*TK1(N3,N2,N1)*XN*FLWTHL +C WRITE(*,4446)'DISCHMA',I,J,M,N1,N2,N3,M4,M5,M6,N,NN,XN +C 2,FLWHL(N,M6,M5,M4),FLWTHL,FLWTH,PSISWTH,CNDH1(N3,N2,N1) +C 3,DPTH(N3,N2,N1),DLYR(3,N3,N2,N1),DPTHH,VOLWH1(N3,N2,N1) +C 4,VOLIH1(L,NY,NX),VOLAH1(N3,N2,N1),DTBLX(N2,N1),PSISWD +4446 FORMAT(A8,11I4,30E12.4) + ELSE + FLWHL(N,M6,M5,M4)=0.0 + ENDIF +C +C MICROPORE RECHARGE BELOW WATER TABLE +C + IF(IPRC(N2,N1).NE.3.AND.DPTH(N3,N2,N1).GT.DTBLX(N2,N1) +C 2.AND.DPTHA(N2,N1).GT.DTBLX(N2,N1) + 2.AND.(BKDS(N3,N2,N1).EQ.0.0.OR.VOLP2.GT.0.0))THEN + PSISWD=XN*0.005*SLOPE(N,N2,N1)*DLYR(N,N3,N2,N1) + 2*(1.0-DTBLG(N2,N1)) + PSISUT=AMAX1(0.0,PSISE(N3,N2,N1)-PSISM1(N3,N2,N1) + 2+0.0098*(DPTH(N3,N2,N1)-DTBLX(N2,N1))) + IF(PSISUT.GT.0.0)PSISUT=PSISUT+PSISWD + FLWU=PSISUT*HCND(N,1,N3,N2,N1)*XNPH*AREA(N,N3,N2,N1) + 2*AREAU(N3,N2,N1)/(RCHGFU+1.0)*RCHGFT + FLWUL=AMIN1(FLWU,AMAX1(0.0,VOLP2)) + FLWUX=AMIN1(FLWU,AMAX1(0.0,VOLPX2)) + FLWL(N,M6,M5,M4)=FLWL(N,M6,M5,M4)+XN*FLWUL + FLWLX(N,M6,M5,M4)=FLWLX(N,M6,M5,M4)+XN*FLWUX + HFLWL(N,M6,M5,M4)=HFLWL(N,M6,M5,M4)+4.19*TK1(N3,N2,N1) + 2*XN*FLWUL +C IF((I/30)*30.EQ.I.AND.J.EQ.15)THEN +C WRITE(*,4444)'RECHGMI',I,J,M,N1,N2,N3,M4,M5,M6,N,NN,IFLGU,XN +C 2,FLWL(N,M6,M5,M4),AREAU(N3,N2,N1),RCHGFT,VOLP2,FLWT +C 3,FLWU,FLWUL,PSISM1(N3,N2,N1),PSISA(N3,N2,N1) +C 4,PSISWT,PSISUT,PSISUTH,HCND(N,1,N3,N2,N1) +C 5,DTBLX(N2,N1),CDPTH(N3,N2,N1),DPTHT(N2,N1) +C 6,DDRG(N2,N1),DPTH(N3,N2,N1),VOLW1(N3,N2,N1),VOLI1(N3,N2,N1) +C 7,VOLX(N3,N2,N1),VOLP1(N3,N2,N1) +C 8,RCHGFU,AREA(N,N3,N2,N1) +C 9,FINHL(N3,N2,N1),DLYR(N,N3,N2,N1),DLYR(3,N3,N2,N1),PSISWD +C 1,SLOPE(N,N2,N1) +4444 FORMAT(A8,12I4,40E12.4) +C ENDIF + ENDIF +C +C MACROPORE RECHARGE BELOW WATER TABLE +C + IF(IPRC(N2,N1).NE.3.AND.DPTHH.GT.DTBLX(N2,N1) +C 2.AND.DPTHA(N2,N1).GT.DTBLX(N2,N1) + 2.AND.VOLPH2.GT.0.0)THEN + PSISWD=XN*0.005*SLOPE(N,N2,N1)*DLYR(N,N3,N2,N1) + 2*(1.0-DTBLG(N2,N1)) + PSISUTH=0.0098*(DPTHH-DTBLX(N2,N1)) + IF(PSISUTH.GT.0.0)PSISUTH=PSISUTH+PSISWD + FLWUH=PSISUTH*CNDH1(N3,N2,N1)*AREA(N,N3,N2,N1) + 2*AREAU(N3,N2,N1)/(RCHGFU+1.0)*RCHGFT + FLWUHL=AMIN1(FLWUH,AMAX1(0.0,XNPH*(VOLPH2 + 2-FLWHL(3,N3,N2,N1)+FLWHL(3,N3+1,N2,N1)+FINHL(N3,N2,N1)))) + FLWHL(N,M6,M5,M4)=FLWHL(N,M6,M5,M4)+XN*FLWUHL + HFLWL(N,M6,M5,M4)=HFLWL(N,M6,M5,M4)+4.19*TK1(N3,N2,N1) + 2*XN*FLWUHL +C IF(I.GT.208.AND.J.EQ.21)THEN +C WRITE(*,4447)'RECHGMA',I,J,M,N1,N2,N3,M4,M5,M6,N,NN,IFLGU,XN +C 2,AREAU(N3,N2,N1),FLWUH,FLWUHL,DPTHH,PSISUTH,CNDH1(N3,N2,N1) +C 5,FLWHL(N,M6,M5,M4),DTBLX(N2,N1),CDPTH(N3,N2,N1),DPTHT(N2,N1) +C 6,DDRG(N2,N1),DPTH(N3,N2,N1),VOLWH1(N3,N2,N1),VOLPH1(N3,N2,N1) +C 8,FLWHL(3,N3,N2,N1),FLWHL(3,N3+1,N2,N1),RCHGFU,AREA(N,N3,N2,N1) +C 9,FINHL(N3,N2,N1),DLYR(N,N3,N2,N1),DLYR(3,N3,N2,N1),PSISWD +C 1,SLOPE(N,N2,N1) +4447 FORMAT(A8,12I4,40E12.4) +C ENDIF + ENDIF + ENDIF +C +C SUBSURFACE HEAT SOURCE/SINK +C + IF(N.EQ.3.AND.IETYP(N2,N1).NE.-2)THEN + HFLWL(N,M6,M5,M4)=HFLWL(N,M6,M5,M4)+(TK1(N3,N2,N1) + 2-TKSD(N2,N1))*TCNDG/(DPTHSK(N2,N1)-CDPTH(N3,N2,N1)) + 3*AREA(N,N3,N2,N1)*XNPH + ENDIF + VOLP2=VOLP2-XN*FLWL(N,M6,M5,M4) + VOLPX2=VOLPX2-XN*FLWLX(N,M6,M5,M4) + VOLPH2=VOLPH2-XN*FLWHL(N,M6,M5,M4) + FLWLD=0.0 + FLWLXD=0.0 + FLWHLD=0.0 + FLW(N,M6,M5,M4)=FLW(N,M6,M5,M4)+FLWL(N,M6,M5,M4) + FLWX(N,M6,M5,M4)=FLWX(N,M6,M5,M4)+FLWLX(N,M6,M5,M4) + FLWH(N,M6,M5,M4)=FLWH(N,M6,M5,M4)+FLWHL(N,M6,M5,M4) + HFLW(N,M6,M5,M4)=HFLW(N,M6,M5,M4)+HFLWL(N,M6,M5,M4) + FLWM(M,N,M6,M5,M4)=FLWL(N,M6,M5,M4) + FLWHM(M,N,M6,M5,M4)=FLWHL(N,M6,M5,M4) + ENDIF +9575 CONTINUE +C +C TOTAL WATER AND HEAT FLUXES IN EACH GRID CELL +C + IF(L.EQ.NU(N2,N1).AND.N.NE.3)THEN + TQR1(N2,N1)=TQR1(N2,N1)+QR1(N,N2,N1)-QR1(N,N5,N4) + THQR1(N2,N1)=THQR1(N2,N1)+HQR1(N,N2,N1)-HQR1(N,N5,N4) + TQS1(N2,N1)=TQS1(N2,N1)+QS1(N,N2,N1)-QS1(N,N5,N4) + TQW1(N2,N1)=TQW1(N2,N1)+QW1(N,N2,N1)-QW1(N,N5,N4) + TQI1(N2,N1)=TQI1(N2,N1)+QI1(N,N2,N1)-QI1(N,N5,N4) + THQS1(N2,N1)=THQS1(N2,N1)+HQS1(N,N2,N1)-HQS1(N,N5,N4) + ENDIF + IF(NCN(N2,N1).NE.3.OR.N.EQ.3)THEN + TFLWL(N3,N2,N1)=TFLWL(N3,N2,N1)+FLWL(N,N3,N2,N1) + 2-FLWL(N,N6,N5,N4) + TFLWLX(N3,N2,N1)=TFLWLX(N3,N2,N1)+FLWLX(N,N3,N2,N1) + 2-FLWLX(N,N6,N5,N4) + TFLWHL(N3,N2,N1)=TFLWHL(N3,N2,N1)+FLWHL(N,N3,N2,N1) + 2-FLWHL(N,N6,N5,N4) + THFLWL(N3,N2,N1)=THFLWL(N3,N2,N1)+HFLWL(N,N3,N2,N1) + 2-HFLWL(N,N6,N5,N4) + TWFLXL(N3,N2,N1)=TWFLXL(N3,N2,N1)+WFLXL(N,N3,N2,N1) + TWFLXH(N3,N2,N1)=TWFLXH(N3,N2,N1)+WFLXLH(N,N3,N2,N1) + TTFLXL(N3,N2,N1)=TTFLXL(N3,N2,N1)+TFLXL(N,N3,N2,N1) +C IF(L.EQ.NU(NY,NX))THEN +C WRITE(*,3378)'THFLWL',I,J,M,N1,N2,N3,N4,N5,N6,N,THFLWL(N3,N2,N1) +C 3,HFLWL(N,N3,N2,N1),HFLWL(N,N6,N5,N4),TFLWL(N3,N2,N1) +C 3,FLWL(N,N3,N2,N1),FLWL(N,N6,N5,N4),TFLWHL(N3,N2,N1) +C 3,FLWHL(N,N3,N2,N1),FLWHL(N,N6,N5,N4) +3378 FORMAT(A8,10I4,20E12.4) +C ENDIF + ENDIF +9580 CONTINUE +9585 CONTINUE +9590 CONTINUE +9595 CONTINUE +C +C UPDATE STATE VARIABLES FROM FLUXES CALCULATED ABOVE +C + IF(M.NE.NPH)THEN + DO 9795 NX=NHW,NHE + DO 9790 NY=NVN,NVS +C +C SNOWPACK WATER, ICE, SNOW AND TEMPERATURE +C + IF(VHCP0(NY,NX).GT.VHCPWX(NY,NX))THEN + VOLS0(NY,NX)=VOLS0(NY,NX)+FLW0S(NY,NX) + 2-WFLXA(NY,NX)-FLWS1(NY,NX)+TQS1(NY,NX) + VOLW0(NY,NX)=VOLW0(NY,NX)+FLW0L(NY,NX) + 2+WFLXA(NY,NX)+WFLXB(NY,NX)-FLWZ1(NY,NX)+TQW1(NY,NX) + VOLI0(NY,NX)=VOLI0(NY,NX) + 2-WFLXB(NY,NX)/0.92-FLWI1(NY,NX)+TQI1(NY,NX) + ENGY0=VHCP0(NY,NX)*TK0(NY,NX) + VHCP0(NY,NX)=2.095*VOLS0(NY,NX)+4.19*VOLW0(NY,NX) + 2+1.9274*VOLI0(NY,NX) + TK0(NY,NX)=(ENGY0+HFLW0L(NY,NX)+TFLX0(NY,NX)-HFLWZ1(NY,NX) + 2-HFLSI1(NY,NX)+THQS1(NY,NX))/VHCP0(NY,NX) + ELSE + VOLS0(NY,NX)=VOLS0(NY,NX)+FLQ0S(NY,NX)-FLWS1(NY,NX)+TQS1(NY,NX) + VOLW0(NY,NX)=VOLW0(NY,NX)+FLQ0W(NY,NX)-FLWZ1(NY,NX)+TQW1(NY,NX) + VOLI0(NY,NX)=VOLI0(NY,NX)-FLWI1(NY,NX)+TQI1(NY,NX) + VHCP0(NY,NX)=2.095*VOLS0(NY,NX)+4.19*VOLW0(NY,NX) + 2+1.9274*VOLI0(NY,NX) + TK0(NY,NX)=TKQ(NY,NX) + ENDIF +C IF(NX.EQ.2.AND.NY.EQ.2)THEN +C WRITE(*,7754)'TKW',I,J,M,NX,NY,TK0(NY,NX) +C 3,VOLS0(NY,NX),VOLW0(NY,NX),VOLI0(NY,NX),VOLS1(NY,NX) +C 3,FLW0S(NY,NX),WFLXA(NY,NX),FLWS1(NY,NX),TQS1(NY,NX) +C 4,FLW0L(NY,NX),WFLXB(NY,NX),FLWZ1(NY,NX),TQW1(NY,NX) +C 5,FLWI1(NY,NX),TQI1(NY,NX),THFLWW(NY,NX),HWFLQ0(NY,NX) +C 2,HFLW0L(NY,NX),TFLX0(NY,NX),HFLWZ1(NY,NX),HFLSI1(NY,NX) +C 4,THQS1(NY,NX),VHCP0(NY,NX),VHCPWX(NY,NX) +C ENDIF +C +C SURFACE RESIDUE WATER AND TEMPERATURE +C + TVOL1(NY,NX)=AMAX1(0.0,VOLW1(0,NY,NX)+VOLI1(0,NY,NX) + 2-VOLWRX(NY,NX)) + TVOLW(NY,NX)=AMAX1(0.0,VOLW1(0,NY,NX)-VOLWRX(NY,NX)) + VOLGM(M+1,NY,NX)=AMAX1(0.0,TVOL1(NY,NX)) +C VOLXP2=(VOLP1(NU(NY,NX),NY,NX)+VOLPH1(NU(NY,NX),NY,NX)) +C 2*AMIN1(1.0,(VOLA(NU(NY,NX),NY,NX)+VOLAH1(NU(NY,NX),NY,NX)) +C 3/TVOL1(NY,NX)) +C VOLPX1(NU(NY,NX),NY,NX)=VOLXP2*HYST(NU(NY,NX),NY,NX) + VOLW1(0,NY,NX)=AMAX1(0.0,VOLW1(0,NY,NX)+FLWRL(NY,NX)+WFLXR(NY,NX) + 2+TQR1(NY,NX)) + VOLI1(0,NY,NX)=AMAX1(0.0,VOLI1(0,NY,NX)-WFLXR(NY,NX)/0.92) + VOLP1(0,NY,NX)=AMAX1(0.0,VOLA(0,NY,NX)-VOLW1(0,NY,NX) + 2-VOLI1(0,NY,NX)) + VOLWM(M+1,0,NY,NX)=VOLW1(0,NY,NX) + VOLPM(M+1,0,NY,NX)=VOLP1(0,NY,NX) + IF(VOLR(NY,NX).GT.ZEROS(NY,NX))THEN + THETWX(0,NY,NX)=AMAX1(0.0,VOLW1(0,NY,NX)/VOLR(NY,NX)) + THETIX(0,NY,NX)=AMAX1(0.0,VOLI1(0,NY,NX)/VOLR(NY,NX)) + THETPX(0,NY,NX)=AMAX1(0.0,VOLP1(0,NY,NX)/VOLR(NY,NX)) + ELSE + THETWX(0,NY,NX)=0.0 + THETIX(0,NY,NX)=0.0 + THETPX(0,NY,NX)=0.0 + ENDIF + THETPM(M+1,0,NY,NX)=THETPX(0,NY,NX) +C IF(NX.EQ.1.AND.NY.EQ.6)THEN +C WRITE(*,7752)'VOLW10',I,J,M,NX,NY,VOLW1(0,NY,NX) +C 2,VOLI1(0,NY,NX),VOLP1(0,NY,NX),FLWRL(NY,NX),WFLXR(NY,NX) +C 2,TQR1(NY,NX),TRC0(NY,NX),VHCPR1(NY,NX),VHCPRX(NY,NX),CVRD(NY,NX) +C 4,FLWR(NY,NX),VOLA(0,NY,NX),VOLWRX(NY,NX),VOLR(NY,NX) +C 2,ORGC(0,NY,NX),PSISM1(0,NY,NX) +7752 FORMAT(A8,5I4,20E12.4) +C ENDIF + ENGYR=VHCPR1(NY,NX)*TK1(0,NY,NX) + VHCPR1(NY,NX)=2.496E-06*ORGC(0,NY,NX)+4.19*VOLW1(0,NY,NX) + 2+1.9274*VOLI1(0,NY,NX) + IF(VHCPR1(NY,NX).GT.VHCPRX(NY,NX))THEN + TK1(0,NY,NX)=(ENGYR+HFLWRL(NY,NX)+TFLXR(NY,NX) + 2+THQR1(NY,NX))/VHCPR1(NY,NX) +C WRITE(*,7754)'TKR',I,J,M,NX,NY,TK1(0,NY,NX),ENGYR,HFLWRL(NY,NX) +C 2,TFLXR(NY,NX),THQR1(NY,NX),VHCPR1(NY,NX),VOLW1(0,NY,NX) +7754 FORMAT(A8,5I4,30E12.4) + ELSE + TK1(0,NY,NX)=TK1(NU(NY,NX),NY,NX) + ENDIF +C +C SOIL SURFACE WATER FROM RUNOFF +C + VOLI1(NU(NY,NX),NY,NX)=VOLI1(NU(NY,NX),NY,NX)+FLSI1(NY,NX) + ENGY1=VHCP1(NU(NY,NX),NY,NX)*TK1(NU(NY,NX),NY,NX) + VHCP1(NU(NY,NX),NY,NX)=VHCM(NU(NY,NX),NY,NX) + 2+4.19*(VOLW1(NU(NY,NX),NY,NX)+VOLWH1(NU(NY,NX),NY,NX)) + 3+1.9274*(VOLI1(NU(NY,NX),NY,NX)+VOLIH1(NU(NY,NX),NY,NX)) + TK1(NU(NY,NX),NY,NX)=(ENGY1+HFLSI1(NY,NX)) + 2/VHCP1(NU(NY,NX),NY,NX) +C WRITE(*,7755)'TQR',I,J,M,NX,NY,VOLW1(NU(NY,NX),NY,NX) +C 2,VOLWH1(NU(NY,NX),NY,NX),TQR1(NY,NX) +C WRITE(*,7755)'TK1',I,J,M,NX,NY,TK1(NU(NY,NX),NY,NX) +C 2,VHCP1(NU(NY,NX),NY,NX),VHCM(NU(NY,NX),NY,NX) +C 2,ENGY1,THQR1(NY,NX),HFLSI1(NY,NX),TQR1(NY,NX) +C 3,VOLW1(NU(NY,NX),NY,NX),VOLWH1(NU(NY,NX),NY,NX) +C 4,VOLI1(NU(NY,NX),NY,NX),FLSI1(NY,NX) +7755 FORMAT(A8,5I4,20E12.4) +C +C SOIL LAYER WATER, ICE AND TEMPERATURE +C + DO 9785 L=NU(NY,NX),NL(NY,NX) + VOLW1(L,NY,NX)=VOLW1(L,NY,NX)+TFLWL(L,NY,NX) + 2+FINHL(L,NY,NX)+TWFLXL(L,NY,NX)+FLU1(L,NY,NX) + VOLWX1(L,NY,NX)=VOLWX1(L,NY,NX)+TFLWLX(L,NY,NX) + 2+FINHL(L,NY,NX)+TWFLXL(L,NY,NX)+FLU1(L,NY,NX)+FLWVL(L,NY,NX) + VOLWX1(L,NY,NX)=AMIN1(VOLW1(L,NY,NX),VOLWX1(L,NY,NX)) + VOLI1(L,NY,NX)=VOLI1(L,NY,NX)-TWFLXL(L,NY,NX)/0.92 + VOLWH1(L,NY,NX)=VOLWH1(L,NY,NX)+TFLWHL(L,NY,NX) + 2-FINHL(L,NY,NX)+TWFLXH(L,NY,NX) + VOLIH1(L,NY,NX)=VOLIH1(L,NY,NX)-TWFLXH(L,NY,NX)/0.92 + VOLP1(L,NY,NX)=AMAX1(0.0,VOLA(L,NY,NX)-VOLW1(L,NY,NX) + 2-VOLI1(L,NY,NX)) + VOLAH1(L,NY,NX)=AMAX1(0.0,VOLAH(L,NY,NX)-FVOLAH*CCLAY(L,NY,NX) + 2*(VOLW1(L,NY,NX)/VOLX(L,NY,NX)-WP(L,NY,NX))*VOLT(L,NY,NX)) + VOLPH1(L,NY,NX)=AMAX1(0.0,VOLAH1(L,NY,NX)-VOLWH1(L,NY,NX) + 2-VOLIH1(L,NY,NX)) + VOLPX1(L,NY,NX)=VOLP1(L,NY,NX)*HYST(L,NY,NX) + VOLWM(M+1,L,NY,NX)=VOLW1(L,NY,NX) + VOLWHM(M+1,L,NY,NX)=VOLWH1(L,NY,NX) + VOLPM(M+1,L,NY,NX)=VOLP1(L,NY,NX)+VOLPH1(L,NY,NX) +C 2+THETPI*(VOLI1(L,NY,NX)+VOLIH1(L,NY,NX)) + FLPM(M,L,NY,NX)=VOLPM(M,L,NY,NX)-VOLPM(M+1,L,NY,NX) + THETWX(L,NY,NX)=AMAX1(0.0,(VOLW1(L,NY,NX)+VOLWH1(L,NY,NX)) + 2/VOLT(L,NY,NX)) + THETIX(L,NY,NX)=AMAX1(0.0,(VOLI1(L,NY,NX)+VOLIH1(L,NY,NX)) + 2/VOLT(L,NY,NX)) + THETPX(L,NY,NX)=AMAX1(0.0,(VOLP1(L,NY,NX)+VOLPH1(L,NY,NX)) + 2/VOLT(L,NY,NX)) + THETPM(M+1,L,NY,NX)=THETPX(L,NY,NX) + IF(VOLA(L,NY,NX)+VOLAH(L,NY,NX).GT.ZEROS(NY,NX))THEN + THETPY(L,NY,NX)=AMAX1(0.0,(VOLP1(L,NY,NX)+VOLPH1(L,NY,NX)) + 2/(VOLA(L,NY,NX)+VOLAH(L,NY,NX))) + ELSE + THETPY(L,NY,NX)=0.0 + ENDIF + IF(VOLAH(L,NY,NX).GT.ZEROS(NY,NX))THEN + FMAC(L,NY,NX)=FHOL(L,NY,NX)*VOLAH1(L,NY,NX)/VOLAH(L,NY,NX) + CNDH1(L,NY,NX)=XNPH*NHOL(L,NY,NX)*CNDH(L,NY,NX) + 2*(VOLAH1(L,NY,NX)/VOLAH(L,NY,NX))**2 + ELSE + FMAC(L,NY,NX)=0.0 + CNDH1(L,NY,NX)=0.0 + ENDIF + FGRD(L,NY,NX)=1.0-FMAC(L,NY,NX) + TKXX=TK1(L,NY,NX) + VHXX=VHCP1(L,NY,NX) + ENGY1=VHCP1(L,NY,NX)*TK1(L,NY,NX) + VHCP1(L,NY,NX)=VHCM(L,NY,NX)+4.19*(VOLW1(L,NY,NX) + 2+VOLWH1(L,NY,NX))+1.9274*(VOLI1(L,NY,NX)+VOLIH1(L,NY,NX)) +C +C ARTIFICIAL SOIL WARMING +C +C IF(NX.EQ.3.AND.NY.EQ.2.AND.L.GT.NU(NY,NX) +C 3.AND.L.LE.17.AND.I.GE.152.AND.I.LE.304)THEN +C THFLWL(L,NY,NX)=THFLWL(L,NY,NX) +C 2+(TKSZ(I,J,L)-TK1(L,NY,NX))*VHCP1(L,NY,NX)*XNPH +C WRITE(*,3379)'TKSZ',I,J,M,NX,NY,L,TKSZ(I,J,L) +C 2,TK1(L,NY,NX),VHCP1(L,NY,NX),THFLWL(L,NY,NX) +3379 FORMAT(A8,6I4,12E12.4) +C ENDIF +C +C ARTIFICIAL SOIL WARMING +C + TK1(L,NY,NX)=(ENGY1+THFLWL(L,NY,NX)+TTFLXL(L,NY,NX) + 2+HWFLU1(L,NY,NX))/VHCP1(L,NY,NX) +C IF(J.EQ.24.AND.L.EQ.NU(NY,NX))THEN +C WRITE(*,3377)'VOLW1',I,J,M,NX,NY,L,VOLW1(L,NY,NX) +C 2,VOLWH1(L,NY,NX),VOLI1(L,NY,NX),VOLIH1(L,NY,NX) +C 3,VOLP1(L,NY,NX),VOLPH1(L,NY,NX),VOLT(L,NY,NX) +C 4,VOLA(L,NY,NX),VOLAH(L,NY,NX) +C 5,VOLPM(M,L,NY,NX),VOLPM(M+1,L,NY,NX) +C 2,TFLWL(L,NY,NX),FINHL(L,NY,NX),TWFLXL(L,NY,NX),FLU1(L,NY,NX) +C 3,TQR1(NY,NX),VOLP1(L,NY,NX) +C 5,VOLPX1(L,NY,NX),HYST(L,NY,NX),PSISM1(L,NY,NX) +C 6,FLWL(3,L,NY,NX),FLWL(3,L+1,NY,NX) +C 7,FLWL(2,L,NY,NX),FLWL(2,L,NY+1,NX) +C 8,FLWL(1,L,NY,NX),FLWL(1,L,NY,NX+1) +C 9,FLPM(M,L,NY,NX) +C WRITE(*,3377)'VOLWH1',I,J,M,NX,NY,L,VOLWH1(L,NY,NX) +C 2,TFLWHL(L,NY,NX),FINHL(L,NY,NX),VOLIH1(L,NY,NX) +C 4,TWFLXH(L,NY,NX),TQR1(NY,NX),VOLPH1(L,NY,NX) +C 5,FLWHL(2,L,NY,NX),FLWHL(2,L,NY+1,NX) +C WRITE(*,3377)'TKL',I,J,M,NX,NY,L,TK1(L,NY,NX),ENGY1 +C 2,THFLWL(L,NY,NX),TTFLXL(L,NY,NX),HWFLU1(L,NY,NX),VHCP1(L,NY,NX) +C 3,VHCM(L,NY,NX),VOLW1(L,NY,NX),VOLWH1(L,NY,NX),VOLI1(L,NY,NX) +C 4,THETW(L,NY,NX),THETI(L,NY,NX),FINHL(L,NY,NX),THQR1(NY,NX) +C 5,HFLSI1(NY,NX),HFLWL(2,L,NY,NX),HFLWL(2,L,NY+1,NX) +3377 FORMAT(A8,6I4,40E12.4) +C ENDIF +9785 CONTINUE +9790 CONTINUE +9795 CONTINUE + ENDIF +3320 CONTINUE + RETURN + END diff --git a/f77src/wouts.f b/f77src/wouts.f index 574f354..b9de5c0 100755 --- a/f77src/wouts.f +++ b/f77src/wouts.f @@ -46,7 +46,7 @@ SUBROUTINE wouts(I,NHW,NHE,NVN,NVS) 6,(TDCNO(NY,NX,N),N=1,12) WRITE(21,93)I,IDATA(3),IFLGT(NY,NX),NU(NY,NX),IFNHB(NY,NX) 2,IFNOB(NY,NX),IFPOB(NY,NX),IUTYP(NY,NX),ZT(NY,NX),TFLWC(NY,NX) - 3,XTILL(NY,NX),ZS(NY,NX),THRMC(NY,NX),THRMG(NY,NX),TCNET(NY,NX) + 3,ZS(NY,NX),THRMC(NY,NX),THRMG(NY,NX),TCNET(NY,NX) 4,TVOLWC(NY,NX),VOLSS(NY,NX),VOLWS(NY,NX),VOLIS(NY,NX),VOLS(NY,NX) 5,DPTHS(NY,NX),TCW(NY,NX),TKW(NY,NX),VHCPW(NY,NX),VHCPR(NY,NX) 6,VOLWG(NY,NX),URAIN(NY,NX),ARLFC(NY,NX),ARSTC(NY,NX),PPT(NY,NX) From e2a3813d630e07c632284f959b96b95a5b2cc2f4 Mon Sep 17 00:00:00 2001 From: Jinyun Tang Date: Thu, 18 Apr 2019 15:05:54 -0700 Subject: [PATCH 2/2] new update for solution P and salts Some refinements in soil solution P and salts, and changes related to organic nutrients. --- f77src/blk11a.h | 2 +- f77src/blk11b.h | 2 +- f77src/blk12a.h | 41 +- f77src/blk12b.h | 5 +- f77src/blk13a.h | 48 +- f77src/blk13b.h | 8 +- f77src/blk13c.h | 8 +- f77src/blk15a.h | 45 +- f77src/blk15b.h | 1 + f77src/blk16.h | 3 +- f77src/blk18a.h | 2 +- f77src/blk18b.h | 3 +- f77src/blk19a.h | 44 +- f77src/blk19c.h | 17 +- f77src/blk19d.h | 4 +- f77src/blk20a.h | 2 +- f77src/blk20b.h | 4 +- f77src/blk20c.h | 4 +- f77src/blk20d.h | 1 + f77src/blk20e.h | 4 +- f77src/blk20f.h | 37 +- f77src/blk21a.h | 38 +- f77src/blk21b.h | 3 +- f77src/blk22a.h | 3 +- f77src/blk22b.h | 2 +- f77src/blkc.h | 2 +- f77src/day.f | 53 +- f77src/erosion.f | 6 + f77src/exec.f | 8 +- f77src/extract.f | 10 + f77src/grosub.f | 15057 +++++++++++++++++++++++---------------------- f77src/hfunc.f | 1343 ++-- f77src/hour1.f | 122 +- f77src/nitro.f | 5683 ++++++++--------- f77src/outsd.f | 54 +- f77src/outsh.f | 3 +- f77src/readi.f | 120 +- f77src/readq.f | 5 - f77src/reads.f | 15 +- f77src/redist.f | 11536 +++++++++++++++++----------------- f77src/routp.f | 2 + f77src/routq.f | 11 + f77src/routs.f | 20 +- f77src/solute.f | 7914 ++++++++++-------------- f77src/starte.f | 2033 +++--- f77src/startq.f | 1 + f77src/starts.f | 2485 ++++---- f77src/trnsfr.f | 9457 ++++++++++++++-------------- f77src/trnsfrs.f | 915 ++- f77src/uptake.f | 160 +- f77src/watsub.f | 6201 +++++++++---------- f77src/woutp.f | 2 + f77src/wouts.f | 20 +- 53 files changed, 31242 insertions(+), 32327 deletions(-) diff --git a/f77src/blk11a.h b/f77src/blk11a.h index 8999070..6f3d8a3 100755 --- a/f77src/blk11a.h +++ b/f77src/blk11a.h @@ -6,7 +6,7 @@ 6,TVOLWC(JY,JX),VOLSS(JY,JX),VOLWS(JY,JX),VOLIS(JY,JX) 7,VOLS(JY,JX),THETW(0:JZ,JY,JX),THETI(0:JZ,JY,JX),THETP(0:JZ,JY,JX) 8,PSISM(0:JZ,JY,JX),PSIST(JZ,JY,JX),RSCS(JZ,JY,JX),VOLA(0:JZ,JY,JX) - 9,VOLAH(JZ,JY,JX),CNDH(JZ,JY,JX),CNDU(JZ,JY,JX) + 9,VOLAH(JZ,JY,JX),CNDH(JZ,JY,JX),CNDU(JZ,JY,JX),VOLWD(JY,JX) 1,VHCM(JZ,JY,JX),VOLWX(0:JZ,JY,JX),STC(JZ,JY,JX) 2,DTC(JZ,JY,JX),HCND(3,100,JZ,JY,JX),FINH(JZ,JY,JX),FLWV(JZ,JY,JX) 3,THAW(3,JZ,JY,JX),HTHAW(3,JZ,JY,JX),HTHAWW(JY,JX) diff --git a/f77src/blk11b.h b/f77src/blk11b.h index 8878014..72be857 100755 --- a/f77src/blk11b.h +++ b/f77src/blk11b.h @@ -6,7 +6,7 @@ 6,SCO2L(0:JZ,JY,JX),SOXYL(0:JZ,JY,JX),SCH4L(0:JZ,JY,JX) 7,SN2OL(0:JZ,JY,JX),SN2GL(0:JZ,JY,JX),SNH3L(0:JZ,JY,JX) 8,SH2GL(0:JZ,JY,JX),PSISE(0:JZ,JY,JX),PSISA(JZ,JY,JX) - 9,PSISO(JZ,JY,JX),PSISH(JZ,JY,JX),THETX + 9,PSISO(JZ,JY,JX),PSISH(JZ,JY,JX),THETX,THETPI,DENSI 1,THETY(0:JZ,JY,JX),FCR(JY,JX),VOLQ(0:JZ,JY,JX) 2,TFNQ(0:JZ,JY,JX),HGSGL(JZ,JY,JX),HLSGL(0:JZ,JY,JX) 3,THAWR(JY,JX),HTHAWR(JY,JX) diff --git a/f77src/blk12a.h b/f77src/blk12a.h index 209edea..897f4fd 100755 --- a/f77src/blk12a.h +++ b/f77src/blk12a.h @@ -1,20 +1,21 @@ - COMMON/BLK12A/WSTR(JP,JY,JX),OSTR(JP,JY,JX) - 2,RAD1(JP,JY,JX),THRM1(JP,JY,JX) - 3,EFLXC(JP,JY,JX),SFLXC(JP,JY,JX),HFLXC(JP,JY,JX),ENGYX(JP,JY,JX) - 4,VHCPC(JP,JY,JX),PSILT(JP,JY,JX),PSILG(JP,JY,JX),PSILO(JP,JY,JX) - 5,RC(JP,JY,JX),RA(JP,JY,JX),EP(JP,JY,JX),EVAPC(JP,JY,JX) - 6,UPWTR(2,JZ,JP,JY,JX),PSIRT(2,JZ,JP,JY,JX) - 7,PSIRO(2,JZ,JP,JY,JX),PSIRG(2,JZ,JP,JY,JX),CO2A(2,JZ,JP,JY,JX) - 8,OXYA(2,JZ,JP,JY,JX),CH4A(2,JZ,JP,JY,JX),Z2OA(2,JZ,JP,JY,JX) - 9,ZH3A(2,JZ,JP,JY,JX),CO2P(2,JZ,JP,JY,JX),OXYP(2,JZ,JP,JY,JX) - 1,CH4P(2,JZ,JP,JY,JX),Z2OP(2,JZ,JP,JY,JX),ZH3P(2,JZ,JP,JY,JX) - 2,ROXYP(2,JZ,JP,JY,JX),RCOFLA(2,JZ,JP,JY,JX),ROXFLA(2,JZ,JP,JY,JX) - 3,RCHFLA(2,JZ,JP,JY,JX),RN2FLA(2,JZ,JP,JY,JX),RNHFLA(2,JZ,JP,JY,JX) - 4,RCODFA(2,JZ,JP,JY,JX),ROXDFA(2,JZ,JP,JY,JX),RCHDFA(2,JZ,JP,JY,JX) - 5,RN2DFA(2,JZ,JP,JY,JX),RNHDFA(2,JZ,JP,JY,JX),RCO2S(2,JZ,JP,JY,JX) - 6,RUPOXS(2,JZ,JP,JY,JX),RUPCHS(2,JZ,JP,JY,JX),RUPN2S(2,JZ,JP,JY,JX) - 7,RUPN3S(2,JZ,JP,JY,JX),RUPN3B(2,JZ,JP,JY,JX),RCO2P(2,JZ,JP,JY,JX) - 8,RUPOXP(2,JZ,JP,JY,JX),RCO2M(2,JZ,JP,JY,JX),RCO2A(2,JZ,JP,JY,JX) - 9,UPOMC(JP,JY,JX),UPOMN(JP,JY,JX),UPOMP(JP,JY,JX),UPNH4(JP,JY,JX) - 1,UPNO3(JP,JY,JX),UPH2P(JP,JY,JX),UPNF(JP,JY,JX) - 2,RCO2Z(JP,JY,JX),ROXYZ(JP,JY,JX),RCH4Z(JP,JY,JX),RN2OZ(JP,JY,JX) + COMMON/BLK12A/WSTR(JP,JY,JX),OSTR(JP,JY,JX) + 2,RAD1(JP,JY,JX),THRM1(JP,JY,JX) + 3,EFLXC(JP,JY,JX),SFLXC(JP,JY,JX),HFLXC(JP,JY,JX),ENGYX(JP,JY,JX) + 4,VHCPC(JP,JY,JX),PSILT(JP,JY,JX),PSILG(JP,JY,JX),PSILO(JP,JY,JX) + 5,RC(JP,JY,JX),RA(JP,JY,JX),EP(JP,JY,JX),EVAPC(JP,JY,JX) + 6,UPWTR(2,JZ,JP,JY,JX),PSIRT(2,JZ,JP,JY,JX) + 7,PSIRO(2,JZ,JP,JY,JX),PSIRG(2,JZ,JP,JY,JX),CO2A(2,JZ,JP,JY,JX) + 8,OXYA(2,JZ,JP,JY,JX),CH4A(2,JZ,JP,JY,JX),Z2OA(2,JZ,JP,JY,JX) + 9,ZH3A(2,JZ,JP,JY,JX),CO2P(2,JZ,JP,JY,JX),OXYP(2,JZ,JP,JY,JX) + 1,CH4P(2,JZ,JP,JY,JX),Z2OP(2,JZ,JP,JY,JX),ZH3P(2,JZ,JP,JY,JX) + 2,ROXYP(2,JZ,JP,JY,JX),RCOFLA(2,JZ,JP,JY,JX),ROXFLA(2,JZ,JP,JY,JX) + 3,RCHFLA(2,JZ,JP,JY,JX),RN2FLA(2,JZ,JP,JY,JX),RNHFLA(2,JZ,JP,JY,JX) + 4,RCODFA(2,JZ,JP,JY,JX),ROXDFA(2,JZ,JP,JY,JX),RCHDFA(2,JZ,JP,JY,JX) + 5,RN2DFA(2,JZ,JP,JY,JX),RNHDFA(2,JZ,JP,JY,JX),RCO2S(2,JZ,JP,JY,JX) + 6,RUPOXS(2,JZ,JP,JY,JX),RUPCHS(2,JZ,JP,JY,JX),RUPN2S(2,JZ,JP,JY,JX) + 7,RUPN3S(2,JZ,JP,JY,JX),RUPN3B(2,JZ,JP,JY,JX),RCO2P(2,JZ,JP,JY,JX) + 8,RUPOXP(2,JZ,JP,JY,JX),RCO2M(2,JZ,JP,JY,JX),RCO2A(2,JZ,JP,JY,JX) + 9,UPOMC(JP,JY,JX),UPOMN(JP,JY,JX),UPOMP(JP,JY,JX),UPNH4(JP,JY,JX) + 1,UPNO3(JP,JY,JX),UPH2P(JP,JY,JX),UPH1P(JP,JY,JX),UPNF(JP,JY,JX) + 2,RCO2Z(JP,JY,JX),ROXYZ(JP,JY,JX),RCH4Z(JP,JY,JX),RN2OZ(JP,JY,JX) + diff --git a/f77src/blk12b.h b/f77src/blk12b.h index 7877c68..56cbdad 100755 --- a/f77src/blk12b.h +++ b/f77src/blk12b.h @@ -5,11 +5,14 @@ 5,RUOH2B(2,JZ,JP,JY,JX),RUCNH4(2,JZ,JP,JY,JX),RUCNHB(2,JZ,JP,JY,JX) 6,RUCNO3(2,JZ,JP,JY,JX),RUCNOB(2,JZ,JP,JY,JX),RUCH2P(2,JZ,JP,JY,JX) 7,RUCH2B(2,JZ,JP,JY,JX),RUPNF(JZ,JP,JY,JX),RUPHGS(2,JZ,JP,JY,JX) + 8,RUPH1P(2,JZ,JP,JY,JX),RUOH1P(2,JZ,JP,JY,JX),RUCH1P(2,JZ,JP,JY,JX) + 9,RUPH1B(2,JZ,JP,JY,JX),RUOH1B(2,JZ,JP,JY,JX),RUCH1B(2,JZ,JP,JY,JX) 1,VOLWP(JP,JY,JX),RCO2N(2,JZ,JP,JY,JX),RDFOMC(2,0:4,JZ,JP,JY,JX) 2,RDFOMN(2,0:4,JZ,JP,JY,JX),RDFOMP(2,0:4,JZ,JP,JY,JX) 4,RUNNHP(2,JZ,JP,JY,JX),RUNNOP(2,JZ,JP,JY,JX),RUPPOP(2,JZ,JP,JY,JX) 5,RUNNBP(2,JZ,JP,JY,JX),RUNNXP(2,JZ,JP,JY,JX),RUPPBP(2,JZ,JP,JY,JX) 6,RNH3Z(JP,JY,JX),RNH3B(JC,JP,JY,JX),WFR(2,JZ,JP,JY,JX) 7,RHGFLA(2,JZ,JP,JY,JX),RHGDFA(2,JZ,JP,JY,JX),H2GA(2,JZ,JP,JY,JX) - 8,H2GP(2,JZ,JP,JY,JX),RH2GZ(JP,JY,JX) + 8,H2GP(2,JZ,JP,JY,JX),RH2GZ(JP,JY,JX),RUPP1P(2,JZ,JP,JY,JX) + 9,RUPP1B(2,JZ,JP,JY,JX) diff --git a/f77src/blk13a.h b/f77src/blk13a.h index 4fb6c24..b98cb8b 100755 --- a/f77src/blk13a.h +++ b/f77src/blk13a.h @@ -1,23 +1,25 @@ - COMMON/BLK13A/ORGC(0:JZ,JY,JX),OMC(3,7,0:5,0:JZ,JY,JX) - 2,OMN(3,7,0:5,0:JZ,JY,JX),OMP(3,7,0:5,0:JZ,JY,JX) - 3,ORC(2,0:4,0:JZ,JY,JX),ORN(2,0:4,0:JZ,JY,JX),ORP(2,0:4,0:JZ,JY,JX) - 4,OQC(0:4,0:JZ,JY,JX),OQN(0:4,0:JZ,JY,JX),OQP(0:4,0:JZ,JY,JX) - 5,OQA(0:4,0:JZ,JY,JX),OQCH(0:4,0:JZ,JY,JX),OQNH(0:4,0:JZ,JY,JX) - 6,OQPH(0:4,0:JZ,JY,JX),OQAH(0:4,0:JZ,JY,JX),OHC(0:4,0:JZ,JY,JX) - 7,OHN(0:4,0:JZ,JY,JX),OHP(0:4,0:JZ,JY,JX),OSC(4,0:4,0:JZ,JY,JX) - 8,OSN(4,0:4,0:JZ,JY,JX),OSP(4,0:4,0:JZ,JY,JX),OHA(0:4,0:JZ,JY,JX) - 9,ZNH4FA(0:JZ,JY,JX),ZNH3FA(0:JZ,JY,JX),ZNHUFA(0:JZ,JY,JX) - 1,ZNO3FA(0:JZ,JY,JX),ZNH4FB(0:JZ,JY,JX),ZNH3FB(0:JZ,JY,JX) - 2,ZNHUFB(0:JZ,JY,JX),ZNO3FB(0:JZ,JY,JX),ZNO2B(0:JZ,JY,JX) - 3,ZNH4S(0:JZ,JY,JX),ZNH3S(0:JZ,JY,JX),ZNO3S(0:JZ,JY,JX) - 4,H2PO4(0:JZ,JY,JX),ZNH4B(0:JZ,JY,JX),ZNH3B(0:JZ,JY,JX) - 5,ZNO3B(0:JZ,JY,JX),H2POB(0:JZ,JY,JX),ZNO2S(0:JZ,JY,JX) - 6,ZNH3G(JZ,JY,JX),Z2GG(JZ,JY,JX),Z2GS(0:JZ,JY,JX),Z2OG(JZ,JY,JX) - 7,Z2OS(0:JZ,JY,JX),ZNH4SH(JZ,JY,JX),ZNH3SH(JZ,JY,JX) - 8,ZNO3SH(JZ,JY,JX),H2PO4H(JZ,JY,JX),ZNH4BH(JZ,JY,JX) - 9,ZNH3BH(JZ,JY,JX),ZNO3BH(JZ,JY,JX),H2POBH(JZ,JY,JX) - 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) - 5,ZNHUI(0:JZ,JY,JX),ZNHU0(0:JZ,JY,JX) + COMMON/BLK13A/ORGC(0:JZ,JY,JX),OMC(3,7,0:5,0:JZ,JY,JX) + 2,OMN(3,7,0:5,0:JZ,JY,JX),OMP(3,7,0:5,0:JZ,JY,JX) + 3,ORC(2,0:4,0:JZ,JY,JX),ORN(2,0:4,0:JZ,JY,JX),ORP(2,0:4,0:JZ,JY,JX) + 4,OQC(0:4,0:JZ,JY,JX),OQN(0:4,0:JZ,JY,JX),OQP(0:4,0:JZ,JY,JX) + 5,OQA(0:4,0:JZ,JY,JX),OQCH(0:4,0:JZ,JY,JX),OQNH(0:4,0:JZ,JY,JX) + 6,OQPH(0:4,0:JZ,JY,JX),OQAH(0:4,0:JZ,JY,JX),OHC(0:4,0:JZ,JY,JX) + 7,OHN(0:4,0:JZ,JY,JX),OHP(0:4,0:JZ,JY,JX),OSC(4,0:4,0:JZ,JY,JX) + 8,OSN(4,0:4,0:JZ,JY,JX),OSP(4,0:4,0:JZ,JY,JX),OHA(0:4,0:JZ,JY,JX) + 9,ZNH4FA(0:JZ,JY,JX),ZNH3FA(0:JZ,JY,JX),ZNHUFA(0:JZ,JY,JX) + 1,ZNO3FA(0:JZ,JY,JX),ZNH4FB(0:JZ,JY,JX),ZNH3FB(0:JZ,JY,JX) + 2,ZNHUFB(0:JZ,JY,JX),ZNO3FB(0:JZ,JY,JX),ZNO2B(0:JZ,JY,JX) + 3,ZNH4S(0:JZ,JY,JX),ZNH3S(0:JZ,JY,JX),ZNO3S(0:JZ,JY,JX) + 4,H2PO4(0:JZ,JY,JX),ZNH4B(0:JZ,JY,JX),ZNH3B(0:JZ,JY,JX) + 5,ZNO3B(0:JZ,JY,JX),H2POB(0:JZ,JY,JX),ZNO2S(0:JZ,JY,JX) + 6,ZNH3G(JZ,JY,JX),Z2GG(JZ,JY,JX),Z2GS(0:JZ,JY,JX),Z2OG(JZ,JY,JX) + 7,Z2OS(0:JZ,JY,JX),ZNH4SH(JZ,JY,JX),ZNH3SH(JZ,JY,JX) + 8,ZNO3SH(JZ,JY,JX),H2PO4H(JZ,JY,JX),ZNH4BH(JZ,JY,JX) + 9,ZNH3BH(JZ,JY,JX),ZNO3BH(JZ,JY,JX),H2POBH(JZ,JY,JX) + 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) + 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/blk13b.h b/f77src/blk13b.h index 04b5d41..6f7be61 100755 --- a/f77src/blk13b.h +++ b/f77src/blk13b.h @@ -10,7 +10,7 @@ 1,COXYS(0:JZ,JY,JX),CCO2G(0:JZ,JY,JX),CCO2S(0:JZ,JY,JX) 2,CCH4S(0:JZ,JY,JX),RUPOXO(0:JZ,JY,JX),RCO2O(0:JZ,JY,JX) 3,RCH4O(0:JZ,JY,JX),RH2GO(0:JZ,JY,JX),RN2G(0:JZ,JY,JX) - 4,RN2O(0:JZ,JY,JX),CH2P4(0:JZ,JY,JX),CH2PB(0:JZ,JY,JX) + 4,RN2O(0:JZ,JY,JX),CH2P4(0:JZ,JY,JX),CH2P4B(0:JZ,JY,JX) 5,XCODFG(0:JZ,JY,JX),XCHDFG(0:JZ,JY,JX),XOXDFG(0:JZ,JY,JX) 6,XNGDFG(0:JZ,JY,JX),XN2DFG(0:JZ,JY,JX),XN3DFG(0:JZ,JY,JX) 7,XNBDFG(0:JZ,JY,JX) ,XHGDFG(0:JZ,JY,JX),XCODFS(JY,JX) @@ -18,8 +18,8 @@ 8,XN3DFS(JY,JX),XNBDFS(JY,JX),XHGDFS(JY,JX),RCO2F(0:JZ,JY,JX) 9,ROXYS(7,0:5,0:JZ,JY,JX),H2GS(0:JZ,JY,JX),CH2GS(0:JZ,JY,JX) 1,RCH4L(0:JZ,JY,JX),ROXYF(0:JZ,JY,JX),ROXYL(0:JZ,JY,JX) - 2,RCH4F(0:JZ,JY,JX) - 3,XZHYS(0:JZ,JY,JX),CNO2B(0:JZ,JY,JX),XNO2B(0:JZ,JY,JX) - 4,OSA(4,0:4,0:JZ,JY,JX),XN34SQ(0:JZ,JY,JX),XN34BQ(0:JZ,JY,JX) + 2,RCH4F(0:JZ,JY,JX),CH1P4(0:JZ,JY,JX),CH1P4B(0:JZ,JY,JX) + 3,CNO2B(0:JZ,JY,JX),XNO2B(0:JZ,JY,JX) + 4,OSA(4,0:4,0:JZ,JY,JX) 5,ROQCS(7,0:4,0:JZ,JY,JX),ROQAS(7,0:4,0:JZ,JY,JX) diff --git a/f77src/blk13c.h b/f77src/blk13c.h index cb5fe7d..68cee7e 100755 --- a/f77src/blk13c.h +++ b/f77src/blk13c.h @@ -15,13 +15,13 @@ 6,XNGDFR(JY,JX),XN2DFR(JY,JX),XN3DFR(JY,JX),XHGDFR(JY,JX) 7,XCOBBL(JZ,JY,JX),XCHBBL(JZ,JY,JX),XOXBBL(JZ,JY,JX) 8,XNGBBL(JZ,JY,JX),XN2BBL(JZ,JY,JX),XN3BBL(JZ,JY,JX) - 9,XNBBBL(JZ,JY,JX),XHGBBL(JZ,JY,JX) + 9,XNBBBL(JZ,JY,JX),XHGBBL(JZ,JY,JX),XH1PS(0:JZ,JY,JX) 1,RVMX4(7,0:5,0:JZ,JY,JX),RVMX3(7,0:5,0:JZ,JY,JX) 2,RVMX2(7,0:5,0:JZ,JY,JX),RVMB4(7,0:5,0:JZ,JY,JX) 3,RVMB3(7,0:5,0:JZ,JY,JX),RVMB2(7,0:5,0:JZ,JY,JX) 4,RVMX1(7,0:5,0:JZ,JY,JX),CFOMC(2,JZ,JY,JX) - 5,EPOC(0:JZ,JY,JX),EHUM(0:JZ,JY,JX) + 5,EPOC(0:JZ,JY,JX),EHUM(0:JZ,JY,JX),XH1BS(0:JZ,JY,JX) 6,H2GSH(JZ,JY,JX),RVMXC(0:JZ,JY,JX),RVMBC(0:JZ,JY,JX) 7,RINHB(7,0:5,0:JZ,JY,JX),RINOB(7,0:5,0:JZ,JY,JX) - 8,RIPOB(7,0:5,0:JZ,JY,JX) - + 8,RIPBO(7,0:5,0:JZ,JY,JX),RIPO1(7,0:5,0:JZ,JY,JX) + 9,RIPB1(7,0:5,0:JZ,JY,JX),RIPO1R(7,0:5,JY,JX),XZHYS(0:JZ,JY,JX) diff --git a/f77src/blk15a.h b/f77src/blk15a.h index 13b7826..778d748 100755 --- a/f77src/blk15a.h +++ b/f77src/blk15a.h @@ -1,22 +1,23 @@ - COMMON/BLK15A/QR(2,JV,JH),HQR(2,JV,JH),QS(2,JV,JH),QW(2,JV,JH) - 2,QI(2,JV,JH),HQS(2,JV,JH),FLW(3,JD,JV,JH) - 2,FLWH(3,JD,JV,JH),HFLW(3,JD,JV,JH),XCOFLS(3,0:JD,JV,JH) - 3,XCHFLS(3,0:JD,JV,JH),XOXFLS(3,0:JD,JV,JH),XNGFLS(3,0:JD,JV,JH) - 4,XN2FLS(3,0:JD,JV,JH),XHGFLS(3,0:JD,JV,JH),XN4FLW(3,0:JD,JV,JH) - 5,XN3FLW(3,0:JD,JV,JH),XNOFLW(3,0:JD,JV,JH),XH2PFS(3,0:JD,JV,JH) - 6,XNXFLS(3,0:JD,JV,JH),XN4FLB(3,JD,JV,JH),XN3FLB(3,JD,JV,JH) - 7,XNOFLB(3,JD,JV,JH),XH2BFB(3,JD,JV,JH),XNXFLB(3,JD,JV,JH) - 8,XOCFLS(0:4,3,0:JD,JV,JH),XONFLS(0:4,3,0:JD,JV,JH) - 9,XCHFLG(3,0:JD,JV,JH),XOAFLS(0:4,3,0:JD,JV,JH),XCOFLG(3,JD,JV,JH) - 1,XOPFLS(0:4,3,0:JD,JV,JH),XOXFLG(3,JD,JV,JH),XNGFLG(3,JD,JV,JH) - 2,XHGFLG(3,JD,JV,JH),XN2FLG(3,JD,JV,JH),XN3FLG(3,JD,JV,JH) - 3,XCOQRS(2,JV,JH),XCHQRS(2,JV,JH),XOXQRS(2,JV,JH),XNGQRS(2,JV,JH) - 4,XN2QRS(2,JV,JH),XHGQRS(2,JV,JH),XN4QRW(2,JV,JH),XN3QRW(2,JV,JH) - 5,XNOQRW(2,JV,JH),XNXQRS(2,JV,JH),XP4QRW(2,JV,JH) - 3,XCOQSS(2,JV,JH),XCHQSS(2,JV,JH),XOXQSS(2,JV,JH),XNGQSS(2,JV,JH) - 4,XN2QSS(2,JV,JH),XN4QSS(2,JV,JH),XN3QSS(2,JV,JH) - 5,XNOQSS(2,JV,JH),XP4QSS(2,JV,JH) - 6,XOCQRS(0:4,2,JV,JH),XONQRS(0:4,2,JV,JH),XOPQRS(0:4,2,JV,JH) - 7,XOAQRS(0:4,2,JV,JH),FLQRQ(JY,JX),FLQRI(JY,JX) - 8,FLQGQ(JY,JX),FLQGI(JY,JX),FLQRM(JY,JX),FLQGM(JY,JX) - + COMMON/BLK15A/QR(2,JV,JH),HQR(2,JV,JH),QS(2,JV,JH),QW(2,JV,JH) + 2,QI(2,JV,JH),HQS(2,JV,JH),FLW(3,JD,JV,JH) + 2,FLWH(3,JD,JV,JH),HFLW(3,JD,JV,JH),XCOFLS(3,0:JD,JV,JH) + 3,XCHFLS(3,0:JD,JV,JH),XOXFLS(3,0:JD,JV,JH),XNGFLS(3,0:JD,JV,JH) + 4,XN2FLS(3,0:JD,JV,JH),XHGFLS(3,0:JD,JV,JH),XN4FLW(3,0:JD,JV,JH) + 5,XN3FLW(3,0:JD,JV,JH),XNOFLW(3,0:JD,JV,JH),XH2PFS(3,0:JD,JV,JH) + 6,XNXFLS(3,0:JD,JV,JH),XN4FLB(3,JD,JV,JH),XN3FLB(3,JD,JV,JH) + 7,XNOFLB(3,JD,JV,JH),XH2BFB(3,JD,JV,JH),XNXFLB(3,JD,JV,JH) + 8,XOCFLS(0:4,3,0:JD,JV,JH),XONFLS(0:4,3,0:JD,JV,JH) + 9,XCHFLG(3,0:JD,JV,JH),XOAFLS(0:4,3,0:JD,JV,JH),XCOFLG(3,JD,JV,JH) + 1,XOPFLS(0:4,3,0:JD,JV,JH),XOXFLG(3,JD,JV,JH),XNGFLG(3,JD,JV,JH) + 2,XHGFLG(3,JD,JV,JH),XN2FLG(3,JD,JV,JH),XN3FLG(3,JD,JV,JH) + 3,XCOQRS(2,JV,JH),XCHQRS(2,JV,JH),XOXQRS(2,JV,JH),XNGQRS(2,JV,JH) + 4,XN2QRS(2,JV,JH),XHGQRS(2,JV,JH),XN4QRW(2,JV,JH),XN3QRW(2,JV,JH) + 5,XNOQRW(2,JV,JH),XNXQRS(2,JV,JH),XP4QRW(2,JV,JH),XP1QRW(2,JV,JH) + 3,XCOQSS(2,JV,JH),XCHQSS(2,JV,JH),XOXQSS(2,JV,JH),XNGQSS(2,JV,JH) + 4,XN2QSS(2,JV,JH),XN4QSS(2,JV,JH),XN3QSS(2,JV,JH) + 5,XNOQSS(2,JV,JH),XP4QSS(2,JV,JH),XP1QSS(2,JV,JH) + 6,XOCQRS(0:4,2,JV,JH),XONQRS(0:4,2,JV,JH),XOPQRS(0:4,2,JV,JH) + 7,XOAQRS(0:4,2,JV,JH),FLQRQ(JY,JX),FLQRI(JY,JX) + 8,FLQGQ(JY,JX),FLQGI(JY,JX),FLQRM(JY,JX),FLQGM(JY,JX) + 9,XH1PFS(3,0:JD,JV,JH),XH1BFB(3,0:JD,JV,JH) + diff --git a/f77src/blk15b.h b/f77src/blk15b.h index 9694c84..2d08955 100755 --- a/f77src/blk15b.h +++ b/f77src/blk15b.h @@ -6,3 +6,4 @@ 6,XNXFHB(3,0:JD,JV,JH),XH2BHB(3,JD,JV,JH),XOCFHS(0:4,3,JD,JV,JH) 7,XONFHS(0:4,3,JD,JV,JH),XOPFHS(0:4,3,JD,JV,JH) 8,XOAFHS(0:4,3,JD,JV,JH),FLWX(3,JD,JV,JH) + 9,XH1PHS(3,JD,JV,JH),XH1BHB(3,JD,JV,JH) diff --git a/f77src/blk16.h b/f77src/blk16.h index 32f223a..3576c29 100755 --- a/f77src/blk16.h +++ b/f77src/blk16.h @@ -16,4 +16,5 @@ 7,UPO4F(JY,JX),UDRAIN(JY,JX),ZDRAIN(JY,JX),PDRAIN(JY,JX) 8,UCOP(JY,JX),USEDOU(JY,JX),PPT(JY,JX),UDICQ(JY,JX),UDICD(JY,JX) 9,UDINQ(JY,JX),UDIND(JY,JX),UDIPQ(JY,JX),UDIPD(JY,JX),HVOLO(JY,JX) - 1,WTSTGT(JY,JX),TFERTN,TFERTP,TION,TIONIN,TIONOU,TSEDSO,TSEDOU + 1,WTSTGT(JY,JX),TION,TIONIN,TIONOU,TSEDSO,TSEDOU + 2,TLH2G,H2GIN,H2GOU diff --git a/f77src/blk18a.h b/f77src/blk18a.h index 1493e18..a7b7d55 100755 --- a/f77src/blk18a.h +++ b/f77src/blk18a.h @@ -14,4 +14,4 @@ 5,TCO2P(JZ,JY,JX),TUPOXP(JZ,JY,JX),THRMC(JY,JX),TCNET(JY,JX) 6,ZCSNC(JY,JX),ZZSNC(JY,JX),ZPSNC(JY,JX),WGLFT(JC,JY,JX) 7,ARLFT(JC,JY,JX),ARSTT(JC,JY,JX),ARLSS(JY,JX),RTDNT(JZ,JY,JX) - + 6,TUPH1P(JZ,JY,JX),TUPH1B(JZ,JY,JX) diff --git a/f77src/blk18b.h b/f77src/blk18b.h index c464c4b..54c1fce 100755 --- a/f77src/blk18b.h +++ b/f77src/blk18b.h @@ -10,5 +10,6 @@ 1,THGFLA(JZ,JY,JX),TLH2GP(JZ,JY,JX),TRN(JY,JX) 2,TLE(JY,JX),TSH(JY,JX),TGH(JY,JX),TGPP(JY,JX),TRAU(JY,JX) 3,TNPP(JY,JX),THRE(JY,JX),XHVSTC(JY,JX),XHVSTN(JY,JX) - 4,XHVSTP(JY,JX),IFLGT(JY,JX) + 4,XHVSTP(JY,JX),RP14X(0:JZ,JY,JX),RP14Y(0:JZ,JY,JX) + 5,RP1BX(0:JZ,JY,JX),RP1BY(0:JZ,JY,JX),IFLGT(JY,JX) diff --git a/f77src/blk19a.h b/f77src/blk19a.h index 1f3a473..4e1cd56 100755 --- a/f77src/blk19a.h +++ b/f77src/blk19a.h @@ -1,21 +1,23 @@ - COMMON/BLK19A/ZAL(0:JZ,JY,JX),ZFE(0:JZ,JY,JX),ZHY(0:JZ,JY,JX) - 2,ZCA(0:JZ,JY,JX),ZMG(0:JZ,JY,JX),ZNA(0:JZ,JY,JX),ZKA(0:JZ,JY,JX) - 3,ZOH(0:JZ,JY,JX),ZSO4(0:JZ,JY,JX),ZCL(0:JZ,JY,JX),ZCO3(0:JZ,JY,JX) - 4,ZHCO3(0:JZ,JY,JX),ZALOH1(0:JZ,JY,JX),ZALOH2(0:JZ,JY,JX) - 5,ZALOH3(0:JZ,JY,JX),ZALOH4(0:JZ,JY,JX),ZALS(0:JZ,JY,JX) - 6,ZFEOH1(0:JZ,JY,JX),ZFEOH2(0:JZ,JY,JX),ZFEOH3(0:JZ,JY,JX) - 7,ZFEOH4(0:JZ,JY,JX),ZFES(0:JZ,JY,JX),ZCAO(0:JZ,JY,JX) - 8,ZCAC(0:JZ,JY,JX),ZCAH(0:JZ,JY,JX),ZCAS(0:JZ,JY,JX) - 9,ZMGO(0:JZ,JY,JX),ZMGC(0:JZ,JY,JX),ZMGH(0:JZ,JY,JX) - 1,ZMGS(0:JZ,JY,JX),ZNAC(0:JZ,JY,JX) - 1,ZNAS(0:JZ,JY,JX),ZKAS(0:JZ,JY,JX),H0PO4(0:JZ,JY,JX) - 2,H1PO4(0:JZ,JY,JX),H3PO4(0:JZ,JY,JX),ZFE1P(0:JZ,JY,JX) - 3,ZFE2P(0:JZ,JY,JX),ZCA0P(0:JZ,JY,JX),ZCA1P(0:JZ,JY,JX) - 4,ZCA2P(0:JZ,JY,JX),ZMG1P(0:JZ,JY,JX),H0POB(JZ,JY,JX) - 5,H1POB(JZ,JY,JX),H3POB(JZ,JY,JX),ZFE1PB(JZ,JY,JX) - 6,ZFE2PB(JZ,JY,JX),ZCA0PB(JZ,JY,JX),ZCA1PB(JZ,JY,JX) - 7,ZCA2PB(JZ,JY,JX),ZMG1PB(JZ,JY,JX),XN4(0:JZ,JY,JX),XNB(0:JZ,JY,JX) - 8,XHY(JZ,JY,JX),XAL(JZ,JY,JX),XCA(JZ,JY,JX),XMG(JZ,JY,JX) - 9,XNA(JZ,JY,JX),XKA(JZ,JY,JX),XHC(JZ,JY,JX),XALO2(JZ,JY,JX) - 1,XOH0(0:JZ,JY,JX),XOH1(0:JZ,JY,JX),XOH2(0:JZ,JY,JX) - 2,XH1P(0:JZ,JY,JX),XH2P(0:JZ,JY,JX),XOH0B(0:JZ,JY,JX) + COMMON/BLK19A/ZAL(0:JZ,JY,JX),ZFE(0:JZ,JY,JX),ZHY(0:JZ,JY,JX) + 2,ZCA(0:JZ,JY,JX),ZMG(0:JZ,JY,JX),ZNA(0:JZ,JY,JX),ZKA(0:JZ,JY,JX) + 3,ZOH(0:JZ,JY,JX),ZSO4(0:JZ,JY,JX),ZCL(0:JZ,JY,JX),ZCO3(0:JZ,JY,JX) + 4,ZHCO3(0:JZ,JY,JX),ZALOH1(0:JZ,JY,JX),ZALOH2(0:JZ,JY,JX) + 5,ZALOH3(0:JZ,JY,JX),ZALOH4(0:JZ,JY,JX),ZALS(0:JZ,JY,JX) + 6,ZFEOH1(0:JZ,JY,JX),ZFEOH2(0:JZ,JY,JX),ZFEOH3(0:JZ,JY,JX) + 7,ZFEOH4(0:JZ,JY,JX),ZFES(0:JZ,JY,JX),ZCAO(0:JZ,JY,JX) + 8,ZCAC(0:JZ,JY,JX),ZCAH(0:JZ,JY,JX),ZCAS(0:JZ,JY,JX) + 9,ZMGO(0:JZ,JY,JX),ZMGC(0:JZ,JY,JX),ZMGH(0:JZ,JY,JX) + 1,ZMGS(0:JZ,JY,JX),ZNAC(0:JZ,JY,JX) + 1,ZNAS(0:JZ,JY,JX),ZKAS(0:JZ,JY,JX),H0PO4(0:JZ,JY,JX) + 2,H3PO4(0:JZ,JY,JX),ZFE1P(0:JZ,JY,JX) + 3,ZFE2P(0:JZ,JY,JX),ZCA0P(0:JZ,JY,JX),ZCA1P(0:JZ,JY,JX) + 4,ZCA2P(0:JZ,JY,JX),ZMG1P(0:JZ,JY,JX),H0POB(JZ,JY,JX) + 5,H3POB(JZ,JY,JX),ZFE1PB(JZ,JY,JX),ZFE2PB(JZ,JY,JX) + 6,ZCA0PB(JZ,JY,JX),ZCA1PB(JZ,JY,JX),ZCA2PB(JZ,JY,JX) + 7,ZMG1PB(JZ,JY,JX),XN4(0:JZ,JY,JX),XNB(0:JZ,JY,JX) + 8,XHY(JZ,JY,JX),XAL(JZ,JY,JX),XCA(JZ,JY,JX),XMG(JZ,JY,JX) + 9,XNA(JZ,JY,JX),XKA(JZ,JY,JX),XHC(JZ,JY,JX),XALO2(JZ,JY,JX) + 1,XOH0(0:JZ,JY,JX),XOH1(0:JZ,JY,JX),XOH2(0:JZ,JY,JX) + 2,XH1P(0:JZ,JY,JX),XH2P(0:JZ,JY,JX),XOH0B(0:JZ,JY,JX) + 3,XFE(JZ,JY,JX),XFEO2(JZ,JY,JX) + diff --git a/f77src/blk19c.h b/f77src/blk19c.h index 0574b10..8f91a6a 100755 --- a/f77src/blk19c.h +++ b/f77src/blk19c.h @@ -1,8 +1,9 @@ - COMMON/BLK19C/ZMGOH(JZ,JY,JX),ZMGCH(JZ,JY,JX),ZMGHH(JZ,JY,JX) - 2,ZMGSH(JZ,JY,JX),ZNACH(JZ,JY,JX),ZNASH(JZ,JY,JX),ZKASH(JZ,JY,JX) - 3,H0PO4H(JZ,JY,JX),H1PO4H(JZ,JY,JX),H3PO4H(JZ,JY,JX) - 4,ZFE1PH(JZ,JY,JX),ZFE2PH(JZ,JY,JX),ZCA0PH(JZ,JY,JX) - 5,ZCA1PH(JZ,JY,JX),ZCA2PH(JZ,JY,JX),ZMG1PH(JZ,JY,JX) - 6,H0POBH(JZ,JY,JX),H1POBH(JZ,JY,JX),H3POBH(JZ,JY,JX) - 7,ZFE1BH(JZ,JY,JX),ZFE2BH(JZ,JY,JX),ZCA0BH(JZ,JY,JX) - 8,ZCA1BH(JZ,JY,JX),ZCA2BH(JZ,JY,JX),ZMG1BH(JZ,JY,JX) + COMMON/BLK19C/ZMGOH(JZ,JY,JX),ZMGCH(JZ,JY,JX),ZMGHH(JZ,JY,JX) + 2,ZMGSH(JZ,JY,JX),ZNACH(JZ,JY,JX),ZNASH(JZ,JY,JX),ZKASH(JZ,JY,JX) + 3,H0PO4H(JZ,JY,JX),H3PO4H(JZ,JY,JX) + 4,ZFE1PH(JZ,JY,JX),ZFE2PH(JZ,JY,JX),ZCA0PH(JZ,JY,JX) + 5,ZCA1PH(JZ,JY,JX),ZCA2PH(JZ,JY,JX),ZMG1PH(JZ,JY,JX) + 6,H0POBH(JZ,JY,JX),H3POBH(JZ,JY,JX) + 7,ZFE1BH(JZ,JY,JX),ZFE2BH(JZ,JY,JX),ZCA0BH(JZ,JY,JX) + 8,ZCA1BH(JZ,JY,JX),ZCA2BH(JZ,JY,JX),ZMG1BH(JZ,JY,JX) + diff --git a/f77src/blk19d.h b/f77src/blk19d.h index 0371c5f..7a74013 100755 --- a/f77src/blk19d.h +++ b/f77src/blk19d.h @@ -7,6 +7,6 @@ 7,ZFEH2W(JY,JX),ZFEH3W(JY,JX),ZFEH4W(JY,JX),ZFESW(JY,JX) 8,ZCAOW(JY,JX),ZCACW(JY,JX),ZCAHW(JY,JX),ZCASW(JY,JX),ZMGOW(JY,JX) 9,ZMGCW(JY,JX),ZMGHW(JY,JX),ZMGSW(JY,JX),ZNACW(JY,JX),ZNASW(JY,JX) - 1,ZKASW(JY,JX),H0PO4W(JY,JX),H1PO4W(JY,JX),H3PO4W(JY,JX) + 1,ZKASW(JY,JX),H0PO4W(JY,JX),H3PO4W(JY,JX) 2,ZFE1PW(JY,JX),ZFE2PW(JY,JX),ZCA0PW(JY,JX),ZCA1PW(JY,JX) - 3,ZCA2PW(JY,JX),ZMG1PW(JY,JX),H2GW(JY,JX) + 3,ZCA2PW(JY,JX),ZMG1PW(JY,JX),H2GW(JY,JX),Z1PW(JY,JX) diff --git a/f77src/blk20a.h b/f77src/blk20a.h index c6608a2..4517fa6 100755 --- a/f77src/blk20a.h +++ b/f77src/blk20a.h @@ -6,7 +6,7 @@ 6,XQRFE3(2,JV,JH),XQRFE4(2,JV,JH),XQRFES(2,JV,JH),XQRCAO(2,JV,JH) 7,XQRCAC(2,JV,JH),XQRCAH(2,JV,JH),XQRCAS(2,JV,JH),XQRMGO(2,JV,JH) 8,XQRMGC(2,JV,JH),XQRMGH(2,JV,JH),XQRMGS(2,JV,JH),XQRNAC(2,JV,JH) - 9,XQRNAS(2,JV,JH),XQRKAS(2,JV,JH),XQRH0P(2,JV,JH),XQRH1P(2,JV,JH) + 9,XQRNAS(2,JV,JH),XQRKAS(2,JV,JH),XQRH0P(2,JV,JH) 1,XQRH3P(2,JV,JH),XQRF1P(2,JV,JH),XQRF2P(2,JV,JH),XQRC0P(2,JV,JH) 2,XQRC1P(2,JV,JH),XQRC2P(2,JV,JH),XQRM1P(2,JV,JH),XQRH0B(2,JV,JH) 3,XQRH1B(2,JV,JH),XQRH3B(2,JV,JH),XQRF1B(2,JV,JH),XQRF2B(2,JV,JH) diff --git a/f77src/blk20b.h b/f77src/blk20b.h index f5be6b1..99d0e08 100755 --- a/f77src/blk20b.h +++ b/f77src/blk20b.h @@ -10,9 +10,9 @@ 9,XCASFS(3,0:JD,JV,JH),XMGOFS(3,0:JD,JV,JH),XMGCFS(3,0:JD,JV,JH) 1,XMGHFS(3,0:JD,JV,JH),XMGSFS(3,0:JD,JV,JH),XNACFS(3,0:JD,JV,JH) 2,XNASFS(3,0:JD,JV,JH),XKASFS(3,0:JD,JV,JH),XH0PFS(3,0:JD,JV,JH) - 3,XH1PFS(3,0:JD,JV,JH),XH3PFS(3,0:JD,JV,JH),XF1PFS(3,0:JD,JV,JH) + 3,XH3PFS(3,0:JD,JV,JH),XF1PFS(3,0:JD,JV,JH) 4,XF2PFS(3,0:JD,JV,JH),XC0PFS(3,0:JD,JV,JH),XC1PFS(3,0:JD,JV,JH) 5,XC2PFS(3,0:JD,JV,JH),XM1PFS(3,0:JD,JV,JH),XH0BFB(3,0:JD,JV,JH) - 6,XH1BFB(3,0:JD,JV,JH),XH3BFB(3,0:JD,JV,JH),XF1BFB(3,0:JD,JV,JH) + 6,XH3BFB(3,0:JD,JV,JH),XF1BFB(3,0:JD,JV,JH) 7,XF2BFB(3,0:JD,JV,JH),XC0BFB(3,0:JD,JV,JH),XC1BFB(3,0:JD,JV,JH) 8,XC2BFB(3,0:JD,JV,JH),XM1BFB(3,0:JD,JV,JH) diff --git a/f77src/blk20c.h b/f77src/blk20c.h index da4fa0a..0681608 100755 --- a/f77src/blk20c.h +++ b/f77src/blk20c.h @@ -10,9 +10,9 @@ 9,XCASHS(3,JD,JV,JH),XMGOHS(3,JD,JV,JH),XMGCHS(3,JD,JV,JH) 1,XMGHHS(3,JD,JV,JH),XMGSHS(3,JD,JV,JH),XNACHS(3,JD,JV,JH) 2,XNASHS(3,JD,JV,JH),XKASHS(3,JD,JV,JH),XH0PHS(3,JD,JV,JH) - 3,XH1PHS(3,JD,JV,JH),XH3PHS(3,JD,JV,JH),XF1PHS(3,JD,JV,JH) + 3,XH3PHS(3,JD,JV,JH),XF1PHS(3,JD,JV,JH) 4,XF2PHS(3,JD,JV,JH),XC0PHS(3,JD,JV,JH),XC1PHS(3,JD,JV,JH) 5,XC2PHS(3,JD,JV,JH),XM1PHS(3,JD,JV,JH),XH0BHB(3,JD,JV,JH) - 6,XH1BHB(3,JD,JV,JH),XH3BHB(3,JD,JV,JH),XF1BHB(3,JD,JV,JH) + 6,XH3BHB(3,JD,JV,JH),XF1BHB(3,JD,JV,JH) 7,XF2BHB(3,JD,JV,JH),XC0BHB(3,JD,JV,JH),XC1BHB(3,JD,JV,JH) 8,XC2BHB(3,JD,JV,JH),XM1BHB(3,JD,JV,JH) diff --git a/f77src/blk20d.h b/f77src/blk20d.h index 1bfdd49..162d081 100755 --- a/f77src/blk20d.h +++ b/f77src/blk20d.h @@ -16,3 +16,4 @@ 7,XCAHXS(JZ,JY,JX),XCASXS(JZ,JY,JX),XMGOXS(JZ,JY,JX) 8,XMGCXS(JZ,JY,JX),XMGHXS(JZ,JY,JX),XMGSXS(JZ,JY,JX) 9,XNACXS(JZ,JY,JX),XNASXS(JZ,JY,JX),XKASXS(JZ,JY,JX) + 1,XH1PXS(JZ,JY,JX),XH1BXB(JZ,JY,JX) diff --git a/f77src/blk20e.h b/f77src/blk20e.h index 86be54d..8868d91 100755 --- a/f77src/blk20e.h +++ b/f77src/blk20e.h @@ -1,7 +1,7 @@ - COMMON/BLK20E/XH0PXS(JZ,JY,JX),XH1PXS(JZ,JY,JX) + COMMON/BLK20E/XH0PXS(JZ,JY,JX) 2,XH3PXS(JZ,JY,JX),XF1PXS(JZ,JY,JX),XF2PXS(JZ,JY,JX) 3,XC0PXS(JZ,JY,JX),XC1PXS(JZ,JY,JX),XC2PXS(JZ,JY,JX) - 4,XM1PXS(JZ,JY,JX),XH0BXB(JZ,JY,JX),XH1BXB(JZ,JY,JX) + 4,XM1PXS(JZ,JY,JX),XH0BXB(JZ,JY,JX) 5,XH3BXB(JZ,JY,JX),XF1BXB(JZ,JY,JX),XF2BXB(JZ,JY,JX) 6,XC0BXB(JZ,JY,JX),XC1BXB(JZ,JY,JX),XC2BXB(JZ,JY,JX) 7,XM1BXB(JZ,JY,JX),XNXFXB(JZ,JY,JX) diff --git a/f77src/blk20f.h b/f77src/blk20f.h index d8f32cc..b1bf395 100755 --- a/f77src/blk20f.h +++ b/f77src/blk20f.h @@ -1,18 +1,19 @@ - COMMON/BLK20F/XSANER(2,JV,JH),XSILER(2,JV,JH),XCLAER(2,JV,JH) - 2,XCECER(2,JV,JH),XAECER(2,JV,JH),XNH4ER(2,JV,JH),XNH3ER(2,JV,JH) - 3,XNHUER(2,JV,JH),XNO3ER(2,JV,JH),XNH4EB(2,JV,JH),XNH3EB(2,JV,JH) - 4,XNHUEB(2,JV,JH),XNO3EB(2,JV,JH),XN4ER(2,JV,JH),XNBER(2,JV,JH) - 5,XHYER(2,JV,JH),XALER(2,JV,JH),XCAER(2,JV,JH),XMGER(2,JV,JH) - 6,XNAER(2,JV,JH),XKAER(2,JV,JH),XHCER(2,JV,JH),XAL2ER(2,JV,JH) - 7,XOH0ER(2,JV,JH),XOH1ER(2,JV,JH),XOH2ER(2,JV,JH),XH1PER(2,JV,JH) - 8,XH2PER(2,JV,JH),XOH0EB(2,JV,JH),XOH1EB(2,JV,JH),XOH2EB(2,JV,JH) - 9,XH1PEB(2,JV,JH),XH2PEB(2,JV,JH),PALOER(2,JV,JH),PFEOER(2,JV,JH) - 1,PCACER(2,JV,JH),PCASER(2,JV,JH),PALPER(2,JV,JH),PFEPER(2,JV,JH) - 2,PCPDER(2,JV,JH),PCPHER(2,JV,JH),PCPMER(2,JV,JH),PALPEB(2,JV,JH) - 3,PFEPEB(2,JV,JH),PCPDEB(2,JV,JH),PCPHEB(2,JV,JH),PCPMEB(2,JV,JH) - 4,OMCER(3,7,0:5,2,JV,JH),OMNER(3,7,0:5,2,JV,JH) - 5,ORCER(2,0:4,2,JV,JH),ORNER(2,0:4,2,JV,JH),ORPER(2,0:4,2,JV,JH) - 6,OHCER(0:4,2,JV,JH),OHNER(0:4,2,JV,JH),OHPER(0:4,2,JV,JH) - 7,OHAER(0:4,2,JV,JH),OSCER(4,0:4,2,JV,JH),OSAER(4,0:4,2,JV,JH) - 8,OSNER(4,0:4,2,JV,JH),OSPER(4,0:4,2,JV,JH),OMPER(3,7,0:5,2,JV,JH) - 9,XSEDER(2,JV,JH),XDTSED(JY,JX) + COMMON/BLK20F/XSANER(2,JV,JH),XSILER(2,JV,JH),XCLAER(2,JV,JH) + 2,XCECER(2,JV,JH),XAECER(2,JV,JH),XNH4ER(2,JV,JH),XNH3ER(2,JV,JH) + 3,XNHUER(2,JV,JH),XNO3ER(2,JV,JH),XNH4EB(2,JV,JH),XNH3EB(2,JV,JH) + 4,XNHUEB(2,JV,JH),XNO3EB(2,JV,JH),XN4ER(2,JV,JH),XNBER(2,JV,JH) + 5,XHYER(2,JV,JH),XALER(2,JV,JH),XCAER(2,JV,JH),XMGER(2,JV,JH) + 6,XNAER(2,JV,JH),XKAER(2,JV,JH),XHCER(2,JV,JH),XAL2ER(2,JV,JH) + 7,XOH0ER(2,JV,JH),XOH1ER(2,JV,JH),XOH2ER(2,JV,JH),XH1PER(2,JV,JH) + 8,XH2PER(2,JV,JH),XOH0EB(2,JV,JH),XOH1EB(2,JV,JH),XOH2EB(2,JV,JH) + 9,XH1PEB(2,JV,JH),XH2PEB(2,JV,JH),PALOER(2,JV,JH),PFEOER(2,JV,JH) + 1,PCACER(2,JV,JH),PCASER(2,JV,JH),PALPER(2,JV,JH),PFEPER(2,JV,JH) + 2,PCPDER(2,JV,JH),PCPHER(2,JV,JH),PCPMER(2,JV,JH),PALPEB(2,JV,JH) + 3,PFEPEB(2,JV,JH),PCPDEB(2,JV,JH),PCPHEB(2,JV,JH),PCPMEB(2,JV,JH) + 4,OMCER(3,7,0:5,2,JV,JH),OMNER(3,7,0:5,2,JV,JH) + 5,ORCER(2,0:4,2,JV,JH),ORNER(2,0:4,2,JV,JH),ORPER(2,0:4,2,JV,JH) + 6,OHCER(0:4,2,JV,JH),OHNER(0:4,2,JV,JH),OHPER(0:4,2,JV,JH) + 7,OHAER(0:4,2,JV,JH),OSCER(4,0:4,2,JV,JH),OSAER(4,0:4,2,JV,JH) + 8,OSNER(4,0:4,2,JV,JH),OSPER(4,0:4,2,JV,JH),OMPER(3,7,0:5,2,JV,JH) + 9,XSEDER(2,JV,JH),XDTSED(JY,JX),XFEER(2,JV,JH),XFE2ER(2,JV,JH) + diff --git a/f77src/blk21a.h b/f77src/blk21a.h index e24418b..d507d84 100755 --- a/f77src/blk21a.h +++ b/f77src/blk21a.h @@ -1,18 +1,20 @@ - COMMON/BLK21A/TRN4S(0:JZ,JY,JX),TRN3S(0:JZ,JY,JX),TRN4B(JZ,JY,JX) - 2,TRNO3(0:JZ,JY,JX),TRN3B(JZ,JY,JX),TRNOB(JZ,JY,JX),TRAL(JZ,JY,JX) - 3,TRFE(JZ,JY,JX),TRHY(JZ,JY,JX),TRCA(JZ,JY,JX),TRMG(JZ,JY,JX) - 4,TRNA(JZ,JY,JX),TRKA(JZ,JY,JX),TROH(JZ,JY,JX),TRSO4(JZ,JY,JX) - 5,TRCO3(JZ,JY,JX),TRHCO(JZ,JY,JX),TRCO2(JZ,JY,JX),TRH2O(0:JZ,JY,JX) - 6,TRAL1(JZ,JY,JX),TRAL2(JZ,JY,JX),TRAL3(JZ,JY,JX),TRAL4(JZ,JY,JX) - 7,TRALS(JZ,JY,JX),TRFE1(JZ,JY,JX),TRFE2(JZ,JY,JX),TRFE3(JZ,JY,JX) - 8,TRFE4(JZ,JY,JX),TRFES(JZ,JY,JX),TRCAO(JZ,JY,JX),TRCAC(JZ,JY,JX) - 9,TRCAH(JZ,JY,JX),TRCAS(JZ,JY,JX),TRMGO(JZ,JY,JX),TRMGC(JZ,JY,JX) - 1,TRMGH(JZ,JY,JX),TRMGS(JZ,JY,JX),TRNAC(JZ,JY,JX),TRNAS(JZ,JY,JX) - 2,TRKAS(JZ,JY,JX),TRH0P(JZ,JY,JX),TRH1P(JZ,JY,JX),TRH2P(0:JZ,JY,JX) - 3,TRH3P(JZ,JY,JX),TRF1P(JZ,JY,JX),TRF2P(JZ,JY,JX),TRC0P(JZ,JY,JX) - 4,TRC1P(JZ,JY,JX),TRC2P(JZ,JY,JX),TRM1P(JZ,JY,JX),TRH0B(JZ,JY,JX) - 5,TRH1B(JZ,JY,JX),TRH2B(JZ,JY,JX),TRH3B(JZ,JY,JX),TRF1B(JZ,JY,JX) - 6,TRF2B(JZ,JY,JX),TRC0B(JZ,JY,JX),TRC1B(JZ,JY,JX),TRC2B(JZ,JY,JX) - 7,TRM1B(JZ,JY,JX),TRXN4(0:JZ,JY,JX),TRXNB(JZ,JY,JX),TRXHY(JZ,JY,JX) - 8,TRXAL(JZ,JY,JX),TRXCA(JZ,JY,JX),TRXMG(JZ,JY,JX),TRXNA(JZ,JY,JX) - 9,TRXKA(JZ,JY,JX),TRXHC(JZ,JY,JX),TRXAL2(JZ,JY,JX) + COMMON/BLK21A/TRN4S(0:JZ,JY,JX),TRN3S(0:JZ,JY,JX),TRN4B(JZ,JY,JX) + 2,TRNO3(0:JZ,JY,JX),TRN3B(JZ,JY,JX),TRNOB(JZ,JY,JX),TRAL(JZ,JY,JX) + 3,TRFE(JZ,JY,JX),TRHY(JZ,JY,JX),TRCA(JZ,JY,JX),TRMG(JZ,JY,JX) + 4,TRNA(JZ,JY,JX),TRKA(JZ,JY,JX),TROH(JZ,JY,JX),TRSO4(JZ,JY,JX) + 5,TRCO3(JZ,JY,JX),TRHCO(JZ,JY,JX),TRCO2(JZ,JY,JX),TRH2O(0:JZ,JY,JX) + 6,TRAL1(JZ,JY,JX),TRAL2(JZ,JY,JX),TRAL3(JZ,JY,JX),TRAL4(JZ,JY,JX) + 7,TRALS(JZ,JY,JX),TRFE1(JZ,JY,JX),TRFE2(JZ,JY,JX),TRFE3(JZ,JY,JX) + 8,TRFE4(JZ,JY,JX),TRFES(JZ,JY,JX),TRCAO(JZ,JY,JX),TRCAC(JZ,JY,JX) + 9,TRCAH(JZ,JY,JX),TRCAS(JZ,JY,JX),TRMGO(JZ,JY,JX),TRMGC(JZ,JY,JX) + 1,TRMGH(JZ,JY,JX),TRMGS(JZ,JY,JX),TRNAC(JZ,JY,JX),TRNAS(JZ,JY,JX) + 2,TRH0P(JZ,JY,JX),TRH1P(0:JZ,JY,JX),TRH2P(0:JZ,JY,JX) + 3,TRH3P(JZ,JY,JX),TRF1P(JZ,JY,JX),TRF2P(JZ,JY,JX),TRC0P(JZ,JY,JX) + 4,TRC1P(JZ,JY,JX),TRC2P(JZ,JY,JX),TRM1P(JZ,JY,JX),TRH0B(JZ,JY,JX) + 5,TRH1B(JZ,JY,JX),TRH2B(JZ,JY,JX),TRH3B(JZ,JY,JX),TRF1B(JZ,JY,JX) + 6,TRF2B(JZ,JY,JX),TRC0B(JZ,JY,JX),TRC1B(JZ,JY,JX),TRC2B(JZ,JY,JX) + 7,TRM1B(JZ,JY,JX),TRXN4(0:JZ,JY,JX),TRXNB(JZ,JY,JX),TRXHY(JZ,JY,JX) + 8,TRXAL(JZ,JY,JX),TRXCA(JZ,JY,JX),TRXMG(JZ,JY,JX),TRXNA(JZ,JY,JX) + 9,TRXKA(JZ,JY,JX),TRXHC(JZ,JY,JX),TRXAL2(JZ,JY,JX),TRKAS(JZ,JY,JX) + 1,TRXFE(JZ,JY,JX),TRXFE2(JZ,JY,JX) + diff --git a/f77src/blk21b.h b/f77src/blk21b.h index 72857e6..f508d86 100755 --- a/f77src/blk21b.h +++ b/f77src/blk21b.h @@ -6,6 +6,5 @@ 6,TRFEPO(0:JZ,JY,JX),TRCAPD(0:JZ,JY,JX),TRCAPH(0:JZ,JY,JX) 7,TRCAPM(0:JZ,JY,JX),TRALPB(JZ,JY,JX),TRFEPB(JZ,JY,JX) 8,TRCPDB(JZ,JY,JX),TRCPHB(JZ,JY,JX),TRCPMB(JZ,JY,JX) - 9,TBNH4(0:JZ,JY,JX),TBNH3(0:JZ,JY,JX),TBNO3(0:JZ,JY,JX) - 1,TBH2P(0:JZ,JY,JX),TBCO2(JZ,JY,JX),TBION(0:JZ,JY,JX) + 1,TBCO2(JZ,JY,JX),TBION(0:JZ,JY,JX) 2,TRNO2(0:JZ,JY,JX),TRN2B(JZ,JY,JX),TRN3G(0:JZ,JY,JX) diff --git a/f77src/blk22a.h b/f77src/blk22a.h index 455c49c..c3d7916 100755 --- a/f77src/blk22a.h +++ b/f77src/blk22a.h @@ -16,4 +16,5 @@ 7,RNACFU(JZ,JY,JX),RNASFU(JZ,JY,JX),RKASFU(JZ,JY,JX) 8,RH0PFU(JZ,JY,JX),RH1PFU(JZ,JY,JX),RH3PFU(JZ,JY,JX) 9,RF1PFU(JZ,JY,JX),RF2PFU(JZ,JY,JX),RC0PFU(JZ,JY,JX) - 1,RC1PFU(JZ,JY,JX),RHGFLU(JZ,JY,JX) + 1,RC1PFU(JZ,JY,JX),RHGFLU(JZ,JY,JX),RH1BBU(JZ,JY,JX) + \ No newline at end of file diff --git a/f77src/blk22b.h b/f77src/blk22b.h index 3b40ba4..ad6ea46 100755 --- a/f77src/blk22b.h +++ b/f77src/blk22b.h @@ -1,5 +1,5 @@ COMMON/BLK22B/RC2PFU(JZ,JY,JX),RM1PFU(JZ,JY,JX) - 2,RH0BBU(JZ,JY,JX),RH1BBU(JZ,JY,JX),RH3BBU(JZ,JY,JX) + 2,RH0BBU(JZ,JY,JX),RH3BBU(JZ,JY,JX) 3,RF1BBU(JZ,JY,JX),RF2BBU(JZ,JY,JX),RC0BBU(JZ,JY,JX) 4,RC1BBU(JZ,JY,JX),RC2BBU(JZ,JY,JX),RM1BBU(JZ,JY,JX) 5,XCOBLS(JY,JX),XCHBLS(JY,JX),XOXBLS(JY,JX),XNGBLS(JY,JX) diff --git a/f77src/blkc.h b/f77src/blkc.h index 0f1710d..9d6273a 100755 --- a/f77src/blkc.h +++ b/f77src/blkc.h @@ -6,7 +6,7 @@ 6,ZEROP(JP,JY,JX),ZEROQ(JP,JY,JX),ZEROL(JP,JY,JX) 7,XNPH,XNPT,XNPG,XNPD,ALAT(JY,JX),DOY,DYLM(JY,JX) 8,IFLGS(JY,JX),IFNHB(JY,JX),IFNOB(JY,JX),IFPOB(JY,JX) - 9,IWTHR(2),IDAYR,IYRC,IYRR,NYR,ITERM,IFIN,ISALT(JY,JX) + 9,IWTHR(2),IDAYR,IYRC,IYRR,NYR,ITERM,IFIN,ISALT(JV,JH) 1,IERSN(JY,JX),NCN(JY,JX),NPX,NPY,NPH,NPT,NPG,IGO,ICLM,IMNG,IFLGW 2,JOUT,IOUT,KOUT,IOLD,ILAST,IRUN,IBEGIN,ISTART,IEND 3,ISOIL(0:4,JZ,JY,JX),LYRX,LYRC,LSG(JZ,JY,JX),NP(JY,JX) diff --git a/f77src/day.f b/f77src/day.f index 0febe2a..050f318 100755 --- a/f77src/day.f +++ b/f77src/day.f @@ -186,7 +186,7 @@ SUBROUTINE day(I,NHW,NHE,NVN,NVS) IF(ITYPE.EQ.1)THEN IF(IETYP(NY,NX).GE.-1)THEN IF(DYLN(NY,NX).GT.ZERO)THEN - RMAX=SRAD(I)/(DYLN(NY,NX)*0.627) + RMAX=SRAD(I)/(DYLN(NY,NX)*0.658) ELSE RMAX=0.0 ENDIF @@ -242,57 +242,16 @@ SUBROUTINE day(I,NHW,NHE,NVN,NVS) 600 CONTINUE 950 CONTINUE 955 CONTINUE + DO 9995 NX=NHW,NHE + DO 9990 NY=NVN,NVS C C ATTRIBUTE MIXING COEFFICIENTS AND SURFACE ROUGHNESS PARAMETERS C TO TILLAGE EVENTS FROM ARRAY LOADED IN 'READS' C - DO 9995 NX=NHW,NHE - DO 9990 NY=NVN,NVS - IF(ITILL(I,NY,NX).EQ.0.OR.ITILL(I,NY,NX).GT.20)THEN - CORP=0.0 - ELSE - IF(ITILL(I,NY,NX).EQ.1.OR.ITILL(I,NY,NX).EQ.11)THEN - CORP=0.10 - ZS(NY,NX)=0.04 - ENDIF - IF(ITILL(I,NY,NX).EQ.2.OR.ITILL(I,NY,NX).EQ.12)THEN - CORP=0.20 - ZS(NY,NX)=0.04 - ENDIF - IF(ITILL(I,NY,NX).EQ.3.OR.ITILL(I,NY,NX).EQ.13)THEN - CORP=0.30 - ZS(NY,NX)=0.04 - ENDIF - IF(ITILL(I,NY,NX).EQ.4.OR.ITILL(I,NY,NX).EQ.14)THEN - CORP=0.40 - ZS(NY,NX)=0.04 - ENDIF - IF(ITILL(I,NY,NX).EQ.5.OR.ITILL(I,NY,NX).EQ.15)THEN - CORP=0.50 - ZS(NY,NX)=0.02 - ENDIF - IF(ITILL(I,NY,NX).EQ.6.OR.ITILL(I,NY,NX).EQ.16)THEN - CORP=0.60 - ZS(NY,NX)=0.04 - ENDIF - IF(ITILL(I,NY,NX).EQ.7.OR.ITILL(I,NY,NX).EQ.17)THEN - CORP=0.70 - ZS(NY,NX)=0.04 - ENDIF - IF(ITILL(I,NY,NX).EQ.8.OR.ITILL(I,NY,NX).EQ.18)THEN - CORP=0.80 - ZS(NY,NX)=0.02 - ENDIF - IF(ITILL(I,NY,NX).EQ.9.OR.ITILL(I,NY,NX).EQ.19)THEN - CORP=0.90 - ZS(NY,NX)=0.01 - ENDIF - IF(ITILL(I,NY,NX).EQ.10.OR.ITILL(I,NY,NX).EQ.20)THEN - CORP=1.00 - ZS(NY,NX)=0.02 - ENDIF + IF(ITILL(I,NY,NX).LE.10)THEN + CORP=AMIN1(1.0,AMAX1(0.0,ITILL(I,NY,NX)/10.0)) + XCORP(NY,NX)=AMAX1(1.0E-03,1.0-CORP) ENDIF - XCORP(NY,NX)=AMAX1(1.0E-06,1.0-CORP) C C AUTOMATIC IRRIGATION IF SELECTED C diff --git a/f77src/erosion.f b/f77src/erosion.f index 4a2e395..04699ab 100755 --- a/f77src/erosion.f +++ b/f77src/erosion.f @@ -352,12 +352,14 @@ SUBROUTINE erosion(I,J,NHW,NHE,NVN,NVS) XNBER(N,N5,N4)=FSEDER*XNB(NU(N2,N1),N2,N1) XHYER(N,N5,N4)=FSEDER*XHY(NU(N2,N1),N2,N1) XALER(N,N5,N4)=FSEDER*XAL(NU(N2,N1),N2,N1) + XFEER(N,N5,N4)=FSEDER*XFE(NU(N2,N1),N2,N1) XCAER(N,N5,N4)=FSEDER*XCA(NU(N2,N1),N2,N1) XMGER(N,N5,N4)=FSEDER*XMG(NU(N2,N1),N2,N1) XNAER(N,N5,N4)=FSEDER*XNA(NU(N2,N1),N2,N1) XKAER(N,N5,N4)=FSEDER*XKA(NU(N2,N1),N2,N1) XHCER(N,N5,N4)=FSEDER*XHC(NU(N2,N1),N2,N1) XAL2ER(N,N5,N4)=FSEDER*XALO2(NU(N2,N1),N2,N1) + XFE2ER(N,N5,N4)=FSEDER*XFEO2(NU(N2,N1),N2,N1) XOH0ER(N,N5,N4)=FSEDER*XOH0(NU(N2,N1),N2,N1) XOH1ER(N,N5,N4)=FSEDER*XOH1(NU(N2,N1),N2,N1) XOH2ER(N,N5,N4)=FSEDER*XOH2(NU(N2,N1),N2,N1) @@ -447,12 +449,14 @@ SUBROUTINE erosion(I,J,NHW,NHE,NVN,NVS) XNBER(N,N5,N4)=FSEDER*XNB(NU(N5,N4),N5,N4) XHYER(N,N5,N4)=FSEDER*XHY(NU(N5,N4),N5,N4) XALER(N,N5,N4)=FSEDER*XAL(NU(N5,N4),N5,N4) + XFEER(N,N5,N4)=FSEDER*XFE(NU(N5,N4),N5,N4) XCAER(N,N5,N4)=FSEDER*XCA(NU(N5,N4),N5,N4) XMGER(N,N5,N4)=FSEDER*XMG(NU(N5,N4),N5,N4) XNAER(N,N5,N4)=FSEDER*XNA(NU(N5,N4),N5,N4) XKAER(N,N5,N4)=FSEDER*XKA(NU(N5,N4),N5,N4) XHCER(N,N5,N4)=FSEDER*XHC(NU(N5,N4),N5,N4) XAL2ER(N,N5,N4)=FSEDER*XALO2(NU(N5,N4),N5,N4) + XFE2ER(N,N5,N4)=FSEDER*XFEO2(NU(N5,N4),N5,N4) XOH0ER(N,N5,N4)=FSEDER*XOH0(NU(N5,N4),N5,N4) XOH1ER(N,N5,N4)=FSEDER*XOH1(NU(N5,N4),N5,N4) XOH2ER(N,N5,N4)=FSEDER*XOH2(NU(N5,N4),N5,N4) @@ -594,12 +598,14 @@ SUBROUTINE erosion(I,J,NHW,NHE,NVN,NVS) XNBER(N,N5,N4)=FSEDER*XNB(NU(N2,N1),N2,N1) XHYER(N,N5,N4)=FSEDER*XHY(NU(N2,N1),N2,N1) XALER(N,N5,N4)=FSEDER*XAL(NU(N2,N1),N2,N1) + XFEER(N,N5,N4)=FSEDER*XFE(NU(N2,N1),N2,N1) XCAER(N,N5,N4)=FSEDER*XCA(NU(N2,N1),N2,N1) XMGER(N,N5,N4)=FSEDER*XMG(NU(N2,N1),N2,N1) XNAER(N,N5,N4)=FSEDER*XNA(NU(N2,N1),N2,N1) XKAER(N,N5,N4)=FSEDER*XKA(NU(N2,N1),N2,N1) XHCER(N,N5,N4)=FSEDER*XHC(NU(N2,N1),N2,N1) XAL2ER(N,N5,N4)=FSEDER*XALO2(NU(N2,N1),N2,N1) + XFE2ER(N,N5,N4)=FSEDER*XFEO2(NU(N2,N1),N2,N1) XOH0ER(N,N5,N4)=FSEDER*XOH0(NU(N2,N1),N2,N1) XOH1ER(N,N5,N4)=FSEDER*XOH1(NU(N2,N1),N2,N1) XOH2ER(N,N5,N4)=FSEDER*XOH2(NU(N2,N1),N2,N1) diff --git a/f77src/exec.f b/f77src/exec.f index 88fcd1f..e457f37 100755 --- a/f77src/exec.f +++ b/f77src/exec.f @@ -21,7 +21,7 @@ SUBROUTINE exec(I) TLC=TLRSDC+TLORGC+TLCO2G-CO2GIN+TCOU-TORGF-XCSN TLN=TLRSDN+TLORGN+TLN2G+TLNH4+TLNO3-ZN2GIN-TZIN+TZOU-TORGN-XZSN TLP=TLRSDP+TLORGP+TLPO4-TPIN+TPOU-TORGP-XPSN - TLI=TION-TIONIN+TIONOU-TFERTN-TFERTP + TLI=TION-TIONIN+TIONOU ENDIF C C CALCULATE DEVIATION SINCE MASS BALANCE WAS LAST RESET @@ -34,12 +34,12 @@ SUBROUTINE exec(I) DIFFN=(TLRSDN+TLORGN+TLN2G+TLNH4+TLNO3-ZN2GIN-TZIN+TZOU 2-TORGN-XZSN-TLN)/TAREA DIFFP=(TLRSDP+TLORGP+TLPO4-TPIN+TPOU-TORGP-XPSN-TLP)/TAREA - DIFFI=(TION-TIONIN+TIONOU-TFERTN-TFERTP-TLI)/TAREA + DIFFI=(TION-TIONIN+TIONOU-TLI)/TAREA WRITE(*,212)I,IYRC WRITE(18,213)I,IYRC,DIFFQ,DIFFH,DIFFO,DIFFC,DIFFN 2,DIFFP,DIFFI 212 FORMAT('NOW EXECUTING DAY',I6,' OF YEAR',I6) -213 FORMAT(2I6,10F18.9) +213 FORMAT(2I6,10F16.6) C C FLAG DEVIATIONS > 1UG OR 1 J IN ENTIRE MODEL LANDSCAPE, C RESET MASS BALANCE @@ -77,7 +77,7 @@ SUBROUTINE exec(I) IF(ABS(DIFFI).GT.1.0E-06)THEN WRITE(18,197)I,IYRC 197 FORMAT('ION BALANCE LOST ON DAY, YEAR',2I4) - TLI=TION-TIONIN+TIONOU-TFERTN-TFERTP + TLI=TION-TIONIN+TIONOU ENDIF ENDIF IF(IDAYR.LT.0)THEN diff --git a/f77src/extract.f b/f77src/extract.f index 086a017..d011ba7 100755 --- a/f77src/extract.f +++ b/f77src/extract.f @@ -23,6 +23,7 @@ SUBROUTINE extract(I,J,NHW,NHE,NVN,NVS) include "blk11b.h" include "blk12a.h" include "blk12b.h" + include "blk13c.h" include "blk14.h" include "blk16.h" include "blk18a.h" @@ -153,9 +154,11 @@ SUBROUTINE extract(I,J,NHW,NHE,NVN,NVS) TUPNH4(L,NY,NX)=TUPNH4(L,NY,NX)+RUPNH4(N,L,NZ,NY,NX) TUPNO3(L,NY,NX)=TUPNO3(L,NY,NX)+RUPNO3(N,L,NZ,NY,NX) TUPH2P(L,NY,NX)=TUPH2P(L,NY,NX)+RUPH2P(N,L,NZ,NY,NX) + TUPH1P(L,NY,NX)=TUPH1P(L,NY,NX)+RUPH1P(N,L,NZ,NY,NX) TUPNHB(L,NY,NX)=TUPNHB(L,NY,NX)+RUPNHB(N,L,NZ,NY,NX) TUPNOB(L,NY,NX)=TUPNOB(L,NY,NX)+RUPNOB(N,L,NZ,NY,NX) TUPH2B(L,NY,NX)=TUPH2B(L,NY,NX)+RUPH2B(N,L,NZ,NY,NX) + TUPH1B(L,NY,NX)=TUPH1B(L,NY,NX)+RUPH1B(N,L,NZ,NY,NX) C IF(J.EQ.12)THEN C WRITE(*,4141)'TUPOX',I,J,NX,NY,L,NZ,N,TUPOXS(L,NY,NX) C 2,RUPOXS(N,L,NZ,NY,NX),TUPOXP(L,NY,NX),RUPOXP(N,L,NZ,NY,NX) @@ -180,10 +183,17 @@ SUBROUTINE extract(I,J,NHW,NHE,NVN,NVS) RNH4X(L,NY,NX)=RNH4X(L,NY,NX)+RUNNHP(N,L,NZ,NY,NX) RNO3X(L,NY,NX)=RNO3X(L,NY,NX)+RUNNOP(N,L,NZ,NY,NX) RPO4X(L,NY,NX)=RPO4X(L,NY,NX)+RUPPOP(N,L,NZ,NY,NX) + RP14X(L,NY,NX)=RP14X(L,NY,NX)+RUPP1P(N,L,NZ,NY,NX) RNHBX(L,NY,NX)=RNHBX(L,NY,NX)+RUNNBP(N,L,NZ,NY,NX) RN3BX(L,NY,NX)=RN3BX(L,NY,NX)+RUNNXP(N,L,NZ,NY,NX) RPOBX(L,NY,NX)=RPOBX(L,NY,NX)+RUPPBP(N,L,NZ,NY,NX) + RP1BX(L,NY,NX)=RP1BX(L,NY,NX)+RUPP1B(N,L,NZ,NY,NX) 100 CONTINUE +C IF(ISALT(NY,NX).NE.0)THEN +C XZHYS(L,NY,NX)=XZHYS(L,NY,NX) +C 2+0.0714*(TUPNH4(L,NY,NX)+TUPNHB(L,NY,NX)) +C 3-0.0714*(TUPNO3(L,NY,NX)+TUPNOB(L,NY,NX)) +C ENDIF C C TOTAL ROOT N2 FIXATION BY ALL PLANT SPECIES C diff --git a/f77src/grosub.f b/f77src/grosub.f index c5ed343..5d7b989 100755 --- a/f77src/grosub.f +++ b/f77src/grosub.f @@ -1,7514 +1,7543 @@ - - SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) -C -C THIS SUBROUTINE CALCULATES ALL PLANT BIOLOGICAL TRANSFORMATIONS -C - include "parameters.h" - include "files.h" - include "blkc.h" - include "blk1cp.h" - include "blk1cr.h" - include "blk1g.h" - include "blk1n.h" - include "blk1p.h" - include "blk1s.h" - include "blk2a.h" - include "blk2b.h" - include "blk2c.h" - include "blk3.h" - include "blk5.h" - include "blk8a.h" - include "blk8b.h" - include "blk9a.h" - include "blk9b.h" - include "blk9c.h" - include "blk11a.h" - include "blk11b.h" - include "blk12a.h" - include "blk12b.h" - include "blk13a.h" - include "blk13b.h" - include "blk13c.h" - include "blk14.h" - include "blk16.h" - include "blk18a.h" - include "blk18b.h" - DIMENSION PART(7),TFN6(JZ),ARSTKB(10),NRX(2,JZ),ICHK1(2,JZ) - 2,NBZ(10),FXFB(0:3),FXRT(0:1),FXSH(0:1),FXRN(4) - 3,VMXS(0:1),WTLSBZ(10),CPOOLZ(10),ZPOOLZ(10),PPOOLZ(10) - 4,ZCX(JP,JY,JX),UPNFC(JP,JY,JX),FRSV(0:3),FXFY(0:1),FXFZ(0:1) - 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) - 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) - 2,FWODB(0:1),FWODLN(0:1),FWODLP(0:1),FWODSN(0:1),FWODSP(0:1) -C DIMENSION VCO2(400,366,05) - PARAMETER(PART1X=0.05,PART2X=0.02 - 2,VMXC=0.015,ATRPX=276.9,FSNR=2.884E-03,FLG4X=168.0 - 3,FLGZX=240.0,XFRX=2.5E-02,XFRY=2.5E-03,IFLGQX=960 - 4,FSNKM=0.05,FXFS=1.0,FMYC=0.01) - PARAMETER(CNKI=1.0E+01,CPKI=1.0E+02,CNKF=1.0) - PARAMETER(RMPLT=0.010,PSILM=0.1,RCMN=1.560E+01,RTDPX=0.00 - 2,RTLGAX=1.0E-02,EMODR=5.0) - PARAMETER(QNTM=0.45,CURV=0.70,CURV2=2.0*CURV,CURV4=4.0*CURV - 2,ELEC3=4.5,ELEC4=3.0,CO2KI=1.0E+03,FCO2B=0.02,FHCOB=1.0-FCO2B) - PARAMETER(COMP4=0.5,FDML=6.0,FBS=0.2*FDML,FMP=0.8*FDML - 2,FVRN=0.5) - PARAMETER(ZPLFM=0.33,ZPLFD=1.0-ZPLFM,ZPGRM=0.75 - 2,ZPGRD=1.0-ZPGRM,FRF=0.25,FRC=1.0-FRF,GY=0.2,GZ=1.0-GY) - PARAMETER(FSTK=0.05,ZSTX=1.0E-03,DSTK=0.225,VSTK=1.0E-06/DSTK - 2,FRTX=1.0/(1.0-(1.0-FSTK)**2)) - PARAMETER(SETC=1.0E-02,SETN=1.0E-03,SETP=1.0E-04) - PARAMETER(SLA2=-0.33,SSL2=-0.50,SNL2=-0.67) - PARAMETER(CNMX=0.20,CPMX=0.020,CNMN=0.050,CPMN=0.005) - PARAMETER(EN2F=0.20,VMXO=0.50,SPNDL=1.0E-06,CCNKM=1.0E-02 - 2,CCNKX=1.0E+02,WTNDI=0.01) - DATA RCCZ/0.167,0.167,0.0557,0.167/ - 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 FXRN/0.50,0.025,0.25,0.025/ - DATA FXFB/1.0E-02,1.0E-02,1.0E-05,1.0E-05/ - DATA VMXS/0.025,0.0025/ - DATA FPART1/1.00/,FPART2/0.40/ - DATA FXSH/0.50,0.75/,FXRT/0.50,0.25/ - DATA FRSV/0.025,0.025,0.001,0.001/ - DATA FXFY/0.05,0.005/,FXFZ/0.25,0.005/ - DATA EFIRE/0.917,0.167/ - DATA PSILY/-200.0,-2.0,-2.0/ - DATA FLG4Y/360.0,1440.0,720.0,720.0/ -C DATA TC4,TLK/0.0,0.0/ - REAL*4 TFN5,WFNG,WFNC,WFNS,WFNSG,WFNSS,WFN4,WFNB - 2,WFNR,WFNRG,WFNGR,FSNC2 -C -C TOTAL AGB FOR GRAZING IN LANDSCAPE GROUP -C - DO 2995 NX=NHW,NHE - DO 2990 NY=NVN,NVS - DO 2985 NZ=1,NP(NY,NX) - IF(IHVST(NZ,I,NY,NX).EQ.4.OR.IHVST(NZ,I,NY,NX).EQ.6)THEN - WTSHTZ=0 - NN=0 - DO 1995 NX1=NHW,NHE - DO 1990 NY1=NVN,NVS - IF(LSG(NZ,NY1,NX1).EQ.LSG(NZ,NY,NX))THEN - IF(IFLGC(NZ,NY1,NX1).EQ.1)THEN - WTSHTZ=WTSHTZ+WTSHT(NZ,NY1,NX1) - NN=NN+1 - ENDIF - ENDIF -1990 CONTINUE -1995 CONTINUE - IF(NN.GT.0)THEN - WTSHTA(NZ,NY,NX)=WTSHTZ/NN - ELSE - WTSHTA(NZ,NY,NX)=WTSHT(NZ,NY,NX) - ENDIF - ENDIF -2985 CONTINUE -2990 CONTINUE -2995 CONTINUE - DO 9995 NX=NHW,NHE - DO 9990 NY=NVN,NVS - DO 9980 NZ=1,NP0(NY,NX) - DO 1 L=0,NJ(NY,NX) - DO 1 K=0,1 - DO 1 M=1,4 - CSNC(M,K,L,NZ,NY,NX)=0.0 - ZSNC(M,K,L,NZ,NY,NX)=0.0 - PSNC(M,K,L,NZ,NY,NX)=0.0 -1 CONTINUE - HCSNC(NZ,NY,NX)=0.0 - HZSNC(NZ,NY,NX)=0.0 - HPSNC(NZ,NY,NX)=0.0 - CNET(NZ,NY,NX)=0.0 - UPNFC(NZ,NY,NX)=0.0 - ZCX(NZ,NY,NX)=ZC(NZ,NY,NX) - ZC(NZ,NY,NX)=0.0 -9980 CONTINUE -C -C TRANSFORMATIONS IN LIVING PLANT POPULATIONS -C - DO 9985 NZ=1,NP(NY,NX) -C IF(J.EQ.INT(ZNOON(NY,NX)))THEN - XHVST=1.0 - WHVSBL=0.0 - WTHTH0=0.0 - WTHNH0=0.0 - WTHPH0=0.0 - WTHTH1=0.0 - WTHNH1=0.0 - WTHPH1=0.0 - WTHTH2=0.0 - WTHNH2=0.0 - WTHPH2=0.0 - WTHTH3=0.0 - WTHNH3=0.0 - WTHPH3=0.0 - WTHTH4=0.0 - WTHNH4=0.0 - WTHPH4=0.0 - WTHTR1=0.0 - WTHNR1=0.0 - WTHPR1=0.0 - WTHTR2=0.0 - WTHNR2=0.0 - WTHPR2=0.0 - WTHTR3=0.0 - WTHNR3=0.0 - WTHPR3=0.0 - WTHTR4=0.0 - WTHNR4=0.0 - WTHPR4=0.0 - WTHTX0=0.0 - WTHNX0=0.0 - WTHPX0=0.0 - WTHTX1=0.0 - WTHNX1=0.0 - WTHPX1=0.0 - WTHTX2=0.0 - WTHNX2=0.0 - WTHPX2=0.0 - WTHTX3=0.0 - WTHNX3=0.0 - WTHPX3=0.0 - WTHTX4=0.0 - WTHNX4=0.0 - WTHPX4=0.0 - WTHTG=0.0 - WTHNG=0.0 - WTHPG=0.0 -C ENDIF -C IF(NX.EQ.4.AND.NY.EQ.4.AND.NZ.EQ.2)THEN -C WRITE(*,2328)'IFLGC',I,J,NZ,IFLGC(NZ,NY,NX) -C 2,IDTHP(NZ,NY,NX),IDTHR(NZ,NY,NX) -2328 FORMAT(A8,10I4) -C ENDIF - IF(IFLGC(NZ,NY,NX).EQ.1)THEN - IF(IDTHP(NZ,NY,NX).EQ.0.OR.IDTHR(NZ,NY,NX).EQ.0)THEN -C IF(I.EQ.1.AND.J.EQ.1)THEN -C DO 87 II=1,366 -C DO 87 N=1,400 -C VCO2(N,II,NZ)=0.0 -87 CONTINUE -C ENDIF -C IF(IYRC.GE.2099)THEN -C IF(I.EQ.365.AND.J.EQ.24)THEN -C DO 88 N=1,400 -C WRITE(19,12)IYRC,NZ,N,(VCO2(N,II,NZ),II=1,181) -C WRITE(20,12)IYRC,NZ,N,(VCO2(N,II,NZ),II=182,365) -12 FORMAT(3I8,365E12.4) -88 CONTINUE -C ENDIF -C ENDIF - IFLGZ=0 - IFLGY=0 - DO 2 L=1,JC - ARLFV(L,NZ,NY,NX)=0.0 - WGLFV(L,NZ,NY,NX)=0.0 - ARSTV(L,NZ,NY,NX)=0.0 -2 CONTINUE - DO 5 NR=1,NRT(NZ,NY,NX) - DO 5 N=1,MY(NZ,NY,NX) - NRX(N,NR)=0 - ICHK1(N,NR)=0 -5 CONTINUE - DO 9 N=1,MY(NZ,NY,NX) - RTNT(N)=0.0 - DO 6 L=NU(NY,NX),NJ(NY,NX) - WSRTL(N,L,NZ,NY,NX)=0.0 - RTN1(N,L,NZ,NY,NX)=0.0 - RTNL(N,L,NZ,NY,NX)=0.0 - RCO2M(N,L,NZ,NY,NX)=0.0 - RCO2N(N,L,NZ,NY,NX)=0.0 - RCO2A(N,L,NZ,NY,NX)=0.0 - RLNT(N,L)=0.0 - DO 6 NR=1,NRT(NZ,NY,NX) - RTSK1(N,L,NR)=0.0 - RTSK2(N,L,NR)=0.0 -6 CONTINUE -9 CONTINUE - IF(IBTYP(NZ,NY,NX).EQ.0.OR.IGTYP(NZ,NY,NX).LE.1 - 2.OR.WTSTK(NZ,NY,NX).LT.ZEROP(NZ,NY,NX) - 3.OR.WVSTK(NZ,NY,NX).LT.ZEROP(NZ,NY,NX))THEN - FWOOD(1)=1.0 - FWODB(1)=1.0 - ELSE - FWOOD(1)=SQRT(FRTX*WVSTK(NZ,NY,NX)/WTSTK(NZ,NY,NX)) - FWODB(1)=1.0 - ENDIF - FWOOD(0)=1.0-FWOOD(1) - FWODB(0)=1.0-FWODB(1) - CNLFW=FWODB(0)*CNSTK(NZ,NY,NX)+FWODB(1)*CNLF(NZ,NY,NX) - CPLFW=FWODB(0)*CPSTK(NZ,NY,NX)+FWODB(1)*CPLF(NZ,NY,NX) - CNSHW=FWODB(0)*CNSTK(NZ,NY,NX)+FWODB(1)*CNSHE(NZ,NY,NX) - CPSHW=FWODB(0)*CPSTK(NZ,NY,NX)+FWODB(1)*CPSHE(NZ,NY,NX) - CNRTW=FWOOD(0)*CNSTK(NZ,NY,NX)+FWOOD(1)*CNRT(NZ,NY,NX) - CPRTW=FWOOD(0)*CPSTK(NZ,NY,NX)+FWOOD(1)*CPRT(NZ,NY,NX) - FWODLN(0)=FWODB(0)*CNSTK(NZ,NY,NX)/CNLFW - FWODLP(0)=FWODB(0)*CPSTK(NZ,NY,NX)/CPLFW - FWODSN(0)=FWODB(0)*CNSTK(NZ,NY,NX)/CNSHW - FWODSP(0)=FWODB(0)*CPSTK(NZ,NY,NX)/CPSHW - FWOODN(0)=FWOOD(0)*CNSTK(NZ,NY,NX)/CNRTW - FWOODP(0)=FWOOD(0)*CPSTK(NZ,NY,NX)/CPRTW - FWODLN(1)=1.0-FWODLN(0) - FWODLP(1)=1.0-FWODLP(0) - FWODSN(1)=1.0-FWODSN(0) - FWODSP(1)=1.0-FWODSP(0) - FWOODN(1)=1.0-FWOODN(0) - FWOODP(1)=1.0-FWOODP(0) -C -C SHOOT AND ROOT TEMPERATURE FUNCTIONS FOR MAINTENANCE -C RESPIRATION FROM TEMPERATURES WITH OFFSETS FOR THERMAL ADAPTATION -C -C TKSM=AMAX1(258.15,TKC(NZ,NY,NX))+OFFST(NZ,NY,NX) - TKSM=TKC(NZ,NY,NX)+OFFST(NZ,NY,NX) - RTK=8.3143*TKSM - STK=710.0*TKSM - ACTVM=1+EXP((195000-STK)/RTK)+EXP((STK-232500)/RTK) - TFN5=EXP(25.214-62500/RTK)/ACTVM - DO 7 L=NU(NY,NX),NJ(NY,NX) -C TKSM=AMAX1(258.15,TKS(L,NY,NX))+OFFST(NZ,NY,NX) - TKSM=TKS(L,NY,NX)+OFFST(NZ,NY,NX) - RTK=8.3143*TKSM - STK=710.0*TKSM - ACTVM=1+EXP((195000-STK)/RTK)+EXP((STK-232500)/RTK) - TFN6(L)=EXP(25.214-62500/RTK)/ACTVM -7 CONTINUE - GROGR=0.0 - WTRTA(NZ,NY,NX)=AMAX1(0.999992087*WTRTA(NZ,NY,NX) - 2,WTRT(NZ,NY,NX)/PP(NZ,NY,NX)) - XRTN1=AMAX1(1.0,WTRTA(NZ,NY,NX)**0.667)*PP(NZ,NY,NX) -C -C WATER STRESS FUNCTIONS FOR EXPANSION AND GROWTH RESPIRATION -C FROM CANOPY TURGOR -C - WFNS=AMIN1(1.0,AMAX1(0.0,PSILG(NZ,NY,NX)-PSILM)) - WFNSG=WFNS**0.25 - WFNSS=WFNS**0.50 - IF(IGTYP(NZ,NY,NX).EQ.0)THEN - WFNC=1.0 - WFNG=EXP(0.05*PSILT(NZ,NY,NX)) - ELSE - WFNC=EXP(RCS(NZ,NY,NX)*PSILG(NZ,NY,NX)) - WFNG=EXP(0.10*PSILT(NZ,NY,NX)) - ENDIF -C -C CALCULATE GROWTH OF EACH BRANCH -C - DO 105 NB=1,NBR(NZ,NY,NX) - WTLSB(NB,NZ,NY,NX)=AMAX1(0.0,WTLFB(NB,NZ,NY,NX) - 2+WTSHEB(NB,NZ,NY,NX)) - IF(IDTHB(NB,NZ,NY,NX).EQ.0)THEN -C -C PARTITION GROWTH WITHIN EACH BRANCH FROM GROWTH STAGE -C 1=LEAF,2=SHEATH OR PETIOLE,3=STALK,4=RESERVE, -C 5,6=REPRODUCTIVE ORGANS,7=GRAIN -C - ARSTKB(NB)=0.0 - TOTAL=0.0 - DO 10 N=1,7 - PART(N)=0.0 -10 CONTINUE -C -C IF BEFORE FLORAL INDUCTION -C - IF(IDAY(2,NB,NZ,NY,NX).EQ.0)THEN - PART(1)=0.725 - PART(2)=0.275 -C -C IF BEFORE ANTHESIS -C - ELSEIF(IDAY(6,NB,NZ,NY,NX).EQ.0)THEN - PART(1)=AMAX1(PART1X,0.725-FPART1*TGSTGI(NB,NZ,NY,NX)) - PART(2)=AMAX1(PART2X,0.275-FPART2*TGSTGI(NB,NZ,NY,NX)) - PARTS=1.0-PART(1)-PART(2) - PART(3)=0.60*PARTS - PART(4)=0.30*PARTS - PARTX=PARTS-PART(3)-PART(4) - PART(5)=0.5*PARTX - PART(6)=0.5*PARTX -C -C IF BEFORE GRAIN FILLING, DETERMINATE OR INDETERMINATE -C - ELSEIF(IDAY(7,NB,NZ,NY,NX).EQ.0)THEN - IF(IDTYP(NZ,NY,NX).EQ.0)THEN - PART(1)=0.0 - PART(2)=0.0 - ELSE - PART(1)=AMAX1(PART1X,(0.725-FPART1)*(1.0-TGSTGF(NB,NZ,NY,NX))) - PART(2)=AMAX1(PART2X,(0.275-FPART2)*(1.0-TGSTGF(NB,NZ,NY,NX))) - ENDIF - PARTS=1.0-PART(1)-PART(2) - PART(3)=AMAX1(0.0,0.60*PARTS*(1.0-TGSTGF(NB,NZ,NY,NX))) - PART(4)=AMAX1(0.0,0.30*PARTS*(1.0-TGSTGF(NB,NZ,NY,NX))) - PARTX=PARTS-PART(3)-PART(4) - PART(5)=0.5*PARTX - PART(6)=0.5*PARTX -C -C DURING GRAIN FILLING, DETERMINATE OR INDETERMINATE -C - ELSE - IF(IDTYP(NZ,NY,NX).EQ.0)THEN - PART(7)=1.0 - ELSE - PART(1)=PART1X - PART(2)=PART2X - PARTS=1.0-PART(1)-PART(2) - IF(ISTYP(NZ,NY,NX).EQ.0)THEN - PART(3)=0.125*PARTS - PART(5)=0.125*PARTS - PART(6)=0.125*PARTS - PART(7)=0.625*PARTS - ELSE - PART(3)=0.75*PARTS - PART(7)=0.25*PARTS - ENDIF - ENDIF - ENDIF -C -C IF AFTER GRAIN FILLING -C - IF(IBTYP(NZ,NY,NX).EQ.0.AND.IDAY(10,NB,NZ,NY,NX).NE.0)THEN - IF(ISTYP(NZ,NY,NX).EQ.0)THEN - PART(4)=0.0 - PART(3)=0.0 - PART(7)=0.0 - ELSE - PART(4)=PART(4)+PART(3) - PART(3)=0.0 - PART(7)=0.0 - ENDIF - ENDIF -C -C REDIRECT FROM STALK TO STALK RESERVES IF RESERVES BECOME LOW -C - IF(IDAY(2,NB,NZ,NY,NX).NE.0)THEN - IF(WTRSVB(NB,NZ,NY,NX).LT.XFRX*WVSTKB(NB,NZ,NY,NX))THEN - DO 1020 N=1,7 - IF(N.NE.4)THEN - PART(4)=PART(4)+0.10*PART(N) - PART(N)=PART(N)-0.10*PART(N) - ENDIF -1020 CONTINUE -C -C REDIRECT FROM STALK RESERVES TO STALK IF RESERVES BECOME TOO LARGE -C - ELSEIF(WTRSVB(NB,NZ,NY,NX).GT.1.0*WVSTKB(NB,NZ,NY,NX))THEN - PART(3)=PART(3)+PART(4)+PART(7) - PART(4)=0.0 - PART(7)=0.0 - ENDIF - ENDIF -C -C REDIRECT FROM LEAVES TO STALK IF LAI BECOMES TOO LARGE -C - ARLFI=ARLFP(NZ,NY,NX)/AREA(3,NU(NY,NX),NY,NX) - IF(ARLFI.GT.5.0)THEN - FPARTL=AMAX1(0.0,(10.0-ARLFI)/5.0) - PART(3)=PART(3)+(1.0-FPARTL)*(PART(1)+PART(2)) - PART(1)=FPARTL*PART(1) - PART(2)=FPARTL*PART(2) - ENDIF -C -C DECIDUOUS LEAF FALL AFTER GRAIN FILL IN DETERMINATES, -C AFTER AUTUMNIZATION IN INDETERMINATES, OR AFTER SUSTAINED -C WATER STRESS -C - IF((ISTYP(NZ,NY,NX).NE.0 - 2.AND.VRNF(NB,NZ,NY,NX).GE.FVRN*VRNX(NB,NZ,NY,NX)) - 3.OR.(ISTYP(NZ,NY,NX).EQ.0 - 4.AND.IDAY(8,NB,NZ,NY,NX).NE.0))THEN - IFLGZ=1 - IF(ISTYP(NZ,NY,NX).EQ.0.OR.IWTYP(NZ,NY,NX).EQ.0)THEN - IFLGY=1 - FLGZ(NB,NZ,NY,NX)=FLGZ(NB,NZ,NY,NX)+1.0 - ELSEIF((IWTYP(NZ,NY,NX).EQ.1.OR.IWTYP(NZ,NY,NX).EQ.3) - 2.AND.TCC(NZ,NY,NX).LT.CTC(NZ,NY,NX))THEN - IFLGY=1 - FLGZ(NB,NZ,NY,NX)=FLGZ(NB,NZ,NY,NX)+1.0 - ELSEIF(IWTYP(NZ,NY,NX).GE.2 - 2.AND.PSILT(NZ,NY,NX).LT.PSILY(IGTYP(NZ,NY,NX)))THEN - IFLGY=1 - FLGZ(NB,NZ,NY,NX)=FLGZ(NB,NZ,NY,NX)+1.0 - ENDIF - IF(ISTYP(NZ,NY,NX).NE.0.AND.IWTYP(NZ,NY,NX).NE.0)THEN - PART(3)=PART(3)+0.5*(PART(1)+PART(2)) - PART(4)=PART(4)+0.5*(PART(1)+PART(2)) - PART(1)=0.0 - PART(2)=0.0 - ENDIF - ELSE - IFLGZ=0 - IFLGY=0 - FLGZ(NB,NZ,NY,NX)=0.0 - ENDIF -C -C CHECK PARTITIONING COEFFICIENTS -C - DO 1000 N=1,7 - PART(N)=AMAX1(0.0,PART(N)) - TOTAL=TOTAL+PART(N) -1000 CONTINUE - IF(TOTAL.GT.ZERO)THEN - DO 1010 N=1,7 - PART(N)=PART(N)/TOTAL -1010 CONTINUE - ELSE - DO 1015 N=1,7 - PART(N)=0.0 -1015 CONTINUE - ENDIF -C -C SHOOT COEFFICIENTS FOR GROWTH RESPIRATION AND N,P CONTENTS -C FROM GROWTH YIELDS ENTERED IN 'READQ', AND FROM PARTITIONING -C COEFFICIENTS ABOVE -C - IF(IDAY(1,NB,NZ,NY,NX).NE.0)THEN - DMLFB=DMLF(NZ,NY,NX) - DMSHB=DMSHE(NZ,NY,NX) - CNLFB=CNLFW - CNSHB=CNSHW - CPLFB=CPLFW - CPSHB=CPSHW - ELSE - DMLFB=DMRT(NZ,NY,NX) - DMSHB=DMRT(NZ,NY,NX) - CNLFB=CNRTW - CNSHB=CNRTW - CPLFB=CPRTW - CPSHB=CPRTW - ENDIF - DMSHT=PART(1)*DMLFB+PART(2)*DMSHB+PART(3)*DMSTK(NZ,NY,NX) - 2+PART(4)*DMRSV(NZ,NY,NX)+PART(5)*DMHSK(NZ,NY,NX) - 3+PART(6)*DMEAR(NZ,NY,NX)+PART(7)*DMGR(NZ,NY,NX) - DMSHD=1.0-DMSHT - CNLFM=PART(1)*DMLFB*ZPLFM*CNLFB - CPLFM=PART(1)*DMLFB*ZPLFM*CPLFB - CNLFX=PART(1)*DMLFB*ZPLFD*CNLFB - CPLFX=PART(1)*DMLFB*ZPLFD*CPLFB - CNSHX=PART(2)*DMSHB*CNSHB - 2+PART(3)*DMSTK(NZ,NY,NX)*CNSTK(NZ,NY,NX) - 3+PART(4)*DMRSV(NZ,NY,NX)*CNRSV(NZ,NY,NX) - 4+PART(5)*DMHSK(NZ,NY,NX)*CNHSK(NZ,NY,NX) - 5+PART(6)*DMEAR(NZ,NY,NX)*CNEAR(NZ,NY,NX) - 6+PART(7)*DMGR(NZ,NY,NX)*CNRSV(NZ,NY,NX) - CPSHX=PART(2)*DMSHB*CPSHB - 2+PART(3)*DMSTK(NZ,NY,NX)*CPSTK(NZ,NY,NX) - 3+PART(4)*DMRSV(NZ,NY,NX)*CPRSV(NZ,NY,NX) - 4+PART(5)*DMHSK(NZ,NY,NX)*CPHSK(NZ,NY,NX) - 5+PART(6)*DMEAR(NZ,NY,NX)*CPEAR(NZ,NY,NX) - 6+PART(7)*DMGR(NZ,NY,NX)*CPRSV(NZ,NY,NX) -C -C TOTAL SHOOT STRUCTURAL N CONTENT FOR MAINTENANCE RESPIRATION -C - WTSHXN=AMAX1(0.0,WTLFBN(NB,NZ,NY,NX)+WTSHBN(NB,NZ,NY,NX) - 2+CNSTK(NZ,NY,NX)*WVSTKB(NB,NZ,NY,NX)) - IF(IDAY(10,NB,NZ,NY,NX).EQ.0)THEN - WTSHXN=WTSHXN+AMAX1(0.0,WTHSBN(NB,NZ,NY,NX) - 2+WTEABN(NB,NZ,NY,NX)+WTGRBN(NB,NZ,NY,NX)) - ENDIF -C -C GROSS PRIMARY PRODUCTIVITY -C - IF(IDAY(1,NB,NZ,NY,NX).NE.0)THEN - IF(FDBK(NB,NZ,NY,NX).NE.0)THEN - IF(SSIN(NY,NX).GT.0.0.AND.RADP(NZ,NY,NX).GT.0.0 - 2.AND.CO2Q(NZ,NY,NX).GT.0.0)THEN - CO2F=0.0 - CH2O=0.0 - IF(IGTYP(NZ,NY,NX).NE.0.OR.WFNC.GT.0.0)THEN -C IF(NZ.EQ.1.OR.NZ.EQ.4)THEN -C WRITE(*,5651)'CHECK1',I,J,NZ,NB,IDAY(1,NB,NZ,NY,NX) -C 2,FDBK(NB,NZ,NY,NX),RADP(NZ,NY,NX),CO2Q(NZ,NY,NX),WFNC -5651 FORMAT(A8,5I4,12E12.4) -C ENDIF -C -C FOR EACH NODE -C - DO 100 K=1,25 - CH2O3(K)=0.0 - CH2O4(K)=0.0 - IF(ARLF(K,NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN -C -C C4 PHOTOSYNTHESIS -C - IF(ICTYP(NZ,NY,NX).EQ.4.AND.VCGR4(K,NB,NZ,NY,NX).GT.0.0)THEN -C -C FOR EACH CANOPY LAYER -C - DO 110 L=JC,1,-1 - IF(ARLFL(L,K,NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN -C -C FOR EACH LEAF AZIMUTH AND INCLINATION -C - DO 115 N = 1,4 - DO 120 M = 1,4 -C -C CO2 FIXATION BY SUNLIT LEAVES -C - IF(SURFX(N,L,K,NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - IF(PAR(N,M,L,NZ,NY,NX).GT.0.0)THEN -C -C C4 CARBOXYLATION REACTIONS USING VARIABLES FROM 'STOMATE' -C - PARX=QNTM*PAR(N,M,L,NZ,NY,NX) - PARJ=PARX+ETGR4(K,NB,NZ,NY,NX) - ETLF=(PARJ-SQRT(PARJ**2-CURV4*PARX*ETGR4(K,NB,NZ,NY,NX)))/CURV2 - EGRO=ETLF*CBXN4(K,NB,NZ,NY,NX) - VL=AMIN1(VGRO4(K,NB,NZ,NY,NX),EGRO)*FDBK4(K,NB,NZ,NY,NX) -C -C STOMATAL EFFECT OF WATER DEFICIT -C - IF(VL.GT.ZERO)THEN - RS=AMIN1(RCMX(NZ,NY,NX),AMAX1(RCMN,DCO2(NZ,NY,NX)/VL)) - RSL=RS+(RCMX(NZ,NY,NX)-RS)*WFNC - GSL=1.0/RSL*FMOL(NZ,NY,NX) -C -C NON-STOMATAL EFFECT OF WATER DEFICIT -C - IF(IGTYP(NZ,NY,NX).NE.0)THEN - WFN4=(RS/RSL)**1.00 - WFNB=SQRT(RS/RSL) - ELSE - WFN4=WFNG - WFNB=WFNG - ENDIF -C -C CONVERGENCE SOLUTION FOR CO2I AT WHICH CARBOXYLATION -C EQUALS DIFFUSION -C - CO2X=CO2I(NZ,NY,NX) - DO 125 NN=1,100 - CO2C=CO2X*SCO2(NZ,NY,NX) - CO2Y=AMAX1(0.0,CO2C-COMP4) - CBXNX=CO2Y/(ELEC4*CO2C+10.5*COMP4) - VGROX=VCGR4(K,NB,NZ,NY,NX)*CO2Y/(CO2C+XKCO24(NZ,NY,NX)) - EGROX=ETLF*CBXNX - VL=AMIN1(VGROX,EGROX)*WFN4*FDBK4(K,NB,NZ,NY,NX) - VG=(CO2Q(NZ,NY,NX)-CO2X)*GSL - IF(VL+VG.GT.ZERO)THEN - DIFF=(VL-VG)/(VL+VG) - IF(ABS(DIFF).LT.0.005)GO TO 130 - VA=0.95*VG+0.05*VL - CO2X=CO2Q(NZ,NY,NX)-VA/GSL - ELSE - VL=0.0 - GO TO 130 - ENDIF -125 CONTINUE - -C -C ACCUMULATE C4 FIXATION PRODUCT -C -130 CH2O4(K)=CH2O4(K)+VL*SURFX(N,L,K,NB,NZ,NY,NX) - 2*TAUS(L+1,NY,NX) -C ICO2I=MAX(1,MIN(400,INT(CO2X))) -C VCO2(ICO2I,I,NZ)=VCO2(ICO2I,I,NZ) -C 2+(VL*SURFX(N,L,K,NB,NZ,NY,NX)*TAUS(L+1,NY,NX))*0.0432 -C IF(NB.EQ.1.AND.M.EQ.1.AND.N.EQ.3.AND.K.EQ.KLEAF(NB,NZ,NY,NX) -C 2.AND.(I/10)*10.EQ.I.AND.J.EQ.12)THEN -C WRITE(20,4444)'VLD4',IYRC,I,J,NZ,L,M,N,K,VL,PAR(N,M,L,NZ,NY,NX) -C 2,PAR(N,M,L,NZ,NY,NX)*TAUS(L+1,NY,NX)+PARDIF(N,M,L,NZ,NY,NX) -C 3*TAU0(L+1,NY,NX) -C 2,RAPS,TKC(NZ,NY,NX),CO2Q(NZ,NY,NX),ETGR4(K,NB,NZ,NY,NX) -C 3,CBXN4(K,NB,NZ,NY,NX),VGRO4(K,NB,NZ,NY,NX),EGRO -C 3,FDBK4(K,NB,NZ,NY,NX),CH2O4(K),WFN4,VGROX,EGROX -C 4,VCGR4(K,NB,NZ,NY,NX),CO2X,CO2C,CBXNX -C 5,RS,RSL -4444 FORMAT(A8,8I4,40E12.4) -C ENDIF -C -C C3 CARBOXYLATION REACTIONS IN C4 PLANTS USING VARIABLES FROM 'STOMATE' -C - PARJ=PARX+ETGRO(K,NB,NZ,NY,NX) - ETLF=(PARJ-SQRT(PARJ**2-CURV4*PARX*ETGRO(K,NB,NZ,NY,NX)))/CURV2 - EGRO=ETLF*CBXN(K,NB,NZ,NY,NX) - VL=AMIN1(VGRO(K,NB,NZ,NY,NX),EGRO)*WFNB*FDBK(NB,NZ,NY,NX) -C -C ACCUMULATE C3 FIXATION PRODUCT -C - CH2O3(K)=CH2O3(K)+VL*SURFX(N,L,K,NB,NZ,NY,NX) - 2*TAUS(L+1,NY,NX) -C IF(L.EQ.NC-1.AND.NB.EQ.1.AND.M.EQ.1.AND.N.EQ.1)THEN -C WRITE(*,4445)'VLD3',IYRC,I,J,NZ,L,M,N,K,VL,PAR(N,M,L,NZ,NY,NX) -C 2,RAPS,TKC(NZ,NY,NX),CO2Q(NZ,NY,NX),ETGRO(K,NB,NZ,NY,NX) -C 3,CBXN(K,NB,NZ,NY,NX),VGRO(K,NB,NZ,NY,NX),EGRO -C 3,FDBK(NB,NZ,NY,NX),WFNB -4445 FORMAT(A8,8I4,20E12.4) -C ENDIF - ENDIF - ENDIF -C -C CO2 FIXATION BY SHADED LEAVES -C - IF(PARDIF(N,M,L,NZ,NY,NX).GT.0.0)THEN -C -C C4 CARBOXYLATION REACTIONS -C - PARX=QNTM*PARDIF(N,M,L,NZ,NY,NX) - PARJ=PARX+ETGR4(K,NB,NZ,NY,NX) - ETLF=(PARJ-SQRT(PARJ**2-CURV4*PARX*ETGR4(K,NB,NZ,NY,NX)))/CURV2 - EGRO=ETLF*CBXN4(K,NB,NZ,NY,NX) - VL=AMIN1(VGRO4(K,NB,NZ,NY,NX),EGRO)*FDBK4(K,NB,NZ,NY,NX) -C -C STOMATAL EFFECT OF WATER DEFICIT -C - IF(VL.GT.ZERO)THEN - RS=AMIN1(RCMX(NZ,NY,NX),AMAX1(RCMN,DCO2(NZ,NY,NX)/VL)) - RSL=RS+(RCMX(NZ,NY,NX)-RS)*WFNC - GSL=1.0/RSL*FMOL(NZ,NY,NX) -C -C NON-STOMATAL EFFECT OF WATER DEFICIT -C - IF(IGTYP(NZ,NY,NX).NE.0)THEN - WFN4=(RS/RSL)**1.00 - WFNB=SQRT(RS/RSL) - ELSE - WFN4=WFNG - WFNB=WFNG - ENDIF -C -C CONVERGENCE SOLUTION FOR CO2I AT WHICH CARBOXYLATION -C EQUALS DIFFUSION -C - CO2X=CO2I(NZ,NY,NX) - DO 135 NN=1,100 - CO2C=CO2X*SCO2(NZ,NY,NX) - CO2Y=AMAX1(0.0,CO2C-COMP4) - CBXNX=CO2Y/(ELEC4*CO2C+10.5*COMP4) - VGROX=VCGR4(K,NB,NZ,NY,NX)*CO2Y/(CO2C+XKCO24(NZ,NY,NX)) - EGROX=ETLF*CBXNX - VL=AMIN1(VGROX,EGROX)*WFN4*FDBK4(K,NB,NZ,NY,NX) - VG=(CO2Q(NZ,NY,NX)-CO2X)*GSL - IF(VL+VG.GT.ZERO)THEN - DIFF=(VL-VG)/(VL+VG) - IF(ABS(DIFF).LT.0.005)GO TO 140 - VA=0.95*VG+0.05*VL - CO2X=CO2Q(NZ,NY,NX)-VA/GSL - ELSE - VL=0.0 - GO TO 140 - ENDIF -135 CONTINUE -C -C ACCUMULATE C4 FIXATION PRODUCT -C -140 CH2O4(K)=CH2O4(K)+VL*SURFX(N,L,K,NB,NZ,NY,NX) - 2*TAU0(L+1,NY,NX) -C ICO2I=MAX(1,MIN(400,INT(CO2X))) -C VCO2(ICO2I,I,NZ)=VCO2(ICO2I,I,NZ) -C 2+(VL*SURFX(N,L,K,NB,NZ,NY,NX)*TAU0(L+1,NY,NX))*0.0432 -C WRITE(*,4455)'VLB4',IYRC,I,J,NZ,L,M,N,K,VL,PAR(N,M,L,NZ,NY,NX) -C 2,RAPS,TKC(NZ,NY,NX),CO2Q(NZ,NY,NX),ETGR4(K,NB,NZ,NY,NX) -C 3,CBXN4(K,NB,NZ,NY,NX),VGRO4(K,NB,NZ,NY,NX),EGRO -C 3,FDBK4(K,NB,NZ,NY,NX),CH2O4(K),WFN4,VGROX,EGROX -C 4,VCGR4(K,NB,NZ,NY,NX),CO2X,CO2C,CBXNX -C 5,RS,RSL -4455 FORMAT(A8,8I4,40E12.4) -C -C C3 CARBOXYLATION REACTIONS IN C4 PLANTS USING VARIABLES FROM 'STOMATE' -C - PARJ=PARX+ETGRO(K,NB,NZ,NY,NX) - ETLF=(PARJ-SQRT(PARJ**2-CURV4*PARX*ETGRO(K,NB,NZ,NY,NX)))/CURV2 - EGRO=ETLF*CBXN(K,NB,NZ,NY,NX) - VL=AMIN1(VGRO(K,NB,NZ,NY,NX),EGRO)*WFNB*FDBK(NB,NZ,NY,NX) -C -C ACCUMULATE C3 FIXATION PRODUCT -C - CH2O3(K)=CH2O3(K)+VL*SURFX(N,L,K,NB,NZ,NY,NX) - 2*TAU0(L+1,NY,NX) -C IF(J.EQ.13.AND.NB.EQ.1.AND.M.EQ.1.AND.N.EQ.1)THEN -C WRITE(*,4444)'VLB4',IYRC,I,J,NZ,L,K,VL,PARDIF(N,M,L,NZ,NY,NX) -C 2,RAPY,TKC(NZ,NY,NX),CO2Q(NZ,NY,NX),CO2X,FMOL(NZ,NY,NX)/GSL -C 3,VCGRO(K,NB,NZ,NY,NX),ETLF,FDBK(NB,NZ,NY,NX),WFNB -C ENDIF - ENDIF - ENDIF - ENDIF -120 CONTINUE -115 CONTINUE - ENDIF -110 CONTINUE - CO2F=CO2F+CH2O4(K) - CH2O=CH2O+CH2O3(K) -C -C C3 PHOTOSYNTHESIS -C - ELSEIF(ICTYP(NZ,NY,NX).NE.4.AND.VCGRO(K,NB,NZ,NY,NX).GT.0.0)THEN -C -C FOR EACH CANOPY LAYER -C - DO 210 L=JC,1,-1 - IF(ARLFL(L,K,NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN -C -C FOR EACH LEAF AZIMUTH AND INCLINATION -C - DO 215 N=1,4 - DO 220 M=1,4 -C -C CO2 FIXATION BY SUNLIT LEAVES -C - IF(SURFX(N,L,K,NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - - IF(PAR(N,M,L,NZ,NY,NX).GT.0.0)THEN -C -C C3 CARBOXYLATION REACTIONS USING VARIABLES FROM 'STOMATE' -C - PARX=QNTM*PAR(N,M,L,NZ,NY,NX) - PARJ=PARX+ETGRO(K,NB,NZ,NY,NX) - ETLF=(PARJ-SQRT(PARJ**2-CURV4*PARX*ETGRO(K,NB,NZ,NY,NX)))/CURV2 - EGRO=ETLF*CBXN(K,NB,NZ,NY,NX) - VL=AMIN1(VGRO(K,NB,NZ,NY,NX),EGRO)*FDBK(NB,NZ,NY,NX) -C -C STOMATAL EFFECT OF WATER DEFICIT -C - IF(VL.GT.ZERO)THEN - RS=AMIN1(RCMX(NZ,NY,NX),AMAX1(RCMN,DCO2(NZ,NY,NX)/VL)) - RSL=RS+(RCMX(NZ,NY,NX)-RS)*WFNC - GSL=1.0/RSL*FMOL(NZ,NY,NX) -C -C NON-STOMATAL EFFECT OF WATER DEFICIT -C - IF(IGTYP(NZ,NY,NX).NE.0)THEN - WFNB=SQRT(RS/RSL) - ELSE - WFNB=WFNG - ENDIF -C -C CONVERGENCE SOLUTION FOR CO2I AT WHICH CARBOXYLATION -C EQUALS DIFFUSION -C - CO2X=CO2I(NZ,NY,NX) - DO 225 NN=1,100 - CO2C=CO2X*SCO2(NZ,NY,NX) - CO2Y=AMAX1(0.0,CO2C-COMPL(K,NB,NZ,NY,NX)) - CBXNX=CO2Y/(ELEC3*CO2C+10.5*COMPL(K,NB,NZ,NY,NX)) - VGROX=VCGRO(K,NB,NZ,NY,NX)*CO2Y/(CO2C+XKCO2O(NZ,NY,NX)) - EGROX=ETLF*CBXNX - VL=AMIN1(VGROX,EGROX)*WFNB*FDBK(NB,NZ,NY,NX) - VG=(CO2Q(NZ,NY,NX)-CO2X)*GSL - IF(VL+VG.GT.ZERO)THEN - DIFF=(VL-VG)/(VL+VG) - IF(ABS(DIFF).LT.0.005)GO TO 230 - VA=0.95*VG+0.05*VL - CO2X=CO2Q(NZ,NY,NX)-VA/GSL - ELSE - VL=0.0 - GO TO 230 - ENDIF -225 CONTINUE -C -C ACCUMULATE C3 FIXATION PRODUCT -C -230 CH2O3(K)=CH2O3(K)+VL*SURFX(N,L,K,NB,NZ,NY,NX) - 2*TAUS(L+1,NY,NX) -C ICO2I=MAX(1,MIN(400,INT(CO2X))) -C VCO2(ICO2I,I,NZ)=VCO2(ICO2I,I,NZ) -C 2+(VL*SURFX(N,L,K,NB,NZ,NY,NX)*TAUS(L+1,NY,NX))*0.0432 -C IF(NB.EQ.1.AND.M.EQ.1.AND.N.EQ.1.AND.K.EQ.KLEAF(NB,NZ,NY,NX)-1 -C 2.AND.J.EQ.12)THEN -C WRITE(20,3335)'VLD',IYRC,I,J,NZ,L,M,N,K,VL,PAR(N,M,L,NZ,NY,NX) -C 2,RAPS,TKC(NZ,NY,NX),TKA,CO2Q(NZ,NY,NX),CO2X,CO2C,FMOL(NZ,NY,NX) -C 3/GSL,VGROX,EGROX,ETLF,CBXNX,FDBK(NB,NZ,NY,NX),WFNB,PSILG(NZ,NY,NX) -C 4,VCGRO(K,NB,NZ,NY,NX),ETGRO(K,NB,NZ,NY,NX),COMPL(K,NB,NZ,NY,NX) -C 5,SURFX(N,L,K,NB,NZ,NY,NX),TAUS(L+1,NY,NX),CH2O3(K) -3335 FORMAT(A8,8I4,30E12.4) -C ENDIF - ENDIF - ENDIF -C -C CO2 FIXATION BY SHADED LEAVES -C - IF(PARDIF(N,M,L,NZ,NY,NX).GT.0.0)THEN -C -C C3 CARBOXYLATION REACTIONS USING VARIABLES FROM 'STOMATE' -C - PARX=QNTM*PARDIF(N,M,L,NZ,NY,NX) - PARJ=PARX+ETGRO(K,NB,NZ,NY,NX) - ETLF=(PARJ-SQRT(PARJ**2-CURV4*PARX*ETGRO(K,NB,NZ,NY,NX)))/CURV2 - EGRO=ETLF*CBXN(K,NB,NZ,NY,NX) - VL=AMIN1(VGRO(K,NB,NZ,NY,NX),EGRO)*FDBK(NB,NZ,NY,NX) -C -C STOMATAL EFFECT OF WATER DEFICIT -C - IF(VL.GT.ZERO)THEN - RS=AMIN1(RCMX(NZ,NY,NX),AMAX1(RCMN,DCO2(NZ,NY,NX)/VL)) - RSL=RS+(RCMX(NZ,NY,NX)-RS)*WFNC - GSL=1.0/RSL*FMOL(NZ,NY,NX) -C -C NON-STOMATAL EFFECT OF WATER DEFICIT -C - IF(IGTYP(NZ,NY,NX).NE.0)THEN - WFNB=SQRT(RS/RSL) - ELSE - WFNB=WFNG - ENDIF -C -C CONVERGENCE SOLUTION FOR CO2I AT WHICH CARBOXYLATION -C EQUALS DIFFUSION -C - CO2X=CO2I(NZ,NY,NX) - DO 235 NN=1,100 - CO2C=CO2X*SCO2(NZ,NY,NX) - CO2Y=AMAX1(0.0,CO2C-COMPL(K,NB,NZ,NY,NX)) - CBXNX=CO2Y/(ELEC3*CO2C+10.5*COMPL(K,NB,NZ,NY,NX)) - VGROX=VCGRO(K,NB,NZ,NY,NX)*CO2Y/(CO2C+XKCO2O(NZ,NY,NX)) - EGROX=ETLF*CBXNX - VL=AMIN1(VGROX,EGROX)*WFNB*FDBK(NB,NZ,NY,NX) - VG=(CO2Q(NZ,NY,NX)-CO2X)*GSL - IF(VL+VG.GT.ZERO)THEN - DIFF=(VL-VG)/(VL+VG) - IF(ABS(DIFF).LT.0.005)GO TO 240 - VA=0.95*VG+0.05*VL - CO2X=CO2Q(NZ,NY,NX)-VA/GSL - ELSE - VL=0.0 - GO TO 240 - ENDIF -235 CONTINUE -C -C ACCUMULATE C3 FIXATION PRODUCT -C -240 CH2O3(K)=CH2O3(K)+VL*SURFX(N,L,K,NB,NZ,NY,NX) - 2*TAU0(L+1,NY,NX) -C ICO2I=MAX(1,MIN(400,INT(CO2X))) -C VCO2(ICO2I,I,NZ)=VCO2(ICO2I,I,NZ) -C 2+(VL*SURFX(N,L,K,NB,NZ,NY,NX)*TAU0(L+1,NY,NX))*0.0432 -C IF(J.EQ.13.AND.NB.EQ.1.AND.M.EQ.1.AND.N.EQ.1)THEN -C WRITE(*,3335)'VLB',IYRC,I,J,NZ,L,K,VL,PARDIF(N,M,L,NZ,NY,NX) -C 2,RAPY,TKC(NZ,NY,NX),CO2Q(NZ,NY,NX),CO2X,FMOL(NZ,NY,NX)/GSL -C 3,VCGRO(K,NB,NZ,NY,NX),ETLF,FDBK(NB,NZ,NY,NX),WFNB -C ENDIF - ENDIF - ENDIF - ENDIF -220 CONTINUE -215 CONTINUE - ENDIF -210 CONTINUE - CO2F=CO2F+CH2O3(K) - CH2O=CH2O+CH2O3(K) - ENDIF - ENDIF -100 CONTINUE - CO2F=CO2F*0.0432 - CH2O=CH2O*0.0432 -C -C CONVERT UMOL M-2 S-1 TO G C M-2 H-1 -C - DO 150 K=1,25 - CH2O3(K)=CH2O3(K)*0.0432 - CH2O4(K)=CH2O4(K)*0.0432 -150 CONTINUE - ELSE - CO2F=0.0 - CH2O=0.0 - IF(ICTYP(NZ,NY,NX).EQ.4)THEN - DO 155 K=1,25 - CH2O3(K)=0.0 - CH2O4(K)=0.0 -155 CONTINUE - ENDIF - ENDIF - ELSE - CO2F=0.0 - CH2O=0.0 - IF(ICTYP(NZ,NY,NX).EQ.4)THEN - DO 160 K=1,25 - CH2O3(K)=0.0 - CH2O4(K)=0.0 -160 CONTINUE - ENDIF - ENDIF - ELSE - CO2F=0.0 - CH2O=0.0 - IF(ICTYP(NZ,NY,NX).EQ.4)THEN - DO 165 K=1,25 - CH2O3(K)=0.0 - CH2O4(K)=0.0 -165 CONTINUE - ENDIF - ENDIF -C -C SHOOT AUTOTROPHIC RESPIRATION AFTER EMERGENCE -C -C -C N,P CONSTRAINT ON RESPIRATION FROM NON-STRUCTURAL C:N:P -C - IF(CCPOLB(NB,NZ,NY,NX).GT.ZERO)THEN - CNPG=AMIN1(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) - 2+CCPOLB(NB,NZ,NY,NX)/CPKI)) - ELSE - CNPG=1.0 - ENDIF -C -C RESPIRATION FROM NON-STRUCTURAL C DETERMINED BY TEMPERATURE, -C NON-STRUCTURAL C:N:P -C - RCO2C=AMAX1(0.0,VMXC*CPOOL(NB,NZ,NY,NX) - 2*TFN3(NZ,NY,NX))*CNPG*FDBKX(NB,NZ,NY,NX)*WFNG -C -C MAINTENANCE RESPIRATION FROM TEMPERATURE, PLANT STRUCTURAL N -C - RMNCS=AMAX1(0.0,RMPLT*TFN5*WTSHXN) - IF(IWTYP(NZ,NY,NX).EQ.2)THEN - RMNCS=RMNCS*WFNG - ENDIF -C -C GROWTH RESPIRATION FROM TOTAL - MAINTENANCE -C IF > 0 DRIVES GROWTH, IF < 0 DRIVES REMOBILIZATION -C - RCO2X=RCO2C-RMNCS - RCO2Y=AMAX1(0.0,RCO2X)*WFNSG - SNCR=AMAX1(0.0,-RCO2X) -C -C GROWTH RESPIRATION MAY BE LIMITED BY NON-STRUCTURAL N,P -C AVAILABLE FOR GROWTH -C - IF(RCO2Y.GT.0.0.AND.(CNSHX.GT.0.0.OR.CNLFX.GT.0.0))THEN - ZPOOLB=AMAX1(0.0,ZPOOL(NB,NZ,NY,NX)) - PPOOLB=AMAX1(0.0,PPOOL(NB,NZ,NY,NX)) - RCO2G=AMIN1(RCO2Y,ZPOOLB*DMSHD/(CNSHX+CNLFM+CNLFX*CNPG) - 2,PPOOLB*DMSHD/(CPSHX+CPLFM+CPLFX*CNPG)) - ELSE - RCO2G=0.0 - ENDIF -C -C TOTAL NON-STRUCTURAL C,N,P USED IN GROWTH -C AND GROWTH RESPIRATION DEPENDS ON GROWTH YIELDS -C ENTERED IN 'READQ' -C - CGROS=RCO2G/DMSHD - ZADDB=AMAX1(0.0,AMIN1(ZPOOL(NB,NZ,NY,NX) - 2,CGROS*(CNSHX+CNLFM+CNLFX*CNPG))) - PADDB=AMAX1(0.0,AMIN1(PPOOL(NB,NZ,NY,NX) - 2,CGROS*(CPSHX+CPLFM+CPLFX*CNPG))) - CNRDA=AMAX1(0.0,1.70*ZADDB-0.025*CH2O) -C -C TOTAL ABOVE-GROUND AUTOTROPHIC RESPIRATION BY BRANCH -C ACCUMULATE GPP, SHOOT AUTOTROPHIC RESPIRATION, NET C EXCHANGE -C - RCO2T=AMIN1(RMNCS,RCO2C)+RCO2G+SNCR+CNRDA - CARBN(NZ,NY,NX)=CARBN(NZ,NY,NX)+CO2F - TCO2T(NZ,NY,NX)=TCO2T(NZ,NY,NX)-RCO2T - TCO2A(NZ,NY,NX)=TCO2A(NZ,NY,NX)-RCO2T - CNET(NZ,NY,NX)=CNET(NZ,NY,NX)+CO2F-RCO2T - GPP(NY,NX)=GPP(NY,NX)+CO2F - TGPP(NY,NX)=TGPP(NY,NX)+CO2F - RECO(NY,NX)=RECO(NY,NX)-RCO2T - TRAU(NY,NX)=TRAU(NY,NX)-RCO2T -C IF(NZ.EQ.1)THEN -C WRITE(*,4477)'RCO2',I,J,NX,NY,NZ,NB,IFLGZ,CPOOL(NB,NZ,NY,NX) -C 2,CH2O,RMNCS,RCO2C,CGROS,CNRDA,CNPG,RCO2T,RCO2X,SNCR -C 3,RCO2G,DMSHD,ZADDB,PART(1),PART(2),DMLFB,DMSHB -C 4,WTRSVB(NB,NZ,NY,NX),WVSTKB(NB,NZ,NY,NX),WTSHXN -C 5,ZPOOL(NB,NZ,NY,NX),PPOOL(NB,NZ,NY,NX),PSILT(NZ,NY,NX) -C 6,ZADDB,RNH3B(NB,NZ,NY,NX),WFR(1,NG(NZ,NY,NX),NZ,NY,NX) -C 7,WFNG,TFN3(NZ,NY,NX),TFN5,FDBKX(NB,NZ,NY,NX),VMXC -4477 FORMAT(A8,7I4,40E12.4) -C ENDIF -C -C SHOOT AUTOTROPHIC RESPIRATION BEFORE EMERGENCE -C - ELSE -C -C N,P CONSTRAINT ON RESPIRATION FROM NON-STRUCTURAL C:N:P -C - IF(CCPOLB(NB,NZ,NY,NX).GT.ZERO)THEN - CNPG=AMIN1(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)) - ELSE - CNPG=1.0 - ENDIF -C -C RESPIRATION FROM NON-STRUCTURAL C DETERMINED BY TEMPERATURE, -C NON-STRUCTURAL C:N:P, O2 UPTAKE -C - RCO2CM=AMAX1(0.0,VMXC*CPOOL(NB,NZ,NY,NX) - 2*TFN4(NG(NZ,NY,NX),NZ,NY,NX))*CNPG*WFNG*FDBKX(NB,NZ,NY,NX) - RCO2C=RCO2CM*WFR(1,NG(NZ,NY,NX),NZ,NY,NX) -C -C MAINTENANCE RESPIRATION FROM TEMPERATURE, PLANT STRUCTURAL N -C - RMNCS=AMAX1(0.0,RMPLT*TFN6(NG(NZ,NY,NX))*WTSHXN) - IF(IWTYP(NZ,NY,NX).EQ.2)THEN - RMNCS=RMNCS*WFNG - ENDIF -C -C GROWTH RESPIRATION FROM TOTAL - MAINTENANCE -C IF > 0 DRIVES GROWTH, IF < 0 DRIVES REMOBILIZATION -C - RCO2XM=RCO2CM-RMNCS - RCO2X=RCO2C-RMNCS - RCO2YM=AMAX1(0.0,RCO2XM)*WFNSG - RCO2Y=AMAX1(0.0,RCO2X)*WFNSG - SNCRM=AMAX1(0.0,-RCO2XM) - SNCR=AMAX1(0.0,-RCO2X) -C -C GROWTH RESPIRATION MAY BE LIMITED BY NON-STRUCTURAL N,P -C AVAILABLE FOR GROWTH -C - IF(CNSHX.GT.0.0.OR.CNLFX.GT.0.0)THEN - ZPOOLB=AMAX1(0.0,ZPOOL(NB,NZ,NY,NX)) - PPOOLB=AMAX1(0.0,PPOOL(NB,NZ,NY,NX)) - FNP=AMIN1(ZPOOLB*DMSHD/(CNSHX+CNLFM+CNLFX*CNPG) - 2,PPOOLB*DMSHD/(CPSHX+CPLFM+CPLFX*CNPG)) - IF(RCO2YM.GT.0.0)THEN - RCO2GM=AMIN1(RCO2YM,FNP) - ELSE - RCO2GM=0.0 - ENDIF - IF(RCO2Y.GT.0.0)THEN - RCO2G=AMIN1(RCO2Y,FNP*WFR(1,NG(NZ,NY,NX),NZ,NY,NX)) - ELSE - RCO2G=0.0 - ENDIF - ELSE - RCO2GM=0.0 - RCO2G=0.0 - ENDIF -C -C TOTAL NON-STRUCTURAL C,N,P USED IN GROWTH -C AND GROWTH RESPIRATION DEPENDS ON GROWTH YIELDS -C ENTERED IN 'READQ' -C - CGROSM=RCO2GM/DMSHD - CGROS=RCO2G/DMSHD - ZADDBM=AMAX1(0.0,CGROSM*(CNSHX+CNLFM+CNLFX*CNPG)) - ZADDB=AMAX1(0.0,CGROS*(CNSHX+CNLFM+CNLFX*CNPG)) - PADDB=AMAX1(0.0,CGROS*(CPSHX+CPLFM+CPLFX*CNPG)) - CNRDM=AMAX1(0.0,1.70*ZADDBM) - CNRDA=AMAX1(0.0,1.70*ZADDB) -C -C TOTAL ABOVE-GROUND AUTOTROPHIC RESPIRATION BY BRANCH -C ACCUMULATE GPP, SHOOT AUTOTROPHIC RESPIRATION, NET C EXCHANGE -C - RCO2TM=RMNCS+RCO2GM+SNCRM+CNRDM - RCO2T=RMNCS+RCO2G+SNCR+CNRDA - RCO2M(1,NG(NZ,NY,NX),NZ,NY,NX)=RCO2M(1,NG(NZ,NY,NX),NZ,NY,NX) - 2+RCO2TM - RCO2N(1,NG(NZ,NY,NX),NZ,NY,NX)=RCO2N(1,NG(NZ,NY,NX),NZ,NY,NX) - 2+RCO2T - RCO2A(1,NG(NZ,NY,NX),NZ,NY,NX)=RCO2A(1,NG(NZ,NY,NX),NZ,NY,NX) - 2-RCO2T - CH2O=0.0 - ENDIF -C -C REMOVE C,N,P USED IN MAINTENANCE + GROWTH REPIRATION AND GROWTH -C FROM NON-STRUCTURAL POOLS -C - CPOOL(NB,NZ,NY,NX)=CPOOL(NB,NZ,NY,NX)+CH2O-AMIN1(RMNCS,RCO2C) - 2-CGROS-CNRDA - ZPOOL(NB,NZ,NY,NX)=ZPOOL(NB,NZ,NY,NX)-ZADDB+RNH3B(NB,NZ,NY,NX) - PPOOL(NB,NZ,NY,NX)=PPOOL(NB,NZ,NY,NX)-PADDB -C -C TRANSFER OF C4 FIXATION PRODUCTS FROM NON-STRUCTURAL POOLS -C IN MESOPHYLL TO THOSE IN BUNDLE SHEATH, DECARBOXYLATION -C OF C4 FIXATION PRODUCTS IN BUNDLE SHEATH, LEAKAGE OF DECARBOXYLATION -C PRODUCTS BACK TO MESOPHYLL IN C4 PLANTS -C - IF(ICTYP(NZ,NY,NX).EQ.4)THEN - DO 170 K=1,25 - IF(WGLF(K,NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - CCBS1=AMAX1(0.0,0.083E+09*CO2B(K,NB,NZ,NY,NX) - 2/(WGLF(K,NB,NZ,NY,NX)*FBS)) -C -C BUNDLE SHEATH LEAKAGE -C - CO2LK=AMIN1(AMAX1(0.0,CPOOL3(K,NB,NZ,NY,NX)-CH2O3(K)) - 2,5.0E-07*(CCBS1-CO2L(NZ,NY,NX))*WGLF(K,NB,NZ,NY,NX)*FBS) - IF(CPOOL3(K,NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - FPL3X=CPOOL3(K,NB,NZ,NY,NX)/(CPOOL3(K,NB,NZ,NY,NX) - 2+AMAX1(0.0,CO2B(K,NB,NZ,NY,NX))) - ELSE - FPL3X=0.0 - ENDIF - CPL3X=FPL3X*(CH2O3(K)+CO2LK) - CPL3Z=CPL3X-CH2O3(K)-CO2LK - CO2B(K,NB,NZ,NY,NX)=CO2B(K,NB,NZ,NY,NX)+FCO2B*CPL3Z - HCOB(K,NB,NZ,NY,NX)=HCOB(K,NB,NZ,NY,NX)+FHCOB*CPL3Z - CPOOL3(K,NB,NZ,NY,NX)=CPOOL3(K,NB,NZ,NY,NX)-CPL3X -C -C BUNDLE SHEATH DECARBOXYLATION -C - CCBS2=AMAX1(0.0,0.083E+09*CO2B(K,NB,NZ,NY,NX) - 2/(WGLF(K,NB,NZ,NY,NX)*FBS)) - CPL3K=2.5E-02*CPOOL3(K,NB,NZ,NY,NX)/(1.0+CCBS2/CO2KI) - CPOOL3(K,NB,NZ,NY,NX)=CPOOL3(K,NB,NZ,NY,NX)-CPL3K - CO2B(K,NB,NZ,NY,NX)=CO2B(K,NB,NZ,NY,NX)+FCO2B*CPL3K - HCOB(K,NB,NZ,NY,NX)=HCOB(K,NB,NZ,NY,NX)+FHCOB*CPL3K -C -C MESOPHYLL TO BUNDLE SHEATH TRANSFER -C - CPOOL4(K,NB,NZ,NY,NX)=CPOOL4(K,NB,NZ,NY,NX)+CH2O4(K) - CPL4M=0.5*(CPOOL4(K,NB,NZ,NY,NX)*WGLF(K,NB,NZ,NY,NX)*FBS - 2-CPOOL3(K,NB,NZ,NY,NX)*WGLF(K,NB,NZ,NY,NX)*FMP) - 2/(WGLF(K,NB,NZ,NY,NX)*(FBS+FMP)) - CPOOL4(K,NB,NZ,NY,NX)=CPOOL4(K,NB,NZ,NY,NX)-CPL4M - CPOOL3(K,NB,NZ,NY,NX)=CPOOL3(K,NB,NZ,NY,NX)+CPL4M - TCO2T(NZ,NY,NX)=TCO2T(NZ,NY,NX)-CO2LK - TCO2A(NZ,NY,NX)=TCO2A(NZ,NY,NX)-CO2LK - CNET(NZ,NY,NX)=CNET(NZ,NY,NX)-CO2LK - RECO(NY,NX)=RECO(NY,NX)-CO2LK - TRAU(NY,NX)=TRAU(NY,NX)-CO2LK - CO2LKF=CO2LK/ARLF(K,NB,NZ,NY,NX)*23.148 -C TC4=TC4+CH2O4(K) -C TLK=TLK+CO2LK -C IF(NB.EQ.1.AND.(K.EQ.16))THEN -C CCBS3=AMAX1(0.0,0.083E+09*CO2B(K,NB,NZ,NY,NX) -C 2/(WGLF(K,NB,NZ,NY,NX)*FBS)) -C WRITE(*,6667)'CO2K',I,J,NB,K,CPOOL4(K,NB,NZ,NY,NX) -C 2,CPOOL3(K,NB,NZ,NY,NX),CO2B(K,NB,NZ,NY,NX) -C 2,CPOOL4(K,NB,NZ,NY,NX)/(WGLF(K,NB,NZ,NY,NX)*FMP) -C 2,CPOOL3(K,NB,NZ,NY,NX)/(WGLF(K,NB,NZ,NY,NX)*FBS) -C 2,CO2B(K,NB,NZ,NY,NX)/(WGLF(K,NB,NZ,NY,NX)*FBS) -C 4,FPL3X,CH2O4(K),CH2O3(K),CPL4M,CPL3X,CPL3K,CO2LK -C 5,TC4,TLK,CO2LKF,CCBS1,CO2L(NZ,NY,NX),CCBS3 -C 6,ARLF(K,NB,NZ,NY,NX),HCOB(K,NB,NZ,NY,NX) -6667 FORMAT(A8,4I4,30E14.6) -C ENDIF - ENDIF -170 CONTINUE - ENDIF -C -C C,N,P GROWTH OF LEAF, SHEATH OR PETIOLE, STALK, -C STALK RESERVES, REPRODUCTIVE ORGANS, GRAIN -C - GROLF=PART(1)*CGROS*DMLFB - GROSHE=PART(2)*CGROS*DMSHB - GROSTK=PART(3)*CGROS*DMSTK(NZ,NY,NX) - GRORSV=PART(4)*CGROS*DMRSV(NZ,NY,NX) - GROHSK=PART(5)*CGROS*DMHSK(NZ,NY,NX) - GROEAR=PART(6)*CGROS*DMEAR(NZ,NY,NX) - GROGR=PART(7)*CGROS*DMGR(NZ,NY,NX) - GROSHT=CGROS*DMSHT - GROLFN=GROLF*CNLFB*(ZPLFM+ZPLFD*CNPG) - GROSHN=GROSHE*CNSHB - GROSTN=GROSTK*CNSTK(NZ,NY,NX) - GRORSN=GRORSV*CNRSV(NZ,NY,NX) - GROHSN=GROHSK*CNHSK(NZ,NY,NX) - GROEAN=GROEAR*CNEAR(NZ,NY,NX) - GROGRN=GROGR*CNRSV(NZ,NY,NX) - GROLFP=GROLF*CPLFB*(ZPLFM+ZPLFD*CNPG) - GROSHP=GROSHE*CPSHB - GROSTP=GROSTK*CPSTK(NZ,NY,NX) - GRORSP=GRORSV*CPRSV(NZ,NY,NX) - GROHSP=GROHSK*CPHSK(NZ,NY,NX) - GROEAP=GROEAR*CPEAR(NZ,NY,NX) - GROGRP=GROGR*CPRSV(NZ,NY,NX) - WTLFB(NB,NZ,NY,NX)=WTLFB(NB,NZ,NY,NX)+GROLF - WTSHEB(NB,NZ,NY,NX)=WTSHEB(NB,NZ,NY,NX)+GROSHE - WTSTKB(NB,NZ,NY,NX)=WTSTKB(NB,NZ,NY,NX)+GROSTK - WTRSVB(NB,NZ,NY,NX)=WTRSVB(NB,NZ,NY,NX)+GRORSV - WTHSKB(NB,NZ,NY,NX)=WTHSKB(NB,NZ,NY,NX)+GROHSK - WTEARB(NB,NZ,NY,NX)=WTEARB(NB,NZ,NY,NX)+GROEAR - WTLFBN(NB,NZ,NY,NX)=WTLFBN(NB,NZ,NY,NX)+GROLFN - WTSHBN(NB,NZ,NY,NX)=WTSHBN(NB,NZ,NY,NX)+GROSHN - WTSTBN(NB,NZ,NY,NX)=WTSTBN(NB,NZ,NY,NX)+GROSTN - WTRSBN(NB,NZ,NY,NX)=WTRSBN(NB,NZ,NY,NX)+GRORSN - WTHSBN(NB,NZ,NY,NX)=WTHSBN(NB,NZ,NY,NX)+GROHSN - WTEABN(NB,NZ,NY,NX)=WTEABN(NB,NZ,NY,NX)+GROEAN - WTLFBP(NB,NZ,NY,NX)=WTLFBP(NB,NZ,NY,NX)+GROLFP - WTSHBP(NB,NZ,NY,NX)=WTSHBP(NB,NZ,NY,NX)+GROSHP - WTSTBP(NB,NZ,NY,NX)=WTSTBP(NB,NZ,NY,NX)+GROSTP - WTRSBP(NB,NZ,NY,NX)=WTRSBP(NB,NZ,NY,NX)+GRORSP - WTHSBP(NB,NZ,NY,NX)=WTHSBP(NB,NZ,NY,NX)+GROHSP - WTEABP(NB,NZ,NY,NX)=WTEABP(NB,NZ,NY,NX)+GROEAP -C -C DISTRIBUTE LEAF GROWTH AMONG CURRENTLY GROWING NODES -C - CCE=AMIN1(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)) - ETOL=1.0+CCE - IF(NB.EQ.NB1(NZ,NY,NX).AND.HTCTL(NZ,NY,NX).LE.SDPTH(NZ,NY,NX))THEN - NNOD1=0 - ELSE - NNOD1=1 - ENDIF - IF(GROLF.GT.0.0)THEN - MXNOD=KVSTG(NB,NZ,NY,NX) - MNNOD=MAX(NNOD1,MXNOD-NNOD(NZ,NY,NX)+1) - MXNOD=MAX(MXNOD,MNNOD) - KNOD=MXNOD-MNNOD+1 - GNOD=KNOD - ALLOCL=1.0/GNOD - GRO=ALLOCL*GROLF - GRON=ALLOCL*GROLFN - GROP=ALLOCL*GROLFP - GSLA=ALLOCL*FNOD(NZ,NY,NX)*NNOD(NZ,NY,NX) -C -C GROWTH AT EACH CURRENT NODE -C - DO 490 KK=MNNOD,MXNOD - K=MOD(KK,25) - IF(K.EQ.0.AND.KK.NE.0)K=25 - WGLF(K,NB,NZ,NY,NX)=WGLF(K,NB,NZ,NY,NX)+GRO - WGLFN(K,NB,NZ,NY,NX)=WGLFN(K,NB,NZ,NY,NX)+GRON - WGLFP(K,NB,NZ,NY,NX)=WGLFP(K,NB,NZ,NY,NX)+GROP - WSLF(K,NB,NZ,NY,NX)=WSLF(K,NB,NZ,NY,NX) - 2+AMIN1(GRON*CNWS(NZ,NY,NX),GROP*CPWS(NZ,NY,NX)) -C -C SPECIFIC LEAF AREA FUNCTION OF CURRENT LEAF MASS -C WITH PARAMETERS FROM 'READQ' -C - SLA=ETOL*SLA1(NZ,NY,NX)*(AMAX1(ZEROL(NZ,NY,NX) - 2,WGLF(K,NB,NZ,NY,NX))/(PP(NZ,NY,NX)*GSLA))**SLA2*WFNS - GROA=GRO*SLA - ARLFB(NB,NZ,NY,NX)=ARLFB(NB,NZ,NY,NX)+GROA - ARLF(K,NB,NZ,NY,NX)=ARLF(K,NB,NZ,NY,NX)+GROA -490 CONTINUE - ENDIF -C -C DISTRIBUTE SHEATH OR PETIOLE GROWTH AMONG CURRENTLY GROWING NODES -C - IF(GROSHE.GT.0.0)THEN - MXNOD=KVSTG(NB,NZ,NY,NX) - MNNOD=MAX(NNOD1,MXNOD-NNOD(NZ,NY,NX)+1) - MXNOD=MAX(MXNOD,MNNOD) - GNOD=MXNOD-MNNOD+1 - ALLOCS=1.0/GNOD - GRO=ALLOCS*GROSHE - GRON=ALLOCS*GROSHN - GROP=ALLOCS*GROSHP - GSSL=ALLOCL*FNOD(NZ,NY,NX)*NNOD(NZ,NY,NX) -C -C GROWTH AT EACH CURRENT NODE -C - DO 505 KK=MNNOD,MXNOD - K=MOD(KK,25) - IF(K.EQ.0.AND.KK.NE.0)K=25 - WGSHE(K,NB,NZ,NY,NX)=WGSHE(K,NB,NZ,NY,NX)+GRO - WGSHN(K,NB,NZ,NY,NX)=WGSHN(K,NB,NZ,NY,NX)+GRON - WGSHP(K,NB,NZ,NY,NX)=WGSHP(K,NB,NZ,NY,NX)+GROP - WSSHE(K,NB,NZ,NY,NX)=WSSHE(K,NB,NZ,NY,NX) - 2+AMIN1(GRON*CNWS(NZ,NY,NX),GROP*CPWS(NZ,NY,NX)) -C -C SPECIFIC SHEATH OR PETIOLE LENGTH FUNCTION OF CURRENT MASS -C WITH PARAMETERS FROM 'READQ' -C - IF(WGLF(K,NB,NZ,NY,NX).GT.0.0)THEN - SSL=ETOL*SSL1(NZ,NY,NX)*(AMAX1(ZEROL(NZ,NY,NX) - 4,WGSHE(K,NB,NZ,NY,NX))/(PP(NZ,NY,NX)*GSSL))**SSL2*WFNS - GROS=GRO/PP(NZ,NY,NX)*SSL - HTSHE(K,NB,NZ,NY,NX)=HTSHE(K,NB,NZ,NY,NX)+GROS*ANGSH(NZ,NY,NX) -C IF(I.EQ.120.AND.J.EQ.24)THEN -C WRITE(*,2526)'HTSHE',I,J,NZ,NB,K,SSL,WGSHE(K,NB,NZ,NY,NX) -C 2,HTSHE(K,NB,NZ,NY,NX),PP(NZ,NY,NX),SSL1(NZ,NY,NX) -C 3,GSLA,SSL3,WFNS,GROS,GRO,ANGSH(NZ,NY,NX),ZEROL(NZ,NY,NX) -C 4,CCPOLB(NB,NZ,NY,NX),ETOL -2526 FORMAT(A8,5I4,20E12.4) -C ENDIF - ENDIF -505 CONTINUE - ENDIF -C -C DISTRIBUTE STALK GROWTH AMONG CURRENTLY GROWING NODES -C - IF(IDAY(1,NB,NZ,NY,NX).EQ.0)THEN - NN=0 - ELSE - NN=1 - ENDIF - MXNOD=KVSTG(NB,NZ,NY,NX) - MNNOD=MAX(MIN(NN,MAX(NN,MXNOD-NNOD(NZ,NY,NX))) - 2,KVSTG(NB,NZ,NY,NX)-23) - MXNOD=MAX(MXNOD,MNNOD) - IF(GROSTK.GT.0.0)THEN - GNOD=MXNOD-MNNOD+1 - ALLOCN=1.0/GNOD - GRO=ALLOCN*GROSTK - GRON=ALLOCN*GROSTN - GROP=ALLOCN*GROSTP -C -C SPECIFIC INTERNODE LENGTH FUNCTION OF CURRENT STALK MASS -C WITH PARAMETERS FROM 'READQ' -C - SNL=ETOL*SNL1(NZ,NY,NX)*(WTSTKB(NB,NZ,NY,NX)/PP(NZ,NY,NX))**SNL2 - GROH=GRO/PP(NZ,NY,NX)*SNL - KX=MOD(MNNOD-1,25) - IF(KX.EQ.0.AND.MNNOD-1.NE.0)KX=25 -C -C GROWTH AT EACH CURRENT NODE -C - DO 510 KK=MNNOD,MXNOD - K1=MOD(KK,25) - IF(K1.EQ.0.AND.KK.NE.0)K1=25 - K2=MOD(KK-1,25) - IF(K2.EQ.0.AND.KK-1.NE.0)K2=25 - WGNODE(K1,NB,NZ,NY,NX)=WGNODE(K1,NB,NZ,NY,NX)+GRO - WGNODN(K1,NB,NZ,NY,NX)=WGNODN(K1,NB,NZ,NY,NX)+GRON - WGNODP(K1,NB,NZ,NY,NX)=WGNODP(K1,NB,NZ,NY,NX)+GROP - HTNODX(K1,NB,NZ,NY,NX)=HTNODX(K1,NB,NZ,NY,NX)+GROH*ANGBR(NZ,NY,NX) - IF(K1.NE.0)THEN - HTNODE(K1,NB,NZ,NY,NX)=HTNODX(K1,NB,NZ,NY,NX) - 2+HTNODE(K2,NB,NZ,NY,NX) - ELSE - HTNODE(K1,NB,NZ,NY,NX)=HTNODX(K1,NB,NZ,NY,NX) - ENDIF -C IF(NZ.EQ.1)THEN -C WRITE(*,515)'HTNODE',I,J,NZ,NB,KK,K1,K2,MNNOD,MXNOD -C 1,NNOD(NZ,NY,NX),ARLF(K1,NB,NZ,NY,NX) -C 2,HTNODE(K1,NB,NZ,NY,NX),HTNODE(K2,NB,NZ,NY,NX),SNL,GRO -C 3,ALLOCN,WTSTKB(NB,NZ,NY,NX),WGNODE(K1,NB,NZ,NY,NX) -C 4,HTNODX(K1,NB,NZ,NY,NX),PP(NZ,NY,NX),GROSTK -515 FORMAT(A8,10I4,20E12.4) -C ENDIF -510 CONTINUE - ENDIF -C -C RECOVERY OF REMOBILIZABLE N,P DURING REMOBILIZATION DEPENDS -C ON SHOOT NON-STRUCTURAL C:N:P -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) - 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) - ELSE - CCC=0.0 - CNC=0.0 - CPC=0.0 - ENDIF - RCCC=RCCZ(IBTYP(NZ,NY,NX))+CCC*RCCY(IBTYP(NZ,NY,NX)) - RCCN=CNC*RCCX(IGTYP(NZ,NY,NX)) - RCCP=CPC*RCCQ(IGTYP(NZ,NY,NX)) -C -C WITHDRAW REMOBILIZABLE C,N,P FROM LOWEST NODE AFTER -C MAXIMUM NODE NUMBER OF 25 IS REACHED -C - IF(IFLGG(NB,NZ,NY,NX).EQ.1)THEN - KVSTGX=KVSTG(NB,NZ,NY,NX)-24 - IF(KVSTGX.GT.0)THEN - K=MOD(KVSTGX,25) - IF(K.EQ.0.AND.KVSTGX.GT.0)K=25 - KX=MOD(KVSTG(NB,NZ,NY,NX),25) - IF(KX.EQ.0.AND.KVSTG(NB,NZ,NY,NX).NE.0)KX=25 - FSNC=TFN3(NZ,NY,NX)*XRLA(NZ,NY,NX) -C -C REMOBILIZATION OF LEAF C,N,P ALSO DEPENDS ON STRUCTURAL C:N:P -C - IF(IFLGP(NB,NZ,NY,NX).EQ.1)THEN - WGLFX(NB,NZ,NY,NX)=AMAX1(0.0,WGLF(K,NB,NZ,NY,NX)) - WGLFNX(NB,NZ,NY,NX)=AMAX1(0.0,WGLFN(K,NB,NZ,NY,NX)) - WGLFPX(NB,NZ,NY,NX)=AMAX1(0.0,WGLFP(K,NB,NZ,NY,NX)) - ARLFZ(NB,NZ,NY,NX)=AMAX1(0.0,ARLF(K,NB,NZ,NY,NX)) - IF(WGLFX(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - RCCLX(NB,NZ,NY,NX)=RCCC*WGLFX(NB,NZ,NY,NX) - RCZLX(NB,NZ,NY,NX)=WGLFNX(NB,NZ,NY,NX)*(RCCN+(1.0-RCCN)*RCCC) - RCPLX(NB,NZ,NY,NX)=WGLFPX(NB,NZ,NY,NX)*(RCCP+(1.0-RCCP)*RCCC) - ELSE - RCCLX(NB,NZ,NY,NX)=0.0 - RCZLX(NB,NZ,NY,NX)=0.0 - RCPLX(NB,NZ,NY,NX)=0.0 - ENDIF - ENDIF -C -C FRACTION OF CURRENT LEAF TO BE REMOBILIZED -C - IF(FSNC*WGLFX(NB,NZ,NY,NX).GT.WGLF(K,NB,NZ,NY,NX) - 2.AND.WGLFX(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - FSNCL=AMAX1(0.0,WGLF(K,NB,NZ,NY,NX)/WGLFX(NB,NZ,NY,NX)) - ELSE - FSNCL=FSNC - ENDIF -C -C NON-REMOBILIZABLE C,N,P BECOMES LITTERFALL ALLOCATED -C TO FRACTIONS SET IN 'STARTQ' -C - DO 6300 M=1,4 - CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX)+CFOPC(5,M,NZ,NY,NX) - 2*FSNCL*(WGLFX(NB,NZ,NY,NX)-RCCLX(NB,NZ,NY,NX))*FWODB(0) - ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX)+CFOPN(5,M,NZ,NY,NX) - 2*FSNCL*(WGLFNX(NB,NZ,NY,NX)-RCZLX(NB,NZ,NY,NX))*FWODLN(0) - PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX)+CFOPP(5,M,NZ,NY,NX) - 2*FSNCL*(WGLFPX(NB,NZ,NY,NX)-RCPLX(NB,NZ,NY,NX))*FWODLP(0) - CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX)+CFOPC(1,M,NZ,NY,NX) - 2*FSNCL*(WGLFX(NB,NZ,NY,NX)-RCCLX(NB,NZ,NY,NX))*FWODB(1) - ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX)+CFOPN(1,M,NZ,NY,NX) - 2*FSNCL*(WGLFNX(NB,NZ,NY,NX)-RCZLX(NB,NZ,NY,NX))*FWODLN(1) - PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX)+CFOPP(1,M,NZ,NY,NX) - 2*FSNCL*(WGLFPX(NB,NZ,NY,NX)-RCPLX(NB,NZ,NY,NX))*FWODLP(1) -6300 CONTINUE -C -C UPDATE STATE VARIABLES FOR REMOBILIZATION AND LITTERFALL -C - ARLFB(NB,NZ,NY,NX)=ARLFB(NB,NZ,NY,NX) - 2-FSNCL*ARLFZ(NB,NZ,NY,NX) - WTLFB(NB,NZ,NY,NX)=WTLFB(NB,NZ,NY,NX) - 2-FSNCL*WGLFX(NB,NZ,NY,NX) - WTLFBN(NB,NZ,NY,NX)=WTLFBN(NB,NZ,NY,NX) - 2-FSNCL*WGLFNX(NB,NZ,NY,NX) - WTLFBP(NB,NZ,NY,NX)=WTLFBP(NB,NZ,NY,NX) - 2-FSNCL*WGLFPX(NB,NZ,NY,NX) - ARLF(K,NB,NZ,NY,NX)=ARLF(K,NB,NZ,NY,NX) - 2-FSNCL*ARLFZ(NB,NZ,NY,NX) - WGLF(K,NB,NZ,NY,NX)=WGLF(K,NB,NZ,NY,NX) - 2-FSNCL*WGLFX(NB,NZ,NY,NX) - WGLFN(K,NB,NZ,NY,NX)=WGLFN(K,NB,NZ,NY,NX) - 2-FSNCL*WGLFNX(NB,NZ,NY,NX) - WGLFP(K,NB,NZ,NY,NX)=WGLFP(K,NB,NZ,NY,NX) - 2-FSNCL*WGLFPX(NB,NZ,NY,NX) - WSLF(K,NB,NZ,NY,NX)=AMAX1(0.0,WSLF(K,NB,NZ,NY,NX) - 2-FSNCL*AMAX1(WGLFNX(NB,NZ,NY,NX)*CNWS(NZ,NY,NX) - 3,WGLFPX(NB,NZ,NY,NX)*CPWS(NZ,NY,NX))) - CPOOL(NB,NZ,NY,NX)=CPOOL(NB,NZ,NY,NX)+FSNCL*RCCLX(NB,NZ,NY,NX) - ZPOOL(NB,NZ,NY,NX)=ZPOOL(NB,NZ,NY,NX)+FSNCL*RCZLX(NB,NZ,NY,NX) - PPOOL(NB,NZ,NY,NX)=PPOOL(NB,NZ,NY,NX)+FSNCL*RCPLX(NB,NZ,NY,NX) -C -C REMOBILIZATION OF SHEATHS OR PETIOLE C,N,P ALSO DEPENDS ON -C STRUCTURAL C:N:P -C - IF(IFLGP(NB,NZ,NY,NX).EQ.1)THEN - WGSHEX(NB,NZ,NY,NX)=AMAX1(0.0,WGSHE(K,NB,NZ,NY,NX)) - WGSHNX(NB,NZ,NY,NX)=AMAX1(0.0,WGSHN(K,NB,NZ,NY,NX)) - WGSHPX(NB,NZ,NY,NX)=AMAX1(0.0,WGSHP(K,NB,NZ,NY,NX)) - HTSHEX(NB,NZ,NY,NX)=AMAX1(0.0,HTSHE(K,NB,NZ,NY,NX)) - IF(WGSHEX(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - RCCSX(NB,NZ,NY,NX)=RCCC*WGSHEX(NB,NZ,NY,NX) - RCZSX(NB,NZ,NY,NX)=WGSHNX(NB,NZ,NY,NX) - 2*(RCCN+(1.0-RCCN)*RCCSX(NB,NZ,NY,NX)/WGSHEX(NB,NZ,NY,NX)) - RCPSX(NB,NZ,NY,NX)=WGSHPX(NB,NZ,NY,NX) - 2*(RCCP+(1.0-RCCP)*RCCSX(NB,NZ,NY,NX)/WGSHEX(NB,NZ,NY,NX)) - ELSE - RCCSX(NB,NZ,NY,NX)=0.0 - RCZSX(NB,NZ,NY,NX)=0.0 - RCPSX(NB,NZ,NY,NX)=0.0 - ENDIF - WTSTXB(NB,NZ,NY,NX)=WTSTXB(NB,NZ,NY,NX)+WGNODE(K,NB,NZ,NY,NX) - WTSTXN(NB,NZ,NY,NX)=WTSTXN(NB,NZ,NY,NX)+WGNODN(K,NB,NZ,NY,NX) - WTSTXP(NB,NZ,NY,NX)=WTSTXP(NB,NZ,NY,NX)+WGNODP(K,NB,NZ,NY,NX) -C IF(NZ.EQ.2)THEN -C WRITE(*,2358)'WTSTXB',I,J,NZ,NB,K,WTSTXB(NB,NZ,NY,NX) -C 2,WTSTKB(NB,NZ,NY,NX),WGNODE(K,NB,NZ,NY,NX) -2358 FORMAT(A8,5I4,12E12.4) -C ENDIF - WGNODE(K,NB,NZ,NY,NX)=0.0 - WGNODN(K,NB,NZ,NY,NX)=0.0 - WGNODP(K,NB,NZ,NY,NX)=0.0 - HTNODX(K,NB,NZ,NY,NX)=0.0 - ENDIF -C -C FRACTION OF CURRENT SHEATH TO BE REMOBILIZED -C - IF(FSNC*WGSHEX(NB,NZ,NY,NX).GT.WGSHE(K,NB,NZ,NY,NX) - 2.AND.WGSHEX(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - FSNCS=AMAX1(0.0,WGSHE(K,NB,NZ,NY,NX)/WGSHEX(NB,NZ,NY,NX)) - ELSE - FSNCS=FSNC - ENDIF -C -C NON-REMOBILIZABLE C,N,P BECOMES LITTERFALL ALLOCATED -C TO FRACTIONS SET IN 'STARTQ' -C - DO 6305 M=1,4 - CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX)+CFOPC(5,M,NZ,NY,NX) - 2*FSNCS*(WGSHEX(NB,NZ,NY,NX)-RCCSX(NB,NZ,NY,NX))*FWODB(0) - ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX)+CFOPN(5,M,NZ,NY,NX) - 2*FSNCS*(WGSHNX(NB,NZ,NY,NX)-RCZSX(NB,NZ,NY,NX))*FWODSN(0) - PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX)+CFOPP(5,M,NZ,NY,NX) - 2*FSNCS*(WGSHPX(NB,NZ,NY,NX)-RCPSX(NB,NZ,NY,NX))*FWODSP(0) - CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX)+CFOPC(2,M,NZ,NY,NX) - 2*FSNCS*(WGSHEX(NB,NZ,NY,NX)-RCCSX(NB,NZ,NY,NX))*FWODB(1) - ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX)+CFOPN(2,M,NZ,NY,NX) - 2*FSNCS*(WGSHNX(NB,NZ,NY,NX)-RCZSX(NB,NZ,NY,NX))*FWODSN(1) - PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX)+CFOPP(2,M,NZ,NY,NX) - 2*FSNCS*(WGSHPX(NB,NZ,NY,NX)-RCPSX(NB,NZ,NY,NX))*FWODSP(1) -6305 CONTINUE -C -C UPDATE STATE VARIABLES FOR REMOBILIZATION AND LITTERFALL -C - WTSHEB(NB,NZ,NY,NX)=WTSHEB(NB,NZ,NY,NX) - 2-FSNCS*WGSHEX(NB,NZ,NY,NX) - WTSHBN(NB,NZ,NY,NX)=WTSHBN(NB,NZ,NY,NX) - 2-FSNCS*WGSHNX(NB,NZ,NY,NX) - WTSHBP(NB,NZ,NY,NX)=WTSHBP(NB,NZ,NY,NX) - 2-FSNCS*WGSHPX(NB,NZ,NY,NX) - HTSHE(K,NB,NZ,NY,NX)=HTSHE(K,NB,NZ,NY,NX) - 2-FSNCS*HTSHEX(NB,NZ,NY,NX) - WGSHE(K,NB,NZ,NY,NX)=WGSHE(K,NB,NZ,NY,NX) - 2-FSNCS*WGSHEX(NB,NZ,NY,NX) - WGSHN(K,NB,NZ,NY,NX)=WGSHN(K,NB,NZ,NY,NX) - 2-FSNCS*WGSHNX(NB,NZ,NY,NX) - WGSHP(K,NB,NZ,NY,NX)=WGSHP(K,NB,NZ,NY,NX) - 2-FSNCS*WGSHPX(NB,NZ,NY,NX) - WSSHE(K,NB,NZ,NY,NX)=AMAX1(0.0,WSSHE(K,NB,NZ,NY,NX) - 2-FSNCS*AMAX1(WGSHNX(NB,NZ,NY,NX)*CNWS(NZ,NY,NX) - 3,WGSHPX(NB,NZ,NY,NX)*CPWS(NZ,NY,NX))) - CPOOL(NB,NZ,NY,NX)=CPOOL(NB,NZ,NY,NX)+FSNCS*RCCSX(NB,NZ,NY,NX) - ZPOOL(NB,NZ,NY,NX)=ZPOOL(NB,NZ,NY,NX)+FSNCS*RCZSX(NB,NZ,NY,NX) - PPOOL(NB,NZ,NY,NX)=PPOOL(NB,NZ,NY,NX)+FSNCS*RCPSX(NB,NZ,NY,NX) - ENDIF - ENDIF -C -C REMOBILIZATION OF STALK RESERVE C,N,P IF GROWTH RESPIRATION < 0 -C - IF(IFLGZ.EQ.0)THEN - IF(SNCR.GT.0.0.AND.WTRSVB(NB,NZ,NY,NX).GT.0.0)THEN - RCO2V=AMIN1(SNCR,VMXC*WTRSVB(NB,NZ,NY,NX)*TFN3(NZ,NY,NX)) - WTRSVB(NB,NZ,NY,NX)=WTRSVB(NB,NZ,NY,NX)-RCO2V - SNCR=SNCR-RCO2V - ENDIF - ENDIF -C -C TOTAL REMOBILIZATION = GROWTH RESPIRATION < 0 + DECIDUOUS LEAF -C FALL DURING AUTUMN + REMOBILZATION DURING GRAIN FILL IN ANNUALS -C - IF(ISTYP(NZ,NY,NX).NE.0.AND.IFLGZ.EQ.1.AND.IFLGY.EQ.1)THEN - SNCZ=FXFB(IBTYP(NZ,NY,NX)) - 2*WTLSB(NB,NZ,NY,NX)*AMIN1(1.0,FLGZ(NB,NZ,NY,NX)/FLGZX) - ELSE - SNCZ=0.0 - ENDIF - SNCX=SNCR+SNCZ - IF(SNCX.GT.ZEROP(NZ,NY,NX))THEN - SNCF=SNCZ/SNCX - KSNC=INT(0.5*(KVSTG(NB,NZ,NY,NX)-KVSTGN(NB,NZ,NY,NX)))+1 - XKSNC=KSNC - KN=MAX(0,KVSTGN(NB,NZ,NY,NX)-1) -C IF(NZ.EQ.2.OR.NZ.EQ.3)THEN -C WRITE(*,1266)'SNCX0',I,J,NX,NY,NZ,NB,SNCY,SNCR,SNCX,SNCF -C 2,CPOOL(NB,NZ,NY,NX),WTLSB(NB,NZ,NY,NX),RCCC -1266 FORMAT(A8,6I4,12E16.8) -C ENDIF -C -C TRANSFER NON-STRUCTURAL C,N,P FROM BRANCHES TO MAIN STEM -C IF MAIN STEM POOLS ARE DEPLETED -C - IF(IBTYP(NZ,NY,NX).NE.0.AND.IGTYP(NZ,NY,NX).GT.1 - 2.AND.NB.EQ.NB1(NZ,NY,NX).AND.SNCF.EQ.0)THEN - NBY=0 - DO 584 NBL=1,NBR(NZ,NY,NX) - NBZ(NBL)=0 -584 CONTINUE - DO 586 NBL=1,NBR(NZ,NY,NX) - NBX=KVSTG(NB,NZ,NY,NX) - DO 585 NBK=1,NBR(NZ,NY,NX) - IF(IDTHB(NBK,NZ,NY,NX).EQ.0.AND.NBK.NE.NB1(NZ,NY,NX) - 2.AND.NBTB(NBK,NZ,NY,NX).LT.NBX - 3.AND.NBTB(NBK,NZ,NY,NX).GT.NBY)THEN - NBZ(NBL)=NBK - NBX=NBTB(NBK,NZ,NY,NX) - ENDIF -585 CONTINUE - IF(NBZ(NBL).NE.0)THEN - NBY=NBTB(NBZ(NBL),NZ,NY,NX) - ENDIF -586 CONTINUE - DO 580 NBL=1,NBR(NZ,NY,NX) - IF(NBZ(NBL).NE.0)THEN - IF(NBTB(NBZ(NBL),NZ,NY,NX).LT.KK)THEN - IF(CPOOL(NBZ(NBL),NZ,NY,NX).GT.0)THEN - XFRC=1.0E-02*AMIN1(SNCX,CPOOL(NBZ(NBL),NZ,NY,NX)) - XFRN=XFRC*ZPOOL(NBZ(NBL),NZ,NY,NX)/CPOOL(NBZ(NBL),NZ,NY,NX) - XFRP=XFRC*PPOOL(NBZ(NBL),NZ,NY,NX)/CPOOL(NBZ(NBL),NZ,NY,NX) - ELSE - XFRC=0.0 - XFRN=1.0E-02*ZPOOL(NBZ(NBL),NZ,NY,NX) - XFRP=1.0E-02*PPOOL(NBZ(NBL),NZ,NY,NX) - ENDIF - CPOOL(NBZ(NBL),NZ,NY,NX)=CPOOL(NBZ(NBL),NZ,NY,NX)-XFRC - ZPOOL(NBZ(NBL),NZ,NY,NX)=ZPOOL(NBZ(NBL),NZ,NY,NX)-XFRN - PPOOL(NBZ(NBL),NZ,NY,NX)=PPOOL(NBZ(NBL),NZ,NY,NX)-XFRP - CPOOL(NB1(NZ,NY,NX),NZ,NY,NX)=CPOOL(NB1(NZ,NY,NX),NZ,NY,NX) - 2+XFRC*SNCF - ZPOOL(NB1(NZ,NY,NX),NZ,NY,NX)=ZPOOL(NB1(NZ,NY,NX),NZ,NY,NX) - 2+XFRN - PPOOL(NB1(NZ,NY,NX),NZ,NY,NX)=PPOOL(NB1(NZ,NY,NX),NZ,NY,NX) - 2+XFRP - SNCX=SNCX-XFRC - IF(SNCX.LE.0.0)GO TO 595 - ENDIF - ENDIF -580 CONTINUE - ENDIF -C -C REMOBILIZATION AND LITTERFALL WHEN GROWTH RESPIRATION < 0 -C STARTING FROM LOWEST LEAFED NODE AND PROCEEDING UPWARDS -C -C IF(NZ.EQ.2.OR.NZ.EQ.3)THEN -C WRITE(*,1266)'SNCX1',I,J,NX,NY,NZ,NB,SNCY,SNCR,SNCX,SNCF -C 2,CPOOL(NB,NZ,NY,NX),WTLSB(NB,NZ,NY,NX),RCCC -C ENDIF - DO 575 N=1,KSNC - SNCT=SNCX/XKSNC - DO 650 KK=KN,KVSTG(NB,NZ,NY,NX) - SNCLF=0.0 - SNCSH=0.0 - K=MOD(KK,25) - IF(K.EQ.0.AND.KK.NE.0)K=25 -C -C REMOBILIZATION OF LEAF C,N,P DEPENDS ON NON-STRUCTURAL C:N:P -C - IF(WGLF(K,NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - FNCLF=WGLF(K,NB,NZ,NY,NX)/(WGLF(K,NB,NZ,NY,NX) - 2+WGSHE(K,NB,NZ,NY,NX)) - SNCLF=FNCLF*SNCT - SNCSH=SNCT-SNCLF - RCCL=RCCC*WGLF(K,NB,NZ,NY,NX) - RCZL=WGLFN(K,NB,NZ,NY,NX)*(RCCN+(1.0-RCCN)*RCCC) - RCPL=WGLFP(K,NB,NZ,NY,NX)*(RCCP+(1.0-RCCP)*RCCC) -C -C FRACTION OF CURRENT LEAF TO BE REMOBILIZED -C - IF(RCCL.GT.ZEROP(NZ,NY,NX))THEN - FSNCL=AMAX1(0.0,AMIN1(1.0,SNCLF/RCCL)) - ELSE - FSNCL=1.0 - ENDIF - FSNAL=FSNCL -C -C NON-REMOBILIZABLE C,N,P BECOMES LITTERFALL ALLOCATED -C TO FRACTIONS SET IN 'STARTQ' -C -C IF(NZ.EQ.1)THEN -C WRITE(*,4898)'SNCT1',I,J,NX,NY,NZ,NB,K,N -C 2,KN,KVSTG(NB,NZ,NY,NX),SNCLF,SNCT -C 2,FSNCL,RCCL,WTLFB(NB,NZ,NY,NX),ARLFB(NB,NZ,NY,NX) -C 2,WGLFN(K,NB,NZ,NY,NX),WGLFLN(1,K,NB,NZ,NY,NX) -C 3,ARLF(K,NB,NZ,NY,NX) -4898 FORMAT(A8,10I4,12E16.8) -C ENDIF - DO 6310 M=1,4 - CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX)+CFOPC(5,M,NZ,NY,NX) - 2*FSNCL*(WGLF(K,NB,NZ,NY,NX)-RCCL)*FWODB(0) - ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX)+CFOPN(5,M,NZ,NY,NX) - 2*FSNCL*(WGLFN(K,NB,NZ,NY,NX)-RCZL)*FWODLN(0) - PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX)+CFOPP(5,M,NZ,NY,NX) - 2*FSNCL*(WGLFP(K,NB,NZ,NY,NX)-RCPL)*FWODLP(0) - CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX)+CFOPC(1,M,NZ,NY,NX) - 2*FSNCL*(WGLF(K,NB,NZ,NY,NX)-RCCL)*FWODB(1) - ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX)+CFOPN(1,M,NZ,NY,NX) - 2*FSNCL*(WGLFN(K,NB,NZ,NY,NX)-RCZL)*FWODLN(1) - PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX)+CFOPP(1,M,NZ,NY,NX) - 2*FSNCL*(WGLFP(K,NB,NZ,NY,NX)-RCPL)*FWODLP(1) -6310 CONTINUE - IF(K.NE.0)THEN - CSNC(2,1,0,NZ,NY,NX)=CSNC(2,1,0,NZ,NY,NX) - 2+FSNCL*(CPOOL3(K,NB,NZ,NY,NX)+CPOOL4(K,NB,NZ,NY,NX)) - CPOOL3(K,NB,NZ,NY,NX)=CPOOL3(K,NB,NZ,NY,NX) - 2-FSNCL*CPOOL3(K,NB,NZ,NY,NX) - CPOOL4(K,NB,NZ,NY,NX)=CPOOL4(K,NB,NZ,NY,NX) - 2-FSNCL*CPOOL4(K,NB,NZ,NY,NX) - ENDIF -C -C UPDATE STATE VARIABLES FOR REMOBILIZATION AND LITTERFALL -C - ARLFB(NB,NZ,NY,NX)=AMAX1(0.0,ARLFB(NB,NZ,NY,NX) - 2-FSNAL*ARLF(K,NB,NZ,NY,NX)) - WTLFB(NB,NZ,NY,NX)=AMAX1(0.0,WTLFB(NB,NZ,NY,NX) - 2-FSNCL*WGLF(K,NB,NZ,NY,NX)) - WTLFBN(NB,NZ,NY,NX)=AMAX1(0.0,WTLFBN(NB,NZ,NY,NX) - 2-FSNCL*WGLFN(K,NB,NZ,NY,NX)) - WTLFBP(NB,NZ,NY,NX)=AMAX1(0.0,WTLFBP(NB,NZ,NY,NX) - 2-FSNCL*WGLFP(K,NB,NZ,NY,NX)) - ARLF(K,NB,NZ,NY,NX)=ARLF(K,NB,NZ,NY,NX) - 2-FSNAL*ARLF(K,NB,NZ,NY,NX) - WGLF(K,NB,NZ,NY,NX)=WGLF(K,NB,NZ,NY,NX) - 2-FSNCL*WGLF(K,NB,NZ,NY,NX) - WGLFN(K,NB,NZ,NY,NX)=WGLFN(K,NB,NZ,NY,NX) - 2-FSNCL*WGLFN(K,NB,NZ,NY,NX) - WGLFP(K,NB,NZ,NY,NX)=WGLFP(K,NB,NZ,NY,NX) - 2-FSNCL*WGLFP(K,NB,NZ,NY,NX) - WSLF(K,NB,NZ,NY,NX)=AMAX1(0.0,WSLF(K,NB,NZ,NY,NX) - 2-FSNCL*AMAX1(WGLFN(K,NB,NZ,NY,NX)*CNWS(NZ,NY,NX) - 3,WGLFP(K,NB,NZ,NY,NX)*CPWS(NZ,NY,NX))) -C -C FRACTION OF C REMOBILIZED FOR GROWTH RESPIRATION < 0 IS -C RESPIRED AND NOT TRANSFERRED TO NON-STRUCTURAL POOLS -C - CPOOL(NB,NZ,NY,NX)=CPOOL(NB,NZ,NY,NX)+FSNCL*RCCL*SNCF - ZPOOL(NB,NZ,NY,NX)=ZPOOL(NB,NZ,NY,NX)+FSNCL*RCZL - PPOOL(NB,NZ,NY,NX)=PPOOL(NB,NZ,NY,NX)+FSNCL*RCPL - SNCLF=SNCLF-FSNCL*RCCL - SNCT=SNCT-FSNCL*RCCL - IF(WTLFB(NB,NZ,NY,NX).LT.ZEROL(NZ,NY,NX))THEN - WTLFB(NB,NZ,NY,NX)=0.0 - ARLFB(NB,NZ,NY,NX)=0.0 - ENDIF -C -C EXIT LOOP IF REMOBILIZATION REQUIREMENT HAS BEEN MET -C - IF(SNCLF.LE.ZEROP(NZ,NY,NX))GO TO 564 -C -C OTHERWISE REMAINING C,N,P IN LEAF GOES TO LITTERFALL -C - ELSE -C IF(NZ.EQ.1)THEN -C WRITE(*,4899)'SNCT2',I,J,NX,NY,NZ,NB,K,N,SNCLF,SNCT -C 2,FSNCL,RCCL,WTLFB(NB,NZ,NY,NX),ARLFB(NB,NZ,NY,NX) -C 2,WGLFN(K,NB,NZ,NY,NX),WGLFLN(1,K,NB,NZ,NY,NX) -C 3,ARLF(K,NB,NZ,NY,NX) -4899 FORMAT(A8,8I4,12E16.8) -C ENDIF - DO 6315 M=1,4 - CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX)+CFOPC(5,M,NZ,NY,NX) - 2*WGLF(K,NB,NZ,NY,NX)*FWODB(0) - ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX)+CFOPN(5,M,NZ,NY,NX) - 2*WGLFN(K,NB,NZ,NY,NX)*FWODLN(0) - PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX)+CFOPP(5,M,NZ,NY,NX) - 2*WGLFP(K,NB,NZ,NY,NX)*FWODLP(0) - CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX)+CFOPC(1,M,NZ,NY,NX) - 2*WGLF(K,NB,NZ,NY,NX)*FWODB(1) - ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX)+CFOPN(1,M,NZ,NY,NX) - 2*WGLFN(K,NB,NZ,NY,NX)*FWODLN(1) - PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX)+CFOPP(1,M,NZ,NY,NX) - 2*WGLFP(K,NB,NZ,NY,NX)*FWODLP(1) -6315 CONTINUE - IF(K.NE.0)THEN - CSNC(2,1,0,NZ,NY,NX)=CSNC(2,1,0,NZ,NY,NX) - 2+CPOOL3(K,NB,NZ,NY,NX)+CPOOL4(K,NB,NZ,NY,NX) - CPOOL3(K,NB,NZ,NY,NX)=0.0 - CPOOL4(K,NB,NZ,NY,NX)=0.0 - ENDIF - ARLFB(NB,NZ,NY,NX)=AMAX1(0.0,ARLFB(NB,NZ,NY,NX) - 2-ARLF(K,NB,NZ,NY,NX)) - WTLFB(NB,NZ,NY,NX)=AMAX1(0.0,WTLFB(NB,NZ,NY,NX) - 2-WGLF(K,NB,NZ,NY,NX)) - WTLFBN(NB,NZ,NY,NX)=AMAX1(0.0,WTLFBN(NB,NZ,NY,NX) - 2-WGLFN(K,NB,NZ,NY,NX)) - WTLFBP(NB,NZ,NY,NX)=AMAX1(0.0,WTLFBP(NB,NZ,NY,NX) - 2-WGLFP(K,NB,NZ,NY,NX)) - ARLF(K,NB,NZ,NY,NX)=0.0 - WGLF(K,NB,NZ,NY,NX)=0.0 - WGLFN(K,NB,NZ,NY,NX)=0.0 - WGLFP(K,NB,NZ,NY,NX)=0.0 - WSLF(K,NB,NZ,NY,NX)=0.0 - IF(WTLFB(NB,NZ,NY,NX).LT.ZEROL(NZ,NY,NX))THEN - WTLFB(NB,NZ,NY,NX)=0.0 - ARLFB(NB,NZ,NY,NX)=0.0 - ENDIF - ENDIF -C -C REMOBILIZATION OF SHEATHS OR PETIOLE C,N,P DEPENDS ON -C NON-STRUCTURAL C:N:P -C -564 CONTINUE - IF(WGSHE(K,NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - RCCS=RCCC*WGSHE(K,NB,NZ,NY,NX) - RCZS=WGSHN(K,NB,NZ,NY,NX)*(RCCN+(1.0-RCCN)*RCCC) - RCPS=WGSHP(K,NB,NZ,NY,NX)*(RCCP+(1.0-RCCP)*RCCC) -C -C FRACTION OF REMOBILIZATION THAT CAN BE MET FROM CURRENT SHEATH -C OR PETIOLE -C - IF(RCCS.GT.ZEROP(NZ,NY,NX))THEN - FSNCS=AMAX1(0.0,AMIN1(1.0,SNCSH/RCCS)) - ELSE - FSNCS=1.0 - ENDIF - FSNAS=1.0*FSNCS -C -C NON-REMOBILIZABLE C,N,P BECOMES LITTERFALL ALLOCATED -C TO FRACTIONS SET IN 'STARTQ' -C - DO 6320 M=1,4 - CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX)+CFOPC(5,M,NZ,NY,NX) - 2*FSNCS*(WGSHE(K,NB,NZ,NY,NX)-RCCS)*FWODB(0) - ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX)+CFOPN(5,M,NZ,NY,NX) - 2*FSNCS*(WGSHN(K,NB,NZ,NY,NX)-RCZS)*FWODSN(0) - PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX)+CFOPP(5,M,NZ,NY,NX) - 2*FSNCS*(WGSHP(K,NB,NZ,NY,NX)-RCPS)*FWODSP(0) - CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX)+CFOPC(2,M,NZ,NY,NX) - 2*FSNCS*(WGSHE(K,NB,NZ,NY,NX)-RCCS)*FWODB(1) - ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX)+CFOPN(2,M,NZ,NY,NX) - 2*FSNCS*(WGSHN(K,NB,NZ,NY,NX)-RCZS)*FWODSN(1) - PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX)+CFOPP(2,M,NZ,NY,NX) - 2*FSNCS*(WGSHP(K,NB,NZ,NY,NX)-RCPS)*FWODSP(1) -6320 CONTINUE -C -C UPDATE STATE VARIABLES FOR REMOBILIZATION AND LITTERFALL -C - WTSHEB(NB,NZ,NY,NX)=AMAX1(0.0,WTSHEB(NB,NZ,NY,NX) - 2-FSNCS*WGSHE(K,NB,NZ,NY,NX)) - WTSHBN(NB,NZ,NY,NX)=AMAX1(0.0,WTSHBN(NB,NZ,NY,NX) - 2-FSNCS*WGSHN(K,NB,NZ,NY,NX)) - WTSHBP(NB,NZ,NY,NX)=AMAX1(0.0,WTSHBP(NB,NZ,NY,NX) - 2-FSNCS*WGSHP(K,NB,NZ,NY,NX)) - HTSHE(K,NB,NZ,NY,NX)=HTSHE(K,NB,NZ,NY,NX) - 2-FSNAS*HTSHE(K,NB,NZ,NY,NX) - WGSHE(K,NB,NZ,NY,NX)=WGSHE(K,NB,NZ,NY,NX) - 2-FSNCS*WGSHE(K,NB,NZ,NY,NX) - WGSHN(K,NB,NZ,NY,NX)=WGSHN(K,NB,NZ,NY,NX) - 2-FSNCS*WGSHN(K,NB,NZ,NY,NX) - WGSHP(K,NB,NZ,NY,NX)=WGSHP(K,NB,NZ,NY,NX) - 2-FSNCS*WGSHP(K,NB,NZ,NY,NX) - WSSHE(K,NB,NZ,NY,NX)=AMAX1(0.0,WSSHE(K,NB,NZ,NY,NX) - 2-FSNCS*AMAX1(WGSHN(K,NB,NZ,NY,NX)*CNWS(NZ,NY,NX) - 3,WGSHP(K,NB,NZ,NY,NX)*CPWS(NZ,NY,NX))) -C -C FRACTION OF C REMOBILIZED FOR GROWTH RESPIRATION < 0 IS -C RESPIRED AND NOT TRANSFERRED TO NON-STRUCTURAL POOLS -C - CPOOL(NB,NZ,NY,NX)=CPOOL(NB,NZ,NY,NX)+FSNCS*RCCS*SNCF - ZPOOL(NB,NZ,NY,NX)=ZPOOL(NB,NZ,NY,NX)+FSNCS*RCZS - PPOOL(NB,NZ,NY,NX)=PPOOL(NB,NZ,NY,NX)+FSNCS*RCPS - SNCSH=SNCSH-FSNCS*RCCS - SNCT=SNCT-FSNCS*RCCS - IF(WTSHEB(NB,NZ,NY,NX).LT.ZEROL(NZ,NY,NX))THEN - WTSHEB(NB,NZ,NY,NX)=0.0 - ENDIF -C -C EXIT LOOP IF REMOBILIZATION REQUIREMENT HAS BEEN MET -C - IF(SNCSH.LE.ZEROP(NZ,NY,NX))GO TO 565 -C -C OTHERWISE REMAINING C,N,P IN SHEATH OR PETIOLE GOES TO LITTERFALL -C - ELSE - DO 6325 M=1,4 - CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX)+CFOPC(5,M,NZ,NY,NX) - 2*WGSHE(K,NB,NZ,NY,NX)*FWODB(0) - ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX)+CFOPN(5,M,NZ,NY,NX) - 2*WGSHN(K,NB,NZ,NY,NX)*FWODSN(0) - PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX)+CFOPP(5,M,NZ,NY,NX) - 2*WGSHP(K,NB,NZ,NY,NX)*FWODSP(0) - CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX)+CFOPC(2,M,NZ,NY,NX) - 2*WGSHE(K,NB,NZ,NY,NX)*FWODB(1) - ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX)+CFOPN(2,M,NZ,NY,NX) - 2*WGSHN(K,NB,NZ,NY,NX)*FWODSN(1) - PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX)+CFOPP(2,M,NZ,NY,NX) - 2*WGSHP(K,NB,NZ,NY,NX)*FWODSP(1) -6325 CONTINUE - WTSHEB(NB,NZ,NY,NX)=AMAX1(0.0,WTSHEB(NB,NZ,NY,NX) - 2-WGSHE(K,NB,NZ,NY,NX)) - WTSHBN(NB,NZ,NY,NX)=AMAX1(0.0,WTSHBN(NB,NZ,NY,NX) - 2-WGSHN(K,NB,NZ,NY,NX)) - WTSHBP(NB,NZ,NY,NX)=AMAX1(0.0,WTSHBP(NB,NZ,NY,NX) - 2-WGSHP(K,NB,NZ,NY,NX)) - HTSHE(K,NB,NZ,NY,NX)=0.0 - WGSHE(K,NB,NZ,NY,NX)=0.0 - WGSHN(K,NB,NZ,NY,NX)=0.0 - WGSHP(K,NB,NZ,NY,NX)=0.0 - WSSHE(K,NB,NZ,NY,NX)=0.0 - IF(WTSHEB(NB,NZ,NY,NX).LT.ZEROL(NZ,NY,NX))THEN - WTSHEB(NB,NZ,NY,NX)=0.0 - ENDIF - ENDIF -650 CONTINUE - KN=KN+1 - SNCR=SNCT*(1.0-SNCF) -C -C REMOBILIZATION OF RESERVE C -C - IF(WTRSVB(NB,NZ,NY,NX).GT.SNCR)THEN - WTRSVB(NB,NZ,NY,NX)=WTRSVB(NB,NZ,NY,NX)-SNCR - SNCR=0.0 - GO TO 565 - ENDIF -C -C REMOBILIZATION OF STALK C,N,P -C - SNCZ=FXFS*SNCR - SNCT=SNCR+SNCZ - IF(ISTYP(NZ,NY,NX).NE.0.AND.SNCT.GT.ZEROP(NZ,NY,NX) - 2.AND.WTSTKB(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - SNCF=SNCZ/SNCT - FRCC=WVSTKB(NB,NZ,NY,NX)/WTSTKB(NB,NZ,NY,NX) - RCSC=RCCC*FRCC - RCSN=RCCN*FRCC - RCSP=RCCP*FRCC - MXNOD=KVSTG(NB,NZ,NY,NX) - MNNOD=MAX(MIN(0,MAX(0,MXNOD-NNOD(NZ,NY,NX))) - 2,KVSTG(NB,NZ,NY,NX)-23) - MXNOD=MAX(MXNOD,MNNOD) - DO 1650 KK=MXNOD,MNNOD,-1 - K=MOD(KK,25) - IF(K.EQ.0.AND.KK.NE.0)K=25 -C IF(NZ.EQ.1.OR.NZ.EQ.4)THEN -C WRITE(*,2356)'WGNODE1',I,J,NZ,NB,K,KK,MXNOD,MNNOD -C 2,KSNC,RCCC,FRCC,RCSC,SNCT,WGNODE(K,NB,NZ,NY,NX) -C 3,HTNODX(K,NB,NZ,NY,NX),WTSTKB(NB,NZ,NY,NX) -C 4,CPOOL(NB,NZ,NY,NX) -C ENDIF -C -C REMOBILIZATION OF STALK C,N,P DEPENDS ON NON-STRUCTURAL C:N:P -C - IF(WGNODE(K,NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - RCCK=RCSC*WGNODE(K,NB,NZ,NY,NX) - RCZK=WGNODN(K,NB,NZ,NY,NX)*(RCSN+(1.0-RCSN)*RCSC) - RCPK=WGNODP(K,NB,NZ,NY,NX)*(RCSP+(1.0-RCSP)*RCSC) -C -C FRACTION OF CURRENT NODE TO BE REMOBILIZED -C - IF(RCCK.GT.ZEROP(NZ,NY,NX))THEN - FSNCK=AMAX1(0.0,AMIN1(1.0,SNCT/RCCK)) - ELSE - FSNCK=1.0 - ENDIF -C -C NON-REMOBILIZABLE C,N,P BECOMES LITTERFALL ALLOCATED -C TO FRACTIONS SET IN 'STARTQ' -C - DO 7310 M=1,4 - CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX)+CFOPC(3,M,NZ,NY,NX) - 2*FSNCK*(WGNODE(K,NB,NZ,NY,NX)-RCCK) - ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX)+CFOPN(3,M,NZ,NY,NX) - 2*FSNCK*(WGNODN(K,NB,NZ,NY,NX)-RCZK) - PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX)+CFOPP(3,M,NZ,NY,NX) - 2*FSNCK*(WGNODP(K,NB,NZ,NY,NX)-RCPK) -7310 CONTINUE -C -C UPDATE STATE VARIABLES FOR REMOBILIZATION AND LITTERFALL -C - WTSTKB(NB,NZ,NY,NX)=AMAX1(0.0,WTSTKB(NB,NZ,NY,NX) - 2-FSNCK*WGNODE(K,NB,NZ,NY,NX)) - WTSTBN(NB,NZ,NY,NX)=AMAX1(0.0,WTSTBN(NB,NZ,NY,NX) - 2-FSNCK*WGNODN(K,NB,NZ,NY,NX)) - WTSTBP(NB,NZ,NY,NX)=AMAX1(0.0,WTSTBP(NB,NZ,NY,NX) - 2-FSNCK*WGNODP(K,NB,NZ,NY,NX)) - HTNODE(K,NB,NZ,NY,NX)=HTNODE(K,NB,NZ,NY,NX) - 2-FSNCK*HTNODX(K,NB,NZ,NY,NX) - WGNODE(K,NB,NZ,NY,NX)=WGNODE(K,NB,NZ,NY,NX) - 2-FSNCK*WGNODE(K,NB,NZ,NY,NX) - WGNODN(K,NB,NZ,NY,NX)=WGNODN(K,NB,NZ,NY,NX) - 2-FSNCK*WGNODN(K,NB,NZ,NY,NX) - WGNODP(K,NB,NZ,NY,NX)=WGNODP(K,NB,NZ,NY,NX) - 2-FSNCK*WGNODP(K,NB,NZ,NY,NX) - HTNODX(K,NB,NZ,NY,NX)=HTNODX(K,NB,NZ,NY,NX) - 2-FSNCK*HTNODX(K,NB,NZ,NY,NX) -C -C FRACTION OF C REMOBILIZED FOR GROWTH RESPIRATION < 0 IS -C RESPIRED AND NOT TRANSFERRED TO NON-STRUCTURAL POOLS -C - WTRSVB(NB,NZ,NY,NX)=WTRSVB(NB,NZ,NY,NX)+FSNCK*RCCK*SNCF - WTRSBN(NB,NZ,NY,NX)=WTRSBN(NB,NZ,NY,NX)+FSNCK*RCZK - WTRSBP(NB,NZ,NY,NX)=WTRSBP(NB,NZ,NY,NX)+FSNCK*RCPK - SNCT=SNCT-FSNCK*RCCK -C IF(NZ.EQ.1.OR.NZ.EQ.4)THEN -C WRITE(*,2356)'WGNODE2',I,J,NZ,NB,K,KK,MXNOD,MNNOD -C 2,KSNC,RCCC,FRCC,RCSC,SNCT,WGNODE(K,NB,NZ,NY,NX) -C 3,HTNODX(K,NB,NZ,NY,NX),WTSTKB(NB,NZ,NY,NX) -C 4,CPOOL(NB,NZ,NY,NX) -2356 FORMAT(A8,9I4,12E16.8) -C ENDIF -C -C EXIT LOOP IF REMOBILIZATION REQUIREMENT HAS BEEN MET -C - IF(SNCT.LE.ZEROP(NZ,NY,NX))GO TO 565 -C -C OTHERWISE REMAINING C,N,P IN NODE GOES TO LITTERFALL -C - ELSE - DO 7315 M=1,4 - CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX)+CFOPC(3,M,NZ,NY,NX) - 2*WGNODE(K,NB,NZ,NY,NX) - ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX)+CFOPN(3,M,NZ,NY,NX) - 2*WGNODN(K,NB,NZ,NY,NX) - PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX)+CFOPP(3,M,NZ,NY,NX) - 2*WGNODP(K,NB,NZ,NY,NX) -7315 CONTINUE - WTSTKB(NB,NZ,NY,NX)=AMAX1(0.0,WTSTKB(NB,NZ,NY,NX) - 2-WGNODE(K,NB,NZ,NY,NX)) - WTSTBN(NB,NZ,NY,NX)=AMAX1(0.0,WTSTBN(NB,NZ,NY,NX) - 2-WGNODN(K,NB,NZ,NY,NX)) - WTSTBP(NB,NZ,NY,NX)=AMAX1(0.0,WTSTBP(NB,NZ,NY,NX) - 2-WGNODP(K,NB,NZ,NY,NX)) - HTNODE(K,NB,NZ,NY,NX)=HTNODE(K,NB,NZ,NY,NX) - 2-HTNODX(K,NB,NZ,NY,NX) - WGNODE(K,NB,NZ,NY,NX)=0.0 - WGNODN(K,NB,NZ,NY,NX)=0.0 - WGNODP(K,NB,NZ,NY,NX)=0.0 - HTNODX(K,NB,NZ,NY,NX)=0.0 - ENDIF -1650 CONTINUE -C -C RESIDUAL STALK -C - IF(WTSTXB(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - RCCK=RCSC*WTSTXB(NB,NZ,NY,NX) - RCZK=WTSTXN(NB,NZ,NY,NX)*(RCSN+(1.0-RCSN)*RCSC) - RCPK=WTSTXP(NB,NZ,NY,NX)*(RCSP+(1.0-RCSP)*RCSC) -C -C FRACTION OF RESIDUAL STALK TO BE REMOBILIZED -C - IF(RCCK.GT.ZEROP(NZ,NY,NX))THEN - FSNCR=AMAX1(0.0,AMIN1(1.0,SNCT/RCCK)) - ELSE - FSNCR=1.0 - ENDIF -C -C NON-REMOBILIZABLE C,N,P BECOMES LITTERFALL ALLOCATED -C TO FRACTIONS SET IN 'STARTQ' -C - DO 8310 M=1,4 - CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX)+CFOPC(3,M,NZ,NY,NX) - 2*FSNCR*(WTSTXB(NB,NZ,NY,NX)-RCCK) - ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX)+CFOPN(3,M,NZ,NY,NX) - 2*FSNCR*(WTSTXN(NB,NZ,NY,NX)-RCZK) - PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX)+CFOPP(3,M,NZ,NY,NX) - 2*FSNCR*(WTSTXP(NB,NZ,NY,NX)-RCPK) -8310 CONTINUE -C -C UPDATE STATE VARIABLES FOR REMOBILIZATION AND LITTERFALL -C - WTSTKB(NB,NZ,NY,NX)=AMAX1(0.0,WTSTKB(NB,NZ,NY,NX) - 2-FSNCR*WTSTXB(NB,NZ,NY,NX)) - WTSTBN(NB,NZ,NY,NX)=AMAX1(0.0,WTSTBN(NB,NZ,NY,NX) - 2-FSNCR*WTSTXN(NB,NZ,NY,NX)) - WTSTBP(NB,NZ,NY,NX)=AMAX1(0.0,WTSTBP(NB,NZ,NY,NX) - 2-FSNCR*WTSTXP(NB,NZ,NY,NX)) - WTSTXB(NB,NZ,NY,NX)=AMAX1(0.0,WTSTXB(NB,NZ,NY,NX) - 2-FSNCR*WTSTXB(NB,NZ,NY,NX)) - WTSTXN(NB,NZ,NY,NX)=AMAX1(0.0,WTSTXN(NB,NZ,NY,NX) - 2-FSNCR*WTSTXN(NB,NZ,NY,NX)) - WTSTXP(NB,NZ,NY,NX)=AMAX1(0.0,WTSTXP(NB,NZ,NY,NX) - 2-FSNCR*WTSTXP(NB,NZ,NY,NX)) - HTNODZ=0.0 - DO 8320 K=0,25 - HTNODZ=AMAX1(HTNODZ,HTNODE(K,NB,NZ,NY,NX)) -8320 CONTINUE - HTNODZ=AMAX1(0.0,HTNODZ-FSNCR*HTNODZ) - DO 8325 K=0,25 - HTNODE(K,NB,NZ,NY,NX)=AMIN1(HTNODZ,HTNODE(K,NB,NZ,NY,NX)) -8325 CONTINUE -C -C FRACTION OF C REMOBILIZED FOR GROWTH RESPIRATION < 0 IS -C RESPIRED AND NOT TRANSFERRED TO NON-STRUCTURAL POOLS -C - WTRSVB(NB,NZ,NY,NX)=WTRSVB(NB,NZ,NY,NX)+FSNCR*RCCK*SNCF - WTRSBN(NB,NZ,NY,NX)=WTRSBN(NB,NZ,NY,NX)+FSNCR*RCZK - WTRSBP(NB,NZ,NY,NX)=WTRSBP(NB,NZ,NY,NX)+FSNCR*RCPK - SNCT=SNCT-FSNCR*RCCK - ENDIF -C IF(NZ.EQ.1.OR.NZ.EQ.4)THEN -C WRITE(*,2357)'WTSTXB1',I,J,NZ,NB,K,FSNCR,SNCT -C 3,WTSTKB(NB,NZ,NY,NX),WTSTXB(NB,NZ,NY,NX) -C 4,(HTNODE(K,NB,NZ,NY,NX),K=0,25) -2357 FORMAT(A8,5I4,40E12.4) -C ENDIF -C -C EXIT LOOP IF REMOBILIZATION REQUIREMENT HAS BEEN MET -C - IF(SNCT.LE.ZEROP(NZ,NY,NX))GO TO 565 -C -C OTHERWISE REMAINING C,N,P IN NODE GOES TO LITTERFALL -C - ELSE - DO 8315 M=1,4 - CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX)+CFOPC(3,M,NZ,NY,NX) - 2*WTSTXB(NB,NZ,NY,NX) - ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX)+CFOPN(3,M,NZ,NY,NX) - 2*WTSTXN(NB,NZ,NY,NX) - PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX)+CFOPP(3,M,NZ,NY,NX) - 2*WTSTXP(NB,NZ,NY,NX) -8315 CONTINUE - WTSTKB(NB,NZ,NY,NX)=AMAX1(0.0,WTSTKB(NB,NZ,NY,NX) - 2-WTSTXB(NB,NZ,NY,NX)) - WTSTBN(NB,NZ,NY,NX)=AMAX1(0.0,WTSTBN(NB,NZ,NY,NX) - 2-WTSTXN(NB,NZ,NY,NX)) - WTSTBP(NB,NZ,NY,NX)=AMAX1(0.0,WTSTBP(NB,NZ,NY,NX) - 2-WTSTXP(NB,NZ,NY,NX)) - WTSTXB(NB,NZ,NY,NX)=0.0 - WTSTXN(NB,NZ,NY,NX)=0.0 - WTSTXP(NB,NZ,NY,NX)=0.0 - MXNOD=KVSTG(NB,NZ,NY,NX) - MNNOD=MAX(MIN(0,MAX(0,MXNOD-NNOD(NZ,NY,NX))) - 2,KVSTG(NB,NZ,NY,NX)-23) - MXNOD=MAX(MXNOD,MNNOD) - DO 1660 KK=MXNOD,MNNOD,-1 - K=MOD(KK,25) - IF(K.EQ.0.AND.KK.NE.0)K=25 - HTNODE(K,NB,NZ,NY,NX)=0.0 - HTNODX(K,NB,NZ,NY,NX)=0.0 -1660 CONTINUE -C IF(NZ.EQ.2)THEN -C WRITE(*,2357)'WTSTXB2',I,J,NZ,NB,FSNCR,SNCT -C 3,HTNODX(K,NB,NZ,NY,NX),WTSTKB(NB,NZ,NY,NX) -C 4,WTSTXB(NB,NZ,NY,NX),WTSTBN(NB,NZ,NY,NX),WTSTBP(NB,NZ,NY,NX) -C ENDIF - ENDIF -C -C REMOBILIZATION OF STORAGE C,N,P -C - SNCR=SNCT/(1.0+FXFS) - IF(WTRVC(NZ,NY,NX).GT.SNCR)THEN - WTRVC(NZ,NY,NX)=WTRVC(NZ,NY,NX)-SNCR - SNCR=0.0 - GO TO 565 - ELSE - IDTHB(NB,NZ,NY,NX)=1 - ENDIF -565 CONTINUE -575 CONTINUE - ENDIF -595 CONTINUE -C -C DEATH IF MAIN STALK OF TREE DIES -C - IF(IBTYP(NZ,NY,NX).NE.0.AND.IGTYP(NZ,NY,NX).GT.1 - 2.AND.IDTHB(NB1(NZ,NY,NX),NZ,NY,NX).EQ.1)IDTHB(NB,NZ,NY,NX)=1 -C -C REMOBILIZE EXCESS LEAF STRUCTURAL N,P -C - KVSTGX=MAX(0,KVSTG(NB,NZ,NY,NX)-24) - DO 495 KK=KVSTGX,KVSTG(NB,NZ,NY,NX) - K=MOD(KK,25) - IF(K.EQ.0.AND.KK.NE.0)K=25 - IF(WGLF(K,NB,NZ,NY,NX).GT.0.0)THEN - CPOOLT=WGLF(K,NB,NZ,NY,NX)+CPOOL(NB,NZ,NY,NX) - IF(CPOOLT.GT.ZEROP(NZ,NY,NX))THEN - ZPOOLD=WGLFN(K,NB,NZ,NY,NX)*CPOOL(NB,NZ,NY,NX) - 2-ZPOOL(NB,NZ,NY,NX)*WGLF(K,NB,NZ,NY,NX) - XFRN1=AMAX1(0.0,AMIN1(1.0E-03*ZPOOLD/CPOOLT,WGLFN(K,NB,NZ,NY,NX) - 2-ZPLFM*CNLFB*WGLF(K,NB,NZ,NY,NX))) - PPOOLD=WGLFP(K,NB,NZ,NY,NX)*CPOOL(NB,NZ,NY,NX) - 2-PPOOL(NB,NZ,NY,NX)*WGLF(K,NB,NZ,NY,NX) - XFRP1=AMAX1(0.0,AMIN1(1.0E-03*PPOOLD/CPOOLT,WGLFP(K,NB,NZ,NY,NX) - 2-ZPLFM*CPLFB*WGLF(K,NB,NZ,NY,NX))) - XFRN=AMAX1(XFRN1,10.0*XFRP1) - XFRP=AMAX1(XFRP1,0.10*XFRN1) - WGLFN(K,NB,NZ,NY,NX)=WGLFN(K,NB,NZ,NY,NX)-XFRN - WTLFBN(NB,NZ,NY,NX)=WTLFBN(NB,NZ,NY,NX)-XFRN - ZPOOL(NB,NZ,NY,NX)=ZPOOL(NB,NZ,NY,NX)+XFRN - WGLFP(K,NB,NZ,NY,NX)=WGLFP(K,NB,NZ,NY,NX)-XFRP - WTLFBP(NB,NZ,NY,NX)=WTLFBP(NB,NZ,NY,NX)-XFRP - PPOOL(NB,NZ,NY,NX)=PPOOL(NB,NZ,NY,NX)+XFRP - WSLF(K,NB,NZ,NY,NX)=AMAX1(0.0,WSLF(K,NB,NZ,NY,NX) - 2-AMAX1(XFRN*CNWS(NZ,NY,NX),XFRP*CPWS(NZ,NY,NX))) - ENDIF - ENDIF -495 CONTINUE -C -C ALLOCATION OF LEAF AREA TO CANOPY LAYERS -C - KVSTGN(NB,NZ,NY,NX)=0 - IF(HTCTL(NZ,NY,NX).LE.SDPTH(NZ,NY,NX) - 2.AND.ARLF(0,NB1(NZ,NY,NX),NZ,NY,NX).GT.0.0)THEN - XLGLF=SQRT(1.0E+02*ARLF(0,NB1(NZ,NY,NX),NZ,NY,NX) - 2/PP(NZ,NY,NX)) - HTCTL(NZ,NY,NX)=XLGLF+HTSHE(0,NB1(NZ,NY,NX),NZ,NY,NX) - 2+HTNODE(0,NB1(NZ,NY,NX),NZ,NY,NX) - ENDIF -C -C IF CANOPY HAS EMERGED -C - IF(HTCTL(NZ,NY,NX).GT.SDPTH(NZ,NY,NX))THEN - DO 540 K=0,25 - DO 540 L=1,JC - ARLFL(L,K,NB,NZ,NY,NX)=0.0 - WGLFL(L,K,NB,NZ,NY,NX)=0.0 - WGLFLN(L,K,NB,NZ,NY,NX)=0.0 - WGLFLP(L,K,NB,NZ,NY,NX)=0.0 -540 CONTINUE - DO 535 L=1,JC - ARSTK(L,NB,NZ,NY,NX)=0.0 -535 CONTINUE -C -C BRANCH HEIGHT -C - IF(IBTYP(NZ,NY,NX).NE.0.AND.IGTYP(NZ,NY,NX).GT.1)THEN - IF(NB.NE.NB1(NZ,NY,NX))THEN - KVSTG1=MAX(1,KVSTG(NB1(NZ,NY,NX),NZ,NY,NX)-24) - IF(NBTB(NB,NZ,NY,NX).GE.KVSTG1)THEN - K=MOD(NBTB(NB,NZ,NY,NX),25) - IF(K.EQ.0.AND.KK.NE.0)K=25 - HTBR=HTNODE(K,NB1(NZ,NY,NX),NZ,NY,NX) - ELSE - HTBR=0.0 - ENDIF - ELSE - HTBR=0.0 - ENDIF - ELSE - HTBR=0.0 - ENDIF - KVSTGX=MAX(0,KVSTG(NB,NZ,NY,NX)-24) -C -C FOR ALL LEAFED NODES -C - DO 560 KK=KVSTGX,KVSTG(NB,NZ,NY,NX) - K=MOD(KK,25) - IF(K.EQ.0.AND.KK.NE.0)K=25 -C -C HEIGHT OF STALK INTERNODE + SHEATH OR PETIOLE -C AND LENGTH OF LEAF -C - HTSTK=HTBR+HTNODE(K,NB,NZ,NY,NX) - HTLF=HTSTK+HTSHE(K,NB,NZ,NY,NX) - XLGLF=AMAX1(0.0,SQRT(WDLF(NZ,NY,NX)*AMAX1(0.0 - 2,ARLF(K,NB,NZ,NY,NX))/(PP(NZ,NY,NX)*FNOD(NZ,NY,NX)))) - TLGLF=0.0 -C -C ALLOCATE FRACTIONS OF LEAF IN EACH INCLINATION CLASS -C FROM HIGHEST TO LOWEST TO CANOPY LAYER -C - DO 555 N=4,1,-1 - YLGLF=ZSIN(N)*CLASS(N,NZ,NY,NX)*XLGLF - HTLFL=AMIN1(ZCX(NZ,NY,NX)+0.01-YLGLF,HTLF+TLGLF) - HTLFU=AMIN1(ZCX(NZ,NY,NX)+0.01,HTLFL+YLGLF) - LU=0 - LL=0 - DO 550 L=JC,1,-1 - IF(LU.EQ.1.AND.LL.EQ.1)GO TO 551 - IF((HTLFU.GT.ZL(L-1,NY,NX).OR.ZL(L-1,NY,NX).LT.ZERO) - 2.AND.LU.EQ.0)THEN - LHTLFU=MAX(1,L) - LU=1 - ENDIF - IF((HTLFL.GT.ZL(L-1,NY,NX).OR.ZL(L-1,NY,NX).LT.ZERO) - 2.AND.LL.EQ.0)THEN - LHTLFL=MAX(1,L) - LL=1 - ENDIF -550 CONTINUE -551 CONTINUE - DO 570 L=LHTLFL,LHTLFU - IF(LHTLFU.EQ.LHTLFL)THEN - FRACL=CLASS(N,NZ,NY,NX) - ELSEIF(HTLFU.GT.HTLFL.AND.ZL(L,NY,NX).GT.HTLFL)THEN - FRACL=CLASS(N,NZ,NY,NX)*(AMIN1(HTLFU,ZL(L,NY,NX)) - 2-AMAX1(HTLFL,ZL(L-1,NY,NX)))/(HTLFU-HTLFL) - ELSE - FRACL=CLASS(N,NZ,NY,NX) - ENDIF - YARLF=FRACL*ARLF(K,NB,NZ,NY,NX) - YWGLF=FRACL*WGLF(K,NB,NZ,NY,NX) - YWGLFN=FRACL*WGLFN(K,NB,NZ,NY,NX) - YWGLFP=FRACL*WGLFP(K,NB,NZ,NY,NX) -C -C ACCUMULATE LAYER LEAF AREAS, C, N AND P CONTENTS -C - ARLFL(L,K,NB,NZ,NY,NX)=ARLFL(L,K,NB,NZ,NY,NX)+YARLF - WGLFL(L,K,NB,NZ,NY,NX)=WGLFL(L,K,NB,NZ,NY,NX)+YWGLF - WGLFLN(L,K,NB,NZ,NY,NX)=WGLFLN(L,K,NB,NZ,NY,NX)+YWGLFN - WGLFLP(L,K,NB,NZ,NY,NX)=WGLFLP(L,K,NB,NZ,NY,NX)+YWGLFP - ARLFV(L,NZ,NY,NX)=ARLFV(L,NZ,NY,NX)+YARLF - WGLFV(L,NZ,NY,NX)=WGLFV(L,NZ,NY,NX)+YWGLF -C IF(J.EQ.12)THEN -C WRITE(*,4813)'GRO',I,J,NZ,NB,K,KK,L,LHTLFL,LHTLFU -C 2,FRACL,HTLFU,HTLFL,ZL(L-1,NY,NX),ARLFB(NB,NZ,NY,NX) -C 3,ARLF(K,NB,NZ,NY,NX),WTLFB(NB,NZ,NY,NX),WGLF(K,NB,NZ,NY,NX) -C 4,ARLFP(NZ,NY,NX),ZL(L,NY,NX),HTLF,TLGLF,HTSTK,HTBR -C 4,HTNODE(K,NB,NZ,NY,NX),HTSHE(K,NB,NZ,NY,NX),YLGLF -C 5,ZSIN(N),CLASS(N,NZ,NY,NX),XLGLF,ZC(NZ,NY,NX) -C 6,ZCX(NZ,NY,NX) -4813 FORMAT(A8,9I4,30E12.4) -C ENDIF -570 CONTINUE - TLGLF=TLGLF+YLGLF - ZC(NZ,NY,NX)=AMAX1(ZC(NZ,NY,NX),HTLFU) -555 CONTINUE - IF(WSSHE(K,NB,NZ,NY,NX).GT.0.0)THEN - IF(KVSTGN(NB,NZ,NY,NX).EQ.0)KVSTGN(NB,NZ,NY,NX) - 2=MIN(KK,KVSTG(NB,NZ,NY,NX)) - ENDIF -560 CONTINUE - IF(KVSTGN(NB,NZ,NY,NX).EQ.0)KVSTGN(NB,NZ,NY,NX) - 2=KVSTG(NB,NZ,NY,NX) - K1=MOD(KVSTG(NB,NZ,NY,NX),25) - IF(K1.EQ.0.AND.KVSTG(NB,NZ,NY,NX).NE.0)K1=25 - K2=MOD(KVSTG(NB,NZ,NY,NX)-1,25) - IF(K2.EQ.0.AND.KVSTG(NB,NZ,NY,NX)-1.NE.0)K2=25 - IF(HTNODE(K1,NB,NZ,NY,NX).EQ.0.0)THEN - HTNODE(K1,NB,NZ,NY,NX)=HTNODE(K2,NB,NZ,NY,NX) - ENDIF - HTLFB=HTBR - 2+AMAX1(0.0,HTNODE(K1,NB,NZ,NY,NX)) -C -C ALLOCATE STALK SURFACE AREA TO CANOPY LAYERS -C -C IF(NZ.EQ.1)THEN -C WRITE(*,6679)'K1',I,J,NZ,NB,K1,KVSTG(NB,NZ,NY,NX) -C 2,HTNODE(K1,NB,NZ,NY,NX) -6679 FORMAT(A8,6I4,12E12.4) -C ENDIF - IF(HTNODE(K1,NB,NZ,NY,NX).GT.0.0)THEN - LU=0 - LL=0 - DO 545 L=JC,1,-1 - IF(LU.EQ.1.AND.LL.EQ.1)GO TO 546 - IF((HTLFB.GT.ZL(L-1,NY,NX).OR.ZL(L-1,NY,NX).LT.ZERO) - 2.AND.LU.EQ.0)THEN - LHTBRU=MAX(1,L) - LU=1 - ENDIF - IF((HTBR.GT.ZL(L-1,NY,NX).OR.ZL(L-1,NY,NX) - 2.LT.ZERO).AND.LL.EQ.0)THEN - LHTBRL=MAX(1,L) - LL=1 - ENDIF -545 CONTINUE -546 CONTINUE - RSTK=SQRT(VSTK*(AMAX1(0.0,WTSTKB(NB,NZ,NY,NX))/PP(NZ,NY,NX)) - 3/(3.1416*HTNODE(K1,NB,NZ,NY,NX))) - ARSTKB(NB)=3.1416*HTNODE(K1,NB,NZ,NY,NX)*PP(NZ,NY,NX)*RSTK - IF(ISTYP(NZ,NY,NX).EQ.0)THEN - WVSTKB(NB,NZ,NY,NX)=WTSTKB(NB,NZ,NY,NX) - ELSE - ZSTK=AMIN1(ZSTX,FSTK*RSTK) - ASTV=3.1416*(2.0*RSTK*ZSTK-ZSTK**2) - WVSTKB(NB,NZ,NY,NX)=ASTV/VSTK*HTNODE(K1,NB,NZ,NY,NX)*PP(NZ,NY,NX) - ENDIF -C IF(NZ.EQ.1)THEN -C WRITE(*,6677)'WVSTK',I,J,NZ,NB,WVSTKB(NB,NZ,NY,NX) -C 2,ASTV,VSTK,HTNODE(K1,NB,NZ,NY,NX),PP(NZ,NY,NX) -6677 FORMAT(A8,4I4,12E12.4) -C ENDIF - DO 445 L=LHTBRL,LHTBRU - IF(HTLFB.GT.HTBR)THEN - IF(HTLFB.GT.ZL(L-1,NY,NX))THEN - FRACL=(AMIN1(HTLFB,ZL(L,NY,NX))-AMAX1(HTBR - 2,ZL(L-1,NY,NX)))/(HTLFB-HTBR) - ELSE - FRACL=0.0 - ENDIF - ELSE - FRACL=1.0 - ENDIF - ARSTK(L,NB,NZ,NY,NX)=FRACL*ARSTKB(NB) -445 CONTINUE - ELSE - WVSTKB(NB,NZ,NY,NX)=0.0 - DO 450 L=1,JC - ARSTK(L,NB,NZ,NY,NX)=0.0 -450 CONTINUE - ENDIF - ELSE - WVSTKB(NB,NZ,NY,NX)=0.0 - DO 455 L=1,JC - ARSTK(L,NB,NZ,NY,NX)=0.0 -455 CONTINUE - ENDIF -C -C ALLOCATE LEAF AREA TO INCLINATION CLASSES ACCORDING TO -C DISTRIBUTION ENTERED IN 'READQ' ASSUMING AZIMUTH IS UNIFORM -C - IF(SSINN(NY,NX).GT.0.0)THEN - DO 900 K=1,25 - DO 900 L=1,JC - DO 900 N=1,4 - SURF(N,L,K,NB,NZ,NY,NX)=0.0 -900 CONTINUE -C ARLFXB=0.0 -C ARLFXL=0.0 -C SURFXX=0.0 - DO 500 K=1,25 -C ARLFXB=ARLFXB+ARLF(K,NB,NZ,NY,NX) - IF(ARLF(K,NB,NZ,NY,NX).GT.0.0 - 2.AND.ZC(NZ,NY,NX).GT.DPTHS(NY,NX))THEN - DO 700 L=JC,1,-1 -C ARLFXL=ARLFXL+ARLFL(L,K,NB,NZ,NY,NX) - DO 800 N=1,4 - SURF(N,L,K,NB,NZ,NY,NX)=AMAX1(0.0,CLASS(N,NZ,NY,NX) - 2*0.25*ARLFL(L,K,NB,NZ,NY,NX)) -C SURFXX=SURFXX+SURF(N,L,K,NB,NZ,NY,NX) -C IF(I.EQ.151.AND.(NZ.EQ.1.OR.NZ.EQ.4))THEN -C WRITE(*,6363)'SURF',I,J,NX,NY,NZ,NB,K,L,N -C 2,ARLFL(L,K,NB,NZ,NY,NX) -C 2,SURF(N,L,K,NB,NZ,NY,NX),CLASS(N,NZ,NY,NX),ARLF(K,NB,NZ,NY,NX) -C 3,DPTHS(NY,NX),ARLFXB,ARLFXL,SURFXX,ARLF(0,NB,NZ,NY,NX) -C 4,ARLFB(NB,NZ,NY,NX) -6363 FORMAT(A8,9I4,12E16.8) -C ENDIF -800 CONTINUE -700 CONTINUE - ENDIF -500 CONTINUE -C -C ALLOCATE STALK AREA TO INCLINATION CLASSES ACCORDING TO -C BRANCH ANGLE ENTERED IN 'READQ' ASSUMING AZIMUTH IS UNIFORM -C - DO 910 L=1,JC - DO 910 N=1,4 - SURFB(N,L,NB,NZ,NY,NX)=0.0 -910 CONTINUE - IF(NB.EQ.NB1(NZ,NY,NX))THEN - N=4 - ELSE - N=MIN(4,INT(ASIN(ANGBR(NZ,NY,NX))/0.3927)+1) - ENDIF - DO 710 L=JC,1,-1 - SURFB(N,L,NB,NZ,NY,NX)=0.25*ARSTK(L,NB,NZ,NY,NX) -710 CONTINUE - ENDIF -C -C SET MAXIMUM GRAIN NUMBER FROM SHOOT MASS BEFORE ANTHESIS -C - IF(IDAY(3,NB,NZ,NY,NX).NE.0.AND.IDAY(6,NB,NZ,NY,NX).EQ.0)THEN - GRNXB(NB,NZ,NY,NX)=GRNXB(NB,NZ,NY,NX) - 2+STMX(NZ,NY,NX)*AMAX1(0.0,GROSTK) -C WRITE(*,4246)'GRNX',I,J,NZ,NB,IDAY(3,NB,NZ,NY,NX) -C 2,GRNXB(NB,NZ,NY,NX),STMX(NZ,NY,NX),CGROS,GROSTK - ENDIF -C -C SET FINAL GRAIN NUMBER AND MAXIMUM GRAIN SIZE FROM C,N,P -C NON-STRUCTURAL POOLS AFTER ANTHESIS -C - IF(IDAY(6,NB,NZ,NY,NX).NE.0.AND.IDAY(9,NB,NZ,NY,NX).EQ.0)THEN - SET=AMIN1(CCPOLB(NB,NZ,NY,NX)/(CCPOLB(NB,NZ,NY,NX)+SETC) - 2,CZPOLB(NB,NZ,NY,NX)/(CZPOLB(NB,NZ,NY,NX)+SETN) - 3,CPPOLB(NB,NZ,NY,NX)/(CPPOLB(NB,NZ,NY,NX)+SETP)) - IF(TCC(NZ,NY,NX).LT.CTC(NZ,NY,NX))THEN - IF(IDAY(7,NB,NZ,NY,NX).EQ.0)THEN - FGRNX=0.002*(CTC(NZ,NY,NX)-TCC(NZ,NY,NX)) - ELSEIF(IDAY(8,NB,NZ,NY,NX).EQ.0)THEN - FGRNX=0.002*(CTC(NZ,NY,NX)-TCC(NZ,NY,NX)) - ELSE - FGRNX=0.0 - ENDIF - ELSEIF(TCC(NZ,NY,NX).GT.HTC(NZ,NY,NX))THEN - IF(IDAY(7,NB,NZ,NY,NX).EQ.0)THEN - FGRNX=0.002*(TCC(NZ,NY,NX)-HTC(NZ,NY,NX)) - ELSEIF(IDAY(8,NB,NZ,NY,NX).EQ.0)THEN - FGRNX=0.002*(TCC(NZ,NY,NX)-HTC(NZ,NY,NX)) - ELSE - FGRNX=0.0 - ENDIF - ELSE - FGRNX=0.0 - ENDIF - IF(IDAY(6,NB,NZ,NY,NX).NE.0.AND.IDAY(8,NB,NZ,NY,NX).EQ.0)THEN -C GRNXB(NB,NZ,NY,NX)=GRNXB(NB,NZ,NY,NX)*FGRNX - GRNOB(NB,NZ,NY,NX)=AMIN1(SDMX(NZ,NY,NX)*GRNXB(NB,NZ,NY,NX) - 2,GRNOB(NB,NZ,NY,NX)+SDMX(NZ,NY,NX)*GRNXB(NB,NZ,NY,NX) - 3*SET*DGSTGF(NB,NZ,NY,NX)-FGRNX*GRNOB(NB,NZ,NY,NX)) -C IF(FGRNX.LT.1.0)THEN -C WRITE(*,4246)'GRNO',I,J,NZ,NB,IDAY(7,NB,NZ,NY,NX),TCC(NZ,NY,NX) -C 2,HTC(NZ,NY,NX),FGRNX,GRNXB(NB,NZ,NY,NX),GRNOB(NB,NZ,NY,NX) -C 3,SET,CCPOLB(NB,NZ,NY,NX),CZPOLB(NB,NZ,NY,NX) -C 4,CPPOLB(NB,NZ,NY,NX) -4246 FORMAT(A8,5I4,20E12.4) -C ENDIF - ENDIF - IF(IDAY(7,NB,NZ,NY,NX).NE.0.AND.IDAY(9,NB,NZ,NY,NX).EQ.0)THEN - GRMXB=GRMX(NZ,NY,NX)*SQRT(1.0-FGRNX) - GRWTB(NB,NZ,NY,NX)=AMIN1(GRMX(NZ,NY,NX),GRWTB(NB,NZ,NY,NX) - 2+GRMXB*AMAX1(0.50,SQRT(SET))*DGSTGF(NB,NZ,NY,NX)) -C IF(FGRNX.LT.1.0)THEN -C WRITE(*,4246)'GRWT',I,J,NZ,NB,IDAY(8,NB,NZ,NY,NX),TCC(NZ,NY,NX) -C 2,HTC(NZ,NY,NX),FGRNX,GRMX(NZ,NY,NX),GRWTB(NB,NZ,NY,NX) -C ENDIF - ENDIF - ENDIF -C -C GRAIN FILL BY TRANSLOCATION FROM STALK RESERVES -C UNTIL GRAIN SINK (=FINAL GRAIN NUMBER X MAXIMUM -C GRAIN SIZE) IS FILLED OR RESERVES ARE EXHAUSTED -C - IF(IDAY(7,NB,NZ,NY,NX).NE.0)THEN - IF(WTGRB(NB,NZ,NY,NX).GE.GRWTB(NB,NZ,NY,NX) - 2*GRNOB(NB,NZ,NY,NX))THEN - GROLM=0.0 - ELSEIF(IRTYP(NZ,NY,NX).EQ.0)THEN - GROLM=AMAX1(0.0,GFILL(NZ,NY,NX)*GRNOB(NB,NZ,NY,NX) - 2*SQRT(TFN3(NZ,NY,NX))) - ELSE - GROLM=AMAX1(0.0,GFILL(NZ,NY,NX)*GRNOB(NB,NZ,NY,NX) - 2*SQRT(TFN4(NG(NZ,NY,NX),NZ,NY,NX))) - ENDIF -C -C GRAIN FILL RATE MAY BE CONSTRAINED BY HIGH GRAIN C:N OR C:P -C - IF(WTGRBN(NB,NZ,NY,NX).LT.ZPGRM*CNGR(NZ,NY,NX) - 2*WTGRB(NB,NZ,NY,NX).OR.WTGRBP(NB,NZ,NY,NX).LT.ZPGRM - 3*CPGR(NZ,NY,NX)*WTGRB(NB,NZ,NY,NX))THEN - GROLC=0.0 - ELSE - GROLC=GROLM - ENDIF - XLOCM=AMIN1(GROLM,WTRSVB(NB,NZ,NY,NX)) - XLOCC=AMIN1(GROLC,WTRSVB(NB,NZ,NY,NX)) -C -C GRAIN N OR P FILL RATE MAY BE LIMITED BY C:N OR C:P RATIOS -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) - 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)) - XLOCN=AMIN1(XLOCM*CNGR(NZ,NY,NX) - 2,AMAX1(0.0,WTRSBN(NB,NZ,NY,NX)*ZPGRX) - 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) - 3,(WTGRB(NB,NZ,NY,NX)+XLOCC)*CPGR(NZ,NY,NX)-WTGRBP(NB,NZ,NY,NX)) - ELSE - XLOCN=0.0 - XLOCP=0.0 - ENDIF -C IF(NX.EQ.1.AND.NY.EQ.6.AND.NZ.EQ.3)THEN -C WRITE(*,85)'XLOC',I,J,NZ,NB,WTGRB(NB,NZ,NY,NX),WTGRBN(NB,NZ,NY,NX) -C 2,WTRSVB(NB,NZ,NY,NX),WTRSBN(NB,NZ,NY,NX),XLOCC,XLOCN,XLOCP,XLOCM -C 3,CNGR(NZ,NY,NX),ZPGRX,ZNPG,GROLC,GROLM,GROGR,GROGRN -C 3,XLOCM*CNGR(NZ,NY,NX),AMAX1(0.0,WTRSBN(NB,NZ,NY,NX)*ZPGRX) -C 4,(WTGRB(NB,NZ,NY,NX)+XLOCC)*CNGR(NZ,NY,NX)-WTGRBN(NB,NZ,NY,NX) -C 4,GRNOB(NB,NZ,NY,NX),GRWTB(NB,NZ,NY,NX),GFILL(NZ,NY,NX) -C 5,SQRT(TFN3(NZ,NY,NX)),FLG4(NB,NZ,NY,NX) -85 FORMAT(A8,4I4,20E12.4) -C ENDIF -C -C TRANSLOCATE C,N,P FROM STALK RESERVES TO GRAIN -C - WTRSVB(NB,NZ,NY,NX)=WTRSVB(NB,NZ,NY,NX)+GROGR-XLOCC - WTRSBN(NB,NZ,NY,NX)=WTRSBN(NB,NZ,NY,NX)+GROGRN-XLOCN - WTRSBP(NB,NZ,NY,NX)=WTRSBP(NB,NZ,NY,NX)+GROGRP-XLOCP - WTGRB(NB,NZ,NY,NX)=WTGRB(NB,NZ,NY,NX)+XLOCC - WTGRBN(NB,NZ,NY,NX)=WTGRBN(NB,NZ,NY,NX)+XLOCN - WTGRBP(NB,NZ,NY,NX)=WTGRBP(NB,NZ,NY,NX)+XLOCP - ELSE - XLOCC=0.0 - XLOCN=0.0 - XLOCP=0.0 - ENDIF -C -C SET DATE OF PHYSIOLOGICAL MATURITY WHEN GRAIN FILL -C HAS STOPPED FOR SET PERIOD OF TIME -C - IF(IDAY(8,NB,NZ,NY,NX).NE.0)THEN - IF(XLOCC.LE.1.0E-09*PP(NZ,NY,NX))THEN - FLG4(NB,NZ,NY,NX)=FLG4(NB,NZ,NY,NX)+1.0 - ELSE - FLG4(NB,NZ,NY,NX)=0.0 - ENDIF - IF(FLG4(NB,NZ,NY,NX).GE.FLG4X)THEN - IF(IDAY(10,NB,NZ,NY,NX).EQ.0)THEN - IDAY(10,NB,NZ,NY,NX)=I - ENDIF - ENDIF -C -C TERMINATE ANNUALS AFTER GRAIN FILL -C - IF(ISTYP(NZ,NY,NX).EQ.0.AND.IWTYP(NZ,NY,NX).NE.0)THEN - IF(FLG4(NB,NZ,NY,NX).GT.FLG4Y(IWTYP(NZ,NY,NX)))THEN - VRNF(NB,NZ,NY,NX)=VRNX(NB,NZ,NY,NX)+0.5 - ENDIF - ENDIF - ENDIF -C -C RESET PHENOLOGY AT EMERGENCE ('VRNS' > 'VRNL') -C AND END OF SEASON ('VRNF' > 'VRNX') -C - IF(ISTYP(NZ,NY,NX).NE.0 - 2.OR.(ISTYP(NZ,NY,NX).EQ.0.AND.IWTYP(NZ,NY,NX).NE.0))THEN - IF((IFLGE(NB,NZ,NY,NX).EQ.0 - 2.AND.VRNS(NB,NZ,NY,NX).GE.VRNL(NB,NZ,NY,NX)) - 3.OR.(IFLGF(NB,NZ,NY,NX).EQ.0 - 4.AND.VRNF(NB,NZ,NY,NX).GE.VRNX(NB,NZ,NY,NX)))THEN -C -C SPRING PHENOLOGY RESET -C - IF((IFLGE(NB,NZ,NY,NX).EQ.0.AND.ISTYP(NZ,NY,NX).NE.0) - 2.AND.(VRNS(NB,NZ,NY,NX).GE.VRNL(NB,NZ,NY,NX)))THEN - IF(ISTYP(NZ,NY,NX).EQ.0)THEN - GROUP(NB,NZ,NY,NX)=AMAX1(0.0,GROUPI(NZ,NY,NX) - 2-NBTB(NB,NZ,NY,NX)) - ELSE - GROUP(NB,NZ,NY,NX)=GROUPI(NZ,NY,NX) - ENDIF - PSTGI(NB,NZ,NY,NX)=PSTG(NB,NZ,NY,NX) - PSTGF(NB,NZ,NY,NX)=0.0 - VSTGX(NB,NZ,NY,NX)=0.0 - TGSTGI(NB,NZ,NY,NX)=0.0 - TGSTGF(NB,NZ,NY,NX)=0.0 - IDAY(1,NB,NZ,NY,NX)=I - DO 2005 M=2,10 - IDAY(M,NB,NZ,NY,NX)=0 -2005 CONTINUE - IF(NB.EQ.NB1(NZ,NY,NX))THEN - WSTR(NZ,NY,NX)=0.0 - ENDIF -C -C SPRING LEAF AND SHEATH RESET -C - IF(IFLGE(NB,NZ,NY,NX).EQ.0.AND.ISTYP(NZ,NY,NX).NE.0 - 2.AND.VRNS(NB,NZ,NY,NX).GE.VRNL(NB,NZ,NY,NX))THEN - IF(IBTYP(NZ,NY,NX).EQ.0)THEN - PSTG(NB,NZ,NY,NX)=XTLI(NZ,NY,NX) - VSTG(NB,NZ,NY,NX)=0.0 - KLEAF(NB,NZ,NY,NX)=1 - KVSTG(NB,NZ,NY,NX)=1 - FLG4(NB,NZ,NY,NX)=0.0 - DO 5330 M=1,4 - CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX) - 2+CFOPC(5,M,NZ,NY,NX)*WTLFB(NB,NZ,NY,NX)*FWODB(0) - 3+CFOPC(5,M,NZ,NY,NX)*WTSHEB(NB,NZ,NY,NX)*FWODB(0) - ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX) - 2+CFOPN(5,M,NZ,NY,NX)*WTLFBN(NB,NZ,NY,NX)*FWODLN(0) - 3+CFOPN(5,M,NZ,NY,NX)*WTSHBN(NB,NZ,NY,NX)*FWODSN(0) - PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX) - 2+CFOPP(5,M,NZ,NY,NX)*WTLFBP(NB,NZ,NY,NX)*FWODLP(0) - 3+CFOPP(5,M,NZ,NY,NX)*WTSHBP(NB,NZ,NY,NX)*FWODSP(0) - CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) - 2+CFOPC(1,M,NZ,NY,NX)*WTLFB(NB,NZ,NY,NX)*FWODB(1) - 3+CFOPC(2,M,NZ,NY,NX)*WTSHEB(NB,NZ,NY,NX)*FWODB(1) - ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) - 2+CFOPN(1,M,NZ,NY,NX)*WTLFBN(NB,NZ,NY,NX)*FWODLN(1) - 3+CFOPN(2,M,NZ,NY,NX)*WTSHBN(NB,NZ,NY,NX)*FWODSN(1) - PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) - 2+CFOPP(1,M,NZ,NY,NX)*WTLFBP(NB,NZ,NY,NX)*FWODLP(1) - 3+CFOPP(2,M,NZ,NY,NX)*WTSHBP(NB,NZ,NY,NX)*FWODSP(1) -5330 CONTINUE - ARLFB(NB,NZ,NY,NX)=0.0 - WTLFB(NB,NZ,NY,NX)=0.0 - WTLFBN(NB,NZ,NY,NX)=0.0 - WTLFBP(NB,NZ,NY,NX)=0.0 - WTSHEB(NB,NZ,NY,NX)=0.0 - WTSHBN(NB,NZ,NY,NX)=0.0 - WTSHBP(NB,NZ,NY,NX)=0.0 - DO 5335 K=0,25 - ARLF(K,NB,NZ,NY,NX)=0.0 - HTSHE(K,NB,NZ,NY,NX)=0.0 - WGLF(K,NB,NZ,NY,NX)=0.0 - WSLF(K,NB,NZ,NY,NX)=0.0 - WGLFN(K,NB,NZ,NY,NX)=0.0 - WGLFP(K,NB,NZ,NY,NX)=0.0 - WGSHE(K,NB,NZ,NY,NX)=0.0 - WSSHE(K,NB,NZ,NY,NX)=0.0 - WGSHN(K,NB,NZ,NY,NX)=0.0 - WGSHP(K,NB,NZ,NY,NX)=0.0 -5335 CONTINUE - ENDIF - ENDIF -C -C RESIDUAL STALKS BECOME LITTERFALL IN GRASSES, SHRUBS AT -C START OF SEASON -C - IF((IFLGE(NB,NZ,NY,NX).EQ.0.AND.ISTYP(NZ,NY,NX).NE.0) - 2.AND.VRNS(NB,NZ,NY,NX).GE.VRNL(NB,NZ,NY,NX))THEN - DO 6245 M=1,4 - CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX)+CFOPC(2,M,NZ,NY,NX) - 2*(WTHSKB(NB,NZ,NY,NX)+WTEARB(NB,NZ,NY,NX)+WTGRB(NB,NZ,NY,NX)) - ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX)+CFOPN(2,M,NZ,NY,NX) - 2*(WTHSBN(NB,NZ,NY,NX)+WTEABN(NB,NZ,NY,NX)+WTGRBN(NB,NZ,NY,NX)) - PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX)+CFOPP(2,M,NZ,NY,NX) - 2*(WTHSBP(NB,NZ,NY,NX)+WTEABP(NB,NZ,NY,NX)+WTGRBP(NB,NZ,NY,NX)) -6245 CONTINUE - WTHSKB(NB,NZ,NY,NX)=0.0 - WTEARB(NB,NZ,NY,NX)=0.0 - WTGRB(NB,NZ,NY,NX)=0.0 - WTHSBN(NB,NZ,NY,NX)=0.0 - WTEABN(NB,NZ,NY,NX)=0.0 - WTGRBN(NB,NZ,NY,NX)=0.0 - WTHSBP(NB,NZ,NY,NX)=0.0 - WTEABP(NB,NZ,NY,NX)=0.0 - WTGRBP(NB,NZ,NY,NX)=0.0 - GRNXB(NB,NZ,NY,NX)=0.0 - GRNOB(NB,NZ,NY,NX)=0.0 - GRWTB(NB,NZ,NY,NX)=0.0 - IF(IBTYP(NZ,NY,NX).EQ.0.OR.IGTYP(NZ,NY,NX).LE.1)THEN - DO 6345 M=1,4 - CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX)+CFOPC(3,M,NZ,NY,NX) - 2*WTSTKB(NB,NZ,NY,NX) - ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX)+CFOPN(3,M,NZ,NY,NX) - 2*WTSTBN(NB,NZ,NY,NX) - PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX)+CFOPP(3,M,NZ,NY,NX) - 2*WTSTBP(NB,NZ,NY,NX) -6345 CONTINUE - WTSTKB(NB,NZ,NY,NX)=0.0 - WTSTBN(NB,NZ,NY,NX)=0.0 - WTSTBP(NB,NZ,NY,NX)=0.0 - WTSTXB(NB,NZ,NY,NX)=0.0 - WTSTXN(NB,NZ,NY,NX)=0.0 - WTSTXP(NB,NZ,NY,NX)=0.0 - DO 6340 K=0,25 - HTNODE(K,NB,NZ,NY,NX)=0.0 - HTNODX(K,NB,NZ,NY,NX)=0.0 - WGNODE(K,NB,NZ,NY,NX)=0.0 - WGNODN(K,NB,NZ,NY,NX)=0.0 - WGNODP(K,NB,NZ,NY,NX)=0.0 -6340 CONTINUE - ENDIF - ENDIF - ENDIF -C -C SPRING OR FALL FLAG RESET -C - IF(IFLGE(NB,NZ,NY,NX).EQ.0 - 2.AND.VRNS(NB,NZ,NY,NX).GE.VRNL(NB,NZ,NY,NX))THEN - IFLGA(NB,NZ,NY,NX)=0 - IFLGE(NB,NZ,NY,NX)=1 - IFLGF(NB,NZ,NY,NX)=0 - IFLGR(NB,NZ,NY,NX)=0 - IFLGQ(NB,NZ,NY,NX)=0 - ELSE - IFLGE(NB,NZ,NY,NX)=0 - IFLGF(NB,NZ,NY,NX)=1 - IFLGR(NB,NZ,NY,NX)=1 - IFLGQ(NB,NZ,NY,NX)=0 - ENDIF - ENDIF - ENDIF -C -C REPRODUCTIVE MATERIAL BECOMES LITTERFALL AT END OF SEASON -C - IF(IFLGR(NB,NZ,NY,NX).EQ.1)THEN - IFLGQ(NB,NZ,NY,NX)=IFLGQ(NB,NZ,NY,NX)+1 - IF(IFLGQ(NB,NZ,NY,NX).EQ.IFLGQX)THEN - IFLGR(NB,NZ,NY,NX)=0 - IFLGQ(NB,NZ,NY,NX)=0 - ENDIF - DO 6330 M=1,4 - CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) - 2+FSNR*CFOPC(2,M,NZ,NY,NX) - 2*(WTHSKB(NB,NZ,NY,NX)+WTEARB(NB,NZ,NY,NX)) - ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) - 2+FSNR*CFOPN(2,M,NZ,NY,NX) - 2*(WTHSBN(NB,NZ,NY,NX)+WTEABN(NB,NZ,NY,NX)) - PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) - 2+FSNR*CFOPP(2,M,NZ,NY,NX) - 2*(WTHSBP(NB,NZ,NY,NX)+WTEABP(NB,NZ,NY,NX)) - IF(ISTYP(NZ,NY,NX).EQ.0.AND.IWTYP(NZ,NY,NX).NE.0)THEN - WTRVC(NZ,NY,NX)=WTRVC(NZ,NY,NX) - 2+FSNR*CFOPC(2,M,NZ,NY,NX)*WTGRB(NB,NZ,NY,NX) - WTRVN(NZ,NY,NX)=WTRVN(NZ,NY,NX) - 2+FSNR*CFOPN(2,M,NZ,NY,NX)*WTGRBN(NB,NZ,NY,NX) - WTRVP(NZ,NY,NX)=WTRVP(NZ,NY,NX) - 2+FSNR*CFOPP(2,M,NZ,NY,NX)*WTGRBP(NB,NZ,NY,NX) - ELSE - CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) - 2+FSNR*CFOPC(2,M,NZ,NY,NX)*WTGRB(NB,NZ,NY,NX) - ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) - 2+FSNR*CFOPN(2,M,NZ,NY,NX)*WTGRBN(NB,NZ,NY,NX) - PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) - 2+FSNR*CFOPP(2,M,NZ,NY,NX)*WTGRBP(NB,NZ,NY,NX) - ENDIF -6330 CONTINUE - WTHSKB(NB,NZ,NY,NX)=(1.0-FSNR)*WTHSKB(NB,NZ,NY,NX) - WTEARB(NB,NZ,NY,NX)=(1.0-FSNR)*WTEARB(NB,NZ,NY,NX) - WTGRB(NB,NZ,NY,NX)=(1.0-FSNR)*WTGRB(NB,NZ,NY,NX) - WTHSBN(NB,NZ,NY,NX)=(1.0-FSNR)*WTHSBN(NB,NZ,NY,NX) - WTEABN(NB,NZ,NY,NX)=(1.0-FSNR)*WTEABN(NB,NZ,NY,NX) - WTGRBN(NB,NZ,NY,NX)=(1.0-FSNR)*WTGRBN(NB,NZ,NY,NX) - WTHSBP(NB,NZ,NY,NX)=(1.0-FSNR)*WTHSBP(NB,NZ,NY,NX) - WTEABP(NB,NZ,NY,NX)=(1.0-FSNR)*WTEABP(NB,NZ,NY,NX) - WTGRBP(NB,NZ,NY,NX)=(1.0-FSNR)*WTGRBP(NB,NZ,NY,NX) - GRNXB(NB,NZ,NY,NX)=(1.0-FSNR)*GRNXB(NB,NZ,NY,NX) - GRNOB(NB,NZ,NY,NX)=(1.0-FSNR)*GRNOB(NB,NZ,NY,NX) - GRWTB(NB,NZ,NY,NX)=(1.0-FSNR)*GRWTB(NB,NZ,NY,NX) -C -C STALKS BECOME LITTERFALL IN GRASSES AT END OF SEASON -C - IF((IBTYP(NZ,NY,NX).EQ.0.OR.IGTYP(NZ,NY,NX).LE.1) - 2.AND.ISTYP(NZ,NY,NX).NE.0)THEN - DO 6335 M=1,4 - CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) - 2+FSNR*CFOPC(3,M,NZ,NY,NX)*WTSTKB(NB,NZ,NY,NX) - ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) - 2+FSNR*CFOPN(3,M,NZ,NY,NX)*WTSTBN(NB,NZ,NY,NX) - PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) - 2+FSNR*CFOPP(3,M,NZ,NY,NX)*WTSTBP(NB,NZ,NY,NX) -6335 CONTINUE - WTSTKB(NB,NZ,NY,NX)=(1.0-FSNR)*WTSTKB(NB,NZ,NY,NX) - WTSTBN(NB,NZ,NY,NX)=(1.0-FSNR)*WTSTBN(NB,NZ,NY,NX) - WTSTBP(NB,NZ,NY,NX)=(1.0-FSNR)*WTSTBP(NB,NZ,NY,NX) - WTSTXB(NB,NZ,NY,NX)=(1.0-FSNR)*WTSTXB(NB,NZ,NY,NX) - WTSTXN(NB,NZ,NY,NX)=(1.0-FSNR)*WTSTXN(NB,NZ,NY,NX) - WTSTXP(NB,NZ,NY,NX)=(1.0-FSNR)*WTSTXP(NB,NZ,NY,NX) - DO 2010 K=0,25 -C HTNODE(K,NB,NZ,NY,NX)=(1.0-FSNR)*HTNODE(K,NB,NZ,NY,NX) - HTNODX(K,NB,NZ,NY,NX)=(1.0-FSNR)*HTNODX(K,NB,NZ,NY,NX) - WGNODE(K,NB,NZ,NY,NX)=(1.0-FSNR)*WGNODE(K,NB,NZ,NY,NX) - WGNODN(K,NB,NZ,NY,NX)=(1.0-FSNR)*WGNODN(K,NB,NZ,NY,NX) - WGNODP(K,NB,NZ,NY,NX)=(1.0-FSNR)*WGNODP(K,NB,NZ,NY,NX) -2010 CONTINUE - ENDIF -C -C SELF-SEEDING ANNUALS IF COLD OR DROUGHT DECIDUOUS -C - IF(J.EQ.INT(ZNOON(NY,NX)))THEN - IF(NB.EQ.NB1(NZ,NY,NX))THEN - IF(ISTYP(NZ,NY,NX).EQ.0.AND.IWTYP(NZ,NY,NX).NE.0)THEN - IDAYH(NZ,NY,NX)=I - IYRH(NZ,NY,NX)=IYRC - IHVST(NZ,I,NY,NX)=1 - JHVST(NZ,I,NY,NX)=2 - HVST(NZ,I,NY,NX)=0.0 - THIN(NZ,I,NY,NX)=0.0 - EHVST(1,1,NZ,I,NY,NX)=1.0 - EHVST(1,2,NZ,I,NY,NX)=1.0 - EHVST(1,3,NZ,I,NY,NX)=1.0 - EHVST(1,4,NZ,I,NY,NX)=1.0 - EHVST(2,1,NZ,I,NY,NX)=0.0 - EHVST(2,2,NZ,I,NY,NX)=1.0 - EHVST(2,3,NZ,I,NY,NX)=0.0 - EHVST(2,4,NZ,I,NY,NX)=0.0 - IDAY0(NZ,NY,NX)=-1E+06 - IYR0(NZ,NY,NX)=-1E+06 - IFLGI(NZ,NY,NX)=1 -C WRITE(*,3366)'HVST',I,J,IYRC,IDAYH(NZ,NY,NX),IYRH(NZ,NY,NX) -C 2,IHVST(NZ,I,NY,NX),JHVST(NZ,I,NY,NX),IFLGI(NZ,NY,NX) -3366 FORMAT(A8,8I8) - ENDIF - ENDIF - ENDIF - ENDIF -C -C TRANSFER C,N,P FROM SEASONAL STORAGE TO SHOOT AND ROOT -C NON-STRUCTURAL C DURING SEED GERMINATION OR LEAFOUT -C -C IF(NZ.EQ.1)THEN -C WRITE(*,2322)'VRNS',I,J,NX,NY,NZ,NB,NB1(NZ,NY,NX),IFLGZ -C 2,ISTYP(NZ,NY,NX),IFLGI(NZ,NY,NX),IDAY0(NZ,NY,NX),IYR0(NZ,NY,NX) -C 3,VRNS(NB1(NZ,NY,NX),NZ,NY,NX),VRNL(NB,NZ,NY,NX) -C 3,VRNF(NB,NZ,NY,NX),VRNX(NB,NZ,NY,NX) -2322 FORMAT(A8,12I4,20E12.4) -C ENDIF - IF((ISTYP(NZ,NY,NX).EQ.0.AND.IFLGI(NZ,NY,NX).EQ.0) - 2.OR.(I.GE.IDAY0(NZ,NY,NX).AND.IYRC.EQ.IYR0(NZ,NY,NX)) - 2.OR.(VRNS(NB1(NZ,NY,NX),NZ,NY,NX).GE.VRNL(NB,NZ,NY,NX) - 3.AND.VRNF(NB,NZ,NY,NX).LT.FVRN*VRNX(NB,NZ,NY,NX)))THEN - WTRTM=0.0 - CPOOLM=0.0 - DO 4 L=NU(NY,NX),NI(NZ,NY,NX) - WTRTM=WTRTM+AMAX1(0.0,WTRTD(1,L,NZ,NY,NX)) - CPOOLM=CPOOLM+AMAX1(0.0,CPOOLR(1,L,NZ,NY,NX)) -4 CONTINUE -C -C RESET TIME COUNTER -C - IF(IFLGA(NB,NZ,NY,NX).EQ.0)THEN - ATRP(NB,NZ,NY,NX)=0.0 - IFLGA(NB,NZ,NY,NX)=1 - ENDIF -C -C INCREMENT TIME COUNTER -C - IF(NB.EQ.NB1(NZ,NY,NX))THEN - IF(IPTYP(NZ,NY,NX).EQ.2 - 2.AND.(IWTYP(NZ,NY,NX).EQ.1.OR.IWTYP(NZ,NY,NX).EQ.3))THEN - PPDX=AMAX1(0.0,XDL(NZ,NY,NX)-XPPD(NZ,NY,NX)-DYLN(NY,NX)) - ATRPPD=EXP(-0.0*PPDX) - ELSE - ATRPPD=1.0 - ENDIF - DATRP=ATRPPD*TFN3(NZ,NY,NX)*WFNSG/AMIN1(1.0,ZTYP(NZ,NY,NX)) - ATRP(NB,NZ,NY,NX)=ATRP(NB,NZ,NY,NX)+DATRP -C IF(NZ.EQ.1)THEN -C WRITE(*,2323)'ATRP',I,J,NX,NY,NZ,NB,ATRP(NB,NZ,NY,NX),DATRP -C 2,ATRPPD,TFN3(NZ,NY,NX),WFNSG,PPDX,XDL(NZ,NY,NX),XPPD(NZ,NY,NX) -C 3,DYLN(NY,NX),WTLFB(NB,NZ,NY,NX),ARLFB(NB,NZ,NY,NX),HTCTL(NZ,NY,NX) -2323 FORMAT(A8,6I4,20E12.4) -C ENDIF - IF(ATRP(NB,NZ,NY,NX).LE.ATRPX - 2.OR.(ISTYP(NZ,NY,NX).EQ.0.AND.IWTYP(NZ,NY,NX).EQ.0))THEN - IF(WTRVC(NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - CPOOLT=CPOOLM+CPOOL(NB,NZ,NY,NX) -C -C REMOBILIZE C FROM SEASONAL STORAGE AT FIRST-ORDER RATE -C MODIFIED BY SOIL TEMPERATURE AT SEED DEPTH -C - GFNX=VMXS(ISTYP(NZ,NY,NX))*DATRP - CH2OH=AMAX1(0.0,GFNX*WTRVC(NZ,NY,NX)) -C IF(NZ.EQ.1.OR.NZ.EQ.4)THEN -C WRITE(*,2123)'GERM0',I,J,NX,NY,NZ,NB,GFNX,CH2OH,WTRVC(NZ,NY,NX) -C 2,CPOOL(NB,NZ,NY,NX),CPOOLR(1,NG(NZ,NY,NX),NZ,NY,NX) -C 3,FXSH(ISTYP(NZ,NY,NX)),FXRT(ISTYP(NZ,NY,NX)) -2123 FORMAT(A8,6I4,20E12.4) -C ENDIF - WTRVC(NZ,NY,NX)=WTRVC(NZ,NY,NX)-CH2OH - CPOOL(NB,NZ,NY,NX)=CPOOL(NB,NZ,NY,NX) - 2+CH2OH*FXSH(ISTYP(NZ,NY,NX)) - IF(WTRTM.GT.ZEROP(NZ,NY,NX).AND.CPOOLM.GT.ZEROP(NZ,NY,NX))THEN - DO 50 L=NU(NY,NX),NI(NZ,NY,NX) - FXFC=AMAX1(0.0,WTRTD(1,L,NZ,NY,NX))/WTRTM - CPOOLR(1,L,NZ,NY,NX)=CPOOLR(1,L,NZ,NY,NX) - 2+FXFC*CH2OH*FXRT(ISTYP(NZ,NY,NX)) -50 CONTINUE - ELSE - CPOOLR(1,NG(NZ,NY,NX),NZ,NY,NX)=CPOOLR(1,NG(NZ,NY,NX),NZ,NY,NX) - 2+CH2OH*FXRT(ISTYP(NZ,NY,NX)) - ENDIF - ELSE - CH2OH=0.0 - ENDIF - ELSE - CH2OH=0.0 - ENDIF -C -C REMOBILIZE N,P FROM SEASONAL STORAGE AT FIRST-ORDER RATE -C MODIFIED BY SOIL TEMPERATURE AT SEED DEPTH -C - IF(WTRVC(NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - IF(ISTYP(NZ,NY,NX).NE.0)THEN - CPOOLT=AMAX1(0.0,WTRVC(NZ,NY,NX)+CPOOL(NB,NZ,NY,NX)) - ZPOOLD=(WTRVN(NZ,NY,NX)*CPOOL(NB,NZ,NY,NX) - 2-ZPOOL(NB,NZ,NY,NX)*WTRVC(NZ,NY,NX))/CPOOLT - PPOOLD=(WTRVP(NZ,NY,NX)*CPOOL(NB,NZ,NY,NX) - 2-PPOOL(NB,NZ,NY,NX)*WTRVC(NZ,NY,NX))/CPOOLT - UPNH4B=AMAX1(0.0,FRSV(IBTYP(NZ,NY,NX))*ZPOOLD) - UPPO4B=AMAX1(0.0,FRSV(IBTYP(NZ,NY,NX))*PPOOLD) - ELSE - UPNH4B=AMAX1(0.0,FXSH(ISTYP(NZ,NY,NX)) - 2*CH2OH*WTRVN(NZ,NY,NX)/WTRVC(NZ,NY,NX)) - UPPO4B=AMAX1(0.0,FXSH(ISTYP(NZ,NY,NX)) - 2*CH2OH*WTRVP(NZ,NY,NX)/WTRVC(NZ,NY,NX)) - ENDIF - ELSE - UPNH4B=AMAX1(0.0,FXSH(ISTYP(NZ,NY,NX))*WTRVN(NZ,NY,NX)) - UPPO4B=AMAX1(0.0,FXSH(ISTYP(NZ,NY,NX))*WTRVP(NZ,NY,NX)) - ENDIF -C -C ADD TO NON-STRUCTURAL POOLS IN ROOT -C - CPOOLM=0.0 - ZPOOLM=0.0 - PPOOLM=0.0 - DO 3 L=NU(NY,NX),NI(NZ,NY,NX) - CPOOLM=CPOOLM+AMAX1(0.0,CPOOLR(1,L,NZ,NY,NX)) - ZPOOLM=ZPOOLM+AMAX1(0.0,ZPOOLR(1,L,NZ,NY,NX)) - PPOOLM=PPOOLM+AMAX1(0.0,PPOOLR(1,L,NZ,NY,NX)) -3 CONTINUE - IF(WTRVC(NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - IF(ISTYP(NZ,NY,NX).NE.0)THEN - CPOOLT=AMAX1(ZEROP(NZ,NY,NX),WTRVC(NZ,NY,NX)+CPOOLM) - ZPOOLD=(WTRVN(NZ,NY,NX)*CPOOLM - 2-ZPOOLM*WTRVC(NZ,NY,NX))/CPOOLT - PPOOLD=(WTRVP(NZ,NY,NX)*CPOOLM - 2-PPOOLM*WTRVC(NZ,NY,NX))/CPOOLT - UPNH4R=AMAX1(0.0,FRSV(IBTYP(NZ,NY,NX))*ZPOOLD) - UPPO4R=AMAX1(0.0,FRSV(IBTYP(NZ,NY,NX))*PPOOLD) -C IF(NZ.EQ.1.OR.NZ.EQ.4)THEN -C WRITE(*,9878)'GERM1',I,J,NZ,UPNH4R,FRSV(IBTYP(NZ,NY,NX)) -C 2,ZPOOLD,WTRVN(NZ,NY,NX),CPOOLM,ZPOOLM,WTRVC(NZ,NY,NX) -C 3,CPOOLT -9878 FORMAT(A8,3I4,12E24.16) -C ENDIF - ELSE - UPNH4R=AMAX1(0.0,FXRT(ISTYP(NZ,NY,NX)) - 2*CH2OH*WTRVN(NZ,NY,NX)/WTRVC(NZ,NY,NX)) - UPPO4R=AMAX1(0.0,FXRT(ISTYP(NZ,NY,NX)) - 2*CH2OH*WTRVP(NZ,NY,NX)/WTRVC(NZ,NY,NX)) - ENDIF - ELSE - UPNH4R=AMAX1(0.0,FXRT(ISTYP(NZ,NY,NX))*WTRVN(NZ,NY,NX)) - UPPO4R=AMAX1(0.0,FXRT(ISTYP(NZ,NY,NX))*WTRVP(NZ,NY,NX)) - ENDIF -C -C TRANSFER STORAGE FLUXES -C - WTRVN(NZ,NY,NX)=WTRVN(NZ,NY,NX)-UPNH4B-UPNH4R - WTRVP(NZ,NY,NX)=WTRVP(NZ,NY,NX)-UPPO4B-UPPO4R - ZPOOL(NB,NZ,NY,NX)=ZPOOL(NB,NZ,NY,NX)+UPNH4B - PPOOL(NB,NZ,NY,NX)=PPOOL(NB,NZ,NY,NX)+UPPO4B - IF(WTRTM.GT.ZEROP(NZ,NY,NX) - 2.AND.CPOOLM.GT.ZEROP(NZ,NY,NX))THEN - DO 51 L=NU(NY,NX),NI(NZ,NY,NX) - FXFN=AMAX1(0.0,CPOOLR(1,L,NZ,NY,NX))/CPOOLM -C IF(NZ.EQ.1.OR.NZ.EQ.4)THEN -C WRITE(*,9879)'GERM2',I,J,NZ,L,UPNH4R,FXFN -C 2,ZPOOLR(1,L,NZ,NY,NX),CPOOLR(1,L,NZ,NY,NX),CPOOLM -9879 FORMAT(A8,4I4,12E24.16) -C ENDIF - ZPOOLR(1,L,NZ,NY,NX)=ZPOOLR(1,L,NZ,NY,NX)+FXFN*UPNH4R - PPOOLR(1,L,NZ,NY,NX)=PPOOLR(1,L,NZ,NY,NX)+FXFN*UPPO4R -51 CONTINUE - ELSE -C IF(NZ.EQ.1.OR.NZ.EQ.4)THEN -C WRITE(*,9879)'GERM3',I,J,NZ,L,UPNH4R,FXFN -C 2,ZPOOLR(1,L,NZ,NY,NX),CPOOLR(1,L,NZ,NY,NX),CPOOLM -C ENDIF - ZPOOLR(1,NG(NZ,NY,NX),NZ,NY,NX)=ZPOOLR(1,NG(NZ,NY,NX),NZ,NY,NX) - 2+UPNH4R - PPOOLR(1,NG(NZ,NY,NX),NZ,NY,NX)=PPOOLR(1,NG(NZ,NY,NX),NZ,NY,NX) - 2+UPPO4R - ENDIF - ENDIF -C -C REDISTRIBUTE TRANFERRED C FROM MAIN STEM TO OTHER BRANCHES -C - IF(NB.NE.NB1(NZ,NY,NX).AND.ATRP(NB,NZ,NY,NX).LE.ATRPX)THEN - ATRP(NB,NZ,NY,NX)=ATRP(NB,NZ,NY,NX)+TFN3(NZ,NY,NX)*WFNG - XFRC=AMAX1(0.0,0.05*TFN3(NZ,NY,NX) - 2*(0.5*(CPOOL(NB1(NZ,NY,NX),NZ,NY,NX)+CPOOL(NB,NZ,NY,NX)) - 3-CPOOL(NB,NZ,NY,NX))) - XFRN=AMAX1(0.0,0.05*TFN3(NZ,NY,NX) - 2*(0.5*(ZPOOL(NB1(NZ,NY,NX),NZ,NY,NX)+ZPOOL(NB,NZ,NY,NX)) - 2-ZPOOL(NB,NZ,NY,NX))) - XFRP=AMAX1(0.0,0.05*TFN3(NZ,NY,NX) - 2*(0.5*(PPOOL(NB1(NZ,NY,NX),NZ,NY,NX)+PPOOL(NB,NZ,NY,NX)) - 3-PPOOL(NB,NZ,NY,NX))) - CPOOL(NB,NZ,NY,NX)=CPOOL(NB,NZ,NY,NX)+XFRC - ZPOOL(NB,NZ,NY,NX)=ZPOOL(NB,NZ,NY,NX)+XFRN - PPOOL(NB,NZ,NY,NX)=PPOOL(NB,NZ,NY,NX)+XFRP - CPOOL(NB1(NZ,NY,NX),NZ,NY,NX)=CPOOL(NB1(NZ,NY,NX),NZ,NY,NX)-XFRC - ZPOOL(NB1(NZ,NY,NX),NZ,NY,NX)=ZPOOL(NB1(NZ,NY,NX),NZ,NY,NX)-XFRN - PPOOL(NB1(NZ,NY,NX),NZ,NY,NX)=PPOOL(NB1(NZ,NY,NX),NZ,NY,NX)-XFRP - ENDIF - ENDIF -C -C TRANSFER LEAF AND STALK NON-STRUCTURAL C,N,P TO SEASONAL STORAGE -C IN PERENNIALS AFTER GRAIN FILL IN DETERMINATES, AFTER AUTUMNIZ'N -C IN INDETERMINATES, OR AFTER SUSTAINED WATER STRESS -C - IF(ISTYP(NZ,NY,NX).NE.0.AND.IFLGZ.EQ.1)THEN - IF(WVSTKB(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX) - 2.AND.WTRSVB(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - CWTRSV=AMAX1(0.0,WTRSVB(NB,NZ,NY,NX)/WVSTKB(NB,NZ,NY,NX)) - CWTRSN=AMAX1(0.0,WTRSBN(NB,NZ,NY,NX)/WVSTKB(NB,NZ,NY,NX)) - CWTRSP=AMAX1(0.0,WTRSBP(NB,NZ,NY,NX)/WVSTKB(NB,NZ,NY,NX)) - CNR=CWTRSV/(CWTRSV+CWTRSN*CNKI) - CPR=CWTRSV/(CWTRSV+CWTRSP*CPKI) - ELSE - CNR=0.0 - CPR=0.0 - ENDIF - XFRCX=FXFB(IBTYP(NZ,NY,NX)) - 2*AMAX1(0.0,WTRSVB(NB,NZ,NY,NX)) - XFRNX=FXFB(IBTYP(NZ,NY,NX)) - 2*AMAX1(0.0,WTRSBN(NB,NZ,NY,NX))*(1.0+CNR) - XFRPX=FXFB(IBTYP(NZ,NY,NX)) - 2*AMAX1(0.0,WTRSBP(NB,NZ,NY,NX))*(1.0+CPR) - XFRC=AMIN1(XFRCX,XFRNX/CNMN,XFRPX/CPMN) - XFRN=AMIN1(XFRNX,XFRC*CNMX,XFRPX*CNMX/CPMN*0.5) - XFRP=AMIN1(XFRPX,XFRC*CPMX,XFRNX*CPMX/CNMN*0.5) - WTRSVB(NB,NZ,NY,NX)=WTRSVB(NB,NZ,NY,NX)-XFRC - WTRVC(NZ,NY,NX)=WTRVC(NZ,NY,NX)+XFRC - WTRSBN(NB,NZ,NY,NX)=WTRSBN(NB,NZ,NY,NX)-XFRN - WTRVN(NZ,NY,NX)=WTRVN(NZ,NY,NX)+XFRN - WTRSBP(NB,NZ,NY,NX)=WTRSBP(NB,NZ,NY,NX)-XFRP - WTRVP(NZ,NY,NX)=WTRVP(NZ,NY,NX)+XFRP - IF(CPOOL(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - CNL=CCPOLB(NB,NZ,NY,NX)/(CCPOLB(NB,NZ,NY,NX) - 2+CZPOLB(NB,NZ,NY,NX)*CNKI) - CPL=CCPOLB(NB,NZ,NY,NX)/(CCPOLB(NB,NZ,NY,NX) - 2+CPPOLB(NB,NZ,NY,NX)*CPKI) - ELSE - CNL=0.0 - CPL=0.0 - ENDIF - XFRCX=FXFB(IBTYP(NZ,NY,NX)) - 2*AMAX1(0.0,CPOOL(NB,NZ,NY,NX)) - XFRNX=FXFB(IBTYP(NZ,NY,NX)) - 2*AMAX1(0.0,ZPOOL(NB,NZ,NY,NX))*(1.0+CNL) - XFRPX=FXFB(IBTYP(NZ,NY,NX)) - 2*AMAX1(0.0,PPOOL(NB,NZ,NY,NX))*(1.0+CPL) - XFRC=AMIN1(XFRCX,XFRNX/CNMN,XFRPX/CPMN) - XFRN=AMIN1(XFRNX,XFRC*CNMX,XFRPX*CNMX/CPMN*0.5) - XFRP=AMIN1(XFRPX,XFRC*CPMX,XFRNX*CPMX/CNMN*0.5) - CPOOL(NB,NZ,NY,NX)=CPOOL(NB,NZ,NY,NX)-XFRC - WTRVC(NZ,NY,NX)=WTRVC(NZ,NY,NX)+XFRC - ZPOOL(NB,NZ,NY,NX)=ZPOOL(NB,NZ,NY,NX)-XFRN - WTRVN(NZ,NY,NX)=WTRVN(NZ,NY,NX)+XFRN - PPOOL(NB,NZ,NY,NX)=PPOOL(NB,NZ,NY,NX)-XFRP - WTRVP(NZ,NY,NX)=WTRVP(NZ,NY,NX)+XFRP -C IF(NZ.EQ.1)THEN -C WRITE(*,4490)'RSV',I,J,NZ,NB,XFRC,XFRN,WTRSVB(NB,NZ,NY,NX) -C 2,WTRSBN(NB,NZ,NY,NX),WTRVC(NZ,NY,NX),WTRVN(NZ,NY,NX) -C 3,CNR,CNL,CPOOL(NB,NZ,NY,NX),ZPOOL(NB,NZ,NY,NX) -C 4,FXFB(IBTYP(NZ,NY,NX)) -4490 FORMAT(A8,4I4,20E12.4) -C ENDIF - ENDIF -C -C TRANSFER NON-STRUCTURAL C,N,P FROM LEAVES AND ROOTS TO RESERVES -C IN STALKS DURING GRAIN FILL IN ANNUALS OR BETWEEN STALK RESERVES -C AND LEAVES IN PERENNIALS ACCORDING TO CONCENTRATION DIFFERENCES -C - IF((ISTYP(NZ,NY,NX).EQ.0.AND.IDAY(8,NB,NZ,NY,NX).NE.0) - 2.OR.(ISTYP(NZ,NY,NX).EQ.1.AND.IDAY(3,NB,NZ,NY,NX).NE.0))THEN - WTPLTT=WTLSB(NB,NZ,NY,NX)+WVSTKB(NB,NZ,NY,NX) - CPOOLT=CPOOL(NB,NZ,NY,NX)+WTRSVB(NB,NZ,NY,NX) - IF(WTPLTT.GT.ZEROP(NZ,NY,NX))THEN - CPOOLD=(CPOOL(NB,NZ,NY,NX)*WVSTKB(NB,NZ,NY,NX) - 2-WTRSVB(NB,NZ,NY,NX)*WTLSB(NB,NZ,NY,NX))/WTPLTT - XFRC=FXFY(ISTYP(NZ,NY,NX))*CPOOLD - CPOOL(NB,NZ,NY,NX)=CPOOL(NB,NZ,NY,NX)-XFRC - WTRSVB(NB,NZ,NY,NX)=WTRSVB(NB,NZ,NY,NX)+XFRC - ENDIF - IF(CPOOLT.GT.ZEROP(NZ,NY,NX))THEN - ZPOOLD=(ZPOOL(NB,NZ,NY,NX)*WTRSVB(NB,NZ,NY,NX) - 2-WTRSBN(NB,NZ,NY,NX)*CPOOL(NB,NZ,NY,NX))/CPOOLT - PPOOLD=(PPOOL(NB,NZ,NY,NX)*WTRSVB(NB,NZ,NY,NX) - 2-WTRSBP(NB,NZ,NY,NX)*CPOOL(NB,NZ,NY,NX))/CPOOLT - XFRN=FXFZ(ISTYP(NZ,NY,NX))*ZPOOLD - XFRP=FXFZ(ISTYP(NZ,NY,NX))*PPOOLD - ZPOOL(NB,NZ,NY,NX)=ZPOOL(NB,NZ,NY,NX)-XFRN - WTRSBN(NB,NZ,NY,NX)=WTRSBN(NB,NZ,NY,NX)+XFRN - PPOOL(NB,NZ,NY,NX)=PPOOL(NB,NZ,NY,NX)-XFRP - WTRSBP(NB,NZ,NY,NX)=WTRSBP(NB,NZ,NY,NX)+XFRP - ENDIF -C IF(NZ.EQ.1)THEN -C WRITE(*,4488)'EXCHC',I,J,NX,NY,NZ,NB,NS,XFRC,XFRN -C 2,FXFZ(ISTYP(NZ,NY,NX)),WTRSVB(NB,NZ,NY,NX),CPOOL(NB,NZ,NY,NX) -C 3,WVSTKB(NB,NZ,NY,NX),WTLSB(NB,NZ,NY,NX) -C 4,CPOOLT,CPOOLD,ZPOOL(NB,NZ,NY,NX),WTRSBN(NB,NZ,NY,NX) -4488 FORMAT(A8,7I4,12E12.4) -C ENDIF - IF(ISTYP(NZ,NY,NX).EQ.0)THEN - DO 2050 L=NU(NY,NX),NI(NZ,NY,NX) - WTRTRX=AMAX1(ZEROP(NZ,NY,NX),WTRTL(1,L,NZ,NY,NX)*FWOOD(1)) - WTPLTX=WTRTRX+WVSTKB(NB,NZ,NY,NX) - IF(WTPLTX.GT.ZEROP(NZ,NY,NX))THEN - CPOOLD=(CPOOLR(1,L,NZ,NY,NX)*WVSTKB(NB,NZ,NY,NX) - 2-WTRSVB(NB,NZ,NY,NX)*WTRTRX)/WTPLTX - XFRC=AMAX1(0.0,FXFY(ISTYP(NZ,NY,NX))*CPOOLD) - CPOOLR(1,L,NZ,NY,NX)=CPOOLR(1,L,NZ,NY,NX)-XFRC - WTRSVB(NB,NZ,NY,NX)=WTRSVB(NB,NZ,NY,NX)+XFRC - CPOOLT=CPOOLR(1,L,NZ,NY,NX)+WTRSVB(NB,NZ,NY,NX) - IF(CPOOLT.GT.ZEROP(NZ,NY,NX))THEN - ZPOOLD=(ZPOOLR(1,L,NZ,NY,NX)*WTRSVB(NB,NZ,NY,NX) - 2-WTRSBN(NB,NZ,NY,NX)*CPOOLR(1,L,NZ,NY,NX))/CPOOLT - PPOOLD=(PPOOLR(1,L,NZ,NY,NX)*WTRSVB(NB,NZ,NY,NX) - 2-WTRSBP(NB,NZ,NY,NX)*CPOOLR(1,L,NZ,NY,NX))/CPOOLT - XFRN=AMAX1(0.0,FXFZ(ISTYP(NZ,NY,NX))*ZPOOLD) - XFRP=AMAX1(0.0,FXFZ(ISTYP(NZ,NY,NX))*PPOOLD) - ZPOOLR(1,L,NZ,NY,NX)=ZPOOLR(1,L,NZ,NY,NX)-XFRN - WTRSBN(NB,NZ,NY,NX)=WTRSBN(NB,NZ,NY,NX)+XFRN - PPOOLR(1,L,NZ,NY,NX)=PPOOLR(1,L,NZ,NY,NX)-XFRP - WTRSBP(NB,NZ,NY,NX)=WTRSBP(NB,NZ,NY,NX)+XFRP -C IF(NZ.EQ.1)THEN -C WRITE(*,4489)'EXCHC',I,J,NZ,NB,L,WTRSVB(NB,NZ,NY,NX) -C 2,WVSTKB(NB,NZ,NY,NX),CPOOLR(1,L,NZ,NY,NX) -C 3,WTRTL(1,L,NZ,NY,NX),FWOOD(1),WTRTRX,WTPLTX -C 4,CPOOLT,CPOOLD,XFRC,FXFZ(ISTYP(NZ,NY,NX)) -4489 FORMAT(A8,5I4,12E16.8) -C ENDIF -C IF(NZ.EQ.1.OR.NZ.EQ.4)THEN -C WRITE(*,4489)'EXCHN',I,J,NZ,NB,L,WTRSBN(NB,NZ,NY,NX) -C 2,WTRSVB(NB,NZ,NY,NX),ZPOOLR(1,L,NZ,NY,NX) -C 3,CPOOLR(1,L,NZ,NY,NX),FWOOD(1),ZPOOLD,XFRN -C ENDIF - ENDIF - ENDIF -2050 CONTINUE - ENDIF - ENDIF -C -C REPLENISH BRANCH NON-STRUCTURAL POOL FROM -C SEASONAL STORAGE POOL -C - IF(WVSTKB(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX) - 2.AND.WVSTK(NZ,NY,NX).GT.ZEROP(NZ,NY,NX) - 3.AND.WTRT(NZ,NY,NX).GT.ZEROP(NZ,NY,NX) - 4.AND.WTRSVB(NB,NZ,NY,NX).LE.XFRX*WVSTKB(NB,NZ,NY,NX))THEN - FWTBR=WVSTKB(NB,NZ,NY,NX)/WVSTK(NZ,NY,NX) - WVSTBX=WVSTKB(NB,NZ,NY,NX) - WTRTTX=WTRT(NZ,NY,NX)*FWTBR - WTPLTT=WVSTBX+WTRTTX - WTRSBX=AMAX1(0.0,WTRSVB(NB,NZ,NY,NX)) - WTRVCX=AMAX1(0.0,WTRVC(NZ,NY,NX)*FWTBR) - CPOOLD=(WTRVCX*WVSTBX-WTRSBX*WTRTTX)/WTPLTT - XFRC=AMAX1(0.0,XFRY*CPOOLD) - WTRSVB(NB,NZ,NY,NX)=WTRSVB(NB,NZ,NY,NX)+XFRC - WTRVC(NZ,NY,NX)=WTRVC(NZ,NY,NX)-XFRC - ENDIF -C -C CANOPY N2 FIXATION (CYANOBACTERIA) -C - IF(INTYP(NZ,NY,NX).GE.3)THEN -C -C INITIAL INFECTION -C - IF(WTNDB(NB,NZ,NY,NX).LE.0.0)THEN - WTNDB(NB,NZ,NY,NX)=WTNDB(NB,NZ,NY,NX) - 2+WTNDI*AREA(3,NU(NY,NX),NY,NX) - WTNDBN(NB,NZ,NY,NX)=WTNDBN(NB,NZ,NY,NX) - 2+WTNDI*AREA(3,NU(NY,NX),NY,NX)*CNND(NZ,NY,NX) - WTNDBP(NB,NZ,NY,NX)=WTNDBP(NB,NZ,NY,NX) - 2+WTNDI*AREA(3,NU(NY,NX),NY,NX)*CPND(NZ,NY,NX) - ENDIF -C -C O2-UNCONSTRAINED RESPIRATION RATES BY HETEROTROPHIC AEROBES -C IN NODULE FROM SPECIFIC OXIDATION RATE, ACTIVE BIOMASS, -C NON-STRUCTURAL C CONCENTRATION, MICROBIAL C:N:P FACTOR, -C AND TEMPERATURE -C - IF(WTNDB(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - CCPOLN=AMAX1(0.0,CPOLNB(NB,NZ,NY,NX)/WTNDB(NB,NZ,NY,NX)) - CZPOLN=AMAX1(0.0,ZPOLNB(NB,NZ,NY,NX)/WTNDB(NB,NZ,NY,NX)) - CPPOLN=AMAX1(0.0,PPOLNB(NB,NZ,NY,NX)/WTNDB(NB,NZ,NY,NX)) - ELSE - CCPOLN=1.0 - CZPOLN=1.0 - 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) - ELSE - CCC=0.0 - CNC=0.0 - CPC=0.0 - CNF=0.0 - ENDIF - IF(WTNDB(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - FCNPF=AMIN1(1.0,AMAX1(0.0 - 2,WTNDBN(NB,NZ,NY,NX)/(WTNDB(NB,NZ,NY,NX)*CNND(NZ,NY,NX)) - 3,WTNDBP(NB,NZ,NY,NX)/(WTNDB(NB,NZ,NY,NX)*CPND(NZ,NY,NX)))) - ELSE - FCNPF=1.0 - ENDIF - RDNDBX=CCPOLN/(CCPOLN+CCNKX) - RCNDL=AMAX1(0.0,AMIN1(CPOLNB(NB,NZ,NY,NX)*(1.0-DMND(NZ,NY,NX)) - 2,VMXO*WTNDB(NB,NZ,NY,NX)*CCPOLN/(CCPOLN+CCNKM) - 3*TFN3(NZ,NY,NX)*FCNPF*WFNG))*CNF -C -C NODULE MAINTENANCE RESPIRATION FROM SOIL TEMPERATURE, -C NODULE STRUCTURAL N -C - RMNDL=AMAX1(0.0,RMPLT*TFN5*WTNDBN(NB,NZ,NY,NX))*RDNDBX -C -C NODULE GROWTH RESPIRATION FROM TOTAL - MAINTENANCE -C IF > 0 DRIVES GROWTH, IF < 0 DRIVES REMOBILIZATION -C - RXNDL=RCNDL-RMNDL - RGNDL=AMAX1(0.0,RXNDL) - RSNDL=AMAX1(0.0,-RXNDL) -C -C NODULE N2 FIXATION FROM GROWTH RESPIRATION, FIXATION ENERGY -C REQUIREMENT AND NON-STRUCTURAL C:N:P PRODUCT INHIBITION, -C CONSTRAINED BY MICROBIAL N REQUIREMENT -C - RGN2P=AMAX1(0.0,WTNDB(NB,NZ,NY,NX)*CNND(NZ,NY,NX) - 2-WTNDBN(NB,NZ,NY,NX))/EN2F - RGN2F=AMIN1(RGNDL,RGN2P) - RUPNFB=RGN2F*EN2F - UPNFC(NZ,NY,NX)=UPNFC(NZ,NY,NX)+RUPNFB -C -C TOTAL NON-STRUCTURAL C,N,P USED IN NODULE GROWTH -C AND GROWTH RESPIRATION DEPENDS ON GROWTH YIELD ENTERED IN 'READQ' -C - CGNDL=(RGNDL-RGN2F)/(1.0-DMND(NZ,NY,NX)) - GRNDG=CGNDL*DMND(NZ,NY,NX) - ZADDN=AMAX1(0.0,AMIN1(ZPOLNB(NB,NZ,NY,NX) - 2,GRNDG*CNND(NZ,NY,NX))*CCC) - PADDN=AMAX1(0.0,AMIN1(PPOLNB(NB,NZ,NY,NX) - 2,GRNDG*CPND(NZ,NY,NX))*CCC) -C -C NODULE C,N,P REMOBILIZATION AND DECOMPOSITION AND LEAKAGE -C - RCCC=RCCZ(IBTYP(NZ,NY,NX))+CCC*RCCY(IBTYP(NZ,NY,NX)) - RCCN=CNC*RCCX(IGTYP(NZ,NY,NX)) - RCCP=CPC*RCCQ(IGTYP(NZ,NY,NX)) - SPNDX=SPNDL*RDNDBX - RXNDLC=SPNDX*WTNDB(NB,NZ,NY,NX)*WFNG - RXNDLN=SPNDX*WTNDBN(NB,NZ,NY,NX)*WFNG - RXNDLP=SPNDX*WTNDBP(NB,NZ,NY,NX)*WFNG - RDNDLC=RXNDLC*(1.0-RCCC) - RDNDLN=RXNDLN*(1.0-RCCN)*(1.0-RCCC) - RDNDLP=RXNDLP*(1.0-RCCP)*(1.0-RCCC) - RCNDLC=RXNDLC-RDNDLC - RCNDLN=RXNDLN-RDNDLN - RCNDLP=RXNDLP-RDNDLP -C -C NODULE SENESCENCE -C - IF(RSNDL.GT.0.0.AND.WTNDB(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX) - 2.AND.RCCC.GT.ZERO)THEN - RXNSNC=RSNDL/RCCC - RXNSNN=RXNSNC*WTNDBN(NB,NZ,NY,NX)/WTNDB(NB,NZ,NY,NX) - RXNSNP=RXNSNC*WTNDBP(NB,NZ,NY,NX)/WTNDB(NB,NZ,NY,NX) - RDNSNC=RXNSNC*(1.0-RCCC) - RDNSNN=RXNSNN*(1.0-RCCN)*(1.0-RCCC) - RDNSNP=RXNSNP*(1.0-RCCP)*(1.0-RCCC) - RCNSNC=RXNSNC-RDNSNC - RCNSNN=RXNSNN-RDNSNN - RCNSNP=RXNSNP-RDNSNP - ELSE - RXNSNC=0.0 - RXNSNN=0.0 - RXNSNP=0.0 - RDNSNC=0.0 - RDNSNN=0.0 - RDNSNP=0.0 - RCNSNC=0.0 - RCNSNN=0.0 - RCNSNP=0.0 - ENDIF -C -C TOTAL NODULE RESPIRATION -C - RCO2T=AMIN1(RMNDL,RCNDL)+RGNDL+RCNSNC - TCO2T(NZ,NY,NX)=TCO2T(NZ,NY,NX)-RCO2T - TCO2A(NZ,NY,NX)=TCO2A(NZ,NY,NX)-RCO2T - CNET(NZ,NY,NX)=CNET(NZ,NY,NX)-RCO2T - RECO(NY,NX)=RECO(NY,NX)-RCO2T - TRAU(NY,NX)=TRAU(NY,NX)-RCO2T -C -C NODULE LITTERFALL CAUSED BY REMOBILIZATION -C - DO 6470 M=1,4 - CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX)+CFOPC(1,M,NZ,NY,NX) - 2*(RDNDLC+RDNSNC) - ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX)+CFOPN(1,M,NZ,NY,NX) - 2*(RDNDLN+RDNSNN) - PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX)+CFOPP(1,M,NZ,NY,NX) - 2*(RDNDLP+RDNSNP) -6470 CONTINUE -C -C CONSUMPTION OF NON-STRUCTURAL C,N,P BY NODULE -C - CPOLNB(NB,NZ,NY,NX)=CPOLNB(NB,NZ,NY,NX)-AMIN1(RMNDL,RCNDL) - 2-RGN2F-CGNDL+RCNDLC - ZPOLNB(NB,NZ,NY,NX)=ZPOLNB(NB,NZ,NY,NX)-ZADDN+RCNDLN+RCNSNN - 2+RUPNFB - PPOLNB(NB,NZ,NY,NX)=PPOLNB(NB,NZ,NY,NX)-PADDN+RCNDLP+RCNSNP -C -C UPDATE STATE VARIABLES FOR NODULE C, N, P -C - WTNDB(NB,NZ,NY,NX)=WTNDB(NB,NZ,NY,NX)+GRNDG-RXNDLC-RXNSNC - WTNDBN(NB,NZ,NY,NX)=WTNDBN(NB,NZ,NY,NX)+ZADDN-RXNDLN-RXNSNN - WTNDBP(NB,NZ,NY,NX)=WTNDBP(NB,NZ,NY,NX)+PADDN-RXNDLP-RXNSNP -C -C TRANSFER NON-STRUCTURAL C,N,P BETWEEN BRANCH AND NODULES -C FROM NON-STRUCTURAL C,N,P CONCENTRATION DIFFERENCES -C - 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),WTNDB(NB,NZ,NY,NX)) - WTLSBT=WTLSB1+WTNDB1 - IF(WTLSBT.GT.ZEROP(NZ,NY,NX))THEN - CPOOLD=(CPOOL(NB,NZ,NY,NX)*WTNDB1 - 2-CPOLNB(NB,NZ,NY,NX)*WTLSB1)/WTLSBT - XFRC=FXRN(INTYP(NZ,NY,NX))*CPOOLD - CPOOL(NB,NZ,NY,NX)=CPOOL(NB,NZ,NY,NX)-XFRC - CPOLNB(NB,NZ,NY,NX)=CPOLNB(NB,NZ,NY,NX)+XFRC - CPOOLT=CPOOL(NB,NZ,NY,NX)+CPOLNB(NB,NZ,NY,NX) - IF(CPOOLT.GT.ZEROP(NZ,NY,NX))THEN - ZPOOLD=(ZPOOL(NB,NZ,NY,NX)*CPOLNB(NB,NZ,NY,NX) - 2-ZPOLNB(NB,NZ,NY,NX)*CPOOL(NB,NZ,NY,NX))/CPOOLT - XFRN=FXRN(INTYP(NZ,NY,NX))*ZPOOLD - PPOOLD=(PPOOL(NB,NZ,NY,NX)*CPOLNB(NB,NZ,NY,NX) - 2-PPOLNB(NB,NZ,NY,NX)*CPOOL(NB,NZ,NY,NX))/CPOOLT - XFRP=FXRN(INTYP(NZ,NY,NX))*PPOOLD - ZPOOL(NB,NZ,NY,NX)=ZPOOL(NB,NZ,NY,NX)-XFRN - PPOOL(NB,NZ,NY,NX)=PPOOL(NB,NZ,NY,NX)-XFRP - ZPOLNB(NB,NZ,NY,NX)=ZPOLNB(NB,NZ,NY,NX)+XFRN - PPOLNB(NB,NZ,NY,NX)=PPOLNB(NB,NZ,NY,NX)+XFRP -C IF((I/10)*10.EQ.I.AND.J.EQ.12.AND.NZ.EQ.4)THEN -C WRITE(*,2121)'NODEX',I,J,NZ,NB,XFRC,XFRN,XFRP -C 3,WTLSB(NB,NZ,NY,NX),WTNDB(NB,NZ,NY,NX),CPOOLT -C 4,CPOLNB(NB,NZ,NY,NX),ZPOLNB(NB,NZ,NY,NX),PPOLNB(NB,NZ,NY,NX) -C 4,CPOOL(NB,NZ,NY,NX),ZPOOL(NB,NZ,NY,NX),PPOOL(NB,NZ,NY,NX) -C ENDIF - ENDIF - ENDIF - ENDIF -C IF((I/10)*10.EQ.I.AND.J.EQ.12.AND.NY.EQ.5)THEN -C WRITE(*,2121)'NODGR',I,J,NZ,NB,RCNDL,RMNDL,RGNDL,RGN2P -C 2,RGN2F,CGNDL,SNCR,GRNDG,ZADDN,PADDN,FSNCN -C 8,RDNDLC,RDNDLN,RDNDLP,RCCC,RCCN,RCCP,TFN5 -C 3,WTNDB(NB,NZ,NY,NX),WTNDBN(NB,NZ,NY,NX),WTNDBP(NB,NZ,NY,NX) -C 4,CPOLNB(NB,NZ,NY,NX),ZPOLNB(NB,NZ,NY,NX),PPOLNB(NB,NZ,NY,NX) -C 5,CCPOLN,CZPOLN,TFN3(NZ,NY,NX),CNF,FCNPF,WFNG -C 6,CPOLNB(NB,NZ,NY,NX)*(1.0-DMND(NZ,NY,NX)) -C 6,VMXO*WTNDB(NB,NZ,NY,NX)*CCPOLN/(CCPOLN+CCNKM) -2121 FORMAT(A8,4I4,60E12.4) -C ENDIF - ENDIF - ENDIF - - -105 CONTINUE -C -C ROOT GROWTH -C - NIX(NZ,NY,NX)=NG(NZ,NY,NX) - IDTHRN=0 -C -C FOR ROOTS (N=1) AND MYCORRHIZAE (N=2) IN EACH SOIL LAYER -C - DO 4990 N=1,MY(NZ,NY,NX) - DO 4990 L=NU(NY,NX),NI(NZ,NY,NX) -C -C RESPIRATION FROM NUTRIENT UPTAKE CALCULATED IN 'UPTAKE': -C ACTUAL, O2-UNLIMITED AND C-UNLIMITED -C - CUPRL=0.86*(RUPNH4(N,L,NZ,NY,NX)+RUPNHB(N,L,NZ,NY,NX) - 2+RUPNO3(N,L,NZ,NY,NX)+RUPNOB(N,L,NZ,NY,NX)+RUPH2P(N,L,NZ,NY,NX) - 3+RUPH2B(N,L,NZ,NY,NX)) - CUPRO=0.86*(RUONH4(N,L,NZ,NY,NX)+RUONHB(N,L,NZ,NY,NX) - 2+RUONO3(N,L,NZ,NY,NX)+RUONOB(N,L,NZ,NY,NX)+RUOH2P(N,L,NZ,NY,NX) - 3+RUOH2B(N,L,NZ,NY,NX)) - CUPRC=0.86*(RUCNH4(N,L,NZ,NY,NX)+RUCNHB(N,L,NZ,NY,NX) - 2+RUCNO3(N,L,NZ,NY,NX)+RUCNOB(N,L,NZ,NY,NX)+RUCH2P(N,L,NZ,NY,NX) - 3+RUCH2B(N,L,NZ,NY,NX)) -C -C ACCUMULATE RESPIRATION IN FLUX ARRAYS -C - RCO2M(N,L,NZ,NY,NX)=RCO2M(N,L,NZ,NY,NX)+CUPRO - RCO2N(N,L,NZ,NY,NX)=RCO2N(N,L,NZ,NY,NX)+CUPRC - RCO2A(N,L,NZ,NY,NX)=RCO2A(N,L,NZ,NY,NX)-CUPRL - CPOOLR(N,L,NZ,NY,NX)=CPOOLR(N,L,NZ,NY,NX)-CUPRL -C -C EXUDATION AND UPTAKE OF C, N AND P TO/FROM SOIL AND ROOT -C OR MYCORRHIZAL NON-STRUCTURAL C,N,P POOLS -C - DO 195 K=0,4 - CPOOLR(N,L,NZ,NY,NX)=CPOOLR(N,L,NZ,NY,NX)+RDFOMC(N,K,L,NZ,NY,NX) - ZPOOLR(N,L,NZ,NY,NX)=ZPOOLR(N,L,NZ,NY,NX)+RDFOMN(N,K,L,NZ,NY,NX) - PPOOLR(N,L,NZ,NY,NX)=PPOOLR(N,L,NZ,NY,NX)+RDFOMP(N,K,L,NZ,NY,NX) -195 CONTINUE - ZPOOLR(N,L,NZ,NY,NX)=ZPOOLR(N,L,NZ,NY,NX) - 2+RUPNH4(N,L,NZ,NY,NX)+RUPNHB(N,L,NZ,NY,NX) - 2+RUPNO3(N,L,NZ,NY,NX)+RUPNOB(N,L,NZ,NY,NX) - PPOOLR(N,L,NZ,NY,NX)=PPOOLR(N,L,NZ,NY,NX) - 2+RUPH2P(N,L,NZ,NY,NX)+RUPH2B(N,L,NZ,NY,NX) -C IF(L.EQ.1)THEN -C WRITE(*,9881)'CUPNH4',I,J,NZ,L,N,CPOOLR(N,L,NZ,NY,NX) -C 2,ZPOOLR(N,L,NZ,NY,NX),PPOOLR(N,L,NZ,NY,NX),CUPRL -C 2,RDFOMC(N,L,NZ,NY,NX),RDFOMN(N,L,NZ,NY,NX),RDFOMP(N,L,NZ,NY,NX) -C 2,RUPNH4(N,L,NZ,NY,NX),RUPNHB(N,L,NZ,NY,NX),RUPNO3(N,L,NZ,NY,NX) -C 2,RUPNOB(N,L,NZ,NY,NX),RUPH2P(N,L,NZ,NY,NX),RUPH2B(N,L,NZ,NY,NX) -C 3,WFR(N,L,NZ,NY,NX) -9881 FORMAT(A8,5I4,30E24.16) -C ENDIF -C -C GROWTH OF EACH ROOT AXIS -C - DO 4985 NR=1,NRT(NZ,NY,NX) -C -C PRIMARY ROOT SINK STRENGTH FROM ROOT RADIUS AND ROOT DEPTH -C - IF(N.EQ.1)THEN - 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 - RTNT(N)=RTNT(N)+RTSK1(N,L,NR) - RLNT(N,L)=RLNT(N,L)+RTSK1(N,L,NR) - ENDIF - ENDIF - ENDIF -C -C SECONDARY ROOT SINK STRENGTH FROM ROOT RADIUS, ROOT AXIS NUMBER, -C AND ROOT LENGTH IN SERIES WITH PRIMARY ROOT SINK STRENGTH -C - IF(N.EQ.1)THEN - RTDPL(NR,L)=AMAX1(0.0,RTDP1(1,NR,NZ,NY,NX)-CDPTHZ(L-1,NY,NX) - 2-RTDPX) - RTDPL(NR,L)=AMAX1(0.0,AMIN1(DLYR(3,L,NY,NX),RTDPL(NR,L)) - 2-AMAX1(0.0,SDPTH(NZ,NY,NX)-CDPTHZ(L-1,NY,NX)-HTCTL(NZ,NY,NX))) - RTDPS=AMAX1(SDPTH(NZ,NY,NX),CDPTHZ(L-1,NY,NX)) - 2+0.5*RTDPL(NR,L)+HTSTZ(NZ,NY,NX) - IF(RTDPS.GT.ZERO)THEN - RTSKP=XRTN1*RRAD1(N,L,NZ,NY,NX)**2/RTDPS - RTSKS=RTN2(N,L,NR,NZ,NY,NX)*RRAD2(N,L,NZ,NY,NX)**2 - 2/RTLGA(N,L,NZ,NY,NX) - IF(RTSKP+RTSKS.GT.ZEROP(NZ,NY,NX))THEN - RTSK2(N,L,NR)=RTSKP*RTSKS/(RTSKP+RTSKS) - ELSE - RTSK2(N,L,NR)=0.0 - ENDIF - ELSE - RTSK2(N,L,NR)=0.0 - ENDIF - ELSE - RTSK2(N,L,NR)=RTN2(N,L,NR,NZ,NY,NX)*RRAD2(N,L,NZ,NY,NX)**2 - 2/RTLGA(N,L,NZ,NY,NX) - ENDIF - RTNT(N)=RTNT(N)+RTSK2(N,L,NR) - RLNT(N,L)=RLNT(N,L)+RTSK2(N,L,NR) -C IF(NZ.EQ.3)THEN -C WRITE(*,3341)'SINK',I,J,NX,NY,NZ,L,NR,N -C 2,RTSK1(N,L,NR),RTSK2(N,L,NR),RLNT(N,L),RTNT(N) -C 3,XRTN1,PP(NZ,NY,NX),RRAD1(N,L,NZ,NY,NX),RTDPP -C 4,RTN2(N,L,NR,NZ,NY,NX),RRAD2(N,L,NZ,NY,NX) -C 2,RTLGA(N,L,NZ,NY,NX) -3341 FORMAT(A8,8I4,20E12.4) -C ENDIF -4985 CONTINUE -4990 CONTINUE -C -C RESPIRATION AND GROWTH OF ROOT, MYCORRHIZAE IN EACH LAYER -C - DO 5010 N=1,MY(NZ,NY,NX) - DO 5000 L=NU(NY,NX),NI(NZ,NY,NX) -C -C WATER STRESS CONSTRAINT ON SECONDARY ROOT EXTENSION IMPOSED -C BY ROOT TURGOR AND SOIL PENETRATION RESISTANCE -C - RSCS2=RSCS(L,NY,NX)*RRAD2(N,L,NZ,NY,NX)/1.0E-03 - WFNR=AMIN1(1.0,AMAX1(0.0,PSIRG(N,L,NZ,NY,NX)-PSILM-RSCS2)) - WFNRG=WFNR**0.25 - WFNGR(N,L)=EXP(0.10*PSIRT(N,L,NZ,NY,NX)) - DMRTD=1.0-DMRT(NZ,NY,NX) - RTLGL=0.0 - RTLGZ=0.0 - WTRTX=0.0 - WTRTZ=0.0 -C -C FOR EACH ROOT AXIS -C - DO 5050 NR=1,NRT(NZ,NY,NX) -C -C SECONDARY ROOT EXTENSION -C - IF(L.LE.NINR(NR,NZ,NY,NX).AND.NRX(N,NR).EQ.0)THEN -C -C FRACTION OF SECONDARY ROOT SINK IN SOIL LAYER ATTRIBUTED -C TO CURRENT AXIS -C - IF(RLNT(N,L).GT.ZEROP(NZ,NY,NX))THEN - FRTN=RTSK2(N,L,NR)/RLNT(N,L) - ELSE - FRTN=1.0 - ENDIF -C -C N,P CONSTRAINT ON SECONDARY ROOT RESPIRATION FROM -C NON-STRUCTURAL C:N:P -C - IF(CCPOLR(N,L,NZ,NY,NX).GT.ZERO)THEN - CNPG=AMIN1(CZPOLR(N,L,NZ,NY,NX)/(CZPOLR(N,L,NZ,NY,NX) - 2+CCPOLR(N,L,NZ,NY,NX)/CNKI),CPPOLR(N,L,NZ,NY,NX) - 3/(CPPOLR(N,L,NZ,NY,NX)+CCPOLR(N,L,NZ,NY,NX)/CPKI)) - ELSE - CNPG=1.0 - ENDIF -C -C O2-UNLIMITED SECONDARY ROOT RESPIRATION FROM NON-STRUCTURAL C -C CONSTRAINED BY TEMPERATURE AND NON-STRUCTURAL C:N:P -C - RCO2RM=AMAX1(0.0,VMXC*FRTN*CPOOLR(N,L,NZ,NY,NX) - 2*TFN4(L,NZ,NY,NX))*CNPG*FDBKX(NB1(NZ,NY,NX),NZ,NY,NX) - 3*WFNGR(N,L) -C -C O2-LIMITED SECONDARY ROOT RESPIRATION FROM 'WFR' IN 'UPTAKE' -C - RCO2R=RCO2RM*WFR(N,L,NZ,NY,NX) -C -C SECONDARY ROOT MAINTENANCE RESPIRATION FROM SOIL TEMPERATURE, -C ROOT STRUCTURAL N -C - RMNCR=AMAX1(0.0,RMPLT*WTRT2N(N,L,NR,NZ,NY,NX))*TFN6(L) - IF(IWTYP(NZ,NY,NX).EQ.2)THEN - RMNCR=RMNCR*WFNGR(N,L) - ENDIF - RCO2XM=RCO2RM-RMNCR - RCO2X=RCO2R-RMNCR - RCO2YM=AMAX1(0.0,RCO2XM)*WFNRG - RCO2Y=AMAX1(0.0,RCO2X)*WFNRG -C -C SECONDARY ROOT GROWTH RESPIRATION MAY BE LIMITED BY -C NON-STRUCTURAL N,P AVAILABLE FOR GROWTH -C - DMRTR=DMRTD*FRTN - ZPOOLB=AMAX1(0.0,ZPOOLR(N,L,NZ,NY,NX)) - PPOOLB=AMAX1(0.0,PPOOLR(N,L,NZ,NY,NX)) - FNP=AMIN1(ZPOOLB*DMRTR/CNRTS(NZ,NY,NX) - 2,PPOOLB*DMRTR/CPRTS(NZ,NY,NX)) - IF(RCO2YM.GT.0.0)THEN - RCO2GM=AMIN1(RCO2YM,FNP) - ELSE - RCO2GM=0.0 - ENDIF - IF(RCO2Y.GT.0.0)THEN - RCO2G=AMIN1(RCO2Y,FNP*WFR(N,L,NZ,NY,NX)) - ELSE - RCO2G=0.0 - ENDIF -C -C TOTAL NON-STRUCTURAL C,N,P USED IN SECONDARY ROOT GROWTH -C AND GROWTH RESPIRATION DEPENDS ON GROWTH YIELD ENTERED IN 'READQ' -C - CGRORM=RCO2GM/DMRTD - CGROR=RCO2G/DMRTD - GRTWGM=CGRORM*DMRT(NZ,NY,NX) - GRTWTG=CGROR*DMRT(NZ,NY,NX) - ZADD2M=AMAX1(0.0,GRTWGM*CNRTW) - ZADD2=AMAX1(0.0,AMIN1(FRTN*ZPOOLR(N,L,NZ,NY,NX),GRTWTG*CNRTW)) - PADD2=AMAX1(0.0,AMIN1(FRTN*PPOOLR(N,L,NZ,NY,NX),GRTWTG*CPRTW)) - CNRDM=AMAX1(0.0,1.70*ZADD2M) - CNRDA=AMAX1(0.0,1.70*ZADD2) -C -C SECONDARY ROOT GROWTH RESPIRATION FROM TOTAL - MAINTENANCE -C IF > 0 DRIVES GROWTH, IF < 0 DRIVES REMOBILIZATION, ALSO -C SECONDARY ROOT C LOSS FROM REMOBILIZATION AND CONSEQUENT LITTERFALL -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) - 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) - ELSE - CCC=0.0 - CNC=0.0 - CPC=0.0 - ENDIF - RCCC=RCCZ(IBTYP(NZ,NY,NX))+CCC*RCCY(IBTYP(NZ,NY,NX)) - RCCN=CNC*RCCX(IGTYP(NZ,NY,NX)) - RCCP=CPC*RCCQ(IGTYP(NZ,NY,NX)) - IF(-RCO2XM.GT.0.0)THEN - IF(-RCO2XM.LT.WTRT2(N,L,NR,NZ,NY,NX)*RCCC)THEN - SNCRM=-RCO2XM - ELSE - SNCRM=AMAX1(0.0,WTRT2(N,L,NR,NZ,NY,NX)*RCCC) - ENDIF - ELSE - SNCRM=0.0 - ENDIF - IF(-RCO2X.GT.0.0)THEN - IF(-RCO2X.LT.WTRT2(N,L,NR,NZ,NY,NX)*RCCC)THEN - SNCR=-RCO2X - ELSE - SNCR=AMAX1(0.0,WTRT2(N,L,NR,NZ,NY,NX)*RCCC) - 2*WFR(N,L,NZ,NY,NX) - ENDIF - ELSE - SNCR=0.0 - ENDIF -C -C RECOVERY OF REMOBILIZABLE N,P FROM SECONDARY ROOT DURING -C REMOBILIZATION DEPENDS ON ROOT NON-STRUCTURAL C:N:P -C - IF(SNCR.GT.0.0.AND.WTRT2(N,L,NR,NZ,NY,NX) - 2.GT.ZEROP(NZ,NY,NX))THEN - RCCR=RCCC*WTRT2(N,L,NR,NZ,NY,NX) - RCZR=WTRT2N(N,L,NR,NZ,NY,NX)*(RCCN+(1.0-RCCN) - 2*RCCR/WTRT2(N,L,NR,NZ,NY,NX)) - RCPR=WTRT2P(N,L,NR,NZ,NY,NX)*(RCCP+(1.0-RCCP) - 2*RCCR/WTRT2(N,L,NR,NZ,NY,NX)) - IF(RCCR.GT.ZEROP(NZ,NY,NX))THEN - FSNC2=AMAX1(0.0,AMIN1(1.0,SNCR/RCCR)) - ELSE - FSNC2=1.0 - ENDIF - ELSE - RCCR=0.0 - RCZR=0.0 - RCPR=0.0 - FSNC2=0.0 - ENDIF -C -C SECONDARY ROOT LITTERFALL CAUSED BY REMOBILIZATION -C - DO 6350 M=1,4 - CSNC(M,0,L,NZ,NY,NX)=CSNC(M,0,L,NZ,NY,NX)+CFOPC(5,M,NZ,NY,NX) - 2*FSNC2*(WTRT2(N,L,NR,NZ,NY,NX)-RCCR)*FWOOD(0) - ZSNC(M,0,L,NZ,NY,NX)=ZSNC(M,0,L,NZ,NY,NX)+CFOPN(5,M,NZ,NY,NX) - 2*FSNC2*(WTRT2N(N,L,NR,NZ,NY,NX)-RCZR)*FWOODN(0) - PSNC(M,0,L,NZ,NY,NX)=PSNC(M,0,L,NZ,NY,NX)+CFOPP(5,M,NZ,NY,NX) - 2*FSNC2*(WTRT2P(N,L,NR,NZ,NY,NX)-RCPR)*FWOODP(0) - CSNC(M,1,L,NZ,NY,NX)=CSNC(M,1,L,NZ,NY,NX)+CFOPC(4,M,NZ,NY,NX) - 2*FSNC2*(WTRT2(N,L,NR,NZ,NY,NX)-RCCR)*FWOOD(1) - ZSNC(M,1,L,NZ,NY,NX)=ZSNC(M,1,L,NZ,NY,NX)+CFOPN(4,M,NZ,NY,NX) - 2*FSNC2*(WTRT2N(N,L,NR,NZ,NY,NX)-RCZR)*FWOODN(1) - PSNC(M,1,L,NZ,NY,NX)=PSNC(M,1,L,NZ,NY,NX)+CFOPP(4,M,NZ,NY,NX) - 2*FSNC2*(WTRT2P(N,L,NR,NZ,NY,NX)-RCPR)*FWOODP(1) -6350 CONTINUE -C -C CONSUMPTION OF NON-STRUCTURAL C,N,P BY SECONDARY ROOT -C - CPOOLR(N,L,NZ,NY,NX)=CPOOLR(N,L,NZ,NY,NX)-AMIN1(RMNCR,RCO2R) - 2-CGROR-CNRDA-SNCR+FSNC2*RCCR - ZPOOLR(N,L,NZ,NY,NX)=ZPOOLR(N,L,NZ,NY,NX)-ZADD2+FSNC2*RCZR - PPOOLR(N,L,NZ,NY,NX)=PPOOLR(N,L,NZ,NY,NX)-PADD2+FSNC2*RCPR -C -C TOTAL SECONDARY ROOT RESPIRATION -C - RCO2TM=AMIN1(RMNCR,RCO2RM)+RCO2GM+SNCRM+CNRDM - RCO2T=AMIN1(RMNCR,RCO2R)+RCO2G+SNCR+CNRDA - RCO2M(N,L,NZ,NY,NX)=RCO2M(N,L,NZ,NY,NX)+RCO2TM - RCO2N(N,L,NZ,NY,NX)=RCO2N(N,L,NZ,NY,NX)+RCO2T - RCO2A(N,L,NZ,NY,NX)=RCO2A(N,L,NZ,NY,NX)-RCO2T -C -C SECONDARY ROOT EXTENSION FROM ROOT GROWTH AND ROOT TURGOR -C - GRTLGL=GRTWTG*RTLG2X(N,NZ,NY,NX)*WFNR*FWOOD(1) - 2-FSNC2*RTLG2(N,L,NR,NZ,NY,NX) - GRTWTL=GRTWTG-FSNC2*WTRT2(N,L,NR,NZ,NY,NX) - GRTWTN=ZADD2-FSNC2*WTRT2N(N,L,NR,NZ,NY,NX) - GRTWTP=PADD2-FSNC2*WTRT2P(N,L,NR,NZ,NY,NX) -C -C UPDATE STATE VARIABLES FOR SECONDARY ROOT LENGTH, C, N, P -C AND AXIS NUMBER -C - RTLG2(N,L,NR,NZ,NY,NX)=RTLG2(N,L,NR,NZ,NY,NX)+GRTLGL - WTRT2(N,L,NR,NZ,NY,NX)=WTRT2(N,L,NR,NZ,NY,NX)+GRTWTL - WTRT2N(N,L,NR,NZ,NY,NX)=WTRT2N(N,L,NR,NZ,NY,NX)+GRTWTN - WTRT2P(N,L,NR,NZ,NY,NX)=WTRT2P(N,L,NR,NZ,NY,NX)+GRTWTP - WSRTL(N,L,NZ,NY,NX)=WSRTL(N,L,NZ,NY,NX) - 2+AMIN1(CNWS(NZ,NY,NX)*WTRT2N(N,L,NR,NZ,NY,NX) - 2,CPWS(NZ,NY,NX)*WTRT2P(N,L,NR,NZ,NY,NX)) - RTLGL=RTLGL+RTLG2(N,L,NR,NZ,NY,NX) - WTRTX=WTRTX+WTRT2(N,L,NR,NZ,NY,NX) - RTN2X=RTFQ(NZ,NY,NX)*XRTN1 - RTN2Y=RTFQ(NZ,NY,NX)*RTN2X - RTN2(N,L,NR,NZ,NY,NX)=RTN2X+RTN2Y - RTNL(N,L,NZ,NY,NX)=RTNL(N,L,NZ,NY,NX)+RTN2(N,L,NR,NZ,NY,NX) -C IF(L.EQ.1)THEN -C WRITE(*,9876)'RCO22',I,J,NZ,NR,L,N -C 2,RCO2TM,RCO2T,RMNCR,RCO2RM,RCO2R,RCO2GM,RCO2G -C 3,RCO2XM,RCO2X,CGROR,SNCRM,SNCR,CNRDA,CPOOLR(N,L,NZ,NY,NX),FRTN -C 4,TFN4(L,NZ,NY,NX),CNPG,FDBKX(NB1(NZ,NY,NX),NZ,NY,NX),WFNGR(N,L) -C 5,TFN6(L),GRTWTG,GRTWTL,GRTLGL,RTLG2(N,L,NR,NZ,NY,NX) -C 5,WTRT2(N,L,NR,NZ,NY,NX),RTLG2(N,L,NR,NZ,NY,NX) -C 4,RCO2M(N,L,NZ,NY,NX),RCO2A(N,L,NZ,NY,NX),WFR(N,L,NZ,NY,NX) -C 8,ZPOOLR(N,L,NZ,NY,NX),PPOOLR(N,L,NZ,NY,NX) -C 9,FSNC2,RLNT(N,L),RTSK1(N,L,NR),RTSK2(N,L,NR) -C 4,RTN2X,RTN2Y,XRTN1 -C 5,RTDPL(NR,L),RTDNP(N,L,NZ,NY,NX) -C 5,RTDP1(1,NR,NZ,NY,NX),CDPTHZ(L-1,NY,NX),DLYR(3,L,NY,NX) -C 6,SDPTH(NZ,NY,NX),HTCTL(NZ,NY,NX) -C 5,WFNRG,FNP,RTLGP(N,L,NZ,NY,NX),ZADD2,PADD2,CUPRO,CUPRL -C 7,RUPNH4(N,L,NZ,NY,NX),RUPNHB(N,L,NZ,NY,NX) -C 8,RUPNO3(N,L,NZ,NY,NX),RUPNOB(N,L,NZ,NY,NX) -C 9,RUPH2P(N,L,NZ,NY,NX),RUPH2B(N,L,NZ,NY,NX) -C 6,RDFOMN(N,L,NZ,NY,NX),RDFOMP(N,L,NZ,NY,NX) -C 2,RTN1(N,L,NZ,NY,NX),RTN2(N,L,NR,NZ,NY,NX) -C 3,RTNL(N,L,NZ,NY,NX) -9876 FORMAT(A8,6I4,100E12.4) -C ENDIF -C -C PRIMARY ROOT EXTENSION -C - IF(N.EQ.1)THEN - IF(RTDP1(N,NR,NZ,NY,NX).GT.CDPTHZ(L-1,NY,NX) - 2.AND.ICHK1(N,NR).EQ.0)THEN - RTN1(N,L,NZ,NY,NX)=RTN1(N,L,NZ,NY,NX)+XRTN1 - IF(RTDP1(N,NR,NZ,NY,NX).LE.CDPTHZ(L,NY,NX))THEN - ICHK1(N,NR)=1 -C -C FRACTION OF PRIMARY ROOT SINK IN SOIL LAYER ATTRIBUTED TO CURRENT AXIS -C - IF(RLNT(N,L).GT.ZEROP(NZ,NY,NX))THEN - FRTN=RTSK1(N,L,NR)/RLNT(N,L) - ELSE - FRTN=1.0 - ENDIF -C -C WATER STRESS CONSTRAINT ON SECONDARY ROOT EXTENSION IMPOSED -C BY ROOT TURGOR AND SOIL PENETRATION RESISTANCE -C - RSCS1=RSCS(L,NY,NX)*RRAD1(N,L,NZ,NY,NX)/1.0E-03 - WFNR=AMIN1(1.0,AMAX1(0.0,PSIRG(N,L,NZ,NY,NX)-PSILM-RSCS1)) - WFNRG=WFNR**0.25 -C -C N,P CONSTRAINT ON PRIMARY ROOT RESPIRATION FROM -C NON-STRUCTURAL C:N:P -C - IF(CCPOLR(N,L,NZ,NY,NX).GT.ZERO)THEN - CNPG=AMIN1(CZPOLR(N,L,NZ,NY,NX)/(CZPOLR(N,L,NZ,NY,NX) - 2+CCPOLR(N,L,NZ,NY,NX)/CNKI),CPPOLR(N,L,NZ,NY,NX) - 3/(CPPOLR(N,L,NZ,NY,NX)+CCPOLR(N,L,NZ,NY,NX)/CPKI)) - ELSE - CNPG=1.0 - ENDIF -C -C O2-UNLIMITED PRIMARY ROOT RESPIRATION FROM ROOT NON-STRUCTURAL C -C CONSTRAINED BY TEMPERATURE AND NON-STRUCTURAL C:N:P -C - RCO2RM=AMAX1(0.0,VMXC*FRTN*CPOOLR(N,L,NZ,NY,NX) - 2*TFN4(L,NZ,NY,NX))*CNPG*FDBKX(NB1(NZ,NY,NX),NZ,NY,NX) - 3*WFNGR(N,L) -C -C O2-LIMITED PRIMARY ROOT RESPIRATION FROM 'WFR' IN 'UPTAKE' -C - RCO2R=RCO2RM*WFR(N,L,NZ,NY,NX) -C -C PRIMARY ROOT MAINTENANCE RESPIRATION FROM SOIL TEMPERATURE, -C ROOT STRUCTURAL N -C - RMNCR=AMAX1(0.0,RMPLT*RTWT1N(N,NR,NZ,NY,NX))*TFN6(L) - IF(IWTYP(NZ,NY,NX).EQ.2)THEN - RMNCR=RMNCR*WFNGR(N,L) - ENDIF - RCO2XM=RCO2RM-RMNCR - RCO2X=RCO2R-RMNCR - RCO2YM=AMAX1(0.0,RCO2XM)*WFNRG - RCO2Y=AMAX1(0.0,RCO2X)*WFNRG -C -C PRIMARY ROOT GROWTH RESPIRATION MAY BE LIMITED BY -C NON-STRUCTURAL N,P AVAILABLE FOR GROWTH -C - DMRTR=DMRTD*FRTN - ZPOOLB=AMAX1(0.0,ZPOOLR(N,L,NZ,NY,NX)) - PPOOLB=AMAX1(0.0,PPOOLR(N,L,NZ,NY,NX)) - FNP=AMIN1(ZPOOLB*DMRTR/CNRTS(NZ,NY,NX) - 2,PPOOLB*DMRTR/CPRTS(NZ,NY,NX)) - IF(RCO2YM.GT.0.0)THEN - RCO2GM=AMIN1(RCO2YM,FNP) - ELSE - RCO2GM=0.0 - ENDIF - IF(RCO2Y.GT.0.0)THEN - RCO2G=AMIN1(RCO2Y,FNP*WFR(N,L,NZ,NY,NX)) - ELSE - RCO2G=0.0 - ENDIF -C -C TOTAL NON-STRUCTURAL C,N,P USED IN PRIMARY ROOT GROWTH -C AND GROWTH RESPIRATION DEPENDS ON GROWTH YIELD -C ENTERED IN 'READQ' -C - CGRORM=RCO2GM/DMRTD - CGROR=RCO2G/DMRTD - GRTWGM=CGRORM*DMRT(NZ,NY,NX) - GRTWTG=CGROR*DMRT(NZ,NY,NX) - ZADD1M=AMAX1(0.0,GRTWGM*CNRTW) - ZADD1=AMAX1(0.0,AMIN1(FRTN*ZPOOLR(N,L,NZ,NY,NX),GRTWTG*CNRTW)) - PADD1=AMAX1(0.0,AMIN1(FRTN*PPOOLR(N,L,NZ,NY,NX),GRTWTG*CPRTW)) - CNRDM=AMAX1(0.0,1.70*ZADD1M) - CNRDA=AMAX1(0.0,1.70*ZADD1) -C -C PRIMARY ROOT GROWTH RESPIRATION FROM TOTAL - MAINTENANCE -C IF > 0 DRIVES GROWTH, IF < 0 DRIVES REMOBILIZATION, ALSO -C PRIMARY ROOT C LOSS FROM REMOBILIZATION AND CONSEQUENT LITTERFALL -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) - 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) - ELSE - CCC=0.0 - CNC=0.0 - CPC=0.0 - ENDIF - RCCC=RCCZ(IBTYP(NZ,NY,NX))+CCC*RCCY(IBTYP(NZ,NY,NX)) - RCCN=CNC*RCCX(IGTYP(NZ,NY,NX)) - RCCP=CPC*RCCQ(IGTYP(NZ,NY,NX)) - IF(-RCO2XM.GT.0.0)THEN - IF(-RCO2XM.LT.RTWT1(N,NR,NZ,NY,NX)*RCCC)THEN - SNCRM=-RCO2XM - ELSE - SNCRM=AMAX1(0.0,RTWT1(N,NR,NZ,NY,NX)*RCCC) - ENDIF - ELSE - SNCRM=0.0 - ENDIF - IF(-RCO2X.GT.0.0)THEN - IF(-RCO2X.LT.RTWT1(N,NR,NZ,NY,NX)*RCCC)THEN - SNCR=-RCO2X - ELSE - SNCR=AMAX1(0.0,RTWT1(N,NR,NZ,NY,NX)*RCCC) - 2*WFR(N,L,NZ,NY,NX) - ENDIF - ELSE - SNCR=0.0 - ENDIF -C -C RECOVERY OF REMOBILIZABLE N,P DURING PRIMARY ROOT REMOBILIZATION -C DEPENDS ON ROOT NON-STRUCTURAL C:N:P -C - IF(SNCR.GT.0.0.AND.RTWT1(N,NR,NZ,NY,NX) - 2.GT.ZEROP(NZ,NY,NX))THEN - RCCR=RCCC*RTWT1(N,NR,NZ,NY,NX) - RCZR=RTWT1N(N,NR,NZ,NY,NX)*(RCCN+(1.0-RCCN) - 2*RCCR/RTWT1(N,NR,NZ,NY,NX)) - RCPR=RTWT1P(N,NR,NZ,NY,NX)*(RCCP+(1.0-RCCP) - 2*RCCR/RTWT1(N,NR,NZ,NY,NX)) - IF(RCCR.GT.ZEROP(NZ,NY,NX))THEN - FSNC1=AMAX1(0.0,AMIN1(1.0,SNCR/RCCR)) - ELSE - FSNC1=1.0 - ENDIF - ELSE - RCCR=0.0 - RCZR=0.0 - RCPR=0.0 - FSNC1=0.0 - ENDIF -C -C PRIMARY ROOT LITTERFALL CAUSED BY REMOBILIZATION -C - DO 6355 M=1,4 - CSNC(M,0,L,NZ,NY,NX)=CSNC(M,0,L,NZ,NY,NX)+CFOPC(5,M,NZ,NY,NX) - 2*FSNC1*(RTWT1(N,NR,NZ,NY,NX)-RCCR)*FWOOD(0) - ZSNC(M,0,L,NZ,NY,NX)=ZSNC(M,0,L,NZ,NY,NX)+CFOPN(5,M,NZ,NY,NX) - 2*FSNC1*(RTWT1N(N,NR,NZ,NY,NX)-RCZR)*FWOODN(0) - PSNC(M,0,L,NZ,NY,NX)=PSNC(M,0,L,NZ,NY,NX)+CFOPP(5,M,NZ,NY,NX) - 2*FSNC1*(RTWT1P(N,NR,NZ,NY,NX)-RCPR)*FWOODP(0) - CSNC(M,1,L,NZ,NY,NX)=CSNC(M,1,L,NZ,NY,NX)+CFOPC(4,M,NZ,NY,NX) - 2*FSNC1*(RTWT1(N,NR,NZ,NY,NX)-RCCR)*FWOOD(1) - ZSNC(M,1,L,NZ,NY,NX)=ZSNC(M,1,L,NZ,NY,NX)+CFOPN(4,M,NZ,NY,NX) - 2*FSNC1*(RTWT1N(N,NR,NZ,NY,NX)-RCZR)*FWOODN(1) - PSNC(M,1,L,NZ,NY,NX)=PSNC(M,1,L,NZ,NY,NX)+CFOPP(4,M,NZ,NY,NX) - 2*FSNC1*(RTWT1P(N,NR,NZ,NY,NX)-RCPR)*FWOODP(1) -6355 CONTINUE -C -C CONSUMPTION OF NON-STRUCTURAL C,N,P BY PRIMARY ROOTS -C - CPOOLR(N,L,NZ,NY,NX)=CPOOLR(N,L,NZ,NY,NX)-AMIN1(RMNCR,RCO2R) - 2-CGROR-CNRDA-SNCR+FSNC1*RCCR - ZPOOLR(N,L,NZ,NY,NX)=ZPOOLR(N,L,NZ,NY,NX)-ZADD1+FSNC1*RCZR - PPOOLR(N,L,NZ,NY,NX)=PPOOLR(N,L,NZ,NY,NX)-PADD1+FSNC1*RCPR -C -C TOTAL PRIMARY ROOT RESPIRATION -C - RCO2TM=AMIN1(RMNCR,RCO2RM)+RCO2GM+SNCRM+CNRDM - RCO2T=AMIN1(RMNCR,RCO2R)+RCO2G+SNCR+CNRDA -C -C ALLOCATE PRIMARY ROOT TOTAL RESPIRATION TO ALL SOIL LAYERS -C THROUGH WHICH PRIMARY ROOTS GROW -C - IF(RTDP1(N,NR,NZ,NY,NX).GT.CDPTHZ(NG(NZ,NY,NX),NY,NX))THEN - DO 5100 LL=NG(NZ,NY,NX),NINR(NR,NZ,NY,NX) - FRCO2=RTLG1(N,LL,NR,NZ,NY,NX)/(RTDP1(N,NR,NZ,NY,NX) - 2-SDPTH(NZ,NY,NX)) - RCO2M(N,LL,NZ,NY,NX)=RCO2M(N,LL,NZ,NY,NX)+RCO2TM*FRCO2 - RCO2N(N,LL,NZ,NY,NX)=RCO2N(N,LL,NZ,NY,NX)+RCO2T*FRCO2 - RCO2A(N,LL,NZ,NY,NX)=RCO2A(N,LL,NZ,NY,NX)-RCO2T*FRCO2 -5100 CONTINUE - ELSE - RCO2M(N,L,NZ,NY,NX)=RCO2M(N,L,NZ,NY,NX)+RCO2TM - RCO2N(N,L,NZ,NY,NX)=RCO2N(N,L,NZ,NY,NX)+RCO2T - RCO2A(N,L,NZ,NY,NX)=RCO2A(N,L,NZ,NY,NX)-RCO2T - ENDIF -C -C ALLOCATE ANY NEGATIVE PRIMARY ROOT C,N,P GROWTH TO SECONDARY -C ROOTS ON THE SAME AXIS IN THE SAME LAYER UNTIL SECONDARY ROOTS -C HAVE DISAPPEARED -C - GRTWTL=GRTWTG-FSNC1*RTWT1(N,NR,NZ,NY,NX) - GRTWTN=ZADD1-FSNC1*RTWT1N(N,NR,NZ,NY,NX) - GRTWTP=PADD1-FSNC1*RTWT1P(N,NR,NZ,NY,NX) - IF(GRTWTL.LT.0.0)THEN - LX=MAX(1,L-1) - DO 5105 LL=L,LX,-1 - GRTWTM=GRTWTL - IF(GRTWTL.LT.0.0)THEN - IF(GRTWTL.GT.-WTRT2(N,LL,NR,NZ,NY,NX))THEN - RTLG2(N,LL,NR,NZ,NY,NX)=RTLG2(N,LL,NR,NZ,NY,NX)+GRTWTL - 2*RTLG2(N,LL,NR,NZ,NY,NX)/WTRT2(N,LL,NR,NZ,NY,NX) - WTRT2(N,LL,NR,NZ,NY,NX)=WTRT2(N,LL,NR,NZ,NY,NX)+GRTWTL - GRTWTL=0.0 - ELSE - GRTWTL=GRTWTL+WTRT2(N,LL,NR,NZ,NY,NX) - RTLG2(N,LL,NR,NZ,NY,NX)=0.0 - WTRT2(N,LL,NR,NZ,NY,NX)=0.0 - ENDIF - ENDIF - IF(GRTWTN.LT.0.0)THEN - IF(GRTWTN.GT.-WTRT2N(N,LL,NR,NZ,NY,NX))THEN - WTRT2N(N,LL,NR,NZ,NY,NX)=WTRT2N(N,LL,NR,NZ,NY,NX)+GRTWTN - GRTWTN=0.0 - ELSE - GRTWTN=GRTWTN+WTRT2N(N,LL,NR,NZ,NY,NX) - WTRT2N(N,LL,NR,NZ,NY,NX)=0.0 - ENDIF - ENDIF - IF(GRTWTP.LT.0.0)THEN - IF(GRTWTP.GT.-WTRT2P(N,LL,NR,NZ,NY,NX))THEN - WTRT2P(N,LL,NR,NZ,NY,NX)=WTRT2P(N,LL,NR,NZ,NY,NX)+GRTWTP - GRTWTP=0.0 - ELSE - GRTWTP=GRTWTP+WTRT2P(N,LL,NR,NZ,NY,NX) - WTRT2P(N,LL,NR,NZ,NY,NX)=0.0 - ENDIF - ENDIF -C WRITE(*,9876)'WTRT2',I,J,NZ,NR,LL,N -C 2,GRTWTL,GRTWTM,GRTWTG,FSNC1,SNCR,RCCR,RTWT1(N,NR,NZ,NY,NX) -C 3,WTRT2(1,LL,NR,NZ,NY,NX),WTRTL(1,LL,NZ,NY,NX) -C 3,WTRT2(2,LL,NR,NZ,NY,NX),WTRTL(2,LL,NZ,NY,NX) -C 4,RTLG2(1,LL,NR,NZ,NY,NX),RTLG1(1,LL,NR,NZ,NY,NX) -C 4,RTLG2(2,LL,NR,NZ,NY,NX),RTLG1(2,LL,NR,NZ,NY,NX) -C -C CONCURRENT LOSS OF MYCORRHIZAE AND NODULES -C - IF(GRTWTM.LT.0.0)THEN - IF(WTRT2(1,LL,NR,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - FSNCM=AMIN1(1.0,ABS(GRTWTM)/WTRT2(1,LL,NR,NZ,NY,NX)) - ELSE - FSNCM=1.0 - ENDIF - IF(WTRTL(1,LL,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - FSNCP=AMIN1(1.0,ABS(GRTWTM)/WTRTL(1,LL,NZ,NY,NX)) - ELSE - FSNCP=1.0 - ENDIF - DO 6450 M=1,4 - CSNC(M,0,LL,NZ,NY,NX)=CSNC(M,0,LL,NZ,NY,NX)+CFOPC(5,M,NZ,NY,NX) - 2*FSNCM*AMAX1(0.0,WTRT2(2,LL,NR,NZ,NY,NX))*FWOOD(0) - ZSNC(M,0,LL,NZ,NY,NX)=ZSNC(M,0,LL,NZ,NY,NX)+CFOPN(5,M,NZ,NY,NX) - 2*FSNCM*AMAX1(0.0,WTRT2N(2,LL,NR,NZ,NY,NX))*FWOODN(0) - PSNC(M,0,LL,NZ,NY,NX)=PSNC(M,0,LL,NZ,NY,NX)+CFOPP(5,M,NZ,NY,NX) - 2*FSNCM*AMAX1(0.0,WTRT2P(2,LL,NR,NZ,NY,NX))*FWOODP(0) - CSNC(M,1,LL,NZ,NY,NX)=CSNC(M,1,LL,NZ,NY,NX)+CFOPC(4,M,NZ,NY,NX) - 2*FSNCM*AMAX1(0.0,WTRT2(2,LL,NR,NZ,NY,NX))*FWOOD(1) - ZSNC(M,1,LL,NZ,NY,NX)=ZSNC(M,1,LL,NZ,NY,NX)+CFOPN(4,M,NZ,NY,NX) - 2*FSNCM*AMAX1(0.0,WTRT2N(2,LL,NR,NZ,NY,NX))*FWOODN(1) - PSNC(M,1,LL,NZ,NY,NX)=PSNC(M,1,LL,NZ,NY,NX)+CFOPP(4,M,NZ,NY,NX) - 2*FSNCM*AMAX1(0.0,WTRT2P(2,LL,NR,NZ,NY,NX))*FWOODP(1) - CSNC(M,1,LL,NZ,NY,NX)=CSNC(M,1,LL,NZ,NY,NX)+CFOPC(0,M,NZ,NY,NX) - 2*FSNCP*AMAX1(0.0,CPOOLR(2,LL,NZ,NY,NX)) - ZSNC(M,1,LL,NZ,NY,NX)=ZSNC(M,1,LL,NZ,NY,NX)+CFOPN(0,M,NZ,NY,NX) - 2*FSNCP*AMAX1(0.0,ZPOOLR(2,LL,NZ,NY,NX)) - PSNC(M,1,LL,NZ,NY,NX)=PSNC(M,1,LL,NZ,NY,NX)+CFOPP(0,M,NZ,NY,NX) - 2*FSNCP*AMAX1(0.0,PPOOLR(2,LL,NZ,NY,NX)) -6450 CONTINUE - RTLG2(2,LL,NR,NZ,NY,NX)=AMAX1(0.0,RTLG2(2,LL,NR,NZ,NY,NX)) - 2*(1.0-FSNCM) - WTRT2(2,LL,NR,NZ,NY,NX)=AMAX1(0.0,WTRT2(2,LL,NR,NZ,NY,NX)) - 2*(1.0-FSNCM) - WTRT2N(2,LL,NR,NZ,NY,NX)=AMAX1(0.0,WTRT2N(2,LL,NR,NZ,NY,NX)) - 2*(1.0-FSNCM) - WTRT2P(2,LL,NR,NZ,NY,NX)=AMAX1(0.0,WTRT2P(2,LL,NR,NZ,NY,NX)) - 2*(1.0-FSNCM) - CPOOLR(2,LL,NZ,NY,NX)=AMAX1(0.0,CPOOLR(2,LL,NZ,NY,NX)) - 2*(1.0-FSNCP) - ZPOOLR(2,LL,NZ,NY,NX)=AMAX1(0.0,ZPOOLR(2,LL,NZ,NY,NX)) - 2*(1.0-FSNCP) - PPOOLR(2,LL,NZ,NY,NX)=AMAX1(0.0,PPOOLR(2,LL,NZ,NY,NX)) - 2*(1.0-FSNCP) - ENDIF -5105 CONTINUE - ENDIF -C -C PRIMARY ROOT EXTENSION FROM ROOT GROWTH AND ROOT TURGOR -C - IF(GRTWTL.LT.0.0.AND.RTWT1(N,NR,NZ,NY,NX) - 2.GT.ZEROP(NZ,NY,NX))THEN - GRTLGL=GRTWTG*RTLG1X(N,NZ,NY,NX)/PP(NZ,NY,NX)*WFNR*FWOOD(1) - 2+GRTWTL*(RTDP1(N,NR,NZ,NY,NX)-SDPTH(NZ,NY,NX)) - 3/RTWT1(N,NR,NZ,NY,NX) - ELSE - GRTLGL=GRTWTG*RTLG1X(N,NZ,NY,NX)/PP(NZ,NY,NX)*WFNR*FWOOD(1) - ENDIF - IF(L.LT.NJ(NY,NX))THEN - GRTLGL=AMIN1(DLYR(3,L+1,NY,NX),GRTLGL) - ENDIF -C -C ALLOCATE PRIMARY ROOT GROWTH TO CURRENT -C AND NEXT SOIL LAYER WHEN PRIMARY ROOTS EXTEND ACROSS LOWER -C BOUNDARY OF CURRENT LAYER -C - IF(GRTLGL.GT.ZEROP(NZ,NY,NX).AND.L.LT.NJ(NY,NX))THEN - FGROL=AMAX1(0.0,AMIN1(1.0,(CDPTHZ(L,NY,NX) - 2-RTDP1(N,NR,NZ,NY,NX))/GRTLGL)) - IF(FGROL.LT.1.0)FGROL=0.0 - FGROZ=AMAX1(0.0,1.0-FGROL) - ELSE - FGROL=1.0 - FGROZ=0.0 - ENDIF -C -C UPDATE STATE VARIABLES FOR PRIMARY ROOT LENGTH, GROWTH -C AND AXIS NUMBER -C - RTWT1(N,NR,NZ,NY,NX)=RTWT1(N,NR,NZ,NY,NX)+GRTWTL - RTWT1N(N,NR,NZ,NY,NX)=RTWT1N(N,NR,NZ,NY,NX)+GRTWTN - RTWT1P(N,NR,NZ,NY,NX)=RTWT1P(N,NR,NZ,NY,NX)+GRTWTP - RTDP1(N,NR,NZ,NY,NX)=RTDP1(N,NR,NZ,NY,NX)+GRTLGL - WTRT1(N,L,NR,NZ,NY,NX)=WTRT1(N,L,NR,NZ,NY,NX)+GRTWTL*FGROL - WTRT1N(N,L,NR,NZ,NY,NX)=WTRT1N(N,L,NR,NZ,NY,NX)+GRTWTN*FGROL - WTRT1P(N,L,NR,NZ,NY,NX)=WTRT1P(N,L,NR,NZ,NY,NX)+GRTWTP*FGROL - WSRTL(N,L,NZ,NY,NX)=WSRTL(N,L,NZ,NY,NX) - 2+AMIN1(CNWS(NZ,NY,NX)*WTRT1N(N,L,NR,NZ,NY,NX) - 2,CPWS(NZ,NY,NX)*WTRT1P(N,L,NR,NZ,NY,NX)) - RTLG1(N,L,NR,NZ,NY,NX)=RTLG1(N,L,NR,NZ,NY,NX)+GRTLGL*FGROL -C -C TRANSFER C,N,P INTO NEXT SOIL LAYER -C WHEN PRIMARY ROOT EXTENDS ACROSS LOWER BOUNDARY -C OF CURRENT SOIL LAYER -C - IF(FGROZ.GT.0.0)THEN - WTRT1(N,L+1,NR,NZ,NY,NX)=WTRT1(N,L+1,NR,NZ,NY,NX) - 2+GRTWTL*FGROZ - WTRT1N(N,L+1,NR,NZ,NY,NX)=WTRT1N(N,L+1,NR,NZ,NY,NX) - 2+GRTWTN*FGROZ - WTRT1P(N,L+1,NR,NZ,NY,NX)=WTRT1P(N,L+1,NR,NZ,NY,NX) - 2+GRTWTP*FGROZ - WSRTL(N,L+1,NZ,NY,NX)=WSRTL(N,L+1,NZ,NY,NX) - 2+AMIN1(CNWS(NZ,NY,NX)*WTRT1N(N,L+1,NR,NZ,NY,NX) - 2,CPWS(NZ,NY,NX)*WTRT1P(N,L+1,NR,NZ,NY,NX)) - WTRTD(N,L+1,NZ,NY,NX)=WTRTD(N,L+1,NZ,NY,NX) - 2+WTRT1(N,L+1,NR,NZ,NY,NX) - RTLG1(N,L+1,NR,NZ,NY,NX)=RTLG1(N,L+1,NR,NZ,NY,NX)+GRTLGL*FGROZ - RRAD1(N,L+1,NZ,NY,NX)=RRAD1(N,L,NZ,NY,NX) - RTLGZ=RTLGZ+RTLG1(N,L+1,NR,NZ,NY,NX) - WTRTZ=WTRTZ+WTRT1(N,L+1,NR,NZ,NY,NX) - XFRC=FRTN*CPOOLR(N,L,NZ,NY,NX) - XFRN=FRTN*ZPOOLR(N,L,NZ,NY,NX) - XFRP=FRTN*PPOOLR(N,L,NZ,NY,NX) - CPOOLR(N,L,NZ,NY,NX)=CPOOLR(N,L,NZ,NY,NX)-XFRC - ZPOOLR(N,L,NZ,NY,NX)=ZPOOLR(N,L,NZ,NY,NX)-XFRN - PPOOLR(N,L,NZ,NY,NX)=PPOOLR(N,L,NZ,NY,NX)-XFRP - CPOOLR(N,L+1,NZ,NY,NX)=CPOOLR(N,L+1,NZ,NY,NX)+XFRC - ZPOOLR(N,L+1,NZ,NY,NX)=ZPOOLR(N,L+1,NZ,NY,NX)+XFRN - PPOOLR(N,L+1,NZ,NY,NX)=PPOOLR(N,L+1,NZ,NY,NX)+XFRP - PSIRT(N,L+1,NZ,NY,NX)=PSIRT(N,L,NZ,NY,NX) - PSIRO(N,L+1,NZ,NY,NX)=PSIRO(N,L,NZ,NY,NX) - PSIRG(N,L+1,NZ,NY,NX)=PSIRG(N,L,NZ,NY,NX) - NINR(NR,NZ,NY,NX)=MAX(NG(NZ,NY,NX),L+1) -C WRITE(*,9877)'INFIL',I,J,NZ,NR,L,N,NINR(NR,NZ,NY,NX) -C 2,FRTN,WTRTD(N,L+1,NZ,NY,NX),CPOOLR(N,L+1,NZ,NY,NX) -C 2,FGROZ,RTDP1(N,NR,NZ,NY,NX),GRTLGL,CDPTHZ(L,NY,NX) - ENDIF -C IF((I/10)*10.EQ.I.AND.J.EQ.14.AND.NZ.EQ.1)THEN -C WRITE(*,9877)'RCO21',I,J,NZ,NR,L,N,NINR(NR,NZ,NY,NX) -C 2,RCO2TM,RCO2T,RMNCR,RCO2RM,RCO2R,RCO2GM,RCO2G -C 3,RCO2XM,RCO2X,CGROR,SNCRM,SNCR,CNRDA,CPOOLR(N,L,NZ,NY,NX),FRTN -C 4,TFN4(L,NZ,NY,NX),CNPG,FDBKX(NB1(NZ,NY,NX),NZ,NY,NX),WFNGR(N,L) -C 5,TFN6(L),GRTWTG,GRTWTL,GRTLGL,RTWT1N(N,NR,NZ,NY,NX) -C 6,WTRT1(N,L,NR,NZ,NY,NX),RTDP1(N,NR,NZ,NY,NX) -C 3,RCO2M(N,L,NZ,NY,NX),RCO2A(N,L,NZ,NY,NX),WFR(N,L,NZ,NY,NX) -C 4,RTSK1(N,L,NR),RRAD1(N,L,NZ,NY,NX),RTDPP -C 5,PSIRG(N,L,NZ,NY,NX),WFNR,WFNRG,FWOOD(1) -C 6,RTDP1(N,NR,NZ,NY,NX),FGROZ,RTWT1(N,NR,NZ,NY,NX),FSNC1 -C 9,ZADD1,PADD1,ZPOOLR(N,L,NZ,NY,NX),PPOOLR(N,L,NZ,NY,NX) -C 1,RUPNH4(N,L,NZ,NY,NX),RUPNO3(N,L,NZ,NY,NX) -9877 FORMAT(A8,7I4,100E12.4) -C ENDIF - ENDIF -C -C TRANSFER PRIMARY ROOT C,N,P TO NEXT SOIL LAYER ABOVE THE -C CURRENT SOIL LAYER WHEN NEGATIVE PRIMARY ROOT GROWTH FORCES -C WITHDRAWAL FROM THE CURRENT SOIL LAYER AND ALL SECONDARY ROOTS -C IN THE CURRENT SOIL LAYER HAVE BEEN LOST -C - IF(L.EQ.NINR(NR,NZ,NY,NX))THEN - DO 5115 LL=L,NG(NZ,NY,NX)+1,-1 - IF(RTDP1(N,NR,NZ,NY,NX).LT.CDPTHZ(LL-1,NY,NX) - 2.OR.RTDP1(N,NR,NZ,NY,NX).LT.SDPTH(NZ,NY,NX))THEN - IF(RLNT(N,LL).GT.ZEROP(NZ,NY,NX))THEN - FRTN=(RTSK1(N,LL,NR)+RTSK2(N,LL,NR))/RLNT(N,LL) - ELSE - FRTN=1.0 - ENDIF - DO 5110 NN=1,MY(NZ,NY,NX) - WTRT1(NN,LL-1,NR,NZ,NY,NX)=WTRT1(NN,LL-1,NR,NZ,NY,NX) - 2+WTRT1(NN,LL,NR,NZ,NY,NX) - WTRT1N(NN,LL-1,NR,NZ,NY,NX)=WTRT1N(NN,LL-1,NR,NZ,NY,NX) - 2+WTRT1N(NN,LL,NR,NZ,NY,NX) - WTRT1P(NN,LL-1,NR,NZ,NY,NX)=WTRT1P(NN,LL-1,NR,NZ,NY,NX) - 2+WTRT1P(NN,LL,NR,NZ,NY,NX) - WTRT2(NN,LL-1,NR,NZ,NY,NX)=WTRT2(NN,LL-1,NR,NZ,NY,NX) - 2+WTRT2(NN,LL,NR,NZ,NY,NX) - WTRT2N(NN,LL-1,NR,NZ,NY,NX)=WTRT2N(NN,LL-1,NR,NZ,NY,NX) - 2+WTRT2N(NN,LL,NR,NZ,NY,NX) - WTRT2P(NN,LL-1,NR,NZ,NY,NX)=WTRT2P(NN,LL-1,NR,NZ,NY,NX) - 2+WTRT2P(NN,LL,NR,NZ,NY,NX) - RTLG1(NN,LL-1,NR,NZ,NY,NX)=RTLG1(NN,LL-1,NR,NZ,NY,NX) - 2+RTLG1(NN,LL,NR,NZ,NY,NX) - WTRT1(NN,LL,NR,NZ,NY,NX)=0.0 - WTRT1N(NN,LL,NR,NZ,NY,NX)=0.0 - WTRT1P(NN,LL,NR,NZ,NY,NX)=0.0 - WTRT2(NN,LL,NR,NZ,NY,NX)=0.0 - WTRT2N(NN,LL,NR,NZ,NY,NX)=0.0 - WTRT2P(NN,LL,NR,NZ,NY,NX)=0.0 - RTLG1(NN,LL,NR,NZ,NY,NX)=0.0 - XFRC=FRTN*CPOOLR(NN,LL,NZ,NY,NX) - XFRN=FRTN*ZPOOLR(NN,LL,NZ,NY,NX) - XFRP=FRTN*PPOOLR(NN,LL,NZ,NY,NX) - XFRW=FRTN*WSRTL(NN,L,NZ,NY,NX) - XFRD=FRTN*WTRTD(NN,LL,NZ,NY,NX) - CPOOLR(NN,LL,NZ,NY,NX)=CPOOLR(NN,LL,NZ,NY,NX)-XFRC - ZPOOLR(NN,LL,NZ,NY,NX)=ZPOOLR(NN,LL,NZ,NY,NX)-XFRN - PPOOLR(NN,LL,NZ,NY,NX)=PPOOLR(NN,LL,NZ,NY,NX)-XFRP - WSRTL(NN,LL,NZ,NY,NX)=WSRTL(NN,LL,NZ,NY,NX)-XFRW - WTRTD(NN,LL,NZ,NY,NX)=WTRTD(NN,LL,NZ,NY,NX)-XFRD - CPOOLR(NN,LL-1,NZ,NY,NX)=CPOOLR(NN,LL-1,NZ,NY,NX)+XFRC - ZPOOLR(NN,LL-1,NZ,NY,NX)=ZPOOLR(NN,LL-1,NZ,NY,NX)+XFRN - PPOOLR(NN,LL-1,NZ,NY,NX)=PPOOLR(NN,LL-1,NZ,NY,NX)+XFRP - WSRTL(NN,LL-1,NZ,NY,NX)=WSRTL(NN,LL-1,NZ,NY,NX)+XFRW - WTRTD(NN,LL-1,NZ,NY,NX)=WTRTD(NN,LL-1,NZ,NY,NX)+XFRD -C -C WITHDRAW GASES IN PRIMARY ROOTS -C - RCO2Z(NZ,NY,NX)=RCO2Z(NZ,NY,NX)-FRTN*(CO2A(NN,LL,NZ,NY,NX) - 2+CO2P(NN,LL,NZ,NY,NX)) - ROXYZ(NZ,NY,NX)=ROXYZ(NZ,NY,NX)-FRTN*(OXYA(NN,LL,NZ,NY,NX) - 2+OXYP(NN,LL,NZ,NY,NX)) - RCH4Z(NZ,NY,NX)=RCH4Z(NZ,NY,NX)-FRTN*(CH4A(NN,LL,NZ,NY,NX) - 2+CH4P(NN,LL,NZ,NY,NX)) - RN2OZ(NZ,NY,NX)=RN2OZ(NZ,NY,NX)-FRTN*(Z2OA(NN,LL,NZ,NY,NX) - 2+Z2OP(NN,LL,NZ,NY,NX)) - RNH3Z(NZ,NY,NX)=RNH3Z(NZ,NY,NX)-FRTN*(ZH3A(NN,LL,NZ,NY,NX) - 2+ZH3P(NN,LL,NZ,NY,NX)) - RH2GZ(NZ,NY,NX)=RH2GZ(NZ,NY,NX)-FRTN*(H2GA(NN,LL,NZ,NY,NX) - 2+H2GP(NN,LL,NZ,NY,NX)) - CO2A(NN,LL,NZ,NY,NX)=(1.0-FRTN)*CO2A(NN,LL,NZ,NY,NX) - OXYA(NN,LL,NZ,NY,NX)=(1.0-FRTN)*OXYA(NN,LL,NZ,NY,NX) - CH4A(NN,LL,NZ,NY,NX)=(1.0-FRTN)*CH4A(NN,LL,NZ,NY,NX) - Z2OA(NN,LL,NZ,NY,NX)=(1.0-FRTN)*Z2OA(NN,LL,NZ,NY,NX) - ZH3A(NN,LL,NZ,NY,NX)=(1.0-FRTN)*ZH3A(NN,LL,NZ,NY,NX) - H2GA(NN,LL,NZ,NY,NX)=(1.0-FRTN)*H2GA(NN,LL,NZ,NY,NX) - CO2P(NN,LL,NZ,NY,NX)=(1.0-FRTN)*CO2P(NN,LL,NZ,NY,NX) - OXYP(NN,LL,NZ,NY,NX)=(1.0-FRTN)*OXYP(NN,LL,NZ,NY,NX) - CH4P(NN,LL,NZ,NY,NX)=(1.0-FRTN)*CH4P(NN,LL,NZ,NY,NX) - Z2OP(NN,LL,NZ,NY,NX)=(1.0-FRTN)*Z2OP(NN,LL,NZ,NY,NX) - ZH3P(NN,LL,NZ,NY,NX)=(1.0-FRTN)*ZH3P(NN,LL,NZ,NY,NX) - H2GP(NN,LL,NZ,NY,NX)=(1.0-FRTN)*H2GP(NN,LL,NZ,NY,NX) -C IF(NZ.EQ.1.OR.NZ.EQ.4)THEN -C WRITE(*,9868)'WITHDR',I,J,NZ,NR,LL,NN,NINR(NR,NZ,NY,NX) -C 2,FRTN,RTSK1(N,LL,NR),RTSK2(N,LL,NR),RLNT(N,LL) -C 2,WTRTD(NN,LL-1,NZ,NY,NX),WTRTD(NN,LL,NZ,NY,NX) -C 2,RTLG1(NN,LL-1,NR,NZ,NY,NX),RTLG1(NN,LL,NR,NZ,NY,NX) -C 2,RTLG2(NN,LL-1,NR,NZ,NY,NX),RTLG2(NN,LL,NR,NZ,NY,NX) -C 3,RTDP1(N,NR,NZ,NY,NX),RTDP1(NN,NR,NZ,NY,NX) -C 4,CPOOLR(NN,LL-1,NZ,NY,NX),CPOOLR(NN,LL,NZ,NY,NX) -C 4,WTRT1(NN,LL-1,NR,NZ,NY,NX),WTRT1(NN,LL,NR,NZ,NY,NX) -C 4,WTRT2(NN,LL-1,NR,NZ,NY,NX),WTRT2(NN,LL,NR,NZ,NY,NX) -9868 FORMAT(A8,7I4,100E24.16) -C ENDIF -5110 CONTINUE - RTNL(N,LL,NZ,NY,NX)=RTNL(N,LL,NZ,NY,NX) - 2-RTN2(N,LL,NR,NZ,NY,NX) - RTNL(N,LL-1,NZ,NY,NX)=RTNL(N,LL-1,NZ,NY,NX) - 2+RTN2(N,LL,NR,NZ,NY,NX) - RTN2(N,LL,NR,NZ,NY,NX)=0.0 - RTN1(N,LL,NZ,NY,NX)=RTN1(N,LL,NZ,NY,NX)-XRTN1 -C -C RESET PRIMARY ROOT LENGTH -C - IF(LL-1.GT.NG(NZ,NY,NX))THEN - RTLG1(N,LL-1,NR,NZ,NY,NX)=DLYR(3,LL-1,NY,NX) - 2-(CDPTHZ(LL-1,NY,NX)-RTDP1(N,NR,NZ,NY,NX)) - ELSE - RTLG1(N,LL-1,NR,NZ,NY,NX)=DLYR(3,LL-1,NY,NX) - 2-(CDPTHZ(LL-1,NY,NX)-RTDP1(N,NR,NZ,NY,NX)) - 3-(SDPTH(NZ,NY,NX)-CDPTHZ(LL-2,NY,NX)) - ENDIF -C -C REMOBILIZE C,N,P FROM ROOT NODULES IN LEGUMES -C - IF(INTYP(NZ,NY,NX).EQ.1.OR.INTYP(NZ,NY,NX).EQ.2)THEN - XFRC=FRTN*WTNDL(LL,NZ,NY,NX) - XFRN=FRTN*WTNDLN(LL,NZ,NY,NX) - XFRP=FRTN*WTNDLP(LL,NZ,NY,NX) - WTNDL(LL,NZ,NY,NX)=WTNDL(LL,NZ,NY,NX)-XFRC - WTNDLN(LL,NZ,NY,NX)=WTNDLN(LL,NZ,NY,NX)-XFRN - WTNDLP(LL,NZ,NY,NX)=WTNDLP(LL,NZ,NY,NX)-XFRP - WTNDL(LL-1,NZ,NY,NX)=WTNDL(LL-1,NZ,NY,NX)+XFRC - WTNDLN(LL-1,NZ,NY,NX)=WTNDLN(LL-1,NZ,NY,NX)+XFRN - WTNDLP(LL-1,NZ,NY,NX)=WTNDLP(LL-1,NZ,NY,NX)+XFRP - XFRC=FRTN*CPOOLN(LL,NZ,NY,NX) - XFRN=FRTN*ZPOOLN(LL,NZ,NY,NX) - XFRP=FRTN*PPOOLN(LL,NZ,NY,NX) - CPOOLN(LL,NZ,NY,NX)=CPOOLN(LL,NZ,NY,NX)-XFRC - ZPOOLN(LL,NZ,NY,NX)=ZPOOLN(LL,NZ,NY,NX)-XFRN - PPOOLN(LL,NZ,NY,NX)=PPOOLN(LL,NZ,NY,NX)-XFRP - CPOOLN(LL-1,NZ,NY,NX)=CPOOLN(LL-1,NZ,NY,NX)+XFRC - ZPOOLN(LL-1,NZ,NY,NX)=ZPOOLN(LL-1,NZ,NY,NX)+XFRN - PPOOLN(LL-1,NZ,NY,NX)=PPOOLN(LL-1,NZ,NY,NX)+XFRP -C WRITE(*,9868)'WITHDRN',I,J,NZ,NR,LL,NN,NINR(NR,NZ,NY,NX) -C 2,WTNDL(LL,NZ,NY,NX),CPOOLN(LL,NZ,NY,NX),RTDP1(N,NR,NZ,NY,NX) - ENDIF - NINR(NR,NZ,NY,NX)=MAX(NG(NZ,NY,NX),LL-1) - ELSE - GO TO 5120 - ENDIF -5115 CONTINUE - ENDIF -5120 CONTINUE - IF(WTRT1(N,L,NR,NZ,NY,NX).LT.0.0)THEN - CPOOLR(N,L,NZ,NY,NX)=CPOOLR(N,L,NZ,NY,NX)+WTRT1(N,L,NR,NZ,NY,NX) - WTRT1(N,L,NR,NZ,NY,NX)=0.0 - ENDIF - IF(WTRT2(N,L,NR,NZ,NY,NX).LT.0.0)THEN - CPOOLR(N,L,NZ,NY,NX)=CPOOLR(N,L,NZ,NY,NX)+WTRT2(N,L,NR,NZ,NY,NX) - WTRT2(N,L,NR,NZ,NY,NX)=0.0 - ENDIF -C -C TOTAL ROOT LENGTH AND MASS -C - RTLGZ=RTLGZ+RTLG1(N,L,NR,NZ,NY,NX) - WTRTZ=WTRTZ+WTRT1(N,L,NR,NZ,NY,NX) - NINR(NR,NZ,NY,NX)=MIN(NINR(NR,NZ,NY,NX),NJ(NY,NX)) - IF(L.EQ.NINR(NR,NZ,NY,NX))NRX(N,NR)=1 - ENDIF - ENDIF - RTLGZ=RTLGZ+RTLG1(N,L,NR,NZ,NY,NX) - WTRTZ=WTRTZ+WTRT1(N,L,NR,NZ,NY,NX) -C ENDIF - ENDIF - NIX(NZ,NY,NX)=MAX(NIX(NZ,NY,NX),NINR(NR,NZ,NY,NX)) -5050 CONTINUE -C -C DRAW FROM ROOT NON-STRUCTURAL POOL WHEN -C SEASONAL STORAGE POOL IS DEPLETED -C - IF(L.LE.NIX(NZ,NY,NX))THEN - IF(WTRTL(N,L,NZ,NY,NX).GT.ZEROP(NZ,NY,NX) - 2.AND.WTRT(NZ,NY,NX).GT.ZEROP(NZ,NY,NX) - 2.AND.WTRVC(NZ,NY,NX).LT.XFRX*WTRT(NZ,NY,NX))THEN - FWTRT=WTRTL(N,L,NZ,NY,NX)/WTRT(NZ,NY,NX) - WTRTLX=WTRTL(N,L,NZ,NY,NX) - WTRTTX=WTRT(NZ,NY,NX)*FWTRT - WTRTTT=WTRTLX+WTRTTX - CPOOLX=AMAX1(0.0,CPOOLR(N,L,NZ,NY,NX)) - WTRVCX=AMAX1(0.0,WTRVC(NZ,NY,NX)*FWTRT) - CPOOLD=(WTRVCX*WTRTLX-CPOOLX*WTRTTX)/WTRTTT - XFRC=AMIN1(0.0,XFRY*CPOOLD) - CPOOLR(N,L,NZ,NY,NX)=CPOOLR(N,L,NZ,NY,NX)+XFRC - WTRVC(NZ,NY,NX)=WTRVC(NZ,NY,NX)-XFRC -C WRITE(*,3471)'RVC',I,J,NX,NY,NZ,L -C 2,XFRC,CPOOLR(N,L,NZ,NY,NX),WTRTD(N,L,NZ,NY,NX) -C 3,WTRVC(NZ,NY,NX),WTRT(NZ,NY,NX),FWTRT -3471 FORMAT(A8,6I4,12E12.4) - ENDIF - ENDIF -C -C ROOT AND MYCORRHIZAL LENGTH, DENSITY, VOLUME, RADIUS, AREA -C TO CALCULATE WATER AND NUTRIENT UPTAKE IN 'UPTAKE' -C - IF(N.EQ.1)THEN - RTLGZ=RTLGZ*FWOOD(1) - RTLGL=RTLGL*FWOOD(1) - ENDIF - RTLGX=RTLGZ*PP(NZ,NY,NX) - RTLGT=RTLGL+RTLGX - WTRTT=WTRTX+WTRTZ - IF(RTLGT.GT.ZEROP(NZ,NY,NX).AND.WTRTT.GT.ZEROP(NZ,NY,NX) - 2.AND.PP(NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - RTLGP(N,L,NZ,NY,NX)=RTLGT/PP(NZ,NY,NX) - RTDNP(N,L,NZ,NY,NX)=RTLGP(N,L,NZ,NY,NX)/DLYR(3,L,NY,NX) - RTVL=AMAX1(RTAR1X(N,NZ,NY,NX)*RTLGX+RTAR2X(N,NZ,NY,NX)*RTLGL - 2,WTRTT*DMVL(N,NZ,NY,NX)*PSIRG(N,L,NZ,NY,NX)) - RTVLP(N,L,NZ,NY,NX)=PORT(N,NZ,NY,NX)*RTVL - RTVLW(N,L,NZ,NY,NX)=(1.0-PORT(N,NZ,NY,NX))*RTVL - RRAD1(N,L,NZ,NY,NX)=AMAX1(RRAD1X(N,NZ,NY,NX) - 2,(1.0+PSIRT(N,L,NZ,NY,NX)/EMODR)*RRAD1M(N,NZ,NY,NX)) - RRAD2(N,L,NZ,NY,NX)=AMAX1(RRAD2X(N,NZ,NY,NX) - 2,(1.0+PSIRT(N,L,NZ,NY,NX)/EMODR)*RRAD2M(N,NZ,NY,NX)) - RTAR=6.283*RRAD1(N,L,NZ,NY,NX)*RTLGX - 2+6.283*RRAD2(N,L,NZ,NY,NX)*RTLGL - RTARP(N,L,NZ,NY,NX)=RTAR/PP(NZ,NY,NX) - IF(RTNL(N,L,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - RTLGA(N,L,NZ,NY,NX)=AMAX1(RTLGAX,RTLGL/RTNL(N,L,NZ,NY,NX)) - ELSE - RTLGA(N,L,NZ,NY,NX)=RTLGAX - ENDIF - ELSE - RTLGP(N,L,NZ,NY,NX)=0.0 - RTDNP(N,L,NZ,NY,NX)=0.0 - RTVLP(N,L,NZ,NY,NX)=0.0 - RTVLW(N,L,NZ,NY,NX)=0.0 - RRAD1(N,L,NZ,NY,NX)=RRAD1M(N,NZ,NY,NX) - RRAD2(N,L,NZ,NY,NX)=RRAD2M(N,NZ,NY,NX) - RTARP(N,L,NZ,NY,NX)=0.0 - RTLGA(N,L,NZ,NY,NX)=RTLGAX - RCO2Z(NZ,NY,NX)=RCO2Z(NZ,NY,NX)-(CO2A(N,L,NZ,NY,NX) - 2+CO2P(N,L,NZ,NY,NX)) - ROXYZ(NZ,NY,NX)=ROXYZ(NZ,NY,NX)-(OXYA(N,L,NZ,NY,NX) - 2+OXYP(N,L,NZ,NY,NX)) - RCH4Z(NZ,NY,NX)=RCH4Z(NZ,NY,NX)-(CH4A(N,L,NZ,NY,NX) - 2+CH4P(N,L,NZ,NY,NX)) - RN2OZ(NZ,NY,NX)=RN2OZ(NZ,NY,NX)-(Z2OA(N,L,NZ,NY,NX) - 2+Z2OP(N,L,NZ,NY,NX)) - RNH3Z(NZ,NY,NX)=RNH3Z(NZ,NY,NX)-(ZH3A(N,L,NZ,NY,NX) - 2+ZH3P(N,L,NZ,NY,NX)) - RH2GZ(NZ,NY,NX)=RH2GZ(NZ,NY,NX)-(H2GA(N,L,NZ,NY,NX) - 2+H2GP(N,L,NZ,NY,NX)) - CO2A(N,L,NZ,NY,NX)=0.0 - OXYA(N,L,NZ,NY,NX)=0.0 - CH4A(N,L,NZ,NY,NX)=0.0 - Z2OA(N,L,NZ,NY,NX)=0.0 - ZH3A(N,L,NZ,NY,NX)=0.0 - H2GA(N,L,NZ,NY,NX)=0.0 - CO2P(N,L,NZ,NY,NX)=0.0 - OXYP(N,L,NZ,NY,NX)=0.0 - CH4P(N,L,NZ,NY,NX)=0.0 - Z2OP(N,L,NZ,NY,NX)=0.0 - ZH3P(N,L,NZ,NY,NX)=0.0 - H2GP(N,L,NZ,NY,NX)=0.0 - ENDIF -5000 CONTINUE -5010 CONTINUE -C -C ADD SEED DIMENSIONS TO ROOT DIMENSIONS (ONLY IMPORTANT DURING -C GERMINATION) -C - RTLGP(1,NG(NZ,NY,NX),NZ,NY,NX)=RTLGP(1,NG(NZ,NY,NX),NZ,NY,NX) - 2+SDLG(NZ,NY,NX) - RTDNP(1,NG(NZ,NY,NX),NZ,NY,NX)=RTLGP(1,NG(NZ,NY,NX),NZ,NY,NX) - 2/DLYR(3,NG(NZ,NY,NX),NY,NX) - RTVL=RTVLP(1,NG(NZ,NY,NX),NZ,NY,NX)+RTVLW(1,NG(NZ,NY,NX),NZ,NY,NX) - 2+SDVL(NZ,NY,NX)*PP(NZ,NY,NX) - RTVLP(1,NG(NZ,NY,NX),NZ,NY,NX)=PORT(1,NZ,NY,NX)*RTVL - RTVLW(1,NG(NZ,NY,NX),NZ,NY,NX)=(1.0-PORT(1,NZ,NY,NX))*RTVL - RTARP(1,NG(NZ,NY,NX),NZ,NY,NX)=RTARP(1,NG(NZ,NY,NX),NZ,NY,NX) - 2+SDAR(NZ,NY,NX) - IF(IDTHRN.EQ.NRT(NZ,NY,NX).OR.(WTRVC(NZ,NY,NX) - 2.LT.ZEROL(NZ,NY,NX).AND.ISTYP(NZ,NY,NX).NE.0))THEN - IDTHR(NZ,NY,NX)=1 - IDTHP(NZ,NY,NX)=1 - ENDIF -C -C ROOT N2 FIXATION (LEGUMES) -C - IF((INTYP(NZ,NY,NX).EQ.1.OR.INTYP(NZ,NY,NX).EQ.2))THEN - DO 5400 L=NU(NY,NX),NIX(NZ,NY,NX) - IF(WTRTD(1,L,NZ,NY,NX).GT.ZEROL(NZ,NY,NX))THEN -C -C INITIAL INFECTION -C - IF(WTNDL(L,NZ,NY,NX).LE.0.0)THEN - WTNDL(L,NZ,NY,NX)=WTNDL(L,NZ,NY,NX) - 2+WTNDI*AREA(3,NU(NY,NX),NY,NX) - WTNDLN(L,NZ,NY,NX)=WTNDLN(L,NZ,NY,NX) - 2+WTNDI*AREA(3,NU(NY,NX),NY,NX)*CNND(NZ,NY,NX) - WTNDLP(L,NZ,NY,NX)=WTNDLP(L,NZ,NY,NX) - 2+WTNDI*AREA(3,NU(NY,NX),NY,NX)*CPND(NZ,NY,NX) - ENDIF -C -C O2-UNCONSTRAINED RESPIRATION RATES BY HETEROTROPHIC AEROBES -C IN NODULE FROM SPECIFIC OXIDATION RATE, ACTIVE BIOMASS, -C NON-STRUCTURAL C CONCENTRATION, MICROBIAL C:N:P FACTOR, -C AND TEMPERATURE -C - IF(WTNDL(L,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - CCPOLN=AMAX1(0.0,CPOOLN(L,NZ,NY,NX)/WTNDL(L,NZ,NY,NX)) - CZPOLN=AMAX1(0.0,ZPOOLN(L,NZ,NY,NX)/WTNDL(L,NZ,NY,NX)) - CPPOLN=AMAX1(0.0,PPOOLN(L,NZ,NY,NX)/WTNDL(L,NZ,NY,NX)) - ELSE - CCPOLN=1.0 - CZPOLN=1.0 - 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) - ELSE - CCC=0.0 - CNC=0.0 - CPC=0.0 - CNF=0.0 - ENDIF - IF(WTNDL(L,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - FCNPF=AMIN1(1.0,AMAX1(0.0 - 2,WTNDLN(L,NZ,NY,NX)/(WTNDL(L,NZ,NY,NX)*CNND(NZ,NY,NX)) - 3,WTNDLP(L,NZ,NY,NX)/(WTNDL(L,NZ,NY,NX)*CPND(NZ,NY,NX)))) - ELSE - FCNPF=1.0 - ENDIF - RDNDLX=CCPOLN/(CCPOLN+CCNKX) - RCNDLM=AMAX1(0.0,AMIN1(CPOOLN(L,NZ,NY,NX)*(1.0-DMND(NZ,NY,NX)) - 2,VMXO*WTNDL(L,NZ,NY,NX)*CCPOLN/(CCPOLN+CCNKM) - 3*TFN4(L,NZ,NY,NX)*FCNPF*WFNGR(1,L)))*CNF -C -C O2-LIMITED NODULE RESPIRATION FROM 'WFR' IN 'UPTAKE' -C - RCNDL=RCNDLM*WFR(1,L,NZ,NY,NX) -C -C NODULE MAINTENANCE RESPIRATION FROM SOIL TEMPERATURE, -C NODULE STRUCTURAL N -C - RMNDL=AMAX1(0.0,RMPLT*WTNDLN(L,NZ,NY,NX))*TFN6(L)*RDNDLX -C -C NODULE GROWTH RESPIRATION FROM TOTAL - MAINTENANCE -C IF > 0 DRIVES GROWTH, IF < 0 DRIVES REMOBILIZATION -C - RXNDLM=RCNDLM-RMNDL - RXNDL=RCNDL-RMNDL - RGNDLM=AMAX1(0.0,RXNDLM) - RGNDL=AMAX1(0.0,RXNDL) - RSNDLM=AMAX1(0.0,-RXNDLM) - RSNDL=AMAX1(0.0,-RXNDL) -C -C NODULE N2 FIXATION FROM GROWTH RESPIRATION, FIXATION ENERGY -C REQUIREMENT AND NON-STRUCTURAL C:N:P PRODUCT INHIBITION, -C CONSTRAINED BY MICROBIAL N REQUIREMENT -C - RGN2P=AMAX1(0.0,WTNDL(L,NZ,NY,NX)*CNND(NZ,NY,NX) - 2-WTNDLN(L,NZ,NY,NX))/EN2F - RGN2F=AMIN1(RGNDL,RGN2P) - RUPNF(L,NZ,NY,NX)=RGN2F*EN2F - UPNF(NZ,NY,NX)=UPNF(NZ,NY,NX)+RUPNF(L,NZ,NY,NX) -C -C TOTAL NON-STRUCTURAL C,N,P USED IN NODULE GROWTH -C AND GROWTH RESPIRATION DEPENDS ON GROWTH YIELD ENTERED IN 'READQ' -C - CGNDL=(RGNDL-RGN2F)/(1.0-DMND(NZ,NY,NX)) - GRNDG=CGNDL*DMND(NZ,NY,NX) - ZADDN=AMAX1(0.0,AMIN1(ZPOOLN(L,NZ,NY,NX) - 2,GRNDG*CNND(NZ,NY,NX))*CCC) - PADDN=AMAX1(0.0,AMIN1(PPOOLN(L,NZ,NY,NX) - 2,GRNDG*CPND(NZ,NY,NX))*CCC) -C -C NODULE C,N,P REMOBILIZATION AND DECOMPOSITION -C - RCCC=RCCZ(IBTYP(NZ,NY,NX))+CCC*RCCY(IBTYP(NZ,NY,NX)) - RCCN=CNC*RCCX(IGTYP(NZ,NY,NX)) - RCCP=CPC*RCCQ(IGTYP(NZ,NY,NX)) - SPNDX=SPNDL*RDNDLX - RXNDLC=SPNDX*WTNDL(L,NZ,NY,NX)*WFNGR(1,L) - RXNDLN=SPNDX*WTNDLN(L,NZ,NY,NX)*WFNGR(1,L) - RXNDLP=SPNDX*WTNDLP(L,NZ,NY,NX)*WFNGR(1,L) - RDNDLC=RXNDLC*(1.0-RCCC) - RDNDLN=RXNDLN*(1.0-RCCN)*(1.0-RCCC) - RDNDLP=RXNDLP*(1.0-RCCP)*(1.0-RCCC) - RCNDLC=RXNDLC-RDNDLC - RCNDLN=RXNDLN-RDNDLN - RCNDLP=RXNDLP-RDNDLP -C -C NODULE SENESCENCE -C - IF(RSNDL.GT.0.0.AND.WTNDL(L,NZ,NY,NX).GT.ZEROP(NZ,NY,NX) - 2.AND.RCCC.GT.ZERO)THEN - RXNSNC=RSNDL/RCCC - RXNSNN=RXNSNC*WTNDLN(L,NZ,NY,NX)/WTNDL(L,NZ,NY,NX) - RXNSNP=RXNSNC*WTNDLP(L,NZ,NY,NX)/WTNDL(L,NZ,NY,NX) - RDNSNC=RXNSNC*(1.0-RCCC) - RDNSNN=RXNSNN*(1.0-RCCN)*(1.0-RCCC) - RDNSNP=RXNSNP*(1.0-RCCP)*(1.0-RCCC) - RCNSNC=RXNSNC-RDNSNC - RCNSNN=RXNSNN-RDNSNN - RCNSNP=RXNSNP-RDNSNP - ELSE - RXNSNC=0.0 - RXNSNN=0.0 - RXNSNP=0.0 - RDNSNC=0.0 - RDNSNN=0.0 - RDNSNP=0.0 - RCNSNC=0.0 - RCNSNN=0.0 - RCNSNP=0.0 - ENDIF -C -C TOTAL NODULE RESPIRATION -C - RCO2TM=AMIN1(RMNDL,RCNDLM)+RGNDLM+RCNSNC - RCO2T=AMIN1(RMNDL,RCNDL)+RGNDL+RCNSNC - RCO2M(1,L,NZ,NY,NX)=RCO2M(1,L,NZ,NY,NX)+RCO2TM - RCO2N(1,L,NZ,NY,NX)=RCO2N(1,L,NZ,NY,NX)+RCO2T - RCO2A(1,L,NZ,NY,NX)=RCO2A(1,L,NZ,NY,NX)-RCO2T -C -C NODULE LITTERFALL CAUSED BY REMOBILIZATION -C - DO 6370 M=1,4 - CSNC(M,1,L,NZ,NY,NX)=CSNC(M,1,L,NZ,NY,NX)+CFOPC(4,M,NZ,NY,NX) - 2*(RDNDLC+RDNSNC) - ZSNC(M,1,L,NZ,NY,NX)=ZSNC(M,1,L,NZ,NY,NX)+CFOPN(4,M,NZ,NY,NX) - 2*(RDNDLN+RDNSNN) - PSNC(M,1,L,NZ,NY,NX)=PSNC(M,1,L,NZ,NY,NX)+CFOPP(4,M,NZ,NY,NX) - 2*(RDNDLP+RDNSNP) -6370 CONTINUE -C -C CONSUMPTION OF NON-STRUCTURAL C,N,P BY NODULE -C - CPOOLN(L,NZ,NY,NX)=CPOOLN(L,NZ,NY,NX)-AMIN1(RMNDL,RCNDL) - 2-RGN2F-CGNDL+RCNDLC - ZPOOLN(L,NZ,NY,NX)=ZPOOLN(L,NZ,NY,NX)-ZADDN+RCNDLN+RCNSNN - 2+RUPNF(L,NZ,NY,NX) - PPOOLN(L,NZ,NY,NX)=PPOOLN(L,NZ,NY,NX)-PADDN+RCNDLP+RCNSNP -C -C UPDATE STATE VARIABLES FOR NODULE C, N, P -C - WTNDL(L,NZ,NY,NX)=WTNDL(L,NZ,NY,NX)+GRNDG-RXNDLC-RXNSNC - WTNDLN(L,NZ,NY,NX)=WTNDLN(L,NZ,NY,NX)+ZADDN-RXNDLN-RXNSNN - WTNDLP(L,NZ,NY,NX)=WTNDLP(L,NZ,NY,NX)+PADDN-RXNDLP-RXNSNP -C -C TRANSFER NON-STRUCTURAL C,N,P BETWEEN ROOT AND NODULES -C FROM NON-STRUCTURAL C,N,P CONCENTRATION DIFFERENCES -C - IF(CPOOLR(1,L,NZ,NY,NX).GT.ZEROP(NZ,NY,NX) - 2.AND.WTRTD(1,L,NZ,NY,NX).GT.ZEROL(NZ,NY,NX))THEN - WTRTD1=WTRTD(1,L,NZ,NY,NX) - WTNDL1=AMIN1(WTRTD(1,L,NZ,NY,NX),AMAX1(FSNKM - 2*WTRTD(1,L,NZ,NY,NX),WTNDL(L,NZ,NY,NX))) - WTRTDT=WTRTD1+WTRTD2 - IF(WTRTDT.GT.ZEROP(NZ,NY,NX))THEN - CPOOLD=(CPOOLR(1,L,NZ,NY,NX)*WTNDL1 - 2-CPOOLN(L,NZ,NY,NX)*WTRTD1)/WTRTDT - XFRC=FXRN(INTYP(NZ,NY,NX))*CPOOLD - CPOOLR(1,L,NZ,NY,NX)=CPOOLR(1,L,NZ,NY,NX)-XFRC - CPOOLN(L,NZ,NY,NX)=CPOOLN(L,NZ,NY,NX)+XFRC - CPOOLT=CPOOLR(1,L,NZ,NY,NX)+CPOOLN(L,NZ,NY,NX) - IF(CPOOLT.GT.ZEROP(NZ,NY,NX))THEN - ZPOOLD=(ZPOOLR(1,L,NZ,NY,NX)*CPOOLN(L,NZ,NY,NX) - 2-ZPOOLN(L,NZ,NY,NX)*CPOOLR(1,L,NZ,NY,NX))/CPOOLT - XFRN=FXRN(INTYP(NZ,NY,NX))*ZPOOLD - PPOOLD=(PPOOLR(1,L,NZ,NY,NX)*CPOOLN(L,NZ,NY,NX) - 2-PPOOLN(L,NZ,NY,NX)*CPOOLR(1,L,NZ,NY,NX))/CPOOLT - XFRP=FXRN(INTYP(NZ,NY,NX))*PPOOLD - ZPOOLR(1,L,NZ,NY,NX)=ZPOOLR(1,L,NZ,NY,NX)-XFRN - PPOOLR(1,L,NZ,NY,NX)=PPOOLR(1,L,NZ,NY,NX)-XFRP - ZPOOLN(L,NZ,NY,NX)=ZPOOLN(L,NZ,NY,NX)+XFRN - PPOOLN(L,NZ,NY,NX)=PPOOLN(L,NZ,NY,NX)+XFRP -C IF(L.EQ.1)THEN -C WRITE(*,2122)'NODEX',I,J,NZ,L,XFRC,XFRN,XFRP -C 3,WTRTD(1,L,NZ,NY,NX),WTRTDT,CPOOLT -C 4,WTNDL(L,NZ,NY,NX),WTNDLN(L,NZ,NY,NX),WTNDLP(L,NZ,NY,NX) -C 2,CPOOLN(L,NZ,NY,NX),ZPOOLN(L,NZ,NY,NX),PPOOLN(L,NZ,NY,NX) -C 3,CPOOLR(1,L,NZ,NY,NX),ZPOOLR(1,L,NZ,NY,NX),PPOOLR(1,L,NZ,NY,NX) -C ENDIF - ENDIF - ENDIF - ENDIF -C IF(L.EQ.1)THEN -C WRITE(*,2122)'NODGR',I,J,NZ,L,RCNDL,RMNDL,RGNDL,RGN2P -C 2,RGN2F,CGNDL,GRNDG,CCC,ZADDN,PADDN,SNCR,RCCC,RCCN,RCCP -C 8,FSNCN,RCCO,RDNDLC,RDNDLN,RDNDLP,WFR(1,L,NZ,NY,NX) -C 3,WTNDL(L,NZ,NY,NX),WTNDLN(L,NZ,NY,NX),WTNDLP(L,NZ,NY,NX) -C 2,CPOOLN(L,NZ,NY,NX),ZPOOLN(L,NZ,NY,NX),PPOOLN(L,NZ,NY,NX) -C 5,FCNPF,TFN4(L,NZ,NY,NX),WFNGR(1,L) -2122 FORMAT(A8,4I4,60E24.16) -C ENDIF - ENDIF -5400 CONTINUE - ENDIF -C -C TRANSFER NON-STRUCTURAL C,N,P AMONG BRANCH LEAVES -C FROM NON-STRUCTURAL C,N,P CONCENTRATION DIFFERENCES -C WHEN SEASONAL STORAGE C IS NOT BEING MOBILIZED -C - IF(NBR(NZ,NY,NX).GT.1)THEN - WTPLTT=0.0 - CPOOLT=0.0 - ZPOOLT=0.0 - PPOOLT=0.0 - DO 300 NB=1,NBR(NZ,NY,NX) - IF(IDTHB(NB,NZ,NY,NX).EQ.0)THEN - IF(ATRP(NB,NZ,NY,NX).GT.ATRPX)THEN - WTLSBZ(NB)=AMAX1(0.0,WTLSB(NB,NZ,NY,NX)) - CPOOLZ(NB)=AMAX1(0.0,CPOOL(NB,NZ,NY,NX)) - ZPOOLZ(NB)=AMAX1(0.0,ZPOOL(NB,NZ,NY,NX)) - PPOOLZ(NB)=AMAX1(0.0,PPOOL(NB,NZ,NY,NX)) - WTPLTT=WTPLTT+WTLSBZ(NB) - CPOOLT=CPOOLT+CPOOLZ(NB) - ZPOOLT=ZPOOLT+ZPOOLZ(NB) - PPOOLT=PPOOLT+PPOOLZ(NB) - ENDIF - ENDIF -300 CONTINUE - DO 305 NB=1,NBR(NZ,NY,NX) - IF(IDTHB(NB,NZ,NY,NX).EQ.0)THEN - IF(ATRP(NB,NZ,NY,NX).GT.ATRPX)THEN - IF(WTPLTT.GT.ZEROP(NZ,NY,NX) - 2.AND.CPOOLT.GT.ZEROP(NZ,NY,NX))THEN - CPOOLD=CPOOLT*WTLSBZ(NB)-CPOOLZ(NB)*WTPLTT - ZPOOLD=ZPOOLT*CPOOLZ(NB)-ZPOOLZ(NB)*CPOOLT - PPOOLD=PPOOLT*CPOOLZ(NB)-PPOOLZ(NB)*CPOOLT - XFRC=0.01*CPOOLD/WTPLTT - XFRN=0.01*ZPOOLD/CPOOLT - XFRP=0.01*PPOOLD/CPOOLT - CPOOL(NB,NZ,NY,NX)=CPOOL(NB,NZ,NY,NX)+XFRC - ZPOOL(NB,NZ,NY,NX)=ZPOOL(NB,NZ,NY,NX)+XFRN - PPOOL(NB,NZ,NY,NX)=PPOOL(NB,NZ,NY,NX)+XFRP - ENDIF - ENDIF - ENDIF -305 CONTINUE - ENDIF -C -C TRANSFER NON-STRUCTURAL C,N,P AMONG BRANCH STALK RESERVES -C FROM NON-STRUCTURAL C,N,P CONCENTRATION DIFFERENCES -C - IF(NBR(NZ,NY,NX).GT.1)THEN - WTSTKT=0.0 - WTRSVT=0.0 - WTRSNT=0.0 - WTRSPT=0.0 - DO 330 NB=1,NBR(NZ,NY,NX) - IF(IDTHB(NB,NZ,NY,NX).EQ.0)THEN - IF(IDAY(7,NB,NZ,NY,NX).NE.0)THEN - WTSTKT=WTSTKT+WVSTKB(NB,NZ,NY,NX) - WTRSVT=WTRSVT+WTRSVB(NB,NZ,NY,NX) - WTRSNT=WTRSNT+WTRSBN(NB,NZ,NY,NX) - WTRSPT=WTRSPT+WTRSBP(NB,NZ,NY,NX) - ENDIF - ENDIF -330 CONTINUE - IF(WTSTKT.GT.ZEROP(NZ,NY,NX) - 2.AND.WTRSVT.GT.ZEROP(NZ,NY,NX))THEN - DO 335 NB=1,NBR(NZ,NY,NX) - IF(IDTHB(NB,NZ,NY,NX).EQ.0)THEN - IF(IDAY(7,NB,NZ,NY,NX).NE.0)THEN - WTRSVD=WTRSVT*WVSTKB(NB,NZ,NY,NX) - 2-WTRSVB(NB,NZ,NY,NX)*WTSTKT - XFRC=0.1*WTRSVD/WTSTKT - WTRSVB(NB,NZ,NY,NX)=WTRSVB(NB,NZ,NY,NX)+XFRC - WTRSND=WTRSNT*WTRSVB(NB,NZ,NY,NX) - 2-WTRSBN(NB,NZ,NY,NX)*WTRSVT - XFRN=0.1*WTRSND/WTRSVT - WTRSBN(NB,NZ,NY,NX)=WTRSBN(NB,NZ,NY,NX)+XFRN - WTRSPD=WTRSPT*WTRSVB(NB,NZ,NY,NX) - 2-WTRSBP(NB,NZ,NY,NX)*WTRSVT - XFRP=0.1*WTRSPD/WTRSVT - WTRSBP(NB,NZ,NY,NX)=WTRSBP(NB,NZ,NY,NX)+XFRP - ENDIF - ENDIF -335 CONTINUE - ENDIF - ENDIF -C -C TRANSFER NON-STRUCTURAL C,N,P BWTWEEN ROOT AND MYCORRHIZAE -C IN EACH ROOTED SOIL LAYER FROM NON-STRUCTURAL C,N,P CONCENTRATION -C DIFFERENCES -C - IF(MY(NZ,NY,NX).EQ.2)THEN - DO 425 L=NU(NY,NX),NIX(NZ,NY,NX) - IF(CPOOLR(1,L,NZ,NY,NX).GT.ZEROP(NZ,NY,NX) - 2.AND.WTRTD(1,L,NZ,NY,NX).GT.ZEROL(NZ,NY,NX))THEN - WTRTD1=WTRTD(1,L,NZ,NY,NX) - WTRTD2=AMIN1(WTRTD(1,L,NZ,NY,NX),AMAX1(FSNKM - 2*WTRTD(1,L,NZ,NY,NX),WTRTD(2,L,NZ,NY,NX))) - WTPLTT=WTRTD1+WTRTD2 - IF(WTPLTT.GT.ZEROP(NZ,NY,NX))THEN - CPOOLD=(CPOOLR(1,L,NZ,NY,NX)*WTRTD2 - 2-CPOOLR(2,L,NZ,NY,NX)*WTRTD1)/WTPLTT - XFRC=FMYC*CPOOLD - CPOOLR(1,L,NZ,NY,NX)=CPOOLR(1,L,NZ,NY,NX)-XFRC - CPOOLR(2,L,NZ,NY,NX)=CPOOLR(2,L,NZ,NY,NX)+XFRC - CPOOLT=CPOOLR(1,L,NZ,NY,NX)+CPOOLR(2,L,NZ,NY,NX) - IF(CPOOLT.GT.ZEROP(NZ,NY,NX))THEN - ZPOOLD=(ZPOOLR(1,L,NZ,NY,NX)*CPOOLR(2,L,NZ,NY,NX) - 2-ZPOOLR(2,L,NZ,NY,NX)*CPOOLR(1,L,NZ,NY,NX))/CPOOLT - XFRN=FMYC*ZPOOLD - PPOOLD=(PPOOLR(1,L,NZ,NY,NX)*CPOOLR(2,L,NZ,NY,NX) - 2-PPOOLR(2,L,NZ,NY,NX)*CPOOLR(1,L,NZ,NY,NX))/CPOOLT - XFRP=FMYC*PPOOLD - ZPOOLR(1,L,NZ,NY,NX)=ZPOOLR(1,L,NZ,NY,NX)-XFRN - ZPOOLR(2,L,NZ,NY,NX)=ZPOOLR(2,L,NZ,NY,NX)+XFRN - PPOOLR(1,L,NZ,NY,NX)=PPOOLR(1,L,NZ,NY,NX)-XFRP - PPOOLR(2,L,NZ,NY,NX)=PPOOLR(2,L,NZ,NY,NX)+XFRP -C IF(L.EQ.NIX(NZ,NY,NX))THEN -C WRITE(*,9873)'MYCO',I,J,NZ,L,XFRC,XFRN,XFRP -C 2,CPOOLR(1,L,NZ,NY,NX),WTRTD(1,L,NZ,NY,NX) -C 3,CPOOLR(2,L,NZ,NY,NX),WTRTD2 -C 3,WTPLTT,ZPOOLR(1,L,NZ,NY,NX),ZPOOLR(2,L,NZ,NY,NX) -C 4,PPOOLR(1,L,NZ,NY,NX),PPOOLR(2,L,NZ,NY,NX),CPOOLT -9873 FORMAT(A8,4I4,20E24.16) -C ENDIF - ENDIF - ENDIF - ENDIF -425 CONTINUE - ENDIF -C -C TRANSFER NON-STRUCTURAL C,N,P BETWEEN ROOT AND STORAGE -C -C IF(IFLGZ.EQ.1.AND.ISTYP(NZ,NY,NX).NE.0)THEN -C DO 5545 N=1,MY(NZ,NY,NX) -C DO 5550 L=NU(NY,NX),NI(NZ,NY,NX) -C IF(CCPOLR(N,L,NZ,NY,NX).GT.ZERO)THEN -C CNL=CCPOLR(N,L,NZ,NY,NX)/(CCPOLR(N,L,NZ,NY,NX) -C 2+CZPOLR(N,L,NZ,NY,NX)*CNKI) -C CPL=CCPOLR(N,L,NZ,NY,NX)/(CCPOLR(N,L,NZ,NY,NX) -C 2+CPPOLR(N,L,NZ,NY,NX)*CPKI) -C ELSE -C CNL=0.0 -C CPL=0.0 -C ENDIF -C XFRCX=FXFB(IBTYP(NZ,NY,NX)) -C 2*AMAX1(0.0,CPOOLR(N,L,NZ,NY,NX)) -C XFRNX=FXFB(IBTYP(NZ,NY,NX)) -C 2*AMAX1(0.0,ZPOOLR(N,L,NZ,NY,NX))*(1.0+CNL) -C XFRPX=FXFB(IBTYP(NZ,NY,NX)) -C 2*AMAX1(0.0,PPOOLR(N,L,NZ,NY,NX))*(1.0+CPL) -C XFRC=AMIN1(XFRCX,XFRNX/CNMN,XFRPX/CPMN) -C XFRN=AMIN1(XFRNX,XFRC*CNMX,XFRPX*CNMX/CPMN*0.5) -C XFRP=AMIN1(XFRPX,XFRC*CPMX,XFRNX*CPMX/CNMN*0.5) -C CPOOLR(N,L,NZ,NY,NX)=CPOOLR(N,L,NZ,NY,NX)-XFRC -C WTRVC(NZ,NY,NX)=WTRVC(NZ,NY,NX)+XFRC -C ZPOOLR(N,L,NZ,NY,NX)=ZPOOLR(N,L,NZ,NY,NX)-XFRN -C WTRVN(NZ,NY,NX)=WTRVN(NZ,NY,NX)+XFRN -C PPOOLR(N,L,NZ,NY,NX)=PPOOLR(N,L,NZ,NY,NX)-XFRP -C WTRVP(NZ,NY,NX)=WTRVP(NZ,NY,NX)+XFRP -5550 CONTINUE -5545 CONTINUE -C ENDIF -C -C ROOT AND NODULE TOTALS -C - DO 5445 N=1,MY(NZ,NY,NX) - DO 5450 L=NU(NY,NX),NI(NZ,NY,NX) - WTRTL(N,L,NZ,NY,NX)=0.0 - WTRTD(N,L,NZ,NY,NX)=0.0 - DO 5460 NR=1,NRT(NZ,NY,NX) - WTRTL(N,L,NZ,NY,NX)=WTRTL(N,L,NZ,NY,NX)+WTRT2(N,L,NR,NZ,NY,NX) - WTRTD(N,L,NZ,NY,NX)=WTRTD(N,L,NZ,NY,NX)+WTRT2(N,L,NR,NZ,NY,NX) - 2+WTRT1(N,L,NR,NZ,NY,NX) -5460 CONTINUE - TCO2T(NZ,NY,NX)=TCO2T(NZ,NY,NX)+RCO2A(N,L,NZ,NY,NX) - RECO(NY,NX)=RECO(NY,NX)+RCO2A(N,L,NZ,NY,NX) - TRAU(NY,NX)=TRAU(NY,NX)+RCO2A(N,L,NZ,NY,NX) -5450 CONTINUE - DO 5470 NR=1,NRT(NZ,NY,NX) - WTRTL(N,NINR(NR,NZ,NY,NX),NZ,NY,NX) - 2=WTRTL(N,NINR(NR,NZ,NY,NX),NZ,NY,NX) - 3+RTWT1(N,NR,NZ,NY,NX) -5470 CONTINUE -5445 CONTINUE -C -C TRANSFER NON-STRUCTURAL C,N,P BETWEEN ROOT AND SHOOT -C -C SINK STRENGTH OF ROOTS IN EACH SOIL LAYER AS A FRACTION -C OF TOTAL SINK STRENGTH OF ROOTS IN ALL SOIL LAYERS -C - IF(ISTYP(NZ,NY,NX).EQ.1)THEN - IF(WTLS(NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - FWTC=AMIN1(1.0,0.667*WTRT(NZ,NY,NX)/WTLS(NZ,NY,NX)) - ELSE - FWTC=1.0 - ENDIF - IF(WTRT(NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - FWTS=AMIN1(1.0,WTLS(NZ,NY,NX)/(0.667*WTRT(NZ,NY,NX))) - ELSE - FWTS=1.0 - ENDIF - ELSE - FWTC=1.0 - FWTS=1.0 - ENDIF - DO 290 L=NU(NY,NX),NI(NZ,NY,NX) - IF(RTNT(1).GT.ZEROP(NZ,NY,NX))THEN - FWTR(L)=AMAX1(0.0,RLNT(1,L)/RTNT(1)) - ELSE - FWTR(L)=1.0 - ENDIF -290 CONTINUE -C -C RATE CONSTANT FOR TRANSFER IS SET FROM INPUT IN 'READQ' -C BUT IS NOT USED FOR ANNUALS DURING GRAIN FILL -C - WTLS(NZ,NY,NX)=0.0 - DO 309 NB=1,NBR(NZ,NY,NX) - WTLS(NZ,NY,NX)=WTLS(NZ,NY,NX)+WTLSB(NB,NZ,NY,NX) -309 CONTINUE - DO 310 NB=1,NBR(NZ,NY,NX) - IF(IDTHB(NB,NZ,NY,NX).EQ.0 - 2.AND.(ISTYP(NZ,NY,NX).NE.0.OR.IDAY(7,NB,NZ,NY,NX).EQ.0))THEN -C -C SINK STRENGTH OF BRANCHES IN EACH CANOPY AS A FRACTION -C OF TOTAL SINK STRENGTH OF THE CANOPY -C - IF(WTLS(NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - FWTB(NB)=AMAX1(0.0,WTLSB(NB,NZ,NY,NX)/WTLS(NZ,NY,NX)) - ELSE - FWTB(NB)=1.0 - ENDIF - PTSHTR=AMIN1(1.0,PTSHT(NZ,NY,NX)) - DO 415 L=NU(NY,NX),NI(NZ,NY,NX) - WTLSBX=WTLSB(NB,NZ,NY,NX)*FWODB(1)*FWTR(L)*FWTC - WTRTLX=WTRTL(1,L,NZ,NY,NX)*FWOOD(1)*FWTB(NB)*FWTS - WTLSBB=AMAX1(0.0,WTLSBX,FSNKM*WTRTLX) - WTRTLR=AMAX1(0.0,WTRTLX,FSNKM*WTLSBX) - WTPLTT=WTLSBB+WTRTLR - IF(WTPLTT.GT.ZEROP(NZ,NY,NX))THEN - CPOOLB=AMAX1(0.0,CPOOL(NB,NZ,NY,NX)*FWTR(L)) - CPOOLS=AMAX1(0.0,CPOOLR(1,L,NZ,NY,NX)*FWTB(NB)) - CPOOLD=(CPOOLB*WTRTLR-CPOOLS*WTLSBB)/WTPLTT - XFRC=PTSHTR*CPOOLD - CPOOL(NB,NZ,NY,NX)=CPOOL(NB,NZ,NY,NX)-XFRC - CPOOLR(1,L,NZ,NY,NX)=CPOOLR(1,L,NZ,NY,NX)+XFRC - CPOOLT=CPOOLS+CPOOLB - IF(CPOOLT.GT.ZEROP(NZ,NY,NX))THEN - ZPOOLB=AMAX1(0.0,ZPOOL(NB,NZ,NY,NX)*FWTR(L)) - ZPOOLS=AMAX1(0.0,ZPOOLR(1,L,NZ,NY,NX)*FWTB(NB)) - ZPOOLD=(ZPOOLB*CPOOLS-ZPOOLS*CPOOLB)/CPOOLT - XFRN=PTSHTR*ZPOOLD - PPOOLB=AMAX1(0.0,PPOOL(NB,NZ,NY,NX)*FWTR(L)) - PPOOLS=AMAX1(0.0,PPOOLR(1,L,NZ,NY,NX)*FWTB(NB)) - PPOOLD=(PPOOLB*CPOOLS-PPOOLS*CPOOLB)/CPOOLT - XFRP=PTSHTR*PPOOLD - ELSE - XFRN=0.0 - XFRP=0.0 - ENDIF - ZPOOL(NB,NZ,NY,NX)=ZPOOL(NB,NZ,NY,NX)-XFRN - ZPOOLR(1,L,NZ,NY,NX)=ZPOOLR(1,L,NZ,NY,NX)+XFRN - PPOOL(NB,NZ,NY,NX)=PPOOL(NB,NZ,NY,NX)-XFRP - PPOOLR(1,L,NZ,NY,NX)=PPOOLR(1,L,NZ,NY,NX)+XFRP -C IF((I/10)*10.EQ.I.AND.J.EQ.14.AND.NZ.EQ.1.AND.NB.EQ.1)THEN -C WRITE(*,3344)'ROOT',I,J,NX,NY,NZ,NB,L -C 2,FSNKR,FDBK(NB,NZ,NY,NX),CPOOL(NB,NZ,NY,NX) -C 3,CPOOLR(1,L,NZ,NY,NX),ZPOOL(NB,NZ,NY,NX) -C 3,ZPOOLR(1,L,NZ,NY,NX),FWTB(NB),FWTR(L) -C 3,FWTC,FWTS,XFRC,XFRN,XFRP,WTLSBX,WTRTLX -C 4,CPOOLD,CPOOLB,WTLSBB,CPOOLS,WTRTLR -C 5,FWOOD(1),FWODB(1),WTRTL(1,L,NZ,NY,NX) -C 6,WTLSB(NB,NZ,NY,NX),RLNT(1,L),RTNT(1) -3344 FORMAT(A8,7I4,30E12.4) -C ENDIF - ENDIF -415 CONTINUE - ENDIF -310 CONTINUE -C -C TOTAL C,N,P IN EACH BRANCH -C - DO 320 NB=1,NBR(NZ,NY,NX) - CPOOLK(NB,NZ,NY,NX)=0.0 - DO 325 K=1,25 - CPOOLK(NB,NZ,NY,NX)=CPOOLK(NB,NZ,NY,NX) - 2+CPOOL3(K,NB,NZ,NY,NX)+CPOOL4(K,NB,NZ,NY,NX) - 3+CO2B(K,NB,NZ,NY,NX)+HCOB(K,NB,NZ,NY,NX) -325 CONTINUE - WTSHTB(NB,NZ,NY,NX)=WTLFB(NB,NZ,NY,NX) - 2+WTSHEB(NB,NZ,NY,NX)+WTSTKB(NB,NZ,NY,NX)+WTRSVB(NB,NZ,NY,NX) - 3+WTHSKB(NB,NZ,NY,NX)+WTEARB(NB,NZ,NY,NX)+WTGRB(NB,NZ,NY,NX) - 4+CPOOL(NB,NZ,NY,NX)+CPOOLK(NB,NZ,NY,NX) - WTSHTN(NB,NZ,NY,NX)=WTLFBN(NB,NZ,NY,NX) - 2+WTSHBN(NB,NZ,NY,NX)+WTSTBN(NB,NZ,NY,NX)+WTRSBN(NB,NZ,NY,NX) - 3+WTHSBN(NB,NZ,NY,NX)+WTEABN(NB,NZ,NY,NX)+WTGRBN(NB,NZ,NY,NX) - 4+ZPOOL(NB,NZ,NY,NX) - WTSHTP(NB,NZ,NY,NX)=WTLFBP(NB,NZ,NY,NX) - 2+WTSHBP(NB,NZ,NY,NX)+WTSTBP(NB,NZ,NY,NX)+WTRSBP(NB,NZ,NY,NX) - 3+WTHSBP(NB,NZ,NY,NX)+WTEABP(NB,NZ,NY,NX)+WTGRBP(NB,NZ,NY,NX) - 4+PPOOL(NB,NZ,NY,NX) -320 CONTINUE -C -C TOTAL C,N,P IN ROOTS AND MYCORRHIZAE IN EACH SOIL LAYER -C - DO 345 N=1,MY(NZ,NY,NX) - DO 345 L=NU(NY,NX),NI(NZ,NY,NX) - WTRTD(N,L,NZ,NY,NX)=WTRTD(N,L,NZ,NY,NX)+CPOOLR(N,L,NZ,NY,NX) -345 CONTINUE - ELSE - HCUPTK(NZ,NY,NX)=UPOMC(NZ,NY,NX) - HZUPTK(NZ,NY,NX)=UPOMN(NZ,NY,NX)+UPNH4(NZ,NY,NX)+UPNO3(NZ,NY,NX) - 2+UPNF(NZ,NY,NX) - HPUPTK(NZ,NY,NX)=UPOMP(NZ,NY,NX)+UPH2P(NZ,NY,NX) - ENDIF -C -C TRANSFER ABOVE-GROUND C,N,P AT HARVEST OR DISTURBANCE -C - IF((IHVST(NZ,I,NY,NX).GE.0.AND.J.EQ.INT(ZNOON(NY,NX)) - 2.AND.IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6) - 3.OR.(IHVST(NZ,I,NY,NX).EQ.4.OR.IHVST(NZ,I,NY,NX).EQ.6))THEN -C -C ACCUMULATE ALL HARVESTED MATERIAL ABOVE CUTTING HEIGHT -C ACCOUNTING FOR HARVEST EFFICIENCY ENTERED IN 'READS' -C - IF(IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6)THEN - IF(JHVST(NZ,I,NY,NX).NE.2)THEN - PPX(NZ,NY,NX)=PPX(NZ,NY,NX)*(1.0-THIN(NZ,I,NY,NX)) - PP(NZ,NY,NX)=PP(NZ,NY,NX)*(1.0-THIN(NZ,I,NY,NX)) - ELSE -C PPI(NZ,NY,NX)=AMAX1(1.0,0.5*(PPI(NZ,NY,NX)+GRNO(NZ,NY,NX) -C 2/AREA(3,NU(NY,NX),NY,NX))) - PPX(NZ,NY,NX)=PPI(NZ,NY,NX) - PP(NZ,NY,NX)=PPX(NZ,NY,NX)*AREA(3,NU(NY,NX),NY,NX) - ENDIF - IF(IHVST(NZ,I,NY,NX).EQ.3)THEN - CF(NZ,NY,NX)=CF(NZ,NY,NX)*HVST(NZ,I,NY,NX) - ENDIF - IF(IHVST(NZ,I,NY,NX).LE.2.AND.HVST(NZ,I,NY,NX).LT.0.0)THEN - ARLFY=(1.0-ABS(HVST(NZ,I,NY,NX)))*ARLFC(NY,NX) - ARLFR=0.0 - DO 9875 L=1,JC - IF(ZL(L,NY,NX).GT.ZL(L-1,NY,NX) - 2.AND.ARLFT(L,NY,NX).GT.ZEROS(NY,NX) - 3.AND.ARLFR.LT.ARLFY)THEN - IF(ARLFR+ARLFT(L,NY,NX).GT.ARLFY)THEN - HVST(NZ,I,NY,NX)=ZL(L-1,NY,NX)+((ARLFY-ARLFR) - 2/ARLFT(L,NY,NX))*(ZL(L,NY,NX)-ZL(L-1,NY,NX)) - ENDIF - ARLFR=ARLFR+ARLFT(L,NY,NX) - ENDIF -C WRITE(*,6544)'HVST',I,J,L,NZ,IHVST(NZ,I,NY,NX),ARLFC(NY,NX) -C 2,ARLFT(L,NY,NX),ARLFY,ARLFR,ZL(L,NY,NX),ZL(L-1,NY,NX) -C 3,ARLFV(L,NZ,NY,NX),HVST(NZ,I,NY,NX) -6544 FORMAT(A8,5I4,20E12.4) -9875 CONTINUE - ENDIF - WHVSTT=0.0 - WHVSLF=0.0 - WHVHSH=0.0 - WHVEAH=0.0 - WHVGRH=0.0 - WHVSCP=0.0 - WHVSTH=0.0 - WHVRVH=0.0 - ELSE -C -C GRAZING REMOVAL -C - IF(WTSHTA(NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - WHVSTT=HVST(NZ,I,NY,NX)*THIN(NZ,I,NY,NX)*0.45/24.0 - 2*AREA(3,NU(NY,NX),NY,NX)*WTSHT(NZ,NY,NX)/WTSHTA(NZ,NY,NX) - ELSE - WHVSTT=0.0 - ENDIF - IF(IHVST(NZ,I,NY,NX).EQ.6)THEN - WHVSTT=WHVSTT*TFN3(NZ,NY,NX) - ENDIF - CCPOLX=CCPOLP(NZ,NY,NX)/(1.0+CCPOLP(NZ,NY,NX)) - CCPLNX=CCPLNP(NZ,NY,NX)/(1.0+CCPLNP(NZ,NY,NX)) - WHVSLX=WHVSTT*EHVST(1,1,NZ,I,NY,NX) - WHVSLY=AMIN1(WTLF(NZ,NY,NX),WHVSLX) - WHVSLF=WHVSLY*(1.0-CCPOLX) - WHVSCL=WHVSLY*CCPOLX - WHVSNL=WHVSLY*CCPLNX - WHVXXX=AMAX1(0.0,WHVSLX-WHVSLY) - WHVSSX=WHVSTT*EHVST(1,2,NZ,I,NY,NX) - WTSHTT=WTSHE(NZ,NY,NX)+WTHSK(NZ,NY,NX)+WTEAR(NZ,NY,NX) - 2+WTGR(NZ,NY,NX) - IF(WTSHTT.GT.ZEROP(NZ,NY,NX))THEN - WHVSHX=WHVSSX*WTSHE(NZ,NY,NX)/WTSHTT+WHVXXX - WHVSHY=AMIN1(WTSHE(NZ,NY,NX),WHVSHX) - WHVSHH=WHVSHY*(1.0-CCPOLX) - WHVSCS=WHVSHY*CCPOLX - WHVSNS=WHVSHY*CCPLNX - WHVXXX=AMAX1(0.0,WHVSHX-WHVSHY) - WHVHSX=WHVSSX*WTHSK(NZ,NY,NX)/WTSHTT+WHVXXX - WHVHSY=AMIN1(WTHSK(NZ,NY,NX),WHVHSX) - WHVHSH=WHVHSY - WHVXXX=AMAX1(0.0,WHVHSX-WHVHSY) - WHVEAX=WHVSSX*WTEAR(NZ,NY,NX)/WTSHTT+WHVXXX - WHVEAY=AMIN1(WTEAR(NZ,NY,NX),WHVEAX) - WHVEAH=WHVEAY - WHVXXX=AMAX1(0.0,WHVEAX-WHVEAY) - WHVGRX=WHVSSX*WTGR(NZ,NY,NX)/WTSHTT+WHVXXX - WHVGRY=AMIN1(WTGR(NZ,NY,NX),WHVGRX) - WHVGRH=WHVGRY - WHVXXX=AMAX1(0.0,WHVGRX-WHVGRY) - ELSE - WHVSHH=0.0 - WHVSCS=0.0 - WHVSNS=0.0 - WHVHSH=0.0 - WHVEAH=0.0 - WHVGRH=0.0 - WHVXXX=WHVXXX+WHVSSX - ENDIF - WHVSCP=WHVSCL+WHVSCS - WHVSNP=WHVSNL+WHVSNS - WHVSKX=WHVSTT*EHVST(1,3,NZ,I,NY,NX) - WTSTKT=WTSTK(NZ,NY,NX)+WTRSV(NZ,NY,NX) - IF(WTSTKT.GT.WHVSKX+WHVXXX)THEN - WHVSTX=WHVSKX*WTSTK(NZ,NY,NX)/WTSTKT+WHVXXX - WHVSTY=AMIN1(WTSTK(NZ,NY,NX),WHVSTX) - WHVSTH=WHVSTY - WHVXXX=AMAX1(0.0,WHVSTX-WHVSTY) - WHVRVX=WHVSKX*WTRSV(NZ,NY,NX)/WTSTKT+WHVXXX - WHVRVY=AMIN1(WTRSV(NZ,NY,NX),WHVRVX) - WHVRVH=WHVRVY - WHVXXX=AMAX1(0.0,WHVRVX-WHVRVY) - ELSE - WHVSTH=0.0 - WHVRVH=0.0 - WHVXXX=AMAX1(0.0,WHVSKX) - IF(WHVXXX.GT.0.0)THEN - WHVSLY=AMIN1(WTLF(NZ,NY,NX)-WHVSLF-WHVSCL,WHVXXX) - WHVSLF=WHVSLF+WHVSLY*(1.0-CCPOLX) - WHVSCL=WHVSCL+WHVSLY*CCPOLX - WHVSNL=WHVSNL+WHVSLY*CCPLNX - WHVXXX=AMAX1(0.0,WHVXXX-WHVSLY) - IF(WTSHTT.GT.ZEROP(NZ,NY,NX))THEN - WHVSHX=WHVXXX*WTSHE(NZ,NY,NX)/WTSHTT - WHVSHY=AMIN1(WTSHE(NZ,NY,NX),WHVSHX) - WHVSHH=WHVSHH+WHVSHY*(1.0-CCPOLX) - WHVSCS=WHVSCS+WHVSHY*CCPOLX - WHVSNS=WHVSNS+WHVSHY*CCPLNX - WHVXXX=AMAX1(0.0,WHVXXX-WHVSHY) - WHVHSX=WHVXXX*WTHSK(NZ,NY,NX)/WTSHTT - WHVHSY=AMIN1(WTHSK(NZ,NY,NX),WHVHSX) - WHVHSH=WHVHSH+WHVHSY - WHVXXX=AMAX1(0.0,WHVXXX-WHVHSY) - WHVEAX=WHVXXX*WTEAR(NZ,NY,NX)/WTSHTT - WHVEAY=AMIN1(WTEAR(NZ,NY,NX),WHVEAX) - WHVEAH=WHVEAH+WHVEAY - WHVXXX=AMAX1(0.0,WHVEAX-WHVEAY) - WHVGRX=WHVXXX*WTGR(NZ,NY,NX)/WTSHTT - WHVGRY=AMIN1(WTGR(NZ,NY,NX),WHVGRX) - WHVGRH=WHVGRH+WHVGRY - WHVXXX=AMAX1(0.0,WHVGRX-WHVGRY) - ENDIF - ENDIF - ENDIF -C -C ALL HARVEST REMOVALS -C - DO 9860 NB=1,NBR(NZ,NY,NX) - DO 9860 L=1,JC - DO 9860 K=0,25 - WGLFBL(L,NB,NZ,NY,NX)=0.0 -9860 CONTINUE - DO 9870 NB=1,NBR(NZ,NY,NX) - DO 9870 L=1,JC - DO 9870 K=0,25 - WGLFBL(L,NB,NZ,NY,NX)=WGLFBL(L,NB,NZ,NY,NX) - 2+WGLFL(L,K,NB,NZ,NY,NX) -9870 CONTINUE - ENDIF - DO 9865 L=JC,1,-1 - IF(IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6)THEN - IF(IHVST(NZ,I,NY,NX).NE.3)THEN - IF(ZL(L,NY,NX).GT.ZL(L-1,NY,NX))THEN - FHGT=AMAX1(0.0,AMIN1(1.0,1.0-((ZL(L,NY,NX)) - 2-HVST(NZ,I,NY,NX))/(ZL(L,NY,NX)-ZL(L-1,NY,NX)))) - ELSE - FHGT=1.0 - ENDIF - ELSE - FHGT=0.0 - ENDIF - IF(THIN(NZ,I,NY,NX).EQ.0.0)THEN - FHVST=AMAX1(0.0,1.0-(1.0-FHGT)*EHVST(1,1,NZ,I,NY,NX)) - FHVSH=FHVST - ELSE - FHVST=AMAX1(0.0,1.0-THIN(NZ,I,NY,NX)) - IF(IHVST(NZ,I,NY,NX).EQ.0)THEN - FHVSH=1.0-(1.0-FHGT)*EHVST(1,1,NZ,I,NY,NX)*THIN(NZ,I,NY,NX) - ELSE - FHVSH=FHVST - ENDIF - ENDIF - ELSE - FHVST=0.0 - FHVSH=0.0 - ENDIF -C -C CUT LEAVES AT HARVESTED NODES AND LAYERS -C - DO 9855 NB=1,NBR(NZ,NY,NX) - IF((IHVST(NZ,I,NY,NX).EQ.4.OR.IHVST(NZ,I,NY,NX).EQ.6) - 2.AND.WTLF(NZ,NY,NX).GT.ZEROL(NZ,NY,NX))THEN - WHVSBL=WHVSLF*AMAX1(0.0,WGLFBL(L,NB,NZ,NY,NX))/WTLF(NZ,NY,NX) - ELSE - WHVSBL=0.0 - ENDIF - DO 9845 K=25,0,-1 - IF((IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6) - 2.OR.WHVSBL.GT.0.0)THEN - IF(IHVST(NZ,I,NY,NX).EQ.4.OR.IHVST(NZ,I,NY,NX).EQ.6)THEN - IF(WGLFL(L,K,NB,NZ,NY,NX).GT.WHVSBL)THEN - FHVST=AMAX1(0.0,AMIN1(1.0,(WGLFL(L,K,NB,NZ,NY,NX)-WHVSBL) - 2/WGLFL(L,K,NB,NZ,NY,NX))) - FHVSH=FHVST - ELSE - FHVST=1.0 - FHVSH=1.0 - ENDIF - ENDIF -C -C HARVESTED LEAF AREA, C, N, P -C - WHVSBL=WHVSBL-(1.0-FHVST)*WGLFL(L,K,NB,NZ,NY,NX) - WTHTH1=WTHTH1+(1.0-FHVSH)*WGLFL(L,K,NB,NZ,NY,NX)*FWODB(1) - WTHNH1=WTHNH1+(1.0-FHVSH)*WGLFLN(L,K,NB,NZ,NY,NX)*FWODLN(1) - WTHPH1=WTHPH1+(1.0-FHVSH)*WGLFLP(L,K,NB,NZ,NY,NX)*FWODLP(1) - WTHTX1=WTHTX1+(FHVSH-FHVST)*WGLFL(L,K,NB,NZ,NY,NX)*FWODB(1) - WTHNX1=WTHNX1+(FHVSH-FHVST)*WGLFLN(L,K,NB,NZ,NY,NX)*FWODLN(1) - WTHPX1=WTHPX1+(FHVSH-FHVST)*WGLFLP(L,K,NB,NZ,NY,NX)*FWODLP(1) - WTHTH3=WTHTH3+(1.0-FHVSH)*WGLFL(L,K,NB,NZ,NY,NX)*FWODB(0) - WTHNH3=WTHNH3+(1.0-FHVSH)*WGLFLN(L,K,NB,NZ,NY,NX)*FWODLN(0) - WTHPH3=WTHPH3+(1.0-FHVSH)*WGLFLP(L,K,NB,NZ,NY,NX)*FWODLP(0) - WTHTX3=WTHTX3+(FHVSH-FHVST)*WGLFL(L,K,NB,NZ,NY,NX)*FWODB(0) - WTHNX3=WTHNX3+(FHVSH-FHVST)*WGLFLN(L,K,NB,NZ,NY,NX)*FWODLN(0) - WTHPX3=WTHPX3+(FHVSH-FHVST)*WGLFLP(L,K,NB,NZ,NY,NX)*FWODLP(0) -C -C REMAINING LEAF C,N,P AND AREA -C - WGLFL(L,K,NB,NZ,NY,NX)=FHVST*WGLFL(L,K,NB,NZ,NY,NX) - WGLFLN(L,K,NB,NZ,NY,NX)=FHVST*WGLFLN(L,K,NB,NZ,NY,NX) - WGLFLP(L,K,NB,NZ,NY,NX)=FHVST*WGLFLP(L,K,NB,NZ,NY,NX) - ARLFL(L,K,NB,NZ,NY,NX)=FHVST*ARLFL(L,K,NB,NZ,NY,NX) - IF(K.EQ.1)THEN - ARSTK(L,NB,NZ,NY,NX)=FHVST*ARSTK(L,NB,NZ,NY,NX) - ENDIF - ENDIF -C IF(I.EQ.262.AND.K.EQ.5)THEN -C WRITE(*,6543)'GRAZ',I,J,NZ,NB,K,L,IHVST(NZ,I,NY,NX) -C 2,ZL(L,NY,NX),ZL(L-1,NY,NX),HVST(NZ,I,NY,NX),FHVST,FHVSH -C 5,WGLFBL(L,NB,NZ,NY,NX),WTLF(NZ,NY,NX),CPOOLP(NZ,NY,NX) -C 6,ARLFL(L,K,NB,NZ,NY,NX),WGLF(K,NB,NZ,NY,NX),ARLF(K,NB,NZ,NY,NX) -C 7,HTNODE(K,NB,NZ,NY,NX) -C 7,WTSHTA(NZ,NY,NX),WHVSBL,WHVSTT,WHVSLF,WHVSHH -C 3,WHVHSH,WHVEAH,WHVGRH,WHVSCP,WHVSTH,WHVRVH,WHVXXX -C 4,WTSHTT,WHVSSX,CCPOLX -6543 FORMAT(A8,7I4,30E12.4) -C ENDIF -9845 CONTINUE -9855 CONTINUE - ARLFV(L,NZ,NY,NX)=0.0 - WGLFV(L,NZ,NY,NX)=0.0 - ARSTV(L,NZ,NY,NX)=ARSTV(L,NZ,NY,NX)*FHVST -9865 CONTINUE - DO 9835 NB=1,NBR(NZ,NY,NX) - CPOOLG=0.0 - ZPOOLG=0.0 - PPOOLG=0.0 - CPOLNG=0.0 - ZPOLNG=0.0 - PPOLNG=0.0 - WTNDG=0.0 - WTNDNG=0.0 - WTNDPG=0.0 - WGLFGX=0.0 - WGSHGX=0.0 - WGLFGY=0.0 - WGSHGY=0.0 - DO 9825 K=0,25 - ARLFG=0.0 - WGLFG=0.0 - WGLFNG=0.0 - WGLFPG=0.0 -C -C REMAINING LEAF AREA, C, N, P -C - DO 9815 L=1,JC - ARLFG=ARLFG+ARLFL(L,K,NB,NZ,NY,NX) - WGLFG=WGLFG+WGLFL(L,K,NB,NZ,NY,NX) - WGLFNG=WGLFNG+WGLFLN(L,K,NB,NZ,NY,NX) - WGLFPG=WGLFPG+WGLFLP(L,K,NB,NZ,NY,NX) - ARLFV(L,NZ,NY,NX)=ARLFV(L,NZ,NY,NX)+ARLFL(L,K,NB,NZ,NY,NX) - WGLFV(L,NZ,NY,NX)=WGLFV(L,NZ,NY,NX)+WGLFL(L,K,NB,NZ,NY,NX) -9815 CONTINUE -C -C ACCUMULATE REMAINING BRANCH LEAF AREA, C, N, P -C - IF(IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6)THEN - IF(WGLF(K,NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX) - 2.AND.EHVST(1,1,NZ,I,NY,NX).GT.0.0)THEN - FHVSTK(K)=AMAX1(0.0,AMIN1(1.0,(1.0-(1.0-AMAX1(0.0,WGLFG) - 2/WGLF(K,NB,NZ,NY,NX))*EHVST(1,2,NZ,I,NY,NX) - 3/EHVST(1,1,NZ,I,NY,NX)))) - FHVSHK(K)=FHVSTK(K) - ELSE - IF(THIN(NZ,I,NY,NX).EQ.0.0)THEN - FHVSTK(K)=1.0-EHVST(1,2,NZ,I,NY,NX) - FHVSHK(K)=FHVSTK(K) - ELSE - FHVSTK(K)=1.0-THIN(NZ,I,NY,NX) - IF(IHVST(NZ,I,NY,NX).EQ.0)THEN - FHVSHK(K)=1.0-EHVST(1,2,NZ,I,NY,NX)*THIN(NZ,I,NY,NX) - ELSE - FHVSHK(K)=FHVSTK(K) - ENDIF - ENDIF - ENDIF - ELSE - FHVSTK(K)=0.0 - FHVSHK(K)=0.0 - ENDIF - WGLFGY=WGLFGY+WGLF(K,NB,NZ,NY,NX) - WTLFB(NB,NZ,NY,NX)=WTLFB(NB,NZ,NY,NX) - 2-WGLF(K,NB,NZ,NY,NX)+WGLFG - WTLFBN(NB,NZ,NY,NX)=WTLFBN(NB,NZ,NY,NX) - 2-WGLFN(K,NB,NZ,NY,NX)+WGLFNG - WTLFBP(NB,NZ,NY,NX)=WTLFBP(NB,NZ,NY,NX) - 2-WGLFP(K,NB,NZ,NY,NX)+WGLFPG - ARLFB(NB,NZ,NY,NX)=ARLFB(NB,NZ,NY,NX)-ARLF(K,NB,NZ,NY,NX)+ARLFG - IF(ARLF(K,NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - WSLF(K,NB,NZ,NY,NX)=WSLF(K,NB,NZ,NY,NX)*ARLFG/ARLF(K,NB,NZ,NY,NX) - ELSE - WSLF(K,NB,NZ,NY,NX)=0.0 - ENDIF - ARLF(K,NB,NZ,NY,NX)=ARLFG - WGLF(K,NB,NZ,NY,NX)=WGLFG - WGLFN(K,NB,NZ,NY,NX)=WGLFNG - WGLFP(K,NB,NZ,NY,NX)=WGLFPG - WGLFGX=WGLFGX+WGLF(K,NB,NZ,NY,NX) -9825 CONTINUE -C -C CUT SHEATHS OR PETIOLES AND STALKS HARVESTED NODES AND LAYERS -C - HTSTKX=-1.0 - IF((IHVST(NZ,I,NY,NX).EQ.4.OR.IHVST(NZ,I,NY,NX).EQ.6) - 2.AND.WTSHE(NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - WHVSBS=WHVSHH*WTSHEB(NB,NZ,NY,NX)/WTSHE(NZ,NY,NX) - ELSE - WHVSBS=0.0 - ENDIF - DO 9805 K=25,0,-1 -C WRITE(*,112)'VSTG',I,J,NX,NY,NZ,NB,K,VSTG(NB,NZ,NY,NX),FHVSTK(K) -C 2,HTNODE(K,NB,NZ,NY,NX),HVST(NZ,I,NY,NX) -112 FORMAT(A8,7I4,12E12.4) - IF(HTNODE(K,NB,NZ,NY,NX).GT.0.0) - 2HTSTKX=AMAX1(HTSTKX,HTNODE(K,NB,NZ,NY,NX)) -C -C HARVESTED SHEATH OR PETIOLE C,N,P -C - IF((IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6) - 2.OR.WHVSBS.GT.0.0)THEN - IF(IHVST(NZ,I,NY,NX).EQ.4.OR.IHVST(NZ,I,NY,NX).EQ.6)THEN - IF(WGSHE(K,NB,NZ,NY,NX).GT.WHVSBS)THEN - FHVSTK(K)=AMAX1(0.0,AMIN1(1.0,(WGSHE(K,NB,NZ,NY,NX)-WHVSBS) - 2/WGSHE(K,NB,NZ,NY,NX))) - FHVSHK(K)=FHVSTK(K) - ELSE - FHVSTK(K)=0.0 - FHVSHK(K)=0.0 - ENDIF - ENDIF - WHVSBS=WHVSBS-(1.0-FHVSTK(K))*WGSHE(K,NB,NZ,NY,NX) - WTHTH2=WTHTH2+(1.0-FHVSHK(K))*WGSHE(K,NB,NZ,NY,NX)*FWODB(1) - WTHNH2=WTHNH2+(1.0-FHVSHK(K))*WGSHN(K,NB,NZ,NY,NX)*FWODSN(1) - WTHPH2=WTHPH2+(1.0-FHVSHK(K))*WGSHP(K,NB,NZ,NY,NX)*FWODSP(1) - WTHTX2=WTHTX2+(FHVSHK(K)-FHVSTK(K))*WGSHE(K,NB,NZ,NY,NX) - 2*FWODB(1) - WTHNX2=WTHNX2+(FHVSHK(K)-FHVSTK(K))*WGSHN(K,NB,NZ,NY,NX) - 2*FWODSN(1) - WTHPX2=WTHPX2+(FHVSHK(K)-FHVSTK(K))*WGSHP(K,NB,NZ,NY,NX) - 2*FWODSP(1) - WTHTH3=WTHTH3+(1.0-FHVSHK(K))*WGSHE(K,NB,NZ,NY,NX)*FWODB(0) - WTHNH3=WTHNH3+(1.0-FHVSHK(K))*WGSHN(K,NB,NZ,NY,NX)*FWODSN(0) - WTHPH3=WTHPH3+(1.0-FHVSHK(K))*WGSHP(K,NB,NZ,NY,NX)*FWODSP(0) - WTHTX3=WTHTX3+(FHVSHK(K)-FHVSTK(K))*WGSHE(K,NB,NZ,NY,NX) - 2*FWODB(0) - WTHNX3=WTHNX3+(FHVSHK(K)-FHVSTK(K))*WGSHN(K,NB,NZ,NY,NX) - 2*FWODSN(0) - WTHPX3=WTHPX3+(FHVSHK(K)-FHVSTK(K))*WGSHP(K,NB,NZ,NY,NX) - 2*FWODSP(0) -C -C REMAINING SHEATH OR PETIOLE C,N,P AND LENGTH -C - WGSHGY=WGSHGY+WGSHE(K,NB,NZ,NY,NX) - WTSHEB(NB,NZ,NY,NX)=WTSHEB(NB,NZ,NY,NX) - 2-(1.0-FHVSTK(K))*WGSHE(K,NB,NZ,NY,NX) - WTSHBN(NB,NZ,NY,NX)=WTSHBN(NB,NZ,NY,NX) - 2-(1.0-FHVSTK(K))*WGSHN(K,NB,NZ,NY,NX) - WTSHBP(NB,NZ,NY,NX)=WTSHBP(NB,NZ,NY,NX) - 2-(1.0-FHVSTK(K))*WGSHP(K,NB,NZ,NY,NX) - WGSHE(K,NB,NZ,NY,NX)=FHVSTK(K)*WGSHE(K,NB,NZ,NY,NX) - WSSHE(K,NB,NZ,NY,NX)=FHVSTK(K)*WSSHE(K,NB,NZ,NY,NX) - WGSHN(K,NB,NZ,NY,NX)=FHVSTK(K)*WGSHN(K,NB,NZ,NY,NX) - WGSHP(K,NB,NZ,NY,NX)=FHVSTK(K)*WGSHP(K,NB,NZ,NY,NX) - WSSHE(K,NB,NZ,NY,NX)=FHVSTK(K)*WSSHE(K,NB,NZ,NY,NX) - IF(IHVST(NZ,I,NY,NX).LE.2 - 2.AND.HTSHE(K,NB,NZ,NY,NX).GT.0.0)THEN - FHGT=AMAX1(0.0,AMIN1(1.0,(HTNODE(K,NB,NZ,NY,NX) - 2+HTSHE(K,NB,NZ,NY,NX)-HVST(NZ,I,NY,NX))/HTSHE(K,NB,NZ,NY,NX))) - HTSHE(K,NB,NZ,NY,NX)=(1.0-FHGT)*HTSHE(K,NB,NZ,NY,NX) - ELSE - HTSHE(K,NB,NZ,NY,NX)=FHVSTK(K)*HTSHE(K,NB,NZ,NY,NX) - ENDIF - WGSHGX=WGSHGX+WGSHE(K,NB,NZ,NY,NX) -C IF(IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6)THEN -C IF(HTNODE(K,NB,NZ,NY,NX).GT.HVST(NZ,I,NY,NX) -C 2.OR.IHVST(NZ,I,NY,NX).EQ.3)THEN -C IF(FHVSTK(K).EQ.0.0.AND.K.GT.0)THEN -C IF(IBTYP(NZ,NY,NX).EQ.0.OR.IGTYP(NZ,NY,NX).LE.1)THEN -C VSTG(NB,NZ,NY,NX)=AMAX1(0.0,VSTG(NB,NZ,NY,NX)-1.0) -C ELSE -C VSTG(NB,NZ,NY,NX)=AMAX1(0.0,VSTG(NB,NZ,NY,NX)-0.04) -C ENDIF -C ENDIF -C ENDIF -C ENDIF - ENDIF -9805 CONTINUE -C -C CUT NON-STRUCTURAL C,N,P IN HARVESTED BRANCHES -C - CPOOLX=AMAX1(0.0,CPOOL(NB,NZ,NY,NX)) - ZPOOLX=AMAX1(0.0,ZPOOL(NB,NZ,NY,NX)) - PPOOLX=AMAX1(0.0,PPOOL(NB,NZ,NY,NX)) - CPOLNX=AMAX1(0.0,CPOLNB(NB,NZ,NY,NX)) - ZPOLNX=AMAX1(0.0,ZPOLNB(NB,NZ,NY,NX)) - PPOLNX=AMAX1(0.0,PPOLNB(NB,NZ,NY,NX)) - IF(IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6)THEN - IF(WGLFGY+WGSHGY.GT.ZEROP(NZ,NY,NX))THEN - FHVST=AMAX1(0.0,AMIN1(1.0,(WGLFGX+WGSHGX) - 2/(WGLFGY+WGSHGY))) - CPOOLG=CPOOLX*FHVST - ZPOOLG=ZPOOLX*FHVST - PPOOLG=PPOOLX*FHVST - CPOLNG=CPOLNX*FHVST - ZPOLNG=ZPOLNX*FHVST - PPOLNG=PPOLNX*FHVST - WTNDG=WTNDB(NB,NZ,NY,NX)*FHVST - WTNDNG=WTNDBN(NB,NZ,NY,NX)*FHVST - WTNDPG=WTNDBP(NB,NZ,NY,NX)*FHVST - ELSE - CPOOLG=0.0 - ZPOOLG=0.0 - PPOOLG=0.0 - CPOLNG=0.0 - ZPOLNG=0.0 - PPOLNG=0.0 - WTNDG=0.0 - WTNDNG=0.0 - WTNDPG=0.0 - ENDIF - ELSE - IF(WTLS(NZ,NY,NX).GT.ZEROL(NZ,NY,NX))THEN - WTLSBX=AMAX1(0.0,WTLSB(NB,NZ,NY,NX)) - IF(CPOOL(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - WHVSCX=AMAX1(0.0,WHVSCP)*WTLSBX/WTLS(NZ,NY,NX) - CPOOLG=AMAX1(0.0,CPOOLX-WHVSCX) - ZPOOLG=AMAX1(0.0,ZPOOLX-WHVSCX*ZPOOLX/CPOOL(NB,NZ,NY,NX)) - PPOOLG=AMAX1(0.0,PPOOLX-WHVSCX*PPOOLX/CPOOL(NB,NZ,NY,NX)) - ELSE - CPOOLG=0.0 - ZPOOLG=0.0 - PPOOLG=0.0 - ENDIF - IF(CPOLNB(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - WHVSNX=AMAX1(0.0,WHVSNP)*WTLSBX/WTLS(NZ,NY,NX) - CPOLNG=AMAX1(0.0,CPOLNX-WHVSNX) - ZPOLNG=AMAX1(0.0,ZPOLNX-WHVSNX*ZPOLNX/CPOLNB(NB,NZ,NY,NX)) - PPOLNG=AMAX1(0.0,PPOLNX-WHVSNX*PPOLNX/CPOLNB(NB,NZ,NY,NX)) - WTNDG=WTNDB(NB,NZ,NY,NX)*(1.0-WHVSNX/CPOLNX) - WTNDNG=WTNDBN(NB,NZ,NY,NX)*(1.0-WHVSNX/CPOLNX) - WTNDPG=WTNDBP(NB,NZ,NY,NX)*(1.0-WHVSNX/CPOLNX) - ELSE - CPOLNG=0.0 - ZPOLNG=0.0 - PPOLNG=0.0 - WTNDG=0.0 - WTNDNG=0.0 - WTNDPG=0.0 - ENDIF - ELSE - CPOOLG=0.0 - ZPOOLG=0.0 - PPOOLG=0.0 - CPOLNG=0.0 - ZPOLNG=0.0 - PPOLNG=0.0 - WTNDG=0.0 - WTNDNG=0.0 - WTNDPG=0.0 - ENDIF - ENDIF -C -C HARVESTED NON-STRUCTURAL C, N, P -C - WTHTH0=WTHTH0+CPOOLX-CPOOLG+CPOLNX-CPOLNG - WTHNH0=WTHNH0+ZPOOLX-ZPOOLG+ZPOLNX-ZPOLNG - WTHPH0=WTHPH0+PPOOLX-PPOOLG+PPOLNX-PPOLNG - WTHTH0=WTHTH0+WTNDB(NB,NZ,NY,NX)-WTNDG - WTHNH0=WTHNH0+WTNDBN(NB,NZ,NY,NX)-WTNDNG - WTHPH0=WTHPH0+WTNDBP(NB,NZ,NY,NX)-WTNDPG -C -C REMAINING NON-STRUCTURAL C, N, P -C - CPOOL(NB,NZ,NY,NX)=CPOOLG - ZPOOL(NB,NZ,NY,NX)=ZPOOLG - PPOOL(NB,NZ,NY,NX)=PPOOLG - CPOLNB(NB,NZ,NY,NX)=CPOLNG - ZPOLNB(NB,NZ,NY,NX)=ZPOLNG - PPOLNB(NB,NZ,NY,NX)=PPOLNG - WTNDB(NB,NZ,NY,NX)=WTNDG - WTNDBN(NB,NZ,NY,NX)=WTNDNG - WTNDBP(NB,NZ,NY,NX)=WTNDPG -C -C REMOVE C4 NON-STRUCTURAL C -C - IF(ICTYP(NZ,NY,NX).EQ.4.AND.CPOOLX.GT.ZEROP(NZ,NY,NX))THEN - FHVST4=CPOOLG/CPOOLX - DO 9810 K=1,25 - WTHTH0=WTHTH0+(1.0-FHVST4)*CPOOL3(K,NB,NZ,NY,NX) - WTHTH0=WTHTH0+(1.0-FHVST4)*CPOOL4(K,NB,NZ,NY,NX) - WTHTH0=WTHTH0+(1.0-FHVST4)*CO2B(K,NB,NZ,NY,NX) - WTHTH0=WTHTH0+(1.0-FHVST4)*HCOB(K,NB,NZ,NY,NX) - CPOOL3(K,NB,NZ,NY,NX)=FHVST4*CPOOL3(K,NB,NZ,NY,NX) - CPOOL4(K,NB,NZ,NY,NX)=FHVST4*CPOOL4(K,NB,NZ,NY,NX) - CO2B(K,NB,NZ,NY,NX)=FHVST4*CO2B(K,NB,NZ,NY,NX) - HCOB(K,NB,NZ,NY,NX)=FHVST4*HCOB(K,NB,NZ,NY,NX) -9810 CONTINUE - ENDIF -C -C CUT STALKS -C - IF(IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6)THEN - IF(HTSTKX.GT.ZERO)THEN - IF(IHVST(NZ,I,NY,NX).NE.3)THEN - FHGT=AMAX1(0.0,AMIN1(1.0,HVST(NZ,I,NY,NX)/HTSTKX)) - ELSE - FHGT=0.0 - ENDIF - IF(THIN(NZ,I,NY,NX).EQ.0.0)THEN - FHVST=AMAX1(0.0,1.0-(1.0-FHGT)*EHVST(1,3,NZ,I,NY,NX)) - FHVSH=FHVST - ELSE - FHVST=AMAX1(0.0,1.0-THIN(NZ,I,NY,NX)) - IF(IHVST(NZ,I,NY,NX).EQ.0)THEN - FHVSH=1.0-(1.0-FHGT)*EHVST(1,3,NZ,I,NY,NX)*THIN(NZ,I,NY,NX) - ELSE - FHVSH=FHVST - ENDIF - ENDIF - ELSE - FHVST=1.0 - FHVSH=1.0 - ENDIF - ELSE - IF(WTSTK(NZ,NY,NX).GT.ZEROL(NZ,NY,NX))THEN - FHVST=AMAX1(0.0,AMIN1(1.0,1.0-WHVSTH/WTSTK(NZ,NY,NX))) - FHVSH=FHVST - ELSE - FHVST=1.0 - FHVSH=1.0 - ENDIF - ENDIF -C -C HARVESTED STALK C,N,P -C - WTHTH3=WTHTH3+(1.0-FHVSH)*WTSTKB(NB,NZ,NY,NX) - WTHNH3=WTHNH3+(1.0-FHVSH)*WTSTBN(NB,NZ,NY,NX) - WTHPH3=WTHPH3+(1.0-FHVSH)*WTSTBP(NB,NZ,NY,NX) - WTHTX3=WTHTX3+(FHVSH-FHVST)*WTSTKB(NB,NZ,NY,NX) - WTHNX3=WTHNX3+(FHVSH-FHVST)*WTSTBN(NB,NZ,NY,NX) - WTHPX3=WTHPX3+(FHVSH-FHVST)*WTSTBP(NB,NZ,NY,NX) -C -C REMAINING STALK C,N,P -C - WTSTKB(NB,NZ,NY,NX)=FHVST*WTSTKB(NB,NZ,NY,NX) - WTSTBN(NB,NZ,NY,NX)=FHVST*WTSTBN(NB,NZ,NY,NX) - WTSTBP(NB,NZ,NY,NX)=FHVST*WTSTBP(NB,NZ,NY,NX) - WVSTKB(NB,NZ,NY,NX)=FHVST*WVSTKB(NB,NZ,NY,NX) - WTSTXB(NB,NZ,NY,NX)=FHVST*WTSTXB(NB,NZ,NY,NX) - WTSTXN(NB,NZ,NY,NX)=FHVST*WTSTXN(NB,NZ,NY,NX) - WTSTXP(NB,NZ,NY,NX)=FHVST*WTSTXP(NB,NZ,NY,NX) - -C -C CUT STALK NODES -C - DO 9820 K=25,0,-1 - IF(IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6)THEN - IF(HTNODX(K,NB,NZ,NY,NX).GT.ZERO)THEN - IF(IHVST(NZ,I,NY,NX).NE.3)THEN - FHGT=AMAX1(0.0,AMIN1(1.0,(HTNODE(K,NB,NZ,NY,NX) - 2-HVST(NZ,I,NY,NX))/HTNODX(K,NB,NZ,NY,NX))) - ELSE - FHGT=0.0 - ENDIF - IF(THIN(NZ,I,NY,NX).EQ.0.0)THEN - FHVST=AMAX1(0.0,1.0-FHGT*EHVST(1,3,NZ,I,NY,NX)) - ELSE - FHVST=AMAX1(0.0,1.0-THIN(NZ,I,NY,NX)) - ENDIF - ELSE - FHVST=1.0 - ENDIF - ELSE - IF(WTSTK(NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - FHVST=AMAX1(0.0,AMIN1(1.0,1.0-WHVSTH/WTSTK(NZ,NY,NX))) - ELSE - FHVST=1.0 - ENDIF - ENDIF - WGNODE(K,NB,NZ,NY,NX)=FHVST*WGNODE(K,NB,NZ,NY,NX) - WGNODN(K,NB,NZ,NY,NX)=FHVST*WGNODN(K,NB,NZ,NY,NX) - WGNODP(K,NB,NZ,NY,NX)=FHVST*WGNODP(K,NB,NZ,NY,NX) - IF(IHVST(NZ,I,NY,NX).LE.2.AND.THIN(NZ,I,NY,NX).EQ.0.0)THEN - HTNODX(K,NB,NZ,NY,NX)=FHVST*HTNODX(K,NB,NZ,NY,NX) - HTNODE(K,NB,NZ,NY,NX)=AMIN1(HTNODE(K,NB,NZ,NY,NX) - 2,HVST(NZ,I,NY,NX)) - ENDIF -C IF(NZ.EQ.2)THEN -C WRITE(*,4811)'STK2',I,J,NZ,NB,K,IHVST(NZ,I,NY,NX) -C 2,HTNODX(K,NB,NZ,NY,NX),HTNODE(K,NB,NZ,NY,NX) -C 3,HVST(NZ,I,NY,NX),FHGT,FHVST,ARLF(K,NB,NZ,NY,NX) -C 4,EHVST(1,3,NZ,I,NY,NX),THIN(NZ,I,NY,NX) -4811 FORMAT(A8,6I4,12E12.4) -C ENDIF -9820 CONTINUE -C -C CUT STALK RESERVES -C - IF(IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6)THEN - IF(WTSTKB(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - FHVST=FHVST - FHVSH=FHVSH - ELSE - FHVST=0.0 - FHVSH=0.0 - ENDIF - ELSE - IF(WTRSV(NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - FHVST=AMAX1(0.0,AMIN1(1.0,1.0-WHVRVH/WTRSV(NZ,NY,NX))) - FHVSH=FHVST - ELSE - FHVST=0.0 - FHVSH=0.0 - ENDIF - ENDIF -C -C HARVESTED STALK RESERVE C,N,P -C - WTHTH3=WTHTH3+(1.0-FHVSH)*WTRSVB(NB,NZ,NY,NX) - WTHNH3=WTHNH3+(1.0-FHVSH)*WTRSBN(NB,NZ,NY,NX) - WTHPH3=WTHPH3+(1.0-FHVSH)*WTRSBP(NB,NZ,NY,NX) - WTHTX3=WTHTX3+(FHVSH-FHVST)*WTRSVB(NB,NZ,NY,NX) - WTHNX3=WTHNX3+(FHVSH-FHVST)*WTRSBN(NB,NZ,NY,NX) - WTHPX3=WTHPX3+(FHVSH-FHVST)*WTRSBP(NB,NZ,NY,NX) -C -C REMAINING STALK RESERVE C,N,P IF STALK REMAINING -C - WTRSVB(NB,NZ,NY,NX)=FHVST*WTRSVB(NB,NZ,NY,NX) - WTRSBN(NB,NZ,NY,NX)=FHVST*WTRSBN(NB,NZ,NY,NX) - WTRSBP(NB,NZ,NY,NX)=FHVST*WTRSBP(NB,NZ,NY,NX) -C -C CUT REPRODUCTIVE ORGANS -C - IF(IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6)THEN - IF(HVST(NZ,I,NY,NX).LT.HTSTKX - 2.OR.IHVST(NZ,I,NY,NX).EQ.3)THEN - IF(THIN(NZ,I,NY,NX).EQ.0.0)THEN - FHVSTG=1.0-EHVST(1,2,NZ,I,NY,NX) - FHVSHG=FHVSTG - ELSE - FHVSTG=1.0-THIN(NZ,I,NY,NX) - FHVSHG=1.0-EHVST(1,2,NZ,I,NY,NX)*THIN(NZ,I,NY,NX) - ENDIF - ELSE - FHVSTG=1.0-THIN(NZ,I,NY,NX) - FHVSHG=FHVSTG - ENDIF - FHVSTH=FHVSTG - FHVSTE=FHVSTG - FHVSHH=FHVSHG - FHVSHE=FHVSHG - ELSE - IF(WTHSK(NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - FHVSTH=AMAX1(0.0,AMIN1(1.0,1.0-WHVHSH/WTHSK(NZ,NY,NX))) - FHVSHH=FHVSTH - ELSE - FHVSTH=1.0 - FHVSHH=1.0 - ENDIF - IF(WTEAR(NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - FHVSTE=AMAX1(0.0,AMIN1(1.0,1.0-WHVEAH/WTEAR(NZ,NY,NX))) - FHVSHE=FHVSTE - ELSE - FHVSTE=1.0 - FHVSHE=1.0 - ENDIF - IF(WTGR(NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - FHVSTG=AMAX1(0.0,AMIN1(1.0,1.0-WHVGRH/WTGR(NZ,NY,NX))) - FHVSHG=FHVSTG - ELSE - FHVSTG=1.0 - FHVSHG=1.0 - ENDIF - ENDIF -C -C HARVESTED REPRODUCTIVE C,N,P -C - WTHTH2=WTHTH2+(1.0-FHVSHH)*WTHSKB(NB,NZ,NY,NX)+(1.0-FHVSHE) - 2*WTEARB(NB,NZ,NY,NX)+(1.0-FHVSHG)*WTGRB(NB,NZ,NY,NX) - WTHNH2=WTHNH2+(1.0-FHVSHH)*WTHSBN(NB,NZ,NY,NX)+(1.0-FHVSHE) - 2*WTEABN(NB,NZ,NY,NX)+(1.0-FHVSHG)*WTGRBN(NB,NZ,NY,NX) - WTHPH2=WTHPH2+(1.0-FHVSHH)*WTHSBP(NB,NZ,NY,NX)+(1.0-FHVSHE) - 2*WTEABP(NB,NZ,NY,NX)+(1.0-FHVSHG)*WTGRBP(NB,NZ,NY,NX) - WTHTX2=WTHTX2+(FHVSHH-FHVSTH)*WTHSKB(NB,NZ,NY,NX)+(FHVSHE-FHVSTE) - 2*WTEARB(NB,NZ,NY,NX)+(FHVSHG-FHVSTG)*WTGRB(NB,NZ,NY,NX) - WTHNX2=WTHNX2+(FHVSHH-FHVSTH)*WTHSBN(NB,NZ,NY,NX)+(FHVSHE-FHVSTE) - 2*WTEABN(NB,NZ,NY,NX)+(FHVSHG-FHVSTG)*WTGRBN(NB,NZ,NY,NX) - WTHPX2=WTHPX2+(FHVSHH-FHVSTH)*WTHSBP(NB,NZ,NY,NX)+(FHVSHE-FHVSTE) - 2*WTEABP(NB,NZ,NY,NX)+(FHVSHG-FHVSTG)*WTGRBP(NB,NZ,NY,NX) - WTHTG=WTHTG+(1.0-FHVSTG)*WTGRB(NB,NZ,NY,NX) - WTHNG=WTHNG+(1.0-FHVSTG)*WTGRBN(NB,NZ,NY,NX) - WTHPG=WTHPG+(1.0-FHVSTG)*WTGRBP(NB,NZ,NY,NX) -C -C REMAINING REPRODUCTIVE C,N,P -C - WTHSKB(NB,NZ,NY,NX)=FHVSTH*WTHSKB(NB,NZ,NY,NX) - WTEARB(NB,NZ,NY,NX)=FHVSTE*WTEARB(NB,NZ,NY,NX) - WTGRB(NB,NZ,NY,NX)=FHVSTG*WTGRB(NB,NZ,NY,NX) - WTHSBN(NB,NZ,NY,NX)=FHVSTH*WTHSBN(NB,NZ,NY,NX) - WTEABN(NB,NZ,NY,NX)=FHVSTE*WTEABN(NB,NZ,NY,NX) - WTGRBN(NB,NZ,NY,NX)=FHVSTG*WTGRBN(NB,NZ,NY,NX) - WTHSBP(NB,NZ,NY,NX)=FHVSTH*WTHSBP(NB,NZ,NY,NX) - WTEABP(NB,NZ,NY,NX)=FHVSTE*WTEABP(NB,NZ,NY,NX) - WTGRBP(NB,NZ,NY,NX)=FHVSTG*WTGRBP(NB,NZ,NY,NX) - GRNXB(NB,NZ,NY,NX)=FHVSTG*GRNXB(NB,NZ,NY,NX) - GRNOB(NB,NZ,NY,NX)=FHVSTG*GRNOB(NB,NZ,NY,NX) - GRWTB(NB,NZ,NY,NX)=FHVSTG*GRWTB(NB,NZ,NY,NX) -C -C REMAINING TOTAL BRANCH C,N,P AND LEAF, STALK AREA -C - CPOOLK(NB,NZ,NY,NX)=0.0 - DO 1325 K=1,25 - CPOOLK(NB,NZ,NY,NX)=CPOOLK(NB,NZ,NY,NX) - 2+CPOOL3(K,NB,NZ,NY,NX)+CPOOL4(K,NB,NZ,NY,NX) - 2+CO2B(K,NB,NZ,NY,NX)+HCOB(K,NB,NZ,NY,NX) -1325 CONTINUE - WTLSB(NB,NZ,NY,NX)=AMAX1(0.0,WTLFB(NB,NZ,NY,NX) - 2+WTSHEB(NB,NZ,NY,NX)) - WTSHTB(NB,NZ,NY,NX)=AMAX1(0.0,WTLFB(NB,NZ,NY,NX) - 2+WTSHEB(NB,NZ,NY,NX)+WTSTKB(NB,NZ,NY,NX)+WTRSVB(NB,NZ,NY,NX) - 3+WTHSKB(NB,NZ,NY,NX)+WTEARB(NB,NZ,NY,NX)+WTGRB(NB,NZ,NY,NX) - 4+CPOOL(NB,NZ,NY,NX)+CPOOLK(NB,NZ,NY,NX)) - WTSHTN(NB,NZ,NY,NX)=AMAX1(0.0,WTLFBN(NB,NZ,NY,NX) - 2+WTSHBN(NB,NZ,NY,NX)+WTSTBN(NB,NZ,NY,NX)+WTRSBN(NB,NZ,NY,NX) - 3+WTHSBN(NB,NZ,NY,NX)+WTEABN(NB,NZ,NY,NX)+WTGRBN(NB,NZ,NY,NX) - 4+ZPOOL(NB,NZ,NY,NX)) - WTSHTP(NB,NZ,NY,NX)=AMAX1(0.0,WTLFBP(NB,NZ,NY,NX) - 2+WTSHBP(NB,NZ,NY,NX)+WTSTBP(NB,NZ,NY,NX)+WTRSBP(NB,NZ,NY,NX) - 3+WTHSBP(NB,NZ,NY,NX)+WTEABP(NB,NZ,NY,NX)+WTGRBP(NB,NZ,NY,NX) - 4+PPOOL(NB,NZ,NY,NX)) - VOLWPX=VOLWP(NZ,NY,NX) - WVPLT=AMAX1(0.0,WTLS(NZ,NY,NX)+WVSTK(NZ,NY,NX)) - APSILT=ABS(PSILT(NZ,NY,NX)) - FDM=0.16+0.10*APSILT/(0.05*APSILT+2.0) - VOLWP(NZ,NY,NX)=1.0E-06*WVPLT/FDM - VOLWOU=VOLWOU+VOLWPX-VOLWP(NZ,NY,NX) - UVOLO(NY,NX)=UVOLO(NY,NX)+VOLWPX-VOLWP(NZ,NY,NX) -C -C RESET PHENOLOGY, GROWTH STAGE IF STALKS ARE CUT -C - IF((IBTYP(NZ,NY,NX).EQ.0.OR.IGTYP(NZ,NY,NX).LE.1) - 2.AND.(IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6) - 3.AND.ZC(NZ,NY,NX).GT.HVST(NZ,I,NY,NX))THEN - IF((IWTYP(NZ,NY,NX).NE.0 - 2.AND.VRNF(NB,NZ,NY,NX).LE.FVRN*VRNX(NB,NZ,NY,NX)) - 3.OR.(IWTYP(NZ,NY,NX).EQ.0 - 4.AND.IDAY(1,NB,NZ,NY,NX).NE.0))THEN - GROUP(NB,NZ,NY,NX)=GROUPI(NZ,NY,NX) - PSTGI(NB,NZ,NY,NX)=PSTG(NB,NZ,NY,NX) - PSTGF(NB,NZ,NY,NX)=0.0 - VSTGX(NB,NZ,NY,NX)=0.0 - TGSTGI(NB,NZ,NY,NX)=0.0 - TGSTGF(NB,NZ,NY,NX)=0.0 - FLG4(NB,NZ,NY,NX)=0.0 - IDAY(1,NB,NZ,NY,NX)=I - DO 3005 M=2,10 - IDAY(M,NB,NZ,NY,NX)=0 -3005 CONTINUE - IFLGA(NB,NZ,NY,NX)=0 - IF(NB.EQ.NB1(NZ,NY,NX))THEN - DO 3010 NBX=1,NBR(NZ,NY,NX) - IF(NBX.NE.NB1(NZ,NY,NX))THEN - GROUP(NBX,NZ,NY,NX)=GROUPI(NZ,NY,NX) - PSTGI(NBX,NZ,NY,NX)=PSTG(NBX,NZ,NY,NX) - PSTGF(NBX,NZ,NY,NX)=0.0 - VSTGX(NBX,NZ,NY,NX)=0.0 - TGSTGI(NBX,NZ,NY,NX)=0.0 - TGSTGF(NBX,NZ,NY,NX)=0.0 - FLG4(NBX,NZ,NY,NX)=0.0 - IDAY(1,NBX,NZ,NY,NX)=I - DO 3015 M=2,10 - IDAY(M,NBX,NZ,NY,NX)=0 -3015 CONTINUE - IFLGA(NBX,NZ,NY,NX)=0 - ENDIF -3010 CONTINUE - ENDIF - ENDIF - ENDIF -C -C DEATH OF BRANCH IF KILLING HARVEST ENTERED IN 'READQ' -C - IF(JHVST(NZ,I,NY,NX).NE.0)IDTHB(NB,NZ,NY,NX)=1 - IF(PP(NZ,NY,NX).LE.0.0)IDTHB(NB,NZ,NY,NX)=1 -9835 CONTINUE - WTLS(NZ,NY,NX)=0.0 - WTSTK(NZ,NY,NX)=0.0 - WVSTK(NZ,NY,NX)=0.0 - ARSTP(NZ,NY,NX)=0.0 - DO 9840 NB=1,NBR(NZ,NY,NX) - WTLS(NZ,NY,NX)=WTLS(NZ,NY,NX)+WTLSB(NB,NZ,NY,NX) - WTSTK(NZ,NY,NX)=WTSTK(NZ,NY,NX)+WTSTKB(NB,NZ,NY,NX) - WVSTK(NZ,NY,NX)=WVSTK(NZ,NY,NX)+WVSTKB(NB,NZ,NY,NX) - DO 9830 L=1,JC - ARSTP(NZ,NY,NX)=ARSTP(NZ,NY,NX)+ARSTK(L,NB,NZ,NY,NX) -9830 CONTINUE -9840 CONTINUE -C -C ROOT LITTERFALL FROM HARVESTING OR FIRE -C - IF(IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6)THEN - XHVST=1.0-THIN(NZ,I,NY,NX) - DO 3985 N=1,MY(NZ,NY,NX) - DO 3980 L=NU(NY,NX),NJ(NY,NX) - IF(IHVST(NZ,I,NY,NX).NE.5)THEN - XHVST=1.0-THIN(NZ,I,NY,NX) - XHVSN=XHVST - XHVSP=XHVST - FFIRE=0.0 - FFIRN=0.0 - FFIRP=0.0 - ELSE - IF(THETW(L,NY,NX).GT.FVLWB.OR.CORGC(L,NY,NX).LE.FORGC)THEN - XHVST=1.0 - XHVSN=XHVST - XHVSP=XHVST - FFIRE=0.0 - FFIRN=0.0 - FFIRP=0.0 - ELSE - XHVST=1.0-EHVST(1,3,NZ,I,NY,NX)*AMIN1(1.0,(CORGC(L,NY,NX)-FORGC) - 2/(0.5E+06-FORGC)) - XHVSN=XHVST - XHVSP=XHVST - FFIRE=EHVST(2,3,NZ,I,NY,NX) - FFIRN=FFIRE*EFIRE(1,IHVST(NZ,I,NY,NX)) - FFIRP=FFIRE*EFIRE(2,IHVST(NZ,I,NY,NX)) - ENDIF - ENDIF - DO 3385 M=1,4 - FHVST=(1.0-XHVST)*CFOPC(0,M,NZ,NY,NX)*CPOOLR(N,L,NZ,NY,NX) - FHVSN=(1.0-XHVSN)*CFOPN(0,M,NZ,NY,NX)*ZPOOLR(N,L,NZ,NY,NX) - FHVSP=(1.0-XHVSP)*CFOPP(0,M,NZ,NY,NX)*PPOOLR(N,L,NZ,NY,NX) - CSNC(M,1,L,NZ,NY,NX)=CSNC(M,1,L,NZ,NY,NX)+(1.0-FFIRE)*FHVST - ZSNC(M,1,L,NZ,NY,NX)=ZSNC(M,1,L,NZ,NY,NX)+(1.0-FFIRN)*FHVSN - PSNC(M,1,L,NZ,NY,NX)=PSNC(M,1,L,NZ,NY,NX)+(1.0-FFIRP)*FHVSP - VCO2F(NZ,NY,NX)=VCO2F(NZ,NY,NX)-(1.0-FCH4F)*FFIRE*FHVST - VCH4F(NZ,NY,NX)=VCH4F(NZ,NY,NX)-FCH4F*FFIRE*FHVST - VOXYF(NZ,NY,NX)=VOXYF(NZ,NY,NX)-(1.0-FCH4F)*FFIRE*FHVST*2.667 - VNH3F(NZ,NY,NX)=VNH3F(NZ,NY,NX)-FFIRN*FHVSN - VN2OF(NZ,NY,NX)=VN2OF(NZ,NY,NX)-0.0 - VPO4F(NZ,NY,NX)=VPO4F(NZ,NY,NX)-FFIRP*FHVSP - CNET(NZ,NY,NX)=CNET(NZ,NY,NX)-(1.0-FCH4F)*FFIRE*FHVST - TNBP(NY,NX)=TNBP(NY,NX)-FCH4F*FFIRE*FHVST - DO 3385 NR=1,NRT(NZ,NY,NX) - FHVST=(1.0-XHVST)*CFOPC(5,M,NZ,NY,NX)*(WTRT1(N,L,NR,NZ,NY,NX) - 3+WTRT2(N,L,NR,NZ,NY,NX))*FWOOD(0) - FHVSN=(1.0-XHVSN)*CFOPN(5,M,NZ,NY,NX)*(WTRT1N(N,L,NR,NZ,NY,NX) - 3+WTRT2N(N,L,NR,NZ,NY,NX))*FWOODN(0) - FHVSP=(1.0-XHVSP)*CFOPP(5,M,NZ,NY,NX)*(WTRT1P(N,L,NR,NZ,NY,NX) - 3+WTRT2P(N,L,NR,NZ,NY,NX))*FWOODP(0) - CSNC(M,1,L,NZ,NY,NX)=CSNC(M,1,L,NZ,NY,NX)+(1.0-FFIRE)*FHVST - ZSNC(M,1,L,NZ,NY,NX)=ZSNC(M,1,L,NZ,NY,NX)+(1.0-FFIRN)*FHVSN - PSNC(M,1,L,NZ,NY,NX)=PSNC(M,1,L,NZ,NY,NX)+(1.0-FFIRP)*FHVSP - VCO2F(NZ,NY,NX)=VCO2F(NZ,NY,NX)-(1.0-FCH4F)*FFIRE*FHVST - VCH4F(NZ,NY,NX)=VCH4F(NZ,NY,NX)-FCH4F*FFIRE*FHVST - VOXYF(NZ,NY,NX)=VOXYF(NZ,NY,NX)-(1.0-FCH4F)*FFIRE*FHVST*2.667 - VNH3F(NZ,NY,NX)=VNH3F(NZ,NY,NX)-FFIRN*FHVSN - VN2OF(NZ,NY,NX)=VN2OF(NZ,NY,NX)-0.0 - VPO4F(NZ,NY,NX)=VPO4F(NZ,NY,NX)-FFIRP*FHVSP - CNET(NZ,NY,NX)=CNET(NZ,NY,NX)-(1.0-FCH4F)*FFIRE*FHVST - TNBP(NY,NX)=TNBP(NY,NX)-FCH4F*FFIRE*FHVST - FHVST=(1.0-XHVST)*CFOPC(4,M,NZ,NY,NX)*(WTRT1(N,L,NR,NZ,NY,NX) - 3+WTRT2(N,L,NR,NZ,NY,NX))*FWOOD(1) - FHVSN=(1.0-XHVSN)*CFOPN(4,M,NZ,NY,NX)*(WTRT1N(N,L,NR,NZ,NY,NX) - 3+WTRT2N(N,L,NR,NZ,NY,NX))*FWOODN(1) - FHVSP=(1.0-XHVSP)*CFOPP(4,M,NZ,NY,NX)*(WTRT1P(N,L,NR,NZ,NY,NX) - 3+WTRT2P(N,L,NR,NZ,NY,NX))*FWOODP(1) - CSNC(M,1,L,NZ,NY,NX)=CSNC(M,1,L,NZ,NY,NX)+(1.0-FFIRE)*FHVST - ZSNC(M,1,L,NZ,NY,NX)=ZSNC(M,1,L,NZ,NY,NX)+(1.0-FFIRN)*FHVSN - PSNC(M,1,L,NZ,NY,NX)=PSNC(M,1,L,NZ,NY,NX)+(1.0-FFIRP)*FHVSP - VCO2F(NZ,NY,NX)=VCO2F(NZ,NY,NX)-(1.0-FCH4F)*FFIRE*FHVST - VCH4F(NZ,NY,NX)=VCH4F(NZ,NY,NX)-FCH4F*FFIRE*FHVST - VOXYF(NZ,NY,NX)=VOXYF(NZ,NY,NX)-(1.0-FCH4F)*FFIRE*FHVST*2.667 - VNH3F(NZ,NY,NX)=VNH3F(NZ,NY,NX)-FFIRN*FHVSN - VN2OF(NZ,NY,NX)=VN2OF(NZ,NY,NX)-0.0 - VPO4F(NZ,NY,NX)=VPO4F(NZ,NY,NX)-FFIRP*FHVSP - CNET(NZ,NY,NX)=CNET(NZ,NY,NX)-(1.0-FCH4F)*FFIRE*FHVST - TNBP(NY,NX)=TNBP(NY,NX)-FCH4F*FFIRE*FHVST -3385 CONTINUE -C WRITE(*,6161)'FIRE',I,J,NZ,L,N,M,VCO2F(NZ,NY,NX),FFIRE -C 2,FHVST,CFOPC(4,M,NZ,NY,NX),CPOOLR(N,L,NZ,NY,NX),THETW(L,NY,NX) -C 3,CORGC(L,NY,NX) -6161 FORMAT(A8,6I4,20E12.4) -C -C RELEASE ROOT GAS CONTENTS DURING HARVESTING -C - RCO2Z(NZ,NY,NX)=RCO2Z(NZ,NY,NX)-(1.0-XHVST) - 2*(CO2A(N,L,NZ,NY,NX)+CO2P(N,L,NZ,NY,NX)) - ROXYZ(NZ,NY,NX)=ROXYZ(NZ,NY,NX)-(1.0-XHVST) - 2*(OXYA(N,L,NZ,NY,NX)+OXYP(N,L,NZ,NY,NX)) - RCH4Z(NZ,NY,NX)=RCH4Z(NZ,NY,NX)-(1.0-XHVST) - 2*(CH4A(N,L,NZ,NY,NX)+CH4P(N,L,NZ,NY,NX)) - RN2OZ(NZ,NY,NX)=RN2OZ(NZ,NY,NX)-(1.0-XHVST) - 2*(Z2OA(N,L,NZ,NY,NX)+Z2OP(N,L,NZ,NY,NX)) - RNH3Z(NZ,NY,NX)=RNH3Z(NZ,NY,NX)-(1.0-XHVST) - 2*(ZH3A(N,L,NZ,NY,NX)+ZH3P(N,L,NZ,NY,NX)) - RH2GZ(NZ,NY,NX)=RH2GZ(NZ,NY,NX)-(1.0-XHVST) - 2*(H2GA(N,L,NZ,NY,NX)+H2GP(N,L,NZ,NY,NX)) - CO2A(N,L,NZ,NY,NX)=XHVST*CO2A(N,L,NZ,NY,NX) - OXYA(N,L,NZ,NY,NX)=XHVST*OXYA(N,L,NZ,NY,NX) - CH4A(N,L,NZ,NY,NX)=XHVST*CH4A(N,L,NZ,NY,NX) - Z2OA(N,L,NZ,NY,NX)=XHVST*Z2OA(N,L,NZ,NY,NX) - ZH3A(N,L,NZ,NY,NX)=XHVST*ZH3A(N,L,NZ,NY,NX) - H2GA(N,L,NZ,NY,NX)=XHVST*H2GA(N,L,NZ,NY,NX) - CO2P(N,L,NZ,NY,NX)=XHVST*CO2P(N,L,NZ,NY,NX) - OXYP(N,L,NZ,NY,NX)=XHVST*OXYP(N,L,NZ,NY,NX) - CH4P(N,L,NZ,NY,NX)=XHVST*CH4P(N,L,NZ,NY,NX) - Z2OP(N,L,NZ,NY,NX)=XHVST*Z2OP(N,L,NZ,NY,NX) - ZH3P(N,L,NZ,NY,NX)=XHVST*ZH3P(N,L,NZ,NY,NX) - H2GP(N,L,NZ,NY,NX)=XHVST*H2GP(N,L,NZ,NY,NX) -C -C REDUCE ROOT STATE VARIABLES DURING HARVESTING -C - DO 3960 NR=1,NRT(NZ,NY,NX) - WTRT1(N,L,NR,NZ,NY,NX)=WTRT1(N,L,NR,NZ,NY,NX)*XHVST - WTRT2(N,L,NR,NZ,NY,NX)=WTRT2(N,L,NR,NZ,NY,NX)*XHVST - WTRT1N(N,L,NR,NZ,NY,NX)=WTRT1N(N,L,NR,NZ,NY,NX)*XHVST - WTRT2N(N,L,NR,NZ,NY,NX)=WTRT2N(N,L,NR,NZ,NY,NX)*XHVST - WTRT1P(N,L,NR,NZ,NY,NX)=WTRT1P(N,L,NR,NZ,NY,NX)*XHVST - WTRT2P(N,L,NR,NZ,NY,NX)=WTRT2P(N,L,NR,NZ,NY,NX)*XHVST - RTWT1(N,NR,NZ,NY,NX)=RTWT1(N,NR,NZ,NY,NX)*XHVST - RTWT1N(N,NR,NZ,NY,NX)=RTWT1N(N,NR,NZ,NY,NX)*XHVST - RTWT1P(N,NR,NZ,NY,NX)=RTWT1P(N,NR,NZ,NY,NX)*XHVST - RTLG1(N,L,NR,NZ,NY,NX)=RTLG1(N,L,NR,NZ,NY,NX)*XHVST - RTLG2(N,L,NR,NZ,NY,NX)=RTLG2(N,L,NR,NZ,NY,NX)*XHVST - RTN2(N,L,NR,NZ,NY,NX)=RTN2(N,L,NR,NZ,NY,NX)*XHVST -3960 CONTINUE - CPOOLR(N,L,NZ,NY,NX)=CPOOLR(N,L,NZ,NY,NX)*XHVST - ZPOOLR(N,L,NZ,NY,NX)=ZPOOLR(N,L,NZ,NY,NX)*XHVST - PPOOLR(N,L,NZ,NY,NX)=PPOOLR(N,L,NZ,NY,NX)*XHVST - WTRTL(N,L,NZ,NY,NX)=WTRTL(N,L,NZ,NY,NX)*XHVST - WTRTD(N,L,NZ,NY,NX)=WTRTD(N,L,NZ,NY,NX)*XHVST - WSRTL(N,L,NZ,NY,NX)=WSRTL(N,L,NZ,NY,NX)*XHVST - RTN1(N,L,NZ,NY,NX)=RTN1(N,L,NZ,NY,NX)*XHVST - RTNL(N,L,NZ,NY,NX)=RTNL(N,L,NZ,NY,NX)*XHVST - RTLGP(N,L,NZ,NY,NX)=RTLGP(N,L,NZ,NY,NX)*XHVST - RTDNP(N,L,NZ,NY,NX)=RTDNP(N,L,NZ,NY,NX)*XHVST - RTVLP(N,L,NZ,NY,NX)=RTVLP(N,L,NZ,NY,NX)*XHVST - RTVLW(N,L,NZ,NY,NX)=RTVLW(N,L,NZ,NY,NX)*XHVST - RTARP(N,L,NZ,NY,NX)=RTARP(N,L,NZ,NY,NX)*XHVST - RCO2M(N,L,NZ,NY,NX)=RCO2M(N,L,NZ,NY,NX)*XHVST - RCO2N(N,L,NZ,NY,NX)=RCO2N(N,L,NZ,NY,NX)*XHVST - RCO2A(N,L,NZ,NY,NX)=RCO2A(N,L,NZ,NY,NX)*XHVST -C -C NODULE LITTERFALL AND STATE VARIABLES DURING HARVESTING -C - IF(INTYP(NZ,NY,NX).NE.0.AND.N.EQ.1)THEN - DO 3395 M=1,4 - CSNC(M,1,L,NZ,NY,NX)=CSNC(M,1,L,NZ,NY,NX)+(1.0-XHVST) - 2*(CFOPC(4,M,NZ,NY,NX)*WTNDL(L,NZ,NY,NX) - 3+CFOPC(0,M,NZ,NY,NX)*CPOOLN(L,NZ,NY,NX)) - ZSNC(M,1,L,NZ,NY,NX)=ZSNC(M,1,L,NZ,NY,NX)+(1.0-XHVST) - 2*(CFOPN(4,M,NZ,NY,NX)*WTNDLN(L,NZ,NY,NX) - 3+CFOPN(0,M,NZ,NY,NX)*ZPOOLN(L,NZ,NY,NX)) - PSNC(M,1,L,NZ,NY,NX)=PSNC(M,1,L,NZ,NY,NX)+(1.0-XHVST) - 2*(CFOPP(4,M,NZ,NY,NX)*WTNDLP(L,NZ,NY,NX) - 3+CFOPP(0,M,NZ,NY,NX)*PPOOLN(L,NZ,NY,NX)) -3395 CONTINUE - WTNDL(L,NZ,NY,NX)=WTNDL(L,NZ,NY,NX)*XHVST - WTNDLN(L,NZ,NY,NX)=WTNDLN(L,NZ,NY,NX)*XHVST - WTNDLP(L,NZ,NY,NX)=WTNDLP(L,NZ,NY,NX)*XHVST - CPOOLN(L,NZ,NY,NX)=CPOOLN(L,NZ,NY,NX)*XHVST - ZPOOLN(L,NZ,NY,NX)=ZPOOLN(L,NZ,NY,NX)*XHVST - PPOOLN(L,NZ,NY,NX)=PPOOLN(L,NZ,NY,NX)*XHVST - ENDIF -3980 CONTINUE -3985 CONTINUE -C -C STORAGE LITTERFALL AND STATE VARIABLES DURING HARVESTING -C - IF(ISTYP(NZ,NY,NX).NE.0)THEN - DO 3400 M=1,4 - CSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX)=CSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX) - 2+((1.0-XHVST)*CFOPC(0,M,NZ,NY,NX)*WTRVC(NZ,NY,NX))*FWOOD(0) - ZSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX)=ZSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX) - 2+((1.0-XHVST)*CFOPN(0,M,NZ,NY,NX)*WTRVN(NZ,NY,NX))*FWOODN(0) - PSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX)=PSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX) - 2+((1.0-XHVST)*CFOPP(0,M,NZ,NY,NX)*WTRVP(NZ,NY,NX))*FWOODP(0) - CSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX)=CSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX) - 2+((1.0-XHVST)*CFOPC(0,M,NZ,NY,NX)*WTRVC(NZ,NY,NX))*FWOOD(1) - ZSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX)=ZSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX) - 2+((1.0-XHVST)*CFOPN(0,M,NZ,NY,NX)*WTRVN(NZ,NY,NX))*FWOODN(1) - PSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX)=PSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX) - 2+((1.0-XHVST)*CFOPP(0,M,NZ,NY,NX)*WTRVP(NZ,NY,NX))*FWOODP(1) -3400 CONTINUE - WTRVC(NZ,NY,NX)=WTRVC(NZ,NY,NX)*XHVST - WTRVN(NZ,NY,NX)=WTRVN(NZ,NY,NX)*XHVST - WTRVP(NZ,NY,NX)=WTRVP(NZ,NY,NX)*XHVST - ENDIF - ENDIF - ENDIF -C -C REDUCE OR REMOVE PLANT POPULATIONS DURING TILLAGE -C - IF(J.EQ.INT(ZNOON(NY,NX)).AND.(IBTYP(NZ,NY,NX).EQ.0 - 2.OR.IGTYP(NZ,NY,NX).LE.1).AND.(I.NE.IDAY0(NZ,NY,NX) - 3.OR.IDATA(3).NE.IYR0(NZ,NY,NX)))THEN - IF(ITILL(I,NY,NX).LE.10.OR.NZ.NE.1)THEN - IF(I.GT.IDAY0(NZ,NY,NX).OR.IYRC.GT.IYR0(NZ,NY,NX))THEN - XHVST=XCORP(NY,NX) - PPX(NZ,NY,NX)=PPX(NZ,NY,NX)*XHVST - PP(NZ,NY,NX)=PP(NZ,NY,NX)*XHVST - FRADP(NZ,NY,NX)=FRADP(NZ,NY,NX)*XHVST - VHCPC(NZ,NY,NX)=VHCPC(NZ,NY,NX)*XHVST - WTLS(NZ,NY,NX)=0.0 - WVSTK(NZ,NY,NX)=0.0 -C -C TERMINATE BRANCHES IF TILLAGE IMPLEMENT 20 IS SELECTED -C - DO 8975 NB=1,NBR(NZ,NY,NX) - IF(IDTHB(NB,NZ,NY,NX).EQ.0)THEN - IF(XHVST.LE.1.0E-06)THEN - IDTHB(NB,NZ,NY,NX)=1 - ENDIF -C -C LITTERFALL FROM BRANCHES DURING TILLAGE -C - DO 6380 M=1,4 - CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX)+(1.0-XHVST) - 2*(CFOPC(0,M,NZ,NY,NX)*(CPOOL(NB,NZ,NY,NX)+CPOLNB(NB,NZ,NY,NX) - 3+CPOOLK(NB,NZ,NY,NX)+WTRSVB(NB,NZ,NY,NX)) - 4+CFOPC(1,M,NZ,NY,NX)*(WTLFB(NB,NZ,NY,NX)*FWODB(1) - 5+WTNDB(NB,NZ,NY,NX)) - 6+CFOPC(2,M,NZ,NY,NX)*(WTSHEB(NB,NZ,NY,NX)*FWODB(1) - 7+WTHSKB(NB,NZ,NY,NX)+WTEARB(NB,NZ,NY,NX))) - CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX)+(1.0-XHVST) - 2*CFOPC(5,M,NZ,NY,NX)*(WTLFB(NB,NZ,NY,NX)*FWODB(0) - 3+WTSHEB(NB,NZ,NY,NX)*FWODB(0)) - ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX)+(1.0-XHVST) - 2*(CFOPN(0,M,NZ,NY,NX)*(ZPOOL(NB,NZ,NY,NX)+ZPOLNB(NB,NZ,NY,NX) - 3+WTRSBN(NB,NZ,NY,NX)) - 4+CFOPN(1,M,NZ,NY,NX)*(WTLFBN(NB,NZ,NY,NX)*FWODLN(1) - 5+WTNDBN(NB,NZ,NY,NX)) - 6+CFOPN(2,M,NZ,NY,NX)*(WTSHBN(NB,NZ,NY,NX)*FWODSN(1) - 7+WTHSBN(NB,NZ,NY,NX)+WTEABN(NB,NZ,NY,NX))) - ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX)+(1.0-XHVST) - 2*CFOPN(5,M,NZ,NY,NX)*(WTLFBN(NB,NZ,NY,NX)*FWODLN(0) - 3+WTSHBN(NB,NZ,NY,NX)*FWODSN(0)) - PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX)+(1.0-XHVST) - 2*(CFOPP(0,M,NZ,NY,NX)*(PPOOL(NB,NZ,NY,NX)+PPOLNB(NB,NZ,NY,NX) - 3+WTRSBP(NB,NZ,NY,NX)) - 4+CFOPP(1,M,NZ,NY,NX)*(WTLFBP(NB,NZ,NY,NX)*FWODLP(1) - 5+WTNDBP(NB,NZ,NY,NX)) - 6+CFOPP(2,M,NZ,NY,NX)*(WTSHBP(NB,NZ,NY,NX)*FWODSP(1) - 7+WTHSBP(NB,NZ,NY,NX)+WTEABP(NB,NZ,NY,NX))) - PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX)+(1.0-XHVST) - 2*CFOPP(5,M,NZ,NY,NX)*(WTLFBP(NB,NZ,NY,NX)*FWODLP(0) - 3+WTSHBP(NB,NZ,NY,NX)*FWODSP(0)) - IF(ISTYP(NZ,NY,NX).EQ.0.AND.IWTYP(NZ,NY,NX).NE.0)THEN - WTRVC(NZ,NY,NX)=WTRVC(NZ,NY,NX)+(1.0-XHVST) - 2*CFOPC(2,M,NZ,NY,NX)*WTGRB(NB,NZ,NY,NX) - WTRVN(NZ,NY,NX)=WTRVN(NZ,NY,NX)+(1.0-XHVST) - 2*CFOPN(2,M,NZ,NY,NX)*WTGRBN(NB,NZ,NY,NX) - WTRVP(NZ,NY,NX)=WTRVP(NZ,NY,NX)+(1.0-XHVST) - 2*CFOPP(2,M,NZ,NY,NX)*WTGRBP(NB,NZ,NY,NX) - ELSE - CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX)+(1.0-XHVST) - 2*CFOPC(2,M,NZ,NY,NX)*WTGRB(NB,NZ,NY,NX) - ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX)+(1.0-XHVST) - 2*CFOPN(2,M,NZ,NY,NX)*WTGRBN(NB,NZ,NY,NX) - PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX)+(1.0-XHVST) - 2*CFOPP(2,M,NZ,NY,NX)*WTGRBP(NB,NZ,NY,NX) - ENDIF - IF(IBTYP(NZ,NY,NX).EQ.0.OR.IGTYP(NZ,NY,NX).LE.1)THEN - CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX)+(1.0-XHVST) - 2*CFOPC(3,M,NZ,NY,NX)*WTSTKB(NB,NZ,NY,NX) - ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX)+(1.0-XHVST) - 2*CFOPN(3,M,NZ,NY,NX)*WTSTBN(NB,NZ,NY,NX) - PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX)+(1.0-XHVST) - 2*CFOPP(3,M,NZ,NY,NX)*WTSTBP(NB,NZ,NY,NX) - ELSE - CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX)+(1.0-XHVST) - 2*CFOPC(5,M,NZ,NY,NX)*WTSTKB(NB,NZ,NY,NX) - ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX)+(1.0-XHVST) - 2*CFOPN(5,M,NZ,NY,NX)*WTSTBN(NB,NZ,NY,NX) - PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX)+(1.0-XHVST) - 2*CFOPP(5,M,NZ,NY,NX)*WTSTBP(NB,NZ,NY,NX) - ENDIF -6380 CONTINUE -C -C REDUCE PLANT STATE VARIABLES DURING TILLAGE -C - CPOOL(NB,NZ,NY,NX)=CPOOL(NB,NZ,NY,NX)*XHVST - CPOOLK(NB,NZ,NY,NX)=CPOOLK(NB,NZ,NY,NX)*XHVST - ZPOOL(NB,NZ,NY,NX)=ZPOOL(NB,NZ,NY,NX)*XHVST - PPOOL(NB,NZ,NY,NX)=PPOOL(NB,NZ,NY,NX)*XHVST - CPOLNB(NB,NZ,NY,NX)=CPOLNB(NB,NZ,NY,NX)*XHVST - ZPOLNB(NB,NZ,NY,NX)=ZPOLNB(NB,NZ,NY,NX)*XHVST - PPOLNB(NB,NZ,NY,NX)=PPOLNB(NB,NZ,NY,NX)*XHVST - WTSHTB(NB,NZ,NY,NX)=WTSHTB(NB,NZ,NY,NX)*XHVST - WTLFB(NB,NZ,NY,NX)=WTLFB(NB,NZ,NY,NX)*XHVST - WTNDB(NB,NZ,NY,NX)=WTNDB(NB,NZ,NY,NX)*XHVST - WTSHEB(NB,NZ,NY,NX)=WTSHEB(NB,NZ,NY,NX)*XHVST - WTSTKB(NB,NZ,NY,NX)=WTSTKB(NB,NZ,NY,NX)*XHVST - WVSTKB(NB,NZ,NY,NX)=WVSTKB(NB,NZ,NY,NX)*XHVST - WTRSVB(NB,NZ,NY,NX)=WTRSVB(NB,NZ,NY,NX)*XHVST - WTHSKB(NB,NZ,NY,NX)=WTHSKB(NB,NZ,NY,NX)*XHVST - WTEARB(NB,NZ,NY,NX)=WTEARB(NB,NZ,NY,NX)*XHVST - WTGRB(NB,NZ,NY,NX)=WTGRB(NB,NZ,NY,NX)*XHVST - WTSHTN(NB,NZ,NY,NX)=WTSHTN(NB,NZ,NY,NX)*XHVST - WTLFBN(NB,NZ,NY,NX)=WTLFBN(NB,NZ,NY,NX)*XHVST - WTNDBN(NB,NZ,NY,NX)=WTNDBN(NB,NZ,NY,NX)*XHVST - WTSHBN(NB,NZ,NY,NX)=WTSHBN(NB,NZ,NY,NX)*XHVST - WTSTBN(NB,NZ,NY,NX)=WTSTBN(NB,NZ,NY,NX)*XHVST - WTRSBN(NB,NZ,NY,NX)=WTRSBN(NB,NZ,NY,NX)*XHVST - WTHSBN(NB,NZ,NY,NX)=WTHSBN(NB,NZ,NY,NX)*XHVST - WTEABN(NB,NZ,NY,NX)=WTEABN(NB,NZ,NY,NX)*XHVST - WTGRBN(NB,NZ,NY,NX)=WTGRBN(NB,NZ,NY,NX)*XHVST - WTSHTP(NB,NZ,NY,NX)=WTSHTP(NB,NZ,NY,NX)*XHVST - WTLFBP(NB,NZ,NY,NX)=WTLFBP(NB,NZ,NY,NX)*XHVST - WTNDBP(NB,NZ,NY,NX)=WTNDBP(NB,NZ,NY,NX)*XHVST - WTSHBP(NB,NZ,NY,NX)=WTSHBP(NB,NZ,NY,NX)*XHVST - WTSTBP(NB,NZ,NY,NX)=WTSTBP(NB,NZ,NY,NX)*XHVST - WTRSBP(NB,NZ,NY,NX)=WTRSBP(NB,NZ,NY,NX)*XHVST - WTHSBP(NB,NZ,NY,NX)=WTHSBP(NB,NZ,NY,NX)*XHVST - WTEABP(NB,NZ,NY,NX)=WTEABP(NB,NZ,NY,NX)*XHVST - WTGRBP(NB,NZ,NY,NX)=WTGRBP(NB,NZ,NY,NX)*XHVST - GRNXB(NB,NZ,NY,NX)=GRNXB(NB,NZ,NY,NX)*XHVST - GRNOB(NB,NZ,NY,NX)=GRNOB(NB,NZ,NY,NX)*XHVST - GRWTB(NB,NZ,NY,NX)=GRWTB(NB,NZ,NY,NX)*XHVST - ARLFB(NB,NZ,NY,NX)=ARLFB(NB,NZ,NY,NX)*XHVST - WTLSB(NB,NZ,NY,NX)=AMAX1(0.0,WTLFB(NB,NZ,NY,NX) - 2+WTSHEB(NB,NZ,NY,NX)) - WTLS(NZ,NY,NX)=WTLS(NZ,NY,NX)+WTLSB(NB,NZ,NY,NX) - WTSTXB(NB,NZ,NY,NX)=WTSTXB(NB,NZ,NY,NX)*XHVST - WTSTXN(NB,NZ,NY,NX)=WTSTXN(NB,NZ,NY,NX)*XHVST - WTSTXP(NB,NZ,NY,NX)=WTSTXP(NB,NZ,NY,NX)*XHVST - WVSTK(NZ,NY,NX)=WVSTK(NZ,NY,NX)+WVSTKB(NB,NZ,NY,NX) - DO 8970 K=0,25 - IF(K.NE.0)THEN - CPOOL3(K,NB,NZ,NY,NX)=CPOOL3(K,NB,NZ,NY,NX)*XHVST - CPOOL4(K,NB,NZ,NY,NX)=CPOOL4(K,NB,NZ,NY,NX)*XHVST - CO2B(K,NB,NZ,NY,NX)=CO2B(K,NB,NZ,NY,NX)*XHVST - HCOB(K,NB,NZ,NY,NX)=HCOB(K,NB,NZ,NY,NX)*XHVST - ENDIF - ARLF(K,NB,NZ,NY,NX)=ARLF(K,NB,NZ,NY,NX)*XHVST - WGLF(K,NB,NZ,NY,NX)=WGLF(K,NB,NZ,NY,NX)*XHVST - WSLF(K,NB,NZ,NY,NX)=WSLF(K,NB,NZ,NY,NX)*XHVST -C HTSHE(K,NB,NZ,NY,NX)=HTSHE(K,NB,NZ,NY,NX)*XHVST - WGSHE(K,NB,NZ,NY,NX)=WGSHE(K,NB,NZ,NY,NX)*XHVST - WSSHE(K,NB,NZ,NY,NX)=WSSHE(K,NB,NZ,NY,NX)*XHVST -C HTNODE(K,NB,NZ,NY,NX)=HTNODE(K,NB,NZ,NY,NX)*XHVST -C HTNODX(K,NB,NZ,NY,NX)=HTNODX(K,NB,NZ,NY,NX)*XHVST - WGNODE(K,NB,NZ,NY,NX)=WGNODE(K,NB,NZ,NY,NX)*XHVST - WGLFN(K,NB,NZ,NY,NX)=WGLFN(K,NB,NZ,NY,NX)*XHVST - WGSHN(K,NB,NZ,NY,NX)=WGSHN(K,NB,NZ,NY,NX)*XHVST - WGNODN(K,NB,NZ,NY,NX)=WGNODN(K,NB,NZ,NY,NX)*XHVST - WGLFP(K,NB,NZ,NY,NX)=WGLFP(K,NB,NZ,NY,NX)*XHVST - WGSHP(K,NB,NZ,NY,NX)=WGSHP(K,NB,NZ,NY,NX)*XHVST - WGNODP(K,NB,NZ,NY,NX)=WGNODP(K,NB,NZ,NY,NX)*XHVST - DO 8965 L=1,JC - ARLFL(L,K,NB,NZ,NY,NX)=ARLFL(L,K,NB,NZ,NY,NX)*XHVST - WGLFL(L,K,NB,NZ,NY,NX)=WGLFL(L,K,NB,NZ,NY,NX)*XHVST - WGLFLN(L,K,NB,NZ,NY,NX)=WGLFLN(L,K,NB,NZ,NY,NX)*XHVST - WGLFLP(L,K,NB,NZ,NY,NX)=WGLFLP(L,K,NB,NZ,NY,NX)*XHVST -8965 CONTINUE -8970 CONTINUE - ENDIF -8975 CONTINUE - VOLWPX=VOLWP(NZ,NY,NX) - WVPLT=AMAX1(0.0,WTLS(NZ,NY,NX)+WVSTK(NZ,NY,NX)) - APSILT=ABS(PSILT(NZ,NY,NX)) - FDM=0.16+0.10*APSILT/(0.05*APSILT+2.0) - VOLWP(NZ,NY,NX)=1.0E-06*WVPLT/FDM - VOLWOU=VOLWOU+VOLWPX-VOLWP(NZ,NY,NX) - UVOLO(NY,NX)=UVOLO(NY,NX)+VOLWPX-VOLWP(NZ,NY,NX) -C -C TERMINATE ROOTS IF TILLAGE IMPLEMENT 20 IS SELECTED -C - IF(XHVST.LE.1.0E-06)THEN - IDTHR(NZ,NY,NX)=1 - IDTHP(NZ,NY,NX)=1 - JHVST(NZ,I,NY,NX)=1 - ENDIF -C -C LITTERFALL FROM ROOTS DURING TILLAGE -C - DO 8985 N=1,MY(NZ,NY,NX) - DO 8980 L=NU(NY,NX),NJ(NY,NX) - DO 6385 M=1,4 - CSNC(M,1,L,NZ,NY,NX)=CSNC(M,1,L,NZ,NY,NX)+(1.0-XHVST) - 2*CFOPC(0,M,NZ,NY,NX)*CPOOLR(N,L,NZ,NY,NX) - ZSNC(M,1,L,NZ,NY,NX)=ZSNC(M,1,L,NZ,NY,NX)+(1.0-XHVST) - 2*CFOPN(0,M,NZ,NY,NX)*ZPOOLR(N,L,NZ,NY,NX) - PSNC(M,1,L,NZ,NY,NX)=PSNC(M,1,L,NZ,NY,NX)+(1.0-XHVST) - 2*CFOPP(0,M,NZ,NY,NX)*PPOOLR(N,L,NZ,NY,NX) - DO 6385 NR=1,NRT(NZ,NY,NX) - CSNC(M,0,L,NZ,NY,NX)=CSNC(M,0,L,NZ,NY,NX)+(1.0-XHVST) - 2*CFOPC(5,M,NZ,NY,NX)*(WTRT1(N,L,NR,NZ,NY,NX) - 3+WTRT2(N,L,NR,NZ,NY,NX))*FWOOD(0) - ZSNC(M,0,L,NZ,NY,NX)=ZSNC(M,0,L,NZ,NY,NX)+(1.0-XHVST) - 2*CFOPN(5,M,NZ,NY,NX)*(WTRT1N(N,L,NR,NZ,NY,NX) - 3+WTRT2N(N,L,NR,NZ,NY,NX))*FWOODN(0) - PSNC(M,0,L,NZ,NY,NX)=PSNC(M,0,L,NZ,NY,NX)+(1.0-XHVST) - 2*CFOPP(5,M,NZ,NY,NX)*(WTRT1P(N,L,NR,NZ,NY,NX) - 3+WTRT2P(N,L,NR,NZ,NY,NX))*FWOODP(0) - CSNC(M,1,L,NZ,NY,NX)=CSNC(M,1,L,NZ,NY,NX)+(1.0-XHVST) - 2*CFOPC(4,M,NZ,NY,NX)*(WTRT1(N,L,NR,NZ,NY,NX) - 3+WTRT2(N,L,NR,NZ,NY,NX))*FWOOD(1) - ZSNC(M,1,L,NZ,NY,NX)=ZSNC(M,1,L,NZ,NY,NX)+(1.0-XHVST) - 2*CFOPN(4,M,NZ,NY,NX)*(WTRT1N(N,L,NR,NZ,NY,NX) - 3+WTRT2N(N,L,NR,NZ,NY,NX))*FWOODN(1) - PSNC(M,1,L,NZ,NY,NX)=PSNC(M,1,L,NZ,NY,NX)+(1.0-XHVST) - 2*CFOPP(4,M,NZ,NY,NX)*(WTRT1P(N,L,NR,NZ,NY,NX) - 3+WTRT2P(N,L,NR,NZ,NY,NX))*FWOODP(1) -6385 CONTINUE -C -C RELEASE ROOT GAS CONTENTS DURING TILLAGE -C - RCO2Z(NZ,NY,NX)=RCO2Z(NZ,NY,NX)-(1.0-XHVST) - 2*(CO2A(N,L,NZ,NY,NX)+CO2P(N,L,NZ,NY,NX)) - ROXYZ(NZ,NY,NX)=ROXYZ(NZ,NY,NX)-(1.0-XHVST) - 2*(OXYA(N,L,NZ,NY,NX)+OXYP(N,L,NZ,NY,NX)) - RCH4Z(NZ,NY,NX)=RCH4Z(NZ,NY,NX)-(1.0-XHVST) - 2*(CH4A(N,L,NZ,NY,NX)+CH4P(N,L,NZ,NY,NX)) - RN2OZ(NZ,NY,NX)=RN2OZ(NZ,NY,NX)-(1.0-XHVST) - 2*(Z2OA(N,L,NZ,NY,NX)+Z2OP(N,L,NZ,NY,NX)) - RNH3Z(NZ,NY,NX)=RNH3Z(NZ,NY,NX)-(1.0-XHVST) - 2*(ZH3A(N,L,NZ,NY,NX)+ZH3P(N,L,NZ,NY,NX)) - RH2GZ(NZ,NY,NX)=RH2GZ(NZ,NY,NX)-(1.0-XHVST) - 2*(H2GA(N,L,NZ,NY,NX)+H2GP(N,L,NZ,NY,NX)) - CO2A(N,L,NZ,NY,NX)=XHVST*CO2A(N,L,NZ,NY,NX) - OXYA(N,L,NZ,NY,NX)=XHVST*OXYA(N,L,NZ,NY,NX) - CH4A(N,L,NZ,NY,NX)=XHVST*CH4A(N,L,NZ,NY,NX) - Z2OA(N,L,NZ,NY,NX)=XHVST*Z2OA(N,L,NZ,NY,NX) - ZH3A(N,L,NZ,NY,NX)=XHVST*ZH3A(N,L,NZ,NY,NX) - H2GA(N,L,NZ,NY,NX)=XHVST*H2GA(N,L,NZ,NY,NX) - CO2P(N,L,NZ,NY,NX)=XHVST*CO2P(N,L,NZ,NY,NX) - OXYP(N,L,NZ,NY,NX)=XHVST*OXYP(N,L,NZ,NY,NX) - CH4P(N,L,NZ,NY,NX)=XHVST*CH4P(N,L,NZ,NY,NX) - Z2OP(N,L,NZ,NY,NX)=XHVST*Z2OP(N,L,NZ,NY,NX) - ZH3P(N,L,NZ,NY,NX)=XHVST*ZH3P(N,L,NZ,NY,NX) - H2GP(N,L,NZ,NY,NX)=XHVST*H2GP(N,L,NZ,NY,NX) -C -C REDUCE ROOT STATE VARIABLES DURING TILLAGE -C - DO 8960 NR=1,NRT(NZ,NY,NX) - WTRT1(N,L,NR,NZ,NY,NX)=WTRT1(N,L,NR,NZ,NY,NX)*XHVST - WTRT2(N,L,NR,NZ,NY,NX)=WTRT2(N,L,NR,NZ,NY,NX)*XHVST - WTRT1N(N,L,NR,NZ,NY,NX)=WTRT1N(N,L,NR,NZ,NY,NX)*XHVST - WTRT2N(N,L,NR,NZ,NY,NX)=WTRT2N(N,L,NR,NZ,NY,NX)*XHVST - WTRT1P(N,L,NR,NZ,NY,NX)=WTRT1P(N,L,NR,NZ,NY,NX)*XHVST - WTRT2P(N,L,NR,NZ,NY,NX)=WTRT2P(N,L,NR,NZ,NY,NX)*XHVST - RTWT1(N,NR,NZ,NY,NX)=RTWT1(N,NR,NZ,NY,NX)*XHVST - RTWT1N(N,NR,NZ,NY,NX)=RTWT1N(N,NR,NZ,NY,NX)*XHVST - RTWT1P(N,NR,NZ,NY,NX)=RTWT1P(N,NR,NZ,NY,NX)*XHVST - RTLG1(N,L,NR,NZ,NY,NX)=RTLG1(N,L,NR,NZ,NY,NX)*XHVST - RTLG2(N,L,NR,NZ,NY,NX)=RTLG2(N,L,NR,NZ,NY,NX)*XHVST - RTN2(N,L,NR,NZ,NY,NX)=RTN2(N,L,NR,NZ,NY,NX)*XHVST -8960 CONTINUE - CPOOLR(N,L,NZ,NY,NX)=CPOOLR(N,L,NZ,NY,NX)*XHVST - ZPOOLR(N,L,NZ,NY,NX)=ZPOOLR(N,L,NZ,NY,NX)*XHVST - PPOOLR(N,L,NZ,NY,NX)=PPOOLR(N,L,NZ,NY,NX)*XHVST - WTRTL(N,L,NZ,NY,NX)=WTRTL(N,L,NZ,NY,NX)*XHVST - WTRTD(N,L,NZ,NY,NX)=WTRTD(N,L,NZ,NY,NX)*XHVST - WSRTL(N,L,NZ,NY,NX)=WSRTL(N,L,NZ,NY,NX)*XHVST - RTN1(N,L,NZ,NY,NX)=RTN1(N,L,NZ,NY,NX)*XHVST - RTNL(N,L,NZ,NY,NX)=RTNL(N,L,NZ,NY,NX)*XHVST - RTLGP(N,L,NZ,NY,NX)=RTLGP(N,L,NZ,NY,NX)*XHVST - RTDNP(N,L,NZ,NY,NX)=RTDNP(N,L,NZ,NY,NX)*XHVST - RTVLP(N,L,NZ,NY,NX)=RTVLP(N,L,NZ,NY,NX)*XHVST - RTVLW(N,L,NZ,NY,NX)=RTVLW(N,L,NZ,NY,NX)*XHVST - RTARP(N,L,NZ,NY,NX)=RTARP(N,L,NZ,NY,NX)*XHVST - RCO2M(N,L,NZ,NY,NX)=RCO2M(N,L,NZ,NY,NX)*XHVST - RCO2N(N,L,NZ,NY,NX)=RCO2N(N,L,NZ,NY,NX)*XHVST - RCO2A(N,L,NZ,NY,NX)=RCO2A(N,L,NZ,NY,NX)*XHVST -C -C LITTERFALL AND STATE VARIABLES FOR NODULES DURING TILLAGE -C - IF(INTYP(NZ,NY,NX).NE.0.AND.N.EQ.1)THEN - DO 6395 M=1,4 - CSNC(M,1,L,NZ,NY,NX)=CSNC(M,1,L,NZ,NY,NX)+(1.0-XHVST) - 2*(CFOPC(4,M,NZ,NY,NX)*WTNDL(L,NZ,NY,NX) - 3+CFOPC(0,M,NZ,NY,NX)*CPOOLN(L,NZ,NY,NX)) - ZSNC(M,1,L,NZ,NY,NX)=ZSNC(M,1,L,NZ,NY,NX)+(1.0-XHVST) - 2*(CFOPN(4,M,NZ,NY,NX)*WTNDLN(L,NZ,NY,NX) - 3+CFOPN(0,M,NZ,NY,NX)*ZPOOLN(L,NZ,NY,NX)) - PSNC(M,1,L,NZ,NY,NX)=PSNC(M,1,L,NZ,NY,NX)+(1.0-XHVST) - 2*(CFOPP(4,M,NZ,NY,NX)*WTNDLP(L,NZ,NY,NX) - 3+CFOPP(0,M,NZ,NY,NX)*PPOOLN(L,NZ,NY,NX)) -6395 CONTINUE - WTNDL(L,NZ,NY,NX)=WTNDL(L,NZ,NY,NX)*XHVST - WTNDLN(L,NZ,NY,NX)=WTNDLN(L,NZ,NY,NX)*XHVST - WTNDLP(L,NZ,NY,NX)=WTNDLP(L,NZ,NY,NX)*XHVST - CPOOLN(L,NZ,NY,NX)=CPOOLN(L,NZ,NY,NX)*XHVST - ZPOOLN(L,NZ,NY,NX)=ZPOOLN(L,NZ,NY,NX)*XHVST - PPOOLN(L,NZ,NY,NX)=PPOOLN(L,NZ,NY,NX)*XHVST - ENDIF -8980 CONTINUE -8985 CONTINUE -C -C LITTERFALL AND STATE VARIABLES FOR SEASONAL STORAGE RESERVES -C DURING TILLAGE -C - DO 6400 M=1,4 - CSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX)=CSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX) - 2+((1.0-XHVST)*CFOPC(0,M,NZ,NY,NX)*WTRVC(NZ,NY,NX))*FWOOD(0) - ZSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX)=ZSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX) - 2+((1.0-XHVST)*CFOPN(0,M,NZ,NY,NX)*WTRVN(NZ,NY,NX))*FWOODN(0) - PSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX)=PSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX) - 2+((1.0-XHVST)*CFOPP(0,M,NZ,NY,NX)*WTRVP(NZ,NY,NX))*FWOODP(0) - CSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX)=CSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX) - 2+((1.0-XHVST)*CFOPC(0,M,NZ,NY,NX)*WTRVC(NZ,NY,NX))*FWOOD(1) - ZSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX)=ZSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX) - 2+((1.0-XHVST)*CFOPN(0,M,NZ,NY,NX)*WTRVN(NZ,NY,NX))*FWOODN(1) - PSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX)=PSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX) - 2+((1.0-XHVST)*CFOPP(0,M,NZ,NY,NX)*WTRVP(NZ,NY,NX))*FWOODP(1) -6400 CONTINUE - WTRVC(NZ,NY,NX)=WTRVC(NZ,NY,NX)*XHVST - WTRVN(NZ,NY,NX)=WTRVN(NZ,NY,NX)*XHVST - WTRVP(NZ,NY,NX)=WTRVP(NZ,NY,NX)*XHVST - ENDIF - ENDIF - ENDIF -C -C DEAD BRANCHES -C - IF(J.EQ.INT(ZNOON(NY,NX)).AND.IDAY(1,NB1(NZ,NY,NX),NZ,NY,NX).NE.0 - 2.AND.(ISTYP(NZ,NY,NX).NE.0.OR.(I.GE.IDAYH(NZ,NY,NX) - 3.AND.IYRC.GE.IYRH(NZ,NY,NX))))THEN - IDTHY=0 -C -C RESET PHENOLOGY AND GROWTH STAGE OF DEAD BRANCHES -C - DO 8845 NB=1,NBR(NZ,NY,NX) - IF(IDTHB(NB,NZ,NY,NX).EQ.1)THEN - GROUP(NB,NZ,NY,NX)=GROUPI(NZ,NY,NX) - PSTG(NB,NZ,NY,NX)=XTLI(NZ,NY,NX) - PSTGI(NB,NZ,NY,NX)=PSTG(NB,NZ,NY,NX) - PSTGF(NB,NZ,NY,NX)=0.0 - VSTG(NB,NZ,NY,NX)=0.0 - VSTGX(NB,NZ,NY,NX)=0.0 - KLEAF(NB,NZ,NY,NX)=1 - KVSTG(NB,NZ,NY,NX)=1 - TGSTGI(NB,NZ,NY,NX)=0.0 - TGSTGF(NB,NZ,NY,NX)=0.0 - VRNS(NB,NZ,NY,NX)=0.0 - VRNF(NB,NZ,NY,NX)=0.0 - VRNY(NB,NZ,NY,NX)=0.0 - VRNZ(NB,NZ,NY,NX)=0.0 - ATRP(NB,NZ,NY,NX)=0.0 - FLG4(NB,NZ,NY,NX)=0.0 - FDBK(NB,NZ,NY,NX)=1.0 - FDBKX(NB,NZ,NY,NX)=1.0 - IFLGA(NB,NZ,NY,NX)=0 - IFLGE(NB,NZ,NY,NX)=1 - IFLGF(NB,NZ,NY,NX)=0 - IFLGR(NB,NZ,NY,NX)=0 - IFLGQ(NB,NZ,NY,NX)=0 - IFLGD(NB,NZ,NY,NX)=0 - NBTB(NB,NZ,NY,NX)=0 - DO 8850 M=1,10 - IDAY(M,NB,NZ,NY,NX)=0 -8850 CONTINUE -C -C LITTERFALL FROM DEAD BRANCHES -C - DO 6405 M=1,4 - CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) - 2+CFOPC(0,M,NZ,NY,NX)*CPOLNB(NB,NZ,NY,NX) - 4+CFOPC(1,M,NZ,NY,NX)*(WTLFB(NB,NZ,NY,NX)*FWODB(1) - 5+WTNDB(NB,NZ,NY,NX)) - 6+CFOPC(2,M,NZ,NY,NX)*(WTSHEB(NB,NZ,NY,NX)*FWODB(1) - 7+WTHSKB(NB,NZ,NY,NX)+WTEARB(NB,NZ,NY,NX)) - CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX) - 2+CFOPC(5,M,NZ,NY,NX)*(WTLFB(NB,NZ,NY,NX)*FWODB(0) - 3+WTSHEB(NB,NZ,NY,NX)*FWODB(0)) - ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) - 2+CFOPN(0,M,NZ,NY,NX)*ZPOLNB(NB,NZ,NY,NX) - 4+CFOPN(1,M,NZ,NY,NX)*(WTLFBN(NB,NZ,NY,NX)*FWODLN(1) - 5+WTNDBN(NB,NZ,NY,NX)) - 6+CFOPN(2,M,NZ,NY,NX)*(WTSHBN(NB,NZ,NY,NX)*FWODSN(1) - 7+WTHSBN(NB,NZ,NY,NX)+WTEABN(NB,NZ,NY,NX)) - ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX) - 2+CFOPN(5,M,NZ,NY,NX)*(WTLFBN(NB,NZ,NY,NX)*FWODLN(0) - 3+WTSHBN(NB,NZ,NY,NX)*FWODSN(0)) - PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) - 2+CFOPP(0,M,NZ,NY,NX)*PPOLNB(NB,NZ,NY,NX) - 4+CFOPP(1,M,NZ,NY,NX)*(WTLFBP(NB,NZ,NY,NX)*FWODLP(1) - 5+WTNDBP(NB,NZ,NY,NX)) - 6+CFOPP(2,M,NZ,NY,NX)*(WTSHBP(NB,NZ,NY,NX)*FWODSP(1) - 7+WTHSBP(NB,NZ,NY,NX)+WTEABP(NB,NZ,NY,NX)) - PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX) - 2+CFOPP(5,M,NZ,NY,NX)*(WTLFBP(NB,NZ,NY,NX)*FWODLP(0) - 3+WTSHBP(NB,NZ,NY,NX)*FWODSP(0)) - IF(ISTYP(NZ,NY,NX).EQ.0.AND.IWTYP(NZ,NY,NX).NE.0)THEN - WTRVC(NZ,NY,NX)=WTRVC(NZ,NY,NX) - 2+CFOPC(2,M,NZ,NY,NX)*WTGRB(NB,NZ,NY,NX) - WTRVN(NZ,NY,NX)=WTRVN(NZ,NY,NX) - 2+CFOPN(2,M,NZ,NY,NX)*WTGRBN(NB,NZ,NY,NX) - WTRVP(NZ,NY,NX)=WTRVP(NZ,NY,NX) - 2+CFOPP(2,M,NZ,NY,NX)*WTGRBP(NB,NZ,NY,NX) - ELSE - CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) - 2+CFOPC(2,M,NZ,NY,NX)*WTGRB(NB,NZ,NY,NX) - ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) - 2+CFOPN(2,M,NZ,NY,NX)*WTGRBN(NB,NZ,NY,NX) - PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) - 2+CFOPP(2,M,NZ,NY,NX)*WTGRBP(NB,NZ,NY,NX) - ENDIF - IF(IBTYP(NZ,NY,NX).EQ.0.OR.IGTYP(NZ,NY,NX).LE.1)THEN - CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) - 5+CFOPC(3,M,NZ,NY,NX)*WTSTKB(NB,NZ,NY,NX) - ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) - 5+CFOPN(3,M,NZ,NY,NX)*WTSTBN(NB,NZ,NY,NX) - PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) - 5+CFOPP(3,M,NZ,NY,NX)*WTSTBP(NB,NZ,NY,NX) - ELSE - WTSTDG(M,NZ,NY,NX)=WTSTDG(M,NZ,NY,NX) - 5+CFOPC(5,M,NZ,NY,NX)*WTSTKB(NB,NZ,NY,NX) - WTSTDN(M,NZ,NY,NX)=WTSTDN(M,NZ,NY,NX) - 5+CFOPN(5,M,NZ,NY,NX)*WTSTBN(NB,NZ,NY,NX) - WTSTDP(M,NZ,NY,NX)=WTSTDP(M,NZ,NY,NX) - 5+CFOPP(5,M,NZ,NY,NX)*WTSTBP(NB,NZ,NY,NX) - ENDIF -6405 CONTINUE -C -C RECOVER NON-STRUCTURAL C,N,P FROM BRANCH TO -C SEASONAL STORAGE RESERVES -C - WTRVC(NZ,NY,NX)=WTRVC(NZ,NY,NX) - 2+CPOOL(NB,NZ,NY,NX)+CPOOLK(NB,NZ,NY,NX)+WTRSVB(NB,NZ,NY,NX) - WTRVN(NZ,NY,NX)=WTRVN(NZ,NY,NX) - 2+ZPOOL(NB,NZ,NY,NX)+WTRSBN(NB,NZ,NY,NX) - WTRVP(NZ,NY,NX)=WTRVP(NZ,NY,NX) - 2+PPOOL(NB,NZ,NY,NX)+WTRSBP(NB,NZ,NY,NX) -C -C RESET STATE VARIABLES FROM DEAD BRANCHES -C - CPOOL(NB,NZ,NY,NX)=0.0 - CPOOLK(NB,NZ,NY,NX)=0.0 - ZPOOL(NB,NZ,NY,NX)=0.0 - PPOOL(NB,NZ,NY,NX)=0.0 - CPOLNB(NB,NZ,NY,NX)=0.0 - ZPOLNB(NB,NZ,NY,NX)=0.0 - PPOLNB(NB,NZ,NY,NX)=0.0 - WTSHTB(NB,NZ,NY,NX)=0.0 - WTLFB(NB,NZ,NY,NX)=0.0 - WTNDB(NB,NZ,NY,NX)=0.0 - WTSHEB(NB,NZ,NY,NX)=0.0 - WTSTKB(NB,NZ,NY,NX)=0.0 - WVSTKB(NB,NZ,NY,NX)=0.0 - WTRSVB(NB,NZ,NY,NX)=0.0 - WTHSKB(NB,NZ,NY,NX)=0.0 - WTEARB(NB,NZ,NY,NX)=0.0 - WTGRB(NB,NZ,NY,NX)=0.0 - WTLSB(NB,NZ,NY,NX)=0.0 - WTSHTN(NB,NZ,NY,NX)=0.0 - WTLFBN(NB,NZ,NY,NX)=0.0 - WTNDBN(NB,NZ,NY,NX)=0.0 - WTSHBN(NB,NZ,NY,NX)=0.0 - WTSTBN(NB,NZ,NY,NX)=0.0 - WTRSBN(NB,NZ,NY,NX)=0.0 - WTHSBN(NB,NZ,NY,NX)=0.0 - WTEABN(NB,NZ,NY,NX)=0.0 - WTGRBN(NB,NZ,NY,NX)=0.0 - WTSHTP(NB,NZ,NY,NX)=0.0 - WTLFBP(NB,NZ,NY,NX)=0.0 - WTNDBP(NB,NZ,NY,NX)=0.0 - WTSHBP(NB,NZ,NY,NX)=0.0 - WTSTBP(NB,NZ,NY,NX)=0.0 - WTRSBP(NB,NZ,NY,NX)=0.0 - WTHSBP(NB,NZ,NY,NX)=0.0 - WTEABP(NB,NZ,NY,NX)=0.0 - WTGRBP(NB,NZ,NY,NX)=0.0 - GRNXB(NB,NZ,NY,NX)=0.0 - GRNOB(NB,NZ,NY,NX)=0.0 - GRWTB(NB,NZ,NY,NX)=0.0 - ARLFB(NB,NZ,NY,NX)=0.0 - WTSTXB(NB,NZ,NY,NX)=0.0 - WTSTXN(NB,NZ,NY,NX)=0.0 - WTSTXP(NB,NZ,NY,NX)=0.0 - DO 8855 K=0,25 - IF(K.NE.0)THEN - CPOOL3(K,NB,NZ,NY,NX)=0.0 - CPOOL4(K,NB,NZ,NY,NX)=0.0 - CO2B(K,NB,NZ,NY,NX)=0.0 - HCOB(K,NB,NZ,NY,NX)=0.0 - ENDIF - ARLF(K,NB,NZ,NY,NX)=0.0 - HTNODE(K,NB,NZ,NY,NX)=0.0 - HTNODX(K,NB,NZ,NY,NX)=0.0 - HTSHE(K,NB,NZ,NY,NX)=0.0 - WGLF(K,NB,NZ,NY,NX)=0.0 - WSLF(K,NB,NZ,NY,NX)=0.0 - WGLFN(K,NB,NZ,NY,NX)=0.0 - WGLFP(K,NB,NZ,NY,NX)=0.0 - WGSHE(K,NB,NZ,NY,NX)=0.0 - WSSHE(K,NB,NZ,NY,NX)=0.0 - WGSHN(K,NB,NZ,NY,NX)=0.0 - WGSHP(K,NB,NZ,NY,NX)=0.0 - WGNODE(K,NB,NZ,NY,NX)=0.0 - WGNODN(K,NB,NZ,NY,NX)=0.0 - WGNODP(K,NB,NZ,NY,NX)=0.0 - DO 8865 L=1,JC - ARLFV(L,NZ,NY,NX)=ARLFV(L,NZ,NY,NX)-ARLFL(L,K,NB,NZ,NY,NX) - WGLFV(L,NZ,NY,NX)=WGLFV(L,NZ,NY,NX)-WGLFL(L,K,NB,NZ,NY,NX) - ARLFL(L,K,NB,NZ,NY,NX)=0.0 - WGLFL(L,K,NB,NZ,NY,NX)=0.0 - WGLFLN(L,K,NB,NZ,NY,NX)=0.0 - WGLFLP(L,K,NB,NZ,NY,NX)=0.0 - IF(K.NE.0)THEN - DO 8860 N=1,4 - SURF(N,L,K,NB,NZ,NY,NX)=0.0 -8860 CONTINUE - ENDIF -8865 CONTINUE -8855 CONTINUE - DO 8875 L=1,JC - ARSTK(L,NB,NZ,NY,NX)=0.0 - DO 8875 N=1,4 - SURFB(N,L,NB,NZ,NY,NX)=0.0 -8875 CONTINUE - IDTHY=IDTHY+1 - ENDIF -8845 CONTINUE - IF(IDTHY.EQ.NBR(NZ,NY,NX))THEN - IDTHP(NZ,NY,NX)=1 - NBT(NZ,NY,NX)=0 - WSTR(NZ,NY,NX)=0.0 - IF(IFLGI(NZ,NY,NX).EQ.1)THEN - NBR(NZ,NY,NX)=1 - ELSE - NBR(NZ,NY,NX)=0 - ENDIF - HTCTL(NZ,NY,NX)=0.0 - VOLWOU=VOLWOU+VOLWP(NZ,NY,NX) - UVOLO(NY,NX)=UVOLO(NY,NX)+VOLWP(NZ,NY,NX) - VOLWP(NZ,NY,NX)=0.0 - IF(WTRVC(NZ,NY,NX).LT.1.0E-04*WTRT(NZ,NY,NX) - 2.AND.ISTYP(NZ,NY,NX).NE.0)IDTHR(NZ,NY,NX)=1 - IF(ISTYP(NZ,NY,NX).EQ.0)IDTHR(NZ,NY,NX)=1 - IF(JHVST(NZ,I,NY,NX).NE.0)IDTHR(NZ,NY,NX)=1 - IF(PP(NZ,NY,NX).LE.0.0)IDTHR(NZ,NY,NX)=1 - IF(IDTHR(NZ,NY,NX).EQ.1)IDTHP(NZ,NY,NX)=1 - ENDIF -C -C DEAD ROOTS -C -C -C LITTERFALL FROM DEAD ROOTS -C - IF(IDTHR(NZ,NY,NX).EQ.1)THEN - DO 8900 N=1,MY(NZ,NY,NX) - DO 8895 L=NU(NY,NX),NJ(NY,NX) - DO 6410 M=1,4 - CSNC(M,1,L,NZ,NY,NX)=CSNC(M,1,L,NZ,NY,NX)+CFOPC(0,M,NZ,NY,NX) - 2*CPOOLR(N,L,NZ,NY,NX) - ZSNC(M,1,L,NZ,NY,NX)=ZSNC(M,1,L,NZ,NY,NX)+CFOPN(0,M,NZ,NY,NX) - 2*ZPOOLR(N,L,NZ,NY,NX) - PSNC(M,1,L,NZ,NY,NX)=PSNC(M,1,L,NZ,NY,NX)+CFOPP(0,M,NZ,NY,NX) - 2*PPOOLR(N,L,NZ,NY,NX) - DO 6410 NR=1,NRT(NZ,NY,NX) - CSNC(M,0,L,NZ,NY,NX)=CSNC(M,0,L,NZ,NY,NX)+CFOPC(5,M,NZ,NY,NX) - 2*(WTRT1(N,L,NR,NZ,NY,NX)+WTRT2(N,L,NR,NZ,NY,NX))*FWOOD(0) - ZSNC(M,0,L,NZ,NY,NX)=ZSNC(M,0,L,NZ,NY,NX)+CFOPN(5,M,NZ,NY,NX) - 2*(WTRT1N(N,L,NR,NZ,NY,NX)+WTRT2N(N,L,NR,NZ,NY,NX))*FWOODN(0) - PSNC(M,0,L,NZ,NY,NX)=PSNC(M,0,L,NZ,NY,NX)+CFOPP(5,M,NZ,NY,NX) - 2*(WTRT1P(N,L,NR,NZ,NY,NX)+WTRT2P(N,L,NR,NZ,NY,NX))*FWOODP(0) - CSNC(M,1,L,NZ,NY,NX)=CSNC(M,1,L,NZ,NY,NX)+CFOPC(4,M,NZ,NY,NX) - 2*(WTRT1(N,L,NR,NZ,NY,NX)+WTRT2(N,L,NR,NZ,NY,NX))*FWOOD(1) - ZSNC(M,1,L,NZ,NY,NX)=ZSNC(M,1,L,NZ,NY,NX)+CFOPN(4,M,NZ,NY,NX) - 2*(WTRT1N(N,L,NR,NZ,NY,NX)+WTRT2N(N,L,NR,NZ,NY,NX))*FWOODN(1) - PSNC(M,1,L,NZ,NY,NX)=PSNC(M,1,L,NZ,NY,NX)+CFOPP(4,M,NZ,NY,NX) - 2*(WTRT1P(N,L,NR,NZ,NY,NX)+WTRT2P(N,L,NR,NZ,NY,NX))*FWOODP(1) -6410 CONTINUE -C -C RELEASE GAS CONTENTS OF DEAD ROOTS -C - RCO2Z(NZ,NY,NX)=RCO2Z(NZ,NY,NX)-CO2A(N,L,NZ,NY,NX) - 2-CO2P(N,L,NZ,NY,NX) - ROXYZ(NZ,NY,NX)=ROXYZ(NZ,NY,NX)-OXYA(N,L,NZ,NY,NX) - 2-OXYP(N,L,NZ,NY,NX) - RCH4Z(NZ,NY,NX)=RCH4Z(NZ,NY,NX)-CH4A(N,L,NZ,NY,NX) - 2-CH4P(N,L,NZ,NY,NX) - RN2OZ(NZ,NY,NX)=RN2OZ(NZ,NY,NX)-Z2OA(N,L,NZ,NY,NX) - 2-Z2OP(N,L,NZ,NY,NX) - RNH3Z(NZ,NY,NX)=RNH3Z(NZ,NY,NX)-ZH3A(N,L,NZ,NY,NX) - 2-ZH3P(N,L,NZ,NY,NX) - RH2GZ(NZ,NY,NX)=RH2GZ(NZ,NY,NX)-H2GA(N,L,NZ,NY,NX) - 2-H2GP(N,L,NZ,NY,NX) - CO2A(N,L,NZ,NY,NX)=0.0 - OXYA(N,L,NZ,NY,NX)=0.0 - CH4A(N,L,NZ,NY,NX)=0.0 - Z2OA(N,L,NZ,NY,NX)=0.0 - ZH3A(N,L,NZ,NY,NX)=0.0 - H2GA(N,L,NZ,NY,NX)=0.0 - CO2P(N,L,NZ,NY,NX)=0.0 - OXYP(N,L,NZ,NY,NX)=0.0 - CH4P(N,L,NZ,NY,NX)=0.0 - Z2OP(N,L,NZ,NY,NX)=0.0 - ZH3P(N,L,NZ,NY,NX)=0.0 - H2GP(N,L,NZ,NY,NX)=0.0 -C -C RESET STATE VARIABLES OF DEAD ROOTS -C - DO 8870 NR=1,NRT(NZ,NY,NX) - WTRT1(N,L,NR,NZ,NY,NX)=0.0 - WTRT1N(N,L,NR,NZ,NY,NX)=0.0 - WTRT1P(N,L,NR,NZ,NY,NX)=0.0 - WTRT2(N,L,NR,NZ,NY,NX)=0.0 - WTRT2N(N,L,NR,NZ,NY,NX)=0.0 - WTRT2P(N,L,NR,NZ,NY,NX)=0.0 - RTWT1(N,NR,NZ,NY,NX)=0.0 - RTWT1N(N,NR,NZ,NY,NX)=0.0 - RTWT1P(N,NR,NZ,NY,NX)=0.0 - RTLG1(N,L,NR,NZ,NY,NX)=0.0 - RTLG2(N,L,NR,NZ,NY,NX)=0.0 - RTN2(N,L,NR,NZ,NY,NX)=0.0 -8870 CONTINUE - CPOOLR(N,L,NZ,NY,NX)=0.0 - ZPOOLR(N,L,NZ,NY,NX)=0.0 - PPOOLR(N,L,NZ,NY,NX)=0.0 - WTRTL(N,L,NZ,NY,NX)=0.0 - WTRTD(N,L,NZ,NY,NX)=0.0 - WSRTL(N,L,NZ,NY,NX)=0.0 - RTN1(N,L,NZ,NY,NX)=0.0 - RTNL(N,L,NZ,NY,NX)=0.0 - RTLGP(N,L,NZ,NY,NX)=0.0 - RTDNP(N,L,NZ,NY,NX)=0.0 - RTVLP(N,L,NZ,NY,NX)=0.0 - RTVLW(N,L,NZ,NY,NX)=0.0 - RRAD1(N,L,NZ,NY,NX)=RRAD1M(N,NZ,NY,NX) - RRAD2(N,L,NZ,NY,NX)=RRAD2M(N,NZ,NY,NX) - RTARP(N,L,NZ,NY,NX)=0.0 - RTLGA(N,L,NZ,NY,NX)=RTLGAX -C -C LITTERFALL AND STATE VARIABLES FROM DEAD NODULES -C - IF(INTYP(NZ,NY,NX).NE.0.AND.N.EQ.1)THEN - DO 6420 M=1,4 - CSNC(M,1,L,NZ,NY,NX)=CSNC(M,1,L,NZ,NY,NX)+CFOPC(4,M,NZ,NY,NX) - 2*WTNDL(L,NZ,NY,NX)+CFOPC(0,M,NZ,NY,NX)*CPOOLN(L,NZ,NY,NX) - ZSNC(M,1,L,NZ,NY,NX)=ZSNC(M,1,L,NZ,NY,NX)+CFOPN(4,M,NZ,NY,NX) - 2*WTNDLN(L,NZ,NY,NX)+CFOPN(0,M,NZ,NY,NX)*ZPOOLN(L,NZ,NY,NX) - PSNC(M,1,L,NZ,NY,NX)=PSNC(M,1,L,NZ,NY,NX)+CFOPP(4,M,NZ,NY,NX) - 2*WTNDLP(L,NZ,NY,NX)+CFOPP(0,M,NZ,NY,NX)*PPOOLN(L,NZ,NY,NX) -6420 CONTINUE - WTNDL(L,NZ,NY,NX)=0.0 - WTNDLN(L,NZ,NY,NX)=0.0 - WTNDLP(L,NZ,NY,NX)=0.0 - CPOOLN(L,NZ,NY,NX)=0.0 - ZPOOLN(L,NZ,NY,NX)=0.0 - PPOOLN(L,NZ,NY,NX)=0.0 - ENDIF -8895 CONTINUE -8900 CONTINUE -C -C RESET DEPTH VARIABLES OF DEAD ROOTS -C - DO 8795 NR=1,NRT(NZ,NY,NX) - NINR(NR,NZ,NY,NX)=NG(NZ,NY,NX) - DO 8790 N=1,MY(NZ,NY,NX) - RTDP1(N,NR,NZ,NY,NX)=SDPTH(NZ,NY,NX) - RTWT1(N,NR,NZ,NY,NX)=0.0 - RTWT1N(N,NR,NZ,NY,NX)=0.0 - RTWT1P(N,NR,NZ,NY,NX)=0.0 -8790 CONTINUE -8795 CONTINUE - NIX(NZ,NY,NX)=NG(NZ,NY,NX) - NRT(NZ,NY,NX)=0 - ENDIF -C -C LITTERFALL AND STATE VARIABLES FOR SEASONAL STORAGE -C RESERVES AT DEATH -C - IF(IDTHP(NZ,NY,NX).EQ.1.AND.IDTHR(NZ,NY,NX).EQ.1)THEN - IF(IFLGI(NZ,NY,NX).EQ.0)THEN - DO 6425 M=1,4 - DO 8825 NB=1,NBR(NZ,NY,NX) - CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) - 2+CFOPC(0,M,NZ,NY,NX)*(CPOOL(NB,NZ,NY,NX)+CPOLNB(NB,NZ,NY,NX) - 3+CPOOLK(NB,NZ,NY,NX)+WTRSVB(NB,NZ,NY,NX)) - 4+CFOPC(1,M,NZ,NY,NX)*(WTLFB(NB,NZ,NY,NX)*FWODB(1) - 5+WTNDB(NB,NZ,NY,NX)) - 6+CFOPC(2,M,NZ,NY,NX)*(WTSHEB(NB,NZ,NY,NX)*FWODB(1) - 7+WTHSKB(NB,NZ,NY,NX)+WTEARB(NB,NZ,NY,NX)) - CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX) - 2+CFOPC(5,M,NZ,NY,NX)*(WTLFB(NB,NZ,NY,NX)*FWODB(0) - 3+WTSHEB(NB,NZ,NY,NX)*FWODB(0)) - ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) - 2+CFOPN(0,M,NZ,NY,NX)*(ZPOOL(NB,NZ,NY,NX)+ZPOLNB(NB,NZ,NY,NX) - 3+WTRSBN(NB,NZ,NY,NX)) - 4+CFOPN(1,M,NZ,NY,NX)*(WTLFBN(NB,NZ,NY,NX)*FWODLN(1) - 5+WTNDBN(NB,NZ,NY,NX)) - 6+CFOPN(2,M,NZ,NY,NX)*(WTSHBN(NB,NZ,NY,NX)*FWODSN(1) - 7+WTHSBN(NB,NZ,NY,NX)+WTEABN(NB,NZ,NY,NX)) - ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX) - 2+CFOPN(5,M,NZ,NY,NX)*(WTLFBN(NB,NZ,NY,NX)*FWODLN(0) - 3+WTSHBN(NB,NZ,NY,NX)*FWODSN(0)) - PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) - 2+CFOPP(0,M,NZ,NY,NX)*(PPOOL(NB,NZ,NY,NX)+PPOLNB(NB,NZ,NY,NX) - 3+WTRSBP(NB,NZ,NY,NX)) - 4+CFOPP(1,M,NZ,NY,NX)*(WTLFBP(NB,NZ,NY,NX)*FWODLP(1) - 5+WTNDBP(NB,NZ,NY,NX)) - 6+CFOPP(2,M,NZ,NY,NX)*(WTSHBP(NB,NZ,NY,NX)*FWODSP(1) - 7+WTHSBP(NB,NZ,NY,NX)+WTEABP(NB,NZ,NY,NX)) - PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX) - 2+CFOPP(5,M,NZ,NY,NX)*(WTLFBP(NB,NZ,NY,NX)*FWODLP(0) - 3+WTSHBP(NB,NZ,NY,NX)*FWODSP(0)) - IF(ISTYP(NZ,NY,NX).EQ.0.AND.IWTYP(NZ,NY,NX).NE.0)THEN - WTRVC(NZ,NY,NX)=WTRVC(NZ,NY,NX) - 2+CFOPC(2,M,NZ,NY,NX)*WTGRB(NB,NZ,NY,NX) - WTRVN(NZ,NY,NX)=WTRVN(NZ,NY,NX) - 2+CFOPN(2,M,NZ,NY,NX)*WTGRBN(NB,NZ,NY,NX) - WTRVP(NZ,NY,NX)=WTRVP(NZ,NY,NX) - 2+CFOPP(2,M,NZ,NY,NX)*WTGRBP(NB,NZ,NY,NX) - ELSE - CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) - 2+CFOPC(2,M,NZ,NY,NX)*WTGRB(NB,NZ,NY,NX) - ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) - 2+CFOPN(2,M,NZ,NY,NX)*WTGRBN(NB,NZ,NY,NX) - PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) - 2+CFOPP(2,M,NZ,NY,NX)*WTGRBP(NB,NZ,NY,NX) - ENDIF - IF(IBTYP(NZ,NY,NX).EQ.0.OR.IGTYP(NZ,NY,NX).LE.1)THEN - CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) - 5+CFOPC(3,M,NZ,NY,NX)*WTSTKB(NB,NZ,NY,NX) - ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) - 5+CFOPN(3,M,NZ,NY,NX)*WTSTBN(NB,NZ,NY,NX) - PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) - 5+CFOPP(3,M,NZ,NY,NX)*WTSTBP(NB,NZ,NY,NX) - ELSE - WTSTDG(M,NZ,NY,NX)=WTSTDG(M,NZ,NY,NX) - 5+CFOPC(5,M,NZ,NY,NX)*WTSTKB(NB,NZ,NY,NX) - WTSTDN(M,NZ,NY,NX)=WTSTDN(M,NZ,NY,NX) - 5+CFOPN(5,M,NZ,NY,NX)*WTSTBN(NB,NZ,NY,NX) - WTSTDP(M,NZ,NY,NX)=WTSTDP(M,NZ,NY,NX) - 5+CFOPP(5,M,NZ,NY,NX)*WTSTBP(NB,NZ,NY,NX) - ENDIF -8825 CONTINUE - DO 6415 L=NU(NY,NX),NJ(NY,NX) - DO 6415 N=1,MY(NZ,NY,NX) - CSNC(M,1,L,NZ,NY,NX)=CSNC(M,1,L,NZ,NY,NX)+CFOPC(0,M,NZ,NY,NX) - 2*CPOOLR(N,L,NZ,NY,NX) - ZSNC(M,1,L,NZ,NY,NX)=ZSNC(M,1,L,NZ,NY,NX)+CFOPN(0,M,NZ,NY,NX) - 2*ZPOOLR(N,L,NZ,NY,NX) - PSNC(M,1,L,NZ,NY,NX)=PSNC(M,1,L,NZ,NY,NX)+CFOPP(0,M,NZ,NY,NX) - 2*PPOOLR(N,L,NZ,NY,NX) - DO 6415 NR=1,NRT(NZ,NY,NX) - CSNC(M,0,L,NZ,NY,NX)=CSNC(M,0,L,NZ,NY,NX)+CFOPC(5,M,NZ,NY,NX) - 2*(WTRT1(N,L,NR,NZ,NY,NX)+WTRT2(N,L,NR,NZ,NY,NX))*FWOOD(0) - ZSNC(M,0,L,NZ,NY,NX)=ZSNC(M,0,L,NZ,NY,NX)+CFOPN(5,M,NZ,NY,NX) - 2*(WTRT1N(N,L,NR,NZ,NY,NX)+WTRT2N(N,L,NR,NZ,NY,NX))*FWOODN(0) - PSNC(M,0,L,NZ,NY,NX)=PSNC(M,0,L,NZ,NY,NX)+CFOPP(5,M,NZ,NY,NX) - 2*(WTRT1P(N,L,NR,NZ,NY,NX)+WTRT2P(N,L,NR,NZ,NY,NX))*FWOODP(0) - CSNC(M,1,L,NZ,NY,NX)=CSNC(M,1,L,NZ,NY,NX)+CFOPC(4,M,NZ,NY,NX) - 2*(WTRT1(N,L,NR,NZ,NY,NX)+WTRT2(N,L,NR,NZ,NY,NX))*FWOOD(1) - ZSNC(M,1,L,NZ,NY,NX)=ZSNC(M,1,L,NZ,NY,NX)+CFOPN(4,M,NZ,NY,NX) - 2*(WTRT1N(N,L,NR,NZ,NY,NX)+WTRT2N(N,L,NR,NZ,NY,NX))*FWOODN(1) - PSNC(M,1,L,NZ,NY,NX)=PSNC(M,1,L,NZ,NY,NX)+CFOPP(4,M,NZ,NY,NX) - 2*(WTRT1P(N,L,NR,NZ,NY,NX)+WTRT2P(N,L,NR,NZ,NY,NX))*FWOODP(1) -6415 CONTINUE - CSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX)=CSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX) - 2+CFOPC(0,M,NZ,NY,NX)*WTRVC(NZ,NY,NX)*FWOOD(0) - ZSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX)=ZSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX) - 2+CFOPN(0,M,NZ,NY,NX)*WTRVN(NZ,NY,NX)*FWOODN(0) - PSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX)=PSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX) - 2+CFOPP(0,M,NZ,NY,NX)*WTRVP(NZ,NY,NX)*FWOODP(0) - CSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX)=CSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX) - 2+CFOPC(0,M,NZ,NY,NX)*WTRVC(NZ,NY,NX)*FWOOD(1) - ZSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX)=ZSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX) - 2+CFOPN(0,M,NZ,NY,NX)*WTRVN(NZ,NY,NX)*FWOODN(1) - PSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX)=PSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX) - 2+CFOPP(0,M,NZ,NY,NX)*WTRVP(NZ,NY,NX)*FWOODP(1) -6425 CONTINUE - DO 8835 NB=1,NBR(NZ,NY,NX) - CPOOL(NB,NZ,NY,NX)=0.0 - CPOOLK(NB,NZ,NY,NX)=0.0 - ZPOOL(NB,NZ,NY,NX)=0.0 - PPOOL(NB,NZ,NY,NX)=0.0 - CPOLNB(NB,NZ,NY,NX)=0.0 - ZPOLNB(NB,NZ,NY,NX)=0.0 - PPOLNB(NB,NZ,NY,NX)=0.0 - WTSHTB(NB,NZ,NY,NX)=0.0 - WTLFB(NB,NZ,NY,NX)=0.0 - WTNDB(NB,NZ,NY,NX)=0.0 - WTSHEB(NB,NZ,NY,NX)=0.0 - WTSTKB(NB,NZ,NY,NX)=0.0 - WVSTKB(NB,NZ,NY,NX)=0.0 - WTRSVB(NB,NZ,NY,NX)=0.0 - WTHSKB(NB,NZ,NY,NX)=0.0 - WTEARB(NB,NZ,NY,NX)=0.0 - WTGRB(NB,NZ,NY,NX)=0.0 - WTLSB(NB,NZ,NY,NX)=0.0 - WTSHTN(NB,NZ,NY,NX)=0.0 - WTLFBN(NB,NZ,NY,NX)=0.0 - WTNDBN(NB,NZ,NY,NX)=0.0 - WTSHBN(NB,NZ,NY,NX)=0.0 - WTSTBN(NB,NZ,NY,NX)=0.0 - WTRSBN(NB,NZ,NY,NX)=0.0 - WTHSBN(NB,NZ,NY,NX)=0.0 - WTEABN(NB,NZ,NY,NX)=0.0 - WTGRBN(NB,NZ,NY,NX)=0.0 - WTSHTP(NB,NZ,NY,NX)=0.0 - WTLFBP(NB,NZ,NY,NX)=0.0 - WTNDBP(NB,NZ,NY,NX)=0.0 - WTSHBP(NB,NZ,NY,NX)=0.0 - WTSTBP(NB,NZ,NY,NX)=0.0 - WTRSBP(NB,NZ,NY,NX)=0.0 - WTHSBP(NB,NZ,NY,NX)=0.0 - WTEABP(NB,NZ,NY,NX)=0.0 - WTGRBP(NB,NZ,NY,NX)=0.0 - WTSTXB(NB,NZ,NY,NX)=0.0 - WTSTXN(NB,NZ,NY,NX)=0.0 - WTSTXP(NB,NZ,NY,NX)=0.0 -8835 CONTINUE - DO 6416 L=NU(NY,NX),NJ(NY,NX) - DO 6416 N=1,MY(NZ,NY,NX) - CPOOLR(N,L,NZ,NY,NX)=0.0 - ZPOOLR(N,L,NZ,NY,NX)=0.0 - PPOOLR(N,L,NZ,NY,NX)=0.0 - DO 6416 NR=1,NRT(NZ,NY,NX) - WTRT1(N,L,NR,NZ,NY,NX)=0.0 - WTRT1N(N,L,NR,NZ,NY,NX)=0.0 - WTRT1P(N,L,NR,NZ,NY,NX)=0.0 - WTRT2(N,L,NR,NZ,NY,NX)=0.0 - WTRT2N(N,L,NR,NZ,NY,NX)=0.0 - WTRT2P(N,L,NR,NZ,NY,NX)=0.0 - RTWT1(N,NR,NZ,NY,NX)=0.0 - RTWT1N(N,NR,NZ,NY,NX)=0.0 - RTWT1P(N,NR,NZ,NY,NX)=0.0 - RTLG1(N,L,NR,NZ,NY,NX)=0.0 - RTLG2(N,L,NR,NZ,NY,NX)=0.0 - RTN2(N,L,NR,NZ,NY,NX)=0.0 -6416 CONTINUE - WTRVC(NZ,NY,NX)=0.0 - WTRVN(NZ,NY,NX)=0.0 - WTRVP(NZ,NY,NX)=0.0 - IDTH(NZ,NY,NX)=1 - ENDIF -C -C RESEED DEAD PERENNIALS -C - IF(ISTYP(NZ,NY,NX).NE.0.AND.JHVST(NZ,I,NY,NX).EQ.0)THEN - IF(I.LT.LYRC)THEN - IDAY0(NZ,NY,NX)=I+1 - IYR0(NZ,NY,NX)=IDATA(3) - ELSE - IDAY0(NZ,NY,NX)=1 - IYR0(NZ,NY,NX)=IDATA(3)+1 - ENDIF - ENDIF - ENDIF - ENDIF -C -C CHECK PLANT C,N,P BALANCES -C - CPOOLP(NZ,NY,NX)=0.0 - ZPOOLP(NZ,NY,NX)=0.0 - PPOOLP(NZ,NY,NX)=0.0 - WTSHT(NZ,NY,NX)=0.0 - WTSHN(NZ,NY,NX)=0.0 - WTSHP(NZ,NY,NX)=0.0 - WTLF(NZ,NY,NX)=0.0 - WTSHE(NZ,NY,NX)=0.0 - WTSTK(NZ,NY,NX)=0.0 - WVSTK(NZ,NY,NX)=0.0 - WTRSV(NZ,NY,NX)=0.0 - WTHSK(NZ,NY,NX)=0.0 - WTEAR(NZ,NY,NX)=0.0 - WTGR(NZ,NY,NX)=0.0 - WTLS(NZ,NY,NX)=0.0 - WTRT(NZ,NY,NX)=0.0 - WTRTS(NZ,NY,NX)=0.0 - WTRTN(NZ,NY,NX)=0.0 - WTRTP(NZ,NY,NX)=0.0 - WTLFN(NZ,NY,NX)=0.0 - WTSHEN(NZ,NY,NX)=0.0 - WTSTKN(NZ,NY,NX)=0.0 - WTRSVN(NZ,NY,NX)=0.0 - WTHSKN(NZ,NY,NX)=0.0 - WTEARN(NZ,NY,NX)=0.0 - WTGRNN(NZ,NY,NX)=0.0 - WTLFP(NZ,NY,NX)=0.0 - WTSHEP(NZ,NY,NX)=0.0 - WTSTKP(NZ,NY,NX)=0.0 - WTRSVP(NZ,NY,NX)=0.0 - WTHSKP(NZ,NY,NX)=0.0 - WTEARP(NZ,NY,NX)=0.0 - WTGRNP(NZ,NY,NX)=0.0 - GRNO(NZ,NY,NX)=0.0 - ARLFP(NZ,NY,NX)=0.0 - ARSTP(NZ,NY,NX)=0.0 - DO 8940 L=1,JC - ARSTV(L,NZ,NY,NX)=0.0 -8940 CONTINUE -C -C ACCUMULATE PLANT STATE VARIABLES FROM BRANCH STATE VARIABLES -C - DO 8950 NB=1,NBR(NZ,NY,NX) - CPOOLP(NZ,NY,NX)=CPOOLP(NZ,NY,NX)+CPOOL(NB,NZ,NY,NX) - ZPOOLP(NZ,NY,NX)=ZPOOLP(NZ,NY,NX)+ZPOOL(NB,NZ,NY,NX) - PPOOLP(NZ,NY,NX)=PPOOLP(NZ,NY,NX)+PPOOL(NB,NZ,NY,NX) - WTSHT(NZ,NY,NX)=WTSHT(NZ,NY,NX)+WTSHTB(NB,NZ,NY,NX) - WTLF(NZ,NY,NX)=WTLF(NZ,NY,NX)+WTLFB(NB,NZ,NY,NX) - WTSHE(NZ,NY,NX)=WTSHE(NZ,NY,NX)+WTSHEB(NB,NZ,NY,NX) - WTSTK(NZ,NY,NX)=WTSTK(NZ,NY,NX)+WTSTKB(NB,NZ,NY,NX) - WVSTK(NZ,NY,NX)=WVSTK(NZ,NY,NX)+WVSTKB(NB,NZ,NY,NX) - WTRSV(NZ,NY,NX)=WTRSV(NZ,NY,NX)+WTRSVB(NB,NZ,NY,NX) - WTHSK(NZ,NY,NX)=WTHSK(NZ,NY,NX)+WTHSKB(NB,NZ,NY,NX) - WTEAR(NZ,NY,NX)=WTEAR(NZ,NY,NX)+WTEARB(NB,NZ,NY,NX) - WTGR(NZ,NY,NX)=WTGR(NZ,NY,NX)+WTGRB(NB,NZ,NY,NX) - WTLS(NZ,NY,NX)=WTLS(NZ,NY,NX)+WTLSB(NB,NZ,NY,NX) - WTSHN(NZ,NY,NX)=WTSHN(NZ,NY,NX)+WTSHTN(NB,NZ,NY,NX) - WTLFN(NZ,NY,NX)=WTLFN(NZ,NY,NX)+WTLFBN(NB,NZ,NY,NX) - WTSHEN(NZ,NY,NX)=WTSHEN(NZ,NY,NX)+WTSHBN(NB,NZ,NY,NX) - WTSTKN(NZ,NY,NX)=WTSTKN(NZ,NY,NX)+WTSTBN(NB,NZ,NY,NX) - WTRSVN(NZ,NY,NX)=WTRSVN(NZ,NY,NX)+WTRSBN(NB,NZ,NY,NX) - WTHSKN(NZ,NY,NX)=WTHSKN(NZ,NY,NX)+WTHSBN(NB,NZ,NY,NX) - WTEARN(NZ,NY,NX)=WTEARN(NZ,NY,NX)+WTEABN(NB,NZ,NY,NX) - WTGRNN(NZ,NY,NX)=WTGRNN(NZ,NY,NX)+WTGRBN(NB,NZ,NY,NX) - WTSHP(NZ,NY,NX)=WTSHP(NZ,NY,NX)+WTSHTP(NB,NZ,NY,NX) - WTLFP(NZ,NY,NX)=WTLFP(NZ,NY,NX)+WTLFBP(NB,NZ,NY,NX) - WTSHEP(NZ,NY,NX)=WTSHEP(NZ,NY,NX)+WTSHBP(NB,NZ,NY,NX) - WTSTKP(NZ,NY,NX)=WTSTKP(NZ,NY,NX)+WTSTBP(NB,NZ,NY,NX) - WTRSVP(NZ,NY,NX)=WTRSVP(NZ,NY,NX)+WTRSBP(NB,NZ,NY,NX) - WTHSKP(NZ,NY,NX)=WTHSKP(NZ,NY,NX)+WTHSBP(NB,NZ,NY,NX) - WTEARP(NZ,NY,NX)=WTEARP(NZ,NY,NX)+WTEABP(NB,NZ,NY,NX) - WTGRNP(NZ,NY,NX)=WTGRNP(NZ,NY,NX)+WTGRBP(NB,NZ,NY,NX) - ARLFP(NZ,NY,NX)=ARLFP(NZ,NY,NX)+ARLFB(NB,NZ,NY,NX) - GRNO(NZ,NY,NX)=GRNO(NZ,NY,NX)+GRNOB(NB,NZ,NY,NX) - DO 8945 L=1,JC - ARSTP(NZ,NY,NX)=ARSTP(NZ,NY,NX)+ARSTK(L,NB,NZ,NY,NX) - ARSTV(L,NZ,NY,NX)=ARSTV(L,NZ,NY,NX)+ARSTK(L,NB,NZ,NY,NX) -8945 CONTINUE -8950 CONTINUE -C -C ACCUMULATE ROOT STATE VARIABLES FROM ROOT LAYER STATE VARIABLES -C -C IF(WTLS(NZ,NY,NX).LE.0.0)ARLFP(NZ,NY,NX)=0.0 - DO 8925 N=1,MY(NZ,NY,NX) - DO 8930 L=NU(NY,NX),NJ(NY,NX) - WTRT(NZ,NY,NX)=WTRT(NZ,NY,NX)+CPOOLR(N,L,NZ,NY,NX) - WTRTN(NZ,NY,NX)=WTRTN(NZ,NY,NX)+ZPOOLR(N,L,NZ,NY,NX) - WTRTP(NZ,NY,NX)=WTRTP(NZ,NY,NX)+PPOOLR(N,L,NZ,NY,NX) - DO 8935 NR=1,NRT(NZ,NY,NX) - WTRT(NZ,NY,NX)=WTRT(NZ,NY,NX)+WTRT1(N,L,NR,NZ,NY,NX) - 2+WTRT2(N,L,NR,NZ,NY,NX) - WTRTS(NZ,NY,NX)=WTRTS(NZ,NY,NX)+WTRT1(N,L,NR,NZ,NY,NX) - 2+WTRT2(N,L,NR,NZ,NY,NX) - WTRTN(NZ,NY,NX)=WTRTN(NZ,NY,NX)+WTRT1N(N,L,NR,NZ,NY,NX) - 2+WTRT2N(N,L,NR,NZ,NY,NX) - WTRTP(NZ,NY,NX)=WTRTP(NZ,NY,NX)+WTRT1P(N,L,NR,NZ,NY,NX) - 2+WTRT2P(N,L,NR,NZ,NY,NX) -8935 CONTINUE -8930 CONTINUE -8925 CONTINUE -C -C ACCUMULATE NODULE STATE VATIABLES FROM NODULE LAYER VARIABLES -C - IF(INTYP(NZ,NY,NX).NE.0)THEN - WTND(NZ,NY,NX)=0.0 - WTNDN(NZ,NY,NX)=0.0 - WTNDP(NZ,NY,NX)=0.0 - IF(INTYP(NZ,NY,NX).GE.3)THEN - DO 7950 NB=1,NBR(NZ,NY,NX) - CPOLNP(NZ,NY,NX)=CPOLNP(NZ,NY,NX)+CPOLNB(NB,NZ,NY,NX) - ZPOLNP(NZ,NY,NX)=ZPOLNP(NZ,NY,NX)+ZPOLNB(NB,NZ,NY,NX) - PPOLNP(NZ,NY,NX)=PPOLNP(NZ,NY,NX)+PPOLNB(NB,NZ,NY,NX) - WTND(NZ,NY,NX)=WTND(NZ,NY,NX)+WTNDB(NB,NZ,NY,NX) - 2+CPOLNB(NB,NZ,NY,NX) - WTNDN(NZ,NY,NX)=WTNDN(NZ,NY,NX)+WTNDBN(NB,NZ,NY,NX) - 2+ZPOLNB(NB,NZ,NY,NX) - WTNDP(NZ,NY,NX)=WTNDP(NZ,NY,NX)+WTNDBP(NB,NZ,NY,NX) - 2+PPOLNB(NB,NZ,NY,NX) -7950 CONTINUE - ELSEIF(INTYP(NZ,NY,NX).EQ.1.OR.INTYP(NZ,NY,NX).EQ.2)THEN - DO 8920 L=NU(NY,NX),NI(NZ,NY,NX) - WTND(NZ,NY,NX)=WTND(NZ,NY,NX)+WTNDL(L,NZ,NY,NX) - 2+CPOOLN(L,NZ,NY,NX) - WTNDN(NZ,NY,NX)=WTNDN(NZ,NY,NX)+WTNDLN(L,NZ,NY,NX) - 2+ZPOOLN(L,NZ,NY,NX) - WTNDP(NZ,NY,NX)=WTNDP(NZ,NY,NX)+WTNDLP(L,NZ,NY,NX) - 2+PPOOLN(L,NZ,NY,NX) -8920 CONTINUE - ENDIF - ENDIF -C -C ACCUMULATE TOTAL SOIL-PLANT C,N,P EXCHANGE -C - HCUPTK(NZ,NY,NX)=UPOMC(NZ,NY,NX) - HZUPTK(NZ,NY,NX)=UPOMN(NZ,NY,NX)+UPNH4(NZ,NY,NX)+UPNO3(NZ,NY,NX) - 2+UPNF(NZ,NY,NX) - HPUPTK(NZ,NY,NX)=UPOMP(NZ,NY,NX)+UPH2P(NZ,NY,NX) - TCUPTK(NZ,NY,NX)=TCUPTK(NZ,NY,NX)+UPOMC(NZ,NY,NX) - TZUPTK(NZ,NY,NX)=TZUPTK(NZ,NY,NX)+UPOMN(NZ,NY,NX)+UPNH4(NZ,NY,NX) - 2+UPNO3(NZ,NY,NX) - TPUPTK(NZ,NY,NX)=TPUPTK(NZ,NY,NX)+UPOMP(NZ,NY,NX)+UPH2P(NZ,NY,NX) - TZUPFX(NZ,NY,NX)=TZUPFX(NZ,NY,NX)+UPNF(NZ,NY,NX)+UPNFC(NZ,NY,NX) - ENDIF -C -C HARVEST STANDING DEAD -C - IF(IHVST(NZ,I,NY,NX).GE.0)THEN - IF(J.EQ.INT(ZNOON(NY,NX)).AND.IHVST(NZ,I,NY,NX).NE.4 - 2.AND.IHVST(NZ,I,NY,NX).NE.6)THEN - IF(THIN(NZ,I,NY,NX).EQ.0.0)THEN - FHVST=AMAX1(0.0,1.0-EHVST(1,4,NZ,I,NY,NX)) - FHVSH=FHVST - ELSE - FHVST=AMAX1(0.0,1.0-THIN(NZ,I,NY,NX)) - IF(IHVST(NZ,I,NY,NX).EQ.0)THEN - FHVSH=AMAX1(0.0,1.0-EHVST(1,4,NZ,I,NY,NX)*THIN(NZ,I,NY,NX)) - ELSE - FHVSH=FHVST - ENDIF - ENDIF - ELSEIF(IHVST(NZ,I,NY,NX).EQ.4.OR.IHVST(NZ,I,NY,NX).EQ.6)THEN - IF(WTSTG(NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - WHVSTD=HVST(NZ,I,NY,NX)*THIN(NZ,I,NY,NX)*0.45/24.0 - 2*AREA(3,NU(NY,NX),NY,NX)*EHVST(1,4,NZ,I,NY,NX) - FHVST=AMAX1(0.0,1.0-WHVSTD/WTSTG(NZ,NY,NX)) - FHVSH=FHVST - ELSE - FHVST=1.0 - FHVSH=1.0 - ENDIF - ELSE - FHVST=1.0 - FHVSH=1.0 - ENDIF - DO 6475 M=1,4 - WTHTH4=WTHTH4+(1.0-FHVSH)*WTSTDG(M,NZ,NY,NX) - WTHNH4=WTHNH4+(1.0-FHVSH)*WTSTDN(M,NZ,NY,NX) - WTHPH4=WTHPH4+(1.0-FHVSH)*WTSTDP(M,NZ,NY,NX) - WTHTX4=WTHTX4+(FHVSH-FHVST)*WTSTDG(M,NZ,NY,NX) - WTHNX4=WTHNX4+(FHVSH-FHVST)*WTSTDN(M,NZ,NY,NX) - WTHPX4=WTHPX4+(FHVSH-FHVST)*WTSTDP(M,NZ,NY,NX) - WTSTDG(M,NZ,NY,NX)=FHVST*WTSTDG(M,NZ,NY,NX) - WTSTDN(M,NZ,NY,NX)=FHVST*WTSTDN(M,NZ,NY,NX) - WTSTDP(M,NZ,NY,NX)=FHVST*WTSTDP(M,NZ,NY,NX) -6475 CONTINUE -C -C IF NO PLANT C,N,P REMOVED AT HARVEST (ALL RESIDUE RETURNED) -C - IF(IHVST(NZ,I,NY,NX).EQ.0)THEN - WTHTR0=WTHTH0*(1.0-EHVST(2,1,NZ,I,NY,NX)) - WTHNR0=WTHNH0*(1.0-EHVST(2,1,NZ,I,NY,NX)) - WTHPR0=WTHPH0*(1.0-EHVST(2,1,NZ,I,NY,NX)) - WTHTR1=WTHTH1*(1.0-EHVST(2,1,NZ,I,NY,NX)) - WTHNR1=WTHNH1*(1.0-EHVST(2,1,NZ,I,NY,NX)) - WTHPR1=WTHPH1*(1.0-EHVST(2,1,NZ,I,NY,NX)) - WTHTR2=WTHTH2*(1.0-EHVST(2,2,NZ,I,NY,NX)) - WTHNR2=WTHNH2*(1.0-EHVST(2,2,NZ,I,NY,NX)) - WTHPR2=WTHPH2*(1.0-EHVST(2,2,NZ,I,NY,NX)) - WTHTR3=WTHTH3*(1.0-EHVST(2,3,NZ,I,NY,NX)) - WTHNR3=WTHNH3*(1.0-EHVST(2,3,NZ,I,NY,NX)) - WTHPR3=WTHPH3*(1.0-EHVST(2,3,NZ,I,NY,NX)) - WTHTR4=WTHTH4*(1.0-EHVST(2,4,NZ,I,NY,NX)) - WTHNR4=WTHNH4*(1.0-EHVST(2,4,NZ,I,NY,NX)) - WTHPR4=WTHPH4*(1.0-EHVST(2,4,NZ,I,NY,NX)) -C -C IF ONLY GRAIN C,N,P REMOVED AT HARVEST -C - ELSEIF(IHVST(NZ,I,NY,NX).EQ.1)THEN - WTHTR0=WTHTH0 - WTHNR0=WTHNH0 - WTHPR0=WTHPH0 - WTHTR1=WTHTH1 - WTHNR1=WTHNH1 - WTHPR1=WTHPH1 - WTHTR2=WTHTH2-WTHTG*EHVST(2,2,NZ,I,NY,NX) - WTHNR2=WTHNH2-WTHNG*EHVST(2,2,NZ,I,NY,NX) - WTHPR2=WTHPH2-WTHPG*EHVST(2,2,NZ,I,NY,NX) - WTHTR3=WTHTH3 - WTHNR3=WTHNH3 - WTHPR3=WTHPH3 - WTHTR4=WTHTH4 - WTHNR4=WTHNH4 - WTHPR4=WTHPH4 -C -C IF ONLY WOOD C,N,P REMOVED AT HARVEST -C - ELSEIF(IHVST(NZ,I,NY,NX).EQ.2)THEN - WTHTR0=WTHTH0*(1.0-EHVST(2,1,NZ,I,NY,NX)) - WTHNR0=WTHNH0*(1.0-EHVST(2,1,NZ,I,NY,NX)) - WTHPR0=WTHPH0*(1.0-EHVST(2,1,NZ,I,NY,NX)) - WTHTR1=WTHTH1*(1.0-EHVST(2,1,NZ,I,NY,NX)) - WTHNR1=WTHNH1*(1.0-EHVST(2,1,NZ,I,NY,NX)) - WTHPR1=WTHPH1*(1.0-EHVST(2,1,NZ,I,NY,NX)) - WTHTR2=WTHTH2*(1.0-EHVST(2,2,NZ,I,NY,NX)) - WTHNR2=WTHNH2*(1.0-EHVST(2,2,NZ,I,NY,NX)) - WTHPR2=WTHPH2*(1.0-EHVST(2,2,NZ,I,NY,NX)) - WTHTR3=WTHTH3*(1.0-EHVST(2,3,NZ,I,NY,NX)) - WTHNR3=WTHNH3*(1.0-EHVST(2,3,NZ,I,NY,NX)) - WTHPR3=WTHPH3*(1.0-EHVST(2,3,NZ,I,NY,NX)) - WTHTR4=WTHTH4*(1.0-EHVST(2,4,NZ,I,NY,NX)) - WTHNR4=WTHNH4*(1.0-EHVST(2,4,NZ,I,NY,NX)) - WTHPR4=WTHPH4*(1.0-EHVST(2,4,NZ,I,NY,NX)) -C -C IF ALL PLANT C,N,P REMOVED AT HARVEST (NO RESIDUE RETURNED) -C - ELSEIF(IHVST(NZ,I,NY,NX).EQ.3)THEN - WTHTR0=WTHTH0*(1.0-EHVST(2,1,NZ,I,NY,NX)) - WTHNR0=WTHNH0*(1.0-EHVST(2,1,NZ,I,NY,NX)) - WTHPR0=WTHPH0*(1.0-EHVST(2,1,NZ,I,NY,NX)) - WTHTR1=WTHTH1*(1.0-EHVST(2,1,NZ,I,NY,NX)) - WTHNR1=WTHNH1*(1.0-EHVST(2,1,NZ,I,NY,NX)) - WTHPR1=WTHPH1*(1.0-EHVST(2,1,NZ,I,NY,NX)) - WTHTR2=WTHTH2*(1.0-EHVST(2,2,NZ,I,NY,NX)) - WTHNR2=WTHNH2*(1.0-EHVST(2,2,NZ,I,NY,NX)) - WTHPR2=WTHPH2*(1.0-EHVST(2,2,NZ,I,NY,NX)) - WTHTR3=WTHTH3*(1.0-EHVST(2,3,NZ,I,NY,NX)) - WTHNR3=WTHNH3*(1.0-EHVST(2,3,NZ,I,NY,NX)) - WTHPR3=WTHPH3*(1.0-EHVST(2,3,NZ,I,NY,NX)) - WTHTR4=WTHTH4*(1.0-EHVST(2,4,NZ,I,NY,NX)) - WTHNR4=WTHNH4*(1.0-EHVST(2,4,NZ,I,NY,NX)) - WTHPR4=WTHPH4*(1.0-EHVST(2,4,NZ,I,NY,NX)) -C -C IF PLANT C,N,P REMOVED BY GRAZING -C - ELSEIF(IHVST(NZ,I,NY,NX).EQ.4.OR.IHVST(NZ,I,NY,NX).EQ.6)THEN - WTHTR0=WTHTH0*(1.0-EHVST(2,1,NZ,I,NY,NX)) - WTHNR0=WTHNH0*(1.0-EHVST(2,1,NZ,I,NY,NX)*0.5) - WTHPR0=WTHPH0*(1.0-EHVST(2,1,NZ,I,NY,NX)*0.5) - WTHTR1=WTHTH1*(1.0-EHVST(2,1,NZ,I,NY,NX)) - WTHNR1=WTHNH1*(1.0-EHVST(2,1,NZ,I,NY,NX)*0.5) - WTHPR1=WTHPH1*(1.0-EHVST(2,1,NZ,I,NY,NX)*0.5) - WTHTR2=WTHTH2*(1.0-EHVST(2,2,NZ,I,NY,NX)) - WTHNR2=WTHNH2*(1.0-EHVST(2,2,NZ,I,NY,NX)*0.5) - WTHPR2=WTHPH2*(1.0-EHVST(2,2,NZ,I,NY,NX)*0.5) - WTHTR3=WTHTH3*(1.0-EHVST(2,3,NZ,I,NY,NX)) - WTHNR3=WTHNH3*(1.0-EHVST(2,3,NZ,I,NY,NX)*0.5) - WTHPR3=WTHPH3*(1.0-EHVST(2,3,NZ,I,NY,NX)*0.5) - WTHTR4=WTHTH4*(1.0-EHVST(2,4,NZ,I,NY,NX)) - WTHNR4=WTHNH4*(1.0-EHVST(2,4,NZ,I,NY,NX)*0.5) - WTHPR4=WTHPH4*(1.0-EHVST(2,4,NZ,I,NY,NX)*0.5) -C -C ADD MANURE FROM GRAZING NEXT DAY -C - FERT(17,I+1,NY,NX)=FERT(17,I+1,NY,NX) - 2+(WTHTR1+WTHTR2+WTHTR3+WTHTR4)/AREA(3,NU(NY,NX),NY,NX) - FERT(18,I+1,NY,NX)=FERT(18,I+1,NY,NX) - 2+(WTHNR1+WTHNR2+WTHNR3+WTHNR4)/AREA(3,NU(NY,NX),NY,NX)*0.5 - FERT(3,I+1,NY,NX)=FERT(3,I+1,NY,NX) - 2+(WTHNR1+WTHNR2+WTHNR3+WTHNR4)/AREA(3,NU(NY,NX),NY,NX)*0.5 - FERT(19,I+1,NY,NX)=FERT(19,I+1,NY,NX) - 2+(WTHPR1+WTHPR2+WTHPR3+WTHPR4)/AREA(3,NU(NY,NX),NY,NX) - IYTYP(2,I+1,NY,NX)=3 -C IF(NX.EQ.2)THEN -C WRITE(*,6542)'MANURE',I,J,NX,NY,NZ,FERT(2,I+1,NY,NX) -C 2,WTHNR1,WTHNR2,WTHNR3,WTHNR4,WTHNH1,WTHNH2,WTHNH3 -C 3,WTHNH4 -6542 FORMAT(A8,5I4,20E12.4) -C ENDIF -C -C FIRE -C - ELSEIF(IHVST(NZ,I,NY,NX).EQ.5)THEN - WTHTR0=WTHTH0*(1.0-EHVST(2,1,NZ,I,NY,NX)) - WTHNR0=WTHNH0*(1.0-EFIRE(1,IHVST(NZ,I,NY,NX)) - 2*EHVST(2,1,NZ,I,NY,NX)) - WTHPR0=WTHPH0*(1.0-EFIRE(2,IHVST(NZ,I,NY,NX)) - 2*EHVST(2,1,NZ,I,NY,NX)) - WTHNL0=WTHNH0*(1.0-EHVST(2,1,NZ,I,NY,NX)) - WTHPL0=WTHPH0*(1.0-EHVST(2,1,NZ,I,NY,NX)) - WTHTR1=WTHTH1*(1.0-EHVST(2,1,NZ,I,NY,NX)) - WTHNR1=WTHNH1*(1.0-EFIRE(1,IHVST(NZ,I,NY,NX)) - 2*EHVST(2,1,NZ,I,NY,NX)) - WTHPR1=WTHPH1*(1.0-EFIRE(2,IHVST(NZ,I,NY,NX)) - 2*EHVST(2,1,NZ,I,NY,NX)) - WTHNL1=WTHNH1*(1.0-EHVST(2,1,NZ,I,NY,NX)) - WTHPL1=WTHPH1*(1.0-EHVST(2,1,NZ,I,NY,NX)) - WTHTR2=WTHTH2*(1.0-EHVST(2,2,NZ,I,NY,NX)) - WTHNR2=WTHNH2*(1.0-EFIRE(1,IHVST(NZ,I,NY,NX)) - 2*EHVST(2,2,NZ,I,NY,NX)) - WTHPR2=WTHPH2*(1.0-EFIRE(2,IHVST(NZ,I,NY,NX)) - 2*EHVST(2,2,NZ,I,NY,NX)) - WTHNL2=WTHNH2*(1.0-EHVST(2,2,NZ,I,NY,NX)) - WTHPL2=WTHPH2*(1.0-EHVST(2,2,NZ,I,NY,NX)) - WTHTR3=WTHTH3*(1.0-EHVST(2,3,NZ,I,NY,NX)) - WTHNR3=WTHNH3*(1.0-EFIRE(1,IHVST(NZ,I,NY,NX)) - 2*EHVST(2,3,NZ,I,NY,NX)) - WTHPR3=WTHPH3*(1.0-EFIRE(2,IHVST(NZ,I,NY,NX)) - 2*EHVST(2,3,NZ,I,NY,NX)) - WTHNL3=WTHNH3*(1.0-EHVST(2,3,NZ,I,NY,NX)) - WTHPL3=WTHPH3*(1.0-EHVST(2,3,NZ,I,NY,NX)) - WTHTR4=WTHTH4*(1.0-EHVST(2,4,NZ,I,NY,NX)) - WTHNR4=WTHNH4*(1.0-EFIRE(1,IHVST(NZ,I,NY,NX)) - 2*EHVST(2,4,NZ,I,NY,NX)) - WTHPR4=WTHPH4*(1.0-EFIRE(2,IHVST(NZ,I,NY,NX)) - 2*EHVST(2,4,NZ,I,NY,NX)) - WTHNL4=WTHNH4*(1.0-EHVST(2,4,NZ,I,NY,NX)) - WTHPL4=WTHPH4*(1.0-EHVST(2,4,NZ,I,NY,NX)) - ENDIF -C -C C,N,P REMOVED FROM HARVESTING -C - WTHTHT=WTHTH0+WTHTH1+WTHTH2+WTHTH3+WTHTH4 - WTHTRT=WTHTR0+WTHTR1+WTHTR2+WTHTR3+WTHTR4 - WTHNHT=WTHNH0+WTHNH1+WTHNH2+WTHNH3+WTHNH4 - WTHNRT=WTHNR0+WTHNR1+WTHNR2+WTHNR3+WTHNR4 - WTHPHT=WTHPH0+WTHPH1+WTHPH2+WTHPH3+WTHPH4 - WTHPRT=WTHPR0+WTHPR1+WTHPR2+WTHPR3+WTHPR4 - WTHTXT=WTHTX0+WTHTX1+WTHTX2+WTHTX3+WTHTX4 - WTHNXT=WTHNX0+WTHNX1+WTHNX2+WTHNX3+WTHNX4 - WTHPXT=WTHPX0+WTHPX1+WTHPX2+WTHPX3+WTHPX4 - IF(IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6)THEN - IF(IHVST(NZ,I,NY,NX).NE.5)THEN - IF(JHVST(NZ,I,NY,NX).NE.2)THEN - HVSTC(NZ,NY,NX)=HVSTC(NZ,NY,NX)+WTHTHT-WTHTRT - HVSTN(NZ,NY,NX)=HVSTN(NZ,NY,NX)+WTHNHT-WTHNRT - HVSTP(NZ,NY,NX)=HVSTP(NZ,NY,NX)+WTHPHT-WTHPRT - TNBP(NY,NX)=TNBP(NY,NX)+WTHTRT-WTHTHT - XHVSTC(NY,NX)=XHVSTC(NY,NX)+WTHTHT-WTHTRT - XHVSTN(NY,NX)=XHVSTN(NY,NX)+WTHNHT-WTHNRT - XHVSTP(NY,NX)=XHVSTP(NY,NX)+WTHPHT-WTHPRT - ELSE - WTRVC(NZ,NY,NX)=WTRVC(NZ,NY,NX)+WTHTHT-WTHTRT - WTRVN(NZ,NY,NX)=WTRVN(NZ,NY,NX)+WTHNHT-WTHNRT - WTRVP(NZ,NY,NX)=WTRVP(NZ,NY,NX)+WTHPHT-WTHPRT - ENDIF -C -C C,N,P LOST AS GAS IF FIRE -C - ELSE - VCO2F(NZ,NY,NX)=VCO2F(NZ,NY,NX)-(1.0-FCH4F)*(WTHTHT-WTHTRT) - VCH4F(NZ,NY,NX)=VCH4F(NZ,NY,NX)-FCH4F*(WTHTHT-WTHTRT) - VOXYF(NZ,NY,NX)=VOXYF(NZ,NY,NX)-(1.0-FCH4F)*(WTHTHT-WTHTRT)*2.667 - VNH3F(NZ,NY,NX)=VNH3F(NZ,NY,NX)-WTHNHT+WTHNRT - VN2OF(NZ,NY,NX)=VN2OF(NZ,NY,NX)-0.0 - VPO4F(NZ,NY,NX)=VPO4F(NZ,NY,NX)-WTHPHT+WTHPRT - CNET(NZ,NY,NX)=CNET(NZ,NY,NX)-(1.0-FCH4F)*(WTHTHT-WTHTRT) - TNBP(NY,NX)=TNBP(NY,NX)-FCH4F*(WTHTHT-WTHTRT) -C WRITE(*,5679)'FIRE2',I,J,NZ,VCO2F(NZ,NY,NX),FCH4F,WTHNH0,WTHNH1,WTHNH2 -C 3,WTHNH3,WTHNH4,WTHNR0,WTHNR1,WTHNR2,WTHNR3,WTHNR4,WTHNHT,WTHNRT -5679 FORMAT(A8,3I4,20E12.4) - ENDIF -C -C C,N,P REMOVED FROM GRAZING -C - ELSE - HVSTC(NZ,NY,NX)=HVSTC(NZ,NY,NX)+GY*(WTHTHT-WTHTRT) - TCO2T(NZ,NY,NX)=TCO2T(NZ,NY,NX)-GZ*(WTHTHT-WTHTRT) - TCO2A(NZ,NY,NX)=TCO2A(NZ,NY,NX)-GZ*(WTHTHT-WTHTRT) - HVSTN(NZ,NY,NX)=HVSTN(NZ,NY,NX)+WTHNHT-WTHNRT - HVSTP(NZ,NY,NX)=HVSTP(NZ,NY,NX)+WTHPHT-WTHPRT - TNBP(NY,NX)=TNBP(NY,NX)+GY*(WTHTRT-WTHTHT) - CNET(NZ,NY,NX)=CNET(NZ,NY,NX)+GZ*(WTHTRT-WTHTHT) - XHVSTC(NY,NX)=XHVSTC(NY,NX)+GY*(WTHTHT-WTHTRT) - XHVSTN(NY,NX)=XHVSTN(NY,NX)+WTHNHT-WTHNRT - XHVSTP(NY,NX)=XHVSTP(NY,NX)+WTHPHT-WTHPRT - RECO(NY,NX)=RECO(NY,NX)-GZ*(WTHTHT-WTHTRT) - TRAU(NY,NX)=TRAU(NY,NX)-GZ*(WTHTHT-WTHTRT) - ENDIF -C -C ABOVE-GROUND LITTERFALL FROM HARVESTING -C - IF(IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6)THEN - IF(IHVST(NZ,I,NY,NX).NE.5)THEN - DO 6375 M=1,4 - CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) - 2+CFOPC(0,M,NZ,NY,NX)*(WTHTR0+WTHTX0) - 3+CFOPC(1,M,NZ,NY,NX)*(WTHTR1+WTHTX1) - 4+CFOPC(2,M,NZ,NY,NX)*(WTHTR2+WTHTX2) - ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) - 2+CFOPN(0,M,NZ,NY,NX)*(WTHNR0+WTHNX0) - 3+CFOPN(1,M,NZ,NY,NX)*(WTHNR1+WTHNX1) - 4+CFOPN(2,M,NZ,NY,NX)*(WTHNR2+WTHNX2) - PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) - 2+CFOPP(0,M,NZ,NY,NX)*(WTHPR0+WTHPX0) - 3+CFOPP(1,M,NZ,NY,NX)*(WTHPR1+WTHPX1) - 4+CFOPP(2,M,NZ,NY,NX)*(WTHPR2+WTHPX2) - IF(IBTYP(NZ,NY,NX).EQ.0.OR.IGTYP(NZ,NY,NX).LE.1)THEN - CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) - 2+CFOPC(3,M,NZ,NY,NX)*(WTHTR3+WTHTX3+WTHTR4+WTHTX4) - ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) - 2+CFOPN(3,M,NZ,NY,NX)*(WTHNR3+WTHNX3+WTHNR4+WTHNX4) - PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) - 2+CFOPP(3,M,NZ,NY,NX)*(WTHPR3+WTHPX3+WTHPR4+WTHPX4) - ELSE - WTSTDG(M,NZ,NY,NX)=WTSTDG(M,NZ,NY,NX) - 2+CFOPC(5,M,NZ,NY,NX)*(WTHTX3+WTHTX4) - WTSTDN(M,NZ,NY,NX)=WTSTDN(M,NZ,NY,NX) - 2+CFOPN(5,M,NZ,NY,NX)*(WTHNX3+WTHNX4) - WTSTDP(M,NZ,NY,NX)=WTSTDP(M,NZ,NY,NX) - 2+CFOPP(5,M,NZ,NY,NX)*(WTHPX3+WTHPX4) - CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX) - 2+FRC*CFOPC(5,M,NZ,NY,NX)*(WTHTR3+WTHTR4) - ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX) - 2+FRC*CFOPN(5,M,NZ,NY,NX)*(WTHNR3+WTHNR4) - PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX) - 2+FRC*CFOPP(5,M,NZ,NY,NX)*(WTHPR3+WTHPR4) - CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) - 2+FRF*CFOPC(5,M,NZ,NY,NX)*(WTHTR3+WTHTR4) - ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) - 2+FRF*CFOPN(5,M,NZ,NY,NX)*(WTHNR3+WTHNR4) - PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) - 2+FRF*CFOPP(5,M,NZ,NY,NX)*(WTHPR3+WTHPR4) - ENDIF -6375 CONTINUE -C -C ABOVE-GROUND LITTERFALL FROM FIRE -C - ELSE - DO 6485 M=1,4 - CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) - 2+CFOPC(0,M,NZ,NY,NX)*(WTHTR0+WTHTX0) - 3+CFOPC(1,M,NZ,NY,NX)*(WTHTR1+WTHTX1) - 4+CFOPC(2,M,NZ,NY,NX)*(WTHTR2+WTHTX2) - ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) - 2+CFOPN(0,M,NZ,NY,NX)*WTHNL0 - 3+CFOPN(1,M,NZ,NY,NX)*WTHNL1 - 4+CFOPN(2,M,NZ,NY,NX)*WTHNL2 - PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) - 2+CFOPP(0,M,NZ,NY,NX)*WTHPL0 - 3+CFOPP(1,M,NZ,NY,NX)*WTHPL1 - 4+CFOPP(2,M,NZ,NY,NX)*WTHPL2 - ZSNC(4,1,0,NZ,NY,NX)=ZSNC(4,1,0,NZ,NY,NX) - 2+CFOPN(0,M,NZ,NY,NX)*(WTHNR0+WTHNX0-WTHNL0) - 3+CFOPN(1,M,NZ,NY,NX)*(WTHNR1+WTHNX1-WTHNL1) - 4+CFOPN(2,M,NZ,NY,NX)*(WTHNR2+WTHNX2-WTHNL2) - PSNC(4,1,0,NZ,NY,NX)=PSNC(4,1,0,NZ,NY,NX) - 2+CFOPP(0,M,NZ,NY,NX)*(WTHPR0+WTHPX0-WTHPL0) - 3+CFOPP(1,M,NZ,NY,NX)*(WTHPR1+WTHPX1-WTHPL1) - 4+CFOPP(2,M,NZ,NY,NX)*(WTHPR2+WTHPX2-WTHPL2) - IF(IBTYP(NZ,NY,NX).EQ.0.OR.IGTYP(NZ,NY,NX).LE.1)THEN - CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) - 2+CFOPC(3,M,NZ,NY,NX)*(WTHTR3+WTHTX3+WTHTR4+WTHTX4) - ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) - 2+CFOPN(3,M,NZ,NY,NX)*(WTHNL3+WTHNL4) - PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) - 2+CFOPP(3,M,NZ,NY,NX)*(WTHPL3+WTHPL4) - ZSNC(4,1,0,NZ,NY,NX)=ZSNC(4,1,0,NZ,NY,NX) - 2+CFOPN(3,M,NZ,NY,NX)*(WTHNR3+WTHNX3-WTHNL3+WTHNR4+WTHNX4-WTHNL4) - PSNC(4,1,0,NZ,NY,NX)=PSNC(4,1,0,NZ,NY,NX) - 2+CFOPP(3,M,NZ,NY,NX)*(WTHPR3+WTHPX3-WTHPL3+WTHPR4+WTHPX4-WTHPL4) - ELSE - WTSTDG(M,NZ,NY,NX)=WTSTDG(M,NZ,NY,NX) - 2+CFOPC(5,M,NZ,NY,NX)*(WTHTR3+WTHTX3) - WTSTDN(M,NZ,NY,NX)=WTSTDN(M,NZ,NY,NX) - 2+CFOPN(5,M,NZ,NY,NX)*WTHNL3 - WTSTDP(M,NZ,NY,NX)=WTSTDP(M,NZ,NY,NX) - 2+CFOPP(5,M,NZ,NY,NX)*WTHPL3 - CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX) - 2+FRC*CFOPC(3,M,NZ,NY,NX)*(WTHTR4+WTHTX4) - ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX) - 2+FRC*CFOPN(3,M,NZ,NY,NX)*WTHNL4 - PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX) - 2+FRC*CFOPP(3,M,NZ,NY,NX)*WTHPL4 - ZSNC(4,0,0,NZ,NY,NX)=ZSNC(4,0,0,NZ,NY,NX) - 2+FRC*CFOPN(5,M,NZ,NY,NX)*(WTHNR3+WTHNX3-WTHNL3 - 3+WTHNR4+WTHNX4-WTHNL4) - PSNC(4,0,0,NZ,NY,NX)=PSNC(4,0,0,NZ,NY,NX) - 2+FRC*CFOPP(5,M,NZ,NY,NX)*(WTHPR3+WTHPX3-WTHPL3 - 3+WTHPR4+WTHPX4-WTHPL4) - CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) - 2+FRF*CFOPC(3,M,NZ,NY,NX)*(WTHTR4+WTHTX4) - ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) - 2+FRF*CFOPN(3,M,NZ,NY,NX)*WTHNL4 - PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) - 2+FRF*CFOPP(3,M,NZ,NY,NX)*WTHPL4 - ZSNC(4,1,0,NZ,NY,NX)=ZSNC(4,1,0,NZ,NY,NX) - 2+FRF*CFOPN(5,M,NZ,NY,NX)*(WTHNR3+WTHNX3-WTHNL3 - 3+WTHNR4+WTHNX4-WTHNL4) - PSNC(4,1,0,NZ,NY,NX)=PSNC(4,1,0,NZ,NY,NX) - 2+FRF*CFOPP(5,M,NZ,NY,NX)*(WTHPR3+WTHPX3-WTHPL3 - 3+WTHPR4+WTHPX4-WTHPL4) - ENDIF -6485 CONTINUE - ENDIF - ELSE -C -C ABOVE-GROUND LITTERFALL FROM GRAZING -C - TCSNC(NZ,NY,NX)=TCSNC(NZ,NY,NX)+WTHTRT+WTHTXT - TZSNC(NZ,NY,NX)=TZSNC(NZ,NY,NX)+WTHNRT+WTHNXT - TPSNC(NZ,NY,NX)=TPSNC(NZ,NY,NX)+WTHPRT+WTHPXT - TCSN0(NZ,NY,NX)=TCSN0(NZ,NY,NX)+WTHTRT+WTHTXT - TZSN0(NZ,NY,NX)=TZSNC(NZ,NY,NX)+WTHNRT+WTHNXT - TPSN0(NZ,NY,NX)=TPSNC(NZ,NY,NX)+WTHPRT+WTHPXT - ENDIF - ZEROP(NZ,NY,NX)=ZERO*PP(NZ,NY,NX) - ZEROQ(NZ,NY,NX)=ZERO*PP(NZ,NY,NX)/AREA(3,NU(NY,NX),NY,NX) - ZEROL(NZ,NY,NX)=ZERO*PP(NZ,NY,NX)*1.0E+06 - ENDIF -9985 CONTINUE -C -C TRANSFORMATIONS IN LIVING OR DEAD PLANT POPULATIONS -C - DO 9975 NZ=1,NP0(NY,NX) -C -C ACTIVATE DORMANT SEEDS -C - DO 205 NB=1,NBR(NZ,NY,NX) - IF(IFLGI(NZ,NY,NX).EQ.1)THEN - IF(IFLGE(NB,NZ,NY,NX).EQ.0 - 2.AND.VRNS(NB,NZ,NY,NX).GE.VRNL(NB,NZ,NY,NX))THEN - IDAY0(NZ,NY,NX)=I - IYR0(NZ,NY,NX)=IYRC - SDPTHI(NZ,NY,NX)=0.005 - IFLGI(NZ,NY,NX)=0 - ENDIF - ENDIF -205 CONTINUE -C -C LITTERFALL FROM STANDING DEAD -C - DO 6235 M=1,4 - XFRC=1.5814E-05*TFN3(NZ,NY,NX)*WTSTDG(M,NZ,NY,NX) - XFRN=1.5814E-05*TFN3(NZ,NY,NX)*WTSTDN(M,NZ,NY,NX) - XFRP=1.5814E-05*TFN3(NZ,NY,NX)*WTSTDP(M,NZ,NY,NX) - IF(IBTYP(NZ,NY,NX).EQ.0.OR.IGTYP(NZ,NY,NX).LE.1)THEN - CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX)+XFRC - ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX)+XFRN - PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX)+XFRP - ELSE - CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX)+XFRC - ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX)+XFRN - PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX)+XFRP - ENDIF - WTSTDG(M,NZ,NY,NX)=WTSTDG(M,NZ,NY,NX)-XFRC - WTSTDN(M,NZ,NY,NX)=WTSTDN(M,NZ,NY,NX)-XFRN - WTSTDP(M,NZ,NY,NX)=WTSTDP(M,NZ,NY,NX)-XFRP -6235 CONTINUE -C -C ACCUMULATE TOTAL SURFACE, SUBSURFACE LITTERFALL -C - DO 6430 M=1,4 - DO 6430 K=0,1 - TCSN0(NZ,NY,NX)=TCSN0(NZ,NY,NX)+CSNC(M,K,0,NZ,NY,NX) - TZSN0(NZ,NY,NX)=TZSN0(NZ,NY,NX)+ZSNC(M,K,0,NZ,NY,NX) - TPSN0(NZ,NY,NX)=TPSN0(NZ,NY,NX)+PSNC(M,K,0,NZ,NY,NX) - DO 8955 L=0,NJ(NY,NX) - HCSNC(NZ,NY,NX)=HCSNC(NZ,NY,NX)+CSNC(M,K,L,NZ,NY,NX) - HZSNC(NZ,NY,NX)=HZSNC(NZ,NY,NX)+ZSNC(M,K,L,NZ,NY,NX) - HPSNC(NZ,NY,NX)=HPSNC(NZ,NY,NX)+PSNC(M,K,L,NZ,NY,NX) - TCSNC(NZ,NY,NX)=TCSNC(NZ,NY,NX)+CSNC(M,K,L,NZ,NY,NX) - TZSNC(NZ,NY,NX)=TZSNC(NZ,NY,NX)+ZSNC(M,K,L,NZ,NY,NX) - TPSNC(NZ,NY,NX)=TPSNC(NZ,NY,NX)+PSNC(M,K,L,NZ,NY,NX) -8955 CONTINUE -6430 CONTINUE -C -C TOTAL STANDING DEAD -C - WTSTG(NZ,NY,NX)=WTSTDG(1,NZ,NY,NX)+WTSTDG(2,NZ,NY,NX) - 4+WTSTDG(3,NZ,NY,NX)+WTSTDG(4,NZ,NY,NX) - WTSTGN(NZ,NY,NX)=WTSTDN(1,NZ,NY,NX)+WTSTDN(2,NZ,NY,NX) - 4+WTSTDN(3,NZ,NY,NX)+WTSTDN(4,NZ,NY,NX) - WTSTGP(NZ,NY,NX)=WTSTDP(1,NZ,NY,NX)+WTSTDP(2,NZ,NY,NX) - 4+WTSTDP(3,NZ,NY,NX)+WTSTDP(4,NZ,NY,NX) -C -C PLANT C BALANCE = TOTAL C STATE VARIABLES + TOTAL -C AUTOTROPHIC RESPIRATION + TOTAL LITTERFALL - TOTAL EXUDATION -C - TOTAL CO2 FIXATION -C - ZNPP(NZ,NY,NX)=CARBN(NZ,NY,NX)+TCO2T(NZ,NY,NX) - IF(IFLGC(NZ,NY,NX).EQ.1)THEN - BALC(NZ,NY,NX)=WTSHT(NZ,NY,NX)+WTRT(NZ,NY,NX)+WTND(NZ,NY,NX) - 2+WTRVC(NZ,NY,NX)-ZNPP(NZ,NY,NX)+TCSNC(NZ,NY,NX)-TCUPTK(NZ,NY,NX) - 3-RSETC(NZ,NY,NX)+WTSTG(NZ,NY,NX)+THVSTC(NZ,NY,NX) - 4+HVSTC(NZ,NY,NX)-VCO2F(NZ,NY,NX)-VCH4F(NZ,NY,NX) -C IF(NZ.EQ.1)THEN -C WRITE(*,1111)'BALC',I,J,NX,NY,NZ,BALC(NZ,NY,NX),WTSHT(NZ,NY,NX) -C 2,WTRT(NZ,NY,NX),WTND(NZ,NY,NX),WTRVC(NZ,NY,NX),TCO2T(NZ,NY,NX) -C 3,TCSNC(NZ,NY,NX),TCUPTK(NZ,NY,NX),CARBN(NZ,NY,NX) -C 2,RSETC(NZ,NY,NX),WTSTG(NZ,NY,NX),THVSTC(NZ,NY,NX) -C 3,HVSTC(NZ,NY,NX),CPOOLP(NZ,NY,NX) -C 3,WTLF(NZ,NY,NX),WTSHE(NZ,NY,NX),WTSTK(NZ,NY,NX),WTRSV(NZ,NY,NX) -C 3,WTHSK(NZ,NY,NX),WTEAR(NZ,NY,NX),WTGR(NZ,NY,NX) -C 5,VCO2F(NZ,NY,NX),VCH4F(NZ,NY,NX) -C 5,(WTLFB(NB,NZ,NY,NX),NB=1,5) -C 3,((CSNC(M,0,L,NZ,NY,NX),M=1,4),L=0,NL(NY,NX)) -C 4,((CPOOLR(N,L,NZ,NY,NX),L=1,NL(NY,NX)),N=1,2) -C 4,(CPOOLK(NB,NZ,NY,NX),NB=1,10) -1111 FORMAT(A8,5I4,200F18.6) -C ENDIF -C -C PLANT N BALANCE = TOTAL N STATE VARIABLES + TOTAL N LITTERFALL -C - TOTAL N UPTAKE FROM SOIL - TOTAL N ABSORPTION FROM ATMOSPHERE -C - BALN(NZ,NY,NX)=WTSHN(NZ,NY,NX)+WTRTN(NZ,NY,NX)+WTNDN(NZ,NY,NX) - 2+WTRVN(NZ,NY,NX)+TZSNC(NZ,NY,NX)-TZUPTK(NZ,NY,NX)-TNH3C(NZ,NY,NX) - 3-RSETN(NZ,NY,NX)+WTSTGN(NZ,NY,NX)+HVSTN(NZ,NY,NX)+THVSTN(NZ,NY,NX) - 4-VNH3F(NZ,NY,NX)-VN2OF(NZ,NY,NX)-TZUPFX(NZ,NY,NX) -C IF(NZ.EQ.1)THEN -C WRITE(*,1112)'BALN',I,J,NX,NY,NZ,BALN(NZ,NY,NX),WTSHN(NZ,NY,NX) -C 2,WTRTN(NZ,NY,NX),WTNDN(NZ,NY,NX),WTRVN(NZ,NY,NX),TZSNC(NZ,NY,NX) -C 3,TZUPTK(NZ,NY,NX),TNH3C(NZ,NY,NX),RSETN(NZ,NY,NX),HVSTN(NZ,NY,NX) -C 4,WTSTGN(NZ,NY,NX),WTLFN(NZ,NY,NX),WTSHEN(NZ,NY,NX) -C 5,WTSTKN(NZ,NY,NX),WTRSVN(NZ,NY,NX),WTHSKN(NZ,NY,NX) -C 3,WTEARN(NZ,NY,NX),WTGRNN(NZ,NY,NX),UPOMN(NZ,NY,NX),UPNH4(NZ,NY,NX) -C 2,UPNO3(NZ,NY,NX),VNH3F(NZ,NY,NX),VN2OF(NZ,NY,NX) -C 4,((RDFOMN(N,L,NZ,NY,NX),N=1,2),L=NU(NY,NX),NI(NZ,NY,NX)) -C 4,((ZPOOLR(N,L,NZ,NY,NX),N=1,2),L=NU(NY,NX),NI(NZ,NY,NX)) -1112 FORMAT(A8,5I4,200F18.6) -C ENDIF -C -C PLANT P BALANCE = TOTAL P STATE VARIABLES + TOTAL P LITTERFALL -C - TOTAL P UPTAKE FROM SOIL -C - BALP(NZ,NY,NX)=WTSHP(NZ,NY,NX)+WTRTP(NZ,NY,NX)+WTNDP(NZ,NY,NX) - 2+WTRVP(NZ,NY,NX)+TPSNC(NZ,NY,NX)-TPUPTK(NZ,NY,NX) - 3-RSETP(NZ,NY,NX)+WTSTDP(1,NZ,NY,NX)+WTSTGP(NZ,NY,NX) - 4+HVSTP(NZ,NY,NX)+THVSTP(NZ,NY,NX)-VPO4F(NZ,NY,NX) -C IF(NZ.EQ.4)THEN -C WRITE(*,1112)'BALP',I,J,NX,NY,NZ,BALP(NZ,NY,NX),WTSHP(NZ,NY,NX) -C 2,WTRTP(NZ,NY,NX),WTNDP(NZ,NY,NX),WTRVP(NZ,NY,NX),TPSNC(NZ,NY,NX) -C 3,TPUPTK(NZ,NY,NX),RSETP(NZ,NY,NX) -C 4,WTSTDP(1,NZ,NY,NX),WTSTGP(NZ,NY,NX),HVSTP(NZ,NY,NX) -C 5,THVSTP(NZ,NY,NX),VPO4F(NZ,NY,NX) -C ENDIF - ENDIF -9975 CONTINUE -9990 CONTINUE -9995 CONTINUE - RETURN - END + + SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) +C +C THIS SUBROUTINE CALCULATES ALL PLANT BIOLOGICAL TRANSFORMATIONS +C + include "parameters.h" + include "files.h" + include "blkc.h" + include "blk1cp.h" + include "blk1cr.h" + include "blk1g.h" + include "blk1n.h" + include "blk1p.h" + include "blk1s.h" + include "blk2a.h" + include "blk2b.h" + include "blk2c.h" + include "blk3.h" + include "blk5.h" + include "blk8a.h" + include "blk8b.h" + include "blk9a.h" + include "blk9b.h" + include "blk9c.h" + include "blk11a.h" + include "blk11b.h" + include "blk12a.h" + include "blk12b.h" + include "blk13a.h" + include "blk13b.h" + include "blk13c.h" + include "blk14.h" + include "blk16.h" + include "blk18a.h" + include "blk18b.h" + DIMENSION PART(7),TFN6(JZ),ARSTKB(10),NRX(2,JZ),ICHK1(2,JZ) + 2,NBZ(10),FXFB(0:3),FXRT(0:1),FXSH(0:1),FXRN(4) + 3,WTLSBZ(10),CPOOLZ(10),ZPOOLZ(10),PPOOLZ(10) + 4,ZCX(JP,JY,JX),UPNFC(JP,JY,JX),FRSV(0:3),FXFY(0:1),FXFZ(0:1) + 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) + 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) + 2,FWODB(0:1),FWODLN(0:1),FWODLP(0:1),FWODSN(0:1),FWODSP(0:1) +C DIMENSION VCO2(400,366,05) + PARAMETER(PART1X=0.05,PART2X=0.02 + 2,VMXC=0.015,FSNR=2.884E-03,FLG4X=168.0 + 3,FLGZX=240.0,XFRX=2.5E-02,XFRY=2.5E-03,IFLGQX=960 + 4,FSNKM=0.05,FXFS=1.0,FMYC=0.01) + PARAMETER(CNKI=1.0E-01,CPKI=1.0E-02,CNKF=1.0) + PARAMETER(RMPLT=0.010,PSILM=0.1,RCMN=1.560E+01,RTDPX=0.00 + 2,RTLGAX=1.0E-02,EMODR=5.0) + PARAMETER(QNTM=0.45,CURV=0.70,CURV2=2.0*CURV,CURV4=4.0*CURV + 2,ELEC3=4.5,ELEC4=3.0,CO2KI=1.0E+03,FCO2B=0.02,FHCOB=1.0-FCO2B) + PARAMETER(COMP4=0.5,FDML=6.0,FBS=0.2*FDML,FMP=0.8*FDML + 2,FVRN=0.5) + PARAMETER(ZPLFM=0.33,ZPLFD=1.0-ZPLFM,ZPGRM=0.75 + 2,ZPGRD=1.0-ZPGRM,FRF=0.25,FRC=1.0-FRF,GY=0.2,GZ=1.0-GY) + PARAMETER(FSTK=0.05,ZSTX=1.0E-03,DSTK=0.225,VSTK=1.0E-06/DSTK + 2,FRTX=1.0/(1.0-(1.0-FSTK)**2)) + PARAMETER(SETC=1.0E-02,SETN=1.0E-03,SETP=1.0E-04) + PARAMETER(SLA2=-0.33,SSL2=-0.50,SNL2=-0.67) + PARAMETER(CNMX=0.20,CPMX=0.020,CNMN=0.050,CPMN=0.005) + PARAMETER(EN2F=0.20,VMXO=0.50,SPNDL=1.0E-06,CCNKM=1.0E-02 + 2,CCNKX=1.0E+02,WTNDI=0.01,RCCZR=0.0557,RCCYR=0.167 + 3,RCCZN=0.167,RCCYN=0.833) + DATA RCCZ/0.167,0.167,0.0557,0.167/ + 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 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/ + DATA FXSH/0.50,0.75/,FXRT/0.50,0.25/ + DATA FRSV/0.025,0.025,0.001,0.001/ + DATA FXFY/0.05,0.005/,FXFZ/0.25,0.005/ + DATA EFIRE/0.917,0.167/ + DATA PSILY/-200.0,-2.0,-2.0/ + DATA FLG4Y/360.0,1440.0,720.0,720.0/ + DATA ATRPX/68.96,276.9/,GVMX/0.010,0.0025/ +C DATA TC4,TLK/0.0,0.0/ + REAL*4 TFN5,WFNG,WFNC,WFNS,WFNSG,WFNSS,WFN4,WFNB + 2,WFNR,WFNRG,WFNGR,FSNC2 +C +C TOTAL AGB FOR GRAZING IN LANDSCAPE GROUP +C + DO 2995 NX=NHW,NHE + DO 2990 NY=NVN,NVS + DO 2985 NZ=1,NP(NY,NX) + IF(IHVST(NZ,I,NY,NX).EQ.4.OR.IHVST(NZ,I,NY,NX).EQ.6)THEN + WTSHTZ=0 + NN=0 + DO 1995 NX1=NHW,NHE + DO 1990 NY1=NVN,NVS + IF(LSG(NZ,NY1,NX1).EQ.LSG(NZ,NY,NX))THEN + IF(IFLGC(NZ,NY1,NX1).EQ.1)THEN + WTSHTZ=WTSHTZ+WTSHT(NZ,NY1,NX1) + NN=NN+1 + ENDIF + ENDIF +1990 CONTINUE +1995 CONTINUE + IF(NN.GT.0)THEN + WTSHTA(NZ,NY,NX)=WTSHTZ/NN + ELSE + WTSHTA(NZ,NY,NX)=WTSHT(NZ,NY,NX) + ENDIF + ENDIF +2985 CONTINUE +2990 CONTINUE +2995 CONTINUE + DO 9995 NX=NHW,NHE + DO 9990 NY=NVN,NVS + DO 9980 NZ=1,NP0(NY,NX) + DO 1 L=0,NJ(NY,NX) + DO 1 K=0,1 + DO 1 M=1,4 + CSNC(M,K,L,NZ,NY,NX)=0.0 + ZSNC(M,K,L,NZ,NY,NX)=0.0 + PSNC(M,K,L,NZ,NY,NX)=0.0 +1 CONTINUE + HCSNC(NZ,NY,NX)=0.0 + HZSNC(NZ,NY,NX)=0.0 + HPSNC(NZ,NY,NX)=0.0 + CNET(NZ,NY,NX)=0.0 + UPNFC(NZ,NY,NX)=0.0 + ZCX(NZ,NY,NX)=ZC(NZ,NY,NX) + ZC(NZ,NY,NX)=0.0 +9980 CONTINUE +C +C TRANSFORMATIONS IN LIVING PLANT POPULATIONS +C + DO 9985 NZ=1,NP(NY,NX) +C IF(J.EQ.INT(ZNOON(NY,NX)))THEN + XHVST=1.0 + WHVSBL=0.0 + WTHTH0=0.0 + WTHNH0=0.0 + WTHPH0=0.0 + WTHTH1=0.0 + WTHNH1=0.0 + WTHPH1=0.0 + WTHTH2=0.0 + WTHNH2=0.0 + WTHPH2=0.0 + WTHTH3=0.0 + WTHNH3=0.0 + WTHPH3=0.0 + WTHTH4=0.0 + WTHNH4=0.0 + WTHPH4=0.0 + WTHTR1=0.0 + WTHNR1=0.0 + WTHPR1=0.0 + WTHTR2=0.0 + WTHNR2=0.0 + WTHPR2=0.0 + WTHTR3=0.0 + WTHNR3=0.0 + WTHPR3=0.0 + WTHTR4=0.0 + WTHNR4=0.0 + WTHPR4=0.0 + WTHTX0=0.0 + WTHNX0=0.0 + WTHPX0=0.0 + WTHTX1=0.0 + WTHNX1=0.0 + WTHPX1=0.0 + WTHTX2=0.0 + WTHNX2=0.0 + WTHPX2=0.0 + WTHTX3=0.0 + WTHNX3=0.0 + WTHPX3=0.0 + WTHTX4=0.0 + WTHNX4=0.0 + WTHPX4=0.0 + WTHTG=0.0 + WTHNG=0.0 + WTHPG=0.0 +C ENDIF +C IF(NX.EQ.4.AND.NY.EQ.4.AND.NZ.EQ.2)THEN +C WRITE(*,2328)'IFLGC',I,J,NZ,IFLGC(NZ,NY,NX) +C 2,IDTHP(NZ,NY,NX),IDTHR(NZ,NY,NX) +2328 FORMAT(A8,10I4) +C ENDIF + IF(IFLGC(NZ,NY,NX).EQ.1)THEN + IF(IDTHP(NZ,NY,NX).EQ.0.OR.IDTHR(NZ,NY,NX).EQ.0)THEN +C IF(I.EQ.1.AND.J.EQ.1)THEN +C DO 87 II=1,366 +C DO 87 N=1,400 +C VCO2(N,II,NZ)=0.0 +87 CONTINUE +C ENDIF +C IF(IYRC.GE.2099)THEN +C IF(I.EQ.365.AND.J.EQ.24)THEN +C DO 88 N=1,400 +C WRITE(19,12)IYRC,NZ,N,(VCO2(N,II,NZ),II=1,181) +C WRITE(20,12)IYRC,NZ,N,(VCO2(N,II,NZ),II=182,365) +12 FORMAT(3I8,365E12.4) +88 CONTINUE +C ENDIF +C ENDIF + IFLGZ=0 + IFLGY=0 + DO 2 L=1,JC + ARLFV(L,NZ,NY,NX)=0.0 + WGLFV(L,NZ,NY,NX)=0.0 + ARSTV(L,NZ,NY,NX)=0.0 +2 CONTINUE + DO 5 NR=1,NRT(NZ,NY,NX) + DO 5 N=1,MY(NZ,NY,NX) + NRX(N,NR)=0 + ICHK1(N,NR)=0 +5 CONTINUE + DO 9 N=1,MY(NZ,NY,NX) + RTNT(N)=0.0 + DO 6 L=NU(NY,NX),NJ(NY,NX) + WSRTL(N,L,NZ,NY,NX)=0.0 + RTN1(N,L,NZ,NY,NX)=0.0 + RTNL(N,L,NZ,NY,NX)=0.0 + RCO2M(N,L,NZ,NY,NX)=0.0 + RCO2N(N,L,NZ,NY,NX)=0.0 + RCO2A(N,L,NZ,NY,NX)=0.0 + RLNT(N,L)=0.0 + DO 6 NR=1,NRT(NZ,NY,NX) + RTSK1(N,L,NR)=0.0 + RTSK2(N,L,NR)=0.0 +6 CONTINUE +9 CONTINUE + IF(IBTYP(NZ,NY,NX).EQ.0.OR.IGTYP(NZ,NY,NX).LE.1 + 2.OR.WTSTK(NZ,NY,NX).LT.ZEROP(NZ,NY,NX) + 3.OR.WVSTK(NZ,NY,NX).LT.ZEROP(NZ,NY,NX))THEN + FWOOD(1)=1.0 + FWODB(1)=1.0 + ELSE + FWOOD(1)=SQRT(FRTX*WVSTK(NZ,NY,NX)/WTSTK(NZ,NY,NX)) + FWODB(1)=1.0 + ENDIF + FWOOD(0)=1.0-FWOOD(1) + FWODB(0)=1.0-FWODB(1) + CNLFW=FWODB(0)*CNSTK(NZ,NY,NX)+FWODB(1)*CNLF(NZ,NY,NX) + CPLFW=FWODB(0)*CPSTK(NZ,NY,NX)+FWODB(1)*CPLF(NZ,NY,NX) + CNSHW=FWODB(0)*CNSTK(NZ,NY,NX)+FWODB(1)*CNSHE(NZ,NY,NX) + CPSHW=FWODB(0)*CPSTK(NZ,NY,NX)+FWODB(1)*CPSHE(NZ,NY,NX) + CNRTW=FWOOD(0)*CNSTK(NZ,NY,NX)+FWOOD(1)*CNRT(NZ,NY,NX) + CPRTW=FWOOD(0)*CPSTK(NZ,NY,NX)+FWOOD(1)*CPRT(NZ,NY,NX) + FWODLN(0)=FWODB(0)*CNSTK(NZ,NY,NX)/CNLFW + FWODLP(0)=FWODB(0)*CPSTK(NZ,NY,NX)/CPLFW + FWODSN(0)=FWODB(0)*CNSTK(NZ,NY,NX)/CNSHW + FWODSP(0)=FWODB(0)*CPSTK(NZ,NY,NX)/CPSHW + FWOODN(0)=FWOOD(0)*CNSTK(NZ,NY,NX)/CNRTW + FWOODP(0)=FWOOD(0)*CPSTK(NZ,NY,NX)/CPRTW + FWODLN(1)=1.0-FWODLN(0) + FWODLP(1)=1.0-FWODLP(0) + FWODSN(1)=1.0-FWODSN(0) + FWODSP(1)=1.0-FWODSP(0) + FWOODN(1)=1.0-FWOODN(0) + FWOODP(1)=1.0-FWOODP(0) +C +C SHOOT AND ROOT TEMPERATURE FUNCTIONS FOR MAINTENANCE +C RESPIRATION FROM TEMPERATURES WITH OFFSETS FOR THERMAL ADAPTATION +C +C TKSM=AMAX1(258.15,TKC(NZ,NY,NX))+OFFST(NZ,NY,NX) + TKSM=TKC(NZ,NY,NX)+OFFST(NZ,NY,NX) + RTK=8.3143*TKSM + STK=710.0*TKSM + ACTVM=1+EXP((195000-STK)/RTK)+EXP((STK-232500)/RTK) + TFN5=EXP(25.214-62500/RTK)/ACTVM + DO 7 L=NU(NY,NX),NJ(NY,NX) +C TKSM=AMAX1(258.15,TKS(L,NY,NX))+OFFST(NZ,NY,NX) + TKSM=TKS(L,NY,NX)+OFFST(NZ,NY,NX) + RTK=8.3143*TKSM + STK=710.0*TKSM + ACTVM=1+EXP((195000-STK)/RTK)+EXP((STK-232500)/RTK) + TFN6(L)=EXP(25.214-62500/RTK)/ACTVM +7 CONTINUE + GROGR=0.0 + WTRTA(NZ,NY,NX)=AMAX1(0.999992087*WTRTA(NZ,NY,NX) + 2,WTRT(NZ,NY,NX)/PP(NZ,NY,NX)) + XRTN1=AMAX1(1.0,WTRTA(NZ,NY,NX)**0.667)*PP(NZ,NY,NX) +C +C WATER STRESS FUNCTIONS FOR EXPANSION AND GROWTH RESPIRATION +C FROM CANOPY TURGOR +C + WFNS=AMIN1(1.0,AMAX1(0.0,PSILG(NZ,NY,NX)-PSILM)) + WFNSG=WFNS**0.25 + WFNSS=WFNS**0.50 + IF(IGTYP(NZ,NY,NX).EQ.0)THEN + WFNC=1.0 + WFNG=EXP(0.05*PSILT(NZ,NY,NX)) + ELSE + WFNC=EXP(RCS(NZ,NY,NX)*PSILG(NZ,NY,NX)) + WFNG=EXP(0.10*PSILT(NZ,NY,NX)) + ENDIF +C +C CALCULATE GROWTH OF EACH BRANCH +C + DO 105 NB=1,NBR(NZ,NY,NX) + WTLSB(NB,NZ,NY,NX)=AMAX1(0.0,WTLFB(NB,NZ,NY,NX) + 2+WTSHEB(NB,NZ,NY,NX)) + IF(IDTHB(NB,NZ,NY,NX).EQ.0)THEN +C +C PARTITION GROWTH WITHIN EACH BRANCH FROM GROWTH STAGE +C 1=LEAF,2=SHEATH OR PETIOLE,3=STALK,4=RESERVE, +C 5,6=REPRODUCTIVE ORGANS,7=GRAIN +C + ARSTKB(NB)=0.0 + TOTAL=0.0 + DO 10 N=1,7 + PART(N)=0.0 +10 CONTINUE +C +C IF BEFORE FLORAL INDUCTION +C + IF(IDAY(2,NB,NZ,NY,NX).EQ.0)THEN + PART(1)=0.725 + PART(2)=0.275 +C +C IF BEFORE ANTHESIS +C + ELSEIF(IDAY(6,NB,NZ,NY,NX).EQ.0)THEN + PART(1)=AMAX1(PART1X,0.725-FPART1*TGSTGI(NB,NZ,NY,NX)) + PART(2)=AMAX1(PART2X,0.275-FPART2*TGSTGI(NB,NZ,NY,NX)) + PARTS=1.0-PART(1)-PART(2) + PART(3)=0.60*PARTS + PART(4)=0.30*PARTS + PARTX=PARTS-PART(3)-PART(4) + PART(5)=0.5*PARTX + PART(6)=0.5*PARTX +C +C IF BEFORE GRAIN FILLING, DETERMINATE OR INDETERMINATE +C + ELSEIF(IDAY(7,NB,NZ,NY,NX).EQ.0)THEN + IF(IDTYP(NZ,NY,NX).EQ.0)THEN + PART(1)=0.0 + PART(2)=0.0 + ELSE + PART(1)=AMAX1(PART1X,(0.725-FPART1)*(1.0-TGSTGF(NB,NZ,NY,NX))) + PART(2)=AMAX1(PART2X,(0.275-FPART2)*(1.0-TGSTGF(NB,NZ,NY,NX))) + ENDIF + PARTS=1.0-PART(1)-PART(2) + PART(3)=AMAX1(0.0,0.60*PARTS*(1.0-TGSTGF(NB,NZ,NY,NX))) + PART(4)=AMAX1(0.0,0.30*PARTS*(1.0-TGSTGF(NB,NZ,NY,NX))) + PARTX=PARTS-PART(3)-PART(4) + PART(5)=0.5*PARTX + PART(6)=0.5*PARTX +C +C DURING GRAIN FILLING, DETERMINATE OR INDETERMINATE +C + ELSE + IF(IDTYP(NZ,NY,NX).EQ.0)THEN + PART(7)=1.0 + ELSE + PART(1)=PART1X + PART(2)=PART2X + PARTS=1.0-PART(1)-PART(2) + IF(ISTYP(NZ,NY,NX).EQ.0)THEN + PART(3)=0.125*PARTS + PART(5)=0.125*PARTS + PART(6)=0.125*PARTS + PART(7)=0.625*PARTS + ELSE + PART(3)=0.75*PARTS + PART(7)=0.25*PARTS + ENDIF + ENDIF + ENDIF +C +C IF AFTER GRAIN FILLING +C + IF(IBTYP(NZ,NY,NX).EQ.0.AND.IDAY(10,NB,NZ,NY,NX).NE.0)THEN + IF(ISTYP(NZ,NY,NX).EQ.0)THEN + PART(4)=0.0 + PART(3)=0.0 + PART(7)=0.0 + ELSE + PART(4)=PART(4)+PART(3) + PART(3)=0.0 + PART(7)=0.0 + ENDIF + ENDIF +C +C REDIRECT FROM STALK TO STALK RESERVES IF RESERVES BECOME LOW +C + IF(IDAY(2,NB,NZ,NY,NX).NE.0)THEN + IF(WTRSVB(NB,NZ,NY,NX).LT.XFRX*WVSTKB(NB,NZ,NY,NX))THEN + DO 1020 N=1,7 + IF(N.NE.4)THEN + PART(4)=PART(4)+0.10*PART(N) + PART(N)=PART(N)-0.10*PART(N) + ENDIF +1020 CONTINUE +C +C REDIRECT FROM STALK RESERVES TO STALK IF RESERVES BECOME TOO LARGE +C + ELSEIF(WTRSVB(NB,NZ,NY,NX).GT.1.0*WVSTKB(NB,NZ,NY,NX))THEN + PART(3)=PART(3)+PART(4)+PART(7) + PART(4)=0.0 + PART(7)=0.0 + ENDIF + ENDIF +C +C REDIRECT FROM LEAVES TO STALK IF LAI BECOMES TOO LARGE +C + ARLFI=ARLFP(NZ,NY,NX)/AREA(3,NU(NY,NX),NY,NX) + IF(ARLFI.GT.5.0)THEN + FPARTL=AMAX1(0.0,(10.0-ARLFI)/5.0) + PART(3)=PART(3)+(1.0-FPARTL)*(PART(1)+PART(2)) + PART(1)=FPARTL*PART(1) + PART(2)=FPARTL*PART(2) + ENDIF +C +C DECIDUOUS LEAF FALL AFTER GRAIN FILL IN DETERMINATES, +C AFTER AUTUMNIZATION IN INDETERMINATES, OR AFTER SUSTAINED +C WATER STRESS +C + IF((ISTYP(NZ,NY,NX).NE.0 + 2.AND.VRNF(NB,NZ,NY,NX).GE.FVRN*VRNX(NB,NZ,NY,NX)) + 3.OR.(ISTYP(NZ,NY,NX).EQ.0 + 4.AND.IDAY(8,NB,NZ,NY,NX).NE.0))THEN + IFLGZ=1 + IF(ISTYP(NZ,NY,NX).EQ.0.OR.IWTYP(NZ,NY,NX).EQ.0)THEN + IFLGY=1 + FLGZ(NB,NZ,NY,NX)=FLGZ(NB,NZ,NY,NX)+1.0 + ELSEIF((IWTYP(NZ,NY,NX).EQ.1.OR.IWTYP(NZ,NY,NX).EQ.3) + 2.AND.TCC(NZ,NY,NX).LT.CTC(NZ,NY,NX))THEN + IFLGY=1 + FLGZ(NB,NZ,NY,NX)=FLGZ(NB,NZ,NY,NX)+1.0 + ELSEIF(IWTYP(NZ,NY,NX).GE.2 + 2.AND.PSILT(NZ,NY,NX).LT.PSILY(IGTYP(NZ,NY,NX)))THEN + IFLGY=1 + FLGZ(NB,NZ,NY,NX)=FLGZ(NB,NZ,NY,NX)+1.0 + ENDIF + IF(ISTYP(NZ,NY,NX).NE.0.AND.IWTYP(NZ,NY,NX).NE.0)THEN + PART(3)=PART(3)+0.5*(PART(1)+PART(2)) + PART(4)=PART(4)+0.5*(PART(1)+PART(2)) + PART(1)=0.0 + PART(2)=0.0 + ENDIF + ELSE + IFLGZ=0 + IFLGY=0 + FLGZ(NB,NZ,NY,NX)=0.0 + ENDIF +C +C CHECK PARTITIONING COEFFICIENTS +C + DO 1000 N=1,7 + PART(N)=AMAX1(0.0,PART(N)) + TOTAL=TOTAL+PART(N) +1000 CONTINUE + IF(TOTAL.GT.ZERO)THEN + DO 1010 N=1,7 + PART(N)=PART(N)/TOTAL +1010 CONTINUE + ELSE + DO 1015 N=1,7 + PART(N)=0.0 +1015 CONTINUE + ENDIF +C +C SHOOT COEFFICIENTS FOR GROWTH RESPIRATION AND N,P CONTENTS +C FROM GROWTH YIELDS ENTERED IN 'READQ', AND FROM PARTITIONING +C COEFFICIENTS ABOVE +C + IF(IDAY(1,NB,NZ,NY,NX).NE.0)THEN + DMLFB=DMLF(NZ,NY,NX) + DMSHB=DMSHE(NZ,NY,NX) + CNLFB=CNLFW + CNSHB=CNSHW + CPLFB=CPLFW + CPSHB=CPSHW + ELSE + DMLFB=DMRT(NZ,NY,NX) + DMSHB=DMRT(NZ,NY,NX) + CNLFB=CNRTW + CNSHB=CNRTW + CPLFB=CPRTW + CPSHB=CPRTW + ENDIF + DMSHT=PART(1)*DMLFB+PART(2)*DMSHB+PART(3)*DMSTK(NZ,NY,NX) + 2+PART(4)*DMRSV(NZ,NY,NX)+PART(5)*DMHSK(NZ,NY,NX) + 3+PART(6)*DMEAR(NZ,NY,NX)+PART(7)*DMGR(NZ,NY,NX) + DMSHD=1.0-DMSHT + CNLFM=PART(1)*DMLFB*ZPLFM*CNLFB + CPLFM=PART(1)*DMLFB*ZPLFM*CPLFB + CNLFX=PART(1)*DMLFB*ZPLFD*CNLFB + CPLFX=PART(1)*DMLFB*ZPLFD*CPLFB + CNSHX=PART(2)*DMSHB*CNSHB + 2+PART(3)*DMSTK(NZ,NY,NX)*CNSTK(NZ,NY,NX) + 3+PART(4)*DMRSV(NZ,NY,NX)*CNRSV(NZ,NY,NX) + 4+PART(5)*DMHSK(NZ,NY,NX)*CNHSK(NZ,NY,NX) + 5+PART(6)*DMEAR(NZ,NY,NX)*CNEAR(NZ,NY,NX) + 6+PART(7)*DMGR(NZ,NY,NX)*CNRSV(NZ,NY,NX) + CPSHX=PART(2)*DMSHB*CPSHB + 2+PART(3)*DMSTK(NZ,NY,NX)*CPSTK(NZ,NY,NX) + 3+PART(4)*DMRSV(NZ,NY,NX)*CPRSV(NZ,NY,NX) + 4+PART(5)*DMHSK(NZ,NY,NX)*CPHSK(NZ,NY,NX) + 5+PART(6)*DMEAR(NZ,NY,NX)*CPEAR(NZ,NY,NX) + 6+PART(7)*DMGR(NZ,NY,NX)*CPRSV(NZ,NY,NX) +C +C TOTAL SHOOT STRUCTURAL N CONTENT FOR MAINTENANCE RESPIRATION +C + WTSHXN=AMAX1(0.0,WTLFBN(NB,NZ,NY,NX)+WTSHBN(NB,NZ,NY,NX) + 2+CNSTK(NZ,NY,NX)*WVSTKB(NB,NZ,NY,NX)) + IF(IDAY(10,NB,NZ,NY,NX).EQ.0)THEN + WTSHXN=WTSHXN+AMAX1(0.0,WTHSBN(NB,NZ,NY,NX) + 2+WTEABN(NB,NZ,NY,NX)+WTGRBN(NB,NZ,NY,NX)) + ENDIF +C +C GROSS PRIMARY PRODUCTIVITY +C + IF(IDAY(1,NB,NZ,NY,NX).NE.0)THEN + IF(FDBK(NB,NZ,NY,NX).NE.0)THEN + IF(SSIN(NY,NX).GT.0.0.AND.RADP(NZ,NY,NX).GT.0.0 + 2.AND.CO2Q(NZ,NY,NX).GT.0.0)THEN + CO2F=0.0 + CH2O=0.0 + IF(IGTYP(NZ,NY,NX).NE.0.OR.WFNC.GT.0.0)THEN +C IF(NZ.EQ.1.OR.NZ.EQ.4)THEN +C WRITE(*,5651)'CHECK1',I,J,NZ,NB,IDAY(1,NB,NZ,NY,NX) +C 2,FDBK(NB,NZ,NY,NX),RADP(NZ,NY,NX),CO2Q(NZ,NY,NX),WFNC +5651 FORMAT(A8,5I4,12E12.4) +C ENDIF +C +C FOR EACH NODE +C + DO 100 K=1,25 + CH2O3(K)=0.0 + CH2O4(K)=0.0 + IF(ARLF(K,NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN +C +C C4 PHOTOSYNTHESIS +C + IF(ICTYP(NZ,NY,NX).EQ.4.AND.VCGR4(K,NB,NZ,NY,NX).GT.0.0)THEN +C +C FOR EACH CANOPY LAYER +C + DO 110 L=JC,1,-1 + IF(ARLFL(L,K,NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN +C +C FOR EACH LEAF AZIMUTH AND INCLINATION +C + DO 115 N = 1,4 + DO 120 M = 1,4 +C +C CO2 FIXATION BY SUNLIT LEAVES +C + IF(SURFX(N,L,K,NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + IF(PAR(N,M,L,NZ,NY,NX).GT.0.0)THEN +C +C C4 CARBOXYLATION REACTIONS USING VARIABLES FROM 'STOMATE' +C + PARX=QNTM*PAR(N,M,L,NZ,NY,NX) + PARJ=PARX+ETGR4(K,NB,NZ,NY,NX) + ETLF=(PARJ-SQRT(PARJ**2-CURV4*PARX*ETGR4(K,NB,NZ,NY,NX)))/CURV2 + EGRO=ETLF*CBXN4(K,NB,NZ,NY,NX) + VL=AMIN1(VGRO4(K,NB,NZ,NY,NX),EGRO)*FDBK4(K,NB,NZ,NY,NX) +C +C STOMATAL EFFECT OF WATER DEFICIT +C + IF(VL.GT.ZERO)THEN + RS=AMIN1(RCMX(NZ,NY,NX),AMAX1(RCMN,DCO2(NZ,NY,NX)/VL)) + RSL=RS+(RCMX(NZ,NY,NX)-RS)*WFNC + GSL=1.0/RSL*FMOL(NZ,NY,NX) +C +C NON-STOMATAL EFFECT OF WATER DEFICIT +C + IF(IGTYP(NZ,NY,NX).NE.0)THEN + WFN4=(RS/RSL)**1.00 + WFNB=SQRT(RS/RSL) + ELSE + WFN4=WFNG + WFNB=WFNG + ENDIF +C +C CONVERGENCE SOLUTION FOR CO2I AT WHICH CARBOXYLATION +C EQUALS DIFFUSION +C + CO2X=CO2I(NZ,NY,NX) + DO 125 NN=1,100 + CO2C=CO2X*SCO2(NZ,NY,NX) + CO2Y=AMAX1(0.0,CO2C-COMP4) + CBXNX=CO2Y/(ELEC4*CO2C+10.5*COMP4) + VGROX=VCGR4(K,NB,NZ,NY,NX)*CO2Y/(CO2C+XKCO24(NZ,NY,NX)) + EGROX=ETLF*CBXNX + VL=AMIN1(VGROX,EGROX)*WFN4*FDBK4(K,NB,NZ,NY,NX) + VG=(CO2Q(NZ,NY,NX)-CO2X)*GSL + IF(VL+VG.GT.ZERO)THEN + DIFF=(VL-VG)/(VL+VG) + IF(ABS(DIFF).LT.0.005)GO TO 130 + VA=0.95*VG+0.05*VL + CO2X=CO2Q(NZ,NY,NX)-VA/GSL + ELSE + VL=0.0 + GO TO 130 + ENDIF +125 CONTINUE + +C +C ACCUMULATE C4 FIXATION PRODUCT +C +130 CH2O4(K)=CH2O4(K)+VL*SURFX(N,L,K,NB,NZ,NY,NX) + 2*TAUS(L+1,NY,NX) +C ICO2I=MAX(1,MIN(400,INT(CO2X))) +C VCO2(ICO2I,I,NZ)=VCO2(ICO2I,I,NZ) +C 2+(VL*SURFX(N,L,K,NB,NZ,NY,NX)*TAUS(L+1,NY,NX))*0.0432 +C IF(NB.EQ.1.AND.M.EQ.1.AND.N.EQ.3.AND.K.EQ.KLEAF(NB,NZ,NY,NX) +C 2.AND.(I/10)*10.EQ.I.AND.J.EQ.12)THEN +C WRITE(20,4444)'VLD4',IYRC,I,J,NZ,L,M,N,K,VL,PAR(N,M,L,NZ,NY,NX) +C 2,PAR(N,M,L,NZ,NY,NX)*TAUS(L+1,NY,NX)+PARDIF(N,M,L,NZ,NY,NX) +C 3*TAU0(L+1,NY,NX) +C 2,RAPS,TKC(NZ,NY,NX),CO2Q(NZ,NY,NX),ETGR4(K,NB,NZ,NY,NX) +C 3,CBXN4(K,NB,NZ,NY,NX),VGRO4(K,NB,NZ,NY,NX),EGRO +C 3,FDBK4(K,NB,NZ,NY,NX),CH2O4(K),WFN4,VGROX,EGROX +C 4,VCGR4(K,NB,NZ,NY,NX),CO2X,CO2C,CBXNX +C 5,RS,RSL +4444 FORMAT(A8,8I4,40E12.4) +C ENDIF +C +C C3 CARBOXYLATION REACTIONS IN C4 PLANTS USING VARIABLES FROM 'STOMATE' +C + PARJ=PARX+ETGRO(K,NB,NZ,NY,NX) + ETLF=(PARJ-SQRT(PARJ**2-CURV4*PARX*ETGRO(K,NB,NZ,NY,NX)))/CURV2 + EGRO=ETLF*CBXN(K,NB,NZ,NY,NX) + VL=AMIN1(VGRO(K,NB,NZ,NY,NX),EGRO)*WFNB*FDBK(NB,NZ,NY,NX) +C +C ACCUMULATE C3 FIXATION PRODUCT +C + CH2O3(K)=CH2O3(K)+VL*SURFX(N,L,K,NB,NZ,NY,NX) + 2*TAUS(L+1,NY,NX) +C IF(L.EQ.NC-1.AND.NB.EQ.1.AND.M.EQ.1.AND.N.EQ.1)THEN +C WRITE(*,4445)'VLD3',IYRC,I,J,NZ,L,M,N,K,VL,PAR(N,M,L,NZ,NY,NX) +C 2,RAPS,TKC(NZ,NY,NX),CO2Q(NZ,NY,NX),ETGRO(K,NB,NZ,NY,NX) +C 3,CBXN(K,NB,NZ,NY,NX),VGRO(K,NB,NZ,NY,NX),EGRO +C 3,FDBK(NB,NZ,NY,NX),WFNB +4445 FORMAT(A8,8I4,20E12.4) +C ENDIF + ENDIF + ENDIF +C +C CO2 FIXATION BY SHADED LEAVES +C + IF(PARDIF(N,M,L,NZ,NY,NX).GT.0.0)THEN +C +C C4 CARBOXYLATION REACTIONS +C + PARX=QNTM*PARDIF(N,M,L,NZ,NY,NX) + PARJ=PARX+ETGR4(K,NB,NZ,NY,NX) + ETLF=(PARJ-SQRT(PARJ**2-CURV4*PARX*ETGR4(K,NB,NZ,NY,NX)))/CURV2 + EGRO=ETLF*CBXN4(K,NB,NZ,NY,NX) + VL=AMIN1(VGRO4(K,NB,NZ,NY,NX),EGRO)*FDBK4(K,NB,NZ,NY,NX) +C +C STOMATAL EFFECT OF WATER DEFICIT +C + IF(VL.GT.ZERO)THEN + RS=AMIN1(RCMX(NZ,NY,NX),AMAX1(RCMN,DCO2(NZ,NY,NX)/VL)) + RSL=RS+(RCMX(NZ,NY,NX)-RS)*WFNC + GSL=1.0/RSL*FMOL(NZ,NY,NX) +C +C NON-STOMATAL EFFECT OF WATER DEFICIT +C + IF(IGTYP(NZ,NY,NX).NE.0)THEN + WFN4=(RS/RSL)**1.00 + WFNB=SQRT(RS/RSL) + ELSE + WFN4=WFNG + WFNB=WFNG + ENDIF +C +C CONVERGENCE SOLUTION FOR CO2I AT WHICH CARBOXYLATION +C EQUALS DIFFUSION +C + CO2X=CO2I(NZ,NY,NX) + DO 135 NN=1,100 + CO2C=CO2X*SCO2(NZ,NY,NX) + CO2Y=AMAX1(0.0,CO2C-COMP4) + CBXNX=CO2Y/(ELEC4*CO2C+10.5*COMP4) + VGROX=VCGR4(K,NB,NZ,NY,NX)*CO2Y/(CO2C+XKCO24(NZ,NY,NX)) + EGROX=ETLF*CBXNX + VL=AMIN1(VGROX,EGROX)*WFN4*FDBK4(K,NB,NZ,NY,NX) + VG=(CO2Q(NZ,NY,NX)-CO2X)*GSL + IF(VL+VG.GT.ZERO)THEN + DIFF=(VL-VG)/(VL+VG) + IF(ABS(DIFF).LT.0.005)GO TO 140 + VA=0.95*VG+0.05*VL + CO2X=CO2Q(NZ,NY,NX)-VA/GSL + ELSE + VL=0.0 + GO TO 140 + ENDIF +135 CONTINUE +C +C ACCUMULATE C4 FIXATION PRODUCT +C +140 CH2O4(K)=CH2O4(K)+VL*SURFX(N,L,K,NB,NZ,NY,NX) + 2*TAU0(L+1,NY,NX) +C ICO2I=MAX(1,MIN(400,INT(CO2X))) +C VCO2(ICO2I,I,NZ)=VCO2(ICO2I,I,NZ) +C 2+(VL*SURFX(N,L,K,NB,NZ,NY,NX)*TAU0(L+1,NY,NX))*0.0432 +C WRITE(*,4455)'VLB4',IYRC,I,J,NZ,L,M,N,K,VL,PAR(N,M,L,NZ,NY,NX) +C 2,RAPS,TKC(NZ,NY,NX),CO2Q(NZ,NY,NX),ETGR4(K,NB,NZ,NY,NX) +C 3,CBXN4(K,NB,NZ,NY,NX),VGRO4(K,NB,NZ,NY,NX),EGRO +C 3,FDBK4(K,NB,NZ,NY,NX),CH2O4(K),WFN4,VGROX,EGROX +C 4,VCGR4(K,NB,NZ,NY,NX),CO2X,CO2C,CBXNX +C 5,RS,RSL +4455 FORMAT(A8,8I4,40E12.4) +C +C C3 CARBOXYLATION REACTIONS IN C4 PLANTS USING VARIABLES FROM 'STOMATE' +C + PARJ=PARX+ETGRO(K,NB,NZ,NY,NX) + ETLF=(PARJ-SQRT(PARJ**2-CURV4*PARX*ETGRO(K,NB,NZ,NY,NX)))/CURV2 + EGRO=ETLF*CBXN(K,NB,NZ,NY,NX) + VL=AMIN1(VGRO(K,NB,NZ,NY,NX),EGRO)*WFNB*FDBK(NB,NZ,NY,NX) +C +C ACCUMULATE C3 FIXATION PRODUCT +C + CH2O3(K)=CH2O3(K)+VL*SURFX(N,L,K,NB,NZ,NY,NX) + 2*TAU0(L+1,NY,NX) +C IF(J.EQ.13.AND.NB.EQ.1.AND.M.EQ.1.AND.N.EQ.1)THEN +C WRITE(*,4444)'VLB4',IYRC,I,J,NZ,L,K,VL,PARDIF(N,M,L,NZ,NY,NX) +C 2,RAPY,TKC(NZ,NY,NX),CO2Q(NZ,NY,NX),CO2X,FMOL(NZ,NY,NX)/GSL +C 3,VCGRO(K,NB,NZ,NY,NX),ETLF,FDBK(NB,NZ,NY,NX),WFNB +C ENDIF + ENDIF + ENDIF + ENDIF +120 CONTINUE +115 CONTINUE + ENDIF +110 CONTINUE + CO2F=CO2F+CH2O4(K) + CH2O=CH2O+CH2O3(K) +C +C C3 PHOTOSYNTHESIS +C + ELSEIF(ICTYP(NZ,NY,NX).NE.4.AND.VCGRO(K,NB,NZ,NY,NX).GT.0.0)THEN +C +C FOR EACH CANOPY LAYER +C + DO 210 L=JC,1,-1 + IF(ARLFL(L,K,NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN +C +C FOR EACH LEAF AZIMUTH AND INCLINATION +C + DO 215 N=1,4 + DO 220 M=1,4 +C +C CO2 FIXATION BY SUNLIT LEAVES +C + IF(SURFX(N,L,K,NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + + IF(PAR(N,M,L,NZ,NY,NX).GT.0.0)THEN +C +C C3 CARBOXYLATION REACTIONS USING VARIABLES FROM 'STOMATE' +C + PARX=QNTM*PAR(N,M,L,NZ,NY,NX) + PARJ=PARX+ETGRO(K,NB,NZ,NY,NX) + ETLF=(PARJ-SQRT(PARJ**2-CURV4*PARX*ETGRO(K,NB,NZ,NY,NX)))/CURV2 + EGRO=ETLF*CBXN(K,NB,NZ,NY,NX) + VL=AMIN1(VGRO(K,NB,NZ,NY,NX),EGRO)*FDBK(NB,NZ,NY,NX) +C +C STOMATAL EFFECT OF WATER DEFICIT +C + IF(VL.GT.ZERO)THEN + RS=AMIN1(RCMX(NZ,NY,NX),AMAX1(RCMN,DCO2(NZ,NY,NX)/VL)) + RSL=RS+(RCMX(NZ,NY,NX)-RS)*WFNC + GSL=1.0/RSL*FMOL(NZ,NY,NX) +C +C NON-STOMATAL EFFECT OF WATER DEFICIT +C + IF(IGTYP(NZ,NY,NX).NE.0)THEN + WFNB=SQRT(RS/RSL) + ELSE + WFNB=WFNG + ENDIF +C +C CONVERGENCE SOLUTION FOR CO2I AT WHICH CARBOXYLATION +C EQUALS DIFFUSION +C + CO2X=CO2I(NZ,NY,NX) + DO 225 NN=1,100 + CO2C=CO2X*SCO2(NZ,NY,NX) + CO2Y=AMAX1(0.0,CO2C-COMPL(K,NB,NZ,NY,NX)) + CBXNX=CO2Y/(ELEC3*CO2C+10.5*COMPL(K,NB,NZ,NY,NX)) + VGROX=VCGRO(K,NB,NZ,NY,NX)*CO2Y/(CO2C+XKCO2O(NZ,NY,NX)) + EGROX=ETLF*CBXNX + VL=AMIN1(VGROX,EGROX)*WFNB*FDBK(NB,NZ,NY,NX) + VG=(CO2Q(NZ,NY,NX)-CO2X)*GSL + IF(VL+VG.GT.ZERO)THEN + DIFF=(VL-VG)/(VL+VG) + IF(ABS(DIFF).LT.0.005)GO TO 230 + VA=0.95*VG+0.05*VL + CO2X=CO2Q(NZ,NY,NX)-VA/GSL + ELSE + VL=0.0 + GO TO 230 + ENDIF +225 CONTINUE +C +C ACCUMULATE C3 FIXATION PRODUCT +C +230 CH2O3(K)=CH2O3(K)+VL*SURFX(N,L,K,NB,NZ,NY,NX) + 2*TAUS(L+1,NY,NX) +C ICO2I=MAX(1,MIN(400,INT(CO2X))) +C VCO2(ICO2I,I,NZ)=VCO2(ICO2I,I,NZ) +C 2+(VL*SURFX(N,L,K,NB,NZ,NY,NX)*TAUS(L+1,NY,NX))*0.0432 +C IF(NB.EQ.1.AND.M.EQ.1.AND.N.EQ.1.AND.K.EQ.KLEAF(NB,NZ,NY,NX)-1 +C 2.AND.J.EQ.12)THEN +C WRITE(20,3335)'VLD',IYRC,I,J,NZ,L,M,N,K,VL,PAR(N,M,L,NZ,NY,NX) +C 2,RAPS,TKC(NZ,NY,NX),TKA,CO2Q(NZ,NY,NX),CO2X,CO2C,FMOL(NZ,NY,NX) +C 3/GSL,VGROX,EGROX,ETLF,CBXNX,FDBK(NB,NZ,NY,NX),WFNB,PSILG(NZ,NY,NX) +C 4,VCGRO(K,NB,NZ,NY,NX),ETGRO(K,NB,NZ,NY,NX),COMPL(K,NB,NZ,NY,NX) +C 5,SURFX(N,L,K,NB,NZ,NY,NX),TAUS(L+1,NY,NX),CH2O3(K) +3335 FORMAT(A8,8I4,30E12.4) +C ENDIF + ENDIF + ENDIF +C +C CO2 FIXATION BY SHADED LEAVES +C + IF(PARDIF(N,M,L,NZ,NY,NX).GT.0.0)THEN +C +C C3 CARBOXYLATION REACTIONS USING VARIABLES FROM 'STOMATE' +C + PARX=QNTM*PARDIF(N,M,L,NZ,NY,NX) + PARJ=PARX+ETGRO(K,NB,NZ,NY,NX) + ETLF=(PARJ-SQRT(PARJ**2-CURV4*PARX*ETGRO(K,NB,NZ,NY,NX)))/CURV2 + EGRO=ETLF*CBXN(K,NB,NZ,NY,NX) + VL=AMIN1(VGRO(K,NB,NZ,NY,NX),EGRO)*FDBK(NB,NZ,NY,NX) +C +C STOMATAL EFFECT OF WATER DEFICIT +C + IF(VL.GT.ZERO)THEN + RS=AMIN1(RCMX(NZ,NY,NX),AMAX1(RCMN,DCO2(NZ,NY,NX)/VL)) + RSL=RS+(RCMX(NZ,NY,NX)-RS)*WFNC + GSL=1.0/RSL*FMOL(NZ,NY,NX) +C +C NON-STOMATAL EFFECT OF WATER DEFICIT +C + IF(IGTYP(NZ,NY,NX).NE.0)THEN + WFNB=SQRT(RS/RSL) + ELSE + WFNB=WFNG + ENDIF +C +C CONVERGENCE SOLUTION FOR CO2I AT WHICH CARBOXYLATION +C EQUALS DIFFUSION +C + CO2X=CO2I(NZ,NY,NX) + DO 235 NN=1,100 + CO2C=CO2X*SCO2(NZ,NY,NX) + CO2Y=AMAX1(0.0,CO2C-COMPL(K,NB,NZ,NY,NX)) + CBXNX=CO2Y/(ELEC3*CO2C+10.5*COMPL(K,NB,NZ,NY,NX)) + VGROX=VCGRO(K,NB,NZ,NY,NX)*CO2Y/(CO2C+XKCO2O(NZ,NY,NX)) + EGROX=ETLF*CBXNX + VL=AMIN1(VGROX,EGROX)*WFNB*FDBK(NB,NZ,NY,NX) + VG=(CO2Q(NZ,NY,NX)-CO2X)*GSL + IF(VL+VG.GT.ZERO)THEN + DIFF=(VL-VG)/(VL+VG) + IF(ABS(DIFF).LT.0.005)GO TO 240 + VA=0.95*VG+0.05*VL + CO2X=CO2Q(NZ,NY,NX)-VA/GSL + ELSE + VL=0.0 + GO TO 240 + ENDIF +235 CONTINUE +C +C ACCUMULATE C3 FIXATION PRODUCT +C +240 CH2O3(K)=CH2O3(K)+VL*SURFX(N,L,K,NB,NZ,NY,NX) + 2*TAU0(L+1,NY,NX) +C ICO2I=MAX(1,MIN(400,INT(CO2X))) +C VCO2(ICO2I,I,NZ)=VCO2(ICO2I,I,NZ) +C 2+(VL*SURFX(N,L,K,NB,NZ,NY,NX)*TAU0(L+1,NY,NX))*0.0432 +C IF(J.EQ.13.AND.NB.EQ.1.AND.M.EQ.1.AND.N.EQ.1)THEN +C WRITE(*,3335)'VLB',IYRC,I,J,NZ,L,K,VL,PARDIF(N,M,L,NZ,NY,NX) +C 2,RAPY,TKC(NZ,NY,NX),CO2Q(NZ,NY,NX),CO2X,FMOL(NZ,NY,NX)/GSL +C 3,VCGRO(K,NB,NZ,NY,NX),ETLF,FDBK(NB,NZ,NY,NX),WFNB +C ENDIF + ENDIF + ENDIF + ENDIF +220 CONTINUE +215 CONTINUE + ENDIF +210 CONTINUE + CO2F=CO2F+CH2O3(K) + CH2O=CH2O+CH2O3(K) + ENDIF + ENDIF +100 CONTINUE + CO2F=CO2F*0.0432 + CH2O=CH2O*0.0432 +C +C CONVERT UMOL M-2 S-1 TO G C M-2 H-1 +C + DO 150 K=1,25 + CH2O3(K)=CH2O3(K)*0.0432 + CH2O4(K)=CH2O4(K)*0.0432 +150 CONTINUE + ELSE + CO2F=0.0 + CH2O=0.0 + IF(ICTYP(NZ,NY,NX).EQ.4)THEN + DO 155 K=1,25 + CH2O3(K)=0.0 + CH2O4(K)=0.0 +155 CONTINUE + ENDIF + ENDIF + ELSE + CO2F=0.0 + CH2O=0.0 + IF(ICTYP(NZ,NY,NX).EQ.4)THEN + DO 160 K=1,25 + CH2O3(K)=0.0 + CH2O4(K)=0.0 +160 CONTINUE + ENDIF + ENDIF + ELSE + CO2F=0.0 + CH2O=0.0 + IF(ICTYP(NZ,NY,NX).EQ.4)THEN + DO 165 K=1,25 + CH2O3(K)=0.0 + CH2O4(K)=0.0 +165 CONTINUE + ENDIF + ENDIF +C +C SHOOT AUTOTROPHIC RESPIRATION AFTER EMERGENCE +C +C +C N,P CONSTRAINT ON RESPIRATION FROM NON-STRUCTURAL C:N:P +C + IF(CCPOLB(NB,NZ,NY,NX).GT.ZERO)THEN + CNPG=AMIN1(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) + 2+CCPOLB(NB,NZ,NY,NX)*CPKI)) + ELSE + CNPG=1.0 + ENDIF +C +C RESPIRATION FROM NON-STRUCTURAL C DETERMINED BY TEMPERATURE, +C NON-STRUCTURAL C:N:P +C + RCO2C=AMAX1(0.0,VMXC*CPOOL(NB,NZ,NY,NX) + 2*TFN3(NZ,NY,NX))*CNPG*FDBKX(NB,NZ,NY,NX)*WFNG +C +C MAINTENANCE RESPIRATION FROM TEMPERATURE, PLANT STRUCTURAL N +C + RMNCS=AMAX1(0.0,RMPLT*TFN5*WTSHXN) + IF(IWTYP(NZ,NY,NX).EQ.2)THEN + RMNCS=RMNCS*WFNG + ENDIF +C +C GROWTH RESPIRATION FROM TOTAL - MAINTENANCE +C IF > 0 DRIVES GROWTH, IF < 0 DRIVES REMOBILIZATION +C + RCO2X=RCO2C-RMNCS + RCO2Y=AMAX1(0.0,RCO2X)*WFNSG + SNCR=AMAX1(0.0,-RCO2X) +C +C GROWTH RESPIRATION MAY BE LIMITED BY NON-STRUCTURAL N,P +C AVAILABLE FOR GROWTH +C + IF(RCO2Y.GT.0.0.AND.(CNSHX.GT.0.0.OR.CNLFX.GT.0.0))THEN + ZPOOLB=AMAX1(0.0,ZPOOL(NB,NZ,NY,NX)) + PPOOLB=AMAX1(0.0,PPOOL(NB,NZ,NY,NX)) + RCO2G=AMIN1(RCO2Y,ZPOOLB*DMSHD/(CNSHX+CNLFM+CNLFX*CNPG) + 2,PPOOLB*DMSHD/(CPSHX+CPLFM+CPLFX*CNPG)) + ELSE + RCO2G=0.0 + ENDIF +C +C TOTAL NON-STRUCTURAL C,N,P USED IN GROWTH +C AND GROWTH RESPIRATION DEPENDS ON GROWTH YIELDS +C ENTERED IN 'READQ' +C + CGROS=RCO2G/DMSHD + ZADDB=AMAX1(0.0,AMIN1(ZPOOL(NB,NZ,NY,NX) + 2,CGROS*(CNSHX+CNLFM+CNLFX*CNPG))) + PADDB=AMAX1(0.0,AMIN1(PPOOL(NB,NZ,NY,NX) + 2,CGROS*(CPSHX+CPLFM+CPLFX*CNPG))) + CNRDA=AMAX1(0.0,1.70*ZADDB-0.025*CH2O) +C +C TOTAL ABOVE-GROUND AUTOTROPHIC RESPIRATION BY BRANCH +C ACCUMULATE GPP, SHOOT AUTOTROPHIC RESPIRATION, NET C EXCHANGE +C + RCO2T=AMIN1(RMNCS,RCO2C)+RCO2G+SNCR+CNRDA + CARBN(NZ,NY,NX)=CARBN(NZ,NY,NX)+CO2F + TCO2T(NZ,NY,NX)=TCO2T(NZ,NY,NX)-RCO2T + TCO2A(NZ,NY,NX)=TCO2A(NZ,NY,NX)-RCO2T + CNET(NZ,NY,NX)=CNET(NZ,NY,NX)+CO2F-RCO2T + GPP(NY,NX)=GPP(NY,NX)+CO2F + TGPP(NY,NX)=TGPP(NY,NX)+CO2F + RECO(NY,NX)=RECO(NY,NX)-RCO2T + TRAU(NY,NX)=TRAU(NY,NX)-RCO2T +C IF(NZ.EQ.1)THEN +C WRITE(*,4477)'RCO2',I,J,NX,NY,NZ,NB,IFLGZ,CPOOL(NB,NZ,NY,NX) +C 2,CH2O,RMNCS,RCO2C,CGROS,CNRDA,CNPG,RCO2T,RCO2X,SNCR +C 3,RCO2G,DMSHD,ZADDB,PART(1),PART(2),DMLFB,DMSHB +C 4,WTRSVB(NB,NZ,NY,NX),WVSTKB(NB,NZ,NY,NX),WTSHXN +C 5,ZPOOL(NB,NZ,NY,NX),PPOOL(NB,NZ,NY,NX),PSILT(NZ,NY,NX) +C 6,ZADDB,RNH3B(NB,NZ,NY,NX),WFR(1,NG(NZ,NY,NX),NZ,NY,NX) +C 7,WFNG,TFN3(NZ,NY,NX),TFN5,FDBKX(NB,NZ,NY,NX),VMXC +4477 FORMAT(A8,7I4,40E12.4) +C ENDIF +C +C SHOOT AUTOTROPHIC RESPIRATION BEFORE EMERGENCE +C + ELSE +C +C N,P CONSTRAINT ON RESPIRATION FROM NON-STRUCTURAL C:N:P +C + IF(CCPOLB(NB,NZ,NY,NX).GT.ZERO)THEN + CNPG=AMIN1(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)) + ELSE + CNPG=1.0 + ENDIF +C +C RESPIRATION FROM NON-STRUCTURAL C DETERMINED BY TEMPERATURE, +C NON-STRUCTURAL C:N:P, O2 UPTAKE +C + RCO2CM=AMAX1(0.0,VMXC*CPOOL(NB,NZ,NY,NX) + 2*TFN4(NG(NZ,NY,NX),NZ,NY,NX))*CNPG*WFNG*FDBKX(NB,NZ,NY,NX) + RCO2C=RCO2CM*WFR(1,NG(NZ,NY,NX),NZ,NY,NX) +C +C MAINTENANCE RESPIRATION FROM TEMPERATURE, PLANT STRUCTURAL N +C + RMNCS=AMAX1(0.0,RMPLT*TFN6(NG(NZ,NY,NX))*WTSHXN) + IF(IWTYP(NZ,NY,NX).EQ.2)THEN + RMNCS=RMNCS*WFNG + ENDIF +C +C GROWTH RESPIRATION FROM TOTAL - MAINTENANCE +C IF > 0 DRIVES GROWTH, IF < 0 DRIVES REMOBILIZATION +C + RCO2XM=RCO2CM-RMNCS + RCO2X=RCO2C-RMNCS + RCO2YM=AMAX1(0.0,RCO2XM)*WFNSG + RCO2Y=AMAX1(0.0,RCO2X)*WFNSG + SNCRM=AMAX1(0.0,-RCO2XM) + SNCR=AMAX1(0.0,-RCO2X) +C +C GROWTH RESPIRATION MAY BE LIMITED BY NON-STRUCTURAL N,P +C AVAILABLE FOR GROWTH +C + IF(CNSHX.GT.0.0.OR.CNLFX.GT.0.0)THEN + ZPOOLB=AMAX1(0.0,ZPOOL(NB,NZ,NY,NX)) + PPOOLB=AMAX1(0.0,PPOOL(NB,NZ,NY,NX)) + FNP=AMIN1(ZPOOLB*DMSHD/(CNSHX+CNLFM+CNLFX*CNPG) + 2,PPOOLB*DMSHD/(CPSHX+CPLFM+CPLFX*CNPG)) + IF(RCO2YM.GT.0.0)THEN + RCO2GM=AMIN1(RCO2YM,FNP) + ELSE + RCO2GM=0.0 + ENDIF + IF(RCO2Y.GT.0.0)THEN + RCO2G=AMIN1(RCO2Y,FNP*WFR(1,NG(NZ,NY,NX),NZ,NY,NX)) + ELSE + RCO2G=0.0 + ENDIF + ELSE + RCO2GM=0.0 + RCO2G=0.0 + ENDIF +C +C TOTAL NON-STRUCTURAL C,N,P USED IN GROWTH +C AND GROWTH RESPIRATION DEPENDS ON GROWTH YIELDS +C ENTERED IN 'READQ' +C + CGROSM=RCO2GM/DMSHD + CGROS=RCO2G/DMSHD + ZADDBM=AMAX1(0.0,CGROSM*(CNSHX+CNLFM+CNLFX*CNPG)) + ZADDB=AMAX1(0.0,CGROS*(CNSHX+CNLFM+CNLFX*CNPG)) + PADDB=AMAX1(0.0,CGROS*(CPSHX+CPLFM+CPLFX*CNPG)) + CNRDM=AMAX1(0.0,1.70*ZADDBM) + CNRDA=AMAX1(0.0,1.70*ZADDB) +C +C TOTAL ABOVE-GROUND AUTOTROPHIC RESPIRATION BY BRANCH +C ACCUMULATE GPP, SHOOT AUTOTROPHIC RESPIRATION, NET C EXCHANGE +C + RCO2TM=RMNCS+RCO2GM+SNCRM+CNRDM + RCO2T=RMNCS+RCO2G+SNCR+CNRDA + RCO2M(1,NG(NZ,NY,NX),NZ,NY,NX)=RCO2M(1,NG(NZ,NY,NX),NZ,NY,NX) + 2+RCO2TM + RCO2N(1,NG(NZ,NY,NX),NZ,NY,NX)=RCO2N(1,NG(NZ,NY,NX),NZ,NY,NX) + 2+RCO2T + RCO2A(1,NG(NZ,NY,NX),NZ,NY,NX)=RCO2A(1,NG(NZ,NY,NX),NZ,NY,NX) + 2-RCO2T + CH2O=0.0 + ENDIF +C +C REMOVE C,N,P USED IN MAINTENANCE + GROWTH REPIRATION AND GROWTH +C FROM NON-STRUCTURAL POOLS +C + CPOOL(NB,NZ,NY,NX)=CPOOL(NB,NZ,NY,NX)+CH2O-AMIN1(RMNCS,RCO2C) + 2-CGROS-CNRDA + ZPOOL(NB,NZ,NY,NX)=ZPOOL(NB,NZ,NY,NX)-ZADDB+RNH3B(NB,NZ,NY,NX) + PPOOL(NB,NZ,NY,NX)=PPOOL(NB,NZ,NY,NX)-PADDB +C +C TRANSFER OF C4 FIXATION PRODUCTS FROM NON-STRUCTURAL POOLS +C IN MESOPHYLL TO THOSE IN BUNDLE SHEATH, DECARBOXYLATION +C OF C4 FIXATION PRODUCTS IN BUNDLE SHEATH, LEAKAGE OF DECARBOXYLATION +C PRODUCTS BACK TO MESOPHYLL IN C4 PLANTS +C + IF(ICTYP(NZ,NY,NX).EQ.4)THEN + DO 170 K=1,25 + IF(WGLF(K,NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + CCBS1=AMAX1(0.0,0.083E+09*CO2B(K,NB,NZ,NY,NX) + 2/(WGLF(K,NB,NZ,NY,NX)*FBS)) +C +C BUNDLE SHEATH LEAKAGE +C + CO2LK=AMIN1(AMAX1(0.0,CPOOL3(K,NB,NZ,NY,NX)-CH2O3(K)) + 2,5.0E-07*(CCBS1-CO2L(NZ,NY,NX))*WGLF(K,NB,NZ,NY,NX)*FBS) + IF(CPOOL3(K,NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + FPL3X=CPOOL3(K,NB,NZ,NY,NX)/(CPOOL3(K,NB,NZ,NY,NX) + 2+AMAX1(0.0,CO2B(K,NB,NZ,NY,NX))) + ELSE + FPL3X=0.0 + ENDIF + CPL3X=FPL3X*(CH2O3(K)+CO2LK) + CPL3Z=CPL3X-CH2O3(K)-CO2LK + CO2B(K,NB,NZ,NY,NX)=CO2B(K,NB,NZ,NY,NX)+FCO2B*CPL3Z + HCOB(K,NB,NZ,NY,NX)=HCOB(K,NB,NZ,NY,NX)+FHCOB*CPL3Z + CPOOL3(K,NB,NZ,NY,NX)=CPOOL3(K,NB,NZ,NY,NX)-CPL3X +C +C BUNDLE SHEATH DECARBOXYLATION +C + CCBS2=AMAX1(0.0,0.083E+09*CO2B(K,NB,NZ,NY,NX) + 2/(WGLF(K,NB,NZ,NY,NX)*FBS)) + CPL3K=2.5E-02*CPOOL3(K,NB,NZ,NY,NX)/(1.0+CCBS2/CO2KI) + CPOOL3(K,NB,NZ,NY,NX)=CPOOL3(K,NB,NZ,NY,NX)-CPL3K + CO2B(K,NB,NZ,NY,NX)=CO2B(K,NB,NZ,NY,NX)+FCO2B*CPL3K + HCOB(K,NB,NZ,NY,NX)=HCOB(K,NB,NZ,NY,NX)+FHCOB*CPL3K +C +C MESOPHYLL TO BUNDLE SHEATH TRANSFER +C + CPOOL4(K,NB,NZ,NY,NX)=CPOOL4(K,NB,NZ,NY,NX)+CH2O4(K) + CPL4M=0.5*(CPOOL4(K,NB,NZ,NY,NX)*WGLF(K,NB,NZ,NY,NX)*FBS + 2-CPOOL3(K,NB,NZ,NY,NX)*WGLF(K,NB,NZ,NY,NX)*FMP) + 2/(WGLF(K,NB,NZ,NY,NX)*(FBS+FMP)) + CPOOL4(K,NB,NZ,NY,NX)=CPOOL4(K,NB,NZ,NY,NX)-CPL4M + CPOOL3(K,NB,NZ,NY,NX)=CPOOL3(K,NB,NZ,NY,NX)+CPL4M + TCO2T(NZ,NY,NX)=TCO2T(NZ,NY,NX)-CO2LK + TCO2A(NZ,NY,NX)=TCO2A(NZ,NY,NX)-CO2LK + CNET(NZ,NY,NX)=CNET(NZ,NY,NX)-CO2LK + RECO(NY,NX)=RECO(NY,NX)-CO2LK + TRAU(NY,NX)=TRAU(NY,NX)-CO2LK + CO2LKF=CO2LK/ARLF(K,NB,NZ,NY,NX)*23.148 +C TC4=TC4+CH2O4(K) +C TLK=TLK+CO2LK +C IF(NB.EQ.1.AND.(K.EQ.16))THEN +C CCBS3=AMAX1(0.0,0.083E+09*CO2B(K,NB,NZ,NY,NX) +C 2/(WGLF(K,NB,NZ,NY,NX)*FBS)) +C WRITE(*,6667)'CO2K',I,J,NB,K,CPOOL4(K,NB,NZ,NY,NX) +C 2,CPOOL3(K,NB,NZ,NY,NX),CO2B(K,NB,NZ,NY,NX) +C 2,CPOOL4(K,NB,NZ,NY,NX)/(WGLF(K,NB,NZ,NY,NX)*FMP) +C 2,CPOOL3(K,NB,NZ,NY,NX)/(WGLF(K,NB,NZ,NY,NX)*FBS) +C 2,CO2B(K,NB,NZ,NY,NX)/(WGLF(K,NB,NZ,NY,NX)*FBS) +C 4,FPL3X,CH2O4(K),CH2O3(K),CPL4M,CPL3X,CPL3K,CO2LK +C 5,TC4,TLK,CO2LKF,CCBS1,CO2L(NZ,NY,NX),CCBS3 +C 6,ARLF(K,NB,NZ,NY,NX),HCOB(K,NB,NZ,NY,NX) +6667 FORMAT(A8,4I4,30E14.6) +C ENDIF + ENDIF +170 CONTINUE + ENDIF +C +C C,N,P GROWTH OF LEAF, SHEATH OR PETIOLE, STALK, +C STALK RESERVES, REPRODUCTIVE ORGANS, GRAIN +C + GROLF=PART(1)*CGROS*DMLFB + GROSHE=PART(2)*CGROS*DMSHB + GROSTK=PART(3)*CGROS*DMSTK(NZ,NY,NX) + GRORSV=PART(4)*CGROS*DMRSV(NZ,NY,NX) + GROHSK=PART(5)*CGROS*DMHSK(NZ,NY,NX) + GROEAR=PART(6)*CGROS*DMEAR(NZ,NY,NX) + GROGR=PART(7)*CGROS*DMGR(NZ,NY,NX) + GROSHT=CGROS*DMSHT + GROLFN=GROLF*CNLFB*(ZPLFM+ZPLFD*CNPG) + GROSHN=GROSHE*CNSHB + GROSTN=GROSTK*CNSTK(NZ,NY,NX) + GRORSN=GRORSV*CNRSV(NZ,NY,NX) + GROHSN=GROHSK*CNHSK(NZ,NY,NX) + GROEAN=GROEAR*CNEAR(NZ,NY,NX) + GROGRN=GROGR*CNRSV(NZ,NY,NX) + GROLFP=GROLF*CPLFB*(ZPLFM+ZPLFD*CNPG) + GROSHP=GROSHE*CPSHB + GROSTP=GROSTK*CPSTK(NZ,NY,NX) + GRORSP=GRORSV*CPRSV(NZ,NY,NX) + GROHSP=GROHSK*CPHSK(NZ,NY,NX) + GROEAP=GROEAR*CPEAR(NZ,NY,NX) + GROGRP=GROGR*CPRSV(NZ,NY,NX) + WTLFB(NB,NZ,NY,NX)=WTLFB(NB,NZ,NY,NX)+GROLF + WTSHEB(NB,NZ,NY,NX)=WTSHEB(NB,NZ,NY,NX)+GROSHE + WTSTKB(NB,NZ,NY,NX)=WTSTKB(NB,NZ,NY,NX)+GROSTK + WTRSVB(NB,NZ,NY,NX)=WTRSVB(NB,NZ,NY,NX)+GRORSV + WTHSKB(NB,NZ,NY,NX)=WTHSKB(NB,NZ,NY,NX)+GROHSK + WTEARB(NB,NZ,NY,NX)=WTEARB(NB,NZ,NY,NX)+GROEAR + WTLFBN(NB,NZ,NY,NX)=WTLFBN(NB,NZ,NY,NX)+GROLFN + WTSHBN(NB,NZ,NY,NX)=WTSHBN(NB,NZ,NY,NX)+GROSHN + WTSTBN(NB,NZ,NY,NX)=WTSTBN(NB,NZ,NY,NX)+GROSTN + WTRSBN(NB,NZ,NY,NX)=WTRSBN(NB,NZ,NY,NX)+GRORSN + WTHSBN(NB,NZ,NY,NX)=WTHSBN(NB,NZ,NY,NX)+GROHSN + WTEABN(NB,NZ,NY,NX)=WTEABN(NB,NZ,NY,NX)+GROEAN + WTLFBP(NB,NZ,NY,NX)=WTLFBP(NB,NZ,NY,NX)+GROLFP + WTSHBP(NB,NZ,NY,NX)=WTSHBP(NB,NZ,NY,NX)+GROSHP + WTSTBP(NB,NZ,NY,NX)=WTSTBP(NB,NZ,NY,NX)+GROSTP + WTRSBP(NB,NZ,NY,NX)=WTRSBP(NB,NZ,NY,NX)+GRORSP + WTHSBP(NB,NZ,NY,NX)=WTHSBP(NB,NZ,NY,NX)+GROHSP + WTEABP(NB,NZ,NY,NX)=WTEABP(NB,NZ,NY,NX)+GROEAP +C +C DISTRIBUTE LEAF GROWTH AMONG CURRENTLY GROWING NODES +C + CCE=AMIN1(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)) + ETOL=1.0+CCE + IF(NB.EQ.NB1(NZ,NY,NX).AND.HTCTL(NZ,NY,NX).LE.SDPTH(NZ,NY,NX))THEN + NNOD1=0 + ELSE + NNOD1=1 + ENDIF + IF(GROLF.GT.0.0)THEN + MXNOD=KVSTG(NB,NZ,NY,NX) + MNNOD=MAX(NNOD1,MXNOD-NNOD(NZ,NY,NX)+1) + MXNOD=MAX(MXNOD,MNNOD) + KNOD=MXNOD-MNNOD+1 + GNOD=KNOD + ALLOCL=1.0/GNOD + GRO=ALLOCL*GROLF + GRON=ALLOCL*GROLFN + GROP=ALLOCL*GROLFP + GSLA=ALLOCL*FNOD(NZ,NY,NX)*NNOD(NZ,NY,NX) +C +C GROWTH AT EACH CURRENT NODE +C + DO 490 KK=MNNOD,MXNOD + K=MOD(KK,25) + IF(K.EQ.0.AND.KK.NE.0)K=25 + WGLF(K,NB,NZ,NY,NX)=WGLF(K,NB,NZ,NY,NX)+GRO + WGLFN(K,NB,NZ,NY,NX)=WGLFN(K,NB,NZ,NY,NX)+GRON + WGLFP(K,NB,NZ,NY,NX)=WGLFP(K,NB,NZ,NY,NX)+GROP + WSLF(K,NB,NZ,NY,NX)=WSLF(K,NB,NZ,NY,NX) + 2+AMIN1(GRON*CNWS(NZ,NY,NX),GROP*CPWS(NZ,NY,NX)) +C +C SPECIFIC LEAF AREA FUNCTION OF CURRENT LEAF MASS +C WITH PARAMETERS FROM 'READQ' +C + SLA=ETOL*SLA1(NZ,NY,NX)*(AMAX1(ZEROL(NZ,NY,NX) + 2,WGLF(K,NB,NZ,NY,NX))/(PP(NZ,NY,NX)*GSLA))**SLA2*WFNS + GROA=GRO*SLA + ARLFB(NB,NZ,NY,NX)=ARLFB(NB,NZ,NY,NX)+GROA + ARLF(K,NB,NZ,NY,NX)=ARLF(K,NB,NZ,NY,NX)+GROA +490 CONTINUE + ENDIF +C +C DISTRIBUTE SHEATH OR PETIOLE GROWTH AMONG CURRENTLY GROWING NODES +C + IF(GROSHE.GT.0.0)THEN + MXNOD=KVSTG(NB,NZ,NY,NX) + MNNOD=MAX(NNOD1,MXNOD-NNOD(NZ,NY,NX)+1) + MXNOD=MAX(MXNOD,MNNOD) + GNOD=MXNOD-MNNOD+1 + ALLOCS=1.0/GNOD + GRO=ALLOCS*GROSHE + GRON=ALLOCS*GROSHN + GROP=ALLOCS*GROSHP + GSSL=ALLOCL*FNOD(NZ,NY,NX)*NNOD(NZ,NY,NX) +C +C GROWTH AT EACH CURRENT NODE +C + DO 505 KK=MNNOD,MXNOD + K=MOD(KK,25) + IF(K.EQ.0.AND.KK.NE.0)K=25 + WGSHE(K,NB,NZ,NY,NX)=WGSHE(K,NB,NZ,NY,NX)+GRO + WGSHN(K,NB,NZ,NY,NX)=WGSHN(K,NB,NZ,NY,NX)+GRON + WGSHP(K,NB,NZ,NY,NX)=WGSHP(K,NB,NZ,NY,NX)+GROP + WSSHE(K,NB,NZ,NY,NX)=WSSHE(K,NB,NZ,NY,NX) + 2+AMIN1(GRON*CNWS(NZ,NY,NX),GROP*CPWS(NZ,NY,NX)) +C +C SPECIFIC SHEATH OR PETIOLE LENGTH FUNCTION OF CURRENT MASS +C WITH PARAMETERS FROM 'READQ' +C + IF(WGLF(K,NB,NZ,NY,NX).GT.0.0)THEN + SSL=ETOL*SSL1(NZ,NY,NX)*(AMAX1(ZEROL(NZ,NY,NX) + 4,WGSHE(K,NB,NZ,NY,NX))/(PP(NZ,NY,NX)*GSSL))**SSL2*WFNS + GROS=GRO/PP(NZ,NY,NX)*SSL + HTSHE(K,NB,NZ,NY,NX)=HTSHE(K,NB,NZ,NY,NX)+GROS*ANGSH(NZ,NY,NX) +C IF(I.EQ.120.AND.J.EQ.24)THEN +C WRITE(*,2526)'HTSHE',I,J,NZ,NB,K,SSL,WGSHE(K,NB,NZ,NY,NX) +C 2,HTSHE(K,NB,NZ,NY,NX),PP(NZ,NY,NX),SSL1(NZ,NY,NX) +C 3,GSLA,SSL3,WFNS,GROS,GRO,ANGSH(NZ,NY,NX),ZEROL(NZ,NY,NX) +C 4,CCPOLB(NB,NZ,NY,NX),ETOL +2526 FORMAT(A8,5I4,20E12.4) +C ENDIF + ENDIF +505 CONTINUE + ENDIF +C +C DISTRIBUTE STALK GROWTH AMONG CURRENTLY GROWING NODES +C + IF(IDAY(1,NB,NZ,NY,NX).EQ.0)THEN + NN=0 + ELSE + NN=1 + ENDIF + MXNOD=KVSTG(NB,NZ,NY,NX) + MNNOD=MAX(MIN(NN,MAX(NN,MXNOD-NNOD(NZ,NY,NX))) + 2,KVSTG(NB,NZ,NY,NX)-23) + MXNOD=MAX(MXNOD,MNNOD) + IF(GROSTK.GT.0.0)THEN + GNOD=MXNOD-MNNOD+1 + ALLOCN=1.0/GNOD + GRO=ALLOCN*GROSTK + GRON=ALLOCN*GROSTN + GROP=ALLOCN*GROSTP +C +C SPECIFIC INTERNODE LENGTH FUNCTION OF CURRENT STALK MASS +C WITH PARAMETERS FROM 'READQ' +C + SNL=ETOL*SNL1(NZ,NY,NX)*(WTSTKB(NB,NZ,NY,NX)/PP(NZ,NY,NX))**SNL2 + GROH=GRO/PP(NZ,NY,NX)*SNL + KX=MOD(MNNOD-1,25) + IF(KX.EQ.0.AND.MNNOD-1.NE.0)KX=25 +C +C GROWTH AT EACH CURRENT NODE +C + DO 510 KK=MNNOD,MXNOD + K1=MOD(KK,25) + IF(K1.EQ.0.AND.KK.NE.0)K1=25 + K2=MOD(KK-1,25) + IF(K2.EQ.0.AND.KK-1.NE.0)K2=25 + WGNODE(K1,NB,NZ,NY,NX)=WGNODE(K1,NB,NZ,NY,NX)+GRO + WGNODN(K1,NB,NZ,NY,NX)=WGNODN(K1,NB,NZ,NY,NX)+GRON + WGNODP(K1,NB,NZ,NY,NX)=WGNODP(K1,NB,NZ,NY,NX)+GROP + HTNODX(K1,NB,NZ,NY,NX)=HTNODX(K1,NB,NZ,NY,NX)+GROH*ANGBR(NZ,NY,NX) + IF(K1.NE.0)THEN + HTNODE(K1,NB,NZ,NY,NX)=HTNODX(K1,NB,NZ,NY,NX) + 2+HTNODE(K2,NB,NZ,NY,NX) + ELSE + HTNODE(K1,NB,NZ,NY,NX)=HTNODX(K1,NB,NZ,NY,NX) + ENDIF +C IF(NZ.EQ.1)THEN +C WRITE(*,515)'HTNODE',I,J,NZ,NB,KK,K1,K2,MNNOD,MXNOD +C 1,NNOD(NZ,NY,NX),ARLF(K1,NB,NZ,NY,NX) +C 2,HTNODE(K1,NB,NZ,NY,NX),HTNODE(K2,NB,NZ,NY,NX),SNL,GRO +C 3,ALLOCN,WTSTKB(NB,NZ,NY,NX),WGNODE(K1,NB,NZ,NY,NX) +C 4,HTNODX(K1,NB,NZ,NY,NX),PP(NZ,NY,NX),GROSTK +515 FORMAT(A8,10I4,20E12.4) +C ENDIF +510 CONTINUE + ENDIF +C +C RECOVERY OF REMOBILIZABLE N,P DURING REMOBILIZATION DEPENDS +C ON SHOOT NON-STRUCTURAL C:N:P +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) + 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) + ELSE + CCC=0.0 + CNC=0.0 + CPC=0.0 + ENDIF + RCCC=RCCZ(IBTYP(NZ,NY,NX))+CCC*RCCY(IBTYP(NZ,NY,NX)) + RCCN=CNC*RCCX(IGTYP(NZ,NY,NX)) + RCCP=CPC*RCCQ(IGTYP(NZ,NY,NX)) +C +C WITHDRAW REMOBILIZABLE C,N,P FROM LOWEST NODE AFTER +C MAXIMUM NODE NUMBER OF 25 IS REACHED +C + IF(IFLGG(NB,NZ,NY,NX).EQ.1)THEN + KVSTGX=KVSTG(NB,NZ,NY,NX)-24 + IF(KVSTGX.GT.0)THEN + K=MOD(KVSTGX,25) + IF(K.EQ.0.AND.KVSTGX.GT.0)K=25 + KX=MOD(KVSTG(NB,NZ,NY,NX),25) + IF(KX.EQ.0.AND.KVSTG(NB,NZ,NY,NX).NE.0)KX=25 + FSNC=TFN3(NZ,NY,NX)*XRLA(NZ,NY,NX) +C +C REMOBILIZATION OF LEAF C,N,P ALSO DEPENDS ON STRUCTURAL C:N:P +C + IF(IFLGP(NB,NZ,NY,NX).EQ.1)THEN + WGLFX(NB,NZ,NY,NX)=AMAX1(0.0,WGLF(K,NB,NZ,NY,NX)) + WGLFNX(NB,NZ,NY,NX)=AMAX1(0.0,WGLFN(K,NB,NZ,NY,NX)) + WGLFPX(NB,NZ,NY,NX)=AMAX1(0.0,WGLFP(K,NB,NZ,NY,NX)) + ARLFZ(NB,NZ,NY,NX)=AMAX1(0.0,ARLF(K,NB,NZ,NY,NX)) + IF(WGLFX(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + RCCLX(NB,NZ,NY,NX)=RCCC*WGLFX(NB,NZ,NY,NX) + RCZLX(NB,NZ,NY,NX)=WGLFNX(NB,NZ,NY,NX)*(RCCN+(1.0-RCCN)*RCCC) + RCPLX(NB,NZ,NY,NX)=WGLFPX(NB,NZ,NY,NX)*(RCCP+(1.0-RCCP)*RCCC) + ELSE + RCCLX(NB,NZ,NY,NX)=0.0 + RCZLX(NB,NZ,NY,NX)=0.0 + RCPLX(NB,NZ,NY,NX)=0.0 + ENDIF + ENDIF +C +C FRACTION OF CURRENT LEAF TO BE REMOBILIZED +C + IF(FSNC*WGLFX(NB,NZ,NY,NX).GT.WGLF(K,NB,NZ,NY,NX) + 2.AND.WGLFX(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + FSNCL=AMAX1(0.0,WGLF(K,NB,NZ,NY,NX)/WGLFX(NB,NZ,NY,NX)) + ELSE + FSNCL=FSNC + ENDIF +C +C NON-REMOBILIZABLE C,N,P BECOMES LITTERFALL ALLOCATED +C TO FRACTIONS SET IN 'STARTQ' +C + DO 6300 M=1,4 + CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX)+CFOPC(5,M,NZ,NY,NX) + 2*FSNCL*(WGLFX(NB,NZ,NY,NX)-RCCLX(NB,NZ,NY,NX))*FWODB(0) + ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX)+CFOPN(5,M,NZ,NY,NX) + 2*FSNCL*(WGLFNX(NB,NZ,NY,NX)-RCZLX(NB,NZ,NY,NX))*FWODLN(0) + PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX)+CFOPP(5,M,NZ,NY,NX) + 2*FSNCL*(WGLFPX(NB,NZ,NY,NX)-RCPLX(NB,NZ,NY,NX))*FWODLP(0) + CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX)+CFOPC(1,M,NZ,NY,NX) + 2*FSNCL*(WGLFX(NB,NZ,NY,NX)-RCCLX(NB,NZ,NY,NX))*FWODB(1) + ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX)+CFOPN(1,M,NZ,NY,NX) + 2*FSNCL*(WGLFNX(NB,NZ,NY,NX)-RCZLX(NB,NZ,NY,NX))*FWODLN(1) + PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX)+CFOPP(1,M,NZ,NY,NX) + 2*FSNCL*(WGLFPX(NB,NZ,NY,NX)-RCPLX(NB,NZ,NY,NX))*FWODLP(1) +6300 CONTINUE +C +C UPDATE STATE VARIABLES FOR REMOBILIZATION AND LITTERFALL +C + ARLFB(NB,NZ,NY,NX)=ARLFB(NB,NZ,NY,NX) + 2-FSNCL*ARLFZ(NB,NZ,NY,NX) + WTLFB(NB,NZ,NY,NX)=WTLFB(NB,NZ,NY,NX) + 2-FSNCL*WGLFX(NB,NZ,NY,NX) + WTLFBN(NB,NZ,NY,NX)=WTLFBN(NB,NZ,NY,NX) + 2-FSNCL*WGLFNX(NB,NZ,NY,NX) + WTLFBP(NB,NZ,NY,NX)=WTLFBP(NB,NZ,NY,NX) + 2-FSNCL*WGLFPX(NB,NZ,NY,NX) + ARLF(K,NB,NZ,NY,NX)=ARLF(K,NB,NZ,NY,NX) + 2-FSNCL*ARLFZ(NB,NZ,NY,NX) + WGLF(K,NB,NZ,NY,NX)=WGLF(K,NB,NZ,NY,NX) + 2-FSNCL*WGLFX(NB,NZ,NY,NX) + WGLFN(K,NB,NZ,NY,NX)=WGLFN(K,NB,NZ,NY,NX) + 2-FSNCL*WGLFNX(NB,NZ,NY,NX) + WGLFP(K,NB,NZ,NY,NX)=WGLFP(K,NB,NZ,NY,NX) + 2-FSNCL*WGLFPX(NB,NZ,NY,NX) + WSLF(K,NB,NZ,NY,NX)=AMAX1(0.0,WSLF(K,NB,NZ,NY,NX) + 2-FSNCL*AMAX1(WGLFNX(NB,NZ,NY,NX)*CNWS(NZ,NY,NX) + 3,WGLFPX(NB,NZ,NY,NX)*CPWS(NZ,NY,NX))) + CPOOL(NB,NZ,NY,NX)=CPOOL(NB,NZ,NY,NX)+FSNCL*RCCLX(NB,NZ,NY,NX) + ZPOOL(NB,NZ,NY,NX)=ZPOOL(NB,NZ,NY,NX)+FSNCL*RCZLX(NB,NZ,NY,NX) + PPOOL(NB,NZ,NY,NX)=PPOOL(NB,NZ,NY,NX)+FSNCL*RCPLX(NB,NZ,NY,NX) +C +C REMOBILIZATION OF SHEATHS OR PETIOLE C,N,P ALSO DEPENDS ON +C STRUCTURAL C:N:P +C + IF(IFLGP(NB,NZ,NY,NX).EQ.1)THEN + WGSHEX(NB,NZ,NY,NX)=AMAX1(0.0,WGSHE(K,NB,NZ,NY,NX)) + WGSHNX(NB,NZ,NY,NX)=AMAX1(0.0,WGSHN(K,NB,NZ,NY,NX)) + WGSHPX(NB,NZ,NY,NX)=AMAX1(0.0,WGSHP(K,NB,NZ,NY,NX)) + HTSHEX(NB,NZ,NY,NX)=AMAX1(0.0,HTSHE(K,NB,NZ,NY,NX)) + IF(WGSHEX(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + RCCSX(NB,NZ,NY,NX)=RCCC*WGSHEX(NB,NZ,NY,NX) + RCZSX(NB,NZ,NY,NX)=WGSHNX(NB,NZ,NY,NX) + 2*(RCCN+(1.0-RCCN)*RCCSX(NB,NZ,NY,NX)/WGSHEX(NB,NZ,NY,NX)) + RCPSX(NB,NZ,NY,NX)=WGSHPX(NB,NZ,NY,NX) + 2*(RCCP+(1.0-RCCP)*RCCSX(NB,NZ,NY,NX)/WGSHEX(NB,NZ,NY,NX)) + ELSE + RCCSX(NB,NZ,NY,NX)=0.0 + RCZSX(NB,NZ,NY,NX)=0.0 + RCPSX(NB,NZ,NY,NX)=0.0 + ENDIF + WTSTXB(NB,NZ,NY,NX)=WTSTXB(NB,NZ,NY,NX)+WGNODE(K,NB,NZ,NY,NX) + WTSTXN(NB,NZ,NY,NX)=WTSTXN(NB,NZ,NY,NX)+WGNODN(K,NB,NZ,NY,NX) + WTSTXP(NB,NZ,NY,NX)=WTSTXP(NB,NZ,NY,NX)+WGNODP(K,NB,NZ,NY,NX) +C IF(NZ.EQ.2)THEN +C WRITE(*,2358)'WTSTXB',I,J,NZ,NB,K,WTSTXB(NB,NZ,NY,NX) +C 2,WTSTKB(NB,NZ,NY,NX),WGNODE(K,NB,NZ,NY,NX) +2358 FORMAT(A8,5I4,12E12.4) +C ENDIF + WGNODE(K,NB,NZ,NY,NX)=0.0 + WGNODN(K,NB,NZ,NY,NX)=0.0 + WGNODP(K,NB,NZ,NY,NX)=0.0 + HTNODX(K,NB,NZ,NY,NX)=0.0 + ENDIF +C +C FRACTION OF CURRENT SHEATH TO BE REMOBILIZED +C + IF(FSNC*WGSHEX(NB,NZ,NY,NX).GT.WGSHE(K,NB,NZ,NY,NX) + 2.AND.WGSHEX(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + FSNCS=AMAX1(0.0,WGSHE(K,NB,NZ,NY,NX)/WGSHEX(NB,NZ,NY,NX)) + ELSE + FSNCS=FSNC + ENDIF +C +C NON-REMOBILIZABLE C,N,P BECOMES LITTERFALL ALLOCATED +C TO FRACTIONS SET IN 'STARTQ' +C + DO 6305 M=1,4 + CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX)+CFOPC(5,M,NZ,NY,NX) + 2*FSNCS*(WGSHEX(NB,NZ,NY,NX)-RCCSX(NB,NZ,NY,NX))*FWODB(0) + ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX)+CFOPN(5,M,NZ,NY,NX) + 2*FSNCS*(WGSHNX(NB,NZ,NY,NX)-RCZSX(NB,NZ,NY,NX))*FWODSN(0) + PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX)+CFOPP(5,M,NZ,NY,NX) + 2*FSNCS*(WGSHPX(NB,NZ,NY,NX)-RCPSX(NB,NZ,NY,NX))*FWODSP(0) + CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX)+CFOPC(2,M,NZ,NY,NX) + 2*FSNCS*(WGSHEX(NB,NZ,NY,NX)-RCCSX(NB,NZ,NY,NX))*FWODB(1) + ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX)+CFOPN(2,M,NZ,NY,NX) + 2*FSNCS*(WGSHNX(NB,NZ,NY,NX)-RCZSX(NB,NZ,NY,NX))*FWODSN(1) + PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX)+CFOPP(2,M,NZ,NY,NX) + 2*FSNCS*(WGSHPX(NB,NZ,NY,NX)-RCPSX(NB,NZ,NY,NX))*FWODSP(1) +6305 CONTINUE +C +C UPDATE STATE VARIABLES FOR REMOBILIZATION AND LITTERFALL +C + WTSHEB(NB,NZ,NY,NX)=WTSHEB(NB,NZ,NY,NX) + 2-FSNCS*WGSHEX(NB,NZ,NY,NX) + WTSHBN(NB,NZ,NY,NX)=WTSHBN(NB,NZ,NY,NX) + 2-FSNCS*WGSHNX(NB,NZ,NY,NX) + WTSHBP(NB,NZ,NY,NX)=WTSHBP(NB,NZ,NY,NX) + 2-FSNCS*WGSHPX(NB,NZ,NY,NX) + HTSHE(K,NB,NZ,NY,NX)=HTSHE(K,NB,NZ,NY,NX) + 2-FSNCS*HTSHEX(NB,NZ,NY,NX) + WGSHE(K,NB,NZ,NY,NX)=WGSHE(K,NB,NZ,NY,NX) + 2-FSNCS*WGSHEX(NB,NZ,NY,NX) + WGSHN(K,NB,NZ,NY,NX)=WGSHN(K,NB,NZ,NY,NX) + 2-FSNCS*WGSHNX(NB,NZ,NY,NX) + WGSHP(K,NB,NZ,NY,NX)=WGSHP(K,NB,NZ,NY,NX) + 2-FSNCS*WGSHPX(NB,NZ,NY,NX) + WSSHE(K,NB,NZ,NY,NX)=AMAX1(0.0,WSSHE(K,NB,NZ,NY,NX) + 2-FSNCS*AMAX1(WGSHNX(NB,NZ,NY,NX)*CNWS(NZ,NY,NX) + 3,WGSHPX(NB,NZ,NY,NX)*CPWS(NZ,NY,NX))) + CPOOL(NB,NZ,NY,NX)=CPOOL(NB,NZ,NY,NX)+FSNCS*RCCSX(NB,NZ,NY,NX) + ZPOOL(NB,NZ,NY,NX)=ZPOOL(NB,NZ,NY,NX)+FSNCS*RCZSX(NB,NZ,NY,NX) + PPOOL(NB,NZ,NY,NX)=PPOOL(NB,NZ,NY,NX)+FSNCS*RCPSX(NB,NZ,NY,NX) + ENDIF + ENDIF +C +C REMOBILIZATION OF STALK RESERVE C,N,P IF GROWTH RESPIRATION < 0 +C + IF(IFLGZ.EQ.0)THEN + IF(SNCR.GT.0.0.AND.WTRSVB(NB,NZ,NY,NX).GT.0.0)THEN + RCO2V=AMIN1(SNCR,VMXC*WTRSVB(NB,NZ,NY,NX)*TFN3(NZ,NY,NX)) + WTRSVB(NB,NZ,NY,NX)=WTRSVB(NB,NZ,NY,NX)-RCO2V + SNCR=SNCR-RCO2V + ENDIF + ENDIF +C +C TOTAL REMOBILIZATION = GROWTH RESPIRATION < 0 + DECIDUOUS LEAF +C FALL DURING AUTUMN + REMOBILZATION DURING GRAIN FILL IN ANNUALS +C + IF(ISTYP(NZ,NY,NX).NE.0.AND.IFLGZ.EQ.1.AND.IFLGY.EQ.1)THEN + SNCZ=FXFB(IBTYP(NZ,NY,NX)) + 2*WTLSB(NB,NZ,NY,NX)*AMIN1(1.0,FLGZ(NB,NZ,NY,NX)/FLGZX) + ELSE + SNCZ=0.0 + ENDIF + SNCX=SNCR+SNCZ + IF(SNCX.GT.ZEROP(NZ,NY,NX))THEN + SNCF=SNCZ/SNCX + KSNC=INT(0.5*(KVSTG(NB,NZ,NY,NX)-KVSTGN(NB,NZ,NY,NX)))+1 + XKSNC=KSNC + KN=MAX(0,KVSTGN(NB,NZ,NY,NX)-1) +C IF(NZ.EQ.2.OR.NZ.EQ.3)THEN +C WRITE(*,1266)'SNCX0',I,J,NX,NY,NZ,NB,SNCY,SNCR,SNCX,SNCF +C 2,CPOOL(NB,NZ,NY,NX),WTLSB(NB,NZ,NY,NX),RCCC +1266 FORMAT(A8,6I4,12E16.8) +C ENDIF +C +C TRANSFER NON-STRUCTURAL C,N,P FROM BRANCHES TO MAIN STEM +C IF MAIN STEM POOLS ARE DEPLETED +C + IF(IBTYP(NZ,NY,NX).NE.0.AND.IGTYP(NZ,NY,NX).GT.1 + 2.AND.NB.EQ.NB1(NZ,NY,NX).AND.SNCF.EQ.0)THEN + NBY=0 + DO 584 NBL=1,NBR(NZ,NY,NX) + NBZ(NBL)=0 +584 CONTINUE + DO 586 NBL=1,NBR(NZ,NY,NX) + NBX=KVSTG(NB,NZ,NY,NX) + DO 585 NBK=1,NBR(NZ,NY,NX) + IF(IDTHB(NBK,NZ,NY,NX).EQ.0.AND.NBK.NE.NB1(NZ,NY,NX) + 2.AND.NBTB(NBK,NZ,NY,NX).LT.NBX + 3.AND.NBTB(NBK,NZ,NY,NX).GT.NBY)THEN + NBZ(NBL)=NBK + NBX=NBTB(NBK,NZ,NY,NX) + ENDIF +585 CONTINUE + IF(NBZ(NBL).NE.0)THEN + NBY=NBTB(NBZ(NBL),NZ,NY,NX) + ENDIF +586 CONTINUE + DO 580 NBL=1,NBR(NZ,NY,NX) + IF(NBZ(NBL).NE.0)THEN + IF(NBTB(NBZ(NBL),NZ,NY,NX).LT.KK)THEN + IF(CPOOL(NBZ(NBL),NZ,NY,NX).GT.0)THEN + XFRC=1.0E-02*AMIN1(SNCX,CPOOL(NBZ(NBL),NZ,NY,NX)) + XFRN=XFRC*ZPOOL(NBZ(NBL),NZ,NY,NX)/CPOOL(NBZ(NBL),NZ,NY,NX) + XFRP=XFRC*PPOOL(NBZ(NBL),NZ,NY,NX)/CPOOL(NBZ(NBL),NZ,NY,NX) + ELSE + XFRC=0.0 + XFRN=1.0E-02*ZPOOL(NBZ(NBL),NZ,NY,NX) + XFRP=1.0E-02*PPOOL(NBZ(NBL),NZ,NY,NX) + ENDIF + CPOOL(NBZ(NBL),NZ,NY,NX)=CPOOL(NBZ(NBL),NZ,NY,NX)-XFRC + ZPOOL(NBZ(NBL),NZ,NY,NX)=ZPOOL(NBZ(NBL),NZ,NY,NX)-XFRN + PPOOL(NBZ(NBL),NZ,NY,NX)=PPOOL(NBZ(NBL),NZ,NY,NX)-XFRP + CPOOL(NB1(NZ,NY,NX),NZ,NY,NX)=CPOOL(NB1(NZ,NY,NX),NZ,NY,NX) + 2+XFRC*SNCF + ZPOOL(NB1(NZ,NY,NX),NZ,NY,NX)=ZPOOL(NB1(NZ,NY,NX),NZ,NY,NX) + 2+XFRN + PPOOL(NB1(NZ,NY,NX),NZ,NY,NX)=PPOOL(NB1(NZ,NY,NX),NZ,NY,NX) + 2+XFRP + SNCX=SNCX-XFRC + IF(SNCX.LE.0.0)GO TO 595 + ENDIF + ENDIF +580 CONTINUE + ENDIF +C +C REMOBILIZATION AND LITTERFALL WHEN GROWTH RESPIRATION < 0 +C STARTING FROM LOWEST LEAFED NODE AND PROCEEDING UPWARDS +C +C IF(NZ.EQ.2.OR.NZ.EQ.3)THEN +C WRITE(*,1266)'SNCX1',I,J,NX,NY,NZ,NB,SNCY,SNCR,SNCX,SNCF +C 2,CPOOL(NB,NZ,NY,NX),WTLSB(NB,NZ,NY,NX),RCCC +C ENDIF + DO 575 N=1,KSNC + SNCT=SNCX/XKSNC + DO 650 KK=KN,KVSTG(NB,NZ,NY,NX) + SNCLF=0.0 + SNCSH=0.0 + K=MOD(KK,25) + IF(K.EQ.0.AND.KK.NE.0)K=25 +C +C REMOBILIZATION OF LEAF C,N,P DEPENDS ON NON-STRUCTURAL C:N:P +C + IF(WGLF(K,NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + FNCLF=WGLF(K,NB,NZ,NY,NX)/(WGLF(K,NB,NZ,NY,NX) + 2+WGSHE(K,NB,NZ,NY,NX)) + SNCLF=FNCLF*SNCT + SNCSH=SNCT-SNCLF + RCCL=RCCC*WGLF(K,NB,NZ,NY,NX) + RCZL=WGLFN(K,NB,NZ,NY,NX)*(RCCN+(1.0-RCCN)*RCCC) + RCPL=WGLFP(K,NB,NZ,NY,NX)*(RCCP+(1.0-RCCP)*RCCC) +C +C FRACTION OF CURRENT LEAF TO BE REMOBILIZED +C + IF(RCCL.GT.ZEROP(NZ,NY,NX))THEN + FSNCL=AMAX1(0.0,AMIN1(1.0,SNCLF/RCCL)) + ELSE + FSNCL=1.0 + ENDIF + FSNAL=FSNCL +C +C NON-REMOBILIZABLE C,N,P BECOMES LITTERFALL ALLOCATED +C TO FRACTIONS SET IN 'STARTQ' +C +C IF(NZ.EQ.1)THEN +C WRITE(*,4898)'SNCT1',I,J,NX,NY,NZ,NB,K,N +C 2,KN,KVSTG(NB,NZ,NY,NX),SNCLF,SNCT +C 2,FSNCL,RCCL,WTLFB(NB,NZ,NY,NX),ARLFB(NB,NZ,NY,NX) +C 2,WGLFN(K,NB,NZ,NY,NX),WGLFLN(1,K,NB,NZ,NY,NX) +C 3,ARLF(K,NB,NZ,NY,NX) +4898 FORMAT(A8,10I4,12E16.8) +C ENDIF + DO 6310 M=1,4 + CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX)+CFOPC(5,M,NZ,NY,NX) + 2*FSNCL*(WGLF(K,NB,NZ,NY,NX)-RCCL)*FWODB(0) + ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX)+CFOPN(5,M,NZ,NY,NX) + 2*FSNCL*(WGLFN(K,NB,NZ,NY,NX)-RCZL)*FWODLN(0) + PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX)+CFOPP(5,M,NZ,NY,NX) + 2*FSNCL*(WGLFP(K,NB,NZ,NY,NX)-RCPL)*FWODLP(0) + CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX)+CFOPC(1,M,NZ,NY,NX) + 2*FSNCL*(WGLF(K,NB,NZ,NY,NX)-RCCL)*FWODB(1) + ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX)+CFOPN(1,M,NZ,NY,NX) + 2*FSNCL*(WGLFN(K,NB,NZ,NY,NX)-RCZL)*FWODLN(1) + PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX)+CFOPP(1,M,NZ,NY,NX) + 2*FSNCL*(WGLFP(K,NB,NZ,NY,NX)-RCPL)*FWODLP(1) +6310 CONTINUE + IF(K.NE.0)THEN + CSNC(2,1,0,NZ,NY,NX)=CSNC(2,1,0,NZ,NY,NX) + 2+FSNCL*(CPOOL3(K,NB,NZ,NY,NX)+CPOOL4(K,NB,NZ,NY,NX)) + CPOOL3(K,NB,NZ,NY,NX)=CPOOL3(K,NB,NZ,NY,NX) + 2-FSNCL*CPOOL3(K,NB,NZ,NY,NX) + CPOOL4(K,NB,NZ,NY,NX)=CPOOL4(K,NB,NZ,NY,NX) + 2-FSNCL*CPOOL4(K,NB,NZ,NY,NX) + ENDIF +C +C UPDATE STATE VARIABLES FOR REMOBILIZATION AND LITTERFALL +C + ARLFB(NB,NZ,NY,NX)=AMAX1(0.0,ARLFB(NB,NZ,NY,NX) + 2-FSNAL*ARLF(K,NB,NZ,NY,NX)) + WTLFB(NB,NZ,NY,NX)=AMAX1(0.0,WTLFB(NB,NZ,NY,NX) + 2-FSNCL*WGLF(K,NB,NZ,NY,NX)) + WTLFBN(NB,NZ,NY,NX)=AMAX1(0.0,WTLFBN(NB,NZ,NY,NX) + 2-FSNCL*WGLFN(K,NB,NZ,NY,NX)) + WTLFBP(NB,NZ,NY,NX)=AMAX1(0.0,WTLFBP(NB,NZ,NY,NX) + 2-FSNCL*WGLFP(K,NB,NZ,NY,NX)) + ARLF(K,NB,NZ,NY,NX)=ARLF(K,NB,NZ,NY,NX) + 2-FSNAL*ARLF(K,NB,NZ,NY,NX) + WGLF(K,NB,NZ,NY,NX)=WGLF(K,NB,NZ,NY,NX) + 2-FSNCL*WGLF(K,NB,NZ,NY,NX) + WGLFN(K,NB,NZ,NY,NX)=WGLFN(K,NB,NZ,NY,NX) + 2-FSNCL*WGLFN(K,NB,NZ,NY,NX) + WGLFP(K,NB,NZ,NY,NX)=WGLFP(K,NB,NZ,NY,NX) + 2-FSNCL*WGLFP(K,NB,NZ,NY,NX) + WSLF(K,NB,NZ,NY,NX)=AMAX1(0.0,WSLF(K,NB,NZ,NY,NX) + 2-FSNCL*AMAX1(WGLFN(K,NB,NZ,NY,NX)*CNWS(NZ,NY,NX) + 3,WGLFP(K,NB,NZ,NY,NX)*CPWS(NZ,NY,NX))) +C +C FRACTION OF C REMOBILIZED FOR GROWTH RESPIRATION < 0 IS +C RESPIRED AND NOT TRANSFERRED TO NON-STRUCTURAL POOLS +C + CPOOL(NB,NZ,NY,NX)=CPOOL(NB,NZ,NY,NX)+FSNCL*RCCL*SNCF + ZPOOL(NB,NZ,NY,NX)=ZPOOL(NB,NZ,NY,NX)+FSNCL*RCZL + PPOOL(NB,NZ,NY,NX)=PPOOL(NB,NZ,NY,NX)+FSNCL*RCPL + SNCLF=SNCLF-FSNCL*RCCL + SNCT=SNCT-FSNCL*RCCL + IF(WTLFB(NB,NZ,NY,NX).LT.ZEROL(NZ,NY,NX))THEN + WTLFB(NB,NZ,NY,NX)=0.0 + ARLFB(NB,NZ,NY,NX)=0.0 + ENDIF +C +C EXIT LOOP IF REMOBILIZATION REQUIREMENT HAS BEEN MET +C + IF(SNCLF.LE.ZEROP(NZ,NY,NX))GO TO 564 +C +C OTHERWISE REMAINING C,N,P IN LEAF GOES TO LITTERFALL +C + ELSE +C IF(NZ.EQ.1)THEN +C WRITE(*,4899)'SNCT2',I,J,NX,NY,NZ,NB,K,N,SNCLF,SNCT +C 2,FSNCL,RCCL,WTLFB(NB,NZ,NY,NX),ARLFB(NB,NZ,NY,NX) +C 2,WGLFN(K,NB,NZ,NY,NX),WGLFLN(1,K,NB,NZ,NY,NX) +C 3,ARLF(K,NB,NZ,NY,NX) +4899 FORMAT(A8,8I4,12E16.8) +C ENDIF + DO 6315 M=1,4 + CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX)+CFOPC(5,M,NZ,NY,NX) + 2*WGLF(K,NB,NZ,NY,NX)*FWODB(0) + ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX)+CFOPN(5,M,NZ,NY,NX) + 2*WGLFN(K,NB,NZ,NY,NX)*FWODLN(0) + PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX)+CFOPP(5,M,NZ,NY,NX) + 2*WGLFP(K,NB,NZ,NY,NX)*FWODLP(0) + CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX)+CFOPC(1,M,NZ,NY,NX) + 2*WGLF(K,NB,NZ,NY,NX)*FWODB(1) + ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX)+CFOPN(1,M,NZ,NY,NX) + 2*WGLFN(K,NB,NZ,NY,NX)*FWODLN(1) + PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX)+CFOPP(1,M,NZ,NY,NX) + 2*WGLFP(K,NB,NZ,NY,NX)*FWODLP(1) +6315 CONTINUE + IF(K.NE.0)THEN + CSNC(2,1,0,NZ,NY,NX)=CSNC(2,1,0,NZ,NY,NX) + 2+CPOOL3(K,NB,NZ,NY,NX)+CPOOL4(K,NB,NZ,NY,NX) + CPOOL3(K,NB,NZ,NY,NX)=0.0 + CPOOL4(K,NB,NZ,NY,NX)=0.0 + ENDIF + ARLFB(NB,NZ,NY,NX)=AMAX1(0.0,ARLFB(NB,NZ,NY,NX) + 2-ARLF(K,NB,NZ,NY,NX)) + WTLFB(NB,NZ,NY,NX)=AMAX1(0.0,WTLFB(NB,NZ,NY,NX) + 2-WGLF(K,NB,NZ,NY,NX)) + WTLFBN(NB,NZ,NY,NX)=AMAX1(0.0,WTLFBN(NB,NZ,NY,NX) + 2-WGLFN(K,NB,NZ,NY,NX)) + WTLFBP(NB,NZ,NY,NX)=AMAX1(0.0,WTLFBP(NB,NZ,NY,NX) + 2-WGLFP(K,NB,NZ,NY,NX)) + ARLF(K,NB,NZ,NY,NX)=0.0 + WGLF(K,NB,NZ,NY,NX)=0.0 + WGLFN(K,NB,NZ,NY,NX)=0.0 + WGLFP(K,NB,NZ,NY,NX)=0.0 + WSLF(K,NB,NZ,NY,NX)=0.0 + IF(WTLFB(NB,NZ,NY,NX).LT.ZEROL(NZ,NY,NX))THEN + WTLFB(NB,NZ,NY,NX)=0.0 + ARLFB(NB,NZ,NY,NX)=0.0 + ENDIF + ENDIF +C +C REMOBILIZATION OF SHEATHS OR PETIOLE C,N,P DEPENDS ON +C NON-STRUCTURAL C:N:P +C +564 CONTINUE + IF(WGSHE(K,NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + RCCS=RCCC*WGSHE(K,NB,NZ,NY,NX) + RCZS=WGSHN(K,NB,NZ,NY,NX)*(RCCN+(1.0-RCCN)*RCCC) + RCPS=WGSHP(K,NB,NZ,NY,NX)*(RCCP+(1.0-RCCP)*RCCC) +C +C FRACTION OF REMOBILIZATION THAT CAN BE MET FROM CURRENT SHEATH +C OR PETIOLE +C + IF(RCCS.GT.ZEROP(NZ,NY,NX))THEN + FSNCS=AMAX1(0.0,AMIN1(1.0,SNCSH/RCCS)) + ELSE + FSNCS=1.0 + ENDIF + FSNAS=1.0*FSNCS +C +C NON-REMOBILIZABLE C,N,P BECOMES LITTERFALL ALLOCATED +C TO FRACTIONS SET IN 'STARTQ' +C + DO 6320 M=1,4 + CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX)+CFOPC(5,M,NZ,NY,NX) + 2*FSNCS*(WGSHE(K,NB,NZ,NY,NX)-RCCS)*FWODB(0) + ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX)+CFOPN(5,M,NZ,NY,NX) + 2*FSNCS*(WGSHN(K,NB,NZ,NY,NX)-RCZS)*FWODSN(0) + PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX)+CFOPP(5,M,NZ,NY,NX) + 2*FSNCS*(WGSHP(K,NB,NZ,NY,NX)-RCPS)*FWODSP(0) + CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX)+CFOPC(2,M,NZ,NY,NX) + 2*FSNCS*(WGSHE(K,NB,NZ,NY,NX)-RCCS)*FWODB(1) + ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX)+CFOPN(2,M,NZ,NY,NX) + 2*FSNCS*(WGSHN(K,NB,NZ,NY,NX)-RCZS)*FWODSN(1) + PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX)+CFOPP(2,M,NZ,NY,NX) + 2*FSNCS*(WGSHP(K,NB,NZ,NY,NX)-RCPS)*FWODSP(1) +6320 CONTINUE +C +C UPDATE STATE VARIABLES FOR REMOBILIZATION AND LITTERFALL +C + WTSHEB(NB,NZ,NY,NX)=AMAX1(0.0,WTSHEB(NB,NZ,NY,NX) + 2-FSNCS*WGSHE(K,NB,NZ,NY,NX)) + WTSHBN(NB,NZ,NY,NX)=AMAX1(0.0,WTSHBN(NB,NZ,NY,NX) + 2-FSNCS*WGSHN(K,NB,NZ,NY,NX)) + WTSHBP(NB,NZ,NY,NX)=AMAX1(0.0,WTSHBP(NB,NZ,NY,NX) + 2-FSNCS*WGSHP(K,NB,NZ,NY,NX)) + HTSHE(K,NB,NZ,NY,NX)=HTSHE(K,NB,NZ,NY,NX) + 2-FSNAS*HTSHE(K,NB,NZ,NY,NX) + WGSHE(K,NB,NZ,NY,NX)=WGSHE(K,NB,NZ,NY,NX) + 2-FSNCS*WGSHE(K,NB,NZ,NY,NX) + WGSHN(K,NB,NZ,NY,NX)=WGSHN(K,NB,NZ,NY,NX) + 2-FSNCS*WGSHN(K,NB,NZ,NY,NX) + WGSHP(K,NB,NZ,NY,NX)=WGSHP(K,NB,NZ,NY,NX) + 2-FSNCS*WGSHP(K,NB,NZ,NY,NX) + WSSHE(K,NB,NZ,NY,NX)=AMAX1(0.0,WSSHE(K,NB,NZ,NY,NX) + 2-FSNCS*AMAX1(WGSHN(K,NB,NZ,NY,NX)*CNWS(NZ,NY,NX) + 3,WGSHP(K,NB,NZ,NY,NX)*CPWS(NZ,NY,NX))) +C +C FRACTION OF C REMOBILIZED FOR GROWTH RESPIRATION < 0 IS +C RESPIRED AND NOT TRANSFERRED TO NON-STRUCTURAL POOLS +C + CPOOL(NB,NZ,NY,NX)=CPOOL(NB,NZ,NY,NX)+FSNCS*RCCS*SNCF + ZPOOL(NB,NZ,NY,NX)=ZPOOL(NB,NZ,NY,NX)+FSNCS*RCZS + PPOOL(NB,NZ,NY,NX)=PPOOL(NB,NZ,NY,NX)+FSNCS*RCPS + SNCSH=SNCSH-FSNCS*RCCS + SNCT=SNCT-FSNCS*RCCS + IF(WTSHEB(NB,NZ,NY,NX).LT.ZEROL(NZ,NY,NX))THEN + WTSHEB(NB,NZ,NY,NX)=0.0 + ENDIF +C +C EXIT LOOP IF REMOBILIZATION REQUIREMENT HAS BEEN MET +C + IF(SNCSH.LE.ZEROP(NZ,NY,NX))GO TO 565 +C +C OTHERWISE REMAINING C,N,P IN SHEATH OR PETIOLE GOES TO LITTERFALL +C + ELSE + DO 6325 M=1,4 + CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX)+CFOPC(5,M,NZ,NY,NX) + 2*WGSHE(K,NB,NZ,NY,NX)*FWODB(0) + ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX)+CFOPN(5,M,NZ,NY,NX) + 2*WGSHN(K,NB,NZ,NY,NX)*FWODSN(0) + PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX)+CFOPP(5,M,NZ,NY,NX) + 2*WGSHP(K,NB,NZ,NY,NX)*FWODSP(0) + CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX)+CFOPC(2,M,NZ,NY,NX) + 2*WGSHE(K,NB,NZ,NY,NX)*FWODB(1) + ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX)+CFOPN(2,M,NZ,NY,NX) + 2*WGSHN(K,NB,NZ,NY,NX)*FWODSN(1) + PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX)+CFOPP(2,M,NZ,NY,NX) + 2*WGSHP(K,NB,NZ,NY,NX)*FWODSP(1) +6325 CONTINUE + WTSHEB(NB,NZ,NY,NX)=AMAX1(0.0,WTSHEB(NB,NZ,NY,NX) + 2-WGSHE(K,NB,NZ,NY,NX)) + WTSHBN(NB,NZ,NY,NX)=AMAX1(0.0,WTSHBN(NB,NZ,NY,NX) + 2-WGSHN(K,NB,NZ,NY,NX)) + WTSHBP(NB,NZ,NY,NX)=AMAX1(0.0,WTSHBP(NB,NZ,NY,NX) + 2-WGSHP(K,NB,NZ,NY,NX)) + HTSHE(K,NB,NZ,NY,NX)=0.0 + WGSHE(K,NB,NZ,NY,NX)=0.0 + WGSHN(K,NB,NZ,NY,NX)=0.0 + WGSHP(K,NB,NZ,NY,NX)=0.0 + WSSHE(K,NB,NZ,NY,NX)=0.0 + IF(WTSHEB(NB,NZ,NY,NX).LT.ZEROL(NZ,NY,NX))THEN + WTSHEB(NB,NZ,NY,NX)=0.0 + ENDIF + ENDIF +650 CONTINUE + KN=KN+1 + SNCR=SNCT*(1.0-SNCF) +C +C REMOBILIZATION OF RESERVE C +C + IF(WTRSVB(NB,NZ,NY,NX).GT.SNCR)THEN + WTRSVB(NB,NZ,NY,NX)=WTRSVB(NB,NZ,NY,NX)-SNCR + SNCR=0.0 + GO TO 565 + ENDIF +C +C REMOBILIZATION OF STALK C,N,P +C + SNCZ=FXFS*SNCR + SNCT=SNCR+SNCZ + IF(ISTYP(NZ,NY,NX).NE.0.AND.SNCT.GT.ZEROP(NZ,NY,NX) + 2.AND.WTSTKB(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + SNCF=SNCZ/SNCT + FRCC=WVSTKB(NB,NZ,NY,NX)/WTSTKB(NB,NZ,NY,NX) + RCSC=RCCC*FRCC + RCSN=RCCN*FRCC + RCSP=RCCP*FRCC + MXNOD=KVSTG(NB,NZ,NY,NX) + MNNOD=MAX(MIN(0,MAX(0,MXNOD-NNOD(NZ,NY,NX))) + 2,KVSTG(NB,NZ,NY,NX)-23) + MXNOD=MAX(MXNOD,MNNOD) + DO 1650 KK=MXNOD,MNNOD,-1 + K=MOD(KK,25) + IF(K.EQ.0.AND.KK.NE.0)K=25 +C IF(NZ.EQ.1.OR.NZ.EQ.4)THEN +C WRITE(*,2356)'WGNODE1',I,J,NZ,NB,K,KK,MXNOD,MNNOD +C 2,KSNC,RCCC,FRCC,RCSC,SNCT,WGNODE(K,NB,NZ,NY,NX) +C 3,HTNODX(K,NB,NZ,NY,NX),WTSTKB(NB,NZ,NY,NX) +C 4,CPOOL(NB,NZ,NY,NX) +C ENDIF +C +C REMOBILIZATION OF STALK C,N,P DEPENDS ON NON-STRUCTURAL C:N:P +C + IF(WGNODE(K,NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + RCCK=RCSC*WGNODE(K,NB,NZ,NY,NX) + RCZK=WGNODN(K,NB,NZ,NY,NX)*(RCSN+(1.0-RCSN)*RCSC) + RCPK=WGNODP(K,NB,NZ,NY,NX)*(RCSP+(1.0-RCSP)*RCSC) +C +C FRACTION OF CURRENT NODE TO BE REMOBILIZED +C + IF(RCCK.GT.ZEROP(NZ,NY,NX))THEN + FSNCK=AMAX1(0.0,AMIN1(1.0,SNCT/RCCK)) + ELSE + FSNCK=1.0 + ENDIF +C +C NON-REMOBILIZABLE C,N,P BECOMES LITTERFALL ALLOCATED +C TO FRACTIONS SET IN 'STARTQ' +C + DO 7310 M=1,4 + CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX)+CFOPC(3,M,NZ,NY,NX) + 2*FSNCK*(WGNODE(K,NB,NZ,NY,NX)-RCCK) + ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX)+CFOPN(3,M,NZ,NY,NX) + 2*FSNCK*(WGNODN(K,NB,NZ,NY,NX)-RCZK) + PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX)+CFOPP(3,M,NZ,NY,NX) + 2*FSNCK*(WGNODP(K,NB,NZ,NY,NX)-RCPK) +7310 CONTINUE +C +C UPDATE STATE VARIABLES FOR REMOBILIZATION AND LITTERFALL +C + WTSTKB(NB,NZ,NY,NX)=AMAX1(0.0,WTSTKB(NB,NZ,NY,NX) + 2-FSNCK*WGNODE(K,NB,NZ,NY,NX)) + WTSTBN(NB,NZ,NY,NX)=AMAX1(0.0,WTSTBN(NB,NZ,NY,NX) + 2-FSNCK*WGNODN(K,NB,NZ,NY,NX)) + WTSTBP(NB,NZ,NY,NX)=AMAX1(0.0,WTSTBP(NB,NZ,NY,NX) + 2-FSNCK*WGNODP(K,NB,NZ,NY,NX)) + HTNODE(K,NB,NZ,NY,NX)=HTNODE(K,NB,NZ,NY,NX) + 2-FSNCK*HTNODX(K,NB,NZ,NY,NX) + WGNODE(K,NB,NZ,NY,NX)=WGNODE(K,NB,NZ,NY,NX) + 2-FSNCK*WGNODE(K,NB,NZ,NY,NX) + WGNODN(K,NB,NZ,NY,NX)=WGNODN(K,NB,NZ,NY,NX) + 2-FSNCK*WGNODN(K,NB,NZ,NY,NX) + WGNODP(K,NB,NZ,NY,NX)=WGNODP(K,NB,NZ,NY,NX) + 2-FSNCK*WGNODP(K,NB,NZ,NY,NX) + HTNODX(K,NB,NZ,NY,NX)=HTNODX(K,NB,NZ,NY,NX) + 2-FSNCK*HTNODX(K,NB,NZ,NY,NX) +C +C FRACTION OF C REMOBILIZED FOR GROWTH RESPIRATION < 0 IS +C RESPIRED AND NOT TRANSFERRED TO NON-STRUCTURAL POOLS +C + WTRSVB(NB,NZ,NY,NX)=WTRSVB(NB,NZ,NY,NX)+FSNCK*RCCK*SNCF + WTRSBN(NB,NZ,NY,NX)=WTRSBN(NB,NZ,NY,NX)+FSNCK*RCZK + WTRSBP(NB,NZ,NY,NX)=WTRSBP(NB,NZ,NY,NX)+FSNCK*RCPK + SNCT=SNCT-FSNCK*RCCK +C IF(NZ.EQ.1.OR.NZ.EQ.4)THEN +C WRITE(*,2356)'WGNODE2',I,J,NZ,NB,K,KK,MXNOD,MNNOD +C 2,KSNC,RCCC,FRCC,RCSC,SNCT,WGNODE(K,NB,NZ,NY,NX) +C 3,HTNODX(K,NB,NZ,NY,NX),WTSTKB(NB,NZ,NY,NX) +C 4,CPOOL(NB,NZ,NY,NX) +2356 FORMAT(A8,9I4,12E16.8) +C ENDIF +C +C EXIT LOOP IF REMOBILIZATION REQUIREMENT HAS BEEN MET +C + IF(SNCT.LE.ZEROP(NZ,NY,NX))GO TO 565 +C +C OTHERWISE REMAINING C,N,P IN NODE GOES TO LITTERFALL +C + ELSE + DO 7315 M=1,4 + CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX)+CFOPC(3,M,NZ,NY,NX) + 2*WGNODE(K,NB,NZ,NY,NX) + ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX)+CFOPN(3,M,NZ,NY,NX) + 2*WGNODN(K,NB,NZ,NY,NX) + PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX)+CFOPP(3,M,NZ,NY,NX) + 2*WGNODP(K,NB,NZ,NY,NX) +7315 CONTINUE + WTSTKB(NB,NZ,NY,NX)=AMAX1(0.0,WTSTKB(NB,NZ,NY,NX) + 2-WGNODE(K,NB,NZ,NY,NX)) + WTSTBN(NB,NZ,NY,NX)=AMAX1(0.0,WTSTBN(NB,NZ,NY,NX) + 2-WGNODN(K,NB,NZ,NY,NX)) + WTSTBP(NB,NZ,NY,NX)=AMAX1(0.0,WTSTBP(NB,NZ,NY,NX) + 2-WGNODP(K,NB,NZ,NY,NX)) + HTNODE(K,NB,NZ,NY,NX)=HTNODE(K,NB,NZ,NY,NX) + 2-HTNODX(K,NB,NZ,NY,NX) + WGNODE(K,NB,NZ,NY,NX)=0.0 + WGNODN(K,NB,NZ,NY,NX)=0.0 + WGNODP(K,NB,NZ,NY,NX)=0.0 + HTNODX(K,NB,NZ,NY,NX)=0.0 + ENDIF +1650 CONTINUE +C +C RESIDUAL STALK +C + IF(WTSTXB(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + RCCK=RCSC*WTSTXB(NB,NZ,NY,NX) + RCZK=WTSTXN(NB,NZ,NY,NX)*(RCSN+(1.0-RCSN)*RCSC) + RCPK=WTSTXP(NB,NZ,NY,NX)*(RCSP+(1.0-RCSP)*RCSC) +C +C FRACTION OF RESIDUAL STALK TO BE REMOBILIZED +C + IF(RCCK.GT.ZEROP(NZ,NY,NX))THEN + FSNCR=AMAX1(0.0,AMIN1(1.0,SNCT/RCCK)) + ELSE + FSNCR=1.0 + ENDIF +C +C NON-REMOBILIZABLE C,N,P BECOMES LITTERFALL ALLOCATED +C TO FRACTIONS SET IN 'STARTQ' +C + DO 8310 M=1,4 + CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX)+CFOPC(3,M,NZ,NY,NX) + 2*FSNCR*(WTSTXB(NB,NZ,NY,NX)-RCCK) + ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX)+CFOPN(3,M,NZ,NY,NX) + 2*FSNCR*(WTSTXN(NB,NZ,NY,NX)-RCZK) + PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX)+CFOPP(3,M,NZ,NY,NX) + 2*FSNCR*(WTSTXP(NB,NZ,NY,NX)-RCPK) +8310 CONTINUE +C +C UPDATE STATE VARIABLES FOR REMOBILIZATION AND LITTERFALL +C + WTSTKB(NB,NZ,NY,NX)=AMAX1(0.0,WTSTKB(NB,NZ,NY,NX) + 2-FSNCR*WTSTXB(NB,NZ,NY,NX)) + WTSTBN(NB,NZ,NY,NX)=AMAX1(0.0,WTSTBN(NB,NZ,NY,NX) + 2-FSNCR*WTSTXN(NB,NZ,NY,NX)) + WTSTBP(NB,NZ,NY,NX)=AMAX1(0.0,WTSTBP(NB,NZ,NY,NX) + 2-FSNCR*WTSTXP(NB,NZ,NY,NX)) + WTSTXB(NB,NZ,NY,NX)=AMAX1(0.0,WTSTXB(NB,NZ,NY,NX) + 2-FSNCR*WTSTXB(NB,NZ,NY,NX)) + WTSTXN(NB,NZ,NY,NX)=AMAX1(0.0,WTSTXN(NB,NZ,NY,NX) + 2-FSNCR*WTSTXN(NB,NZ,NY,NX)) + WTSTXP(NB,NZ,NY,NX)=AMAX1(0.0,WTSTXP(NB,NZ,NY,NX) + 2-FSNCR*WTSTXP(NB,NZ,NY,NX)) + HTNODZ=0.0 + DO 8320 K=0,25 + HTNODZ=AMAX1(HTNODZ,HTNODE(K,NB,NZ,NY,NX)) +8320 CONTINUE + HTNODZ=AMAX1(0.0,HTNODZ-FSNCR*HTNODZ) + DO 8325 K=0,25 + HTNODE(K,NB,NZ,NY,NX)=AMIN1(HTNODZ,HTNODE(K,NB,NZ,NY,NX)) +8325 CONTINUE +C +C FRACTION OF C REMOBILIZED FOR GROWTH RESPIRATION < 0 IS +C RESPIRED AND NOT TRANSFERRED TO NON-STRUCTURAL POOLS +C + WTRSVB(NB,NZ,NY,NX)=WTRSVB(NB,NZ,NY,NX)+FSNCR*RCCK*SNCF + WTRSBN(NB,NZ,NY,NX)=WTRSBN(NB,NZ,NY,NX)+FSNCR*RCZK + WTRSBP(NB,NZ,NY,NX)=WTRSBP(NB,NZ,NY,NX)+FSNCR*RCPK + SNCT=SNCT-FSNCR*RCCK + ENDIF +C IF(NZ.EQ.1.OR.NZ.EQ.4)THEN +C WRITE(*,2357)'WTSTXB1',I,J,NZ,NB,K,FSNCR,SNCT +C 3,WTSTKB(NB,NZ,NY,NX),WTSTXB(NB,NZ,NY,NX) +C 4,(HTNODE(K,NB,NZ,NY,NX),K=0,25) +2357 FORMAT(A8,5I4,40E12.4) +C ENDIF +C +C EXIT LOOP IF REMOBILIZATION REQUIREMENT HAS BEEN MET +C + IF(SNCT.LE.ZEROP(NZ,NY,NX))GO TO 565 +C +C OTHERWISE REMAINING C,N,P IN NODE GOES TO LITTERFALL +C + ELSE + DO 8315 M=1,4 + CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX)+CFOPC(3,M,NZ,NY,NX) + 2*WTSTXB(NB,NZ,NY,NX) + ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX)+CFOPN(3,M,NZ,NY,NX) + 2*WTSTXN(NB,NZ,NY,NX) + PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX)+CFOPP(3,M,NZ,NY,NX) + 2*WTSTXP(NB,NZ,NY,NX) +8315 CONTINUE + WTSTKB(NB,NZ,NY,NX)=AMAX1(0.0,WTSTKB(NB,NZ,NY,NX) + 2-WTSTXB(NB,NZ,NY,NX)) + WTSTBN(NB,NZ,NY,NX)=AMAX1(0.0,WTSTBN(NB,NZ,NY,NX) + 2-WTSTXN(NB,NZ,NY,NX)) + WTSTBP(NB,NZ,NY,NX)=AMAX1(0.0,WTSTBP(NB,NZ,NY,NX) + 2-WTSTXP(NB,NZ,NY,NX)) + WTSTXB(NB,NZ,NY,NX)=0.0 + WTSTXN(NB,NZ,NY,NX)=0.0 + WTSTXP(NB,NZ,NY,NX)=0.0 +C MXNOD=KVSTG(NB,NZ,NY,NX) +C MNNOD=MAX(MIN(0,MAX(0,MXNOD-NNOD(NZ,NY,NX))) +C 2,KVSTG(NB,NZ,NY,NX)-23) +C MXNOD=MAX(MXNOD,MNNOD) +C DO 1660 KK=MXNOD,MNNOD,-1 +C K=MOD(KK,25) +C IF(K.EQ.0.AND.KK.NE.0)K=25 +C HTNODE(K,NB,NZ,NY,NX)=0.0 +C HTNODX(K,NB,NZ,NY,NX)=0.0 +1660 CONTINUE +C IF(NZ.EQ.2)THEN +C WRITE(*,2357)'WTSTXB2',I,J,NZ,NB,FSNCR,SNCT +C 3,HTNODX(K,NB,NZ,NY,NX),WTSTKB(NB,NZ,NY,NX) +C 4,WTSTXB(NB,NZ,NY,NX),WTSTBN(NB,NZ,NY,NX),WTSTBP(NB,NZ,NY,NX) +C ENDIF + ENDIF +C +C REMOBILIZATION OF STORAGE C,N,P +C + SNCR=SNCT/(1.0+FXFS) + IF(WTRVC(NZ,NY,NX).GT.SNCR)THEN + WTRVC(NZ,NY,NX)=WTRVC(NZ,NY,NX)-SNCR + SNCR=0.0 + GO TO 565 + ELSE + IDTHB(NB,NZ,NY,NX)=1 + ENDIF +565 CONTINUE +575 CONTINUE + ENDIF +595 CONTINUE +C +C DEATH IF MAIN STALK OF TREE DIES +C + IF(IBTYP(NZ,NY,NX).NE.0.AND.IGTYP(NZ,NY,NX).GT.1 + 2.AND.IDTHB(NB1(NZ,NY,NX),NZ,NY,NX).EQ.1)IDTHB(NB,NZ,NY,NX)=1 +C +C REMOBILIZE EXCESS LEAF STRUCTURAL N,P +C + KVSTGX=MAX(0,KVSTG(NB,NZ,NY,NX)-24) + DO 495 KK=KVSTGX,KVSTG(NB,NZ,NY,NX) + K=MOD(KK,25) + IF(K.EQ.0.AND.KK.NE.0)K=25 + IF(WGLF(K,NB,NZ,NY,NX).GT.0.0)THEN + CPOOLT=WGLF(K,NB,NZ,NY,NX)+CPOOL(NB,NZ,NY,NX) + IF(CPOOLT.GT.ZEROP(NZ,NY,NX))THEN + ZPOOLD=WGLFN(K,NB,NZ,NY,NX)*CPOOL(NB,NZ,NY,NX) + 2-ZPOOL(NB,NZ,NY,NX)*WGLF(K,NB,NZ,NY,NX) + XFRN1=AMAX1(0.0,AMIN1(1.0E-03*ZPOOLD/CPOOLT,WGLFN(K,NB,NZ,NY,NX) + 2-ZPLFM*CNLFB*WGLF(K,NB,NZ,NY,NX))) + PPOOLD=WGLFP(K,NB,NZ,NY,NX)*CPOOL(NB,NZ,NY,NX) + 2-PPOOL(NB,NZ,NY,NX)*WGLF(K,NB,NZ,NY,NX) + XFRP1=AMAX1(0.0,AMIN1(1.0E-03*PPOOLD/CPOOLT,WGLFP(K,NB,NZ,NY,NX) + 2-ZPLFM*CPLFB*WGLF(K,NB,NZ,NY,NX))) + XFRN=AMAX1(XFRN1,10.0*XFRP1) + XFRP=AMAX1(XFRP1,0.10*XFRN1) + WGLFN(K,NB,NZ,NY,NX)=WGLFN(K,NB,NZ,NY,NX)-XFRN + WTLFBN(NB,NZ,NY,NX)=WTLFBN(NB,NZ,NY,NX)-XFRN + ZPOOL(NB,NZ,NY,NX)=ZPOOL(NB,NZ,NY,NX)+XFRN + WGLFP(K,NB,NZ,NY,NX)=WGLFP(K,NB,NZ,NY,NX)-XFRP + WTLFBP(NB,NZ,NY,NX)=WTLFBP(NB,NZ,NY,NX)-XFRP + PPOOL(NB,NZ,NY,NX)=PPOOL(NB,NZ,NY,NX)+XFRP + WSLF(K,NB,NZ,NY,NX)=AMAX1(0.0,WSLF(K,NB,NZ,NY,NX) + 2-AMAX1(XFRN*CNWS(NZ,NY,NX),XFRP*CPWS(NZ,NY,NX))) + ENDIF + ENDIF +495 CONTINUE +C +C ALLOCATION OF LEAF AREA TO CANOPY LAYERS +C + KVSTGN(NB,NZ,NY,NX)=0 + IF(HTCTL(NZ,NY,NX).LE.SDPTH(NZ,NY,NX) + 2.AND.ARLF(0,NB1(NZ,NY,NX),NZ,NY,NX).GT.0.0)THEN + XLGLF=SQRT(1.0E+02*ARLF(0,NB1(NZ,NY,NX),NZ,NY,NX) + 2/PP(NZ,NY,NX)) + HTCTL(NZ,NY,NX)=XLGLF+HTSHE(0,NB1(NZ,NY,NX),NZ,NY,NX) + 2+HTNODE(0,NB1(NZ,NY,NX),NZ,NY,NX) + ENDIF +C +C IF CANOPY HAS EMERGED +C + IF(HTCTL(NZ,NY,NX).GT.SDPTH(NZ,NY,NX))THEN + DO 540 K=0,25 + DO 540 L=1,JC + ARLFL(L,K,NB,NZ,NY,NX)=0.0 + WGLFL(L,K,NB,NZ,NY,NX)=0.0 + WGLFLN(L,K,NB,NZ,NY,NX)=0.0 + WGLFLP(L,K,NB,NZ,NY,NX)=0.0 +540 CONTINUE + DO 535 L=1,JC + ARSTK(L,NB,NZ,NY,NX)=0.0 +535 CONTINUE +C +C BRANCH HEIGHT +C + IF(IBTYP(NZ,NY,NX).NE.0.AND.IGTYP(NZ,NY,NX).GT.1)THEN + IF(NB.NE.NB1(NZ,NY,NX))THEN + KVSTG1=MAX(1,KVSTG(NB1(NZ,NY,NX),NZ,NY,NX)-24) + IF(NBTB(NB,NZ,NY,NX).GE.KVSTG1)THEN + K=MOD(NBTB(NB,NZ,NY,NX),25) + IF(K.EQ.0.AND.KK.NE.0)K=25 + HTBR=HTNODE(K,NB1(NZ,NY,NX),NZ,NY,NX) + ELSE + HTBR=0.0 + ENDIF + ELSE + HTBR=0.0 + ENDIF + ELSE + HTBR=0.0 + ENDIF + KVSTGX=MAX(0,KVSTG(NB,NZ,NY,NX)-24) +C +C FOR ALL LEAFED NODES +C + DO 560 KK=KVSTGX,KVSTG(NB,NZ,NY,NX) + K=MOD(KK,25) + IF(K.EQ.0.AND.KK.NE.0)K=25 +C +C HEIGHT OF STALK INTERNODE + SHEATH OR PETIOLE +C AND LENGTH OF LEAF +C + HTSTK=HTBR+HTNODE(K,NB,NZ,NY,NX) + HTLF=HTSTK+HTSHE(K,NB,NZ,NY,NX) + XLGLF=AMAX1(0.0,SQRT(WDLF(NZ,NY,NX)*AMAX1(0.0 + 2,ARLF(K,NB,NZ,NY,NX))/(PP(NZ,NY,NX)*FNOD(NZ,NY,NX)))) + TLGLF=0.0 +C +C ALLOCATE FRACTIONS OF LEAF IN EACH INCLINATION CLASS +C FROM HIGHEST TO LOWEST TO CANOPY LAYER +C + DO 555 N=4,1,-1 + YLGLF=ZSIN(N)*CLASS(N,NZ,NY,NX)*XLGLF + HTLFL=AMIN1(ZCX(NZ,NY,NX)+0.01-YLGLF,HTLF+TLGLF) + HTLFU=AMIN1(ZCX(NZ,NY,NX)+0.01,HTLFL+YLGLF) + LU=0 + LL=0 + DO 550 L=JC,1,-1 + IF(LU.EQ.1.AND.LL.EQ.1)GO TO 551 + IF((HTLFU.GT.ZL(L-1,NY,NX).OR.ZL(L-1,NY,NX).LT.ZERO) + 2.AND.LU.EQ.0)THEN + LHTLFU=MAX(1,L) + LU=1 + ENDIF + IF((HTLFL.GT.ZL(L-1,NY,NX).OR.ZL(L-1,NY,NX).LT.ZERO) + 2.AND.LL.EQ.0)THEN + LHTLFL=MAX(1,L) + LL=1 + ENDIF +550 CONTINUE +551 CONTINUE + DO 570 L=LHTLFL,LHTLFU + IF(LHTLFU.EQ.LHTLFL)THEN + FRACL=CLASS(N,NZ,NY,NX) + ELSEIF(HTLFU.GT.HTLFL.AND.ZL(L,NY,NX).GT.HTLFL)THEN + FRACL=CLASS(N,NZ,NY,NX)*(AMIN1(HTLFU,ZL(L,NY,NX)) + 2-AMAX1(HTLFL,ZL(L-1,NY,NX)))/(HTLFU-HTLFL) + ELSE + FRACL=CLASS(N,NZ,NY,NX) + ENDIF + YARLF=FRACL*ARLF(K,NB,NZ,NY,NX) + YWGLF=FRACL*WGLF(K,NB,NZ,NY,NX) + YWGLFN=FRACL*WGLFN(K,NB,NZ,NY,NX) + YWGLFP=FRACL*WGLFP(K,NB,NZ,NY,NX) +C +C ACCUMULATE LAYER LEAF AREAS, C, N AND P CONTENTS +C + ARLFL(L,K,NB,NZ,NY,NX)=ARLFL(L,K,NB,NZ,NY,NX)+YARLF + WGLFL(L,K,NB,NZ,NY,NX)=WGLFL(L,K,NB,NZ,NY,NX)+YWGLF + WGLFLN(L,K,NB,NZ,NY,NX)=WGLFLN(L,K,NB,NZ,NY,NX)+YWGLFN + WGLFLP(L,K,NB,NZ,NY,NX)=WGLFLP(L,K,NB,NZ,NY,NX)+YWGLFP + ARLFV(L,NZ,NY,NX)=ARLFV(L,NZ,NY,NX)+YARLF + WGLFV(L,NZ,NY,NX)=WGLFV(L,NZ,NY,NX)+YWGLF +C IF(J.EQ.12)THEN +C WRITE(*,4813)'GRO',I,J,NZ,NB,K,KK,L,LHTLFL,LHTLFU +C 2,FRACL,HTLFU,HTLFL,ZL(L-1,NY,NX),ARLFB(NB,NZ,NY,NX) +C 3,ARLF(K,NB,NZ,NY,NX),WTLFB(NB,NZ,NY,NX),WGLF(K,NB,NZ,NY,NX) +C 4,ARLFP(NZ,NY,NX),ZL(L,NY,NX),HTLF,TLGLF,HTSTK,HTBR +C 4,HTNODE(K,NB,NZ,NY,NX),HTSHE(K,NB,NZ,NY,NX),YLGLF +C 5,ZSIN(N),CLASS(N,NZ,NY,NX),XLGLF,ZC(NZ,NY,NX) +C 6,ZCX(NZ,NY,NX) +4813 FORMAT(A8,9I4,30E12.4) +C ENDIF +570 CONTINUE + TLGLF=TLGLF+YLGLF + ZC(NZ,NY,NX)=AMAX1(ZC(NZ,NY,NX),HTLFU) +555 CONTINUE + IF(WSSHE(K,NB,NZ,NY,NX).GT.0.0)THEN + IF(KVSTGN(NB,NZ,NY,NX).EQ.0)KVSTGN(NB,NZ,NY,NX) + 2=MIN(KK,KVSTG(NB,NZ,NY,NX)) + ENDIF +560 CONTINUE + IF(KVSTGN(NB,NZ,NY,NX).EQ.0)KVSTGN(NB,NZ,NY,NX) + 2=KVSTG(NB,NZ,NY,NX) + K1=MOD(KVSTG(NB,NZ,NY,NX),25) + IF(K1.EQ.0.AND.KVSTG(NB,NZ,NY,NX).NE.0)K1=25 + K2=MOD(KVSTG(NB,NZ,NY,NX)-1,25) + IF(K2.EQ.0.AND.KVSTG(NB,NZ,NY,NX)-1.NE.0)K2=25 + IF(HTNODE(K1,NB,NZ,NY,NX).EQ.0.0)THEN + HTNODE(K1,NB,NZ,NY,NX)=HTNODE(K2,NB,NZ,NY,NX) + ENDIF + HTLFB=HTBR + 2+AMAX1(0.0,HTNODE(K1,NB,NZ,NY,NX)) +C +C ALLOCATE STALK SURFACE AREA TO CANOPY LAYERS +C +C IF(NZ.EQ.1)THEN +C WRITE(*,6679)'K1',I,J,NZ,NB,K1,KVSTG(NB,NZ,NY,NX) +C 2,HTNODE(K1,NB,NZ,NY,NX) +6679 FORMAT(A8,6I4,12E12.4) +C ENDIF + IF(HTNODE(K1,NB,NZ,NY,NX).GT.0.0)THEN + LU=0 + LL=0 + DO 545 L=JC,1,-1 + IF(LU.EQ.1.AND.LL.EQ.1)GO TO 546 + IF((HTLFB.GT.ZL(L-1,NY,NX).OR.ZL(L-1,NY,NX).LT.ZERO) + 2.AND.LU.EQ.0)THEN + LHTBRU=MAX(1,L) + LU=1 + ENDIF + IF((HTBR.GT.ZL(L-1,NY,NX).OR.ZL(L-1,NY,NX) + 2.LT.ZERO).AND.LL.EQ.0)THEN + LHTBRL=MAX(1,L) + LL=1 + ENDIF +545 CONTINUE +546 CONTINUE + RSTK=SQRT(VSTK*(AMAX1(0.0,WTSTKB(NB,NZ,NY,NX))/PP(NZ,NY,NX)) + 3/(3.1416*HTNODE(K1,NB,NZ,NY,NX))) + ARSTKB(NB)=3.1416*HTNODE(K1,NB,NZ,NY,NX)*PP(NZ,NY,NX)*RSTK + IF(ISTYP(NZ,NY,NX).EQ.0)THEN + WVSTKB(NB,NZ,NY,NX)=WTSTKB(NB,NZ,NY,NX) + ELSE + ZSTK=AMIN1(ZSTX,FSTK*RSTK) + ASTV=3.1416*(2.0*RSTK*ZSTK-ZSTK**2) + WVSTKB(NB,NZ,NY,NX)=ASTV/VSTK*HTNODE(K1,NB,NZ,NY,NX)*PP(NZ,NY,NX) + ENDIF +C IF(NZ.EQ.1)THEN +C WRITE(*,6677)'WVSTK',I,J,NZ,NB,WVSTKB(NB,NZ,NY,NX) +C 2,ASTV,VSTK,HTNODE(K1,NB,NZ,NY,NX),PP(NZ,NY,NX) +6677 FORMAT(A8,4I4,12E12.4) +C ENDIF + DO 445 L=LHTBRL,LHTBRU + IF(HTLFB.GT.HTBR)THEN + IF(HTLFB.GT.ZL(L-1,NY,NX))THEN + FRACL=(AMIN1(HTLFB,ZL(L,NY,NX))-AMAX1(HTBR + 2,ZL(L-1,NY,NX)))/(HTLFB-HTBR) + ELSE + FRACL=0.0 + ENDIF + ELSE + FRACL=1.0 + ENDIF + ARSTK(L,NB,NZ,NY,NX)=FRACL*ARSTKB(NB) +445 CONTINUE + ELSE + WVSTKB(NB,NZ,NY,NX)=0.0 + DO 450 L=1,JC + ARSTK(L,NB,NZ,NY,NX)=0.0 +450 CONTINUE + ENDIF + ELSE + WVSTKB(NB,NZ,NY,NX)=0.0 + DO 455 L=1,JC + ARSTK(L,NB,NZ,NY,NX)=0.0 +455 CONTINUE + ENDIF +C +C ALLOCATE LEAF AREA TO INCLINATION CLASSES ACCORDING TO +C DISTRIBUTION ENTERED IN 'READQ' ASSUMING AZIMUTH IS UNIFORM +C + IF(SSINN(NY,NX).GT.0.0)THEN + DO 900 K=1,25 + DO 900 L=1,JC + DO 900 N=1,4 + SURF(N,L,K,NB,NZ,NY,NX)=0.0 +900 CONTINUE +C ARLFXB=0.0 +C ARLFXL=0.0 +C SURFXX=0.0 + DO 500 K=1,25 +C ARLFXB=ARLFXB+ARLF(K,NB,NZ,NY,NX) + IF(ARLF(K,NB,NZ,NY,NX).GT.0.0 + 2.AND.ZC(NZ,NY,NX).GT.DPTHS(NY,NX))THEN + DO 700 L=JC,1,-1 +C ARLFXL=ARLFXL+ARLFL(L,K,NB,NZ,NY,NX) + DO 800 N=1,4 + SURF(N,L,K,NB,NZ,NY,NX)=AMAX1(0.0,CLASS(N,NZ,NY,NX) + 2*0.25*ARLFL(L,K,NB,NZ,NY,NX)) +C SURFXX=SURFXX+SURF(N,L,K,NB,NZ,NY,NX) +C IF(I.EQ.151.AND.(NZ.EQ.1.OR.NZ.EQ.4))THEN +C WRITE(*,6363)'SURF',I,J,NX,NY,NZ,NB,K,L,N +C 2,ARLFL(L,K,NB,NZ,NY,NX) +C 2,SURF(N,L,K,NB,NZ,NY,NX),CLASS(N,NZ,NY,NX),ARLF(K,NB,NZ,NY,NX) +C 3,DPTHS(NY,NX),ARLFXB,ARLFXL,SURFXX,ARLF(0,NB,NZ,NY,NX) +C 4,ARLFB(NB,NZ,NY,NX) +6363 FORMAT(A8,9I4,12E16.8) +C ENDIF +800 CONTINUE +700 CONTINUE + ENDIF +500 CONTINUE +C +C ALLOCATE STALK AREA TO INCLINATION CLASSES ACCORDING TO +C BRANCH ANGLE ENTERED IN 'READQ' ASSUMING AZIMUTH IS UNIFORM +C + DO 910 L=1,JC + DO 910 N=1,4 + SURFB(N,L,NB,NZ,NY,NX)=0.0 +910 CONTINUE + IF(NB.EQ.NB1(NZ,NY,NX))THEN + N=4 + ELSE + N=MIN(4,INT(ASIN(ANGBR(NZ,NY,NX))/0.3927)+1) + ENDIF + DO 710 L=JC,1,-1 + SURFB(N,L,NB,NZ,NY,NX)=0.25*ARSTK(L,NB,NZ,NY,NX) +710 CONTINUE + ENDIF +C +C SET MAXIMUM GRAIN NUMBER FROM SHOOT MASS BEFORE ANTHESIS +C + IF(IDAY(3,NB,NZ,NY,NX).NE.0.AND.IDAY(6,NB,NZ,NY,NX).EQ.0)THEN + GRNXB(NB,NZ,NY,NX)=GRNXB(NB,NZ,NY,NX) + 2+STMX(NZ,NY,NX)*AMAX1(0.0,GROSTK) +C WRITE(*,4246)'GRNX',I,J,NZ,NB,IDAY(3,NB,NZ,NY,NX) +C 2,GRNXB(NB,NZ,NY,NX),STMX(NZ,NY,NX),CGROS,GROSTK + ENDIF +C +C SET FINAL GRAIN NUMBER AND MAXIMUM GRAIN SIZE FROM C,N,P +C NON-STRUCTURAL POOLS AFTER ANTHESIS +C + IF(IDAY(6,NB,NZ,NY,NX).NE.0.AND.IDAY(9,NB,NZ,NY,NX).EQ.0)THEN + SET=AMIN1(CCPOLB(NB,NZ,NY,NX)/(CCPOLB(NB,NZ,NY,NX)+SETC) + 2,CZPOLB(NB,NZ,NY,NX)/(CZPOLB(NB,NZ,NY,NX)+SETN) + 3,CPPOLB(NB,NZ,NY,NX)/(CPPOLB(NB,NZ,NY,NX)+SETP)) + IF(TCC(NZ,NY,NX).LT.CTC(NZ,NY,NX))THEN + IF(IDAY(7,NB,NZ,NY,NX).EQ.0)THEN + FGRNX=0.002*(CTC(NZ,NY,NX)-TCC(NZ,NY,NX)) + ELSEIF(IDAY(8,NB,NZ,NY,NX).EQ.0)THEN + FGRNX=0.002*(CTC(NZ,NY,NX)-TCC(NZ,NY,NX)) + ELSE + FGRNX=0.0 + ENDIF + ELSEIF(TCC(NZ,NY,NX).GT.HTC(NZ,NY,NX))THEN + IF(IDAY(7,NB,NZ,NY,NX).EQ.0)THEN + FGRNX=0.002*(TCC(NZ,NY,NX)-HTC(NZ,NY,NX)) + ELSEIF(IDAY(8,NB,NZ,NY,NX).EQ.0)THEN + FGRNX=0.002*(TCC(NZ,NY,NX)-HTC(NZ,NY,NX)) + ELSE + FGRNX=0.0 + ENDIF + ELSE + FGRNX=0.0 + ENDIF + IF(IDAY(6,NB,NZ,NY,NX).NE.0.AND.IDAY(8,NB,NZ,NY,NX).EQ.0)THEN +C GRNXB(NB,NZ,NY,NX)=GRNXB(NB,NZ,NY,NX)*FGRNX + GRNOB(NB,NZ,NY,NX)=AMIN1(SDMX(NZ,NY,NX)*GRNXB(NB,NZ,NY,NX) + 2,GRNOB(NB,NZ,NY,NX)+SDMX(NZ,NY,NX)*GRNXB(NB,NZ,NY,NX) + 3*SET*DGSTGF(NB,NZ,NY,NX)-FGRNX*GRNOB(NB,NZ,NY,NX)) +C IF(FGRNX.LT.1.0)THEN +C WRITE(*,4246)'GRNO',I,J,NZ,NB,IDAY(7,NB,NZ,NY,NX),TCC(NZ,NY,NX) +C 2,HTC(NZ,NY,NX),FGRNX,GRNXB(NB,NZ,NY,NX),GRNOB(NB,NZ,NY,NX) +C 3,SET,CCPOLB(NB,NZ,NY,NX),CZPOLB(NB,NZ,NY,NX) +C 4,CPPOLB(NB,NZ,NY,NX) +4246 FORMAT(A8,5I4,20E12.4) +C ENDIF + ENDIF + IF(IDAY(7,NB,NZ,NY,NX).NE.0.AND.IDAY(9,NB,NZ,NY,NX).EQ.0)THEN + GRMXB=GRMX(NZ,NY,NX)*SQRT(1.0-FGRNX) + GRWTB(NB,NZ,NY,NX)=AMIN1(GRMX(NZ,NY,NX),GRWTB(NB,NZ,NY,NX) + 2+GRMXB*AMAX1(0.50,SQRT(SET))*DGSTGF(NB,NZ,NY,NX)) +C IF(FGRNX.LT.1.0)THEN +C WRITE(*,4246)'GRWT',I,J,NZ,NB,IDAY(8,NB,NZ,NY,NX),TCC(NZ,NY,NX) +C 2,HTC(NZ,NY,NX),FGRNX,GRMX(NZ,NY,NX),GRWTB(NB,NZ,NY,NX) +C ENDIF + ENDIF + ENDIF +C +C GRAIN FILL BY TRANSLOCATION FROM STALK RESERVES +C UNTIL GRAIN SINK (=FINAL GRAIN NUMBER X MAXIMUM +C GRAIN SIZE) IS FILLED OR RESERVES ARE EXHAUSTED +C + IF(IDAY(7,NB,NZ,NY,NX).NE.0)THEN + IF(WTGRB(NB,NZ,NY,NX).GE.GRWTB(NB,NZ,NY,NX) + 2*GRNOB(NB,NZ,NY,NX))THEN + GROLM=0.0 + ELSEIF(IRTYP(NZ,NY,NX).EQ.0)THEN + GROLM=AMAX1(0.0,GFILL(NZ,NY,NX)*GRNOB(NB,NZ,NY,NX) + 2*SQRT(TFN3(NZ,NY,NX))) + ELSE + GROLM=AMAX1(0.0,GFILL(NZ,NY,NX)*GRNOB(NB,NZ,NY,NX) + 2*SQRT(TFN4(NG(NZ,NY,NX),NZ,NY,NX))) + ENDIF +C +C GRAIN FILL RATE MAY BE CONSTRAINED BY HIGH GRAIN C:N OR C:P +C + IF(WTGRBN(NB,NZ,NY,NX).LT.ZPGRM*CNGR(NZ,NY,NX) + 2*WTGRB(NB,NZ,NY,NX).OR.WTGRBP(NB,NZ,NY,NX).LT.ZPGRM + 3*CPGR(NZ,NY,NX)*WTGRB(NB,NZ,NY,NX))THEN + GROLC=0.0 + ELSE + GROLC=GROLM + ENDIF + XLOCM=AMIN1(GROLM,WTRSVB(NB,NZ,NY,NX)) + XLOCC=AMIN1(GROLC,WTRSVB(NB,NZ,NY,NX)) +C +C GRAIN N OR P FILL RATE MAY BE LIMITED BY C:N OR C:P RATIOS +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) + 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)) + XLOCN=AMIN1(XLOCM*CNGR(NZ,NY,NX) + 2,AMAX1(0.0,WTRSBN(NB,NZ,NY,NX)*ZPGRX) + 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) + 3,(WTGRB(NB,NZ,NY,NX)+XLOCC)*CPGR(NZ,NY,NX)-WTGRBP(NB,NZ,NY,NX)) + ELSE + XLOCN=0.0 + XLOCP=0.0 + ENDIF +C IF(NX.EQ.1.AND.NY.EQ.6.AND.NZ.EQ.3)THEN +C WRITE(*,85)'XLOC',I,J,NZ,NB,WTGRB(NB,NZ,NY,NX),WTGRBN(NB,NZ,NY,NX) +C 2,WTRSVB(NB,NZ,NY,NX),WTRSBN(NB,NZ,NY,NX),XLOCC,XLOCN,XLOCP,XLOCM +C 3,CNGR(NZ,NY,NX),ZPGRX,ZNPG,GROLC,GROLM,GROGR,GROGRN +C 3,XLOCM*CNGR(NZ,NY,NX),AMAX1(0.0,WTRSBN(NB,NZ,NY,NX)*ZPGRX) +C 4,(WTGRB(NB,NZ,NY,NX)+XLOCC)*CNGR(NZ,NY,NX)-WTGRBN(NB,NZ,NY,NX) +C 4,GRNOB(NB,NZ,NY,NX),GRWTB(NB,NZ,NY,NX),GFILL(NZ,NY,NX) +C 5,SQRT(TFN3(NZ,NY,NX)),FLG4(NB,NZ,NY,NX) +85 FORMAT(A8,4I4,20E12.4) +C ENDIF +C +C TRANSLOCATE C,N,P FROM STALK RESERVES TO GRAIN +C + WTRSVB(NB,NZ,NY,NX)=WTRSVB(NB,NZ,NY,NX)+GROGR-XLOCC + WTRSBN(NB,NZ,NY,NX)=WTRSBN(NB,NZ,NY,NX)+GROGRN-XLOCN + WTRSBP(NB,NZ,NY,NX)=WTRSBP(NB,NZ,NY,NX)+GROGRP-XLOCP + WTGRB(NB,NZ,NY,NX)=WTGRB(NB,NZ,NY,NX)+XLOCC + WTGRBN(NB,NZ,NY,NX)=WTGRBN(NB,NZ,NY,NX)+XLOCN + WTGRBP(NB,NZ,NY,NX)=WTGRBP(NB,NZ,NY,NX)+XLOCP + ELSE + XLOCC=0.0 + XLOCN=0.0 + XLOCP=0.0 + ENDIF +C +C SET DATE OF PHYSIOLOGICAL MATURITY WHEN GRAIN FILL +C HAS STOPPED FOR SET PERIOD OF TIME +C + IF(IDAY(8,NB,NZ,NY,NX).NE.0)THEN + IF(XLOCC.LE.1.0E-09*PP(NZ,NY,NX))THEN + FLG4(NB,NZ,NY,NX)=FLG4(NB,NZ,NY,NX)+1.0 + ELSE + FLG4(NB,NZ,NY,NX)=0.0 + ENDIF + IF(FLG4(NB,NZ,NY,NX).GE.FLG4X)THEN + IF(IDAY(10,NB,NZ,NY,NX).EQ.0)THEN + IDAY(10,NB,NZ,NY,NX)=I + ENDIF + ENDIF +C +C TERMINATE ANNUALS AFTER GRAIN FILL +C + IF(ISTYP(NZ,NY,NX).EQ.0.AND.IWTYP(NZ,NY,NX).NE.0)THEN + IF(FLG4(NB,NZ,NY,NX).GT.FLG4Y(IWTYP(NZ,NY,NX)))THEN + VRNF(NB,NZ,NY,NX)=VRNX(NB,NZ,NY,NX)+0.5 + ENDIF + ENDIF + ENDIF +C +C RESET PHENOLOGY AT EMERGENCE ('VRNS' > 'VRNL') +C AND END OF SEASON ('VRNF' > 'VRNX') +C + IF(ISTYP(NZ,NY,NX).NE.0 + 2.OR.(ISTYP(NZ,NY,NX).EQ.0.AND.IWTYP(NZ,NY,NX).NE.0))THEN + IF((IFLGE(NB,NZ,NY,NX).EQ.0 + 2.AND.VRNS(NB,NZ,NY,NX).GE.VRNL(NB,NZ,NY,NX)) + 3.OR.(IFLGF(NB,NZ,NY,NX).EQ.0 + 4.AND.VRNF(NB,NZ,NY,NX).GE.VRNX(NB,NZ,NY,NX)))THEN +C +C SPRING PHENOLOGY RESET +C + IF((IFLGE(NB,NZ,NY,NX).EQ.0.AND.ISTYP(NZ,NY,NX).NE.0) + 2.AND.(VRNS(NB,NZ,NY,NX).GE.VRNL(NB,NZ,NY,NX)))THEN + IF(ISTYP(NZ,NY,NX).EQ.0)THEN + GROUP(NB,NZ,NY,NX)=AMAX1(0.0,GROUPI(NZ,NY,NX) + 2-NBTB(NB,NZ,NY,NX)) + ELSE + GROUP(NB,NZ,NY,NX)=GROUPI(NZ,NY,NX) + ENDIF + PSTGI(NB,NZ,NY,NX)=PSTG(NB,NZ,NY,NX) + PSTGF(NB,NZ,NY,NX)=0.0 + VSTGX(NB,NZ,NY,NX)=0.0 + TGSTGI(NB,NZ,NY,NX)=0.0 + TGSTGF(NB,NZ,NY,NX)=0.0 + IDAY(1,NB,NZ,NY,NX)=I + DO 2005 M=2,10 + IDAY(M,NB,NZ,NY,NX)=0 +2005 CONTINUE + IF(NB.EQ.NB1(NZ,NY,NX))THEN + WSTR(NZ,NY,NX)=0.0 + ENDIF +C +C SPRING LEAF AND SHEATH RESET +C + IF(IFLGE(NB,NZ,NY,NX).EQ.0.AND.ISTYP(NZ,NY,NX).NE.0 + 2.AND.VRNS(NB,NZ,NY,NX).GE.VRNL(NB,NZ,NY,NX))THEN + IF(IBTYP(NZ,NY,NX).EQ.0)THEN + PSTG(NB,NZ,NY,NX)=XTLI(NZ,NY,NX) + VSTG(NB,NZ,NY,NX)=0.0 + KLEAF(NB,NZ,NY,NX)=1 + KVSTG(NB,NZ,NY,NX)=1 + FLG4(NB,NZ,NY,NX)=0.0 + DO 5330 M=1,4 + CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX) + 2+CFOPC(5,M,NZ,NY,NX)*WTLFB(NB,NZ,NY,NX)*FWODB(0) + 3+CFOPC(5,M,NZ,NY,NX)*WTSHEB(NB,NZ,NY,NX)*FWODB(0) + ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX) + 2+CFOPN(5,M,NZ,NY,NX)*WTLFBN(NB,NZ,NY,NX)*FWODLN(0) + 3+CFOPN(5,M,NZ,NY,NX)*WTSHBN(NB,NZ,NY,NX)*FWODSN(0) + PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX) + 2+CFOPP(5,M,NZ,NY,NX)*WTLFBP(NB,NZ,NY,NX)*FWODLP(0) + 3+CFOPP(5,M,NZ,NY,NX)*WTSHBP(NB,NZ,NY,NX)*FWODSP(0) + CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) + 2+CFOPC(1,M,NZ,NY,NX)*WTLFB(NB,NZ,NY,NX)*FWODB(1) + 3+CFOPC(2,M,NZ,NY,NX)*WTSHEB(NB,NZ,NY,NX)*FWODB(1) + ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) + 2+CFOPN(1,M,NZ,NY,NX)*WTLFBN(NB,NZ,NY,NX)*FWODLN(1) + 3+CFOPN(2,M,NZ,NY,NX)*WTSHBN(NB,NZ,NY,NX)*FWODSN(1) + PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) + 2+CFOPP(1,M,NZ,NY,NX)*WTLFBP(NB,NZ,NY,NX)*FWODLP(1) + 3+CFOPP(2,M,NZ,NY,NX)*WTSHBP(NB,NZ,NY,NX)*FWODSP(1) +5330 CONTINUE + ARLFB(NB,NZ,NY,NX)=0.0 + WTLFB(NB,NZ,NY,NX)=0.0 + WTLFBN(NB,NZ,NY,NX)=0.0 + WTLFBP(NB,NZ,NY,NX)=0.0 + WTSHEB(NB,NZ,NY,NX)=0.0 + WTSHBN(NB,NZ,NY,NX)=0.0 + WTSHBP(NB,NZ,NY,NX)=0.0 + DO 5335 K=0,25 + ARLF(K,NB,NZ,NY,NX)=0.0 + HTSHE(K,NB,NZ,NY,NX)=0.0 + WGLF(K,NB,NZ,NY,NX)=0.0 + WSLF(K,NB,NZ,NY,NX)=0.0 + WGLFN(K,NB,NZ,NY,NX)=0.0 + WGLFP(K,NB,NZ,NY,NX)=0.0 + WGSHE(K,NB,NZ,NY,NX)=0.0 + WSSHE(K,NB,NZ,NY,NX)=0.0 + WGSHN(K,NB,NZ,NY,NX)=0.0 + WGSHP(K,NB,NZ,NY,NX)=0.0 +5335 CONTINUE + ENDIF + ENDIF +C +C RESIDUAL STALKS BECOME LITTERFALL IN GRASSES, SHRUBS AT +C START OF SEASON +C + IF((IFLGE(NB,NZ,NY,NX).EQ.0.AND.ISTYP(NZ,NY,NX).NE.0) + 2.AND.VRNS(NB,NZ,NY,NX).GE.VRNL(NB,NZ,NY,NX))THEN + DO 6245 M=1,4 + CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX)+CFOPC(2,M,NZ,NY,NX) + 2*(WTHSKB(NB,NZ,NY,NX)+WTEARB(NB,NZ,NY,NX)+WTGRB(NB,NZ,NY,NX)) + ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX)+CFOPN(2,M,NZ,NY,NX) + 2*(WTHSBN(NB,NZ,NY,NX)+WTEABN(NB,NZ,NY,NX)+WTGRBN(NB,NZ,NY,NX)) + PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX)+CFOPP(2,M,NZ,NY,NX) + 2*(WTHSBP(NB,NZ,NY,NX)+WTEABP(NB,NZ,NY,NX)+WTGRBP(NB,NZ,NY,NX)) +6245 CONTINUE + WTHSKB(NB,NZ,NY,NX)=0.0 + WTEARB(NB,NZ,NY,NX)=0.0 + WTGRB(NB,NZ,NY,NX)=0.0 + WTHSBN(NB,NZ,NY,NX)=0.0 + WTEABN(NB,NZ,NY,NX)=0.0 + WTGRBN(NB,NZ,NY,NX)=0.0 + WTHSBP(NB,NZ,NY,NX)=0.0 + WTEABP(NB,NZ,NY,NX)=0.0 + WTGRBP(NB,NZ,NY,NX)=0.0 + GRNXB(NB,NZ,NY,NX)=0.0 + GRNOB(NB,NZ,NY,NX)=0.0 + GRWTB(NB,NZ,NY,NX)=0.0 + IF(IBTYP(NZ,NY,NX).EQ.0.OR.IGTYP(NZ,NY,NX).LE.1)THEN + DO 6345 M=1,4 + CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX)+CFOPC(3,M,NZ,NY,NX) + 2*WTSTKB(NB,NZ,NY,NX) + ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX)+CFOPN(3,M,NZ,NY,NX) + 2*WTSTBN(NB,NZ,NY,NX) + PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX)+CFOPP(3,M,NZ,NY,NX) + 2*WTSTBP(NB,NZ,NY,NX) +6345 CONTINUE + WTSTKB(NB,NZ,NY,NX)=0.0 + WTSTBN(NB,NZ,NY,NX)=0.0 + WTSTBP(NB,NZ,NY,NX)=0.0 + WTSTXB(NB,NZ,NY,NX)=0.0 + WTSTXN(NB,NZ,NY,NX)=0.0 + WTSTXP(NB,NZ,NY,NX)=0.0 + DO 6340 K=0,25 + HTNODE(K,NB,NZ,NY,NX)=0.0 + HTNODX(K,NB,NZ,NY,NX)=0.0 + WGNODE(K,NB,NZ,NY,NX)=0.0 + WGNODN(K,NB,NZ,NY,NX)=0.0 + WGNODP(K,NB,NZ,NY,NX)=0.0 +6340 CONTINUE + ENDIF + ENDIF + ENDIF +C +C SPRING OR FALL FLAG RESET +C + IF(IFLGE(NB,NZ,NY,NX).EQ.0 + 2.AND.VRNS(NB,NZ,NY,NX).GE.VRNL(NB,NZ,NY,NX))THEN + IFLGE(NB,NZ,NY,NX)=1 + IFLGF(NB,NZ,NY,NX)=0 + IFLGR(NB,NZ,NY,NX)=0 + IFLGQ(NB,NZ,NY,NX)=0 + ELSE + IFLGE(NB,NZ,NY,NX)=0 + IFLGF(NB,NZ,NY,NX)=1 + IFLGR(NB,NZ,NY,NX)=1 + IFLGQ(NB,NZ,NY,NX)=0 + IFLGA(NB,NZ,NY,NX)=0 + ENDIF + ENDIF + ENDIF +C +C REPRODUCTIVE MATERIAL BECOMES LITTERFALL AT END OF SEASON +C + IF(IFLGR(NB,NZ,NY,NX).EQ.1)THEN + IFLGQ(NB,NZ,NY,NX)=IFLGQ(NB,NZ,NY,NX)+1 + IF(IFLGQ(NB,NZ,NY,NX).EQ.IFLGQX)THEN + IFLGR(NB,NZ,NY,NX)=0 + IFLGQ(NB,NZ,NY,NX)=0 + ENDIF + DO 6330 M=1,4 + CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) + 2+FSNR*CFOPC(2,M,NZ,NY,NX) + 2*(WTHSKB(NB,NZ,NY,NX)+WTEARB(NB,NZ,NY,NX)) + ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) + 2+FSNR*CFOPN(2,M,NZ,NY,NX) + 2*(WTHSBN(NB,NZ,NY,NX)+WTEABN(NB,NZ,NY,NX)) + PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) + 2+FSNR*CFOPP(2,M,NZ,NY,NX) + 2*(WTHSBP(NB,NZ,NY,NX)+WTEABP(NB,NZ,NY,NX)) + IF(ISTYP(NZ,NY,NX).EQ.0.AND.IWTYP(NZ,NY,NX).NE.0)THEN + WTRVC(NZ,NY,NX)=WTRVC(NZ,NY,NX) + 2+FSNR*CFOPC(2,M,NZ,NY,NX)*WTGRB(NB,NZ,NY,NX) + WTRVN(NZ,NY,NX)=WTRVN(NZ,NY,NX) + 2+FSNR*CFOPN(2,M,NZ,NY,NX)*WTGRBN(NB,NZ,NY,NX) + WTRVP(NZ,NY,NX)=WTRVP(NZ,NY,NX) + 2+FSNR*CFOPP(2,M,NZ,NY,NX)*WTGRBP(NB,NZ,NY,NX) + ELSE + CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) + 2+FSNR*CFOPC(2,M,NZ,NY,NX)*WTGRB(NB,NZ,NY,NX) + ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) + 2+FSNR*CFOPN(2,M,NZ,NY,NX)*WTGRBN(NB,NZ,NY,NX) + PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) + 2+FSNR*CFOPP(2,M,NZ,NY,NX)*WTGRBP(NB,NZ,NY,NX) + ENDIF +6330 CONTINUE + WTHSKB(NB,NZ,NY,NX)=(1.0-FSNR)*WTHSKB(NB,NZ,NY,NX) + WTEARB(NB,NZ,NY,NX)=(1.0-FSNR)*WTEARB(NB,NZ,NY,NX) + WTGRB(NB,NZ,NY,NX)=(1.0-FSNR)*WTGRB(NB,NZ,NY,NX) + WTHSBN(NB,NZ,NY,NX)=(1.0-FSNR)*WTHSBN(NB,NZ,NY,NX) + WTEABN(NB,NZ,NY,NX)=(1.0-FSNR)*WTEABN(NB,NZ,NY,NX) + WTGRBN(NB,NZ,NY,NX)=(1.0-FSNR)*WTGRBN(NB,NZ,NY,NX) + WTHSBP(NB,NZ,NY,NX)=(1.0-FSNR)*WTHSBP(NB,NZ,NY,NX) + WTEABP(NB,NZ,NY,NX)=(1.0-FSNR)*WTEABP(NB,NZ,NY,NX) + WTGRBP(NB,NZ,NY,NX)=(1.0-FSNR)*WTGRBP(NB,NZ,NY,NX) + GRNXB(NB,NZ,NY,NX)=(1.0-FSNR)*GRNXB(NB,NZ,NY,NX) + GRNOB(NB,NZ,NY,NX)=(1.0-FSNR)*GRNOB(NB,NZ,NY,NX) + GRWTB(NB,NZ,NY,NX)=(1.0-FSNR)*GRWTB(NB,NZ,NY,NX) +C +C STALKS BECOME LITTERFALL IN GRASSES AT END OF SEASON +C + IF((IBTYP(NZ,NY,NX).EQ.0.OR.IGTYP(NZ,NY,NX).LE.1) + 2.AND.ISTYP(NZ,NY,NX).NE.0)THEN + DO 6335 M=1,4 + CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) + 2+FSNR*CFOPC(3,M,NZ,NY,NX)*WTSTKB(NB,NZ,NY,NX) + ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) + 2+FSNR*CFOPN(3,M,NZ,NY,NX)*WTSTBN(NB,NZ,NY,NX) + PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) + 2+FSNR*CFOPP(3,M,NZ,NY,NX)*WTSTBP(NB,NZ,NY,NX) +6335 CONTINUE + WTSTKB(NB,NZ,NY,NX)=(1.0-FSNR)*WTSTKB(NB,NZ,NY,NX) + WTSTBN(NB,NZ,NY,NX)=(1.0-FSNR)*WTSTBN(NB,NZ,NY,NX) + WTSTBP(NB,NZ,NY,NX)=(1.0-FSNR)*WTSTBP(NB,NZ,NY,NX) + WTSTXB(NB,NZ,NY,NX)=(1.0-FSNR)*WTSTXB(NB,NZ,NY,NX) + WTSTXN(NB,NZ,NY,NX)=(1.0-FSNR)*WTSTXN(NB,NZ,NY,NX) + WTSTXP(NB,NZ,NY,NX)=(1.0-FSNR)*WTSTXP(NB,NZ,NY,NX) + DO 2010 K=0,25 +C HTNODE(K,NB,NZ,NY,NX)=(1.0-FSNR)*HTNODE(K,NB,NZ,NY,NX) + HTNODX(K,NB,NZ,NY,NX)=(1.0-FSNR)*HTNODX(K,NB,NZ,NY,NX) + WGNODE(K,NB,NZ,NY,NX)=(1.0-FSNR)*WGNODE(K,NB,NZ,NY,NX) + WGNODN(K,NB,NZ,NY,NX)=(1.0-FSNR)*WGNODN(K,NB,NZ,NY,NX) + WGNODP(K,NB,NZ,NY,NX)=(1.0-FSNR)*WGNODP(K,NB,NZ,NY,NX) +2010 CONTINUE + ENDIF +C +C SELF-SEEDING ANNUALS IF COLD OR DROUGHT DECIDUOUS +C +C IF(J.EQ.INT(ZNOON(NY,NX)))THEN + IF(NB.EQ.NB1(NZ,NY,NX))THEN + IF(ISTYP(NZ,NY,NX).EQ.0.AND.IWTYP(NZ,NY,NX).NE.0)THEN + IDAYH(NZ,NY,NX)=I + IYRH(NZ,NY,NX)=IYRC + IHVST(NZ,I,NY,NX)=1 + JHVST(NZ,I,NY,NX)=2 + HVST(NZ,I,NY,NX)=0.0 + THIN(NZ,I,NY,NX)=0.0 + EHVST(1,1,NZ,I,NY,NX)=1.0 + EHVST(1,2,NZ,I,NY,NX)=1.0 + EHVST(1,3,NZ,I,NY,NX)=1.0 + EHVST(1,4,NZ,I,NY,NX)=1.0 + EHVST(2,1,NZ,I,NY,NX)=0.0 + EHVST(2,2,NZ,I,NY,NX)=1.0 + EHVST(2,3,NZ,I,NY,NX)=0.0 + EHVST(2,4,NZ,I,NY,NX)=0.0 + IDAY0(NZ,NY,NX)=-1E+06 + IYR0(NZ,NY,NX)=-1E+06 + IFLGI(NZ,NY,NX)=1 +C WRITE(*,3366)'HVST',I,J,IYRC,IDAYH(NZ,NY,NX),IYRH(NZ,NY,NX) +C 2,IHVST(NZ,I,NY,NX),JHVST(NZ,I,NY,NX),IFLGI(NZ,NY,NX) +3366 FORMAT(A8,8I8) + ENDIF + ENDIF +C ENDIF + ENDIF +C +C TRANSFER C,N,P FROM SEASONAL STORAGE TO SHOOT AND ROOT +C NON-STRUCTURAL C DURING SEED GERMINATION OR LEAFOUT +C +C IF(NZ.EQ.1)THEN +C WRITE(*,2322)'VRNS',I,J,NX,NY,NZ,NB,NB1(NZ,NY,NX),IFLGZ +C 2,ISTYP(NZ,NY,NX),IFLGI(NZ,NY,NX),IDAY0(NZ,NY,NX),IYR0(NZ,NY,NX) +C 3,VRNS(NB1(NZ,NY,NX),NZ,NY,NX),VRNL(NB,NZ,NY,NX) +C 3,VRNF(NB,NZ,NY,NX),VRNX(NB,NZ,NY,NX) +2322 FORMAT(A8,12I4,20E12.4) +C ENDIF + IF((ISTYP(NZ,NY,NX).EQ.0.AND.IFLGI(NZ,NY,NX).EQ.0) + 2.OR.(I.GE.IDAY0(NZ,NY,NX).AND.IYRC.EQ.IYR0(NZ,NY,NX)) + 2.OR.(VRNS(NB1(NZ,NY,NX),NZ,NY,NX).GE.VRNL(NB,NZ,NY,NX) + 3.AND.VRNF(NB,NZ,NY,NX).LT.FVRN*VRNX(NB,NZ,NY,NX)))THEN + WTRTM=0.0 + CPOOLM=0.0 + DO 4 L=NU(NY,NX),NI(NZ,NY,NX) + WTRTM=WTRTM+AMAX1(0.0,WTRTD(1,L,NZ,NY,NX)) + CPOOLM=CPOOLM+AMAX1(0.0,CPOOLR(1,L,NZ,NY,NX)) +4 CONTINUE +C +C RESET TIME COUNTER +C + IF(IFLGA(NB,NZ,NY,NX).EQ.0)THEN + ATRP(NB,NZ,NY,NX)=0.0 + IFLGA(NB,NZ,NY,NX)=1 + ENDIF +C +C INCREMENT TIME COUNTER +C + IF(NB.EQ.NB1(NZ,NY,NX))THEN + IF(IPTYP(NZ,NY,NX).EQ.2 + 2.AND.(IWTYP(NZ,NY,NX).EQ.1.OR.IWTYP(NZ,NY,NX).EQ.3))THEN + PPDX=AMAX1(0.0,XDL(NZ,NY,NX)-XPPD(NZ,NY,NX)-DYLN(NY,NX)) + ATRPPD=EXP(-0.0*PPDX) + ELSE + ATRPPD=1.0 + ENDIF + DATRP=ATRPPD*TFN3(NZ,NY,NX)*WFNSG/AMIN1(1.0,ZTYP(NZ,NY,NX)) + ATRP(NB,NZ,NY,NX)=ATRP(NB,NZ,NY,NX)+DATRP +C IF(NZ.EQ.1)THEN +C WRITE(*,2323)'ATRP',I,J,NX,NY,NZ,NB,ATRP(NB,NZ,NY,NX),DATRP +C 2,ATRPPD,TFN3(NZ,NY,NX),WFNSG,PPDX,XDL(NZ,NY,NX),XPPD(NZ,NY,NX) +C 3,DYLN(NY,NX),WTLFB(NB,NZ,NY,NX),ARLFB(NB,NZ,NY,NX),HTCTL(NZ,NY,NX) +2323 FORMAT(A8,6I4,20E12.4) +C ENDIF + IF(ATRP(NB,NZ,NY,NX).LE.ATRPX(ISTYP(NZ,NY,NX)) + 2.OR.(ISTYP(NZ,NY,NX).EQ.0.AND.IWTYP(NZ,NY,NX).EQ.0))THEN + IF(WTRVC(NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + CPOOLT=CPOOLM+CPOOL(NB,NZ,NY,NX) +C +C REMOBILIZE C FROM SEASONAL STORAGE AT FIRST-ORDER RATE +C MODIFIED BY SOIL TEMPERATURE AT SEED DEPTH +C + GFNX=GVMX(ISTYP(NZ,NY,NX))*DATRP + CH2OH=AMAX1(0.0,GFNX*WTRVC(NZ,NY,NX)) +C IF(NZ.EQ.1.OR.NZ.EQ.4)THEN +C WRITE(*,2123)'GERM0',I,J,NX,NY,NZ,NB,GFNX,CH2OH,WTRVC(NZ,NY,NX) +C 2,CPOOL(NB,NZ,NY,NX),CPOOLR(1,NG(NZ,NY,NX),NZ,NY,NX) +C 3,FXSH(ISTYP(NZ,NY,NX)),FXRT(ISTYP(NZ,NY,NX)) +2123 FORMAT(A8,6I4,20E12.4) +C ENDIF + WTRVC(NZ,NY,NX)=WTRVC(NZ,NY,NX)-CH2OH + CPOOL(NB,NZ,NY,NX)=CPOOL(NB,NZ,NY,NX) + 2+CH2OH*FXSH(ISTYP(NZ,NY,NX)) + IF(WTRTM.GT.ZEROP(NZ,NY,NX).AND.CPOOLM.GT.ZEROP(NZ,NY,NX))THEN + DO 50 L=NU(NY,NX),NI(NZ,NY,NX) + FXFC=AMAX1(0.0,WTRTD(1,L,NZ,NY,NX))/WTRTM + CPOOLR(1,L,NZ,NY,NX)=CPOOLR(1,L,NZ,NY,NX) + 2+FXFC*CH2OH*FXRT(ISTYP(NZ,NY,NX)) +50 CONTINUE + ELSE + CPOOLR(1,NG(NZ,NY,NX),NZ,NY,NX)=CPOOLR(1,NG(NZ,NY,NX),NZ,NY,NX) + 2+CH2OH*FXRT(ISTYP(NZ,NY,NX)) + ENDIF + ELSE + CH2OH=0.0 + ENDIF + ELSE + CH2OH=0.0 + ENDIF +C +C REMOBILIZE N,P FROM SEASONAL STORAGE AT FIRST-ORDER RATE +C MODIFIED BY SOIL TEMPERATURE AT SEED DEPTH +C + IF(WTRVC(NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + IF(ISTYP(NZ,NY,NX).NE.0)THEN + CPOOLT=AMAX1(0.0,WTRVC(NZ,NY,NX)+CPOOL(NB,NZ,NY,NX)) + ZPOOLD=(WTRVN(NZ,NY,NX)*CPOOL(NB,NZ,NY,NX) + 2-ZPOOL(NB,NZ,NY,NX)*WTRVC(NZ,NY,NX))/CPOOLT + PPOOLD=(WTRVP(NZ,NY,NX)*CPOOL(NB,NZ,NY,NX) + 2-PPOOL(NB,NZ,NY,NX)*WTRVC(NZ,NY,NX))/CPOOLT + UPNH4B=AMAX1(0.0,FRSV(IBTYP(NZ,NY,NX))*ZPOOLD) + UPPO4B=AMAX1(0.0,FRSV(IBTYP(NZ,NY,NX))*PPOOLD) + ELSE + UPNH4B=AMAX1(0.0,FXSH(ISTYP(NZ,NY,NX)) + 2*CH2OH*WTRVN(NZ,NY,NX)/WTRVC(NZ,NY,NX)) + UPPO4B=AMAX1(0.0,FXSH(ISTYP(NZ,NY,NX)) + 2*CH2OH*WTRVP(NZ,NY,NX)/WTRVC(NZ,NY,NX)) + ENDIF + ELSE + UPNH4B=AMAX1(0.0,FXSH(ISTYP(NZ,NY,NX))*WTRVN(NZ,NY,NX)) + UPPO4B=AMAX1(0.0,FXSH(ISTYP(NZ,NY,NX))*WTRVP(NZ,NY,NX)) + ENDIF +C +C ADD TO NON-STRUCTURAL POOLS IN ROOT +C + CPOOLM=0.0 + ZPOOLM=0.0 + PPOOLM=0.0 + DO 3 L=NU(NY,NX),NI(NZ,NY,NX) + CPOOLM=CPOOLM+AMAX1(0.0,CPOOLR(1,L,NZ,NY,NX)) + ZPOOLM=ZPOOLM+AMAX1(0.0,ZPOOLR(1,L,NZ,NY,NX)) + PPOOLM=PPOOLM+AMAX1(0.0,PPOOLR(1,L,NZ,NY,NX)) +3 CONTINUE + IF(WTRVC(NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + IF(ISTYP(NZ,NY,NX).NE.0)THEN + CPOOLT=AMAX1(ZEROP(NZ,NY,NX),WTRVC(NZ,NY,NX)+CPOOLM) + ZPOOLD=(WTRVN(NZ,NY,NX)*CPOOLM + 2-ZPOOLM*WTRVC(NZ,NY,NX))/CPOOLT + PPOOLD=(WTRVP(NZ,NY,NX)*CPOOLM + 2-PPOOLM*WTRVC(NZ,NY,NX))/CPOOLT + UPNH4R=AMAX1(0.0,FRSV(IBTYP(NZ,NY,NX))*ZPOOLD) + UPPO4R=AMAX1(0.0,FRSV(IBTYP(NZ,NY,NX))*PPOOLD) +C IF(NZ.EQ.1.OR.NZ.EQ.4)THEN +C WRITE(*,9878)'GERM1',I,J,NZ,UPNH4R,FRSV(IBTYP(NZ,NY,NX)) +C 2,ZPOOLD,WTRVN(NZ,NY,NX),CPOOLM,ZPOOLM,WTRVC(NZ,NY,NX) +C 3,CPOOLT +9878 FORMAT(A8,3I4,12E24.16) +C ENDIF + ELSE + UPNH4R=AMAX1(0.0,FXRT(ISTYP(NZ,NY,NX)) + 2*CH2OH*WTRVN(NZ,NY,NX)/WTRVC(NZ,NY,NX)) + UPPO4R=AMAX1(0.0,FXRT(ISTYP(NZ,NY,NX)) + 2*CH2OH*WTRVP(NZ,NY,NX)/WTRVC(NZ,NY,NX)) + ENDIF + ELSE + UPNH4R=AMAX1(0.0,FXRT(ISTYP(NZ,NY,NX))*WTRVN(NZ,NY,NX)) + UPPO4R=AMAX1(0.0,FXRT(ISTYP(NZ,NY,NX))*WTRVP(NZ,NY,NX)) + ENDIF +C +C TRANSFER STORAGE FLUXES +C + WTRVN(NZ,NY,NX)=WTRVN(NZ,NY,NX)-UPNH4B-UPNH4R + WTRVP(NZ,NY,NX)=WTRVP(NZ,NY,NX)-UPPO4B-UPPO4R + ZPOOL(NB,NZ,NY,NX)=ZPOOL(NB,NZ,NY,NX)+UPNH4B + PPOOL(NB,NZ,NY,NX)=PPOOL(NB,NZ,NY,NX)+UPPO4B + IF(WTRTM.GT.ZEROP(NZ,NY,NX) + 2.AND.CPOOLM.GT.ZEROP(NZ,NY,NX))THEN + DO 51 L=NU(NY,NX),NI(NZ,NY,NX) + FXFN=AMAX1(0.0,CPOOLR(1,L,NZ,NY,NX))/CPOOLM +C IF(NZ.EQ.1.OR.NZ.EQ.4)THEN +C WRITE(*,9879)'GERM2',I,J,NZ,L,UPNH4R,FXFN +C 2,ZPOOLR(1,L,NZ,NY,NX),CPOOLR(1,L,NZ,NY,NX),CPOOLM +9879 FORMAT(A8,4I4,12E24.16) +C ENDIF + ZPOOLR(1,L,NZ,NY,NX)=ZPOOLR(1,L,NZ,NY,NX)+FXFN*UPNH4R + PPOOLR(1,L,NZ,NY,NX)=PPOOLR(1,L,NZ,NY,NX)+FXFN*UPPO4R +51 CONTINUE + ELSE +C IF(NZ.EQ.1.OR.NZ.EQ.4)THEN +C WRITE(*,9879)'GERM3',I,J,NZ,L,UPNH4R,FXFN +C 2,ZPOOLR(1,L,NZ,NY,NX),CPOOLR(1,L,NZ,NY,NX),CPOOLM +C ENDIF + ZPOOLR(1,NG(NZ,NY,NX),NZ,NY,NX)=ZPOOLR(1,NG(NZ,NY,NX),NZ,NY,NX) + 2+UPNH4R + PPOOLR(1,NG(NZ,NY,NX),NZ,NY,NX)=PPOOLR(1,NG(NZ,NY,NX),NZ,NY,NX) + 2+UPPO4R + ENDIF + ENDIF +C +C REDISTRIBUTE TRANFERRED C FROM MAIN STEM TO OTHER BRANCHES +C + IF(NB.NE.NB1(NZ,NY,NX).AND.ATRP(NB,NZ,NY,NX) + 2.LE.ATRPX(ISTYP(NZ,NY,NX)))THEN + ATRP(NB,NZ,NY,NX)=ATRP(NB,NZ,NY,NX)+TFN3(NZ,NY,NX)*WFNG + XFRC=AMAX1(0.0,0.05*TFN3(NZ,NY,NX) + 2*(0.5*(CPOOL(NB1(NZ,NY,NX),NZ,NY,NX)+CPOOL(NB,NZ,NY,NX)) + 3-CPOOL(NB,NZ,NY,NX))) + XFRN=AMAX1(0.0,0.05*TFN3(NZ,NY,NX) + 2*(0.5*(ZPOOL(NB1(NZ,NY,NX),NZ,NY,NX)+ZPOOL(NB,NZ,NY,NX)) + 2-ZPOOL(NB,NZ,NY,NX))) + XFRP=AMAX1(0.0,0.05*TFN3(NZ,NY,NX) + 2*(0.5*(PPOOL(NB1(NZ,NY,NX),NZ,NY,NX)+PPOOL(NB,NZ,NY,NX)) + 3-PPOOL(NB,NZ,NY,NX))) + CPOOL(NB,NZ,NY,NX)=CPOOL(NB,NZ,NY,NX)+XFRC + ZPOOL(NB,NZ,NY,NX)=ZPOOL(NB,NZ,NY,NX)+XFRN + PPOOL(NB,NZ,NY,NX)=PPOOL(NB,NZ,NY,NX)+XFRP + CPOOL(NB1(NZ,NY,NX),NZ,NY,NX)=CPOOL(NB1(NZ,NY,NX),NZ,NY,NX)-XFRC + ZPOOL(NB1(NZ,NY,NX),NZ,NY,NX)=ZPOOL(NB1(NZ,NY,NX),NZ,NY,NX)-XFRN + PPOOL(NB1(NZ,NY,NX),NZ,NY,NX)=PPOOL(NB1(NZ,NY,NX),NZ,NY,NX)-XFRP + ENDIF + ENDIF +C +C TRANSFER LEAF AND STALK NON-STRUCTURAL C,N,P TO SEASONAL STORAGE +C IN PERENNIALS AFTER GRAIN FILL IN DETERMINATES, AFTER AUTUMNIZ'N +C IN INDETERMINATES, OR AFTER SUSTAINED WATER STRESS +C + IF(ISTYP(NZ,NY,NX).NE.0.AND.IFLGZ.EQ.1)THEN + IF(WVSTKB(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX) + 2.AND.WTRSVB(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + CWTRSV=AMAX1(0.0,WTRSVB(NB,NZ,NY,NX)/WVSTKB(NB,NZ,NY,NX)) + CWTRSN=AMAX1(0.0,WTRSBN(NB,NZ,NY,NX)/WVSTKB(NB,NZ,NY,NX)) + CWTRSP=AMAX1(0.0,WTRSBP(NB,NZ,NY,NX)/WVSTKB(NB,NZ,NY,NX)) + CNR=CWTRSV/(CWTRSV+CWTRSN/CNKI) + CPR=CWTRSV/(CWTRSV+CWTRSP/CPKI) + ELSE + CNR=0.0 + CPR=0.0 + ENDIF + XFRCX=FXFB(IBTYP(NZ,NY,NX)) + 2*AMAX1(0.0,WTRSVB(NB,NZ,NY,NX)) + XFRNX=FXFB(IBTYP(NZ,NY,NX)) + 2*AMAX1(0.0,WTRSBN(NB,NZ,NY,NX))*(1.0+CNR) + XFRPX=FXFB(IBTYP(NZ,NY,NX)) + 2*AMAX1(0.0,WTRSBP(NB,NZ,NY,NX))*(1.0+CPR) + XFRC=AMIN1(XFRCX,XFRNX/CNMN,XFRPX/CPMN) + XFRN=AMIN1(XFRNX,XFRC*CNMX,XFRPX*CNMX/CPMN*0.5) + XFRP=AMIN1(XFRPX,XFRC*CPMX,XFRNX*CPMX/CNMN*0.5) + WTRSVB(NB,NZ,NY,NX)=WTRSVB(NB,NZ,NY,NX)-XFRC + WTRVC(NZ,NY,NX)=WTRVC(NZ,NY,NX)+XFRC + WTRSBN(NB,NZ,NY,NX)=WTRSBN(NB,NZ,NY,NX)-XFRN + WTRVN(NZ,NY,NX)=WTRVN(NZ,NY,NX)+XFRN + WTRSBP(NB,NZ,NY,NX)=WTRSBP(NB,NZ,NY,NX)-XFRP + WTRVP(NZ,NY,NX)=WTRVP(NZ,NY,NX)+XFRP + IF(CPOOL(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + CNL=CCPOLB(NB,NZ,NY,NX)/(CCPOLB(NB,NZ,NY,NX) + 2+CZPOLB(NB,NZ,NY,NX)/CNKI) + CPL=CCPOLB(NB,NZ,NY,NX)/(CCPOLB(NB,NZ,NY,NX) + 2+CPPOLB(NB,NZ,NY,NX)/CPKI) + ELSE + CNL=0.0 + CPL=0.0 + ENDIF + XFRCX=FXFB(IBTYP(NZ,NY,NX)) + 2*AMAX1(0.0,CPOOL(NB,NZ,NY,NX)) + XFRNX=FXFB(IBTYP(NZ,NY,NX)) + 2*AMAX1(0.0,ZPOOL(NB,NZ,NY,NX))*(1.0+CNL) + XFRPX=FXFB(IBTYP(NZ,NY,NX)) + 2*AMAX1(0.0,PPOOL(NB,NZ,NY,NX))*(1.0+CPL) + XFRC=AMIN1(XFRCX,XFRNX/CNMN,XFRPX/CPMN) + XFRN=AMIN1(XFRNX,XFRC*CNMX,XFRPX*CNMX/CPMN*0.5) + XFRP=AMIN1(XFRPX,XFRC*CPMX,XFRNX*CPMX/CNMN*0.5) + CPOOL(NB,NZ,NY,NX)=CPOOL(NB,NZ,NY,NX)-XFRC + WTRVC(NZ,NY,NX)=WTRVC(NZ,NY,NX)+XFRC + ZPOOL(NB,NZ,NY,NX)=ZPOOL(NB,NZ,NY,NX)-XFRN + WTRVN(NZ,NY,NX)=WTRVN(NZ,NY,NX)+XFRN + PPOOL(NB,NZ,NY,NX)=PPOOL(NB,NZ,NY,NX)-XFRP + WTRVP(NZ,NY,NX)=WTRVP(NZ,NY,NX)+XFRP +C IF(NZ.EQ.1)THEN +C WRITE(*,4490)'RSV',I,J,NZ,NB,XFRC,XFRN,WTRSVB(NB,NZ,NY,NX) +C 2,WTRSBN(NB,NZ,NY,NX),WTRVC(NZ,NY,NX),WTRVN(NZ,NY,NX) +C 3,CNR,CNL,CPOOL(NB,NZ,NY,NX),ZPOOL(NB,NZ,NY,NX) +C 4,FXFB(IBTYP(NZ,NY,NX)) +4490 FORMAT(A8,4I4,20E12.4) +C ENDIF + ENDIF +C +C TRANSFER NON-STRUCTURAL C,N,P FROM LEAVES AND ROOTS TO RESERVES +C IN STALKS DURING GRAIN FILL IN ANNUALS OR BETWEEN STALK RESERVES +C AND LEAVES IN PERENNIALS ACCORDING TO CONCENTRATION DIFFERENCES +C + IF((ISTYP(NZ,NY,NX).EQ.0.AND.IDAY(8,NB,NZ,NY,NX).NE.0) + 2.OR.(ISTYP(NZ,NY,NX).EQ.1.AND.IDAY(3,NB,NZ,NY,NX).NE.0))THEN + WTPLTT=WTLSB(NB,NZ,NY,NX)+WVSTKB(NB,NZ,NY,NX) + CPOOLT=CPOOL(NB,NZ,NY,NX)+WTRSVB(NB,NZ,NY,NX) + IF(WTPLTT.GT.ZEROP(NZ,NY,NX))THEN + CPOOLD=(CPOOL(NB,NZ,NY,NX)*WVSTKB(NB,NZ,NY,NX) + 2-WTRSVB(NB,NZ,NY,NX)*WTLSB(NB,NZ,NY,NX))/WTPLTT + XFRC=FXFY(ISTYP(NZ,NY,NX))*CPOOLD + CPOOL(NB,NZ,NY,NX)=CPOOL(NB,NZ,NY,NX)-XFRC + WTRSVB(NB,NZ,NY,NX)=WTRSVB(NB,NZ,NY,NX)+XFRC + ENDIF + IF(CPOOLT.GT.ZEROP(NZ,NY,NX))THEN + ZPOOLD=(ZPOOL(NB,NZ,NY,NX)*WTRSVB(NB,NZ,NY,NX) + 2-WTRSBN(NB,NZ,NY,NX)*CPOOL(NB,NZ,NY,NX))/CPOOLT + PPOOLD=(PPOOL(NB,NZ,NY,NX)*WTRSVB(NB,NZ,NY,NX) + 2-WTRSBP(NB,NZ,NY,NX)*CPOOL(NB,NZ,NY,NX))/CPOOLT + XFRN=FXFZ(ISTYP(NZ,NY,NX))*ZPOOLD + XFRP=FXFZ(ISTYP(NZ,NY,NX))*PPOOLD + ZPOOL(NB,NZ,NY,NX)=ZPOOL(NB,NZ,NY,NX)-XFRN + WTRSBN(NB,NZ,NY,NX)=WTRSBN(NB,NZ,NY,NX)+XFRN + PPOOL(NB,NZ,NY,NX)=PPOOL(NB,NZ,NY,NX)-XFRP + WTRSBP(NB,NZ,NY,NX)=WTRSBP(NB,NZ,NY,NX)+XFRP + ENDIF +C IF(NZ.EQ.1)THEN +C WRITE(*,4488)'EXCHC',I,J,NX,NY,NZ,NB,NS,XFRC,XFRN +C 2,FXFZ(ISTYP(NZ,NY,NX)),WTRSVB(NB,NZ,NY,NX),CPOOL(NB,NZ,NY,NX) +C 3,WVSTKB(NB,NZ,NY,NX),WTLSB(NB,NZ,NY,NX) +C 4,CPOOLT,CPOOLD,ZPOOL(NB,NZ,NY,NX),WTRSBN(NB,NZ,NY,NX) +4488 FORMAT(A8,7I4,12E12.4) +C ENDIF + IF(ISTYP(NZ,NY,NX).EQ.0.AND.IDAY(8,NB,NZ,NY,NX).NE.0)THEN + DO 2050 L=NU(NY,NX),NI(NZ,NY,NX) + WTRTRX=AMAX1(ZEROP(NZ,NY,NX),WTRTL(1,L,NZ,NY,NX)*FWOOD(1)) + WTPLTX=WTRTRX+WVSTKB(NB,NZ,NY,NX) + IF(WTPLTX.GT.ZEROP(NZ,NY,NX))THEN + CPOOLD=(CPOOLR(1,L,NZ,NY,NX)*WVSTKB(NB,NZ,NY,NX) + 2-WTRSVB(NB,NZ,NY,NX)*WTRTRX)/WTPLTX + XFRC=AMAX1(0.0,FXFY(ISTYP(NZ,NY,NX))*CPOOLD) + CPOOLR(1,L,NZ,NY,NX)=CPOOLR(1,L,NZ,NY,NX)-XFRC + WTRSVB(NB,NZ,NY,NX)=WTRSVB(NB,NZ,NY,NX)+XFRC + CPOOLT=CPOOLR(1,L,NZ,NY,NX)+WTRSVB(NB,NZ,NY,NX) + IF(CPOOLT.GT.ZEROP(NZ,NY,NX))THEN + ZPOOLD=(ZPOOLR(1,L,NZ,NY,NX)*WTRSVB(NB,NZ,NY,NX) + 2-WTRSBN(NB,NZ,NY,NX)*CPOOLR(1,L,NZ,NY,NX))/CPOOLT + PPOOLD=(PPOOLR(1,L,NZ,NY,NX)*WTRSVB(NB,NZ,NY,NX) + 2-WTRSBP(NB,NZ,NY,NX)*CPOOLR(1,L,NZ,NY,NX))/CPOOLT + XFRN=AMAX1(0.0,FXFZ(ISTYP(NZ,NY,NX))*ZPOOLD) + XFRP=AMAX1(0.0,FXFZ(ISTYP(NZ,NY,NX))*PPOOLD) + ZPOOLR(1,L,NZ,NY,NX)=ZPOOLR(1,L,NZ,NY,NX)-XFRN + WTRSBN(NB,NZ,NY,NX)=WTRSBN(NB,NZ,NY,NX)+XFRN + PPOOLR(1,L,NZ,NY,NX)=PPOOLR(1,L,NZ,NY,NX)-XFRP + WTRSBP(NB,NZ,NY,NX)=WTRSBP(NB,NZ,NY,NX)+XFRP +C IF(NZ.EQ.1)THEN +C WRITE(*,4489)'EXCHC',I,J,NZ,NB,L,WTRSVB(NB,NZ,NY,NX) +C 2,WVSTKB(NB,NZ,NY,NX),CPOOLR(1,L,NZ,NY,NX) +C 3,WTRTL(1,L,NZ,NY,NX),FWOOD(1),WTRTRX,WTPLTX +C 4,CPOOLT,CPOOLD,XFRC,FXFZ(ISTYP(NZ,NY,NX)) +4489 FORMAT(A8,5I4,12E16.8) +C ENDIF +C IF(NZ.EQ.1.OR.NZ.EQ.4)THEN +C WRITE(*,4489)'EXCHN',I,J,NZ,NB,L,WTRSBN(NB,NZ,NY,NX) +C 2,WTRSVB(NB,NZ,NY,NX),ZPOOLR(1,L,NZ,NY,NX) +C 3,CPOOLR(1,L,NZ,NY,NX),FWOOD(1),ZPOOLD,XFRN +C ENDIF + ENDIF + ENDIF +2050 CONTINUE + ENDIF + ENDIF +C +C REPLENISH BRANCH NON-STRUCTURAL POOL FROM +C SEASONAL STORAGE POOL +C + IF(WVSTKB(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX) + 2.AND.WVSTK(NZ,NY,NX).GT.ZEROP(NZ,NY,NX) + 3.AND.WTRT(NZ,NY,NX).GT.ZEROP(NZ,NY,NX) + 4.AND.WTRSVB(NB,NZ,NY,NX).LE.XFRX*WVSTKB(NB,NZ,NY,NX))THEN + FWTBR=WVSTKB(NB,NZ,NY,NX)/WVSTK(NZ,NY,NX) + WVSTBX=WVSTKB(NB,NZ,NY,NX) + WTRTTX=WTRT(NZ,NY,NX)*FWTBR + WTPLTT=WVSTBX+WTRTTX + WTRSBX=AMAX1(0.0,WTRSVB(NB,NZ,NY,NX)) + WTRVCX=AMAX1(0.0,WTRVC(NZ,NY,NX)*FWTBR) + CPOOLD=(WTRVCX*WVSTBX-WTRSBX*WTRTTX)/WTPLTT + XFRC=AMAX1(0.0,XFRY*CPOOLD) + WTRSVB(NB,NZ,NY,NX)=WTRSVB(NB,NZ,NY,NX)+XFRC + WTRVC(NZ,NY,NX)=WTRVC(NZ,NY,NX)-XFRC + ENDIF +C +C CANOPY N2 FIXATION (CYANOBACTERIA) +C + IF(INTYP(NZ,NY,NX).GE.3)THEN +C +C INITIAL INFECTION +C + IF(WTNDB(NB,NZ,NY,NX).LE.0.0)THEN + WTNDB(NB,NZ,NY,NX)=WTNDB(NB,NZ,NY,NX) + 2+WTNDI*AREA(3,NU(NY,NX),NY,NX) + WTNDBN(NB,NZ,NY,NX)=WTNDBN(NB,NZ,NY,NX) + 2+WTNDI*AREA(3,NU(NY,NX),NY,NX)*CNND(NZ,NY,NX) + WTNDBP(NB,NZ,NY,NX)=WTNDBP(NB,NZ,NY,NX) + 2+WTNDI*AREA(3,NU(NY,NX),NY,NX)*CPND(NZ,NY,NX) + ENDIF +C +C O2-UNCONSTRAINED RESPIRATION RATES BY HETEROTROPHIC AEROBES +C IN NODULE FROM SPECIFIC OXIDATION RATE, ACTIVE BIOMASS, +C NON-STRUCTURAL C CONCENTRATION, MICROBIAL C:N:P FACTOR, +C AND TEMPERATURE +C + IF(WTNDB(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + CCPOLN=AMAX1(0.0,CPOLNB(NB,NZ,NY,NX)/WTNDB(NB,NZ,NY,NX)) + CZPOLN=AMAX1(0.0,ZPOLNB(NB,NZ,NY,NX)/WTNDB(NB,NZ,NY,NX)) + CPPOLN=AMAX1(0.0,PPOLNB(NB,NZ,NY,NX)/WTNDB(NB,NZ,NY,NX)) + ELSE + CCPOLN=1.0 + CZPOLN=1.0 + 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) + ELSE + CCC=0.0 + CNC=0.0 + CPC=0.0 + CNF=0.0 + ENDIF + IF(WTNDB(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + FCNPF=AMIN1(1.0,AMAX1(0.0 + 2,WTNDBN(NB,NZ,NY,NX)/(WTNDB(NB,NZ,NY,NX)*CNND(NZ,NY,NX)) + 3,WTNDBP(NB,NZ,NY,NX)/(WTNDB(NB,NZ,NY,NX)*CPND(NZ,NY,NX)))) + ELSE + FCNPF=1.0 + ENDIF + RDNDBX=CCPOLN/(CCPOLN+CCNKX) + RCNDL=AMAX1(0.0,AMIN1(CPOLNB(NB,NZ,NY,NX)*(1.0-DMND(NZ,NY,NX)) + 2,VMXO*WTNDB(NB,NZ,NY,NX)*CCPOLN/(CCPOLN+CCNKM) + 3*TFN3(NZ,NY,NX)*FCNPF*WFNG))*CNF +C +C NODULE MAINTENANCE RESPIRATION FROM SOIL TEMPERATURE, +C NODULE STRUCTURAL N +C + RMNDL=AMAX1(0.0,RMPLT*TFN5*WTNDBN(NB,NZ,NY,NX))*RDNDBX +C +C NODULE GROWTH RESPIRATION FROM TOTAL - MAINTENANCE +C IF > 0 DRIVES GROWTH, IF < 0 DRIVES REMOBILIZATION +C + RXNDL=RCNDL-RMNDL + RGNDL=AMAX1(0.0,RXNDL) + RSNDL=AMAX1(0.0,-RXNDL) +C +C NODULE N2 FIXATION FROM GROWTH RESPIRATION, FIXATION ENERGY +C REQUIREMENT AND NON-STRUCTURAL C:N:P PRODUCT INHIBITION, +C CONSTRAINED BY MICROBIAL N REQUIREMENT +C + RGN2P=AMAX1(0.0,WTNDB(NB,NZ,NY,NX)*CNND(NZ,NY,NX) + 2-WTNDBN(NB,NZ,NY,NX))/EN2F + RGN2F=AMIN1(RGNDL,RGN2P) + RUPNFB=RGN2F*EN2F + UPNFC(NZ,NY,NX)=UPNFC(NZ,NY,NX)+RUPNFB +C +C TOTAL NON-STRUCTURAL C,N,P USED IN NODULE GROWTH +C AND GROWTH RESPIRATION DEPENDS ON GROWTH YIELD ENTERED IN 'READQ' +C + CGNDL=(RGNDL-RGN2F)/(1.0-DMND(NZ,NY,NX)) + GRNDG=CGNDL*DMND(NZ,NY,NX) + ZADDN=AMAX1(0.0,AMIN1(ZPOLNB(NB,NZ,NY,NX) + 2,GRNDG*CNND(NZ,NY,NX))*CCC) + PADDN=AMAX1(0.0,AMIN1(PPOLNB(NB,NZ,NY,NX) + 2,GRNDG*CPND(NZ,NY,NX))*CCC) +C +C NODULE C,N,P REMOBILIZATION AND DECOMPOSITION AND LEAKAGE +C + RCCC=RCCZN+CCC*RCCYN + RCCN=CNC*RCCX(IGTYP(NZ,NY,NX)) + RCCP=CPC*RCCQ(IGTYP(NZ,NY,NX)) + SPNDX=SPNDL*RDNDBX + RXNDLC=SPNDX*WTNDB(NB,NZ,NY,NX)*WFNG + RXNDLN=SPNDX*WTNDBN(NB,NZ,NY,NX)*WFNG + RXNDLP=SPNDX*WTNDBP(NB,NZ,NY,NX)*WFNG + RDNDLC=RXNDLC*(1.0-RCCC) + RDNDLN=RXNDLN*(1.0-RCCN)*(1.0-RCCC) + RDNDLP=RXNDLP*(1.0-RCCP)*(1.0-RCCC) + RCNDLC=RXNDLC-RDNDLC + RCNDLN=RXNDLN-RDNDLN + RCNDLP=RXNDLP-RDNDLP +C +C NODULE SENESCENCE +C + IF(RSNDL.GT.0.0.AND.WTNDB(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX) + 2.AND.RCCC.GT.ZERO)THEN + RXNSNC=RSNDL/RCCC + RXNSNN=RXNSNC*WTNDBN(NB,NZ,NY,NX)/WTNDB(NB,NZ,NY,NX) + RXNSNP=RXNSNC*WTNDBP(NB,NZ,NY,NX)/WTNDB(NB,NZ,NY,NX) + RDNSNC=RXNSNC*(1.0-RCCC) + RDNSNN=RXNSNN*(1.0-RCCN)*(1.0-RCCC) + RDNSNP=RXNSNP*(1.0-RCCP)*(1.0-RCCC) + RCNSNC=RXNSNC-RDNSNC + RCNSNN=RXNSNN-RDNSNN + RCNSNP=RXNSNP-RDNSNP + ELSE + RXNSNC=0.0 + RXNSNN=0.0 + RXNSNP=0.0 + RDNSNC=0.0 + RDNSNN=0.0 + RDNSNP=0.0 + RCNSNC=0.0 + RCNSNN=0.0 + RCNSNP=0.0 + ENDIF +C +C TOTAL NODULE RESPIRATION +C + RCO2T=AMIN1(RMNDL,RCNDL)+RGNDL+RCNSNC + TCO2T(NZ,NY,NX)=TCO2T(NZ,NY,NX)-RCO2T + TCO2A(NZ,NY,NX)=TCO2A(NZ,NY,NX)-RCO2T + CNET(NZ,NY,NX)=CNET(NZ,NY,NX)-RCO2T + RECO(NY,NX)=RECO(NY,NX)-RCO2T + TRAU(NY,NX)=TRAU(NY,NX)-RCO2T +C +C NODULE LITTERFALL CAUSED BY REMOBILIZATION +C + DO 6470 M=1,4 + CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX)+CFOPC(1,M,NZ,NY,NX) + 2*(RDNDLC+RDNSNC) + ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX)+CFOPN(1,M,NZ,NY,NX) + 2*(RDNDLN+RDNSNN) + PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX)+CFOPP(1,M,NZ,NY,NX) + 2*(RDNDLP+RDNSNP) +6470 CONTINUE +C +C CONSUMPTION OF NON-STRUCTURAL C,N,P BY NODULE +C + CPOLNB(NB,NZ,NY,NX)=CPOLNB(NB,NZ,NY,NX)-AMIN1(RMNDL,RCNDL) + 2-RGN2F-CGNDL+RCNDLC + ZPOLNB(NB,NZ,NY,NX)=ZPOLNB(NB,NZ,NY,NX)-ZADDN+RCNDLN+RCNSNN + 2+RUPNFB + PPOLNB(NB,NZ,NY,NX)=PPOLNB(NB,NZ,NY,NX)-PADDN+RCNDLP+RCNSNP +C +C UPDATE STATE VARIABLES FOR NODULE C, N, P +C + WTNDB(NB,NZ,NY,NX)=WTNDB(NB,NZ,NY,NX)+GRNDG-RXNDLC-RXNSNC + WTNDBN(NB,NZ,NY,NX)=WTNDBN(NB,NZ,NY,NX)+ZADDN-RXNDLN-RXNSNN + WTNDBP(NB,NZ,NY,NX)=WTNDBP(NB,NZ,NY,NX)+PADDN-RXNDLP-RXNSNP +C +C TRANSFER NON-STRUCTURAL C,N,P BETWEEN BRANCH AND NODULES +C FROM NON-STRUCTURAL C,N,P CONCENTRATION DIFFERENCES +C + 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))) + WTLSBT=WTLSB1+WTNDB1 + IF(WTLSBT.GT.ZEROP(NZ,NY,NX))THEN + CPOOLD=(CPOOL(NB,NZ,NY,NX)*WTNDB1 + 2-CPOLNB(NB,NZ,NY,NX)*WTLSB1)/WTLSBT + XFRC=FXRN(INTYP(NZ,NY,NX))*CPOOLD + CPOOL(NB,NZ,NY,NX)=CPOOL(NB,NZ,NY,NX)-XFRC + CPOLNB(NB,NZ,NY,NX)=CPOLNB(NB,NZ,NY,NX)+XFRC + CPOOLT=CPOOL(NB,NZ,NY,NX)+CPOLNB(NB,NZ,NY,NX) + IF(CPOOLT.GT.ZEROP(NZ,NY,NX))THEN + ZPOOLD=(ZPOOL(NB,NZ,NY,NX)*CPOLNB(NB,NZ,NY,NX) + 2-ZPOLNB(NB,NZ,NY,NX)*CPOOL(NB,NZ,NY,NX))/CPOOLT + XFRN=FXRN(INTYP(NZ,NY,NX))*ZPOOLD + PPOOLD=(PPOOL(NB,NZ,NY,NX)*CPOLNB(NB,NZ,NY,NX) + 2-PPOLNB(NB,NZ,NY,NX)*CPOOL(NB,NZ,NY,NX))/CPOOLT + XFRP=FXRN(INTYP(NZ,NY,NX))*PPOOLD + ZPOOL(NB,NZ,NY,NX)=ZPOOL(NB,NZ,NY,NX)-XFRN + PPOOL(NB,NZ,NY,NX)=PPOOL(NB,NZ,NY,NX)-XFRP + ZPOLNB(NB,NZ,NY,NX)=ZPOLNB(NB,NZ,NY,NX)+XFRN + PPOLNB(NB,NZ,NY,NX)=PPOLNB(NB,NZ,NY,NX)+XFRP +C IF((I/10)*10.EQ.I.AND.J.EQ.12.AND.NZ.EQ.4)THEN +C WRITE(*,2121)'NODEX',I,J,NZ,NB,XFRC,XFRN,XFRP +C 3,WTLSB(NB,NZ,NY,NX),WTNDB(NB,NZ,NY,NX),CPOOLT +C 4,CPOLNB(NB,NZ,NY,NX),ZPOLNB(NB,NZ,NY,NX),PPOLNB(NB,NZ,NY,NX) +C 4,CPOOL(NB,NZ,NY,NX),ZPOOL(NB,NZ,NY,NX),PPOOL(NB,NZ,NY,NX) +C ENDIF + ENDIF + ENDIF + ENDIF +C IF((I/10)*10.EQ.I.AND.J.EQ.12.AND.NY.EQ.5)THEN +C WRITE(*,2121)'NODGR',I,J,NZ,NB,RCNDL,RMNDL,RGNDL,RGN2P +C 2,RGN2F,CGNDL,SNCR,GRNDG,ZADDN,PADDN,FSNCN +C 8,RDNDLC,RDNDLN,RDNDLP,RCCC,RCCN,RCCP,TFN5 +C 3,WTNDB(NB,NZ,NY,NX),WTNDBN(NB,NZ,NY,NX),WTNDBP(NB,NZ,NY,NX) +C 4,CPOLNB(NB,NZ,NY,NX),ZPOLNB(NB,NZ,NY,NX),PPOLNB(NB,NZ,NY,NX) +C 5,CCPOLN,CZPOLN,TFN3(NZ,NY,NX),CNF,FCNPF,WFNG +C 6,CPOLNB(NB,NZ,NY,NX)*(1.0-DMND(NZ,NY,NX)) +C 6,VMXO*WTNDB(NB,NZ,NY,NX)*CCPOLN/(CCPOLN+CCNKM) +2121 FORMAT(A8,4I4,60E12.4) +C ENDIF + ENDIF + ENDIF + + +105 CONTINUE +C +C ROOT GROWTH +C + NIX(NZ,NY,NX)=NG(NZ,NY,NX) + IDTHRN=0 +C +C FOR ROOTS (N=1) AND MYCORRHIZAE (N=2) IN EACH SOIL LAYER +C + DO 4990 N=1,MY(NZ,NY,NX) + DO 4990 L=NU(NY,NX),NI(NZ,NY,NX) +C +C RESPIRATION FROM NUTRIENT UPTAKE CALCULATED IN 'UPTAKE': +C ACTUAL, O2-UNLIMITED AND C-UNLIMITED +C + CUPRL=0.86*(RUPNH4(N,L,NZ,NY,NX)+RUPNHB(N,L,NZ,NY,NX) + 2+RUPNO3(N,L,NZ,NY,NX)+RUPNOB(N,L,NZ,NY,NX)+RUPH2P(N,L,NZ,NY,NX) + 3+RUPH2B(N,L,NZ,NY,NX)+RUPH1P(N,L,NZ,NY,NX)+RUPH1B(N,L,NZ,NY,NX)) + CUPRO=0.86*(RUONH4(N,L,NZ,NY,NX)+RUONHB(N,L,NZ,NY,NX) + 2+RUONO3(N,L,NZ,NY,NX)+RUONOB(N,L,NZ,NY,NX)+RUOH2P(N,L,NZ,NY,NX) + 3+RUOH2B(N,L,NZ,NY,NX)+RUOH1P(N,L,NZ,NY,NX)+RUOH1B(N,L,NZ,NY,NX)) + CUPRC=0.86*(RUCNH4(N,L,NZ,NY,NX)+RUCNHB(N,L,NZ,NY,NX) + 2+RUCNO3(N,L,NZ,NY,NX)+RUCNOB(N,L,NZ,NY,NX)+RUCH2P(N,L,NZ,NY,NX) + 3+RUCH2B(N,L,NZ,NY,NX)+RUCH1P(N,L,NZ,NY,NX)+RUCH1B(N,L,NZ,NY,NX)) +C +C ACCUMULATE RESPIRATION IN FLUX ARRAYS +C + RCO2M(N,L,NZ,NY,NX)=RCO2M(N,L,NZ,NY,NX)+CUPRO + RCO2N(N,L,NZ,NY,NX)=RCO2N(N,L,NZ,NY,NX)+CUPRC + RCO2A(N,L,NZ,NY,NX)=RCO2A(N,L,NZ,NY,NX)-CUPRL + CPOOLR(N,L,NZ,NY,NX)=CPOOLR(N,L,NZ,NY,NX)-CUPRL +C +C EXUDATION AND UPTAKE OF C, N AND P TO/FROM SOIL AND ROOT +C OR MYCORRHIZAL NON-STRUCTURAL C,N,P POOLS +C + DO 195 K=0,4 + CPOOLR(N,L,NZ,NY,NX)=CPOOLR(N,L,NZ,NY,NX)+RDFOMC(N,K,L,NZ,NY,NX) + ZPOOLR(N,L,NZ,NY,NX)=ZPOOLR(N,L,NZ,NY,NX)+RDFOMN(N,K,L,NZ,NY,NX) + PPOOLR(N,L,NZ,NY,NX)=PPOOLR(N,L,NZ,NY,NX)+RDFOMP(N,K,L,NZ,NY,NX) +195 CONTINUE + ZPOOLR(N,L,NZ,NY,NX)=ZPOOLR(N,L,NZ,NY,NX) + 2+RUPNH4(N,L,NZ,NY,NX)+RUPNHB(N,L,NZ,NY,NX) + 3+RUPNO3(N,L,NZ,NY,NX)+RUPNOB(N,L,NZ,NY,NX) + PPOOLR(N,L,NZ,NY,NX)=PPOOLR(N,L,NZ,NY,NX) + 2+RUPH2P(N,L,NZ,NY,NX)+RUPH2B(N,L,NZ,NY,NX) + 3+RUPH1P(N,L,NZ,NY,NX)+RUPH1B(N,L,NZ,NY,NX) +C IF(L.EQ.1)THEN +C WRITE(*,9881)'CUPNH4',I,J,NZ,L,N,CPOOLR(N,L,NZ,NY,NX) +C 2,ZPOOLR(N,L,NZ,NY,NX),PPOOLR(N,L,NZ,NY,NX),CUPRL +C 2,RDFOMC(N,L,NZ,NY,NX),RDFOMN(N,L,NZ,NY,NX),RDFOMP(N,L,NZ,NY,NX) +C 2,RUPNH4(N,L,NZ,NY,NX),RUPNHB(N,L,NZ,NY,NX),RUPNO3(N,L,NZ,NY,NX) +C 2,RUPNOB(N,L,NZ,NY,NX),RUPH2P(N,L,NZ,NY,NX),RUPH2B(N,L,NZ,NY,NX) +C 3,RUPH12P(N,L,NZ,NY,NX),RUPH1B(N,L,NZ,NY,NX),WFR(N,L,NZ,NY,NX) +9881 FORMAT(A8,5I4,30E24.16) +C ENDIF +C +C GROWTH OF EACH ROOT AXIS +C + DO 4985 NR=1,NRT(NZ,NY,NX) +C +C PRIMARY ROOT SINK STRENGTH FROM ROOT RADIUS AND ROOT DEPTH +C + IF(N.EQ.1)THEN + 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 + RTNT(N)=RTNT(N)+RTSK1(N,L,NR) + RLNT(N,L)=RLNT(N,L)+RTSK1(N,L,NR) + ENDIF + ENDIF + ENDIF +C +C SECONDARY ROOT SINK STRENGTH FROM ROOT RADIUS, ROOT AXIS NUMBER, +C AND ROOT LENGTH IN SERIES WITH PRIMARY ROOT SINK STRENGTH +C + IF(N.EQ.1)THEN + RTDPL(NR,L)=AMAX1(0.0,RTDP1(1,NR,NZ,NY,NX)-CDPTHZ(L-1,NY,NX) + 2-RTDPX) + RTDPL(NR,L)=AMAX1(0.0,AMIN1(DLYR(3,L,NY,NX),RTDPL(NR,L)) + 2-AMAX1(0.0,SDPTH(NZ,NY,NX)-CDPTHZ(L-1,NY,NX)-HTCTL(NZ,NY,NX))) + RTDPS=AMAX1(SDPTH(NZ,NY,NX),CDPTHZ(L-1,NY,NX)) + 2+0.5*RTDPL(NR,L)+HTSTZ(NZ,NY,NX) + IF(RTDPS.GT.ZERO)THEN + RTSKP=XRTN1*RRAD1(N,L,NZ,NY,NX)**2/RTDPS + RTSKS=RTN2(N,L,NR,NZ,NY,NX)*RRAD2(N,L,NZ,NY,NX)**2 + 2/RTLGA(N,L,NZ,NY,NX) + IF(RTSKP+RTSKS.GT.ZEROP(NZ,NY,NX))THEN + RTSK2(N,L,NR)=RTSKP*RTSKS/(RTSKP+RTSKS) + ELSE + RTSK2(N,L,NR)=0.0 + ENDIF + ELSE + RTSK2(N,L,NR)=0.0 + ENDIF + ELSE + RTSK2(N,L,NR)=RTN2(N,L,NR,NZ,NY,NX)*RRAD2(N,L,NZ,NY,NX)**2 + 2/RTLGA(N,L,NZ,NY,NX) + ENDIF + RTNT(N)=RTNT(N)+RTSK2(N,L,NR) + RLNT(N,L)=RLNT(N,L)+RTSK2(N,L,NR) +C IF(NZ.EQ.3)THEN +C WRITE(*,3341)'SINK',I,J,NX,NY,NZ,L,NR,N +C 2,RTSK1(N,L,NR),RTSK2(N,L,NR),RLNT(N,L),RTNT(N) +C 3,XRTN1,PP(NZ,NY,NX),RRAD1(N,L,NZ,NY,NX),RTDPP +C 4,RTN2(N,L,NR,NZ,NY,NX),RRAD2(N,L,NZ,NY,NX) +C 2,RTLGA(N,L,NZ,NY,NX) +3341 FORMAT(A8,8I4,20E12.4) +C ENDIF +4985 CONTINUE +4990 CONTINUE +C +C RESPIRATION AND GROWTH OF ROOT, MYCORRHIZAE IN EACH LAYER +C + DO 5010 N=1,MY(NZ,NY,NX) + DO 5000 L=NU(NY,NX),NI(NZ,NY,NX) +C +C WATER STRESS CONSTRAINT ON SECONDARY ROOT EXTENSION IMPOSED +C BY ROOT TURGOR AND SOIL PENETRATION RESISTANCE +C + RSCS2=RSCS(L,NY,NX)*RRAD2(N,L,NZ,NY,NX)/1.0E-03 + WFNR=AMIN1(1.0,AMAX1(0.0,PSIRG(N,L,NZ,NY,NX)-PSILM-RSCS2)) + WFNRG=WFNR**0.25 + WFNGR(N,L)=EXP(0.10*PSIRT(N,L,NZ,NY,NX)) + DMRTD=1.0-DMRT(NZ,NY,NX) + RTLGL=0.0 + RTLGZ=0.0 + WTRTX=0.0 + WTRTZ=0.0 +C +C FOR EACH ROOT AXIS +C + DO 5050 NR=1,NRT(NZ,NY,NX) +C +C SECONDARY ROOT EXTENSION +C + IF(L.LE.NINR(NR,NZ,NY,NX).AND.NRX(N,NR).EQ.0)THEN +C +C FRACTION OF SECONDARY ROOT SINK IN SOIL LAYER ATTRIBUTED +C TO CURRENT AXIS +C + IF(RLNT(N,L).GT.ZEROP(NZ,NY,NX))THEN + FRTN=RTSK2(N,L,NR)/RLNT(N,L) + ELSE + FRTN=1.0 + ENDIF +C +C N,P CONSTRAINT ON SECONDARY ROOT RESPIRATION FROM +C NON-STRUCTURAL C:N:P +C + IF(CCPOLR(N,L,NZ,NY,NX).GT.ZERO)THEN + CNPG=AMIN1(CZPOLR(N,L,NZ,NY,NX)/(CZPOLR(N,L,NZ,NY,NX) + 2+CCPOLR(N,L,NZ,NY,NX)*CNKI),CPPOLR(N,L,NZ,NY,NX) + 3/(CPPOLR(N,L,NZ,NY,NX)+CCPOLR(N,L,NZ,NY,NX)*CPKI)) + ELSE + CNPG=1.0 + ENDIF +C +C O2-UNLIMITED SECONDARY ROOT RESPIRATION FROM NON-STRUCTURAL C +C CONSTRAINED BY TEMPERATURE AND NON-STRUCTURAL C:N:P +C + RCO2RM=AMAX1(0.0,VMXC*FRTN*CPOOLR(N,L,NZ,NY,NX) + 2*TFN4(L,NZ,NY,NX))*CNPG*FDBKX(NB1(NZ,NY,NX),NZ,NY,NX) + 3*WFNGR(N,L) +C +C O2-LIMITED SECONDARY ROOT RESPIRATION FROM 'WFR' IN 'UPTAKE' +C + RCO2R=RCO2RM*WFR(N,L,NZ,NY,NX) +C +C SECONDARY ROOT MAINTENANCE RESPIRATION FROM SOIL TEMPERATURE, +C ROOT STRUCTURAL N +C + RMNCR=AMAX1(0.0,RMPLT*WTRT2N(N,L,NR,NZ,NY,NX))*TFN6(L) + IF(IWTYP(NZ,NY,NX).EQ.2)THEN + RMNCR=RMNCR*WFNGR(N,L) + ENDIF + RCO2XM=RCO2RM-RMNCR + RCO2X=RCO2R-RMNCR + RCO2YM=AMAX1(0.0,RCO2XM)*WFNRG + RCO2Y=AMAX1(0.0,RCO2X)*WFNRG +C +C SECONDARY ROOT GROWTH RESPIRATION MAY BE LIMITED BY +C NON-STRUCTURAL N,P AVAILABLE FOR GROWTH +C + DMRTR=DMRTD*FRTN + ZPOOLB=AMAX1(0.0,ZPOOLR(N,L,NZ,NY,NX)) + PPOOLB=AMAX1(0.0,PPOOLR(N,L,NZ,NY,NX)) + FNP=AMIN1(ZPOOLB*DMRTR/CNRTS(NZ,NY,NX) + 2,PPOOLB*DMRTR/CPRTS(NZ,NY,NX)) + IF(RCO2YM.GT.0.0)THEN + RCO2GM=AMIN1(RCO2YM,FNP) + ELSE + RCO2GM=0.0 + ENDIF + IF(RCO2Y.GT.0.0)THEN + RCO2G=AMIN1(RCO2Y,FNP*WFR(N,L,NZ,NY,NX)) + ELSE + RCO2G=0.0 + ENDIF +C +C TOTAL NON-STRUCTURAL C,N,P USED IN SECONDARY ROOT GROWTH +C AND GROWTH RESPIRATION DEPENDS ON GROWTH YIELD ENTERED IN 'READQ' +C + CGRORM=RCO2GM/DMRTD + CGROR=RCO2G/DMRTD + GRTWGM=CGRORM*DMRT(NZ,NY,NX) + GRTWTG=CGROR*DMRT(NZ,NY,NX) + ZADD2M=AMAX1(0.0,GRTWGM*CNRTW) + ZADD2=AMAX1(0.0,AMIN1(FRTN*ZPOOLR(N,L,NZ,NY,NX),GRTWTG*CNRTW)) + PADD2=AMAX1(0.0,AMIN1(FRTN*PPOOLR(N,L,NZ,NY,NX),GRTWTG*CPRTW)) + CNRDM=AMAX1(0.0,1.70*ZADD2M) + CNRDA=AMAX1(0.0,1.70*ZADD2) +C +C SECONDARY ROOT GROWTH RESPIRATION FROM TOTAL - MAINTENANCE +C IF > 0 DRIVES GROWTH, IF < 0 DRIVES REMOBILIZATION, ALSO +C SECONDARY ROOT C LOSS FROM REMOBILIZATION AND CONSEQUENT LITTERFALL +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) + 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) + ELSE + CCC=0.0 + CNC=0.0 + CPC=0.0 + ENDIF + RCCC=RCCZR+CCC*RCCYR + RCCN=CNC*RCCX(IGTYP(NZ,NY,NX)) + RCCP=CPC*RCCQ(IGTYP(NZ,NY,NX)) + IF(-RCO2XM.GT.0.0)THEN + IF(-RCO2XM.LT.WTRT2(N,L,NR,NZ,NY,NX)*RCCC)THEN + SNCRM=-RCO2XM + ELSE + SNCRM=AMAX1(0.0,WTRT2(N,L,NR,NZ,NY,NX)*RCCC) + ENDIF + ELSE + SNCRM=0.0 + ENDIF + IF(-RCO2X.GT.0.0)THEN + IF(-RCO2X.LT.WTRT2(N,L,NR,NZ,NY,NX)*RCCC)THEN + SNCR=-RCO2X + ELSE + SNCR=AMAX1(0.0,WTRT2(N,L,NR,NZ,NY,NX)*RCCC) + 2*WFR(N,L,NZ,NY,NX) + ENDIF + ELSE + SNCR=0.0 + ENDIF +C +C RECOVERY OF REMOBILIZABLE N,P FROM SECONDARY ROOT DURING +C REMOBILIZATION DEPENDS ON ROOT NON-STRUCTURAL C:N:P +C + IF(SNCR.GT.0.0.AND.WTRT2(N,L,NR,NZ,NY,NX) + 2.GT.ZEROP(NZ,NY,NX))THEN + RCCR=RCCC*WTRT2(N,L,NR,NZ,NY,NX) + RCZR=WTRT2N(N,L,NR,NZ,NY,NX)*(RCCN+(1.0-RCCN) + 2*RCCR/WTRT2(N,L,NR,NZ,NY,NX)) + RCPR=WTRT2P(N,L,NR,NZ,NY,NX)*(RCCP+(1.0-RCCP) + 2*RCCR/WTRT2(N,L,NR,NZ,NY,NX)) + IF(RCCR.GT.ZEROP(NZ,NY,NX))THEN + FSNC2=AMAX1(0.0,AMIN1(1.0,SNCR/RCCR)) + ELSE + FSNC2=1.0 + ENDIF + ELSE + RCCR=0.0 + RCZR=0.0 + RCPR=0.0 + FSNC2=0.0 + ENDIF +C +C SECONDARY ROOT LITTERFALL CAUSED BY REMOBILIZATION +C + DO 6350 M=1,4 + CSNC(M,0,L,NZ,NY,NX)=CSNC(M,0,L,NZ,NY,NX)+CFOPC(5,M,NZ,NY,NX) + 2*FSNC2*(WTRT2(N,L,NR,NZ,NY,NX)-RCCR)*FWOOD(0) + ZSNC(M,0,L,NZ,NY,NX)=ZSNC(M,0,L,NZ,NY,NX)+CFOPN(5,M,NZ,NY,NX) + 2*FSNC2*(WTRT2N(N,L,NR,NZ,NY,NX)-RCZR)*FWOODN(0) + PSNC(M,0,L,NZ,NY,NX)=PSNC(M,0,L,NZ,NY,NX)+CFOPP(5,M,NZ,NY,NX) + 2*FSNC2*(WTRT2P(N,L,NR,NZ,NY,NX)-RCPR)*FWOODP(0) + CSNC(M,1,L,NZ,NY,NX)=CSNC(M,1,L,NZ,NY,NX)+CFOPC(4,M,NZ,NY,NX) + 2*FSNC2*(WTRT2(N,L,NR,NZ,NY,NX)-RCCR)*FWOOD(1) + ZSNC(M,1,L,NZ,NY,NX)=ZSNC(M,1,L,NZ,NY,NX)+CFOPN(4,M,NZ,NY,NX) + 2*FSNC2*(WTRT2N(N,L,NR,NZ,NY,NX)-RCZR)*FWOODN(1) + PSNC(M,1,L,NZ,NY,NX)=PSNC(M,1,L,NZ,NY,NX)+CFOPP(4,M,NZ,NY,NX) + 2*FSNC2*(WTRT2P(N,L,NR,NZ,NY,NX)-RCPR)*FWOODP(1) +6350 CONTINUE +C +C CONSUMPTION OF NON-STRUCTURAL C,N,P BY SECONDARY ROOT +C + CPOOLR(N,L,NZ,NY,NX)=CPOOLR(N,L,NZ,NY,NX)-AMIN1(RMNCR,RCO2R) + 2-CGROR-CNRDA-SNCR+FSNC2*RCCR + ZPOOLR(N,L,NZ,NY,NX)=ZPOOLR(N,L,NZ,NY,NX)-ZADD2+FSNC2*RCZR + PPOOLR(N,L,NZ,NY,NX)=PPOOLR(N,L,NZ,NY,NX)-PADD2+FSNC2*RCPR +C +C TOTAL SECONDARY ROOT RESPIRATION +C + RCO2TM=AMIN1(RMNCR,RCO2RM)+RCO2GM+SNCRM+CNRDM + RCO2T=AMIN1(RMNCR,RCO2R)+RCO2G+SNCR+CNRDA + RCO2M(N,L,NZ,NY,NX)=RCO2M(N,L,NZ,NY,NX)+RCO2TM + RCO2N(N,L,NZ,NY,NX)=RCO2N(N,L,NZ,NY,NX)+RCO2T + RCO2A(N,L,NZ,NY,NX)=RCO2A(N,L,NZ,NY,NX)-RCO2T +C +C SECONDARY ROOT EXTENSION FROM ROOT GROWTH AND ROOT TURGOR +C + GRTLGL=GRTWTG*RTLG2X(N,NZ,NY,NX)*WFNR*FWOOD(1) + 2-FSNC2*RTLG2(N,L,NR,NZ,NY,NX) + GRTWTL=GRTWTG-FSNC2*WTRT2(N,L,NR,NZ,NY,NX) + GRTWTN=ZADD2-FSNC2*WTRT2N(N,L,NR,NZ,NY,NX) + GRTWTP=PADD2-FSNC2*WTRT2P(N,L,NR,NZ,NY,NX) +C +C UPDATE STATE VARIABLES FOR SECONDARY ROOT LENGTH, C, N, P +C AND AXIS NUMBER +C + RTLG2(N,L,NR,NZ,NY,NX)=RTLG2(N,L,NR,NZ,NY,NX)+GRTLGL + WTRT2(N,L,NR,NZ,NY,NX)=WTRT2(N,L,NR,NZ,NY,NX)+GRTWTL + WTRT2N(N,L,NR,NZ,NY,NX)=WTRT2N(N,L,NR,NZ,NY,NX)+GRTWTN + WTRT2P(N,L,NR,NZ,NY,NX)=WTRT2P(N,L,NR,NZ,NY,NX)+GRTWTP + WSRTL(N,L,NZ,NY,NX)=WSRTL(N,L,NZ,NY,NX) + 2+AMIN1(CNWS(NZ,NY,NX)*WTRT2N(N,L,NR,NZ,NY,NX) + 2,CPWS(NZ,NY,NX)*WTRT2P(N,L,NR,NZ,NY,NX)) + RTLGL=RTLGL+RTLG2(N,L,NR,NZ,NY,NX) + WTRTX=WTRTX+WTRT2(N,L,NR,NZ,NY,NX) + RTN2X=RTFQ(NZ,NY,NX)*XRTN1 + RTN2Y=RTFQ(NZ,NY,NX)*RTN2X + RTN2(N,L,NR,NZ,NY,NX)=RTN2X+RTN2Y + RTNL(N,L,NZ,NY,NX)=RTNL(N,L,NZ,NY,NX)+RTN2(N,L,NR,NZ,NY,NX) +C IF(L.EQ.1)THEN +C WRITE(*,9876)'RCO22',I,J,NZ,NR,L,N +C 2,RCO2TM,RCO2T,RMNCR,RCO2RM,RCO2R,RCO2GM,RCO2G +C 3,RCO2XM,RCO2X,CGROR,SNCRM,SNCR,CNRDA,CPOOLR(N,L,NZ,NY,NX),FRTN +C 4,TFN4(L,NZ,NY,NX),CNPG,FDBKX(NB1(NZ,NY,NX),NZ,NY,NX),WFNGR(N,L) +C 5,TFN6(L),GRTWTG,GRTWTL,GRTLGL,RTLG2(N,L,NR,NZ,NY,NX) +C 5,WTRT2(N,L,NR,NZ,NY,NX),RTLG2(N,L,NR,NZ,NY,NX) +C 4,RCO2M(N,L,NZ,NY,NX),RCO2A(N,L,NZ,NY,NX),WFR(N,L,NZ,NY,NX) +C 8,ZPOOLR(N,L,NZ,NY,NX),PPOOLR(N,L,NZ,NY,NX) +C 9,FSNC2,RLNT(N,L),RTSK1(N,L,NR),RTSK2(N,L,NR) +C 4,RTN2X,RTN2Y,XRTN1 +C 5,RTDPL(NR,L),RTDNP(N,L,NZ,NY,NX) +C 5,RTDP1(1,NR,NZ,NY,NX),CDPTHZ(L-1,NY,NX),DLYR(3,L,NY,NX) +C 6,SDPTH(NZ,NY,NX),HTCTL(NZ,NY,NX) +C 5,WFNRG,FNP,RTLGP(N,L,NZ,NY,NX),ZADD2,PADD2,CUPRO,CUPRL +C 7,RUPNH4(N,L,NZ,NY,NX),RUPNHB(N,L,NZ,NY,NX) +C 8,RUPNO3(N,L,NZ,NY,NX),RUPNOB(N,L,NZ,NY,NX) +C 9,RUPH2P(N,L,NZ,NY,NX),RUPH2B(N,L,NZ,NY,NX) +C 9,RUPH1P(N,L,NZ,NY,NX),RUPH1B(N,L,NZ,NY,NX) +C 6,RDFOMN(N,L,NZ,NY,NX),RDFOMP(N,L,NZ,NY,NX) +C 2,RTN1(N,L,NZ,NY,NX),RTN2(N,L,NR,NZ,NY,NX) +C 3,RTNL(N,L,NZ,NY,NX) +9876 FORMAT(A8,6I4,100E12.4) +C ENDIF +C +C PRIMARY ROOT EXTENSION +C + IF(N.EQ.1)THEN + IF(RTDP1(N,NR,NZ,NY,NX).GT.CDPTHZ(L-1,NY,NX) + 2.AND.ICHK1(N,NR).EQ.0)THEN + RTN1(N,L,NZ,NY,NX)=RTN1(N,L,NZ,NY,NX)+XRTN1 + IF(RTDP1(N,NR,NZ,NY,NX).LE.CDPTHZ(L,NY,NX))THEN + ICHK1(N,NR)=1 +C +C FRACTION OF PRIMARY ROOT SINK IN SOIL LAYER ATTRIBUTED TO CURRENT AXIS +C + IF(RLNT(N,L).GT.ZEROP(NZ,NY,NX))THEN + FRTN=RTSK1(N,L,NR)/RLNT(N,L) + ELSE + FRTN=1.0 + ENDIF +C +C WATER STRESS CONSTRAINT ON SECONDARY ROOT EXTENSION IMPOSED +C BY ROOT TURGOR AND SOIL PENETRATION RESISTANCE +C + RSCS1=RSCS(L,NY,NX)*RRAD1(N,L,NZ,NY,NX)/1.0E-03 + WFNR=AMIN1(1.0,AMAX1(0.0,PSIRG(N,L,NZ,NY,NX)-PSILM-RSCS1)) + WFNRG=WFNR**0.25 +C +C N,P CONSTRAINT ON PRIMARY ROOT RESPIRATION FROM +C NON-STRUCTURAL C:N:P +C + IF(CCPOLR(N,L,NZ,NY,NX).GT.ZERO)THEN + CNPG=AMIN1(CZPOLR(N,L,NZ,NY,NX)/(CZPOLR(N,L,NZ,NY,NX) + 2+CCPOLR(N,L,NZ,NY,NX)*CNKI),CPPOLR(N,L,NZ,NY,NX) + 3/(CPPOLR(N,L,NZ,NY,NX)+CCPOLR(N,L,NZ,NY,NX)*CPKI)) + ELSE + CNPG=1.0 + ENDIF +C +C O2-UNLIMITED PRIMARY ROOT RESPIRATION FROM ROOT NON-STRUCTURAL C +C CONSTRAINED BY TEMPERATURE AND NON-STRUCTURAL C:N:P +C + RCO2RM=AMAX1(0.0,VMXC*FRTN*CPOOLR(N,L,NZ,NY,NX) + 2*TFN4(L,NZ,NY,NX))*CNPG*FDBKX(NB1(NZ,NY,NX),NZ,NY,NX) + 3*WFNGR(N,L) +C +C O2-LIMITED PRIMARY ROOT RESPIRATION FROM 'WFR' IN 'UPTAKE' +C + RCO2R=RCO2RM*WFR(N,L,NZ,NY,NX) +C +C PRIMARY ROOT MAINTENANCE RESPIRATION FROM SOIL TEMPERATURE, +C ROOT STRUCTURAL N +C + RMNCR=AMAX1(0.0,RMPLT*RTWT1N(N,NR,NZ,NY,NX))*TFN6(L) + IF(IWTYP(NZ,NY,NX).EQ.2)THEN + RMNCR=RMNCR*WFNGR(N,L) + ENDIF + RCO2XM=RCO2RM-RMNCR + RCO2X=RCO2R-RMNCR + RCO2YM=AMAX1(0.0,RCO2XM)*WFNRG + RCO2Y=AMAX1(0.0,RCO2X)*WFNRG +C +C PRIMARY ROOT GROWTH RESPIRATION MAY BE LIMITED BY +C NON-STRUCTURAL N,P AVAILABLE FOR GROWTH +C + DMRTR=DMRTD*FRTN + ZPOOLB=AMAX1(0.0,ZPOOLR(N,L,NZ,NY,NX)) + PPOOLB=AMAX1(0.0,PPOOLR(N,L,NZ,NY,NX)) + FNP=AMIN1(ZPOOLB*DMRTR/CNRTS(NZ,NY,NX) + 2,PPOOLB*DMRTR/CPRTS(NZ,NY,NX)) + IF(RCO2YM.GT.0.0)THEN + RCO2GM=AMIN1(RCO2YM,FNP) + ELSE + RCO2GM=0.0 + ENDIF + IF(RCO2Y.GT.0.0)THEN + RCO2G=AMIN1(RCO2Y,FNP*WFR(N,L,NZ,NY,NX)) + ELSE + RCO2G=0.0 + ENDIF +C +C TOTAL NON-STRUCTURAL C,N,P USED IN PRIMARY ROOT GROWTH +C AND GROWTH RESPIRATION DEPENDS ON GROWTH YIELD +C ENTERED IN 'READQ' +C + CGRORM=RCO2GM/DMRTD + CGROR=RCO2G/DMRTD + GRTWGM=CGRORM*DMRT(NZ,NY,NX) + GRTWTG=CGROR*DMRT(NZ,NY,NX) + ZADD1M=AMAX1(0.0,GRTWGM*CNRTW) + ZADD1=AMAX1(0.0,AMIN1(FRTN*ZPOOLR(N,L,NZ,NY,NX),GRTWTG*CNRTW)) + PADD1=AMAX1(0.0,AMIN1(FRTN*PPOOLR(N,L,NZ,NY,NX),GRTWTG*CPRTW)) + CNRDM=AMAX1(0.0,1.70*ZADD1M) + CNRDA=AMAX1(0.0,1.70*ZADD1) +C +C PRIMARY ROOT GROWTH RESPIRATION FROM TOTAL - MAINTENANCE +C IF > 0 DRIVES GROWTH, IF < 0 DRIVES REMOBILIZATION, ALSO +C PRIMARY ROOT C LOSS FROM REMOBILIZATION AND CONSEQUENT LITTERFALL +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) + 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) + ELSE + CCC=0.0 + CNC=0.0 + CPC=0.0 + ENDIF + RCCC=RCCZR+CCC*RCCYR + RCCN=CNC*RCCX(IGTYP(NZ,NY,NX)) + RCCP=CPC*RCCQ(IGTYP(NZ,NY,NX)) + IF(-RCO2XM.GT.0.0)THEN + IF(-RCO2XM.LT.RTWT1(N,NR,NZ,NY,NX)*RCCC)THEN + SNCRM=-RCO2XM + ELSE + SNCRM=AMAX1(0.0,RTWT1(N,NR,NZ,NY,NX)*RCCC) + ENDIF + ELSE + SNCRM=0.0 + ENDIF + IF(-RCO2X.GT.0.0)THEN + IF(-RCO2X.LT.RTWT1(N,NR,NZ,NY,NX)*RCCC)THEN + SNCR=-RCO2X + ELSE + SNCR=AMAX1(0.0,RTWT1(N,NR,NZ,NY,NX)*RCCC) + 2*WFR(N,L,NZ,NY,NX) + ENDIF + ELSE + SNCR=0.0 + ENDIF +C +C RECOVERY OF REMOBILIZABLE N,P DURING PRIMARY ROOT REMOBILIZATION +C DEPENDS ON ROOT NON-STRUCTURAL C:N:P +C + IF(SNCR.GT.0.0.AND.RTWT1(N,NR,NZ,NY,NX) + 2.GT.ZEROP(NZ,NY,NX))THEN + RCCR=RCCC*RTWT1(N,NR,NZ,NY,NX) + RCZR=RTWT1N(N,NR,NZ,NY,NX)*(RCCN+(1.0-RCCN) + 2*RCCR/RTWT1(N,NR,NZ,NY,NX)) + RCPR=RTWT1P(N,NR,NZ,NY,NX)*(RCCP+(1.0-RCCP) + 2*RCCR/RTWT1(N,NR,NZ,NY,NX)) + IF(RCCR.GT.ZEROP(NZ,NY,NX))THEN + FSNC1=AMAX1(0.0,AMIN1(1.0,SNCR/RCCR)) + ELSE + FSNC1=1.0 + ENDIF + ELSE + RCCR=0.0 + RCZR=0.0 + RCPR=0.0 + FSNC1=0.0 + ENDIF +C +C PRIMARY ROOT LITTERFALL CAUSED BY REMOBILIZATION +C + DO 6355 M=1,4 + CSNC(M,0,L,NZ,NY,NX)=CSNC(M,0,L,NZ,NY,NX)+CFOPC(5,M,NZ,NY,NX) + 2*FSNC1*(RTWT1(N,NR,NZ,NY,NX)-RCCR)*FWOOD(0) + ZSNC(M,0,L,NZ,NY,NX)=ZSNC(M,0,L,NZ,NY,NX)+CFOPN(5,M,NZ,NY,NX) + 2*FSNC1*(RTWT1N(N,NR,NZ,NY,NX)-RCZR)*FWOODN(0) + PSNC(M,0,L,NZ,NY,NX)=PSNC(M,0,L,NZ,NY,NX)+CFOPP(5,M,NZ,NY,NX) + 2*FSNC1*(RTWT1P(N,NR,NZ,NY,NX)-RCPR)*FWOODP(0) + CSNC(M,1,L,NZ,NY,NX)=CSNC(M,1,L,NZ,NY,NX)+CFOPC(4,M,NZ,NY,NX) + 2*FSNC1*(RTWT1(N,NR,NZ,NY,NX)-RCCR)*FWOOD(1) + ZSNC(M,1,L,NZ,NY,NX)=ZSNC(M,1,L,NZ,NY,NX)+CFOPN(4,M,NZ,NY,NX) + 2*FSNC1*(RTWT1N(N,NR,NZ,NY,NX)-RCZR)*FWOODN(1) + PSNC(M,1,L,NZ,NY,NX)=PSNC(M,1,L,NZ,NY,NX)+CFOPP(4,M,NZ,NY,NX) + 2*FSNC1*(RTWT1P(N,NR,NZ,NY,NX)-RCPR)*FWOODP(1) +6355 CONTINUE +C +C CONSUMPTION OF NON-STRUCTURAL C,N,P BY PRIMARY ROOTS +C + CPOOLR(N,L,NZ,NY,NX)=CPOOLR(N,L,NZ,NY,NX)-AMIN1(RMNCR,RCO2R) + 2-CGROR-CNRDA-SNCR+FSNC1*RCCR + ZPOOLR(N,L,NZ,NY,NX)=ZPOOLR(N,L,NZ,NY,NX)-ZADD1+FSNC1*RCZR + PPOOLR(N,L,NZ,NY,NX)=PPOOLR(N,L,NZ,NY,NX)-PADD1+FSNC1*RCPR +C +C TOTAL PRIMARY ROOT RESPIRATION +C + RCO2TM=AMIN1(RMNCR,RCO2RM)+RCO2GM+SNCRM+CNRDM + RCO2T=AMIN1(RMNCR,RCO2R)+RCO2G+SNCR+CNRDA +C +C ALLOCATE PRIMARY ROOT TOTAL RESPIRATION TO ALL SOIL LAYERS +C THROUGH WHICH PRIMARY ROOTS GROW +C + IF(RTDP1(N,NR,NZ,NY,NX).GT.CDPTHZ(NG(NZ,NY,NX),NY,NX))THEN + DO 5100 LL=NG(NZ,NY,NX),NINR(NR,NZ,NY,NX) + FRCO2=RTLG1(N,LL,NR,NZ,NY,NX)/(RTDP1(N,NR,NZ,NY,NX) + 2-SDPTH(NZ,NY,NX)) + RCO2M(N,LL,NZ,NY,NX)=RCO2M(N,LL,NZ,NY,NX)+RCO2TM*FRCO2 + RCO2N(N,LL,NZ,NY,NX)=RCO2N(N,LL,NZ,NY,NX)+RCO2T*FRCO2 + RCO2A(N,LL,NZ,NY,NX)=RCO2A(N,LL,NZ,NY,NX)-RCO2T*FRCO2 +5100 CONTINUE + ELSE + RCO2M(N,L,NZ,NY,NX)=RCO2M(N,L,NZ,NY,NX)+RCO2TM + RCO2N(N,L,NZ,NY,NX)=RCO2N(N,L,NZ,NY,NX)+RCO2T + RCO2A(N,L,NZ,NY,NX)=RCO2A(N,L,NZ,NY,NX)-RCO2T + ENDIF +C +C ALLOCATE ANY NEGATIVE PRIMARY ROOT C,N,P GROWTH TO SECONDARY +C ROOTS ON THE SAME AXIS IN THE SAME LAYER UNTIL SECONDARY ROOTS +C HAVE DISAPPEARED +C + GRTWTL=GRTWTG-FSNC1*RTWT1(N,NR,NZ,NY,NX) + GRTWTN=ZADD1-FSNC1*RTWT1N(N,NR,NZ,NY,NX) + GRTWTP=PADD1-FSNC1*RTWT1P(N,NR,NZ,NY,NX) + IF(GRTWTL.LT.0.0)THEN + LX=MAX(1,L-1) + DO 5105 LL=L,LX,-1 + GRTWTM=GRTWTL + IF(GRTWTL.LT.0.0)THEN + IF(GRTWTL.GT.-WTRT2(N,LL,NR,NZ,NY,NX))THEN + RTLG2(N,LL,NR,NZ,NY,NX)=RTLG2(N,LL,NR,NZ,NY,NX)+GRTWTL + 2*RTLG2(N,LL,NR,NZ,NY,NX)/WTRT2(N,LL,NR,NZ,NY,NX) + WTRT2(N,LL,NR,NZ,NY,NX)=WTRT2(N,LL,NR,NZ,NY,NX)+GRTWTL + GRTWTL=0.0 + ELSE + GRTWTL=GRTWTL+WTRT2(N,LL,NR,NZ,NY,NX) + RTLG2(N,LL,NR,NZ,NY,NX)=0.0 + WTRT2(N,LL,NR,NZ,NY,NX)=0.0 + ENDIF + ENDIF + IF(GRTWTN.LT.0.0)THEN + IF(GRTWTN.GT.-WTRT2N(N,LL,NR,NZ,NY,NX))THEN + WTRT2N(N,LL,NR,NZ,NY,NX)=WTRT2N(N,LL,NR,NZ,NY,NX)+GRTWTN + GRTWTN=0.0 + ELSE + GRTWTN=GRTWTN+WTRT2N(N,LL,NR,NZ,NY,NX) + WTRT2N(N,LL,NR,NZ,NY,NX)=0.0 + ENDIF + ENDIF + IF(GRTWTP.LT.0.0)THEN + IF(GRTWTP.GT.-WTRT2P(N,LL,NR,NZ,NY,NX))THEN + WTRT2P(N,LL,NR,NZ,NY,NX)=WTRT2P(N,LL,NR,NZ,NY,NX)+GRTWTP + GRTWTP=0.0 + ELSE + GRTWTP=GRTWTP+WTRT2P(N,LL,NR,NZ,NY,NX) + WTRT2P(N,LL,NR,NZ,NY,NX)=0.0 + ENDIF + ENDIF +C WRITE(*,9876)'WTRT2',I,J,NZ,NR,LL,N +C 2,GRTWTL,GRTWTM,GRTWTG,FSNC1,SNCR,RCCR,RTWT1(N,NR,NZ,NY,NX) +C 3,WTRT2(1,LL,NR,NZ,NY,NX),WTRTL(1,LL,NZ,NY,NX) +C 3,WTRT2(2,LL,NR,NZ,NY,NX),WTRTL(2,LL,NZ,NY,NX) +C 4,RTLG2(1,LL,NR,NZ,NY,NX),RTLG1(1,LL,NR,NZ,NY,NX) +C 4,RTLG2(2,LL,NR,NZ,NY,NX),RTLG1(2,LL,NR,NZ,NY,NX) +C +C CONCURRENT LOSS OF MYCORRHIZAE AND NODULES +C + IF(GRTWTM.LT.0.0)THEN + IF(WTRT2(1,LL,NR,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + FSNCM=AMIN1(1.0,ABS(GRTWTM)/WTRT2(1,LL,NR,NZ,NY,NX)) + ELSE + FSNCM=1.0 + ENDIF + IF(WTRTL(1,LL,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + FSNCP=AMIN1(1.0,ABS(GRTWTM)/WTRTL(1,LL,NZ,NY,NX)) + ELSE + FSNCP=1.0 + ENDIF + DO 6450 M=1,4 + CSNC(M,0,LL,NZ,NY,NX)=CSNC(M,0,LL,NZ,NY,NX)+CFOPC(5,M,NZ,NY,NX) + 2*FSNCM*AMAX1(0.0,WTRT2(2,LL,NR,NZ,NY,NX))*FWOOD(0) + ZSNC(M,0,LL,NZ,NY,NX)=ZSNC(M,0,LL,NZ,NY,NX)+CFOPN(5,M,NZ,NY,NX) + 2*FSNCM*AMAX1(0.0,WTRT2N(2,LL,NR,NZ,NY,NX))*FWOODN(0) + PSNC(M,0,LL,NZ,NY,NX)=PSNC(M,0,LL,NZ,NY,NX)+CFOPP(5,M,NZ,NY,NX) + 2*FSNCM*AMAX1(0.0,WTRT2P(2,LL,NR,NZ,NY,NX))*FWOODP(0) + CSNC(M,1,LL,NZ,NY,NX)=CSNC(M,1,LL,NZ,NY,NX)+CFOPC(4,M,NZ,NY,NX) + 2*FSNCM*AMAX1(0.0,WTRT2(2,LL,NR,NZ,NY,NX))*FWOOD(1) + ZSNC(M,1,LL,NZ,NY,NX)=ZSNC(M,1,LL,NZ,NY,NX)+CFOPN(4,M,NZ,NY,NX) + 2*FSNCM*AMAX1(0.0,WTRT2N(2,LL,NR,NZ,NY,NX))*FWOODN(1) + PSNC(M,1,LL,NZ,NY,NX)=PSNC(M,1,LL,NZ,NY,NX)+CFOPP(4,M,NZ,NY,NX) + 2*FSNCM*AMAX1(0.0,WTRT2P(2,LL,NR,NZ,NY,NX))*FWOODP(1) + CSNC(M,1,LL,NZ,NY,NX)=CSNC(M,1,LL,NZ,NY,NX)+CFOPC(0,M,NZ,NY,NX) + 2*FSNCP*AMAX1(0.0,CPOOLR(2,LL,NZ,NY,NX)) + ZSNC(M,1,LL,NZ,NY,NX)=ZSNC(M,1,LL,NZ,NY,NX)+CFOPN(0,M,NZ,NY,NX) + 2*FSNCP*AMAX1(0.0,ZPOOLR(2,LL,NZ,NY,NX)) + PSNC(M,1,LL,NZ,NY,NX)=PSNC(M,1,LL,NZ,NY,NX)+CFOPP(0,M,NZ,NY,NX) + 2*FSNCP*AMAX1(0.0,PPOOLR(2,LL,NZ,NY,NX)) +6450 CONTINUE + RTLG2(2,LL,NR,NZ,NY,NX)=AMAX1(0.0,RTLG2(2,LL,NR,NZ,NY,NX)) + 2*(1.0-FSNCM) + WTRT2(2,LL,NR,NZ,NY,NX)=AMAX1(0.0,WTRT2(2,LL,NR,NZ,NY,NX)) + 2*(1.0-FSNCM) + WTRT2N(2,LL,NR,NZ,NY,NX)=AMAX1(0.0,WTRT2N(2,LL,NR,NZ,NY,NX)) + 2*(1.0-FSNCM) + WTRT2P(2,LL,NR,NZ,NY,NX)=AMAX1(0.0,WTRT2P(2,LL,NR,NZ,NY,NX)) + 2*(1.0-FSNCM) + CPOOLR(2,LL,NZ,NY,NX)=AMAX1(0.0,CPOOLR(2,LL,NZ,NY,NX)) + 2*(1.0-FSNCP) + ZPOOLR(2,LL,NZ,NY,NX)=AMAX1(0.0,ZPOOLR(2,LL,NZ,NY,NX)) + 2*(1.0-FSNCP) + PPOOLR(2,LL,NZ,NY,NX)=AMAX1(0.0,PPOOLR(2,LL,NZ,NY,NX)) + 2*(1.0-FSNCP) + ENDIF +5105 CONTINUE + ENDIF +C +C PRIMARY ROOT EXTENSION FROM ROOT GROWTH AND ROOT TURGOR +C + IF(GRTWTL.LT.0.0.AND.RTWT1(N,NR,NZ,NY,NX) + 2.GT.ZEROP(NZ,NY,NX))THEN + GRTLGL=GRTWTG*RTLG1X(N,NZ,NY,NX)/PP(NZ,NY,NX)*WFNR*FWOOD(1) + 2+GRTWTL*(RTDP1(N,NR,NZ,NY,NX)-SDPTH(NZ,NY,NX)) + 3/RTWT1(N,NR,NZ,NY,NX) + ELSE + GRTLGL=GRTWTG*RTLG1X(N,NZ,NY,NX)/PP(NZ,NY,NX)*WFNR*FWOOD(1) + ENDIF + IF(L.LT.NJ(NY,NX))THEN + GRTLGL=AMIN1(DLYR(3,L+1,NY,NX),GRTLGL) + ENDIF +C +C ALLOCATE PRIMARY ROOT GROWTH TO CURRENT +C AND NEXT SOIL LAYER WHEN PRIMARY ROOTS EXTEND ACROSS LOWER +C BOUNDARY OF CURRENT LAYER +C + IF(GRTLGL.GT.ZEROP(NZ,NY,NX).AND.L.LT.NJ(NY,NX))THEN + FGROL=AMAX1(0.0,AMIN1(1.0,(CDPTHZ(L,NY,NX) + 2-RTDP1(N,NR,NZ,NY,NX))/GRTLGL)) + IF(FGROL.LT.1.0)FGROL=0.0 + FGROZ=AMAX1(0.0,1.0-FGROL) + ELSE + FGROL=1.0 + FGROZ=0.0 + ENDIF +C +C UPDATE STATE VARIABLES FOR PRIMARY ROOT LENGTH, GROWTH +C AND AXIS NUMBER +C + RTWT1(N,NR,NZ,NY,NX)=RTWT1(N,NR,NZ,NY,NX)+GRTWTL + RTWT1N(N,NR,NZ,NY,NX)=RTWT1N(N,NR,NZ,NY,NX)+GRTWTN + RTWT1P(N,NR,NZ,NY,NX)=RTWT1P(N,NR,NZ,NY,NX)+GRTWTP + RTDP1(N,NR,NZ,NY,NX)=RTDP1(N,NR,NZ,NY,NX)+GRTLGL + WTRT1(N,L,NR,NZ,NY,NX)=WTRT1(N,L,NR,NZ,NY,NX)+GRTWTL*FGROL + WTRT1N(N,L,NR,NZ,NY,NX)=WTRT1N(N,L,NR,NZ,NY,NX)+GRTWTN*FGROL + WTRT1P(N,L,NR,NZ,NY,NX)=WTRT1P(N,L,NR,NZ,NY,NX)+GRTWTP*FGROL + WSRTL(N,L,NZ,NY,NX)=WSRTL(N,L,NZ,NY,NX) + 2+AMIN1(CNWS(NZ,NY,NX)*WTRT1N(N,L,NR,NZ,NY,NX) + 2,CPWS(NZ,NY,NX)*WTRT1P(N,L,NR,NZ,NY,NX)) + RTLG1(N,L,NR,NZ,NY,NX)=RTLG1(N,L,NR,NZ,NY,NX)+GRTLGL*FGROL +C +C TRANSFER C,N,P INTO NEXT SOIL LAYER +C WHEN PRIMARY ROOT EXTENDS ACROSS LOWER BOUNDARY +C OF CURRENT SOIL LAYER +C + IF(FGROZ.GT.0.0)THEN + WTRT1(N,L+1,NR,NZ,NY,NX)=WTRT1(N,L+1,NR,NZ,NY,NX) + 2+GRTWTL*FGROZ + WTRT1N(N,L+1,NR,NZ,NY,NX)=WTRT1N(N,L+1,NR,NZ,NY,NX) + 2+GRTWTN*FGROZ + WTRT1P(N,L+1,NR,NZ,NY,NX)=WTRT1P(N,L+1,NR,NZ,NY,NX) + 2+GRTWTP*FGROZ + WSRTL(N,L+1,NZ,NY,NX)=WSRTL(N,L+1,NZ,NY,NX) + 2+AMIN1(CNWS(NZ,NY,NX)*WTRT1N(N,L+1,NR,NZ,NY,NX) + 2,CPWS(NZ,NY,NX)*WTRT1P(N,L+1,NR,NZ,NY,NX)) + WTRTD(N,L+1,NZ,NY,NX)=WTRTD(N,L+1,NZ,NY,NX) + 2+WTRT1(N,L+1,NR,NZ,NY,NX) + RTLG1(N,L+1,NR,NZ,NY,NX)=RTLG1(N,L+1,NR,NZ,NY,NX)+GRTLGL*FGROZ + RRAD1(N,L+1,NZ,NY,NX)=RRAD1(N,L,NZ,NY,NX) + RTLGZ=RTLGZ+RTLG1(N,L+1,NR,NZ,NY,NX) + WTRTZ=WTRTZ+WTRT1(N,L+1,NR,NZ,NY,NX) + XFRC=FRTN*CPOOLR(N,L,NZ,NY,NX) + XFRN=FRTN*ZPOOLR(N,L,NZ,NY,NX) + XFRP=FRTN*PPOOLR(N,L,NZ,NY,NX) + CPOOLR(N,L,NZ,NY,NX)=CPOOLR(N,L,NZ,NY,NX)-XFRC + ZPOOLR(N,L,NZ,NY,NX)=ZPOOLR(N,L,NZ,NY,NX)-XFRN + PPOOLR(N,L,NZ,NY,NX)=PPOOLR(N,L,NZ,NY,NX)-XFRP + CPOOLR(N,L+1,NZ,NY,NX)=CPOOLR(N,L+1,NZ,NY,NX)+XFRC + ZPOOLR(N,L+1,NZ,NY,NX)=ZPOOLR(N,L+1,NZ,NY,NX)+XFRN + PPOOLR(N,L+1,NZ,NY,NX)=PPOOLR(N,L+1,NZ,NY,NX)+XFRP + PSIRT(N,L+1,NZ,NY,NX)=PSIRT(N,L,NZ,NY,NX) + PSIRO(N,L+1,NZ,NY,NX)=PSIRO(N,L,NZ,NY,NX) + PSIRG(N,L+1,NZ,NY,NX)=PSIRG(N,L,NZ,NY,NX) + NINR(NR,NZ,NY,NX)=MAX(NG(NZ,NY,NX),L+1) +C WRITE(*,9877)'INFIL',I,J,NZ,NR,L,N,NINR(NR,NZ,NY,NX) +C 2,FRTN,WTRTD(N,L+1,NZ,NY,NX),CPOOLR(N,L+1,NZ,NY,NX) +C 2,FGROZ,RTDP1(N,NR,NZ,NY,NX),GRTLGL,CDPTHZ(L,NY,NX) + ENDIF +C IF((I/10)*10.EQ.I.AND.J.EQ.14.AND.NZ.EQ.1)THEN +C WRITE(*,9877)'RCO21',I,J,NZ,NR,L,N,NINR(NR,NZ,NY,NX) +C 2,RCO2TM,RCO2T,RMNCR,RCO2RM,RCO2R,RCO2GM,RCO2G +C 3,RCO2XM,RCO2X,CGROR,SNCRM,SNCR,CNRDA,CPOOLR(N,L,NZ,NY,NX),FRTN +C 4,TFN4(L,NZ,NY,NX),CNPG,FDBKX(NB1(NZ,NY,NX),NZ,NY,NX),WFNGR(N,L) +C 5,TFN6(L),GRTWTG,GRTWTL,GRTLGL,RTWT1N(N,NR,NZ,NY,NX) +C 6,WTRT1(N,L,NR,NZ,NY,NX),RTDP1(N,NR,NZ,NY,NX) +C 3,RCO2M(N,L,NZ,NY,NX),RCO2A(N,L,NZ,NY,NX),WFR(N,L,NZ,NY,NX) +C 4,RTSK1(N,L,NR),RRAD1(N,L,NZ,NY,NX),RTDPP +C 5,PSIRG(N,L,NZ,NY,NX),WFNR,WFNRG,FWOOD(1) +C 6,RTDP1(N,NR,NZ,NY,NX),FGROZ,RTWT1(N,NR,NZ,NY,NX),FSNC1 +C 9,ZADD1,PADD1,ZPOOLR(N,L,NZ,NY,NX),PPOOLR(N,L,NZ,NY,NX) +C 1,RUPNH4(N,L,NZ,NY,NX),RUPNO3(N,L,NZ,NY,NX) +9877 FORMAT(A8,7I4,100E12.4) +C ENDIF + ENDIF +C +C TRANSFER PRIMARY ROOT C,N,P TO NEXT SOIL LAYER ABOVE THE +C CURRENT SOIL LAYER WHEN NEGATIVE PRIMARY ROOT GROWTH FORCES +C WITHDRAWAL FROM THE CURRENT SOIL LAYER AND ALL SECONDARY ROOTS +C IN THE CURRENT SOIL LAYER HAVE BEEN LOST +C + IF(L.EQ.NINR(NR,NZ,NY,NX))THEN + DO 5115 LL=L,NG(NZ,NY,NX)+1,-1 + IF(RTDP1(N,NR,NZ,NY,NX).LT.CDPTHZ(LL-1,NY,NX) + 2.OR.RTDP1(N,NR,NZ,NY,NX).LT.SDPTH(NZ,NY,NX))THEN + IF(RLNT(N,LL).GT.ZEROP(NZ,NY,NX))THEN + FRTN=(RTSK1(N,LL,NR)+RTSK2(N,LL,NR))/RLNT(N,LL) + ELSE + FRTN=1.0 + ENDIF + DO 5110 NN=1,MY(NZ,NY,NX) + WTRT1(NN,LL-1,NR,NZ,NY,NX)=WTRT1(NN,LL-1,NR,NZ,NY,NX) + 2+WTRT1(NN,LL,NR,NZ,NY,NX) + WTRT1N(NN,LL-1,NR,NZ,NY,NX)=WTRT1N(NN,LL-1,NR,NZ,NY,NX) + 2+WTRT1N(NN,LL,NR,NZ,NY,NX) + WTRT1P(NN,LL-1,NR,NZ,NY,NX)=WTRT1P(NN,LL-1,NR,NZ,NY,NX) + 2+WTRT1P(NN,LL,NR,NZ,NY,NX) + WTRT2(NN,LL-1,NR,NZ,NY,NX)=WTRT2(NN,LL-1,NR,NZ,NY,NX) + 2+WTRT2(NN,LL,NR,NZ,NY,NX) + WTRT2N(NN,LL-1,NR,NZ,NY,NX)=WTRT2N(NN,LL-1,NR,NZ,NY,NX) + 2+WTRT2N(NN,LL,NR,NZ,NY,NX) + WTRT2P(NN,LL-1,NR,NZ,NY,NX)=WTRT2P(NN,LL-1,NR,NZ,NY,NX) + 2+WTRT2P(NN,LL,NR,NZ,NY,NX) + RTLG1(NN,LL-1,NR,NZ,NY,NX)=RTLG1(NN,LL-1,NR,NZ,NY,NX) + 2+RTLG1(NN,LL,NR,NZ,NY,NX) + WTRT1(NN,LL,NR,NZ,NY,NX)=0.0 + WTRT1N(NN,LL,NR,NZ,NY,NX)=0.0 + WTRT1P(NN,LL,NR,NZ,NY,NX)=0.0 + WTRT2(NN,LL,NR,NZ,NY,NX)=0.0 + WTRT2N(NN,LL,NR,NZ,NY,NX)=0.0 + WTRT2P(NN,LL,NR,NZ,NY,NX)=0.0 + RTLG1(NN,LL,NR,NZ,NY,NX)=0.0 + XFRC=FRTN*CPOOLR(NN,LL,NZ,NY,NX) + XFRN=FRTN*ZPOOLR(NN,LL,NZ,NY,NX) + XFRP=FRTN*PPOOLR(NN,LL,NZ,NY,NX) + XFRW=FRTN*WSRTL(NN,L,NZ,NY,NX) + XFRD=FRTN*WTRTD(NN,LL,NZ,NY,NX) + CPOOLR(NN,LL,NZ,NY,NX)=CPOOLR(NN,LL,NZ,NY,NX)-XFRC + ZPOOLR(NN,LL,NZ,NY,NX)=ZPOOLR(NN,LL,NZ,NY,NX)-XFRN + PPOOLR(NN,LL,NZ,NY,NX)=PPOOLR(NN,LL,NZ,NY,NX)-XFRP + WSRTL(NN,LL,NZ,NY,NX)=WSRTL(NN,LL,NZ,NY,NX)-XFRW + WTRTD(NN,LL,NZ,NY,NX)=WTRTD(NN,LL,NZ,NY,NX)-XFRD + CPOOLR(NN,LL-1,NZ,NY,NX)=CPOOLR(NN,LL-1,NZ,NY,NX)+XFRC + ZPOOLR(NN,LL-1,NZ,NY,NX)=ZPOOLR(NN,LL-1,NZ,NY,NX)+XFRN + PPOOLR(NN,LL-1,NZ,NY,NX)=PPOOLR(NN,LL-1,NZ,NY,NX)+XFRP + WSRTL(NN,LL-1,NZ,NY,NX)=WSRTL(NN,LL-1,NZ,NY,NX)+XFRW + WTRTD(NN,LL-1,NZ,NY,NX)=WTRTD(NN,LL-1,NZ,NY,NX)+XFRD +C +C WITHDRAW GASES IN PRIMARY ROOTS +C + RCO2Z(NZ,NY,NX)=RCO2Z(NZ,NY,NX)-FRTN*(CO2A(NN,LL,NZ,NY,NX) + 2+CO2P(NN,LL,NZ,NY,NX)) + ROXYZ(NZ,NY,NX)=ROXYZ(NZ,NY,NX)-FRTN*(OXYA(NN,LL,NZ,NY,NX) + 2+OXYP(NN,LL,NZ,NY,NX)) + RCH4Z(NZ,NY,NX)=RCH4Z(NZ,NY,NX)-FRTN*(CH4A(NN,LL,NZ,NY,NX) + 2+CH4P(NN,LL,NZ,NY,NX)) + RN2OZ(NZ,NY,NX)=RN2OZ(NZ,NY,NX)-FRTN*(Z2OA(NN,LL,NZ,NY,NX) + 2+Z2OP(NN,LL,NZ,NY,NX)) + RNH3Z(NZ,NY,NX)=RNH3Z(NZ,NY,NX)-FRTN*(ZH3A(NN,LL,NZ,NY,NX) + 2+ZH3P(NN,LL,NZ,NY,NX)) + RH2GZ(NZ,NY,NX)=RH2GZ(NZ,NY,NX)-FRTN*(H2GA(NN,LL,NZ,NY,NX) + 2+H2GP(NN,LL,NZ,NY,NX)) + CO2A(NN,LL,NZ,NY,NX)=(1.0-FRTN)*CO2A(NN,LL,NZ,NY,NX) + OXYA(NN,LL,NZ,NY,NX)=(1.0-FRTN)*OXYA(NN,LL,NZ,NY,NX) + CH4A(NN,LL,NZ,NY,NX)=(1.0-FRTN)*CH4A(NN,LL,NZ,NY,NX) + Z2OA(NN,LL,NZ,NY,NX)=(1.0-FRTN)*Z2OA(NN,LL,NZ,NY,NX) + ZH3A(NN,LL,NZ,NY,NX)=(1.0-FRTN)*ZH3A(NN,LL,NZ,NY,NX) + H2GA(NN,LL,NZ,NY,NX)=(1.0-FRTN)*H2GA(NN,LL,NZ,NY,NX) + CO2P(NN,LL,NZ,NY,NX)=(1.0-FRTN)*CO2P(NN,LL,NZ,NY,NX) + OXYP(NN,LL,NZ,NY,NX)=(1.0-FRTN)*OXYP(NN,LL,NZ,NY,NX) + CH4P(NN,LL,NZ,NY,NX)=(1.0-FRTN)*CH4P(NN,LL,NZ,NY,NX) + Z2OP(NN,LL,NZ,NY,NX)=(1.0-FRTN)*Z2OP(NN,LL,NZ,NY,NX) + ZH3P(NN,LL,NZ,NY,NX)=(1.0-FRTN)*ZH3P(NN,LL,NZ,NY,NX) + H2GP(NN,LL,NZ,NY,NX)=(1.0-FRTN)*H2GP(NN,LL,NZ,NY,NX) +C IF(NZ.EQ.1.OR.NZ.EQ.4)THEN +C WRITE(*,9868)'WITHDR',I,J,NZ,NR,LL,NN,NINR(NR,NZ,NY,NX) +C 2,FRTN,RTSK1(N,LL,NR),RTSK2(N,LL,NR),RLNT(N,LL) +C 2,WTRTD(NN,LL-1,NZ,NY,NX),WTRTD(NN,LL,NZ,NY,NX) +C 2,RTLG1(NN,LL-1,NR,NZ,NY,NX),RTLG1(NN,LL,NR,NZ,NY,NX) +C 2,RTLG2(NN,LL-1,NR,NZ,NY,NX),RTLG2(NN,LL,NR,NZ,NY,NX) +C 3,RTDP1(N,NR,NZ,NY,NX),RTDP1(NN,NR,NZ,NY,NX) +C 4,CPOOLR(NN,LL-1,NZ,NY,NX),CPOOLR(NN,LL,NZ,NY,NX) +C 4,WTRT1(NN,LL-1,NR,NZ,NY,NX),WTRT1(NN,LL,NR,NZ,NY,NX) +C 4,WTRT2(NN,LL-1,NR,NZ,NY,NX),WTRT2(NN,LL,NR,NZ,NY,NX) +9868 FORMAT(A8,7I4,100E24.16) +C ENDIF +5110 CONTINUE + RTNL(N,LL,NZ,NY,NX)=RTNL(N,LL,NZ,NY,NX) + 2-RTN2(N,LL,NR,NZ,NY,NX) + RTNL(N,LL-1,NZ,NY,NX)=RTNL(N,LL-1,NZ,NY,NX) + 2+RTN2(N,LL,NR,NZ,NY,NX) + RTN2(N,LL,NR,NZ,NY,NX)=0.0 + RTN1(N,LL,NZ,NY,NX)=RTN1(N,LL,NZ,NY,NX)-XRTN1 +C +C RESET PRIMARY ROOT LENGTH +C + IF(LL-1.GT.NG(NZ,NY,NX))THEN + RTLG1(N,LL-1,NR,NZ,NY,NX)=DLYR(3,LL-1,NY,NX) + 2-(CDPTHZ(LL-1,NY,NX)-RTDP1(N,NR,NZ,NY,NX)) + ELSE + RTLG1(N,LL-1,NR,NZ,NY,NX)=DLYR(3,LL-1,NY,NX) + 2-(CDPTHZ(LL-1,NY,NX)-RTDP1(N,NR,NZ,NY,NX)) + 3-(SDPTH(NZ,NY,NX)-CDPTHZ(LL-2,NY,NX)) + ENDIF +C +C REMOBILIZE C,N,P FROM ROOT NODULES IN LEGUMES +C + IF(INTYP(NZ,NY,NX).EQ.1.OR.INTYP(NZ,NY,NX).EQ.2)THEN + XFRC=FRTN*WTNDL(LL,NZ,NY,NX) + XFRN=FRTN*WTNDLN(LL,NZ,NY,NX) + XFRP=FRTN*WTNDLP(LL,NZ,NY,NX) + WTNDL(LL,NZ,NY,NX)=WTNDL(LL,NZ,NY,NX)-XFRC + WTNDLN(LL,NZ,NY,NX)=WTNDLN(LL,NZ,NY,NX)-XFRN + WTNDLP(LL,NZ,NY,NX)=WTNDLP(LL,NZ,NY,NX)-XFRP + WTNDL(LL-1,NZ,NY,NX)=WTNDL(LL-1,NZ,NY,NX)+XFRC + WTNDLN(LL-1,NZ,NY,NX)=WTNDLN(LL-1,NZ,NY,NX)+XFRN + WTNDLP(LL-1,NZ,NY,NX)=WTNDLP(LL-1,NZ,NY,NX)+XFRP + XFRC=FRTN*CPOOLN(LL,NZ,NY,NX) + XFRN=FRTN*ZPOOLN(LL,NZ,NY,NX) + XFRP=FRTN*PPOOLN(LL,NZ,NY,NX) + CPOOLN(LL,NZ,NY,NX)=CPOOLN(LL,NZ,NY,NX)-XFRC + ZPOOLN(LL,NZ,NY,NX)=ZPOOLN(LL,NZ,NY,NX)-XFRN + PPOOLN(LL,NZ,NY,NX)=PPOOLN(LL,NZ,NY,NX)-XFRP + CPOOLN(LL-1,NZ,NY,NX)=CPOOLN(LL-1,NZ,NY,NX)+XFRC + ZPOOLN(LL-1,NZ,NY,NX)=ZPOOLN(LL-1,NZ,NY,NX)+XFRN + PPOOLN(LL-1,NZ,NY,NX)=PPOOLN(LL-1,NZ,NY,NX)+XFRP +C WRITE(*,9868)'WITHDRN',I,J,NZ,NR,LL,NN,NINR(NR,NZ,NY,NX) +C 2,WTNDL(LL,NZ,NY,NX),CPOOLN(LL,NZ,NY,NX),RTDP1(N,NR,NZ,NY,NX) + ENDIF + NINR(NR,NZ,NY,NX)=MAX(NG(NZ,NY,NX),LL-1) + ELSE + GO TO 5120 + ENDIF +5115 CONTINUE + ENDIF +5120 CONTINUE + IF(WTRT1(N,L,NR,NZ,NY,NX).LT.0.0)THEN + CPOOLR(N,L,NZ,NY,NX)=CPOOLR(N,L,NZ,NY,NX)+WTRT1(N,L,NR,NZ,NY,NX) + WTRT1(N,L,NR,NZ,NY,NX)=0.0 + ENDIF + IF(WTRT2(N,L,NR,NZ,NY,NX).LT.0.0)THEN + CPOOLR(N,L,NZ,NY,NX)=CPOOLR(N,L,NZ,NY,NX)+WTRT2(N,L,NR,NZ,NY,NX) + WTRT2(N,L,NR,NZ,NY,NX)=0.0 + ENDIF +C +C TOTAL ROOT LENGTH AND MASS +C + RTLGZ=RTLGZ+RTLG1(N,L,NR,NZ,NY,NX) + WTRTZ=WTRTZ+WTRT1(N,L,NR,NZ,NY,NX) + NINR(NR,NZ,NY,NX)=MIN(NINR(NR,NZ,NY,NX),NJ(NY,NX)) + IF(L.EQ.NINR(NR,NZ,NY,NX))NRX(N,NR)=1 + ENDIF + ENDIF + RTLGZ=RTLGZ+RTLG1(N,L,NR,NZ,NY,NX) + WTRTZ=WTRTZ+WTRT1(N,L,NR,NZ,NY,NX) +C ENDIF + ENDIF + NIX(NZ,NY,NX)=MAX(NIX(NZ,NY,NX),NINR(NR,NZ,NY,NX)) +5050 CONTINUE +C +C DRAW FROM ROOT NON-STRUCTURAL POOL WHEN +C SEASONAL STORAGE POOL IS DEPLETED +C + IF(L.LE.NIX(NZ,NY,NX))THEN + IF(WTRTL(N,L,NZ,NY,NX).GT.ZEROP(NZ,NY,NX) + 2.AND.WTRT(NZ,NY,NX).GT.ZEROP(NZ,NY,NX) + 2.AND.WTRVC(NZ,NY,NX).LT.XFRX*WTRT(NZ,NY,NX))THEN + FWTRT=WTRTL(N,L,NZ,NY,NX)/WTRT(NZ,NY,NX) + WTRTLX=WTRTL(N,L,NZ,NY,NX) + WTRTTX=WTRT(NZ,NY,NX)*FWTRT + WTRTTT=WTRTLX+WTRTTX + CPOOLX=AMAX1(0.0,CPOOLR(N,L,NZ,NY,NX)) + WTRVCX=AMAX1(0.0,WTRVC(NZ,NY,NX)*FWTRT) + CPOOLD=(WTRVCX*WTRTLX-CPOOLX*WTRTTX)/WTRTTT + XFRC=AMIN1(0.0,XFRY*CPOOLD) + CPOOLR(N,L,NZ,NY,NX)=CPOOLR(N,L,NZ,NY,NX)+XFRC + WTRVC(NZ,NY,NX)=WTRVC(NZ,NY,NX)-XFRC +C WRITE(*,3471)'RVC',I,J,NX,NY,NZ,L +C 2,XFRC,CPOOLR(N,L,NZ,NY,NX),WTRTD(N,L,NZ,NY,NX) +C 3,WTRVC(NZ,NY,NX),WTRT(NZ,NY,NX),FWTRT +3471 FORMAT(A8,6I4,12E12.4) + ENDIF + ENDIF +C +C ROOT AND MYCORRHIZAL LENGTH, DENSITY, VOLUME, RADIUS, AREA +C TO CALCULATE WATER AND NUTRIENT UPTAKE IN 'UPTAKE' +C + IF(N.EQ.1)THEN + RTLGZ=RTLGZ*FWOOD(1) + RTLGL=RTLGL*FWOOD(1) + ENDIF + RTLGX=RTLGZ*PP(NZ,NY,NX) + RTLGT=RTLGL+RTLGX + WTRTT=WTRTX+WTRTZ + IF(RTLGT.GT.ZEROP(NZ,NY,NX).AND.WTRTT.GT.ZEROP(NZ,NY,NX) + 2.AND.PP(NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + RTLGP(N,L,NZ,NY,NX)=RTLGT/PP(NZ,NY,NX) + RTDNP(N,L,NZ,NY,NX)=RTLGP(N,L,NZ,NY,NX)/DLYR(3,L,NY,NX) + RTVL=AMAX1(RTAR1X(N,NZ,NY,NX)*RTLGX+RTAR2X(N,NZ,NY,NX)*RTLGL + 2,WTRTT*DMVL(N,NZ,NY,NX)*PSIRG(N,L,NZ,NY,NX)) + RTVLP(N,L,NZ,NY,NX)=PORT(N,NZ,NY,NX)*RTVL + RTVLW(N,L,NZ,NY,NX)=(1.0-PORT(N,NZ,NY,NX))*RTVL + RRAD1(N,L,NZ,NY,NX)=AMAX1(RRAD1X(N,NZ,NY,NX) + 2,(1.0+PSIRT(N,L,NZ,NY,NX)/EMODR)*RRAD1M(N,NZ,NY,NX)) + RRAD2(N,L,NZ,NY,NX)=AMAX1(RRAD2X(N,NZ,NY,NX) + 2,(1.0+PSIRT(N,L,NZ,NY,NX)/EMODR)*RRAD2M(N,NZ,NY,NX)) + RTAR=6.283*RRAD1(N,L,NZ,NY,NX)*RTLGX + 2+6.283*RRAD2(N,L,NZ,NY,NX)*RTLGL + RTARP(N,L,NZ,NY,NX)=RTAR/PP(NZ,NY,NX) + IF(RTNL(N,L,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + RTLGA(N,L,NZ,NY,NX)=AMAX1(RTLGAX,RTLGL/RTNL(N,L,NZ,NY,NX)) + ELSE + RTLGA(N,L,NZ,NY,NX)=RTLGAX + ENDIF + ELSE + RTLGP(N,L,NZ,NY,NX)=0.0 + RTDNP(N,L,NZ,NY,NX)=0.0 + RTVLP(N,L,NZ,NY,NX)=0.0 + RTVLW(N,L,NZ,NY,NX)=0.0 + RRAD1(N,L,NZ,NY,NX)=RRAD1M(N,NZ,NY,NX) + RRAD2(N,L,NZ,NY,NX)=RRAD2M(N,NZ,NY,NX) + RTARP(N,L,NZ,NY,NX)=0.0 + RTLGA(N,L,NZ,NY,NX)=RTLGAX + RCO2Z(NZ,NY,NX)=RCO2Z(NZ,NY,NX)-(CO2A(N,L,NZ,NY,NX) + 2+CO2P(N,L,NZ,NY,NX)) + ROXYZ(NZ,NY,NX)=ROXYZ(NZ,NY,NX)-(OXYA(N,L,NZ,NY,NX) + 2+OXYP(N,L,NZ,NY,NX)) + RCH4Z(NZ,NY,NX)=RCH4Z(NZ,NY,NX)-(CH4A(N,L,NZ,NY,NX) + 2+CH4P(N,L,NZ,NY,NX)) + RN2OZ(NZ,NY,NX)=RN2OZ(NZ,NY,NX)-(Z2OA(N,L,NZ,NY,NX) + 2+Z2OP(N,L,NZ,NY,NX)) + RNH3Z(NZ,NY,NX)=RNH3Z(NZ,NY,NX)-(ZH3A(N,L,NZ,NY,NX) + 2+ZH3P(N,L,NZ,NY,NX)) + RH2GZ(NZ,NY,NX)=RH2GZ(NZ,NY,NX)-(H2GA(N,L,NZ,NY,NX) + 2+H2GP(N,L,NZ,NY,NX)) + CO2A(N,L,NZ,NY,NX)=0.0 + OXYA(N,L,NZ,NY,NX)=0.0 + CH4A(N,L,NZ,NY,NX)=0.0 + Z2OA(N,L,NZ,NY,NX)=0.0 + ZH3A(N,L,NZ,NY,NX)=0.0 + H2GA(N,L,NZ,NY,NX)=0.0 + CO2P(N,L,NZ,NY,NX)=0.0 + OXYP(N,L,NZ,NY,NX)=0.0 + CH4P(N,L,NZ,NY,NX)=0.0 + Z2OP(N,L,NZ,NY,NX)=0.0 + ZH3P(N,L,NZ,NY,NX)=0.0 + H2GP(N,L,NZ,NY,NX)=0.0 + ENDIF +5000 CONTINUE +5010 CONTINUE +C +C ADD SEED DIMENSIONS TO ROOT DIMENSIONS (ONLY IMPORTANT DURING +C GERMINATION) +C + RTLGP(1,NG(NZ,NY,NX),NZ,NY,NX)=RTLGP(1,NG(NZ,NY,NX),NZ,NY,NX) + 2+SDLG(NZ,NY,NX) + RTDNP(1,NG(NZ,NY,NX),NZ,NY,NX)=RTLGP(1,NG(NZ,NY,NX),NZ,NY,NX) + 2/DLYR(3,NG(NZ,NY,NX),NY,NX) + RTVL=RTVLP(1,NG(NZ,NY,NX),NZ,NY,NX)+RTVLW(1,NG(NZ,NY,NX),NZ,NY,NX) + 2+SDVL(NZ,NY,NX)*PP(NZ,NY,NX) + RTVLP(1,NG(NZ,NY,NX),NZ,NY,NX)=PORT(1,NZ,NY,NX)*RTVL + RTVLW(1,NG(NZ,NY,NX),NZ,NY,NX)=(1.0-PORT(1,NZ,NY,NX))*RTVL + RTARP(1,NG(NZ,NY,NX),NZ,NY,NX)=RTARP(1,NG(NZ,NY,NX),NZ,NY,NX) + 2+SDAR(NZ,NY,NX) + IF(IDTHRN.EQ.NRT(NZ,NY,NX).OR.(WTRVC(NZ,NY,NX) + 2.LT.ZEROL(NZ,NY,NX).AND.ISTYP(NZ,NY,NX).NE.0))THEN + IDTHR(NZ,NY,NX)=1 + IDTHP(NZ,NY,NX)=1 + ENDIF +C +C ROOT N2 FIXATION (LEGUMES) +C + IF((INTYP(NZ,NY,NX).EQ.1.OR.INTYP(NZ,NY,NX).EQ.2))THEN + DO 5400 L=NU(NY,NX),NIX(NZ,NY,NX) + IF(WTRTD(1,L,NZ,NY,NX).GT.ZEROL(NZ,NY,NX))THEN +C +C INITIAL INFECTION +C + IF(WTNDL(L,NZ,NY,NX).LE.0.0)THEN + WTNDL(L,NZ,NY,NX)=WTNDL(L,NZ,NY,NX) + 2+WTNDI*AREA(3,NU(NY,NX),NY,NX) + WTNDLN(L,NZ,NY,NX)=WTNDLN(L,NZ,NY,NX) + 2+WTNDI*AREA(3,NU(NY,NX),NY,NX)*CNND(NZ,NY,NX) + WTNDLP(L,NZ,NY,NX)=WTNDLP(L,NZ,NY,NX) + 2+WTNDI*AREA(3,NU(NY,NX),NY,NX)*CPND(NZ,NY,NX) + ENDIF +C +C O2-UNCONSTRAINED RESPIRATION RATES BY HETEROTROPHIC AEROBES +C IN NODULE FROM SPECIFIC OXIDATION RATE, ACTIVE BIOMASS, +C NON-STRUCTURAL C CONCENTRATION, MICROBIAL C:N:P FACTOR, +C AND TEMPERATURE +C + IF(WTNDL(L,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + CCPOLN=AMAX1(0.0,CPOOLN(L,NZ,NY,NX)/WTNDL(L,NZ,NY,NX)) + CZPOLN=AMAX1(0.0,ZPOOLN(L,NZ,NY,NX)/WTNDL(L,NZ,NY,NX)) + CPPOLN=AMAX1(0.0,PPOOLN(L,NZ,NY,NX)/WTNDL(L,NZ,NY,NX)) + ELSE + CCPOLN=1.0 + CZPOLN=1.0 + 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) + ELSE + CCC=0.0 + CNC=0.0 + CPC=0.0 + CNF=0.0 + ENDIF + IF(WTNDL(L,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + FCNPF=AMIN1(1.0,AMAX1(0.0 + 2,WTNDLN(L,NZ,NY,NX)/(WTNDL(L,NZ,NY,NX)*CNND(NZ,NY,NX)) + 3,WTNDLP(L,NZ,NY,NX)/(WTNDL(L,NZ,NY,NX)*CPND(NZ,NY,NX)))) + ELSE + FCNPF=1.0 + ENDIF + RDNDLX=CCPOLN/(CCPOLN+CCNKX) + RCNDLM=AMAX1(0.0,AMIN1(CPOOLN(L,NZ,NY,NX)*(1.0-DMND(NZ,NY,NX)) + 2,VMXO*WTNDL(L,NZ,NY,NX)*CCPOLN/(CCPOLN+CCNKM) + 3*TFN4(L,NZ,NY,NX)*FCNPF*WFNGR(1,L)))*CNF +C +C O2-LIMITED NODULE RESPIRATION FROM 'WFR' IN 'UPTAKE' +C + RCNDL=RCNDLM*WFR(1,L,NZ,NY,NX) +C +C NODULE MAINTENANCE RESPIRATION FROM SOIL TEMPERATURE, +C NODULE STRUCTURAL N +C + RMNDL=AMAX1(0.0,RMPLT*WTNDLN(L,NZ,NY,NX))*TFN6(L)*RDNDLX +C +C NODULE GROWTH RESPIRATION FROM TOTAL - MAINTENANCE +C IF > 0 DRIVES GROWTH, IF < 0 DRIVES REMOBILIZATION +C + RXNDLM=RCNDLM-RMNDL + RXNDL=RCNDL-RMNDL + RGNDLM=AMAX1(0.0,RXNDLM) + RGNDL=AMAX1(0.0,RXNDL) + RSNDLM=AMAX1(0.0,-RXNDLM) + RSNDL=AMAX1(0.0,-RXNDL) +C +C NODULE N2 FIXATION FROM GROWTH RESPIRATION, FIXATION ENERGY +C REQUIREMENT AND NON-STRUCTURAL C:N:P PRODUCT INHIBITION, +C CONSTRAINED BY MICROBIAL N REQUIREMENT +C + RGN2P=AMAX1(0.0,WTNDL(L,NZ,NY,NX)*CNND(NZ,NY,NX) + 2-WTNDLN(L,NZ,NY,NX))/EN2F + RGN2F=AMIN1(RGNDL,RGN2P) + RUPNF(L,NZ,NY,NX)=RGN2F*EN2F + UPNF(NZ,NY,NX)=UPNF(NZ,NY,NX)+RUPNF(L,NZ,NY,NX) +C +C TOTAL NON-STRUCTURAL C,N,P USED IN NODULE GROWTH +C AND GROWTH RESPIRATION DEPENDS ON GROWTH YIELD ENTERED IN 'READQ' +C + CGNDL=(RGNDL-RGN2F)/(1.0-DMND(NZ,NY,NX)) + GRNDG=CGNDL*DMND(NZ,NY,NX) + ZADDN=AMAX1(0.0,AMIN1(ZPOOLN(L,NZ,NY,NX) + 2,GRNDG*CNND(NZ,NY,NX))*CCC) + PADDN=AMAX1(0.0,AMIN1(PPOOLN(L,NZ,NY,NX) + 2,GRNDG*CPND(NZ,NY,NX))*CCC) +C +C NODULE C,N,P REMOBILIZATION AND DECOMPOSITION +C + RCCC=RCCZN+CCC*RCCYN + RCCN=CNC*RCCX(IGTYP(NZ,NY,NX)) + RCCP=CPC*RCCQ(IGTYP(NZ,NY,NX)) + SPNDX=SPNDL*RDNDLX + RXNDLC=SPNDX*WTNDL(L,NZ,NY,NX)*WFNGR(1,L) + RXNDLN=SPNDX*WTNDLN(L,NZ,NY,NX)*WFNGR(1,L) + RXNDLP=SPNDX*WTNDLP(L,NZ,NY,NX)*WFNGR(1,L) + RDNDLC=RXNDLC*(1.0-RCCC) + RDNDLN=RXNDLN*(1.0-RCCN)*(1.0-RCCC) + RDNDLP=RXNDLP*(1.0-RCCP)*(1.0-RCCC) + RCNDLC=RXNDLC-RDNDLC + RCNDLN=RXNDLN-RDNDLN + RCNDLP=RXNDLP-RDNDLP +C +C NODULE SENESCENCE +C + IF(RSNDL.GT.0.0.AND.WTNDL(L,NZ,NY,NX).GT.ZEROP(NZ,NY,NX) + 2.AND.RCCC.GT.ZERO)THEN + RXNSNC=RSNDL/RCCC + RXNSNN=RXNSNC*WTNDLN(L,NZ,NY,NX)/WTNDL(L,NZ,NY,NX) + RXNSNP=RXNSNC*WTNDLP(L,NZ,NY,NX)/WTNDL(L,NZ,NY,NX) + RDNSNC=RXNSNC*(1.0-RCCC) + RDNSNN=RXNSNN*(1.0-RCCN)*(1.0-RCCC) + RDNSNP=RXNSNP*(1.0-RCCP)*(1.0-RCCC) + RCNSNC=RXNSNC-RDNSNC + RCNSNN=RXNSNN-RDNSNN + RCNSNP=RXNSNP-RDNSNP + ELSE + RXNSNC=0.0 + RXNSNN=0.0 + RXNSNP=0.0 + RDNSNC=0.0 + RDNSNN=0.0 + RDNSNP=0.0 + RCNSNC=0.0 + RCNSNN=0.0 + RCNSNP=0.0 + ENDIF +C +C TOTAL NODULE RESPIRATION +C + RCO2TM=AMIN1(RMNDL,RCNDLM)+RGNDLM+RCNSNC + RCO2T=AMIN1(RMNDL,RCNDL)+RGNDL+RCNSNC + RCO2M(1,L,NZ,NY,NX)=RCO2M(1,L,NZ,NY,NX)+RCO2TM + RCO2N(1,L,NZ,NY,NX)=RCO2N(1,L,NZ,NY,NX)+RCO2T + RCO2A(1,L,NZ,NY,NX)=RCO2A(1,L,NZ,NY,NX)-RCO2T +C +C NODULE LITTERFALL CAUSED BY REMOBILIZATION +C + DO 6370 M=1,4 + CSNC(M,1,L,NZ,NY,NX)=CSNC(M,1,L,NZ,NY,NX)+CFOPC(4,M,NZ,NY,NX) + 2*(RDNDLC+RDNSNC) + ZSNC(M,1,L,NZ,NY,NX)=ZSNC(M,1,L,NZ,NY,NX)+CFOPN(4,M,NZ,NY,NX) + 2*(RDNDLN+RDNSNN) + PSNC(M,1,L,NZ,NY,NX)=PSNC(M,1,L,NZ,NY,NX)+CFOPP(4,M,NZ,NY,NX) + 2*(RDNDLP+RDNSNP) +6370 CONTINUE +C +C CONSUMPTION OF NON-STRUCTURAL C,N,P BY NODULE +C + CPOOLN(L,NZ,NY,NX)=CPOOLN(L,NZ,NY,NX)-AMIN1(RMNDL,RCNDL) + 2-RGN2F-CGNDL+RCNDLC + ZPOOLN(L,NZ,NY,NX)=ZPOOLN(L,NZ,NY,NX)-ZADDN+RCNDLN+RCNSNN + 2+RUPNF(L,NZ,NY,NX) + PPOOLN(L,NZ,NY,NX)=PPOOLN(L,NZ,NY,NX)-PADDN+RCNDLP+RCNSNP +C +C UPDATE STATE VARIABLES FOR NODULE C, N, P +C + WTNDL(L,NZ,NY,NX)=WTNDL(L,NZ,NY,NX)+GRNDG-RXNDLC-RXNSNC + WTNDLN(L,NZ,NY,NX)=WTNDLN(L,NZ,NY,NX)+ZADDN-RXNDLN-RXNSNN + WTNDLP(L,NZ,NY,NX)=WTNDLP(L,NZ,NY,NX)+PADDN-RXNDLP-RXNSNP +C +C TRANSFER NON-STRUCTURAL C,N,P BETWEEN ROOT AND NODULES +C FROM NON-STRUCTURAL C,N,P CONCENTRATION DIFFERENCES +C + IF(CPOOLR(1,L,NZ,NY,NX).GT.ZEROP(NZ,NY,NX) + 2.AND.WTRTD(1,L,NZ,NY,NX).GT.ZEROL(NZ,NY,NX))THEN + WTRTD1=WTRTD(1,L,NZ,NY,NX) + WTNDL1=AMIN1(WTRTD(1,L,NZ,NY,NX),AMAX1(FSNKM + 2*WTRTD(1,L,NZ,NY,NX),WTNDL(L,NZ,NY,NX))) + WTRTDT=WTRTD1+WTNDL1 + IF(WTRTDT.GT.ZEROP(NZ,NY,NX))THEN + CPOOLD=(CPOOLR(1,L,NZ,NY,NX)*WTNDL1 + 2-CPOOLN(L,NZ,NY,NX)*WTRTD1)/WTRTDT + XFRC=FXRN(INTYP(NZ,NY,NX))*CPOOLD + CPOOLR(1,L,NZ,NY,NX)=CPOOLR(1,L,NZ,NY,NX)-XFRC + CPOOLN(L,NZ,NY,NX)=CPOOLN(L,NZ,NY,NX)+XFRC + CPOOLT=CPOOLR(1,L,NZ,NY,NX)+CPOOLN(L,NZ,NY,NX) + IF(CPOOLT.GT.ZEROP(NZ,NY,NX))THEN + ZPOOLD=(ZPOOLR(1,L,NZ,NY,NX)*CPOOLN(L,NZ,NY,NX) + 2-ZPOOLN(L,NZ,NY,NX)*CPOOLR(1,L,NZ,NY,NX))/CPOOLT + XFRN=FXRN(INTYP(NZ,NY,NX))*ZPOOLD + PPOOLD=(PPOOLR(1,L,NZ,NY,NX)*CPOOLN(L,NZ,NY,NX) + 2-PPOOLN(L,NZ,NY,NX)*CPOOLR(1,L,NZ,NY,NX))/CPOOLT + XFRP=FXRN(INTYP(NZ,NY,NX))*PPOOLD + ZPOOLR(1,L,NZ,NY,NX)=ZPOOLR(1,L,NZ,NY,NX)-XFRN + PPOOLR(1,L,NZ,NY,NX)=PPOOLR(1,L,NZ,NY,NX)-XFRP + ZPOOLN(L,NZ,NY,NX)=ZPOOLN(L,NZ,NY,NX)+XFRN + PPOOLN(L,NZ,NY,NX)=PPOOLN(L,NZ,NY,NX)+XFRP +C IF(L.EQ.1)THEN +C WRITE(*,2122)'NODEX',I,J,NZ,L,XFRC,XFRN,XFRP +C 3,WTRTD(1,L,NZ,NY,NX),WTRTDT,CPOOLT +C 4,WTNDL(L,NZ,NY,NX),WTNDLN(L,NZ,NY,NX),WTNDLP(L,NZ,NY,NX) +C 2,CPOOLN(L,NZ,NY,NX),ZPOOLN(L,NZ,NY,NX),PPOOLN(L,NZ,NY,NX) +C 3,CPOOLR(1,L,NZ,NY,NX),ZPOOLR(1,L,NZ,NY,NX),PPOOLR(1,L,NZ,NY,NX) +C ENDIF + ENDIF + ENDIF + ENDIF +C IF(L.EQ.1)THEN +C WRITE(*,2122)'NODGR',I,J,NZ,L,RCNDL,RMNDL,RGNDL,RGN2P +C 2,RGN2F,CGNDL,GRNDG,CCC,ZADDN,PADDN,SNCR,RCCC,RCCN,RCCP +C 8,FSNCN,RCCO,RDNDLC,RDNDLN,RDNDLP,WFR(1,L,NZ,NY,NX) +C 3,WTNDL(L,NZ,NY,NX),WTNDLN(L,NZ,NY,NX),WTNDLP(L,NZ,NY,NX) +C 2,CPOOLN(L,NZ,NY,NX),ZPOOLN(L,NZ,NY,NX),PPOOLN(L,NZ,NY,NX) +C 5,FCNPF,TFN4(L,NZ,NY,NX),WFNGR(1,L) +2122 FORMAT(A8,4I4,60E24.16) +C ENDIF + ENDIF +5400 CONTINUE + ENDIF +C +C TRANSFER NON-STRUCTURAL C,N,P AMONG BRANCH LEAVES +C FROM NON-STRUCTURAL C,N,P CONCENTRATION DIFFERENCES +C WHEN SEASONAL STORAGE C IS NOT BEING MOBILIZED +C + IF(NBR(NZ,NY,NX).GT.1)THEN + WTPLTT=0.0 + CPOOLT=0.0 + ZPOOLT=0.0 + PPOOLT=0.0 + DO 300 NB=1,NBR(NZ,NY,NX) + IF(IDTHB(NB,NZ,NY,NX).EQ.0)THEN + IF(ATRP(NB,NZ,NY,NX).GT.ATRPX(ISTYP(NZ,NY,NX)))THEN + WTLSBZ(NB)=AMAX1(0.0,WTLSB(NB,NZ,NY,NX)) + CPOOLZ(NB)=AMAX1(0.0,CPOOL(NB,NZ,NY,NX)) + ZPOOLZ(NB)=AMAX1(0.0,ZPOOL(NB,NZ,NY,NX)) + PPOOLZ(NB)=AMAX1(0.0,PPOOL(NB,NZ,NY,NX)) + WTPLTT=WTPLTT+WTLSBZ(NB) + CPOOLT=CPOOLT+CPOOLZ(NB) + ZPOOLT=ZPOOLT+ZPOOLZ(NB) + PPOOLT=PPOOLT+PPOOLZ(NB) + ENDIF + ENDIF +300 CONTINUE + DO 305 NB=1,NBR(NZ,NY,NX) + IF(IDTHB(NB,NZ,NY,NX).EQ.0)THEN + IF(ATRP(NB,NZ,NY,NX).GT.ATRPX(ISTYP(NZ,NY,NX)))THEN + IF(WTPLTT.GT.ZEROP(NZ,NY,NX) + 2.AND.CPOOLT.GT.ZEROP(NZ,NY,NX))THEN + CPOOLD=CPOOLT*WTLSBZ(NB)-CPOOLZ(NB)*WTPLTT + ZPOOLD=ZPOOLT*CPOOLZ(NB)-ZPOOLZ(NB)*CPOOLT + PPOOLD=PPOOLT*CPOOLZ(NB)-PPOOLZ(NB)*CPOOLT + XFRC=0.01*CPOOLD/WTPLTT + XFRN=0.01*ZPOOLD/CPOOLT + XFRP=0.01*PPOOLD/CPOOLT + CPOOL(NB,NZ,NY,NX)=CPOOL(NB,NZ,NY,NX)+XFRC + ZPOOL(NB,NZ,NY,NX)=ZPOOL(NB,NZ,NY,NX)+XFRN + PPOOL(NB,NZ,NY,NX)=PPOOL(NB,NZ,NY,NX)+XFRP + ENDIF + ENDIF + ENDIF +305 CONTINUE + ENDIF +C +C TRANSFER NON-STRUCTURAL C,N,P AMONG BRANCH STALK RESERVES +C FROM NON-STRUCTURAL C,N,P CONCENTRATION DIFFERENCES +C + IF(NBR(NZ,NY,NX).GT.1)THEN + WTSTKT=0.0 + WTRSVT=0.0 + WTRSNT=0.0 + WTRSPT=0.0 + DO 330 NB=1,NBR(NZ,NY,NX) + IF(IDTHB(NB,NZ,NY,NX).EQ.0)THEN + IF(IDAY(7,NB,NZ,NY,NX).NE.0)THEN + WTSTKT=WTSTKT+WVSTKB(NB,NZ,NY,NX) + WTRSVT=WTRSVT+WTRSVB(NB,NZ,NY,NX) + WTRSNT=WTRSNT+WTRSBN(NB,NZ,NY,NX) + WTRSPT=WTRSPT+WTRSBP(NB,NZ,NY,NX) + ENDIF + ENDIF +330 CONTINUE + IF(WTSTKT.GT.ZEROP(NZ,NY,NX) + 2.AND.WTRSVT.GT.ZEROP(NZ,NY,NX))THEN + DO 335 NB=1,NBR(NZ,NY,NX) + IF(IDTHB(NB,NZ,NY,NX).EQ.0)THEN + IF(IDAY(7,NB,NZ,NY,NX).NE.0)THEN + WTRSVD=WTRSVT*WVSTKB(NB,NZ,NY,NX) + 2-WTRSVB(NB,NZ,NY,NX)*WTSTKT + XFRC=0.1*WTRSVD/WTSTKT + WTRSVB(NB,NZ,NY,NX)=WTRSVB(NB,NZ,NY,NX)+XFRC + WTRSND=WTRSNT*WTRSVB(NB,NZ,NY,NX) + 2-WTRSBN(NB,NZ,NY,NX)*WTRSVT + XFRN=0.1*WTRSND/WTRSVT + WTRSBN(NB,NZ,NY,NX)=WTRSBN(NB,NZ,NY,NX)+XFRN + WTRSPD=WTRSPT*WTRSVB(NB,NZ,NY,NX) + 2-WTRSBP(NB,NZ,NY,NX)*WTRSVT + XFRP=0.1*WTRSPD/WTRSVT + WTRSBP(NB,NZ,NY,NX)=WTRSBP(NB,NZ,NY,NX)+XFRP + ENDIF + ENDIF +335 CONTINUE + ENDIF + ENDIF +C +C TRANSFER NON-STRUCTURAL C,N,P BWTWEEN ROOT AND MYCORRHIZAE +C IN EACH ROOTED SOIL LAYER FROM NON-STRUCTURAL C,N,P CONCENTRATION +C DIFFERENCES +C + IF(MY(NZ,NY,NX).EQ.2)THEN + DO 425 L=NU(NY,NX),NIX(NZ,NY,NX) + IF(CPOOLR(1,L,NZ,NY,NX).GT.ZEROP(NZ,NY,NX) + 2.AND.WTRTD(1,L,NZ,NY,NX).GT.ZEROL(NZ,NY,NX))THEN + WTRTD1=WTRTD(1,L,NZ,NY,NX) + WTRTD2=AMIN1(WTRTD(1,L,NZ,NY,NX),AMAX1(FSNKM + 2*WTRTD(1,L,NZ,NY,NX),WTRTD(2,L,NZ,NY,NX))) + WTPLTT=WTRTD1+WTRTD2 + IF(WTPLTT.GT.ZEROP(NZ,NY,NX))THEN + CPOOLD=(CPOOLR(1,L,NZ,NY,NX)*WTRTD2 + 2-CPOOLR(2,L,NZ,NY,NX)*WTRTD1)/WTPLTT + XFRC=FMYC*CPOOLD + CPOOLR(1,L,NZ,NY,NX)=CPOOLR(1,L,NZ,NY,NX)-XFRC + CPOOLR(2,L,NZ,NY,NX)=CPOOLR(2,L,NZ,NY,NX)+XFRC + CPOOLT=CPOOLR(1,L,NZ,NY,NX)+CPOOLR(2,L,NZ,NY,NX) + IF(CPOOLT.GT.ZEROP(NZ,NY,NX))THEN + ZPOOLD=(ZPOOLR(1,L,NZ,NY,NX)*CPOOLR(2,L,NZ,NY,NX) + 2-ZPOOLR(2,L,NZ,NY,NX)*CPOOLR(1,L,NZ,NY,NX))/CPOOLT + XFRN=FMYC*ZPOOLD + PPOOLD=(PPOOLR(1,L,NZ,NY,NX)*CPOOLR(2,L,NZ,NY,NX) + 2-PPOOLR(2,L,NZ,NY,NX)*CPOOLR(1,L,NZ,NY,NX))/CPOOLT + XFRP=FMYC*PPOOLD + ZPOOLR(1,L,NZ,NY,NX)=ZPOOLR(1,L,NZ,NY,NX)-XFRN + ZPOOLR(2,L,NZ,NY,NX)=ZPOOLR(2,L,NZ,NY,NX)+XFRN + PPOOLR(1,L,NZ,NY,NX)=PPOOLR(1,L,NZ,NY,NX)-XFRP + PPOOLR(2,L,NZ,NY,NX)=PPOOLR(2,L,NZ,NY,NX)+XFRP +C IF(L.EQ.NIX(NZ,NY,NX))THEN +C WRITE(*,9873)'MYCO',I,J,NZ,L,XFRC,XFRN,XFRP +C 2,CPOOLR(1,L,NZ,NY,NX),WTRTD(1,L,NZ,NY,NX) +C 3,CPOOLR(2,L,NZ,NY,NX),WTRTD2 +C 3,WTPLTT,ZPOOLR(1,L,NZ,NY,NX),ZPOOLR(2,L,NZ,NY,NX) +C 4,PPOOLR(1,L,NZ,NY,NX),PPOOLR(2,L,NZ,NY,NX),CPOOLT +9873 FORMAT(A8,4I4,20E24.16) +C ENDIF + ENDIF + ENDIF + ENDIF +425 CONTINUE + ENDIF +C +C TRANSFER NON-STRUCTURAL C,N,P BETWEEN ROOT AND STORAGE +C +C IF(IFLGZ.EQ.1.AND.ISTYP(NZ,NY,NX).NE.0)THEN +C DO 5545 N=1,MY(NZ,NY,NX) +C DO 5550 L=NU(NY,NX),NI(NZ,NY,NX) +C IF(CCPOLR(N,L,NZ,NY,NX).GT.ZERO)THEN +C CNL=CCPOLR(N,L,NZ,NY,NX)/(CCPOLR(N,L,NZ,NY,NX) +C 2+CZPOLR(N,L,NZ,NY,NX)/CNKI) +C CPL=CCPOLR(N,L,NZ,NY,NX)/(CCPOLR(N,L,NZ,NY,NX) +C 2+CPPOLR(N,L,NZ,NY,NX)/CPKI) +C ELSE +C CNL=0.0 +C CPL=0.0 +C ENDIF +C XFRCX=FXFB(IBTYP(NZ,NY,NX)) +C 2*AMAX1(0.0,CPOOLR(N,L,NZ,NY,NX)) +C XFRNX=FXFB(IBTYP(NZ,NY,NX)) +C 2*AMAX1(0.0,ZPOOLR(N,L,NZ,NY,NX))*(1.0+CNL) +C XFRPX=FXFB(IBTYP(NZ,NY,NX)) +C 2*AMAX1(0.0,PPOOLR(N,L,NZ,NY,NX))*(1.0+CPL) +C XFRC=AMIN1(XFRCX,XFRNX/CNMN,XFRPX/CPMN) +C XFRN=AMIN1(XFRNX,XFRC*CNMX,XFRPX*CNMX/CPMN*0.5) +C XFRP=AMIN1(XFRPX,XFRC*CPMX,XFRNX*CPMX/CNMN*0.5) +C CPOOLR(N,L,NZ,NY,NX)=CPOOLR(N,L,NZ,NY,NX)-XFRC +C WTRVC(NZ,NY,NX)=WTRVC(NZ,NY,NX)+XFRC +C ZPOOLR(N,L,NZ,NY,NX)=ZPOOLR(N,L,NZ,NY,NX)-XFRN +C WTRVN(NZ,NY,NX)=WTRVN(NZ,NY,NX)+XFRN +C PPOOLR(N,L,NZ,NY,NX)=PPOOLR(N,L,NZ,NY,NX)-XFRP +C WTRVP(NZ,NY,NX)=WTRVP(NZ,NY,NX)+XFRP +5550 CONTINUE +5545 CONTINUE +C ENDIF +C +C ROOT AND NODULE TOTALS +C + DO 5445 N=1,MY(NZ,NY,NX) + DO 5450 L=NU(NY,NX),NI(NZ,NY,NX) + WTRTL(N,L,NZ,NY,NX)=0.0 + WTRTD(N,L,NZ,NY,NX)=0.0 + DO 5460 NR=1,NRT(NZ,NY,NX) + WTRTL(N,L,NZ,NY,NX)=WTRTL(N,L,NZ,NY,NX)+WTRT2(N,L,NR,NZ,NY,NX) + WTRTD(N,L,NZ,NY,NX)=WTRTD(N,L,NZ,NY,NX)+WTRT2(N,L,NR,NZ,NY,NX) + 2+WTRT1(N,L,NR,NZ,NY,NX) +5460 CONTINUE + TCO2T(NZ,NY,NX)=TCO2T(NZ,NY,NX)+RCO2A(N,L,NZ,NY,NX) + RECO(NY,NX)=RECO(NY,NX)+RCO2A(N,L,NZ,NY,NX) + TRAU(NY,NX)=TRAU(NY,NX)+RCO2A(N,L,NZ,NY,NX) +5450 CONTINUE + DO 5470 NR=1,NRT(NZ,NY,NX) + WTRTL(N,NINR(NR,NZ,NY,NX),NZ,NY,NX) + 2=WTRTL(N,NINR(NR,NZ,NY,NX),NZ,NY,NX) + 3+RTWT1(N,NR,NZ,NY,NX) +5470 CONTINUE +5445 CONTINUE +C +C TRANSFER NON-STRUCTURAL C,N,P BETWEEN ROOT AND SHOOT +C +C SINK STRENGTH OF ROOTS IN EACH SOIL LAYER AS A FRACTION +C OF TOTAL SINK STRENGTH OF ROOTS IN ALL SOIL LAYERS +C + IF(ISTYP(NZ,NY,NX).EQ.1)THEN + IF(WTLS(NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + FWTC=AMIN1(1.0,0.667*WTRT(NZ,NY,NX)/WTLS(NZ,NY,NX)) + ELSE + FWTC=1.0 + ENDIF + IF(WTRT(NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + FWTS=AMIN1(1.0,WTLS(NZ,NY,NX)/(0.667*WTRT(NZ,NY,NX))) + ELSE + FWTS=1.0 + ENDIF + ELSE + FWTC=1.0 + FWTS=1.0 + ENDIF + DO 290 L=NU(NY,NX),NI(NZ,NY,NX) + IF(RTNT(1).GT.ZEROP(NZ,NY,NX))THEN + FWTR(L)=AMAX1(0.0,RLNT(1,L)/RTNT(1)) + ELSE + FWTR(L)=1.0 + ENDIF +290 CONTINUE +C +C RATE CONSTANT FOR TRANSFER IS SET FROM INPUT IN 'READQ' +C BUT IS NOT USED FOR ANNUALS DURING GRAIN FILL +C + WTLS(NZ,NY,NX)=0.0 + DO 309 NB=1,NBR(NZ,NY,NX) + WTLS(NZ,NY,NX)=WTLS(NZ,NY,NX)+WTLSB(NB,NZ,NY,NX) +309 CONTINUE + DO 310 NB=1,NBR(NZ,NY,NX) + IF(IDTHB(NB,NZ,NY,NX).EQ.0 + 2.AND.(ISTYP(NZ,NY,NX).NE.0.OR.IDAY(8,NB,NZ,NY,NX).EQ.0))THEN +C +C SINK STRENGTH OF BRANCHES IN EACH CANOPY AS A FRACTION +C OF TOTAL SINK STRENGTH OF THE CANOPY +C + IF(WTLS(NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + FWTB(NB)=AMAX1(0.0,WTLSB(NB,NZ,NY,NX)/WTLS(NZ,NY,NX)) + ELSE + FWTB(NB)=1.0 + ENDIF + PTSHTR=AMIN1(1.0,PTSHT(NZ,NY,NX)) + DO 415 L=NU(NY,NX),NI(NZ,NY,NX) + WTLSBX=WTLSB(NB,NZ,NY,NX)*FWODB(1)*FWTR(L)*FWTC + WTRTLX=WTRTL(1,L,NZ,NY,NX)*FWOOD(1)*FWTB(NB)*FWTS + WTLSBB=AMAX1(0.0,WTLSBX,FSNKM*WTRTLX) + WTRTLR=AMAX1(0.0,WTRTLX,FSNKM*WTLSBX) + WTPLTT=WTLSBB+WTRTLR + IF(WTPLTT.GT.ZEROP(NZ,NY,NX))THEN + CPOOLB=AMAX1(0.0,CPOOL(NB,NZ,NY,NX)*FWTR(L)) + CPOOLS=AMAX1(0.0,CPOOLR(1,L,NZ,NY,NX)*FWTB(NB)) + CPOOLD=(CPOOLB*WTRTLR-CPOOLS*WTLSBB)/WTPLTT + XFRC=PTSHTR*CPOOLD + CPOOL(NB,NZ,NY,NX)=CPOOL(NB,NZ,NY,NX)-XFRC + CPOOLR(1,L,NZ,NY,NX)=CPOOLR(1,L,NZ,NY,NX)+XFRC + CPOOLT=CPOOLS+CPOOLB + IF(CPOOLT.GT.ZEROP(NZ,NY,NX))THEN + ZPOOLB=AMAX1(0.0,ZPOOL(NB,NZ,NY,NX)*FWTR(L)) + ZPOOLS=AMAX1(0.0,ZPOOLR(1,L,NZ,NY,NX)*FWTB(NB)) + ZPOOLD=(ZPOOLB*CPOOLS-ZPOOLS*CPOOLB)/CPOOLT + XFRN=PTSHTR*ZPOOLD + PPOOLB=AMAX1(0.0,PPOOL(NB,NZ,NY,NX)*FWTR(L)) + PPOOLS=AMAX1(0.0,PPOOLR(1,L,NZ,NY,NX)*FWTB(NB)) + PPOOLD=(PPOOLB*CPOOLS-PPOOLS*CPOOLB)/CPOOLT + XFRP=PTSHTR*PPOOLD + ELSE + XFRN=0.0 + XFRP=0.0 + ENDIF + ZPOOL(NB,NZ,NY,NX)=ZPOOL(NB,NZ,NY,NX)-XFRN + ZPOOLR(1,L,NZ,NY,NX)=ZPOOLR(1,L,NZ,NY,NX)+XFRN + PPOOL(NB,NZ,NY,NX)=PPOOL(NB,NZ,NY,NX)-XFRP + PPOOLR(1,L,NZ,NY,NX)=PPOOLR(1,L,NZ,NY,NX)+XFRP +C IF((I/10)*10.EQ.I.AND.J.EQ.14.AND.NZ.EQ.1.AND.NB.EQ.1)THEN +C WRITE(*,3344)'ROOT',I,J,NX,NY,NZ,NB,L +C 2,FSNKR,FDBK(NB,NZ,NY,NX),CPOOL(NB,NZ,NY,NX) +C 3,CPOOLR(1,L,NZ,NY,NX),ZPOOL(NB,NZ,NY,NX) +C 3,ZPOOLR(1,L,NZ,NY,NX),FWTB(NB),FWTR(L) +C 3,FWTC,FWTS,XFRC,XFRN,XFRP,WTLSBX,WTRTLX +C 4,CPOOLD,CPOOLB,WTLSBB,CPOOLS,WTRTLR +C 5,FWOOD(1),FWODB(1),WTRTL(1,L,NZ,NY,NX) +C 6,WTLSB(NB,NZ,NY,NX),RLNT(1,L),RTNT(1) +3344 FORMAT(A8,7I4,30E12.4) +C ENDIF + ENDIF +415 CONTINUE + ENDIF +310 CONTINUE +C +C TOTAL C,N,P IN EACH BRANCH +C + DO 320 NB=1,NBR(NZ,NY,NX) + CPOOLK(NB,NZ,NY,NX)=0.0 + DO 325 K=1,25 + CPOOLK(NB,NZ,NY,NX)=CPOOLK(NB,NZ,NY,NX) + 2+CPOOL3(K,NB,NZ,NY,NX)+CPOOL4(K,NB,NZ,NY,NX) + 3+CO2B(K,NB,NZ,NY,NX)+HCOB(K,NB,NZ,NY,NX) +325 CONTINUE + WTSHTB(NB,NZ,NY,NX)=WTLFB(NB,NZ,NY,NX) + 2+WTSHEB(NB,NZ,NY,NX)+WTSTKB(NB,NZ,NY,NX)+WTRSVB(NB,NZ,NY,NX) + 3+WTHSKB(NB,NZ,NY,NX)+WTEARB(NB,NZ,NY,NX)+WTGRB(NB,NZ,NY,NX) + 4+CPOOL(NB,NZ,NY,NX)+CPOOLK(NB,NZ,NY,NX) + WTSHTN(NB,NZ,NY,NX)=WTLFBN(NB,NZ,NY,NX) + 2+WTSHBN(NB,NZ,NY,NX)+WTSTBN(NB,NZ,NY,NX)+WTRSBN(NB,NZ,NY,NX) + 3+WTHSBN(NB,NZ,NY,NX)+WTEABN(NB,NZ,NY,NX)+WTGRBN(NB,NZ,NY,NX) + 4+ZPOOL(NB,NZ,NY,NX) + WTSHTP(NB,NZ,NY,NX)=WTLFBP(NB,NZ,NY,NX) + 2+WTSHBP(NB,NZ,NY,NX)+WTSTBP(NB,NZ,NY,NX)+WTRSBP(NB,NZ,NY,NX) + 3+WTHSBP(NB,NZ,NY,NX)+WTEABP(NB,NZ,NY,NX)+WTGRBP(NB,NZ,NY,NX) + 4+PPOOL(NB,NZ,NY,NX) +320 CONTINUE +C +C TOTAL C,N,P IN ROOTS AND MYCORRHIZAE IN EACH SOIL LAYER +C + DO 345 N=1,MY(NZ,NY,NX) + DO 345 L=NU(NY,NX),NI(NZ,NY,NX) + WTRTD(N,L,NZ,NY,NX)=WTRTD(N,L,NZ,NY,NX)+CPOOLR(N,L,NZ,NY,NX) +345 CONTINUE + ELSE + HCUPTK(NZ,NY,NX)=UPOMC(NZ,NY,NX) + HZUPTK(NZ,NY,NX)=UPOMN(NZ,NY,NX)+UPNH4(NZ,NY,NX)+UPNO3(NZ,NY,NX) + 2+UPNF(NZ,NY,NX) + HPUPTK(NZ,NY,NX)=UPOMP(NZ,NY,NX)+UPH2P(NZ,NY,NX)+UPH1P(NZ,NY,NX) + ENDIF +C +C TRANSFER ABOVE-GROUND C,N,P AT HARVEST OR DISTURBANCE +C + IF((IHVST(NZ,I,NY,NX).GE.0.AND.J.EQ.INT(ZNOON(NY,NX)) + 2.AND.IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6) + 3.OR.(IHVST(NZ,I,NY,NX).EQ.4.OR.IHVST(NZ,I,NY,NX).EQ.6))THEN +C +C ACCUMULATE ALL HARVESTED MATERIAL ABOVE CUTTING HEIGHT +C ACCOUNTING FOR HARVEST EFFICIENCY ENTERED IN 'READS' +C + IF(IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6)THEN + IF(JHVST(NZ,I,NY,NX).NE.2)THEN + PPX(NZ,NY,NX)=PPX(NZ,NY,NX)*(1.0-THIN(NZ,I,NY,NX)) + PP(NZ,NY,NX)=PP(NZ,NY,NX)*(1.0-THIN(NZ,I,NY,NX)) + ELSE +C PPI(NZ,NY,NX)=AMAX1(1.0,0.5*(PPI(NZ,NY,NX)+GRNO(NZ,NY,NX) +C 2/AREA(3,NU(NY,NX),NY,NX))) + PPX(NZ,NY,NX)=PPI(NZ,NY,NX) + PP(NZ,NY,NX)=PPX(NZ,NY,NX)*AREA(3,NU(NY,NX),NY,NX) + ENDIF + IF(IHVST(NZ,I,NY,NX).EQ.3)THEN + CF(NZ,NY,NX)=CF(NZ,NY,NX)*HVST(NZ,I,NY,NX) + ENDIF + IF(IHVST(NZ,I,NY,NX).LE.2.AND.HVST(NZ,I,NY,NX).LT.0.0)THEN + ARLFY=(1.0-ABS(HVST(NZ,I,NY,NX)))*ARLFC(NY,NX) + ARLFR=0.0 + DO 9875 L=1,JC + IF(ZL(L,NY,NX).GT.ZL(L-1,NY,NX) + 2.AND.ARLFT(L,NY,NX).GT.ZEROS(NY,NX) + 3.AND.ARLFR.LT.ARLFY)THEN + IF(ARLFR+ARLFT(L,NY,NX).GT.ARLFY)THEN + HVST(NZ,I,NY,NX)=ZL(L-1,NY,NX)+((ARLFY-ARLFR) + 2/ARLFT(L,NY,NX))*(ZL(L,NY,NX)-ZL(L-1,NY,NX)) + ENDIF + ARLFR=ARLFR+ARLFT(L,NY,NX) + ENDIF +C WRITE(*,6544)'HVST',I,J,L,NZ,IHVST(NZ,I,NY,NX),ARLFC(NY,NX) +C 2,ARLFT(L,NY,NX),ARLFY,ARLFR,ZL(L,NY,NX),ZL(L-1,NY,NX) +C 3,ARLFV(L,NZ,NY,NX),HVST(NZ,I,NY,NX) +6544 FORMAT(A8,5I4,20E12.4) +9875 CONTINUE + ENDIF + WHVSTT=0.0 + WHVSLF=0.0 + WHVHSH=0.0 + WHVEAH=0.0 + WHVGRH=0.0 + WHVSCP=0.0 + WHVSTH=0.0 + WHVRVH=0.0 + ELSE +C +C GRAZING REMOVAL +C + IF(WTSHTA(NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + WHVSTT=HVST(NZ,I,NY,NX)*THIN(NZ,I,NY,NX)*0.45/24.0 + 2*AREA(3,NU(NY,NX),NY,NX)*WTSHT(NZ,NY,NX)/WTSHTA(NZ,NY,NX) + ELSE + WHVSTT=0.0 + ENDIF + IF(IHVST(NZ,I,NY,NX).EQ.6)THEN + WHVSTT=WHVSTT*TFN3(NZ,NY,NX) + ENDIF + CCPOLX=CCPOLP(NZ,NY,NX)/(1.0+CCPOLP(NZ,NY,NX)) + CCPLNX=CCPLNP(NZ,NY,NX)/(1.0+CCPLNP(NZ,NY,NX)) + WHVSLX=WHVSTT*EHVST(1,1,NZ,I,NY,NX) + WHVSLY=AMIN1(WTLF(NZ,NY,NX),WHVSLX) + WHVSLF=WHVSLY*(1.0-CCPOLX) + WHVSCL=WHVSLY*CCPOLX + WHVSNL=WHVSLY*CCPLNX + WHVXXX=AMAX1(0.0,WHVSLX-WHVSLY) + WHVSSX=WHVSTT*EHVST(1,2,NZ,I,NY,NX) + WTSHTT=WTSHE(NZ,NY,NX)+WTHSK(NZ,NY,NX)+WTEAR(NZ,NY,NX) + 2+WTGR(NZ,NY,NX) + IF(WTSHTT.GT.ZEROP(NZ,NY,NX))THEN + WHVSHX=WHVSSX*WTSHE(NZ,NY,NX)/WTSHTT+WHVXXX + WHVSHY=AMIN1(WTSHE(NZ,NY,NX),WHVSHX) + WHVSHH=WHVSHY*(1.0-CCPOLX) + WHVSCS=WHVSHY*CCPOLX + WHVSNS=WHVSHY*CCPLNX + WHVXXX=AMAX1(0.0,WHVSHX-WHVSHY) + WHVHSX=WHVSSX*WTHSK(NZ,NY,NX)/WTSHTT+WHVXXX + WHVHSY=AMIN1(WTHSK(NZ,NY,NX),WHVHSX) + WHVHSH=WHVHSY + WHVXXX=AMAX1(0.0,WHVHSX-WHVHSY) + WHVEAX=WHVSSX*WTEAR(NZ,NY,NX)/WTSHTT+WHVXXX + WHVEAY=AMIN1(WTEAR(NZ,NY,NX),WHVEAX) + WHVEAH=WHVEAY + WHVXXX=AMAX1(0.0,WHVEAX-WHVEAY) + WHVGRX=WHVSSX*WTGR(NZ,NY,NX)/WTSHTT+WHVXXX + WHVGRY=AMIN1(WTGR(NZ,NY,NX),WHVGRX) + WHVGRH=WHVGRY + WHVXXX=AMAX1(0.0,WHVGRX-WHVGRY) + ELSE + WHVSHH=0.0 + WHVSCS=0.0 + WHVSNS=0.0 + WHVHSH=0.0 + WHVEAH=0.0 + WHVGRH=0.0 + WHVXXX=WHVXXX+WHVSSX + ENDIF + WHVSCP=WHVSCL+WHVSCS + WHVSNP=WHVSNL+WHVSNS + WHVSKX=WHVSTT*EHVST(1,3,NZ,I,NY,NX) + WTSTKT=WTSTK(NZ,NY,NX)+WTRSV(NZ,NY,NX) + IF(WTSTKT.GT.WHVSKX+WHVXXX)THEN + WHVSTX=WHVSKX*WTSTK(NZ,NY,NX)/WTSTKT+WHVXXX + WHVSTY=AMIN1(WTSTK(NZ,NY,NX),WHVSTX) + WHVSTH=WHVSTY + WHVXXX=AMAX1(0.0,WHVSTX-WHVSTY) + WHVRVX=WHVSKX*WTRSV(NZ,NY,NX)/WTSTKT+WHVXXX + WHVRVY=AMIN1(WTRSV(NZ,NY,NX),WHVRVX) + WHVRVH=WHVRVY + WHVXXX=AMAX1(0.0,WHVRVX-WHVRVY) + ELSE + WHVSTH=0.0 + WHVRVH=0.0 + WHVXXX=AMAX1(0.0,WHVSKX) + IF(WHVXXX.GT.0.0)THEN + WHVSLY=AMIN1(WTLF(NZ,NY,NX)-WHVSLF-WHVSCL,WHVXXX) + WHVSLF=WHVSLF+WHVSLY*(1.0-CCPOLX) + WHVSCL=WHVSCL+WHVSLY*CCPOLX + WHVSNL=WHVSNL+WHVSLY*CCPLNX + WHVXXX=AMAX1(0.0,WHVXXX-WHVSLY) + IF(WTSHTT.GT.ZEROP(NZ,NY,NX))THEN + WHVSHX=WHVXXX*WTSHE(NZ,NY,NX)/WTSHTT + WHVSHY=AMIN1(WTSHE(NZ,NY,NX),WHVSHX) + WHVSHH=WHVSHH+WHVSHY*(1.0-CCPOLX) + WHVSCS=WHVSCS+WHVSHY*CCPOLX + WHVSNS=WHVSNS+WHVSHY*CCPLNX + WHVXXX=AMAX1(0.0,WHVXXX-WHVSHY) + WHVHSX=WHVXXX*WTHSK(NZ,NY,NX)/WTSHTT + WHVHSY=AMIN1(WTHSK(NZ,NY,NX),WHVHSX) + WHVHSH=WHVHSH+WHVHSY + WHVXXX=AMAX1(0.0,WHVXXX-WHVHSY) + WHVEAX=WHVXXX*WTEAR(NZ,NY,NX)/WTSHTT + WHVEAY=AMIN1(WTEAR(NZ,NY,NX),WHVEAX) + WHVEAH=WHVEAH+WHVEAY + WHVXXX=AMAX1(0.0,WHVEAX-WHVEAY) + WHVGRX=WHVXXX*WTGR(NZ,NY,NX)/WTSHTT + WHVGRY=AMIN1(WTGR(NZ,NY,NX),WHVGRX) + WHVGRH=WHVGRH+WHVGRY + WHVXXX=AMAX1(0.0,WHVGRX-WHVGRY) + ENDIF + ENDIF + ENDIF +C +C ALL HARVEST REMOVALS +C + DO 9860 NB=1,NBR(NZ,NY,NX) + DO 9860 L=1,JC + DO 9860 K=0,25 + WGLFBL(L,NB,NZ,NY,NX)=0.0 +9860 CONTINUE + DO 9870 NB=1,NBR(NZ,NY,NX) + DO 9870 L=1,JC + DO 9870 K=0,25 + WGLFBL(L,NB,NZ,NY,NX)=WGLFBL(L,NB,NZ,NY,NX) + 2+WGLFL(L,K,NB,NZ,NY,NX) +9870 CONTINUE + ENDIF + DO 9865 L=JC,1,-1 + IF(IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6)THEN + IF(IHVST(NZ,I,NY,NX).NE.3)THEN + IF(ZL(L,NY,NX).GT.ZL(L-1,NY,NX))THEN + FHGT=AMAX1(0.0,AMIN1(1.0,1.0-((ZL(L,NY,NX)) + 2-HVST(NZ,I,NY,NX))/(ZL(L,NY,NX)-ZL(L-1,NY,NX)))) + ELSE + FHGT=1.0 + ENDIF + ELSE + FHGT=0.0 + ENDIF + IF(THIN(NZ,I,NY,NX).EQ.0.0)THEN + FHVST=AMAX1(0.0,1.0-(1.0-FHGT)*EHVST(1,1,NZ,I,NY,NX)) + FHVSH=FHVST + ELSE + FHVST=AMAX1(0.0,1.0-THIN(NZ,I,NY,NX)) + IF(IHVST(NZ,I,NY,NX).EQ.0)THEN + FHVSH=1.0-(1.0-FHGT)*EHVST(1,1,NZ,I,NY,NX)*THIN(NZ,I,NY,NX) + ELSE + FHVSH=FHVST + ENDIF + ENDIF + ELSE + FHVST=0.0 + FHVSH=0.0 + ENDIF +C +C CUT LEAVES AT HARVESTED NODES AND LAYERS +C + DO 9855 NB=1,NBR(NZ,NY,NX) + IF((IHVST(NZ,I,NY,NX).EQ.4.OR.IHVST(NZ,I,NY,NX).EQ.6) + 2.AND.WTLF(NZ,NY,NX).GT.ZEROL(NZ,NY,NX))THEN + WHVSBL=WHVSLF*AMAX1(0.0,WGLFBL(L,NB,NZ,NY,NX))/WTLF(NZ,NY,NX) + ELSE + WHVSBL=0.0 + ENDIF + DO 9845 K=25,0,-1 + IF((IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6) + 2.OR.WHVSBL.GT.0.0)THEN + IF(IHVST(NZ,I,NY,NX).EQ.4.OR.IHVST(NZ,I,NY,NX).EQ.6)THEN + IF(WGLFL(L,K,NB,NZ,NY,NX).GT.WHVSBL)THEN + FHVST=AMAX1(0.0,AMIN1(1.0,(WGLFL(L,K,NB,NZ,NY,NX)-WHVSBL) + 2/WGLFL(L,K,NB,NZ,NY,NX))) + FHVSH=FHVST + ELSE + FHVST=1.0 + FHVSH=1.0 + ENDIF + ENDIF +C +C HARVESTED LEAF AREA, C, N, P +C + WHVSBL=WHVSBL-(1.0-FHVST)*WGLFL(L,K,NB,NZ,NY,NX) + WTHTH1=WTHTH1+(1.0-FHVSH)*WGLFL(L,K,NB,NZ,NY,NX)*FWODB(1) + WTHNH1=WTHNH1+(1.0-FHVSH)*WGLFLN(L,K,NB,NZ,NY,NX)*FWODLN(1) + WTHPH1=WTHPH1+(1.0-FHVSH)*WGLFLP(L,K,NB,NZ,NY,NX)*FWODLP(1) + WTHTX1=WTHTX1+(FHVSH-FHVST)*WGLFL(L,K,NB,NZ,NY,NX)*FWODB(1) + WTHNX1=WTHNX1+(FHVSH-FHVST)*WGLFLN(L,K,NB,NZ,NY,NX)*FWODLN(1) + WTHPX1=WTHPX1+(FHVSH-FHVST)*WGLFLP(L,K,NB,NZ,NY,NX)*FWODLP(1) + WTHTH3=WTHTH3+(1.0-FHVSH)*WGLFL(L,K,NB,NZ,NY,NX)*FWODB(0) + WTHNH3=WTHNH3+(1.0-FHVSH)*WGLFLN(L,K,NB,NZ,NY,NX)*FWODLN(0) + WTHPH3=WTHPH3+(1.0-FHVSH)*WGLFLP(L,K,NB,NZ,NY,NX)*FWODLP(0) + WTHTX3=WTHTX3+(FHVSH-FHVST)*WGLFL(L,K,NB,NZ,NY,NX)*FWODB(0) + WTHNX3=WTHNX3+(FHVSH-FHVST)*WGLFLN(L,K,NB,NZ,NY,NX)*FWODLN(0) + WTHPX3=WTHPX3+(FHVSH-FHVST)*WGLFLP(L,K,NB,NZ,NY,NX)*FWODLP(0) +C +C REMAINING LEAF C,N,P AND AREA +C + WGLFL(L,K,NB,NZ,NY,NX)=FHVST*WGLFL(L,K,NB,NZ,NY,NX) + WGLFLN(L,K,NB,NZ,NY,NX)=FHVST*WGLFLN(L,K,NB,NZ,NY,NX) + WGLFLP(L,K,NB,NZ,NY,NX)=FHVST*WGLFLP(L,K,NB,NZ,NY,NX) + ARLFL(L,K,NB,NZ,NY,NX)=FHVST*ARLFL(L,K,NB,NZ,NY,NX) + IF(K.EQ.1)THEN + ARSTK(L,NB,NZ,NY,NX)=FHVST*ARSTK(L,NB,NZ,NY,NX) + ENDIF + ENDIF +C IF(I.EQ.262.AND.K.EQ.5)THEN +C WRITE(*,6543)'GRAZ',I,J,NZ,NB,K,L,IHVST(NZ,I,NY,NX) +C 2,ZL(L,NY,NX),ZL(L-1,NY,NX),HVST(NZ,I,NY,NX),FHVST,FHVSH +C 5,WGLFBL(L,NB,NZ,NY,NX),WTLF(NZ,NY,NX),CPOOLP(NZ,NY,NX) +C 6,ARLFL(L,K,NB,NZ,NY,NX),WGLF(K,NB,NZ,NY,NX),ARLF(K,NB,NZ,NY,NX) +C 7,HTNODE(K,NB,NZ,NY,NX) +C 7,WTSHTA(NZ,NY,NX),WHVSBL,WHVSTT,WHVSLF,WHVSHH +C 3,WHVHSH,WHVEAH,WHVGRH,WHVSCP,WHVSTH,WHVRVH,WHVXXX +C 4,WTSHTT,WHVSSX,CCPOLX +6543 FORMAT(A8,7I4,30E12.4) +C ENDIF +9845 CONTINUE +9855 CONTINUE + ARLFV(L,NZ,NY,NX)=0.0 + WGLFV(L,NZ,NY,NX)=0.0 + ARSTV(L,NZ,NY,NX)=ARSTV(L,NZ,NY,NX)*FHVST +9865 CONTINUE + DO 9835 NB=1,NBR(NZ,NY,NX) + CPOOLG=0.0 + ZPOOLG=0.0 + PPOOLG=0.0 + CPOLNG=0.0 + ZPOLNG=0.0 + PPOLNG=0.0 + WTNDG=0.0 + WTNDNG=0.0 + WTNDPG=0.0 + WGLFGX=0.0 + WGSHGX=0.0 + WGLFGY=0.0 + WGSHGY=0.0 + DO 9825 K=0,25 + ARLFG=0.0 + WGLFG=0.0 + WGLFNG=0.0 + WGLFPG=0.0 +C +C REMAINING LEAF AREA, C, N, P +C + DO 9815 L=1,JC + ARLFG=ARLFG+ARLFL(L,K,NB,NZ,NY,NX) + WGLFG=WGLFG+WGLFL(L,K,NB,NZ,NY,NX) + WGLFNG=WGLFNG+WGLFLN(L,K,NB,NZ,NY,NX) + WGLFPG=WGLFPG+WGLFLP(L,K,NB,NZ,NY,NX) + ARLFV(L,NZ,NY,NX)=ARLFV(L,NZ,NY,NX)+ARLFL(L,K,NB,NZ,NY,NX) + WGLFV(L,NZ,NY,NX)=WGLFV(L,NZ,NY,NX)+WGLFL(L,K,NB,NZ,NY,NX) +9815 CONTINUE +C +C ACCUMULATE REMAINING BRANCH LEAF AREA, C, N, P +C + IF(IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6)THEN + IF(WGLF(K,NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX) + 2.AND.EHVST(1,1,NZ,I,NY,NX).GT.0.0)THEN + FHVSTK(K)=AMAX1(0.0,AMIN1(1.0,(1.0-(1.0-AMAX1(0.0,WGLFG) + 2/WGLF(K,NB,NZ,NY,NX))*EHVST(1,2,NZ,I,NY,NX) + 3/EHVST(1,1,NZ,I,NY,NX)))) + FHVSHK(K)=FHVSTK(K) + ELSE + IF(THIN(NZ,I,NY,NX).EQ.0.0)THEN + FHVSTK(K)=1.0-EHVST(1,2,NZ,I,NY,NX) + FHVSHK(K)=FHVSTK(K) + ELSE + FHVSTK(K)=1.0-THIN(NZ,I,NY,NX) + IF(IHVST(NZ,I,NY,NX).EQ.0)THEN + FHVSHK(K)=1.0-EHVST(1,2,NZ,I,NY,NX)*THIN(NZ,I,NY,NX) + ELSE + FHVSHK(K)=FHVSTK(K) + ENDIF + ENDIF + ENDIF + ELSE + FHVSTK(K)=0.0 + FHVSHK(K)=0.0 + ENDIF + WGLFGY=WGLFGY+WGLF(K,NB,NZ,NY,NX) + WTLFB(NB,NZ,NY,NX)=WTLFB(NB,NZ,NY,NX) + 2-WGLF(K,NB,NZ,NY,NX)+WGLFG + WTLFBN(NB,NZ,NY,NX)=WTLFBN(NB,NZ,NY,NX) + 2-WGLFN(K,NB,NZ,NY,NX)+WGLFNG + WTLFBP(NB,NZ,NY,NX)=WTLFBP(NB,NZ,NY,NX) + 2-WGLFP(K,NB,NZ,NY,NX)+WGLFPG + ARLFB(NB,NZ,NY,NX)=ARLFB(NB,NZ,NY,NX)-ARLF(K,NB,NZ,NY,NX)+ARLFG + IF(ARLF(K,NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + WSLF(K,NB,NZ,NY,NX)=WSLF(K,NB,NZ,NY,NX)*ARLFG/ARLF(K,NB,NZ,NY,NX) + ELSE + WSLF(K,NB,NZ,NY,NX)=0.0 + ENDIF + ARLF(K,NB,NZ,NY,NX)=ARLFG + WGLF(K,NB,NZ,NY,NX)=WGLFG + WGLFN(K,NB,NZ,NY,NX)=WGLFNG + WGLFP(K,NB,NZ,NY,NX)=WGLFPG + WGLFGX=WGLFGX+WGLF(K,NB,NZ,NY,NX) +9825 CONTINUE +C +C CUT SHEATHS OR PETIOLES AND STALKS HARVESTED NODES AND LAYERS +C + HTSTKX=0.0 + IF((IHVST(NZ,I,NY,NX).EQ.4.OR.IHVST(NZ,I,NY,NX).EQ.6) + 2.AND.WTSHE(NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + WHVSBS=WHVSHH*WTSHEB(NB,NZ,NY,NX)/WTSHE(NZ,NY,NX) + ELSE + WHVSBS=0.0 + ENDIF + DO 9805 K=25,0,-1 +112 FORMAT(A8,8I4,12E12.4) + IF(HTNODE(K,NB,NZ,NY,NX).GT.0.0) + 2HTSTKX=AMAX1(HTSTKX,HTNODE(K,NB,NZ,NY,NX)) +C WRITE(*,112)'VSTG',I,J,NX,NY,NZ,NB,K,IDTHB(NB,NZ,NY,NX) +C 2,VSTG(NB,NZ,NY,NX),FHVSTK(K),HTSTKX,HTNODE(K,NB,NZ,NY,NX) +C 3,HVST(NZ,I,NY,NX) +C +C HARVESTED SHEATH OR PETIOLE C,N,P +C + IF((IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6) + 2.OR.WHVSBS.GT.0.0)THEN + IF(IHVST(NZ,I,NY,NX).EQ.4.OR.IHVST(NZ,I,NY,NX).EQ.6)THEN + IF(WGSHE(K,NB,NZ,NY,NX).GT.WHVSBS)THEN + FHVSTK(K)=AMAX1(0.0,AMIN1(1.0,(WGSHE(K,NB,NZ,NY,NX)-WHVSBS) + 2/WGSHE(K,NB,NZ,NY,NX))) + FHVSHK(K)=FHVSTK(K) + ELSE + FHVSTK(K)=0.0 + FHVSHK(K)=0.0 + ENDIF + ENDIF + WHVSBS=WHVSBS-(1.0-FHVSTK(K))*WGSHE(K,NB,NZ,NY,NX) + WTHTH2=WTHTH2+(1.0-FHVSHK(K))*WGSHE(K,NB,NZ,NY,NX)*FWODB(1) + WTHNH2=WTHNH2+(1.0-FHVSHK(K))*WGSHN(K,NB,NZ,NY,NX)*FWODSN(1) + WTHPH2=WTHPH2+(1.0-FHVSHK(K))*WGSHP(K,NB,NZ,NY,NX)*FWODSP(1) + WTHTX2=WTHTX2+(FHVSHK(K)-FHVSTK(K))*WGSHE(K,NB,NZ,NY,NX) + 2*FWODB(1) + WTHNX2=WTHNX2+(FHVSHK(K)-FHVSTK(K))*WGSHN(K,NB,NZ,NY,NX) + 2*FWODSN(1) + WTHPX2=WTHPX2+(FHVSHK(K)-FHVSTK(K))*WGSHP(K,NB,NZ,NY,NX) + 2*FWODSP(1) + WTHTH3=WTHTH3+(1.0-FHVSHK(K))*WGSHE(K,NB,NZ,NY,NX)*FWODB(0) + WTHNH3=WTHNH3+(1.0-FHVSHK(K))*WGSHN(K,NB,NZ,NY,NX)*FWODSN(0) + WTHPH3=WTHPH3+(1.0-FHVSHK(K))*WGSHP(K,NB,NZ,NY,NX)*FWODSP(0) + WTHTX3=WTHTX3+(FHVSHK(K)-FHVSTK(K))*WGSHE(K,NB,NZ,NY,NX) + 2*FWODB(0) + WTHNX3=WTHNX3+(FHVSHK(K)-FHVSTK(K))*WGSHN(K,NB,NZ,NY,NX) + 2*FWODSN(0) + WTHPX3=WTHPX3+(FHVSHK(K)-FHVSTK(K))*WGSHP(K,NB,NZ,NY,NX) + 2*FWODSP(0) +C +C REMAINING SHEATH OR PETIOLE C,N,P AND LENGTH +C + WGSHGY=WGSHGY+WGSHE(K,NB,NZ,NY,NX) + WTSHEB(NB,NZ,NY,NX)=WTSHEB(NB,NZ,NY,NX) + 2-(1.0-FHVSTK(K))*WGSHE(K,NB,NZ,NY,NX) + WTSHBN(NB,NZ,NY,NX)=WTSHBN(NB,NZ,NY,NX) + 2-(1.0-FHVSTK(K))*WGSHN(K,NB,NZ,NY,NX) + WTSHBP(NB,NZ,NY,NX)=WTSHBP(NB,NZ,NY,NX) + 2-(1.0-FHVSTK(K))*WGSHP(K,NB,NZ,NY,NX) + WGSHE(K,NB,NZ,NY,NX)=FHVSTK(K)*WGSHE(K,NB,NZ,NY,NX) + WSSHE(K,NB,NZ,NY,NX)=FHVSTK(K)*WSSHE(K,NB,NZ,NY,NX) + WGSHN(K,NB,NZ,NY,NX)=FHVSTK(K)*WGSHN(K,NB,NZ,NY,NX) + WGSHP(K,NB,NZ,NY,NX)=FHVSTK(K)*WGSHP(K,NB,NZ,NY,NX) + WSSHE(K,NB,NZ,NY,NX)=FHVSTK(K)*WSSHE(K,NB,NZ,NY,NX) + IF(IHVST(NZ,I,NY,NX).LE.2 + 2.AND.HTSHE(K,NB,NZ,NY,NX).GT.0.0)THEN + FHGT=AMAX1(0.0,AMIN1(1.0,(HTNODE(K,NB,NZ,NY,NX) + 2+HTSHE(K,NB,NZ,NY,NX)-HVST(NZ,I,NY,NX))/HTSHE(K,NB,NZ,NY,NX))) + HTSHE(K,NB,NZ,NY,NX)=(1.0-FHGT)*HTSHE(K,NB,NZ,NY,NX) + ELSE + HTSHE(K,NB,NZ,NY,NX)=FHVSTK(K)*HTSHE(K,NB,NZ,NY,NX) + ENDIF + WGSHGX=WGSHGX+WGSHE(K,NB,NZ,NY,NX) +C IF(IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6)THEN +C IF(HTNODE(K,NB,NZ,NY,NX).GT.HVST(NZ,I,NY,NX) +C 2.OR.IHVST(NZ,I,NY,NX).EQ.3)THEN +C IF(FHVSTK(K).EQ.0.0.AND.K.GT.0)THEN +C IF(IBTYP(NZ,NY,NX).EQ.0.OR.IGTYP(NZ,NY,NX).LE.1)THEN +C VSTG(NB,NZ,NY,NX)=AMAX1(0.0,VSTG(NB,NZ,NY,NX)-1.0) +C ELSE +C VSTG(NB,NZ,NY,NX)=AMAX1(0.0,VSTG(NB,NZ,NY,NX)-0.04) +C ENDIF +C ENDIF +C ENDIF +C ENDIF + ENDIF +9805 CONTINUE +C +C CUT NON-STRUCTURAL C,N,P IN HARVESTED BRANCHES +C + CPOOLX=AMAX1(0.0,CPOOL(NB,NZ,NY,NX)) + ZPOOLX=AMAX1(0.0,ZPOOL(NB,NZ,NY,NX)) + PPOOLX=AMAX1(0.0,PPOOL(NB,NZ,NY,NX)) + CPOLNX=AMAX1(0.0,CPOLNB(NB,NZ,NY,NX)) + ZPOLNX=AMAX1(0.0,ZPOLNB(NB,NZ,NY,NX)) + PPOLNX=AMAX1(0.0,PPOLNB(NB,NZ,NY,NX)) + IF(IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6)THEN + IF(WGLFGY+WGSHGY.GT.ZEROP(NZ,NY,NX))THEN + FHVST=AMAX1(0.0,AMIN1(1.0,(WGLFGX+WGSHGX) + 2/(WGLFGY+WGSHGY))) + CPOOLG=CPOOLX*FHVST + ZPOOLG=ZPOOLX*FHVST + PPOOLG=PPOOLX*FHVST + CPOLNG=CPOLNX*FHVST + ZPOLNG=ZPOLNX*FHVST + PPOLNG=PPOLNX*FHVST + WTNDG=WTNDB(NB,NZ,NY,NX)*FHVST + WTNDNG=WTNDBN(NB,NZ,NY,NX)*FHVST + WTNDPG=WTNDBP(NB,NZ,NY,NX)*FHVST + ELSE + CPOOLG=0.0 + ZPOOLG=0.0 + PPOOLG=0.0 + CPOLNG=0.0 + ZPOLNG=0.0 + PPOLNG=0.0 + WTNDG=0.0 + WTNDNG=0.0 + WTNDPG=0.0 + ENDIF + ELSE + IF(WTLS(NZ,NY,NX).GT.ZEROL(NZ,NY,NX))THEN + WTLSBX=AMAX1(0.0,WTLSB(NB,NZ,NY,NX)) + IF(CPOOL(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + WHVSCX=AMAX1(0.0,WHVSCP)*WTLSBX/WTLS(NZ,NY,NX) + CPOOLG=AMAX1(0.0,CPOOLX-WHVSCX) + ZPOOLG=AMAX1(0.0,ZPOOLX-WHVSCX*ZPOOLX/CPOOL(NB,NZ,NY,NX)) + PPOOLG=AMAX1(0.0,PPOOLX-WHVSCX*PPOOLX/CPOOL(NB,NZ,NY,NX)) + ELSE + CPOOLG=0.0 + ZPOOLG=0.0 + PPOOLG=0.0 + ENDIF + IF(CPOLNB(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + WHVSNX=AMAX1(0.0,WHVSNP)*WTLSBX/WTLS(NZ,NY,NX) + CPOLNG=AMAX1(0.0,CPOLNX-WHVSNX) + ZPOLNG=AMAX1(0.0,ZPOLNX-WHVSNX*ZPOLNX/CPOLNB(NB,NZ,NY,NX)) + PPOLNG=AMAX1(0.0,PPOLNX-WHVSNX*PPOLNX/CPOLNB(NB,NZ,NY,NX)) + WTNDG=WTNDB(NB,NZ,NY,NX)*(1.0-WHVSNX/CPOLNX) + WTNDNG=WTNDBN(NB,NZ,NY,NX)*(1.0-WHVSNX/CPOLNX) + WTNDPG=WTNDBP(NB,NZ,NY,NX)*(1.0-WHVSNX/CPOLNX) + ELSE + CPOLNG=0.0 + ZPOLNG=0.0 + PPOLNG=0.0 + WTNDG=0.0 + WTNDNG=0.0 + WTNDPG=0.0 + ENDIF + ELSE + CPOOLG=0.0 + ZPOOLG=0.0 + PPOOLG=0.0 + CPOLNG=0.0 + ZPOLNG=0.0 + PPOLNG=0.0 + WTNDG=0.0 + WTNDNG=0.0 + WTNDPG=0.0 + ENDIF + ENDIF +C +C HARVESTED NON-STRUCTURAL C, N, P +C + WTHTH0=WTHTH0+CPOOLX-CPOOLG+CPOLNX-CPOLNG + WTHNH0=WTHNH0+ZPOOLX-ZPOOLG+ZPOLNX-ZPOLNG + WTHPH0=WTHPH0+PPOOLX-PPOOLG+PPOLNX-PPOLNG + WTHTH0=WTHTH0+WTNDB(NB,NZ,NY,NX)-WTNDG + WTHNH0=WTHNH0+WTNDBN(NB,NZ,NY,NX)-WTNDNG + WTHPH0=WTHPH0+WTNDBP(NB,NZ,NY,NX)-WTNDPG +C +C REMAINING NON-STRUCTURAL C, N, P +C + CPOOL(NB,NZ,NY,NX)=CPOOLG + ZPOOL(NB,NZ,NY,NX)=ZPOOLG + PPOOL(NB,NZ,NY,NX)=PPOOLG + CPOLNB(NB,NZ,NY,NX)=CPOLNG + ZPOLNB(NB,NZ,NY,NX)=ZPOLNG + PPOLNB(NB,NZ,NY,NX)=PPOLNG + WTNDB(NB,NZ,NY,NX)=WTNDG + WTNDBN(NB,NZ,NY,NX)=WTNDNG + WTNDBP(NB,NZ,NY,NX)=WTNDPG +C +C REMOVE C4 NON-STRUCTURAL C +C + IF(ICTYP(NZ,NY,NX).EQ.4.AND.CPOOLX.GT.ZEROP(NZ,NY,NX))THEN + FHVST4=CPOOLG/CPOOLX + DO 9810 K=1,25 + WTHTH0=WTHTH0+(1.0-FHVST4)*CPOOL3(K,NB,NZ,NY,NX) + WTHTH0=WTHTH0+(1.0-FHVST4)*CPOOL4(K,NB,NZ,NY,NX) + WTHTH0=WTHTH0+(1.0-FHVST4)*CO2B(K,NB,NZ,NY,NX) + WTHTH0=WTHTH0+(1.0-FHVST4)*HCOB(K,NB,NZ,NY,NX) + CPOOL3(K,NB,NZ,NY,NX)=FHVST4*CPOOL3(K,NB,NZ,NY,NX) + CPOOL4(K,NB,NZ,NY,NX)=FHVST4*CPOOL4(K,NB,NZ,NY,NX) + CO2B(K,NB,NZ,NY,NX)=FHVST4*CO2B(K,NB,NZ,NY,NX) + HCOB(K,NB,NZ,NY,NX)=FHVST4*HCOB(K,NB,NZ,NY,NX) +9810 CONTINUE + ENDIF +C +C CUT STALKS +C + IF(IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6)THEN + IF(HTSTKX.GT.ZERO)THEN + IF(IHVST(NZ,I,NY,NX).NE.3)THEN + FHGT=AMAX1(0.0,AMIN1(1.0,HVST(NZ,I,NY,NX)/HTSTKX)) + ELSE + FHGT=0.0 + ENDIF + IF(THIN(NZ,I,NY,NX).EQ.0.0)THEN + FHVST=AMAX1(0.0,1.0-(1.0-FHGT)*EHVST(1,3,NZ,I,NY,NX)) + FHVSH=FHVST + ELSE + FHVST=AMAX1(0.0,1.0-THIN(NZ,I,NY,NX)) + IF(IHVST(NZ,I,NY,NX).EQ.0)THEN + FHVSH=1.0-(1.0-FHGT)*EHVST(1,3,NZ,I,NY,NX)*THIN(NZ,I,NY,NX) + ELSE + FHVSH=FHVST + ENDIF + ENDIF + ELSE + FHVST=1.0 + FHVSH=1.0 + ENDIF + ELSE + IF(WTSTK(NZ,NY,NX).GT.ZEROL(NZ,NY,NX))THEN + FHVST=AMAX1(0.0,AMIN1(1.0,1.0-WHVSTH/WTSTK(NZ,NY,NX))) + FHVSH=FHVST + ELSE + FHVST=1.0 + FHVSH=1.0 + ENDIF + ENDIF +C +C HARVESTED STALK C,N,P +C + WTHTH3=WTHTH3+(1.0-FHVSH)*WTSTKB(NB,NZ,NY,NX) + WTHNH3=WTHNH3+(1.0-FHVSH)*WTSTBN(NB,NZ,NY,NX) + WTHPH3=WTHPH3+(1.0-FHVSH)*WTSTBP(NB,NZ,NY,NX) + WTHTX3=WTHTX3+(FHVSH-FHVST)*WTSTKB(NB,NZ,NY,NX) + WTHNX3=WTHNX3+(FHVSH-FHVST)*WTSTBN(NB,NZ,NY,NX) + WTHPX3=WTHPX3+(FHVSH-FHVST)*WTSTBP(NB,NZ,NY,NX) +C +C REMAINING STALK C,N,P +C + WTSTKB(NB,NZ,NY,NX)=FHVST*WTSTKB(NB,NZ,NY,NX) + WTSTBN(NB,NZ,NY,NX)=FHVST*WTSTBN(NB,NZ,NY,NX) + WTSTBP(NB,NZ,NY,NX)=FHVST*WTSTBP(NB,NZ,NY,NX) + WVSTKB(NB,NZ,NY,NX)=FHVST*WVSTKB(NB,NZ,NY,NX) + WTSTXB(NB,NZ,NY,NX)=FHVST*WTSTXB(NB,NZ,NY,NX) + WTSTXN(NB,NZ,NY,NX)=FHVST*WTSTXN(NB,NZ,NY,NX) + WTSTXP(NB,NZ,NY,NX)=FHVST*WTSTXP(NB,NZ,NY,NX) +C +C CUT STALK NODES +C + DO 9820 K=25,0,-1 + IF(IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6)THEN + IF(HTNODX(K,NB,NZ,NY,NX).GT.ZERO)THEN + IF(IHVST(NZ,I,NY,NX).NE.3)THEN + FHGTK=AMAX1(0.0,AMIN1(1.0,(HTNODE(K,NB,NZ,NY,NX) + 2-HVST(NZ,I,NY,NX))/HTNODX(K,NB,NZ,NY,NX))) + ELSE + FHGTK=0.0 + ENDIF + IF(THIN(NZ,I,NY,NX).EQ.0.0)THEN + FHVSTS=AMAX1(0.0,1.0-FHGTK*EHVST(1,3,NZ,I,NY,NX)) + ELSE + FHVSTS=AMAX1(0.0,1.0-THIN(NZ,I,NY,NX)) + ENDIF + ELSE + FHVSTS=1.0 + ENDIF + ELSE + IF(WTSTK(NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + FHVSTS=AMAX1(0.0,AMIN1(1.0,1.0-WHVSTH/WTSTK(NZ,NY,NX))) + ELSE + FHVSTS=1.0 + ENDIF + ENDIF + WGNODE(K,NB,NZ,NY,NX)=FHVSTS*WGNODE(K,NB,NZ,NY,NX) + WGNODN(K,NB,NZ,NY,NX)=FHVSTS*WGNODN(K,NB,NZ,NY,NX) + WGNODP(K,NB,NZ,NY,NX)=FHVSTS*WGNODP(K,NB,NZ,NY,NX) + IF(IHVST(NZ,I,NY,NX).LE.2.AND.THIN(NZ,I,NY,NX).EQ.0.0)THEN + HTNODX(K,NB,NZ,NY,NX)=FHVSTS*HTNODX(K,NB,NZ,NY,NX) + HTNODE(K,NB,NZ,NY,NX)=AMIN1(HTNODE(K,NB,NZ,NY,NX) + 2,HVST(NZ,I,NY,NX)) + ENDIF +C IF(NZ.EQ.2)THEN +C WRITE(*,4811)'STK2',I,J,NZ,NB,K,IHVST(NZ,I,NY,NX) +C 2,HTNODX(K,NB,NZ,NY,NX),HTNODE(K,NB,NZ,NY,NX) +C 3,HVST(NZ,I,NY,NX),FHGTK,FHVSTS,ARLF(K,NB,NZ,NY,NX) +C 4,EHVST(1,3,NZ,I,NY,NX),THIN(NZ,I,NY,NX) +4811 FORMAT(A8,6I4,12E12.4) +C ENDIF +9820 CONTINUE +C +C CUT STALK RESERVES +C + IF(IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6)THEN + IF(WTSTKB(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + FHVST=FHVST + FHVSH=FHVSH + ELSE + FHVST=0.0 + FHVSH=0.0 + ENDIF + ELSE + IF(WTRSV(NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + FHVST=AMAX1(0.0,AMIN1(1.0,1.0-WHVRVH/WTRSV(NZ,NY,NX))) + FHVSH=FHVST + ELSE + FHVST=0.0 + FHVSH=0.0 + ENDIF + ENDIF +C +C HARVESTED STALK RESERVE C,N,P +C + WTHTH3=WTHTH3+(1.0-FHVSH)*WTRSVB(NB,NZ,NY,NX) + WTHNH3=WTHNH3+(1.0-FHVSH)*WTRSBN(NB,NZ,NY,NX) + WTHPH3=WTHPH3+(1.0-FHVSH)*WTRSBP(NB,NZ,NY,NX) + WTHTX3=WTHTX3+(FHVSH-FHVST)*WTRSVB(NB,NZ,NY,NX) + WTHNX3=WTHNX3+(FHVSH-FHVST)*WTRSBN(NB,NZ,NY,NX) + WTHPX3=WTHPX3+(FHVSH-FHVST)*WTRSBP(NB,NZ,NY,NX) +C +C REMAINING STALK RESERVE C,N,P IF STALK REMAINING +C + WTRSVB(NB,NZ,NY,NX)=FHVST*WTRSVB(NB,NZ,NY,NX) + WTRSBN(NB,NZ,NY,NX)=FHVST*WTRSBN(NB,NZ,NY,NX) + WTRSBP(NB,NZ,NY,NX)=FHVST*WTRSBP(NB,NZ,NY,NX) +C +C CUT REPRODUCTIVE ORGANS +C + IF(IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6)THEN + IF(HVST(NZ,I,NY,NX).LT.HTSTKX + 2.OR.IHVST(NZ,I,NY,NX).EQ.1 + 3.OR.IHVST(NZ,I,NY,NX).EQ.3)THEN + IF(THIN(NZ,I,NY,NX).EQ.0.0)THEN + FHVSTG=1.0-EHVST(1,2,NZ,I,NY,NX) + FHVSHG=FHVSTG + ELSE + FHVSTG=1.0-THIN(NZ,I,NY,NX) + FHVSHG=1.0-EHVST(1,2,NZ,I,NY,NX)*THIN(NZ,I,NY,NX) + ENDIF + ELSE + FHVSTG=1.0-THIN(NZ,I,NY,NX) + FHVSHG=FHVSTG + ENDIF + FHVSTH=FHVSTG + FHVSTE=FHVSTG + FHVSHH=FHVSHG + FHVSHE=FHVSHG + ELSE + IF(WTHSK(NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + FHVSTH=AMAX1(0.0,AMIN1(1.0,1.0-WHVHSH/WTHSK(NZ,NY,NX))) + FHVSHH=FHVSTH + ELSE + FHVSTH=1.0 + FHVSHH=1.0 + ENDIF + IF(WTEAR(NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + FHVSTE=AMAX1(0.0,AMIN1(1.0,1.0-WHVEAH/WTEAR(NZ,NY,NX))) + FHVSHE=FHVSTE + ELSE + FHVSTE=1.0 + FHVSHE=1.0 + ENDIF + IF(WTGR(NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + FHVSTG=AMAX1(0.0,AMIN1(1.0,1.0-WHVGRH/WTGR(NZ,NY,NX))) + FHVSHG=FHVSTG + ELSE + FHVSTG=1.0 + FHVSHG=1.0 + ENDIF + ENDIF +C +C HARVESTED REPRODUCTIVE C,N,P +C + WTHTH2=WTHTH2+(1.0-FHVSHH)*WTHSKB(NB,NZ,NY,NX)+(1.0-FHVSHE) + 2*WTEARB(NB,NZ,NY,NX)+(1.0-FHVSHG)*WTGRB(NB,NZ,NY,NX) + WTHNH2=WTHNH2+(1.0-FHVSHH)*WTHSBN(NB,NZ,NY,NX)+(1.0-FHVSHE) + 2*WTEABN(NB,NZ,NY,NX)+(1.0-FHVSHG)*WTGRBN(NB,NZ,NY,NX) + WTHPH2=WTHPH2+(1.0-FHVSHH)*WTHSBP(NB,NZ,NY,NX)+(1.0-FHVSHE) + 2*WTEABP(NB,NZ,NY,NX)+(1.0-FHVSHG)*WTGRBP(NB,NZ,NY,NX) + WTHTX2=WTHTX2+(FHVSHH-FHVSTH)*WTHSKB(NB,NZ,NY,NX)+(FHVSHE-FHVSTE) + 2*WTEARB(NB,NZ,NY,NX)+(FHVSHG-FHVSTG)*WTGRB(NB,NZ,NY,NX) + WTHNX2=WTHNX2+(FHVSHH-FHVSTH)*WTHSBN(NB,NZ,NY,NX)+(FHVSHE-FHVSTE) + 2*WTEABN(NB,NZ,NY,NX)+(FHVSHG-FHVSTG)*WTGRBN(NB,NZ,NY,NX) + WTHPX2=WTHPX2+(FHVSHH-FHVSTH)*WTHSBP(NB,NZ,NY,NX)+(FHVSHE-FHVSTE) + 2*WTEABP(NB,NZ,NY,NX)+(FHVSHG-FHVSTG)*WTGRBP(NB,NZ,NY,NX) + WTHTG=WTHTG+(1.0-FHVSTG)*WTGRB(NB,NZ,NY,NX) + WTHNG=WTHNG+(1.0-FHVSTG)*WTGRBN(NB,NZ,NY,NX) + WTHPG=WTHPG+(1.0-FHVSTG)*WTGRBP(NB,NZ,NY,NX) +C +C REMAINING REPRODUCTIVE C,N,P +C + WTHSKB(NB,NZ,NY,NX)=FHVSTH*WTHSKB(NB,NZ,NY,NX) + WTEARB(NB,NZ,NY,NX)=FHVSTE*WTEARB(NB,NZ,NY,NX) + WTGRB(NB,NZ,NY,NX)=FHVSTG*WTGRB(NB,NZ,NY,NX) + WTHSBN(NB,NZ,NY,NX)=FHVSTH*WTHSBN(NB,NZ,NY,NX) + WTEABN(NB,NZ,NY,NX)=FHVSTE*WTEABN(NB,NZ,NY,NX) + WTGRBN(NB,NZ,NY,NX)=FHVSTG*WTGRBN(NB,NZ,NY,NX) + WTHSBP(NB,NZ,NY,NX)=FHVSTH*WTHSBP(NB,NZ,NY,NX) + WTEABP(NB,NZ,NY,NX)=FHVSTE*WTEABP(NB,NZ,NY,NX) + WTGRBP(NB,NZ,NY,NX)=FHVSTG*WTGRBP(NB,NZ,NY,NX) + GRNXB(NB,NZ,NY,NX)=FHVSTG*GRNXB(NB,NZ,NY,NX) + GRNOB(NB,NZ,NY,NX)=FHVSTG*GRNOB(NB,NZ,NY,NX) + GRWTB(NB,NZ,NY,NX)=FHVSTG*GRWTB(NB,NZ,NY,NX) +C +C REMAINING TOTAL BRANCH C,N,P AND LEAF, STALK AREA +C + CPOOLK(NB,NZ,NY,NX)=0.0 + DO 1325 K=1,25 + CPOOLK(NB,NZ,NY,NX)=CPOOLK(NB,NZ,NY,NX) + 2+CPOOL3(K,NB,NZ,NY,NX)+CPOOL4(K,NB,NZ,NY,NX) + 2+CO2B(K,NB,NZ,NY,NX)+HCOB(K,NB,NZ,NY,NX) +1325 CONTINUE + WTLSB(NB,NZ,NY,NX)=AMAX1(0.0,WTLFB(NB,NZ,NY,NX) + 2+WTSHEB(NB,NZ,NY,NX)) + WTSHTB(NB,NZ,NY,NX)=AMAX1(0.0,WTLFB(NB,NZ,NY,NX) + 2+WTSHEB(NB,NZ,NY,NX)+WTSTKB(NB,NZ,NY,NX)+WTRSVB(NB,NZ,NY,NX) + 3+WTHSKB(NB,NZ,NY,NX)+WTEARB(NB,NZ,NY,NX)+WTGRB(NB,NZ,NY,NX) + 4+CPOOL(NB,NZ,NY,NX)+CPOOLK(NB,NZ,NY,NX)) + WTSHTN(NB,NZ,NY,NX)=AMAX1(0.0,WTLFBN(NB,NZ,NY,NX) + 2+WTSHBN(NB,NZ,NY,NX)+WTSTBN(NB,NZ,NY,NX)+WTRSBN(NB,NZ,NY,NX) + 3+WTHSBN(NB,NZ,NY,NX)+WTEABN(NB,NZ,NY,NX)+WTGRBN(NB,NZ,NY,NX) + 4+ZPOOL(NB,NZ,NY,NX)) + WTSHTP(NB,NZ,NY,NX)=AMAX1(0.0,WTLFBP(NB,NZ,NY,NX) + 2+WTSHBP(NB,NZ,NY,NX)+WTSTBP(NB,NZ,NY,NX)+WTRSBP(NB,NZ,NY,NX) + 3+WTHSBP(NB,NZ,NY,NX)+WTEABP(NB,NZ,NY,NX)+WTGRBP(NB,NZ,NY,NX) + 4+PPOOL(NB,NZ,NY,NX)) + VOLWPX=VOLWP(NZ,NY,NX) + WVPLT=AMAX1(0.0,WTLS(NZ,NY,NX)+WVSTK(NZ,NY,NX)) + APSILT=ABS(PSILT(NZ,NY,NX)) + FDM=0.16+0.10*APSILT/(0.05*APSILT+2.0) + VOLWP(NZ,NY,NX)=1.0E-06*WVPLT/FDM + VOLWOU=VOLWOU+VOLWPX-VOLWP(NZ,NY,NX) + UVOLO(NY,NX)=UVOLO(NY,NX)+VOLWPX-VOLWP(NZ,NY,NX) +C +C RESET PHENOLOGY, GROWTH STAGE IF STALKS ARE CUT +C + IF((IBTYP(NZ,NY,NX).EQ.0.OR.IGTYP(NZ,NY,NX).LE.1) + 2.AND.(IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6) + 3.AND.ZC(NZ,NY,NX).GT.HVST(NZ,I,NY,NX))THEN + IF((IWTYP(NZ,NY,NX).NE.0 + 2.AND.VRNF(NB,NZ,NY,NX).LE.FVRN*VRNX(NB,NZ,NY,NX)) + 3.OR.(IWTYP(NZ,NY,NX).EQ.0 + 4.AND.IDAY(1,NB,NZ,NY,NX).NE.0))THEN + GROUP(NB,NZ,NY,NX)=GROUPI(NZ,NY,NX) + PSTGI(NB,NZ,NY,NX)=PSTG(NB,NZ,NY,NX) + PSTGF(NB,NZ,NY,NX)=0.0 + VSTGX(NB,NZ,NY,NX)=0.0 + TGSTGI(NB,NZ,NY,NX)=0.0 + TGSTGF(NB,NZ,NY,NX)=0.0 + FLG4(NB,NZ,NY,NX)=0.0 + IDAY(1,NB,NZ,NY,NX)=I + DO 3005 M=2,10 + IDAY(M,NB,NZ,NY,NX)=0 +3005 CONTINUE + IFLGA(NB,NZ,NY,NX)=0 + IF(NB.EQ.NB1(NZ,NY,NX))THEN + DO 3010 NBX=1,NBR(NZ,NY,NX) + IF(NBX.NE.NB1(NZ,NY,NX))THEN + GROUP(NBX,NZ,NY,NX)=GROUPI(NZ,NY,NX) + PSTGI(NBX,NZ,NY,NX)=PSTG(NBX,NZ,NY,NX) + PSTGF(NBX,NZ,NY,NX)=0.0 + VSTGX(NBX,NZ,NY,NX)=0.0 + TGSTGI(NBX,NZ,NY,NX)=0.0 + TGSTGF(NBX,NZ,NY,NX)=0.0 + FLG4(NBX,NZ,NY,NX)=0.0 + IDAY(1,NBX,NZ,NY,NX)=I + DO 3015 M=2,10 + IDAY(M,NBX,NZ,NY,NX)=0 +3015 CONTINUE + IFLGA(NBX,NZ,NY,NX)=0 + ENDIF +3010 CONTINUE + ENDIF + ENDIF + ENDIF +C +C DEATH OF BRANCH IF KILLING HARVEST ENTERED IN 'READQ' +C + IF(JHVST(NZ,I,NY,NX).NE.0)IDTHB(NB,NZ,NY,NX)=1 + IF(PP(NZ,NY,NX).LE.0.0)IDTHB(NB,NZ,NY,NX)=1 +9835 CONTINUE + WTLS(NZ,NY,NX)=0.0 + WTSTK(NZ,NY,NX)=0.0 + WVSTK(NZ,NY,NX)=0.0 + ARSTP(NZ,NY,NX)=0.0 + DO 9840 NB=1,NBR(NZ,NY,NX) + WTLS(NZ,NY,NX)=WTLS(NZ,NY,NX)+WTLSB(NB,NZ,NY,NX) + WTSTK(NZ,NY,NX)=WTSTK(NZ,NY,NX)+WTSTKB(NB,NZ,NY,NX) + WVSTK(NZ,NY,NX)=WVSTK(NZ,NY,NX)+WVSTKB(NB,NZ,NY,NX) + DO 9830 L=1,JC + ARSTP(NZ,NY,NX)=ARSTP(NZ,NY,NX)+ARSTK(L,NB,NZ,NY,NX) +9830 CONTINUE +9840 CONTINUE +C +C ROOT LITTERFALL FROM HARVESTING OR FIRE +C + IF(IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6)THEN + XHVST=1.0-THIN(NZ,I,NY,NX) + DO 3985 N=1,MY(NZ,NY,NX) + DO 3980 L=NU(NY,NX),NJ(NY,NX) + IF(IHVST(NZ,I,NY,NX).NE.5)THEN + XHVST=1.0-THIN(NZ,I,NY,NX) + XHVSN=XHVST + XHVSP=XHVST + FFIRE=0.0 + FFIRN=0.0 + FFIRP=0.0 + ELSE + IF(THETW(L,NY,NX).GT.FVLWB.OR.CORGC(L,NY,NX).LE.FORGC)THEN + XHVST=1.0 + XHVSN=XHVST + XHVSP=XHVST + FFIRE=0.0 + FFIRN=0.0 + FFIRP=0.0 + ELSE + XHVST=1.0-EHVST(1,3,NZ,I,NY,NX)*AMIN1(1.0,(CORGC(L,NY,NX)-FORGC) + 2/(0.5E+06-FORGC)) + XHVSN=XHVST + XHVSP=XHVST + FFIRE=EHVST(2,3,NZ,I,NY,NX) + FFIRN=FFIRE*EFIRE(1,IHVST(NZ,I,NY,NX)) + FFIRP=FFIRE*EFIRE(2,IHVST(NZ,I,NY,NX)) + ENDIF + ENDIF + DO 3385 M=1,4 + FHVST=(1.0-XHVST)*CFOPC(0,M,NZ,NY,NX)*CPOOLR(N,L,NZ,NY,NX) + FHVSN=(1.0-XHVSN)*CFOPN(0,M,NZ,NY,NX)*ZPOOLR(N,L,NZ,NY,NX) + FHVSP=(1.0-XHVSP)*CFOPP(0,M,NZ,NY,NX)*PPOOLR(N,L,NZ,NY,NX) + CSNC(M,1,L,NZ,NY,NX)=CSNC(M,1,L,NZ,NY,NX)+(1.0-FFIRE)*FHVST + ZSNC(M,1,L,NZ,NY,NX)=ZSNC(M,1,L,NZ,NY,NX)+(1.0-FFIRN)*FHVSN + PSNC(M,1,L,NZ,NY,NX)=PSNC(M,1,L,NZ,NY,NX)+(1.0-FFIRP)*FHVSP + VCO2F(NZ,NY,NX)=VCO2F(NZ,NY,NX)-(1.0-FCH4F)*FFIRE*FHVST + VCH4F(NZ,NY,NX)=VCH4F(NZ,NY,NX)-FCH4F*FFIRE*FHVST + VOXYF(NZ,NY,NX)=VOXYF(NZ,NY,NX)-(1.0-FCH4F)*FFIRE*FHVST*2.667 + VNH3F(NZ,NY,NX)=VNH3F(NZ,NY,NX)-FFIRN*FHVSN + VN2OF(NZ,NY,NX)=VN2OF(NZ,NY,NX)-0.0 + VPO4F(NZ,NY,NX)=VPO4F(NZ,NY,NX)-FFIRP*FHVSP + CNET(NZ,NY,NX)=CNET(NZ,NY,NX)-(1.0-FCH4F)*FFIRE*FHVST + TNBP(NY,NX)=TNBP(NY,NX)-FCH4F*FFIRE*FHVST + DO 3385 NR=1,NRT(NZ,NY,NX) + FHVST=(1.0-XHVST)*CFOPC(5,M,NZ,NY,NX)*(WTRT1(N,L,NR,NZ,NY,NX) + 3+WTRT2(N,L,NR,NZ,NY,NX))*FWOOD(0) + FHVSN=(1.0-XHVSN)*CFOPN(5,M,NZ,NY,NX)*(WTRT1N(N,L,NR,NZ,NY,NX) + 3+WTRT2N(N,L,NR,NZ,NY,NX))*FWOODN(0) + FHVSP=(1.0-XHVSP)*CFOPP(5,M,NZ,NY,NX)*(WTRT1P(N,L,NR,NZ,NY,NX) + 3+WTRT2P(N,L,NR,NZ,NY,NX))*FWOODP(0) + CSNC(M,1,L,NZ,NY,NX)=CSNC(M,1,L,NZ,NY,NX)+(1.0-FFIRE)*FHVST + ZSNC(M,1,L,NZ,NY,NX)=ZSNC(M,1,L,NZ,NY,NX)+(1.0-FFIRN)*FHVSN + PSNC(M,1,L,NZ,NY,NX)=PSNC(M,1,L,NZ,NY,NX)+(1.0-FFIRP)*FHVSP + VCO2F(NZ,NY,NX)=VCO2F(NZ,NY,NX)-(1.0-FCH4F)*FFIRE*FHVST + VCH4F(NZ,NY,NX)=VCH4F(NZ,NY,NX)-FCH4F*FFIRE*FHVST + VOXYF(NZ,NY,NX)=VOXYF(NZ,NY,NX)-(1.0-FCH4F)*FFIRE*FHVST*2.667 + VNH3F(NZ,NY,NX)=VNH3F(NZ,NY,NX)-FFIRN*FHVSN + VN2OF(NZ,NY,NX)=VN2OF(NZ,NY,NX)-0.0 + VPO4F(NZ,NY,NX)=VPO4F(NZ,NY,NX)-FFIRP*FHVSP + CNET(NZ,NY,NX)=CNET(NZ,NY,NX)-(1.0-FCH4F)*FFIRE*FHVST + TNBP(NY,NX)=TNBP(NY,NX)-FCH4F*FFIRE*FHVST + FHVST=(1.0-XHVST)*CFOPC(4,M,NZ,NY,NX)*(WTRT1(N,L,NR,NZ,NY,NX) + 3+WTRT2(N,L,NR,NZ,NY,NX))*FWOOD(1) + FHVSN=(1.0-XHVSN)*CFOPN(4,M,NZ,NY,NX)*(WTRT1N(N,L,NR,NZ,NY,NX) + 3+WTRT2N(N,L,NR,NZ,NY,NX))*FWOODN(1) + FHVSP=(1.0-XHVSP)*CFOPP(4,M,NZ,NY,NX)*(WTRT1P(N,L,NR,NZ,NY,NX) + 3+WTRT2P(N,L,NR,NZ,NY,NX))*FWOODP(1) + CSNC(M,1,L,NZ,NY,NX)=CSNC(M,1,L,NZ,NY,NX)+(1.0-FFIRE)*FHVST + ZSNC(M,1,L,NZ,NY,NX)=ZSNC(M,1,L,NZ,NY,NX)+(1.0-FFIRN)*FHVSN + PSNC(M,1,L,NZ,NY,NX)=PSNC(M,1,L,NZ,NY,NX)+(1.0-FFIRP)*FHVSP + VCO2F(NZ,NY,NX)=VCO2F(NZ,NY,NX)-(1.0-FCH4F)*FFIRE*FHVST + VCH4F(NZ,NY,NX)=VCH4F(NZ,NY,NX)-FCH4F*FFIRE*FHVST + VOXYF(NZ,NY,NX)=VOXYF(NZ,NY,NX)-(1.0-FCH4F)*FFIRE*FHVST*2.667 + VNH3F(NZ,NY,NX)=VNH3F(NZ,NY,NX)-FFIRN*FHVSN + VN2OF(NZ,NY,NX)=VN2OF(NZ,NY,NX)-0.0 + VPO4F(NZ,NY,NX)=VPO4F(NZ,NY,NX)-FFIRP*FHVSP + CNET(NZ,NY,NX)=CNET(NZ,NY,NX)-(1.0-FCH4F)*FFIRE*FHVST + TNBP(NY,NX)=TNBP(NY,NX)-FCH4F*FFIRE*FHVST +3385 CONTINUE +C WRITE(*,6161)'FIRE',I,J,NZ,L,N,M,VCO2F(NZ,NY,NX),FFIRE +C 2,FHVST,CFOPC(4,M,NZ,NY,NX),CPOOLR(N,L,NZ,NY,NX),THETW(L,NY,NX) +C 3,CORGC(L,NY,NX) +6161 FORMAT(A8,6I4,20E12.4) +C +C RELEASE ROOT GAS CONTENTS DURING HARVESTING +C + RCO2Z(NZ,NY,NX)=RCO2Z(NZ,NY,NX)-(1.0-XHVST) + 2*(CO2A(N,L,NZ,NY,NX)+CO2P(N,L,NZ,NY,NX)) + ROXYZ(NZ,NY,NX)=ROXYZ(NZ,NY,NX)-(1.0-XHVST) + 2*(OXYA(N,L,NZ,NY,NX)+OXYP(N,L,NZ,NY,NX)) + RCH4Z(NZ,NY,NX)=RCH4Z(NZ,NY,NX)-(1.0-XHVST) + 2*(CH4A(N,L,NZ,NY,NX)+CH4P(N,L,NZ,NY,NX)) + RN2OZ(NZ,NY,NX)=RN2OZ(NZ,NY,NX)-(1.0-XHVST) + 2*(Z2OA(N,L,NZ,NY,NX)+Z2OP(N,L,NZ,NY,NX)) + RNH3Z(NZ,NY,NX)=RNH3Z(NZ,NY,NX)-(1.0-XHVST) + 2*(ZH3A(N,L,NZ,NY,NX)+ZH3P(N,L,NZ,NY,NX)) + RH2GZ(NZ,NY,NX)=RH2GZ(NZ,NY,NX)-(1.0-XHVST) + 2*(H2GA(N,L,NZ,NY,NX)+H2GP(N,L,NZ,NY,NX)) + CO2A(N,L,NZ,NY,NX)=XHVST*CO2A(N,L,NZ,NY,NX) + OXYA(N,L,NZ,NY,NX)=XHVST*OXYA(N,L,NZ,NY,NX) + CH4A(N,L,NZ,NY,NX)=XHVST*CH4A(N,L,NZ,NY,NX) + Z2OA(N,L,NZ,NY,NX)=XHVST*Z2OA(N,L,NZ,NY,NX) + ZH3A(N,L,NZ,NY,NX)=XHVST*ZH3A(N,L,NZ,NY,NX) + H2GA(N,L,NZ,NY,NX)=XHVST*H2GA(N,L,NZ,NY,NX) + CO2P(N,L,NZ,NY,NX)=XHVST*CO2P(N,L,NZ,NY,NX) + OXYP(N,L,NZ,NY,NX)=XHVST*OXYP(N,L,NZ,NY,NX) + CH4P(N,L,NZ,NY,NX)=XHVST*CH4P(N,L,NZ,NY,NX) + Z2OP(N,L,NZ,NY,NX)=XHVST*Z2OP(N,L,NZ,NY,NX) + ZH3P(N,L,NZ,NY,NX)=XHVST*ZH3P(N,L,NZ,NY,NX) + H2GP(N,L,NZ,NY,NX)=XHVST*H2GP(N,L,NZ,NY,NX) +C +C REDUCE ROOT STATE VARIABLES DURING HARVESTING +C + DO 3960 NR=1,NRT(NZ,NY,NX) + WTRT1(N,L,NR,NZ,NY,NX)=WTRT1(N,L,NR,NZ,NY,NX)*XHVST + WTRT2(N,L,NR,NZ,NY,NX)=WTRT2(N,L,NR,NZ,NY,NX)*XHVST + WTRT1N(N,L,NR,NZ,NY,NX)=WTRT1N(N,L,NR,NZ,NY,NX)*XHVST + WTRT2N(N,L,NR,NZ,NY,NX)=WTRT2N(N,L,NR,NZ,NY,NX)*XHVST + WTRT1P(N,L,NR,NZ,NY,NX)=WTRT1P(N,L,NR,NZ,NY,NX)*XHVST + WTRT2P(N,L,NR,NZ,NY,NX)=WTRT2P(N,L,NR,NZ,NY,NX)*XHVST + RTWT1(N,NR,NZ,NY,NX)=RTWT1(N,NR,NZ,NY,NX)*XHVST + RTWT1N(N,NR,NZ,NY,NX)=RTWT1N(N,NR,NZ,NY,NX)*XHVST + RTWT1P(N,NR,NZ,NY,NX)=RTWT1P(N,NR,NZ,NY,NX)*XHVST + RTLG1(N,L,NR,NZ,NY,NX)=RTLG1(N,L,NR,NZ,NY,NX)*XHVST + RTLG2(N,L,NR,NZ,NY,NX)=RTLG2(N,L,NR,NZ,NY,NX)*XHVST + RTN2(N,L,NR,NZ,NY,NX)=RTN2(N,L,NR,NZ,NY,NX)*XHVST +3960 CONTINUE + CPOOLR(N,L,NZ,NY,NX)=CPOOLR(N,L,NZ,NY,NX)*XHVST + ZPOOLR(N,L,NZ,NY,NX)=ZPOOLR(N,L,NZ,NY,NX)*XHVST + PPOOLR(N,L,NZ,NY,NX)=PPOOLR(N,L,NZ,NY,NX)*XHVST + WTRTL(N,L,NZ,NY,NX)=WTRTL(N,L,NZ,NY,NX)*XHVST + WTRTD(N,L,NZ,NY,NX)=WTRTD(N,L,NZ,NY,NX)*XHVST + WSRTL(N,L,NZ,NY,NX)=WSRTL(N,L,NZ,NY,NX)*XHVST + RTN1(N,L,NZ,NY,NX)=RTN1(N,L,NZ,NY,NX)*XHVST + RTNL(N,L,NZ,NY,NX)=RTNL(N,L,NZ,NY,NX)*XHVST + RTLGP(N,L,NZ,NY,NX)=RTLGP(N,L,NZ,NY,NX)*XHVST + RTDNP(N,L,NZ,NY,NX)=RTDNP(N,L,NZ,NY,NX)*XHVST + RTVLP(N,L,NZ,NY,NX)=RTVLP(N,L,NZ,NY,NX)*XHVST + RTVLW(N,L,NZ,NY,NX)=RTVLW(N,L,NZ,NY,NX)*XHVST + RTARP(N,L,NZ,NY,NX)=RTARP(N,L,NZ,NY,NX)*XHVST + RCO2M(N,L,NZ,NY,NX)=RCO2M(N,L,NZ,NY,NX)*XHVST + RCO2N(N,L,NZ,NY,NX)=RCO2N(N,L,NZ,NY,NX)*XHVST + RCO2A(N,L,NZ,NY,NX)=RCO2A(N,L,NZ,NY,NX)*XHVST +C +C NODULE LITTERFALL AND STATE VARIABLES DURING HARVESTING +C + IF(INTYP(NZ,NY,NX).NE.0.AND.N.EQ.1)THEN + DO 3395 M=1,4 + CSNC(M,1,L,NZ,NY,NX)=CSNC(M,1,L,NZ,NY,NX)+(1.0-XHVST) + 2*(CFOPC(4,M,NZ,NY,NX)*WTNDL(L,NZ,NY,NX) + 3+CFOPC(0,M,NZ,NY,NX)*CPOOLN(L,NZ,NY,NX)) + ZSNC(M,1,L,NZ,NY,NX)=ZSNC(M,1,L,NZ,NY,NX)+(1.0-XHVST) + 2*(CFOPN(4,M,NZ,NY,NX)*WTNDLN(L,NZ,NY,NX) + 3+CFOPN(0,M,NZ,NY,NX)*ZPOOLN(L,NZ,NY,NX)) + PSNC(M,1,L,NZ,NY,NX)=PSNC(M,1,L,NZ,NY,NX)+(1.0-XHVST) + 2*(CFOPP(4,M,NZ,NY,NX)*WTNDLP(L,NZ,NY,NX) + 3+CFOPP(0,M,NZ,NY,NX)*PPOOLN(L,NZ,NY,NX)) +3395 CONTINUE + WTNDL(L,NZ,NY,NX)=WTNDL(L,NZ,NY,NX)*XHVST + WTNDLN(L,NZ,NY,NX)=WTNDLN(L,NZ,NY,NX)*XHVST + WTNDLP(L,NZ,NY,NX)=WTNDLP(L,NZ,NY,NX)*XHVST + CPOOLN(L,NZ,NY,NX)=CPOOLN(L,NZ,NY,NX)*XHVST + ZPOOLN(L,NZ,NY,NX)=ZPOOLN(L,NZ,NY,NX)*XHVST + PPOOLN(L,NZ,NY,NX)=PPOOLN(L,NZ,NY,NX)*XHVST + ENDIF +3980 CONTINUE +3985 CONTINUE +C +C STORAGE LITTERFALL AND STATE VARIABLES DURING HARVESTING +C + IF(ISTYP(NZ,NY,NX).NE.0)THEN + DO 3400 M=1,4 + CSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX)=CSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX) + 2+((1.0-XHVST)*CFOPC(0,M,NZ,NY,NX)*WTRVC(NZ,NY,NX))*FWOOD(0) + ZSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX)=ZSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX) + 2+((1.0-XHVST)*CFOPN(0,M,NZ,NY,NX)*WTRVN(NZ,NY,NX))*FWOODN(0) + PSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX)=PSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX) + 2+((1.0-XHVST)*CFOPP(0,M,NZ,NY,NX)*WTRVP(NZ,NY,NX))*FWOODP(0) + CSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX)=CSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX) + 2+((1.0-XHVST)*CFOPC(0,M,NZ,NY,NX)*WTRVC(NZ,NY,NX))*FWOOD(1) + ZSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX)=ZSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX) + 2+((1.0-XHVST)*CFOPN(0,M,NZ,NY,NX)*WTRVN(NZ,NY,NX))*FWOODN(1) + PSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX)=PSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX) + 2+((1.0-XHVST)*CFOPP(0,M,NZ,NY,NX)*WTRVP(NZ,NY,NX))*FWOODP(1) +3400 CONTINUE + WTRVC(NZ,NY,NX)=WTRVC(NZ,NY,NX)*XHVST + WTRVN(NZ,NY,NX)=WTRVN(NZ,NY,NX)*XHVST + WTRVP(NZ,NY,NX)=WTRVP(NZ,NY,NX)*XHVST + ENDIF + ENDIF + ENDIF +C +C REDUCE OR REMOVE PLANT POPULATIONS DURING TILLAGE +C + IF(J.EQ.INT(ZNOON(NY,NX)).AND.(IBTYP(NZ,NY,NX).EQ.0 + 2.OR.IGTYP(NZ,NY,NX).LE.1).AND.(I.NE.IDAY0(NZ,NY,NX) + 3.OR.IDATA(3).NE.IYR0(NZ,NY,NX)))THEN + IF(ITILL(I,NY,NX).LE.10.OR.NZ.NE.1)THEN + IF(I.GT.IDAY0(NZ,NY,NX).OR.IYRC.GT.IYR0(NZ,NY,NX))THEN + IF(ITILL(I,NY,NX).EQ.10)THEN + XHVST=0.0 + ELSE + XHVST=XCORP(NY,NX) + ENDIF + PPX(NZ,NY,NX)=PPX(NZ,NY,NX)*XHVST + PP(NZ,NY,NX)=PP(NZ,NY,NX)*XHVST + FRADP(NZ,NY,NX)=FRADP(NZ,NY,NX)*XHVST + VHCPC(NZ,NY,NX)=VHCPC(NZ,NY,NX)*XHVST + WTLS(NZ,NY,NX)=0.0 + WVSTK(NZ,NY,NX)=0.0 +C +C TERMINATE BRANCHES IF TILLAGE IMPLEMENT 10 IS SELECTED +C + DO 8975 NB=1,NBR(NZ,NY,NX) + IF(IDTHB(NB,NZ,NY,NX).EQ.0)THEN + IF(PP(NZ,NY,NX).LE.0.0)IDTHB(NB,NZ,NY,NX)=1 +C +C LITTERFALL FROM BRANCHES DURING TILLAGE +C + DO 6380 M=1,4 + CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX)+(1.0-XHVST) + 2*(CFOPC(0,M,NZ,NY,NX)*(CPOOL(NB,NZ,NY,NX)+CPOLNB(NB,NZ,NY,NX) + 3+CPOOLK(NB,NZ,NY,NX)+WTRSVB(NB,NZ,NY,NX)) + 4+CFOPC(1,M,NZ,NY,NX)*(WTLFB(NB,NZ,NY,NX)*FWODB(1) + 5+WTNDB(NB,NZ,NY,NX)) + 6+CFOPC(2,M,NZ,NY,NX)*(WTSHEB(NB,NZ,NY,NX)*FWODB(1) + 7+WTHSKB(NB,NZ,NY,NX)+WTEARB(NB,NZ,NY,NX))) + CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX)+(1.0-XHVST) + 2*CFOPC(5,M,NZ,NY,NX)*(WTLFB(NB,NZ,NY,NX)*FWODB(0) + 3+WTSHEB(NB,NZ,NY,NX)*FWODB(0)) + ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX)+(1.0-XHVST) + 2*(CFOPN(0,M,NZ,NY,NX)*(ZPOOL(NB,NZ,NY,NX)+ZPOLNB(NB,NZ,NY,NX) + 3+WTRSBN(NB,NZ,NY,NX)) + 4+CFOPN(1,M,NZ,NY,NX)*(WTLFBN(NB,NZ,NY,NX)*FWODLN(1) + 5+WTNDBN(NB,NZ,NY,NX)) + 6+CFOPN(2,M,NZ,NY,NX)*(WTSHBN(NB,NZ,NY,NX)*FWODSN(1) + 7+WTHSBN(NB,NZ,NY,NX)+WTEABN(NB,NZ,NY,NX))) + ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX)+(1.0-XHVST) + 2*CFOPN(5,M,NZ,NY,NX)*(WTLFBN(NB,NZ,NY,NX)*FWODLN(0) + 3+WTSHBN(NB,NZ,NY,NX)*FWODSN(0)) + PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX)+(1.0-XHVST) + 2*(CFOPP(0,M,NZ,NY,NX)*(PPOOL(NB,NZ,NY,NX)+PPOLNB(NB,NZ,NY,NX) + 3+WTRSBP(NB,NZ,NY,NX)) + 4+CFOPP(1,M,NZ,NY,NX)*(WTLFBP(NB,NZ,NY,NX)*FWODLP(1) + 5+WTNDBP(NB,NZ,NY,NX)) + 6+CFOPP(2,M,NZ,NY,NX)*(WTSHBP(NB,NZ,NY,NX)*FWODSP(1) + 7+WTHSBP(NB,NZ,NY,NX)+WTEABP(NB,NZ,NY,NX))) + PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX)+(1.0-XHVST) + 2*CFOPP(5,M,NZ,NY,NX)*(WTLFBP(NB,NZ,NY,NX)*FWODLP(0) + 3+WTSHBP(NB,NZ,NY,NX)*FWODSP(0)) + IF(ISTYP(NZ,NY,NX).EQ.0.AND.IWTYP(NZ,NY,NX).NE.0)THEN + WTRVC(NZ,NY,NX)=WTRVC(NZ,NY,NX)+(1.0-XHVST) + 2*CFOPC(2,M,NZ,NY,NX)*WTGRB(NB,NZ,NY,NX) + WTRVN(NZ,NY,NX)=WTRVN(NZ,NY,NX)+(1.0-XHVST) + 2*CFOPN(2,M,NZ,NY,NX)*WTGRBN(NB,NZ,NY,NX) + WTRVP(NZ,NY,NX)=WTRVP(NZ,NY,NX)+(1.0-XHVST) + 2*CFOPP(2,M,NZ,NY,NX)*WTGRBP(NB,NZ,NY,NX) + ELSE + CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX)+(1.0-XHVST) + 2*CFOPC(2,M,NZ,NY,NX)*WTGRB(NB,NZ,NY,NX) + ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX)+(1.0-XHVST) + 2*CFOPN(2,M,NZ,NY,NX)*WTGRBN(NB,NZ,NY,NX) + PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX)+(1.0-XHVST) + 2*CFOPP(2,M,NZ,NY,NX)*WTGRBP(NB,NZ,NY,NX) + ENDIF + IF(IBTYP(NZ,NY,NX).EQ.0.OR.IGTYP(NZ,NY,NX).LE.1)THEN + CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX)+(1.0-XHVST) + 2*CFOPC(3,M,NZ,NY,NX)*WTSTKB(NB,NZ,NY,NX) + ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX)+(1.0-XHVST) + 2*CFOPN(3,M,NZ,NY,NX)*WTSTBN(NB,NZ,NY,NX) + PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX)+(1.0-XHVST) + 2*CFOPP(3,M,NZ,NY,NX)*WTSTBP(NB,NZ,NY,NX) + ELSE + CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX)+(1.0-XHVST) + 2*CFOPC(5,M,NZ,NY,NX)*WTSTKB(NB,NZ,NY,NX) + ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX)+(1.0-XHVST) + 2*CFOPN(5,M,NZ,NY,NX)*WTSTBN(NB,NZ,NY,NX) + PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX)+(1.0-XHVST) + 2*CFOPP(5,M,NZ,NY,NX)*WTSTBP(NB,NZ,NY,NX) + ENDIF +6380 CONTINUE +C +C REDUCE PLANT STATE VARIABLES DURING TILLAGE +C + CPOOL(NB,NZ,NY,NX)=CPOOL(NB,NZ,NY,NX)*XHVST + CPOOLK(NB,NZ,NY,NX)=CPOOLK(NB,NZ,NY,NX)*XHVST + ZPOOL(NB,NZ,NY,NX)=ZPOOL(NB,NZ,NY,NX)*XHVST + PPOOL(NB,NZ,NY,NX)=PPOOL(NB,NZ,NY,NX)*XHVST + CPOLNB(NB,NZ,NY,NX)=CPOLNB(NB,NZ,NY,NX)*XHVST + ZPOLNB(NB,NZ,NY,NX)=ZPOLNB(NB,NZ,NY,NX)*XHVST + PPOLNB(NB,NZ,NY,NX)=PPOLNB(NB,NZ,NY,NX)*XHVST + WTSHTB(NB,NZ,NY,NX)=WTSHTB(NB,NZ,NY,NX)*XHVST + WTLFB(NB,NZ,NY,NX)=WTLFB(NB,NZ,NY,NX)*XHVST + WTNDB(NB,NZ,NY,NX)=WTNDB(NB,NZ,NY,NX)*XHVST + WTSHEB(NB,NZ,NY,NX)=WTSHEB(NB,NZ,NY,NX)*XHVST + WTSTKB(NB,NZ,NY,NX)=WTSTKB(NB,NZ,NY,NX)*XHVST + WVSTKB(NB,NZ,NY,NX)=WVSTKB(NB,NZ,NY,NX)*XHVST + WTRSVB(NB,NZ,NY,NX)=WTRSVB(NB,NZ,NY,NX)*XHVST + WTHSKB(NB,NZ,NY,NX)=WTHSKB(NB,NZ,NY,NX)*XHVST + WTEARB(NB,NZ,NY,NX)=WTEARB(NB,NZ,NY,NX)*XHVST + WTGRB(NB,NZ,NY,NX)=WTGRB(NB,NZ,NY,NX)*XHVST + WTSHTN(NB,NZ,NY,NX)=WTSHTN(NB,NZ,NY,NX)*XHVST + WTLFBN(NB,NZ,NY,NX)=WTLFBN(NB,NZ,NY,NX)*XHVST + WTNDBN(NB,NZ,NY,NX)=WTNDBN(NB,NZ,NY,NX)*XHVST + WTSHBN(NB,NZ,NY,NX)=WTSHBN(NB,NZ,NY,NX)*XHVST + WTSTBN(NB,NZ,NY,NX)=WTSTBN(NB,NZ,NY,NX)*XHVST + WTRSBN(NB,NZ,NY,NX)=WTRSBN(NB,NZ,NY,NX)*XHVST + WTHSBN(NB,NZ,NY,NX)=WTHSBN(NB,NZ,NY,NX)*XHVST + WTEABN(NB,NZ,NY,NX)=WTEABN(NB,NZ,NY,NX)*XHVST + WTGRBN(NB,NZ,NY,NX)=WTGRBN(NB,NZ,NY,NX)*XHVST + WTSHTP(NB,NZ,NY,NX)=WTSHTP(NB,NZ,NY,NX)*XHVST + WTLFBP(NB,NZ,NY,NX)=WTLFBP(NB,NZ,NY,NX)*XHVST + WTNDBP(NB,NZ,NY,NX)=WTNDBP(NB,NZ,NY,NX)*XHVST + WTSHBP(NB,NZ,NY,NX)=WTSHBP(NB,NZ,NY,NX)*XHVST + WTSTBP(NB,NZ,NY,NX)=WTSTBP(NB,NZ,NY,NX)*XHVST + WTRSBP(NB,NZ,NY,NX)=WTRSBP(NB,NZ,NY,NX)*XHVST + WTHSBP(NB,NZ,NY,NX)=WTHSBP(NB,NZ,NY,NX)*XHVST + WTEABP(NB,NZ,NY,NX)=WTEABP(NB,NZ,NY,NX)*XHVST + WTGRBP(NB,NZ,NY,NX)=WTGRBP(NB,NZ,NY,NX)*XHVST + GRNXB(NB,NZ,NY,NX)=GRNXB(NB,NZ,NY,NX)*XHVST + GRNOB(NB,NZ,NY,NX)=GRNOB(NB,NZ,NY,NX)*XHVST + GRWTB(NB,NZ,NY,NX)=GRWTB(NB,NZ,NY,NX)*XHVST + ARLFB(NB,NZ,NY,NX)=ARLFB(NB,NZ,NY,NX)*XHVST + WTLSB(NB,NZ,NY,NX)=AMAX1(0.0,WTLFB(NB,NZ,NY,NX) + 2+WTSHEB(NB,NZ,NY,NX)) + WTLS(NZ,NY,NX)=WTLS(NZ,NY,NX)+WTLSB(NB,NZ,NY,NX) + WTSTXB(NB,NZ,NY,NX)=WTSTXB(NB,NZ,NY,NX)*XHVST + WTSTXN(NB,NZ,NY,NX)=WTSTXN(NB,NZ,NY,NX)*XHVST + WTSTXP(NB,NZ,NY,NX)=WTSTXP(NB,NZ,NY,NX)*XHVST + WVSTK(NZ,NY,NX)=WVSTK(NZ,NY,NX)+WVSTKB(NB,NZ,NY,NX) + DO 8970 K=0,25 + IF(K.NE.0)THEN + CPOOL3(K,NB,NZ,NY,NX)=CPOOL3(K,NB,NZ,NY,NX)*XHVST + CPOOL4(K,NB,NZ,NY,NX)=CPOOL4(K,NB,NZ,NY,NX)*XHVST + CO2B(K,NB,NZ,NY,NX)=CO2B(K,NB,NZ,NY,NX)*XHVST + HCOB(K,NB,NZ,NY,NX)=HCOB(K,NB,NZ,NY,NX)*XHVST + ENDIF + ARLF(K,NB,NZ,NY,NX)=ARLF(K,NB,NZ,NY,NX)*XHVST + WGLF(K,NB,NZ,NY,NX)=WGLF(K,NB,NZ,NY,NX)*XHVST + WSLF(K,NB,NZ,NY,NX)=WSLF(K,NB,NZ,NY,NX)*XHVST +C HTSHE(K,NB,NZ,NY,NX)=HTSHE(K,NB,NZ,NY,NX)*XHVST + WGSHE(K,NB,NZ,NY,NX)=WGSHE(K,NB,NZ,NY,NX)*XHVST + WSSHE(K,NB,NZ,NY,NX)=WSSHE(K,NB,NZ,NY,NX)*XHVST +C HTNODE(K,NB,NZ,NY,NX)=HTNODE(K,NB,NZ,NY,NX)*XHVST +C HTNODX(K,NB,NZ,NY,NX)=HTNODX(K,NB,NZ,NY,NX)*XHVST + WGNODE(K,NB,NZ,NY,NX)=WGNODE(K,NB,NZ,NY,NX)*XHVST + WGLFN(K,NB,NZ,NY,NX)=WGLFN(K,NB,NZ,NY,NX)*XHVST + WGSHN(K,NB,NZ,NY,NX)=WGSHN(K,NB,NZ,NY,NX)*XHVST + WGNODN(K,NB,NZ,NY,NX)=WGNODN(K,NB,NZ,NY,NX)*XHVST + WGLFP(K,NB,NZ,NY,NX)=WGLFP(K,NB,NZ,NY,NX)*XHVST + WGSHP(K,NB,NZ,NY,NX)=WGSHP(K,NB,NZ,NY,NX)*XHVST + WGNODP(K,NB,NZ,NY,NX)=WGNODP(K,NB,NZ,NY,NX)*XHVST + DO 8965 L=1,JC + ARLFL(L,K,NB,NZ,NY,NX)=ARLFL(L,K,NB,NZ,NY,NX)*XHVST + WGLFL(L,K,NB,NZ,NY,NX)=WGLFL(L,K,NB,NZ,NY,NX)*XHVST + WGLFLN(L,K,NB,NZ,NY,NX)=WGLFLN(L,K,NB,NZ,NY,NX)*XHVST + WGLFLP(L,K,NB,NZ,NY,NX)=WGLFLP(L,K,NB,NZ,NY,NX)*XHVST +8965 CONTINUE +8970 CONTINUE + ENDIF +8975 CONTINUE + VOLWPX=VOLWP(NZ,NY,NX) + WVPLT=AMAX1(0.0,WTLS(NZ,NY,NX)+WVSTK(NZ,NY,NX)) + APSILT=ABS(PSILT(NZ,NY,NX)) + FDM=0.16+0.10*APSILT/(0.05*APSILT+2.0) + VOLWP(NZ,NY,NX)=1.0E-06*WVPLT/FDM + VOLWOU=VOLWOU+VOLWPX-VOLWP(NZ,NY,NX) + UVOLO(NY,NX)=UVOLO(NY,NX)+VOLWPX-VOLWP(NZ,NY,NX) +C +C TERMINATE ROOTS IF TILLAGE IMPLEMENT 10 IS SELECTED +C + IF(PP(NZ,NY,NX).LE.0.0)THEN + IDTHR(NZ,NY,NX)=1 + IDTHP(NZ,NY,NX)=1 + IDTH(NZ,NY,NX)=1 + JHVST(NZ,I,NY,NX)=1 + IDAYH(NZ,NY,NX)=I + IYRH(NZ,NY,NX)=IYRC + ENDIF +C +C LITTERFALL FROM ROOTS DURING TILLAGE +C + DO 8985 N=1,MY(NZ,NY,NX) + DO 8980 L=NU(NY,NX),NJ(NY,NX) + DO 6385 M=1,4 + CSNC(M,1,L,NZ,NY,NX)=CSNC(M,1,L,NZ,NY,NX)+(1.0-XHVST) + 2*CFOPC(0,M,NZ,NY,NX)*CPOOLR(N,L,NZ,NY,NX) + ZSNC(M,1,L,NZ,NY,NX)=ZSNC(M,1,L,NZ,NY,NX)+(1.0-XHVST) + 2*CFOPN(0,M,NZ,NY,NX)*ZPOOLR(N,L,NZ,NY,NX) + PSNC(M,1,L,NZ,NY,NX)=PSNC(M,1,L,NZ,NY,NX)+(1.0-XHVST) + 2*CFOPP(0,M,NZ,NY,NX)*PPOOLR(N,L,NZ,NY,NX) + DO 6385 NR=1,NRT(NZ,NY,NX) + CSNC(M,0,L,NZ,NY,NX)=CSNC(M,0,L,NZ,NY,NX)+(1.0-XHVST) + 2*CFOPC(5,M,NZ,NY,NX)*(WTRT1(N,L,NR,NZ,NY,NX) + 3+WTRT2(N,L,NR,NZ,NY,NX))*FWOOD(0) + ZSNC(M,0,L,NZ,NY,NX)=ZSNC(M,0,L,NZ,NY,NX)+(1.0-XHVST) + 2*CFOPN(5,M,NZ,NY,NX)*(WTRT1N(N,L,NR,NZ,NY,NX) + 3+WTRT2N(N,L,NR,NZ,NY,NX))*FWOODN(0) + PSNC(M,0,L,NZ,NY,NX)=PSNC(M,0,L,NZ,NY,NX)+(1.0-XHVST) + 2*CFOPP(5,M,NZ,NY,NX)*(WTRT1P(N,L,NR,NZ,NY,NX) + 3+WTRT2P(N,L,NR,NZ,NY,NX))*FWOODP(0) + CSNC(M,1,L,NZ,NY,NX)=CSNC(M,1,L,NZ,NY,NX)+(1.0-XHVST) + 2*CFOPC(4,M,NZ,NY,NX)*(WTRT1(N,L,NR,NZ,NY,NX) + 3+WTRT2(N,L,NR,NZ,NY,NX))*FWOOD(1) + ZSNC(M,1,L,NZ,NY,NX)=ZSNC(M,1,L,NZ,NY,NX)+(1.0-XHVST) + 2*CFOPN(4,M,NZ,NY,NX)*(WTRT1N(N,L,NR,NZ,NY,NX) + 3+WTRT2N(N,L,NR,NZ,NY,NX))*FWOODN(1) + PSNC(M,1,L,NZ,NY,NX)=PSNC(M,1,L,NZ,NY,NX)+(1.0-XHVST) + 2*CFOPP(4,M,NZ,NY,NX)*(WTRT1P(N,L,NR,NZ,NY,NX) + 3+WTRT2P(N,L,NR,NZ,NY,NX))*FWOODP(1) +6385 CONTINUE +C +C RELEASE ROOT GAS CONTENTS DURING TILLAGE +C + RCO2Z(NZ,NY,NX)=RCO2Z(NZ,NY,NX)-(1.0-XHVST) + 2*(CO2A(N,L,NZ,NY,NX)+CO2P(N,L,NZ,NY,NX)) + ROXYZ(NZ,NY,NX)=ROXYZ(NZ,NY,NX)-(1.0-XHVST) + 2*(OXYA(N,L,NZ,NY,NX)+OXYP(N,L,NZ,NY,NX)) + RCH4Z(NZ,NY,NX)=RCH4Z(NZ,NY,NX)-(1.0-XHVST) + 2*(CH4A(N,L,NZ,NY,NX)+CH4P(N,L,NZ,NY,NX)) + RN2OZ(NZ,NY,NX)=RN2OZ(NZ,NY,NX)-(1.0-XHVST) + 2*(Z2OA(N,L,NZ,NY,NX)+Z2OP(N,L,NZ,NY,NX)) + RNH3Z(NZ,NY,NX)=RNH3Z(NZ,NY,NX)-(1.0-XHVST) + 2*(ZH3A(N,L,NZ,NY,NX)+ZH3P(N,L,NZ,NY,NX)) + RH2GZ(NZ,NY,NX)=RH2GZ(NZ,NY,NX)-(1.0-XHVST) + 2*(H2GA(N,L,NZ,NY,NX)+H2GP(N,L,NZ,NY,NX)) + CO2A(N,L,NZ,NY,NX)=XHVST*CO2A(N,L,NZ,NY,NX) + OXYA(N,L,NZ,NY,NX)=XHVST*OXYA(N,L,NZ,NY,NX) + CH4A(N,L,NZ,NY,NX)=XHVST*CH4A(N,L,NZ,NY,NX) + Z2OA(N,L,NZ,NY,NX)=XHVST*Z2OA(N,L,NZ,NY,NX) + ZH3A(N,L,NZ,NY,NX)=XHVST*ZH3A(N,L,NZ,NY,NX) + H2GA(N,L,NZ,NY,NX)=XHVST*H2GA(N,L,NZ,NY,NX) + CO2P(N,L,NZ,NY,NX)=XHVST*CO2P(N,L,NZ,NY,NX) + OXYP(N,L,NZ,NY,NX)=XHVST*OXYP(N,L,NZ,NY,NX) + CH4P(N,L,NZ,NY,NX)=XHVST*CH4P(N,L,NZ,NY,NX) + Z2OP(N,L,NZ,NY,NX)=XHVST*Z2OP(N,L,NZ,NY,NX) + ZH3P(N,L,NZ,NY,NX)=XHVST*ZH3P(N,L,NZ,NY,NX) + H2GP(N,L,NZ,NY,NX)=XHVST*H2GP(N,L,NZ,NY,NX) +C +C REDUCE ROOT STATE VARIABLES DURING TILLAGE +C + DO 8960 NR=1,NRT(NZ,NY,NX) + WTRT1(N,L,NR,NZ,NY,NX)=WTRT1(N,L,NR,NZ,NY,NX)*XHVST + WTRT2(N,L,NR,NZ,NY,NX)=WTRT2(N,L,NR,NZ,NY,NX)*XHVST + WTRT1N(N,L,NR,NZ,NY,NX)=WTRT1N(N,L,NR,NZ,NY,NX)*XHVST + WTRT2N(N,L,NR,NZ,NY,NX)=WTRT2N(N,L,NR,NZ,NY,NX)*XHVST + WTRT1P(N,L,NR,NZ,NY,NX)=WTRT1P(N,L,NR,NZ,NY,NX)*XHVST + WTRT2P(N,L,NR,NZ,NY,NX)=WTRT2P(N,L,NR,NZ,NY,NX)*XHVST + RTWT1(N,NR,NZ,NY,NX)=RTWT1(N,NR,NZ,NY,NX)*XHVST + RTWT1N(N,NR,NZ,NY,NX)=RTWT1N(N,NR,NZ,NY,NX)*XHVST + RTWT1P(N,NR,NZ,NY,NX)=RTWT1P(N,NR,NZ,NY,NX)*XHVST + RTLG1(N,L,NR,NZ,NY,NX)=RTLG1(N,L,NR,NZ,NY,NX)*XHVST + RTLG2(N,L,NR,NZ,NY,NX)=RTLG2(N,L,NR,NZ,NY,NX)*XHVST + RTN2(N,L,NR,NZ,NY,NX)=RTN2(N,L,NR,NZ,NY,NX)*XHVST +8960 CONTINUE + CPOOLR(N,L,NZ,NY,NX)=CPOOLR(N,L,NZ,NY,NX)*XHVST + ZPOOLR(N,L,NZ,NY,NX)=ZPOOLR(N,L,NZ,NY,NX)*XHVST + PPOOLR(N,L,NZ,NY,NX)=PPOOLR(N,L,NZ,NY,NX)*XHVST + WTRTL(N,L,NZ,NY,NX)=WTRTL(N,L,NZ,NY,NX)*XHVST + WTRTD(N,L,NZ,NY,NX)=WTRTD(N,L,NZ,NY,NX)*XHVST + WSRTL(N,L,NZ,NY,NX)=WSRTL(N,L,NZ,NY,NX)*XHVST + RTN1(N,L,NZ,NY,NX)=RTN1(N,L,NZ,NY,NX)*XHVST + RTNL(N,L,NZ,NY,NX)=RTNL(N,L,NZ,NY,NX)*XHVST + RTLGP(N,L,NZ,NY,NX)=RTLGP(N,L,NZ,NY,NX)*XHVST + RTDNP(N,L,NZ,NY,NX)=RTDNP(N,L,NZ,NY,NX)*XHVST + RTVLP(N,L,NZ,NY,NX)=RTVLP(N,L,NZ,NY,NX)*XHVST + RTVLW(N,L,NZ,NY,NX)=RTVLW(N,L,NZ,NY,NX)*XHVST + RTARP(N,L,NZ,NY,NX)=RTARP(N,L,NZ,NY,NX)*XHVST + RCO2M(N,L,NZ,NY,NX)=RCO2M(N,L,NZ,NY,NX)*XHVST + RCO2N(N,L,NZ,NY,NX)=RCO2N(N,L,NZ,NY,NX)*XHVST + RCO2A(N,L,NZ,NY,NX)=RCO2A(N,L,NZ,NY,NX)*XHVST +C +C LITTERFALL AND STATE VARIABLES FOR NODULES DURING TILLAGE +C + IF(INTYP(NZ,NY,NX).NE.0.AND.N.EQ.1)THEN + DO 6395 M=1,4 + CSNC(M,1,L,NZ,NY,NX)=CSNC(M,1,L,NZ,NY,NX)+(1.0-XHVST) + 2*(CFOPC(4,M,NZ,NY,NX)*WTNDL(L,NZ,NY,NX) + 3+CFOPC(0,M,NZ,NY,NX)*CPOOLN(L,NZ,NY,NX)) + ZSNC(M,1,L,NZ,NY,NX)=ZSNC(M,1,L,NZ,NY,NX)+(1.0-XHVST) + 2*(CFOPN(4,M,NZ,NY,NX)*WTNDLN(L,NZ,NY,NX) + 3+CFOPN(0,M,NZ,NY,NX)*ZPOOLN(L,NZ,NY,NX)) + PSNC(M,1,L,NZ,NY,NX)=PSNC(M,1,L,NZ,NY,NX)+(1.0-XHVST) + 2*(CFOPP(4,M,NZ,NY,NX)*WTNDLP(L,NZ,NY,NX) + 3+CFOPP(0,M,NZ,NY,NX)*PPOOLN(L,NZ,NY,NX)) +6395 CONTINUE + WTNDL(L,NZ,NY,NX)=WTNDL(L,NZ,NY,NX)*XHVST + WTNDLN(L,NZ,NY,NX)=WTNDLN(L,NZ,NY,NX)*XHVST + WTNDLP(L,NZ,NY,NX)=WTNDLP(L,NZ,NY,NX)*XHVST + CPOOLN(L,NZ,NY,NX)=CPOOLN(L,NZ,NY,NX)*XHVST + ZPOOLN(L,NZ,NY,NX)=ZPOOLN(L,NZ,NY,NX)*XHVST + PPOOLN(L,NZ,NY,NX)=PPOOLN(L,NZ,NY,NX)*XHVST + ENDIF +8980 CONTINUE +8985 CONTINUE +C +C LITTERFALL AND STATE VARIABLES FOR SEASONAL STORAGE RESERVES +C DURING TILLAGE +C + DO 6400 M=1,4 + CSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX)=CSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX) + 2+((1.0-XHVST)*CFOPC(0,M,NZ,NY,NX)*WTRVC(NZ,NY,NX))*FWOOD(0) + ZSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX)=ZSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX) + 2+((1.0-XHVST)*CFOPN(0,M,NZ,NY,NX)*WTRVN(NZ,NY,NX))*FWOODN(0) + PSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX)=PSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX) + 2+((1.0-XHVST)*CFOPP(0,M,NZ,NY,NX)*WTRVP(NZ,NY,NX))*FWOODP(0) + CSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX)=CSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX) + 2+((1.0-XHVST)*CFOPC(0,M,NZ,NY,NX)*WTRVC(NZ,NY,NX))*FWOOD(1) + ZSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX)=ZSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX) + 2+((1.0-XHVST)*CFOPN(0,M,NZ,NY,NX)*WTRVN(NZ,NY,NX))*FWOODN(1) + PSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX)=PSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX) + 2+((1.0-XHVST)*CFOPP(0,M,NZ,NY,NX)*WTRVP(NZ,NY,NX))*FWOODP(1) +6400 CONTINUE + WTRVC(NZ,NY,NX)=WTRVC(NZ,NY,NX)*XHVST + WTRVN(NZ,NY,NX)=WTRVN(NZ,NY,NX)*XHVST + WTRVP(NZ,NY,NX)=WTRVP(NZ,NY,NX)*XHVST + ENDIF + ENDIF + ENDIF +C +C DEAD BRANCHES +C + IF(J.EQ.INT(ZNOON(NY,NX)).AND.IDAY(1,NB1(NZ,NY,NX),NZ,NY,NX).NE.0 + 2.AND.(ISTYP(NZ,NY,NX).NE.0.OR.(I.GE.IDAYH(NZ,NY,NX) + 3.AND.IYRC.GE.IYRH(NZ,NY,NX))))THEN + IDTHY=0 +C +C RESET PHENOLOGY AND GROWTH STAGE OF DEAD BRANCHES +C + DO 8845 NB=1,NBR(NZ,NY,NX) + IF(IDTHB(NB,NZ,NY,NX).EQ.1)THEN + GROUP(NB,NZ,NY,NX)=GROUPI(NZ,NY,NX) + PSTG(NB,NZ,NY,NX)=XTLI(NZ,NY,NX) + PSTGI(NB,NZ,NY,NX)=PSTG(NB,NZ,NY,NX) + PSTGF(NB,NZ,NY,NX)=0.0 + VSTG(NB,NZ,NY,NX)=0.0 + VSTGX(NB,NZ,NY,NX)=0.0 + KLEAF(NB,NZ,NY,NX)=1 + KVSTG(NB,NZ,NY,NX)=1 + TGSTGI(NB,NZ,NY,NX)=0.0 + TGSTGF(NB,NZ,NY,NX)=0.0 + VRNS(NB,NZ,NY,NX)=0.0 + VRNF(NB,NZ,NY,NX)=0.0 + VRNY(NB,NZ,NY,NX)=0.0 + VRNZ(NB,NZ,NY,NX)=0.0 + ATRP(NB,NZ,NY,NX)=0.0 + FLG4(NB,NZ,NY,NX)=0.0 + FDBK(NB,NZ,NY,NX)=1.0 + FDBKX(NB,NZ,NY,NX)=1.0 + IFLGA(NB,NZ,NY,NX)=0 + IFLGE(NB,NZ,NY,NX)=1 + IFLGF(NB,NZ,NY,NX)=0 + IFLGR(NB,NZ,NY,NX)=0 + IFLGQ(NB,NZ,NY,NX)=0 + IFLGD(NB,NZ,NY,NX)=0 + NBTB(NB,NZ,NY,NX)=0 + DO 8850 M=1,10 + IDAY(M,NB,NZ,NY,NX)=0 +8850 CONTINUE +C +C LITTERFALL FROM DEAD BRANCHES +C + DO 6405 M=1,4 + CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) + 2+CFOPC(0,M,NZ,NY,NX)*CPOLNB(NB,NZ,NY,NX) + 4+CFOPC(1,M,NZ,NY,NX)*(WTLFB(NB,NZ,NY,NX)*FWODB(1) + 5+WTNDB(NB,NZ,NY,NX)) + 6+CFOPC(2,M,NZ,NY,NX)*(WTSHEB(NB,NZ,NY,NX)*FWODB(1) + 7+WTHSKB(NB,NZ,NY,NX)+WTEARB(NB,NZ,NY,NX)) + CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX) + 2+CFOPC(5,M,NZ,NY,NX)*(WTLFB(NB,NZ,NY,NX)*FWODB(0) + 3+WTSHEB(NB,NZ,NY,NX)*FWODB(0)) + ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) + 2+CFOPN(0,M,NZ,NY,NX)*ZPOLNB(NB,NZ,NY,NX) + 4+CFOPN(1,M,NZ,NY,NX)*(WTLFBN(NB,NZ,NY,NX)*FWODLN(1) + 5+WTNDBN(NB,NZ,NY,NX)) + 6+CFOPN(2,M,NZ,NY,NX)*(WTSHBN(NB,NZ,NY,NX)*FWODSN(1) + 7+WTHSBN(NB,NZ,NY,NX)+WTEABN(NB,NZ,NY,NX)) + ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX) + 2+CFOPN(5,M,NZ,NY,NX)*(WTLFBN(NB,NZ,NY,NX)*FWODLN(0) + 3+WTSHBN(NB,NZ,NY,NX)*FWODSN(0)) + PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) + 2+CFOPP(0,M,NZ,NY,NX)*PPOLNB(NB,NZ,NY,NX) + 4+CFOPP(1,M,NZ,NY,NX)*(WTLFBP(NB,NZ,NY,NX)*FWODLP(1) + 5+WTNDBP(NB,NZ,NY,NX)) + 6+CFOPP(2,M,NZ,NY,NX)*(WTSHBP(NB,NZ,NY,NX)*FWODSP(1) + 7+WTHSBP(NB,NZ,NY,NX)+WTEABP(NB,NZ,NY,NX)) + PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX) + 2+CFOPP(5,M,NZ,NY,NX)*(WTLFBP(NB,NZ,NY,NX)*FWODLP(0) + 3+WTSHBP(NB,NZ,NY,NX)*FWODSP(0)) + IF(ISTYP(NZ,NY,NX).EQ.0.AND.IWTYP(NZ,NY,NX).NE.0)THEN + WTRVC(NZ,NY,NX)=WTRVC(NZ,NY,NX) + 2+CFOPC(2,M,NZ,NY,NX)*WTGRB(NB,NZ,NY,NX) + WTRVN(NZ,NY,NX)=WTRVN(NZ,NY,NX) + 2+CFOPN(2,M,NZ,NY,NX)*WTGRBN(NB,NZ,NY,NX) + WTRVP(NZ,NY,NX)=WTRVP(NZ,NY,NX) + 2+CFOPP(2,M,NZ,NY,NX)*WTGRBP(NB,NZ,NY,NX) + ELSE + CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) + 2+CFOPC(2,M,NZ,NY,NX)*WTGRB(NB,NZ,NY,NX) + ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) + 2+CFOPN(2,M,NZ,NY,NX)*WTGRBN(NB,NZ,NY,NX) + PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) + 2+CFOPP(2,M,NZ,NY,NX)*WTGRBP(NB,NZ,NY,NX) + ENDIF + IF(IBTYP(NZ,NY,NX).EQ.0.OR.IGTYP(NZ,NY,NX).LE.1)THEN + CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) + 5+CFOPC(3,M,NZ,NY,NX)*WTSTKB(NB,NZ,NY,NX) + ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) + 5+CFOPN(3,M,NZ,NY,NX)*WTSTBN(NB,NZ,NY,NX) + PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) + 5+CFOPP(3,M,NZ,NY,NX)*WTSTBP(NB,NZ,NY,NX) + ELSE + WTSTDG(M,NZ,NY,NX)=WTSTDG(M,NZ,NY,NX) + 5+CFOPC(5,M,NZ,NY,NX)*WTSTKB(NB,NZ,NY,NX) + WTSTDN(M,NZ,NY,NX)=WTSTDN(M,NZ,NY,NX) + 5+CFOPN(5,M,NZ,NY,NX)*WTSTBN(NB,NZ,NY,NX) + WTSTDP(M,NZ,NY,NX)=WTSTDP(M,NZ,NY,NX) + 5+CFOPP(5,M,NZ,NY,NX)*WTSTBP(NB,NZ,NY,NX) + ENDIF +6405 CONTINUE +C +C RECOVER NON-STRUCTURAL C,N,P FROM BRANCH TO +C SEASONAL STORAGE RESERVES +C + WTRVC(NZ,NY,NX)=WTRVC(NZ,NY,NX)+CPOOL(NB,NZ,NY,NX) + 2+CPOOLK(NB,NZ,NY,NX) + WTRVN(NZ,NY,NX)=WTRVN(NZ,NY,NX)+ZPOOL(NB,NZ,NY,NX) + WTRVP(NZ,NY,NX)=WTRVP(NZ,NY,NX)+PPOOL(NB,NZ,NY,NX) + IF(IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6)THEN + DO 6406 M=1,4 + CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) + 2+CFOPC(0,M,NZ,NY,NX)*WTRSVB(NB,NZ,NY,NX) + ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) + 2+CFOPN(0,M,NZ,NY,NX)*WTRSBN(NB,NZ,NY,NX) + PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) + 2+CFOPP(0,M,NZ,NY,NX)*WTRSBP(NB,NZ,NY,NX) +6406 CONTINUE + ELSE + WTRVC(NZ,NY,NX)=WTRVC(NZ,NY,NX)+WTRSVB(NB,NZ,NY,NX) + WTRVN(NZ,NY,NX)=WTRVN(NZ,NY,NX)+WTRSBN(NB,NZ,NY,NX) + WTRVP(NZ,NY,NX)=WTRVP(NZ,NY,NX)+WTRSBP(NB,NZ,NY,NX) + ENDIF +C +C RESET STATE VARIABLES FROM DEAD BRANCHES +C + CPOOL(NB,NZ,NY,NX)=0.0 + CPOOLK(NB,NZ,NY,NX)=0.0 + ZPOOL(NB,NZ,NY,NX)=0.0 + PPOOL(NB,NZ,NY,NX)=0.0 + CPOLNB(NB,NZ,NY,NX)=0.0 + ZPOLNB(NB,NZ,NY,NX)=0.0 + PPOLNB(NB,NZ,NY,NX)=0.0 + WTSHTB(NB,NZ,NY,NX)=0.0 + WTLFB(NB,NZ,NY,NX)=0.0 + WTNDB(NB,NZ,NY,NX)=0.0 + WTSHEB(NB,NZ,NY,NX)=0.0 + WTSTKB(NB,NZ,NY,NX)=0.0 + WVSTKB(NB,NZ,NY,NX)=0.0 + WTRSVB(NB,NZ,NY,NX)=0.0 + WTHSKB(NB,NZ,NY,NX)=0.0 + WTEARB(NB,NZ,NY,NX)=0.0 + WTGRB(NB,NZ,NY,NX)=0.0 + WTLSB(NB,NZ,NY,NX)=0.0 + WTSHTN(NB,NZ,NY,NX)=0.0 + WTLFBN(NB,NZ,NY,NX)=0.0 + WTNDBN(NB,NZ,NY,NX)=0.0 + WTSHBN(NB,NZ,NY,NX)=0.0 + WTSTBN(NB,NZ,NY,NX)=0.0 + WTRSBN(NB,NZ,NY,NX)=0.0 + WTHSBN(NB,NZ,NY,NX)=0.0 + WTEABN(NB,NZ,NY,NX)=0.0 + WTGRBN(NB,NZ,NY,NX)=0.0 + WTSHTP(NB,NZ,NY,NX)=0.0 + WTLFBP(NB,NZ,NY,NX)=0.0 + WTNDBP(NB,NZ,NY,NX)=0.0 + WTSHBP(NB,NZ,NY,NX)=0.0 + WTSTBP(NB,NZ,NY,NX)=0.0 + WTRSBP(NB,NZ,NY,NX)=0.0 + WTHSBP(NB,NZ,NY,NX)=0.0 + WTEABP(NB,NZ,NY,NX)=0.0 + WTGRBP(NB,NZ,NY,NX)=0.0 + GRNXB(NB,NZ,NY,NX)=0.0 + GRNOB(NB,NZ,NY,NX)=0.0 + GRWTB(NB,NZ,NY,NX)=0.0 + ARLFB(NB,NZ,NY,NX)=0.0 + WTSTXB(NB,NZ,NY,NX)=0.0 + WTSTXN(NB,NZ,NY,NX)=0.0 + WTSTXP(NB,NZ,NY,NX)=0.0 + DO 8855 K=0,25 + IF(K.NE.0)THEN + CPOOL3(K,NB,NZ,NY,NX)=0.0 + CPOOL4(K,NB,NZ,NY,NX)=0.0 + CO2B(K,NB,NZ,NY,NX)=0.0 + HCOB(K,NB,NZ,NY,NX)=0.0 + ENDIF + ARLF(K,NB,NZ,NY,NX)=0.0 + HTNODE(K,NB,NZ,NY,NX)=0.0 + HTNODX(K,NB,NZ,NY,NX)=0.0 + HTSHE(K,NB,NZ,NY,NX)=0.0 + WGLF(K,NB,NZ,NY,NX)=0.0 + WSLF(K,NB,NZ,NY,NX)=0.0 + WGLFN(K,NB,NZ,NY,NX)=0.0 + WGLFP(K,NB,NZ,NY,NX)=0.0 + WGSHE(K,NB,NZ,NY,NX)=0.0 + WSSHE(K,NB,NZ,NY,NX)=0.0 + WGSHN(K,NB,NZ,NY,NX)=0.0 + WGSHP(K,NB,NZ,NY,NX)=0.0 + WGNODE(K,NB,NZ,NY,NX)=0.0 + WGNODN(K,NB,NZ,NY,NX)=0.0 + WGNODP(K,NB,NZ,NY,NX)=0.0 + DO 8865 L=1,JC + ARLFV(L,NZ,NY,NX)=ARLFV(L,NZ,NY,NX)-ARLFL(L,K,NB,NZ,NY,NX) + WGLFV(L,NZ,NY,NX)=WGLFV(L,NZ,NY,NX)-WGLFL(L,K,NB,NZ,NY,NX) + ARLFL(L,K,NB,NZ,NY,NX)=0.0 + WGLFL(L,K,NB,NZ,NY,NX)=0.0 + WGLFLN(L,K,NB,NZ,NY,NX)=0.0 + WGLFLP(L,K,NB,NZ,NY,NX)=0.0 + IF(K.NE.0)THEN + DO 8860 N=1,4 + SURF(N,L,K,NB,NZ,NY,NX)=0.0 +8860 CONTINUE + ENDIF +8865 CONTINUE +8855 CONTINUE + DO 8875 L=1,JC + ARSTK(L,NB,NZ,NY,NX)=0.0 + DO 8875 N=1,4 + SURFB(N,L,NB,NZ,NY,NX)=0.0 +8875 CONTINUE + IDTHY=IDTHY+1 + ENDIF +8845 CONTINUE + IF(IDTHY.EQ.NBR(NZ,NY,NX))THEN + IDTHP(NZ,NY,NX)=1 + NBT(NZ,NY,NX)=0 + WSTR(NZ,NY,NX)=0.0 + IF(IFLGI(NZ,NY,NX).EQ.1)THEN + NBR(NZ,NY,NX)=1 + ELSE + NBR(NZ,NY,NX)=0 + ENDIF + HTCTL(NZ,NY,NX)=0.0 + VOLWOU=VOLWOU+VOLWP(NZ,NY,NX) + UVOLO(NY,NX)=UVOLO(NY,NX)+VOLWP(NZ,NY,NX) + VOLWP(NZ,NY,NX)=0.0 + IF(WTRVC(NZ,NY,NX).LT.1.0E-04*WTRT(NZ,NY,NX) + 2.AND.ISTYP(NZ,NY,NX).NE.0)IDTHR(NZ,NY,NX)=1 + IF(ISTYP(NZ,NY,NX).EQ.0)IDTHR(NZ,NY,NX)=1 + IF(JHVST(NZ,I,NY,NX).NE.0)IDTHR(NZ,NY,NX)=1 + IF(PP(NZ,NY,NX).LE.0.0)IDTHR(NZ,NY,NX)=1 + IF(IDTHR(NZ,NY,NX).EQ.1)IDTHP(NZ,NY,NX)=1 + ENDIF +C +C DEAD ROOTS +C +C +C LITTERFALL FROM DEAD ROOTS +C + IF(IDTHR(NZ,NY,NX).EQ.1)THEN + DO 8900 N=1,MY(NZ,NY,NX) + DO 8895 L=NU(NY,NX),NJ(NY,NX) + DO 6410 M=1,4 + CSNC(M,1,L,NZ,NY,NX)=CSNC(M,1,L,NZ,NY,NX)+CFOPC(0,M,NZ,NY,NX) + 2*CPOOLR(N,L,NZ,NY,NX) + ZSNC(M,1,L,NZ,NY,NX)=ZSNC(M,1,L,NZ,NY,NX)+CFOPN(0,M,NZ,NY,NX) + 2*ZPOOLR(N,L,NZ,NY,NX) + PSNC(M,1,L,NZ,NY,NX)=PSNC(M,1,L,NZ,NY,NX)+CFOPP(0,M,NZ,NY,NX) + 2*PPOOLR(N,L,NZ,NY,NX) + DO 6410 NR=1,NRT(NZ,NY,NX) + CSNC(M,0,L,NZ,NY,NX)=CSNC(M,0,L,NZ,NY,NX)+CFOPC(5,M,NZ,NY,NX) + 2*(WTRT1(N,L,NR,NZ,NY,NX)+WTRT2(N,L,NR,NZ,NY,NX))*FWOOD(0) + ZSNC(M,0,L,NZ,NY,NX)=ZSNC(M,0,L,NZ,NY,NX)+CFOPN(5,M,NZ,NY,NX) + 2*(WTRT1N(N,L,NR,NZ,NY,NX)+WTRT2N(N,L,NR,NZ,NY,NX))*FWOODN(0) + PSNC(M,0,L,NZ,NY,NX)=PSNC(M,0,L,NZ,NY,NX)+CFOPP(5,M,NZ,NY,NX) + 2*(WTRT1P(N,L,NR,NZ,NY,NX)+WTRT2P(N,L,NR,NZ,NY,NX))*FWOODP(0) + CSNC(M,1,L,NZ,NY,NX)=CSNC(M,1,L,NZ,NY,NX)+CFOPC(4,M,NZ,NY,NX) + 2*(WTRT1(N,L,NR,NZ,NY,NX)+WTRT2(N,L,NR,NZ,NY,NX))*FWOOD(1) + ZSNC(M,1,L,NZ,NY,NX)=ZSNC(M,1,L,NZ,NY,NX)+CFOPN(4,M,NZ,NY,NX) + 2*(WTRT1N(N,L,NR,NZ,NY,NX)+WTRT2N(N,L,NR,NZ,NY,NX))*FWOODN(1) + PSNC(M,1,L,NZ,NY,NX)=PSNC(M,1,L,NZ,NY,NX)+CFOPP(4,M,NZ,NY,NX) + 2*(WTRT1P(N,L,NR,NZ,NY,NX)+WTRT2P(N,L,NR,NZ,NY,NX))*FWOODP(1) +6410 CONTINUE +C +C RELEASE GAS CONTENTS OF DEAD ROOTS +C + RCO2Z(NZ,NY,NX)=RCO2Z(NZ,NY,NX)-CO2A(N,L,NZ,NY,NX) + 2-CO2P(N,L,NZ,NY,NX) + ROXYZ(NZ,NY,NX)=ROXYZ(NZ,NY,NX)-OXYA(N,L,NZ,NY,NX) + 2-OXYP(N,L,NZ,NY,NX) + RCH4Z(NZ,NY,NX)=RCH4Z(NZ,NY,NX)-CH4A(N,L,NZ,NY,NX) + 2-CH4P(N,L,NZ,NY,NX) + RN2OZ(NZ,NY,NX)=RN2OZ(NZ,NY,NX)-Z2OA(N,L,NZ,NY,NX) + 2-Z2OP(N,L,NZ,NY,NX) + RNH3Z(NZ,NY,NX)=RNH3Z(NZ,NY,NX)-ZH3A(N,L,NZ,NY,NX) + 2-ZH3P(N,L,NZ,NY,NX) + RH2GZ(NZ,NY,NX)=RH2GZ(NZ,NY,NX)-H2GA(N,L,NZ,NY,NX) + 2-H2GP(N,L,NZ,NY,NX) + CO2A(N,L,NZ,NY,NX)=0.0 + OXYA(N,L,NZ,NY,NX)=0.0 + CH4A(N,L,NZ,NY,NX)=0.0 + Z2OA(N,L,NZ,NY,NX)=0.0 + ZH3A(N,L,NZ,NY,NX)=0.0 + H2GA(N,L,NZ,NY,NX)=0.0 + CO2P(N,L,NZ,NY,NX)=0.0 + OXYP(N,L,NZ,NY,NX)=0.0 + CH4P(N,L,NZ,NY,NX)=0.0 + Z2OP(N,L,NZ,NY,NX)=0.0 + ZH3P(N,L,NZ,NY,NX)=0.0 + H2GP(N,L,NZ,NY,NX)=0.0 +C +C RESET STATE VARIABLES OF DEAD ROOTS +C + DO 8870 NR=1,NRT(NZ,NY,NX) + WTRT1(N,L,NR,NZ,NY,NX)=0.0 + WTRT1N(N,L,NR,NZ,NY,NX)=0.0 + WTRT1P(N,L,NR,NZ,NY,NX)=0.0 + WTRT2(N,L,NR,NZ,NY,NX)=0.0 + WTRT2N(N,L,NR,NZ,NY,NX)=0.0 + WTRT2P(N,L,NR,NZ,NY,NX)=0.0 + RTWT1(N,NR,NZ,NY,NX)=0.0 + RTWT1N(N,NR,NZ,NY,NX)=0.0 + RTWT1P(N,NR,NZ,NY,NX)=0.0 + RTLG1(N,L,NR,NZ,NY,NX)=0.0 + RTLG2(N,L,NR,NZ,NY,NX)=0.0 + RTN2(N,L,NR,NZ,NY,NX)=0.0 +8870 CONTINUE + CPOOLR(N,L,NZ,NY,NX)=0.0 + ZPOOLR(N,L,NZ,NY,NX)=0.0 + PPOOLR(N,L,NZ,NY,NX)=0.0 + WTRTL(N,L,NZ,NY,NX)=0.0 + WTRTD(N,L,NZ,NY,NX)=0.0 + WSRTL(N,L,NZ,NY,NX)=0.0 + RTN1(N,L,NZ,NY,NX)=0.0 + RTNL(N,L,NZ,NY,NX)=0.0 + RTLGP(N,L,NZ,NY,NX)=0.0 + RTDNP(N,L,NZ,NY,NX)=0.0 + RTVLP(N,L,NZ,NY,NX)=0.0 + RTVLW(N,L,NZ,NY,NX)=0.0 + RRAD1(N,L,NZ,NY,NX)=RRAD1M(N,NZ,NY,NX) + RRAD2(N,L,NZ,NY,NX)=RRAD2M(N,NZ,NY,NX) + RTARP(N,L,NZ,NY,NX)=0.0 + RTLGA(N,L,NZ,NY,NX)=RTLGAX +C +C LITTERFALL AND STATE VARIABLES FROM DEAD NODULES +C + IF(INTYP(NZ,NY,NX).NE.0.AND.N.EQ.1)THEN + DO 6420 M=1,4 + CSNC(M,1,L,NZ,NY,NX)=CSNC(M,1,L,NZ,NY,NX)+CFOPC(4,M,NZ,NY,NX) + 2*WTNDL(L,NZ,NY,NX)+CFOPC(0,M,NZ,NY,NX)*CPOOLN(L,NZ,NY,NX) + ZSNC(M,1,L,NZ,NY,NX)=ZSNC(M,1,L,NZ,NY,NX)+CFOPN(4,M,NZ,NY,NX) + 2*WTNDLN(L,NZ,NY,NX)+CFOPN(0,M,NZ,NY,NX)*ZPOOLN(L,NZ,NY,NX) + PSNC(M,1,L,NZ,NY,NX)=PSNC(M,1,L,NZ,NY,NX)+CFOPP(4,M,NZ,NY,NX) + 2*WTNDLP(L,NZ,NY,NX)+CFOPP(0,M,NZ,NY,NX)*PPOOLN(L,NZ,NY,NX) +6420 CONTINUE + WTNDL(L,NZ,NY,NX)=0.0 + WTNDLN(L,NZ,NY,NX)=0.0 + WTNDLP(L,NZ,NY,NX)=0.0 + CPOOLN(L,NZ,NY,NX)=0.0 + ZPOOLN(L,NZ,NY,NX)=0.0 + PPOOLN(L,NZ,NY,NX)=0.0 + ENDIF +8895 CONTINUE +8900 CONTINUE +C +C RESET DEPTH VARIABLES OF DEAD ROOTS +C + DO 8795 NR=1,NRT(NZ,NY,NX) + NINR(NR,NZ,NY,NX)=NG(NZ,NY,NX) + DO 8790 N=1,MY(NZ,NY,NX) + RTDP1(N,NR,NZ,NY,NX)=SDPTH(NZ,NY,NX) + RTWT1(N,NR,NZ,NY,NX)=0.0 + RTWT1N(N,NR,NZ,NY,NX)=0.0 + RTWT1P(N,NR,NZ,NY,NX)=0.0 +8790 CONTINUE +8795 CONTINUE + NIX(NZ,NY,NX)=NG(NZ,NY,NX) + NRT(NZ,NY,NX)=0 + ENDIF +C +C LITTERFALL AND STATE VARIABLES FOR SEASONAL STORAGE +C RESERVES AT DEATH +C + IF(IDTHP(NZ,NY,NX).EQ.1.AND.IDTHR(NZ,NY,NX).EQ.1)THEN + IF(IFLGI(NZ,NY,NX).EQ.0)THEN + DO 6425 M=1,4 + DO 8825 NB=1,NBR(NZ,NY,NX) + CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) + 2+CFOPC(0,M,NZ,NY,NX)*(CPOOL(NB,NZ,NY,NX)+CPOLNB(NB,NZ,NY,NX) + 3+CPOOLK(NB,NZ,NY,NX)+WTRSVB(NB,NZ,NY,NX)) + 4+CFOPC(1,M,NZ,NY,NX)*(WTLFB(NB,NZ,NY,NX)*FWODB(1) + 5+WTNDB(NB,NZ,NY,NX)) + 6+CFOPC(2,M,NZ,NY,NX)*(WTSHEB(NB,NZ,NY,NX)*FWODB(1) + 7+WTHSKB(NB,NZ,NY,NX)+WTEARB(NB,NZ,NY,NX)) + CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX) + 2+CFOPC(5,M,NZ,NY,NX)*(WTLFB(NB,NZ,NY,NX)*FWODB(0) + 3+WTSHEB(NB,NZ,NY,NX)*FWODB(0)) + ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) + 2+CFOPN(0,M,NZ,NY,NX)*(ZPOOL(NB,NZ,NY,NX)+ZPOLNB(NB,NZ,NY,NX) + 3+WTRSBN(NB,NZ,NY,NX)) + 4+CFOPN(1,M,NZ,NY,NX)*(WTLFBN(NB,NZ,NY,NX)*FWODLN(1) + 5+WTNDBN(NB,NZ,NY,NX)) + 6+CFOPN(2,M,NZ,NY,NX)*(WTSHBN(NB,NZ,NY,NX)*FWODSN(1) + 7+WTHSBN(NB,NZ,NY,NX)+WTEABN(NB,NZ,NY,NX)) + ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX) + 2+CFOPN(5,M,NZ,NY,NX)*(WTLFBN(NB,NZ,NY,NX)*FWODLN(0) + 3+WTSHBN(NB,NZ,NY,NX)*FWODSN(0)) + PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) + 2+CFOPP(0,M,NZ,NY,NX)*(PPOOL(NB,NZ,NY,NX)+PPOLNB(NB,NZ,NY,NX) + 3+WTRSBP(NB,NZ,NY,NX)) + 4+CFOPP(1,M,NZ,NY,NX)*(WTLFBP(NB,NZ,NY,NX)*FWODLP(1) + 5+WTNDBP(NB,NZ,NY,NX)) + 6+CFOPP(2,M,NZ,NY,NX)*(WTSHBP(NB,NZ,NY,NX)*FWODSP(1) + 7+WTHSBP(NB,NZ,NY,NX)+WTEABP(NB,NZ,NY,NX)) + PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX) + 2+CFOPP(5,M,NZ,NY,NX)*(WTLFBP(NB,NZ,NY,NX)*FWODLP(0) + 3+WTSHBP(NB,NZ,NY,NX)*FWODSP(0)) + IF(ISTYP(NZ,NY,NX).EQ.0.AND.IWTYP(NZ,NY,NX).NE.0)THEN + WTRVC(NZ,NY,NX)=WTRVC(NZ,NY,NX) + 2+CFOPC(2,M,NZ,NY,NX)*WTGRB(NB,NZ,NY,NX) + WTRVN(NZ,NY,NX)=WTRVN(NZ,NY,NX) + 2+CFOPN(2,M,NZ,NY,NX)*WTGRBN(NB,NZ,NY,NX) + WTRVP(NZ,NY,NX)=WTRVP(NZ,NY,NX) + 2+CFOPP(2,M,NZ,NY,NX)*WTGRBP(NB,NZ,NY,NX) + ELSE + CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) + 2+CFOPC(2,M,NZ,NY,NX)*WTGRB(NB,NZ,NY,NX) + ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) + 2+CFOPN(2,M,NZ,NY,NX)*WTGRBN(NB,NZ,NY,NX) + PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) + 2+CFOPP(2,M,NZ,NY,NX)*WTGRBP(NB,NZ,NY,NX) + ENDIF + IF(IBTYP(NZ,NY,NX).EQ.0.OR.IGTYP(NZ,NY,NX).LE.1)THEN + CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) + 5+CFOPC(3,M,NZ,NY,NX)*WTSTKB(NB,NZ,NY,NX) + ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) + 5+CFOPN(3,M,NZ,NY,NX)*WTSTBN(NB,NZ,NY,NX) + PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) + 5+CFOPP(3,M,NZ,NY,NX)*WTSTBP(NB,NZ,NY,NX) + ELSE + WTSTDG(M,NZ,NY,NX)=WTSTDG(M,NZ,NY,NX) + 5+CFOPC(5,M,NZ,NY,NX)*WTSTKB(NB,NZ,NY,NX) + WTSTDN(M,NZ,NY,NX)=WTSTDN(M,NZ,NY,NX) + 5+CFOPN(5,M,NZ,NY,NX)*WTSTBN(NB,NZ,NY,NX) + WTSTDP(M,NZ,NY,NX)=WTSTDP(M,NZ,NY,NX) + 5+CFOPP(5,M,NZ,NY,NX)*WTSTBP(NB,NZ,NY,NX) + ENDIF +8825 CONTINUE + DO 6415 L=NU(NY,NX),NJ(NY,NX) + DO 6415 N=1,MY(NZ,NY,NX) + CSNC(M,1,L,NZ,NY,NX)=CSNC(M,1,L,NZ,NY,NX)+CFOPC(0,M,NZ,NY,NX) + 2*CPOOLR(N,L,NZ,NY,NX) + ZSNC(M,1,L,NZ,NY,NX)=ZSNC(M,1,L,NZ,NY,NX)+CFOPN(0,M,NZ,NY,NX) + 2*ZPOOLR(N,L,NZ,NY,NX) + PSNC(M,1,L,NZ,NY,NX)=PSNC(M,1,L,NZ,NY,NX)+CFOPP(0,M,NZ,NY,NX) + 2*PPOOLR(N,L,NZ,NY,NX) + DO 6415 NR=1,NRT(NZ,NY,NX) + CSNC(M,0,L,NZ,NY,NX)=CSNC(M,0,L,NZ,NY,NX)+CFOPC(5,M,NZ,NY,NX) + 2*(WTRT1(N,L,NR,NZ,NY,NX)+WTRT2(N,L,NR,NZ,NY,NX))*FWOOD(0) + ZSNC(M,0,L,NZ,NY,NX)=ZSNC(M,0,L,NZ,NY,NX)+CFOPN(5,M,NZ,NY,NX) + 2*(WTRT1N(N,L,NR,NZ,NY,NX)+WTRT2N(N,L,NR,NZ,NY,NX))*FWOODN(0) + PSNC(M,0,L,NZ,NY,NX)=PSNC(M,0,L,NZ,NY,NX)+CFOPP(5,M,NZ,NY,NX) + 2*(WTRT1P(N,L,NR,NZ,NY,NX)+WTRT2P(N,L,NR,NZ,NY,NX))*FWOODP(0) + CSNC(M,1,L,NZ,NY,NX)=CSNC(M,1,L,NZ,NY,NX)+CFOPC(4,M,NZ,NY,NX) + 2*(WTRT1(N,L,NR,NZ,NY,NX)+WTRT2(N,L,NR,NZ,NY,NX))*FWOOD(1) + ZSNC(M,1,L,NZ,NY,NX)=ZSNC(M,1,L,NZ,NY,NX)+CFOPN(4,M,NZ,NY,NX) + 2*(WTRT1N(N,L,NR,NZ,NY,NX)+WTRT2N(N,L,NR,NZ,NY,NX))*FWOODN(1) + PSNC(M,1,L,NZ,NY,NX)=PSNC(M,1,L,NZ,NY,NX)+CFOPP(4,M,NZ,NY,NX) + 2*(WTRT1P(N,L,NR,NZ,NY,NX)+WTRT2P(N,L,NR,NZ,NY,NX))*FWOODP(1) +6415 CONTINUE + CSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX)=CSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX) + 2+CFOPC(0,M,NZ,NY,NX)*WTRVC(NZ,NY,NX)*FWOOD(0) + ZSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX)=ZSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX) + 2+CFOPN(0,M,NZ,NY,NX)*WTRVN(NZ,NY,NX)*FWOODN(0) + PSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX)=PSNC(M,0,NG(NZ,NY,NX),NZ,NY,NX) + 2+CFOPP(0,M,NZ,NY,NX)*WTRVP(NZ,NY,NX)*FWOODP(0) + CSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX)=CSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX) + 2+CFOPC(0,M,NZ,NY,NX)*WTRVC(NZ,NY,NX)*FWOOD(1) + ZSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX)=ZSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX) + 2+CFOPN(0,M,NZ,NY,NX)*WTRVN(NZ,NY,NX)*FWOODN(1) + PSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX)=PSNC(M,1,NG(NZ,NY,NX),NZ,NY,NX) + 2+CFOPP(0,M,NZ,NY,NX)*WTRVP(NZ,NY,NX)*FWOODP(1) +6425 CONTINUE + DO 8835 NB=1,NBR(NZ,NY,NX) + CPOOL(NB,NZ,NY,NX)=0.0 + CPOOLK(NB,NZ,NY,NX)=0.0 + ZPOOL(NB,NZ,NY,NX)=0.0 + PPOOL(NB,NZ,NY,NX)=0.0 + CPOLNB(NB,NZ,NY,NX)=0.0 + ZPOLNB(NB,NZ,NY,NX)=0.0 + PPOLNB(NB,NZ,NY,NX)=0.0 + WTSHTB(NB,NZ,NY,NX)=0.0 + WTLFB(NB,NZ,NY,NX)=0.0 + WTNDB(NB,NZ,NY,NX)=0.0 + WTSHEB(NB,NZ,NY,NX)=0.0 + WTSTKB(NB,NZ,NY,NX)=0.0 + WVSTKB(NB,NZ,NY,NX)=0.0 + WTRSVB(NB,NZ,NY,NX)=0.0 + WTHSKB(NB,NZ,NY,NX)=0.0 + WTEARB(NB,NZ,NY,NX)=0.0 + WTGRB(NB,NZ,NY,NX)=0.0 + WTLSB(NB,NZ,NY,NX)=0.0 + WTSHTN(NB,NZ,NY,NX)=0.0 + WTLFBN(NB,NZ,NY,NX)=0.0 + WTNDBN(NB,NZ,NY,NX)=0.0 + WTSHBN(NB,NZ,NY,NX)=0.0 + WTSTBN(NB,NZ,NY,NX)=0.0 + WTRSBN(NB,NZ,NY,NX)=0.0 + WTHSBN(NB,NZ,NY,NX)=0.0 + WTEABN(NB,NZ,NY,NX)=0.0 + WTGRBN(NB,NZ,NY,NX)=0.0 + WTSHTP(NB,NZ,NY,NX)=0.0 + WTLFBP(NB,NZ,NY,NX)=0.0 + WTNDBP(NB,NZ,NY,NX)=0.0 + WTSHBP(NB,NZ,NY,NX)=0.0 + WTSTBP(NB,NZ,NY,NX)=0.0 + WTRSBP(NB,NZ,NY,NX)=0.0 + WTHSBP(NB,NZ,NY,NX)=0.0 + WTEABP(NB,NZ,NY,NX)=0.0 + WTGRBP(NB,NZ,NY,NX)=0.0 + WTSTXB(NB,NZ,NY,NX)=0.0 + WTSTXN(NB,NZ,NY,NX)=0.0 + WTSTXP(NB,NZ,NY,NX)=0.0 +8835 CONTINUE + DO 6416 L=NU(NY,NX),NJ(NY,NX) + DO 6416 N=1,MY(NZ,NY,NX) + CPOOLR(N,L,NZ,NY,NX)=0.0 + ZPOOLR(N,L,NZ,NY,NX)=0.0 + PPOOLR(N,L,NZ,NY,NX)=0.0 + DO 6416 NR=1,NRT(NZ,NY,NX) + WTRT1(N,L,NR,NZ,NY,NX)=0.0 + WTRT1N(N,L,NR,NZ,NY,NX)=0.0 + WTRT1P(N,L,NR,NZ,NY,NX)=0.0 + WTRT2(N,L,NR,NZ,NY,NX)=0.0 + WTRT2N(N,L,NR,NZ,NY,NX)=0.0 + WTRT2P(N,L,NR,NZ,NY,NX)=0.0 + RTWT1(N,NR,NZ,NY,NX)=0.0 + RTWT1N(N,NR,NZ,NY,NX)=0.0 + RTWT1P(N,NR,NZ,NY,NX)=0.0 + RTLG1(N,L,NR,NZ,NY,NX)=0.0 + RTLG2(N,L,NR,NZ,NY,NX)=0.0 + RTN2(N,L,NR,NZ,NY,NX)=0.0 +6416 CONTINUE + WTRVC(NZ,NY,NX)=0.0 + WTRVN(NZ,NY,NX)=0.0 + WTRVP(NZ,NY,NX)=0.0 + IDTH(NZ,NY,NX)=1 + ENDIF +C +C RESEED DEAD PERENNIALS +C + IF(ISTYP(NZ,NY,NX).NE.0.AND.JHVST(NZ,I,NY,NX).EQ.0)THEN + IF(I.LT.LYRC)THEN + IDAY0(NZ,NY,NX)=I+1 + IYR0(NZ,NY,NX)=IDATA(3) + ELSE + IDAY0(NZ,NY,NX)=1 + IYR0(NZ,NY,NX)=IDATA(3)+1 + ENDIF + ENDIF + ENDIF + ENDIF +C +C CHECK PLANT C,N,P BALANCES +C + CPOOLP(NZ,NY,NX)=0.0 + ZPOOLP(NZ,NY,NX)=0.0 + PPOOLP(NZ,NY,NX)=0.0 + WTSHT(NZ,NY,NX)=0.0 + WTSHN(NZ,NY,NX)=0.0 + WTSHP(NZ,NY,NX)=0.0 + WTLF(NZ,NY,NX)=0.0 + WTSHE(NZ,NY,NX)=0.0 + WTSTK(NZ,NY,NX)=0.0 + WVSTK(NZ,NY,NX)=0.0 + WTRSV(NZ,NY,NX)=0.0 + WTHSK(NZ,NY,NX)=0.0 + WTEAR(NZ,NY,NX)=0.0 + WTGR(NZ,NY,NX)=0.0 + WTLS(NZ,NY,NX)=0.0 + WTRT(NZ,NY,NX)=0.0 + WTRTS(NZ,NY,NX)=0.0 + WTRTN(NZ,NY,NX)=0.0 + WTRTP(NZ,NY,NX)=0.0 + WTLFN(NZ,NY,NX)=0.0 + WTSHEN(NZ,NY,NX)=0.0 + WTSTKN(NZ,NY,NX)=0.0 + WTRSVN(NZ,NY,NX)=0.0 + WTHSKN(NZ,NY,NX)=0.0 + WTEARN(NZ,NY,NX)=0.0 + WTGRNN(NZ,NY,NX)=0.0 + WTLFP(NZ,NY,NX)=0.0 + WTSHEP(NZ,NY,NX)=0.0 + WTSTKP(NZ,NY,NX)=0.0 + WTRSVP(NZ,NY,NX)=0.0 + WTHSKP(NZ,NY,NX)=0.0 + WTEARP(NZ,NY,NX)=0.0 + WTGRNP(NZ,NY,NX)=0.0 + GRNO(NZ,NY,NX)=0.0 + ARLFP(NZ,NY,NX)=0.0 + ARSTP(NZ,NY,NX)=0.0 + DO 8940 L=1,JC + ARSTV(L,NZ,NY,NX)=0.0 +8940 CONTINUE +C +C ACCUMULATE PLANT STATE VARIABLES FROM BRANCH STATE VARIABLES +C + DO 8950 NB=1,NBR(NZ,NY,NX) + CPOOLP(NZ,NY,NX)=CPOOLP(NZ,NY,NX)+CPOOL(NB,NZ,NY,NX) + ZPOOLP(NZ,NY,NX)=ZPOOLP(NZ,NY,NX)+ZPOOL(NB,NZ,NY,NX) + PPOOLP(NZ,NY,NX)=PPOOLP(NZ,NY,NX)+PPOOL(NB,NZ,NY,NX) + WTSHT(NZ,NY,NX)=WTSHT(NZ,NY,NX)+WTSHTB(NB,NZ,NY,NX) + WTLF(NZ,NY,NX)=WTLF(NZ,NY,NX)+WTLFB(NB,NZ,NY,NX) + WTSHE(NZ,NY,NX)=WTSHE(NZ,NY,NX)+WTSHEB(NB,NZ,NY,NX) + WTSTK(NZ,NY,NX)=WTSTK(NZ,NY,NX)+WTSTKB(NB,NZ,NY,NX) + WVSTK(NZ,NY,NX)=WVSTK(NZ,NY,NX)+WVSTKB(NB,NZ,NY,NX) + WTRSV(NZ,NY,NX)=WTRSV(NZ,NY,NX)+WTRSVB(NB,NZ,NY,NX) + WTHSK(NZ,NY,NX)=WTHSK(NZ,NY,NX)+WTHSKB(NB,NZ,NY,NX) + WTEAR(NZ,NY,NX)=WTEAR(NZ,NY,NX)+WTEARB(NB,NZ,NY,NX) + WTGR(NZ,NY,NX)=WTGR(NZ,NY,NX)+WTGRB(NB,NZ,NY,NX) + WTLS(NZ,NY,NX)=WTLS(NZ,NY,NX)+WTLSB(NB,NZ,NY,NX) + WTSHN(NZ,NY,NX)=WTSHN(NZ,NY,NX)+WTSHTN(NB,NZ,NY,NX) + WTLFN(NZ,NY,NX)=WTLFN(NZ,NY,NX)+WTLFBN(NB,NZ,NY,NX) + WTSHEN(NZ,NY,NX)=WTSHEN(NZ,NY,NX)+WTSHBN(NB,NZ,NY,NX) + WTSTKN(NZ,NY,NX)=WTSTKN(NZ,NY,NX)+WTSTBN(NB,NZ,NY,NX) + WTRSVN(NZ,NY,NX)=WTRSVN(NZ,NY,NX)+WTRSBN(NB,NZ,NY,NX) + WTHSKN(NZ,NY,NX)=WTHSKN(NZ,NY,NX)+WTHSBN(NB,NZ,NY,NX) + WTEARN(NZ,NY,NX)=WTEARN(NZ,NY,NX)+WTEABN(NB,NZ,NY,NX) + WTGRNN(NZ,NY,NX)=WTGRNN(NZ,NY,NX)+WTGRBN(NB,NZ,NY,NX) + WTSHP(NZ,NY,NX)=WTSHP(NZ,NY,NX)+WTSHTP(NB,NZ,NY,NX) + WTLFP(NZ,NY,NX)=WTLFP(NZ,NY,NX)+WTLFBP(NB,NZ,NY,NX) + WTSHEP(NZ,NY,NX)=WTSHEP(NZ,NY,NX)+WTSHBP(NB,NZ,NY,NX) + WTSTKP(NZ,NY,NX)=WTSTKP(NZ,NY,NX)+WTSTBP(NB,NZ,NY,NX) + WTRSVP(NZ,NY,NX)=WTRSVP(NZ,NY,NX)+WTRSBP(NB,NZ,NY,NX) + WTHSKP(NZ,NY,NX)=WTHSKP(NZ,NY,NX)+WTHSBP(NB,NZ,NY,NX) + WTEARP(NZ,NY,NX)=WTEARP(NZ,NY,NX)+WTEABP(NB,NZ,NY,NX) + WTGRNP(NZ,NY,NX)=WTGRNP(NZ,NY,NX)+WTGRBP(NB,NZ,NY,NX) + ARLFP(NZ,NY,NX)=ARLFP(NZ,NY,NX)+ARLFB(NB,NZ,NY,NX) + GRNO(NZ,NY,NX)=GRNO(NZ,NY,NX)+GRNOB(NB,NZ,NY,NX) + DO 8945 L=1,JC + ARSTP(NZ,NY,NX)=ARSTP(NZ,NY,NX)+ARSTK(L,NB,NZ,NY,NX) + ARSTV(L,NZ,NY,NX)=ARSTV(L,NZ,NY,NX)+ARSTK(L,NB,NZ,NY,NX) +8945 CONTINUE +8950 CONTINUE +C +C ACCUMULATE ROOT STATE VARIABLES FROM ROOT LAYER STATE VARIABLES +C +C IF(WTLS(NZ,NY,NX).LE.0.0)ARLFP(NZ,NY,NX)=0.0 + DO 8925 N=1,MY(NZ,NY,NX) + DO 8930 L=NU(NY,NX),NJ(NY,NX) + WTRT(NZ,NY,NX)=WTRT(NZ,NY,NX)+CPOOLR(N,L,NZ,NY,NX) + WTRTN(NZ,NY,NX)=WTRTN(NZ,NY,NX)+ZPOOLR(N,L,NZ,NY,NX) + WTRTP(NZ,NY,NX)=WTRTP(NZ,NY,NX)+PPOOLR(N,L,NZ,NY,NX) + DO 8935 NR=1,NRT(NZ,NY,NX) + WTRT(NZ,NY,NX)=WTRT(NZ,NY,NX)+WTRT1(N,L,NR,NZ,NY,NX) + 2+WTRT2(N,L,NR,NZ,NY,NX) + WTRTS(NZ,NY,NX)=WTRTS(NZ,NY,NX)+WTRT1(N,L,NR,NZ,NY,NX) + 2+WTRT2(N,L,NR,NZ,NY,NX) + WTRTN(NZ,NY,NX)=WTRTN(NZ,NY,NX)+WTRT1N(N,L,NR,NZ,NY,NX) + 2+WTRT2N(N,L,NR,NZ,NY,NX) + WTRTP(NZ,NY,NX)=WTRTP(NZ,NY,NX)+WTRT1P(N,L,NR,NZ,NY,NX) + 2+WTRT2P(N,L,NR,NZ,NY,NX) +8935 CONTINUE +8930 CONTINUE +8925 CONTINUE +C +C ACCUMULATE NODULE STATE VATIABLES FROM NODULE LAYER VARIABLES +C + IF(INTYP(NZ,NY,NX).NE.0)THEN + WTND(NZ,NY,NX)=0.0 + WTNDN(NZ,NY,NX)=0.0 + WTNDP(NZ,NY,NX)=0.0 + IF(INTYP(NZ,NY,NX).GE.3)THEN + DO 7950 NB=1,NBR(NZ,NY,NX) + CPOLNP(NZ,NY,NX)=CPOLNP(NZ,NY,NX)+CPOLNB(NB,NZ,NY,NX) + ZPOLNP(NZ,NY,NX)=ZPOLNP(NZ,NY,NX)+ZPOLNB(NB,NZ,NY,NX) + PPOLNP(NZ,NY,NX)=PPOLNP(NZ,NY,NX)+PPOLNB(NB,NZ,NY,NX) + WTND(NZ,NY,NX)=WTND(NZ,NY,NX)+WTNDB(NB,NZ,NY,NX) + 2+CPOLNB(NB,NZ,NY,NX) + WTNDN(NZ,NY,NX)=WTNDN(NZ,NY,NX)+WTNDBN(NB,NZ,NY,NX) + 2+ZPOLNB(NB,NZ,NY,NX) + WTNDP(NZ,NY,NX)=WTNDP(NZ,NY,NX)+WTNDBP(NB,NZ,NY,NX) + 2+PPOLNB(NB,NZ,NY,NX) +7950 CONTINUE + ELSEIF(INTYP(NZ,NY,NX).EQ.1.OR.INTYP(NZ,NY,NX).EQ.2)THEN + DO 8920 L=NU(NY,NX),NI(NZ,NY,NX) + WTND(NZ,NY,NX)=WTND(NZ,NY,NX)+WTNDL(L,NZ,NY,NX) + 2+CPOOLN(L,NZ,NY,NX) + WTNDN(NZ,NY,NX)=WTNDN(NZ,NY,NX)+WTNDLN(L,NZ,NY,NX) + 2+ZPOOLN(L,NZ,NY,NX) + WTNDP(NZ,NY,NX)=WTNDP(NZ,NY,NX)+WTNDLP(L,NZ,NY,NX) + 2+PPOOLN(L,NZ,NY,NX) +8920 CONTINUE + ENDIF + ENDIF +C +C ACCUMULATE TOTAL SOIL-PLANT C,N,P EXCHANGE +C + HCUPTK(NZ,NY,NX)=UPOMC(NZ,NY,NX) + HZUPTK(NZ,NY,NX)=UPOMN(NZ,NY,NX)+UPNH4(NZ,NY,NX)+UPNO3(NZ,NY,NX) + 2+UPNF(NZ,NY,NX) + HPUPTK(NZ,NY,NX)=UPOMP(NZ,NY,NX)+UPH2P(NZ,NY,NX)+UPH1P(NZ,NY,NX) + TCUPTK(NZ,NY,NX)=TCUPTK(NZ,NY,NX)+UPOMC(NZ,NY,NX) + TZUPTK(NZ,NY,NX)=TZUPTK(NZ,NY,NX)+UPOMN(NZ,NY,NX)+UPNH4(NZ,NY,NX) + 2+UPNO3(NZ,NY,NX) + TPUPTK(NZ,NY,NX)=TPUPTK(NZ,NY,NX)+UPOMP(NZ,NY,NX)+UPH2P(NZ,NY,NX) + 2+UPH1P(NZ,NY,NX) + TZUPFX(NZ,NY,NX)=TZUPFX(NZ,NY,NX)+UPNF(NZ,NY,NX)+UPNFC(NZ,NY,NX) + ENDIF +C +C HARVEST STANDING DEAD +C + IF(IHVST(NZ,I,NY,NX).GE.0)THEN + IF(J.EQ.INT(ZNOON(NY,NX)).AND.IHVST(NZ,I,NY,NX).NE.4 + 2.AND.IHVST(NZ,I,NY,NX).NE.6)THEN + IF(THIN(NZ,I,NY,NX).EQ.0.0)THEN + FHVST=AMAX1(0.0,1.0-EHVST(1,4,NZ,I,NY,NX)) + FHVSH=FHVST + ELSE + FHVST=AMAX1(0.0,1.0-THIN(NZ,I,NY,NX)) + IF(IHVST(NZ,I,NY,NX).EQ.0)THEN + FHVSH=AMAX1(0.0,1.0-EHVST(1,4,NZ,I,NY,NX)*THIN(NZ,I,NY,NX)) + ELSE + FHVSH=FHVST + ENDIF + ENDIF + ELSEIF(IHVST(NZ,I,NY,NX).EQ.4.OR.IHVST(NZ,I,NY,NX).EQ.6)THEN + IF(WTSTG(NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + WHVSTD=HVST(NZ,I,NY,NX)*THIN(NZ,I,NY,NX)*0.45/24.0 + 2*AREA(3,NU(NY,NX),NY,NX)*EHVST(1,4,NZ,I,NY,NX) + FHVST=AMAX1(0.0,1.0-WHVSTD/WTSTG(NZ,NY,NX)) + FHVSH=FHVST + ELSE + FHVST=1.0 + FHVSH=1.0 + ENDIF + ELSE + FHVST=1.0 + FHVSH=1.0 + ENDIF + DO 6475 M=1,4 + WTHTH4=WTHTH4+(1.0-FHVSH)*WTSTDG(M,NZ,NY,NX) + WTHNH4=WTHNH4+(1.0-FHVSH)*WTSTDN(M,NZ,NY,NX) + WTHPH4=WTHPH4+(1.0-FHVSH)*WTSTDP(M,NZ,NY,NX) + WTHTX4=WTHTX4+(FHVSH-FHVST)*WTSTDG(M,NZ,NY,NX) + WTHNX4=WTHNX4+(FHVSH-FHVST)*WTSTDN(M,NZ,NY,NX) + WTHPX4=WTHPX4+(FHVSH-FHVST)*WTSTDP(M,NZ,NY,NX) + WTSTDG(M,NZ,NY,NX)=FHVST*WTSTDG(M,NZ,NY,NX) + WTSTDN(M,NZ,NY,NX)=FHVST*WTSTDN(M,NZ,NY,NX) + WTSTDP(M,NZ,NY,NX)=FHVST*WTSTDP(M,NZ,NY,NX) +6475 CONTINUE +C +C IF NO PLANT C,N,P REMOVED AT HARVEST (ALL RESIDUE RETURNED) +C + IF(IHVST(NZ,I,NY,NX).EQ.0)THEN + WTHTR0=WTHTH0*(1.0-EHVST(2,1,NZ,I,NY,NX)) + WTHNR0=WTHNH0*(1.0-EHVST(2,1,NZ,I,NY,NX)) + WTHPR0=WTHPH0*(1.0-EHVST(2,1,NZ,I,NY,NX)) + WTHTR1=WTHTH1*(1.0-EHVST(2,1,NZ,I,NY,NX)) + WTHNR1=WTHNH1*(1.0-EHVST(2,1,NZ,I,NY,NX)) + WTHPR1=WTHPH1*(1.0-EHVST(2,1,NZ,I,NY,NX)) + WTHTR2=WTHTH2*(1.0-EHVST(2,2,NZ,I,NY,NX)) + WTHNR2=WTHNH2*(1.0-EHVST(2,2,NZ,I,NY,NX)) + WTHPR2=WTHPH2*(1.0-EHVST(2,2,NZ,I,NY,NX)) + WTHTR3=WTHTH3*(1.0-EHVST(2,3,NZ,I,NY,NX)) + WTHNR3=WTHNH3*(1.0-EHVST(2,3,NZ,I,NY,NX)) + WTHPR3=WTHPH3*(1.0-EHVST(2,3,NZ,I,NY,NX)) + WTHTR4=WTHTH4*(1.0-EHVST(2,4,NZ,I,NY,NX)) + WTHNR4=WTHNH4*(1.0-EHVST(2,4,NZ,I,NY,NX)) + WTHPR4=WTHPH4*(1.0-EHVST(2,4,NZ,I,NY,NX)) +C +C IF ONLY GRAIN C,N,P REMOVED AT HARVEST +C + ELSEIF(IHVST(NZ,I,NY,NX).EQ.1)THEN + WTHTR0=WTHTH0 + WTHNR0=WTHNH0 + WTHPR0=WTHPH0 + WTHTR1=WTHTH1 + WTHNR1=WTHNH1 + WTHPR1=WTHPH1 + WTHTR2=WTHTH2-WTHTG*EHVST(2,2,NZ,I,NY,NX) + WTHNR2=WTHNH2-WTHNG*EHVST(2,2,NZ,I,NY,NX) + WTHPR2=WTHPH2-WTHPG*EHVST(2,2,NZ,I,NY,NX) + WTHTR3=WTHTH3 + WTHNR3=WTHNH3 + WTHPR3=WTHPH3 + WTHTR4=WTHTH4 + WTHNR4=WTHNH4 + WTHPR4=WTHPH4 +C +C IF ONLY WOOD C,N,P REMOVED AT HARVEST +C + ELSEIF(IHVST(NZ,I,NY,NX).EQ.2)THEN + WTHTR0=WTHTH0*(1.0-EHVST(2,1,NZ,I,NY,NX)) + WTHNR0=WTHNH0*(1.0-EHVST(2,1,NZ,I,NY,NX)) + WTHPR0=WTHPH0*(1.0-EHVST(2,1,NZ,I,NY,NX)) + WTHTR1=WTHTH1*(1.0-EHVST(2,1,NZ,I,NY,NX)) + WTHNR1=WTHNH1*(1.0-EHVST(2,1,NZ,I,NY,NX)) + WTHPR1=WTHPH1*(1.0-EHVST(2,1,NZ,I,NY,NX)) + WTHTR2=WTHTH2*(1.0-EHVST(2,2,NZ,I,NY,NX)) + WTHNR2=WTHNH2*(1.0-EHVST(2,2,NZ,I,NY,NX)) + WTHPR2=WTHPH2*(1.0-EHVST(2,2,NZ,I,NY,NX)) + WTHTR3=WTHTH3*(1.0-EHVST(2,3,NZ,I,NY,NX)) + WTHNR3=WTHNH3*(1.0-EHVST(2,3,NZ,I,NY,NX)) + WTHPR3=WTHPH3*(1.0-EHVST(2,3,NZ,I,NY,NX)) + WTHTR4=WTHTH4*(1.0-EHVST(2,4,NZ,I,NY,NX)) + WTHNR4=WTHNH4*(1.0-EHVST(2,4,NZ,I,NY,NX)) + WTHPR4=WTHPH4*(1.0-EHVST(2,4,NZ,I,NY,NX)) +C +C IF ALL PLANT C,N,P REMOVED AT HARVEST (NO RESIDUE RETURNED) +C + ELSEIF(IHVST(NZ,I,NY,NX).EQ.3)THEN + WTHTR0=WTHTH0*(1.0-EHVST(2,1,NZ,I,NY,NX)) + WTHNR0=WTHNH0*(1.0-EHVST(2,1,NZ,I,NY,NX)) + WTHPR0=WTHPH0*(1.0-EHVST(2,1,NZ,I,NY,NX)) + WTHTR1=WTHTH1*(1.0-EHVST(2,1,NZ,I,NY,NX)) + WTHNR1=WTHNH1*(1.0-EHVST(2,1,NZ,I,NY,NX)) + WTHPR1=WTHPH1*(1.0-EHVST(2,1,NZ,I,NY,NX)) + WTHTR2=WTHTH2*(1.0-EHVST(2,2,NZ,I,NY,NX)) + WTHNR2=WTHNH2*(1.0-EHVST(2,2,NZ,I,NY,NX)) + WTHPR2=WTHPH2*(1.0-EHVST(2,2,NZ,I,NY,NX)) + WTHTR3=WTHTH3*(1.0-EHVST(2,3,NZ,I,NY,NX)) + WTHNR3=WTHNH3*(1.0-EHVST(2,3,NZ,I,NY,NX)) + WTHPR3=WTHPH3*(1.0-EHVST(2,3,NZ,I,NY,NX)) + WTHTR4=WTHTH4*(1.0-EHVST(2,4,NZ,I,NY,NX)) + WTHNR4=WTHNH4*(1.0-EHVST(2,4,NZ,I,NY,NX)) + WTHPR4=WTHPH4*(1.0-EHVST(2,4,NZ,I,NY,NX)) +C +C IF PLANT C,N,P REMOVED BY GRAZING +C + ELSEIF(IHVST(NZ,I,NY,NX).EQ.4.OR.IHVST(NZ,I,NY,NX).EQ.6)THEN + WTHTR0=WTHTH0*(1.0-EHVST(2,1,NZ,I,NY,NX)) + WTHNR0=WTHNH0*(1.0-EHVST(2,1,NZ,I,NY,NX)*0.5) + WTHPR0=WTHPH0*(1.0-EHVST(2,1,NZ,I,NY,NX)*0.5) + WTHTR1=WTHTH1*(1.0-EHVST(2,1,NZ,I,NY,NX)) + WTHNR1=WTHNH1*(1.0-EHVST(2,1,NZ,I,NY,NX)*0.5) + WTHPR1=WTHPH1*(1.0-EHVST(2,1,NZ,I,NY,NX)*0.5) + WTHTR2=WTHTH2*(1.0-EHVST(2,2,NZ,I,NY,NX)) + WTHNR2=WTHNH2*(1.0-EHVST(2,2,NZ,I,NY,NX)*0.5) + WTHPR2=WTHPH2*(1.0-EHVST(2,2,NZ,I,NY,NX)*0.5) + WTHTR3=WTHTH3*(1.0-EHVST(2,3,NZ,I,NY,NX)) + WTHNR3=WTHNH3*(1.0-EHVST(2,3,NZ,I,NY,NX)*0.5) + WTHPR3=WTHPH3*(1.0-EHVST(2,3,NZ,I,NY,NX)*0.5) + WTHTR4=WTHTH4*(1.0-EHVST(2,4,NZ,I,NY,NX)) + WTHNR4=WTHNH4*(1.0-EHVST(2,4,NZ,I,NY,NX)*0.5) + WTHPR4=WTHPH4*(1.0-EHVST(2,4,NZ,I,NY,NX)*0.5) +C +C ADD MANURE FROM GRAZING NEXT DAY +C + FERT(17,I+1,NY,NX)=FERT(17,I+1,NY,NX) + 2+(WTHTR1+WTHTR2+WTHTR3+WTHTR4)/AREA(3,NU(NY,NX),NY,NX) + FERT(18,I+1,NY,NX)=FERT(18,I+1,NY,NX) + 2+(WTHNR1+WTHNR2+WTHNR3+WTHNR4)/AREA(3,NU(NY,NX),NY,NX)*0.5 + FERT(3,I+1,NY,NX)=FERT(3,I+1,NY,NX) + 2+(WTHNR1+WTHNR2+WTHNR3+WTHNR4)/AREA(3,NU(NY,NX),NY,NX)*0.5 + FERT(19,I+1,NY,NX)=FERT(19,I+1,NY,NX) + 2+(WTHPR1+WTHPR2+WTHPR3+WTHPR4)/AREA(3,NU(NY,NX),NY,NX) + IYTYP(2,I+1,NY,NX)=3 +C IF(NX.EQ.2)THEN +C WRITE(*,6542)'MANURE',I,J,NX,NY,NZ,FERT(2,I+1,NY,NX) +C 2,WTHNR1,WTHNR2,WTHNR3,WTHNR4,WTHNH1,WTHNH2,WTHNH3 +C 3,WTHNH4 +6542 FORMAT(A8,5I4,20E12.4) +C ENDIF +C +C FIRE +C + ELSEIF(IHVST(NZ,I,NY,NX).EQ.5)THEN + WTHTR0=WTHTH0*(1.0-EHVST(2,1,NZ,I,NY,NX)) + WTHNR0=WTHNH0*(1.0-EFIRE(1,IHVST(NZ,I,NY,NX)) + 2*EHVST(2,1,NZ,I,NY,NX)) + WTHPR0=WTHPH0*(1.0-EFIRE(2,IHVST(NZ,I,NY,NX)) + 2*EHVST(2,1,NZ,I,NY,NX)) + WTHNL0=WTHNH0*(1.0-EHVST(2,1,NZ,I,NY,NX)) + WTHPL0=WTHPH0*(1.0-EHVST(2,1,NZ,I,NY,NX)) + WTHTR1=WTHTH1*(1.0-EHVST(2,1,NZ,I,NY,NX)) + WTHNR1=WTHNH1*(1.0-EFIRE(1,IHVST(NZ,I,NY,NX)) + 2*EHVST(2,1,NZ,I,NY,NX)) + WTHPR1=WTHPH1*(1.0-EFIRE(2,IHVST(NZ,I,NY,NX)) + 2*EHVST(2,1,NZ,I,NY,NX)) + WTHNL1=WTHNH1*(1.0-EHVST(2,1,NZ,I,NY,NX)) + WTHPL1=WTHPH1*(1.0-EHVST(2,1,NZ,I,NY,NX)) + WTHTR2=WTHTH2*(1.0-EHVST(2,2,NZ,I,NY,NX)) + WTHNR2=WTHNH2*(1.0-EFIRE(1,IHVST(NZ,I,NY,NX)) + 2*EHVST(2,2,NZ,I,NY,NX)) + WTHPR2=WTHPH2*(1.0-EFIRE(2,IHVST(NZ,I,NY,NX)) + 2*EHVST(2,2,NZ,I,NY,NX)) + WTHNL2=WTHNH2*(1.0-EHVST(2,2,NZ,I,NY,NX)) + WTHPL2=WTHPH2*(1.0-EHVST(2,2,NZ,I,NY,NX)) + WTHTR3=WTHTH3*(1.0-EHVST(2,3,NZ,I,NY,NX)) + WTHNR3=WTHNH3*(1.0-EFIRE(1,IHVST(NZ,I,NY,NX)) + 2*EHVST(2,3,NZ,I,NY,NX)) + WTHPR3=WTHPH3*(1.0-EFIRE(2,IHVST(NZ,I,NY,NX)) + 2*EHVST(2,3,NZ,I,NY,NX)) + WTHNL3=WTHNH3*(1.0-EHVST(2,3,NZ,I,NY,NX)) + WTHPL3=WTHPH3*(1.0-EHVST(2,3,NZ,I,NY,NX)) + WTHTR4=WTHTH4*(1.0-EHVST(2,4,NZ,I,NY,NX)) + WTHNR4=WTHNH4*(1.0-EFIRE(1,IHVST(NZ,I,NY,NX)) + 2*EHVST(2,4,NZ,I,NY,NX)) + WTHPR4=WTHPH4*(1.0-EFIRE(2,IHVST(NZ,I,NY,NX)) + 2*EHVST(2,4,NZ,I,NY,NX)) + WTHNL4=WTHNH4*(1.0-EHVST(2,4,NZ,I,NY,NX)) + WTHPL4=WTHPH4*(1.0-EHVST(2,4,NZ,I,NY,NX)) + ENDIF +C +C C,N,P REMOVED FROM HARVESTING +C + WTHTHT=WTHTH0+WTHTH1+WTHTH2+WTHTH3+WTHTH4 + WTHTRT=WTHTR0+WTHTR1+WTHTR2+WTHTR3+WTHTR4 + WTHNHT=WTHNH0+WTHNH1+WTHNH2+WTHNH3+WTHNH4 + WTHNRT=WTHNR0+WTHNR1+WTHNR2+WTHNR3+WTHNR4 + WTHPHT=WTHPH0+WTHPH1+WTHPH2+WTHPH3+WTHPH4 + WTHPRT=WTHPR0+WTHPR1+WTHPR2+WTHPR3+WTHPR4 + WTHTXT=WTHTX0+WTHTX1+WTHTX2+WTHTX3+WTHTX4 + WTHNXT=WTHNX0+WTHNX1+WTHNX2+WTHNX3+WTHNX4 + WTHPXT=WTHPX0+WTHPX1+WTHPX2+WTHPX3+WTHPX4 + IF(IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6)THEN + IF(IHVST(NZ,I,NY,NX).NE.5)THEN + IF(JHVST(NZ,I,NY,NX).NE.2)THEN + HVSTC(NZ,NY,NX)=HVSTC(NZ,NY,NX)+WTHTHT-WTHTRT + HVSTN(NZ,NY,NX)=HVSTN(NZ,NY,NX)+WTHNHT-WTHNRT + HVSTP(NZ,NY,NX)=HVSTP(NZ,NY,NX)+WTHPHT-WTHPRT + TNBP(NY,NX)=TNBP(NY,NX)+WTHTRT-WTHTHT + XHVSTC(NY,NX)=XHVSTC(NY,NX)+WTHTHT-WTHTRT + XHVSTN(NY,NX)=XHVSTN(NY,NX)+WTHNHT-WTHNRT + XHVSTP(NY,NX)=XHVSTP(NY,NX)+WTHPHT-WTHPRT + ELSE + WTRVC(NZ,NY,NX)=WTRVC(NZ,NY,NX)+WTHTHT-WTHTRT + WTRVN(NZ,NY,NX)=WTRVN(NZ,NY,NX)+WTHNHT-WTHNRT + WTRVP(NZ,NY,NX)=WTRVP(NZ,NY,NX)+WTHPHT-WTHPRT + ENDIF +C +C C,N,P LOST AS GAS IF FIRE +C + ELSE + VCO2F(NZ,NY,NX)=VCO2F(NZ,NY,NX)-(1.0-FCH4F)*(WTHTHT-WTHTRT) + VCH4F(NZ,NY,NX)=VCH4F(NZ,NY,NX)-FCH4F*(WTHTHT-WTHTRT) + VOXYF(NZ,NY,NX)=VOXYF(NZ,NY,NX)-(1.0-FCH4F)*(WTHTHT-WTHTRT)*2.667 + VNH3F(NZ,NY,NX)=VNH3F(NZ,NY,NX)-WTHNHT+WTHNRT + VN2OF(NZ,NY,NX)=VN2OF(NZ,NY,NX)-0.0 + VPO4F(NZ,NY,NX)=VPO4F(NZ,NY,NX)-WTHPHT+WTHPRT + CNET(NZ,NY,NX)=CNET(NZ,NY,NX)-(1.0-FCH4F)*(WTHTHT-WTHTRT) + TNBP(NY,NX)=TNBP(NY,NX)-FCH4F*(WTHTHT-WTHTRT) +C WRITE(*,5679)'FIRE2',I,J,NZ,VCO2F(NZ,NY,NX),FCH4F,WTHNH0 +C 2,WTHNH1,WTHNH2,WTHNH3,WTHNH4,WTHNR0,WTHNR1,WTHNR2 +C 3,WTHNR3,WTHNR4,WTHNHT,WTHNRT +5679 FORMAT(A8,3I4,20E12.4) + ENDIF +C +C C,N,P REMOVED FROM GRAZING +C + ELSE + HVSTC(NZ,NY,NX)=HVSTC(NZ,NY,NX)+GY*(WTHTHT-WTHTRT) + TCO2T(NZ,NY,NX)=TCO2T(NZ,NY,NX)-GZ*(WTHTHT-WTHTRT) + TCO2A(NZ,NY,NX)=TCO2A(NZ,NY,NX)-GZ*(WTHTHT-WTHTRT) + HVSTN(NZ,NY,NX)=HVSTN(NZ,NY,NX)+WTHNHT-WTHNRT + HVSTP(NZ,NY,NX)=HVSTP(NZ,NY,NX)+WTHPHT-WTHPRT + TNBP(NY,NX)=TNBP(NY,NX)+GY*(WTHTRT-WTHTHT) + CNET(NZ,NY,NX)=CNET(NZ,NY,NX)+GZ*(WTHTRT-WTHTHT) + XHVSTC(NY,NX)=XHVSTC(NY,NX)+GY*(WTHTHT-WTHTRT) + XHVSTN(NY,NX)=XHVSTN(NY,NX)+WTHNHT-WTHNRT + XHVSTP(NY,NX)=XHVSTP(NY,NX)+WTHPHT-WTHPRT + RECO(NY,NX)=RECO(NY,NX)-GZ*(WTHTHT-WTHTRT) + TRAU(NY,NX)=TRAU(NY,NX)-GZ*(WTHTHT-WTHTRT) + ENDIF +C +C ABOVE-GROUND LITTERFALL FROM HARVESTING +C + IF(IHVST(NZ,I,NY,NX).NE.4.AND.IHVST(NZ,I,NY,NX).NE.6)THEN + IF(IHVST(NZ,I,NY,NX).NE.5)THEN + DO 6375 M=1,4 + CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) + 2+CFOPC(0,M,NZ,NY,NX)*(WTHTR0+WTHTX0) + 3+CFOPC(1,M,NZ,NY,NX)*(WTHTR1+WTHTX1) + 4+CFOPC(2,M,NZ,NY,NX)*(WTHTR2+WTHTX2) + ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) + 2+CFOPN(0,M,NZ,NY,NX)*(WTHNR0+WTHNX0) + 3+CFOPN(1,M,NZ,NY,NX)*(WTHNR1+WTHNX1) + 4+CFOPN(2,M,NZ,NY,NX)*(WTHNR2+WTHNX2) + PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) + 2+CFOPP(0,M,NZ,NY,NX)*(WTHPR0+WTHPX0) + 3+CFOPP(1,M,NZ,NY,NX)*(WTHPR1+WTHPX1) + 4+CFOPP(2,M,NZ,NY,NX)*(WTHPR2+WTHPX2) + IF(IBTYP(NZ,NY,NX).EQ.0.OR.IGTYP(NZ,NY,NX).LE.1)THEN + CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) + 2+CFOPC(3,M,NZ,NY,NX)*(WTHTR3+WTHTX3+WTHTR4+WTHTX4) + ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) + 2+CFOPN(3,M,NZ,NY,NX)*(WTHNR3+WTHNX3+WTHNR4+WTHNX4) + PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) + 2+CFOPP(3,M,NZ,NY,NX)*(WTHPR3+WTHPX3+WTHPR4+WTHPX4) + ELSE + WTSTDG(M,NZ,NY,NX)=WTSTDG(M,NZ,NY,NX) + 2+CFOPC(5,M,NZ,NY,NX)*(WTHTX3+WTHTX4) + WTSTDN(M,NZ,NY,NX)=WTSTDN(M,NZ,NY,NX) + 2+CFOPN(5,M,NZ,NY,NX)*(WTHNX3+WTHNX4) + WTSTDP(M,NZ,NY,NX)=WTSTDP(M,NZ,NY,NX) + 2+CFOPP(5,M,NZ,NY,NX)*(WTHPX3+WTHPX4) + CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX) + 2+FRC*CFOPC(5,M,NZ,NY,NX)*(WTHTR3+WTHTR4) + ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX) + 2+FRC*CFOPN(5,M,NZ,NY,NX)*(WTHNR3+WTHNR4) + PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX) + 2+FRC*CFOPP(5,M,NZ,NY,NX)*(WTHPR3+WTHPR4) + CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) + 2+FRF*CFOPC(5,M,NZ,NY,NX)*(WTHTR3+WTHTR4) + ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) + 2+FRF*CFOPN(5,M,NZ,NY,NX)*(WTHNR3+WTHNR4) + PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) + 2+FRF*CFOPP(5,M,NZ,NY,NX)*(WTHPR3+WTHPR4) + ENDIF +6375 CONTINUE +C +C ABOVE-GROUND LITTERFALL FROM FIRE +C + ELSE + DO 6485 M=1,4 + CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) + 2+CFOPC(0,M,NZ,NY,NX)*(WTHTR0+WTHTX0) + 3+CFOPC(1,M,NZ,NY,NX)*(WTHTR1+WTHTX1) + 4+CFOPC(2,M,NZ,NY,NX)*(WTHTR2+WTHTX2) + ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) + 2+CFOPN(0,M,NZ,NY,NX)*WTHNL0 + 3+CFOPN(1,M,NZ,NY,NX)*WTHNL1 + 4+CFOPN(2,M,NZ,NY,NX)*WTHNL2 + PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) + 2+CFOPP(0,M,NZ,NY,NX)*WTHPL0 + 3+CFOPP(1,M,NZ,NY,NX)*WTHPL1 + 4+CFOPP(2,M,NZ,NY,NX)*WTHPL2 + ZSNC(4,1,0,NZ,NY,NX)=ZSNC(4,1,0,NZ,NY,NX) + 2+CFOPN(0,M,NZ,NY,NX)*(WTHNR0+WTHNX0-WTHNL0) + 3+CFOPN(1,M,NZ,NY,NX)*(WTHNR1+WTHNX1-WTHNL1) + 4+CFOPN(2,M,NZ,NY,NX)*(WTHNR2+WTHNX2-WTHNL2) + PSNC(4,1,0,NZ,NY,NX)=PSNC(4,1,0,NZ,NY,NX) + 2+CFOPP(0,M,NZ,NY,NX)*(WTHPR0+WTHPX0-WTHPL0) + 3+CFOPP(1,M,NZ,NY,NX)*(WTHPR1+WTHPX1-WTHPL1) + 4+CFOPP(2,M,NZ,NY,NX)*(WTHPR2+WTHPX2-WTHPL2) + IF(IBTYP(NZ,NY,NX).EQ.0.OR.IGTYP(NZ,NY,NX).LE.1)THEN + CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) + 2+CFOPC(3,M,NZ,NY,NX)*(WTHTR3+WTHTX3+WTHTR4+WTHTX4) + ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) + 2+CFOPN(3,M,NZ,NY,NX)*(WTHNL3+WTHNL4) + PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) + 2+CFOPP(3,M,NZ,NY,NX)*(WTHPL3+WTHPL4) + ZSNC(4,1,0,NZ,NY,NX)=ZSNC(4,1,0,NZ,NY,NX) + 2+CFOPN(3,M,NZ,NY,NX)*(WTHNR3+WTHNX3-WTHNL3+WTHNR4+WTHNX4-WTHNL4) + PSNC(4,1,0,NZ,NY,NX)=PSNC(4,1,0,NZ,NY,NX) + 2+CFOPP(3,M,NZ,NY,NX)*(WTHPR3+WTHPX3-WTHPL3+WTHPR4+WTHPX4-WTHPL4) + ELSE + WTSTDG(M,NZ,NY,NX)=WTSTDG(M,NZ,NY,NX) + 2+CFOPC(5,M,NZ,NY,NX)*(WTHTR3+WTHTX3) + WTSTDN(M,NZ,NY,NX)=WTSTDN(M,NZ,NY,NX) + 2+CFOPN(5,M,NZ,NY,NX)*WTHNL3 + WTSTDP(M,NZ,NY,NX)=WTSTDP(M,NZ,NY,NX) + 2+CFOPP(5,M,NZ,NY,NX)*WTHPL3 + CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX) + 2+FRC*CFOPC(3,M,NZ,NY,NX)*(WTHTR4+WTHTX4) + ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX) + 2+FRC*CFOPN(3,M,NZ,NY,NX)*WTHNL4 + PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX) + 2+FRC*CFOPP(3,M,NZ,NY,NX)*WTHPL4 + ZSNC(4,0,0,NZ,NY,NX)=ZSNC(4,0,0,NZ,NY,NX) + 2+FRC*CFOPN(5,M,NZ,NY,NX)*(WTHNR3+WTHNX3-WTHNL3 + 3+WTHNR4+WTHNX4-WTHNL4) + PSNC(4,0,0,NZ,NY,NX)=PSNC(4,0,0,NZ,NY,NX) + 2+FRC*CFOPP(5,M,NZ,NY,NX)*(WTHPR3+WTHPX3-WTHPL3 + 3+WTHPR4+WTHPX4-WTHPL4) + CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX) + 2+FRF*CFOPC(3,M,NZ,NY,NX)*(WTHTR4+WTHTX4) + ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX) + 2+FRF*CFOPN(3,M,NZ,NY,NX)*WTHNL4 + PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX) + 2+FRF*CFOPP(3,M,NZ,NY,NX)*WTHPL4 + ZSNC(4,1,0,NZ,NY,NX)=ZSNC(4,1,0,NZ,NY,NX) + 2+FRF*CFOPN(5,M,NZ,NY,NX)*(WTHNR3+WTHNX3-WTHNL3 + 3+WTHNR4+WTHNX4-WTHNL4) + PSNC(4,1,0,NZ,NY,NX)=PSNC(4,1,0,NZ,NY,NX) + 2+FRF*CFOPP(5,M,NZ,NY,NX)*(WTHPR3+WTHPX3-WTHPL3 + 3+WTHPR4+WTHPX4-WTHPL4) + ENDIF +6485 CONTINUE + ENDIF + ELSE +C +C ABOVE-GROUND LITTERFALL FROM GRAZING +C + TCSNC(NZ,NY,NX)=TCSNC(NZ,NY,NX)+WTHTRT+WTHTXT + TZSNC(NZ,NY,NX)=TZSNC(NZ,NY,NX)+WTHNRT+WTHNXT + TPSNC(NZ,NY,NX)=TPSNC(NZ,NY,NX)+WTHPRT+WTHPXT + TCSN0(NZ,NY,NX)=TCSN0(NZ,NY,NX)+WTHTRT+WTHTXT + TZSN0(NZ,NY,NX)=TZSNC(NZ,NY,NX)+WTHNRT+WTHNXT + TPSN0(NZ,NY,NX)=TPSNC(NZ,NY,NX)+WTHPRT+WTHPXT + ENDIF + ZEROP(NZ,NY,NX)=ZERO*PP(NZ,NY,NX) + ZEROQ(NZ,NY,NX)=ZERO*PP(NZ,NY,NX)/AREA(3,NU(NY,NX),NY,NX) + ZEROL(NZ,NY,NX)=ZERO*PP(NZ,NY,NX)*1.0E+06 + ENDIF +9985 CONTINUE +C +C TRANSFORMATIONS IN LIVING OR DEAD PLANT POPULATIONS +C + DO 9975 NZ=1,NP0(NY,NX) +C +C ACTIVATE DORMANT SEEDS +C + DO 205 NB=1,NBR(NZ,NY,NX) + IF(IFLGI(NZ,NY,NX).EQ.1)THEN + IF(IFLGE(NB,NZ,NY,NX).EQ.0 + 2.AND.VRNS(NB,NZ,NY,NX).GE.VRNL(NB,NZ,NY,NX))THEN + IDAY0(NZ,NY,NX)=I + IYR0(NZ,NY,NX)=IYRC + SDPTHI(NZ,NY,NX)=0.005 + IFLGI(NZ,NY,NX)=0 + ENDIF + ENDIF +205 CONTINUE +C +C LITTERFALL FROM STANDING DEAD +C + DO 6235 M=1,4 + XFRC=1.5814E-05*TFN3(NZ,NY,NX)*WTSTDG(M,NZ,NY,NX) + XFRN=1.5814E-05*TFN3(NZ,NY,NX)*WTSTDN(M,NZ,NY,NX) + XFRP=1.5814E-05*TFN3(NZ,NY,NX)*WTSTDP(M,NZ,NY,NX) + IF(IBTYP(NZ,NY,NX).EQ.0.OR.IGTYP(NZ,NY,NX).LE.1)THEN + CSNC(M,1,0,NZ,NY,NX)=CSNC(M,1,0,NZ,NY,NX)+XFRC + ZSNC(M,1,0,NZ,NY,NX)=ZSNC(M,1,0,NZ,NY,NX)+XFRN + PSNC(M,1,0,NZ,NY,NX)=PSNC(M,1,0,NZ,NY,NX)+XFRP + ELSE + CSNC(M,0,0,NZ,NY,NX)=CSNC(M,0,0,NZ,NY,NX)+XFRC + ZSNC(M,0,0,NZ,NY,NX)=ZSNC(M,0,0,NZ,NY,NX)+XFRN + PSNC(M,0,0,NZ,NY,NX)=PSNC(M,0,0,NZ,NY,NX)+XFRP + ENDIF + WTSTDG(M,NZ,NY,NX)=WTSTDG(M,NZ,NY,NX)-XFRC + WTSTDN(M,NZ,NY,NX)=WTSTDN(M,NZ,NY,NX)-XFRN + WTSTDP(M,NZ,NY,NX)=WTSTDP(M,NZ,NY,NX)-XFRP +6235 CONTINUE +C +C ACCUMULATE TOTAL SURFACE, SUBSURFACE LITTERFALL +C + DO 6430 M=1,4 + DO 6430 K=0,1 + TCSN0(NZ,NY,NX)=TCSN0(NZ,NY,NX)+CSNC(M,K,0,NZ,NY,NX) + TZSN0(NZ,NY,NX)=TZSN0(NZ,NY,NX)+ZSNC(M,K,0,NZ,NY,NX) + TPSN0(NZ,NY,NX)=TPSN0(NZ,NY,NX)+PSNC(M,K,0,NZ,NY,NX) +6538 FORMAT(A8,4I4,12E12.4) + DO 8955 L=0,NJ(NY,NX) + HCSNC(NZ,NY,NX)=HCSNC(NZ,NY,NX)+CSNC(M,K,L,NZ,NY,NX) + HZSNC(NZ,NY,NX)=HZSNC(NZ,NY,NX)+ZSNC(M,K,L,NZ,NY,NX) + HPSNC(NZ,NY,NX)=HPSNC(NZ,NY,NX)+PSNC(M,K,L,NZ,NY,NX) + TCSNC(NZ,NY,NX)=TCSNC(NZ,NY,NX)+CSNC(M,K,L,NZ,NY,NX) + TZSNC(NZ,NY,NX)=TZSNC(NZ,NY,NX)+ZSNC(M,K,L,NZ,NY,NX) + TPSNC(NZ,NY,NX)=TPSNC(NZ,NY,NX)+PSNC(M,K,L,NZ,NY,NX) +8955 CONTINUE +6430 CONTINUE +C +C TOTAL STANDING DEAD +C + WTSTG(NZ,NY,NX)=WTSTDG(1,NZ,NY,NX)+WTSTDG(2,NZ,NY,NX) + 4+WTSTDG(3,NZ,NY,NX)+WTSTDG(4,NZ,NY,NX) + WTSTGN(NZ,NY,NX)=WTSTDN(1,NZ,NY,NX)+WTSTDN(2,NZ,NY,NX) + 4+WTSTDN(3,NZ,NY,NX)+WTSTDN(4,NZ,NY,NX) + WTSTGP(NZ,NY,NX)=WTSTDP(1,NZ,NY,NX)+WTSTDP(2,NZ,NY,NX) + 4+WTSTDP(3,NZ,NY,NX)+WTSTDP(4,NZ,NY,NX) +C +C PLANT C BALANCE = TOTAL C STATE VARIABLES + TOTAL +C AUTOTROPHIC RESPIRATION + TOTAL LITTERFALL - TOTAL EXUDATION +C - TOTAL CO2 FIXATION +C + ZNPP(NZ,NY,NX)=CARBN(NZ,NY,NX)+TCO2T(NZ,NY,NX) + IF(IFLGC(NZ,NY,NX).EQ.1)THEN + BALC(NZ,NY,NX)=WTSHT(NZ,NY,NX)+WTRT(NZ,NY,NX)+WTND(NZ,NY,NX) + 2+WTRVC(NZ,NY,NX)-ZNPP(NZ,NY,NX)+TCSNC(NZ,NY,NX)-TCUPTK(NZ,NY,NX) + 3-RSETC(NZ,NY,NX)+WTSTG(NZ,NY,NX)+THVSTC(NZ,NY,NX) + 4+HVSTC(NZ,NY,NX)-VCO2F(NZ,NY,NX)-VCH4F(NZ,NY,NX) +C IF(NZ.EQ.1)THEN +C WRITE(*,1111)'BALC',I,J,NX,NY,NZ,BALC(NZ,NY,NX),WTSHT(NZ,NY,NX) +C 2,WTRT(NZ,NY,NX),WTND(NZ,NY,NX),WTRVC(NZ,NY,NX),TCO2T(NZ,NY,NX) +C 3,TCSNC(NZ,NY,NX),TCUPTK(NZ,NY,NX),CARBN(NZ,NY,NX) +C 2,RSETC(NZ,NY,NX),WTSTG(NZ,NY,NX),THVSTC(NZ,NY,NX) +C 3,HVSTC(NZ,NY,NX),CPOOLP(NZ,NY,NX) +C 3,WTLF(NZ,NY,NX),WTSHE(NZ,NY,NX),WTSTK(NZ,NY,NX),WTRSV(NZ,NY,NX) +C 3,WTHSK(NZ,NY,NX),WTEAR(NZ,NY,NX),WTGR(NZ,NY,NX) +C 5,VCO2F(NZ,NY,NX),VCH4F(NZ,NY,NX) +C 5,(WTLFB(NB,NZ,NY,NX),NB=1,5) +C 3,((CSNC(M,0,L,NZ,NY,NX),M=1,4),L=0,NL(NY,NX)) +C 4,((CPOOLR(N,L,NZ,NY,NX),L=1,NL(NY,NX)),N=1,2) +C 4,(CPOOLK(NB,NZ,NY,NX),NB=1,10) +1111 FORMAT(A8,5I4,200F18.6) +C ENDIF +C +C PLANT N BALANCE = TOTAL N STATE VARIABLES + TOTAL N LITTERFALL +C - TOTAL N UPTAKE FROM SOIL - TOTAL N ABSORPTION FROM ATMOSPHERE +C + BALN(NZ,NY,NX)=WTSHN(NZ,NY,NX)+WTRTN(NZ,NY,NX)+WTNDN(NZ,NY,NX) + 2+WTRVN(NZ,NY,NX)+TZSNC(NZ,NY,NX)-TZUPTK(NZ,NY,NX)-TNH3C(NZ,NY,NX) + 3-RSETN(NZ,NY,NX)+WTSTGN(NZ,NY,NX)+HVSTN(NZ,NY,NX)+THVSTN(NZ,NY,NX) + 4-VNH3F(NZ,NY,NX)-VN2OF(NZ,NY,NX)-TZUPFX(NZ,NY,NX) +C IF(NZ.EQ.1)THEN +C WRITE(*,1112)'BALN',I,J,NX,NY,NZ,BALN(NZ,NY,NX),WTSHN(NZ,NY,NX) +C 2,WTRTN(NZ,NY,NX),WTNDN(NZ,NY,NX),WTRVN(NZ,NY,NX),TZSNC(NZ,NY,NX) +C 3,TZUPTK(NZ,NY,NX),TNH3C(NZ,NY,NX),RSETN(NZ,NY,NX),HVSTN(NZ,NY,NX) +C 4,WTSTGN(NZ,NY,NX),WTLFN(NZ,NY,NX),WTSHEN(NZ,NY,NX) +C 5,WTSTKN(NZ,NY,NX),WTRSVN(NZ,NY,NX),WTHSKN(NZ,NY,NX) +C 3,WTEARN(NZ,NY,NX),WTGRNN(NZ,NY,NX),UPOMN(NZ,NY,NX),UPNH4(NZ,NY,NX) +C 2,UPNO3(NZ,NY,NX),VNH3F(NZ,NY,NX),VN2OF(NZ,NY,NX) +C 4,((RDFOMN(N,L,NZ,NY,NX),N=1,2),L=NU(NY,NX),NI(NZ,NY,NX)) +C 4,((ZPOOLR(N,L,NZ,NY,NX),N=1,2),L=NU(NY,NX),NI(NZ,NY,NX)) +1112 FORMAT(A8,5I4,200F18.6) +C ENDIF +C +C PLANT P BALANCE = TOTAL P STATE VARIABLES + TOTAL P LITTERFALL +C - TOTAL P UPTAKE FROM SOIL +C + BALP(NZ,NY,NX)=WTSHP(NZ,NY,NX)+WTRTP(NZ,NY,NX)+WTNDP(NZ,NY,NX) + 2+WTRVP(NZ,NY,NX)+TPSNC(NZ,NY,NX)-TPUPTK(NZ,NY,NX) + 3-RSETP(NZ,NY,NX)+WTSTDP(1,NZ,NY,NX)+WTSTGP(NZ,NY,NX) + 4+HVSTP(NZ,NY,NX)+THVSTP(NZ,NY,NX)-VPO4F(NZ,NY,NX) +C IF(NZ.EQ.4)THEN +C WRITE(*,1112)'BALP',I,J,NX,NY,NZ,BALP(NZ,NY,NX),WTSHP(NZ,NY,NX) +C 2,WTRTP(NZ,NY,NX),WTNDP(NZ,NY,NX),WTRVP(NZ,NY,NX),TPSNC(NZ,NY,NX) +C 3,TPUPTK(NZ,NY,NX),RSETP(NZ,NY,NX) +C 4,WTSTDP(1,NZ,NY,NX),WTSTGP(NZ,NY,NX),HVSTP(NZ,NY,NX) +C 5,THVSTP(NZ,NY,NX),VPO4F(NZ,NY,NX) +C ENDIF + ENDIF +9975 CONTINUE +9990 CONTINUE +9995 CONTINUE + RETURN + END + + + diff --git a/f77src/hfunc.f b/f77src/hfunc.f index 4584922..447a1ef 100755 --- a/f77src/hfunc.f +++ b/f77src/hfunc.f @@ -1,670 +1,673 @@ - - SUBROUTINE hfunc(I,J,NHW,NHE,NVN,NVS) -C -C THIS SUBROUTINE CALCULATES PLANT PHENOLOGY -C - include "parameters.h" - include "filec.h" - include "files.h" - include "blkc.h" - include "blk1cp.h" - include "blk1cr.h" - include "blk1g.h" - include "blk1n.h" - include "blk1p.h" - include "blk2a.h" - include "blk2b.h" - include "blk2c.h" - include "blk3.h" - include "blk8a.h" - include "blk8b.h" - include "blk9a.h" - include "blk9b.h" - include "blk9c.h" - include "blk11a.h" - include "blk11b.h" - include "blk12a.h" - include "blk12b.h" - include "blk16.h" - include "blk18a.h" - include "blk18b.h" - DIMENSION NBX(0:3),PSILY(0:2) - 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 - PARAMETER (PSILM=0.1,PSILX=-0.2) - PARAMETER(GSTGG=2.00,GSTGR=0.667,FVRN=0.5,VRNE=3600.0) - DATA PSILY/-200.0,-2.0,-2.0/ - DATA NBX /5,1,1,1/ - DO 9995 NX=NHW,NHE - DO 9990 NY=NVN,NVS - DO 9985 NZ=1,NP(NY,NX) -C WRITE(*,4444)'IFLGC',I,NX,NY,NZ,DATAP(NZ,NY,NX),IFLGT(NY,NX) -C 2,IDAY0(NZ,NY,NX),IDAYH(NZ,NY,NX),IYRC,IYRH(NZ,NY,NX) -C 3,IDTH(NZ,NY,NX),IYR0(NZ,NY,NX),IFLGC(NZ,NY,NX) -4444 FORMAT(A8,4I8,A16,20I8) - IF(DATAP(NZ,NY,NX).NE.'NO')THEN - PPT(NY,NX)=PPT(NY,NX)+PP(NZ,NY,NX) -C -C SET CROP FLAG ACCORDING TO PLANTING, HARVEST DATES, DEATH, -C 1 = ALIVE, 0 = NOT ALIVE -C - IF(J.EQ.1)THEN - IF(IDAY0(NZ,NY,NX).LE.IDAYH(NZ,NY,NX) - 3.OR.IYR0(NZ,NY,NX).LT.IYRH(NZ,NY,NX))THEN - IF(I.GE.IDAY0(NZ,NY,NX).OR.IDATA(3).GT.IYR0(NZ,NY,NX))THEN - IF(I.GT.IDAYH(NZ,NY,NX).AND.IYRC.GE.IYRH(NZ,NY,NX) - 2.AND.IDTH(NZ,NY,NX).EQ.1)THEN - IFLGC(NZ,NY,NX)=0 - ELSE - IF(I.EQ.IDAY0(NZ,NY,NX).AND.IDATA(3).EQ.IYR0(NZ,NY,NX))THEN - IFLGC(NZ,NY,NX)=0 - IDTH(NZ,NY,NX)=0 - CALL STARTQ(NX,NX,NY,NY,NZ,NZ) - TNBP(NY,NX)=TNBP(NY,NX)+WTRVX(NZ,NY,NX) - ENDIF - IF(DATAP(NZ,NY,NX).NE.'NO'.AND.IDTH(NZ,NY,NX).EQ.0) - 2IFLGC(NZ,NY,NX)=1 - ENDIF - ELSE - IFLGC(NZ,NY,NX)=0 - ENDIF - ELSE - IF((I.LT.IDAY0(NZ,NY,NX).AND.I.GT.IDAYH(NZ,NY,NX) - 2.AND.IYRC.GE.IYRH(NZ,NY,NX).AND.IDTH(NZ,NY,NX).EQ.1) - 3.OR.(I.LT.IDAY0(NZ,NY,NX).AND.IYR0(NZ,NY,NX) - 4.GT.IYRH(NZ,NY,NX)))THEN - IFLGC(NZ,NY,NX)=0 - ELSE - IF(I.EQ.IDAY0(NZ,NY,NX).AND.IDATA(3).EQ.IYR0(NZ,NY,NX))THEN - IFLGC(NZ,NY,NX)=0 - IDTH(NZ,NY,NX)=0 - CALL STARTQ(NX,NX,NY,NY,NZ,NZ) - TNBP(NY,NX)=TNBP(NY,NX)+WTRVX(NZ,NY,NX) - ENDIF - IF(DATAP(NZ,NY,NX).NE.'NO'.AND.IDTH(NZ,NY,NX).EQ.0) - 2IFLGC(NZ,NY,NX)=1 - ENDIF - ENDIF - IFLGT(NY,NX)=IFLGT(NY,NX)+IFLGC(NZ,NY,NX) - ENDIF - IF(IFLGC(NZ,NY,NX).EQ.1)THEN - RCO2Z(NZ,NY,NX)=0.0 - ROXYZ(NZ,NY,NX)=0.0 - RCH4Z(NZ,NY,NX)=0.0 - RN2OZ(NZ,NY,NX)=0.0 - RNH3Z(NZ,NY,NX)=0.0 - RH2GZ(NZ,NY,NX)=0.0 - CPOOLP(NZ,NY,NX)=0.0 - ZPOOLP(NZ,NY,NX)=0.0 - PPOOLP(NZ,NY,NX)=0.0 - NI(NZ,NY,NX)=NIX(NZ,NY,NX) - NG(NZ,NY,NX)=MIN(NI(NZ,NY,NX),MAX(NG(NZ,NY,NX),NU(NY,NX))) - NB1(NZ,NY,NX)=1 - NBTX=1.0E+06 -C -C TOTAL PLANT NON-STRUCTURAL C, N, P -C - DO 140 NB=1,NBR(NZ,NY,NX) - IF(IDTHB(NB,NZ,NY,NX).EQ.0)THEN - CPOOLP(NZ,NY,NX)=CPOOLP(NZ,NY,NX)+CPOOL(NB,NZ,NY,NX) - ZPOOLP(NZ,NY,NX)=ZPOOLP(NZ,NY,NX)+ZPOOL(NB,NZ,NY,NX) - PPOOLP(NZ,NY,NX)=PPOOLP(NZ,NY,NX)+PPOOL(NB,NZ,NY,NX) - CPOLNP(NZ,NY,NX)=CPOLNP(NZ,NY,NX)+CPOLNB(NB,NZ,NY,NX) - ZPOLNP(NZ,NY,NX)=ZPOLNP(NZ,NY,NX)+ZPOLNB(NB,NZ,NY,NX) - PPOLNP(NZ,NY,NX)=PPOLNP(NZ,NY,NX)+PPOLNB(NB,NZ,NY,NX) - IF(NBTB(NB,NZ,NY,NX).LT.NBTX)THEN - NB1(NZ,NY,NX)=NB - NBTX=NBTB(NB,NZ,NY,NX) - ENDIF - ENDIF -140 CONTINUE -C -C NON-STRUCTURAL C, N, P CONCENTRATIONS IN ROOT -C - DO 180 N=1,MY(NZ,NY,NX) - DO 160 L=NU(NY,NX),NI(NZ,NY,NX) - IF(WTRTL(N,L,NZ,NY,NX).GT.ZEROL(NZ,NY,NX))THEN - CCPOLR(N,L,NZ,NY,NX)=AMAX1(0.0,CPOOLR(N,L,NZ,NY,NX) - 2/WTRTL(N,L,NZ,NY,NX)) - CZPOLR(N,L,NZ,NY,NX)=AMAX1(0.0,ZPOOLR(N,L,NZ,NY,NX) - 2/WTRTL(N,L,NZ,NY,NX)) - CPPOLR(N,L,NZ,NY,NX)=AMAX1(0.0,PPOOLR(N,L,NZ,NY,NX) - 2/WTRTL(N,L,NZ,NY,NX)) -C CCPOLR(N,L,NZ,NY,NX)=AMIN1(1.0,CCPOLR(N,L,NZ,NY,NX)) - ELSE - CCPOLR(N,L,NZ,NY,NX)=1.0 - CZPOLR(N,L,NZ,NY,NX)=1.0 - CPPOLR(N,L,NZ,NY,NX)=1.0 - ENDIF -160 CONTINUE -180 CONTINUE -C -C NON-STRUCTURAL C, N, P CONCENTRATIONS IN SHOOT -C - IF(WTLS(NZ,NY,NX).GT.ZEROL(NZ,NY,NX))THEN - CCPOLP(NZ,NY,NX)=AMAX1(0.0,AMIN1(1.0,CPOOLP(NZ,NY,NX) - 2/WTLS(NZ,NY,NX))) - CCPLNP(NZ,NY,NX)=AMAX1(0.0,AMIN1(1.0,CPOLNP(NZ,NY,NX) - 2/WTLS(NZ,NY,NX))) - CZPOLP(NZ,NY,NX)=AMAX1(0.0,AMIN1(1.0,ZPOOLP(NZ,NY,NX) - 2/WTLS(NZ,NY,NX))) - CPPOLP(NZ,NY,NX)=AMAX1(0.0,AMIN1(1.0,PPOOLP(NZ,NY,NX) - 2/WTLS(NZ,NY,NX))) - ELSE - CCPOLP(NZ,NY,NX)=1.0 - CCPLNP(NZ,NY,NX)=1.0 - CZPOLP(NZ,NY,NX)=1.0 - CPPOLP(NZ,NY,NX)=1.0 - ENDIF - DO 190 NB=1,NBR(NZ,NY,NX) - IF(WTLSB(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN - CCPOLB(NB,NZ,NY,NX)=AMAX1(0.0,CPOOL(NB,NZ,NY,NX) - 2/WTLSB(NB,NZ,NY,NX)) - CZPOLB(NB,NZ,NY,NX)=AMAX1(0.0,ZPOOL(NB,NZ,NY,NX) - 2/WTLSB(NB,NZ,NY,NX)) - CPPOLB(NB,NZ,NY,NX)=AMAX1(0.0,PPOOL(NB,NZ,NY,NX) - 2/WTLSB(NB,NZ,NY,NX)) - ELSE - CCPOLB(NB,NZ,NY,NX)=1.0 - CZPOLB(NB,NZ,NY,NX)=1.0 - CPPOLB(NB,NZ,NY,NX)=1.0 - ENDIF -190 CONTINUE -C -C EMERGENCE DATE FROM COTYLEDON HEIGHT, LEAF AREA, ROOT DEPTH -C - IF(IDAY(1,NB1(NZ,NY,NX),NZ,NY,NX).EQ.0)THEN - ARLSP=ARLFP(NZ,NY,NX)+ARSTP(NZ,NY,NX) - IF((HTCTL(NZ,NY,NX).GT.SDPTH(NZ,NY,NX)) - 2.AND.(ARLSP.GT.ZEROL(NZ,NY,NX)) - 3.AND.(RTDP1(1,1,NZ,NY,NX).GT.SDPTH(NZ,NY,NX)+1.0E-06))THEN - IDAY(1,NB1(NZ,NY,NX),NZ,NY,NX)=I - VHCPC(NZ,NY,NX)=4.19*(WTSHT(NZ,NY,NX)*10.0E-06+VOLWC(NZ,NY,NX)) - ENDIF - ENDIF -C -C ADD BRANCH TO SHOOT IF PLANT GROWTH STAGE, SHOOT NON-STRUCTURAL C -C CONCENTRATION PERMIT -C -C WRITE(*,224)'HFUNC',I,J,IFLGI(NZ,NY,NX),PP(NZ,NY,NX) -C 2,TCG(NZ,NY,NX),PSIRG(1,NG(NZ,NY,NX),NZ,NY,NX) -C 3,PSILM,ISTYP(NZ,NY,NX),IDAY(2,NB1(NZ,NY,NX),NZ,NY,NX) -C 4,NBR(NZ,NY,NX),WTRVC(NZ,NY,NX),CCPOLP(NZ,NY,NX) -C 5,PB(NZ,NY,NX),IDTHB(NB,NZ,NY,NX),NB1(NZ,NY,NX) -C 6,PSTG(NB1(NZ,NY,NX),NZ,NY,NX),NBT(NZ,NY,NX) -C 7,NNOD(NZ,NY,NX),FNOD(NZ,NY,NX),XTLI(NZ,NY,NX) -224 FORMAT(A8,3I6,5E12.4,3I6,3E12.4,2I6,1E12.4,2I6,2E12.4) - IF(IFLGI(NZ,NY,NX).EQ.0)THEN - IF(J.EQ.1.AND.PP(NZ,NY,NX).GT.0.0)THEN - IF(PSIRG(1,NG(NZ,NY,NX),NZ,NY,NX).GT.PSILM)THEN - IF(ISTYP(NZ,NY,NX).NE.0 - 2.OR.IDAY(2,NB1(NZ,NY,NX),NZ,NY,NX).EQ.0)THEN - IF((NBR(NZ,NY,NX).EQ.0.AND.WTRVC(NZ,NY,NX).GT.0.0) - 2.OR.(CCPOLP(NZ,NY,NX).GT.PB(NZ,NY,NX) - 3.AND.PB(NZ,NY,NX).GT.0.0))THEN - DO 120 NB=1,10 - IF(IDTHB(NB,NZ,NY,NX).EQ.1)THEN - IF(NB.EQ.NB1(NZ,NY,NX) - 2.OR.PSTG(NB1(NZ,NY,NX),NZ,NY,NX).GT.NBT(NZ,NY,NX) - 2+NNOD(NZ,NY,NX)/FNOD(NZ,NY,NX)+XTLI(NZ,NY,NX))THEN - NBT(NZ,NY,NX)=NBT(NZ,NY,NX)+1 - NBR(NZ,NY,NX)=MIN(NBX(IBTYP(NZ,NY,NX)),MAX(NB,NBR(NZ,NY,NX))) - NBTB(NB,NZ,NY,NX)=NBT(NZ,NY,NX)-1 - IDTHP(NZ,NY,NX)=0 - IDTHB(NB,NZ,NY,NX)=0 - VRNS(NB,NZ,NY,NX)=0.0 - IF(ISTYP(NZ,NY,NX).EQ.0)THEN - GROUP(NB,NZ,NY,NX)=AMAX1(0.0,GROUPI(NZ,NY,NX)-NBTB(NB,NZ,NY,NX)) - ELSE - GROUP(NB,NZ,NY,NX)=GROUPI(NZ,NY,NX) - ENDIF - GO TO 125 - ENDIF - ENDIF -120 CONTINUE -125 CONTINUE - ENDIF - ENDIF - ENDIF -C -C ADD AXIS TO ROOT IF PLANT GROWTH STAGE, ROOT NON-STRUCTURAL C -C CONCENTRATION PERMIT -C - IF(PSIRG(1,NG(NZ,NY,NX),NZ,NY,NX).GT.PSILM)THEN - IF(NRT(NZ,NY,NX).EQ.0.OR.PSTG(NB1(NZ,NY,NX),NZ,NY,NX) - 2.GT.NRT(NZ,NY,NX)/FNOD(NZ,NY,NX)+XTLI(NZ,NY,NX))THEN - IF((NRT(NZ,NY,NX).EQ.0.AND.WTRVC(NZ,NY,NX).GT.0.0) - 2.OR.(CCPOLP(NZ,NY,NX).GT.PR(NZ,NY,NX) - 3.AND.PR(NZ,NY,NX).GT.0.0))THEN - NRT(NZ,NY,NX)=MIN(10,NRT(NZ,NY,NX)+1) - IDTHR(NZ,NY,NX)=0 - ENDIF - ENDIF - ENDIF - ENDIF - ENDIF -2224 FORMAT(A8,6I4) -C -C THE REST OF THE SUBROUTINE MODELS THE PHENOLOGY OF EACH BRANCH -C - IF(IDAY(1,NB1(NZ,NY,NX),NZ,NY,NX).NE.0 - 2.OR.IFLGI(NZ,NY,NX).EQ.1)THEN - DO 2010 NB=1,NBR(NZ,NY,NX) - IF(IDTHB(NB,NZ,NY,NX).EQ.0)THEN - IF(IDAY(1,NB,NZ,NY,NX).EQ.0)THEN - IDAY(1,NB,NZ,NY,NX)=I - IFLGA(NB,NZ,NY,NX)=1 - IFLGE(NB,NZ,NY,NX)=0 - VRNS(NB,NZ,NY,NX)=0.5*VRNS(NB1(NZ,NY,NX),NZ,NY,NX) - ENDIF -C -C CALCULATE NODE INITIATION AND LEAF APPEARANCE RATES -C FROM TEMPERATURE FUNCTION CALCULATED IN 'UPTAKE' AND -C RATES AT 25C ENTERED IN 'READQ' EXCEPT WHEN DORMANT -C - IF(IWTYP(NZ,NY,NX).EQ.0 - 2.OR.VRNF(NB,NZ,NY,NX).LT.VRNX(NB,NZ,NY,NX))THEN - TKCO=TKG(NZ,NY,NX)+OFFST(NZ,NY,NX) - RTK=8.3143*TKCO - STK=710.0*TKCO - ACTV=1+EXP((197500-STK)/RTK)+EXP((STK-222500)/RTK) - TFNP=EXP(25.229-62500/RTK)/ACTV - RNI=AMAX1(0.0,TFNP*XRNI(NZ,NY,NX)) - RLA=AMAX1(0.0,TFNP*XRLA(NZ,NY,NX)) -C -C NODE INITIATION AND LEAF APPEARANCE RATES SLOWED BY LOW TURGOR -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 - RNI=RNI*WFNSP - RLA=RLA*WFNSP - ENDIF -C -C ACCUMULATE NODE INITIATION AND LEAF APPEARANCE RATES -C INTO TOTAL NUMBER OF NODES AND LEAVES -C - PSTG(NB,NZ,NY,NX)=PSTG(NB,NZ,NY,NX)+RNI - VSTG(NB,NZ,NY,NX)=VSTG(NB,NZ,NY,NX)+RLA -C -C USE TOTAL NUMBER OF NODES TO CALCULATE PROGRESSION THROUGH -C VEGETATIVE AND REPRODUCTIVE GROWTH STAGES. THIS PROGRESSION -C IS USED TO SET START AND END DATES FOR GROWTH STAGES BELOW -C - IF(IDAY(2,NB,NZ,NY,NX).NE.0)THEN - GSTGI(NB,NZ,NY,NX)=(PSTG(NB,NZ,NY,NX)-PSTGI(NB,NZ,NY,NX)) - 2/GROUPI(NZ,NY,NX) - DGSTGI(NB,NZ,NY,NX)=RNI/(GROUPI(NZ,NY,NX)*GSTGG) - TGSTGI(NB,NZ,NY,NX)=TGSTGI(NB,NZ,NY,NX)+DGSTGI(NB,NZ,NY,NX) - ENDIF - IF(IDAY(6,NB,NZ,NY,NX).NE.0)THEN - GSTGF(NB,NZ,NY,NX)=(PSTG(NB,NZ,NY,NX)-PSTGF(NB,NZ,NY,NX)) - 2/GROUPI(NZ,NY,NX) - DGSTGF(NB,NZ,NY,NX)=RNI/(GROUPI(NZ,NY,NX)*GSTGR) - TGSTGF(NB,NZ,NY,NX)=TGSTGF(NB,NZ,NY,NX)+DGSTGF(NB,NZ,NY,NX) - ENDIF - IFLGG(NB,NZ,NY,NX)=1 - ELSE - IFLGG(NB,NZ,NY,NX)=0 - ENDIF -C -C REPRODUCTIVE GROWTH STAGES ADVANCE WHEN THRESHOLD NUMBER -C OF NODES HAVE BEEN INITIATED. FIRST DETERMINE PHOTOPERIOD -C AND TEMPERATURE EFFECTS ON FINAL VEG NODE NUMBER FROM -C NUMBER OF INITIATED NODES -C - IF(IDAY(2,NB,NZ,NY,NX).EQ.0)THEN - IF(PSTG(NB,NZ,NY,NX).GT.GROUP(NB,NZ,NY,NX)+PSTGI(NB,NZ,NY,NX) - 2.AND.((VRNS(NB,NZ,NY,NX).GE.VRNL(NB,NZ,NY,NX)) - 2.OR.(I.GE.IDAY0(NZ,NY,NX).AND.IYRC.EQ.IYR0(NZ,NY,NX) - 2.AND.DYLN(NY,NX).GT.DYLX(NY,NX))) - 3.OR.(((ISTYP(NZ,NY,NX).EQ.1.AND.(IWTYP(NZ,NY,NX).EQ.1 - 4.OR.IWTYP(NZ,NY,NX).EQ.3)) - 5.OR.(ISTYP(NZ,NY,NX).EQ.0.AND.IWTYP(NZ,NY,NX).EQ.0)) - 6.AND.ZC(NZ,NY,NX).GT.DPTHS(NY,NX) - 7.AND.DYLN(NY,NX).LT.DYLX(NY,NX)))THEN -C -C FINAL VEGETATIVE NODE NUMBER DEPENDS ON PHOTOPERIOD FROM 'DAY' -C AND ON MATURITY GROUP, CRITICAL PHOTOPERIOD AND PHOTOPERIOD -C SENSITIVITY ENTERED IN 'READQ' -C - IF(IPTYP(NZ,NY,NX).EQ.0)THEN - PPD=0.0 - ELSE - PPD=AMAX1(0.0,XDL(NZ,NY,NX)-DYLN(NY,NX)) - IF(IPTYP(NZ,NY,NX).EQ.1.AND.DYLN(NY,NX).GE.DYLX(NY,NX))PPD=0.0 - ENDIF -C IF(NZ.EQ.1)THEN -C WRITE(*,333)'IDAY2',I,J,NZ,NB,IDAY(2,NB,NZ,NY,NX),IDAY0(NZ,NY,NX) -C 2,IYR0(NZ,NY,NX),IPTYP(NZ,NY,NX) -C 2,PPD,XDL(NZ,NY,NX),DYLN(NY,NX),DYLX(NY,NX),VRNS(NB,NZ,NY,NX) -C 3,VRNL(NB,NZ,NY,NX),PSTG(NB,NZ,NY,NX),GROUP(NB,NZ,NY,NX) -C 4,PSTGI(NB,NZ,NY,NX),XPPD(NZ,NY,NX) -333 FORMAT(A8,8I4,20E12.4) -C ENDIF - IF(IPTYP(NZ,NY,NX).EQ.0 - 2.OR.(IPTYP(NZ,NY,NX).EQ.1.AND.PPD.GT.XPPD(NZ,NY,NX)) - 3.OR.(IPTYP(NZ,NY,NX).EQ.2.AND.PPD.LT.XPPD(NZ,NY,NX)) - 3.OR.(((ISTYP(NZ,NY,NX).EQ.1.AND.(IWTYP(NZ,NY,NX).EQ.1 - 4.OR.IWTYP(NZ,NY,NX).EQ.3)) - 5.OR.(ISTYP(NZ,NY,NX).EQ.0.AND.IWTYP(NZ,NY,NX).EQ.0)) - 6.AND.ZC(NZ,NY,NX).GT.DPTHS(NY,NX) - 7.AND.DYLN(NY,NX).LT.DYLX(NY,NX)))THEN - IDAY(2,NB,NZ,NY,NX)=I - PSTGI(NB,NZ,NY,NX)=PSTG(NB,NZ,NY,NX) - IF(ISTYP(NZ,NY,NX).EQ.0.AND.IDTYP(NZ,NY,NX).EQ.0)THEN - VSTGX(NB,NZ,NY,NX)=PSTG(NB,NZ,NY,NX) - ENDIF - ENDIF - ENDIF -C -C STEM ELONGATION -C - ELSEIF(IDAY(3,NB,NZ,NY,NX).EQ.0)THEN - IF(GSTGI(NB,NZ,NY,NX).GT.0.25*GSTGG - 2.OR.((IWTYP(NZ,NY,NX).EQ.1.OR.IWTYP(NZ,NY,NX).EQ.3) - 3.AND.ISTYP(NZ,NY,NX).NE.0.AND.IPTYP(NZ,NY,NX).NE.1 - 3.AND.DYLN(NY,NX).LT.DYLX(NY,NX).AND.IFLGE(NB,NZ,NY,NX).EQ.1 - 4.AND.VRNF(NB,NZ,NY,NX).GT.VRNX(NB,NZ,NY,NX)) - 5.OR.(IWTYP(NZ,NY,NX).EQ.2.AND.ISTYP(NZ,NY,NX).EQ.0) - 6.AND.IFLGE(NB,NZ,NY,NX).EQ.1 - 7.AND.VRNF(NB,NZ,NY,NX).GT.VRNX(NB,NZ,NY,NX))THEN - IDAY(3,NB,NZ,NY,NX)=I - ENDIF - ELSEIF(IDAY(4,NB,NZ,NY,NX).EQ.0)THEN - IF(GSTGI(NB,NZ,NY,NX).GT.0.50*GSTGG - 2.OR.((IWTYP(NZ,NY,NX).EQ.1.OR.IWTYP(NZ,NY,NX).EQ.3) - 3.AND.ISTYP(NZ,NY,NX).NE.0.AND.IPTYP(NZ,NY,NX).NE.1 - 3.AND.DYLN(NY,NX).LT.DYLX(NY,NX).AND.IFLGE(NB,NZ,NY,NX).EQ.1 - 4.AND.VRNF(NB,NZ,NY,NX).GT.VRNX(NB,NZ,NY,NX)) - 5.OR.(IWTYP(NZ,NY,NX).EQ.2.AND.ISTYP(NZ,NY,NX).EQ.0) - 6.AND.IFLGE(NB,NZ,NY,NX).EQ.1 - 7.AND.VRNF(NB,NZ,NY,NX).GT.VRNX(NB,NZ,NY,NX))THEN - IDAY(4,NB,NZ,NY,NX)=I - IF(ISTYP(NZ,NY,NX).EQ.0.AND.IDTYP(NZ,NY,NX).NE.0)THEN - VSTGX(NB,NZ,NY,NX)=PSTG(NB,NZ,NY,NX) - ENDIF - ENDIF - ELSEIF(IDAY(5,NB,NZ,NY,NX).EQ.0)THEN - IF(GSTGI(NB,NZ,NY,NX).GT.1.00*GSTGG - 2.OR.((IWTYP(NZ,NY,NX).EQ.1.OR.IWTYP(NZ,NY,NX).EQ.3) - 3.AND.ISTYP(NZ,NY,NX).NE.0.AND.IPTYP(NZ,NY,NX).NE.1 - 3.AND.DYLN(NY,NX).LT.DYLX(NY,NX).AND.IFLGE(NB,NZ,NY,NX).EQ.1 - 4.AND.VRNF(NB,NZ,NY,NX).GT.VRNX(NB,NZ,NY,NX)) - 5.OR.(IWTYP(NZ,NY,NX).EQ.2.AND.ISTYP(NZ,NY,NX).EQ.0) - 6.AND.IFLGE(NB,NZ,NY,NX).EQ.1 - 7.AND.VRNF(NB,NZ,NY,NX).GT.VRNX(NB,NZ,NY,NX))THEN - IDAY(5,NB,NZ,NY,NX)=I - ENDIF -C -C ANTHESIS OCCURS WHEN THE NUMBER OF LEAVES THAT HAVE APPEARED -C EQUALS THE NUMBER OF NODES INITIATED WHEN THE FINAL VEGETATIVE -C NODE NUMBER WAS SET ABOVE -C - ELSEIF(IDAY(6,NB,NZ,NY,NX).EQ.0)THEN - IF((VSTG(NB,NZ,NY,NX).GT.PSTGI(NB,NZ,NY,NX)) - 2.OR.(ISTYP(NZ,NY,NX).NE.0.AND.IDAY(5,NB,NZ,NY,NX).NE.0) - 2.OR.((IWTYP(NZ,NY,NX).EQ.1.OR.IWTYP(NZ,NY,NX).EQ.3) - 3.AND.ISTYP(NZ,NY,NX).NE.0.AND.IPTYP(NZ,NY,NX).NE.1 - 3.AND.DYLN(NY,NX).LT.DYLX(NY,NX).AND.IFLGE(NB,NZ,NY,NX).EQ.1 - 4.AND.VRNF(NB,NZ,NY,NX).GT.VRNX(NB,NZ,NY,NX)) - 5.OR.(IWTYP(NZ,NY,NX).EQ.2.AND.ISTYP(NZ,NY,NX).EQ.0) - 6.AND.IFLGE(NB,NZ,NY,NX).EQ.1 - 7.AND.VRNF(NB,NZ,NY,NX).GT.VRNX(NB,NZ,NY,NX))THEN - IF(NB.EQ.NB1(NZ,NY,NX) - 2.OR.IDAY(6,NB1(NZ,NY,NX),NZ,NY,NX).NE.0)THEN - IDAY(6,NB,NZ,NY,NX)=I - PSTGF(NB,NZ,NY,NX)=PSTG(NB,NZ,NY,NX) - ENDIF - ENDIF -C -C START GRAIN FILL PERIOD -C - ELSEIF(IDAY(7,NB,NZ,NY,NX).EQ.0)THEN - IF(GSTGF(NB,NZ,NY,NX).GT.0.50*GSTGR - 2.OR.((IWTYP(NZ,NY,NX).EQ.1.OR.IWTYP(NZ,NY,NX).EQ.3) - 3.AND.ISTYP(NZ,NY,NX).NE.0.AND.IPTYP(NZ,NY,NX).NE.1 - 3.AND.DYLN(NY,NX).LT.DYLX(NY,NX).AND.IFLGE(NB,NZ,NY,NX).EQ.1 - 4.AND.VRNF(NB,NZ,NY,NX).GT.VRNX(NB,NZ,NY,NX)) - 5.OR.(IWTYP(NZ,NY,NX).EQ.2.AND.ISTYP(NZ,NY,NX).EQ.0) - 6.AND.IFLGE(NB,NZ,NY,NX).EQ.1 - 7.AND.VRNF(NB,NZ,NY,NX).GT.VRNX(NB,NZ,NY,NX))THEN - IDAY(7,NB,NZ,NY,NX)=I -C IF(IWTYP(NZ,NY,NX).NE.0.AND.NB.EQ.NB1(NZ,NY,NX))THEN -C DO 1500 NBB=1,NBR(NZ,NY,NX) -C IF(NBB.NE.NB.AND.IDAY(5,NBB,NZ,NY,NX).EQ.0)THEN -C IDAY(5,NBB,NZ,NY,NX)=I -C PSTGF(NBB,NZ,NY,NX)=PSTG(NBB,NZ,NY,NX) -C ENDIF -1500 CONTINUE -C ENDIF - ENDIF -C -C END SEED NUMBER SET PERIOD -C - ELSEIF(IDAY(8,NB,NZ,NY,NX).EQ.0)THEN - IF(GSTGF(NB,NZ,NY,NX).GT.1.00*GSTGR)THEN - IDAY(8,NB,NZ,NY,NX)=I -C IF(IWTYP(NZ,NY,NX).NE.0.AND.NB.EQ.NB1(NZ,NY,NX))THEN -C DO 1495 NBB=1,NBR(NZ,NY,NX) -C IF(NBB.NE.NB.AND.IDAY(6,NBB,NZ,NY,NX).EQ.0)THEN -C IDAY(6,NBB,NZ,NY,NX)=I -C ENDIF -1495 CONTINUE -C ENDIF - ENDIF -C -C END SEED SIZE SET PERIOD -C - ELSEIF(IDAY(9,NB,NZ,NY,NX).EQ.0)THEN - IF(GSTGF(NB,NZ,NY,NX).GT.1.50*GSTGR)THEN - IDAY(9,NB,NZ,NY,NX)=I - ENDIF - ENDIF - ENDIF - KVSTGX=KVSTG(NB,NZ,NY,NX) - IF(VSTGX(NB,NZ,NY,NX).LE.1.0E-06)THEN - KVSTG(NB,NZ,NY,NX)=INT(VSTG(NB,NZ,NY,NX))+1 - ELSE - KVSTG(NB,NZ,NY,NX)=INT(AMIN1(VSTG(NB,NZ,NY,NX) - 2,VSTGX(NB,NZ,NY,NX)))+1 - ENDIF - KLEAF(NB,NZ,NY,NX)=MIN(24,KVSTG(NB,NZ,NY,NX)) - IF(KVSTG(NB,NZ,NY,NX).GT.KVSTGX)THEN - IFLGP(NB,NZ,NY,NX)=1 - ELSE - IFLGP(NB,NZ,NY,NX)=0 - ENDIF -C -C PHENOLOGY -C - IF(IDTHB(NB,NZ,NY,NX).EQ.0.OR.IFLGI(NZ,NY,NX).EQ.1)THEN - IF(DYLN(NY,NX).GE.DYLX(NY,NX))THEN - VRNY(NB,NZ,NY,NX)=VRNY(NB,NZ,NY,NX)+1.0 - VRNZ(NB,NZ,NY,NX)=0.0 - ELSE - VRNY(NB,NZ,NY,NX)=0.0 - VRNZ(NB,NZ,NY,NX)=VRNZ(NB,NZ,NY,NX)+1.0 - ENDIF -C -C CALCULATE PHENOLOGY DURING LENGTHENING PHOTOPERIODS -C - IF(IWTYP(NZ,NY,NX).EQ.0)THEN - IF(DYLN(NY,NX).GE.DYLX(NY,NX))THEN - VRNS(NB,NZ,NY,NX)=VRNY(NB,NZ,NY,NX) - IF(VRNS(NB,NZ,NY,NX).GE.VRNL(NB,NZ,NY,NX) - 2.OR.(ALAT(NY,NX).GT.0.0.AND.I.EQ.173) - 3.OR.(ALAT(NY,NX).LT.0.0.AND.I.EQ.355))THEN - VRNF(NB,NZ,NY,NX)=0.0 - IFLGF(NB,NZ,NY,NX)=0 - ENDIF - ENDIF -C -C CALCULATE EVERGREEN PHENOLOGY DURING SHORTENING PHOTOPERIODS -C - IF(DYLN(NY,NX).LT.DYLX(NY,NX))THEN - VRNF(NB,NZ,NY,NX)=VRNZ(NB,NZ,NY,NX) - IF(VRNF(NB,NZ,NY,NX).GE.VRNX(NB,NZ,NY,NX) - 2.OR.(ALAT(NY,NX).GT.0.0.AND.I.EQ.355) - 3.OR.(ALAT(NY,NX).LT.0.0.AND.I.EQ.173))THEN - VRNS(NB,NZ,NY,NX)=0.0 - IFLGE(NB,NZ,NY,NX)=0 - ENDIF - ENDIF -C -C CALCULATE WINTER DECIDUOUS PHENOLOGY BY ACCUMULATING HOURS IN -C SPECIFIED TEMPERATURE RANGES DURING LENGTHENING PHOTOPERIODS -C - ELSEIF(IWTYP(NZ,NY,NX).EQ.1)THEN - IF((DYLN(NY,NX).GE.DYLX(NY,NX) - 2.OR.(DYLN(NY,NX).LT.DYLX(NY,NX) - 3.AND.VRNF(NB,NZ,NY,NX).LT.VRNX(NB,NZ,NY,NX))) - 4.AND.IFLGE(NB,NZ,NY,NX).EQ.0)THEN - IF(TCG(NZ,NY,NX).GE.TCZ(NZ,NY,NX))THEN - VRNS(NB,NZ,NY,NX)=VRNS(NB,NZ,NY,NX)+1.0 - ENDIF - IF(VRNS(NB,NZ,NY,NX).LT.VRNL(NB,NZ,NY,NX))THEN - IF(TCG(NZ,NY,NX).LT.CTC(NZ,NY,NX))THEN - VRNS(NB,NZ,NY,NX)=AMAX1(0.0,VRNS(NB,NZ,NY,NX)-1.0) - ENDIF - ENDIF - IF(VRNS(NB,NZ,NY,NX).GE.VRNL(NB,NZ,NY,NX) - 2.OR.(ALAT(NY,NX).GT.0.0.AND.I.EQ.173) - 3.OR.(ALAT(NY,NX).LT.0.0.AND.I.EQ.355))THEN - VRNF(NB,NZ,NY,NX)=0.0 - ENDIF - ENDIF - IF(IDAY(2,NB,NZ,NY,NX).NE.0.OR.(DYLN(NY,NX).LT.DYLX(NY,NX) - 2.AND.DYLN(NY,NX).LT.12.0))THEN - IFLGF(NB,NZ,NY,NX)=0 - ENDIF -C -C CALCULATE WINTER DECIDUOUS PHENOLOGY BY ACCUMULATING HOURS IN -C SPECIFIED TEMPERATURE RANGES DURING SHORTENING PHOTOPERIODS -C - IF(DYLN(NY,NX).LT.DYLX(NY,NX) - 2.AND.IFLGF(NB,NZ,NY,NX).EQ.0 - 2.AND.IDAY(2,NB,NZ,NY,NX).NE.0)THEN - IF(TCG(NZ,NY,NX).LE.TCX(NZ,NY,NX))THEN - VRNF(NB,NZ,NY,NX)=VRNF(NB,NZ,NY,NX)+1.0 - ENDIF - IF(VRNF(NB,NZ,NY,NX).GE.VRNX(NB,NZ,NY,NX) - 2.AND.IFLGE(NB,NZ,NY,NX).EQ.1)THEN - VRNS(NB,NZ,NY,NX)=0.0 - IFLGE(NB,NZ,NY,NX)=0 - ENDIF - ENDIF -C WRITE(*,4646)'VRNS',I,J,NZ,NB,IDAY(2,NB,NZ,NY,NX) -C 2,IFLGE(NB,NZ,NY,NX),IFLGF(NB,NZ,NY,NX),VRNS(NB,NZ,NY,NX) -C 2,TCG(NZ,NY,NX),TCZ(NZ,NY,NX),TCX(NZ,NY,NX),PSILG(NZ,NY,NX) -C 3,DYLN(NY,NX),DYLX(NY,NX),DYLM(NY,NX),VRNF(NB,NZ,NY,NX) -C 4,VRNL(NB,NZ,NY,NX),VRNX(NB,NZ,NY,NX) -4646 FORMAT(A8,7I4,20E12.4) -C -C CALCULATE DROUGHT DECIDUOUS PHENOLOGY BY ACCUMULATING HOURS IN -C SPECIFIED TURGOR RANGES IN DORMANT STATE -C - ELSEIF(IWTYP(NZ,NY,NX).EQ.2.OR.IWTYP(NZ,NY,NX).EQ.4 - 2.OR.IWTYP(NZ,NY,NX).EQ.5)THEN - IF(IFLGE(NB,NZ,NY,NX).EQ.0)THEN - IF(PSILT(NZ,NY,NX).GE.PSILX)THEN - VRNS(NB,NZ,NY,NX)=VRNS(NB,NZ,NY,NX)+1.0 - ENDIF - IF(VRNS(NB,NZ,NY,NX).LT.VRNL(NB,NZ,NY,NX))THEN - IF(PSILT(NZ,NY,NX).LT.PSILY(IGTYP(NZ,NY,NX)))THEN - VRNS(NB,NZ,NY,NX)=AMAX1(0.0,VRNS(NB,NZ,NY,NX)-12.0) - ENDIF - ENDIF - IF(VRNS(NB,NZ,NY,NX).GE.VRNL(NB,NZ,NY,NX))THEN - VRNF(NB,NZ,NY,NX)=0.0 - IF(IDAY(2,NB,NZ,NY,NX).NE.0)IFLGF(NB,NZ,NY,NX)=0 - ENDIF - ENDIF - IF(IDAY(2,NB,NZ,NY,NX).NE.0)IFLGF(NB,NZ,NY,NX)=0 -C -C CALCULATE DROUGHT DECIDUOUS PHENOLOGY BY ACCUMULATING HOURS IN -C SPECIFIED TURGOR RANGES IN DORMANT STATE -C - IF(IFLGE(NB,NZ,NY,NX).EQ.1 - 3.AND.IFLGF(NB,NZ,NY,NX).EQ.0)THEN - IF(PSILT(NZ,NY,NX).LT.PSILY(IGTYP(NZ,NY,NX)))THEN - VRNF(NB,NZ,NY,NX)=VRNF(NB,NZ,NY,NX)+1.0 - ENDIF - IF(IWTYP(NZ,NY,NX).EQ.4)THEN - IF(VRNZ(NB,NZ,NY,NX).GT.VRNE)THEN - VRNF(NB,NZ,NY,NX)=VRNZ(NB,NZ,NY,NX) - ENDIF - ELSEIF(IWTYP(NZ,NY,NX).EQ.5)THEN - IF(VRNY(NB,NZ,NY,NX).GT.VRNE)THEN - VRNF(NB,NZ,NY,NX)=VRNY(NB,NZ,NY,NX) - ENDIF - ENDIF - IF(VRNF(NB,NZ,NY,NX).GE.VRNX(NB,NZ,NY,NX) - 2.AND.IFLGE(NB,NZ,NY,NX).EQ.1)THEN - VRNS(NB,NZ,NY,NX)=0.0 - IFLGE(NB,NZ,NY,NX)=0 - ENDIF - ENDIF -C -C CALCULATE WINTER AND DROUGHT DECIDUOUS PHENOLOGY BY ACCUMULATING HOURS -C IN SPECIFIED TEMPERATURE RANGES DURING LENGTHENING PHOTOPERIODS -C - ELSEIF(IWTYP(NZ,NY,NX).EQ.3)THEN - IF((DYLN(NY,NX).GE.DYLX(NY,NX).OR.DYLN(NY,NX).GE.DYLM(NY,NX)-2.0) - 2.AND.IFLGE(NB,NZ,NY,NX).EQ.0)THEN - IF(TCG(NZ,NY,NX).GE.TCZ(NZ,NY,NX) - 2.AND.PSILG(NZ,NY,NX).GT.PSILM)THEN - VRNS(NB,NZ,NY,NX)=VRNS(NB,NZ,NY,NX)+1.0 - ENDIF - IF(VRNS(NB,NZ,NY,NX).LT.VRNL(NB,NZ,NY,NX))THEN - IF(TCG(NZ,NY,NX).LT.CTC(NZ,NY,NX) - 2.OR.PSILG(NZ,NY,NX).LT.PSILM)THEN - VRNS(NB,NZ,NY,NX)=AMAX1(0.0,VRNS(NB,NZ,NY,NX)-1.5) - ENDIF - ENDIF - IF(VRNS(NB,NZ,NY,NX).GE.VRNL(NB,NZ,NY,NX))THEN - VRNF(NB,NZ,NY,NX)=0.0 - IF(IDAY(2,NB,NZ,NY,NX).NE.0)IFLGF(NB,NZ,NY,NX)=0 - ENDIF - ENDIF - IF(IDAY(2,NB,NZ,NY,NX).NE.0)IFLGF(NB,NZ,NY,NX)=0 -C WRITE(*,4647)'VRNS',I,J,NZ,NB,VRNS(NB,NZ,NY,NX),TCG(NZ,NY,NX) -C 2,TCZ(NZ,NY,NX),PSILG(NZ,NY,NX),PSILM,CTC(NZ,NY,NX) -C 3,DYLN(NY,NX),DYLX(NY,NX),DYLM(NY,NX),VRNL(NB,NZ,NY,NX) -4647 FORMAT(A8,4I4,20E12.4) -C -C CALCULATE WINTER AND DROUGHT DECIDUOUS PHENOLOGY BY ACCUMULATING HOURS -C IN SPECIFIED TEMPERATURE RANGES DURING SHORTENING PHOTOPERIODS -C - IF((DYLN(NY,NX).LT.DYLX(NY,NX).OR.DYLN(NY,NX) - 2.LT.24.0-DYLM(NY,NX)+2.0).AND.IFLGF(NB,NZ,NY,NX).EQ.0)THEN - IF(TCG(NZ,NY,NX).LE.TCX(NZ,NY,NX) - 2.OR.PSILT(NZ,NY,NX).LT.PSILY(IGTYP(NZ,NY,NX)))THEN - VRNF(NB,NZ,NY,NX)=VRNF(NB,NZ,NY,NX)+1.0 - ENDIF - IF(VRNF(NB,NZ,NY,NX).GE.VRNX(NB,NZ,NY,NX) - 2.AND.IFLGE(NB,NZ,NY,NX).EQ.1)THEN - VRNS(NB,NZ,NY,NX)=0.0 - IFLGE(NB,NZ,NY,NX)=0 - ENDIF - ENDIF - ENDIF - ENDIF -2010 CONTINUE -C -C WATER STRESS INDICATOR -C - IF(PSILT(NZ,NY,NX).LT.PSILY(IGTYP(NZ,NY,NX)))THEN - WSTR(NZ,NY,NX)=WSTR(NZ,NY,NX)+1.0 - ENDIF - ENDIF - ENDIF - ENDIF -9985 CONTINUE -9990 CONTINUE -9995 CONTINUE - RETURN - END + + SUBROUTINE hfunc(I,J,NHW,NHE,NVN,NVS) +C +C THIS SUBROUTINE CALCULATES PLANT PHENOLOGY +C + include "parameters.h" + include "filec.h" + include "files.h" + include "blkc.h" + include "blk1cp.h" + include "blk1cr.h" + include "blk1g.h" + include "blk1n.h" + include "blk1p.h" + include "blk2a.h" + include "blk2b.h" + include "blk2c.h" + include "blk3.h" + include "blk8a.h" + include "blk8b.h" + include "blk9a.h" + include "blk9b.h" + include "blk9c.h" + include "blk11a.h" + include "blk11b.h" + include "blk12a.h" + include "blk12b.h" + include "blk16.h" + include "blk18a.h" + include "blk18b.h" + DIMENSION NBX(0:3),PSILY(0:2) + 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 + PARAMETER (PSILM=0.1,PSILX=-0.2) + PARAMETER(GSTGG=2.00,GSTGR=0.667,FVRN=0.5,VRNE=3600.0) + DATA PSILY/-200.0,-2.0,-2.0/ + DATA NBX /5,1,1,1/ + DO 9995 NX=NHW,NHE + DO 9990 NY=NVN,NVS + DO 9985 NZ=1,NP(NY,NX) +C WRITE(*,4444)'IFLGC',I,J,NX,NY,NZ,DATAP(NZ,NY,NX) +C 2,IDAY0(NZ,NY,NX),IDAYH(NZ,NY,NX),IYRC,IYRH(NZ,NY,NX) +C 3,IDTH(NZ,NY,NX),IYR0(NZ,NY,NX),IFLGC(NZ,NY,NX),IFLGT(NY,NX) +4444 FORMAT(A8,5I8,A16,20I8) + IF(DATAP(NZ,NY,NX).NE.'NO')THEN + PPT(NY,NX)=PPT(NY,NX)+PP(NZ,NY,NX) +C +C SET CROP FLAG ACCORDING TO PLANTING, HARVEST DATES, DEATH, +C 1 = ALIVE, 0 = NOT ALIVE +C + IF(J.EQ.1)THEN + IF(IDAY0(NZ,NY,NX).LE.IDAYH(NZ,NY,NX) + 3.OR.IYR0(NZ,NY,NX).LT.IYRH(NZ,NY,NX))THEN + IF(I.GE.IDAY0(NZ,NY,NX).OR.IDATA(3).GT.IYR0(NZ,NY,NX))THEN + IF(I.GT.IDAYH(NZ,NY,NX).AND.IYRC.GE.IYRH(NZ,NY,NX) + 2.AND.IDTH(NZ,NY,NX).EQ.1)THEN + IFLGC(NZ,NY,NX)=0 + ELSE + IF(I.EQ.IDAY0(NZ,NY,NX).AND.IDATA(3).EQ.IYR0(NZ,NY,NX))THEN + IFLGC(NZ,NY,NX)=0 + IDTH(NZ,NY,NX)=0 + CALL STARTQ(NX,NX,NY,NY,NZ,NZ) + TNBP(NY,NX)=TNBP(NY,NX)+WTRVX(NZ,NY,NX) + ENDIF + IF(DATAP(NZ,NY,NX).NE.'NO'.AND.IDTH(NZ,NY,NX).EQ.0) + 2IFLGC(NZ,NY,NX)=1 + ENDIF + ELSE + IFLGC(NZ,NY,NX)=0 + ENDIF + ELSE + IF((I.LT.IDAY0(NZ,NY,NX).AND.I.GT.IDAYH(NZ,NY,NX) + 2.AND.IYRC.GE.IYRH(NZ,NY,NX).AND.IDTH(NZ,NY,NX).EQ.1) + 3.OR.(I.LT.IDAY0(NZ,NY,NX).AND.IYR0(NZ,NY,NX) + 4.GT.IYRH(NZ,NY,NX)))THEN + IFLGC(NZ,NY,NX)=0 + ELSE + IF(I.EQ.IDAY0(NZ,NY,NX).AND.IDATA(3).EQ.IYR0(NZ,NY,NX))THEN + IFLGC(NZ,NY,NX)=0 + IDTH(NZ,NY,NX)=0 + CALL STARTQ(NX,NX,NY,NY,NZ,NZ) + TNBP(NY,NX)=TNBP(NY,NX)+WTRVX(NZ,NY,NX) + ENDIF + IF(DATAP(NZ,NY,NX).NE.'NO'.AND.IDTH(NZ,NY,NX).EQ.0) + 2IFLGC(NZ,NY,NX)=1 + ENDIF + ENDIF + IFLGT(NY,NX)=IFLGT(NY,NX)+IFLGC(NZ,NY,NX) + ENDIF + IF(IFLGC(NZ,NY,NX).EQ.1)THEN + RCO2Z(NZ,NY,NX)=0.0 + ROXYZ(NZ,NY,NX)=0.0 + RCH4Z(NZ,NY,NX)=0.0 + RN2OZ(NZ,NY,NX)=0.0 + RNH3Z(NZ,NY,NX)=0.0 + RH2GZ(NZ,NY,NX)=0.0 + CPOOLP(NZ,NY,NX)=0.0 + ZPOOLP(NZ,NY,NX)=0.0 + PPOOLP(NZ,NY,NX)=0.0 + NI(NZ,NY,NX)=NIX(NZ,NY,NX) + NG(NZ,NY,NX)=MIN(NI(NZ,NY,NX),MAX(NG(NZ,NY,NX),NU(NY,NX))) + NB1(NZ,NY,NX)=1 + NBTX=1.0E+06 +C +C TOTAL PLANT NON-STRUCTURAL C, N, P +C + DO 140 NB=1,NBR(NZ,NY,NX) + IF(IDTHB(NB,NZ,NY,NX).EQ.0)THEN + CPOOLP(NZ,NY,NX)=CPOOLP(NZ,NY,NX)+CPOOL(NB,NZ,NY,NX) + ZPOOLP(NZ,NY,NX)=ZPOOLP(NZ,NY,NX)+ZPOOL(NB,NZ,NY,NX) + PPOOLP(NZ,NY,NX)=PPOOLP(NZ,NY,NX)+PPOOL(NB,NZ,NY,NX) + CPOLNP(NZ,NY,NX)=CPOLNP(NZ,NY,NX)+CPOLNB(NB,NZ,NY,NX) + ZPOLNP(NZ,NY,NX)=ZPOLNP(NZ,NY,NX)+ZPOLNB(NB,NZ,NY,NX) + PPOLNP(NZ,NY,NX)=PPOLNP(NZ,NY,NX)+PPOLNB(NB,NZ,NY,NX) + IF(NBTB(NB,NZ,NY,NX).LT.NBTX)THEN + NB1(NZ,NY,NX)=NB + NBTX=NBTB(NB,NZ,NY,NX) + ENDIF + ENDIF +140 CONTINUE +C +C NON-STRUCTURAL C, N, P CONCENTRATIONS IN ROOT +C + DO 180 N=1,MY(NZ,NY,NX) + DO 160 L=NU(NY,NX),NI(NZ,NY,NX) + IF(WTRTL(N,L,NZ,NY,NX).GT.ZEROL(NZ,NY,NX))THEN + CCPOLR(N,L,NZ,NY,NX)=AMAX1(0.0,CPOOLR(N,L,NZ,NY,NX) + 2/WTRTL(N,L,NZ,NY,NX)) + CZPOLR(N,L,NZ,NY,NX)=AMAX1(0.0,ZPOOLR(N,L,NZ,NY,NX) + 2/WTRTL(N,L,NZ,NY,NX)) + CPPOLR(N,L,NZ,NY,NX)=AMAX1(0.0,PPOOLR(N,L,NZ,NY,NX) + 2/WTRTL(N,L,NZ,NY,NX)) +C CCPOLR(N,L,NZ,NY,NX)=AMIN1(1.0,CCPOLR(N,L,NZ,NY,NX)) + ELSE + CCPOLR(N,L,NZ,NY,NX)=1.0 + CZPOLR(N,L,NZ,NY,NX)=1.0 + CPPOLR(N,L,NZ,NY,NX)=1.0 + ENDIF +160 CONTINUE +180 CONTINUE +C +C NON-STRUCTURAL C, N, P CONCENTRATIONS IN SHOOT +C + IF(WTLS(NZ,NY,NX).GT.ZEROL(NZ,NY,NX))THEN + CCPOLP(NZ,NY,NX)=AMAX1(0.0,AMIN1(1.0,CPOOLP(NZ,NY,NX) + 2/WTLS(NZ,NY,NX))) + CCPLNP(NZ,NY,NX)=AMAX1(0.0,AMIN1(1.0,CPOLNP(NZ,NY,NX) + 2/WTLS(NZ,NY,NX))) + CZPOLP(NZ,NY,NX)=AMAX1(0.0,AMIN1(1.0,ZPOOLP(NZ,NY,NX) + 2/WTLS(NZ,NY,NX))) + CPPOLP(NZ,NY,NX)=AMAX1(0.0,AMIN1(1.0,PPOOLP(NZ,NY,NX) + 2/WTLS(NZ,NY,NX))) + ELSE + CCPOLP(NZ,NY,NX)=1.0 + CCPLNP(NZ,NY,NX)=1.0 + CZPOLP(NZ,NY,NX)=1.0 + CPPOLP(NZ,NY,NX)=1.0 + ENDIF + DO 190 NB=1,NBR(NZ,NY,NX) + IF(WTLSB(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN + CCPOLB(NB,NZ,NY,NX)=AMAX1(0.0,CPOOL(NB,NZ,NY,NX) + 2/WTLSB(NB,NZ,NY,NX)) + CZPOLB(NB,NZ,NY,NX)=AMAX1(0.0,ZPOOL(NB,NZ,NY,NX) + 2/WTLSB(NB,NZ,NY,NX)) + CPPOLB(NB,NZ,NY,NX)=AMAX1(0.0,PPOOL(NB,NZ,NY,NX) + 2/WTLSB(NB,NZ,NY,NX)) + ELSE + CCPOLB(NB,NZ,NY,NX)=1.0 + CZPOLB(NB,NZ,NY,NX)=1.0 + CPPOLB(NB,NZ,NY,NX)=1.0 + ENDIF +190 CONTINUE +C +C EMERGENCE DATE FROM COTYLEDON HEIGHT, LEAF AREA, ROOT DEPTH +C + IF(IDAY(1,NB1(NZ,NY,NX),NZ,NY,NX).EQ.0)THEN + ARLSP=ARLFP(NZ,NY,NX)+ARSTP(NZ,NY,NX) + IF((HTCTL(NZ,NY,NX).GT.SDPTH(NZ,NY,NX)) + 2.AND.(ARLSP.GT.ZEROL(NZ,NY,NX)) + 3.AND.(RTDP1(1,1,NZ,NY,NX).GT.SDPTH(NZ,NY,NX)+1.0E-06))THEN + IDAY(1,NB1(NZ,NY,NX),NZ,NY,NX)=I + VHCPC(NZ,NY,NX)=4.19*(WTSHT(NZ,NY,NX)*10.0E-06+VOLWC(NZ,NY,NX)) + ENDIF + ENDIF +C +C ADD BRANCH TO SHOOT IF PLANT GROWTH STAGE, SHOOT NON-STRUCTURAL C +C CONCENTRATION PERMIT +C +C WRITE(*,224)'HFUNC',I,J,IFLGI(NZ,NY,NX),PP(NZ,NY,NX) +C 2,TCG(NZ,NY,NX),PSIRG(1,NG(NZ,NY,NX),NZ,NY,NX) +C 3,PSILM,ISTYP(NZ,NY,NX),IDAY(2,NB1(NZ,NY,NX),NZ,NY,NX) +C 4,NBR(NZ,NY,NX),WTRVC(NZ,NY,NX),CCPOLP(NZ,NY,NX) +C 5,PB(NZ,NY,NX),IDTHB(NB,NZ,NY,NX),NB1(NZ,NY,NX) +C 6,PSTG(NB1(NZ,NY,NX),NZ,NY,NX),NBT(NZ,NY,NX) +C 7,NNOD(NZ,NY,NX),FNOD(NZ,NY,NX),XTLI(NZ,NY,NX) +224 FORMAT(A8,3I6,5E12.4,3I6,3E12.4,2I6,1E12.4,2I6,2E12.4) + IF(IFLGI(NZ,NY,NX).EQ.0)THEN + IF(J.EQ.1.AND.PP(NZ,NY,NX).GT.0.0)THEN + IF(PSIRG(1,NG(NZ,NY,NX),NZ,NY,NX).GT.PSILM)THEN + IF(ISTYP(NZ,NY,NX).NE.0 + 2.OR.IDAY(2,NB1(NZ,NY,NX),NZ,NY,NX).EQ.0)THEN + IF((NBR(NZ,NY,NX).EQ.0.AND.WTRVC(NZ,NY,NX).GT.0.0) + 2.OR.(CCPOLP(NZ,NY,NX).GT.PB(NZ,NY,NX) + 3.AND.PB(NZ,NY,NX).GT.0.0))THEN + DO 120 NB=1,10 + IF(IDTHB(NB,NZ,NY,NX).EQ.1)THEN + IF(NB.EQ.NB1(NZ,NY,NX) + 2.OR.PSTG(NB1(NZ,NY,NX),NZ,NY,NX).GT.NBT(NZ,NY,NX) + 2+NNOD(NZ,NY,NX)/FNOD(NZ,NY,NX)+XTLI(NZ,NY,NX))THEN + NBT(NZ,NY,NX)=NBT(NZ,NY,NX)+1 + NBR(NZ,NY,NX)=MIN(NBX(IBTYP(NZ,NY,NX)),MAX(NB,NBR(NZ,NY,NX))) + NBTB(NB,NZ,NY,NX)=NBT(NZ,NY,NX)-1 + IDTHP(NZ,NY,NX)=0 + IDTHB(NB,NZ,NY,NX)=0 + VRNS(NB,NZ,NY,NX)=0.0 + IF(ISTYP(NZ,NY,NX).EQ.0)THEN + GROUP(NB,NZ,NY,NX)=AMAX1(0.0,GROUPI(NZ,NY,NX)-NBTB(NB,NZ,NY,NX)) + ELSE + GROUP(NB,NZ,NY,NX)=GROUPI(NZ,NY,NX) + ENDIF + GO TO 125 + ENDIF + ENDIF +120 CONTINUE +125 CONTINUE + ENDIF + ENDIF + ENDIF +C +C ADD AXIS TO ROOT IF PLANT GROWTH STAGE, ROOT NON-STRUCTURAL C +C CONCENTRATION PERMIT +C + IF(PSIRG(1,NG(NZ,NY,NX),NZ,NY,NX).GT.PSILM)THEN + IF(NRT(NZ,NY,NX).EQ.0.OR.PSTG(NB1(NZ,NY,NX),NZ,NY,NX) + 2.GT.NRT(NZ,NY,NX)/FNOD(NZ,NY,NX)+XTLI(NZ,NY,NX))THEN + IF((NRT(NZ,NY,NX).EQ.0.AND.WTRVC(NZ,NY,NX).GT.0.0) + 2.OR.(CCPOLP(NZ,NY,NX).GT.PR(NZ,NY,NX) + 3.AND.PR(NZ,NY,NX).GT.0.0))THEN + NRT(NZ,NY,NX)=MIN(10,NRT(NZ,NY,NX)+1) + IDTHR(NZ,NY,NX)=0 + ENDIF + ENDIF + ENDIF + ENDIF + ENDIF +2224 FORMAT(A8,6I4) +C +C THE REST OF THE SUBROUTINE MODELS THE PHENOLOGY OF EACH BRANCH +C + IF(IDAY(1,NB1(NZ,NY,NX),NZ,NY,NX).NE.0 + 2.OR.IFLGI(NZ,NY,NX).EQ.1)THEN + DO 2010 NB=1,NBR(NZ,NY,NX) + IF(IDTHB(NB,NZ,NY,NX).EQ.0)THEN + IF(IDAY(1,NB,NZ,NY,NX).EQ.0)THEN + IDAY(1,NB,NZ,NY,NX)=I + IFLGA(NB,NZ,NY,NX)=1 + IFLGE(NB,NZ,NY,NX)=0 + VRNS(NB,NZ,NY,NX)=0.5*VRNS(NB1(NZ,NY,NX),NZ,NY,NX) + ENDIF +C +C CALCULATE NODE INITIATION AND LEAF APPEARANCE RATES +C FROM TEMPERATURE FUNCTION CALCULATED IN 'UPTAKE' AND +C RATES AT 25C ENTERED IN 'READQ' EXCEPT WHEN DORMANT +C + IF(IWTYP(NZ,NY,NX).EQ.0 + 2.OR.VRNF(NB,NZ,NY,NX).LT.VRNX(NB,NZ,NY,NX))THEN + TKCO=TKG(NZ,NY,NX)+OFFST(NZ,NY,NX) + RTK=8.3143*TKCO + STK=710.0*TKCO + ACTV=1+EXP((197500-STK)/RTK)+EXP((STK-222500)/RTK) + TFNP=EXP(25.229-62500/RTK)/ACTV + RNI=AMAX1(0.0,TFNP*XRNI(NZ,NY,NX)) + RLA=AMAX1(0.0,TFNP*XRLA(NZ,NY,NX)) +C +C NODE INITIATION AND LEAF APPEARANCE RATES SLOWED BY LOW TURGOR +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 + RNI=RNI*WFNSP + RLA=RLA*WFNSP + ENDIF +C +C ACCUMULATE NODE INITIATION AND LEAF APPEARANCE RATES +C INTO TOTAL NUMBER OF NODES AND LEAVES +C + PSTG(NB,NZ,NY,NX)=PSTG(NB,NZ,NY,NX)+RNI + VSTG(NB,NZ,NY,NX)=VSTG(NB,NZ,NY,NX)+RLA +C +C USE TOTAL NUMBER OF NODES TO CALCULATE PROGRESSION THROUGH +C VEGETATIVE AND REPRODUCTIVE GROWTH STAGES. THIS PROGRESSION +C IS USED TO SET START AND END DATES FOR GROWTH STAGES BELOW +C + IF(IDAY(2,NB,NZ,NY,NX).NE.0)THEN + GSTGI(NB,NZ,NY,NX)=(PSTG(NB,NZ,NY,NX)-PSTGI(NB,NZ,NY,NX)) + 2/GROUPI(NZ,NY,NX) + DGSTGI(NB,NZ,NY,NX)=RNI/(GROUPI(NZ,NY,NX)*GSTGG) + TGSTGI(NB,NZ,NY,NX)=TGSTGI(NB,NZ,NY,NX)+DGSTGI(NB,NZ,NY,NX) + ENDIF + IF(IDAY(6,NB,NZ,NY,NX).NE.0)THEN + GSTGF(NB,NZ,NY,NX)=(PSTG(NB,NZ,NY,NX)-PSTGF(NB,NZ,NY,NX)) + 2/GROUPI(NZ,NY,NX) + DGSTGF(NB,NZ,NY,NX)=RNI/(GROUPI(NZ,NY,NX)*GSTGR) + TGSTGF(NB,NZ,NY,NX)=TGSTGF(NB,NZ,NY,NX)+DGSTGF(NB,NZ,NY,NX) + ENDIF + IFLGG(NB,NZ,NY,NX)=1 + ELSE + IFLGG(NB,NZ,NY,NX)=0 + ENDIF +C +C REPRODUCTIVE GROWTH STAGES ADVANCE WHEN THRESHOLD NUMBER +C OF NODES HAVE BEEN INITIATED. FIRST DETERMINE PHOTOPERIOD +C AND TEMPERATURE EFFECTS ON FINAL VEG NODE NUMBER FROM +C NUMBER OF INITIATED NODES +C + IF(IDAY(2,NB,NZ,NY,NX).EQ.0)THEN + IF(PSTG(NB,NZ,NY,NX).GT.GROUP(NB,NZ,NY,NX)+PSTGI(NB,NZ,NY,NX) + 2.AND.((VRNS(NB,NZ,NY,NX).GE.VRNL(NB,NZ,NY,NX)) + 2.OR.(I.GE.IDAY0(NZ,NY,NX).AND.IYRC.EQ.IYR0(NZ,NY,NX) + 2.AND.DYLN(NY,NX).GT.DYLX(NY,NX))) + 3.OR.(((ISTYP(NZ,NY,NX).EQ.1.AND.(IWTYP(NZ,NY,NX).EQ.1 + 4.OR.IWTYP(NZ,NY,NX).EQ.3)) + 5.OR.(ISTYP(NZ,NY,NX).EQ.0.AND.IWTYP(NZ,NY,NX).EQ.0)) + 6.AND.ZC(NZ,NY,NX).GT.DPTHS(NY,NX) + 7.AND.DYLN(NY,NX).LT.DYLX(NY,NX)))THEN +C +C FINAL VEGETATIVE NODE NUMBER DEPENDS ON PHOTOPERIOD FROM 'DAY' +C AND ON MATURITY GROUP, CRITICAL PHOTOPERIOD AND PHOTOPERIOD +C SENSITIVITY ENTERED IN 'READQ' +C + IF(IPTYP(NZ,NY,NX).EQ.0)THEN + PPD=0.0 + ELSE + PPD=AMAX1(0.0,XDL(NZ,NY,NX)-DYLN(NY,NX)) + IF(IPTYP(NZ,NY,NX).EQ.1.AND.DYLN(NY,NX).GE.DYLX(NY,NX))PPD=0.0 + ENDIF +C IF(NZ.EQ.1)THEN +C WRITE(*,333)'IDAY2',I,J,NZ,NB,IDAY(2,NB,NZ,NY,NX),IDAY0(NZ,NY,NX) +C 2,IYR0(NZ,NY,NX),IPTYP(NZ,NY,NX) +C 2,PPD,XDL(NZ,NY,NX),DYLN(NY,NX),DYLX(NY,NX),VRNS(NB,NZ,NY,NX) +C 3,VRNL(NB,NZ,NY,NX),PSTG(NB,NZ,NY,NX),GROUP(NB,NZ,NY,NX) +C 4,PSTGI(NB,NZ,NY,NX),XPPD(NZ,NY,NX) +333 FORMAT(A8,8I4,20E12.4) +C ENDIF + IF(IPTYP(NZ,NY,NX).EQ.0 + 2.OR.(IPTYP(NZ,NY,NX).EQ.1.AND.PPD.GT.XPPD(NZ,NY,NX)) + 3.OR.(IPTYP(NZ,NY,NX).EQ.2.AND.PPD.LT.XPPD(NZ,NY,NX)) + 3.OR.(((ISTYP(NZ,NY,NX).EQ.1.AND.(IWTYP(NZ,NY,NX).EQ.1 + 4.OR.IWTYP(NZ,NY,NX).EQ.3)) + 5.OR.(ISTYP(NZ,NY,NX).EQ.0.AND.IWTYP(NZ,NY,NX).EQ.0)) + 6.AND.ZC(NZ,NY,NX).GT.DPTHS(NY,NX) + 7.AND.DYLN(NY,NX).LT.DYLX(NY,NX)))THEN + IDAY(2,NB,NZ,NY,NX)=I + PSTGI(NB,NZ,NY,NX)=PSTG(NB,NZ,NY,NX) + IF(ISTYP(NZ,NY,NX).EQ.0.AND.IDTYP(NZ,NY,NX).EQ.0)THEN + VSTGX(NB,NZ,NY,NX)=PSTG(NB,NZ,NY,NX) + ENDIF + ENDIF + ENDIF +C +C STEM ELONGATION +C + ELSEIF(IDAY(3,NB,NZ,NY,NX).EQ.0)THEN + IF(GSTGI(NB,NZ,NY,NX).GT.0.25*GSTGG + 2.OR.((IWTYP(NZ,NY,NX).EQ.1.OR.IWTYP(NZ,NY,NX).EQ.3) + 3.AND.ISTYP(NZ,NY,NX).NE.0.AND.IPTYP(NZ,NY,NX).NE.1 + 3.AND.DYLN(NY,NX).LT.DYLX(NY,NX).AND.IFLGE(NB,NZ,NY,NX).EQ.1 + 4.AND.VRNF(NB,NZ,NY,NX).GT.VRNX(NB,NZ,NY,NX)) + 5.OR.(IWTYP(NZ,NY,NX).EQ.2.AND.ISTYP(NZ,NY,NX).EQ.0) + 6.AND.IFLGE(NB,NZ,NY,NX).EQ.1 + 7.AND.VRNF(NB,NZ,NY,NX).GT.VRNX(NB,NZ,NY,NX))THEN + IDAY(3,NB,NZ,NY,NX)=I + ENDIF + ELSEIF(IDAY(4,NB,NZ,NY,NX).EQ.0)THEN + IF(GSTGI(NB,NZ,NY,NX).GT.0.50*GSTGG + 2.OR.((IWTYP(NZ,NY,NX).EQ.1.OR.IWTYP(NZ,NY,NX).EQ.3) + 3.AND.ISTYP(NZ,NY,NX).NE.0.AND.IPTYP(NZ,NY,NX).NE.1 + 3.AND.DYLN(NY,NX).LT.DYLX(NY,NX).AND.IFLGE(NB,NZ,NY,NX).EQ.1 + 4.AND.VRNF(NB,NZ,NY,NX).GT.VRNX(NB,NZ,NY,NX)) + 5.OR.(IWTYP(NZ,NY,NX).EQ.2.AND.ISTYP(NZ,NY,NX).EQ.0) + 6.AND.IFLGE(NB,NZ,NY,NX).EQ.1 + 7.AND.VRNF(NB,NZ,NY,NX).GT.VRNX(NB,NZ,NY,NX))THEN + IDAY(4,NB,NZ,NY,NX)=I + IF(ISTYP(NZ,NY,NX).EQ.0.AND.IDTYP(NZ,NY,NX).NE.0)THEN + VSTGX(NB,NZ,NY,NX)=PSTG(NB,NZ,NY,NX) + ENDIF + ENDIF + ELSEIF(IDAY(5,NB,NZ,NY,NX).EQ.0)THEN + IF(GSTGI(NB,NZ,NY,NX).GT.1.00*GSTGG + 2.OR.((IWTYP(NZ,NY,NX).EQ.1.OR.IWTYP(NZ,NY,NX).EQ.3) + 3.AND.ISTYP(NZ,NY,NX).NE.0.AND.IPTYP(NZ,NY,NX).NE.1 + 3.AND.DYLN(NY,NX).LT.DYLX(NY,NX).AND.IFLGE(NB,NZ,NY,NX).EQ.1 + 4.AND.VRNF(NB,NZ,NY,NX).GT.VRNX(NB,NZ,NY,NX)) + 5.OR.(IWTYP(NZ,NY,NX).EQ.2.AND.ISTYP(NZ,NY,NX).EQ.0) + 6.AND.IFLGE(NB,NZ,NY,NX).EQ.1 + 7.AND.VRNF(NB,NZ,NY,NX).GT.VRNX(NB,NZ,NY,NX))THEN + IDAY(5,NB,NZ,NY,NX)=I + ENDIF +C +C ANTHESIS OCCURS WHEN THE NUMBER OF LEAVES THAT HAVE APPEARED +C EQUALS THE NUMBER OF NODES INITIATED WHEN THE FINAL VEGETATIVE +C NODE NUMBER WAS SET ABOVE +C + ELSEIF(IDAY(6,NB,NZ,NY,NX).EQ.0)THEN + IF((VSTG(NB,NZ,NY,NX).GT.PSTGI(NB,NZ,NY,NX)) + 2.OR.(ISTYP(NZ,NY,NX).NE.0.AND.IDAY(5,NB,NZ,NY,NX).NE.0) + 2.OR.((IWTYP(NZ,NY,NX).EQ.1.OR.IWTYP(NZ,NY,NX).EQ.3) + 3.AND.ISTYP(NZ,NY,NX).NE.0.AND.IPTYP(NZ,NY,NX).NE.1 + 3.AND.DYLN(NY,NX).LT.DYLX(NY,NX).AND.IFLGE(NB,NZ,NY,NX).EQ.1 + 4.AND.VRNF(NB,NZ,NY,NX).GT.VRNX(NB,NZ,NY,NX)) + 5.OR.(IWTYP(NZ,NY,NX).EQ.2.AND.ISTYP(NZ,NY,NX).EQ.0) + 6.AND.IFLGE(NB,NZ,NY,NX).EQ.1 + 7.AND.VRNF(NB,NZ,NY,NX).GT.VRNX(NB,NZ,NY,NX))THEN + IF(NB.EQ.NB1(NZ,NY,NX) + 2.OR.IDAY(6,NB1(NZ,NY,NX),NZ,NY,NX).NE.0)THEN + IDAY(6,NB,NZ,NY,NX)=I + PSTGF(NB,NZ,NY,NX)=PSTG(NB,NZ,NY,NX) + ENDIF + ENDIF +C +C START GRAIN FILL PERIOD +C + ELSEIF(IDAY(7,NB,NZ,NY,NX).EQ.0)THEN + IF(GSTGF(NB,NZ,NY,NX).GT.0.50*GSTGR + 2.OR.((IWTYP(NZ,NY,NX).EQ.1.OR.IWTYP(NZ,NY,NX).EQ.3) + 3.AND.ISTYP(NZ,NY,NX).NE.0.AND.IPTYP(NZ,NY,NX).NE.1 + 3.AND.DYLN(NY,NX).LT.DYLX(NY,NX).AND.IFLGE(NB,NZ,NY,NX).EQ.1 + 4.AND.VRNF(NB,NZ,NY,NX).GT.VRNX(NB,NZ,NY,NX)) + 5.OR.(IWTYP(NZ,NY,NX).EQ.2.AND.ISTYP(NZ,NY,NX).EQ.0) + 6.AND.IFLGE(NB,NZ,NY,NX).EQ.1 + 7.AND.VRNF(NB,NZ,NY,NX).GT.VRNX(NB,NZ,NY,NX))THEN + IDAY(7,NB,NZ,NY,NX)=I +C IF(IWTYP(NZ,NY,NX).NE.0.AND.NB.EQ.NB1(NZ,NY,NX))THEN +C DO 1500 NBB=1,NBR(NZ,NY,NX) +C IF(NBB.NE.NB.AND.IDAY(5,NBB,NZ,NY,NX).EQ.0)THEN +C IDAY(5,NBB,NZ,NY,NX)=I +C PSTGF(NBB,NZ,NY,NX)=PSTG(NBB,NZ,NY,NX) +C ENDIF +1500 CONTINUE +C ENDIF + ENDIF +C +C END SEED NUMBER SET PERIOD +C + ELSEIF(IDAY(8,NB,NZ,NY,NX).EQ.0)THEN + IF(GSTGF(NB,NZ,NY,NX).GT.1.00*GSTGR)THEN + IDAY(8,NB,NZ,NY,NX)=I +C IF(IWTYP(NZ,NY,NX).NE.0.AND.NB.EQ.NB1(NZ,NY,NX))THEN +C DO 1495 NBB=1,NBR(NZ,NY,NX) +C IF(NBB.NE.NB.AND.IDAY(6,NBB,NZ,NY,NX).EQ.0)THEN +C IDAY(6,NBB,NZ,NY,NX)=I +C ENDIF +1495 CONTINUE +C ENDIF + ENDIF +C +C END SEED SIZE SET PERIOD +C + ELSEIF(IDAY(9,NB,NZ,NY,NX).EQ.0)THEN + IF(GSTGF(NB,NZ,NY,NX).GT.1.50*GSTGR)THEN + IDAY(9,NB,NZ,NY,NX)=I + ENDIF + ENDIF + ENDIF + KVSTGX=KVSTG(NB,NZ,NY,NX) + IF(VSTGX(NB,NZ,NY,NX).LE.1.0E-06)THEN + KVSTG(NB,NZ,NY,NX)=INT(VSTG(NB,NZ,NY,NX))+1 + ELSE + KVSTG(NB,NZ,NY,NX)=INT(AMIN1(VSTG(NB,NZ,NY,NX) + 2,VSTGX(NB,NZ,NY,NX)))+1 + ENDIF + KLEAF(NB,NZ,NY,NX)=MIN(24,KVSTG(NB,NZ,NY,NX)) + IF(KVSTG(NB,NZ,NY,NX).GT.KVSTGX)THEN + IFLGP(NB,NZ,NY,NX)=1 + ELSE + IFLGP(NB,NZ,NY,NX)=0 + ENDIF +C +C PHENOLOGY +C + IF(IDTHB(NB,NZ,NY,NX).EQ.0.OR.IFLGI(NZ,NY,NX).EQ.1)THEN + IF(DYLN(NY,NX).GE.DYLX(NY,NX))THEN + VRNY(NB,NZ,NY,NX)=VRNY(NB,NZ,NY,NX)+1.0 + VRNZ(NB,NZ,NY,NX)=0.0 + ELSE + VRNY(NB,NZ,NY,NX)=0.0 + VRNZ(NB,NZ,NY,NX)=VRNZ(NB,NZ,NY,NX)+1.0 + ENDIF +C +C CALCULATE PHENOLOGY DURING LENGTHENING PHOTOPERIODS +C + IF(IWTYP(NZ,NY,NX).EQ.0)THEN + IF(DYLN(NY,NX).GE.DYLX(NY,NX))THEN + VRNS(NB,NZ,NY,NX)=VRNY(NB,NZ,NY,NX) + IF(VRNS(NB,NZ,NY,NX).GE.VRNL(NB,NZ,NY,NX) + 2.OR.(ALAT(NY,NX).GT.0.0.AND.I.EQ.173) + 3.OR.(ALAT(NY,NX).LT.0.0.AND.I.EQ.355))THEN + VRNF(NB,NZ,NY,NX)=0.0 + IFLGF(NB,NZ,NY,NX)=0 + ENDIF + ENDIF +C +C CALCULATE EVERGREEN PHENOLOGY DURING SHORTENING PHOTOPERIODS +C + IF(DYLN(NY,NX).LT.DYLX(NY,NX))THEN + VRNF(NB,NZ,NY,NX)=VRNZ(NB,NZ,NY,NX) + IF(VRNF(NB,NZ,NY,NX).GE.VRNX(NB,NZ,NY,NX) + 2.OR.(ALAT(NY,NX).GT.0.0.AND.I.EQ.355) + 3.OR.(ALAT(NY,NX).LT.0.0.AND.I.EQ.173))THEN + VRNS(NB,NZ,NY,NX)=0.0 + IFLGE(NB,NZ,NY,NX)=0 + ENDIF + ENDIF +C +C CALCULATE WINTER DECIDUOUS PHENOLOGY BY ACCUMULATING HOURS ABOVE +C SPECIFIED TEMPERATURE DURING LENGTHENING PHOTOPERIODS +C + ELSEIF(IWTYP(NZ,NY,NX).EQ.1)THEN + IF((DYLN(NY,NX).GE.DYLX(NY,NX) + 2.OR.(DYLN(NY,NX).LT.DYLX(NY,NX) + 3.AND.VRNF(NB,NZ,NY,NX).LT.VRNX(NB,NZ,NY,NX))) + 4.AND.IFLGE(NB,NZ,NY,NX).EQ.0)THEN + IF(TCG(NZ,NY,NX).GE.TCZ(NZ,NY,NX))THEN + VRNS(NB,NZ,NY,NX)=VRNS(NB,NZ,NY,NX)+1.0 + ENDIF + IF(VRNS(NB,NZ,NY,NX).LT.VRNL(NB,NZ,NY,NX))THEN + IF(TCG(NZ,NY,NX).LT.CTC(NZ,NY,NX))THEN + VRNS(NB,NZ,NY,NX)=AMAX1(0.0,VRNS(NB,NZ,NY,NX)-1.0) + ENDIF + ENDIF + IF(VRNS(NB,NZ,NY,NX).GE.VRNL(NB,NZ,NY,NX) + 2.OR.(ALAT(NY,NX).GT.0.0.AND.I.EQ.173) + 3.OR.(ALAT(NY,NX).LT.0.0.AND.I.EQ.355))THEN + VRNF(NB,NZ,NY,NX)=0.0 + ENDIF + ENDIF + IF(IDAY(2,NB,NZ,NY,NX).NE.0.OR.(DYLN(NY,NX).LT.DYLX(NY,NX) + 2.AND.DYLN(NY,NX).LT.12.0))THEN + IFLGF(NB,NZ,NY,NX)=0 + ENDIF +C +C CALCULATE WINTER DECIDUOUS PHENOLOGY BY ACCUMULATING HOURS BELOW +C SPECIFIED TEMPERATURE DURING SHORTENING PHOTOPERIODS +C + IF(DYLN(NY,NX).LT.DYLX(NY,NX) + 2.AND.IFLGF(NB,NZ,NY,NX).EQ.0 + 2.AND.IDAY(2,NB,NZ,NY,NX).NE.0)THEN + IF(TCG(NZ,NY,NX).LE.TCX(NZ,NY,NX))THEN + VRNF(NB,NZ,NY,NX)=VRNF(NB,NZ,NY,NX)+1.0 + ENDIF + IF(VRNF(NB,NZ,NY,NX).GE.VRNX(NB,NZ,NY,NX) + 2.AND.IFLGE(NB,NZ,NY,NX).EQ.1)THEN + VRNS(NB,NZ,NY,NX)=0.0 + IFLGE(NB,NZ,NY,NX)=0 + ENDIF + ENDIF +C WRITE(*,4646)'VRNS',I,J,NZ,NB,IDAY(2,NB,NZ,NY,NX) +C 2,IFLGE(NB,NZ,NY,NX),IFLGF(NB,NZ,NY,NX),VRNS(NB,NZ,NY,NX) +C 2,TCG(NZ,NY,NX),TCZ(NZ,NY,NX),TCX(NZ,NY,NX),PSILG(NZ,NY,NX) +C 3,DYLN(NY,NX),DYLX(NY,NX),DYLM(NY,NX),VRNF(NB,NZ,NY,NX) +C 4,VRNL(NB,NZ,NY,NX),VRNX(NB,NZ,NY,NX) +4646 FORMAT(A8,7I4,20E12.4) +C +C CALCULATE DROUGHT DECIDUOUS PHENOLOGY BY ACCUMULATING HOURS ABOVE +C SPECIFIED WATER POTENTIAL DURING DORMANCY +C + ELSEIF(IWTYP(NZ,NY,NX).EQ.2.OR.IWTYP(NZ,NY,NX).EQ.4 + 2.OR.IWTYP(NZ,NY,NX).EQ.5)THEN + IF(IFLGE(NB,NZ,NY,NX).EQ.0)THEN + IF(PSILT(NZ,NY,NX).GE.PSILX)THEN + VRNS(NB,NZ,NY,NX)=VRNS(NB,NZ,NY,NX)+1.0 + ENDIF + IF(VRNS(NB,NZ,NY,NX).LT.VRNL(NB,NZ,NY,NX))THEN + IF(PSILT(NZ,NY,NX).LT.PSILY(IGTYP(NZ,NY,NX)))THEN + VRNS(NB,NZ,NY,NX)=AMAX1(0.0,VRNS(NB,NZ,NY,NX)-12.0) + ENDIF + ENDIF + IF(VRNS(NB,NZ,NY,NX).GE.VRNL(NB,NZ,NY,NX))THEN + VRNF(NB,NZ,NY,NX)=0.0 + IF(IDAY(2,NB,NZ,NY,NX).NE.0)IFLGF(NB,NZ,NY,NX)=0 + ENDIF + ENDIF + IF(IDAY(2,NB,NZ,NY,NX).NE.0)IFLGF(NB,NZ,NY,NX)=0 +C +C CALCULATE DROUGHT DECIDUOUS PHENOLOGY BY ACCUMULATING HOURS BELOW +C SPECIFIED WATER POTENTIAL DURING GROWING SEASON +C + IF(IFLGE(NB,NZ,NY,NX).EQ.1 + 3.AND.IFLGF(NB,NZ,NY,NX).EQ.0)THEN + IF(PSILT(NZ,NY,NX).LT.PSILY(IGTYP(NZ,NY,NX)))THEN + VRNF(NB,NZ,NY,NX)=VRNF(NB,NZ,NY,NX)+1.0 + ENDIF + IF(IWTYP(NZ,NY,NX).EQ.4)THEN + IF(VRNZ(NB,NZ,NY,NX).GT.VRNE)THEN + VRNF(NB,NZ,NY,NX)=VRNZ(NB,NZ,NY,NX) + ENDIF + ELSEIF(IWTYP(NZ,NY,NX).EQ.5)THEN + IF(VRNY(NB,NZ,NY,NX).GT.VRNE)THEN + VRNF(NB,NZ,NY,NX)=VRNY(NB,NZ,NY,NX) + ENDIF + ENDIF + IF(VRNF(NB,NZ,NY,NX).GE.VRNX(NB,NZ,NY,NX) + 2.AND.IFLGE(NB,NZ,NY,NX).EQ.1)THEN + VRNS(NB,NZ,NY,NX)=0.0 + IFLGE(NB,NZ,NY,NX)=0 + ENDIF + ENDIF +C +C CALCULATE WINTER AND DROUGHT DECIDUOUS PHENOLOGY BY ACCUMULATING +C HOURS ABOVE SPECIFIED TEMPERATURE OR WATER POTENTIAL DURING +C LENGTHENING PHOTOPERIODS +C + ELSEIF(IWTYP(NZ,NY,NX).EQ.3)THEN + IF((DYLN(NY,NX).GE.DYLX(NY,NX).OR.DYLN(NY,NX).GE.DYLM(NY,NX)-2.0) + 2.AND.IFLGE(NB,NZ,NY,NX).EQ.0)THEN + IF(TCG(NZ,NY,NX).GE.TCZ(NZ,NY,NX) + 2.AND.PSILG(NZ,NY,NX).GT.PSILM)THEN + VRNS(NB,NZ,NY,NX)=VRNS(NB,NZ,NY,NX)+1.0 + ENDIF + IF(VRNS(NB,NZ,NY,NX).LT.VRNL(NB,NZ,NY,NX))THEN + IF(TCG(NZ,NY,NX).LT.CTC(NZ,NY,NX) + 2.OR.PSILG(NZ,NY,NX).LT.PSILM)THEN + VRNS(NB,NZ,NY,NX)=AMAX1(0.0,VRNS(NB,NZ,NY,NX)-1.5) + ENDIF + ENDIF + IF(VRNS(NB,NZ,NY,NX).GE.VRNL(NB,NZ,NY,NX))THEN + VRNF(NB,NZ,NY,NX)=0.0 + IF(IDAY(2,NB,NZ,NY,NX).NE.0)IFLGF(NB,NZ,NY,NX)=0 + ENDIF + ENDIF + IF(IDAY(2,NB,NZ,NY,NX).NE.0)IFLGF(NB,NZ,NY,NX)=0 +C WRITE(*,4647)'VRNS',I,J,NZ,NB,VRNS(NB,NZ,NY,NX),TCG(NZ,NY,NX) +C 2,TCZ(NZ,NY,NX),PSILG(NZ,NY,NX),PSILM,CTC(NZ,NY,NX) +C 3,DYLN(NY,NX),DYLX(NY,NX),DYLM(NY,NX),VRNL(NB,NZ,NY,NX) +4647 FORMAT(A8,4I4,20E12.4) +C +C CALCULATE WINTER AND DROUGHT DECIDUOUS PHENOLOGY BY ACCUMULATING +C HOURS BELOW SPECIFIED TEMPERATURE OR WATER POTENTIAL DURING +C SHORTENING PHOTOPERIODS +C + IF((DYLN(NY,NX).LT.DYLX(NY,NX).OR.DYLN(NY,NX) + 2.LT.24.0-DYLM(NY,NX)+2.0).AND.IFLGF(NB,NZ,NY,NX).EQ.0)THEN + IF(TCG(NZ,NY,NX).LE.TCX(NZ,NY,NX) + 2.OR.PSILT(NZ,NY,NX).LT.PSILY(IGTYP(NZ,NY,NX)))THEN + VRNF(NB,NZ,NY,NX)=VRNF(NB,NZ,NY,NX)+1.0 + ENDIF + IF(VRNF(NB,NZ,NY,NX).GE.VRNX(NB,NZ,NY,NX) + 2.AND.IFLGE(NB,NZ,NY,NX).EQ.1)THEN + VRNS(NB,NZ,NY,NX)=0.0 + IFLGE(NB,NZ,NY,NX)=0 + ENDIF + ENDIF + ENDIF + ENDIF +2010 CONTINUE +C +C WATER STRESS INDICATOR +C + IF(PSILT(NZ,NY,NX).LT.PSILY(IGTYP(NZ,NY,NX)))THEN + WSTR(NZ,NY,NX)=WSTR(NZ,NY,NX)+1.0 + ENDIF + ENDIF + ENDIF + ENDIF +9985 CONTINUE +9990 CONTINUE +9995 CONTINUE + RETURN + END + diff --git a/f77src/hour1.f b/f77src/hour1.f index 22d5791..049cc32 100755 --- a/f77src/hour1.f +++ b/f77src/hour1.f @@ -75,8 +75,7 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) 2,FORGW=0.25E+06,HYGR=-2500.0,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/16.0E-06,16.0E-06,16.0E-06/ - DATA ZNHUX,ZNFNX/1.00,1.00/ + DATA THETRX/8.0E-06,8.0E-06,8.0E-06/ REAL*4 TFACL,TFACG,TFACW,TFACR,TFACA XJ=J DOY=I-1+XJ/24 @@ -86,6 +85,7 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) VOLWSO=0.0 HEATSO=0.0 OXYGSO=0.0 + TLH2G=0.0 TSEDSO=0.0 TLRSDC=0.0 TLORGC=0.0 @@ -167,6 +167,7 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) XN3QRW(N,NY,NX)=0.0 XNOQRW(N,NY,NX)=0.0 XNXQRS(N,NY,NX)=0.0 + XP1QRW(N,NY,NX)=0.0 XP4QRW(N,NY,NX)=0.0 XCOQSS(N,NY,NX)=0.0 XCHQSS(N,NY,NX)=0.0 @@ -176,6 +177,7 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) XN4QSS(N,NY,NX)=0.0 XN3QSS(N,NY,NX)=0.0 XNOQSS(N,NY,NX)=0.0 + XP1QSS(N,NY,NX)=0.0 XP4QSS(N,NY,NX)=0.0 IF(IERSN(NY,NX).NE.0)THEN XSEDER(N,NY,NX)=0.0 @@ -262,6 +264,7 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) XN3FLW(N,L,NY,NX)=0.0 XNOFLW(N,L,NY,NX)=0.0 XNXFLS(N,L,NY,NX)=0.0 + XH1PFS(N,L,NY,NX)=0.0 XH2PFS(N,L,NY,NX)=0.0 DO 9860 K=0,4 XOCFLS(K,N,L,NY,NX)=0.0 @@ -280,6 +283,7 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) XN3FLB(N,L,NY,NX)=0.0 XNOFLB(N,L,NY,NX)=0.0 XNXFLB(N,L,NY,NX)=0.0 + XH1BFB(N,L,NY,NX)=0.0 XH2BFB(N,L,NY,NX)=0.0 XCOFHS(N,L,NY,NX)=0.0 XCHFHS(N,L,NY,NX)=0.0 @@ -291,11 +295,13 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) XN3FHW(N,L,NY,NX)=0.0 XNOFHW(N,L,NY,NX)=0.0 XNXFHS(N,L,NY,NX)=0.0 + XH1PHS(N,L,NY,NX)=0.0 XH2PHS(N,L,NY,NX)=0.0 XN4FHB(N,L,NY,NX)=0.0 XN3FHB(N,L,NY,NX)=0.0 XNOFHB(N,L,NY,NX)=0.0 XNXFHB(N,L,NY,NX)=0.0 + XH1BHB(N,L,NY,NX)=0.0 XH2BHB(N,L,NY,NX)=0.0 XCOFLG(N,L,NY,NX)=0.0 XCHFLG(N,L,NY,NX)=0.0 @@ -355,7 +361,6 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) XQRNAS(N,NY,NX)=0.0 XQRKAS(N,NY,NX)=0.0 XQRH0P(N,NY,NX)=0.0 - XQRH1P(N,NY,NX)=0.0 XQRH3P(N,NY,NX)=0.0 XQRF1P(N,NY,NX)=0.0 XQRF2P(N,NY,NX)=0.0 @@ -449,7 +454,6 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) XNASFS(N,L,NY,NX)=0.0 XKASFS(N,L,NY,NX)=0.0 XH0PFS(N,L,NY,NX)=0.0 - XH1PFS(N,L,NY,NX)=0.0 XH3PFS(N,L,NY,NX)=0.0 XF1PFS(N,L,NY,NX)=0.0 XF2PFS(N,L,NY,NX)=0.0 @@ -458,7 +462,6 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) XC2PFS(N,L,NY,NX)=0.0 XM1PFS(N,L,NY,NX)=0.0 XH0BFB(N,L,NY,NX)=0.0 - XH1BFB(N,L,NY,NX)=0.0 XH3BFB(N,L,NY,NX)=0.0 XF1BFB(N,L,NY,NX)=0.0 XF2BFB(N,L,NY,NX)=0.0 @@ -500,7 +503,6 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) XNASHS(N,L,NY,NX)=0.0 XKASHS(N,L,NY,NX)=0.0 XH0PHS(N,L,NY,NX)=0.0 - XH1PHS(N,L,NY,NX)=0.0 XH3PHS(N,L,NY,NX)=0.0 XF1PHS(N,L,NY,NX)=0.0 XF2PHS(N,L,NY,NX)=0.0 @@ -509,7 +511,6 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) XC2PHS(N,L,NY,NX)=0.0 XM1PHS(N,L,NY,NX)=0.0 XH0BHB(N,L,NY,NX)=0.0 - XH1BHB(N,L,NY,NX)=0.0 XH3BHB(N,L,NY,NX)=0.0 XF1BHB(N,L,NY,NX)=0.0 XF2BHB(N,L,NY,NX)=0.0 @@ -597,6 +598,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) ENDIF IF(ISOIL(2,L,NY,NX).EQ.1)THEN IF(CORGC(L,NY,NX).LT.FORGW)THEN @@ -613,6 +617,8 @@ 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) ENDIF ENDIF IF(THW(L,NY,NX).GT.1.0.OR.DPTH(L,NY,NX).GE.DTBLZ(NY,NX))THEN @@ -666,6 +672,8 @@ 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) ENDIF IF(ISOIL(4,L,NY,NX).EQ.1)THEN IF(CORGC(L,NY,NX).LT.FORGW)THEN @@ -676,6 +684,8 @@ 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) 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) @@ -772,16 +782,21 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) C C SOIL SURFACE WATER STORAGE CAPACITY C - DS=AMAX1(0.001,0.112*ZS(NY,NX)+3.10*ZS(NY,NX)**2 - 2-0.012*ZS(NY,NX)*GSIN(NY,NX)) - VOLWG(NY,NX)=AMAX1(DS,-DTBLX(NY,NX))*AREA(3,NU(NY,NX),NY,NX) + ZS(NY,NX)=0.025 + VOLWD(NY,NX)=AMAX1(0.001,0.112*ZS(NY,NX)+3.10*ZS(NY,NX)**2 + 2-0.012*ZS(NY,NX)*GSIN(NY,NX))*AREA(3,NU(NY,NX),NY,NX) + VOLWG(NY,NX)=AMAX1(VOLWD(NY,NX),-DTBLX(NY,NX) + 2*AREA(3,NU(NY,NX),NY,NX)) DPTH(NU(NY,NX),NY,NX)=CDPTH(NU(NY,NX),NY,NX) 2-0.5*DLYR(3,NU(NY,NX),NY,NX) YDPTH(NU(NY,NX),NY,NX)=ALT(NY,NX)-DPTH(NU(NY,NX),NY,NX) IF(BKVL(NU(NY,NX),NY,NX).GT.0.0)THEN - CCLAY(NU(NY,NX),NY,NX)=CLAY(NU(NY,NX),NY,NX)/BKVL(NU(NY,NX),NY,NX) - CSILT(NU(NY,NX),NY,NX)=SILT(NU(NY,NX),NY,NX)/BKVL(NU(NY,NX),NY,NX) - CSAND(NU(NY,NX),NY,NX)=SAND(NU(NY,NX),NY,NX)/BKVL(NU(NY,NX),NY,NX) + CCLAY(NU(NY,NX),NY,NX)=CLAY(NU(NY,NX),NY,NX) + 2/BKVL(NU(NY,NX),NY,NX) + CSILT(NU(NY,NX),NY,NX)=SILT(NU(NY,NX),NY,NX) + 2/BKVL(NU(NY,NX),NY,NX) + CSAND(NU(NY,NX),NY,NX)=SAND(NU(NY,NX),NY,NX) + 2/BKVL(NU(NY,NX),NY,NX) ELSE CCLAY(NU(NY,NX),NY,NX)=0.0 CSILT(NU(NY,NX),NY,NX)=0.0 @@ -899,11 +914,13 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) XOQPS(K,L,NY,NX)=0.0 XOQAS(K,L,NY,NX)=0.0 7775 CONTINUE + XZHYS(L,NY,NX)=0.0 TRN4S(L,NY,NX)=0.0 TRN3S(L,NY,NX)=0.0 TRN3G(L,NY,NX)=0.0 TRNO3(L,NY,NX)=0.0 TRNO2(L,NY,NX)=0.0 + TRH1P(L,NY,NX)=0.0 TRH2P(L,NY,NX)=0.0 TRXN4(L,NY,NX)=0.0 TRXH0(L,NY,NX)=0.0 @@ -916,12 +933,6 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) TRCAPD(L,NY,NX)=0.0 TRCAPH(L,NY,NX)=0.0 TRCAPM(L,NY,NX)=0.0 - TRH2O(L,NY,NX)=0.0 - TBNH4(L,NY,NX)=0.0 - TBNH3(L,NY,NX)=0.0 - TBNO3(L,NY,NX)=0.0 - TBH2P(L,NY,NX)=0.0 - TBION(L,NY,NX)=0.0 TUPWTR(L,NY,NX)=0.0 TUPHT(L,NY,NX)=0.0 XCODFG(L,NY,NX)=0.0 @@ -930,9 +941,7 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) XNGDFG(L,NY,NX)=0.0 XN2DFG(L,NY,NX)=0.0 XN3DFG(L,NY,NX)=0.0 - XN34SQ(L,NY,NX)=0.0 XNBDFG(L,NY,NX)=0.0 - XN34BQ(L,NY,NX)=0.0 XHGDFG(L,NY,NX)=0.0 IF(L.GE.NU(NY,NX))THEN DO 195 K=0,4 @@ -976,14 +985,17 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) TUPNH4(L,NY,NX)=0.0 TUPNO3(L,NY,NX)=0.0 TUPH2P(L,NY,NX)=0.0 + TUPH1P(L,NY,NX)=0.0 TUPNHB(L,NY,NX)=0.0 TUPNOB(L,NY,NX)=0.0 TUPH2B(L,NY,NX)=0.0 + TUPH1B(L,NY,NX)=0.0 TUPNF(L,NY,NX)=0.0 TRN4B(L,NY,NX)=0.0 TRN3B(L,NY,NX)=0.0 TRNOB(L,NY,NX)=0.0 TRN2B(L,NY,NX)=0.0 + TRH1B(L,NY,NX)=0.0 TRH2B(L,NY,NX)=0.0 TRAL(L,NY,NX)=0.0 TRFE(L,NY,NX)=0.0 @@ -1019,7 +1031,6 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) TRNAS(L,NY,NX)=0.0 TRKAS(L,NY,NX)=0.0 TRH0P(L,NY,NX)=0.0 - TRH1P(L,NY,NX)=0.0 TRH3P(L,NY,NX)=0.0 TRC0P(L,NY,NX)=0.0 TRF1P(L,NY,NX)=0.0 @@ -1028,7 +1039,6 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) TRC2P(L,NY,NX)=0.0 TRM1P(L,NY,NX)=0.0 TRH0B(L,NY,NX)=0.0 - TRH1B(L,NY,NX)=0.0 TRH3B(L,NY,NX)=0.0 TRF1B(L,NY,NX)=0.0 TRF2B(L,NY,NX)=0.0 @@ -1039,12 +1049,14 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) TRXNB(L,NY,NX)=0.0 TRXHY(L,NY,NX)=0.0 TRXAL(L,NY,NX)=0.0 + TRXFE(L,NY,NX)=0.0 TRXCA(L,NY,NX)=0.0 TRXMG(L,NY,NX)=0.0 TRXNA(L,NY,NX)=0.0 TRXKA(L,NY,NX)=0.0 TRXHC(L,NY,NX)=0.0 TRXAL2(L,NY,NX)=0.0 + TRXFE2(L,NY,NX)=0.0 TRBH0(L,NY,NX)=0.0 TRBH1(L,NY,NX)=0.0 TRBH2(L,NY,NX)=0.0 @@ -1069,11 +1081,13 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) XN3FXW(L,NY,NX)=0.0 XNOFXW(L,NY,NX)=0.0 XNXFXS(L,NY,NX)=0.0 + XH1PXS(L,NY,NX)=0.0 XH2PXS(L,NY,NX)=0.0 XN4FXB(L,NY,NX)=0.0 XN3FXB(L,NY,NX)=0.0 XNOFXB(L,NY,NX)=0.0 XNXFXB(L,NY,NX)=0.0 + XH1BXB(L,NY,NX)=0.0 XH2BXB(L,NY,NX)=0.0 XALFXS(L,NY,NX)=0.0 XFEFXS(L,NY,NX)=0.0 @@ -1109,7 +1123,6 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) XNASXS(L,NY,NX)=0.0 XKASXS(L,NY,NX)=0.0 XH0PXS(L,NY,NX)=0.0 - XH1PXS(L,NY,NX)=0.0 XH3PXS(L,NY,NX)=0.0 XF1PXS(L,NY,NX)=0.0 XF2PXS(L,NY,NX)=0.0 @@ -1118,7 +1131,6 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) XC2PXS(L,NY,NX)=0.0 XM1PXS(L,NY,NX)=0.0 XH0BXB(L,NY,NX)=0.0 - XH1BXB(L,NY,NX)=0.0 XH3BXB(L,NY,NX)=0.0 XF1BXB(L,NY,NX)=0.0 XF2BXB(L,NY,NX)=0.0 @@ -1250,13 +1262,16 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) CNO2S(L,NY,NX)=0.0 ENDIF IF(VLPO4(L,NY,NX).GT.ZERO)THEN + CH1P4(L,NY,NX)=AMAX1(0.0,H1PO4(L,NY,NX) + 2/(VOLW(L,NY,NX)*VLPO4(L,NY,NX))) CH2P4(L,NY,NX)=AMAX1(0.0,H2PO4(L,NY,NX) 2/(VOLW(L,NY,NX)*VLPO4(L,NY,NX))) - CPO4S(L,NY,NX)=AMAX1(0.0,((H0PO4(L,NY,NX)+H1PO4(L,NY,NX) - 2+H3PO4(L,NY,NX)+ZFE1P(L,NY,NX)+ZFE2P(L,NY,NX)+ZCA0P(L,NY,NX) + CPO4S(L,NY,NX)=AMAX1(0.0,((H0PO4(L,NY,NX)+H3PO4(L,NY,NX) + 2+ZFE1P(L,NY,NX)+ZFE2P(L,NY,NX)+ZCA0P(L,NY,NX) 3+ZCA1P(L,NY,NX)+ZCA2P(L,NY,NX)+ZMG1P(L,NY,NX))*31.0 - 4+H2PO4(L,NY,NX))/(VOLW(L,NY,NX)*VLPO4(L,NY,NX))) + 4+H1PO4(L,NY,NX)+H2PO4(L,NY,NX))/(VOLW(L,NY,NX)*VLPO4(L,NY,NX))) ELSE + CH1P4(L,NY,NX)=0.0 CH2P4(L,NY,NX)=0.0 CPO4S(L,NY,NX)=0.0 ENDIF @@ -1279,14 +1294,17 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) CNO2B(L,NY,NX)=0.0 ENDIF IF(VLPOB(L,NY,NX).GT.ZERO)THEN - CH2PB(L,NY,NX)=AMAX1(0.0,H2POB(L,NY,NX) + CH1P4B(L,NY,NX)=AMAX1(0.0,H1POB(L,NY,NX) + 2/(VOLW(L,NY,NX)*VLPOB(L,NY,NX))) + CH2P4B(L,NY,NX)=AMAX1(0.0,H2POB(L,NY,NX) 2/(VOLW(L,NY,NX)*VLPOB(L,NY,NX))) - CPO4B(L,NY,NX)=AMAX1(0.0,((H0POB(L,NY,NX)+H1POB(L,NY,NX) - 2+H3POB(L,NY,NX)+ZFE1PB(L,NY,NX)+ZFE2PB(L,NY,NX)+ZCA0PB(L,NY,NX) + CPO4B(L,NY,NX)=AMAX1(0.0,((H0POB(L,NY,NX)+H3POB(L,NY,NX) + 2+ZFE1PB(L,NY,NX)+ZFE2PB(L,NY,NX)+ZCA0PB(L,NY,NX) 3+ZCA1PB(L,NY,NX)+ZCA2PB(L,NY,NX)+ZMG1PB(L,NY,NX))*31.0 - 4+H2POB(L,NY,NX))/(VOLW(L,NY,NX)*VLPOB(L,NY,NX))) + 4+H1POB(L,NY,NX)+H2POB(L,NY,NX))/(VOLW(L,NY,NX)*VLPOB(L,NY,NX))) ELSE - CH2PB(L,NY,NX)=0.0 + CH1P4B(L,NY,NX)=0.0 + CH2P4B(L,NY,NX)=0.0 CPO4B(L,NY,NX)=0.0 ENDIF ELSE @@ -1294,13 +1312,15 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) CNH3S(L,NY,NX)=0.0 CNO3S(L,NY,NX)=0.0 CNO2S(L,NY,NX)=0.0 + CH1P4(L,NY,NX)=0.0 CH2P4(L,NY,NX)=0.0 CPO4S(L,NY,NX)=0.0 CNH4B(L,NY,NX)=0.0 CNH3B(L,NY,NX)=0.0 CNO3B(L,NY,NX)=0.0 CNO2B(L,NY,NX)=0.0 - CH2PB(L,NY,NX)=0.0 + CH1P4B(L,NY,NX)=0.0 + CH2P4B(L,NY,NX)=0.0 CPO4B(L,NY,NX)=0.0 ENDIF ROXYY(L,NY,NX)=ROXYX(L,NY,NX) @@ -1308,20 +1328,24 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) RNO3Y(L,NY,NX)=RNO3X(L,NY,NX) RNO2Y(L,NY,NX)=RNO2X(L,NY,NX) RN2OY(L,NY,NX)=RN2OX(L,NY,NX) + RP14Y(L,NY,NX)=RP14X(L,NY,NX) RPO4Y(L,NY,NX)=RPO4X(L,NY,NX) RNHBY(L,NY,NX)=RNHBX(L,NY,NX) RN3BY(L,NY,NX)=RN3BX(L,NY,NX) RN2BY(L,NY,NX)=RN2BX(L,NY,NX) + RP1BY(L,NY,NX)=RP1BX(L,NY,NX) RPOBY(L,NY,NX)=RPOBX(L,NY,NX) ROXYX(L,NY,NX)=0.0 RNH4X(L,NY,NX)=0.0 RNO3X(L,NY,NX)=0.0 RNO2X(L,NY,NX)=0.0 RN2OX(L,NY,NX)=0.0 + RP14X(L,NY,NX)=0.0 RPO4X(L,NY,NX)=0.0 RNHBX(L,NY,NX)=0.0 RN3BX(L,NY,NX)=0.0 RN2BX(L,NY,NX)=0.0 + RP1BX(L,NY,NX)=0.0 RPOBX(L,NY,NX)=0.0 DO 5050 K=0,4 ROQCY(K,L,NY,NX)=ROQCX(K,L,NY,NX) @@ -1398,10 +1422,10 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) CSTR(L,NY,NX)=0.0 CION(L,NY,NX)=0.0 ENDIF - IF(ZHY(L,NY,NX).GT.ZEROS(NY,NX) - 2.AND.VOLW(L,NY,NX).GT.ZEROS(NY,NX))THEN - PH(L,NY,NX)=-LOG10(ZHY(L,NY,NX)/(VOLW(L,NY,NX)*1.0E+03)) - ENDIF +C IF(ZHY(L,NY,NX).GT.ZEROS(NY,NX) +C 2.AND.VOLW(L,NY,NX).GT.ZEROS(NY,NX))THEN +C PH(L,NY,NX)=-LOG10(ZHY(L,NY,NX)/(VOLW(L,NY,NX)*1.0E+03)) +C ENDIF ENDIF C C OSTWALD COEFFICIENTS FOR CO2, CH4, O2, N2, N2O, NH3 AND H2 @@ -1604,6 +1628,7 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) CNH3S(0,NY,NX)=AMAX1(0.0,ZNH3S(0,NY,NX)/VOLW(0,NY,NX)) CNO3S(0,NY,NX)=AMAX1(0.0,ZNO3S(0,NY,NX)/VOLW(0,NY,NX)) CNO2S(0,NY,NX)=AMAX1(0.0,ZNO2S(0,NY,NX)/VOLW(0,NY,NX)) + CH1P4(0,NY,NX)=AMAX1(0.0,H1PO4(0,NY,NX)/VOLW(0,NY,NX)) CH2P4(0,NY,NX)=AMAX1(0.0,H2PO4(0,NY,NX)/VOLW(0,NY,NX)) ELSE VOLXA(NY,NX)=0.0 @@ -1612,6 +1637,7 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) CNH3S(0,NY,NX)=0.0 CNO3S(0,NY,NX)=0.0 CNO2S(0,NY,NX)=0.0 + CH1P4(0,NY,NX)=0.0 CH2P4(0,NY,NX)=0.0 ENDIF ELSE @@ -1633,6 +1659,7 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) CNH3S(0,NY,NX)=0.0 CNO3S(0,NY,NX)=0.0 CNO2S(0,NY,NX)=0.0 + CH1P4(0,NY,NX)=0.0 CH2P4(0,NY,NX)=0.0 CCO2S(0,NY,NX)=0.0 CCH4S(0,NY,NX)=0.0 @@ -1653,7 +1680,7 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) CNH3B(0,NY,NX)=0.0 CNO3B(0,NY,NX)=0.0 CNO2B(0,NY,NX)=0.0 - CH2PB(0,NY,NX)=0.0 + CH2P4B(0,NY,NX)=0.0 SCO2L(0,NY,NX)=SCO2X*EXP(0.843-0.0281*TCS(0,NY,NX)) SCH4L(0,NY,NX)=SCH4X*EXP(0.597-0.0199*TCS(0,NY,NX)) SOXYL(0,NY,NX)=SOXYX*EXP(0.516-0.0172*TCS(0,NY,NX)) @@ -1695,12 +1722,14 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) RNO3Y(0,NY,NX)=RNO3X(0,NY,NX) RNO2Y(0,NY,NX)=RNO2X(0,NY,NX) RN2OY(0,NY,NX)=RN2OX(0,NY,NX) + RP14Y(0,NY,NX)=RP14X(0,NY,NX) RPO4Y(0,NY,NX)=RPO4X(0,NY,NX) ROXYX(0,NY,NX)=0.0 RNH4X(0,NY,NX)=0.0 RNO3X(0,NY,NX)=0.0 RNO2X(0,NY,NX)=0.0 RN2OX(0,NY,NX)=0.0 + RP14X(0,NY,NX)=0.0 RPO4X(0,NY,NX)=0.0 DO 5055 K=0,4 ROQCY(K,0,NY,NX)=ROQCX(K,0,NY,NX) @@ -2564,8 +2593,8 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) ENDIF PCACO(NU(NY,NX),NY,NX)=PCACO(NU(NY,NX),NY,NX)+CACX PCASO(NU(NY,NX),NY,NX)=PCASO(NU(NY,NX),NY,NX)+CASX - TFERTN=TFERTN+2.0*(Z4AX+Z4BX)+ZUAX+ZUBX+Z3AX+Z3BX+ZOAX+ZOBX - TFERTP=TFERTP+7.0*(PMAX+PMBX)+9.0*PHAX + TZIN=TZIN+14.0*(Z4AX+Z3AX+ZUAX+ZOAX+Z4BX+Z3BX+ZUBX+ZOBX) + TPIN=TPIN+62.0*(PMAX+PMBX)+93.0*PHAX TIONIN=TIONIN+2.0*(CACX+CASX) UFERTN(NY,NX)=UFERTN(NY,NX)+14.0*(Z4AX+Z4BX+Z3AX+Z3BX 2+ZUAX+ZUBX+ZOAX+ZOBX) @@ -2821,8 +2850,8 @@ 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)=ZNHUX - ZNHU0(L,NY,NX)=ZNHUX + ZNHUI(L,NY,NX)=1.0 + ZNHU0(L,NY,NX)=1.0 ELSE ZNHUI(L,NY,NX)=0.0 ZNHU0(L,NY,NX)=0.0 @@ -2832,9 +2861,9 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) IF(IYTYP(0,I,NY,NX).EQ.3.OR.IYTYP(0,I,NY,NX).EQ.4)THEN DO 9965 L=0,NL(NY,NX) IF(L.EQ.LFDPTH)THEN - ZNFN0(L,NY,NX)=ZNFNX - ZNFNI(L,NY,NX)=ZNFNX - ZNFNG(L,NY,NX)=0.25 + 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 @@ -2854,3 +2883,4 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) XNPD=600.0*XNPG RETURN END + diff --git a/f77src/nitro.f b/f77src/nitro.f index a71ed01..0d25191 100755 --- a/f77src/nitro.f +++ b/f77src/nitro.f @@ -1,2786 +1,2897 @@ - SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) -C -C THIS SUBROUTINE CALCULATES ALL SOIL BIOLOGICAL TRANSFORMATIONS -C - include "parameters.h" - include "blkc.h" - include "blk2a.h" - include "blk2b.h" - include "blk2c.h" - include "blk8a.h" - include "blk8b.h" - include "blk10.h" - include "blk11a.h" - include "blk11b.h" - include "blk13a.h" - include "blk13b.h" - include "blk13c.h" - include "blk13d.h" - include "blk15a.h" - include "blk15b.h" - include "blk18a.h" - include "blk18b.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) - 3,RHOSN(4,0:4),RHOSP(4,0:4),RCOSC(4,0:4),RCOSN(4,0:4),RCOSP(4,0:4) - 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),RIPB4(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) - 6,CGOMP(7,0:5),RDMMC(2,7,0:5),RHMMC(2,7,0:5),RCMMC(2,7,0:5) - 7,RDMMN(2,7,0:5),RHMMN(2,7,0:5),RCMMN(2,7,0:5),RDMMP(2,7,0:5) - 8,RHMMP(2,7,0:5),RCMMP(2,7,0:5),RCCMC(2,7,0:4) - 9,RCCMN(2,7,0:4),RCCMP(2,7,0:4),RN2FX(7,0:5),TOMK(0:5) - 1,TONK(0:5),TOPK(0:5),SPOMC(2),OMC2(7,0:5),TFNG(7,0:5),TFNR(7,0:5) - 2,OMN2(7,0:5),FOM2(7,0:5),FOCA(0:4),FOAA(0:4),RXOMC(2,7,0:5) - 3,RXOMN(2,7,0:5),RXOMP(2,7,0:5),R3OMC(2,7,0:5),R3OMN(2,7,0:5) - 4,R3OMP(2,7,0:5),RXMMC(2,7,0:5),RXMMN(2,7,0:5),RXMMP(2,7,0:5) - 4,R3MMC(2,7,0:5),R3MMN(2,7,0:5),R3MMP(2,7,0:5),WFN(7,0:5) - DIMENSION CGOQC(7,0:5),CGOAC(7,0:5),ROQCK(0:4),XOQCK(0:4) - 2,EN2F(7),ORCT(0:4),OSCT(0:4),OSAT(0:4),ZNH4T(0:JZ),ZNO3T(0:JZ) - 3,ZNO2T(0:JZ),H2P4T(0:JZ),RINH4R(7,0:5),RINO3R(7,0:5) - 4,RIPO4R(7,0:5),FNH4XR(7,0:5),FNO3XR(7,0:5),FPO4XR(7,0:5) - 5,RGOMY(7,0:5),CNQ(0:4),CPQ(0:4),CNH(0:4),CPH(0:4) - 6,CNS(4,0:4),CPS(4,0:4),DCKM(0:4),DCKX(0:4),ROQCD(7,0:4) - 7,DOSA(0:4),DOSX(0:4),DOSM(0:4),FORC(0:5),DOMX(0:5) - 8,CGOMS(2,7,0:5),CGONS(2,7,0:5),CGOPS(2,7,0:5) - 1,TONX(0:5),TOPX(0:5),FCNK(0:4),FCPK(0:4) - 2,RCO2X(7,0:5),RCH3X(7,0:5),RCH4X(7,0:5),RVOXA(7),RVOXB(7) - 2,TGROMC(0:7),XOQCZ(0:4),XOQNZ(0:4),XOQPZ(0:4),XOQAZ(0:4) - 3,XOMCZ(3,7,0:4),XOMNZ(3,7,0:4),XOMPZ(3,7,0:4) - 4,FCN(7,0:5),FCP(7,0:5),FCNP(7,0:5),FSBST(7,0:5) - 5,TCGOQC(0:5),TCGOAC(0:5),TCGOMN(0:5),TCGOMP(0:5),TRINH4(JY,JX) - 6,TRN2ON(JY,JX),TRN2OD(JY,JX),TRN2GD(JY,JX) -C -C SUBSTRATE DECOMPOSITION BY MICROBIAL POPULATIONS -C - PARAMETER (ORAD=1.0E-06,BIOS=1.0E-06/(4.19*ORAD**3) - 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,DOMK=2.5E+02 - 5,FOSCZ0=2.0E-02,FOSCZL=1.0E-06,FMN=1.0E-03) -C -C SPECIFIC RESPIRATION RATES, M-M UPTAKE CONSTANTS, -C STOICHIOMETRIC CONSTANTS FOR MICROBIAL REDOX REACTIONS -C - PARAMETER (VMXO=0.10,VMXF=0.10,VMXM=0.10,VMXH=0.25,VMXN=0.25 - 2,VMX4=0.25,VMXC=0.10,OQKM=1.2E+01,OQKA=1.2E+01,OQKAM=1.2E+01 - 3,CCKM=0.15,CCK4=1.2E-04,ZHKM=2.0E-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,C3KI=7.0,ECNH=0.30 - 7,ECNO=0.10,ECN3=0.857,ECN2=0.857,ECN1=0.429,RNFNI=1.25E-04 - 8,RNFNG=0.015,ECHO=0.75,VMKI=2.50,OXKA=0.32 - 9,EDNH=1.00,EDNA=1.00) -C -C ENERGY REQUIREMENTS FOR MICROBIAL GROWTH AND -C ENERGY YIELDS FROM REDUCTION OF O2, OC, CH4, NO3, N2 -C - PARAMETER (EOMC=25.0,EOMD=37.5,EOMG=37.5,EOMF=25.0,EOMH=25.0 - 2,EOMN=75.0,GO2X=37.5,GCHX=4.50,GO2A=GO2X-GCHX,GC4X=3.00 - 3,GCOX=11.00,GNOX=10.0,GN2X=187.5,EN2X=GO2X/GN2X,EN2Y=GCHX/GN2X - 4,EO2X=1.0/(1.0+GO2X/EOMC),EO2G=1.0/(1.0+GO2X/EOMG) - 5,EO2D=1.0/(1.0+GO2X/EOMD),ENFX=1.0/(1.0+GO2X/EOMN) - 6,ENOX=1.0/(1.0+GNOX/EOMC),EO2A=1.0/(1.0+GO2A/EOMC)) -C -C SORPTION RATE CONSTANTS -C - PARAMETER (TSORP=0.5,HSORP=1.0) -C -C SPECIFIC DECOMPOSITION RATES -C - PARAMETER (SPOHC=0.25,SPOHA=0.25,RMOM=0.010) - DATA SPOSC/10.0,10.0,1.5,0.25,10.0,10.0,1.5,0.25 - 2,10.0,10.0,1.5,0.25,0.05,0.00,0.00,0.00 - 3,0.05,0.0167,0.00,0.00/ - DATA SPORC/10.0,1.5/ - DATA SPOMC/10.0E-03,5.0E-04/ - DATA DCKM/0.25E+03,0.25E+03,0.25E+03,1.0E+03,1.0E+03/ - DATA DOSA/5.0E+00,5.0E+00,5.0E+00,5.0E+00,5.0E+00/ - DATA DOSX/0.0500,0.0500,0.0500,0.0125,0.0125/ - DATA DOSM/0.0050,0.0050,0.0050,0.0025,0.0025/ - DATA DCKX/0.50,0.50,0.50,0.00,0.00/ - DATA DOMX/1.0,1.0,1.0,1.0,1.0,0.001/ -C -C MICROBIAL C:N:P RATIOS DURING HUMIFICATION -C - DATA EN2F/0.0,0.0,0.0,0.0,0.0,EN2X,EN2Y/ - REAL*4 WFNG,TFNX,TFNY,TFNG,TFNR,CNSHZ,CPSHZ,FRM -C REAL*16 B,C - DO 9995 NX=NHW,NHE - DO 9990 NY=NVN,NVS -C IF(I.EQ.1.AND.J.EQ.1)THEN -C TRINH4(NY,NX)=0.0 -C TRN2ON(NY,NX)=0.0 -C TRN2OD(NY,NX)=0.0 -C TRN2GD(NY,NX)=0.0 -C ENDIF - DO 998 L=0,NL(NY,NX) - IF(L.EQ.0.OR.L.GE.NU(NY,NX))THEN - IF(L.EQ.0)THEN - KL=2 -C ZNH4T(NU(NY,NX))=AMAX1(0.0,ZNH4S(NU(NY,NX),NY,NX)) -C 2+AMAX1(0.0,ZNH4B(NU(NY,NX),NY,NX)) -C ZNO3T(NU(NY,NX))=AMAX1(0.0,ZNO3S(NU(NY,NX),NY,NX)) -C 2+AMAX1(0.0,ZNO3B(NU(NY,NX),NY,NX)) -C ZNO2T(NU(NY,NX))=AMAX1(0.0,ZNO2S(NU(NY,NX),NY,NX)) -C 2+AMAX1(0.0,ZNO2B(NU(NY,NX),NY,NX)) -C H2P4T(NU(NY,NX))=AMAX1(0.0,H2PO4(NU(NY,NX),NY,NX)) -C 2+AMAX1(0.0,H2POB(NU(NY,NX),NY,NX)) - 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)) - 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)) - ENDIF -C -C TEMPERATURE FUNCTIONS FOR GROWTH AND MAINTENANCE -C WITH OFFSET FOR THERMAL ADAPTATION -C - TKSO=TKS(L,NY,NX)+OFFSET(NY,NX) - RTK=8.3143*TKSO - STK=710.0*TKSO - ACTV=1+EXP((197500-STK)/RTK)+EXP((STK-222500)/RTK) - TFNX=EXP(25.229-62500/RTK)/ACTV -C TKSM=AMAX1(258.15,TKS(L,NY,NX))+OFFSET(NY,NX) -C RTK=8.3143*TKSM -C STK=710.0*TKSM - ACTVM=1+EXP((195000-STK)/RTK)+EXP((STK-232500)/RTK) - TFNY=EXP(25.214-62500/RTK)/ACTVM - OXYI=1.0-1.0/(1.0+EXP(1.0*(-COXYS(L,NY,NX)+3.0))) -C -C NITRIFICATION INHIBITION -C - IF(ZNFN0(L,NY,NX).GT.ZEROS(NY,NX))THEN - ZNFNI(L,NY,NX)=AMAX1(0.0,ZNFNI(L,NY,NX)-RNFNI*AMAX1(0.50,TFNX)) - ZNFNG(L,NY,NX)=ZNFNG(L,NY,NX)+RNFNG*TFNX - 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)) - IF(ZNH4T(L).GT.ZEROS(NY,NX))THEN - FNH4S=AMAX1(0.0,ZNH4S(L,NY,NX))/ZNH4T(L) - FNHBS=AMAX1(0.0,ZNH4B(L,NY,NX))/ZNH4T(L) - ELSE - FNH4S=VLNH4(L,NY,NX) - FNHBS=VLNHB(L,NY,NX) - ENDIF - ZNO3T(L)=AMAX1(0.0,ZNO3S(L,NY,NX))+AMAX1(0.0,ZNO3B(L,NY,NX)) - IF(ZNO3T(L).GT.ZEROS(NY,NX))THEN - FNO3S=AMAX1(0.0,ZNO3S(L,NY,NX))/ZNO3T(L) - FNO3B=AMAX1(0.0,ZNO3B(L,NY,NX))/ZNO3T(L) - ELSE - FNO3S=VLNO3(L,NY,NX) - FNO3B=VLNOB(L,NY,NX) - ENDIF - ZNO2T(L)=AMAX1(0.0,ZNO2S(L,NY,NX))+AMAX1(0.0,ZNO2B(L,NY,NX)) - IF(ZNO2T(L).GT.ZEROS(NY,NX))THEN - FNO2S=AMAX1(0.0,ZNO2S(L,NY,NX))/ZNO2T(L) - FNO2B=AMAX1(0.0,ZNO2B(L,NY,NX))/ZNO2T(L) - ELSE - FNO2S=VLNO3(L,NY,NX) - FNO2B=VLNOB(L,NY,NX) - ENDIF - H2P4T(L)=AMAX1(0.0,H2PO4(L,NY,NX))+AMAX1(0.0,H2POB(L,NY,NX)) - IF(H2P4T (L).GT.ZEROS(NY,NX))THEN - FH2PS=AMAX1(0.0,H2PO4(L,NY,NX))/H2P4T (L) - FH2PB=AMAX1(0.0,H2POB(L,NY,NX))/H2P4T (L) - ELSE - FH2PS=VLPO4(L,NY,NX) - FH2PB=VLPOB(L,NY,NX) - ENDIF - COXYQ1=COXYG(L,NY,NX)*SOXYL(L,NY,NX) -C -C TOTAL SUBSTRATE -C - TOSC=0.0 - TOSA=0.0 - TORC=0.0 - TOHC=0.0 -C -C TOTAL SOLID SUBSTRATE -C - DO 870 K=0,KL - OSCT(K)=0.0 - OSAT(K)=0.0 - DO 865 M=1,4 - OSCT(K)=OSCT(K)+OSC(M,K,L,NY,NX) - OSAT(K)=OSAT(K)+OSA(M,K,L,NY,NX) -865 CONTINUE - TOSC=TOSC+OSCT(K) - TOSA=TOSA+OSAT(K) -870 CONTINUE -C -C TOTAL BIORESIDUE -C - DO 880 K=0,KL - ORCT(K)=0.0 - DO 875 M=1,2 - ORCT(K)=ORCT(K)+ORC(M,K,L,NY,NX) -C IF(L.EQ.4.AND.K.EQ.2)THEN -C WRITE(*,876)'ORCT',I,J,NX,NY,L,K,M,ORCT(K) -C 2,ORC(M,K,L,NY,NX) -876 FORMAT(A8,7I4,60E12.4) -C ENDIF -875 CONTINUE - TORC=TORC+ORCT(K) -C -C TOTAL ADSORBED AND DISSOLVED SUBSTRATE -C - TOHC=TOHC+OHC(K,L,NY,NX)+OHA(K,L,NY,NX) -880 CONTINUE - DO 860 K=0,KL - OSRH(K)=OSAT(K)+ORCT(K)+OHC(K,L,NY,NX)+OHA(K,L,NY,NX) -C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.EQ.4.AND.K.EQ.2)THEN -C WRITE(*,861)'OSRH',I,J,NX,NY,L,K,OSRH(K),OSCT(K) -C 2,OSAT(K),ORCT(K),OHC(K,L,NY,NX),OHA(K,L,NY,NX) -861 FORMAT(A8,6I4,20E12.4) -C ENDIF -860 CONTINUE - TSRH=TOSA+TORC+TOHC -C -C C:N AND C:P RATIOS OF TOTAL BIOMASS -C - TOMA=0.0 - TOMN=0.0 - DO 890 K=0,5 - IF(L.NE.0.OR.(K.NE.3.AND.K.NE.4))THEN - DO 895 N=1,7 - IF(K.NE.5.OR.(N.LE.3.OR.N.EQ.5))THEN - IF(OMC(1,N,K,L,NY,NX).GT.ZEROS(NY,NX))THEN - CNOMA(N,K)=AMAX1(0.0,OMN(1,N,K,L,NY,NX)/OMC(1,N,K,L,NY,NX)) - CPOMA(N,K)=AMAX1(0.0,OMP(1,N,K,L,NY,NX)/OMC(1,N,K,L,NY,NX)) - ELSE - CNOMA(N,K)=CNOMC(1,N,K) - CPOMA(N,K)=CPOMC(1,N,K) - ENDIF - OMA(N,K)=AMAX1(0.0,OMC(1,N,K,L,NY,NX)/FL(1)) - FCN(N,K)=AMIN1(1.0,AMAX1(0.50,SQRT(CNOMA(N,K)/CNOMC(1,N,K)))) - FCP(N,K)=AMIN1(1.0,AMAX1(0.50,SQRT(CPOMA(N,K)/CPOMC(1,N,K)))) - FCNP(N,K)=AMIN1(FCN(N,K),FCP(N,K)) -C -C TOTAL BIOMASS -C - IF(K.NE.5.OR.(N.LE.3.OR.N.EQ.5))THEN - TOMA=TOMA+OMA(N,K) - ENDIF - IF((K.LE.4.AND.N.EQ.2).OR.(K.EQ.5.AND.N.EQ.1))THEN - TOMN=TOMN+OMA(N,K) - ENDIF - OMC2(N,K)=AMAX1(0.0,AMIN1(OMA(N,K)*FL(2),OMC(2,N,K,L,NY,NX))) - IF(OMC(2,N,K,L,NY,NX).GT.ZEROS(NY,NX))THEN - FOM2(N,K)=AMAX1(0.0,OMC2(N,K)/OMC(2,N,K,L,NY,NX)) - OMN2(N,K)=AMAX1(0.0,FOM2(N,K)*OMN(2,N,K,L,NY,NX)) - ELSE - FOM2(N,K)=0.0 - OMN2(N,K)=0.0 - ENDIF - ENDIF -895 CONTINUE - ENDIF -890 CONTINUE - DO 690 K=0,KL - TOMK(K)=0.0 - TONK(K)=0.0 - TOPK(K)=0.0 - TONX(K)=0.0 - TOPX(K)=0.0 - DO 685 N=1,7 - TOMK(K)=TOMK(K)+OMA(N,K) - TONK(K)=TONK(K)+OMA(N,K)*CNOMA(N,K) - TOPK(K)=TOPK(K)+OMA(N,K)*CPOMA(N,K) - TONX(K)=TONX(K)+OMA(N,K)*CNOMC(1,N,K) - TOPX(K)=TOPX(K)+OMA(N,K)*CPOMC(1,N,K) -685 CONTINUE -690 CONTINUE - DO 790 K=0,KL - IF(TSRH.GT.ZEROS(NY,NX))THEN - FOSRH(K,L,NY,NX)=OSRH(K)/TSRH - ELSE - FOSRH(K,L,NY,NX)=1.0 - ENDIF -C -C DOC CONCENTRATIONS -C - IF(VOLWM(NPH,L,NY,NX).GT.ZEROS(NY,NX))THEN - IF(FOSRH(K,L,NY,NX).GT.ZERO)THEN - COQC(K,L,NY,NX)=AMAX1(0.0,OQC(K,L,NY,NX) - 2/(VOLWM(NPH,L,NY,NX)*FOSRH(K,L,NY,NX))) - COQA(K,L,NY,NX)=AMAX1(0.0,OQA(K,L,NY,NX) - 2/(VOLWM(NPH,L,NY,NX)*FOSRH(K,L,NY,NX))) - ELSE - COQC(K,L,NY,NX)=AMAX1(0.0,OQC(K,L,NY,NX)/VOLWM(NPH,L,NY,NX)) - COQA(K,L,NY,NX)=AMAX1(0.0,OQA(K,L,NY,NX)/VOLWM(NPH,L,NY,NX)) - ENDIF - ELSE - COQC(K,L,NY,NX)=0.0 - COQA(K,L,NY,NX)=0.0 - OHCQ=0.0 - ENDIF - IF(OQC(K,L,NY,NX).GT.ZEROS(NY,NX))THEN - CNQ(K)=AMAX1(0.0,OQN(K,L,NY,NX)/OQC(K,L,NY,NX)) - CPQ(K)=AMAX1(0.0,OQP(K,L,NY,NX)/OQC(K,L,NY,NX)) - ELSE - CNQ(K)=0.0 - CPQ(K)=0.0 - ENDIF - IF(OQC(K,L,NY,NX).GT.ZEROS(NY,NX).AND.OQA(K,L,NY,NX) - 2.GT.ZEROS(NY,NX))THEN - FOCA(K)=OQC(K,L,NY,NX)/(OQC(K,L,NY,NX)+OQA(K,L,NY,NX)) - FOAA(K)=1.0-FOCA(K) - ELSEIF(OQC(K,L,NY,NX).GT.ZEROS(NY,NX))THEN - FOCA(K)=1.0 - FOAA(K)=0.0 - ELSE - FOCA(K)=0.0 - FOAA(K)=1.0 - ENDIF -790 CONTINUE -C -C NITROUS ACID CONCN AND ENERGY YIELD OF HYDROGENOTROPHIC -C METHANOGENESIS AT AMBIENT H2 CONCENTRATION -C - CHY1=AMAX1(ZERO,10.0**(-(PH(L,NY,NX)-3.0))) - CHNO2=CNO2S(L,NY,NX)*CHY1/0.5 - CHNOB=CNO2B(L,NY,NX)*CHY1/0.5 - GH2X=8.3143E-03*TKS(L,NY,NX) - 2*LOG((AMAX1(1.0E-03,CH2GS(L,NY,NX))/H2KI)**4) -C -C RESPIRATION BY MICROBIAL POPULATIONS -C - TFOXYX=0.0 - TFNH4X=0.0 - TFNO3X=0.0 - TFNO2X=0.0 - TFN2OX=0.0 - TFPO4X=0.0 - TFNH4B=0.0 - TFNO3B=0.0 - TFNO2B=0.0 - TFPO4B=0.0 - TCH4H=0.0 - TCH4A=0.0 - TFOQC=0.0 - TFOQA=0.0 - TRH2G=0.0 - IF(L.NE.0)THEN - LL=L - 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.333,0.750+8.00*CNSHY) - FPSHY=AMIN1(1.333,0.750+80.0*CPSHY) - DO 760 K=0,5 - IF(L.NE.0.OR.(K.NE.3.AND.K.NE.4))THEN - TCGOQC(K)=0.0 - TCGOAC(K)=0.0 - TCGOMN(K)=0.0 - TCGOMP(K)=0.0 - DO 750 N=1,7 - IF(K.NE.5.OR.(N.LE.3.OR.N.EQ.5))THEN - IF(K.LE.4)THEN - IF(N.EQ.3)THEN - WFNG=EXP(0.1*PSISM(L,NY,NX)) - ELSE - WFNG=EXP(0.2*PSISM(L,NY,NX)) - ENDIF - OXKX=OXKM - ELSE - WFNG=EXP(0.2*PSISM(L,NY,NX)) - OXKX=OXKA - ENDIF - TFNG(N,K)=TFNX*WFNG - TFNR(N,K)=TFNY - IF(OMA(N,K).GT.0.0)THEN - IF(TOMA.GT.ZEROS(NY,NX))THEN - FOMA(N,K)=OMA(N,K)/TOMA - ELSE - FOMA(N,K)=1.0 - ENDIF - IF(TOMN.GT.ZEROS(NY,NX))THEN - FOMN(N,K)=OMA(N,K)/TOMN - ELSE - FOMN(N,K)=1.0 - ENDIF - IF(TOMK(K).GT.ZEROS(NY,NX))THEN - FOMK(N,K)=OMA(N,K)/TOMK(K) - ELSE - FOMK(N,K)=1.0 - ENDIF - IF(BKVL(L,NY,NX).GT.ZEROS(NY,NX))THEN - DOMA=OMA(N,K)/BKVL(L,NY,NX) - ELSEIF(VOLWZ.GT.ZEROS(NY,NX))THEN - DOMA=OMA(N,K)/VOLWZ - ELSE - DOMA=1.0E+06 - ENDIF - DOMA=AMAX1(0.0,DOMA-DOMX(K)) - SPOMC2=DOMA/(DOMA+DOMK) -C -C FACTORS CONSTRAINING DOC,ACETATE, O2, NH4, NO3, PO4 UPTAKE AMONG -C COMPETING MICROBIAL AND ROOT POPULATIONS IN SOIL LAYERS -C - IF(ROXYY(L,NY,NX).GT.ZEROS(NY,NX))THEN - FOXYX=AMAX1(FMN,ROXYS(N,K,L,NY,NX)/ROXYY(L,NY,NX)) - ELSE - FOXYX=AMAX1(FMN,FOMA(N,K)) - ENDIF - IF(RNH4Y(L,NY,NX).GT.ZEROS(NY,NX))THEN - FNH4X=AMAX1(FMN,RINHO(N,K,L,NY,NX)/RNH4Y(L,NY,NX)) - ELSE - FNH4X=AMAX1(FMN,FOMA(N,K)*VLNH4(L,NY,NX)) - ENDIF - IF(RNHBY(L,NY,NX).GT.ZEROS(NY,NX))THEN - FNB4X=AMAX1(FMN,RINHB(N,K,L,NY,NX)/RNHBY(L,NY,NX)) - ELSE - FNB4X=AMAX1(FMN,FOMA(N,K)*VLNHB(L,NY,NX)) - ENDIF - IF(RNO3Y(L,NY,NX).GT.ZEROS(NY,NX))THEN - FNO3X=AMAX1(FMN,RINOO(N,K,L,NY,NX)/RNO3Y(L,NY,NX)) - ELSE - FNO3X=AMAX1(FMN,FOMA(N,K)*VLNO3(L,NY,NX)) - ENDIF - IF(RN3BY(L,NY,NX).GT.ZEROS(NY,NX))THEN - FNB3X=AMAX1(FMN,RINOB(N,K,L,NY,NX)/RN3BY(L,NY,NX)) - ELSE - FNB3X=AMAX1(FMN,FOMA(N,K)*VLNOB(L,NY,NX)) - ENDIF - IF(RPO4Y(L,NY,NX).GT.ZEROS(NY,NX))THEN - FPO4X=AMAX1(FMN,RIPOO(N,K,L,NY,NX)/RPO4Y(L,NY,NX)) - ELSE - FPO4X=AMAX1(FMN,FOMA(N,K)*VLPO4(L,NY,NX)) - ENDIF - IF(RPOBY(L,NY,NX).GT.ZEROS(NY,NX))THEN - FPB4X=AMAX1(FMN,RIPOB(N,K,L,NY,NX)/RPOBY(L,NY,NX)) - ELSE - FPB4X=AMAX1(FMN,FOMA(N,K)*VLPOB(L,NY,NX)) - ENDIF - IF(K.LE.4)THEN - IF(ROQCY(K,L,NY,NX).GT.ZEROS(NY,NX))THEN - FOQC=AMAX1(FMN,ROQCS(N,K,L,NY,NX)/ROQCY(K,L,NY,NX)) - ELSE - FOQC=AMAX1(FMN,FOMK(N,K)) - ENDIF - TFOQC=TFOQC+FOQC - IF(ROQAY(K,L,NY,NX).GT.ZEROS(NY,NX))THEN - FOQA=AMAX1(FMN,ROQAS(N,K,L,NY,NX)/ROQAY(K,L,NY,NX)) - ELSE - FOQA=AMAX1(FMN,FOMK(N,K)) - ENDIF - TFOQA=TFOQA+FOQA - ENDIF - TFOXYX=TFOXYX+FOXYX - TFNH4X=TFNH4X+FNH4X - TFNO3X=TFNO3X+FNO3X - TFPO4X=TFPO4X+FPO4X - TFNH4B=TFNH4B+FNB4X - TFNO3B=TFNO3B+FNB3X - TFPO4B=TFPO4B+FPB4X -C -C FACTORS CONSTRAINING NH4, NO3, PO4 UPTAKE AMONG COMPETING -C MICROBIAL POPULATIONS IN SURFACE RESIDUE -C - IF(L.EQ.0)THEN - IF(RNH4Y(NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN - FNH4XR(N,K)=AMAX1(FMN,RINHOR(N,K,NY,NX) - 2/RNH4Y(NU(NY,NX),NY,NX)) - ELSE - FNH4XR(N,K)=0.0 - ENDIF - IF(RNO3Y(NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN - FNO3XR(N,K)=AMAX1(FMN,RINOOR(N,K,NY,NX) - 2/RNO3Y(NU(NY,NX),NY,NX)) - ELSE - FNO3XR(N,K)=0.0 - ENDIF - IF(RPO4Y(NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN - FPO4XR(N,K)=AMAX1(FMN,RIPOOR(N,K,NY,NX) - 2/RPO4Y(NU(NY,NX),NY,NX)) - ELSE - FPO4XR(N,K)=0.0 - ENDIF - ENDIF - IF(L.EQ.NU(NY,NX).AND.K.NE.3.AND.K.NE.4 - 2.AND.BKVL(0,NY,NX).GT.ZEROS(NY,NX))THEN - TFNH4X=TFNH4X+FNH4XR(N,K) - TFNO3X=TFNO3X+FNO3XR(N,K) - TFPO4X=TFPO4X+FPO4XR(N,K) - ENDIF -C -C HETEROTROPHIC BIOMASS RESPIRATION -C - IF(K.LE.4)THEN -C -C RESPIRATION BY HETEROTROPHIC AEROBES: -C N=(1)OBLIGATE AEROBES,(2)FACULTATIVE ANAEROBES,(3)FUNGI,(6)N2 FIXERS -C - IF(N.LE.3.OR.N.EQ.6)THEN -C -C ENERGY YIELDS OF REDOX REACTIONS -C - IF(N.EQ.1)THEN - EO2Q=EO2X - ELSEIF(N.EQ.2)THEN - EO2Q=EO2D - ELSEIF(N.EQ.3)THEN - EO2Q=EO2G - ELSEIF(N.EQ.6)THEN - EO2Q=ENFX - ENDIF -C -C O2-UNCONSTRAINED RESPIRATION RATES BY HETEROTROPHIC AEROBES 'RGO*Z' -C FROM SPECIFIC OXIDATION RATE, ACTIVE BIOMASS, DOC OR ACETATE - -C CONCENTRATION,MICROBIAL C:N:P FACTOR, AND TEMPERATURE FOLLOWED BY -C POTENTIAL RESPIRATION RATES 'RGO*P' WITH UNLIMITED SUBSTRATE USED -C FOR MICROBIAL COMPETITION FACTOR -C - FSBSTC=COQC(K,L,NY,NX)/(COQC(K,L,NY,NX)+OQKM) - FSBSTA=COQA(K,L,NY,NX)/(COQA(K,L,NY,NX)+OQKA) - FSBST(N,K)=FOCA(K)*FSBSTC+FOAA(K)*FSBSTA - RGOCY=AMAX1(0.0,FCNP(N,K)*VMXO*WFNG*OMA(N,K)) - RGOCZ=RGOCY*FSBSTC*FOCA(K)*TFNX - RGOAZ=RGOCY*FSBSTA*FOAA(K)*TFNX - RGOCX=AMAX1(0.0,OQC(K,L,NY,NX)*FOQC*EO2Q) - RGOAX=AMAX1(0.0,OQA(K,L,NY,NX)*FOQA*EO2A) - RGOCP=AMIN1(RGOCX,RGOCZ) - RGOAP=AMIN1(RGOAX,RGOAZ) - RGOMP=RGOCP+RGOAP - IF(RGOMP.GT.ZEROS(NY,NX))THEN - FGOCP=RGOCP/RGOMP - FGOAP=RGOAP/RGOMP - ELSE - FGOCP=1.0 - FGOAP=0.0 - ENDIF -C -C ENERGY YIELD AND O2 DEMAND FROM DOC AND ACETATE OXIDATION -C BY HETEROTROPHIC AEROBES -C - ECHZ=EO2Q*FGOCP+EO2A*FGOAP - ROXYM(N,K)=2.667*RGOMP - ROXYP(N,K)=ROXYM(N,K) - ROXYS(N,K,L,NY,NX)=ROXYP(N,K) - ROQCS(N,K,L,NY,NX)=RGOCZ - ROQAS(N,K,L,NY,NX)=RGOAZ - ROQCD(N,K)=RGOCY -C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.LE.1)THEN -C WRITE(*,5555)'RGOMP',I,J,NX,NY,L,K,N,RGOMP,RGOCX,RGOAX,RGOCZ -C 2,RGOAZ,RGOCX,RGOAX,FCNP(N,K),TFNG(N,K),VMXO,OMA(N,K),FOQC,FOQA -C 2,COQC(K,L,NY,NX),OQC(K,L,NY,NX),EO2Q,TKS(L,NY,NX),COXYS(L,NY,NX) -C 3,OQKM,OMC(1,N,K,L,NY,NX),OMC(2,N,K,L,NY,NX),OMC(3,N,K,L,NY,NX) -C 3,VOLWM(NPH,L,NY,NX),FOSRH(K,L,NY,NX),DOMA,SPOMC2 -C 4,FSBST(N,K),ROQCD(N,K) -5555 FORMAT(A8,7I4,60E12.4) -C ENDIF -C -C RESPIRATION BY HETEROTROPHIC ANAEROBES: -C N=(4)ACETOGENIC FERMENTERS (7) ACETOGENIC N2 FIXERS -C -C -C ENERGY YIELD FROM FERMENTATION DEPENDS ON H2 CONCENTRATION -C - ELSEIF(N.EQ.4.OR.N.EQ.7)THEN - GH2F=GH2X/72.0 - GOAX=8.3143E-03*TKS(L,NY,NX) - 2*LOG((AMAX1(ZERO,COQA(K,L,NY,NX))/OAKI)**2) - GOAF=GOAX/72.0 - GHAX=GH2F+GOAF - IF(N.EQ.4)THEN - ECHZ=AMAX1(EO2X,AMIN1(1.0,1.0 - 2/(1.0+AMAX1(0.0,(GCHX-GHAX))/EOMF))) - ELSE - ECHZ=AMAX1(ENFX,AMIN1(1.0,1.0 - 2/(1.0+AMAX1(0.0,(GCHX-GHAX))/EOMN))) - ENDIF -C -C RESPIRATION RATES BY HETEROTROPHIC ANAEROBES 'RGOMP' FROM SPECIFIC -C OXIDATION RATE, ACTIVE BIOMASS, DOC CONCENTRATION, -C MICROBIAL C:N:P FACTOR, AND TEMPERATURE FOLLOWED BY POTENTIAL -C RESPIRATION RATES 'RGOMP' WITH UNLIMITED SUBSTRATE USED FOR MICROBIAL -C COMPETITION FACTOR -C - FSBST(N,K)=COQC(K,L,NY,NX)/(COQC(K,L,NY,NX)+OQKM)*OXYI - SPOMC2=SPOMC2*OXYI - RGOFY=AMAX1(0.0,FCNP(N,K)*VMXF*WFNG*OMA(N,K)) - RGOFZ=RGOFY*FSBST(N,K)*TFNX - RGOFX=AMAX1(0.0,OQC(K,L,NY,NX)*FOQC*ECHZ) - RGOMP=AMIN1(RGOFX,RGOFZ) - FGOCP=1.0 - FGOAP=0.0 - ROXYM(N,K)=0.0 - ROXYP(N,K)=0.0 - ROXYS(N,K,L,NY,NX)=0.0 - ROQCS(N,K,L,NY,NX)=RGOFZ - ROQAS(N,K,L,NY,NX)=0.0 - ROQCD(N,K)=RGOFY - TRH2G=TRH2G+RGOMP -C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.LE.4)THEN -C WRITE(*,5554)'FERM',I,J,NX,NY,L,K,N,RGOMP,RGOFX,RGOFZ,GHAX,GOAF -C 2,ECHZ,FCNP(N,K),TFNG(N,K),OMA(N,K),FOQC,COQC(K,L,NY,NX),OQC(K,L,NY,NX) -C 3,OQKM,OMC(1,N,K,L,NY,NX),OMC(2,N,K,L,NY,NX),OMC(3,N,K,L,NY,NX) -C 3,OMN(1,N,K,L,NY,NX),OMN(2,N,K,L,NY,NX),OMN(3,N,K,L,NY,NX) -C 5,VOLWM(NPH,L,NY,NX),PSISM(L,NY,NX),WFNG,COXYS(L,NY,NX),OXYI -C 6,FSBST(N,K),FOSRH(K,L,NY,NX),DOMA,SPOMC2,ROQCD(N,K) -5554 FORMAT(A8,7I4,60E12.4) -C ENDIF -C -C ENERGY YIELD FROM ACETOTROPHIC METHANOGENESIS -C - ELSEIF(N.EQ.5)THEN - GOMX=8.3143E-03*TKS(L,NY,NX) - 2*LOG((AMAX1(ZERO,COQA(K,L,NY,NX))/OAKI)) - GOMM=GOMX/24.0 - ECHZ=AMAX1(EO2X,AMIN1(1.0,1.0/(1.0+AMAX1(0.0,(GC4X+GOMM))/EOMH))) -C -C RESPIRATION RATES BY ACETOTROPHIC METHANOGENS 'RGOMP' FROM SPECIFIC -C OXIDATION RATE, ACTIVE BIOMASS, DOC CONCENTRATION, -C MICROBIAL C:N:P FACTOR, AND TEMPERATURE FOLLOWED BY POTENTIAL C -C RESPIRATION RATES 'RGOMP' WITH UNLIMITED SUBSTRATE USED FOR -C MICROBIAL COMPETITION FACTOR -C - FSBST(N,K)=COQA(K,L,NY,NX)/(COQA(K,L,NY,NX)+OQKAM) - RGOGY=AMAX1(0.0,FCNP(N,K)*VMXM*WFNG*OMA(N,K)) - RGOGZ=RGOGY*FSBST(N,K)*TFNX - RGOGX=AMAX1(0.0,OQA(K,L,NY,NX)*FOQA*ECHZ) - RGOMP=AMIN1(RGOGX,RGOGZ) - FGOCP=0.0 - FGOAP=1.0 - ROXYM(N,K)=0.0 - ROXYP(N,K)=0.0 - ROXYS(N,K,L,NY,NX)=0.0 - ROQCS(N,K,L,NY,NX)=0.0 - ROQAS(N,K,L,NY,NX)=RGOGZ - ROQCD(N,K)=0.0 - TCH4H=TCH4H+0.5*RGOMP -C IF((I/30)*30.EQ.I.AND.NX.EQ.3.AND.NY.EQ.1.AND.J.EQ.24)THEN -C WRITE(*,5552)'ACMETH',I,J,NX,NY,L,K,N,RGOMP,RGOGZ,RGOGX,GOMM -C 2,ECHZ,FCNP(N,K),TFNG(N,K),OMA(N,K),FOQA,COQA(K,L,NY,NX),OQA(K,L,NY,NX) -C 3,OMC(1,N,K,L,NY,NX),OMC(2,N,K,L,NY,NX),OMC(3,N,K,L,NY,NX) -C 3,OMN(1,N,K,L,NY,NX),OMN(2,N,K,L,NY,NX),OMN(3,N,K,L,NY,NX) -C 5,VOLWM(NPH,L,NY,NX),PSISM(L,NY,NX),WFNG,COXYS(L,NY,NX) -C 6,OHA(K,L,NY,NX),FSBST(N,K),SPOMC2 -5552 FORMAT(A8,7I4,40E12.4) -C ENDIF - ENDIF -C -C RESPIRATION RATES BY AUTOTROPHS 'RGOMP' FROM SPECIFIC -C OXIDATION RATE, ACTIVE BIOMASS, DOC CONCENTRATION, -C MICROBIAL C:N:P FACTOR, AND TEMPERATURE FOLLOWED BY POTENTIAL -C RESPIRATION RATES 'RGOMP' WITH UNLIMITED SUBSTRATE USED FOR MICROBIAL -C COMPETITION FACTOR. N=(1) NH4 OXIDIZERS (2) NO2 OXIDIZERS, -C (3) CH4 OXIDIZERS, (5) H2TROPHIC METHANOGENS -C - ELSEIF(K.EQ.5)THEN - XCO2=CCO2S(L,NY,NX)/(CCO2S(L,NY,NX)+CCKM) - CNH3SI=1.0+CNH3S(L,NY,NX)/C3KI - CNH3BI=1.0+CNH3B(L,NY,NX)/C3KI -C -C NH3 OXIDIZERS -C - IF(N.EQ.1)THEN -C -C FACTOR TO REGULATE COMPETITION FOR NH4 AMONG DIFFERENT -C MICROBIAL AND ROOT POPULATIONS -C - IF(RNH4Y(L,NY,NX).GT.ZEROS(NY,NX))THEN - FNH4=AMAX1(FMN,RVMX4(N,K,L,NY,NX)/RNH4Y(L,NY,NX)) - ELSE - FNH4=AMAX1(FMN,VLNH4(L,NY,NX)*FOMA(N,K)) - ENDIF - IF(RNHBY(L,NY,NX).GT.ZEROS(NY,NX))THEN - FNB4=AMAX1(FMN,RVMB4(N,K,L,NY,NX)/RNHBY(L,NY,NX)) - ELSE - FNB4=AMAX1(FMN,VLNHB(L,NY,NX)*FOMA(N,K)) - ENDIF - TFNH4X=TFNH4X+FNH4 - TFNH4B=TFNH4B+FNB4 -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)/CNH3SI - FCN3B=FNHBS*CNH3B(L,NY,NX)/(CNH3B(L,NY,NX)+ZHKM)/CNH3BI - FSBST(N,K)=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))) - 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 -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.4)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,RNFNG,ZNFNI(L,NY,NX),ZNFNG(L,NY,NX),ZNFNA -C 9,SPOMC2,DOMA,DOMX(K),DOMK,BKVL(L,NY,NX) -6666 FORMAT(A8,5I4,40E12.4) -C ENDIF -C -C NO2 OXIDIZERS -C - ELSEIF(N.EQ.2)THEN -C -C FACTOR TO REGULATE COMPETITION FOR NO2 AMONG DIFFERENT -C MICROBIAL POPULATIONS -C - IF(RNO2Y(L,NY,NX).GT.ZEROS(NY,NX))THEN - FNO2=AMAX1(FMN,RVMX2(N,K,L,NY,NX)/RNO2Y(L,NY,NX)) - ELSE - FNO2=AMAX1(FMN,FOMN(N,K)*VLNO3(L,NY,NX)) - ENDIF - IF(RN2BY(L,NY,NX).GT.ZEROS(NY,NX))THEN - FNB2=AMAX1(FMN,RVMB2(N,K,L,NY,NX)/RN2BY(L,NY,NX)) - ELSE - FNB2=AMAX1(FMN,FOMN(N,K)*VLNOB(L,NY,NX)) - ENDIF - TFNO2X=TFNO2X+FNO2 - TFNO2B=TFNO2B+FNB2 -C -C NO2 OXIDATION FROM SPECIFIC OXIDATION RATE, ENERGY YIELD, -C ACTIVE OXIDIZER BIOMASS, TEMPERATURE, AQUEOUS CO2 AND -C NO2 CONCENTRATIONS -C - ECHZ=EO2X - VMXA=TFNG(N,K)*FCNP(N,K)*XCO2*OMA(N,K)*VMXN - FCN2S=FNH4S*CNO2S(L,NY,NX)/(CNO2S(L,NY,NX)+ZNKM)/CNH3SI - FCN2B=FNHBS*CNO2B(L,NY,NX)/(CNO2B(L,NY,NX)+ZNKM)/CNH3BI - FSBST(N,K)=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))) - 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 -C -C O2 DEMAND FROM NO2 OXIDATION -C - ROXYM(N,K)=2.667*RGOMP - ROXYP(N,K)=ROXYM(N,K)+1.143*RVOXP - ROXYS(N,K,L,NY,NX)=ROXYP(N,K) -C IF((I/30)*30.EQ.I.AND.J.EQ.15.AND.L.LE.6)THEN -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 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) -C 7,DOMA,SPOMC2 -6667 FORMAT(A8,5I4,50E12.4) -C ENDIF -C -C H2TROPHIC METHANOGENS -C - ELSEIF(N.EQ.5)THEN -C -C CO2 REDUCTION FROM SPECIFIC REDUCTION RATE, ENERGY YIELD, -C ACTIVE OXIDIZER BIOMASS, TEMPERATURE, AQUEOUS CO2 AND -C - GH2H=GH2X/12.0 - ECHZ=AMAX1(EO2X,AMIN1(1.0,1.0/(1.0+AMAX1(0.0,(GCOX+GH2H))/EOMH))) - VMXA=TFNG(N,K)*FCNP(N,K)*XCO2*OMA(N,K)*VMXC - H2GSX=H2GS(L,NY,NX)+0.111*TRH2G - FSBST(N,K)=CH2GS(L,NY,NX)/(CH2GS(L,NY,NX)+H2KM) - RGOMP=AMAX1(0.0,AMIN1(1.5*H2GSX,VMXA*FSBST(N,K))) - ROXYM(N,K)=0.0 - ROXYM(N,K)=0.0 - ROXYS(N,K,L,NY,NX)=0.0 - TCH4A=TCH4A+RGOMP -C IF((I/30)*30.EQ.I.AND.NX.EQ.3.AND.NY.EQ.1.AND.J.EQ.24)THEN -C WRITE(*,5553)'H2METH',I,J,NX,NY,L,K,N,RGOMP,H2GS(L,NY,NX) -C 2,H2GSX,CH2GS(L,NY,NX),VMXA,TFNG(N,K),FCNP(N,K),XCO2 -C 3,OMA(N,K),VMXC,ECHZ,GCOX,GH2H,TKS(L,NY,NX),FSBST(N,K),SPOMC2 -5553 FORMAT(A8,7I4,20E12.4) -C ENDIF -C -C METHANOTROPHS -C - ELSEIF(N.EQ.3)THEN -C -C CH4 OXIDATION FROM SPECIFIC OXIDATION RATE, ENERGY YIELD, -C ACTIVE OXIDIZER BIOMASS, TEMPERATURE, AQUEOUS CO2 AND -C CH4 CONCENTRATIONS IN BAND AND NON-BAND SOIL ZONES -C - ECHZ=EO2X - VMXA=TFNG(N,K)*FCNP(N,K)*OMA(N,K)*VMX4 - RCH4L1=RCH4L(L,NY,NX)*XNPG - RCH4F1=RCH4F(L,NY,NX)*XNPG - RCH4S1=(TCH4H+TCH4A)*XNPG - IF(L.EQ.0)THEN - CH4G1=CCH4E(NY,NX)*VOLPM(1,L,NY,NX) - ELSE - CH4G1=CCH4G(L,NY,NX)*VOLPM(1,L,NY,NX) - ENDIF - CH4S1=CH4S(L,NY,NX) - VMXA1=VMXA*XNPG - RVOXP=0.0 - RGOMP=0.0 -C -C CH4 DISSOLUTION FROM GASEOUS PHASE SOLVED IN SHORTER TIME STEP -C TO MAINTAIN AQUEOUS CH4 CONCENTRATION DURING OXIDATION -C - DO 320 M=1,NPH - IF(VOLWM(M,L,NY,NX).GT.ZEROS(NY,NX))THEN - VOLWCH=VOLWM(M,L,NY,NX)*SCH4L(L,NY,NX) - VOLWPM=VOLWCH+VOLPM(M,L,NY,NX) - DO 325 MM=1,NPT - CH4G1=CH4G1+RCH4F1 - CH4S1=CH4S1+RCH4L1+RCH4S1 - CCH4S1=AMAX1(0.0,CH4S1/VOLWM(M,L,NY,NX)) - FSBST(N,K)=CCH4S1/(CCH4S1+CCK4) - RVOXP1=AMIN1(AMAX1(0.0,CH4S1)/(1.0+ECHO*ECHZ) - 2,VMXA1*FSBST(N,K)) - RGOMP1=RVOXP1*ECHO*ECHZ - CH4S1=CH4S1-RVOXP1-RGOMP1 - IF(THETPM(M,L,NY,NX).GT.THETX)THEN - RCHDF=DFGS(M,L,NY,NX)*(AMAX1(ZEROS(NY,NX),CH4G1)*VOLWCH - 2-CH4S1*VOLPM(M,L,NY,NX))/VOLWPM - ELSE - RCHDF=0.0 - ENDIF - CH4G1=CH4G1-RCHDF - CH4S1=CH4S1+RCHDF - RVOXP=RVOXP+RVOXP1 - RGOMP=RGOMP+RGOMP1 -C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.EQ.0 -C 2.AND.MM.EQ.NPT)THEN -C WRITE(*,5547)'CH4OX',I,J,NX,NY,L,K,N,M,MM,RVOXP1,RGOMP1,CH4G1 -C 2,CH4S1,VMXA1,RVOXP,RGOMP,RCHDF,RCH4L1,RCH4F1,RCH4S1,CCH4S1 -C 3,ECHO,ECHZ,OMA(N,K),VOLWM(M,L,NY,NX),VOLPM(M,L,NY,NX),VOLWCH -C 4,THETPM(M,L,NY,NX),SCH4L(L,NY,NX),DFGS(M,L,NY,NX) -C 5,COXYS(L,NY,NX),CCH4E(NY,NX),FSBST(N,K),SPOMC2 -C 6,CH4G1/VOLPM(M,L,NY,NX) -5547 FORMAT(A8,9I4,30E12.4) -C ENDIF -325 CONTINUE - ENDIF -320 CONTINUE - RVOXPA=RVOXP - RVOXPB=0.0 -C -C O2 DEMAND FROM CH4 OXIDATION -C - ROXYM(N,K)=2.667*RGOMP - ROXYP(N,K)=ROXYM(N,K)+4.00*RVOXP - ROXYS(N,K,L,NY,NX)=ROXYP(N,K) - ELSE - RGOMP=0.0 - ROXYM(N,K)=0.0 - ROXYP(N,K)=0.0 - ROXYS(N,K,L,NY,NX)=0.0 - ENDIF - ELSE - RGOMP=0.0 - ROXYM(N,K)=0.0 - ROXYP(N,K)=0.0 - ROXYS(N,K,L,NY,NX)=0.0 - ENDIF -C -C O2 UPTAKE BY AEROBES -C - RUPOX(N,K)=0.0 - IF(N.LE.3.OR.N.EQ.6)THEN - IF(ROXYP(N,K).GT.ZEROS(NY,NX).AND.FOXYX.GT.ZERO)THEN - IF(L.NE.0.OR.VOLX(L,NY,NX).GT.ZEROS(NY,NX))THEN -C -C MAXIMUM O2 UPAKE FROM POTENTIAL RESPIRATION OF EACH AEROBIC -C POPULATION -C - RUPMX=ROXYP(N,K)*XNPG - ROXYFX=ROXYF(L,NY,NX)*XNPG*FOXYX - OLSGL1=OLSGL(L,NY,NX)*XNPG - IF(L.NE.0)THEN - OXYG1=OXYG(L,NY,NX)*FOXYX - ROXYLX=ROXYL(L,NY,NX)*XNPG*FOXYX - ELSE - OXYG1=COXYG(L,NY,NX)*VOLPM(1,L,NY,NX)*FOXYX - ROXYLX=(ROXYL(L,NY,NX)+FLQRQ(NY,NX)*COXR(NY,NX) - 2+FLQRI(NY,NX)*COXQ(NY,NX))*XNPG*FOXYX - ENDIF - OXYS1=OXYS(L,NY,NX)*FOXYX -C -C O2 DISSOLUTION FROM GASEOUS PHASE SOLVED IN SHORTER TIME STEP -C TO MAINTAIN AQUEOUS O2 CONCENTRATION DURING REDUCTION -C - DO 420 M=1,NPH -C -C ACTUAL REDUCTION OF AQUEOUS BY AEROBES CALCULATED -C FROM MASS FLOW PLUS DIFFUSION = ACTIVE UPTAKE -C COUPLED WITH DISSOLUTION OF GASEOUS O2 DURING REDUCTION -C OF AQUEOUS O2 FROM DISSOLUTION RATE CONSTANT 'DFGS' -C CALCULATED IN 'WATSUB' -C - THETW1=AMAX1(0.0,VOLWM(M,L,NY,NX)/VOLX(L,NY,NX)) - RRADO=ORAD*(FILM(M,L,NY,NX)+ORAD)/FILM(M,L,NY,NX) - DIFOX=TORT(M,L,NY,NX)*OLSGL1*12.57*BIOS*OMA(N,K)*RRADO - VOLWOX=VOLWM(M,L,NY,NX)*SOXYL(L,NY,NX) - VOLPOX=VOLPM(M,L,NY,NX) - VOLWPM=VOLWOX+VOLPOX - DO 425 MX=1,NPT - OXYG1=OXYG1+ROXYFX - OXYS1=OXYS1+ROXYLX - COXYS1=AMIN1(COXYE(NY,NX)*SOXYL(L,NY,NX) - 2,AMAX1(0.0,OXYS1/(VOLWM(M,L,NY,NX)*FOXYX))) - X=DIFOX*COXYS1 - IF(X.GT.ZEROS(NY,NX).AND.OXYS1.GT.ZEROS(NY,NX))THEN - B=-RUPMX-DIFOX*OXKX-X - C=X*RUPMX - RMPOX=(-B-SQRT(B*B-4.0*C))/2.0 - ELSE - RMPOX=0.0 - ENDIF - OXYS1=OXYS1-RMPOX - IF(THETPM(M,L,NY,NX).GT.THETX.AND.VOLPOX.GT.ZEROS(NY,NX))THEN - ROXDFQ=DFGS(M,L,NY,NX)*(AMAX1(ZEROS(NY,NX),OXYG1)*VOLWOX - 2-OXYS1*VOLPOX)/VOLWPM - ELSE - ROXDFQ=0.0 - ENDIF - OXYG1=OXYG1-ROXDFQ - OXYS1=OXYS1+ROXDFQ - RUPOX(N,K)=RUPOX(N,K)+RMPOX - ROXSK(M,L,NY,NX)=ROXSK(M,L,NY,NX)+RMPOX -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 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) -C ENDIF -C IF((I/10)*10.EQ.I.AND.J.EQ.16.AND.L.EQ.NU(NY,NX) -C 2.AND.K.EQ.4.AND.N.EQ.2)THEN -C WRITE(*,5544)'OXY',I,J,L,K,N,M,MX,RUPOX(N,K),ROXYP(N,K) -C 2,ROXSK(M,L,NY,NX),RUPMX,RMPOX,DIFOX,OLSGL1,BIOS,OMA(N,K),X -C 2,ROXDFQ,ROXYLX,ROXYFX,FOXYX,COXYS1,OXYS1,OXYG1,OXYS1 -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 -5544 FORMAT(A8,7I4,50E12.4) -C ENDIF -425 CONTINUE -420 CONTINUE -C -C RATIO OF ACTUAL O2 UPAKE TO BIOLOGICAL DEMAND -C - WFN(N,K)=AMIN1(1.0,AMAX1(0.0,RUPOX(N,K)/ROXYP(N,K))) - IF(K.LE.4)THEN - ROQCS(N,K,L,NY,NX)=ROQCS(N,K,L,NY,NX)*WFN(N,K) - ROQAS(N,K,L,NY,NX)=ROQAS(N,K,L,NY,NX)*WFN(N,K) - ROQCD(N,K)=ROQCD(N,K)*WFN(N,K) - ENDIF - IF(K.EQ.5)THEN - IF(N.EQ.1)THEN - RVMX4(N,K,L,NY,NX)=RVMX4(N,K,L,NY,NX)*WFN(N,K) - RVMB4(N,K,L,NY,NX)=RVMB4(N,K,L,NY,NX)*WFN(N,K) - ELSEIF(N.EQ.2)THEN - RVMX2(N,K,L,NY,NX)=RVMX2(N,K,L,NY,NX)*WFN(N,K) - RVMB2(N,K,L,NY,NX)=RVMB2(N,K,L,NY,NX)*WFN(N,K) - ENDIF - ENDIF - ELSE - RUPOX(N,K)=ROXYP(N,K) - WFN(N,K)=1.0 - ENDIF - ELSE - RUPOX(N,K)=0.0 - WFN(N,K)=1.0 - ENDIF -C -C RESPIRATION PRODUCTS ALLOCATED TO O2, CO2, ACETATE, CH4, H2 -C - RGOMO(N,K)=RGOMP*WFN(N,K) - RCO2X(N,K)=RGOMO(N,K) - RCH3X(N,K)=0.0 - RCH4X(N,K)=0.0 - ROXYO(N,K)=ROXYM(N,K)*WFN(N,K) - RH2GX(N,K)=0.0 - IF(K.EQ.5)THEN - RVOXA(N)=RVOXPA*WFN(N,K) - RVOXB(N)=RVOXPB*WFN(N,K) - ENDIF - ELSEIF(N.EQ.4.OR.N.EQ.7)THEN - RGOMO(N,K)=RGOMP - RCO2X(N,K)=0.333*RGOMO(N,K) - RCH3X(N,K)=0.667*RGOMO(N,K) - RCH4X(N,K)=0.0 - ROXYO(N,K)=ROXYM(N,K) - IF(K.LE.4)THEN - RH2GX(N,K)=0.111*RGOMO(N,K) - ELSE - RH2GX(N,K)=0.0 - ENDIF - ELSEIF(N.EQ.5)THEN - RGOMO(N,K)=RGOMP - IF(K.LE.4)THEN - RCO2X(N,K)=0.50*RGOMO(N,K) - RCH3X(N,K)=0.00 - RCH4X(N,K)=0.50*RGOMO(N,K) - ROXYO(N,K)=ROXYM(N,K) - RH2GX(N,K)=0.0 - ELSEIF(K.EQ.5)THEN - RCO2X(N,K)=0.00 - RCH3X(N,K)=0.00 - RCH4X(N,K)=RGOMO(N,K) - ROXYO(N,K)=ROXYM(N,K) - RH2GX(N,K)=0.0 - RH2GZ=0.667*RGOMO(N,K) - ENDIF - ENDIF -C -C HETEROTROPHIC DENITRIFICATION -C - IF(K.LE.4.AND.N.EQ.2.AND.ROXYM(N,K).GT.0.0 - 2.AND.(L.NE.0.OR.VOLX(L,NY,NX).GT.ZEROS(NY,NX)))THEN -C -C FACTOR TO CONSTRAIN NO3 UPAKE AMONG COMPETING MICROBIAL -C AND ROOT POPULATIONS -C - IF(RNO3Y(L,NY,NX).GT.ZEROS(NY,NX))THEN - FNO3=AMAX1(FMN,RVMX3(N,K,L,NY,NX)/RNO3Y(L,NY,NX)) - ELSE - FNO3=AMAX1(FMN,FOMA(N,K)*VLNO3(L,NY,NX)) - ENDIF - IF(RN3BY(L,NY,NX).GT.ZEROS(NY,NX))THEN - FNB3=AMAX1(FMN,RVMB3(N,K,L,NY,NX)/RN3BY(L,NY,NX)) - ELSE - FNB3=AMAX1(FMN,FOMA(N,K)*VLNOB(L,NY,NX)) - ENDIF - TFNO3X=TFNO3X+FNO3 - TFNO3B=TFNO3B+FNB3 -C -C NO3 REDUCTION FROM SPECIFIC REDUCTION RATE, ENERGY YIELD, -C ACTIVE DENITRIFIER BIOMASS, TEMPERATURE, AQUEOUS NO3 -C CONCENTRATIONS AND STOICHIOMETRY OF REDOX ELECTRON TRANSFER -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 - IF(CNO3S(L,NY,NX).GT.ZERO)THEN - VMXD3S=VMXD3*FNO3S*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 - ENDIF - IF(CNO3B(L,NY,NX).GT.ZERO)THEN - VMXD3B=VMXD3*FNO3B*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 - ENDIF - OQCZ3=AMAX1(0.0,OQC(K,L,NY,NX)*FOQC-RGOCP*WFN(N,K)) - OQCD3=OQCZ3/ECN3 - OQCD3S=OQCD3*FNO3S - OQCD3B=OQCD3*FNO3B - ZNO3SX=ZNO3S(L,NY,NX)*FNO3 - ZNO3BX=ZNO3B(L,NY,NX)*FNB3 - RDNO3X=AMAX1(0.0,AMIN1(ZNO3SX,VMXD3S)) - RDNOBX=AMAX1(0.0,AMIN1(ZNO3BX,VMXD3B)) - RDNO3(N,K)=AMAX1(0.0,AMIN1(VMXD3S,OQCD3S,ZNO3SX)) - RDNOB(N,K)=AMAX1(0.0,AMIN1(VMXD3B,OQCD3B,ZNO3BX)) - RDNOX=RDNO3X+RDNOBX - RDNOT=RDNO3(N,K)+RDNOB(N,K) - RGOM3X=ECN3*RDNOX - RGOMD3=ECN3*RDNOT - RVMX3(N,K,L,NY,NX)=VMXD3S - RVMB3(N,K,L,NY,NX)=VMXD3B -C -C FACTOR TO CONSTRAIN NO2 UPAKE AMONG COMPETING MICROBIAL -C POPULATIONS -C - IF(RNO2Y(L,NY,NX).GT.ZEROS(NY,NX))THEN - FNO2=AMAX1(FMN,RVMX2(N,K,L,NY,NX)/RNO2Y(L,NY,NX)) - ELSE - FNO2=AMAX1(FMN,FOMA(N,K)*VLNO3(L,NY,NX)) - ENDIF - IF(RN2BY(L,NY,NX).GT.ZEROS(NY,NX))THEN - FNB2=AMAX1(FMN,RVMB2(N,K,L,NY,NX)/RN2BY(L,NY,NX)) - ELSE - FNB2=AMAX1(FMN,FOMA(N,K)*VLNOB(L,NY,NX)) - ENDIF - TFNO2X=TFNO2X+FNO2 - TFNO2B=TFNO2B+FNB2 -C -C NO2 REDUCTION FROM SPECIFIC REDUCTION RATE, ENERGY YIELD, -C ACTIVE DENITRIFIER BIOMASS, TEMPERATURE, AQUEOUS NO2 -C CONCENTRATIONS AND STOICHIOMETRY OF REDOX ELECTRON TRANSFER -C NOT ACCEPTED BY O2 AND NO3 IN BAND AND NON-BAND SOIL ZONES -C - VMXD2=VMXD3-RDNOT - IF(CNO2S(L,NY,NX).GT.ZERO)THEN - VMXD2S=VMXD2*FNO3S*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 - ENDIF - IF(CNO2B(L,NY,NX).GT.ZERO)THEN - VMXD2B=VMXD2*FNO3B*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 - ENDIF - OQCZ2=AMAX1(0.0,OQCZ3-RGOMD3) - OQCD2=OQCZ2/ECN2 - OQCD2S=OQCD2*FNO3S - OQCD2B=OQCD2*FNO3B - ZNO2SX=(ZNO2S(L,NY,NX)+RDNO3(N,K))*FNO2 - ZNO2BX=(ZNO2B(L,NY,NX)+RDNOB(N,K))*FNB2 - RDNO2X=AMAX1(0.0,AMIN1(ZNO2SX,VMXD2S)) - RDNOBX=AMAX1(0.0,AMIN1(ZNO2BX,VMXD2B)) - RDNO2(N,K)=AMAX1(0.0,AMIN1(VMXD2S,OQCD2S,ZNO2SX)) - RDN2B(N,K)=AMAX1(0.0,AMIN1(VMXD2B,OQCD2B,ZNO2BX)) - RDN2X=RDNO2X+RDNOBX - RDN2T=RDNO2(N,K)+RDN2B(N,K) - RGOM2X=ECN2*RDN2X - RGOMD2=ECN2*RDN2T - RVMX2(N,K,L,NY,NX)=VMXD2S - RVMB2(N,K,L,NY,NX)=VMXD2B -C -C FACTOR TO CONSTRAIN N2O UPAKE AMONG COMPETING MICROBIAL -C AND ROOT POPULATIONS -C - IF(RN2OY(L,NY,NX).GT.ZEROS(NY,NX))THEN - FN2O=AMAX1(FMN,RVMX1(N,K,L,NY,NX)/RN2OY(L,NY,NX)) - ELSE - FN2O=AMAX1(FMN,FOMA(N,K)) - ENDIF - TFN2OX=TFN2OX+FN2O -C -C N2O REDUCTION FROM SPECIFIC REDUCTION RATE, ENERGY YIELD, -C ACTIVE DENITRIFIER BIOMASS, TEMPERATURE, AQUEOUS N2O -C CONCENTRATIONS AND STOICHIOMETRY OF REDOX ELECTRON TRANSFER -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) - OQCZ1=AMAX1(0.0,OQCZ2-RGOMD2) - OQCD1=OQCZ1/ECN1 - Z2OSX=(Z2OS(L,NY,NX)+RDN2T)*FN2O - RDN2OX=AMAX1(0.0,AMIN1(Z2OSX,VMXD1S)) - RDN2O(N,K)=AMAX1(0.0,AMIN1(VMXD1S,OQCD1,Z2OSX)) - RGOM1X=ECN1*RDN2OX - RGOMD1=ECN1*RDN2O(N,K) - RGOMY(N,K)=RGOM3X+RGOM2X+RGOM1X - RGOMD(N,K)=RGOMD3+RGOMD2+RGOMD1 - 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 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) -C 3,ROXYO(N,K),OMA(N,K),VMXD,CNO3S(L,NY,NX),CNO3B(L,NY,NX) -C 4,CNO2S(L,NY,NX),CNO2B(L,NY,NX),CZ2OS(L,NY,NX),VLNO3(L,NY,NX) -C 5,VLNOB(L,NY,NX),THETW(L,NY,NX),THETI(L,NY,NX),FOMA(N,K) -C 5,ZNO3S(L,NY,NX),ZNO3B(L,NY,NX),ZNO2S(L,NY,NX),ZNO2B(L,NY,NX) -C 6,Z2OS(L,NY,NX),RGOMY(N,K),RGOMD(N,K),TOMA,FOXYX,FNO23S,FNO23B -C 7,OQC(K,L,NY,NX),FOQC,RGOCP,WFN(N,K),VOLWZ,FOSRH(K,L,NY,NX),ZERO -C 9,RGOM3X,RGOM2X,RGOM1X,FNO3,FNO2,FN2O,ZNO3SX,ZNO2SX,Z2OSX -C 3,OQCD3S,OQCD2S,OQCD1,VMXD3S,VMXD2S,VMXD1S,VMXD3,VMXD2,VMXD1 -C 4,ROXYD,VMXDX,TFNX,WFNG,TFNG(N,K),PSISM(L,NY,NX) -C 2,(1.0+(CNO2S(L,NY,NX)*Z3KM)/(CNO3S(L,NY,NX)*Z2KM)) -C 2,(1.0+(CZ2OS(L,NY,NX)*Z2KM)/(CNO2S(L,NY,NX)*Z1KM)) -2222 FORMAT(A8,5I4,70E12.4) -C ENDIF -C -C AUTOTROPHIC DENITRIFICATION -C - ELSEIF(K.EQ.5.AND.N.EQ.1.AND.ROXYM(N,K).GT.0.0 - 2.AND.(L.NE.0.OR.VOLX(L,NY,NX).GT.ZEROS(NY,NX)))THEN -C -C FACTOR TO CONSTRAIN NO2 UPAKE AMONG COMPETING MICROBIAL -C POPULATIONS -C - IF(RNO2Y(L,NY,NX).GT.ZEROS(NY,NX))THEN - FNO2=AMAX1(FMN,RVMX2(N,K,L,NY,NX)/RNO2Y(L,NY,NX)) - ELSE - FNO2=AMAX1(FMN,FOMN(N,K)*VLNO3(L,NY,NX)) - ENDIF - IF(RN2BY(L,NY,NX).GT.ZEROS(NY,NX))THEN - FNB2=AMAX1(FMN,RVMB2(N,K,L,NY,NX)/RN2BY(L,NY,NX)) - ELSE - FNB2=AMAX1(FMN,FOMN(N,K)*VLNOB(L,NY,NX)) - ENDIF - TFNO2X=TFNO2X+FNO2 - TFNO2B=TFNO2B+FNB2 -C -C NO2 REDUCTION FROM SPECIFIC REDUCTION RATE, ENERGY YIELD, -C ACTIVE NITRIFIER BIOMASS, TEMPERATURE, AQUEOUS NO2 AND CO2 -C CONCENTRATIONS AND STOICHIOMETRY OF REDOX ELECTRON TRANSFER -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)) - 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 - 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/10)*10.EQ.I.AND.J.EQ.14)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,VMXD,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,VMXDX,VMXDA,RVOXA(N),RVOXB(N) -7777 FORMAT(A8,5I4,40E12.4) -C ENDIF - ELSE - RDNO3(N,K)=0.0 - RDNOB(N,K)=0.0 - RDNO2(N,K)=0.0 - RDN2B(N,K)=0.0 - RDN2O(N,K)=0.0 - RGOMY(N,K)=0.0 - RGOMD(N,K)=0.0 - ENDIF -C -C BIOMASS DECOMPOSITION AND MINERALIZATION -C -C -C MINERALIZATION-IMMOBILIZATION OF NH4 IN SOIL FROM MICROBIAL -C C:N AND NH4 CONCENTRATION IN BAND AND NON-BAND SOIL ZONES -C - RINHP=(OMC(3,N,K,L,NY,NX)*CNOMC(3,N,K)-OMN(3,N,K,L,NY,NX)) - IF(RINHP.GT.0.0)THEN - CNH4X=AMAX1(0.0,CNH4S(L,NY,NX)-Z4MN) - CNH4Y=AMAX1(0.0,CNH4B(L,NY,NX)-Z4MN) - RINHX=AMIN1(RINHP,BIOA*OMA(N,K)*TFNG(N,K)*Z4MX) - RINHO(N,K,L,NY,NX)=FNH4S*RINHX*CNH4X/(CNH4X+Z4KU) - RINHB(N,K,L,NY,NX)=FNHBS*RINHX*CNH4Y/(CNH4Y+Z4KU) - ZNH4M=Z4MN*VOLW(L,NY,NX)*FNH4S - ZNHBM=Z4MN*VOLW(L,NY,NX)*FNHBS - RINH4(N,K)=AMIN1(FNH4X*AMAX1(0.0,(ZNH4S(L,NY,NX)-ZNH4M)) - 2,RINHO(N,K,L,NY,NX)) - RINB4(N,K)=AMIN1(FNB4X*AMAX1(0.0,(ZNH4B(L,NY,NX)-ZNHBM)) - 2,RINHB(N,K,L,NY,NX)) - ELSE - RINHO(N,K,L,NY,NX)=0.0 - RINHB(N,K,L,NY,NX)=0.0 - RINH4(N,K)=RINHP*FNH4S - RINB4(N,K)=RINHP*FNHBS - ENDIF -C TRINH4(NY,NX)=TRINH4(NY,NX)+(RINH4(N,K)+RINB4(N,K)) -C 2/AREA(3,L,NY,NX) -C IF(I.EQ.365.AND.J.EQ.24.AND.L.EQ.NJ(NY,NX) -C 2.AND.K.EQ.5.AND.N.EQ.3)THEN -C WRITE(*,7776)'RINH4',IYRC,I,J,NX,NY,L,K,N,TRINH4(NY,NX) -C 1,RINH4(N,K),RINHP -C 1,BIOA*OMA(N,K)*Z4MX*TFNG(N,K),BIOA,OMA(N,K),Z4MX,TFNG(N,K) -C 2,OMC(M,N,K,L,NY,NX),CNOMC(3,N,K),OMN(M,N,K,L,NY,NX) -C 3,RINHO(N,K,L,NY,NX),CNH4S(L,NY,NX),FNH4X -C 4,ZNH4T(L),OQN(K,L,NY,NX) -7776 FORMAT(A8,8I6,30E12.4) -C ENDIF -C -C MINERALIZATION-IMMOBILIZATION OF NO3 IN SOIL FROM MICROBIAL -C C:N AND NO3 CONCENTRATION IN BAND AND NON-BAND SOIL ZONES -C - RINOP=AMAX1(0.0,RINHP-RINH4(N,K)-RINB4(N,K)) - IF(RINOP.GT.0.0)THEN - CNO3X=AMAX1(0.0,CNO3S(L,NY,NX)-ZOMN) - CNO3Y=AMAX1(0.0,CNO3B(L,NY,NX)-ZOMN) - RINOX=AMIN1(RINOP,BIOA*OMA(N,K)*TFNG(N,K)*ZOMX) - RINOO(N,K,L,NY,NX)=FNO3S*RINOX*CNO3X/(CNO3X+ZOKU) - RINOB(N,K,L,NY,NX)=FNO3B*RINOX*CNO3Y/(CNO3Y+ZOKU) - ZNO3M=ZOMN*VOLW(L,NY,NX)*FNO3S - ZNOBM=ZOMN*VOLW(L,NY,NX)*FNO3B - RINO3(N,K)=AMIN1(FNO3X*AMAX1(0.0,(ZNO3S(L,NY,NX)-ZNO3M)) - 2,RINOO(N,K,L,NY,NX)) - RINB3(N,K)=AMIN1(FNB3X*AMAX1(0.0,(ZNO3B(L,NY,NX)-ZNOBM)) - 2,RINOB(N,K,L,NY,NX)) - ELSE - RINOO(N,K,L,NY,NX)=0.0 - RINOB(N,K,L,NY,NX)=0.0 - RINO3(N,K)=RINOP*FNO3S - RINB3(N,K)=RINOP*FNO3B - ENDIF -C -C MINERALIZATION-IMMOBILIZATION OF PO4 IN SOIL FROM MICROBIAL -C C:P AND PO4 CONCENTRATION IN BAND AND NON-BAND SOIL ZONES -C - RIPOP=(OMC(3,N,K,L,NY,NX)*CPOMC(3,N,K)-OMP(3,N,K,L,NY,NX)) - IF(RIPOP.GT.0.0)THEN - CH2PX=AMAX1(0.0,CH2P4(L,NY,NX)-HPMN) - CH2PY=AMAX1(0.0,CH2PB(L,NY,NX)-HPMN) - RIPOX=AMIN1(RIPOP,BIOA*OMA(N,K)*TFNG(N,K)*HPMX) - RIPOO(N,K,L,NY,NX)=FH2PS*RIPOX*CH2PX/(CH2PX+HPKU) - RIPOB(N,K,L,NY,NX)=FH2PB*RIPOX*CH2PY/(CH2PY+HPKU) - H2POM=HPMN*VOLW(L,NY,NX)*FH2PS - H2PBM=HPMN*VOLW(L,NY,NX)*FH2PB - RIPO4(N,K)=AMIN1(FPO4X*AMAX1(0.0,(H2PO4(L,NY,NX)-H2POM)) - 2,RIPOO(N,K,L,NY,NX)) - RIPB4(N,K)=AMIN1(FPB4X*AMAX1(0.0,(H2POB(L,NY,NX)-H2PBM)) - 2,RIPOB(N,K,L,NY,NX)) - ELSE - RIPOO(N,K,L,NY,NX)=0.0 - RIPOB(N,K,L,NY,NX)=0.0 - RIPO4(N,K)=RIPOP*FH2PS - RIPB4(N,K)=RIPOP*FH2PB - ENDIF -C IF(NY.EQ.5.AND.L.EQ.10.AND.K.EQ.3.AND.N.EQ.2)THEN -C WRITE(*,4322)'RIPO4',I,J,NX,NY,L,K,N,RIPO4(N,K),FPO4X,H2P4T(L) -C 2,RIPOO(N,K,L,NY,NX),RIPOP,BIOA,OMA(N,K),TFNG(N,K),HPMX,WFN(N,K) -C 2,VLPO4(L,NY,NX),CH2PX,HPKU,VLPOB(L,NY,NX),CH2PY -C 3,OMC(3,N,K,L,NY,NX),CPOMC(3,N,K),OMP(3,N,K,L,NY,NX),WFNG -4322 FORMAT(A8,7I4,30E12.4) -C ENDIF -C -C MINERALIZATION-IMMOBILIZATION OF NH4 IN SURFACE RESIDUE FROM -C MICROBIAL C:N AND NH4 CONCENTRATION IN BAND AND NON-BAND SOIL -C ZONES OF SOIL SURFACE -C - IF(L.EQ.0)THEN - RINHPR=RINHP-RINH4(N,K)-RINO3(N,K) - IF(RINHPR.GT.0.0)THEN - CNH4X=AMAX1(0.0,CNH4S(NU(NY,NX),NY,NX)-Z4MN) - CNH4Y=AMAX1(0.0,CNH4B(NU(NY,NX),NY,NX)-Z4MN) - RINHOR(N,K,NY,NX)=AMIN1(RINHPR,BIOA*OMA(N,K)*TFNG(N,K)*Z4MX) - 2*(FNH4S*CNH4X/(CNH4X+Z4KU)+FNHBS*CNH4Y - 3/(CNH4Y+Z4KU)) - ZNH4M=Z4MN*VOLW(NU(NY,NX),NY,NX) - RINH4R(N,K)=AMIN1(FNH4XR(N,K)*AMAX1(0.0,(ZNH4T(NU(NY,NX))-ZNH4M)) - 2,RINHOR(N,K,NY,NX)) - ELSE - RINHOR(N,K,NY,NX)=0.0 - RINH4R(N,K)=RINHPR - ENDIF -C TRINH4(NY,NX)=TRINH4(NY,NX)+RINH4R(N,K) -C 2/AREA(3,L,NY,NX) -C IF(K.EQ.2.AND.N.EQ.1)THEN -C WRITE(*,7778)'RINH4R',I,J,NX,NY,L,K,N,RINH4R(N,K),RINHPR -C 2,BIOA*OMA(N,K)*Z4MX,RINHP,RINH4(N,K),RINO3(N,K) -C 3,RINHOR(N,K,NY,NX),CNH4S(NU(NY,NX),NY,NX),FNH4XR(N,K) -C 4,ZNH4T(NU(NY,NX)) -7778 FORMAT(A8,7I4,20E12.4) -C ENDIF -C -C MINERALIZATION-IMMOBILIZATION OF NO3 IN SURFACE RESIDUE FROM -C MICROBIAL C:N AND NO3 CONCENTRATION IN BAND AND NON-BAND SOIL -C ZONES OF SOIL SURFACE -C - RINOPR=AMAX1(0.0,RINHPR-RINH4R(N,K)) - IF(RINOPR.GT.0.0)THEN - CNO3X=AMAX1(0.0,CNO3S(NU(NY,NX),NY,NX)-ZOMN) - CNO3Y=AMAX1(0.0,CNO3B(NU(NY,NX),NY,NX)-ZOMN) - RINOOR(N,K,NY,NX)=AMAX1(RINOPR,BIOA*OMA(N,K)*TFNG(N,K)*ZOMX) - 2*(FNO3S*CNO3X/(CNO3X+ZOKU)+FNO3B*CNO3Y - 3/(CNO3Y+ZOKU)) - ZNO3M=ZOMN*VOLW(NU(NY,NX),NY,NX) - RINO3R(N,K)=AMIN1(FNO3XR(N,K)*AMAX1(0.0,(ZNO3T(NU(NY,NX))-ZNO3M)) - 2,RINOOR(N,K,NY,NX)) - ELSE - RINOOR(N,K,NY,NX)=0.0 - RINO3R(N,K)=RINOPR - ENDIF -C -C MINERALIZATION-IMMOBILIZATION OF PO4 IN SURFACE RESIDUE FROM -C MICROBIAL C:P AND PO4 CONCENTRATION IN BAND AND NON-BAND SOIL -C ZONES OF SOIL SURFACE -C - RIPOPR=RIPOP-RIPO4(N,K) - IF(RIPOPR.GT.0.0)THEN - CH2PX=AMAX1(0.0,CH2P4(NU(NY,NX),NY,NX)-HPMN) - CH2PY=AMAX1(0.0,CH2PB(NU(NY,NX),NY,NX)-HPMN) - RIPOOR(N,K,NY,NX)=AMIN1(RIPOPR,BIOA*OMA(N,K)*TFNG(N,K)*HPMX) - 2*(FH2PS*CH2PX/(CH2PX+HPKU)+FH2PB*CH2PY - 3/(CH2PY+HPKU)) - H2P4M=HPMN*VOLW(NU(NY,NX),NY,NX) - RIPO4R(N,K)=AMIN1(FPO4XR(N,K)*AMAX1(0.0,(H2P4T(NU(NY,NX))-H2P4M)) - 2,RIPOOR(N,K,NY,NX)) - ELSE - RIPOOR(N,K,NY,NX)=0.0 - RIPO4R(N,K)=RIPOPR - ENDIF -C WRITE(*,7778)'RIPO4R',I,J,NX,NY,L,K,N,RIPO4R(N,K),FPO4XR(N,K) -C 2,H2P4T(NU(NY,NX)),H2P4M,RIPOOR(N,K,NY,NX),RIPOPR - ENDIF -C -C pH EFFECT ON MAINTENANCE RESPIRATION -C - IF(SPOMC2.GT.0.0)THEN - FPH=1.0+AMAX1(0.0,0.25*(6.5-PH(L,NY,NX))) - RMOMX=RMOM*TFNR(N,K)*FPH - RMOMC(1,N,K)=OMN(1,N,K,L,NY,NX)*RMOMX - RMOMC(2,N,K)=OMN2(N,K)*RMOMX - ELSE - RMOMC(1,N,K)=0.0 - RMOMC(2,N,K)=0.0 - ENDIF -C -C MICROBIAL MAINTENANCE AND GROWTH RESPIRATION -C - RMOMT=RMOMC(1,N,K)+RMOMC(2,N,K) - RGOMT=AMAX1(0.0,RGOMO(N,K)-RMOMT) - RXOMT=AMAX1(0.0,RMOMT-RGOMO(N,K)) -C -C N2 FIXATION: N=(6) AEROBIC, (7) ANAEROBIC -C FROM GROWTH RESPIRATION, FIXATION ENERGY REQUIREMENT, -C MICROBIAL N REQUIREMENT IN LABILE (1) AND RESISTANT (2) FRACTIONS -C - IF(K.LE.4.AND.(N.EQ.6.OR.N.EQ.7))THEN - RGN2P=AMAX1(0.0,OMC(3,N,K,L,NY,NX)*CNOMC(3,N,K) - 2-OMN(3,N,K,L,NY,NX))/EN2F(N) - RGN2F(N,K)=AMIN1(RGN2P,RGOMT) - 2*CZ2GS(L,NY,NX)/(CZ2GS(L,NY,NX)+ZFKM) - RN2FX(N,K)=RGN2F(N,K)*EN2F(N) -C IF((I/30)*30.EQ.I.AND.J.EQ.12)THEN -C WRITE(*,5566)'N2 FIX',I,J,NX,NY,L,K,N,RN2FX(N,K),EN2F(N) -C 2,OMC(3,N,K,L,NY,NX)*CNOMC(3,N,K),OMN(3,N,K,L,NY,NX) -C 3,RINH4(N,K),RINO3(N,K),RGN2P,RGN2F(N,K),FNFX,RGOMT -C 4,CZ2GS(L,NY,NX) -5566 FORMAT(A8,7I4,30E12.4) -C ENDIF - ELSE - RN2FX(N,K)=0.0 - RGN2F(N,K)=0.0 - ENDIF -C -C DOC, DON, DOP AND ACETATE UPTAKE DRIVEN BY GROWTH RESPIRATION -C FROM O2, NOX AND C REDUCTION -C - CGOMX=AMIN1(RMOMT,RGOMO(N,K))+RGN2F(N,K)+(RGOMT-RGN2F(N,K))/ECHZ - CGOMD=RGOMD(N,K)/ENOX - CGOMC(N,K)=CGOMX+CGOMD - IF(K.LE.4)THEN - CGOQC(N,K)=CGOMX*FGOCP+CGOMD - CGOAC(N,K)=CGOMX*FGOAP - CGOXC=CGOQC(N,K)+CGOAC(N,K) - CGOMN(N,K)=AMAX1(0.0,AMIN1(OQN(K,L,NY,NX)*FOMK(N,K) - 2,CGOXC*CNQ(K)/FCN(N,K))) - CGOMP(N,K)=AMAX1(0.0,AMIN1(OQP(K,L,NY,NX)*FOMK(N,K) - 2,CGOXC*CPQ(K)/FCP(N,K))) - ELSE - CGOQC(N,K)=CGOMX+CGOMD - CGOAC(N,K)=0.0 - CGOMN(N,K)=0.0 - CGOMP(N,K)=0.0 - ENDIF - TCGOQC(K)=TCGOQC(K)+CGOQC(N,K) - TCGOAC(K)=TCGOAC(K)+CGOAC(N,K) - TCGOMN(K)=TCGOMN(K)+CGOMN(N,K) - TCGOMP(K)=TCGOMP(K)+CGOMP(N,K) -C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.EQ.3)THEN -C WRITE(*,5557)'CGOQC',I,J,NX,NY,L,K,N,CGOQC(N,K),CGOMX -C 2,FGOCP,FGOAP,CGOMD,RMOMT,RGN2F(N,K),ECHZ -C 3,RGOMD(N,K),ENOX,RGOMO(N,K),WFN(N,K),FOXYX -C WRITE(*,5557)'CGOMP',I,J,NX,NY,L,K,N,CGOMP(N,K),OQP(K,L,NY,NX) -C 2,FOMK(N,K),CGOXC,CPQ(K),FCP(N,K),CGOQC(N,K),CGOAC(N,K) -5557 FORMAT(A8,7I4,30E12.4) -C ENDIF -C -C TRANSFER UPTAKEN C,N,P FROM STORAGE TO ACTIVE BIOMASS -C - IF(OMC(3,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) - 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)))) - 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))) - RCCC=RCCZ+CCC*RCCY*(1.0-FSBST(N,K)) - RCCN=CNC*RCCX - RCCP=CPC*RCCQ - ELSE - RCCC=RCCZ - RCCN=0.0 - RCCP=0.0 - ENDIF - CGOMZ=TFNG(N,K)*OMGR*AMAX1(0.0,OMC(3,N,K,L,NY,NX)) - DO 745 M=1,2 - CGOMS(M,N,K)=FL(M)*CGOMZ - IF(OMC(3,N,K,L,NY,NX).GT.ZEROS(NY,NX))THEN - CGONS(M,N,K)=AMIN1(FL(M)*AMAX1(0.0,OMN(3,N,K,L,NY,NX)) - 2,CGOMS(M,N,K)*OMN(3,N,K,L,NY,NX)/OMC(3,N,K,L,NY,NX)) - CGOPS(M,N,K)=AMIN1(FL(M)*AMAX1(0.0,OMP(3,N,K,L,NY,NX)) - 2,CGOMS(M,N,K)*OMP(3,N,K,L,NY,NX)/OMC(3,N,K,L,NY,NX)) - ELSE - CGONS(M,N,K)=0.0 - CGOPS(M,N,K)=0.0 - ENDIF -C -C MICROBIAL DECOMPOSITION FROM BIOMASS, SPECIFIC DECOMPOSITION -C RATE, TEMPERATURE -C - SPOMX=SQRT(TFNG(N,K))*SPOMC(M)*SPOMC2 - RXOMC(M,N,K)=AMAX1(0.0,OMC(M,N,K,L,NY,NX)*SPOMX) - 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) - 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) -C -C HUMIFICATION OF MICROBIAL DECOMPOSITION PRODUCTS FROM -C DECOMPOSITION RATE, SOIL CLAY AND OC CONTENT '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 -C WRITE(*,8821)'RHOMC',I,J,L,K,N,M -C 3,CNSHY,CPSHY,FNSHY,FPSHY -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 -C NON-HUMIFIED PRODUCTS TO MICROBIAL RESIDUE -C - RCOMC(M,N,K)=RDOMC(M,N,K)-RHOMC(M,N,K) - RCOMN(M,N,K)=RDOMN(M,N,K)-RHOMN(M,N,K) - RCOMP(M,N,K)=RDOMP(M,N,K)-RHOMP(M,N,K) -745 CONTINUE -C -C MICROBIAL DECOMPOSITION WHEN MAINTENANCE RESPIRATION -C EXCEEDS UPTAKE -C - IF(RXOMT.GT.ZEROS(NY,NX).AND.RMOMT.GT.ZEROS(NY,NX) - 2.AND.RCCC.GT.ZERO)THEN - FRM=RXOMT/RMOMT - DO 730 M=1,2 - RXMMC(M,N,K)=AMIN1(OMC(M,N,K,L,NY,NX) - 2,AMAX1(0.0,FRM*RMOMC(M,N,K)/RCCC)) - RXMMN(M,N,K)=AMIN1(OMN(M,N,K,L,NY,NX) - 2,AMAX1(0.0,RXMMC(M,N,K)*CNOMA(N,K))) - RXMMP(M,N,K)=AMIN1(OMP(M,N,K,L,NY,NX) - 2,AMAX1(0.0,RXMMC(M,N,K)*CPOMA(N,K))) - RDMMC(M,N,K)=RXMMC(M,N,K)*(1.0-RCCC) - RDMMN(M,N,K)=RXMMN(M,N,K)*(1.0-RCCN)*(1.0-RCCC) - RDMMP(M,N,K)=RXMMP(M,N,K)*(1.0-RCCP)*(1.0-RCCC) - R3MMC(M,N,K)=RXMMC(M,N,K)-RDMMC(M,N,K) - R3MMN(M,N,K)=RXMMN(M,N,K)-RDMMN(M,N,K) - R3MMP(M,N,K)=RXMMP(M,N,K)-RDMMP(M,N,K) -C -C HUMIFICATION AND RECYCLING OF RESPIRATION DECOMPOSITION -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) - 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) -C IF(L.EQ.11.AND.K.EQ.1)THEN -C WRITE(*,8821)'RCMMC',I,J,L,K,N,M,RCMMC(M,N,K) -C 2,RDMMC(M,N,K),RHMMC(M,N,K),OMC(M,N,K,L,NY,NX) -C 3,FRM,RMOMC(M,N,K),OMN(1,N,K,L,NY,NX),OMN2(N,K) -C 4,RMOM,TFNR(N,K),FPH,RDMMN(M,N,K),CNSHZ,RDMMP(M,N,K) -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 ENDIF -730 CONTINUE - ELSE - DO 720 M=1,2 - RXMMC(M,N,K)=0.0 - RXMMN(M,N,K)=0.0 - RXMMP(M,N,K)=0.0 - RDMMC(M,N,K)=0.0 - RDMMN(M,N,K)=0.0 - RDMMP(M,N,K)=0.0 - R3MMC(M,N,K)=0.0 - R3MMN(M,N,K)=0.0 - R3MMP(M,N,K)=0.0 - RHMMC(M,N,K)=0.0 - RHMMN(M,N,K)=0.0 - RHMMP(M,N,K)=0.0 - RCMMC(M,N,K)=0.0 - RCMMN(M,N,K)=0.0 - RCMMP(M,N,K)=0.0 -720 CONTINUE - ENDIF - ELSE - RUPOX(N,K)=0.0 - RGOMO(N,K)=0.0 - RCO2X(N,K)=0.0 - RCH3X(N,K)=0.0 - RCH4X(N,K)=0.0 - RGOMY(N,K)=0.0 - RGOMD(N,K)=0.0 - CGOMC(N,K)=0.0 - CGOMN(N,K)=0.0 - CGOMP(N,K)=0.0 - CGOQC(N,K)=0.0 - CGOAC(N,K)=0.0 - RDNO3(N,K)=0.0 - RDNOB(N,K)=0.0 - RDNO2(N,K)=0.0 - RDN2B(N,K)=0.0 - RDN2O(N,K)=0.0 - RN2FX(N,K)=0.0 - RINH4(N,K)=0.0 - RINO3(N,K)=0.0 - RIPO4(N,K)=0.0 - RINB4(N,K)=0.0 - RINB3(N,K)=0.0 - RIPB4(N,K)=0.0 - IF(L.EQ.0)THEN - RINH4R(N,K)=0.0 - RINO3R(N,K)=0.0 - RIPO4R(N,K)=0.0 - FNH4XR(N,K)=0.0 - FNO3XR(N,K)=0.0 - FPO4XR(N,K)=0.0 - ENDIF - DO 725 M=1,2 - CGOMS(M,N,K)=0.0 - CGONS(M,N,K)=0.0 - CGOPS(M,N,K)=0.0 - RMOMC(M,N,K)=0.0 - RXMMC(M,N,K)=0.0 - RXMMN(M,N,K)=0.0 - RXMMP(M,N,K)=0.0 - RDMMC(M,N,K)=0.0 - RDMMN(M,N,K)=0.0 - RDMMP(M,N,K)=0.0 - R3MMC(M,N,K)=0.0 - R3MMN(M,N,K)=0.0 - R3MMP(M,N,K)=0.0 - RHMMC(M,N,K)=0.0 - RHMMN(M,N,K)=0.0 - RHMMP(M,N,K)=0.0 - RCMMC(M,N,K)=0.0 - RCMMN(M,N,K)=0.0 - RCMMP(M,N,K)=0.0 - RXOMC(M,N,K)=0.0 - RXOMN(M,N,K)=0.0 - RXOMP(M,N,K)=0.0 - RDOMC(M,N,K)=0.0 - RDOMN(M,N,K)=0.0 - RDOMP(M,N,K)=0.0 - R3OMC(M,N,K)=0.0 - R3OMN(M,N,K)=0.0 - R3OMP(M,N,K)=0.0 - RHOMC(M,N,K)=0.0 - RHOMN(M,N,K)=0.0 - RHOMP(M,N,K)=0.0 - RCOMC(M,N,K)=0.0 - RCOMN(M,N,K)=0.0 - RCOMP(M,N,K)=0.0 -725 CONTINUE - RH2GX(N,K)=0.0 - IF(K.EQ.5)THEN - RVOXA(N)=0.0 - RVOXB(N)=0.0 - IF(N.EQ.5)THEN - RH2GZ=0.0 - ENDIF - ENDIF - ENDIF - ENDIF -750 CONTINUE - ENDIF -760 CONTINUE -C -C CHEMODENITRIFICATION -C - IF(RNO2Y(L,NY,NX).GT.ZEROS(NY,NX))THEN - FNO2=AMAX1(FMN,RVMXC(L,NY,NX)/RNO2Y(L,NY,NX)) - ELSE - FNO2=FMN*VLNO3(L,NY,NX) - ENDIF - IF(RN2BY(L,NY,NX).GT.ZEROS(NY,NX))THEN - FNB2=AMAX1(FMN,RVMBC(L,NY,NX)/RN2BY(L,NY,NX)) - ELSE - FNB2=FMN*VLNOB(L,NY,NX) - 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)) - 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 -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) -7779 FORMAT(A8,3I4,30E12.4) -C ENDIF -C -C DECOMPOSITION -C - DO 1870 K=0,KL - ROQCK(K)=0.0 - DO 1875 N=1,7 - ROQCK(K)=ROQCK(K)+ROQCD(N,K) -1875 CONTINUE - XOQCK(K)=0.0 - XOQCZ(K)=0.0 - XOQNZ(K)=0.0 - XOQPZ(K)=0.0 - XOQAZ(K)=0.0 - DO 845 N=1,7 - DO 845 M=1,3 - XOMCZ(M,N,K)=0.0 - XOMNZ(M,N,K)=0.0 - XOMPZ(M,N,K)=0.0 -845 CONTINUE -C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.LE.1)THEN -C WRITE(*,4443)'PRIM1',I,J,NX,NY,L,K,ROQCK(K) -C 2,XOQCK(K),OQC(K,L,NY,NX),XOQCZ(K),OQN(K,L,NY,NX),XOQNZ(K) -C 3,OQP(K,L,NY,NX),XOQPZ(K),OQA(K,L,NY,NX),XOQAZ(K) -C ENDIF -1870 CONTINUE -C -C PRIMING BETWEEN LITTER AND NON-LITTER C -C - DO 795 K=0,KL - IF(K.LE.KL-1)THEN - DO 800 KK=K+1,KL - OSRT=OSRH(K)+OSRH(KK) - IF(OSRH(K).GT.ZEROS(NY,NX).AND.OSRH(KK).GT.ZEROS(NY,NX))THEN - XFRK=FPRIM*TFND(L,NY,NX)*(ROQCK(K)*OSRH(KK) - 2-ROQCK(KK)*OSRH(K))/OSRT - XFRC=FPRIM*TFND(L,NY,NX)*(OQC(K,L,NY,NX)*OSRH(KK) - 2-OQC(KK,L,NY,NX)*OSRH(K))/OSRT - XFRN=FPRIM*TFND(L,NY,NX)*(OQN(K,L,NY,NX)*OSRH(KK) - 2-OQN(KK,L,NY,NX)*OSRH(K))/OSRT - XFRP=FPRIM*TFND(L,NY,NX)*(OQP(K,L,NY,NX)*OSRH(KK) - 2-OQP(KK,L,NY,NX)*OSRH(K))/OSRT - XFRA=FPRIM*TFND(L,NY,NX)*(OQA(K,L,NY,NX)*OSRH(KK) - 2-OQA(KK,L,NY,NX)*OSRH(K))/OSRT - IF(ROQCK(K)+XOQCK(K)-XFRK.GT.0.0 - 2.AND.ROQCK(KK)+XOQCK(KK)+XFRK.GT.0.0)THEN - XOQCK(K)=XOQCK(K)-XFRK - XOQCK(KK)=XOQCK(KK)+XFRK -C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.LE.1)THEN -C WRITE(*,4442)'XOQCK',I,J,NX,NY,L,K,KK,XFRC,ROQCK(K) -C 2,OSRH(K),ROQCK(KK),OSRH(KK),XOQCK(K),XOQCK(KK) -4442 FORMAT(A8,7I4,12E12.4) -C ENDIF - ENDIF - IF(OQC(K,L,NY,NX)+XOQCZ(K)-XFRC.GT.0.0 - 2.AND.OQC(KK,L,NY,NX)+XOQCZ(KK)+XFRC.GT.0.0)THEN - XOQCZ(K)=XOQCZ(K)-XFRC - XOQCZ(KK)=XOQCZ(KK)+XFRC -C IF((I/1)*1.EQ.I.AND.L.EQ.3.AND.K.EQ.1)THEN -C WRITE(*,4442)'XOQCZ',I,J,NX,NY,L,K,KK,XFRC,OQC(K,L,NY,NX) -C 2,OSRH(K),OQC(KK,L,NY,NX),OSRH(KK),XOQCZ(K),XOQCZ(KK) -C ENDIF - ENDIF - IF(OQN(K,L,NY,NX)+XOQNZ(K)-XFRN.GT.0.0 - 2.AND.OQN(KK,L,NY,NX)+XOQNZ(KK)+XFRN.GT.0.0)THEN - XOQNZ(K)=XOQNZ(K)-XFRN - XOQNZ(KK)=XOQNZ(KK)+XFRN -C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.EQ.4)THEN -C WRITE(*,4442)'XOQNZ',I,J,NX,NY,L,K,KK,XFRN,OQN(K,L,NY,NX) -C 2,OSRH(K),OQN(KK,L,NY,NX),OSRH(KK),XOQNZ(K),XOQNZ(KK) -C ENDIF - ENDIF - IF(OQP(K,L,NY,NX)+XOQPZ(K)-XFRP.GT.0.0 - 2.AND.OQP(KK,L,NY,NX)+XOQPZ(KK)+XFRP.GT.0.0)THEN - XOQPZ(K)=XOQPZ(K)-XFRP - XOQPZ(KK)=XOQPZ(KK)+XFRP -C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.EQ.4)THEN -C WRITE(*,4442)'XOQPZ',I,J,NX,NY,L,K,KK,XFRP,OQP(K,L,NY,NX) -C 2,OSRH(K),OQP(KK,L,NY,NX),OSRH(KK),XOQPZ(K),XOQPZ(KK) -C ENDIF - ENDIF - IF(OQA(K,L,NY,NX)+XOQAZ(K)-XFRA.GT.0.0 - 2.AND.OQA(KK,L,NY,NX)+XOQAZ(KK)+XFRA.GT.0.0)THEN - XOQAZ(K)=XOQAZ(K)-XFRA - XOQAZ(KK)=XOQAZ(KK)+XFRA -C IF((I/1)*1.EQ.I.AND.L.EQ.3.AND.K.EQ.1)THEN -C WRITE(*,4442)'XOQAZ',I,J,NX,NY,L,K,KK,XFRA,OQA(K,L,NY,NX) -C 2,OSRH(K),OQA(KK,L,NY,NX),OSRH(KK),XOQAZ(K),XOQAZ(KK) -C ENDIF - ENDIF - DO 850 N=1,7 - DO 850 M=1,3 - XFMC=FPRIMM*TFNG(N,K)*(OMC(M,N,K,L,NY,NX)*OSRH(KK) - 2-OMC(M,N,KK,L,NY,NX)*OSRH(K))/OSRT - XFMN=FPRIMM*TFNG(N,K)*(OMN(M,N,K,L,NY,NX)*OSRH(KK) - 2-OMN(M,N,KK,L,NY,NX)*OSRH(K))/OSRT - XFMP=FPRIMM*TFNG(N,K)*(OMP(M,N,K,L,NY,NX)*OSRH(KK) - 2-OMP(M,N,KK,L,NY,NX)*OSRH(K))/OSRT - IF(OMC(M,N,K,L,NY,NX)+XOMCZ(M,N,K)-XFMC.GT.0.0 - 2.AND.OMC(M,N,KK,L,NY,NX)+XOMCZ(M,N,KK)+XFMC.GT.0.0)THEN - XOMCZ(M,N,K)=XOMCZ(M,N,K)-XFMC - XOMCZ(M,N,KK)=XOMCZ(M,N,KK)+XFMC -C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.EQ.4)THEN -C WRITE(*,4447)'XOMCZ',I,J,NX,NY,L,K,KK,N,M,XFMC,OMC(M,N,K,L,NY,NX) -C 2,OQC(K,L,NY,NX),OMC(M,N,KK,L,NY,NX),OQC(KK,L,NY,NX),OQCT -C 3,XOMCZ(M,N,K),XOMCZ(M,N,KK) -4447 FORMAT(A8,9I4,20E12.4) -C ENDIF - ENDIF - IF(OMN(M,N,K,L,NY,NX)+XOMNZ(M,N,K)-XFMN.GT.0.0 - 2.AND.OMN(M,N,KK,L,NY,NX)+XOMNZ(M,N,KK)+XFMN.GT.0.0)THEN - XOMNZ(M,N,K)=XOMNZ(M,N,K)-XFMN - XOMNZ(M,N,KK)=XOMNZ(M,N,KK)+XFMN -C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.EQ.4)THEN -C WRITE(*,4447)'XOMNZ',I,J,NX,NY,L,K,KK,N,M,XFMN,OMN(M,N,K,L,NY,NX) -C 2,OSRH(K),OMN(M,N,KK,L,NY,NX),OSRH(KK),XOMNZ(M,N,K),XOMNZ(M,N,KK) -C ENDIF - ENDIF - IF(OMP(M,N,K,L,NY,NX)+XOMPZ(M,N,K)-XFMP.GT.0.0 - 2.AND.OMP(M,N,KK,L,NY,NX)+XOMPZ(M,N,KK)+XFMP.GT.0.0)THEN - XOMPZ(M,N,K)=XOMPZ(M,N,K)-XFMP - XOMPZ(M,N,KK)=XOMPZ(M,N,KK)+XFMP -C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.EQ.4)THEN -C WRITE(*,4447)'XOMPZ',I,J,NX,NY,L,K,KK,N,M,XFMP,OMP(M,N,K,L,NY,NX) -C 2,OSRH(K),OMP(M,N,KK,L,NY,NX),OSRH(KK),XOMPZ(M,N,K),XOMPZ(M,N,KK) -C ENDIF - ENDIF -850 CONTINUE - ENDIF -800 CONTINUE - ENDIF -795 CONTINUE -C -C DECOMPOSITION OF ORGANIC SUBSTRATES -C - TOQCK(L,NY,NX)=0.0 - DO 1790 K=0,KL - ROQCK(K)=ROQCK(K)+XOQCK(K) - TOQCK(L,NY,NX)=TOQCK(L,NY,NX)+ROQCK(K) - OQC(K,L,NY,NX)=OQC(K,L,NY,NX)+XOQCZ(K) - OQN(K,L,NY,NX)=OQN(K,L,NY,NX)+XOQNZ(K) - OQP(K,L,NY,NX)=OQP(K,L,NY,NX)+XOQPZ(K) - OQA(K,L,NY,NX)=OQA(K,L,NY,NX)+XOQAZ(K) - DO 840 N=1,7 - DO 840 M=1,3 - OMC(M,N,K,L,NY,NX)=OMC(M,N,K,L,NY,NX)+XOMCZ(M,N,K) - OMN(M,N,K,L,NY,NX)=OMN(M,N,K,L,NY,NX)+XOMNZ(M,N,K) - OMP(M,N,K,L,NY,NX)=OMP(M,N,K,L,NY,NX)+XOMPZ(M,N,K) -840 CONTINUE - IF(TOMK(K).GT.ZEROS(NY,NX))THEN - CNOMX=TONK(K)/TONX(K) - CPOMX=TOPK(K)/TOPX(K) - FCNK(K)=AMIN1(1.0,AMAX1(0.50,CNOMX)) - FCPK(K)=AMIN1(1.0,AMAX1(0.50,CPOMX)) - ELSE - FCNK(K)=1.0 - FCPK(K)=1.0 - ENDIF -C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.EQ.4)THEN -C WRITE(*,4443)'PRIM2',I,J,NX,NY,L,K,ROQCK(K) -C 2,XOQCK(K),OQC(K,L,NY,NX),XOQCZ(K),OQN(K,L,NY,NX),XOQNZ(K) -C 3,OQP(K,L,NY,NX),XOQPZ(K),OQA(K,L,NY,NX),XOQAZ(K),TOMK(K) -C 3,TONK(K),TOPK(K),TONX(K),TOPX(K),CNOMX,CPOMX,FCNK(K),FCPK(K) -C 4,TOQCK(L,NY,NX) -4443 FORMAT(A8,6I4,20E12.4) -C ENDIF -C -C AQUEOUS CONCENTRATION OF BIOMASS TO CACULATE INHIBITION -C CONSTANT FOR DECOMPOSITION -C - IF(VOLWZ.GT.ZEROS(NY,NX))THEN - COQCK=AMIN1(0.1E+06,ROQCK(K)/VOLWZ) - ELSE - COQCK=0.1E+06 - ENDIF - DCKD=DCKM(K)*(1.0+COQCK/DCKI) - IF(OSRH(K).GT.ZEROS(NY,NX))THEN - COSC=OSRH(K)/VOLX(L,NY,NX) - DFNS=COSC/(COSC+DCKD) - OQCI=1.0/(1.0+COQC(K,L,NY,NX)/OQKI) -C IF(L.EQ.0)THEN -C WRITE(*,4242)'COSC',I,J,L,K,DFNS,COSC,COQCK,DCKD,OSRH(K) -C 2,OSAT(K),OSCT(K),ORCT(K),OHC(K,L,NY,NX),BKVL(L,NY,NX),ROQCK(K) -C 3,VOLWZ,VOLWRX(NY,NX),VOLW(0,NY,NX),FCR(NY,NX) -C 4,THETY(L,NY,NX) -4242 FORMAT(A8,4I4,30E12.4) -C ENDIF -C -C C, N, P DECOMPOSITION RATE OF SOLID SUBSTRATES 'RDOS*' FROM -C RATE CONSTANT, TOTAL ACTIVE BIOMASS, DENSITY FACTOR, -C TEMPERATURE, SUBSTRATE C:N, C:P -C - DO 785 M=1,4 - IF(OSC(M,K,L,NY,NX).GT.ZEROS(NY,NX))THEN - CNS(M,K)=AMAX1(0.0,OSN(M,K,L,NY,NX)/OSC(M,K,L,NY,NX)) - CPS(M,K)=AMAX1(0.0,OSP(M,K,L,NY,NX)/OSC(M,K,L,NY,NX)) - RDOSC(M,K)=AMAX1(0.0,AMIN1(OSA(M,K,L,NY,NX) - 2,SPOSC(M,K)*ROQCK(K)*DFNS*OQCI*TFNX*OSA(M,K,L,NY,NX)/OSRH(K))) -C 3*AMIN1(FCNK(K),FCPK(K)) - RDOSN(M,K)=AMAX1(0.0,AMIN1(OSN(M,K,L,NY,NX) - 2,CNS(M,K)*RDOSC(M,K)))/FCNK(K) - RDOSP(M,K)=AMAX1(0.0,AMIN1(OSP(M,K,L,NY,NX) - 2,CPS(M,K)*RDOSC(M,K)))/FCPK(K) -C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.LE.1)THEN -C WRITE(*,4444)'RDOSC',I,J,NX,NY,L,K,M,RDOSC(M,K),RDOSN(M,K) -C 2,RDOSP(M,K),CNS(M,K),CPS(M,K),SPOSC(M,K),ROQCK(K),DFNS,TFNX -C 3,OQCI,OSA(M,K,L,NY,NX),OSRH(K),COSC,COQCK,DCKD,VOLWZ -C 4,TFNX,WFNG,TKS(L,NY,NX),PSISM(L,NY,NX),THETW(L,NY,NX) -C 4,FOSRH(K,L,NY,NX),VOLX(L,NY,NX),ORGC(L,NY,NX),OSC(M,K,L,NY,NX) -C 2,OSN(M,K,L,NY,NX),OSP(M,K,L,NY,NX),TONK(K),TONX(K),FCNK(K) -C 6,FCPK(K),WFN(1,K),WFN(3,K),COQC(K,L,NY,NX),THETY(L,NY,NX) -4444 FORMAT(A8,7I4,40E12.4) -C ENDIF - ELSE - CNS(M,K)=CNOSC(M,K,L,NY,NX) - CPS(M,K)=CPOSC(M,K,L,NY,NX) - RDOSC(M,K)=0.0 - RDOSN(M,K)=0.0 - RDOSP(M,K)=0.0 - ENDIF -785 CONTINUE -C -C HUMIFICATION OF DECOMPOSED RESIDUE LIGNIN WITH PROTEIN, -C CH2O AND CELLULOSE 'RHOS*' WITH REMAINDER 'RCOS*' TO DOC,N,P -C - IF(K.LE.2)THEN - RHOSC(4,K)=AMAX1(0.0,AMIN1(RDOSN(4,K)/CNRH(3) - 2,RDOSP(4,K)/CPRH(3),EPOC(L,NY,NX)*RDOSC(4,K))) - RHOSCM=0.10*RHOSC(4,K) - RHOSC(1,K)=AMAX1(0.0,AMIN1(RDOSC(1,K),RDOSN(1,K)/CNRH(3) - 2,RDOSP(1,K)/CPRH(3),RHOSCM)) - RHOSC(2,K)=AMAX1(0.0,AMIN1(RDOSC(2,K),RDOSN(2,K)/CNRH(3) - 2,RDOSP(2,K)/CPRH(3),RHOSCM)) - RHOSC(3,K)=AMAX1(0.0,AMIN1(RDOSC(3,K),RDOSN(3,K)/CNRH(3) - 2,RDOSP(3,K)/CPRH(3),RHOSCM-RHOSC(2,K))) - DO 805 M=1,4 - RHOSN(M,K)=AMIN1(RDOSN(M,K),RHOSC(M,K)*CNRH(3)) - RHOSP(M,K)=AMIN1(RDOSP(M,K),RHOSC(M,K)*CPRH(3)) - RCOSC(M,K)=RDOSC(M,K)-RHOSC(M,K) - RCOSN(M,K)=RDOSN(M,K)-RHOSN(M,K) - RCOSP(M,K)=RDOSP(M,K)-RHOSP(M,K) -805 CONTINUE - ELSE - DO 810 M=1,4 - RHOSC(M,K)=0.0 - RHOSN(M,K)=0.0 - RHOSP(M,K)=0.0 - RCOSC(M,K)=RDOSC(M,K) - RCOSN(M,K)=RDOSN(M,K) - RCOSP(M,K)=RDOSP(M,K) -810 CONTINUE - ENDIF - ELSE - DO 780 M=1,4 - RDOSC(M,K)=0.0 - RDOSN(M,K)=0.0 - RDOSP(M,K)=0.0 - RHOSC(M,K)=0.0 - RHOSN(M,K)=0.0 - RHOSP(M,K)=0.0 - RCOSC(M,K)=0.0 - RCOSN(M,K)=0.0 - RCOSP(M,K)=0.0 -780 CONTINUE - ENDIF -C -C C, N, P DECOMPOSITION RATE OF BIORESIDUE 'RDOR*' FROM -C RATE CONSTANT, TOTAL ACTIVE BIOMASS, DENSITY FACTOR, -C TEMPERATURE, SUBSTRATE C:N, C:P -C - IF(OSRH(K).GT.ZEROS(NY,NX))THEN - DO 775 M=1,2 - IF(ORC(M,K,L,NY,NX).GT.ZEROS(NY,NX))THEN - CNR=AMAX1(0.0,ORN(M,K,L,NY,NX)/ORC(M,K,L,NY,NX)) - CPR=AMAX1(0.0,ORP(M,K,L,NY,NX)/ORC(M,K,L,NY,NX)) - RDORC(M,K)=AMAX1(0.0,AMIN1(ORC(M,K,L,NY,NX) - 2,SPORC(M)*ROQCK(K)*DFNS*OQCI*TFNX*ORC(M,K,L,NY,NX)/OSRH(K))) -C 3*AMIN1(FCNK(K),FCPK(K)) - RDORN(M,K)=AMAX1(0.0,AMIN1(ORN(M,K,L,NY,NX),CNR*RDORC(M,K))) - 2/FCNK(K) - RDORP(M,K)=AMAX1(0.0,AMIN1(ORP(M,K,L,NY,NX),CPR*RDORC(M,K))) - 2/FCPK(K) - ELSE - RDORC(M,K)=0.0 - RDORN(M,K)=0.0 - RDORP(M,K)=0.0 - ENDIF -775 CONTINUE - ELSE - DO 776 M=1,2 - RDORC(M,K)=0.0 - RDORN(M,K)=0.0 - RDORP(M,K)=0.0 -776 CONTINUE - ENDIF -C -C C, N, P DECOMPOSITION RATE OF SORBED SUBSTRATES 'RDOH*' FROM -C RATE CONSTANT, TOTAL ACTIVE BIOMASS, DENSITY FACTOR, -C TEMPERATURE, SUBSTRATE C:N, C:P -C - IF(OSRH(K).GT.ZEROS(NY,NX))THEN - IF(OHC(K,L,NY,NX).GT.ZEROS(NY,NX))THEN - CNH(K)=AMAX1(0.0,OHN(K,L,NY,NX)/OHC(K,L,NY,NX)) - CPH(K)=AMAX1(0.0,OHP(K,L,NY,NX)/OHC(K,L,NY,NX)) - RDOHC(K)=AMAX1(0.0,AMIN1(OHC(K,L,NY,NX) - 2,SPOHC*ROQCK(K)*DFNS*OQCI*TFNX*OHC(K,L,NY,NX)/OSRH(K))) -C 3*AMIN1(FCNK(K),FCPK(K)) - RDOHN(K)=AMAX1(0.0,AMIN1(OHN(K,L,NY,NX),CNH(K)*RDOHC(K))) - 2/FCNK(K) - RDOHP(K)=AMAX1(0.0,AMIN1(OHP(K,L,NY,NX),CPH(K)*RDOHC(K))) - 2/FCPK(K) - RDOHA(K)=AMAX1(0.0,AMIN1(OHA(K,L,NY,NX) - 2,SPOHA*ROQCK(K)*DFNS*TFNX*OHA(K,L,NY,NX)/OSRH(K))) -C 3*AMIN1(FCNK(K),FCPK(K)) - ELSE - CNH(K)=0.0 - CPH(K)=0.0 - RDOHC(K)=0.0 - RDOHN(K)=0.0 - RDOHP(K)=0.0 - RDOHA(K)=0.0 - ENDIF - ELSE - CNH(K)=0.0 - CPH(K)=0.0 - RDOHC(K)=0.0 - RDOHN(K)=0.0 - RDOHP(K)=0.0 - RDOHA(K)=0.0 - ENDIF -C -C DOC ADSORPTION - DESORPTION -C - IF(VOLWM(NPH,L,NY,NX).GT.ZEROS(NY,NX) - 2.AND.FOSRH(K,L,NY,NX).GT.ZERO)THEN - IF(L.EQ.0)THEN - AECX=50.0 - ELSE - AECX=AEC(L,NY,NX) - ENDIF - OQCX=AMAX1(ZEROS(NY,NX),OQC(K,L,NY,NX)-TCGOQC(K)) - OQNX=AMAX1(ZEROS(NY,NX),OQN(K,L,NY,NX)-TCGOAC(K)) - OQPX=AMAX1(ZEROS(NY,NX),OQP(K,L,NY,NX)-TCGOMN(K)) - OQAX=AMAX1(ZEROS(NY,NX),OQA(K,L,NY,NX)-TCGOMP(K)) - OHCX=AMAX1(ZEROS(NY,NX),OHC(K,L,NY,NX)) - OHNX=AMAX1(ZEROS(NY,NX),OHN(K,L,NY,NX)) - OHPX=AMAX1(ZEROS(NY,NX),OHP(K,L,NY,NX)) - OHAX=AMAX1(ZEROS(NY,NX),OHA(K,L,NY,NX)) - VOLXX=BKVL(L,NY,NX)*AECX*HSORP*FOSRH(K,L,NY,NX) - VOLXW=VOLWM(NPH,L,NY,NX)*FOSRH(K,L,NY,NX) - IF(FOCA(K).GT.ZERO)THEN - VOLCX=FOCA(K)*VOLXX - VOLCW=FOCA(K)*VOLXW - CSORP(K)=TSORP*(OQCX*VOLCX-OHCX*VOLCW)/(VOLCX+VOLCW) - ELSE - CSORP(K)=TSORP*(OQCX*VOLXX-OHCX*VOLXW)/(VOLXX+VOLXW) - ENDIF - IF(FOAA(K).GT.ZERO)THEN - VOLAX=FOAA(K)*VOLXX - VOLAW=FOAA(K)*VOLXW - CSORPA(K)=TSORP*(OQAX*VOLAX-OHAX*VOLAW)/(VOLAX+VOLAW) - ELSE - CSORPA(K)=TSORP*(OQAX*VOLXX-OHAX*VOLXW)/(VOLXX+VOLXW) - ENDIF - ZSORP(K)=TSORP*(OQNX*VOLXX-OHNX*VOLXW)/(VOLXX+VOLXW) - PSORP(K)=TSORP*(OQPX*VOLXX-OHPX*VOLXW)/(VOLXX+VOLXW) - ELSE - CSORP(K)=0.0 - CSORPA(K)=0.0 - ZSORP(K)=0.0 - PSORP(K)=0.0 - ENDIF -C IF(L.EQ.4.AND.K.EQ.1)THEN -C WRITE(*,591)'CSORP',I,J,NX,NY,L,K,CSORP(K),CSORPA(K) -C 1,OQC(K,L,NY,NX),OHC(K,L,NY,NX),OQA(K,L,NY,NX),OHA(K,L,NY,NX) -C 2,OQC(K,L,NY,NX)/VOLWM(NPH,L,NY,NX),OHC(K,L,NY,NX)/BKVL(L,NY,NX) -C 2,OQA(K,L,NY,NX)/VOLWM(NPH,L,NY,NX),OHA(K,L,NY,NX)/BKVL(L,NY,NX) -C 4,BKVL(L,NY,NX),VOLWM(NPH,L,NY,NX),FOCA(K),FOAA(K) -C 5,FOSRH(K,L,NY,NX),TCGOQC(K),OQCX -591 FORMAT(A8,6I4,40E12.4) -C ENDIF -1790 CONTINUE -C -C REDISTRIBUTE AUTOTROPHIC DECOMPOSITION PRODUCTS AMONG -C HETEROTROPHIC SUBSTRATE-MICROBE COMPLEXES -C - DO 1690 K=0,KL - IF(TORC.GT.ZEROS(NY,NX))THEN - FORC(K)=ORCT(K)/TORC - ELSE - IF(K.EQ.3)THEN - FORC(K)=1.0 - ELSE - FORC(K)=0.0 - ENDIF - ENDIF - DO 1685 N=1,7 - DO 1680 M=1,2 - RCCMC(M,N,K)=(RCOMC(M,N,5)+RCMMC(M,N,5))*FORC(K) - RCCMN(M,N,K)=(RCOMN(M,N,5)+RCMMN(M,N,5))*FORC(K) - RCCMP(M,N,K)=(RCOMP(M,N,5)+RCMMP(M,N,5))*FORC(K) -C IF(L.EQ.0)THEN -C WRITE(*,8821)'RCCMC',I,J,L,K,N,M,RCCMC(M,N,K) -C 2,RCOMC(M,N,5),RCMMC(M,N,5),FORC(K) -C ENDIF -1680 CONTINUE -1685 CONTINUE -1690 CONTINUE -C -C REDISTRIBUTE C,N AND P TRANSFORMATIONS AMONG STATE -C VARIABLES IN SUBSTRATE-MICROBE COMPLEXES -C - DO 590 K=0,KL - DO 580 M=1,4 -C -C SUBSTRATE DECOMPOSITION PRODUCTS -C - OSC(M,K,L,NY,NX)=OSC(M,K,L,NY,NX)-RDOSC(M,K) - OSA(M,K,L,NY,NX)=OSA(M,K,L,NY,NX)-RDOSC(M,K) - OSN(M,K,L,NY,NX)=OSN(M,K,L,NY,NX)-RDOSN(M,K) - OSP(M,K,L,NY,NX)=OSP(M,K,L,NY,NX)-RDOSP(M,K) - OQC(K,L,NY,NX)=OQC(K,L,NY,NX)+RCOSC(M,K) - OQN(K,L,NY,NX)=OQN(K,L,NY,NX)+RCOSN(M,K) - OQP(K,L,NY,NX)=OQP(K,L,NY,NX)+RCOSP(M,K) -C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.K.EQ.4)THEN -C WRITE(*,4444)'RDOSC',I,J,NX,NY,L,K,M,OSC(M,K,L,NY,NX) -C 2,RDOSC(M,K) -C ENDIF -C -C LIGNIFICATION PRODUCTS -C - IF(L.NE.0)THEN - OSC(1,3,L,NY,NX)=OSC(1,3,L,NY,NX)+RHOSC(M,K) - OSA(1,3,L,NY,NX)=OSA(1,3,L,NY,NX)+RHOSC(M,K) - OSN(1,3,L,NY,NX)=OSN(1,3,L,NY,NX)+RHOSN(M,K) - OSP(1,3,L,NY,NX)=OSP(1,3,L,NY,NX)+RHOSP(M,K) - ELSE - OSC(1,3,NU(NY,NX),NY,NX)=OSC(1,3,NU(NY,NX),NY,NX)+RHOSC(M,K) - OSA(1,3,NU(NY,NX),NY,NX)=OSA(1,3,NU(NY,NX),NY,NX)+RHOSC(M,K) - OSN(1,3,NU(NY,NX),NY,NX)=OSN(1,3,NU(NY,NX),NY,NX)+RHOSN(M,K) - OSP(1,3,NU(NY,NX),NY,NX)=OSP(1,3,NU(NY,NX),NY,NX)+RHOSP(M,K) - ENDIF -580 CONTINUE -C -C MICROBIAL RESIDUE DECOMPOSITION PRODUCTS -C - DO 575 M=1,2 - ORC(M,K,L,NY,NX)=ORC(M,K,L,NY,NX)-RDORC(M,K) - ORN(M,K,L,NY,NX)=ORN(M,K,L,NY,NX)-RDORN(M,K) - ORP(M,K,L,NY,NX)=ORP(M,K,L,NY,NX)-RDORP(M,K) - OQC(K,L,NY,NX)=OQC(K,L,NY,NX)+RDORC(M,K) - OQN(K,L,NY,NX)=OQN(K,L,NY,NX)+RDORN(M,K) - OQP(K,L,NY,NX)=OQP(K,L,NY,NX)+RDORP(M,K) -575 CONTINUE - OQC(K,L,NY,NX)=OQC(K,L,NY,NX)+RDOHC(K) - OQN(K,L,NY,NX)=OQN(K,L,NY,NX)+RDOHN(K)+RCOQN*FORC(K) - OQP(K,L,NY,NX)=OQP(K,L,NY,NX)+RDOHP(K) - OQA(K,L,NY,NX)=OQA(K,L,NY,NX)+RDOHA(K) - OHC(K,L,NY,NX)=OHC(K,L,NY,NX)-RDOHC(K) - OHN(K,L,NY,NX)=OHN(K,L,NY,NX)-RDOHN(K) - OHP(K,L,NY,NX)=OHP(K,L,NY,NX)-RDOHP(K) - OHA(K,L,NY,NX)=OHA(K,L,NY,NX)-RDOHA(K) -C -C MICROBIAL UPTAKE OF DISSOLVED C, N, P -C - DO 570 N=1,7 - OQC(K,L,NY,NX)=OQC(K,L,NY,NX)-CGOQC(N,K) - OQN(K,L,NY,NX)=OQN(K,L,NY,NX)-CGOMN(N,K) - OQP(K,L,NY,NX)=OQP(K,L,NY,NX)-CGOMP(N,K) - OQA(K,L,NY,NX)=OQA(K,L,NY,NX)-CGOAC(N,K)+RCH3X(N,K) -C -C MICROBIAL DECOMPOSITION PRODUCTS -C - DO 565 M=1,2 - ORC(M,K,L,NY,NX)=ORC(M,K,L,NY,NX)+RCOMC(M,N,K)+RCCMC(M,N,K) - 2+RCMMC(M,N,K) - ORN(M,K,L,NY,NX)=ORN(M,K,L,NY,NX)+RCOMN(M,N,K)+RCCMN(M,N,K) - 2+RCMMN(M,N,K) - ORP(M,K,L,NY,NX)=ORP(M,K,L,NY,NX)+RCOMP(M,N,K)+RCCMP(M,N,K) - 2+RCMMP(M,N,K) -C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.EQ.4.AND.K.EQ.2)THEN -C WRITE(*,8821)'ORC',I,J,L,K,N,M,ORC(M,K,L,NY,NX) -C 2,RCOMC(M,N,K),RCCMC(M,N,K),RCMMC(M,N,K),RDORC(M,K) -C WRITE(*,8821)'ORP',I,J,L,K,N,M,ORP(M,K,L,NY,NX) -C 2,RCOMP(M,N,K),RCCMP(M,N,K),RCMMP(M,N,K),RDORP(M,K) -8821 FORMAT(A8,6I4,30E12.4) -C ENDIF -565 CONTINUE -570 CONTINUE -C -C SORPTION PRODUCTS -C - OQC(K,L,NY,NX)=OQC(K,L,NY,NX)-CSORP(K) - OQN(K,L,NY,NX)=OQN(K,L,NY,NX)-ZSORP(K) - OQP(K,L,NY,NX)=OQP(K,L,NY,NX)-PSORP(K) - OQA(K,L,NY,NX)=OQA(K,L,NY,NX)-CSORPA(K) - OHC(K,L,NY,NX)=OHC(K,L,NY,NX)+CSORP(K) - OHN(K,L,NY,NX)=OHN(K,L,NY,NX)+ZSORP(K) - OHP(K,L,NY,NX)=OHP(K,L,NY,NX)+PSORP(K) - OHA(K,L,NY,NX)=OHA(K,L,NY,NX)+CSORPA(K) -C IF((I/1)*1.EQ.I.AND.L.EQ.3.AND.K.EQ.1)THEN -C WRITE(*,592)'OQC',I,J,NX,NY,L,K,OQC(K,L,NY,NX) -C 2,(RCOSC(M,K),M=1,4),(RDORC(M,K),M=1,2),RDOHC(K) -C 2,(CGOQC(N,K),N=1,7),CSORP(K),OHC(K,L,NY,NX),OQCI -C 4,(WFN(N,K),N=1,7),OQA(K,L,NY,NX),RDOHA(K),(RCH3X(N,K),N=1,7) -C 3,(CGOAC(N,K),N=1,7),CSORPA(K),OHA(K,L,NY,NX) -C WRITE(*,592)'OQN',I,J,NX,NY,L,K,OQN(K,L,NY,NX) -C 2,(RCOSN(M,K),M=1,4),(RDORN(M,K),M=1,2),RDOHN(K) -C 2,RCOQN*FORC(K),(CGOMN(N,K),N=1,7),ZSORP(K),OHN(K,L,NY,NX) -592 FORMAT(A8,6I4,80E12.4) -C ENDIF -590 CONTINUE -C -C MICROBIAL GROWTH FROM RESPIRATION, MINERALIZATION -C - DO 550 K=0,5 - TGROMC(K)=0.0 - IF(L.NE.0.OR.(K.NE.3.AND.K.NE.4))THEN - DO 545 N=1,7 - IF(K.NE.5.OR.(N.LE.3.OR.N.EQ.5))THEN - DO 540 M=1,2 - OMC(M,N,K,L,NY,NX)=OMC(M,N,K,L,NY,NX)+CGOMS(M,N,K) - 2-RXOMC(M,N,K)-RXMMC(M,N,K) - OMN(M,N,K,L,NY,NX)=OMN(M,N,K,L,NY,NX)+CGONS(M,N,K) - 2-RXOMN(M,N,K)-RXMMN(M,N,K) - OMP(M,N,K,L,NY,NX)=OMP(M,N,K,L,NY,NX)+CGOPS(M,N,K) - 2-RXOMP(M,N,K)-RXMMP(M,N,K) -C IF((I/30)*30.EQ.I.AND.J.EQ.15.AND.L.LE.6 -C 2.AND.K.EQ.5.AND.N.EQ.2)THEN -C WRITE(*,4488)'RDOMC',I,J,NX,NY,L,K,N,M,CGOMS(M,N,K),CGOQC(N,K) -C 4,CGOAC(N,K),RGOMO(N,K),RGOMD(N,K),RXOMC(M,N,K),RXMMC(M,N,K) -C 3,RMOMC(M,N,K),TFNX,OMGR,OMC(3,N,K,L,NY,NX),WFN(N,K) -C 3,OMC(M,N,K,L,NY,NX),OMA(N,K),TSRH -C 4,RCH3X(N,K),RH2GZ,RH2GX(4,K),FOCA(K),FOAA(K) -C 6,OQA(K,L,NY,NX),OHA(K,L,NY,NX),OQC(K,L,NY,NX),OHC(K,L,NY,NX) -C 7,OMP(M,N,K,L,NY,NX),CGOPS(M,N,K),RDOMP(M,N,K),RDMMP(M,N,K) -C 8,OMP(3,N,K,L,NY,NX),CGOMP(N,K),RIPO4(N,K) -4488 FORMAT(A8,8I4,40E12.4) -C ENDIF -C -C HUMIFICATION PRODUCTS -C - IF(L.NE.0)THEN - OSC(1,4,L,NY,NX)=OSC(1,4,L,NY,NX)+CFOMC(1,L,NY,NX) - 2*(RHOMC(M,N,K)+RHMMC(M,N,K)) - OSA(1,4,L,NY,NX)=OSA(1,4,L,NY,NX)+CFOMC(1,L,NY,NX) - 2*(RHOMC(M,N,K)+RHMMC(M,N,K)) - OSN(1,4,L,NY,NX)=OSN(1,4,L,NY,NX)+CFOMC(1,L,NY,NX) - 2*(RHOMN(M,N,K)+RHMMN(M,N,K)) - OSP(1,4,L,NY,NX)=OSP(1,4,L,NY,NX)+CFOMC(1,L,NY,NX) - 2*(RHOMP(M,N,K)+RHMMP(M,N,K)) - OSC(2,4,L,NY,NX)=OSC(2,4,L,NY,NX)+CFOMC(2,L,NY,NX) - 2*(RHOMC(M,N,K)+RHMMC(M,N,K)) - OSA(2,4,L,NY,NX)=OSA(2,4,L,NY,NX)+CFOMC(2,L,NY,NX) - 2*(RHOMC(M,N,K)+RHMMC(M,N,K)) - OSN(2,4,L,NY,NX)=OSN(2,4,L,NY,NX)+CFOMC(2,L,NY,NX) - 2*(RHOMN(M,N,K)+RHMMN(M,N,K)) - OSP(2,4,L,NY,NX)=OSP(2,4,L,NY,NX)+CFOMC(2,L,NY,NX) - 2*(RHOMP(M,N,K)+RHMMP(M,N,K)) -C IF((I/10)*10.EQ.I.AND.J.EQ.24)THEN -C WRITE(*,4445)'RHOMC',I,J,NX,NY,L,K,M,N,OSC(1,4,L,NY,NX) -C 2,OSC(2,4,L,NY,NX),CFOMC(1,L,NY,NX),CFOMC(2,L,NY,NX) -C 3,RHOMC(M,N,K),RHMMC(M,N,K) -4445 FORMAT(A8,8I4,40E12.4) -C ENDIF - ELSE - OSC(1,4,NU(NY,NX),NY,NX)=OSC(1,4,NU(NY,NX),NY,NX) - 2+CFOMC(1,NU(NY,NX),NY,NX)*(RHOMC(M,N,K)+RHMMC(M,N,K)) - OSA(1,4,NU(NY,NX),NY,NX)=OSA(1,4,NU(NY,NX),NY,NX) - 2+CFOMC(1,NU(NY,NX),NY,NX)*(RHOMC(M,N,K)+RHMMC(M,N,K)) - OSN(1,4,NU(NY,NX),NY,NX)=OSN(1,4,NU(NY,NX),NY,NX) - 2+CFOMC(1,NU(NY,NX),NY,NX)*(RHOMN(M,N,K)+RHMMN(M,N,K)) - OSP(1,4,NU(NY,NX),NY,NX)=OSP(1,4,NU(NY,NX),NY,NX) - 2+CFOMC(1,NU(NY,NX),NY,NX)*(RHOMP(M,N,K)+RHMMP(M,N,K)) - OSC(2,4,NU(NY,NX),NY,NX)=OSC(2,4,NU(NY,NX),NY,NX) - 2+CFOMC(2,NU(NY,NX),NY,NX)*(RHOMC(M,N,K)+RHMMC(M,N,K)) - OSA(2,4,NU(NY,NX),NY,NX)=OSA(2,4,NU(NY,NX),NY,NX) - 2+CFOMC(2,NU(NY,NX),NY,NX)*(RHOMC(M,N,K)+RHMMC(M,N,K)) - OSN(2,4,NU(NY,NX),NY,NX)=OSN(2,4,NU(NY,NX),NY,NX) - 2+CFOMC(2,NU(NY,NX),NY,NX)*(RHOMN(M,N,K)+RHMMN(M,N,K)) - OSP(2,4,NU(NY,NX),NY,NX)=OSP(2,4,NU(NY,NX),NY,NX) - 2+CFOMC(2,NU(NY,NX),NY,NX)*(RHOMP(M,N,K)+RHMMP(M,N,K)) - ENDIF -540 CONTINUE -C -C INPUTS TO NONSTRUCTURAL POOLS -C - CGROMC=CGOMC(N,K)-RGOMO(N,K)-RGOMD(N,K)-RGN2F(N,K) - TGROMC(K)=TGROMC(K)+CGROMC - RCO2X(N,K)=RCO2X(N,K)+RGN2F(N,K) - DO 555 M=1,2 - OMC(3,N,K,L,NY,NX)=OMC(3,N,K,L,NY,NX)-CGOMS(M,N,K) - 2+R3OMC(M,N,K) - OMN(3,N,K,L,NY,NX)=OMN(3,N,K,L,NY,NX)-CGONS(M,N,K) - 2+R3OMN(M,N,K)+R3MMN(M,N,K) - OMP(3,N,K,L,NY,NX)=OMP(3,N,K,L,NY,NX)-CGOPS(M,N,K) - 2+R3OMP(M,N,K)+R3MMP(M,N,K) - RCO2X(N,K)=RCO2X(N,K)+R3MMC(M,N,K) -555 CONTINUE - OMC(3,N,K,L,NY,NX)=OMC(3,N,K,L,NY,NX)+CGROMC - OMN(3,N,K,L,NY,NX)=OMN(3,N,K,L,NY,NX)+CGOMN(N,K) - 2+RINH4(N,K)+RINB4(N,K)+RINO3(N,K)+RINB3(N,K)+RN2FX(N,K) - OMP(3,N,K,L,NY,NX)=OMP(3,N,K,L,NY,NX)+CGOMP(N,K) - 2+RIPO4(N,K)+RIPB4(N,K) - IF(L.EQ.0)THEN - OMN(3,N,K,L,NY,NX)=OMN(3,N,K,L,NY,NX)+RINH4R(N,K)+RINO3R(N,K) - OMP(3,N,K,L,NY,NX)=OMP(3,N,K,L,NY,NX)+RIPO4R(N,K) - ENDIF -C IF(NY.EQ.5.AND.L.EQ.10.AND.K.EQ.3.AND.N.EQ.2)THEN -C WRITE(*,5556)'OMC3',I,J,NX,NY,L,K,N,OMC(3,N,K,L,NY,NX) -C 2,CGOMS(1,N,K),CGOMS(2,N,K),CGROMC,OMP(3,N,K,L,NY,NX) -C 3,CGOPS(1,N,K),CGOPS(2,N,K),CGOMP(N,K),RIPO4(N,K) -C 4,CGOMC(N,K),RGOMO(N,K),RGOMD(N,K),RMOMT,WFN(N,K) -5556 FORMAT(A8,7I4,20E12.4) -C ENDIF - ENDIF -545 CONTINUE - ENDIF -550 CONTINUE - DO 475 K=0,KL - OSCT(K)=0.0 - OSAT(K)=0.0 - DO 475 M=1,4 - OSCT(K)=OSCT(K)+OSC(M,K,L,NY,NX) - OSAT(K)=OSAT(K)+OSA(M,K,L,NY,NX) -475 CONTINUE - DO 480 K=0,KL - OSCX=OSCT(K)-OSAT(K) - IF(OSCX.GT.ZEROS(NY,NX))THEN - IF(OSAT(K).GT.ZEROS(NY,NX))THEN - COSC=OSCX/OSAT(K) - DFNA=COSC/(COSC+DCKX(K)) - ELSE - DFNA=1.0 - ENDIF - DO 485 M=1,4 - OSA(M,K,L,NY,NX)=AMIN1(OSC(M,K,L,NY,NX) - 2,OSA(M,K,L,NY,NX)+DOSA(K)*(AMAX1(DOSM(K),AMIN1(DOSX(K),TGROMC(K) - 3/AREA(3,L,NY,NX))))*AREA(3,L,NY,NX) - 3*(OSC(M,K,L,NY,NX)-OSA(M,K,L,NY,NX))/OSCX*DFNA) -C IF(INT(I/30)*30.EQ.I.AND.J.EQ.19.AND.K.LE.1)THEN -C WRITE(*,8822)'OSA',I,J,L,K,M,OSA(M,K,L,NY,NX),OSC(M,K,L,NY,NX) -C 3,OSAT(K),OSCT(K),(OSC(M,K,L,NY,NX)-OSA(M,K,L,NY,NX)) -C 3/OSCX,DOSA(K),ROQCK(K),TFNX,TFNX,WFNG,COSC,DFNA -C 4,(TGROMC(K)/AREA(3,L,NY,NX)) -C 5,(AMAX1(DOSM(K),AMIN1(DOSX(K) -C 3,TGROMC(K)/AREA(3,L,NY,NX)))),TGROMC(K) -C ENDIF -8822 FORMAT(A8,5I4,20E12.4) -485 CONTINUE - ELSE - DO 490 M=1,4 - OSA(M,K,L,NY,NX)=AMIN1(OSC(M,K,L,NY,NX),OSA(M,K,L,NY,NX)) -490 CONTINUE - ENDIF -C IF(L.EQ.0)THEN -C WRITE(*,8823)'OSC',I,J,L,K,((OMC(M,N,K,L,NY,NX),N=1,7),M=1,3) -C 2,(ORC(M,K,L,NY,NX),M=1,2),OQC(K,L,NY,NX),OQCH(K,L,NY,NX) -C 3,OHC(K,L,NY,NX),OQA(K,L,NY,NX),OQAH(K,L,NY,NX),OHA(K,L,NY,NX) -C 4,(OSC(M,K,L,NY,NX),M=1,4) -8823 FORMAT(A8,4I4,100E24.16) -C ENDIF -480 CONTINUE -C -C AGGREGATE TRANSFORMATIONS -C - TRINH=0.0 - TRINO=0.0 - TRIPO=0.0 - TRINB=0.0 - TRIOB=0.0 - TRIPB=0.0 - TRGOM=0.0 - TRGOC=0.0 - TRGOD=0.0 - TRGOA=0.0 - TRGOH=0.0 - TUPOX=0.0 - TRDN3=0.0 - TRDNB=0.0 - TRDN2=0.0 - TRD2B=0.0 - TRDNO=0.0 - TRN2F=0.0 - DO 650 K=0,5 - IF(L.NE.0.OR.(K.NE.3.AND.K.NE.4))THEN - DO 640 N=1,7 - IF(K.NE.5.OR.(N.LE.3.OR.N.EQ.5))THEN - TRINH=TRINH+RINH4(N,K) - TRINO=TRINO+RINO3(N,K) - TRIPO=TRIPO+RIPO4(N,K) - TRINB=TRINB+RINB4(N,K) - TRIOB=TRIOB+RINB3(N,K) - TRIPB=TRIPB+RIPB4(N,K) - TRN2F=TRN2F+RN2FX(N,K) - IF(L.EQ.NU(NY,NX))THEN - TRINH=TRINH+RINH4R(N,K) - TRINO=TRINO+RINO3R(N,K) - TRIPO=TRIPO+RIPO4R(N,K) - ENDIF -C IF(NY.EQ.5.AND.L.EQ.10.AND.K.EQ.3.AND.N.EQ.2)THEN -C WRITE(*,4469)'TRINH',I,J,NX,NY,L,K,N,TRINH,RINH4(N,K),RINH4R(N,K) -C WRITE(*,4469)'TRIPO',I,J,NX,NY,L,K,N,TRIPO,RIPO4(N,K),RIPO4R(N,K) -C 2,CGOMP(N,K) -4469 FORMAT(A8,7I4,20E12.4) -C ENDIF - TRGOM=TRGOM+RCO2X(N,K) - TRGOC=TRGOC+RCH4X(N,K) - TRGOD=TRGOD+RGOMD(N,K) - TUPOX=TUPOX+RUPOX(N,K) - TRDN3=TRDN3+RDNO3(N,K) - TRDNB=TRDNB+RDNOB(N,K) - TRDN2=TRDN2+RDNO2(N,K) - TRD2B=TRD2B+RDN2B(N,K) - TRDNO=TRDNO+RDN2O(N,K) - TRGOH=TRGOH+RH2GX(N,K) -C IF(L.EQ.NU(NY,NX))THEN -C WRITE(*,3333)'TUPOX',I,J,NX,NY,L,K,N,TUPOX,RUPOX(N,K) -C ENDIF -C IF(J.EQ.12.AND.L.LE.4)THEN -C WRITE(*,3333)'N2O',I,J,NX,NY,L,K,N,TRDN2,TRD2B,TRDNO -C 2,RDNO2(N,K),RDN2B(N,K),RDN2O(N,K),COXYS(L,NY,NX) -C 3,COXYG(L,NY,NX) -C WRITE(*,3333)'TRGOH',I,J,NX,NY,L,K,N,TRGOH,RH2GX(N,K) -C 2,RGOMO(N,K) -3333 FORMAT(A8,7I4,20E12.4) -C ENDIF - ENDIF -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 - TRGOA=TRGOA+CGOMC(N,5) - ENDIF - ENDIF -645 CONTINUE -C -C ALLOCATE AGGREGATED TRANSFORMATIONS INTO ARRAYS TO UPDATE -C STATE VARIABLES IN 'REDIST' -C - RCO2O(L,NY,NX)=TRGOA-TRGOM-TRGOD-RVOXA(3) - RCH4O(L,NY,NX)=RVOXA(3)+CGOMC(3,5)-TRGOC - RH2GO(L,NY,NX)=RH2GZ-TRGOH - 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 WRITE(*,2468)'RN2O',I,J,NX,NY,L -C 2,RN2O(L,NY,NX),TRDN2,TRD2B,RCN2O,RCN2B,TRDNO -C 2,RCH4O(L,NY,NX),RVOXA(3) -C 2,CGOMC(3,5),TRGOC,(OMA(N,1),N=1,7) -2468 FORMAT(A8,5I4,20E12.4) -C ENDIF - DO 655 K=0,4 - DO 660 M=1,4 - XOQCS(K,L,NY,NX)=XOQCS(K,L,NY,NX)+RCOSC(M,K) - XOQNS(K,L,NY,NX)=XOQNS(K,L,NY,NX)+RCOSN(M,K) - XOQPS(K,L,NY,NX)=XOQPS(K,L,NY,NX)+RCOSP(M,K) -660 CONTINUE - DO 665 M=1,2 - XOQCS(K,L,NY,NX)=XOQCS(K,L,NY,NX)+RDORC(M,K) - XOQNS(K,L,NY,NX)=XOQNS(K,L,NY,NX)+RDORN(M,K) - XOQPS(K,L,NY,NX)=XOQPS(K,L,NY,NX)+RDORP(M,K) -665 CONTINUE - XOQCS(K,L,NY,NX)=XOQCS(K,L,NY,NX)+RDOHC(K) - XOQNS(K,L,NY,NX)=XOQNS(K,L,NY,NX)+RDOHN(K) - XOQPS(K,L,NY,NX)=XOQPS(K,L,NY,NX)+RDOHP(K) - XOQAS(K,L,NY,NX)=XOQAS(K,L,NY,NX)+RDOHA(K) - DO 670 N=1,7 - XOQCS(K,L,NY,NX)=XOQCS(K,L,NY,NX)-CGOQC(N,K) - XOQNS(K,L,NY,NX)=XOQNS(K,L,NY,NX)-CGOMN(N,K) - XOQPS(K,L,NY,NX)=XOQPS(K,L,NY,NX)-CGOMP(N,K) - XOQAS(K,L,NY,NX)=XOQAS(K,L,NY,NX)-CGOAC(N,K)+RCH3X(N,K) -670 CONTINUE - XOQCS(K,L,NY,NX)=XOQCS(K,L,NY,NX)-CSORP(K) - XOQNS(K,L,NY,NX)=XOQNS(K,L,NY,NX)-ZSORP(K) - XOQPS(K,L,NY,NX)=XOQPS(K,L,NY,NX)-PSORP(K) - XOQAS(K,L,NY,NX)=XOQAS(K,L,NY,NX)-CSORPA(K) -655 CONTINUE - XNH4S(L,NY,NX)=-TRINH-RVOXA(1) - XNO3S(L,NY,NX)=-TRINO+RVOXA(2)-TRDN3+RCNO3 - XNO2S(L,NY,NX)=RVOXA(1)-RVOXA(2)+TRDN3-TRDN2-RCNO2 - XH2PS(L,NY,NX)=-TRIPO - XNH4B(L,NY,NX)=-TRINB-RVOXB(1) - XNO3B(L,NY,NX)=-TRIOB+RVOXB(2)-TRDNB+RCN3B - XNO2B(L,NY,NX)=RVOXB(1)-RVOXB(2)+TRDNB-TRD2B-RCNOB - XH2BS(L,NY,NX)=-TRIPB - XN2GS(L,NY,NX)=TRN2F - XZHYS(L,NY,NX)=0.1429*(RVOXA(1)+RVOXB(1)-TRDN3-TRDNB) - 2-0.0714*(TRDN2+TRD2B+TRDNO) - TFNQ(L,NY,NX)=TFNX - VOLQ(L,NY,NX)=VOLWZ -C IF(L.EQ.0)THEN -C WRITE(*,2323)'XNH4S',I,J,L,XNH4S(L,NY,NX) -C 2,TRINH,RVOXA(1),VLNH4(L,NY,NX) -C WRITE(*,2323)'XNO3S',I,J,L,XNO3S(L,NY,NX) -C 2,TRINO,RVOXA(2),VLNO3(L,NY,NX),TRDN3,RCNO3 -C WRITE(*,2323)'XH2PS',I,J,L,XH2PS(L,NY,NX) -C 2,RIPOT,TRIPO,VLPO4(L,NY,NX) -C WRITE(*,2323)'XNO2B',I,J,L,XNO2B(L,NY,NX),RVOXB(1) -C 2,VLNHB(L,NY,NX),RVOXB(2),VLNOB(L,NY,NX),TRDNB,TRD2B,RCNOB -2323 FORMAT(A8,3I4,12E12.4) -C ENDIF - ELSE - RCO2O(L,NY,NX)=0.0 - RCH4O(L,NY,NX)=0.0 - RH2GO(L,NY,NX)=0.0 - RUPOXO(L,NY,NX)=0.0 - RN2G(L,NY,NX)=0.0 - RN2O(L,NY,NX)=0.0 - XNH4S(L,NY,NX)=0.0 - XNO3S(L,NY,NX)=0.0 - XNO2S(L,NY,NX)=0.0 - XH2PS(L,NY,NX)=0.0 - XNH4B(L,NY,NX)=0.0 - XNO3B(L,NY,NX)=0.0 - XNO2B(L,NY,NX)=0.0 - XH2BS(L,NY,NX)=0.0 - XN2GS(L,NY,NX)=0.0 - XZHYS(L,NY,NX)=0.0 - ENDIF -C -C ADJUST LAYERING OF SOC -C - IF(L.EQ.0.OR.(L.GE.NU(NY,NX).AND.L.LT.NL(NY,NX)))THEN -C 2.AND.CDPTH(L,NY,NX).LE.CDPTH(NU(NY,NX)-1,NY,NX)+0.60)THEN - IF(L.EQ.0)THEN - LL=NU(NY,NX) - IF(ORGR(L,NY,NX).GT.0.0)THEN - FOSCXS=AMIN1(1.0,FOSCZ0/ORGR(L,NY,NX)*TOMA*TFNX) - ELSE - FOSCXS=0.0 - ENDIF - ELSE - LL=L+1 - OSCXD=(ORGR(L,NY,NX)*VOLT(LL,NY,NX)-ORGR(LL,NY,NX)*VOLT(L,NY,NX)) - 2/(VOLT(L,NY,NX)+VOLT(LL,NY,NX)) - IF(OSCXD.GT.0.0.AND.ORGR(L,NY,NX).GT.ZEROS(NY,NX))THEN - FOSCXD=OSCXD/ORGR(L,NY,NX) - ELSEIF(OSCXD.LT.0.0.AND.ORGR(LL,NY,NX).GT.ZEROS(NY,NX))THEN - FOSCXD=OSCXD/ORGR(LL,NY,NX) - ELSE - FOSCXD=0.0 - ENDIF - FOSCXS=FOSCZL*FOSCXD*TFNX*TOMA/VOLT(L,NY,NX) - ENDIF -C IF(L.EQ.3.AND.K.EQ.2)THEN -C WRITE(*,1115)'MIX',I,J,L,LL,FOSCXS,FOSCZ0,FOSCZL,OSCXD,TOMA -C 2,TFNX,ORGR(L,NY,NX),VOLT(LL,NY,NX),ORGR(LL,NY,NX),VOLT(L,NY,NX) -1115 FORMAT(A8,4I4,20E12.4) -C ENDIF - IF(FOSCXS.NE.0.0)THEN - DO 7971 K=1,2 - DO 7961 N=1,7 - DO 7962 M=1,3 - IF(FOSCXS.GT.0.0)THEN - OMCXS=FOSCXS*AMAX1(0.0,OMC(M,N,K,L,NY,NX)) - OMNXS=FOSCXS*AMAX1(0.0,OMN(M,N,K,L,NY,NX)) - OMPXS=FOSCXS*AMAX1(0.0,OMP(M,N,K,L,NY,NX)) - ELSE - OMCXS=FOSCXS*AMAX1(0.0,OMC(M,N,K,LL,NY,NX)) - OMNXS=FOSCXS*AMAX1(0.0,OMN(M,N,K,LL,NY,NX)) - OMPXS=FOSCXS*AMAX1(0.0,OMP(M,N,K,LL,NY,NX)) - ENDIF - OMC(M,N,K,L,NY,NX)=OMC(M,N,K,L,NY,NX)-OMCXS - OMN(M,N,K,L,NY,NX)=OMN(M,N,K,L,NY,NX)-OMNXS - OMP(M,N,K,L,NY,NX)=OMP(M,N,K,L,NY,NX)-OMPXS - OMC(M,N,K,LL,NY,NX)=OMC(M,N,K,LL,NY,NX)+OMCXS - OMN(M,N,K,LL,NY,NX)=OMN(M,N,K,LL,NY,NX)+OMNXS - OMP(M,N,K,LL,NY,NX)=OMP(M,N,K,LL,NY,NX)+OMPXS -7962 CONTINUE -7961 CONTINUE -7971 CONTINUE - DO 7901 K=1,2 - DO 7941 M=1,2 - IF(FOSCXS.GT.0.0)THEN - ORCXS=FOSCXS*AMAX1(0.0,ORC(M,K,L,NY,NX)) - ORNXS=FOSCXS*AMAX1(0.0,ORN(M,K,L,NY,NX)) - ORPXS=FOSCXS*AMAX1(0.0,ORP(M,K,L,NY,NX)) - ELSE - ORCXS=FOSCXS*AMAX1(0.0,ORC(M,K,LL,NY,NX)) - ORNXS=FOSCXS*AMAX1(0.0,ORN(M,K,LL,NY,NX)) - ORPXS=FOSCXS*AMAX1(0.0,ORP(M,K,LL,NY,NX)) - ENDIF - ORC(M,K,L,NY,NX)=ORC(M,K,L,NY,NX)-ORCXS - ORN(M,K,L,NY,NX)=ORN(M,K,L,NY,NX)-ORNXS - ORP(M,K,L,NY,NX)=ORP(M,K,L,NY,NX)-ORPXS - ORC(M,K,LL,NY,NX)=ORC(M,K,LL,NY,NX)+ORCXS - ORN(M,K,LL,NY,NX)=ORN(M,K,LL,NY,NX)+ORNXS - ORP(M,K,LL,NY,NX)=ORP(M,K,LL,NY,NX)+ORPXS -C IF(L.EQ.3.AND.K.EQ.2)THEN -C WRITE(*,7942)'ORC',I,J,L,LL,K,M,ORC(M,K,L,NY,NX) -C 2,ORC(M,K,LL,NY,NX),ORCXS,FOSCXS -7942 FORMAT(A8,6I4,20E12.4) -C ENDIF -7941 CONTINUE - IF(FOSCXS.GT.0.0)THEN - OQCXS=FOSCXS*AMAX1(0.0,OQC(K,L,NY,NX)) - OQCHXS=FOSCXS*AMAX1(0.0,OQCH(K,L,NY,NX)) - OHCXS=FOSCXS*AMAX1(0.0,OHC(K,L,NY,NX)) - OQAXS=FOSCXS*AMAX1(0.0,OQA(K,L,NY,NX)) - OQAHXS=FOSCXS*AMAX1(0.0,OQAH(K,L,NY,NX)) - OHAXS=FOSCXS*AMAX1(0.0,OHA(K,L,NY,NX)) - OQNXS=FOSCXS*AMAX1(0.0,OQN(K,L,NY,NX)) - OQNHXS=FOSCXS*AMAX1(0.0,OQNH(K,L,NY,NX)) - OHNXS=FOSCXS*AMAX1(0.0,OHN(K,L,NY,NX)) - OQPXS=FOSCXS*AMAX1(0.0,OQP(K,L,NY,NX)) - OQPHXS=FOSCXS*AMAX1(0.0,OQPH(K,L,NY,NX)) - OHPXS=FOSCXS*AMAX1(0.0,OHP(K,L,NY,NX)) - ELSE - OQCXS=FOSCXS*AMAX1(0.0,OQC(K,LL,NY,NX)) - OQCHXS=FOSCXS*AMAX1(0.0,OQCH(K,LL,NY,NX)) - OHCXS=FOSCXS*AMAX1(0.0,OHC(K,LL,NY,NX)) - OQAXS=FOSCXS*AMAX1(0.0,OQA(K,LL,NY,NX)) - OQAHXS=FOSCXS*AMAX1(0.0,OQAH(K,LL,NY,NX)) - OHAXS=FOSCXS*AMAX1(0.0,OHA(K,LL,NY,NX)) - OQNXS=FOSCXS*AMAX1(0.0,OQN(K,LL,NY,NX)) - OQNHXS=FOSCXS*AMAX1(0.0,OQNH(K,LL,NY,NX)) - OHNXS=FOSCXS*AMAX1(0.0,OHN(K,LL,NY,NX)) - OQPXS=FOSCXS*AMAX1(0.0,OQP(K,LL,NY,NX)) - OQPHXS=FOSCXS*AMAX1(0.0,OQPH(K,LL,NY,NX)) - OHPXS=FOSCXS*AMAX1(0.0,OHP(K,LL,NY,NX)) - ENDIF - OQC(K,L,NY,NX)=OQC(K,L,NY,NX)-OQCXS - OQCH(K,L,NY,NX)=OQCH(K,L,NY,NX)-OQCHXS - OHC(K,L,NY,NX)=OHC(K,L,NY,NX)-OHCXS - OQA(K,L,NY,NX)=OQA(K,L,NY,NX)-OQAXS - OQAH(K,L,NY,NX)=OQAH(K,L,NY,NX)-OQAHXS - OHA(K,L,NY,NX)=OHA(K,L,NY,NX)-OHAXS - OQN(K,L,NY,NX)=OQN(K,L,NY,NX)-OQNXS - OQNH(K,L,NY,NX)=OQNH(K,L,NY,NX)-OQNHXS - OHN(K,L,NY,NX)=OHN(K,L,NY,NX)-OHNXS - OQP(K,L,NY,NX)=OQP(K,L,NY,NX)-OQPXS - OQPH(K,L,NY,NX)=OQPH(K,L,NY,NX)-OQPHXS - OHP(K,L,NY,NX)=OHP(K,L,NY,NX)-OHPXS - OQC(K,LL,NY,NX)=OQC(K,LL,NY,NX)+OQCXS - OQCH(K,LL,NY,NX)=OQCH(K,LL,NY,NX)+OQCHXS - OHC(K,LL,NY,NX)=OHC(K,LL,NY,NX)+OHCXS - OQA(K,LL,NY,NX)=OQA(K,LL,NY,NX)+OQAXS - OQAH(K,LL,NY,NX)=OQAH(K,LL,NY,NX)+OQAHXS - OHA(K,LL,NY,NX)=OHA(K,LL,NY,NX)+OHAXS - OQN(K,LL,NY,NX)=OQN(K,LL,NY,NX)+OQNXS - OQNH(K,LL,NY,NX)=OQNH(K,LL,NY,NX)+OQNHXS - OHN(K,LL,NY,NX)=OHN(K,LL,NY,NX)+OHNXS - OQP(K,LL,NY,NX)=OQP(K,LL,NY,NX)+OQPXS - OQPH(K,LL,NY,NX)=OQPH(K,LL,NY,NX)+OQPHXS - OHP(K,LL,NY,NX)=OHP(K,LL,NY,NX)+OHPXS - DO 7931 M=1,4 - IF(FOSCXS.GT.0.0)THEN - OSCXS=FOSCXS*AMAX1(0.0,OSC(M,K,L,NY,NX)) - OSAXS=FOSCXS*AMAX1(0.0,OSA(M,K,L,NY,NX)) - OSNXS=FOSCXS*AMAX1(0.0,OSN(M,K,L,NY,NX)) - OSPXS=FOSCXS*AMAX1(0.0,OSP(M,K,L,NY,NX)) - ELSE - OSCXS=FOSCXS*AMAX1(0.0,OSC(M,K,LL,NY,NX)) - OSAXS=FOSCXS*AMAX1(0.0,OSA(M,K,LL,NY,NX)) - OSNXS=FOSCXS*AMAX1(0.0,OSN(M,K,LL,NY,NX)) - OSPXS=FOSCXS*AMAX1(0.0,OSP(M,K,LL,NY,NX)) - ENDIF - OSC(M,K,L,NY,NX)=OSC(M,K,L,NY,NX)-OSCXS - OSA(M,K,L,NY,NX)=OSA(M,K,L,NY,NX)-OSAXS - OSN(M,K,L,NY,NX)=OSN(M,K,L,NY,NX)-OSNXS - OSP(M,K,L,NY,NX)=OSP(M,K,L,NY,NX)-OSPXS - OSC(M,K,LL,NY,NX)=OSC(M,K,LL,NY,NX)+OSCXS - OSA(M,K,LL,NY,NX)=OSA(M,K,LL,NY,NX)+OSAXS - OSN(M,K,LL,NY,NX)=OSN(M,K,LL,NY,NX)+OSNXS - OSP(M,K,LL,NY,NX)=OSP(M,K,LL,NY,NX)+OSPXS -7931 CONTINUE -7901 CONTINUE - ENDIF -C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.EQ.3)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 -2123 FORMAT(A8,5I4,12E15.4) -C ENDIF - ENDIF -998 CONTINUE -C WRITE(20,3434)'RN2O',IYRC,I,J,(RN2O(L,NY,NX),L=0,NL(NY,NX)) -3434 FORMAT(A8,3I4,20E12.4) -9990 CONTINUE -9995 CONTINUE - RETURN - END + SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) +C +C THIS SUBROUTINE CALCULATES ALL SOIL BIOLOGICAL TRANSFORMATIONS +C + include "parameters.h" + include "blkc.h" + include "blk2a.h" + include "blk2b.h" + include "blk2c.h" + include "blk8a.h" + include "blk8b.h" + include "blk10.h" + include "blk11a.h" + include "blk11b.h" + include "blk13a.h" + include "blk13b.h" + include "blk13c.h" + include "blk13d.h" + include "blk15a.h" + include "blk15b.h" + include "blk18a.h" + include "blk18b.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) + 3,RHOSN(4,0:4),RHOSP(4,0:4),RCOSC(4,0:4),RCOSN(4,0:4),RCOSP(4,0:4) + 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) + 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) + 6,CGOMP(7,0:5),RDMMC(2,7,0:5),RHMMC(2,7,0:5),RCMMC(2,7,0:5) + 7,RDMMN(2,7,0:5),RHMMN(2,7,0:5),RCMMN(2,7,0:5),RDMMP(2,7,0:5) + 8,RHMMP(2,7,0:5),RCMMP(2,7,0:5),RCCMC(2,7,0:4) + 9,RCCMN(2,7,0:4),RCCMP(2,7,0:4),RN2FX(7,0:5),TOMK(0:5) + 1,TONK(0:5),TOPK(0:5),SPOMC(2),OMC2(7,0:5),TFNG(7,0:5),TFNR(7,0:5) + 2,OMN2(7,0:5),FOM2(7,0:5),FOCA(0:4),FOAA(0:4),RXOMC(2,7,0:5) + 3,RXOMN(2,7,0:5),RXOMP(2,7,0:5),R3OMC(2,7,0:5),R3OMN(2,7,0:5) + 4,R3OMP(2,7,0:5),RXMMC(2,7,0:5),RXMMN(2,7,0:5),RXMMP(2,7,0:5) + 4,R3MMC(2,7,0:5),R3MMN(2,7,0:5),R3MMP(2,7,0:5),WFN(7,0:5) + DIMENSION CGOQC(7,0:5),CGOAC(7,0:5),ROQCK(0:4),XOQCK(0:4) + 2,EN2F(7),ORCT(0:4),OSCT(0:4),OSAT(0:4),ZNH4T(0:JZ),ZNO3T(0:JZ) + 3,ZNO2T(0:JZ),H2P4T(0:JZ),RINH4R(7,0:5),RINO3R(7,0:5) + 4,RIPO4R(7,0:5),FNH4XR(7,0:5),FNO3XR(7,0:5),FPO4XR(7,0:5) + 5,RGOMY(7,0:5),CNQ(0:4),CPQ(0:4),CNH(0:4),CPH(0:4) + 6,CNS(4,0:4),CPS(4,0:4),DCKX(0:4),ROQCD(7,0:4) + 7,DOSA(0:4),DOSX(0:4),DOSM(0:4),FORC(0:5),SPOMK(2),RMOMK(2) + 8,CGOMS(2,7,0:5),CGONS(2,7,0:5),CGOPS(2,7,0:5),H1P4T(0:JZ) + 1,TONX(0:5),TOPX(0:5),FCNK(0:4),FCPK(0:4),FP14XR(7,0:5) + 2,RCO2X(7,0:5),RCH3X(7,0:5),RCH4X(7,0:5),RVOXA(7),RVOXB(7) + 2,TGROMC(0:7),XOQCZ(0:4),XOQNZ(0:4),XOQPZ(0:4),XOQAZ(0:4) + 3,XOMCZ(3,7,0:4),XOMNZ(3,7,0:4),XOMPZ(3,7,0:4) + 4,FCN(7,0:5),FCP(7,0:5),FCNP(7,0:5),RIP14(7,0:5),RIP1B(7,0:5) + 5,TCGOQC(0:5),TCGOAC(0:5),TCGOMN(0:5),TCGOMP(0:5),TRINH4(JY,JX) + 6,TRN2ON(JY,JX),TRN2OD(JY,JX),TRN2GD(JY,JX),RIP14R(7,0:5) +C +C SUBSTRATE DECOMPOSITION BY MICROBIAL POPULATIONS +C + PARAMETER (ORAD=1.0E-06,BIOS=1.0E-06/(4.19*ORAD**3) + 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) +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 + 9,EDNH=1.00,EDNA=1.00) +C +C ENERGY REQUIREMENTS FOR MICROBIAL GROWTH AND +C ENERGY YIELDS FROM REDUCTION OF O2, OC, CH4, NO3, N2 +C + PARAMETER (EOMC=25.0,EOMD=37.5,EOMG=37.5,EOMF=25.0,EOMH=25.0 + 2,EOMN=75.0,GO2X=37.5,GCHX=4.50,GO2A=GO2X-GCHX,GC4X=3.00 + 3,GCOX=11.00,GNOX=10.0,GN2X=187.5,EN2X=GO2X/GN2X,EN2Y=GCHX/GN2X + 4,EO2X=1.0/(1.0+GO2X/EOMC),EO2G=1.0/(1.0+GO2X/EOMG) + 5,EO2D=1.0/(1.0+GO2X/EOMD),ENFX=1.0/(1.0+GO2X/EOMN) + 6,ENOX=1.0/(1.0+GNOX/EOMC),EO2A=1.0/(1.0+GO2A/EOMC)) +C +C SORPTION RATE CONSTANTS +C + PARAMETER (TSORP=0.5,HSORP=1.0) +C +C SPECIFIC DECOMPOSITION RATES +C + PARAMETER (SPOHC=0.25,SPOHA=0.25,RMOM=0.010) + DATA SPOSC/7.5,7.5,1.25,0.25,7.5,7.5,1.25,0.25 + 2,7.5,7.5,1.25,0.25,0.05,0.00,0.00,0.00 + 3,0.05,0.0167,0.00,0.00/ + DATA SPORC/7.5,1.25/ + DATA SPOMC/10.0E-03,5.0E-04/ + DATA DOSA/5.0E+00,5.0E+00,5.0E+00,5.0E+00,5.0E+00/ + DATA DOSX/0.0500,0.0500,0.0500,0.0125,0.0125/ + DATA DOSM/0.0050,0.0050,0.0050,0.0025,0.0025/ + DATA DCKX/0.50,0.50,0.50,0.00,0.00/ +C +C MICROBIAL C:N:P RATIOS DURING HUMIFICATION +C + DATA EN2F/0.0,0.0,0.0,0.0,0.0,EN2X,EN2Y/ + REAL*4 WFNG,TFNX,TFNY,TFNG,TFNR,CNSHZ,CPSHZ,FRM + DO 9995 NX=NHW,NHE + DO 9990 NY=NVN,NVS +C IF(I.EQ.1.AND.J.EQ.1)THEN +C TRINH4(NY,NX)=0.0 +C TRN2ON(NY,NX)=0.0 +C TRN2OD(NY,NX)=0.0 +C TRN2GD(NY,NX)=0.0 +C ENDIF + DO 998 L=0,NL(NY,NX) + IF(L.EQ.0.OR.L.GE.NU(NY,NX))THEN + 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)) + 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)) + ENDIF +C +C TEMPERATURE FUNCTIONS FOR GROWTH AND MAINTENANCE +C WITH OFFSET FOR THERMAL ADAPTATION +C + TKSO=TKS(L,NY,NX)+OFFSET(NY,NX) + RTK=8.3143*TKSO + STK=710.0*TKSO + ACTV=1+EXP((197500-STK)/RTK)+EXP((STK-222500)/RTK) + TFNX=EXP(25.229-62500/RTK)/ACTV + ACTVM=1+EXP((195000-STK)/RTK)+EXP((STK-232500)/RTK) + TFNY=EXP(25.214-62500/RTK)/ACTVM + 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)) + IF(ZNH4T(L).GT.ZEROS(NY,NX))THEN + FNH4S=AMAX1(0.0,ZNH4S(L,NY,NX))/ZNH4T(L) + FNHBS=AMAX1(0.0,ZNH4B(L,NY,NX))/ZNH4T(L) + ELSE + FNH4S=VLNH4(L,NY,NX) + FNHBS=VLNHB(L,NY,NX) + ENDIF + ZNO3T(L)=AMAX1(0.0,ZNO3S(L,NY,NX))+AMAX1(0.0,ZNO3B(L,NY,NX)) + IF(ZNO3T(L).GT.ZEROS(NY,NX))THEN + FNO3S=AMAX1(0.0,ZNO3S(L,NY,NX))/ZNO3T(L) + FNO3B=AMAX1(0.0,ZNO3B(L,NY,NX))/ZNO3T(L) + ELSE + FNO3S=VLNO3(L,NY,NX) + FNO3B=VLNOB(L,NY,NX) + ENDIF + ZNO2T(L)=AMAX1(0.0,ZNO2S(L,NY,NX))+AMAX1(0.0,ZNO2B(L,NY,NX)) + IF(ZNO2T(L).GT.ZEROS(NY,NX))THEN + FNO2S=AMAX1(0.0,ZNO2S(L,NY,NX))/ZNO2T(L) + FNO2B=AMAX1(0.0,ZNO2B(L,NY,NX))/ZNO2T(L) + ELSE + FNO2S=VLNO3(L,NY,NX) + FNO2B=VLNOB(L,NY,NX) + ENDIF + H1P4T(L)=AMAX1(0.0,H1PO4(L,NY,NX))+AMAX1(0.0,H1POB(L,NY,NX)) + IF(H1P4T(L).GT.ZEROS(NY,NX))THEN + FH1PS=AMAX1(0.0,H1PO4(L,NY,NX))/H1P4T(L) + FH1PB=AMAX1(0.0,H1POB(L,NY,NX))/H1P4T(L) + ELSE + FH1PS=VLPO4(L,NY,NX) + FH1PB=VLPOB(L,NY,NX) + ENDIF + H2P4T(L)=AMAX1(0.0,H2PO4(L,NY,NX))+AMAX1(0.0,H2POB(L,NY,NX)) + IF(H2P4T(L).GT.ZEROS(NY,NX))THEN + FH2PS=AMAX1(0.0,H2PO4(L,NY,NX))/H2P4T(L) + FH2PB=AMAX1(0.0,H2POB(L,NY,NX))/H2P4T(L) + ELSE + FH2PS=VLPO4(L,NY,NX) + FH2PB=VLPOB(L,NY,NX) + ENDIF + COXYQ1=COXYG(L,NY,NX)*SOXYL(L,NY,NX) +C +C TOTAL SUBSTRATE +C + TOSC=0.0 + TOSA=0.0 + TORC=0.0 + TOHC=0.0 +C +C TOTAL SOLID SUBSTRATE +C + DO 870 K=0,KL + OSCT(K)=0.0 + OSAT(K)=0.0 + DO 865 M=1,4 + OSCT(K)=OSCT(K)+OSC(M,K,L,NY,NX) + OSAT(K)=OSAT(K)+OSA(M,K,L,NY,NX) +865 CONTINUE + TOSC=TOSC+OSCT(K) + TOSA=TOSA+OSAT(K) +870 CONTINUE +C +C TOTAL BIORESIDUE +C + DO 880 K=0,KL + ORCT(K)=0.0 + DO 875 M=1,2 + ORCT(K)=ORCT(K)+ORC(M,K,L,NY,NX) +C IF(L.EQ.4.AND.K.EQ.2)THEN +C WRITE(*,876)'ORCT',I,J,NX,NY,L,K,M,ORCT(K) +C 2,ORC(M,K,L,NY,NX) +876 FORMAT(A8,7I4,60E12.4) +C ENDIF +875 CONTINUE + TORC=TORC+ORCT(K) +C +C TOTAL ADSORBED AND DISSOLVED SUBSTRATE +C + TOHC=TOHC+OHC(K,L,NY,NX)+OHA(K,L,NY,NX) +880 CONTINUE + DO 860 K=0,KL + OSRH(K)=OSAT(K)+ORCT(K)+OHC(K,L,NY,NX)+OHA(K,L,NY,NX) +C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.EQ.4.AND.K.EQ.2)THEN +C WRITE(*,861)'OSRH',I,J,NX,NY,L,K,OSRH(K),OSCT(K) +C 2,OSAT(K),ORCT(K),OHC(K,L,NY,NX),OHA(K,L,NY,NX) +861 FORMAT(A8,6I4,20E12.4) +C ENDIF +860 CONTINUE + TSRH=TOSA+TORC+TOHC +C +C C:N AND C:P RATIOS OF TOTAL BIOMASS +C + TOMA=0.0 + TOMN=0.0 + DO 890 K=0,5 + IF(L.NE.0.OR.(K.NE.3.AND.K.NE.4))THEN + DO 895 N=1,7 + IF(K.NE.5.OR.(N.LE.3.OR.N.EQ.5))THEN + IF(OMC(1,N,K,L,NY,NX).GT.ZEROS(NY,NX))THEN + CNOMA(N,K)=AMAX1(0.0,OMN(1,N,K,L,NY,NX)/OMC(1,N,K,L,NY,NX)) + CPOMA(N,K)=AMAX1(0.0,OMP(1,N,K,L,NY,NX)/OMC(1,N,K,L,NY,NX)) + ELSE + CNOMA(N,K)=CNOMC(1,N,K) + CPOMA(N,K)=CPOMC(1,N,K) + ENDIF + OMA(N,K)=AMAX1(0.0,OMC(1,N,K,L,NY,NX)/FL(1)) + FCN(N,K)=AMIN1(1.0,AMAX1(0.50,SQRT(CNOMA(N,K)/CNOMC(1,N,K)))) + FCP(N,K)=AMIN1(1.0,AMAX1(0.50,SQRT(CPOMA(N,K)/CPOMC(1,N,K)))) + FCNP(N,K)=AMIN1(FCN(N,K),FCP(N,K)) +C +C TOTAL BIOMASS +C + IF(K.NE.5.OR.(N.LE.3.OR.N.EQ.5))THEN + TOMA=TOMA+OMA(N,K) + ENDIF + IF((K.LE.4.AND.N.EQ.2).OR.(K.EQ.5.AND.N.EQ.1))THEN + TOMN=TOMN+OMA(N,K) + ENDIF + OMC2(N,K)=AMAX1(0.0,AMIN1(OMA(N,K)*FL(2),OMC(2,N,K,L,NY,NX))) + IF(OMC(2,N,K,L,NY,NX).GT.ZEROS(NY,NX))THEN + FOM2(N,K)=AMAX1(0.0,OMC2(N,K)/OMC(2,N,K,L,NY,NX)) + OMN2(N,K)=AMAX1(0.0,FOM2(N,K)*OMN(2,N,K,L,NY,NX)) + ELSE + FOM2(N,K)=0.0 + OMN2(N,K)=0.0 + ENDIF + ENDIF +895 CONTINUE + ENDIF +890 CONTINUE + DO 690 K=0,KL + TOMK(K)=0.0 + TONK(K)=0.0 + TOPK(K)=0.0 + TONX(K)=0.0 + TOPX(K)=0.0 + DO 685 N=1,7 + TOMK(K)=TOMK(K)+OMA(N,K) + TONK(K)=TONK(K)+OMA(N,K)*CNOMA(N,K) + TOPK(K)=TOPK(K)+OMA(N,K)*CPOMA(N,K) + TONX(K)=TONX(K)+OMA(N,K)*CNOMC(1,N,K) + TOPX(K)=TOPX(K)+OMA(N,K)*CPOMC(1,N,K) +685 CONTINUE +690 CONTINUE + DO 790 K=0,KL + IF(TSRH.GT.ZEROS(NY,NX))THEN + FOSRH(K,L,NY,NX)=OSRH(K)/TSRH + ELSE + FOSRH(K,L,NY,NX)=1.0 + ENDIF +C +C DOC CONCENTRATIONS +C + IF(VOLWM(NPH,L,NY,NX).GT.ZEROS(NY,NX))THEN + IF(FOSRH(K,L,NY,NX).GT.ZERO)THEN + COQC(K,L,NY,NX)=AMAX1(0.0,OQC(K,L,NY,NX) + 2/(VOLWM(NPH,L,NY,NX)*FOSRH(K,L,NY,NX))) + COQA(K,L,NY,NX)=AMAX1(0.0,OQA(K,L,NY,NX) + 2/(VOLWM(NPH,L,NY,NX)*FOSRH(K,L,NY,NX))) + ELSE + COQC(K,L,NY,NX)=AMAX1(0.0,OQC(K,L,NY,NX)/VOLWM(NPH,L,NY,NX)) + COQA(K,L,NY,NX)=AMAX1(0.0,OQA(K,L,NY,NX)/VOLWM(NPH,L,NY,NX)) + ENDIF + ELSE + COQC(K,L,NY,NX)=0.0 + COQA(K,L,NY,NX)=0.0 + OHCQ=0.0 + ENDIF + IF(OQC(K,L,NY,NX).GT.ZEROS(NY,NX))THEN + CNQ(K)=AMAX1(0.0,OQN(K,L,NY,NX)/OQC(K,L,NY,NX)) + CPQ(K)=AMAX1(0.0,OQP(K,L,NY,NX)/OQC(K,L,NY,NX)) + ELSE + CNQ(K)=0.0 + CPQ(K)=0.0 + ENDIF + IF(OQC(K,L,NY,NX).GT.ZEROS(NY,NX).AND.OQA(K,L,NY,NX) + 2.GT.ZEROS(NY,NX))THEN + FOCA(K)=OQC(K,L,NY,NX)/(OQC(K,L,NY,NX)+OQA(K,L,NY,NX)) + FOAA(K)=1.0-FOCA(K) + ELSEIF(OQC(K,L,NY,NX).GT.ZEROS(NY,NX))THEN + FOCA(K)=1.0 + FOAA(K)=0.0 + ELSE + FOCA(K)=0.0 + FOAA(K)=1.0 + ENDIF +790 CONTINUE +C +C NITROUS ACID CONCN AND ENERGY YIELD OF HYDROGENOTROPHIC +C METHANOGENESIS AT AMBIENT H2 CONCENTRATION +C + CHY1=AMAX1(ZERO,10.0**(-(PH(L,NY,NX)-3.0))) + CHNO2=CNO2S(L,NY,NX)*CHY1/0.5 + CHNOB=CNO2B(L,NY,NX)*CHY1/0.5 + GH2X=8.3143E-03*TKS(L,NY,NX) + 2*LOG((AMAX1(1.0E-03,CH2GS(L,NY,NX))/H2KI)**4) +C +C RESPIRATION BY MICROBIAL POPULATIONS +C + TFOXYX=0.0 + TFNH4X=0.0 + TFNO3X=0.0 + TFNO2X=0.0 + TFN2OX=0.0 + TFP14X=0.0 + TFPO4X=0.0 + TFNH4B=0.0 + TFNO3B=0.0 + TFNO2B=0.0 + TFP14B=0.0 + TFPO4B=0.0 + TCH4H=0.0 + TCH4A=0.0 + TFOQC=0.0 + TFOQA=0.0 + TRH2G=0.0 + IF(L.NE.0)THEN + LL=L + 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 + TCGOAC(K)=0.0 + TCGOMN(K)=0.0 + TCGOMP(K)=0.0 + DO 750 N=1,7 + IF(K.NE.5.OR.(N.LE.3.OR.N.EQ.5))THEN + IF(K.LE.4)THEN + IF(N.EQ.3)THEN + WFNG=EXP(0.1*PSISM(L,NY,NX)) + ELSE + WFNG=EXP(0.2*PSISM(L,NY,NX)) + ENDIF + OXKX=OXKM + ELSE + WFNG=EXP(0.2*PSISM(L,NY,NX)) + OXKX=OXKA + ENDIF + TFNG(N,K)=TFNX*WFNG + TFNR(N,K)=TFNY + IF(OMA(N,K).GT.0.0)THEN + IF(TOMA.GT.ZEROS(NY,NX))THEN + FOMA(N,K)=OMA(N,K)/TOMA + ELSE + FOMA(N,K)=1.0 + ENDIF + IF(TOMN.GT.ZEROS(NY,NX))THEN + FOMN(N,K)=OMA(N,K)/TOMN + ELSE + FOMN(N,K)=1.0 + ENDIF + IF(TOMK(K).GT.ZEROS(NY,NX))THEN + FOMK(N,K)=OMA(N,K)/TOMK(K) + ELSE + FOMK(N,K)=1.0 + ENDIF +C +C ADJUST MCROBIAL GROWTH AND DECOMPOSITION RATES FOR BIOMASS +C + IF(ORGCX.GT.ZEROS(NY,NX))THEN + DO 765 M=1,2 + COMC=OMC(M,N,K,L,NY,NX)/ORGCX + SPOMK(M)=COMC/(COMC+COMKI) + RMOMK(M)=COMC/(COMC+COMKM) +765 CONTINUE + ELSE + DO 770 M=1,2 + SPOMK(M)=1.0 + RMOMK(M)=1.0 +770 CONTINUE + ENDIF +C +C FACTORS CONSTRAINING DOC,ACETATE, O2, NH4, NO3, PO4 UPTAKE +C AMONG COMPETING MICROBIAL AND ROOT POPULATIONS IN SOIL LAYERS +C + IF(ROXYY(L,NY,NX).GT.ZEROS(NY,NX))THEN + FOXYX=AMAX1(FMN,ROXYS(N,K,L,NY,NX)/ROXYY(L,NY,NX)) + ELSE + FOXYX=AMAX1(FMN,FOMA(N,K)) + ENDIF + IF(RNH4Y(L,NY,NX).GT.ZEROS(NY,NX))THEN + FNH4X=AMAX1(FMN,RINHO(N,K,L,NY,NX)/RNH4Y(L,NY,NX)) + ELSE + FNH4X=AMAX1(FMN,FOMA(N,K)*VLNH4(L,NY,NX)) + ENDIF + IF(RNHBY(L,NY,NX).GT.ZEROS(NY,NX))THEN + FNB4X=AMAX1(FMN,RINHB(N,K,L,NY,NX)/RNHBY(L,NY,NX)) + ELSE + FNB4X=AMAX1(FMN,FOMA(N,K)*VLNHB(L,NY,NX)) + ENDIF + IF(RNO3Y(L,NY,NX).GT.ZEROS(NY,NX))THEN + FNO3X=AMAX1(FMN,RINOO(N,K,L,NY,NX)/RNO3Y(L,NY,NX)) + ELSE + FNO3X=AMAX1(FMN,FOMA(N,K)*VLNO3(L,NY,NX)) + ENDIF + IF(RN3BY(L,NY,NX).GT.ZEROS(NY,NX))THEN + FNB3X=AMAX1(FMN,RINOB(N,K,L,NY,NX)/RN3BY(L,NY,NX)) + ELSE + FNB3X=AMAX1(FMN,FOMA(N,K)*VLNOB(L,NY,NX)) + ENDIF + IF(RPO4Y(L,NY,NX).GT.ZEROS(NY,NX))THEN + FPO4X=AMAX1(FMN,RIPOO(N,K,L,NY,NX)/RPO4Y(L,NY,NX)) + ELSE + FPO4X=AMAX1(FMN,FOMA(N,K)*VLPO4(L,NY,NX)) + ENDIF + IF(RPOBY(L,NY,NX).GT.ZEROS(NY,NX))THEN + FPOBX=AMAX1(FMN,RIPBO(N,K,L,NY,NX)/RPOBY(L,NY,NX)) + ELSE + FPOBX=AMAX1(FMN,FOMA(N,K)*VLPOB(L,NY,NX)) + ENDIF + IF(RP14Y(L,NY,NX).GT.ZEROS(NY,NX))THEN + FP14X=AMAX1(FMN,RIPO1(N,K,L,NY,NX)/RP14Y(L,NY,NX)) + ELSE + FP14X=AMAX1(FMN,FOMA(N,K)*VLPO4(L,NY,NX)) + ENDIF + IF(RP1BY(L,NY,NX).GT.ZEROS(NY,NX))THEN + FP1BX=AMAX1(FMN,RIPB1(N,K,L,NY,NX)/RP1BY(L,NY,NX)) + ELSE + FP1BX=AMAX1(FMN,FOMA(N,K)*VLPOB(L,NY,NX)) + ENDIF + IF(K.LE.4)THEN + IF(ROQCY(K,L,NY,NX).GT.ZEROS(NY,NX))THEN + FOQC=AMAX1(FMN,ROQCS(N,K,L,NY,NX)/ROQCY(K,L,NY,NX)) + ELSE + FOQC=AMAX1(FMN,FOMK(N,K)) + ENDIF + TFOQC=TFOQC+FOQC + IF(ROQAY(K,L,NY,NX).GT.ZEROS(NY,NX))THEN + FOQA=AMAX1(FMN,ROQAS(N,K,L,NY,NX)/ROQAY(K,L,NY,NX)) + ELSE + FOQA=AMAX1(FMN,FOMK(N,K)) + ENDIF + TFOQA=TFOQA+FOQA + ENDIF + TFOXYX=TFOXYX+FOXYX + TFNH4X=TFNH4X+FNH4X + TFNO3X=TFNO3X+FNO3X + TFPO4X=TFPO4X+FPO4X + TFP14X=TFP14X+FP14X + TFNH4B=TFNH4B+FNB4X + TFNO3B=TFNO3B+FNB3X + TFPO4B=TFPO4B+FPOBX + TFP14B=TFP14B+FP1BX +C +C FACTORS CONSTRAINING NH4, NO3, PO4 UPTAKE AMONG COMPETING +C MICROBIAL POPULATIONS IN SURFACE RESIDUE +C + IF(L.EQ.0)THEN + IF(RNH4Y(NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN + FNH4XR(N,K)=AMAX1(FMN,RINHOR(N,K,NY,NX) + 2/RNH4Y(NU(NY,NX),NY,NX)) + ELSE + FNH4XR(N,K)=AMAX1(FMN,FOMK(N,K)) + ENDIF + IF(RNO3Y(NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN + FNO3XR(N,K)=AMAX1(FMN,RINOOR(N,K,NY,NX) + 2/RNO3Y(NU(NY,NX),NY,NX)) + ELSE + FNO3XR(N,K)=AMAX1(FMN,FOMK(N,K)) + ENDIF + IF(RPO4Y(NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN + FPO4XR(N,K)=AMAX1(FMN,RIPOOR(N,K,NY,NX) + 2/RPO4Y(NU(NY,NX),NY,NX)) + ELSE + FPO4XR(N,K)=AMAX1(FMN,FOMK(N,K)) + ENDIF + IF(RP14Y(NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN + FP14XR(N,K)=AMAX1(FMN,RIPO1R(N,K,NY,NX) + 2/RP14Y(NU(NY,NX),NY,NX)) + ELSE + FP14XR(N,K)=AMAX1(FMN,FOMK(N,K)) + ENDIF + ENDIF + IF(L.EQ.NU(NY,NX).AND.K.NE.3.AND.K.NE.4 + 2.AND.BKVL(0,NY,NX).GT.ZEROS(NY,NX))THEN + TFNH4X=TFNH4X+FNH4XR(N,K) + TFNO3X=TFNO3X+FNO3XR(N,K) + TFPO4X=TFPO4X+FPO4XR(N,K) + TFP14X=TFP14X+FP14XR(N,K) + ENDIF +C +C HETEROTROPHIC BIOMASS RESPIRATION +C + IF(K.LE.4)THEN +C +C RESPIRATION BY HETEROTROPHIC AEROBES: +C N=(1)OBLIGATE AEROBES,(2)FACULTATIVE ANAEROBES,(3)FUNGI,(6)N2 FIXERS +C + IF(N.LE.3.OR.N.EQ.6)THEN +C +C ENERGY YIELDS OF REDOX REACTIONS +C + IF(N.EQ.1)THEN + EO2Q=EO2X + ELSEIF(N.EQ.2)THEN + EO2Q=EO2D + ELSEIF(N.EQ.3)THEN + EO2Q=EO2G + ELSEIF(N.EQ.6)THEN + EO2Q=ENFX + ENDIF +C +C O2-UNCONSTRAINED RESPIRATION RATES BY HETEROTROPHIC AEROBES 'RGO*Z' +C FROM SPECIFIC OXIDATION RATE, ACTIVE BIOMASS, DOC OR ACETATE + +C CONCENTRATION,MICROBIAL C:N:P FACTOR, AND TEMPERATURE FOLLOWED BY +C POTENTIAL RESPIRATION RATES 'RGO*P' WITH UNLIMITED SUBSTRATE +C USED FOR MICROBIAL COMPETITION FACTOR +C + FSBSTC=COQC(K,L,NY,NX)/(COQC(K,L,NY,NX)+OQKM) + FSBSTA=COQA(K,L,NY,NX)/(COQA(K,L,NY,NX)+OQKA) + FSBST=FOCA(K)*FSBSTC+FOAA(K)*FSBSTA + RGOCY=AMAX1(0.0,FCNP(N,K)*VMXO*WFNG*OMA(N,K)) + RGOCZ=RGOCY*FSBSTC*FOCA(K)*TFNX + RGOAZ=RGOCY*FSBSTA*FOAA(K)*TFNX + RGOCX=AMAX1(0.0,OQC(K,L,NY,NX)*FOQC*EO2Q) + RGOAX=AMAX1(0.0,OQA(K,L,NY,NX)*FOQA*EO2A) + RGOCP=AMIN1(RGOCX,RGOCZ) + RGOAP=AMIN1(RGOAX,RGOAZ) + RGOMP=RGOCP+RGOAP + IF(RGOMP.GT.ZEROS(NY,NX))THEN + FGOCP=RGOCP/RGOMP + FGOAP=RGOAP/RGOMP + ELSE + FGOCP=1.0 + FGOAP=0.0 + ENDIF +C +C ENERGY YIELD AND O2 DEMAND FROM DOC AND ACETATE OXIDATION +C BY HETEROTROPHIC AEROBES +C + ECHZ=EO2Q*FGOCP+EO2A*FGOAP + ROXYM(N,K)=2.667*RGOMP + ROXYP(N,K)=ROXYM(N,K) + ROXYS(N,K,L,NY,NX)=ROXYP(N,K) + ROQCS(N,K,L,NY,NX)=RGOCZ + ROQAS(N,K,L,NY,NX)=RGOAZ + ROQCD(N,K)=RGOCY +C IF((I/120)*120.EQ.I.AND.J.EQ.24.AND.L.LE.6)THEN +C WRITE(*,5555)'RGOMP',I,J,NX,NY,L,K,N,RGOMP,RGOCX,RGOAX,RGOCZ +C 2,RGOAZ,RGOCX,RGOAX,FCNP(N,K),TFNG(N,K),VMXO,OMA(N,K),OSRH(K) +C 2,FOQC,FOQA,COQC(K,L,NY,NX),OQC(K,L,NY,NX),EO2Q,TKS(L,NY,NX) +C 3,COXYS(L,NY,NX),OQKM,OMC(1,N,K,L,NY,NX),OMC(2,N,K,L,NY,NX) +C 4,OMC(3,N,K,L,NY,NX),VOLWM(NPH,L,NY,NX),FOSRH(K,L,NY,NX) +C 5,FSBST,SPOMK(1),RMOMK(1),ROQCD(N,K) +5555 FORMAT(A8,7I4,60E12.4) +C ENDIF +C +C RESPIRATION BY HETEROTROPHIC ANAEROBES: +C N=(4)ACETOGENIC FERMENTERS (7) ACETOGENIC N2 FIXERS +C +C +C ENERGY YIELD FROM FERMENTATION DEPENDS ON H2 CONCENTRATION +C + ELSEIF(N.EQ.4.OR.N.EQ.7)THEN + GH2F=GH2X/72.0 + GOAX=8.3143E-03*TKS(L,NY,NX) + 2*LOG((AMAX1(ZERO,COQA(K,L,NY,NX))/OAKI)**2) + GOAF=GOAX/72.0 + GHAX=GH2F+GOAF + IF(N.EQ.4)THEN + ECHZ=AMAX1(EO2X,AMIN1(1.0,1.0 + 2/(1.0+AMAX1(0.0,(GCHX-GHAX))/EOMF))) + ELSE + ECHZ=AMAX1(ENFX,AMIN1(1.0,1.0 + 2/(1.0+AMAX1(0.0,(GCHX-GHAX))/EOMN))) + ENDIF +C +C RESPIRATION RATES BY HETEROTROPHIC ANAEROBES 'RGOMP' FROM +C SPECIFIC OXIDATION RATE, ACTIVE BIOMASS, DOC CONCENTRATION, +C MICROBIAL C:N:P FACTOR, AND TEMPERATURE FOLLOWED BY POTENTIAL +C RESPIRATION RATES 'RGOMP' WITH UNLIMITED SUBSTRATE USED FOR +C MICROBIAL COMPETITION FACTOR +C + FSBST=COQC(K,L,NY,NX)/(COQC(K,L,NY,NX)+OQKM)*OXYI + RGOFY=AMAX1(0.0,FCNP(N,K)*VMXF*WFNG*OMA(N,K)) + RGOFZ=RGOFY*FSBST*TFNX + RGOFX=AMAX1(0.0,OQC(K,L,NY,NX)*FOQC*ECHZ) + RGOMP=AMIN1(RGOFX,RGOFZ) + FGOCP=1.0 + FGOAP=0.0 + ROXYM(N,K)=0.0 + ROXYP(N,K)=0.0 + ROXYS(N,K,L,NY,NX)=0.0 + ROQCS(N,K,L,NY,NX)=RGOFZ + ROQAS(N,K,L,NY,NX)=0.0 + ROQCD(N,K)=RGOFY + TRH2G=TRH2G+RGOMP +C IF((I/120)*120.EQ.I.AND.J.EQ.24.AND.L.LE.6)THEN +C WRITE(*,5554)'FERM',I,J,NX,NY,L,K,N,RGOMP,RGOFX,RGOFZ,GHAX,GOAF +C 2,ECHZ,FCNP(N,K),TFNG(N,K),OMA(N,K),OSRH(K),FOQC,COQC(K,L,NY,NX) +C 3,OQKM,OMC(1,N,K,L,NY,NX),OMC(2,N,K,L,NY,NX),OMC(3,N,K,L,NY,NX) +C 3,OMN(1,N,K,L,NY,NX),OMN(2,N,K,L,NY,NX),OMN(3,N,K,L,NY,NX) +C 5,VOLWM(NPH,L,NY,NX),PSISM(L,NY,NX),WFNG,COXYS(L,NY,NX),OXYI +C 6,FSBST,FOSRH(K,L,NY,NX),SPOMK(1),RMOMK(1),ROQCD(N,K) +5554 FORMAT(A8,7I4,60E12.4) +C ENDIF +C +C ENERGY YIELD FROM ACETOTROPHIC METHANOGENESIS +C + ELSEIF(N.EQ.5)THEN + GOMX=8.3143E-03*TKS(L,NY,NX) + 2*LOG((AMAX1(ZERO,COQA(K,L,NY,NX))/OAKI)) + GOMM=GOMX/24.0 + ECHZ=AMAX1(EO2X,AMIN1(1.0,1.0/(1.0+AMAX1(0.0,(GC4X+GOMM))/EOMH))) +C +C RESPIRATION RATES BY ACETOTROPHIC METHANOGENS 'RGOMP' FROM SPECIFIC +C OXIDATION RATE, ACTIVE BIOMASS, DOC CONCENTRATION, +C MICROBIAL C:N:P FACTOR, AND TEMPERATURE FOLLOWED BY POTENTIAL C +C RESPIRATION RATES 'RGOMP' WITH UNLIMITED SUBSTRATE USED FOR +C MICROBIAL COMPETITION FACTOR +C + FSBST=COQA(K,L,NY,NX)/(COQA(K,L,NY,NX)+OQKAM) + RGOGY=AMAX1(0.0,FCNP(N,K)*VMXM*WFNG*OMA(N,K)) + RGOGZ=RGOGY*FSBST*TFNX + RGOGX=AMAX1(0.0,OQA(K,L,NY,NX)*FOQA*ECHZ) + RGOMP=AMIN1(RGOGX,RGOGZ) + FGOCP=0.0 + FGOAP=1.0 + ROXYM(N,K)=0.0 + ROXYP(N,K)=0.0 + ROXYS(N,K,L,NY,NX)=0.0 + ROQCS(N,K,L,NY,NX)=0.0 + ROQAS(N,K,L,NY,NX)=RGOGZ + ROQCD(N,K)=0.0 + TCH4H=TCH4H+0.5*RGOMP +C IF((I/30)*30.EQ.I.AND.NX.EQ.3.AND.NY.EQ.1.AND.J.EQ.24)THEN +C WRITE(*,5552)'ACMETH',I,J,NX,NY,L,K,N,RGOMP,RGOGZ,RGOGX,GOMM +C 2,ECHZ,FCNP(N,K),TFNG(N,K),OMA(N,K),FOQA,COQA(K,L,NY,NX),OQA(K,L,NY,NX) +C 3,OMC(1,N,K,L,NY,NX),OMC(2,N,K,L,NY,NX),OMC(3,N,K,L,NY,NX) +C 3,OMN(1,N,K,L,NY,NX),OMN(2,N,K,L,NY,NX),OMN(3,N,K,L,NY,NX) +C 5,VOLWM(NPH,L,NY,NX),PSISM(L,NY,NX),WFNG,COXYS(L,NY,NX) +C 6,OHA(K,L,NY,NX),FSBST,SPOMK(1),RMOMK(1) +5552 FORMAT(A8,7I4,40E12.4) +C ENDIF + ENDIF +C +C RESPIRATION RATES BY AUTOTROPHS 'RGOMP' FROM SPECIFIC +C OXIDATION RATE, ACTIVE BIOMASS, DOC CONCENTRATION, +C MICROBIAL C:N:P FACTOR, AND TEMPERATURE FOLLOWED BY POTENTIAL +C RESPIRATION RATES 'RGOMP' WITH UNLIMITED SUBSTRATE USED FOR MICROBIAL +C COMPETITION FACTOR. N=(1) NH4 OXIDIZERS (2) NO2 OXIDIZERS, +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 + IF(N.EQ.1)THEN +C +C FACTOR TO REGULATE COMPETITION FOR NH4 AMONG DIFFERENT +C MICROBIAL AND ROOT POPULATIONS +C + IF(RNH4Y(L,NY,NX).GT.ZEROS(NY,NX))THEN + FNH4=AMAX1(FMN,RVMX4(N,K,L,NY,NX)/RNH4Y(L,NY,NX)) + ELSE + FNH4=AMAX1(FMN,VLNH4(L,NY,NX)*FOMA(N,K)) + ENDIF + IF(RNHBY(L,NY,NX).GT.ZEROS(NY,NX))THEN + FNB4=AMAX1(FMN,RVMB4(N,K,L,NY,NX)/RNHBY(L,NY,NX)) + ELSE + FNB4=AMAX1(FMN,VLNHB(L,NY,NX)*FOMA(N,K)) + ENDIF + TFNH4X=TFNH4X+FNH4 + TFNH4B=TFNH4B+FNB4 +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))) + 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 +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 ENDIF +C +C NO2 OXIDIZERS +C + ELSEIF(N.EQ.2)THEN +C +C FACTOR TO REGULATE COMPETITION FOR NO2 AMONG DIFFERENT +C MICROBIAL POPULATIONS +C + IF(RNO2Y(L,NY,NX).GT.ZEROS(NY,NX))THEN + FNO2=AMAX1(FMN,RVMX2(N,K,L,NY,NX)/RNO2Y(L,NY,NX)) + ELSE + FNO2=AMAX1(FMN,FOMN(N,K)*VLNO3(L,NY,NX)) + ENDIF + IF(RN2BY(L,NY,NX).GT.ZEROS(NY,NX))THEN + FNB2=AMAX1(FMN,RVMB2(N,K,L,NY,NX)/RN2BY(L,NY,NX)) + ELSE + FNB2=AMAX1(FMN,FOMN(N,K)*VLNOB(L,NY,NX)) + ENDIF + TFNO2X=TFNO2X+FNO2 + TFNO2B=TFNO2B+FNB2 +C +C NO2 OXIDATION FROM SPECIFIC OXIDATION RATE, ENERGY YIELD, +C ACTIVE OXIDIZER BIOMASS, TEMPERATURE, AQUEOUS CO2 AND +C NO2 CONCENTRATIONS +C + ECHZ=EO2X + VMXA=TFNG(N,K)*FCNP(N,K)*XCO2*OMA(N,K)*VMXN + 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))) + 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 +C +C O2 DEMAND FROM NO2 OXIDATION +C + ROXYM(N,K)=2.667*RGOMP + ROXYP(N,K)=ROXYM(N,K)+1.143*RVOXP + ROXYS(N,K,L,NY,NX)=ROXYP(N,K) +C IF((I/30)*30.EQ.I.AND.J.EQ.15.AND.L.LE.6)THEN +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 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) +C 7,SPOMK(1),RMOMK(1) +6667 FORMAT(A8,5I4,50E12.4) +C ENDIF +C +C H2TROPHIC METHANOGENS +C + ELSEIF(N.EQ.5)THEN +C +C CO2 REDUCTION FROM SPECIFIC REDUCTION RATE, ENERGY YIELD, +C ACTIVE OXIDIZER BIOMASS, TEMPERATURE, AQUEOUS CO2 AND +C + GH2H=GH2X/12.0 + ECHZ=AMAX1(EO2X,AMIN1(1.0,1.0/(1.0+AMAX1(0.0,(GCOX+GH2H))/EOMH))) + VMXA=TFNG(N,K)*FCNP(N,K)*XCO2*OMA(N,K)*VMXC + H2GSX=H2GS(L,NY,NX)+0.111*TRH2G + FSBST=CH2GS(L,NY,NX)/(CH2GS(L,NY,NX)+H2KM) + RGOMP=AMAX1(0.0,AMIN1(1.5*H2GSX,VMXA*FSBST)) + ROXYM(N,K)=0.0 + ROXYM(N,K)=0.0 + ROXYS(N,K,L,NY,NX)=0.0 + TCH4A=TCH4A+RGOMP +C IF((I/30)*30.EQ.I.AND.NX.EQ.3.AND.NY.EQ.1.AND.J.EQ.24)THEN +C WRITE(*,5553)'H2METH',I,J,NX,NY,L,K,N,RGOMP,H2GS(L,NY,NX) +C 2,H2GSX,CH2GS(L,NY,NX),VMXA,TFNG(N,K),FCNP(N,K),XCO2 +C 3,OMA(N,K),VMXC,ECHZ,GCOX,GH2H,TKS(L,NY,NX),FSBST +C 4,SPOMK(1),RMOMK(1) +5553 FORMAT(A8,7I4,20E12.4) +C ENDIF +C +C METHANOTROPHS +C + ELSEIF(N.EQ.3)THEN +C +C CH4 OXIDATION FROM SPECIFIC OXIDATION RATE, ENERGY YIELD, +C ACTIVE OXIDIZER BIOMASS, TEMPERATURE, AQUEOUS CO2 AND +C CH4 CONCENTRATIONS IN BAND AND NON-BAND SOIL ZONES +C + ECHZ=EO2X + VMXA=TFNG(N,K)*FCNP(N,K)*OMA(N,K)*VMX4 + RCH4L1=RCH4L(L,NY,NX)*XNPG + RCH4F1=RCH4F(L,NY,NX)*XNPG + RCH4S1=(TCH4H+TCH4A)*XNPG + IF(L.EQ.0)THEN + CH4G1=CCH4E(NY,NX)*VOLPM(1,L,NY,NX) + ELSE + CH4G1=CCH4G(L,NY,NX)*VOLPM(1,L,NY,NX) + ENDIF + CH4S1=CH4S(L,NY,NX) + VMXA1=VMXA*XNPG + RVOXP=0.0 + RGOMP=0.0 +C +C CH4 DISSOLUTION FROM GASEOUS PHASE SOLVED IN SHORTER TIME STEP +C TO MAINTAIN AQUEOUS CH4 CONCENTRATION DURING OXIDATION +C + DO 320 M=1,NPH + IF(VOLWM(M,L,NY,NX).GT.ZEROS(NY,NX))THEN + VOLWCH=VOLWM(M,L,NY,NX)*SCH4L(L,NY,NX) + VOLWPM=VOLWCH+VOLPM(M,L,NY,NX) + DO 325 MM=1,NPT + CH4G1=CH4G1+RCH4F1 + CH4S1=CH4S1+RCH4L1+RCH4S1 + CCH4S1=AMAX1(0.0,CH4S1/VOLWM(M,L,NY,NX)) + FSBST=CCH4S1/(CCH4S1+CCK4) + RVOXP1=AMIN1(AMAX1(0.0,CH4S1)/(1.0+ECHO*ECHZ) + 2,VMXA1*FSBST) + RGOMP1=RVOXP1*ECHO*ECHZ + CH4S1=CH4S1-RVOXP1-RGOMP1 + IF(THETPM(M,L,NY,NX).GT.THETX)THEN + RCHDF=DFGS(M,L,NY,NX)*(AMAX1(ZEROS(NY,NX),CH4G1)*VOLWCH + 2-CH4S1*VOLPM(M,L,NY,NX))/VOLWPM + ELSE + RCHDF=0.0 + ENDIF + CH4G1=CH4G1-RCHDF + CH4S1=CH4S1+RCHDF + RVOXP=RVOXP+RVOXP1 + RGOMP=RGOMP+RGOMP1 +C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.EQ.0 +C 2.AND.MM.EQ.NPT)THEN +C WRITE(*,5547)'CH4OX',I,J,NX,NY,L,K,N,M,MM,RVOXP1,RGOMP1,CH4G1 +C 2,CH4S1,VMXA1,RVOXP,RGOMP,RCHDF,RCH4L1,RCH4F1,RCH4S1,CCH4S1 +C 3,ECHO,ECHZ,OMA(N,K),VOLWM(M,L,NY,NX),VOLPM(M,L,NY,NX),VOLWCH +C 4,THETPM(M,L,NY,NX),SCH4L(L,NY,NX),DFGS(M,L,NY,NX) +C 5,COXYS(L,NY,NX),CCH4E(NY,NX),FSBST,SPOMK(1),RMOMK(1) +C 6,CH4G1/VOLPM(M,L,NY,NX) +5547 FORMAT(A8,9I4,30E12.4) +C ENDIF +325 CONTINUE + ENDIF +320 CONTINUE + RVOXPA=RVOXP + RVOXPB=0.0 +C +C O2 DEMAND FROM CH4 OXIDATION +C + ROXYM(N,K)=2.667*RGOMP + ROXYP(N,K)=ROXYM(N,K)+4.00*RVOXP + ROXYS(N,K,L,NY,NX)=ROXYP(N,K) + ELSE + RGOMP=0.0 + ROXYM(N,K)=0.0 + ROXYP(N,K)=0.0 + ROXYS(N,K,L,NY,NX)=0.0 + ENDIF + ELSE + RGOMP=0.0 + ROXYM(N,K)=0.0 + ROXYP(N,K)=0.0 + ROXYS(N,K,L,NY,NX)=0.0 + ENDIF +C +C O2 UPTAKE BY AEROBES +C + RUPOX(N,K)=0.0 + IF(N.LE.3.OR.N.EQ.6)THEN + IF(ROXYP(N,K).GT.ZEROS(NY,NX).AND.FOXYX.GT.ZERO)THEN + IF(L.NE.0.OR.VOLX(L,NY,NX).GT.ZEROS(NY,NX))THEN +C +C MAXIMUM O2 UPAKE FROM POTENTIAL RESPIRATION OF EACH AEROBIC +C POPULATION +C + RUPMX=ROXYP(N,K)*XNPG + ROXYFX=ROXYF(L,NY,NX)*XNPG*FOXYX + OLSGL1=OLSGL(L,NY,NX)*XNPG + IF(L.NE.0)THEN + OXYG1=OXYG(L,NY,NX)*FOXYX + ROXYLX=ROXYL(L,NY,NX)*XNPG*FOXYX + ELSE + OXYG1=COXYG(L,NY,NX)*VOLPM(1,L,NY,NX)*FOXYX + ROXYLX=(ROXYL(L,NY,NX)+FLQRQ(NY,NX)*COXR(NY,NX) + 2+FLQRI(NY,NX)*COXQ(NY,NX))*XNPG*FOXYX + ENDIF + OXYS1=OXYS(L,NY,NX)*FOXYX +C +C O2 DISSOLUTION FROM GASEOUS PHASE SOLVED IN SHORTER TIME STEP +C TO MAINTAIN AQUEOUS O2 CONCENTRATION DURING REDUCTION +C + DO 420 M=1,NPH +C +C ACTUAL REDUCTION OF AQUEOUS BY AEROBES CALCULATED +C FROM MASS FLOW PLUS DIFFUSION = ACTIVE UPTAKE +C COUPLED WITH DISSOLUTION OF GASEOUS O2 DURING REDUCTION +C OF AQUEOUS O2 FROM DISSOLUTION RATE CONSTANT 'DFGS' +C CALCULATED IN 'WATSUB' +C + THETW1=AMAX1(0.0,VOLWM(M,L,NY,NX)/VOLX(L,NY,NX)) + RRADO=ORAD*(FILM(M,L,NY,NX)+ORAD)/FILM(M,L,NY,NX) + DIFOX=TORT(M,L,NY,NX)*OLSGL1*12.57*BIOS*OMA(N,K)*RRADO + VOLWOX=VOLWM(M,L,NY,NX)*SOXYL(L,NY,NX) + VOLPOX=VOLPM(M,L,NY,NX) + VOLWPM=VOLWOX+VOLPOX + DO 425 MX=1,NPT + OXYG1=OXYG1+ROXYFX + OXYS1=OXYS1+ROXYLX + COXYS1=AMIN1(COXYE(NY,NX)*SOXYL(L,NY,NX) + 2,AMAX1(0.0,OXYS1/(VOLWM(M,L,NY,NX)*FOXYX))) + X=DIFOX*COXYS1 + IF(X.GT.ZEROS(NY,NX).AND.OXYS1.GT.ZEROS(NY,NX))THEN + B=-RUPMX-DIFOX*OXKX-X + C=X*RUPMX + RMPOX=(-B-SQRT(B*B-4.0*C))/2.0 + ELSE + RMPOX=0.0 + ENDIF + OXYS1=OXYS1-RMPOX + IF(THETPM(M,L,NY,NX).GT.THETX.AND.VOLPOX.GT.ZEROS(NY,NX))THEN + ROXDFQ=DFGS(M,L,NY,NX)*(AMAX1(ZEROS(NY,NX),OXYG1)*VOLWOX + 2-OXYS1*VOLPOX)/VOLWPM + ELSE + ROXDFQ=0.0 + ENDIF + OXYG1=OXYG1-ROXDFQ + OXYS1=OXYS1+ROXDFQ + RUPOX(N,K)=RUPOX(N,K)+RMPOX + ROXSK(M,L,NY,NX)=ROXSK(M,L,NY,NX)+RMPOX +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 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) +C ENDIF +C IF((I/10)*10.EQ.I.AND.J.EQ.16.AND.L.EQ.NU(NY,NX) +C 2.AND.K.EQ.4.AND.N.EQ.2)THEN +C WRITE(*,5544)'OXY',I,J,L,K,N,M,MX,RUPOX(N,K),ROXYP(N,K) +C 2,ROXSK(M,L,NY,NX),RUPMX,RMPOX,DIFOX,OLSGL1,BIOS,OMA(N,K),X +C 2,ROXDFQ,ROXYLX,ROXYFX,FOXYX,COXYS1,OXYS1,OXYG1,OXYS1 +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 +5544 FORMAT(A8,7I4,50E12.4) +C ENDIF +425 CONTINUE +420 CONTINUE +C +C RATIO OF ACTUAL O2 UPAKE TO BIOLOGICAL DEMAND +C + WFN(N,K)=AMIN1(1.0,AMAX1(0.0,RUPOX(N,K)/ROXYP(N,K))) + IF(K.LE.4)THEN + ROQCS(N,K,L,NY,NX)=ROQCS(N,K,L,NY,NX)*WFN(N,K) + ROQAS(N,K,L,NY,NX)=ROQAS(N,K,L,NY,NX)*WFN(N,K) + ROQCD(N,K)=ROQCD(N,K)*WFN(N,K) + ENDIF + IF(K.EQ.5)THEN + IF(N.EQ.1)THEN + RVMX4(N,K,L,NY,NX)=RVMX4(N,K,L,NY,NX)*WFN(N,K) + RVMB4(N,K,L,NY,NX)=RVMB4(N,K,L,NY,NX)*WFN(N,K) + ELSEIF(N.EQ.2)THEN + RVMX2(N,K,L,NY,NX)=RVMX2(N,K,L,NY,NX)*WFN(N,K) + RVMB2(N,K,L,NY,NX)=RVMB2(N,K,L,NY,NX)*WFN(N,K) + ENDIF + ENDIF + ELSE + RUPOX(N,K)=ROXYP(N,K) + WFN(N,K)=1.0 + ENDIF + ELSE + RUPOX(N,K)=0.0 + WFN(N,K)=1.0 + ENDIF +C +C RESPIRATION PRODUCTS ALLOCATED TO O2, CO2, ACETATE, CH4, H2 +C + RGOMO(N,K)=RGOMP*WFN(N,K) + RCO2X(N,K)=RGOMO(N,K) + RCH3X(N,K)=0.0 + RCH4X(N,K)=0.0 + ROXYO(N,K)=ROXYM(N,K)*WFN(N,K) + RH2GX(N,K)=0.0 + IF(K.EQ.5)THEN + RVOXA(N)=RVOXPA*WFN(N,K) + RVOXB(N)=RVOXPB*WFN(N,K) + ENDIF + ELSEIF(N.EQ.4.OR.N.EQ.7)THEN + RGOMO(N,K)=RGOMP + RCO2X(N,K)=0.333*RGOMO(N,K) + RCH3X(N,K)=0.667*RGOMO(N,K) + RCH4X(N,K)=0.0 + ROXYO(N,K)=ROXYM(N,K) + IF(K.LE.4)THEN + RH2GX(N,K)=0.111*RGOMO(N,K) + ELSE + RH2GX(N,K)=0.0 + ENDIF + ELSEIF(N.EQ.5)THEN + RGOMO(N,K)=RGOMP + IF(K.LE.4)THEN + RCO2X(N,K)=0.50*RGOMO(N,K) + RCH3X(N,K)=0.00 + RCH4X(N,K)=0.50*RGOMO(N,K) + ROXYO(N,K)=ROXYM(N,K) + RH2GX(N,K)=0.0 + ELSEIF(K.EQ.5)THEN + RCO2X(N,K)=0.00 + RCH3X(N,K)=0.00 + RCH4X(N,K)=RGOMO(N,K) + ROXYO(N,K)=ROXYM(N,K) + RH2GX(N,K)=0.0 + RH2GZ=0.667*RGOMO(N,K) + ENDIF + ENDIF +C +C HETEROTROPHIC DENITRIFICATION +C + IF(K.LE.4.AND.N.EQ.2.AND.ROXYM(N,K).GT.0.0 + 2.AND.(L.NE.0.OR.VOLX(L,NY,NX).GT.ZEROS(NY,NX)))THEN +C +C FACTOR TO CONSTRAIN NO3 UPAKE AMONG COMPETING MICROBIAL +C AND ROOT POPULATIONS +C + IF(RNO3Y(L,NY,NX).GT.ZEROS(NY,NX))THEN + FNO3=AMAX1(FMN,RVMX3(N,K,L,NY,NX)/RNO3Y(L,NY,NX)) + ELSE + FNO3=AMAX1(FMN,FOMA(N,K)*VLNO3(L,NY,NX)) + ENDIF + IF(RN3BY(L,NY,NX).GT.ZEROS(NY,NX))THEN + FNB3=AMAX1(FMN,RVMB3(N,K,L,NY,NX)/RN3BY(L,NY,NX)) + ELSE + FNB3=AMAX1(FMN,FOMA(N,K)*VLNOB(L,NY,NX)) + ENDIF + TFNO3X=TFNO3X+FNO3 + TFNO3B=TFNO3B+FNB3 +C +C NO3 REDUCTION FROM SPECIFIC REDUCTION RATE, ENERGY YIELD, +C ACTIVE DENITRIFIER BIOMASS, TEMPERATURE, AQUEOUS NO3 +C CONCENTRATIONS AND STOICHIOMETRY OF REDOX ELECTRON TRANSFER +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 + IF(CNO3S(L,NY,NX).GT.ZERO)THEN + VMXD3S=VMXD3*FNO3S*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 + ENDIF + IF(CNO3B(L,NY,NX).GT.ZERO)THEN + VMXD3B=VMXD3*FNO3B*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 + ENDIF + OQCZ3=AMAX1(0.0,OQC(K,L,NY,NX)*FOQC-RGOCP*WFN(N,K)) + OQCD3=OQCZ3/ECN3 + OQCD3S=OQCD3*FNO3S + OQCD3B=OQCD3*FNO3B + ZNO3SX=ZNO3S(L,NY,NX)*FNO3 + ZNO3BX=ZNO3B(L,NY,NX)*FNB3 + RDNO3X=AMAX1(0.0,AMIN1(ZNO3SX,VMXD3S)) + RDNOBX=AMAX1(0.0,AMIN1(ZNO3BX,VMXD3B)) + RDNO3(N,K)=AMAX1(0.0,AMIN1(VMXD3S,OQCD3S,ZNO3SX)) + RDNOB(N,K)=AMAX1(0.0,AMIN1(VMXD3B,OQCD3B,ZNO3BX)) + RDNOX=RDNO3X+RDNOBX + RDNOT=RDNO3(N,K)+RDNOB(N,K) + RGOM3X=ECN3*RDNOX + RGOMD3=ECN3*RDNOT + RVMX3(N,K,L,NY,NX)=VMXD3S + RVMB3(N,K,L,NY,NX)=VMXD3B +C +C FACTOR TO CONSTRAIN NO2 UPAKE AMONG COMPETING MICROBIAL +C POPULATIONS +C + IF(RNO2Y(L,NY,NX).GT.ZEROS(NY,NX))THEN + FNO2=AMAX1(FMN,RVMX2(N,K,L,NY,NX)/RNO2Y(L,NY,NX)) + ELSE + FNO2=AMAX1(FMN,FOMA(N,K)*VLNO3(L,NY,NX)) + ENDIF + IF(RN2BY(L,NY,NX).GT.ZEROS(NY,NX))THEN + FNB2=AMAX1(FMN,RVMB2(N,K,L,NY,NX)/RN2BY(L,NY,NX)) + ELSE + FNB2=AMAX1(FMN,FOMA(N,K)*VLNOB(L,NY,NX)) + ENDIF + TFNO2X=TFNO2X+FNO2 + TFNO2B=TFNO2B+FNB2 +C +C NO2 REDUCTION FROM SPECIFIC REDUCTION RATE, ENERGY YIELD, +C ACTIVE DENITRIFIER BIOMASS, TEMPERATURE, AQUEOUS NO2 +C CONCENTRATIONS AND STOICHIOMETRY OF REDOX ELECTRON TRANSFER +C NOT ACCEPTED BY O2 AND NO3 IN BAND AND NON-BAND SOIL ZONES +C + VMXD2=VMXD3-RDNOT + IF(CNO2S(L,NY,NX).GT.ZERO)THEN + VMXD2S=VMXD2*FNO3S*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 + ENDIF + IF(CNO2B(L,NY,NX).GT.ZERO)THEN + VMXD2B=VMXD2*FNO3B*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 + ENDIF + OQCZ2=AMAX1(0.0,OQCZ3-RGOMD3) + OQCD2=OQCZ2/ECN2 + OQCD2S=OQCD2*FNO3S + OQCD2B=OQCD2*FNO3B + ZNO2SX=(ZNO2S(L,NY,NX)+RDNO3(N,K))*FNO2 + ZNO2BX=(ZNO2B(L,NY,NX)+RDNOB(N,K))*FNB2 + RDNO2X=AMAX1(0.0,AMIN1(ZNO2SX,VMXD2S)) + RDNOBX=AMAX1(0.0,AMIN1(ZNO2BX,VMXD2B)) + RDNO2(N,K)=AMAX1(0.0,AMIN1(VMXD2S,OQCD2S,ZNO2SX)) + RDN2B(N,K)=AMAX1(0.0,AMIN1(VMXD2B,OQCD2B,ZNO2BX)) + RDN2X=RDNO2X+RDNOBX + RDN2T=RDNO2(N,K)+RDN2B(N,K) + RGOM2X=ECN2*RDN2X + RGOMD2=ECN2*RDN2T + RVMX2(N,K,L,NY,NX)=VMXD2S + RVMB2(N,K,L,NY,NX)=VMXD2B +C +C FACTOR TO CONSTRAIN N2O UPAKE AMONG COMPETING MICROBIAL +C AND ROOT POPULATIONS +C + IF(RN2OY(L,NY,NX).GT.ZEROS(NY,NX))THEN + FN2O=AMAX1(FMN,RVMX1(N,K,L,NY,NX)/RN2OY(L,NY,NX)) + ELSE + FN2O=AMAX1(FMN,FOMA(N,K)) + ENDIF + TFN2OX=TFN2OX+FN2O +C +C N2O REDUCTION FROM SPECIFIC REDUCTION RATE, ENERGY YIELD, +C ACTIVE DENITRIFIER BIOMASS, TEMPERATURE, AQUEOUS N2O +C CONCENTRATIONS AND STOICHIOMETRY OF REDOX ELECTRON TRANSFER +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) + OQCZ1=AMAX1(0.0,OQCZ2-RGOMD2) + OQCD1=OQCZ1/ECN1 + Z2OSX=(Z2OS(L,NY,NX)+RDN2T)*FN2O + RDN2OX=AMAX1(0.0,AMIN1(Z2OSX,VMXD1S)) + RDN2O(N,K)=AMAX1(0.0,AMIN1(VMXD1S,OQCD1,Z2OSX)) + RGOM1X=ECN1*RDN2OX + RGOMD1=ECN1*RDN2O(N,K) + RGOMY(N,K)=RGOM3X+RGOM2X+RGOM1X + RGOMD(N,K)=RGOMD3+RGOMD2+RGOMD1 + 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 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) +C 3,ROXYO(N,K),OMA(N,K),VMXD,CNO3S(L,NY,NX),CNO3B(L,NY,NX) +C 4,CNO2S(L,NY,NX),CNO2B(L,NY,NX),CZ2OS(L,NY,NX),VLNO3(L,NY,NX) +C 5,VLNOB(L,NY,NX),THETW(L,NY,NX),THETI(L,NY,NX),FOMA(N,K) +C 5,ZNO3S(L,NY,NX),ZNO3B(L,NY,NX),ZNO2S(L,NY,NX),ZNO2B(L,NY,NX) +C 6,Z2OS(L,NY,NX),RGOMY(N,K),RGOMD(N,K),TOMA,FOXYX,FNO23S,FNO23B +C 7,OQC(K,L,NY,NX),FOQC,RGOCP,WFN(N,K),VOLWZ,FOSRH(K,L,NY,NX),ZERO +C 9,RGOM3X,RGOM2X,RGOM1X,FNO3,FNO2,FN2O,ZNO3SX,ZNO2SX,Z2OSX +C 3,OQCD3S,OQCD2S,OQCD1,VMXD3S,VMXD2S,VMXD1S,VMXD3,VMXD2,VMXD1 +C 4,ROXYD,VMXDX,TFNX,WFNG,TFNG(N,K),PSISM(L,NY,NX) +C 2,(1.0+(CNO2S(L,NY,NX)*Z3KM)/(CNO3S(L,NY,NX)*Z2KM)) +C 2,(1.0+(CZ2OS(L,NY,NX)*Z2KM)/(CNO2S(L,NY,NX)*Z1KM)) +2222 FORMAT(A8,5I4,70E12.4) +C ENDIF +C +C AUTOTROPHIC DENITRIFICATION +C + ELSEIF(K.EQ.5.AND.N.EQ.1.AND.ROXYM(N,K).GT.0.0 + 2.AND.(L.NE.0.OR.VOLX(L,NY,NX).GT.ZEROS(NY,NX)))THEN +C +C FACTOR TO CONSTRAIN NO2 UPAKE AMONG COMPETING MICROBIAL +C POPULATIONS +C + IF(RNO2Y(L,NY,NX).GT.ZEROS(NY,NX))THEN + FNO2=AMAX1(FMN,RVMX2(N,K,L,NY,NX)/RNO2Y(L,NY,NX)) + ELSE + FNO2=AMAX1(FMN,FOMN(N,K)*VLNO3(L,NY,NX)) + ENDIF + IF(RN2BY(L,NY,NX).GT.ZEROS(NY,NX))THEN + FNB2=AMAX1(FMN,RVMB2(N,K,L,NY,NX)/RN2BY(L,NY,NX)) + ELSE + FNB2=AMAX1(FMN,FOMN(N,K)*VLNOB(L,NY,NX)) + ENDIF + TFNO2X=TFNO2X+FNO2 + TFNO2B=TFNO2B+FNB2 +C +C NO2 REDUCTION FROM SPECIFIC REDUCTION RATE, ENERGY YIELD, +C ACTIVE NITRIFIER BIOMASS, TEMPERATURE, AQUEOUS NO2 AND CO2 +C CONCENTRATIONS AND STOICHIOMETRY OF REDOX ELECTRON TRANSFER +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)) + 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 + 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 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 ENDIF + ELSE + RDNO3(N,K)=0.0 + RDNOB(N,K)=0.0 + RDNO2(N,K)=0.0 + RDN2B(N,K)=0.0 + RDN2O(N,K)=0.0 + RGOMY(N,K)=0.0 + RGOMD(N,K)=0.0 + ENDIF +C +C BIOMASS DECOMPOSITION AND MINERALIZATION +C +C +C MINERALIZATION-IMMOBILIZATION OF NH4 IN SOIL FROM MICROBIAL +C C:N AND NH4 CONCENTRATION IN BAND AND NON-BAND SOIL ZONES +C + RINHP=(OMC(3,N,K,L,NY,NX)*CNOMC(3,N,K)-OMN(3,N,K,L,NY,NX)) + IF(RINHP.GT.0.0)THEN + CNH4X=AMAX1(0.0,CNH4S(L,NY,NX)-Z4MN) + CNH4Y=AMAX1(0.0,CNH4B(L,NY,NX)-Z4MN) + RINHX=AMIN1(RINHP,BIOA*OMA(N,K)*TFNG(N,K)*Z4MX) + RINHO(N,K,L,NY,NX)=FNH4S*RINHX*CNH4X/(CNH4X+Z4KU) + RINHB(N,K,L,NY,NX)=FNHBS*RINHX*CNH4Y/(CNH4Y+Z4KU) + ZNH4M=Z4MN*VOLW(L,NY,NX)*FNH4S + ZNHBM=Z4MN*VOLW(L,NY,NX)*FNHBS + RINH4(N,K)=AMIN1(FNH4X*AMAX1(0.0,(ZNH4S(L,NY,NX)-ZNH4M)) + 2,RINHO(N,K,L,NY,NX)) + RINB4(N,K)=AMIN1(FNB4X*AMAX1(0.0,(ZNH4B(L,NY,NX)-ZNHBM)) + 2,RINHB(N,K,L,NY,NX)) + ELSE + RINHO(N,K,L,NY,NX)=0.0 + RINHB(N,K,L,NY,NX)=0.0 + RINH4(N,K)=RINHP*FNH4S + RINB4(N,K)=RINHP*FNHBS + ENDIF +C TRINH4(NY,NX)=TRINH4(NY,NX)+(RINH4(N,K)+RINB4(N,K)) +C 2/AREA(3,L,NY,NX) +C IF(I.EQ.365.AND.J.EQ.24.AND.L.EQ.NJ(NY,NX) +C 2.AND.K.EQ.5.AND.N.EQ.3)THEN +C WRITE(*,7776)'RINH4',IYRC,I,J,NX,NY,L,K,N,TRINH4(NY,NX) +C 1,RINH4(N,K),RINHP +C 1,BIOA*OMA(N,K)*Z4MX*TFNG(N,K),BIOA,OMA(N,K),Z4MX,TFNG(N,K) +C 2,OMC(M,N,K,L,NY,NX),CNOMC(3,N,K),OMN(M,N,K,L,NY,NX) +C 3,RINHO(N,K,L,NY,NX),CNH4S(L,NY,NX),FNH4X +C 4,ZNH4T(L),OQN(K,L,NY,NX) +7776 FORMAT(A8,8I6,30E12.4) +C ENDIF +C +C MINERALIZATION-IMMOBILIZATION OF NO3 IN SOIL FROM MICROBIAL +C C:N AND NO3 CONCENTRATION IN BAND AND NON-BAND SOIL ZONES +C + RINOP=AMAX1(0.0,RINHP-RINH4(N,K)-RINB4(N,K)) + IF(RINOP.GT.0.0)THEN + CNO3X=AMAX1(0.0,CNO3S(L,NY,NX)-ZOMN) + CNO3Y=AMAX1(0.0,CNO3B(L,NY,NX)-ZOMN) + RINOX=AMIN1(RINOP,BIOA*OMA(N,K)*TFNG(N,K)*ZOMX) + RINOO(N,K,L,NY,NX)=FNO3S*RINOX*CNO3X/(CNO3X+ZOKU) + RINOB(N,K,L,NY,NX)=FNO3B*RINOX*CNO3Y/(CNO3Y+ZOKU) + ZNO3M=ZOMN*VOLW(L,NY,NX)*FNO3S + ZNOBM=ZOMN*VOLW(L,NY,NX)*FNO3B + RINO3(N,K)=AMIN1(FNO3X*AMAX1(0.0,(ZNO3S(L,NY,NX)-ZNO3M)) + 2,RINOO(N,K,L,NY,NX)) + RINB3(N,K)=AMIN1(FNB3X*AMAX1(0.0,(ZNO3B(L,NY,NX)-ZNOBM)) + 2,RINOB(N,K,L,NY,NX)) + ELSE + RINOO(N,K,L,NY,NX)=0.0 + RINOB(N,K,L,NY,NX)=0.0 + RINO3(N,K)=RINOP*FNO3S + RINB3(N,K)=RINOP*FNO3B + ENDIF +C +C MINERALIZATION-IMMOBILIZATION OF H2PO4 IN SOIL FROM MICROBIAL +C C:P AND PO4 CONCENTRATION IN BAND AND NON-BAND SOIL ZONES +C + RIPOP=(OMC(3,N,K,L,NY,NX)*CPOMC(3,N,K)-OMP(3,N,K,L,NY,NX)) + IF(RIPOP.GT.0.0)THEN + CH2PX=AMAX1(0.0,CH2P4(L,NY,NX)-HPMN) + CH2PY=AMAX1(0.0,CH2P4B(L,NY,NX)-HPMN) + RIPOX=AMIN1(RIPOP,BIOA*OMA(N,K)*TFNG(N,K)*HPMX) + RIPOO(N,K,L,NY,NX)=FH2PS*RIPOX*CH2PX/(CH2PX+HPKU) + RIPBO(N,K,L,NY,NX)=FH2PB*RIPOX*CH2PY/(CH2PY+HPKU) + H2POM=HPMN*VOLW(L,NY,NX)*FH2PS + H2PBM=HPMN*VOLW(L,NY,NX)*FH2PB + RIPO4(N,K)=AMIN1(FPO4X*AMAX1(0.0,(H2PO4(L,NY,NX)-H2POM)) + 2,RIPOO(N,K,L,NY,NX)) + RIPOB(N,K)=AMIN1(FPOBX*AMAX1(0.0,(H2POB(L,NY,NX)-H2PBM)) + 2,RIPBO(N,K,L,NY,NX)) + ELSE + RIPOO(N,K,L,NY,NX)=0.0 + RIPBO(N,K,L,NY,NX)=0.0 + RIPO4(N,K)=RIPOP*FH2PS + RIPOB(N,K)=RIPOP*FH2PB + ENDIF +C IF(NY.EQ.5.AND.L.EQ.10.AND.K.EQ.3.AND.N.EQ.2)THEN +C WRITE(*,4322)'RIPO4',I,J,NX,NY,L,K,N,RIPO4(N,K),FPO4X,H2P4T(L) +C 2,RIPOO(N,K,L,NY,NX),RIPOP,BIOA,OMA(N,K),TFNG(N,K),HPMX,WFN(N,K) +C 2,VLPO4(L,NY,NX),VLPOB(L,NY,NX),CH2P4(L,NY,NX),CH2P4B(L,NY,NX) +C 3,OMC(3,N,K,L,NY,NX),CPOMC(3,N,K),OMP(3,N,K,L,NY,NX),WFNG +4322 FORMAT(A8,7I4,30E12.4) +C ENDIF +C +C MINERALIZATION-IMMOBILIZATION OF HPO4 IN SOIL FROM MICROBIAL +C C:P AND PO4 CONCENTRATION IN BAND AND NON-BAND SOIL ZONES +C + RIP1P=0.1*AMAX1(0.0,RIPOP-RIPO4(N,K)-RIPOB(N,K)) + IF(RIP1P.GT.0.0)THEN + CH1PX=AMAX1(0.0,CH1P4(L,NY,NX)-HPMN) + CH1PY=AMAX1(0.0,CH1P4B(L,NY,NX)-HPMN) + RIP1X=AMIN1(RIP1P,BIOA*OMA(N,K)*TFNG(N,K)*HPMX) + RIPO1(N,K,L,NY,NX)=FH1PS*RIP1X*CH1PX/(CH1PX+HPKU) + RIPB1(N,K,L,NY,NX)=FH1PB*RIP1X*CH1PY/(CH1PY+HPKU) + H1POM=HPMN*VOLW(L,NY,NX)*FH1PS + H1PBM=HPMN*VOLW(L,NY,NX)*FH1PB + RIP14(N,K)=AMIN1(FP14X*AMAX1(0.0,(H1PO4(L,NY,NX)-H1POM)) + 2,RIPO1(N,K,L,NY,NX)) + RIP1B(N,K)=AMIN1(FP1BX*AMAX1(0.0,(H1POB(L,NY,NX)-H1PBM)) + 2,RIPB1(N,K,L,NY,NX)) + ELSE + RIPO1(N,K,L,NY,NX)=0.0 + RIPB1(N,K,L,NY,NX)=0.0 + RIP14(N,K)=RIP1P*FH1PS + RIP1B(N,K)=RIP1P*FH1PB + ENDIF +C IF(NY.EQ.5.AND.L.EQ.10.AND.K.EQ.3.AND.N.EQ.2)THEN +C WRITE(*,4323)'RIP14',I,J,NX,NY,L,K,N,RIP14(N,K),FP14X,H1P4T(L) +C 2,RIPO1(N,K,L,NY,NX),RIP1P,BIOA,OMA(N,K),TFNG(N,K),HPMX,WFN(N,K) +C 2,VLPO4(L,NY,NX),VLPOB(L,NY,NX),CH1P4(L,NY,NX),CH1P4B(L,NY,NX) +C 3,OMC(3,N,K,L,NY,NX),CPOMC(3,N,K),OMP(3,N,K,L,NY,NX),WFNG +4323 FORMAT(A8,7I4,30E12.4) +C ENDIF +C +C MINERALIZATION-IMMOBILIZATION OF NH4 IN SURFACE RESIDUE FROM +C MICROBIAL C:N AND NH4 CONCENTRATION IN BAND AND NON-BAND SOIL +C ZONES OF SOIL SURFACE +C + IF(L.EQ.0)THEN + RINHPR=RINHP-RINH4(N,K)-RINO3(N,K) + IF(RINHPR.GT.0.0)THEN + CNH4X=AMAX1(0.0,CNH4S(NU(NY,NX),NY,NX)-Z4MN) + CNH4Y=AMAX1(0.0,CNH4B(NU(NY,NX),NY,NX)-Z4MN) + RINHOR(N,K,NY,NX)=AMIN1(RINHPR,BIOA*OMA(N,K)*TFNG(N,K)*Z4MX) + 2*(FNH4S*CNH4X/(CNH4X+Z4KU)+FNHBS*CNH4Y + 3/(CNH4Y+Z4KU)) + ZNH4M=Z4MN*VOLW(NU(NY,NX),NY,NX) + RINH4R(N,K)=AMIN1(FNH4XR(N,K)*AMAX1(0.0 + 2,(ZNH4T(NU(NY,NX))-ZNH4M)),RINHOR(N,K,NY,NX)) + ELSE + RINHOR(N,K,NY,NX)=0.0 + RINH4R(N,K)=RINHPR + ENDIF +C TRINH4(NY,NX)=TRINH4(NY,NX)+RINH4R(N,K) +C 2/AREA(3,L,NY,NX) +C IF(K.EQ.2.AND.N.EQ.1)THEN +C WRITE(*,7778)'RINH4R',I,J,NX,NY,L,K,N,RINH4R(N,K),RINHPR +C 2,BIOA*OMA(N,K)*Z4MX,RINHP,RINH4(N,K),RINO3(N,K) +C 3,RINHOR(N,K,NY,NX),CNH4S(NU(NY,NX),NY,NX),FNH4XR(N,K) +C 4,ZNH4T(NU(NY,NX)) +7778 FORMAT(A8,7I4,20E12.4) +C ENDIF +C +C MINERALIZATION-IMMOBILIZATION OF NO3 IN SURFACE RESIDUE FROM +C MICROBIAL C:N AND NO3 CONCENTRATION IN BAND AND NON-BAND SOIL +C ZONES OF SOIL SURFACE +C + RINOPR=AMAX1(0.0,RINHPR-RINH4R(N,K)) + IF(RINOPR.GT.0.0)THEN + CNO3X=AMAX1(0.0,CNO3S(NU(NY,NX),NY,NX)-ZOMN) + CNO3Y=AMAX1(0.0,CNO3B(NU(NY,NX),NY,NX)-ZOMN) + RINOOR(N,K,NY,NX)=AMAX1(RINOPR,BIOA*OMA(N,K)*TFNG(N,K)*ZOMX) + 2*(FNO3S*CNO3X/(CNO3X+ZOKU)+FNO3B*CNO3Y + 3/(CNO3Y+ZOKU)) + ZNO3M=ZOMN*VOLW(NU(NY,NX),NY,NX) + RINO3R(N,K)=AMIN1(FNO3XR(N,K)*AMAX1(0.0 + 2,(ZNO3T(NU(NY,NX))-ZNO3M)),RINOOR(N,K,NY,NX)) + ELSE + RINOOR(N,K,NY,NX)=0.0 + RINO3R(N,K)=RINOPR + ENDIF +C +C MINERALIZATION-IMMOBILIZATION OF H2PO4 IN SURFACE RESIDUE FROM +C MICROBIAL C:P AND PO4 CONCENTRATION IN BAND AND NON-BAND SOIL +C ZONES OF SOIL SURFACE +C + RIPOPR=RIPOP-RIPO4(N,K) + IF(RIPOPR.GT.0.0)THEN + CH2PX=AMAX1(0.0,CH2P4(NU(NY,NX),NY,NX)-HPMN) + CH2PY=AMAX1(0.0,CH2P4B(NU(NY,NX),NY,NX)-HPMN) + RIPOOR(N,K,NY,NX)=AMIN1(RIPOPR,BIOA*OMA(N,K)*TFNG(N,K)*HPMX) + 2*(FH2PS*CH2PX/(CH2PX+HPKU)+FH2PB*CH2PY + 3/(CH2PY+HPKU)) + H2P4M=HPMN*VOLW(NU(NY,NX),NY,NX) + RIPO4R(N,K)=AMIN1(FPO4XR(N,K)*AMAX1(0.0 + 2,(H2P4T(NU(NY,NX))-H2P4M)),RIPOOR(N,K,NY,NX)) + ELSE + RIPOOR(N,K,NY,NX)=0.0 + RIPO4R(N,K)=RIPOPR + ENDIF +C WRITE(*,7778)'RIPO4R',I,J,NX,NY,L,K,N,RIPO4R(N,K),FPO4XR(N,K) +C 2,H2P4T(NU(NY,NX)),RIPOOR(N,K,NY,NX),RIPOPR +C +C MINERALIZATION-IMMOBILIZATION OF HPO4 IN SURFACE RESIDUE FROM +C MICROBIAL C:P AND PO4 CONCENTRATION IN BAND AND NON-BAND SOIL +C ZONES OF SOIL SURFACE +C + RIP1PR=0.1*AMAX1(0.0,RIPOPR-RIPO4R(N,K)) + IF(RIP1PR.GT.0.0)THEN + CH1PX=AMAX1(0.0,CH1P4(NU(NY,NX),NY,NX)-HPMN) + CH1PY=AMAX1(0.0,CH1P4B(NU(NY,NX),NY,NX)-HPMN) + RIPO1R(N,K,NY,NX)=AMIN1(RIP1PR,BIOA*OMA(N,K)*TFNG(N,K)*HPMX) + 2*(FH1PS*CH1PX/(CH1PX+HPKU)+FH1PB*CH1PY + 3/(CH1PY+HPKU)) + H1P4M=HPMN*VOLW(NU(NY,NX),NY,NX) + RIP14R(N,K)=AMIN1(FP14XR(N,K)*AMAX1(0.0 + 2,(H1P4T(NU(NY,NX))-H1P4M)),RIPO1R(N,K,NY,NX)) + ELSE + RIPO1R(N,K,NY,NX)=0.0 + RIP14R(N,K)=RIP1PR + ENDIF +C WRITE(*,7778)'RIP14R',I,J,NX,NY,L,K,N,RIP14R(N,K),FP14XR(N,K) +C 2,H1P4T(NU(NY,NX)),RIPO1R(N,K,NY,NX),RIP1PR + ENDIF +C +C pH EFFECT ON MAINTENANCE RESPIRATION +C + FPH=1.0+AMAX1(0.0,0.25*(6.5-PH(L,NY,NX))) + RMOMX=RMOM*TFNR(N,K)*FPH + RMOMC(1,N,K)=OMN(1,N,K,L,NY,NX)*RMOMX*RMOMK(1) + RMOMC(2,N,K)=OMN2(N,K)*RMOMX*RMOMK(2) +C +C MICROBIAL MAINTENANCE AND GROWTH RESPIRATION +C + RMOMT=RMOMC(1,N,K)+RMOMC(2,N,K) + RGOMT=AMAX1(0.0,RGOMO(N,K)-RMOMT) + RXOMT=AMAX1(0.0,RMOMT-RGOMO(N,K)) +C +C N2 FIXATION: N=(6) AEROBIC, (7) ANAEROBIC +C FROM GROWTH RESPIRATION, FIXATION ENERGY REQUIREMENT, +C MICROBIAL N REQUIREMENT IN LABILE (1) AND RESISTANT (2) FRACTIONS +C + IF(K.LE.4.AND.(N.EQ.6.OR.N.EQ.7))THEN + RGN2P=AMAX1(0.0,OMC(3,N,K,L,NY,NX)*CNOMC(3,N,K) + 2-OMN(3,N,K,L,NY,NX))/EN2F(N) + RGN2F(N,K)=AMIN1(RGN2P,RGOMT,OMGR*OMC(3,N,K,L,NY,NX)) + 2*CZ2GS(L,NY,NX)/(CZ2GS(L,NY,NX)+ZFKM) + RN2FX(N,K)=RGN2F(N,K)*EN2F(N) +C IF((I/30)*30.EQ.I.AND.J.EQ.12)THEN +C WRITE(*,5566)'N2 FIX',I,J,NX,NY,L,K,N,RN2FX(N,K),EN2F(N) +C 2,OMC(3,N,K,L,NY,NX)*CNOMC(3,N,K),OMN(3,N,K,L,NY,NX) +C 3,RINH4(N,K),RINO3(N,K),RGN2P,RGN2F(N,K),FNFX,RGOMT +C 4,CZ2GS(L,NY,NX) +5566 FORMAT(A8,7I4,30E12.4) +C ENDIF + ELSE + RN2FX(N,K)=0.0 + RGN2F(N,K)=0.0 + ENDIF +C +C DOC, DON, DOP AND ACETATE UPTAKE DRIVEN BY GROWTH RESPIRATION +C FROM O2, NOX AND C REDUCTION +C + CGOMX=AMIN1(RMOMT,RGOMO(N,K))+RGN2F(N,K) + 2+(RGOMT-RGN2F(N,K))/ECHZ + CGOMD=RGOMD(N,K)/ENOX + CGOMC(N,K)=CGOMX+CGOMD + IF(K.LE.4)THEN + CGOQC(N,K)=CGOMX*FGOCP+CGOMD + CGOAC(N,K)=CGOMX*FGOAP + CGOXC=CGOQC(N,K)+CGOAC(N,K) + CGOMN(N,K)=AMAX1(0.0,AMIN1(OQN(K,L,NY,NX)*FOMK(N,K) + 2,CGOXC*CNQ(K)/FCN(N,K))) + CGOMP(N,K)=AMAX1(0.0,AMIN1(OQP(K,L,NY,NX)*FOMK(N,K) + 2,CGOXC*CPQ(K)/FCP(N,K))) + ELSE + CGOQC(N,K)=CGOMX+CGOMD + CGOAC(N,K)=0.0 + CGOMN(N,K)=0.0 + CGOMP(N,K)=0.0 + ENDIF + TCGOQC(K)=TCGOQC(K)+CGOQC(N,K) + TCGOAC(K)=TCGOAC(K)+CGOAC(N,K) + TCGOMN(K)=TCGOMN(K)+CGOMN(N,K) + TCGOMP(K)=TCGOMP(K)+CGOMP(N,K) +C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.EQ.3)THEN +C WRITE(*,5557)'CGOQC',I,J,NX,NY,L,K,N,CGOQC(N,K),CGOMX +C 2,FGOCP,FGOAP,CGOMD,RMOMT,RGN2F(N,K),ECHZ +C 3,RGOMD(N,K),ENOX,RGOMO(N,K),WFN(N,K),FOXYX +C WRITE(*,5557)'CGOMP',I,J,NX,NY,L,K,N,CGOMP(N,K),OQP(K,L,NY,NX) +C 2,FOMK(N,K),CGOXC,CPQ(K),FCP(N,K),CGOQC(N,K),CGOAC(N,K) +5557 FORMAT(A8,7I4,30E12.4) +C ENDIF +C +C TRANSFER UPTAKEN C,N,P FROM STORAGE TO ACTIVE BIOMASS +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) + 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))) + RCCC=RCCZ+AMAX1(CCC,C3C)*RCCY + RCCN=CNC*RCCX + RCCP=CPC*RCCQ + ELSE + RCCC=RCCZ + RCCN=0.0 + RCCP=0.0 + ENDIF +C IF((I/120)*120.EQ.I.AND.J.EQ.24.AND.L.LE.6)THEN +C WRITE(*,5555)'RCCC',I,J,NX,NY,L,K,N,RCCC,CCC,C3C +C 2,OMC(3,N,K,L,NY,NX),OMN(3,N,K,L,NY,NX),OMP(3,N,K,L,NY,NX) +C 3,OMC(1,N,K,L,NY,NX),CXC +C ENDIF +C +C MICROBIAL ASSIMILATION OF NONSTRUCTURAL C,N,P +C + CGOMZ=TFNG(N,K)*OMGR*AMAX1(0.0,OMC(3,N,K,L,NY,NX)) + DO 745 M=1,2 + CGOMS(M,N,K)=FL(M)*CGOMZ + IF(OMC(3,N,K,L,NY,NX).GT.ZEROS(NY,NX))THEN + CGONS(M,N,K)=AMIN1(FL(M)*AMAX1(0.0,OMN(3,N,K,L,NY,NX)) + 2,CGOMS(M,N,K)*OMN(3,N,K,L,NY,NX)/OMC(3,N,K,L,NY,NX)) + CGOPS(M,N,K)=AMIN1(FL(M)*AMAX1(0.0,OMP(3,N,K,L,NY,NX)) + 2,CGOMS(M,N,K)*OMP(3,N,K,L,NY,NX)/OMC(3,N,K,L,NY,NX)) + ELSE + CGONS(M,N,K)=0.0 + CGOPS(M,N,K)=0.0 + ENDIF +C +C MICROBIAL DECOMPOSITION FROM BIOMASS, SPECIFIC DECOMPOSITION +C RATE, TEMPERATURE +C + SPOMX=SQRT(TFNG(N,K))*SPOMC(M)*SPOMK(M) + RXOMC(M,N,K)=AMAX1(0.0,OMC(M,N,K,L,NY,NX)*SPOMX) + 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) + 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) +C +C HUMIFICATION OF MICROBIAL DECOMPOSITION PRODUCTS FROM +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 +C WRITE(*,8821)'RHOMC',I,J,L,K,N,M +C 3,CNSHY,CPSHY,FNSHY,FPSHY +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 +C NON-HUMIFIED PRODUCTS TO MICROBIAL RESIDUE +C + RCOMC(M,N,K)=RDOMC(M,N,K)-RHOMC(M,N,K) + RCOMN(M,N,K)=RDOMN(M,N,K)-RHOMN(M,N,K) + RCOMP(M,N,K)=RDOMP(M,N,K)-RHOMP(M,N,K) +745 CONTINUE +C +C MICROBIAL DECOMPOSITION WHEN MAINTENANCE RESPIRATION +C EXCEEDS UPTAKE +C + IF(RXOMT.GT.ZEROS(NY,NX).AND.RMOMT.GT.ZEROS(NY,NX) + 2.AND.RCCC.GT.ZERO)THEN + FRM=RXOMT/RMOMT + DO 730 M=1,2 + RXMMC(M,N,K)=AMIN1(OMC(M,N,K,L,NY,NX) + 2,AMAX1(0.0,FRM*RMOMC(M,N,K)/RCCC)) + RXMMN(M,N,K)=AMIN1(OMN(M,N,K,L,NY,NX) + 2,AMAX1(0.0,RXMMC(M,N,K)*CNOMA(N,K))) + RXMMP(M,N,K)=AMIN1(OMP(M,N,K,L,NY,NX) + 2,AMAX1(0.0,RXMMC(M,N,K)*CPOMA(N,K))) + RDMMC(M,N,K)=RXMMC(M,N,K)*(1.0-RCCC) + RDMMN(M,N,K)=RXMMN(M,N,K)*(1.0-RCCN)*(1.0-RCCC) + RDMMP(M,N,K)=RXMMP(M,N,K)*(1.0-RCCP)*(1.0-RCCC) + R3MMC(M,N,K)=RXMMC(M,N,K)-RDMMC(M,N,K) + R3MMN(M,N,K)=RXMMN(M,N,K)-RDMMN(M,N,K) + R3MMP(M,N,K)=RXMMP(M,N,K)-RDMMP(M,N,K) +C +C HUMIFICATION AND RECYCLING OF RESPIRATION DECOMPOSITION +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) + 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) +C IF(L.EQ.11.AND.K.EQ.1)THEN +C WRITE(*,8821)'RCMMC',I,J,L,K,N,M,RCMMC(M,N,K) +C 2,RDMMC(M,N,K),RHMMC(M,N,K),OMC(M,N,K,L,NY,NX) +C 3,FRM,RMOMC(M,N,K),OMN(1,N,K,L,NY,NX),OMN2(N,K) +C 4,RMOM,TFNR(N,K),FPH,RDMMN(M,N,K),CNSHZ,RDMMP(M,N,K) +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 ENDIF +730 CONTINUE + ELSE + DO 720 M=1,2 + RXMMC(M,N,K)=0.0 + RXMMN(M,N,K)=0.0 + RXMMP(M,N,K)=0.0 + RDMMC(M,N,K)=0.0 + RDMMN(M,N,K)=0.0 + RDMMP(M,N,K)=0.0 + R3MMC(M,N,K)=0.0 + R3MMN(M,N,K)=0.0 + R3MMP(M,N,K)=0.0 + RHMMC(M,N,K)=0.0 + RHMMN(M,N,K)=0.0 + RHMMP(M,N,K)=0.0 + RCMMC(M,N,K)=0.0 + RCMMN(M,N,K)=0.0 + RCMMP(M,N,K)=0.0 +720 CONTINUE + ENDIF + ELSE + RUPOX(N,K)=0.0 + RGOMO(N,K)=0.0 + RCO2X(N,K)=0.0 + RCH3X(N,K)=0.0 + RCH4X(N,K)=0.0 + RGOMY(N,K)=0.0 + RGOMD(N,K)=0.0 + CGOMC(N,K)=0.0 + CGOMN(N,K)=0.0 + CGOMP(N,K)=0.0 + CGOQC(N,K)=0.0 + CGOAC(N,K)=0.0 + RDNO3(N,K)=0.0 + RDNOB(N,K)=0.0 + RDNO2(N,K)=0.0 + RDN2B(N,K)=0.0 + RDN2O(N,K)=0.0 + RN2FX(N,K)=0.0 + RINH4(N,K)=0.0 + RINO3(N,K)=0.0 + RIPO4(N,K)=0.0 + RIP14(N,K)=0.0 + RINB4(N,K)=0.0 + RINB3(N,K)=0.0 + RIPOB(N,K)=0.0 + RIP1B(N,K)=0.0 + IF(L.EQ.0)THEN + RINH4R(N,K)=0.0 + RINO3R(N,K)=0.0 + RIPO4R(N,K)=0.0 + RIP14R(N,K)=0.0 + FNH4XR(N,K)=0.0 + FNO3XR(N,K)=0.0 + FPO4XR(N,K)=0.0 + FP14XR(N,K)=0.0 + ENDIF + DO 725 M=1,2 + CGOMS(M,N,K)=0.0 + CGONS(M,N,K)=0.0 + CGOPS(M,N,K)=0.0 + RMOMC(M,N,K)=0.0 + RXMMC(M,N,K)=0.0 + RXMMN(M,N,K)=0.0 + RXMMP(M,N,K)=0.0 + RDMMC(M,N,K)=0.0 + RDMMN(M,N,K)=0.0 + RDMMP(M,N,K)=0.0 + R3MMC(M,N,K)=0.0 + R3MMN(M,N,K)=0.0 + R3MMP(M,N,K)=0.0 + RHMMC(M,N,K)=0.0 + RHMMN(M,N,K)=0.0 + RHMMP(M,N,K)=0.0 + RCMMC(M,N,K)=0.0 + RCMMN(M,N,K)=0.0 + RCMMP(M,N,K)=0.0 + RXOMC(M,N,K)=0.0 + RXOMN(M,N,K)=0.0 + RXOMP(M,N,K)=0.0 + RDOMC(M,N,K)=0.0 + RDOMN(M,N,K)=0.0 + RDOMP(M,N,K)=0.0 + R3OMC(M,N,K)=0.0 + R3OMN(M,N,K)=0.0 + R3OMP(M,N,K)=0.0 + RHOMC(M,N,K)=0.0 + RHOMN(M,N,K)=0.0 + RHOMP(M,N,K)=0.0 + RCOMC(M,N,K)=0.0 + RCOMN(M,N,K)=0.0 + RCOMP(M,N,K)=0.0 +725 CONTINUE + RH2GX(N,K)=0.0 + IF(K.EQ.5)THEN + RVOXA(N)=0.0 + RVOXB(N)=0.0 + IF(N.EQ.5)THEN + RH2GZ=0.0 + ENDIF + ENDIF + ENDIF + ENDIF +750 CONTINUE + ENDIF +760 CONTINUE +C +C CHEMODENITRIFICATION +C + IF(RNO2Y(L,NY,NX).GT.ZEROS(NY,NX))THEN + FNO2=AMAX1(FMN,RVMXC(L,NY,NX)/RNO2Y(L,NY,NX)) + ELSE + FNO2=FMN*VLNO3(L,NY,NX) + ENDIF + IF(RN2BY(L,NY,NX).GT.ZEROS(NY,NX))THEN + FNB2=AMAX1(FMN,RVMBC(L,NY,NX)/RN2BY(L,NY,NX)) + ELSE + FNB2=FMN*VLNOB(L,NY,NX) + 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)) + 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 +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) +7779 FORMAT(A8,3I4,30E12.4) +C ENDIF +C +C DECOMPOSITION +C + DO 1870 K=0,KL + ROQCK(K)=0.0 + DO 1875 N=1,7 + ROQCK(K)=ROQCK(K)+ROQCD(N,K) +1875 CONTINUE + XOQCK(K)=0.0 + XOQCZ(K)=0.0 + XOQNZ(K)=0.0 + XOQPZ(K)=0.0 + XOQAZ(K)=0.0 + DO 845 N=1,7 + DO 845 M=1,3 + XOMCZ(M,N,K)=0.0 + XOMNZ(M,N,K)=0.0 + XOMPZ(M,N,K)=0.0 +845 CONTINUE +C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.LE.1)THEN +C WRITE(*,4443)'PRIM1',I,J,NX,NY,L,K,ROQCK(K) +C 2,XOQCK(K),OQC(K,L,NY,NX),XOQCZ(K),OQN(K,L,NY,NX),XOQNZ(K) +C 3,OQP(K,L,NY,NX),XOQPZ(K),OQA(K,L,NY,NX),XOQAZ(K) +C ENDIF +1870 CONTINUE +C +C PRIMING BETWEEN LITTER AND NON-LITTER C +C + DO 795 K=0,KL + IF(K.LE.KL-1)THEN + DO 800 KK=K+1,KL + OSRT=OSRH(K)+OSRH(KK) + IF(OSRH(K).GT.ZEROS(NY,NX).AND.OSRH(KK).GT.ZEROS(NY,NX))THEN + XFRK=FPRIM*TFND(L,NY,NX)*(ROQCK(K)*OSRH(KK) + 2-ROQCK(KK)*OSRH(K))/OSRT + XFRC=FPRIM*TFND(L,NY,NX)*(OQC(K,L,NY,NX)*OSRH(KK) + 2-OQC(KK,L,NY,NX)*OSRH(K))/OSRT + XFRN=FPRIM*TFND(L,NY,NX)*(OQN(K,L,NY,NX)*OSRH(KK) + 2-OQN(KK,L,NY,NX)*OSRH(K))/OSRT + XFRP=FPRIM*TFND(L,NY,NX)*(OQP(K,L,NY,NX)*OSRH(KK) + 2-OQP(KK,L,NY,NX)*OSRH(K))/OSRT + XFRA=FPRIM*TFND(L,NY,NX)*(OQA(K,L,NY,NX)*OSRH(KK) + 2-OQA(KK,L,NY,NX)*OSRH(K))/OSRT + IF(ROQCK(K)+XOQCK(K)-XFRK.GT.0.0 + 2.AND.ROQCK(KK)+XOQCK(KK)+XFRK.GT.0.0)THEN + XOQCK(K)=XOQCK(K)-XFRK + XOQCK(KK)=XOQCK(KK)+XFRK +C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.LE.1)THEN +C WRITE(*,4442)'XOQCK',I,J,NX,NY,L,K,KK,XFRC,ROQCK(K) +C 2,OSRH(K),ROQCK(KK),OSRH(KK),XOQCK(K),XOQCK(KK) +4442 FORMAT(A8,7I4,12E12.4) +C ENDIF + ENDIF + IF(OQC(K,L,NY,NX)+XOQCZ(K)-XFRC.GT.0.0 + 2.AND.OQC(KK,L,NY,NX)+XOQCZ(KK)+XFRC.GT.0.0)THEN + XOQCZ(K)=XOQCZ(K)-XFRC + XOQCZ(KK)=XOQCZ(KK)+XFRC +C IF((I/1)*1.EQ.I.AND.L.EQ.3.AND.K.EQ.1)THEN +C WRITE(*,4442)'XOQCZ',I,J,NX,NY,L,K,KK,XFRC,OQC(K,L,NY,NX) +C 2,OSRH(K),OQC(KK,L,NY,NX),OSRH(KK),XOQCZ(K),XOQCZ(KK) +C ENDIF + ENDIF + IF(OQN(K,L,NY,NX)+XOQNZ(K)-XFRN.GT.0.0 + 2.AND.OQN(KK,L,NY,NX)+XOQNZ(KK)+XFRN.GT.0.0)THEN + XOQNZ(K)=XOQNZ(K)-XFRN + XOQNZ(KK)=XOQNZ(KK)+XFRN +C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.EQ.4)THEN +C WRITE(*,4442)'XOQNZ',I,J,NX,NY,L,K,KK,XFRN,OQN(K,L,NY,NX) +C 2,OSRH(K),OQN(KK,L,NY,NX),OSRH(KK),XOQNZ(K),XOQNZ(KK) +C ENDIF + ENDIF + IF(OQP(K,L,NY,NX)+XOQPZ(K)-XFRP.GT.0.0 + 2.AND.OQP(KK,L,NY,NX)+XOQPZ(KK)+XFRP.GT.0.0)THEN + XOQPZ(K)=XOQPZ(K)-XFRP + XOQPZ(KK)=XOQPZ(KK)+XFRP +C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.EQ.4)THEN +C WRITE(*,4442)'XOQPZ',I,J,NX,NY,L,K,KK,XFRP,OQP(K,L,NY,NX) +C 2,OSRH(K),OQP(KK,L,NY,NX),OSRH(KK),XOQPZ(K),XOQPZ(KK) +C ENDIF + ENDIF + IF(OQA(K,L,NY,NX)+XOQAZ(K)-XFRA.GT.0.0 + 2.AND.OQA(KK,L,NY,NX)+XOQAZ(KK)+XFRA.GT.0.0)THEN + XOQAZ(K)=XOQAZ(K)-XFRA + XOQAZ(KK)=XOQAZ(KK)+XFRA +C IF((I/1)*1.EQ.I.AND.L.EQ.3.AND.K.EQ.1)THEN +C WRITE(*,4442)'XOQAZ',I,J,NX,NY,L,K,KK,XFRA,OQA(K,L,NY,NX) +C 2,OSRH(K),OQA(KK,L,NY,NX),OSRH(KK),XOQAZ(K),XOQAZ(KK) +C ENDIF + ENDIF + DO 850 N=1,7 + DO 850 M=1,3 + XFMC=FPRIMM*TFNG(N,K)*(OMC(M,N,K,L,NY,NX)*OSRH(KK) + 2-OMC(M,N,KK,L,NY,NX)*OSRH(K))/OSRT + XFMN=FPRIMM*TFNG(N,K)*(OMN(M,N,K,L,NY,NX)*OSRH(KK) + 2-OMN(M,N,KK,L,NY,NX)*OSRH(K))/OSRT + XFMP=FPRIMM*TFNG(N,K)*(OMP(M,N,K,L,NY,NX)*OSRH(KK) + 2-OMP(M,N,KK,L,NY,NX)*OSRH(K))/OSRT + IF(OMC(M,N,K,L,NY,NX)+XOMCZ(M,N,K)-XFMC.GT.0.0 + 2.AND.OMC(M,N,KK,L,NY,NX)+XOMCZ(M,N,KK)+XFMC.GT.0.0)THEN + XOMCZ(M,N,K)=XOMCZ(M,N,K)-XFMC + XOMCZ(M,N,KK)=XOMCZ(M,N,KK)+XFMC +C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.EQ.4)THEN +C WRITE(*,4447)'XOMCZ',I,J,NX,NY,L,K,KK,N,M,XFMC,OMC(M,N,K,L,NY,NX) +C 2,OQC(K,L,NY,NX),OMC(M,N,KK,L,NY,NX),OQC(KK,L,NY,NX),OQCT +C 3,XOMCZ(M,N,K),XOMCZ(M,N,KK) +4447 FORMAT(A8,9I4,20E12.4) +C ENDIF + ENDIF + IF(OMN(M,N,K,L,NY,NX)+XOMNZ(M,N,K)-XFMN.GT.0.0 + 2.AND.OMN(M,N,KK,L,NY,NX)+XOMNZ(M,N,KK)+XFMN.GT.0.0)THEN + XOMNZ(M,N,K)=XOMNZ(M,N,K)-XFMN + XOMNZ(M,N,KK)=XOMNZ(M,N,KK)+XFMN +C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.EQ.4)THEN +C WRITE(*,4447)'XOMNZ',I,J,NX,NY,L,K,KK,N,M,XFMN,OMN(M,N,K,L,NY,NX) +C 2,OSRH(K),OMN(M,N,KK,L,NY,NX),OSRH(KK),XOMNZ(M,N,K),XOMNZ(M,N,KK) +C ENDIF + ENDIF + IF(OMP(M,N,K,L,NY,NX)+XOMPZ(M,N,K)-XFMP.GT.0.0 + 2.AND.OMP(M,N,KK,L,NY,NX)+XOMPZ(M,N,KK)+XFMP.GT.0.0)THEN + XOMPZ(M,N,K)=XOMPZ(M,N,K)-XFMP + XOMPZ(M,N,KK)=XOMPZ(M,N,KK)+XFMP +C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.EQ.4)THEN +C WRITE(*,4447)'XOMPZ',I,J,NX,NY,L,K,KK,N,M,XFMP,OMP(M,N,K,L,NY,NX) +C 2,OSRH(K),OMP(M,N,KK,L,NY,NX),OSRH(KK),XOMPZ(M,N,K),XOMPZ(M,N,KK) +C ENDIF + ENDIF +850 CONTINUE + ENDIF +800 CONTINUE + ENDIF +795 CONTINUE +C +C DECOMPOSITION OF ORGANIC SUBSTRATES +C + TOQCK(L,NY,NX)=0.0 + DO 1790 K=0,KL + ROQCK(K)=ROQCK(K)+XOQCK(K) + TOQCK(L,NY,NX)=TOQCK(L,NY,NX)+ROQCK(K) + OQC(K,L,NY,NX)=OQC(K,L,NY,NX)+XOQCZ(K) + OQN(K,L,NY,NX)=OQN(K,L,NY,NX)+XOQNZ(K) + OQP(K,L,NY,NX)=OQP(K,L,NY,NX)+XOQPZ(K) + OQA(K,L,NY,NX)=OQA(K,L,NY,NX)+XOQAZ(K) + DO 840 N=1,7 + DO 840 M=1,3 + OMC(M,N,K,L,NY,NX)=OMC(M,N,K,L,NY,NX)+XOMCZ(M,N,K) + OMN(M,N,K,L,NY,NX)=OMN(M,N,K,L,NY,NX)+XOMNZ(M,N,K) + OMP(M,N,K,L,NY,NX)=OMP(M,N,K,L,NY,NX)+XOMPZ(M,N,K) +840 CONTINUE + IF(TOMK(K).GT.ZEROS(NY,NX))THEN + CNOMX=TONK(K)/TONX(K) + CPOMX=TOPK(K)/TOPX(K) + FCNK(K)=AMIN1(1.0,AMAX1(0.50,CNOMX)) + FCPK(K)=AMIN1(1.0,AMAX1(0.50,CPOMX)) + ELSE + FCNK(K)=1.0 + FCPK(K)=1.0 + ENDIF +C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.EQ.4)THEN +C WRITE(*,4443)'PRIM2',I,J,NX,NY,L,K,ROQCK(K) +C 2,XOQCK(K),OQC(K,L,NY,NX),XOQCZ(K),OQN(K,L,NY,NX),XOQNZ(K) +C 3,OQP(K,L,NY,NX),XOQPZ(K),OQA(K,L,NY,NX),XOQAZ(K),TOMK(K) +C 3,TONK(K),TOPK(K),TONX(K),TOPX(K),CNOMX,CPOMX,FCNK(K),FCPK(K) +C 4,TOQCK(L,NY,NX) +4443 FORMAT(A8,6I4,20E12.4) +C ENDIF +C +C AQUEOUS CONCENTRATION OF BIOMASS TO CACULATE INHIBITION +C CONSTANT FOR DECOMPOSITION +C + IF(VOLWZ.GT.ZEROS(NY,NX))THEN + COQCK=AMIN1(0.1E+06,ROQCK(K)/VOLWZ) + ELSE + COQCK=0.1E+06 + ENDIF + IF(L.EQ.0)THEN + DCKD=DCKM0*(1.0+COQCK/DCKI) + ELSE + DCKD=DCKML*(1.0+COQCK/DCKI) + ENDIF + IF(OSRH(K).GT.ZEROS(NY,NX))THEN + IF(BKVL(L,NY,NX).GT.ZEROS(NY,NX))THEN + COSC=OSRH(K)/BKVL(L,NY,NX) + ELSE + COSC=OSRH(K)/VOLX(L,NY,NX) + ENDIF + DFNS=COSC/(COSC+DCKD) + OQCI=1.0/(1.0+COQC(K,L,NY,NX)/OQKI) +C IF(L.EQ.0)THEN +C WRITE(*,4242)'COSC',I,J,L,K,DFNS,COSC,COQCK,DCKD,OSRH(K) +C 2,OSAT(K),OSCT(K),ORCT(K),OHC(K,L,NY,NX),BKVL(L,NY,NX),ROQCK(K) +C 3,VOLWZ,VOLWRX(NY,NX),VOLW(0,NY,NX),FCR(NY,NX) +C 4,THETY(L,NY,NX) +4242 FORMAT(A8,4I4,30E12.4) +C ENDIF +C +C C, N, P DECOMPOSITION RATE OF SOLID SUBSTRATES 'RDOS*' FROM +C RATE CONSTANT, TOTAL ACTIVE BIOMASS, DENSITY FACTOR, +C TEMPERATURE, SUBSTRATE C:N, C:P +C + DO 785 M=1,4 + IF(OSC(M,K,L,NY,NX).GT.ZEROS(NY,NX))THEN + CNS(M,K)=AMAX1(0.0,OSN(M,K,L,NY,NX)/OSC(M,K,L,NY,NX)) + CPS(M,K)=AMAX1(0.0,OSP(M,K,L,NY,NX)/OSC(M,K,L,NY,NX)) + RDOSC(M,K)=AMAX1(0.0,AMIN1(0.5*OSA(M,K,L,NY,NX) + 2,SPOSC(M,K)*ROQCK(K)*DFNS*OQCI*TFNX*OSA(M,K,L,NY,NX)/OSRH(K))) +C 3*AMIN1(FCNK(K),FCPK(K)) + RDOSN(M,K)=AMAX1(0.0,AMIN1(OSN(M,K,L,NY,NX) + 2,CNS(M,K)*RDOSC(M,K)))/FCNK(K) + RDOSP(M,K)=AMAX1(0.0,AMIN1(OSP(M,K,L,NY,NX) + 2,CPS(M,K)*RDOSC(M,K)))/FCPK(K) +C IF((I/120)*120.EQ.I.AND.J.EQ.24.AND.L.LE.6)THEN +C WRITE(*,4444)'RDOSC',I,J,NX,NY,L,K,M,RDOSC(M,K),RDOSN(M,K) +C 2,RDOSP(M,K),CNS(M,K),CPS(M,K),SPOSC(M,K),ROQCK(K),DFNS,TFNX +C 3,OQCI,OSA(M,K,L,NY,NX),OSRH(K),COSC,COQCK,DCKD,VOLWZ +C 4,TFNX,WFNG,TKS(L,NY,NX),PSISM(L,NY,NX),THETW(L,NY,NX) +C 4,FOSRH(K,L,NY,NX),VOLX(L,NY,NX),ORGC(L,NY,NX),OSC(M,K,L,NY,NX) +C 2,OSN(M,K,L,NY,NX),OSP(M,K,L,NY,NX),TONK(K),TONX(K),FCNK(K) +C 6,FCPK(K),WFN(1,K),WFN(3,K),WFN(4,K),COQC(K,L,NY,NX) +C 7,THETY(L,NY,NX) +4444 FORMAT(A8,7I4,40E12.4) +C ENDIF + ELSE + CNS(M,K)=CNOSC(M,K,L,NY,NX) + CPS(M,K)=CPOSC(M,K,L,NY,NX) + RDOSC(M,K)=0.0 + RDOSN(M,K)=0.0 + RDOSP(M,K)=0.0 + ENDIF +785 CONTINUE +C +C HUMIFICATION OF DECOMPOSED RESIDUE LIGNIN WITH PROTEIN, +C CH2O AND CELLULOSE 'RHOS*' WITH REMAINDER 'RCOS*' TO DOC,N,P +C + IF(K.LE.2)THEN + RHOSC(4,K)=AMAX1(0.0,AMIN1(RDOSN(4,K)/CNRH(3) + 2,RDOSP(4,K)/CPRH(3),EPOC(L,NY,NX)*RDOSC(4,K))) + RHOSCM=0.10*RHOSC(4,K) + RHOSC(1,K)=AMAX1(0.0,AMIN1(RDOSC(1,K),RDOSN(1,K)/CNRH(3) + 2,RDOSP(1,K)/CPRH(3),RHOSCM)) + RHOSC(2,K)=AMAX1(0.0,AMIN1(RDOSC(2,K),RDOSN(2,K)/CNRH(3) + 2,RDOSP(2,K)/CPRH(3),RHOSCM)) + RHOSC(3,K)=AMAX1(0.0,AMIN1(RDOSC(3,K),RDOSN(3,K)/CNRH(3) + 2,RDOSP(3,K)/CPRH(3),RHOSCM-RHOSC(2,K))) + DO 805 M=1,4 + RHOSN(M,K)=AMIN1(RDOSN(M,K),RHOSC(M,K)*CNRH(3)) + RHOSP(M,K)=AMIN1(RDOSP(M,K),RHOSC(M,K)*CPRH(3)) + RCOSC(M,K)=RDOSC(M,K)-RHOSC(M,K) + RCOSN(M,K)=RDOSN(M,K)-RHOSN(M,K) + RCOSP(M,K)=RDOSP(M,K)-RHOSP(M,K) +805 CONTINUE + ELSE + DO 810 M=1,4 + RHOSC(M,K)=0.0 + RHOSN(M,K)=0.0 + RHOSP(M,K)=0.0 + RCOSC(M,K)=RDOSC(M,K) + RCOSN(M,K)=RDOSN(M,K) + RCOSP(M,K)=RDOSP(M,K) +810 CONTINUE + ENDIF + ELSE + DO 780 M=1,4 + RDOSC(M,K)=0.0 + RDOSN(M,K)=0.0 + RDOSP(M,K)=0.0 + RHOSC(M,K)=0.0 + RHOSN(M,K)=0.0 + RHOSP(M,K)=0.0 + RCOSC(M,K)=0.0 + RCOSN(M,K)=0.0 + RCOSP(M,K)=0.0 +780 CONTINUE + ENDIF +C +C C, N, P DECOMPOSITION RATE OF BIORESIDUE 'RDOR*' FROM +C RATE CONSTANT, TOTAL ACTIVE BIOMASS, DENSITY FACTOR, +C TEMPERATURE, SUBSTRATE C:N, C:P +C + IF(OSRH(K).GT.ZEROS(NY,NX))THEN + DO 775 M=1,2 + IF(ORC(M,K,L,NY,NX).GT.ZEROS(NY,NX))THEN + CNR=AMAX1(0.0,ORN(M,K,L,NY,NX)/ORC(M,K,L,NY,NX)) + CPR=AMAX1(0.0,ORP(M,K,L,NY,NX)/ORC(M,K,L,NY,NX)) + RDORC(M,K)=AMAX1(0.0,AMIN1(ORC(M,K,L,NY,NX) + 2,SPORC(M)*ROQCK(K)*DFNS*OQCI*TFNX*ORC(M,K,L,NY,NX)/OSRH(K))) +C 3*AMIN1(FCNK(K),FCPK(K)) + RDORN(M,K)=AMAX1(0.0,AMIN1(ORN(M,K,L,NY,NX),CNR*RDORC(M,K))) + 2/FCNK(K) + RDORP(M,K)=AMAX1(0.0,AMIN1(ORP(M,K,L,NY,NX),CPR*RDORC(M,K))) + 2/FCPK(K) + ELSE + RDORC(M,K)=0.0 + RDORN(M,K)=0.0 + RDORP(M,K)=0.0 + ENDIF +775 CONTINUE + ELSE + DO 776 M=1,2 + RDORC(M,K)=0.0 + RDORN(M,K)=0.0 + RDORP(M,K)=0.0 +776 CONTINUE + ENDIF +C +C C, N, P DECOMPOSITION RATE OF SORBED SUBSTRATES 'RDOH*' FROM +C RATE CONSTANT, TOTAL ACTIVE BIOMASS, DENSITY FACTOR, +C TEMPERATURE, SUBSTRATE C:N, C:P +C + IF(OSRH(K).GT.ZEROS(NY,NX))THEN + IF(OHC(K,L,NY,NX).GT.ZEROS(NY,NX))THEN + CNH(K)=AMAX1(0.0,OHN(K,L,NY,NX)/OHC(K,L,NY,NX)) + CPH(K)=AMAX1(0.0,OHP(K,L,NY,NX)/OHC(K,L,NY,NX)) + RDOHC(K)=AMAX1(0.0,AMIN1(OHC(K,L,NY,NX) + 2,SPOHC*ROQCK(K)*DFNS*OQCI*TFNX*OHC(K,L,NY,NX)/OSRH(K))) +C 3*AMIN1(FCNK(K),FCPK(K)) + RDOHN(K)=AMAX1(0.0,AMIN1(OHN(K,L,NY,NX),CNH(K)*RDOHC(K))) + 2/FCNK(K) + RDOHP(K)=AMAX1(0.0,AMIN1(OHP(K,L,NY,NX),CPH(K)*RDOHC(K))) + 2/FCPK(K) + RDOHA(K)=AMAX1(0.0,AMIN1(OHA(K,L,NY,NX) + 2,SPOHA*ROQCK(K)*DFNS*TFNX*OHA(K,L,NY,NX)/OSRH(K))) +C 3*AMIN1(FCNK(K),FCPK(K)) + ELSE + CNH(K)=0.0 + CPH(K)=0.0 + RDOHC(K)=0.0 + RDOHN(K)=0.0 + RDOHP(K)=0.0 + RDOHA(K)=0.0 + ENDIF + ELSE + CNH(K)=0.0 + CPH(K)=0.0 + RDOHC(K)=0.0 + RDOHN(K)=0.0 + RDOHP(K)=0.0 + RDOHA(K)=0.0 + ENDIF +C +C DOC ADSORPTION - DESORPTION +C + IF(VOLWM(NPH,L,NY,NX).GT.ZEROS(NY,NX) + 2.AND.FOSRH(K,L,NY,NX).GT.ZERO)THEN + IF(L.EQ.0)THEN + AECX=50.0 + ELSE + AECX=AEC(L,NY,NX) + ENDIF + OQCX=AMAX1(ZEROS(NY,NX),OQC(K,L,NY,NX)-TCGOQC(K)) + OQNX=AMAX1(ZEROS(NY,NX),OQN(K,L,NY,NX)-TCGOAC(K)) + OQPX=AMAX1(ZEROS(NY,NX),OQP(K,L,NY,NX)-TCGOMN(K)) + OQAX=AMAX1(ZEROS(NY,NX),OQA(K,L,NY,NX)-TCGOMP(K)) + OHCX=AMAX1(ZEROS(NY,NX),OHC(K,L,NY,NX)) + OHNX=AMAX1(ZEROS(NY,NX),OHN(K,L,NY,NX)) + OHPX=AMAX1(ZEROS(NY,NX),OHP(K,L,NY,NX)) + OHAX=AMAX1(ZEROS(NY,NX),OHA(K,L,NY,NX)) + VOLXX=BKVL(L,NY,NX)*AECX*HSORP*FOSRH(K,L,NY,NX) + VOLXW=VOLWM(NPH,L,NY,NX)*FOSRH(K,L,NY,NX) + IF(FOCA(K).GT.ZERO)THEN + VOLCX=FOCA(K)*VOLXX + VOLCW=FOCA(K)*VOLXW + CSORP(K)=TSORP*(OQCX*VOLCX-OHCX*VOLCW)/(VOLCX+VOLCW) + ELSE + CSORP(K)=TSORP*(OQCX*VOLXX-OHCX*VOLXW)/(VOLXX+VOLXW) + ENDIF + IF(FOAA(K).GT.ZERO)THEN + VOLAX=FOAA(K)*VOLXX + VOLAW=FOAA(K)*VOLXW + CSORPA(K)=TSORP*(OQAX*VOLAX-OHAX*VOLAW)/(VOLAX+VOLAW) + ELSE + CSORPA(K)=TSORP*(OQAX*VOLXX-OHAX*VOLXW)/(VOLXX+VOLXW) + ENDIF + ZSORP(K)=TSORP*(OQNX*VOLXX-OHNX*VOLXW)/(VOLXX+VOLXW) + PSORP(K)=TSORP*(OQPX*VOLXX-OHPX*VOLXW)/(VOLXX+VOLXW) + ELSE + CSORP(K)=0.0 + CSORPA(K)=0.0 + ZSORP(K)=0.0 + PSORP(K)=0.0 + ENDIF +C IF(L.EQ.4.AND.K.EQ.1)THEN +C WRITE(*,591)'CSORP',I,J,NX,NY,L,K,CSORP(K),CSORPA(K) +C 1,OQC(K,L,NY,NX),OHC(K,L,NY,NX),OQA(K,L,NY,NX),OHA(K,L,NY,NX) +C 2,OQC(K,L,NY,NX)/VOLWM(NPH,L,NY,NX),OHC(K,L,NY,NX)/BKVL(L,NY,NX) +C 2,OQA(K,L,NY,NX)/VOLWM(NPH,L,NY,NX),OHA(K,L,NY,NX)/BKVL(L,NY,NX) +C 4,BKVL(L,NY,NX),VOLWM(NPH,L,NY,NX),FOCA(K),FOAA(K) +C 5,FOSRH(K,L,NY,NX),TCGOQC(K),OQCX +591 FORMAT(A8,6I4,40E12.4) +C ENDIF +1790 CONTINUE +C +C REDISTRIBUTE AUTOTROPHIC DECOMPOSITION PRODUCTS AMONG +C HETEROTROPHIC SUBSTRATE-MICROBE COMPLEXES +C + DO 1690 K=0,KL + IF(TORC.GT.ZEROS(NY,NX))THEN + FORC(K)=ORCT(K)/TORC + ELSE + IF(K.EQ.3)THEN + FORC(K)=1.0 + ELSE + FORC(K)=0.0 + ENDIF + ENDIF + DO 1685 N=1,7 + DO 1680 M=1,2 + RCCMC(M,N,K)=(RCOMC(M,N,5)+RCMMC(M,N,5))*FORC(K) + RCCMN(M,N,K)=(RCOMN(M,N,5)+RCMMN(M,N,5))*FORC(K) + RCCMP(M,N,K)=(RCOMP(M,N,5)+RCMMP(M,N,5))*FORC(K) +C IF(L.EQ.0)THEN +C WRITE(*,8821)'RCCMC',I,J,L,K,N,M,RCCMC(M,N,K) +C 2,RCOMC(M,N,5),RCMMC(M,N,5),FORC(K) +C ENDIF +1680 CONTINUE +1685 CONTINUE +1690 CONTINUE +C +C REDISTRIBUTE C,N AND P TRANSFORMATIONS AMONG STATE +C VARIABLES IN SUBSTRATE-MICROBE COMPLEXES +C + DO 590 K=0,KL + DO 580 M=1,4 +C +C SUBSTRATE DECOMPOSITION PRODUCTS +C + OSC(M,K,L,NY,NX)=OSC(M,K,L,NY,NX)-RDOSC(M,K) + OSA(M,K,L,NY,NX)=OSA(M,K,L,NY,NX)-RDOSC(M,K) + OSN(M,K,L,NY,NX)=OSN(M,K,L,NY,NX)-RDOSN(M,K) + OSP(M,K,L,NY,NX)=OSP(M,K,L,NY,NX)-RDOSP(M,K) + OQC(K,L,NY,NX)=OQC(K,L,NY,NX)+RCOSC(M,K) + OQN(K,L,NY,NX)=OQN(K,L,NY,NX)+RCOSN(M,K) + OQP(K,L,NY,NX)=OQP(K,L,NY,NX)+RCOSP(M,K) +C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.K.EQ.4)THEN +C WRITE(*,4444)'RDOSC',I,J,NX,NY,L,K,M,OSC(M,K,L,NY,NX) +C 2,RDOSC(M,K) +C ENDIF +C +C LIGNIFICATION PRODUCTS +C + IF(L.NE.0)THEN + OSC(1,3,L,NY,NX)=OSC(1,3,L,NY,NX)+RHOSC(M,K) + OSA(1,3,L,NY,NX)=OSA(1,3,L,NY,NX)+RHOSC(M,K) + OSN(1,3,L,NY,NX)=OSN(1,3,L,NY,NX)+RHOSN(M,K) + OSP(1,3,L,NY,NX)=OSP(1,3,L,NY,NX)+RHOSP(M,K) + ELSE + OSC(1,3,NU(NY,NX),NY,NX)=OSC(1,3,NU(NY,NX),NY,NX)+RHOSC(M,K) + OSA(1,3,NU(NY,NX),NY,NX)=OSA(1,3,NU(NY,NX),NY,NX)+RHOSC(M,K) + OSN(1,3,NU(NY,NX),NY,NX)=OSN(1,3,NU(NY,NX),NY,NX)+RHOSN(M,K) + OSP(1,3,NU(NY,NX),NY,NX)=OSP(1,3,NU(NY,NX),NY,NX)+RHOSP(M,K) + ENDIF +580 CONTINUE +C +C MICROBIAL RESIDUE DECOMPOSITION PRODUCTS +C + DO 575 M=1,2 + ORC(M,K,L,NY,NX)=ORC(M,K,L,NY,NX)-RDORC(M,K) + ORN(M,K,L,NY,NX)=ORN(M,K,L,NY,NX)-RDORN(M,K) + ORP(M,K,L,NY,NX)=ORP(M,K,L,NY,NX)-RDORP(M,K) + OQC(K,L,NY,NX)=OQC(K,L,NY,NX)+RDORC(M,K) + OQN(K,L,NY,NX)=OQN(K,L,NY,NX)+RDORN(M,K) + OQP(K,L,NY,NX)=OQP(K,L,NY,NX)+RDORP(M,K) +575 CONTINUE + OQC(K,L,NY,NX)=OQC(K,L,NY,NX)+RDOHC(K) + OQN(K,L,NY,NX)=OQN(K,L,NY,NX)+RDOHN(K)+RCOQN*FORC(K) + OQP(K,L,NY,NX)=OQP(K,L,NY,NX)+RDOHP(K) + OQA(K,L,NY,NX)=OQA(K,L,NY,NX)+RDOHA(K) + OHC(K,L,NY,NX)=OHC(K,L,NY,NX)-RDOHC(K) + OHN(K,L,NY,NX)=OHN(K,L,NY,NX)-RDOHN(K) + OHP(K,L,NY,NX)=OHP(K,L,NY,NX)-RDOHP(K) + OHA(K,L,NY,NX)=OHA(K,L,NY,NX)-RDOHA(K) +C +C MICROBIAL UPTAKE OF DISSOLVED C, N, P +C + DO 570 N=1,7 + OQC(K,L,NY,NX)=OQC(K,L,NY,NX)-CGOQC(N,K) + OQN(K,L,NY,NX)=OQN(K,L,NY,NX)-CGOMN(N,K) + OQP(K,L,NY,NX)=OQP(K,L,NY,NX)-CGOMP(N,K) + OQA(K,L,NY,NX)=OQA(K,L,NY,NX)-CGOAC(N,K)+RCH3X(N,K) +C +C MICROBIAL DECOMPOSITION PRODUCTS +C + DO 565 M=1,2 + ORC(M,K,L,NY,NX)=ORC(M,K,L,NY,NX)+RCOMC(M,N,K)+RCCMC(M,N,K) + 2+RCMMC(M,N,K) + ORN(M,K,L,NY,NX)=ORN(M,K,L,NY,NX)+RCOMN(M,N,K)+RCCMN(M,N,K) + 2+RCMMN(M,N,K) + ORP(M,K,L,NY,NX)=ORP(M,K,L,NY,NX)+RCOMP(M,N,K)+RCCMP(M,N,K) + 2+RCMMP(M,N,K) +C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.EQ.4.AND.K.EQ.2)THEN +C WRITE(*,8821)'ORC',I,J,L,K,N,M,ORC(M,K,L,NY,NX) +C 2,RCOMC(M,N,K),RCCMC(M,N,K),RCMMC(M,N,K),RDORC(M,K) +C WRITE(*,8821)'ORP',I,J,L,K,N,M,ORP(M,K,L,NY,NX) +C 2,RCOMP(M,N,K),RCCMP(M,N,K),RCMMP(M,N,K),RDORP(M,K) +8821 FORMAT(A8,6I4,30E12.4) +C ENDIF +565 CONTINUE +570 CONTINUE +C +C SORPTION PRODUCTS +C + OQC(K,L,NY,NX)=OQC(K,L,NY,NX)-CSORP(K) + OQN(K,L,NY,NX)=OQN(K,L,NY,NX)-ZSORP(K) + OQP(K,L,NY,NX)=OQP(K,L,NY,NX)-PSORP(K) + OQA(K,L,NY,NX)=OQA(K,L,NY,NX)-CSORPA(K) + OHC(K,L,NY,NX)=OHC(K,L,NY,NX)+CSORP(K) + OHN(K,L,NY,NX)=OHN(K,L,NY,NX)+ZSORP(K) + OHP(K,L,NY,NX)=OHP(K,L,NY,NX)+PSORP(K) + OHA(K,L,NY,NX)=OHA(K,L,NY,NX)+CSORPA(K) +C IF((I/1)*1.EQ.I.AND.L.EQ.3.AND.K.EQ.1)THEN +C WRITE(*,592)'OQC',I,J,NX,NY,L,K,OQC(K,L,NY,NX) +C 2,(RCOSC(M,K),M=1,4),(RDORC(M,K),M=1,2),RDOHC(K) +C 2,(CGOQC(N,K),N=1,7),CSORP(K),OHC(K,L,NY,NX),OQCI +C 4,(WFN(N,K),N=1,7),OQA(K,L,NY,NX),RDOHA(K),(RCH3X(N,K),N=1,7) +C 3,(CGOAC(N,K),N=1,7),CSORPA(K),OHA(K,L,NY,NX) +C WRITE(*,592)'OQN',I,J,NX,NY,L,K,OQN(K,L,NY,NX) +C 2,(RCOSN(M,K),M=1,4),(RDORN(M,K),M=1,2),RDOHN(K) +C 2,RCOQN*FORC(K),(CGOMN(N,K),N=1,7),ZSORP(K),OHN(K,L,NY,NX) +592 FORMAT(A8,6I4,80E12.4) +C ENDIF +590 CONTINUE +C +C MICROBIAL GROWTH FROM RESPIRATION, MINERALIZATION +C + DO 550 K=0,5 + TGROMC(K)=0.0 + IF(L.NE.0.OR.(K.NE.3.AND.K.NE.4))THEN + DO 545 N=1,7 + IF(K.NE.5.OR.(N.LE.3.OR.N.EQ.5))THEN + DO 540 M=1,2 + OMC(M,N,K,L,NY,NX)=OMC(M,N,K,L,NY,NX)+CGOMS(M,N,K) + 2-RXOMC(M,N,K)-RXMMC(M,N,K) + OMN(M,N,K,L,NY,NX)=OMN(M,N,K,L,NY,NX)+CGONS(M,N,K) + 2-RXOMN(M,N,K)-RXMMN(M,N,K) + OMP(M,N,K,L,NY,NX)=OMP(M,N,K,L,NY,NX)+CGOPS(M,N,K) + 2-RXOMP(M,N,K)-RXMMP(M,N,K) +C IF((I/30)*30.EQ.I.AND.J.EQ.15.AND.L.LE.6 +C 2.AND.K.EQ.5.AND.N.EQ.2)THEN +C WRITE(*,4488)'RDOMC',I,J,NX,NY,L,K,N,M,CGOMS(M,N,K),CGOQC(N,K) +C 4,CGOAC(N,K),RGOMO(N,K),RGOMD(N,K),RXOMC(M,N,K),RXMMC(M,N,K) +C 3,RMOMC(M,N,K),TFNX,OMGR,OMC(3,N,K,L,NY,NX),WFN(N,K) +C 3,OMC(M,N,K,L,NY,NX),OMA(N,K),TSRH +C 4,RCH3X(N,K),RH2GZ,RH2GX(4,K),FOCA(K),FOAA(K) +C 6,OQA(K,L,NY,NX),OHA(K,L,NY,NX),OQC(K,L,NY,NX),OHC(K,L,NY,NX) +C 7,OMP(M,N,K,L,NY,NX),CGOPS(M,N,K),RDOMP(M,N,K),RDMMP(M,N,K) +C 8,OMP(3,N,K,L,NY,NX),CGOMP(N,K),RIPO4(N,K) +4488 FORMAT(A8,8I4,40E12.4) +C ENDIF +C +C HUMIFICATION PRODUCTS +C + IF(L.NE.0)THEN + OSC(1,4,L,NY,NX)=OSC(1,4,L,NY,NX)+CFOMC(1,L,NY,NX) + 2*(RHOMC(M,N,K)+RHMMC(M,N,K)) + OSA(1,4,L,NY,NX)=OSA(1,4,L,NY,NX)+CFOMC(1,L,NY,NX) + 2*(RHOMC(M,N,K)+RHMMC(M,N,K)) + OSN(1,4,L,NY,NX)=OSN(1,4,L,NY,NX)+CFOMC(1,L,NY,NX) + 2*(RHOMN(M,N,K)+RHMMN(M,N,K)) + OSP(1,4,L,NY,NX)=OSP(1,4,L,NY,NX)+CFOMC(1,L,NY,NX) + 2*(RHOMP(M,N,K)+RHMMP(M,N,K)) + OSC(2,4,L,NY,NX)=OSC(2,4,L,NY,NX)+CFOMC(2,L,NY,NX) + 2*(RHOMC(M,N,K)+RHMMC(M,N,K)) + OSA(2,4,L,NY,NX)=OSA(2,4,L,NY,NX)+CFOMC(2,L,NY,NX) + 2*(RHOMC(M,N,K)+RHMMC(M,N,K)) + OSN(2,4,L,NY,NX)=OSN(2,4,L,NY,NX)+CFOMC(2,L,NY,NX) + 2*(RHOMN(M,N,K)+RHMMN(M,N,K)) + OSP(2,4,L,NY,NX)=OSP(2,4,L,NY,NX)+CFOMC(2,L,NY,NX) + 2*(RHOMP(M,N,K)+RHMMP(M,N,K)) +C IF((I/10)*10.EQ.I.AND.J.EQ.24)THEN +C WRITE(*,4445)'RHOMC',I,J,NX,NY,L,K,M,N,OSC(1,4,L,NY,NX) +C 2,OSC(2,4,L,NY,NX),CFOMC(1,L,NY,NX),CFOMC(2,L,NY,NX) +C 3,RHOMC(M,N,K),RHMMC(M,N,K) +4445 FORMAT(A8,8I4,40E12.4) +C ENDIF + ELSE + OSC(1,4,NU(NY,NX),NY,NX)=OSC(1,4,NU(NY,NX),NY,NX) + 2+CFOMC(1,NU(NY,NX),NY,NX)*(RHOMC(M,N,K)+RHMMC(M,N,K)) + OSA(1,4,NU(NY,NX),NY,NX)=OSA(1,4,NU(NY,NX),NY,NX) + 2+CFOMC(1,NU(NY,NX),NY,NX)*(RHOMC(M,N,K)+RHMMC(M,N,K)) + OSN(1,4,NU(NY,NX),NY,NX)=OSN(1,4,NU(NY,NX),NY,NX) + 2+CFOMC(1,NU(NY,NX),NY,NX)*(RHOMN(M,N,K)+RHMMN(M,N,K)) + OSP(1,4,NU(NY,NX),NY,NX)=OSP(1,4,NU(NY,NX),NY,NX) + 2+CFOMC(1,NU(NY,NX),NY,NX)*(RHOMP(M,N,K)+RHMMP(M,N,K)) + OSC(2,4,NU(NY,NX),NY,NX)=OSC(2,4,NU(NY,NX),NY,NX) + 2+CFOMC(2,NU(NY,NX),NY,NX)*(RHOMC(M,N,K)+RHMMC(M,N,K)) + OSA(2,4,NU(NY,NX),NY,NX)=OSA(2,4,NU(NY,NX),NY,NX) + 2+CFOMC(2,NU(NY,NX),NY,NX)*(RHOMC(M,N,K)+RHMMC(M,N,K)) + OSN(2,4,NU(NY,NX),NY,NX)=OSN(2,4,NU(NY,NX),NY,NX) + 2+CFOMC(2,NU(NY,NX),NY,NX)*(RHOMN(M,N,K)+RHMMN(M,N,K)) + OSP(2,4,NU(NY,NX),NY,NX)=OSP(2,4,NU(NY,NX),NY,NX) + 2+CFOMC(2,NU(NY,NX),NY,NX)*(RHOMP(M,N,K)+RHMMP(M,N,K)) + ENDIF +540 CONTINUE +C +C INPUTS TO NONSTRUCTURAL POOLS +C + CGROMC=CGOMC(N,K)-RGOMO(N,K)-RGOMD(N,K)-RGN2F(N,K) + TGROMC(K)=TGROMC(K)+CGROMC + RCO2X(N,K)=RCO2X(N,K)+RGN2F(N,K) + DO 555 M=1,2 + OMC(3,N,K,L,NY,NX)=OMC(3,N,K,L,NY,NX)-CGOMS(M,N,K) + 2+R3OMC(M,N,K) + OMN(3,N,K,L,NY,NX)=OMN(3,N,K,L,NY,NX)-CGONS(M,N,K) + 2+R3OMN(M,N,K)+R3MMN(M,N,K) + OMP(3,N,K,L,NY,NX)=OMP(3,N,K,L,NY,NX)-CGOPS(M,N,K) + 2+R3OMP(M,N,K)+R3MMP(M,N,K) + RCO2X(N,K)=RCO2X(N,K)+R3MMC(M,N,K) +555 CONTINUE + OMC(3,N,K,L,NY,NX)=OMC(3,N,K,L,NY,NX)+CGROMC + OMN(3,N,K,L,NY,NX)=OMN(3,N,K,L,NY,NX)+CGOMN(N,K) + 2+RINH4(N,K)+RINB4(N,K)+RINO3(N,K)+RINB3(N,K)+RN2FX(N,K) + OMP(3,N,K,L,NY,NX)=OMP(3,N,K,L,NY,NX)+CGOMP(N,K) + 2+RIPO4(N,K)+RIPOB(N,K)+RIP14(N,K)+RIP1B(N,K) + IF(L.EQ.0)THEN + OMN(3,N,K,L,NY,NX)=OMN(3,N,K,L,NY,NX)+RINH4R(N,K)+RINO3R(N,K) + OMP(3,N,K,L,NY,NX)=OMP(3,N,K,L,NY,NX)+RIPO4R(N,K)+RIP14R(N,K) + ENDIF +C IF(NY.EQ.5.AND.L.EQ.10.AND.K.EQ.3.AND.N.EQ.2)THEN +C WRITE(*,5556)'OMC3',I,J,NX,NY,L,K,N,OMC(3,N,K,L,NY,NX) +C 2,CGOMS(1,N,K),CGOMS(2,N,K),CGROMC,OMP(3,N,K,L,NY,NX) +C 3,CGOPS(1,N,K),CGOPS(2,N,K),CGOMP(N,K),RIPO4(N,K) +C 4,CGOMC(N,K),RGOMO(N,K),RGOMD(N,K),RMOMT,WFN(N,K) +5556 FORMAT(A8,7I4,20E12.4) +C ENDIF + ENDIF +545 CONTINUE + ENDIF +550 CONTINUE + DO 475 K=0,KL + OSCT(K)=0.0 + OSAT(K)=0.0 + DO 475 M=1,4 + OSCT(K)=OSCT(K)+OSC(M,K,L,NY,NX) + OSAT(K)=OSAT(K)+OSA(M,K,L,NY,NX) +475 CONTINUE + DO 480 K=0,KL + OSCX=OSCT(K)-OSAT(K) + IF(OSCX.GT.ZEROS(NY,NX))THEN + IF(OSAT(K).GT.ZEROS(NY,NX))THEN + COSC=OSCX/OSAT(K) + DFNA=COSC/(COSC+DCKX(K)) + ELSE + DFNA=1.0 + ENDIF + DO 485 M=1,4 + OSA(M,K,L,NY,NX)=AMIN1(OSC(M,K,L,NY,NX) + 2,OSA(M,K,L,NY,NX)+DOSA(K)*(AMAX1(DOSM(K),AMIN1(DOSX(K) + 3,TGROMC(K)/AREA(3,L,NY,NX))))*AREA(3,L,NY,NX) + 3*(OSC(M,K,L,NY,NX)-OSA(M,K,L,NY,NX))/OSCX*DFNA) +C IF(INT(I/30)*30.EQ.I.AND.J.EQ.19.AND.K.LE.1)THEN +C WRITE(*,8822)'OSA',I,J,L,K,M,OSA(M,K,L,NY,NX),OSC(M,K,L,NY,NX) +C 3,OSAT(K),OSCT(K),(OSC(M,K,L,NY,NX)-OSA(M,K,L,NY,NX)) +C 3/OSCX,DOSA(K),ROQCK(K),TFNX,TFNX,WFNG,COSC,DFNA +C 4,(TGROMC(K)/AREA(3,L,NY,NX)) +C 5,(AMAX1(DOSM(K),AMIN1(DOSX(K) +C 3,TGROMC(K)/AREA(3,L,NY,NX)))),TGROMC(K) +C ENDIF +8822 FORMAT(A8,5I4,20E12.4) +485 CONTINUE + ELSE + DO 490 M=1,4 + OSA(M,K,L,NY,NX)=AMIN1(OSC(M,K,L,NY,NX),OSA(M,K,L,NY,NX)) +490 CONTINUE + ENDIF +C IF(L.EQ.0)THEN +C WRITE(*,8823)'OSC',I,J,L,K,((OMC(M,N,K,L,NY,NX),N=1,7),M=1,3) +C 2,(ORC(M,K,L,NY,NX),M=1,2),OQC(K,L,NY,NX),OQCH(K,L,NY,NX) +C 3,OHC(K,L,NY,NX),OQA(K,L,NY,NX),OQAH(K,L,NY,NX),OHA(K,L,NY,NX) +C 4,(OSC(M,K,L,NY,NX),M=1,4) +8823 FORMAT(A8,4I4,100E24.16) +C ENDIF +480 CONTINUE +C +C AGGREGATE TRANSFORMATIONS +C + TRINH=0.0 + TRINO=0.0 + TRIPO=0.0 + TRIP1=0.0 + TRINB=0.0 + TRIOB=0.0 + TRIPB=0.0 + TRIB1=0.0 + TRGOM=0.0 + TRGOC=0.0 + TRGOD=0.0 + TRGOA=0.0 + TRGOH=0.0 + TUPOX=0.0 + TRDN3=0.0 + TRDNB=0.0 + TRDN2=0.0 + TRD2B=0.0 + TRDNO=0.0 + TRN2F=0.0 + DO 650 K=0,5 + IF(L.NE.0.OR.(K.NE.3.AND.K.NE.4))THEN + DO 640 N=1,7 + IF(K.NE.5.OR.(N.LE.3.OR.N.EQ.5))THEN + TRINH=TRINH+RINH4(N,K) + TRINO=TRINO+RINO3(N,K) + TRIPO=TRIPO+RIPO4(N,K) + TRIP1=TRIP1+RIP14(N,K) + TRINB=TRINB+RINB4(N,K) + TRIOB=TRIOB+RINB3(N,K) + TRIPB=TRIPB+RIPOB(N,K) + TRIB1=TRIB1+RIP1B(N,K) + TRN2F=TRN2F+RN2FX(N,K) + IF(L.EQ.NU(NY,NX))THEN + TRINH=TRINH+RINH4R(N,K) + TRINO=TRINO+RINO3R(N,K) + TRIPO=TRIPO+RIPO4R(N,K) + TRIP1=TRIP1+RIP14R(N,K) + ENDIF +C IF(NY.EQ.5.AND.L.EQ.10.AND.K.EQ.3.AND.N.EQ.2)THEN +C WRITE(*,4469)'TRINH',I,J,NX,NY,L,K,N,TRINH,RINH4(N,K),RINH4R(N,K) +C WRITE(*,4469)'TRIPO',I,J,NX,NY,L,K,N,TRIPO,RIPO4(N,K),RIPO4R(N,K) +C 2,CGOMP(N,K) +4469 FORMAT(A8,7I4,20E12.4) +C ENDIF + TRGOM=TRGOM+RCO2X(N,K) + TRGOC=TRGOC+RCH4X(N,K) + TRGOD=TRGOD+RGOMD(N,K) + TUPOX=TUPOX+RUPOX(N,K) + TRDN3=TRDN3+RDNO3(N,K) + TRDNB=TRDNB+RDNOB(N,K) + TRDN2=TRDN2+RDNO2(N,K) + TRD2B=TRD2B+RDN2B(N,K) + TRDNO=TRDNO+RDN2O(N,K) + TRGOH=TRGOH+RH2GX(N,K) +C IF(L.EQ.NU(NY,NX))THEN +C WRITE(*,3333)'TRGOM',I,J,NX,NY,L,K,N,TRGOM +C 2,RCO2X(N,K),TRGOA +C WRITE(*,3333)'TUPOX',I,J,NX,NY,L,K,N,TUPOX,RUPOX(N,K) +C ENDIF +C IF(J.EQ.12.AND.L.LE.4)THEN +C WRITE(*,3333)'N2O',I,J,NX,NY,L,K,N,TRDN2,TRD2B,TRDNO +C 2,RDNO2(N,K),RDN2B(N,K),RDN2O(N,K),COXYS(L,NY,NX) +C 3,COXYG(L,NY,NX) +C WRITE(*,3333)'TRGOH',I,J,NX,NY,L,K,N,TRGOH,RH2GX(N,K) +C 2,RGOMO(N,K) +3333 FORMAT(A8,7I4,20E12.4) +C ENDIF + ENDIF +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 + TRGOA=TRGOA+CGOMC(N,5) + ENDIF + ENDIF +645 CONTINUE +C +C ALLOCATE AGGREGATED TRANSFORMATIONS INTO ARRAYS TO UPDATE +C STATE VARIABLES IN 'REDIST' +C + RCO2O(L,NY,NX)=TRGOA-TRGOM-TRGOD-RVOXA(3) + RCH4O(L,NY,NX)=RVOXA(3)+CGOMC(3,5)-TRGOC + RH2GO(L,NY,NX)=RH2GZ-TRGOH + 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 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 +C WRITE(*,2468)'RN2O',I,J,NX,NY,L +C 2,RN2O(L,NY,NX),TRDN2,TRD2B,RCN2O,RCN2B,TRDNO +C 2,RCH4O(L,NY,NX),RVOXA(3) +C 2,CGOMC(3,5),TRGOC,(OMA(N,1),N=1,7) +2468 FORMAT(A8,5I4,20E12.4) +C ENDIF + DO 655 K=0,4 + DO 660 M=1,4 + XOQCS(K,L,NY,NX)=XOQCS(K,L,NY,NX)+RCOSC(M,K) + XOQNS(K,L,NY,NX)=XOQNS(K,L,NY,NX)+RCOSN(M,K) + XOQPS(K,L,NY,NX)=XOQPS(K,L,NY,NX)+RCOSP(M,K) +660 CONTINUE + DO 665 M=1,2 + XOQCS(K,L,NY,NX)=XOQCS(K,L,NY,NX)+RDORC(M,K) + XOQNS(K,L,NY,NX)=XOQNS(K,L,NY,NX)+RDORN(M,K) + XOQPS(K,L,NY,NX)=XOQPS(K,L,NY,NX)+RDORP(M,K) +665 CONTINUE + XOQCS(K,L,NY,NX)=XOQCS(K,L,NY,NX)+RDOHC(K) + XOQNS(K,L,NY,NX)=XOQNS(K,L,NY,NX)+RDOHN(K) + XOQPS(K,L,NY,NX)=XOQPS(K,L,NY,NX)+RDOHP(K) + XOQAS(K,L,NY,NX)=XOQAS(K,L,NY,NX)+RDOHA(K) + DO 670 N=1,7 + XOQCS(K,L,NY,NX)=XOQCS(K,L,NY,NX)-CGOQC(N,K) + XOQNS(K,L,NY,NX)=XOQNS(K,L,NY,NX)-CGOMN(N,K) + XOQPS(K,L,NY,NX)=XOQPS(K,L,NY,NX)-CGOMP(N,K) + XOQAS(K,L,NY,NX)=XOQAS(K,L,NY,NX)-CGOAC(N,K)+RCH3X(N,K) +670 CONTINUE + XOQCS(K,L,NY,NX)=XOQCS(K,L,NY,NX)-CSORP(K) + XOQNS(K,L,NY,NX)=XOQNS(K,L,NY,NX)-ZSORP(K) + XOQPS(K,L,NY,NX)=XOQPS(K,L,NY,NX)-PSORP(K) + XOQAS(K,L,NY,NX)=XOQAS(K,L,NY,NX)-CSORPA(K) +655 CONTINUE + XNH4S(L,NY,NX)=-TRINH-RVOXA(1) + XNO3S(L,NY,NX)=-TRINO+RVOXA(2)-TRDN3+RCNO3 + XNO2S(L,NY,NX)=RVOXA(1)-RVOXA(2)+TRDN3-TRDN2-RCNO2 + XH2PS(L,NY,NX)=-TRIPO + XH1PS(L,NY,NX)=-TRIP1 + XNH4B(L,NY,NX)=-TRINB-RVOXB(1) + XNO3B(L,NY,NX)=-TRIOB+RVOXB(2)-TRDNB+RCN3B + XNO2B(L,NY,NX)=RVOXB(1)-RVOXB(2)+TRDNB-TRD2B-RCNOB + XH2BS(L,NY,NX)=-TRIPB + XH1BS(L,NY,NX)=-TRIB1 + XN2GS(L,NY,NX)=TRN2F + TFNQ(L,NY,NX)=TFNX + VOLQ(L,NY,NX)=VOLWZ +C IF(ISALT(NY,NX).NE.0)THEN +C XZHYS(L,NY,NX)=XZHYS(L,NY,NX)+0.1429*(RVOXA(1)+RVOXB(1) +C 2-TRDN3-TRDNB)-0.0714*(TRDN2+TRD2B+TRDNO) +C ENDIF +C IF(L.EQ.0)THEN +C WRITE(*,2323)'XNH4S',I,J,L,XNH4S(L,NY,NX) +C 2,TRINH,RVOXA(1),VLNH4(L,NY,NX),TRDN2 +C WRITE(*,2323)'XNO3S',I,J,L,XNO3S(L,NY,NX) +C 2,TRINO,RVOXA(2),VLNO3(L,NY,NX),TRDN3,RCNO3 +C WRITE(*,2323)'XH2PS',I,J,L,XH2PS(L,NY,NX) +C 2,RIPOT,TRIPO,VLPO4(L,NY,NX) +C WRITE(*,2323)'XNO2B',I,J,L,XNO2B(L,NY,NX),RVOXB(1) +C 2,VLNHB(L,NY,NX),RVOXB(2),VLNOB(L,NY,NX),TRDNB,TRD2B,RCNOB +C ENDIF + ELSE + RCO2O(L,NY,NX)=0.0 + RCH4O(L,NY,NX)=0.0 + RH2GO(L,NY,NX)=0.0 + RUPOXO(L,NY,NX)=0.0 + RN2G(L,NY,NX)=0.0 + RN2O(L,NY,NX)=0.0 + XNH4S(L,NY,NX)=0.0 + XNO3S(L,NY,NX)=0.0 + XNO2S(L,NY,NX)=0.0 + XH2PS(L,NY,NX)=0.0 + XH1PS(L,NY,NX)=0.0 + XNH4B(L,NY,NX)=0.0 + XNO3B(L,NY,NX)=0.0 + XNO2B(L,NY,NX)=0.0 + XH2BS(L,NY,NX)=0.0 + XH1BS(L,NY,NX)=0.0 + XN2GS(L,NY,NX)=0.0 + ENDIF +C +C ADJUST LAYERING OF SOC +C + IF(L.EQ.0.OR.(L.GE.NU(NY,NX).AND.L.LT.NL(NY,NX)))THEN +C 2.AND.CDPTH(L,NY,NX).LE.CDPTH(NU(NY,NX)-1,NY,NX)+0.60)THEN + IF(L.EQ.0)THEN + LL=NU(NY,NX) + IF(ORGR(L,NY,NX).GT.0.0)THEN + FOSCXS=AMIN1(1.0,FOSCZ0/ORGR(L,NY,NX)*TOMA*TFNX) + ELSE + FOSCXS=0.0 + ENDIF + ELSE + LL=L+1 + OSCXD=(ORGR(L,NY,NX)*VOLT(LL,NY,NX)-ORGR(LL,NY,NX)*VOLT(L,NY,NX)) + 2/(VOLT(L,NY,NX)+VOLT(LL,NY,NX)) + IF(OSCXD.GT.0.0.AND.ORGR(L,NY,NX).GT.ZEROS(NY,NX))THEN + FOSCXD=OSCXD/ORGR(L,NY,NX) + ELSEIF(OSCXD.LT.0.0.AND.ORGR(LL,NY,NX).GT.ZEROS(NY,NX))THEN + FOSCXD=OSCXD/ORGR(LL,NY,NX) + ELSE + FOSCXD=0.0 + ENDIF + FOSCXS=FOSCZL*FOSCXD*TFNX*TOMA/VOLT(L,NY,NX) + ENDIF +C IF(L.EQ.3.AND.K.EQ.2)THEN +C WRITE(*,1115)'MIX',I,J,L,LL,FOSCXS,FOSCZ0,FOSCZL,OSCXD,TOMA +C 2,TFNX,ORGR(L,NY,NX),VOLT(LL,NY,NX),ORGR(LL,NY,NX),VOLT(L,NY,NX) +1115 FORMAT(A8,4I4,20E12.4) +C ENDIF + IF(FOSCXS.NE.0.0)THEN + DO 7971 K=1,2 + DO 7961 N=1,7 + DO 7962 M=1,3 + IF(FOSCXS.GT.0.0)THEN + OMCXS=FOSCXS*AMAX1(0.0,OMC(M,N,K,L,NY,NX)) + OMNXS=FOSCXS*AMAX1(0.0,OMN(M,N,K,L,NY,NX)) + OMPXS=FOSCXS*AMAX1(0.0,OMP(M,N,K,L,NY,NX)) + ELSE + OMCXS=FOSCXS*AMAX1(0.0,OMC(M,N,K,LL,NY,NX)) + OMNXS=FOSCXS*AMAX1(0.0,OMN(M,N,K,LL,NY,NX)) + OMPXS=FOSCXS*AMAX1(0.0,OMP(M,N,K,LL,NY,NX)) + ENDIF + OMC(M,N,K,L,NY,NX)=OMC(M,N,K,L,NY,NX)-OMCXS + OMN(M,N,K,L,NY,NX)=OMN(M,N,K,L,NY,NX)-OMNXS + OMP(M,N,K,L,NY,NX)=OMP(M,N,K,L,NY,NX)-OMPXS + OMC(M,N,K,LL,NY,NX)=OMC(M,N,K,LL,NY,NX)+OMCXS + OMN(M,N,K,LL,NY,NX)=OMN(M,N,K,LL,NY,NX)+OMNXS + OMP(M,N,K,LL,NY,NX)=OMP(M,N,K,LL,NY,NX)+OMPXS +7962 CONTINUE +7961 CONTINUE +7971 CONTINUE + DO 7901 K=1,2 + DO 7941 M=1,2 + IF(FOSCXS.GT.0.0)THEN + ORCXS=FOSCXS*AMAX1(0.0,ORC(M,K,L,NY,NX)) + ORNXS=FOSCXS*AMAX1(0.0,ORN(M,K,L,NY,NX)) + ORPXS=FOSCXS*AMAX1(0.0,ORP(M,K,L,NY,NX)) + ELSE + ORCXS=FOSCXS*AMAX1(0.0,ORC(M,K,LL,NY,NX)) + ORNXS=FOSCXS*AMAX1(0.0,ORN(M,K,LL,NY,NX)) + ORPXS=FOSCXS*AMAX1(0.0,ORP(M,K,LL,NY,NX)) + ENDIF + ORC(M,K,L,NY,NX)=ORC(M,K,L,NY,NX)-ORCXS + ORN(M,K,L,NY,NX)=ORN(M,K,L,NY,NX)-ORNXS + ORP(M,K,L,NY,NX)=ORP(M,K,L,NY,NX)-ORPXS + ORC(M,K,LL,NY,NX)=ORC(M,K,LL,NY,NX)+ORCXS + ORN(M,K,LL,NY,NX)=ORN(M,K,LL,NY,NX)+ORNXS + ORP(M,K,LL,NY,NX)=ORP(M,K,LL,NY,NX)+ORPXS +C IF(L.EQ.3.AND.K.EQ.2)THEN +C WRITE(*,7942)'ORC',I,J,L,LL,K,M,ORC(M,K,L,NY,NX) +C 2,ORC(M,K,LL,NY,NX),ORCXS,FOSCXS +7942 FORMAT(A8,6I4,20E12.4) +C ENDIF +7941 CONTINUE + IF(FOSCXS.GT.0.0)THEN + OQCXS=FOSCXS*AMAX1(0.0,OQC(K,L,NY,NX)) + OQCHXS=FOSCXS*AMAX1(0.0,OQCH(K,L,NY,NX)) + OHCXS=FOSCXS*AMAX1(0.0,OHC(K,L,NY,NX)) + OQAXS=FOSCXS*AMAX1(0.0,OQA(K,L,NY,NX)) + OQAHXS=FOSCXS*AMAX1(0.0,OQAH(K,L,NY,NX)) + OHAXS=FOSCXS*AMAX1(0.0,OHA(K,L,NY,NX)) + OQNXS=FOSCXS*AMAX1(0.0,OQN(K,L,NY,NX)) + OQNHXS=FOSCXS*AMAX1(0.0,OQNH(K,L,NY,NX)) + OHNXS=FOSCXS*AMAX1(0.0,OHN(K,L,NY,NX)) + OQPXS=FOSCXS*AMAX1(0.0,OQP(K,L,NY,NX)) + OQPHXS=FOSCXS*AMAX1(0.0,OQPH(K,L,NY,NX)) + OHPXS=FOSCXS*AMAX1(0.0,OHP(K,L,NY,NX)) + ELSE + OQCXS=FOSCXS*AMAX1(0.0,OQC(K,LL,NY,NX)) + OQCHXS=FOSCXS*AMAX1(0.0,OQCH(K,LL,NY,NX)) + OHCXS=FOSCXS*AMAX1(0.0,OHC(K,LL,NY,NX)) + OQAXS=FOSCXS*AMAX1(0.0,OQA(K,LL,NY,NX)) + OQAHXS=FOSCXS*AMAX1(0.0,OQAH(K,LL,NY,NX)) + OHAXS=FOSCXS*AMAX1(0.0,OHA(K,LL,NY,NX)) + OQNXS=FOSCXS*AMAX1(0.0,OQN(K,LL,NY,NX)) + OQNHXS=FOSCXS*AMAX1(0.0,OQNH(K,LL,NY,NX)) + OHNXS=FOSCXS*AMAX1(0.0,OHN(K,LL,NY,NX)) + OQPXS=FOSCXS*AMAX1(0.0,OQP(K,LL,NY,NX)) + OQPHXS=FOSCXS*AMAX1(0.0,OQPH(K,LL,NY,NX)) + OHPXS=FOSCXS*AMAX1(0.0,OHP(K,LL,NY,NX)) + ENDIF + OQC(K,L,NY,NX)=OQC(K,L,NY,NX)-OQCXS + OQCH(K,L,NY,NX)=OQCH(K,L,NY,NX)-OQCHXS + OHC(K,L,NY,NX)=OHC(K,L,NY,NX)-OHCXS + OQA(K,L,NY,NX)=OQA(K,L,NY,NX)-OQAXS + OQAH(K,L,NY,NX)=OQAH(K,L,NY,NX)-OQAHXS + OHA(K,L,NY,NX)=OHA(K,L,NY,NX)-OHAXS + OQN(K,L,NY,NX)=OQN(K,L,NY,NX)-OQNXS + OQNH(K,L,NY,NX)=OQNH(K,L,NY,NX)-OQNHXS + OHN(K,L,NY,NX)=OHN(K,L,NY,NX)-OHNXS + OQP(K,L,NY,NX)=OQP(K,L,NY,NX)-OQPXS + OQPH(K,L,NY,NX)=OQPH(K,L,NY,NX)-OQPHXS + OHP(K,L,NY,NX)=OHP(K,L,NY,NX)-OHPXS + OQC(K,LL,NY,NX)=OQC(K,LL,NY,NX)+OQCXS + OQCH(K,LL,NY,NX)=OQCH(K,LL,NY,NX)+OQCHXS + OHC(K,LL,NY,NX)=OHC(K,LL,NY,NX)+OHCXS + OQA(K,LL,NY,NX)=OQA(K,LL,NY,NX)+OQAXS + OQAH(K,LL,NY,NX)=OQAH(K,LL,NY,NX)+OQAHXS + OHA(K,LL,NY,NX)=OHA(K,LL,NY,NX)+OHAXS + OQN(K,LL,NY,NX)=OQN(K,LL,NY,NX)+OQNXS + OQNH(K,LL,NY,NX)=OQNH(K,LL,NY,NX)+OQNHXS + OHN(K,LL,NY,NX)=OHN(K,LL,NY,NX)+OHNXS + OQP(K,LL,NY,NX)=OQP(K,LL,NY,NX)+OQPXS + OQPH(K,LL,NY,NX)=OQPH(K,LL,NY,NX)+OQPHXS + OHP(K,LL,NY,NX)=OHP(K,LL,NY,NX)+OHPXS + DO 7931 M=1,4 + IF(FOSCXS.GT.0.0)THEN + OSCXS=FOSCXS*AMAX1(0.0,OSC(M,K,L,NY,NX)) + OSAXS=FOSCXS*AMAX1(0.0,OSA(M,K,L,NY,NX)) + OSNXS=FOSCXS*AMAX1(0.0,OSN(M,K,L,NY,NX)) + OSPXS=FOSCXS*AMAX1(0.0,OSP(M,K,L,NY,NX)) + ELSE + OSCXS=FOSCXS*AMAX1(0.0,OSC(M,K,LL,NY,NX)) + OSAXS=FOSCXS*AMAX1(0.0,OSA(M,K,LL,NY,NX)) + OSNXS=FOSCXS*AMAX1(0.0,OSN(M,K,LL,NY,NX)) + OSPXS=FOSCXS*AMAX1(0.0,OSP(M,K,LL,NY,NX)) + ENDIF + OSC(M,K,L,NY,NX)=OSC(M,K,L,NY,NX)-OSCXS + OSA(M,K,L,NY,NX)=OSA(M,K,L,NY,NX)-OSAXS + OSN(M,K,L,NY,NX)=OSN(M,K,L,NY,NX)-OSNXS + OSP(M,K,L,NY,NX)=OSP(M,K,L,NY,NX)-OSPXS + OSC(M,K,LL,NY,NX)=OSC(M,K,LL,NY,NX)+OSCXS + OSA(M,K,LL,NY,NX)=OSA(M,K,LL,NY,NX)+OSAXS + OSN(M,K,LL,NY,NX)=OSN(M,K,LL,NY,NX)+OSNXS + OSP(M,K,LL,NY,NX)=OSP(M,K,LL,NY,NX)+OSPXS +7931 CONTINUE +7901 CONTINUE + ENDIF +C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.EQ.3)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 +2123 FORMAT(A8,5I4,12E15.4) +C ENDIF + ENDIF +998 CONTINUE +C WRITE(20,3434)'RN2O',IYRC,I,J,(RN2O(L,NY,NX),L=0,NL(NY,NX)) +3434 FORMAT(A8,3I4,20E12.4) +9990 CONTINUE +9995 CONTINUE + RETURN + END + + + diff --git a/f77src/outsd.f b/f77src/outsd.f index 3479859..27f1100 100755 --- a/f77src/outsd.f +++ b/f77src/outsd.f @@ -169,7 +169,8 @@ SUBROUTINE outsd(I,NT,NE,NAX,NDX,NTX,NEX,NHW,NHE,NVN,NVS) IF(K.EQ.33)HEAD(M)=(VOLI(15,NY,NX)+AMIN1(VOLAH(15,NY,NX) 2,VOLIH(15,NY,NX)))/VOLT(15,NY,NX) IF(K.EQ.34)THEN - HEAD(M)=1000.0*VOLI(0,NY,NX)/AREA(3,NU(NY,NX),NY,NX) + HEAD(M)=1000.0*AMAX1(0.0,VOLI(0,NY,NX)-VOLWRX(NY,NX)) + 2/AREA(3,NU(NY,NX),NY,NX) ENDIF IF(K.EQ.35)HEAD(M)=PSISM(1,NY,NX)+PSISO(1,NY,NX) IF(K.EQ.36)HEAD(M)=PSISM(2,NY,NX)+PSISO(2,NY,NX) @@ -502,111 +503,120 @@ SUBROUTINE outsd(I,NT,NE,NAX,NDX,NTX,NEX,NHW,NHE,NVN,NVS) IF(K.EQ.12)HEAD(M)=UPO4F(NY,NX)/AREA(3,NU(NY,NX),NY,NX) IF(K.EQ.13)THEN IF(BKVL(1,NY,NX).GT.ZEROS(NY,NX))THEN - HEAD(M)=(H2PO4(1,NY,NX)+H2POB(1,NY,NX))/VOLW(1,NY,NX) + HEAD(M)=(H1PO4(1,NY,NX)+H1POB(1,NY,NX) + 2+H2PO4(1,NY,NX)+H2POB(1,NY,NX))/VOLW(1,NY,NX) ELSE HEAD(M)=0.0 ENDIF ENDIF IF(K.EQ.14)THEN IF(BKVL(2,NY,NX).GT.ZEROS(NY,NX))THEN - HEAD(M)=(H2PO4(2,NY,NX)+H2POB(2,NY,NX))/VOLW(2,NY,NX) + HEAD(M)=(H1PO4(2,NY,NX)+H2POB(1,NY,NX) + 2+H2PO4(2,NY,NX)+H2POB(2,NY,NX))/VOLW(2,NY,NX) ELSE HEAD(M)=0.0 ENDIF ENDIF IF(K.EQ.15)THEN IF(BKVL(3,NY,NX).GT.ZEROS(NY,NX))THEN - HEAD(M)=(H2PO4(3,NY,NX)+H2POB(3,NY,NX))/VOLW(3,NY,NX) + HEAD(M)=(H1PO4(3,NY,NX)+H1POB(3,NY,NX) + 2+H2PO4(3,NY,NX)+H2POB(3,NY,NX))/VOLW(3,NY,NX) ELSE HEAD(M)=0.0 ENDIF ENDIF IF(K.EQ.16)THEN IF(BKVL(4,NY,NX).GT.ZEROS(NY,NX))THEN - HEAD(M)=(H2PO4(4,NY,NX)+H2POB(4,NY,NX))/VOLW(4,NY,NX) + HEAD(M)=(H1PO4(4,NY,NX)+H1POB(4,NY,NX) + 2+H2PO4(4,NY,NX)+H2POB(4,NY,NX))/VOLW(4,NY,NX) ELSE HEAD(M)=0.0 ENDIF ENDIF IF(K.EQ.17)THEN IF(BKVL(5,NY,NX).GT.ZEROS(NY,NX))THEN - HEAD(M)=(H2PO4(5,NY,NX)+H2POB(5,NY,NX))/VOLW(5,NY,NX) + HEAD(M)=(H1PO4(5,NY,NX)+H1POB(5,NY,NX) + 2+H2PO4(5,NY,NX)+H2POB(5,NY,NX))/VOLW(5,NY,NX) ELSE HEAD(M)=0.0 ENDIF ENDIF IF(K.EQ.18)THEN IF(BKVL(6,NY,NX).GT.ZEROS(NY,NX))THEN - HEAD(M)=(H2PO4(6,NY,NX)+H2POB(6,NY,NX))/VOLW(6,NY,NX) + HEAD(M)=(H1PO4(6,NY,NX)+H1POB(6,NY,NX) + 2+H2PO4(6,NY,NX)+H2POB(6,NY,NX))/VOLW(6,NY,NX) ELSE HEAD(M)=0.0 ENDIF ENDIF IF(K.EQ.19)THEN IF(BKVL(7,NY,NX).GT.ZEROS(NY,NX))THEN - HEAD(M)=(H2PO4(7,NY,NX)+H2POB(7,NY,NX))/VOLW(7,NY,NX) + HEAD(M)=(H1PO4(7,NY,NX)+H1POB(7,NY,NX) + 2+H2PO4(7,NY,NX)+H2POB(7,NY,NX))/VOLW(7,NY,NX) ELSE HEAD(M)=0.0 ENDIF ENDIF IF(K.EQ.20)THEN IF(BKVL(8,NY,NX).GT.ZEROS(NY,NX))THEN - HEAD(M)=(H2PO4(8,NY,NX)+H2POB(8,NY,NX))/VOLW(8,NY,NX) + HEAD(M)=(H1PO4(8,NY,NX)+H1POB(8,NY,NX) + 2+H2PO4(8,NY,NX)+H2POB(8,NY,NX))/VOLW(8,NY,NX) ELSE HEAD(M)=0.0 ENDIF ENDIF IF(K.EQ.21)THEN IF(BKVL(9,NY,NX).GT.ZEROS(NY,NX))THEN - HEAD(M)=(H2PO4(9,NY,NX)+H2POB(9,NY,NX))/VOLW(9,NY,NX) + HEAD(M)=(H1PO4(9,NY,NX)+H1POB(9,NY,NX) + 2+H2PO4(9,NY,NX)+H2POB(9,NY,NX))/VOLW(9,NY,NX) ELSE HEAD(M)=0.0 ENDIF ENDIF IF(K.EQ.22)THEN IF(BKVL(10,NY,NX).GT.ZEROS(NY,NX))THEN - HEAD(M)=(H2PO4(10,NY,NX)+H2POB(10,NY,NX)) - 2/VOLW(10,NY,NX) + HEAD(M)=(H1PO4(10,NY,NX)+H1POB(10,NY,NX) + 2+H2PO4(10,NY,NX)+H2POB(10,NY,NX))/VOLW(10,NY,NX) ELSE HEAD(M)=0.0 ENDIF ENDIF IF(K.EQ.23)THEN IF(BKVL(11,NY,NX).GT.ZEROS(NY,NX))THEN - HEAD(M)=(H2PO4(11,NY,NX)+H2POB(11,NY,NX)) - 2/VOLW(11,NY,NX) + HEAD(M)=(H1PO4(11,NY,NX)+H1POB(11,NY,NX) + 2+H2PO4(11,NY,NX)+H2POB(11,NY,NX))/VOLW(11,NY,NX) ELSE HEAD(M)=0.0 ENDIF ENDIF IF(K.EQ.24)THEN IF(BKVL(12,NY,NX).GT.ZEROS(NY,NX))THEN - HEAD(M)=(H2PO4(12,NY,NX)+H2POB(12,NY,NX)) - 2/VOLW(12,NY,NX) + HEAD(M)=(H1PO4(12,NY,NX)+H1POB(1,NY,NX) + 2+H2PO4(12,NY,NX)+H2POB(12,NY,NX))/VOLW(12,NY,NX) ELSE HEAD(M)=0.0 ENDIF ENDIF IF(K.EQ.25)THEN IF(BKVL(13,NY,NX).GT.ZEROS(NY,NX))THEN - HEAD(M)=(H2PO4(13,NY,NX)+H2POB(13,NY,NX)) - 2/VOLW(13,NY,NX) + HEAD(M)=(H1PO4(13,NY,NX)+H1POB(13,NY,NX) + 2+H2PO4(13,NY,NX)+H2POB(13,NY,NX))/VOLW(13,NY,NX) ELSE HEAD(M)=0.0 ENDIF ENDIF IF(K.EQ.26)THEN IF(BKVL(14,NY,NX).GT.ZEROS(NY,NX))THEN - HEAD(M)=(H2PO4(14,NY,NX)+H2POB(14,NY,NX)) - 2/VOLW(14,NY,NX) + HEAD(M)=(H1PO4(14,NY,NX)+H1POB(14,NY,NX) + 2+H2PO4(14,NY,NX)+H2POB(14,NY,NX))/VOLW(14,NY,NX) ELSE HEAD(M)=0.0 ENDIF ENDIF IF(K.EQ.27)THEN IF(BKVL(15,NY,NX).GT.ZEROS(NY,NX))THEN - HEAD(M)=(H2PO4(15,NY,NX)+H2POB(15,NY,NX)) - 2/VOLW(15,NY,NX) + HEAD(M)=(H1PO4(15,NY,NX)+H1POB(15,NY,NX) + 2+H2PO4(15,NY,NX)+H2POB(15,NY,NX))/VOLW(15,NY,NX) ELSE HEAD(M)=0.0 ENDIF diff --git a/f77src/outsh.f b/f77src/outsh.f index 9859172..b5c7563 100755 --- a/f77src/outsh.f +++ b/f77src/outsh.f @@ -212,7 +212,8 @@ SUBROUTINE outsh(I,J,NT,NE,NAX,NDX,NTX,NEX,NHW,NHE,NVN,NVS) IF(K.EQ.47)HEAD(M)=(VOLI(20,NY,NX)+AMIN1(VOLAH(20,NY,NX) 2,VOLIH(20,NY,NX)))/VOLT(20,NY,NX) IF(K.EQ.48)THEN - HEAD(M)=1000.0*VOLI(0,NY,NX)/AREA(3,NU(NY,NX),NY,NX) + HEAD(M)=1000.0*AMAX1(0.0,VOLI(0,NY,NX)-VOLWRX(NY,NX)) + 2/AREA(3,NU(NY,NX),NY,NX) ENDIF IF(K.EQ.49)HEAD(M)=-(DPTHA(NY,NX)-CDPTH(NU(NY,NX)-1,NY,NX)) IF(K.EQ.50)HEAD(M)=-(DPTHT(NY,NX)-CDPTH(NU(NY,NX)-1,NY,NX)) diff --git a/f77src/readi.f b/f77src/readi.f index 5ae1533..1b78df5 100755 --- a/f77src/readi.f +++ b/f77src/readi.f @@ -35,7 +35,7 @@ SUBROUTINE readi(NA,ND,NT,NE,NAX,NDX,NTX,NEX,NF,NFX,NTZ 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)' 27 OCT 2018' + WRITE(18,5000)' 17 APR 2019' 5000 FORMAT(A16) NF=1 NFX=1 @@ -64,7 +64,6 @@ SUBROUTINE readi(NA,ND,NT,NE,NAX,NDX,NTX,NEX,NF,NFX,NTZ Z2OE(NY,NX)=Z2OEG ZNH3E(NY,NX)=ZNH3EG IETYP(NY,NX)=IETYPG - ISALT(NY,NX)=ISALTG IERSN(NY,NX)=IERSNG NCN(NY,NX)=NCNG DTBLI(NY,NX)=DTBLIG @@ -105,6 +104,11 @@ SUBROUTINE readi(NA,ND,NT,NE,NAX,NDX,NTX,NEX,NF,NFX,NTZ 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 @@ -229,49 +233,6 @@ SUBROUTINE readi(NA,ND,NT,NE,NAX,NDX,NTX,NEX,NF,NFX,NTZ 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 - DO 24 L=NU(NY,NX),NM(NY,NX) - 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 - CORGC(L,NY,NX)=CORGC(L,NY,NX)*1.0E+03 - CORGR(L,NY,NX)=CORGR(L,NY,NX)*1.0E+03 - IF(CORGN(L,NY,NX).LT.0.0)THEN - CORGN(L,NY,NX)=AMIN1(0.111*CORGC(L,NY,NX),CORGC(L,NY,NX)**0.73) - ENDIF - IF(CORGP(L,NY,NX).LT.0.0)THEN - CORGP(L,NY,NX)=0.10*CORGN(L,NY,NX) - ENDIF - IF(CEC(L,NY,NX).LT.0.0)THEN - CEC(L,NY,NX)=10.0*(200.0*2.0*CORGCR/1.0E+06 - 2+80.0*CCLAY(L,NY,NX)/1.0E+06) - ENDIF -24 CONTINUE C C ADD SOIL BOUNDARY LAYERS ABOVE ROOTING ZONE C @@ -362,10 +323,10 @@ SUBROUTINE readi(NA,ND,NT,NE,NAX,NDX,NTX,NEX,NF,NFX,NTZ 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.25*CORGC(L-1,NY,NX) - CORGR(L,NY,NX)=0.25*CORGR(L-1,NY,NX) - CORGN(L,NY,NX)=0.25*CORGN(L-1,NY,NX) - CORGP(L,NY,NX)=0.25*CORGP(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) C ELSE C CORGC(L,NY,NX)=CORGC(L-1,NY,NX) C CORGR(L,NY,NX)=CORGR(L-1,NY,NX) @@ -425,14 +386,16 @@ SUBROUTINE readi(NA,ND,NT,NE,NAX,NDX,NTX,NEX,NF,NFX,NTZ 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))) - CORGCR=CORGC(L,NY,NX)+(RSC(1,L,NY,NX)+RSC(0,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-CORGCR/0.5E+06)) + 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-CORGCR/0.5E+06)) + 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-CORGCR/0.5E+06)) + 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 @@ -454,6 +417,56 @@ SUBROUTINE readi(NA,ND,NT,NE,NAX,NDX,NTX,NEX,NF,NFX,NTZ 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 @@ -475,3 +488,4 @@ SUBROUTINE readi(NA,ND,NT,NE,NAX,NDX,NTX,NEX,NF,NFX,NTZ RETURN END + diff --git a/f77src/readq.f b/f77src/readq.f index 24ce74c..e615c56 100755 --- a/f77src/readq.f +++ b/f77src/readq.f @@ -20,16 +20,11 @@ SUBROUTINE readq(NA,ND,NT,NE,NAX,NDX,NTX,NEX,NF,NFX,NTZ CHARACTER*3 CHOICE(102,20) CHARACTER*8 CDATE CHARACTER*80 PREFIX - CHARACTER*2 CLIMATE PARAMETER (TWILGT=0.06976) DO 9995 NX=NHW,NHE DO 9990 NY=NVN,NVS DO 9985 NZ=1,NP(NY,NX) IF(DATAP(NZ,NY,NX).NE.'NO')THEN - IF(IETYP(NY,NX).GT.0)THEN - WRITE(CLIMATE,'(I2)')IETYP(NY,NX) - DATAP(NZ,NY,NX)=DATAP(NZ,NY,NX)(1:4)//CLIMATE - ENDIF C WRITE(*,2233)'READQ',NX,NY,NZ,IETYP(NY,NX),DATAP(NZ,NY,NX) 2233 FORMAT(A8,4I4,2A16) OPEN(11,FILE=TRIM(PREFIX)//DATAP(NZ,NY,NX),STATUS='OLD') diff --git a/f77src/reads.f b/f77src/reads.f index 5518bb9..c66868f 100755 --- a/f77src/reads.f +++ b/f77src/reads.f @@ -27,8 +27,8 @@ SUBROUTINE reads(NA,ND,NT,NE,NAX,NDX,NTX,NEX,NF,NFX,NTZ CHARACTER*80 PREFIX DIMENSION IDAT(20),DAT(50),DATK(50),OUT(50) PARAMETER (TWILGT=0.06976) - DATA IFLGY,IYRX,IYRY,IYRD/0,0,0,0/ - SAVE N1,N2,N1X,N2X,IFLGY,IYRX,IYRY,IYRD + 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' @@ -196,14 +196,13 @@ SUBROUTINE reads(NA,ND,NT,NE,NAX,NDX,NTX,NEX,NF,NFX,NTZ ENDIF IF(IVAR(K).EQ.'Y')THEN IFLGY=1 - IYRY=IDAT(K) - IYRY=IYRY+(NT-1)*NF+(NTX-1)*NFX-NTZX + 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.IYRY.LE.IYRX)GO TO 60 + IF(IFLGY.EQ.1.AND.IYRX.LT.IYRC)GO TO 60 IF(CTYPE.EQ.'J')THEN I=N ELSE @@ -316,7 +315,6 @@ SUBROUTINE reads(NA,ND,NT,NE,NAX,NDX,NTX,NEX,NF,NFX,NTZ 65 CONTINUE IX=I IF(IFLGY.EQ.1.AND.I.EQ.IYRD)THEN - IYRX=IYRY GO TO 110 ENDIF GO TO 60 @@ -333,7 +331,11 @@ SUBROUTINE reads(NA,ND,NT,NE,NAX,NDX,NTX,NEX,NF,NFX,NTZ 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 @@ -495,7 +497,6 @@ SUBROUTINE reads(NA,ND,NT,NE,NAX,NDX,NTX,NEX,NF,NFX,NTZ ENDIF ENDIF IF(IFLGY.EQ.1.AND.I.EQ.IYRD.AND.J.EQ.24)THEN - IYRX=IYRY GO TO 110 ENDIF GO TO 60 diff --git a/f77src/redist.f b/f77src/redist.f index 5076d30..a059bd6 100755 --- a/f77src/redist.f +++ b/f77src/redist.f @@ -1,5624 +1,5912 @@ - - SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) -C -C THIS SUBROUTINE UPDATES SOIL STATE VARIABLES WITH WATER, HEAT, -C C, N, P, SOLUTE FLUXES CALCULATED IN EARLIER SUBROUTINES -C - include "parameters.h" - include "blkc.h" - include "blk2a.h" - include "blk2b.h" - include "blk2c.h" - include "blk5.h" - include "blk8a.h" - include "blk8b.h" - include "blk11a.h" - include "blk11b.h" - include "blk13a.h" - include "blk13b.h" - include "blk13c.h" - include "blk15a.h" - include "blk15b.h" - include "blk16.h" - include "blk18a.h" - include "blk18b.h" - include "blk19a.h" - include "blk19b.h" - include "blk19c.h" - include "blk19d.h" - include "blk20a.h" - include "blk20b.h" - include "blk20c.h" - include "blk20d.h" - include "blk20e.h" - include "blk20f.h" - include "blk21a.h" - include "blk21b.h" - include "blk22a.h" - include "blk22b.h" - include "blk22c.h" - include "blktest.h" - DIMENSION TFLW(JZ,JY,JX),TFLWX(JZ,JY,JX),THFLW(JZ,JY,JX) - 1,TFLWH(JZ,JY,JX),TOCFLS(0:4,JZ,JY,JX),TONFLS(0:4,JZ,JY,JX) - 2,TOPFLS(0:4,JZ,JY,JX),TOAFLS(0:4,JZ,JY,JX),TCOFLS(JZ,JY,JX) - 3,TCHFLS(JZ,JY,JX),TOXFLS(JZ,JY,JX),TNXFLB(JZ,JY,JX) - 4,TNGFLS(JZ,JY,JX),TN2FLS(JZ,JY,JX),TN4FLS(JZ,JY,JX) - 5,TN4FLB(JZ,JY,JX),TN3FLS(JZ,JY,JX),TN3FLB(JZ,JY,JX) - 6,TNOFLS(JZ,JY,JX),TNOFLB(JZ,JY,JX),TPOFLS(JZ,JY,JX) - 7,TH2BFB(JZ,JY,JX),TNXFLS(JZ,JY,JX),TOCFHS(0:4,JZ,JY,JX) - 8,TONFHS(0:4,JZ,JY,JX),TOPFHS(0:4,JZ,JY,JX),TOAFHS(0:4,JZ,JY,JX) - 9,TCOFHS(JZ,JY,JX),TCHFHS(JZ,JY,JX),TNXFHB(JZ,JY,JX) - 2,TOXFHS(JZ,JY,JX),TNGFHS(JZ,JY,JX),TN2FHS(JZ,JY,JX) - 2,TN4FHS(JZ,JY,JX),TN4FHB(JZ,JY,JX),TN3FHS(JZ,JY,JX) - 3,TN3FHB(JZ,JY,JX),TNOFHS(JZ,JY,JX),TNOFHB(JZ,JY,JX) - 4,TPOFHS(JZ,JY,JX),TH2BHB(JZ,JY,JX),TNXFHS(JZ,JY,JX) - 5,TCOFLG(JZ,JY,JX),TCHFLG(JZ,JY,JX),TOXFLG(JZ,JY,JX) - 6,TNGFLG(JZ,JY,JX),TN2FLG(JZ,JY,JX),TNHFLG(JZ,JY,JX) - 7,TTHAW(JZ,JY,JX),THTHAW(JZ,JY,JX),TTHAWH(JZ,JY,JX) - DIMENSION TQR(JY,JX),THQR(JY,JX),TQS(JY,JX) - 2,TQW(JY,JX),TQI(JY,JX),THQS(JY,JX),TOCQRS(0:4,JY,JX) - 1,TONQRS(0:4,JY,JX),TOPQRS(0:4,JY,JX),TOAQRS(0:4,JY,JX) - 2,TCOQRS(JY,JX),TCHQRS(JY,JX),TOXQRS(JY,JX) - 3,TNGQRS(JY,JX),TN2QRS(JY,JX),TN4QRS(JY,JX),TN3QRS(JY,JX) - 4,TNOQRS(JY,JX),TPOQRS(JY,JX),TNXQRS(JY,JX),TQRAL(JY,JX) - 6,TQRFE(JY,JX),TQRHY(JY,JX),TQRCA(JY,JX),TQRMG(JY,JX) - 7,TQRNA(JY,JX),TQRKA(JY,JX),TQROH(JY,JX),TQRSO(JY,JX) - 8,TQRCL(JY,JX),TQRC3(JY,JX),TQRHC(JY,JX),TQRAL1(JY,JX) - 9,TQRAL2(JY,JX),TQRAL3(JY,JX),TQRAL4(JY,JX),TQRALS(JY,JX) - 1,TQRFE1(JY,JX),TQRFE2(JY,JX),TQRFE3(JY,JX),TQRFE4(JY,JX) - 2,TQRFES(JY,JX),TQRCAO(JY,JX),TQRCAC(JY,JX),TQRCAH(JY,JX) - 3,TQRCAS(JY,JX),TQRMGO(JY,JX),TQRMGC(JY,JX),TQRMGH(JY,JX) - 4,TQRMGS(JY,JX),TQRNAC(JY,JX),TQRNAS(JY,JX),TQRKAS(JY,JX) - 5,TQRH0P(JY,JX),TQRH1P(JY,JX),TQRH3P(JY,JX),TQRF1P(JY,JX) - 6,TQRF2P(JY,JX),TQRC0P(JY,JX),TQRC1P(JY,JX),TQRC2P(JY,JX) - 7,TQRM1P(JY,JX),TCOQSS(JY,JX),TCHQSS(JY,JX),TOXQSS(JY,JX) - 3,TNGQSS(JY,JX),TN2QSS(JY,JX),TN4QSS(JY,JX),TN3QSS(JY,JX) - 4,TNOQSS(JY,JX),TPOQSS(JY,JX),TQSAL(JY,JX) - 6,TQSFE(JY,JX),TQSHY(JY,JX),TQSCA(JY,JX),TQSMG(JY,JX) - 7,TQSNA(JY,JX),TQSKA(JY,JX),TQSOH(JY,JX),TQSSO(JY,JX) - 8,TQSCL(JY,JX),TQSC3(JY,JX),TQSHC(JY,JX),TQSAL1(JY,JX) - 9,TQSAL2(JY,JX),TQSAL3(JY,JX),TQSAL4(JY,JX),TQSALS(JY,JX) - 1,TQSFE1(JY,JX),TQSFE2(JY,JX),TQSFE3(JY,JX),TQSFE4(JY,JX) - 2,TQSFES(JY,JX),TQSCAO(JY,JX),TQSCAC(JY,JX),TQSCAH(JY,JX) - 3,TQSCAS(JY,JX),TQSMGO(JY,JX),TQSMGC(JY,JX),TQSMGH(JY,JX) - 4,TQSMGS(JY,JX),TQSNAC(JY,JX),TQSNAS(JY,JX),TQSKAS(JY,JX) - 5,TQSH0P(JY,JX),TQSH1P(JY,JX),TQSH3P(JY,JX),TQSF1P(JY,JX) - 6,TQSF2P(JY,JX),TQSC0P(JY,JX),TQSC1P(JY,JX),TQSC2P(JY,JX) - 7,TQSM1P(JY,JX) - DIMENSION TALFLS(JZ,JY,JX),TFEFLS(JZ,JY,JX) - 1,TCAFLS(JZ,JY,JX),THYFLS(JZ,JY,JX),TMGFLS(JZ,JY,JX) - 2,TNAFLS(JZ,JY,JX),TKAFLS(JZ,JY,JX),TOHFLS(JZ,JY,JX) - 3,TSOFLS(JZ,JY,JX),TCLFLS(JZ,JY,JX),TC3FLS(JZ,JY,JX) - 4,THCFLS(JZ,JY,JX),TAL1FS(JZ,JY,JX),TAL2FS(JZ,JY,JX) - 5,TAL3FS(JZ,JY,JX),TAL4FS(JZ,JY,JX),TALSFS(JZ,JY,JX) - 6,TFE1FS(JZ,JY,JX),TFE2FS(JZ,JY,JX) - 7,TFE3FS(JZ,JY,JX),TFE4FS(JZ,JY,JX),TFESFS(JZ,JY,JX) - 8,TCAOFS(JZ,JY,JX),TCACFS(JZ,JY,JX),TCAHFS(JZ,JY,JX) - 9,TCASFS(JZ,JY,JX),TMGOFS(JZ,JY,JX),TMGCFS(JZ,JY,JX) - 1,TMGHFS(JZ,JY,JX),TMGSFS(JZ,JY,JX),TNACFS(JZ,JY,JX) - 2,TNASFS(JZ,JY,JX),TKASFS(JZ,JY,JX),TH0PFS(JZ,JY,JX) - 3,TH1PFS(JZ,JY,JX),TH3PFS(JZ,JY,JX),TF1PFS(JZ,JY,JX) - 4,TF2PFS(JZ,JY,JX),TC0PFS(JZ,JY,JX),TC1PFS(JZ,JY,JX) - 5,TC2PFS(JZ,JY,JX),TM1PFS(JZ,JY,JX),TH0BFB(JZ,JY,JX) - 6,TH1BFB(JZ,JY,JX),TH3BFB(JZ,JY,JX),TF1BFB(JZ,JY,JX) - 7,TF2BFB(JZ,JY,JX),TC0BFB(JZ,JY,JX),TC1BFB(JZ,JY,JX) - 8,TC2BFB(JZ,JY,JX),TM1BFB(JZ,JY,JX) - DIMENSION TALFHS(JZ,JY,JX),TFEFHS(JZ,JY,JX) - 1,THYFHS(JZ,JY,JX),TCAFHS(JZ,JY,JX),TMGFHS(JZ,JY,JX) - 2,TNAFHS(JZ,JY,JX),TKAFHS(JZ,JY,JX),TOHFHS(JZ,JY,JX) - 3,TSOFHS(JZ,JY,JX),TCLFHS(JZ,JY,JX),TC3FHS(JZ,JY,JX) - 4,THCFHS(JZ,JY,JX),TAL1HS(JZ,JY,JX),TAL2HS(JZ,JY,JX) - 5,TAL3HS(JZ,JY,JX),TAL4HS(JZ,JY,JX),TALSHS(JZ,JY,JX) - 6,TFE1HS(JZ,JY,JX),TFE2HS(JZ,JY,JX) - 7,TFE3HS(JZ,JY,JX),TFE4HS(JZ,JY,JX),TFESHS(JZ,JY,JX) - 8,TCAOHS(JZ,JY,JX),TCACHS(JZ,JY,JX),TCAHHS(JZ,JY,JX) - 9,TCASHS(JZ,JY,JX),TMGOHS(JZ,JY,JX),TMGCHS(JZ,JY,JX) - 1,TMGHHS(JZ,JY,JX),TMGSHS(JZ,JY,JX),TNACHS(JZ,JY,JX) - 2,TNASHS(JZ,JY,JX),TKASHS(JZ,JY,JX),TH0PHS(JZ,JY,JX) - 3,TH1PHS(JZ,JY,JX),TH3PHS(JZ,JY,JX),TF1PHS(JZ,JY,JX) - 4,TF2PHS(JZ,JY,JX),TC0PHS(JZ,JY,JX),TC1PHS(JZ,JY,JX) - 5,TC2PHS(JZ,JY,JX),TM1PHS(JZ,JY,JX),TH0BHB(JZ,JY,JX) - 6,TH1BHB(JZ,JY,JX),TH3BHB(JZ,JY,JX),TF1BHB(JZ,JY,JX) - 7,TF2BHB(JZ,JY,JX),TC0BHB(JZ,JY,JX),TC1BHB(JZ,JY,JX) - 8,TC2BHB(JZ,JY,JX),TM1BHB(JZ,JY,JX) - DIMENSION TSANER(JY,JX),TSILER(JY,JX),TCLAER(JY,JX) - 2,TCECER(JY,JX),TAECER(JY,JX),TNH4ER(JY,JX),TNH3ER(JY,JX) - 3,TNHUER(JY,JX),TNO3ER(JY,JX),TNH4EB(JY,JX),TNH3EB(JY,JX) - 4,TNHUEB(JY,JX),TNO3EB(JY,JX),TN4ER(JY,JX),TNBER(JY,JX) - 5,THYER(JY,JX),TALER(JY,JX),TCAER(JY,JX),TMGER(JY,JX) - 6,TNAER(JY,JX),TKAER(JY,JX),THCER(JY,JX),TAL2ER(JY,JX) - 7,TOH0ER(JY,JX),TOH1ER(JY,JX),TOH2ER(JY,JX),TH1PER(JY,JX) - 8,TH2PER(JY,JX),TOH0EB(JY,JX),TOH1EB(JY,JX),TOH2EB(JY,JX) - 9,TH1PEB(JY,JX),TH2PEB(JY,JX),TALOER(JY,JX),TFEOER(JY,JX) - 1,TCACER(JY,JX),TCASER(JY,JX),TALPER(JY,JX),TFEPER(JY,JX) - 2,TCPDER(JY,JX),TCPHER(JY,JX),TCPMER(JY,JX),TALPEB(JY,JX) - 3,TFEPEB(JY,JX),TCPDEB(JY,JX),TCPHEB(JY,JX),TCPMEB(JY,JX) - 4,TOMCER(3,7,0:5,JY,JX),TOMNER(3,7,0:5,JY,JX),TOMPER(3,7,0:5,JY,JX) - 5,TORCER(2,0:4,JY,JX),TORNER(2,0:4,JY,JX),TORPER(2,0:4,JY,JX) - 6,TOHCER(0:4,JY,JX),TOHNER(0:4,JY,JX),TOHPER(0:4,JY,JX) - 7,TOHAER(0:4,JY,JX),TOSCER(4,0:4,JY,JX),TOSAER(4,0:4,JY,JX) - 8,TOSNER(4,0:4,JY,JX),TOSPER(4,0:4,JY,JX),TSEDER(JY,JX) - DIMENSION TOMC(3,7,0:5),TOMN(3,7,0:5),TOMP(3,7,0:5),TORC(2,0:4) - 2,TORN(2,0:4),TORP(2,0:4),TOQC(0:4),TOQN(0:4),TOQP(0:4),TOQA(0:4) - 3,TOHC(0:4),TOHN(0:4),TOHP(0:4),TOHA(0:4),TOSC(4,0:4),TOSA(4,0:4) - 4,TOSN(4,0:4),TOSP(4,0:4),TOSGC(4,0:2),TOSGA(4,0:2),TOSGN(4,0:2) - 5,TOSGP(4,0:2),TOMGC(3,7,0:5),TOMGN(3,7,0:5),TOMGP(3,7,0:5) - 6,TORXC(2,0:2),TORXN(2,0:2),TORXP(2,0:2),TOQGC(0:2),TOQGN(0:2) - 7,TOQGP(0:2),TOQHC(0:2),TOQHN(0:2),TOQHP(0:2),TOHGC(0:2) - 8,TOHGN(0:2),TOHGP(0:2), TOHGA(0:2),TOQGA(0:2),TOQHA(0:2) - 9,THGQRS(JY,JX),THGFHS(JZ,JY,JX),THGFLG(JZ,JY,JX),THGFLS(JZ,JY,JX) - 1,OMCL(0:JZ,JY,JX),OMNL(0:JZ,JY,JX),EFIRE(2,21:22) - 2,ONL(4,0:4),OPL(4,0:4) - PARAMETER (DNUMN=0.001,DNUMX=0.025) - DATA SG/0.0/ - DATA EFIRE/1.0,1.0,0.917,0.167/ - TFLWT=0.0 - VOLPT=0.0 - VOLTT=0.0 - DO 9995 NX=NHW,NHE - DO 9990 NY=NVN,NVS - TNPP(NY,NX)=TGPP(NY,NX)+TRAU(NY,NX) -C -C ADD WATER, HEAT FLUXES FROM 'WATSUB' AND GAS, SOLUTE FLUXES -C FROM 'TRNSFR' AND 'TRNSFRS' TO SNOWPACK -C - IF(PRECW(NY,NX).GT.0.0.OR.FLQGM(NY,NX).GT.0.0.OR. - 2(PRECR(NY,NX).GT.0.0.AND.VHCPW(NY,NX).GT.VHCPWX(NY,NX)))THEN - CO2W(NY,NX)=CO2W(NY,NX)+XCOBLS(NY,NX) - CH4W(NY,NX)=CH4W(NY,NX)+XCHBLS(NY,NX) - OXYW(NY,NX)=OXYW(NY,NX)+XOXBLS(NY,NX) - ZNGW(NY,NX)=ZNGW(NY,NX)+XNGBLS(NY,NX) - ZN2W(NY,NX)=ZN2W(NY,NX)+XN2BLS(NY,NX) - H2GW(NY,NX)=H2GW(NY,NX)+XHGBLS(NY,NX) - ZN4W(NY,NX)=ZN4W(NY,NX)+XN4BLW(NY,NX) - ZN3W(NY,NX)=ZN3W(NY,NX)+XN3BLW(NY,NX) - ZNOW(NY,NX)=ZNOW(NY,NX)+XNOBLW(NY,NX) - ZHPW(NY,NX)=ZHPW(NY,NX)+XH2PBS(NY,NX) - IF(ISALT(NY,NX).NE.0)THEN - ZALW(NY,NX)=ZALW(NY,NX)+XALBLS(NY,NX) - ZFEW(NY,NX)=ZFEW(NY,NX)+XFEBLS(NY,NX) - ZHYW(NY,NX)=ZHYW(NY,NX)+XHYBLS(NY,NX) - ZCAW(NY,NX)=ZCAW(NY,NX)+XCABLS(NY,NX) - ZMGW(NY,NX)=ZMGW(NY,NX)+XMGBLS(NY,NX) - ZNAW(NY,NX)=ZNAW(NY,NX)+XNABLS(NY,NX) - ZKAW(NY,NX)=ZKAW(NY,NX)+XKABLS(NY,NX) - ZOHW(NY,NX)=ZOHW(NY,NX)+XOHBLS(NY,NX) - ZSO4W(NY,NX)=ZSO4W(NY,NX)+XSOBLS(NY,NX) - ZCLW(NY,NX)=ZCLW(NY,NX)+XCLBLS(NY,NX) - ZCO3W(NY,NX)=ZCO3W(NY,NX)+XC3BLS(NY,NX) - ZHCO3W(NY,NX)=ZHCO3W(NY,NX)+XHCBLS(NY,NX) - ZALH1W(NY,NX)=ZALH1W(NY,NX)+XAL1BS(NY,NX) - ZALH2W(NY,NX)=ZALH2W(NY,NX)+XAL2BS(NY,NX) - ZALH3W(NY,NX)=ZALH3W(NY,NX)+XAL3BS(NY,NX) - ZALH4W(NY,NX)=ZALH4W(NY,NX)+XAL4BS(NY,NX) - ZALSW(NY,NX)=ZALSW(NY,NX)+XALSBS(NY,NX) - ZFEH1W(NY,NX)=ZFEH1W(NY,NX)+XFE1BS(NY,NX) - ZFEH2W(NY,NX)=ZFEH2W(NY,NX)+XFE2BS(NY,NX) - ZFEH3W(NY,NX)=ZFEH3W(NY,NX)+XFE3BS(NY,NX) - ZFEH4W(NY,NX)=ZFEH4W(NY,NX)+XFE4BS(NY,NX) - ZFESW(NY,NX)=ZFESW(NY,NX)+XFESBS(NY,NX) - ZCAOW(NY,NX)=ZCAOW(NY,NX)+XCAOBS(NY,NX) - ZCACW(NY,NX)=ZCACW(NY,NX)+XCACBS(NY,NX) - ZCAHW(NY,NX)=ZCAHW(NY,NX)+XCAHBS(NY,NX) - ZCASW(NY,NX)=ZCASW(NY,NX)+XCASBS(NY,NX) - ZMGOW(NY,NX)=ZMGOW(NY,NX)+XMGOBS(NY,NX) - ZMGCW(NY,NX)=ZMGCW(NY,NX)+XMGCBS(NY,NX) - ZMGHW(NY,NX)=ZMGHW(NY,NX)+XMGHBS(NY,NX) - ZMGSW(NY,NX)=ZMGSW(NY,NX)+XMGSBS(NY,NX) - ZNACW(NY,NX)=ZNACW(NY,NX)+XNACBS(NY,NX) - ZNASW(NY,NX)=ZNASW(NY,NX)+XNASBS(NY,NX) - ZKASW(NY,NX)=ZKASW(NY,NX)+XKASBS(NY,NX) - H0PO4W(NY,NX)=H0PO4W(NY,NX)+XH0PBS(NY,NX) - H1PO4W(NY,NX)=H1PO4W(NY,NX)+XH1PBS(NY,NX) - H3PO4W(NY,NX)=H3PO4W(NY,NX)+XH3PBS(NY,NX) - ZFE1PW(NY,NX)=ZFE1PW(NY,NX)+XF1PBS(NY,NX) - ZFE2PW(NY,NX)=ZFE2PW(NY,NX)+XF2PBS(NY,NX) - ZCA0PW(NY,NX)=ZCA0PW(NY,NX)+XC0PBS(NY,NX) - ZCA1PW(NY,NX)=ZCA1PW(NY,NX)+XC1PBS(NY,NX) - ZCA2PW(NY,NX)=ZCA2PW(NY,NX)+XC2PBS(NY,NX) - ZMG1PW(NY,NX)=ZMG1PW(NY,NX)+XM1PBS(NY,NX) - ENDIF - ENDIF -C -C CALCULATE SNOWPACK TEMPERATURE FROM ITS CHANGE -C IN HEAT STORAGE -C - VHCPW(NY,NX)=2.095*VOLSS(NY,NX)+4.19*VOLWS(NY,NX) - 2+1.9274*VOLIS(NY,NX) -C VHCPX=VHCPW(NY,NX) - VOLSS(NY,NX)=VOLSS(NY,NX)+TFLWS(NY,NX)+TQS(NY,NX) - VOLWS(NY,NX)=VOLWS(NY,NX)+TFLWW(NY,NX)+TQW(NY,NX) - VOLIS(NY,NX)=VOLIS(NY,NX)+TFLWI(NY,NX)+TQI(NY,NX) - DENSS=AMIN1(0.6,DENS0(NY,NX)+DENS1(NY,NX)*VOLSS(NY,NX) - 2/AREA(3,NU(NY,NX),NY,NX)) - VOLS(NY,NX)=VOLSS(NY,NX)/DENSS+VOLWS(NY,NX)+VOLIS(NY,NX) - ENGYW=VHCPW(NY,NX)*TKW(NY,NX) - VHCPW(NY,NX)=2.095*VOLSS(NY,NX)+4.19*VOLWS(NY,NX) - 2+1.9274*VOLIS(NY,NX) - DPTHS(NY,NX)=AMAX1(0.0,VOLS(NY,NX))/AREA(3,NU(NY,NX),NY,NX) - IF(VHCPW(NY,NX).GT.VHCPWX(NY,NX))THEN - TKW(NY,NX)=(ENGYW+THFLWW(NY,NX)+THQS(NY,NX))/VHCPW(NY,NX) - ELSEIF(VHCPW(NY,NX).GT.ZEROS(NY,NX))THEN - TKWX=(ENGYW+THFLWW(NY,NX)+THQS(NY,NX))/VHCPW(NY,NX) - HFLXW=VHCPW(NY,NX)*(TKWX-TKA(NY,NX)) - HEATOU=HEATOU+HFLXW - TKW(NY,NX)=TKA(NY,NX) - ELSE - TKW(NY,NX)=TKA(NY,NX) - ENDIF - TCW(NY,NX)=TKW(NY,NX)-273.15 -C IF(NX.EQ.2.AND.NY.EQ.2)THEN -C WRITE(*,8483)'TKWH',I,J,NX,NY,TKW(NY,NX),ENGYW,THFLWW(NY,NX) -C 2,THQS(NY,NX),VHCPW(NY,NX),VHCPX,VOLSS(NY,NX),VOLWS(NY,NX) -C 2,VOLIS(NY,NX),TFLWS(NY,NX),TQS(NY,NX),TFLWW(NY,NX),TQW(NY,NX) -C 3,TFLWI(NY,NX),TQI(NY,NX),VOLS(NY,NX) -8483 FORMAT(A8,4I4,20E12.4) -C ENDIF -C -C SNOWPACK VARIABLES NEEDED FOR WATER, C, N, P, O, SOLUTE AND -C ENERGY BALANCES INCLUDING SUM OF ALL CURRENT STATE VARIABLES, -C CUMULATIVE SUMS OF ALL ADDITIONS AND REMOVALS SINCE START OF RUN -C -C IF(J.EQ.24)THEN - WS=VOLSS(NY,NX)+VOLWS(NY,NX)+VOLIS(NY,NX)*0.92 - VOLWSO=VOLWSO+WS - UVOLW(NY,NX)=UVOLW(NY,NX)+WS - HEATSO=HEATSO+VHCPW(NY,NX)*TKW(NY,NX) - TLCO2G=TLCO2G+CO2W(NY,NX)+CH4W(NY,NX) - UCO2S(NY,NX)=UCO2S(NY,NX)+CO2W(NY,NX)+CH4W(NY,NX) - OXYGSO=OXYGSO+OXYW(NY,NX) - TLN2G=TLN2G+ZNGW(NY,NX)+ZN2W(NY,NX) - TLNH4=TLNH4+ZN4W(NY,NX)+ZN3W(NY,NX) - TLNO3=TLNO3+ZNOW(NY,NX) - TLPO4=TLPO4+ZHPW(NY,NX) - TW=ZALW(NY,NX)+ZFEW(NY,NX)+ZHYW(NY,NX)+ZCAW(NY,NX) - 2+ZMGW(NY,NX)+ZNAW(NY,NX)+ZKAW(NY,NX)+ZOHW(NY,NX) - 3+ZSO4W(NY,NX)+ZCLW(NY,NX)+ZCO3W(NY,NX)+H0PO4W(NY,NX) - 4+2.0*(ZHCO3W(NY,NX)+ZALH1W(NY,NX) - 5+ZALSW(NY,NX)+ZFEH1W(NY,NX)+ZFESW(NY,NX)+ZCAOW(NY,NX) - 6+ZCACW(NY,NX)+ZCASW(NY,NX)+ZMGOW(NY,NX)+ZMGCW(NY,NX) - 7+ZMGSW(NY,NX)+ZNACW(NY,NX)+ZNASW(NY,NX)+ZKASW(NY,NX) - 8+H1PO4W(NY,NX)+ZCA0PW(NY,NX)) - 9+3.0*(ZALH2W(NY,NX)+ZFEH2W(NY,NX)+ZCAHW(NY,NX) - 1+ZMGHW(NY,NX)+ZFE1PW(NY,NX)+ZCA1PW(NY,NX)+ZMG1PW(NY,NX)) - 2+4.0*(ZALH3W(NY,NX)+ZFEH3W(NY,NX)+H3PO4W(NY,NX)+ZFE2PW(NY,NX) - 4+ZCA2PW(NY,NX))+5.0*(ZALH4W(NY,NX)+ZFEH4W(NY,NX))+H2GW(NY,NX) - TION=TION+TW -C ENDIF -C -C ADD ABOVE-GROUND LITTERFALL FROM 'EXTRACT' TO SURFACE RESIDUE -C - OSGX=ORGC(0,NY,NX) -C -C ADD PLANT C,N,P IN ABOVE-GROUND LITTERFALL TO C,N,P -C IN SURFACE RESIDUE -C - DO 6965 K=0,1 - DO 6965 M=1,4 - OSC(M,K,0,NY,NX)=OSC(M,K,0,NY,NX)+CSNT(M,K,0,NY,NX) - OSN(M,K,0,NY,NX)=OSN(M,K,0,NY,NX)+ZSNT(M,K,0,NY,NX) - OSP(M,K,0,NY,NX)=OSP(M,K,0,NY,NX)+PSNT(M,K,0,NY,NX) -C IF((I/30)*30.EQ.I.AND.J.EQ.15)THEN -C WRITE(*,8486)'OSC0',I,J,L,K,M,OSC(M,K,0,NY,NX) -C 2,OSN(M,K,0,NY,NX),OSP(M,K,0,NY,NX),CSNT(M,K,0,NY,NX) -C 3,ZSNT(M,K,0,NY,NX),PSNT(M,K,0,NY,NX) -8486 FORMAT(A8,5I4,12E12.4) -C ENDIF -6965 CONTINUE -C -C GAS AND SOLUTE EXCHANGE WITHIN SURFACE RESIDUE ADDED TO ECOSYSTEM -C TOTALS FOR CALCULATING COMPETITION CONSTRAINTS ON MICROBIAL -C AND ROOT POPULATIONS -C - DO 8990 K=0,5 - IF(K.NE.3.AND.K.NE.4)THEN - DO 8980 N=1,7 - ROXYX(0,NY,NX)=ROXYX(0,NY,NX)+ROXYS(N,K,0,NY,NX) - RNH4X(0,NY,NX)=RNH4X(0,NY,NX)+RVMX4(N,K,0,NY,NX) - RNO3X(0,NY,NX)=RNO3X(0,NY,NX)+RVMX3(N,K,0,NY,NX) - RNO2X(0,NY,NX)=RNO2X(0,NY,NX)+RVMX2(N,K,0,NY,NX) - RN2OX(0,NY,NX)=RN2OX(0,NY,NX)+RVMX1(N,K,0,NY,NX) - RNH4X(0,NY,NX)=RNH4X(0,NY,NX)+RINHO(N,K,0,NY,NX) - RNO3X(0,NY,NX)=RNO3X(0,NY,NX)+RINOO(N,K,0,NY,NX) - RPO4X(0,NY,NX)=RPO4X(0,NY,NX)+RIPOO(N,K,0,NY,NX) - RNH4X(NU(NY,NX),NY,NX)=RNH4X(NU(NY,NX),NY,NX)+RINHOR(N,K,NY,NX) - RNO3X(NU(NY,NX),NY,NX)=RNO3X(NU(NY,NX),NY,NX)+RINOOR(N,K,NY,NX) - RPO4X(NU(NY,NX),NY,NX)=RPO4X(NU(NY,NX),NY,NX)+RIPOOR(N,K,NY,NX) - IF(K.LE.4)THEN - ROQCX(K,0,NY,NX)=ROQCX(K,0,NY,NX)+ROQCS(N,K,0,NY,NX) - ROQAX(K,0,NY,NX)=ROQAX(K,0,NY,NX)+ROQAS(N,K,0,NY,NX) - ENDIF -8980 CONTINUE - ENDIF -8990 CONTINUE - RNO2X(0,NY,NX)=RNO2X(0,NY,NX)+RVMXC(0,NY,NX) -C -C ADD RESIDUE C,N,P TO SUBSURFACE SEDIMENT BELOW A POND SURFACE -C - IF(BKDS(NU(NY,NX),NY,NX).EQ.0.0.AND.ORGC(0,NY,NX).GT.0.0)THEN - OSGX=ORGC(0,NY,NX) - RC=0.0 - RN=0.0 - RP=0.0 - DO 1970 K=0,5 - IF(K.NE.3.AND.K.NE.4)THEN -C -C MICROBIAL C,N,P -C - DO 1960 N=1,7 - DO 1960 M=1,3 - OMC(M,N,K,NW(NY,NX),NY,NX)=OMC(M,N,K,NW(NY,NX),NY,NX) - 2+OMC(M,N,K,0,NY,NX) - OMN(M,N,K,NW(NY,NX),NY,NX)=OMN(M,N,K,NW(NY,NX),NY,NX) - 2+OMN(M,N,K,0,NY,NX) - OMP(M,N,K,NW(NY,NX),NY,NX)=OMP(M,N,K,NW(NY,NX),NY,NX) - 2+OMP(M,N,K,0,NY,NX) - RC=RC+OMC(M,N,K,0,NY,NX) - RN=RN+OMN(M,N,K,0,NY,NX) - RP=RP+OMP(M,N,K,0,NY,NX) - OMC(M,N,K,0,NY,NX)=0.0 - OMN(M,N,K,0,NY,NX)=0.0 - OMP(M,N,K,0,NY,NX)=0.0 -1960 CONTINUE - ENDIF -1970 CONTINUE -C -C MICROBIAL RESIDUE C,N,P -C - DO 1900 K=0,2 - DO 1940 M=1,2 - ORC(M,K,NW(NY,NX),NY,NX)=ORC(M,K,NW(NY,NX),NY,NX)+ORC(M,K,0,NY,NX) - ORN(M,K,NW(NY,NX),NY,NX)=ORN(M,K,NW(NY,NX),NY,NX)+ORN(M,K,0,NY,NX) - ORP(M,K,NW(NY,NX),NY,NX)=ORP(M,K,NW(NY,NX),NY,NX)+ORP(M,K,0,NY,NX) - RC=RC+ORC(M,K,0,NY,NX) - RN=RN+ORN(M,K,0,NY,NX) - RP=RP+ORP(M,K,0,NY,NX) - ORC(M,K,0,NY,NX)=0.0 - ORN(M,K,0,NY,NX)=0.0 - ORP(M,K,0,NY,NX)=0.0 -1940 CONTINUE -C -C DOC, DON, DOP -C - OQC(K,NW(NY,NX),NY,NX)=OQC(K,NW(NY,NX),NY,NX)+OQC(K,0,NY,NX) - OQN(K,NW(NY,NX),NY,NX)=OQN(K,NW(NY,NX),NY,NX)+OQN(K,0,NY,NX) - OQP(K,NW(NY,NX),NY,NX)=OQP(K,NW(NY,NX),NY,NX)+OQP(K,0,NY,NX) - OQA(K,NW(NY,NX),NY,NX)=OQA(K,NW(NY,NX),NY,NX)+OQA(K,0,NY,NX) - RC=RC+OQC(K,0,NY,NX)+OQA(K,0,NY,NX) - RN=RN+OQN(K,0,NY,NX) - RP=RP+OQP(K,0,NY,NX) - OQC(K,0,NY,NX)=0.0 - OQN(K,0,NY,NX)=0.0 - OQP(K,0,NY,NX)=0.0 - OQA(K,0,NY,NX)=0.0 - OQCH(K,NW(NY,NX),NY,NX)=OQCH(K,NW(NY,NX),NY,NX)+OQCH(K,0,NY,NX) - OQNH(K,NW(NY,NX),NY,NX)=OQNH(K,NW(NY,NX),NY,NX)+OQNH(K,0,NY,NX) - OQPH(K,NW(NY,NX),NY,NX)=OQPH(K,NW(NY,NX),NY,NX)+OQPH(K,0,NY,NX) - OQAH(K,NW(NY,NX),NY,NX)=OQAH(K,NW(NY,NX),NY,NX)+OQAH(K,0,NY,NX) - RC=RC+OQCH(K,0,NY,NX)+OQAH(K,0,NY,NX) - RN=RN+OQNH(K,0,NY,NX) - RP=RP+OQPH(K,0,NY,NX) - OQCH(K,0,NY,NX)=0.0 - OQNH(K,0,NY,NX)=0.0 - OQPH(K,0,NY,NX)=0.0 - OQAH(K,0,NY,NX)=0.0 -C -C ADSORBED C,N,P -C - OHC(K,NW(NY,NX),NY,NX)=OHC(K,NW(NY,NX),NY,NX)+OHC(K,0,NY,NX) - OHN(K,NW(NY,NX),NY,NX)=OHN(K,NW(NY,NX),NY,NX)+OHN(K,0,NY,NX) - OHP(K,NW(NY,NX),NY,NX)=OHP(K,NW(NY,NX),NY,NX)+OHP(K,0,NY,NX) - OHA(K,NW(NY,NX),NY,NX)=OHA(K,NW(NY,NX),NY,NX)+OHA(K,0,NY,NX) - RC=RC+OHC(K,0,NY,NX)+OHA(K,0,NY,NX) - RN=RN+OHN(K,0,NY,NX) - RP=RP+OHP(K,0,NY,NX) - OHC(K,0,NY,NX)=0.0 - OHN(K,0,NY,NX)=0.0 - OHP(K,0,NY,NX)=0.0 - OHA(K,0,NY,NX)=0.0 -C -C PLANT RESIDUE C,N,P -C - DO 1930 M=1,4 - OSC(M,K,NW(NY,NX),NY,NX)=OSC(M,K,NW(NY,NX),NY,NX)+OSC(M,K,0,NY,NX) - OSA(M,K,NW(NY,NX),NY,NX)=OSA(M,K,NW(NY,NX),NY,NX)+OSA(M,K,0,NY,NX) - OSN(M,K,NW(NY,NX),NY,NX)=OSN(M,K,NW(NY,NX),NY,NX)+OSN(M,K,0,NY,NX) - OSP(M,K,NW(NY,NX),NY,NX)=OSP(M,K,NW(NY,NX),NY,NX)+OSP(M,K,0,NY,NX) - RC=RC+OSC(M,K,0,NY,NX) - RN=RN+OSN(M,K,0,NY,NX) - RP=RP+OSP(M,K,0,NY,NX) - OSC(M,K,0,NY,NX)=0.0 - OSA(M,K,0,NY,NX)=0.0 - OSN(M,K,0,NY,NX)=0.0 - OSP(M,K,0,NY,NX)=0.0 -1930 CONTINUE -1900 CONTINUE - TLRSDC=TLRSDC-RC - TLRSDN=TLRSDN-RN - TLRSDP=TLRSDP-RP - URSDC(NY,NX)=URSDC(NY,NX)-RC - URSDN(NY,NX)=URSDN(NY,NX)-RN - URSDP(NY,NX)=URSDP(NY,NX)-RP - ORGC(0,NY,NX)=0.0 - ORGN(0,NY,NX)=0.0 - ORGR(0,NY,NX)=0.0 -C -C ADD RESIDUE SOLUTES TO SUBSURFACE SEDIMENT BELOW A POND SURFACE -C -C CO2S(NW(NY,NX),NY,NX)=CO2S(NW(NY,NX),NY,NX)+CO2S(0,NY,NX) -C CH4S(NW(NY,NX),NY,NX)=CH4S(NW(NY,NX),NY,NX)+CH4S(0,NY,NX) -C OXYS(NW(NY,NX),NY,NX)=OXYS(NW(NY,NX),NY,NX)+OXYS(0,NY,NX) -C Z2GS(NW(NY,NX),NY,NX)=Z2GS(NW(NY,NX),NY,NX)+Z2GS(0,NY,NX) -C Z2OS(NW(NY,NX),NY,NX)=Z2OS(NW(NY,NX),NY,NX)+Z2OS(0,NY,NX) -C H2GS(NW(NY,NX),NY,NX)=H2GS(NW(NY,NX),NY,NX)+H2GS(0,NY,NX) -C ZNH4S(NW(NY,NX),NY,NX)=ZNH4S(NW(NY,NX),NY,NX)+ZNH4S(0,NY,NX) -C ZNH3S(NW(NY,NX),NY,NX)=ZNH3S(NW(NY,NX),NY,NX)+ZNH3S(0,NY,NX) -C ZNO3S(NW(NY,NX),NY,NX)=ZNO3S(NW(NY,NX),NY,NX)+ZNO3S(0,NY,NX) -C H2PO4(NW(NY,NX),NY,NX)=H2PO4(NW(NY,NX),NY,NX)+H2PO4(0,NY,NX) -C ZNO2S(NW(NY,NX),NY,NX)=ZNO2S(NW(NY,NX),NY,NX)+ZNO2S(0,NY,NX) -C CS=CO2S(0,NY,NX)+CH4S(0,NY,NX) -C TLCO2G=TLCO2G-CS -C UCO2S(NY,NX)=UCO2S(NY,NX)-CS -C OS=OXYS(0,NY,NX) -C OXYGSO=OXYGSO-OS -C ZG=Z2GS(0,NY,NX)+Z2OS(0,NY,NX) -C TLN2G=TLN2G-ZG -C ZNH=ZNH4S(0,NY,NX)+ZNH3S(0,NY,NX) -C TLNH4=TLNH4-ZNH -C UNH4(NY,NX)=UNH4(NY,NX)-ZNH -C ZNO=ZNO3S(0,NY,NX)+ZNO2S(0,NY,NX) -C TLNO3=TLNO3-ZNO -C UNO3(NY,NX)=UNO3(NY,NX)-ZNO -C P4=H2PO4(0,NY,NX) -C TLPO4=TLPO4-P4 -C UPO4(NY,NX)=UPO4(NY,NX)-P4 -C CO2S(0,NY,NX)=0.0 -C CH4S(0,NY,NX)=0.0 -C OXYS(0,NY,NX)=0.0 -C Z2GS(0,NY,NX)=0.0 -C Z2OS(0,NY,NX)=0.0 -C H2GS(0,NY,NX)=0.0 -C ZNH4S(0,NY,NX)=0.0 -C ZNH3S(0,NY,NX)=0.0 -C ZNO3S(0,NY,NX)=0.0 -C H2PO4(0,NY,NX)=0.0 -C ZNO2S(0,NY,NX)=0.0 - ENDIF -C -C RUNOFF AND SUBSURFACE BOUNDARY FLUXES -C - DO 9985 L=NU(NY,NX),NL(NY,NX) -C -C LOCATE EXTERNAL BOUNDARIES -C - DO 9980 N=1,3 - DO 9975 NN=1,2 - IF(N.EQ.1)THEN - IF(NN.EQ.1)THEN - IF(NX.EQ.NHE)THEN - N4=NX+1 - N5=NY - N6=L - XN=-1.0 - ELSE - GO TO 9975 - ENDIF - ELSEIF(NN.EQ.2)THEN - IF(NX.EQ.NHW)THEN - N4=NX - N5=NY - N6=L - XN=1.0 - ELSE - GO TO 9975 - ENDIF - ENDIF - ELSEIF(N.EQ.2)THEN - IF(NN.EQ.1)THEN - IF(NY.EQ.NVS)THEN - N4=NX - N5=NY+1 - N6=L - XN=-1.0 - ELSE - GO TO 9975 - ENDIF - ELSEIF(NN.EQ.2)THEN - IF(NY.EQ.NVN)THEN - N4=NX - N5=NY - N6=L - XN=1.0 - ELSE - GO TO 9975 - ENDIF - ENDIF - ELSEIF(N.EQ.3)THEN - IF(NN.EQ.1)THEN - IF(L.EQ.NL(NY,NX))THEN - N4=NX - N5=NY - N6=L+1 - XN=-1.0 - ELSE - GO TO 9975 - ENDIF - ELSEIF(NN.EQ.2)THEN - GO TO 9975 - ENDIF - ENDIF -C -C RUNOFF BOUNDARY FLUXES OF WATER AND HEAT -C - IF(L.EQ.NU(NY,NX).AND.N.NE.3)THEN - WQ=XN*(QR(N,N5,N4)+QS(N,N5,N4)+QW(N,N5,N4)+QI(N,N5,N4)) - IF(WQ.NE.0.0)THEN - CRUN=CRUN-WQ - URUN(NY,NX)=URUN(NY,NX)-WQ - HEATOU=HEATOU-XN*(HQR(N,N5,N4)+HQS(N,N5,N4)) -C -C RUNOFF BOUNDARY FLUXES OF c, n AND p -C - CX=XN*(XCOQRS(N,N5,N4)+XCHQRS(N,N5,N4) - 2+XCOQSS(N,N5,N4)+XCHQSS(N,N5,N4)) - CQ=0.0 - DO 2575 K=0,4 - CQ=CQ+XN*(XOCQRS(K,N,N5,N4)+XOAQRS(K,N,N5,N4)) -2575 CONTINUE - TCOU=TCOU-CQ-CX - TNBP(NY,NX)=TNBP(NY,NX)+CQ+CX - UDOCQ(NY,NX)=UDOCQ(NY,NX)-CQ - UDICQ(NY,NX)=UDICQ(NY,NX)-CX - OX=XN*(XOXQRS(N,N5,N4)+XOXQSS(N,N5,N4)) - OXYGOU=OXYGOU-OX - ZX=XN*(XN4QRW(N,N5,N4)+XN3QRW(N,N5,N4) - 2+XNOQRW(N,N5,N4)+XNXQRS(N,N5,N4)+XN4QSS(N,N5,N4) - 3+XN3QSS(N,N5,N4)+XNOQSS(N,N5,N4)) - ZG=XN*(XN2QRS(N,N5,N4)+XNGQRS(N,N5,N4) - 2+XN2QSS(N,N5,N4)+XNGQSS(N,N5,N4)) - ZQ=0.0 - DO 2875 K=0,4 - ZQ=ZQ+XN*XONQRS(K,N,N5,N4) -2875 CONTINUE - TZOU=TZOU-ZQ-ZX-ZG - UDONQ(NY,NX)=UDONQ(NY,NX)-ZQ - UDINQ(NY,NX)=UDINQ(NY,NX)-ZX - PX=XN*(XP4QRW(N,N5,N4)+XP4QSS(N,N5,N4)) - PQ=0.0 - DO 2775 K=0,4 - PQ=PQ+XN*XOPQRS(K,N,N5,N4) -2775 CONTINUE - TPOU=TPOU-PQ-PX - UDOPQ(NY,NX)=UDOPQ(NY,NX)-PQ - UDIPQ(NY,NX)=UDIPQ(NY,NX)-PX -C -C RUNOFF BOUNDARY FLUXES OF SOLUTES -C - SQ1=XN*(XQRAL(N,N5,N4)+XQRFE(N,N5,N4)+XQRHY(N,N5,N4) - 2+XQRCA(N,N5,N4)+XQRMG(N,N5,N4)+XQRNA(N,N5,N4)+XQRKA(N,N5,N4) - 3+XQROH(N,N5,N4)+XQRSO(N,N5,N4)+XQRCL(N,N5,N4)+XQRC3(N,N5,N4) - 4+XQRH0P(N,N5,N4)+XHGQRS(N,N5,N4)+XQSAL(N,N5,N4)+XQSFE(N,N5,N4) - 5+XQSHY(N,N5,N4)+XQSCA(N,N5,N4)+XQSMG(N,N5,N4)+XQSNA(N,N5,N4) - 6+XQSKA(N,N5,N4)+XQSOH(N,N5,N4)+XQSSO(N,N5,N4)+XQSCL(N,N5,N4) - 3+XQSC3(N,N5,N4)+XQSH0P(N,N5,N4)) - SQ2=XN*2.0*(XQRHC(N,N5,N4)+XQRAL1(N,N5,N4)+XQRALS(N,N5,N4) - 2+XQRFE1(N,N5,N4)+XQRFES(N,N5,N4)+XQRCAO(N,N5,N4)+XQRCAC(N,N5,N4) - 3+XQRCAS(N,N5,N4)+XQRMGO(N,N5,N4)+XQRMGC(N,N5,N4)+XQRMGS(N,N5,N4) - 4+XQRNAC(N,N5,N4)+XQRNAS(N,N5,N4)+XQRKAS(N,N5,N4)+XQRH1P(N,N5,N4) - 5+XQRC0P(N,N5,N4)+XQSHC(N,N5,N4)+XQSAL1(N,N5,N4)+XQSALS(N,N5,N4) - 2+XQSFE1(N,N5,N4)+XQSFES(N,N5,N4)+XQSCAO(N,N5,N4)+XQSCAC(N,N5,N4) - 3+XQSCAS(N,N5,N4)+XQSMGO(N,N5,N4)+XQSMGC(N,N5,N4)+XQSMGS(N,N5,N4) - 4+XQSNAC(N,N5,N4)+XQSNAS(N,N5,N4)+XQSKAS(N,N5,N4)+XQSH1P(N,N5,N4) - 5+XQSC0P(N,N5,N4)) - SQ3=XN*3.0*(XQRAL2(N,N5,N4)+XQRFE2(N,N5,N4)+XQRCAH(N,N5,N4) - 2+XQRMGH(N,N5,N4)+XQRF1P(N,N5,N4)+XQRC1P(N,N5,N4)+XQRM1P(N,N5,N4) - 3+XQSAL2(N,N5,N4)+XQSFE2(N,N5,N4)+XQSCAH(N,N5,N4)+XQSMGH(N,N5,N4) - 2+XQSF1P(N,N5,N4)+XQSC1P(N,N5,N4)+XQSM1P(N,N5,N4)) - SQ4=XN*4.0*(XQRAL3(N,N5,N4)+XQRFE3(N,N5,N4)+XQRH3P(N,N5,N4) - 2+XQRF2P(N,N5,N4)+XQRC2P(N,N5,N4)+XQSAL3(N,N5,N4)+XQSFE3(N,N5,N4) - 3+XQSH3P(N,N5,N4)+XQSF2P(N,N5,N4)+XQSC2P(N,N5,N4)) - 5+XN*5.0*(XQRAL4(N,N5,N4)+XQRFE4(N,N5,N4) - 6+XQSAL4(N,N5,N4)+XQSFE4(N,N5,N4)) - SQ=SQ1+SQ2+SQ3+SQ4 - TIONOU=TIONOU-SQ - UIONOU(NY,NX)=UIONOU(NY,NX)-SQ -C -C SURFACE FLUX ELECTRICAL CONDUCTIVITY -C - WX=QR(N,N5,N4) - IF(WX.NE.0.0)THEN - ECHY=0.337*AMAX1(0.0,XQRHY(N,N5,N4)/WX) - ECOH=0.192*AMAX1(0.0,XQROH(N,N5,N4)/WX) - ECAL=0.056*AMAX1(0.0,XQRAL(N,N5,N4)*3.0/WX) - ECFE=0.051*AMAX1(0.0,XQRFE(N,N5,N4)*3.0/WX) - ECCA=0.060*AMAX1(0.0,XQRCA(N,N5,N4)*2.0/WX) - ECMG=0.053*AMAX1(0.0,XQRMG(N,N5,N4)*2.0/WX) - ECNA=0.050*AMAX1(0.0,XQRNA(N,N5,N4)/WX) - ECKA=0.070*AMAX1(0.0,XQRKA(N,N5,N4)/WX) - ECCO=0.072*AMAX1(0.0,XQRC3(N,N5,N4)*2.0/WX) - ECHC=0.044*AMAX1(0.0,XQRHC(N,N5,N4)/WX) - ECSO=0.080*AMAX1(0.0,XQRSO(N,N5,N4)*2.0/WX) - ECCL=0.076*AMAX1(0.0,XQRCL(N,N5,N4)/WX) - ECNO=0.071*AMAX1(0.0,XNOQRW(N,N5,N4)/(WX*14.0)) - ECNDQ=ECHY+ECOH+ECAL+ECFE+ECCA+ECMG+ECNA+ECKA - 2+ECCO+ECHC+ECSO+ECCL+ECNO -C WRITE(*,9991)'ECNDQ',IYRC,I,J,N4,N5,N6,N,WX,ECNDQ -9991 FORMAT(A8,7I4,2E12.4) - ELSE - ECNDQ=0.0 - ENDIF -C -C RUNOFF BOUNDARY FLUXES OF SEDIMENT -C - IF(IERSN(N5,N4).NE.0)THEN - ER=XN*(XSANER(N,N5,N4)+XSILER(N,N5,N4)+XCLAER(N,N5,N4)) - TSEDOU=TSEDOU-ER - USEDOU(NY,NX)=USEDOU(NY,NX)-ER -C -C MICROBIAL C IN RUNOFF SEDIMENT -C - CQ=0.0 - DO 3580 K=0,5 - DO 3580 NO=1,7 - DO 3580 M=1,3 - CQ=CQ+XN*OMCER(M,NO,K,N,N5,N4) -3580 CONTINUE -C -C MICROBIAL RESIDUE C IN RUNOFF SEDIMENT -C - DO 3575 K=0,4 - DO 3570 M=1,2 - CQ=CQ+XN*ORCER(M,K,N,N5,N4) -3570 CONTINUE -C -C DOC, ADSORBED AND HUMUS C IN RUNOFF SEDIMENT -C - CQ=CQ+XN*OHCER(K,N,N5,N4) - DO 3565 M=1,4 - CQ=CQ+XN*OSCER(M,K,N,N5,N4) -3565 CONTINUE -3575 CONTINUE - TCOU=TCOU-CQ-CX - UDOCQ(NY,NX)=UDOCQ(NY,NX)-CQ - UDICQ(NY,NX)=UDICQ(NY,NX)-CX - TSEDOU=TSEDOU-CQ*1.0E-06 - USEDOU(NY,NX)=USEDOU(NY,NX)-CQ*1.0E-06 - TNBP(NY,NX)=TNBP(NY,NX)+CQ+CX -C -C MICROBIAL N IN RUNOFF SEDIMENT -C - ZQ=0.0 - DO 6880 K=0,5 - DO 6880 NO=1,7 - DO 6880 M=1,2 - ZQ=ZQ+XN*OMNER(M,NO,K,N,N5,N4) -6880 CONTINUE -C -C MICROBIAL RESIDUE N IN RUNOFF SEDIMENT -C - DO 6875 K=0,4 - DO 6870 M=1,2 - ZQ=ZQ+XN*ORNER(M,K,N,N5,N4) -6870 CONTINUE -C -C DON, ADSORBED AND HUMUS N IN RUNOFF SEDIMENT -C - ZQ=ZQ+XN*OHNER(K,N,N5,N4) - DO 6865 M=1,4 - ZQ=ZQ+XN*OSNER(M,K,N,N5,N4) -6865 CONTINUE -6875 CONTINUE - TZOU=TZOU-ZQ-ZX-ZG - UDONQ(NY,NX)=UDONQ(NY,NX)-ZQ - UDINQ(NY,NX)=UDINQ(NY,NX)-ZX -C -C MICROBIAL P IN RUNOFF SEDIMENT -C - PQ=0.0 - DO 6780 K=0,5 - DO 6780 NO=1,7 - DO 6780 M=1,2 - PQ=PQ+XN*OMPER(M,NO,K,N,N5,N4) -6780 CONTINUE -C -C MICROBIAL RESIDUE P IN RUNOFF SEDIMENT -C - DO 6775 K=0,4 - DO 6770 M=1,2 - PQ=PQ+XN*ORPER(M,K,N,N5,N4) -6770 CONTINUE -C -C DOP, ADSORBED AND HUMUS P IN RUNOFF SEDIMENT -C - PQ=PQ+XN*OHPER(K,N,N5,N4) - DO 6765 M=1,4 - PQ=PQ+XN*OSPER(M,K,N,N5,N4) -6765 CONTINUE -6775 CONTINUE - TPOU=TPOU-PQ-PX - UDOPQ(NY,NX)=UDOPQ(NY,NX)-PQ - UDIPQ(NY,NX)=UDIPQ(NY,NX)-PX -C -C SOLUTES IN RUNOFF SEDIMENTS -C - SQ1=XN*(XOH0ER(N,N5,N4) - 5+XOH0EB(N,N5,N4)+XHYER(N,N5,N4)+XALER(N,N5,N4)+XCAER(N,N5,N4) - 6+XMGER(N,N5,N4)+XNAER(N,N5,N4)+XKAER(N,N5,N4)+XHCER(N,N5,N4) - 7+XNH3ER(N,N5,N4)+XNHUER(N,N5,N4)+XNO3ER(N,N5,N4)+XNH3EB(N,N5,N4) - 8+XNHUEB(N,N5,N4)+XNO3EB(N,N5,N4)) - SQ2=XN*2.0*(XN4ER(N,N5,N4) - 6+XNBER(N,N5,N4)+XOH1ER(N,N5,N4)+XOH1EB(N,N5,N4)+PCACER(N,N5,N4) - 7+PCASER(N,N5,N4)+PALPER(N,N5,N4)+PFEPER(N,N5,N4)+PALPEB(N,N5,N4) - 8+PFEPEB(N,N5,N4)+XNH4ER(N,N5,N4)+XNH4EB(N,N5,N4)) - SQ3=XN*3.0*(XAL2ER(N,N5,N4) - 4+XOH2ER(N,N5,N4)+XH1PER(N,N5,N4)+XOH2EB(N,N5,N4)+XH1PEB(N,N5,N4) - 5+PCPDER(N,N5,N4)+PCPDEB(N,N5,N4)) - SQ4=XN*4.0*(XH2PER(N,N5,N4)+XH2PEB(N,N5,N4)+PALOER(N,N5,N4) - 4+PFEOER(N,N5,N4)) - 6+XN*7.0*(PCPMER(N,N5,N4)+PCPMEB(N,N5,N4)) - 7+XN*9.0*(PCPHER(N,N5,N4)+PCPHEB(N,N5,N4)) - SQ=SQ1+SQ2+SQ3+SQ4 - TIONOU=TIONOU-SQ - UIONOU(NY,NX)=UIONOU(NY,NX)-SQ - ENDIF - ENDIF - ENDIF -C -C SUBSURFACE BOUNDARY FLUXES OF WATER AND HEAT -C - IF(NCN(NY,NX).NE.3.OR.N.EQ.3)THEN - WO=XN*(FLW(N,N6,N5,N4)+FLWH(N,N6,N5,N4)) - VOLWOU=VOLWOU-WO - HVOLO(NY,NX)=HVOLO(NY,NX)-WO - UVOLO(NY,NX)=UVOLO(NY,NX)-WO - HEATOU=HEATOU-XN*HFLW(N,N6,N5,N4) -C -C SUBSURFACE BOUNDARY FLUXES OF CO2 AND DOC -C - CO=0.0 - DO 450 K=0,4 - CO=CO+XN*(XOCFLS(K,N,N6,N5,N4)+XOAFLS(K,N,N6,N5,N4) - 4+XOCFHS(K,N,N6,N5,N4)+XOAFHS(K,N,N6,N5,N4)) -450 CONTINUE - CX=XN*(XCOFLS(N,N6,N5,N4)+XCOFHS(N,N6,N5,N4) - 2+XCOFLG(N,N6,N5,N4)+XCHFLS(N,N6,N5,N4) - 3+XCHFHS(N,N6,N5,N4)+XCHFLG(N,N6,N5,N4)) - TCOU=TCOU-CO-CX - UDOCD(NY,NX)=UDOCD(NY,NX)-CO - UDICD(NY,NX)=UDICD(NY,NX)-CX - TNBP(NY,NX)=TNBP(NY,NX)+CO+CX -C -C SUBSURFACE BOUNDARY FLUXES OF O2 -C - OO=XN*(XOXFLS(N,N6,N5,N4)+XOXFHS(N,N6,N5,N4)+XOXFLG(N,N6,N5,N4)) - OXYGOU=OXYGOU-OO -C -C SUBSURFACE BOUNDARY FLUXES OF N2O, N2, NH4, NH3, NO3, NO2 AND DON -C - ZO=0.0 - DO 455 K=0,4 - ZO=ZO+XN*(XONFLS(K,N,N6,N5,N4)+XONFHS(K,N,N6,N5,N4)) -455 CONTINUE - ZX=XN*(XN2FLS(N,N6,N5,N4)+XN4FLW(N,N6,N5,N4) - 2+XN3FLW(N,N6,N5,N4)+XNOFLW(N,N6,N5,N4)+XN4FLB(N,N6,N5,N4) - 3+XN3FLB(N,N6,N5,N4)+XNOFLB(N,N6,N5,N4)+XNXFLS(N,N6,N5,N4) - 4+XNXFLB(N,N6,N5,N4)+XN2FHS(N,N6,N5,N4) - 5+XN4FHW(N,N6,N5,N4)+XN3FHW(N,N6,N5,N4)+XNOFHW(N,N6,N5,N4) - 6+XN4FHB(N,N6,N5,N4)+XN3FHB(N,N6,N5,N4)+XNOFHB(N,N6,N5,N4) - 7+XNXFHS(N,N6,N5,N4)+XNXFHB(N,N6,N5,N4)+XN2FLG(N,N6,N5,N4) - 8+XN3FLG(N,N6,N5,N4)) - ZG=XN*(XNGFLS(N,N6,N5,N4)+XNGFLG(N,N6,N5,N4)+XNGFHS(N,N6,N5,N4)) - TZOU=TZOU-ZO-ZX-ZG - UDOND(NY,NX)=UDOND(NY,NX)-ZO - UDIND(NY,NX)=UDIND(NY,NX)-ZX -C -C SUBSURFACE BOUNDARY FLUXES OF PO4 AND DOP -C - PO=0.0 - DO 460 K=0,4 - PO=PO+XN*(XOPFLS(K,N,N6,N5,N4)+XOPFHS(K,N,N6,N5,N4)) -460 CONTINUE - PX=XN*(XH2PFS(N,N6,N5,N4)+XH2BFB(N,N6,N5,N4) - 2+XH2PHS(N,N6,N5,N4)+XH2BHB(N,N6,N5,N4)) - TPOU=TPOU-PO-PX - UDOPD(NY,NX)=UDOPD(NY,NX)-PO - UDIPD(NY,NX)=UDIPD(NY,NX)-PX -C -C SUBSURFACE BOUNDARY FLUXES OF SOLUTES -C - SS=XN*(XALFLS(N,N6,N5,N4)+XFEFLS(N,N6,N5,N4)+XHYFLS(N,N6,N5,N4) - 2+XCAFLS(N,N6,N5,N4)+XMGFLS(N,N6,N5,N4)+XNAFLS(N,N6,N5,N4) - 3+XKAFLS(N,N6,N5,N4)+XOHFLS(N,N6,N5,N4)+XSOFLS(N,N6,N5,N4) - 4+XCLFLS(N,N6,N5,N4)+XC3FLS(N,N6,N5,N4)+XH0PFS(N,N6,N5,N4) - 5+XH0BFB(N,N6,N5,N4)+2.0*(XHCFLS(N,N6,N5,N4)+XAL1FS(N,N6,N5,N4) - 6+XALSFS(N,N6,N5,N4)+XFE1FS(N,N6,N5,N4)+XFESFS(N,N6,N5,N4) - 7+XCAOFS(N,N6,N5,N4)+XCACFS(N,N6,N5,N4) - 8+XCASFS(N,N6,N5,N4)+XMGOFS(N,N6,N5,N4)+XMGCFS(N,N6,N5,N4) - 9+XMGSFS(N,N6,N5,N4)+XNACFS(N,N6,N5,N4)+XNASFS(N,N6,N5,N4) - 1+XKASFS(N,N6,N5,N4)+XH1PFS(N,N6,N5,N4)+XH1BFB(N,N6,N5,N4) - 2+XC0PFS(N,N6,N5,N4)+XC0BFB(N,N6,N5,N4))+3.0*(XAL2FS(N,N6,N5,N4) - 3+XFE2FS(N,N6,N5,N4)+XCAHFS(N,N6,N5,N4)+XMGHFS(N,N6,N5,N4) - 4+XF1PFS(N,N6,N5,N4)+XC1PFS(N,N6,N5,N4)+XM1PFS(N,N6,N5,N4) - 5+XF1BFB(N,N6,N5,N4)+XC1BFB(N,N6,N5,N4)+XM1BFB(N,N6,N5,N4)) - 6+4.0*(XAL3FS(N,N6,N5,N4)+XFE3FS(N,N6,N5,N4)+XH3PFS(N,N6,N5,N4) - 7+XF2PFS(N,N6,N5,N4)+XC2PFS(N,N6,N5,N4)+XH3BFB(N,N6,N5,N4) - 8+XF2BFB(N,N6,N5,N4)+XC2BFB(N,N6,N5,N4)) - 9+5.0*(XAL4FS(N,N6,N5,N4)+XFE4FS(N,N6,N5,N4))+XHGFLS(N,N6,N5,N4) - 1+XHGFLG(N,N6,N5,N4)) - SG=SG+XHGFLS(N,N6,N5,N4)+XHGFLG(N,N6,N5,N4) - SH=XN*(XALFHS(N,N6,N5,N4)+XFEFHS(N,N6,N5,N4)+XHYFHS(N,N6,N5,N4) - 2+XCAFHS(N,N6,N5,N4)+XMGFHS(N,N6,N5,N4)+XNAFHS(N,N6,N5,N4) - 3+XKAFHS(N,N6,N5,N4)+XOHFHS(N,N6,N5,N4)+XSOFHS(N,N6,N5,N4) - 4+XCLFHS(N,N6,N5,N4)+XC3FHS(N,N6,N5,N4)+XH0PHS(N,N6,N5,N4) - 5+XH0BHB(N,N6,N5,N4)+2.0*(XHCFHS(N,N6,N5,N4)+XAL1HS(N,N6,N5,N4) - 6+XALSHS(N,N6,N5,N4)+XFE1HS(N,N6,N5,N4)+XFESHS(N,N6,N5,N4) - 7+XCAOHS(N,N6,N5,N4)+XCACHS(N,N6,N5,N4) - 8+XCASHS(N,N6,N5,N4)+XMGOHS(N,N6,N5,N4)+XMGCHS(N,N6,N5,N4) - 9+XMGSHS(N,N6,N5,N4)+XNACHS(N,N6,N5,N4)+XNASHS(N,N6,N5,N4) - 1+XKASHS(N,N6,N5,N4)+XH1PHS(N,N6,N5,N4)+XH1BHB(N,N6,N5,N4) - 2+XC0PHS(N,N6,N5,N4)+XC0BHB(N,N6,N5,N4))+3.0*(XAL2HS(N,N6,N5,N4) - 3+XFE2HS(N,N6,N5,N4)+XCAHHS(N,N6,N5,N4)+XMGHHS(N,N6,N5,N4) - 4+XF1PHS(N,N6,N5,N4)+XC1PHS(N,N6,N5,N4)+XM1PHS(N,N6,N5,N4) - 5+XF1BHB(N,N6,N5,N4)+XC1BHB(N,N6,N5,N4)+XM1BHB(N,N6,N5,N4)) - 6+4.0*(XAL3HS(N,N6,N5,N4)+XFE3HS(N,N6,N5,N4)+XH3PHS(N,N6,N5,N4) - 7+XF2PHS(N,N6,N5,N4)+XC2PHS(N,N6,N5,N4)+XH3BHB(N,N6,N5,N4) - 8+XF2BHB(N,N6,N5,N4)+XC2BHB(N,N6,N5,N4)) - 9+5.0*(XAL4HS(N,N6,N5,N4)+XAL4HS(N,N6,N5,N4))+XHGFHS(N,N6,N5,N4)) - SO=SS+SH - TIONOU=TIONOU-SO - UIONOU(NY,NX)=UIONOU(NY,NX)-SO -C -C SUBSURFACE FLUX ELECTRICAL CONDUCTIVITY -C - WX=FLW(N,N6,N5,N4)+FLWH(N,N6,N5,N4) - IF(WX.NE.0.0)THEN - ECHY=0.337*AMAX1(0.0,(XHYFLS(N,N6,N5,N4) - 2+XHYFHS(N,N6,N5,N4))/WX) - ECOH=0.192*AMAX1(0.0,(XOHFLS(N,N6,N5,N4) - 2+XOHFHS(N,N6,N5,N4))/WX) - ECAL=0.056*AMAX1(0.0,(XALFLS(N,N6,N5,N4) - 2+XCAFHS(N,N6,N5,N4))*3.0/WX) - ECFE=0.051*AMAX1(0.0,(XFEFLS(N,N6,N5,N4) - 2+XFEFHS(N,N6,N5,N4))*3.0/WX) - ECCA=0.060*AMAX1(0.0,(XCAFLS(N,N6,N5,N4) - 2+XCAFHS(N,N6,N5,N4))*2.0/WX) - ECMG=0.053*AMAX1(0.0,(XMGFLS(N,N6,N5,N4) - 2+XMGFHS(N,N6,N5,N4))*2.0/WX) - ECNA=0.050*AMAX1(0.0,(XNAFLS(N,N6,N5,N4) - 2+XNAFHS(N,N6,N5,N4))/WX) - ECKA=0.070*AMAX1(0.0,(XKAFLS(N,N6,N5,N4) - 2+XKAFHS(N,N6,N5,N4))/WX) - ECCO=0.072*AMAX1(0.0,(XC3FLS(N,N6,N5,N4) - 2+XC3FHS(N,N6,N5,N4))*2.0/WX) - ECHC=0.044*AMAX1(0.0,(XHCFLS(N,N6,N5,N4) - 2+XHCFHS(N,N6,N5,N4))/WX) - ECSO=0.080*AMAX1(0.0,(XSOFLS(N,N6,N5,N4) - 2+XSOFHS(N,N6,N5,N4))*2.0/WX) - ECCL=0.076*AMAX1(0.0,(XCLFLS(N,N6,N5,N4) - 2+XCLFHS(N,N6,N5,N4))/WX) - ECNO=0.071*AMAX1(0.0,(XNOFLW(N,N6,N5,N4) - 2+XNOFHW(N,N6,N5,N4))/(WX*14.0)) - ECNDX=ECHY+ECOH+ECAL+ECFE+ECCA+ECMG+ECNA+ECKA - 2+ECCO+ECHC+ECSO+ECCL+ECNO -C IF((I/10)*10.EQ.I.AND.J.EQ.15)THEN -C WRITE(*,9992)'ECNDX',IYRC,I,J,N4,N5,N6,N,WX,ECNDX -C 2,FLW(N,N6,N5,N4),FLWH(N,N6,N5,N4) -9992 FORMAT(A8,7I4,4E12.4) -C ENDIF - ELSE - ECNDX=0.0 - ENDIF - ENDIF -9975 CONTINUE -9980 CONTINUE -9985 CONTINUE -C -C SET DEPTH OF EXTERNAL WATER TABLE -C - IF(IPRC(NY,NX).EQ.2)THEN - DTBLX(NY,NX)=DTBLX(NY,NX)-HVOLO(NY,NX)/AREA(3,NU(NY,NX),NY,NX) - 2-0.001*(DTBLX(NY,NX)-DTBLZ(NY,NX)) - ELSEIF(IPRC(NY,NX).EQ.3)THEN - DTBLX(NY,NX)=DTBLX(NY,NX)-HVOLO(NY,NX)/AREA(3,NU(NY,NX),NY,NX) - 2-0.001*(DTBLX(NY,NX)-DDRG(NY,NX)) - ENDIF -C -C TOTAL FLUXES FOR EACH GRID CELL FROM ALL INTERNAL AND BOUNDARY FLUXES -C CALCULATED IN 'WATSUB', NITRO', 'SOLUTE', 'EXTRACT', 'TRNSFR', -C 'TRNSFRS' AND 'REDIST' ABOVE -C - TQR(NY,NX)=0.0 - THQR(NY,NX)=0.0 - TQS(NY,NX)=0.0 - TQW(NY,NX)=0.0 - TQI(NY,NX)=0.0 - THQS(NY,NX)=0.0 - DO 9960 K=0,2 - TOCQRS(K,NY,NX)=0.0 - TONQRS(K,NY,NX)=0.0 - TOPQRS(K,NY,NX)=0.0 - TOAQRS(K,NY,NX)=0.0 -9960 CONTINUE - TCOQRS(NY,NX)=0.0 - TCHQRS(NY,NX)=0.0 - TOXQRS(NY,NX)=0.0 - TNGQRS(NY,NX)=0.0 - TN2QRS(NY,NX)=0.0 - THGQRS(NY,NX)=0.0 - TN4QRS(NY,NX)=0.0 - TN3QRS(NY,NX)=0.0 - TNOQRS(NY,NX)=0.0 - TNXQRS(NY,NX)=0.0 - TPOQRS(NY,NX)=0.0 - TCOQSS(NY,NX)=0.0 - TCHQSS(NY,NX)=0.0 - TOXQSS(NY,NX)=0.0 - TNGQSS(NY,NX)=0.0 - TN2QSS(NY,NX)=0.0 - TN4QSS(NY,NX)=0.0 - TN3QSS(NY,NX)=0.0 - TNOQSS(NY,NX)=0.0 - TPOQSS(NY,NX)=0.0 - IF(ISALT(NY,NX).NE.0)THEN - TQRAL(NY,NX)=0.0 - TQRFE(NY,NX)=0.0 - TQRHY(NY,NX)=0.0 - TQRCA(NY,NX)=0.0 - TQRMG(NY,NX)=0.0 - TQRNA(NY,NX)=0.0 - TQRKA(NY,NX)=0.0 - TQROH(NY,NX)=0.0 - TQRSO(NY,NX)=0.0 - TQRCL(NY,NX)=0.0 - TQRC3(NY,NX)=0.0 - TQRHC(NY,NX)=0.0 - TQRAL1(NY,NX)=0.0 - TQRAL2(NY,NX)=0.0 - TQRAL3(NY,NX)=0.0 - TQRAL4(NY,NX)=0.0 - TQRALS(NY,NX)=0.0 - TQRFE1(NY,NX)=0.0 - TQRFE2(NY,NX)=0.0 - TQRFE3(NY,NX)=0.0 - TQRFE4(NY,NX)=0.0 - TQRFES(NY,NX)=0.0 - TQRCAO(NY,NX)=0.0 - TQRCAC(NY,NX)=0.0 - TQRCAH(NY,NX)=0.0 - TQRCAS(NY,NX)=0.0 - TQRMGO(NY,NX)=0.0 - TQRMGC(NY,NX)=0.0 - TQRMGH(NY,NX)=0.0 - TQRMGS(NY,NX)=0.0 - TQRNAC(NY,NX)=0.0 - TQRNAS(NY,NX)=0.0 - TQRKAS(NY,NX)=0.0 - TQRH0P(NY,NX)=0.0 - TQRH1P(NY,NX)=0.0 - TQRH3P(NY,NX)=0.0 - TQRF1P(NY,NX)=0.0 - TQRF2P(NY,NX)=0.0 - TQRC0P(NY,NX)=0.0 - TQRC1P(NY,NX)=0.0 - TQRC2P(NY,NX)=0.0 - TQRM1P(NY,NX)=0.0 - TQSAL(NY,NX)=0.0 - TQSFE(NY,NX)=0.0 - TQSHY(NY,NX)=0.0 - TQSCA(NY,NX)=0.0 - TQSMG(NY,NX)=0.0 - TQSNA(NY,NX)=0.0 - TQSKA(NY,NX)=0.0 - TQSOH(NY,NX)=0.0 - TQSSO(NY,NX)=0.0 - TQSCL(NY,NX)=0.0 - TQSC3(NY,NX)=0.0 - TQSHC(NY,NX)=0.0 - TQSAL1(NY,NX)=0.0 - TQSAL2(NY,NX)=0.0 - TQSAL3(NY,NX)=0.0 - TQSAL4(NY,NX)=0.0 - TQSALS(NY,NX)=0.0 - TQSFE1(NY,NX)=0.0 - TQSFE2(NY,NX)=0.0 - TQSFE3(NY,NX)=0.0 - TQSFE4(NY,NX)=0.0 - TQSFES(NY,NX)=0.0 - TQSCAO(NY,NX)=0.0 - TQSCAC(NY,NX)=0.0 - TQSCAH(NY,NX)=0.0 - TQSCAS(NY,NX)=0.0 - TQSMGO(NY,NX)=0.0 - TQSMGC(NY,NX)=0.0 - TQSMGH(NY,NX)=0.0 - TQSMGS(NY,NX)=0.0 - TQSNAC(NY,NX)=0.0 - TQSNAS(NY,NX)=0.0 - TQSKAS(NY,NX)=0.0 - TQSH0P(NY,NX)=0.0 - TQSH1P(NY,NX)=0.0 - TQSH3P(NY,NX)=0.0 - TQSF1P(NY,NX)=0.0 - TQSF2P(NY,NX)=0.0 - TQSC0P(NY,NX)=0.0 - TQSC1P(NY,NX)=0.0 - TQSC2P(NY,NX)=0.0 - TQSM1P(NY,NX)=0.0 - ENDIF - IF(IERSN(NY,NX).NE.0)THEN - TSEDER(NY,NX)=0.0 - TSANER(NY,NX)=0.0 - TSILER(NY,NX)=0.0 - TCLAER(NY,NX)=0.0 - TCECER(NY,NX)=0.0 - TAECER(NY,NX)=0.0 - TNH4ER(NY,NX)=0.0 - TNH3ER(NY,NX)=0.0 - TNHUER(NY,NX)=0.0 - TNO3ER(NY,NX)=0.0 - TNH4EB(NY,NX)=0.0 - TNH3EB(NY,NX)=0.0 - TNHUEB(NY,NX)=0.0 - TNO3EB(NY,NX)=0.0 - TN4ER(NY,NX)=0.0 - TNBER(NY,NX)=0.0 - THYER(NY,NX)=0.0 - TALER(NY,NX)=0.0 - TCAER(NY,NX)=0.0 - TMGER(NY,NX)=0.0 - TNAER(NY,NX)=0.0 - TKAER(NY,NX)=0.0 - THCER(NY,NX)=0.0 - TAL2ER(NY,NX)=0.0 - TOH0ER(NY,NX)=0.0 - TOH1ER(NY,NX)=0.0 - TOH2ER(NY,NX)=0.0 - TH1PER(NY,NX)=0.0 - TH2PER(NY,NX)=0.0 - TOH0EB(NY,NX)=0.0 - TOH1EB(NY,NX)=0.0 - TOH2EB(NY,NX)=0.0 - TH1PEB(NY,NX)=0.0 - TH2PEB(NY,NX)=0.0 - TALOER(NY,NX)=0.0 - TFEOER(NY,NX)=0.0 - TCACER(NY,NX)=0.0 - TCASER(NY,NX)=0.0 - TALPER(NY,NX)=0.0 - TFEPER(NY,NX)=0.0 - TCPDER(NY,NX)=0.0 - TCPHER(NY,NX)=0.0 - TCPMER(NY,NX)=0.0 - TALPEB(NY,NX)=0.0 - TFEPEB(NY,NX)=0.0 - TCPDEB(NY,NX)=0.0 - TCPHEB(NY,NX)=0.0 - TCPMEB(NY,NX)=0.0 - DO 9480 K=0,5 - DO 9480 NN=1,7 - TOMCER(3,NN,K,NY,NX)=0.0 - DO 9480 M=1,2 - TOMCER(M,NN,K,NY,NX)=0.0 - TOMNER(M,NN,K,NY,NX)=0.0 - TOMPER(M,NN,K,NY,NX)=0.0 -9480 CONTINUE - DO 9475 K=0,4 - DO 9470 M=1,2 - TORCER(M,K,NY,NX)=0.0 - TORNER(M,K,NY,NX)=0.0 - TORPER(M,K,NY,NX)=0.0 -9470 CONTINUE - TOHCER(K,NY,NX)=0.0 - TOHNER(K,NY,NX)=0.0 - TOHPER(K,NY,NX)=0.0 - DO 9465 M=1,4 - TOSCER(M,K,NY,NX)=0.0 - TOSAER(M,K,NY,NX)=0.0 - TOSNER(M,K,NY,NX)=0.0 - TOSPER(M,K,NY,NX)=0.0 -9465 CONTINUE -9475 CONTINUE - ENDIF - LG=0 - LX=0 - DO 8575 L=NU(NY,NX),NL(NY,NX) - IF(THETP(L,NY,NX).LT.THETX)LX=1 - IF(THETP(L,NY,NX).GE.THETX.AND.LX.EQ.0)LG=L - TTHAW(L,NY,NX)=0.0 - TTHAWH(L,NY,NX)=0.0 - THTHAW(L,NY,NX)=0.0 - TFLW(L,NY,NX)=0.0 - TFLWX(L,NY,NX)=0.0 - TFLWH(L,NY,NX)=0.0 - THFLW(L,NY,NX)=0.0 - DO 8595 K=0,4 - TOCFLS(K,L,NY,NX)=0.0 - TONFLS(K,L,NY,NX)=0.0 - TOPFLS(K,L,NY,NX)=0.0 - TOAFLS(K,L,NY,NX)=0.0 - TOCFHS(K,L,NY,NX)=0.0 - TONFHS(K,L,NY,NX)=0.0 - TOPFHS(K,L,NY,NX)=0.0 - TOAFHS(K,L,NY,NX)=0.0 -8595 CONTINUE - TCOFLS(L,NY,NX)=0.0 - TCHFLS(L,NY,NX)=0.0 - TOXFLS(L,NY,NX)=0.0 - TNGFLS(L,NY,NX)=0.0 - TN2FLS(L,NY,NX)=0.0 - THGFLS(L,NY,NX)=0.0 - TN4FLS(L,NY,NX)=0.0 - TN3FLS(L,NY,NX)=0.0 - TNOFLS(L,NY,NX)=0.0 - TNXFLS(L,NY,NX)=0.0 - TPOFLS(L,NY,NX)=0.0 - TN4FLB(L,NY,NX)=0.0 - TN3FLB(L,NY,NX)=0.0 - TNOFLB(L,NY,NX)=0.0 - TNXFLB(L,NY,NX)=0.0 - TH2BFB(L,NY,NX)=0.0 - TCOFHS(L,NY,NX)=0.0 - TCHFHS(L,NY,NX)=0.0 - TOXFHS(L,NY,NX)=0.0 - TNGFHS(L,NY,NX)=0.0 - TN2FHS(L,NY,NX)=0.0 - THGFHS(L,NY,NX)=0.0 - TN4FHS(L,NY,NX)=0.0 - TN3FHS(L,NY,NX)=0.0 - TNOFHS(L,NY,NX)=0.0 - TNXFHS(L,NY,NX)=0.0 - TPOFHS(L,NY,NX)=0.0 - TN4FHB(L,NY,NX)=0.0 - TN3FHB(L,NY,NX)=0.0 - TNOFHB(L,NY,NX)=0.0 - TNXFHB(L,NY,NX)=0.0 - TH2BHB(L,NY,NX)=0.0 - TCOFLG(L,NY,NX)=0.0 - TCHFLG(L,NY,NX)=0.0 - TOXFLG(L,NY,NX)=0.0 - TNGFLG(L,NY,NX)=0.0 - TN2FLG(L,NY,NX)=0.0 - TNHFLG(L,NY,NX)=0.0 - THGFLG(L,NY,NX)=0.0 - IF(ISALT(NY,NX).NE.0)THEN - TALFLS(L,NY,NX)=0.0 - TFEFLS(L,NY,NX)=0.0 - THYFLS(L,NY,NX)=0.0 - TCAFLS(L,NY,NX)=0.0 - TMGFLS(L,NY,NX)=0.0 - TNAFLS(L,NY,NX)=0.0 - TKAFLS(L,NY,NX)=0.0 - TOHFLS(L,NY,NX)=0.0 - TSOFLS(L,NY,NX)=0.0 - TCLFLS(L,NY,NX)=0.0 - TC3FLS(L,NY,NX)=0.0 - THCFLS(L,NY,NX)=0.0 - TAL1FS(L,NY,NX)=0.0 - TAL2FS(L,NY,NX)=0.0 - TAL3FS(L,NY,NX)=0.0 - TAL4FS(L,NY,NX)=0.0 - TALSFS(L,NY,NX)=0.0 - TFE1FS(L,NY,NX)=0.0 - TFE2FS(L,NY,NX)=0.0 - TFE3FS(L,NY,NX)=0.0 - TFE4FS(L,NY,NX)=0.0 - TFESFS(L,NY,NX)=0.0 - TCAOFS(L,NY,NX)=0.0 - TCACFS(L,NY,NX)=0.0 - TCAHFS(L,NY,NX)=0.0 - TCASFS(L,NY,NX)=0.0 - TMGOFS(L,NY,NX)=0.0 - TMGCFS(L,NY,NX)=0.0 - TMGHFS(L,NY,NX)=0.0 - TMGSFS(L,NY,NX)=0.0 - TNACFS(L,NY,NX)=0.0 - TNASFS(L,NY,NX)=0.0 - TKASFS(L,NY,NX)=0.0 - TH0PFS(L,NY,NX)=0.0 - TH1PFS(L,NY,NX)=0.0 - TH3PFS(L,NY,NX)=0.0 - TF1PFS(L,NY,NX)=0.0 - TF2PFS(L,NY,NX)=0.0 - TC0PFS(L,NY,NX)=0.0 - TC1PFS(L,NY,NX)=0.0 - TC2PFS(L,NY,NX)=0.0 - TM1PFS(L,NY,NX)=0.0 - TH0BFB(L,NY,NX)=0.0 - TH1BFB(L,NY,NX)=0.0 - TH3BFB(L,NY,NX)=0.0 - TF1BFB(L,NY,NX)=0.0 - TF2BFB(L,NY,NX)=0.0 - TC0BFB(L,NY,NX)=0.0 - TC1BFB(L,NY,NX)=0.0 - TC2BFB(L,NY,NX)=0.0 - TM1BFB(L,NY,NX)=0.0 - TALFHS(L,NY,NX)=0.0 - TFEFHS(L,NY,NX)=0.0 - THYFHS(L,NY,NX)=0.0 - TCAFHS(L,NY,NX)=0.0 - TMGFHS(L,NY,NX)=0.0 - TNAFHS(L,NY,NX)=0.0 - TKAFHS(L,NY,NX)=0.0 - TOHFHS(L,NY,NX)=0.0 - TSOFHS(L,NY,NX)=0.0 - TCLFHS(L,NY,NX)=0.0 - TC3FHS(L,NY,NX)=0.0 - THCFHS(L,NY,NX)=0.0 - TAL1HS(L,NY,NX)=0.0 - TAL2HS(L,NY,NX)=0.0 - TAL3HS(L,NY,NX)=0.0 - TAL4HS(L,NY,NX)=0.0 - TALSHS(L,NY,NX)=0.0 - TFE1HS(L,NY,NX)=0.0 - TFE2HS(L,NY,NX)=0.0 - TFE3HS(L,NY,NX)=0.0 - TFE4HS(L,NY,NX)=0.0 - TFESHS(L,NY,NX)=0.0 - TCAOHS(L,NY,NX)=0.0 - TCACHS(L,NY,NX)=0.0 - TCAHHS(L,NY,NX)=0.0 - TCASHS(L,NY,NX)=0.0 - TMGOHS(L,NY,NX)=0.0 - TMGCHS(L,NY,NX)=0.0 - TMGHHS(L,NY,NX)=0.0 - TMGSHS(L,NY,NX)=0.0 - TNACHS(L,NY,NX)=0.0 - TNASHS(L,NY,NX)=0.0 - TKASHS(L,NY,NX)=0.0 - TH0PHS(L,NY,NX)=0.0 - TH1PHS(L,NY,NX)=0.0 - TH3PHS(L,NY,NX)=0.0 - TF1PHS(L,NY,NX)=0.0 - TF2PHS(L,NY,NX)=0.0 - TC0PHS(L,NY,NX)=0.0 - TC1PHS(L,NY,NX)=0.0 - TC2PHS(L,NY,NX)=0.0 - TM1PHS(L,NY,NX)=0.0 - TH0BHB(L,NY,NX)=0.0 - TH1BHB(L,NY,NX)=0.0 - TH3BHB(L,NY,NX)=0.0 - TF1BHB(L,NY,NX)=0.0 - TF2BHB(L,NY,NX)=0.0 - TC0BHB(L,NY,NX)=0.0 - TC1BHB(L,NY,NX)=0.0 - TC2BHB(L,NY,NX)=0.0 - TM1BHB(L,NY,NX)=0.0 - ENDIF - N1=NX - N2=NY - N3=L - DO 8580 N=1,3 - IF(N.EQ.1)THEN - N4=NX+1 - N5=NY - N6=L - ELSEIF(N.EQ.2)THEN - N4=NX - N5=NY+1 - N6=L - ELSEIF(N.EQ.3)THEN - N4=NX - N5=NY - N6=L+1 - ENDIF -C -C TOTAL FLUXES FROM OVERLAND FLOW -C - IF(L.EQ.NU(N2,N1).AND.N.NE.3)THEN - TQR(N2,N1)=TQR(N2,N1)+QR(N,N2,N1)-QR(N,N5,N4) - THQR(N2,N1)=THQR(N2,N1)+HQR(N,N2,N1)-HQR(N,N5,N4) - TQS(N2,N1)=TQS(N2,N1)+QS(N,N2,N1)-QS(N,N5,N4) - TQW(N2,N1)=TQW(N2,N1)+QW(N,N2,N1)-QW(N,N5,N4) - TQI(N2,N1)=TQI(N2,N1)+QI(N,N2,N1)-QI(N,N5,N4) - THQS(N2,N1)=THQS(N2,N1)+HQS(N,N2,N1)-HQS(N,N5,N4) - DO 8590 K=0,2 - TOCQRS(K,N2,N1)=TOCQRS(K,N2,N1)+XOCQRS(K,N,N2,N1) - 2-XOCQRS(K,N,N5,N4) - TONQRS(K,N2,N1)=TONQRS(K,N2,N1)+XONQRS(K,N,N2,N1) - 2-XONQRS(K,N,N5,N4) - TOPQRS(K,N2,N1)=TOPQRS(K,N2,N1)+XOPQRS(K,N,N2,N1) - 2-XOPQRS(K,N,N5,N4) - TOAQRS(K,N2,N1)=TOAQRS(K,N2,N1)+XOAQRS(K,N,N2,N1) - 2-XOAQRS(K,N,N5,N4) -8590 CONTINUE - TCOQRS(N2,N1)=TCOQRS(N2,N1)+XCOQRS(N,N2,N1)-XCOQRS(N,N5,N4) - TCHQRS(N2,N1)=TCHQRS(N2,N1)+XCHQRS(N,N2,N1)-XCHQRS(N,N5,N4) - TOXQRS(N2,N1)=TOXQRS(N2,N1)+XOXQRS(N,N2,N1)-XOXQRS(N,N5,N4) - TNGQRS(N2,N1)=TNGQRS(N2,N1)+XNGQRS(N,N2,N1)-XNGQRS(N,N5,N4) - TN2QRS(N2,N1)=TN2QRS(N2,N1)+XN2QRS(N,N2,N1)-XN2QRS(N,N5,N4) - THGQRS(N2,N1)=THGQRS(N2,N1)+XHGQRS(N,N2,N1)-XHGQRS(N,N5,N4) - TN4QRS(N2,N1)=TN4QRS(N2,N1)+XN4QRW(N,N2,N1)-XN4QRW(N,N5,N4) - TN3QRS(N2,N1)=TN3QRS(N2,N1)+XN3QRW(N,N2,N1)-XN3QRW(N,N5,N4) - TNOQRS(N2,N1)=TNOQRS(N2,N1)+XNOQRW(N,N2,N1)-XNOQRW(N,N5,N4) - TNXQRS(N2,N1)=TNXQRS(N2,N1)+XNXQRS(N,N2,N1)-XNXQRS(N,N5,N4) - TPOQRS(N2,N1)=TPOQRS(N2,N1)+XP4QRW(N,N2,N1)-XP4QRW(N,N5,N4) - TCOQSS(N2,N1)=TCOQSS(N2,N1)+XCOQSS(N,N2,N1)-XCOQSS(N,N5,N4) - TCHQSS(N2,N1)=TCHQSS(N2,N1)+XCHQSS(N,N2,N1)-XCHQSS(N,N5,N4) - TOXQSS(N2,N1)=TOXQSS(N2,N1)+XOXQSS(N,N2,N1)-XOXQSS(N,N5,N4) - TNGQSS(N2,N1)=TNGQSS(N2,N1)+XNGQSS(N,N2,N1)-XNGQSS(N,N5,N4) - TN2QSS(N2,N1)=TN2QSS(N2,N1)+XN2QSS(N,N2,N1)-XN2QSS(N,N5,N4) - TN4QSS(N2,N1)=TN4QSS(N2,N1)+XN4QSS(N,N2,N1)-XN4QSS(N,N5,N4) - TN3QSS(N2,N1)=TN3QSS(N2,N1)+XN3QSS(N,N2,N1)-XN3QSS(N,N5,N4) - TNOQSS(N2,N1)=TNOQSS(N2,N1)+XNOQSS(N,N2,N1)-XNOQSS(N,N5,N4) - TPOQSS(N2,N1)=TPOQSS(N2,N1)+XP4QSS(N,N2,N1)-XP4QSS(N,N5,N4) - IF(ISALT(NY,NX).NE.0)THEN - TQRAL(N2,N1)=TQRAL(N2,N1)+XQRAL(N,N2,N1)-XQRAL(N,N5,N4) - TQRFE(N2,N1)=TQRFE(N2,N1)+XQRFE(N,N2,N1)-XQRFE(N,N5,N4) - TQRHY(N2,N1)=TQRHY(N2,N1)+XQRHY(N,N2,N1)-XQRHY(N,N5,N4) - TQRCA(N2,N1)=TQRCA(N2,N1)+XQRCA(N,N2,N1)-XQRCA(N,N5,N4) - TQRMG(N2,N1)=TQRMG(N2,N1)+XQRMG(N,N2,N1)-XQRMG(N,N5,N4) - TQRNA(N2,N1)=TQRNA(N2,N1)+XQRNA(N,N2,N1)-XQRNA(N,N5,N4) - TQRKA(N2,N1)=TQRKA(N2,N1)+XQRKA(N,N2,N1)-XQRKA(N,N5,N4) - TQROH(N2,N1)=TQROH(N2,N1)+XQROH(N,N2,N1)-XQROH(N,N5,N4) - TQRSO(N2,N1)=TQRSO(N2,N1)+XQRSO(N,N2,N1)-XQRSO(N,N5,N4) - TQRCL(N2,N1)=TQRCL(N2,N1)+XQRCL(N,N2,N1)-XQRCL(N,N5,N4) - TQRC3(N2,N1)=TQRC3(N2,N1)+XQRC3(N,N2,N1)-XQRC3(N,N5,N4) - TQRHC(N2,N1)=TQRHC(N2,N1)+XQRHC(N,N2,N1)-XQRHC(N,N5,N4) - TQRAL1(N2,N1)=TQRAL1(N2,N1)+XQRAL1(N,N2,N1)-XQRAL1(N,N5,N4) - TQRAL2(N2,N1)=TQRAL2(N2,N1)+XQRAL2(N,N2,N1)-XQRAL2(N,N5,N4) - TQRAL3(N2,N1)=TQRAL3(N2,N1)+XQRAL3(N,N2,N1)-XQRAL3(N,N5,N4) - TQRAL4(N2,N1)=TQRAL4(N2,N1)+XQRAL4(N,N2,N1)-XQRAL4(N,N5,N4) - TQRALS(N2,N1)=TQRALS(N2,N1)+XQRALS(N,N2,N1)-XQRALS(N,N5,N4) - TQRFE1(N2,N1)=TQRFE1(N2,N1)+XQRFE1(N,N2,N1)-XQRFE1(N,N5,N4) - TQRFE2(N2,N1)=TQRFE2(N2,N1)+XQRFE2(N,N2,N1)-XQRFE2(N,N5,N4) - TQRFE3(N2,N1)=TQRFE3(N2,N1)+XQRFE3(N,N2,N1)-XQRFE3(N,N5,N4) - TQRFE4(N2,N1)=TQRFE4(N2,N1)+XQRFE4(N,N2,N1)-XQRFE4(N,N5,N4) - TQRFES(N2,N1)=TQRFES(N2,N1)+XQRFES(N,N2,N1)-XQRFES(N,N5,N4) - TQRCAO(N2,N1)=TQRCAO(N2,N1)+XQRCAO(N,N2,N1)-XQRCAO(N,N5,N4) - TQRCAC(N2,N1)=TQRCAC(N2,N1)+XQRCAC(N,N2,N1)-XQRCAC(N,N5,N4) - TQRCAH(N2,N1)=TQRCAH(N2,N1)+XQRCAH(N,N2,N1)-XQRCAH(N,N5,N4) - TQRCAS(N2,N1)=TQRCAS(N2,N1)+XQRCAS(N,N2,N1)-XQRCAS(N,N5,N4) - TQRMGO(N2,N1)=TQRMGO(N2,N1)+XQRMGO(N,N2,N1)-XQRMGO(N,N5,N4) - TQRMGC(N2,N1)=TQRMGC(N2,N1)+XQRMGC(N,N2,N1)-XQRMGC(N,N5,N4) - TQRMGH(N2,N1)=TQRMGH(N2,N1)+XQRMGH(N,N2,N1)-XQRMGH(N,N5,N4) - TQRMGS(N2,N1)=TQRMGS(N2,N1)+XQRMGS(N,N2,N1)-XQRMGS(N,N5,N4) - TQRNAC(N2,N1)=TQRNAC(N2,N1)+XQRNAC(N,N2,N1)-XQRNAC(N,N5,N4) - TQRNAS(N2,N1)=TQRNAS(N2,N1)+XQRNAS(N,N2,N1)-XQRNAS(N,N5,N4) - TQRKAS(N2,N1)=TQRKAS(N2,N1)+XQRKAS(N,N2,N1)-XQRKAS(N,N5,N4) - TQRH0P(N2,N1)=TQRH0P(N2,N1)+XQRH0P(N,N2,N1)-XQRH0P(N,N5,N4) - TQRH1P(N2,N1)=TQRH1P(N2,N1)+XQRH1P(N,N2,N1)-XQRH1P(N,N5,N4) - TQRH3P(N2,N1)=TQRH3P(N2,N1)+XQRH3P(N,N2,N1)-XQRH3P(N,N5,N4) - TQRF1P(N2,N1)=TQRF1P(N2,N1)+XQRF1P(N,N2,N1)-XQRF1P(N,N5,N4) - TQRF2P(N2,N1)=TQRF2P(N2,N1)+XQRF2P(N,N2,N1)-XQRF2P(N,N5,N4) - TQRC0P(N2,N1)=TQRC0P(N2,N1)+XQRC0P(N,N2,N1)-XQRC0P(N,N5,N4) - TQRC1P(N2,N1)=TQRC1P(N2,N1)+XQRC1P(N,N2,N1)-XQRC1P(N,N5,N4) - TQRC2P(N2,N1)=TQRC2P(N2,N1)+XQRC2P(N,N2,N1)-XQRC2P(N,N5,N4) - TQRM1P(N2,N1)=TQRM1P(N2,N1)+XQRM1P(N,N2,N1)-XQRM1P(N,N5,N4) - TQSAL(N2,N1)=TQSAL(N2,N1)+XQSAL(N,N2,N1)-XQSAL(N,N5,N4) - TQSFE(N2,N1)=TQSFE(N2,N1)+XQSFE(N,N2,N1)-XQSFE(N,N5,N4) - TQSHY(N2,N1)=TQSHY(N2,N1)+XQSHY(N,N2,N1)-XQSHY(N,N5,N4) - TQSCA(N2,N1)=TQSCA(N2,N1)+XQSCA(N,N2,N1)-XQSCA(N,N5,N4) - TQSMG(N2,N1)=TQSMG(N2,N1)+XQSMG(N,N2,N1)-XQSMG(N,N5,N4) - TQSNA(N2,N1)=TQSNA(N2,N1)+XQSNA(N,N2,N1)-XQSNA(N,N5,N4) - TQSKA(N2,N1)=TQSKA(N2,N1)+XQSKA(N,N2,N1)-XQSKA(N,N5,N4) - TQSOH(N2,N1)=TQSOH(N2,N1)+XQSOH(N,N2,N1)-XQSOH(N,N5,N4) - TQSSO(N2,N1)=TQSSO(N2,N1)+XQSSO(N,N2,N1)-XQSSO(N,N5,N4) - TQSCL(N2,N1)=TQSCL(N2,N1)+XQSCL(N,N2,N1)-XQSCL(N,N5,N4) - TQSC3(N2,N1)=TQSC3(N2,N1)+XQSC3(N,N2,N1)-XQSC3(N,N5,N4) - TQSHC(N2,N1)=TQSHC(N2,N1)+XQSHC(N,N2,N1)-XQSHC(N,N5,N4) - TQSAL1(N2,N1)=TQSAL1(N2,N1)+XQSAL1(N,N2,N1)-XQSAL1(N,N5,N4) - TQSAL2(N2,N1)=TQSAL2(N2,N1)+XQSAL2(N,N2,N1)-XQSAL2(N,N5,N4) - TQSAL3(N2,N1)=TQSAL3(N2,N1)+XQSAL3(N,N2,N1)-XQSAL3(N,N5,N4) - TQSAL4(N2,N1)=TQSAL4(N2,N1)+XQSAL4(N,N2,N1)-XQSAL4(N,N5,N4) - TQSALS(N2,N1)=TQSALS(N2,N1)+XQSALS(N,N2,N1)-XQSALS(N,N5,N4) - TQSFE1(N2,N1)=TQSFE1(N2,N1)+XQSFE1(N,N2,N1)-XQSFE1(N,N5,N4) - TQSFE2(N2,N1)=TQSFE2(N2,N1)+XQSFE2(N,N2,N1)-XQSFE2(N,N5,N4) - TQSFE3(N2,N1)=TQSFE3(N2,N1)+XQSFE3(N,N2,N1)-XQSFE3(N,N5,N4) - TQSFE4(N2,N1)=TQSFE4(N2,N1)+XQSFE4(N,N2,N1)-XQSFE4(N,N5,N4) - TQSFES(N2,N1)=TQSFES(N2,N1)+XQSFES(N,N2,N1)-XQSFES(N,N5,N4) - TQSCAO(N2,N1)=TQSCAO(N2,N1)+XQSCAO(N,N2,N1)-XQSCAO(N,N5,N4) - TQSCAC(N2,N1)=TQSCAC(N2,N1)+XQSCAC(N,N2,N1)-XQSCAC(N,N5,N4) - TQSCAH(N2,N1)=TQSCAH(N2,N1)+XQSCAH(N,N2,N1)-XQSCAH(N,N5,N4) - TQSCAS(N2,N1)=TQSCAS(N2,N1)+XQSCAS(N,N2,N1)-XQSCAS(N,N5,N4) - TQSMGO(N2,N1)=TQSMGO(N2,N1)+XQSMGO(N,N2,N1)-XQSMGO(N,N5,N4) - TQSMGC(N2,N1)=TQSMGC(N2,N1)+XQSMGC(N,N2,N1)-XQSMGC(N,N5,N4) - TQSMGH(N2,N1)=TQSMGH(N2,N1)+XQSMGH(N,N2,N1)-XQSMGH(N,N5,N4) - TQSMGS(N2,N1)=TQSMGS(N2,N1)+XQSMGS(N,N2,N1)-XQSMGS(N,N5,N4) - TQSNAC(N2,N1)=TQSNAC(N2,N1)+XQSNAC(N,N2,N1)-XQSNAC(N,N5,N4) - TQSNAS(N2,N1)=TQSNAS(N2,N1)+XQSNAS(N,N2,N1)-XQSNAS(N,N5,N4) - TQSKAS(N2,N1)=TQSKAS(N2,N1)+XQSKAS(N,N2,N1)-XQSKAS(N,N5,N4) - TQSH0P(N2,N1)=TQSH0P(N2,N1)+XQSH0P(N,N2,N1)-XQSH0P(N,N5,N4) - TQSH1P(N2,N1)=TQSH1P(N2,N1)+XQSH1P(N,N2,N1)-XQSH1P(N,N5,N4) - TQSH3P(N2,N1)=TQSH3P(N2,N1)+XQSH3P(N,N2,N1)-XQSH3P(N,N5,N4) - TQSF1P(N2,N1)=TQSF1P(N2,N1)+XQSF1P(N,N2,N1)-XQSF1P(N,N5,N4) - TQSF2P(N2,N1)=TQSF2P(N2,N1)+XQSF2P(N,N2,N1)-XQSF2P(N,N5,N4) - TQSC0P(N2,N1)=TQSC0P(N2,N1)+XQSC0P(N,N2,N1)-XQSC0P(N,N5,N4) - TQSC1P(N2,N1)=TQSC1P(N2,N1)+XQSC1P(N,N2,N1)-XQSC1P(N,N5,N4) - TQSC2P(N2,N1)=TQSC2P(N2,N1)+XQSC2P(N,N2,N1)-XQSC2P(N,N5,N4) - TQSM1P(N2,N1)=TQSM1P(N2,N1)+XQSM1P(N,N2,N1)-XQSM1P(N,N5,N4) - ENDIF -C -C TOTAL FLUXES FROM SEDIMENT TRANSPORT -C - IF(IERSN(NY,NX).NE.0)THEN - TSEDER(N2,N1)=TSEDER(N2,N1)+XSEDER(N,N2,N1)-XSEDER(N,N5,N4) - TSANER(N2,N1)=TSANER(N2,N1)+XSANER(N,N2,N1)-XSANER(N,N5,N4) - TSILER(N2,N1)=TSILER(N2,N1)+XSILER(N,N2,N1)-XSILER(N,N5,N4) - TCLAER(N2,N1)=TCLAER(N2,N1)+XCLAER(N,N2,N1)-XCLAER(N,N5,N4) - TCECER(N2,N1)=TCECER(N2,N1)+XCECER(N,N2,N1)-XCECER(N,N5,N4) - TAECER(N2,N1)=TAECER(N2,N1)+XAECER(N,N2,N1)-XAECER(N,N5,N4) - TNH4ER(N2,N1)=TNH4ER(N2,N1)+XNH4ER(N,N2,N1)-XNH4ER(N,N5,N4) - TNH3ER(N2,N1)=TNH3ER(N2,N1)+XNH3ER(N,N2,N1)-XNH3ER(N,N5,N4) - TNHUER(N2,N1)=TNHUER(N2,N1)+XNHUER(N,N2,N1)-XNHUER(N,N5,N4) - TNO3ER(N2,N1)=TNO3ER(N2,N1)+XNO3ER(N,N2,N1)-XNO3ER(N,N5,N4) - TNH4EB(N2,N1)=TNH4EB(N2,N1)+XNH4EB(N,N2,N1)-XNH4EB(N,N5,N4) - TNH3EB(N2,N1)=TNH3EB(N2,N1)+XNH3EB(N,N2,N1)-XNH3EB(N,N5,N4) - TNHUEB(N2,N1)=TNHUEB(N2,N1)+XNHUEB(N,N2,N1)-XNHUEB(N,N5,N4) - TNO3EB(N2,N1)=TNO3EB(N2,N1)+XNO3EB(N,N2,N1)-XNO3EB(N,N5,N4) - TN4ER(N2,N1)=TN4ER(N2,N1)+XN4ER(N,N2,N1)-XN4ER(N,N5,N4) - TNBER(N2,N1)=TNBER(N2,N1)+XNBER(N,N2,N1)-XNBER(N,N5,N4) - THYER(N2,N1)=THYER(N2,N1)+XHYER(N,N2,N1)-XHYER(N,N5,N4) - TALER(N2,N1)=TALER(N2,N1)+XALER(N,N2,N1)-XALER(N,N5,N4) - TCAER(N2,N1)=TCAER(N2,N1)+XCAER(N,N2,N1)-XCAER(N,N5,N4) - TMGER(N2,N1)=TMGER(N2,N1)+XMGER(N,N2,N1)-XMGER(N,N5,N4) - TNAER(N2,N1)=TNAER(N2,N1)+XNAER(N,N2,N1)-XNAER(N,N5,N4) - TKAER(N2,N1)=TKAER(N2,N1)+XKAER(N,N2,N1)-XKAER(N,N5,N4) - THCER(N2,N1)=THCER(N2,N1)+XHCER(N,N2,N1)-XHCER(N,N5,N4) - TAL2ER(N2,N1)=TAL2ER(N2,N1)+XAL2ER(N,N2,N1)-XAL2ER(N,N5,N4) - TOH0ER(N2,N1)=TOH0ER(N2,N1)+XOH0ER(N,N2,N1)-XOH0ER(N,N5,N4) - TOH1ER(N2,N1)=TOH1ER(N2,N1)+XOH1ER(N,N2,N1)-XOH1ER(N,N5,N4) - TOH2ER(N2,N1)=TOH2ER(N2,N1)+XOH2ER(N,N2,N1)-XOH2ER(N,N5,N4) - TH1PER(N2,N1)=TH1PER(N2,N1)+XH1PER(N,N2,N1)-XH1PER(N,N5,N4) - TH2PER(N2,N1)=TH2PER(N2,N1)+XH2PER(N,N2,N1)-XH2PER(N,N5,N4) - TOH0EB(N2,N1)=TOH0EB(N2,N1)+XOH0EB(N,N2,N1)-XOH0EB(N,N5,N4) - TOH1EB(N2,N1)=TOH1EB(N2,N1)+XOH1EB(N,N2,N1)-XOH1EB(N,N5,N4) - TOH2EB(N2,N1)=TOH2EB(N2,N1)+XOH2EB(N,N2,N1)-XOH2EB(N,N5,N4) - TH1PEB(N2,N1)=TH1PEB(N2,N1)+XH1PEB(N,N2,N1)-XH1PEB(N,N5,N4) - TH2PEB(N2,N1)=TH2PEB(N2,N1)+XH2PEB(N,N2,N1)-XH2PEB(N,N5,N4) - TALOER(N2,N1)=TALOER(N2,N1)+PALOER(N,N2,N1)-PALOER(N,N5,N4) - TFEOER(N2,N1)=TFEOER(N2,N1)+PFEOER(N,N2,N1)-PFEOER(N,N5,N4) - TCACER(N2,N1)=TCACER(N2,N1)+PCACER(N,N2,N1)-PCACER(N,N5,N4) - TCASER(N2,N1)=TCASER(N2,N1)+PCASER(N,N2,N1)-PCASER(N,N5,N4) - TALPER(N2,N1)=TALPER(N2,N1)+PALPER(N,N2,N1)-PALPER(N,N5,N4) - TFEPER(N2,N1)=TFEPER(N2,N1)+PFEPER(N,N2,N1)-PFEPER(N,N5,N4) - TCPDER(N2,N1)=TCPDER(N2,N1)+PCPDER(N,N2,N1)-PCPDER(N,N5,N4) - TCPHER(N2,N1)=TCPHER(N2,N1)+PCPHER(N,N2,N1)-PCPHER(N,N5,N4) - TCPMER(N2,N1)=TCPMER(N2,N1)+PCPMER(N,N2,N1)-PCPMER(N,N5,N4) - TALPEB(N2,N1)=TALPEB(N2,N1)+PALPEB(N,N2,N1)-PALPEB(N,N5,N4) - TFEPEB(N2,N1)=TFEPEB(N2,N1)+PFEPEB(N,N2,N1)-PFEPEB(N,N5,N4) - TCPDEB(N2,N1)=TCPDEB(N2,N1)+PCPDEB(N,N2,N1)-PCPDEB(N,N5,N4) - TCPHEB(N2,N1)=TCPHEB(N2,N1)+PCPHEB(N,N2,N1)-PCPHEB(N,N5,N4) - TCPMEB(N2,N1)=TCPMEB(N2,N1)+PCPMEB(N,N2,N1)-PCPMEB(N,N5,N4) - DO 9380 K=0,5 - DO 9380 NN=1,7 - TOMCER(3,NN,K,N2,N1)=TOMCER(3,NN,K,N2,N1) - 2+OMCER(3,NN,K,N,N2,N1)-OMCER(3,NN,K,N,N5,N4) - DO 9380 M=1,2 - TOMCER(M,NN,K,N2,N1)=TOMCER(M,NN,K,N2,N1) - 2+OMCER(M,NN,K,N,N2,N1)-OMCER(M,NN,K,N,N5,N4) - TOMNER(M,NN,K,N2,N1)=TOMNER(M,NN,K,N2,N1) - 2+OMNER(M,NN,K,N,N2,N1)-OMNER(M,NN,K,N,N5,N4) - TOMPER(M,NN,K,N2,N1)=TOMPER(M,NN,K,N2,N1) - 2+OMPER(M,NN,K,N,N2,N1)-OMPER(M,NN,K,N,N5,N4) -9380 CONTINUE - DO 9375 K=0,4 - DO 9370 M=1,2 - TORCER(M,K,N2,N1)=TORCER(M,K,N2,N1) - 2+ORCER(M,K,N,N2,N1)-ORCER(M,K,N,N5,N4) - TORNER(M,K,N2,N1)=TORNER(M,K,N2,N1) - 2+ORNER(M,K,N,N2,N1)-ORNER(M,K,N,N5,N4) - TORPER(M,K,N2,N1)=TORPER(M,K,N2,N1) - 2+ORPER(M,K,N,N2,N1)-ORPER(M,K,N,N5,N4) -9370 CONTINUE - TOHCER(K,N2,N1)=TOHCER(K,N2,N1) - 2+OHCER(K,N,N2,N1)-OHCER(K,N,N5,N4) - TOHNER(K,N2,N1)=TOHNER(K,N2,N1) - 2+OHNER(K,N,N2,N1)-OHNER(K,N,N5,N4) - TOHPER(K,N2,N1)=TOHPER(K,N2,N1) - 2+OHPER(K,N,N2,N1)-OHPER(K,N,N5,N4) - DO 9365 M=1,4 - TOSCER(M,K,N2,N1)=TOSCER(M,K,N2,N1) - 2+OSCER(M,K,N,N2,N1)-OSCER(M,K,N,N5,N4) - TOSAER(M,K,N2,N1)=TOSAER(M,K,N2,N1) - 2+OSAER(M,K,N,N2,N1)-OSAER(M,K,N,N5,N4) - TOSNER(M,K,N2,N1)=TOSNER(M,K,N2,N1) - 2+OSNER(M,K,N,N2,N1)-OSNER(M,K,N,N5,N4) - TOSPER(M,K,N2,N1)=TOSPER(M,K,N2,N1) - 2+OSPER(M,K,N,N2,N1)-OSPER(M,K,N,N5,N4) -9365 CONTINUE -9375 CONTINUE - ENDIF - ENDIF -C -C TOTAL HEAT, WATER, GAS AND SOLUTE FLUXES BETWEEN ADJACENT -C GRID CELLS -C - IF(NCN(N2,N1).NE.3.OR.N.EQ.3)THEN - TTHAW(N3,N2,N1)=TTHAW(N3,N2,N1)+THAW(N,N3,N2,N1) - TTHAWH(N3,N2,N1)=TTHAWH(N3,N2,N1)+THAWH(N,N3,N2,N1) - THTHAW(N3,N2,N1)=THTHAW(N3,N2,N1)+HTHAW(N,N3,N2,N1) - TFLW(N3,N2,N1)=TFLW(N3,N2,N1)+FLW(N,N3,N2,N1)-FLW(N,N6,N5,N4) - TFLWX(N3,N2,N1)=TFLWX(N3,N2,N1)+FLWX(N,N3,N2,N1)-FLWX(N,N6,N5,N4) - TFLWH(N3,N2,N1)=TFLWH(N3,N2,N1)+FLWH(N,N3,N2,N1)-FLWH(N,N6,N5,N4) - THFLW(N3,N2,N1)=THFLW(N3,N2,N1)+HFLW(N,N3,N2,N1)-HFLW(N,N6,N5,N4) - DO 8585 K=0,4 - TOCFLS(K,N3,N2,N1)=TOCFLS(K,N3,N2,N1)+XOCFLS(K,N,N3,N2,N1) - 2-XOCFLS(K,N,N6,N5,N4) - TONFLS(K,N3,N2,N1)=TONFLS(K,N3,N2,N1)+XONFLS(K,N,N3,N2,N1) - 2-XONFLS(K,N,N6,N5,N4) - TOPFLS(K,N3,N2,N1)=TOPFLS(K,N3,N2,N1)+XOPFLS(K,N,N3,N2,N1) - 2-XOPFLS(K,N,N6,N5,N4) - TOAFLS(K,N3,N2,N1)=TOAFLS(K,N3,N2,N1)+XOAFLS(K,N,N3,N2,N1) - 2-XOAFLS(K,N,N6,N5,N4) - TOCFHS(K,N3,N2,N1)=TOCFHS(K,N3,N2,N1)+XOCFHS(K,N,N3,N2,N1) - 2-XOCFHS(K,N,N6,N5,N4) - TONFHS(K,N3,N2,N1)=TONFHS(K,N3,N2,N1)+XONFHS(K,N,N3,N2,N1) - 2-XONFHS(K,N,N6,N5,N4) - TOPFHS(K,N3,N2,N1)=TOPFHS(K,N3,N2,N1)+XOPFHS(K,N,N3,N2,N1) - 2-XOPFHS(K,N,N6,N5,N4) - TOAFHS(K,N3,N2,N1)=TOAFHS(K,N3,N2,N1)+XOAFHS(K,N,N3,N2,N1) - 2-XOAFHS(K,N,N6,N5,N4) -8585 CONTINUE - TCOFLS(N3,N2,N1)=TCOFLS(N3,N2,N1)+XCOFLS(N,N3,N2,N1) - 2-XCOFLS(N,N6,N5,N4) - TCHFLS(N3,N2,N1)=TCHFLS(N3,N2,N1)+XCHFLS(N,N3,N2,N1) - 2-XCHFLS(N,N6,N5,N4) - TOXFLS(N3,N2,N1)=TOXFLS(N3,N2,N1)+XOXFLS(N,N3,N2,N1) - 2-XOXFLS(N,N6,N5,N4) - TNGFLS(N3,N2,N1)=TNGFLS(N3,N2,N1)+XNGFLS(N,N3,N2,N1) - 2-XNGFLS(N,N6,N5,N4) - TN2FLS(N3,N2,N1)=TN2FLS(N3,N2,N1)+XN2FLS(N,N3,N2,N1) - 2-XN2FLS(N,N6,N5,N4) - THGFLS(N3,N2,N1)=THGFLS(N3,N2,N1)+XHGFLS(N,N3,N2,N1) - 2-XHGFLS(N,N6,N5,N4) - TN4FLS(N3,N2,N1)=TN4FLS(N3,N2,N1)+XN4FLW(N,N3,N2,N1) - 2-XN4FLW(N,N6,N5,N4) - TN3FLS(N3,N2,N1)=TN3FLS(N3,N2,N1)+XN3FLW(N,N3,N2,N1) - 2-XN3FLW(N,N6,N5,N4) - TNOFLS(N3,N2,N1)=TNOFLS(N3,N2,N1)+XNOFLW(N,N3,N2,N1) - 2-XNOFLW(N,N6,N5,N4) - TNXFLS(N3,N2,N1)=TNXFLS(N3,N2,N1)+XNXFLS(N,N3,N2,N1) - 2-XNXFLS(N,N6,N5,N4) - TPOFLS(N3,N2,N1)=TPOFLS(N3,N2,N1)+XH2PFS(N,N3,N2,N1) - 2-XH2PFS(N,N6,N5,N4) - TN4FLB(N3,N2,N1)=TN4FLB(N3,N2,N1)+XN4FLB(N,N3,N2,N1) - 2-XN4FLB(N,N6,N5,N4) - TN3FLB(N3,N2,N1)=TN3FLB(N3,N2,N1)+XN3FLB(N,N3,N2,N1) - 2-XN3FLB(N,N6,N5,N4) - TNOFLB(N3,N2,N1)=TNOFLB(N3,N2,N1)+XNOFLB(N,N3,N2,N1) - 2-XNOFLB(N,N6,N5,N4) - TNXFLB(N3,N2,N1)=TNXFLB(N3,N2,N1)+XNXFLB(N,N3,N2,N1) - 2-XNXFLB(N,N6,N5,N4) - TH2BFB(N3,N2,N1)=TH2BFB(N3,N2,N1)+XH2BFB(N,N3,N2,N1) - 2-XH2BFB(N,N6,N5,N4) - TCOFHS(N3,N2,N1)=TCOFHS(N3,N2,N1)+XCOFHS(N,N3,N2,N1) - 2-XCOFHS(N,N6,N5,N4) - TCHFHS(N3,N2,N1)=TCHFHS(N3,N2,N1)+XCHFHS(N,N3,N2,N1) - 2-XCHFHS(N,N6,N5,N4) - TOXFHS(N3,N2,N1)=TOXFHS(N3,N2,N1)+XOXFHS(N,N3,N2,N1) - 2-XOXFHS(N,N6,N5,N4) - TNGFHS(N3,N2,N1)=TNGFHS(N3,N2,N1)+XNGFHS(N,N3,N2,N1) - 2-XNGFHS(N,N6,N5,N4) - TN2FHS(N3,N2,N1)=TN2FHS(N3,N2,N1)+XN2FHS(N,N3,N2,N1) - 2-XN2FHS(N,N6,N5,N4) - THGFHS(N3,N2,N1)=THGFHS(N3,N2,N1)+XHGFHS(N,N3,N2,N1) - 2-XHGFHS(N,N6,N5,N4) - TN4FHS(N3,N2,N1)=TN4FHS(N3,N2,N1)+XN4FHW(N,N3,N2,N1) - 2-XN4FHW(N,N6,N5,N4) - TN3FHS(N3,N2,N1)=TN3FHS(N3,N2,N1)+XN3FHW(N,N3,N2,N1) - 2-XN3FHW(N,N6,N5,N4) - TNOFHS(N3,N2,N1)=TNOFHS(N3,N2,N1)+XNOFHW(N,N3,N2,N1) - 2-XNOFHW(N,N6,N5,N4) - TNXFHS(N3,N2,N1)=TNXFHS(N3,N2,N1)+XNXFHS(N,N3,N2,N1) - 2-XNXFHS(N,N6,N5,N4) - TPOFHS(N3,N2,N1)=TPOFHS(N3,N2,N1)+XH2PHS(N,N3,N2,N1) - 2-XH2PHS(N,N6,N5,N4) - TN4FHB(N3,N2,N1)=TN4FHB(N3,N2,N1)+XN4FHB(N,N3,N2,N1) - 2-XN4FHB(N,N6,N5,N4) - TN3FHB(N3,N2,N1)=TN3FHB(N3,N2,N1)+XN3FHB(N,N3,N2,N1) - 2-XN3FHB(N,N6,N5,N4) - TNOFHB(N3,N2,N1)=TNOFHB(N3,N2,N1)+XNOFHB(N,N3,N2,N1) - 2-XNOFHB(N,N6,N5,N4) - TNXFHB(N3,N2,N1)=TNXFHB(N3,N2,N1)+XNXFHB(N,N3,N2,N1) - 2-XNXFHB(N,N6,N5,N4) - TH2BHB(N3,N2,N1)=TH2BHB(N3,N2,N1)+XH2BHB(N,N3,N2,N1) - 2-XH2BHB(N,N6,N5,N4) - TCOFLG(N3,N2,N1)=TCOFLG(N3,N2,N1)+XCOFLG(N,N3,N2,N1) - 2-XCOFLG(N,N6,N5,N4) - TCHFLG(N3,N2,N1)=TCHFLG(N3,N2,N1)+XCHFLG(N,N3,N2,N1) - 2-XCHFLG(N,N6,N5,N4) - TOXFLG(N3,N2,N1)=TOXFLG(N3,N2,N1)+XOXFLG(N,N3,N2,N1) - 2-XOXFLG(N,N6,N5,N4) - TNGFLG(N3,N2,N1)=TNGFLG(N3,N2,N1)+XNGFLG(N,N3,N2,N1) - 2-XNGFLG(N,N6,N5,N4) - TN2FLG(N3,N2,N1)=TN2FLG(N3,N2,N1)+XN2FLG(N,N3,N2,N1) - 2-XN2FLG(N,N6,N5,N4) - TNHFLG(N3,N2,N1)=TNHFLG(N3,N2,N1)+XN3FLG(N,N3,N2,N1) - 2-XN3FLG(N,N6,N5,N4) - THGFLG(N3,N2,N1)=THGFLG(N3,N2,N1)+XHGFLG(N,N3,N2,N1) - 2-XHGFLG(N,N6,N5,N4) - IF(ISALT(N2,N1).NE.0)THEN - TALFLS(N3,N2,N1)=TALFLS(N3,N2,N1)+XALFLS(N,N3,N2,N1) - 2-XALFLS(N,N6,N5,N4) - TFEFLS(N3,N2,N1)=TFEFLS(N3,N2,N1)+XFEFLS(N,N3,N2,N1) - 2-XFEFLS(N,N6,N5,N4) - THYFLS(N3,N2,N1)=THYFLS(N3,N2,N1)+XHYFLS(N,N3,N2,N1) - 2-XHYFLS(N,N6,N5,N4) - TCAFLS(N3,N2,N1)=TCAFLS(N3,N2,N1)+XCAFLS(N,N3,N2,N1) - 2-XCAFLS(N,N6,N5,N4) - TMGFLS(N3,N2,N1)=TMGFLS(N3,N2,N1)+XMGFLS(N,N3,N2,N1) - 2-XMGFLS(N,N6,N5,N4) - TNAFLS(N3,N2,N1)=TNAFLS(N3,N2,N1)+XNAFLS(N,N3,N2,N1) - 2-XNAFLS(N,N6,N5,N4) - TKAFLS(N3,N2,N1)=TKAFLS(N3,N2,N1)+XKAFLS(N,N3,N2,N1) - 2-XKAFLS(N,N6,N5,N4) - TOHFLS(N3,N2,N1)=TOHFLS(N3,N2,N1)+XOHFLS(N,N3,N2,N1) - 2-XOHFLS(N,N6,N5,N4) - TSOFLS(N3,N2,N1)=TSOFLS(N3,N2,N1)+XSOFLS(N,N3,N2,N1) - 2-XSOFLS(N,N6,N5,N4) - TCLFLS(N3,N2,N1)=TCLFLS(N3,N2,N1)+XCLFLS(N,N3,N2,N1) - 2-XCLFLS(N,N6,N5,N4) - TC3FLS(N3,N2,N1)=TC3FLS(N3,N2,N1)+XC3FLS(N,N3,N2,N1) - 2-XC3FLS(N,N6,N5,N4) - THCFLS(N3,N2,N1)=THCFLS(N3,N2,N1)+XHCFLS(N,N3,N2,N1) - 2-XHCFLS(N,N6,N5,N4) - TAL1FS(N3,N2,N1)=TAL1FS(N3,N2,N1)+XAL1FS(N,N3,N2,N1) - 2-XAL1FS(N,N6,N5,N4) - TAL2FS(N3,N2,N1)=TAL2FS(N3,N2,N1)+XAL2FS(N,N3,N2,N1) - 2-XAL2FS(N,N6,N5,N4) - TAL3FS(N3,N2,N1)=TAL3FS(N3,N2,N1)+XAL3FS(N,N3,N2,N1) - 2-XAL3FS(N,N6,N5,N4) - TAL4FS(N3,N2,N1)=TAL4FS(N3,N2,N1)+XAL4FS(N,N3,N2,N1) - 2-XAL4FS(N,N6,N5,N4) - TALSFS(N3,N2,N1)=TALSFS(N3,N2,N1)+XALSFS(N,N3,N2,N1) - 2-XALSFS(N,N6,N5,N4) - TFE1FS(N3,N2,N1)=TFE1FS(N3,N2,N1)+XFE1FS(N,N3,N2,N1) - 2-XFE1FS(N,N6,N5,N4) - TFE2FS(N3,N2,N1)=TFE2FS(N3,N2,N1)+XFE2FS(N,N3,N2,N1) - 2-XFE2FS(N,N6,N5,N4) - TFE3FS(N3,N2,N1)=TFE3FS(N3,N2,N1)+XFE3FS(N,N3,N2,N1) - 2-XFE3FS(N,N6,N5,N4) - TFE4FS(N3,N2,N1)=TFE4FS(N3,N2,N1)+XFE4FS(N,N3,N2,N1) - 2-XFE4FS(N,N6,N5,N4) - TFESFS(N3,N2,N1)=TFESFS(N3,N2,N1)+XFESFS(N,N3,N2,N1) - 2-XFESFS(N,N6,N5,N4) - TCAOFS(N3,N2,N1)=TCAOFS(N3,N2,N1)+XCAOFS(N,N3,N2,N1) - 2-XCAOFS(N,N6,N5,N4) - TCACFS(N3,N2,N1)=TCACFS(N3,N2,N1)+XCACFS(N,N3,N2,N1) - 2-XCACFS(N,N6,N5,N4) - TCAHFS(N3,N2,N1)=TCAHFS(N3,N2,N1)+XCAHFS(N,N3,N2,N1) - 2-XCAHFS(N,N6,N5,N4) - TCASFS(N3,N2,N1)=TCASFS(N3,N2,N1)+XCASFS(N,N3,N2,N1) - 2-XCASFS(N,N6,N5,N4) - TMGOFS(N3,N2,N1)=TMGOFS(N3,N2,N1)+XMGOFS(N,N3,N2,N1) - 2-XMGOFS(N,N6,N5,N4) - TMGCFS(N3,N2,N1)=TMGCFS(N3,N2,N1)+XMGCFS(N,N3,N2,N1) - 2-XMGCFS(N,N6,N5,N4) - TMGHFS(N3,N2,N1)=TMGHFS(N3,N2,N1)+XMGHFS(N,N3,N2,N1) - 2-XMGHFS(N,N6,N5,N4) - TMGSFS(N3,N2,N1)=TMGSFS(N3,N2,N1)+XMGSFS(N,N3,N2,N1) - 2-XMGSFS(N,N6,N5,N4) - TNACFS(N3,N2,N1)=TNACFS(N3,N2,N1)+XNACFS(N,N3,N2,N1) - 2-XNACFS(N,N6,N5,N4) - TNASFS(N3,N2,N1)=TNASFS(N3,N2,N1)+XNASFS(N,N3,N2,N1) - 2-XNASFS(N,N6,N5,N4) - TKASFS(N3,N2,N1)=TKASFS(N3,N2,N1)+XKASFS(N,N3,N2,N1) - 2-XKASFS(N,N6,N5,N4) - TH0PFS(N3,N2,N1)=TH0PFS(N3,N2,N1)+XH0PFS(N,N3,N2,N1) - 2-XH0PFS(N,N6,N5,N4) - TH1PFS(N3,N2,N1)=TH1PFS(N3,N2,N1)+XH1PFS(N,N3,N2,N1) - 2-XH1PFS(N,N6,N5,N4) - TH3PFS(N3,N2,N1)=TH3PFS(N3,N2,N1)+XH3PFS(N,N3,N2,N1) - 2-XH3PFS(N,N6,N5,N4) - TF1PFS(N3,N2,N1)=TF1PFS(N3,N2,N1)+XF1PFS(N,N3,N2,N1) - 2-XF1PFS(N,N6,N5,N4) - TF2PFS(N3,N2,N1)=TF2PFS(N3,N2,N1)+XF2PFS(N,N3,N2,N1) - 2-XF2PFS(N,N6,N5,N4) - TC0PFS(N3,N2,N1)=TC0PFS(N3,N2,N1)+XC0PFS(N,N3,N2,N1) - 2-XC0PFS(N,N6,N5,N4) - TC1PFS(N3,N2,N1)=TC1PFS(N3,N2,N1)+XC1PFS(N,N3,N2,N1) - 2-XC1PFS(N,N6,N5,N4) - TC2PFS(N3,N2,N1)=TC2PFS(N3,N2,N1)+XC2PFS(N,N3,N2,N1) - 2-XC2PFS(N,N6,N5,N4) - TM1PFS(N3,N2,N1)=TM1PFS(N3,N2,N1)+XM1PFS(N,N3,N2,N1) - 2-XM1PFS(N,N6,N5,N4) - TH0BFB(N3,N2,N1)=TH0BFB(N3,N2,N1)+XH0BFB(N,N3,N2,N1) - 2-XH0BFB(N,N6,N5,N4) - TH1BFB(N3,N2,N1)=TH1BFB(N3,N2,N1)+XH1BFB(N,N3,N2,N1) - 2-XH1BFB(N,N6,N5,N4) - TH3BFB(N3,N2,N1)=TH3BFB(N3,N2,N1)+XH3BFB(N,N3,N2,N1) - 2-XH3BFB(N,N6,N5,N4) - TF1BFB(N3,N2,N1)=TF1BFB(N3,N2,N1)+XF1BFB(N,N3,N2,N1) - 2-XF1BFB(N,N6,N5,N4) - TF2BFB(N3,N2,N1)=TF2BFB(N3,N2,N1)+XF2BFB(N,N3,N2,N1) - 2-XF2BFB(N,N6,N5,N4) - TC0BFB(N3,N2,N1)=TC0BFB(N3,N2,N1)+XC0BFB(N,N3,N2,N1) - 2-XC0BFB(N,N6,N5,N4) - TC1BFB(N3,N2,N1)=TC1BFB(N3,N2,N1)+XC1BFB(N,N3,N2,N1) - 2-XC1BFB(N,N6,N5,N4) - TC2BFB(N3,N2,N1)=TC2BFB(N3,N2,N1)+XC2BFB(N,N3,N2,N1) - 2-XC2BFB(N,N6,N5,N4) - TM1BFB(N3,N2,N1)=TM1BFB(N3,N2,N1)+XM1BFB(N,N3,N2,N1) - 2-XM1BFB(N,N6,N5,N4) - TALFHS(N3,N2,N1)=TALFHS(N3,N2,N1)+XALFHS(N,N3,N2,N1) - 2-XALFHS(N,N6,N5,N4) - TFEFHS(N3,N2,N1)=TFEFHS(N3,N2,N1)+XFEFHS(N,N3,N2,N1) - 2-XFEFHS(N,N6,N5,N4) - THYFHS(N3,N2,N1)=THYFHS(N3,N2,N1)+XHYFHS(N,N3,N2,N1) - 2-XHYFHS(N,N6,N5,N4) - TCAFHS(N3,N2,N1)=TCAFHS(N3,N2,N1)+XCAFHS(N,N3,N2,N1) - 2-XCAFHS(N,N6,N5,N4) - TMGFHS(N3,N2,N1)=TMGFHS(N3,N2,N1)+XMGFHS(N,N3,N2,N1) - 2-XMGFHS(N,N6,N5,N4) - TNAFHS(N3,N2,N1)=TNAFHS(N3,N2,N1)+XNAFHS(N,N3,N2,N1) - 2-XNAFHS(N,N6,N5,N4) - TKAFHS(N3,N2,N1)=TKAFHS(N3,N2,N1)+XKAFHS(N,N3,N2,N1) - 2-XKAFHS(N,N6,N5,N4) - TOHFHS(N3,N2,N1)=TOHFHS(N3,N2,N1)+XOHFHS(N,N3,N2,N1) - 2-XOHFHS(N,N6,N5,N4) - TSOFHS(N3,N2,N1)=TSOFHS(N3,N2,N1)+XSOFHS(N,N3,N2,N1) - 2-XSOFHS(N,N6,N5,N4) - TCLFHS(N3,N2,N1)=TCLFHS(N3,N2,N1)+XCLFHS(N,N3,N2,N1) - 2-XCLFHS(N,N6,N5,N4) - TC3FHS(N3,N2,N1)=TC3FHS(N3,N2,N1)+XC3FHS(N,N3,N2,N1) - 2-XC3FHS(N,N6,N5,N4) - THCFHS(N3,N2,N1)=THCFHS(N3,N2,N1)+XHCFHS(N,N3,N2,N1) - 2-XHCFHS(N,N6,N5,N4) - TAL1HS(N3,N2,N1)=TAL1HS(N3,N2,N1)+XAL1HS(N,N3,N2,N1) - 2-XAL1HS(N,N6,N5,N4) - TAL2HS(N3,N2,N1)=TAL2HS(N3,N2,N1)+XAL2HS(N,N3,N2,N1) - 2-XAL2HS(N,N6,N5,N4) - TAL3HS(N3,N2,N1)=TAL3HS(N3,N2,N1)+XAL3HS(N,N3,N2,N1) - 2-XAL3HS(N,N6,N5,N4) - TAL4HS(N3,N2,N1)=TAL4HS(N3,N2,N1)+XAL4HS(N,N3,N2,N1) - 2-XAL4HS(N,N6,N5,N4) - TALSHS(N3,N2,N1)=TALSHS(N3,N2,N1)+XALSHS(N,N3,N2,N1) - 2-XALSHS(N,N6,N5,N4) - TFE1HS(N3,N2,N1)=TFE1HS(N3,N2,N1)+XFE1HS(N,N3,N2,N1) - 2-XFE1HS(N,N6,N5,N4) - TFE2HS(N3,N2,N1)=TFE2HS(N3,N2,N1)+XFE2HS(N,N3,N2,N1) - 2-XFE2HS(N,N6,N5,N4) - TFE3HS(N3,N2,N1)=TFE3HS(N3,N2,N1)+XFE3HS(N,N3,N2,N1) - 2-XFE3HS(N,N6,N5,N4) - TFE4HS(N3,N2,N1)=TFE4HS(N3,N2,N1)+XFE4HS(N,N3,N2,N1) - 2-XFE4HS(N,N6,N5,N4) - TFESHS(N3,N2,N1)=TFESHS(N3,N2,N1)+XFESHS(N,N3,N2,N1) - 2-XFESHS(N,N6,N5,N4) - TCAOHS(N3,N2,N1)=TCAOHS(N3,N2,N1)+XCAOHS(N,N3,N2,N1) - 2-XCAOHS(N,N6,N5,N4) - TCACHS(N3,N2,N1)=TCACHS(N3,N2,N1)+XCACHS(N,N3,N2,N1) - 2-XCACHS(N,N6,N5,N4) - TCAHHS(N3,N2,N1)=TCAHHS(N3,N2,N1)+XCAHHS(N,N3,N2,N1) - 2-XCAHHS(N,N6,N5,N4) - TCASHS(N3,N2,N1)=TCASHS(N3,N2,N1)+XCASHS(N,N3,N2,N1) - 2-XCASHS(N,N6,N5,N4) - TMGOHS(N3,N2,N1)=TMGOHS(N3,N2,N1)+XMGOHS(N,N3,N2,N1) - 2-XMGOHS(N,N6,N5,N4) - TMGCHS(N3,N2,N1)=TMGCHS(N3,N2,N1)+XMGCHS(N,N3,N2,N1) - 2-XMGCHS(N,N6,N5,N4) - TMGHHS(N3,N2,N1)=TMGHHS(N3,N2,N1)+XMGHHS(N,N3,N2,N1) - 2-XMGHHS(N,N6,N5,N4) - TMGSHS(N3,N2,N1)=TMGSHS(N3,N2,N1)+XMGSHS(N,N3,N2,N1) - 2-XMGSHS(N,N6,N5,N4) - TNACHS(N3,N2,N1)=TNACHS(N3,N2,N1)+XNACHS(N,N3,N2,N1) - 2-XNACHS(N,N6,N5,N4) - TNASHS(N3,N2,N1)=TNASHS(N3,N2,N1)+XNASHS(N,N3,N2,N1) - 2-XNASHS(N,N6,N5,N4) - TKASHS(N3,N2,N1)=TKASHS(N3,N2,N1)+XKASHS(N,N3,N2,N1) - 2-XKASHS(N,N6,N5,N4) - TH0PHS(N3,N2,N1)=TH0PHS(N3,N2,N1)+XH0PHS(N,N3,N2,N1) - 2-XH0PHS(N,N6,N5,N4) - TH1PHS(N3,N2,N1)=TH1PHS(N3,N2,N1)+XH1PHS(N,N3,N2,N1) - 2-XH1PHS(N,N6,N5,N4) - TH3PHS(N3,N2,N1)=TH3PHS(N3,N2,N1)+XH3PHS(N,N3,N2,N1) - 2-XH3PHS(N,N6,N5,N4) - TF1PHS(N3,N2,N1)=TF1PHS(N3,N2,N1)+XF1PHS(N,N3,N2,N1) - 2-XF1PHS(N,N6,N5,N4) - TF2PHS(N3,N2,N1)=TF2PHS(N3,N2,N1)+XF2PHS(N,N3,N2,N1) - 2-XF2PHS(N,N6,N5,N4) - TC0PHS(N3,N2,N1)=TC0PHS(N3,N2,N1)+XC0PHS(N,N3,N2,N1) - 2-XC0PHS(N,N6,N5,N4) - TC1PHS(N3,N2,N1)=TC1PHS(N3,N2,N1)+XC1PHS(N,N3,N2,N1) - 2-XC1PHS(N,N6,N5,N4) - TC2PHS(N3,N2,N1)=TC2PHS(N3,N2,N1)+XC2PHS(N,N3,N2,N1) - 2-XC2PHS(N,N6,N5,N4) - TM1PHS(N3,N2,N1)=TM1PHS(N3,N2,N1)+XM1PHS(N,N3,N2,N1) - 2-XM1PHS(N,N6,N5,N4) - TH0BHB(N3,N2,N1)=TH0BHB(N3,N2,N1)+XH0BHB(N,N3,N2,N1) - 2-XH0BHB(N,N6,N5,N4) - TH1BHB(N3,N2,N1)=TH1BHB(N3,N2,N1)+XH1BHB(N,N3,N2,N1) - 2-XH1BHB(N,N6,N5,N4) - TH3BHB(N3,N2,N1)=TH3BHB(N3,N2,N1)+XH3BHB(N,N3,N2,N1) - 2-XH3BHB(N,N6,N5,N4) - TF1BHB(N3,N2,N1)=TF1BHB(N3,N2,N1)+XF1BHB(N,N3,N2,N1) - 2-XF1BHB(N,N6,N5,N4) - TF2BHB(N3,N2,N1)=TF2BHB(N3,N2,N1)+XF2BHB(N,N3,N2,N1) - 2-XF2BHB(N,N6,N5,N4) - TC0BHB(N3,N2,N1)=TC0BHB(N3,N2,N1)+XC0BHB(N,N3,N2,N1) - 2-XC0BHB(N,N6,N5,N4) - TC1BHB(N3,N2,N1)=TC1BHB(N3,N2,N1)+XC1BHB(N,N3,N2,N1) - 2-XC1BHB(N,N6,N5,N4) - TC2BHB(N3,N2,N1)=TC2BHB(N3,N2,N1)+XC2BHB(N,N3,N2,N1) - 2-XC2BHB(N,N6,N5,N4) - TM1BHB(N3,N2,N1)=TM1BHB(N3,N2,N1)+XM1BHB(N,N3,N2,N1) - 2-XM1BHB(N,N6,N5,N4) - ENDIF - ENDIF -8580 CONTINUE -8575 CONTINUE -C -C CALCULATE SURFACE RESIDUE TEMPERATURE FROM ITS CHANGE -C IN HEAT STORAGE -C - HFLXD=2.496E-06*(OSGX-ORGC(0,NY,NX))*TKS(0,NY,NX) - VOLW(0,NY,NX)=VOLW(0,NY,NX)+FLWR(NY,NX)+THAWR(NY,NX) - 2+TQR(NY,NX)+18.0E-06*TRH2O(0,NY,NX) - VOLI(0,NY,NX)=VOLI(0,NY,NX)-THAWR(NY,NX)/0.92 - ENGYR=VHCPR(NY,NX)*TKS(0,NY,NX)-HFLXD - VHCPR(NY,NX)=2.496E-06*ORGC(0,NY,NX)+4.19*VOLW(0,NY,NX) - 2+1.9274*VOLI(0,NY,NX) - IF(VHCPR(NY,NX).GT.ZEROS(NY,NX))THEN - TKS(0,NY,NX)=(ENGYR+HFLWR(NY,NX)+HTHAWR(NY,NX) - 2+THQR(NY,NX))/VHCPR(NY,NX) - ELSE - TKS(0,NY,NX)=TKS(NU(NY,NX),NY,NX) - ENDIF - IF(VHCPR(NY,NX).LT.VHCPRX(NY,NX))THEN - HFLXR=VHCPR(NY,NX)*(TKS(0,NY,NX)-TKS(NU(NY,NX),NY,NX)) - HEATOU=HEATOU+HFLXR - TKS(0,NY,NX)=TKS(NU(NY,NX),NY,NX) - ENDIF - HEATIN=HEATIN+HTHAWR(NY,NX)-HFLXD -C UVOLW(NY,NX)=UVOLW(NY,NX)-VOLW(0,NY,NX)-VOLI(0,NY,NX)*0.92 -C -C SURFACE BOUNDARY WATER FLUXES -C - WI=PRECQ(NY,NX)+PRECI(NY,NX) - CRAIN=CRAIN+WI - URAIN(NY,NX)=URAIN(NY,NX)+WI - WO=TEVAPG(NY,NX)+TEVAPP(NY,NX) - CEVAP=CEVAP-WO - UEVAP(NY,NX)=UEVAP(NY,NX)-WO - VOLWOU=VOLWOU-PRECU(NY,NX)-18.0E-06*TRH2O(0,NY,NX) - HVOLO(NY,NX)=HVOLO(NY,NX)-PRECU(NY,NX) - UVOLO(NY,NX)=UVOLO(NY,NX)-PRECU(NY,NX) - UDRAIN(NY,NX)=UDRAIN(NY,NX)+FLW(3,NK(NY,NX),NY,NX) -C -C SURFACE BOUNDARY HEAT FLUXES -C - HEATIN=HEATIN+4.19*TKA(NY,NX)*PRECA(NY,NX) - 2+2.095*TKA(NY,NX)*PRECW(NY,NX) - HEATIN=HEATIN+HEATH(NY,NX)+HTHAWW(NY,NX)+THFLXC(NY,NX) - HEATOU=HEATOU-4.19*TKA(NY,NX)*PRECU(NY,NX) -C WRITE(*,5151)'TK0',I,J,NX,NY,TKS(0,NY,NX),ENGYR -C 2,HFLWR(NY,NX),HFLXD,HTHAWR(NY,NX),VHCPR(NY,NX),VOLW(0,NY,NX) -C 3,VOLI(0,NY,NX),FLWR(NY,NX),THAWR(NY,NX),TRH2O(0,NY,NX) -C 3,ORGC(0,NY,NX),VHCPR(NY,NX)*TKS(0,NY,NX),TQR(NY,NX) -C 4,THQR(NY,NX),HEATH(NY,NX),HTHAWW(NY,NX),THFLXC(NY,NX),HEATIN -5151 FORMAT(A8,4I4,30F20.6) -C -C SURFACE BOUNDARY CO2, CH4 AND DOC FLUXES -C - CI=XCODFS(NY,NX)+XCOFLG(3,NU(NY,NX),NY,NX)+TCO2Z(NY,NX) - 2+(FLQGQ(NY,NX)+FLQRQ(NY,NX))*CCOR(NY,NX) - 3+(FLQGI(NY,NX)+FLQRI(NY,NX))*CCOQ(NY,NX) - 4+XCODFG(0,NY,NX)+XCODFR(NY,NX) - CH=XCHDFS(NY,NX)+XCHFLG(3,NU(NY,NX),NY,NX)+TCH4Z(NY,NX) - 2+(FLQGQ(NY,NX)+FLQRQ(NY,NX))*CCHR(NY,NX) - 3+(FLQGI(NY,NX)+FLQRI(NY,NX))*CCHQ(NY,NX) - 4+XCHDFG(0,NY,NX)+XCHDFR(NY,NX) - CO=-PRECU(NY,NX)*CCOQ(NY,NX) - CX=-PRECU(NY,NX)*CCHQ(NY,NX) - UCO2G(NY,NX)=UCO2G(NY,NX)+CI - HCO2G(NY,NX)=HCO2G(NY,NX)+CI - UCH4G(NY,NX)=UCH4G(NY,NX)+CH - HCH4G(NY,NX)=HCH4G(NY,NX)+CH - CO2GIN=CO2GIN+CI+CH - TCOU=TCOU+CO+CX - TNBP(NY,NX)=TNBP(NY,NX)+CH -C IF(NX.EQ.3.AND.NY.EQ.3)THEN -C WRITE(*,6644)'CO2',I,J,NX,NY,HCO2G(NY,NX),CI,XCODFS(NY,NX) -C 2,XCOFLG(3,NU(NY,NX),NY,NX),TCO2Z(NY,NX) -C 3,(FLQGQ(NY,NX)+FLQRQ(NY,NX))*CCOR(NY,NX) -C 4,(FLQGI(NY,NX)+FLQRI(NY,NX))*CCOQ(NY,NX) -C 5,XCODFG(0,NY,NX),XCODFR(NY,NX),VOLP(0,NY,NX) -C 6,VOLP(NU(NY,NX),NY,NX) -C WRITE(*,6644)'CH4',I,J,NX,NY,CH,XCHDFS(NY,NX) -C 2,XCHFLG(3,NU(NY,NX),NY,NX),TCH4Z(NY,NX),FLQGQ(NY,NX) -C 3,FLQRQ(NY,NX),FLQGI(NY,NX),FLQRI(NY,NX),CCHR(NY,NX),CCHQ(NY,NX) -C 4,XCHDFG(0,NY,NX),XCHDFR(NY,NX),CH4S(NU(NY,NX),NY,NX) -6644 FORMAT(A8,4I4,30E12.4) -C ENDIF -C -C SURFACE BOUNDARY O2 FLUXES -C - OI=XOXDFS(NY,NX)+XOXFLG(3,NU(NY,NX),NY,NX)+TOXYZ(NY,NX) - 2+(FLQGQ(NY,NX)+FLQRQ(NY,NX))*COXR(NY,NX) - 3+(FLQGI(NY,NX)+FLQRI(NY,NX))*COXQ(NY,NX) - 4+XOXDFG(0,NY,NX)+XOXDFR(NY,NX) - OO=RUPOXO(0,NY,NX)-PRECU(NY,NX)*COXQ(NY,NX) - UOXYG(NY,NX)=UOXYG(NY,NX)+OI - HOXYG(NY,NX)=HOXYG(NY,NX)+OI - OXYGIN=OXYGIN+OI - OXYGOU=OXYGOU+OO -C IF(NX.EQ.2.AND.NY.EQ.1)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) -C 3,(FLQGI(NY,NX)+FLQRI(NY,NX))*CCOQ(NY,NX) -C 4,XCODFG(0,NY,NX),XCODFR(NY,NX) -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) -6646 FORMAT(A8,4I4,60E12.4) -C ENDIF -C -C SURFACE BOUNDARY N2, N2O, NH3, NH4, NO3, AND DON FLUXES -C - ZN2GIN=ZN2GIN+XNGDFS(NY,NX)+XN2DFS(NY,NX)+XN3DFS(NY,NX) - 2+XNBDFS(NY,NX)+XNGFLG(3,NU(NY,NX),NY,NX)+XN2FLG(3,NU(NY,NX),NY,NX) - 3+XN3FLG(3,NU(NY,NX),NY,NX)+TN2OZ(NY,NX)+TNH3Z(NY,NX) - 4+(FLQGQ(NY,NX)+FLQRQ(NY,NX))*(CNNR(NY,NX)+CN2R(NY,NX)) - 5+(FLQGI(NY,NX)+FLQRI(NY,NX))*(CNNQ(NY,NX)+CN2Q(NY,NX)) - 6+XN2DFG(0,NY,NX)+XNGDFG(0,NY,NX)+XN3DFG(0,NY,NX) - 7+XNGDFR(NY,NX)+XN2DFR(NY,NX)+XN3DFR(NY,NX) - TZIN=TZIN+((FLQGQ(NY,NX)+FLQRQ(NY,NX)) - 2*(CN4R(NY,NX)+CN3R(NY,NX)+CNOR(NY,NX)) - 3+(FLQGI(NY,NX)+FLQRI(NY,NX))*(CN4Q(I,NY,NX)+CN3Q(I,NY,NX) - 4+CNOQ(I,NY,NX)))*14.0 - TZOU=TZOU-PRECU(NY,NX)*(CNNQ(NY,NX)+CN2Q(NY,NX))-PRECU(NY,NX) - 2*(CN4Q(I,NY,NX)+CN3Q(I,NY,NX)+CNOQ(I,NY,NX))*14.0 - ZDRAIN(NY,NX)=ZDRAIN(NY,NX)+XN4FLW(3,NK(NY,NX),NY,NX) - 2+XN3FLW(3,NK(NY,NX),NY,NX)+XNOFLW(3,NK(NY,NX),NY,NX) - 3+XNXFLS(3,NK(NY,NX),NY,NX)+XN4FLB(3,NK(NY,NX),NY,NX) - 4+XN3FLB(3,NK(NY,NX),NY,NX)+XNOFLB(3,NK(NY,NX),NY,NX) - 5+XNXFLB(3,NK(NY,NX),NY,NX) - ZNGGIN=XNGDFS(NY,NX)+XNGFLG(3,NU(NY,NX),NY,NX)+XNGDFG(0,NY,NX) - ZN2OIN=XN2DFS(NY,NX)+XN2FLG(3,NU(NY,NX),NY,NX)+XN2DFG(0,NY,NX) - ZNH3IN=XN3DFS(NY,NX)+XNBDFS(NY,NX)+XN3FLG(3,NU(NY,NX),NY,NX) - 2+XN3DFG(0,NY,NX) - TI=XHGDFS(NY,NX)+XHGFLG(3,NU(NY,NX),NY,NX)+TH2GZ(NY,NX) - 2+XHGDFG(0,NY,NX)+XHGDFR(NY,NX) -C UN2GG(NY,NX)=UN2GG(NY,NX)+ZNGGIN -C HN2GG(NY,NX)=HN2GG(NY,NX)+ZNGGIN - UN2OG(NY,NX)=UN2OG(NY,NX)+ZN2OIN - HN2OG(NY,NX)=HN2OG(NY,NX)+ZN2OIN - UNH3G(NY,NX)=UNH3G(NY,NX)+ZNH3IN - HNH3G(NY,NX)=HNH3G(NY,NX)+ZNH3IN - UN2GS(NY,NX)=UN2GS(NY,NX)+XN2GS(0,NY,NX) - UH2GG(NY,NX)=UH2GG(NY,NX)+TI -C WRITE(*,6644)'HNH3G',I,J,NX,NY,HNH3G(NY,NX),ZNH3IN -C 2,XN3DFS(NY,NX),XNBDFS(NY,NX),XN3FLG(3,NU(NY,NX),NY,NX) -C 2,XN3DFG(0,NY,NX) -C WRITE(*,6644)'ZN2GIN',I,J,NX,NY,ZN2GIN,XNGDFS(NY,NX) -C 3,XN2DFS(NY,NX),XN3DFS(NY,NX) -C 2,XNBDFS(NY,NX),XNGFLG(3,NU(NY,NX),NY,NX),XN2FLG(3,NU(NY,NX),NY,NX) -C 3,XN3FLG(3,NU(NY,NX),NY,NX),TN2OZ(NY,NX),TNH3Z(NY,NX) -C 4,(FLQGQ(NY,NX)+FLQRQ(NY,NX))*(CNNR(NY,NX)+CN2R(NY,NX)) -C 5,(FLQGI(NY,NX)+FLQRI(NY,NX))*(CNNQ(NY,NX)+CN2Q(NY,NX)) -C 6,XN2DFG(0,NY,NX)+XNGDFG(0,NY,NX),XN3DFG(0,NY,NX) -C 7,XNGDFR(NY,NX)+XN2DFR(NY,NX),XN3DFR(NY,NX) -C -C SURFACE BOUNDARY PO4 AND DOP FLUXES -C - TPIN=TPIN+((FLQGQ(NY,NX)+FLQRQ(NY,NX))*CPOR(NY,NX) - 2+(FLQGI(NY,NX)+FLQRI(NY,NX))*CPOQ(I,NY,NX))*31.0 - TPOU=TPOU-PRECU(NY,NX)*CPOQ(I,NY,NX)*31.0 - PDRAIN(NY,NX)=PDRAIN(NY,NX)+XH2PFS(3,NK(NY,NX),NY,NX) - 2+XH2BFB(3,NK(NY,NX),NY,NX) -C -C SURFACE BOUNDARY ION FLUXES -C - TZOU=TZOU-14.0*(TBNH4(0,NY,NX)+TBNO3(0,NY,NX)+TBNH3(0,NY,NX)) - TPOU=TPOU-31.0*TBH2P(0,NY,NX) - TO=2.0*TRH2O(0,NY,NX)+2.0*TBNH4(0,NY,NX) - 2+TBNH3(0,NY,NX)+TBNO3(0,NY,NX)+3.0*TBH2P(0,NY,NX) - 3+RH2GO(0,NY,NX)+TBION(0,NY,NX) - TIONIN=TIONIN+TI - TIONOU=TIONOU+TO -C UIONOU(NY,NX)=UIONOU(NY,NX)+TO -C -C ACCUMULATE PLANT LITTERFALL FLUXES -C - XCSN=XCSN+ZCSNC(NY,NX) - XZSN=XZSN+ZZSNC(NY,NX) - XPSN=XPSN+ZPSNC(NY,NX) - UXCSN(NY,NX)=UXCSN(NY,NX)+ZCSNC(NY,NX) - UXZSN(NY,NX)=UXZSN(NY,NX)+ZZSNC(NY,NX) - UXPSN(NY,NX)=UXPSN(NY,NX)+ZPSNC(NY,NX) -C -C SURFACE BOUNDARY SALT FLUXES FROM RAINFALL AND SURFACE IRRIGATION -C - IF(ISALT(NY,NX).NE.0)THEN - SR=PRECQ(NY,NX)*(CALR(NY,NX)+CFER(NY,NX)+CHYR(NY,NX)+CCAR(NY,NX) - 2+CMGR(NY,NX)+CNAR(NY,NX)+CKAR(NY,NX)+COHR(NY,NX)+CSOR(NY,NX) - 3+CCLR(NY,NX)+CC3R(NY,NX)+CH0PR(NY,NX) - 4+2.0*(CHCR(NY,NX)+CAL1R(NY,NX)+CALSR(NY,NX)+CFE1R(NY,NX) - 5+CFESR(NY,NX)+CCAOR(NY,NX)+CCACR(NY,NX)+CCASR(NY,NX)+CMGOR(NY,NX) - 6+CMGCR(NY,NX)+CMGSR(NY,NX)+CNACR(NY,NX)+CNASR(NY,NX) - 7+CKASR(NY,NX)+CH1PR(NY,NX)+CC0PR(NY,NX)) - 8+3.0*(CAL2R(NY,NX)+CFE2R(NY,NX)+CCAHR(NY,NX)+CMGHR(NY,NX) - 9+CF1PR(NY,NX)+CC1PR(NY,NX)+CM1PR(NY,NX)) - 1+4.0*(CAL3R(NY,NX)+CFE3R(NY,NX)+CH3PR(NY,NX)+CF2PR(NY,NX) - 2+CC2PR(NY,NX)) - 3+5.0*(CAL4R(NY,NX)+CFE4R(NY,NX))) - SI=PRECI(NY,NX)*(CALQ(I,NY,NX)+CFEQ(I,NY,NX)+CHYQ(I,NY,NX) - 2+CCAQ(I,NY,NX)+CMGQ(I,NY,NX)+CNAQ(I,NY,NX)+CKAQ(I,NY,NX) - 3+COHQ(I,NY,NX)+CSOQ(I,NY,NX)+CCLQ(I,NY,NX)+CC3Q(I,NY,NX) - 4+CH0PQ(I,NY,NX)+2.0*(CHCQ(I,NY,NX)+CAL1Q(I,NY,NX)+CALSQ(I,NY,NX) - 5+CFE1Q(I,NY,NX)+CFESQ(I,NY,NX)+CCAOQ(I,NY,NX)+CCACQ(I,NY,NX) - 6+CCASQ(I,NY,NX)+CMGOQ(I,NY,NX)+CMGCQ(I,NY,NX)+CMGSQ(I,NY,NX) - 7+CNACQ(I,NY,NX)+CNASQ(I,NY,NX)+CKASQ(I,NY,NX)+CH1PQ(I,NY,NX) - 8+CC0PQ(I,NY,NX))+3.0*(CAL2Q(I,NY,NX)+CFE2Q(I,NY,NX) - 9+CCAHQ(I,NY,NX)+CMGHQ(I,NY,NX)+CF1PQ(I,NY,NX)+CC1PQ(I,NY,NX) - 1+CM1PQ(I,NY,NX))+4.0*(CAL3Q(I,NY,NX)+CFE3Q(I,NY,NX) - 2+CH3PQ(I,NY,NX)+CF2PQ(I,NY,NX)+CC2PQ(I,NY,NX)) - 3+5.0*(CAL4Q(I,NY,NX)+CFE4Q(I,NY,NX))) - TIONIN=TIONIN+SR+SI -C -C SUBSURFACE BOUNDARY SALT FLUXES FROM SUBSURFACE IRRIGATION -C - SI=PRECU(NY,NX)*(CALQ(I,NY,NX)+CFEQ(I,NY,NX)+CHYQ(I,NY,NX) - 2+CCAQ(I,NY,NX)+CMGQ(I,NY,NX)+CNAQ(I,NY,NX)+CKAQ(I,NY,NX) - 3+COHQ(I,NY,NX)+CSOQ(I,NY,NX)+CCLQ(I,NY,NX)+CC3Q(I,NY,NX) - 4+CH0PQ(I,NY,NX)+2.0*(CHCQ(I,NY,NX)+CAL1Q(I,NY,NX)+CALSQ(I,NY,NX) - 5+CFE1Q(I,NY,NX)+CFESQ(I,NY,NX)+CCAOQ(I,NY,NX)+CCACQ(I,NY,NX) - 6+CCASQ(I,NY,NX)+CMGOQ(I,NY,NX)+CMGCQ(I,NY,NX)+CMGSQ(I,NY,NX) - 7+CNACQ(I,NY,NX)+CNASQ(I,NY,NX)+CKASQ(I,NY,NX)+CH1PQ(I,NY,NX) - 8+CC0PQ(I,NY,NX))+3.0*(CAL2Q(I,NY,NX)+CFE2Q(I,NY,NX) - 9+CCAHQ(I,NY,NX)+CMGHQ(I,NY,NX)+CF1PQ(I,NY,NX)+CC1PQ(I,NY,NX) - 1+CM1PQ(I,NY,NX))+4.0*(CAL3Q(I,NY,NX)+CFE3Q(I,NY,NX) - 2+CH3PQ(I,NY,NX)+CF2PQ(I,NY,NX)+CC2PQ(I,NY,NX)) - 3+5.0*(CAL4Q(I,NY,NX)+CFE4Q(I,NY,NX))) - TIONIN=TIONIN+SI - ENDIF -C -C GAS EXCHANGE FROM SURFACE VOLATILIZATION-DISSOLUTION -C - DO 9680 K=0,2 - OQC(K,0,NY,NX)=OQC(K,0,NY,NX)+XOCFLS(K,3,0,NY,NX) - OQN(K,0,NY,NX)=OQN(K,0,NY,NX)+XONFLS(K,3,0,NY,NX) - OQP(K,0,NY,NX)=OQP(K,0,NY,NX)+XOPFLS(K,3,0,NY,NX) - OQA(K,0,NY,NX)=OQA(K,0,NY,NX)+XOAFLS(K,3,0,NY,NX) -9680 CONTINUE - CO2S(0,NY,NX)=CO2S(0,NY,NX)+XCODFR(NY,NX)+XCOFLS(3,0,NY,NX) - 2+XCODFG(0,NY,NX)-RCO2O(0,NY,NX) - CH4S(0,NY,NX)=CH4S(0,NY,NX)+XCHDFR(NY,NX)+XCHFLS(3,0,NY,NX) - 2+XCHDFG(0,NY,NX)-RCH4O(0,NY,NX) - OXYS(0,NY,NX)=OXYS(0,NY,NX)+XOXDFR(NY,NX)+XOXFLS(3,0,NY,NX) - 2+XOXDFG(0,NY,NX)-RUPOXO(0,NY,NX) - Z2GS(0,NY,NX)=Z2GS(0,NY,NX)+XNGDFR(NY,NX)+XNGFLS(3,0,NY,NX) - 2+XNGDFG(0,NY,NX)-RN2G(0,NY,NX)-XN2GS(0,NY,NX) - Z2OS(0,NY,NX)=Z2OS(0,NY,NX)+XN2DFR(NY,NX)+XN2FLS(3,0,NY,NX) - 2+XN2DFG(0,NY,NX)-RN2O(0,NY,NX) - H2GS(0,NY,NX)=H2GS(0,NY,NX)+XHGDFR(NY,NX)+XHGFLS(3,0,NY,NX) - 2+XHGDFG(0,NY,NX)-RH2GO(0,NY,NX) - ZNH4S(0,NY,NX)=ZNH4S(0,NY,NX)+XN4FLW(3,0,NY,NX) - 2+XNH4S(0,NY,NX)+TRN4S(0,NY,NX)+XN34SQ(0,NY,NX) - ZNH3S(0,NY,NX)=ZNH3S(0,NY,NX)+XN3DFR(NY,NX)+XN3FLW(3,0,NY,NX) - 2+XN3DFG(0,NY,NX)+TRN3S(0,NY,NX)-XN34SQ(0,NY,NX) - ZNO3S(0,NY,NX)=ZNO3S(0,NY,NX)+XNOFLW(3,0,NY,NX) - 2+XNO3S(0,NY,NX)+TRNO3(0,NY,NX) - ZNO2S(0,NY,NX)=ZNO2S(0,NY,NX)+XNXFLS(3,0,NY,NX) - 2+XNO2S(0,NY,NX) - H2PO4(0,NY,NX)=H2PO4(0,NY,NX)+XH2PFS(3,0,NY,NX) - 2+XH2PS(0,NY,NX)+TRH2P(0,NY,NX) - CO2S(NU(NY,NX),NY,NX)=CO2S(NU(NY,NX),NY,NX)+XCODFS(NY,NX) - CH4S(NU(NY,NX),NY,NX)=CH4S(NU(NY,NX),NY,NX)+XCHDFS(NY,NX) - OXYS(NU(NY,NX),NY,NX)=OXYS(NU(NY,NX),NY,NX)+XOXDFS(NY,NX) - Z2GS(NU(NY,NX),NY,NX)=Z2GS(NU(NY,NX),NY,NX)+XNGDFS(NY,NX) - Z2OS(NU(NY,NX),NY,NX)=Z2OS(NU(NY,NX),NY,NX)+XN2DFS(NY,NX) - ZNH3S(NU(NY,NX),NY,NX)=ZNH3S(NU(NY,NX),NY,NX)+XN3DFS(NY,NX) - ZNH3B(NU(NY,NX),NY,NX)=ZNH3B(NU(NY,NX),NY,NX)+XNBDFS(NY,NX) - H2GS(NU(NY,NX),NY,NX)=H2GS(NU(NY,NX),NY,NX)+XHGDFS(NY,NX) - SED(NY,NX)=SED(NY,NX)+XDTSED(NY,NX) - THRE(NY,NX)=THRE(NY,NX)+RCO2O(0,NY,NX) - UN2GG(NY,NX)=UN2GG(NY,NX)+RN2G(0,NY,NX) - HN2GG(NY,NX)=HN2GG(NY,NX)+RN2G(0,NY,NX) - ROXYF(0,NY,NX)=XOXDFG(0,NY,NX) - RCO2F(0,NY,NX)=XCODFG(0,NY,NX) - RCH4F(0,NY,NX)=XCHDFG(0,NY,NX) - ROXYL(0,NY,NX)=XOXDFR(NY,NX)+XOXFLS(3,0,NY,NX) - 2-(FLQRQ(NY,NX)*COXR(NY,NX)+FLQRI(NY,NX)*COXQ(NY,NX)) - RCH4L(0,NY,NX)=XCHDFR(NY,NX)+XCHFLS(3,0,NY,NX) - 2-(FLQRQ(NY,NX)*CCHR(NY,NX)+FLQRI(NY,NX)*CCHQ(NY,NX)) - ROXYL(NU(NY,NX),NY,NX)=ROXYL(NU(NY,NX),NY,NX)+XOXDFS(NY,NX) - RCH4L(NU(NY,NX),NY,NX)=RCH4L(NU(NY,NX),NY,NX)+XCHDFS(NY,NX) -C IF(NX.EQ.1.AND.NY.EQ.6)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) -C WRITE(*,1119)'CH4S0',I,J,NX,NY,CH4S(0,NY,NX),XCHDFS(NY,NX) -C 2,XCHDFR(NY,NX),XCHFLS(3,0,NY,NX),RCH4O(0,NY,NX),XCHDFG(0,NY,NX) -C 3,RCH4L(0,NY,NX) -C WRITE(*,1119)'OXYS0',I,J,NX,NY,OXYS(0,NY,NX),XOXDFR(NY,NX) -C 2,XOXFLS(3,0,NY,NX),XOXDFG(0,NY,NX),RUPOXO(0,NY,NX) -C 3,ROXYL(0,NY,NX),TOXQRS(NY,NX) -1119 FORMAT(A8,4I4,12E12.4) -C ENDIF -C IF(NX.EQ.5)THEN -C WRITE(*,5533)'ZNH4S0',I,J,NX,NY,ZNH4S(0,NY,NX),XN4FLW(3,0,NY,NX) -C 2,XNH4S(0,NY,NX),XN3FLW(3,0,NY,NX),TRN4S(0,NY,NX) -C 3,ZNH3S(0,NY,NX),TRN3S(0,NY,NX),XN3DFG(0,NY,NX),XN34SQ(0,NY,NX) -C 4,ZNHUFA(0,NY,NX),XNO2S(0,NY,NX),XN4(0,NY,NX)*14.0 -C WRITE(*,5533)'ZNO3S0',I,J,NX,NY,ZNO3S(0,NY,NX),XNOFLW(3,0,NY,NX) -C 2,XNO3S(0,NY,NX),TRNO3(0,NY,NX),ZNO2S(0,NY,NX),XNXFLS(3,0,NY,NX) -C 3,XNO2S(0,NY,NX) -C WRITE(*,5533)'H2PO40',I,J,NX,NY,H2PO4(0,NY,NX) -C 2,XH2PFS(3,0,NY,NX),XH2PS(0,NY,NX),TRH2P(0,NY,NX) -5533 FORMAT(A8,4I4,20E12.4) -C ENDIF -C -C OVERLAND FLOW -C - IF(TQR(NY,NX).NE.0.0)THEN -C -C DOC, DON, DOP -C - DO 8570 K=0,2 - OQC(K,0,NY,NX)=OQC(K,0,NY,NX)+TOCQRS(K,NY,NX) - OQN(K,0,NY,NX)=OQN(K,0,NY,NX)+TONQRS(K,NY,NX) - OQP(K,0,NY,NX)=OQP(K,0,NY,NX)+TOPQRS(K,NY,NX) - OQA(K,0,NY,NX)=OQA(K,0,NY,NX)+TOAQRS(K,NY,NX) -C IF(NX.EQ.1.AND.NY.EQ.6)THEN -C WRITE(*,2626)'OQC0',I,J,NX,NY,K,OQC(K,0,NY,NX) -C 2,TOCQRS(K,NY,NX),OQN(K,0,NY,NX),TONQRS(K,NY,NX) -2626 FORMAT(A8,5I4,20E12.4) -C ENDIF -8570 CONTINUE -C -C SOLUTES -C - CO2S(0,NY,NX)=CO2S(0,NY,NX)+TCOQRS(NY,NX) - CH4S(0,NY,NX)=CH4S(0,NY,NX)+TCHQRS(NY,NX) - OXYS(0,NY,NX)=OXYS(0,NY,NX)+TOXQRS(NY,NX) - Z2GS(0,NY,NX)=Z2GS(0,NY,NX)+TNGQRS(NY,NX) - Z2OS(0,NY,NX)=Z2OS(0,NY,NX)+TN2QRS(NY,NX) - H2GS(0,NY,NX)=H2GS(0,NY,NX)+THGQRS(NY,NX) - ZNH4S(0,NY,NX)=ZNH4S(0,NY,NX)+TN4QRS(NY,NX) - ZNH3S(0,NY,NX)=ZNH3S(0,NY,NX)+TN3QRS(NY,NX) - ZNO3S(0,NY,NX)=ZNO3S(0,NY,NX)+TNOQRS(NY,NX) - ZNO2S(0,NY,NX)=ZNO2S(0,NY,NX)+TNXQRS(NY,NX) - H2PO4(0,NY,NX)=H2PO4(0,NY,NX)+TPOQRS(NY,NX) - IF(ISALT(NY,NX).NE.0)THEN - ZAL(0,NY,NX)=ZAL(0,NY,NX)+TQRAL(NY,NX) - ZFE(0,NY,NX)=ZFE(0,NY,NX)+TQRFE(NY,NX) - ZHY(0,NY,NX)=ZHY(0,NY,NX)+TQRHY(NY,NX) - ZCA(0,NY,NX)=ZCA(0,NY,NX)+TQRCA(NY,NX) - ZMG(0,NY,NX)=ZMG(0,NY,NX)+TQRMG(NY,NX) - ZNA(0,NY,NX)=ZNA(0,NY,NX)+TQRNA(NY,NX) - ZKA(0,NY,NX)=ZKA(0,NY,NX)+TQRKA(NY,NX) - ZOH(0,NY,NX)=ZOH(0,NY,NX)+TQROH(NY,NX) - ZSO4(0,NY,NX)=ZSO4(0,NY,NX)+TQRSO(NY,NX) - ZCL(0,NY,NX)=ZCL(0,NY,NX)+TQRCL(NY,NX) - ZCO3(0,NY,NX)=ZCO3(0,NY,NX)+TQRC3(NY,NX) - ZHCO3(0,NY,NX)=ZHCO3(0,NY,NX)+TQRHC(NY,NX) - ZALOH1(0,NY,NX)=ZALOH1(0,NY,NX)+TQRAL1(NY,NX) - ZALOH2(0,NY,NX)=ZALOH2(0,NY,NX)+TQRAL2(NY,NX) - ZALOH3(0,NY,NX)=ZALOH3(0,NY,NX)+TQRAL3(NY,NX) - ZALOH4(0,NY,NX)=ZALOH4(0,NY,NX)+TQRAL4(NY,NX) - ZALS(0,NY,NX)=ZALS(0,NY,NX)+TQRALS(NY,NX) - ZFEOH1(0,NY,NX)=ZFEOH1(0,NY,NX)+TQRFE1(NY,NX) - ZFEOH2(0,NY,NX)=ZFEOH2(0,NY,NX)+TQRFE2(NY,NX) - ZFEOH3(0,NY,NX)=ZFEOH3(0,NY,NX)+TQRFE3(NY,NX) - ZFEOH4(0,NY,NX)=ZFEOH4(0,NY,NX)+TQRFE4(NY,NX) - ZFES(0,NY,NX)=ZFES(0,NY,NX)+TQRFES(NY,NX) - ZCAO(0,NY,NX)=ZCAO(0,NY,NX)+TQRCAO(NY,NX) - ZCAC(0,NY,NX)=ZCAC(0,NY,NX)+TQRCAC(NY,NX) - ZCAH(0,NY,NX)=ZCAH(0,NY,NX)+TQRCAH(NY,NX) - ZCAS(0,NY,NX)=ZCAS(0,NY,NX)+TQRCAS(NY,NX) - ZMGO(0,NY,NX)=ZMGO(0,NY,NX)+TQRMGO(NY,NX) - ZMGC(0,NY,NX)=ZMGC(0,NY,NX)+TQRMGC(NY,NX) - ZMGH(0,NY,NX)=ZMGH(0,NY,NX)+TQRMGH(NY,NX) - ZMGS(0,NY,NX)=ZMGS(0,NY,NX)+TQRMGS(NY,NX) - ZNAC(0,NY,NX)=ZNAC(0,NY,NX)+TQRNAC(NY,NX) - ZNAS(0,NY,NX)=ZNAS(0,NY,NX)+TQRNAS(NY,NX) - ZKAS(0,NY,NX)=ZKAS(0,NY,NX)+TQRKAS(NY,NX) - H0PO4(0,NY,NX)=H0PO4(0,NY,NX)+TQRH0P(NY,NX) - H1PO4(0,NY,NX)=H1PO4(0,NY,NX)+TQRH1P(NY,NX) - H3PO4(0,NY,NX)=H3PO4(0,NY,NX)+TQRH3P(NY,NX) - ZFE1P(0,NY,NX)=ZFE1P(0,NY,NX)+TQRF1P(NY,NX) - ZFE2P(0,NY,NX)=ZFE2P(0,NY,NX)+TQRF2P(NY,NX) - ZCA0P(0,NY,NX)=ZCA0P(0,NY,NX)+TQRC0P(NY,NX) - ZCA1P(0,NY,NX)=ZCA1P(0,NY,NX)+TQRC1P(NY,NX) - ZCA2P(0,NY,NX)=ZCA2P(0,NY,NX)+TQRC2P(NY,NX) - ZMG1P(0,NY,NX)=ZMG1P(0,NY,NX)+TQRM1P(NY,NX) - ENDIF -C -C SURFACE SEDIMENT TRANSPORT -C - IF(IERSN(NY,NX).NE.0)THEN - IF(BKDS(NU(NY,NX),NY,NX).GT.ZERO)THEN - SED(NY,NX)=SED(NY,NX)+TSEDER(NY,NX) - DLYR(3,NU(NY,NX),NY,NX)=DLYR(3,NU(NY,NX),NY,NX)+TSEDER(NY,NX) - 2/(AREA(3,NU(NY,NX),NY,NX)*BKDS(NU(NY,NX),NY,NX)) - IF(TSEDER(NY,NX).GT.1.0E-06*BKVL(NU(NY,NX),NY,NX))IFLGS(NY,NX)=1 - ENDIF -C -C SOIL MINERAL FRACTIONS -C - SAND(NU(NY,NX),NY,NX)=SAND(NU(NY,NX),NY,NX)+TSANER(NY,NX) - SILT(NU(NY,NX),NY,NX)=SILT(NU(NY,NX),NY,NX)+TSILER(NY,NX) - CLAY(NU(NY,NX),NY,NX)=CLAY(NU(NY,NX),NY,NX)+TCLAER(NY,NX) - XCEC(NU(NY,NX),NY,NX)=XCEC(NU(NY,NX),NY,NX)+TCECER(NY,NX) - XAEC(NU(NY,NX),NY,NX)=XAEC(NU(NY,NX),NY,NX)+TAECER(NY,NX) -C -C FERTILIZER POOLS -C - ZNH4FA(NU(NY,NX),NY,NX)=ZNH4FA(NU(NY,NX),NY,NX)+TNH4ER(NY,NX) - ZNH3FA(NU(NY,NX),NY,NX)=ZNH3FA(NU(NY,NX),NY,NX)+TNH3ER(NY,NX) - ZNHUFA(NU(NY,NX),NY,NX)=ZNHUFA(NU(NY,NX),NY,NX)+TNHUER(NY,NX) - ZNO3FA(NU(NY,NX),NY,NX)=ZNO3FA(NU(NY,NX),NY,NX)+TNO3ER(NY,NX) - ZNH4FB(NU(NY,NX),NY,NX)=ZNH4FB(NU(NY,NX),NY,NX)+TNH4EB(NY,NX) - ZNH3FB(NU(NY,NX),NY,NX)=ZNH3FB(NU(NY,NX),NY,NX)+TNH3EB(NY,NX) - ZNHUFB(NU(NY,NX),NY,NX)=ZNHUFB(NU(NY,NX),NY,NX)+TNHUEB(NY,NX) - ZNO3FB(NU(NY,NX),NY,NX)=ZNO3FB(NU(NY,NX),NY,NX)+TNO3EB(NY,NX) -C -C EXCHANGEABLE CATIONS AND ANIONS -C - XN4(NU(NY,NX),NY,NX)=XN4(NU(NY,NX),NY,NX)+TN4ER(NY,NX) - XNB(NU(NY,NX),NY,NX)=XNB(NU(NY,NX),NY,NX)+TNBER(NY,NX) - XHY(NU(NY,NX),NY,NX)=XHY(NU(NY,NX),NY,NX)+THYER(NY,NX) - XAL(NU(NY,NX),NY,NX)=XAL(NU(NY,NX),NY,NX)+TALER(NY,NX) - XCA(NU(NY,NX),NY,NX)=XCA(NU(NY,NX),NY,NX)+TCAER(NY,NX) - XMG(NU(NY,NX),NY,NX)=XMG(NU(NY,NX),NY,NX)+TMGER(NY,NX) - XNA(NU(NY,NX),NY,NX)=XNA(NU(NY,NX),NY,NX)+TNAER(NY,NX) - XKA(NU(NY,NX),NY,NX)=XKA(NU(NY,NX),NY,NX)+TKAER(NY,NX) - XHC(NU(NY,NX),NY,NX)=XHC(NU(NY,NX),NY,NX)+THCER(NY,NX) - XALO2(NU(NY,NX),NY,NX)=XALO2(NU(NY,NX),NY,NX)+TAL2ER(NY,NX) - XOH0(NU(NY,NX),NY,NX)=XOH0(NU(NY,NX),NY,NX)+TOH0ER(NY,NX) - XOH1(NU(NY,NX),NY,NX)=XOH1(NU(NY,NX),NY,NX)+TOH1ER(NY,NX) - XOH2(NU(NY,NX),NY,NX)=XOH2(NU(NY,NX),NY,NX)+TOH2ER(NY,NX) - XH1P(NU(NY,NX),NY,NX)=XH1P(NU(NY,NX),NY,NX)+TH1PER(NY,NX) - XH2P(NU(NY,NX),NY,NX)=XH2P(NU(NY,NX),NY,NX)+TH2PER(NY,NX) - XOH0B(NU(NY,NX),NY,NX)=XOH0B(NU(NY,NX),NY,NX)+TOH0EB(NY,NX) - XOH1B(NU(NY,NX),NY,NX)=XOH1B(NU(NY,NX),NY,NX)+TOH1EB(NY,NX) - XOH2B(NU(NY,NX),NY,NX)=XOH2B(NU(NY,NX),NY,NX)+TOH2EB(NY,NX) - XH1PB(NU(NY,NX),NY,NX)=XH1PB(NU(NY,NX),NY,NX)+TH1PEB(NY,NX) - XH2PB(NU(NY,NX),NY,NX)=XH2PB(NU(NY,NX),NY,NX)+TH2PEB(NY,NX) -C -C PRECIPITATES -C - PALOH(NU(NY,NX),NY,NX)=PALOH(NU(NY,NX),NY,NX)+TALOER(NY,NX) - PFEOH(NU(NY,NX),NY,NX)=PFEOH(NU(NY,NX),NY,NX)+TFEOER(NY,NX) - PCACO(NU(NY,NX),NY,NX)=PCACO(NU(NY,NX),NY,NX)+TCACER(NY,NX) - PCASO(NU(NY,NX),NY,NX)=PCASO(NU(NY,NX),NY,NX)+TCASER(NY,NX) - PALPO(NU(NY,NX),NY,NX)=PALPO(NU(NY,NX),NY,NX)+TALPER(NY,NX) - PFEPO(NU(NY,NX),NY,NX)=PFEPO(NU(NY,NX),NY,NX)+TFEPER(NY,NX) - PCAPD(NU(NY,NX),NY,NX)=PCAPD(NU(NY,NX),NY,NX)+TCPDER(NY,NX) - PCAPH(NU(NY,NX),NY,NX)=PCAPH(NU(NY,NX),NY,NX)+TCPHER(NY,NX) - PCAPM(NU(NY,NX),NY,NX)=PCAPM(NU(NY,NX),NY,NX)+TCPMER(NY,NX) - PALPB(NU(NY,NX),NY,NX)=PALPB(NU(NY,NX),NY,NX)+TALPEB(NY,NX) - PFEPB(NU(NY,NX),NY,NX)=PFEPB(NU(NY,NX),NY,NX)+TFEPEB(NY,NX) - PCPDB(NU(NY,NX),NY,NX)=PCPDB(NU(NY,NX),NY,NX)+TCPDEB(NY,NX) - PCPHB(NU(NY,NX),NY,NX)=PCPHB(NU(NY,NX),NY,NX)+TCPHEB(NY,NX) - PCPMB(NU(NY,NX),NY,NX)=PCPMB(NU(NY,NX),NY,NX)+TCPMEB(NY,NX) -C -C ORGANIC CONSTITUENTS -C - DO 9280 K=0,5 - DO 9280 NN=1,7 - DO 9280 M=1,3 - OMC(M,NN,K,NU(NY,NX),NY,NX)=OMC(M,NN,K,NU(NY,NX),NY,NX) - 2+TOMCER(M,NN,K,NY,NX) - OMN(M,NN,K,NU(NY,NX),NY,NX)=OMN(M,NN,K,NU(NY,NX),NY,NX) - 2+TOMNER(M,NN,K,NY,NX) - OMP(M,NN,K,NU(NY,NX),NY,NX)=OMP(M,NN,K,NU(NY,NX),NY,NX) - 2+TOMPER(M,NN,K,NY,NX) -9280 CONTINUE - DO 9275 K=0,4 - DO 9270 M=1,2 - ORC(M,K,NU(NY,NX),NY,NX)=ORC(M,K,NU(NY,NX),NY,NX) - 2+TORCER(M,K,NY,NX) - ORN(M,K,NU(NY,NX),NY,NX)=ORN(M,K,NU(NY,NX),NY,NX) - 2+TORNER(M,K,NY,NX) - ORP(M,K,NU(NY,NX),NY,NX)=ORP(M,K,NU(NY,NX),NY,NX) - 2+TORPER(M,K,NY,NX) -9270 CONTINUE - OHC(K,NU(NY,NX),NY,NX)=OHC(K,NU(NY,NX),NY,NX)+TOHCER(K,NY,NX) - OHN(K,NU(NY,NX),NY,NX)=OHN(K,NU(NY,NX),NY,NX)+TOHNER(K,NY,NX) - OHP(K,NU(NY,NX),NY,NX)=OHP(K,NU(NY,NX),NY,NX)+TOHPER(K,NY,NX) - OHA(K,NU(NY,NX),NY,NX)=OHA(K,NU(NY,NX),NY,NX)+TOHAER(K,NY,NX) - DO 9265 M=1,4 - OSC(M,K,NU(NY,NX),NY,NX)=OSC(M,K,NU(NY,NX),NY,NX) - 2+TOSCER(M,K,NY,NX) - OSA(M,K,NU(NY,NX),NY,NX)=OSA(M,K,NU(NY,NX),NY,NX) - 2+TOSAER(M,K,NY,NX) - OSN(M,K,NU(NY,NX),NY,NX)=OSN(M,K,NU(NY,NX),NY,NX) - 2+TOSNER(M,K,NY,NX) - OSP(M,K,NU(NY,NX),NY,NX)=OSP(M,K,NU(NY,NX),NY,NX) - 2+TOSPER(M,K,NY,NX) -9265 CONTINUE -9275 CONTINUE - ENDIF - ENDIF -C -C OVERLAND SNOW REDISTRIBUTION -C - IF(TQS(NY,NX).NE.0.0)THEN - CO2W(NY,NX)=CO2W(NY,NX)+TCOQSS(NY,NX) - CH4W(NY,NX)=CH4W(NY,NX)+TCHQSS(NY,NX) - OXYW(NY,NX)=OXYW(NY,NX)+TOXQSS(NY,NX) - ZNGW(NY,NX)=ZNGW(NY,NX)+TNGQSS(NY,NX) - ZN2W(NY,NX)=ZN2W(NY,NX)+TN2QSS(NY,NX) - ZN4W(NY,NX)=ZN4W(NY,NX)+TN4QSS(NY,NX) - ZN3W(NY,NX)=ZN3W(NY,NX)+TN3QSS(NY,NX) - ZNOW(NY,NX)=ZNOW(NY,NX)+TNOQSS(NY,NX) - ZHPW(NY,NX)=ZHPW(NY,NX)+TPOQSS(NY,NX) - IF(ISALT(NY,NX).NE.0)THEN - ZALW(NY,NX)=ZALW(NY,NX)+TQSAL(NY,NX) - ZFEW(NY,NX)=ZFEW(NY,NX)+TQSFE(NY,NX) - ZHYW(NY,NX)=ZHYW(NY,NX)+TQSHY(NY,NX) - ZCAW(NY,NX)=ZCAW(NY,NX)+TQSCA(NY,NX) - ZMGW(NY,NX)=ZMGW(NY,NX)+TQSMG(NY,NX) - ZNAW(NY,NX)=ZNAW(NY,NX)+TQSNA(NY,NX) - ZKAW(NY,NX)=ZKAW(NY,NX)+TQSKA(NY,NX) - ZOHW(NY,NX)=ZOHW(NY,NX)+TQSOH(NY,NX) - ZSO4W(NY,NX)=ZSO4W(NY,NX)+TQSSO(NY,NX) - ZCLW(NY,NX)=ZCLW(NY,NX)+TQSCL(NY,NX) - ZCO3W(NY,NX)=ZCO3W(NY,NX)+TQSC3(NY,NX) - ZHCO3W(NY,NX)=ZHCO3W(NY,NX)+TQSHC(NY,NX) - ZALH1W(NY,NX)=ZALH1W(NY,NX)+TQSAL1(NY,NX) - ZALH2W(NY,NX)=ZALH2W(NY,NX)+TQSAL2(NY,NX) - ZALH3W(NY,NX)=ZALH3W(NY,NX)+TQSAL3(NY,NX) - ZALH4W(NY,NX)=ZALH4W(NY,NX)+TQSAL4(NY,NX) - ZALSW(NY,NX)=ZALSW(NY,NX)+TQSALS(NY,NX) - ZFEH1W(NY,NX)=ZFEH1W(NY,NX)+TQSFE1(NY,NX) - ZFEH2W(NY,NX)=ZFEH2W(NY,NX)+TQSFE2(NY,NX) - ZFEH3W(NY,NX)=ZFEH3W(NY,NX)+TQSFE3(NY,NX) - ZFEH4W(NY,NX)=ZFEH4W(NY,NX)+TQSFE4(NY,NX) - ZFESW(NY,NX)=ZFESW(NY,NX)+TQSFES(NY,NX) - ZCAOW(NY,NX)=ZCAOW(NY,NX)+TQSCAO(NY,NX) - ZCACW(NY,NX)=ZCACW(NY,NX)+TQSCAC(NY,NX) - ZCAHW(NY,NX)=ZCAHW(NY,NX)+TQSCAH(NY,NX) - ZCASW(NY,NX)=ZCASW(NY,NX)+TQSCAS(NY,NX) - ZMGOW(NY,NX)=ZMGOW(NY,NX)+TQSMGO(NY,NX) - ZMGCW(NY,NX)=ZMGCW(NY,NX)+TQSMGC(NY,NX) - ZMGHW(NY,NX)=ZMGHW(NY,NX)+TQSMGH(NY,NX) - ZMGSW(NY,NX)=ZMGSW(NY,NX)+TQSMGS(NY,NX) - ZNACW(NY,NX)=ZNACW(NY,NX)+TQSNAC(NY,NX) - ZNASW(NY,NX)=ZNASW(NY,NX)+TQSNAS(NY,NX) - ZKASW(NY,NX)=ZKASW(NY,NX)+TQSKAS(NY,NX) - H0PO4W(NY,NX)=H0PO4W(NY,NX)+TQSH0P(NY,NX) - H1PO4W(NY,NX)=H1PO4W(NY,NX)+TQSH1P(NY,NX) - H3PO4W(NY,NX)=H3PO4W(NY,NX)+TQSH3P(NY,NX) - ZFE1PW(NY,NX)=ZFE1PW(NY,NX)+TQSF1P(NY,NX) - ZFE2PW(NY,NX)=ZFE2PW(NY,NX)+TQSF2P(NY,NX) - ZCA0PW(NY,NX)=ZCA0PW(NY,NX)+TQSC0P(NY,NX) - ZCA1PW(NY,NX)=ZCA1PW(NY,NX)+TQSC1P(NY,NX) - ZCA2PW(NY,NX)=ZCA2PW(NY,NX)+TQSC2P(NY,NX) - ZMG1PW(NY,NX)=ZMG1PW(NY,NX)+TQSM1P(NY,NX) - ENDIF - ENDIF -C -C UPDATE STATE VARIABLES WITH TOTAL FLUXES CALCULATED ABOVE -C -C IF(J.EQ.24)THEN -C -C TOTAL C,N,P IN SURFACE RESIDUE -C - RC=0.0 - RN=0.0 - RP=0.0 - DO 6975 K=0,5 - RC0(K,NY,NX)=0.0 - RA0(K,NY,NX)=0.0 -6975 CONTINUE - OMCL(0,NY,NX)=0.0 - OMNL(0,NY,NX)=0.0 - DO 6970 K=0,5 - IF(K.NE.3.AND.K.NE.4)THEN -C -C TOTAL MICROBIAL C,N,P -C - DO 6960 N=1,7 - DO 6960 M=1,3 - RC=RC+OMC(M,N,K,0,NY,NX) - RN=RN+OMN(M,N,K,0,NY,NX) - RP=RP+OMP(M,N,K,0,NY,NX) - RC0(K,NY,NX)=RC0(K,NY,NX)+OMC(M,N,K,0,NY,NX) - RA0(K,NY,NX)=RA0(K,NY,NX)+OMC(M,N,K,0,NY,NX) - TOMT(NY,NX)=TOMT(NY,NX)+OMC(M,N,K,0,NY,NX) - TONT(NY,NX)=TONT(NY,NX)+OMN(M,N,K,0,NY,NX) - TOPT(NY,NX)=TOPT(NY,NX)+OMP(M,N,K,0,NY,NX) - OMCL(0,NY,NX)=OMCL(0,NY,NX)+OMC(M,N,K,0,NY,NX) - OMNL(0,NY,NX)=OMNL(0,NY,NX)+OMN(M,N,K,0,NY,NX) -6960 CONTINUE - ENDIF -6970 CONTINUE -C -C TOTAL MICROBIAL RESIDUE C,N,P -C - DO 6900 K=0,2 - DO 6940 M=1,2 - RC=RC+ORC(M,K,0,NY,NX) - RN=RN+ORN(M,K,0,NY,NX) - RP=RP+ORP(M,K,0,NY,NX) - RC0(K,NY,NX)=RC0(K,NY,NX)+ORC(M,K,0,NY,NX) - RA0(K,NY,NX)=RA0(K,NY,NX)+ORC(M,K,0,NY,NX) -6940 CONTINUE -C -C TOTAL DOC, DON, DOP -C - RC=RC+OQC(K,0,NY,NX)+OQCH(K,0,NY,NX)+OHC(K,0,NY,NX)+OQA(K,0,NY,NX) - 2+OQAH(K,0,NY,NX)+OHA(K,0,NY,NX) - RN=RN+OQN(K,0,NY,NX)+OQNH(K,0,NY,NX)+OHN(K,0,NY,NX) - RP=RP+OQP(K,0,NY,NX)+OQPH(K,0,NY,NX)+OHP(K,0,NY,NX) - RC0(K,NY,NX)=RC0(K,NY,NX)+OQC(K,0,NY,NX)+OQCH(K,0,NY,NX) - 2+OHC(K,0,NY,NX)+OQA(K,0,NY,NX)+OQAH(K,0,NY,NX)+OHA(K,0,NY,NX) - RA0(K,NY,NX)=RA0(K,NY,NX)+OQC(K,0,NY,NX)+OQCH(K,0,NY,NX) - 2+OHC(K,0,NY,NX)+OQA(K,0,NY,NX)+OQAH(K,0,NY,NX)+OHA(K,0,NY,NX) -C -C TOTAL PLANT RESIDUE C,N,P -C - DO 6930 M=1,4 - RC=RC+OSC(M,K,0,NY,NX) - RN=RN+OSN(M,K,0,NY,NX) - RP=RP+OSP(M,K,0,NY,NX) - RC0(K,NY,NX)=RC0(K,NY,NX)+OSC(M,K,0,NY,NX) - RA0(K,NY,NX)=RA0(K,NY,NX)+OSA(M,K,0,NY,NX) -6930 CONTINUE -6900 CONTINUE - ORGC(0,NY,NX)=RC - ORGN(0,NY,NX)=RN - ORGR(0,NY,NX)=RC - TLRSDC=TLRSDC+RC - URSDC(NY,NX)=URSDC(NY,NX)+RC - TLRSDN=TLRSDN+RN - URSDN(NY,NX)=URSDN(NY,NX)+RN - TLRSDP=TLRSDP+RP - URSDP(NY,NX)=URSDP(NY,NX)+RP - WS=TVOLWC(NY,NX)+TVOLWP(NY,NX)+VOLW(0,NY,NX)+VOLI(0,NY,NX)*0.92 - VOLWSO=VOLWSO+WS - UVOLW(NY,NX)=UVOLW(NY,NX)+WS - ENGYR=VHCPR(NY,NX)*TKS(0,NY,NX) - HEATSO=HEATSO+TENGYC(NY,NX)+ENGYR - CS=CO2S(0,NY,NX)+CH4S(0,NY,NX) - TLCO2G=TLCO2G+CS - UCO2S(NY,NX)=UCO2S(NY,NX)+CS - OS=OXYS(0,NY,NX) - OXYGSO=OXYGSO+OS - ZG=Z2GS(0,NY,NX)+Z2OS(0,NY,NX) - TLN2G=TLN2G+ZG - ZNH=ZNH4S(0,NY,NX)+ZNH3S(0,NY,NX) - TLNH4=TLNH4+ZNH - UNH4(NY,NX)=UNH4(NY,NX)+ZNH+14.0*(XN4(0,NY,NX)+XNB(0,NY,NX)) - XN4(0,NY,NX)=XN4(0,NY,NX)+TRXN4(0,NY,NX) - ZNO=ZNO3S(0,NY,NX)+ZNO2S(0,NY,NX) - TLNO3=TLNO3+ZNO - UNO3(NY,NX)=UNO3(NY,NX)+ZNO - P4=H2PO4(0,NY,NX) - TLPO4=TLPO4+P4 - UPO4(NY,NX)=UPO4(NY,NX)+P4+31.0*(XH1P(0,NY,NX)+XH2P(0,NY,NX)) - PALPO(0,NY,NX)=PALPO(0,NY,NX)+TRALPO(0,NY,NX) - PFEPO(0,NY,NX)=PFEPO(0,NY,NX)+TRFEPO(0,NY,NX) - PCAPD(0,NY,NX)=PCAPD(0,NY,NX)+TRCAPD(0,NY,NX) - PCAPH(0,NY,NX)=PCAPH(0,NY,NX)+TRCAPH(0,NY,NX) - PCAPM(0,NY,NX)=PCAPM(0,NY,NX)+TRCAPM(0,NY,NX) - UPP4(NY,NX)=UPP4(NY,NX)+31.0*(PALPO(0,NY,NX)+PFEPO(0,NY,NX) - 2+PCAPD(0,NY,NX))+93.0*PCAPH(0,NY,NX)+62.0*PCAPM(0,NY,NX) - TX=2.0*XN4(0,NY,NX)+XOH0(0,NY,NX) - 2+2.0*(PALPO(0,NY,NX)+PFEPO(0,NY,NX)+XOH1(0,NY,NX)) - 3+3.0*(PCAPD(0,NY,NX)+XOH2(0,NY,NX)+XH1P(0,NY,NX)) - 4+4.0*XH2P(0,NY,NX)+7.0*PCAPM(0,NY,NX)+9.0*PCAPH(0,NY,NX) - TF=2.0*ZNH4FA(0,NY,NX)+ZNHUFA(0,NY,NX)+ZNO3FA(0,NY,NX) - 2+ZNH3FA(0,NY,NX) - TG=H2GS(0,NY,NX) - TI=TX+TF+TG - TION=TION+TI - UION(NY,NX)=UION(NY,NX)+TI - - IF(ISALT(NY,NX).NE.0)THEN - ZAL(0,NY,NX)=ZAL(0,NY,NX)+XALFLS(3,0,NY,NX) - ZFE(0,NY,NX)=ZFE(0,NY,NX)+XFEFLS(3,0,NY,NX) - ZHY(0,NY,NX)=ZHY(0,NY,NX)+XHYFLS(3,0,NY,NX) - ZCA(0,NY,NX)=ZCA(0,NY,NX)+XCAFLS(3,0,NY,NX) - ZMG(0,NY,NX)=ZMG(0,NY,NX)+XMGFLS(3,0,NY,NX) - ZNA(0,NY,NX)=ZNA(0,NY,NX)+XNAFLS(3,0,NY,NX) - ZKA(0,NY,NX)=ZKA(0,NY,NX)+XKAFLS(3,0,NY,NX) - ZOH(0,NY,NX)=ZOH(0,NY,NX)+XOHFLS(3,0,NY,NX) - ZSO4(0,NY,NX)=ZSO4(0,NY,NX)+XSOFLS(3,0,NY,NX) - ZCL(0,NY,NX)=ZCL(0,NY,NX)+XCLFLS(3,0,NY,NX) - ZCO3(0,NY,NX)=ZCO3(0,NY,NX)+XC3FLS(3,0,NY,NX) - ZHCO3(0,NY,NX)=ZHCO3(0,NY,NX)+XHCFLS(3,0,NY,NX) - ZALOH1(0,NY,NX)=ZALOH1(0,NY,NX)+XAL1FS(3,0,NY,NX) - ZALOH2(0,NY,NX)=ZALOH2(0,NY,NX)+XAL2FS(3,0,NY,NX) - ZALOH3(0,NY,NX)=ZALOH3(0,NY,NX)+XAL3FS(3,0,NY,NX) - ZALOH4(0,NY,NX)=ZALOH4(0,NY,NX)+XAL4FS(3,0,NY,NX) - ZALS(0,NY,NX)=ZALS(0,NY,NX)+XALSFS(3,0,NY,NX) - ZFEOH1(0,NY,NX)=ZFEOH1(0,NY,NX)+XFE1FS(3,0,NY,NX) - ZFEOH2(0,NY,NX)=ZFEOH2(0,NY,NX)+XFE2FS(3,0,NY,NX) - ZFEOH3(0,NY,NX)=ZFEOH3(0,NY,NX)+XFE3FS(3,0,NY,NX) - ZFEOH4(0,NY,NX)=ZFEOH4(0,NY,NX)+XFE4FS(3,0,NY,NX) - ZFES(0,NY,NX)=ZFES(0,NY,NX)+XFESFS(3,0,NY,NX) - ZCAO(0,NY,NX)=ZCAO(0,NY,NX)+XCAOFS(3,0,NY,NX) - ZCAC(0,NY,NX)=ZCAC(0,NY,NX)+XCACFS(3,0,NY,NX) - ZCAH(0,NY,NX)=ZCAH(0,NY,NX)+XCAHFS(3,0,NY,NX) - ZCAS(0,NY,NX)=ZCAS(0,NY,NX)+XCASFS(3,0,NY,NX) - ZMGO(0,NY,NX)=ZMGO(0,NY,NX)+XMGOFS(3,0,NY,NX) - ZMGC(0,NY,NX)=ZMGC(0,NY,NX)+XMGCFS(3,0,NY,NX) - ZMGH(0,NY,NX)=ZMGH(0,NY,NX)+XMGHFS(3,0,NY,NX) - ZMGS(0,NY,NX)=ZMGS(0,NY,NX)+XMGSFS(3,0,NY,NX) - ZNAC(0,NY,NX)=ZNAC(0,NY,NX)+XNACFS(3,0,NY,NX) - ZNAS(0,NY,NX)=ZNAS(0,NY,NX)+XNASFS(3,0,NY,NX) - ZKAS(0,NY,NX)=ZKAS(0,NY,NX)+XKASFS(3,0,NY,NX) - H0PO4(0,NY,NX)=H0PO4(0,NY,NX)+XH0PFS(3,0,NY,NX) - H1PO4(0,NY,NX)=H1PO4(0,NY,NX)+XH1PFS(3,0,NY,NX) - H3PO4(0,NY,NX)=H3PO4(0,NY,NX)+XH3PFS(3,0,NY,NX) - ZFE1P(0,NY,NX)=ZFE1P(0,NY,NX)+XF1PFS(3,0,NY,NX) - ZFE2P(0,NY,NX)=ZFE2P(0,NY,NX)+XF2PFS(3,0,NY,NX) - ZCA0P(0,NY,NX)=ZCA0P(0,NY,NX)+XC0PFS(3,0,NY,NX) - ZCA1P(0,NY,NX)=ZCA1P(0,NY,NX)+XC1PFS(3,0,NY,NX) - ZCA2P(0,NY,NX)=ZCA2P(0,NY,NX)+XC2PFS(3,0,NY,NX) - ZMG1P(0,NY,NX)=ZMG1P(0,NY,NX)+XM1PFS(3,0,NY,NX) - TS=ZAL(0,NY,NX)+ZFE(0,NY,NX)+ZHY(0,NY,NX)+ZCA(0,NY,NX) - 2+ZMG(0,NY,NX)+ZNA(0,NY,NX)+ZKA(0,NY,NX)+ZOH(0,NY,NX) - 3+ZSO4(0,NY,NX)+ZCL(0,NY,NX)+ZCO3(0,NY,NX)+H0PO4(0,NY,NX) - 4+2.0*(ZHCO3(0,NY,NX)+ZALOH1(0,NY,NX) - 5+ZALS(0,NY,NX)+ZFEOH1(0,NY,NX)+ZFES(0,NY,NX)+ZCAO(0,NY,NX) - 6+ZCAC(0,NY,NX)+ZCAS(0,NY,NX)+ZMGO(0,NY,NX)+ZMGC(0,NY,NX) - 7+ZMGS(0,NY,NX)+ZNAC(0,NY,NX)+ZNAS(0,NY,NX)+ZKAS(0,NY,NX) - 8+H1PO4(0,NY,NX)+ZCA0P(0,NY,NX)) - 9+3.0*(ZALOH2(0,NY,NX)+ZFEOH2(0,NY,NX)+ZCAH(0,NY,NX) - 1+ZMGH(0,NY,NX)+ZFE1P(0,NY,NX)+ZCA1P(0,NY,NX)+ZMG1P(0,NY,NX)) - 2+4.0* - 3(ZALOH3(0,NY,NX)+ZFEOH3(0,NY,NX)+H3PO4(0,NY,NX)+ZFE2P(0,NY,NX) - 4+ZCA2P(0,NY,NX))+5.0*(ZALOH4(0,NY,NX)+ZFEOH4(0,NY,NX)) - TION=TION+TS - UION(NY,NX)=UION(NY,NX)+TS - ENDIF -C ENDIF -C -C IF SNOWPACK OR SURFACE RESIDUE DISAPPEARS -C - IF(FLWSI(NY,NX).GT.0.0)THEN - VHCP(NU(NY,NX),NY,NX)=VHCM(NU(NY,NX),NY,NX) - 2+4.19*(VOLW(NU(NY,NX),NY,NX)+VOLWH(NU(NY,NX),NY,NX)) - 2+1.9274*(VOLI(NU(NY,NX),NY,NX)+VOLIH(NU(NY,NX),NY,NX)) - VOLI(NU(NY,NX),NY,NX)=VOLI(NU(NY,NX),NY,NX)+FLWSI(NY,NX) - ENGY=VHCP(NU(NY,NX),NY,NX)*TKS(NU(NY,NX),NY,NX) - VHCP(NU(NY,NX),NY,NX)=VHCM(NU(NY,NX),NY,NX) - 2+4.19*(VOLW(NU(NY,NX),NY,NX)+VOLWH(NU(NY,NX),NY,NX)) - 2+1.9274*(VOLI(NU(NY,NX),NY,NX)+VOLIH(NU(NY,NX),NY,NX)) - TKS(NU(NY,NX),NY,NX)=(ENGY+HFLWSI(NY,NX))/VHCP(NU(NY,NX),NY,NX) - ENDIF - VOLWX(NU(NY,NX),NY,NX)=VOLW(NU(NY,NX),NY,NX) - TCS(0,NY,NX)=TKS(0,NY,NX)-273.15 - TSMX(0,NY,NX)=AMAX1(TSMX(0,NY,NX),TCS(0,NY,NX)) - TSMN(0,NY,NX)=AMIN1(TSMN(0,NY,NX),TCS(0,NY,NX)) -C -C UPDATE SOIL LAYER VARIABLES WITH TOTAL FLUXES -C - DO 125 L=NU(NY,NX),NL(NY,NX) -C -C WATER, ICE, HEAT, TEMPERATURE -C - VHCP(L,NY,NX)=VHCM(L,NY,NX)+4.19*(VOLW(L,NY,NX)+VOLWH(L,NY,NX)) - 2+1.9274*(VOLI(L,NY,NX)+VOLIH(L,NY,NX)) - VOLW1=VOLW(L,NY,NX) - VOLW(L,NY,NX)=VOLW(L,NY,NX)+TFLW(L,NY,NX)+FINH(L,NY,NX) - 2+TTHAW(L,NY,NX)+TUPWTR(L,NY,NX) - 3+FLU(L,NY,NX)+18.0E-06*TRH2O(L,NY,NX) - IF(VOLW(L,NY,NX).GT.ZEROS(NY,NX))THEN - VOLWX(L,NY,NX)=VOLWX(L,NY,NX)+TFLWX(L,NY,NX)+FINH(L,NY,NX) - 2+TTHAW(L,NY,NX)+TUPWTR(L,NY,NX)*VOLWX(L,NY,NX)/VOLW(L,NY,NX) - 3+FLU(L,NY,NX)+18.0E-06*TRH2O(L,NY,NX)+FLWV(L,NY,NX) - VOLWX(L,NY,NX)=AMAX1(THETY(L,NY,NX)*VOLX(L,NY,NX) - 2,AMIN1(VOLW(L,NY,NX),VOLWX(L,NY,NX))) - ELSE - VOLWX(L,NY,NX)=0.0 - ENDIF - VOLI(L,NY,NX)=VOLI(L,NY,NX)-TTHAW(L,NY,NX)/0.92 - VOLWH(L,NY,NX)=VOLWH(L,NY,NX)+TFLWH(L,NY,NX)-FINH(L,NY,NX) - 2+TTHAWH(L,NY,NX) - VOLIH(L,NY,NX)=VOLIH(L,NY,NX)-TTHAWH(L,NY,NX)/0.92 - 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)) - ENGY=VHCP(L,NY,NX)*TKS(L,NY,NX) - VHCP1=VHCP(L,NY,NX) - TKS1=TKS(L,NY,NX) - VHCP(L,NY,NX)=VHCM(L,NY,NX)+4.19*(VOLW(L,NY,NX)+VOLWH(L,NY,NX)) - 2+1.9274*(VOLI(L,NY,NX)+VOLIH(L,NY,NX)) -C -C ARTIFICIAL SOIL WARMING -C -C IF(NX.EQ.3.AND.NY.EQ.2.AND.L.GT.NU(NY,NX) -C 3.AND.L.LE.17.AND.I.GE.152.AND.I.LE.304)THEN -C THFLW(L,NY,NX)=THFLW(L,NY,NX) -C 2+(TKSZ(I,J,L)-TKS(L,NY,NX))*VHCP(L,NY,NX) -C WRITE(*,3379)'TKSZ',I,J,NX,NY,L,TKSZ(I,J,L) -C 2,TKS(L,NY,NX),VHCP(L,NY,NX),THFLW(L,NY,NX) -3379 FORMAT(A8,6I4,12E12.4) -C ENDIF -C -C 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) - TCS(L,NY,NX)=TKS(L,NY,NX)-273.15 - TSMX(L,NY,NX)=AMAX1(TSMX(L,NY,NX),TCS(L,NY,NX)) - TSMN(L,NY,NX)=AMIN1(TSMN(L,NY,NX),TCS(L,NY,NX)) - UN2GS(NY,NX)=UN2GS(NY,NX)+XN2GS(L,NY,NX) -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),18.0E-06*TRH2O(L,NY,NX),TQR(NY,NX) -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) -6547 FORMAT(A8,5I4,20E16.8) -C WRITE(*,6633)'TKS',I,J,NX,NY,L,TKS(L,NY,NX),ENGY,THFLW(L,NY,NX) -C 2,THTHAW(L,NY,NX),TUPHT(L,NY,NX),HWFLU(L,NY,NX),VHCP(L,NY,NX) -C 3,VHCP1,TKS1,VOLW(L,NY,NX),VOLWH(L,NY,NX),VOLI(L,NY,NX) -C 4,VOLIH(L,NY,NX),TFLW(L,NY,NX),FINH(L,NY,NX),TTHAW(L,NY,NX) -C 5,TUPWTR(L,NY,NX),FLU(L,NY,NX),TRH2O(L,NY,NX),TQR(NY,NX) -C 6,FLWSI(NY,NX),HFLWSI(NY,NX) -6633 FORMAT(A8,5I4,30F20.6) -C ENDIF -C -C RESIDUE FROM PLANT LITTERFALL -C - DO 8565 K=0,1 - DO 8565 M=1,4 - OSC(M,K,L,NY,NX)=OSC(M,K,L,NY,NX)+CSNT(M,K,L,NY,NX) - OSN(M,K,L,NY,NX)=OSN(M,K,L,NY,NX)+ZSNT(M,K,L,NY,NX) - OSP(M,K,L,NY,NX)=OSP(M,K,L,NY,NX)+PSNT(M,K,L,NY,NX) -C IF((I/30)*30.EQ.I.AND.J.EQ.15)THEN -C WRITE(*,8484)'OSC',I,J,L,K,M,OSC(M,K,L,NY,NX) -C 2,OSN(M,K,L,NY,NX),OSP(M,K,L,NY,NX),CSNT(M,K,L,NY,NX) -C 3,ZSNT(M,K,L,NY,NX),PSNT(M,K,L,NY,NX) -8484 FORMAT(A8,5I4,12E12.4) -C ENDIF -8565 CONTINUE -C -C DOC, DON, DOP FROM AQUEOUS TRANSPORT -C - DO 8560 K=0,4 - OQC(K,L,NY,NX)=OQC(K,L,NY,NX)+TOCFLS(K,L,NY,NX) - 2+XOCFXS(K,L,NY,NX) - OQN(K,L,NY,NX)=OQN(K,L,NY,NX)+TONFLS(K,L,NY,NX) - 2+XONFXS(K,L,NY,NX) - OQP(K,L,NY,NX)=OQP(K,L,NY,NX)+TOPFLS(K,L,NY,NX) - 2+XOPFXS(K,L,NY,NX) - OQA(K,L,NY,NX)=OQA(K,L,NY,NX)+TOAFLS(K,L,NY,NX) - 2+XOAFXS(K,L,NY,NX) - OQCH(K,L,NY,NX)=OQCH(K,L,NY,NX)+TOCFHS(K,L,NY,NX) - 2-XOCFXS(K,L,NY,NX) - OQNH(K,L,NY,NX)=OQNH(K,L,NY,NX)+TONFHS(K,L,NY,NX) - 2-XONFXS(K,L,NY,NX) - OQPH(K,L,NY,NX)=OQPH(K,L,NY,NX)+TOPFHS(K,L,NY,NX) - 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 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,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) -C ENDIF -8560 CONTINUE -C -C DOC, DON, DOP FROM PLANT EXUDATION -C - DO 195 K=0,4 - OQC(K,L,NY,NX)=OQC(K,L,NY,NX)+TDFOMC(K,L,NY,NX) - OQN(K,L,NY,NX)=OQN(K,L,NY,NX)+TDFOMN(K,L,NY,NX) - OQP(K,L,NY,NX)=OQP(K,L,NY,NX)+TDFOMP(K,L,NY,NX) -195 CONTINUE -C -C SOIL SOLUTES FROM AQUEOUS TRANSPORT, MICROBIAL AND ROOT -C EXCHANGE, EQUILIBRIUM REACTIONS, GAS EXCHANGE, -C MICROPORE-MACROPORE EXCHANGE, -C - CO2S(L,NY,NX)=CO2S(L,NY,NX)+TCOFLS(L,NY,NX)+XCODFG(L,NY,NX) - 2-RCO2O(L,NY,NX)-TCO2S(L,NY,NX)+RCOFLU(L,NY,NX)+XCOFXS(L,NY,NX) - 3+TRCO2(L,NY,NX)+XCOBBL(L,NY,NX) - CH4S(L,NY,NX)=CH4S(L,NY,NX)+TCHFLS(L,NY,NX)+XCHDFG(L,NY,NX) - 2-RCH4O(L,NY,NX)-TUPCHS(L,NY,NX)+RCHFLU(L,NY,NX) - 3+XCHFXS(L,NY,NX)+XCHBBL(L,NY,NX) - 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 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 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 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) -5432 FORMAT(A8,5I4,20E16.6) -C ENDIF - Z2GS(L,NY,NX)=Z2GS(L,NY,NX)+TNGFLS(L,NY,NX)+XNGDFG(L,NY,NX) - 2-RN2G(L,NY,NX)-TUPNF(L,NY,NX)+RNGFLU(L,NY,NX)+XNGFXS(L,NY,NX) - 3-XN2GS(L,NY,NX)+XNGBBL(L,NY,NX) - Z2OS(L,NY,NX)=Z2OS(L,NY,NX)+TN2FLS(L,NY,NX)+XN2DFG(L,NY,NX) - 2-RN2O(L,NY,NX)-TUPN2S(L,NY,NX)+RN2FLU(L,NY,NX)+XN2FXS(L,NY,NX) - 3+XN2BBL(L,NY,NX) -C IF(I.GT.160.AND.I.LT.190)THEN -C WRITE(*,4444)'Z2OS',I,J,NX,NY,L,Z2OS(L,NY,NX),TN2FLS(L,NY,NX) -C 2,XN2DFG(L,NY,NX),RN2O(L,NY,NX),TUPN2S(L,NY,NX),RN2FLU(L,NY,NX) -C 3,XN2FXS(L,NY,NX),Z2GS(L,NY,NX),TNGFLS(L,NY,NX),XNGDFG(L,NY,NX) -C 4,RN2G(L,NY,NX),TUPNF(L,NY,NX),RNGFLU(L,NY,NX),XNGFXS(L,NY,NX) -C 5,XN2GS(L,NY,NX),XNGBBL(L,NY,NX) -C ENDIF - H2GS(L,NY,NX)=H2GS(L,NY,NX)+THGFLS(L,NY,NX)+XHGDFG(L,NY,NX) - 2-RH2GO(L,NY,NX)-TUPHGS(L,NY,NX)+RHGFLU(L,NY,NX) - 3+XHGFXS(L,NY,NX)+XHGBBL(L,NY,NX) - ZNH3S(L,NY,NX)=ZNH3S(L,NY,NX)+TN3FLS(L,NY,NX)+XN3DFG(L,NY,NX) - 2-XN34SQ(L,NY,NX)+TRN3S(L,NY,NX)-TUPN3S(L,NY,NX)+RN3FLU(L,NY,NX) - 3+XN3FXW(L,NY,NX)+XN3BBL(L,NY,NX) - ZNH4S(L,NY,NX)=ZNH4S(L,NY,NX)+TN4FLS(L,NY,NX)+XNH4S(L,NY,NX) - 2+TRN4S(L,NY,NX)-TUPNH4(L,NY,NX)+RN4FLU(L,NY,NX) - 3+XN4FXW(L,NY,NX)+XN34SQ(L,NY,NX) -C IF(L.EQ.1)THEN -C WRITE(*,4444)'NH3',I,J,NX,NY,L,ZNH3S(L,NY,NX),TN3FLS(L,NY,NX) -C 2,XN3DFG(L,NY,NX),XN34SQ(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),ZNH4S(L,NY,NX) -C 4,TN4FLS(L,NY,NX),XNH4S(L,NY,NX),TRN4S(L,NY,NX),TUPNH4(L,NY,NX) -C 5,RN4FLU(L,NY,NX),XN4FXW(L,NY,NX),TN4QRS(NY,NX),TN3QRS(NY,NX) -C 6,ZNH3SH(L,NY,NX),ZNH4SH(L,NY,NX) -4444 FORMAT(A8,5I4,30E12.4) -C ENDIF - ZNO3S(L,NY,NX)=ZNO3S(L,NY,NX)+TNOFLS(L,NY,NX)+XNO3S(L,NY,NX) - 2+TRNO3(L,NY,NX)-TUPNO3(L,NY,NX)+RNOFLU(L,NY,NX) - 3+XNOFXW(L,NY,NX) - ZNO2S(L,NY,NX)=ZNO2S(L,NY,NX)+TNXFLS(L,NY,NX)+XNO2S(L,NY,NX) - 2+TRNO2(L,NY,NX)+XNXFXS(L,NY,NX) -C IF(L.EQ.NU(NY,NX))THEN -C WRITE(*,5545)'NO3',I,J,NX,NY,L,ZNO3S(L,NY,NX),TNOFLS(L,NY,NX) -C 2,XNO3S(L,NY,NX),TRNO3(L,NY,NX),TUPNO3(L,NY,NX),RNOFLU(L,NY,NX) -C 3,XNOFXW(L,NY,NX),ZNO2S(L,NY,NX),TNXFLS(L,NY,NX) -C 4,XNO2S(L,NY,NX),TRNO2(L,NY,NX),XNXFXS(L,NY,NX),TNXQRS(NY,NX) -5545 FORMAT(A8,5I4,40E12.4) -C ENDIF - H2PO4(L,NY,NX)=H2PO4(L,NY,NX)+TPOFLS(L,NY,NX)+XH2PS(L,NY,NX) - 2+TRH2P(L,NY,NX)-TUPH2P(L,NY,NX)+RH2PFU(L,NY,NX) - 3+XH2PXS(L,NY,NX) - ZNH3B(L,NY,NX)=ZNH3B(L,NY,NX)+TN3FLB(L,NY,NX)+XNBDFG(L,NY,NX) - 2-XN34BQ(L,NY,NX)+TRN3B(L,NY,NX)-TUPN3B(L,NY,NX)+RN3FBU(L,NY,NX) - 3+XN3FXB(L,NY,NX)+XNBBBL(L,NY,NX) - ZNH4B(L,NY,NX)=ZNH4B(L,NY,NX)+TN4FLB(L,NY,NX)+XNH4B(L,NY,NX) - 2+TRN4B(L,NY,NX)-TUPNHB(L,NY,NX)+RN4FBU(L,NY,NX) - 3+XN4FXB(L,NY,NX)+XN34BQ(L,NY,NX) - ZNO3B(L,NY,NX)=ZNO3B(L,NY,NX)+TNOFLB(L,NY,NX)+XNO3B(L,NY,NX) - 2+TRNOB(L,NY,NX)-TUPNOB(L,NY,NX)+RNOFBU(L,NY,NX) - 3+XNOFXB(L,NY,NX) - ZNO2B(L,NY,NX)=ZNO2B(L,NY,NX)+TNXFLB(L,NY,NX)+XNO2B(L,NY,NX) - 2+TRN2B(L,NY,NX)+XNXFXB(L,NY,NX) - H2POB(L,NY,NX)=H2POB(L,NY,NX)+TH2BFB(L,NY,NX)+XH2BS(L,NY,NX) - 2+TRH2B(L,NY,NX)-TUPH2B(L,NY,NX)+RH2BBU(L,NY,NX) - 3+XH2BXB(L,NY,NX) - THRE(NY,NX)=THRE(NY,NX)+RCO2O(L,NY,NX) - UN2GG(NY,NX)=UN2GG(NY,NX)+RN2G(L,NY,NX) - HN2GG(NY,NX)=HN2GG(NY,NX)+RN2G(L,NY,NX) -C -C EXCHANGEABLE CATIONS AND ANIONS FROM EXCHANGE REACTIONS -C - XN4(L,NY,NX)=XN4(L,NY,NX)+TRXN4(L,NY,NX) - XNB(L,NY,NX)=XNB(L,NY,NX)+TRXNB(L,NY,NX) - XOH0(L,NY,NX)=XOH0(L,NY,NX)+TRXH0(L,NY,NX) - XOH1(L,NY,NX)=XOH1(L,NY,NX)+TRXH1(L,NY,NX) - XOH2(L,NY,NX)=XOH2(L,NY,NX)+TRXH2(L,NY,NX) - XH1P(L,NY,NX)=XH1P(L,NY,NX)+TRX1P(L,NY,NX) - XH2P(L,NY,NX)=XH2P(L,NY,NX)+TRX2P(L,NY,NX) - XOH0B(L,NY,NX)=XOH0B(L,NY,NX)+TRBH0(L,NY,NX) - XOH1B(L,NY,NX)=XOH1B(L,NY,NX)+TRBH1(L,NY,NX) - XOH2B(L,NY,NX)=XOH2B(L,NY,NX)+TRBH2(L,NY,NX) - XH1PB(L,NY,NX)=XH1PB(L,NY,NX)+TRB1P(L,NY,NX) - XH2PB(L,NY,NX)=XH2PB(L,NY,NX)+TRB2P(L,NY,NX) -C IF(J.EQ.12.AND.L.LE.4)THEN -C WRITE(*,4445)'NHB',I,J,NX,NY,L,ZNH3B(L,NY,NX),TN3FLB(L,NY,NX) -C 2,XNBDFG(L,NY,NX),XN34BQ(L,NY,NX),TRN3B(L,NY,NX),TUPN3B(L,NY,NX) -C 3,RN3FBU(L,NY,NX),XN3FXB(L,NY,NX),XNBBBL(L,NY,NX),TUPNHB(L,NY,NX) -C 4,ZNH4B(L,NY,NX),TN4FLB(L,NY,NX),XNH4B(L,NY,NX) -C 5,TRN4B(L,NY,NX),TUPNHB(L,NY,NX),RN4FBU(L,NY,NX),XNB(L,NY,NX)*14.0 -C WRITE(*,4445)'NOB',I,J,NX,NY,L,ZNO2B(L,NY,NX),TNXFLB(L,NY,NX) -C 2,XNO2B(L,NY,NX),TRN2B(L,NY,NX),XNXFXB(L,NY,NX) -4445 FORMAT(A8,5I4,20E12.4) -C ENDIF -C -C PRECIPITATES FROM PRECIPITATION-DISSOLUTION REACTIONS -C - PALPO(L,NY,NX)=PALPO(L,NY,NX)+TRALPO(L,NY,NX) - PFEPO(L,NY,NX)=PFEPO(L,NY,NX)+TRFEPO(L,NY,NX) - PCAPD(L,NY,NX)=PCAPD(L,NY,NX)+TRCAPD(L,NY,NX) - PCAPH(L,NY,NX)=PCAPH(L,NY,NX)+TRCAPH(L,NY,NX) - PCAPM(L,NY,NX)=PCAPM(L,NY,NX)+TRCAPM(L,NY,NX) - PALPB(L,NY,NX)=PALPB(L,NY,NX)+TRALPB(L,NY,NX) - PFEPB(L,NY,NX)=PFEPB(L,NY,NX)+TRFEPB(L,NY,NX) - PCPDB(L,NY,NX)=PCPDB(L,NY,NX)+TRCPDB(L,NY,NX) - PCPHB(L,NY,NX)=PCPHB(L,NY,NX)+TRCPHB(L,NY,NX) - PCPMB(L,NY,NX)=PCPMB(L,NY,NX)+TRCPMB(L,NY,NX) -C -C MACROPORE SOLUTES FROM MACROPORE-MICROPORE EXCHANGE -C - CO2SH(L,NY,NX)=CO2SH(L,NY,NX)+TCOFHS(L,NY,NX)-XCOFXS(L,NY,NX) - CH4SH(L,NY,NX)=CH4SH(L,NY,NX)+TCHFHS(L,NY,NX)-XCHFXS(L,NY,NX) - OXYSH(L,NY,NX)=OXYSH(L,NY,NX)+TOXFHS(L,NY,NX)-XOXFXS(L,NY,NX) - Z2GSH(L,NY,NX)=Z2GSH(L,NY,NX)+TNGFHS(L,NY,NX)-XNGFXS(L,NY,NX) - Z2OSH(L,NY,NX)=Z2OSH(L,NY,NX)+TN2FHS(L,NY,NX)-XN2FXS(L,NY,NX) - H2GSH(L,NY,NX)=H2GSH(L,NY,NX)+THGFHS(L,NY,NX)-XHGFXS(L,NY,NX) - ZNH4SH(L,NY,NX)=ZNH4SH(L,NY,NX)+TN4FHS(L,NY,NX)-XN4FXW(L,NY,NX) - ZNH3SH(L,NY,NX)=ZNH3SH(L,NY,NX)+TN3FHS(L,NY,NX)-XN3FXW(L,NY,NX) - ZNO3SH(L,NY,NX)=ZNO3SH(L,NY,NX)+TNOFHS(L,NY,NX)-XNOFXW(L,NY,NX) - ZNO2SH(L,NY,NX)=ZNO2SH(L,NY,NX)+TNXFHS(L,NY,NX)-XNXFXS(L,NY,NX) - H2PO4H(L,NY,NX)=H2PO4H(L,NY,NX)+TPOFHS(L,NY,NX)-XH2PXS(L,NY,NX) - ZNH4BH(L,NY,NX)=ZNH4BH(L,NY,NX)+TN4FHB(L,NY,NX)-XN4FXB(L,NY,NX) - ZNH3BH(L,NY,NX)=ZNH3BH(L,NY,NX)+TN3FHB(L,NY,NX)-XN3FXB(L,NY,NX) - ZNO3BH(L,NY,NX)=ZNO3BH(L,NY,NX)+TNOFHB(L,NY,NX)-XNOFXB(L,NY,NX) - ZNO2BH(L,NY,NX)=ZNO2BH(L,NY,NX)+TNXFHB(L,NY,NX)-XNXFXB(L,NY,NX) - H2POBH(L,NY,NX)=H2POBH(L,NY,NX)+TH2BHB(L,NY,NX)-XH2BXB(L,NY,NX) -C IF(NX.EQ.1)THEN -C WRITE(*,4747)'ZNO3SH',I,J,NX,NY,L,ZNO3SH(L,NY,NX) -C 2,TNOFHS(L,NY,NX),XNOFXW(L,NY,NX) -C 3,ZNO2SH(L,NY,NX),TNXFHS(L,NY,NX),XNXFXS(L,NY,NX) -4747 FORMAT(A8,5I4,12E12.4) -C ENDIF -C -C GASES FROM VOLATILIZATION-DISSOLUTION AND GAS TRANSFER -C - CO2G(L,NY,NX)=CO2G(L,NY,NX)+TCOFLG(L,NY,NX)-XCODFG(L,NY,NX) - CH4G(L,NY,NX)=CH4G(L,NY,NX)+TCHFLG(L,NY,NX)-XCHDFG(L,NY,NX) - OXYG(L,NY,NX)=OXYG(L,NY,NX)+TOXFLG(L,NY,NX)-XOXDFG(L,NY,NX) - Z2GG(L,NY,NX)=Z2GG(L,NY,NX)+TNGFLG(L,NY,NX)-XNGDFG(L,NY,NX) - Z2OG(L,NY,NX)=Z2OG(L,NY,NX)+TN2FLG(L,NY,NX)-XN2DFG(L,NY,NX) - ZNH3G(L,NY,NX)=ZNH3G(L,NY,NX)+TNHFLG(L,NY,NX)-XN3DFG(L,NY,NX) - 2-XNBDFG(L,NY,NX)+TRN3G(L,NY,NX) - H2GG(L,NY,NX)=H2GG(L,NY,NX)+THGFLG(L,NY,NX)-XHGDFG(L,NY,NX) - ROXYF(L,NY,NX)=TOXFLG(L,NY,NX) - RCO2F(L,NY,NX)=TCOFLG(L,NY,NX) - RCH4F(L,NY,NX)=TCHFLG(L,NY,NX) - ROXYL(L,NY,NX)=TOXFLS(L,NY,NX)+ROXFLU(L,NY,NX)+XOXFXS(L,NY,NX) - 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 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 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 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) -C 5,XCHFXS(L,NY,NX),XCHBBL(L,NY,NX) -C ENDIF -C -C SALT SOLUTES IFROM EQUILIBRIUM REACTIONS, MICROPORE-MACROPORE -C EXCHANGE, AQUEOUS FLUXES -C - IF(ISALT(NY,NX).NE.0)THEN - XZHYU=0.0714*(TUPNH4(L,NY,NX)+TUPNHB(L,NY,NX)) - XZOHU=0.0714*(TUPNO3(L,NY,NX)+TUPNOB(L,NY,NX)) - ZAL(L,NY,NX)=ZAL(L,NY,NX)+TRAL(L,NY,NX)+TALFLS(L,NY,NX) - 2+RALFLU(L,NY,NX)+XALFXS(L,NY,NX) - ZFE(L,NY,NX)=ZFE(L,NY,NX)+TRFE(L,NY,NX)+TFEFLS(L,NY,NX) - 2+RFEFLU(L,NY,NX)+XFEFXS(L,NY,NX) - ZHY(L,NY,NX)=ZHY(L,NY,NX)+TRHY(L,NY,NX)+THYFLS(L,NY,NX) - 2+RHYFLU(L,NY,NX)+XHYFXS(L,NY,NX)+XZHYS(L,NY,NX)+XZHYU - ZCA(L,NY,NX)=ZCA(L,NY,NX)+TRCA(L,NY,NX)+TCAFLS(L,NY,NX) - 2+RCAFLU(L,NY,NX)+XCAFXS(L,NY,NX) - ZMG(L,NY,NX)=ZMG(L,NY,NX)+TRMG(L,NY,NX)+TMGFLS(L,NY,NX) - 2+RMGFLU(L,NY,NX)+XMGFXS(L,NY,NX) - ZNA(L,NY,NX)=ZNA(L,NY,NX)+TRNA(L,NY,NX)+TNAFLS(L,NY,NX) - 2+RNAFLU(L,NY,NX)+XNAFXS(L,NY,NX) - ZKA(L,NY,NX)=ZKA(L,NY,NX)+TRKA(L,NY,NX)+TKAFLS(L,NY,NX) - 2+RKAFLU(L,NY,NX)+XKAFXS(L,NY,NX) - ZOH(L,NY,NX)=ZOH(L,NY,NX)+TROH(L,NY,NX)+TOHFLS(L,NY,NX) - 2+ROHFLU(L,NY,NX)+XOHFXS(L,NY,NX)+XZOHU - ZSO4(L,NY,NX)=ZSO4(L,NY,NX)+TRSO4(L,NY,NX)+TSOFLS(L,NY,NX) - 2+RSOFLU(L,NY,NX)+XSOFXS(L,NY,NX) - ZCL(L,NY,NX)=ZCL(L,NY,NX)+TCLFLS(L,NY,NX)+RCLFLU(L,NY,NX) - 2+XCLFXS(L,NY,NX) - ZCO3(L,NY,NX)=ZCO3(L,NY,NX)+TRCO3(L,NY,NX)+TC3FLS(L,NY,NX) - 2+XC3FXS(L,NY,NX) - ZHCO3(L,NY,NX)=ZHCO3(L,NY,NX)+TRHCO(L,NY,NX)+THCFLS(L,NY,NX) - 2+XHCFXS(L,NY,NX) - ZALOH1(L,NY,NX)=ZALOH1(L,NY,NX)+TRAL1(L,NY,NX)+TAL1FS(L,NY,NX) - 2+XAL1XS(L,NY,NX) - ZALOH2(L,NY,NX)=ZALOH2(L,NY,NX)+TRAL2(L,NY,NX)+TAL2FS(L,NY,NX) - 2+XAL2XS(L,NY,NX) - ZALOH3(L,NY,NX)=ZALOH3(L,NY,NX)+TRAL3(L,NY,NX)+TAL3FS(L,NY,NX) - 2+XAL3XS(L,NY,NX) - ZALOH4(L,NY,NX)=ZALOH4(L,NY,NX)+TRAL4(L,NY,NX)+TAL4FS(L,NY,NX) - 2+XAL4XS(L,NY,NX) - ZALS(L,NY,NX)=ZALS(L,NY,NX)+TRALS(L,NY,NX)+TALSFS(L,NY,NX) - 2+XALSXS(L,NY,NX) - ZFEOH1(L,NY,NX)=ZFEOH1(L,NY,NX)+TRFE1(L,NY,NX)+TFE1FS(L,NY,NX) - 2+XFE1XS(L,NY,NX) - ZFEOH2(L,NY,NX)=ZFEOH2(L,NY,NX)+TRFE2(L,NY,NX)+TFE2FS(L,NY,NX) - 2+XFE2XS(L,NY,NX) - ZFEOH3(L,NY,NX)=ZFEOH3(L,NY,NX)+TRFE3(L,NY,NX)+TFE3FS(L,NY,NX) - 2+XFE3XS(L,NY,NX) - ZFEOH4(L,NY,NX)=ZFEOH4(L,NY,NX)+TRFE4(L,NY,NX)+TFE4FS(L,NY,NX) - 2+XFE4XS(L,NY,NX) - ZFES(L,NY,NX)=ZFES(L,NY,NX)+TRFES(L,NY,NX)+TFESFS(L,NY,NX) - 2+XFESXS(L,NY,NX) - ZCAO(L,NY,NX)=ZCAO(L,NY,NX)+TRCAO(L,NY,NX)+TCAOFS(L,NY,NX) - 2+XCAOXS(L,NY,NX) - ZCAC(L,NY,NX)=ZCAC(L,NY,NX)+TRCAC(L,NY,NX)+TCACFS(L,NY,NX) - 2+XCACXS(L,NY,NX) - ZCAH(L,NY,NX)=ZCAH(L,NY,NX)+TRCAH(L,NY,NX)+TCAHFS(L,NY,NX) - 2+XCAHXS(L,NY,NX) - ZCAS(L,NY,NX)=ZCAS(L,NY,NX)+TRCAS(L,NY,NX)+TCASFS(L,NY,NX) - 2+XCASXS(L,NY,NX) - ZMGO(L,NY,NX)=ZMGO(L,NY,NX)+TRMGO(L,NY,NX)+TMGOFS(L,NY,NX) - 2+XMGOXS(L,NY,NX) - ZMGC(L,NY,NX)=ZMGC(L,NY,NX)+TRMGC(L,NY,NX)+TMGCFS(L,NY,NX) - 2+XMGCXS(L,NY,NX) - ZMGH(L,NY,NX)=ZMGH(L,NY,NX)+TRMGH(L,NY,NX)+TMGHFS(L,NY,NX) - 2+XMGHXS(L,NY,NX) - ZMGS(L,NY,NX)=ZMGS(L,NY,NX)+TRMGS(L,NY,NX)+TMGSFS(L,NY,NX) - 2+XMGSXS(L,NY,NX) - ZNAC(L,NY,NX)=ZNAC(L,NY,NX)+TRNAC(L,NY,NX)+TNACFS(L,NY,NX) - 2+XNACXS(L,NY,NX) - ZNAS(L,NY,NX)=ZNAS(L,NY,NX)+TRNAS(L,NY,NX)+TNASFS(L,NY,NX) - 2+XNASXS(L,NY,NX) - ZKAS(L,NY,NX)=ZKAS(L,NY,NX)+TRKAS(L,NY,NX)+TKASFS(L,NY,NX) - 2+XKASXS(L,NY,NX) - H0PO4(L,NY,NX)=H0PO4(L,NY,NX)+TRH0P(L,NY,NX)+TH0PFS(L,NY,NX) - 2+XH0PXS(L,NY,NX) - H1PO4(L,NY,NX)=H1PO4(L,NY,NX)+TRH1P(L,NY,NX)+TH1PFS(L,NY,NX) - 2+XH1PXS(L,NY,NX) - H3PO4(L,NY,NX)=H3PO4(L,NY,NX)+TRH3P(L,NY,NX)+TH3PFS(L,NY,NX) - 2+XH3PXS(L,NY,NX) - ZFE1P(L,NY,NX)=ZFE1P(L,NY,NX)+TRF1P(L,NY,NX)+TF1PFS(L,NY,NX) - 2+XF1PXS(L,NY,NX) - ZFE2P(L,NY,NX)=ZFE2P(L,NY,NX)+TRF2P(L,NY,NX)+TF2PFS(L,NY,NX) - 2+XF2PXS(L,NY,NX) - ZCA0P(L,NY,NX)=ZCA0P(L,NY,NX)+TRC0P(L,NY,NX)+TC0PFS(L,NY,NX) - 2+XC0PXS(L,NY,NX) - ZCA1P(L,NY,NX)=ZCA1P(L,NY,NX)+TRC1P(L,NY,NX)+TC1PFS(L,NY,NX) - 2+XC1PXS(L,NY,NX) - ZCA2P(L,NY,NX)=ZCA2P(L,NY,NX)+TRC2P(L,NY,NX)+TC2PFS(L,NY,NX) - 2+XC2PXS(L,NY,NX) - ZMG1P(L,NY,NX)=ZMG1P(L,NY,NX)+TRM1P(L,NY,NX)+TM1PFS(L,NY,NX) - 2+XM1PXS(L,NY,NX) - H0POB(L,NY,NX)=H0POB(L,NY,NX)+TRH0B(L,NY,NX)+TH0BFB(L,NY,NX) - 2+XH0BXB(L,NY,NX) - H1POB(L,NY,NX)=H1POB(L,NY,NX)+TRH1B(L,NY,NX)+TH1BFB(L,NY,NX) - 2+XH1BXB(L,NY,NX) - H3POB(L,NY,NX)=H3POB(L,NY,NX)+TRH3B(L,NY,NX)+TH3BFB(L,NY,NX) - 2+XH3BXB(L,NY,NX) - ZFE1PB(L,NY,NX)=ZFE1PB(L,NY,NX)+TRF1B(L,NY,NX)+TF1BFB(L,NY,NX) - 2+XF1BXB(L,NY,NX) - ZFE2PB(L,NY,NX)=ZFE2PB(L,NY,NX)+TRF2B(L,NY,NX)+TF2BFB(L,NY,NX) - 2+XF2BXB(L,NY,NX) - ZCA0PB(L,NY,NX)=ZCA0PB(L,NY,NX)+TRC0B(L,NY,NX)+TC0BFB(L,NY,NX) - 2+XC0BXB(L,NY,NX) - ZCA1PB(L,NY,NX)=ZCA1PB(L,NY,NX)+TRC1B(L,NY,NX)+TC1BFB(L,NY,NX) - 2+XC1BXB(L,NY,NX) - ZCA2PB(L,NY,NX)=ZCA2PB(L,NY,NX)+TRC2B(L,NY,NX)+TC2BFB(L,NY,NX) - 2+XC2BXB(L,NY,NX) - ZMG1PB(L,NY,NX)=ZMG1PB(L,NY,NX)+TRM1B(L,NY,NX)+TM1BFB(L,NY,NX) - 2+XM1BXB(L,NY,NX) - ZALH(L,NY,NX)=ZALH(L,NY,NX)+TALFHS(L,NY,NX)-XALFXS(L,NY,NX) - ZFEH(L,NY,NX)=ZFEH(L,NY,NX)+TFEFHS(L,NY,NX)-XFEFXS(L,NY,NX) - ZHYH(L,NY,NX)=ZHYH(L,NY,NX)+THYFHS(L,NY,NX)-XHYFXS(L,NY,NX) - ZCCH(L,NY,NX)=ZCCH(L,NY,NX)+TCAFHS(L,NY,NX)-XCAFXS(L,NY,NX) - ZMAH(L,NY,NX)=ZMAH(L,NY,NX)+TMGFHS(L,NY,NX)-XMGFXS(L,NY,NX) - ZNAH(L,NY,NX)=ZNAH(L,NY,NX)+TNAFHS(L,NY,NX)-XNAFXS(L,NY,NX) - ZKAH(L,NY,NX)=ZKAH(L,NY,NX)+TKAFHS(L,NY,NX)-XKAFXS(L,NY,NX) - ZOHH(L,NY,NX)=ZOHH(L,NY,NX)+TOHFHS(L,NY,NX)-XOHFXS(L,NY,NX) - ZSO4H(L,NY,NX)=ZSO4H(L,NY,NX)+TSOFHS(L,NY,NX)-XSOFXS(L,NY,NX) - ZCLH(L,NY,NX)=ZCLH(L,NY,NX)+TCLFHS(L,NY,NX)-XCLFXS(L,NY,NX) - ZCO3H(L,NY,NX)=ZCO3H(L,NY,NX)+TC3FHS(L,NY,NX)-XC3FXS(L,NY,NX) - ZHCO3H(L,NY,NX)=ZHCO3H(L,NY,NX)+THCFHS(L,NY,NX)-XHCFXS(L,NY,NX) - ZALO1H(L,NY,NX)=ZALO1H(L,NY,NX)+TAL1HS(L,NY,NX)-XAL1XS(L,NY,NX) - ZALO2H(L,NY,NX)=ZALO2H(L,NY,NX)+TAL2HS(L,NY,NX)-XAL2XS(L,NY,NX) - ZALO3H(L,NY,NX)=ZALO3H(L,NY,NX)+TAL3HS(L,NY,NX)-XAL3XS(L,NY,NX) - ZALO4H(L,NY,NX)=ZALO4H(L,NY,NX)+TAL4HS(L,NY,NX)-XAL4XS(L,NY,NX) - ZALSH(L,NY,NX)=ZALSH(L,NY,NX)+TALSHS(L,NY,NX)-XALSXS(L,NY,NX) - ZFEO1H(L,NY,NX)=ZFEO1H(L,NY,NX)+TFE1HS(L,NY,NX)-XFE1XS(L,NY,NX) - ZFEO2H(L,NY,NX)=ZFEO2H(L,NY,NX)+TFE2HS(L,NY,NX)-XFE2XS(L,NY,NX) - ZFEO3H(L,NY,NX)=ZFEO3H(L,NY,NX)+TFE3HS(L,NY,NX)-XFE3XS(L,NY,NX) - ZFEO4H(L,NY,NX)=ZFEO4H(L,NY,NX)+TFE4HS(L,NY,NX)-XFE4XS(L,NY,NX) - ZFESH(L,NY,NX)=ZFESH(L,NY,NX)+TFESHS(L,NY,NX)-XFESXS(L,NY,NX) - ZCAOH(L,NY,NX)=ZCAOH(L,NY,NX)+TCAOHS(L,NY,NX)-XCAOXS(L,NY,NX) - ZCACH(L,NY,NX)=ZCACH(L,NY,NX)+TCACHS(L,NY,NX)-XCACXS(L,NY,NX) - ZCAHH(L,NY,NX)=ZCAHH(L,NY,NX)+TCAHHS(L,NY,NX)-XCAHXS(L,NY,NX) - ZCASH(L,NY,NX)=ZCASH(L,NY,NX)+TCASHS(L,NY,NX)-XCASXS(L,NY,NX) - ZMGOH(L,NY,NX)=ZMGOH(L,NY,NX)+TMGOHS(L,NY,NX)-XMGOXS(L,NY,NX) - ZMGCH(L,NY,NX)=ZMGCH(L,NY,NX)+TMGCHS(L,NY,NX)-XMGCXS(L,NY,NX) - ZMGHH(L,NY,NX)=ZMGHH(L,NY,NX)+TMGHHS(L,NY,NX)-XMGHXS(L,NY,NX) - ZMGSH(L,NY,NX)=ZMGSH(L,NY,NX)+TMGSHS(L,NY,NX)-XMGSXS(L,NY,NX) - ZNACH(L,NY,NX)=ZNACH(L,NY,NX)+TNACHS(L,NY,NX)-XNACXS(L,NY,NX) - ZNASH(L,NY,NX)=ZNASH(L,NY,NX)+TNASHS(L,NY,NX)-XNASXS(L,NY,NX) - ZKASH(L,NY,NX)=ZKASH(L,NY,NX)+TKASHS(L,NY,NX)-XKASXS(L,NY,NX) - H0PO4H(L,NY,NX)=H0PO4H(L,NY,NX)+TH0PHS(L,NY,NX)-XH0PXS(L,NY,NX) - H1PO4H(L,NY,NX)=H1PO4H(L,NY,NX)+TH1PHS(L,NY,NX)-XH1PXS(L,NY,NX) - H3PO4H(L,NY,NX)=H3PO4H(L,NY,NX)+TH3PHS(L,NY,NX)-XH3PXS(L,NY,NX) - ZFE1PH(L,NY,NX)=ZFE1PH(L,NY,NX)+TF1PHS(L,NY,NX)-XF1PXS(L,NY,NX) - ZFE2PH(L,NY,NX)=ZFE2PH(L,NY,NX)+TF2PHS(L,NY,NX)-XF2PXS(L,NY,NX) - ZCA0PH(L,NY,NX)=ZCA0PH(L,NY,NX)+TC0PHS(L,NY,NX)-XC0PXS(L,NY,NX) - ZCA1PH(L,NY,NX)=ZCA1PH(L,NY,NX)+TC1PHS(L,NY,NX)-XC1PXS(L,NY,NX) - ZCA2PH(L,NY,NX)=ZCA2PH(L,NY,NX)+TC2PHS(L,NY,NX)-XC2PXS(L,NY,NX) - ZMG1PH(L,NY,NX)=ZMG1PH(L,NY,NX)+TM1PHS(L,NY,NX)-XM1PXS(L,NY,NX) - H0POBH(L,NY,NX)=H0POBH(L,NY,NX)+TH0BHB(L,NY,NX)-XH0BXB(L,NY,NX) - H1POBH(L,NY,NX)=H1POBH(L,NY,NX)+TH1BHB(L,NY,NX)-XH1BXB(L,NY,NX) - H3POBH(L,NY,NX)=H3POBH(L,NY,NX)+TH3BHB(L,NY,NX)-XH3BXB(L,NY,NX) - ZFE1BH(L,NY,NX)=ZFE1BH(L,NY,NX)+TF1BHB(L,NY,NX)-XF1BXB(L,NY,NX) - ZFE2BH(L,NY,NX)=ZFE2BH(L,NY,NX)+TF2BHB(L,NY,NX)-XF2BXB(L,NY,NX) - ZCA0BH(L,NY,NX)=ZCA0BH(L,NY,NX)+TC0BHB(L,NY,NX)-XC0BXB(L,NY,NX) - ZCA1BH(L,NY,NX)=ZCA1BH(L,NY,NX)+TC1BHB(L,NY,NX)-XC1BXB(L,NY,NX) - ZCA2BH(L,NY,NX)=ZCA2BH(L,NY,NX)+TC2BHB(L,NY,NX)-XC2BXB(L,NY,NX) - ZMG1BH(L,NY,NX)=ZMG1BH(L,NY,NX)+TM1BHB(L,NY,NX)-XM1BXB(L,NY,NX) - XHY(L,NY,NX)=XHY(L,NY,NX)+TRXHY(L,NY,NX) - XAL(L,NY,NX)=XAL(L,NY,NX)+TRXAL(L,NY,NX) - XCA(L,NY,NX)=XCA(L,NY,NX)+TRXCA(L,NY,NX) - XMG(L,NY,NX)=XMG(L,NY,NX)+TRXMG(L,NY,NX) - XNA(L,NY,NX)=XNA(L,NY,NX)+TRXNA(L,NY,NX) - XKA(L,NY,NX)=XKA(L,NY,NX)+TRXKA(L,NY,NX) - XHC(L,NY,NX)=XHC(L,NY,NX)+TRXHC(L,NY,NX) - XALO2(L,NY,NX)=XALO2(L,NY,NX)+TRXAL2(L,NY,NX) - PALOH(L,NY,NX)=PALOH(L,NY,NX)+TRALOH(L,NY,NX) - PFEOH(L,NY,NX)=PFEOH(L,NY,NX)+TRFEOH(L,NY,NX) - PCACO(L,NY,NX)=PCACO(L,NY,NX)+TRCACO(L,NY,NX) - PCASO(L,NY,NX)=PCASO(L,NY,NX)+TRCASO(L,NY,NX) -C -C SOIL ELECTRICAL CONDUCTIVITY -C - IF(VOLW(L,NY,NX).GT.0.0)THEN - ECHY=0.337*AMAX1(0.0,ZHY(L,NY,NX)/VOLW(L,NY,NX)) - ECOH=0.192*AMAX1(0.0,ZOH(L,NY,NX)/VOLW(L,NY,NX)) - ECAL=0.056*AMAX1(0.0,ZAL(L,NY,NX)*3.0/VOLW(L,NY,NX)) - ECFE=0.051*AMAX1(0.0,ZFE(L,NY,NX)*3.0/VOLW(L,NY,NX)) - ECCA=0.060*AMAX1(0.0,ZCA(L,NY,NX)*2.0/VOLW(L,NY,NX)) - ECMG=0.053*AMAX1(0.0,ZMG(L,NY,NX)*2.0/VOLW(L,NY,NX)) - ECNA=0.050*AMAX1(0.0,ZNA(L,NY,NX)/VOLW(L,NY,NX)) - ECKA=0.070*AMAX1(0.0,ZKA(L,NY,NX)/VOLW(L,NY,NX)) - ECCO=0.072*AMAX1(0.0,ZCO3(L,NY,NX)*2.0/VOLW(L,NY,NX)) - ECHC=0.044*AMAX1(0.0,ZHCO3(L,NY,NX)/VOLW(L,NY,NX)) - ECSO=0.080*AMAX1(0.0,ZSO4(L,NY,NX)*2.0/VOLW(L,NY,NX)) - ECCL=0.076*AMAX1(0.0,ZCL(L,NY,NX)/VOLW(L,NY,NX)) - ECNO=0.071*AMAX1(0.0,ZNO3S(L,NY,NX)/(VOLW(L,NY,NX)*14.0)) - ECND(L,NY,NX)=ECHY+ECOH+ECAL+ECFE+ECCA+ECMG+ECNA+ECKA - 2+ECCO+ECHC+ECSO+ECCL+ECNO - ELSE - ECND(L,NY,NX)=0.0 - ENDIF -C IF(NX.EQ.1.AND.NY.EQ.5)THEN -C WRITE(*,5656)'ECND',IYRC,I,J,NX,NY,L -C 2,ECND(L,NY,NX),VOLW(L,NY,NX),ECHY,ECOH,ECAL,ECFE,ECCA -C 3,ECMG,ECNA,ECKA,ECCO,ECHC,ECSO,ECCL,ECNO -5656 FORMAT(A8,6I4,30E12.4) -C ENDIF - ELSE - XZHYS(L,NY,NX)=0.0 - XZHYU=0.0 - XZOHU=0.0 - ENDIF -C -C GRID CELL BOUNDARY FLUXES FROM ROOT GAS TRANSFER -C - VOLWOU=VOLWOU-18.0E-06*TRH2O(L,NY,NX) - HEATIN=HEATIN+THTHAW(L,NY,NX)+TUPHT(L,NY,NX) - CI=TCOFLA(L,NY,NX) - CH=TCHFLA(L,NY,NX) - OI=TOXFLA(L,NY,NX) - ZGI=0.0 - Z2I=TN2FLA(L,NY,NX) - ZHI=TNHFLA(L,NY,NX) - TI=THGFLA(L,NY,NX) -C -C GRID CELL BOUNDARY FLUXES BUBBLING -C - IF(LG.EQ.0)THEN - CI=CI+XCOBBL(L,NY,NX) - CH=CH+XCHBBL(L,NY,NX) - OI=OI+XOXBBL(L,NY,NX) - ZGI=ZGI+XNGBBL(L,NY,NX) - Z2I=Z2I+XN2BBL(L,NY,NX) - ZHI=ZHI+XN3BBL(L,NY,NX)+XNBBBL(L,NY,NX) - TI=TI+XHGBBL(L,NY,NX) - ELSE - LL=MIN(L,LG) - CO2G(LL,NY,NX)=CO2G(LL,NY,NX)-XCOBBL(L,NY,NX) - CH4G(LL,NY,NX)=CH4G(LL,NY,NX)-XCHBBL(L,NY,NX) - OXYG(LL,NY,NX)=OXYG(LL,NY,NX)-XOXBBL(L,NY,NX) - Z2GG(LL,NY,NX)=Z2GG(LL,NY,NX)-XNGBBL(L,NY,NX) - Z2OG(LL,NY,NX)=Z2OG(LL,NY,NX)-XN2BBL(L,NY,NX) - ZNH3G(LL,NY,NX)=ZNH3G(LL,NY,NX)-XN3BBL(L,NY,NX)-XNBBBL(L,NY,NX) - H2GG(LL,NY,NX)=H2GG(LL,NY,NX)-XHGBBL(L,NY,NX) - IF(LG.LT.L)THEN - TLCO2G=TLCO2G-XCOBBL(L,NY,NX)-XCHBBL(L,NY,NX) - UCO2S(NY,NX)=UCO2S(NY,NX)-XCOBBL(L,NY,NX)-XCHBBL(L,NY,NX) - OXYGSO=OXYGSO-XOXBBL(L,NY,NX) - TLN2G=TLN2G-XNGBBL(L,NY,NX)-XN2BBL(L,NY,NX) - 2-XN3BBL(L,NY,NX)-XNBBBL(L,NY,NX) - TION=TION-XHGBBL(L,NY,NX) - ENDIF - ENDIF - CO2GIN=CO2GIN+CI+CH - CO=TCO2P(L,NY,NX)+TCO2S(L,NY,NX)-TRCO2(L,NY,NX) - HCO2G(NY,NX)=HCO2G(NY,NX)+CI - UCO2G(NY,NX)=UCO2G(NY,NX)+CI - HCH4G(NY,NX)=HCH4G(NY,NX)+CH - UCH4G(NY,NX)=UCH4G(NY,NX)+CH - TCOU=TCOU+CO - UCOP(NY,NX)=UCOP(NY,NX)+TCO2P(L,NY,NX)+TCO2S(L,NY,NX) - UDICD(NY,NX)=UDICD(NY,NX)-TRCO2(L,NY,NX) - TNBP(NY,NX)=TNBP(NY,NX)+CH+TRCO2(L,NY,NX) - OXYGIN=OXYGIN+OI - OO=RUPOXO(L,NY,NX)+TUPOXP(L,NY,NX)+TUPOXS(L,NY,NX) - UOXYG(NY,NX)=UOXYG(NY,NX)+OI - HOXYG(NY,NX)=HOXYG(NY,NX)+OI - OXYGOU=OXYGOU+OO - ZN2GIN=ZN2GIN+ZGI+Z2I+ZHI -C UN2GG(NY,NX)=UN2GG(NY,NX)+ZGI -C HN2GG(NY,NX)=HN2GG(NY,NX)+ZGI - UN2OG(NY,NX)=UN2OG(NY,NX)+Z2I - HN2OG(NY,NX)=HN2OG(NY,NX)+Z2I - UNH3G(NY,NX)=UNH3G(NY,NX)+ZHI - HNH3G(NY,NX)=HNH3G(NY,NX)+ZHI - UH2GG(NY,NX)=UH2GG(NY,NX)+TI -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 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,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) -C 6,CH4G(LL,NY,NX) -6645 FORMAT(A8,7I4,30E12.4) -C ENDIF -C -C GRID CELL BOUNDARY FLUXES FROM EQUILIBRIUM REACTIONS -C - TZOU=TZOU-14.0*(TBNH4(L,NY,NX)+TBNO3(L,NY,NX)+TBNH3(L,NY,NX)) - TPOU=TPOU-31.0*TBH2P(L,NY,NX) - TIONIN=TIONIN+TI - TO=2.0*TRH2O(L,NY,NX)+3.0*TBCO2(L,NY,NX)+2.0*TBNH4(L,NY,NX) - 2+TBNH3(L,NY,NX)+TBNO3(L,NY,NX)+3.0*TBH2P(L,NY,NX)-XZHYS(L,NY,NX) - 3+RH2GO(L,NY,NX)-XZHYU-XZOHU+TBION(L,NY,NX) - TIONOU=TIONOU+TO -C UIONOU(NY,NX)=UIONOU(NY,NX)+TO -C -C GAS AND SOLUTE EXCHANGE WITHIN GRID CELL ADDED TO ECOSYSTEM - -C TOTALS FOR CALCULATING COMPETITION CONSTRAINTS ON MICROBIAL -C AND ROOT POPULATIONS -C - DO 7990 K=0,5 - DO 7980 N=1,7 - ROXYX(L,NY,NX)=ROXYX(L,NY,NX)+ROXYS(N,K,L,NY,NX) - RNH4X(L,NY,NX)=RNH4X(L,NY,NX)+RVMX4(N,K,L,NY,NX) - 2+RINHO(N,K,L,NY,NX) - RNO3X(L,NY,NX)=RNO3X(L,NY,NX)+RVMX3(N,K,L,NY,NX) - 2+RINOO(N,K,L,NY,NX) - RNO2X(L,NY,NX)=RNO2X(L,NY,NX)+RVMX2(N,K,L,NY,NX) - RN2OX(L,NY,NX)=RN2OX(L,NY,NX)+RVMX1(N,K,L,NY,NX) - RPO4X(L,NY,NX)=RPO4X(L,NY,NX)+RIPOO(N,K,L,NY,NX) - RNHBX(L,NY,NX)=RNHBX(L,NY,NX)+RVMB4(N,K,L,NY,NX) - 2+RINHB(N,K,L,NY,NX) - RN3BX(L,NY,NX)=RN3BX(L,NY,NX)+RVMB3(N,K,L,NY,NX) - 2+RINOB(N,K,L,NY,NX) - RN2BX(L,NY,NX)=RN2BX(L,NY,NX)+RVMB2(N,K,L,NY,NX) - RPOBX(L,NY,NX)=RPOBX(L,NY,NX)+RIPOB(N,K,L,NY,NX) - IF(K.LE.4)THEN - ROQCX(K,L,NY,NX)=ROQCX(K,L,NY,NX)+ROQCS(N,K,L,NY,NX) - ROQAX(K,L,NY,NX)=ROQAX(K,L,NY,NX)+ROQAS(N,K,L,NY,NX) - ENDIF -7980 CONTINUE -7990 CONTINUE - RNO2X(L,NY,NX)=RNO2X(L,NY,NX)+RVMXC(L,NY,NX) - RN2BX(L,NY,NX)=RN2BX(L,NY,NX)+RVMBC(L,NY,NX) -C -C GRID CELL VARIABLES NEEDED FOR WATER, C, N, P, O, SOLUTE AND -C ENERGY BALANCES INCLUDING SUM OF ALL CURRENT STATE VARIABLES, -C CUMULATIVE SUMS OF ALL ADDITIONS AND REMOVALS SINCE START OF RUN -C -C IF(J.EQ.24)THEN - WS=VOLW(L,NY,NX)+VOLWH(L,NY,NX) - 2+(VOLI(L,NY,NX)+VOLIH(L,NY,NX))*0.92 - VOLWSO=VOLWSO+WS - UVOLW(NY,NX)=UVOLW(NY,NX)+WS -C 2-WP(L,NY,NX)*VOLX(L,NY,NX) - HEATSO=HEATSO+VHCP(L,NY,NX)*TKS(L,NY,NX) - SD=SAND(L,NY,NX)+SILT(L,NY,NX)+CLAY(L,NY,NX) - TSEDSO=TSEDSO+SD - CS=CO2G(L,NY,NX)+CO2S(L,NY,NX)+CO2SH(L,NY,NX)+TLCO2P(L,NY,NX) - 2+CH4G(L,NY,NX)+CH4S(L,NY,NX)+CH4SH(L,NY,NX)+TLCH4P(L,NY,NX) - TLCO2G=TLCO2G+CS - UCO2S(NY,NX)=UCO2S(NY,NX)+CS -C IF(NX.EQ.1.AND.NY.EQ.1)THEN -C WRITE(*,8642)'TLCO2G',I,J,L,TLCO2G,CS,CO2G(L,NY,NX),CO2S(L,NY,NX) -C 2,CO2SH(L,NY,NX),TLCO2P(L,NY,NX),CH4G(L,NY,NX),CH4S(L,NY,NX) -C 3,CH4SH(L,NY,NX),TLCH4P(L,NY,NX),UCO2S(NY,NX) -8642 FORMAT(A8,3I4,20F20.6) -C ENDIF - OS=OXYG(L,NY,NX)+OXYS(L,NY,NX)+OXYSH(L,NY,NX)+TLOXYP(L,NY,NX) - OXYGSO=OXYGSO+OS - ZG=Z2GG(L,NY,NX)+Z2GS(L,NY,NX)+Z2GSH(L,NY,NX)+TLN2OP(L,NY,NX) - 2+Z2OG(L,NY,NX)+Z2OS(L,NY,NX)+Z2OSH(L,NY,NX)+TLNH3P(L,NY,NX) - 3+ZNH3G(L,NY,NX) - TLN2G=TLN2G+ZG - ZNH=ZNH4S(L,NY,NX)+ZNH4SH(L,NY,NX)+ZNH4B(L,NY,NX)+ZNH4BH(L,NY,NX) - 2+ZNH3S(L,NY,NX)+ZNH3SH(L,NY,NX)+ZNH3B(L,NY,NX)+ZNH3BH(L,NY,NX) - TLNH4=TLNH4+ZNH - UNH4(NY,NX)=UNH4(NY,NX)+ZNH+14.0*(XN4(L,NY,NX)+XNB(L,NY,NX)) -C IF(NX.EQ.4)THEN -C WRITE(*,5455)'XNH4L',I,J,NX,NY,L,UNH4(NY,NX),ZNH,XN4(L,NY,NX) -C 2,XNB(L,NY,NX),ZNH4S(L,NY,NX),ZNH4SH(L,NY,NX) -C 3,ZNH4B(L,NY,NX),ZNH4BH(L,NY,NX),ZNH3S(L,NY,NX),ZNH3SH(L,NY,NX) -C 4,ZNH3B(L,NY,NX),ZNH3BH(L,NY,NX) -5455 FORMAT(A8,5I4,30E12.4) -C ENDIF - ZNO=ZNO3S(L,NY,NX)+ZNO3SH(L,NY,NX)+ZNO3B(L,NY,NX)+ZNO3BH(L,NY,NX) - 2+ZNO2S(L,NY,NX)+ZNO2SH(L,NY,NX)+ZNO2B(L,NY,NX)+ZNO2BH(L,NY,NX) - TLNO3=TLNO3+ZNO - UNO3(NY,NX)=UNO3(NY,NX)+ZNO - P4=H2PO4(L,NY,NX)+H2PO4H(L,NY,NX)+H2POB(L,NY,NX)+H2POBH(L,NY,NX) - TLPO4=TLPO4+P4 - UPO4(NY,NX)=UPO4(NY,NX)+P4+31.0*(XH1P(L,NY,NX)+XH2P(L,NY,NX) - 2+XH1PB(L,NY,NX)+XH2PB(L,NY,NX)) - UPP4(NY,NX)=UPP4(NY,NX)+31.0*(PALPO(L,NY,NX)+PFEPO(L,NY,NX) - 2+PCAPD(L,NY,NX)+PALPB(L,NY,NX)+PFEPB(L,NY,NX)+PCPDB(L,NY,NX)) - 3+93.0*(PCAPH(L,NY,NX)+PCPHB(L,NY,NX)) - 4+62.0*(PCAPM(L,NY,NX)+PCPMB(L,NY,NX)) -C -C TOTAL SON,SON,SOP -C - RC=0.0 - RN=0.0 - RP=0.0 - OC=0.0 - ON=0.0 - OP=0.0 - OMCL(L,NY,NX)=0.0 - OMNL(L,NY,NX)=0.0 - DO 7970 K=0,5 - IF(K.LE.2)THEN - DO 7960 N=1,7 - DO 7960 M=1,3 - RC=RC+OMC(M,N,K,L,NY,NX) - RN=RN+OMN(M,N,K,L,NY,NX) - RP=RP+OMP(M,N,K,L,NY,NX) - TOMT(NY,NX)=TOMT(NY,NX)+OMC(M,N,K,L,NY,NX) - TONT(NY,NX)=TONT(NY,NX)+OMN(M,N,K,L,NY,NX) - TOPT(NY,NX)=TOPT(NY,NX)+OMP(M,N,K,L,NY,NX) - OMCL(L,NY,NX)=OMCL(L,NY,NX)+OMC(M,N,K,L,NY,NX) - OMNL(L,NY,NX)=OMNL(L,NY,NX)+OMN(M,N,K,L,NY,NX) -7960 CONTINUE - ELSE - DO 7950 N=1,7 - DO 7950 M=1,3 - OC=OC+OMC(M,N,K,L,NY,NX) - ON=ON+OMN(M,N,K,L,NY,NX) - OP=OP+OMP(M,N,K,L,NY,NX) - TOMT(NY,NX)=TOMT(NY,NX)+OMC(M,N,K,L,NY,NX) - TONT(NY,NX)=TONT(NY,NX)+OMN(M,N,K,L,NY,NX) - TOPT(NY,NX)=TOPT(NY,NX)+OMP(M,N,K,L,NY,NX) - OMCL(L,NY,NX)=OMCL(L,NY,NX)+OMC(M,N,K,L,NY,NX) - OMNL(L,NY,NX)=OMNL(L,NY,NX)+OMN(M,N,K,L,NY,NX) -7950 CONTINUE - ENDIF -7970 CONTINUE - DO 7900 K=0,4 - IF(K.LE.2)THEN - DO 7940 M=1,2 - RC=RC+ORC(M,K,L,NY,NX) - RN=RN+ORN(M,K,L,NY,NX) - RP=RP+ORP(M,K,L,NY,NX) -7940 CONTINUE - RC=RC+OQC(K,L,NY,NX)+OQCH(K,L,NY,NX)+OHC(K,L,NY,NX) - 2+OQA(K,L,NY,NX)+OQAH(K,L,NY,NX)+OHA(K,L,NY,NX) - RN=RN+OQN(K,L,NY,NX)+OQNH(K,L,NY,NX)+OHN(K,L,NY,NX) - RP=RP+OQP(K,L,NY,NX)+OQPH(K,L,NY,NX)+OHP(K,L,NY,NX) - DO 7930 M=1,4 - RC=RC+OSC(M,K,L,NY,NX) - RN=RN+OSN(M,K,L,NY,NX) - RP=RP+OSP(M,K,L,NY,NX) -7930 CONTINUE - ELSE - DO 7920 M=1,2 - OC=OC+ORC(M,K,L,NY,NX) - ON=ON+ORN(M,K,L,NY,NX) - OP=OP+ORP(M,K,L,NY,NX) -7920 CONTINUE - OC=OC+OQC(K,L,NY,NX)+OQCH(K,L,NY,NX)+OHC(K,L,NY,NX) - 2+OQA(K,L,NY,NX)+OQAH(K,L,NY,NX)+OHA(K,L,NY,NX) - ON=ON+OQN(K,L,NY,NX)+OQNH(K,L,NY,NX)+OHN(K,L,NY,NX) - OP=OP+OQP(K,L,NY,NX)+OQPH(K,L,NY,NX)+OHP(K,L,NY,NX) - DO 7910 M=1,4 - OC=OC+OSC(M,K,L,NY,NX) - ON=ON+OSN(M,K,L,NY,NX) - OP=OP+OSP(M,K,L,NY,NX) -7910 CONTINUE - ENDIF -7900 CONTINUE - ORGC(L,NY,NX)=RC+OC - ORGN(L,NY,NX)=RN+ON - ORGR(L,NY,NX)=RC -C IF(L.EQ.1)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) -4343 FORMAT(A8,6I4,60E12.4) -4344 CONTINUE -C ENDIF - TLRSDC=TLRSDC+RC - URSDC(NY,NX)=URSDC(NY,NX)+RC - TLRSDN=TLRSDN+RN - URSDN(NY,NX)=URSDN(NY,NX)+RN - TLRSDP=TLRSDP+RP - URSDP(NY,NX)=URSDP(NY,NX)+RP - TLORGC=TLORGC+OC - UORGC(NY,NX)=UORGC(NY,NX)+OC - TLORGN=TLORGN+ON - UORGN(NY,NX)=UORGN(NY,NX)+ON - TLORGP=TLORGP+OP - UORGP(NY,NX)=UORGP(NY,NX)+OP - TSEDSO=TSEDSO+(RC+OC)*1.0E-06 - TS=ZAL(L,NY,NX)+ZFE(L,NY,NX)+ZHY(L,NY,NX)+ZCA(L,NY,NX) - 2+ZMG(L,NY,NX)+ZNA(L,NY,NX)+ZKA(L,NY,NX)+ZOH(L,NY,NX) - 3+ZSO4(L,NY,NX)+ZCL(L,NY,NX)+ZCO3(L,NY,NX)+H0PO4(L,NY,NX) - 4+H0POB(L,NY,NX)+2.0*(ZHCO3(L,NY,NX)+ZALOH1(L,NY,NX) - 5+ZALS(L,NY,NX)+ZFEOH1(L,NY,NX)+ZFES(L,NY,NX)+ZCAO(L,NY,NX) - 6+ZCAC(L,NY,NX)+ZCAS(L,NY,NX)+ZMGO(L,NY,NX)+ZMGC(L,NY,NX) - 7+ZMGS(L,NY,NX)+ZNAC(L,NY,NX)+ZNAS(L,NY,NX)+ZKAS(L,NY,NX) - 8+H1PO4(L,NY,NX)+H1POB(L,NY,NX)+ZCA0P(L,NY,NX)+ZCA0PB(L,NY,NX)) - 9+3.0*(ZALOH2(L,NY,NX)+ZFEOH2(L,NY,NX)+ZCAH(L,NY,NX) - 1+ZMGH(L,NY,NX)+ZFE1P(L,NY,NX)+ZCA1P(L,NY,NX)+ZMG1P(L,NY,NX) - 2+ZFE1PB(L,NY,NX)+ZCA1PB(L,NY,NX)+ZMG1PB(L,NY,NX))+4.0* - 3(ZALOH3(L,NY,NX)+ZFEOH3(L,NY,NX)+H3PO4(L,NY,NX)+ZFE2P(L,NY,NX) - 4+ZCA2P(L,NY,NX)+H3POB(L,NY,NX)+ZFE2PB(L,NY,NX) - 5+ZCA2PB(L,NY,NX))+5.0*(ZALOH4(L,NY,NX)+ZFEOH4(L,NY,NX)) - TH=ZALH(L,NY,NX)+ZFEH(L,NY,NX)+ZHYH(L,NY,NX)+ZCCH(L,NY,NX) - 2+ZMAH(L,NY,NX)+ZNAH(L,NY,NX)+ZKAH(L,NY,NX)+ZOHH(L,NY,NX) - 3+ZSO4H(L,NY,NX)+ZCLH(L,NY,NX)+ZCO3H(L,NY,NX)+H0PO4H(L,NY,NX) - 4+H0POBH(L,NY,NX)+2.0*(ZHCO3H(L,NY,NX)+ZALO1H(L,NY,NX) - 5+ZALSH(L,NY,NX)+ZFEO1H(L,NY,NX)+ZFESH(L,NY,NX)+ZCAOH(L,NY,NX) - 6+ZCACH(L,NY,NX)+ZCASH(L,NY,NX)+ZMGOH(L,NY,NX)+ZMGCH(L,NY,NX) - 7+ZMGSH(L,NY,NX)+ZNACH(L,NY,NX)+ZNASH(L,NY,NX)+ZKASH(L,NY,NX) - 8+H1PO4H(L,NY,NX)+H1POBH(L,NY,NX)+ZCA0PH(L,NY,NX)+ZCA0BH(L,NY,NX)) - 9+3.0*(ZALO2H(L,NY,NX)+ZFEO2H(L,NY,NX)+ZCAHH(L,NY,NX) - 1+ZMGHH(L,NY,NX)+ZFE1PH(L,NY,NX)+ZCA1PH(L,NY,NX)+ZMG1PH(L,NY,NX) - 2+ZFE1BH(L,NY,NX)+ZCA1BH(L,NY,NX)+ZMG1BH(L,NY,NX))+4.0* - 3(ZALO3H(L,NY,NX)+ZFEO3H(L,NY,NX)+H3PO4H(L,NY,NX)+ZFE2PH(L,NY,NX) - 4+ZCA2PH(L,NY,NX)+H3POBH(L,NY,NX)+ZFE2BH(L,NY,NX) - 5+ZCA2BH(L,NY,NX))+5.0*(ZALO4H(L,NY,NX)+ZFEO4H(L,NY,NX)) - TX=2.0*(XN4(L,NY,NX)+XNB(L,NY,NX))+XHY(L,NY,NX)+XAL(L,NY,NX) - 2+XCA(L,NY,NX)+XMG(L,NY,NX)+XNA(L,NY,NX)+XKA(L,NY,NX)+XHC(L,NY,NX) - 3+XOH0(L,NY,NX)+XOH0B(L,NY,NX)+2.0*(PCACO(L,NY,NX)+PCASO(L,NY,NX) - 4+PALPO(L,NY,NX)+PFEPO(L,NY,NX)+PALPB(L,NY,NX)+PFEPB(L,NY,NX) - 5+XOH1(L,NY,NX)+XOH1B(L,NY,NX)) - 6+3.0*(PCAPD(L,NY,NX)+PCPDB(L,NY,NX)+XALO2(L,NY,NX) - 7+XOH2(L,NY,NX)+XOH2B(L,NY,NX)+XH1P(L,NY,NX)+XH1PB(L,NY,NX)) - 8+4.0*(PALOH(L,NY,NX)+PFEOH(L,NY,NX)+XH2P(L,NY,NX) - 9+XH2PB(L,NY,NX))+7.0*(PCAPM(L,NY,NX)+PCPMB(L,NY,NX)) - 1+9.0*(PCAPH(L,NY,NX)+PCPHB(L,NY,NX)) - TF=2.0*(ZNH4FA(L,NY,NX)+ZNH4FB(L,NY,NX))+ZNO3FA(L,NY,NX) - 2+ZNO3FB(L,NY,NX)+ZNH3FA(L,NY,NX)+ZNH3FB(L,NY,NX) - 3+ZNHUFA(L,NY,NX)+ZNHUFB(L,NY,NX) - TG=H2GG(L,NY,NX)+H2GS(L,NY,NX)+H2GSH(L,NY,NX)+TLH2GP(L,NY,NX) - TI=TS+TH+TX+TF+TG - TION=TION+TI - UION(NY,NX)=UION(NY,NX)+TI -C ENDIF -125 CONTINUE - TRN(NY,NX)=TRN(NY,NX)+HEATI(NY,NX) - TLE(NY,NX)=TLE(NY,NX)+HEATE(NY,NX) - TSH(NY,NX)=TSH(NY,NX)+HEATS(NY,NX) - TGH(NY,NX)=TGH(NY,NX)-(HEATH(NY,NX)-HEATV(NY,NX)) - TLEC(NY,NX)=TLEC(NY,NX)+HEATE(NY,NX)*RAC(NY,NX) - TSHC(NY,NX)=TSHC(NY,NX)+HEATS(NY,NX)*RAC(NY,NX) - TCNET(NY,NX)=TCNET(NY,NX)+HCO2G(NY,NX) - RECO(NY,NX)=RECO(NY,NX)+HCO2G(NY,NX) - TNBP(NY,NX)=TNBP(NY,NX)+TCNET(NY,NX) -C -C UPDATE STATE VARIABLES WHEN SURFACE SEDIMENT TRANSPORT -C FORCES SOIL RE-LAYERING IF SURFACE LAYER BECOMES TOO -C THIN OR TOO THICK -C - IF(DLYR(3,NU(NY,NX),NY,NX).LT.DNUMN - 2.OR.DLYR(3,NU(NY,NX),NY,NX).GT.DNUMX)THEN - L0=NU(NY,NX) - IF(DLYR(3,NU(NY,NX),NY,NX).LT.DNUMN)THEN - FX=1.0 - L1=NU(NY,NX)+1 - NU(NY,NX)=L1 - ELSE - IF(NU(NY,NX).EQ.1)THEN - FX=(DLYR(3,NU(NY,NX),NY,NX)-DNUMX)/DLYR(3,NU(NY,NX),NY,NX) - L1=NU(NY,NX)+1 - NU(NY,NX)=L0 - ELSE - FZ=DLYR(3,NU(NY,NX),NY,NX)-DNUMX - IF(FZ.GT.DNUMN)THEN - FX=(DLYR(3,NU(NY,NX),NY,NX)-DNUMX)/DLYR(3,NU(NY,NX),NY,NX) - L1=NU(NY,NX)-1 - NU(NY,NX)=L1 - ELSE - FX=0.0 - L1=NU(NY,NX) - ENDIF - ENDIF - ENDIF - WRITE(*,5599)'ERODE1',I,J,NX,NY,L0,L1,NU(NY,NX),DNUMN,DNUMX - 2,DLYR(3,L0,NY,NX),DLYR(3,L1,NY,NX),FX -5599 FORMAT(A8,7I4,12E12.4) - IF(FX.GT.0.0)THEN - FY=1.0-FX - BKDS(L1,NY,NX)=(BKDS(L1,NY,NX) - 2*DLYR(3,L1,NY,NX)+BKDS(L0,NY,NX) - 3*FX*DLYR(3,L0,NY,NX))/(DLYR(3,L1,NY,NX) - 4+FX*DLYR(3,L0,NY,NX)) - VLNHB(L1,NY,NX)=(VLNHB(L1,NY,NX) - 2*DLYR(3,L1,NY,NX)+VLNHB(L0,NY,NX) - 3*FX*DLYR(3,L0,NY,NX))/(DLYR(3,L1,NY,NX) - 4+FX*DLYR(3,L0,NY,NX)) - VLNOB(L1,NY,NX)=(VLNOB(L1,NY,NX) - 2*DLYR(3,L1,NY,NX)+VLNOB(L0,NY,NX) - 3*FX*DLYR(3,L0,NY,NX))/(DLYR(3,L1,NY,NX) - 4+FX*DLYR(3,L0,NY,NX)) - VLPOB(L1,NY,NX)=(VLPOB(L1,NY,NX) - 2*DLYR(3,L1,NY,NX)+VLPOB(L0,NY,NX) - 3*FX*DLYR(3,L0,NY,NX))/(DLYR(3,L1,NY,NX) - 4+FX*DLYR(3,L0,NY,NX)) - VLNH4(L1,NY,NX)=1.0-VLNHB(L1,NY,NX) - VLNO3(L1,NY,NX)=1.0-VLNOB(L1,NY,NX) - VLPO4(L1,NY,NX)=1.0-VLPOB(L1,NY,NX) - DLYR(3,L1,NY,NX)=DLYR(3,L1,NY,NX) - 2+FX*DLYR(3,L0,NY,NX) - VOLX(L1,NY,NX)=VOLX(L1,NY,NX) - 2+FX*VOLX(L0,NY,NX) - BKVL(L1,NY,NX)=BKVL(L1,NY,NX) - 2+FX*BKVL(L0,NY,NX) - SAND(L1,NY,NX)=SAND(L1,NY,NX) - 2+FX*SAND(L0,NY,NX) - SILT(L1,NY,NX)=SILT(L1,NY,NX) - 2+FX*SILT(L0,NY,NX) - CLAY(L1,NY,NX)=CLAY(L1,NY,NX) - 2+FX*CLAY(L0,NY,NX) - XCEC(L1,NY,NX)=XCEC(L1,NY,NX) - 2+FX*XCEC(L0,NY,NX) - XAEC(L1,NY,NX)=XAEC(L1,NY,NX) - 2+FX*XAEC(L0,NY,NX) - VOLW(L1,NY,NX)=VOLW(L1,NY,NX) - 2+FX*VOLW(L0,NY,NX) - VOLI(L1,NY,NX)=VOLI(L1,NY,NX) - 2+FX*VOLI(L0,NY,NX) - VOLIH(L1,NY,NX)=VOLIH(L1,NY,NX) - 2+FX*VOLIH(L0,NY,NX) - VOLP(L1,NY,NX)=VOLP(L1,NY,NX) - 2+FX*VOLP(L0,NY,NX) - VOLA(L1,NY,NX)=VOLA(L1,NY,NX) - 2+FX*VOLA(L0,NY,NX) - VOLWX(L1,NY,NX)=VOLW(L0,NY,NX) - VOLWH(L1,NY,NX)=VOLWH(L1,NY,NX) - 2+FX*VOLWH(L0,NY,NX) - VOLAH(L1,NY,NX)=VOLAH(L1,NY,NX) - 2+FX*VOLAH(L0,NY,NX) - VHCM(L1,NY,NX)=VHCM(L1,NY,NX) - 2+FX*VHCM(L0,NY,NX) - VHCP(L1,NY,NX)=VHCM(L1,NY,NX) - 2+4.19*(VOLW(L1,NY,NX)+VOLWH(L1,NY,NX)) - 3+1.9274*(VOLI(L1,NY,NX)+VOLIH(L1,NY,NX)) - ZNH4FA(L1,NY,NX)=ZNH4FA(L1,NY,NX) - 2+FX*ZNH4FA(L0,NY,NX) - ZNH3FA(L1,NY,NX)=ZNH3FA(L1,NY,NX) - 2+FX*ZNH3FA(L0,NY,NX) - ZNHUFA(L1,NY,NX)=ZNHUFA(L1,NY,NX) - 2+FX*ZNHUFA(L0,NY,NX) - ZNO3FA(L1,NY,NX)=ZNO3FA(L1,NY,NX) - 2+FX*ZNO3FA(L0,NY,NX) - ZNH4FB(L1,NY,NX)=ZNH4FB(L1,NY,NX) - 2+FX*ZNH4FB(L0,NY,NX) - ZNH3FB(L1,NY,NX)=ZNH3FB(L1,NY,NX) - 2+FX*ZNH3FB(L0,NY,NX) - ZNHUFB(L1,NY,NX)=ZNHUFB(L1,NY,NX) - 2+FX*ZNHUFB(L0,NY,NX) - ZNO3FB(L1,NY,NX)=ZNO3FB(L1,NY,NX) - 2+FX*ZNO3FB(L0,NY,NX) - ZNH4S(L1,NY,NX)=ZNH4S(L1,NY,NX) - 2+FX*ZNH4S(L0,NY,NX) - ZNH4B(L1,NY,NX)=ZNH4B(L1,NY,NX) - 2+FX*ZNH4B(L0,NY,NX) - ZNH3S(L1,NY,NX)=ZNH3S(L1,NY,NX) - 2+FX*ZNH3S(L0,NY,NX) - ZNH3B(L1,NY,NX)=ZNH3B(L1,NY,NX) - 2+FX*ZNH3B(L0,NY,NX) - ZNO3S(L1,NY,NX)=ZNO3S(L1,NY,NX) - 2+FX*ZNO3S(L0,NY,NX) - ZNO3B(L1,NY,NX)=ZNO3B(L1,NY,NX) - 2+FX*ZNO3B(L0,NY,NX) - ZNO2S(L1,NY,NX)=ZNO2S(L1,NY,NX) - 2+FX*ZNO2S(L0,NY,NX) - ZNO2B(L1,NY,NX)=ZNO2B(L1,NY,NX) - 2+FX*ZNO2B(L0,NY,NX) - ZAL(L1,NY,NX)=ZAL(L1,NY,NX) - 2+FX*ZAL(L0,NY,NX) - ZFE(L1,NY,NX)=ZFE(L1,NY,NX) - 2+FX*ZFE(L0,NY,NX) - ZHY(L1,NY,NX)=ZHY(L1,NY,NX) - 2+FX*ZHY(L0,NY,NX) - ZCA(L1,NY,NX)=ZCA(L1,NY,NX) - 2+FX*ZCA(L0,NY,NX) - ZMG(L1,NY,NX)=ZMG(L1,NY,NX) - 2+FX*ZMG(L0,NY,NX) - ZNA(L1,NY,NX)=ZNA(L1,NY,NX) - 2+FX*ZNA(L0,NY,NX) - ZKA(L1,NY,NX)=ZKA(L1,NY,NX) - 2+FX*ZKA(L0,NY,NX) - ZOH(L1,NY,NX)=ZOH(L1,NY,NX) - 2+FX*ZOH(L0,NY,NX) - ZSO4(L1,NY,NX)=ZSO4(L1,NY,NX) - 2+FX*ZSO4(L0,NY,NX) - ZCL(L1,NY,NX)=ZCL(L1,NY,NX) - 2+FX*ZCL(L0,NY,NX) - ZCO3(L1,NY,NX)=ZCO3(L1,NY,NX) - 2+FX*ZCO3(L0,NY,NX) - ZHCO3(L1,NY,NX)=ZHCO3(L1,NY,NX) - 2+FX*ZHCO3(L0,NY,NX) - ZALOH1(L1,NY,NX)=ZALOH1(L1,NY,NX) - 2+FX*ZALOH1(L0,NY,NX) - ZALOH2(L1,NY,NX)=ZALOH2(L1,NY,NX) - 2+FX*ZALOH2(L0,NY,NX) - ZALOH3(L1,NY,NX)=ZALOH3(L1,NY,NX) - 2+FX*ZALOH3(L0,NY,NX) - ZALOH4(L1,NY,NX)=ZALOH4(L1,NY,NX) - 2+FX*ZALOH4(L0,NY,NX) - ZALS(L1,NY,NX)=ZALS(L1,NY,NX) - 2+FX*ZALS(L0,NY,NX) - ZFEOH1(L1,NY,NX)=ZFEOH1(L1,NY,NX) - 2+FX*ZFEOH1(L0,NY,NX) - ZFEOH2(L1,NY,NX)=ZFEOH2(L1,NY,NX) - 2+FX*ZFEOH2(L0,NY,NX) - ZFEOH3(L1,NY,NX)=ZFEOH3(L1,NY,NX) - 2+FX*ZFEOH3(L0,NY,NX) - ZFEOH4(L1,NY,NX)=ZFEOH4(L1,NY,NX) - 2+FX*ZFEOH4(L0,NY,NX) - ZFES(L1,NY,NX)=ZFES(L1,NY,NX) - 2+FX*ZFES(L0,NY,NX) - ZCAO(L1,NY,NX)=ZCAO(L1,NY,NX) - 2+FX*ZCAO(L0,NY,NX) - ZCAC(L1,NY,NX)=ZCAC(L1,NY,NX) - 2+FX*ZCAC(L0,NY,NX) - ZCAH(L1,NY,NX)=ZCAH(L1,NY,NX) - 2+FX*ZCAH(L0,NY,NX) - ZCAS(L1,NY,NX)=ZCAS(L1,NY,NX) - 2+FX*ZCAS(L0,NY,NX) - ZMGO(L1,NY,NX)=ZMGO(L1,NY,NX) - 2+FX*ZMGO(L0,NY,NX) - ZMGC(L1,NY,NX)=ZMGC(L1,NY,NX) - 2+FX*ZMGC(L0,NY,NX) - ZMGH(L1,NY,NX)=ZMGH(L1,NY,NX) - 2+FX*ZMGH(L0,NY,NX) - ZMGS(L1,NY,NX)=ZMGS(L1,NY,NX) - 2+FX*ZMGS(L0,NY,NX) - ZNAC(L1,NY,NX)=ZNAC(L1,NY,NX) - 2+FX*ZNAC(L0,NY,NX) - ZNAS(L1,NY,NX)=ZNAS(L1,NY,NX) - 2+FX*ZNAS(L0,NY,NX) - ZKAS(L1,NY,NX)=ZKAS(L1,NY,NX) - 2+FX*ZKAS(L0,NY,NX) - H0PO4(L1,NY,NX)=H0PO4(L1,NY,NX) - 2+FX*H0PO4(L0,NY,NX) - H1PO4(L1,NY,NX)=H1PO4(L1,NY,NX) - 2+FX*H1PO4(L0,NY,NX) - H2PO4(L1,NY,NX)=H2PO4(L1,NY,NX) - 2+FX*H2PO4(L0,NY,NX) - H3PO4(L1,NY,NX)=H3PO4(L1,NY,NX) - 2+FX*H3PO4(L0,NY,NX) - ZFE1P(L1,NY,NX)=ZFE1P(L1,NY,NX) - 2+FX*ZFE1P(L0,NY,NX) - ZFE2P(L1,NY,NX)=ZFE2P(L1,NY,NX) - 2+FX*ZFE2P(L0,NY,NX) - ZCA0P(L1,NY,NX)=ZCA0P(L1,NY,NX) - 2+FX*ZCA0P(L0,NY,NX) - ZCA1P(L1,NY,NX)=ZCA1P(L1,NY,NX) - 2+FX*ZCA1P(L0,NY,NX) - ZCA2P(L1,NY,NX)=ZCA2P(L1,NY,NX) - 2+FX*ZCA2P(L0,NY,NX) - ZMG1P(L1,NY,NX)=ZMG1P(L1,NY,NX) - 2+FX*ZMG1P(L0,NY,NX) - H0POB(L1,NY,NX)=H0POB(L1,NY,NX) - 2+FX*H0POB(L0,NY,NX) - H1POB(L1,NY,NX)=H1POB(L1,NY,NX) - 2+FX*H1POB(L0,NY,NX) - H2POB(L1,NY,NX)=H2POB(L1,NY,NX) - 2+FX*H2POB(L0,NY,NX) - H3POB(L1,NY,NX)=H3POB(L1,NY,NX) - 2+FX*H3POB(L0,NY,NX) - ZFE1PB(L1,NY,NX)=ZFE1PB(L1,NY,NX) - 2+FX*ZFE1PB(L0,NY,NX) - ZFE2PB(L1,NY,NX)=ZFE2PB(L1,NY,NX) - 2+FX*ZFE2PB(L0,NY,NX) - ZCA0PB(L1,NY,NX)=ZCA0PB(L1,NY,NX) - 2+FX*ZCA0PB(L0,NY,NX) - ZCA1PB(L1,NY,NX)=ZCA1PB(L1,NY,NX) - 2+FX*ZCA1PB(L0,NY,NX) - ZCA2PB(L1,NY,NX)=ZCA2PB(L1,NY,NX) - 2+FX*ZCA2PB(L0,NY,NX) - ZMG1PB(L1,NY,NX)=ZMG1PB(L1,NY,NX) - 2+FX*ZMG1PB(L0,NY,NX) - XN4(L1,NY,NX)=XN4(L1,NY,NX) - 2+FX*XN4(L0,NY,NX) - XNB(L1,NY,NX)=XNB(L1,NY,NX) - 2+FX*XNB(L0,NY,NX) - XHY(L1,NY,NX)=XHY(L1,NY,NX) - 2+FX*XHY(L0,NY,NX) - XAL(L1,NY,NX)=XAL(L1,NY,NX) - 2+FX*XAL(L0,NY,NX) - XCA(L1,NY,NX)=XCA(L1,NY,NX) - 2+FX*XCA(L0,NY,NX) - XMG(L1,NY,NX)=XMG(L1,NY,NX) - 2+FX*XMG(L0,NY,NX) - XNA(L1,NY,NX)=XNA(L1,NY,NX) - 2+FX*XNA(L0,NY,NX) - XKA(L1,NY,NX)=XKA(L1,NY,NX) - 2+FX*XKA(L0,NY,NX) - XHC(L1,NY,NX)=XHC(L1,NY,NX) - 2+FX*XHC(L0,NY,NX) - XALO2(L1,NY,NX)=XALO2(L1,NY,NX) - 2+FX*XALO2(L0,NY,NX) - XOH0(L1,NY,NX)=XOH0(L1,NY,NX) - 2+FX*XOH0(L0,NY,NX) - XOH1(L1,NY,NX)=XOH1(L1,NY,NX) - 2+FX*XOH1(L0,NY,NX) - XOH2(L1,NY,NX)=XOH2(L1,NY,NX) - 2+FX*XOH2(L0,NY,NX) - XH1P(L1,NY,NX)=XH1P(L1,NY,NX) - 2+FX*XH1P(L0,NY,NX) - XH2P(L1,NY,NX)=XH2P(L1,NY,NX) - 2+FX*XH2P(L0,NY,NX) - XOH0B(L1,NY,NX)=XOH0B(L1,NY,NX) - 2+FX*XOH0B(L0,NY,NX) - XOH1B(L1,NY,NX)=XOH1B(L1,NY,NX) - 2+FX*XOH1B(L0,NY,NX) - XOH2B(L1,NY,NX)=XOH2B(L1,NY,NX) - 2+FX*XOH2B(L0,NY,NX) - XH1PB(L1,NY,NX)=XH1PB(L1,NY,NX) - 2+FX*XH1PB(L0,NY,NX) - XH2PB(L1,NY,NX)=XH2PB(L1,NY,NX) - 2+FX*XH2PB(L0,NY,NX) - PALOH(L1,NY,NX)=PALOH(L1,NY,NX) - 2+FX*PALOH(L0,NY,NX) - PFEOH(L1,NY,NX)=PFEOH(L1,NY,NX) - 2+FX*PFEOH(L0,NY,NX) - PCACO(L1,NY,NX)=PCACO(L1,NY,NX) - 2+FX*PCACO(L0,NY,NX) - PCASO(L1,NY,NX)=PCASO(L1,NY,NX) - 2+FX*PCASO(L0,NY,NX) - PALPO(L1,NY,NX)=PALPO(L1,NY,NX) - 2+FX*PALPO(L0,NY,NX) - PFEPO(L1,NY,NX)=PFEPO(L1,NY,NX) - 2+FX*PFEPO(L0,NY,NX) - PCAPD(L1,NY,NX)=PCAPD(L1,NY,NX) - 2+FX*PCAPD(L0,NY,NX) - PCAPH(L1,NY,NX)=PCAPH(L1,NY,NX) - 2+FX*PCAPH(L0,NY,NX) - PCAPM(L1,NY,NX)=PCAPM(L1,NY,NX) - 2+FX*PCAPM(L0,NY,NX) - PALPB(L1,NY,NX)=PALPB(L1,NY,NX) - 2+FX*PALPB(L0,NY,NX) - PFEPB(L1,NY,NX)=PFEPB(L1,NY,NX) - 2+FX*PFEPB(L0,NY,NX) - PCPDB(L1,NY,NX)=PCPDB(L1,NY,NX) - 2+FX*PCPDB(L0,NY,NX) - PCPHB(L1,NY,NX)=PCPHB(L1,NY,NX) - 2+FX*PCPHB(L0,NY,NX) - PCPMB(L1,NY,NX)=PCPMB(L1,NY,NX) - 2+FX*PCPMB(L0,NY,NX) - CO2G(L1,NY,NX)=CO2G(L1,NY,NX) - 2+FX*CO2G(L0,NY,NX) - CH4G(L1,NY,NX)=CH4G(L1,NY,NX) - 2+FX*CH4G(L0,NY,NX) - CO2S(L1,NY,NX)=CO2S(L1,NY,NX) - 2+FX*CO2S(L0,NY,NX) - CH4S(L1,NY,NX)=CH4S(L1,NY,NX) - 2+FX*CH4S(L0,NY,NX) - OXYG(L1,NY,NX)=OXYG(L1,NY,NX) - 2+FX*OXYG(L0,NY,NX) - OXYS(L1,NY,NX)=OXYS(L1,NY,NX) - 2+FX*OXYS(L0,NY,NX) - Z2GG(L1,NY,NX)=Z2GG(L1,NY,NX) - 2+FX*Z2GG(L0,NY,NX) - Z2GS(L1,NY,NX)=Z2GS(L1,NY,NX) - 2+FX*Z2GS(L0,NY,NX) - Z2OG(L1,NY,NX)=Z2OG(L1,NY,NX) - 2+FX*Z2OG(L0,NY,NX) - Z2OS(L1,NY,NX)=Z2OS(L1,NY,NX) - 2+FX*Z2OS(L0,NY,NX) - ZNH3G(L1,NY,NX)=ZNH3G(L1,NY,NX) - 2+FX*ZNH3G(L0,NY,NX) - H2GG(L1,NY,NX)=H2GG(L1,NY,NX) - 2+FX*H2GG(L0,NY,NX) - H2GS(L1,NY,NX)=H2GS(L1,NY,NX) - 2+FX*H2GS(L0,NY,NX) - ZNH4SH(L1,NY,NX)=ZNH4SH(L1,NY,NX) - 2+FX*ZNH4SH(L0,NY,NX) - ZNH3SH(L1,NY,NX)=ZNH3SH(L1,NY,NX) - 2+FX*ZNH3SH(L0,NY,NX) - ZNO3SH(L1,NY,NX)=ZNO3SH(L1,NY,NX) - 2+FX*ZNO3SH(L0,NY,NX) - ZNO2SH(L1,NY,NX)=ZNO2SH(L1,NY,NX) - 2+FX*ZNO2SH(L0,NY,NX) - H2PO4H(L1,NY,NX)=H2PO4H(L1,NY,NX) - 2+FX*H2PO4H(L0,NY,NX) - ZNH4BH(L1,NY,NX)=ZNH4BH(L1,NY,NX) - 2+FX*ZNH4BH(L0,NY,NX) - ZNH3BH(L1,NY,NX)=ZNH3BH(L1,NY,NX) - 2+FX*ZNH3BH(L0,NY,NX) - ZNO3BH(L1,NY,NX)=ZNO3BH(L1,NY,NX) - 2+FX*ZNO3BH(L0,NY,NX) - ZNO2BH(L1,NY,NX)=ZNO2BH(L1,NY,NX) - 2+FX*ZNO2BH(L0,NY,NX) - H2POBH(L1,NY,NX)=H2POBH(L1,NY,NX) - 2+FX*H2POBH(L0,NY,NX) - ZALH(L1,NY,NX)=ZALH(L1,NY,NX) - 2+FX*ZALH(L0,NY,NX) - ZFEH(L1,NY,NX)=ZFEH(L1,NY,NX) - 2+FX*ZFEH(L0,NY,NX) - ZHYH(L1,NY,NX)=ZHYH(L1,NY,NX) - 2+FX*ZHYH(L0,NY,NX) - ZCCH(L1,NY,NX)=ZCCH(L1,NY,NX) - 2+FX*ZCCH(L0,NY,NX) - ZMAH(L1,NY,NX)=ZMAH(L1,NY,NX) - 2+FX*ZMAH(L0,NY,NX) - ZNAH(L1,NY,NX)=ZNAH(L1,NY,NX) - 2+FX*ZNAH(L0,NY,NX) - ZKAH(L1,NY,NX)=ZKAH(L1,NY,NX) - 2+FX*ZKAH(L0,NY,NX) - ZOHH(L1,NY,NX)=ZOHH(L1,NY,NX) - 2+FX*ZOHH(L0,NY,NX) - ZSO4H(L1,NY,NX)=ZSO4H(L1,NY,NX) - 2+FX*ZSO4H(L0,NY,NX) - ZCLH(L1,NY,NX)=ZCLH(L1,NY,NX) - 2+FX*ZCLH(L0,NY,NX) - ZCO3H(L1,NY,NX)=ZCO3H(L1,NY,NX) - 2+FX*ZCO3H(L0,NY,NX) - ZHCO3H(L1,NY,NX)=ZHCO3H(L1,NY,NX) - 2+FX*ZHCO3H(L0,NY,NX) - ZALO1H(L1,NY,NX)=ZALO1H(L1,NY,NX) - 2+FX*ZALO1H(L0,NY,NX) - ZALO2H(L1,NY,NX)=ZALO2H(L1,NY,NX) - 2+FX*ZALO2H(L0,NY,NX) - ZALO3H(L1,NY,NX)=ZALO3H(L1,NY,NX) - 2+FX*ZALO3H(L0,NY,NX) - ZALO4H(L1,NY,NX)=ZALO4H(L1,NY,NX) - 2+FX*ZALO4H(L0,NY,NX) - ZALSH(L1,NY,NX)=ZALSH(L1,NY,NX) - 2+FX*ZALSH(L0,NY,NX) - ZFEO1H(L1,NY,NX)=ZFEO1H(L1,NY,NX) - 2+FX*ZFEO1H(L0,NY,NX) - ZFEO2H(L1,NY,NX)=ZFEO2H(L1,NY,NX) - 2+FX*ZFEO2H(L0,NY,NX) - ZFEO3H(L1,NY,NX)=ZFEO3H(L1,NY,NX) - 2+FX*ZFEO3H(L0,NY,NX) - ZFEO4H(L1,NY,NX)=ZFEO4H(L1,NY,NX) - 2+FX*ZFEO4H(L0,NY,NX) - ZFESH(L1,NY,NX)=ZFESH(L1,NY,NX) - 2+FX*ZFESH(L0,NY,NX) - ZCAOH(L1,NY,NX)=ZCAOH(L1,NY,NX) - 2+FX*ZCAOH(L0,NY,NX) - ZCACH(L1,NY,NX)=ZCACH(L1,NY,NX) - 2+FX*ZCACH(L0,NY,NX) - ZCAHH(L1,NY,NX)=ZCAHH(L1,NY,NX) - 2+FX*ZCAHH(L0,NY,NX) - ZCASH(L1,NY,NX)=ZCASH(L1,NY,NX) - 2+FX*ZCASH(L0,NY,NX) - ZMGOH(L1,NY,NX)=ZMGOH(L1,NY,NX) - 2+FX*ZMGOH(L0,NY,NX) - ZMGCH(L1,NY,NX)=ZMGCH(L1,NY,NX) - 2+FX*ZMGCH(L0,NY,NX) - ZMGHH(L1,NY,NX)=ZMGHH(L1,NY,NX) - 2+FX*ZMGHH(L0,NY,NX) - ZMGSH(L1,NY,NX)=ZMGSH(L1,NY,NX) - 2+FX*ZMGSH(L0,NY,NX) - ZNACH(L1,NY,NX)=ZNACH(L1,NY,NX) - 2+FX*ZNACH(L0,NY,NX) - ZNASH(L1,NY,NX)=ZNASH(L1,NY,NX) - 2+FX*ZNASH(L0,NY,NX) - ZKASH(L1,NY,NX)=ZKASH(L1,NY,NX) - 2+FX*ZKASH(L0,NY,NX) - H0PO4H(L1,NY,NX)=H0PO4H(L1,NY,NX) - 2+FX*H0PO4H(L0,NY,NX) - H1PO4H(L1,NY,NX)=H1PO4H(L1,NY,NX) - 2+FX*H1PO4H(L0,NY,NX) - H3PO4H(L1,NY,NX)=H3PO4H(L1,NY,NX) - 2+FX*H3PO4H(L0,NY,NX) - ZFE1PH(L1,NY,NX)=ZFE1PH(L1,NY,NX) - 2+FX*ZFE1PH(L0,NY,NX) - ZFE2PH(L1,NY,NX)=ZFE2PH(L1,NY,NX) - 2+FX*ZFE2PH(L0,NY,NX) - ZCA0PH(L1,NY,NX)=ZCA0PH(L1,NY,NX) - 2+FX*ZCA0PH(L0,NY,NX) - ZCA1PH(L1,NY,NX)=ZCA1PH(L1,NY,NX) - 2+FX*ZCA1PH(L0,NY,NX) - ZCA2PH(L1,NY,NX)=ZCA2PH(L1,NY,NX) - 2+FX*ZCA2PH(L0,NY,NX) - ZMG1PH(L1,NY,NX)=ZMG1PH(L1,NY,NX) - 2+FX*ZMG1PH(L0,NY,NX) - H0POBH(L1,NY,NX)=H0POBH(L1,NY,NX) - 2+FX*H0POBH(L0,NY,NX) - H1POBH(L1,NY,NX)=H1POBH(L1,NY,NX) - 2+FX*H1POBH(L0,NY,NX) - H3POBH(L1,NY,NX)=H3POBH(L1,NY,NX) - 2+FX*H3POBH(L0,NY,NX) - ZFE1BH(L1,NY,NX)=ZFE1BH(L1,NY,NX) - 2+FX*ZFE1BH(L0,NY,NX) - ZFE2BH(L1,NY,NX)=ZFE2BH(L1,NY,NX) - 2+FX*ZFE2BH(L0,NY,NX) - ZCA0BH(L1,NY,NX)=ZCA0BH(L1,NY,NX) - 2+FX*ZCA0BH(L0,NY,NX) - ZCA1BH(L1,NY,NX)=ZCA1BH(L1,NY,NX) - 2+FX*ZCA1BH(L0,NY,NX) - ZCA2BH(L1,NY,NX)=ZCA2BH(L1,NY,NX) - 2+FX*ZCA2BH(L0,NY,NX) - ZMG1BH(L1,NY,NX)=ZMG1BH(L1,NY,NX) - 2+FX*ZMG1BH(L0,NY,NX) - CO2SH(L1,NY,NX)=CO2SH(L1,NY,NX) - 2+FX*CO2SH(L0,NY,NX) - CH4SH(L1,NY,NX)=CH4SH(L1,NY,NX) - 2+FX*CH4SH(L0,NY,NX) - OXYSH(L1,NY,NX)=OXYSH(L1,NY,NX) - 2+FX*OXYSH(L0,NY,NX) - Z2GSH(L1,NY,NX)=Z2GSH(L1,NY,NX) - 2+FX*Z2GSH(L0,NY,NX) - Z2OSH(L1,NY,NX)=Z2OSH(L1,NY,NX) - 2+FX*Z2OSH(L0,NY,NX) - ORGC(L1,NY,NX)=ORGC(L1,NY,NX) - 2+FX*ORGC(L0,NY,NX) - ORGN(L1,NY,NX)=ORGN(L1,NY,NX) - 2+FX*ORGN(L0,NY,NX) - DO 7965 K=0,5 - DO 7965 N=1,7 - DO 7965 M=1,3 - OMC(M,N,K,L1,NY,NX)=OMC(M,N,K,L1,NY,NX) - 2+FX*OMC(M,N,K,L0,NY,NX) - OMN(M,N,K,L1,NY,NX)=OMN(M,N,K,L1,NY,NX) - 2+FX*OMN(M,N,K,L0,NY,NX) - OMP(M,N,K,L1,NY,NX)=OMP(M,N,K,L1,NY,NX) - 2+FX*OMP(M,N,K,L0,NY,NX) -7965 CONTINUE - DO 7780 K=0,4 - DO 7775 M=1,2 - ORC(M,K,L1,NY,NX)=ORC(M,K,L1,NY,NX) - 2+FX*ORC(M,K,L0,NY,NX) - ORN(M,K,L1,NY,NX)=ORN(M,K,L1,NY,NX) - 2+FX*ORN(M,K,L0,NY,NX) - ORP(M,K,L1,NY,NX)=ORP(M,K,L1,NY,NX) - 2+FX*ORP(M,K,L0,NY,NX) -7775 CONTINUE - OQC(K,L1,NY,NX)=OQC(K,L1,NY,NX) - 2+FX*OQC(K,L0,NY,NX) - OQN(K,L1,NY,NX)=OQN(K,L1,NY,NX) - 2+FX*OQN(K,L0,NY,NX) - OQP(K,L1,NY,NX)=OQP(K,L1,NY,NX) - 2+FX*OQP(K,L0,NY,NX) - OQA(K,L1,NY,NX)=OQA(K,L1,NY,NX) - 2+FX*OQA(K,L0,NY,NX) - OQCH(K,L1,NY,NX)=OQCH(K,L1,NY,NX) - 2+FX*OQCH(K,L0,NY,NX) - OQNH(K,L1,NY,NX)=OQNH(K,L1,NY,NX) - 2+FX*OQNH(K,L0,NY,NX) - OQPH(K,L1,NY,NX)=OQPH(K,L1,NY,NX) - 2+FX*OQPH(K,L0,NY,NX) - OQAH(K,L1,NY,NX)=OQAH(K,L1,NY,NX) - 2+FX*OQAH(K,L0,NY,NX) - OHC(K,L1,NY,NX)=OHC(K,L1,NY,NX) - 2+FX*OHC(K,L0,NY,NX) - OHN(K,L1,NY,NX)=OHN(K,L1,NY,NX) - 2+FX*OHN(K,L0,NY,NX) - OHP(K,L1,NY,NX)=OHP(K,L1,NY,NX) - 2+FX*OHP(K,L0,NY,NX) - OHA(K,L1,NY,NX)=OHA(K,L1,NY,NX) - 2+FX*OHA(K,L0,NY,NX) - DO 7770 M=1,4 - OSC(M,K,L1,NY,NX)=OSC(M,K,L1,NY,NX) - 2+FX*OSC(M,K,L0,NY,NX) - OSA(M,K,L1,NY,NX)=OSA(M,K,L1,NY,NX) - 2+FX*OSA(M,K,L0,NY,NX) - OSN(M,K,L1,NY,NX)=OSN(M,K,L1,NY,NX) - 2+FX*OSN(M,K,L0,NY,NX) - OSP(M,K,L1,NY,NX)=OSP(M,K,L1,NY,NX) - 2+FX*OSP(M,K,L0,NY,NX) -7770 CONTINUE -7780 CONTINUE - CDPTH(L0,NY,NX)=CDPTH(L0,NY,NX) - 2-FX*DLYR(3,L0,NY,NX) - DLYR(3,L0,NY,NX)=FY*DLYR(3,L0,NY,NX) - VOLX(L0,NY,NX)=FY*VOLX(L0,NY,NX) - BKVL(L0,NY,NX)=FY*BKVL(L0,NY,NX) - SAND(L0,NY,NX)=FY*SAND(L0,NY,NX) - SILT(L0,NY,NX)=FY*SILT(L0,NY,NX) - CLAY(L0,NY,NX)=FY*CLAY(L0,NY,NX) - XCEC(L0,NY,NX)=FY*XCEC(L0,NY,NX) - XAEC(L0,NY,NX)=FY*XAEC(L0,NY,NX) - VOLW(L0,NY,NX)=FY*VOLW(L0,NY,NX) - VOLI(L0,NY,NX)=FY*VOLI(L0,NY,NX) - VOLP(L0,NY,NX)=FY*VOLP(L0,NY,NX) - VOLA(L0,NY,NX)=FY*VOLA(L0,NY,NX) - VOLWX(L0,NY,NX)=FY*VOLWX(L0,NY,NX) - VOLWH(L0,NY,NX)=FY*VOLWH(L0,NY,NX) - VOLIH(L0,NY,NX)=FY*VOLIH(L0,NY,NX) - VOLAH(L0,NY,NX)=FY*VOLAH(L0,NY,NX) - VHCM(L0,NY,NX)=FY*VHCM(L0,NY,NX) - VHCP(L0,NY,NX)=FY*VHCP(L0,NY,NX) - VHCP(L0,NY,NX)=VHCM(L0,NY,NX) - 2+4.19*(VOLW(L0,NY,NX)+VOLWH(L0,NY,NX)) - 3+1.9274*(VOLI(L0,NY,NX)+VOLIH(L0,NY,NX)) - ZNH4FA(L0,NY,NX)=FY*ZNH4FA(L0,NY,NX) - ZNH3FA(L0,NY,NX)=FY*ZNH3FA(L0,NY,NX) - ZNHUFA(L0,NY,NX)=FY*ZNHUFA(L0,NY,NX) - ZNO3FA(L0,NY,NX)=FY*ZNO3FA(L0,NY,NX) - ZNH4FB(L0,NY,NX)=FY*ZNH4FB(L0,NY,NX) - ZNH3FB(L0,NY,NX)=FY*ZNH3FB(L0,NY,NX) - ZNHUFB(L0,NY,NX)=FY*ZNHUFB(L0,NY,NX) - ZNO3FB(L0,NY,NX)=FY*ZNO3FB(L0,NY,NX) - ZNH4S(L0,NY,NX)=FY*ZNH4S(L0,NY,NX) - ZNH4B(L0,NY,NX)=FY*ZNH4B(L0,NY,NX) - ZNH3S(L0,NY,NX)=FY*ZNH3S(L0,NY,NX) - ZNH3B(L0,NY,NX)=FY*ZNH3B(L0,NY,NX) - ZNO3S(L0,NY,NX)=FY*ZNO3S(L0,NY,NX) - ZNO3B(L0,NY,NX)=FY*ZNO3B(L0,NY,NX) - ZNO2S(L0,NY,NX)=FY*ZNO2S(L0,NY,NX) - ZNO2B(L0,NY,NX)=FY*ZNO2B(L0,NY,NX) - ZAL(L0,NY,NX)=FY*ZAL(L0,NY,NX) - ZFE(L0,NY,NX)=FY*ZFE(L0,NY,NX) - ZHY(L0,NY,NX)=FY*ZHY(L0,NY,NX) - ZCA(L0,NY,NX)=FY*ZCA(L0,NY,NX) - ZMG(L0,NY,NX)=FY*ZMG(L0,NY,NX) - ZNA(L0,NY,NX)=FY*ZNA(L0,NY,NX) - ZKA(L0,NY,NX)=FY*ZKA(L0,NY,NX) - ZOH(L0,NY,NX)=FY*ZOH(L0,NY,NX) - ZSO4(L0,NY,NX)=FY*ZSO4(L0,NY,NX) - ZCL(L0,NY,NX)=FY*ZCL(L0,NY,NX) - ZCO3(L0,NY,NX)=FY*ZCO3(L0,NY,NX) - ZHCO3(L0,NY,NX)=FY*ZHCO3(L0,NY,NX) - ZALOH1(L0,NY,NX)=FY*ZALOH1(L0,NY,NX) - ZALOH2(L0,NY,NX)=FY*ZALOH2(L0,NY,NX) - ZALOH3(L0,NY,NX)=FY*ZALOH3(L0,NY,NX) - ZALOH4(L0,NY,NX)=FY*ZALOH4(L0,NY,NX) - ZALS(L0,NY,NX)=FY*ZALS(L0,NY,NX) - ZFEOH1(L0,NY,NX)=FY*ZFEOH1(L0,NY,NX) - ZFEOH2(L0,NY,NX)=FY*ZFEOH2(L0,NY,NX) - ZFEOH3(L0,NY,NX)=FY*ZFEOH3(L0,NY,NX) - ZFEOH4(L0,NY,NX)=FY*ZFEOH4(L0,NY,NX) - ZFES(L0,NY,NX)=FY*ZFES(L0,NY,NX) - ZCAO(L0,NY,NX)=FY*ZCAO(L0,NY,NX) - ZCAC(L0,NY,NX)=FY*ZCAC(L0,NY,NX) - ZCAH(L0,NY,NX)=FY*ZCAH(L0,NY,NX) - ZCAS(L0,NY,NX)=FY*ZCAS(L0,NY,NX) - ZMGO(L0,NY,NX)=FY*ZMGO(L0,NY,NX) - ZMGC(L0,NY,NX)=FY*ZMGC(L0,NY,NX) - ZMGH(L0,NY,NX)=FY*ZMGH(L0,NY,NX) - ZMGS(L0,NY,NX)=FY*ZMGS(L0,NY,NX) - ZNAC(L0,NY,NX)=FY*ZNAC(L0,NY,NX) - ZNAS(L0,NY,NX)=FY*ZNAS(L0,NY,NX) - ZKAS(L0,NY,NX)=FY*ZKAS(L0,NY,NX) - H0PO4(L0,NY,NX)=FY*H0PO4(L0,NY,NX) - H1PO4(L0,NY,NX)=FY*H1PO4(L0,NY,NX) - H2PO4(L0,NY,NX)=FY*H2PO4(L0,NY,NX) - H3PO4(L0,NY,NX)=FY*H3PO4(L0,NY,NX) - ZFE1P(L0,NY,NX)=FY*ZFE1P(L0,NY,NX) - ZFE2P(L0,NY,NX)=FY*ZFE2P(L0,NY,NX) - ZCA0P(L0,NY,NX)=FY*ZCA0P(L0,NY,NX) - ZCA1P(L0,NY,NX)=FY*ZCA1P(L0,NY,NX) - ZCA2P(L0,NY,NX)=FY*ZCA2P(L0,NY,NX) - ZMG1P(L0,NY,NX)=FY*ZMG1P(L0,NY,NX) - H0POB(L0,NY,NX)=FY*H0POB(L0,NY,NX) - H1POB(L0,NY,NX)=FY*H1POB(L0,NY,NX) - H2POB(L0,NY,NX)=FY*H2POB(L0,NY,NX) - H3POB(L0,NY,NX)=FY*H3POB(L0,NY,NX) - ZFE1PB(L0,NY,NX)=FY*ZFE1PB(L0,NY,NX) - ZFE2PB(L0,NY,NX)=FY*ZFE2PB(L0,NY,NX) - ZCA0PB(L0,NY,NX)=FY*ZCA0PB(L0,NY,NX) - ZCA1PB(L0,NY,NX)=FY*ZCA1PB(L0,NY,NX) - ZCA2PB(L0,NY,NX)=FY*ZCA2PB(L0,NY,NX) - ZMG1PB(L0,NY,NX)=FY*ZMG1PB(L0,NY,NX) - XN4(L0,NY,NX)=FY*XN4(L0,NY,NX) - XNB(L0,NY,NX)=FY*XNB(L0,NY,NX) - XHY(L0,NY,NX)=FY*XHY(L0,NY,NX) - XAL(L0,NY,NX)=FY*XAL(L0,NY,NX) - XCA(L0,NY,NX)=FY*XCA(L0,NY,NX) - XMG(L0,NY,NX)=FY*XMG(L0,NY,NX) - XNA(L0,NY,NX)=FY*XNA(L0,NY,NX) - XKA(L0,NY,NX)=FY*XKA(L0,NY,NX) - XHC(L0,NY,NX)=FY*XHC(L0,NY,NX) - XALO2(L0,NY,NX)=FY*XALO2(L0,NY,NX) - XOH0(L0,NY,NX)=FY*XOH0(L0,NY,NX) - XOH1(L0,NY,NX)=FY*XOH1(L0,NY,NX) - XOH2(L0,NY,NX)=FY*XOH2(L0,NY,NX) - XH1P(L0,NY,NX)=FY*XH1P(L0,NY,NX) - XH2P(L0,NY,NX)=FY*XH2P(L0,NY,NX) - XOH0B(L0,NY,NX)=FY*XOH0B(L0,NY,NX) - XOH1B(L0,NY,NX)=FY*XOH1B(L0,NY,NX) - XOH2B(L0,NY,NX)=FY*XOH2B(L0,NY,NX) - XH1PB(L0,NY,NX)=FY*XH1PB(L0,NY,NX) - XH2PB(L0,NY,NX)=FY*XH2PB(L0,NY,NX) - PALOH(L0,NY,NX)=FY*PALOH(L0,NY,NX) - PFEOH(L0,NY,NX)=FY*PFEOH(L0,NY,NX) - PCACO(L0,NY,NX)=FY*PCACO(L0,NY,NX) - PCASO(L0,NY,NX)=FY*PCASO(L0,NY,NX) - PALPO(L0,NY,NX)=FY*PALPO(L0,NY,NX) - PFEPO(L0,NY,NX)=FY*PFEPO(L0,NY,NX) - PCAPD(L0,NY,NX)=FY*PCAPD(L0,NY,NX) - PCAPH(L0,NY,NX)=FY*PCAPH(L0,NY,NX) - PCAPM(L0,NY,NX)=FY*PCAPM(L0,NY,NX) - PALPB(L0,NY,NX)=FY*PALPB(L0,NY,NX) - PFEPB(L0,NY,NX)=FY*PFEPB(L0,NY,NX) - PCPDB(L0,NY,NX)=FY*PCPDB(L0,NY,NX) - PCPHB(L0,NY,NX)=FY*PCPHB(L0,NY,NX) - PCPMB(L0,NY,NX)=FY*PCPMB(L0,NY,NX) - CO2G(L0,NY,NX)=FY*CO2G(L0,NY,NX) - CH4G(L0,NY,NX)=FY*CH4G(L0,NY,NX) - CO2S(L0,NY,NX)=FY*CO2S(L0,NY,NX) - CH4S(L0,NY,NX)=FY*CH4S(L0,NY,NX) - OXYG(L0,NY,NX)=FY*OXYG(L0,NY,NX) - OXYS(L0,NY,NX)=FY*OXYS(L0,NY,NX) - Z2GG(L0,NY,NX)=FY*Z2GG(L0,NY,NX) - Z2GS(L0,NY,NX)=FY*Z2GS(L0,NY,NX) - Z2OG(L0,NY,NX)=FY*Z2OG(L0,NY,NX) - Z2OS(L0,NY,NX)=FY*Z2OS(L0,NY,NX) - ZNH3G(L0,NY,NX)=FY*ZNH3G(L0,NY,NX) - H2GG(L0,NY,NX)=FY*H2GG(L0,NY,NX) - H2GS(L0,NY,NX)=FY*H2GS(L0,NY,NX) - ZNH4SH(L0,NY,NX)=FY*ZNH4SH(L0,NY,NX) - ZNH3SH(L0,NY,NX)=FY*ZNH3SH(L0,NY,NX) - ZNO3SH(L0,NY,NX)=FY*ZNO3SH(L0,NY,NX) - ZNO2SH(L0,NY,NX)=FY*ZNO2SH(L0,NY,NX) - H2PO4H(L0,NY,NX)=FY*H2PO4H(L0,NY,NX) - ZNH4BH(L0,NY,NX)=FY*ZNH4BH(L0,NY,NX) - ZNH3BH(L0,NY,NX)=FY*ZNH3BH(L0,NY,NX) - ZNO3BH(L0,NY,NX)=FY*ZNO3BH(L0,NY,NX) - ZNO2BH(L0,NY,NX)=FY*ZNO2BH(L0,NY,NX) - H2POBH(L0,NY,NX)=FY*H2POBH(L0,NY,NX) - ZALH(L0,NY,NX)=FY*ZALH(L0,NY,NX) - ZFEH(L0,NY,NX)=FY*ZFEH(L0,NY,NX) - ZHYH(L0,NY,NX)=FY*ZHYH(L0,NY,NX) - ZCCH(L0,NY,NX)=FY*ZCCH(L0,NY,NX) - ZMAH(L0,NY,NX)=FY*ZMAH(L0,NY,NX) - ZNAH(L0,NY,NX)=FY*ZNAH(L0,NY,NX) - ZKAH(L0,NY,NX)=FY*ZKAH(L0,NY,NX) - ZOHH(L0,NY,NX)=FY*ZOHH(L0,NY,NX) - ZSO4H(L0,NY,NX)=FY*ZSO4H(L0,NY,NX) - ZCLH(L0,NY,NX)=FY*ZCLH(L0,NY,NX) - ZCO3H(L0,NY,NX)=FY*ZCO3H(L0,NY,NX) - ZHCO3H(L0,NY,NX)=FY*ZHCO3H(L0,NY,NX) - ZALO1H(L0,NY,NX)=FY*ZALO1H(L0,NY,NX) - ZALO2H(L0,NY,NX)=FY*ZALO2H(L0,NY,NX) - ZALO3H(L0,NY,NX)=FY*ZALO3H(L0,NY,NX) - ZALO4H(L0,NY,NX)=FY*ZALO4H(L0,NY,NX) - ZALSH(L0,NY,NX)=FY*ZALSH(L0,NY,NX) - ZFEO1H(L0,NY,NX)=FY*ZFEO1H(L0,NY,NX) - ZFEO2H(L0,NY,NX)=FY*ZFEO2H(L0,NY,NX) - ZFEO3H(L0,NY,NX)=FY*ZFEO3H(L0,NY,NX) - ZFEO4H(L0,NY,NX)=FY*ZFEO4H(L0,NY,NX) - ZFESH(L0,NY,NX)=FY*ZFESH(L0,NY,NX) - ZCAOH(L0,NY,NX)=FY*ZCAOH(L0,NY,NX) - ZCACH(L0,NY,NX)=FY*ZCACH(L0,NY,NX) - ZCAHH(L0,NY,NX)=FY*ZCAHH(L0,NY,NX) - ZCASH(L0,NY,NX)=FY*ZCASH(L0,NY,NX) - ZMGOH(L0,NY,NX)=FY*ZMGOH(L0,NY,NX) - ZMGCH(L0,NY,NX)=FY*ZMGCH(L0,NY,NX) - ZMGHH(L0,NY,NX)=FY*ZMGHH(L0,NY,NX) - ZMGSH(L0,NY,NX)=FY*ZMGSH(L0,NY,NX) - ZNACH(L0,NY,NX)=FY*ZNACH(L0,NY,NX) - ZNASH(L0,NY,NX)=FY*ZNASH(L0,NY,NX) - ZKASH(L0,NY,NX)=FY*ZKASH(L0,NY,NX) - H0PO4H(L0,NY,NX)=FY*H0PO4H(L0,NY,NX) - H1PO4H(L0,NY,NX)=FY*H1PO4H(L0,NY,NX) - H3PO4H(L0,NY,NX)=FY*H3PO4H(L0,NY,NX) - ZFE1PH(L0,NY,NX)=FY*ZFE1PH(L0,NY,NX) - ZFE2PH(L0,NY,NX)=FY*ZFE2PH(L0,NY,NX) - ZCA0PH(L0,NY,NX)=FY*ZCA0PH(L0,NY,NX) - ZCA1PH(L0,NY,NX)=FY*ZCA1PH(L0,NY,NX) - ZCA2PH(L0,NY,NX)=FY*ZCA2PH(L0,NY,NX) - ZMG1PH(L0,NY,NX)=FY*ZMG1PH(L0,NY,NX) - H0POBH(L0,NY,NX)=FY*H0POBH(L0,NY,NX) - H1POBH(L0,NY,NX)=FY*H1POBH(L0,NY,NX) - H3POBH(L0,NY,NX)=FY*H3POBH(L0,NY,NX) - ZFE1BH(L0,NY,NX)=FY*ZFE1BH(L0,NY,NX) - ZFE2BH(L0,NY,NX)=FY*ZFE2BH(L0,NY,NX) - ZCA0BH(L0,NY,NX)=FY*ZCA0BH(L0,NY,NX) - ZCA1BH(L0,NY,NX)=FY*ZCA1BH(L0,NY,NX) - ZCA2BH(L0,NY,NX)=FY*ZCA2BH(L0,NY,NX) - ZMG1BH(L0,NY,NX)=FY*ZMG1BH(L0,NY,NX) - CO2SH(L0,NY,NX)=FY*CO2SH(L0,NY,NX) - CH4SH(L0,NY,NX)=FY*CH4SH(L0,NY,NX) - OXYSH(L0,NY,NX)=FY*OXYSH(L0,NY,NX) - Z2GSH(L0,NY,NX)=FY*Z2GSH(L0,NY,NX) - Z2OSH(L0,NY,NX)=FY*Z2OSH(L0,NY,NX) - ORGC(L0,NY,NX)=FY*ORGC(L0,NY,NX) - ORGN(L0,NY,NX)=FY*ORGN(L0,NY,NX) - DO 7865 K=0,5 - DO 7865 N=1,7 - DO 7865 M=1,3 - OMC(M,N,K,L0,NY,NX)=FY*OMC(M,N,K,L0,NY,NX) - OMN(M,N,K,L0,NY,NX)=FY*OMN(M,N,K,L0,NY,NX) - OMP(M,N,K,L0,NY,NX)=FY*OMP(M,N,K,L0,NY,NX) -7865 CONTINUE - DO 7880 K=0,4 - DO 7875 M=1,2 - ORC(M,K,L0,NY,NX)=FY*ORC(M,K,L0,NY,NX) - ORN(M,K,L0,NY,NX)=FY*ORN(M,K,L0,NY,NX) - ORP(M,K,L0,NY,NX)=FY*ORP(M,K,L0,NY,NX) -7875 CONTINUE - OQC(K,L0,NY,NX)=FY*OQC(K,L0,NY,NX) - OQN(K,L0,NY,NX)=FY*OQN(K,L0,NY,NX) - OQP(K,L0,NY,NX)=FY*OQP(K,L0,NY,NX) - OQA(K,L0,NY,NX)=FY*OQA(K,L0,NY,NX) - OQCH(K,L0,NY,NX)=FY*OQCH(K,L0,NY,NX) - OQNH(K,L0,NY,NX)=FY*OQNH(K,L0,NY,NX) - OQPH(K,L0,NY,NX)=FY*OQPH(K,L0,NY,NX) - OQAH(K,L0,NY,NX)=FY*OQAH(K,L0,NY,NX) - OHC(K,L0,NY,NX)=FY*OHC(K,L0,NY,NX) - OHN(K,L0,NY,NX)=FY*OHN(K,L0,NY,NX) - OHP(K,L0,NY,NX)=FY*OHP(K,L0,NY,NX) - OHA(K,L0,NY,NX)=FY*OHA(K,L0,NY,NX) - DO 7870 M=1,4 - OSC(M,K,L0,NY,NX)=FY*OSC(M,K,L0,NY,NX) - OSA(M,K,L0,NY,NX)=FY*OSA(M,K,L0,NY,NX) - OSN(M,K,L0,NY,NX)=FY*OSN(M,K,L0,NY,NX) - OSP(M,K,L0,NY,NX)=FY*OSP(M,K,L0,NY,NX) -7870 CONTINUE -7880 CONTINUE - IF(FY.EQ.0.0)THEN - CCO2S(L0,NY,NX)=9999 - CCH4S(L0,NY,NX)=9999 - COXYS(L0,NY,NX)=9999 - THETW(L0,NY,NX)=9999 - THETI(L0,NY,NX)=9999 - PSISM(L0,NY,NX)=9999 - CZ2OS(L0,NY,NX)=9999 - CNH3S(L0,NY,NX)=9999 - TCS(L0,NY,NX)=9999 - ENDIF - IFLGS(NY,NX)=1 - WRITE(*,5599)'ERODE2',I,J,NX,NY,L0,L1,NU(NY,NX),DNUMN,DNUMX - 2,DLYR(3,L0,NY,NX),DLYR(3,L1,NY,NX),FX - ENDIF - ENDIF -C -C RESIDUE REMOVAL IF FIRE OR REMOVAL EVENT IS ENTERED IN DISTURBANCE FILE -C - IF(J.EQ.INT(ZNOON(NY,NX)).AND.(ITILL(I,NY,NX).EQ.21 - 2.OR.ITILL(I,NY,NX).EQ.22))THEN - IF(ITILL(I,NY,NX).EQ.22)THEN - IFLGQ=0 - NLL=-1 - DO 2945 L=0,NL(NY,NX) -C WRITE(*,9494)'FIRE',I,J,L,IFLGQ,NLL,THETW(L,NY,NX) -9494 FORMAT(A8,5I6,12E12.4) - IF(L.EQ.0.OR.L.GE.NU(NY,NX))THEN - IF(IFLGQ.EQ.1)THEN - GO TO 2946 - ELSEIF(THETW(L,NY,NX).GT.FVLWB.OR.CORGC(L,NY,NX).LE.FORGC - 2.OR.DPTH(L,NY,NX).GT.0.15)THEN - IFLGQ=1 - ELSE - NLL=L - ENDIF - ENDIF -2945 CONTINUE - ELSE - NLL=0 - ENDIF -2946 CONTINUE - DO 2950 L=0,NLL - IF(NLL.GE.0)THEN - IF(ITILL(I,NY,NX).EQ.22)THEN - DCORPC=AMIN1(0.999,DCORP(I,NY,NX))*(CORGC(L,NY,NX)-FORGC) - 2/(AMAX1(CORGC(L,NY,NX),0.5E+06)-FORGC) - ELSE - DCORPC=AMIN1(0.999,DCORP(I,NY,NX)) - ENDIF - VOLWOU=VOLWOU+DCORPC*VOLW(L,NY,NX) - HEATOU=HEATOU+DCORPC*4.19*TKS(L,NY,NX)*VOLW(L,NY,NX) - VOLW(L,NY,NX)=VOLW(L,NY,NX)-DCORPC*VOLW(L,NY,NX) -C WRITE(*,9696)'BURN',I,J,L,NLL,CORGC(L,NY,NX) -C 2,FORGC,DCORPC,DCORP(I,NY,NX),VOLW(L,NY,NX) -9696 FORMAT(A8,4I6,12E12.4) - OSGX=ORGC(L,NY,NX) - OC=0.0 - ON=0.0 - OP=0.0 - RC=0.0 - RN=0.0 - RP=0.0 - DO 2955 K=0,4 - DO 2955 M=1,4 - ONL(M,K)=0.0 - OPL(M,K)=0.0 -2955 CONTINUE - DO 2970 K=0,5 - IF(L.NE.0.OR.(K.NE.3.AND.K.NE.4))THEN -C -C REMOVE MICROBIAL BIOMASS -C - DO 2960 N=1,7 - DO 2960 M=1,3 - OCH=DCORPC*OMC(M,N,K,L,NY,NX) - ONH=DCORPC*OMN(M,N,K,L,NY,NX) - OPH=DCORPC*OMP(M,N,K,L,NY,NX) - ONX=EFIRE(1,ITILL(I,NY,NX))*ONH - OPX=EFIRE(2,ITILL(I,NY,NX))*OPH - IF(K.LE.2)THEN - ONL(4,K)=ONL(4,K)+ONH-ONX - OPL(4,K)=OPL(4,K)+OPH-OPX - ELSEIF(K.LE.4)THEN - ONL(1,K)=ONL(1,K)+ONH-ONX - OPL(1,K)=OPL(1,K)+OPH-OPX - ELSEIF(K.EQ.5)THEN - ONL(4,1)=ONL(4,1)+ONH-ONX - OPL(4,1)=OPL(4,1)+OPH-OPX - ENDIF - OMC(M,N,K,L,NY,NX)=OMC(M,N,K,L,NY,NX)-OCH - OMN(M,N,K,L,NY,NX)=OMN(M,N,K,L,NY,NX)-ONH - OMP(M,N,K,L,NY,NX)=OMP(M,N,K,L,NY,NX)-OPH - RC=RC+OMC(M,N,K,L,NY,NX) - RN=RN+OMN(M,N,K,L,NY,NX) - RP=RP+OMP(M,N,K,L,NY,NX) - TOMT(NY,NX)=TOMT(NY,NX)+OMC(M,N,K,L,NY,NX) - TONT(NY,NX)=TONT(NY,NX)+OMN(M,N,K,L,NY,NX) - TOPT(NY,NX)=TOPT(NY,NX)+OMP(M,N,K,L,NY,NX) - OMCL(L,NY,NX)=OMCL(L,NY,NX)+OMC(M,N,K,L,NY,NX) - OMNL(L,NY,NX)=OMNL(L,NY,NX)+OMN(M,N,K,L,NY,NX) - OC=OC+OCH - ON=ON+ONX - OP=OP+OPX -2960 CONTINUE - ENDIF -2970 CONTINUE -C -C REMOVE MICROBIAL RESIDUE -C - DO 2900 K=0,4 - IF(L.NE.0.OR.(K.NE.3.AND.K.NE.4))THEN - DO 2940 M=1,2 - OCH=DCORPC*ORC(M,K,L,NY,NX) - ONH=DCORPC*ORN(M,K,L,NY,NX) - OPH=DCORPC*ORP(M,K,L,NY,NX) - ONX=EFIRE(1,ITILL(I,NY,NX))*ONH - OPX=EFIRE(2,ITILL(I,NY,NX))*OPH - IF(K.LE.2)THEN - ONL(4,K)=ONL(4,K)+ONH-ONX - OPL(4,K)=OPL(4,K)+OPH-OPX - ELSE - ONL(1,K)=ONL(1,K)+ONH-ONX - OPL(1,K)=OPL(1,K)+OPH-OPX - ENDIF - ORC(M,K,L,NY,NX)=ORC(M,K,L,NY,NX)-OCH - ORN(M,K,L,NY,NX)=ORN(M,K,L,NY,NX)-ONH - ORP(M,K,L,NY,NX)=ORP(M,K,L,NY,NX)-OPH - RC=RC+ORC(M,K,L,NY,NX) - RN=RN+ORN(M,K,L,NY,NX) - RP=RP+ORP(M,K,L,NY,NX) - OC=OC+OCH - ON=ON+ONX - OP=OP+OPX -2940 CONTINUE -C -C REMOVE DOC, DON, DOP -C - OCH=DCORPC*OQC(K,L,NY,NX) - OCA=DCORPC*OQA(K,L,NY,NX) - ONH=DCORPC*OQN(K,L,NY,NX) - OPH=DCORPC*OQP(K,L,NY,NX) - ONX=EFIRE(1,ITILL(I,NY,NX))*ONH - OPX=EFIRE(2,ITILL(I,NY,NX))*OPH - IF(K.LE.2)THEN - ONL(4,K)=ONL(4,K)+ONH-ONX - OPL(4,K)=OPL(4,K)+OPH-OPX - ELSE - ONL(1,K)=ONL(1,K)+ONH-ONX - OPL(1,K)=OPL(1,K)+OPH-OPX - ENDIF - OQC(K,L,NY,NX)=OQC(K,L,NY,NX)-OCH - OQA(K,L,NY,NX)=OQA(K,L,NY,NX)-OCA - OQN(K,L,NY,NX)=OQN(K,L,NY,NX)-ONH - OQP(K,L,NY,NX)=OQP(K,L,NY,NX)-OPH - OC=OC+OCH+OCA - ON=ON+ONX - OP=OP+OPX - OCH=DCORPC*OQCH(K,L,NY,NX) - ONH=DCORPC*OQNH(K,L,NY,NX) - OPH=DCORPC*OQPH(K,L,NY,NX) - OAH=DCORPC*OQAH(K,L,NY,NX) - ONX=EFIRE(1,ITILL(I,NY,NX))*ONH - OPX=EFIRE(2,ITILL(I,NY,NX))*OPH - IF(K.LE.2)THEN - ONL(4,K)=ONL(4,K)+ONH-ONX - OPL(4,K)=OPL(4,K)+OPH-OPX - ELSE - ONL(1,K)=ONL(1,K)+ONH-ONX - OPL(1,K)=OPL(1,K)+OPH-OPX - ENDIF - OQCH(K,L,NY,NX)=OQCH(K,L,NY,NX)-OCH - OQNH(K,L,NY,NX)=OQNH(K,L,NY,NX)-ONH - OQPH(K,L,NY,NX)=OQPH(K,L,NY,NX)-OPH - OQAH(K,L,NY,NX)=OQAH(K,L,NY,NX)-OAH - OC=OC+OCH+OAH - ON=ON+ONX - OP=OP+OPX -C -C REMOVE ADSORBED OM -C - OCH=DCORPC*OHC(K,L,NY,NX) - ONH=DCORPC*OHN(K,L,NY,NX) - OPH=DCORPC*OHP(K,L,NY,NX) - OAH=DCORPC*OHA(K,L,NY,NX) - ONX=EFIRE(1,ITILL(I,NY,NX))*ONH - OPX=EFIRE(2,ITILL(I,NY,NX))*OPH - IF(K.LE.2)THEN - ONL(4,K)=ONL(4,K)+ONH-ONX - OPL(4,K)=OPL(4,K)+OPH-OPX - ELSE - ONL(1,K)=ONL(1,K)+ONH-ONX - OPL(1,K)=OPL(1,K)+OPH-OPX - ENDIF - OHC(K,L,NY,NX)=OHC(K,L,NY,NX)-OCH - OHN(K,L,NY,NX)=OHN(K,L,NY,NX)-ONH - OHP(K,L,NY,NX)=OHP(K,L,NY,NX)-OPH - OHA(K,L,NY,NX)=OHA(K,L,NY,NX)-OAH - RC=RC+OQC(K,L,NY,NX)+OQCH(K,L,NY,NX)+OHC(K,L,NY,NX) - 2+OQA(K,L,NY,NX)+OQAH(K,L,NY,NX)+OHA(K,L,NY,NX) - RN=RN+OQN(K,L,NY,NX)+OQNH(K,L,NY,NX)+OHN(K,L,NY,NX) - RP=RP+OQP(K,L,NY,NX)+OQPH(K,L,NY,NX)+OHP(K,L,NY,NX) - OC=OC+OCH - ON=ON+ONX - OP=OP+OPX -C -C REMOVE RESIDUE -C - DO 2930 M=1,4 - OCH=DCORPC*OSC(M,K,L,NY,NX) - OCA=DCORPC*OSA(M,K,L,NY,NX) - ONH=DCORPC*OSN(M,K,L,NY,NX) - OPH=DCORPC*OSP(M,K,L,NY,NX) - ONX=EFIRE(1,ITILL(I,NY,NX))*ONH - OPX=EFIRE(2,ITILL(I,NY,NX))*OPH - ONL(M,K)=ONL(M,K)+ONH-ONX - OPL(M,K)=OPL(M,K)+OPH-OPX - OSC(M,K,L,NY,NX)=OSC(M,K,L,NY,NX)-OCH - OSA(M,K,L,NY,NX)=OSA(M,K,L,NY,NX)-OCA - OSN(M,K,L,NY,NX)=OSN(M,K,L,NY,NX)-ONH - OSP(M,K,L,NY,NX)=OSP(M,K,L,NY,NX)-OPH - RC=RC+OSC(M,K,L,NY,NX) - RN=RN+OSN(M,K,L,NY,NX) - RP=RP+OSP(M,K,L,NY,NX) - OC=OC+OCH - ON=ON+ONX - OP=OP+OPX -2930 CONTINUE - ENDIF -2900 CONTINUE -C -C ADD UNBURNED N,P TO ORG N, ORG P -C - DO 2905 K=0,4 - DO 2905 M=1,4 - OSN(M,K,L,NY,NX)=OSN(M,K,L,NY,NX)+ONL(M,K) - OSP(M,K,L,NY,NX)=OSP(M,K,L,NY,NX)+OPL(M,K) - RN=RN+ONL(M,K) - RP=RP+OPL(M,K) -2905 CONTINUE -C -C REMOVE FERTILIZER IN RESIDUE -C - IF(ITILL(I,NY,NX).EQ.21)THEN - ON=ON+DCORPC*(ZNH4S(L,NY,NX)+ZNH3S(L,NY,NX) - 2+ZNO3S(L,NY,NX)+ZNO2S(L,NY,NX)) - OP=OP+DCORPC*H2PO4(L,NY,NX) - TIONOU=TIONOU+DCORPC*(ZNH3FA(L,NY,NX)+ZNO3FA(L,NY,NX) - 2+ZNHUFA(L,NY,NX)+2.0*(XN4(L,NY,NX)+PALPO(L,NY,NX)+PFEPO(L,NY,NX) - 2+ZNH4FA(L,NY,NX))+3.0*PCAPD(L,NY,NX)+7.0*PCAPM(L,NY,NX) - 3+9.0*PCAPH(L,NY,NX)) - ZNH4S(L,NY,NX)=(1.0-DCORPC)*ZNH4S(L,NY,NX) - ZNH3S(L,NY,NX)=(1.0-DCORPC)*ZNH3S(L,NY,NX) - ZNO3S(L,NY,NX)=(1.0-DCORPC)*ZNO3S(L,NY,NX) - ZNO2S(L,NY,NX)=(1.0-DCORPC)*ZNO2S(L,NY,NX) - H2PO4(L,NY,NX)=(1.0-DCORPC)*H2PO4(L,NY,NX) - XN4(L,NY,NX)=(1.0-DCORPC)*XN4(L,NY,NX) - PALPO(L,NY,NX)=(1.0-DCORPC)*PALPO(L,NY,NX) - PFEPO(L,NY,NX)=(1.0-DCORPC)*PFEPO(L,NY,NX) - PCAPD(L,NY,NX)=(1.0-DCORPC)*PCAPD(L,NY,NX) - PCAPH(L,NY,NX)=(1.0-DCORPC)*PCAPH(L,NY,NX) - PCAPM(L,NY,NX)=(1.0-DCORPC)*PCAPM(L,NY,NX) - ZNH4FA(L,NY,NX)=(1.0-DCORPC)*ZNH4FA(L,NY,NX) - ZNH3FA(L,NY,NX)=(1.0-DCORPC)*ZNH3FA(L,NY,NX) - ZNHUFA(L,NY,NX)=(1.0-DCORPC)*ZNHUFA(L,NY,NX) - ZNO3FA(L,NY,NX)=(1.0-DCORPC)*ZNO3FA(L,NY,NX) - ENDIF - ORGC(L,NY,NX)=RC - ORGN(L,NY,NX)=RN - HFLXD=4.19E-06*(OSGX-ORGC(L,NY,NX))*TKS(L,NY,NX) - HEATOU=HEATOU+HFLXD - IF(L.EQ.0)THEN - VHCPR(NY,NX)=2.496E-06*ORGC(0,NY,NX)+4.19*VOLW(0,NY,NX) - 2+1.9274*VOLI(0,NY,NX) - ELSE - VHCP(L,NY,NX)=VHCM(L,NY,NX)+4.19*(VOLW(L,NY,NX)+VOLWH(L,NY,NX)) - 2+1.9274*(VOLI(L,NY,NX)+VOLIH(L,NY,NX)) - ENDIF - IF(ITILL(I,NY,NX).EQ.21)THEN - TCOU=TCOU+OC - TZOU=TZOU+ON - TPOU=TPOU+OP - UDOCQ(NY,NX)=UDOCQ(NY,NX)+OC - UDONQ(NY,NX)=UDONQ(NY,NX)+ON - UDOPQ(NY,NX)=UDOPQ(NY,NX)+OP - TNBP(NY,NX)=TNBP(NY,NX)-OC - ELSEIF(ITILL(I,NY,NX).EQ.22)THEN - CO2GIN=CO2GIN-OC - OXYGIN=OXYGIN+2.667*OC - OXYGOU=OXYGOU+2.667*OC - TZOU=TZOU+ON - TPOU=TPOU+OP - UCO2F(NY,NX)=UCO2F(NY,NX)-(1.0-FCH4F)*OC - UCH4F(NY,NX)=UCH4F(NY,NX)-FCH4F*OC - UOXYF(NY,NX)=UOXYF(NY,NX)+(1.0-FCH4F)*2.667*OC - UNH3F(NY,NX)=UNH3F(NY,NX)-ON - UN2OF(NY,NX)=UN2OF(NY,NX)-0.0 - UPO4F(NY,NX)=UPO4F(NY,NX)-OP - TNBP(NY,NX)=TNBP(NY,NX)-OC - ENDIF - ENDIF -2950 CONTINUE -C IFLGS(NY,NX)=1 - ENDIF -C -C CHANGE EXTERNAL WATER TABLE DEPTH THROUGH DISTURBANCE -C - IF(J.EQ.INT(ZNOON(NY,NX)).AND.ITILL(I,NY,NX).EQ.23)THEN - DTBLI(NY,NX)=DCORP(I,NY,NX) - IF(BKDS(NU(NY,NX),NY,NX).GT.0.0)THEN - DTBLZ(NY,NX)=AMAX1(0.0,DTBLI(NY,NX)-(ALTZ(NY,NX)-ALT(NY,NX)) - 2*(1.0-DTBLG(NY,NX))) - ELSE - DTBLZ(NY,NX)=0.0 - ENDIF - DTBLX(NY,NX)=DTBLZ(NY,NX) - ENDIF - IF(J.EQ.INT(ZNOON(NY,NX)).AND.ITILL(I,NY,NX).EQ.24)THEN - DDRGI(NY,NX)=DCORP(I,NY,NX) - IF(BKDS(NU(NY,NX),NY,NX).GT.0.0)THEN - DDRG(NY,NX)=AMAX1(0.0,DDRGI(NY,NX)-(ALTZ(NY,NX)-ALT(NY,NX)) - 2*(1.0-DTBLG(NY,NX))) - ELSE - DDRG(NY,NX)=0.0 - ENDIF - DTBLX(NY,NX)=DDRG(NY,NX) - ENDIF -C -C MIX ALL SOIL STATE VARIABLES AND INCORPORATE ALL SURFACE -C RESIDUE STATE VARIABLES WITHIN THE TILLAGE ZONE TO THE EXTENT -C ASSOCIATED IN 'DAY' WITH EACH TILLAGE EVENT ENTERED IN THE -C TILLAGE FILE -C - IF(J.EQ.INT(ZNOON(NY,NX)).AND.XCORP(NY,NX).LT.1.0 - 2.AND.DCORP(I,NY,NX).GT.0.0)THEN -C -C EXTENT OF MIXING -C - CORP=1.0-XCORP(NY,NX) -C -C TEMPORARY ACCUMULATORS -C - TBKDS=0.0 - TFC=0.0 - TWP=0.0 - TSCNV=0.0 - TSCNH=0.0 - TSAND=0.0 - TSILT=0.0 - TCLAY=0.0 - TXCEC=0.0 - TXAEC=0.0 - TGKC4=0.0 - TGKCA=0.0 - TGKCM=0.0 - TGKCN=0.0 - TGKCK=0.0 - TVOLW=0.0 - TVOLI=0.0 - TVOLP=0.0 - TVOLA=0.0 - TENGY=0.0 - TVHCM=0.0 - TNFNIH=0.0 - TNH4FA=0.0 - TNH3FA=0.0 - TNHUFA=0.0 - TNO3FA=0.0 - TNH4FB=0.0 - TNH3FB=0.0 - TNHUFB=0.0 - TNO3FB=0.0 - TNH4S=0.0 - TNH4B=0.0 - TNH3S=0.0 - TNH3B=0.0 - TNO3S=0.0 - TNO3B=0.0 - TNO2S=0.0 - TNO2B=0.0 - TZAL=0.0 - TZFE=0.0 - TZHY=0.0 - TZCA=0.0 - TZMG=0.0 - TZNA=0.0 - TZKA=0.0 - TZOH=0.0 - TZSO4=0.0 - TZCL=0.0 - TZCO3=0.0 - TZHCO3=0.0 - TZALO1=0.0 - TZALO2=0.0 - TZALO3=0.0 - TZALO4=0.0 - TZALS=0.0 - TZFEO1=0.0 - TZFEO2=0.0 - TZFEO3=0.0 - TZFEO4=0.0 - TZFES=0.0 - TZCAO=0.0 - TZCAC=0.0 - TZCAH=0.0 - TZCAS=0.0 - TZMGO=0.0 - TZMGC=0.0 - TZMGH=0.0 - TZMGS=0.0 - TZNAC=0.0 - TZNAS=0.0 - TZKAS=0.0 - TH0PO4=0.0 - TH1PO4=0.0 - TH2PO4=0.0 - TH3PO4=0.0 - TZFE1P=0.0 - TZFE2P=0.0 - TZCA0P=0.0 - TZCA1P=0.0 - TZCA2P=0.0 - TZMG1P=0.0 - TH0POB=0.0 - TH1POB=0.0 - TH2POB=0.0 - TH3POB=0.0 - TFE1PB=0.0 - TFE2PB=0.0 - TCA0PB=0.0 - TCA1PB=0.0 - TCA2PB=0.0 - TMG1PB=0.0 - TXNH4=0.0 - TXNHB=0.0 - TXHY=0.0 - TXAL=0.0 - TXCA=0.0 - TXMG=0.0 - TXNA=0.0 - TXKA=0.0 - TXHC=0.0 - TXAL2=0.0 - TXOH0=0.0 - TXOH1=0.0 - TXOH2=0.0 - TXH1P=0.0 - TXH2P=0.0 - TXOH0B=0.0 - TXOH1B=0.0 - TXOH2B=0.0 - TXH1PB=0.0 - TXH2PB=0.0 - TPALOH=0.0 - TPFEOH=0.0 - TPCACO=0.0 - TPCASO=0.0 - TPALPO=0.0 - TPFEPO=0.0 - TPCAPD=0.0 - TPCAPH=0.0 - TPCAPM=0.0 - TPALPB=0.0 - TPFEPB=0.0 - TPCPDB=0.0 - TPCPHB=0.0 - TPCPMB=0.0 - TCO2G=0.0 - TCH4G=0.0 - TCOZS=0.0 - TCHFS=0.0 - TOXYG=0.0 - TOXYS=0.0 - TZ2GG=0.0 - TZ2GS=0.0 - TZ2OG=0.0 - TZ2OS=0.0 - 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 - TOMC(M,N,K)=0.0 - TOMN(M,N,K)=0.0 - TOMP(M,N,K)=0.0 -3990 CONTINUE - DO 3980 K=0,4 - DO 3975 M=1,2 - TORC(M,K)=0.0 - TORN(M,K)=0.0 - TORP(M,K)=0.0 -3975 CONTINUE - TOQC(K)=0.0 - TOQN(K)=0.0 - TOQP(K)=0.0 - TOQA(K)=0.0 - TOHC(K)=0.0 - TOHN(K)=0.0 - TOHP(K)=0.0 - TOHA(K)=0.0 - DO 3970 M=1,4 - TOSC(M,K)=0.0 - TOSA(M,K)=0.0 - TOSN(M,K)=0.0 - TOSP(M,K)=0.0 -3970 CONTINUE -3980 CONTINUE -C -C ACCUMULATE STATE VARIABLES IN SURFACE RESIDUE FOR ADDITION -C TO SOIL IN TILLAGE MIXING ZONE -C - RC=0.0 - RN=0.0 - RP=0.0 - DO 3950 K=0,5 - IF(K.NE.3.AND.K.NE.4)THEN - DO 3945 N=1,7 - DO 3945 M=1,3 - TOMGC(M,N,K)=OMC(M,N,K,0,NY,NX)*CORP - TOMGN(M,N,K)=OMN(M,N,K,0,NY,NX)*CORP - TOMGP(M,N,K)=OMP(M,N,K,0,NY,NX)*CORP - OMC(M,N,K,0,NY,NX)=OMC(M,N,K,0,NY,NX)*XCORP(NY,NX) - OMN(M,N,K,0,NY,NX)=OMN(M,N,K,0,NY,NX)*XCORP(NY,NX) - OMP(M,N,K,0,NY,NX)=OMP(M,N,K,0,NY,NX)*XCORP(NY,NX) - RC=RC+OMC(M,N,K,0,NY,NX) - RN=RN+OMN(M,N,K,0,NY,NX) - RP=RP+OMP(M,N,K,0,NY,NX) -3945 CONTINUE - ENDIF -3950 CONTINUE - DO 3940 K=0,2 - DO 3935 M=1,2 - TORXC(M,K)=ORC(M,K,0,NY,NX)*CORP - TORXN(M,K)=ORN(M,K,0,NY,NX)*CORP - TORXP(M,K)=ORP(M,K,0,NY,NX)*CORP - ORC(M,K,0,NY,NX)=ORC(M,K,0,NY,NX)*XCORP(NY,NX) - ORN(M,K,0,NY,NX)=ORN(M,K,0,NY,NX)*XCORP(NY,NX) - ORP(M,K,0,NY,NX)=ORP(M,K,0,NY,NX)*XCORP(NY,NX) - RC=RC+ORC(M,K,0,NY,NX) - RN=RN+ORN(M,K,0,NY,NX) - RP=RP+ORP(M,K,0,NY,NX) -3935 CONTINUE - TOQGC(K)=OQC(K,0,NY,NX)*CORP - TOQGN(K)=OQN(K,0,NY,NX)*CORP - TOQGP(K)=OQP(K,0,NY,NX)*CORP - TOQGA(K)=OQA(K,0,NY,NX)*CORP - TOQHC(K)=OQCH(K,0,NY,NX)*CORP - TOQHN(K)=OQNH(K,0,NY,NX)*CORP - TOQHP(K)=OQPH(K,0,NY,NX)*CORP - TOQHA(K)=OQAH(K,0,NY,NX)*CORP - TOHGC(K)=OHC(K,0,NY,NX)*CORP - TOHGN(K)=OHN(K,0,NY,NX)*CORP - TOHGP(K)=OHP(K,0,NY,NX)*CORP - TOHGA(K)=OHA(K,0,NY,NX)*CORP -C -C REDUCE SURFACE RESIDUE STATE VARIABLES FOR INCORPORATION -C - OQC(K,0,NY,NX)=OQC(K,0,NY,NX)*XCORP(NY,NX) - OQN(K,0,NY,NX)=OQN(K,0,NY,NX)*XCORP(NY,NX) - OQP(K,0,NY,NX)=OQP(K,0,NY,NX)*XCORP(NY,NX) - OQA(K,0,NY,NX)=OQA(K,0,NY,NX)*XCORP(NY,NX) - OQCH(K,0,NY,NX)=OQCH(K,0,NY,NX)*XCORP(NY,NX) - OQNH(K,0,NY,NX)=OQNH(K,0,NY,NX)*XCORP(NY,NX) - OQPH(K,0,NY,NX)=OQPH(K,0,NY,NX)*XCORP(NY,NX) - OQAH(K,0,NY,NX)=OQAH(K,0,NY,NX)*XCORP(NY,NX) - OHC(K,0,NY,NX)=OHC(K,0,NY,NX)*XCORP(NY,NX) - OHN(K,0,NY,NX)=OHN(K,0,NY,NX)*XCORP(NY,NX) - OHP(K,0,NY,NX)=OHP(K,0,NY,NX)*XCORP(NY,NX) - OHA(K,0,NY,NX)=OHA(K,0,NY,NX)*XCORP(NY,NX) - RC=RC+OQC(K,0,NY,NX)+OQCH(K,0,NY,NX)+OHC(K,0,NY,NX)+OQA(K,0,NY,NX) - 2+OQAH(K,0,NY,NX)+OHA(K,0,NY,NX) - RN=RN+OQN(K,0,NY,NX)+OQNH(K,0,NY,NX)+OHN(K,0,NY,NX) - RP=RP+OQP(K,0,NY,NX)+OQPH(K,0,NY,NX)+OHP(K,0,NY,NX) - DO 3965 M=1,4 - TOSGC(M,K)=OSC(M,K,0,NY,NX)*CORP - TOSGA(M,K)=OSA(M,K,0,NY,NX)*CORP - TOSGN(M,K)=OSN(M,K,0,NY,NX)*CORP - TOSGP(M,K)=OSP(M,K,0,NY,NX)*CORP - OSC(M,K,0,NY,NX)=OSC(M,K,0,NY,NX)*XCORP(NY,NX) - OSA(M,K,0,NY,NX)=OSA(M,K,0,NY,NX)*XCORP(NY,NX) - OSN(M,K,0,NY,NX)=OSN(M,K,0,NY,NX)*XCORP(NY,NX) - OSP(M,K,0,NY,NX)=OSP(M,K,0,NY,NX)*XCORP(NY,NX) - RC=RC+OSC(M,K,0,NY,NX) - RN=RN+OSN(M,K,0,NY,NX) - RP=RP+OSP(M,K,0,NY,NX) -3965 CONTINUE -3940 CONTINUE - TCO2GS=CO2S(0,NY,NX)*CORP - TCH4GS=CH4S(0,NY,NX)*CORP - TOXYGS=OXYS(0,NY,NX)*CORP - TZ2GSG=Z2GS(0,NY,NX)*CORP - TZ2OGS=Z2OS(0,NY,NX)*CORP - TH2GGS=H2GS(0,NY,NX)*CORP - TNH4GS=ZNH4S(0,NY,NX)*CORP - TNH3GS=ZNH3S(0,NY,NX)*CORP - TNO3GS=ZNO3S(0,NY,NX)*CORP - TNO2GS=ZNO2S(0,NY,NX)*CORP - TPO4GS=H2PO4(0,NY,NX)*CORP - TXN4G=XN4(0,NY,NX)*CORP - TXOH0G=XOH0(0,NY,NX)*CORP - TXOH1G=XOH1(0,NY,NX)*CORP - TXOH2G=XOH2(0,NY,NX)*CORP - TXH1PG=XH1P(0,NY,NX)*CORP - TXH2PG=XH2P(0,NY,NX)*CORP - TALPOG=PALPO(0,NY,NX)*CORP - TFEPOG=PFEPO(0,NY,NX)*CORP - TCAPDG=PCAPD(0,NY,NX)*CORP - TCAPHG=PCAPH(0,NY,NX)*CORP - TCAPMG=PCAPM(0,NY,NX)*CORP - TNH4FG=ZNH4FA(0,NY,NX)*CORP - TNH3FG=ZNH3FA(0,NY,NX)*CORP - TNHUFG=ZNHUFA(0,NY,NX)*CORP - TNO3FG=ZNO3FA(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) - HEATIN=HEATIN-HFLXD - HEATSO=HEATSO-HFLXD - TENGYR=(4.19*TVOLWR+1.9274*TVOLIR)*TKS(0,NY,NX) - ORGC(0,NY,NX)=RC - ORGN(0,NY,NX)=RN - ORGR(0,NY,NX)=RC - CO2S(0,NY,NX)=CO2S(0,NY,NX)*XCORP(NY,NX) - CH4S(0,NY,NX)=CH4S(0,NY,NX)*XCORP(NY,NX) - OXYS(0,NY,NX)=OXYS(0,NY,NX)*XCORP(NY,NX) - Z2GS(0,NY,NX)=Z2GS(0,NY,NX)*XCORP(NY,NX) - Z2OS(0,NY,NX)=Z2OS(0,NY,NX)*XCORP(NY,NX) - H2GS(0,NY,NX)=H2GS(0,NY,NX)*XCORP(NY,NX) - ZNH4S(0,NY,NX)=ZNH4S(0,NY,NX)*XCORP(NY,NX) - ZNH3S(0,NY,NX)=ZNH3S(0,NY,NX)*XCORP(NY,NX) - ZNO3S(0,NY,NX)=ZNO3S(0,NY,NX)*XCORP(NY,NX) - ZNO2S(0,NY,NX)=ZNO2S(0,NY,NX)*XCORP(NY,NX) - H2PO4(0,NY,NX)=H2PO4(0,NY,NX)*XCORP(NY,NX) - XN4(0,NY,NX)=XN4(0,NY,NX)*XCORP(NY,NX) - XOH0(0,NY,NX)=XOH0(0,NY,NX)*XCORP(NY,NX) - XOH1(0,NY,NX)=XOH1(0,NY,NX)*XCORP(NY,NX) - XOH2(0,NY,NX)=XOH2(0,NY,NX)*XCORP(NY,NX) - XH1P(0,NY,NX)=XH1P(0,NY,NX)*XCORP(NY,NX) - XH2P(0,NY,NX)=XH2P(0,NY,NX)*XCORP(NY,NX) - PALPO(0,NY,NX)=PALPO(0,NY,NX)*XCORP(NY,NX) - PFEPO(0,NY,NX)=PFEPO(0,NY,NX)*XCORP(NY,NX) - PCAPD(0,NY,NX)=PCAPD(0,NY,NX)*XCORP(NY,NX) - PCAPH(0,NY,NX)=PCAPH(0,NY,NX)*XCORP(NY,NX) - PCAPM(0,NY,NX)=PCAPM(0,NY,NX)*XCORP(NY,NX) - ZNH4FA(0,NY,NX)=ZNH4FA(0,NY,NX)*XCORP(NY,NX) - ZNH3FA(0,NY,NX)=ZNH3FA(0,NY,NX)*XCORP(NY,NX) - ZNHUFA(0,NY,NX)=ZNHUFA(0,NY,NX)*XCORP(NY,NX) - ZNO3FA(0,NY,NX)=ZNO3FA(0,NY,NX)*XCORP(NY,NX) - VOLW(0,NY,NX)=VOLW(0,NY,NX)*XCORP(NY,NX) - VOLI(0,NY,NX)=VOLI(0,NY,NX)*XCORP(NY,NX) - 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)) - ZNFNX0=AMAX1(ZNFNX0,ZNFN0(0,NY,NX)) - LL=NU(NY,NX) -C -C REDISTRIBUTE SOIL STATE VARIABLES DURING TILLAGE -C - DCORPZ=AMIN1(DCORP(I,NY,NX),CDPTH(NL(NY,NX),NY,NX)) - DCORPX=DCORPZ+(CDPTH(NU(NY,NX),NY,NX)-DLYR(3,NU(NY,NX),NY,NX)) -C -C ACCUMULATE SOIL STATE VARIABLES WITHIN TILLAGE MIXING ZONE -C - DO 1000 L=NU(NY,NX),NL(NY,NX) - IF(CDPTH(L,NY,NX)-DLYR(3,L,NY,NX).LT.DCORPX)THEN - TL=AMIN1(DLYR(3,L,NY,NX),DCORPX-(CDPTH(L,NY,NX) - 2-DLYR(3,L,NY,NX))) - FI=TL/DCORPZ - TI=TL/DLYR(3,L,NY,NX) - TBKDS=TBKDS+FI*BKDS(L,NY,NX) - TFC=TFC+FI*FC(L,NY,NX) - TWP=TWP+FI*WP(L,NY,NX) - TSCNV=TSCNV+FI*SCNV(L,NY,NX) - TSCNH=TSCNH+FI*SCNH(L,NY,NX) - TSAND=TSAND+TI*SAND(L,NY,NX) - TSILT=TSILT+TI*SILT(L,NY,NX) - TCLAY=TCLAY+TI*CLAY(L,NY,NX) - TXCEC=TXCEC+TI*XCEC(L,NY,NX) - TXAEC=TXAEC+TI*XAEC(L,NY,NX) - TGKC4=TGKC4+FI*GKC4(L,NY,NX) - TGKCA=TGKCA+FI*GKCA(L,NY,NX) - TGKCM=TGKCM+FI*GKCM(L,NY,NX) - TGKCN=TGKCN+FI*GKCN(L,NY,NX) - TGKCK=TGKCK+FI*GKCK(L,NY,NX) - TVOLW=TVOLW+TI*VOLW(L,NY,NX) - TVOLI=TVOLI+TI*VOLI(L,NY,NX) - TVOLP=TVOLP+TI*VOLP(L,NY,NX) - TVOLA=TVOLA+TI*VOLA(L,NY,NX) - TENGY=TENGY+TI*(4.19*(VOLW(L,NY,NX)+VOLWH(L,NY,NX)) - 2+1.9274*(VOLI(L,NY,NX)+VOLIH(L,NY,NX)))*TKS(L,NY,NX) - TNH4FA=TNH4FA+TI*ZNH4FA(L,NY,NX) - TNH3FA=TNH3FA+TI*ZNH3FA(L,NY,NX) - TNHUFA=TNHUFA+TI*ZNHUFA(L,NY,NX) - TNO3FA=TNO3FA+TI*ZNO3FA(L,NY,NX) - TNH4FB=TNH4FB+TI*ZNH4FB(L,NY,NX) - TNH3FB=TNH3FB+TI*ZNH3FB(L,NY,NX) - TNHUFB=TNHUFB+TI*ZNHUFB(L,NY,NX) - TNO3FB=TNO3FB+TI*ZNO3FB(L,NY,NX) - TNH4S=TNH4S+TI*ZNH4S(L,NY,NX) - TNH4B=TNH4B+TI*ZNH4B(L,NY,NX) - TNH3S=TNH3S+TI*ZNH3S(L,NY,NX) - TNH3B=TNH3B+TI*ZNH3B(L,NY,NX) - TNO3S=TNO3S+TI*ZNO3S(L,NY,NX) - TNO3B=TNO3B+TI*ZNO3B(L,NY,NX) - TNO2S=TNO2S+TI*ZNO2S(L,NY,NX) - TNO2B=TNO2B+TI*ZNO2B(L,NY,NX) - TZAL=TZAL+TI*ZAL(L,NY,NX) - TZFE=TZFE+TI*ZFE(L,NY,NX) - TZHY=TZHY+TI*ZHY(L,NY,NX) - TZCA=TZCA+TI*ZCA(L,NY,NX) - TZMG=TZMG+TI*ZMG(L,NY,NX) - TZNA=TZNA+TI*ZNA(L,NY,NX) - TZKA=TZKA+TI*ZKA(L,NY,NX) - TZOH=TZOH+TI*ZOH(L,NY,NX) - TZSO4=TZSO4+TI*ZSO4(L,NY,NX) - TZCL=TZCL+TI*ZCL(L,NY,NX) - TZCO3=TZCO3+TI*ZCO3(L,NY,NX) - TZHCO3=TZHCO3+TI*ZHCO3(L,NY,NX) - TZALO1=TZALO1+TI*ZALOH1(L,NY,NX) - TZALO2=TZALO2+TI*ZALOH2(L,NY,NX) - TZALO3=TZALO3+TI*ZALOH3(L,NY,NX) - TZALO4=TZALO4+TI*ZALOH4(L,NY,NX) - TZALS=TZALS+TI*ZALS(L,NY,NX) - TZFEO1=TZFEO1+TI*ZFEOH1(L,NY,NX) - TZFEO2=TZFEO2+TI*ZFEOH2(L,NY,NX) - TZFEO3=TZFEO3+TI*ZFEOH3(L,NY,NX) - TZFEO4=TZFEO4+TI*ZFEOH4(L,NY,NX) - TZFES=TZFES+TI*ZFES(L,NY,NX) - TZCAO=TZCAO+TI*ZCAO(L,NY,NX) - TZCAC=TZCAC+TI*ZCAC(L,NY,NX) - TZCAH=TZCAH+TI*ZCAH(L,NY,NX) - TZCAS=TZCAS+TI*ZCAS(L,NY,NX) - TZMGO=TZMGO+TI*ZMGO(L,NY,NX) - TZMGC=TZMGC+TI*ZMGC(L,NY,NX) - TZMGH=TZMGH+TI*ZMGH(L,NY,NX) - TZMGS=TZMGS+TI*ZMGS(L,NY,NX) - TZNAC=TZNAC+TI*ZNAC(L,NY,NX) - TZNAS=TZNAS+TI*ZNAS(L,NY,NX) - TZKAS=TZKAS+TI*ZKAS(L,NY,NX) - TH0PO4=TH0PO4+TI*H0PO4(L,NY,NX) - TH1PO4=TH1PO4+TI*H1PO4(L,NY,NX) - TH2PO4=TH2PO4+TI*H2PO4(L,NY,NX) - TH3PO4=TH3PO4+TI*H3PO4(L,NY,NX) - TZFE1P=TZFE1P+TI*ZFE1P(L,NY,NX) - TZFE2P=TZFE2P+TI*ZFE2P(L,NY,NX) - TZCA0P=TZCA0P+TI*ZCA0P(L,NY,NX) - TZCA1P=TZCA1P+TI*ZCA1P(L,NY,NX) - TZCA2P=TZCA2P+TI*ZCA2P(L,NY,NX) - TZMG1P=TZMG1P+TI*ZMG1P(L,NY,NX) - TH0POB=TH0POB+TI*H0POB(L,NY,NX) - TH1POB=TH1POB+TI*H1POB(L,NY,NX) - TH2POB=TH2POB+TI*H2POB(L,NY,NX) - TH3POB=TH3POB+TI*H3POB(L,NY,NX) - TFE1PB=TFE1PB+TI*ZFE1PB(L,NY,NX) - TFE2PB=TFE2PB+TI*ZFE2PB(L,NY,NX) - TCA0PB=TCA0PB+TI*ZCA0PB(L,NY,NX) - TCA1PB=TCA1PB+TI*ZCA1PB(L,NY,NX) - TCA2PB=TCA2PB+TI*ZCA2PB(L,NY,NX) - TMG1PB=TMG1PB+TI*ZMG1PB(L,NY,NX) - TXNH4=TXNH4+TI*XN4(L,NY,NX) - TXNHB=TXNHB+TI*XNB(L,NY,NX) - TXHY=TXHY+TI*XHY(L,NY,NX) - TXAL=TXAL+TI*XAL(L,NY,NX) - TXCA=TXCA+TI*XCA(L,NY,NX) - TXMG=TXMG+TI*XMG(L,NY,NX) - TXNA=TXNA+TI*XNA(L,NY,NX) - TXKA=TXKA+TI*XKA(L,NY,NX) - TXHC=TXHC+TI*XHC(L,NY,NX) - TXAL2=TXAL2+TI*XALO2(L,NY,NX) - TXOH0=TXOH0+TI*XOH0(L,NY,NX) - TXOH1=TXOH1+TI*XOH1(L,NY,NX) - TXOH2=TXOH2+TI*XOH2(L,NY,NX) - TXH1P=TXH1P+TI*XH1P(L,NY,NX) - TXH2P=TXH2P+TI*XH2P(L,NY,NX) - TXOH0B=TXOH0B+TI*XOH0B(L,NY,NX) - TXOH1B=TXOH1B+TI*XOH1B(L,NY,NX) - TXOH2B=TXOH2B+TI*XOH2B(L,NY,NX) - TXH1PB=TXH1PB+TI*XH1PB(L,NY,NX) - TXH2PB=TXH2PB+TI*XH2PB(L,NY,NX) - TPALOH=TPALOH+TI*PALOH(L,NY,NX) - TPFEOH=TPFEOH+TI*PFEOH(L,NY,NX) - TPCACO=TPCACO+TI*PCACO(L,NY,NX) - TPCASO=TPCASO+TI*PCASO(L,NY,NX) - TPALPO=TPALPO+TI*PALPO(L,NY,NX) - TPFEPO=TPFEPO+TI*PFEPO(L,NY,NX) - TPCAPD=TPCAPD+TI*PCAPD(L,NY,NX) - TPCAPH=TPCAPH+TI*PCAPH(L,NY,NX) - TPCAPM=TPCAPM+TI*PCAPM(L,NY,NX) - TPALPB=TPALPB+TI*PALPB(L,NY,NX) - TPFEPB=TPFEPB+TI*PFEPB(L,NY,NX) - TPCPDB=TPCPDB+TI*PCPDB(L,NY,NX) - TPCPHB=TPCPHB+TI*PCPHB(L,NY,NX) - TPCPMB=TPCPMB+TI*PCPMB(L,NY,NX) - TCO2G=TCO2G+TI*CO2G(L,NY,NX) - TCH4G=TCH4G+TI*CH4G(L,NY,NX) - TCOZS=TCOZS+TI*CO2S(L,NY,NX) - TCHFS=TCHFS+TI*CH4S(L,NY,NX) - TOXYG=TOXYG+TI*OXYG(L,NY,NX) - TOXYS=TOXYS+TI*OXYS(L,NY,NX) - TZ2GG=TZ2GG+TI*Z2GG(L,NY,NX) - TZ2GS=TZ2GS+TI*Z2GS(L,NY,NX) - TZ2OG=TZ2OG+TI*Z2OG(L,NY,NX) - TZ2OS=TZ2OS+TI*Z2OS(L,NY,NX) - TZNH3G=TZNH3G+TI*ZNH3G(L,NY,NX) - TH2GG=TH2GG+TI*H2GG(L,NY,NX) - TH2GS=TH2GS+TI*H2GS(L,NY,NX) - DO 4985 K=0,5 - DO 4985 N=1,7 - DO 4985 M=1,3 - TOMC(M,N,K)=TOMC(M,N,K)+TI*OMC(M,N,K,L,NY,NX) - TOMN(M,N,K)=TOMN(M,N,K)+TI*OMN(M,N,K,L,NY,NX) - TOMP(M,N,K)=TOMP(M,N,K)+TI*OMP(M,N,K,L,NY,NX) -4985 CONTINUE - DO 4980 K=0,4 - DO 4975 M=1,2 - TORC(M,K)=TORC(M,K)+TI*ORC(M,K,L,NY,NX) - TORN(M,K)=TORN(M,K)+TI*ORN(M,K,L,NY,NX) - TORP(M,K)=TORP(M,K)+TI*ORP(M,K,L,NY,NX) -4975 CONTINUE - TOQC(K)=TOQC(K)+TI*OQC(K,L,NY,NX) - TOQN(K)=TOQN(K)+TI*OQN(K,L,NY,NX) - TOQP(K)=TOQP(K)+TI*OQP(K,L,NY,NX) - TOQA(K)=TOQA(K)+TI*OQA(K,L,NY,NX) - TOHC(K)=TOHC(K)+TI*OHC(K,L,NY,NX) - TOHN(K)=TOHN(K)+TI*OHN(K,L,NY,NX) - TOHP(K)=TOHP(K)+TI*OHP(K,L,NY,NX) - TOHA(K)=TOHA(K)+TI*OHA(K,L,NY,NX) - DO 4970 M=1,4 - TOSC(M,K)=TOSC(M,K)+TI*OSC(M,K,L,NY,NX) - TOSA(M,K)=TOSA(M,K)+TI*OSA(M,K,L,NY,NX) - TOSN(M,K)=TOSN(M,K)+TI*OSN(M,K,L,NY,NX) - 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)) - ZNFNX0=AMAX1(ZNFNX0,ZNFN0(L,NY,NX)) - LL=L - ENDIF -1000 CONTINUE -C -C CHANGE SOIL STATE VARIABLES IN TILLAGE MIXING ZONE -C TO ACCOUNT FOR REDISTRIBUTION FROM MIXING -C - HEATSR=VHCPW(NY,NX)*TKW(NY,NX)+VHCPR(NY,NX)*TKS(0,NY,NX) - DO 2000 L=NU(NY,NX),LL - TL=AMIN1(DLYR(3,L,NY,NX),DCORPX-(CDPTH(L,NY,NX) - 2-DLYR(3,L,NY,NX))) - FI=TL/DCORPZ - TI=TL/DLYR(3,L,NY,NX) - TX=1.0-TI - BKDS(L,NY,NX)=TI*(BKDS(L,NY,NX)+CORP*(TBKDS-BKDS(L,NY,NX))) - 2+TX*BKDS(L,NY,NX) - FC(L,NY,NX)=TI*(FC(L,NY,NX)+CORP*(TFC-FC(L,NY,NX))) - 2+TX*FC(L,NY,NX) - WP(L,NY,NX)=TI*(WP(L,NY,NX)+CORP*(TWP-WP(L,NY,NX))) - 2+TX*WP(L,NY,NX) - SCNV(L,NY,NX)=TI*(SCNV(L,NY,NX)+CORP*(TSCNV-SCNV(L,NY,NX))) - 2+TX*SCNV(L,NY,NX) - SCNH(L,NY,NX)=TI*(SCNH(L,NY,NX)+CORP*(TSCNH-SCNH(L,NY,NX))) - 2+TX*SCNH(L,NY,NX) - SAND(L,NY,NX)=TI*SAND(L,NY,NX)+CORP*(FI*TSAND-TI*SAND(L,NY,NX)) - 2+TX*SAND(L,NY,NX) - SILT(L,NY,NX)=TI*SILT(L,NY,NX)+CORP*(FI*TSILT-TI*SILT(L,NY,NX)) - 2+TX*SILT(L,NY,NX) - CLAY(L,NY,NX)=TI*CLAY(L,NY,NX)+CORP*(FI*TCLAY-TI*CLAY(L,NY,NX)) - 2+TX*CLAY(L,NY,NX) - XCEC(L,NY,NX)=TI*XCEC(L,NY,NX)+CORP*(FI*TXCEC-TI*XCEC(L,NY,NX)) - 2+TX*XCEC(L,NY,NX) - XAEC(L,NY,NX)=TI*XAEC(L,NY,NX)+CORP*(FI*TXAEC-TI*XAEC(L,NY,NX)) - 2+TX*XAEC(L,NY,NX) - GKC4(L,NY,NX)=TI*(GKC4(L,NY,NX)+CORP*(TGKC4-GKC4(L,NY,NX))) - 2+TX*GKC4(L,NY,NX) - GKCA(L,NY,NX)=TI*(GKCA(L,NY,NX)+CORP*(TGKCA-GKCA(L,NY,NX))) - 2+TX*GKCA(L,NY,NX) - GKCM(L,NY,NX)=TI*(GKCM(L,NY,NX)+CORP*(TGKCM-GKCM(L,NY,NX))) - 2+TX*GKCM(L,NY,NX) - GKCN(L,NY,NX)=TI*(GKCN(L,NY,NX)+CORP*(TGKCN-GKCN(L,NY,NX))) - 2+TX*GKCN(L,NY,NX) - GKCK(L,NY,NX)=TI*(GKCK(L,NY,NX)+CORP*(TGKCK-GKCK(L,NY,NX))) - 2+TX*GKCK(L,NY,NX) - ENGYM=VHCM(L,NY,NX)*TKS(L,NY,NX) - ENGYW=(4.19*(VOLW(L,NY,NX)+VOLWH(L,NY,NX)) - 2+1.9274*(VOLI(L,NY,NX)+VOLIH(L,NY,NX)))*TKS(L,NY,NX) - VOLW(L,NY,NX)=TI*VOLW(L,NY,NX)+CORP*(FI*TVOLW-TI*VOLW(L,NY,NX)) - 2+TX*VOLW(L,NY,NX)+FI*TVOLWR - VOLI(L,NY,NX)=TI*VOLI(L,NY,NX)+CORP*(FI*TVOLI-TI*VOLI(L,NY,NX)) - 2+TX*VOLI(L,NY,NX)+FI*TVOLIR - VOLP(L,NY,NX)=TI*VOLP(L,NY,NX)+CORP*(FI*TVOLP-TI*VOLP(L,NY,NX)) - 2+TX*VOLP(L,NY,NX) - VOLA(L,NY,NX)=TI*VOLA(L,NY,NX)+CORP*(FI*TVOLA-TI*VOLA(L,NY,NX)) - 2+TX*VOLA(L,NY,NX) - VOLWX(L,NY,NX)=VOLW(L,NY,NX) -C VOLW(L,NY,NX)=VOLW(L,NY,NX)+CORP*VOLWH(L,NY,NX) -C VOLI(L,NY,NX)=VOLI(L,NY,NX)+CORP*VOLIH(L,NY,NX) -C VOLA(L,NY,NX)=VOLA(L,NY,NX)+CORP*VOLAH(L,NY,NX) -C VOLWH(L,NY,NX)=XCORP(NY,NX)*VOLWH(L,NY,NX) -C VOLIH(L,NY,NX)=XCORP(NY,NX)*VOLIH(L,NY,NX) -C VOLAH(L,NY,NX)=XCORP(NY,NX)*VOLAH(L,NY,NX) -C FHOL(L,NY,NX)=XCORP(NY,NX)*FHOL(L,NY,NX) - ENGYL=TI*ENGYW+CORP*(FI*TENGY-TI*ENGYW)+TX*ENGYW+FI*TENGYR - VHCP(L,NY,NX)=VHCM(L,NY,NX)+4.19*(VOLW(L,NY,NX)+VOLWH(L,NY,NX)) - 2+1.9274*(VOLI(L,NY,NX)+VOLIH(L,NY,NX)) - TKS(L,NY,NX)=(ENGYM+ENGYL)/VHCP(L,NY,NX) - TCS(L,NY,NX)=TKS(L,NY,NX)-273.15 - ZNH4FA(L,NY,NX)=TI*ZNH4FA(L,NY,NX)+CORP*(FI*TNH4FA - 2-TI*ZNH4FA(L,NY,NX))+TX*ZNH4FA(L,NY,NX) - ZNH3FA(L,NY,NX)=TI*ZNH3FA(L,NY,NX)+CORP*(FI*TNH3FA - 2-TI*ZNH3FA(L,NY,NX))+TX*ZNH3FA(L,NY,NX) - ZNHUFA(L,NY,NX)=TI*ZNHUFA(L,NY,NX)+CORP*(FI*TNHUFA - 2-TI*ZNHUFA(L,NY,NX))+TX*ZNHUFA(L,NY,NX) - ZNO3FA(L,NY,NX)=TI*ZNO3FA(L,NY,NX)+CORP*(FI*TNO3FA - 2-TI*ZNO3FA(L,NY,NX))+TX*ZNO3FA(L,NY,NX) - ZNH4FB(L,NY,NX)=TI*ZNH4FB(L,NY,NX)+CORP*(FI*TNH4FB - 2-TI*ZNH4FB(L,NY,NX))+TX*ZNH4FB(L,NY,NX) - ZNH3FB(L,NY,NX)=TI*ZNH3FB(L,NY,NX)+CORP*(FI*TNH3FB - 2-TI*ZNH3FB(L,NY,NX))+TX*ZNH3FB(L,NY,NX) - ZNHUFB(L,NY,NX)=TI*ZNHUFB(L,NY,NX)+CORP*(FI*TNHUFB - 2-TI*ZNHUFB(L,NY,NX))+TX*ZNHUFB(L,NY,NX) - ZNO3FB(L,NY,NX)=TI*ZNO3FB(L,NY,NX)+CORP*(FI*TNO3FB - 2-TI*ZNO3FB(L,NY,NX))+TX*ZNO3FB(L,NY,NX) - ZNH4S(L,NY,NX)=TI*ZNH4S(L,NY,NX)+CORP*(FI*TNH4S-TI*ZNH4S(L,NY,NX)) - 2+TX*ZNH4S(L,NY,NX)+CORP*ZNH4SH(L,NY,NX) - ZNH4B(L,NY,NX)=TI*ZNH4B(L,NY,NX)+CORP*(FI*TNH4B-TI*ZNH4B(L,NY,NX)) - 2+TX*ZNH4B(L,NY,NX)+CORP*ZNH4BH(L,NY,NX) - ZNH3S(L,NY,NX)=TI*ZNH3S(L,NY,NX)+CORP*(FI*TNH3S-TI*ZNH3S(L,NY,NX)) - 2+TX*ZNH3S(L,NY,NX)+CORP*ZNH3SH(L,NY,NX) - ZNH3B(L,NY,NX)=TI*ZNH3B(L,NY,NX)+CORP*(FI*TNH3B-TI*ZNH3B(L,NY,NX)) - 2+TX*ZNH3B(L,NY,NX)+CORP*ZNH3BH(L,NY,NX) - ZNO3S(L,NY,NX)=TI*ZNO3S(L,NY,NX)+CORP*(FI*TNO3S-TI*ZNO3S(L,NY,NX)) - 2+TX*ZNO3S(L,NY,NX)+CORP*ZNO3SH(L,NY,NX) - ZNO3B(L,NY,NX)=TI*ZNO3B(L,NY,NX)+CORP*(FI*TNO3B-TI*ZNO3B(L,NY,NX)) - 2+TX*ZNO3B(L,NY,NX)+CORP*ZNO3BH(L,NY,NX) - ZNO2S(L,NY,NX)=TI*ZNO2S(L,NY,NX)+CORP*(FI*TNO2S-TI*ZNO2S(L,NY,NX)) - 2+TX*ZNO2S(L,NY,NX)+CORP*ZNO2SH(L,NY,NX) - ZNO2B(L,NY,NX)=TI*ZNO2B(L,NY,NX)+CORP*(FI*TNO2B-TI*ZNO2B(L,NY,NX)) - 2+TX*ZNO2B(L,NY,NX)+CORP*ZNO2BH(L,NY,NX) - ZAL(L,NY,NX)=TI*ZAL(L,NY,NX)+CORP*(FI*TZAL-TI*ZAL(L,NY,NX)) - 2+TX*ZAL(L,NY,NX)+CORP*ZALH(L,NY,NX) - ZFE(L,NY,NX)=TI*ZFE(L,NY,NX)+CORP*(FI*TZFE-TI*ZFE(L,NY,NX)) - 2+TX*ZFE(L,NY,NX)+CORP*ZFEH(L,NY,NX) - ZHY(L,NY,NX)=TI*ZHY(L,NY,NX)+CORP*(FI*TZHY-TI*ZHY(L,NY,NX)) - 2+TX*ZHY(L,NY,NX)+CORP*ZHYH(L,NY,NX) - ZCA(L,NY,NX)=TI*ZCA(L,NY,NX)+CORP*(FI*TZCA-TI*ZCA(L,NY,NX)) - 2+TX*ZCA(L,NY,NX)+CORP*ZCCH(L,NY,NX) - ZMG(L,NY,NX)=TI*ZMG(L,NY,NX)+CORP*(FI*TZMG-TI*ZMG(L,NY,NX)) - 2+TX*ZMG(L,NY,NX)+CORP*ZMAH(L,NY,NX) - ZNA(L,NY,NX)=TI*ZNA(L,NY,NX)+CORP*(FI*TZNA-TI*ZNA(L,NY,NX)) - 2+TX*ZNA(L,NY,NX)+CORP*ZNAH(L,NY,NX) - ZKA(L,NY,NX)=TI*ZKA(L,NY,NX)+CORP*(FI*TZKA-TI*ZKA(L,NY,NX)) - 2+TX*ZKA(L,NY,NX)+CORP*ZKAH(L,NY,NX) - ZOH(L,NY,NX)=TI*ZOH(L,NY,NX)+CORP*(FI*TZOH-TI*ZOH(L,NY,NX)) - 2+TX*ZOH(L,NY,NX)+CORP*ZOHH(L,NY,NX) - ZSO4(L,NY,NX)=TI*ZSO4(L,NY,NX)+CORP*(FI*TZSO4-TI*ZSO4(L,NY,NX)) - 2+TX*ZSO4(L,NY,NX)+CORP*ZSO4H(L,NY,NX) - ZCL(L,NY,NX)=TI*ZCL(L,NY,NX)+CORP*(FI*TZCL-TI*ZCL(L,NY,NX)) - 2+TX*ZCL(L,NY,NX)+CORP*ZCLH(L,NY,NX) - ZCO3(L,NY,NX)=TI*ZCO3(L,NY,NX)+CORP*(FI*TZCO3-TI*ZCO3(L,NY,NX)) - 2+TX*ZCO3(L,NY,NX)+CORP*ZCO3H(L,NY,NX) - ZHCO3(L,NY,NX)=TI*ZHCO3(L,NY,NX)+CORP*(FI*TZHCO3 - 2-TI*ZHCO3(L,NY,NX))+TX*ZHCO3(L,NY,NX)+CORP*ZHCO3H(L,NY,NX) - ZALOH1(L,NY,NX)=TI*ZALOH1(L,NY,NX)+CORP*(FI*TZALO1 - 2-TI*ZALOH1(L,NY,NX))+TX*ZALOH1(L,NY,NX)+CORP*ZALO1H(L,NY,NX) - ZALOH2(L,NY,NX)=TI*ZALOH2(L,NY,NX)+CORP*(FI*TZALO2 - 2-TI*ZALOH2(L,NY,NX))+TX*ZALOH2(L,NY,NX)+CORP*ZALO2H(L,NY,NX) - ZALOH3(L,NY,NX)=TI*ZALOH3(L,NY,NX)+CORP*(FI*TZALO3 - 2-TI*ZALOH3(L,NY,NX))+TX*ZALOH3(L,NY,NX)+CORP*ZALO3H(L,NY,NX) - ZALOH4(L,NY,NX)=TI*ZALOH4(L,NY,NX)+CORP*(FI*TZALO4 - 2-TI*ZALOH4(L,NY,NX))+TX*ZALOH4(L,NY,NX)+CORP*ZALO4H(L,NY,NX) - ZALS(L,NY,NX)=TI*ZALS(L,NY,NX)+CORP*(FI*TZALS-TI*ZALS(L,NY,NX)) - 2+TX*ZALS(L,NY,NX)+CORP*ZALSH(L,NY,NX) - ZFEOH1(L,NY,NX)=TI*ZFEOH1(L,NY,NX)+CORP*(FI*TZFEO1 - 2-TI*ZFEOH1(L,NY,NX))+TX*ZFEOH1(L,NY,NX)+CORP*ZFEO1H(L,NY,NX) - ZFEOH2(L,NY,NX)=TI*ZFEOH2(L,NY,NX)+CORP*(FI*TZFEO2 - 2-TI*ZFEOH2(L,NY,NX))+TX*ZFEOH2(L,NY,NX)+CORP*ZFEO2H(L,NY,NX) - ZFEOH3(L,NY,NX)=TI*ZFEOH3(L,NY,NX)+CORP*(FI*TZFEO3 - 2-TI*ZFEOH3(L,NY,NX))+TX*ZFEOH3(L,NY,NX)+CORP*ZFEO3H(L,NY,NX) - ZFEOH4(L,NY,NX)=TI*ZFEOH4(L,NY,NX)+CORP*(FI*TZFEO4 - 2-TI*ZFEOH4(L,NY,NX))+TX*ZFEOH4(L,NY,NX)+CORP*ZFEO4H(L,NY,NX) - ZFES(L,NY,NX)=TI*ZFES(L,NY,NX)+CORP*(FI*TZFES-TI*ZFES(L,NY,NX)) - 2+TX*ZFES(L,NY,NX)+CORP*ZFESH(L,NY,NX) - ZCAO(L,NY,NX)=TI*ZCAO(L,NY,NX)+CORP*(FI*TZCAO-TI*ZCAO(L,NY,NX)) - 2+TX*ZCAO(L,NY,NX)+CORP*ZCAOH(L,NY,NX) - ZCAC(L,NY,NX)=TI*ZCAC(L,NY,NX)+CORP*(FI*TZCAC-TI*ZCAC(L,NY,NX)) - 2+TX*ZCAC(L,NY,NX)+CORP*ZCACH(L,NY,NX) - ZCAH(L,NY,NX)=TI*ZCAH(L,NY,NX)+CORP*(FI*TZCAH-TI*ZCAH(L,NY,NX)) - 2+TX*ZCAH(L,NY,NX)+CORP*ZCAHH(L,NY,NX) - ZCAS(L,NY,NX)=TI*ZCAS(L,NY,NX)+CORP*(FI*TZCAS-TI*ZCAS(L,NY,NX)) - 2+TX*ZCAS(L,NY,NX)+CORP*ZCASH(L,NY,NX) - ZMGO(L,NY,NX)=TI*ZMGO(L,NY,NX)+CORP*(FI*TZMGO-TI*ZMGO(L,NY,NX)) - 2+TX*ZMGO(L,NY,NX)+CORP*ZMGOH(L,NY,NX) - ZMGC(L,NY,NX)=TI*ZMGC(L,NY,NX)+CORP*(FI*TZMGC-TI*ZMGC(L,NY,NX)) - 2+TX*ZMGC(L,NY,NX)+CORP*ZMGCH(L,NY,NX) - ZMGH(L,NY,NX)=TI*ZMGH(L,NY,NX)+CORP*(FI*TZMGH-TI*ZMGH(L,NY,NX)) - 2+TX*ZMGH(L,NY,NX)+CORP*ZMGHH(L,NY,NX) - ZMGS(L,NY,NX)=TI*ZMGS(L,NY,NX)+CORP*(FI*TZMGS-TI*ZMGS(L,NY,NX)) - 2+TX*ZMGS(L,NY,NX)+CORP*ZMGSH(L,NY,NX) - ZNAC(L,NY,NX)=TI*ZNAC(L,NY,NX)+CORP*(FI*TZNAC-TI*ZNAC(L,NY,NX)) - 2+TX*ZNAC(L,NY,NX)+CORP*ZNACH(L,NY,NX) - ZNAS(L,NY,NX)=TI*ZNAS(L,NY,NX)+CORP*(FI*TZNAS-TI*ZNAS(L,NY,NX)) - 2+TX*ZNAS(L,NY,NX)+CORP*ZNASH(L,NY,NX) - ZKAS(L,NY,NX)=TI*ZKAS(L,NY,NX)+CORP*(FI*TZKAS-TI*ZKAS(L,NY,NX)) - 2+TX*ZKAS(L,NY,NX)+CORP*ZKASH(L,NY,NX) - H0PO4(L,NY,NX)=TI*H0PO4(L,NY,NX)+CORP*(FI*TH0PO4 - 2-TI*H0PO4(L,NY,NX))+TX*H0PO4(L,NY,NX)+CORP*H0PO4H(L,NY,NX) - H1PO4(L,NY,NX)=TI*H1PO4(L,NY,NX)+CORP*(FI*TH1PO4 - 2-TI*H1PO4(L,NY,NX))+TX*H1PO4(L,NY,NX)+CORP*H1PO4H(L,NY,NX) - H2PO4(L,NY,NX)=TI*H2PO4(L,NY,NX)+CORP*(FI*TH2PO4 - 2-TI*H2PO4(L,NY,NX))+TX*H2PO4(L,NY,NX)+CORP*H2PO4H(L,NY,NX) - H3PO4(L,NY,NX)=TI*H3PO4(L,NY,NX)+CORP*(FI*TH3PO4 - 2-TI*H3PO4(L,NY,NX))+TX*H3PO4(L,NY,NX)+CORP*H3PO4H(L,NY,NX) - ZFE1P(L,NY,NX)=TI*ZFE1P(L,NY,NX)+CORP*(FI*TZFE1P - 2-TI*ZFE1P(L,NY,NX))+TX*ZFE1P(L,NY,NX)+CORP*ZFE1PH(L,NY,NX) - ZFE2P(L,NY,NX)=TI*ZFE2P(L,NY,NX)+CORP*(FI*TZFE2P - 2-TI*ZFE2P(L,NY,NX))+TX*ZFE2P(L,NY,NX)+CORP*ZFE2PH(L,NY,NX) - ZCA0P(L,NY,NX)=TI*ZCA0P(L,NY,NX)+CORP*(FI*TZCA0P - 2-TI*ZCA0P(L,NY,NX))+TX*ZCA0P(L,NY,NX)+CORP*ZCA0PH(L,NY,NX) - ZCA1P(L,NY,NX)=TI*ZCA1P(L,NY,NX)+CORP*(FI*TZCA1P - 2-TI*ZCA1P(L,NY,NX))+TX*ZCA1P(L,NY,NX)+CORP*ZCA1PH(L,NY,NX) - ZCA2P(L,NY,NX)=TI*ZCA2P(L,NY,NX)+CORP*(FI*TZCA2P - 2-TI*ZCA2P(L,NY,NX))+TX*ZCA2P(L,NY,NX)+CORP*ZCA2PH(L,NY,NX) - ZMG1P(L,NY,NX)=TI*ZMG1P(L,NY,NX)+CORP*(FI*TZMG1P - 2-TI*ZMG1P(L,NY,NX))+TX*ZMG1P(L,NY,NX)+CORP*ZMG1PH(L,NY,NX) - H0POB(L,NY,NX)=TI*H0POB(L,NY,NX)+CORP*(FI*TH0POB - 2-TI*H0POB(L,NY,NX))+TX*H0POB(L,NY,NX)+CORP*H0POBH(L,NY,NX) - H1POB(L,NY,NX)=TI*H1POB(L,NY,NX)+CORP*(FI*TH1POB - 2-TI*H1POB(L,NY,NX))+TX*H1POB(L,NY,NX)+CORP*H1POBH(L,NY,NX) - H2POB(L,NY,NX)=TI*H2POB(L,NY,NX)+CORP*(FI*TH2POB - 2-TI*H2POB(L,NY,NX))+TX*H2POB(L,NY,NX)+CORP*H2POBH(L,NY,NX) - H3POB(L,NY,NX)=TI*H3POB(L,NY,NX)+CORP*(FI*TH3POB - 2-TI*H3POB(L,NY,NX))+TX*H3POB(L,NY,NX)+CORP*H3POBH(L,NY,NX) - ZFE1PB(L,NY,NX)=TI*ZFE1PB(L,NY,NX)+CORP*(FI*TFE1PB - 2-TI*ZFE1PB(L,NY,NX))+TX*ZFE1PB(L,NY,NX)+CORP*ZFE1BH(L,NY,NX) - ZFE2PB(L,NY,NX)=TI*ZFE2PB(L,NY,NX)+CORP*(FI*TFE2PB - 2-TI*ZFE2PB(L,NY,NX))+TX*ZFE2PB(L,NY,NX)+CORP*ZFE2BH(L,NY,NX) - ZCA0PB(L,NY,NX)=TI*ZCA0PB(L,NY,NX)+CORP*(FI*TCA0PB - 2-TI*ZCA0PB(L,NY,NX))+TX*ZCA0PB(L,NY,NX)+CORP*ZCA0BH(L,NY,NX) - ZCA1PB(L,NY,NX)=TI*ZCA1PB(L,NY,NX)+CORP*(FI*TCA1PB - 2-TI*ZCA1PB(L,NY,NX))+TX*ZCA1PB(L,NY,NX)+CORP*ZCA1BH(L,NY,NX) - ZCA2PB(L,NY,NX)=TI*ZCA2PB(L,NY,NX)+CORP*(FI*TCA2PB - 2-TI*ZCA2PB(L,NY,NX))+TX*ZCA2PB(L,NY,NX)+CORP*ZCA2BH(L,NY,NX) - ZMG1PB(L,NY,NX)=TI*ZMG1PB(L,NY,NX)+CORP*(FI*TMG1PB - 2-TI*ZMG1PB(L,NY,NX))+TX*ZMG1PB(L,NY,NX)+CORP*ZMG1BH(L,NY,NX) - XN4(L,NY,NX)=TI*XN4(L,NY,NX)+CORP*(FI*TXNH4-TI*XN4(L,NY,NX)) - 2+TX*XN4(L,NY,NX) - XNB(L,NY,NX)=TI*XNB(L,NY,NX)+CORP*(FI*TXNHB-TI*XNB(L,NY,NX)) - 2+TX*XNB(L,NY,NX) - XHY(L,NY,NX)=TI*XHY(L,NY,NX)+CORP*(FI*TXHY-TI*XHY(L,NY,NX)) - 2+TX*XHY(L,NY,NX) - XAL(L,NY,NX)=TI*XAL(L,NY,NX)+CORP*(FI*TXAL-TI*XAL(L,NY,NX)) - 2+TX*XAL(L,NY,NX) - XCA(L,NY,NX)=TI*XCA(L,NY,NX)+CORP*(FI*TXCA-TI*XCA(L,NY,NX)) - 2+TX*XCA(L,NY,NX) - XMG(L,NY,NX)=TI*XMG(L,NY,NX)+CORP*(FI*TXMG-TI*XMG(L,NY,NX)) - 2+TX*XMG(L,NY,NX) - XNA(L,NY,NX)=TI*XNA(L,NY,NX)+CORP*(FI*TXNA-TI*XNA(L,NY,NX)) - 2+TX*XNA(L,NY,NX) - XKA(L,NY,NX)=TI*XKA(L,NY,NX)+CORP*(FI*TXKA-TI*XKA(L,NY,NX)) - 2+TX*XKA(L,NY,NX) - XHC(L,NY,NX)=TI*XHC(L,NY,NX)+CORP*(FI*TXHC-TI*XHC(L,NY,NX)) - 2+TX*XHC(L,NY,NX) - XALO2(L,NY,NX)=TI*XALO2(L,NY,NX)+CORP*(FI*TXAL2-TI*XALO2(L,NY,NX)) - 2+TX*XALO2(L,NY,NX) - XOH0(L,NY,NX)=TI*XOH0(L,NY,NX)+CORP*(FI*TXOH0-TI*XOH0(L,NY,NX)) - 2+TX*XOH0(L,NY,NX) - XOH1(L,NY,NX)=TI*XOH1(L,NY,NX)+CORP*(FI*TXOH1-TI*XOH1(L,NY,NX)) - 2+TX*XOH1(L,NY,NX) - XOH2(L,NY,NX)=TI*XOH2(L,NY,NX)+CORP*(FI*TXOH2-TI*XOH2(L,NY,NX)) - 2+TX*XOH2(L,NY,NX) - XH1P(L,NY,NX)=TI*XH1P(L,NY,NX)+CORP*(FI*TXH1P-TI*XH1P(L,NY,NX)) - 2+TX*XH1P(L,NY,NX) - XH2P(L,NY,NX)=TI*XH2P(L,NY,NX)+CORP*(FI*TXH2P-TI*XH2P(L,NY,NX)) - 2+TX*XH2P(L,NY,NX) - XOH0B(L,NY,NX)=TI*XOH0B(L,NY,NX)+CORP*(FI*TXOH0B - 2-TI*XOH0B(L,NY,NX))+TX*XOH0B(L,NY,NX) - XOH1B(L,NY,NX)=TI*XOH1B(L,NY,NX)+CORP*(FI*TXOH1B - 2-TI*XOH1B(L,NY,NX))+TX*XOH1B(L,NY,NX) - XOH2B(L,NY,NX)=TI*XOH2B(L,NY,NX)+CORP*(FI*TXOH2B - 2-TI*XOH2B(L,NY,NX))+TX*XOH2B(L,NY,NX) - XH1PB(L,NY,NX)=TI*XH1PB(L,NY,NX)+CORP*(FI*TXH1PB - 2-TI*XH1PB(L,NY,NX))+TX*XH1PB(L,NY,NX) - XH2PB(L,NY,NX)=TI*XH2PB(L,NY,NX)+CORP*(FI*TXH2PB - 2-TI*XH2PB(L,NY,NX))+TX*XH2PB(L,NY,NX) - PALOH(L,NY,NX)=TI*PALOH(L,NY,NX)+CORP*(FI*TPALOH - 2-TI*PALOH(L,NY,NX))+TX*PALOH(L,NY,NX) - PFEOH(L,NY,NX)=TI*PFEOH(L,NY,NX)+CORP*(FI*TPFEOH - 2-TI*PFEOH(L,NY,NX))+TX*PFEOH(L,NY,NX) - PCACO(L,NY,NX)=TI*PCACO(L,NY,NX)+CORP*(FI*TPCACO - 2-TI*PCACO(L,NY,NX))+TX*PCACO(L,NY,NX) - PCASO(L,NY,NX)=TI*PCASO(L,NY,NX)+CORP*(FI*TPCASO - 2-TI*PCASO(L,NY,NX))+TX*PCASO(L,NY,NX) - PALPO(L,NY,NX)=TI*PALPO(L,NY,NX)+CORP*(FI*TPALPO - 2-TI*PALPO(L,NY,NX))+TX*PALPO(L,NY,NX) - PFEPO(L,NY,NX)=TI*PFEPO(L,NY,NX)+CORP*(FI*TPFEPO - 2-TI*PFEPO(L,NY,NX))+TX*PFEPO(L,NY,NX) - PCAPD(L,NY,NX)=TI*PCAPD(L,NY,NX)+CORP*(FI*TPCAPD - 2-TI*PCAPD(L,NY,NX))+TX*PCAPD(L,NY,NX) - PCAPH(L,NY,NX)=TI*PCAPH(L,NY,NX)+CORP*(FI*TPCAPH - 2-TI*PCAPH(L,NY,NX))+TX*PCAPH(L,NY,NX) - PCAPM(L,NY,NX)=TI*PCAPM(L,NY,NX)+CORP*(FI*TPCAPM - 2-TI*PCAPM(L,NY,NX))+TX*PCAPM(L,NY,NX) - PALPB(L,NY,NX)=TI*PALPB(L,NY,NX)+CORP*(FI*TPALPB - 2-TI*PALPB(L,NY,NX))+TX*PALPB(L,NY,NX) - PFEPB(L,NY,NX)=TI*PFEPB(L,NY,NX)+CORP*(FI*TPFEPB - 2-TI*PFEPB(L,NY,NX))+TX*PFEPB(L,NY,NX) - PCPDB(L,NY,NX)=TI*PCPDB(L,NY,NX)+CORP*(FI*TPCPDB - 2-TI*PCPDB(L,NY,NX))+TX*PCPDB(L,NY,NX) - PCPHB(L,NY,NX)=TI*PCPHB(L,NY,NX)+CORP*(FI*TPCPHB - 2-TI*PCPHB(L,NY,NX))+TX*PCPHB(L,NY,NX) - PCPMB(L,NY,NX)=TI*PCPMB(L,NY,NX)+CORP*(FI*TPCPMB - 2-TI*PCPMB(L,NY,NX))+TX*PCPMB(L,NY,NX) - CO2G(L,NY,NX)=TI*CO2G(L,NY,NX)+CORP*(FI*TCO2G-TI*CO2G(L,NY,NX)) - 2+TX*CO2G(L,NY,NX) - CH4G(L,NY,NX)=TI*CH4G(L,NY,NX)+CORP*(FI*TCH4G-TI*CH4G(L,NY,NX)) - 2+TX*CH4G(L,NY,NX) - CO2S(L,NY,NX)=TI*CO2S(L,NY,NX)+CORP*(FI*TCOZS-TI*CO2S(L,NY,NX)) - 2+TX*CO2S(L,NY,NX)+CORP*CO2SH(L,NY,NX) - CH4S(L,NY,NX)=TI*CH4S(L,NY,NX)+CORP*(FI*TCHFS-TI*CH4S(L,NY,NX)) - 2+TX*CH4S(L,NY,NX)+CORP*CH4SH(L,NY,NX) - OXYG(L,NY,NX)=TI*OXYG(L,NY,NX)+CORP*(FI*TOXYG-TI*OXYG(L,NY,NX)) - 2+TX*OXYG(L,NY,NX) - OXYS(L,NY,NX)=TI*OXYS(L,NY,NX)+CORP*(FI*TOXYS-TI*OXYS(L,NY,NX)) - 2+TX*OXYS(L,NY,NX)+CORP*OXYSH(L,NY,NX) - Z2GG(L,NY,NX)=TI*Z2GG(L,NY,NX)+CORP*(FI*TZ2GG-TI*Z2GG(L,NY,NX)) - 2+TX*Z2GG(L,NY,NX) - Z2GS(L,NY,NX)=TI*Z2GS(L,NY,NX)+CORP*(FI*TZ2GS-TI*Z2GS(L,NY,NX)) - 2+TX*Z2GS(L,NY,NX)+CORP*Z2GSH(L,NY,NX) - Z2OG(L,NY,NX)=TI*Z2OG(L,NY,NX)+CORP*(FI*TZ2OG-TI*Z2OG(L,NY,NX)) - 2+TX*Z2OG(L,NY,NX) - Z2OS(L,NY,NX)=TI*Z2OS(L,NY,NX)+CORP*(FI*TZ2OS-TI*Z2OS(L,NY,NX)) - 2+TX*Z2OS(L,NY,NX)+CORP*Z2OSH(L,NY,NX) - ZNH3G(L,NY,NX)=TI*ZNH3G(L,NY,NX)+CORP*(FI*TZNH3G - 2-TI*ZNH3G(L,NY,NX))+TX*ZNH3G(L,NY,NX) - H2GG(L,NY,NX)=TI*H2GG(L,NY,NX)+CORP*(FI*TH2GG-TI*H2GG(L,NY,NX)) - 2+TX*H2GG(L,NY,NX) - H2GS(L,NY,NX)=TI*H2GS(L,NY,NX)+CORP*(FI*TH2GS-TI*H2GS(L,NY,NX)) - 2+TX*H2GS(L,NY,NX)+CORP*H2GSH(L,NY,NX) - ZNH4SH(L,NY,NX)=XCORP(NY,NX)*ZNH4SH(L,NY,NX) - ZNH3SH(L,NY,NX)=XCORP(NY,NX)*ZNH3SH(L,NY,NX) - ZNO3SH(L,NY,NX)=XCORP(NY,NX)*ZNO3SH(L,NY,NX) - ZNO2SH(L,NY,NX)=XCORP(NY,NX)*ZNO2SH(L,NY,NX) - H2PO4H(L,NY,NX)=XCORP(NY,NX)*H2PO4H(L,NY,NX) - ZNH4BH(L,NY,NX)=XCORP(NY,NX)*ZNH4BH(L,NY,NX) - ZNH3BH(L,NY,NX)=XCORP(NY,NX)*ZNH3BH(L,NY,NX) - ZNO3BH(L,NY,NX)=XCORP(NY,NX)*ZNO3BH(L,NY,NX) - ZNO2BH(L,NY,NX)=XCORP(NY,NX)*ZNO2BH(L,NY,NX) - H2POBH(L,NY,NX)=XCORP(NY,NX)*H2POBH(L,NY,NX) - ZALH(L,NY,NX)=XCORP(NY,NX)*ZALH(L,NY,NX) - ZFEH(L,NY,NX)=XCORP(NY,NX)*ZFEH(L,NY,NX) - ZHYH(L,NY,NX)=XCORP(NY,NX)*ZHYH(L,NY,NX) - ZCCH(L,NY,NX)=XCORP(NY,NX)*ZCCH(L,NY,NX) - ZMAH(L,NY,NX)=XCORP(NY,NX)*ZMAH(L,NY,NX) - ZNAH(L,NY,NX)=XCORP(NY,NX)*ZNAH(L,NY,NX) - ZKAH(L,NY,NX)=XCORP(NY,NX)*ZKAH(L,NY,NX) - ZOHH(L,NY,NX)=XCORP(NY,NX)*ZOHH(L,NY,NX) - ZSO4H(L,NY,NX)=XCORP(NY,NX)*ZSO4H(L,NY,NX) - ZCLH(L,NY,NX)=XCORP(NY,NX)*ZCLH(L,NY,NX) - ZCO3H(L,NY,NX)=XCORP(NY,NX)*ZCO3H(L,NY,NX) - ZHCO3H(L,NY,NX)=XCORP(NY,NX)*ZHCO3H(L,NY,NX) - ZALO1H(L,NY,NX)=XCORP(NY,NX)*ZALO1H(L,NY,NX) - ZALO2H(L,NY,NX)=XCORP(NY,NX)*ZALO2H(L,NY,NX) - ZALO3H(L,NY,NX)=XCORP(NY,NX)*ZALO3H(L,NY,NX) - ZALO4H(L,NY,NX)=XCORP(NY,NX)*ZALO4H(L,NY,NX) - ZALSH(L,NY,NX)=XCORP(NY,NX)*ZALSH(L,NY,NX) - ZFEO1H(L,NY,NX)=XCORP(NY,NX)*ZFEO1H(L,NY,NX) - ZFEO2H(L,NY,NX)=XCORP(NY,NX)*ZFEO2H(L,NY,NX) - ZFEO3H(L,NY,NX)=XCORP(NY,NX)*ZFEO3H(L,NY,NX) - ZFEO4H(L,NY,NX)=XCORP(NY,NX)*ZFEO4H(L,NY,NX) - ZFESH(L,NY,NX)=XCORP(NY,NX)*ZFESH(L,NY,NX) - ZCAOH(L,NY,NX)=XCORP(NY,NX)*ZCAOH(L,NY,NX) - ZCACH(L,NY,NX)=XCORP(NY,NX)*ZCACH(L,NY,NX) - ZCAHH(L,NY,NX)=XCORP(NY,NX)*ZCAHH(L,NY,NX) - ZCASH(L,NY,NX)=XCORP(NY,NX)*ZCASH(L,NY,NX) - ZMGOH(L,NY,NX)=XCORP(NY,NX)*ZMGOH(L,NY,NX) - ZMGCH(L,NY,NX)=XCORP(NY,NX)*ZMGCH(L,NY,NX) - ZMGHH(L,NY,NX)=XCORP(NY,NX)*ZMGHH(L,NY,NX) - ZMGSH(L,NY,NX)=XCORP(NY,NX)*ZMGSH(L,NY,NX) - ZNACH(L,NY,NX)=XCORP(NY,NX)*ZNACH(L,NY,NX) - ZNASH(L,NY,NX)=XCORP(NY,NX)*ZNASH(L,NY,NX) - ZKASH(L,NY,NX)=XCORP(NY,NX)*ZKASH(L,NY,NX) - H0PO4H(L,NY,NX)=XCORP(NY,NX)*H0PO4H(L,NY,NX) - H1PO4H(L,NY,NX)=XCORP(NY,NX)*H1PO4H(L,NY,NX) - H3PO4H(L,NY,NX)=XCORP(NY,NX)*H3PO4H(L,NY,NX) - ZFE1PH(L,NY,NX)=XCORP(NY,NX)*ZFE1PH(L,NY,NX) - ZFE2PH(L,NY,NX)=XCORP(NY,NX)*ZFE2PH(L,NY,NX) - ZCA0PH(L,NY,NX)=XCORP(NY,NX)*ZCA0PH(L,NY,NX) - ZCA1PH(L,NY,NX)=XCORP(NY,NX)*ZCA1PH(L,NY,NX) - ZCA2PH(L,NY,NX)=XCORP(NY,NX)*ZCA2PH(L,NY,NX) - ZMG1PH(L,NY,NX)=XCORP(NY,NX)*ZMG1PH(L,NY,NX) - H0POBH(L,NY,NX)=XCORP(NY,NX)*H0POBH(L,NY,NX) - H1POBH(L,NY,NX)=XCORP(NY,NX)*H1POBH(L,NY,NX) - H3POBH(L,NY,NX)=XCORP(NY,NX)*H3POBH(L,NY,NX) - ZFE1BH(L,NY,NX)=XCORP(NY,NX)*ZFE1BH(L,NY,NX) - ZFE2BH(L,NY,NX)=XCORP(NY,NX)*ZFE2BH(L,NY,NX) - ZCA0BH(L,NY,NX)=XCORP(NY,NX)*ZCA0BH(L,NY,NX) - ZCA1BH(L,NY,NX)=XCORP(NY,NX)*ZCA1BH(L,NY,NX) - ZCA2BH(L,NY,NX)=XCORP(NY,NX)*ZCA2BH(L,NY,NX) - ZMG1BH(L,NY,NX)=XCORP(NY,NX)*ZMG1BH(L,NY,NX) - CO2SH(L,NY,NX)=XCORP(NY,NX)*CO2SH(L,NY,NX) - CH4SH(L,NY,NX)=XCORP(NY,NX)*CH4SH(L,NY,NX) - 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) - DO 5965 K=0,5 - DO 5965 N=1,7 - DO 5965 M=1,3 - OMC(M,N,K,L,NY,NX)=TI*OMC(M,N,K,L,NY,NX)+CORP*(FI*TOMC(M,N,K) - 2-TI*OMC(M,N,K,L,NY,NX))+TX*OMC(M,N,K,L,NY,NX) - OMN(M,N,K,L,NY,NX)=TI*OMN(M,N,K,L,NY,NX)+CORP*(FI*TOMN(M,N,K) - 2-TI*OMN(M,N,K,L,NY,NX))+TX*OMN(M,N,K,L,NY,NX) - OMP(M,N,K,L,NY,NX)=TI*OMP(M,N,K,L,NY,NX)+CORP*(FI*TOMP(M,N,K) - 2-TI*OMP(M,N,K,L,NY,NX))+TX*OMP(M,N,K,L,NY,NX) -5965 CONTINUE - DO 5980 K=0,4 - DO 5975 M=1,2 - ORC(M,K,L,NY,NX)=TI*ORC(M,K,L,NY,NX)+CORP*(FI*TORC(M,K) - 2-TI*ORC(M,K,L,NY,NX))+TX*ORC(M,K,L,NY,NX) - ORN(M,K,L,NY,NX)=TI*ORN(M,K,L,NY,NX)+CORP*(FI*TORN(M,K) - 2-TI*ORN(M,K,L,NY,NX))+TX*ORN(M,K,L,NY,NX) - ORP(M,K,L,NY,NX)=TI*ORP(M,K,L,NY,NX)+CORP*(FI*TORP(M,K) - 2-TI*ORP(M,K,L,NY,NX))+TX*ORP(M,K,L,NY,NX) -5975 CONTINUE - OQC(K,L,NY,NX)=TI*OQC(K,L,NY,NX)+CORP*(FI*TOQC(K) - 2-TI*OQC(K,L,NY,NX))+TX*OQC(K,L,NY,NX)+CORP*OQCH(K,L,NY,NX) - OQN(K,L,NY,NX)=TI*OQN(K,L,NY,NX)+CORP*(FI*TOQN(K) - 2-TI*OQN(K,L,NY,NX))+TX*OQN(K,L,NY,NX)+CORP*OQNH(K,L,NY,NX) - OQP(K,L,NY,NX)=TI*OQP(K,L,NY,NX)+CORP*(FI*TOQP(K) - 2-TI*OQP(K,L,NY,NX))+TX*OQP(K,L,NY,NX)+CORP*OQPH(K,L,NY,NX) - OQA(K,L,NY,NX)=TI*OQA(K,L,NY,NX)+CORP*(FI*TOQA(K) - 2-TI*OQA(K,L,NY,NX))+TX*OQA(K,L,NY,NX)+CORP*OQAH(K,L,NY,NX) - OQCH(K,L,NY,NX)=XCORP(NY,NX)*OQCH(K,L,NY,NX) - OQNH(K,L,NY,NX)=XCORP(NY,NX)*OQNH(K,L,NY,NX) - OQPH(K,L,NY,NX)=XCORP(NY,NX)*OQPH(K,L,NY,NX) - OQAH(K,L,NY,NX)=XCORP(NY,NX)*OQAH(K,L,NY,NX) - OHC(K,L,NY,NX)=TI*OHC(K,L,NY,NX)+CORP*(FI*TOHC(K) - 2-TI*OHC(K,L,NY,NX))+TX*OHC(K,L,NY,NX) - OHN(K,L,NY,NX)=TI*OHN(K,L,NY,NX)+CORP*(FI*TOHN(K) - 2-TI*OHN(K,L,NY,NX))+TX*OHN(K,L,NY,NX) - OHP(K,L,NY,NX)=TI*OHP(K,L,NY,NX)+CORP*(FI*TOHP(K) - 2-TI*OHP(K,L,NY,NX))+TX*OHP(K,L,NY,NX) - OHA(K,L,NY,NX)=TI*OHA(K,L,NY,NX)+CORP*(FI*TOHA(K) - 2-TI*OHA(K,L,NY,NX))+TX*OHA(K,L,NY,NX) - DO 5970 M=1,4 - OSC(M,K,L,NY,NX)=TI*OSC(M,K,L,NY,NX)+CORP*(FI*TOSC(M,K) - 2-TI*OSC(M,K,L,NY,NX))+TX*OSC(M,K,L,NY,NX) - OSA(M,K,L,NY,NX)=TI*OSA(M,K,L,NY,NX)+CORP*(FI*TOSA(M,K) - 2-TI*OSA(M,K,L,NY,NX))+TX*OSA(M,K,L,NY,NX) - OSN(M,K,L,NY,NX)=TI*OSN(M,K,L,NY,NX)+CORP*(FI*TOSN(M,K) - 2-TI*OSN(M,K,L,NY,NX))+TX*OSN(M,K,L,NY,NX) - OSP(M,K,L,NY,NX)=TI*OSP(M,K,L,NY,NX)+CORP*(FI*TOSP(M,K) - 2-TI*OSP(M,K,L,NY,NX))+TX*OSP(M,K,L,NY,NX) -5970 CONTINUE -5980 CONTINUE -C -C ADD STATE VARIABLES IN SURFACE RESIDUE INCORPORATED -C WITHIN TILLAGE MIXING ZONE -C - DO 5910 K=0,5 - IF(K.NE.3.AND.K.NE.4)THEN - DO 5915 N=1,7 - DO 5915 M=1,3 - OMC(M,N,K,L,NY,NX)=OMC(M,N,K,L,NY,NX)+FI*TOMGC(M,N,K) - OMN(M,N,K,L,NY,NX)=OMN(M,N,K,L,NY,NX)+FI*TOMGN(M,N,K) - OMP(M,N,K,L,NY,NX)=OMP(M,N,K,L,NY,NX)+FI*TOMGP(M,N,K) -5915 CONTINUE - ENDIF -5910 CONTINUE - DO 5920 K=0,2 - DO 5925 M=1,2 - ORC(M,K,L,NY,NX)=ORC(M,K,L,NY,NX)+FI*TORXC(M,K) - ORN(M,K,L,NY,NX)=ORN(M,K,L,NY,NX)+FI*TORXN(M,K) - ORP(M,K,L,NY,NX)=ORP(M,K,L,NY,NX)+FI*TORXP(M,K) -5925 CONTINUE - OQC(K,L,NY,NX)=OQC(K,L,NY,NX)+FI*TOQGC(K) - OQN(K,L,NY,NX)=OQN(K,L,NY,NX)+FI*TOQGN(K) - OQP(K,L,NY,NX)=OQP(K,L,NY,NX)+FI*TOQGP(K) - OQA(K,L,NY,NX)=OQA(K,L,NY,NX)+FI*TOQGA(K) - OQCH(K,L,NY,NX)=OQCH(K,L,NY,NX)+FI*TOQHC(K) - OQNH(K,L,NY,NX)=OQNH(K,L,NY,NX)+FI*TOQHN(K) - OQPH(K,L,NY,NX)=OQPH(K,L,NY,NX)+FI*TOQHP(K) - OQAH(K,L,NY,NX)=OQAH(K,L,NY,NX)+FI*TOQHA(K) - OHC(K,L,NY,NX)=OHC(K,L,NY,NX)+FI*TOHGC(K) - OHN(K,L,NY,NX)=OHN(K,L,NY,NX)+FI*TOHGN(K) - OHP(K,L,NY,NX)=OHP(K,L,NY,NX)+FI*TOHGP(K) - OHA(K,L,NY,NX)=OHA(K,L,NY,NX)+FI*TOHGA(K) - DO 5930 M=1,4 - OSC(M,K,L,NY,NX)=OSC(M,K,L,NY,NX)+FI*TOSGC(M,K) - OSA(M,K,L,NY,NX)=OSA(M,K,L,NY,NX)+FI*TOSGA(M,K) - OSN(M,K,L,NY,NX)=OSN(M,K,L,NY,NX)+FI*TOSGN(M,K) - OSP(M,K,L,NY,NX)=OSP(M,K,L,NY,NX)+FI*TOSGP(M,K) -5930 CONTINUE -5920 CONTINUE - OC=0.0 - ON=0.0 - OP=0.0 - RC=0.0 - DO 5985 K=0,5 - DO 5985 N=1,7 - DO 5985 M=1,3 - OC=OC+OMC(M,N,K,L,NY,NX) - ON=ON+OMN(M,N,K,L,NY,NX) - OP=OP+OMP(M,N,K,L,NY,NX) - IF(K.LE.2)THEN - RC=RC+OMC(M,N,K,L,NY,NX) - ENDIF -5985 CONTINUE - DO 6995 K=0,4 - DO 6985 M=1,2 - OC=OC+ORC(M,K,L,NY,NX) - ON=ON+ORN(M,K,L,NY,NX) - OP=OP+ORP(M,K,L,NY,NX) - IF(K.LE.2)THEN - RC=RC+ORC(M,K,L,NY,NX) - ENDIF -6985 CONTINUE - OC=OC+OQC(K,L,NY,NX)+OQCH(K,L,NY,NX)+OHC(K,L,NY,NX) - 2+OQA(K,L,NY,NX)+OQAH(K,L,NY,NX)+OHA(K,L,NY,NX) - ON=ON+OQN(K,L,NY,NX)+OQNH(K,L,NY,NX)+OHN(K,L,NY,NX) - OP=OP+OQP(K,L,NY,NX)+OQPH(K,L,NY,NX)+OHP(K,L,NY,NX) - IF(K.LE.2)THEN - RC=RC+OQC(K,L,NY,NX)+OQCH(K,L,NY,NX)+OHC(K,L,NY,NX) - 2+OQA(K,L,NY,NX)+OQAH(K,L,NY,NX)+OHA(K,L,NY,NX) - ENDIF - DO 6980 M=1,4 - OC=OC+OSC(M,K,L,NY,NX) - ON=ON+OSN(M,K,L,NY,NX) - OP=OP+OSP(M,K,L,NY,NX) - IF(K.LE.2)THEN - RC=RC+OSC(M,K,L,NY,NX) - ENDIF -6980 CONTINUE -6995 CONTINUE - ORGC(L,NY,NX)=OC - ORGN(L,NY,NX)=ON - ORGR(L,NY,NX)=RC - CO2S(L,NY,NX)=CO2S(L,NY,NX)+FI*TCO2GS - CH4S(L,NY,NX)=CH4S(L,NY,NX)+FI*TCH4GS - OXYS(L,NY,NX)=OXYS(L,NY,NX)+FI*TOXYGS - Z2GS(L,NY,NX)=Z2GS(L,NY,NX)+FI*TZ2GSG - Z2OS(L,NY,NX)=Z2OS(L,NY,NX)+FI*TZ2OGS - H2GS(L,NY,NX)=H2GS(L,NY,NX)+FI*TH2GGS - ZNH4S(L,NY,NX)=ZNH4S(L,NY,NX)+FI*TNH4GS - ZNH3S(L,NY,NX)=ZNH3S(L,NY,NX)+FI*TNH3GS - ZNO3S(L,NY,NX)=ZNO3S(L,NY,NX)+FI*TNO3GS - ZNO2S(L,NY,NX)=ZNO2S(L,NY,NX)+FI*TNO2GS - H2PO4(L,NY,NX)=H2PO4(L,NY,NX)+FI*TPO4GS - XN4(L,NY,NX)=XN4(L,NY,NX)+FI*TXN4G - XOH0(L,NY,NX)=XOH0(L,NY,NX)+FI*TXOH0G - XOH1(L,NY,NX)=XOH1(L,NY,NX)+FI*TXOH1G - XOH2(L,NY,NX)=XOH2(L,NY,NX)+FI*TXOH2G - XH1P(L,NY,NX)=XH1P(L,NY,NX)+FI*TXH1PG - XH2P(L,NY,NX)=XH2P(L,NY,NX)+FI*TXH2PG - PALPO(L,NY,NX)=PALPO(L,NY,NX)+FI*TALPOG - PFEPO(L,NY,NX)=PFEPO(L,NY,NX)+FI*TFEPOG - PCAPD(L,NY,NX)=PCAPD(L,NY,NX)+FI*TCAPDG - PCAPH(L,NY,NX)=PCAPH(L,NY,NX)+FI*TCAPHG - PCAPM(L,NY,NX)=PCAPM(L,NY,NX)+FI*TCAPMG - ZNH4FA(L,NY,NX)=ZNH4FA(L,NY,NX)+FI*TNH4FG - 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 - ZNFN0(L,NY,NX)=ZNFNX0 -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 - IFLGS(NY,NX)=1 - ENDIF -C -C CHECK MATERIAL BALANCES -C - IF(I.EQ.365.AND.J.EQ.24)THEN - WRITE(19,2221)'ORGC',I,J,IYRC,NX,NY - 2,(ORGC(L,NY,NX)/AREA(3,L,NY,NX),L=0,NL(NY,NX)) - WRITE(20,2221)'ORGN',I,J,IYRC,NX,NY - 2,(ORGN(L,NY,NX)/AREA(3,L,NY,NX),L=0,NL(NY,NX)) -2221 FORMAT(A8,5I4,21E12.4) - ENDIF -C IF(I.EQ.365.AND.J.EQ.24)THEN -C WRITE(20,2221)'OMCL',I,J,IYRC,NX,NY,(OMCL(L,NY,NX),L=0,NL(NY,NX)) -C WRITE(20,2221)'OMNL',I,J,IYRC,NX,NY,(OMNL(L,NY,NX),L=0,NL(NY,NX)) -C WRITE(20,2222)'TLC',I,J,IYRC,NX,NY,TLRSDC+TLORGC+TLCO2G-CO2GIN -C 2+TCOU-TORGF-XCSN,TLRSDC,TLORGC,TLCO2G,CO2GIN,TCOU,TORGF,XCSN -C 5,XCODFS(NY,NX),XCOFLG(3,NU(NY,NX),NY,NX),TCO2Z(NY,NX) -C 2,FLQGQ(NY,NX)*CCOR(NY,NX),FLQGI(NY,NX)*CCOQ(NY,NX),XCODFG(0,NY,NX) -C 3,XCODFR(NY,NX),XCHDFS(NY,NX),XCHFLG(3,NU(NY,NX),NY,NX) -C 2,FLQGQ(NY,NX)*CCHR(NY,NX),FLQGI(NY,NX)*CCHQ(NY,NX),XCHDFG(0,NY,NX) -C 3,XCHDFR(NY,NX),PRECU(NY,NX)*CCOQ(NY,NX),PRECU(NY,NX)*CCHQ(NY,NX) -C 6,TCOQRS(NY,NX),TCHQRS(NY,NX),XCOFLS(1,0,NY,NX+1) -C 7,XCOFLS(2,0,NY+1,NX) -C 3,UCOP(NY,NX),UDOCQ(NY,NX),UDICQ(NY,NX),UDOCD(NY,NX),UDICD(NY,NX) -C 2,(((CSNT(M,K,L,NY,NX),M=1,4),K=0,1),L=0,NJ(NY,NX)) -C 3,(TCO2P(L,NY,NX),L=1,NJ(NY,NX)),(TCO2S(L,NY,NX),L=1,NJ(NY,NX)) -C 4,CQ,ZCSNC(NY,NX) -C WRITE(20,2222)'TLW',I,J,IYRC,NX,NY,VOLWSO-CRAIN+CRUN+CEVAP+VOLWOU -C 2,VOLWSO,CRAIN,CRUN,CEVAP,VOLWOU,(TUPWTR(L,NY,NX),L=1,JZ) -C 3,TVOLWC(NY,NX),TVOLWP(NY,NX),VOLW(0,NY,NX),VOLI(0,NY,NX)*0.92 -C 4,TFLWC(NY,NX),TEVAPC(NY,NX),TEVAPG(NY,NX),TEVAPP(NY,NX) -C 5,VOLSS(NY,NX),VOLWS(NY,NX),VOLIS(NY,NX)*0.92,TQS(NY,NX) -C 6,TQW(NY,NX),TQI(NY,NX),TFLWS(NY,NX),TFLWW(NY,NX),TFLWI(NY,NX) -C 7,TVOLWC(NY,NX),TVOLWP(NY,NX) -C WRITE(19,2222)'TLH',I,J,IYRC,NX,NY,HEATSO-HEATIN+HEATOU -C 2,HEATSO,HEATIN,HEATOU,HTHAWR(NY,NX),HFLXD,4.19*TKA(NY,NX)*PRECA(NY,NX) -C 3+2.095*TKA(NY,NX)*PRECW(NY,NX),HEATH(NY,NX),HTHAWW(NY,NX) -C 4,THFLXC(NY,NX),(THTHAW(L,NY,NX),L=NU(NY,NX),NL(NY,NX)) -C 5,(VHCP(L,NY,NX)*TKS(L,NY,NX),L=NU(NY,NX),NL(NY,NX)) -C 5,4.19*TKA(NY,NX)*PRECU(NY,NX),TENGYC(NY,NX),ENGYR -C 6,VHCPW(NY,NX)*TKW(NY,NX),VHCPR(NY,NX)*TKS(0,NY,NX) -C WRITE(19,2222)'TLO',I,J,IYRC,NX,NY,OXYGSO-OXYGIN+OXYGOU,OXYGSO -C 2,OXYGIN,OXYGOU,XOXDFS(NY,NX),XOXFLG(3,NU(NY,NX),NY,NX) -C 3,XOXDFG(0,NY,NX),TOXYZ(NY,NX),FLQGQ(NY,NX)*COXR(NY,NX),FLQGI(NY,NX)*COXQ -C 2,PRECU(NY,NX)*COXQ,(RUPOXO(L,NY,NX),L=1,NJ(NY,NX)) -C 3,(TUPOXP(L,NY,NX),L=1,NJ(NY,NX)),(TOXFLA(L,NY,NX),L=1,NJ(NY,NX)) -C WRITE(20,2222)'TLN',I,J,IYRC,NX,NY,TLRSDN+TLORGN+TLN2G+TLNH4 -C 2+TLNO3-ZN2GIN-TZIN+TZOU-TORGN-XZSN,TLRSDN,TLORGN,TLN2G,TLNH4 -C 3,TLNO3,ZN2GIN,TZIN,TZOU,TORGN,XZSN,PRECQ(NY,NX),PRECR(NY,NX) -C 4,PRECW(NY,NX),PRECI(NY,NX),FLQGM(NY,NX),FLQRM(NY,NX) -C 4,(((ZSNT(M,K,L,NY,NX),M=1,4),K=0,1),L=0,JZ) -C 5,(TUPNH4(L,NY,NX),L=1,JZ) -C 6,(TUPNO3(L,NY,NX),L=1,JZ),(TNHFLA(L,NY,NX),L=1,JZ) -C 7,XN3DFS(NY,NX),XNBDFS(NY,NX) -C 8,XN3FLG(3,NU(NY,NX),NY,NX),TNH3Z(NY,NX),UN2GS(NY,NX) -C 9,(XN2GS(L,NY,NX),L=0,JZ) -C WRITE(*,2222)'TLI',I,J,IYRC,NX,NY,TION-TIONIN+TIONOU -C 2-TFERTN-TFERTP,TION,TIONIN,TIONOU,SG,TFERTN,TFERTP -C 3,PRECQ(NY,NX),XHGDFS(NY,NX),XHGFLG(3,NU(NY,NX),NY,NX),TH2GZ(NY,NX) -C 4,(XHGQRS(N,NY,NX),N=1,2),(RH2GO(L,NY,NX),L=1,JZ) -C 5,(THGFLA(L,NY,NX),L=1,JZ),H2GW(NY,NX),(H2GS(L,NY,NX),L=1,JZ) -C 6,(H2GG(L,NY,NX),L=1,JZ),(TLH2GP(L,NY,NX),L=1,JZ) -C WRITE(*,2223)'TLS',I,J,IYRC,NX,NY,NU(NY,NX),TSEDSO+TSEDOU -C 2,TSEDSO,TSEDOU,USEDOU(NY,NX),DLYR(3,NU(NY,NX),NY,NX) -C 3,BKVL(NU(NY,NX),NY,NX),SAND(NU(NY,NX),NY,NX),SILT(NU(NY,NX),NY,NX) -C 4,CLAY(NU(NY,NX),NY,NX),ORGC(NU(NY,NX),NY,NX) -2222 FORMAT(A8,5I6,240F20.6) -2223 FORMAT(A8,6I6,160F16.6) -C ENDIF -9990 CONTINUE -9995 CONTINUE - RETURN - END - + + SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) +C +C THIS SUBROUTINE UPDATES SOIL STATE VARIABLES WITH WATER, HEAT, +C C, N, P, SOLUTE FLUXES CALCULATED IN EARLIER SUBROUTINES +C + include "parameters.h" + include "blkc.h" + include "blk2a.h" + include "blk2b.h" + include "blk2c.h" + include "blk5.h" + include "blk8a.h" + include "blk8b.h" + include "blk11a.h" + include "blk11b.h" + include "blk13a.h" + include "blk13b.h" + include "blk13c.h" + include "blk15a.h" + include "blk15b.h" + include "blk16.h" + include "blk18a.h" + include "blk18b.h" + include "blk19a.h" + include "blk19b.h" + include "blk19c.h" + include "blk19d.h" + include "blk20a.h" + include "blk20b.h" + include "blk20c.h" + include "blk20d.h" + include "blk20e.h" + include "blk20f.h" + include "blk21a.h" + include "blk21b.h" + include "blk22a.h" + include "blk22b.h" + include "blk22c.h" + include "blktest.h" + DIMENSION TFLW(JZ,JY,JX),TFLWX(JZ,JY,JX),THFLW(JZ,JY,JX) + 1,TFLWH(JZ,JY,JX),TOCFLS(0:4,JZ,JY,JX),TONFLS(0:4,JZ,JY,JX) + 2,TOPFLS(0:4,JZ,JY,JX),TOAFLS(0:4,JZ,JY,JX),TCOFLS(JZ,JY,JX) + 3,TCHFLS(JZ,JY,JX),TOXFLS(JZ,JY,JX),TNXFLB(JZ,JY,JX) + 4,TNGFLS(JZ,JY,JX),TN2FLS(JZ,JY,JX),TN4FLS(JZ,JY,JX) + 5,TN4FLB(JZ,JY,JX),TN3FLS(JZ,JY,JX),TN3FLB(JZ,JY,JX) + 6,TNOFLS(JZ,JY,JX),TNOFLB(JZ,JY,JX),TPOFLS(JZ,JY,JX) + 7,TH2BFB(JZ,JY,JX),TNXFLS(JZ,JY,JX),TOCFHS(0:4,JZ,JY,JX) + 8,TONFHS(0:4,JZ,JY,JX),TOPFHS(0:4,JZ,JY,JX),TOAFHS(0:4,JZ,JY,JX) + 9,TCOFHS(JZ,JY,JX),TCHFHS(JZ,JY,JX),TNXFHB(JZ,JY,JX) + 2,TOXFHS(JZ,JY,JX),TNGFHS(JZ,JY,JX),TN2FHS(JZ,JY,JX) + 2,TN4FHS(JZ,JY,JX),TN4FHB(JZ,JY,JX),TN3FHS(JZ,JY,JX) + 3,TN3FHB(JZ,JY,JX),TNOFHS(JZ,JY,JX),TNOFHB(JZ,JY,JX) + 4,TPOFHS(JZ,JY,JX),TH2BHB(JZ,JY,JX),TNXFHS(JZ,JY,JX) + 5,TCOFLG(JZ,JY,JX),TCHFLG(JZ,JY,JX),TOXFLG(JZ,JY,JX) + 6,TNGFLG(JZ,JY,JX),TN2FLG(JZ,JY,JX),TNHFLG(JZ,JY,JX) + 7,TTHAW(JZ,JY,JX),THTHAW(JZ,JY,JX),TTHAWH(JZ,JY,JX) + 8,TP1FLS(JZ,JY,JX),TP1FHS(JZ,JY,JX),TH1BFB(JZ,JY,JX) + 9,TH1BHB(JZ,JY,JX) + DIMENSION TQR(JY,JX),THQR(JY,JX),TQS(JY,JX) + 2,TQW(JY,JX),TQI(JY,JX),THQS(JY,JX),TOCQRS(0:4,JY,JX) + 1,TONQRS(0:4,JY,JX),TOPQRS(0:4,JY,JX),TOAQRS(0:4,JY,JX) + 2,TCOQRS(JY,JX),TCHQRS(JY,JX),TOXQRS(JY,JX),TQRH1P(JY,JX) + 3,TNGQRS(JY,JX),TN2QRS(JY,JX),TN4QRS(JY,JX),TN3QRS(JY,JX) + 4,TNOQRS(JY,JX),TPOQRS(JY,JX),TNXQRS(JY,JX),TQRAL(JY,JX) + 6,TQRFE(JY,JX),TQRHY(JY,JX),TQRCA(JY,JX),TQRMG(JY,JX) + 7,TQRNA(JY,JX),TQRKA(JY,JX),TQROH(JY,JX),TQRSO(JY,JX) + 8,TQRCL(JY,JX),TQRC3(JY,JX),TQRHC(JY,JX),TQRAL1(JY,JX) + 9,TQRAL2(JY,JX),TQRAL3(JY,JX),TQRAL4(JY,JX),TQRALS(JY,JX) + 1,TQRFE1(JY,JX),TQRFE2(JY,JX),TQRFE3(JY,JX),TQRFE4(JY,JX) + 2,TQRFES(JY,JX),TQRCAO(JY,JX),TQRCAC(JY,JX),TQRCAH(JY,JX) + 3,TQRCAS(JY,JX),TQRMGO(JY,JX),TQRMGC(JY,JX),TQRMGH(JY,JX) + 4,TQRMGS(JY,JX),TQRNAC(JY,JX),TQRNAS(JY,JX),TQRKAS(JY,JX) + 5,TQRH0P(JY,JX),TQRH3P(JY,JX),TQRF1P(JY,JX),TP1QRS(JY,JX) + 6,TQRF2P(JY,JX),TQRC0P(JY,JX),TQRC1P(JY,JX),TQRC2P(JY,JX) + 7,TQRM1P(JY,JX),TCOQSS(JY,JX),TCHQSS(JY,JX),TOXQSS(JY,JX) + 3,TNGQSS(JY,JX),TN2QSS(JY,JX),TN4QSS(JY,JX),TN3QSS(JY,JX) + 4,TNOQSS(JY,JX),TPOQSS(JY,JX),TP1QSS(JY,JX),TQSAL(JY,JX) + 6,TQSFE(JY,JX),TQSHY(JY,JX),TQSCA(JY,JX),TQSMG(JY,JX) + 7,TQSNA(JY,JX),TQSKA(JY,JX),TQSOH(JY,JX),TQSSO(JY,JX) + 8,TQSCL(JY,JX),TQSC3(JY,JX),TQSHC(JY,JX),TQSAL1(JY,JX) + 9,TQSAL2(JY,JX),TQSAL3(JY,JX),TQSAL4(JY,JX),TQSALS(JY,JX) + 1,TQSFE1(JY,JX),TQSFE2(JY,JX),TQSFE3(JY,JX),TQSFE4(JY,JX) + 2,TQSFES(JY,JX),TQSCAO(JY,JX),TQSCAC(JY,JX),TQSCAH(JY,JX) + 3,TQSCAS(JY,JX),TQSMGO(JY,JX),TQSMGC(JY,JX),TQSMGH(JY,JX) + 4,TQSMGS(JY,JX),TQSNAC(JY,JX),TQSNAS(JY,JX),TQSKAS(JY,JX) + 5,TQSH0P(JY,JX),TQSH1P(JY,JX),TQSH3P(JY,JX),TQSF1P(JY,JX) + 6,TQSF2P(JY,JX),TQSC0P(JY,JX),TQSC1P(JY,JX),TQSC2P(JY,JX) + 7,TQSM1P(JY,JX) + DIMENSION TALFLS(JZ,JY,JX),TFEFLS(JZ,JY,JX) + 1,TCAFLS(JZ,JY,JX),THYFLS(JZ,JY,JX),TMGFLS(JZ,JY,JX) + 2,TNAFLS(JZ,JY,JX),TKAFLS(JZ,JY,JX),TOHFLS(JZ,JY,JX) + 3,TSOFLS(JZ,JY,JX),TCLFLS(JZ,JY,JX),TC3FLS(JZ,JY,JX) + 4,THCFLS(JZ,JY,JX),TAL1FS(JZ,JY,JX),TAL2FS(JZ,JY,JX) + 5,TAL3FS(JZ,JY,JX),TAL4FS(JZ,JY,JX),TALSFS(JZ,JY,JX) + 6,TFE1FS(JZ,JY,JX),TFE2FS(JZ,JY,JX) + 7,TFE3FS(JZ,JY,JX),TFE4FS(JZ,JY,JX),TFESFS(JZ,JY,JX) + 8,TCAOFS(JZ,JY,JX),TCACFS(JZ,JY,JX),TCAHFS(JZ,JY,JX) + 9,TCASFS(JZ,JY,JX),TMGOFS(JZ,JY,JX),TMGCFS(JZ,JY,JX) + 1,TMGHFS(JZ,JY,JX),TMGSFS(JZ,JY,JX),TNACFS(JZ,JY,JX) + 2,TNASFS(JZ,JY,JX),TKASFS(JZ,JY,JX),TH0PFS(JZ,JY,JX) + 3,TH1PFS(JZ,JY,JX),TH3PFS(JZ,JY,JX),TF1PFS(JZ,JY,JX) + 4,TF2PFS(JZ,JY,JX),TC0PFS(JZ,JY,JX),TC1PFS(JZ,JY,JX) + 5,TC2PFS(JZ,JY,JX),TM1PFS(JZ,JY,JX),TH0BFB(JZ,JY,JX) + 6,TH3BFB(JZ,JY,JX),TF1BFB(JZ,JY,JX) + 7,TF2BFB(JZ,JY,JX),TC0BFB(JZ,JY,JX),TC1BFB(JZ,JY,JX) + 8,TC2BFB(JZ,JY,JX),TM1BFB(JZ,JY,JX) + DIMENSION TALFHS(JZ,JY,JX),TFEFHS(JZ,JY,JX) + 1,THYFHS(JZ,JY,JX),TCAFHS(JZ,JY,JX),TMGFHS(JZ,JY,JX) + 2,TNAFHS(JZ,JY,JX),TKAFHS(JZ,JY,JX),TOHFHS(JZ,JY,JX) + 3,TSOFHS(JZ,JY,JX),TCLFHS(JZ,JY,JX),TC3FHS(JZ,JY,JX) + 4,THCFHS(JZ,JY,JX),TAL1HS(JZ,JY,JX),TAL2HS(JZ,JY,JX) + 5,TAL3HS(JZ,JY,JX),TAL4HS(JZ,JY,JX),TALSHS(JZ,JY,JX) + 6,TFE1HS(JZ,JY,JX),TFE2HS(JZ,JY,JX) + 7,TFE3HS(JZ,JY,JX),TFE4HS(JZ,JY,JX),TFESHS(JZ,JY,JX) + 8,TCAOHS(JZ,JY,JX),TCACHS(JZ,JY,JX),TCAHHS(JZ,JY,JX) + 9,TCASHS(JZ,JY,JX),TMGOHS(JZ,JY,JX),TMGCHS(JZ,JY,JX) + 1,TMGHHS(JZ,JY,JX),TMGSHS(JZ,JY,JX),TNACHS(JZ,JY,JX) + 2,TNASHS(JZ,JY,JX),TKASHS(JZ,JY,JX),TH0PHS(JZ,JY,JX) + 3,TH3PHS(JZ,JY,JX),TF1PHS(JZ,JY,JX) + 4,TF2PHS(JZ,JY,JX),TC0PHS(JZ,JY,JX),TC1PHS(JZ,JY,JX) + 5,TC2PHS(JZ,JY,JX),TM1PHS(JZ,JY,JX),TH0BHB(JZ,JY,JX) + 6,TH3BHB(JZ,JY,JX),TF1BHB(JZ,JY,JX) + 7,TF2BHB(JZ,JY,JX),TC0BHB(JZ,JY,JX),TC1BHB(JZ,JY,JX) + 8,TC2BHB(JZ,JY,JX),TM1BHB(JZ,JY,JX) + DIMENSION TSANER(JY,JX),TSILER(JY,JX),TCLAER(JY,JX) + 2,TCECER(JY,JX),TAECER(JY,JX),TNH4ER(JY,JX),TNH3ER(JY,JX) + 3,TNHUER(JY,JX),TNO3ER(JY,JX),TNH4EB(JY,JX),TNH3EB(JY,JX) + 4,TNHUEB(JY,JX),TNO3EB(JY,JX),TN4ER(JY,JX),TNBER(JY,JX) + 5,THYER(JY,JX),TALER(JY,JX),TCAER(JY,JX),TMGER(JY,JX) + 6,TNAER(JY,JX),TKAER(JY,JX),THCER(JY,JX),TAL2ER(JY,JX) + 7,TOH0ER(JY,JX),TOH1ER(JY,JX),TOH2ER(JY,JX),TH1PER(JY,JX) + 8,TH2PER(JY,JX),TOH0EB(JY,JX),TOH1EB(JY,JX),TOH2EB(JY,JX) + 9,TH1PEB(JY,JX),TH2PEB(JY,JX),TALOER(JY,JX),TFEOER(JY,JX) + 1,TCACER(JY,JX),TCASER(JY,JX),TALPER(JY,JX),TFEPER(JY,JX) + 2,TCPDER(JY,JX),TCPHER(JY,JX),TCPMER(JY,JX),TALPEB(JY,JX) + 3,TFEPEB(JY,JX),TCPDEB(JY,JX),TCPHEB(JY,JX),TCPMEB(JY,JX) + 4,TOMCER(3,7,0:5,JY,JX),TOMNER(3,7,0:5,JY,JX) + 4,TOMPER(3,7,0:5,JY,JX),TFEER(JY,JX),TFE2ER(JY,JX) + 5,TORCER(2,0:4,JY,JX),TORNER(2,0:4,JY,JX),TORPER(2,0:4,JY,JX) + 6,TOHCER(0:4,JY,JX),TOHNER(0:4,JY,JX),TOHPER(0:4,JY,JX) + 7,TOHAER(0:4,JY,JX),TOSCER(4,0:4,JY,JX),TOSAER(4,0:4,JY,JX) + 8,TOSNER(4,0:4,JY,JX),TOSPER(4,0:4,JY,JX),TSEDER(JY,JX) + DIMENSION TOMC(3,7,0:5),TOMN(3,7,0:5),TOMP(3,7,0:5),TORC(2,0:4) + 2,TORN(2,0:4),TORP(2,0:4),TOQC(0:4),TOQN(0:4),TOQP(0:4),TOQA(0:4) + 3,TOHC(0:4),TOHN(0:4),TOHP(0:4),TOHA(0:4),TOSC(4,0:4),TOSA(4,0:4) + 4,TOSN(4,0:4),TOSP(4,0:4),TOSGC(4,0:2),TOSGA(4,0:2),TOSGN(4,0:2) + 5,TOSGP(4,0:2),TOMGC(3,7,0:5),TOMGN(3,7,0:5),TOMGP(3,7,0:5) + 6,TORXC(2,0:2),TORXN(2,0:2),TORXP(2,0:2),TOQGC(0:2),TOQGN(0:2) + 7,TOQGP(0:2),TOQHC(0:2),TOQHN(0:2),TOQHP(0:2),TOHGC(0:2) + 8,TOHGN(0:2),TOHGP(0:2), TOHGA(0:2),TOQGA(0:2),TOQHA(0:2) + 9,THGQRS(JY,JX),THGFHS(JZ,JY,JX),THGFLG(JZ,JY,JX),THGFLS(JZ,JY,JX) + 1,OMCL(0:JZ,JY,JX),OMNL(0:JZ,JY,JX),EFIRE(2,21:22) + 2,ONL(4,0:4),OPL(4,0:4) + PARAMETER (DNUMN=0.001,DNUMX=0.025) + DATA SG/0.0/ + DATA EFIRE/1.0,1.0,0.917,0.167/ + TFLWT=0.0 + VOLPT=0.0 + VOLTT=0.0 + DO 9995 NX=NHW,NHE + DO 9990 NY=NVN,NVS + TNPP(NY,NX)=TGPP(NY,NX)+TRAU(NY,NX) +C +C ADD WATER, HEAT FLUXES FROM 'WATSUB' AND GAS, SOLUTE FLUXES +C FROM 'TRNSFR' AND 'TRNSFRS' TO SNOWPACK +C + CO2W(NY,NX)=CO2W(NY,NX)+XCOBLS(NY,NX) + CH4W(NY,NX)=CH4W(NY,NX)+XCHBLS(NY,NX) + OXYW(NY,NX)=OXYW(NY,NX)+XOXBLS(NY,NX) + ZNGW(NY,NX)=ZNGW(NY,NX)+XNGBLS(NY,NX) + ZN2W(NY,NX)=ZN2W(NY,NX)+XN2BLS(NY,NX) + H2GW(NY,NX)=H2GW(NY,NX)+XHGBLS(NY,NX) + ZN4W(NY,NX)=ZN4W(NY,NX)+XN4BLW(NY,NX) + ZN3W(NY,NX)=ZN3W(NY,NX)+XN3BLW(NY,NX) + ZNOW(NY,NX)=ZNOW(NY,NX)+XNOBLW(NY,NX) + Z1PW(NY,NX)=Z1PW(NY,NX)+XH1PBS(NY,NX) + ZHPW(NY,NX)=ZHPW(NY,NX)+XH2PBS(NY,NX) + IF(ISALT(NY,NX).NE.0)THEN + ZALW(NY,NX)=ZALW(NY,NX)+XALBLS(NY,NX) + ZFEW(NY,NX)=ZFEW(NY,NX)+XFEBLS(NY,NX) + ZHYW(NY,NX)=ZHYW(NY,NX)+XHYBLS(NY,NX) + ZCAW(NY,NX)=ZCAW(NY,NX)+XCABLS(NY,NX) + ZMGW(NY,NX)=ZMGW(NY,NX)+XMGBLS(NY,NX) + ZNAW(NY,NX)=ZNAW(NY,NX)+XNABLS(NY,NX) + ZKAW(NY,NX)=ZKAW(NY,NX)+XKABLS(NY,NX) + ZOHW(NY,NX)=ZOHW(NY,NX)+XOHBLS(NY,NX) + ZSO4W(NY,NX)=ZSO4W(NY,NX)+XSOBLS(NY,NX) + ZCLW(NY,NX)=ZCLW(NY,NX)+XCLBLS(NY,NX) + ZCO3W(NY,NX)=ZCO3W(NY,NX)+XC3BLS(NY,NX) + ZHCO3W(NY,NX)=ZHCO3W(NY,NX)+XHCBLS(NY,NX) + ZALH1W(NY,NX)=ZALH1W(NY,NX)+XAL1BS(NY,NX) + ZALH2W(NY,NX)=ZALH2W(NY,NX)+XAL2BS(NY,NX) + ZALH3W(NY,NX)=ZALH3W(NY,NX)+XAL3BS(NY,NX) + ZALH4W(NY,NX)=ZALH4W(NY,NX)+XAL4BS(NY,NX) + ZALSW(NY,NX)=ZALSW(NY,NX)+XALSBS(NY,NX) + ZFEH1W(NY,NX)=ZFEH1W(NY,NX)+XFE1BS(NY,NX) + ZFEH2W(NY,NX)=ZFEH2W(NY,NX)+XFE2BS(NY,NX) + ZFEH3W(NY,NX)=ZFEH3W(NY,NX)+XFE3BS(NY,NX) + ZFEH4W(NY,NX)=ZFEH4W(NY,NX)+XFE4BS(NY,NX) + ZFESW(NY,NX)=ZFESW(NY,NX)+XFESBS(NY,NX) + ZCAOW(NY,NX)=ZCAOW(NY,NX)+XCAOBS(NY,NX) + ZCACW(NY,NX)=ZCACW(NY,NX)+XCACBS(NY,NX) + ZCAHW(NY,NX)=ZCAHW(NY,NX)+XCAHBS(NY,NX) + ZCASW(NY,NX)=ZCASW(NY,NX)+XCASBS(NY,NX) + ZMGOW(NY,NX)=ZMGOW(NY,NX)+XMGOBS(NY,NX) + ZMGCW(NY,NX)=ZMGCW(NY,NX)+XMGCBS(NY,NX) + ZMGHW(NY,NX)=ZMGHW(NY,NX)+XMGHBS(NY,NX) + ZMGSW(NY,NX)=ZMGSW(NY,NX)+XMGSBS(NY,NX) + ZNACW(NY,NX)=ZNACW(NY,NX)+XNACBS(NY,NX) + ZNASW(NY,NX)=ZNASW(NY,NX)+XNASBS(NY,NX) + ZKASW(NY,NX)=ZKASW(NY,NX)+XKASBS(NY,NX) + H0PO4W(NY,NX)=H0PO4W(NY,NX)+XH0PBS(NY,NX) + H3PO4W(NY,NX)=H3PO4W(NY,NX)+XH3PBS(NY,NX) + ZFE1PW(NY,NX)=ZFE1PW(NY,NX)+XF1PBS(NY,NX) + ZFE2PW(NY,NX)=ZFE2PW(NY,NX)+XF2PBS(NY,NX) + ZCA0PW(NY,NX)=ZCA0PW(NY,NX)+XC0PBS(NY,NX) + ZCA1PW(NY,NX)=ZCA1PW(NY,NX)+XC1PBS(NY,NX) + ZCA2PW(NY,NX)=ZCA2PW(NY,NX)+XC2PBS(NY,NX) + ZMG1PW(NY,NX)=ZMG1PW(NY,NX)+XM1PBS(NY,NX) + ENDIF +C +C CALCULATE SNOWPACK TEMPERATURE FROM ITS CHANGE +C IN HEAT STORAGE +C + VHCPW(NY,NX)=2.095*VOLSS(NY,NX)+4.19*VOLWS(NY,NX) + 2+1.9274*VOLIS(NY,NX) +C VHCPX=VHCPW(NY,NX) + VOLSS(NY,NX)=VOLSS(NY,NX)+TFLWS(NY,NX)+TQS(NY,NX) + VOLWS(NY,NX)=VOLWS(NY,NX)+TFLWW(NY,NX)+TQW(NY,NX) + VOLIS(NY,NX)=VOLIS(NY,NX)+TFLWI(NY,NX)+TQI(NY,NX) + DENSS=AMIN1(0.6,DENS0(NY,NX)+DENS1(NY,NX)*VOLSS(NY,NX) + 2/AREA(3,NU(NY,NX),NY,NX)) + VOLS(NY,NX)=VOLSS(NY,NX)/DENSS+VOLWS(NY,NX)+VOLIS(NY,NX) + ENGYW=VHCPW(NY,NX)*TKW(NY,NX) + VHCPW(NY,NX)=2.095*VOLSS(NY,NX)+4.19*VOLWS(NY,NX) + 2+1.9274*VOLIS(NY,NX) + DPTHS(NY,NX)=AMAX1(0.0,VOLS(NY,NX))/AREA(3,NU(NY,NX),NY,NX) + IF(VHCPW(NY,NX).GT.VHCPWX(NY,NX))THEN + TKW(NY,NX)=(ENGYW+THFLWW(NY,NX)+THQS(NY,NX))/VHCPW(NY,NX) + ELSEIF(VHCPW(NY,NX).GT.ZEROS(NY,NX))THEN + TKWX=(ENGYW+THFLWW(NY,NX)+THQS(NY,NX))/VHCPW(NY,NX) + HFLXW=VHCPW(NY,NX)*(TKWX-TKA(NY,NX)) + HEATOU=HEATOU+HFLXW + TKW(NY,NX)=TKA(NY,NX) + ELSE + TKW(NY,NX)=TKA(NY,NX) + ENDIF + TCW(NY,NX)=TKW(NY,NX)-273.15 +C IF(NX.EQ.2.AND.NY.EQ.2)THEN +C WRITE(*,8483)'TKWH',I,J,NX,NY,TKW(NY,NX),ENGYW,THFLWW(NY,NX) +C 2,THQS(NY,NX),VHCPW(NY,NX),VHCPX,VOLSS(NY,NX),VOLWS(NY,NX) +C 2,VOLIS(NY,NX),TFLWS(NY,NX),TQS(NY,NX),TFLWW(NY,NX),TQW(NY,NX) +C 3,TFLWI(NY,NX),TQI(NY,NX),VOLS(NY,NX) +8483 FORMAT(A8,4I4,20E12.4) +C ENDIF +C +C SNOWPACK VARIABLES NEEDED FOR WATER, C, N, P, O, SOLUTE AND +C ENERGY BALANCES INCLUDING SUM OF ALL CURRENT STATE VARIABLES, +C CUMULATIVE SUMS OF ALL ADDITIONS AND REMOVALS SINCE START OF RUN +C +C IF(J.EQ.24)THEN + WS=VOLSS(NY,NX)+VOLWS(NY,NX)+VOLIS(NY,NX)*DENSI + VOLWSO=VOLWSO+WS + UVOLW(NY,NX)=UVOLW(NY,NX)+WS + HEATSO=HEATSO+VHCPW(NY,NX)*TKW(NY,NX) + TLCO2G=TLCO2G+CO2W(NY,NX)+CH4W(NY,NX) + UCO2S(NY,NX)=UCO2S(NY,NX)+CO2W(NY,NX)+CH4W(NY,NX) + OXYGSO=OXYGSO+OXYW(NY,NX) + TLH2G=TLH2G+H2GW(NY,NX) + TLN2G=TLN2G+ZNGW(NY,NX)+ZN2W(NY,NX) + TLNH4=TLNH4+ZN4W(NY,NX)+ZN3W(NY,NX) + TLNO3=TLNO3+ZNOW(NY,NX) + TLPO4=TLPO4+Z1PW(NY,NX)+ZHPW(NY,NX) + IF(ISALT(NY,NX).NE.0)THEN + SSW=ZALW(NY,NX)+ZFEW(NY,NX)+ZHYW(NY,NX)+ZCAW(NY,NX) + 2+ZMGW(NY,NX)+ZNAW(NY,NX)+ZKAW(NY,NX)+ZOHW(NY,NX) + 3+ZSO4W(NY,NX)+ZCLW(NY,NX)+ZCO3W(NY,NX)+H0PO4W(NY,NX) + 4+2.0*(ZHCO3W(NY,NX)+ZALH1W(NY,NX) + 5+ZALSW(NY,NX)+ZFEH1W(NY,NX)+ZFESW(NY,NX)+ZCAOW(NY,NX) + 6+ZCACW(NY,NX)+ZCASW(NY,NX)+ZMGOW(NY,NX)+ZMGCW(NY,NX) + 7+ZMGSW(NY,NX)+ZNACW(NY,NX)+ZNASW(NY,NX)+ZKASW(NY,NX) + 8+ZCA0PW(NY,NX)) + 9+3.0*(ZALH2W(NY,NX)+ZFEH2W(NY,NX)+ZCAHW(NY,NX) + 1+ZMGHW(NY,NX)+ZFE1PW(NY,NX)+ZCA1PW(NY,NX)+ZMG1PW(NY,NX)) + 2+4.0*(ZALH3W(NY,NX)+ZFEH3W(NY,NX)+H3PO4W(NY,NX)+ZFE2PW(NY,NX) + 4+ZCA2PW(NY,NX)) + 5+5.0*(ZALH4W(NY,NX)+ZFEH4W(NY,NX)) + TION=TION+SSW + ENDIF +C ENDIF +C +C ADD ABOVE-GROUND LITTERFALL FROM 'EXTRACT' TO SURFACE RESIDUE +C + OSGX=ORGC(0,NY,NX) +C +C ADD PLANT C,N,P IN ABOVE-GROUND LITTERFALL TO C,N,P +C IN SURFACE RESIDUE +C + DO 6965 K=0,1 + DO 6965 M=1,4 + OSC(M,K,0,NY,NX)=OSC(M,K,0,NY,NX)+CSNT(M,K,0,NY,NX) + OSN(M,K,0,NY,NX)=OSN(M,K,0,NY,NX)+ZSNT(M,K,0,NY,NX) + OSP(M,K,0,NY,NX)=OSP(M,K,0,NY,NX)+PSNT(M,K,0,NY,NX) +C IF((I/30)*30.EQ.I.AND.J.EQ.15)THEN +C WRITE(*,8486)'OSC0',I,J,L,K,M,OSC(M,K,0,NY,NX) +C 2,OSN(M,K,0,NY,NX),OSP(M,K,0,NY,NX),CSNT(M,K,0,NY,NX) +C 3,ZSNT(M,K,0,NY,NX),PSNT(M,K,0,NY,NX) +8486 FORMAT(A8,5I4,12E12.4) +C ENDIF +6965 CONTINUE +C +C GAS AND SOLUTE EXCHANGE WITHIN SURFACE RESIDUE ADDED TO ECOSYSTEM +C TOTALS FOR CALCULATING COMPETITION CONSTRAINTS ON MICROBIAL +C AND ROOT POPULATIONS +C + DO 8990 K=0,5 + IF(K.NE.3.AND.K.NE.4)THEN + DO 8980 N=1,7 + ROXYX(0,NY,NX)=ROXYX(0,NY,NX)+ROXYS(N,K,0,NY,NX) + RNH4X(0,NY,NX)=RNH4X(0,NY,NX)+RVMX4(N,K,0,NY,NX) + RNO3X(0,NY,NX)=RNO3X(0,NY,NX)+RVMX3(N,K,0,NY,NX) + RNO2X(0,NY,NX)=RNO2X(0,NY,NX)+RVMX2(N,K,0,NY,NX) + RN2OX(0,NY,NX)=RN2OX(0,NY,NX)+RVMX1(N,K,0,NY,NX) + RNH4X(0,NY,NX)=RNH4X(0,NY,NX)+RINHO(N,K,0,NY,NX) + RNO3X(0,NY,NX)=RNO3X(0,NY,NX)+RINOO(N,K,0,NY,NX) + RPO4X(0,NY,NX)=RPO4X(0,NY,NX)+RIPOO(N,K,0,NY,NX) + RP14X(0,NY,NX)=RP14X(0,NY,NX)+RIPO1(N,K,0,NY,NX) + RNH4X(NU(NY,NX),NY,NX)=RNH4X(NU(NY,NX),NY,NX)+RINHOR(N,K,NY,NX) + RNO3X(NU(NY,NX),NY,NX)=RNO3X(NU(NY,NX),NY,NX)+RINOOR(N,K,NY,NX) + RPO4X(NU(NY,NX),NY,NX)=RPO4X(NU(NY,NX),NY,NX)+RIPOOR(N,K,NY,NX) + RP14X(NU(NY,NX),NY,NX)=RP14X(NU(NY,NX),NY,NX)+RIPO1R(N,K,NY,NX) + IF(K.LE.4)THEN + ROQCX(K,0,NY,NX)=ROQCX(K,0,NY,NX)+ROQCS(N,K,0,NY,NX) + ROQAX(K,0,NY,NX)=ROQAX(K,0,NY,NX)+ROQAS(N,K,0,NY,NX) + ENDIF +8980 CONTINUE + ENDIF +8990 CONTINUE + RNO2X(0,NY,NX)=RNO2X(0,NY,NX)+RVMXC(0,NY,NX) +C +C ADD RESIDUE C,N,P TO SUBSURFACE SEDIMENT BELOW A POND SURFACE +C + IF(BKDS(NU(NY,NX),NY,NX).EQ.0.0.AND.ORGC(0,NY,NX).GT.0.0)THEN + OSGX=ORGC(0,NY,NX) + RC=0.0 + RN=0.0 + RP=0.0 + DO 1970 K=0,5 + IF(K.NE.3.AND.K.NE.4)THEN +C +C MICROBIAL C,N,P +C + DO 1960 N=1,7 + DO 1960 M=1,3 + OMC(M,N,K,NW(NY,NX),NY,NX)=OMC(M,N,K,NW(NY,NX),NY,NX) + 2+OMC(M,N,K,0,NY,NX) + OMN(M,N,K,NW(NY,NX),NY,NX)=OMN(M,N,K,NW(NY,NX),NY,NX) + 2+OMN(M,N,K,0,NY,NX) + OMP(M,N,K,NW(NY,NX),NY,NX)=OMP(M,N,K,NW(NY,NX),NY,NX) + 2+OMP(M,N,K,0,NY,NX) + RC=RC+OMC(M,N,K,0,NY,NX) + RN=RN+OMN(M,N,K,0,NY,NX) + RP=RP+OMP(M,N,K,0,NY,NX) + OMC(M,N,K,0,NY,NX)=0.0 + OMN(M,N,K,0,NY,NX)=0.0 + OMP(M,N,K,0,NY,NX)=0.0 +1960 CONTINUE + ENDIF +1970 CONTINUE +C +C MICROBIAL RESIDUE C,N,P +C + DO 1900 K=0,2 + DO 1940 M=1,2 + ORC(M,K,NW(NY,NX),NY,NX)=ORC(M,K,NW(NY,NX),NY,NX)+ORC(M,K,0,NY,NX) + ORN(M,K,NW(NY,NX),NY,NX)=ORN(M,K,NW(NY,NX),NY,NX)+ORN(M,K,0,NY,NX) + ORP(M,K,NW(NY,NX),NY,NX)=ORP(M,K,NW(NY,NX),NY,NX)+ORP(M,K,0,NY,NX) + RC=RC+ORC(M,K,0,NY,NX) + RN=RN+ORN(M,K,0,NY,NX) + RP=RP+ORP(M,K,0,NY,NX) + ORC(M,K,0,NY,NX)=0.0 + ORN(M,K,0,NY,NX)=0.0 + ORP(M,K,0,NY,NX)=0.0 +1940 CONTINUE +C +C DOC, DON, DOP +C + OQC(K,NW(NY,NX),NY,NX)=OQC(K,NW(NY,NX),NY,NX)+OQC(K,0,NY,NX) + OQN(K,NW(NY,NX),NY,NX)=OQN(K,NW(NY,NX),NY,NX)+OQN(K,0,NY,NX) + OQP(K,NW(NY,NX),NY,NX)=OQP(K,NW(NY,NX),NY,NX)+OQP(K,0,NY,NX) + OQA(K,NW(NY,NX),NY,NX)=OQA(K,NW(NY,NX),NY,NX)+OQA(K,0,NY,NX) + RC=RC+OQC(K,0,NY,NX)+OQA(K,0,NY,NX) + RN=RN+OQN(K,0,NY,NX) + RP=RP+OQP(K,0,NY,NX) + OQC(K,0,NY,NX)=0.0 + OQN(K,0,NY,NX)=0.0 + OQP(K,0,NY,NX)=0.0 + OQA(K,0,NY,NX)=0.0 + OQCH(K,NW(NY,NX),NY,NX)=OQCH(K,NW(NY,NX),NY,NX)+OQCH(K,0,NY,NX) + OQNH(K,NW(NY,NX),NY,NX)=OQNH(K,NW(NY,NX),NY,NX)+OQNH(K,0,NY,NX) + OQPH(K,NW(NY,NX),NY,NX)=OQPH(K,NW(NY,NX),NY,NX)+OQPH(K,0,NY,NX) + OQAH(K,NW(NY,NX),NY,NX)=OQAH(K,NW(NY,NX),NY,NX)+OQAH(K,0,NY,NX) + RC=RC+OQCH(K,0,NY,NX)+OQAH(K,0,NY,NX) + RN=RN+OQNH(K,0,NY,NX) + RP=RP+OQPH(K,0,NY,NX) + OQCH(K,0,NY,NX)=0.0 + OQNH(K,0,NY,NX)=0.0 + OQPH(K,0,NY,NX)=0.0 + OQAH(K,0,NY,NX)=0.0 +C +C ADSORBED C,N,P +C + OHC(K,NW(NY,NX),NY,NX)=OHC(K,NW(NY,NX),NY,NX)+OHC(K,0,NY,NX) + OHN(K,NW(NY,NX),NY,NX)=OHN(K,NW(NY,NX),NY,NX)+OHN(K,0,NY,NX) + OHP(K,NW(NY,NX),NY,NX)=OHP(K,NW(NY,NX),NY,NX)+OHP(K,0,NY,NX) + OHA(K,NW(NY,NX),NY,NX)=OHA(K,NW(NY,NX),NY,NX)+OHA(K,0,NY,NX) + RC=RC+OHC(K,0,NY,NX)+OHA(K,0,NY,NX) + RN=RN+OHN(K,0,NY,NX) + RP=RP+OHP(K,0,NY,NX) + OHC(K,0,NY,NX)=0.0 + OHN(K,0,NY,NX)=0.0 + OHP(K,0,NY,NX)=0.0 + OHA(K,0,NY,NX)=0.0 +C +C PLANT RESIDUE C,N,P +C + DO 1930 M=1,4 + OSC(M,K,NW(NY,NX),NY,NX)=OSC(M,K,NW(NY,NX),NY,NX)+OSC(M,K,0,NY,NX) + OSA(M,K,NW(NY,NX),NY,NX)=OSA(M,K,NW(NY,NX),NY,NX)+OSA(M,K,0,NY,NX) + OSN(M,K,NW(NY,NX),NY,NX)=OSN(M,K,NW(NY,NX),NY,NX)+OSN(M,K,0,NY,NX) + OSP(M,K,NW(NY,NX),NY,NX)=OSP(M,K,NW(NY,NX),NY,NX)+OSP(M,K,0,NY,NX) + RC=RC+OSC(M,K,0,NY,NX) + RN=RN+OSN(M,K,0,NY,NX) + RP=RP+OSP(M,K,0,NY,NX) + OSC(M,K,0,NY,NX)=0.0 + OSA(M,K,0,NY,NX)=0.0 + OSN(M,K,0,NY,NX)=0.0 + OSP(M,K,0,NY,NX)=0.0 +1930 CONTINUE +1900 CONTINUE + TLRSDC=TLRSDC-RC + TLRSDN=TLRSDN-RN + TLRSDP=TLRSDP-RP + URSDC(NY,NX)=URSDC(NY,NX)-RC + URSDN(NY,NX)=URSDN(NY,NX)-RN + URSDP(NY,NX)=URSDP(NY,NX)-RP + ORGC(0,NY,NX)=0.0 + ORGN(0,NY,NX)=0.0 + ORGR(0,NY,NX)=0.0 +C +C ADD RESIDUE SOLUTES TO SUBSURFACE SEDIMENT BELOW A POND SURFACE +C +C CO2S(NW(NY,NX),NY,NX)=CO2S(NW(NY,NX),NY,NX)+CO2S(0,NY,NX) +C CH4S(NW(NY,NX),NY,NX)=CH4S(NW(NY,NX),NY,NX)+CH4S(0,NY,NX) +C OXYS(NW(NY,NX),NY,NX)=OXYS(NW(NY,NX),NY,NX)+OXYS(0,NY,NX) +C Z2GS(NW(NY,NX),NY,NX)=Z2GS(NW(NY,NX),NY,NX)+Z2GS(0,NY,NX) +C Z2OS(NW(NY,NX),NY,NX)=Z2OS(NW(NY,NX),NY,NX)+Z2OS(0,NY,NX) +C H2GS(NW(NY,NX),NY,NX)=H2GS(NW(NY,NX),NY,NX)+H2GS(0,NY,NX) +C ZNH4S(NW(NY,NX),NY,NX)=ZNH4S(NW(NY,NX),NY,NX)+ZNH4S(0,NY,NX) +C ZNH3S(NW(NY,NX),NY,NX)=ZNH3S(NW(NY,NX),NY,NX)+ZNH3S(0,NY,NX) +C ZNO3S(NW(NY,NX),NY,NX)=ZNO3S(NW(NY,NX),NY,NX)+ZNO3S(0,NY,NX) +C H1PO4(NW(NY,NX),NY,NX)=H1PO4(NW(NY,NX),NY,NX)+H1PO4(0,NY,NX) +C H2PO4(NW(NY,NX),NY,NX)=H2PO4(NW(NY,NX),NY,NX)+H2PO4(0,NY,NX) +C ZNO2S(NW(NY,NX),NY,NX)=ZNO2S(NW(NY,NX),NY,NX)+ZNO2S(0,NY,NX) +C CS=CO2S(0,NY,NX)+CH4S(0,NY,NX) +C TLCO2G=TLCO2G-CS +C UCO2S(NY,NX)=UCO2S(NY,NX)-CS +C OS=OXYS(0,NY,NX) +C OXYGSO=OXYGSO-OS +C ZG=Z2GS(0,NY,NX)+Z2OS(0,NY,NX) +C TLN2G=TLN2G-ZG +C ZSH=ZNH4S(0,NY,NX)+ZNH3S(0,NY,NX) +C ZX=14.0*XN4(0,NY,NX) +C TLNH4=TLNH4-ZS-ZX +C UNH4(NY,NX)=UNH4(NY,NX)-ZS-ZX +C ZNO=ZNO3S(0,NY,NX)+ZNO2S(0,NY,NX) +C TLNO3=TLNO3-ZNO +C UNO3(NY,NX)=UNO3(NY,NX)-ZNO +C PS=H1PO4(0,NY,NX)+H2PO4(0,NY,NX) +C PX=31.0*(XH1P(0,NY,NX)+XH2P(0,NY,NX)) +C TLPO4=TLPO4-P4 +C UPO4(NY,NX)=UPO4(NY,NX)-PX +C CO2S(0,NY,NX)=0.0 +C CH4S(0,NY,NX)=0.0 +C OXYS(0,NY,NX)=0.0 +C Z2GS(0,NY,NX)=0.0 +C Z2OS(0,NY,NX)=0.0 +C H2GS(0,NY,NX)=0.0 +C ZNH4S(0,NY,NX)=0.0 +C ZNH3S(0,NY,NX)=0.0 +C ZNO3S(0,NY,NX)=0.0 +C H1PO4(0,NY,NX)=0.0 +C H2PO4(0,NY,NX)=0.0 +C ZNO2S(0,NY,NX)=0.0 + ENDIF +C +C RUNOFF AND SUBSURFACE BOUNDARY FLUXES +C + DO 9985 L=NU(NY,NX),NL(NY,NX) +C +C LOCATE EXTERNAL BOUNDARIES +C + DO 9980 N=1,3 + DO 9975 NN=1,2 + IF(N.EQ.1)THEN + IF(NN.EQ.1)THEN + IF(NX.EQ.NHE)THEN + N4=NX+1 + N5=NY + N6=L + XN=-1.0 + ELSE + GO TO 9975 + ENDIF + ELSEIF(NN.EQ.2)THEN + IF(NX.EQ.NHW)THEN + N4=NX + N5=NY + N6=L + XN=1.0 + ELSE + GO TO 9975 + ENDIF + ENDIF + ELSEIF(N.EQ.2)THEN + IF(NN.EQ.1)THEN + IF(NY.EQ.NVS)THEN + N4=NX + N5=NY+1 + N6=L + XN=-1.0 + ELSE + GO TO 9975 + ENDIF + ELSEIF(NN.EQ.2)THEN + IF(NY.EQ.NVN)THEN + N4=NX + N5=NY + N6=L + XN=1.0 + ELSE + GO TO 9975 + ENDIF + ENDIF + ELSEIF(N.EQ.3)THEN + IF(NN.EQ.1)THEN + IF(L.EQ.NL(NY,NX))THEN + N4=NX + N5=NY + N6=L+1 + XN=-1.0 + ELSE + GO TO 9975 + ENDIF + ELSEIF(NN.EQ.2)THEN + GO TO 9975 + ENDIF + ENDIF +C +C RUNOFF BOUNDARY FLUXES OF WATER AND HEAT +C + IF(L.EQ.NU(NY,NX).AND.N.NE.3)THEN + WQR=XN*(QR(N,N5,N4)+QS(N,N5,N4)+QW(N,N5,N4)+QI(N,N5,N4)) + IF(WQR.NE.0.0)THEN + CRUN=CRUN-WQR + URUN(NY,NX)=URUN(NY,NX)-WQR + HEATOU=HEATOU-XN*(HQR(N,N5,N4)+HQS(N,N5,N4)) +C +C RUNOFF BOUNDARY FLUXES OF C, N AND P +C + CXR=XN*(XCOQRS(N,N5,N4)+XCHQRS(N,N5,N4) + 2+XCOQSS(N,N5,N4)+XCHQSS(N,N5,N4)) + CQR=0.0 + DO 2575 K=0,4 + CQR=CQR+XN*(XOCQRS(K,N,N5,N4)+XOAQRS(K,N,N5,N4)) +2575 CONTINUE + TCOU=TCOU-CQR-CXR + TNBP(NY,NX)=TNBP(NY,NX)+CQR+CXR + UDOCQ(NY,NX)=UDOCQ(NY,NX)-CQR + UDICQ(NY,NX)=UDICQ(NY,NX)-CXR + OXR=XN*(XOXQRS(N,N5,N4)+XOXQSS(N,N5,N4)) + OXYGOU=OXYGOU-OXR + HGR=XN*XHGQRS(N,N5,N4) + H2GOU=H2GOU+HGR + ZXR=XN*(XN4QRW(N,N5,N4)+XN3QRW(N,N5,N4) + 2+XNOQRW(N,N5,N4)+XNXQRS(N,N5,N4)+XN4QSS(N,N5,N4) + 3+XN3QSS(N,N5,N4)+XNOQSS(N,N5,N4)) + ZGR=XN*(XN2QRS(N,N5,N4)+XNGQRS(N,N5,N4) + 2+XN2QSS(N,N5,N4)+XNGQSS(N,N5,N4)) + ZOR=0.0 + DO 2875 K=0,4 + ZOR=ZOR+XN*XONQRS(K,N,N5,N4) +2875 CONTINUE + TZOU=TZOU-ZXR-ZGR-ZOR + UDONQ(NY,NX)=UDONQ(NY,NX)-ZOR + UDINQ(NY,NX)=UDINQ(NY,NX)-ZXR + PXR=XN*(XP4QRW(N,N5,N4)+XP4QSS(N,N5,N4) + 2+XP1QRW(N,N5,N4)+XP1QSS(N,N5,N4)) + POR=0.0 + DO 2775 K=0,4 + POR=POR+XN*XOPQRS(K,N,N5,N4) +2775 CONTINUE + TPOU=TPOU-PXR-POR + UDOPQ(NY,NX)=UDOPQ(NY,NX)-POR + UDIPQ(NY,NX)=UDIPQ(NY,NX)-PXR +C +C RUNOFF BOUNDARY FLUXES OF SOLUTES +C + IF(ISALT(N5,N4).NE.0)THEN + PSS=XN*31.0*(XQRH0P(N,N5,N4)+XQSH0P(N,N5,N4)+XQRC0P(N,N5,N4) + 2+XQSC0P(N,N5,N4)+XQRF1P(N,N5,N4)+XQRC1P(N,N5,N4)+XQRM1P(N,N5,N4) + 3+XQSF1P(N,N5,N4)+XQSC1P(N,N5,N4)+XQSM1P(N,N5,N4)+XQRH3P(N,N5,N4) + 4+XQRF2P(N,N5,N4)+XQRC2P(N,N5,N4)+XQSH3P(N,N5,N4)+XQSF2P(N,N5,N4) + 5+XQSC2P(N,N5,N4)) + TPOU=TPOU-PSS + SS1=XN*(XQRAL(N,N5,N4)+XQRFE(N,N5,N4)+XQRHY(N,N5,N4) + 2+XQRCA(N,N5,N4)+XQRMG(N,N5,N4)+XQRNA(N,N5,N4)+XQRKA(N,N5,N4) + 3+XQROH(N,N5,N4)+XQRSO(N,N5,N4)+XQRCL(N,N5,N4)+XQRC3(N,N5,N4) + 4+XQRH0P(N,N5,N4)+XQSAL(N,N5,N4)+XQSFE(N,N5,N4) + 5+XQSHY(N,N5,N4)+XQSCA(N,N5,N4)+XQSMG(N,N5,N4)+XQSNA(N,N5,N4) + 6+XQSKA(N,N5,N4)+XQSOH(N,N5,N4)+XQSSO(N,N5,N4)+XQSCL(N,N5,N4) + 3+XQSC3(N,N5,N4)+XQSH0P(N,N5,N4)) + SS2=XN*2.0*(XQRHC(N,N5,N4)+XQRAL1(N,N5,N4)+XQRALS(N,N5,N4) + 2+XQRFE1(N,N5,N4)+XQRFES(N,N5,N4)+XQRCAO(N,N5,N4)+XQRCAC(N,N5,N4) + 3+XQRCAS(N,N5,N4)+XQRMGO(N,N5,N4)+XQRMGC(N,N5,N4)+XQRMGS(N,N5,N4) + 4+XQRNAC(N,N5,N4)+XQRNAS(N,N5,N4)+XQRKAS(N,N5,N4) + 5+XQRC0P(N,N5,N4)+XQSHC(N,N5,N4)+XQSAL1(N,N5,N4)+XQSALS(N,N5,N4) + 2+XQSFE1(N,N5,N4)+XQSFES(N,N5,N4)+XQSCAO(N,N5,N4)+XQSCAC(N,N5,N4) + 3+XQSCAS(N,N5,N4)+XQSMGO(N,N5,N4)+XQSMGC(N,N5,N4)+XQSMGS(N,N5,N4) + 4+XQSNAC(N,N5,N4)+XQSNAS(N,N5,N4)+XQSKAS(N,N5,N4)+XQSC0P(N,N5,N4)) + SS3=XN*3.0*(XQRAL2(N,N5,N4)+XQRFE2(N,N5,N4)+XQRCAH(N,N5,N4) + 2+XQRMGH(N,N5,N4)+XQRF1P(N,N5,N4)+XQRC1P(N,N5,N4)+XQRM1P(N,N5,N4) + 3+XQSAL2(N,N5,N4)+XQSFE2(N,N5,N4)+XQSCAH(N,N5,N4)+XQSMGH(N,N5,N4) + 2+XQSF1P(N,N5,N4)+XQSC1P(N,N5,N4)+XQSM1P(N,N5,N4)) + SS4=XN*4.0*(XQRAL3(N,N5,N4)+XQRFE3(N,N5,N4)+XQRH3P(N,N5,N4) + 2+XQRF2P(N,N5,N4)+XQRC2P(N,N5,N4)+XQSAL3(N,N5,N4)+XQSFE3(N,N5,N4) + 3+XQSH3P(N,N5,N4)+XQSF2P(N,N5,N4)+XQSC2P(N,N5,N4)) + 5+XN*5.0*(XQRAL4(N,N5,N4)+XQRFE4(N,N5,N4) + 6+XQSAL4(N,N5,N4)+XQSFE4(N,N5,N4)) + SSR=SS1+SS2+SS3+SS4 + TIONOU=TIONOU-SSR + UIONOU(NY,NX)=UIONOU(NY,NX)-SSR +C WRITE(20,3336)'SSR',I,J,N,N5,N4,SSR,SS1,SS2,SS3,SS4,TIONOU +3336 FORMAT(A8,5I6,20F16.9) +C +C SURFACE FLUX ELECTRICAL CONDUCTIVITY +C + WX=QR(N,N5,N4) + IF(WX.NE.0.0)THEN + ECHY=0.337*AMAX1(0.0,XQRHY(N,N5,N4)/WX) + ECOH=0.192*AMAX1(0.0,XQROH(N,N5,N4)/WX) + ECAL=0.056*AMAX1(0.0,XQRAL(N,N5,N4)*3.0/WX) + ECFE=0.051*AMAX1(0.0,XQRFE(N,N5,N4)*3.0/WX) + ECCA=0.060*AMAX1(0.0,XQRCA(N,N5,N4)*2.0/WX) + ECMG=0.053*AMAX1(0.0,XQRMG(N,N5,N4)*2.0/WX) + ECNA=0.050*AMAX1(0.0,XQRNA(N,N5,N4)/WX) + ECKA=0.070*AMAX1(0.0,XQRKA(N,N5,N4)/WX) + ECCO=0.072*AMAX1(0.0,XQRC3(N,N5,N4)*2.0/WX) + ECHC=0.044*AMAX1(0.0,XQRHC(N,N5,N4)/WX) + ECSO=0.080*AMAX1(0.0,XQRSO(N,N5,N4)*2.0/WX) + ECCL=0.076*AMAX1(0.0,XQRCL(N,N5,N4)/WX) + ECNO=0.071*AMAX1(0.0,XNOQRW(N,N5,N4)/(WX*14.0)) + ECNDQ=ECHY+ECOH+ECAL+ECFE+ECCA+ECMG+ECNA+ECKA + 2+ECCO+ECHC+ECSO+ECCL+ECNO +C WRITE(*,9991)'ECNDQ',IYRC,I,J,N4,N5,N6,N,WX,ECNDQ +9991 FORMAT(A8,7I4,2E12.4) + ELSE + ECNDQ=0.0 + ENDIF + ENDIF +C +C RUNOFF BOUNDARY FLUXES OF SEDIMENT +C + IF(IERSN(N5,N4).NE.0)THEN + ER=XN*(XSANER(N,N5,N4)+XSILER(N,N5,N4)+XCLAER(N,N5,N4)) + TSEDOU=TSEDOU-ER + USEDOU(NY,NX)=USEDOU(NY,NX)-ER +C +C MICROBIAL C IN RUNOFF SEDIMENT +C + CQE=0.0 + CXE=0.0 + DO 3580 K=0,5 + DO 3580 NO=1,7 + DO 3580 M=1,3 + CQE=CQE+XN*OMCER(M,NO,K,N,N5,N4) +3580 CONTINUE +C +C MICROBIAL RESIDUE C IN RUNOFF SEDIMENT +C + DO 3575 K=0,4 + DO 3570 M=1,2 + CQE=CQE+XN*ORCER(M,K,N,N5,N4) +3570 CONTINUE +C +C DOC, ADSORBED AND HUMUS C IN RUNOFF SEDIMENT +C + CQE=CQE+XN*OHCER(K,N,N5,N4) + DO 3565 M=1,4 + CQE=CQE+XN*OSCER(M,K,N,N5,N4) +3565 CONTINUE +3575 CONTINUE + TCOU=TCOU-CQE-CXE + UDOCQ(NY,NX)=UDOCQ(NY,NX)-CQE + UDICQ(NY,NX)=UDICQ(NY,NX)-CXE + TSEDOU=TSEDOU-CQE*1.0E-06 + USEDOU(NY,NX)=USEDOU(NY,NX)-CQE*1.0E-06 + TNBP(NY,NX)=TNBP(NY,NX)+CQE+CXE +C +C MICROBIAL N IN RUNOFF SEDIMENT +C + ZXE=0.0 + ZGE=0.0 + ZQE=0.0 + DO 6880 K=0,5 + DO 6880 NO=1,7 + DO 6880 M=1,2 + ZQE=ZQE+XN*OMNER(M,NO,K,N,N5,N4) +6880 CONTINUE +C +C MICROBIAL RESIDUE N IN RUNOFF SEDIMENT +C + DO 6875 K=0,4 + DO 6870 M=1,2 + ZQE=ZQE+XN*ORNER(M,K,N,N5,N4) +6870 CONTINUE +C +C DON, ADSORBED AND HUMUS N IN RUNOFF SEDIMENT +C + ZQE=ZQE+XN*OHNER(K,N,N5,N4) + DO 6865 M=1,4 + ZQE=ZQE+XN*OSNER(M,K,N,N5,N4) +6865 CONTINUE +6875 CONTINUE + TZOU=TZOU-ZQE-ZXE-ZGE + UDONQ(NY,NX)=UDONQ(NY,NX)-ZQE + UDINQ(NY,NX)=UDINQ(NY,NX)-ZXE +C +C MICROBIAL P IN RUNOFF SEDIMENT +C + PXE=0.0 + PQE=0.0 + DO 6780 K=0,5 + DO 6780 NO=1,7 + DO 6780 M=1,2 + PQE=PQE+XN*OMPER(M,NO,K,N,N5,N4) +6780 CONTINUE +C +C MICROBIAL RESIDUE P IN RUNOFF SEDIMENT +C + DO 6775 K=0,4 + DO 6770 M=1,2 + PQE=PQE+XN*ORPER(M,K,N,N5,N4) +6770 CONTINUE +C +C DOP, ADSORBED AND HUMUS P IN RUNOFF SEDIMENT +C + PQE=PQE+XN*OHPER(K,N,N5,N4) + DO 6765 M=1,4 + PQE=PQE+XN*OSPER(M,K,N,N5,N4) +6765 CONTINUE +6775 CONTINUE + TPOU=TPOU-PQE-PXE + UDOPQ(NY,NX)=UDOPQ(NY,NX)-PQE + UDIPQ(NY,NX)=UDIPQ(NY,NX)-PXE +C +C SOLUTES IN RUNOFF SEDIMENTS +C + IF(ISALT(NY,NX).NE.0)THEN + SQ1=XN*(XOH0ER(N,N5,N4) + 5+XOH0EB(N,N5,N4)+XHYER(N,N5,N4)+XALER(N,N5,N4)+XCAER(N,N5,N4) + 6+XMGER(N,N5,N4)+XNAER(N,N5,N4)+XKAER(N,N5,N4)+XHCER(N,N5,N4) + 7+XNH3ER(N,N5,N4)+XNHUER(N,N5,N4)+XNO3ER(N,N5,N4)+XNH3EB(N,N5,N4) + 8+XNHUEB(N,N5,N4)+XNO3EB(N,N5,N4)) + SQ2=XN*2.0*(XN4ER(N,N5,N4) + 6+XNBER(N,N5,N4)+XOH1ER(N,N5,N4)+XOH1EB(N,N5,N4)+PCACER(N,N5,N4) + 7+PCASER(N,N5,N4)+PALPER(N,N5,N4)+PFEPER(N,N5,N4)+PALPEB(N,N5,N4) + 8+PFEPEB(N,N5,N4)+XNH4ER(N,N5,N4)+XNH4EB(N,N5,N4)) + SQ3=XN*3.0*(XAL2ER(N,N5,N4) + 4+XOH2ER(N,N5,N4)+XH1PER(N,N5,N4)+XOH2EB(N,N5,N4)+XH1PEB(N,N5,N4) + 5+PCPDER(N,N5,N4)+PCPDEB(N,N5,N4)) + SQ4=XN*4.0*(XH2PER(N,N5,N4)+XH2PEB(N,N5,N4)+PALOER(N,N5,N4) + 4+PFEOER(N,N5,N4)) + 6+XN*7.0*(PCPMER(N,N5,N4)+PCPMEB(N,N5,N4)) + 7+XN*9.0*(PCPHER(N,N5,N4)+PCPHEB(N,N5,N4)) + SQE=SQ1+SQ2+SQ3+SQ4 + TIONOU=TIONOU-SQE + UIONOU(NY,NX)=UIONOU(NY,NX)-SQE + ENDIF + ENDIF + ENDIF + ENDIF +C +C SUBSURFACE BOUNDARY FLUXES OF WATER AND HEAT +C + IF(NCN(NY,NX).NE.3.OR.N.EQ.3)THEN + HEATOU=HEATOU-XN*HFLW(N,N6,N5,N4) + WO=XN*(FLW(N,N6,N5,N4)+FLWH(N,N6,N5,N4)) + IF(WO.NE.0)THEN + VOLWOU=VOLWOU-WO + HVOLO(NY,NX)=HVOLO(NY,NX)-WO + UVOLO(NY,NX)=UVOLO(NY,NX)-WO +C +C SUBSURFACE BOUNDARY FLUXES OF CO2 AND DOC +C + COD=0.0 + DO 450 K=0,4 + COD=COD+XN*(XOCFLS(K,N,N6,N5,N4)+XOAFLS(K,N,N6,N5,N4) + 4+XOCFHS(K,N,N6,N5,N4)+XOAFHS(K,N,N6,N5,N4)) +450 CONTINUE + CXD=XN*(XCOFLS(N,N6,N5,N4)+XCOFHS(N,N6,N5,N4) + 2+XCOFLG(N,N6,N5,N4)+XCHFLS(N,N6,N5,N4) + 3+XCHFHS(N,N6,N5,N4)+XCHFLG(N,N6,N5,N4)) + TCOU=TCOU-COD-CXD + UDOCD(NY,NX)=UDOCD(NY,NX)-COD + UDICD(NY,NX)=UDICD(NY,NX)-CXD + TNBP(NY,NX)=TNBP(NY,NX)+COD+CXD +C +C SUBSURFACE BOUNDARY FLUXES OF O2 +C + OOD=XN*(XOXFLS(N,N6,N5,N4)+XOXFHS(N,N6,N5,N4)+XOXFLG(N,N6,N5,N4)) + OXYGOU=OXYGOU-OOD + HOD=XN*(XHGFLS(N,N6,N5,N4)+XHGFHS(N,N6,N5,N4)+XHGFLG(N,N6,N5,N4)) + H2GOU=H2GOU-HOD +C +C SUBSURFACE BOUNDARY FLUXES OF N2O, N2, NH4, NH3, NO3, NO2 AND DON +C + ZOD=0.0 + DO 455 K=0,4 + ZOD=ZOD+XN*(XONFLS(K,N,N6,N5,N4)+XONFHS(K,N,N6,N5,N4)) +455 CONTINUE + ZXD=XN*(XN4FLW(N,N6,N5,N4)+XN3FLW(N,N6,N5,N4)+XNOFLW(N,N6,N5,N4) + 2+XN4FLB(N,N6,N5,N4)+XN3FLB(N,N6,N5,N4)+XNOFLB(N,N6,N5,N4) + 3+XNXFLS(N,N6,N5,N4)+XNXFLB(N,N6,N5,N4) + 5+XN4FHW(N,N6,N5,N4)+XN3FHW(N,N6,N5,N4)+XNOFHW(N,N6,N5,N4) + 6+XN4FHB(N,N6,N5,N4)+XN3FHB(N,N6,N5,N4)+XNOFHB(N,N6,N5,N4) + 7+XNXFHS(N,N6,N5,N4)+XNXFHB(N,N6,N5,N4)) + ZGD=XN*(XNGFLS(N,N6,N5,N4)+XNGFLG(N,N6,N5,N4)+XNGFHS(N,N6,N5,N4) + 2+XN2FLS(N,N6,N5,N4)+XN2FLG(N,N6,N5,N4)+XN2FHS(N,N6,N5,N4) + 3+XN3FLG(N,N6,N5,N4)) + TZOU=TZOU-ZOD-ZXD-ZGD + UDOND(NY,NX)=UDOND(NY,NX)-ZOD + UDIND(NY,NX)=UDIND(NY,NX)-ZXD +C +C SUBSURFACE BOUNDARY FLUXES OF PO4 AND DOP +C + POD=0.0 + DO 460 K=0,4 + POD=POD+XN*(XOPFLS(K,N,N6,N5,N4)+XOPFHS(K,N,N6,N5,N4)) +460 CONTINUE + PXD=XN*(XH2PFS(N,N6,N5,N4)+XH2BFB(N,N6,N5,N4) + 2+XH2PHS(N,N6,N5,N4)+XH2BHB(N,N6,N5,N4)+XH1PFS(N,N6,N5,N4) + 3+XH1BFB(N,N6,N5,N4)+XH1PHS(N,N6,N5,N4)+XH1BHB(N,N6,N5,N4)) + TPOU=TPOU-POD-PXD + UDOPD(NY,NX)=UDOPD(NY,NX)-POD + UDIPD(NY,NX)=UDIPD(NY,NX)-PXD +C +C SUBSURFACE BOUNDARY FLUXES OF SOLUTES +C + IF(ISALT(N5,N4).NE.0)THEN + PQD=XN*31.0*(XH0PFS(N,N6,N5,N4)+XH0BFB(N,N6,N5,N4) + 2+XC0PFS(N,N6,N5,N4)+XC0BFB(N,N6,N5,N4)+XF1PFS(N,N6,N5,N4) + 3+XC1PFS(N,N6,N5,N4)+XM1PFS(N,N6,N5,N4)+XF1BFB(N,N6,N5,N4) + 4+XC1BFB(N,N6,N5,N4)+XM1BFB(N,N6,N5,N4)+XH3PFS(N,N6,N5,N4) + 5+XF2PFS(N,N6,N5,N4)+XC2PFS(N,N6,N5,N4)+XH3BFB(N,N6,N5,N4) + 6+XF2BFB(N,N6,N5,N4)+XC2BFB(N,N6,N5,N4)) + PHD=XN*31.0*(XH0PHS(N,N6,N5,N4)+XH0BHB(N,N6,N5,N4) + 2+XC0PHS(N,N6,N5,N4)+XC0BHB(N,N6,N5,N4)+XF1PHS(N,N6,N5,N4) + 3+XC1PHS(N,N6,N5,N4)+XM1PHS(N,N6,N5,N4)+XF1BHB(N,N6,N5,N4) + 4+XC1BHB(N,N6,N5,N4)+XM1BHB(N,N6,N5,N4)+XH3PHS(N,N6,N5,N4) + 7+XF2PHS(N,N6,N5,N4)+XC2PHS(N,N6,N5,N4)+XH3BHB(N,N6,N5,N4) + 8+XF2BHB(N,N6,N5,N4)+XC2BHB(N,N6,N5,N4)) + TPOU=TPOU-PQD-PHD + SSD=XN*(XALFLS(N,N6,N5,N4)+XFEFLS(N,N6,N5,N4)+XHYFLS(N,N6,N5,N4) + 2+XCAFLS(N,N6,N5,N4)+XMGFLS(N,N6,N5,N4)+XNAFLS(N,N6,N5,N4) + 3+XKAFLS(N,N6,N5,N4)+XOHFLS(N,N6,N5,N4)+XSOFLS(N,N6,N5,N4) + 4+XCLFLS(N,N6,N5,N4)+XC3FLS(N,N6,N5,N4)+XH0PFS(N,N6,N5,N4) + 5+XH0BFB(N,N6,N5,N4) + 6+2.0*(XHCFLS(N,N6,N5,N4)+XAL1FS(N,N6,N5,N4) + 6+XALSFS(N,N6,N5,N4)+XFE1FS(N,N6,N5,N4)+XFESFS(N,N6,N5,N4) + 7+XCAOFS(N,N6,N5,N4)+XCACFS(N,N6,N5,N4) + 8+XCASFS(N,N6,N5,N4)+XMGOFS(N,N6,N5,N4)+XMGCFS(N,N6,N5,N4) + 9+XMGSFS(N,N6,N5,N4)+XNACFS(N,N6,N5,N4)+XNASFS(N,N6,N5,N4) + 1+XKASFS(N,N6,N5,N4)+XC0PFS(N,N6,N5,N4)+XC0BFB(N,N6,N5,N4)) + 3+3.0*(XAL2FS(N,N6,N5,N4) + 3+XFE2FS(N,N6,N5,N4)+XCAHFS(N,N6,N5,N4)+XMGHFS(N,N6,N5,N4) + 4+XF1PFS(N,N6,N5,N4)+XC1PFS(N,N6,N5,N4)+XM1PFS(N,N6,N5,N4) + 5+XF1BFB(N,N6,N5,N4)+XC1BFB(N,N6,N5,N4)+XM1BFB(N,N6,N5,N4)) + 6+4.0*(XAL3FS(N,N6,N5,N4)+XFE3FS(N,N6,N5,N4)+XH3PFS(N,N6,N5,N4) + 7+XF2PFS(N,N6,N5,N4)+XC2PFS(N,N6,N5,N4)+XH3BFB(N,N6,N5,N4) + 8+XF2BFB(N,N6,N5,N4)+XC2BFB(N,N6,N5,N4)) + 9+5.0*(XAL4FS(N,N6,N5,N4)+XFE4FS(N,N6,N5,N4))) + SHD=XN*(XALFHS(N,N6,N5,N4)+XFEFHS(N,N6,N5,N4)+XHYFHS(N,N6,N5,N4) + 2+XCAFHS(N,N6,N5,N4)+XMGFHS(N,N6,N5,N4)+XNAFHS(N,N6,N5,N4) + 3+XKAFHS(N,N6,N5,N4)+XOHFHS(N,N6,N5,N4)+XSOFHS(N,N6,N5,N4) + 4+XCLFHS(N,N6,N5,N4)+XC3FHS(N,N6,N5,N4)+XH0PHS(N,N6,N5,N4) + 5+XH0BHB(N,N6,N5,N4) + 5+2.0*(XHCFHS(N,N6,N5,N4)+XAL1HS(N,N6,N5,N4) + 6+XALSHS(N,N6,N5,N4)+XFE1HS(N,N6,N5,N4)+XFESHS(N,N6,N5,N4) + 7+XCAOHS(N,N6,N5,N4)+XCACHS(N,N6,N5,N4) + 8+XCASHS(N,N6,N5,N4)+XMGOHS(N,N6,N5,N4)+XMGCHS(N,N6,N5,N4) + 9+XMGSHS(N,N6,N5,N4)+XNACHS(N,N6,N5,N4)+XNASHS(N,N6,N5,N4) + 1+XKASHS(N,N6,N5,N4)+XC0PHS(N,N6,N5,N4)+XC0BHB(N,N6,N5,N4)) + 3+3.0*(XAL2HS(N,N6,N5,N4) + 3+XFE2HS(N,N6,N5,N4)+XCAHHS(N,N6,N5,N4)+XMGHHS(N,N6,N5,N4) + 4+XF1PHS(N,N6,N5,N4)+XC1PHS(N,N6,N5,N4)+XM1PHS(N,N6,N5,N4) + 5+XF1BHB(N,N6,N5,N4)+XC1BHB(N,N6,N5,N4)+XM1BHB(N,N6,N5,N4)) + 6+4.0*(XAL3HS(N,N6,N5,N4)+XFE3HS(N,N6,N5,N4)+XH3PHS(N,N6,N5,N4) + 7+XF2PHS(N,N6,N5,N4)+XC2PHS(N,N6,N5,N4)+XH3BHB(N,N6,N5,N4) + 8+XF2BHB(N,N6,N5,N4)+XC2BHB(N,N6,N5,N4)) + 9+5.0*(XAL4HS(N,N6,N5,N4)+XAL4HS(N,N6,N5,N4))) + SO=SSD+SHD + TIONOU=TIONOU-SO + UIONOU(NY,NX)=UIONOU(NY,NX)-SO +C IF(I.EQ.180.AND.J.EQ.12)THEN +C WRITE(*,3337)'SSD',I,J,N,N6,N5,N4,SSD +C 2,XALFLS(N,N6,N5,N4),XFEFLS(N,N6,N5,N4),XHYFLS(N,N6,N5,N4) +C 2,XCAFLS(N,N6,N5,N4),XMGFLS(N,N6,N5,N4),XNAFLS(N,N6,N5,N4) +C 3,XKAFLS(N,N6,N5,N4),XOHFLS(N,N6,N5,N4),XSOFLS(N,N6,N5,N4) +C 4,XCLFLS(N,N6,N5,N4),XC3FLS(N,N6,N5,N4),XH0PFS(N,N6,N5,N4) +C 5,XH0BFB(N,N6,N5,N4) +C 6,XHCFLS(N,N6,N5,N4),XAL1FS(N,N6,N5,N4) +C 6,XALSFS(N,N6,N5,N4),XFE1FS(N,N6,N5,N4),XFESFS(N,N6,N5,N4) +C 7,XCAOFS(N,N6,N5,N4),XCACFS(N,N6,N5,N4) +C 8,XCASFS(N,N6,N5,N4),XMGOFS(N,N6,N5,N4),XMGCFS(N,N6,N5,N4) +C 9,XMGSFS(N,N6,N5,N4),XNACFS(N,N6,N5,N4),XNASFS(N,N6,N5,N4) +C 1,XKASFS(N,N6,N5,N4),XC0PFS(N,N6,N5,N4),XC0BFB(N,N6,N5,N4) +C 3,XAL2FS(N,N6,N5,N4) +C 3,XFE2FS(N,N6,N5,N4),XCAHFS(N,N6,N5,N4),XMGHFS(N,N6,N5,N4) +C 4,XF1PFS(N,N6,N5,N4),XC1PFS(N,N6,N5,N4),XM1PFS(N,N6,N5,N4) +C 5,XF1BFB(N,N6,N5,N4),XC1BFB(N,N6,N5,N4),XM1BFB(N,N6,N5,N4) +C 6,XAL3FS(N,N6,N5,N4),XFE3FS(N,N6,N5,N4),XH3PFS(N,N6,N5,N4) +C 7,XF2PFS(N,N6,N5,N4),XC2PFS(N,N6,N5,N4),XH3BFB(N,N6,N5,N4) +C 8,XF2BFB(N,N6,N5,N4),XC2BFB(N,N6,N5,N4) +C 9,XAL4FS(N,N6,N5,N4),XFE4FS(N,N6,N5,N4) +3337 FORMAT(A8,6I4,80E12.4) +C ENDIF +C +C SUBSURFACE FLUX ELECTRICAL CONDUCTIVITY +C + WX=FLW(N,N6,N5,N4)+FLWH(N,N6,N5,N4) + IF(WX.NE.0.0)THEN + ECHY=0.337*AMAX1(0.0,(XHYFLS(N,N6,N5,N4) + 2+XHYFHS(N,N6,N5,N4))/WX) + ECOH=0.192*AMAX1(0.0,(XOHFLS(N,N6,N5,N4) + 2+XOHFHS(N,N6,N5,N4))/WX) + ECAL=0.056*AMAX1(0.0,(XALFLS(N,N6,N5,N4) + 2+XCAFHS(N,N6,N5,N4))*3.0/WX) + ECFE=0.051*AMAX1(0.0,(XFEFLS(N,N6,N5,N4) + 2+XFEFHS(N,N6,N5,N4))*3.0/WX) + ECCA=0.060*AMAX1(0.0,(XCAFLS(N,N6,N5,N4) + 2+XCAFHS(N,N6,N5,N4))*2.0/WX) + ECMG=0.053*AMAX1(0.0,(XMGFLS(N,N6,N5,N4) + 2+XMGFHS(N,N6,N5,N4))*2.0/WX) + ECNA=0.050*AMAX1(0.0,(XNAFLS(N,N6,N5,N4) + 2+XNAFHS(N,N6,N5,N4))/WX) + ECKA=0.070*AMAX1(0.0,(XKAFLS(N,N6,N5,N4) + 2+XKAFHS(N,N6,N5,N4))/WX) + ECCO=0.072*AMAX1(0.0,(XC3FLS(N,N6,N5,N4) + 2+XC3FHS(N,N6,N5,N4))*2.0/WX) + ECHC=0.044*AMAX1(0.0,(XHCFLS(N,N6,N5,N4) + 2+XHCFHS(N,N6,N5,N4))/WX) + ECSO=0.080*AMAX1(0.0,(XSOFLS(N,N6,N5,N4) + 2+XSOFHS(N,N6,N5,N4))*2.0/WX) + ECCL=0.076*AMAX1(0.0,(XCLFLS(N,N6,N5,N4) + 2+XCLFHS(N,N6,N5,N4))/WX) + ECNO=0.071*AMAX1(0.0,(XNOFLW(N,N6,N5,N4) + 2+XNOFHW(N,N6,N5,N4))/(WX*14.0)) + ECNDX=ECHY+ECOH+ECAL+ECFE+ECCA+ECMG+ECNA+ECKA + 2+ECCO+ECHC+ECSO+ECCL+ECNO +C IF((I/10)*10.EQ.I.AND.J.EQ.15)THEN +C WRITE(*,9992)'ECNDX',IYRC,I,J,N4,N5,N6,N,WX,ECNDX +C 2,FLW(N,N6,N5,N4),FLWH(N,N6,N5,N4) +9992 FORMAT(A8,7I4,4E12.4) +C ENDIF + ELSE + ECNDX=0.0 + ENDIF + ENDIF + SG=SG+XHGFLS(N,N6,N5,N4)+XHGFLG(N,N6,N5,N4) + ENDIF + ENDIF +9975 CONTINUE +9980 CONTINUE +9985 CONTINUE +C +C SET DEPTH OF EXTERNAL WATER TABLE +C + IF(IPRC(NY,NX).EQ.2)THEN + DTBLX(NY,NX)=DTBLX(NY,NX)-HVOLO(NY,NX)/AREA(3,NU(NY,NX),NY,NX) + 2-0.001*(DTBLX(NY,NX)-DTBLZ(NY,NX)) + ELSEIF(IPRC(NY,NX).EQ.3)THEN + DTBLX(NY,NX)=DTBLX(NY,NX)-HVOLO(NY,NX)/AREA(3,NU(NY,NX),NY,NX) + 2-0.001*(DTBLX(NY,NX)-DDRG(NY,NX)) + ENDIF +C +C TOTAL FLUXES FOR EACH GRID CELL FROM ALL INTERNAL AND BOUNDARY FLUXES +C CALCULATED IN 'WATSUB', NITRO', 'SOLUTE', 'EXTRACT', 'TRNSFR', +C 'TRNSFRS' AND 'REDIST' ABOVE +C + TQR(NY,NX)=0.0 + THQR(NY,NX)=0.0 + TQS(NY,NX)=0.0 + TQW(NY,NX)=0.0 + TQI(NY,NX)=0.0 + THQS(NY,NX)=0.0 + DO 9960 K=0,2 + TOCQRS(K,NY,NX)=0.0 + TONQRS(K,NY,NX)=0.0 + TOPQRS(K,NY,NX)=0.0 + TOAQRS(K,NY,NX)=0.0 +9960 CONTINUE + TCOQRS(NY,NX)=0.0 + TCHQRS(NY,NX)=0.0 + TOXQRS(NY,NX)=0.0 + TNGQRS(NY,NX)=0.0 + TN2QRS(NY,NX)=0.0 + THGQRS(NY,NX)=0.0 + TN4QRS(NY,NX)=0.0 + TN3QRS(NY,NX)=0.0 + TNOQRS(NY,NX)=0.0 + TNXQRS(NY,NX)=0.0 + TP1QRS(NY,NX)=0.0 + TPOQRS(NY,NX)=0.0 + TCOQSS(NY,NX)=0.0 + TCHQSS(NY,NX)=0.0 + TOXQSS(NY,NX)=0.0 + TNGQSS(NY,NX)=0.0 + TN2QSS(NY,NX)=0.0 + TN4QSS(NY,NX)=0.0 + TN3QSS(NY,NX)=0.0 + TNOQSS(NY,NX)=0.0 + TP1QSS(NY,NX)=0.0 + TPOQSS(NY,NX)=0.0 + IF(ISALT(NY,NX).NE.0)THEN + TQRAL(NY,NX)=0.0 + TQRFE(NY,NX)=0.0 + TQRHY(NY,NX)=0.0 + TQRCA(NY,NX)=0.0 + TQRMG(NY,NX)=0.0 + TQRNA(NY,NX)=0.0 + TQRKA(NY,NX)=0.0 + TQROH(NY,NX)=0.0 + TQRSO(NY,NX)=0.0 + TQRCL(NY,NX)=0.0 + TQRC3(NY,NX)=0.0 + TQRHC(NY,NX)=0.0 + TQRAL1(NY,NX)=0.0 + TQRAL2(NY,NX)=0.0 + TQRAL3(NY,NX)=0.0 + TQRAL4(NY,NX)=0.0 + TQRALS(NY,NX)=0.0 + TQRFE1(NY,NX)=0.0 + TQRFE2(NY,NX)=0.0 + TQRFE3(NY,NX)=0.0 + TQRFE4(NY,NX)=0.0 + TQRFES(NY,NX)=0.0 + TQRCAO(NY,NX)=0.0 + TQRCAC(NY,NX)=0.0 + TQRCAH(NY,NX)=0.0 + TQRCAS(NY,NX)=0.0 + TQRMGO(NY,NX)=0.0 + TQRMGC(NY,NX)=0.0 + TQRMGH(NY,NX)=0.0 + TQRMGS(NY,NX)=0.0 + TQRNAC(NY,NX)=0.0 + TQRNAS(NY,NX)=0.0 + TQRKAS(NY,NX)=0.0 + TQRH0P(NY,NX)=0.0 + TQRH3P(NY,NX)=0.0 + TQRF1P(NY,NX)=0.0 + TQRF2P(NY,NX)=0.0 + TQRC0P(NY,NX)=0.0 + TQRC1P(NY,NX)=0.0 + TQRC2P(NY,NX)=0.0 + TQRM1P(NY,NX)=0.0 + TQSAL(NY,NX)=0.0 + TQSFE(NY,NX)=0.0 + TQSHY(NY,NX)=0.0 + TQSCA(NY,NX)=0.0 + TQSMG(NY,NX)=0.0 + TQSNA(NY,NX)=0.0 + TQSKA(NY,NX)=0.0 + TQSOH(NY,NX)=0.0 + TQSSO(NY,NX)=0.0 + TQSCL(NY,NX)=0.0 + TQSC3(NY,NX)=0.0 + TQSHC(NY,NX)=0.0 + TQSAL1(NY,NX)=0.0 + TQSAL2(NY,NX)=0.0 + TQSAL3(NY,NX)=0.0 + TQSAL4(NY,NX)=0.0 + TQSALS(NY,NX)=0.0 + TQSFE1(NY,NX)=0.0 + TQSFE2(NY,NX)=0.0 + TQSFE3(NY,NX)=0.0 + TQSFE4(NY,NX)=0.0 + TQSFES(NY,NX)=0.0 + TQSCAO(NY,NX)=0.0 + TQSCAC(NY,NX)=0.0 + TQSCAH(NY,NX)=0.0 + TQSCAS(NY,NX)=0.0 + TQSMGO(NY,NX)=0.0 + TQSMGC(NY,NX)=0.0 + TQSMGH(NY,NX)=0.0 + TQSMGS(NY,NX)=0.0 + TQSNAC(NY,NX)=0.0 + TQSNAS(NY,NX)=0.0 + TQSKAS(NY,NX)=0.0 + TQSH0P(NY,NX)=0.0 + TQSH3P(NY,NX)=0.0 + TQSF1P(NY,NX)=0.0 + TQSF2P(NY,NX)=0.0 + TQSC0P(NY,NX)=0.0 + TQSC1P(NY,NX)=0.0 + TQSC2P(NY,NX)=0.0 + TQSM1P(NY,NX)=0.0 + ENDIF + IF(IERSN(NY,NX).NE.0)THEN + TSEDER(NY,NX)=0.0 + TSANER(NY,NX)=0.0 + TSILER(NY,NX)=0.0 + TCLAER(NY,NX)=0.0 + TCECER(NY,NX)=0.0 + TAECER(NY,NX)=0.0 + TNH4ER(NY,NX)=0.0 + TNH3ER(NY,NX)=0.0 + TNHUER(NY,NX)=0.0 + TNO3ER(NY,NX)=0.0 + TNH4EB(NY,NX)=0.0 + TNH3EB(NY,NX)=0.0 + TNHUEB(NY,NX)=0.0 + TNO3EB(NY,NX)=0.0 + TN4ER(NY,NX)=0.0 + TNBER(NY,NX)=0.0 + THYER(NY,NX)=0.0 + TALER(NY,NX)=0.0 + TFEER(NY,NX)=0.0 + TCAER(NY,NX)=0.0 + TMGER(NY,NX)=0.0 + TNAER(NY,NX)=0.0 + TKAER(NY,NX)=0.0 + THCER(NY,NX)=0.0 + TAL2ER(NY,NX)=0.0 + TFE2ER(NY,NX)=0.0 + TOH0ER(NY,NX)=0.0 + TOH1ER(NY,NX)=0.0 + TOH2ER(NY,NX)=0.0 + TH1PER(NY,NX)=0.0 + TH2PER(NY,NX)=0.0 + TOH0EB(NY,NX)=0.0 + TOH1EB(NY,NX)=0.0 + TOH2EB(NY,NX)=0.0 + TH1PEB(NY,NX)=0.0 + TH2PEB(NY,NX)=0.0 + TALOER(NY,NX)=0.0 + TFEOER(NY,NX)=0.0 + TCACER(NY,NX)=0.0 + TCASER(NY,NX)=0.0 + TALPER(NY,NX)=0.0 + TFEPER(NY,NX)=0.0 + TCPDER(NY,NX)=0.0 + TCPHER(NY,NX)=0.0 + TCPMER(NY,NX)=0.0 + TALPEB(NY,NX)=0.0 + TFEPEB(NY,NX)=0.0 + TCPDEB(NY,NX)=0.0 + TCPHEB(NY,NX)=0.0 + TCPMEB(NY,NX)=0.0 + DO 9480 K=0,5 + DO 9480 NN=1,7 + TOMCER(3,NN,K,NY,NX)=0.0 + DO 9480 M=1,2 + TOMCER(M,NN,K,NY,NX)=0.0 + TOMNER(M,NN,K,NY,NX)=0.0 + TOMPER(M,NN,K,NY,NX)=0.0 +9480 CONTINUE + DO 9475 K=0,4 + DO 9470 M=1,2 + TORCER(M,K,NY,NX)=0.0 + TORNER(M,K,NY,NX)=0.0 + TORPER(M,K,NY,NX)=0.0 +9470 CONTINUE + TOHCER(K,NY,NX)=0.0 + TOHNER(K,NY,NX)=0.0 + TOHPER(K,NY,NX)=0.0 + DO 9465 M=1,4 + TOSCER(M,K,NY,NX)=0.0 + TOSAER(M,K,NY,NX)=0.0 + TOSNER(M,K,NY,NX)=0.0 + TOSPER(M,K,NY,NX)=0.0 +9465 CONTINUE +9475 CONTINUE + ENDIF + LG=0 + LX=0 + DO 8575 L=NU(NY,NX),NL(NY,NX) + IF(THETP(L,NY,NX).LT.THETX)LX=1 + IF(THETP(L,NY,NX).GE.THETX.AND.LX.EQ.0)LG=L + TTHAW(L,NY,NX)=0.0 + TTHAWH(L,NY,NX)=0.0 + THTHAW(L,NY,NX)=0.0 + TFLW(L,NY,NX)=0.0 + TFLWX(L,NY,NX)=0.0 + TFLWH(L,NY,NX)=0.0 + THFLW(L,NY,NX)=0.0 + DO 8595 K=0,4 + TOCFLS(K,L,NY,NX)=0.0 + TONFLS(K,L,NY,NX)=0.0 + TOPFLS(K,L,NY,NX)=0.0 + TOAFLS(K,L,NY,NX)=0.0 + TOCFHS(K,L,NY,NX)=0.0 + TONFHS(K,L,NY,NX)=0.0 + TOPFHS(K,L,NY,NX)=0.0 + TOAFHS(K,L,NY,NX)=0.0 +8595 CONTINUE + TCOFLS(L,NY,NX)=0.0 + TCHFLS(L,NY,NX)=0.0 + TOXFLS(L,NY,NX)=0.0 + TNGFLS(L,NY,NX)=0.0 + TN2FLS(L,NY,NX)=0.0 + THGFLS(L,NY,NX)=0.0 + TN4FLS(L,NY,NX)=0.0 + TN3FLS(L,NY,NX)=0.0 + TNOFLS(L,NY,NX)=0.0 + TNXFLS(L,NY,NX)=0.0 + TP1FLS(L,NY,NX)=0.0 + TPOFLS(L,NY,NX)=0.0 + TN4FLB(L,NY,NX)=0.0 + TN3FLB(L,NY,NX)=0.0 + TNOFLB(L,NY,NX)=0.0 + TNXFLB(L,NY,NX)=0.0 + TH1BFB(L,NY,NX)=0.0 + TH2BFB(L,NY,NX)=0.0 + TCOFHS(L,NY,NX)=0.0 + TCHFHS(L,NY,NX)=0.0 + TOXFHS(L,NY,NX)=0.0 + TNGFHS(L,NY,NX)=0.0 + TN2FHS(L,NY,NX)=0.0 + THGFHS(L,NY,NX)=0.0 + TN4FHS(L,NY,NX)=0.0 + TN3FHS(L,NY,NX)=0.0 + TNOFHS(L,NY,NX)=0.0 + TNXFHS(L,NY,NX)=0.0 + TP1FHS(L,NY,NX)=0.0 + TPOFHS(L,NY,NX)=0.0 + TN4FHB(L,NY,NX)=0.0 + TN3FHB(L,NY,NX)=0.0 + TNOFHB(L,NY,NX)=0.0 + TNXFHB(L,NY,NX)=0.0 + TH1BHB(L,NY,NX)=0.0 + TH2BHB(L,NY,NX)=0.0 + TCOFLG(L,NY,NX)=0.0 + TCHFLG(L,NY,NX)=0.0 + TOXFLG(L,NY,NX)=0.0 + TNGFLG(L,NY,NX)=0.0 + TN2FLG(L,NY,NX)=0.0 + TNHFLG(L,NY,NX)=0.0 + THGFLG(L,NY,NX)=0.0 + IF(ISALT(NY,NX).NE.0)THEN + TALFLS(L,NY,NX)=0.0 + TFEFLS(L,NY,NX)=0.0 + THYFLS(L,NY,NX)=0.0 + TCAFLS(L,NY,NX)=0.0 + TMGFLS(L,NY,NX)=0.0 + TNAFLS(L,NY,NX)=0.0 + TKAFLS(L,NY,NX)=0.0 + TOHFLS(L,NY,NX)=0.0 + TSOFLS(L,NY,NX)=0.0 + TCLFLS(L,NY,NX)=0.0 + TC3FLS(L,NY,NX)=0.0 + THCFLS(L,NY,NX)=0.0 + TAL1FS(L,NY,NX)=0.0 + TAL2FS(L,NY,NX)=0.0 + TAL3FS(L,NY,NX)=0.0 + TAL4FS(L,NY,NX)=0.0 + TALSFS(L,NY,NX)=0.0 + TFE1FS(L,NY,NX)=0.0 + TFE2FS(L,NY,NX)=0.0 + TFE3FS(L,NY,NX)=0.0 + TFE4FS(L,NY,NX)=0.0 + TFESFS(L,NY,NX)=0.0 + TCAOFS(L,NY,NX)=0.0 + TCACFS(L,NY,NX)=0.0 + TCAHFS(L,NY,NX)=0.0 + TCASFS(L,NY,NX)=0.0 + TMGOFS(L,NY,NX)=0.0 + TMGCFS(L,NY,NX)=0.0 + TMGHFS(L,NY,NX)=0.0 + TMGSFS(L,NY,NX)=0.0 + TNACFS(L,NY,NX)=0.0 + TNASFS(L,NY,NX)=0.0 + TKASFS(L,NY,NX)=0.0 + TH0PFS(L,NY,NX)=0.0 + TH3PFS(L,NY,NX)=0.0 + TF1PFS(L,NY,NX)=0.0 + TF2PFS(L,NY,NX)=0.0 + TC0PFS(L,NY,NX)=0.0 + TC1PFS(L,NY,NX)=0.0 + TC2PFS(L,NY,NX)=0.0 + TM1PFS(L,NY,NX)=0.0 + TH0BFB(L,NY,NX)=0.0 + TH3BFB(L,NY,NX)=0.0 + TF1BFB(L,NY,NX)=0.0 + TF2BFB(L,NY,NX)=0.0 + TC0BFB(L,NY,NX)=0.0 + TC1BFB(L,NY,NX)=0.0 + TC2BFB(L,NY,NX)=0.0 + TM1BFB(L,NY,NX)=0.0 + TALFHS(L,NY,NX)=0.0 + TFEFHS(L,NY,NX)=0.0 + THYFHS(L,NY,NX)=0.0 + TCAFHS(L,NY,NX)=0.0 + TMGFHS(L,NY,NX)=0.0 + TNAFHS(L,NY,NX)=0.0 + TKAFHS(L,NY,NX)=0.0 + TOHFHS(L,NY,NX)=0.0 + TSOFHS(L,NY,NX)=0.0 + TCLFHS(L,NY,NX)=0.0 + TC3FHS(L,NY,NX)=0.0 + THCFHS(L,NY,NX)=0.0 + TAL1HS(L,NY,NX)=0.0 + TAL2HS(L,NY,NX)=0.0 + TAL3HS(L,NY,NX)=0.0 + TAL4HS(L,NY,NX)=0.0 + TALSHS(L,NY,NX)=0.0 + TFE1HS(L,NY,NX)=0.0 + TFE2HS(L,NY,NX)=0.0 + TFE3HS(L,NY,NX)=0.0 + TFE4HS(L,NY,NX)=0.0 + TFESHS(L,NY,NX)=0.0 + TCAOHS(L,NY,NX)=0.0 + TCACHS(L,NY,NX)=0.0 + TCAHHS(L,NY,NX)=0.0 + TCASHS(L,NY,NX)=0.0 + TMGOHS(L,NY,NX)=0.0 + TMGCHS(L,NY,NX)=0.0 + TMGHHS(L,NY,NX)=0.0 + TMGSHS(L,NY,NX)=0.0 + TNACHS(L,NY,NX)=0.0 + TNASHS(L,NY,NX)=0.0 + TKASHS(L,NY,NX)=0.0 + TH0PHS(L,NY,NX)=0.0 + TH3PHS(L,NY,NX)=0.0 + TF1PHS(L,NY,NX)=0.0 + TF2PHS(L,NY,NX)=0.0 + TC0PHS(L,NY,NX)=0.0 + TC1PHS(L,NY,NX)=0.0 + TC2PHS(L,NY,NX)=0.0 + TM1PHS(L,NY,NX)=0.0 + TH0BHB(L,NY,NX)=0.0 + TH3BHB(L,NY,NX)=0.0 + TF1BHB(L,NY,NX)=0.0 + TF2BHB(L,NY,NX)=0.0 + TC0BHB(L,NY,NX)=0.0 + TC1BHB(L,NY,NX)=0.0 + TC2BHB(L,NY,NX)=0.0 + TM1BHB(L,NY,NX)=0.0 + ENDIF + N1=NX + N2=NY + N3=L + DO 8580 N=1,3 + IF(N.EQ.1)THEN + N4=NX+1 + N5=NY + N6=L + ELSEIF(N.EQ.2)THEN + N4=NX + N5=NY+1 + N6=L + ELSEIF(N.EQ.3)THEN + N4=NX + N5=NY + N6=L+1 + ENDIF +C +C TOTAL FLUXES FROM OVERLAND FLOW +C + IF(L.EQ.NU(N2,N1).AND.N.NE.3)THEN + TQR(N2,N1)=TQR(N2,N1)+QR(N,N2,N1)-QR(N,N5,N4) + THQR(N2,N1)=THQR(N2,N1)+HQR(N,N2,N1)-HQR(N,N5,N4) + TQS(N2,N1)=TQS(N2,N1)+QS(N,N2,N1)-QS(N,N5,N4) + TQW(N2,N1)=TQW(N2,N1)+QW(N,N2,N1)-QW(N,N5,N4) + TQI(N2,N1)=TQI(N2,N1)+QI(N,N2,N1)-QI(N,N5,N4) + THQS(N2,N1)=THQS(N2,N1)+HQS(N,N2,N1)-HQS(N,N5,N4) + DO 8590 K=0,2 + TOCQRS(K,N2,N1)=TOCQRS(K,N2,N1)+XOCQRS(K,N,N2,N1) + 2-XOCQRS(K,N,N5,N4) + TONQRS(K,N2,N1)=TONQRS(K,N2,N1)+XONQRS(K,N,N2,N1) + 2-XONQRS(K,N,N5,N4) + TOPQRS(K,N2,N1)=TOPQRS(K,N2,N1)+XOPQRS(K,N,N2,N1) + 2-XOPQRS(K,N,N5,N4) + TOAQRS(K,N2,N1)=TOAQRS(K,N2,N1)+XOAQRS(K,N,N2,N1) + 2-XOAQRS(K,N,N5,N4) +8590 CONTINUE + TCOQRS(N2,N1)=TCOQRS(N2,N1)+XCOQRS(N,N2,N1)-XCOQRS(N,N5,N4) + TCHQRS(N2,N1)=TCHQRS(N2,N1)+XCHQRS(N,N2,N1)-XCHQRS(N,N5,N4) + TOXQRS(N2,N1)=TOXQRS(N2,N1)+XOXQRS(N,N2,N1)-XOXQRS(N,N5,N4) + TNGQRS(N2,N1)=TNGQRS(N2,N1)+XNGQRS(N,N2,N1)-XNGQRS(N,N5,N4) + TN2QRS(N2,N1)=TN2QRS(N2,N1)+XN2QRS(N,N2,N1)-XN2QRS(N,N5,N4) + THGQRS(N2,N1)=THGQRS(N2,N1)+XHGQRS(N,N2,N1)-XHGQRS(N,N5,N4) + TN4QRS(N2,N1)=TN4QRS(N2,N1)+XN4QRW(N,N2,N1)-XN4QRW(N,N5,N4) + TN3QRS(N2,N1)=TN3QRS(N2,N1)+XN3QRW(N,N2,N1)-XN3QRW(N,N5,N4) + TNOQRS(N2,N1)=TNOQRS(N2,N1)+XNOQRW(N,N2,N1)-XNOQRW(N,N5,N4) + TNXQRS(N2,N1)=TNXQRS(N2,N1)+XNXQRS(N,N2,N1)-XNXQRS(N,N5,N4) + TP1QRS(N2,N1)=TP1QRS(N2,N1)+XP1QRW(N,N2,N1)-XP1QRW(N,N5,N4) + TPOQRS(N2,N1)=TPOQRS(N2,N1)+XP4QRW(N,N2,N1)-XP4QRW(N,N5,N4) + TCOQSS(N2,N1)=TCOQSS(N2,N1)+XCOQSS(N,N2,N1)-XCOQSS(N,N5,N4) + TCHQSS(N2,N1)=TCHQSS(N2,N1)+XCHQSS(N,N2,N1)-XCHQSS(N,N5,N4) + TOXQSS(N2,N1)=TOXQSS(N2,N1)+XOXQSS(N,N2,N1)-XOXQSS(N,N5,N4) + TNGQSS(N2,N1)=TNGQSS(N2,N1)+XNGQSS(N,N2,N1)-XNGQSS(N,N5,N4) + TN2QSS(N2,N1)=TN2QSS(N2,N1)+XN2QSS(N,N2,N1)-XN2QSS(N,N5,N4) + TN4QSS(N2,N1)=TN4QSS(N2,N1)+XN4QSS(N,N2,N1)-XN4QSS(N,N5,N4) + TN3QSS(N2,N1)=TN3QSS(N2,N1)+XN3QSS(N,N2,N1)-XN3QSS(N,N5,N4) + TNOQSS(N2,N1)=TNOQSS(N2,N1)+XNOQSS(N,N2,N1)-XNOQSS(N,N5,N4) + TP1QSS(N2,N1)=TP1QSS(N2,N1)+XP1QSS(N,N2,N1)-XP1QSS(N,N5,N4) + TPOQSS(N2,N1)=TPOQSS(N2,N1)+XP4QSS(N,N2,N1)-XP4QSS(N,N5,N4) + IF(ISALT(N2,N1).NE.0)THEN + TQRAL(N2,N1)=TQRAL(N2,N1)+XQRAL(N,N2,N1)-XQRAL(N,N5,N4) + TQRFE(N2,N1)=TQRFE(N2,N1)+XQRFE(N,N2,N1)-XQRFE(N,N5,N4) + TQRHY(N2,N1)=TQRHY(N2,N1)+XQRHY(N,N2,N1)-XQRHY(N,N5,N4) + TQRCA(N2,N1)=TQRCA(N2,N1)+XQRCA(N,N2,N1)-XQRCA(N,N5,N4) + TQRMG(N2,N1)=TQRMG(N2,N1)+XQRMG(N,N2,N1)-XQRMG(N,N5,N4) + TQRNA(N2,N1)=TQRNA(N2,N1)+XQRNA(N,N2,N1)-XQRNA(N,N5,N4) + TQRKA(N2,N1)=TQRKA(N2,N1)+XQRKA(N,N2,N1)-XQRKA(N,N5,N4) + TQROH(N2,N1)=TQROH(N2,N1)+XQROH(N,N2,N1)-XQROH(N,N5,N4) + TQRSO(N2,N1)=TQRSO(N2,N1)+XQRSO(N,N2,N1)-XQRSO(N,N5,N4) + TQRCL(N2,N1)=TQRCL(N2,N1)+XQRCL(N,N2,N1)-XQRCL(N,N5,N4) + TQRC3(N2,N1)=TQRC3(N2,N1)+XQRC3(N,N2,N1)-XQRC3(N,N5,N4) + TQRHC(N2,N1)=TQRHC(N2,N1)+XQRHC(N,N2,N1)-XQRHC(N,N5,N4) + TQRAL1(N2,N1)=TQRAL1(N2,N1)+XQRAL1(N,N2,N1)-XQRAL1(N,N5,N4) + TQRAL2(N2,N1)=TQRAL2(N2,N1)+XQRAL2(N,N2,N1)-XQRAL2(N,N5,N4) + TQRAL3(N2,N1)=TQRAL3(N2,N1)+XQRAL3(N,N2,N1)-XQRAL3(N,N5,N4) + TQRAL4(N2,N1)=TQRAL4(N2,N1)+XQRAL4(N,N2,N1)-XQRAL4(N,N5,N4) + TQRALS(N2,N1)=TQRALS(N2,N1)+XQRALS(N,N2,N1)-XQRALS(N,N5,N4) + TQRFE1(N2,N1)=TQRFE1(N2,N1)+XQRFE1(N,N2,N1)-XQRFE1(N,N5,N4) + TQRFE2(N2,N1)=TQRFE2(N2,N1)+XQRFE2(N,N2,N1)-XQRFE2(N,N5,N4) + TQRFE3(N2,N1)=TQRFE3(N2,N1)+XQRFE3(N,N2,N1)-XQRFE3(N,N5,N4) + TQRFE4(N2,N1)=TQRFE4(N2,N1)+XQRFE4(N,N2,N1)-XQRFE4(N,N5,N4) + TQRFES(N2,N1)=TQRFES(N2,N1)+XQRFES(N,N2,N1)-XQRFES(N,N5,N4) + TQRCAO(N2,N1)=TQRCAO(N2,N1)+XQRCAO(N,N2,N1)-XQRCAO(N,N5,N4) + TQRCAC(N2,N1)=TQRCAC(N2,N1)+XQRCAC(N,N2,N1)-XQRCAC(N,N5,N4) + TQRCAH(N2,N1)=TQRCAH(N2,N1)+XQRCAH(N,N2,N1)-XQRCAH(N,N5,N4) + TQRCAS(N2,N1)=TQRCAS(N2,N1)+XQRCAS(N,N2,N1)-XQRCAS(N,N5,N4) + TQRMGO(N2,N1)=TQRMGO(N2,N1)+XQRMGO(N,N2,N1)-XQRMGO(N,N5,N4) + TQRMGC(N2,N1)=TQRMGC(N2,N1)+XQRMGC(N,N2,N1)-XQRMGC(N,N5,N4) + TQRMGH(N2,N1)=TQRMGH(N2,N1)+XQRMGH(N,N2,N1)-XQRMGH(N,N5,N4) + TQRMGS(N2,N1)=TQRMGS(N2,N1)+XQRMGS(N,N2,N1)-XQRMGS(N,N5,N4) + TQRNAC(N2,N1)=TQRNAC(N2,N1)+XQRNAC(N,N2,N1)-XQRNAC(N,N5,N4) + TQRNAS(N2,N1)=TQRNAS(N2,N1)+XQRNAS(N,N2,N1)-XQRNAS(N,N5,N4) + TQRKAS(N2,N1)=TQRKAS(N2,N1)+XQRKAS(N,N2,N1)-XQRKAS(N,N5,N4) + TQRH0P(N2,N1)=TQRH0P(N2,N1)+XQRH0P(N,N2,N1)-XQRH0P(N,N5,N4) + TQRH3P(N2,N1)=TQRH3P(N2,N1)+XQRH3P(N,N2,N1)-XQRH3P(N,N5,N4) + TQRF1P(N2,N1)=TQRF1P(N2,N1)+XQRF1P(N,N2,N1)-XQRF1P(N,N5,N4) + TQRF2P(N2,N1)=TQRF2P(N2,N1)+XQRF2P(N,N2,N1)-XQRF2P(N,N5,N4) + TQRC0P(N2,N1)=TQRC0P(N2,N1)+XQRC0P(N,N2,N1)-XQRC0P(N,N5,N4) + TQRC1P(N2,N1)=TQRC1P(N2,N1)+XQRC1P(N,N2,N1)-XQRC1P(N,N5,N4) + TQRC2P(N2,N1)=TQRC2P(N2,N1)+XQRC2P(N,N2,N1)-XQRC2P(N,N5,N4) + TQRM1P(N2,N1)=TQRM1P(N2,N1)+XQRM1P(N,N2,N1)-XQRM1P(N,N5,N4) + TQSAL(N2,N1)=TQSAL(N2,N1)+XQSAL(N,N2,N1)-XQSAL(N,N5,N4) + TQSFE(N2,N1)=TQSFE(N2,N1)+XQSFE(N,N2,N1)-XQSFE(N,N5,N4) + TQSHY(N2,N1)=TQSHY(N2,N1)+XQSHY(N,N2,N1)-XQSHY(N,N5,N4) + TQSCA(N2,N1)=TQSCA(N2,N1)+XQSCA(N,N2,N1)-XQSCA(N,N5,N4) + TQSMG(N2,N1)=TQSMG(N2,N1)+XQSMG(N,N2,N1)-XQSMG(N,N5,N4) + TQSNA(N2,N1)=TQSNA(N2,N1)+XQSNA(N,N2,N1)-XQSNA(N,N5,N4) + TQSKA(N2,N1)=TQSKA(N2,N1)+XQSKA(N,N2,N1)-XQSKA(N,N5,N4) + TQSOH(N2,N1)=TQSOH(N2,N1)+XQSOH(N,N2,N1)-XQSOH(N,N5,N4) + TQSSO(N2,N1)=TQSSO(N2,N1)+XQSSO(N,N2,N1)-XQSSO(N,N5,N4) + TQSCL(N2,N1)=TQSCL(N2,N1)+XQSCL(N,N2,N1)-XQSCL(N,N5,N4) + TQSC3(N2,N1)=TQSC3(N2,N1)+XQSC3(N,N2,N1)-XQSC3(N,N5,N4) + TQSHC(N2,N1)=TQSHC(N2,N1)+XQSHC(N,N2,N1)-XQSHC(N,N5,N4) + TQSAL1(N2,N1)=TQSAL1(N2,N1)+XQSAL1(N,N2,N1)-XQSAL1(N,N5,N4) + TQSAL2(N2,N1)=TQSAL2(N2,N1)+XQSAL2(N,N2,N1)-XQSAL2(N,N5,N4) + TQSAL3(N2,N1)=TQSAL3(N2,N1)+XQSAL3(N,N2,N1)-XQSAL3(N,N5,N4) + TQSAL4(N2,N1)=TQSAL4(N2,N1)+XQSAL4(N,N2,N1)-XQSAL4(N,N5,N4) + TQSALS(N2,N1)=TQSALS(N2,N1)+XQSALS(N,N2,N1)-XQSALS(N,N5,N4) + TQSFE1(N2,N1)=TQSFE1(N2,N1)+XQSFE1(N,N2,N1)-XQSFE1(N,N5,N4) + TQSFE2(N2,N1)=TQSFE2(N2,N1)+XQSFE2(N,N2,N1)-XQSFE2(N,N5,N4) + TQSFE3(N2,N1)=TQSFE3(N2,N1)+XQSFE3(N,N2,N1)-XQSFE3(N,N5,N4) + TQSFE4(N2,N1)=TQSFE4(N2,N1)+XQSFE4(N,N2,N1)-XQSFE4(N,N5,N4) + TQSFES(N2,N1)=TQSFES(N2,N1)+XQSFES(N,N2,N1)-XQSFES(N,N5,N4) + TQSCAO(N2,N1)=TQSCAO(N2,N1)+XQSCAO(N,N2,N1)-XQSCAO(N,N5,N4) + TQSCAC(N2,N1)=TQSCAC(N2,N1)+XQSCAC(N,N2,N1)-XQSCAC(N,N5,N4) + TQSCAH(N2,N1)=TQSCAH(N2,N1)+XQSCAH(N,N2,N1)-XQSCAH(N,N5,N4) + TQSCAS(N2,N1)=TQSCAS(N2,N1)+XQSCAS(N,N2,N1)-XQSCAS(N,N5,N4) + TQSMGO(N2,N1)=TQSMGO(N2,N1)+XQSMGO(N,N2,N1)-XQSMGO(N,N5,N4) + TQSMGC(N2,N1)=TQSMGC(N2,N1)+XQSMGC(N,N2,N1)-XQSMGC(N,N5,N4) + TQSMGH(N2,N1)=TQSMGH(N2,N1)+XQSMGH(N,N2,N1)-XQSMGH(N,N5,N4) + TQSMGS(N2,N1)=TQSMGS(N2,N1)+XQSMGS(N,N2,N1)-XQSMGS(N,N5,N4) + TQSNAC(N2,N1)=TQSNAC(N2,N1)+XQSNAC(N,N2,N1)-XQSNAC(N,N5,N4) + TQSNAS(N2,N1)=TQSNAS(N2,N1)+XQSNAS(N,N2,N1)-XQSNAS(N,N5,N4) + TQSKAS(N2,N1)=TQSKAS(N2,N1)+XQSKAS(N,N2,N1)-XQSKAS(N,N5,N4) + TQSH0P(N2,N1)=TQSH0P(N2,N1)+XQSH0P(N,N2,N1)-XQSH0P(N,N5,N4) + TQSH3P(N2,N1)=TQSH3P(N2,N1)+XQSH3P(N,N2,N1)-XQSH3P(N,N5,N4) + TQSF1P(N2,N1)=TQSF1P(N2,N1)+XQSF1P(N,N2,N1)-XQSF1P(N,N5,N4) + TQSF2P(N2,N1)=TQSF2P(N2,N1)+XQSF2P(N,N2,N1)-XQSF2P(N,N5,N4) + TQSC0P(N2,N1)=TQSC0P(N2,N1)+XQSC0P(N,N2,N1)-XQSC0P(N,N5,N4) + TQSC1P(N2,N1)=TQSC1P(N2,N1)+XQSC1P(N,N2,N1)-XQSC1P(N,N5,N4) + TQSC2P(N2,N1)=TQSC2P(N2,N1)+XQSC2P(N,N2,N1)-XQSC2P(N,N5,N4) + TQSM1P(N2,N1)=TQSM1P(N2,N1)+XQSM1P(N,N2,N1)-XQSM1P(N,N5,N4) + ENDIF +C +C TOTAL FLUXES FROM SEDIMENT TRANSPORT +C + IF(IERSN(NY,NX).NE.0)THEN + TSEDER(N2,N1)=TSEDER(N2,N1)+XSEDER(N,N2,N1)-XSEDER(N,N5,N4) + TSANER(N2,N1)=TSANER(N2,N1)+XSANER(N,N2,N1)-XSANER(N,N5,N4) + TSILER(N2,N1)=TSILER(N2,N1)+XSILER(N,N2,N1)-XSILER(N,N5,N4) + TCLAER(N2,N1)=TCLAER(N2,N1)+XCLAER(N,N2,N1)-XCLAER(N,N5,N4) + TCECER(N2,N1)=TCECER(N2,N1)+XCECER(N,N2,N1)-XCECER(N,N5,N4) + TAECER(N2,N1)=TAECER(N2,N1)+XAECER(N,N2,N1)-XAECER(N,N5,N4) + TNH4ER(N2,N1)=TNH4ER(N2,N1)+XNH4ER(N,N2,N1)-XNH4ER(N,N5,N4) + TNH3ER(N2,N1)=TNH3ER(N2,N1)+XNH3ER(N,N2,N1)-XNH3ER(N,N5,N4) + TNHUER(N2,N1)=TNHUER(N2,N1)+XNHUER(N,N2,N1)-XNHUER(N,N5,N4) + TNO3ER(N2,N1)=TNO3ER(N2,N1)+XNO3ER(N,N2,N1)-XNO3ER(N,N5,N4) + TNH4EB(N2,N1)=TNH4EB(N2,N1)+XNH4EB(N,N2,N1)-XNH4EB(N,N5,N4) + TNH3EB(N2,N1)=TNH3EB(N2,N1)+XNH3EB(N,N2,N1)-XNH3EB(N,N5,N4) + TNHUEB(N2,N1)=TNHUEB(N2,N1)+XNHUEB(N,N2,N1)-XNHUEB(N,N5,N4) + TNO3EB(N2,N1)=TNO3EB(N2,N1)+XNO3EB(N,N2,N1)-XNO3EB(N,N5,N4) + TN4ER(N2,N1)=TN4ER(N2,N1)+XN4ER(N,N2,N1)-XN4ER(N,N5,N4) + TNBER(N2,N1)=TNBER(N2,N1)+XNBER(N,N2,N1)-XNBER(N,N5,N4) + THYER(N2,N1)=THYER(N2,N1)+XHYER(N,N2,N1)-XHYER(N,N5,N4) + TALER(N2,N1)=TALER(N2,N1)+XALER(N,N2,N1)-XALER(N,N5,N4) + TFEER(N2,N1)=TFEER(N2,N1)+XFEER(N,N2,N1)-XFEER(N,N5,N4) + TCAER(N2,N1)=TCAER(N2,N1)+XCAER(N,N2,N1)-XCAER(N,N5,N4) + TMGER(N2,N1)=TMGER(N2,N1)+XMGER(N,N2,N1)-XMGER(N,N5,N4) + TNAER(N2,N1)=TNAER(N2,N1)+XNAER(N,N2,N1)-XNAER(N,N5,N4) + TKAER(N2,N1)=TKAER(N2,N1)+XKAER(N,N2,N1)-XKAER(N,N5,N4) + THCER(N2,N1)=THCER(N2,N1)+XHCER(N,N2,N1)-XHCER(N,N5,N4) + TAL2ER(N2,N1)=TAL2ER(N2,N1)+XAL2ER(N,N2,N1)-XAL2ER(N,N5,N4) + TFE2ER(N2,N1)=TFE2ER(N2,N1)+XFE2ER(N,N2,N1)-XFE2ER(N,N5,N4) + TOH0ER(N2,N1)=TOH0ER(N2,N1)+XOH0ER(N,N2,N1)-XOH0ER(N,N5,N4) + TOH1ER(N2,N1)=TOH1ER(N2,N1)+XOH1ER(N,N2,N1)-XOH1ER(N,N5,N4) + TOH2ER(N2,N1)=TOH2ER(N2,N1)+XOH2ER(N,N2,N1)-XOH2ER(N,N5,N4) + TH1PER(N2,N1)=TH1PER(N2,N1)+XH1PER(N,N2,N1)-XH1PER(N,N5,N4) + TH2PER(N2,N1)=TH2PER(N2,N1)+XH2PER(N,N2,N1)-XH2PER(N,N5,N4) + TOH0EB(N2,N1)=TOH0EB(N2,N1)+XOH0EB(N,N2,N1)-XOH0EB(N,N5,N4) + TOH1EB(N2,N1)=TOH1EB(N2,N1)+XOH1EB(N,N2,N1)-XOH1EB(N,N5,N4) + TOH2EB(N2,N1)=TOH2EB(N2,N1)+XOH2EB(N,N2,N1)-XOH2EB(N,N5,N4) + TH1PEB(N2,N1)=TH1PEB(N2,N1)+XH1PEB(N,N2,N1)-XH1PEB(N,N5,N4) + TH2PEB(N2,N1)=TH2PEB(N2,N1)+XH2PEB(N,N2,N1)-XH2PEB(N,N5,N4) + TALOER(N2,N1)=TALOER(N2,N1)+PALOER(N,N2,N1)-PALOER(N,N5,N4) + TFEOER(N2,N1)=TFEOER(N2,N1)+PFEOER(N,N2,N1)-PFEOER(N,N5,N4) + TCACER(N2,N1)=TCACER(N2,N1)+PCACER(N,N2,N1)-PCACER(N,N5,N4) + TCASER(N2,N1)=TCASER(N2,N1)+PCASER(N,N2,N1)-PCASER(N,N5,N4) + TALPER(N2,N1)=TALPER(N2,N1)+PALPER(N,N2,N1)-PALPER(N,N5,N4) + TFEPER(N2,N1)=TFEPER(N2,N1)+PFEPER(N,N2,N1)-PFEPER(N,N5,N4) + TCPDER(N2,N1)=TCPDER(N2,N1)+PCPDER(N,N2,N1)-PCPDER(N,N5,N4) + TCPHER(N2,N1)=TCPHER(N2,N1)+PCPHER(N,N2,N1)-PCPHER(N,N5,N4) + TCPMER(N2,N1)=TCPMER(N2,N1)+PCPMER(N,N2,N1)-PCPMER(N,N5,N4) + TALPEB(N2,N1)=TALPEB(N2,N1)+PALPEB(N,N2,N1)-PALPEB(N,N5,N4) + TFEPEB(N2,N1)=TFEPEB(N2,N1)+PFEPEB(N,N2,N1)-PFEPEB(N,N5,N4) + TCPDEB(N2,N1)=TCPDEB(N2,N1)+PCPDEB(N,N2,N1)-PCPDEB(N,N5,N4) + TCPHEB(N2,N1)=TCPHEB(N2,N1)+PCPHEB(N,N2,N1)-PCPHEB(N,N5,N4) + TCPMEB(N2,N1)=TCPMEB(N2,N1)+PCPMEB(N,N2,N1)-PCPMEB(N,N5,N4) + DO 9380 K=0,5 + DO 9380 NN=1,7 + TOMCER(3,NN,K,N2,N1)=TOMCER(3,NN,K,N2,N1) + 2+OMCER(3,NN,K,N,N2,N1)-OMCER(3,NN,K,N,N5,N4) + DO 9380 M=1,2 + TOMCER(M,NN,K,N2,N1)=TOMCER(M,NN,K,N2,N1) + 2+OMCER(M,NN,K,N,N2,N1)-OMCER(M,NN,K,N,N5,N4) + TOMNER(M,NN,K,N2,N1)=TOMNER(M,NN,K,N2,N1) + 2+OMNER(M,NN,K,N,N2,N1)-OMNER(M,NN,K,N,N5,N4) + TOMPER(M,NN,K,N2,N1)=TOMPER(M,NN,K,N2,N1) + 2+OMPER(M,NN,K,N,N2,N1)-OMPER(M,NN,K,N,N5,N4) +9380 CONTINUE + DO 9375 K=0,4 + DO 9370 M=1,2 + TORCER(M,K,N2,N1)=TORCER(M,K,N2,N1) + 2+ORCER(M,K,N,N2,N1)-ORCER(M,K,N,N5,N4) + TORNER(M,K,N2,N1)=TORNER(M,K,N2,N1) + 2+ORNER(M,K,N,N2,N1)-ORNER(M,K,N,N5,N4) + TORPER(M,K,N2,N1)=TORPER(M,K,N2,N1) + 2+ORPER(M,K,N,N2,N1)-ORPER(M,K,N,N5,N4) +9370 CONTINUE + TOHCER(K,N2,N1)=TOHCER(K,N2,N1) + 2+OHCER(K,N,N2,N1)-OHCER(K,N,N5,N4) + TOHNER(K,N2,N1)=TOHNER(K,N2,N1) + 2+OHNER(K,N,N2,N1)-OHNER(K,N,N5,N4) + TOHPER(K,N2,N1)=TOHPER(K,N2,N1) + 2+OHPER(K,N,N2,N1)-OHPER(K,N,N5,N4) + DO 9365 M=1,4 + TOSCER(M,K,N2,N1)=TOSCER(M,K,N2,N1) + 2+OSCER(M,K,N,N2,N1)-OSCER(M,K,N,N5,N4) + TOSAER(M,K,N2,N1)=TOSAER(M,K,N2,N1) + 2+OSAER(M,K,N,N2,N1)-OSAER(M,K,N,N5,N4) + TOSNER(M,K,N2,N1)=TOSNER(M,K,N2,N1) + 2+OSNER(M,K,N,N2,N1)-OSNER(M,K,N,N5,N4) + TOSPER(M,K,N2,N1)=TOSPER(M,K,N2,N1) + 2+OSPER(M,K,N,N2,N1)-OSPER(M,K,N,N5,N4) +9365 CONTINUE +9375 CONTINUE + ENDIF + ENDIF +C +C TOTAL HEAT, WATER, GAS AND SOLUTE FLUXES BETWEEN ADJACENT +C GRID CELLS +C + IF(NCN(N2,N1).NE.3.OR.N.EQ.3)THEN + TTHAW(N3,N2,N1)=TTHAW(N3,N2,N1)+THAW(N,N3,N2,N1) + TTHAWH(N3,N2,N1)=TTHAWH(N3,N2,N1)+THAWH(N,N3,N2,N1) + THTHAW(N3,N2,N1)=THTHAW(N3,N2,N1)+HTHAW(N,N3,N2,N1) + TFLW(N3,N2,N1)=TFLW(N3,N2,N1)+FLW(N,N3,N2,N1)-FLW(N,N6,N5,N4) + TFLWX(N3,N2,N1)=TFLWX(N3,N2,N1)+FLWX(N,N3,N2,N1)-FLWX(N,N6,N5,N4) + TFLWH(N3,N2,N1)=TFLWH(N3,N2,N1)+FLWH(N,N3,N2,N1)-FLWH(N,N6,N5,N4) + THFLW(N3,N2,N1)=THFLW(N3,N2,N1)+HFLW(N,N3,N2,N1)-HFLW(N,N6,N5,N4) + DO 8585 K=0,4 + TOCFLS(K,N3,N2,N1)=TOCFLS(K,N3,N2,N1)+XOCFLS(K,N,N3,N2,N1) + 2-XOCFLS(K,N,N6,N5,N4) + TONFLS(K,N3,N2,N1)=TONFLS(K,N3,N2,N1)+XONFLS(K,N,N3,N2,N1) + 2-XONFLS(K,N,N6,N5,N4) + TOPFLS(K,N3,N2,N1)=TOPFLS(K,N3,N2,N1)+XOPFLS(K,N,N3,N2,N1) + 2-XOPFLS(K,N,N6,N5,N4) + TOAFLS(K,N3,N2,N1)=TOAFLS(K,N3,N2,N1)+XOAFLS(K,N,N3,N2,N1) + 2-XOAFLS(K,N,N6,N5,N4) + TOCFHS(K,N3,N2,N1)=TOCFHS(K,N3,N2,N1)+XOCFHS(K,N,N3,N2,N1) + 2-XOCFHS(K,N,N6,N5,N4) + TONFHS(K,N3,N2,N1)=TONFHS(K,N3,N2,N1)+XONFHS(K,N,N3,N2,N1) + 2-XONFHS(K,N,N6,N5,N4) + TOPFHS(K,N3,N2,N1)=TOPFHS(K,N3,N2,N1)+XOPFHS(K,N,N3,N2,N1) + 2-XOPFHS(K,N,N6,N5,N4) + TOAFHS(K,N3,N2,N1)=TOAFHS(K,N3,N2,N1)+XOAFHS(K,N,N3,N2,N1) + 2-XOAFHS(K,N,N6,N5,N4) +8585 CONTINUE + TCOFLS(N3,N2,N1)=TCOFLS(N3,N2,N1)+XCOFLS(N,N3,N2,N1) + 2-XCOFLS(N,N6,N5,N4) + TCHFLS(N3,N2,N1)=TCHFLS(N3,N2,N1)+XCHFLS(N,N3,N2,N1) + 2-XCHFLS(N,N6,N5,N4) + TOXFLS(N3,N2,N1)=TOXFLS(N3,N2,N1)+XOXFLS(N,N3,N2,N1) + 2-XOXFLS(N,N6,N5,N4) + TNGFLS(N3,N2,N1)=TNGFLS(N3,N2,N1)+XNGFLS(N,N3,N2,N1) + 2-XNGFLS(N,N6,N5,N4) + TN2FLS(N3,N2,N1)=TN2FLS(N3,N2,N1)+XN2FLS(N,N3,N2,N1) + 2-XN2FLS(N,N6,N5,N4) + THGFLS(N3,N2,N1)=THGFLS(N3,N2,N1)+XHGFLS(N,N3,N2,N1) + 2-XHGFLS(N,N6,N5,N4) + TN4FLS(N3,N2,N1)=TN4FLS(N3,N2,N1)+XN4FLW(N,N3,N2,N1) + 2-XN4FLW(N,N6,N5,N4) + TN3FLS(N3,N2,N1)=TN3FLS(N3,N2,N1)+XN3FLW(N,N3,N2,N1) + 2-XN3FLW(N,N6,N5,N4) + TNOFLS(N3,N2,N1)=TNOFLS(N3,N2,N1)+XNOFLW(N,N3,N2,N1) + 2-XNOFLW(N,N6,N5,N4) + TNXFLS(N3,N2,N1)=TNXFLS(N3,N2,N1)+XNXFLS(N,N3,N2,N1) + 2-XNXFLS(N,N6,N5,N4) + TP1FLS(N3,N2,N1)=TP1FLS(N3,N2,N1)+XH1PFS(N,N3,N2,N1) + 2-XH1PFS(N,N6,N5,N4) + TPOFLS(N3,N2,N1)=TPOFLS(N3,N2,N1)+XH2PFS(N,N3,N2,N1) + 2-XH2PFS(N,N6,N5,N4) + TN4FLB(N3,N2,N1)=TN4FLB(N3,N2,N1)+XN4FLB(N,N3,N2,N1) + 2-XN4FLB(N,N6,N5,N4) + TN3FLB(N3,N2,N1)=TN3FLB(N3,N2,N1)+XN3FLB(N,N3,N2,N1) + 2-XN3FLB(N,N6,N5,N4) + TNOFLB(N3,N2,N1)=TNOFLB(N3,N2,N1)+XNOFLB(N,N3,N2,N1) + 2-XNOFLB(N,N6,N5,N4) + TNXFLB(N3,N2,N1)=TNXFLB(N3,N2,N1)+XNXFLB(N,N3,N2,N1) + 2-XNXFLB(N,N6,N5,N4) + TH1BFB(N3,N2,N1)=TH1BFB(N3,N2,N1)+XH1BFB(N,N3,N2,N1) + 2-XH1BFB(N,N6,N5,N4) + TH2BFB(N3,N2,N1)=TH2BFB(N3,N2,N1)+XH2BFB(N,N3,N2,N1) + 2-XH2BFB(N,N6,N5,N4) + TCOFHS(N3,N2,N1)=TCOFHS(N3,N2,N1)+XCOFHS(N,N3,N2,N1) + 2-XCOFHS(N,N6,N5,N4) + TCHFHS(N3,N2,N1)=TCHFHS(N3,N2,N1)+XCHFHS(N,N3,N2,N1) + 2-XCHFHS(N,N6,N5,N4) + TOXFHS(N3,N2,N1)=TOXFHS(N3,N2,N1)+XOXFHS(N,N3,N2,N1) + 2-XOXFHS(N,N6,N5,N4) + TNGFHS(N3,N2,N1)=TNGFHS(N3,N2,N1)+XNGFHS(N,N3,N2,N1) + 2-XNGFHS(N,N6,N5,N4) + TN2FHS(N3,N2,N1)=TN2FHS(N3,N2,N1)+XN2FHS(N,N3,N2,N1) + 2-XN2FHS(N,N6,N5,N4) + THGFHS(N3,N2,N1)=THGFHS(N3,N2,N1)+XHGFHS(N,N3,N2,N1) + 2-XHGFHS(N,N6,N5,N4) + TN4FHS(N3,N2,N1)=TN4FHS(N3,N2,N1)+XN4FHW(N,N3,N2,N1) + 2-XN4FHW(N,N6,N5,N4) + TN3FHS(N3,N2,N1)=TN3FHS(N3,N2,N1)+XN3FHW(N,N3,N2,N1) + 2-XN3FHW(N,N6,N5,N4) + TNOFHS(N3,N2,N1)=TNOFHS(N3,N2,N1)+XNOFHW(N,N3,N2,N1) + 2-XNOFHW(N,N6,N5,N4) + TNXFHS(N3,N2,N1)=TNXFHS(N3,N2,N1)+XNXFHS(N,N3,N2,N1) + 2-XNXFHS(N,N6,N5,N4) + TP1FHS(N3,N2,N1)=TP1FHS(N3,N2,N1)+XH1PHS(N,N3,N2,N1) + 2-XH1PHS(N,N6,N5,N4) + TPOFHS(N3,N2,N1)=TPOFHS(N3,N2,N1)+XH2PHS(N,N3,N2,N1) + 2-XH2PHS(N,N6,N5,N4) + TN4FHB(N3,N2,N1)=TN4FHB(N3,N2,N1)+XN4FHB(N,N3,N2,N1) + 2-XN4FHB(N,N6,N5,N4) + TN3FHB(N3,N2,N1)=TN3FHB(N3,N2,N1)+XN3FHB(N,N3,N2,N1) + 2-XN3FHB(N,N6,N5,N4) + TNOFHB(N3,N2,N1)=TNOFHB(N3,N2,N1)+XNOFHB(N,N3,N2,N1) + 2-XNOFHB(N,N6,N5,N4) + TNXFHB(N3,N2,N1)=TNXFHB(N3,N2,N1)+XNXFHB(N,N3,N2,N1) + 2-XNXFHB(N,N6,N5,N4) + TH1BHB(N3,N2,N1)=TH1BHB(N3,N2,N1)+XH1BHB(N,N3,N2,N1) + 2-XH1BHB(N,N6,N5,N4) + TH2BHB(N3,N2,N1)=TH2BHB(N3,N2,N1)+XH2BHB(N,N3,N2,N1) + 2-XH2BHB(N,N6,N5,N4) + TCOFLG(N3,N2,N1)=TCOFLG(N3,N2,N1)+XCOFLG(N,N3,N2,N1) + 2-XCOFLG(N,N6,N5,N4) + TCHFLG(N3,N2,N1)=TCHFLG(N3,N2,N1)+XCHFLG(N,N3,N2,N1) + 2-XCHFLG(N,N6,N5,N4) + TOXFLG(N3,N2,N1)=TOXFLG(N3,N2,N1)+XOXFLG(N,N3,N2,N1) + 2-XOXFLG(N,N6,N5,N4) + TNGFLG(N3,N2,N1)=TNGFLG(N3,N2,N1)+XNGFLG(N,N3,N2,N1) + 2-XNGFLG(N,N6,N5,N4) + TN2FLG(N3,N2,N1)=TN2FLG(N3,N2,N1)+XN2FLG(N,N3,N2,N1) + 2-XN2FLG(N,N6,N5,N4) + TNHFLG(N3,N2,N1)=TNHFLG(N3,N2,N1)+XN3FLG(N,N3,N2,N1) + 2-XN3FLG(N,N6,N5,N4) + THGFLG(N3,N2,N1)=THGFLG(N3,N2,N1)+XHGFLG(N,N3,N2,N1) + 2-XHGFLG(N,N6,N5,N4) + IF(ISALT(N2,N1).NE.0)THEN + TALFLS(N3,N2,N1)=TALFLS(N3,N2,N1)+XALFLS(N,N3,N2,N1) + 2-XALFLS(N,N6,N5,N4) + TFEFLS(N3,N2,N1)=TFEFLS(N3,N2,N1)+XFEFLS(N,N3,N2,N1) + 2-XFEFLS(N,N6,N5,N4) + THYFLS(N3,N2,N1)=THYFLS(N3,N2,N1)+XHYFLS(N,N3,N2,N1) + 2-XHYFLS(N,N6,N5,N4) + TCAFLS(N3,N2,N1)=TCAFLS(N3,N2,N1)+XCAFLS(N,N3,N2,N1) + 2-XCAFLS(N,N6,N5,N4) + TMGFLS(N3,N2,N1)=TMGFLS(N3,N2,N1)+XMGFLS(N,N3,N2,N1) + 2-XMGFLS(N,N6,N5,N4) + TNAFLS(N3,N2,N1)=TNAFLS(N3,N2,N1)+XNAFLS(N,N3,N2,N1) + 2-XNAFLS(N,N6,N5,N4) + TKAFLS(N3,N2,N1)=TKAFLS(N3,N2,N1)+XKAFLS(N,N3,N2,N1) + 2-XKAFLS(N,N6,N5,N4) + TOHFLS(N3,N2,N1)=TOHFLS(N3,N2,N1)+XOHFLS(N,N3,N2,N1) + 2-XOHFLS(N,N6,N5,N4) + TSOFLS(N3,N2,N1)=TSOFLS(N3,N2,N1)+XSOFLS(N,N3,N2,N1) + 2-XSOFLS(N,N6,N5,N4) + TCLFLS(N3,N2,N1)=TCLFLS(N3,N2,N1)+XCLFLS(N,N3,N2,N1) + 2-XCLFLS(N,N6,N5,N4) + TC3FLS(N3,N2,N1)=TC3FLS(N3,N2,N1)+XC3FLS(N,N3,N2,N1) + 2-XC3FLS(N,N6,N5,N4) + THCFLS(N3,N2,N1)=THCFLS(N3,N2,N1)+XHCFLS(N,N3,N2,N1) + 2-XHCFLS(N,N6,N5,N4) + TAL1FS(N3,N2,N1)=TAL1FS(N3,N2,N1)+XAL1FS(N,N3,N2,N1) + 2-XAL1FS(N,N6,N5,N4) + TAL2FS(N3,N2,N1)=TAL2FS(N3,N2,N1)+XAL2FS(N,N3,N2,N1) + 2-XAL2FS(N,N6,N5,N4) + TAL3FS(N3,N2,N1)=TAL3FS(N3,N2,N1)+XAL3FS(N,N3,N2,N1) + 2-XAL3FS(N,N6,N5,N4) + TAL4FS(N3,N2,N1)=TAL4FS(N3,N2,N1)+XAL4FS(N,N3,N2,N1) + 2-XAL4FS(N,N6,N5,N4) + TALSFS(N3,N2,N1)=TALSFS(N3,N2,N1)+XALSFS(N,N3,N2,N1) + 2-XALSFS(N,N6,N5,N4) + TFE1FS(N3,N2,N1)=TFE1FS(N3,N2,N1)+XFE1FS(N,N3,N2,N1) + 2-XFE1FS(N,N6,N5,N4) + TFE2FS(N3,N2,N1)=TFE2FS(N3,N2,N1)+XFE2FS(N,N3,N2,N1) + 2-XFE2FS(N,N6,N5,N4) + TFE3FS(N3,N2,N1)=TFE3FS(N3,N2,N1)+XFE3FS(N,N3,N2,N1) + 2-XFE3FS(N,N6,N5,N4) + TFE4FS(N3,N2,N1)=TFE4FS(N3,N2,N1)+XFE4FS(N,N3,N2,N1) + 2-XFE4FS(N,N6,N5,N4) + TFESFS(N3,N2,N1)=TFESFS(N3,N2,N1)+XFESFS(N,N3,N2,N1) + 2-XFESFS(N,N6,N5,N4) + TCAOFS(N3,N2,N1)=TCAOFS(N3,N2,N1)+XCAOFS(N,N3,N2,N1) + 2-XCAOFS(N,N6,N5,N4) + TCACFS(N3,N2,N1)=TCACFS(N3,N2,N1)+XCACFS(N,N3,N2,N1) + 2-XCACFS(N,N6,N5,N4) + TCAHFS(N3,N2,N1)=TCAHFS(N3,N2,N1)+XCAHFS(N,N3,N2,N1) + 2-XCAHFS(N,N6,N5,N4) + TCASFS(N3,N2,N1)=TCASFS(N3,N2,N1)+XCASFS(N,N3,N2,N1) + 2-XCASFS(N,N6,N5,N4) + TMGOFS(N3,N2,N1)=TMGOFS(N3,N2,N1)+XMGOFS(N,N3,N2,N1) + 2-XMGOFS(N,N6,N5,N4) + TMGCFS(N3,N2,N1)=TMGCFS(N3,N2,N1)+XMGCFS(N,N3,N2,N1) + 2-XMGCFS(N,N6,N5,N4) + TMGHFS(N3,N2,N1)=TMGHFS(N3,N2,N1)+XMGHFS(N,N3,N2,N1) + 2-XMGHFS(N,N6,N5,N4) + TMGSFS(N3,N2,N1)=TMGSFS(N3,N2,N1)+XMGSFS(N,N3,N2,N1) + 2-XMGSFS(N,N6,N5,N4) + TNACFS(N3,N2,N1)=TNACFS(N3,N2,N1)+XNACFS(N,N3,N2,N1) + 2-XNACFS(N,N6,N5,N4) + TNASFS(N3,N2,N1)=TNASFS(N3,N2,N1)+XNASFS(N,N3,N2,N1) + 2-XNASFS(N,N6,N5,N4) + TKASFS(N3,N2,N1)=TKASFS(N3,N2,N1)+XKASFS(N,N3,N2,N1) + 2-XKASFS(N,N6,N5,N4) + TH0PFS(N3,N2,N1)=TH0PFS(N3,N2,N1)+XH0PFS(N,N3,N2,N1) + 2-XH0PFS(N,N6,N5,N4) + TH3PFS(N3,N2,N1)=TH3PFS(N3,N2,N1)+XH3PFS(N,N3,N2,N1) + 2-XH3PFS(N,N6,N5,N4) + TF1PFS(N3,N2,N1)=TF1PFS(N3,N2,N1)+XF1PFS(N,N3,N2,N1) + 2-XF1PFS(N,N6,N5,N4) + TF2PFS(N3,N2,N1)=TF2PFS(N3,N2,N1)+XF2PFS(N,N3,N2,N1) + 2-XF2PFS(N,N6,N5,N4) + TC0PFS(N3,N2,N1)=TC0PFS(N3,N2,N1)+XC0PFS(N,N3,N2,N1) + 2-XC0PFS(N,N6,N5,N4) + TC1PFS(N3,N2,N1)=TC1PFS(N3,N2,N1)+XC1PFS(N,N3,N2,N1) + 2-XC1PFS(N,N6,N5,N4) + TC2PFS(N3,N2,N1)=TC2PFS(N3,N2,N1)+XC2PFS(N,N3,N2,N1) + 2-XC2PFS(N,N6,N5,N4) + TM1PFS(N3,N2,N1)=TM1PFS(N3,N2,N1)+XM1PFS(N,N3,N2,N1) + 2-XM1PFS(N,N6,N5,N4) + TH0BFB(N3,N2,N1)=TH0BFB(N3,N2,N1)+XH0BFB(N,N3,N2,N1) + 2-XH0BFB(N,N6,N5,N4) + TH3BFB(N3,N2,N1)=TH3BFB(N3,N2,N1)+XH3BFB(N,N3,N2,N1) + 2-XH3BFB(N,N6,N5,N4) + TF1BFB(N3,N2,N1)=TF1BFB(N3,N2,N1)+XF1BFB(N,N3,N2,N1) + 2-XF1BFB(N,N6,N5,N4) + TF2BFB(N3,N2,N1)=TF2BFB(N3,N2,N1)+XF2BFB(N,N3,N2,N1) + 2-XF2BFB(N,N6,N5,N4) + TC0BFB(N3,N2,N1)=TC0BFB(N3,N2,N1)+XC0BFB(N,N3,N2,N1) + 2-XC0BFB(N,N6,N5,N4) + TC1BFB(N3,N2,N1)=TC1BFB(N3,N2,N1)+XC1BFB(N,N3,N2,N1) + 2-XC1BFB(N,N6,N5,N4) + TC2BFB(N3,N2,N1)=TC2BFB(N3,N2,N1)+XC2BFB(N,N3,N2,N1) + 2-XC2BFB(N,N6,N5,N4) + TM1BFB(N3,N2,N1)=TM1BFB(N3,N2,N1)+XM1BFB(N,N3,N2,N1) + 2-XM1BFB(N,N6,N5,N4) + TALFHS(N3,N2,N1)=TALFHS(N3,N2,N1)+XALFHS(N,N3,N2,N1) + 2-XALFHS(N,N6,N5,N4) + TFEFHS(N3,N2,N1)=TFEFHS(N3,N2,N1)+XFEFHS(N,N3,N2,N1) + 2-XFEFHS(N,N6,N5,N4) + THYFHS(N3,N2,N1)=THYFHS(N3,N2,N1)+XHYFHS(N,N3,N2,N1) + 2-XHYFHS(N,N6,N5,N4) + TCAFHS(N3,N2,N1)=TCAFHS(N3,N2,N1)+XCAFHS(N,N3,N2,N1) + 2-XCAFHS(N,N6,N5,N4) + TMGFHS(N3,N2,N1)=TMGFHS(N3,N2,N1)+XMGFHS(N,N3,N2,N1) + 2-XMGFHS(N,N6,N5,N4) + TNAFHS(N3,N2,N1)=TNAFHS(N3,N2,N1)+XNAFHS(N,N3,N2,N1) + 2-XNAFHS(N,N6,N5,N4) + TKAFHS(N3,N2,N1)=TKAFHS(N3,N2,N1)+XKAFHS(N,N3,N2,N1) + 2-XKAFHS(N,N6,N5,N4) + TOHFHS(N3,N2,N1)=TOHFHS(N3,N2,N1)+XOHFHS(N,N3,N2,N1) + 2-XOHFHS(N,N6,N5,N4) + TSOFHS(N3,N2,N1)=TSOFHS(N3,N2,N1)+XSOFHS(N,N3,N2,N1) + 2-XSOFHS(N,N6,N5,N4) + TCLFHS(N3,N2,N1)=TCLFHS(N3,N2,N1)+XCLFHS(N,N3,N2,N1) + 2-XCLFHS(N,N6,N5,N4) + TC3FHS(N3,N2,N1)=TC3FHS(N3,N2,N1)+XC3FHS(N,N3,N2,N1) + 2-XC3FHS(N,N6,N5,N4) + THCFHS(N3,N2,N1)=THCFHS(N3,N2,N1)+XHCFHS(N,N3,N2,N1) + 2-XHCFHS(N,N6,N5,N4) + TAL1HS(N3,N2,N1)=TAL1HS(N3,N2,N1)+XAL1HS(N,N3,N2,N1) + 2-XAL1HS(N,N6,N5,N4) + TAL2HS(N3,N2,N1)=TAL2HS(N3,N2,N1)+XAL2HS(N,N3,N2,N1) + 2-XAL2HS(N,N6,N5,N4) + TAL3HS(N3,N2,N1)=TAL3HS(N3,N2,N1)+XAL3HS(N,N3,N2,N1) + 2-XAL3HS(N,N6,N5,N4) + TAL4HS(N3,N2,N1)=TAL4HS(N3,N2,N1)+XAL4HS(N,N3,N2,N1) + 2-XAL4HS(N,N6,N5,N4) + TALSHS(N3,N2,N1)=TALSHS(N3,N2,N1)+XALSHS(N,N3,N2,N1) + 2-XALSHS(N,N6,N5,N4) + TFE1HS(N3,N2,N1)=TFE1HS(N3,N2,N1)+XFE1HS(N,N3,N2,N1) + 2-XFE1HS(N,N6,N5,N4) + TFE2HS(N3,N2,N1)=TFE2HS(N3,N2,N1)+XFE2HS(N,N3,N2,N1) + 2-XFE2HS(N,N6,N5,N4) + TFE3HS(N3,N2,N1)=TFE3HS(N3,N2,N1)+XFE3HS(N,N3,N2,N1) + 2-XFE3HS(N,N6,N5,N4) + TFE4HS(N3,N2,N1)=TFE4HS(N3,N2,N1)+XFE4HS(N,N3,N2,N1) + 2-XFE4HS(N,N6,N5,N4) + TFESHS(N3,N2,N1)=TFESHS(N3,N2,N1)+XFESHS(N,N3,N2,N1) + 2-XFESHS(N,N6,N5,N4) + TCAOHS(N3,N2,N1)=TCAOHS(N3,N2,N1)+XCAOHS(N,N3,N2,N1) + 2-XCAOHS(N,N6,N5,N4) + TCACHS(N3,N2,N1)=TCACHS(N3,N2,N1)+XCACHS(N,N3,N2,N1) + 2-XCACHS(N,N6,N5,N4) + TCAHHS(N3,N2,N1)=TCAHHS(N3,N2,N1)+XCAHHS(N,N3,N2,N1) + 2-XCAHHS(N,N6,N5,N4) + TCASHS(N3,N2,N1)=TCASHS(N3,N2,N1)+XCASHS(N,N3,N2,N1) + 2-XCASHS(N,N6,N5,N4) + TMGOHS(N3,N2,N1)=TMGOHS(N3,N2,N1)+XMGOHS(N,N3,N2,N1) + 2-XMGOHS(N,N6,N5,N4) + TMGCHS(N3,N2,N1)=TMGCHS(N3,N2,N1)+XMGCHS(N,N3,N2,N1) + 2-XMGCHS(N,N6,N5,N4) + TMGHHS(N3,N2,N1)=TMGHHS(N3,N2,N1)+XMGHHS(N,N3,N2,N1) + 2-XMGHHS(N,N6,N5,N4) + TMGSHS(N3,N2,N1)=TMGSHS(N3,N2,N1)+XMGSHS(N,N3,N2,N1) + 2-XMGSHS(N,N6,N5,N4) + TNACHS(N3,N2,N1)=TNACHS(N3,N2,N1)+XNACHS(N,N3,N2,N1) + 2-XNACHS(N,N6,N5,N4) + TNASHS(N3,N2,N1)=TNASHS(N3,N2,N1)+XNASHS(N,N3,N2,N1) + 2-XNASHS(N,N6,N5,N4) + TKASHS(N3,N2,N1)=TKASHS(N3,N2,N1)+XKASHS(N,N3,N2,N1) + 2-XKASHS(N,N6,N5,N4) + TH0PHS(N3,N2,N1)=TH0PHS(N3,N2,N1)+XH0PHS(N,N3,N2,N1) + 2-XH0PHS(N,N6,N5,N4) + TH3PHS(N3,N2,N1)=TH3PHS(N3,N2,N1)+XH3PHS(N,N3,N2,N1) + 2-XH3PHS(N,N6,N5,N4) + TF1PHS(N3,N2,N1)=TF1PHS(N3,N2,N1)+XF1PHS(N,N3,N2,N1) + 2-XF1PHS(N,N6,N5,N4) + TF2PHS(N3,N2,N1)=TF2PHS(N3,N2,N1)+XF2PHS(N,N3,N2,N1) + 2-XF2PHS(N,N6,N5,N4) + TC0PHS(N3,N2,N1)=TC0PHS(N3,N2,N1)+XC0PHS(N,N3,N2,N1) + 2-XC0PHS(N,N6,N5,N4) + TC1PHS(N3,N2,N1)=TC1PHS(N3,N2,N1)+XC1PHS(N,N3,N2,N1) + 2-XC1PHS(N,N6,N5,N4) + TC2PHS(N3,N2,N1)=TC2PHS(N3,N2,N1)+XC2PHS(N,N3,N2,N1) + 2-XC2PHS(N,N6,N5,N4) + TM1PHS(N3,N2,N1)=TM1PHS(N3,N2,N1)+XM1PHS(N,N3,N2,N1) + 2-XM1PHS(N,N6,N5,N4) + TH0BHB(N3,N2,N1)=TH0BHB(N3,N2,N1)+XH0BHB(N,N3,N2,N1) + 2-XH0BHB(N,N6,N5,N4) + TH3BHB(N3,N2,N1)=TH3BHB(N3,N2,N1)+XH3BHB(N,N3,N2,N1) + 2-XH3BHB(N,N6,N5,N4) + TF1BHB(N3,N2,N1)=TF1BHB(N3,N2,N1)+XF1BHB(N,N3,N2,N1) + 2-XF1BHB(N,N6,N5,N4) + TF2BHB(N3,N2,N1)=TF2BHB(N3,N2,N1)+XF2BHB(N,N3,N2,N1) + 2-XF2BHB(N,N6,N5,N4) + TC0BHB(N3,N2,N1)=TC0BHB(N3,N2,N1)+XC0BHB(N,N3,N2,N1) + 2-XC0BHB(N,N6,N5,N4) + TC1BHB(N3,N2,N1)=TC1BHB(N3,N2,N1)+XC1BHB(N,N3,N2,N1) + 2-XC1BHB(N,N6,N5,N4) + TC2BHB(N3,N2,N1)=TC2BHB(N3,N2,N1)+XC2BHB(N,N3,N2,N1) + 2-XC2BHB(N,N6,N5,N4) + TM1BHB(N3,N2,N1)=TM1BHB(N3,N2,N1)+XM1BHB(N,N3,N2,N1) + 2-XM1BHB(N,N6,N5,N4) + ENDIF + ENDIF +8580 CONTINUE +8575 CONTINUE +C +C CALCULATE SURFACE RESIDUE TEMPERATURE FROM ITS CHANGE +C IN HEAT STORAGE +C + HFLXD=2.496E-06*(OSGX-ORGC(0,NY,NX))*TKS(0,NY,NX) + VOLW(0,NY,NX)=VOLW(0,NY,NX)+FLWR(NY,NX)+THAWR(NY,NX) + 2+TQR(NY,NX) + VOLI(0,NY,NX)=VOLI(0,NY,NX)-THAWR(NY,NX)/DENSI + ENGYR=VHCPR(NY,NX)*TKS(0,NY,NX)-HFLXD + VHCPR(NY,NX)=2.496E-06*ORGC(0,NY,NX)+4.19*VOLW(0,NY,NX) + 2+1.9274*VOLI(0,NY,NX) + IF(VHCPR(NY,NX).GT.ZEROS(NY,NX))THEN + TKS(0,NY,NX)=(ENGYR+HFLWR(NY,NX)+HTHAWR(NY,NX) + 2+THQR(NY,NX))/VHCPR(NY,NX) + ELSE + TKS(0,NY,NX)=TKS(NU(NY,NX),NY,NX) + ENDIF + IF(VHCPR(NY,NX).LT.VHCPRX(NY,NX))THEN + HFLXR=VHCPR(NY,NX)*(TKS(0,NY,NX)-TKS(NU(NY,NX),NY,NX)) + HEATOU=HEATOU+HFLXR + TKS(0,NY,NX)=TKS(NU(NY,NX),NY,NX) + ENDIF + HEATIN=HEATIN+HTHAWR(NY,NX)-HFLXD +C UVOLW(NY,NX)=UVOLW(NY,NX)-VOLW(0,NY,NX)-VOLI(0,NY,NX)*DENSI +C +C SURFACE BOUNDARY WATER FLUXES +C + WI=PRECQ(NY,NX)+PRECI(NY,NX) + CRAIN=CRAIN+WI + URAIN(NY,NX)=URAIN(NY,NX)+WI + WO=TEVAPG(NY,NX)+TEVAPP(NY,NX) + CEVAP=CEVAP-WO + UEVAP(NY,NX)=UEVAP(NY,NX)-WO + VOLWOU=VOLWOU-PRECU(NY,NX) + HVOLO(NY,NX)=HVOLO(NY,NX)-PRECU(NY,NX) + UVOLO(NY,NX)=UVOLO(NY,NX)-PRECU(NY,NX) + UDRAIN(NY,NX)=UDRAIN(NY,NX)+FLW(3,NK(NY,NX),NY,NX) +C +C SURFACE BOUNDARY HEAT FLUXES +C + HEATIN=HEATIN+4.19*TKA(NY,NX)*PRECA(NY,NX) + 2+2.095*TKA(NY,NX)*PRECW(NY,NX) + HEATIN=HEATIN+HEATH(NY,NX)+HTHAWW(NY,NX)+THFLXC(NY,NX) + HEATOU=HEATOU-4.19*TKA(NY,NX)*PRECU(NY,NX) +C WRITE(*,5151)'TK0',I,J,NX,NY,TKS(0,NY,NX),ENGYR +C 2,HFLWR(NY,NX),HFLXD,HTHAWR(NY,NX),VHCPR(NY,NX),VOLW(0,NY,NX) +C 3,VOLI(0,NY,NX),FLWR(NY,NX),THAWR(NY,NX) +C 3,ORGC(0,NY,NX),VHCPR(NY,NX)*TKS(0,NY,NX),TQR(NY,NX) +C 4,THQR(NY,NX),HEATH(NY,NX),HTHAWW(NY,NX),THFLXC(NY,NX),HEATIN +5151 FORMAT(A8,4I4,30F20.6) +C +C SURFACE BOUNDARY CO2, CH4 AND DOC FLUXES +C + CI=XCODFS(NY,NX)+XCOFLG(3,NU(NY,NX),NY,NX)+TCO2Z(NY,NX) + 2+(FLQGQ(NY,NX)+FLQRQ(NY,NX))*CCOR(NY,NX) + 3+(FLQGI(NY,NX)+FLQRI(NY,NX))*CCOQ(NY,NX) + 4+XCODFG(0,NY,NX)+XCODFR(NY,NX) + CH=XCHDFS(NY,NX)+XCHFLG(3,NU(NY,NX),NY,NX)+TCH4Z(NY,NX) + 2+(FLQGQ(NY,NX)+FLQRQ(NY,NX))*CCHR(NY,NX) + 3+(FLQGI(NY,NX)+FLQRI(NY,NX))*CCHQ(NY,NX) + 4+XCHDFG(0,NY,NX)+XCHDFR(NY,NX) + CO=-PRECU(NY,NX)*CCOQ(NY,NX) + CX=-PRECU(NY,NX)*CCHQ(NY,NX) + UCO2G(NY,NX)=UCO2G(NY,NX)+CI + HCO2G(NY,NX)=HCO2G(NY,NX)+CI + UCH4G(NY,NX)=UCH4G(NY,NX)+CH + HCH4G(NY,NX)=HCH4G(NY,NX)+CH + CO2GIN=CO2GIN+CI+CH + TCOU=TCOU+CO+CX + TNBP(NY,NX)=TNBP(NY,NX)+CH +C IF(NX.EQ.3.AND.NY.EQ.3)THEN +C WRITE(*,6644)'CO2',I,J,NX,NY,HCO2G(NY,NX),CI,XCODFS(NY,NX) +C 2,XCOFLG(3,NU(NY,NX),NY,NX),TCO2Z(NY,NX) +C 3,(FLQGQ(NY,NX)+FLQRQ(NY,NX))*CCOR(NY,NX) +C 4,(FLQGI(NY,NX)+FLQRI(NY,NX))*CCOQ(NY,NX) +C 5,XCODFG(0,NY,NX),XCODFR(NY,NX),VOLP(0,NY,NX) +C 6,VOLP(NU(NY,NX),NY,NX) +C WRITE(*,6644)'CH4',I,J,NX,NY,CH,XCHDFS(NY,NX) +C 2,XCHFLG(3,NU(NY,NX),NY,NX),TCH4Z(NY,NX),FLQGQ(NY,NX) +C 3,FLQRQ(NY,NX),FLQGI(NY,NX),FLQRI(NY,NX),CCHR(NY,NX),CCHQ(NY,NX) +C 4,XCHDFG(0,NY,NX),XCHDFR(NY,NX),CH4S(NU(NY,NX),NY,NX) +6644 FORMAT(A8,4I4,30E12.4) +C ENDIF +C +C SURFACE BOUNDARY O2 FLUXES +C + OI=XOXDFS(NY,NX)+XOXFLG(3,NU(NY,NX),NY,NX)+TOXYZ(NY,NX) + 2+(FLQGQ(NY,NX)+FLQRQ(NY,NX))*COXR(NY,NX) + 3+(FLQGI(NY,NX)+FLQRI(NY,NX))*COXQ(NY,NX) + 4+XOXDFG(0,NY,NX)+XOXDFR(NY,NX) + OXYGIN=OXYGIN+OI + OO=RUPOXO(0,NY,NX)-PRECU(NY,NX)*COXQ(NY,NX) + OXYGOU=OXYGOU+OO + UOXYG(NY,NX)=UOXYG(NY,NX)+OI + HOXYG(NY,NX)=HOXYG(NY,NX)+OI + HI=XHGDFS(NY,NX)+XHGFLG(3,NU(NY,NX),NY,NX)+TH2GZ(NY,NX) + 2+XHGDFG(0,NY,NX)+XHGDFR(NY,NX) + H2GIN=H2GIN+HI + HO=RH2GO(0,NY,NX) + H2GOU=H2GOU+HO +C IF(NX.EQ.2.AND.NY.EQ.1)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) +C 3,(FLQGI(NY,NX)+FLQRI(NY,NX))*CCOQ(NY,NX) +C 4,XCODFG(0,NY,NX),XCODFR(NY,NX) +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) +6646 FORMAT(A8,4I4,60E12.4) +C ENDIF +C +C SURFACE BOUNDARY N2, N2O, NH3, NH4, NO3, AND DON FLUXES +C + ZSI=((FLQGQ(NY,NX)+FLQRQ(NY,NX)) + 2*(CN4R(NY,NX)+CN3R(NY,NX)+CNOR(NY,NX)) + 3+(FLQGI(NY,NX)+FLQRI(NY,NX)) + 4*(CN4Q(I,NY,NX)+CN3Q(I,NY,NX)+CNOQ(I,NY,NX)))*14.0 + ZXB=-PRECU(NY,NX)*(CNNQ(NY,NX)+CN2Q(NY,NX))-PRECU(NY,NX) + 2*(CN4Q(I,NY,NX)+CN3Q(I,NY,NX)+CNOQ(I,NY,NX))*14.0 + TZIN=TZIN+ZSI + TZOU=TZOU+ZXB + ZGI=(FLQGQ(NY,NX)+FLQRQ(NY,NX))*(CNNR(NY,NX)+CN2R(NY,NX)) + 2+(FLQGI(NY,NX)+FLQRI(NY,NX))*(CNNQ(NY,NX)+CN2Q(NY,NX)) + 3+XNGDFS(NY,NX)+XN2DFS(NY,NX)+XN3DFS(NY,NX) + 2+XNBDFS(NY,NX)+XNGFLG(3,NU(NY,NX),NY,NX) + 2+XN2FLG(3,NU(NY,NX),NY,NX)+XN3FLG(3,NU(NY,NX),NY,NX) + 3+TN2OZ(NY,NX)+TNH3Z(NY,NX) + 6+XN2DFG(0,NY,NX)+XNGDFG(0,NY,NX)+XN3DFG(0,NY,NX) + 7+XNGDFR(NY,NX)+XN2DFR(NY,NX)+XN3DFR(NY,NX) + ZN2GIN=ZN2GIN+ZGI + ZDRAIN(NY,NX)=ZDRAIN(NY,NX)+XN4FLW(3,NK(NY,NX),NY,NX) + 2+XN3FLW(3,NK(NY,NX),NY,NX)+XNOFLW(3,NK(NY,NX),NY,NX) + 3+XNXFLS(3,NK(NY,NX),NY,NX)+XN4FLB(3,NK(NY,NX),NY,NX) + 4+XN3FLB(3,NK(NY,NX),NY,NX)+XNOFLB(3,NK(NY,NX),NY,NX) + 5+XNXFLB(3,NK(NY,NX),NY,NX) + ZNGGIN=XNGDFS(NY,NX)+XNGFLG(3,NU(NY,NX),NY,NX)+XNGDFG(0,NY,NX) + ZN2OIN=XN2DFS(NY,NX)+XN2FLG(3,NU(NY,NX),NY,NX)+XN2DFG(0,NY,NX) + ZNH3IN=XN3DFS(NY,NX)+XNBDFS(NY,NX)+XN3FLG(3,NU(NY,NX),NY,NX) + 2+XN3DFG(0,NY,NX) +C UN2GG(NY,NX)=UN2GG(NY,NX)+ZNGGIN +C HN2GG(NY,NX)=HN2GG(NY,NX)+ZNGGIN + UN2OG(NY,NX)=UN2OG(NY,NX)+ZN2OIN + HN2OG(NY,NX)=HN2OG(NY,NX)+ZN2OIN + UNH3G(NY,NX)=UNH3G(NY,NX)+ZNH3IN + HNH3G(NY,NX)=HNH3G(NY,NX)+ZNH3IN + UN2GS(NY,NX)=UN2GS(NY,NX)+XN2GS(0,NY,NX) + UH2GG(NY,NX)=UH2GG(NY,NX)+HI +C WRITE(*,6644)'HNH3G',I,J,NX,NY,HNH3G(NY,NX),ZNH3IN +C 2,XN3DFS(NY,NX),XNBDFS(NY,NX),XN3FLG(3,NU(NY,NX),NY,NX) +C 2,XN3DFG(0,NY,NX) +C WRITE(*,6644)'ZN2GIN',I,J,NX,NY,ZN2GIN,XNGDFS(NY,NX) +C 3,XN2DFS(NY,NX),XN3DFS(NY,NX) +C 2,XNBDFS(NY,NX),XNGFLG(3,NU(NY,NX),NY,NX) +C 2,XN2FLG(3,NU(NY,NX),NY,NX) +C 3,XN3FLG(3,NU(NY,NX),NY,NX),TN2OZ(NY,NX),TNH3Z(NY,NX) +C 4,(FLQGQ(NY,NX)+FLQRQ(NY,NX))*(CNNR(NY,NX)+CN2R(NY,NX)) +C 5,(FLQGI(NY,NX)+FLQRI(NY,NX))*(CNNQ(NY,NX)+CN2Q(NY,NX)) +C 6,XN2DFG(0,NY,NX)+XNGDFG(0,NY,NX),XN3DFG(0,NY,NX) +C 7,XNGDFR(NY,NX)+XN2DFR(NY,NX),XN3DFR(NY,NX) +C +C SURFACE BOUNDARY PO4 AND DOP FLUXES +C + PI=31.0*((FLQGQ(NY,NX)+FLQRQ(NY,NX)) + 2*(CPOR(NY,NX)+CH1PR(NY,NX)) + 3+(FLQGI(NY,NX)+FLQRI(NY,NX)) + 4*(CPOQ(I,NY,NX)+CH1PQ(I,NY,NX))) + PXB=-31.0*PRECU(NY,NX)*(CPOQ(I,NY,NX)+CH1PQ(I,NY,NX)) + TPIN=TPIN+PI + TPOU=TPOU+PXB + PDRAIN(NY,NX)=PDRAIN(NY,NX)+XH2PFS(3,NK(NY,NX),NY,NX) + 2+XH2BFB(3,NK(NY,NX),NY,NX)+XH1PFS(3,NK(NY,NX),NY,NX) + 2+XH1BFB(3,NK(NY,NX),NY,NX) +C +C SURFACE BOUNDARY ION FLUXES +C + SIN=((FLQGQ(NY,NX)+FLQRQ(NY,NX)) + 2*(2.0*CN4R(NY,NX)+CN3R(NY,NX)+CNOR(NY,NX)) + 3+(FLQGI(NY,NX)+FLQRI(NY,NX)) + 4*(2.0*CN4Q(I,NY,NX)+CN3Q(I,NY,NX)+CNOQ(I,NY,NX))) + SGN=(2.0*(FLQGQ(NY,NX)+FLQRQ(NY,NX))*(CNNR(NY,NX)+CN2R(NY,NX)) + 2+2.0*(FLQGI(NY,NX)+FLQRI(NY,NX))*(CNNQ(NY,NX)+CN2Q(NY,NX)) + 3+2.0*(XNGDFS(NY,NX)+XN2DFS(NY,NX))+XN3DFS(NY,NX) + 2+XNBDFS(NY,NX)+2.0*(XNGFLG(3,NU(NY,NX),NY,NX) + 2+XN2FLG(3,NU(NY,NX),NY,NX))+XN3FLG(3,NU(NY,NX),NY,NX) + 3+2.0*TN2OZ(NY,NX)+TNH3Z(NY,NX) + 6+2.0*(XN2DFG(0,NY,NX)+XNGDFG(0,NY,NX))+XN3DFG(0,NY,NX) + 7+2.0*(XNGDFR(NY,NX)+XN2DFR(NY,NX))+XN3DFR(NY,NX))/14.0 + SIP=((FLQGQ(NY,NX)+FLQRQ(NY,NX)) + 2*(3.0*CPOR(NY,NX)+2.0*CH1PR(NY,NX)) + 3+(FLQGI(NY,NX)+FLQRI(NY,NX)) + 4*(3.0*CPOQ(I,NY,NX)+2.0*CH1PQ(I,NY,NX))) + SNB=-PRECU(NY,NX)*(CNNQ(NY,NX)+CN2Q(NY,NX))-PRECU(NY,NX) + 2*(2.0*CN4Q(I,NY,NX)+CN3Q(I,NY,NX)+CNOQ(I,NY,NX)) + SPB=-PRECU(NY,NX)*(3.0*CPOQ(I,NY,NX)+2.0*CH1PQ(I,NY,NX)) + SNM0=(2.0*XNH4S(0,NY,NX)+XNO3S(0,NY,NX)+XNO2S(0,NY,NX) + 2-2.0*XN2GS(0,NY,NX))/14.0 + SPM0=(2.0*XH1PS(0,NY,NX)+3.0*XH2PS(0,NY,NX))/31.0 +C +C ACCUMULATE PLANT LITTERFALL FLUXES +C + XCSN=XCSN+ZCSNC(NY,NX) + XZSN=XZSN+ZZSNC(NY,NX) + XPSN=XPSN+ZPSNC(NY,NX) + UXCSN(NY,NX)=UXCSN(NY,NX)+ZCSNC(NY,NX) + UXZSN(NY,NX)=UXZSN(NY,NX)+ZZSNC(NY,NX) + UXPSN(NY,NX)=UXPSN(NY,NX)+ZPSNC(NY,NX) +C +C SURFACE BOUNDARY SALT FLUXES FROM RAINFALL AND SURFACE IRRIGATION +C + IF(ISALT(NY,NX).NE.0)THEN + SIR=PRECQ(NY,NX)*(CALR(NY,NX)+CFER(NY,NX)+CHYR(NY,NX)+CCAR(NY,NX) + 2+CMGR(NY,NX)+CNAR(NY,NX)+CKAR(NY,NX)+COHR(NY,NX)+CSOR(NY,NX) + 3+CCLR(NY,NX)+CC3R(NY,NX)+CH0PR(NY,NX) + 4+2.0*(CHCR(NY,NX)+CAL1R(NY,NX)+CALSR(NY,NX)+CFE1R(NY,NX) + 5+CFESR(NY,NX)+CCAOR(NY,NX)+CCACR(NY,NX)+CCASR(NY,NX)+CMGOR(NY,NX) + 6+CMGCR(NY,NX)+CMGSR(NY,NX)+CNACR(NY,NX)+CNASR(NY,NX) + 7+CKASR(NY,NX)+CC0PR(NY,NX)) + 8+3.0*(CAL2R(NY,NX)+CFE2R(NY,NX)+CCAHR(NY,NX)+CMGHR(NY,NX) + 9+CF1PR(NY,NX)+CC1PR(NY,NX)+CM1PR(NY,NX)) + 1+4.0*(CAL3R(NY,NX)+CFE3R(NY,NX)+CH3PR(NY,NX)+CF2PR(NY,NX) + 2+CC2PR(NY,NX)) + 3+5.0*(CAL4R(NY,NX)+CFE4R(NY,NX))) + SII=PRECI(NY,NX)*(CALQ(I,NY,NX)+CFEQ(I,NY,NX)+CHYQ(I,NY,NX) + 2+CCAQ(I,NY,NX)+CMGQ(I,NY,NX)+CNAQ(I,NY,NX)+CKAQ(I,NY,NX) + 3+COHQ(I,NY,NX)+CSOQ(I,NY,NX)+CCLQ(I,NY,NX)+CC3Q(I,NY,NX) + 4+CH0PQ(I,NY,NX) + 5+2.0*(CHCQ(I,NY,NX)+CAL1Q(I,NY,NX)+CALSQ(I,NY,NX) + 5+CFE1Q(I,NY,NX)+CFESQ(I,NY,NX)+CCAOQ(I,NY,NX)+CCACQ(I,NY,NX) + 6+CCASQ(I,NY,NX)+CMGOQ(I,NY,NX)+CMGCQ(I,NY,NX)+CMGSQ(I,NY,NX) + 7+CNACQ(I,NY,NX)+CNASQ(I,NY,NX)+CKASQ(I,NY,NX)+CC0PQ(I,NY,NX)) + 9+3.0*(CAL2Q(I,NY,NX)+CFE2Q(I,NY,NX)+CCAHQ(I,NY,NX) + 9+CMGHQ(I,NY,NX)+CF1PQ(I,NY,NX)+CC1PQ(I,NY,NX)+CM1PQ(I,NY,NX)) + 2+4.0*(CAL3Q(I,NY,NX)+CFE3Q(I,NY,NX) + 2+CH3PQ(I,NY,NX)+CF2PQ(I,NY,NX)+CC2PQ(I,NY,NX)) + 3+5.0*(CAL4Q(I,NY,NX)+CFE4Q(I,NY,NX))) + TIONIN=TIONIN+SIR+SII +C WRITE(20,3338)'SIR',I,J,SIR,PRECQ(NY,NX) +C 2,CALR(NY,NX),CFER(NY,NX),CHYR(NY,NX),CCAR(NY,NX) +C 2,CMGR(NY,NX),CNAR(NY,NX),CKAR(NY,NX),COHR(NY,NX),CSOR(NY,NX) +C 3,CCLR(NY,NX),CC3R(NY,NX),CH0PR(NY,NX) +C 4,CHCR(NY,NX),CAL1R(NY,NX),CALSR(NY,NX),CFE1R(NY,NX) +C 5,CFESR(NY,NX),CCAOR(NY,NX),CCACR(NY,NX),CCASR(NY,NX),CMGOR(NY,NX) +C 6,CMGCR(NY,NX),CMGSR(NY,NX),CNACR(NY,NX),CNASR(NY,NX) +C 7,CKASR(NY,NX),CC0PR(NY,NX) +C 8,CAL2R(NY,NX),CFE2R(NY,NX),CCAHR(NY,NX),CMGHR(NY,NX) +C 9,CF1PR(NY,NX),CC1PR(NY,NX),CM1PR(NY,NX) +C 1,CAL3R(NY,NX),CFE3R(NY,NX),CH3PR(NY,NX),CF2PR(NY,NX) +C 2,CC2PR(NY,NX),CAL4R(NY,NX),CFE4R(NY,NX) +C +C SUBSURFACE BOUNDARY SALT FLUXES FROM SUBSURFACE IRRIGATION +C + SBU=-PRECU(NY,NX)*(CALQ(I,NY,NX)+CFEQ(I,NY,NX)+CHYQ(I,NY,NX) + 2+CCAQ(I,NY,NX)+CMGQ(I,NY,NX)+CNAQ(I,NY,NX)+CKAQ(I,NY,NX) + 3+COHQ(I,NY,NX)+CSOQ(I,NY,NX)+CCLQ(I,NY,NX)+CC3Q(I,NY,NX) + 4+CH0PQ(I,NY,NX) + 5+2.0*(CHCQ(I,NY,NX)+CAL1Q(I,NY,NX)+CALSQ(I,NY,NX) + 5+CFE1Q(I,NY,NX)+CFESQ(I,NY,NX)+CCAOQ(I,NY,NX)+CCACQ(I,NY,NX) + 6+CCASQ(I,NY,NX)+CMGOQ(I,NY,NX)+CMGCQ(I,NY,NX)+CMGSQ(I,NY,NX) + 7+CNACQ(I,NY,NX)+CNASQ(I,NY,NX)+CKASQ(I,NY,NX)+CC0PQ(I,NY,NX)) + 9+3.0*(CAL2Q(I,NY,NX)+CFE2Q(I,NY,NX)+CCAHQ(I,NY,NX)+CMGHQ(I,NY,NX) + 9+CF1PQ(I,NY,NX)+CC1PQ(I,NY,NX)+CM1PQ(I,NY,NX)) + 4+4.0*(CAL3Q(I,NY,NX)+CFE3Q(I,NY,NX) + 2+CH3PQ(I,NY,NX)+CF2PQ(I,NY,NX)+CC2PQ(I,NY,NX)) + 3+5.0*(CAL4Q(I,NY,NX)+CFE4Q(I,NY,NX))) + TIONOU=TIONOU+SBU + ENDIF +C +C GAS EXCHANGE FROM SURFACE VOLATILIZATION-DISSOLUTION +C + DO 9680 K=0,2 + OQC(K,0,NY,NX)=OQC(K,0,NY,NX)+XOCFLS(K,3,0,NY,NX) + OQN(K,0,NY,NX)=OQN(K,0,NY,NX)+XONFLS(K,3,0,NY,NX) + OQP(K,0,NY,NX)=OQP(K,0,NY,NX)+XOPFLS(K,3,0,NY,NX) + OQA(K,0,NY,NX)=OQA(K,0,NY,NX)+XOAFLS(K,3,0,NY,NX) +9680 CONTINUE + CO2S(0,NY,NX)=CO2S(0,NY,NX)+XCODFR(NY,NX)+XCOFLS(3,0,NY,NX) + 2+XCODFG(0,NY,NX)-RCO2O(0,NY,NX) + CH4S(0,NY,NX)=CH4S(0,NY,NX)+XCHDFR(NY,NX)+XCHFLS(3,0,NY,NX) + 2+XCHDFG(0,NY,NX)-RCH4O(0,NY,NX) + OXYS(0,NY,NX)=OXYS(0,NY,NX)+XOXDFR(NY,NX)+XOXFLS(3,0,NY,NX) + 2+XOXDFG(0,NY,NX)-RUPOXO(0,NY,NX) + Z2GS(0,NY,NX)=Z2GS(0,NY,NX)+XNGDFR(NY,NX)+XNGFLS(3,0,NY,NX) + 2+XNGDFG(0,NY,NX)-RN2G(0,NY,NX)-XN2GS(0,NY,NX) + Z2OS(0,NY,NX)=Z2OS(0,NY,NX)+XN2DFR(NY,NX)+XN2FLS(3,0,NY,NX) + 2+XN2DFG(0,NY,NX)-RN2O(0,NY,NX) + H2GS(0,NY,NX)=H2GS(0,NY,NX)+XHGDFR(NY,NX)+XHGFLS(3,0,NY,NX) + 2+XHGDFG(0,NY,NX)-RH2GO(0,NY,NX) + ZNH4S(0,NY,NX)=ZNH4S(0,NY,NX)+XN4FLW(3,0,NY,NX) + 2+XNH4S(0,NY,NX)+TRN4S(0,NY,NX) + ZNH3S(0,NY,NX)=ZNH3S(0,NY,NX)+XN3DFR(NY,NX)+XN3FLW(3,0,NY,NX) + 2+XN3DFG(0,NY,NX)+TRN3S(0,NY,NX) + ZNO3S(0,NY,NX)=ZNO3S(0,NY,NX)+XNOFLW(3,0,NY,NX) + 2+XNO3S(0,NY,NX)+TRNO3(0,NY,NX) + ZNO2S(0,NY,NX)=ZNO2S(0,NY,NX)+XNXFLS(3,0,NY,NX) + 2+XNO2S(0,NY,NX) + H1PO4(0,NY,NX)=H1PO4(0,NY,NX)+TRH1P(0,NY,NX)+XH1PFS(3,0,NY,NX) + 2+XH1PS(0,NY,NX) + H2PO4(0,NY,NX)=H2PO4(0,NY,NX)+TRH2P(0,NY,NX)+XH2PFS(3,0,NY,NX) + 2+XH2PS(0,NY,NX) + CO2S(NU(NY,NX),NY,NX)=CO2S(NU(NY,NX),NY,NX)+XCODFS(NY,NX) + CH4S(NU(NY,NX),NY,NX)=CH4S(NU(NY,NX),NY,NX)+XCHDFS(NY,NX) + OXYS(NU(NY,NX),NY,NX)=OXYS(NU(NY,NX),NY,NX)+XOXDFS(NY,NX) + Z2GS(NU(NY,NX),NY,NX)=Z2GS(NU(NY,NX),NY,NX)+XNGDFS(NY,NX) + Z2OS(NU(NY,NX),NY,NX)=Z2OS(NU(NY,NX),NY,NX)+XN2DFS(NY,NX) + ZNH3S(NU(NY,NX),NY,NX)=ZNH3S(NU(NY,NX),NY,NX)+XN3DFS(NY,NX) + ZNH3B(NU(NY,NX),NY,NX)=ZNH3B(NU(NY,NX),NY,NX)+XNBDFS(NY,NX) + H2GS(NU(NY,NX),NY,NX)=H2GS(NU(NY,NX),NY,NX)+XHGDFS(NY,NX) + SED(NY,NX)=SED(NY,NX)+XDTSED(NY,NX) + THRE(NY,NX)=THRE(NY,NX)+RCO2O(0,NY,NX) + UN2GG(NY,NX)=UN2GG(NY,NX)+RN2G(0,NY,NX) + HN2GG(NY,NX)=HN2GG(NY,NX)+RN2G(0,NY,NX) + ROXYF(0,NY,NX)=XOXDFG(0,NY,NX) + RCO2F(0,NY,NX)=XCODFG(0,NY,NX) + RCH4F(0,NY,NX)=XCHDFG(0,NY,NX) + ROXYL(0,NY,NX)=XOXDFR(NY,NX)+XOXFLS(3,0,NY,NX) + 2-(FLQRQ(NY,NX)*COXR(NY,NX)+FLQRI(NY,NX)*COXQ(NY,NX)) + RCH4L(0,NY,NX)=XCHDFR(NY,NX)+XCHFLS(3,0,NY,NX) + 2-(FLQRQ(NY,NX)*CCHR(NY,NX)+FLQRI(NY,NX)*CCHQ(NY,NX)) + ROXYL(NU(NY,NX),NY,NX)=ROXYL(NU(NY,NX),NY,NX)+XOXDFS(NY,NX) + RCH4L(NU(NY,NX),NY,NX)=RCH4L(NU(NY,NX),NY,NX)+XCHDFS(NY,NX) +C +C SURFACE LITTER ION EXCHANGE AND PRECIPITATION +C + XN4(0,NY,NX)=XN4(0,NY,NX)+TRXN4(0,NY,NX) + XOH0(0,NY,NX)=XOH0(0,NY,NX)+TRXH0(0,NY,NX) + XOH1(0,NY,NX)=XOH1(0,NY,NX)+TRXH1(0,NY,NX) + XOH2(0,NY,NX)=XOH2(0,NY,NX)+TRXH2(0,NY,NX) + XH1P(0,NY,NX)=XH1P(0,NY,NX)+TRX1P(0,NY,NX) + XH2P(0,NY,NX)=XH2P(0,NY,NX)+TRX2P(0,NY,NX) + PALPO(0,NY,NX)=PALPO(0,NY,NX)+TRALPO(0,NY,NX) + PFEPO(0,NY,NX)=PFEPO(0,NY,NX)+TRFEPO(0,NY,NX) + PCAPD(0,NY,NX)=PCAPD(0,NY,NX)+TRCAPD(0,NY,NX) + PCAPH(0,NY,NX)=PCAPH(0,NY,NX)+TRCAPH(0,NY,NX) + PCAPM(0,NY,NX)=PCAPM(0,NY,NX)+TRCAPM(0,NY,NX) +C +C SURFACE LITTER OUTPUTS +C +C IF(NX.EQ.1.AND.NY.EQ.6)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) +C WRITE(*,1119)'CH4S0',I,J,NX,NY,CH4S(0,NY,NX),XCHDFS(NY,NX) +C 2,XCHDFR(NY,NX),XCHFLS(3,0,NY,NX),RCH4O(0,NY,NX),XCHDFG(0,NY,NX) +C 3,RCH4L(0,NY,NX) +C WRITE(*,1119)'OXYS0',I,J,NX,NY,OXYS(0,NY,NX),XOXDFR(NY,NX) +C 2,XOXFLS(3,0,NY,NX),XOXDFG(0,NY,NX),RUPOXO(0,NY,NX) +C 3,ROXYL(0,NY,NX),TOXQRS(NY,NX) +1119 FORMAT(A8,4I4,12E12.4) +C ENDIF +C IF(NX.EQ.5)THEN +C WRITE(20,5533)'NH30',I,J,NX,NY,ZNH4S(0,NY,NX),XN4FLW(3,0,NY,NX) +C 2,XNH4S(0,NY,NX),XN3FLW(3,0,NY,NX),TRN4S(0,NY,NX) +C 3,ZNH3S(0,NY,NX),TRN3S(0,NY,NX),XN3DFG(0,NY,NX),XN3DFR(NY,NX) +C 4,ZNHUFA(0,NY,NX),XNO2S(0,NY,NX),XN4(0,NY,NX)*14.0 +C WRITE(*,5533)'ZNO3S0',I,J,NX,NY,ZNO3S(0,NY,NX),XNOFLW(3,0,NY,NX) +C 2,XNO3S(0,NY,NX),TRNO3(0,NY,NX),ZNO2S(0,NY,NX),XNXFLS(3,0,NY,NX) +C 3,XNO2S(0,NY,NX) +C WRITE(*,5533)'H2PO40',I,J,NX,NY,H2PO4(0,NY,NX) +C 2,XH2PFS(3,0,NY,NX),XH2PS(0,NY,NX),TRH2P(0,NY,NX) +5533 FORMAT(A8,4I4,20F14.7) +C ENDIF +C WRITE(*,5544)'HP140',I,J,NX,NY,H1PO4(0,NY,NX) +C 2,XH1P(0,NY,NX),TRH1P(0,NY,NX),XH1PFS(3,0,NY,NX) +C 2,XH1PS(0,NY,NX),TP1QRS(NY,NX) +C WRITE(*,5544)'HP240',I,J,NX,NY,H2PO4(0,NY,NX) +C 2,XH2P(0,NY,NX),TRH2P(0,NY,NX),XH2PFS(3,0,NY,NX) +C 2,XH2PS(0,NY,NX),TPOQRS(NY,NX) +5544 FORMAT(A8,4I4,40E12.4) +C +C OVERLAND FLOW +C + IF(TQR(NY,NX).NE.0.0)THEN +C +C DOC, DON, DOP +C + DO 8570 K=0,2 + OQC(K,0,NY,NX)=OQC(K,0,NY,NX)+TOCQRS(K,NY,NX) + OQN(K,0,NY,NX)=OQN(K,0,NY,NX)+TONQRS(K,NY,NX) + OQP(K,0,NY,NX)=OQP(K,0,NY,NX)+TOPQRS(K,NY,NX) + OQA(K,0,NY,NX)=OQA(K,0,NY,NX)+TOAQRS(K,NY,NX) +C IF(NX.EQ.1.AND.NY.EQ.6)THEN +C WRITE(*,2626)'OQC0',I,J,NX,NY,K,OQC(K,0,NY,NX) +C 2,TOCQRS(K,NY,NX),OQN(K,0,NY,NX),TONQRS(K,NY,NX) +2626 FORMAT(A8,5I4,20E12.4) +C ENDIF +8570 CONTINUE +C +C SOLUTES +C + CO2S(0,NY,NX)=CO2S(0,NY,NX)+TCOQRS(NY,NX) + CH4S(0,NY,NX)=CH4S(0,NY,NX)+TCHQRS(NY,NX) + OXYS(0,NY,NX)=OXYS(0,NY,NX)+TOXQRS(NY,NX) + Z2GS(0,NY,NX)=Z2GS(0,NY,NX)+TNGQRS(NY,NX) + Z2OS(0,NY,NX)=Z2OS(0,NY,NX)+TN2QRS(NY,NX) + H2GS(0,NY,NX)=H2GS(0,NY,NX)+THGQRS(NY,NX) + ZNH4S(0,NY,NX)=ZNH4S(0,NY,NX)+TN4QRS(NY,NX) + ZNH3S(0,NY,NX)=ZNH3S(0,NY,NX)+TN3QRS(NY,NX) + ZNO3S(0,NY,NX)=ZNO3S(0,NY,NX)+TNOQRS(NY,NX) + ZNO2S(0,NY,NX)=ZNO2S(0,NY,NX)+TNXQRS(NY,NX) + H1PO4(0,NY,NX)=H1PO4(0,NY,NX)+TP1QRS(NY,NX) + H2PO4(0,NY,NX)=H2PO4(0,NY,NX)+TPOQRS(NY,NX) + IF(ISALT(NY,NX).NE.0)THEN + ZAL(0,NY,NX)=ZAL(0,NY,NX)+TQRAL(NY,NX) + ZFE(0,NY,NX)=ZFE(0,NY,NX)+TQRFE(NY,NX) + ZHY(0,NY,NX)=ZHY(0,NY,NX)+TQRHY(NY,NX) + ZCA(0,NY,NX)=ZCA(0,NY,NX)+TQRCA(NY,NX) + ZMG(0,NY,NX)=ZMG(0,NY,NX)+TQRMG(NY,NX) + ZNA(0,NY,NX)=ZNA(0,NY,NX)+TQRNA(NY,NX) + ZKA(0,NY,NX)=ZKA(0,NY,NX)+TQRKA(NY,NX) + ZOH(0,NY,NX)=ZOH(0,NY,NX)+TQROH(NY,NX) + ZSO4(0,NY,NX)=ZSO4(0,NY,NX)+TQRSO(NY,NX) + ZCL(0,NY,NX)=ZCL(0,NY,NX)+TQRCL(NY,NX) + ZCO3(0,NY,NX)=ZCO3(0,NY,NX)+TQRC3(NY,NX) + ZHCO3(0,NY,NX)=ZHCO3(0,NY,NX)+TQRHC(NY,NX) + ZALOH1(0,NY,NX)=ZALOH1(0,NY,NX)+TQRAL1(NY,NX) + ZALOH2(0,NY,NX)=ZALOH2(0,NY,NX)+TQRAL2(NY,NX) + ZALOH3(0,NY,NX)=ZALOH3(0,NY,NX)+TQRAL3(NY,NX) + ZALOH4(0,NY,NX)=ZALOH4(0,NY,NX)+TQRAL4(NY,NX) + ZALS(0,NY,NX)=ZALS(0,NY,NX)+TQRALS(NY,NX) + ZFEOH1(0,NY,NX)=ZFEOH1(0,NY,NX)+TQRFE1(NY,NX) + ZFEOH2(0,NY,NX)=ZFEOH2(0,NY,NX)+TQRFE2(NY,NX) + ZFEOH3(0,NY,NX)=ZFEOH3(0,NY,NX)+TQRFE3(NY,NX) + ZFEOH4(0,NY,NX)=ZFEOH4(0,NY,NX)+TQRFE4(NY,NX) + ZFES(0,NY,NX)=ZFES(0,NY,NX)+TQRFES(NY,NX) + ZCAO(0,NY,NX)=ZCAO(0,NY,NX)+TQRCAO(NY,NX) + ZCAC(0,NY,NX)=ZCAC(0,NY,NX)+TQRCAC(NY,NX) + ZCAH(0,NY,NX)=ZCAH(0,NY,NX)+TQRCAH(NY,NX) + ZCAS(0,NY,NX)=ZCAS(0,NY,NX)+TQRCAS(NY,NX) + ZMGO(0,NY,NX)=ZMGO(0,NY,NX)+TQRMGO(NY,NX) + ZMGC(0,NY,NX)=ZMGC(0,NY,NX)+TQRMGC(NY,NX) + ZMGH(0,NY,NX)=ZMGH(0,NY,NX)+TQRMGH(NY,NX) + ZMGS(0,NY,NX)=ZMGS(0,NY,NX)+TQRMGS(NY,NX) + ZNAC(0,NY,NX)=ZNAC(0,NY,NX)+TQRNAC(NY,NX) + ZNAS(0,NY,NX)=ZNAS(0,NY,NX)+TQRNAS(NY,NX) + ZKAS(0,NY,NX)=ZKAS(0,NY,NX)+TQRKAS(NY,NX) + H0PO4(0,NY,NX)=H0PO4(0,NY,NX)+TQRH0P(NY,NX) + H3PO4(0,NY,NX)=H3PO4(0,NY,NX)+TQRH3P(NY,NX) + ZFE1P(0,NY,NX)=ZFE1P(0,NY,NX)+TQRF1P(NY,NX) + ZFE2P(0,NY,NX)=ZFE2P(0,NY,NX)+TQRF2P(NY,NX) + ZCA0P(0,NY,NX)=ZCA0P(0,NY,NX)+TQRC0P(NY,NX) + ZCA1P(0,NY,NX)=ZCA1P(0,NY,NX)+TQRC1P(NY,NX) + ZCA2P(0,NY,NX)=ZCA2P(0,NY,NX)+TQRC2P(NY,NX) + ZMG1P(0,NY,NX)=ZMG1P(0,NY,NX)+TQRM1P(NY,NX) + ENDIF +C +C OVERLAND SNOW REDISTRIBUTION +C + IF(TQS(NY,NX).NE.0.0)THEN + CO2W(NY,NX)=CO2W(NY,NX)+TCOQSS(NY,NX) + CH4W(NY,NX)=CH4W(NY,NX)+TCHQSS(NY,NX) + OXYW(NY,NX)=OXYW(NY,NX)+TOXQSS(NY,NX) + ZNGW(NY,NX)=ZNGW(NY,NX)+TNGQSS(NY,NX) + ZN2W(NY,NX)=ZN2W(NY,NX)+TN2QSS(NY,NX) + ZN4W(NY,NX)=ZN4W(NY,NX)+TN4QSS(NY,NX) + ZN3W(NY,NX)=ZN3W(NY,NX)+TN3QSS(NY,NX) + ZNOW(NY,NX)=ZNOW(NY,NX)+TNOQSS(NY,NX) + Z1PW(NY,NX)=Z1PW(NY,NX)+TP1QSS(NY,NX) + ZHPW(NY,NX)=ZHPW(NY,NX)+TPOQSS(NY,NX) + IF(ISALT(NY,NX).NE.0)THEN + ZALW(NY,NX)=ZALW(NY,NX)+TQSAL(NY,NX) + ZFEW(NY,NX)=ZFEW(NY,NX)+TQSFE(NY,NX) + ZHYW(NY,NX)=ZHYW(NY,NX)+TQSHY(NY,NX) + ZCAW(NY,NX)=ZCAW(NY,NX)+TQSCA(NY,NX) + ZMGW(NY,NX)=ZMGW(NY,NX)+TQSMG(NY,NX) + ZNAW(NY,NX)=ZNAW(NY,NX)+TQSNA(NY,NX) + ZKAW(NY,NX)=ZKAW(NY,NX)+TQSKA(NY,NX) + ZOHW(NY,NX)=ZOHW(NY,NX)+TQSOH(NY,NX) + ZSO4W(NY,NX)=ZSO4W(NY,NX)+TQSSO(NY,NX) + ZCLW(NY,NX)=ZCLW(NY,NX)+TQSCL(NY,NX) + ZCO3W(NY,NX)=ZCO3W(NY,NX)+TQSC3(NY,NX) + ZHCO3W(NY,NX)=ZHCO3W(NY,NX)+TQSHC(NY,NX) + ZALH1W(NY,NX)=ZALH1W(NY,NX)+TQSAL1(NY,NX) + ZALH2W(NY,NX)=ZALH2W(NY,NX)+TQSAL2(NY,NX) + ZALH3W(NY,NX)=ZALH3W(NY,NX)+TQSAL3(NY,NX) + ZALH4W(NY,NX)=ZALH4W(NY,NX)+TQSAL4(NY,NX) + ZALSW(NY,NX)=ZALSW(NY,NX)+TQSALS(NY,NX) + ZFEH1W(NY,NX)=ZFEH1W(NY,NX)+TQSFE1(NY,NX) + ZFEH2W(NY,NX)=ZFEH2W(NY,NX)+TQSFE2(NY,NX) + ZFEH3W(NY,NX)=ZFEH3W(NY,NX)+TQSFE3(NY,NX) + ZFEH4W(NY,NX)=ZFEH4W(NY,NX)+TQSFE4(NY,NX) + ZFESW(NY,NX)=ZFESW(NY,NX)+TQSFES(NY,NX) + ZCAOW(NY,NX)=ZCAOW(NY,NX)+TQSCAO(NY,NX) + ZCACW(NY,NX)=ZCACW(NY,NX)+TQSCAC(NY,NX) + ZCAHW(NY,NX)=ZCAHW(NY,NX)+TQSCAH(NY,NX) + ZCASW(NY,NX)=ZCASW(NY,NX)+TQSCAS(NY,NX) + ZMGOW(NY,NX)=ZMGOW(NY,NX)+TQSMGO(NY,NX) + ZMGCW(NY,NX)=ZMGCW(NY,NX)+TQSMGC(NY,NX) + ZMGHW(NY,NX)=ZMGHW(NY,NX)+TQSMGH(NY,NX) + ZMGSW(NY,NX)=ZMGSW(NY,NX)+TQSMGS(NY,NX) + ZNACW(NY,NX)=ZNACW(NY,NX)+TQSNAC(NY,NX) + ZNASW(NY,NX)=ZNASW(NY,NX)+TQSNAS(NY,NX) + ZKASW(NY,NX)=ZKASW(NY,NX)+TQSKAS(NY,NX) + H0PO4W(NY,NX)=H0PO4W(NY,NX)+TQSH0P(NY,NX) + H3PO4W(NY,NX)=H3PO4W(NY,NX)+TQSH3P(NY,NX) + ZFE1PW(NY,NX)=ZFE1PW(NY,NX)+TQSF1P(NY,NX) + ZFE2PW(NY,NX)=ZFE2PW(NY,NX)+TQSF2P(NY,NX) + ZCA0PW(NY,NX)=ZCA0PW(NY,NX)+TQSC0P(NY,NX) + ZCA1PW(NY,NX)=ZCA1PW(NY,NX)+TQSC1P(NY,NX) + ZCA2PW(NY,NX)=ZCA2PW(NY,NX)+TQSC2P(NY,NX) + ZMG1PW(NY,NX)=ZMG1PW(NY,NX)+TQSM1P(NY,NX) + ENDIF + ENDIF +C +C SURFACE SEDIMENT TRANSPORT +C + IF(IERSN(NY,NX).NE.0)THEN + IF(BKDS(NU(NY,NX),NY,NX).GT.ZERO)THEN + SED(NY,NX)=SED(NY,NX)+TSEDER(NY,NX) + DLYR(3,NU(NY,NX),NY,NX)=DLYR(3,NU(NY,NX),NY,NX)+TSEDER(NY,NX) + 2/(AREA(3,NU(NY,NX),NY,NX)*BKDS(NU(NY,NX),NY,NX)) + IF(TSEDER(NY,NX).GT.1.0E-06*BKVL(NU(NY,NX),NY,NX))IFLGS(NY,NX)=1 + ENDIF +C +C SOIL MINERAL FRACTIONS +C + SAND(NU(NY,NX),NY,NX)=SAND(NU(NY,NX),NY,NX)+TSANER(NY,NX) + SILT(NU(NY,NX),NY,NX)=SILT(NU(NY,NX),NY,NX)+TSILER(NY,NX) + CLAY(NU(NY,NX),NY,NX)=CLAY(NU(NY,NX),NY,NX)+TCLAER(NY,NX) + XCEC(NU(NY,NX),NY,NX)=XCEC(NU(NY,NX),NY,NX)+TCECER(NY,NX) + XAEC(NU(NY,NX),NY,NX)=XAEC(NU(NY,NX),NY,NX)+TAECER(NY,NX) +C +C FERTILIZER POOLS +C + ZNH4FA(NU(NY,NX),NY,NX)=ZNH4FA(NU(NY,NX),NY,NX)+TNH4ER(NY,NX) + ZNH3FA(NU(NY,NX),NY,NX)=ZNH3FA(NU(NY,NX),NY,NX)+TNH3ER(NY,NX) + ZNHUFA(NU(NY,NX),NY,NX)=ZNHUFA(NU(NY,NX),NY,NX)+TNHUER(NY,NX) + ZNO3FA(NU(NY,NX),NY,NX)=ZNO3FA(NU(NY,NX),NY,NX)+TNO3ER(NY,NX) + ZNH4FB(NU(NY,NX),NY,NX)=ZNH4FB(NU(NY,NX),NY,NX)+TNH4EB(NY,NX) + ZNH3FB(NU(NY,NX),NY,NX)=ZNH3FB(NU(NY,NX),NY,NX)+TNH3EB(NY,NX) + ZNHUFB(NU(NY,NX),NY,NX)=ZNHUFB(NU(NY,NX),NY,NX)+TNHUEB(NY,NX) + ZNO3FB(NU(NY,NX),NY,NX)=ZNO3FB(NU(NY,NX),NY,NX)+TNO3EB(NY,NX) +C +C EXCHANGEABLE CATIONS AND ANIONS +C + XN4(NU(NY,NX),NY,NX)=XN4(NU(NY,NX),NY,NX)+TN4ER(NY,NX) + XNB(NU(NY,NX),NY,NX)=XNB(NU(NY,NX),NY,NX)+TNBER(NY,NX) + XHY(NU(NY,NX),NY,NX)=XHY(NU(NY,NX),NY,NX)+THYER(NY,NX) + XAL(NU(NY,NX),NY,NX)=XAL(NU(NY,NX),NY,NX)+TALER(NY,NX) + XFE(NU(NY,NX),NY,NX)=XFE(NU(NY,NX),NY,NX)+TFEER(NY,NX) + XCA(NU(NY,NX),NY,NX)=XCA(NU(NY,NX),NY,NX)+TCAER(NY,NX) + XMG(NU(NY,NX),NY,NX)=XMG(NU(NY,NX),NY,NX)+TMGER(NY,NX) + XNA(NU(NY,NX),NY,NX)=XNA(NU(NY,NX),NY,NX)+TNAER(NY,NX) + XKA(NU(NY,NX),NY,NX)=XKA(NU(NY,NX),NY,NX)+TKAER(NY,NX) + XHC(NU(NY,NX),NY,NX)=XHC(NU(NY,NX),NY,NX)+THCER(NY,NX) + XALO2(NU(NY,NX),NY,NX)=XALO2(NU(NY,NX),NY,NX)+TAL2ER(NY,NX) + XFEO2(NU(NY,NX),NY,NX)=XFEO2(NU(NY,NX),NY,NX)+TFE2ER(NY,NX) + XOH0(NU(NY,NX),NY,NX)=XOH0(NU(NY,NX),NY,NX)+TOH0ER(NY,NX) + XOH1(NU(NY,NX),NY,NX)=XOH1(NU(NY,NX),NY,NX)+TOH1ER(NY,NX) + XOH2(NU(NY,NX),NY,NX)=XOH2(NU(NY,NX),NY,NX)+TOH2ER(NY,NX) + XH1P(NU(NY,NX),NY,NX)=XH1P(NU(NY,NX),NY,NX)+TH1PER(NY,NX) + XH2P(NU(NY,NX),NY,NX)=XH2P(NU(NY,NX),NY,NX)+TH2PER(NY,NX) + XOH0B(NU(NY,NX),NY,NX)=XOH0B(NU(NY,NX),NY,NX)+TOH0EB(NY,NX) + XOH1B(NU(NY,NX),NY,NX)=XOH1B(NU(NY,NX),NY,NX)+TOH1EB(NY,NX) + XOH2B(NU(NY,NX),NY,NX)=XOH2B(NU(NY,NX),NY,NX)+TOH2EB(NY,NX) + XH1PB(NU(NY,NX),NY,NX)=XH1PB(NU(NY,NX),NY,NX)+TH1PEB(NY,NX) + XH2PB(NU(NY,NX),NY,NX)=XH2PB(NU(NY,NX),NY,NX)+TH2PEB(NY,NX) +C +C PRECIPITATES +C + PALOH(NU(NY,NX),NY,NX)=PALOH(NU(NY,NX),NY,NX)+TALOER(NY,NX) + PFEOH(NU(NY,NX),NY,NX)=PFEOH(NU(NY,NX),NY,NX)+TFEOER(NY,NX) + PCACO(NU(NY,NX),NY,NX)=PCACO(NU(NY,NX),NY,NX)+TCACER(NY,NX) + PCASO(NU(NY,NX),NY,NX)=PCASO(NU(NY,NX),NY,NX)+TCASER(NY,NX) + PALPO(NU(NY,NX),NY,NX)=PALPO(NU(NY,NX),NY,NX)+TALPER(NY,NX) + PFEPO(NU(NY,NX),NY,NX)=PFEPO(NU(NY,NX),NY,NX)+TFEPER(NY,NX) + PCAPD(NU(NY,NX),NY,NX)=PCAPD(NU(NY,NX),NY,NX)+TCPDER(NY,NX) + PCAPH(NU(NY,NX),NY,NX)=PCAPH(NU(NY,NX),NY,NX)+TCPHER(NY,NX) + PCAPM(NU(NY,NX),NY,NX)=PCAPM(NU(NY,NX),NY,NX)+TCPMER(NY,NX) + PALPB(NU(NY,NX),NY,NX)=PALPB(NU(NY,NX),NY,NX)+TALPEB(NY,NX) + PFEPB(NU(NY,NX),NY,NX)=PFEPB(NU(NY,NX),NY,NX)+TFEPEB(NY,NX) + PCPDB(NU(NY,NX),NY,NX)=PCPDB(NU(NY,NX),NY,NX)+TCPDEB(NY,NX) + PCPHB(NU(NY,NX),NY,NX)=PCPHB(NU(NY,NX),NY,NX)+TCPHEB(NY,NX) + PCPMB(NU(NY,NX),NY,NX)=PCPMB(NU(NY,NX),NY,NX)+TCPMEB(NY,NX) +C +C ORGANIC CONSTITUENTS +C + DO 9280 K=0,5 + DO 9280 NN=1,7 + DO 9280 M=1,3 + OMC(M,NN,K,NU(NY,NX),NY,NX)=OMC(M,NN,K,NU(NY,NX),NY,NX) + 2+TOMCER(M,NN,K,NY,NX) + OMN(M,NN,K,NU(NY,NX),NY,NX)=OMN(M,NN,K,NU(NY,NX),NY,NX) + 2+TOMNER(M,NN,K,NY,NX) + OMP(M,NN,K,NU(NY,NX),NY,NX)=OMP(M,NN,K,NU(NY,NX),NY,NX) + 2+TOMPER(M,NN,K,NY,NX) +9280 CONTINUE + DO 9275 K=0,4 + DO 9270 M=1,2 + ORC(M,K,NU(NY,NX),NY,NX)=ORC(M,K,NU(NY,NX),NY,NX) + 2+TORCER(M,K,NY,NX) + ORN(M,K,NU(NY,NX),NY,NX)=ORN(M,K,NU(NY,NX),NY,NX) + 2+TORNER(M,K,NY,NX) + ORP(M,K,NU(NY,NX),NY,NX)=ORP(M,K,NU(NY,NX),NY,NX) + 2+TORPER(M,K,NY,NX) +9270 CONTINUE + OHC(K,NU(NY,NX),NY,NX)=OHC(K,NU(NY,NX),NY,NX)+TOHCER(K,NY,NX) + OHN(K,NU(NY,NX),NY,NX)=OHN(K,NU(NY,NX),NY,NX)+TOHNER(K,NY,NX) + OHP(K,NU(NY,NX),NY,NX)=OHP(K,NU(NY,NX),NY,NX)+TOHPER(K,NY,NX) + OHA(K,NU(NY,NX),NY,NX)=OHA(K,NU(NY,NX),NY,NX)+TOHAER(K,NY,NX) + DO 9265 M=1,4 + OSC(M,K,NU(NY,NX),NY,NX)=OSC(M,K,NU(NY,NX),NY,NX) + 2+TOSCER(M,K,NY,NX) + OSA(M,K,NU(NY,NX),NY,NX)=OSA(M,K,NU(NY,NX),NY,NX) + 2+TOSAER(M,K,NY,NX) + OSN(M,K,NU(NY,NX),NY,NX)=OSN(M,K,NU(NY,NX),NY,NX) + 2+TOSNER(M,K,NY,NX) + OSP(M,K,NU(NY,NX),NY,NX)=OSP(M,K,NU(NY,NX),NY,NX) + 2+TOSPER(M,K,NY,NX) +9265 CONTINUE +9275 CONTINUE + ENDIF + ENDIF +C +C UPDATE STATE VARIABLES WITH TOTAL FLUXES CALCULATED ABOVE +C +C IF(J.EQ.24)THEN +C +C TOTAL C,N,P, SALTS IN SURFACE RESIDUE +C + RC=0.0 + RN=0.0 + RP=0.0 + DO 6975 K=0,5 + RC0(K,NY,NX)=0.0 + RA0(K,NY,NX)=0.0 +6975 CONTINUE + OMCL(0,NY,NX)=0.0 + OMNL(0,NY,NX)=0.0 + DO 6970 K=0,5 + IF(K.NE.3.AND.K.NE.4)THEN +C +C TOTAL MICROBIAL C,N,P +C + DO 6960 N=1,7 + DO 6960 M=1,3 + RC=RC+OMC(M,N,K,0,NY,NX) + RN=RN+OMN(M,N,K,0,NY,NX) + RP=RP+OMP(M,N,K,0,NY,NX) + RC0(K,NY,NX)=RC0(K,NY,NX)+OMC(M,N,K,0,NY,NX) + RA0(K,NY,NX)=RA0(K,NY,NX)+OMC(M,N,K,0,NY,NX) + TOMT(NY,NX)=TOMT(NY,NX)+OMC(M,N,K,0,NY,NX) + TONT(NY,NX)=TONT(NY,NX)+OMN(M,N,K,0,NY,NX) + TOPT(NY,NX)=TOPT(NY,NX)+OMP(M,N,K,0,NY,NX) + OMCL(0,NY,NX)=OMCL(0,NY,NX)+OMC(M,N,K,0,NY,NX) + OMNL(0,NY,NX)=OMNL(0,NY,NX)+OMN(M,N,K,0,NY,NX) +6960 CONTINUE + ENDIF +6970 CONTINUE +C +C TOTAL MICROBIAL RESIDUE C,N,P +C + DO 6900 K=0,2 + DO 6940 M=1,2 + RC=RC+ORC(M,K,0,NY,NX) + RN=RN+ORN(M,K,0,NY,NX) + RP=RP+ORP(M,K,0,NY,NX) + RC0(K,NY,NX)=RC0(K,NY,NX)+ORC(M,K,0,NY,NX) + RA0(K,NY,NX)=RA0(K,NY,NX)+ORC(M,K,0,NY,NX) +6940 CONTINUE +C +C TOTAL DOC, DON, DOP +C + RC=RC+OQC(K,0,NY,NX)+OQCH(K,0,NY,NX)+OHC(K,0,NY,NX) + 2+OQA(K,0,NY,NX)+OQAH(K,0,NY,NX)+OHA(K,0,NY,NX) + RN=RN+OQN(K,0,NY,NX)+OQNH(K,0,NY,NX)+OHN(K,0,NY,NX) + RP=RP+OQP(K,0,NY,NX)+OQPH(K,0,NY,NX)+OHP(K,0,NY,NX) + RC0(K,NY,NX)=RC0(K,NY,NX)+OQC(K,0,NY,NX)+OQCH(K,0,NY,NX) + 2+OHC(K,0,NY,NX)+OQA(K,0,NY,NX)+OQAH(K,0,NY,NX)+OHA(K,0,NY,NX) + RA0(K,NY,NX)=RA0(K,NY,NX)+OQC(K,0,NY,NX)+OQCH(K,0,NY,NX) + 2+OHC(K,0,NY,NX)+OQA(K,0,NY,NX)+OQAH(K,0,NY,NX)+OHA(K,0,NY,NX) +C +C TOTAL PLANT RESIDUE C,N,P +C + DO 6930 M=1,4 + RC=RC+OSC(M,K,0,NY,NX) + RN=RN+OSN(M,K,0,NY,NX) + RP=RP+OSP(M,K,0,NY,NX) + RC0(K,NY,NX)=RC0(K,NY,NX)+OSC(M,K,0,NY,NX) + RA0(K,NY,NX)=RA0(K,NY,NX)+OSA(M,K,0,NY,NX) +6930 CONTINUE +6900 CONTINUE + ORGC(0,NY,NX)=RC + ORGN(0,NY,NX)=RN + ORGR(0,NY,NX)=RC + TLRSDC=TLRSDC+RC + URSDC(NY,NX)=URSDC(NY,NX)+RC + TLRSDN=TLRSDN+RN + URSDN(NY,NX)=URSDN(NY,NX)+RN + TLRSDP=TLRSDP+RP + URSDP(NY,NX)=URSDP(NY,NX)+RP + WS=TVOLWC(NY,NX)+TVOLWP(NY,NX)+VOLW(0,NY,NX)+VOLI(0,NY,NX)*DENSI + VOLWSO=VOLWSO+WS + UVOLW(NY,NX)=UVOLW(NY,NX)+WS + ENGYR=VHCPR(NY,NX)*TKS(0,NY,NX) + HEATSO=HEATSO+TENGYC(NY,NX)+ENGYR + CS=CO2S(0,NY,NX)+CH4S(0,NY,NX) + TLCO2G=TLCO2G+CS + UCO2S(NY,NX)=UCO2S(NY,NX)+CS + HS=H2GS(0,NY,NX) + TLH2G=TLH2G+HS + OS=OXYS(0,NY,NX) + OXYGSO=OXYGSO+OS + ZG=Z2GS(0,NY,NX)+Z2OS(0,NY,NX) + TLN2G=TLN2G+ZG + Z4S=ZNH4S(0,NY,NX)+ZNH3S(0,NY,NX) + 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 + ZOS=ZNO3S(0,NY,NX)+ZNO2S(0,NY,NX) + ZOF=14.0*ZNO3FA(0,NY,NX) + TLNO3=TLNO3+ZOS+ZOF + UNO3(NY,NX)=UNO3(NY,NX)+ZOS + POS=H1PO4(0,NY,NX)+H2PO4(0,NY,NX) + POX=31.0*(XH1P(0,NY,NX)+XH2P(0,NY,NX)) + POP=31.0*(PALPO(0,NY,NX)+PFEPO(0,NY,NX) + 2+PCAPD(0,NY,NX)) + 3+62.0*PCAPM(0,NY,NX) + 4+93.0*PCAPH(0,NY,NX) + TLPO4=TLPO4+POS+POX+POP + UPO4(NY,NX)=UPO4(NY,NX)+POX + UPP4(NY,NX)=UPP4(NY,NX)+POP + IF(ISALT(NY,NX).NE.0)THEN + ZAL(0,NY,NX)=ZAL(0,NY,NX)+XALFLS(3,0,NY,NX) + ZFE(0,NY,NX)=ZFE(0,NY,NX)+XFEFLS(3,0,NY,NX) + ZHY(0,NY,NX)=ZHY(0,NY,NX)+XHYFLS(3,0,NY,NX) + ZCA(0,NY,NX)=ZCA(0,NY,NX)+XCAFLS(3,0,NY,NX) + ZMG(0,NY,NX)=ZMG(0,NY,NX)+XMGFLS(3,0,NY,NX) + ZNA(0,NY,NX)=ZNA(0,NY,NX)+XNAFLS(3,0,NY,NX) + ZKA(0,NY,NX)=ZKA(0,NY,NX)+XKAFLS(3,0,NY,NX) + ZOH(0,NY,NX)=ZOH(0,NY,NX)+XOHFLS(3,0,NY,NX) +C WRITE(20,3338)'ZHY0',I,J,ZHY(0,NY,NX),TQRHY(NY,NX) +C 2,XHYFLS(3,0,NY,NX),ZOH(0,NY,NX),TQROH(NY,NX) +C 4,XOHFLS(3,0,NY,NX) + ZSO4(0,NY,NX)=ZSO4(0,NY,NX)+XSOFLS(3,0,NY,NX) + ZCL(0,NY,NX)=ZCL(0,NY,NX)+XCLFLS(3,0,NY,NX) + ZCO3(0,NY,NX)=ZCO3(0,NY,NX)+XC3FLS(3,0,NY,NX) + ZHCO3(0,NY,NX)=ZHCO3(0,NY,NX)+XHCFLS(3,0,NY,NX) + ZALOH1(0,NY,NX)=ZALOH1(0,NY,NX)+XAL1FS(3,0,NY,NX) + ZALOH2(0,NY,NX)=ZALOH2(0,NY,NX)+XAL2FS(3,0,NY,NX) + ZALOH3(0,NY,NX)=ZALOH3(0,NY,NX)+XAL3FS(3,0,NY,NX) + ZALOH4(0,NY,NX)=ZALOH4(0,NY,NX)+XAL4FS(3,0,NY,NX) + ZALS(0,NY,NX)=ZALS(0,NY,NX)+XALSFS(3,0,NY,NX) + ZFEOH1(0,NY,NX)=ZFEOH1(0,NY,NX)+XFE1FS(3,0,NY,NX) + ZFEOH2(0,NY,NX)=ZFEOH2(0,NY,NX)+XFE2FS(3,0,NY,NX) + ZFEOH3(0,NY,NX)=ZFEOH3(0,NY,NX)+XFE3FS(3,0,NY,NX) + ZFEOH4(0,NY,NX)=ZFEOH4(0,NY,NX)+XFE4FS(3,0,NY,NX) + ZFES(0,NY,NX)=ZFES(0,NY,NX)+XFESFS(3,0,NY,NX) + ZCAO(0,NY,NX)=ZCAO(0,NY,NX)+XCAOFS(3,0,NY,NX) + ZCAC(0,NY,NX)=ZCAC(0,NY,NX)+XCACFS(3,0,NY,NX) + ZCAH(0,NY,NX)=ZCAH(0,NY,NX)+XCAHFS(3,0,NY,NX) + ZCAS(0,NY,NX)=ZCAS(0,NY,NX)+XCASFS(3,0,NY,NX) + ZMGO(0,NY,NX)=ZMGO(0,NY,NX)+XMGOFS(3,0,NY,NX) + ZMGC(0,NY,NX)=ZMGC(0,NY,NX)+XMGCFS(3,0,NY,NX) + ZMGH(0,NY,NX)=ZMGH(0,NY,NX)+XMGHFS(3,0,NY,NX) + ZMGS(0,NY,NX)=ZMGS(0,NY,NX)+XMGSFS(3,0,NY,NX) + ZNAC(0,NY,NX)=ZNAC(0,NY,NX)+XNACFS(3,0,NY,NX) + ZNAS(0,NY,NX)=ZNAS(0,NY,NX)+XNASFS(3,0,NY,NX) + ZKAS(0,NY,NX)=ZKAS(0,NY,NX)+XKASFS(3,0,NY,NX) + H0PO4(0,NY,NX)=H0PO4(0,NY,NX)+XH0PFS(3,0,NY,NX) + H3PO4(0,NY,NX)=H3PO4(0,NY,NX)+XH3PFS(3,0,NY,NX) + ZFE1P(0,NY,NX)=ZFE1P(0,NY,NX)+XF1PFS(3,0,NY,NX) + ZFE2P(0,NY,NX)=ZFE2P(0,NY,NX)+XF2PFS(3,0,NY,NX) + ZCA0P(0,NY,NX)=ZCA0P(0,NY,NX)+XC0PFS(3,0,NY,NX) + ZCA1P(0,NY,NX)=ZCA1P(0,NY,NX)+XC1PFS(3,0,NY,NX) + ZCA2P(0,NY,NX)=ZCA2P(0,NY,NX)+XC2PFS(3,0,NY,NX) + ZMG1P(0,NY,NX)=ZMG1P(0,NY,NX)+XM1PFS(3,0,NY,NX) + PSS=31.0*(H0PO4(0,NY,NX)+H3PO4(0,NY,NX)+ZFE1P(0,NY,NX) + 2+ZFE2P(0,NY,NX)+ZCA0P(0,NY,NX)+ZCA1P(0,NY,NX) + 3+ZCA2P(0,NY,NX)+ZMG1P(0,NY,NX)) + TLPO4=TLPO4+PSS + SSS=ZAL(0,NY,NX)+ZFE(0,NY,NX)+ZHY(0,NY,NX)+ZCA(0,NY,NX) + 2+ZMG(0,NY,NX)+ZNA(0,NY,NX)+ZKA(0,NY,NX)+ZOH(0,NY,NX) + 3+ZSO4(0,NY,NX)+ZCL(0,NY,NX)+ZCO3(0,NY,NX)+H0PO4(0,NY,NX) + 4+2.0*(ZHCO3(0,NY,NX)+ZALOH1(0,NY,NX)+ZALS(0,NY,NX) + 5+ZFEOH1(0,NY,NX)+ZFES(0,NY,NX)+ZCAO(0,NY,NX)+ZCAC(0,NY,NX) + 6+ZCAS(0,NY,NX)+ZMGO(0,NY,NX)+ZMGC(0,NY,NX)+ZMGS(0,NY,NX) + 7+ZNAC(0,NY,NX)+ZNAS(0,NY,NX)+ZKAS(0,NY,NX)+ZCA0P(0,NY,NX)) + 9+3.0*(ZALOH2(0,NY,NX)+ZFEOH2(0,NY,NX)+ZCAH(0,NY,NX) + 1+ZMGH(0,NY,NX)+ZFE1P(0,NY,NX)+ZCA1P(0,NY,NX)+ZMG1P(0,NY,NX)) + 2+4.0*(ZALOH3(0,NY,NX)+ZFEOH3(0,NY,NX)+H3PO4(0,NY,NX) + 3+ZFE2P(0,NY,NX)+ZCA2P(0,NY,NX)) + 4+5.0*(ZALOH4(0,NY,NX)+ZFEOH4(0,NY,NX)) + TION=TION+SSS + UION(NY,NX)=UION(NY,NX)+SSS + ENDIF +C WRITE(20,3338)'SBN',I,J,TLNH4,TLNO3,TZIN,TZOU +C 2,Z4S,Z4X,Z4F,ZOS,ZOF,ZG +C 2,ZSI,ZGI,ZGB,Z2B,ZHB +C 3,ZXR,ZGR,ZOR,ZXB,TRN3S(0,NY,NX) +C 3,ZN4W(NY,NX),ZN3W(NY,NX),ZNOW(NY,NX),ZNGW(NY,NX),ZN2W(NY,NX) +C WRITE(20,3338)'SBP',I,J,TLPO4,TPIN,TPOU,PI,PXR,POR,PSS +C 2,PXB,POS,POX,POP +C 2,XH1PS(0,NY,NX),XH2PS(0,NY,NX),H1PO4(0,NY,NX),H2PO4(0,NY,NX) +C 3,XH1P(0,NY,NX),XH2P(0,NY,NX),PALPO(0,NY,NX),PFEPO(0,NY,NX) +C 6,PCAPD(0,NY,NX),PCAPM(0,NY,NX),PCAPH(0,NY,NX),TRH1P(0,NY,NX) +C 2,TRH2P(0,NY,NX),XH1PFS(3,0,NY,NX),XH2PFS(3,0,NY,NX) +C 3,Z1PW(NY,NX),ZHPW(NY,NX),XH1PBS(NY,NX),XH2PBS(NY,NX) +C 4,FLQGQ(NY,NX),FLQRQ(NY,NX) +C WRITE(20,3338)'SBS',I,J,TION,TIONIN,TIONOU +C 2,SSW,SSS,SIR,SII,SSR,SQE,SBU +3338 FORMAT(A8,2I4,50F17.10) +C ENDIF +C +C IF SNOWPACK OR SURFACE RESIDUE DISAPPEARS +C + IF(FLWSI(NY,NX).GT.0.0)THEN + VHCP(NU(NY,NX),NY,NX)=VHCM(NU(NY,NX),NY,NX) + 2+4.19*(VOLW(NU(NY,NX),NY,NX)+VOLWH(NU(NY,NX),NY,NX)) + 2+1.9274*(VOLI(NU(NY,NX),NY,NX)+VOLIH(NU(NY,NX),NY,NX)) + VOLI(NU(NY,NX),NY,NX)=VOLI(NU(NY,NX),NY,NX)+FLWSI(NY,NX) + ENGY=VHCP(NU(NY,NX),NY,NX)*TKS(NU(NY,NX),NY,NX) + VHCP(NU(NY,NX),NY,NX)=VHCM(NU(NY,NX),NY,NX) + 2+4.19*(VOLW(NU(NY,NX),NY,NX)+VOLWH(NU(NY,NX),NY,NX)) + 2+1.9274*(VOLI(NU(NY,NX),NY,NX)+VOLIH(NU(NY,NX),NY,NX)) + TKS(NU(NY,NX),NY,NX)=(ENGY+HFLWSI(NY,NX))/VHCP(NU(NY,NX),NY,NX) + ENDIF + VOLWX(NU(NY,NX),NY,NX)=VOLW(NU(NY,NX),NY,NX) + TCS(0,NY,NX)=TKS(0,NY,NX)-273.15 + TSMX(0,NY,NX)=AMAX1(TSMX(0,NY,NX),TCS(0,NY,NX)) + TSMN(0,NY,NX)=AMIN1(TSMN(0,NY,NX),TCS(0,NY,NX)) +C +C UPDATE SOIL LAYER VARIABLES WITH TOTAL FLUXES +C + DO 125 L=NU(NY,NX),NL(NY,NX) +C +C WATER, ICE, HEAT, TEMPERATURE +C + VHCP(L,NY,NX)=VHCM(L,NY,NX)+4.19*(VOLW(L,NY,NX)+VOLWH(L,NY,NX)) + 2+1.9274*(VOLI(L,NY,NX)+VOLIH(L,NY,NX)) + VOLW1=VOLW(L,NY,NX) + VOLW(L,NY,NX)=VOLW(L,NY,NX)+TFLW(L,NY,NX)+FINH(L,NY,NX) + 2+TTHAW(L,NY,NX)+TUPWTR(L,NY,NX) + 3+FLU(L,NY,NX) + IF(VOLW(L,NY,NX).GT.ZEROS(NY,NX))THEN + VOLWX(L,NY,NX)=VOLWX(L,NY,NX)+TFLWX(L,NY,NX)+FINH(L,NY,NX) + 2+TTHAW(L,NY,NX)+TUPWTR(L,NY,NX)*VOLWX(L,NY,NX)/VOLW(L,NY,NX) + 3+FLU(L,NY,NX)+FLWV(L,NY,NX) + VOLWX(L,NY,NX)=AMAX1(THETY(L,NY,NX)*VOLX(L,NY,NX) + 2,AMIN1(VOLW(L,NY,NX),VOLWX(L,NY,NX))) + ELSE + VOLWX(L,NY,NX)=0.0 + ENDIF + VOLI(L,NY,NX)=VOLI(L,NY,NX)-TTHAW(L,NY,NX)/DENSI + VOLWH(L,NY,NX)=VOLWH(L,NY,NX)+TFLWH(L,NY,NX)-FINH(L,NY,NX) + 2+TTHAWH(L,NY,NX) + VOLIH(L,NY,NX)=VOLIH(L,NY,NX)-TTHAWH(L,NY,NX)/DENSI + 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)) + ENGY=VHCP(L,NY,NX)*TKS(L,NY,NX) + VHCP1=VHCP(L,NY,NX) + TKS1=TKS(L,NY,NX) + VHCP(L,NY,NX)=VHCM(L,NY,NX)+4.19*(VOLW(L,NY,NX)+VOLWH(L,NY,NX)) + 2+1.9274*(VOLI(L,NY,NX)+VOLIH(L,NY,NX)) +C +C ARTIFICIAL SOIL WARMING +C +C IF(NX.EQ.3.AND.NY.EQ.2.AND.L.GT.NU(NY,NX) +C 3.AND.L.LE.17.AND.I.GE.152.AND.I.LE.304)THEN +C THFLW(L,NY,NX)=THFLW(L,NY,NX) +C 2+(TKSZ(I,J,L)-TKS(L,NY,NX))*VHCP(L,NY,NX) +C WRITE(*,3379)'TKSZ',I,J,NX,NY,L,TKSZ(I,J,L) +C 2,TKS(L,NY,NX),VHCP(L,NY,NX),THFLW(L,NY,NX) +3379 FORMAT(A8,6I4,12E12.4) +C ENDIF +C +C 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) + TCS(L,NY,NX)=TKS(L,NY,NX)-273.15 + TSMX(L,NY,NX)=AMAX1(TSMX(L,NY,NX),TCS(L,NY,NX)) + TSMN(L,NY,NX)=AMIN1(TSMN(L,NY,NX),TCS(L,NY,NX)) + UN2GS(NY,NX)=UN2GS(NY,NX)+XN2GS(L,NY,NX) +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 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) +6547 FORMAT(A8,5I4,20E16.8) +C WRITE(*,6633)'TKS',I,J,NX,NY,L,TKS(L,NY,NX),ENGY,THFLW(L,NY,NX) +C 2,THTHAW(L,NY,NX),TUPHT(L,NY,NX),HWFLU(L,NY,NX),VHCP(L,NY,NX) +C 3,VHCP1,TKS1,VOLW(L,NY,NX),VOLWH(L,NY,NX),VOLI(L,NY,NX) +C 4,VOLIH(L,NY,NX),TFLW(L,NY,NX),FINH(L,NY,NX),TTHAW(L,NY,NX) +C 5,TUPWTR(L,NY,NX),FLU(L,NY,NX),TQR(NY,NX) +C 6,FLWSI(NY,NX),HFLWSI(NY,NX) +6633 FORMAT(A8,5I4,30F20.6) +C ENDIF +C +C RESIDUE FROM PLANT LITTERFALL +C + DO 8565 K=0,1 + DO 8565 M=1,4 + OSC(M,K,L,NY,NX)=OSC(M,K,L,NY,NX)+CSNT(M,K,L,NY,NX) + OSN(M,K,L,NY,NX)=OSN(M,K,L,NY,NX)+ZSNT(M,K,L,NY,NX) + OSP(M,K,L,NY,NX)=OSP(M,K,L,NY,NX)+PSNT(M,K,L,NY,NX) +C IF((I/30)*30.EQ.I.AND.J.EQ.15)THEN +C WRITE(*,8484)'OSC',I,J,L,K,M,OSC(M,K,L,NY,NX) +C 2,OSN(M,K,L,NY,NX),OSP(M,K,L,NY,NX),CSNT(M,K,L,NY,NX) +C 3,ZSNT(M,K,L,NY,NX),PSNT(M,K,L,NY,NX) +8484 FORMAT(A8,5I4,12E12.4) +C ENDIF +8565 CONTINUE +C +C DOC, DON, DOP FROM AQUEOUS TRANSPORT +C + DO 8560 K=0,4 + OQC(K,L,NY,NX)=OQC(K,L,NY,NX)+TOCFLS(K,L,NY,NX) + 2+XOCFXS(K,L,NY,NX) + OQN(K,L,NY,NX)=OQN(K,L,NY,NX)+TONFLS(K,L,NY,NX) + 2+XONFXS(K,L,NY,NX) + OQP(K,L,NY,NX)=OQP(K,L,NY,NX)+TOPFLS(K,L,NY,NX) + 2+XOPFXS(K,L,NY,NX) + OQA(K,L,NY,NX)=OQA(K,L,NY,NX)+TOAFLS(K,L,NY,NX) + 2+XOAFXS(K,L,NY,NX) + OQCH(K,L,NY,NX)=OQCH(K,L,NY,NX)+TOCFHS(K,L,NY,NX) + 2-XOCFXS(K,L,NY,NX) + OQNH(K,L,NY,NX)=OQNH(K,L,NY,NX)+TONFHS(K,L,NY,NX) + 2-XONFXS(K,L,NY,NX) + OQPH(K,L,NY,NX)=OQPH(K,L,NY,NX)+TOPFHS(K,L,NY,NX) + 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 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,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) +C ENDIF +8560 CONTINUE +C +C DOC, DON, DOP FROM PLANT EXUDATION +C + DO 195 K=0,4 + OQC(K,L,NY,NX)=OQC(K,L,NY,NX)+TDFOMC(K,L,NY,NX) + OQN(K,L,NY,NX)=OQN(K,L,NY,NX)+TDFOMN(K,L,NY,NX) + OQP(K,L,NY,NX)=OQP(K,L,NY,NX)+TDFOMP(K,L,NY,NX) +195 CONTINUE +C +C SOIL SOLUTES FROM AQUEOUS TRANSPORT, MICROBIAL AND ROOT +C EXCHANGE, EQUILIBRIUM REACTIONS, GAS EXCHANGE, +C MICROPORE-MACROPORE EXCHANGE, +C + CO2S(L,NY,NX)=CO2S(L,NY,NX)+TCOFLS(L,NY,NX)+XCODFG(L,NY,NX) + 2-RCO2O(L,NY,NX)-TCO2S(L,NY,NX)+RCOFLU(L,NY,NX)+XCOFXS(L,NY,NX) + 3+12.0*TRCO2(L,NY,NX)+XCOBBL(L,NY,NX) + CH4S(L,NY,NX)=CH4S(L,NY,NX)+TCHFLS(L,NY,NX)+XCHDFG(L,NY,NX) + 2-RCH4O(L,NY,NX)-TUPCHS(L,NY,NX)+RCHFLU(L,NY,NX) + 3+XCHFXS(L,NY,NX)+XCHBBL(L,NY,NX) + 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 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 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 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) +5432 FORMAT(A8,5I4,20E16.6) +C ENDIF + Z2GS(L,NY,NX)=Z2GS(L,NY,NX)+TNGFLS(L,NY,NX)+XNGDFG(L,NY,NX) + 2-RN2G(L,NY,NX)-TUPNF(L,NY,NX)+RNGFLU(L,NY,NX)+XNGFXS(L,NY,NX) + 3-XN2GS(L,NY,NX)+XNGBBL(L,NY,NX) + Z2OS(L,NY,NX)=Z2OS(L,NY,NX)+TN2FLS(L,NY,NX)+XN2DFG(L,NY,NX) + 2-RN2O(L,NY,NX)-TUPN2S(L,NY,NX)+RN2FLU(L,NY,NX)+XN2FXS(L,NY,NX) + 3+XN2BBL(L,NY,NX) +C IF(I.GT.160.AND.I.LT.190)THEN +C WRITE(*,4444)'Z2OS',I,J,NX,NY,L,Z2OS(L,NY,NX),TN2FLS(L,NY,NX) +C 2,XN2DFG(L,NY,NX),RN2O(L,NY,NX),TUPN2S(L,NY,NX),RN2FLU(L,NY,NX) +C 3,XN2FXS(L,NY,NX),Z2GS(L,NY,NX),TNGFLS(L,NY,NX),XNGDFG(L,NY,NX) +C 4,RN2G(L,NY,NX),TUPNF(L,NY,NX),RNGFLU(L,NY,NX),XNGFXS(L,NY,NX) +C 5,XN2GS(L,NY,NX),XNGBBL(L,NY,NX) +C ENDIF + H2GS(L,NY,NX)=H2GS(L,NY,NX)+THGFLS(L,NY,NX)+XHGDFG(L,NY,NX) + 2-RH2GO(L,NY,NX)-TUPHGS(L,NY,NX)+RHGFLU(L,NY,NX) + 3+XHGFXS(L,NY,NX)+XHGBBL(L,NY,NX) + ZNH3S(L,NY,NX)=ZNH3S(L,NY,NX)+TN3FLS(L,NY,NX)+XN3DFG(L,NY,NX) + 2+TRN3S(L,NY,NX)-TUPN3S(L,NY,NX)+RN3FLU(L,NY,NX) + 3+XN3FXW(L,NY,NX)+XN3BBL(L,NY,NX) + ZNH4S(L,NY,NX)=ZNH4S(L,NY,NX)+TN4FLS(L,NY,NX)+XNH4S(L,NY,NX) + 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 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 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) +C 4,TN4FLS(L,NY,NX),XNH4S(L,NY,NX),TRN4S(L,NY,NX),TUPNH4(L,NY,NX) +C 5,RN4FLU(L,NY,NX),XN4FXW(L,NY,NX),TN4QRS(NY,NX),TN3QRS(NY,NX) +C 6,ZNH3SH(L,NY,NX),ZNH4SH(L,NY,NX),14.0*XN4(L,NY,NX) +4443 FORMAT(A8,5I4,30F16.8) +4444 FORMAT(A8,5I4,30F16.8) +C ENDIF + ZNO3S(L,NY,NX)=ZNO3S(L,NY,NX)+TNOFLS(L,NY,NX)+XNO3S(L,NY,NX) + 2+TRNO3(L,NY,NX)-TUPNO3(L,NY,NX)+RNOFLU(L,NY,NX) + 3+XNOFXW(L,NY,NX) + ZNO2S(L,NY,NX)=ZNO2S(L,NY,NX)+TNXFLS(L,NY,NX)+XNO2S(L,NY,NX) + 2+TRNO2(L,NY,NX)+XNXFXS(L,NY,NX) +C IF(L.EQ.NU(NY,NX))THEN +C WRITE(*,5545)'NO3',I,J,NX,NY,L,ZNO3S(L,NY,NX),TNOFLS(L,NY,NX) +C 2,XNO3S(L,NY,NX),TRNO3(L,NY,NX),TUPNO3(L,NY,NX),RNOFLU(L,NY,NX) +C 3,XNOFXW(L,NY,NX),ZNO2S(L,NY,NX),TNXFLS(L,NY,NX) +C 4,XNO2S(L,NY,NX),TRNO2(L,NY,NX),XNXFXS(L,NY,NX),TNXQRS(NY,NX) +5545 FORMAT(A8,5I4,40F15.8) +C ENDIF + H1PO4(L,NY,NX)=H1PO4(L,NY,NX)+TP1FLS(L,NY,NX)+XH1PS(L,NY,NX) + 2+TRH1P(L,NY,NX)-TUPH1P(L,NY,NX)+RH1PFU(L,NY,NX)+XH1PXS(L,NY,NX) + H2PO4(L,NY,NX)=H2PO4(L,NY,NX)+TPOFLS(L,NY,NX)+XH2PS(L,NY,NX) + 2+TRH2P(L,NY,NX)-TUPH2P(L,NY,NX)+RH2PFU(L,NY,NX)+XH2PXS(L,NY,NX) + ZNH3B(L,NY,NX)=ZNH3B(L,NY,NX)+TN3FLB(L,NY,NX)+XNBDFG(L,NY,NX) + 2+TRN3B(L,NY,NX)-TUPN3B(L,NY,NX)+RN3FBU(L,NY,NX) + 3+XN3FXB(L,NY,NX)+XNBBBL(L,NY,NX) + ZNH4B(L,NY,NX)=ZNH4B(L,NY,NX)+TN4FLB(L,NY,NX)+XNH4B(L,NY,NX) + 2+TRN4B(L,NY,NX)-TUPNHB(L,NY,NX)+RN4FBU(L,NY,NX) + 3+XN4FXB(L,NY,NX) + ZNO3B(L,NY,NX)=ZNO3B(L,NY,NX)+TNOFLB(L,NY,NX)+XNO3B(L,NY,NX) + 2+TRNOB(L,NY,NX)-TUPNOB(L,NY,NX)+RNOFBU(L,NY,NX) + 3+XNOFXB(L,NY,NX) + ZNO2B(L,NY,NX)=ZNO2B(L,NY,NX)+TNXFLB(L,NY,NX)+XNO2B(L,NY,NX) + 2+TRN2B(L,NY,NX)+XNXFXB(L,NY,NX) + H1POB(L,NY,NX)=H1POB(L,NY,NX)+TH1BFB(L,NY,NX)+XH1BS(L,NY,NX) + 2+TRH1B(L,NY,NX)-TUPH1B(L,NY,NX)+RH1BBU(L,NY,NX) + 3+XH1BXB(L,NY,NX) + H2POB(L,NY,NX)=H2POB(L,NY,NX)+TH2BFB(L,NY,NX)+XH2BS(L,NY,NX) + 2+TRH2B(L,NY,NX) -TUPH2B(L,NY,NX)+RH2BBU(L,NY,NX) + 3+XH2BXB(L,NY,NX) + THRE(NY,NX)=THRE(NY,NX)+RCO2O(L,NY,NX) + UN2GG(NY,NX)=UN2GG(NY,NX)+RN2G(L,NY,NX) + HN2GG(NY,NX)=HN2GG(NY,NX)+RN2G(L,NY,NX) +C +C EXCHANGEABLE CATIONS AND ANIONS FROM EXCHANGE REACTIONS +C + XN4(L,NY,NX)=XN4(L,NY,NX)+TRXN4(L,NY,NX) + XNB(L,NY,NX)=XNB(L,NY,NX)+TRXNB(L,NY,NX) + XOH0(L,NY,NX)=XOH0(L,NY,NX)+TRXH0(L,NY,NX) + XOH1(L,NY,NX)=XOH1(L,NY,NX)+TRXH1(L,NY,NX) + XOH2(L,NY,NX)=XOH2(L,NY,NX)+TRXH2(L,NY,NX) + XH1P(L,NY,NX)=XH1P(L,NY,NX)+TRX1P(L,NY,NX) + XH2P(L,NY,NX)=XH2P(L,NY,NX)+TRX2P(L,NY,NX) + XOH0B(L,NY,NX)=XOH0B(L,NY,NX)+TRBH0(L,NY,NX) + XOH1B(L,NY,NX)=XOH1B(L,NY,NX)+TRBH1(L,NY,NX) + XOH2B(L,NY,NX)=XOH2B(L,NY,NX)+TRBH2(L,NY,NX) + XH1PB(L,NY,NX)=XH1PB(L,NY,NX)+TRB1P(L,NY,NX) + XH2PB(L,NY,NX)=XH2PB(L,NY,NX)+TRB2P(L,NY,NX) +C IF(J.EQ.12.AND.L.LE.4)THEN +C WRITE(*,4445)'NHB',I,J,NX,NY,L,ZNH3B(L,NY,NX),TN3FLB(L,NY,NX) +C 2,XNBDFG(L,NY,NX),TRN3B(L,NY,NX),TUPN3B(L,NY,NX) +C 3,RN3FBU(L,NY,NX),XN3FXB(L,NY,NX),XNBBBL(L,NY,NX),TUPNHB(L,NY,NX) +C 4,ZNH4B(L,NY,NX),TN4FLB(L,NY,NX),XNH4B(L,NY,NX) +C 5,TRN4B(L,NY,NX),TUPNHB(L,NY,NX),RN4FBU(L,NY,NX),XNB(L,NY,NX)*14.0 +C WRITE(*,4445)'NOB',I,J,NX,NY,L,ZNO2B(L,NY,NX),TNXFLB(L,NY,NX) +C 2,XNO2B(L,NY,NX),TRN2B(L,NY,NX),XNXFXB(L,NY,NX) +4445 FORMAT(A8,5I4,20E12.4) +C ENDIF +C +C PRECIPITATES FROM PRECIPITATION-DISSOLUTION REACTIONS +C + PALPO(L,NY,NX)=PALPO(L,NY,NX)+TRALPO(L,NY,NX) + PFEPO(L,NY,NX)=PFEPO(L,NY,NX)+TRFEPO(L,NY,NX) + PCAPD(L,NY,NX)=PCAPD(L,NY,NX)+TRCAPD(L,NY,NX) + PCAPH(L,NY,NX)=PCAPH(L,NY,NX)+TRCAPH(L,NY,NX) + PCAPM(L,NY,NX)=PCAPM(L,NY,NX)+TRCAPM(L,NY,NX) + PALPB(L,NY,NX)=PALPB(L,NY,NX)+TRALPB(L,NY,NX) + PFEPB(L,NY,NX)=PFEPB(L,NY,NX)+TRFEPB(L,NY,NX) + PCPDB(L,NY,NX)=PCPDB(L,NY,NX)+TRCPDB(L,NY,NX) + PCPHB(L,NY,NX)=PCPHB(L,NY,NX)+TRCPHB(L,NY,NX) + PCPMB(L,NY,NX)=PCPMB(L,NY,NX)+TRCPMB(L,NY,NX) +C +C MACROPORE SOLUTES FROM MACROPORE-MICROPORE EXCHANGE +C + CO2SH(L,NY,NX)=CO2SH(L,NY,NX)+TCOFHS(L,NY,NX)-XCOFXS(L,NY,NX) + CH4SH(L,NY,NX)=CH4SH(L,NY,NX)+TCHFHS(L,NY,NX)-XCHFXS(L,NY,NX) + OXYSH(L,NY,NX)=OXYSH(L,NY,NX)+TOXFHS(L,NY,NX)-XOXFXS(L,NY,NX) + Z2GSH(L,NY,NX)=Z2GSH(L,NY,NX)+TNGFHS(L,NY,NX)-XNGFXS(L,NY,NX) + Z2OSH(L,NY,NX)=Z2OSH(L,NY,NX)+TN2FHS(L,NY,NX)-XN2FXS(L,NY,NX) + H2GSH(L,NY,NX)=H2GSH(L,NY,NX)+THGFHS(L,NY,NX)-XHGFXS(L,NY,NX) + ZNH4SH(L,NY,NX)=ZNH4SH(L,NY,NX)+TN4FHS(L,NY,NX)-XN4FXW(L,NY,NX) + ZNH3SH(L,NY,NX)=ZNH3SH(L,NY,NX)+TN3FHS(L,NY,NX)-XN3FXW(L,NY,NX) + ZNO3SH(L,NY,NX)=ZNO3SH(L,NY,NX)+TNOFHS(L,NY,NX)-XNOFXW(L,NY,NX) + ZNO2SH(L,NY,NX)=ZNO2SH(L,NY,NX)+TNXFHS(L,NY,NX)-XNXFXS(L,NY,NX) + H1PO4H(L,NY,NX)=H1PO4H(L,NY,NX)+TP1FHS(L,NY,NX)-XH1PXS(L,NY,NX) + H2PO4H(L,NY,NX)=H2PO4H(L,NY,NX)+TPOFHS(L,NY,NX)-XH2PXS(L,NY,NX) + ZNH4BH(L,NY,NX)=ZNH4BH(L,NY,NX)+TN4FHB(L,NY,NX)-XN4FXB(L,NY,NX) + ZNH3BH(L,NY,NX)=ZNH3BH(L,NY,NX)+TN3FHB(L,NY,NX)-XN3FXB(L,NY,NX) + ZNO3BH(L,NY,NX)=ZNO3BH(L,NY,NX)+TNOFHB(L,NY,NX)-XNOFXB(L,NY,NX) + ZNO2BH(L,NY,NX)=ZNO2BH(L,NY,NX)+TNXFHB(L,NY,NX)-XNXFXB(L,NY,NX) + H1POBH(L,NY,NX)=H1POBH(L,NY,NX)+TH1BHB(L,NY,NX)-XH1BXB(L,NY,NX) + H2POBH(L,NY,NX)=H2POBH(L,NY,NX)+TH2BHB(L,NY,NX)-XH2BXB(L,NY,NX) +C IF(NX.EQ.1)THEN +C WRITE(*,4747)'ZNO3SH',I,J,NX,NY,L,ZNO3SH(L,NY,NX) +C 2,TNOFHS(L,NY,NX),XNOFXW(L,NY,NX) +C 3,ZNO2SH(L,NY,NX),TNXFHS(L,NY,NX),XNXFXS(L,NY,NX) +4747 FORMAT(A8,5I4,12E12.4) +C IF((I/30)*30.EQ.I.AND.J.EQ.24)THEN +C WRITE(*,5545)'HP14',I,J,NX,NY,L,H1PO4(L,NY,NX),TP1FLS(L,NY,NX) +C 2,XH1PS(L,NY,NX),TRH1P(L,NY,NX),TUPH1P(L,NY,NX),RH1PFU(L,NY,NX) +C 3,XH1PXS(L,NY,NX),XH1P(L,NY,NX),H1POB(L,NY,NX) +C 4,TH1BFB(L,NY,NX),XH1BS(L,NY,NX),TRH1B(L,NY,NX),TUPH1B(L,NY,NX) +C 2,RH1BBU(L,NY,NX),XH1BXB(L,NY,NX),XH1PB(L,NY,NX) +C 2,H1PO4H(L,NY,NX),TP1FHS(L,NY,NX),XH1PXS(L,NY,NX) +C 2,H1POBH(L,NY,NX),TH1BHB(L,NY,NX),XH1BXB(L,NY,NX) +C WRITE(*,5545)'HP24',I,J,NX,NY,L,H2PO4(L,NY,NX),TPOFLS(L,NY,NX) +C 2,XH2PS(L,NY,NX),TRH2P(L,NY,NX),TUPH2P(L,NY,NX),RH2PFU(L,NY,NX) +C 3,XH2PXS(L,NY,NX),XH2P(L,NY,NX),H2POB(L,NY,NX) +C 4,TH2BFB(L,NY,NX),XH2BS(L,NY,NX),TRH2B(L,NY,NX),TUPH2B(L,NY,NX) +C 5,RH2BBU(L,NY,NX),XH2BXB(L,NY,NX),XH2PB(L,NY,NX) +C 2,H2PO4H(L,NY,NX),TPOFHS(L,NY,NX),XH2PXS(L,NY,NX) +C 2,H2POBH(L,NY,NX),TH2BHB(L,NY,NX),XH2BXB(L,NY,NX) +C ENDIF +C ENDIF +C +C GASES FROM VOLATILIZATION-DISSOLUTION AND GAS TRANSFER +C + CO2G(L,NY,NX)=CO2G(L,NY,NX)+TCOFLG(L,NY,NX)-XCODFG(L,NY,NX) + CH4G(L,NY,NX)=CH4G(L,NY,NX)+TCHFLG(L,NY,NX)-XCHDFG(L,NY,NX) + OXYG(L,NY,NX)=OXYG(L,NY,NX)+TOXFLG(L,NY,NX)-XOXDFG(L,NY,NX) + Z2GG(L,NY,NX)=Z2GG(L,NY,NX)+TNGFLG(L,NY,NX)-XNGDFG(L,NY,NX) + Z2OG(L,NY,NX)=Z2OG(L,NY,NX)+TN2FLG(L,NY,NX)-XN2DFG(L,NY,NX) + ZNH3G(L,NY,NX)=ZNH3G(L,NY,NX)+TNHFLG(L,NY,NX)-XN3DFG(L,NY,NX) + 2-XNBDFG(L,NY,NX)+TRN3G(L,NY,NX) + H2GG(L,NY,NX)=H2GG(L,NY,NX)+THGFLG(L,NY,NX)-XHGDFG(L,NY,NX) + ROXYF(L,NY,NX)=TOXFLG(L,NY,NX) + RCO2F(L,NY,NX)=TCOFLG(L,NY,NX) + RCH4F(L,NY,NX)=TCHFLG(L,NY,NX) + ROXYL(L,NY,NX)=TOXFLS(L,NY,NX)+ROXFLU(L,NY,NX)+XOXFXS(L,NY,NX) + 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 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 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 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) +C 5,XCHFXS(L,NY,NX),XCHBBL(L,NY,NX) +C ENDIF +C +C GRID CELL BOUNDARY FLUXES FROM ROOT GAS TRANSFER +C + HEATIN=HEATIN+THTHAW(L,NY,NX)+TUPHT(L,NY,NX) + CIB=TCOFLA(L,NY,NX) + CHB=TCHFLA(L,NY,NX) + OIB=TOXFLA(L,NY,NX) +C HGB=THGFLA(L,NY,NX) + HGB=0.0 + ZGB=0.0 + Z2B=TN2FLA(L,NY,NX) + ZHB=TNHFLA(L,NY,NX) +C +C GRID CELL BOUNDARY FLUXES BUBBLING +C + IF(LG.EQ.0)THEN + CIB=CIB+XCOBBL(L,NY,NX) + CHB=CHB+XCHBBL(L,NY,NX) + OIB=OIB+XOXBBL(L,NY,NX) + ZGB=ZGB+XNGBBL(L,NY,NX) + Z2B=Z2B+XN2BBL(L,NY,NX) + ZHB=ZHB+XN3BBL(L,NY,NX)+XNBBBL(L,NY,NX) + HGB=HGB+XHGBBL(L,NY,NX) + ELSE + LL=MIN(L,LG) + CO2G(LL,NY,NX)=CO2G(LL,NY,NX)-XCOBBL(L,NY,NX) + CH4G(LL,NY,NX)=CH4G(LL,NY,NX)-XCHBBL(L,NY,NX) + OXYG(LL,NY,NX)=OXYG(LL,NY,NX)-XOXBBL(L,NY,NX) + Z2GG(LL,NY,NX)=Z2GG(LL,NY,NX)-XNGBBL(L,NY,NX) + Z2OG(LL,NY,NX)=Z2OG(LL,NY,NX)-XN2BBL(L,NY,NX) + ZNH3G(LL,NY,NX)=ZNH3G(LL,NY,NX)-XN3BBL(L,NY,NX)-XNBBBL(L,NY,NX) + H2GG(LL,NY,NX)=H2GG(LL,NY,NX)-XHGBBL(L,NY,NX) + IF(LG.LT.L)THEN + TLCO2G=TLCO2G-XCOBBL(L,NY,NX)-XCHBBL(L,NY,NX) + UCO2S(NY,NX)=UCO2S(NY,NX)-XCOBBL(L,NY,NX)-XCHBBL(L,NY,NX) + OXYGSO=OXYGSO-XOXBBL(L,NY,NX) + TLN2G=TLN2G-XNGBBL(L,NY,NX)-XN2BBL(L,NY,NX) + 2-XN3BBL(L,NY,NX)-XNBBBL(L,NY,NX) + TLH2G=TLH2G-XHGBBL(L,NY,NX) + ENDIF + ENDIF + CO2GIN=CO2GIN+CIB+CHB + COB=TCO2P(L,NY,NX)+TCO2S(L,NY,NX)-12.0*TRCO2(L,NY,NX) + TCOU=TCOU+COB + HCO2G(NY,NX)=HCO2G(NY,NX)+CIB + UCO2G(NY,NX)=UCO2G(NY,NX)+CIB + HCH4G(NY,NX)=HCH4G(NY,NX)+CHB + UCH4G(NY,NX)=UCH4G(NY,NX)+CHB + UCOP(NY,NX)=UCOP(NY,NX)+TCO2P(L,NY,NX)+TCO2S(L,NY,NX) + UDICD(NY,NX)=UDICD(NY,NX)-12.0*TRCO2(L,NY,NX) + TNBP(NY,NX)=TNBP(NY,NX)+CH+12.0*TRCO2(L,NY,NX) + OXYGIN=OXYGIN+OIB + OOB=RUPOXO(L,NY,NX)+TUPOXP(L,NY,NX)+TUPOXS(L,NY,NX) + OXYGOU=OXYGOU+OOB + UOXYG(NY,NX)=UOXYG(NY,NX)+OIB + HOXYG(NY,NX)=HOXYG(NY,NX)+OIB + H2GIN=H2GIN+HGB + HOB=RH2GO(L,NY,NX)+TUPHGS(L,NY,NX) + H2GOU=H2GOU+HOB + ZN2GIN=ZN2GIN+ZGB+Z2B+ZHB +C UN2GG(NY,NX)=UN2GG(NY,NX)+ZGB +C HN2GG(NY,NX)=HN2GG(NY,NX)+ZGB + UN2OG(NY,NX)=UN2OG(NY,NX)+Z2B + HN2OG(NY,NX)=HN2OG(NY,NX)+Z2B + UNH3G(NY,NX)=UNH3G(NY,NX)+ZHB + 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 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,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) +C 6,CH4G(LL,NY,NX) +6645 FORMAT(A8,7I4,30E12.4) +C ENDIF +C +C GRID CELL BOUNDARY FLUXES FROM EQUILIBRIUM REACTIONS +C + SNM=(2.0*(XNH4S(L,NY,NX)+XNH4B(L,NY,NX)-TUPNH4(L,NY,NX) + 2-TUPNHB(L,NY,NX)-XN2GS(L,NY,NX))-TUPN3S(L,NY,NX)-TUPN3B(L,NY,NX) + 3+XNO3S(L,NY,NX)+XNO3B(L,NY,NX)-TUPNO3(L,NY,NX)-TUPNOB(L,NY,NX) + 5+XNO2S(L,NY,NX)+XNO2B(L,NY,NX))/14.0 + SPM=(2.0*(XH1PS(L,NY,NX)+XH1BS(L,NY,NX)-TUPH1P(L,NY,NX) + 2-TUPH1B(L,NY,NX))+3.0*(XH2PS(L,NY,NX)+XH2BS(L,NY,NX) + 3-TUPH2P(L,NY,NX)-TUPH2B(L,NY,NX)))/31.0 + SSB=TRH2O(L,NY,NX)+TRCO2(L,NY,NX)+XZHYS(L,NY,NX) + 2+TBION(L,NY,NX) + TIONOU=TIONOU-SSB +C UIONOU(NY,NX)=UIONOU(NY,NX)-SSB +C WRITE(20,3339)'SSB',I,J,L,SSB,TRH2O(L,NY,NX) +C 2,TRCO2(L,NY,NX),XZHYS(L,NY,NX),TBION(L,NY,NX) +C +C GAS AND SOLUTE EXCHANGE WITHIN GRID CELL ADDED TO ECOSYSTEM +C TOTALS FOR CALCULATING COMPETITION CONSTRAINTS ON MICROBIAL +C AND ROOT POPULATIONS +C + DO 7990 K=0,5 + DO 7980 N=1,7 + ROXYX(L,NY,NX)=ROXYX(L,NY,NX)+ROXYS(N,K,L,NY,NX) + RNH4X(L,NY,NX)=RNH4X(L,NY,NX)+RVMX4(N,K,L,NY,NX) + 2+RINHO(N,K,L,NY,NX) + RNO3X(L,NY,NX)=RNO3X(L,NY,NX)+RVMX3(N,K,L,NY,NX) + 2+RINOO(N,K,L,NY,NX) + RNO2X(L,NY,NX)=RNO2X(L,NY,NX)+RVMX2(N,K,L,NY,NX) + RN2OX(L,NY,NX)=RN2OX(L,NY,NX)+RVMX1(N,K,L,NY,NX) + RPO4X(L,NY,NX)=RPO4X(L,NY,NX)+RIPOO(N,K,L,NY,NX) + RP14X(L,NY,NX)=RP14X(L,NY,NX)+RIPO1(N,K,L,NY,NX) + RNHBX(L,NY,NX)=RNHBX(L,NY,NX)+RVMB4(N,K,L,NY,NX) + 2+RINHB(N,K,L,NY,NX) + RN3BX(L,NY,NX)=RN3BX(L,NY,NX)+RVMB3(N,K,L,NY,NX) + 2+RINOB(N,K,L,NY,NX) + RN2BX(L,NY,NX)=RN2BX(L,NY,NX)+RVMB2(N,K,L,NY,NX) + RPOBX(L,NY,NX)=RPOBX(L,NY,NX)+RIPBO(N,K,L,NY,NX) + RP1BX(L,NY,NX)=RP1BX(L,NY,NX)+RIPB1(N,K,L,NY,NX) + IF(K.LE.4)THEN + ROQCX(K,L,NY,NX)=ROQCX(K,L,NY,NX)+ROQCS(N,K,L,NY,NX) + ROQAX(K,L,NY,NX)=ROQAX(K,L,NY,NX)+ROQAS(N,K,L,NY,NX) + ENDIF +7980 CONTINUE +7990 CONTINUE + RNO2X(L,NY,NX)=RNO2X(L,NY,NX)+RVMXC(L,NY,NX) + RN2BX(L,NY,NX)=RN2BX(L,NY,NX)+RVMBC(L,NY,NX) +C +C GRID CELL VARIABLES NEEDED FOR WATER, C, N, P, O, SOLUTE AND +C ENERGY BALANCES INCLUDING SUM OF ALL CURRENT STATE VARIABLES, +C CUMULATIVE SUMS OF ALL ADDITIONS AND REMOVALS SINCE START OF RUN +C +C IF(J.EQ.24)THEN + WS=VOLW(L,NY,NX)+VOLWH(L,NY,NX) + 2+(VOLI(L,NY,NX)+VOLIH(L,NY,NX))*DENSI + VOLWSO=VOLWSO+WS + UVOLW(NY,NX)=UVOLW(NY,NX)+WS +C 2-WP(L,NY,NX)*VOLX(L,NY,NX) + HEATSO=HEATSO+VHCP(L,NY,NX)*TKS(L,NY,NX) + SD=SAND(L,NY,NX)+SILT(L,NY,NX)+CLAY(L,NY,NX) + TSEDSO=TSEDSO+SD + CS=CO2G(L,NY,NX)+CO2S(L,NY,NX)+CO2SH(L,NY,NX)+TLCO2P(L,NY,NX) + 2+CH4G(L,NY,NX)+CH4S(L,NY,NX)+CH4SH(L,NY,NX)+TLCH4P(L,NY,NX) + TLCO2G=TLCO2G+CS + UCO2S(NY,NX)=UCO2S(NY,NX)+CS + HS=H2GG(L,NY,NX)+H2GS(L,NY,NX)+H2GSH(L,NY,NX)+TLH2GP(L,NY,NX) + TLH2G=TLH2G+HS +C IF(NX.EQ.1.AND.NY.EQ.1)THEN +C WRITE(*,8642)'TLCO2G',I,J,L,TLCO2G,CS,CO2G(L,NY,NX),CO2S(L,NY,NX) +C 2,CO2SH(L,NY,NX),TLCO2P(L,NY,NX),CH4G(L,NY,NX),CH4S(L,NY,NX) +C 3,CH4SH(L,NY,NX),TLCH4P(L,NY,NX),UCO2S(NY,NX) +8642 FORMAT(A8,3I4,20F20.6) +C ENDIF + OS=OXYG(L,NY,NX)+OXYS(L,NY,NX)+OXYSH(L,NY,NX)+TLOXYP(L,NY,NX) + OXYGSO=OXYGSO+OS + ZG=Z2GG(L,NY,NX)+Z2GS(L,NY,NX)+Z2GSH(L,NY,NX)+TLN2OP(L,NY,NX) + 2+Z2OG(L,NY,NX)+Z2OS(L,NY,NX)+Z2OSH(L,NY,NX)+TLNH3P(L,NY,NX) + 3+ZNH3G(L,NY,NX) + TLN2G=TLN2G+ZG + Z4S=ZNH4S(L,NY,NX)+ZNH4SH(L,NY,NX)+ZNH4B(L,NY,NX)+ZNH4BH(L,NY,NX) + 2+ZNH3S(L,NY,NX)+ZNH3SH(L,NY,NX)+ZNH3B(L,NY,NX)+ZNH3BH(L,NY,NX) + Z4X=14.0*(XN4(L,NY,NX)+XNB(L,NY,NX)) + Z4F=14.0*(ZNH4FA(L,NY,NX)+ZNHUFA(L,NY,NX)+ZNH3FA(L,NY,NX) + 2+ZNH4FB(L,NY,NX)+ZNHUFB(L,NY,NX)+ZNH3FB(L,NY,NX)) + TLNH4=TLNH4+Z4S+Z4X+Z4F + UNH4(NY,NX)=UNH4(NY,NX)+Z4S+Z4X +C IF(NX.EQ.4)THEN +C WRITE(*,5455)'XNH4L',I,J,NX,NY,L,UNH4(NY,NX),ZNH,XN4(L,NY,NX) +C 2,XNB(L,NY,NX),ZNH4S(L,NY,NX),ZNH4SH(L,NY,NX) +C 3,ZNH4B(L,NY,NX),ZNH4BH(L,NY,NX),ZNH3S(L,NY,NX),ZNH3SH(L,NY,NX) +C 4,ZNH3B(L,NY,NX),ZNH3BH(L,NY,NX) +5455 FORMAT(A8,5I4,30E12.4) +C ENDIF + ZOS=ZNO3S(L,NY,NX)+ZNO3SH(L,NY,NX)+ZNO3B(L,NY,NX)+ZNO3BH(L,NY,NX) + 2+ZNO2S(L,NY,NX)+ZNO2SH(L,NY,NX)+ZNO2B(L,NY,NX)+ZNO2BH(L,NY,NX) + ZOF=14.0*(ZNO3FA(L,NY,NX)+ZNO3FA(L,NY,NX)) + TLNO3=TLNO3+ZOS+ZOF + UNO3(NY,NX)=UNO3(NY,NX)+ZOS + POS=H2PO4(L,NY,NX)+H2PO4H(L,NY,NX)+H2POB(L,NY,NX)+H2POBH(L,NY,NX) + 2+H1PO4(L,NY,NX)+H1PO4H(L,NY,NX)+H1POB(L,NY,NX)+H1POBH(L,NY,NX) + POX=31.0*(XH1P(L,NY,NX)+XH2P(L,NY,NX) + 4+XH1PB(L,NY,NX)+XH2PB(L,NY,NX)) + POP=31.0*(PALPO(L,NY,NX)+PFEPO(L,NY,NX)+PCAPD(L,NY,NX) + 6+PALPB(L,NY,NX)+PFEPB(L,NY,NX)+PCPDB(L,NY,NX)) + 7+62.0*(PCAPM(L,NY,NX)+PCPMB(L,NY,NX)) + 8+93.0*(PCAPH(L,NY,NX)+PCPHB(L,NY,NX)) + TLPO4=TLPO4+POS+POX+POP + UPO4(NY,NX)=UPO4(NY,NX)+POX + UPP4(NY,NX)=UPP4(NY,NX)+POP +C +C TOTAL SOC,SON,SOP +C + RC=0.0 + RN=0.0 + RP=0.0 + OC=0.0 + ON=0.0 + OP=0.0 + OMCL(L,NY,NX)=0.0 + OMNL(L,NY,NX)=0.0 + DO 7970 K=0,5 + IF(K.LE.2)THEN + DO 7960 N=1,7 + DO 7960 M=1,3 + RC=RC+OMC(M,N,K,L,NY,NX) + RN=RN+OMN(M,N,K,L,NY,NX) + RP=RP+OMP(M,N,K,L,NY,NX) + TOMT(NY,NX)=TOMT(NY,NX)+OMC(M,N,K,L,NY,NX) + TONT(NY,NX)=TONT(NY,NX)+OMN(M,N,K,L,NY,NX) + TOPT(NY,NX)=TOPT(NY,NX)+OMP(M,N,K,L,NY,NX) + OMCL(L,NY,NX)=OMCL(L,NY,NX)+OMC(M,N,K,L,NY,NX) + OMNL(L,NY,NX)=OMNL(L,NY,NX)+OMN(M,N,K,L,NY,NX) +7960 CONTINUE + ELSE + DO 7950 N=1,7 + DO 7950 M=1,3 + OC=OC+OMC(M,N,K,L,NY,NX) + ON=ON+OMN(M,N,K,L,NY,NX) + OP=OP+OMP(M,N,K,L,NY,NX) + TOMT(NY,NX)=TOMT(NY,NX)+OMC(M,N,K,L,NY,NX) + TONT(NY,NX)=TONT(NY,NX)+OMN(M,N,K,L,NY,NX) + TOPT(NY,NX)=TOPT(NY,NX)+OMP(M,N,K,L,NY,NX) + OMCL(L,NY,NX)=OMCL(L,NY,NX)+OMC(M,N,K,L,NY,NX) + OMNL(L,NY,NX)=OMNL(L,NY,NX)+OMN(M,N,K,L,NY,NX) +7950 CONTINUE + ENDIF +7970 CONTINUE + DO 7900 K=0,4 + IF(K.LE.2)THEN + DO 7940 M=1,2 + RC=RC+ORC(M,K,L,NY,NX) + RN=RN+ORN(M,K,L,NY,NX) + RP=RP+ORP(M,K,L,NY,NX) +7940 CONTINUE + RC=RC+OQC(K,L,NY,NX)+OQCH(K,L,NY,NX)+OHC(K,L,NY,NX) + 2+OQA(K,L,NY,NX)+OQAH(K,L,NY,NX)+OHA(K,L,NY,NX) + RN=RN+OQN(K,L,NY,NX)+OQNH(K,L,NY,NX)+OHN(K,L,NY,NX) + RP=RP+OQP(K,L,NY,NX)+OQPH(K,L,NY,NX)+OHP(K,L,NY,NX) + DO 7930 M=1,4 + RC=RC+OSC(M,K,L,NY,NX) + RN=RN+OSN(M,K,L,NY,NX) + RP=RP+OSP(M,K,L,NY,NX) +7930 CONTINUE + ELSE + DO 7920 M=1,2 + OC=OC+ORC(M,K,L,NY,NX) + ON=ON+ORN(M,K,L,NY,NX) + OP=OP+ORP(M,K,L,NY,NX) +7920 CONTINUE + OC=OC+OQC(K,L,NY,NX)+OQCH(K,L,NY,NX)+OHC(K,L,NY,NX) + 2+OQA(K,L,NY,NX)+OQAH(K,L,NY,NX)+OHA(K,L,NY,NX) + ON=ON+OQN(K,L,NY,NX)+OQNH(K,L,NY,NX)+OHN(K,L,NY,NX) + OP=OP+OQP(K,L,NY,NX)+OQPH(K,L,NY,NX)+OHP(K,L,NY,NX) + DO 7910 M=1,4 + OC=OC+OSC(M,K,L,NY,NX) + ON=ON+OSN(M,K,L,NY,NX) + OP=OP+OSP(M,K,L,NY,NX) +7910 CONTINUE + ENDIF +7900 CONTINUE + ORGC(L,NY,NX)=RC+OC + ORGN(L,NY,NX)=RN+ON + ORGR(L,NY,NX)=RC +C IF(L.EQ.1)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) +4343 FORMAT(A8,6I4,60E12.4) +4344 CONTINUE +C ENDIF + TLRSDC=TLRSDC+RC + URSDC(NY,NX)=URSDC(NY,NX)+RC + TLRSDN=TLRSDN+RN + URSDN(NY,NX)=URSDN(NY,NX)+RN + TLRSDP=TLRSDP+RP + URSDP(NY,NX)=URSDP(NY,NX)+RP + TLORGC=TLORGC+OC + UORGC(NY,NX)=UORGC(NY,NX)+OC + TLORGN=TLORGN+ON + UORGN(NY,NX)=UORGN(NY,NX)+ON + TLORGP=TLORGP+OP + UORGP(NY,NX)=UORGP(NY,NX)+OP + TSEDSO=TSEDSO+(RC+OC)*1.0E-06 +C +C TOTAL SALT IONS +C + IF(ISALT(NY,NX).NE.0)THEN + ZAL(L,NY,NX)=ZAL(L,NY,NX)+TRAL(L,NY,NX)+TALFLS(L,NY,NX) + 2+RALFLU(L,NY,NX)+XALFXS(L,NY,NX) + ZFE(L,NY,NX)=ZFE(L,NY,NX)+TRFE(L,NY,NX)+TFEFLS(L,NY,NX) + 2+RFEFLU(L,NY,NX)+XFEFXS(L,NY,NX) + ZHY(L,NY,NX)=ZHY(L,NY,NX)+TRHY(L,NY,NX)+THYFLS(L,NY,NX) + 2+RHYFLU(L,NY,NX)+XHYFXS(L,NY,NX)+XZHYS(L,NY,NX) + ZCA(L,NY,NX)=ZCA(L,NY,NX)+TRCA(L,NY,NX)+TCAFLS(L,NY,NX) + 2+RCAFLU(L,NY,NX)+XCAFXS(L,NY,NX) + ZMG(L,NY,NX)=ZMG(L,NY,NX)+TRMG(L,NY,NX)+TMGFLS(L,NY,NX) + 2+RMGFLU(L,NY,NX)+XMGFXS(L,NY,NX) + ZNA(L,NY,NX)=ZNA(L,NY,NX)+TRNA(L,NY,NX)+TNAFLS(L,NY,NX) + 2+RNAFLU(L,NY,NX)+XNAFXS(L,NY,NX) + ZKA(L,NY,NX)=ZKA(L,NY,NX)+TRKA(L,NY,NX)+TKAFLS(L,NY,NX) + 2+RKAFLU(L,NY,NX)+XKAFXS(L,NY,NX) + ZOH(L,NY,NX)=ZOH(L,NY,NX)+TROH(L,NY,NX)+TOHFLS(L,NY,NX) + 2+ROHFLU(L,NY,NX)+XOHFXS(L,NY,NX) +C WRITE(20,5545)'ZOH',I,J,NX,NY,L +C 2,ZOH(L,NY,NX),TROH(L,NY,NX) +C 2,TOHFLS(L,NY,NX),ROHFLU(L,NY,NX),XOHFXS(L,NY,NX) +C 2,ZHY(L,NY,NX),TRHY(L,NY,NX),THYFLS(L,NY,NX) +C 2,RHYFLU(L,NY,NX),XHYFXS(L,NY,NX),XZHYS(L,NY,NX) +C 3,XHY(L,NY,NX),TRXHY(L,NY,NX) +C 4,ZOH(L,NY,NX)/VOLW(L,NY,NX),ZHY(L,NY,NX)/VOLW(L,NY,NX) + ZSO4(L,NY,NX)=ZSO4(L,NY,NX)+TRSO4(L,NY,NX)+TSOFLS(L,NY,NX) + 2+RSOFLU(L,NY,NX)+XSOFXS(L,NY,NX) + ZCL(L,NY,NX)=ZCL(L,NY,NX)+TCLFLS(L,NY,NX)+RCLFLU(L,NY,NX) + 2+XCLFXS(L,NY,NX) + ZCO3(L,NY,NX)=ZCO3(L,NY,NX)+TRCO3(L,NY,NX)+TC3FLS(L,NY,NX) + 2+XC3FXS(L,NY,NX) + ZHCO3(L,NY,NX)=ZHCO3(L,NY,NX)+TRHCO(L,NY,NX)+THCFLS(L,NY,NX) + 2+XHCFXS(L,NY,NX) + ZALOH1(L,NY,NX)=ZALOH1(L,NY,NX)+TRAL1(L,NY,NX)+TAL1FS(L,NY,NX) + 2+XAL1XS(L,NY,NX) + ZALOH2(L,NY,NX)=ZALOH2(L,NY,NX)+TRAL2(L,NY,NX)+TAL2FS(L,NY,NX) + 2+XAL2XS(L,NY,NX)-TRXAL2(L,NY,NX) + ZALOH3(L,NY,NX)=ZALOH3(L,NY,NX)+TRAL3(L,NY,NX)+TAL3FS(L,NY,NX) + 2+XAL3XS(L,NY,NX) + ZALOH4(L,NY,NX)=ZALOH4(L,NY,NX)+TRAL4(L,NY,NX)+TAL4FS(L,NY,NX) + 2+XAL4XS(L,NY,NX) + ZALS(L,NY,NX)=ZALS(L,NY,NX)+TRALS(L,NY,NX)+TALSFS(L,NY,NX) + 2+XALSXS(L,NY,NX) + ZFEOH1(L,NY,NX)=ZFEOH1(L,NY,NX)+TRFE1(L,NY,NX)+TFE1FS(L,NY,NX) + 2+XFE1XS(L,NY,NX) + ZFEOH2(L,NY,NX)=ZFEOH2(L,NY,NX)+TRFE2(L,NY,NX)+TFE2FS(L,NY,NX) + 2+XFE2XS(L,NY,NX)-TRXFE2(L,NY,NX) + ZFEOH3(L,NY,NX)=ZFEOH3(L,NY,NX)+TRFE3(L,NY,NX)+TFE3FS(L,NY,NX) + 2+XFE3XS(L,NY,NX) + ZFEOH4(L,NY,NX)=ZFEOH4(L,NY,NX)+TRFE4(L,NY,NX)+TFE4FS(L,NY,NX) + 2+XFE4XS(L,NY,NX) + ZFES(L,NY,NX)=ZFES(L,NY,NX)+TRFES(L,NY,NX)+TFESFS(L,NY,NX) + 2+XFESXS(L,NY,NX) + ZCAO(L,NY,NX)=ZCAO(L,NY,NX)+TRCAO(L,NY,NX)+TCAOFS(L,NY,NX) + 2+XCAOXS(L,NY,NX) + ZCAC(L,NY,NX)=ZCAC(L,NY,NX)+TRCAC(L,NY,NX)+TCACFS(L,NY,NX) + 2+XCACXS(L,NY,NX) + ZCAH(L,NY,NX)=ZCAH(L,NY,NX)+TRCAH(L,NY,NX)+TCAHFS(L,NY,NX) + 2+XCAHXS(L,NY,NX) + ZCAS(L,NY,NX)=ZCAS(L,NY,NX)+TRCAS(L,NY,NX)+TCASFS(L,NY,NX) + 2+XCASXS(L,NY,NX) + ZMGO(L,NY,NX)=ZMGO(L,NY,NX)+TRMGO(L,NY,NX)+TMGOFS(L,NY,NX) + 2+XMGOXS(L,NY,NX) + ZMGC(L,NY,NX)=ZMGC(L,NY,NX)+TRMGC(L,NY,NX)+TMGCFS(L,NY,NX) + 2+XMGCXS(L,NY,NX) + ZMGH(L,NY,NX)=ZMGH(L,NY,NX)+TRMGH(L,NY,NX)+TMGHFS(L,NY,NX) + 2+XMGHXS(L,NY,NX) + ZMGS(L,NY,NX)=ZMGS(L,NY,NX)+TRMGS(L,NY,NX)+TMGSFS(L,NY,NX) + 2+XMGSXS(L,NY,NX) + ZNAC(L,NY,NX)=ZNAC(L,NY,NX)+TRNAC(L,NY,NX)+TNACFS(L,NY,NX) + 2+XNACXS(L,NY,NX) + ZNAS(L,NY,NX)=ZNAS(L,NY,NX)+TRNAS(L,NY,NX)+TNASFS(L,NY,NX) + 2+XNASXS(L,NY,NX) + ZKAS(L,NY,NX)=ZKAS(L,NY,NX)+TRKAS(L,NY,NX)+TKASFS(L,NY,NX) + 2+XKASXS(L,NY,NX) + H0PO4(L,NY,NX)=H0PO4(L,NY,NX)+TRH0P(L,NY,NX)+TH0PFS(L,NY,NX) + 2+XH0PXS(L,NY,NX) + H3PO4(L,NY,NX)=H3PO4(L,NY,NX)+TRH3P(L,NY,NX)+TH3PFS(L,NY,NX) + 2+XH3PXS(L,NY,NX) + ZFE1P(L,NY,NX)=ZFE1P(L,NY,NX)+TRF1P(L,NY,NX)+TF1PFS(L,NY,NX) + 2+XF1PXS(L,NY,NX) + ZFE2P(L,NY,NX)=ZFE2P(L,NY,NX)+TRF2P(L,NY,NX)+TF2PFS(L,NY,NX) + 2+XF2PXS(L,NY,NX) + ZCA0P(L,NY,NX)=ZCA0P(L,NY,NX)+TRC0P(L,NY,NX)+TC0PFS(L,NY,NX) + 2+XC0PXS(L,NY,NX) + ZCA1P(L,NY,NX)=ZCA1P(L,NY,NX)+TRC1P(L,NY,NX)+TC1PFS(L,NY,NX) + 2+XC1PXS(L,NY,NX) + ZCA2P(L,NY,NX)=ZCA2P(L,NY,NX)+TRC2P(L,NY,NX)+TC2PFS(L,NY,NX) + 2+XC2PXS(L,NY,NX) + ZMG1P(L,NY,NX)=ZMG1P(L,NY,NX)+TRM1P(L,NY,NX)+TM1PFS(L,NY,NX) + 2+XM1PXS(L,NY,NX) + H0POB(L,NY,NX)=H0POB(L,NY,NX)+TRH0B(L,NY,NX)+TH0BFB(L,NY,NX) + 2+XH0BXB(L,NY,NX) + H3POB(L,NY,NX)=H3POB(L,NY,NX)+TRH3B(L,NY,NX)+TH3BFB(L,NY,NX) + 2+XH3BXB(L,NY,NX) + ZFE1PB(L,NY,NX)=ZFE1PB(L,NY,NX)+TRF1B(L,NY,NX)+TF1BFB(L,NY,NX) + 2+XF1BXB(L,NY,NX) + ZFE2PB(L,NY,NX)=ZFE2PB(L,NY,NX)+TRF2B(L,NY,NX)+TF2BFB(L,NY,NX) + 2+XF2BXB(L,NY,NX) + ZCA0PB(L,NY,NX)=ZCA0PB(L,NY,NX)+TRC0B(L,NY,NX)+TC0BFB(L,NY,NX) + 2+XC0BXB(L,NY,NX) + ZCA1PB(L,NY,NX)=ZCA1PB(L,NY,NX)+TRC1B(L,NY,NX)+TC1BFB(L,NY,NX) + 2+XC1BXB(L,NY,NX) + ZCA2PB(L,NY,NX)=ZCA2PB(L,NY,NX)+TRC2B(L,NY,NX)+TC2BFB(L,NY,NX) + 2+XC2BXB(L,NY,NX) + ZMG1PB(L,NY,NX)=ZMG1PB(L,NY,NX)+TRM1B(L,NY,NX)+TM1BFB(L,NY,NX) + 2+XM1BXB(L,NY,NX) + ZALH(L,NY,NX)=ZALH(L,NY,NX)+TALFHS(L,NY,NX)-XALFXS(L,NY,NX) + ZFEH(L,NY,NX)=ZFEH(L,NY,NX)+TFEFHS(L,NY,NX)-XFEFXS(L,NY,NX) + ZHYH(L,NY,NX)=ZHYH(L,NY,NX)+THYFHS(L,NY,NX)-XHYFXS(L,NY,NX) + ZCCH(L,NY,NX)=ZCCH(L,NY,NX)+TCAFHS(L,NY,NX)-XCAFXS(L,NY,NX) + ZMAH(L,NY,NX)=ZMAH(L,NY,NX)+TMGFHS(L,NY,NX)-XMGFXS(L,NY,NX) + ZNAH(L,NY,NX)=ZNAH(L,NY,NX)+TNAFHS(L,NY,NX)-XNAFXS(L,NY,NX) + ZKAH(L,NY,NX)=ZKAH(L,NY,NX)+TKAFHS(L,NY,NX)-XKAFXS(L,NY,NX) + ZOHH(L,NY,NX)=ZOHH(L,NY,NX)+TOHFHS(L,NY,NX)-XOHFXS(L,NY,NX) + ZSO4H(L,NY,NX)=ZSO4H(L,NY,NX)+TSOFHS(L,NY,NX)-XSOFXS(L,NY,NX) + ZCLH(L,NY,NX)=ZCLH(L,NY,NX)+TCLFHS(L,NY,NX)-XCLFXS(L,NY,NX) + ZCO3H(L,NY,NX)=ZCO3H(L,NY,NX)+TC3FHS(L,NY,NX)-XC3FXS(L,NY,NX) + ZHCO3H(L,NY,NX)=ZHCO3H(L,NY,NX)+THCFHS(L,NY,NX)-XHCFXS(L,NY,NX) + ZALO1H(L,NY,NX)=ZALO1H(L,NY,NX)+TAL1HS(L,NY,NX)-XAL1XS(L,NY,NX) + ZALO2H(L,NY,NX)=ZALO2H(L,NY,NX)+TAL2HS(L,NY,NX)-XAL2XS(L,NY,NX) + ZALO3H(L,NY,NX)=ZALO3H(L,NY,NX)+TAL3HS(L,NY,NX)-XAL3XS(L,NY,NX) + ZALO4H(L,NY,NX)=ZALO4H(L,NY,NX)+TAL4HS(L,NY,NX)-XAL4XS(L,NY,NX) + ZALSH(L,NY,NX)=ZALSH(L,NY,NX)+TALSHS(L,NY,NX)-XALSXS(L,NY,NX) + ZFEO1H(L,NY,NX)=ZFEO1H(L,NY,NX)+TFE1HS(L,NY,NX)-XFE1XS(L,NY,NX) + ZFEO2H(L,NY,NX)=ZFEO2H(L,NY,NX)+TFE2HS(L,NY,NX)-XFE2XS(L,NY,NX) + ZFEO3H(L,NY,NX)=ZFEO3H(L,NY,NX)+TFE3HS(L,NY,NX)-XFE3XS(L,NY,NX) + ZFEO4H(L,NY,NX)=ZFEO4H(L,NY,NX)+TFE4HS(L,NY,NX)-XFE4XS(L,NY,NX) + ZFESH(L,NY,NX)=ZFESH(L,NY,NX)+TFESHS(L,NY,NX)-XFESXS(L,NY,NX) + ZCAOH(L,NY,NX)=ZCAOH(L,NY,NX)+TCAOHS(L,NY,NX)-XCAOXS(L,NY,NX) + ZCACH(L,NY,NX)=ZCACH(L,NY,NX)+TCACHS(L,NY,NX)-XCACXS(L,NY,NX) + ZCAHH(L,NY,NX)=ZCAHH(L,NY,NX)+TCAHHS(L,NY,NX)-XCAHXS(L,NY,NX) + ZCASH(L,NY,NX)=ZCASH(L,NY,NX)+TCASHS(L,NY,NX)-XCASXS(L,NY,NX) + ZMGOH(L,NY,NX)=ZMGOH(L,NY,NX)+TMGOHS(L,NY,NX)-XMGOXS(L,NY,NX) + ZMGCH(L,NY,NX)=ZMGCH(L,NY,NX)+TMGCHS(L,NY,NX)-XMGCXS(L,NY,NX) + ZMGHH(L,NY,NX)=ZMGHH(L,NY,NX)+TMGHHS(L,NY,NX)-XMGHXS(L,NY,NX) + ZMGSH(L,NY,NX)=ZMGSH(L,NY,NX)+TMGSHS(L,NY,NX)-XMGSXS(L,NY,NX) + ZNACH(L,NY,NX)=ZNACH(L,NY,NX)+TNACHS(L,NY,NX)-XNACXS(L,NY,NX) + ZNASH(L,NY,NX)=ZNASH(L,NY,NX)+TNASHS(L,NY,NX)-XNASXS(L,NY,NX) + ZKASH(L,NY,NX)=ZKASH(L,NY,NX)+TKASHS(L,NY,NX)-XKASXS(L,NY,NX) + H0PO4H(L,NY,NX)=H0PO4H(L,NY,NX)+TH0PHS(L,NY,NX)-XH0PXS(L,NY,NX) + H3PO4H(L,NY,NX)=H3PO4H(L,NY,NX)+TH3PHS(L,NY,NX)-XH3PXS(L,NY,NX) + ZFE1PH(L,NY,NX)=ZFE1PH(L,NY,NX)+TF1PHS(L,NY,NX)-XF1PXS(L,NY,NX) + ZFE2PH(L,NY,NX)=ZFE2PH(L,NY,NX)+TF2PHS(L,NY,NX)-XF2PXS(L,NY,NX) + ZCA0PH(L,NY,NX)=ZCA0PH(L,NY,NX)+TC0PHS(L,NY,NX)-XC0PXS(L,NY,NX) + ZCA1PH(L,NY,NX)=ZCA1PH(L,NY,NX)+TC1PHS(L,NY,NX)-XC1PXS(L,NY,NX) + ZCA2PH(L,NY,NX)=ZCA2PH(L,NY,NX)+TC2PHS(L,NY,NX)-XC2PXS(L,NY,NX) + ZMG1PH(L,NY,NX)=ZMG1PH(L,NY,NX)+TM1PHS(L,NY,NX)-XM1PXS(L,NY,NX) + H0POBH(L,NY,NX)=H0POBH(L,NY,NX)+TH0BHB(L,NY,NX)-XH0BXB(L,NY,NX) + H3POBH(L,NY,NX)=H3POBH(L,NY,NX)+TH3BHB(L,NY,NX)-XH3BXB(L,NY,NX) + ZFE1BH(L,NY,NX)=ZFE1BH(L,NY,NX)+TF1BHB(L,NY,NX)-XF1BXB(L,NY,NX) + ZFE2BH(L,NY,NX)=ZFE2BH(L,NY,NX)+TF2BHB(L,NY,NX)-XF2BXB(L,NY,NX) + ZCA0BH(L,NY,NX)=ZCA0BH(L,NY,NX)+TC0BHB(L,NY,NX)-XC0BXB(L,NY,NX) + ZCA1BH(L,NY,NX)=ZCA1BH(L,NY,NX)+TC1BHB(L,NY,NX)-XC1BXB(L,NY,NX) + ZCA2BH(L,NY,NX)=ZCA2BH(L,NY,NX)+TC2BHB(L,NY,NX)-XC2BXB(L,NY,NX) + ZMG1BH(L,NY,NX)=ZMG1BH(L,NY,NX)+TM1BHB(L,NY,NX)-XM1BXB(L,NY,NX) + XHY(L,NY,NX)=XHY(L,NY,NX)+TRXHY(L,NY,NX) + XAL(L,NY,NX)=XAL(L,NY,NX)+TRXAL(L,NY,NX) + XFE(L,NY,NX)=XFE(L,NY,NX)+TRXFE(L,NY,NX) + XCA(L,NY,NX)=XCA(L,NY,NX)+TRXCA(L,NY,NX) + XMG(L,NY,NX)=XMG(L,NY,NX)+TRXMG(L,NY,NX) + XNA(L,NY,NX)=XNA(L,NY,NX)+TRXNA(L,NY,NX) + XKA(L,NY,NX)=XKA(L,NY,NX)+TRXKA(L,NY,NX) + XHC(L,NY,NX)=XHC(L,NY,NX)+TRXHC(L,NY,NX) + XALO2(L,NY,NX)=XALO2(L,NY,NX)+TRXAL2(L,NY,NX) + XFEO2(L,NY,NX)=XFEO2(L,NY,NX)+TRXFE2(L,NY,NX) + PALOH(L,NY,NX)=PALOH(L,NY,NX)+TRALOH(L,NY,NX) + PFEOH(L,NY,NX)=PFEOH(L,NY,NX)+TRFEOH(L,NY,NX) + PCACO(L,NY,NX)=PCACO(L,NY,NX)+TRCACO(L,NY,NX) + PCASO(L,NY,NX)=PCASO(L,NY,NX)+TRCASO(L,NY,NX) + PSS=31.0*(H0PO4(L,NY,NX)+H3PO4(L,NY,NX)+ZFE1P(L,NY,NX) + 2+ZFE2P(L,NY,NX)+ZCA0P(L,NY,NX)+ZCA1P(L,NY,NX) + 3+ZCA2P(L,NY,NX)+ZMG1P(L,NY,NX)+H0POB(L,NY,NX) + 4+H3POB(L,NY,NX)+ZFE1PB(L,NY,NX)+ZFE2PB(L,NY,NX) + 5+ZCA0PB(L,NY,NX)+ZCA1PB(L,NY,NX)+ZCA2PB(L,NY,NX) + 6+ZMG1PB(L,NY,NX)+H0PO4H(L,NY,NX)+H3PO4H(L,NY,NX) + 7+ZFE1PH(L,NY,NX)+ZFE2PH(L,NY,NX)+ZCA0PH(L,NY,NX) + 8+ZCA1PH(L,NY,NX)+ZCA2PH(L,NY,NX)+ZMG1PH(L,NY,NX) + 9+H0POBH(L,NY,NX)+H3POBH(L,NY,NX)+ZFE1BH(L,NY,NX) + 1+ZFE2BH(L,NY,NX)+ZCA0BH(L,NY,NX)+ZCA1BH(L,NY,NX) + 2+ZCA2BH(L,NY,NX)+ZMG1BH(L,NY,NX)) + TLPO4=TLPO4+PSS + SSS=ZAL(L,NY,NX)+ZFE(L,NY,NX)+ZHY(L,NY,NX)+ZCA(L,NY,NX) + 2+ZMG(L,NY,NX)+ZNA(L,NY,NX)+ZKA(L,NY,NX)+ZOH(L,NY,NX) + 3+ZSO4(L,NY,NX)+ZCL(L,NY,NX)+ZCO3(L,NY,NX)+H0PO4(L,NY,NX) + 4+H0POB(L,NY,NX) + 5+2.0*(ZHCO3(L,NY,NX)+ZALOH1(L,NY,NX) + 5+ZALS(L,NY,NX)+ZFEOH1(L,NY,NX)+ZFES(L,NY,NX)+ZCAO(L,NY,NX) + 6+ZCAC(L,NY,NX)+ZCAS(L,NY,NX)+ZMGO(L,NY,NX)+ZMGC(L,NY,NX) + 7+ZMGS(L,NY,NX)+ZNAC(L,NY,NX)+ZNAS(L,NY,NX)+ZKAS(L,NY,NX) + 8+ZCA0P(L,NY,NX)+ZCA0PB(L,NY,NX)) + 9+3.0*(ZALOH2(L,NY,NX)+ZFEOH2(L,NY,NX)+ZCAH(L,NY,NX) + 1+ZMGH(L,NY,NX)+ZFE1P(L,NY,NX)+ZCA1P(L,NY,NX)+ZMG1P(L,NY,NX) + 2+ZFE1PB(L,NY,NX)+ZCA1PB(L,NY,NX)+ZMG1PB(L,NY,NX)) + 3+4.0*(ZALOH3(L,NY,NX)+ZFEOH3(L,NY,NX)+H3PO4(L,NY,NX) + 3+ZFE2P(L,NY,NX)+ZCA2P(L,NY,NX)+H3POB(L,NY,NX)+ZFE2PB(L,NY,NX) + 5+ZCA2PB(L,NY,NX)) + 6+5.0*(ZALOH4(L,NY,NX)+ZFEOH4(L,NY,NX)) + SSH=ZALH(L,NY,NX)+ZFEH(L,NY,NX)+ZHYH(L,NY,NX)+ZCCH(L,NY,NX) + 2+ZMAH(L,NY,NX)+ZNAH(L,NY,NX)+ZKAH(L,NY,NX)+ZOHH(L,NY,NX) + 3+ZSO4H(L,NY,NX)+ZCLH(L,NY,NX)+ZCO3H(L,NY,NX) +H0PO4H(L,NY,NX) + 4+H0POBH(L,NY,NX) + 5+2.0*(ZHCO3H(L,NY,NX)+ZALO1H(L,NY,NX) + 5+ZALSH(L,NY,NX)+ZFEO1H(L,NY,NX)+ZFESH(L,NY,NX)+ZCAOH(L,NY,NX) + 6+ZCACH(L,NY,NX)+ZCASH(L,NY,NX)+ZMGOH(L,NY,NX)+ZMGCH(L,NY,NX) + 7+ZMGSH(L,NY,NX)+ZNACH(L,NY,NX)+ZNASH(L,NY,NX)+ZKASH(L,NY,NX) + 8+ZCA0PH(L,NY,NX)+ZCA0BH(L,NY,NX)) + 9+3.0*(ZALO2H(L,NY,NX)+ZFEO2H(L,NY,NX)+ZCAHH(L,NY,NX) + 1+ZMGHH(L,NY,NX)+ZFE1PH(L,NY,NX)+ZCA1PH(L,NY,NX)+ZMG1PH(L,NY,NX) + 2+ZFE1BH(L,NY,NX)+ZCA1BH(L,NY,NX)+ZMG1BH(L,NY,NX)) + 3+4.0*(ZALO3H(L,NY,NX)+ZFEO3H(L,NY,NX)+H3PO4H(L,NY,NX) + 4+ZFE2PH(L,NY,NX)+ZCA2PH(L,NY,NX)+H3POBH(L,NY,NX)+ZFE2BH(L,NY,NX) + 5+ZCA2BH(L,NY,NX)) + 6+5.0*(ZALO4H(L,NY,NX)+ZFEO4H(L,NY,NX)) + SSX=XHY(L,NY,NX)+XAL(L,NY,NX)+XFE(L,NY,NX)+XCA(L,NY,NX) + 2+XMG(L,NY,NX)+XNA(L,NY,NX)+XKA(L,NY,NX)+XHC(L,NY,NX) + 4+3.0*(XALO2(L,NY,NX)+XFEO2(L,NY,NX)) + SSP=2.0*(PCACO(L,NY,NX)+PCASO(L,NY,NX)) + 2+4.0*(PALOH(L,NY,NX)+PFEOH(L,NY,NX)) + SSI=SSS+SSH+SSX+SSP + TION=TION+SSI + UION(NY,NX)=UION(NY,NX)+SSI +C IF(I.EQ.180.AND.J.EQ.12)THEN +C WRITE(*,3339)'SSS',I,J,L,SSS,ZHY(L,NY,NX),ZAL(L,NY,NX) +C 2,ZFE(L,NY,NX),ZCA(L,NY,NX) +C 2,ZMG(L,NY,NX),ZNA(L,NY,NX),ZKA(L, NY,NX),ZOH(L,NY,NX) +C 3,ZSO4(L,NY,NX),ZCL(L,NY,NX),ZCO3(L,NY,NX),H0PO4(L,NY,NX) +C 4,H0POB(L,NY,NX) +C 5,ZHCO3(L,NY,NX),ZALOH1(L,NY,NX) +C 5,ZALS(L,NY,NX),ZFEOH1(L,NY,NX),ZFES(L,NY,NX),ZCAO(L,NY,NX) +C 6,ZCAC(L,NY,NX),ZCAS(L,NY,NX),ZMGO(L,NY,NX),ZMGC(L,NY,NX) +C 7,ZMGS(L,NY,NX),ZNAC(L,NY,NX),ZNAS(L,NY,NX),ZKAS(L,NY,NX) +C 8,ZCA0P(L,NY,NX),ZCA0PB(L,NY,NX) +C 9,ZALOH2(L,NY,NX),ZFEOH2(L,NY,NX),ZCAH(L,NY,NX) +C 1,ZMGH(L,NY,NX),ZFE1P(L,NY,NX),ZCA1P(L,NY,NX),ZMG1P(L,NY,NX) +C 2,ZFE1PB(L,NY,NX),ZCA1PB(L,NY,NX),ZMG1PB(L,NY,NX) +C 3,ZALOH3(L,NY,NX),ZFEOH3(L,NY,NX),H3PO4(L,NY,NX) +C 3,ZFE2P(L,NY,NX),ZCA2P(L,NY,NX),H3POB(L,NY,NX),ZFE2PB(L,NY,NX) +C 5,ZCA2PB(L,NY,NX) +C 6,ZALOH4(L,NY,NX),ZFEOH4(L,NY,NX) +C WRITE(*,3339)'SSX',I,J,L,SSX,XHY(L,NY,NX),XAL(L,NY,NX) +C 2,XFE(L,NY,NX),XCA(L,NY,NX),XMG(L,NY,NX),XNA(L,NY,NX) +C 3,XKA(L,NY,NX),XHC(L,NY,NX),XALO2(L,NY,NX),XFEO2(L,NY,NX) +C 4,PCACO(L,NY,NX),PCASO(L,NY,NX),PALOH(L,NY,NX),PFEOH(L,NY,NX) +C ENDIF +C +C SOIL ELECTRICAL CONDUCTIVITY +C + IF(VOLW(L,NY,NX).GT.0.0)THEN + ECHY=0.337*AMAX1(0.0,ZHY(L,NY,NX)/VOLW(L,NY,NX)) + ECOH=0.192*AMAX1(0.0,ZOH(L,NY,NX)/VOLW(L,NY,NX)) + ECAL=0.056*AMAX1(0.0,ZAL(L,NY,NX)*3.0/VOLW(L,NY,NX)) + ECFE=0.051*AMAX1(0.0,ZFE(L,NY,NX)*3.0/VOLW(L,NY,NX)) + ECCA=0.060*AMAX1(0.0,ZCA(L,NY,NX)*2.0/VOLW(L,NY,NX)) + ECMG=0.053*AMAX1(0.0,ZMG(L,NY,NX)*2.0/VOLW(L,NY,NX)) + ECNA=0.050*AMAX1(0.0,ZNA(L,NY,NX)/VOLW(L,NY,NX)) + ECKA=0.070*AMAX1(0.0,ZKA(L,NY,NX)/VOLW(L,NY,NX)) + ECCO=0.072*AMAX1(0.0,ZCO3(L,NY,NX)*2.0/VOLW(L,NY,NX)) + ECHC=0.044*AMAX1(0.0,ZHCO3(L,NY,NX)/VOLW(L,NY,NX)) + ECSO=0.080*AMAX1(0.0,ZSO4(L,NY,NX)*2.0/VOLW(L,NY,NX)) + ECCL=0.076*AMAX1(0.0,ZCL(L,NY,NX)/VOLW(L,NY,NX)) + ECNO=0.071*AMAX1(0.0,ZNO3S(L,NY,NX)/(VOLW(L,NY,NX)*14.0)) + ECND(L,NY,NX)=ECHY+ECOH+ECAL+ECFE+ECCA+ECMG+ECNA+ECKA + 2+ECCO+ECHC+ECSO+ECCL+ECNO +C IF(I.EQ.180.AND.J.EQ.12)THEN +C WRITE(*,5656)'ECND',I,J,L +C 2,ECND(L,NY,NX),VOLW(L,NY,NX),ECHY,ECOH,ECAL,ECFE,ECCA +C 3,ECMG,ECNA,ECKA,ECCO,ECHC,ECSO,ECCL,ECNO +5656 FORMAT(A8,3I4,30E12.4) +C ENDIF + ELSE + ECND(L,NY,NX)=0.0 + ENDIF + ENDIF +C ENDIF +C WRITE(20,3339)'LBN',I,J,L,TLNH4,TLNO3,TZIN,TZOU +C 2,Z4S,Z4X,Z4F,ZOS,ZOF,ZG +C 2,ZOD,ZXD,ZGD +C 3,ZGB,Z2B,ZHB +C 3,XNH4S(L,NY,NX),ZNH4S(L,NY,NX) +C 3,ZNH4SH(L,NY,NX),ZNH4B(L,NY,NX),ZNH4BH(L,NY,NX) +C 2,ZNH3S(L,NY,NX),ZNH3SH(L,NY,NX),ZNH3B(L,NY,NX),ZNH3BH(L,NY,NX) +C WRITE(20,3339)'LBP',I,J,L,TLPO4,TPIN,TPOU,POD,PXD,PQD,PHD +C 2,POS,POX,POP,PSS +C 2,XH1PS(L,NY,NX),XH2PS(L,NY,NX),H1PO4(L,NY,NX),H2PO4(L,NY,NX) +C 3,XH1P(L,NY,NX),XH2P(L,NY,NX),PALPO(L,NY,NX),PFEPO(L,NY,NX) +C 6,PCAPD(L,NY,NX),PCAPM(L,NY,NX),PCAPH(L,NY,NX) +C WRITE(20,3339)'LBS',I,J,L,TION,TIONIN,TIONOU +C 2,SSS,SSH,SSX,SSP,SSD,SHD,SSB +3339 FORMAT(A8,3I4,80E12.4) +125 CONTINUE + TRN(NY,NX)=TRN(NY,NX)+HEATI(NY,NX) + TLE(NY,NX)=TLE(NY,NX)+HEATE(NY,NX) + TSH(NY,NX)=TSH(NY,NX)+HEATS(NY,NX) + TGH(NY,NX)=TGH(NY,NX)-(HEATH(NY,NX)-HEATV(NY,NX)) + TLEC(NY,NX)=TLEC(NY,NX)+HEATE(NY,NX)*RAC(NY,NX) + TSHC(NY,NX)=TSHC(NY,NX)+HEATS(NY,NX)*RAC(NY,NX) + TCNET(NY,NX)=TCNET(NY,NX)+HCO2G(NY,NX) + RECO(NY,NX)=RECO(NY,NX)+HCO2G(NY,NX) + TNBP(NY,NX)=TNBP(NY,NX)+TCNET(NY,NX) +C +C UPDATE STATE VARIABLES WHEN SURFACE SEDIMENT TRANSPORT +C FORCES SOIL RE-LAYERING IF SURFACE LAYER BECOMES TOO +C THIN OR TOO THICK +C + IF(DLYR(3,NU(NY,NX),NY,NX).LT.DNUMN + 2.OR.DLYR(3,NU(NY,NX),NY,NX).GT.DNUMX)THEN + L0=NU(NY,NX) + IF(DLYR(3,NU(NY,NX),NY,NX).LT.DNUMN)THEN + FX=1.0 + L1=NU(NY,NX)+1 + NU(NY,NX)=L1 + ELSE + IF(NU(NY,NX).EQ.1)THEN + FX=(DLYR(3,NU(NY,NX),NY,NX)-DNUMX)/DLYR(3,NU(NY,NX),NY,NX) + L1=NU(NY,NX)+1 + NU(NY,NX)=L0 + ELSE + FZ=DLYR(3,NU(NY,NX),NY,NX)-DNUMX + IF(FZ.GT.DNUMN)THEN + FX=(DLYR(3,NU(NY,NX),NY,NX)-DNUMX)/DLYR(3,NU(NY,NX),NY,NX) + L1=NU(NY,NX)-1 + NU(NY,NX)=L1 + ELSE + FX=0.0 + L1=NU(NY,NX) + ENDIF + ENDIF + ENDIF + WRITE(*,5599)'ERODE1',I,J,NX,NY,L0,L1,NU(NY,NX),DNUMN,DNUMX + 2,DLYR(3,L0,NY,NX),DLYR(3,L1,NY,NX),FX +5599 FORMAT(A8,7I4,12E12.4) + IF(FX.GT.0.0)THEN + FY=1.0-FX + BKDS(L1,NY,NX)=(BKDS(L1,NY,NX) + 2*DLYR(3,L1,NY,NX)+BKDS(L0,NY,NX) + 3*FX*DLYR(3,L0,NY,NX))/(DLYR(3,L1,NY,NX) + 4+FX*DLYR(3,L0,NY,NX)) + VLNHB(L1,NY,NX)=(VLNHB(L1,NY,NX) + 2*DLYR(3,L1,NY,NX)+VLNHB(L0,NY,NX) + 3*FX*DLYR(3,L0,NY,NX))/(DLYR(3,L1,NY,NX) + 4+FX*DLYR(3,L0,NY,NX)) + VLNOB(L1,NY,NX)=(VLNOB(L1,NY,NX) + 2*DLYR(3,L1,NY,NX)+VLNOB(L0,NY,NX) + 3*FX*DLYR(3,L0,NY,NX))/(DLYR(3,L1,NY,NX) + 4+FX*DLYR(3,L0,NY,NX)) + VLPOB(L1,NY,NX)=(VLPOB(L1,NY,NX) + 2*DLYR(3,L1,NY,NX)+VLPOB(L0,NY,NX) + 3*FX*DLYR(3,L0,NY,NX))/(DLYR(3,L1,NY,NX) + 4+FX*DLYR(3,L0,NY,NX)) + VLNH4(L1,NY,NX)=1.0-VLNHB(L1,NY,NX) + VLNO3(L1,NY,NX)=1.0-VLNOB(L1,NY,NX) + VLPO4(L1,NY,NX)=1.0-VLPOB(L1,NY,NX) + DLYR(3,L1,NY,NX)=DLYR(3,L1,NY,NX) + 2+FX*DLYR(3,L0,NY,NX) + VOLX(L1,NY,NX)=VOLX(L1,NY,NX) + 2+FX*VOLX(L0,NY,NX) + BKVL(L1,NY,NX)=BKVL(L1,NY,NX) + 2+FX*BKVL(L0,NY,NX) + SAND(L1,NY,NX)=SAND(L1,NY,NX) + 2+FX*SAND(L0,NY,NX) + SILT(L1,NY,NX)=SILT(L1,NY,NX) + 2+FX*SILT(L0,NY,NX) + CLAY(L1,NY,NX)=CLAY(L1,NY,NX) + 2+FX*CLAY(L0,NY,NX) + XCEC(L1,NY,NX)=XCEC(L1,NY,NX) + 2+FX*XCEC(L0,NY,NX) + XAEC(L1,NY,NX)=XAEC(L1,NY,NX) + 2+FX*XAEC(L0,NY,NX) + VOLW(L1,NY,NX)=VOLW(L1,NY,NX) + 2+FX*VOLW(L0,NY,NX) + VOLI(L1,NY,NX)=VOLI(L1,NY,NX) + 2+FX*VOLI(L0,NY,NX) + VOLIH(L1,NY,NX)=VOLIH(L1,NY,NX) + 2+FX*VOLIH(L0,NY,NX) + VOLP(L1,NY,NX)=VOLP(L1,NY,NX) + 2+FX*VOLP(L0,NY,NX) + VOLA(L1,NY,NX)=VOLA(L1,NY,NX) + 2+FX*VOLA(L0,NY,NX) + VOLWX(L1,NY,NX)=VOLW(L0,NY,NX) + VOLWH(L1,NY,NX)=VOLWH(L1,NY,NX) + 2+FX*VOLWH(L0,NY,NX) + VOLAH(L1,NY,NX)=VOLAH(L1,NY,NX) + 2+FX*VOLAH(L0,NY,NX) + VHCM(L1,NY,NX)=VHCM(L1,NY,NX) + 2+FX*VHCM(L0,NY,NX) + VHCP(L1,NY,NX)=VHCM(L1,NY,NX) + 2+4.19*(VOLW(L1,NY,NX)+VOLWH(L1,NY,NX)) + 3+1.9274*(VOLI(L1,NY,NX)+VOLIH(L1,NY,NX)) + ZNH4FA(L1,NY,NX)=ZNH4FA(L1,NY,NX) + 2+FX*ZNH4FA(L0,NY,NX) + ZNH3FA(L1,NY,NX)=ZNH3FA(L1,NY,NX) + 2+FX*ZNH3FA(L0,NY,NX) + ZNHUFA(L1,NY,NX)=ZNHUFA(L1,NY,NX) + 2+FX*ZNHUFA(L0,NY,NX) + ZNO3FA(L1,NY,NX)=ZNO3FA(L1,NY,NX) + 2+FX*ZNO3FA(L0,NY,NX) + ZNH4FB(L1,NY,NX)=ZNH4FB(L1,NY,NX) + 2+FX*ZNH4FB(L0,NY,NX) + ZNH3FB(L1,NY,NX)=ZNH3FB(L1,NY,NX) + 2+FX*ZNH3FB(L0,NY,NX) + ZNHUFB(L1,NY,NX)=ZNHUFB(L1,NY,NX) + 2+FX*ZNHUFB(L0,NY,NX) + ZNO3FB(L1,NY,NX)=ZNO3FB(L1,NY,NX) + 2+FX*ZNO3FB(L0,NY,NX) + ZNH4S(L1,NY,NX)=ZNH4S(L1,NY,NX) + 2+FX*ZNH4S(L0,NY,NX) + ZNH4B(L1,NY,NX)=ZNH4B(L1,NY,NX) + 2+FX*ZNH4B(L0,NY,NX) + ZNH3S(L1,NY,NX)=ZNH3S(L1,NY,NX) + 2+FX*ZNH3S(L0,NY,NX) + ZNH3B(L1,NY,NX)=ZNH3B(L1,NY,NX) + 2+FX*ZNH3B(L0,NY,NX) + ZNO3S(L1,NY,NX)=ZNO3S(L1,NY,NX) + 2+FX*ZNO3S(L0,NY,NX) + ZNO3B(L1,NY,NX)=ZNO3B(L1,NY,NX) + 2+FX*ZNO3B(L0,NY,NX) + ZNO2S(L1,NY,NX)=ZNO2S(L1,NY,NX) + 2+FX*ZNO2S(L0,NY,NX) + ZNO2B(L1,NY,NX)=ZNO2B(L1,NY,NX) + 2+FX*ZNO2B(L0,NY,NX) + ZAL(L1,NY,NX)=ZAL(L1,NY,NX) + 2+FX*ZAL(L0,NY,NX) + ZFE(L1,NY,NX)=ZFE(L1,NY,NX) + 2+FX*ZFE(L0,NY,NX) + ZHY(L1,NY,NX)=ZHY(L1,NY,NX) + 2+FX*ZHY(L0,NY,NX) + ZCA(L1,NY,NX)=ZCA(L1,NY,NX) + 2+FX*ZCA(L0,NY,NX) + ZMG(L1,NY,NX)=ZMG(L1,NY,NX) + 2+FX*ZMG(L0,NY,NX) + ZNA(L1,NY,NX)=ZNA(L1,NY,NX) + 2+FX*ZNA(L0,NY,NX) + ZKA(L1,NY,NX)=ZKA(L1,NY,NX) + 2+FX*ZKA(L0,NY,NX) + ZOH(L1,NY,NX)=ZOH(L1,NY,NX) + 2+FX*ZOH(L0,NY,NX) + ZSO4(L1,NY,NX)=ZSO4(L1,NY,NX) + 2+FX*ZSO4(L0,NY,NX) + ZCL(L1,NY,NX)=ZCL(L1,NY,NX) + 2+FX*ZCL(L0,NY,NX) + ZCO3(L1,NY,NX)=ZCO3(L1,NY,NX) + 2+FX*ZCO3(L0,NY,NX) + ZHCO3(L1,NY,NX)=ZHCO3(L1,NY,NX) + 2+FX*ZHCO3(L0,NY,NX) + ZALOH1(L1,NY,NX)=ZALOH1(L1,NY,NX) + 2+FX*ZALOH1(L0,NY,NX) + ZALOH2(L1,NY,NX)=ZALOH2(L1,NY,NX) + 2+FX*ZALOH2(L0,NY,NX) + ZALOH3(L1,NY,NX)=ZALOH3(L1,NY,NX) + 2+FX*ZALOH3(L0,NY,NX) + ZALOH4(L1,NY,NX)=ZALOH4(L1,NY,NX) + 2+FX*ZALOH4(L0,NY,NX) + ZALS(L1,NY,NX)=ZALS(L1,NY,NX) + 2+FX*ZALS(L0,NY,NX) + ZFEOH1(L1,NY,NX)=ZFEOH1(L1,NY,NX) + 2+FX*ZFEOH1(L0,NY,NX) + ZFEOH2(L1,NY,NX)=ZFEOH2(L1,NY,NX) + 2+FX*ZFEOH2(L0,NY,NX) + ZFEOH3(L1,NY,NX)=ZFEOH3(L1,NY,NX) + 2+FX*ZFEOH3(L0,NY,NX) + ZFEOH4(L1,NY,NX)=ZFEOH4(L1,NY,NX) + 2+FX*ZFEOH4(L0,NY,NX) + ZFES(L1,NY,NX)=ZFES(L1,NY,NX) + 2+FX*ZFES(L0,NY,NX) + ZCAO(L1,NY,NX)=ZCAO(L1,NY,NX) + 2+FX*ZCAO(L0,NY,NX) + ZCAC(L1,NY,NX)=ZCAC(L1,NY,NX) + 2+FX*ZCAC(L0,NY,NX) + ZCAH(L1,NY,NX)=ZCAH(L1,NY,NX) + 2+FX*ZCAH(L0,NY,NX) + ZCAS(L1,NY,NX)=ZCAS(L1,NY,NX) + 2+FX*ZCAS(L0,NY,NX) + ZMGO(L1,NY,NX)=ZMGO(L1,NY,NX) + 2+FX*ZMGO(L0,NY,NX) + ZMGC(L1,NY,NX)=ZMGC(L1,NY,NX) + 2+FX*ZMGC(L0,NY,NX) + ZMGH(L1,NY,NX)=ZMGH(L1,NY,NX) + 2+FX*ZMGH(L0,NY,NX) + ZMGS(L1,NY,NX)=ZMGS(L1,NY,NX) + 2+FX*ZMGS(L0,NY,NX) + ZNAC(L1,NY,NX)=ZNAC(L1,NY,NX) + 2+FX*ZNAC(L0,NY,NX) + ZNAS(L1,NY,NX)=ZNAS(L1,NY,NX) + 2+FX*ZNAS(L0,NY,NX) + ZKAS(L1,NY,NX)=ZKAS(L1,NY,NX) + 2+FX*ZKAS(L0,NY,NX) + H0PO4(L1,NY,NX)=H0PO4(L1,NY,NX) + 2+FX*H0PO4(L0,NY,NX) + H1PO4(L1,NY,NX)=H1PO4(L1,NY,NX) + 2+FX*H1PO4(L0,NY,NX) + H2PO4(L1,NY,NX)=H2PO4(L1,NY,NX) + 2+FX*H2PO4(L0,NY,NX) + H3PO4(L1,NY,NX)=H3PO4(L1,NY,NX) + 2+FX*H3PO4(L0,NY,NX) + ZFE1P(L1,NY,NX)=ZFE1P(L1,NY,NX) + 2+FX*ZFE1P(L0,NY,NX) + ZFE2P(L1,NY,NX)=ZFE2P(L1,NY,NX) + 2+FX*ZFE2P(L0,NY,NX) + ZCA0P(L1,NY,NX)=ZCA0P(L1,NY,NX) + 2+FX*ZCA0P(L0,NY,NX) + ZCA1P(L1,NY,NX)=ZCA1P(L1,NY,NX) + 2+FX*ZCA1P(L0,NY,NX) + ZCA2P(L1,NY,NX)=ZCA2P(L1,NY,NX) + 2+FX*ZCA2P(L0,NY,NX) + ZMG1P(L1,NY,NX)=ZMG1P(L1,NY,NX) + 2+FX*ZMG1P(L0,NY,NX) + H0POB(L1,NY,NX)=H0POB(L1,NY,NX) + 2+FX*H0POB(L0,NY,NX) + H1POB(L1,NY,NX)=H1POB(L1,NY,NX) + 2+FX*H1POB(L0,NY,NX) + H2POB(L1,NY,NX)=H2POB(L1,NY,NX) + 2+FX*H2POB(L0,NY,NX) + H3POB(L1,NY,NX)=H3POB(L1,NY,NX) + 2+FX*H3POB(L0,NY,NX) + ZFE1PB(L1,NY,NX)=ZFE1PB(L1,NY,NX) + 2+FX*ZFE1PB(L0,NY,NX) + ZFE2PB(L1,NY,NX)=ZFE2PB(L1,NY,NX) + 2+FX*ZFE2PB(L0,NY,NX) + ZCA0PB(L1,NY,NX)=ZCA0PB(L1,NY,NX) + 2+FX*ZCA0PB(L0,NY,NX) + ZCA1PB(L1,NY,NX)=ZCA1PB(L1,NY,NX) + 2+FX*ZCA1PB(L0,NY,NX) + ZCA2PB(L1,NY,NX)=ZCA2PB(L1,NY,NX) + 2+FX*ZCA2PB(L0,NY,NX) + ZMG1PB(L1,NY,NX)=ZMG1PB(L1,NY,NX) + 2+FX*ZMG1PB(L0,NY,NX) + XN4(L1,NY,NX)=XN4(L1,NY,NX) + 2+FX*XN4(L0,NY,NX) + XNB(L1,NY,NX)=XNB(L1,NY,NX) + 2+FX*XNB(L0,NY,NX) + XHY(L1,NY,NX)=XHY(L1,NY,NX) + 2+FX*XHY(L0,NY,NX) + XAL(L1,NY,NX)=XAL(L1,NY,NX) + 2+FX*XAL(L0,NY,NX) + XFE(L1,NY,NX)=XFE(L1,NY,NX) + 2+FX*XFE(L0,NY,NX) + XCA(L1,NY,NX)=XCA(L1,NY,NX) + 2+FX*XCA(L0,NY,NX) + XMG(L1,NY,NX)=XMG(L1,NY,NX) + 2+FX*XMG(L0,NY,NX) + XNA(L1,NY,NX)=XNA(L1,NY,NX) + 2+FX*XNA(L0,NY,NX) + XKA(L1,NY,NX)=XKA(L1,NY,NX) + 2+FX*XKA(L0,NY,NX) + XHC(L1,NY,NX)=XHC(L1,NY,NX) + 2+FX*XHC(L0,NY,NX) + XALO2(L1,NY,NX)=XALO2(L1,NY,NX) + 2+FX*XALO2(L0,NY,NX) + XFEO2(L1,NY,NX)=XFEO2(L1,NY,NX) + 2+FX*XFEO2(L0,NY,NX) + XOH0(L1,NY,NX)=XOH0(L1,NY,NX) + 2+FX*XOH0(L0,NY,NX) + XOH1(L1,NY,NX)=XOH1(L1,NY,NX) + 2+FX*XOH1(L0,NY,NX) + XOH2(L1,NY,NX)=XOH2(L1,NY,NX) + 2+FX*XOH2(L0,NY,NX) + XH1P(L1,NY,NX)=XH1P(L1,NY,NX) + 2+FX*XH1P(L0,NY,NX) + XH2P(L1,NY,NX)=XH2P(L1,NY,NX) + 2+FX*XH2P(L0,NY,NX) + XOH0B(L1,NY,NX)=XOH0B(L1,NY,NX) + 2+FX*XOH0B(L0,NY,NX) + XOH1B(L1,NY,NX)=XOH1B(L1,NY,NX) + 2+FX*XOH1B(L0,NY,NX) + XOH2B(L1,NY,NX)=XOH2B(L1,NY,NX) + 2+FX*XOH2B(L0,NY,NX) + XH1PB(L1,NY,NX)=XH1PB(L1,NY,NX) + 2+FX*XH1PB(L0,NY,NX) + XH2PB(L1,NY,NX)=XH2PB(L1,NY,NX) + 2+FX*XH2PB(L0,NY,NX) + PALOH(L1,NY,NX)=PALOH(L1,NY,NX) + 2+FX*PALOH(L0,NY,NX) + PFEOH(L1,NY,NX)=PFEOH(L1,NY,NX) + 2+FX*PFEOH(L0,NY,NX) + PCACO(L1,NY,NX)=PCACO(L1,NY,NX) + 2+FX*PCACO(L0,NY,NX) + PCASO(L1,NY,NX)=PCASO(L1,NY,NX) + 2+FX*PCASO(L0,NY,NX) + PALPO(L1,NY,NX)=PALPO(L1,NY,NX) + 2+FX*PALPO(L0,NY,NX) + PFEPO(L1,NY,NX)=PFEPO(L1,NY,NX) + 2+FX*PFEPO(L0,NY,NX) + PCAPD(L1,NY,NX)=PCAPD(L1,NY,NX) + 2+FX*PCAPD(L0,NY,NX) + PCAPH(L1,NY,NX)=PCAPH(L1,NY,NX) + 2+FX*PCAPH(L0,NY,NX) + PCAPM(L1,NY,NX)=PCAPM(L1,NY,NX) + 2+FX*PCAPM(L0,NY,NX) + PALPB(L1,NY,NX)=PALPB(L1,NY,NX) + 2+FX*PALPB(L0,NY,NX) + PFEPB(L1,NY,NX)=PFEPB(L1,NY,NX) + 2+FX*PFEPB(L0,NY,NX) + PCPDB(L1,NY,NX)=PCPDB(L1,NY,NX) + 2+FX*PCPDB(L0,NY,NX) + PCPHB(L1,NY,NX)=PCPHB(L1,NY,NX) + 2+FX*PCPHB(L0,NY,NX) + PCPMB(L1,NY,NX)=PCPMB(L1,NY,NX) + 2+FX*PCPMB(L0,NY,NX) + CO2G(L1,NY,NX)=CO2G(L1,NY,NX) + 2+FX*CO2G(L0,NY,NX) + CH4G(L1,NY,NX)=CH4G(L1,NY,NX) + 2+FX*CH4G(L0,NY,NX) + CO2S(L1,NY,NX)=CO2S(L1,NY,NX) + 2+FX*CO2S(L0,NY,NX) + CH4S(L1,NY,NX)=CH4S(L1,NY,NX) + 2+FX*CH4S(L0,NY,NX) + OXYG(L1,NY,NX)=OXYG(L1,NY,NX) + 2+FX*OXYG(L0,NY,NX) + OXYS(L1,NY,NX)=OXYS(L1,NY,NX) + 2+FX*OXYS(L0,NY,NX) + Z2GG(L1,NY,NX)=Z2GG(L1,NY,NX) + 2+FX*Z2GG(L0,NY,NX) + Z2GS(L1,NY,NX)=Z2GS(L1,NY,NX) + 2+FX*Z2GS(L0,NY,NX) + Z2OG(L1,NY,NX)=Z2OG(L1,NY,NX) + 2+FX*Z2OG(L0,NY,NX) + Z2OS(L1,NY,NX)=Z2OS(L1,NY,NX) + 2+FX*Z2OS(L0,NY,NX) + ZNH3G(L1,NY,NX)=ZNH3G(L1,NY,NX) + 2+FX*ZNH3G(L0,NY,NX) + H2GG(L1,NY,NX)=H2GG(L1,NY,NX) + 2+FX*H2GG(L0,NY,NX) + H2GS(L1,NY,NX)=H2GS(L1,NY,NX) + 2+FX*H2GS(L0,NY,NX) + ZNH4SH(L1,NY,NX)=ZNH4SH(L1,NY,NX) + 2+FX*ZNH4SH(L0,NY,NX) + ZNH3SH(L1,NY,NX)=ZNH3SH(L1,NY,NX) + 2+FX*ZNH3SH(L0,NY,NX) + ZNO3SH(L1,NY,NX)=ZNO3SH(L1,NY,NX) + 2+FX*ZNO3SH(L0,NY,NX) + ZNO2SH(L1,NY,NX)=ZNO2SH(L1,NY,NX) + 2+FX*ZNO2SH(L0,NY,NX) + H1PO4H(L1,NY,NX)=H1PO4H(L1,NY,NX) + 2+FX*H1PO4H(L0,NY,NX) + H2PO4H(L1,NY,NX)=H2PO4H(L1,NY,NX) + 2+FX*H2PO4H(L0,NY,NX) + ZNH4BH(L1,NY,NX)=ZNH4BH(L1,NY,NX) + 2+FX*ZNH4BH(L0,NY,NX) + ZNH3BH(L1,NY,NX)=ZNH3BH(L1,NY,NX) + 2+FX*ZNH3BH(L0,NY,NX) + ZNO3BH(L1,NY,NX)=ZNO3BH(L1,NY,NX) + 2+FX*ZNO3BH(L0,NY,NX) + ZNO2BH(L1,NY,NX)=ZNO2BH(L1,NY,NX) + 2+FX*ZNO2BH(L0,NY,NX) + H1POBH(L1,NY,NX)=H1POBH(L1,NY,NX) + 2+FX*H1POBH(L0,NY,NX) + H2POBH(L1,NY,NX)=H2POBH(L1,NY,NX) + 2+FX*H2POBH(L0,NY,NX) + ZALH(L1,NY,NX)=ZALH(L1,NY,NX) + 2+FX*ZALH(L0,NY,NX) + ZFEH(L1,NY,NX)=ZFEH(L1,NY,NX) + 2+FX*ZFEH(L0,NY,NX) + ZHYH(L1,NY,NX)=ZHYH(L1,NY,NX) + 2+FX*ZHYH(L0,NY,NX) + ZCCH(L1,NY,NX)=ZCCH(L1,NY,NX) + 2+FX*ZCCH(L0,NY,NX) + ZMAH(L1,NY,NX)=ZMAH(L1,NY,NX) + 2+FX*ZMAH(L0,NY,NX) + ZNAH(L1,NY,NX)=ZNAH(L1,NY,NX) + 2+FX*ZNAH(L0,NY,NX) + ZKAH(L1,NY,NX)=ZKAH(L1,NY,NX) + 2+FX*ZKAH(L0,NY,NX) + ZOHH(L1,NY,NX)=ZOHH(L1,NY,NX) + 2+FX*ZOHH(L0,NY,NX) + ZSO4H(L1,NY,NX)=ZSO4H(L1,NY,NX) + 2+FX*ZSO4H(L0,NY,NX) + ZCLH(L1,NY,NX)=ZCLH(L1,NY,NX) + 2+FX*ZCLH(L0,NY,NX) + ZCO3H(L1,NY,NX)=ZCO3H(L1,NY,NX) + 2+FX*ZCO3H(L0,NY,NX) + ZHCO3H(L1,NY,NX)=ZHCO3H(L1,NY,NX) + 2+FX*ZHCO3H(L0,NY,NX) + ZALO1H(L1,NY,NX)=ZALO1H(L1,NY,NX) + 2+FX*ZALO1H(L0,NY,NX) + ZALO2H(L1,NY,NX)=ZALO2H(L1,NY,NX) + 2+FX*ZALO2H(L0,NY,NX) + ZALO3H(L1,NY,NX)=ZALO3H(L1,NY,NX) + 2+FX*ZALO3H(L0,NY,NX) + ZALO4H(L1,NY,NX)=ZALO4H(L1,NY,NX) + 2+FX*ZALO4H(L0,NY,NX) + ZALSH(L1,NY,NX)=ZALSH(L1,NY,NX) + 2+FX*ZALSH(L0,NY,NX) + ZFEO1H(L1,NY,NX)=ZFEO1H(L1,NY,NX) + 2+FX*ZFEO1H(L0,NY,NX) + ZFEO2H(L1,NY,NX)=ZFEO2H(L1,NY,NX) + 2+FX*ZFEO2H(L0,NY,NX) + ZFEO3H(L1,NY,NX)=ZFEO3H(L1,NY,NX) + 2+FX*ZFEO3H(L0,NY,NX) + ZFEO4H(L1,NY,NX)=ZFEO4H(L1,NY,NX) + 2+FX*ZFEO4H(L0,NY,NX) + ZFESH(L1,NY,NX)=ZFESH(L1,NY,NX) + 2+FX*ZFESH(L0,NY,NX) + ZCAOH(L1,NY,NX)=ZCAOH(L1,NY,NX) + 2+FX*ZCAOH(L0,NY,NX) + ZCACH(L1,NY,NX)=ZCACH(L1,NY,NX) + 2+FX*ZCACH(L0,NY,NX) + ZCAHH(L1,NY,NX)=ZCAHH(L1,NY,NX) + 2+FX*ZCAHH(L0,NY,NX) + ZCASH(L1,NY,NX)=ZCASH(L1,NY,NX) + 2+FX*ZCASH(L0,NY,NX) + ZMGOH(L1,NY,NX)=ZMGOH(L1,NY,NX) + 2+FX*ZMGOH(L0,NY,NX) + ZMGCH(L1,NY,NX)=ZMGCH(L1,NY,NX) + 2+FX*ZMGCH(L0,NY,NX) + ZMGHH(L1,NY,NX)=ZMGHH(L1,NY,NX) + 2+FX*ZMGHH(L0,NY,NX) + ZMGSH(L1,NY,NX)=ZMGSH(L1,NY,NX) + 2+FX*ZMGSH(L0,NY,NX) + ZNACH(L1,NY,NX)=ZNACH(L1,NY,NX) + 2+FX*ZNACH(L0,NY,NX) + ZNASH(L1,NY,NX)=ZNASH(L1,NY,NX) + 2+FX*ZNASH(L0,NY,NX) + ZKASH(L1,NY,NX)=ZKASH(L1,NY,NX) + 2+FX*ZKASH(L0,NY,NX) + H0PO4H(L1,NY,NX)=H0PO4H(L1,NY,NX) + 2+FX*H0PO4H(L0,NY,NX) + H1PO4H(L1,NY,NX)=H1PO4H(L1,NY,NX) + 2+FX*H1PO4H(L0,NY,NX) + H3PO4H(L1,NY,NX)=H3PO4H(L1,NY,NX) + 2+FX*H3PO4H(L0,NY,NX) + ZFE1PH(L1,NY,NX)=ZFE1PH(L1,NY,NX) + 2+FX*ZFE1PH(L0,NY,NX) + ZFE2PH(L1,NY,NX)=ZFE2PH(L1,NY,NX) + 2+FX*ZFE2PH(L0,NY,NX) + ZCA0PH(L1,NY,NX)=ZCA0PH(L1,NY,NX) + 2+FX*ZCA0PH(L0,NY,NX) + ZCA1PH(L1,NY,NX)=ZCA1PH(L1,NY,NX) + 2+FX*ZCA1PH(L0,NY,NX) + ZCA2PH(L1,NY,NX)=ZCA2PH(L1,NY,NX) + 2+FX*ZCA2PH(L0,NY,NX) + ZMG1PH(L1,NY,NX)=ZMG1PH(L1,NY,NX) + 2+FX*ZMG1PH(L0,NY,NX) + H0POBH(L1,NY,NX)=H0POBH(L1,NY,NX) + 2+FX*H0POBH(L0,NY,NX) + H1POBH(L1,NY,NX)=H1POBH(L1,NY,NX) + 2+FX*H1POBH(L0,NY,NX) + H3POBH(L1,NY,NX)=H3POBH(L1,NY,NX) + 2+FX*H3POBH(L0,NY,NX) + ZFE1BH(L1,NY,NX)=ZFE1BH(L1,NY,NX) + 2+FX*ZFE1BH(L0,NY,NX) + ZFE2BH(L1,NY,NX)=ZFE2BH(L1,NY,NX) + 2+FX*ZFE2BH(L0,NY,NX) + ZCA0BH(L1,NY,NX)=ZCA0BH(L1,NY,NX) + 2+FX*ZCA0BH(L0,NY,NX) + ZCA1BH(L1,NY,NX)=ZCA1BH(L1,NY,NX) + 2+FX*ZCA1BH(L0,NY,NX) + ZCA2BH(L1,NY,NX)=ZCA2BH(L1,NY,NX) + 2+FX*ZCA2BH(L0,NY,NX) + ZMG1BH(L1,NY,NX)=ZMG1BH(L1,NY,NX) + 2+FX*ZMG1BH(L0,NY,NX) + CO2SH(L1,NY,NX)=CO2SH(L1,NY,NX) + 2+FX*CO2SH(L0,NY,NX) + CH4SH(L1,NY,NX)=CH4SH(L1,NY,NX) + 2+FX*CH4SH(L0,NY,NX) + OXYSH(L1,NY,NX)=OXYSH(L1,NY,NX) + 2+FX*OXYSH(L0,NY,NX) + Z2GSH(L1,NY,NX)=Z2GSH(L1,NY,NX) + 2+FX*Z2GSH(L0,NY,NX) + Z2OSH(L1,NY,NX)=Z2OSH(L1,NY,NX) + 2+FX*Z2OSH(L0,NY,NX) + ORGC(L1,NY,NX)=ORGC(L1,NY,NX) + 2+FX*ORGC(L0,NY,NX) + ORGN(L1,NY,NX)=ORGN(L1,NY,NX) + 2+FX*ORGN(L0,NY,NX) + DO 7965 K=0,5 + DO 7965 N=1,7 + DO 7965 M=1,3 + OMC(M,N,K,L1,NY,NX)=OMC(M,N,K,L1,NY,NX) + 2+FX*OMC(M,N,K,L0,NY,NX) + OMN(M,N,K,L1,NY,NX)=OMN(M,N,K,L1,NY,NX) + 2+FX*OMN(M,N,K,L0,NY,NX) + OMP(M,N,K,L1,NY,NX)=OMP(M,N,K,L1,NY,NX) + 2+FX*OMP(M,N,K,L0,NY,NX) +7965 CONTINUE + DO 7780 K=0,4 + DO 7775 M=1,2 + ORC(M,K,L1,NY,NX)=ORC(M,K,L1,NY,NX) + 2+FX*ORC(M,K,L0,NY,NX) + ORN(M,K,L1,NY,NX)=ORN(M,K,L1,NY,NX) + 2+FX*ORN(M,K,L0,NY,NX) + ORP(M,K,L1,NY,NX)=ORP(M,K,L1,NY,NX) + 2+FX*ORP(M,K,L0,NY,NX) +7775 CONTINUE + OQC(K,L1,NY,NX)=OQC(K,L1,NY,NX) + 2+FX*OQC(K,L0,NY,NX) + OQN(K,L1,NY,NX)=OQN(K,L1,NY,NX) + 2+FX*OQN(K,L0,NY,NX) + OQP(K,L1,NY,NX)=OQP(K,L1,NY,NX) + 2+FX*OQP(K,L0,NY,NX) + OQA(K,L1,NY,NX)=OQA(K,L1,NY,NX) + 2+FX*OQA(K,L0,NY,NX) + OQCH(K,L1,NY,NX)=OQCH(K,L1,NY,NX) + 2+FX*OQCH(K,L0,NY,NX) + OQNH(K,L1,NY,NX)=OQNH(K,L1,NY,NX) + 2+FX*OQNH(K,L0,NY,NX) + OQPH(K,L1,NY,NX)=OQPH(K,L1,NY,NX) + 2+FX*OQPH(K,L0,NY,NX) + OQAH(K,L1,NY,NX)=OQAH(K,L1,NY,NX) + 2+FX*OQAH(K,L0,NY,NX) + OHC(K,L1,NY,NX)=OHC(K,L1,NY,NX) + 2+FX*OHC(K,L0,NY,NX) + OHN(K,L1,NY,NX)=OHN(K,L1,NY,NX) + 2+FX*OHN(K,L0,NY,NX) + OHP(K,L1,NY,NX)=OHP(K,L1,NY,NX) + 2+FX*OHP(K,L0,NY,NX) + OHA(K,L1,NY,NX)=OHA(K,L1,NY,NX) + 2+FX*OHA(K,L0,NY,NX) + DO 7770 M=1,4 + OSC(M,K,L1,NY,NX)=OSC(M,K,L1,NY,NX) + 2+FX*OSC(M,K,L0,NY,NX) + OSA(M,K,L1,NY,NX)=OSA(M,K,L1,NY,NX) + 2+FX*OSA(M,K,L0,NY,NX) + OSN(M,K,L1,NY,NX)=OSN(M,K,L1,NY,NX) + 2+FX*OSN(M,K,L0,NY,NX) + OSP(M,K,L1,NY,NX)=OSP(M,K,L1,NY,NX) + 2+FX*OSP(M,K,L0,NY,NX) +7770 CONTINUE +7780 CONTINUE + CDPTH(L0,NY,NX)=CDPTH(L0,NY,NX) + 2-FX*DLYR(3,L0,NY,NX) + DLYR(3,L0,NY,NX)=FY*DLYR(3,L0,NY,NX) + VOLX(L0,NY,NX)=FY*VOLX(L0,NY,NX) + BKVL(L0,NY,NX)=FY*BKVL(L0,NY,NX) + SAND(L0,NY,NX)=FY*SAND(L0,NY,NX) + SILT(L0,NY,NX)=FY*SILT(L0,NY,NX) + CLAY(L0,NY,NX)=FY*CLAY(L0,NY,NX) + XCEC(L0,NY,NX)=FY*XCEC(L0,NY,NX) + XAEC(L0,NY,NX)=FY*XAEC(L0,NY,NX) + VOLW(L0,NY,NX)=FY*VOLW(L0,NY,NX) + VOLI(L0,NY,NX)=FY*VOLI(L0,NY,NX) + VOLP(L0,NY,NX)=FY*VOLP(L0,NY,NX) + VOLA(L0,NY,NX)=FY*VOLA(L0,NY,NX) + VOLWX(L0,NY,NX)=FY*VOLWX(L0,NY,NX) + VOLWH(L0,NY,NX)=FY*VOLWH(L0,NY,NX) + VOLIH(L0,NY,NX)=FY*VOLIH(L0,NY,NX) + VOLAH(L0,NY,NX)=FY*VOLAH(L0,NY,NX) + VHCM(L0,NY,NX)=FY*VHCM(L0,NY,NX) + VHCP(L0,NY,NX)=FY*VHCP(L0,NY,NX) + VHCP(L0,NY,NX)=VHCM(L0,NY,NX) + 2+4.19*(VOLW(L0,NY,NX)+VOLWH(L0,NY,NX)) + 3+1.9274*(VOLI(L0,NY,NX)+VOLIH(L0,NY,NX)) + ZNH4FA(L0,NY,NX)=FY*ZNH4FA(L0,NY,NX) + ZNH3FA(L0,NY,NX)=FY*ZNH3FA(L0,NY,NX) + ZNHUFA(L0,NY,NX)=FY*ZNHUFA(L0,NY,NX) + ZNO3FA(L0,NY,NX)=FY*ZNO3FA(L0,NY,NX) + ZNH4FB(L0,NY,NX)=FY*ZNH4FB(L0,NY,NX) + ZNH3FB(L0,NY,NX)=FY*ZNH3FB(L0,NY,NX) + ZNHUFB(L0,NY,NX)=FY*ZNHUFB(L0,NY,NX) + ZNO3FB(L0,NY,NX)=FY*ZNO3FB(L0,NY,NX) + ZNH4S(L0,NY,NX)=FY*ZNH4S(L0,NY,NX) + ZNH4B(L0,NY,NX)=FY*ZNH4B(L0,NY,NX) + ZNH3S(L0,NY,NX)=FY*ZNH3S(L0,NY,NX) + ZNH3B(L0,NY,NX)=FY*ZNH3B(L0,NY,NX) + ZNO3S(L0,NY,NX)=FY*ZNO3S(L0,NY,NX) + ZNO3B(L0,NY,NX)=FY*ZNO3B(L0,NY,NX) + ZNO2S(L0,NY,NX)=FY*ZNO2S(L0,NY,NX) + ZNO2B(L0,NY,NX)=FY*ZNO2B(L0,NY,NX) + ZAL(L0,NY,NX)=FY*ZAL(L0,NY,NX) + ZFE(L0,NY,NX)=FY*ZFE(L0,NY,NX) + ZHY(L0,NY,NX)=FY*ZHY(L0,NY,NX) + ZCA(L0,NY,NX)=FY*ZCA(L0,NY,NX) + ZMG(L0,NY,NX)=FY*ZMG(L0,NY,NX) + ZNA(L0,NY,NX)=FY*ZNA(L0,NY,NX) + ZKA(L0,NY,NX)=FY*ZKA(L0,NY,NX) + ZOH(L0,NY,NX)=FY*ZOH(L0,NY,NX) + ZSO4(L0,NY,NX)=FY*ZSO4(L0,NY,NX) + ZCL(L0,NY,NX)=FY*ZCL(L0,NY,NX) + ZCO3(L0,NY,NX)=FY*ZCO3(L0,NY,NX) + ZHCO3(L0,NY,NX)=FY*ZHCO3(L0,NY,NX) + ZALOH1(L0,NY,NX)=FY*ZALOH1(L0,NY,NX) + ZALOH2(L0,NY,NX)=FY*ZALOH2(L0,NY,NX) + ZALOH3(L0,NY,NX)=FY*ZALOH3(L0,NY,NX) + ZALOH4(L0,NY,NX)=FY*ZALOH4(L0,NY,NX) + ZALS(L0,NY,NX)=FY*ZALS(L0,NY,NX) + ZFEOH1(L0,NY,NX)=FY*ZFEOH1(L0,NY,NX) + ZFEOH2(L0,NY,NX)=FY*ZFEOH2(L0,NY,NX) + ZFEOH3(L0,NY,NX)=FY*ZFEOH3(L0,NY,NX) + ZFEOH4(L0,NY,NX)=FY*ZFEOH4(L0,NY,NX) + ZFES(L0,NY,NX)=FY*ZFES(L0,NY,NX) + ZCAO(L0,NY,NX)=FY*ZCAO(L0,NY,NX) + ZCAC(L0,NY,NX)=FY*ZCAC(L0,NY,NX) + ZCAH(L0,NY,NX)=FY*ZCAH(L0,NY,NX) + ZCAS(L0,NY,NX)=FY*ZCAS(L0,NY,NX) + ZMGO(L0,NY,NX)=FY*ZMGO(L0,NY,NX) + ZMGC(L0,NY,NX)=FY*ZMGC(L0,NY,NX) + ZMGH(L0,NY,NX)=FY*ZMGH(L0,NY,NX) + ZMGS(L0,NY,NX)=FY*ZMGS(L0,NY,NX) + ZNAC(L0,NY,NX)=FY*ZNAC(L0,NY,NX) + ZNAS(L0,NY,NX)=FY*ZNAS(L0,NY,NX) + ZKAS(L0,NY,NX)=FY*ZKAS(L0,NY,NX) + H0PO4(L0,NY,NX)=FY*H0PO4(L0,NY,NX) + H1PO4(L0,NY,NX)=FY*H1PO4(L0,NY,NX) + H2PO4(L0,NY,NX)=FY*H2PO4(L0,NY,NX) + H3PO4(L0,NY,NX)=FY*H3PO4(L0,NY,NX) + ZFE1P(L0,NY,NX)=FY*ZFE1P(L0,NY,NX) + ZFE2P(L0,NY,NX)=FY*ZFE2P(L0,NY,NX) + ZCA0P(L0,NY,NX)=FY*ZCA0P(L0,NY,NX) + ZCA1P(L0,NY,NX)=FY*ZCA1P(L0,NY,NX) + ZCA2P(L0,NY,NX)=FY*ZCA2P(L0,NY,NX) + ZMG1P(L0,NY,NX)=FY*ZMG1P(L0,NY,NX) + H0POB(L0,NY,NX)=FY*H0POB(L0,NY,NX) + H1POB(L0,NY,NX)=FY*H1POB(L0,NY,NX) + H2POB(L0,NY,NX)=FY*H2POB(L0,NY,NX) + H3POB(L0,NY,NX)=FY*H3POB(L0,NY,NX) + ZFE1PB(L0,NY,NX)=FY*ZFE1PB(L0,NY,NX) + ZFE2PB(L0,NY,NX)=FY*ZFE2PB(L0,NY,NX) + ZCA0PB(L0,NY,NX)=FY*ZCA0PB(L0,NY,NX) + ZCA1PB(L0,NY,NX)=FY*ZCA1PB(L0,NY,NX) + ZCA2PB(L0,NY,NX)=FY*ZCA2PB(L0,NY,NX) + ZMG1PB(L0,NY,NX)=FY*ZMG1PB(L0,NY,NX) + XN4(L0,NY,NX)=FY*XN4(L0,NY,NX) + XNB(L0,NY,NX)=FY*XNB(L0,NY,NX) + XHY(L0,NY,NX)=FY*XHY(L0,NY,NX) + XAL(L0,NY,NX)=FY*XAL(L0,NY,NX) + XFE(L0,NY,NX)=FY*XFE(L0,NY,NX) + XCA(L0,NY,NX)=FY*XCA(L0,NY,NX) + XMG(L0,NY,NX)=FY*XMG(L0,NY,NX) + XNA(L0,NY,NX)=FY*XNA(L0,NY,NX) + XKA(L0,NY,NX)=FY*XKA(L0,NY,NX) + XHC(L0,NY,NX)=FY*XHC(L0,NY,NX) + XALO2(L0,NY,NX)=FY*XALO2(L0,NY,NX) + XFEO2(L0,NY,NX)=FY*XFEO2(L0,NY,NX) + XOH0(L0,NY,NX)=FY*XOH0(L0,NY,NX) + XOH1(L0,NY,NX)=FY*XOH1(L0,NY,NX) + XOH2(L0,NY,NX)=FY*XOH2(L0,NY,NX) + XH1P(L0,NY,NX)=FY*XH1P(L0,NY,NX) + XH2P(L0,NY,NX)=FY*XH2P(L0,NY,NX) + XOH0B(L0,NY,NX)=FY*XOH0B(L0,NY,NX) + XOH1B(L0,NY,NX)=FY*XOH1B(L0,NY,NX) + XOH2B(L0,NY,NX)=FY*XOH2B(L0,NY,NX) + XH1PB(L0,NY,NX)=FY*XH1PB(L0,NY,NX) + XH2PB(L0,NY,NX)=FY*XH2PB(L0,NY,NX) + PALOH(L0,NY,NX)=FY*PALOH(L0,NY,NX) + PFEOH(L0,NY,NX)=FY*PFEOH(L0,NY,NX) + PCACO(L0,NY,NX)=FY*PCACO(L0,NY,NX) + PCASO(L0,NY,NX)=FY*PCASO(L0,NY,NX) + PALPO(L0,NY,NX)=FY*PALPO(L0,NY,NX) + PFEPO(L0,NY,NX)=FY*PFEPO(L0,NY,NX) + PCAPD(L0,NY,NX)=FY*PCAPD(L0,NY,NX) + PCAPH(L0,NY,NX)=FY*PCAPH(L0,NY,NX) + PCAPM(L0,NY,NX)=FY*PCAPM(L0,NY,NX) + PALPB(L0,NY,NX)=FY*PALPB(L0,NY,NX) + PFEPB(L0,NY,NX)=FY*PFEPB(L0,NY,NX) + PCPDB(L0,NY,NX)=FY*PCPDB(L0,NY,NX) + PCPHB(L0,NY,NX)=FY*PCPHB(L0,NY,NX) + PCPMB(L0,NY,NX)=FY*PCPMB(L0,NY,NX) + CO2G(L0,NY,NX)=FY*CO2G(L0,NY,NX) + CH4G(L0,NY,NX)=FY*CH4G(L0,NY,NX) + CO2S(L0,NY,NX)=FY*CO2S(L0,NY,NX) + CH4S(L0,NY,NX)=FY*CH4S(L0,NY,NX) + OXYG(L0,NY,NX)=FY*OXYG(L0,NY,NX) + OXYS(L0,NY,NX)=FY*OXYS(L0,NY,NX) + Z2GG(L0,NY,NX)=FY*Z2GG(L0,NY,NX) + Z2GS(L0,NY,NX)=FY*Z2GS(L0,NY,NX) + Z2OG(L0,NY,NX)=FY*Z2OG(L0,NY,NX) + Z2OS(L0,NY,NX)=FY*Z2OS(L0,NY,NX) + ZNH3G(L0,NY,NX)=FY*ZNH3G(L0,NY,NX) + H2GG(L0,NY,NX)=FY*H2GG(L0,NY,NX) + H2GS(L0,NY,NX)=FY*H2GS(L0,NY,NX) + ZNH4SH(L0,NY,NX)=FY*ZNH4SH(L0,NY,NX) + ZNH3SH(L0,NY,NX)=FY*ZNH3SH(L0,NY,NX) + ZNO3SH(L0,NY,NX)=FY*ZNO3SH(L0,NY,NX) + ZNO2SH(L0,NY,NX)=FY*ZNO2SH(L0,NY,NX) + H1PO4H(L0,NY,NX)=FY*H1PO4H(L0,NY,NX) + H2PO4H(L0,NY,NX)=FY*H2PO4H(L0,NY,NX) + ZNH4BH(L0,NY,NX)=FY*ZNH4BH(L0,NY,NX) + ZNH3BH(L0,NY,NX)=FY*ZNH3BH(L0,NY,NX) + ZNO3BH(L0,NY,NX)=FY*ZNO3BH(L0,NY,NX) + ZNO2BH(L0,NY,NX)=FY*ZNO2BH(L0,NY,NX) + H1POBH(L0,NY,NX)=FY*H1POBH(L0,NY,NX) + H2POBH(L0,NY,NX)=FY*H2POBH(L0,NY,NX) + ZALH(L0,NY,NX)=FY*ZALH(L0,NY,NX) + ZFEH(L0,NY,NX)=FY*ZFEH(L0,NY,NX) + ZHYH(L0,NY,NX)=FY*ZHYH(L0,NY,NX) + ZCCH(L0,NY,NX)=FY*ZCCH(L0,NY,NX) + ZMAH(L0,NY,NX)=FY*ZMAH(L0,NY,NX) + ZNAH(L0,NY,NX)=FY*ZNAH(L0,NY,NX) + ZKAH(L0,NY,NX)=FY*ZKAH(L0,NY,NX) + ZOHH(L0,NY,NX)=FY*ZOHH(L0,NY,NX) + ZSO4H(L0,NY,NX)=FY*ZSO4H(L0,NY,NX) + ZCLH(L0,NY,NX)=FY*ZCLH(L0,NY,NX) + ZCO3H(L0,NY,NX)=FY*ZCO3H(L0,NY,NX) + ZHCO3H(L0,NY,NX)=FY*ZHCO3H(L0,NY,NX) + ZALO1H(L0,NY,NX)=FY*ZALO1H(L0,NY,NX) + ZALO2H(L0,NY,NX)=FY*ZALO2H(L0,NY,NX) + ZALO3H(L0,NY,NX)=FY*ZALO3H(L0,NY,NX) + ZALO4H(L0,NY,NX)=FY*ZALO4H(L0,NY,NX) + ZALSH(L0,NY,NX)=FY*ZALSH(L0,NY,NX) + ZFEO1H(L0,NY,NX)=FY*ZFEO1H(L0,NY,NX) + ZFEO2H(L0,NY,NX)=FY*ZFEO2H(L0,NY,NX) + ZFEO3H(L0,NY,NX)=FY*ZFEO3H(L0,NY,NX) + ZFEO4H(L0,NY,NX)=FY*ZFEO4H(L0,NY,NX) + ZFESH(L0,NY,NX)=FY*ZFESH(L0,NY,NX) + ZCAOH(L0,NY,NX)=FY*ZCAOH(L0,NY,NX) + ZCACH(L0,NY,NX)=FY*ZCACH(L0,NY,NX) + ZCAHH(L0,NY,NX)=FY*ZCAHH(L0,NY,NX) + ZCASH(L0,NY,NX)=FY*ZCASH(L0,NY,NX) + ZMGOH(L0,NY,NX)=FY*ZMGOH(L0,NY,NX) + ZMGCH(L0,NY,NX)=FY*ZMGCH(L0,NY,NX) + ZMGHH(L0,NY,NX)=FY*ZMGHH(L0,NY,NX) + ZMGSH(L0,NY,NX)=FY*ZMGSH(L0,NY,NX) + ZNACH(L0,NY,NX)=FY*ZNACH(L0,NY,NX) + ZNASH(L0,NY,NX)=FY*ZNASH(L0,NY,NX) + ZKASH(L0,NY,NX)=FY*ZKASH(L0,NY,NX) + H0PO4H(L0,NY,NX)=FY*H0PO4H(L0,NY,NX) + H1PO4H(L0,NY,NX)=FY*H1PO4H(L0,NY,NX) + H3PO4H(L0,NY,NX)=FY*H3PO4H(L0,NY,NX) + ZFE1PH(L0,NY,NX)=FY*ZFE1PH(L0,NY,NX) + ZFE2PH(L0,NY,NX)=FY*ZFE2PH(L0,NY,NX) + ZCA0PH(L0,NY,NX)=FY*ZCA0PH(L0,NY,NX) + ZCA1PH(L0,NY,NX)=FY*ZCA1PH(L0,NY,NX) + ZCA2PH(L0,NY,NX)=FY*ZCA2PH(L0,NY,NX) + ZMG1PH(L0,NY,NX)=FY*ZMG1PH(L0,NY,NX) + H0POBH(L0,NY,NX)=FY*H0POBH(L0,NY,NX) + H1POBH(L0,NY,NX)=FY*H1POBH(L0,NY,NX) + H3POBH(L0,NY,NX)=FY*H3POBH(L0,NY,NX) + ZFE1BH(L0,NY,NX)=FY*ZFE1BH(L0,NY,NX) + ZFE2BH(L0,NY,NX)=FY*ZFE2BH(L0,NY,NX) + ZCA0BH(L0,NY,NX)=FY*ZCA0BH(L0,NY,NX) + ZCA1BH(L0,NY,NX)=FY*ZCA1BH(L0,NY,NX) + ZCA2BH(L0,NY,NX)=FY*ZCA2BH(L0,NY,NX) + ZMG1BH(L0,NY,NX)=FY*ZMG1BH(L0,NY,NX) + CO2SH(L0,NY,NX)=FY*CO2SH(L0,NY,NX) + CH4SH(L0,NY,NX)=FY*CH4SH(L0,NY,NX) + OXYSH(L0,NY,NX)=FY*OXYSH(L0,NY,NX) + Z2GSH(L0,NY,NX)=FY*Z2GSH(L0,NY,NX) + Z2OSH(L0,NY,NX)=FY*Z2OSH(L0,NY,NX) + ORGC(L0,NY,NX)=FY*ORGC(L0,NY,NX) + ORGN(L0,NY,NX)=FY*ORGN(L0,NY,NX) + DO 7865 K=0,5 + DO 7865 N=1,7 + DO 7865 M=1,3 + OMC(M,N,K,L0,NY,NX)=FY*OMC(M,N,K,L0,NY,NX) + OMN(M,N,K,L0,NY,NX)=FY*OMN(M,N,K,L0,NY,NX) + OMP(M,N,K,L0,NY,NX)=FY*OMP(M,N,K,L0,NY,NX) +7865 CONTINUE + DO 7880 K=0,4 + DO 7875 M=1,2 + ORC(M,K,L0,NY,NX)=FY*ORC(M,K,L0,NY,NX) + ORN(M,K,L0,NY,NX)=FY*ORN(M,K,L0,NY,NX) + ORP(M,K,L0,NY,NX)=FY*ORP(M,K,L0,NY,NX) +7875 CONTINUE + OQC(K,L0,NY,NX)=FY*OQC(K,L0,NY,NX) + OQN(K,L0,NY,NX)=FY*OQN(K,L0,NY,NX) + OQP(K,L0,NY,NX)=FY*OQP(K,L0,NY,NX) + OQA(K,L0,NY,NX)=FY*OQA(K,L0,NY,NX) + OQCH(K,L0,NY,NX)=FY*OQCH(K,L0,NY,NX) + OQNH(K,L0,NY,NX)=FY*OQNH(K,L0,NY,NX) + OQPH(K,L0,NY,NX)=FY*OQPH(K,L0,NY,NX) + OQAH(K,L0,NY,NX)=FY*OQAH(K,L0,NY,NX) + OHC(K,L0,NY,NX)=FY*OHC(K,L0,NY,NX) + OHN(K,L0,NY,NX)=FY*OHN(K,L0,NY,NX) + OHP(K,L0,NY,NX)=FY*OHP(K,L0,NY,NX) + OHA(K,L0,NY,NX)=FY*OHA(K,L0,NY,NX) + DO 7870 M=1,4 + OSC(M,K,L0,NY,NX)=FY*OSC(M,K,L0,NY,NX) + OSA(M,K,L0,NY,NX)=FY*OSA(M,K,L0,NY,NX) + OSN(M,K,L0,NY,NX)=FY*OSN(M,K,L0,NY,NX) + OSP(M,K,L0,NY,NX)=FY*OSP(M,K,L0,NY,NX) +7870 CONTINUE +7880 CONTINUE + IF(FY.EQ.0.0)THEN + CCO2S(L0,NY,NX)=9999 + CCH4S(L0,NY,NX)=9999 + COXYS(L0,NY,NX)=9999 + THETW(L0,NY,NX)=9999 + THETI(L0,NY,NX)=9999 + PSISM(L0,NY,NX)=9999 + CZ2OS(L0,NY,NX)=9999 + CNH3S(L0,NY,NX)=9999 + TCS(L0,NY,NX)=9999 + ENDIF + IFLGS(NY,NX)=1 + WRITE(*,5599)'ERODE2',I,J,NX,NY,L0,L1,NU(NY,NX),DNUMN,DNUMX + 2,DLYR(3,L0,NY,NX),DLYR(3,L1,NY,NX),FX + ENDIF + ENDIF +C +C RESIDUE REMOVAL IF FIRE OR REMOVAL EVENT IS ENTERED IN DISTURBANCE FILE +C + IF(J.EQ.INT(ZNOON(NY,NX)).AND.(ITILL(I,NY,NX).EQ.21 + 2.OR.ITILL(I,NY,NX).EQ.22))THEN + IF(ITILL(I,NY,NX).EQ.22)THEN + IFLGQ=0 + NLL=-1 + DO 2945 L=0,NL(NY,NX) +C WRITE(*,9494)'FIRE',I,J,L,IFLGQ,NLL,THETW(L,NY,NX) +9494 FORMAT(A8,5I6,12E12.4) + IF(L.EQ.0.OR.L.GE.NU(NY,NX))THEN + IF(IFLGQ.EQ.1)THEN + GO TO 2946 + ELSEIF(THETW(L,NY,NX).GT.FVLWB.OR.CORGC(L,NY,NX).LE.FORGC + 2.OR.DPTH(L,NY,NX).GT.0.15)THEN + IFLGQ=1 + ELSE + NLL=L + ENDIF + ENDIF +2945 CONTINUE + ELSE + NLL=0 + ENDIF +2946 CONTINUE + DO 2950 L=0,NLL + IF(NLL.GE.0)THEN + IF(ITILL(I,NY,NX).EQ.22)THEN + DCORPC=AMIN1(0.999,DCORP(I,NY,NX))*(CORGC(L,NY,NX)-FORGC) + 2/(AMAX1(CORGC(L,NY,NX),0.5E+06)-FORGC) + ELSE + DCORPC=AMIN1(0.999,DCORP(I,NY,NX)) + ENDIF + VOLWOU=VOLWOU+DCORPC*VOLW(L,NY,NX) + HEATOU=HEATOU+DCORPC*4.19*TKS(L,NY,NX)*VOLW(L,NY,NX) + VOLW(L,NY,NX)=VOLW(L,NY,NX)-DCORPC*VOLW(L,NY,NX) +C WRITE(*,9696)'BURN',I,J,L,NLL,CORGC(L,NY,NX) +C 2,FORGC,DCORPC,DCORP(I,NY,NX),VOLW(L,NY,NX) +9696 FORMAT(A8,4I6,12E12.4) + OSGX=ORGC(L,NY,NX) + OC=0.0 + ON=0.0 + OP=0.0 + RC=0.0 + RN=0.0 + RP=0.0 + DO 2955 K=0,4 + DO 2955 M=1,4 + ONL(M,K)=0.0 + OPL(M,K)=0.0 +2955 CONTINUE + DO 2970 K=0,5 + IF(L.NE.0.OR.(K.NE.3.AND.K.NE.4))THEN +C +C REMOVE MICROBIAL BIOMASS +C + DO 2960 N=1,7 + DO 2960 M=1,3 + OCH=DCORPC*OMC(M,N,K,L,NY,NX) + ONH=DCORPC*OMN(M,N,K,L,NY,NX) + OPH=DCORPC*OMP(M,N,K,L,NY,NX) + ONX=EFIRE(1,ITILL(I,NY,NX))*ONH + OPX=EFIRE(2,ITILL(I,NY,NX))*OPH + IF(K.LE.2)THEN + ONL(4,K)=ONL(4,K)+ONH-ONX + OPL(4,K)=OPL(4,K)+OPH-OPX + ELSEIF(K.LE.4)THEN + ONL(1,K)=ONL(1,K)+ONH-ONX + OPL(1,K)=OPL(1,K)+OPH-OPX + ELSEIF(K.EQ.5)THEN + ONL(4,1)=ONL(4,1)+ONH-ONX + OPL(4,1)=OPL(4,1)+OPH-OPX + ENDIF + OMC(M,N,K,L,NY,NX)=OMC(M,N,K,L,NY,NX)-OCH + OMN(M,N,K,L,NY,NX)=OMN(M,N,K,L,NY,NX)-ONH + OMP(M,N,K,L,NY,NX)=OMP(M,N,K,L,NY,NX)-OPH + RC=RC+OMC(M,N,K,L,NY,NX) + RN=RN+OMN(M,N,K,L,NY,NX) + RP=RP+OMP(M,N,K,L,NY,NX) + TOMT(NY,NX)=TOMT(NY,NX)+OMC(M,N,K,L,NY,NX) + TONT(NY,NX)=TONT(NY,NX)+OMN(M,N,K,L,NY,NX) + TOPT(NY,NX)=TOPT(NY,NX)+OMP(M,N,K,L,NY,NX) + OMCL(L,NY,NX)=OMCL(L,NY,NX)+OMC(M,N,K,L,NY,NX) + OMNL(L,NY,NX)=OMNL(L,NY,NX)+OMN(M,N,K,L,NY,NX) + OC=OC+OCH + ON=ON+ONX + OP=OP+OPX +2960 CONTINUE + ENDIF +2970 CONTINUE +C +C REMOVE MICROBIAL RESIDUE +C + DO 2900 K=0,4 + IF(L.NE.0.OR.(K.NE.3.AND.K.NE.4))THEN + DO 2940 M=1,2 + OCH=DCORPC*ORC(M,K,L,NY,NX) + ONH=DCORPC*ORN(M,K,L,NY,NX) + OPH=DCORPC*ORP(M,K,L,NY,NX) + ONX=EFIRE(1,ITILL(I,NY,NX))*ONH + OPX=EFIRE(2,ITILL(I,NY,NX))*OPH + IF(K.LE.2)THEN + ONL(4,K)=ONL(4,K)+ONH-ONX + OPL(4,K)=OPL(4,K)+OPH-OPX + ELSE + ONL(1,K)=ONL(1,K)+ONH-ONX + OPL(1,K)=OPL(1,K)+OPH-OPX + ENDIF + ORC(M,K,L,NY,NX)=ORC(M,K,L,NY,NX)-OCH + ORN(M,K,L,NY,NX)=ORN(M,K,L,NY,NX)-ONH + ORP(M,K,L,NY,NX)=ORP(M,K,L,NY,NX)-OPH + RC=RC+ORC(M,K,L,NY,NX) + RN=RN+ORN(M,K,L,NY,NX) + RP=RP+ORP(M,K,L,NY,NX) + OC=OC+OCH + ON=ON+ONX + OP=OP+OPX +2940 CONTINUE +C +C REMOVE DOC, DON, DOP +C + OCH=DCORPC*OQC(K,L,NY,NX) + OCA=DCORPC*OQA(K,L,NY,NX) + ONH=DCORPC*OQN(K,L,NY,NX) + OPH=DCORPC*OQP(K,L,NY,NX) + ONX=EFIRE(1,ITILL(I,NY,NX))*ONH + OPX=EFIRE(2,ITILL(I,NY,NX))*OPH + IF(K.LE.2)THEN + ONL(4,K)=ONL(4,K)+ONH-ONX + OPL(4,K)=OPL(4,K)+OPH-OPX + ELSE + ONL(1,K)=ONL(1,K)+ONH-ONX + OPL(1,K)=OPL(1,K)+OPH-OPX + ENDIF + OQC(K,L,NY,NX)=OQC(K,L,NY,NX)-OCH + OQA(K,L,NY,NX)=OQA(K,L,NY,NX)-OCA + OQN(K,L,NY,NX)=OQN(K,L,NY,NX)-ONH + OQP(K,L,NY,NX)=OQP(K,L,NY,NX)-OPH + OC=OC+OCH+OCA + ON=ON+ONX + OP=OP+OPX + OCH=DCORPC*OQCH(K,L,NY,NX) + ONH=DCORPC*OQNH(K,L,NY,NX) + OPH=DCORPC*OQPH(K,L,NY,NX) + OAH=DCORPC*OQAH(K,L,NY,NX) + ONX=EFIRE(1,ITILL(I,NY,NX))*ONH + OPX=EFIRE(2,ITILL(I,NY,NX))*OPH + IF(K.LE.2)THEN + ONL(4,K)=ONL(4,K)+ONH-ONX + OPL(4,K)=OPL(4,K)+OPH-OPX + ELSE + ONL(1,K)=ONL(1,K)+ONH-ONX + OPL(1,K)=OPL(1,K)+OPH-OPX + ENDIF + OQCH(K,L,NY,NX)=OQCH(K,L,NY,NX)-OCH + OQNH(K,L,NY,NX)=OQNH(K,L,NY,NX)-ONH + OQPH(K,L,NY,NX)=OQPH(K,L,NY,NX)-OPH + OQAH(K,L,NY,NX)=OQAH(K,L,NY,NX)-OAH + OC=OC+OCH+OAH + ON=ON+ONX + OP=OP+OPX +C +C REMOVE ADSORBED OM +C + OCH=DCORPC*OHC(K,L,NY,NX) + ONH=DCORPC*OHN(K,L,NY,NX) + OPH=DCORPC*OHP(K,L,NY,NX) + OAH=DCORPC*OHA(K,L,NY,NX) + ONX=EFIRE(1,ITILL(I,NY,NX))*ONH + OPX=EFIRE(2,ITILL(I,NY,NX))*OPH + IF(K.LE.2)THEN + ONL(4,K)=ONL(4,K)+ONH-ONX + OPL(4,K)=OPL(4,K)+OPH-OPX + ELSE + ONL(1,K)=ONL(1,K)+ONH-ONX + OPL(1,K)=OPL(1,K)+OPH-OPX + ENDIF + OHC(K,L,NY,NX)=OHC(K,L,NY,NX)-OCH + OHN(K,L,NY,NX)=OHN(K,L,NY,NX)-ONH + OHP(K,L,NY,NX)=OHP(K,L,NY,NX)-OPH + OHA(K,L,NY,NX)=OHA(K,L,NY,NX)-OAH + RC=RC+OQC(K,L,NY,NX)+OQCH(K,L,NY,NX)+OHC(K,L,NY,NX) + 2+OQA(K,L,NY,NX)+OQAH(K,L,NY,NX)+OHA(K,L,NY,NX) + RN=RN+OQN(K,L,NY,NX)+OQNH(K,L,NY,NX)+OHN(K,L,NY,NX) + RP=RP+OQP(K,L,NY,NX)+OQPH(K,L,NY,NX)+OHP(K,L,NY,NX) + OC=OC+OCH + ON=ON+ONX + OP=OP+OPX +C +C REMOVE RESIDUE +C + DO 2930 M=1,4 + OCH=DCORPC*OSC(M,K,L,NY,NX) + OCA=DCORPC*OSA(M,K,L,NY,NX) + ONH=DCORPC*OSN(M,K,L,NY,NX) + OPH=DCORPC*OSP(M,K,L,NY,NX) + ONX=EFIRE(1,ITILL(I,NY,NX))*ONH + OPX=EFIRE(2,ITILL(I,NY,NX))*OPH + ONL(M,K)=ONL(M,K)+ONH-ONX + OPL(M,K)=OPL(M,K)+OPH-OPX + OSC(M,K,L,NY,NX)=OSC(M,K,L,NY,NX)-OCH + OSA(M,K,L,NY,NX)=OSA(M,K,L,NY,NX)-OCA + OSN(M,K,L,NY,NX)=OSN(M,K,L,NY,NX)-ONH + OSP(M,K,L,NY,NX)=OSP(M,K,L,NY,NX)-OPH + RC=RC+OSC(M,K,L,NY,NX) + RN=RN+OSN(M,K,L,NY,NX) + RP=RP+OSP(M,K,L,NY,NX) + OC=OC+OCH + ON=ON+ONX + OP=OP+OPX +2930 CONTINUE + ENDIF +2900 CONTINUE +C +C ADD UNBURNED N,P TO ORG N, ORG P +C + DO 2905 K=0,4 + DO 2905 M=1,4 + OSN(M,K,L,NY,NX)=OSN(M,K,L,NY,NX)+ONL(M,K) + OSP(M,K,L,NY,NX)=OSP(M,K,L,NY,NX)+OPL(M,K) + RN=RN+ONL(M,K) + RP=RP+OPL(M,K) +2905 CONTINUE +C +C REMOVE FERTILIZER IN RESIDUE +C + IF(ITILL(I,NY,NX).EQ.21)THEN + ON=ON+DCORPC*(ZNH4S(L,NY,NX)+ZNH3S(L,NY,NX) + 2+ZNO3S(L,NY,NX)+ZNO2S(L,NY,NX)) + OP=OP+DCORPC*(H1PO4(L,NY,NX)+H2PO4(L,NY,NX)) + ZNH4S(L,NY,NX)=(1.0-DCORPC)*ZNH4S(L,NY,NX) + ZNH3S(L,NY,NX)=(1.0-DCORPC)*ZNH3S(L,NY,NX) + ZNO3S(L,NY,NX)=(1.0-DCORPC)*ZNO3S(L,NY,NX) + ZNO2S(L,NY,NX)=(1.0-DCORPC)*ZNO2S(L,NY,NX) + H1PO4(L,NY,NX)=(1.0-DCORPC)*H1PO4(L,NY,NX) + H2PO4(L,NY,NX)=(1.0-DCORPC)*H2PO4(L,NY,NX) + XN4(L,NY,NX)=(1.0-DCORPC)*XN4(L,NY,NX) + PALPO(L,NY,NX)=(1.0-DCORPC)*PALPO(L,NY,NX) + PFEPO(L,NY,NX)=(1.0-DCORPC)*PFEPO(L,NY,NX) + PCAPD(L,NY,NX)=(1.0-DCORPC)*PCAPD(L,NY,NX) + PCAPH(L,NY,NX)=(1.0-DCORPC)*PCAPH(L,NY,NX) + PCAPM(L,NY,NX)=(1.0-DCORPC)*PCAPM(L,NY,NX) + ZNH4FA(L,NY,NX)=(1.0-DCORPC)*ZNH4FA(L,NY,NX) + ZNH3FA(L,NY,NX)=(1.0-DCORPC)*ZNH3FA(L,NY,NX) + ZNHUFA(L,NY,NX)=(1.0-DCORPC)*ZNHUFA(L,NY,NX) + ZNO3FA(L,NY,NX)=(1.0-DCORPC)*ZNO3FA(L,NY,NX) + ENDIF + ORGC(L,NY,NX)=RC + ORGN(L,NY,NX)=RN + HFLXD=4.19E-06*(OSGX-ORGC(L,NY,NX))*TKS(L,NY,NX) + HEATOU=HEATOU+HFLXD + IF(L.EQ.0)THEN + VHCPR(NY,NX)=2.496E-06*ORGC(0,NY,NX)+4.19*VOLW(0,NY,NX) + 2+1.9274*VOLI(0,NY,NX) + ELSE + VHCP(L,NY,NX)=VHCM(L,NY,NX)+4.19*(VOLW(L,NY,NX)+VOLWH(L,NY,NX)) + 2+1.9274*(VOLI(L,NY,NX)+VOLIH(L,NY,NX)) + ENDIF + IF(ITILL(I,NY,NX).EQ.21)THEN + TCOU=TCOU+OC + TZOU=TZOU+ON + TPOU=TPOU+OP + UDOCQ(NY,NX)=UDOCQ(NY,NX)+OC + UDONQ(NY,NX)=UDONQ(NY,NX)+ON + UDOPQ(NY,NX)=UDOPQ(NY,NX)+OP + TNBP(NY,NX)=TNBP(NY,NX)-OC + ELSEIF(ITILL(I,NY,NX).EQ.22)THEN + CO2GIN=CO2GIN-OC + OXYGIN=OXYGIN+2.667*OC + OXYGOU=OXYGOU+2.667*OC + TZOU=TZOU+ON + TPOU=TPOU+OP + UCO2F(NY,NX)=UCO2F(NY,NX)-(1.0-FCH4F)*OC + UCH4F(NY,NX)=UCH4F(NY,NX)-FCH4F*OC + UOXYF(NY,NX)=UOXYF(NY,NX)+(1.0-FCH4F)*2.667*OC + UNH3F(NY,NX)=UNH3F(NY,NX)-ON + UN2OF(NY,NX)=UN2OF(NY,NX)-0.0 + UPO4F(NY,NX)=UPO4F(NY,NX)-OP + TNBP(NY,NX)=TNBP(NY,NX)-OC + ENDIF + ENDIF +2950 CONTINUE +C IFLGS(NY,NX)=1 + ENDIF +C +C CHANGE EXTERNAL WATER TABLE DEPTH THROUGH DISTURBANCE +C + IF(J.EQ.INT(ZNOON(NY,NX)).AND.ITILL(I,NY,NX).EQ.23)THEN + DTBLI(NY,NX)=DCORP(I,NY,NX) + IF(BKDS(NU(NY,NX),NY,NX).GT.0.0)THEN + DTBLZ(NY,NX)=AMAX1(0.0,DTBLI(NY,NX)-(ALTZ(NY,NX)-ALT(NY,NX)) + 2*(1.0-DTBLG(NY,NX))) + ELSE + DTBLZ(NY,NX)=0.0 + ENDIF + DTBLX(NY,NX)=DTBLZ(NY,NX) + ENDIF + IF(J.EQ.INT(ZNOON(NY,NX)).AND.ITILL(I,NY,NX).EQ.24)THEN + DDRGI(NY,NX)=DCORP(I,NY,NX) + IF(BKDS(NU(NY,NX),NY,NX).GT.0.0)THEN + DDRG(NY,NX)=AMAX1(0.0,DDRGI(NY,NX)-(ALTZ(NY,NX)-ALT(NY,NX)) + 2*(1.0-DTBLG(NY,NX))) + ELSE + DDRG(NY,NX)=0.0 + ENDIF + DTBLX(NY,NX)=DDRG(NY,NX) + ENDIF +C +C MIX ALL SOIL STATE VARIABLES AND INCORPORATE ALL SURFACE +C RESIDUE STATE VARIABLES WITHIN THE TILLAGE ZONE TO THE EXTENT +C ASSOCIATED IN 'DAY' WITH EACH TILLAGE EVENT ENTERED IN THE +C TILLAGE FILE +C + IF(J.EQ.INT(ZNOON(NY,NX)).AND.XCORP(NY,NX).LT.1.0 + 2.AND.DCORP(I,NY,NX).GT.0.0)THEN +C +C EXTENT OF MIXING +C + CORP=1.0-XCORP(NY,NX) +C +C TEMPORARY ACCUMULATORS +C + TBKDS=0.0 + TFC=0.0 + TWP=0.0 + TSCNV=0.0 + TSCNH=0.0 + TSAND=0.0 + TSILT=0.0 + TCLAY=0.0 + TXCEC=0.0 + TXAEC=0.0 + TGKC4=0.0 + TGKCA=0.0 + TGKCM=0.0 + TGKCN=0.0 + TGKCK=0.0 + TVOLW=0.0 + TVOLI=0.0 + TVOLP=0.0 + TVOLA=0.0 + TENGY=0.0 + TVHCM=0.0 + TNFNIH=0.0 + TNH4FA=0.0 + TNH3FA=0.0 + TNHUFA=0.0 + TNO3FA=0.0 + TNH4FB=0.0 + TNH3FB=0.0 + TNHUFB=0.0 + TNO3FB=0.0 + TNH4S=0.0 + TNH4B=0.0 + TNH3S=0.0 + TNH3B=0.0 + TNO3S=0.0 + TNO3B=0.0 + TNO2S=0.0 + TNO2B=0.0 + TZAL=0.0 + TZFE=0.0 + TZHY=0.0 + TZCA=0.0 + TZMG=0.0 + TZNA=0.0 + TZKA=0.0 + TZOH=0.0 + TZSO4=0.0 + TZCL=0.0 + TZCO3=0.0 + TZHCO3=0.0 + TZALO1=0.0 + TZALO2=0.0 + TZALO3=0.0 + TZALO4=0.0 + TZALS=0.0 + TZFEO1=0.0 + TZFEO2=0.0 + TZFEO3=0.0 + TZFEO4=0.0 + TZFES=0.0 + TZCAO=0.0 + TZCAC=0.0 + TZCAH=0.0 + TZCAS=0.0 + TZMGO=0.0 + TZMGC=0.0 + TZMGH=0.0 + TZMGS=0.0 + TZNAC=0.0 + TZNAS=0.0 + TZKAS=0.0 + TH0PO4=0.0 + TH1PO4=0.0 + TH2PO4=0.0 + TH3PO4=0.0 + TZFE1P=0.0 + TZFE2P=0.0 + TZCA0P=0.0 + TZCA1P=0.0 + TZCA2P=0.0 + TZMG1P=0.0 + TH0POB=0.0 + TH1POB=0.0 + TH2POB=0.0 + TH3POB=0.0 + TFE1PB=0.0 + TFE2PB=0.0 + TCA0PB=0.0 + TCA1PB=0.0 + TCA2PB=0.0 + TMG1PB=0.0 + TXNH4=0.0 + TXNHB=0.0 + TXHY=0.0 + TXAL=0.0 + TXFE=0.0 + TXCA=0.0 + TXMG=0.0 + TXNA=0.0 + TXKA=0.0 + TXHC=0.0 + TXAL2=0.0 + TXFE2=0.0 + TXOH0=0.0 + TXOH1=0.0 + TXOH2=0.0 + TXH1P=0.0 + TXH2P=0.0 + TXOH0B=0.0 + TXOH1B=0.0 + TXOH2B=0.0 + TXH1PB=0.0 + TXH2PB=0.0 + TPALOH=0.0 + TPFEOH=0.0 + TPCACO=0.0 + TPCASO=0.0 + TPALPO=0.0 + TPFEPO=0.0 + TPCAPD=0.0 + TPCAPH=0.0 + TPCAPM=0.0 + TPALPB=0.0 + TPFEPB=0.0 + TPCPDB=0.0 + TPCPHB=0.0 + TPCPMB=0.0 + TCO2G=0.0 + TCH4G=0.0 + TCOZS=0.0 + TCHFS=0.0 + TOXYG=0.0 + TOXYS=0.0 + TZ2GG=0.0 + TZ2GS=0.0 + TZ2OG=0.0 + TZ2OS=0.0 + 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 + TOMC(M,N,K)=0.0 + TOMN(M,N,K)=0.0 + TOMP(M,N,K)=0.0 +3990 CONTINUE + DO 3980 K=0,4 + DO 3975 M=1,2 + TORC(M,K)=0.0 + TORN(M,K)=0.0 + TORP(M,K)=0.0 +3975 CONTINUE + TOQC(K)=0.0 + TOQN(K)=0.0 + TOQP(K)=0.0 + TOQA(K)=0.0 + TOHC(K)=0.0 + TOHN(K)=0.0 + TOHP(K)=0.0 + TOHA(K)=0.0 + DO 3970 M=1,4 + TOSC(M,K)=0.0 + TOSA(M,K)=0.0 + TOSN(M,K)=0.0 + TOSP(M,K)=0.0 +3970 CONTINUE +3980 CONTINUE +C +C ACCUMULATE STATE VARIABLES IN SURFACE RESIDUE FOR ADDITION +C TO SOIL IN TILLAGE MIXING ZONE +C + RC=0.0 + RN=0.0 + RP=0.0 + DO 3950 K=0,5 + IF(K.NE.3.AND.K.NE.4)THEN + DO 3945 N=1,7 + DO 3945 M=1,3 + TOMGC(M,N,K)=OMC(M,N,K,0,NY,NX)*CORP + TOMGN(M,N,K)=OMN(M,N,K,0,NY,NX)*CORP + TOMGP(M,N,K)=OMP(M,N,K,0,NY,NX)*CORP + OMC(M,N,K,0,NY,NX)=OMC(M,N,K,0,NY,NX)*XCORP(NY,NX) + OMN(M,N,K,0,NY,NX)=OMN(M,N,K,0,NY,NX)*XCORP(NY,NX) + OMP(M,N,K,0,NY,NX)=OMP(M,N,K,0,NY,NX)*XCORP(NY,NX) + RC=RC+OMC(M,N,K,0,NY,NX) + RN=RN+OMN(M,N,K,0,NY,NX) + RP=RP+OMP(M,N,K,0,NY,NX) +3945 CONTINUE + ENDIF +3950 CONTINUE + DO 3940 K=0,2 + DO 3935 M=1,2 + TORXC(M,K)=ORC(M,K,0,NY,NX)*CORP + TORXN(M,K)=ORN(M,K,0,NY,NX)*CORP + TORXP(M,K)=ORP(M,K,0,NY,NX)*CORP + ORC(M,K,0,NY,NX)=ORC(M,K,0,NY,NX)*XCORP(NY,NX) + ORN(M,K,0,NY,NX)=ORN(M,K,0,NY,NX)*XCORP(NY,NX) + ORP(M,K,0,NY,NX)=ORP(M,K,0,NY,NX)*XCORP(NY,NX) + RC=RC+ORC(M,K,0,NY,NX) + RN=RN+ORN(M,K,0,NY,NX) + RP=RP+ORP(M,K,0,NY,NX) +3935 CONTINUE + TOQGC(K)=OQC(K,0,NY,NX)*CORP + TOQGN(K)=OQN(K,0,NY,NX)*CORP + TOQGP(K)=OQP(K,0,NY,NX)*CORP + TOQGA(K)=OQA(K,0,NY,NX)*CORP + TOQHC(K)=OQCH(K,0,NY,NX)*CORP + TOQHN(K)=OQNH(K,0,NY,NX)*CORP + TOQHP(K)=OQPH(K,0,NY,NX)*CORP + TOQHA(K)=OQAH(K,0,NY,NX)*CORP + TOHGC(K)=OHC(K,0,NY,NX)*CORP + TOHGN(K)=OHN(K,0,NY,NX)*CORP + TOHGP(K)=OHP(K,0,NY,NX)*CORP + TOHGA(K)=OHA(K,0,NY,NX)*CORP +C +C REDUCE SURFACE RESIDUE STATE VARIABLES FOR INCORPORATION +C + OQC(K,0,NY,NX)=OQC(K,0,NY,NX)*XCORP(NY,NX) + OQN(K,0,NY,NX)=OQN(K,0,NY,NX)*XCORP(NY,NX) + OQP(K,0,NY,NX)=OQP(K,0,NY,NX)*XCORP(NY,NX) + OQA(K,0,NY,NX)=OQA(K,0,NY,NX)*XCORP(NY,NX) + OQCH(K,0,NY,NX)=OQCH(K,0,NY,NX)*XCORP(NY,NX) + OQNH(K,0,NY,NX)=OQNH(K,0,NY,NX)*XCORP(NY,NX) + OQPH(K,0,NY,NX)=OQPH(K,0,NY,NX)*XCORP(NY,NX) + OQAH(K,0,NY,NX)=OQAH(K,0,NY,NX)*XCORP(NY,NX) + OHC(K,0,NY,NX)=OHC(K,0,NY,NX)*XCORP(NY,NX) + OHN(K,0,NY,NX)=OHN(K,0,NY,NX)*XCORP(NY,NX) + OHP(K,0,NY,NX)=OHP(K,0,NY,NX)*XCORP(NY,NX) + OHA(K,0,NY,NX)=OHA(K,0,NY,NX)*XCORP(NY,NX) + RC=RC+OQC(K,0,NY,NX)+OQCH(K,0,NY,NX)+OHC(K,0,NY,NX)+OQA(K,0,NY,NX) + 2+OQAH(K,0,NY,NX)+OHA(K,0,NY,NX) + RN=RN+OQN(K,0,NY,NX)+OQNH(K,0,NY,NX)+OHN(K,0,NY,NX) + RP=RP+OQP(K,0,NY,NX)+OQPH(K,0,NY,NX)+OHP(K,0,NY,NX) + DO 3965 M=1,4 + TOSGC(M,K)=OSC(M,K,0,NY,NX)*CORP + TOSGA(M,K)=OSA(M,K,0,NY,NX)*CORP + TOSGN(M,K)=OSN(M,K,0,NY,NX)*CORP + TOSGP(M,K)=OSP(M,K,0,NY,NX)*CORP + OSC(M,K,0,NY,NX)=OSC(M,K,0,NY,NX)*XCORP(NY,NX) + OSA(M,K,0,NY,NX)=OSA(M,K,0,NY,NX)*XCORP(NY,NX) + OSN(M,K,0,NY,NX)=OSN(M,K,0,NY,NX)*XCORP(NY,NX) + OSP(M,K,0,NY,NX)=OSP(M,K,0,NY,NX)*XCORP(NY,NX) + RC=RC+OSC(M,K,0,NY,NX) + RN=RN+OSN(M,K,0,NY,NX) + RP=RP+OSP(M,K,0,NY,NX) +3965 CONTINUE +3940 CONTINUE + TCO2GS=CO2S(0,NY,NX)*CORP + TCH4GS=CH4S(0,NY,NX)*CORP + TOXYGS=OXYS(0,NY,NX)*CORP + TZ2GSG=Z2GS(0,NY,NX)*CORP + TZ2OGS=Z2OS(0,NY,NX)*CORP + TH2GGS=H2GS(0,NY,NX)*CORP + TNH4GS=ZNH4S(0,NY,NX)*CORP + TNH3GS=ZNH3S(0,NY,NX)*CORP + TNO3GS=ZNO3S(0,NY,NX)*CORP + TNO2GS=ZNO2S(0,NY,NX)*CORP + TP14GS=H1PO4(0,NY,NX)*CORP + TPO4GS=H2PO4(0,NY,NX)*CORP + TXN4G=XN4(0,NY,NX)*CORP + TXOH0G=XOH0(0,NY,NX)*CORP + TXOH1G=XOH1(0,NY,NX)*CORP + TXOH2G=XOH2(0,NY,NX)*CORP + TXH1PG=XH1P(0,NY,NX)*CORP + TXH2PG=XH2P(0,NY,NX)*CORP + TALPOG=PALPO(0,NY,NX)*CORP + TFEPOG=PFEPO(0,NY,NX)*CORP + TCAPDG=PCAPD(0,NY,NX)*CORP + TCAPHG=PCAPH(0,NY,NX)*CORP + TCAPMG=PCAPM(0,NY,NX)*CORP + TNH4FG=ZNH4FA(0,NY,NX)*CORP + TNH3FG=ZNH3FA(0,NY,NX)*CORP + TNHUFG=ZNHUFA(0,NY,NX)*CORP + TNO3FG=ZNO3FA(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) + HEATIN=HEATIN-HFLXD + HEATSO=HEATSO-HFLXD + TENGYR=(4.19*TVOLWR+1.9274*TVOLIR)*TKS(0,NY,NX) + ORGC(0,NY,NX)=RC + ORGN(0,NY,NX)=RN + ORGR(0,NY,NX)=RC + CO2S(0,NY,NX)=CO2S(0,NY,NX)*XCORP(NY,NX) + CH4S(0,NY,NX)=CH4S(0,NY,NX)*XCORP(NY,NX) + OXYS(0,NY,NX)=OXYS(0,NY,NX)*XCORP(NY,NX) + Z2GS(0,NY,NX)=Z2GS(0,NY,NX)*XCORP(NY,NX) + Z2OS(0,NY,NX)=Z2OS(0,NY,NX)*XCORP(NY,NX) + H2GS(0,NY,NX)=H2GS(0,NY,NX)*XCORP(NY,NX) + ZNH4S(0,NY,NX)=ZNH4S(0,NY,NX)*XCORP(NY,NX) + ZNH3S(0,NY,NX)=ZNH3S(0,NY,NX)*XCORP(NY,NX) + ZNO3S(0,NY,NX)=ZNO3S(0,NY,NX)*XCORP(NY,NX) + ZNO2S(0,NY,NX)=ZNO2S(0,NY,NX)*XCORP(NY,NX) + H1PO4(0,NY,NX)=H1PO4(0,NY,NX)*XCORP(NY,NX) + H2PO4(0,NY,NX)=H2PO4(0,NY,NX)*XCORP(NY,NX) + XN4(0,NY,NX)=XN4(0,NY,NX)*XCORP(NY,NX) + XOH0(0,NY,NX)=XOH0(0,NY,NX)*XCORP(NY,NX) + XOH1(0,NY,NX)=XOH1(0,NY,NX)*XCORP(NY,NX) + XOH2(0,NY,NX)=XOH2(0,NY,NX)*XCORP(NY,NX) + XH1P(0,NY,NX)=XH1P(0,NY,NX)*XCORP(NY,NX) + XH2P(0,NY,NX)=XH2P(0,NY,NX)*XCORP(NY,NX) + PALPO(0,NY,NX)=PALPO(0,NY,NX)*XCORP(NY,NX) + PFEPO(0,NY,NX)=PFEPO(0,NY,NX)*XCORP(NY,NX) + PCAPD(0,NY,NX)=PCAPD(0,NY,NX)*XCORP(NY,NX) + PCAPH(0,NY,NX)=PCAPH(0,NY,NX)*XCORP(NY,NX) + PCAPM(0,NY,NX)=PCAPM(0,NY,NX)*XCORP(NY,NX) + ZNH4FA(0,NY,NX)=ZNH4FA(0,NY,NX)*XCORP(NY,NX) + ZNH3FA(0,NY,NX)=ZNH3FA(0,NY,NX)*XCORP(NY,NX) + ZNHUFA(0,NY,NX)=ZNHUFA(0,NY,NX)*XCORP(NY,NX) + ZNO3FA(0,NY,NX)=ZNO3FA(0,NY,NX)*XCORP(NY,NX) + VOLW(0,NY,NX)=VOLW(0,NY,NX)*XCORP(NY,NX) + VOLI(0,NY,NX)=VOLI(0,NY,NX)*XCORP(NY,NX) + 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)) + ZNFNX0=AMAX1(ZNFNX0,ZNFN0(0,NY,NX)) + LL=NU(NY,NX) +C +C REDISTRIBUTE SOIL STATE VARIABLES DURING TILLAGE +C + DCORPZ=AMIN1(DCORP(I,NY,NX),CDPTH(NL(NY,NX),NY,NX)) + DCORPX=DCORPZ+(CDPTH(NU(NY,NX),NY,NX)-DLYR(3,NU(NY,NX),NY,NX)) +C +C ACCUMULATE SOIL STATE VARIABLES WITHIN TILLAGE MIXING ZONE +C + DO 1000 L=NU(NY,NX),NL(NY,NX) + IF(CDPTH(L,NY,NX)-DLYR(3,L,NY,NX).LT.DCORPX)THEN + TL=AMIN1(DLYR(3,L,NY,NX),DCORPX-(CDPTH(L,NY,NX) + 2-DLYR(3,L,NY,NX))) + FI=TL/DCORPZ + TI=TL/DLYR(3,L,NY,NX) + TBKDS=TBKDS+FI*BKDS(L,NY,NX) + TFC=TFC+FI*FC(L,NY,NX) + TWP=TWP+FI*WP(L,NY,NX) + TSCNV=TSCNV+FI*SCNV(L,NY,NX) + TSCNH=TSCNH+FI*SCNH(L,NY,NX) + TSAND=TSAND+TI*SAND(L,NY,NX) + TSILT=TSILT+TI*SILT(L,NY,NX) + TCLAY=TCLAY+TI*CLAY(L,NY,NX) + TXCEC=TXCEC+TI*XCEC(L,NY,NX) + TXAEC=TXAEC+TI*XAEC(L,NY,NX) + TGKC4=TGKC4+FI*GKC4(L,NY,NX) + TGKCA=TGKCA+FI*GKCA(L,NY,NX) + TGKCM=TGKCM+FI*GKCM(L,NY,NX) + TGKCN=TGKCN+FI*GKCN(L,NY,NX) + TGKCK=TGKCK+FI*GKCK(L,NY,NX) + TVOLW=TVOLW+TI*VOLW(L,NY,NX) + TVOLI=TVOLI+TI*VOLI(L,NY,NX) + TVOLP=TVOLP+TI*VOLP(L,NY,NX) + TVOLA=TVOLA+TI*VOLA(L,NY,NX) + TENGY=TENGY+TI*(4.19*(VOLW(L,NY,NX)+VOLWH(L,NY,NX)) + 2+1.9274*(VOLI(L,NY,NX)+VOLIH(L,NY,NX)))*TKS(L,NY,NX) + TNH4FA=TNH4FA+TI*ZNH4FA(L,NY,NX) + TNH3FA=TNH3FA+TI*ZNH3FA(L,NY,NX) + TNHUFA=TNHUFA+TI*ZNHUFA(L,NY,NX) + TNO3FA=TNO3FA+TI*ZNO3FA(L,NY,NX) + TNH4FB=TNH4FB+TI*ZNH4FB(L,NY,NX) + TNH3FB=TNH3FB+TI*ZNH3FB(L,NY,NX) + TNHUFB=TNHUFB+TI*ZNHUFB(L,NY,NX) + TNO3FB=TNO3FB+TI*ZNO3FB(L,NY,NX) + TNH4S=TNH4S+TI*ZNH4S(L,NY,NX) + TNH4B=TNH4B+TI*ZNH4B(L,NY,NX) + TNH3S=TNH3S+TI*ZNH3S(L,NY,NX) + TNH3B=TNH3B+TI*ZNH3B(L,NY,NX) + TNO3S=TNO3S+TI*ZNO3S(L,NY,NX) + TNO3B=TNO3B+TI*ZNO3B(L,NY,NX) + TNO2S=TNO2S+TI*ZNO2S(L,NY,NX) + TNO2B=TNO2B+TI*ZNO2B(L,NY,NX) + TZAL=TZAL+TI*ZAL(L,NY,NX) + TZFE=TZFE+TI*ZFE(L,NY,NX) + TZHY=TZHY+TI*ZHY(L,NY,NX) + TZCA=TZCA+TI*ZCA(L,NY,NX) + TZMG=TZMG+TI*ZMG(L,NY,NX) + TZNA=TZNA+TI*ZNA(L,NY,NX) + TZKA=TZKA+TI*ZKA(L,NY,NX) + TZOH=TZOH+TI*ZOH(L,NY,NX) + TZSO4=TZSO4+TI*ZSO4(L,NY,NX) + TZCL=TZCL+TI*ZCL(L,NY,NX) + TZCO3=TZCO3+TI*ZCO3(L,NY,NX) + TZHCO3=TZHCO3+TI*ZHCO3(L,NY,NX) + TZALO1=TZALO1+TI*ZALOH1(L,NY,NX) + TZALO2=TZALO2+TI*ZALOH2(L,NY,NX) + TZALO3=TZALO3+TI*ZALOH3(L,NY,NX) + TZALO4=TZALO4+TI*ZALOH4(L,NY,NX) + TZALS=TZALS+TI*ZALS(L,NY,NX) + TZFEO1=TZFEO1+TI*ZFEOH1(L,NY,NX) + TZFEO2=TZFEO2+TI*ZFEOH2(L,NY,NX) + TZFEO3=TZFEO3+TI*ZFEOH3(L,NY,NX) + TZFEO4=TZFEO4+TI*ZFEOH4(L,NY,NX) + TZFES=TZFES+TI*ZFES(L,NY,NX) + TZCAO=TZCAO+TI*ZCAO(L,NY,NX) + TZCAC=TZCAC+TI*ZCAC(L,NY,NX) + TZCAH=TZCAH+TI*ZCAH(L,NY,NX) + TZCAS=TZCAS+TI*ZCAS(L,NY,NX) + TZMGO=TZMGO+TI*ZMGO(L,NY,NX) + TZMGC=TZMGC+TI*ZMGC(L,NY,NX) + TZMGH=TZMGH+TI*ZMGH(L,NY,NX) + TZMGS=TZMGS+TI*ZMGS(L,NY,NX) + TZNAC=TZNAC+TI*ZNAC(L,NY,NX) + TZNAS=TZNAS+TI*ZNAS(L,NY,NX) + TZKAS=TZKAS+TI*ZKAS(L,NY,NX) + TH0PO4=TH0PO4+TI*H0PO4(L,NY,NX) + TH1PO4=TH1PO4+TI*H1PO4(L,NY,NX) + TH2PO4=TH2PO4+TI*H2PO4(L,NY,NX) + TH3PO4=TH3PO4+TI*H3PO4(L,NY,NX) + TZFE1P=TZFE1P+TI*ZFE1P(L,NY,NX) + TZFE2P=TZFE2P+TI*ZFE2P(L,NY,NX) + TZCA0P=TZCA0P+TI*ZCA0P(L,NY,NX) + TZCA1P=TZCA1P+TI*ZCA1P(L,NY,NX) + TZCA2P=TZCA2P+TI*ZCA2P(L,NY,NX) + TZMG1P=TZMG1P+TI*ZMG1P(L,NY,NX) + TH0POB=TH0POB+TI*H0POB(L,NY,NX) + TH1POB=TH1POB+TI*H1POB(L,NY,NX) + TH2POB=TH2POB+TI*H2POB(L,NY,NX) + TH3POB=TH3POB+TI*H3POB(L,NY,NX) + TFE1PB=TFE1PB+TI*ZFE1PB(L,NY,NX) + TFE2PB=TFE2PB+TI*ZFE2PB(L,NY,NX) + TCA0PB=TCA0PB+TI*ZCA0PB(L,NY,NX) + TCA1PB=TCA1PB+TI*ZCA1PB(L,NY,NX) + TCA2PB=TCA2PB+TI*ZCA2PB(L,NY,NX) + TMG1PB=TMG1PB+TI*ZMG1PB(L,NY,NX) + TXNH4=TXNH4+TI*XN4(L,NY,NX) + TXNHB=TXNHB+TI*XNB(L,NY,NX) + TXHY=TXHY+TI*XHY(L,NY,NX) + TXAL=TXAL+TI*XAL(L,NY,NX) + TXFE=TXFE+TI*XFE(L,NY,NX) + TXCA=TXCA+TI*XCA(L,NY,NX) + TXMG=TXMG+TI*XMG(L,NY,NX) + TXNA=TXNA+TI*XNA(L,NY,NX) + TXKA=TXKA+TI*XKA(L,NY,NX) + TXHC=TXHC+TI*XHC(L,NY,NX) + TXAL2=TXAL2+TI*XALO2(L,NY,NX) + TXFE2=TXFE2+TI*XFEO2(L,NY,NX) + TXOH0=TXOH0+TI*XOH0(L,NY,NX) + TXOH1=TXOH1+TI*XOH1(L,NY,NX) + TXOH2=TXOH2+TI*XOH2(L,NY,NX) + TXH1P=TXH1P+TI*XH1P(L,NY,NX) + TXH2P=TXH2P+TI*XH2P(L,NY,NX) + TXOH0B=TXOH0B+TI*XOH0B(L,NY,NX) + TXOH1B=TXOH1B+TI*XOH1B(L,NY,NX) + TXOH2B=TXOH2B+TI*XOH2B(L,NY,NX) + TXH1PB=TXH1PB+TI*XH1PB(L,NY,NX) + TXH2PB=TXH2PB+TI*XH2PB(L,NY,NX) + TPALOH=TPALOH+TI*PALOH(L,NY,NX) + TPFEOH=TPFEOH+TI*PFEOH(L,NY,NX) + TPCACO=TPCACO+TI*PCACO(L,NY,NX) + TPCASO=TPCASO+TI*PCASO(L,NY,NX) + TPALPO=TPALPO+TI*PALPO(L,NY,NX) + TPFEPO=TPFEPO+TI*PFEPO(L,NY,NX) + TPCAPD=TPCAPD+TI*PCAPD(L,NY,NX) + TPCAPH=TPCAPH+TI*PCAPH(L,NY,NX) + TPCAPM=TPCAPM+TI*PCAPM(L,NY,NX) + TPALPB=TPALPB+TI*PALPB(L,NY,NX) + TPFEPB=TPFEPB+TI*PFEPB(L,NY,NX) + TPCPDB=TPCPDB+TI*PCPDB(L,NY,NX) + TPCPHB=TPCPHB+TI*PCPHB(L,NY,NX) + TPCPMB=TPCPMB+TI*PCPMB(L,NY,NX) + TCO2G=TCO2G+TI*CO2G(L,NY,NX) + TCH4G=TCH4G+TI*CH4G(L,NY,NX) + TCOZS=TCOZS+TI*CO2S(L,NY,NX) + TCHFS=TCHFS+TI*CH4S(L,NY,NX) + TOXYG=TOXYG+TI*OXYG(L,NY,NX) + TOXYS=TOXYS+TI*OXYS(L,NY,NX) + TZ2GG=TZ2GG+TI*Z2GG(L,NY,NX) + TZ2GS=TZ2GS+TI*Z2GS(L,NY,NX) + TZ2OG=TZ2OG+TI*Z2OG(L,NY,NX) + TZ2OS=TZ2OS+TI*Z2OS(L,NY,NX) + TZNH3G=TZNH3G+TI*ZNH3G(L,NY,NX) + TH2GG=TH2GG+TI*H2GG(L,NY,NX) + TH2GS=TH2GS+TI*H2GS(L,NY,NX) + DO 4985 K=0,5 + DO 4985 N=1,7 + DO 4985 M=1,3 + TOMC(M,N,K)=TOMC(M,N,K)+TI*OMC(M,N,K,L,NY,NX) + TOMN(M,N,K)=TOMN(M,N,K)+TI*OMN(M,N,K,L,NY,NX) + TOMP(M,N,K)=TOMP(M,N,K)+TI*OMP(M,N,K,L,NY,NX) +4985 CONTINUE + DO 4980 K=0,4 + DO 4975 M=1,2 + TORC(M,K)=TORC(M,K)+TI*ORC(M,K,L,NY,NX) + TORN(M,K)=TORN(M,K)+TI*ORN(M,K,L,NY,NX) + TORP(M,K)=TORP(M,K)+TI*ORP(M,K,L,NY,NX) +4975 CONTINUE + TOQC(K)=TOQC(K)+TI*OQC(K,L,NY,NX) + TOQN(K)=TOQN(K)+TI*OQN(K,L,NY,NX) + TOQP(K)=TOQP(K)+TI*OQP(K,L,NY,NX) + TOQA(K)=TOQA(K)+TI*OQA(K,L,NY,NX) + TOHC(K)=TOHC(K)+TI*OHC(K,L,NY,NX) + TOHN(K)=TOHN(K)+TI*OHN(K,L,NY,NX) + TOHP(K)=TOHP(K)+TI*OHP(K,L,NY,NX) + TOHA(K)=TOHA(K)+TI*OHA(K,L,NY,NX) + DO 4970 M=1,4 + TOSC(M,K)=TOSC(M,K)+TI*OSC(M,K,L,NY,NX) + TOSA(M,K)=TOSA(M,K)+TI*OSA(M,K,L,NY,NX) + TOSN(M,K)=TOSN(M,K)+TI*OSN(M,K,L,NY,NX) + 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)) + ZNFNX0=AMAX1(ZNFNX0,ZNFN0(L,NY,NX)) + LL=L + ENDIF +1000 CONTINUE +C +C CHANGE SOIL STATE VARIABLES IN TILLAGE MIXING ZONE +C TO ACCOUNT FOR REDISTRIBUTION FROM MIXING +C + HEATSR=VHCPW(NY,NX)*TKW(NY,NX)+VHCPR(NY,NX)*TKS(0,NY,NX) + DO 2000 L=NU(NY,NX),LL + TL=AMIN1(DLYR(3,L,NY,NX),DCORPX-(CDPTH(L,NY,NX) + 2-DLYR(3,L,NY,NX))) + FI=TL/DCORPZ + TI=TL/DLYR(3,L,NY,NX) + TX=1.0-TI + BKDS(L,NY,NX)=TI*(BKDS(L,NY,NX)+CORP*(TBKDS-BKDS(L,NY,NX))) + 2+TX*BKDS(L,NY,NX) + FC(L,NY,NX)=TI*(FC(L,NY,NX)+CORP*(TFC-FC(L,NY,NX))) + 2+TX*FC(L,NY,NX) + WP(L,NY,NX)=TI*(WP(L,NY,NX)+CORP*(TWP-WP(L,NY,NX))) + 2+TX*WP(L,NY,NX) + SCNV(L,NY,NX)=TI*(SCNV(L,NY,NX)+CORP*(TSCNV-SCNV(L,NY,NX))) + 2+TX*SCNV(L,NY,NX) + SCNH(L,NY,NX)=TI*(SCNH(L,NY,NX)+CORP*(TSCNH-SCNH(L,NY,NX))) + 2+TX*SCNH(L,NY,NX) + SAND(L,NY,NX)=TI*SAND(L,NY,NX)+CORP*(FI*TSAND-TI*SAND(L,NY,NX)) + 2+TX*SAND(L,NY,NX) + SILT(L,NY,NX)=TI*SILT(L,NY,NX)+CORP*(FI*TSILT-TI*SILT(L,NY,NX)) + 2+TX*SILT(L,NY,NX) + CLAY(L,NY,NX)=TI*CLAY(L,NY,NX)+CORP*(FI*TCLAY-TI*CLAY(L,NY,NX)) + 2+TX*CLAY(L,NY,NX) + XCEC(L,NY,NX)=TI*XCEC(L,NY,NX)+CORP*(FI*TXCEC-TI*XCEC(L,NY,NX)) + 2+TX*XCEC(L,NY,NX) + XAEC(L,NY,NX)=TI*XAEC(L,NY,NX)+CORP*(FI*TXAEC-TI*XAEC(L,NY,NX)) + 2+TX*XAEC(L,NY,NX) + GKC4(L,NY,NX)=TI*(GKC4(L,NY,NX)+CORP*(TGKC4-GKC4(L,NY,NX))) + 2+TX*GKC4(L,NY,NX) + GKCA(L,NY,NX)=TI*(GKCA(L,NY,NX)+CORP*(TGKCA-GKCA(L,NY,NX))) + 2+TX*GKCA(L,NY,NX) + GKCM(L,NY,NX)=TI*(GKCM(L,NY,NX)+CORP*(TGKCM-GKCM(L,NY,NX))) + 2+TX*GKCM(L,NY,NX) + GKCN(L,NY,NX)=TI*(GKCN(L,NY,NX)+CORP*(TGKCN-GKCN(L,NY,NX))) + 2+TX*GKCN(L,NY,NX) + GKCK(L,NY,NX)=TI*(GKCK(L,NY,NX)+CORP*(TGKCK-GKCK(L,NY,NX))) + 2+TX*GKCK(L,NY,NX) + ENGYM=VHCM(L,NY,NX)*TKS(L,NY,NX) + ENGYW=(4.19*(VOLW(L,NY,NX)+VOLWH(L,NY,NX)) + 2+1.9274*(VOLI(L,NY,NX)+VOLIH(L,NY,NX)))*TKS(L,NY,NX) + VOLW(L,NY,NX)=TI*VOLW(L,NY,NX)+CORP*(FI*TVOLW-TI*VOLW(L,NY,NX)) + 2+TX*VOLW(L,NY,NX)+FI*TVOLWR + VOLI(L,NY,NX)=TI*VOLI(L,NY,NX)+CORP*(FI*TVOLI-TI*VOLI(L,NY,NX)) + 2+TX*VOLI(L,NY,NX)+FI*TVOLIR + VOLP(L,NY,NX)=TI*VOLP(L,NY,NX)+CORP*(FI*TVOLP-TI*VOLP(L,NY,NX)) + 2+TX*VOLP(L,NY,NX) + VOLA(L,NY,NX)=TI*VOLA(L,NY,NX)+CORP*(FI*TVOLA-TI*VOLA(L,NY,NX)) + 2+TX*VOLA(L,NY,NX) + VOLWX(L,NY,NX)=VOLW(L,NY,NX) +C VOLW(L,NY,NX)=VOLW(L,NY,NX)+CORP*VOLWH(L,NY,NX) +C VOLI(L,NY,NX)=VOLI(L,NY,NX)+CORP*VOLIH(L,NY,NX) +C VOLA(L,NY,NX)=VOLA(L,NY,NX)+CORP*VOLAH(L,NY,NX) +C VOLWH(L,NY,NX)=XCORP(NY,NX)*VOLWH(L,NY,NX) +C VOLIH(L,NY,NX)=XCORP(NY,NX)*VOLIH(L,NY,NX) +C VOLAH(L,NY,NX)=XCORP(NY,NX)*VOLAH(L,NY,NX) +C FHOL(L,NY,NX)=XCORP(NY,NX)*FHOL(L,NY,NX) + ENGYL=TI*ENGYW+CORP*(FI*TENGY-TI*ENGYW)+TX*ENGYW+FI*TENGYR + VHCP(L,NY,NX)=VHCM(L,NY,NX)+4.19*(VOLW(L,NY,NX)+VOLWH(L,NY,NX)) + 2+1.9274*(VOLI(L,NY,NX)+VOLIH(L,NY,NX)) + TKS(L,NY,NX)=(ENGYM+ENGYL)/VHCP(L,NY,NX) + TCS(L,NY,NX)=TKS(L,NY,NX)-273.15 + ZNH4FA(L,NY,NX)=TI*ZNH4FA(L,NY,NX)+CORP*(FI*TNH4FA + 2-TI*ZNH4FA(L,NY,NX))+TX*ZNH4FA(L,NY,NX) + ZNH3FA(L,NY,NX)=TI*ZNH3FA(L,NY,NX)+CORP*(FI*TNH3FA + 2-TI*ZNH3FA(L,NY,NX))+TX*ZNH3FA(L,NY,NX) + ZNHUFA(L,NY,NX)=TI*ZNHUFA(L,NY,NX)+CORP*(FI*TNHUFA + 2-TI*ZNHUFA(L,NY,NX))+TX*ZNHUFA(L,NY,NX) + ZNO3FA(L,NY,NX)=TI*ZNO3FA(L,NY,NX)+CORP*(FI*TNO3FA + 2-TI*ZNO3FA(L,NY,NX))+TX*ZNO3FA(L,NY,NX) + ZNH4FB(L,NY,NX)=TI*ZNH4FB(L,NY,NX)+CORP*(FI*TNH4FB + 2-TI*ZNH4FB(L,NY,NX))+TX*ZNH4FB(L,NY,NX) + ZNH3FB(L,NY,NX)=TI*ZNH3FB(L,NY,NX)+CORP*(FI*TNH3FB + 2-TI*ZNH3FB(L,NY,NX))+TX*ZNH3FB(L,NY,NX) + ZNHUFB(L,NY,NX)=TI*ZNHUFB(L,NY,NX)+CORP*(FI*TNHUFB + 2-TI*ZNHUFB(L,NY,NX))+TX*ZNHUFB(L,NY,NX) + ZNO3FB(L,NY,NX)=TI*ZNO3FB(L,NY,NX)+CORP*(FI*TNO3FB + 2-TI*ZNO3FB(L,NY,NX))+TX*ZNO3FB(L,NY,NX) + ZNH4S(L,NY,NX)=TI*ZNH4S(L,NY,NX)+CORP*(FI*TNH4S-TI*ZNH4S(L,NY,NX)) + 2+TX*ZNH4S(L,NY,NX)+CORP*ZNH4SH(L,NY,NX) + ZNH4B(L,NY,NX)=TI*ZNH4B(L,NY,NX)+CORP*(FI*TNH4B-TI*ZNH4B(L,NY,NX)) + 2+TX*ZNH4B(L,NY,NX)+CORP*ZNH4BH(L,NY,NX) + ZNH3S(L,NY,NX)=TI*ZNH3S(L,NY,NX)+CORP*(FI*TNH3S-TI*ZNH3S(L,NY,NX)) + 2+TX*ZNH3S(L,NY,NX)+CORP*ZNH3SH(L,NY,NX) + ZNH3B(L,NY,NX)=TI*ZNH3B(L,NY,NX)+CORP*(FI*TNH3B-TI*ZNH3B(L,NY,NX)) + 2+TX*ZNH3B(L,NY,NX)+CORP*ZNH3BH(L,NY,NX) + ZNO3S(L,NY,NX)=TI*ZNO3S(L,NY,NX)+CORP*(FI*TNO3S-TI*ZNO3S(L,NY,NX)) + 2+TX*ZNO3S(L,NY,NX)+CORP*ZNO3SH(L,NY,NX) + ZNO3B(L,NY,NX)=TI*ZNO3B(L,NY,NX)+CORP*(FI*TNO3B-TI*ZNO3B(L,NY,NX)) + 2+TX*ZNO3B(L,NY,NX)+CORP*ZNO3BH(L,NY,NX) + ZNO2S(L,NY,NX)=TI*ZNO2S(L,NY,NX)+CORP*(FI*TNO2S-TI*ZNO2S(L,NY,NX)) + 2+TX*ZNO2S(L,NY,NX)+CORP*ZNO2SH(L,NY,NX) + ZNO2B(L,NY,NX)=TI*ZNO2B(L,NY,NX)+CORP*(FI*TNO2B-TI*ZNO2B(L,NY,NX)) + 2+TX*ZNO2B(L,NY,NX)+CORP*ZNO2BH(L,NY,NX) + ZAL(L,NY,NX)=TI*ZAL(L,NY,NX)+CORP*(FI*TZAL-TI*ZAL(L,NY,NX)) + 2+TX*ZAL(L,NY,NX)+CORP*ZALH(L,NY,NX) + ZFE(L,NY,NX)=TI*ZFE(L,NY,NX)+CORP*(FI*TZFE-TI*ZFE(L,NY,NX)) + 2+TX*ZFE(L,NY,NX)+CORP*ZFEH(L,NY,NX) + ZHY(L,NY,NX)=TI*ZHY(L,NY,NX)+CORP*(FI*TZHY-TI*ZHY(L,NY,NX)) + 2+TX*ZHY(L,NY,NX)+CORP*ZHYH(L,NY,NX) + ZCA(L,NY,NX)=TI*ZCA(L,NY,NX)+CORP*(FI*TZCA-TI*ZCA(L,NY,NX)) + 2+TX*ZCA(L,NY,NX)+CORP*ZCCH(L,NY,NX) + ZMG(L,NY,NX)=TI*ZMG(L,NY,NX)+CORP*(FI*TZMG-TI*ZMG(L,NY,NX)) + 2+TX*ZMG(L,NY,NX)+CORP*ZMAH(L,NY,NX) + ZNA(L,NY,NX)=TI*ZNA(L,NY,NX)+CORP*(FI*TZNA-TI*ZNA(L,NY,NX)) + 2+TX*ZNA(L,NY,NX)+CORP*ZNAH(L,NY,NX) + ZKA(L,NY,NX)=TI*ZKA(L,NY,NX)+CORP*(FI*TZKA-TI*ZKA(L,NY,NX)) + 2+TX*ZKA(L,NY,NX)+CORP*ZKAH(L,NY,NX) + ZOH(L,NY,NX)=TI*ZOH(L,NY,NX)+CORP*(FI*TZOH-TI*ZOH(L,NY,NX)) + 2+TX*ZOH(L,NY,NX)+CORP*ZOHH(L,NY,NX) + ZSO4(L,NY,NX)=TI*ZSO4(L,NY,NX)+CORP*(FI*TZSO4-TI*ZSO4(L,NY,NX)) + 2+TX*ZSO4(L,NY,NX)+CORP*ZSO4H(L,NY,NX) + ZCL(L,NY,NX)=TI*ZCL(L,NY,NX)+CORP*(FI*TZCL-TI*ZCL(L,NY,NX)) + 2+TX*ZCL(L,NY,NX)+CORP*ZCLH(L,NY,NX) + ZCO3(L,NY,NX)=TI*ZCO3(L,NY,NX)+CORP*(FI*TZCO3-TI*ZCO3(L,NY,NX)) + 2+TX*ZCO3(L,NY,NX)+CORP*ZCO3H(L,NY,NX) + ZHCO3(L,NY,NX)=TI*ZHCO3(L,NY,NX)+CORP*(FI*TZHCO3 + 2-TI*ZHCO3(L,NY,NX))+TX*ZHCO3(L,NY,NX)+CORP*ZHCO3H(L,NY,NX) + ZALOH1(L,NY,NX)=TI*ZALOH1(L,NY,NX)+CORP*(FI*TZALO1 + 2-TI*ZALOH1(L,NY,NX))+TX*ZALOH1(L,NY,NX)+CORP*ZALO1H(L,NY,NX) + ZALOH2(L,NY,NX)=TI*ZALOH2(L,NY,NX)+CORP*(FI*TZALO2 + 2-TI*ZALOH2(L,NY,NX))+TX*ZALOH2(L,NY,NX)+CORP*ZALO2H(L,NY,NX) + ZALOH3(L,NY,NX)=TI*ZALOH3(L,NY,NX)+CORP*(FI*TZALO3 + 2-TI*ZALOH3(L,NY,NX))+TX*ZALOH3(L,NY,NX)+CORP*ZALO3H(L,NY,NX) + ZALOH4(L,NY,NX)=TI*ZALOH4(L,NY,NX)+CORP*(FI*TZALO4 + 2-TI*ZALOH4(L,NY,NX))+TX*ZALOH4(L,NY,NX)+CORP*ZALO4H(L,NY,NX) + ZALS(L,NY,NX)=TI*ZALS(L,NY,NX)+CORP*(FI*TZALS-TI*ZALS(L,NY,NX)) + 2+TX*ZALS(L,NY,NX)+CORP*ZALSH(L,NY,NX) + ZFEOH1(L,NY,NX)=TI*ZFEOH1(L,NY,NX)+CORP*(FI*TZFEO1 + 2-TI*ZFEOH1(L,NY,NX))+TX*ZFEOH1(L,NY,NX)+CORP*ZFEO1H(L,NY,NX) + ZFEOH2(L,NY,NX)=TI*ZFEOH2(L,NY,NX)+CORP*(FI*TZFEO2 + 2-TI*ZFEOH2(L,NY,NX))+TX*ZFEOH2(L,NY,NX)+CORP*ZFEO2H(L,NY,NX) + ZFEOH3(L,NY,NX)=TI*ZFEOH3(L,NY,NX)+CORP*(FI*TZFEO3 + 2-TI*ZFEOH3(L,NY,NX))+TX*ZFEOH3(L,NY,NX)+CORP*ZFEO3H(L,NY,NX) + ZFEOH4(L,NY,NX)=TI*ZFEOH4(L,NY,NX)+CORP*(FI*TZFEO4 + 2-TI*ZFEOH4(L,NY,NX))+TX*ZFEOH4(L,NY,NX)+CORP*ZFEO4H(L,NY,NX) + ZFES(L,NY,NX)=TI*ZFES(L,NY,NX)+CORP*(FI*TZFES-TI*ZFES(L,NY,NX)) + 2+TX*ZFES(L,NY,NX)+CORP*ZFESH(L,NY,NX) + ZCAO(L,NY,NX)=TI*ZCAO(L,NY,NX)+CORP*(FI*TZCAO-TI*ZCAO(L,NY,NX)) + 2+TX*ZCAO(L,NY,NX)+CORP*ZCAOH(L,NY,NX) + ZCAC(L,NY,NX)=TI*ZCAC(L,NY,NX)+CORP*(FI*TZCAC-TI*ZCAC(L,NY,NX)) + 2+TX*ZCAC(L,NY,NX)+CORP*ZCACH(L,NY,NX) + ZCAH(L,NY,NX)=TI*ZCAH(L,NY,NX)+CORP*(FI*TZCAH-TI*ZCAH(L,NY,NX)) + 2+TX*ZCAH(L,NY,NX)+CORP*ZCAHH(L,NY,NX) + ZCAS(L,NY,NX)=TI*ZCAS(L,NY,NX)+CORP*(FI*TZCAS-TI*ZCAS(L,NY,NX)) + 2+TX*ZCAS(L,NY,NX)+CORP*ZCASH(L,NY,NX) + ZMGO(L,NY,NX)=TI*ZMGO(L,NY,NX)+CORP*(FI*TZMGO-TI*ZMGO(L,NY,NX)) + 2+TX*ZMGO(L,NY,NX)+CORP*ZMGOH(L,NY,NX) + ZMGC(L,NY,NX)=TI*ZMGC(L,NY,NX)+CORP*(FI*TZMGC-TI*ZMGC(L,NY,NX)) + 2+TX*ZMGC(L,NY,NX)+CORP*ZMGCH(L,NY,NX) + ZMGH(L,NY,NX)=TI*ZMGH(L,NY,NX)+CORP*(FI*TZMGH-TI*ZMGH(L,NY,NX)) + 2+TX*ZMGH(L,NY,NX)+CORP*ZMGHH(L,NY,NX) + ZMGS(L,NY,NX)=TI*ZMGS(L,NY,NX)+CORP*(FI*TZMGS-TI*ZMGS(L,NY,NX)) + 2+TX*ZMGS(L,NY,NX)+CORP*ZMGSH(L,NY,NX) + ZNAC(L,NY,NX)=TI*ZNAC(L,NY,NX)+CORP*(FI*TZNAC-TI*ZNAC(L,NY,NX)) + 2+TX*ZNAC(L,NY,NX)+CORP*ZNACH(L,NY,NX) + ZNAS(L,NY,NX)=TI*ZNAS(L,NY,NX)+CORP*(FI*TZNAS-TI*ZNAS(L,NY,NX)) + 2+TX*ZNAS(L,NY,NX)+CORP*ZNASH(L,NY,NX) + ZKAS(L,NY,NX)=TI*ZKAS(L,NY,NX)+CORP*(FI*TZKAS-TI*ZKAS(L,NY,NX)) + 2+TX*ZKAS(L,NY,NX)+CORP*ZKASH(L,NY,NX) + H0PO4(L,NY,NX)=TI*H0PO4(L,NY,NX)+CORP*(FI*TH0PO4 + 2-TI*H0PO4(L,NY,NX))+TX*H0PO4(L,NY,NX)+CORP*H0PO4H(L,NY,NX) + H1PO4(L,NY,NX)=TI*H1PO4(L,NY,NX)+CORP*(FI*TH1PO4 + 2-TI*H1PO4(L,NY,NX))+TX*H1PO4(L,NY,NX)+CORP*H1PO4H(L,NY,NX) + H2PO4(L,NY,NX)=TI*H2PO4(L,NY,NX)+CORP*(FI*TH2PO4 + 2-TI*H2PO4(L,NY,NX))+TX*H2PO4(L,NY,NX)+CORP*H2PO4H(L,NY,NX) + H3PO4(L,NY,NX)=TI*H3PO4(L,NY,NX)+CORP*(FI*TH3PO4 + 2-TI*H3PO4(L,NY,NX))+TX*H3PO4(L,NY,NX)+CORP*H3PO4H(L,NY,NX) + ZFE1P(L,NY,NX)=TI*ZFE1P(L,NY,NX)+CORP*(FI*TZFE1P + 2-TI*ZFE1P(L,NY,NX))+TX*ZFE1P(L,NY,NX)+CORP*ZFE1PH(L,NY,NX) + ZFE2P(L,NY,NX)=TI*ZFE2P(L,NY,NX)+CORP*(FI*TZFE2P + 2-TI*ZFE2P(L,NY,NX))+TX*ZFE2P(L,NY,NX)+CORP*ZFE2PH(L,NY,NX) + ZCA0P(L,NY,NX)=TI*ZCA0P(L,NY,NX)+CORP*(FI*TZCA0P + 2-TI*ZCA0P(L,NY,NX))+TX*ZCA0P(L,NY,NX)+CORP*ZCA0PH(L,NY,NX) + ZCA1P(L,NY,NX)=TI*ZCA1P(L,NY,NX)+CORP*(FI*TZCA1P + 2-TI*ZCA1P(L,NY,NX))+TX*ZCA1P(L,NY,NX)+CORP*ZCA1PH(L,NY,NX) + ZCA2P(L,NY,NX)=TI*ZCA2P(L,NY,NX)+CORP*(FI*TZCA2P + 2-TI*ZCA2P(L,NY,NX))+TX*ZCA2P(L,NY,NX)+CORP*ZCA2PH(L,NY,NX) + ZMG1P(L,NY,NX)=TI*ZMG1P(L,NY,NX)+CORP*(FI*TZMG1P + 2-TI*ZMG1P(L,NY,NX))+TX*ZMG1P(L,NY,NX)+CORP*ZMG1PH(L,NY,NX) + H0POB(L,NY,NX)=TI*H0POB(L,NY,NX)+CORP*(FI*TH0POB + 2-TI*H0POB(L,NY,NX))+TX*H0POB(L,NY,NX)+CORP*H0POBH(L,NY,NX) + H1POB(L,NY,NX)=TI*H1POB(L,NY,NX)+CORP*(FI*TH1POB + 2-TI*H1POB(L,NY,NX))+TX*H1POB(L,NY,NX)+CORP*H1POBH(L,NY,NX) + H2POB(L,NY,NX)=TI*H2POB(L,NY,NX)+CORP*(FI*TH2POB + 2-TI*H2POB(L,NY,NX))+TX*H2POB(L,NY,NX)+CORP*H2POBH(L,NY,NX) + H3POB(L,NY,NX)=TI*H3POB(L,NY,NX)+CORP*(FI*TH3POB + 2-TI*H3POB(L,NY,NX))+TX*H3POB(L,NY,NX)+CORP*H3POBH(L,NY,NX) + ZFE1PB(L,NY,NX)=TI*ZFE1PB(L,NY,NX)+CORP*(FI*TFE1PB + 2-TI*ZFE1PB(L,NY,NX))+TX*ZFE1PB(L,NY,NX)+CORP*ZFE1BH(L,NY,NX) + ZFE2PB(L,NY,NX)=TI*ZFE2PB(L,NY,NX)+CORP*(FI*TFE2PB + 2-TI*ZFE2PB(L,NY,NX))+TX*ZFE2PB(L,NY,NX)+CORP*ZFE2BH(L,NY,NX) + ZCA0PB(L,NY,NX)=TI*ZCA0PB(L,NY,NX)+CORP*(FI*TCA0PB + 2-TI*ZCA0PB(L,NY,NX))+TX*ZCA0PB(L,NY,NX)+CORP*ZCA0BH(L,NY,NX) + ZCA1PB(L,NY,NX)=TI*ZCA1PB(L,NY,NX)+CORP*(FI*TCA1PB + 2-TI*ZCA1PB(L,NY,NX))+TX*ZCA1PB(L,NY,NX)+CORP*ZCA1BH(L,NY,NX) + ZCA2PB(L,NY,NX)=TI*ZCA2PB(L,NY,NX)+CORP*(FI*TCA2PB + 2-TI*ZCA2PB(L,NY,NX))+TX*ZCA2PB(L,NY,NX)+CORP*ZCA2BH(L,NY,NX) + ZMG1PB(L,NY,NX)=TI*ZMG1PB(L,NY,NX)+CORP*(FI*TMG1PB + 2-TI*ZMG1PB(L,NY,NX))+TX*ZMG1PB(L,NY,NX)+CORP*ZMG1BH(L,NY,NX) + XN4(L,NY,NX)=TI*XN4(L,NY,NX)+CORP*(FI*TXNH4-TI*XN4(L,NY,NX)) + 2+TX*XN4(L,NY,NX) + XNB(L,NY,NX)=TI*XNB(L,NY,NX)+CORP*(FI*TXNHB-TI*XNB(L,NY,NX)) + 2+TX*XNB(L,NY,NX) + XHY(L,NY,NX)=TI*XHY(L,NY,NX)+CORP*(FI*TXHY-TI*XHY(L,NY,NX)) + 2+TX*XHY(L,NY,NX) + XAL(L,NY,NX)=TI*XAL(L,NY,NX)+CORP*(FI*TXAL-TI*XAL(L,NY,NX)) + 2+TX*XAL(L,NY,NX) + XFE(L,NY,NX)=TI*XFE(L,NY,NX)+CORP*(FI*TXFE-TI*XFE(L,NY,NX)) + 2+TX*XFE(L,NY,NX) + XCA(L,NY,NX)=TI*XCA(L,NY,NX)+CORP*(FI*TXCA-TI*XCA(L,NY,NX)) + 2+TX*XCA(L,NY,NX) + XMG(L,NY,NX)=TI*XMG(L,NY,NX)+CORP*(FI*TXMG-TI*XMG(L,NY,NX)) + 2+TX*XMG(L,NY,NX) + XNA(L,NY,NX)=TI*XNA(L,NY,NX)+CORP*(FI*TXNA-TI*XNA(L,NY,NX)) + 2+TX*XNA(L,NY,NX) + XKA(L,NY,NX)=TI*XKA(L,NY,NX)+CORP*(FI*TXKA-TI*XKA(L,NY,NX)) + 2+TX*XKA(L,NY,NX) + XHC(L,NY,NX)=TI*XHC(L,NY,NX)+CORP*(FI*TXHC-TI*XHC(L,NY,NX)) + 2+TX*XHC(L,NY,NX) + XALO2(L,NY,NX)=TI*XALO2(L,NY,NX)+CORP*(FI*TXAL2-TI*XALO2(L,NY,NX)) + 2+TX*XALO2(L,NY,NX) + XFEO2(L,NY,NX)=TI*XFEO2(L,NY,NX)+CORP*(FI*TXFE2-TI*XFEO2(L,NY,NX)) + 2+TX*XFEO2(L,NY,NX) + XOH0(L,NY,NX)=TI*XOH0(L,NY,NX)+CORP*(FI*TXOH0-TI*XOH0(L,NY,NX)) + 2+TX*XOH0(L,NY,NX) + XOH1(L,NY,NX)=TI*XOH1(L,NY,NX)+CORP*(FI*TXOH1-TI*XOH1(L,NY,NX)) + 2+TX*XOH1(L,NY,NX) + XOH2(L,NY,NX)=TI*XOH2(L,NY,NX)+CORP*(FI*TXOH2-TI*XOH2(L,NY,NX)) + 2+TX*XOH2(L,NY,NX) + XH1P(L,NY,NX)=TI*XH1P(L,NY,NX)+CORP*(FI*TXH1P-TI*XH1P(L,NY,NX)) + 2+TX*XH1P(L,NY,NX) + XH2P(L,NY,NX)=TI*XH2P(L,NY,NX)+CORP*(FI*TXH2P-TI*XH2P(L,NY,NX)) + 2+TX*XH2P(L,NY,NX) + XOH0B(L,NY,NX)=TI*XOH0B(L,NY,NX)+CORP*(FI*TXOH0B + 2-TI*XOH0B(L,NY,NX))+TX*XOH0B(L,NY,NX) + XOH1B(L,NY,NX)=TI*XOH1B(L,NY,NX)+CORP*(FI*TXOH1B + 2-TI*XOH1B(L,NY,NX))+TX*XOH1B(L,NY,NX) + XOH2B(L,NY,NX)=TI*XOH2B(L,NY,NX)+CORP*(FI*TXOH2B + 2-TI*XOH2B(L,NY,NX))+TX*XOH2B(L,NY,NX) + XH1PB(L,NY,NX)=TI*XH1PB(L,NY,NX)+CORP*(FI*TXH1PB + 2-TI*XH1PB(L,NY,NX))+TX*XH1PB(L,NY,NX) + XH2PB(L,NY,NX)=TI*XH2PB(L,NY,NX)+CORP*(FI*TXH2PB + 2-TI*XH2PB(L,NY,NX))+TX*XH2PB(L,NY,NX) + PALOH(L,NY,NX)=TI*PALOH(L,NY,NX)+CORP*(FI*TPALOH + 2-TI*PALOH(L,NY,NX))+TX*PALOH(L,NY,NX) + PFEOH(L,NY,NX)=TI*PFEOH(L,NY,NX)+CORP*(FI*TPFEOH + 2-TI*PFEOH(L,NY,NX))+TX*PFEOH(L,NY,NX) + PCACO(L,NY,NX)=TI*PCACO(L,NY,NX)+CORP*(FI*TPCACO + 2-TI*PCACO(L,NY,NX))+TX*PCACO(L,NY,NX) + PCASO(L,NY,NX)=TI*PCASO(L,NY,NX)+CORP*(FI*TPCASO + 2-TI*PCASO(L,NY,NX))+TX*PCASO(L,NY,NX) + PALPO(L,NY,NX)=TI*PALPO(L,NY,NX)+CORP*(FI*TPALPO + 2-TI*PALPO(L,NY,NX))+TX*PALPO(L,NY,NX) + PFEPO(L,NY,NX)=TI*PFEPO(L,NY,NX)+CORP*(FI*TPFEPO + 2-TI*PFEPO(L,NY,NX))+TX*PFEPO(L,NY,NX) + PCAPD(L,NY,NX)=TI*PCAPD(L,NY,NX)+CORP*(FI*TPCAPD + 2-TI*PCAPD(L,NY,NX))+TX*PCAPD(L,NY,NX) + PCAPH(L,NY,NX)=TI*PCAPH(L,NY,NX)+CORP*(FI*TPCAPH + 2-TI*PCAPH(L,NY,NX))+TX*PCAPH(L,NY,NX) + PCAPM(L,NY,NX)=TI*PCAPM(L,NY,NX)+CORP*(FI*TPCAPM + 2-TI*PCAPM(L,NY,NX))+TX*PCAPM(L,NY,NX) + PALPB(L,NY,NX)=TI*PALPB(L,NY,NX)+CORP*(FI*TPALPB + 2-TI*PALPB(L,NY,NX))+TX*PALPB(L,NY,NX) + PFEPB(L,NY,NX)=TI*PFEPB(L,NY,NX)+CORP*(FI*TPFEPB + 2-TI*PFEPB(L,NY,NX))+TX*PFEPB(L,NY,NX) + PCPDB(L,NY,NX)=TI*PCPDB(L,NY,NX)+CORP*(FI*TPCPDB + 2-TI*PCPDB(L,NY,NX))+TX*PCPDB(L,NY,NX) + PCPHB(L,NY,NX)=TI*PCPHB(L,NY,NX)+CORP*(FI*TPCPHB + 2-TI*PCPHB(L,NY,NX))+TX*PCPHB(L,NY,NX) + PCPMB(L,NY,NX)=TI*PCPMB(L,NY,NX)+CORP*(FI*TPCPMB + 2-TI*PCPMB(L,NY,NX))+TX*PCPMB(L,NY,NX) + CO2G(L,NY,NX)=TI*CO2G(L,NY,NX)+CORP*(FI*TCO2G-TI*CO2G(L,NY,NX)) + 2+TX*CO2G(L,NY,NX) + CH4G(L,NY,NX)=TI*CH4G(L,NY,NX)+CORP*(FI*TCH4G-TI*CH4G(L,NY,NX)) + 2+TX*CH4G(L,NY,NX) + CO2S(L,NY,NX)=TI*CO2S(L,NY,NX)+CORP*(FI*TCOZS-TI*CO2S(L,NY,NX)) + 2+TX*CO2S(L,NY,NX)+CORP*CO2SH(L,NY,NX) + CH4S(L,NY,NX)=TI*CH4S(L,NY,NX)+CORP*(FI*TCHFS-TI*CH4S(L,NY,NX)) + 2+TX*CH4S(L,NY,NX)+CORP*CH4SH(L,NY,NX) + OXYG(L,NY,NX)=TI*OXYG(L,NY,NX)+CORP*(FI*TOXYG-TI*OXYG(L,NY,NX)) + 2+TX*OXYG(L,NY,NX) + OXYS(L,NY,NX)=TI*OXYS(L,NY,NX)+CORP*(FI*TOXYS-TI*OXYS(L,NY,NX)) + 2+TX*OXYS(L,NY,NX)+CORP*OXYSH(L,NY,NX) + Z2GG(L,NY,NX)=TI*Z2GG(L,NY,NX)+CORP*(FI*TZ2GG-TI*Z2GG(L,NY,NX)) + 2+TX*Z2GG(L,NY,NX) + Z2GS(L,NY,NX)=TI*Z2GS(L,NY,NX)+CORP*(FI*TZ2GS-TI*Z2GS(L,NY,NX)) + 2+TX*Z2GS(L,NY,NX)+CORP*Z2GSH(L,NY,NX) + Z2OG(L,NY,NX)=TI*Z2OG(L,NY,NX)+CORP*(FI*TZ2OG-TI*Z2OG(L,NY,NX)) + 2+TX*Z2OG(L,NY,NX) + Z2OS(L,NY,NX)=TI*Z2OS(L,NY,NX)+CORP*(FI*TZ2OS-TI*Z2OS(L,NY,NX)) + 2+TX*Z2OS(L,NY,NX)+CORP*Z2OSH(L,NY,NX) + ZNH3G(L,NY,NX)=TI*ZNH3G(L,NY,NX)+CORP*(FI*TZNH3G + 2-TI*ZNH3G(L,NY,NX))+TX*ZNH3G(L,NY,NX) + H2GG(L,NY,NX)=TI*H2GG(L,NY,NX)+CORP*(FI*TH2GG-TI*H2GG(L,NY,NX)) + 2+TX*H2GG(L,NY,NX) + H2GS(L,NY,NX)=TI*H2GS(L,NY,NX)+CORP*(FI*TH2GS-TI*H2GS(L,NY,NX)) + 2+TX*H2GS(L,NY,NX)+CORP*H2GSH(L,NY,NX) + ZNH4SH(L,NY,NX)=XCORP(NY,NX)*ZNH4SH(L,NY,NX) + ZNH3SH(L,NY,NX)=XCORP(NY,NX)*ZNH3SH(L,NY,NX) + ZNO3SH(L,NY,NX)=XCORP(NY,NX)*ZNO3SH(L,NY,NX) + ZNO2SH(L,NY,NX)=XCORP(NY,NX)*ZNO2SH(L,NY,NX) + H1PO4H(L,NY,NX)=XCORP(NY,NX)*H1PO4H(L,NY,NX) + H2PO4H(L,NY,NX)=XCORP(NY,NX)*H2PO4H(L,NY,NX) + ZNH4BH(L,NY,NX)=XCORP(NY,NX)*ZNH4BH(L,NY,NX) + ZNH3BH(L,NY,NX)=XCORP(NY,NX)*ZNH3BH(L,NY,NX) + ZNO3BH(L,NY,NX)=XCORP(NY,NX)*ZNO3BH(L,NY,NX) + ZNO2BH(L,NY,NX)=XCORP(NY,NX)*ZNO2BH(L,NY,NX) + H1POBH(L,NY,NX)=XCORP(NY,NX)*H1POBH(L,NY,NX) + H2POBH(L,NY,NX)=XCORP(NY,NX)*H2POBH(L,NY,NX) + ZALH(L,NY,NX)=XCORP(NY,NX)*ZALH(L,NY,NX) + ZFEH(L,NY,NX)=XCORP(NY,NX)*ZFEH(L,NY,NX) + ZHYH(L,NY,NX)=XCORP(NY,NX)*ZHYH(L,NY,NX) + ZCCH(L,NY,NX)=XCORP(NY,NX)*ZCCH(L,NY,NX) + ZMAH(L,NY,NX)=XCORP(NY,NX)*ZMAH(L,NY,NX) + ZNAH(L,NY,NX)=XCORP(NY,NX)*ZNAH(L,NY,NX) + ZKAH(L,NY,NX)=XCORP(NY,NX)*ZKAH(L,NY,NX) + ZOHH(L,NY,NX)=XCORP(NY,NX)*ZOHH(L,NY,NX) + ZSO4H(L,NY,NX)=XCORP(NY,NX)*ZSO4H(L,NY,NX) + ZCLH(L,NY,NX)=XCORP(NY,NX)*ZCLH(L,NY,NX) + ZCO3H(L,NY,NX)=XCORP(NY,NX)*ZCO3H(L,NY,NX) + ZHCO3H(L,NY,NX)=XCORP(NY,NX)*ZHCO3H(L,NY,NX) + ZALO1H(L,NY,NX)=XCORP(NY,NX)*ZALO1H(L,NY,NX) + ZALO2H(L,NY,NX)=XCORP(NY,NX)*ZALO2H(L,NY,NX) + ZALO3H(L,NY,NX)=XCORP(NY,NX)*ZALO3H(L,NY,NX) + ZALO4H(L,NY,NX)=XCORP(NY,NX)*ZALO4H(L,NY,NX) + ZALSH(L,NY,NX)=XCORP(NY,NX)*ZALSH(L,NY,NX) + ZFEO1H(L,NY,NX)=XCORP(NY,NX)*ZFEO1H(L,NY,NX) + ZFEO2H(L,NY,NX)=XCORP(NY,NX)*ZFEO2H(L,NY,NX) + ZFEO3H(L,NY,NX)=XCORP(NY,NX)*ZFEO3H(L,NY,NX) + ZFEO4H(L,NY,NX)=XCORP(NY,NX)*ZFEO4H(L,NY,NX) + ZFESH(L,NY,NX)=XCORP(NY,NX)*ZFESH(L,NY,NX) + ZCAOH(L,NY,NX)=XCORP(NY,NX)*ZCAOH(L,NY,NX) + ZCACH(L,NY,NX)=XCORP(NY,NX)*ZCACH(L,NY,NX) + ZCAHH(L,NY,NX)=XCORP(NY,NX)*ZCAHH(L,NY,NX) + ZCASH(L,NY,NX)=XCORP(NY,NX)*ZCASH(L,NY,NX) + ZMGOH(L,NY,NX)=XCORP(NY,NX)*ZMGOH(L,NY,NX) + ZMGCH(L,NY,NX)=XCORP(NY,NX)*ZMGCH(L,NY,NX) + ZMGHH(L,NY,NX)=XCORP(NY,NX)*ZMGHH(L,NY,NX) + ZMGSH(L,NY,NX)=XCORP(NY,NX)*ZMGSH(L,NY,NX) + ZNACH(L,NY,NX)=XCORP(NY,NX)*ZNACH(L,NY,NX) + ZNASH(L,NY,NX)=XCORP(NY,NX)*ZNASH(L,NY,NX) + ZKASH(L,NY,NX)=XCORP(NY,NX)*ZKASH(L,NY,NX) + H0PO4H(L,NY,NX)=XCORP(NY,NX)*H0PO4H(L,NY,NX) + H3PO4H(L,NY,NX)=XCORP(NY,NX)*H3PO4H(L,NY,NX) + ZFE1PH(L,NY,NX)=XCORP(NY,NX)*ZFE1PH(L,NY,NX) + ZFE2PH(L,NY,NX)=XCORP(NY,NX)*ZFE2PH(L,NY,NX) + ZCA0PH(L,NY,NX)=XCORP(NY,NX)*ZCA0PH(L,NY,NX) + ZCA1PH(L,NY,NX)=XCORP(NY,NX)*ZCA1PH(L,NY,NX) + ZCA2PH(L,NY,NX)=XCORP(NY,NX)*ZCA2PH(L,NY,NX) + ZMG1PH(L,NY,NX)=XCORP(NY,NX)*ZMG1PH(L,NY,NX) + H0POBH(L,NY,NX)=XCORP(NY,NX)*H0POBH(L,NY,NX) + H1POBH(L,NY,NX)=XCORP(NY,NX)*H1POBH(L,NY,NX) + H3POBH(L,NY,NX)=XCORP(NY,NX)*H3POBH(L,NY,NX) + ZFE1BH(L,NY,NX)=XCORP(NY,NX)*ZFE1BH(L,NY,NX) + ZFE2BH(L,NY,NX)=XCORP(NY,NX)*ZFE2BH(L,NY,NX) + ZCA0BH(L,NY,NX)=XCORP(NY,NX)*ZCA0BH(L,NY,NX) + ZCA1BH(L,NY,NX)=XCORP(NY,NX)*ZCA1BH(L,NY,NX) + ZCA2BH(L,NY,NX)=XCORP(NY,NX)*ZCA2BH(L,NY,NX) + ZMG1BH(L,NY,NX)=XCORP(NY,NX)*ZMG1BH(L,NY,NX) + CO2SH(L,NY,NX)=XCORP(NY,NX)*CO2SH(L,NY,NX) + CH4SH(L,NY,NX)=XCORP(NY,NX)*CH4SH(L,NY,NX) + 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) + DO 5965 K=0,5 + DO 5965 N=1,7 + DO 5965 M=1,3 + OMC(M,N,K,L,NY,NX)=TI*OMC(M,N,K,L,NY,NX)+CORP*(FI*TOMC(M,N,K) + 2-TI*OMC(M,N,K,L,NY,NX))+TX*OMC(M,N,K,L,NY,NX) + OMN(M,N,K,L,NY,NX)=TI*OMN(M,N,K,L,NY,NX)+CORP*(FI*TOMN(M,N,K) + 2-TI*OMN(M,N,K,L,NY,NX))+TX*OMN(M,N,K,L,NY,NX) + OMP(M,N,K,L,NY,NX)=TI*OMP(M,N,K,L,NY,NX)+CORP*(FI*TOMP(M,N,K) + 2-TI*OMP(M,N,K,L,NY,NX))+TX*OMP(M,N,K,L,NY,NX) +5965 CONTINUE + DO 5980 K=0,4 + DO 5975 M=1,2 + ORC(M,K,L,NY,NX)=TI*ORC(M,K,L,NY,NX)+CORP*(FI*TORC(M,K) + 2-TI*ORC(M,K,L,NY,NX))+TX*ORC(M,K,L,NY,NX) + ORN(M,K,L,NY,NX)=TI*ORN(M,K,L,NY,NX)+CORP*(FI*TORN(M,K) + 2-TI*ORN(M,K,L,NY,NX))+TX*ORN(M,K,L,NY,NX) + ORP(M,K,L,NY,NX)=TI*ORP(M,K,L,NY,NX)+CORP*(FI*TORP(M,K) + 2-TI*ORP(M,K,L,NY,NX))+TX*ORP(M,K,L,NY,NX) +5975 CONTINUE + OQC(K,L,NY,NX)=TI*OQC(K,L,NY,NX)+CORP*(FI*TOQC(K) + 2-TI*OQC(K,L,NY,NX))+TX*OQC(K,L,NY,NX)+CORP*OQCH(K,L,NY,NX) + OQN(K,L,NY,NX)=TI*OQN(K,L,NY,NX)+CORP*(FI*TOQN(K) + 2-TI*OQN(K,L,NY,NX))+TX*OQN(K,L,NY,NX)+CORP*OQNH(K,L,NY,NX) + OQP(K,L,NY,NX)=TI*OQP(K,L,NY,NX)+CORP*(FI*TOQP(K) + 2-TI*OQP(K,L,NY,NX))+TX*OQP(K,L,NY,NX)+CORP*OQPH(K,L,NY,NX) + OQA(K,L,NY,NX)=TI*OQA(K,L,NY,NX)+CORP*(FI*TOQA(K) + 2-TI*OQA(K,L,NY,NX))+TX*OQA(K,L,NY,NX)+CORP*OQAH(K,L,NY,NX) + OQCH(K,L,NY,NX)=XCORP(NY,NX)*OQCH(K,L,NY,NX) + OQNH(K,L,NY,NX)=XCORP(NY,NX)*OQNH(K,L,NY,NX) + OQPH(K,L,NY,NX)=XCORP(NY,NX)*OQPH(K,L,NY,NX) + OQAH(K,L,NY,NX)=XCORP(NY,NX)*OQAH(K,L,NY,NX) + OHC(K,L,NY,NX)=TI*OHC(K,L,NY,NX)+CORP*(FI*TOHC(K) + 2-TI*OHC(K,L,NY,NX))+TX*OHC(K,L,NY,NX) + OHN(K,L,NY,NX)=TI*OHN(K,L,NY,NX)+CORP*(FI*TOHN(K) + 2-TI*OHN(K,L,NY,NX))+TX*OHN(K,L,NY,NX) + OHP(K,L,NY,NX)=TI*OHP(K,L,NY,NX)+CORP*(FI*TOHP(K) + 2-TI*OHP(K,L,NY,NX))+TX*OHP(K,L,NY,NX) + OHA(K,L,NY,NX)=TI*OHA(K,L,NY,NX)+CORP*(FI*TOHA(K) + 2-TI*OHA(K,L,NY,NX))+TX*OHA(K,L,NY,NX) + DO 5970 M=1,4 + OSC(M,K,L,NY,NX)=TI*OSC(M,K,L,NY,NX)+CORP*(FI*TOSC(M,K) + 2-TI*OSC(M,K,L,NY,NX))+TX*OSC(M,K,L,NY,NX) + OSA(M,K,L,NY,NX)=TI*OSA(M,K,L,NY,NX)+CORP*(FI*TOSA(M,K) + 2-TI*OSA(M,K,L,NY,NX))+TX*OSA(M,K,L,NY,NX) + OSN(M,K,L,NY,NX)=TI*OSN(M,K,L,NY,NX)+CORP*(FI*TOSN(M,K) + 2-TI*OSN(M,K,L,NY,NX))+TX*OSN(M,K,L,NY,NX) + OSP(M,K,L,NY,NX)=TI*OSP(M,K,L,NY,NX)+CORP*(FI*TOSP(M,K) + 2-TI*OSP(M,K,L,NY,NX))+TX*OSP(M,K,L,NY,NX) +5970 CONTINUE +5980 CONTINUE +C +C ADD STATE VARIABLES IN SURFACE RESIDUE INCORPORATED +C WITHIN TILLAGE MIXING ZONE +C + DO 5910 K=0,5 + IF(K.NE.3.AND.K.NE.4)THEN + DO 5915 N=1,7 + DO 5915 M=1,3 + OMC(M,N,K,L,NY,NX)=OMC(M,N,K,L,NY,NX)+FI*TOMGC(M,N,K) + OMN(M,N,K,L,NY,NX)=OMN(M,N,K,L,NY,NX)+FI*TOMGN(M,N,K) + OMP(M,N,K,L,NY,NX)=OMP(M,N,K,L,NY,NX)+FI*TOMGP(M,N,K) +5915 CONTINUE + ENDIF +5910 CONTINUE + DO 5920 K=0,2 + DO 5925 M=1,2 + ORC(M,K,L,NY,NX)=ORC(M,K,L,NY,NX)+FI*TORXC(M,K) + ORN(M,K,L,NY,NX)=ORN(M,K,L,NY,NX)+FI*TORXN(M,K) + ORP(M,K,L,NY,NX)=ORP(M,K,L,NY,NX)+FI*TORXP(M,K) +5925 CONTINUE + OQC(K,L,NY,NX)=OQC(K,L,NY,NX)+FI*TOQGC(K) + OQN(K,L,NY,NX)=OQN(K,L,NY,NX)+FI*TOQGN(K) + OQP(K,L,NY,NX)=OQP(K,L,NY,NX)+FI*TOQGP(K) + OQA(K,L,NY,NX)=OQA(K,L,NY,NX)+FI*TOQGA(K) + OQCH(K,L,NY,NX)=OQCH(K,L,NY,NX)+FI*TOQHC(K) + OQNH(K,L,NY,NX)=OQNH(K,L,NY,NX)+FI*TOQHN(K) + OQPH(K,L,NY,NX)=OQPH(K,L,NY,NX)+FI*TOQHP(K) + OQAH(K,L,NY,NX)=OQAH(K,L,NY,NX)+FI*TOQHA(K) + OHC(K,L,NY,NX)=OHC(K,L,NY,NX)+FI*TOHGC(K) + OHN(K,L,NY,NX)=OHN(K,L,NY,NX)+FI*TOHGN(K) + OHP(K,L,NY,NX)=OHP(K,L,NY,NX)+FI*TOHGP(K) + OHA(K,L,NY,NX)=OHA(K,L,NY,NX)+FI*TOHGA(K) + DO 5930 M=1,4 + OSC(M,K,L,NY,NX)=OSC(M,K,L,NY,NX)+FI*TOSGC(M,K) + OSA(M,K,L,NY,NX)=OSA(M,K,L,NY,NX)+FI*TOSGA(M,K) + OSN(M,K,L,NY,NX)=OSN(M,K,L,NY,NX)+FI*TOSGN(M,K) + OSP(M,K,L,NY,NX)=OSP(M,K,L,NY,NX)+FI*TOSGP(M,K) +5930 CONTINUE +5920 CONTINUE + OC=0.0 + ON=0.0 + OP=0.0 + RC=0.0 + DO 5985 K=0,5 + DO 5985 N=1,7 + DO 5985 M=1,3 + OC=OC+OMC(M,N,K,L,NY,NX) + ON=ON+OMN(M,N,K,L,NY,NX) + OP=OP+OMP(M,N,K,L,NY,NX) + IF(K.LE.2)THEN + RC=RC+OMC(M,N,K,L,NY,NX) + ENDIF +5985 CONTINUE + DO 6995 K=0,4 + DO 6985 M=1,2 + OC=OC+ORC(M,K,L,NY,NX) + ON=ON+ORN(M,K,L,NY,NX) + OP=OP+ORP(M,K,L,NY,NX) + IF(K.LE.2)THEN + RC=RC+ORC(M,K,L,NY,NX) + ENDIF +6985 CONTINUE + OC=OC+OQC(K,L,NY,NX)+OQCH(K,L,NY,NX)+OHC(K,L,NY,NX) + 2+OQA(K,L,NY,NX)+OQAH(K,L,NY,NX)+OHA(K,L,NY,NX) + ON=ON+OQN(K,L,NY,NX)+OQNH(K,L,NY,NX)+OHN(K,L,NY,NX) + OP=OP+OQP(K,L,NY,NX)+OQPH(K,L,NY,NX)+OHP(K,L,NY,NX) + IF(K.LE.2)THEN + RC=RC+OQC(K,L,NY,NX)+OQCH(K,L,NY,NX)+OHC(K,L,NY,NX) + 2+OQA(K,L,NY,NX)+OQAH(K,L,NY,NX)+OHA(K,L,NY,NX) + ENDIF + DO 6980 M=1,4 + OC=OC+OSC(M,K,L,NY,NX) + ON=ON+OSN(M,K,L,NY,NX) + OP=OP+OSP(M,K,L,NY,NX) + IF(K.LE.2)THEN + RC=RC+OSC(M,K,L,NY,NX) + ENDIF +6980 CONTINUE +6995 CONTINUE + ORGC(L,NY,NX)=OC + ORGN(L,NY,NX)=ON + ORGR(L,NY,NX)=RC + CO2S(L,NY,NX)=CO2S(L,NY,NX)+FI*TCO2GS + CH4S(L,NY,NX)=CH4S(L,NY,NX)+FI*TCH4GS + OXYS(L,NY,NX)=OXYS(L,NY,NX)+FI*TOXYGS + Z2GS(L,NY,NX)=Z2GS(L,NY,NX)+FI*TZ2GSG + Z2OS(L,NY,NX)=Z2OS(L,NY,NX)+FI*TZ2OGS + H2GS(L,NY,NX)=H2GS(L,NY,NX)+FI*TH2GGS + ZNH4S(L,NY,NX)=ZNH4S(L,NY,NX)+FI*TNH4GS + ZNH3S(L,NY,NX)=ZNH3S(L,NY,NX)+FI*TNH3GS + ZNO3S(L,NY,NX)=ZNO3S(L,NY,NX)+FI*TNO3GS + ZNO2S(L,NY,NX)=ZNO2S(L,NY,NX)+FI*TNO2GS + H1PO4(L,NY,NX)=H1PO4(L,NY,NX)+FI*TP14GS + H2PO4(L,NY,NX)=H2PO4(L,NY,NX)+FI*TPO4GS + XN4(L,NY,NX)=XN4(L,NY,NX)+FI*TXN4G + XOH0(L,NY,NX)=XOH0(L,NY,NX)+FI*TXOH0G + XOH1(L,NY,NX)=XOH1(L,NY,NX)+FI*TXOH1G + XOH2(L,NY,NX)=XOH2(L,NY,NX)+FI*TXOH2G + XH1P(L,NY,NX)=XH1P(L,NY,NX)+FI*TXH1PG + XH2P(L,NY,NX)=XH2P(L,NY,NX)+FI*TXH2PG + PALPO(L,NY,NX)=PALPO(L,NY,NX)+FI*TALPOG + PFEPO(L,NY,NX)=PFEPO(L,NY,NX)+FI*TFEPOG + PCAPD(L,NY,NX)=PCAPD(L,NY,NX)+FI*TCAPDG + PCAPH(L,NY,NX)=PCAPH(L,NY,NX)+FI*TCAPHG + PCAPM(L,NY,NX)=PCAPM(L,NY,NX)+FI*TCAPMG + ZNH4FA(L,NY,NX)=ZNH4FA(L,NY,NX)+FI*TNH4FG + 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 + ZNFN0(L,NY,NX)=ZNFNX0 +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 + IFLGS(NY,NX)=1 + ENDIF +C +C CHECK MATERIAL BALANCES +C + IF(I.EQ.365.AND.J.EQ.24)THEN + WRITE(19,2221)'ORGC',I,J,IYRC,NX,NY + 2,(ORGC(L,NY,NX)/AREA(3,L,NY,NX),L=0,NL(NY,NX)) + WRITE(20,2221)'ORGN',I,J,IYRC,NX,NY + 2,(ORGN(L,NY,NX)/AREA(3,L,NY,NX),L=0,NL(NY,NX)) +2221 FORMAT(A8,5I4,21E12.4) + ENDIF +C IF(I.EQ.365.AND.J.EQ.24)THEN +C WRITE(20,2221)'OMCL',I,J,IYRC,NX,NY,(OMCL(L,NY,NX),L=0,NL(NY,NX)) +C WRITE(20,2221)'OMNL',I,J,IYRC,NX,NY,(OMNL(L,NY,NX),L=0,NL(NY,NX)) +C WRITE(20,2222)'TLC',I,J,IYRC,NX,NY,TLRSDC+TLORGC+TLCO2G-CO2GIN +C 2+TCOU-TORGF-XCSN,TLRSDC,TLORGC,TLCO2G,CO2GIN,TCOU,TORGF,XCSN +C 5,XCODFS(NY,NX),XCOFLG(3,NU(NY,NX),NY,NX),TCO2Z(NY,NX) +C 2,FLQGQ(NY,NX)*CCOR(NY,NX),FLQGI(NY,NX)*CCOQ(NY,NX),XCODFG(0,NY,NX) +C 3,XCODFR(NY,NX),XCHDFS(NY,NX),XCHFLG(3,NU(NY,NX),NY,NX) +C 2,FLQGQ(NY,NX)*CCHR(NY,NX),FLQGI(NY,NX)*CCHQ(NY,NX),XCHDFG(0,NY,NX) +C 3,XCHDFR(NY,NX),PRECU(NY,NX)*CCOQ(NY,NX),PRECU(NY,NX)*CCHQ(NY,NX) +C 6,TCOQRS(NY,NX),TCHQRS(NY,NX),XCOFLS(1,0,NY,NX+1) +C 7,XCOFLS(2,0,NY+1,NX) +C 3,UCOP(NY,NX),UDOCQ(NY,NX),UDICQ(NY,NX),UDOCD(NY,NX),UDICD(NY,NX) +C 2,(((CSNT(M,K,L,NY,NX),M=1,4),K=0,1),L=0,NJ(NY,NX)) +C 3,(TCO2P(L,NY,NX),L=1,NJ(NY,NX)),(TCO2S(L,NY,NX),L=1,NJ(NY,NX)) +C 4,CQ,ZCSNC(NY,NX) +C WRITE(20,2222)'TLW',I,J,IYRC,NX,NY,VOLWSO-CRAIN+CRUN+CEVAP+VOLWOU +C 2,VOLWSO,CRAIN,CRUN,CEVAP,VOLWOU,(TUPWTR(L,NY,NX),L=1,JZ) +C 3,TVOLWC(NY,NX),TVOLWP(NY,NX),VOLW(0,NY,NX),VOLI(0,NY,NX)*DENSI +C 4,TFLWC(NY,NX),TEVAPC(NY,NX),TEVAPG(NY,NX),TEVAPP(NY,NX) +C 5,VOLSS(NY,NX),VOLWS(NY,NX),VOLIS(NY,NX)*DENSI,TQS(NY,NX) +C 6,TQW(NY,NX),TQI(NY,NX),TFLWS(NY,NX),TFLWW(NY,NX),TFLWI(NY,NX) +C 7,TVOLWC(NY,NX),TVOLWP(NY,NX) +C WRITE(19,2222)'TLH',I,J,IYRC,NX,NY,HEATSO-HEATIN+HEATOU +C 2,HEATSO,HEATIN,HEATOU,HTHAWR(NY,NX),HFLXD,4.19*TKA(NY,NX) +C 3,2.095*TKA(NY,NX)*PRECW(NY,NX),HEATH(NY,NX),HTHAWW(NY,NX) +C 4,THFLXC(NY,NX),(THTHAW(L,NY,NX),L=NU(NY,NX),NL(NY,NX)) +C 5,(VHCP(L,NY,NX)*TKS(L,NY,NX),L=NU(NY,NX),NL(NY,NX)) +C 5,4.19*TKA(NY,NX)*PRECU(NY,NX),TENGYC(NY,NX),ENGYR +C 6,VHCPW(NY,NX)*TKW(NY,NX),VHCPR(NY,NX)*TKS(0,NY,NX) +C WRITE(19,2222)'TLO',I,J,IYRC,NX,NY,OXYGSO-OXYGIN+OXYGOU,OXYGSO +C 2,OXYGIN,OXYGOU,XOXDFS(NY,NX),XOXFLG(3,NU(NY,NX),NY,NX) +C 3,XOXDFG(0,NY,NX),TOXYZ(NY,NX),FLQGQ(NY,NX)*COXR(NY,NX) +C 4,FLQGI(NY,NX)*COXQ +C 2,PRECU(NY,NX)*COXQ,(RUPOXO(L,NY,NX),L=1,NJ(NY,NX)) +C 3,(TUPOXP(L,NY,NX),L=1,NJ(NY,NX)),(TOXFLA(L,NY,NX),L=1,NJ(NY,NX)) +C WRITE(20,2222)'TLN',I,J,IYRC,NX,NY,TLRSDN+TLORGN+TLN2G+TLNH4 +C 2+TLNO3-ZN2GIN-TZIN+TZOU-TORGN-XZSN,TLRSDN,TLORGN,TLN2G,TLNH4 +C 3,TLNO3,ZN2GIN,TZIN,TZOU,TORGN,XZSN,PRECQ(NY,NX),PRECR(NY,NX) +C 4,PRECW(NY,NX),PRECI(NY,NX),FLQGM(NY,NX),FLQRM(NY,NX) +C 5,(XN4(L,NY,NX),L=0,NL(NY,NX)) +C 4,(((ZSNT(M,K,L,NY,NX),M=1,4),K=0,1),L=0,JZ) +C 5,(TUPNH4(L,NY,NX),L=1,JZ) +C 6,(TUPNO3(L,NY,NX),L=1,JZ),(TNHFLA(L,NY,NX),L=1,JZ) +C 7,XN3DFS(NY,NX),XNBDFS(NY,NX) +C 8,XN3FLG(3,NU(NY,NX),NY,NX),TNH3Z(NY,NX),UN2GS(NY,NX) +C 9,(XN2GS(L,NY,NX),L=0,JZ) +C WRITE(20,2222)'TLP',I,J,IYRC,NX,NY,TLRSDP+TLORGP +C 2+TLPO4-TPIN+TPOU-TORGP-XPSN,TLRSDP,TLORGP +C 2,TLPO4,TPIN,TPOU,TORGP,XPSN,Z1PW(NY,NX),ZHPW(NY,NX) +C 3,(H1PO4(L,NY,NX),L=0,JZ),(H2PO4(L,NY,NX),L=0,JZ) +C 4,(H1PO4H(L,NY,NX),L=1,JZ),(H2PO4H(L,NY,NX),L=1,JZ) +C 6,FLQGQ(NY,NX),FLQRQ(NY,NX),CPOR(NY,NX),CH1PR(NY,NX) +C 7,FLQGI(NY,NX),FLQRI(NY,NX),CPOQ(I,NY,NX),CH1PQ(I,NY,NX) +C WRITE(20,2222)'TLI',I,J,IYRC,NX,NY,TION-TIONIN+TIONOU +C 2,TION,TIONIN,TIONOU +C 3,PRECQ(NY,NX),XHGDFS(NY,NX),XHGFLG(3,NU(NY,NX),NY,NX) +C 4,TH2GZ(NY,NX) +C 4,(XHGQRS(N,NY,NX),N=1,2),(RH2GO(L,NY,NX),L=1,JZ) +C 5,(THGFLA(L,NY,NX),L=1,JZ),H2GW(NY,NX),(H2GS(L,NY,NX),L=1,JZ) +C 6,(H2GG(L,NY,NX),L=1,JZ),(TLH2GP(L,NY,NX),L=1,JZ) +C WRITE(20,2224)'TLG',I,J,IYRC,NX,NY,TLH2G-H2GIN+H2GOU,TLH2G +C 2,H2GIN,H2GOU,(H2GG(L,NY,NX),L=0,NJ(NY,NX)) +C 3,(H2GS(L,NY,NX),L=0,NJ(NY,NX)) +C 3,(H2GSH(L,NY,NX),L=1,NJ(NY,NX)),(TLH2GP(L,NY,NX),L=1,NJ(NY,NX)) +C 4,XHGDFS(NY,NX),TH2GZ(NY,NX),(THGFLA(L,NY,NX),L=1,NJ(NY,NX)) +C 2,XHGDFG(0,NY,NX),XHGDFR(NY,NX),(XHGBBL(L,NY,NX),L=1,NJ(NY,NX)) +C 3,(RH2GO(L,NY,NX),L=0,NJ(NY,NX)),(TUPHGS(L,NY,NX),L=1,NJ(NY,NX)) +C 4,(XHGQRS(N,NY,NX),N=1,2),((XHGFLS(N,L,NY,NX),N=1,3),L=0,NJ(NY,NX)) +C 5,((XHGFHS(N,L,NY,NX),N=1,3),L=0,NJ(NY,NX)) +C 6,((XHGFLG(N,L,NY,NX),N=1,3),L=0,NJ(NY,NX)) +C WRITE(*,2223)'TLS',I,J,IYRC,NX,NY,NU(NY,NX),TSEDSO+TSEDOU +C 2,TSEDSO,TSEDOU,USEDOU(NY,NX),DLYR(3,NU(NY,NX),NY,NX) +C 3,BKVL(NU(NY,NX),NY,NX),SAND(NU(NY,NX),NY,NX) +C 4,SILT(NU(NY,NX),NY,NX),CLAY(NU(NY,NX),NY,NX) +C 5,ORGC(NU(NY,NX),NY,NX) +2222 FORMAT(A8,5I6,240F17.10) +2223 FORMAT(A8,6I6,160F16.9) +2224 FORMAT(A8,5I6,160F16.9) +C ENDIF +9990 CONTINUE +9995 CONTINUE + RETURN + END + + diff --git a/f77src/routp.f b/f77src/routp.f index aaccacf..8ddfa88 100755 --- a/f77src/routp.f +++ b/f77src/routp.f @@ -231,9 +231,11 @@ SUBROUTINE routp(NHW,NHE,NVN,NVS) READ(29,94)IDATE,IYR,NZ,(RUNNHP(N,L,NZ,NY,NX),L=1,NJ(NY,NX)) READ(29,94)IDATE,IYR,NZ,(RUNNOP(N,L,NZ,NY,NX),L=1,NJ(NY,NX)) READ(29,94)IDATE,IYR,NZ,(RUPPOP(N,L,NZ,NY,NX),L=1,NJ(NY,NX)) + READ(29,94)IDATE,IYR,NZ,(RUPP1P(N,L,NZ,NY,NX),L=1,NJ(NY,NX)) READ(29,94)IDATE,IYR,NZ,(RUNNBP(N,L,NZ,NY,NX),L=1,NJ(NY,NX)) READ(29,94)IDATE,IYR,NZ,(RUNNXP(N,L,NZ,NY,NX),L=1,NJ(NY,NX)) READ(29,94)IDATE,IYR,NZ,(RUPPBP(N,L,NZ,NY,NX),L=1,NJ(NY,NX)) + READ(29,94)IDATE,IYR,NZ,(RUPP1B(N,L,NZ,NY,NX),L=1,NJ(NY,NX)) READ(29,94)IDATE,IYR,NZ,(WFR(N,L,NZ,NY,NX),L=1,NJ(NY,NX)) READ(29,94)IDATE,IYR,NZ,(CPOOLR(N,L,NZ,NY,NX),L=1,NJ(NY,NX)) READ(29,94)IDATE,IYR,NZ,(ZPOOLR(N,L,NZ,NY,NX),L=1,NJ(NY,NX)) diff --git a/f77src/routq.f b/f77src/routq.f index 40c4e50..73b96cf 100755 --- a/f77src/routq.f +++ b/f77src/routq.f @@ -19,6 +19,7 @@ SUBROUTINE routq(NT,NE,NAX,NDX,NTX,NEX,NHW,NHE,NVN,NVS) CHARACTER*16 OUTX,OUTC,OUTM,OUTR,OUTQ CHARACTER*4 CHARY CHARACTER*80 PREFIX + CHARACTER*2 CLIMATE C C OPEN CHECKPOINT FILES FOR PLANT VARIABLES C @@ -67,6 +68,16 @@ SUBROUTINE routq(NT,NE,NAX,NDX,NTX,NEX,NHW,NHE,NVN,NVS) 4995 CONTINUE IF(NS.GT.0)THEN READ(14,*)(DATAX(NZ),DATAY(NZ),NZ=1,NS) + DO 4975 NX=NH1,NH2 + DO 4970 NY=NV1,NV2 + DO 4965 NZ=1,NS + IF(IETYP(NY,NX).GT.0)THEN + WRITE(CLIMATE,'(I2)')IETYP(NY,NX) + DATAX(NZ)=DATAX(NZ)(1:4)//CLIMATE + ENDIF +4965 CONTINUE +4970 CONTINUE +4975 CONTINUE ENDIF IF(DATA(20).EQ.'NO')THEN DO 8995 NX=NH1,NH2 diff --git a/f77src/routs.f b/f77src/routs.f index fce6f81..8048340 100755 --- a/f77src/routs.f +++ b/f77src/routs.f @@ -61,7 +61,6 @@ SUBROUTINE routs(NHW,NHE,NVN,NVS) 8000 READ(21,90,END=1001)IDATE,IYR,CRAIN,TSEDOU 2,HEATIN,OXYGIN,TORGF,TORGN,TORGP,CO2GIN,ZN2GIN,VOLWOU,CEVAP,CRUN 3,HEATOU,OXYGOU,TCOU,TZOU,TPOU,TZIN,TPIN,XCSN,XZSN,XPSN - 4,TFERTN,TFERTP DO 9995 NX=NHW,NHE DO 9990 NY=NVN,NVS READ(21,95)IDATE,IYR,(TDTPX(NY,NX,N),N=1,12) @@ -76,7 +75,7 @@ SUBROUTINE routs(NHW,NHE,NVN,NVS) 4,TVOLWC(NY,NX),VOLSS(NY,NX),VOLWS(NY,NX),VOLIS(NY,NX),VOLS(NY,NX) 5,DPTHS(NY,NX),TCW(NY,NX),TKW(NY,NX),VHCPW(NY,NX),VHCPR(NY,NX) 6,VOLWG(NY,NX),URAIN(NY,NX),ARLFC(NY,NX),ARSTC(NY,NX),PPT(NY,NX) - 7,ZM(NY,NX),UCO2G(NY,NX),UCH4G(NY,NX),UOXYG(NY,NX) + 7,VOLWD(NY,NX),ZM(NY,NX),UCO2G(NY,NX),UCH4G(NY,NX),UOXYG(NY,NX) 8,UN2GG(NY,NX),UN2OG(NY,NX),UNH3G(NY,NX),UN2GS(NY,NX),UCO2F(NY,NX) 9,UCH4F(NY,NX),UOXYF(NY,NX),UN2OF(NY,NX),UNH3F(NY,NX),UPO4F(NY,NX) 1,UORGF(NY,NX),UFERTN(NY,NX),UFERTP(NY,NX),UVOLO(NY,NX) @@ -88,7 +87,7 @@ SUBROUTINE routs(NHW,NHE,NVN,NVS) 7,DPPO4(NY,NX),CO2W(NY,NX),CH4W(NY,NX),OXYW(NY,NX),ZN2W(NY,NX) 8,ZNGW(NY,NX),ZN4W(NY,NX),ZN3W(NY,NX),ZNOW(NY,NX),ZHPW(NY,NX) 9,H2GW(NY,NX),DETS(NY,NX),COHS(NY,NX),CER(NY,NX),XER(NY,NX) - 1,USEDOU(NY,NX),ROWN(NY,NX),ROWO(NY,NX),ROWP(NY,NX) + 1,USEDOU(NY,NX),ROWN(NY,NX),ROWO(NY,NX),ROWP(NY,NX),Z1PW(NY,NX) 2,DTBLZ(NY,NX),DDRG(NY,NX),TNBP(NY,NX),VOLR(NY,NX),SED(NY,NX) 3,TGPP(NY,NX),TRAU(NY,NX),TNPP(NY,NX),THRE(NY,NX) 4,TLEC(NY,NX),TSHC(NY,NX),DYLN(NY,NX),DYLX(NY,NX) @@ -102,7 +101,7 @@ SUBROUTINE routs(NHW,NHE,NVN,NVS) 7,ZFEH4W(NY,NX),ZFESW(NY,NX),ZCAOW(NY,NX),ZCACW(NY,NX) 8,ZCAHW(NY,NX),ZCASW(NY,NX),ZMGOW(NY,NX),ZMGCW(NY,NX),ZMGHW(NY,NX) 9,ZMGSW(NY,NX),ZNACW(NY,NX),ZNASW(NY,NX),ZKASW(NY,NX),H0PO4W(NY,NX) - 1,H1PO4W(NY,NX),H3PO4W(NY,NX),ZFE1PW(NY,NX),ZFE2PW(NY,NX) + 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)) @@ -160,10 +159,12 @@ SUBROUTINE routs(NHW,NHE,NVN,NVS) READ(21,91)IDATE,IYR,(RNO2X(L,NY,NX),L=0,NL(NY,NX)) READ(21,91)IDATE,IYR,(RN2OX(L,NY,NX),L=0,NL(NY,NX)) READ(21,91)IDATE,IYR,(RPO4X(L,NY,NX),L=0,NL(NY,NX)) + READ(21,91)IDATE,IYR,(RP14X(L,NY,NX),L=0,NL(NY,NX)) READ(21,91)IDATE,IYR,(RNHBX(L,NY,NX),L=0,NL(NY,NX)) READ(21,91)IDATE,IYR,(RN3BX(L,NY,NX),L=0,NL(NY,NX)) READ(21,91)IDATE,IYR,(RN2BX(L,NY,NX),L=0,NL(NY,NX)) READ(21,91)IDATE,IYR,(RPOBX(L,NY,NX),L=0,NL(NY,NX)) + READ(21,91)IDATE,IYR,(RP1BX(L,NY,NX),L=0,NL(NY,NX)) READ(21,95)IDATE,IYR,((ROQCX(K,L,NY,NX),L=0,NL(NY,NX)),K=0,4) READ(21,95)IDATE,IYR,((ROQAX(K,L,NY,NX),L=0,NL(NY,NX)),K=0,4) READ(21,91)IDATE,IYR,(VOLWH(L,NY,NX),L=1,NL(NY,NX)) @@ -239,7 +240,6 @@ SUBROUTINE routs(NHW,NHE,NVN,NVS) READ(21,91)IDATE,IYR,(ZNAS(L,NY,NX),L=1,NL(NY,NX)) READ(21,91)IDATE,IYR,(ZKAS(L,NY,NX),L=1,NL(NY,NX)) READ(21,91)IDATE,IYR,(H0PO4(L,NY,NX),L=1,NL(NY,NX)) - READ(21,91)IDATE,IYR,(H1PO4(L,NY,NX),L=1,NL(NY,NX)) READ(21,91)IDATE,IYR,(H3PO4(L,NY,NX),L=1,NL(NY,NX)) READ(21,91)IDATE,IYR,(ZFE1P(L,NY,NX),L=1,NL(NY,NX)) READ(21,91)IDATE,IYR,(ZFE2P(L,NY,NX),L=1,NL(NY,NX)) @@ -248,7 +248,6 @@ SUBROUTINE routs(NHW,NHE,NVN,NVS) READ(21,91)IDATE,IYR,(ZCA2P(L,NY,NX),L=1,NL(NY,NX)) READ(21,91)IDATE,IYR,(ZMG1P(L,NY,NX),L=1,NL(NY,NX)) READ(21,91)IDATE,IYR,(H0POB(L,NY,NX),L=1,NL(NY,NX)) - READ(21,91)IDATE,IYR,(H1POB(L,NY,NX),L=1,NL(NY,NX)) READ(21,91)IDATE,IYR,(H3POB(L,NY,NX),L=1,NL(NY,NX)) READ(21,91)IDATE,IYR,(ZFE1PB(L,NY,NX),L=1,NL(NY,NX)) READ(21,91)IDATE,IYR,(ZFE2PB(L,NY,NX),L=1,NL(NY,NX)) @@ -290,7 +289,6 @@ SUBROUTINE routs(NHW,NHE,NVN,NVS) READ(21,91)IDATE,IYR,(ZNASH(L,NY,NX),L=1,NL(NY,NX)) READ(21,91)IDATE,IYR,(ZKASH(L,NY,NX),L=1,NL(NY,NX)) READ(21,91)IDATE,IYR,(H0PO4H(L,NY,NX),L=1,NL(NY,NX)) - READ(21,91)IDATE,IYR,(H1PO4H(L,NY,NX),L=1,NL(NY,NX)) READ(21,91)IDATE,IYR,(H3PO4H(L,NY,NX),L=1,NL(NY,NX)) READ(21,91)IDATE,IYR,(ZFE1PH(L,NY,NX),L=1,NL(NY,NX)) READ(21,91)IDATE,IYR,(ZFE2PH(L,NY,NX),L=1,NL(NY,NX)) @@ -299,7 +297,6 @@ SUBROUTINE routs(NHW,NHE,NVN,NVS) READ(21,91)IDATE,IYR,(ZCA2PH(L,NY,NX),L=1,NL(NY,NX)) READ(21,91)IDATE,IYR,(ZMG1PH(L,NY,NX),L=1,NL(NY,NX)) READ(21,91)IDATE,IYR,(H0POBH(L,NY,NX),L=1,NL(NY,NX)) - READ(21,91)IDATE,IYR,(H1POBH(L,NY,NX),L=1,NL(NY,NX)) READ(21,91)IDATE,IYR,(H3POBH(L,NY,NX),L=1,NL(NY,NX)) READ(21,91)IDATE,IYR,(ZFE1BH(L,NY,NX),L=1,NL(NY,NX)) READ(21,91)IDATE,IYR,(ZFE2BH(L,NY,NX),L=1,NL(NY,NX)) @@ -309,6 +306,7 @@ SUBROUTINE routs(NHW,NHE,NVN,NVS) READ(21,91)IDATE,IYR,(ZMG1BH(L,NY,NX),L=1,NL(NY,NX)) READ(21,91)IDATE,IYR,(XHY(L,NY,NX),L=1,NL(NY,NX)) READ(21,91)IDATE,IYR,(XAL(L,NY,NX),L=1,NL(NY,NX)) + READ(21,91)IDATE,IYR,(XFE(L,NY,NX),L=1,NL(NY,NX)) READ(21,91)IDATE,IYR,(XCA(L,NY,NX),L=1,NL(NY,NX)) READ(21,91)IDATE,IYR,(XMG(L,NY,NX),L=1,NL(NY,NX)) READ(21,91)IDATE,IYR,(XNA(L,NY,NX),L=1,NL(NY,NX)) @@ -333,7 +331,7 @@ SUBROUTINE routs(NHW,NHE,NVN,NVS) READ(22,91)IDATE,IYR,(RIPOO(N,K,L,NY,NX),L=0,NL(NY,NX)) READ(22,91)IDATE,IYR,(RINHB(N,K,L,NY,NX),L=0,NL(NY,NX)) READ(22,91)IDATE,IYR,(RINOB(N,K,L,NY,NX),L=0,NL(NY,NX)) - READ(22,91)IDATE,IYR,(RIPOB(N,K,L,NY,NX),L=0,NL(NY,NX)) + READ(22,91)IDATE,IYR,(RIPBO(N,K,L,NY,NX),L=0,NL(NY,NX)) IF(K.NE.5)THEN READ(22,91)IDATE,IYR,(ROQCS(N,K,L,NY,NX),L=0,NL(NY,NX)) READ(22,91)IDATE,IYR,(ROQAS(N,K,L,NY,NX),L=0,NL(NY,NX)) @@ -397,7 +395,9 @@ SUBROUTINE routs(NHW,NHE,NVN,NVS) READ(22,91)IDATE,IYR,(ZNO3SH(L,NY,NX),L=1,NL(NY,NX)) READ(22,91)IDATE,IYR,(ZNO2S(L,NY,NX),L=0,NL(NY,NX)) READ(22,91)IDATE,IYR,(ZNO2SH(L,NY,NX),L=1,NL(NY,NX)) + READ(22,91)IDATE,IYR,(H1PO4(L,NY,NX),L=0,NL(NY,NX)) READ(22,91)IDATE,IYR,(H2PO4(L,NY,NX),L=0,NL(NY,NX)) + READ(22,91)IDATE,IYR,(H1PO4H(L,NY,NX),L=1,NL(NY,NX)) READ(22,91)IDATE,IYR,(H2PO4H(L,NY,NX),L=1,NL(NY,NX)) READ(22,91)IDATE,IYR,(ZNH4B(L,NY,NX),L=0,NL(NY,NX)) READ(22,91)IDATE,IYR,(ZNH4BH(L,NY,NX),L=1,NL(NY,NX)) @@ -407,7 +407,9 @@ SUBROUTINE routs(NHW,NHE,NVN,NVS) READ(22,91)IDATE,IYR,(ZNO3BH(L,NY,NX),L=1,NL(NY,NX)) READ(22,91)IDATE,IYR,(ZNO2B(L,NY,NX),L=0,NL(NY,NX)) READ(22,91)IDATE,IYR,(ZNO2BH(L,NY,NX),L=1,NL(NY,NX)) + READ(22,91)IDATE,IYR,(H1POB(L,NY,NX),L=0,NL(NY,NX)) READ(22,91)IDATE,IYR,(H2POB(L,NY,NX),L=0,NL(NY,NX)) + READ(22,91)IDATE,IYR,(H1POBH(L,NY,NX),L=1,NL(NY,NX)) READ(22,91)IDATE,IYR,(H2POBH(L,NY,NX),L=1,NL(NY,NX)) READ(22,91)IDATE,IYR,(WDNHB(L,NY,NX),L=1,NL(NY,NX)) READ(22,91)IDATE,IYR,(DPNHB(L,NY,NX),L=1,NL(NY,NX)) diff --git a/f77src/solute.f b/f77src/solute.f index 0c4060b..8bec419 100755 --- a/f77src/solute.f +++ b/f77src/solute.f @@ -1,4615 +1,3299 @@ - - SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) -C -C THIS SUBROUTINE CALCULATES ALL SOLUTE TRANSFORMATIONS -C FROM THERMODYNAMIC EQUILIBRIA -C - include "parameters.h" - include "blkc.h" - include "blk2a.h" - include "blk2b.h" - include "blk2c.h" - include "blk8a.h" - include "blk8b.h" - include "blk10.h" - include "blk11a.h" - include "blk11b.h" - include "blk13a.h" - include "blk13b.h" - include "blk13c.h" - include "blk15a.h" - include "blk15b.h" - include "blk18a.h" - include "blk18b.h" - include "blk19a.h" - include "blk19b.h" - include "blk19c.h" - include "blk19d.h" - include "blk21a.h" - include "blk21b.h" -C -C EQUILIBRIUM CONSTANTS -C - DIMENSION RNHUI(2) - PARAMETER (DPH2O=6.5E-09,SYALO=4.0E-21,SYFEO=4.0E-26 - 2,SPCAC=4.0E-03,SPCAS=1.4E+01,SPALP=3.5E-15,SPFEP=3.0E-20 - 3,SPCAM=7.0E+07,SPCAD=1.0E-01,SPCAH=6.4E-32,SXOH2=4.5E-05 - 4,SXOH1=1.1E-06,SYH2P=1.6E+04,SHH2P=SYH2P*DPH2O,SYH1P=1.6E+04 - 5,SHH1P=SYH1P*DPH2O,DPCO2=4.2E-04,DPHCO=5.6E-08 - 6,DPN4=5.7E-07,DPAL1=8.6E-07,DPAL2=1.8E-08,DPAL3=2.0E-04 - 7,DPAL4=8.0E-03,DPALS=0.16,DPFE1=7.1E-10,DPFE2=1.45E-08 - 8,DPFE3=1.15E-04,DPFE4=1.45E-03,DPFES=7.1E-02,DPCAO=12.5 - 9,DPCAC=4.2E-02,DPCAH=13.5,DPCAS=1.2,DPMGO=0.7,DPMGC=0.3 - 1,DPMGH=67.0,DPMGS=2.1,DPNAC=0.45,DPNAS=3.3E+02,DPKAS=5.0E+01 - 2,DPH1P=4.5E-10,DPH2P=6.3E-05,DPH3P=7.1,DPF1P=4.5E-02 - 3,DPF2P=3.7E-03,DPC0P=3.5E-04,DPC1P=1.82,DPC2P=40.0 - 4,DPM1P=1.23,DPCOH=1.0E-02,DPALO=6.3E+04) - PARAMETER (DPCO3=DPCO2*DPHCO,SHALO=SYALO/DPH2O**3 - 2,SYAL1=SYALO/DPAL1,SHAL1=SYAL1/DPH2O**2,SYAL2=SYAL1/DPAL2 - 3,SHAL2=SYAL2/DPH2O,SPAL3=SYAL2/DPAL3,SYAL4=SPAL3/DPAL4 - 4,SHAL4=SYAL4*DPH2O,SHFEO=SYFEO/DPH2O**3,SYFE1=SYFEO/DPFE1 - 5,SHFE1=SYFE1/DPH2O**2,SYFE2=SYFE1/DPFE2,SHFE2=SYFE2/DPH2O - 6,SPFE3=SYFE2/DPFE3,SYFE4=SPFE3/DPFE4,SHFE4=SYFE4*DPH2O - 7,SHCAC1=SPCAC/DPHCO,SYCAC1=SHCAC1*DPH2O,SHCAC2=SHCAC1/DPCO2 - 8,SYCAC2=SHCAC2*DPH2O**2,SHA0P1=SPALP/DPH1P,SYA0P1=SHA0P1*DPH2O - 9,SPA1P1=SYA0P1/DPAL1,SYA2P1=SPA1P1/DPAL2,SHA2P1=SYA2P1*DPH2O - 1,SYA3P1=SYA2P1/DPAL3,SHA3P1=SYA3P1*DPH2O**2,SYA4P1=SYA3P1/DPAL4 - 2,SHA4P1=SYA4P1*DPH2O**3,SHA0P2=SHA0P1/DPH2P - 3,SYA0P2=SHA0P2*DPH2O**2,SYA1P2=SYA0P2/DPAL1,SHA1P2=SYA1P2/DPH2O - 4,SPA2P2=SYA1P2/DPAL2,SYA3P2=SPA2P2/DPAL3,SHA3P2=SYA3P2*DPH2O - 5,SYA4P2=SYA3P2/DPAL4,SHA4P2=SYA4P2*DPH2O**2) - PARAMETER (SHF0P1=SPFEP/DPH1P,SYF0P1=SHF0P1*DPH2O - 2,SPF1P1=SYF0P1/DPFE1,SYF2P1=SPF1P1/DPFE2,SHF2P1=SYF2P1*DPH2O - 3,SYF3P1=SYF2P1/DPFE3,SHF3P1=SYF3P1*DPH2O**2,SYF4P1=SYF3P1/DPFE4 - 4,SHF4P1=SYF4P1*DPH2O**3,SHF0P2=SHF0P1/DPH2P,SYF0P2=SHF0P2*DPH2O**2 - 5,SYF1P2=SYF0P2/DPFE1,SHF1P2=SYF1P2/DPH2O,SPF2P2=SYF1P2/DPFE2 - 6,SYF3P2=SPF2P2/DPFE3,SHF3P2=SYF3P2*DPH2O,SYF4P2=SYF3P2/DPFE4 - 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=5,TPD=1.0E-03,TPDX=TPD/MRXN,TADA=3.3E-01 - 2,TADAX=TADA/MRXN,TADC=3.3E-01,TADCX=TADC/MRXN - 3,TSL=1.0,TSLX=TSL/MRXN) - PARAMETER (DUKM=1.0,DUKI=2.5,A0=1.0,AE=10.0,COOH=2.5E-02 - 2,CCAMX=100.0) - PARAMETER (SPNH4=1.0E-00,SPNH3=1.0E-00,SPNHU=5.0E-01 - 2,SPNO3=1.0E-00,SPPO4=5.0E-03) - DATA RNHUI/5.0E-03,5.0E-04/ -C -C DUKM FROM SOIL SCI 136:56 -C - NPI=INT(NPH/2) - DO 9995 NX=NHW,NHE - DO 9990 NY=NVN,NVS - DO 9985 L=NU(NY,NX),NL(NY,NX) - IF(THETW(L,NY,NX).GT.ZEROS(NY,NX))THEN -C -C WATER VOLUME IN NON-BAND AND BAND SOIL ZONES -C - VOLWNH=VOLWM(NPH,L,NY,NX)*VLNH4(L,NY,NX) - VOLWNB=VOLWM(NPH,L,NY,NX)*VLNHB(L,NY,NX) - VOLWNO=VOLWM(NPH,L,NY,NX)*VLNO3(L,NY,NX) - VOLWNZ=VOLWM(NPH,L,NY,NX)*VLNOB(L,NY,NX) - VOLWPO=VOLWM(NPH,L,NY,NX)*VLPO4(L,NY,NX) - VOLWPB=VOLWM(NPH,L,NY,NX)*VLPOB(L,NY,NX) -C -C UREA HYDROLYSIS IN BAND AND NON-BAND SOIL ZONES -C - IF(VOLQ(L,NY,NX).GT.ZEROS(NY,NX))THEN - COMA=AMIN1(0.1E+06,TOQCK(L,NY,NX)/VOLQ(L,NY,NX)) - ELSE - COMA=0.1E+06 - ENDIF - DUKD=DUKM*(1.0+COMA/DUKI) -C -C UREA HYDROLYSIS INHIBITION -C - IF(ZNHU0(L,NY,NX).GT.ZEROS(NY,NX) - 2.AND.ZNHUI(L,NY,NX).GT.ZEROS(NY,NX))THEN - ZNHUI(L,NY,NX)=ZNHUI(L,NY,NX) - 2-RNHUI(IUTYP(NY,NX))*ZNHUI(L,NY,NX) - 3*AMAX1(RNHUI(IUTYP(NY,NX)),1.0-ZNHUI(L,NY,NX)/ZNHU0(L,NY,NX)) - ELSE - ZNHUI(L,NY,NX)=0.0 - ENDIF -C -C UREA CONCENTRATION AND HYDROLYSIS IN NON-BAND -C - 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) - 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) - 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 4,RNHUI(IUTYP(NY,NX)) -8888 FORMAT(A8,4I4,40E12.4) -C ENDIF -C -C NH4, NH3, UREA, NO3 DISSOLUTION IN BAND AND NON-BAND -C SOIL ZONES FROM FIRST-ORDER FUNCTIONS OF REMAINING -C FERTILIZER (NOTE: SUPERPHOSPHATE AND ROCK PHOSPHATE -C ARE REPRESENTED AS MONOCALCIUM PHOSPHATE AND HYDROXYAPATITE -C MODELLED IN PHOSPHORUS REACTIONS BELOW) -C - RSN4AA=SPNH4*ZNH4FA(L,NY,NX)*VLNH4(L,NY,NX) - 2*THETW(L,NY,NX) - RSN3AA=SPNH3*ZNH3FA(L,NY,NX)*VLNH4(L,NY,NX) - RSNUAA=RSNUA*VLNH4(L,NY,NX)*THETW(L,NY,NX) - RSNOAA=SPNO3*ZNO3FA(L,NY,NX)*VLNO3(L,NY,NX) - 2*THETW(L,NY,NX) - RSN4BA=SPNH4*ZNH4FA(L,NY,NX)*VLNHB(L,NY,NX) - 2*THETW(L,NY,NX) - RSN3BA=SPNH3*ZNH3FA(L,NY,NX)*VLNHB(L,NY,NX) - RSNUBA=RSNUA*VLNHB(L,NY,NX)*THETW(L,NY,NX) - RSNOBA=SPNO3*ZNO3FA(L,NY,NX)*VLNOB(L,NY,NX) - 2*THETW(L,NY,NX) - RSN4BB=SPNH4*ZNH4FB(L,NY,NX)*THETW(L,NY,NX) - RSN3BB=SPNH3*ZNH3FB(L,NY,NX) - RSNUBB=RSNUB*VLNHB(L,NY,NX)*THETW(L,NY,NX) - RSNOBB=SPNO3*ZNO3FB(L,NY,NX)*THETW(L,NY,NX) -C -C SOLUBLE AND EXCHANGEABLE NH4 CONCENTRATIONS -C IN NON-BAND AND BAND SOIL ZONES -C - IF(VOLWNH.GT.ZEROS(NY,NX))THEN - VOLWNX=14.0*VOLWNH - RN4X=(-TUPNH4(L,NY,NX)+XNH4S(L,NY,NX)+14.0*RSN4AA)/VOLWNX - RN3X=(-TUPN3S(L,NY,NX)+14.0*RSNUAA)/VOLWNX - CN41=AMAX1(0.0,ZNH4S(L,NY,NX)/VOLWNX+RN4X) - CN31=AMAX1(0.0,ZNH3S(L,NY,NX)/VOLWNX+RN3X) - XN41=AMAX1(0.0,XN4(L,NY,NX)/VOLWNH) - ELSE - RN4X=0.0 - RN3X=0.0 - CN41=0.0 - CN31=0.0 - XN41=0.0 - ENDIF - IF(VOLWNB.GT.ZEROS(NY,NX))THEN - VOLWNX=14.0*VOLWNB - RNBX=(-TUPNHB(L,NY,NX)+XNH4B(L,NY,NX)+14.0*(RSN4BA+RSN4BB)) - 2/VOLWNX - R3BX=(-TUPN3B(L,NY,NX)+14.0*(RSNUBA+RSNUBB)) - 2/VOLWNX - CN4B=AMAX1(0.0,ZNH4B(L,NY,NX)/VOLWNX+RNBX) - CN3B=AMAX1(0.0,ZNH3B(L,NY,NX)/VOLWNX+R3BX) - XN4B=AMAX1(0.0,XNB(L,NY,NX)/VOLWNB) - ELSE - RNBX=0.0 - R3BX=0.0 - CN4B=0.0 - CN3B=0.0 - XN4B=0.0 - ENDIF -C WRITE(*,4141)'RN4X',I,J,NX,NY,L,RN4X,RN3X,RNBX,R3BX -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 -4141 FORMAT(A8,5I4,30E12.4) -C -C SOLUBLE, EXCHANGEABLE AND PRECIPITATED PO4 CONCENTRATIONS IN -C NON-BAND AND BAND SOIL ZONES -C - IF(VOLWPO.GT.ZEROS(NY,NX))THEN - VOLWPX=31.0*VOLWPO - RH2PX=(XH2PS(L,NY,NX)-TUPH2P(L,NY,NX))/VOLWPX - CH2P1=AMAX1(0.0,H2PO4(L,NY,NX)/VOLWPX+RH2PX) - XOH01=AMAX1(0.0,XOH0(L,NY,NX))/VOLWPO - XOH11=AMAX1(0.0,XOH1(L,NY,NX))/VOLWPO - XOH21=AMAX1(0.0,XOH2(L,NY,NX))/VOLWPO - XH1P1=AMAX1(0.0,XH1P(L,NY,NX))/VOLWPO - XH2P1=AMAX1(0.0,XH2P(L,NY,NX))/VOLWPO - PCAPM1=AMAX1(0.0,PCAPM(L,NY,NX))/VOLWPO - PCAPD1=AMAX1(0.0,PCAPD(L,NY,NX))/VOLWPO - PCAPH1=AMAX1(0.0,PCAPH(L,NY,NX))/VOLWPO - PALPO1=AMAX1(0.0,PALPO(L,NY,NX))/VOLWPO - PFEPO1=AMAX1(0.0,PFEPO(L,NY,NX))/VOLWPO -C WRITE(*,8642)'CH2P1',I,J,L,CH2P1,H2PO4(L,NY,NX) -C 2,VOLWPX,RH2PX,XH2PS(L,NY,NX),TUPH2P(L,NY,NX) -8642 FORMAT(A8,3I4,20E12.4) - ELSE - RH2PX=0.0 - CH2P1=0.0 - XOH01=0.0 - XOH11=0.0 - XOH21=0.0 - XH1P1=0.0 - XH2P1=0.0 - PALPO1=0.0 - PFEPO1=0.0 - PCAPM1=0.0 - PCAPD1=0.0 - PCAPH1=0.0 - ENDIF - IF(VOLWPB.GT.ZEROS(NY,NX))THEN - VOLWPX=31.0*VOLWPB - RH2BX=(XH2BS(L,NY,NX)-TUPH2B(L,NY,NX))/VOLWPX - CH2B1=AMAX1(0.0,H2POB(L,NY,NX)/VOLWPX+RH2BX) - XH01B=AMAX1(0.0,XOH0B(L,NY,NX))/VOLWPB - XH11B=AMAX1(0.0,XOH1B(L,NY,NX))/VOLWPB - XH21B=AMAX1(0.0,XOH2B(L,NY,NX))/VOLWPB - X1P1B=AMAX1(0.0,XH1PB(L,NY,NX))/VOLWPB - X2P1B=AMAX1(0.0,XH2PB(L,NY,NX))/VOLWPB - PALPOB=AMAX1(0.0,PALPB(L,NY,NX))/VOLWPB - PFEPOB=AMAX1(0.0,PFEPB(L,NY,NX))/VOLWPB - PCAPMB=AMAX1(0.0,PCPMB(L,NY,NX))/VOLWPB - PCAPDB=AMAX1(0.0,PCPDB(L,NY,NX))/VOLWPB - PCAPHB=AMAX1(0.0,PCPHB(L,NY,NX))/VOLWPB - ELSE - RH2BX=0.0 - CH2B1=0.0 - XH01B=0.0 - XH11B=0.0 - XH21B=0.0 - X1P1B=0.0 - X2P1B=0.0 - PALPOB=0.0 - PFEPOB=0.0 - PCAPMB=0.0 - PCAPDB=0.0 - PCAPHB=0.0 - ENDIF -C -C IF SALT OPTION SELECTED IN SITE FILE -C THEN SOLVE FULL SET OF EQUILIBRIA REACTIONS -C - IF(ISALT(NY,NX).NE.0)THEN -C -C SOLUBLE NO3 CONCENTRATIONS -C IN NON-BAND AND BAND SOIL ZONES -C - IF(VOLWNO.GT.ZEROS(NY,NX))THEN - CNO1=AMAX1(0.0,ZNO3S(L,NY,NX)/(14.0*VOLWNO)) - ELSE - CNO1=0.0 - ENDIF - IF(VOLWNZ.GT.ZEROS(NY,NX))THEN - CNOB=AMAX1(0.0,ZNO3B(L,NY,NX)/(14.0*VOLWNZ)) - ELSE - CNOB=0.0 - ENDIF - RHY1=XZHYS(L,NY,NX)/VOLWM(NPH,L,NY,NX) - CHY1=AMAX1(0.0,ZHY(L,NY,NX))/VOLWM(NPH,L,NY,NX)+RHY1 -C -C SOLUTE ION AND ION PAIR CONCENTRATIONS -C - CCEC=AMAX1(ZERO,XCEC(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - COH1=AMAX1(0.0,ZOH(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CAL1=AMAX1(0.0,ZAL(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CFE1=AMAX1(0.0,ZFE(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CCA1=AMAX1(0.0,ZCA(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CMG1=AMAX1(0.0,ZMG(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CNA1=AMAX1(0.0,ZNA(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CKA1=AMAX1(0.0,ZKA(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CSO41=AMAX1(0.0,ZSO4(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CCL1=AMAX1(0.0,ZCL(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CCO31=AMAX1(0.0,ZCO3(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CHCO31=AMAX1(0.0,ZHCO3(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CCO21=AMAX1(0.0,CO2S(L,NY,NX)/(12.0*VOLWM(NPH,L,NY,NX))) - CALO1=AMAX1(0.0,ZALOH1(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CALO2=AMAX1(0.0,ZALOH2(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CALO3=AMAX1(0.0,ZALOH3(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CALO4=AMAX1(0.0,ZALOH4(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CALS1=AMAX1(0.0,ZALS(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CFEO1=AMAX1(0.0,ZFEOH1(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CFEO2=AMAX1(0.0,ZFEOH2(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CFEO3=AMAX1(0.0,ZFEOH3(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CFEO4=AMAX1(0.0,ZFEOH4(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CFES1=AMAX1(0.0,ZFES(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CCAO1=AMAX1(0.0,ZCAO(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CCAC1=AMAX1(0.0,ZCAC(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CCAH1=AMAX1(0.0,ZCAH(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CCAS1=AMAX1(0.0,ZCAS(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CMGO1=AMAX1(0.0,ZMGO(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CMGC1=AMAX1(0.0,ZMGC(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CMGH1=AMAX1(0.0,ZMGH(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CMGS1=AMAX1(0.0,ZMGS(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CNAC1=AMAX1(0.0,ZNAC(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CNAS1=AMAX1(0.0,ZNAS(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CKAS1=AMAX1(0.0,ZKAS(L,NY,NX)/VOLWM(NPH,L,NY,NX)) -C -C PO4 CONCENTRATIONS IN NON-BAND AND BAND SOIL ZONES -C - IF(VOLWPO.GT.ZEROS(NY,NX))THEN - CH0P1=AMAX1(0.0,H0PO4(L,NY,NX)/VOLWPO) - CH1P1=AMAX1(0.0,H1PO4(L,NY,NX)/VOLWPO) - CH3P1=AMAX1(0.0,H3PO4(L,NY,NX)/VOLWPO) - CF1P1=AMAX1(0.0,ZFE1P(L,NY,NX)/VOLWPO) - CF2P1=AMAX1(0.0,ZFE2P(L,NY,NX)/VOLWPO) - CC0P1=AMAX1(0.0,ZCA0P(L,NY,NX)/VOLWPO) - CC1P1=AMAX1(0.0,ZCA1P(L,NY,NX)/VOLWPO) - CC2P1=AMAX1(0.0,ZCA2P(L,NY,NX)/VOLWPO) - CM1P1=AMAX1(0.0,ZMG1P(L,NY,NX)/VOLWPO) - ELSE - CH0P1=0.0 - CH1P1=0.0 - CH3P1=0.0 - CF1P1=0.0 - CF2P1=0.0 - CC0P1=0.0 - CC1P1=0.0 - CC2P1=0.0 - CM1P1=0.0 - ENDIF - IF(VOLWPB.GT.ZEROS(NY,NX))THEN - CH0PB=AMAX1(0.0,H0POB(L,NY,NX)/VOLWPB) - CH1PB=AMAX1(0.0,H1POB(L,NY,NX)/VOLWPB) - CH3PB=AMAX1(0.0,H3POB(L,NY,NX)/VOLWPB) - CF1PB=AMAX1(0.0,ZFE1PB(L,NY,NX)/VOLWPB) - CF2PB=AMAX1(0.0,ZFE2PB(L,NY,NX)/VOLWPB) - CC0PB=AMAX1(0.0,ZCA0PB(L,NY,NX)/VOLWPB) - CC1PB=AMAX1(0.0,ZCA1PB(L,NY,NX)/VOLWPB) - CC2PB=AMAX1(0.0,ZCA2PB(L,NY,NX)/VOLWPB) - CM1PB=AMAX1(0.0,ZMG1PB(L,NY,NX)/VOLWPB) - ELSE - CH0PB=0.0 - CH1PB=0.0 - CH3PB=0.0 - CF1PB=0.0 - CF2PB=0.0 - CC0PB=0.0 - CC1PB=0.0 - CC2PB=0.0 - CM1PB=0.0 - ENDIF -C -C EXCHANGEABLE ION CONCENTRATIONS -C - XHY1=AMAX1(0.0,XHY(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - XAL1=AMAX1(0.0,XAL(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - XCA1=AMAX1(0.0,XCA(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - XMG1=AMAX1(0.0,XMG(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - XNA1=AMAX1(0.0,XNA(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - XKA1=AMAX1(0.0,XKA(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - XHC1=AMAX1(0.0,XHC(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - XALO21=AMAX1(0.0,XALO2(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - XCOOH=AMAX1(0.0,COOH*ORGC(L,NY,NX)/VOLWM(NPH,L,NY,NX)) -C -C PRECIPITATE CONCENTRATIONS -C - PALOH1=AMAX1(0.0,PALOH(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - PFEOH1=AMAX1(0.0,PFEOH(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - PCACO1=AMAX1(0.0,PCACO(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - PCASO1=AMAX1(0.0,PCASO(L,NY,NX)/VOLWM(NPH,L,NY,NX)) -C -C CONVERGENCE TOWARDS SOLUTE EQILIBRIA -C - DO 1000 M=1,MRXN - CN41=AMAX1(ZERO,CN41) - CN4B=AMAX1(ZERO,CN4B) - CN31=AMAX1(ZERO,CN31) - CN3B=AMAX1(ZERO,CN3B) - CAL1=AMAX1(ZERO,CAL1) - CFE1=AMAX1(ZERO,CFE1) - CHY1=AMAX1(ZERO,CHY1) - CCA1=AMAX1(ZERO,AMIN1(CCAMX,CCA1)) - CMG1=AMAX1(ZERO,CMG1) - CNA1=AMAX1(ZERO,CNA1) - CKA1=AMAX1(ZERO,CKA1) - COH1=AMAX1(ZERO,COH1) - CSO41=AMAX1(ZERO,CSO41) - CCO31=AMAX1(ZERO,CCO31) - CHCO31=AMAX1(ZERO,CHCO31) - CCO21=AMAX1(ZERO,CCO21) - CALO1=AMAX1(ZERO,CALO1) - CALO2=AMAX1(ZERO,CALO2) - CALO3=AMAX1(ZERO,CALO3) - CALO4=AMAX1(ZERO,CALO4) - CALS1=AMAX1(ZERO,CALS1) - CFEO1=AMAX1(ZERO,CFEO1) - CFEO2=AMAX1(ZERO,CFEO2) - CFEO3=AMAX1(ZERO,CFEO3) - CFEO4=AMAX1(ZERO,CFEO4) - CFES1=AMAX1(ZERO,CFES1) - CCAO1=AMAX1(ZERO,CCAO1) - CCAC1=AMAX1(ZERO,CCAC1) - CCAH1=AMAX1(ZERO,CCAH1) - CCAS1=AMAX1(ZERO,CCAS1) - CMGO1=AMAX1(ZERO,CMGO1) - CMGC1=AMAX1(ZERO,CMGC1) - CMGH1=AMAX1(ZERO,CMGH1) - CMGS1=AMAX1(ZERO,CMGS1) - CNAC1=AMAX1(ZERO,CNAC1) - CNAS1=AMAX1(ZERO,CNAS1) - CKAS1=AMAX1(ZERO,CKAS1) - CH0P1=AMAX1(ZERO,CH0P1) - CH1P1=AMAX1(ZERO,CH1P1) - CH2P1=AMAX1(ZERO,CH2P1) - CH3P1=AMAX1(ZERO,CH3P1) - CF1P1=AMAX1(ZERO,CF1P1) - CF2P1=AMAX1(ZERO,CF2P1) - CC0P1=AMAX1(ZERO,CC0P1) - CC1P1=AMAX1(ZERO,CC1P1) - CC2P1=AMAX1(ZERO,CC2P1) - CM1P1=AMAX1(ZERO,CM1P1) - CH0PB=AMAX1(ZERO,CH0PB) - CH1PB=AMAX1(ZERO,CH1PB) - CH2B1=AMAX1(ZERO,CH2B1) - CH3PB=AMAX1(ZERO,CH3PB) - CF1PB=AMAX1(ZERO,CF1PB) - CF2PB=AMAX1(ZERO,CF2PB) - CC0PB=AMAX1(ZERO,CC0PB) - CC1PB=AMAX1(ZERO,CC1PB) - CC2PB=AMAX1(ZERO,CC2PB) - CM1PB=AMAX1(ZERO,CM1PB) - XCOO=AMAX1(0.0,XCOOH-XHC1-XALO21) -C -C IONIC STRENGTH FROM SUMS OF ION CONCENTRATIONS -C - CC3=CAL1+CFE1 - CA3=CH0P1*VLPO4(L,NY,NX)+CH0PB*VLPOB(L,NY,NX) - CC2=CCA1+CMG1+CALO1+CFEO1+CF2P1*VLPO4(L,NY,NX) - 2+CF2PB*VLPOB(L,NY,NX) - CA2=CSO41+CCO31+CH1P1*VLPO4(L,NY,NX)+CH1PB*VLPOB(L,NY,NX) - CC1=CN41*VLNH4(L,NY,NX)+CN4B*VLNHB(L,NY,NX)+CHY1+CNA1+CKA1 - 2+CALO2+CFEO2+CALS1+CFES1+CCAO1+CCAH1+CMGO1+CMGH1 - 3+(CF1P1+CC2P1)*VLPO4(L,NY,NX)+(CF1PB+CC2PB)*VLPOB(L,NY,NX) - CA1=CNO1*VLNO3(L,NY,NX)+CNOB*VLNOB(L,NY,NX)+COH1+CHCO31+CCL1 - 2+CALO4+CFEO4+CNAC1+CNAS1+CKAS1+(CH2P1+CC0P1)*VLPO4(L,NY,NX) - 3+(CH2B1+CC0PB)*VLPOB(L,NY,NX) - CION1=ABS(3.0*(CC3-CA3)+2.0*(CC2-CA2)+CC1-CA1) - CSTR1=AMAX1(0.0,0.5E-03*(9.0*(CC3+CA3)+4.0*(CC2+CA2) - 2+CC1+CA1+CION1)) - CSTR2=SQRT(CSTR1) - FSTR2=CSTR2/(1.0+CSTR2) -C -C ACTIVITY COEFFICIENTS CALCULATED FROM ION STRENGTH -C - A1=AMIN1(1.0,10.0**(-0.509*1.0*FSTR2+0.20*CSTR2)) - A2=AMIN1(1.0,10.0**(-0.509*4.0*FSTR2+0.20*CSTR2)) - A3=AMIN1(1.0,10.0**(-0.509*9.0*FSTR2+0.20*CSTR2)) - A12=A1**2 - A13=A1**3 - A14=A1**4 - A22=A2**2 - A25=A2**5 - A28=A2**8 - A2Q=A2**0.500 - A3C=A3**0.333 - A0A2=A0*A2 - A0A12=A0/A12 - A0A22=A0/A22 - A0A1A2=A0*A12*A2 - A1A2=A1*A2 - A1A2D=A1/A2 - A1A2QD=A1/A2Q - A1A3=A1*A3 - A1A3D=A1/A3 - A12A2=A12*A2 - A12A2D=A12/A2 - A12A22=A12/A22 - A12A25=A12/A25 - A12A28=A12/A28 - A1202D=A12/A0A2 - A13A2=A13*A2 - A13A3=A13*A3 - A13A3D=A13/A3 - A14A0=A14/A0 - A14A2=A14*A2 - A14A2D=A14/A2 - A14A0A=A14/A0A2 - A14A5D=A14/A25 - A14A28=A14*A28 - A14A8D=A14/A28 - A1TA25=A1**10*A25 - A2A3=A2*A3 - A2A13D=A2/A1A3 - A1A2A3=A1*A2A3 - A1A23D=A1/A2A3 -C -C PRECIPITATION-DISSOLUTION CALCULATED FROM ACTIVITIES -C OF REACTANTS AND PRODUCTS THROUGH CONVERGENCE SOLUTIONS -C FOR THEIR EQUILIBRIUM CONSTANTS USING SOLUTE FORMS -C CURRENTLY AT HIGHEST CONCENTRATIONS -C - AHY1=CHY1*A1 - AOH1=COH1*A1 - AAL1=CAL1*A3 - AALO1=CALO1*A2 - AALO2=CALO2*A1 - AALO3=CALO3 - AALO4=CALO4*A1 - AFE1=CFE1*A3 - AFEO1=CFEO1*A2 - AFEO2=CFEO2*A1 - AFEO3=CFEO3 - AFEO4=CFEO4*A1 - ACO31=CCO31*A2 - AHCO31=CHCO31*A1 - ACO21=CCO21*A0 -C -C ALUMINUM HYDROXIDE (GIBBSITE) -C - PX=AMAX1(AAL1,AALO1,AALO2,AALO3,AALO4) - IF(PX.EQ.AAL1)THEN - R2=CHY1 - P2=COH1 - P1=CAL1 - IF(AOH1.GT.AHY1)THEN - NR2=0 - NP2=3 - SP=SYALO/A13A3 - ELSE - NR2=3 - NP2=0 - SP=SHALO*A13A3D - ENDIF - ELSEIF(PX.EQ.AALO1)THEN - R2=CHY1 - P2=COH1 - P1=CALO1 - IF(AOH1.GT.AHY1)THEN - NR2=0 - NP2=2 - SP=SYAL1/A12A2 - ELSE - NR2=2 - NP2=0 - SP=SHAL1*A12A2D - ENDIF - ELSEIF(PX.EQ.AALO2)THEN - R2=CHY1 - P2=COH1 - P1=CALO2 - IF(AOH1.GT.AHY1)THEN - NR2=0 - NP2=1 - SP=SYAL2/A12 - ELSE - NR2=1 - NP2=0 - SP=SHAL2 - ENDIF - ELSEIF(PX.EQ.AALO3)THEN - R2=CHY1 - P2=COH1 - P1=CALO3 - NR2=0 - NP2=0 - SP=SPAL3 - ELSEIF(PX.EQ.AALO4)THEN - R2=COH1 - P2=CHY1 - P1=CALO4 - IF(AOH1.GT.AHY1)THEN - NR2=1 - NP2=0 - SP=SYAL4 - ELSE - NR2=0 - NP2=1 - SP=SHAL4/A12 - ENDIF - ENDIF - RYAL1=0.0 - RYALO1=0.0 - RYALO2=0.0 - RYALO3=0.0 - RYALO4=0.0 - RHAL1=0.0 - RHALO1=0.0 - RHALO2=0.0 - RHALO3=0.0 - RHALO4=0.0 - X=0.0 - TX=0.0 - FX=1.0/(1+NR2+NP2) - DO 1010 MM=1,100 - R2=AMAX1(ZERO,R2+NR2*X) - P1=AMAX1(ZERO,P1-X) - P2=AMAX1(ZERO,P2-NP2*X) - Z=(P1*P2**NP2/R2**NR2)/SP - IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 1110 - IF(Z.LE.0.95.AND.PALOH1.LE.0.0)GO TO 1110 - IF(NR2.NE.0)THEN - Y=AMIN1(P1,R2/NR2) - ELSEIF(NP2.NE.0)THEN - Y=AMIN1(P1,P2/NP2) - ELSE - Y=P1 - ENDIF - IF(Z.GT.1.0)THEN - X=Y-Y/Z**FX - ELSE - X=Y*Z**FX-Y - ENDIF - TX=TX+X -1010 CONTINUE -1110 CONTINUE - RPALOX=AMAX1(-PALOH1,TPD*TX) - IF(PX.EQ.AAL1)THEN - IF(AOH1.GT.AHY1)THEN - RYAL1=RPALOX - ELSE - RHAL1=RPALOX - ENDIF - ELSEIF(PX.EQ.AALO1)THEN - IF(AOH1.GT.AHY1)THEN - RYALO1=RPALOX - ELSE - RHALO1=RPALOX - ENDIF - ELSEIF(PX.EQ.AALO2)THEN - IF(AOH1.GT.AHY1)THEN - RYALO2=RPALOX - ELSE - RHALO2=RPALOX - ENDIF - ELSEIF(PX.EQ.AALO3)THEN - IF(AOH1.GT.AHY1)THEN - RYALO3=RPALOX - ELSE - RHALO3=RPALOX - ENDIF - ELSEIF(PX.EQ.AALO4)THEN - IF(AOH1.GT.AHY1)THEN - RYALO4=RPALOX - ELSE - RHALO4=RPALOX - ENDIF - ENDIF -C IF((M/10)*10.EQ.M)THEN -C WRITE(*,1112)'GIBB',I,J,M,MM,PALOH1,CAL1,CALO1,CALO2,CALO3,CALO4 -C 2,COH1,R2,P1,P2,SP,Z,TX,RPALOX,RHAL1,RHALO1,RHALO2,RHALO3,RHALO4 -C 3,CAL1*A3*(COH1*A1)**3,SYALO -C ENDIF -C -C IRON HYDROXIDE -C - PX=AMAX1(AFE1,AFEO1,AFEO2,AFEO3,AFEO4) - IF(PX.EQ.AFE1)THEN - R2=CHY1 - P2=COH1 - P1=CFE1 - IF(AOH1.GT.AHY1)THEN - NR2=0 - NP2=3 - SP=SYFEO/A13A3 - ELSE - NR2=3 - NP2=0 - SP=SHFEO*A13A3D - ENDIF - ELSEIF(PX.EQ.AFEO1)THEN - R2=CHY1 - P2=COH1 - P1=CFEO1 - IF(AOH1.GT.AHY1)THEN - NR2=0 - NP2=2 - SP=SYFE1/A12A2 - ELSE - NR2=2 - NP2=0 - SP=SHFE1*A12A2D - ENDIF - ELSEIF(PX.EQ.AFEO2)THEN - R2=CHY1 - P2=COH1 - P1=CFEO2 - IF(AOH1.GT.AHY1)THEN - NR2=0 - NP2=1 - SP=SYFE2/A12 - ELSE - NR2=1 - NP2=0 - SP=SHFE2 - ENDIF - ELSEIF(PX.EQ.AFEO3)THEN - R2=CHY1 - P2=COH1 - P1=CFEO3 - NR2=0 - NP2=0 - SP=SPFE3 - ELSEIF(PX.EQ.AFEO4)THEN - R2=COH1 - P2=CHY1 - P1=CFEO4 - IF(AOH1.GT.AHY1)THEN - NR2=1 - NP2=0 - SP=SYFE4 - ELSE - NR2=0 - NP2=1 - SP=SHFE4/A12 - ENDIF - ENDIF - RYFE1=0.0 - RYFEO1=0.0 - RYFEO2=0.0 - RYFEO3=0.0 - RYFEO4=0.0 - RHFE1=0.0 - RHFEO1=0.0 - RHFEO2=0.0 - RHFEO3=0.0 - RHFEO4=0.0 - X=0.0 - TX=0.0 - FX=1.0/(1+NR2+NP2) - DO 1020 MM=1,100 - R2=AMAX1(ZERO,R2+NR2*X) - P1=AMAX1(ZERO,P1-X) - P2=AMAX1(ZERO,P2-NP2*X) - Z=(P1*P2**NP2/R2**NR2)/SP - IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 1120 - IF(Z.LE.0.95.AND.PFEOH1.LE.0.0)GO TO 1120 - IF(NR2.NE.0)THEN - Y=AMIN1(P1,R2/NR2) - ELSEIF(NP2.NE.0)THEN - Y=AMIN1(P1,P2/NP2) - ELSE - Y=P1 - ENDIF - IF(Z.GT.1.0)THEN - X=Y-Y/Z**FX - ELSE - X=Y*Z**FX-Y - ENDIF - TX=TX+X -1020 CONTINUE -1120 CONTINUE - RPFEOX=AMAX1(-PFEOH1,TPD*TX) - IF(PX.EQ.AFE1)THEN - IF(AOH1.GT.AHY1)THEN - RYFE1=RPFEOX - ELSE - RHFE1=RPFEOX - ENDIF - ELSEIF(PX.EQ.AFEO1)THEN - IF(AOH1.GT.AHY1)THEN - RYFEO1=RPFEOX - ELSE - RHFEO1=RPFEOX - ENDIF - ELSEIF(PX.EQ.AFEO2)THEN - IF(AOH1.GT.AHY1)THEN - RYFEO2=RPFEOX - ELSE - RHFEO2=RPFEOX - ENDIF - ELSEIF(PX.EQ.AFEO3)THEN - IF(AOH1.GT.AHY1)THEN - RYFEO3=RPFEOX - ELSE - RHFEO3=RPFEOX - ENDIF - ELSEIF(PX.EQ.AFEO4)THEN - IF(AOH1.GT.AHY1)THEN - RYFEO4=RPFEOX - ELSE - RHFEO4=RPFEOX - ENDIF - ENDIF -C IF((M/10)*10.EQ.M)THEN -C WRITE(*,1112)'IRON',I,J,M,MM,PFEOH1,CFE1,CFEO1,CFEO2,CFEO3,CFEO4 -C 2,COH1,R2,P1,P2,SP,Z,TX,RPFEOX,RHFE1,RHFEO1,RHFEO2,RHFEO3,RHFEO4 -C 3,CFE1*A3*(COH1*A1)**3,SYFEO -C ENDIF -C -C CALCITE AND GYPSUM -C - PX=AMAX1(ACO31,AHCO31,ACO21) - R2=CHY1 - P3=COH1 - P1=CCA1 - IF(PX.EQ.ACO31)THEN - P2=CCO31 - NR2=0 - NP3=0 - SP=SPCAC/A22 - ELSEIF(PX.EQ.AHCO31)THEN - P2=CHCO31 - IF(AOH1.GT.AHY1)THEN - NR2=0 - NP3=1 - SP=SYCAC1/A12A2 - ELSE - NR2=1 - NP3=0 - SP=SHCAC1/A2 - ENDIF - ELSEIF(PX.EQ.ACO21)THEN - P2=CCO21 - IF(AOH1.GT.AHY1)THEN - NR2=0 - NP3=2 - SP=SYCAC2/A0A1A2 - ELSE - NR2=2 - NP3=0 - SP=SHCAC2*A1202D - ENDIF - ENDIF - RYCAC3=0.0 - RYCACH=0.0 - RYCACO=0.0 - RHCAC3=0.0 - RHCACH=0.0 - RHCACO=0.0 - X=0.0 - TX=0.0 - FX=1.0/(2+NR2+NP3) - DO 1030 MM=1,100 - R2=AMAX1(ZERO,R2+NR2*X) - P1=AMAX1(ZERO,P1-X) - P2=AMAX1(ZERO,P2-X) - P3=AMAX1(ZERO,P3-NP3*X) - Z=(P1*P2*P3**NP3/R2**NR2)/SP - IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 1130 - IF(Z.LE.0.95.AND.PCACO1.LE.0.0)GO TO 1130 - IF(NR2.NE.0)THEN - Y=AMIN1(R2/NR2,P1,P2) - ELSEIF(NP3.NE.0)THEN - Y=AMIN1(P1,P2,P3/NP3) - ELSE - Y=AMIN1(P1,P2) - ENDIF - IF(Z.GT.1.0)THEN - X=Y-Y/Z**FX - ELSE - X=Y*Z**FX-Y - ENDIF - TX=TX+X -1030 CONTINUE -1130 CONTINUE - RPCACX=AMAX1(-PCACO1,TPD*TX) - IF(PX.EQ.ACO31)THEN - IF(AOH1.GT.AHY1)THEN - RYCAC3=RPCACX - ELSE - RHCAC3=RPCACX - ENDIF - ELSEIF(PX.EQ.AHCO31)THEN - IF(AOH1.GT.AHY1)THEN - RYCACH=RPCACX - ELSE - RHCACH=RPCACX - ENDIF - ELSEIF(PX.EQ.ACO21)THEN - IF(AOH1.GT.AHY1)THEN - RYCACO=RPCACX - ELSE - RHCACO=RPCACX - ENDIF - ENDIF - SP=SPCAS/A22 - S0=CCA1+CSO41 - S1=AMAX1(0.0,S0**2-4.0*(CCA1*CSO41-SP)) - RPCASO=AMAX1(-PCASO1,TPDX*(S0-SQRT(S1))) -C IF((M/10)*10.EQ.M)THEN -C WRITE(*,1112)'CALC',I,J,M,MM,PCASO1,ACO31,AHCO31,ACO21,CHY1 -C 2,COH1,R2,P1,P2,P3,SP,Z,TX,RPCACX,RHCAC3,RHCACH,RHCACO -C 3,CCA1*A2*CCO3*A2,SPCAC -C ENDIF -C -C PHOSPHORUS PRECIPITATION-DISSOLUTION IN NON-BAND SOIL ZONE -C - IF(VOLWPO.GT.ZEROS(NY,NX))THEN -C -C ALUMINUM PHOSPHATE (VARISCITE) -C - AH1P1=CH1P1*A2 - AH2P1=CH2P1*A1 - PX=AMAX1(AAL1,AALO1,AALO2,AALO3,AALO4) - PY=AMAX1(AH1P1,AH2P1) - R3=CHY1 - R4=COH1 - P3=CHY1 - P4=COH1 - IF(PY.EQ.AH1P1)THEN - P2=CH1P1 - IF(PX.EQ.AAL1)THEN - P1=CAL1 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=0 - NP3=0 - NP4=1 - SP=SYA0P1/A1A2A3 - ELSE - NR3=1 - NR4=0 - NP3=0 - NP4=0 - SP=SHA0P1*A1A23D - ENDIF - ELSEIF(PX.EQ.AALO1)THEN - P1=CALO1 - NR3=0 - NR4=0 - NP3=0 - NP4=0 - SP=SPA1P1/A22 - ELSEIF(PX.EQ.AALO2)THEN - P1=CALO2 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=1 - NP3=0 - NP4=0 - SP=SYA2P1/A2 - ELSE - NR3=0 - NR4=0 - NP3=1 - NP4=0 - SP=SHA2P1/A12A2 - ENDIF - ELSEIF(PX.EQ.AALO3)THEN - P1=CALO3 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=2 - NP3=0 - NP4=0 - SP=SYA3P1*A12A2D - ELSE - NR3=0 - NR4=0 - NP3=2 - NP4=0 - SP=SHA3P1/A13A2 - ENDIF - ELSEIF(PX.EQ.AALO4)THEN - P1=CALO4 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=3 - NP3=0 - NP4=0 - SP=SYA4P1*A12A2D - ELSE - NR3=0 - NR4=0 - NP3=3 - NP4=0 - SP=SHA4P1*A14A2 - ENDIF - ENDIF - ELSE - P2=CH2P1 - IF(PX.EQ.AAL1)THEN - P1=CAL1 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=0 - NP3=0 - NP4=2 - SP=SYA0P2/A13A3 - ELSE - NR3=2 - NR4=0 - NP3=0 - NP4=0 - SP=SHA0P2*A1A3D - ENDIF - ELSEIF(PX.EQ.AALO1)THEN - P1=CALO1 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=0 - NP3=0 - NP4=1 - SP=SYA1P2/A12A2 - ELSE - NR3=1 - NR4=0 - NP3=0 - NP4=0 - SP=SHA1P2/A2 - ENDIF - ELSEIF(PX.EQ.AALO2)THEN - P1=CALO2 - NR3=0 - NR4=0 - NP3=0 - NP4=0 - SP=SPA2P2/A12 - ELSEIF(PX.EQ.AALO3)THEN - P1=CALO3 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=1 - NP3=0 - NP4=0 - SP=SYA3P2 - ELSE - NR3=0 - NR4=0 - NP3=1 - NP4=0 - SP=SHA3P2/A22 - ENDIF - ELSEIF(PX.EQ.AALO4)THEN - P1=CALO4 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=2 - NP3=0 - NP4=0 - SP=SYA4P2 - ELSE - NR3=0 - NR4=0 - NP3=2 - NP4=0 - SP=SHA4P2/A14 - ENDIF - ENDIF - ENDIF - RYA0P1=0.0 - RYA1P1=0.0 - RYA2P1=0.0 - RYA3P1=0.0 - RYA4P1=0.0 - RYA0P2=0.0 - RYA1P2=0.0 - RYA2P2=0.0 - RYA3P2=0.0 - RYA4P2=0.0 - RHA0P1=0.0 - RHA1P1=0.0 - RHA2P1=0.0 - RHA3P1=0.0 - RHA4P1=0.0 - RHA0P2=0.0 - RHA1P2=0.0 - RHA2P2=0.0 - RHA3P2=0.0 - RHA4P2=0.0 - X=0.0 - TX=0.0 - FX=1.0/(2+NR3+NR4+NP3+NP4) - DO 1040 MM=1,100 - R3=AMAX1(ZERO,R3+NR3*X) - R4=AMAX1(ZERO,R4+NR4*X) - P1=AMAX1(ZERO,P1-X) - P2=AMAX1(ZERO,P2-X) - P3=AMAX1(ZERO,P3-NP3*X) - P4=AMAX1(ZERO,P4-NP4*X) - Z=(P1*P2*P3**NP3*P4**NP4/(R3**NR3*R4**NR4))/SP - IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 1140 - IF(Z.LE.0.95.AND.PALPO1.LE.0.0)GO TO 1140 - IF(NR3.NE.0)THEN - Y=AMIN1(R3/NR3,P1,P2) - ELSEIF(NR4.NE.0)THEN - Y=AMIN1(R4/NR4,P1,P2) - ELSEIF(NP3.NE.0)THEN - Y=AMIN1(P1,P2,P3/NP3) - ELSEIF(NP4.NE.0)THEN - Y=AMIN1(P1,P2,P4/NP4) - ELSE - Y=AMIN1(P1,P2) - ENDIF - IF(Z.GT.1.0)THEN - X=Y-Y/Z**FX - ELSE - X=Y*Z**FX-Y - ENDIF - TX=TX+X -1040 CONTINUE -1140 CONTINUE - RPALPX=AMAX1(-PALPO1,TPD*TX) - IF(PY.EQ.AH1P1)THEN - IF(PX.EQ.AAL1)THEN - IF(AOH1.GT.AHY1)THEN - RYA0P1=RPALPX - ELSE - RHA0P1=RPALPX - ENDIF - ELSEIF(PX.EQ.AALO1)THEN - IF(AOH1.GT.AHY1)THEN - RYA1P1=RPALPX - ELSE - RHA1P1=RPALPX - ENDIF - ELSEIF(PX.EQ.AALO2)THEN - IF(AOH1.GT.AHY1)THEN - RYA2P1=RPALPX - ELSE - RHA2P1=RPALPX - ENDIF - ELSEIF(PX.EQ.AALO3)THEN - IF(AOH1.GT.AHY1)THEN - RYA3P1=RPALPX - ELSE - RHA3P1=RPALPX - ENDIF - ELSEIF(PX.EQ.AALO4)THEN - IF(AOH1.GT.AHY1)THEN - RYA4P1=RPALPX - ELSE - RHA4P1=RPALPX - ENDIF - ENDIF - ELSE - IF(PX.EQ.AAL1)THEN - IF(AOH1.GT.AHY1)THEN - RYA0P2=RPALPX - ELSE - RHA0P2=RPALPX - ENDIF - ELSEIF(PX.EQ.AALO1)THEN - IF(AOH1.GT.AHY1)THEN - RYA1P2=RPALPX - ELSE - RHA1P2=RPALPX - ENDIF - ELSEIF(PX.EQ.AALO2)THEN - IF(AOH1.GT.AHY1)THEN - RYA2P2=RPALPX - ELSE - RHA2P2=RPALPX - ENDIF - ELSEIF(PX.EQ.AALO3)THEN - IF(AOH1.GT.AHY1)THEN - RYA3P2=RPALPX - ELSE - RHA3P2=RPALPX - ENDIF - ELSEIF(PX.EQ.AALO4)THEN - IF(AOH1.GT.AHY1)THEN - RYA4P2=RPALPX - ELSE - RHA4P2=RPALPX - ENDIF - ENDIF - ENDIF -C IF((M/10)*10.EQ.M)THEN -C WRITE(*,1112)'ALPO4',I,J,M,MM,PALPO1,CAL1,CALO1,CALO2,CALO3,CALO4 -C 2,CH1P1,CH2P1,CHY1,COH1,RPALPX,RHA0P1,RHA1P1,RHA2P1,RHA3P1,RHA4P1 -C 3,RHA0P2,RHA1P2,RHA2P2,RHA3P2,RHA4P2,R3,R4,P2,P3,P4,SP,Z,TX -1112 FORMAT(A8,4I4,80E12.4) -C ENDIF -C -C IRON PHOSPHATE (STRENGITE) -C - PX=AMAX1(AFE1,AFEO1,AFEO2,AFEO3,AFEO4) - PY=AMAX1(AH1P1,AH2P1) - R3=CHY1 - R4=COH1 - P3=CHY1 - P4=COH1 - IF(PY.EQ.AH1P1)THEN - P2=CH1P1 - IF(PX.EQ.AFE1)THEN - P1=CFE1 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=0 - NP3=0 - NP4=1 - SP=SYF0P1/A1A2A3 - ELSE - NR3=1 - NR4=0 - NP3=0 - NP4=0 - SP=SHF0P1*A1A23D - ENDIF - ELSEIF(PX.EQ.AFEO1)THEN - P1=CFEO1 - NR3=0 - NR4=0 - NP3=0 - NP4=0 - SP=SPF1P1/A22 - ELSEIF(PX.EQ.AFEO2)THEN - P1=CFEO2 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=1 - NP3=0 - NP4=0 - SP=SYF2P1/A2 - ELSE - NR3=0 - NR4=0 - NP3=1 - NP4=0 - SP=SHF2P1/A12A2 - ENDIF - ELSEIF(PX.EQ.AFEO3)THEN - P1=CFEO3 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=2 - NP3=0 - NP4=0 - SP=SYF3P1*A12A2D - ELSE - NR3=0 - NR4=0 - NP3=2 - NP4=0 - SP=SHF3P1/A13A2 - ENDIF - ELSEIF(PX.EQ.AFEO4)THEN - P1=CFEO4 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=3 - NP3=0 - NP4=0 - SP=SYF4P1*A12A2D - ELSE - NR3=0 - NR4=0 - NP3=3 - NP4=0 - SP=SHF4P1*A14A2 - ENDIF - ENDIF - ELSE - P2=CH2P1 - IF(PX.EQ.AFE1)THEN - P1=CFE1 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=0 - NP3=0 - NP4=2 - SP=SYF0P2/A13A3 - ELSE - NR3=2 - NR4=0 - NP3=0 - NP4=0 - SP=SHF0P2*A1A3D - ENDIF - ELSEIF(PX.EQ.AFEO1)THEN - P1=CFEO1 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=0 - NP3=0 - NP4=1 - SP=SYF1P2/A12A2 - ELSE - NR3=1 - NR4=0 - NP3=0 - NP4=0 - SP=SHF1P2/A2 - ENDIF - ELSEIF(PX.EQ.AFEO2)THEN - P1=CFEO2 - NR3=0 - NR4=0 - NP3=0 - NP4=0 - SP=SPF2P2/A12 - ELSEIF(PX.EQ.AFEO3)THEN - P1=CFEO3 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=1 - NP3=0 - NP4=0 - SP=SYF3P2 - ELSE - NR3=0 - NR4=0 - NP3=1 - NP4=0 - SP=SHF3P2/A22 - ENDIF - ELSEIF(PX.EQ.AFEO4)THEN - P1=CFEO4 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=2 - NP3=0 - NP4=0 - SP=SYF4P2 - ELSE - NR3=0 - NR4=0 - NP3=2 - NP4=0 - SP=SHF4P2/A14 - ENDIF - ENDIF - ENDIF - RYF0P1=0.0 - RYF1P1=0.0 - RYF2P1=0.0 - RYF3P1=0.0 - RYF4P1=0.0 - RYF0P2=0.0 - RYF1P2=0.0 - RYF2P2=0.0 - RYF3P2=0.0 - RYF4P2=0.0 - RHF0P1=0.0 - RHF1P1=0.0 - RHF2P1=0.0 - RHF3P1=0.0 - RHF4P1=0.0 - RHF0P2=0.0 - RHF1P2=0.0 - RHF2P2=0.0 - RHF3P2=0.0 - RHF4P2=0.0 - X=0.0 - TX=0.0 - FX=1.0/(2+NR3+NR4+NP3+NP4) - DO 1050 MM=1,100 - R3=AMAX1(ZERO,R3+NR3*X) - R4=AMAX1(ZERO,R4+NR4*X) - P1=AMAX1(ZERO,P1-X) - P2=AMAX1(ZERO,P2-X) - P3=AMAX1(ZERO,P3-NP3*X) - P4=AMAX1(ZERO,P4-NP4*X) - Z=(P1*P2*P3**NP3*P4**NP4/(R3**NR3*R4**NR4))/SP - IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 1150 - IF(Z.LE.0.95.AND.PFEPO1.LE.0.0)GO TO 1150 - IF(NR3.NE.0)THEN - Y=AMIN1(R3/NR3,P1,P2) - ELSEIF(NR4.NE.0)THEN - Y=AMIN1(R4/NR4,P1,P2) - ELSEIF(NP3.NE.0)THEN - Y=AMIN1(P1,P2,P3/NP3) - ELSEIF(NP4.NE.0)THEN - Y=AMIN1(P1,P2,P4/NP4) - ELSE - Y=AMIN1(P1,P2) - ENDIF - IF(Z.GT.1.0)THEN - X=Y-Y/Z**FX - ELSE - X=Y*Z**FX-Y - ENDIF - TX=TX+X -1050 CONTINUE -1150 CONTINUE - RPFEPX=AMAX1(-PFEPO1,TPD*TX) - IF(PY.EQ.AH1P1)THEN - IF(PX.EQ.AFE1)THEN - IF(AOH1.GT.AHY1)THEN - RYF0P1=RPFEPX - ELSE - RHF0P1=RPFEPX - ENDIF - ELSEIF(PX.EQ.AFEO1)THEN - IF(AOH1.GT.AHY1)THEN - RYF1P1=RPFEPX - ELSE - RHF1P1=RPFEPX - ENDIF - ELSEIF(PX.EQ.AFEO2)THEN - IF(AOH1.GT.AHY1)THEN - RYF2P1=RPFEPX - ELSE - RHF2P1=RPFEPX - ENDIF - ELSEIF(PX.EQ.AFEO3)THEN - IF(AOH1.GT.AHY1)THEN - RYF3P1=RPFEPX - ELSE - RHF3P1=RPFEPX - ENDIF - ELSEIF(PX.EQ.AFEO4)THEN - IF(AOH1.GT.AHY1)THEN - RYF4P1=RPFEPX - ELSE - RHF4P1=RPFEPX - ENDIF - ENDIF - ELSE - IF(PX.EQ.AFE1)THEN - IF(AOH1.GT.AHY1)THEN - RYF0P2=RPFEPX - ELSE - RHF0P2=RPFEPX - ENDIF - ELSEIF(PX.EQ.AFEO1)THEN - IF(AOH1.GT.AHY1)THEN - RYF1P2=RPFEPX - ELSE - RHF1P2=RPFEPX - ENDIF - ELSEIF(PX.EQ.AFEO2)THEN - IF(AOH1.GT.AHY1)THEN - RYF2P2=RPFEPX - ELSE - RHF2P2=RPFEPX - ENDIF - ELSEIF(PX.EQ.AFEO3)THEN - IF(AOH1.GT.AHY1)THEN - RYF3P2=RPFEPX - ELSE - RHF3P2=RPFEPX - ENDIF - ELSEIF(PX.EQ.AFEO4)THEN - IF(AOH1.GT.AHY1)THEN - RYF4P2=RPFEPX - ELSE - RHF4P2=RPFEPX - ENDIF - ENDIF - ENDIF -C IF((M/10)*10.EQ.M)THEN -C WRITE(*,1112)'FEPO4',I,J,M,MM,PFEPO1,CFE1,CFEO1,CFEO2,CFEO3,CFEO4 -C 2,CH1P1,CH2P1,CHY1,COH1,RPFEPX,RHF0P1,RHF1P1,RHF2P1,RHF3P1,RHF4P1 -C 3,RHF0P2,RHF1P2,RHF2P2,RHF3P2,RHF4P2,R3,R4,P2,P3,P4,SP,Z,TX -C ENDIF -C -C DICALCIUM PHOSPHATE -C - PX=AMAX1(AH1P1,AH2P1) - R2=CHY1 - P3=COH1 - P1=CCA1 - IF(PX.EQ.AH1P1)THEN - P2=CH1P1 - NR2=0 - NP3=0 - SP=SPCAD/A22 - ELSEIF(PX.EQ.AH2P1)THEN - P2=CH2P1 - IF(AOH1.GT.AHY1)THEN - NR2=0 - NP3=1 - SP=SYCAD2/A12A2 - ELSE - NR2=1 - NP3=0 - SP=SHCAD2/A2 - ENDIF - ENDIF - RPCAD1=0.0 - RYCAD2=0.0 - RHCAD2=0.0 - X=0.0 - TX=0.0 - FX=1.0/(2+NR2+NP3) - DO 1060 MM=1,100 - R2=AMAX1(ZERO,R2+NR2*X) - P1=AMAX1(ZERO,P1-X) - P2=AMAX1(ZERO,P2-X) - P3=AMAX1(ZERO,P3-NP3*X) - Z=(P1*P2*P3**NP3/R2**NR2)/SP - IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 1160 - IF(Z.LE.0.95.AND.PCAPD1.LE.0.0)GO TO 1160 - IF(NR2.NE.0)THEN - Y=AMIN1(R2/NR2,P1,P2) - ELSEIF(NP3.NE.0)THEN - Y=AMIN1(P1,P2,P3/NP3) - ELSE - Y=AMIN1(P1,P2) - ENDIF - IF(Z.GT.1.0)THEN - X=Y-Y/Z**FX - ELSE - X=Y*Z**FX-Y - ENDIF - TX=TX+X -1060 CONTINUE -1160 CONTINUE - RPCADX=AMAX1(-PCAPD1,TPD*TX) - IF(PX.EQ.AH1P1)THEN - RPCAD1=RPCADX - ELSEIF(PX.EQ.AH2P1)THEN - IF(AOH1.GT.AHY1)THEN - RYCAD2=RPCADX - ELSE - RHCAD2=RPCADX - ENDIF - ENDIF -C IF((M/10)*10.EQ.M)THEN -C WRITE(*,1112)'CAPO4',I,J,M,MM,PCAPM1,PCAPD1,CCA1 -C 2,CH1P1,CH2P1,CHY1,COH1,RPCADX,RPCAD1,RYCAD2,RHCAD2,R2,P1,P2,P3 -C 3,SP,Z,FX,Y,X,TX,A2,CCA1*A2*CH1P1*A2,SPCAD -C ENDIF -C -C HYDROXYAPATITE -C - PX=AMAX1(AH1P1,AH2P1) - R2=CHY1 - P3=COH1 - P1=CCA1 - IF(PX.EQ.AH1P1)THEN - P2=CH1P1 - IF(AOH1.GT.AHY1)THEN - NR2=0 - NP3=4 - SP=SYCAH1/A14A28 - ELSE - NR2=4 - NP3=0 - SP=SHCAH1*A14A8D - ENDIF - ELSEIF(PX.EQ.AH2P1)THEN - P2=CH2P1 - IF(AOH1.GT.AHY1)THEN - NR2=0 - NP3=7 - SP=SYCAH2/A1TA25 - ELSE - NR2=7 - NP3=0 - SP=SHCAH2*A14A5D - ENDIF - ENDIF - RYCAH1=0.0 - RYCAH2=0.0 - RHCAH1=0.0 - RHCAH2=0.0 - X=0.0 - TX=0.0 - FX=1.0/(6+NR2+NR3) - DO 1070 MM=1,100 - R2=AMAX1(ZERO,R2+NR2*X) - P1=AMAX1(ZERO,P1-5.0*X) - P2=AMAX1(ZERO,P2-3.0*X) - P3=AMAX1(ZERO,P3-NP3*X) - Z=(P1**5*P2**3*P3**NP3/R2**NR2)/SP - IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 1170 - IF(Z.LE.0.95.AND.PCAPH1.LE.0.0)GO TO 1170 - IF(NR2.GT.0)THEN - Y=AMIN1(R2/NR2,P1/5,P2/3) - ELSE - Y=AMIN1(P1/5,P2/3,P3/NP3) - ENDIF - IF(Z.GT.1.0)THEN - X=Y-Y/Z**FX - ELSE - X=Y*Z**FX-Y - ENDIF - TX=TX+X -1070 CONTINUE -1170 CONTINUE - RPCAHX=AMAX1(-PCAPH1,TPD*TX) - IF(PX.EQ.AH1P1)THEN - IF(AOH1.GT.AHY1)THEN - RYCAH1=RPCAHX - ELSE - RHCAH1=RPCAHX - ENDIF - ELSEIF(PX.EQ.AH2P1)THEN - IF(AOH1.GT.AHY1)THEN - RYCAH2=RPCAHX - ELSE - RHCAH2=RPCAHX - ENDIF - ENDIF -C IF((M/10)*10.EQ.M)THEN -C WRITE(*,1112)'APATITE',I,J,M,MM,PCAPH1,CCA1 -C 2,CH1P1,CH2P1,CHY1,RPCAHX,RHCAH1,RHCAH2,R2,P1,P2,P3 -C 3,SP,Z,(CCA1*A2)**5*(CH0P1*A3)**3*COH1*A1,SPCAH -C ENDIF -C -C MONOCALCIUM PHOSPHATE -C - P1=CCA1 - P2=CH2P1 - SP=SPCAM/A12A2 - X=0.0 - TX=0.0 - DO 1080 MM=1,100 - P1=AMAX1(ZERO,P1-X) - P2=AMAX1(ZERO,P2-2*X) - Z=P1*P2**2/SP - IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 1180 - IF(Z.LE.0.95.AND.PCAPM1.LE.0.0)GO TO 1180 - Y=AMIN1(P1,P2/2) - IF(Z.GT.1.0)THEN - X=Y-Y/Z**0.33 - ELSE - X=Y*Z**0.33-Y - ENDIF - TX=TX+X -1080 CONTINUE -1180 CONTINUE - RPCAMX=AMAX1(-PCAPM1*SPPO4,TPD*TX) - ELSE - RPALPX=0.0 - RPFEPX=0.0 - RPCADX=0.0 - RPCAHX=0.0 - RYA0P1=0.0 - RYA1P1=0.0 - RYA2P1=0.0 - RYA3P1=0.0 - RYA4P1=0.0 - RYA0P2=0.0 - RYA1P2=0.0 - RYA2P2=0.0 - RYA3P2=0.0 - RYA4P2=0.0 - RHA0P1=0.0 - RHA1P1=0.0 - RHA2P1=0.0 - RHA3P1=0.0 - RHA4P1=0.0 - RHA0P2=0.0 - RHA1P2=0.0 - RHA2P2=0.0 - RHA3P2=0.0 - RHA4P2=0.0 - RYF0P1=0.0 - RYF1P1=0.0 - RYF2P1=0.0 - RYF3P1=0.0 - RYF4P1=0.0 - RYF0P2=0.0 - RYF1P2=0.0 - RYF2P2=0.0 - RYF3P2=0.0 - RYF4P2=0.0 - RHF0P1=0.0 - RHF1P1=0.0 - RHF2P1=0.0 - RHF3P1=0.0 - RHF4P1=0.0 - RHF0P2=0.0 - RHF1P2=0.0 - RHF2P2=0.0 - RHF3P2=0.0 - RHF4P2=0.0 - RPCAD1=0.0 - RYCAD2=0.0 - RHCAD2=0.0 - RYCAH1=0.0 - RYCAH2=0.0 - RHCAH1=0.0 - RHCAH2=0.0 - RPCAMX=0.0 - ENDIF -C -C PHOSPHORUS PRECIPITATION-DISSOLUTION IN BAND SOIL ZONE -C - IF(VOLWPB.GT.ZEROS(NY,NX))THEN -C -C ALUMINUM PHOSPHATE (VARISCITE) -C - AH1PB=CH1PB*A2 - AH2PB=CH2B1*A1 - PX=AMAX1(AAL1,AALO1,AALO2,AALO3,AALO4) - PY=AMAX1(AH1PB,AH2PB) - R3=CHY1 - R4=COH1 - P3=CHY1 - P4=COH1 - IF(PY.EQ.AH1PB)THEN - P2=CH1PB - IF(PX.EQ.AAL1)THEN - P1=CAL1 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=0 - NP3=0 - NP4=1 - SP=SYA0P1/A1A2A3 - ELSE - NR3=1 - NR4=0 - NP3=0 - NP4=0 - SP=SHA0P1*A1A23D - ENDIF - ELSEIF(PX.EQ.AALO1)THEN - P1=CALO1 - NR3=0 - NR4=0 - NP3=0 - NP4=0 - SP=SPA1P1/A22 - ELSEIF(PX.EQ.AALO2)THEN - P1=CALO2 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=1 - NP3=0 - NP4=0 - SP=SYA2P1/A2 - ELSE - NR3=0 - NR4=0 - NP3=1 - NP4=0 - SP=SHA2P1/A12A2 - ENDIF - ELSEIF(PX.EQ.AALO3)THEN - P1=CALO3 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=2 - NP3=0 - NP4=0 - SP=SYA3P1*A12A2D - ELSE - NR3=0 - NR4=0 - NP3=2 - NP4=0 - SP=SHA3P1/A13A2 - ENDIF - ELSEIF(PX.EQ.AALO4)THEN - P1=CALO4 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=3 - NP3=0 - NP4=0 - SP=SYA4P1*A12A2D - ELSE - NR3=0 - NR4=0 - NP3=3 - NP4=0 - SP=SHA4P1*A14A2 - ENDIF - ENDIF - ELSE - P2=CH2B1 - IF(PX.EQ.AAL1)THEN - P1=CAL1 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=0 - NP3=0 - NP4=2 - SP=SYA0P2/A13A3 - ELSE - NR3=2 - NR4=0 - NP3=0 - NP4=0 - SP=SHA0P2*A1A3D - ENDIF - ELSEIF(PX.EQ.AALO1)THEN - P1=CALO1 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=0 - NP3=0 - NP4=1 - SP=SYA1P2/A12A2 - ELSE - NR3=1 - NR4=0 - NP3=0 - NP4=0 - SP=SHA1P2/A2 - ENDIF - ELSEIF(PX.EQ.AALO2)THEN - P1=CALO2 - NR3=0 - NR4=0 - NP3=0 - NP4=0 - SP=SPA2P2/A12 - ELSEIF(PX.EQ.AALO3)THEN - P1=CALO3 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=1 - NP3=0 - NP4=0 - SP=SYA3P2 - ELSE - NR3=0 - NR4=0 - NP3=1 - NP4=0 - SP=SHA3P2/A22 - ENDIF - ELSEIF(PX.EQ.AALO4)THEN - P1=CALO4 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=2 - NP3=0 - NP4=0 - SP=SYA4P2 - ELSE - NR3=0 - NR4=0 - NP3=2 - NP4=0 - SP=SHA4P2/A14 - ENDIF - ENDIF - ENDIF - RYA0B1=0.0 - RYA1B1=0.0 - RYA2B1=0.0 - RYA3B1=0.0 - RYA4B1=0.0 - RYA0B2=0.0 - RYA1B2=0.0 - RYA2B2=0.0 - RYA3B2=0.0 - RYA4B2=0.0 - RHA0B1=0.0 - RHA1B1=0.0 - RHA2B1=0.0 - RHA3B1=0.0 - RHA4B1=0.0 - RHA0B2=0.0 - RHA1B2=0.0 - RHA2B2=0.0 - RHA3B2=0.0 - RHA4B2=0.0 - X=0.0 - TX=0.0 - FX=1.0/(2+NR3+NR4+NP3+NP4) - DO 2040 MM=1,100 - R3=AMAX1(ZERO,R3+NR3*X) - R4=AMAX1(ZERO,R4+NR4*X) - P1=AMAX1(ZERO,P1-X) - P2=AMAX1(ZERO,P2-X) - P3=AMAX1(ZERO,P3-NP3*X) - P4=AMAX1(ZERO,P4-NP4*X) - Z=(P1*P2*P3**NP3*P4**NP4/(R3**NR3*R4**NR4))/SP - IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 2140 - IF(Z.LE.0.95.AND.PALPOB.LE.0.0)GO TO 2140 - IF(NR3.NE.0)THEN - Y=AMIN1(R3/NR3,P1,P2) - ELSEIF(NR4.NE.0)THEN - Y=AMIN1(R4/NR4,P1,P2) - ELSEIF(NP3.NE.0)THEN - Y=AMIN1(P1,P2,P3/NP3) - ELSEIF(NP4.NE.0)THEN - Y=AMIN1(P1,P2,P4/NP4) - ELSE - Y=AMIN1(P1,P2) - ENDIF - IF(Z.GT.1.0)THEN - X=Y-Y/Z**FX - ELSE - X=Y*Z**FX-Y - ENDIF - TX=TX+X -2040 CONTINUE -2140 CONTINUE - RPALBX=AMAX1(-PALPOB,TPD*TX) - IF(PY.EQ.AH1PB)THEN - IF(PX.EQ.AAL1)THEN - IF(AOH1.GT.AHY1)THEN - RYA0B1=RPALBX - ELSE - RHA0B1=RPALBX - ENDIF - ELSEIF(PX.EQ.AALO1)THEN - IF(AOH1.GT.AHY1)THEN - RYA1B1=RPALBX - ELSE - RHA1B1=RPALBX - ENDIF - ELSEIF(PX.EQ.AALO2)THEN - IF(AOH1.GT.AHY1)THEN - RYA2B1=RPALBX - ELSE - RHA2B1=RPALBX - ENDIF - ELSEIF(PX.EQ.AALO3)THEN - IF(AOH1.GT.AHY1)THEN - RYA3B1=RPALBX - ELSE - RHA3B1=RPALBX - ENDIF - ELSEIF(PX.EQ.AALO4)THEN - IF(AOH1.GT.AHY1)THEN - RYA4B1=RPALBX - ELSE - RHA4B1=RPALBX - ENDIF - ENDIF - ELSE - IF(PX.EQ.AAL1)THEN - IF(AOH1.GT.AHY1)THEN - RYA0B2=RPALBX - ELSE - RHA0B2=RPALBX - ENDIF - ELSEIF(PX.EQ.AALO1)THEN - IF(AOH1.GT.AHY1)THEN - RYA1B2=RPALBX - ELSE - RHA1B2=RPALBX - ENDIF - ELSEIF(PX.EQ.AALO2)THEN - IF(AOH1.GT.AHY1)THEN - RYA2B2=RPALBX - ELSE - RHA2B2=RPALBX - ENDIF - ELSEIF(PX.EQ.AALO3)THEN - IF(AOH1.GT.AHY1)THEN - RYA3B2=RPALBX - ELSE - RHA3B2=RPALBX - ENDIF - ELSEIF(PX.EQ.AALO4)THEN - IF(AOH1.GT.AHY1)THEN - RYA4B2=RPALBX - ELSE - RHA4B2=RPALBX - ENDIF - ENDIF - ENDIF -C -C IRON PHOSPHATE (STRENGITE) -C - PX=AMAX1(AFE1,AFEO1,AFEO2,AFEO3,AFEO4) - PY=AMAX1(AH1PB,AH2PB) - R3=CHY1 - R4=COH1 - P3=CHY1 - P4=COH1 - IF(PY.EQ.AH1PB)THEN - P2=CH1PB - IF(PX.EQ.AFE1)THEN - P1=CFE1 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=0 - NP3=0 - NP4=1 - SP=SYF0P1/A1A2A3 - ELSE - NR3=1 - NR4=0 - NP3=0 - NP4=0 - SP=SHF0P1*A1A23D - ENDIF - ELSEIF(PX.EQ.AFEO1)THEN - P1=CFEO1 - NR3=0 - NR4=0 - NP3=0 - NP4=0 - SP=SPF1P1/A22 - ELSEIF(PX.EQ.AFEO2)THEN - P1=CFEO2 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=1 - NP3=0 - NP4=0 - SP=SYF2P1/A2 - ELSE - NR3=0 - NR4=0 - NP3=1 - NP4=0 - SP=SHF2P1/A12A2 - ENDIF - ELSEIF(PX.EQ.AFEO3)THEN - P1=CFEO3 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=2 - NP3=0 - NP4=0 - SP=SYF3P1*A12A2D - ELSE - NR3=0 - NR4=0 - NP3=2 - NP4=0 - SP=SHF3P1/A13A2 - ENDIF - ELSEIF(PX.EQ.AFEO4)THEN - P1=CFEO4 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=3 - NP3=0 - NP4=0 - SP=SYF4P1*A12A2D - ELSE - NR3=0 - NR4=0 - NP3=3 - NP4=0 - SP=SHF4P1*A14A2 - ENDIF - ENDIF - ELSE - P2=CH2B1 - IF(PX.EQ.AFE1)THEN - P1=CFE1 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=0 - NP3=0 - NP4=2 - SP=SYF0P2/A13A3 - ELSE - NR3=2 - NR4=0 - NP3=0 - NP4=0 - SP=SHF0P2*A1A3D - ENDIF - ELSEIF(PX.EQ.AFEO1)THEN - P1=CFEO1 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=0 - NP3=0 - NP4=1 - SP=SYF1P2/A12A2 - ELSE - NR3=1 - NR4=0 - NP3=0 - NP4=0 - SP=SHF1P2/A2 - ENDIF - ELSEIF(PX.EQ.AFEO2)THEN - P1=CFEO2 - NR3=0 - NR4=0 - NP3=0 - NP4=0 - SP=SPF2P2/A12 - ELSEIF(PX.EQ.AFEO3)THEN - P1=CFEO3 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=1 - NP3=0 - NP4=0 - SP=SYF3P2 - ELSE - NR3=0 - NR4=0 - NP3=1 - NP4=0 - SP=SHF3P2/A22 - ENDIF - ELSEIF(PX.EQ.AFEO4)THEN - P1=CFEO4 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=2 - NP3=0 - NP4=0 - SP=SYF4P2 - ELSE - NR3=0 - NR4=0 - NP3=2 - NP4=0 - SP=SHF4P2/A14 - ENDIF - ENDIF - ENDIF - RYF0B1=0.0 - RYF1B1=0.0 - RYF2B1=0.0 - RYF3B1=0.0 - RYF4B1=0.0 - RYF0B2=0.0 - RYF1B2=0.0 - RYF2B2=0.0 - RYF3B2=0.0 - RYF4B2=0.0 - RHF0B1=0.0 - RHF1B1=0.0 - RHF2B1=0.0 - RHF3B1=0.0 - RHF4B1=0.0 - RHF0B2=0.0 - RHF1B2=0.0 - RHF2B2=0.0 - RHF3B2=0.0 - RHF4B2=0.0 - X=0.0 - TX=0.0 - FX=1.0/(2+NR3+NR4+NP3+NP4) - DO 2050 MM=1,100 - R3=AMAX1(ZERO,R3+NR3*X) - R4=AMAX1(ZERO,R4+NR4*X) - P1=AMAX1(ZERO,P1-X) - P2=AMAX1(ZERO,P2-X) - P3=AMAX1(ZERO,P3-NP3*X) - P4=AMAX1(ZERO,P4-NP4*X) - Z=(P1*P2*P3**NP3*P4**NP4/(R3**NR3*R4**NR4))/SP - IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 2150 - IF(Z.LE.0.95.AND.PFEPOB.LE.0.0)GO TO 2150 - IF(NR3.NE.0)THEN - Y=AMIN1(R3/NR3,P1,P2) - ELSEIF(NR4.NE.0)THEN - Y=AMIN1(R4/NR4,P1,P2) - ELSEIF(NP3.NE.0)THEN - Y=AMIN1(P1,P2,P3/NP3) - ELSEIF(NP4.NE.0)THEN - Y=AMIN1(P1,P2,P4/NP4) - ELSE - Y=AMIN1(P1,P2) - ENDIF - IF(Z.GT.1.0)THEN - X=Y-Y/Z**FX - ELSE - X=Y*Z**FX-Y - ENDIF - TX=TX+X -2050 CONTINUE -2150 CONTINUE - RPFEBX=AMAX1(-PFEPOB,TPD*TX) - IF(PY.EQ.AH1PB)THEN - IF(PX.EQ.AFE1)THEN - IF(AOH1.GT.AHY1)THEN - RYF0B1=RPFEBX - ELSE - RHF0B1=RPFEBX - ENDIF - ELSEIF(PX.EQ.AFEO1)THEN - IF(AOH1.GT.AHY1)THEN - RYF1B1=RPFEBX - ELSE - RHF1B1=RPFEBX - ENDIF - ELSEIF(PX.EQ.AFEO2)THEN - IF(AOH1.GT.AHY1)THEN - RYF2B1=RPFEBX - ELSE - RHF2B1=RPFEBX - ENDIF - ELSEIF(PX.EQ.AFEO3)THEN - IF(AOH1.GT.AHY1)THEN - RYF3B1=RPFEBX - ELSE - RHF3B1=RPFEBX - ENDIF - ELSEIF(PX.EQ.AFEO4)THEN - IF(AOH1.GT.AHY1)THEN - RYF4B1=RPFEBX - ELSE - RHF4B1=RPFEBX - ENDIF - ENDIF - ELSE - IF(PX.EQ.AFE1)THEN - IF(AOH1.GT.AHY1)THEN - RYF0B2=RPFEBX - ELSE - RHF0B2=RPFEBX - ENDIF - ELSEIF(PX.EQ.AFEO1)THEN - IF(AOH1.GT.AHY1)THEN - RYF1B2=RPFEBX - ELSE - RHF1B2=RPFEBX - ENDIF - ELSEIF(PX.EQ.AFEO2)THEN - IF(AOH1.GT.AHY1)THEN - RYF2B2=RPFEBX - ELSE - RHF2B2=RPFEBX - ENDIF - ELSEIF(PX.EQ.AFEO3)THEN - IF(AOH1.GT.AHY1)THEN - RYF3B2=RPFEBX - ELSE - RHF3B2=RPFEBX - ENDIF - ELSEIF(PX.EQ.AFEO4)THEN - IF(AOH1.GT.AHY1)THEN - RYF4B2=RPFEBX - ELSE - RHF4B2=RPFEBX - ENDIF - ENDIF - ENDIF -C -C DICALCIUM PHOSPHATE -C - PX=AMAX1(AH1PB,AH2PB) - R2=CHY1 - P3=COH1 - P1=CCA1 - IF(PX.EQ.AH1PB)THEN - P2=CH1PB - NR2=0 - NP3=0 - SP=SPCAD/A22 - ELSEIF(PX.EQ.AH2PB)THEN - P2=CH2B1 - IF(AOH1.GT.AHY1)THEN - NR2=0 - NP3=1 - SP=SYCAD2/A12A2 - ELSE - NR2=1 - NP3=0 - SP=SHCAD2/A2 - ENDIF - ENDIF - RPCDB1=0.0 - RYCDB2=0.0 - RHCDB2=0.0 - X=0.0 - TX=0.0 - FX=1.0/(2+NR2+NP3) - DO 2060 MM=1,100 - R2=AMAX1(ZERO,R2+NR2*X) - P1=AMAX1(ZERO,P1-X) - P2=AMAX1(ZERO,P2-X) - P3=AMAX1(ZERO,P3-NP3*X) - Z=(P1*P2*P3**NP3/R2**NR2)/SP - IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 2160 - IF(Z.LE.0.95.AND.PCAPDB.LE.0.0)GO TO 2160 - IF(NR2.NE.0)THEN - Y=AMIN1(R2/NR2,P1,P2) - ELSEIF(NP3.NE.0)THEN - Y=AMIN1(P1,P2,P3/NP3) - ELSE - Y=AMIN1(P1,P2) - ENDIF - IF(Z.GT.1.0)THEN - X=Y-Y/Z**FX - ELSE - X=Y*Z**FX-Y - ENDIF - TX=TX+X -2060 CONTINUE -2160 CONTINUE - RPCDBX=AMAX1(-PCAPDB,TPD*TX) - IF(PX.EQ.AH1PB)THEN - RPCDB1=RPCDBX - ELSEIF(PX.EQ.AH2PB)THEN - IF(AOH1.GT.AHY1)THEN - RYCDB2=RPCDBX - ELSE - RHCDB2=RPCDBX - ENDIF - ENDIF -C -C HYDROXYAPATITE -C - PX=AMAX1(AH1PB,AH2PB) - R2=CHY1 - P3=COH1 - P1=CCA1 - IF(PX.EQ.AH1PB)THEN - P2=CH1PB - IF(AOH1.GT.AHY1)THEN - NR2=0 - NP3=4 - SP=SYCAH1/A14A28 - ELSE - NR2=4 - NP3=0 - SP=SHCAH1*A14A8D - ENDIF - ELSEIF(PX.EQ.AH2PB)THEN - P2=CH2B1 - IF(AOH1.GT.AHY1)THEN - NR2=0 - NP3=7 - SP=SYCAH2/A1TA25 - ELSE - NR2=7 - NP3=0 - SP=SHCAH2*A14A5D - ENDIF - ENDIF - RYCHB1=0.0 - RYCHB2=0.0 - RHCHB1=0.0 - RHCHB2=0.0 - X=0.0 - TX=0.0 - FX=1.0/(6+NR2+NR3) - DO 2070 MM=1,100 - R2=AMAX1(ZERO,R2+NR2*X) - P1=AMAX1(ZERO,P1-5.0*X) - P2=AMAX1(ZERO,P2-3.0*X) - P3=AMAX1(ZERO,P3-NP3*X) - Z=(P1**5*P2**3*P3**NP3/R2**NR2)/SP - IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 2170 - IF(Z.LE.0.95.AND.PCAPHB.LE.0.0)GO TO 2170 - IF(NR2.GT.0)THEN - Y=AMIN1(R2/NR2,P1/5,P2/3) - ELSE - Y=AMIN1(P1/5,P2/3,P3/NP3) - ENDIF - IF(Z.GT.1.0)THEN - X=Y-Y/Z**FX - ELSE - X=Y*Z**FX-Y - ENDIF - TX=TX+X -2070 CONTINUE -2170 CONTINUE - RPCHBX=AMAX1(-PCAPHB,TPD*TX) - IF(PX.EQ.AH1PB)THEN - IF(AOH1.GT.AHY1)THEN - RYCHB1=RPCHBX - ELSE - RHCHB1=RPCHBX - ENDIF - ELSEIF(PX.EQ.AH2PB)THEN - IF(AOH1.GT.AHY1)THEN - RYCHB2=RPCHBX - ELSE - RHCHB2=RPCHBX - ENDIF - ENDIF -C -C MONOCALCIUM PHOSPHATE -C - P1=CCA1 - P2=CH2B1 - SP=SPCAM/A12A2 - X=0.0 - TX=0.0 - DO 2080 MM=1,100 - P1=AMAX1(ZERO,P1-X) - P2=AMAX1(ZERO,P2-2*X) - Z=P1*P2**2/SP - IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 2180 - IF(Z.LE.0.95.AND.PCAPMB.LE.0.0)GO TO 2180 - Y=AMIN1(P1,P2/2) - IF(Z.GT.1.0)THEN - X=Y-Y/Z**0.33 - ELSE - X=Y*Z**0.33-Y - ENDIF - TX=TX+X -2080 CONTINUE -2180 CONTINUE - RPCMBX=AMAX1(-PCAPMB*SPPO4,TPD*TX) - ELSE - RPALBX=0.0 - RPFEBX=0.0 - RPCDBX=0.0 - RPCHBX=0.0 - RPCMBX=0.0 - RYA0B1=0.0 - RYA1B1=0.0 - RYA2B1=0.0 - RYA3B1=0.0 - RYA4B1=0.0 - RYA0B2=0.0 - RYA1B2=0.0 - RYA2B2=0.0 - RYA3B2=0.0 - RYA4B2=0.0 - RHA0B1=0.0 - RHA1B1=0.0 - RHA2B1=0.0 - RHA3B1=0.0 - RHA4B1=0.0 - RHA0B2=0.0 - RHA1B2=0.0 - RHA2B2=0.0 - RHA3B2=0.0 - RHA4B2=0.0 - RYF0B1=0.0 - RYF1B1=0.0 - RYF2B1=0.0 - RYF3B1=0.0 - RYF4B1=0.0 - RYF0B2=0.0 - RYF1B2=0.0 - RYF2B2=0.0 - RYF3B2=0.0 - RYF4B2=0.0 - RHF0B1=0.0 - RHF1B1=0.0 - RHF2B1=0.0 - RHF3B1=0.0 - RHF4B1=0.0 - RHF0B2=0.0 - RHF1B2=0.0 - RHF2B2=0.0 - RHF3B2=0.0 - RHF4B2=0.0 - RPCDB1=0.0 - RYCDB2=0.0 - RHCDB2=0.0 - RYCHB1=0.0 - RYCHB2=0.0 - RHCHB1=0.0 - RHCHB2=0.0 - ENDIF -C -C PHOSPHORUS ANION EXCHANGE IN NON-BAND SOIL ZONE -C CALCULATED FROM EXCHANGE EQUILIBRIA AMONG H2PO4-, -C HPO4--, H+, OH- AND PROTONATED AND NON-PROTONATED -OH -C EXCHANGE SITES -C - IF(VOLWPO.GT.ZEROS(NY,NX) - 2.AND.AEC(L,NY,NX).GT.ZEROS(NY,NX))THEN -C - -C PROTONATION OF ANION EXCHANGE SITES IN NON-BAND SOIL ZONE -C - DCHG=AMAX1(-0.1E+05,XOH21-XOH01-XH1P1) - AEP=EXP(AE*DCHG/TKS(L,NY,NX)) - AEN=EXP(-AE*DCHG/TKS(L,NY,NX)) - SPOH2=SXOH2*AEP/A1 - X0=XOH11+CHY1+SPOH2 - X1=AMAX1(0.0,X0**2-4.0*(XOH11*CHY1-SPOH2*XOH21)) - RXOH2=TADAX*(X0-SQRT(X1)) - SPOH1=SXOH1/(AEN*A1) - X0=XOH01+CHY1+SPOH1 - X1=AMAX1(0.0,X0**2-4.0*(XOH01*CHY1-SPOH1*XOH11)) - RXOH1=TADAX*(X0-SQRT(X1)) -C -C H2PO4 EXCHANGE IN NON-BAND SOIL ZONE FROM CONVERGENCE -C SOLUTION FOR EQUILIBRIUM AMONG H2PO4-, H+, OH-, X-OH -C AND X-H2PO4 -C - SPH2P=SYH2P*DPH2O/(SXOH2*AEP*A1) - X0=XOH21+CH2P1+SPH2P - X1=AMAX1(0.0,X0**2-4.0*(XOH21*CH2P1-SPH2P*XH2P1)) - RXH2P=TADAX*(X0-SQRT(X1)) - R1=XH2P1 - R2=COH1 - P1=XOH11 - P2=CH2P1 - P3=CHY1 - IF(AOH1.GT.AHY1)THEN - NR2=1 - NP3=0 - SP=SYH2P - ELSE - NR2=0 - NP3=1 - SP=SHH2P/A12 - ENDIF - RYH2P=0.0 - RHH2P=0.0 - X=0.0 - TX=0.0 - DO 4010 MM=1,100 - R1=AMAX1(ZERO,R1+X) - R2=AMAX1(ZERO,R2+NR2*X) - P1=AMAX1(ZERO,P1-X) - P2=AMAX1(ZERO,P2-X) - P3=AMAX1(ZERO,P3-NP3*X) - Z=(P1*P2*P3**NP3/(R1*R2**NR2))/SP - IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 4110 - IF(NR2.GT.0)THEN - Y=AMIN1(R1,R2/NR2,P1,P2) - ELSE - Y=AMIN1(R1,P1,P2,P3/NP3) - ENDIF - IF(Z.GT.1.0)THEN - X=Y-Y/Z**0.25 - ELSE - X=Y*Z**0.25-Y - ENDIF - TX=TX+X -4010 CONTINUE -4110 CONTINUE - IF(AOH1.GT.AHY1)THEN - RYH2P=TADAX*TX - ELSE - RHH2P=TADAX*TX - ENDIF -C -C HPO4 EXCHANGE IN NON-BAND SOIL ZONE FROM CONVERGENCE -C SOLUTION FOR EQUILIBRIUM AMONG HPO4--, H+, OH-, X-OH -C AND X-HPO4 -C - R1=XH1P1 - R2=COH1 - P1=XOH11 - P2=CH1P1 - P3=CHY1 - IF(AOH1.GT.AHY1)THEN - NR2=1 - NP3=0 - SP=SYH1P*AEN*A1A2D - ELSE - NR2=0 - NP3=1 - SP=SHH1P*AEN/A1A2 - ENDIF - RYH1P=0.0 - RHH1P=0.0 - X=0.0 - TX=0.0 - DO 4020 MM=1,100 - R1=AMAX1(ZERO,R1+X) - R2=AMAX1(ZERO,R2+NR2*X) - P1=AMAX1(ZERO,P1-X) - P2=AMAX1(ZERO,P2-X) - P3=AMAX1(ZERO,P3-NP3*X) - Z=(P1*P2*P3**NP3/(R1*R2**NR2))/SP - IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 4120 - IF(NR2.GT.0)THEN - Y=AMIN1(R1,R2/NR2,P1,P2) - ELSE - Y=AMIN1(R1,P1,P2,P3/NP3) - ENDIF - IF(Z.GT.1.0)THEN - X=Y-Y/Z**0.25 - ELSE - X=Y*Z**0.25-Y - ENDIF - TX=TX+X -4020 CONTINUE -4120 CONTINUE - IF(AOH1.GT.AHY1)THEN - RYH1P=TADAX*TX - ELSE - RHH1P=TADAX*TX - ENDIF - ELSE - RXOH2=0.0 - RXOH1=0.0 - RXH2P=0.0 - RYH2P=0.0 - RYH1P=0.0 - RHH2P=0.0 - RHH1P=0.0 - ENDIF -C -C PHOSPHORUS ANION EXCHANGE IN BAND SOIL ZONE -C CALCULATED FROM EXCHANGE EQUILIBRIA AMONG H2PO4-, -C HPO4--, H+, OH- AND PROTONATED AND NON-PROTONATED -OH -C EXCHANGE SITES -C - IF(VOLWPB.GT.ZEROS(NY,NX) - 2.AND.AEC(L,NY,NX).GT.ZEROS(NY,NX))THEN -C -C PROTONATION OF EXCHANGE SITES IN BAND SOIL ZONE -C - DCHG=AMAX1(-0.1E+05,XH21B-XH01B-X1P1B) - AEP=EXP(AE*DCHG/TKS(L,NY,NX)) - AEN=EXP(-AE*DCHG/TKS(L,NY,NX)) - SPOH2=SXOH2*AEP/A1 - - X0=XH11B+CHY1+SPOH2 - X1=AMAX1(0.0,X0**2-4.0*(XH11B*CHY1-SPOH2*XH21B)) - RXO2B=TADAX*(X0-SQRT(X1)) - SPOH1=SXOH1/(AEN*A1) - X0=XH01B+CHY1+SPOH1 - X1=AMAX1(0.0,X0**2-4.0*(XH01B*CHY1-SPOH1*XH11B)) - RXO1B=TADAX*(X0-SQRT(X1)) -C -C H2PO4 EXCHANGE IN BAND SOIL ZONE FROM CONVERGENCE -C SOLUTION FOR EQUILIBRIUM AMONG H2PO4-, H+, OH-, X-OH -C AND X-H2PO4 -C - SPH2P=SYH2P*DPH2O/(SXOH2*AEP*A1) - X0=XH21B+CH2B1+SPH2P - X1=AMAX1(0.0,X0**2-4.0*(XH21B*CH2B1-SPH2P*X2P1B)) - RXH2B=TADAX*(X0-SQRT(X1)) - R1=X2P1B - R2=COH1 - P1=XH11B - P2=CH2B1 - P3=CHY1 - IF(AOH1.GT.AHY1)THEN - NR2=1 - NP3=0 - SP=SYH2P - ELSE - NR2=0 - NP3=1 - SP=SHH2P/A12 - ENDIF - RYH2B=0.0 - RHH2B=0.0 - X=0.0 - TX=0.0 - DO 5010 MM=1,100 - R1=AMAX1(ZERO,R1+X) - R2=AMAX1(ZERO,R2+NR2*X) - P1=AMAX1(ZERO,P1-X) - P2=AMAX1(ZERO,P2-X) - P3=AMAX1(ZERO,P3-NP3*X) - Z=(P1*P2*P3**NP3/(R1*R2**NR2))/SP - IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 5110 - IF(NR2.GT.0)THEN - Y=AMIN1(R1,R2/NR2,P1,P2) - ELSE - Y=AMIN1(R1,P1,P2,P3/NP3) - ENDIF - IF(Z.GT.1.0)THEN - X=Y-Y/Z**0.25 - ELSE - X=Y*Z**0.25-Y - ENDIF - TX=TX+X -5010 CONTINUE -5110 CONTINUE - IF(AOH1.GT.AHY1)THEN - RYH2B=TADAX*TX - ELSE - RHH2B=TADAX*TX - ENDIF -C -C HPO4 EXCHANGE IN BAND SOIL ZONE FROM CONVERGENCE -C SOLUTION FOR EQUILIBRIUM AMONG HPO4--, H+, OH-, X-OH -C AND X-HPO4 -C - R1=X1P1B - R2=COH1 - P1=XH11B - P2=CH1PB - P3=CHY1 - IF(AOH1.GT.AHY1)THEN - NR2=1 - NP3=0 - SP=SYH1P*AEN*A1A2D - ELSE - NR2=0 - NP3=1 - SP=SHH1P*AEN/A1A2 - ENDIF - RYH1B=0.0 - RHH1B=0.0 - X=0.0 - TX=0.0 - DO 5020 MM=1,100 - R1=AMAX1(ZERO,R1+X) - R2=AMAX1(ZERO,R2+NR2*X) - P1=AMAX1(ZERO,P1-X) - P2=AMAX1(ZERO,P2-X) - P3=AMAX1(ZERO,P3-NP3*X) - Z=(P1*P2*P3**NP3/(R1*R2**NR2))/SP - IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 5120 - IF(NR2.GT.0)THEN - Y=AMIN1(R1,R2/NR2,P1,P2) - ELSE - Y=AMIN1(R1,P1,P2,P3/NP3) - ENDIF - IF(Z.GT.1.0)THEN - X=Y-Y/Z**0.25 - ELSE - X=Y*Z**0.25-Y - ENDIF - TX=TX+X -5020 CONTINUE -5120 CONTINUE - IF(AOH1.GT.AHY1)THEN - RYH1B=TADAX*TX - ELSE - RHH1B=TADAX*TX - ENDIF - ELSE - RXO2B=0.0 - RXO1B=0.0 - RXH2B=0.0 - RYH2B=0.0 - RYH1B=0.0 - RHH2B=0.0 - RHH1B=0.0 - ENDIF -C -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 -C -C CATION CONCENTRATIONS -C - CN4X=CN41 - CNBX=CN4B - CHYX=CHY1 - CALX=CAL1**0.333 - CCAX=CCA1**0.500 - CMGX=CMG1**0.500 - CNAX=CNA1 - CKAX=CKA1 -C -C GAPON COEFFICIENTS FROM SOIL FILE ADJUSTED -C FOR ACTIVITY COEFFICIENTS -C - GKCHX=GKCH(L,NY,NX)*A1A2QD - GKC4X=GKC4(L,NY,NX)*A1A2QD - GKCAX=GKCA(L,NY,NX)*A3C/A2Q - GKCMX=GKCM(L,NY,NX) - GKCNX=GKCN(L,NY,NX)*A1A2QD - GKCKX=GKCK(L,NY,NX)*A1A2QD -C -C EQUILIBRIUM X-CA CONCENTRATION FROM CEC AND CATION -C CONCENTRATIONS -C - XCAQ=CCEC/(1.0+GKC4X*CN4X/CCAX*VLNH4(L,NY,NX)+GKC4X*CNBX/CCAX - 2*VLNHB(L,NY,NX)+GKCHX*CHYX/CCAX+GKCAX*CALX/CCAX+GKCMX*CMGX/CCAX - 3+GKCNX*CNAX/CCAX+GKCKX*CKAX/CCAX) - FCAQ=XCAQ/CCAX - FN4X=FCAQ*GKC4X - FHYX=FCAQ*GKCHX - FALX=FCAQ*GKCAX/3.0 - FCAX=FCAQ*0.5 - FMGX=FCAQ*GKCMX*0.5 - FNAX=FCAQ*GKCNX - FKAX=FCAQ*GKCKX -C -C NH4 EXCHANGE IN NON-BAND AND BAND SOIL ZONES -C - RXN4=TADCX*(FN4X*CN4X-XN41)/(1.0+FN4X) - RXNB=TADCX*(FN4X*CNBX-XN4B)/(1.0+FN4X) -C -C H EXCHANGE -C - RXHY=TADCX*(FHYX*CHYX-XHY1)/(1.0+FHYX) -C -C AL EXCHANGE -C - E=XAL1 - C=CAL1 - X=0.0 - TX=0.0 - DO 3010 MM=1,100 - E=AMAX1(ZERO,E+X) - C=AMAX1(ZERO,C-X) - Z=(C**0.333/E)*FALX - IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 3110 - Y=AMIN1(E,C) - IF(Z.GT.1.0)THEN - X=Y-Y/Z**0.75 - ELSE - X=Y*Z**0.75-Y - ENDIF - TX=TX+X -3010 CONTINUE -3110 CONTINUE - RXAL=TADCX*TX -C -C CA EXCHANGE -C - E=XCA1 - C=CCA1 - X=0.0 - TX=0.0 - DO 3020 MM=1,100 - E=AMAX1(ZERO,E+X) - C=AMAX1(ZERO,C-X) - Z=(C**0.50/E)*FCAX - IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 3120 - Y=AMIN1(E,C) - IF(Z.GT.1.0)THEN - X=Y-Y/Z**0.67 - ELSE - X=Y*Z**0.67-Y - ENDIF - TX=TX+X -3020 CONTINUE -3120 CONTINUE - RXCA=TADCX*TX -C -C MG EXCHANGE -C - E=XMG1 - C=CMG1 - X=0.0 - TX=0.0 - DO 3030 MM=1,100 - E=AMAX1(ZERO,E+X) - C=AMAX1(ZERO,C-X) - Z=(C**0.50/E)*FMGX - IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 3130 - Y=AMIN1(E,C) - IF(Z.GT.1.0)THEN - X=Y-Y/Z**0.67 - ELSE - X=Y*Z**0.67-Y - ENDIF - TX=TX+X -3030 CONTINUE -3130 CONTINUE - RXMG=TADCX*TX -C -C NA EXCHANGE -C - RXNA=TADCX*(FNAX*CNAX-XNA1)/(1.0+FNAX) -C -C K EXCHANGE -C - RXKA=TADCX*(FKAX*CKAX-XKA1)/(1.0+FKAX) - ELSE - RXN4=0.0 - RXNB=0.0 - RXHY=0.0 - RXAL=0.0 - RXCA=0.0 - RXMG=0.0 - RXNA=0.0 - RXKA=0.0 - ENDIF -C -C DISSOCIATION OF CARBOXYL RADICALS AND ADSORPTION OF AL(OH)2 -C - DP=DPCOH/A1 - S0=CHY1+XCOO+DP - S1=AMAX1(0.0,S0**2-4.0*(CHY1*XCOO-DP*XHC1)) - RXHC=TADCX*(S0-SQRT(S1)) - DP=DPALO/A1 - S0=CALO2+XCOO+DP - S1=AMAX1(0.0,S0**2-4.0*(CALO2*XCOO-DP*XALO21)) - RXALO2=TADAX*(S0-SQRT(S1)) -C -C NH4-NH3+H IN NON-BAND AND BAND SOIL ZONES -C - IF(VOLWNH.GT.ZEROS(NY,NX))THEN - DP=DPN4/A0 - S0=CHY1+CN31+DP - S1=AMAX1(0.0,S0**2-4.0*(CHY1*CN31-DP*CN41)) - RNH4=TSLX*(S0-SQRT(S1)) - ELSE - RNH4=0.0 - ENDIF - IF(VOLWNB.GT.ZEROS(NY,NX))THEN - DP=DPN4/A0 - S0=CHY1+CN3B+DP - S1=AMAX1(0.0,S0**2-4.0*(CHY1*CN3B-DP*CN4B)) - RNHB=TSLX*(S0-SQRT(S1)) - ELSE - RNHB=0.0 - ENDIF -C -C CO2-H+HCO3 -C - DP=DPCO2*A0A12 - S0=CHY1+CHCO31+DP - S1=AMAX1(0.0,S0**2-4.0*(CHY1*CHCO31-DP*CCO21)) - RCO2Q=TSLX*(S0-SQRT(S1)) -C -C HCO3-H+CO3 -C - DP=DPHCO/A2 - S0=CHY1+CCO31+DP - S1=AMAX1(0.0,S0**2-4.0*(CHY1*CCO31-DP*CHCO31)) - RHCO3=TSLX*(S0-SQRT(S1)) -C -C ALOH-AL+OH -C - DP=DPAL1*A2A13D - S0=CAL1+COH1+DP - S1=AMAX1(0.0,S0**2-4.0*(CAL1*COH1-DP*CALO1)) - RALO1=TSLX*(S0-SQRT(S1)) -C -C AL(OH)2-ALOH+OH -C - DP=DPAL2/A2 - S0=CALO1+COH1+DP - S1=AMAX1(0.0,S0**2-4.0*(CALO1*COH1-DP*CALO2)) - RALO2=TSLX*(S0-SQRT(S1)) -C -C AL(OH)3-AL(OH)2+OH -C - DP=DPAL3*A0A12 - S0=CALO2+COH1+DP - S1=AMAX1(0.0,S0**2-4.0*(CALO2*COH1-DP*CALO3)) - RALO3=TSLX*(S0-SQRT(S1)) -C -C AL(OH)4-AL(OH)3+OH -C - DP=DPAL4/A0 - S0=CALO3+COH1+DP - S1=AMAX1(0.0,S0**2-4.0*(CALO3*COH1-DP*CALO4)) - RALO4=TSLX*(S0-SQRT(S1)) -C -C ALSO4-AL+SO4 -C - DP=DPALS*A1A23D - S0=CAL1+CSO41+DP - S1=AMAX1(0.0,S0**2-4.0*(CAL1*CSO41-DP*CALS1)) - RALS=TSLX*(S0-SQRT(S1)) -C -C FEOH-FE+OH -C - DP=DPFE1*A2A13D - S0=CFE1+COH1+DP - S1=AMAX1(0.0,S0**2-4.0*(CFE1*COH1-DP*CFEO1)) - RFEO1=TSLX*(S0-SQRT(S1)) -C -C FE(OH)2-FEOH+OH -C - DP=DPFE2/A2 - S0=CFEO1+COH1+DP - S1=AMAX1(0.0,S0**2-4.0*(CFEO1*COH1-DP*CFEO2)) - RFEO2=TSLX*(S0-SQRT(S1)) -C -C FE(OH)3-FE(OH)2+OH -C - DP=DPFE3*A0A12 - S0=CFEO2+COH1+DP - S1=AMAX1(0.0,S0**2-4.0*(CFEO2*COH1-DP*CFEO3)) - RFEO3=TSLX*(S0-SQRT(S1)) -C -C AL(OH)4-AL(OH)3+OH -C - DP=DPFE4/A0 - S0=CFEO3+COH1+DP - S1=AMAX1(0.0,S0**2-4.0*(CFEO3*COH1-DP*CFEO4)) - RFEO4=TSLX*(S0-SQRT(S1)) -C -C FESO4-FE+SO4 -C - DP=DPFES*A1A23D - S0=CFE1+CSO41+DP - S1=AMAX1(0.0,S0**2-4.0*(CFE1*CSO41-DP*CFES1)) - RFES=TSLX*(S0-SQRT(S1)) -C -C CAOH-CA+OH -C - DP=DPCAO/A2 - S0=CCA1+COH1+DP - S1=AMAX1(0.0,S0**2-4.0*(CCA1*COH1-DP*CCAO1)) - RCAO=TSLX*(S0-SQRT(S1)) -C -C CACO3-CA+CO3 -C - DP=DPCAC*A0A22 - S0=CCA1+CCO31+DP - S1=AMAX1(0.0,S0**2-4.0*(CCA1*CCO31-DP*CCAC1)) - RCAC=TSLX*(S0-SQRT(S1)) -C -C CAHCO3-CA+HCO3 -C - DP=DPCAH/A2 - S0=CCA1+CHCO31+DP - S1=AMAX1(0.0,S0**2-4.0*(CCA1*CHCO31-DP*CCAH1)) - RCAH=TSLX*(S0-SQRT(S1)) -C -C CASO4-CA+SO4 -C - DP=DPCAS*A0A22 - S0=CCA1+CSO41+DP - S1=AMAX1(0.0,S0**2-4.0*(CCA1*CSO41-DP*CCAS1)) - RCAS=TSLX*(S0-SQRT(S1)) -C -C MGOH-MG+OH -C - DP=DPMGO/A2 - S0=CMG1+COH1+DP - S1=AMAX1(0.0,S0**2-4.0*(CMG1*COH1-DP*CMGO1)) - RMGO=TSLX*(S0-SQRT(S1)) -C -C MGCO3-MG+CO3 -C - DP=DPMGC*A0A22 - S0=CMG1+CCO31+DP - S1=AMAX1(0.0,S0**2-4.0*(CMG1*CCO31-DP*CMGC1)) - RMGC=TSLX*(S0-SQRT(S1)) -C -C MGHCO3-MG+HCO3 -C - DP=DPMGH/A2 - S0=CMG1+CHCO31+DP - S1=AMAX1(0.0,S0**2-4.0*(CMG1*CHCO31-DP*CMGH1)) - RMGH=TSLX*(S0-SQRT(S1)) -C -C MGSO4-MG+SO4 -C - DP=DPMGS*A0A22 - S0=CMG1+CSO41+DP - S1=AMAX1(0.0,S0**2-4.0*(CMG1*CSO41-DP*CMGS1)) - RMGS=TSLX*(S0-SQRT(S1)) -C -C NACO3-NA+CO3 -C - DP=DPNAC/A2 - S0=CNA1+CCO31+DP - S1=AMAX1(0.0,S0**2-4.0*(CNA1*CCO31-DP*CNAC1)) - RNAC=TSLX*(S0-SQRT(S1)) -C -C NASO4-NA+SO4 -C - DP=DPNAS/A2 - S0=CNA1+CSO41+DP - S1=AMAX1(0.0,S0**2-4.0*(CNA1*CSO41-DP*CNAS1)) - RNAS=TSLX*(S0-SQRT(S1)) -C -C KSO4-K+SO4 -C - DP=DPKAS/A2 - S0=CKA1+CSO41+DP - S1=AMAX1(0.0,S0**2-4.0*(CKA1*CSO41-DP*CKAS1)) - RKAS=TSLX*(S0-SQRT(S1)) -C -C PHOSPHORUS IN NON-BAND SOIL ZONE -C - IF(VOLWPO.GT.ZEROS(NY,NX))THEN -C -C HPO4-H+PO4 -C - DP=DPH1P*A2A13D - S0=CH0P1+CHY1+DP - S1=AMAX1(0.0,S0**2-4.0*(CH0P1*CHY1-DP*CH1P1)) - RH1P=TSLX*(S0-SQRT(S1)) -C -C H2PO4-H+HPO4 -C - DP=DPH2P/A2 - S0=CH1P1+CHY1+DP - S1=AMAX1(0.0,S0**2-4.0*(CH1P1*CHY1-DP*CH2P1)) - RH2P=TSLX*(S0-SQRT(S1)) -C IF(NY.EQ.5.AND.L.EQ.10)THEN -C WRITE(*,22)'RH2P',I,J,NX,NY,L,M,RH2P,TSLX,S0,S1,DP,DPH2P,A2 -C 2,CH1P1,CHY1,CH2P1,H2PO4(L,NY,NX),VOLWPX,RH2PX,XH2PS(L,NY,NX) -C 3,TUPH2P(L,NY,NX) -22 FORMAT(A8,6I4,60E12.4) -C ENDIF -C -C H3PO4-H+H2PO4 -C - DP=DPH3P*A0A12 - S0=CH2P1+CHY1+DP - S1=AMAX1(0.0,S0**2-4.0*(CH2P1*CHY1-DP*CH3P1)) - RH3P=TSLX*(S0-SQRT(S1)) -C -C FEHPO4-FE+HPO4 -C - DP=DPF1P*A1A23D - S0=CFE1+CH1P1+DP - S1=AMAX1(0.0,S0**2-4.0*(CFE1*CH1P1-DP*CF1P1)) - RF1P=TSLX*(S0-SQRT(S1)) -C -C FEH2PO4-FE+H2PO4 -C - DP=DPF2P*A2A13D - S0=CFE1+CH2P1+DP - S1=AMAX1(0.0,S0**2-4.0*(CFE1*CH2P1-DP*CF2P1)) - RF2P=TSLX*(S0-SQRT(S1)) -C -C CAPO4-CA+PO4 -C - DP=DPC0P*A1A23D - S0=CCA1+CH0P1+DP - S1=AMAX1(0.0,S0**2-4.0*(CCA1*CH0P1-DP*CC0P1)) - RC0P=TSLX*(S0-SQRT(S1)) -C -C CAHPO4-CA+HPO4 -C - DP=DPC1P*A0A22 - S0=CCA1+CH1P1+DP - S1=AMAX1(0.0,S0**2-4.0*(CCA1*CH1P1-DP*CC1P1)) - RC1P=TSLX*(S0-SQRT(S1)) -C -C CAH2PO4-CA+H2PO4 -C - DP=DPC2P/A2 - S0=CCA1+CH2P1+DP - S1=AMAX1(0.0,S0**2-4.0*(CCA1*CH2P1-DP*CC2P1)) - RC2P=TSLX*(S0-SQRT(S1)) -C -C MGHPO4-MG+HPO4 -C - DP=DPM1P*A0A22 - S0=CMG1+CH1P1+DP - S1=AMAX1(0.0,S0**2-4.0*(CMG1*CH1P1-DP*CM1P1)) - RM1P=TSLX*(S0-SQRT(S1)) - ELSE - RH1P=0.0 - RH2P=0.0 - RH3P=0.0 - RF1P=0.0 - RF2P=0.0 - RC0P=0.0 - RC1P=0.0 - RC2P=0.0 - RM1P=0.0 - ENDIF -C -C PHOSPHORUS IN BAND SOIL ZONE -C - IF(VOLWPB.GT.ZEROS(NY,NX))THEN -C -C HPO4-H+PO4 -C - DP=DPH1P*A2A13D - S0=CH0PB+CHY1+DP - S1=AMAX1(0.0,S0**2-4.0*(CH0PB*CHY1-DP*CH1PB)) - RH1B=TSLX*(S0-SQRT(S1)) -C -C H2PO4-H+HPO4 -C - DP=DPH2P/A2 - S0=CH1PB+CHY1+DP - S1=AMAX1(0.0,S0**2-4.0*(CH1PB*CHY1-DP*CH2B1)) - RH2B=TSLX*(S0-SQRT(S1)) -C -C H3PO4-H+H2PO4 -C - DP=DPH3P*A0A12 - S0=CH2B1+CHY1+DP - S1=AMAX1(0.0,S0**2-4.0*(CH2B1*CHY1-DP*CH3PB)) - RH3B=TSLX*(S0-SQRT(S1)) -C -C FEHPO4-FE+HPO4 -C - DP=DPF1P*A1A23D - S0=CFE1+CH1PB+DP - S1=AMAX1(0.0,S0**2-4.0*(CFE1*CH1PB-DP*CF1PB)) - RF1B=TSLX*(S0-SQRT(S1)) -C -C FEH2PO4-FE+H2PO4 -C - DP=DPF2P*A2A13D - S0=CFE1+CH2B1+DP - S1=AMAX1(0.0,S0**2-4.0*(CFE1*CH2B1-DP*CF2PB)) - RF2B=TSLX*(S0-SQRT(S1)) -C -C CAPO4-CA+PO4 -C - DP=DPC0P*A1A23D - S0=CCA1+CH0PB+DP - S1=AMAX1(0.0,S0**2-4.0*(CCA1*CH0PB-DP*CC0PB)) - RC0B=TSLX*(S0-SQRT(S1)) -C -C CAHPO4-CA+HPO4 -C - DP=DPC1P*A0A22 - S0=CCA1+CH1PB+DP - S1=AMAX1(0.0,S0**2-4.0*(CCA1*CH1PB-DP*CC1PB)) - RC1B=TSLX*(S0-SQRT(S1)) -C -C CAH2PO4-CA+H2PO4 -C - DP=DPC2P/A2 - S0=CCA1+CH2B1+DP - S1=AMAX1(0.0,S0**2-4.0*(CCA1*CH2B1-DP*CC2PB)) - RC2B=TSLX*(S0-SQRT(S1)) -C -C MGHPO4-MG+HPO4 -C - DP=DPM1P*A0A22 - S0=CMG1+CH1PB+DP - S1=AMAX1(0.0,S0**2-4.0*(CMG1*CH1PB-DP*CM1PB)) - RM1B=TSLX*(S0-SQRT(S1)) - ELSE - RH1B=0.0 - RH2B=0.0 - RH3B=0.0 - RF1B=0.0 - RF2B=0.0 - RC0B=0.0 - RC1B=0.0 - RC2B=0.0 - RM1B=0.0 - ENDIF -C -C TOTAL ION FLUXES FOR CURRENT ITERATION -C FROM ALL REACTIONS ABOVE -C - RN4S=RNH4-RXN4 - RN4B=RNHB-RXNB - RN3S=-RNH4 - RN3B=-RNHB - RAL=-RYAL1-RHAL1-RXAL-RALO1-RALS - 2-(RYA0P1+RHA0P1+RYA0P2+RHA0P2)*VLPO4(L,NY,NX) - 3-(RYA0B1+RHA0B1+RYA0B2+RHA0B2)*VLPOB(L,NY,NX) - RFE=-RYFE1-RHFE1-RFEO1-RFES - 2-(RYF0P1+RHF0P1+RYF0P2+RHF0P2+RF1P+RF2P)*VLPO4(L,NY,NX) - 2-(RYF0B1+RHF0B1+RYF0B2+RHF0B2+RF1B+RF2B)*VLPOB(L,NY,NX) - RHY=-RXHY-RXHC+2.0*(RHALO1+RHFEO1+RHCACO - 2+(RHA0P2+RHF0P2-RHA3P1-RHA4P2-RHF3P1-RHF4P2)*VLPO4(L,NY,NX) - 3+(RHA0B2+RHF0B2-RHA3B1-RHA4B2-RHF3B1-RHF4B2)*VLPOB(L,NY,NX)) - 4+3.0*(RHAL1+RHFE1 - 5-(RHA4P1+RHF4P1)*VLPO4(L,NY,NX) - 6-(RHF4B1+RHA4B1)*VLPOB(L,NY,NX)) - 7+4.0*(RHCAH1*VLPO4(L,NY,NX)+RHCHB1*VLPOB(L,NY,NX)) - 8+7.0*(RHCAH2*VLPO4(L,NY,NX)+RHCHB2*VLPOB(L,NY,NX)) - 9+RHALO2+RHFEO2-RHALO4-RHFEO4+RHCACH-RCO2Q-RHCO3 - 1+(RHA0P1-RHA2P1+RHA1P2-RHA3P2+RHF0P1-RHF2P1+RHF1P2-RHF3P2 - 2+RHCAD2-RXOH2-RXOH1-RHH2P-RHH1P-RH1P-RH2P-RH3P)*VLPO4(L,NY,NX) - 3+(RHA0B1-RHA2B1+RHA1B2-RHA3B2+RHF0B1-RHF2B1+RHF1B2-RHF3B2 - 4+RHCDB2-RXO2B-RXO1B-RHH2B-RHH1B-RH1B-RH2B-RH3B)*VLPOB(L,NY,NX) - 5-RNH4*VLNH4(L,NY,NX)-RNHB*VLNHB(L,NY,NX) - RCA=-RPCACX-RPCASO-RXCA-RCAO-RCAC-RCAH-RCAS - 2-(RPCADX+RPCAMX+RC0P+RC1P+RC2P)*VLPO4(L,NY,NX) - 3-(RPCDBX+RPCMBX+RC0B+RC1B+RC2B)*VLPOB(L,NY,NX) - 4-5.0*(RPCAHX*VLPO4(L,NY,NX)+RPCHBX*VLPOB(L,NY,NX)) - RMG=-RXMG-RMGO-RMGC-RMGH-RMGS - 2-RM1P*VLPO4(L,NY,NX)-RM1B*VLPOB(L,NY,NX) - RNA=-RXNA-RNAC-RNAS - RKA=-RXKA-RKAS - ROH=2.0*(-RYALO1-RYFEO1-RYCACO - 2+(RYA3P1+RYA4P2-RYA0P2+RYF3P1+RYF4P2-RYF0P2)*VLPO4(L,NY,NX) - 3+(RYA3B1+RYA4B2-RYA0B2+RYF3B1+RYF4B2-RYF0B2)*VLPOB(L,NY,NX)) - 4+3.0*(-RYAL1-RYFE1+(RYA4P1+RYF4P1)*VLPO4(L,NY,NX) - 5+(RYA4B1+RYF4B1)*VLPOB(L,NY,NX)) - 6-4.0*(RYCAH1*VLPO4(L,NY,NX)+RYCHB1*VLPOB(L,NY,NX)) - 7-7.0*(RYCAH2*VLPO4(L,NY,NX)+RYCHB2*VLPOB(L,NY,NX)) - 8+RYALO4-RYALO2+RYFEO4-RYFEO2-RYCACH-RCAO-RMGO-RALO1 - 9-RALO2-RALO3-RALO4-RFEO1-RFEO2-RFEO3-RFEO4 - 1-(RYA0P1-RYA2P1+RYA1P2-RYA3P2+RYF0P1-RYF2P1+RYF1P2-RYF3P2 - 2+RYCAD2-RYH2P-RYH1P)*VLPO4(L,NY,NX) - 3-(RYA0B1-RYA2B1+RYA1B2-RYA3B2+RYF0B1-RYF2B1+RYF1B2-RYF3B2 - 4+RYCDB2-RYH2B-RYH1B)*VLPOB(L,NY,NX) - RSO4=-RPCASO-RALS-RFES-RCAS-RMGS-RNAS-RKAS - RCO3=-RYCAC3-RHCAC3-RHCO3-RCAC-RMGC-RNAC - RHCO=-RYCACH-RHCACH-RCO2Q-RCAH-RMGH+RHCO3 - RCO2=-RHCACO-RYCACO+RCO2Q - RH2O=2.0*(-RHALO1-RHFEO1+RYCACO - 2+(RHA2P1+RYA0P2+RYA1P2+RYA2P2+RHA2P2+RYA3P2+RYA4P2 - 3+RHF2P1+RYF0P2+RYF1P2+RYF2P2+RHF2P2+RYF3P2+RYF4P2)*VLPO4(L,NY,NX) - 4+(RHA2B1+RYA0B2+RYA1B2+RYA2B2+RHA2B2+RYA3B2+RYA4B2 - 5+RHF2B1+RYF0B2+RYF1B2+RYF2B2+RHF2B2+RYF3B2+RYF4B2)*VLPOB(L,NY,NX)) - 6+3.0*(-RHAL1-RHFE1 - 7+(RHA3P1+RHA3P2+RHF3P1+RHF3P2+RYCAH1)*VLPO4(L,NY,NX) - 8+(RHA3B1+RHA3B2+RHF3B1+RHF3B2+RYCHB1)*VLPOB(L,NY,NX)) - 9+4.0*((RHA4P1+RHA4P2+RHF4P1+RHF4P2)*VLPO4(L,NY,NX) - 1+(RHA4B1+RHA4B2+RHF4B1+RHF4B2)*VLPOB(L,NY,NX)) - 2+6.0*(RYCAH2*VLPO4(L,NY,NX)+RYCHB2*VLPOB(L,NY,NX)) - 3-RHALO2-RHFEO2+RHALO4+RHFEO4+RYCACH - 4+(RYA0P1+RYA1P1+RHA1P1+RYA2P1+RYA3P1+RYA4P1+RHA1P2 - 5+RYF0P1+RYF1P1+RHF1P1+RYF2P1+RYF3P1+RYF4P1+RHF1P2 - 6+RYCAD2-RHCAH1-RHCAH2+RXH2P+RHH2P+RHH1P)*VLPO4(L,NY,NX) - 7+(RYA0B1+RYA1B1+RHA1B1+RYA2B1+RYA3B1+RYA4B1+RHA1B2 - 8+RYF0B1+RYF1B1+RHF1B1+RYF2B1+RYF3B1+RYF4B1+RHF1B2 - 9+RYCDB2-RHCHB1-RHCHB2+RXH2B+RHH2B+RHH1B)*VLPOB(L,NY,NX) - RAL1=-RYALO1-RHALO1+RALO1-RALO2 - 2-(RYA1P1+RHA1P1+RYA1P2+RHA1P2)*VLPO4(L,NY,NX) - 3-(RYA1B1+RHA1B1+RYA1B2+RHA1B2)*VLPOB(L,NY,NX) - RAL2=-RYALO2-RHALO2+RALO2-RALO3 - 2-(RYA2P1+RHA2P1+RYA2P2+RHA2P2)*VLPO4(L,NY,NX) - 3-(RYA2B1+RHA2B1+RYA2B2+RHA2B2)*VLPOB(L,NY,NX)-RXALO2 - RAL3=-RYALO3-RHALO3+RALO3-RALO4 - 2-(RYA3P1+RHA3P1+RYA3P2+RHA3P2)*VLPO4(L,NY,NX) - 3-(RYA3B1+RHA3B1+RYA3B2+RHA3B2)*VLPOB(L,NY,NX) - RAL4=-RYALO4-RHALO4+RALO4 - 2-(RYA4P1+RHA4P1+RYA4P2+RHA4P2)*VLPO4(L,NY,NX) - 3-(RYA4B1+RHA4B1+RYA4B2+RHA4B2)*VLPOB(L,NY,NX) - RFE1=-RYFEO1-RHFEO1+RFEO1-RFEO2 - 2-(RYF1P1+RHF1P1+RYF1P2+RHF1P2)*VLPO4(L,NY,NX) - 3-(RYF1B1+RHF1B1+RYF1B2+RHF1B2)*VLPOB(L,NY,NX) - RFE2=-RYFEO2-RHFEO2+RFEO2-RFEO3 - 2-(RYF2P1+RHF2P1+RYF2P2+RHF2P2)*VLPO4(L,NY,NX) - 3-(RYF2B1+RHF2B1+RYF2B2+RHF2B2)*VLPOB(L,NY,NX) - RFE3=-RYFEO3-RHFEO3+RFEO3-RFEO4 - 2-(RYF3P1+RHF3P1+RYF3P2+RHF3P2)*VLPO4(L,NY,NX) - 3-(RYF3B1+RHF3B1+RYF3B2+RHF3B2)*VLPOB(L,NY,NX) - RFE4=-RYFEO4-RHFEO4+RFEO4 - 2-(RYF4P1+RHF4P1+RYF4P2+RHF4P2)*VLPO4(L,NY,NX) - 3-(RYF4B1+RHF4B1+RYF4B2+RHF4B2)*VLPOB(L,NY,NX) - RHP0=-RH1P-RC0P - RHP1=-RYA0P1-RHA0P1-RYA1P1-RHA1P1-RYA2P1-RHA2P1-RYA3P1-RHA3P1 - 2-RYA4P1-RHA4P1-RYF0P1-RHF0P1-RYF1P1-RHF1P1-RYF2P1-RHF2P1-RYF3P1 - 3-RHF3P1-RYF4P1-RHF4P1-RPCAD1-3.0*(RYCAH1+RHCAH1)-RYH1P-RHH1P - 4+RH1P-RH2P-RF1P-RC1P-RM1P - RHP2=-RYA0P2-RHA0P2-RYA1P2-RHA1P2-RYA2P2-RHA2P2-RYA3P2-RHA3P2 - 2-RYA4P2-RHA4P2-RYF0P2-RHF0P2-RYF1P2-RHF1P2-RYF2P2-RHF2P2-RYF3P2 - 3-RHF3P2-RYF4P2-RHF4P2-RHCAD2-RYCAD2-3.0*(RYCAH2+RHCAH2) - 4-2.0*RPCAMX-RXH2P-RYH2P-RHH2P+RH2P-RH3P-RF2P-RC2P - RHP3=RH3P - RXH0=-RXOH1 - RXH1=RXOH1-RXOH2-RYH2P-RYH1P-RHH2P-RHH1P - RXH2=RXOH2-RXH2P - RX1P=RYH1P+RHH1P - RX2P=RXH2P+RYH2P+RHH2P -C IF(NY.EQ.5.AND.L.EQ.10)THEN -C WRITE(*,23)'HP2',I,J,NX,NY,L,M,RHP2,RYA0P2,RHA0P2,RYA1P2,RHA1P2 -C 2,RYA2P2,RHA2P2,RYA3P2,RHA3P2,RYA4P2,RHA4P2,RYF0P2,RHF0P2,RYF1P2 -C 3,RHF1P2,RYF2P2,RHF2P2,RYF3P2,RHF3P2,RYF4P2,RHF4P2,RHCAD2,RYCAD2 -C 4,RYCAH2,RHCAH2,RPCAMX,RXH2P,RYH2P,RHH2P,RH2P,RH3P,RF2P,RC2P -23 FORMAT(A8,6I4,60E12.4) -C ENDIF - RHB0=-RH1B-RC0B - RHB1=-RYA0B1-RHA0B1-RYA1B1-RHA1B1-RYA2B1-RHA2B1-RYA3B1-RHA3B1 - 2-RYA4B1-RHA4B1-RYF0B1-RHF0B1-RYF1B1-RHF1B1-RYF2B1-RHF2B1-RYF3B1 - 3-RHF3B1-RYF4B1-RHF4B1-RPCDB1-3.0*(RYCHB1+RHCHB1)-RYH1B-RHH1B - 4+RH1B-RH2B-RF1B-RC1B-RM1B - RHB2=-RYA0B2-RHA0B2-RYA1B2-RHA1B2-RYA2B2-RHA2B2-RYA3B2-RHA3B2 - 2-RYA4B2-RHA4B2-RYF0B2-RHF0B2-RYF1B2-RHF1B2-RYF2B2-RHF2B2-RYF3B2 - 3-RHF3B2-RYF4B2-RHF4B2-RHCDB2-RYCDB2-3.0*(RYCHB2+RHCHB2) - 4-2.0*RPCMBX-RXH2B-RYH2B-RHH2B+RH2B-RH3B-RF2B-RC2B - RHB3=RH3B - RBH0=-RXO1B - RBH1=RXO1B-RXO2B-RYH2B-RYH1B-RHH2B-RHH1B - RBH2=RXO2B-RXH2B - RB1P=RYH1B+RHH1B - RB2P=RXH2B+RYH2B+RHH2B - BNH4=-RXN4*VLNH4(L,NY,NX)-RXNB*VLNHB(L,NY,NX) - BH2P=RHP2*VLPO4(L,NY,NX)+RHB2*VLPOB(L,NY,NX) - BION=RNH4*VLNH4(L,NY,NX)+RNHB*VLNHB(L,NY,NX) -C -C UPDATE ION CONCENTRATIONS FOR CURRENT ITERATION -C FROM TOTAL ION FLUXES -C - CN41=CN41+RN4S - CN4B=CN4B+RN4B - CN31=CN31+RN3S - CN3B=CN3B+RN3B - CAL1=CAL1+RAL - CFE1=CFE1+RFE - CHY1=CHY1+RHY - CCA1=CCA1+RCA - CMG1=CMG1+RMG - CNA1=CNA1+RNA - CKA1=CKA1+RKA - COH1=COH1+ROH - CSO41=CSO41+RSO4 - CCO31=CCO31+RCO3 - CHCO31=CHCO31+RHCO - CCO21=CCO21+RCO2 - CALO1=CALO1+RAL1 - CALO2=CALO2+RAL2 - CALO3=CALO3+RAL3 - CALO4=CALO4+RAL4 - CALS1=CALS1+RALS - CFEO1=CFEO1+RFE1 - CFEO2=CFEO2+RFE2 - CFEO3=CFEO3+RFE3 - CFEO4=CFEO4+RFE4 - CFES1=CFES1+RFES - CCAO1=CCAO1+RCAO - CCAC1=CCAC1+RCAC - CCAH1=CCAH1+RCAH - CCAS1=CCAS1+RCAS - CMGO1=CMGO1+RMGO - CMGC1=CMGC1+RMGC - CMGH1=CMGH1+RMGH - CMGS1=CMGS1+RMGS - CNAC1=CNAC1+RNAC - CNAS1=CNAS1+RNAS - CKAS1=CKAS1+RKAS - CH0P1=CH0P1+RHP0 - CH1P1=CH1P1+RHP1 - CH2P1=CH2P1+RHP2 - CH3P1=CH3P1+RHP3 - CF1P1=CF1P1+RF1P - CF2P1=CF2P1+RF2P - CC0P1=CC0P1+RC0P - CC1P1=CC1P1+RC1P - CC2P1=CC2P1+RC2P - CM1P1=CM1P1+RM1P - CH0PB=CH0PB+RHB0 - CH1PB=CH1PB+RHB1 - CH2B1=CH2B1+RHB2 - CH3PB=CH3PB+RHB3 - CF1PB=CF1PB+RF1B - CF2PB=CF2PB+RF2B - CC0PB=CC0PB+RC0B - CC1PB=CC1PB+RC1B - CC2PB=CC2PB+RC2B - CM1PB=CM1PB+RM1B -C -C REQUILIBRATE H2O-H+OH -C - CHY2=AMAX1(ZERO,CHY1) - COH2=AMAX1(ZERO,COH1) - DP=DPH2O/A1**2 - S0=CHY2+COH2 - S1=AMAX1(0.0,S0**2-4.0*(CHY2*COH2-DP)) - RHOH=0.5*(S0-SQRT(S1)) - RHY=RHY-RHOH - ROH=ROH-RHOH - RH2O=RH2O+RHOH - CHY1=CHY1-RHOH - COH1=COH1-RHOH -C IF((I/10)*10.EQ.I.AND.J.EQ.12.AND.L.LE.3)THEN -C WRITE(*,1111)'CCA1',I,J,L,M,CCA1,CHY1,CH1P1,CH2P1,SPCAD/A22,SPCAD2/A2 -C 2,RCA,RPCACX,RPCASO,RPCADX,RPCDBX,5.0*(RPCAHX+RPCHBX),RPCAMX -C 2,RPCMBX,RXCA,RCAO,RCAC,RCAH,RCAS,RC0P,RC1P,RC2P,RC0B,RC1B,RC2B -C WRITE(*,1111)'CAL1',I,J,L,M,CAL1,CAL1*A3 -C 2,RAL,RYAL1,RYA0P1,RYA0P2,RYA0B1,RYA0B2,RXAL,RALO1,RALS -C 3,CSO41,CALS1,DPALS,A1A23D -C WRITE(*,1111)'CFEO2',I,J,L,M,CFEO2,CFEO2*A1 -C 2,RFE2,RYFEO2,RHFEO2,RYF2P1,RHF2P1,RYF2P2,RHF2P2,RYF2B1,RHF2B1 -C 2,RYF2B2,RHF2B2,RFEO2,RFEO3 -C WRITE(*,1112)'CHY1',I,J,L,M,CHY1,COH1,CHY1*A1,CHYX,COHX,RHOH,RHY1 -C 2,RHY,RXHY,RXHC,RHALO1,RHFEO1,RHCACO,RHA0P2,RHA0B2,RHF0P2,RHF0B2 -C 2,RHA3P1,RHA4P2,RHA3B1,RHA4B2,RHF3P1,RHF4P2,RHF3B1,RHF4B2 -C 3,RHAL1,RHFE1,RHA4P1,RHA4B1,RHF4P1,RHF4B1,RHCAH1 -C 4,RHCHB1,RHCAH2,RHCHB2,RHALO2,RHFEO2,RHALO4,RHFEO4 -C 5,RHCACH,RHA0P1,RHA2P1,RHA1P2,RHA3P2,RHA0B1,RHA2B1,RHA1B2 -C 6,RHA3B2,RHF0P1,RHF2P1,RHF1P2,RHF3P2,RHF0B1,RHF2B1,RHF1B2 -C 7,RHF3B2,RHCAD2,RHCDB2,RXOH2,RXOH1,RXO2B,RXO1B,RHH2P,RHH2B -C 8,RHH1P,RHH1B,RCO2Q,RHCO3,RNH4,RNHB,RH1P,RH2P,RH3P,RH1B,RH2B -C 9,RH3B,(CHY2-RHOH)*(COH2-RHOH),DP -C ENDIF -C WRITE(*,1111)'COH1',I,J,L,M,COH1,COH1*A1 -C 2,ROH,RHOH,RYH2P,RYH2B,RYH1P,RYH1B,RPALPX,RYFEPX,RCAO,RMGO -C 2,RPCAHX,RALO1,RALO2,RALO3,RALO4,RFEO1,RFEO2,RFEO3,RFEO4 -1111 FORMAT(A8,4I4,80E12.4) -C -C UPDATE EXCHANGEABLE ION CONCENTRATIONS IN CURRENT -C ITERATION FROM TOTAL ION FLUXES -C - XN41=XN41+RXN4 - XN4B=XN4B+RXNB - XHY1=XHY1+RXHY - XAL1=XAL1+RXAL - XCA1=XCA1+RXCA - XMG1=XMG1+RXMG - XNA1=XNA1+RXNA - XKA1=XKA1+RXKA - XHC1=XHC1+RXHC - XALO21=XALO21+RXALO2 - XOH01=XOH01+RXH0 - XOH11=XOH11+RXH1 - XOH21=XOH21+RXH2 - XH1P1=XH1P1+RX1P - XH2P1=XH2P1+RX2P - XH01B=XH01B+RBH0 - XH11B=XH11B+RBH1 - XH21B=XH21B+RBH2 - X1P1B=X1P1B+RB1P - X2P1B=X2P1B+RB2P -C -C UPDATE PRECIPITATE CONCENTRATIONS IN CURRENT -C ITERATION FROM TOTAL ION FLUXES -C - PALOH1=PALOH1+RPALOX - PFEOH1=PFEOH1+RPFEOX - PCACO1=PCACO1+RPCACX - PCASO1=PCASO1+RPCASO - PALPO1=PALPO1+RPALPX - PFEPO1=PFEPO1+RPFEPX - PCAPD1=PCAPD1+RPCADX - PCAPH1=PCAPH1+RPCAHX - PCAPM1=PCAPM1+RPCAMX - PALPOB=PALPOB+RPALBX - PFEPOB=PFEPOB+RPFEBX - PCAPDB=PCAPDB+RPCDBX - PCAPHB=PCAPHB+RPCHBX - PCAPMB=PCAPMB+RPCMBX -C -C ACCUMULATE TOTAL ION FLUXES FOR ALL ITERATIONS -C - TRN4S(L,NY,NX)=TRN4S(L,NY,NX)+RN4S - TRN4B(L,NY,NX)=TRN4B(L,NY,NX)+RN4B - TRN3S(L,NY,NX)=TRN3S(L,NY,NX)+RN3S - TRN3B(L,NY,NX)=TRN3B(L,NY,NX)+RN3B - TRAL(L,NY,NX)=TRAL(L,NY,NX)+RAL - TRFE(L,NY,NX)=TRFE(L,NY,NX)+RFE - TRHY(L,NY,NX)=TRHY(L,NY,NX)+RHY - TRCA(L,NY,NX)=TRCA(L,NY,NX)+RCA - TRMG(L,NY,NX)=TRMG(L,NY,NX)+RMG - TRNA(L,NY,NX)=TRNA(L,NY,NX)+RNA - TRKA(L,NY,NX)=TRKA(L,NY,NX)+RKA - TROH(L,NY,NX)=TROH(L,NY,NX)+ROH - TRSO4(L,NY,NX)=TRSO4(L,NY,NX)+RSO4 - TRCO3(L,NY,NX)=TRCO3(L,NY,NX)+RCO3 - TRHCO(L,NY,NX)=TRHCO(L,NY,NX)+RHCO - TBCO2(L,NY,NX)=TBCO2(L,NY,NX)+RCO2 - TRH2O(L,NY,NX)=TRH2O(L,NY,NX)+RH2O - TRAL1(L,NY,NX)=TRAL1(L,NY,NX)+RAL1 - TRAL2(L,NY,NX)=TRAL2(L,NY,NX)+RAL2 - TRAL3(L,NY,NX)=TRAL3(L,NY,NX)+RAL3 - TRAL4(L,NY,NX)=TRAL4(L,NY,NX)+RAL4 - TRALS(L,NY,NX)=TRALS(L,NY,NX)+RALS - TRFE1(L,NY,NX)=TRFE1(L,NY,NX)+RFE1 - TRFE2(L,NY,NX)=TRFE2(L,NY,NX)+RFE2 - TRFE3(L,NY,NX)=TRFE3(L,NY,NX)+RFE3 - TRFE4(L,NY,NX)=TRFE4(L,NY,NX)+RFE4 - TRFES(L,NY,NX)=TRFES(L,NY,NX)+RFES - TRCAO(L,NY,NX)=TRCAO(L,NY,NX)+RCAO - TRCAC(L,NY,NX)=TRCAC(L,NY,NX)+RCAC - TRCAH(L,NY,NX)=TRCAH(L,NY,NX)+RCAH - TRCAS(L,NY,NX)=TRCAS(L,NY,NX)+RCAS - TRMGO(L,NY,NX)=TRMGO(L,NY,NX)+RMGO - TRMGC(L,NY,NX)=TRMGC(L,NY,NX)+RMGC - TRMGH(L,NY,NX)=TRMGH(L,NY,NX)+RMGH - TRMGS(L,NY,NX)=TRMGS(L,NY,NX)+RMGS - TRNAC(L,NY,NX)=TRNAC(L,NY,NX)+RNAC - TRNAS(L,NY,NX)=TRNAS(L,NY,NX)+RNAS - TRKAS(L,NY,NX)=TRKAS(L,NY,NX)+RKAS - TRH0P(L,NY,NX)=TRH0P(L,NY,NX)+RHP0 - TRH1P(L,NY,NX)=TRH1P(L,NY,NX)+RHP1 - TRH2P(L,NY,NX)=TRH2P(L,NY,NX)+RHP2 - TRH3P(L,NY,NX)=TRH3P(L,NY,NX)+RHP3 - TRF1P(L,NY,NX)=TRF1P(L,NY,NX)+RF1P - TRF2P(L,NY,NX)=TRF2P(L,NY,NX)+RF2P - TRC0P(L,NY,NX)=TRC0P(L,NY,NX)+RC0P - TRC1P(L,NY,NX)=TRC1P(L,NY,NX)+RC1P - TRC2P(L,NY,NX)=TRC2P(L,NY,NX)+RC2P - TRM1P(L,NY,NX)=TRM1P(L,NY,NX)+RM1P - TRH0B(L,NY,NX)=TRH0B(L,NY,NX)+RHB0 - TRH1B(L,NY,NX)=TRH1B(L,NY,NX)+RHB1 - TRH2B(L,NY,NX)=TRH2B(L,NY,NX)+RHB2 - TRH3B(L,NY,NX)=TRH3B(L,NY,NX)+RHB3 - TRF1B(L,NY,NX)=TRF1B(L,NY,NX)+RF1B - TRF2B(L,NY,NX)=TRF2B(L,NY,NX)+RF2B - TRC0B(L,NY,NX)=TRC0B(L,NY,NX)+RC0B - TRC1B(L,NY,NX)=TRC1B(L,NY,NX)+RC1B - TRC2B(L,NY,NX)=TRC2B(L,NY,NX)+RC2B - TRM1B(L,NY,NX)=TRM1B(L,NY,NX)+RM1B - TRXN4(L,NY,NX)=TRXN4(L,NY,NX)+RXN4 - TRXNB(L,NY,NX)=TRXNB(L,NY,NX)+RXNB - TRXHY(L,NY,NX)=TRXHY(L,NY,NX)+RXHY - TRXAL(L,NY,NX)=TRXAL(L,NY,NX)+RXAL - TRXCA(L,NY,NX)=TRXCA(L,NY,NX)+RXCA - TRXMG(L,NY,NX)=TRXMG(L,NY,NX)+RXMG - TRXNA(L,NY,NX)=TRXNA(L,NY,NX)+RXNA - TRXKA(L,NY,NX)=TRXKA(L,NY,NX)+RXKA - TRXHC(L,NY,NX)=TRXHC(L,NY,NX)+RXHC - TRXAL2(L,NY,NX)=TRXAL2(L,NY,NX)+RXALO2 - TRXH0(L,NY,NX)=TRXH0(L,NY,NX)+RXH0 - TRXH1(L,NY,NX)=TRXH1(L,NY,NX)+RXH1 - TRXH2(L,NY,NX)=TRXH2(L,NY,NX)+RXH2 - TRX1P(L,NY,NX)=TRX1P(L,NY,NX)+RX1P - TRX2P(L,NY,NX)=TRX2P(L,NY,NX)+RX2P - TRBH0(L,NY,NX)=TRBH0(L,NY,NX)+RBH0 - TRBH1(L,NY,NX)=TRBH1(L,NY,NX)+RBH1 - TRBH2(L,NY,NX)=TRBH2(L,NY,NX)+RBH2 - TRB1P(L,NY,NX)=TRB1P(L,NY,NX)+RB1P - TRB2P(L,NY,NX)=TRB2P(L,NY,NX)+RB2P - TRALOH(L,NY,NX)=TRALOH(L,NY,NX)+RPALOX - TRFEOH(L,NY,NX)=TRFEOH(L,NY,NX)+RPFEOX - TRCACO(L,NY,NX)=TRCACO(L,NY,NX)+RPCACX - TRCASO(L,NY,NX)=TRCASO(L,NY,NX)+RPCASO - TRALPO(L,NY,NX)=TRALPO(L,NY,NX)+RPALPX - TRFEPO(L,NY,NX)=TRFEPO(L,NY,NX)+RPFEPX - TRCAPD(L,NY,NX)=TRCAPD(L,NY,NX)+RPCADX - TRCAPH(L,NY,NX)=TRCAPH(L,NY,NX)+RPCAHX - TRCAPM(L,NY,NX)=TRCAPM(L,NY,NX)+RPCAMX - TRALPB(L,NY,NX)=TRALPB(L,NY,NX)+RPALBX - TRFEPB(L,NY,NX)=TRFEPB(L,NY,NX)+RPFEBX - TRCPDB(L,NY,NX)=TRCPDB(L,NY,NX)+RPCDBX - TRCPHB(L,NY,NX)=TRCPHB(L,NY,NX)+RPCHBX - TRCPMB(L,NY,NX)=TRCPMB(L,NY,NX)+RPCMBX - TBNH4(L,NY,NX)=TBNH4(L,NY,NX)+BNH4 - TBH2P(L,NY,NX)=TBH2P(L,NY,NX)+BH2P - TBION(L,NY,NX)=TBION(L,NY,NX)+BION -C -C GO TO NEXT ITERATION -C -1000 CONTINUE -C -C ITERATIONS COMPLETED -C -C IF(J.EQ.24)THEN -C WRITE(*,1119)'GAPON',I,J,L,M,CH0P1,CAL1,CFE1,CH0P1*A3*CAL1*A3 -C 2,SPALP,CH0P1*A3*CFE1*A3,SPFEP -C 6,SPOH2,XOH11*CHY1*A1/XOH21,SPOH1,XOH01*CHY1*A1/XOH11 -C 7,SPH2P,XOH21*CH2P1*A1/XH2P1,SYH2P,XOH11*CH2P1/(XH2P1*COH1) -C 8,SYH1P,XOH11*CH1P1*A2/(XH1P1*COH1*A1) -C 9,COH1*A1,CHY1*A1 -1119 FORMAT(A8,4I4,24E11.3) -C WRITE(*,1119)'CATION',I,J,L,M,CCEC,XN41+XHY1+3*XAL1+2*(XCA1+XMG1) -C 2+XNA1+XKA1,XN41,XHY1,XAL1,XCA1,XMG1,XNA1,XKA1,CN41,CHY1,CAL1,CCA1 -C 2,CMG1,CNA1,CKA1,(CCA1*A2)**0.5*XN41/(CN41*A1*XCA1*2) -C 3,(CCA1*A2)**0.5*XHY1/(CHY1*A1*XCA1*2) -C 2,(CCA1*A2)**0.5*XAL1*3/((CAL1*A3)**0.333*XCA1*2) -C 3,(CCA1*A2)**0.5*XMG1*2/((CMG1*A2)**0.5*XCA1*2) -C 3,(CCA1*A2)**0.5*XNA1/(CNA1*A1*XCA1*2) -C 5,(CCA1*A2)**0.5*XKA1/(CKA1*A1*XCA1*2) -C 6,CHY1*A1*XCOO/XHC1,CALO2*A1*XCOO/XALO21 -C ENDIF -C -C CONVERT TOTAL ION FLUXES FROM CHANGES IN CONCENTRATION -C TO CHANGES IN MASS PER UNIT AREA FOR USE IN 'REDIST' -C - TRN4S(L,NY,NX)=TRN4S(L,NY,NX)*VOLWNH - TRN4B(L,NY,NX)=TRN4B(L,NY,NX)*VOLWNB - TRN3S(L,NY,NX)=TRN3S(L,NY,NX)*VOLWNH - TRN3B(L,NY,NX)=TRN3B(L,NY,NX)*VOLWNB - TRAL(L,NY,NX)=TRAL(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRFE(L,NY,NX)=TRFE(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRHY(L,NY,NX)=TRHY(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRCA(L,NY,NX)=TRCA(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRMG(L,NY,NX)=TRMG(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRNA(L,NY,NX)=TRNA(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRKA(L,NY,NX)=TRKA(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TROH(L,NY,NX)=TROH(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRSO4(L,NY,NX)=TRSO4(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRCO3(L,NY,NX)=TRCO3(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRHCO(L,NY,NX)=TRHCO(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TBCO2(L,NY,NX)=TBCO2(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRH2O(L,NY,NX)=TRH2O(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRAL1(L,NY,NX)=TRAL1(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRAL2(L,NY,NX)=TRAL2(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRAL3(L,NY,NX)=TRAL3(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRAL4(L,NY,NX)=TRAL4(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRALS(L,NY,NX)=TRALS(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRFE1(L,NY,NX)=TRFE1(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRFE2(L,NY,NX)=TRFE2(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRFE3(L,NY,NX)=TRFE3(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRFE4(L,NY,NX)=TRFE4(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRFES(L,NY,NX)=TRFES(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRCAO(L,NY,NX)=TRCAO(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRCAC(L,NY,NX)=TRCAC(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRCAH(L,NY,NX)=TRCAH(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRCAS(L,NY,NX)=TRCAS(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRMGO(L,NY,NX)=TRMGO(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRMGC(L,NY,NX)=TRMGC(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRMGH(L,NY,NX)=TRMGH(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRMGS(L,NY,NX)=TRMGS(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRNAC(L,NY,NX)=TRNAC(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRNAS(L,NY,NX)=TRNAS(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRKAS(L,NY,NX)=TRKAS(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRH0P(L,NY,NX)=TRH0P(L,NY,NX)*VOLWPO - TRH1P(L,NY,NX)=TRH1P(L,NY,NX)*VOLWPO - TRH2P(L,NY,NX)=TRH2P(L,NY,NX)*VOLWPO - TRH3P(L,NY,NX)=TRH3P(L,NY,NX)*VOLWPO - TRF1P(L,NY,NX)=TRF1P(L,NY,NX)*VOLWPO - TRF2P(L,NY,NX)=TRF2P(L,NY,NX)*VOLWPO - TRC0P(L,NY,NX)=TRC0P(L,NY,NX)*VOLWPO - TRC1P(L,NY,NX)=TRC1P(L,NY,NX)*VOLWPO - TRC2P(L,NY,NX)=TRC2P(L,NY,NX)*VOLWPO - TRM1P(L,NY,NX)=TRM1P(L,NY,NX)*VOLWPO - TRH0B(L,NY,NX)=TRH0B(L,NY,NX)*VOLWPB - TRH1B(L,NY,NX)=TRH1B(L,NY,NX)*VOLWPB - TRH2B(L,NY,NX)=TRH2B(L,NY,NX)*VOLWPB - TRH3B(L,NY,NX)=TRH3B(L,NY,NX)*VOLWPB - TRF1B(L,NY,NX)=TRF1B(L,NY,NX)*VOLWPB - TRF2B(L,NY,NX)=TRF2B(L,NY,NX)*VOLWPB - TRC0B(L,NY,NX)=TRC0B(L,NY,NX)*VOLWPB - TRC1B(L,NY,NX)=TRC1B(L,NY,NX)*VOLWPB - TRC2B(L,NY,NX)=TRC2B(L,NY,NX)*VOLWPB - TRM1B(L,NY,NX)=TRM1B(L,NY,NX)*VOLWPB - TRXN4(L,NY,NX)=TRXN4(L,NY,NX)*VOLWNH - TRXNB(L,NY,NX)=TRXNB(L,NY,NX)*VOLWNB - TRXHY(L,NY,NX)=TRXHY(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRXAL(L,NY,NX)=TRXAL(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRXCA(L,NY,NX)=TRXCA(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRXMG(L,NY,NX)=TRXMG(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRXNA(L,NY,NX)=TRXNA(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRXKA(L,NY,NX)=TRXKA(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRXHC(L,NY,NX)=TRXHC(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRXAL2(L,NY,NX)=TRXAL2(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRXH0(L,NY,NX)=TRXH0(L,NY,NX)*VOLWPO - TRXH1(L,NY,NX)=TRXH1(L,NY,NX)*VOLWPO - TRXH2(L,NY,NX)=TRXH2(L,NY,NX)*VOLWPO - TRX1P(L,NY,NX)=TRX1P(L,NY,NX)*VOLWPO - TRX2P(L,NY,NX)=TRX2P(L,NY,NX)*VOLWPO - TRBH0(L,NY,NX)=TRBH0(L,NY,NX)*VOLWPB - TRBH1(L,NY,NX)=TRBH1(L,NY,NX)*VOLWPB - TRBH2(L,NY,NX)=TRBH2(L,NY,NX)*VOLWPB - TRB1P(L,NY,NX)=TRB1P(L,NY,NX)*VOLWPB - TRB2P(L,NY,NX)=TRB2P(L,NY,NX)*VOLWPB - TRALOH(L,NY,NX)=TRALOH(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRFEOH(L,NY,NX)=TRFEOH(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRCACO(L,NY,NX)=TRCACO(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRCASO(L,NY,NX)=TRCASO(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TRALPO(L,NY,NX)=TRALPO(L,NY,NX)*VOLWPO - TRFEPO(L,NY,NX)=TRFEPO(L,NY,NX)*VOLWPO - TRCAPD(L,NY,NX)=TRCAPD(L,NY,NX)*VOLWPO - TRCAPH(L,NY,NX)=TRCAPH(L,NY,NX)*VOLWPO - TRCAPM(L,NY,NX)=TRCAPM(L,NY,NX)*VOLWPO - TRALPB(L,NY,NX)=TRALPB(L,NY,NX)*VOLWPB - TRFEPB(L,NY,NX)=TRFEPB(L,NY,NX)*VOLWPB - TRCPDB(L,NY,NX)=TRCPDB(L,NY,NX)*VOLWPB - TRCPHB(L,NY,NX)=TRCPHB(L,NY,NX)*VOLWPB - TRCPMB(L,NY,NX)=TRCPMB(L,NY,NX)*VOLWPB - TBNH4(L,NY,NX)=TBNH4(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TBH2P(L,NY,NX)=TBH2P(L,NY,NX)*VOLWM(NPH,L,NY,NX) - TBION(L,NY,NX)=TBION(L,NY,NX)*VOLWM(NPH,L,NY,NX) -C -C IF NO SALTS IS SELECTED IN SITE FILE THEN A SUBSET -C OF THE EQUILIBRIA REACTIONS ARE SOLVED: MOSTLY THOSE -C FOR PHOSPHORUS -C - ELSE -C -C PRECIPITATION-DISSOLUTION CALCULATED FROM ACTIVITIES -C OF REACTANTS AND PRODUCTS THROUGH SOLUTIONS -C FOR THEIR EQUILIBRIUM CONSTANTS USING CURRENT -C ION CONCENTRATION -C - CCEC=AMAX1(ZERO,XCEC(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CHY1=AMAX1(ZERO,10.0**(-(PH(L,NY,NX)-3.0))) - COH1=AMAX1(ZERO,DPH2O/CHY1) - IF(CAL(L,NY,NX).LT.0.0)THEN - CAL1=AMAX1(ZERO,SYALO/COH1**3) - ELSE - CAL1=AMAX1(ZERO,AMIN1(CAL(L,NY,NX),SYALO/COH1**3)) - ENDIF - IF(CFE(L,NY,NX).LT.0.0)THEN - CFE1=AMAX1(ZERO,SYFEO/COH1**3) - ELSE - CFE1=AMAX1(ZERO,AMIN1(CFE(L,NY,NX),SYFEO/COH1**3)) - ENDIF - CMG1=AMAX1(0.0,ZMG(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CNA1=AMAX1(0.0,ZNA(L,NY,NX)/VOLWM(NPH,L,NY,NX)) - CKA1=AMAX1(0.0,ZKA(L,NY,NX)/VOLWM(NPH,L,NY,NX)) -C -C CA CONCENTRATION FROM CURRENT CO2 CONCENTRATION -C - CCO21=AMAX1(ZERO,CCO2S(L,NY,NX)/12.0) - CCO31=AMAX1(ZERO,CCO21*DPCO3/CHY1**2) - IF(CCA(L,NY,NX).LT.0.0)THEN - CCA1=AMAX1(ZERO,AMIN1(CCAMX,SPCAC/CCO31)) - ELSE - CCA1=AMAX1(ZERO,AMIN1(CCA(L,NY,NX),SPCAC/CCO31)) - ENDIF -C -C PHOSPHORUS TRANSFORMATIONS IN NON-BAND SOIL ZONE -C - IF(VOLWPO.GT.ZEROS(NY,NX))THEN -C -C ALUMINUM PHOSPHATE (VARISCITE) -C - CH2PA=SYA0P2/(CAL1*COH1**2) - RPALPX=AMAX1(-PALPO1,TPD*(CH2P1-CH2PA)) -C -C IRON PHOSPHATE (STRENGITE) -C - CH2PF=SYF0P2/(CFE1*COH1**2) - RPFEPX=AMAX1(-PFEPO1,TPD*(CH2P1-CH2PF)) -C IF(I.EQ.180.AND.J.EQ.12)THEN -C WRITE(*,1117)'RPFEPX',I,J,L,CH2PA,SYA0P2,CAL1,COH1,PALPO1 -C 2,CH2P1,CH2PF,SYF0P2,CFE1,COH1,PFEPO1,CH2P1,RPALPX,RPFEPX -C 3,CAL(L,NY,NX),CFE(L,NY,NX) -C ENDIF -C -C DICALCIUM PHOSPHATE -C - CH2PD=SYCAD2/(CCA1*COH1) - RPCADX=AMAX1(-PCAPD1,TPD*(CH2P1-CH2PD)) -C -C HYDROXYAPATITE -C - CH2PH=(SYCAH2/(CCA1**5*COH1**7))**0.333 - RPCAHX=AMAX1(-PCAPH1,TPD*(CH2P1-CH2PH)) -C -C MONOCALCIUM PHOSPHATE -C - CH2PM=SQRT(SPCAM/CCA1) - RPCAMX=AMAX1(-PCAPM1*SPPO4,TPD*(CH2P1-CH2PM)) -C IF(I.GT.315)THEN -C WRITE(*,1117)'RPPO4',I,J,L,RPCADX,CH2P1,CH2PD,PCAPD1,RPCAHX -C 2,CH2PA,CH2PH,SYA0P2,CAL1,COH1,SYCAH2,CCA1,CCO21,CCO31,PCAPH1 -C 3,VOLWPO,SPCAC/CCO31,CCA(L,NY,NX),H2PO4(L,NY,NX) -C 4,VOLWM(NPH,L,NY,NX),ZCA(L,NY,NX),CCO2S(L,NY,NX) -1117 FORMAT(A8,3I4,30E12.4) -C ENDIF -C -C PHOSPHORUS ANION EXCHANGE IN NON-BAND SOIL ZONE -C CALCULATED FROM EXCHANGE EQUILIBRIA AMONG H2PO4-, -C HPO4--, H+, OH- AND PROTONATED AND NON-PROTONATED -OH -C EXCHANGE SITES -C - IF(AEC(L,NY,NX).GT.0.0)THEN -C -C PROTONATION OF ANION EXCHANGE SITES IN NON-BAND SOIL ZONE -C - DCHG=AMAX1(-1.0E+02,XOH21-XOH01-XH1P1) - AEP=EXP(AE*DCHG/TKS(L,NY,NX)) - AEN=EXP(-AE*DCHG/TKS(L,NY,NX)) -C -C H2PO4 EXCHANGE IN NON-BAND SOIL ZONE FROM CONVERGENCE -C SOLUTION FOR EQUILIBRIUM AMONG H2PO4-, H+, OH-, X-OH -C AND X-H2PO4 -C - SPH2P=SYH2P*DPH2O/(SXOH2*AEP) - X0=XOH21+CH2P1+SPH2P - X1=AMAX1(0.0,X0**2-4.0*(XOH21*CH2P1-SPH2P*XH2P1)) - RXH2P=TADA*(X0-SQRT(X1)) - X0=XOH11+CH2P1+SYH2P*COH1 - X1=AMAX1(0.0,X0**2-4.0*(XOH11*CH2P1-SYH2P*COH1*XH2P1)) - RYH2P=TADA*(X0-SQRT(X1)) -C -C HPO4 EXCHANGE IN NON-BAND SOIL ZONE FROM CONVERGENCE -C SOLUTION FOR EQUILIBRIUM AMONG HPO4--, H+, OH-, X-OH -C AND X-HPO4 -C - SPH1P=SYH1P*DPH2O*AEN/DPH2P - X0=XOH11+CH2P1+SPH1P - X1=AMAX1(0.0,X0**2-4.0*(XOH11*CH2P1-SPH1P*XH1P1)) - RXH1P=TADA*(X0-SQRT(X1)) -C WRITE(*,1116)'RXH2P',I,J,NX,NY,L,RXH2P -C 2,XOH21,CH2P1,XH2P1,XOH21*(CH2P1-RXH2P)/(XH2P1+RXH2P),SPH2P -C 3,H2PO4(L,NY,NX),RH2PX,VOLWPO,AEP -C WRITE(*,1116)'RYH2P',I,J,NX,NY,L,RYH2P -C 2,XOH11,CH2P1,XH2P1,COH1,(XOH11*(CH2P1-RYH2P)) -C 3/((XH2P1+RYH2P)*COH1),SYH2P -C WRITE(*,1116)'RXH1P',I,J,NX,NY,L,RXH1P,X0,X1 -C 2,XOH11,CH2P1,XH1P1,XOH11*(CH2P1-RXH1P)/(XH1P1+RXH1P),SPH1P -C 3,SYH1P,DPH2O,AEN,DPH2P,XOH1(L,NY,NX),VLPO4(L,NY,NX),VLPOB(L,NY,NX) -C 4,AE,DCHG,TKS(L,NY,NX),XOH21,XOH01 -1116 FORMAT(A8,5I4,40E12.4) - ELSE - RXH2P=0.0 - RYH2P=0.0 - RXH1P=0.0 - ENDIF - ELSE - RPALPX=0.0 - RPFEPX=0.0 - RPCADX=0.0 - RPCAHX=0.0 - RPCAMX=0.0 - RXH2P=0.0 - RYH2P=0.0 - RXH1P=0.0 - ENDIF -C IF(J.EQ.1)THEN -C WRITE(*,2222)'PO4',I,J,L,CH2P1,PALPO1,PFEPO1,PCAPD1,PCAPH1,PCAPM1 -C 2,CH2PA,CH2PF,CH2PD,CH2PH,CH2PM,RPALPX,RPFEPX,RPCADX,RPCAHX,RPCAMX -C 3,XH2P1,RXH2P,RYH2P -C 3,CAL1,CFE1,CCA1,CHY1,COH1 -2222 FORMAT(A8,3I4,40E12.4) -C ENDIF -C -C PHOSPHORUS PRECIPITATION-DISSOLUTION IN BAND SOIL ZONE -C - IF(VOLWPB.GT.ZEROS(NY,NX))THEN -C -C ALUMINUM PHOSPHATE (VARISCITE) -C - CH2PA=SYA0P2/(CAL1*COH1**2) - RPALBX=AMAX1(-PALPOB,TPD*(CH2B1-CH2PA)) -C -C IRON PHOSPHATE (STRENGITE) -C - CH2PF=SYF0P2/(CFE1*COH1**2) - RPFEBX=AMAX1(-PFEPOB,TPD*(CH2B1-CH2PF)) -C -C DICALCIUM PHOSPHATE -C - CH2PD=SYCAD2/(CCA1*COH1) - RPCDBX=AMAX1(-PCAPDB,TPD*(CH2B1-CH2PD)) -C -C HYDROXYAPATITE -C - CH2PH=(SYCAH2/(CCA1**5*COH1**7))**0.333 - RPCHBX=AMAX1(-PCAPHB,TPD*(CH2B1-CH2PH)) -C -C MONOCALCIUM PHOSPHATE -C - CH2PM=SQRT(SPCAM/CCA1) - RPCMBX=AMAX1(-PCAPMB*SPPO4,TPD*(CH2B1-CH2PM)) -C -C PHOSPHORUS ANION EXCHANGE IN BAND SOIL ZONE -C CALCULATED FROM EXCHANGE EQUILIBRIA AMONG H2PO4-, -C HPO4--, H+, OH- AND PROTONATED AND NON-PROTONATED -OH -C EXCHANGE SITES -C - IF(AEC(L,NY,NX).GT.0.0)THEN -C -C PROTONATION OF EXCHANGE SITES IN BAND SOIL ZONE -C - DCHG=AMAX1(-0.1E+05,XH21B-XH01B-X1P1B) - AEP=EXP(AE*DCHG/TKS(L,NY,NX)) - AEN=EXP(-AE*DCHG/TKS(L,NY,NX)) -C -C H2PO4 EXCHANGE IN BAND SOIL ZONE FROM CONVERGENCE -C SOLUTION FOR EQUILIBRIUM AMONG H2PO4-, H+, OH-, X-OH -C AND X-H2PO4 -C - RXH2B=TADA*(XH21B*CH2B1-SPH2P*X2P1B)/(SPH2P+XH21B) - RYH2B=TADA*(XH11B*CH2B1-SYH2P*X2P1B*COH1)/(SYH2P*COH1+XH11B) -C -C HPO4 EXCHANGE IN BAND SOIL ZONE FROM CONVERGENCE -C SOLUTION FOR EQUILIBRIUM AMONG HPO4--, H+, OH-, X-OH -C AND X-HPO4 -C - SPH1P=SYH1P*DPH2O*AEN/DPH2P - RXH1B=TADA*(XH11B*CH2B1-SPH1P*X1P1B)/(SPH1P+XH11B) -C WRITE(*,2224)'RXH2B',I,J,L,RXH2B,RXH1B,XH21B,CH2B1,SPH2P,X2P1B -C 2,SPH2P,XH21B,XH11B,CH2B1,SPH1P,X1P1B,SPH1P,XH11B,H2POB(L,NY,NX) -2224 FORMAT(A8,3I4,40E12.4) - ELSE - RXH2B=0.0 - RYH2B=0.0 - RXH1B=0.0 - ENDIF - ELSE - RPALBX=0.0 - RPFEBX=0.0 - RPCDBX=0.0 - RPCHBX=0.0 - RPCMBX=0.0 - RXH2B=0.0 - RYH2B=0.0 - RXH1B=0.0 - ENDIF -C -C CATION EXCHANGE FROM GAPON SELECTIVITY COEFFICIENTS -C FOR CA-NH4, CA-H, CA-AL -C - CALX=AMAX1(ZERO,CAL1)**0.333 - CCAX=AMAX1(ZERO,CCA1)**0.500 - CMGX=AMAX1(ZERO,CMG1)**0.500 -C -C EQUILIBRIUM X-CA CONCENTRATION FROM CEC AND CATION -C CONCENTRATIONS -C - XCAQ=CCEC/(1.0+GKC4(L,NY,NX)*CN41/CCAX*VLNH4(L,NY,NX) - 2+GKC4(L,NY,NX)*CN4B/CCAX*VLNHB(L,NY,NX)+GKCH(L,NY,NX)*CHY1/CCAX - 3+GKCA(L,NY,NX)*CALX/CCAX+GKCM(L,NY,NX)*CMGX/CCAX - 3+GKCN(L,NY,NX)*CNA1/CCAX+GKCK(L,NY,NX)*CKA1/CCAX) - FCAQ=XCAQ/CCAX - FN4X=FCAQ*GKC4(L,NY,NX) -C -C NH4 EXCHANGE IN NON-BAND AND BAND SOIL ZONES -C - RXN4=TADC*(FN4X*CN41-XN41)/(1.0+FN4X) - RXNB=TADC*(FN4X*CN4B-XN4B)/(1.0+FN4X) -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) -C 3,(CCA1)**0.5*XN41/(CN41*XCAQ),ZCA(L,NY,NX) -C ENDIF -C -C NH4-NH3+H IN NON-BAND AND BAND SOIL ZONES -C - IF(VOLWNH.GT.ZEROS(NY,NX))THEN - RNH4=(CHY1*CN31-DPN4*CN41)/(DPN4+CHY1) - ELSE - RNH4=0.0 - ENDIF - IF(VOLWNB.GT.ZEROS(NY,NX))THEN - RNHB=(CHY1*CN3B-DPN4*CN4B)/(DPN4+CHY1) - ELSE - RNHB=0.0 - ENDIF -C IF(J.EQ.12.AND.L.LE.6)THEN -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) -C 4,RN4X,RN3X,RNBX,R3BX -C ENDIF -C -C TOTAL ION FLUXES FOR ALL REACTIONS ABOVE -C - RN4S=RNH4-RXN4 - RN4B=RNHB-RXNB - RN3S=-RNH4 - RN3B=-RNHB - RHP2=-RXH2P-RYH2P-RXH1P-RPALPX-RPFEPX-RPCADX-2.0*RPCAMX-3.0*RPCAHX - RHB2=-RXH2B-RYH2B-RXH1B-RPALBX-RPFEBX-RPCDBX-2.0*RPCMBX-3.0*RPCHBX - RXH1=-RYH2P-RXH1P - RXH2=-RXH2P - RX1P=RXH1P - RX2P=RXH2P+RYH2P - RBH1=-RYH2B-RXH1B - RBH2=-RXH2B - RB1P=RXH1B - RB2P=RXH2B+RYH2B - RH2O=(RXH2P+RXH1P+RPCADX)*VLPO4(L,NY,NX)+(RXH2B+RXH1B+RPCDBX) - 2*VLPOB(L,NY,NX)+2.0*((RPALPX+RPFEPX)*VLPO4(L,NY,NX) - 3+(RPALBX+RPFEBX)*VLPOB(L,NY,NX))+6.0*(RPCAHX*VLPO4(L,NY,NX) - 4+RPCHBX*VLPOB(L,NY,NX)) - BNH4=-RXN4*VLNH4(L,NY,NX)-RXNB*VLNHB(L,NY,NX) - BH2P=RHP2*VLPO4(L,NY,NX)+RHB2*VLPOB(L,NY,NX) - BION=(RYH2P-RPCAMX)*VLPO4(L,NY,NX)+(RYH2B-RPCMBX)*VLPOB(L,NY,NX) - 2-3.0*((RPALPX+RPFEPX)*VLPO4(L,NY,NX) - 3+(RPALBX+RPFEBX)*VLPOB(L,NY,NX)) - 4-2.0*(RPCADX*VLPO4(L,NY,NX)+RPCDBX*VLPOB(L,NY,NX)) - 5-12.0*(RPCAHX*VLPO4(L,NY,NX)+RPCHBX*VLPOB(L,NY,NX)) -C -C CONVERT TOTAL ION FLUXES FROM CHANGES IN CONCENTRATION -C TO CHANGES IN MASS PER UNIT AREA FOR USE IN 'REDIST' -C - TRN4S(L,NY,NX)=TRN4S(L,NY,NX)+RN4S*VOLWNH - TRN4B(L,NY,NX)=TRN4B(L,NY,NX)+RN4B*VOLWNB - TRN3S(L,NY,NX)=TRN3S(L,NY,NX)+RN3S*VOLWNH - TRN3B(L,NY,NX)=TRN3B(L,NY,NX)+RN3B*VOLWNB - TRH2P(L,NY,NX)=TRH2P(L,NY,NX)+RHP2*VOLWPO - TRH2B(L,NY,NX)=TRH2B(L,NY,NX)+RHB2*VOLWPB - TRXN4(L,NY,NX)=TRXN4(L,NY,NX)+RXN4*VOLWNH - TRXNB(L,NY,NX)=TRXNB(L,NY,NX)+RXNB*VOLWNB - TRXH1(L,NY,NX)=TRXH1(L,NY,NX)+RXH1*VOLWPO - TRXH2(L,NY,NX)=TRXH2(L,NY,NX)+RXH2*VOLWPO - TRX1P(L,NY,NX)=TRX1P(L,NY,NX)+RX1P*VOLWPO - TRX2P(L,NY,NX)=TRX2P(L,NY,NX)+RX2P*VOLWPO - TRBH1(L,NY,NX)=TRBH1(L,NY,NX)+RBH1*VOLWPB - TRBH2(L,NY,NX)=TRBH2(L,NY,NX)+RBH2*VOLWPB - TRB1P(L,NY,NX)=TRB1P(L,NY,NX)+RB1P*VOLWPB - TRB2P(L,NY,NX)=TRB2P(L,NY,NX)+RB2P*VOLWPB - TRALPO(L,NY,NX)=TRALPO(L,NY,NX)+RPALPX*VOLWPO - TRFEPO(L,NY,NX)=TRFEPO(L,NY,NX)+RPFEPX*VOLWPO - TRCAPD(L,NY,NX)=TRCAPD(L,NY,NX)+RPCADX*VOLWPO - TRCAPH(L,NY,NX)=TRCAPH(L,NY,NX)+RPCAHX*VOLWPO - TRCAPM(L,NY,NX)=TRCAPM(L,NY,NX)+RPCAMX*VOLWPO - TRALPB(L,NY,NX)=TRALPB(L,NY,NX)+RPALBX*VOLWPB - TRFEPB(L,NY,NX)=TRFEPB(L,NY,NX)+RPFEBX*VOLWPB - TRCPDB(L,NY,NX)=TRCPDB(L,NY,NX)+RPCDBX*VOLWPB - TRCPHB(L,NY,NX)=TRCPHB(L,NY,NX)+RPCHBX*VOLWPB - TRCPMB(L,NY,NX)=TRCPMB(L,NY,NX)+RPCMBX*VOLWPB - TRH2O(L,NY,NX)=TRH2O(L,NY,NX)+RH2O*VOLWM(NPH,L,NY,NX) - TBNH4(L,NY,NX)=TBNH4(L,NY,NX)+BNH4*VOLWM(NPH,L,NY,NX) - TBH2P(L,NY,NX)=TBH2P(L,NY,NX)+BH2P*VOLWM(NPH,L,NY,NX) - TBION(L,NY,NX)=TBION(L,NY,NX)+BION*VOLWM(NPH,L,NY,NX) -C IF(L.EQ.1)THEN -C WRITE(*,4334)'RH2O',I,J,L,TRH2O(L,NY,NX),RH2O,RXH2P,RXH1P,RPCADX -C 2,VLPO4(L,NY,NX),RXH2B,RXH1B,RPCDBX -C 2,VLPOB(L,NY,NX),RPALPX,RPFEPX,VLPO4(L,NY,NX) -C 3,RPALBX,RPFEBX,VLPOB(L,NY,NX),RPCAHX,VLPO4(L,NY,NX) -C 4,RPCHBX,VLPOB(L,NY,NX),VOLWM(NPH,L,NY,NX) -C 5,TADA,XOH21,CH2P1,SPH2P,XH2P1,H2PO4(L,NY,NX),VOLWPX,RH2PX -C 6,VOLWPO,XH2PS(L,NY,NX),TUPH2P(L,NY,NX) -4334 FORMAT(A8,3I4,40E12.4) -C ENDIF - ENDIF -C -C CHANGE IN WIDTHS AND DEPTHS OF FERTILIZER BANDS FROM -C VERTICAL AND HORIZONTAL DIFFUSION DRIVEN BY CONCENTRATION -C DIFFERENCES BETWEEN BAND AND NON-BAND SOIL ZONES -C -C IF(ROWI(I,NY,NX).GT.0.0)THEN - FLWD=0.5*(FLW(3,L,NY,NX)+FLW(3,L+1,NY,NX))/AREA(3,L,NY,NX) -C -C NH4 FERTILIZER BAND -C - IF(IFNHB(NY,NX).EQ.1.AND.ROWN(NY,NX).GT.0.0)THEN - IF(L.EQ.NU(NY,NX).OR.CDPTH(L-1,NY,NX).LT.DPNH4(NY,NX))THEN -C -C NH4 BAND WIDTH -C - DWNH4=0.5*SQRT(ZNSGL(L,NY,NX))*TORT(NPH,L,NY,NX) - WDNHB(L,NY,NX)=AMIN1(ROWN(NY,NX) - 2,AMAX1(0.025,WDNHB(L,NY,NX))+DWNH4) -C -C NH4 BAND DEPTH -C - IF(CDPTH(L,NY,NX).GE.DPNH4(NY,NX))THEN - DPFLW=FLWD+DWNH4 - DPNH4(NY,NX)=DPNH4(NY,NX)+DPFLW - DPNHB(L,NY,NX)=DPNHB(L,NY,NX)+DPFLW - IF(DPNHB(L,NY,NX).GT.DLYR(3,L,NY,NX))THEN - DPNHB(L+1,NY,NX)=DPNHB(L+1,NY,NX)+(DPNHB(L,NY,NX)-DLYR(3,L,NY,NX)) - WDNHB(L+1,NY,NX)=WDNHB(L,NY,NX) - DPNHB(L,NY,NX)=DLYR(3,L,NY,NX) - ELSEIF(DPNHB(L,NY,NX).LT.0.0)THEN - DPNHB(L-1,NY,NX)=DPNHB(L-1,NY,NX)+DPNHB(L,NY,NX) - DPNHB(L,NY,NX)=0.0 - WDNHB(L,NY,NX)=0.0 - ENDIF - ENDIF -C -C FRACTION OF SOIL LAYER OCCUPIED BY NH4 BAND -C FROM BAND WIDTH X DEPTH -C - XVLNH4=VLNH4(L,NY,NX) - VLNHB(L,NY,NX)=AMIN1(0.999,WDNHB(L,NY,NX)/ROWN(NY,NX) - 2*DPNHB(L,NY,NX)/DLYR(3,L,NY,NX)) - VLNH4(L,NY,NX)=1.0-VLNHB(L,NY,NX) - FVLNH4=AMIN1(0.0,(VLNH4(L,NY,NX)-XVLNH4)/XVLNH4) -C -C TRANSFER NH4, NH3 FROM NON-BAND TO BAND -C DURING BAND GROWTH -C - DNH4S=FVLNH4*ZNH4S(L,NY,NX)/14.0 - DNH3S=FVLNH4*ZNH3S(L,NY,NX)/14.0 - DXNH4=FVLNH4*XN4(L,NY,NX) - TRN4S(L,NY,NX)=TRN4S(L,NY,NX)+DNH4S - TRN4B(L,NY,NX)=TRN4B(L,NY,NX)-DNH4S - TRN3S(L,NY,NX)=TRN3S(L,NY,NX)+DNH3S - TRN3B(L,NY,NX)=TRN3B(L,NY,NX)-DNH3S - TRXN4(L,NY,NX)=TRXN4(L,NY,NX)+DXNH4 - TRXNB(L,NY,NX)=TRXNB(L,NY,NX)-DXNH4 - ELSE -C -C AMALGAMATE NH4 BAND WITH NON-BAND -C - DPNHB(L,NY,NX)=0.0 - WDNHB(L,NY,NX)=0.0 - VLNH4(L,NY,NX)=1.0 - VLNHB(L,NY,NX)=0.0 - ZNH4S(L,NY,NX)=ZNH4S(L,NY,NX)+ZNH4B(L,NY,NX) - ZNH3S(L,NY,NX)=ZNH3S(L,NY,NX)+ZNH3B(L,NY,NX) - ZNH4B(L,NY,NX)=0.0 - ZNH3B(L,NY,NX)=0.0 - XN4(L,NY,NX)=XN4(L,NY,NX)+XNB(L,NY,NX) - XNB(L,NY,NX)=0.0 - ENDIF - ENDIF -C -C NO3 FERTILIZER BAND -C - IF(IFNOB(NY,NX).EQ.1.AND.ROWO(NY,NX).GT.0.0)THEN - IF(L.EQ.NU(NY,NX).OR.CDPTH(L-1,NY,NX).LT.DPNO3(NY,NX))THEN -C -C NO3 BAND WIDTH -C - DWNO3=0.5*SQRT(ZOSGL(L,NY,NX))*TORT(NPH,L,NY,NX) - WDNOB(L,NY,NX)=AMIN1(ROWO(NY,NX),WDNOB(L,NY,NX)+DWNO3) -C -C NO3 BAND DEPTH -C - IF(CDPTH(L,NY,NX).GE.DPNO3(NY,NX))THEN - DPFLW=FLWD+DWNO3 - DPNO3(NY,NX)=DPNO3(NY,NX)+DPFLW - DPNOB(L,NY,NX)=DPNOB(L,NY,NX)+DPFLW - IF(DPNOB(L,NY,NX).GT.DLYR(3,L,NY,NX))THEN - DPNOB(L+1,NY,NX)=DPNOB(L+1,NY,NX)+(DPNOB(L,NY,NX)-DLYR(3,L,NY,NX)) - WDNOB(L+1,NY,NX)=WDNOB(L,NY,NX) - DPNOB(L,NY,NX)=DLYR(3,L,NY,NX) - ELSE IF(DPNOB(L,NY,NX).LT.0.0)THEN - DPNOB(L-1,NY,NX)=DPNOB(L-1,NY,NX)+DPNOB(L,NY,NX) - DPNOB(L,NY,NX)=0.0 - WDNOB(L,NY,NX)=0.0 - ENDIF - ENDIF -C -C FRACTION OF SOIL LAYER OCCUPIED BY NO3 BAND -C FROM BAND WIDTH X DEPTH -C - XVLNO3=VLNO3(L,NY,NX) - VLNOB(L,NY,NX)=AMIN1(0.999,WDNOB(L,NY,NX)/ROWO(NY,NX) - 2*DPNOB(L,NY,NX)/DLYR(3,L,NY,NX)) - VLNO3(L,NY,NX)=1.0-VLNOB(L,NY,NX) - FVLNO3=AMIN1(0.0,(VLNO3(L,NY,NX)-XVLNO3)/XVLNO3) -C -C TRANSFER NO3 FROM NON-BAND TO BAND -C DURING BAND GROWTH -C - DNO3S=FVLNO3*ZNO3S(L,NY,NX)/14.0 - DNO2S=FVLNO3*ZNO2S(L,NY,NX)/14.0 - TRNO3(L,NY,NX)=TRNO3(L,NY,NX)+DNO3S - TRNO2(L,NY,NX)=TRNO2(L,NY,NX)+DNO2S - TRNOB(L,NY,NX)=TRNOB(L,NY,NX)-DNO3S - TRN2B(L,NY,NX)=TRN2B(L,NY,NX)-DNO2S - ELSE -C -C AMALGAMATE NO3 BAND WITH NON-BAND -C - DPNOB(L,NY,NX)=0.0 - WDNOB(L,NY,NX)=0.0 - VLNO3(L,NY,NX)=1.0 - VLNOB(L,NY,NX)=0.0 - ZNO3S(L,NY,NX)=ZNO3S(L,NY,NX)+ZNO3B(L,NY,NX) - ZNO2S(L,NY,NX)=ZNO2S(L,NY,NX)+ZNO2B(L,NY,NX) - ZNO3B(L,NY,NX)=0.0 - ZNO2B(L,NY,NX)=0.0 - ENDIF - ENDIF -C -C PO4 FERTILIZER BAND -C - IF(IFPOB(NY,NX).EQ.1.AND.ROWP(NY,NX).GT.0.0)THEN - IF(L.EQ.NU(NY,NX).OR.CDPTH(L-1,NY,NX).LT.DPPO4(NY,NX))THEN -C -C PO4 BAND WIDTH -C - DWPO4=0.5*SQRT(POSGL(L,NY,NX))*TORT(NPH,L,NY,NX) - WDPOB(L,NY,NX)=AMIN1(ROWP(NY,NX),WDPOB(L,NY,NX)+DWPO4) -C -C PO4 BAND DEPTH -C - IF(CDPTH(L,NY,NX).GE.DPPO4(NY,NX))THEN - DPFLW=FLWD+DWPO4 - DPPO4(NY,NX)=DPPO4(NY,NX)+DPFLW - DPPOB(L,NY,NX)=DPPOB(L,NY,NX)+DPFLW - IF(DPPOB(L,NY,NX).GT.DLYR(3,L,NY,NX))THEN - DPPOB(L+1,NY,NX)=DPPOB(L+1,NY,NX)+(DPPOB(L,NY,NX)-DLYR(3,L,NY,NX)) - WDPOB(L+1,NY,NX)=WDPOB(L,NY,NX) - DPPOB(L,NY,NX)=DLYR(3,L,NY,NX) - ELSE IF(DPPOB(L,NY,NX).LT.0.0)THEN - DPPOB(L-1,NY,NX)=DPPOB(L-1,NY,NX)+DPPOB(L,NY,NX) - DPPOB(L,NY,NX)=0.0 - WDPOB(L,NY,NX)=0.0 - ENDIF - ENDIF -C -C FRACTION OF SOIL LAYER OCCUPIED BY PO4 BAND -C FROM BAND WIDTH X DEPTH -C - XVLPO4=VLPO4(L,NY,NX) - VLPOB(L,NY,NX)=AMIN1(0.999,WDPOB(L,NY,NX)/ROWP(NY,NX) - 2*DPPOB(L,NY,NX)/DLYR(3,L,NY,NX)) - VLPO4(L,NY,NX)=1.0-VLPOB(L,NY,NX) - FVLPO4=AMIN1(0.0,(VLPO4(L,NY,NX)-XVLPO4)/XVLPO4) -C -C TRANSFER NO3 FROM NON-BAND TO BAND -C DURING BAND GROWTH DEPENDING ON SALT -C VS. NON-SALT OPTION -C - IF(ISALT(NY,NX).NE.0)THEN - DZH0P=FVLPO4*H0PO4(L,NY,NX) - DZH1P=FVLPO4*H1PO4(L,NY,NX) - DZH2P=FVLPO4*H2PO4(L,NY,NX)/31.0 - DZH3P=FVLPO4*H3PO4(L,NY,NX) - DZF1P=FVLPO4*ZFE1P(L,NY,NX) - DZF2P=FVLPO4*ZFE2P(L,NY,NX) - DZC0P=FVLPO4*ZCA0P(L,NY,NX) - DZC1P=FVLPO4*ZCA1P(L,NY,NX) - DZC2P=FVLPO4*ZCA2P(L,NY,NX) - DZM1P=FVLPO4*ZMG1P(L,NY,NX) - DXOH0=FVLPO4*XOH0(L,NY,NX) - DXOH1=FVLPO4*XOH1(L,NY,NX) - DXOH2=FVLPO4*XOH2(L,NY,NX) - DXH1P=FVLPO4*XH1P(L,NY,NX) - DXH2P=FVLPO4*XH2P(L,NY,NX) - DPALP=FVLPO4*PALPO(L,NY,NX) - DPFEP=FVLPO4*PFEPO(L,NY,NX) - DPCDP=FVLPO4*PCAPD(L,NY,NX) - DPCHP=FVLPO4*PCAPH(L,NY,NX) - DPCMP=FVLPO4*PCAPM(L,NY,NX) - TRH0P(L,NY,NX)=TRH0P(L,NY,NX)+DZH0P - TRH1P(L,NY,NX)=TRH1P(L,NY,NX)+DZH1P - TRH2P(L,NY,NX)=TRH2P(L,NY,NX)+DZH2P - TRH3P(L,NY,NX)=TRH3P(L,NY,NX)+DZH3P - TRF1P(L,NY,NX)=TRF1P(L,NY,NX)+DZF1P - TRF2P(L,NY,NX)=TRF2P(L,NY,NX)+DZF2P - TRC0P(L,NY,NX)=TRC0P(L,NY,NX)+DZC0P - TRC1P(L,NY,NX)=TRC1P(L,NY,NX)+DZC1P - TRC2P(L,NY,NX)=TRC2P(L,NY,NX)+DZC2P - TRM1P(L,NY,NX)=TRM1P(L,NY,NX)+DZM1P - TRH0B(L,NY,NX)=TRH0B(L,NY,NX)-DZH0P - TRH1B(L,NY,NX)=TRH1B(L,NY,NX)-DZH1P - TRH2B(L,NY,NX)=TRH2B(L,NY,NX)-DZH2P - TRH3B(L,NY,NX)=TRH3B(L,NY,NX)-DZH3P - TRF1B(L,NY,NX)=TRF1B(L,NY,NX)-DZF1P - TRF2B(L,NY,NX)=TRF2B(L,NY,NX)-DZF2P - TRC0B(L,NY,NX)=TRC0B(L,NY,NX)-DZC0P - TRC1B(L,NY,NX)=TRC1B(L,NY,NX)-DZC1P - TRC2B(L,NY,NX)=TRC2B(L,NY,NX)-DZC2P - TRM1B(L,NY,NX)=TRM1B(L,NY,NX)-DZM1P - TRXH0(L,NY,NX)=TRXH0(L,NY,NX)+DXOH0 - TRXH1(L,NY,NX)=TRXH1(L,NY,NX)+DXOH1 - TRXH2(L,NY,NX)=TRXH2(L,NY,NX)+DXOH2 - TRX1P(L,NY,NX)=TRX1P(L,NY,NX)+DXH1P - TRX2P(L,NY,NX)=TRX2P(L,NY,NX)+DXH2P - TRBH0(L,NY,NX)=TRBH0(L,NY,NX)-DXOH0 - TRBH1(L,NY,NX)=TRBH1(L,NY,NX)-DXOH1 - TRBH2(L,NY,NX)=TRBH2(L,NY,NX)-DXOH2 - TRB1P(L,NY,NX)=TRB1P(L,NY,NX)-DXH1P - TRB2P(L,NY,NX)=TRB2P(L,NY,NX)-DXH2P - TRALPO(L,NY,NX)=TRALPO(L,NY,NX)+DPALP - TRFEPO(L,NY,NX)=TRFEPO(L,NY,NX)+DPFEP - TRCAPD(L,NY,NX)=TRCAPD(L,NY,NX)+DPCDP - TRCAPH(L,NY,NX)=TRCAPH(L,NY,NX)+DPCHP - TRCAPM(L,NY,NX)=TRCAPM(L,NY,NX)+DPCMP - TRALPB(L,NY,NX)=TRALPB(L,NY,NX)-DPALP - TRFEPB(L,NY,NX)=TRFEPB(L,NY,NX)-DPFEP - TRCPDB(L,NY,NX)=TRCPDB(L,NY,NX)-DPCDP - TRCPHB(L,NY,NX)=TRCPHB(L,NY,NX)-DPCHP - TRCPMB(L,NY,NX)=TRCPMB(L,NY,NX)-DPCMP - ELSE - DZH2P=FVLPO4*H2PO4(L,NY,NX)/31.0 - DXOH1=FVLPO4*XOH1(L,NY,NX) - DXOH2=FVLPO4*XOH2(L,NY,NX) - DXH2P=FVLPO4*XH2P(L,NY,NX) - DPALP=FVLPO4*PALPO(L,NY,NX) - DPFEP=FVLPO4*PFEPO(L,NY,NX) - DPCDP=FVLPO4*PCAPD(L,NY,NX) - DPCHP=FVLPO4*PCAPH(L,NY,NX) - DPCMP=FVLPO4*PCAPM(L,NY,NX) - TRH2P(L,NY,NX)=TRH2P(L,NY,NX)+DZH2P - TRXH1(L,NY,NX)=TRXH1(L,NY,NX)+DXOH1 - TRXH2(L,NY,NX)=TRXH2(L,NY,NX)+DXOH2 - TRX2P(L,NY,NX)=TRX2P(L,NY,NX)+DXH2P - TRH2B(L,NY,NX)=TRH2B(L,NY,NX)-DZH2P - TRBH1(L,NY,NX)=TRBH1(L,NY,NX)-DXOH1 - TRBH2(L,NY,NX)=TRBH2(L,NY,NX)-DXOH2 - TRB2P(L,NY,NX)=TRB2P(L,NY,NX)-DXH2P - TRALPO(L,NY,NX)=TRALPO(L,NY,NX)+DPALP - TRFEPO(L,NY,NX)=TRFEPO(L,NY,NX)+DPFEP - TRCAPD(L,NY,NX)=TRCAPD(L,NY,NX)+DPCDP - TRCAPH(L,NY,NX)=TRCAPH(L,NY,NX)+DPCHP - TRCAPM(L,NY,NX)=TRCAPM(L,NY,NX)+DPCMP - TRALPB(L,NY,NX)=TRALPB(L,NY,NX)-DPALP - TRFEPB(L,NY,NX)=TRFEPB(L,NY,NX)-DPFEP - TRCPDB(L,NY,NX)=TRCPDB(L,NY,NX)-DPCDP - TRCPHB(L,NY,NX)=TRCPHB(L,NY,NX)-DPCHP - TRCPMB(L,NY,NX)=TRCPMB(L,NY,NX)-DPCMP - ENDIF - ELSE -C -C AMALGAMATE PO4 BAND WITH NON-BAND -C - DPPOB(L,NY,NX)=0.0 - WDPOB(L,NY,NX)=0.0 - VLPOB(L,NY,NX)=0.0 - VLPO4(L,NY,NX)=1.0 - H0PO4(L,NY,NX)=H0PO4(L,NY,NX)+H0POB(L,NY,NX) - H1PO4(L,NY,NX)=H1PO4(L,NY,NX)+H1POB(L,NY,NX) - H2PO4(L,NY,NX)=H2PO4(L,NY,NX)+H2POB(L,NY,NX) - H3PO4(L,NY,NX)=H3PO4(L,NY,NX)+H3POB(L,NY,NX) - ZFE1P(L,NY,NX)=ZFE1P(L,NY,NX)+ZFE1PB(L,NY,NX) - ZFE2P(L,NY,NX)=ZFE2P(L,NY,NX)+ZFE2PB(L,NY,NX) - ZCA0P(L,NY,NX)=ZCA0P(L,NY,NX)+ZCA0PB(L,NY,NX) - ZCA1P(L,NY,NX)=ZCA1P(L,NY,NX)+ZCA1PB(L,NY,NX) - ZCA2P(L,NY,NX)=ZCA2P(L,NY,NX)+ZCA2PB(L,NY,NX) - ZMG1P(L,NY,NX)=ZMG1P(L,NY,NX)+ZMG1PB(L,NY,NX) - H0POB(L,NY,NX)=0.0 - H1POB(L,NY,NX)=0.0 - H2POB(L,NY,NX)=0.0 - H3POB(L,NY,NX)=0.0 - ZFE1PB(L,NY,NX)=0.0 - ZFE2PB(L,NY,NX)=0.0 - ZCA0PB(L,NY,NX)=0.0 - ZCA1PB(L,NY,NX)=0.0 - ZCA2PB(L,NY,NX)=0.0 - ZMG1PB(L,NY,NX)=0.0 - XOH0(L,NY,NX)=XOH0(L,NY,NX)+XOH0B(L,NY,NX) - XOH1(L,NY,NX)=XOH1(L,NY,NX)+XOH1B(L,NY,NX) - XOH2(L,NY,NX)=XOH2(L,NY,NX)+XOH2B(L,NY,NX) - XH1P(L,NY,NX)=XH1P(L,NY,NX)+XH1PB(L,NY,NX) - XH2P(L,NY,NX)=XH2P(L,NY,NX)+XH2PB(L,NY,NX) - XOH0B(L,NY,NX)=0.0 - XOH1B(L,NY,NX)=0.0 - XOH2B(L,NY,NX)=0.0 - XH1PB(L,NY,NX)=0.0 - XH2PB(L,NY,NX)=0.0 - PALPO(L,NY,NX)=PALPO(L,NY,NX)+PALPB(L,NY,NX) - PFEPO(L,NY,NX)=PFEPO(L,NY,NX)+PFEPB(L,NY,NX) - PCAPD(L,NY,NX)=PCAPD(L,NY,NX)+PCPDB(L,NY,NX) - PCAPH(L,NY,NX)=PCAPH(L,NY,NX)+PCPHB(L,NY,NX) - PCAPM(L,NY,NX)=PCAPM(L,NY,NX)+PCPMB(L,NY,NX) - PALPB(L,NY,NX)=0.0 - PFEPB(L,NY,NX)=0.0 - PCPDB(L,NY,NX)=0.0 - PCPHB(L,NY,NX)=0.0 - PCPMB(L,NY,NX)=0.0 - ENDIF - ENDIF -C ENDIF -C -C SUBTRACT FERTILIZER DISSOLUTION FROM FERTILIZER POOLS -C - ZNH4FA(L,NY,NX)=ZNH4FA(L,NY,NX)-RSN4AA-RSN4BA - ZNH3FA(L,NY,NX)=ZNH3FA(L,NY,NX)-RSN3AA-RSN3BA - ZNHUFA(L,NY,NX)=ZNHUFA(L,NY,NX)-RSNUAA-RSNUBA - ZNO3FA(L,NY,NX)=ZNO3FA(L,NY,NX)-RSNOAA-RSNOBA - ZNH4FB(L,NY,NX)=ZNH4FB(L,NY,NX)-RSN4BB - ZNH3FB(L,NY,NX)=ZNH3FB(L,NY,NX)-RSN3BB - ZNHUFB(L,NY,NX)=ZNHUFB(L,NY,NX)-RSNUBB - ZNO3FB(L,NY,NX)=ZNO3FB(L,NY,NX)-RSNOBB -C -C ADD FERTILIZER DISSOLUTION TO ION FLUXES -C - TRN3G(L,NY,NX)=TRN3G(L,NY,NX)+RSN3AA+RSN3BA+RSN3BB - TRN4S(L,NY,NX)=TRN4S(L,NY,NX)+RSN4AA - TRN4B(L,NY,NX)=TRN4B(L,NY,NX)+RSN4BA+RSN4BB - TRN3S(L,NY,NX)=TRN3S(L,NY,NX)+RSNUAA - TRN3B(L,NY,NX)=TRN3B(L,NY,NX)+RSNUBA+RSNUBB - TRNO3(L,NY,NX)=TRNO3(L,NY,NX)+RSNOAA - TRNOB(L,NY,NX)=TRNOB(L,NY,NX)+RSNOBA+RSNOBB - TBNH4(L,NY,NX)=TBNH4(L,NY,NX)+RSN4AA+RSN4BA+RSN4BB - TBNH3(L,NY,NX)=TBNH3(L,NY,NX)+RSN3AA+RSN3BA+RSN3BB - 2+RSNUAA+RSNUBA+RSNUBB - TBNO3(L,NY,NX)=TBNO3(L,NY,NX)+RSNOAA+RSNOBA+RSNOBB - TRN3G(L,NY,NX)=TRN3G(L,NY,NX)*14.0 - TRN4S(L,NY,NX)=TRN4S(L,NY,NX)*14.0 - TRN4B(L,NY,NX)=TRN4B(L,NY,NX)*14.0 - TRN3S(L,NY,NX)=TRN3S(L,NY,NX)*14.0 - TRN3B(L,NY,NX)=TRN3B(L,NY,NX)*14.0 - TRNO3(L,NY,NX)=TRNO3(L,NY,NX)*14.0 - TRNOB(L,NY,NX)=TRNOB(L,NY,NX)*14.0 - TRNO2(L,NY,NX)=TRNO2(L,NY,NX)*14.0 - TRN2B(L,NY,NX)=TRN2B(L,NY,NX)*14.0 - TRH2P(L,NY,NX)=TRH2P(L,NY,NX)*31.0 - TRH2B(L,NY,NX)=TRH2B(L,NY,NX)*31.0 - TRCO2(L,NY,NX)=TBCO2(L,NY,NX)*12.0 -C IF(L.EQ.1)THEN -C WRITE(*,9984)'TRN4S',I,J,L,TRN4S(L,NY,NX) -C 2,RN4S,VOLWNH,RSN4AA,ZNH4FA(L,NY,NX),VLNH4(L,NY,NX) -C 3,TRN4B(L,NY,NX),RN4B,VOLWNB,RSN4BA,RSN4BB,DNH4S -9984 FORMAT(A8,3I4,20E12.4) -C ENDIF - ENDIF -9985 CONTINUE -C -C SURFACE RESIDUE -C - IF(VOLWM(NPH,0,NY,NX).GT.ZEROS(NY,NX))THEN -C -C UREA HYDROLYSIS IN SURFACE RESIDUE -C - IF(VOLQ(0,NY,NX).GT.ZEROS(NY,NX))THEN - COMA=AMIN1(0.1E+06,TOQCK(0,NY,NX)/VOLQ(0,NY,NX)) - ELSE - COMA=0.1E+06 - ENDIF - DUKD=DUKM*(1.0+COMA/DUKI) -C -C UREA HYDROLYSIS INHIBITION -C - IF(ZNHU0(0,NY,NX).GT.ZEROS(NY,NX) - 2.AND.ZNHUI(0,NY,NX).GT.ZEROS(NY,NX))THEN - ZNHUI(0,NY,NX)=ZNHUI(0,NY,NX)-TFNQ(0,NY,NX)**0.25 - 2*RNHUI(IUTYP(NY,NX))*ZNHUI(0,NY,NX) - 3*AMAX1(RNHUI(IUTYP(NY,NX)),1.0-ZNHUI(0,NY,NX)/ZNHU0(0,NY,NX)) - ELSE - ZNHUI(0,NY,NX)=0.0 - ENDIF -C -C UREA CONCENTRATION AND HYDROLYSIS IN SURFACE RESIDUE -C - IF(ZNHUFA(0,NY,NX).GT.ZEROS(NY,NX) - 2.AND.BKVL(0,NY,NX).GT.ZEROS(NY,NX))THEN - CNHUA=ZNHUFA(0,NY,NX)/BKVL(0,NY,NX) - DFNSA=CNHUA/(CNHUA+DUKD) - RSNUA=AMIN1(ZNHUFA(0,NY,NX) - 2,SPNHU*TOQCK(0,NY,NX)*DFNSA*TFNQ(0,NY,NX))*(1.0-ZNHUI(0,NY,NX)) - ELSE - RSNUA=0.0 - ENDIF -C IF(J.EQ.13)THEN -C WRITE(*,8778)'UREA0',I,J,IUTYP(NY,NX) -C 2,ZNHUFA(0,NY,NX),RSNUA -C 2,DFNSA,TFNQ(0,NY,NX),CNHUA,DUKD,DUKM,DUKI,TOQCK(0,NY,NX) -C 3,BKVL(0,NY,NX),TFNQ(0,NY,NX),SPNHU,ZNHU0(0,NY,NX),ZNHUI(0,NY,NX) -C 4,RNHUI(IUTYP(NY,NX)) -8778 FORMAT(A8,3I4,40E12.4) -C ENDIF -C -C NH4, NH3, UREA, NO3 DISSOLUTION IN SURFACE RESIDUE -C FROM FIRST-ORDER FUNCTIONS OF REMAINING -C FERTILIZER (NOTE: SUPERPHOSPHATE AND ROCK PHOSPHATE -C ARE REPRESENTED AS MONOCALCIUM PHOSPHATE AND HYDROXYAPATITE -C MODELLED IN PHOSPHORUS REACTIONS BELOW) -C - RSN4AA=SPNH4*ZNH4FA(0,NY,NX)*THETW(0,NY,NX) - RSN3AA=SPNH3*ZNH3FA(0,NY,NX) - RSNUAA=RSNUA*THETW(0,NY,NX) - RSNOAA=SPNO3*ZNO3FA(0,NY,NX)*THETW(0,NY,NX) - IF(VOLWM(NPH,0,NY,NX).GT.ZEROS(NY,NX))THEN - VOLWMX=14.0*VOLWM(NPH,0,NY,NX) - RN4X=(XNH4S(0,NY,NX)+14.0*RSN4AA)/VOLWMX - RN3X=14.0*RSNUAA/VOLWMX - CN41=AMAX1(0.0,ZNH4S(0,NY,NX)/VOLWMX+RN4X) - CN31=AMAX1(0.0,ZNH3S(0,NY,NX)/VOLWMX+RN3X) - XN41=AMAX1(0.0,XN4(0,NY,NX)/VOLWM(NPH,0,NY,NX)) - VOLWMP=31.0*VOLWM(NPH,0,NY,NX) - RH2PX=XH2PS(0,NY,NX)/VOLWMP - CH2P1=AMAX1(0.0,H2PO4(0,NY,NX)/VOLWMP+RH2PX) - ELSE - RN4X=0.0 - RN3X=0.0 - CN41=0.0 - CN31=0.0 - XN41=0.0 - RH2PX=0.0 - CH2P1=0.0 - ENDIF -C -C PHOSPHORUS TRANSFORMATIONS IN SURFACE RESIDUE -C - PCAPM1=AMAX1(0.0,PCAPM(0,NY,NX)/VOLWM(NPH,0,NY,NX)) - PCAPD1=AMAX1(0.0,PCAPD(0,NY,NX)/VOLWM(NPH,0,NY,NX)) - PCAPH1=AMAX1(0.0,PCAPH(0,NY,NX)/VOLWM(NPH,0,NY,NX)) - PALPO1=AMAX1(0.0,PALPO(0,NY,NX)/VOLWM(NPH,0,NY,NX)) - PFEPO1=AMAX1(0.0,PFEPO(0,NY,NX)/VOLWM(NPH,0,NY,NX)) - CHY1=AMAX1(ZERO,10.0**(-(PH(0,NY,NX)-3.0))) - COH1=AMAX1(ZERO,DPH2O/CHY1) - CAL1=AMAX1(ZERO,SYALO/COH1**3) - CFE1=AMAX1(ZERO,SYFEO/COH1**3) - CCO20=AMAX1(ZERO,CCO2S(0,NY,NX)/12.0) - CCO31=AMAX1(ZERO,CCO20*DPCO3/CHY1**2) - CCA1=AMAX1(ZERO,AMIN1(CCAMX,SPCAC/CCO31)) - CALX=AMAX1(ZERO,CAL1)**0.333 - CCAX=AMAX1(ZERO,CCA1)**0.500 -C -C ALUMINUM PHOSPHATE (VARISCITE) -C - CH2PA=SYA0P2/(CAL1*COH1**2) - RPALPX=AMIN1(AMAX1(0.0,4.0E-08*ORGC(0,NY,NX)-PALPO1) - 2,AMAX1(-PALPO1,TPD*(CH2P1-CH2PA))) -C -C IRON PHOSPHATE (STRENGITE) -C - CH2PF=SYF0P2/(CFE1*COH1**2) - RPFEPX=AMIN1(AMAX1(0.0,2.0E-06*ORGC(0,NY,NX)-PFEPO1) - 2,AMAX1(-PFEPO1,TPD*(CH2P1-CH2PF))) -C -C DICALCIUM PHOSPHATE -C - CH2PD=SYCAD2/(CCA1*COH1) - RPCADX=AMIN1(AMAX1(0-.0,5.0E-05*ORGC(0,NY,NX)-PCAPD1) - 2,AMAX1(-PCAPD1,TPD*(CH2P1-CH2PD))) -C -C HYDROXYAPATITE -C - CH2PH=(SYCAH2/(CCA1**5*COH1**7))**0.333 - RPCAHX=AMIN1(AMAX1(0.0,5.0E-05*ORGC(0,NY,NX)-PCAPH1) - 2,AMAX1(-PCAPH1,TPD*(CH2P1-CH2PH))) -C -C MONOCALCIUM PHOSPHATE -C - CH2PM=SQRT(SPCAM/CCA1) - RPCAMX=AMIN1(AMAX1(0.0,5.0E-05*ORGC(0,NY,NX)-PCAPM1) - 2,AMAX1(-PCAPM1*SPPO4,TPD*(CH2P1-CH2PM))) -C IF(I.GT.315)THEN -C WRITE(*,2227)'RPPO4',I,J,L,RPCAHX,CH2P1,CH2PA,CH2PH -C 2,SYA0P2,CAL1,COH1,SYCAH2,CCA1,CCO21,CCO31,PCAPH1 -C 3,VOLWM(NPH,0,NY,NX),SPCAC/CCO31,H2PO4(0,NY,NX) -C 4,CCO20,DPCO3,CHY1,CCO2S(0,NY,NX) -2227 FORMAT(A8,3I4,20E12.4) -C ENDIF -C -C PHOSPHORUS ANION EXCHANGE IN SURFACE REDISUE -C CALCULATED FROM EXCHANGE EQUILIBRIA AMONG H2PO4-, -C HPO4--, H+, OH- AND PROTONATED AND NON-PROTONATED -OH -C EXCHANGE SITES (NOT CALCULATED) -C -C EQUILIBRIUM X-CA CONCENTRATION FROM CEC AND CATION -C CONCENTRATIONS -C - IF(VOLWM(NPH,0,NY,NX).GT.ZEROS(NY,NX))THEN - CCEC0=AMAX1(0.0,COOH*ORGC(0,NY,NX)/VOLWM(NPH,0,NY,NX)) - ELSE - CCEC0=0.0 - ENDIF - XCAQ=CCEC0/(1.0+GKC4(NU(NY,NX),NY,NX)*CN41/CCAX - 2+GKCH(NU(NY,NX),NY,NX)*CHY1/CCAX+GKCA(NU(NY,NX),NY,NX)*CALX/CCAX) - FCAQ=XCAQ/CCAX - FN4X=FCAQ*GKC4(NU(NY,NX),NY,NX) -C -C NH4 AND NH3 EXCHANGE IN SURFACE RESIDUE -C - RXN4=TADC*(FN4X*CN41-XN41)/(1.0+FN4X) - RNH4=(CHY1*CN31-DPN4*CN41)/(DPN4+CHY1) -C IF(J.EQ.12)THEN -C WRITE(*,2223)'RXN4',I,J,NX,NY,RXN4,CN41,XN41,CCAX,CCA1,CCO20,CCO31 -C 2,XCAQ,CCEC0,FN4X,FCAQ,GKC4(NU(NY,NX),NY,NX),PH(0,NY,NX),CHY1,RNH4 -C 3,CN31,DPN4,ZNH4S(0,NY,NX),XNH4S(0,NY,NX),14.0*RSN4AA,RN4X -2223 FORMAT(A8,4I4,30E12.4) -C ENDIF - ELSE - RSN4AA=0.0 - RSN3AA=0.0 - RSNUAA=0.0 - RSNOAA=0.0 - RPALPX=0.0 - RPFEPX=0.0 - RPCADX=0.0 - RPCAHX=0.0 - RPCAMX=0.0 - RXN4=0.0 - RNH4=0.0 - ENDIF -C -C TOTAL ION FLUXES FOR ALL REACTIONS ABOVE -C - RN4S=RNH4-RXN4 - RN3S=-RNH4 - RHP2=-RPALPX-RPFEPX-RPCADX-2.0*RPCAMX-3.0*RPCAHX - RH2O=RPCADX+2.0*(RPALPX+RPFEPX)+6.0*RPCAHX - BNH4=-RXN4 - BH2P=RHP2 - BION=-RPCAMX-3.0*(RPALPX+RPFEPX)-2.0*RPCADX-12.0*RPCAHX -C -C CONVERT TOTAL ION FLUXES FROM CHANGES IN CONCENTRATION -C TO CHANGES IN MASS PER UNIT AREA FOR USE IN 'REDIST' -C - TRN4S(0,NY,NX)=TRN4S(0,NY,NX)+RN4S*VOLWM(NPH,0,NY,NX) - TRN3S(0,NY,NX)=TRN3S(0,NY,NX)+RN3S*VOLWM(NPH,0,NY,NX) - TRH2P(0,NY,NX)=TRH2P(0,NY,NX)+RHP2*VOLWM(NPH,0,NY,NX) - TRXN4(0,NY,NX)=TRXN4(0,NY,NX)+RXN4*VOLWM(NPH,0,NY,NX) - TRALPO(0,NY,NX)=TRALPO(0,NY,NX)+RPALPX*VOLWM(NPH,0,NY,NX) - TRFEPO(0,NY,NX)=TRFEPO(0,NY,NX)+RPFEPX*VOLWM(NPH,0,NY,NX) - TRCAPD(0,NY,NX)=TRCAPD(0,NY,NX)+RPCADX*VOLWM(NPH,0,NY,NX) - TRCAPH(0,NY,NX)=TRCAPH(0,NY,NX)+RPCAHX*VOLWM(NPH,0,NY,NX) - TRCAPM(0,NY,NX)=TRCAPM(0,NY,NX)+RPCAMX*VOLWM(NPH,0,NY,NX) - TRH2O(0,NY,NX)=TRH2O(0,NY,NX)+RH2O*VOLWM(NPH,0,NY,NX) - TBNH4(0,NY,NX)=TBNH4(0,NY,NX)+BNH4*VOLWM(NPH,0,NY,NX) - TBH2P(0,NY,NX)=TBH2P(0,NY,NX)+BH2P*VOLWM(NPH,0,NY,NX) - TBION(0,NY,NX)=TBION(0,NY,NX)+BION*VOLWM(NPH,0,NY,NX) - ZNH4FA(0,NY,NX)=ZNH4FA(0,NY,NX)-RSN4AA - ZNH3FA(0,NY,NX)=ZNH3FA(0,NY,NX)-RSN3AA - ZNHUFA(0,NY,NX)=ZNHUFA(0,NY,NX)-RSNUAA - ZNO3FA(0,NY,NX)=ZNO3FA(0,NY,NX)-RSNOAA - TRN4S(0,NY,NX)=TRN4S(0,NY,NX)+RSN4AA - TRN3S(0,NY,NX)=TRN3S(0,NY,NX)+RSN3AA+RSNUAA - TRNO3(0,NY,NX)=TRNO3(0,NY,NX)+RSNOAA - TBNH4(0,NY,NX)=TBNH4(0,NY,NX)+RSN4AA - TBNH3(0,NY,NX)=TBNH3(0,NY,NX)+RSN3AA+RSNUAA - TBNO3(0,NY,NX)=TBNO3(0,NY,NX)+RSNOAA - TRN4S(0,NY,NX)=TRN4S(0,NY,NX)*14.0 - TRN3S(0,NY,NX)=TRN3S(0,NY,NX)*14.0 - TRNO3(0,NY,NX)=TRNO3(0,NY,NX)*14.0 - TRH2P(0,NY,NX)=TRH2P(0,NY,NX)*31.0 -C WRITE(*,9989)'TRH2O',I,J,TRH2O(0,NY,NX) -C 2,RH2O,VOLWM(NPH,0,NY,NX),RPCADX,RPALPX,RPFEPX,RPCAHX -C WRITE(*,9989)'TRN4S',I,J,TRN4S(0,NY,NX) -C 2,RN4S,RNH4,RXN4,RSN4AA,VOLWM(NPH,0,NY,NX) -C 3,SPNH4,ZNH4FA(0,NY,NX) -C 4,THETW(0,NY,NX) -9989 FORMAT(A8,2I4,12E12.4) -9990 CONTINUE -9995 CONTINUE - RETURN - END + SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) +C +C THIS SUBROUTINE CALCULATES ALL SOLUTE TRANSFORMATIONS +C FROM THERMODYNAMIC EQUILIBRIA +C + include "parameters.h" + include "blkc.h" + include "blk2a.h" + include "blk2b.h" + include "blk2c.h" + include "blk8a.h" + include "blk8b.h" + include "blk10.h" + include "blk11a.h" + include "blk11b.h" + include "blk13a.h" + include "blk13b.h" + include "blk13c.h" + include "blk15a.h" + include "blk15b.h" + include "blk18a.h" + include "blk18b.h" + include "blk19a.h" + include "blk19b.h" + include "blk19c.h" + include "blk19d.h" + include "blk21a.h" + include "blk21b.h" +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 + 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 + 7,DPAL4=1.2E-05,DPALS=0.16,DPFE1=4.6E-07,DPFE2=7.3E-07 + 8,DPFE3=1.8E-05,DPFE4=1.2E-05,DPFES=7.1E-02,DPCAO=12.5 + 9,DPCAC=4.2E-02,DPCAH=13.5,DPCAS=1.2,DPMGO=0.7,DPMGC=0.3 + 1,DPMGH=67.0,DPMGS=2.1,DPNAC=0.45,DPNAS=3.3E+02,DPKAS=5.0E+01 + 2,DPH1P=4.5E-10,DPH2P=6.3E-05,DPH3P=7.1,DPF1P=4.5E-02 + 3,DPF2P=3.7E-03,DPC0P=3.5E-04,DPC1P=1.82,DPC2P=40.0 + 4,DPM1P=1.23,DPCOH=1.0E-02,DPALO=6.3E+04,DPFEO=6.3E+04) + PARAMETER (DPCO3=DPCO2*DPHCO,SHALO=SPALO/DPH2O**3 + 2,SYAL1=SPALO/DPAL1,SHAL1=SYAL1/DPH2O**2,SYAL2=SYAL1/DPAL2 + 3,SHAL2=SYAL2/DPH2O,SPAL3=SYAL2/DPAL3,SYAL4=SPAL3/DPAL4 + 4,SHAL4=SYAL4*DPH2O,SHFEO=SPFEO/DPH2O**3,SYFE1=SPFEO/DPFE1 + 5,SHFE1=SYFE1/DPH2O**2,SYFE2=SYFE1/DPFE2,SHFE2=SYFE2/DPH2O + 6,SPFE3=SYFE2/DPFE3,SYFE4=SPFE3/DPFE4,SHFE4=SYFE4*DPH2O + 7,SHCAC1=SPCAC/DPHCO,SYCAC1=SHCAC1*DPH2O,SHCAC2=SHCAC1/DPCO2 + 8,SYCAC2=SHCAC2*DPH2O**2,SHA0P1=SPALP/DPH1P,SYA0P1=SHA0P1*DPH2O + 9,SPA1P1=SYA0P1/DPAL1,SYA2P1=SPA1P1/DPAL2,SHA2P1=SYA2P1*DPH2O + 1,SYA3P1=SYA2P1/DPAL3,SHA3P1=SYA3P1*DPH2O**2,SYA4P1=SYA3P1/DPAL4 + 2,SHA4P1=SYA4P1*DPH2O**3,SHA0P2=SHA0P1/DPH2P + 3,SYA0P2=SHA0P2*DPH2O**2,SYA1P2=SYA0P2/DPAL1,SHA1P2=SYA1P2/DPH2O + 4,SPA2P2=SYA1P2/DPAL2,SYA3P2=SPA2P2/DPAL3,SHA3P2=SYA3P2*DPH2O + 5,SYA4P2=SYA3P2/DPAL4,SHA4P2=SYA4P2*DPH2O**2) + PARAMETER (SHF0P1=SPFEP/DPH1P,SYF0P1=SHF0P1*DPH2O + 2,SPF1P1=SYF0P1/DPFE1,SYF2P1=SPF1P1/DPFE2,SHF2P1=SYF2P1*DPH2O + 3,SYF3P1=SYF2P1/DPFE3,SHF3P1=SYF3P1*DPH2O**2,SYF4P1=SYF3P1/DPFE4 + 4,SHF4P1=SYF4P1*DPH2O**3,SHF0P2=SHF0P1/DPH2P + 4,SYF0P2=SHF0P2*DPH2O**2 + 5,SYF1P2=SYF0P2/DPFE1,SHF1P2=SYF1P2/DPH2O,SPF2P2=SYF1P2/DPFE2 + 6,SYF3P2=SPF2P2/DPFE3,SHF3P2=SYF3P2*DPH2O,SYF4P2=SYF3P2/DPFE4 + 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 + 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 + 2,SPNO3=1.0E-00,SPPO4=5.0E-03) + DATA RNHUI/5.0E-03,5.0E-04/ +C +C DUKM FROM SOIL SCI 136:56 +C + NPI=INT(NPH/2) + DO 9995 NX=NHW,NHE + DO 9990 NY=NVN,NVS + DO 9985 L=NU(NY,NX),NL(NY,NX) + IF(VOLWM(NPH,L,NY,NX).GT.ZEROS(NY,NX))THEN +C +C WATER VOLUME IN NON-BAND AND BAND SOIL ZONES +C + VOLWNH=VOLWM(NPH,L,NY,NX)*VLNH4(L,NY,NX) + VOLWNB=VOLWM(NPH,L,NY,NX)*VLNHB(L,NY,NX) + VOLWNO=VOLWM(NPH,L,NY,NX)*VLNO3(L,NY,NX) + VOLWNZ=VOLWM(NPH,L,NY,NX)*VLNOB(L,NY,NX) + VOLWPO=VOLWM(NPH,L,NY,NX)*VLPO4(L,NY,NX) + VOLWPB=VOLWM(NPH,L,NY,NX)*VLPOB(L,NY,NX) + IF(BKVL(L,NY,NX).GT.ZEROS(NY,NX))THEN + BKVLX=BKVL(L,NY,NX) + BKVLNH=BKVL(L,NY,NX)*VLNH4(L,NY,NX) + BKVLNB=BKVL(L,NY,NX)*VLNHB(L,NY,NX) + BKVLNO=BKVL(L,NY,NX)*VLNO3(L,NY,NX) + BKVLNZ=BKVL(L,NY,NX)*VLNOB(L,NY,NX) + BKVLPO=BKVL(L,NY,NX)*VLPO4(L,NY,NX) + BKVLPB=BKVL(L,NY,NX)*VLPOB(L,NY,NX) + ELSE + BKVLX=VOLWM(NPH,L,NY,NX) + BKVLNH=VOLWNH + BKVLNB=VOLWNB + BKVLNO=VOLWNO + BKVLNZ=VOLWNZ + BKVLPO=VOLWPO + BKVLPB=VOLWPB + ENDIF +C +C UREA HYDROLYSIS IN BAND AND NON-BAND SOIL ZONES +C + IF(VOLQ(L,NY,NX).GT.ZEROS(NY,NX))THEN + COMA=AMIN1(0.1E+06,TOQCK(L,NY,NX)/VOLQ(L,NY,NX)) + ELSE + COMA=0.1E+06 + ENDIF + DUKD=DUKM*(1.0+COMA/DUKI) +C +C UREA HYDROLYSIS INHIBITION +C + IF(ZNHU0(L,NY,NX).GT.ZEROS(NY,NX) + 2.AND.ZNHUI(L,NY,NX).GT.ZEROS(NY,NX))THEN + ZNHUI(L,NY,NX)=ZNHUI(L,NY,NX) + 2-RNHUI(IUTYP(NY,NX))*ZNHUI(L,NY,NX) + 3*AMAX1(RNHUI(IUTYP(NY,NX)),1.0-ZNHUI(L,NY,NX)/ZNHU0(L,NY,NX)) + ELSE + ZNHUI(L,NY,NX)=0.0 + ENDIF +C +C UREA CONCENTRATION AND HYDROLYSIS IN NON-BAND +C + 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) + 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) + 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 4,RNHUI(IUTYP(NY,NX)) +8888 FORMAT(A8,4I4,40E12.4) +C ENDIF +C +C NH4, NH3, UREA, NO3 DISSOLUTION IN BAND AND NON-BAND +C SOIL ZONES FROM FIRST-ORDER FUNCTIONS OF REMAINING +C FERTILIZER (NOTE: SUPERPHOSPHATE AND ROCK PHOSPHATE +C ARE REPRESENTED AS MONOCALCIUM PHOSPHATE AND HYDROXYAPATITE +C MODELLED IN PHOSPHORUS REACTIONS BELOW) +C + RSN4AA=SPNH4*ZNH4FA(L,NY,NX)*VLNH4(L,NY,NX) + 2*THETW(L,NY,NX) + RSN3AA=SPNH3*ZNH3FA(L,NY,NX)*VLNH4(L,NY,NX) + RSNUAA=RSNUA*VLNH4(L,NY,NX)*THETW(L,NY,NX) + RSNOAA=SPNO3*ZNO3FA(L,NY,NX)*VLNO3(L,NY,NX) + 2*THETW(L,NY,NX) + RSN4BA=SPNH4*ZNH4FA(L,NY,NX)*VLNHB(L,NY,NX) + 2*THETW(L,NY,NX) + RSN3BA=SPNH3*ZNH3FA(L,NY,NX)*VLNHB(L,NY,NX) + RSNUBA=RSNUA*VLNHB(L,NY,NX)*THETW(L,NY,NX) + RSNOBA=SPNO3*ZNO3FA(L,NY,NX)*VLNOB(L,NY,NX) + 2*THETW(L,NY,NX) + RSN4BB=SPNH4*ZNH4FB(L,NY,NX)*THETW(L,NY,NX) + RSN3BB=SPNH3*ZNH3FB(L,NY,NX) + RSNUBB=RSNUB*VLNHB(L,NY,NX)*THETW(L,NY,NX) + RSNOBB=SPNO3*ZNO3FB(L,NY,NX)*THETW(L,NY,NX) +C +C SOLUBLE AND EXCHANGEABLE NH4 CONCENTRATIONS +C IN NON-BAND AND BAND SOIL ZONES +C + IF(VOLWNH.GT.ZEROS(NY,NX))THEN + VOLWNX=14.0*VOLWNH + RN4X=(-TUPNH4(L,NY,NX)+XNH4S(L,NY,NX)+14.0*RSN4AA)/VOLWNX + RN3X=(-TUPN3S(L,NY,NX)+14.0*RSNUAA)/VOLWNX + CN41=AMAX1(0.0,ZNH4S(L,NY,NX)/VOLWNX+RN4X) + CN31=AMAX1(0.0,ZNH3S(L,NY,NX)/VOLWNX+RN3X) + XN41=AMAX1(0.0,XN4(L,NY,NX)/BKVLNH) + ELSE + RN4X=0.0 + RN3X=0.0 + CN41=0.0 + CN31=0.0 + XN41=0.0 + ENDIF + IF(VOLWNB.GT.ZEROS(NY,NX))THEN + VOLWNX=14.0*VOLWNB + RNBX=(-TUPNHB(L,NY,NX)+XNH4B(L,NY,NX)+14.0*(RSN4BA+RSN4BB)) + 2/VOLWNX + R3BX=(-TUPN3B(L,NY,NX)+14.0*(RSNUBA+RSNUBB)) + 2/VOLWNX + CN4B=AMAX1(0.0,ZNH4B(L,NY,NX)/VOLWNX+RNBX) + CN3B=AMAX1(0.0,ZNH3B(L,NY,NX)/VOLWNX+R3BX) + XN4B=AMAX1(0.0,XNB(L,NY,NX)/BKVLNB) + ELSE + RNBX=0.0 + R3BX=0.0 + CN4B=0.0 + CN3B=0.0 + XN4B=0.0 + ENDIF +C WRITE(*,4141)'RN4X',I,J,NX,NY,L,RN4X,RN3X,RNBX,R3BX +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 +4141 FORMAT(A8,5I4,30E12.4) +C +C SOLUBLE, EXCHANGEABLE AND PRECIPITATED PO4 CONCENTRATIONS IN +C NON-BAND AND BAND SOIL ZONES +C + IF(VOLWPO.GT.ZEROS(NY,NX))THEN + VOLWPX=31.0*VOLWPO + RH1PX=(XH1PS(L,NY,NX)-TUPH1P(L,NY,NX))/VOLWPX + RH2PX=(XH2PS(L,NY,NX)-TUPH2P(L,NY,NX))/VOLWPX + CH1P1=AMAX1(0.0,H1PO4(L,NY,NX)/VOLWPX+RH1PX) + CH2P1=AMAX1(0.0,H2PO4(L,NY,NX)/VOLWPX+RH2PX) + XOH01=AMAX1(0.0,XOH0(L,NY,NX))/BKVLPO + XOH11=AMAX1(0.0,XOH1(L,NY,NX))/BKVLPO + XOH21=AMAX1(0.0,XOH2(L,NY,NX))/BKVLPO + XH1P1=AMAX1(0.0,XH1P(L,NY,NX))/BKVLPO + XH2P1=AMAX1(0.0,XH2P(L,NY,NX))/BKVLPO + PCAPM1=AMAX1(0.0,PCAPM(L,NY,NX))/BKVLPO + PCAPD1=AMAX1(0.0,PCAPD(L,NY,NX))/BKVLPO + PCAPH1=AMAX1(0.0,PCAPH(L,NY,NX))/BKVLPO + PALPO1=AMAX1(0.0,PALPO(L,NY,NX))/BKVLPO + PFEPO1=AMAX1(0.0,PFEPO(L,NY,NX))/BKVLPO +C WRITE(*,8642)'CH2P1',I,J,L,CH2P1,H2PO4(L,NY,NX) +C 2,VOLWPX,RH2PX,XH2PS(L,NY,NX),TUPH2P(L,NY,NX) +8642 FORMAT(A8,3I4,20E12.4) + ELSE + RH1PX=0.0 + RH2PX=0.0 + CH1P1=0.0 + CH2P1=0.0 + XOH01=0.0 + XOH11=0.0 + XOH21=0.0 + XH1P1=0.0 + XH2P1=0.0 + PALPO1=0.0 + PFEPO1=0.0 + PCAPM1=0.0 + PCAPD1=0.0 + PCAPH1=0.0 + ENDIF + IF(VOLWPB.GT.ZEROS(NY,NX))THEN + VOLWPX=31.0*VOLWPB + RH1BX=(XH1BS(L,NY,NX)-TUPH1B(L,NY,NX))/VOLWPX + RH2BX=(XH2BS(L,NY,NX)-TUPH2B(L,NY,NX))/VOLWPX + CH1PB=AMAX1(0.0,H1POB(L,NY,NX)/VOLWPX+RH1BX) + CH2PB=AMAX1(0.0,H2POB(L,NY,NX)/VOLWPX+RH2BX) + XH01B=AMAX1(0.0,XOH0B(L,NY,NX))/BKVLPB + XH11B=AMAX1(0.0,XOH1B(L,NY,NX))/BKVLPB + XH21B=AMAX1(0.0,XOH2B(L,NY,NX))/BKVLPB + X1P1B=AMAX1(0.0,XH1PB(L,NY,NX))/BKVLPB + X2P1B=AMAX1(0.0,XH2PB(L,NY,NX))/BKVLPB + PALPOB=AMAX1(0.0,PALPB(L,NY,NX))/BKVLPB + PFEPOB=AMAX1(0.0,PFEPB(L,NY,NX))/BKVLPB + PCAPMB=AMAX1(0.0,PCPMB(L,NY,NX))/BKVLPB + PCAPDB=AMAX1(0.0,PCPDB(L,NY,NX))/BKVLPB + PCAPHB=AMAX1(0.0,PCPHB(L,NY,NX))/BKVLPB + ELSE + RH1BX=0.0 + RH2BX=0.0 + CH1PB=0.0 + CH2PB=0.0 + XH01B=0.0 + XH11B=0.0 + XH21B=0.0 + X1P1B=0.0 + X2P1B=0.0 + PALPOB=0.0 + PFEPOB=0.0 + PCAPMB=0.0 + PCAPDB=0.0 + PCAPHB=0.0 + ENDIF +C +C IF SALT OPTION SELECTED IN SITE FILE +C THEN SOLVE FULL SET OF EQUILIBRIA REACTIONS +C + IF(ISALT(NY,NX).NE.0)THEN +C +C SOLUBLE NO3 CONCENTRATIONS +C IN NON-BAND AND BAND SOIL ZONES +C + IF(VOLWNO.GT.ZEROS(NY,NX))THEN + CNO1=AMAX1(0.0,ZNO3S(L,NY,NX)/(14.0*VOLWNO)) + ELSE + CNO1=0.0 + ENDIF + IF(VOLWNZ.GT.ZEROS(NY,NX))THEN + CNOB=AMAX1(0.0,ZNO3B(L,NY,NX)/(14.0*VOLWNZ)) + ELSE + CNOB=0.0 + ENDIF + CHY1=AMAX1(0.0,ZHY(L,NY,NX)+XZHYS(L,NY,NX)) + 2/VOLWM(NPH,L,NY,NX) +C +C SOLUTE ION AND ION PAIR CONCENTRATIONS +C + CCEC=AMAX1(ZERO,XCEC(L,NY,NX)/BKVLX) + COH1=AMAX1(0.0,ZOH(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CAL1=AMAX1(0.0,ZAL(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CFE1=AMAX1(0.0,ZFE(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CCA1=AMAX1(0.0,ZCA(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CMG1=AMAX1(0.0,ZMG(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CNA1=AMAX1(0.0,ZNA(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CKA1=AMAX1(0.0,ZKA(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CSO41=AMAX1(0.0,ZSO4(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CCL1=AMAX1(0.0,ZCL(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CCO31=AMAX1(0.0,ZCO3(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CHCO31=AMAX1(0.0,ZHCO3(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CCO21=AMAX1(0.0,CO2S(L,NY,NX)/(12.0*VOLWM(NPH,L,NY,NX))) + CALO1=AMAX1(0.0,ZALOH1(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CALO2=AMAX1(0.0,ZALOH2(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CALO3=AMAX1(0.0,ZALOH3(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CALO4=AMAX1(0.0,ZALOH4(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CALS1=AMAX1(0.0,ZALS(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CFEO1=AMAX1(0.0,ZFEOH1(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CFEO2=AMAX1(0.0,ZFEOH2(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CFEO3=AMAX1(0.0,ZFEOH3(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CFEO4=AMAX1(0.0,ZFEOH4(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CFES1=AMAX1(0.0,ZFES(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CCAO1=AMAX1(0.0,ZCAO(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CCAC1=AMAX1(0.0,ZCAC(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CCAH1=AMAX1(0.0,ZCAH(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CCAS1=AMAX1(0.0,ZCAS(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CMGO1=AMAX1(0.0,ZMGO(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CMGC1=AMAX1(0.0,ZMGC(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CMGH1=AMAX1(0.0,ZMGH(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CMGS1=AMAX1(0.0,ZMGS(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CNAC1=AMAX1(0.0,ZNAC(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CNAS1=AMAX1(0.0,ZNAS(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CKAS1=AMAX1(0.0,ZKAS(L,NY,NX)/VOLWM(NPH,L,NY,NX)) +C +C PO4 CONCENTRATIONS IN NON-BAND AND BAND SOIL ZONES +C + IF(VOLWPO.GT.ZEROS(NY,NX))THEN + VOLWPX=31.0*VOLWPO + CH0P1=AMAX1(0.0,H0PO4(L,NY,NX)/VOLWPO) + CH3P1=AMAX1(0.0,H3PO4(L,NY,NX)/VOLWPO) + CF1P1=AMAX1(0.0,ZFE1P(L,NY,NX)/VOLWPO) + CF2P1=AMAX1(0.0,ZFE2P(L,NY,NX)/VOLWPO) + CC0P1=AMAX1(0.0,ZCA0P(L,NY,NX)/VOLWPO) + CC1P1=AMAX1(0.0,ZCA1P(L,NY,NX)/VOLWPO) + CC2P1=AMAX1(0.0,ZCA2P(L,NY,NX)/VOLWPO) + CM1P1=AMAX1(0.0,ZMG1P(L,NY,NX)/VOLWPO) + ELSE + CH0P1=0.0 + CH3P1=0.0 + CF1P1=0.0 + CF2P1=0.0 + CC0P1=0.0 + CC1P1=0.0 + CC2P1=0.0 + CM1P1=0.0 + ENDIF + IF(VOLWPB.GT.ZEROS(NY,NX))THEN + CH0PB=AMAX1(0.0,H0POB(L,NY,NX)/VOLWPB) + CH3PB=AMAX1(0.0,H3POB(L,NY,NX)/VOLWPB) + CF1PB=AMAX1(0.0,ZFE1PB(L,NY,NX)/VOLWPB) + CF2PB=AMAX1(0.0,ZFE2PB(L,NY,NX)/VOLWPB) + CC0PB=AMAX1(0.0,ZCA0PB(L,NY,NX)/VOLWPB) + CC1PB=AMAX1(0.0,ZCA1PB(L,NY,NX)/VOLWPB) + CC2PB=AMAX1(0.0,ZCA2PB(L,NY,NX)/VOLWPB) + CM1PB=AMAX1(0.0,ZMG1PB(L,NY,NX)/VOLWPB) + ELSE + CH0PB=0.0 + CH3PB=0.0 + CF1PB=0.0 + CF2PB=0.0 + CC0PB=0.0 + CC1PB=0.0 + CC2PB=0.0 + CM1PB=0.0 + ENDIF +C +C EXCHANGEABLE ION CONCENTRATIONS +C + XHY1=AMAX1(0.0,XHY(L,NY,NX)/BKVLX) + XAL1=AMAX1(0.0,XAL(L,NY,NX)/BKVLX) + XFE1=AMAX1(0.0,XFE(L,NY,NX)/BKVLX) + XCA1=AMAX1(0.0,XCA(L,NY,NX)/BKVLX) + XMG1=AMAX1(0.0,XMG(L,NY,NX)/BKVLX) + XNA1=AMAX1(0.0,XNA(L,NY,NX)/BKVLX) + XKA1=AMAX1(0.0,XKA(L,NY,NX)/BKVLX) + XHC1=AMAX1(0.0,XHC(L,NY,NX)/BKVLX) + XALO21=AMAX1(0.0,XALO2(L,NY,NX)/BKVLX) + XFEO21=AMAX1(0.0,XFEO2(L,NY,NX)/BKVLX) + XCOOH=AMAX1(0.0,COOH*ORGC(L,NY,NX)/BKVLX) +C +C PRECIPITATE CONCENTRATIONS +C + PALOH1=AMAX1(0.0,PALOH(L,NY,NX)/BKVLX) + PFEOH1=AMAX1(0.0,PFEOH(L,NY,NX)/BKVLX) + PCACO1=AMAX1(0.0,PCACO(L,NY,NX)/BKVLX) + PCASO1=AMAX1(0.0,PCASO(L,NY,NX)/BKVLX) +C +C CONVERGENCE TOWARDS SOLUTE EQILIBRIA +C + DO 1000 M=1,MRXN + CN41=AMAX1(ZERO,CN41) + CN4B=AMAX1(ZERO,CN4B) + CN31=AMAX1(ZERO,CN31) + CN3B=AMAX1(ZERO,CN3B) + CAL1=AMAX1(ZERO,CAL1) + CFE1=AMAX1(ZERO,CFE1) + CHY1=AMAX1(ZERO,CHY1) + CCA1=AMAX1(ZERO,AMIN1(CCAMX,CCA1)) + CMG1=AMAX1(ZERO,CMG1) + CNA1=AMAX1(ZERO,CNA1) + CKA1=AMAX1(ZERO,CKA1) + COH1=AMAX1(ZERO,COH1) + CSO41=AMAX1(ZERO,CSO41) + CCO31=AMAX1(ZERO,CCO31) + CHCO31=AMAX1(ZERO,CHCO31) + CCO21=AMAX1(ZERO,CCO21) + CALO1=AMAX1(ZERO,CALO1) + CALO2=AMAX1(ZERO,CALO2) + CALO3=AMAX1(ZERO,CALO3) + CALO4=AMAX1(ZERO,CALO4) + CALS1=AMAX1(ZERO,CALS1) + CFEO1=AMAX1(ZERO,CFEO1) + CFEO2=AMAX1(ZERO,CFEO2) + CFEO3=AMAX1(ZERO,CFEO3) + CFEO4=AMAX1(ZERO,CFEO4) + CFES1=AMAX1(ZERO,CFES1) + CCAO1=AMAX1(ZERO,CCAO1) + CCAC1=AMAX1(ZERO,CCAC1) + CCAH1=AMAX1(ZERO,CCAH1) + CCAS1=AMAX1(ZERO,CCAS1) + CMGO1=AMAX1(ZERO,CMGO1) + CMGC1=AMAX1(ZERO,CMGC1) + CMGH1=AMAX1(ZERO,CMGH1) + CMGS1=AMAX1(ZERO,CMGS1) + CNAC1=AMAX1(ZERO,CNAC1) + CNAS1=AMAX1(ZERO,CNAS1) + CKAS1=AMAX1(ZERO,CKAS1) + CH0P1=AMAX1(ZERO,CH0P1) + CH1P1=AMAX1(ZERO,CH1P1) + CH2P1=AMAX1(ZERO,CH2P1) + CH3P1=AMAX1(ZERO,CH3P1) + CF1P1=AMAX1(ZERO,CF1P1) + CF2P1=AMAX1(ZERO,CF2P1) + CC0P1=AMAX1(ZERO,CC0P1) + CC1P1=AMAX1(ZERO,CC1P1) + CC2P1=AMAX1(ZERO,CC2P1) + CM1P1=AMAX1(ZERO,CM1P1) + CH0PB=AMAX1(ZERO,CH0PB) + CH1PB=AMAX1(ZERO,CH1PB) + CH2PB=AMAX1(ZERO,CH2PB) + CH3PB=AMAX1(ZERO,CH3PB) + CF1PB=AMAX1(ZERO,CF1PB) + CF2PB=AMAX1(ZERO,CF2PB) + CC0PB=AMAX1(ZERO,CC0PB) + CC1PB=AMAX1(ZERO,CC1PB) + CC2PB=AMAX1(ZERO,CC2PB) + CM1PB=AMAX1(ZERO,CM1PB) + XCOO=AMAX1(0.0,XCOOH-XHC1-XALO21-XFEO21) +C +C IONIC STRENGTH FROM SUMS OF ION CONCENTRATIONS +C + CC3=CAL1+CFE1 + CA3=CH0P1*VLPO4(L,NY,NX)+CH0PB*VLPOB(L,NY,NX) + CC2=CCA1+CMG1+CALO1+CFEO1+CF2P1*VLPO4(L,NY,NX) + 2+CF2PB*VLPOB(L,NY,NX) + CA2=CSO41+CCO31+CH1P1*VLPO4(L,NY,NX)+CH1PB*VLPOB(L,NY,NX) + CC1=CN41*VLNH4(L,NY,NX)+CN4B*VLNHB(L,NY,NX)+CHY1+CNA1+CKA1 + 2+CALO2+CFEO2+CALS1+CFES1+CCAO1+CCAH1+CMGO1+CMGH1 + 3+(CF1P1+CC2P1)*VLPO4(L,NY,NX)+(CF1PB+CC2PB)*VLPOB(L,NY,NX) + CA1=CNO1*VLNO3(L,NY,NX)+CNOB*VLNOB(L,NY,NX)+COH1+CHCO31+CCL1 + 2+CALO4+CFEO4+CNAC1+CNAS1+CKAS1+(CH2P1+CC0P1)*VLPO4(L,NY,NX) + 3+(CH2PB+CC0PB)*VLPOB(L,NY,NX) + CSTR1=AMAX1(0.0,0.5E-03*(9.0*(CC3+CA3)+4.0*(CC2+CA2) + 2+CC1+CA1)) + CSTR2=SQRT(CSTR1) + FSTR2=CSTR2/(1.0+CSTR2) +C +C ACTIVITY COEFFICIENTS CALCULATED FROM ION STRENGTH +C + A1=AMIN1(1.0,10.0**(-0.509*1.0*FSTR2+0.20*CSTR2)) + A2=AMIN1(1.0,10.0**(-0.509*4.0*FSTR2+0.20*CSTR2)) + A3=AMIN1(1.0,10.0**(-0.509*9.0*FSTR2+0.20*CSTR2)) +C +C PRECIPITATION-DISSOLUTION CALCULATED FROM ACTIVITIES +C OF REACTANTS AND PRODUCTS THROUGH CONVERGENCE SOLUTIONS +C FOR THEIR EQUILIBRIUM CONSTANTS USING SOLUTE FORMS +C CURRENTLY AT HIGHEST CONCENTRATIONS +C + AHY1=CHY1*A1 + AOH1=COH1*A1 + AAL1=CAL1*A3 + AALO1=CALO1*A2 + AALO2=CALO2*A1 + AALO3=CALO3 + AALO4=CALO4*A1 + AFE1=CFE1*A3 + AFEO1=CFEO1*A2 + AFEO2=CFEO2*A1 + AFEO3=CFEO3 + AFEO4=CFEO4*A1 + ACA1=CCA1*A2 + ACO31=CCO31*A2 + AHCO31=CHCO31*A1 + ACO21=CCO21*A0 + ASO41=CSO41*A2 + AH0P1=CH0P1*A3 + AH1P1=CH1P1*A2 + AH2P1=CH2P1*A1 + AH3P1=CH3P1*A0 + AF1P1=CF1P1*A2 + AF2P1=CF2P1*A1 + AC0P1=CC0P1*A1 + AC1P1=CC1P1*A0 + AC2P1=CC2P1*A1 + AM1P1=CM1P1*A0 + AH0PB=CH0PB*A3 + AH1PB=CH1PB*A2 + AH2PB=CH2PB*A1 + AH3PB=CH3PB*A0 + AF1PB=CF1PB*A2 + AF2PB=CF2PB*A1 + AC0PB=CC0PB*A1 + AC1PB=CC1PB*A0 + AC2PB=CC2PB*A1 + AM1PB=CM1PB*A0 + AN41=CN41*A1 + AN4B=CN4B*A1 + AN31=CN31*A0 + AN3B=CN3B*A0 + AMG1=CMG1*A2 + ANA1=CNA1*A1 + AKA1=CKA1*A1 + AALS1=CALS1*A1 + AFES1=CFES1*A1 + ACAO1=CCAO1*A1 + ACAC1=CCAC1*A0 + ACAS1=CCAS1*A0 + ACAH1=CCAH1*A1 + AMGO1=CMGO1*A1 + AMGC1=CMGC1*A0 + AMGH1=CMGH1*A1 + AMGS1=CMGS1*A0 + ANAC1=CNAC1*A1 + ANAS1=CNAS1*A1 + AKAS1=CKAS1*A1 +C +C ALUMINUM HYDROXIDE (GIBBSITE) +C + PX=AMAX1(AAL1,AALO1,AALO2,AALO3,AALO4) + IF(PX.EQ.AAL1)THEN + R1=AHY1 + P1=AAL1 + P2=AOH1 + NR1=3 + NP2=0 + SP=SHALO + ELSEIF(PX.EQ.AALO1)THEN + R1=AHY1 + P1=AALO1 + P2=AOH1 + NR1=2 + NP2=0 + SP=SHAL1 + ELSEIF(PX.EQ.AALO2)THEN + R1=AHY1 + P1=AALO2 + P2=AOH1 + NR1=1 + NP2=0 + SP=SHAL2 + ELSEIF(PX.EQ.AALO3)THEN + R1=AHY1 + P1=AALO3 + P2=AOH1 + NR1=0 + NP2=0 + SP=SPAL3 + ELSEIF(PX.EQ.AALO4)THEN + R1=AOH1 + P1=AALO4 + P2=AHY1 + NR1=0 + NP2=1 + SP=SHAL4 + ENDIF + RHAL1=0.0 + RHALO1=0.0 + RHALO2=0.0 + RHALO3=0.0 + RHALO4=0.0 + R1=AMAX1(ZERO,R1) + P1=AMAX1(ZERO,P1) + P2=AMAX1(ZERO,P2) + SPX=SP*R1**NR1/P2**NP2 + RPALOX=AMAX1(-PALOH1,TPDX*(P1-SPX)) + IF(PX.EQ.AAL1)THEN + RHAL1=RPALOX + ELSEIF(PX.EQ.AALO1)THEN + RHALO1=RPALOX + ELSEIF(PX.EQ.AALO2)THEN + RHALO2=RPALOX + ELSEIF(PX.EQ.AALO3)THEN + RHALO3=RPALOX + ELSEIF(PX.EQ.AALO4)THEN + RHALO4=RPALOX + ENDIF +C IF(I.EQ.180.AND.J.EQ.12)THEN +C WRITE(*,1112)'ALOH',I,J,L,M,PALOH1,AAL1,AALO1,AALO2,AALO3,AALO4 +C 2,AOH1,R1,P1,P2,SP,SPX,RPALOX,RHAL1,RHALO1,RHALO2,RHALO3,RHALO4 +C 3,AAL1*AOH1**3,SPALO +C ENDIF +C +C IRON HYDROXIDE +C + PX=AMAX1(AFE1,AFEO1,AFEO2,AFEO3,AFEO4) + IF(PX.EQ.AFE1)THEN + R1=AHY1 + P1=AFE1 + P2=AOH1 + NR1=3 + NP2=0 + SP=SHFEO + ELSEIF(PX.EQ.AFEO1)THEN + R1=AHY1 + P1=AFEO1 + P2=AOH1 + NR1=2 + NP2=0 + SP=SHFE1 + ELSEIF(PX.EQ.AFEO2)THEN + R1=AHY1 + P1=AFEO2 + P2=AOH1 + NR1=1 + NP2=0 + SP=SHFE2 + ELSEIF(PX.EQ.AFEO3)THEN + R1=AHY1 + P1=AFEO3 + P2=AOH1 + NR1=0 + NP2=0 + SP=SPFE3 + ELSEIF(PX.EQ.AFEO4)THEN + R1=AOH1 + P1=AFEO4 + P2=AHY1 + NR1=0 + NP2=1 + SP=SHFE4 + ENDIF + RHFE1=0.0 + RHFEO1=0.0 + RHFEO2=0.0 + RHFEO3=0.0 + RHFEO4=0.0 + R1=AMAX1(ZERO,R1) + P1=AMAX1(ZERO,P1) + P2=AMAX1(ZERO,P2) + SPX=SP*R1**NR1/P2**NP2 + RPFEOX=AMAX1(-PFEOH1,TPDX*(P1-SPX)) + IF(PX.EQ.AFE1)THEN + RHFE1=RPFEOX + ELSEIF(PX.EQ.AFEO1)THEN + RHFEO1=RPFEOX + ELSEIF(PX.EQ.AFEO2)THEN + RHFEO2=RPFEOX + ELSEIF(PX.EQ.AFEO3)THEN + RHFEO3=RPFEOX + ELSEIF(PX.EQ.AFEO4)THEN + RHFEO4=RPFEOX + ENDIF +C IF(I.EQ.180.AND.J.EQ.12)THEN +C WRITE(*,1112)'FEOH',I,J,L,M,PFEOH1,AFE1,AFEO1,AFEO2,AFEO3,AFEO4 +C 2,AOH1,R1,P1,P2,SP,SPX,RPFEOX,RHFE1,RHFEO1,RHFEO2,RHFEO3,RHFEO4 +C 3,AFE1*AOH1**3,SPFEO +C ENDIF +C +C CALCITE +C + PX=AMAX1(ACO31,AHCO31,ACO21) + R1=AHY1 + P1=ACA1 + IF(PX.EQ.ACO31)THEN + P2=ACO31 + NR1=0 + SP=SPCAC + ELSEIF(PX.EQ.AHCO31)THEN + P2=AHCO31 + NR1=1 + SP=SHCAC1 + ELSEIF(PX.EQ.ACO21)THEN + P2=ACO21 + NR1=2 + SP=SHCAC2 + ENDIF + RHCAC3=0.0 + RHCACH=0.0 + RHCACO=0.0 + R1=AMAX1(ZERO,R1) + P1=AMAX1(ZERO,P1) + P2=AMAX1(ZERO,P2) + SPX=SP*R1**NR1 + S0=P1+P2 + S1=AMAX1(0.0,S0**2-4.0*(P1*P2-SPX)) + RPCACX=AMAX1(-PCACO1,TPDX*(S0-SQRT(S1))) + IF(PX.EQ.ACO31)THEN + RHCAC3=RPCACX + ELSEIF(PX.EQ.AHCO31)THEN + RHCACH=RPCACX + ELSEIF(PX.EQ.ACO21)THEN + RHCACO=RPCACX + ENDIF +C +C GYPSUM +C + P1=ACA1 + P2=ASO41 + P1=AMAX1(ZERO,P1) + P2=AMAX1(ZERO,P2) + SPX=SPCAS + S0=P1+P2 + S1=AMAX1(0.0,S0**2-4.0*(P1*P2-SPX)) + RPCASO=AMAX1(-PCASO1,TPDX*(S0-SQRT(S1))) +C IF((M/10)*10.EQ.M)THEN +C WRITE(*,1112)'CALC',I,J,L,M,PCASO1,ACO31,AHCO31,ACO21,CHY1 +C 2,COH1,R1,P1,P2,P3,SP,Z,TX,RPCACX,RHCAC3,RHCACH,RHCACO +C 3,CCA1*A2*CCO3*A2,SPCAC +C ENDIF +C +C PHOSPHORUS PRECIPITATION-DISSOLUTION IN NON-BAND SOIL ZONE +C + IF(VOLWPO.GT.ZEROS(NY,NX))THEN +C +C ALUMINUM PHOSPHATE (VARISCITE) +C + PX=AMAX1(AAL1,AALO1,AALO2,AALO3,AALO4) + PY=AMAX1(AH1P1,AH2P1) + R1=AHY1 + P3=AHY1 + IF(PY.EQ.AH1P1)THEN + P2=AH1P1 + IF(PX.EQ.AAL1)THEN + P1=AAL1 + NR1=1 + NP3=0 + SP=SHA0P1 + ELSEIF(PX.EQ.AALO1)THEN + P1=AALO1 + NR1=0 + NP3=0 + SP=SPA1P1 + ELSEIF(PX.EQ.AALO2)THEN + P1=AALO2 + NR1=0 + NP3=1 + SP=SHA2P1 + ELSEIF(PX.EQ.AALO3)THEN + P1=AALO3 + NR1=0 + NP3=2 + SP=SHA3P1 + ELSEIF(PX.EQ.AALO4)THEN + P1=AALO4 + NR1=0 + NP3=3 + SP=SHA4P1 + ENDIF + ELSE + P2=AH2P1 + IF(PX.EQ.AAL1)THEN + P1=AAL1 + NR1=2 + NP3=0 + SP=SHA0P2 + ELSEIF(PX.EQ.AALO1)THEN + P1=AALO1 + NR1=1 + NP3=0 + SP=SHA1P2 + ELSEIF(PX.EQ.AALO2)THEN + P1=AALO2 + NR1=0 + NP3=0 + SP=SPA2P2 + ELSEIF(PX.EQ.AALO3)THEN + P1=AALO3 + NR1=0 + NP3=1 + SP=SHA3P2 + ELSEIF(PX.EQ.AALO4)THEN + P1=AALO4 + NR1=0 + NP3=2 + SP=SHA4P2 + ENDIF + ENDIF + RHA0P1=0.0 + RHA1P1=0.0 + RHA2P1=0.0 + RHA3P1=0.0 + RHA4P1=0.0 + RHA0P2=0.0 + RHA1P2=0.0 + RHA2P2=0.0 + RHA3P2=0.0 + RHA4P2=0.0 + R1=AMAX1(ZERO,R1) + P1=AMAX1(ZERO,P1) + P2=AMAX1(ZERO,P2) + P3=AMAX1(ZERO,P3) + SPX=SP*R1**NR1/P3**NP3 + S0=P1+P2 + S1=AMAX1(0.0,S0**2-4.0*(P1*P2-SPX)) + RPALPX=AMAX1(-PALPO1,TPDX*(S0-SQRT(S1))) + IF(PY.EQ.AH1P1)THEN + IF(PX.EQ.AAL1)THEN + RHA0P1=RPALPX + ELSEIF(PX.EQ.AALO1)THEN + RHA1P1=RPALPX + ELSEIF(PX.EQ.AALO2)THEN + RHA2P1=RPALPX + ELSEIF(PX.EQ.AALO3)THEN + RHA3P1=RPALPX + ELSEIF(PX.EQ.AALO4)THEN + RHA4P1=RPALPX + ENDIF + ELSE + IF(PX.EQ.AAL1)THEN + RHA0P2=RPALPX + ELSEIF(PX.EQ.AALO1)THEN + RHA1P2=RPALPX + ELSEIF(PX.EQ.AALO2)THEN + RHA2P2=RPALPX + ELSEIF(PX.EQ.AALO3)THEN + RHA3P2=RPALPX + ELSEIF(PX.EQ.AALO4)THEN + RHA4P2=RPALPX + ENDIF + ENDIF +C IF(I.EQ.180.AND.J.EQ.12)THEN +C WRITE(*,1112)'ALPO4',I,J,L,M,PALPO1,AAL1,AALO1,AALO2,AALO3,AALO4 +C 2,AH0P1,AH1P1,AH2P1,AHY1,AOH1,RPALPX,RHA0P1,RHA1P1,RHA2P1,RHA3P1 +C 3,RHA4P1,RHA0P2,RHA1P2,RHA2P2,RHA3P2,RHA4P2,SP,SPX,AAL1*AH0P1 +C 4,SPALP +C ENDIF +1112 FORMAT(A8,4I4,80E12.4) +C ENDIF +C +C IRON PHOSPHATE (STRENGITE) +C + PX=AMAX1(AFE1,AFEO1,AFEO2,AFEO3,AFEO4) + PY=AMAX1(AH1P1,AH2P1) + R1=AHY1 + P3=AHY1 + IF(PY.EQ.AH1P1)THEN + P2=AH1P1 + IF(PX.EQ.AFE1)THEN + P1=AFE1 + NR1=1 + NP3=0 + SP=SHF0P1 + ELSEIF(PX.EQ.AFEO1)THEN + P1=AFEO1 + NR1=0 + NP3=0 + SP=SPF1P1 + ELSEIF(PX.EQ.AFEO2)THEN + P1=AFEO2 + NR1=0 + NP3=1 + SP=SHF2P1 + ELSEIF(PX.EQ.AFEO3)THEN + P1=AFEO3 + NR1=0 + NP3=2 + SP=SHF3P1 + ELSEIF(PX.EQ.AFEO4)THEN + P1=AFEO4 + NR1=0 + NP3=3 + SP=SHF4P1 + ENDIF + ELSE + P2=AH2P1 + IF(PX.EQ.AFE1)THEN + P1=AFE1 + NR1=2 + NP3=0 + SP=SHF0P2 + ELSEIF(PX.EQ.AFEO1)THEN + P1=AFEO1 + NR1=1 + NP3=0 + SP=SHF1P2 + ELSEIF(PX.EQ.AFEO2)THEN + P1=AFEO2 + NR1=0 + NP3=0 + SP=SPF2P2 + ELSEIF(PX.EQ.AFEO3)THEN + P1=AFEO3 + NR1=0 + NP3=1 + SP=SHF3P2 + ELSEIF(PX.EQ.AFEO4)THEN + P1=AFEO4 + NR1=0 + NP3=2 + SP=SHF4P2 + ENDIF + ENDIF + RHF0P1=0.0 + RHF1P1=0.0 + RHF2P1=0.0 + RHF3P1=0.0 + RHF4P1=0.0 + RHF0P2=0.0 + RHF1P2=0.0 + RHF2P2=0.0 + RHF3P2=0.0 + RHF4P2=0.0 + R1=AMAX1(ZERO,R1) + P1=AMAX1(ZERO,P1) + P2=AMAX1(ZERO,P2) + P3=AMAX1(ZERO,P3) + SPX=SP*R1**NR1/P3**NP3 + S0=P1+P2 + S1=AMAX1(0.0,S0**2-4.0*(P1*P2-SPX)) + RPFEPX=AMAX1(-PFEPO1,TPDX*(S0-SQRT(S1))) + IF(PY.EQ.AH1P1)THEN + IF(PX.EQ.AFE1)THEN + RHF0P1=RPFEPX + ELSEIF(PX.EQ.AFEO1)THEN + RHF1P1=RPFEPX + ELSEIF(PX.EQ.AFEO2)THEN + RHF2P1=RPFEPX + ELSEIF(PX.EQ.AFEO3)THEN + RHF3P1=RPFEPX + ELSEIF(PX.EQ.AFEO4)THEN + RHF4P1=RPFEPX + ENDIF + ELSE + IF(PX.EQ.AFE1)THEN + RHF0P2=RPFEPX + ELSEIF(PX.EQ.AFEO1)THEN + RHF1P2=RPFEPX + ELSEIF(PX.EQ.AFEO2)THEN + RHF2P2=RPFEPX + ELSEIF(PX.EQ.AFEO3)THEN + RHF3P2=RPFEPX + ELSEIF(PX.EQ.AFEO4)THEN + RHF4P2=RPFEPX + ENDIF + ENDIF +C IF(I.EQ.180.AND.J.EQ.12)THEN +C WRITE(*,1112)'FEPO4',I,J,L,M,PFEPO1,AFE1,AFEO1,AFEO2,AFEO3,AFEO4 +C 2,AH0P1,AH1P1,AH2P1,AHY1,AOH1,RPFEPX,RHF0P1,RHF1P1,RHF2P1,RHF3P1 +C 3,RHF4P1,RHF0P2,RHF1P2,RHF2P2,RHF3P2,RHF4P2,SP,SPX,AFE1*AH0P1 +C 4,SPFEP +C ENDIF +C +C DICALCIUM PHOSPHATE +C + PX=AMAX1(AH1P1,AH2P1) + R1=AHY1 + P1=ACA1 + IF(PX.EQ.AH1P1)THEN + P2=AH1P1 + NR1=0 + SP=SPCAD + ELSEIF(PX.EQ.AH2P1)THEN + P2=AH2P1 + NR1=1 + SP=SHCAD2 + ENDIF + RPCAD1=0.0 + RHCAD2=0.0 + R1=AMAX1(ZERO,R1) + P1=AMAX1(ZERO,P1) + P2=AMAX1(ZERO,P2) + SPX=SP*R1**NR1 + S0=P1+P2 + S1=AMAX1(0.0,S0**2-4.0*(P1*P2-SPX)) + RPCADX=AMAX1(-PCAPD1,TPDX*(S0-SQRT(S1))) + IF(PX.EQ.AH1P1)THEN + RPCAD1=RPCADX + ELSEIF(PX.EQ.AH2P1)THEN + RHCAD2=RPCADX + ENDIF +C IF((M/10)*10.EQ.M)THEN +C WRITE(*,1112)'CAPO4',I,J,L,M,PCAPM1,PCAPD1,CCA1 +C 2,CH1P1,CH2P1,CHY1,COH1,RPCADX,RPCAD1,RHCAD2,R1,P1,P2,P3 +C 3,SP,Z,FX,Y,X,TX,A2,CCA1*A2*CH1P1*A2,SPCAD +C ENDIF +C +C HYDROXYAPATITE +C + PX=AMAX1(AH1P1,AH2P1) + R1=AHY1 + P1=ACA1 + IF(PX.EQ.AH1P1)THEN + P2=AH1P1 + NR1=4 + SP=SHCAH1 + ELSEIF(PX.EQ.AH2P1)THEN + P2=AH2P1 + NR1=7 + SP=SHCAH2 + ENDIF + RHCAH1=0.0 + RHCAH2=0.0 + R1=AMAX1(ZERO,R1) + P1=AMAX1(ZERO,P1) + P2=AMAX1(ZERO,P2) + SPX=(SP*R1**NR1/P1**5)**0.333 + RPCAHX=AMAX1(-PCAPH1,TPDX*(P2-SPX)) + IF(PX.EQ.AH1P1)THEN + RHCAH1=RPCAHX + ELSEIF(PX.EQ.AH2P1)THEN + RHCAH2=RPCAHX + ENDIF +C IF(I.EQ.180.AND.J.EQ.12)THEN +C WRITE(*,1112)'APATITE',I,J,L,M,PCAPH1,ACA1 +C 2,AH0P1,AH1P1,AH2P1,AHY1,AOH1,RPCAHX,RHCAH1,RHCAH2 +C 3,SP,SPX,ACA1**5*AH0P1**3*AOH1,SPCAH,SHCAH1,SHCAH2 +C ENDIF +C +C MONOCALCIUM PHOSPHATE +C + P1=ACA1 + P2=AH2P1 + P1=AMAX1(ZERO,P1) + P2=AMAX1(ZERO,P2) + SPX=SPCAM + S0=P1+P2 + S1=AMAX1(0.0,S0**2-4.0*(P1*P2-SPX)) + RPCAMX=AMAX1(-PCAPM1,TPDX*(S0-SQRT(S1))) + ELSE + RPALPX=0.0 + RPFEPX=0.0 + RPCADX=0.0 + RPCAHX=0.0 + RHA0P1=0.0 + RHA1P1=0.0 + RHA2P1=0.0 + RHA3P1=0.0 + RHA4P1=0.0 + RHA0P2=0.0 + RHA1P2=0.0 + RHA2P2=0.0 + RHA3P2=0.0 + RHA4P2=0.0 + RHF0P1=0.0 + RHF1P1=0.0 + RHF2P1=0.0 + RHF3P1=0.0 + RHF4P1=0.0 + RHF0P2=0.0 + RHF1P2=0.0 + RHF2P2=0.0 + RHF3P2=0.0 + RHF4P2=0.0 + RPCAD1=0.0 + RHCAD2=0.0 + RHCAH1=0.0 + RHCAH2=0.0 + RPCAMX=0.0 + ENDIF +C +C PHOSPHORUS PRECIPITATION-DISSOLUTION IN BAND SOIL ZONE +C + IF(VOLWPB.GT.ZEROS(NY,NX))THEN +C +C ALUMINUM PHOSPHATE (VARISCITE) +C + PX=AMAX1(AAL1,AALO1,AALO2,AALO3,AALO4) + PY=AMAX1(AH1PB,AH2PB) + R1=AHY1 + P3=AHY1 + IF(PY.EQ.AH1PB)THEN + P2=AH1PB + IF(PX.EQ.AAL1)THEN + P1=AAL1 + NR1=1 + NP3=0 + SP=SHA0P1 + ELSEIF(PX.EQ.AALO1)THEN + P1=AALO1 + NR1=0 + NP3=0 + SP=SPA1P1 + ELSEIF(PX.EQ.AALO2)THEN + P1=AALO2 + NR1=0 + NP3=1 + SP=SHA2P1 + ELSEIF(PX.EQ.AALO3)THEN + P1=AALO3 + NR1=0 + NP3=2 + SP=SHA3P1 + ELSEIF(PX.EQ.AALO4)THEN + P1=AALO4 + NR1=0 + NP3=3 + SP=SHA4P1 + ENDIF + ELSE + P2=AH2PB + IF(PX.EQ.AAL1)THEN + P1=AAL1 + NR1=2 + NP3=0 + SP=SHA0P2 + ELSEIF(PX.EQ.AALO1)THEN + P1=AALO1 + NR1=1 + NP3=0 + SP=SHA1P2 + ELSEIF(PX.EQ.AALO2)THEN + P1=AALO2 + NR1=0 + NP3=0 + SP=SPA2P2 + ELSEIF(PX.EQ.AALO3)THEN + P1=AALO3 + NR1=0 + NP3=1 + SP=SHA3P2 + ELSEIF(PX.EQ.AALO4)THEN + P1=AALO4 + NR1=0 + NP3=2 + SP=SHA4P2 + ENDIF + ENDIF + RHA0B1=0.0 + RHA1B1=0.0 + RHA2B1=0.0 + RHA3B1=0.0 + RHA4B1=0.0 + RHA0B2=0.0 + RHA1B2=0.0 + RHA2B2=0.0 + RHA3B2=0.0 + RHA4B2=0.0 + R1=AMAX1(ZERO,R1) + P1=AMAX1(ZERO,P1) + P2=AMAX1(ZERO,P2) + P3=AMAX1(ZERO,P3) + SPX=SP*R1**NR1/P3**NP3 + S0=P1+P2 + S1=AMAX1(0.0,S0**2-4.0*(P1*P2-SPX)) + RPALBX=AMAX1(-PALPOB,TPDX*(S0-SQRT(S1))) + IF(PY.EQ.AH1PB)THEN + IF(PX.EQ.AAL1)THEN + RHA0B1=RPALBX + ELSEIF(PX.EQ.AALO1)THEN + RHA1B1=RPALBX + ELSEIF(PX.EQ.AALO2)THEN + RHA2B1=RPALBX + ELSEIF(PX.EQ.AALO3)THEN + RHA3B1=RPALBX + ELSEIF(PX.EQ.AALO4)THEN + RHA4B1=RPALBX + ENDIF + ELSE + IF(PX.EQ.AAL1)THEN + RHA0B2=RPALBX + ELSEIF(PX.EQ.AALO1)THEN + RHA1B2=RPALBX + ELSEIF(PX.EQ.AALO2)THEN + RHA2B2=RPALBX + ELSEIF(PX.EQ.AALO3)THEN + RHA3B2=RPALBX + ELSEIF(PX.EQ.AALO4)THEN + RHA4B2=RPALBX + ENDIF + ENDIF +C +C IRON PHOSPHATE (STRENGITE) +C + PX=AMAX1(AFE1,AFEO1,AFEO2,AFEO3,AFEO4) + PY=AMAX1(AH1PB,AH2PB) + R1=AHY1 + P3=AHY1 + IF(PY.EQ.AH1PB)THEN + P2=AH1PB + IF(PX.EQ.AFE1)THEN + P1=AFE1 + NR1=1 + NP3=0 + SP=SHF0P1 + ELSEIF(PX.EQ.AFEO1)THEN + P1=AFEO1 + NR1=0 + NP3=0 + SP=SPF1P1 + ELSEIF(PX.EQ.AFEO2)THEN + P1=AFEO2 + NR1=0 + NP3=1 + SP=SHF2P1 + ELSEIF(PX.EQ.AFEO3)THEN + P1=AFEO3 + NR1=0 + NP3=2 + SP=SHF3P1 + ELSEIF(PX.EQ.AFEO4)THEN + P1=AFEO4 + NR1=0 + NP3=3 + SP=SHF4P1 + ENDIF + ELSE + P2=AH2PB + IF(PX.EQ.AFE1)THEN + P1=AFE1 + NR1=2 + NP3=0 + SP=SHF0P2 + ELSEIF(PX.EQ.AFEO1)THEN + P1=AFEO1 + NR1=1 + NP3=0 + SP=SHF1P2 + ELSEIF(PX.EQ.AFEO2)THEN + P1=AFEO2 + NR1=0 + NP3=0 + SP=SPF2P2 + ELSEIF(PX.EQ.AFEO3)THEN + P1=AFEO3 + NR1=0 + NP3=1 + SP=SHF3P2 + ELSEIF(PX.EQ.AFEO4)THEN + P1=AFEO4 + NR1=0 + NP3=2 + SP=SHF4P2 + ENDIF + ENDIF + RHF0B1=0.0 + RHF1B1=0.0 + RHF2B1=0.0 + RHF3B1=0.0 + RHF4B1=0.0 + RHF0B2=0.0 + RHF1B2=0.0 + RHF2B2=0.0 + RHF3B2=0.0 + RHF4B2=0.0 + R1=AMAX1(ZERO,R1) + P1=AMAX1(ZERO,P1) + P2=AMAX1(ZERO,P2) + P3=AMAX1(ZERO,P3) + SPX=SP*R1**NR1/P3**NP3 + S0=P1+P2 + S1=AMAX1(0.0,S0**2-4.0*(P1*P2-SPX)) + RPFEBX=AMAX1(-PFEPOB,TPDX*(S0-SQRT(S1))) + IF(PY.EQ.AH1PB)THEN + IF(PX.EQ.AFE1)THEN + RHF0B1=RPFEBX + ELSEIF(PX.EQ.AFEO1)THEN + RHF1B1=RPFEBX + ELSEIF(PX.EQ.AFEO2)THEN + RHF2B1=RPFEBX + ELSEIF(PX.EQ.AFEO3)THEN + RHF3B1=RPFEBX + ELSEIF(PX.EQ.AFEO4)THEN + RHF4B1=RPFEBX + ENDIF + ELSE + IF(PX.EQ.AFE1)THEN + RHF0B2=RPFEBX + ELSEIF(PX.EQ.AFEO1)THEN + RHF1B2=RPFEBX + ELSEIF(PX.EQ.AFEO2)THEN + RHF2B2=RPFEBX + ELSEIF(PX.EQ.AFEO3)THEN + RHF3B2=RPFEBX + ELSEIF(PX.EQ.AFEO4)THEN + RHF4B2=RPFEBX + ENDIF + ENDIF +C +C DICALCIUM PHOSPHATE +C + PX=AMAX1(AH1PB,AH2PB) + R1=AHY1 + P1=ACA1 + IF(PX.EQ.AH1PB)THEN + P2=AH1PB + NR1=0 + SP=SPCAD + ELSEIF(PX.EQ.AH2PB)THEN + P2=AH2PB + NR1=1 + SP=SHCAD2 + ENDIF + RPCDB1=0.0 + RHCDB2=0.0 + R1=AMAX1(ZERO,R1) + P1=AMAX1(ZERO,P1) + P2=AMAX1(ZERO,P2) + SPX=SP*R1**NR1 + S0=P1+P2 + S1=AMAX1(0.0,S0**2-4.0*(P1*P2-SPX)) + RPCDBX=AMAX1(-PCAPDB,TPDX*(S0-SQRT(S1))) + IF(PX.EQ.AH1PB)THEN + RPCDB1=RPCDBX + ELSEIF(PX.EQ.AH2PB)THEN + RHCDB2=RPCDBX + ENDIF +C +C HYDROXYAPATITE +C + PX=AMAX1(AH1PB,AH2PB) + R1=AHY1 + P1=ACA1 + IF(PX.EQ.AH1PB)THEN + P2=AH1PB + NR1=4 + SP=SHCAH1 + ELSEIF(PX.EQ.AH2PB)THEN + P2=AH2PB + NR1=7 + SP=SHCAH2 + ENDIF + RHCHB1=0.0 + RHCHB2=0.0 + R1=AMAX1(ZERO,R1) + P1=AMAX1(ZERO,P1) + P2=AMAX1(ZERO,P2) + SPX=(SP*R1**NR1/P1**5)**0.333 + RPCHBX=AMAX1(-PCAPHB,TPDX*(P2-SPX)) + IF(PX.EQ.AH1PB)THEN + RHCHB1=RPCHBX + ELSEIF(PX.EQ.AH2PB)THEN + RHCHB2=RPCHBX + ENDIF +C +C MONOCALCIUM PHOSPHATE +C + P1=ACA1 + P2=AH2PB + P1=AMAX1(ZERO,P1) + P2=AMAX1(ZERO,P2) + SPX=SPCAM + S0=P1+P2 + S1=AMAX1(0.0,S0**2-4.0*(P1*P2-SPX)) + RPCMBX=AMAX1(-PCAPMB,TPDX*(S0-SQRT(S1))) + ELSE + RPALBX=0.0 + RPFEBX=0.0 + RPCDBX=0.0 + RPCHBX=0.0 + RPCMBX=0.0 + RHA0B1=0.0 + RHA1B1=0.0 + RHA2B1=0.0 + RHA3B1=0.0 + RHA4B1=0.0 + RHA0B2=0.0 + RHA1B2=0.0 + RHA2B2=0.0 + RHA3B2=0.0 + RHA4B2=0.0 + RHF0B1=0.0 + RHF1B1=0.0 + RHF2B1=0.0 + RHF3B1=0.0 + RHF4B1=0.0 + RHF0B2=0.0 + RHF1B2=0.0 + RHF2B2=0.0 + RHF3B2=0.0 + RHF4B2=0.0 + RPCDB1=0.0 + RHCDB2=0.0 + RHCHB1=0.0 + RHCHB2=0.0 + ENDIF +C +C PHOSPHORUS ANION EXCHANGE IN NON-BAND SOIL ZONE +C CALCULATED FROM EXCHANGE EQUILIBRIA AMONG H2PO4-, +C HPO4--, H+, OH- AND PROTONATED AND NON-PROTONATED -OH +C EXCHANGE SITES +C + IF(VOLWM(NPH,L,NY,NX).GT.ZEROS(NY,NX))THEN + VOLWBK=AMIN1(1.0,BKVL(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + ELSE + VOLWBK=1.0 + ENDIF + IF(VOLWPO.GT.ZEROS(NY,NX) + 2.AND.AEC(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 +C H2PO4 EXCHANGE IN NON-BAND SOIL ZONE FROM CONVERGENCE +C SOLUTION FOR EQUILIBRIUM AMONG H2PO4-, H+, OH-, X-OH +C AND X-H2PO4 +C + SPH2P=SXH2P*DPH2O + RXH2P=TADAX*(XOH21*AH2P1-SPH2P*XH2P1)/(XOH21+SPH2P)*VOLWBK + RYH2P=TADAX*(XOH11*AH2P1-SXH2P*XH2P1*AOH1)/(XOH11+SXH2P)*VOLWBK +C +C HPO4 EXCHANGE IN NON-BAND SOIL ZONE FROM CONVERGENCE +C SOLUTION FOR EQUILIBRIUM AMONG HPO4--, H+, OH-, X-OH +C AND X-HPO4 +C + SPH1P=SXH1P*DPH2O/DPH2P + RXH1P=TADAX*(XOH11*AH1P1-SPH1P*XH1P1)/(XOH11+SPH1P)*VOLWBK + ELSE + RXOH2=0.0 + RXOH1=0.0 + RXH2P=0.0 + RYH2P=0.0 + RXH1P=0.0 + ENDIF +C +C PHOSPHORUS ANION EXCHANGE IN BAND SOIL ZONE +C CALCULATED FROM EXCHANGE EQUILIBRIA AMONG H2PO4-, +C HPO4--, H+, OH- AND PROTONATED AND NON-PROTONATED -OH +C EXCHANGE SITES +C + IF(VOLWPB.GT.ZEROS(NY,NX) + 2.AND.AEC(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 +C H2PO4 EXCHANGE IN BAND SOIL ZONE FROM CONVERGENCE +C SOLUTION FOR EQUILIBRIUM AMONG H2PO4-, H+, OH-, X-OH +C AND X-H2PO4 +C + SPH2P=SXH2P*DPH2O + RXH2B=TADAX*(XH21B*AH2PB-SPH2P*X2P1B)/(XH21B+SPH2P)*VOLWBK + RYH2B=TADAX*(XH11B*AH2PB-SXH2P*X2P1B*AOH1)/(XH11B+SXH2P)*VOLWBK +C +C HPO4 EXCHANGE IN BAND SOIL ZONE FROM CONVERGENCE +C SOLUTION FOR EQUILIBRIUM AMONG HPO4--, H+, OH-, X-OH +C AND X-HPO4 +C + SPH1P=SXH1P*DPH2O/DPH2P + RXH1B=TADAX*(XH11B*AH1PB-SPH1P*X1P1B)/(XH11B+SPH1P)*VOLWBK +C WRITE(*,2226)'RXH1B',I,J,L,M,RXH1B,XH11B,XH21B,CH1PB +C 2,SPH1P,X1P1B,RYH2B,CH2PB,SXH2P,X2P1B,COH1,CHY1,ROH +2226 FORMAT(A8,4I4,20E12.4) + ELSE + RXO2B=0.0 + RXO1B=0.0 + RXH2B=0.0 + RYH2B=0.0 + RXH1B=0.0 + ENDIF +C +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 +C +C CATION CONCENTRATIONS +C +C EQUILIBRIUM X-CA CONCENTRATION FROM CEC, GAPON COEFFICIENTS +C AND CATION CONCENTRATIONS +C + AALX=AAL1**0.333 + AFEX=AFE1**0.333 + ACAX=ACA1**0.500 + AMGX=AMG1**0.500 + XCAX=CCEC/(1.0+GKC4(L,NY,NX)*AN41/ACAX*VLNH4(L,NY,NX) + 2+GKC4(L,NY,NX)*AN4B/ACAX*VLNHB(L,NY,NX) + 3+GKCH(L,NY,NX)*AHY1/ACAX+GKCA(L,NY,NX)*AALX/ACAX + 4+GKCA(L,NY,NX)*AFEX/ACAX+GKCM(L,NY,NX)*AMGX/ACAX + 5+GKCN(L,NY,NX)*ANA1/ACAX+GKCK(L,NY,NX)*AKA1/ACAX) + XN4Q=XCAX*AN41*GKC4(L,NY,NX) + XNBQ=XCAX*AN4B*GKC4(L,NY,NX) + XHYQ=XCAX*AHY1*GKCH(L,NY,NX) + XALQ=XCAX*AALX*GKCA(L,NY,NX) + XFEQ=XCAX*AFEX*GKCA(L,NY,NX) + XCAQ=XCAX*ACAX + XMGQ=XCAX*AMGX*GKCM(L,NY,NX) + XNAQ=XCAX*ANA1*GKCN(L,NY,NX) + XKAQ=XCAX*AKA1*GKCK(L,NY,NX) + XTLQ=XN4Q*VLNH4(L,NY,NX)+XNBQ*VLNHB(L,NY,NX) + 2+XHYQ+XALQ+XFEQ+XCAQ+XMGQ+XNAQ+XKAQ + IF(XTLQ.GT.ZERO)THEN + FX=CCEC/XTLQ + ELSE + FX=0.0 + ENDIF + XN4Q=FX*XN4Q + XNBQ=FX*XNBQ + XHYQ=FX*XHYQ + XALQ=FX*XALQ/3.0 + XFEQ=FX*XFEQ/3.0 + XCAQ=FX*XCAQ/2.0 + XMGQ=FX*XMGQ/2.0 + XNAQ=FX*XNAQ + XKAQ=FX*XKAQ +C +C NH4 EXCHANGE IN NON-BAND AND BAND SOIL ZONES +C + RXN4=TADCX*(XN4Q-XN41)*AN41/XN4Q + RXNB=TADCX*(XNBQ-XN4B)*AN4B/XNBQ +C +C H,AL,FE,CA,MG,NA,K EXCHANGE +C + RXHY=TADCX*(XHYQ-XHY1)*AHY1/XHYQ + RXAL=TADCX*(XALQ-XAL1)*AALX/XALQ + RXFE=TADCX*(XFEQ-XFE1)*AFEX/XFEQ + RXCA=TADCX*(XCAQ-XCA1)*ACAX/XCAQ + RXMG=TADCX*(XMGQ-XMG1)*AMGX/XMGQ + RXNA=TADCX*(XNAQ-XNA1)*ANA1/XNAQ + RXKA=TADCX*(XKAQ-XKA1)*AKA1/XKAQ +C IF(I.EQ.180.AND.J.EQ.12)THEN +C WRITE(*,1112)'RXFE',I,J,L,M,CCEC,XCAX,XN41,XHY1,XAL1,XFE1 +C 2,XCA1,XMG1,XNA1,XKA1,AN41,AHY1,AALX,AFEX,ACAX,AMGX,ANA1 +C 3,AKA1,RXN4,RXHY,RXAL,RXFE,RXCA,RXMG,RXNA,RXKA +C ENDIF + ELSE + RXN4=0.0 + RXNB=0.0 + RXHY=0.0 + RXAL=0.0 + RXFE=0.0 + RXCA=0.0 + RXMG=0.0 + RXNA=0.0 + RXKA=0.0 + ENDIF +C +C DISSOCIATION OF CARBOXYL RADICALS +C AND ADSORPTION OF AL AND FE (OH)2 +C + S0=AHY1+XCOO+DPCOH + S1=AMAX1(0.0,S0**2-4.0*(AHY1*XCOO-DPCOH*XHC1)) + RXHC=TADCX*(S0-SQRT(S1)) + S0=AALO2+XCOO+DPALO + S1=AMAX1(0.0,S0**2-4.0*(AALO2*XCOO-DPALO*XALO21)) + RXALO2=TADAX*(S0-SQRT(S1)) + S0=AFEO2+XCOO+DPFEO + S1=AMAX1(0.0,S0**2-4.0*(AFEO2*XCOO-DPFEO*XFEO21)) + RXFEO2=TADAX*(S0-SQRT(S1)) +C +C NH4-NH3+H IN NON-BAND AND BAND SOIL ZONES +C + IF(VOLWNH.GT.ZEROS(NY,NX))THEN + RNH4=TSLX*(AHY1*AN31-DPN4*AN41)/(DPN4+AHY1) + ELSE + RNH4=0.0 + ENDIF + IF(VOLWNB.GT.ZEROS(NY,NX))THEN + RNHB=TSLX*(AHY1*AN3B-DPN4*AN4B)/(DPN4+AHY1) + ELSE + RNHB=0.0 + ENDIF +C +C CO2-H+HCO3 +C + S0=AHY1+AHCO31+DPCO2 + S1=AMAX1(0.0,S0**2-4.0*(AHY1*AHCO31-DPCO2*ACO21)) + RCO2Q=TSLX*(S0-SQRT(S1)) +C +C HCO3-H+CO3 +C + S0=AHY1+ACO31+DPHCO + S1=AMAX1(0.0,S0**2-4.0*(AHY1*ACO31-DPHCO*AHCO31)) + RHCO3=TSLX*(S0-SQRT(S1)) +C +C ALOH-AL+OH +C + RALO1=TSLX*(AAL1*AOH1-DPAL1*AALO1)/(AOH1+DPAL1) +C +C AL(OH)2-ALOH+OH +C + RALO2=TSLX*(AALO1*AOH1-DPAL2*AALO2)/(AOH1+DPAL2) +C +C AL(OH)3-AL(OH)2+OH +C + RALO3=TSLX*(AALO2*AOH1-DPAL3*AALO3)/(AOH1+DPAL3) +C +C AL(OH)4-AL(OH)3+OH +C + RALO4=TSLX*(AALO3*AOH1-DPAL4*AALO4)/(AOH1+DPAL4) +C +C ALSO4-AL+SO4 +C + S0=AAL1+ASO41+DPALS + S1=AMAX1(0.0,S0**2-4.0*(AAL1*ASO41-DPALS*AALS1)) + RALS=TSLX*(S0-SQRT(S1)) +C +C FEOH-FE+OH +C + RFEO1=TSLX*(AFE1*AOH1-DPFE1*AFEO1)/(AOH1+DPFE1) +C +C FE(OH)2-FEOH+OH +C + RFEO2=TSLX*(AFEO1*AOH1-DPFE2*AFEO2)/(AOH1+DPFE2) +C +C FE(OH)3-FE(OH)2+OH +C + RFEO3=TSLX*(AFEO2*AOH1-DPFE3*AFEO3)/(AOH1+DPFE3) +C +C AL(OH)4-AL(OH)3+OH +C + RFEO4=TSLX*(AFEO3*AOH1-DPFE4*AFEO4)/(AOH1+DPFE4) +C +C FESO4-FE+SO4 +C + S0=AFE1+ASO41+DPFES + S1=AMAX1(0.0,S0**2-4.0*(AFE1*ASO41-DPFES*AFES1)) + RFES=TSLX*(S0-SQRT(S1)) +C +C CAOH-CA+OH +C + RCAO=TSLX*(ACA1*AOH1-DPCAO*ACAO1)/(AOH1+DPCAO) +C +C CACO3-CA+CO3 +C + S0=ACA1+ACO31+DPCAC + S1=AMAX1(0.0,S0**2-4.0*(ACA1*ACO31-DPCAC*ACAC1)) + RCAC=TSLX*(S0-SQRT(S1)) +C +C CAHCO3-CA+HCO3 +C + S0=ACA1+AHCO31+DPCAH + S1=AMAX1(0.0,S0**2-4.0*(ACA1*AHCO31-DPCAH*ACAH1)) + RCAH=TSLX*(S0-SQRT(S1)) +C +C CASO4-CA+SO4 +C + S0=ACA1+ASO41+DPCAS + S1=AMAX1(0.0,S0**2-4.0*(ACA1*ASO41-DPCAS*ACAS1)) + RCAS=TSLX*(S0-SQRT(S1)) +C +C MGOH-MG+OH +C + RMGO=TSLX*(AMG1*AOH1-DPMGO*AMGO1)/(AOH1+DPMGO) +C +C MGCO3-MG+CO3 +C + S0=AMG1+ACO31+DPMGC + S1=AMAX1(0.0,S0**2-4.0*(AMG1*ACO31-DPMGC*AMGC1)) + RMGC=TSLX*(S0-SQRT(S1)) +C +C MGHCO3-MG+HCO3 +C + S0=AMG1+AHCO31+DPMGH + S1=AMAX1(0.0,S0**2-4.0*(AMG1*AHCO31-DPMGH*AMGH1)) + RMGH=TSLX*(S0-SQRT(S1)) +C +C MGSO4-MG+SO4 +C + S0=AMG1+ASO41+DPMGS + S1=AMAX1(0.0,S0**2-4.0*(AMG1*ASO41-DPMGS*AMGS1)) + RMGS=TSLX*(S0-SQRT(S1)) +C +C NACO3-NA+CO3 +C + S0=ANA1+ACO31+DPNAC + S1=AMAX1(0.0,S0**2-4.0*(ANA1*ACO31-DPNAC*ANAC1)) + RNAC=TSLX*(S0-SQRT(S1)) +C +C NASO4-NA+SO4 +C + S0=ANA1+ASO41+DPNAS + S1=AMAX1(0.0,S0**2-4.0*(ANA1*ASO41-DPNAS*ANAS1)) + RNAS=TSLX*(S0-SQRT(S1)) +C +C KSO4-K+SO4 +C + S0=AKA1+ASO41+DPKAS + S1=AMAX1(0.0,S0**2-4.0*(AKA1*ASO41-DPKAS*AKAS1)) + RKAS=TSLX*(S0-SQRT(S1)) +C +C PHOSPHORUS IN NON-BAND SOIL ZONE +C + IF(VOLWPO.GT.ZEROS(NY,NX))THEN +C +C HPO4-H+PO4 +C + RH1P=TSLX*(AH0P1*AHY1-DPH1P*AH1P1)/(DPH1P+AHY1) +C +C H2PO4-H+HPO4 +C + RH2P=TSLX*(AH1P1*AHY1-DPH2P*AH2P1)/(DPH2P+AHY1) +C IF(NY.EQ.5.AND.L.EQ.10)THEN +C WRITE(*,22)'RH2P',I,J,NX,NY,L,M,RH2P,TSLX,S0,S1,DP,DPH2P,A2 +C 2,CH1P1,CHY1,CH2P1,H2PO4(L,NY,NX),VOLWPX,RH2PX,XH2PS(L,NY,NX) +C 3,TUPH2P(L,NY,NX) +22 FORMAT(A8,6I4,60E12.4) +C ENDIF +C +C H3PO4-H+H2PO4 +C + RH3P=TSLX*(AH2P1*AHY1-DPH3P*AH3P1)/(DPH3P+AHY1) +C +C FEHPO4-FE+HPO4 +C + S0=AFE1+AH1P1+DPF1P + S1=AMAX1(0.0,S0**2-4.0*(AFE1*AH1P1-DPF1P*AF1P1)) + RF1P=TSLX*(S0-SQRT(S1)) +C +C FEH2PO4-FE+H2PO4 +C + S0=AFE1+AH2P1+DPF2P + S1=AMAX1(0.0,S0**2-4.0*(AFE1*AH2P1-DPF2P*AF2P1)) + RF2P=TSLX*(S0-SQRT(S1)) +C +C CAPO4-CA+PO4 +C + S0=ACA1+AH0P1+DPC0P + S1=AMAX1(0.0,S0**2-4.0*(ACA1*AH0P1-DPC0P*AC0P1)) + RC0P=TSLX*(S0-SQRT(S1)) +C +C CAHPO4-CA+HPO4 +C + S0=ACA1+AH1P1+DPC1P + S1=AMAX1(0.0,S0**2-4.0*(ACA1*AH1P1-DPC1P*AC1P1)) + RC1P=TSLX*(S0-SQRT(S1)) +C +C CAH2PO4-CA+H2PO4 +C + S0=ACA1+AH2P1+DPC2P + S1=AMAX1(0.0,S0**2-4.0*(ACA1*AH2P1-DPC2P*AC2P1)) + RC2P=TSLX*(S0-SQRT(S1)) +C +C MGHPO4-MG+HPO4 +C + S0=AMG1+AH1P1+DPM1P + S1=AMAX1(0.0,S0**2-4.0*(AMG1*AH1P1-DPM1P*AM1P1)) + RM1P=TSLX*(S0-SQRT(S1)) + ELSE + RH1P=0.0 + RH2P=0.0 + RH3P=0.0 + RF1P=0.0 + RF2P=0.0 + RC0P=0.0 + RC1P=0.0 + RC2P=0.0 + RM1P=0.0 + ENDIF +C +C PHOSPHORUS IN BAND SOIL ZONE +C + IF(VOLWPB.GT.ZEROS(NY,NX))THEN +C +C HPO4-H+PO4 +C + RH1B=TSLX*(AH0PB*AHY1-DPH1P*AH1PB)/(AHY1+DPH1P) +C +C H2PO4-H+HPO4 +C + RH2B=TSLX*(AH1PB*AHY1-DPH2P*AH2PB)/(AHY1+DPH2P) +C +C H3PO4-H+H2PO4 +C + RH3B=TSLX*(AH2PB*AHY1-DPH3P*AH3PB)/(AHY1+DPH3P) +C +C FEHPO4-FE+HPO4 +C + S0=AFE1+AH1PB+DPF1P + S1=AMAX1(0.0,S0**2-4.0*(AFE1*AH1PB-DPF1P*AF1PB)) + RF1B=TSLX*(S0-SQRT(S1)) +C +C FEH2PO4-FE+H2PO4 +C + S0=AFE1+AH2PB+DPF2P + S1=AMAX1(0.0,S0**2-4.0*(AFE1*AH2PB-DPF2P*AF2PB)) + RF2B=TSLX*(S0-SQRT(S1)) +C +C CAPO4-CA+PO4 +C + S0=ACA1+AH0PB+DPC0P + S1=AMAX1(0.0,S0**2-4.0*(ACA1*AH0PB-DPC0P*AC0PB)) + RC0B=TSLX*(S0-SQRT(S1)) +C +C CAHPO4-CA+HPO4 +C + S0=ACA1+AH1PB+DPC1P + S1=AMAX1(0.0,S0**2-4.0*(ACA1*AH1PB-DPC1P*AC1PB)) + RC1B=TSLX*(S0-SQRT(S1)) +C +C CAH2PO4-CA+H2PO4 +C + S0=ACA1+AH2PB+DPC2P + S1=AMAX1(0.0,S0**2-4.0*(ACA1*AH2PB-DPC2P*AC2PB)) + RC2B=TSLX*(S0-SQRT(S1)) +C +C MGHPO4-MG+HPO4 +C + S0=AMG1+AH1PB+DPM1P + S1=AMAX1(0.0,S0**2-4.0*(AMG1*AH1PB-DPM1P*AM1PB)) + RM1B=TSLX*(S0-SQRT(S1)) + ELSE + RH1B=0.0 + RH2B=0.0 + RH3B=0.0 + RF1B=0.0 + RF2B=0.0 + RC0B=0.0 + RC1B=0.0 + RC2B=0.0 + RM1B=0.0 + ENDIF + +C +C TOTAL ION FLUXES FOR CURRENT ITERATION +C FROM ALL REACTIONS ABOVE +C + RN4S=RNH4-RXN4 + RN4B=RNHB-RXNB + RN3S=-RNH4 + RN3B=-RNHB + RAL=-RHAL1-RXAL-RALO1-RALS + 2-(RHA0P1+RHA0P2)*VLPO4(L,NY,NX) + 3-(RHA0B1+RHA0B2)*VLPOB(L,NY,NX) + RFE=-RHFE1-RXFE-RFEO1-RFES + 2-(RHF0P1+RHF0P2+RF1P+RF2P)*VLPO4(L,NY,NX) + 2-(RHF0B1+RHF0B2+RF1B+RF2B)*VLPOB(L,NY,NX) + RHY=-RNH4*VLNH4(L,NY,NX)-RNHB*VLNHB(L,NY,NX) + 2-RXHY-RXHC+2.0*(RHALO1+RHFEO1+RHCACO + 2+(RHA0P2+RHF0P2-RHA3P1-RHA4P2-RHF3P1-RHF4P2)*VLPO4(L,NY,NX) + 3+(RHA0B2+RHF0B2-RHA3B1-RHA4B2-RHF3B1-RHF4B2)*VLPOB(L,NY,NX)) + 4+3.0*(RHAL1+RHFE1 + 5-(RHA4P1+RHF4P1)*VLPO4(L,NY,NX) + 6-(RHF4B1+RHA4B1)*VLPOB(L,NY,NX)) + 7+4.0*(RHCAH1*VLPO4(L,NY,NX)+RHCHB1*VLPOB(L,NY,NX)) + 8+7.0*(RHCAH2*VLPO4(L,NY,NX)+RHCHB2*VLPOB(L,NY,NX)) + 9+RHALO2+RHFEO2-RHALO4-RHFEO4+RHCACH-RCO2Q-RHCO3 + 1+(RHA0P1-RHA2P1+RHA1P2-RHA3P2+RHF0P1-RHF2P1+RHF1P2-RHF3P2 + 2+RHCAD2-RXOH2-RXOH1-RH1P-RH2P-RH3P)*VLPO4(L,NY,NX) + 3+(RHA0B1-RHA2B1+RHA1B2-RHA3B2+RHF0B1-RHF2B1+RHF1B2-RHF3B2 + 4+RHCDB2-RXO2B-RXO1B-RH1B-RH2B-RH3B)*VLPOB(L,NY,NX) + RCA=-RPCACX-RPCASO-RXCA-RCAO-RCAC-RCAH-RCAS + 2-(RPCADX+RPCAMX+RC0P+RC1P+RC2P)*VLPO4(L,NY,NX) + 3-(RPCDBX+RPCMBX+RC0B+RC1B+RC2B)*VLPOB(L,NY,NX) + 4-5.0*(RPCAHX*VLPO4(L,NY,NX)+RPCHBX*VLPOB(L,NY,NX)) + RMG=-RXMG-RMGO-RMGC-RMGH-RMGS + 2-RM1P*VLPO4(L,NY,NX)-RM1B*VLPOB(L,NY,NX) + RNA=-RXNA-RNAC-RNAS + RKA=-RXKA-RKAS + ROH=-RCAO-RMGO-RALO1 + 2-RALO2-RALO3-RALO4-RFEO1-RFEO2-RFEO3-RFEO4 + 3-(-RYH2P-RXH1P)*VLPO4(L,NY,NX) + 4-(-RYH2B-RXH1B)*VLPOB(L,NY,NX) + RSO4=-RPCASO-RALS-RFES-RCAS-RMGS-RNAS-RKAS + RCO3=-RHCAC3-RHCO3-RCAC-RMGC-RNAC + RHCO=-RHCACH-RCO2Q-RCAH-RMGH+RHCO3 + RCO2=-RHCACO +RCO2Q +C WRITE(20,27)'CO3',I,J,L,M,CCO31,CHCO31,CCO21,DPHCO,DPCO2 +C 2,RCO3,RHCAC3,RHCO3,RCAC,RMGC,RNAC +C 3,RHCO,RHCACH,RCO2Q,RCAH,RMGH,RHCO3 +C 4,RCO2,RHCACO,RCO2Q +27 FORMAT(A8,4I4,20F14.7) + RAL1=-RHALO1+RALO1-RALO2 + 2-(RHA1P1+RHA1P2)*VLPO4(L,NY,NX) + 3-(RHA1B1+RHA1B2)*VLPOB(L,NY,NX) + RAL2=-RHALO2+RALO2-RALO3 + 2-(RHA2P1+RHA2P2)*VLPO4(L,NY,NX) + 3-(RHA2B1+RHA2B2)*VLPOB(L,NY,NX) + RAL3=-RHALO3+RALO3-RALO4 + 2-(RHA3P1+RHA3P2)*VLPO4(L,NY,NX) + 3-(RHA3B1+RHA3B2)*VLPOB(L,NY,NX) + RAL4=-RHALO4+RALO4 + 2-(RHA4P1+RHA4P2)*VLPO4(L,NY,NX) + 3-(RHA4B1+RHA4B2)*VLPOB(L,NY,NX) + RFE1=-RHFEO1+RFEO1-RFEO2 + 2-(RHF1P1+RHF1P2)*VLPO4(L,NY,NX) + 3-(RHF1B1+RHF1B2)*VLPOB(L,NY,NX) + RFE2=-RHFEO2+RFEO2-RFEO3 + 2-(RHF2P1+RHF2P2)*VLPO4(L,NY,NX) + 3-(RHF2B1+RHF2B2)*VLPOB(L,NY,NX) + RFE3=-RHFEO3+RFEO3-RFEO4 + 2-(RHF3P1+RHF3P2)*VLPO4(L,NY,NX) + 3-(RHF3B1+RHF3B2)*VLPOB(L,NY,NX) + RFE4=-RHFEO4+RFEO4 + 2-(RHF4P1+RHF4P2)*VLPO4(L,NY,NX) + 3-(RHF4B1+RHF4B2)*VLPOB(L,NY,NX) + RHP0=-RH1P-RC0P + RHP1=-RHA0P1-RHA1P1-RHA2P1-RHA3P1 + 2-RHA4P1-RHF0P1-RHF1P1-RHF2P1 + 3-RHF3P1-RHF4P1-RPCAD1-3.0*RHCAH1-RXH1P + 4+RH1P-RH2P-RF1P-RC1P-RM1P + RHP2=-RHA0P2-RHA1P2-RHA2P2-RHA3P2 + 2-RHA4P2-RHF0P2-RHF1P2-RHF2P2 + 3-RHF3P2-RHF4P2-RHCAD2-3.0*RHCAH2 + 4-2.0*RPCAMX-RXH2P-RYH2P+RH2P-RH3P-RF2P-RC2P + RHP3=RH3P + RXH0=-RXOH1 + RXH1=RXOH1-RXOH2-RYH2P-RXH1P + RXH2=RXOH2-RXH2P + RX1P=RXH1P + RX2P=RXH2P+RYH2P + RHB0=-RH1B-RC0B + RHB1=-RHA0B1-RHA1B1-RHA2B1-RHA3B1 + 2-RHA4B1-RHF0B1-RHF1B1-RHF2B1 + 3-RHF3B1-RHF4B1-RPCDB1-3.0*RHCHB1-RXH1B + 4+RH1B-RH2B-RF1B-RC1B-RM1B + RHB2=-RHA0B2-RHA1B2-RHA2B2-RHA3B2 + 2-RHA4B2-RHF0B2-RHF1B2-RHF2B2 + 3-RHF3B2-RHF4B2-RHCDB2-3.0*RHCHB2 + 4-2.0*RPCMBX-RXH2B-RYH2B+RH2B-RH3B-RF2B-RC2B + RHB3=RH3B + RBH0=-RXO1B + RBH1=RXO1B-RXO2B-RYH2B-RXH1B + RBH2=RXO2B-RXH2B + RB1P=RXH1B + RB2P=RXH2B+RYH2B +C IF(NY.EQ.5.AND.L.EQ.10)THEN +C WRITE(20,23)'RHP1',I,J,NX,NY,L,M,RHP1,RHA0P1 +C 2,RHA1P1,RHA2P1,RHA3P1,RHA4P1 +C 3,RHF0P1,RHF1P1,RHF2P1,RHF3P1 +C 4,RHF4P1,RPCAD1,3.0*( RHCAH1),RXH1P,RH1P,RH2P,RF1P,RC1P,RM1P +C WRITE(20,23)'RHP2',I,J,NX,NY,L,M,RHP2,RHA0P2,RHA1P2 +C 2,RHA2P2,RHA3P2,RHA4P2,RHF0P2 +C 3,RHF1P2,RHF2P2,RHF3P2,RHF4P2,RHCAD2 +C 4,RHCAH2,RPCAMX,RXH2P,RYH2P,RH2P,RH3P,RF2P,RC2P +23 FORMAT(A8,6I4,60E12.4) +C ENDIF +C +C UPDATE ION CONCENTRATIONS FOR CURRENT ITERATION +C FROM TOTAL ION FLUXES +C + CN41=CN41+RN4S + CN4B=CN4B+RN4B + CN31=CN31+RN3S + CN3B=CN3B+RN3B + CAL1=CAL1+RAL + CFE1=CFE1+RFE + CHY1=CHY1+RHY + CCA1=CCA1+RCA + CMG1=CMG1+RMG + CNA1=CNA1+RNA + CKA1=CKA1+RKA + COH1=COH1+ROH + CSO41=CSO41+RSO4 + CCO31=CCO31+RCO3 + CHCO31=CHCO31+RHCO + CCO21=CCO21+RCO2 + CALO1=CALO1+RAL1 + CALO2=CALO2+RAL2 + CALO3=CALO3+RAL3 + CALO4=CALO4+RAL4 + CALS1=CALS1+RALS + CFEO1=CFEO1+RFE1 + CFEO2=CFEO2+RFE2 + CFEO3=CFEO3+RFE3 + CFEO4=CFEO4+RFE4 + CFES1=CFES1+RFES + CCAO1=CCAO1+RCAO + CCAC1=CCAC1+RCAC + CCAH1=CCAH1+RCAH + CCAS1=CCAS1+RCAS + CMGO1=CMGO1+RMGO + CMGC1=CMGC1+RMGC + CMGH1=CMGH1+RMGH + CMGS1=CMGS1+RMGS + CNAC1=CNAC1+RNAC + CNAS1=CNAS1+RNAS + CKAS1=CKAS1+RKAS + CH0P1=CH0P1+RHP0 + CH1P1=CH1P1+RHP1 + CH2P1=CH2P1+RHP2 + CH3P1=CH3P1+RHP3 + CF1P1=CF1P1+RF1P + CF2P1=CF2P1+RF2P + CC0P1=CC0P1+RC0P + CC1P1=CC1P1+RC1P + CC2P1=CC2P1+RC2P + CM1P1=CM1P1+RM1P + CH0PB=CH0PB+RHB0 + CH1PB=CH1PB+RHB1 + CH2PB=CH2PB+RHB2 + CH3PB=CH3PB+RHB3 + CF1PB=CF1PB+RF1B + CF2PB=CF2PB+RF2B + CC0PB=CC0PB+RC0B + CC1PB=CC1PB+RC1B + CC2PB=CC2PB+RC2B + CM1PB=CM1PB+RM1B +C +C REQUILIBRATE H2O-H+OH +C + CHY2=10.0**(-PH(L,NY,NX))*1.0E+03 + COH2=DPH2O/CHY2 + RHHY=CHY2-CHY1 + RHOH=COH2-COH1 + CHY1=CHY1+RHHY + COH1=COH1+RHOH +C IF(I.EQ.180.AND.J.EQ.12)THEN +C WRITE(*,1111)'CCA1',I,J,L,M,ACA1,AHY1,AH1P1,AH2P1,ACO31,AHCO31 +C 2,RCA,RPCACX,RPCASO,RPCADX,RPCDBX,5.0*(RPCAHX+RPCHBX),RPCAMX +C 2,RPCMBX,RXCA,RCAO,RCAC,RCAH,RCAS,RC0P,RC1P,RC2P,RC0B,RC1B,RC2B +C WRITE(*,1111)'CAL1',I,J,L,M,CAL1,CAL1*A3 +C 2,RAL,RXAL,RALO1,RALS +C 3,CSO41,CALS1,DPALS,A1A23D +C WRITE(*,1111)'CFEO2',I,J,L,M,CFEO2,CFEO2*A1 +C 2,RFE2,RHFEO2,RHF2P1,RHF2P2,RHF2B1 +C 2,RHF2B2,RFEO2,RFEO3 +C WRITE(20,1111)'CHY1',I,J,L,M,CHY1,RHY,RHHY,CN31,CN41,RNH4 +C 2,RXHY,RXHC +C 2,2.0*(RHALO1+RHFEO1+RHCACO +C 2+(RHA0P2+RHF0P2-RHA3P1-RHA4P2-RHF3P1-RHF4P2)*VLPO4(L,NY,NX) +C 3+(RHA0B2+RHF0B2-RHA3B1-RHA4B2-RHF3B1-RHF4B2)*VLPOB(L,NY,NX)) +C 4,3.0*(RHAL1+RHFE1 +C 5-(RHA4P1+RHF4P1)*VLPO4(L,NY,NX) +C 6-(RHF4B1+RHA4B1)*VLPOB(L,NY,NX)) +C 7,4.0*(RHCAH1*VLPO4(L,NY,NX)+RHCHB1*VLPOB(L,NY,NX)) +C 8,7.0*(RHCAH2*VLPO4(L,NY,NX)+RHCHB2*VLPOB(L,NY,NX)) +C 9,RHALO2,RHFEO2,RHALO4,RHFEO4,RHCACH,RCO2Q,RHCO3 +C 1,(RHA0P1-RHA2P1+RHA1P2-RHA3P2+RHF0P1-RHF2P1+RHF1P2-RHF3P2 +C 2+RHCAD2-RXOH2-RXOH1-RH1P-RH2P-RH3P)*VLPO4(L,NY,NX) +C 3,(RHA0B1-RHA2B1+RHA1B2-RHA3B2+RHF0B1-RHF2B1+RHF1B2-RHF3B2 +C 4+RHCDB2-RXO2B-RXO1B-RH1B-RH2B-RH3B)*VLPOB(L,NY,NX) +C WRITE(20,1111)'COH1',I,J,L,M,COH1,ROH,RHOH +C 2,RYH2P,RYH2B,RXH1P,RXH1B,RPALPX,RCAO,RMGO +C 2,RPCAHX,RALO1,RALO2,RALO3,RALO4,RFEO1,RFEO2,RFEO3,RFEO4 +1111 FORMAT(A8,4I4,80E12.4) +C ENDIF +C +C UPDATE EXCHANGEABLE ION CONCENTRATIONS IN CURRENT +C ITERATION FROM TOTAL ION FLUXES +C + XN41=XN41+RXN4 + XN4B=XN4B+RXNB + XHY1=XHY1+RXHY + XAL1=XAL1+RXAL + XFE1=XFE1+RXFE + XCA1=XCA1+RXCA + XMG1=XMG1+RXMG + XNA1=XNA1+RXNA + XKA1=XKA1+RXKA + XHC1=XHC1+RXHC + XALO21=XALO21+RXALO2 + XFEO21=XFEO21+RXFEO2 + XOH01=XOH01+RXH0 + XOH11=XOH11+RXH1 + XOH21=XOH21+RXH2 + XH1P1=XH1P1+RX1P + XH2P1=XH2P1+RX2P + XH01B=XH01B+RBH0 + XH11B=XH11B+RBH1 + XH21B=XH21B+RBH2 + X1P1B=X1P1B+RB1P + X2P1B=X2P1B+RB2P +C +C UPDATE PRECIPITATE CONCENTRATIONS IN CURRENT +C ITERATION FROM TOTAL ION FLUXES +C + PALOH1=PALOH1+RPALOX + PFEOH1=PFEOH1+RPFEOX + PCACO1=PCACO1+RPCACX + PCASO1=PCASO1+RPCASO + PALPO1=PALPO1+RPALPX + PFEPO1=PFEPO1+RPFEPX + PCAPD1=PCAPD1+RPCADX + PCAPH1=PCAPH1+RPCAHX + PCAPM1=PCAPM1+RPCAMX + PALPOB=PALPOB+RPALBX + PFEPOB=PFEPOB+RPFEBX + PCAPDB=PCAPDB+RPCDBX + PCAPHB=PCAPHB+RPCHBX + PCAPMB=PCAPMB+RPCMBX +C +C ACCUMULATE TOTAL ION FLUXES FOR ALL ITERATIONS +C + TRN4S(L,NY,NX)=TRN4S(L,NY,NX)+RN4S + TRN4B(L,NY,NX)=TRN4B(L,NY,NX)+RN4B + TRN3S(L,NY,NX)=TRN3S(L,NY,NX)+RN3S + TRN3B(L,NY,NX)=TRN3B(L,NY,NX)+RN3B + TRAL(L,NY,NX)=TRAL(L,NY,NX)+RAL + TRFE(L,NY,NX)=TRFE(L,NY,NX)+RFE + TRHY(L,NY,NX)=TRHY(L,NY,NX)+RHY+RHHY + TRCA(L,NY,NX)=TRCA(L,NY,NX)+RCA + TRMG(L,NY,NX)=TRMG(L,NY,NX)+RMG + TRNA(L,NY,NX)=TRNA(L,NY,NX)+RNA + TRKA(L,NY,NX)=TRKA(L,NY,NX)+RKA + TROH(L,NY,NX)=TROH(L,NY,NX)+ROH+RHOH + TRSO4(L,NY,NX)=TRSO4(L,NY,NX)+RSO4 + TRCO3(L,NY,NX)=TRCO3(L,NY,NX)+RCO3 + TRHCO(L,NY,NX)=TRHCO(L,NY,NX)+RHCO + TRAL1(L,NY,NX)=TRAL1(L,NY,NX)+RAL1 + TRAL2(L,NY,NX)=TRAL2(L,NY,NX)+RAL2 + TRAL3(L,NY,NX)=TRAL3(L,NY,NX)+RAL3 + TRAL4(L,NY,NX)=TRAL4(L,NY,NX)+RAL4 + TRALS(L,NY,NX)=TRALS(L,NY,NX)+RALS + TRFE1(L,NY,NX)=TRFE1(L,NY,NX)+RFE1 + TRFE2(L,NY,NX)=TRFE2(L,NY,NX)+RFE2 + TRFE3(L,NY,NX)=TRFE3(L,NY,NX)+RFE3 + TRFE4(L,NY,NX)=TRFE4(L,NY,NX)+RFE4 + TRFES(L,NY,NX)=TRFES(L,NY,NX)+RFES + TRCAO(L,NY,NX)=TRCAO(L,NY,NX)+RCAO + TRCAC(L,NY,NX)=TRCAC(L,NY,NX)+RCAC + TRCAH(L,NY,NX)=TRCAH(L,NY,NX)+RCAH + TRCAS(L,NY,NX)=TRCAS(L,NY,NX)+RCAS + TRMGO(L,NY,NX)=TRMGO(L,NY,NX)+RMGO + TRMGC(L,NY,NX)=TRMGC(L,NY,NX)+RMGC + TRMGH(L,NY,NX)=TRMGH(L,NY,NX)+RMGH + TRMGS(L,NY,NX)=TRMGS(L,NY,NX)+RMGS + TRNAC(L,NY,NX)=TRNAC(L,NY,NX)+RNAC + TRNAS(L,NY,NX)=TRNAS(L,NY,NX)+RNAS + TRKAS(L,NY,NX)=TRKAS(L,NY,NX)+RKAS + TRH0P(L,NY,NX)=TRH0P(L,NY,NX)+RHP0 + TRH1P(L,NY,NX)=TRH1P(L,NY,NX)+RHP1 + TRH2P(L,NY,NX)=TRH2P(L,NY,NX)+RHP2 + TRH3P(L,NY,NX)=TRH3P(L,NY,NX)+RHP3 + TRF1P(L,NY,NX)=TRF1P(L,NY,NX)+RF1P + TRF2P(L,NY,NX)=TRF2P(L,NY,NX)+RF2P + TRC0P(L,NY,NX)=TRC0P(L,NY,NX)+RC0P + TRC1P(L,NY,NX)=TRC1P(L,NY,NX)+RC1P + TRC2P(L,NY,NX)=TRC2P(L,NY,NX)+RC2P + TRM1P(L,NY,NX)=TRM1P(L,NY,NX)+RM1P + TRH0B(L,NY,NX)=TRH0B(L,NY,NX)+RHB0 + TRH1B(L,NY,NX)=TRH1B(L,NY,NX)+RHB1 + TRH2B(L,NY,NX)=TRH2B(L,NY,NX)+RHB2 + TRH3B(L,NY,NX)=TRH3B(L,NY,NX)+RHB3 + TRF1B(L,NY,NX)=TRF1B(L,NY,NX)+RF1B + TRF2B(L,NY,NX)=TRF2B(L,NY,NX)+RF2B + TRC0B(L,NY,NX)=TRC0B(L,NY,NX)+RC0B + TRC1B(L,NY,NX)=TRC1B(L,NY,NX)+RC1B + TRC2B(L,NY,NX)=TRC2B(L,NY,NX)+RC2B + TRM1B(L,NY,NX)=TRM1B(L,NY,NX)+RM1B + TRXN4(L,NY,NX)=TRXN4(L,NY,NX)+RXN4 + TRXNB(L,NY,NX)=TRXNB(L,NY,NX)+RXNB + TRXHY(L,NY,NX)=TRXHY(L,NY,NX)+RXHY + TRXAL(L,NY,NX)=TRXAL(L,NY,NX)+RXAL + TRXFE(L,NY,NX)=TRXFE(L,NY,NX)+RXFE + TRXCA(L,NY,NX)=TRXCA(L,NY,NX)+RXCA + TRXMG(L,NY,NX)=TRXMG(L,NY,NX)+RXMG + TRXNA(L,NY,NX)=TRXNA(L,NY,NX)+RXNA + TRXKA(L,NY,NX)=TRXKA(L,NY,NX)+RXKA + TRXHC(L,NY,NX)=TRXHC(L,NY,NX)+RXHC + TRXAL2(L,NY,NX)=TRXAL2(L,NY,NX)+RXALO2 + TRXFE2(L,NY,NX)=TRXFE2(L,NY,NX)+RXFEO2 + TRXH0(L,NY,NX)=TRXH0(L,NY,NX)+RXH0 + TRXH1(L,NY,NX)=TRXH1(L,NY,NX)+RXH1 + TRXH2(L,NY,NX)=TRXH2(L,NY,NX)+RXH2 + TRX1P(L,NY,NX)=TRX1P(L,NY,NX)+RX1P + TRX2P(L,NY,NX)=TRX2P(L,NY,NX)+RX2P + TRBH0(L,NY,NX)=TRBH0(L,NY,NX)+RBH0 + TRBH1(L,NY,NX)=TRBH1(L,NY,NX)+RBH1 + TRBH2(L,NY,NX)=TRBH2(L,NY,NX)+RBH2 + TRB1P(L,NY,NX)=TRB1P(L,NY,NX)+RB1P + TRB2P(L,NY,NX)=TRB2P(L,NY,NX)+RB2P + TRALOH(L,NY,NX)=TRALOH(L,NY,NX)+RPALOX + TRFEOH(L,NY,NX)=TRFEOH(L,NY,NX)+RPFEOX + TRCACO(L,NY,NX)=TRCACO(L,NY,NX)+RPCACX + TRCASO(L,NY,NX)=TRCASO(L,NY,NX)+RPCASO + TRALPO(L,NY,NX)=TRALPO(L,NY,NX)+RPALPX + TRFEPO(L,NY,NX)=TRFEPO(L,NY,NX)+RPFEPX + TRCAPD(L,NY,NX)=TRCAPD(L,NY,NX)+RPCADX + TRCAPH(L,NY,NX)=TRCAPH(L,NY,NX)+RPCAHX + TRCAPM(L,NY,NX)=TRCAPM(L,NY,NX)+RPCAMX + TRALPB(L,NY,NX)=TRALPB(L,NY,NX)+RPALBX + TRFEPB(L,NY,NX)=TRFEPB(L,NY,NX)+RPFEBX + TRCPDB(L,NY,NX)=TRCPDB(L,NY,NX)+RPCDBX + TRCPHB(L,NY,NX)=TRCPHB(L,NY,NX)+RPCHBX + TRCPMB(L,NY,NX)=TRCPMB(L,NY,NX)+RPCMBX +C +C GO TO NEXT ITERATION +C +1000 CONTINUE +C +C ITERATIONS COMPLETED +C +C IF(J.EQ.24)THEN +C WRITE(*,1119)'GAPON',I,J,L,M,CH0P1,CAL1,CFE1,CH0P1*A3*CAL1*A3 +C 2,SPALP,CH0P1*A3*CFE1*A3,SPFEP +C 6,SPOH2,XOH11*CHY1*A1/XOH21,SPOH1,XOH01*CHY1*A1/XOH11 +C 7,SPH2P,XOH21*CH2P1*A1/XH2P1,SXH2P,XOH11*CH2P1/(XH2P1*COH1) +C 8,SPH1P,XOH11*CH1P1*A2/(XH1P1*COH1*A1) +C 9,COH1*A1,CHY1*A1 +1119 FORMAT(A8,4I4,24E11.3) +C WRITE(*,1119)'CATION',I,J,L,M,CCEC,XN41+XHY1+3*XAL1+2*(XCA1+XMG1) +C 2+XNA1+XKA1,XN41,XHY1,XAL1,XCA1,XMG1,XNA1,XKA1,CN41,CHY1,CAL1,CCA1 +C 2,CMG1,CNA1,CKA1,(CCA1*A2)**0.5*XN41/(CN41*A1*XCA1*2) +C 3,(CCA1*A2)**0.5*XHY1/(CHY1*A1*XCA1*2) +C 2,(CCA1*A2)**0.5*XAL1*3/((CAL1*A3)**0.333*XCA1*2) +C 3,(CCA1*A2)**0.5*XMG1*2/((CMG1*A2)**0.5*XCA1*2) +C 3,(CCA1*A2)**0.5*XNA1/(CNA1*A1*XCA1*2) +C 5,(CCA1*A2)**0.5*XKA1/(CKA1*A1*XCA1*2) +C 6,CHY1*A1*XCOO/XHC1,CALO2*A1*XCOO/XALO21 +C ENDIF +C +C CONVERT TOTAL ION FLUXES FROM CHANGES IN CONCENTRATION +C TO CHANGES IN MASS PER UNIT AREA FOR USE IN 'REDIST' +C + TRN4S(L,NY,NX)=TRN4S(L,NY,NX)*VOLWNH + TRN4B(L,NY,NX)=TRN4B(L,NY,NX)*VOLWNB + TRN3S(L,NY,NX)=TRN3S(L,NY,NX)*VOLWNH + TRN3B(L,NY,NX)=TRN3B(L,NY,NX)*VOLWNB + TRAL(L,NY,NX)=TRAL(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRFE(L,NY,NX)=TRFE(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRHY(L,NY,NX)=TRHY(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRCA(L,NY,NX)=TRCA(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRMG(L,NY,NX)=TRMG(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRNA(L,NY,NX)=TRNA(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRKA(L,NY,NX)=TRKA(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TROH(L,NY,NX)=TROH(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRSO4(L,NY,NX)=TRSO4(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRCO3(L,NY,NX)=TRCO3(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRHCO(L,NY,NX)=TRHCO(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRAL1(L,NY,NX)=TRAL1(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRAL2(L,NY,NX)=TRAL2(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRAL3(L,NY,NX)=TRAL3(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRAL4(L,NY,NX)=TRAL4(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRALS(L,NY,NX)=TRALS(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRFE1(L,NY,NX)=TRFE1(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRFE2(L,NY,NX)=TRFE2(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRFE3(L,NY,NX)=TRFE3(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRFE4(L,NY,NX)=TRFE4(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRFES(L,NY,NX)=TRFES(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRCAO(L,NY,NX)=TRCAO(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRCAC(L,NY,NX)=TRCAC(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRCAH(L,NY,NX)=TRCAH(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRCAS(L,NY,NX)=TRCAS(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRMGO(L,NY,NX)=TRMGO(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRMGC(L,NY,NX)=TRMGC(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRMGH(L,NY,NX)=TRMGH(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRMGS(L,NY,NX)=TRMGS(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRNAC(L,NY,NX)=TRNAC(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRNAS(L,NY,NX)=TRNAS(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRKAS(L,NY,NX)=TRKAS(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRH0P(L,NY,NX)=TRH0P(L,NY,NX)*VOLWPO + TRH1P(L,NY,NX)=TRH1P(L,NY,NX)*VOLWPO + TRH2P(L,NY,NX)=TRH2P(L,NY,NX)*VOLWPO + TRH3P(L,NY,NX)=TRH3P(L,NY,NX)*VOLWPO + TRF1P(L,NY,NX)=TRF1P(L,NY,NX)*VOLWPO + TRF2P(L,NY,NX)=TRF2P(L,NY,NX)*VOLWPO + TRC0P(L,NY,NX)=TRC0P(L,NY,NX)*VOLWPO + TRC1P(L,NY,NX)=TRC1P(L,NY,NX)*VOLWPO + TRC2P(L,NY,NX)=TRC2P(L,NY,NX)*VOLWPO + TRM1P(L,NY,NX)=TRM1P(L,NY,NX)*VOLWPO + TRH0B(L,NY,NX)=TRH0B(L,NY,NX)*VOLWPB + TRH1B(L,NY,NX)=TRH1B(L,NY,NX)*VOLWPB + TRH2B(L,NY,NX)=TRH2B(L,NY,NX)*VOLWPB + TRH3B(L,NY,NX)=TRH3B(L,NY,NX)*VOLWPB + TRF1B(L,NY,NX)=TRF1B(L,NY,NX)*VOLWPB + TRF2B(L,NY,NX)=TRF2B(L,NY,NX)*VOLWPB + TRC0B(L,NY,NX)=TRC0B(L,NY,NX)*VOLWPB + TRC1B(L,NY,NX)=TRC1B(L,NY,NX)*VOLWPB + TRC2B(L,NY,NX)=TRC2B(L,NY,NX)*VOLWPB + TRM1B(L,NY,NX)=TRM1B(L,NY,NX)*VOLWPB + TRXN4(L,NY,NX)=TRXN4(L,NY,NX)*VOLWNH + TRXNB(L,NY,NX)=TRXNB(L,NY,NX)*VOLWNB + TRXHY(L,NY,NX)=TRXHY(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRXAL(L,NY,NX)=TRXAL(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRXFE(L,NY,NX)=TRXFE(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRXCA(L,NY,NX)=TRXCA(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRXMG(L,NY,NX)=TRXMG(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRXNA(L,NY,NX)=TRXNA(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRXKA(L,NY,NX)=TRXKA(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRXHC(L,NY,NX)=TRXHC(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRXAL2(L,NY,NX)=TRXAL2(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRXFE2(L,NY,NX)=TRXFE2(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRXH0(L,NY,NX)=TRXH0(L,NY,NX)*VOLWPO + TRXH1(L,NY,NX)=TRXH1(L,NY,NX)*VOLWPO + TRXH2(L,NY,NX)=TRXH2(L,NY,NX)*VOLWPO + TRX1P(L,NY,NX)=TRX1P(L,NY,NX)*VOLWPO + TRX2P(L,NY,NX)=TRX2P(L,NY,NX)*VOLWPO + TRBH0(L,NY,NX)=TRBH0(L,NY,NX)*VOLWPB + TRBH1(L,NY,NX)=TRBH1(L,NY,NX)*VOLWPB + TRBH2(L,NY,NX)=TRBH2(L,NY,NX)*VOLWPB + TRB1P(L,NY,NX)=TRB1P(L,NY,NX)*VOLWPB + TRB2P(L,NY,NX)=TRB2P(L,NY,NX)*VOLWPB + TRALOH(L,NY,NX)=TRALOH(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRFEOH(L,NY,NX)=TRFEOH(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRCACO(L,NY,NX)=TRCACO(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRCASO(L,NY,NX)=TRCASO(L,NY,NX)*VOLWM(NPH,L,NY,NX) + TRALPO(L,NY,NX)=TRALPO(L,NY,NX)*VOLWPO + TRFEPO(L,NY,NX)=TRFEPO(L,NY,NX)*VOLWPO + TRCAPD(L,NY,NX)=TRCAPD(L,NY,NX)*VOLWPO + TRCAPH(L,NY,NX)=TRCAPH(L,NY,NX)*VOLWPO + TRCAPM(L,NY,NX)=TRCAPM(L,NY,NX)*VOLWPO + TRALPB(L,NY,NX)=TRALPB(L,NY,NX)*VOLWPB + TRFEPB(L,NY,NX)=TRFEPB(L,NY,NX)*VOLWPB + TRCPDB(L,NY,NX)=TRCPDB(L,NY,NX)*VOLWPB + TRCPHB(L,NY,NX)=TRCPHB(L,NY,NX)*VOLWPB + TRCPMB(L,NY,NX)=TRCPMB(L,NY,NX)*VOLWPB +C +C BOUNDARY SALT FLUXES FOR C, H, OH, P, AL+FE, CA, OH +C + TRCO2(L,NY,NX)=TRCO3(L,NY,NX)+2.0*TRHCO(L,NY,NX) + 2+TRCAC(L,NY,NX)+TRMGC(L,NY,NX) + 2+TRNAC(L,NY,NX)+2.0*TRCAH(L,NY,NX) + 2+2.0*TRMGH(L,NY,NX)+TRCACO(L,NY,NX) + TRH2O(L,NY,NX)=TRHY(L,NY,NX)+TROH(L,NY,NX)+TRXHY(L,NY,NX) + 2+TRXHC(L,NY,NX) + TBION(L,NY,NX)=4.0*(TRH3P(L,NY,NX)+TRH3B(L,NY,NX)) + 2+3.0*(TRF2P(L,NY,NX)+TRC2P(L,NY,NX) + 2+TRF2B(L,NY,NX)+TRC2B(L,NY,NX)) + 3+2.0*(TRF1P(L,NY,NX)+TRC1P(L,NY,NX)+TRM1P(L,NY,NX) + 4+TRF1B(L,NY,NX)+TRC1B(L,NY,NX)+TRM1B(L,NY,NX)) + 5+TRH0P(L,NY,NX)+TRC0P(L,NY,NX)+TRH0B(L,NY,NX)+TRC0B(L,NY,NX) + 6-(TRALPO(L,NY,NX)+TRFEPO(L,NY,NX) + 6+TRALPB(L,NY,NX)+TRFEPB(L,NY,NX)) + 7-(TRCAPD(L,NY,NX)+TRCAPM(L,NY,NX) + 6+TRCPDB(L,NY,NX)+TRCPMB(L,NY,NX) + 8+5.0*(TRCAPH(L,NY,NX)+TRCPHB(L,NY,NX))) + 9+TRAL1(L,NY,NX)+TRFE1(L,NY,NX) + 1+2.0*(TRAL2(L,NY,NX)+TRFE2(L,NY,NX)) + 1+3.0*(TRAL3(L,NY,NX)+TRFE3(L,NY,NX)) + 2+4.0*(TRAL4(L,NY,NX)+TRFE4(L,NY,NX)) + 3+TRCAO(L,NY,NX)+TRMGO(L,NY,NX) + 4+3.0*(TRALOH(L,NY,NX)+TRFEOH(L,NY,NX)) +C WRITE(20,1111)'TBION',I,J,L,M,TBION(L,NY,NX) +C +C IF NO SALTS IS SELECTED IN SITE FILE THEN A SUBSET +C OF THE EQUILIBRIA REACTIONS ARE SOLVED: MOSTLY THOSE +C FOR PHOSPHORUS +C + ELSE +C +C PRECIPITATION-DISSOLUTION CALCULATED FROM ACTIVITIES +C OF REACTANTS AND PRODUCTS THROUGH SOLUTIONS +C FOR THEIR EQUILIBRIUM CONSTANTS USING CURRENT +C ION CONCENTRATION +C + CCEC=AMAX1(ZERO,XCEC(L,NY,NX)/BKVLX) + CHY1=AMAX1(ZERO,10.0**(-(PH(L,NY,NX)-3.0))) + COH1=AMAX1(ZERO,DPH2O/CHY1) + IF(CAL(L,NY,NX).LT.0.0)THEN + CAL1=AMAX1(ZERO,SPALO/COH1**3) + ELSE + CAL1=AMAX1(ZERO,AMIN1(CAL(L,NY,NX),SPALO/COH1**3)) + ENDIF + IF(CFE(L,NY,NX).LT.0.0)THEN + CFE1=AMAX1(ZERO,SPFEO/COH1**3) + ELSE + CFE1=AMAX1(ZERO,AMIN1(CFE(L,NY,NX),SPFEO/COH1**3)) + ENDIF + CMG1=AMAX1(ZERO,ZMG(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CNA1=AMAX1(ZERO,ZNA(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + CKA1=AMAX1(ZERO,ZKA(L,NY,NX)/VOLWM(NPH,L,NY,NX)) +C +C CA CONCENTRATION FROM CURRENT CO2 CONCENTRATION +C + CCO21=AMAX1(ZERO,CCO2S(L,NY,NX)/12.0) + CCO31=AMAX1(ZERO,CCO21*DPCO3/CHY1**2) + IF(CCA(L,NY,NX).LT.0.0)THEN + CCA1=AMAX1(ZERO,AMIN1(CCAMX,SPCAC/CCO31)) + ELSE + CCA1=AMAX1(ZERO,AMIN1(CCA(L,NY,NX),SPCAC/CCO31)) + ENDIF +C +C PHOSPHORUS TRANSFORMATIONS IN NON-BAND SOIL ZONE +C + IF(VOLWPO.GT.ZEROS(NY,NX))THEN +C +C ALUMINUM PHOSPHATE (VARISCITE) +C + CH2PA=SYA0P2/(CAL1*COH1**2) + RPALPX=AMAX1(-PALPO1,TPD*(CH2P1-CH2PA)) +C IF(I.EQ.180.AND.J.EQ.12)THEN +C WRITE(*,1117)'RPALPX',I,J,L,CH2P1,CH2PA,SYA0P2,CAL1,COH1,PALPO1 +C 2,RPALPX,CAL1*CH2P1*COH1**2 +C ENDIF +C +C IRON PHOSPHATE (STRENGITE) +C + CH2PF=SYF0P2/(CFE1*COH1**2) + RPFEPX=AMAX1(-PFEPO1,TPD*(CH2P1-CH2PF)) +C IF(I.EQ.180.AND.J.EQ.12)THEN +C WRITE(*,1117)'RPFEPX',I,J,L,CH2P1,CH2PF,SYF0P2,CFE1,COH1,PFEPO1 +C 3,RPFEPX,CFE1*CH2P1*COH1**2 +C ENDIF +C +C DICALCIUM PHOSPHATE +C + CH2PD=SYCAD2/(CCA1*COH1) + RPCADX=AMAX1(-PCAPD1,TPD*(CH2P1-CH2PD)) +C +C HYDROXYAPATITE +C + CH2PH=(SYCAH2/(CCA1**5*COH1**7))**0.333 + RPCAHX=AMAX1(-PCAPH1,TPD*(CH2P1-CH2PH)) +C IF(I.EQ.180.AND.J.EQ.12)THEN +C WRITE(*,1117)'RPCAHX',I,J,L,CH2P1,CH2PH,SYCAH2,CCA1,COH1,SPCAC +C 2,DPCO3,CCO31,CCO21,CHY1,PH(L,NY,NX),PCAPH1,RPCAHX +C 3,CCA1**5*CH2P1**3*COH1**7 +C ENDIF +C +C MONOCALCIUM PHOSPHATE +C + CH2PM=SQRT(SPCAM/CCA1) + RPCAMX=AMAX1(-PCAPM1*SPPO4,TPD*(CH2P1-CH2PM)) +C IF(I.GT.315)THEN +C WRITE(*,1117)'RPPO4',I,J,L,RPCADX,CH2P1,CH2PD,PCAPD1,RPCAHX +C 2,CH2PA,CH2PH,SYA0P2,CAL1,COH1,SYCAH2,CCA1,CCO21,CCO31,PCAPH1 +C 3,VOLWPO,SPCAC/CCO31,CCA(L,NY,NX),H2PO4(L,NY,NX) +C 4,VOLWM(NPH,L,NY,NX),ZCA(L,NY,NX),CCO2S(L,NY,NX) +1117 FORMAT(A8,3I4,30E12.4) +C ENDIF +C +C PHOSPHORUS ANION EXCHANGE IN NON-BAND SOIL ZONE +C CALCULATED FROM EXCHANGE EQUILIBRIA AMONG H2PO4-, +C HPO4--, H+, OH- AND PROTONATED AND NON-PROTONATED -OH +C EXCHANGE SITES +C + IF(VOLWM(NPH,L,NY,NX).GT.ZEROS(NY,NX))THEN + VOLWBK=AMIN1(1.0,BKVL(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + ELSE + VOLWBK=1.0 + ENDIF + IF(AEC(L,NY,NX).GT.0.0)THEN +C +C H2PO4 EXCHANGE IN NON-BAND SOIL ZONE FROM CONVERGENCE +C SOLUTION FOR EQUILIBRIUM AMONG H2PO4-, H+, OH-, X-OH +C AND X-H2PO4 +C + SPH2P=SXH2P*DPH2O + RXH2P=TADA*(XOH21*CH2P1-SPH2P*XH2P1)/(XOH21+SPH2P)*VOLWBK + RYH2P=TADA*(XOH11*CH2P1-SXH2P*COH1*XH2P1)/(XOH11+SXH2P)*VOLWBK +C +C HPO4 EXCHANGE IN NON-BAND SOIL ZONE FROM CONVERGENCE +C SOLUTION FOR EQUILIBRIUM AMONG HPO4--, H+, OH-, X-OH +C AND X-HPO4 +C + SPH1P=SXH1P*DPH2O/DPH2P + RXH1P=TADA*(XOH11*CH1P1-SPH1P*XH1P1)/(XOH11+SPH1P)*VOLWBK +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 +C 3,H2PO4(L,NY,NX),RH2PX,VOLWPO +C WRITE(*,1116)'RYH2P',I,J,NX,NY,L,RYH2P +C 2,XOH11,CH2P1,XH2P1,COH1,(XOH11*(CH2P1-RYH2P)) +C 3/((XH2P1+RYH2P)*COH1),SXH2P +C WRITE(*,1116)'RXH1P',I,J,NX,NY,L,RXH1P +C 2,XOH11,CH1P1,XH1P1,XOH11*(CH1P1-RXH1P)/(XH1P1+RXH1P),SPH1P +C 3,SYH1P,DPH2O,DPH2P,XOH1(L,NY,NX),VLPO4(L,NY,NX),VLPOB(L,NY,NX) +C 4,TKS(L,NY,NX),XOH21,XOH01 +1116 FORMAT(A8,5I4,40E12.4) +C ENDIF +C +C H2PO4-H+HPO4 +C + DP=DPH2P + S0=CH1P1+CHY1+DP + 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 + RPCAHX=0.0 + RPCAMX=0.0 + RXH2P=0.0 + RYH2P=0.0 + RXH1P=0.0 + RH2P=0.0 + ENDIF +C IF(J.EQ.1)THEN +C WRITE(*,2222)'PO4',I,J,L,CH2P1,PALPO1,PFEPO1,PCAPD1,PCAPH1,PCAPM1 +C 2,CH2PA,CH2PF,CH2PD,CH2PH,CH2PM,RPALPX,RPFEPX,RPCADX,RPCAHX,RPCAMX +C 3,XH2P1,RXH2P,RYH2P +C 3,CAL1,CFE1,CCA1,CHY1,COH1 +2222 FORMAT(A8,3I4,40F14.7) +C ENDIF +C +C PHOSPHORUS PRECIPITATION-DISSOLUTION IN BAND SOIL ZONE +C + IF(VOLWPB.GT.ZEROS(NY,NX))THEN +C +C ALUMINUM PHOSPHATE (VARISCITE) +C + CH2PA=SYA0P2/(CAL1*COH1**2) + RPALBX=AMAX1(-PALPOB,TPD*(CH2PB-CH2PA)) +C +C IRON PHOSPHATE (STRENGITE) +C + CH2PF=SYF0P2/(CFE1*COH1**2) + RPFEBX=AMAX1(-PFEPOB,TPD*(CH2PB-CH2PF)) +C +C DICALCIUM PHOSPHATE +C + CH2PD=SYCAD2/(CCA1*COH1) + RPCDBX=AMAX1(-PCAPDB,TPD*(CH2PB-CH2PD)) +C +C HYDROXYAPATITE +C + CH2PH=(SYCAH2/(CCA1**5*COH1**7))**0.333 + RPCHBX=AMAX1(-PCAPHB,TPD*(CH2PB-CH2PH)) +C +C MONOCALCIUM PHOSPHATE +C + CH2PM=SQRT(SPCAM/CCA1) + RPCMBX=AMAX1(-PCAPMB*SPPO4,TPD*(CH2PB-CH2PM)) +C +C PHOSPHORUS ANION EXCHANGE IN BAND SOIL ZONE +C CALCULATED FROM EXCHANGE EQUILIBRIA AMONG H2PO4-, +C HPO4--, H+, OH- AND PROTONATED AND NON-PROTONATED -OH +C EXCHANGE SITES +C + IF(AEC(L,NY,NX).GT.0.0)THEN +C +C H2PO4 EXCHANGE IN BAND SOIL ZONE FROM CONVERGENCE +C SOLUTION FOR EQUILIBRIUM AMONG H2PO4-, H+, OH-, X-OH +C AND X-H2PO4 +C + SPH2P=SXH2P*DPH2O + RXH2B=TADA*(XH21B*CH2PB-SPH2P*X2P1B)/(XH21B+SPH2P)*VOLWBK + RYH2B=TADA*(XH11B*CH2PB-SXH2P*X2P1B*COH1)/(XH11B+SXH2P)*VOLWBK +C +C HPO4 EXCHANGE IN BAND SOIL ZONE FROM CONVERGENCE +C SOLUTION FOR EQUILIBRIUM AMONG HPO4--, H+, OH-, X-OH +C AND X-HPO4 +C + SPH1P=SXH1P*DPH2O/DPH2P + RXH1B=TADA*(XH11B*CH1PB-SPH1P*X1P1B)/(XH11B+SPH1P)*VOLWBK +C WRITE(*,2224)'RXH1B',I,J,L,RXH1B,XH11B,CH1PB,SPH1P,X1P1B +2224 FORMAT(A8,3I4,40E12.4) +C +C H2PO4-H+HPO4 +C + DP=DPH2P + S0=CH1PB+CHY1+DP + 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 + RPCHBX=0.0 + RPCMBX=0.0 + RXH2B=0.0 + RYH2B=0.0 + RXH1B=0.0 + RH2B=0.0 + ENDIF +C +C CATION EXCHANGE FROM GAPON SELECTIVITY COEFFICIENTS +C FOR CA-NH4, CA-H, CA-AL +C + CN41=AMAX1(ZERO,CN41) + CN4B=AMAX1(ZERO,CN4B) + CALX=AMAX1(ZERO,CAL1)**0.333 + CFEX=AMAX1(ZERO,CFE1)**0.333 + CCAX=AMAX1(ZERO,CCA1)**0.500 + CMGX=AMAX1(ZERO,CMG1)**0.500 + CNA1=AMAX1(ZERO,CNA1) + CKA1=AMAX1(ZERO,CKA1) +C +C EQUILIBRIUM X-CA CONCENTRATION FROM CEC AND CATION +C CONCENTRATIONS +C + XCAX=CCEC/(1.0+GKC4(L,NY,NX)*CN41/CCAX*VLNH4(L,NY,NX) + 2+GKC4(L,NY,NX)*CN4B/CCAX*VLNHB(L,NY,NX) + 3+GKCH(L,NY,NX)*CHY1/CCAX+GKCA(L,NY,NX)*CALX/CCAX + 3+GKCA(L,NY,NX)*CFEX/CCAX+GKCM(L,NY,NX)*CMGX/CCAX + 3+GKCN(L,NY,NX)*CNA1/CCAX+GKCK(L,NY,NX)*CKA1/CCAX) + XN4Q=XCAX*CN41*GKC4(L,NY,NX) + XNBQ=XCAX*CN4B*GKC4(L,NY,NX) + XHYQ=XCAX*CHY1*GKCH(L,NY,NX) + XALQ=XCAX*CALX*GKCA(L,NY,NX) + XFEQ=XCAX*CFEX*GKCA(L,NY,NX) + XCAQ=XCAX*CCAX + XMGQ=XCAX*CMGX*GKCM(L,NY,NX) + XNAQ=XCAX*CNA1*GKCN(L,NY,NX) + XKAQ=XCAX*CKA1*GKCK(L,NY,NX) + XTLQ=XN4Q*VLNH4(L,NY,NX)+XNBQ*VLNHB(L,NY,NX) + 2+XHYQ+XALQ+XFEQ+XCAQ+XMGQ+XNAQ+XKAQ + IF(XTLQ.GT.ZERO)THEN + FX=CCEC/XTLQ + ELSE + FX=0.0 + ENDIF + XN4Q=FX*XN4Q + XNBQ=FX*XNBQ +C +C NH4 EXCHANGE IN NON-BAND AND BAND SOIL ZONES +C + RXN4=TADC*(XN4Q-XN41)*CN41/XN4Q + RXNB=TADC*(XNBQ-XN4B)*CN4B/XNBQ +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 ENDIF +C +C NH4-NH3+H IN NON-BAND AND BAND SOIL ZONES +C + IF(VOLWNH.GT.ZEROS(NY,NX))THEN + RNH4=(CHY1*CN31-DPN4*CN41)/(DPN4+CHY1) + ELSE + RNH4=0.0 + ENDIF + IF(VOLWNB.GT.ZEROS(NY,NX))THEN + RNHB=(CHY1*CN3B-DPN4*CN4B)/(DPN4+CHY1) + ELSE + 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 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) +C 4,RN4X,RN3X,RNBX,R3BX +C ENDIF +C +C TOTAL ION FLUXES FOR ALL REACTIONS ABOVE +C + RN4S=RNH4-RXN4 + RN4B=RNHB-RXNB + RN3S=-RNH4 + RN3B=-RNHB + RHP1=-RH2P-RXH1P + RHP2=RH2P-RXH2P-RYH2P + 2-RPALPX-RPFEPX-RPCADX-2.0*RPCAMX-3.0*RPCAHX + RHB1=-RH2B-RXH1B + RHB2=RH2B-RXH2B-RYH2B + 2-RPALBX-RPFEBX-RPCDBX-2.0*RPCMBX-3.0*RPCHBX + RXH1=-RYH2P-RXH1P + RXH2=-RXH2P + RX1P=RXH1P + RX2P=RXH2P+RYH2P + RBH1=-RYH2B-RXH1B + RBH2=-RXH2B + RB1P=RXH1B + RB2P=RXH2B+RYH2B +C +C CONVERT TOTAL ION FLUXES FROM CHANGES IN CONCENTRATION +C TO CHANGES IN MASS PER UNIT AREA FOR USE IN 'REDIST' +C + TRN4S(L,NY,NX)=TRN4S(L,NY,NX)+RN4S*VOLWNH + TRN4B(L,NY,NX)=TRN4B(L,NY,NX)+RN4B*VOLWNB + TRN3S(L,NY,NX)=TRN3S(L,NY,NX)+RN3S*VOLWNH + TRN3B(L,NY,NX)=TRN3B(L,NY,NX)+RN3B*VOLWNB + TRH1P(L,NY,NX)=TRH1P(L,NY,NX)+RHP1*VOLWPO + TRH2P(L,NY,NX)=TRH2P(L,NY,NX)+RHP2*VOLWPO + TRH1B(L,NY,NX)=TRH1B(L,NY,NX)+RHB1*VOLWPB + TRH2B(L,NY,NX)=TRH2B(L,NY,NX)+RHB2*VOLWPB + TRXN4(L,NY,NX)=TRXN4(L,NY,NX)+RXN4*VOLWNH + TRXNB(L,NY,NX)=TRXNB(L,NY,NX)+RXNB*VOLWNB + TRXH1(L,NY,NX)=TRXH1(L,NY,NX)+RXH1*VOLWPO + TRXH2(L,NY,NX)=TRXH2(L,NY,NX)+RXH2*VOLWPO + TRX1P(L,NY,NX)=TRX1P(L,NY,NX)+RX1P*VOLWPO + TRX2P(L,NY,NX)=TRX2P(L,NY,NX)+RX2P*VOLWPO + TRBH1(L,NY,NX)=TRBH1(L,NY,NX)+RBH1*VOLWPB + TRBH2(L,NY,NX)=TRBH2(L,NY,NX)+RBH2*VOLWPB + TRB1P(L,NY,NX)=TRB1P(L,NY,NX)+RB1P*VOLWPB + TRB2P(L,NY,NX)=TRB2P(L,NY,NX)+RB2P*VOLWPB + TRALPO(L,NY,NX)=TRALPO(L,NY,NX)+RPALPX*VOLWPO + TRFEPO(L,NY,NX)=TRFEPO(L,NY,NX)+RPFEPX*VOLWPO + TRCAPD(L,NY,NX)=TRCAPD(L,NY,NX)+RPCADX*VOLWPO + TRCAPH(L,NY,NX)=TRCAPH(L,NY,NX)+RPCAHX*VOLWPO + TRCAPM(L,NY,NX)=TRCAPM(L,NY,NX)+RPCAMX*VOLWPO + TRALPB(L,NY,NX)=TRALPB(L,NY,NX)+RPALBX*VOLWPB + TRFEPB(L,NY,NX)=TRFEPB(L,NY,NX)+RPFEBX*VOLWPB + TRCPDB(L,NY,NX)=TRCPDB(L,NY,NX)+RPCDBX*VOLWPB + TRCPHB(L,NY,NX)=TRCPHB(L,NY,NX)+RPCHBX*VOLWPB + TRCPMB(L,NY,NX)=TRCPMB(L,NY,NX)+RPCMBX*VOLWPB +C IF(L.EQ.1)THEN +C WRITE(20,24)'RHP1',I,J,L,RHP1,RH2P,RXH1P +C 2,TRX1P(L,NY,NX),TRH2P(L,NY,NX) +C WRITE(20,24)'RHP2',I,J,L,RHP2,RH2P,RXH2P,RYH2P +C 2,RPALPX,RPFEPX,RPCADX,2.0*RPCAMX,3.0*RPCAHX +C 3,TRX2P(L,NY,NX) +24 FORMAT(A8,3I4,60E12.4) +C ENDIF + ENDIF +C +C CHANGE IN WIDTHS AND DEPTHS OF FERTILIZER BANDS FROM +C VERTICAL AND HORIZONTAL DIFFUSION DRIVEN BY CONCENTRATION +C DIFFERENCES BETWEEN BAND AND NON-BAND SOIL ZONES +C +C IF(ROWI(I,NY,NX).GT.0.0)THEN + FLWD=0.5*(FLW(3,L,NY,NX)+FLW(3,L+1,NY,NX))/AREA(3,L,NY,NX) +C +C NH4 FERTILIZER BAND +C + IF(IFNHB(NY,NX).EQ.1.AND.ROWN(NY,NX).GT.0.0)THEN + IF(L.EQ.NU(NY,NX).OR.CDPTH(L-1,NY,NX).LT.DPNH4(NY,NX))THEN +C +C NH4 BAND WIDTH +C + DWNH4=0.5*SQRT(ZNSGL(L,NY,NX))*TORT(NPH,L,NY,NX) + WDNHB(L,NY,NX)=AMIN1(ROWN(NY,NX) + 2,AMAX1(0.025,WDNHB(L,NY,NX))+DWNH4) +C +C NH4 BAND DEPTH +C + IF(CDPTH(L,NY,NX).GE.DPNH4(NY,NX))THEN + DPFLW=FLWD+DWNH4 + DPNH4(NY,NX)=DPNH4(NY,NX)+DPFLW + DPNHB(L,NY,NX)=DPNHB(L,NY,NX)+DPFLW + IF(DPNHB(L,NY,NX).GT.DLYR(3,L,NY,NX))THEN + DPNHB(L+1,NY,NX)=DPNHB(L+1,NY,NX)+(DPNHB(L,NY,NX)-DLYR(3,L,NY,NX)) + WDNHB(L+1,NY,NX)=WDNHB(L,NY,NX) + DPNHB(L,NY,NX)=DLYR(3,L,NY,NX) + ELSEIF(DPNHB(L,NY,NX).LT.0.0)THEN + DPNHB(L-1,NY,NX)=DPNHB(L-1,NY,NX)+DPNHB(L,NY,NX) + DPNHB(L,NY,NX)=0.0 + WDNHB(L,NY,NX)=0.0 + ENDIF + ENDIF +C +C FRACTION OF SOIL LAYER OCCUPIED BY NH4 BAND +C FROM BAND WIDTH X DEPTH +C + XVLNH4=VLNH4(L,NY,NX) + VLNHB(L,NY,NX)=AMIN1(0.999,WDNHB(L,NY,NX)/ROWN(NY,NX) + 2*DPNHB(L,NY,NX)/DLYR(3,L,NY,NX)) + VLNH4(L,NY,NX)=1.0-VLNHB(L,NY,NX) + FVLNH4=AMIN1(0.0,(VLNH4(L,NY,NX)-XVLNH4)/XVLNH4) +C +C TRANSFER NH4, NH3 FROM NON-BAND TO BAND +C DURING BAND GROWTH +C + DNH4S=FVLNH4*ZNH4S(L,NY,NX)/14.0 + DNH3S=FVLNH4*ZNH3S(L,NY,NX)/14.0 + DXNH4=FVLNH4*XN4(L,NY,NX) + TRN4S(L,NY,NX)=TRN4S(L,NY,NX)+DNH4S + TRN4B(L,NY,NX)=TRN4B(L,NY,NX)-DNH4S + TRN3S(L,NY,NX)=TRN3S(L,NY,NX)+DNH3S + TRN3B(L,NY,NX)=TRN3B(L,NY,NX)-DNH3S + TRXN4(L,NY,NX)=TRXN4(L,NY,NX)+DXNH4 + TRXNB(L,NY,NX)=TRXNB(L,NY,NX)-DXNH4 + ELSE +C +C AMALGAMATE NH4 BAND WITH NON-BAND +C + DPNHB(L,NY,NX)=0.0 + WDNHB(L,NY,NX)=0.0 + VLNH4(L,NY,NX)=1.0 + VLNHB(L,NY,NX)=0.0 + ZNH4S(L,NY,NX)=ZNH4S(L,NY,NX)+ZNH4B(L,NY,NX) + ZNH3S(L,NY,NX)=ZNH3S(L,NY,NX)+ZNH3B(L,NY,NX) + ZNH4B(L,NY,NX)=0.0 + ZNH3B(L,NY,NX)=0.0 + XN4(L,NY,NX)=XN4(L,NY,NX)+XNB(L,NY,NX) + XNB(L,NY,NX)=0.0 + ENDIF + ENDIF +C +C NO3 FERTILIZER BAND +C + IF(IFNOB(NY,NX).EQ.1.AND.ROWO(NY,NX).GT.0.0)THEN + IF(L.EQ.NU(NY,NX).OR.CDPTH(L-1,NY,NX).LT.DPNO3(NY,NX))THEN +C +C NO3 BAND WIDTH +C + DWNO3=0.5*SQRT(ZOSGL(L,NY,NX))*TORT(NPH,L,NY,NX) + WDNOB(L,NY,NX)=AMIN1(ROWO(NY,NX),WDNOB(L,NY,NX)+DWNO3) +C +C NO3 BAND DEPTH +C + IF(CDPTH(L,NY,NX).GE.DPNO3(NY,NX))THEN + DPFLW=FLWD+DWNO3 + DPNO3(NY,NX)=DPNO3(NY,NX)+DPFLW + DPNOB(L,NY,NX)=DPNOB(L,NY,NX)+DPFLW + IF(DPNOB(L,NY,NX).GT.DLYR(3,L,NY,NX))THEN + DPNOB(L+1,NY,NX)=DPNOB(L+1,NY,NX)+(DPNOB(L,NY,NX)-DLYR(3,L,NY,NX)) + WDNOB(L+1,NY,NX)=WDNOB(L,NY,NX) + DPNOB(L,NY,NX)=DLYR(3,L,NY,NX) + ELSE IF(DPNOB(L,NY,NX).LT.0.0)THEN + DPNOB(L-1,NY,NX)=DPNOB(L-1,NY,NX)+DPNOB(L,NY,NX) + DPNOB(L,NY,NX)=0.0 + WDNOB(L,NY,NX)=0.0 + ENDIF + ENDIF +C +C FRACTION OF SOIL LAYER OCCUPIED BY NO3 BAND +C FROM BAND WIDTH X DEPTH +C + XVLNO3=VLNO3(L,NY,NX) + VLNOB(L,NY,NX)=AMIN1(0.999,WDNOB(L,NY,NX)/ROWO(NY,NX) + 2*DPNOB(L,NY,NX)/DLYR(3,L,NY,NX)) + VLNO3(L,NY,NX)=1.0-VLNOB(L,NY,NX) + FVLNO3=AMIN1(0.0,(VLNO3(L,NY,NX)-XVLNO3)/XVLNO3) +C +C TRANSFER NO3 FROM NON-BAND TO BAND +C DURING BAND GROWTH +C + DNO3S=FVLNO3*ZNO3S(L,NY,NX)/14.0 + DNO2S=FVLNO3*ZNO2S(L,NY,NX)/14.0 + TRNO3(L,NY,NX)=TRNO3(L,NY,NX)+DNO3S + TRNO2(L,NY,NX)=TRNO2(L,NY,NX)+DNO2S + TRNOB(L,NY,NX)=TRNOB(L,NY,NX)-DNO3S + TRN2B(L,NY,NX)=TRN2B(L,NY,NX)-DNO2S + ELSE +C +C AMALGAMATE NO3 BAND WITH NON-BAND +C + DPNOB(L,NY,NX)=0.0 + WDNOB(L,NY,NX)=0.0 + VLNO3(L,NY,NX)=1.0 + VLNOB(L,NY,NX)=0.0 + ZNO3S(L,NY,NX)=ZNO3S(L,NY,NX)+ZNO3B(L,NY,NX) + ZNO2S(L,NY,NX)=ZNO2S(L,NY,NX)+ZNO2B(L,NY,NX) + ZNO3B(L,NY,NX)=0.0 + ZNO2B(L,NY,NX)=0.0 + ENDIF + ENDIF +C +C PO4 FERTILIZER BAND +C + IF(IFPOB(NY,NX).EQ.1.AND.ROWP(NY,NX).GT.0.0)THEN + IF(L.EQ.NU(NY,NX).OR.CDPTH(L-1,NY,NX).LT.DPPO4(NY,NX))THEN +C +C PO4 BAND WIDTH +C + DWPO4=0.5*SQRT(POSGL(L,NY,NX))*TORT(NPH,L,NY,NX) + WDPOB(L,NY,NX)=AMIN1(ROWP(NY,NX),WDPOB(L,NY,NX)+DWPO4) +C +C PO4 BAND DEPTH +C + IF(CDPTH(L,NY,NX).GE.DPPO4(NY,NX))THEN + DPFLW=FLWD+DWPO4 + DPPO4(NY,NX)=DPPO4(NY,NX)+DPFLW + DPPOB(L,NY,NX)=DPPOB(L,NY,NX)+DPFLW + IF(DPPOB(L,NY,NX).GT.DLYR(3,L,NY,NX))THEN + DPPOB(L+1,NY,NX)=DPPOB(L+1,NY,NX)+(DPPOB(L,NY,NX)-DLYR(3,L,NY,NX)) + WDPOB(L+1,NY,NX)=WDPOB(L,NY,NX) + DPPOB(L,NY,NX)=DLYR(3,L,NY,NX) + ELSE IF(DPPOB(L,NY,NX).LT.0.0)THEN + DPPOB(L-1,NY,NX)=DPPOB(L-1,NY,NX)+DPPOB(L,NY,NX) + DPPOB(L,NY,NX)=0.0 + WDPOB(L,NY,NX)=0.0 + ENDIF + ENDIF +C +C FRACTION OF SOIL LAYER OCCUPIED BY PO4 BAND +C FROM BAND WIDTH X DEPTH +C + XVLPO4=VLPO4(L,NY,NX) + VLPOB(L,NY,NX)=AMIN1(0.999,WDPOB(L,NY,NX)/ROWP(NY,NX) + 2*DPPOB(L,NY,NX)/DLYR(3,L,NY,NX)) + VLPO4(L,NY,NX)=1.0-VLPOB(L,NY,NX) + FVLPO4=AMIN1(0.0,(VLPO4(L,NY,NX)-XVLPO4)/XVLPO4) +C +C TRANSFER NO3 FROM NON-BAND TO BAND +C DURING BAND GROWTH DEPENDING ON SALT +C VS. NON-SALT OPTION +C + IF(ISALT(NY,NX).NE.0)THEN + DZH0P=FVLPO4*H0PO4(L,NY,NX) + DZH1P=FVLPO4*H1PO4(L,NY,NX)/31.0 + DZH2P=FVLPO4*H2PO4(L,NY,NX)/31.0 + DZH3P=FVLPO4*H3PO4(L,NY,NX) + DZF1P=FVLPO4*ZFE1P(L,NY,NX) + DZF2P=FVLPO4*ZFE2P(L,NY,NX) + DZC0P=FVLPO4*ZCA0P(L,NY,NX) + DZC1P=FVLPO4*ZCA1P(L,NY,NX) + DZC2P=FVLPO4*ZCA2P(L,NY,NX) + DZM1P=FVLPO4*ZMG1P(L,NY,NX) + DXOH0=FVLPO4*XOH0(L,NY,NX) + DXOH1=FVLPO4*XOH1(L,NY,NX) + DXOH2=FVLPO4*XOH2(L,NY,NX) + DXH1P=FVLPO4*XH1P(L,NY,NX) + DXH2P=FVLPO4*XH2P(L,NY,NX) + DPALP=FVLPO4*PALPO(L,NY,NX) + DPFEP=FVLPO4*PFEPO(L,NY,NX) + DPCDP=FVLPO4*PCAPD(L,NY,NX) + DPCHP=FVLPO4*PCAPH(L,NY,NX) + DPCMP=FVLPO4*PCAPM(L,NY,NX) + TRH0P(L,NY,NX)=TRH0P(L,NY,NX)+DZH0P + TRH1P(L,NY,NX)=TRH1P(L,NY,NX)+DZH1P + TRH2P(L,NY,NX)=TRH2P(L,NY,NX)+DZH2P + TRH3P(L,NY,NX)=TRH3P(L,NY,NX)+DZH3P + TRF1P(L,NY,NX)=TRF1P(L,NY,NX)+DZF1P + TRF2P(L,NY,NX)=TRF2P(L,NY,NX)+DZF2P + TRC0P(L,NY,NX)=TRC0P(L,NY,NX)+DZC0P + TRC1P(L,NY,NX)=TRC1P(L,NY,NX)+DZC1P + TRC2P(L,NY,NX)=TRC2P(L,NY,NX)+DZC2P + TRM1P(L,NY,NX)=TRM1P(L,NY,NX)+DZM1P + TRH0B(L,NY,NX)=TRH0B(L,NY,NX)-DZH0P + TRH1B(L,NY,NX)=TRH1B(L,NY,NX)-DZH1P + TRH2B(L,NY,NX)=TRH2B(L,NY,NX)-DZH2P + TRH3B(L,NY,NX)=TRH3B(L,NY,NX)-DZH3P + TRF1B(L,NY,NX)=TRF1B(L,NY,NX)-DZF1P + TRF2B(L,NY,NX)=TRF2B(L,NY,NX)-DZF2P + TRC0B(L,NY,NX)=TRC0B(L,NY,NX)-DZC0P + TRC1B(L,NY,NX)=TRC1B(L,NY,NX)-DZC1P + TRC2B(L,NY,NX)=TRC2B(L,NY,NX)-DZC2P + TRM1B(L,NY,NX)=TRM1B(L,NY,NX)-DZM1P + TRXH0(L,NY,NX)=TRXH0(L,NY,NX)+DXOH0 + TRXH1(L,NY,NX)=TRXH1(L,NY,NX)+DXOH1 + TRXH2(L,NY,NX)=TRXH2(L,NY,NX)+DXOH2 + TRX1P(L,NY,NX)=TRX1P(L,NY,NX)+DXH1P + TRX2P(L,NY,NX)=TRX2P(L,NY,NX)+DXH2P + TRBH0(L,NY,NX)=TRBH0(L,NY,NX)-DXOH0 + TRBH1(L,NY,NX)=TRBH1(L,NY,NX)-DXOH1 + TRBH2(L,NY,NX)=TRBH2(L,NY,NX)-DXOH2 + TRB1P(L,NY,NX)=TRB1P(L,NY,NX)-DXH1P + TRB2P(L,NY,NX)=TRB2P(L,NY,NX)-DXH2P + TRALPO(L,NY,NX)=TRALPO(L,NY,NX)+DPALP + TRFEPO(L,NY,NX)=TRFEPO(L,NY,NX)+DPFEP + TRCAPD(L,NY,NX)=TRCAPD(L,NY,NX)+DPCDP + TRCAPH(L,NY,NX)=TRCAPH(L,NY,NX)+DPCHP + TRCAPM(L,NY,NX)=TRCAPM(L,NY,NX)+DPCMP + TRALPB(L,NY,NX)=TRALPB(L,NY,NX)-DPALP + TRFEPB(L,NY,NX)=TRFEPB(L,NY,NX)-DPFEP + TRCPDB(L,NY,NX)=TRCPDB(L,NY,NX)-DPCDP + TRCPHB(L,NY,NX)=TRCPHB(L,NY,NX)-DPCHP + TRCPMB(L,NY,NX)=TRCPMB(L,NY,NX)-DPCMP + ELSE + DZH1P=FVLPO4*H1PO4(L,NY,NX)/31.0 + DZH2P=FVLPO4*H2PO4(L,NY,NX)/31.0 + DXOH1=FVLPO4*XOH1(L,NY,NX) + DXOH2=FVLPO4*XOH2(L,NY,NX) + DXH2P=FVLPO4*XH2P(L,NY,NX) + DPALP=FVLPO4*PALPO(L,NY,NX) + DPFEP=FVLPO4*PFEPO(L,NY,NX) + DPCDP=FVLPO4*PCAPD(L,NY,NX) + DPCHP=FVLPO4*PCAPH(L,NY,NX) + DPCMP=FVLPO4*PCAPM(L,NY,NX) + TRH1P(L,NY,NX)=TRH1P(L,NY,NX)+DZH1P + TRH2P(L,NY,NX)=TRH2P(L,NY,NX)+DZH2P + TRXH1(L,NY,NX)=TRXH1(L,NY,NX)+DXOH1 + TRXH2(L,NY,NX)=TRXH2(L,NY,NX)+DXOH2 + TRX2P(L,NY,NX)=TRX2P(L,NY,NX)+DXH2P + TRH1B(L,NY,NX)=TRH1B(L,NY,NX)-DZH1P + TRH2B(L,NY,NX)=TRH2B(L,NY,NX)-DZH2P + TRBH1(L,NY,NX)=TRBH1(L,NY,NX)-DXOH1 + TRBH2(L,NY,NX)=TRBH2(L,NY,NX)-DXOH2 + TRB2P(L,NY,NX)=TRB2P(L,NY,NX)-DXH2P + TRALPO(L,NY,NX)=TRALPO(L,NY,NX)+DPALP + TRFEPO(L,NY,NX)=TRFEPO(L,NY,NX)+DPFEP + TRCAPD(L,NY,NX)=TRCAPD(L,NY,NX)+DPCDP + TRCAPH(L,NY,NX)=TRCAPH(L,NY,NX)+DPCHP + TRCAPM(L,NY,NX)=TRCAPM(L,NY,NX)+DPCMP + TRALPB(L,NY,NX)=TRALPB(L,NY,NX)-DPALP + TRFEPB(L,NY,NX)=TRFEPB(L,NY,NX)-DPFEP + TRCPDB(L,NY,NX)=TRCPDB(L,NY,NX)-DPCDP + TRCPHB(L,NY,NX)=TRCPHB(L,NY,NX)-DPCHP + TRCPMB(L,NY,NX)=TRCPMB(L,NY,NX)-DPCMP + ENDIF + ELSE +C +C AMALGAMATE PO4 BAND WITH NON-BAND +C + DPPOB(L,NY,NX)=0.0 + WDPOB(L,NY,NX)=0.0 + VLPOB(L,NY,NX)=0.0 + VLPO4(L,NY,NX)=1.0 + H0PO4(L,NY,NX)=H0PO4(L,NY,NX)+H0POB(L,NY,NX) + H1PO4(L,NY,NX)=H1PO4(L,NY,NX)+H1POB(L,NY,NX) + H2PO4(L,NY,NX)=H2PO4(L,NY,NX)+H2POB(L,NY,NX) + H3PO4(L,NY,NX)=H3PO4(L,NY,NX)+H3POB(L,NY,NX) + ZFE1P(L,NY,NX)=ZFE1P(L,NY,NX)+ZFE1PB(L,NY,NX) + ZFE2P(L,NY,NX)=ZFE2P(L,NY,NX)+ZFE2PB(L,NY,NX) + ZCA0P(L,NY,NX)=ZCA0P(L,NY,NX)+ZCA0PB(L,NY,NX) + ZCA1P(L,NY,NX)=ZCA1P(L,NY,NX)+ZCA1PB(L,NY,NX) + ZCA2P(L,NY,NX)=ZCA2P(L,NY,NX)+ZCA2PB(L,NY,NX) + ZMG1P(L,NY,NX)=ZMG1P(L,NY,NX)+ZMG1PB(L,NY,NX) + H0POB(L,NY,NX)=0.0 + H1POB(L,NY,NX)=0.0 + H2POB(L,NY,NX)=0.0 + H3POB(L,NY,NX)=0.0 + ZFE1PB(L,NY,NX)=0.0 + ZFE2PB(L,NY,NX)=0.0 + ZCA0PB(L,NY,NX)=0.0 + ZCA1PB(L,NY,NX)=0.0 + ZCA2PB(L,NY,NX)=0.0 + ZMG1PB(L,NY,NX)=0.0 + XOH0(L,NY,NX)=XOH0(L,NY,NX)+XOH0B(L,NY,NX) + XOH1(L,NY,NX)=XOH1(L,NY,NX)+XOH1B(L,NY,NX) + XOH2(L,NY,NX)=XOH2(L,NY,NX)+XOH2B(L,NY,NX) + XH1P(L,NY,NX)=XH1P(L,NY,NX)+XH1PB(L,NY,NX) + XH2P(L,NY,NX)=XH2P(L,NY,NX)+XH2PB(L,NY,NX) + XOH0B(L,NY,NX)=0.0 + XOH1B(L,NY,NX)=0.0 + XOH2B(L,NY,NX)=0.0 + XH1PB(L,NY,NX)=0.0 + XH2PB(L,NY,NX)=0.0 + PALPO(L,NY,NX)=PALPO(L,NY,NX)+PALPB(L,NY,NX) + PFEPO(L,NY,NX)=PFEPO(L,NY,NX)+PFEPB(L,NY,NX) + PCAPD(L,NY,NX)=PCAPD(L,NY,NX)+PCPDB(L,NY,NX) + PCAPH(L,NY,NX)=PCAPH(L,NY,NX)+PCPHB(L,NY,NX) + PCAPM(L,NY,NX)=PCAPM(L,NY,NX)+PCPMB(L,NY,NX) + PALPB(L,NY,NX)=0.0 + PFEPB(L,NY,NX)=0.0 + PCPDB(L,NY,NX)=0.0 + PCPHB(L,NY,NX)=0.0 + PCPMB(L,NY,NX)=0.0 + ENDIF + ENDIF +C ENDIF +C +C SUBTRACT FERTILIZER DISSOLUTION FROM FERTILIZER POOLS +C + ZNH4FA(L,NY,NX)=ZNH4FA(L,NY,NX)-RSN4AA-RSN4BA + ZNH3FA(L,NY,NX)=ZNH3FA(L,NY,NX)-RSN3AA-RSN3BA + ZNHUFA(L,NY,NX)=ZNHUFA(L,NY,NX)-RSNUAA-RSNUBA + ZNO3FA(L,NY,NX)=ZNO3FA(L,NY,NX)-RSNOAA-RSNOBA + ZNH4FB(L,NY,NX)=ZNH4FB(L,NY,NX)-RSN4BB + ZNH3FB(L,NY,NX)=ZNH3FB(L,NY,NX)-RSN3BB + ZNHUFB(L,NY,NX)=ZNHUFB(L,NY,NX)-RSNUBB + ZNO3FB(L,NY,NX)=ZNO3FB(L,NY,NX)-RSNOBB +C +C ADD FERTILIZER DISSOLUTION TO ION FLUXES +C + TRN3G(L,NY,NX)=TRN3G(L,NY,NX)+RSN3AA+RSN3BA+RSN3BB + TRN4S(L,NY,NX)=TRN4S(L,NY,NX)+RSN4AA + TRN4B(L,NY,NX)=TRN4B(L,NY,NX)+RSN4BA+RSN4BB + TRN3S(L,NY,NX)=TRN3S(L,NY,NX)+RSNUAA + TRN3B(L,NY,NX)=TRN3B(L,NY,NX)+RSNUBA+RSNUBB + TRNO3(L,NY,NX)=TRNO3(L,NY,NX)+RSNOAA + TRNOB(L,NY,NX)=TRNOB(L,NY,NX)+RSNOBA+RSNOBB + TRN3G(L,NY,NX)=TRN3G(L,NY,NX)*14.0 + TRN4S(L,NY,NX)=TRN4S(L,NY,NX)*14.0 + TRN4B(L,NY,NX)=TRN4B(L,NY,NX)*14.0 + TRN3S(L,NY,NX)=TRN3S(L,NY,NX)*14.0 + TRN3B(L,NY,NX)=TRN3B(L,NY,NX)*14.0 + TRNO3(L,NY,NX)=TRNO3(L,NY,NX)*14.0 + TRNOB(L,NY,NX)=TRNOB(L,NY,NX)*14.0 + TRNO2(L,NY,NX)=TRNO2(L,NY,NX)*14.0 + TRN2B(L,NY,NX)=TRN2B(L,NY,NX)*14.0 + TRH1P(L,NY,NX)=TRH1P(L,NY,NX)*31.0 + TRH2P(L,NY,NX)=TRH2P(L,NY,NX)*31.0 + TRH1B(L,NY,NX)=TRH1B(L,NY,NX)*31.0 + TRH2B(L,NY,NX)=TRH2B(L,NY,NX)*31.0 +C IF(L.EQ.1)THEN +C WRITE(20,9984)'TRN3S',I,J,L,TRN3S(L,NY,NX),TRN3B(L,NY,NX) +C 2,RSNUAA,RSNUBA,RSNUBB +9984 FORMAT(A8,3I4,20F14.7) +C ENDIF + ENDIF +9985 CONTINUE +C +C SURFACE RESIDUE +C + IF(VOLWM(NPH,0,NY,NX).GT.ZEROS(NY,NX))THEN + IF(BKVL(0,NY,NX).GT.ZEROS(NY,NX))THEN + BKVLX=BKVL(0,NY,NX) + ELSE + BKVLX=VOLWM(NPH,0,NY,NX) + ENDIF +C +C UREA HYDROLYSIS IN SURFACE RESIDUE +C + IF(VOLQ(0,NY,NX).GT.ZEROS(NY,NX))THEN + COMA=AMIN1(0.1E+06,TOQCK(0,NY,NX)/VOLQ(0,NY,NX)) + ELSE + COMA=0.1E+06 + ENDIF + DUKD=DUKM*(1.0+COMA/DUKI) +C +C UREA HYDROLYSIS INHIBITION +C + IF(ZNHU0(0,NY,NX).GT.ZEROS(NY,NX) + 2.AND.ZNHUI(0,NY,NX).GT.ZEROS(NY,NX))THEN + ZNHUI(0,NY,NX)=ZNHUI(0,NY,NX)-TFNQ(0,NY,NX)**0.25 + 2*RNHUI(IUTYP(NY,NX))*ZNHUI(0,NY,NX) + 3*AMAX1(RNHUI(IUTYP(NY,NX)),1.0-ZNHUI(0,NY,NX)/ZNHU0(0,NY,NX)) + ELSE + ZNHUI(0,NY,NX)=0.0 + ENDIF +C +C UREA CONCENTRATION AND HYDROLYSIS IN SURFACE RESIDUE +C + IF(ZNHUFA(0,NY,NX).GT.ZEROS(NY,NX) + 2.AND.BKVL(0,NY,NX).GT.ZEROS(NY,NX))THEN + CNHUA=ZNHUFA(0,NY,NX)/BKVL(0,NY,NX) + DFNSA=CNHUA/(CNHUA+DUKD) + RSNUA=AMIN1(ZNHUFA(0,NY,NX) + 2,SPNHU*TOQCK(0,NY,NX)*DFNSA*TFNQ(0,NY,NX))*(1.0-ZNHUI(0,NY,NX)) + ELSE + RSNUA=0.0 + ENDIF +C IF(J.EQ.13)THEN +C WRITE(*,8778)'UREA0',I,J,IUTYP(NY,NX) +C 2,ZNHUFA(0,NY,NX),RSNUA +C 2,DFNSA,TFNQ(0,NY,NX),CNHUA,DUKD,DUKM,DUKI,TOQCK(0,NY,NX) +C 3,BKVL(0,NY,NX),TFNQ(0,NY,NX),SPNHU,ZNHU0(0,NY,NX),ZNHUI(0,NY,NX) +C 4,RNHUI(IUTYP(NY,NX)) +8778 FORMAT(A8,3I4,40E12.4) +C ENDIF +C +C NH4, NH3, UREA, NO3 DISSOLUTION IN SURFACE RESIDUE +C FROM FIRST-ORDER FUNCTIONS OF REMAINING +C FERTILIZER (NOTE: SUPERPHOSPHATE AND ROCK PHOSPHATE +C ARE REPRESENTED AS MONOCALCIUM PHOSPHATE AND HYDROXYAPATITE +C MODELLED IN PHOSPHORUS REACTIONS BELOW) +C + RSN4AA=SPNH4*ZNH4FA(0,NY,NX)*THETW(0,NY,NX) + RSN3AA=SPNH3*ZNH3FA(0,NY,NX) + RSNUAA=RSNUA*THETW(0,NY,NX) + RSNOAA=SPNO3*ZNO3FA(0,NY,NX)*THETW(0,NY,NX) + IF(VOLWM(NPH,0,NY,NX).GT.ZEROS(NY,NX))THEN + VOLWMX=14.0*VOLWM(NPH,0,NY,NX) + RN4X=(XNH4S(0,NY,NX)+14.0*RSN4AA)/VOLWMX + RN3X=14.0*RSNUAA/VOLWMX + CN41=AMAX1(ZERO,ZNH4S(0,NY,NX)/VOLWMX+RN4X) + CN31=AMAX1(ZERO,ZNH3S(0,NY,NX)/VOLWMX+RN3X) + XN41=AMAX1(ZERO,XN4(0,NY,NX)/BKVLX) + VOLWMP=31.0*VOLWM(NPH,0,NY,NX) + RH1PX=XH1PS(0,NY,NX)/VOLWMP + RH2PX=XH2PS(0,NY,NX)/VOLWMP + CH1P1=AMAX1(0.0,H1PO4(0,NY,NX)/VOLWMP+RH1PX) + CH2P1=AMAX1(0.0,H2PO4(0,NY,NX)/VOLWMP+RH2PX) + ELSE + RN4X=0.0 + RN3X=0.0 + CN41=0.0 + CN31=0.0 + XN41=0.0 + RH1PX=0.0 + RH2PX=0.0 + CH1P1=0.0 + CH2P1=0.0 + ENDIF +C +C PHOSPHORUS TRANSFORMATIONS IN SURFACE RESIDUE +C + PCAPM1=AMAX1(0.0,PCAPM(0,NY,NX)/BKVLX) + PCAPD1=AMAX1(0.0,PCAPD(0,NY,NX)/BKVLX) + PCAPH1=AMAX1(0.0,PCAPH(0,NY,NX)/BKVLX) + PALPO1=AMAX1(0.0,PALPO(0,NY,NX)/BKVLX) + PFEPO1=AMAX1(0.0,PFEPO(0,NY,NX)/BKVLX) + CHY1=AMAX1(ZERO,10.0**(-(PH(0,NY,NX)-3.0))) + COH1=AMAX1(ZERO,DPH2O/CHY1) + CAL1=AMAX1(ZERO,SPALO/COH1**3) + CFE1=AMAX1(ZERO,SPFEO/COH1**3) + CCO20=AMAX1(ZERO,CCO2S(0,NY,NX)/12.0) + CCO31=AMAX1(ZERO,CCO20*DPCO3/CHY1**2) + CCA1=AMAX1(ZERO,AMIN1(CCAMX,SPCAC/CCO31)) +C +C ALUMINUM PHOSPHATE (VARISCITE) +C + CH2PA=SYA0P2/(CAL1*COH1**2) + RPALPX=AMIN1(AMAX1(0.0,4.0E-08*ORGC(0,NY,NX)-PALPO1) + 2,AMAX1(-PALPO1,TPD*(CH2P1-CH2PA))) +C +C IRON PHOSPHATE (STRENGITE) +C + CH2PF=SYF0P2/(CFE1*COH1**2) + RPFEPX=AMIN1(AMAX1(0.0,2.0E-06*ORGC(0,NY,NX)-PFEPO1) + 2,AMAX1(-PFEPO1,TPD*(CH2P1-CH2PF))) +C +C DICALCIUM PHOSPHATE +C + CH2PD=SYCAD2/(CCA1*COH1) + RPCADX=AMIN1(AMAX1(0-.0,5.0E-05*ORGC(0,NY,NX)-PCAPD1) + 2,AMAX1(-PCAPD1,TPD*(CH2P1-CH2PD))) +C +C HYDROXYAPATITE +C + CH2PH=(SYCAH2/(CCA1**5*COH1**7))**0.333 + RPCAHX=AMIN1(AMAX1(0.0,5.0E-05*ORGC(0,NY,NX)-PCAPH1) + 2,AMAX1(-PCAPH1,TPD*(CH2P1-CH2PH))) +C +C MONOCALCIUM PHOSPHATE +C + CH2PM=SQRT(SPCAM/CCA1) + RPCAMX=AMIN1(AMAX1(0.0,5.0E-05*ORGC(0,NY,NX)-PCAPM1) + 2,AMAX1(-PCAPM1*SPPO4,TPD*(CH2P1-CH2PM))) +C IF(I.GT.315)THEN +C WRITE(*,2227)'RPPO4',I,J,L,RPCAHX,CH2P1,CH2PA,CH2PH +C 2,SYA0P2,CAL1,COH1,SYCAH2,CCA1,CCO21,CCO31,PCAPH1 +C 3,VOLWM(NPH,0,NY,NX),SPCAC/CCO31,H2PO4(0,NY,NX) +C 4,CCO20,DPCO3,CHY1,CCO2S(0,NY,NX) +2227 FORMAT(A8,3I4,20E12.4) +C ENDIF +C +C PHOSPHORUS ANION EXCHANGE IN SURFACE REDISUE +C CALCULATED FROM EXCHANGE EQUILIBRIA AMONG H2PO4-, +C HPO4--, H+, OH- AND PROTONATED AND NON-PROTONATED -OH +C EXCHANGE SITES (NOT CALCULATED) + DP=DPH2P + S0=CH1P1+CHY1+DP + S1=AMAX1(0.0,S0**2-4.0*(CH1P1*CHY1-DP*CH2P1)) + RH2P=TSL*(S0-SQRT(S1)) +C +C EQUILIBRIUM X-CA CONCENTRATION FROM CEC AND CATION +C CONCENTRATIONS +C + IF(VOLWM(NPH,0,NY,NX).GT.ZEROS(NY,NX))THEN + CCEC0=AMAX1(0.0,COOH*ORGC(0,NY,NX)/BKVLX) + ELSE + CCEC0=0.0 + ENDIF + CALX=AMAX1(ZERO,CAL1)**0.333 + CFEX=AMAX1(ZERO,CFE1)**0.333 + CCAX=AMAX1(ZERO,CCA1)**0.500 + XCAX=CCEC0/(1.0+GKC4(NU(NY,NX),NY,NX)*CN41/CCAX + 2+GKCH(NU(NY,NX),NY,NX)*CHY1/CCAX + 3+GKCA(NU(NY,NX),NY,NX)*CALX/CCAX + 3+GKCA(NU(NY,NX),NY,NX)*CFEX/CCAX) + XN4Q=XCAX*CN41*GKC4(L,NY,NX) + XHYQ=XCAX*CHY1*GKCH(L,NY,NX) + XALQ=XCAX*CALX*GKCA(L,NY,NX) + XFEQ=XCAX*CFEX*GKCA(L,NY,NX) + XCAQ=XCAX*CCAX + XTLQ=XN4Q+XHYQ+XALQ+XFEQ+XCAQ + IF(XTLQ.GT.ZERO)THEN + FX=CCEC0/XTLQ + ELSE + FX=0.0 + ENDIF + XN4Q=FX*XN4Q +C +C NH4 AND NH3 EXCHANGE IN SURFACE RESIDUE +C + RXN4=TADC0*(XN4Q-XN41) + RNH4=(CHY1*CN31-DPN4*CN41)/(DPN4+CHY1) +C IF(J.EQ.12)THEN +C WRITE(20,2223)'RXN4',I,J,RXN4,CN41,XN41,CCAX,CCA1,CCO20,CCO31 +C 2,XCAQ,CCEC0,FN4X,FCAQ,GKC4(NU(NY,NX),NY,NX),PH(0,NY,NX),CHY1,RNH4 +C 3,CN31,DPN4,ZNH4S(0,NY,NX),XN4(0,NY,NX),14.0*RSN4AA,RN4X,BKVLX +C 4,BKVL(0,NY,NX),VOLWM(NPH,0,NY,NX) +2223 FORMAT(A8,2I4,30F14.7) +C ENDIF + ELSE + RSN4AA=0.0 + RSN3AA=0.0 + RSNUAA=0.0 + RSNOAA=0.0 + RPALPX=0.0 + RPFEPX=0.0 + RPCADX=0.0 + RPCAHX=0.0 + RPCAMX=0.0 + RXN4=0.0 + RNH4=0.0 + ENDIF +C +C TOTAL ION FLUXES FOR ALL REACTIONS ABOVE +C + RN4S=RNH4-RXN4 + RN3S=-RNH4 + RHP1=-RH2P + RHP2=RH2P-RPALPX-RPFEPX-RPCADX-2.0*RPCAMX-3.0*RPCAHX +C +C CONVERT TOTAL ION FLUXES FROM CHANGES IN CONCENTRATION +C TO CHANGES IN MASS PER UNIT AREA FOR USE IN 'REDIST' +C + TRN4S(0,NY,NX)=TRN4S(0,NY,NX)+RN4S*VOLWM(NPH,0,NY,NX) + TRN3S(0,NY,NX)=TRN3S(0,NY,NX)+RN3S*VOLWM(NPH,0,NY,NX) + TRH1P(0,NY,NX)=TRH1P(0,NY,NX)+RHP1*VOLWM(NPH,0,NY,NX) + TRH2P(0,NY,NX)=TRH2P(0,NY,NX)+RHP2*VOLWM(NPH,0,NY,NX) + TRXN4(0,NY,NX)=TRXN4(0,NY,NX)+RXN4*VOLWM(NPH,0,NY,NX) + TRALPO(0,NY,NX)=TRALPO(0,NY,NX)+RPALPX*VOLWM(NPH,0,NY,NX) + TRFEPO(0,NY,NX)=TRFEPO(0,NY,NX)+RPFEPX*VOLWM(NPH,0,NY,NX) + TRCAPD(0,NY,NX)=TRCAPD(0,NY,NX)+RPCADX*VOLWM(NPH,0,NY,NX) + TRCAPH(0,NY,NX)=TRCAPH(0,NY,NX)+RPCAHX*VOLWM(NPH,0,NY,NX) + TRCAPM(0,NY,NX)=TRCAPM(0,NY,NX)+RPCAMX*VOLWM(NPH,0,NY,NX) + ZNH4FA(0,NY,NX)=ZNH4FA(0,NY,NX)-RSN4AA + ZNH3FA(0,NY,NX)=ZNH3FA(0,NY,NX)-RSN3AA + ZNHUFA(0,NY,NX)=ZNHUFA(0,NY,NX)-RSNUAA + ZNO3FA(0,NY,NX)=ZNO3FA(0,NY,NX)-RSNOAA + TRN4S(0,NY,NX)=TRN4S(0,NY,NX)+RSN4AA + TRN3S(0,NY,NX)=TRN3S(0,NY,NX)+RSN3AA+RSNUAA + TRNO3(0,NY,NX)=TRNO3(0,NY,NX)+RSNOAA + TRN4S(0,NY,NX)=TRN4S(0,NY,NX)*14.0 + TRN3S(0,NY,NX)=TRN3S(0,NY,NX)*14.0 + TRNO3(0,NY,NX)=TRNO3(0,NY,NX)*14.0 + TRH1P(0,NY,NX)=TRH1P(0,NY,NX)*31.0 + TRH2P(0,NY,NX)=TRH2P(0,NY,NX)*31.0 +C WRITE(*,9989)'TRN4S',I,J,TRN4S(0,NY,NX) +C 2,RN4S,RNH4,RXN4,RSN4AA,VOLWM(NPH,0,NY,NX) +C 3,SPNH4,ZNH4FA(0,NY,NX) +C 4,THETW(0,NY,NX) +9989 FORMAT(A8,2I4,12E12.4) +9990 CONTINUE +9995 CONTINUE + RETURN + END + + diff --git a/f77src/starte.f b/f77src/starte.f index 3cfe7a6..ae30a65 100755 --- a/f77src/starte.f +++ b/f77src/starte.f @@ -27,23 +27,23 @@ 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,SYALO=4.0E-21,SYFEO=4.0E-26 - 2,SPCAC=4.0E-03,SPCAS=1.4E+01,SPALP=3.5E-15,SPFEP=3.0E-20 - 3,SPCAM=7.0E+07,SPCAD=1.0E-01,SPCAH=6.4E-32,SXOH2=4.5E-05 - 4,SXOH1=1.1E-06,SYH2P=1.6E+04,SHH2P=SYH2P*DPH2O,SYH1P=1.6E+04 - 5,SHH1P=SYH1P*DPH2O,DPCO2=4.2E-04,DPHCO=5.6E-08 - 6,DPN4=5.7E-07,DPAL1=8.6E-07,DPAL2=1.8E-08,DPAL3=2.0E-04 - 7,DPAL4=8.0E-03,DPALS=0.16,DPFE1=7.1E-10,DPFE2=1.45E-08 - 8,DPFE3=1.15E-04,DPFE4=1.45E-03,DPFES=7.1E-02,DPCAO=12.5 + 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 + 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 + 7,DPAL4=1.2E-05,DPALS=0.16,DPFE1=4.6E-07,DPFE2=7.3E-07 + 8,DPFE3=1.8E-05,DPFE4=1.2E-05,DPFES=7.1E-02,DPCAO=12.5 9,DPCAC=4.2E-02,DPCAH=13.5,DPCAS=1.2,DPMGO=0.7,DPMGC=0.3 1,DPMGH=67.0,DPMGS=2.1,DPNAC=0.45,DPNAS=3.3E+02,DPKAS=5.0E+01 2,DPH1P=4.5E-10,DPH2P=6.3E-05,DPH3P=7.1,DPF1P=4.5E-02 3,DPF2P=3.7E-03,DPC0P=3.5E-04,DPC1P=1.82,DPC2P=40.0 - 4,DPM1P=1.23,DPCOH=1.0E-02,DPALO=6.3E+04) - PARAMETER (DPCO3=DPCO2*DPHCO,SHALO=SYALO/DPH2O**3 - 2,SYAL1=SYALO/DPAL1,SHAL1=SYAL1/DPH2O**2,SYAL2=SYAL1/DPAL2 + 4,DPM1P=1.23,DPCOH=1.0E-02,DPALO=6.3E+04,DPFEO=6.3E+04) + PARAMETER (DPCO3=DPCO2*DPHCO,SHALO=SPALO/DPH2O**3 + 2,SYAL1=SPALO/DPAL1,SHAL1=SYAL1/DPH2O**2,SYAL2=SYAL1/DPAL2 3,SHAL2=SYAL2/DPH2O,SPAL3=SYAL2/DPAL3,SYAL4=SPAL3/DPAL4 - 4,SHAL4=SYAL4*DPH2O,SHFEO=SYFEO/DPH2O**3,SYFE1=SYFEO/DPFE1 + 4,SHAL4=SYAL4*DPH2O,SHFEO=SPFEO/DPH2O**3,SYFE1=SPFEO/DPFE1 5,SHFE1=SYFE1/DPH2O**2,SYFE2=SYFE1/DPFE2,SHFE2=SYFE2/DPH2O 6,SPFE3=SYFE2/DPFE3,SYFE4=SPFE3/DPFE4,SHFE4=SYFE4*DPH2O 7,SHCAC1=SPCAC/DPHCO,SYCAC1=SHCAC1*DPH2O,SHCAC2=SHCAC1/DPCO2 @@ -63,8 +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=1.0E-03,TAD=1.0E-02,TSL=1.0,A0=1.0,AE=10.0 - 2,COOH=2.5E-02) + PARAMETER (TPD=0.01,TAD=0.01,TSL=0.01,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) @@ -81,9 +80,9 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) DO 1200 L=NU(NY,NX),NL(NY,NX) DO 2000 K=1,3 IF(K.EQ.1.AND.I.EQ.1.AND.L.EQ.1)THEN - PH1=PHR(NY,NX)-3.0 - AHY1=10.0**(-(PHR(NY,NX)-3.0)) - AOH1=DPH2O/AHY1 + PH1=PHR(NY,NX) + CHY1=10.0**(-(PHR(NY,NX)-3.0)) + COH1=DPH2O/CHY1 CN4Z=CN4R(NY,NX) CNOZ=CNOR(NY,NX) CPOZ=CPOR(NY,NX) @@ -96,9 +95,9 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) CSOZ=CSOR(NY,NX) CCLZ=CCLR(NY,NX) ELSEIF(K.EQ.2.AND.L.EQ.1)THEN - PH1=PHQ(I,NY,NX)-3.0 - AHY1=10.0**(-(PHQ(I,NY,NX)-3.0)) - AOH1=DPH2O/AHY1 + PH1=PHQ(I,NY,NX) + CHY1=10.0**(-(PHQ(I,NY,NX)-3.0)) + COH1=DPH2O/CHY1 CN4Z=CN4Q(I,NY,NX) CNOZ=CNOQ(I,NY,NX) CPOZ=CPOQ(I,NY,NX) @@ -111,8 +110,13 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) CSOZ=CSOQ(I,NY,NX) CCLZ=CCLQ(I,NY,NX) ELSEIF(K.EQ.3.AND.I.EQ.1.AND.DATA(20).EQ.'NO'.AND.IGO.EQ.0)THEN + IF(BKVL(L,NY,NX).GT.ZEROS(NY,NX))THEN + BKVLX=BKVL(L,NY,NX) + ELSE + BKVLX=VOLA(L,NY,NX) + ENDIF CN4X=CNH4(L,NY,NX) - CNOX=CNO3(L,NY,NX)*BKVL(L,NY,NX)/VOLA(L,NY,NX) + CNOX=CNO3(L,NY,NX) CPOX=CPO4(L,NY,NX) CALX=CAL(L,NY,NX) CFEX=CFE(L,NY,NX) @@ -132,9 +136,8 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) CCASOX=CCASO(L,NY,NX) XCEC(L,NY,NX)=AMAX1(CN4X,CEC(L,NY,NX))*BKVL(L,NY,NX) XAEC(L,NY,NX)=AMAX1(CPOX,AEC(L,NY,NX))*BKVL(L,NY,NX) - PH1=PH(L,NY,NX) - AHY1=10.0**(-(PH1-3.0)) - AOH1=DPH2O/AHY1 + CHY1=10.0**(-(PH(L,NY,NX)-3.0)) + COH1=DPH2O/CHY1 CN4Z=CN4X CNOZ=CNOX CPOZ=CPOX @@ -146,7 +149,6 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) CKAZ=CKAX CSOZ=CSOX CCLZ=CCLX - DCHG=0.0 ELSE GO TO 2000 ENDIF @@ -165,11 +167,9 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) C C INITIALIZE ION STRENGTH AND ACTIVITIES C - DO 3010 M=1,25 - CION1=ABS(3.0*(CC3-CA3)+2.0*(CC2-CA2)+CC1-CA1) - CION2=AMAX1(0.0,CC3+CA3+CC2+CA2+CC1+CA1+CN+CION1) - CSTR1=0.5E-03*(9.0*(CC3+CA3)+4.0*(CC2+CA2)+CC1+CA1+CION1) - CSTRZ=0.5E-03*(9.0*(CC3+CA3)+4.0*(CC2+CX2)+CC1+CX1+CION1) + CION2=AMAX1(0.0,CC3+CA3+CC2+CA2+CC1+CA1+CN) + CSTR1=0.5E-03*(9.0*(CC3+CA3)+4.0*(CC2+CA2)+CC1+CA1) + CSTRZ=0.5E-03*(9.0*(CC3+CA3)+4.0*(CC2+CX2)+CC1+CX1) CSTR2=SQRT(CSTR1) FSTR2=CSTR2/(1.0+CSTR2) FH2O=5.56E+04/(5.56E+04+CION2) @@ -182,17 +182,16 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) A2=1.0 A3=1.0 ENDIF - CHY1=AHY1/A1 - COH1=AOH1/A1 C C INITIALIZE GASES C - CCO2X=CCO2M*SCO2X/(EXP(ACO2X*CSTRZ))*EXP(0.843-0.0281*ATCA(NY,NX))*FH2O + CCO2X=CCO2M*SCO2X/(EXP(ACO2X*CSTRZ)) + 2*EXP(0.843-0.0281*ATCA(NY,NX))*FH2O CCO2Y=LOG(CCO2X) CCO2Z=ABS(CCO2Y) CCO21=CCO2X - FCO3=DPCO3*A0/(AHY1**2*A2) - FHCO=DPCO2*A0/(AHY1*A1) + FCO3=DPCO3*A0/(CHY1**2*A2) + FHCO=DPCO2*A0/(CHY1*A1) Z=ACO2X*(2.0E-03*FCO3+0.5E-03*FHCO) DO 3020 MM=1,25 R=(LOG(CCO21)+Z*CCO21-CCO2Y)/CCO2Z @@ -200,32 +199,36 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) CCO21=CCO21/SQRT(1.0+R) 3020 CONTINUE 3030 CONTINUE - CCH41=CCH4M*SCH4X/(EXP(ACH4X*CSTR1))*EXP(0.597-0.0199*ATCA(NY,NX))*FH2O - COXY1=COXYM*SOXYX/(EXP(AOXYX*CSTR1))*EXP(0.516-0.0172*ATCA(NY,NX))*FH2O - CZ2G1=CZ2GM*SN2GX/(EXP(AN2GX*CSTR1))*EXP(0.456-0.0152*ATCA(NY,NX))*FH2O - CZ2O1=CZ2OM*SN2OX/(EXP(AN2OX*CSTR1))*EXP(0.897-0.0299*ATCA(NY,NX))*FH2O - CCO31=CCO21*DPCO3*A0/(AHY1**2*A2) - CHCO31=CCO21*DPCO2*A0/(AHY1*A1) + CCH41=CCH4M*SCH4X/(EXP(ACH4X*CSTR1)) + 2*EXP(0.597-0.0199*ATCA(NY,NX))*FH2O + COXY1=COXYM*SOXYX/(EXP(AOXYX*CSTR1)) + 2*EXP(0.516-0.0172*ATCA(NY,NX))*FH2O + CZ2G1=CZ2GM*SN2GX/(EXP(AN2GX*CSTR1)) + 2*EXP(0.456-0.0152*ATCA(NY,NX))*FH2O + CZ2O1=CZ2OM*SN2OX/(EXP(AN2OX*CSTR1)) + 2*EXP(0.897-0.0299*ATCA(NY,NX))*FH2O + CCO31=CCO21*DPCO3*A0/(CHY1**2*A2) + CHCO31=CCO21*DPCO2*A0/(CHY1*A1) CNO1=CNOZ C C INITIALIZE ION PAIR EQUILIBRIA C IF(K.NE.3)THEN - CN41=CN4Z/(1.0+DPN4*A1/(AHY1*A0)) - CN31=CN41*DPN4*A1/(AHY1*A0) + CN41=CN4Z/(1.0+DPN4*A1/(CHY1*A0)) + CN31=CN41*DPN4*A1/(CHY1*A0) ELSE - CN41=0.0 - CN31=0.0 + CN41=ZERO + CN31=ZERO ENDIF IF(CALZ.LT.0.0)THEN - CAL1=AMIN1(1.0E+03,SYALO/(AOH1**3*A3)) + CAL1=AMIN1(1.0E+03,SPALO/(COH1**3*A3)) ELSE - CAL1=AMIN1(CALZ,SYALO/(AOH1**3*A3)) + CAL1=AMIN1(CALZ,SPALO/(COH1**3*A3)) ENDIF IF(CFEZ.LT.0.0)THEN - CFE1=AMIN1(1.0E+03,SYFEO/(AOH1**3*A3)) + CFE1=AMIN1(1.0E+03,SPFEO/(COH1**3*A3)) ELSE - CFE1=AMIN1(CFEZ,SYFEO/(AOH1**3*A3)) + CFE1=AMIN1(CFEZ,SPFEO/(COH1**3*A3)) ENDIF IF(CCAZ.LT.0.0)THEN CCA1=AMIN1(1.0E+03,SPCAC/(CCO31*A2**2)) @@ -237,21 +240,21 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) CKA1=CKAZ CSO41=CSOZ CCL1=CCLZ - CALO1=CAL1*AOH1*A3/(DPAL1*A2) - CALO2=CAL1*AOH1**2*A3/(DPAL1*DPAL2*A1) - CALO3=CAL1*AOH1**3*A3/(DPAL1*DPAL2*DPAL3*A0) - CALO4=CAL1*AOH1**4*A3/(DPAL1*DPAL2*DPAL3*DPAL4*A1) + CALO1=CAL1*COH1*A3/(DPAL1*A2) + CALO2=CAL1*COH1**2*A3/(DPAL1*DPAL2*A1) + CALO3=CAL1*COH1**3*A3/(DPAL1*DPAL2*DPAL3*A0) + CALO4=CAL1*COH1**4*A3/(DPAL1*DPAL2*DPAL3*DPAL4*A1) CALS1=0.0 - CFEO1=CFE1*AOH1*A3/(DPFE1*A2) - CFEO2=CFE1*AOH1**2*A3/(DPFE1*DPFE2*A1) - CFEO3=CFE1*AOH1**3*A3/(DPFE1*DPFE2*DPFE3*A0) - CFEO4=CFE1*AOH1**4*A3/(DPFE1*DPFE2*DPFE3*DPFE4*A1) + CFEO1=CFE1*COH1*A3/(DPFE1*A2) + CFEO2=CFE1*COH1**2*A3/(DPFE1*DPFE2*A1) + CFEO3=CFE1*COH1**3*A3/(DPFE1*DPFE2*DPFE3*A0) + CFEO4=CFE1*COH1**4*A3/(DPFE1*DPFE2*DPFE3*DPFE4*A1) CFES1=0.0 - CCAO1=CCA1*AOH1*A2/(DPCAO*A1) + CCAO1=CCA1*COH1*A2/(DPCAO*A1) CCAC1=CCA1*CCO31*A2**2/(DPCAC*A0) CCAH1=CCA1*CHCO31*A2/DPCAH CCAS1=0.0 - CMGO1=CMG1*AOH1*A2/(DPMGO*A1) + CMGO1=CMG1*COH1*A2/(DPMGO*A1) CMGC1=CMG1*CCO31*A2**2/(DPMGC*A0) CMGH1=CMG1*CHCO31*A2/DPMGH CMGS1=0.0 @@ -269,35 +272,33 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) C AND PRECIPITATED FORMS C IF(K.NE.3)THEN - CH3P1=CPOZ/(1.0+DPH3P*A0/(AHY1*A1)+DPH3P*DPH2P*A0 - 2/(AHY1**2*A2)+DPH3P*DPH2P*DPH1P*A0/(AHY1**3*A3)) - CH2P1=CH3P1*DPH3P*A0/(AHY1*A1) - CH1P1=CH3P1*DPH3P*DPH2P*A0/(AHY1**2*A2) - CH0P1=CH3P1*DPH3P*DPH2P*DPH1P*A0/(AHY1**3*A3) - ELSE - XHP=CPOZ*BKVL(L,NY,NX)/VOLA(L,NY,NX) - XOH=XAEC(L,NY,NX)/VOLA(L,NY,NX) - FHP3=1.0/(1.0+DPH3P*A0/(AHY1*A1)+DPH3P*DPH2P*A0 - 2/(AHY1**2*A2)+DPH3P*DPH2P*DPH1P*A0/(AHY1**3*A3)) - FHP2=FHP3*DPH3P*A0/(AHY1*A1) - FHP1=FHP3*DPH3P*DPH2P*A0/(AHY1**2*A2) - FHP0=FHP3*DPH3P*DPH2P*DPH1P*A0/(AHY1**3*A3) - AEP=EXP(AE*DCHG/TKS(L,NY,NX)) - AEN=EXP(-AE*DCHG/TKS(L,NY,NX)) - SPOH2=SXOH2*AEP/A1 - SPOH1=SXOH1/(AEN*A1) - SPH2P=SYH2P*DPH2O/(SXOH2*AEP*A1) - SPH1P=SYH1P*AEN*A1/A2 - FXH2=1.0/(1.0+SPOH2/AHY1+SPOH2*SPOH1/AHY1**2) - FXH1=FXH2*SPOH2/AHY1 - FXH0=FXH1*SPOH1/AHY1 - FXP2=1.0/(1.0+SYH2P*DPH2P/(SPH1P*AHY1)) - FXP1=FXP2*SYH2P*DPH2P/(SPH1P*AHY1) + CH3P1=CPOZ/(1.0+DPH3P*A0/(CHY1*A1)+DPH3P*DPH2P*A0 + 2/(CHY1**2*A2)+DPH3P*DPH2P*DPH1P*A0/(CHY1**3*A3)) + CH2P1=CH3P1*DPH3P*A0/(CHY1*A1) + CH1P1=CH3P1*DPH3P*DPH2P*A0/(CHY1**2*A2) + CH0P1=CH3P1*DPH3P*DPH2P*DPH1P*A0/(CHY1**3*A3) + ELSE + XHP=CPOZ + XOH=XAEC(L,NY,NX)/BKVLX + FHP3=1.0/(1.0+DPH3P*A0/(CHY1*A1)+DPH3P*DPH2P*A0 + 2/(CHY1**2*A2)+DPH3P*DPH2P*DPH1P*A0/(CHY1**3*A3)) + FHP2=FHP3*DPH3P*A0/(CHY1*A1) + FHP1=FHP3*DPH3P*DPH2P*A0/(CHY1**2*A2) + FHP0=FHP3*DPH3P*DPH2P*DPH1P*A0/(CHY1**3*A3) + SPOH2=SXOH2/A1 + SPOH1=SXOH1/A1 + SPH2P=SXH2P*DPH2O/A1 + SPH1P=SXH1P*DPH2O*A1/A2 + FXH2=1.0/(1.0+SPOH2/CHY1+SPOH2*SPOH1/CHY1**2) + FXH1=FXH2*SPOH2/CHY1 + FXH0=FXH1*SPOH1/CHY1 + FXP2=1.0/(1.0+SXH2P*DPH2P/(SXH1P*CHY1)) + FXP1=FXP2*SXH2P*DPH2P/(SXH1P*CHY1) FHPA=FHP2*A1 - XPT=(XOH+XHP+SYH2P*FXP2*AOH1/(FXH1*FHPA)-SQRT(XOH**2*FXH1**2 + XPT=(XOH+XHP+SXH2P*FXP2*COH1/(FXH1*FHPA)-SQRT(XOH**2*FXH1**2 2*FHPA**2-2.0*XOH*FXH1**2*XHP*FHPA**2+FXH1**2*XHP**2*FHPA**2 - 3+2.0*XOH*FXH1*FHPA*SYH2P*FXP2*AOH1+2.0*FXH1*XHP*FHPA*SYH2P - 4*FXP2*AOH1+SYH2P**2*FXP2**2*AOH1**2)/(FXH1*FHPA))/2.0 + 3+2.0*XOH*FXH1*FHPA*SXH2P*FXP2*COH1+2.0*FXH1*XHP*FHPA*SXH2P + 4*FXP2*COH1+SXH2P**2*FXP2**2*COH1**2)/(FXH1*FHPA))/2.0 XOH21=(XOH-XPT)*FXH2 XOH11=(XOH-XPT)*FXH1 XOH01=(XOH-XPT)*FXH0 @@ -307,22 +308,23 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) CH2P1=(XHP-XPT)*FHP2 CH1P1=(XHP-XPT)*FHP1 CH0P1=(XHP-XPT)*FHP0 - DCHG=0.25*(XOH21-XOH01-XH1P1)+0.75*DCHG C C INITIALIZE CATION EQILIBRIA BETWEEN SOLUBLE C AND EXCHANGEABLE FORMS C - XCECQ=XCEC(L,NY,NX)/VOLA(L,NY,NX) - XN4Q=CN4X*BKVL(L,NY,NX)/VOLA(L,NY,NX) + XCECQ=AMAX1(CN4X,CEC(L,NY,NX)) + XN4Q=CN4X XHYQ=0.0 XALQ=0.0 + XFEQ=0.0 XCAQ=0.0 XMGQ=0.0 XNAQ=0.0 XKAQ=0.0 XHC1=0.0 XALO21=0.0 - XCOOH=AMAX1(0.0,COOH*ORGC(L,NY,NX)/VOLA(L,NY,NX)) + XFEO21=0.0 + XCOOH=AMAX1(0.0,COOH*ORGC(L,NY,NX)) ENDIF CC3=CAL1+CFE1 CA3=CH0P1 @@ -336,59 +338,80 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) 2+CMGC1+CMGS1+CH3P1+CC1P1+CM1P1 CX2=CA2-CCO31 CX1=CA1-CHCO31 -3010 CONTINUE C C INITIALIZE EQUILIBRIA BETWEEN SOLUBLE AND PRECIPITATED FORMS C IF(K.EQ.3)THEN - IF(CALZ.GE.0.0)THEN - RPALOX=AMAX1(0.0,CALZ-(CAL1+CALO1+CALO2+CALO3+CALO4+CALS1)) - PALOH1=CALOHX*BKVL(L,NY,NX)/VOLA(L,NY,NX)+RPALOX - ELSE - PALOH1=CALOHX*BKVL(L,NY,NX)/VOLA(L,NY,NX) - ENDIF - IF(CFEZ.GE.0.0)THEN - RPFEOX=AMAX1(0.0,CFEZ-(CFE1+CFEO1+CFEO2+CFEO3+CFEO4+CFES1)) - PFEOH1=CFEOHX*BKVL(L,NY,NX)/VOLA(L,NY,NX)+RPFEOX - ELSE - PFEOH1=CFEOHX*BKVL(L,NY,NX)/VOLA(L,NY,NX) - ENDIF - IF(CCAZ.GE.0.0)THEN - RPCACX=AMAX1(0.0,CCAZ-(CCA1+CCAO1+CCAC1+CCAH1+CCAS1)) - PCACO1=CCACOX*BKVL(L,NY,NX)/VOLA(L,NY,NX)+RPCACX - ELSE - PCACO1=CCACOX*BKVL(L,NY,NX)/VOLA(L,NY,NX) - ENDIF - PCASO1=CCASOX*BKVL(L,NY,NX)/VOLA(L,NY,NX) - PALPO1=CALPOX*BKVL(L,NY,NX)/VOLA(L,NY,NX)*VLPO4(L,NY,NX) - PFEPO1=CFEPOX*BKVL(L,NY,NX)/VOLA(L,NY,NX)*VLPO4(L,NY,NX) - PCAPD1=CCAPDX*BKVL(L,NY,NX)/VOLA(L,NY,NX)*VLPO4(L,NY,NX) - PCAPH1=CCAPHX*BKVL(L,NY,NX)/VOLA(L,NY,NX)*VLPO4(L,NY,NX) - PALPOB=CALPOX*BKVL(L,NY,NX)/VOLA(L,NY,NX)*VLPOB(L,NY,NX) - PFEPOB=CFEPOX*BKVL(L,NY,NX)/VOLA(L,NY,NX)*VLPOB(L,NY,NX) - PCAPDB=CCAPDX*BKVL(L,NY,NX)/VOLA(L,NY,NX)*VLPOB(L,NY,NX) - PCAPHB=CCAPHX*BKVL(L,NY,NX)/VOLA(L,NY,NX)*VLPOB(L,NY,NX) + PALOH1=CALOHX + PFEOH1=CFEOHX + PCACO1=CCACOX + PCASO1=CCASOX + PALPO1=CALPOX*VLPO4(L,NY,NX) + PFEPO1=CFEPOX*VLPO4(L,NY,NX) + PCAPD1=CCAPDX*VLPO4(L,NY,NX) + PCAPH1=CCAPHX*VLPO4(L,NY,NX) + IF(BKVL(L,NY,NX).GT.ZEROS(NY,NX))THEN + BKVLX=BKVL(L,NY,NX) + ELSE + BKVLX=VOLW(L,NY,NX) + ENDIF + CCEC=AMAX1(ZERO,XCEC(L,NY,NX)/BKVLX) + CALX=CAL1**0.333 + CFEX=CFE1**0.333 + CCAX=CCA1**0.500 + CMGX=CMG1**0.500 + XCAX=CCEC/(1.0+GKC4(L,NY,NX)*CN41/CCAX + 3+GKCH(L,NY,NX)*CHY1/CCAX+GKCA(L,NY,NX)*CALX/CCAX + 4+GKCA(L,NY,NX)*CFEX/CCAX+GKCA(L,NY,NX)*CMG1/CCAX + 5+GKCN(L,NY,NX)*CNA1/CCAX+GKCK(L,NY,NX)*CKA1/CCAX) + XN4Q=CN4X + XHYQ=XCAX*GKCH(L,NY,NX) + XALQ=XCAX*GKCA(L,NY,NX) + XFEQ=XCAX*GKCA(L,NY,NX) + XCAQ=XCAX*CCAX + XMGQ=XCAX*GKCM(L,NY,NX) + XNAQ=XCAX*GKCN(L,NY,NX) + XKAQ=XCAX*GKCK(L,NY,NX) + XTLQ=XN4Q+XHYQ+XALQ+XFEQ+XCAQ+XMGQ+XNAQ+XKAQ + IF(XTLQ.GT.ZERO)THEN + FX=CCEC/XTLQ + ELSE + FX=0.0 + ENDIF + XN41=CN4X + XHY1=FX*XHYQ + XAL1=FX*XALQ/3.0 + XFE1=FX*XFEQ/3.0 + XCA1=FX*XCAQ/2.0 + XMG1=FX*XMGQ/2.0 + XNA1=FX*XNAQ + XKA1=FX*XKAQ +C WRITE(*,2222)'XN4S',K,L,CN4X,XN4Q,XN41,CNH4(L,NY,NX) +C 2,BKVL(L,NY,NX),XCECQ,XCEC(L,NY,NX),BKVLX,FX +C WRITE(*,2222)'XOH2S',K,L,XOH21,XOH11,XOH01,XH2P1,XH1P1,XOH,XPT +C 2,CH3P1,CH2P1,CH1P1,CH0P1,CHY1,XHP,FHP3,FHP2,FHP1,FHP0 +C 3,FXP2,FXP1,PALPO1,PFEPO1,PCAPD1,PCAPH1 +2222 FORMAT(A8,2I4,40E12.4) ENDIF C C CONVERGE TOWARDS ALL SOLUBILITY EQUILIBRIA C IF SALT OPTION IS SELECTED C IF(ISALT(NY,NX).NE.0)THEN - DO 1000 M=1,1 + DO 1000 M=1,100 + CCO21=AMAX1(ZERO,CCO21) + CCO31=CCO21*DPCO3*A0/(CHY1**2*A2) + CHCO31=CCO21*DPCO2*A0/(CHY1*A1) CN41=AMAX1(ZERO,CN41) CN31=AMAX1(ZERO,CN31) CAL1=AMAX1(ZERO,CAL1) CFE1=AMAX1(ZERO,CFE1) - CHY1=AHY1/A1 CCA1=AMAX1(ZERO,CCA1) + CCA1=AMIN1(CCA1,SPCAC/(CCO31*A2**2)) CMG1=AMAX1(ZERO,CMG1) CNA1=AMAX1(ZERO,CNA1) CKA1=AMAX1(ZERO,CKA1) - COH1=AOH1/A1 CSO41=AMAX1(ZERO,CSO41) - CCO21=AMAX1(ZERO,CCO21) - CCO31=AMAX1(ZERO,CCO31) - CHCO31=AMAX1(ZERO,CHCO31) CALO1=AMAX1(ZERO,CALO1) CALO2=AMAX1(ZERO,CALO2) CALO3=AMAX1(ZERO,CALO3) @@ -435,57 +458,20 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) 2+CMGC1+CMGS1+CH3P1+CC1P1+CM1P1 CX2=CA2-CCO31 CX1=CA1-CHCO31 - CION1=ABS(3.0*(CC3-CA3)+2.0*(CC2-CA2)+CC1-CA1) - CION2=AMAX1(0.0,CC3+CA3+CC2+CA2+CC1+CA1+CN+CION1) - CSTR1=0.5E-03*(9.0*(CC3+CA3)+4.0*(CC2+CA2)+CC1+CA1+CION1) - CSTRZ=0.5E-03*(9.0*(CC3+CA3)+4.0*(CC2+CX2)+CC1+CX1+CION1) + CION2=AMAX1(0.0,CC3+CA3+CC2+CA2+CC1+CA1+CN) + CSTR1=0.5E-03*(9.0*(CC3+CA3)+4.0*(CC2+CA2)+CC1+CA1) + CSTRZ=0.5E-03*(9.0*(CC3+CA3)+4.0*(CC2+CX2)+CC1+CX1) CSTR2=SQRT(CSTR1) FSTR2=CSTR2/(1.0+CSTR2) FH2O=5.56E+04/(5.56E+04+CION2) A1=AMIN1(1.0,10.0**(-0.509*1.0*FSTR2+0.20*CSTR2)) A2=AMIN1(1.0,10.0**(-0.509*4.0*FSTR2+0.20*CSTR2)) A3=AMIN1(1.0,10.0**(-0.509*9.0*FSTR2+0.20*CSTR2)) - A12=A1**2 - A13=A1**3 - A14=A1**4 - A22=A2**2 - A25=A2**5 - A28=A2**8 - A2Q=A2**0.500 - A3C=A3**0.333 - A0A2=A0*A2 - A0A12=A0/A12 - A0A22=A0/A22 - A0A1A2=A0*A12*A2 - A1A2=A1*A2 - A1A2D=A1/A2 - A1A3=A1*A3 - A1A3D=A1/A3 - A12A2=A12*A2 - A12A2D=A12/A2 - A12A22=A12/A22 - A12A25=A12/A25 - A12A28=A12/A28 - A1202D=A12/A0A2 - A13A2=A13*A2 - A13A3=A13*A3 - A13A3D=A13/A3 - A14A0=A14/A0 - A14A2=A14*A2 - A14A2D=A14/A2 - A14A0A=A14/A0A2 - A14A5D=A14/A25 - A14A28=A14*A28 - A14A8D=A14/A28 - A1TA25=A1**10*A25 - A2A3=A2*A3 - A2A13D=A2/A1A3 - A1A2A3=A1*A2A3 - A1A23D=A1/A2A3 -C -C PRECIPITATION-DISSOLUTION EQILIBRIA C - IF(K.EQ.3)THEN +C PRECIPITATION-DISSOLUTION EQUILIBRIA +C + AHY1=CHY1*A1 + AOH1=COH1*A1 AAL1=CAL1*A3 AALO1=CALO1*A2 AALO2=CALO2*A1 @@ -496,508 +482,295 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) AFEO2=CFEO2*A1 AFEO3=CFEO3 AFEO4=CFEO4*A1 + ACA1=CCA1*A2 ACO31=CCO31*A2 AHCO31=CHCO31*A1 ACO21=CCO21*A0 + ASO41=CSO41*A2 + AH0P1=CH0P1*A3 AH1P1=CH1P1*A2 AH2P1=CH2P1*A1 + AH3P1=CH3P1*A0 + AF1P1=CF1P1*A2 + AF2P1=CF2P1*A1 + AC0P1=CC0P1*A1 + AC1P1=CC1P1*A0 + AC2P1=CC2P1*A1 + AM1P1=CM1P1*A0 + AN41=CN41*A1 + AN31=CN31*A0 + AMG1=CMG1*A2 + ANA1=CNA1*A1 + AKA1=CKA1*A1 + AALX=AAL1**0.333 + AFEX=AFE1**0.333 + ACAX=ACA1**0.500 + AMGX=AMG1**0.500 + AALS1=CALS1*A1 + AFES1=CFES1*A1 + ACAO1=CCAO1*A1 + ACAC1=CCAC1*A0 + ACAS1=CCAS1*A0 + ACAH1=CCAH1*A1 + AMGO1=CMGO1*A1 + AMGC1=CMGC1*A0 + AMGH1=CMGH1*A1 + AMGS1=CMGS1*A0 + ANAC1=CNAC1*A1 + ANAS1=CNAS1*A1 + AKAS1=CKAS1*A1 C C ALUMINUM HYDROXIDE (GIBBSITE) C + IF(K.EQ.3)THEN PX=AMAX1(AAL1,AALO1,AALO2,AALO3,AALO4) IF(PX.EQ.AAL1)THEN - R2=CHY1 - P2=COH1 - P1=CAL1 - IF(AOH1.GT.AHY1)THEN - NR2=0 - NP2=3 - SP=SYALO/A13A3 - ELSE - NR2=3 + R1=AHY1 + P1=AAL1 + P2=AOH1 + NR1=3 NP2=0 - SP=SHALO*A13A3D - ENDIF + SP=SHALO ELSEIF(PX.EQ.AALO1)THEN - R2=CHY1 - P2=COH1 - P1=CALO1 - IF(AOH1.GT.AHY1)THEN - NR2=0 - NP2=2 - SP=SYAL1/A12A2 - ELSE - NR2=2 + R1=AHY1 + P1=AALO1 + P2=AOH1 + NR1=2 NP2=0 - SP=SHAL1*A12A2D - ENDIF + SP=SHAL1 ELSEIF(PX.EQ.AALO2)THEN - R2=CHY1 - P2=COH1 - P1=CALO2 - IF(AOH1.GT.AHY1)THEN - NR2=0 - NP2=1 - SP=SYAL2/A12 - ELSE - NR2=1 + R1=AHY1 + P1=AALO2 + P2=AOH1 + NR1=1 NP2=0 SP=SHAL2 - ENDIF ELSEIF(PX.EQ.AALO3)THEN - R2=CHY1 - P2=COH1 - P1=CALO3 - NR2=0 + R1=AHY1 + P1=AALO3 + P2=AOH1 + NR1=0 NP2=0 SP=SPAL3 ELSEIF(PX.EQ.AALO4)THEN - R2=COH1 - P2=CHY1 - P1=CALO4 - IF(AOH1.GT.AHY1)THEN - NR2=1 - NP2=0 - SP=SYAL4 - ELSE - NR2=0 + R1=AOH1 + P1=AALO4 + P2=AHY1 + NR1=0 NP2=1 - SP=SHAL4/A12 - ENDIF + SP=SHAL4 ENDIF - RYAL1=0.0 - RYALO1=0.0 - RYALO2=0.0 - RYALO3=0.0 - RYALO4=0.0 RHAL1=0.0 RHALO1=0.0 RHALO2=0.0 RHALO3=0.0 RHALO4=0.0 - X=0.0 - TX=0.0 - DO 1010 MM=1,100 - P1=AMAX1(ZERO,P1-X) - Z=(P1*P2**NP2/R2**NR2)/SP - IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 1110 - IF(Z.LE.0.95.AND.PALOH1.LE.0.0)GO TO 1110 - Y=P1 - IF(Z.GT.1.0)THEN - X=Y-Y/Z**0.50 - ELSE - X=Y*Z**0.50-Y - ENDIF - TX=TX+X -1010 CONTINUE -1110 CONTINUE - RPALOX=AMAX1(-PALOH1,TPD*TX) + R1=AMAX1(ZERO,R1) + P1=AMAX1(ZERO,P1) + P2=AMAX1(ZERO,P2) + SPX=SP*R1**NR1/P2**NP2 + RPALOX=AMAX1(-PALOH1,TPD*(P1-SPX)) IF(PX.EQ.AAL1)THEN - IF(AOH1.GT.AHY1)THEN - RYAL1=RPALOX - ELSE RHAL1=RPALOX - ENDIF ELSEIF(PX.EQ.AALO1)THEN - IF(AOH1.GT.AHY1)THEN - RYALO1=RPALOX - ELSE RHALO1=RPALOX - ENDIF ELSEIF(PX.EQ.AALO2)THEN - IF(AOH1.GT.AHY1)THEN - RYALO2=RPALOX - ELSE RHALO2=RPALOX - ENDIF ELSEIF(PX.EQ.AALO3)THEN - IF(AOH1.GT.AHY1)THEN - RYALO3=RPALOX - ELSE RHALO3=RPALOX - ENDIF ELSEIF(PX.EQ.AALO4)THEN - IF(AOH1.GT.AHY1)THEN - RYALO4=RPALOX - ELSE RHALO4=RPALOX ENDIF - ENDIF -C WRITE(*,1112)'GIBB',K,L,M,MM,PALOH1,CAL1,CALO1,CALO2,CALO3,CALO4 -C 2,COH1,R2,P1,P2,SP,Z,TX,RPALOX,RHAL1,RHALO1,RHALO2,RHALO3,RHALO4 -C 3,CAL1*A3*(COH1*A1)**3,SYALO +C IF((M/25)*25.EQ.M)THEN +C WRITE(*,1112)'ALOHI',I,L,K,M,PALOH1,AAL1,AALO1,AALO2,AALO3,AALO4 +C 2,AOH1,R1,P1,P2,SP,SPX,RPALOX,RHAL1,RHALO1,RHALO2,RHALO3,RHALO4 +C 3,AAL1*AOH1**3,SPALO,A1 +C ENDIF C C IRON HYDROXIDE C PX=AMAX1(AFE1,AFEO1,AFEO2,AFEO3,AFEO4) IF(PX.EQ.AFE1)THEN - R2=CHY1 - P2=COH1 - P1=CFE1 - IF(AOH1.GT.AHY1)THEN - NR2=0 - NP2=3 - SP=SYFEO/A13A3 - ELSE - NR2=3 + R1=AHY1 + P1=AFE1 + P2=AOH1 + NR1=3 NP2=0 - SP=SHFEO*A13A3D - ENDIF + SP=SHFEO ELSEIF(PX.EQ.AFEO1)THEN - R2=CHY1 - P2=COH1 - P1=CFEO1 - IF(AOH1.GT.AHY1)THEN - NR2=0 - NP2=2 - SP=SYFE1/A12A2 - ELSE - NR2=2 + R1=AHY1 + P1=AFEO1 + P2=AOH1 + NR1=2 NP2=0 - SP=SHFE1*A12A2D - ENDIF + SP=SHFE1 ELSEIF(PX.EQ.AFEO2)THEN - R2=CHY1 - P2=COH1 - P1=CFEO2 - IF(AOH1.GT.AHY1)THEN - NR2=0 - NP2=1 - SP=SYFE2/A12 - ELSE - NR2=1 + R1=AHY1 + P1=AFEO2 + P2=AOH1 + NR1=1 NP2=0 SP=SHFE2 - ENDIF ELSEIF(PX.EQ.AFEO3)THEN - R2=CHY1 - P2=COH1 - P1=CFEO3 - NR2=0 + R1=AHY1 + P1=AFEO3 + P2=AOH1 + NR1=0 NP2=0 SP=SPFE3 ELSEIF(PX.EQ.AFEO4)THEN - R2=COH1 - P2=CHY1 - P1=CFEO4 - IF(AOH1.GT.AHY1)THEN - NR2=1 - NP2=0 - SP=SYFE4 - ELSE - NR2=0 + R1=AOH1 + P1=AFEO4 + P2=AHY1 + NR1=0 NP2=1 - SP=SHFE4/A12 - ENDIF + SP=SHFE4 ENDIF - RYFE1=0.0 - RYFEO1=0.0 - RYFEO2=0.0 - RYFEO3=0.0 - RYFEO4=0.0 RHFE1=0.0 RHFEO1=0.0 RHFEO2=0.0 RHFEO3=0.0 RHFEO4=0.0 - X=0.0 - TX=0.0 - DO 1020 MM=1,100 - P1=AMAX1(ZERO,P1-X) - Z=(P1*P2**NP2/R2**NR2)/SP - IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 1120 - IF(Z.LE.0.95.AND.PFEOH1.LE.0.0)GO TO 1120 - Y=P1 - IF(Z.GT.1.0)THEN - X=Y-Y/Z**0.50 - ELSE - X=Y*Z**0.50-Y - ENDIF - TX=TX+X -1020 CONTINUE -1120 CONTINUE - RPFEOX=AMAX1(-PFEOH1,TPD*TX) + R1=AMAX1(ZERO,R1) + P1=AMAX1(ZERO,P1) + P2=AMAX1(ZERO,P2) + SPX=SP*R1**NR1/P2**NP2 + RPFEOX=AMAX1(-PFEOH1,TPD*(P1-SPX)) IF(PX.EQ.AFE1)THEN - IF(AOH1.GT.AHY1)THEN - RYFE1=RPFEOX - ELSE RHFE1=RPFEOX - ENDIF ELSEIF(PX.EQ.AFEO1)THEN - IF(AOH1.GT.AHY1)THEN - RYFEO1=RPFEOX - ELSE RHFEO1=RPFEOX - ENDIF ELSEIF(PX.EQ.AFEO2)THEN - IF(AOH1.GT.AHY1)THEN - RYFEO2=RPFEOX - ELSE RHFEO2=RPFEOX - ENDIF ELSEIF(PX.EQ.AFEO3)THEN - IF(AOH1.GT.AHY1)THEN - RYFEO3=RPFEOX - ELSE RHFEO3=RPFEOX - ENDIF ELSEIF(PX.EQ.AFEO4)THEN - IF(AOH1.GT.AHY1)THEN - RYFEO4=RPFEOX - ELSE RHFEO4=RPFEOX ENDIF - ENDIF -C WRITE(*,1112)'IRON',K,L,M,MM,PFEOH1,CFE1,CFEO1,CFEO2,CFEO3,CFEO4 -C 2,COH1,R2,P1,P2,SP,Z,TX,RPFEOX,RHFE1,RHFEO1,RHFEO2,RHFEO3,RHFEO4 -C 3,CFE1*A3*(COH1*A1)**3,SYFEO +C IF((M/25)*25.EQ.M)THEN +C WRITE(*,1112)'FEOHI',I,L,K,M,PFEOH1,AFE1,AFEO1,AFEO2,AFEO3,AFEO4 +C 2,AOH1,R1,P1,P2,SP,SPX,RPFEOX,RHFE1,RHFEO1,RHFEO2,RHFEO3,RHFEO4 +C 3,AFE1*AOH1**3,SPFEO +C ENDIF C -C CALCITE AND GYPSUM +C CALCITE C PX=AMAX1(ACO31,AHCO31,ACO21) - R2=CHY1 - P3=COH1 - - P1=CCA1 + R1=AHY1 + P1=ACA1 IF(PX.EQ.ACO31)THEN - P2=CCO31 - NR2=0 - NP3=0 - SP=SPCAC/A22 + P2=ACO31 + NR1=0 + SP=SPCAC ELSEIF(PX.EQ.AHCO31)THEN - P2=CHCO31 - IF(AOH1.GT.AHY1)THEN - NR2=0 - NP3=1 - SP=SYCAC1/A12A2 - ELSE - NR2=1 - NP3=0 - SP=SHCAC1/A2 - ENDIF + P2=AHCO31 + NR1=1 + SP=SHCAC1 ELSEIF(PX.EQ.ACO21)THEN - P2=CCO21 - IF(AOH1.GT.AHY1)THEN - NR2=0 - NP3=2 - SP=SYCAC2/A0A1A2 - ELSE - NR2=2 - NP3=0 - SP=SHCAC2*A1202D + P2=ACO21 + NR1=2 + SP=SHCAC2 ENDIF - ENDIF - RYCAC3=0.0 - RYCACH=0.0 - RYCACO=0.0 RHCAC3=0.0 RHCACH=0.0 RHCACO=0.0 - X=0.0 - TX=0.0 - DO 1030 MM=1,100 - P1=AMAX1(ZERO,P1-X) - Z=(P1*P2*P3**NP3/R2**NR2)/SP - IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 1130 - IF(Z.LE.0.95.AND.PCACO1.LE.0.0)GO TO 1130 - Y=P1 - IF(Z.GT.1.0)THEN - X=Y-Y/Z**0.50 - ELSE - X=Y*Z**0.50-Y - ENDIF - TX=TX+X -1030 CONTINUE -1130 CONTINUE - RPCACX=AMAX1(-PCACO1,TPD*TX) + R1=AMAX1(ZERO,R1) + P1=AMAX1(ZERO,P1) + P2=AMAX1(ZERO,P2) + SPX=SP*R1**NR1 + S0=P1+P2 + S1=AMAX1(0.0,S0**2-4.0*(P1*P2-SPX)) + RPCACX=AMAX1(-PCACO1,TPD*(S0-SQRT(S1))) IF(PX.EQ.ACO31)THEN - IF(AOH1.GT.AHY1)THEN - RYCAC3=RPCACX - ELSE RHCAC3=RPCACX - ENDIF ELSEIF(PX.EQ.AHCO31)THEN - IF(AOH1.GT.AHY1)THEN - RYCACH=RPCACX - ELSE RHCACH=RPCACX - ENDIF ELSEIF(PX.EQ.ACO21)THEN - IF(AOH1.GT.AHY1)THEN - RYCACO=RPCACX - ELSE RHCACO=RPCACX ENDIF - ENDIF - SP=SPCAS/A22 - S0=CCA1+CSO41 - S1=S0**2-4.0*(CCA1*CSO41-SP) - RPCASO=AMAX1(-PCASO1,TPD*0.5*(S0-SQRT(S1))) +C +C GYPSUM +C + P1=ACA1 + P2=ASO41 + P1=AMAX1(ZERO,P1) + P2=AMAX1(ZERO,P2) + SPX=SPCAS + S0=P1+P2 + S1=AMAX1(0.0,S0**2-4.0*(P1*P2-SPX)) + RPCASO=AMAX1(-PCASO1,TPD*(S0-SQRT(S1))) +C IF((M/10)*10.EQ.M)THEN +C WRITE(*,1112)'CALC',I,J,L,K,M,PCASO1,ACO31,AHCO31,ACO21,CHY1 +C 2,COH1,R1,P1,P2,P3,SP,Z,TX,RPCACX,RHCAC3,RHCACH,RHCACO +C 3,CCA1*A2*CCO3*A2,SPCAC +C ENDIF +C +C PHOSPHORUS PRECIPITATION-DISSOLUTION IN NON-BAND SOIL ZONE +C C C ALUMINUM PHOSPHATE (VARISCITE) C - AH1P1=CH1P1*A2 - AH2P1=CH2P1*A1 PX=AMAX1(AAL1,AALO1,AALO2,AALO3,AALO4) PY=AMAX1(AH1P1,AH2P1) - R3=CHY1 - R4=COH1 - P3=CHY1 - P4=COH1 + R1=AHY1 + P3=AHY1 IF(PY.EQ.AH1P1)THEN - P2=CH1P1 + P2=AH1P1 IF(PX.EQ.AAL1)THEN - P1=CAL1 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=0 + P1=AAL1 + NR1=1 NP3=0 - NP4=1 - SP=SYA0P1/A1A2A3 - ELSE - NR3=1 - NR4=0 - NP3=0 - NP4=0 - SP=SHA0P1*A1A23D - ENDIF + SP=SHA0P1 ELSEIF(PX.EQ.AALO1)THEN - P1=CALO1 - NR3=0 - NR4=0 + P1=AALO1 + NR1=0 NP3=0 - NP4=0 - SP=SPA1P1/A22 + SP=SPA1P1 ELSEIF(PX.EQ.AALO2)THEN - P1=CALO2 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=1 - NP3=0 - NP4=0 - SP=SYA2P1/A2 - ELSE - NR3=0 - NR4=0 + P1=AALO2 + NR1=0 NP3=1 - NP4=0 - SP=SHA2P1/A12A2 - ENDIF + SP=SHA2P1 ELSEIF(PX.EQ.AALO3)THEN - P1=CALO3 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=2 - NP3=0 - NP4=0 - SP=SYA3P1*A12A2D - ELSE - NR3=0 - NR4=0 + P1=AALO3 + NR1=0 NP3=2 - NP4=0 - SP=SHA3P1/A13A2 - ENDIF + SP=SHA3P1 ELSEIF(PX.EQ.AALO4)THEN - P1=CALO4 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=3 - NP3=0 - NP4=0 - SP=SYA4P1*A12A2D - - ELSE - NR3=0 - NR4=0 + P1=AALO4 + NR1=0 NP3=3 - NP4=0 - SP=SHA4P1*A14A2 - ENDIF + SP=SHA4P1 ENDIF ELSE - P2=CH2P1 + P2=AH2P1 IF(PX.EQ.AAL1)THEN - P1=CAL1 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=0 - NP3=0 - NP4=2 - SP=SYA0P2/A13A3 - ELSE - NR3=2 - NR4=0 + P1=AAL1 + NR1=2 NP3=0 - NP4=0 - SP=SHA0P2*A1A3D - ENDIF + SP=SHA0P2 ELSEIF(PX.EQ.AALO1)THEN - P1=CALO1 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=0 + P1=AALO1 + NR1=1 NP3=0 - NP4=1 - - SP=SYA1P2/A12A2 - ELSE - NR3=1 - NR4=0 - NP3=0 - NP4=0 - SP=SHA1P2/A2 - ENDIF + SP=SHA1P2 ELSEIF(PX.EQ.AALO2)THEN - P1=CALO2 - NR3=0 - NR4=0 + P1=AALO2 + NR1=0 NP3=0 - NP4=0 - SP=SPA2P2/A12 + SP=SPA2P2 ELSEIF(PX.EQ.AALO3)THEN - P1=CALO3 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=1 - NP3=0 - NP4=0 - SP=SYA3P2 - ELSE - NR3=0 - NR4=0 + P1=AALO3 + NR1=0 NP3=1 - NP4=0 - SP=SHA3P2/A22 - ENDIF + SP=SHA3P2 ELSEIF(PX.EQ.AALO4)THEN - P1=CALO4 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=2 - NP3=0 - NP4=0 - SP=SYA4P2 - ELSE - NR3=0 - NR4=0 + P1=AALO4 + NR1=0 NP3=2 - NP4=0 - SP=SHA4P2/A14 + SP=SHA4P2 ENDIF ENDIF - ENDIF - RYA0P1=0.0 - - RYA1P1=0.0 - RYA2P1=0.0 - RYA3P1=0.0 - RYA4P1=0.0 - RYA0P2=0.0 - RYA1P2=0.0 - RYA2P2=0.0 - RYA3P2=0.0 - RYA4P2=0.0 RHA0P1=0.0 RHA1P1=0.0 RHA2P1=0.0 @@ -1008,253 +781,110 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) RHA2P2=0.0 RHA3P2=0.0 RHA4P2=0.0 - X=0.0 - TX=0.0 - DO 1040 MM=1,100 - P1=AMAX1(ZERO,P1-X) - P2=AMAX1(ZERO,P2-X) - Z=(P1*P2*P3**NP3*P4**NP4/(R3**NR3*R4**NR4))/SP - IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 1140 - IF(Z.LE.0.95.AND.PALPO1.LE.0.0)GO TO 1140 - Y=AMIN1(P1,P2) - IF(Z.GT.1.0)THEN - X=Y-Y/Z**0.50 - ELSE - X=Y*Z**0.50-Y - ENDIF - TX=TX+X -1040 CONTINUE -1140 CONTINUE - RPALPX=AMAX1(-PALPO1,TPD*TX) + R1=AMAX1(ZERO,R1) + P1=AMAX1(ZERO,P1) + P2=AMAX1(ZERO,P2) + P3=AMAX1(ZERO,P3) + SPX=SP*R1**NR1/P3**NP3 + S0=P1+P2 + S1=AMAX1(0.0,S0**2-4.0*(P1*P2-SPX)) + RPALPX=AMAX1(-PALPO1,TPD*(S0-SQRT(S1))) IF(PY.EQ.AH1P1)THEN IF(PX.EQ.AAL1)THEN - IF(AOH1.GT.AHY1)THEN - RYA0P1=RPALPX - ELSE RHA0P1=RPALPX - ENDIF ELSEIF(PX.EQ.AALO1)THEN - IF(AOH1.GT.AHY1)THEN - RYA1P1=RPALPX - ELSE RHA1P1=RPALPX - ENDIF ELSEIF(PX.EQ.AALO2)THEN - IF(AOH1.GT.AHY1)THEN - RYA2P1=RPALPX - ELSE RHA2P1=RPALPX - ENDIF ELSEIF(PX.EQ.AALO3)THEN - IF(AOH1.GT.AHY1)THEN - RYA3P1=RPALPX - ELSE RHA3P1=RPALPX - ENDIF ELSEIF(PX.EQ.AALO4)THEN - IF(AOH1.GT.AHY1)THEN - RYA4P1=RPALPX - ELSE RHA4P1=RPALPX ENDIF - ENDIF ELSE IF(PX.EQ.AAL1)THEN - IF(AOH1.GT.AHY1)THEN - RYA0P2=RPALPX - ELSE RHA0P2=RPALPX - ENDIF ELSEIF(PX.EQ.AALO1)THEN - IF(AOH1.GT.AHY1)THEN - RYA1P2=RPALPX - ELSE RHA1P2=RPALPX - ENDIF ELSEIF(PX.EQ.AALO2)THEN - IF(AOH1.GT.AHY1)THEN - RYA2P2=RPALPX - ELSE RHA2P2=RPALPX - ENDIF ELSEIF(PX.EQ.AALO3)THEN - IF(AOH1.GT.AHY1)THEN - RYA3P2=RPALPX - ELSE RHA3P2=RPALPX - ENDIF ELSEIF(PX.EQ.AALO4)THEN - IF(AOH1.GT.AHY1)THEN - RYA4P2=RPALPX - ELSE RHA4P2=RPALPX ENDIF ENDIF - ENDIF -C WRITE(*,1112)'ALPO4',K,L,M,MM,PALPO1,CAL1,CALO1,CALO2,CALO3,CALO4 -C 2,CH1P1,CH2P1,CHY1,COH1,RPALPX,RHA0P1,RHA1P1,RHA2P1,RHA3P1,RHA4P1 -C 3,RHA0P2,RHA1P2,RHA2P2,RHA3P2,RHA4P2,R3,R4,P3,P4,SP,Z,TX,A1,A2,A3 -1112 FORMAT(A8,4I4,40E12.4) +C IF((M/25)*25.EQ.M)THEN +C WRITE(*,1112)'ALPO4I',I,L,K,M,PALPO1,AAL1,AALO1,AALO2,AALO3,AALO4 +C 2,AH0P1,AH1P1,AH2P1,AHY1,AOH1,RPALPX,RHA0P1,RHA1P1,RHA2P1,RHA3P1 +C 3,RHA4P1,RHA0P2,RHA1P2,RHA2P2,RHA3P2,RHA4P2,SP,SPX,AAL1*AH0P1 +C 4,SPALP +1112 FORMAT(A8,4I4,80E12.4) +C ENDIF C C IRON PHOSPHATE (STRENGITE) C PX=AMAX1(AFE1,AFEO1,AFEO2,AFEO3,AFEO4) PY=AMAX1(AH1P1,AH2P1) - R3=CHY1 - R4=COH1 - P3=CHY1 - P4=COH1 + R1=AHY1 + P3=AHY1 IF(PY.EQ.AH1P1)THEN - P2=CH1P1 + P2=AH1P1 IF(PX.EQ.AFE1)THEN - P1=CFE1 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=0 + P1=AFE1 + NR1=1 NP3=0 - NP4=1 - SP=SYF0P1/A1A2A3 - ELSE - NR3=1 - NR4=0 - NP3=0 - NP4=0 - SP=SHF0P1*A1A23D - ENDIF + SP=SHF0P1 ELSEIF(PX.EQ.AFEO1)THEN - P1=CFEO1 - NR3=0 - NR4=0 + P1=AFEO1 + NR1=0 NP3=0 - NP4=0 - SP=SPF1P1/A22 + SP=SPF1P1 ELSEIF(PX.EQ.AFEO2)THEN - P1=CFEO2 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=1 - NP3=0 - NP4=0 - SP=SYF2P1/A2 - ELSE - NR3=0 - NR4=0 + P1=AFEO2 + NR1=0 NP3=1 - NP4=0 - SP=SHF2P1/A12A2 - ENDIF + SP=SHF2P1 ELSEIF(PX.EQ.AFEO3)THEN - P1=CFEO3 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=2 - NP3=0 - NP4=0 - SP=SYF3P1*A12A2D - ELSE - NR3=0 - NR4=0 + P1=AFEO3 + NR1=0 NP3=2 - NP4=0 - SP=SHF3P1/A13A2 - ENDIF + SP=SHF3P1 ELSEIF(PX.EQ.AFEO4)THEN - P1=CFEO4 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=3 - NP3=0 - NP4=0 - SP=SYF4P1*A12A2D - ELSE - NR3=0 - NR4=0 + P1=AFEO4 + NR1=0 NP3=3 - NP4=0 - SP=SHF4P1*A14A2 - ENDIF + SP=SHF4P1 ENDIF ELSE - P2=CH2P1 + P2=AH2P1 IF(PX.EQ.AFE1)THEN - P1=CFE1 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=0 - NP3=0 - NP4=2 - SP=SYF0P2/A13A3 - ELSE - NR3=2 - NR4=0 + P1=AFE1 + NR1=2 NP3=0 - NP4=0 - SP=SHF0P2*A1A3D - ENDIF + SP=SHF0P2 ELSEIF(PX.EQ.AFEO1)THEN - P1=CFEO1 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=0 + P1=AFEO1 + NR1=1 NP3=0 - NP4=1 - SP=SYF1P2/A12A2 - ELSE - NR3=1 - NR4=0 - NP3=0 - NP4=0 - SP=SHF1P2/A2 - ENDIF + SP=SHF1P2 ELSEIF(PX.EQ.AFEO2)THEN - P1=CFEO2 - NR3=0 - NR4=0 + P1=AFEO2 + NR1=0 NP3=0 - NP4=0 - SP=SPF2P2/A12 + SP=SPF2P2 ELSEIF(PX.EQ.AFEO3)THEN - P1=CFEO3 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=1 - NP3=0 - NP4=0 - SP=SYF3P2 - ELSE - NR3=0 - NR4=0 + P1=AFEO3 + NR1=0 NP3=1 - NP4=0 - SP=SHF3P2/A22 - ENDIF + SP=SHF3P2 ELSEIF(PX.EQ.AFEO4)THEN - P1=CFEO4 - IF(AOH1.GT.AHY1)THEN - NR3=0 - NR4=2 - NP3=0 - NP4=0 - SP=SYF4P2 - ELSE - NR3=0 - NR4=0 + P1=AFEO4 + NR1=0 NP3=2 - NP4=0 - SP=SHF4P2/A14 - ENDIF + SP=SHF4P2 ENDIF ENDIF - RYF0P1=0.0 - RYF1P1=0.0 - RYF2P1=0.0 - RYF3P1=0.0 - RYF4P1=0.0 - RYF0P2=0.0 - RYF1P2=0.0 - RYF2P2=0.0 - RYF3P2=0.0 - RYF4P2=0.0 RHF0P1=0.0 RHF1P1=0.0 RHF2P1=0.0 @@ -1265,215 +895,111 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) RHF2P2=0.0 RHF3P2=0.0 RHF4P2=0.0 - X=0.0 - TX=0.0 - DO 1050 MM=1,100 - P1=AMAX1(ZERO,P1-X) - P2=AMAX1(ZERO,P2-X) - Z=(P1*P2*P3**NP3*P4**NP4/(R3**NR3*R4**NR4))/SP - IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 1150 - IF(Z.LE.0.95.AND.PFEPO1.LE.0.0)GO TO 1150 - Y=AMIN1(P1,P2) - IF(Z.GT.1.0)THEN - X=Y-Y/Z**0.50 - ELSE - X=Y*Z**0.50-Y - ENDIF - TX=TX+X -1050 CONTINUE -1150 CONTINUE - RPFEPX=AMAX1(-PFEPO1,TPD*TX) + R1=AMAX1(ZERO,R1) + P1=AMAX1(ZERO,P1) + P2=AMAX1(ZERO,P2) + P3=AMAX1(ZERO,P3) + SPX=SP*R1**NR1/P3**NP3 + S0=P1+P2 + S1=AMAX1(0.0,S0**2-4.0*(P1*P2-SPX)) + RPFEPX=AMAX1(-PFEPO1,TPD*(S0-SQRT(S1))) IF(PY.EQ.AH1P1)THEN IF(PX.EQ.AFE1)THEN - IF(AOH1.GT.AHY1)THEN - RYF0P1=RPFEPX - ELSE RHF0P1=RPFEPX - ENDIF ELSEIF(PX.EQ.AFEO1)THEN - IF(AOH1.GT.AHY1)THEN - RYF1P1=RPFEPX - ELSE RHF1P1=RPFEPX - ENDIF ELSEIF(PX.EQ.AFEO2)THEN - IF(AOH1.GT.AHY1)THEN - RYF2P1=RPFEPX - ELSE RHF2P1=RPFEPX - ENDIF ELSEIF(PX.EQ.AFEO3)THEN - IF(AOH1.GT.AHY1)THEN - RYF3P1=RPFEPX - ELSE RHF3P1=RPFEPX - ENDIF ELSEIF(PX.EQ.AFEO4)THEN - IF(AOH1.GT.AHY1)THEN - RYF4P1=RPFEPX - ELSE RHF4P1=RPFEPX ENDIF - ENDIF ELSE IF(PX.EQ.AFE1)THEN - IF(AOH1.GT.AHY1)THEN - RYF0P2=RPFEPX - ELSE RHF0P2=RPFEPX - ENDIF ELSEIF(PX.EQ.AFEO1)THEN - IF(AOH1.GT.AHY1)THEN - RYF1P2=RPFEPX - ELSE RHF1P2=RPFEPX - ENDIF ELSEIF(PX.EQ.AFEO2)THEN - IF(AOH1.GT.AHY1)THEN - RYF2P2=RPFEPX - ELSE RHF2P2=RPFEPX - ENDIF ELSEIF(PX.EQ.AFEO3)THEN - IF(AOH1.GT.AHY1)THEN - RYF3P2=RPFEPX - ELSE RHF3P2=RPFEPX - ENDIF ELSEIF(PX.EQ.AFEO4)THEN - IF(AOH1.GT.AHY1)THEN - RYF4P2=RPFEPX - ELSE RHF4P2=RPFEPX ENDIF ENDIF - ENDIF +C IF((M/25)*25.EQ.M)THEN +C WRITE(*,1112)'FEPO4I',I,L,K,M,PFEPO1,AFE1,AFEO1,AFEO2,AFEO3,AFEO4 +C 2,AH0P1,AH1P1,AH2P1,AHY1,AOH1,RPFEPX,RHF0P1,RHF1P1,RHF2P1,RHF3P1 +C 3,RHF4P1,RHF0P2,RHF1P2,RHF2P2,RHF3P2,RHF4P2,SP,SPX,AFE1*AH0P1 +C 4,SPFEP +C ENDIF C C DICALCIUM PHOSPHATE C PX=AMAX1(AH1P1,AH2P1) - R2=CHY1 - P3=COH1 - P1=CCA1 + R1=AHY1 + P1=ACA1 IF(PX.EQ.AH1P1)THEN - P2=CH1P1 - NR2=0 - NP3=0 - SP=SPCAD/A22 + P2=AH1P1 + NR1=0 + SP=SPCAD ELSEIF(PX.EQ.AH2P1)THEN - P2=CH2P1 - IF(AOH1.GT.AHY1)THEN - NR2=0 - NP3=1 - SP=SYCAD2/A12A2 - ELSE - NR2=1 - NP3=0 - SP=SHCAD2/A2 - ENDIF + P2=AH2P1 + NR1=1 + SP=SHCAD2 ENDIF RPCAD1=0.0 - RYCAD2=0.0 RHCAD2=0.0 - X=0.0 - TX=0.0 - FX=1.0/(2+NR2+NP3) - DO 1060 MM=1,100 - P1=AMAX1(ZERO,P1-X) - P2=AMAX1(ZERO,P2-X) - Z=(P1*P2*P3**NP3/R2**NR2)/SP - IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 1160 - IF(Z.LE.0.95.AND.PCAPD1.LE.0.0)GO TO 1160 - Y=AMIN1(P1,P2) - IF(Z.GT.1.0)THEN - X=Y-Y/Z**0.50 - ELSE - X=Y*Z**0.50-Y - ENDIF - TX=TX+X -1060 CONTINUE -1160 CONTINUE - RPCADX=AMAX1(-PCAPD1,TPD*TX) + R1=AMAX1(ZERO,R1) + P1=AMAX1(ZERO,P1) + P2=AMAX1(ZERO,P2) + SPX=SP*R1**NR1 + S0=P1+P2 + S1=AMAX1(0.0,S0**2-4.0*(P1*P2-SPX)) + RPCADX=AMAX1(-PCAPD1,TPD*(S0-SQRT(S1))) IF(PX.EQ.AH1P1)THEN RPCAD1=RPCADX ELSEIF(PX.EQ.AH2P1)THEN - IF(AOH1.GT.AHY1)THEN - RYCAD2=RPCADX - ELSE RHCAD2=RPCADX ENDIF - ENDIF -C WRITE(*,1112)'CAPO4',K,L,M,MM,PCAPD1,CCA1 -C 2,CH1P1,CH2P1,CHY1,RPCADX,RPCAD1,RYCAD2,RHCAD2,R2,P1,P2,P3 -C 3,SP,Z,CCA1*A2*CH1P1*A2,SPCAD +C IF((M/10)*10.EQ.M)THEN +C WRITE(*,1112)'CAPO4',I,J,L,M,PCAPM1,PCAPD1,CCA1 +C 2,CH1P1,CH2P1,CHY1,COH1,RPCADX,RPCAD1,RHCAD2,R1,P1,P2,P3 +C 3,SP,Z,FX,Y,X,TX,A2,CCA1*A2*CH1P1*A2,SPCAD +C ENDIF C C HYDROXYAPATITE C PX=AMAX1(AH1P1,AH2P1) - R2=CHY1 - P3=COH1 - P1=CCA1 + R1=AHY1 + P1=ACA1 IF(PX.EQ.AH1P1)THEN - P2=CH1P1 - IF(AOH1.GT.AHY1)THEN - NR2=0 - NP3=4 - SP=SYCAH1/A14A28 - ELSE - NR2=4 - NP3=0 - SP=SHCAH1*A14A8D - ENDIF + P2=AH1P1 + NR1=4 + SP=SHCAH1 ELSEIF(PX.EQ.AH2P1)THEN - P2=CH2P1 - IF(AOH1.GT.AHY1)THEN - NR2=0 - NP3=7 - SP=SYCAH2/A1TA25 - ELSE - NR2=7 - NP3=0 - SP=SHCAH2*A14A5D - ENDIF + P2=AH2P1 + NR1=7 + SP=SHCAH2 ENDIF - RYCAH1=0.0 - RYCAH2=0.0 RHCAH1=0.0 RHCAH2=0.0 - X=0.0 - TX=0.0 - DO 1070 MM=1,100 - P1=AMAX1(ZERO,P1-5.0*X) - P2=AMAX1(ZERO,P2-3.0*X) - Z=(P1**5*P2**3*P3**NP3/R2**NR2)/SP - IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 1170 - IF(Z.LE.0.95.AND.PCAPH1.LE.0.0)GO TO 1170 - Y=AMIN1(P1/5,P2/3) - IF(Z.GT.1.0)THEN - X=Y-Y/Z**0.125 - ELSE - X=Y*Z**0.125-Y - ENDIF - TX=TX+X -1070 CONTINUE -1170 CONTINUE - RPCAHX=AMAX1(-PCAPH1,TPD*TX) + R1=AMAX1(ZERO,R1) + P1=AMAX1(ZERO,P1) + P2=AMAX1(ZERO,P2) + SPX=(SP*R1**NR1/P1**5)**0.333 + RPCAHX=AMAX1(-PCAPH1,TPD*(P2-SPX)) IF(PX.EQ.AH1P1)THEN - IF(AOH1.GT.AHY1)THEN - RYCAH1=RPCAHX - ELSE RHCAH1=RPCAHX - ENDIF ELSEIF(PX.EQ.AH2P1)THEN - IF(AOH1.GT.AHY1)THEN - RYCAH2=RPCAHX - ELSE RHCAH2=RPCAHX ENDIF - ENDIF -C WRITE(*,1112)'APATITE',K,L,M,MM,PCAPH1,CCA1 -C 2,CH1P1,CH2P1,CHY1,RPCAHX,RHCAH1,RHCAH2,R2,P1,P2,P3 -C 3,SP,Z,(CCA1*A2)**5*(CH0P1*A3)**3*COH1*A1,SPCAH +C IF((M/25)*25.EQ.M)THEN +C WRITE(*,1112)'APATITEI',I,L,K,M,PCAPH1,ACA1 +C 2,AH0P1,AH1P1,AH2P1,AHY1,AOH1,RPCAHX,RHCAH1,RHCAH2 +C 3,SP,SPX,ACA1**5*AH0P1**3*AOH1,SPCAH,SHCAH1,SHCAH2 +C ENDIF PALOH1=PALOH1+RPALOX PFEOH1=PFEOH1+RPFEOX PCACO1=PCACO1+RPCACX @@ -1485,184 +1011,107 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) C C ANION EXCHANGE EQILIBRIA C - DCHG=AMAX1(-0.1E+05,XOH21-XOH01-XH1P1) - AEP=EXP(AE*DCHG/TKS(L,NY,NX)) - AEN=EXP(-AE*DCHG/TKS(L,NY,NX)) -C -C PROTONATION OF EXCHANGE SITES -C - SPOH2=SXOH2*AEP/A1 - X0=XOH11+CHY1+SPOH2 - X1=X0**2-4.0*(XOH11*CHY1-SPOH2*XOH21) - RXOH2=TAD*0.5*(X0-SQRT(X1)) - SPOH1=SXOH1/(AEN*A1) - X0=XOH01+CHY1+SPOH1 - X1=X0**2-4.0*(XOH01*CHY1-SPOH1*XOH11) - RXOH1=TAD*0.5*(X0-SQRT(X1)) - SPH2P=SYH2P*DPH2O/(SXOH2*AEP*A1) - X0=XOH21+CH2P1+SPH2P - X1=X0**2-4.0*(XOH21*CH2P1-SPH2P*XH2P1) - RXH2P=TAD*0.5*(X0-SQRT(X1)) -C -C H2PO4 EXCHANGE -C - R1=XH2P1 - R2=COH1 - P1=XOH11 - P2=CH2P1 - P3=CHY1 - IF(AOH1.GT.AHY1)THEN - NR2=1 - NP3=0 - SP=SYH2P - ELSE - NR2=0 - NP3=1 - SP=SHH2P/A12 - ENDIF - RYH2P=0.0 - RHH2P=0.0 - X=0.0 - TX=0.0 - DO 4010 MM=1,100 - R1=AMAX1(ZERO,R1+X) - P1=AMAX1(ZERO,P1-X) - P2=AMAX1(ZERO,P2-X) - Z=(P1*P2*P3**NP3/(R1*R2**NR2))/SP - IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 4110 - Y=AMIN1(R1,P1,P2) - IF(Z.GT.1.0)THEN - X=Y-Y/Z**0.33 + IF(VOLW(L,NY,NX).GT.ZEROS(NY,NX))THEN + VOLWBK=AMIN1(1.0,BKVL(L,NY,NX)/VOLW(L,NY,NX)) ELSE - X=Y*Z**0.33-Y - ENDIF - TX=TX+X -4010 CONTINUE -4110 CONTINUE - IF(AOH1.GT.AHY1)THEN - RYH2P=TAD*TX - ELSE - RHH2P=TAD*TX + VOLWBK=1.0 ENDIF + IF(AEC(L,NY,NX).GT.ZEROS(NY,NX))THEN + RXOH2=TAD*(XOH11*AHY1-SXOH2*XOH21)/(XOH11+SPOH2)*VOLWBK + RXOH1=TAD*(XOH01*AHY1-SXOH1*XOH11)/(XOH01+SPOH1)*VOLWBK + SPH2P=SXH2P*DPH2O + RXH2P=TAD*(XOH21*AH2P1-SPH2P*XH2P1)/(XOH21+SPH2P)*VOLWBK + RYH2P=TAD*(XOH11*AH2P1-SXH2P*XH2P1*AOH1) + 2/(XOH11+SXH2P*AOH1)*VOLWBK C C HPO4 EXCHANGE C - R1=XH1P1 - R2=COH1 - P1=XOH11 - P2=CH1P1 - P3=CHY1 - IF(AOH1.GT.AHY1)THEN - NR2=1 - NP3=0 - SP=SYH1P*AEN*A1A2D - ELSE - NR2=0 - NP3=1 - SP=SHH1P*AEN/A1A2 - ENDIF - RYH1P=0.0 - RHH1P=0.0 - X=0.0 - TX=0.0 - DO 4020 MM=1,100 - R1=AMAX1(ZERO,R1+X) - P1=AMAX1(ZERO,P1-X) - P2=AMAX1(ZERO,P2-X) - Z=(P1*P2*P3**NP3/(R1*R2**NR2))/SP - IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 4120 - Y=AMIN1(R1,P1,P2) - IF(Z.GT.1.0)THEN - X=Y-Y/Z**0.33 - ELSE - X=Y*Z**0.33-Y - ENDIF - TX=TX+X -4020 CONTINUE -4120 CONTINUE - IF(AOH1.GT.AHY1)THEN - RYH1P=TAD*TX + SPH1P=SXH1P*DPH2O/DPH2P + RXH1P=TAD*(XOH11*AH2P1-SPH1P*XH1P1)/(XOH11+SPH1P)*VOLWBK ELSE - RHH1P=TAD*TX + RXOH2=0.0 + RXOH1=0.0 + RXH2P=0.0 + RYH2P=0.0 + RXH1P=0.0 ENDIF XOH01=XOH01-RXOH1 - XOH11=XOH11+RXOH1-RXOH2-RYH2P-RYH1P-RHH2P-RHH1P + XOH11=XOH11+RXOH1-RXOH2-RYH2P-RXH1P XOH21=XOH21+RXOH2-RXH2P - XH1P1=XH1P1+RYH1P+RHH1P - XH2P1=XH2P1+RXH2P+RYH2P+RHH2P + XH1P1=XH1P1+RXH1P + XH2P1=XH2P1+RXH2P+RYH2P C C CATION EXCHANGE C - CHYX=CHY1 - CN4X=CN41 - CALX=CAL1**0.333 - CCAX=CCA1**0.500 - CMGX=CMG1**0.500 - CNAX=CNA1 - CKAX=CKA1 - A2Q=A2**0.500 - A3C=A3**0.333 - A1A2QD=A1/A2Q - GKC4X=GKC4(L,NY,NX)*A1A2QD - GKCHX=GKCH(L,NY,NX)*A1A2QD - GKCAX=GKCA(L,NY,NX)*A3C/A2Q - GKCMX=GKCM(L,NY,NX) - GKCNX=GKCN(L,NY,NX)*A1A2QD - GKCKX=GKCK(L,NY,NX)*A1A2QD - XCAQ=XCECQ/(1.0+GKC4X*CN4X/CCAX+GKCHX*CHYX/CCAX+GKCAX*CALX/CCAX - 3+GKCMX*CMGX/CCAX+GKCNX*CNAX/CCAX+GKCKX*CKAX/CCAX) - FCAQ=XCAQ/CCAX - FN4Q=FCAQ*GKC4X - RXN4=TSL*(FN4Q*CN41-XN4Q)/(1.0+FN4Q) - XN4Q=XN4Q+RXN4 - XHYQ=FCAQ*GKCHX*CHYX - XALQ=FCAQ*GKCAX*CALX - XMGQ=FCAQ*GKCMX*CMGX - XNAQ=FCAQ*GKCNX*CNAX - XKAQ=FCAQ*GKCKX*CKAX - XTLQ=XHYQ+XALQ+XCAQ+XMGQ+XNAQ+XKAQ + AALX=AAL1**0.333 + AFEX=AFE1**0.333 + ACAX=ACA1**0.500 + AMGX=AMG1**0.500 + XCAX=CCEC/(1.0+GKC4(L,NY,NX)*AN41/ACAX + 3+GKCH(L,NY,NX)*AHY1/ACAX+GKCA(L,NY,NX)*AALX/ACAX + 4+GKCA(L,NY,NX)*AFEX/ACAX+GKCM(L,NY,NX)*AMGX/ACAX + 5+GKCN(L,NY,NX)*ANA1/ACAX+GKCK(L,NY,NX)*AKA1/ACAX) + XN4Q=XCAX*AN41*GKC4(L,NY,NX) + XHYQ=XCAX*AHY1*GKCH(L,NY,NX) + XALQ=XCAX*AALX*GKCA(L,NY,NX) + XFEQ=XCAX*AFEX*GKCA(L,NY,NX) + XCAQ=XCAX*ACAX + XMGQ=XCAX*AMGX*GKCM(L,NY,NX) + XNAQ=XCAX*ANA1*GKCN(L,NY,NX) + XKAQ=XCAX*AKA1*GKCK(L,NY,NX) + XTLQ=XN4Q+XHYQ+XALQ+XFEQ+XCAQ+XMGQ+XNAQ+XKAQ IF(XTLQ.GT.ZERO)THEN - FB=(XCECQ-XN4Q)/XTLQ - ELSE - FB=0.0 - ENDIF - XHYQ=FB*XHYQ - XALQ=FB*XALQ - XCAQ=FB*XCAQ - XMGQ=FB*XMGQ - XNAQ=FB*XNAQ - XKAQ=FB*XKAQ + FX=CCEC/XTLQ + ELSE + FX=0.0 + ENDIF + XN4Q=FX*XN4Q + XHYQ=FX*XHYQ + XALQ=FX*XALQ/3.0 + XFEQ=FX*XFEQ/3.0 + XCAQ=FX*XCAQ/2.0 + XMGQ=FX*XMGQ/2.0 + XNAQ=FX*XNAQ + XKAQ=FX*XKAQ + RXN4=TAD*(XN4Q-XN41)*AN41/XN4Q + RXHY=TAD*(XHYQ-XHY1)*AHY1/XHYQ + RXAL=TAD*(XALQ-XAL1)*AALX/XALQ + RXFE=TAD*(XFEQ-XFE1)*AFEX/XFEQ + RXCA=TAD*(XCAQ-XCA1)*ACAX/XCAQ + RXMG=TAD*(XMGQ-XMG1)*AMGX/XMGQ + RXNA=TAD*(XNAQ-XNA1)*ANA1/XNAQ + RXKA=TAD*(XKAQ-XKA1)*AKA1/XKAQ + XN41=XN41+RXN4 + XHY1=XHY1+RXHY + XAL1=XAL1+RXAL + XFE1=XFE1+RXFE + XCA1=XCA1+RXCA + XMG1=XMG1+RXMG + XNA1=XNA1+RXNA + XKA1=XKA1+RXKA +C IF((M/25)*25.EQ.M)THEN +C WRITE(*,1112)'RXFEI',I,L,K,M,CCEC,XCAX,XN41,XHY1,XAL1,XFE1 +C 2,XCA1,XMG1,XNA1,XKA1,AAL1,AFE1,ACA1 +C ENDIF C C ORGANIC MATTER C - DP=DPCOH*DPALO/A1**2 - XHC1=CHY1*(XCOOH-XALO21)/(CHY1+DPCOH/A1) - XALO21=CALO2*(XCOOH-XHC1)/(CALO2+DPALO/A1) - XCOO=AMAX1(0.0,XCOOH-XHC1-XALO21) + DP=DPCOH*DPALO + XHC1=AHY1*(XCOOH-XALO21-XFEO21)/(AHY1+DPCOH) + XALO21=AALO2*(XCOOH-XHC1)/(AALO2+DPALO) + XFEO21=AFEO2*(XCOOH-XHC1)/(AFEO2+DPFEO) + XCOO=AMAX1(0.0,XCOOH-XHC1-XALO21-XFEO21) ELSE - RYAL1=0.0 - RYALO1=0.0 - RYALO2=0.0 - RYALO3=0.0 - RYALO4=0.0 RHAL1=0.0 RHALO1=0.0 RHALO2=0.0 RHALO3=0.0 RHALO4=0.0 - RYFE1=0.0 - RYFEO1=0.0 - RYFEO2=0.0 - RYFEO3=0.0 - RYFEO4=0.0 RHFE1=0.0 RHFEO1=0.0 RHFEO2=0.0 RHFEO3=0.0 RHFEO4=0.0 - RYCAC3=0.0 - RYCACH=0.0 - RYCACO=0.0 RHCAC3=0.0 RHCACH=0.0 RHCACO=0.0 @@ -1670,16 +1119,6 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) RPCASO=0.0 RPCADX=0.0 RPCAHX=0.0 - RYA0P1=0.0 - RYA1P1=0.0 - RYA2P1=0.0 - RYA3P1=0.0 - RYA4P1=0.0 - RYA0P2=0.0 - RYA1P2=0.0 - RYA2P2=0.0 - RYA3P2=0.0 - RYA4P2=0.0 RHA0P1=0.0 RHA1P1=0.0 RHA2P1=0.0 @@ -1690,16 +1129,6 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) RHA2P2=0.0 RHA3P2=0.0 RHA4P2=0.0 - RYF0P1=0.0 - RYF1P1=0.0 - RYF2P1=0.0 - RYF3P1=0.0 - RYF4P1=0.0 - RYF0P2=0.0 - RYF1P2=0.0 - RYF2P2=0.0 - RYF3P2=0.0 - RYF4P2=0.0 RHF0P1=0.0 RHF1P1=0.0 RHF2P1=0.0 @@ -1711,186 +1140,156 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) RHF3P2=0.0 RHF4P2=0.0 RPCAD1=0.0 - RYCAD2=0.0 RHCAD2=0.0 - RYCAH1=0.0 - RYCAH2=0.0 RHCAH1=0.0 RHCAH2=0.0 - RXN4=0.0 RXOH2=0.0 RXOH1=0.0 RXH2P=0.0 RYH2P=0.0 - RYH1P=0.0 - RHH2P=0.0 - RHH1P=0.0 + RXH1P=0.0 + RXN4=0.0 + RXHY=0.0 + RXAL=0.0 + RXFE=0.0 + RXCA=0.0 + RXMG=0.0 + RXNA=0.0 + RXKA=0.0 ENDIF C C ION SPECIATION C - DP=DPN4/A0 - S0=CHY1+CN31+DP - S1=S0**2-4.0*(CHY1*CN31-DP*CN41) + S0=AHY1+AN31+DPN4 + S1=S0**2-4.0*(AHY1*AN31-DPN4*AN41) RNH4=TSL*(S0-SQRT(S1)) - DP=DPAL1*A2A13D - S0=CAL1+COH1+DP - S1=S0**2-4.0*(CAL1*COH1-DP*CALO1) + S0=AAL1+AOH1+DPAL1 + S1=S0**2-4.0*(AAL1*AOH1-DPAL1*AALO1) RALO1=TSL*(S0-SQRT(S1)) - DP=DPAL2/A2 - S0=CALO1+COH1+DP - S1=S0**2-4.0*(CALO1*COH1-DP*CALO2) + S0=AALO1+AOH1+DPAL2 + S1=S0**2-4.0*(AALO1*AOH1-DPAL2*AALO2) RALO2=TSL*(S0-SQRT(S1)) - DP=DPAL3*A0A12 - S0=CALO2+COH1+DP - S1=S0**2-4.0*(CALO2*COH1-DP*CALO3) + S0=CALO2+COH1+DPAL3 + S1=S0**2-4.0*(AALO2*AOH1-DPAL3*AALO3) RALO3=TSL*(S0-SQRT(S1)) - DP=DPAL4/A0 - S0=CALO3+COH1+DP - S1=S0**2-4.0*(CALO3*COH1-DP*CALO4) + S0=AALO3+AOH1+DPAL4 + S1=S0**2-4.0*(AALO3*AOH1-DPAL4*AALO4) RALO4=TSL*(S0-SQRT(S1)) - DP=DPALS*A1A23D - S0=CAL1+CSO41+DP - S1=S0**2-4.0*(CAL1*CSO41-DP*CALS1) + S0=AAL1+ASO41+DPALS + S1=S0**2-4.0*(AAL1*ASO41-DPALS*AALS1) RALS=TSL*(S0-SQRT(S1)) - DP=DPFE1*A2A13D - S0=CFE1+COH1+DP - S1=S0**2-4.0*(CFE1*COH1-DP*CFEO1) + S0=AFE1+AOH1+DPFE1 + S1=S0**2-4.0*(AFE1*AOH1-DPFE1*AFEO1) RFEO1=TSL*(S0-SQRT(S1)) - DP=DPFE2/A2 - S0=CFEO1+COH1+DP - S1=S0**2-4.0*(CFEO1*COH1-DP*CFEO2) + S0=AFEO1+AOH1+DPFE2 + S1=S0**2-4.0*(AFEO1*AOH1-DPFE2*AFEO2) RFEO2=TSL*(S0-SQRT(S1)) - DP=DPFE3*A0A12 - S0=CFEO2+COH1+DP - S1=S0**2-4.0*(CFEO2*COH1-DP*CFEO3) + S0=AFEO2+AOH1+DPFE3 + S1=S0**2-4.0*(AFEO2*AOH1-DPFE3*AFEO3) RFEO3=TSL*(S0-SQRT(S1)) - DP=DPFE4/A0 - S0=CFEO3+COH1+DP - S1=S0**2-4.0*(CFEO3*COH1-DP*CFEO4) + S0=AFEO3+AOH1+DPFE4 + S1=S0**2-4.0*(AFEO3*AOH1-DPFE4*AFEO4) RFEO4=TSL*(S0-SQRT(S1)) - DP=DPFES*A1A23D - S0=CFE1+CSO41+DP - S1=S0**2-4.0*(CFE1*CSO41-DP*CFES1) + S0=AFE1+ASO41+DPFES + S1=S0**2-4.0*(AFE1*ASO41-DPFES*AFES1) RFES=TSL*(S0-SQRT(S1)) - DP=DPCAO/A2 - S0=CCA1+COH1+DP - S1=S0**2-4.0*(CCA1*COH1-DP*CCAO1) + S0=ACA1+AOH1+DPCAO + S1=S0**2-4.0*(ACA1*AOH1-DPCAO*ACAO1) RCAO=TSL*(S0-SQRT(S1)) - DP=DPCAC*A0A22 - S0=CCA1+CCO31+DP - S1=S0**2-4.0*(CCA1*CCO31-DP*CCAC1) + S0=ACA1+ACO31+DPCAC + S1=S0**2-4.0*(ACA1*ACO31-DPCAC*ACAC1) RCAC=TSL*(S0-SQRT(S1)) - - DP=DPCAH/A2 - S0=CCA1+CHCO31+DP - S1=S0**2-4.0*(CCA1*CHCO31-DP*CCAH1) + S0=ACA1+AHCO31+DPCAH + S1=S0**2-4.0*(ACA1*AHCO31-DPCAH*ACAH1) RCAH=TSL*(S0-SQRT(S1)) - DP=DPCAS*A0A22 - S0=CCA1+CSO41+DP - S1=S0**2-4.0*(CCA1*CSO41-DP*CCAS1) + S0=ACA1+ASO41+DPCAS + S1=S0**2-4.0*(ACA1*ASO41-DPCAS*ACAS1) RCAS=TSL*(S0-SQRT(S1)) - DP=DPMGO/A2 - S0=CMG1+COH1+DP - S1=S0**2-4.0*(CMG1*COH1-DP*CMGO1) + S0=AMG1+AOH1+DPMGO + S1=S0**2-4.0*(AMG1*AOH1-DPMGO*AMGO1) RMGO=TSL*(S0-SQRT(S1)) - DP=DPMGC*A0A22 - S0=CMG1+CCO31+DP - S1=S0**2-4.0*(CMG1*CCO31-DP*CMGC1) + S0=AMG1+ACO31+DPMGC + S1=S0**2-4.0*(AMG1*ACO31-DPMGC*AMGC1) RMGC=TSL*(S0-SQRT(S1)) - DP=DPMGH/A2 - S0=CMG1+CHCO31+DP - S1=S0**2-4.0*(CMG1*CHCO31-DP*CMGH1) + S0=AMG1+AHCO31+DPMGH + S1=S0**2-4.0*(AMG1*AHCO31-DPMGH*AMGH1) RMGH=TSL*(S0-SQRT(S1)) - DP=DPMGS*A0A22 - S0=CMG1+CSO41+DP - S1=S0**2-4.0*(CMG1*CSO41-DP*CMGS1) + S0=AMG1+ASO41+DPMGS + S1=S0**2-4.0*(AMG1*ASO41-DPMGS*AMGS1) RMGS=TSL*(S0-SQRT(S1)) - DP=DPNAC/A2 - S0=CNA1+CCO31+DP - S1=S0**2-4.0*(CNA1*CCO31-DP*CNAC1) + S0=ANA1+ACO31+DPNAC + S1=S0**2-4.0*(ANA1*ACO31-DPNAC*ANAC1) RNAC=TSL*(S0-SQRT(S1)) - DP=DPNAS/A2 - S0=CNA1+CSO41+DP - S1=S0**2-4.0*(CNA1*CSO41-DP*CNAS1) + S0=ANA1+ASO41+DPNAS + S1=S0**2-4.0*(ANA1*ASO41-DPNAS*ANAS1) RNAS=TSL*(S0-SQRT(S1)) - DP=DPKAS/A2 - S0=CKA1+CSO41+DP - S1=S0**2-4.0*(CKA1*CSO41-DP*CKAS1) + S0=AKA1+ASO41+DPKAS + S1=S0**2-4.0*(AKA1*ASO41-DPKAS*AKAS1) RKAS=TSL*(S0-SQRT(S1)) - DP=DPH1P*A2A13D - S0=CH0P1+CHY1+DP - S1=S0**2-4.0*(CH0P1*CHY1-DP*CH1P1) + S0=AH0P1+AHY1+DPH1P + S1=S0**2-4.0*(AH0P1*AHY1-DPH1P*AH1P1) RH1P=TSL*(S0-SQRT(S1)) - DP=DPH2P/A2 - S0=CH1P1+CHY1+DP - S1=S0**2-4.0*(CH1P1*CHY1-DP*CH2P1) + S0=AH1P1+AHY1+DPH2P + S1=S0**2-4.0*(AH1P1*AHY1-DPH2P*AH2P1) RH2P=TSL*(S0-SQRT(S1)) - - DP=DPH3P*A0A12 - S0=CH2P1+CHY1+DP - S1=S0**2-4.0*(CH2P1*CHY1-DP*CH3P1) + S0=AH2P1+AHY1+DPH3P + S1=S0**2-4.0*(AH2P1*AHY1-DPH3P*AH3P1) RH3P=TSL*(S0-SQRT(S1)) - DP=DPF1P*A1A23D - S0=CFE1+CH1P1+DP - S1=S0**2-4.0*(CFE1*CH1P1-DP*CF1P1) + S0=AFE1+AH1P1+DPF1P + S1=S0**2-4.0*(AFE1*AH1P1-DPF1P*AF1P1) RF1P=TSL*(S0-SQRT(S1)) - DP=DPF2P*A2A13D - S0=CFE1+CH2P1+DP - S1=S0**2-4.0*(CFE1*CH2P1-DP*CF2P1) + S0=AFE1+AH2P1+DPF2P + S1=S0**2-4.0*(AFE1*AH2P1-DPF2P*AF2P1) RF2P=TSL*(S0-SQRT(S1)) - DP=DPC0P*A1A23D - S0=CCA1+CH0P1+DP - S1=S0**2-4.0*(CCA1*CH0P1-DP*CC0P1) + S0=ACA1+AH0P1+DPC0P + S1=S0**2-4.0*(ACA1*AH0P1-DPC0P*AC0P1) RC0P=TSL*(S0-SQRT(S1)) - DP=DPC1P*A0A22 - S0=CCA1+CH1P1+DP - S1=S0**2-4.0*(CCA1*CH1P1-DP*CC1P1) + S0=ACA1+AH1P1+DPC1P + S1=S0**2-4.0*(ACA1*AH1P1-DPC1P*AC1P1) RC1P=TSL*(S0-SQRT(S1)) - DP=DPC2P/A2 - S0=CCA1+CH2P1+DP - S1=S0**2-4.0*(CCA1*CH2P1-DP*CC2P1) + S0=ACA1+AH2P1+DPC2P + S1=S0**2-4.0*(ACA1*AH2P1-DPC2P*AC2P1) RC2P=TSL*(S0-SQRT(S1)) - DP=DPM1P*A0A22 - S0=CMG1+CH1P1+DP - S1=S0**2-4.0*(CMG1*CH1P1-DP*CM1P1) + S0=AMG1+AH1P1+DPM1P + S1=S0**2-4.0*(AMG1*AH1P1-DPM1P*AM1P1) RM1P=TSL*(S0-SQRT(S1)) C C TOTAL ION FLUX FOR EACH ION SPECIES C RN4S=RNH4-RXN4 RN3S=-RNH4 - RAL=-RYAL1-RHAL1-RYA0P1-RHA0P1-RYA0P2-RHA0P2-RALO1-RALS - RFE=-RYFE1-RHFE1-RYF0P1-RHF0P1-RYF0P2-RHF0P2-RFEO1-RFES + RAL=-RHAL1-RHA0P1-RHA0P2-RALO1-RALS-RXAL + RFE=-RHFE1-RHF0P1-RHF0P2-RFEO1-RFES-RXFE 2-RF1P-RF2P - RCA=-RPCACX-RPCASO-RPCADX-5.0*RPCAHX + RCA=-RPCACX-RPCASO-RPCADX-5.0*RPCAHX-RXCA 2-RCAO-RCAC-RCAH-RCAS-RC0P-RC1P-RC2P - RMG=-RMGO-RMGC-RMGH-RMGS-RM1P - RNA=-RNAC-RNAS - RKA=-RKAS + RMG=-RMGO-RMGC-RMGH-RMGS-RM1P-RXMG + RNA=-RNAC-RNAS-RXNA + RKA=-RKAS-RXKA RSO4=-RPCASO-RALS-RFES-RCAS-RMGS-RNAS-RKAS - RAL1=-RYALO1-RHALO1-RYA1P1-RHA1P1-RYA1P2-RHA1P2+RALO1-RALO2 - RAL2=-RYALO2-RHALO2-RYA2P1-RHA2P1-RYA2P2-RHA2P2+RALO2-RALO3 - RAL3=-RYALO3-RHALO3-RYA3P1-RHA3P1-RYA3P2-RHA3P2+RALO3-RALO4 - RAL4=-RYALO4-RHALO4-RYA4P1-RHA4P1-RYA4P2-RHA4P2+RALO4 - RFE1=-RYFEO1-RHFEO1-RYF1P1-RHF1P1-RYF1P2-RHF1P2+RFEO1-RFEO2 - RFE2=-RYFEO2-RHFEO2-RYF2P1-RHF2P1-RYF2P2-RHF2P2+RFEO2-RFEO3 - RFE3=-RYFEO3-RHFEO3-RYF3P1-RHF3P1-RYF3P2-RHF3P2+RFEO3-RFEO4 - RFE4=-RYFEO4-RHFEO4-RYF4P1-RHF4P1-RYF4P2-RHF4P2+RFEO4 + RAL1=-RHALO1-RHA1P1-RHA1P2+RALO1-RALO2 + RAL2=-RHALO2-RHA2P1-RHA2P2+RALO2-RALO3 + RAL3=-RHALO3-RHA3P1-RHA3P2+RALO3-RALO4 + RAL4=-RHALO4-RHA4P1-RHA4P2+RALO4 + RFE1=-RHFEO1-RHF1P1-RHF1P2+RFEO1-RFEO2 + RFE2=-RHFEO2-RHF2P1-RHF2P2+RFEO2-RFEO3 + RFE3=-RHFEO3-RHF3P1-RHF3P2+RFEO3-RFEO4 + RFE4=-RHFEO4-RHF4P1-RHF4P2+RFEO4 RHP0=-RH1P-RC0P - RHP1=-RYA0P1-RHA0P1-RYA1P1-RHA1P1-RYA2P1-RHA2P1-RYA3P1-RHA3P1 - 2-RYA4P1-RHA4P1-RYF0P1-RHF0P1-RYF1P1-RHF1P1-RYF2P1-RHF2P1-RYF3P1 - 3-RHF3P1-RYF4P1-RHF4P1-RPCAD1-3.0*(RYCAH1+RHCAH1)-RYH1P-RHH1P - 4+RH1P-RH2P-RF1P-RC1P-RM1P - RHP2=-RYA0P2-RHA0P2-RYA1P2-RHA1P2-RYA2P2-RHA2P2-RYA3P2-RHA3P2 - 2-RYA4P2-RHA4P2-RYF0P2-RHF0P2-RYF1P2-RHF1P2-RYF2P2-RHF2P2-RYF3P2 - 3-RHF3P2-RYF4P2-RHF4P2-RHCAD2-RYCAD2-3.0*(RYCAH2+RHCAH2) - 4-RXH2P-RYH2P-RHH2P+RH2P-RH3P-RF2P-RC2P + RHP1=-RHA0P1-RHA1P1-RHA2P1-RHA3P1 + 2-RHA4P1-RHF0P1-RHF1P1-RHF2P1 + 3-RHF3P1-RHF4P1-RPCAD1-3.0*RHCAH1 + 4-RXH1P+RH1P-RH2P-RF1P-RC1P-RM1P + RHP2=-RHA0P2-RHA1P2-RHA2P2-RHA3P2 + 2-RHA4P2-RHF0P2-RHF1P2-RHF2P2 + 3-RHF3P2-RHF4P2-RHCAD2-3.0*RHCAH2 + 4-RXH2P-RYH2P+RH2P-RH3P-RF2P-RC2P RHP3=RH3P C C ION CONCENTRATIONS C - CCO2X=CCO2M*SCO2X/(EXP(ACO2X*CSTRZ))*EXP(0.843-0.0281*ATCA(NY,NX))*FH2O + CCO2X=CCO2M*SCO2X/(EXP(ACO2X*CSTRZ)) + 2*EXP(0.843-0.0281*ATCA(NY,NX))*FH2O CCO2Y=LOG(CCO2X) CCO2Z=ABS(CCO2Y) CCO21=CCO2X @@ -1903,21 +1302,23 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) CCO21=CCO21/SQRT(1.0+R) 2120 CONTINUE 2130 CONTINUE - CCH41=CCH4M*SCH4X/(EXP(ACH4X*CSTR1))*EXP(0.597-0.0199*ATCA(NY,NX))*FH2O - COXY1=COXYM*SOXYX/(EXP(AOXYX*CSTR1))*EXP(0.516-0.0172*ATCA(NY,NX))*FH2O - CZ2G1=CZ2GM*SN2GX/(EXP(AN2GX*CSTR1))*EXP(0.456-0.0152*ATCA(NY,NX))*FH2O - CZ2O1=CZ2OM*SN2OX/(EXP(AN2OX*CSTR1))*EXP(0.897-0.0299*ATCA(NY,NX))*FH2O - CN41=CN41+RN4S + CCH41=CCH4M*SCH4X/(EXP(ACH4X*CSTR1)) + 2*EXP(0.597-0.0199*ATCA(NY,NX))*FH2O + COXY1=COXYM*SOXYX/(EXP(AOXYX*CSTR1)) + 2*EXP(0.516-0.0172*ATCA(NY,NX))*FH2O + CZ2G1=CZ2GM*SN2GX/(EXP(AN2GX*CSTR1)) + 2*EXP(0.456-0.0152*ATCA(NY,NX))*FH2O + CZ2O1=CZ2OM*SN2OX/(EXP(AN2OX*CSTR1)) + 2*EXP(0.897-0.0299*ATCA(NY,NX))*FH2O + CN41=CN41+RN4S CN31=CN31+RN3S -C CAL1=CAL1+RAL -C CFE1=CFE1+RFE -C CCA1=CCA1+RCA -C CMG1=CMG1+RMG -C CNA1=CNA1+RNA -C CKA1=CKA1+RKA -C CSO41=CSO41+RSO4 - CHY1=AHY1/A1 - COH1=AOH1/A1 + CAL1=CAL1+RAL + CFE1=CFE1+RFE + CCA1=CCA1+RCA + CMG1=CMG1+RMG + CNA1=CNA1+RNA + CKA1=CKA1+RKA + CSO41=CSO41+RSO4 CCO31=CCO21*DPCO3*A0/(AHY1**2*A2) CHCO31=CCO21*DPCO2*A0/(AHY1*A1) CALO1=CALO1+RAL1 @@ -1957,12 +1358,20 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) C CONVERGE TOWARDS ALL SOLUBILITY EQUILIBRIA C IF SALT OPTION IS NOT SELECTED C - DO 1100 M=1,500 + DO 1100 M=1,100 + CCO21=AMAX1(ZERO,CCO21) + CCO31=CCO21*DPCO3*A0/(CHY1**2*A2) + CHCO31=CCO21*DPCO2*A0/(CHY1*A1) + CN41=AMAX1(ZERO,CN41) + CN31=AMAX1(ZERO,CN31) CAL1=AMAX1(ZERO,CAL1) CFE1=AMAX1(ZERO,CFE1) - CHY1=AHY1/A1 CCA1=AMAX1(ZERO,CCA1) - COH1=AOH1/A1 + CCA1=AMIN1(CCA1,SPCAC/(CCO31*A2**2)) + CMG1=AMAX1(ZERO,CMG1) + CNA1=AMAX1(ZERO,CNA1) + CKA1=AMAX1(ZERO,CKA1) + CH1P1=AMAX1(ZERO,CH1P1) CH2P1=AMAX1(ZERO,CH2P1) C C PRECIPITATION-DISSOLUTION FLUXES @@ -1977,49 +1386,29 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) CH2PH=(SYCAH2/(CCA1**5*COH1**7))**0.333 RPCAHX=AMAX1(-PCAPH1,TPD*(CH2P1-CH2PH)) PALPO1=PALPO1+RPALPX - PFEPO1=PFEPO1+RPFEPX PCAPD1=PCAPD1+RPCADX PCAPH1=PCAPH1+RPCAHX C C ANION EXCHANGE FLUXES C - DCHG=AMAX1(-0.1E+05,XOH21-XOH01-XH1P1) - AEP=EXP(AE*DCHG/TKS(L,NY,NX)) - AEN=EXP(-AE*DCHG/TKS(L,NY,NX)) - SPH2P=SYH2P*DPH2O/(SXOH2*AEP) - X0=XOH21+CH2P1+SPH2P - X1=AMAX1(0.0,X0**2-4.0*(XOH21*CH2P1-SPH2P*XH2P1)) - RXH2P=TAD*0.5*(X0-SQRT(X1)) -C -C H2PO4 EXCHANGE -C - R1=XH2P1 - R2=COH1 - P1=XOH11 - P2=CH2P1 - X=0.0 - TX=0.0 - DO 6010 MM=1,100 - R1=AMAX1(ZERO,R1+X) - P1=AMAX1(ZERO,P1-X) - P2=AMAX1(ZERO,P2-X) - Z=(P1*P2/(R1*R2))/SYH2P - IF(Z.GT.0.95.AND.Z.LT.1.05)GO TO 6110 - Y=AMIN1(R1,P1,P2) - IF(Z.GT.1.0)THEN - X=Y-Y/Z**0.33 + IF(VOLW(L,NY,NX).GT.ZEROS(NY,NX))THEN + VOLWBK=AMIN1(1.0,BKVL(L,NY,NX)/VOLW(L,NY,NX)) ELSE - X=Y*Z**0.33-Y + VOLWBK=1.0 + ENDIF + IF(AEC(L,NY,NX).GT.ZEROS(NY,NX))THEN + SPH2P=SXH2P*DPH2O + RXH2P=TAD*(XOH21*CH2P1-SPH2P*XH2P1)/(XOH21+SPH2P)*VOLWBK + RYH2P=TAD*(XOH11*CH2P1-SXH2P*COH1*XH2P1) + 2/(XOH11+SXH2P*COH1)*VOLWBK + SPH1P=SXH1P*DPH2O/DPH2P + RXH1P=TAD*(XOH11*CH1P1-SPH1P*XH1P1)/(XOH11+SPH1P)*VOLWBK + ELSE + RXH2P=0.0 + RYH2P=0.0 + RXH1P=0.0 ENDIF - TX=TX+X -6010 CONTINUE -6110 CONTINUE - RYH2P=TAD*TX - SPH1P=SYH1P*DPH2O*AEN/DPH2P - X0=XOH11+CH2P1+SPH1P - X1=AMAX1(0.0,X0**2-4.0*(XOH11*CH2P1-SPH1P*XH1P1)) - RXH1P=TAD*0.5*(X0-SQRT(X1)) XOH11=XOH11-RYH2P-RXH1P XOH21=XOH21-RXH2P XH1P1=XH1P1+RXH1P @@ -2027,16 +1416,40 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) C C CATION EXCHANGE C - CHYX=CHY1 - CN4X=CN41 + IF(BKVL(L,NY,NX).GT.ZEROS(NY,NX))THEN + BKVLX=BKVL(L,NY,NX) + ELSE + BKVLX=VOLW(L,NY,NX) + ENDIF + CCEC=AMAX1(ZERO,XCEC(L,NY,NX)/BKVLX) CALX=CAL1**0.333 + CFEX=CFE1**0.333 CCAX=CCA1**0.500 - XCAQ=XCECQ/(1.0+GKC4(L,NY,NX)*CN4X/CCAX+GKCH(L,NY,NX)*CHYX/CCAX - 2+GKCA(L,NY,NX)*CALX/CCAX) - FCAQ=XCAQ/CCAX - FN4Q=FCAQ*GKC4(L,NY,NX) - RXN4=TSL*(FN4Q*CN41-XN4Q)/(1.0+FN4Q) - XN4Q=XN4Q+RXN4 + CMGX=CMG1**0.500 + XCAX=CCEC/(1.0+GKC4(L,NY,NX)*CN41/CCAX + 3+GKCH(L,NY,NX)*CHY1/CCAX+GKCA(L,NY,NX)*CALX/CCAX + 4+GKCA(L,NY,NX)*CFEX/CCAX+GKCM(L,NY,NX)*CMGX/CCAX + 5+GKCN(L,NY,NX)*CNA1/CCAX+GKCK(L,NY,NX)*CKA1/CCAX) + XN4Q=XCAX*CN41*GKC4(L,NY,NX) + XHYQ=XCAX*CHY1*GKCH(L,NY,NX) + XALQ=XCAX*CALX*GKCA(L,NY,NX) + XFEQ=XCAX*CFEX*GKCA(L,NY,NX) + XCAQ=XCAX*CCAX + XMGQ=XCAX*CMGX*GKCM(L,NY,NX) + XNAQ=XCAX*CNA1*GKCN(L,NY,NX) + XKAQ=XCAX*CKA1*GKCK(L,NY,NX) + XTLQ=XN4Q+XHYQ+XALQ+XFEQ+XCAQ+XMGQ+XNAQ+XKAQ + IF(XTLQ.GT.ZERO)THEN + FX=CCEC/XTLQ + ELSE + FX=0.0 + ENDIF + XN4Q=FX*XN4Q + RXN4=TSL*(XN4Q-XN41)*CN41/XN4Q + XN41=XN41+RXN4 +C WRITE(*,2224)'RXN4',NX,NY,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) ELSE RPALPX=0.0 RPFEPX=0.0 @@ -2048,20 +1461,37 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) RXN4=0.0 ENDIF C -C ION SPECIATION +C NH4 – NH3 C S0=CHY1+CN31+DPN4 S1=AMAX1(0.0,S0**2-4.0*(CHY1*CN31-DPN4*CN41)) RNH4=TSL*(S0-SQRT(S1)) C +C H2PO4 – HPO4 +C + S0=CH1P1+CHY1+DPH2P + S1=AMAX1(0.0,S0**2-4.0*(CH1P1*CHY1-DPH2P*CH2P1)) + RH2P=TSL*(S0-SQRT(S1)) +C C ION FLUXES C RN4S=RNH4-RXN4 RN3S=-RNH4 - RHP2=-RXH2P-RYH2P-RXH1P-RPALPX-RPFEPX-RPCADX-3.0*RPCAHX + RHP1=-RXH1P-RH2P + RHP2=-RXH2P-RYH2P+RH2P-RPALPX-RPFEPX-RPCADX-3.0*RPCAHX CN41=CN41+RN4S 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 +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 2,XH2P1,XH1P1,RXH1P,RXH2P,RYH2P,RH2P,CHY1,COH1 +C 3,XOH21,XOH11 +C ENDIF 1100 CONTINUE ENDIF C @@ -2266,6 +1696,8 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) ZNO3B(L,NY,NX)=CNOU(L,NY,NX)*VOLW(L,NY,NX)*VLNOB(L,NY,NX)*14.0 H2PO4(L,NY,NX)=CPOU(L,NY,NX)*VOLW(L,NY,NX)*VLPO4(L,NY,NX)*31.0 H2POB(L,NY,NX)=CPOU(L,NY,NX)*VOLW(L,NY,NX)*VLPOB(L,NY,NX)*31.0 + H1PO4(L,NY,NX)=CH1PU(L,NY,NX)*VOLW(L,NY,NX)*VLPO4(L,NY,NX) + 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 @@ -2305,7 +1737,6 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) ZNAS(L,NY,NX)=CNASU(L,NY,NX)*VOLW(L,NY,NX) ZKAS(L,NY,NX)=CKASU(L,NY,NX)*VOLW(L,NY,NX) H0PO4(L,NY,NX)=CH0PU(L,NY,NX)*VOLW(L,NY,NX)*VLPO4(L,NY,NX) - H1PO4(L,NY,NX)=CH1PU(L,NY,NX)*VOLW(L,NY,NX)*VLPO4(L,NY,NX) H3PO4(L,NY,NX)=CH3PU(L,NY,NX)*VOLW(L,NY,NX)*VLPO4(L,NY,NX) ZFE1P(L,NY,NX)=CF1PU(L,NY,NX)*VOLW(L,NY,NX)*VLPO4(L,NY,NX) ZFE2P(L,NY,NX)=CF2PU(L,NY,NX)*VOLW(L,NY,NX)*VLPO4(L,NY,NX) @@ -2314,7 +1745,6 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) ZCA2P(L,NY,NX)=CC2PU(L,NY,NX)*VOLW(L,NY,NX)*VLPO4(L,NY,NX) ZMG1P(L,NY,NX)=CM1PU(L,NY,NX)*VOLW(L,NY,NX)*VLPO4(L,NY,NX) H0POB(L,NY,NX)=CH0PU(L,NY,NX)*VOLW(L,NY,NX)*VLPOB(L,NY,NX) - H1POB(L,NY,NX)=CH1PU(L,NY,NX)*VOLW(L,NY,NX)*VLPOB(L,NY,NX) H3POB(L,NY,NX)=CH3PU(L,NY,NX)*VOLW(L,NY,NX)*VLPOB(L,NY,NX) ZFE1PB(L,NY,NX)=CF1PU(L,NY,NX)*VOLW(L,NY,NX)*VLPOB(L,NY,NX) ZFE2PB(L,NY,NX)=CF2PU(L,NY,NX)*VOLW(L,NY,NX)*VLPOB(L,NY,NX) @@ -2341,6 +1771,8 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) ZNO2BH(L,NY,NX)=0.0 H2PO4H(L,NY,NX)=0.0 H2POBH(L,NY,NX)=0.0 + H1PO4H(L,NY,NX)=0.0 + H1POBH(L,NY,NX)=0.0 ZALH(L,NY,NX)=0.0 ZFEH(L,NY,NX)=0.0 ZHYH(L,NY,NX)=0.0 @@ -2395,48 +1827,57 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) C C INITIAL STATE VARIABLES FOR EXCHANGEABLE CATIONS AND ANIONS C - XN4(L,NY,NX)=XN4Q*VOLA(L,NY,NX)*VLNH4(L,NY,NX) - XNB(L,NY,NX)=XN4Q*VOLA(L,NY,NX)*VLNHB(L,NY,NX) - XHY(L,NY,NX)=XHYQ*VOLA(L,NY,NX) - XAL(L,NY,NX)=XALQ*VOLA(L,NY,NX)/3.0 - XCA(L,NY,NX)=XCAQ*VOLA(L,NY,NX)*0.50 - XMG(L,NY,NX)=XMGQ*VOLA(L,NY,NX)*0.50 - XNA(L,NY,NX)=XNAQ*VOLA(L,NY,NX) - XKA(L,NY,NX)=XKAQ*VOLA(L,NY,NX) - XHC(L,NY,NX)=XHC1*VOLA(L,NY,NX) - XALO2(L,NY,NX)=XALO21*VOLA(L,NY,NX) - XOH0(L,NY,NX)=XOH01*VOLA(L,NY,NX)*VLPO4(L,NY,NX) - XOH1(L,NY,NX)=XOH11*VOLA(L,NY,NX)*VLPO4(L,NY,NX) - XOH2(L,NY,NX)=XOH21*VOLA(L,NY,NX)*VLPO4(L,NY,NX) - XH1P(L,NY,NX)=XH1P1*VOLA(L,NY,NX)*VLPO4(L,NY,NX) - XH2P(L,NY,NX)=XH2P1*VOLA(L,NY,NX)*VLPO4(L,NY,NX) - XOH0B(L,NY,NX)=XOH01*VOLA(L,NY,NX)*VLPOB(L,NY,NX) - XOH1B(L,NY,NX)=XOH11*VOLA(L,NY,NX)*VLPOB(L,NY,NX) - XOH2B(L,NY,NX)=XOH21*VOLA(L,NY,NX)*VLPOB(L,NY,NX) - XH1PB(L,NY,NX)=XH1P1*VOLA(L,NY,NX)*VLPOB(L,NY,NX) - XH2PB(L,NY,NX)=XH2P1*VOLA(L,NY,NX)*VLPOB(L,NY,NX) + XN4(L,NY,NX)=XN41*BKVL(L,NY,NX)*VLNH4(L,NY,NX) + XNB(L,NY,NX)=XN41*BKVL(L,NY,NX)*VLNHB(L,NY,NX) + XHY(L,NY,NX)=XHY1*BKVL(L,NY,NX) + XAL(L,NY,NX)=XAL1*BKVL(L,NY,NX) + XFE(L,NY,NX)=XFE1*BKVL(L,NY,NX) + XCA(L,NY,NX)=XCA1*BKVL(L,NY,NX) + XMG(L,NY,NX)=XMG1*BKVL(L,NY,NX) + XNA(L,NY,NX)=XNA1*BKVL(L,NY,NX) + XKA(L,NY,NX)=XKA1*BKVL(L,NY,NX) + XHC(L,NY,NX)=XHC1*BKVL(L,NY,NX) + XALO2(L,NY,NX)=XALO21*BKVL(L,NY,NX) + XFEO2(L,NY,NX)=XFEO21*BKVL(L,NY,NX) + XOH0(L,NY,NX)=XOH01*BKVL(L,NY,NX)*VLPO4(L,NY,NX) + XOH1(L,NY,NX)=XOH11*BKVL(L,NY,NX)*VLPO4(L,NY,NX) + XOH2(L,NY,NX)=XOH21*BKVL(L,NY,NX)*VLPO4(L,NY,NX) + XH1P(L,NY,NX)=XH1P1*BKVL(L,NY,NX)*VLPO4(L,NY,NX) + XH2P(L,NY,NX)=XH2P1*BKVL(L,NY,NX)*VLPO4(L,NY,NX) + XOH0B(L,NY,NX)=XOH01*BKVL(L,NY,NX)*VLPOB(L,NY,NX) + XOH1B(L,NY,NX)=XOH11*BKVL(L,NY,NX)*VLPOB(L,NY,NX) + XOH2B(L,NY,NX)=XOH21*BKVL(L,NY,NX)*VLPOB(L,NY,NX) + XH1PB(L,NY,NX)=XH1P1*BKVL(L,NY,NX)*VLPOB(L,NY,NX) + XH2PB(L,NY,NX)=XH2P1*BKVL(L,NY,NX)*VLPOB(L,NY,NX) C C INITIAL STATE VARIABLES FOR PRECIPITATES C - PALOH(L,NY,NX)=PALOH1*VOLA(L,NY,NX) - PFEOH(L,NY,NX)=PFEOH1*VOLA(L,NY,NX) - PCACO(L,NY,NX)=PCACO1*VOLA(L,NY,NX) - PCASO(L,NY,NX)=PCASO1*VOLA(L,NY,NX) - PALPO(L,NY,NX)=PALPO1*VOLA(L,NY,NX) - PFEPO(L,NY,NX)=PFEPO1*VOLA(L,NY,NX) - PCAPD(L,NY,NX)=PCAPD1*VOLA(L,NY,NX) - PCAPH(L,NY,NX)=PCAPH1*VOLA(L,NY,NX) + PALOH(L,NY,NX)=PALOH1*BKVL(L,NY,NX) + PFEOH(L,NY,NX)=PFEOH1*BKVL(L,NY,NX) + PCACO(L,NY,NX)=PCACO1*BKVL(L,NY,NX) + PCASO(L,NY,NX)=PCASO1*BKVL(L,NY,NX) + PALPO(L,NY,NX)=PALPO1*BKVL(L,NY,NX)*VLPO4(L,NY,NX) + PFEPO(L,NY,NX)=PFEPO1*BKVL(L,NY,NX)*VLPO4(L,NY,NX) + PCAPD(L,NY,NX)=PCAPD1*BKVL(L,NY,NX)*VLPO4(L,NY,NX) + PCAPH(L,NY,NX)=PCAPH1*BKVL(L,NY,NX)*VLPO4(L,NY,NX) PCAPM(L,NY,NX)=0.0 - PALPB(L,NY,NX)=PALPOB*VOLA(L,NY,NX) - PFEPB(L,NY,NX)=PFEPOB*VOLA(L,NY,NX) - PCPDB(L,NY,NX)=PCAPDB*VOLA(L,NY,NX) - PCPHB(L,NY,NX)=PCAPHB*VOLA(L,NY,NX) + PALPB(L,NY,NX)=PALPO1*BKVL(L,NY,NX)*VLPOB(L,NY,NX) + PFEPB(L,NY,NX)=PFEPO1*BKVL(L,NY,NX)*VLPOB(L,NY,NX) + PCPDB(L,NY,NX)=PCAPD1*BKVL(L,NY,NX)*VLPOB(L,NY,NX) + PCPHB(L,NY,NX)=PCAPH1*BKVL(L,NY,NX)*VLPOB(L,NY,NX) PCPMB(L,NY,NX)=0.0 ECND(L,NY,NX)=0.0 CSTR(L,NY,NX)=0.0 CION(L,NY,NX)=0.0 ZNH4S(L,NY,NX)=ZNH4S(L,NY,NX)+0.5*OSN(1,2,L,NY,NX) OSN(1,2,L,NY,NX)=OSN(1,2,L,NY,NX)-0.5*OSN(1,2,L,NY,NX) +C IF(K.EQ.3)THEN +C WRITE(*,2222)'XN4F',K,L,XN4(L,NY,NX),XN4Q,BKVL(L,NY,NX) +C 2,VLNH4(L,NY,NX) +C WRITE(*,2222)'XOH2F',K,L,XOH21,XOH11,XOH01,XH2P1,XH1P1,XOH,XPT +C 2,CH3P1,CH2P1,CH1P1,CH0P1,AHY1,XHP,FHP3,FHP2,FHP1,FHP0 +C 3,FXP2,FXP1,PALPO1,PFEPO1,PCAPD1,PCAPH1 +C ENDIF ENDIF 2000 CONTINUE 1200 CONTINUE @@ -2449,12 +1890,15 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) ZNO3S(0,NY,NX)=0.0 ZNO2S(0,NY,NX)=0.0 H2PO4(0,NY,NX)=0.0 + H1PO4(0,NY,NX)=0.0 ZNH4B(0,NY,NX)=0.0 ZNH3B(0,NY,NX)=0.0 ZNO3B(0,NY,NX)=0.0 ZNO2B(0,NY,NX)=0.0 H2POB(0,NY,NX)=0.0 + H1POB(0,NY,NX)=0.0 XN4(0,NY,NX)=0.0 + XNB(0,NY,NX)=0.0 XOH0(0,NY,NX)=0.0 XOH1(0,NY,NX)=0.0 XOH2(0,NY,NX)=0.0 @@ -2488,6 +1932,7 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) ZN4W(NY,NX)=VOLWW*CN4R(NY,NX)*14.0 ZN3W(NY,NX)=VOLWW*CN3R(NY,NX)*14.0 ZNOW(NY,NX)=VOLWW*CNOR(NY,NX)*14.0 + Z1PW(NY,NX)=VOLWW*CH1PR(NY,NX)*31.0 ZHPW(NY,NX)=VOLWW*CPOR(NY,NX)*31.0 C C INITIAL STATE VARIABLES FOR CATIONS AND ANIONS IN SNOWPACK @@ -2527,7 +1972,6 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) ZNASW(NY,NX)=VOLWW*CNASR(NY,NX) ZKASW(NY,NX)=VOLWW*CKASR(NY,NX) H0PO4W(NY,NX)=VOLWW*CH0PR(NY,NX) - H1PO4W(NY,NX)=VOLWW*CH1PR(NY,NX) H3PO4W(NY,NX)=VOLWW*CH3PR(NY,NX) ZFE1PW(NY,NX)=VOLWW*CF1PR(NY,NX) ZFE2PW(NY,NX)=VOLWW*CF2PR(NY,NX) @@ -2541,3 +1985,6 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) 9995 CONTINUE RETURN END + + + diff --git a/f77src/startq.f b/f77src/startq.f index 91c0e56..b718eee 100755 --- a/f77src/startq.f +++ b/f77src/startq.f @@ -590,6 +590,7 @@ SUBROUTINE startq(NHWQ,NHEQ,NVNQ,NVSQ,NZ1Q,NZ2Q) UPNH4(NZ,NY,NX)=0.0 UPNO3(NZ,NY,NX)=0.0 UPH2P(NZ,NY,NX)=0.0 + UPH1P(NZ,NY,NX)=0.0 UPNF(NZ,NY,NX)=0.0 DO 40 N=1,2 DO 20 L=1,NL(NY,NX) diff --git a/f77src/starts.f b/f77src/starts.f index 4bd1ba2..f563a4a 100755 --- a/f77src/starts.f +++ b/f77src/starts.f @@ -1,1228 +1,1257 @@ - - SUBROUTINE starts(NHW,NHE,NVN,NVS) -C -C THIS SUBROUTINE INITIALIZES ALL SOIL VARIABLES -C - include "parameters.h" - include "blkc.h" - include "blk2a.h" - include "blk2b.h" - include "blk2c.h" - include "blk5.h" - include "blk8a.h" - include "blk8b.h" - include "blk11a.h" - include "blk11b.h" - include "blk13a.h" - include "blk13b.h" - include "blk13c.h" - include "blk16.h" - include "blk18a.h" - include "blk18b.h" - DIMENSION YSIN(4),YCOS(4),YAZI(4),ZAZI(4),OSCI(0:4),OSNI(0:4) - 2,ORCI(2,0:4),OSPI(0:4),OSCM(0:4),CORGCX(0:4) - 3,CORGNX(0:4),CORGPX(0:4),CNOSCT(0:4),CPOSCT(0:4) - 4,GSINA(JY,JX),GCOSA(JY,JX),ALTX(JV,JH) - 5,OSCX(0:4),OSNX(0:4),OSPX(0:4),OMCK(0:4),ORCK(0:4),OQCK(0:4) - 6,OHCK(0:4),TOSCK(0:4),TOSNK(0:4),TOSPK(0:4),TORGL(JZ) - PARAMETER (OQKM=12.0,DCKR=0.25,DCKM=2.5E+04,PSIPS=-0.5E-03) - DATA OMCI/0.005,0.050,0.005,0.050,0.050,0.005,0.050,0.050,0.005 - 2,0.005,0.050,0.005,0.005,0.050,0.005/ - DATA ORCI/0.01,0.05,0.01,0.05,0.01,0.05 - 2,0.001,0.005,0.001,0.005/ - DATA OMCK/0.01,0.01,0.01,0.01,0.01/ - DATA ORCK/0.25,0.25,0.25,0.25,0.25/ - DATA OQCK/0.005,0.005,0.005,0.005,0.005/ - DATA OHCK/0.05,0.05,0.05,0.05,0.05/ - DATA OMCF/0.20,0.20,0.30,0.20,0.050,0.025,0.025/ - DATA OMCA/0.06,0.02,0.01,0.0,0.01,0.0,0.0/ - DATA CNRH/3.33E-02,3.33E-02,3.33E-02,5.00E-02,12.50E-02/ - 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/ - NDIM=1 - IF(NHE.GT.NHW)NDIM=NDIM+1 - IF(NVS.GT.NVN)NDIM=NDIM+1 - XDIM=1.0/NDIM - ZERO=1.0E-16 - TAREA=0.0 - THETX=2.5E-03 -C -C INITIALIZE MASS BALANCE CHECKS -C - CRAIN=0.0 - HEATIN=0.0 - CO2GIN=0.0 - OXYGIN=0.0 - TZIN=0.0 - ZN2GIN=0.0 - TPIN=0.0 - TORGF=0.0 - TORGN=0.0 - TORGP=0.0 - TFERTN=0.0 - TFERTP=0.0 - VOLWOU=0.0 - CEVAP=0.0 - CRUN=0.0 - HEATOU=0.0 - OXYGOU=0.0 - TSEDOU=0.0 - TCOU=0.0 - TZOU=0.0 - TPOU=0.0 - XCSN=0.0 - XZSN=0.0 - XPSN=0.0 - TIONIN=0.0 - TIONOU=0.0 - VAP=2465.0 - VAPW=2834.0 - OXKM=0.064 - TYSIN=0.0 - ZSIN(1)=0.195 - ZSIN(2)=0.556 - ZSIN(3)=0.831 - ZSIN(4)=0.981 - ZCOS(1)=0.981 - ZCOS(2)=0.831 - ZCOS(3)=0.556 - ZCOS(4)=0.195 - DO 205 L=1,4 - ZAZI(L)=(L-0.5)*3.1416/4.0 -205 CONTINUE - DO 230 N=1,4 - YAZI(N)=3.1416*(2*N-1)/4.0 - YAGL=3.1416/4.0 - YSIN(N)=SIN(YAGL) - YCOS(N)=COS(YAGL) - TYSIN=TYSIN+YSIN(N) - DO 225 L=1,4 - DAZI=COS(ZAZI(L)-YAZI(N)) - DO 225 M=1,4 - OMEGY=ZCOS(M)*YSIN(N)+ZSIN(M)*YCOS(N)*DAZI - OMEGA(N,M,L)=ABS(OMEGY) - OMEGX(N,M,L)=OMEGA(N,M,L)/YSIN(N) - IF(ZCOS(M).GT.YSIN(N))THEN - OMEGZ=ACOS(OMEGY) - ELSE - OMEGZ=-ACOS(OMEGY) - ENDIF - IF(OMEGZ.GT.-1.5708)THEN - ZAGL=YAGL+2.0*OMEGZ - ELSE - ZAGL=YAGL-2.0*(3.1416+OMEGZ) - ENDIF - IF(ZAGL.GT.0.0.AND.ZAGL.LT.3.1416)THEN - IALBY(N,M,L)=1 - ELSE - IALBY(N,M,L)=2 - ENDIF -225 CONTINUE -230 CONTINUE -C -C INITIALIZE C-N AND C-P RATIOS OF RESIDUE AND SOIL -C - CNOFC(1,0)=0.005 - CNOFC(2,0)=0.005 - CNOFC(3,0)=0.005 - CNOFC(4,0)=0.020 - CPOFC(1,0)=0.0005 - CPOFC(2,0)=0.0005 - CPOFC(3,0)=0.0005 - CPOFC(4,0)=0.0020 - CNOFC(1,1)=0.020 - CNOFC(2,1)=0.020 - CNOFC(3,1)=0.020 - CNOFC(4,1)=0.020 - CPOFC(1,1)=0.0020 - CPOFC(2,1)=0.0020 - CPOFC(3,1)=0.0020 - CPOFC(4,1)=0.0020 - CNOFC(1,2)=0.005 - CNOFC(2,2)=0.005 - CNOFC(3,2)=0.005 - CNOFC(4,2)=0.020 - CPOFC(1,2)=0.0005 - CPOFC(2,2)=0.0005 - CPOFC(3,2)=0.0005 - CPOFC(4,2)=0.0020 - FL(1)=0.55 - FL(2)=0.45 - DO 95 K=0,5 - DO 95 N=1,7 - IF(K.LE.4.AND.N.EQ.3)THEN - CNOMC(1,N,K)=0.15 - CNOMC(2,N,K)=0.09 - CPOMC(1,N,K)=0.015 - CPOMC(2,N,K)=0.009 - ELSE - CNOMC(1,N,K)=0.225 - CNOMC(2,N,K)=0.135 - CPOMC(1,N,K)=0.0225 - CPOMC(2,N,K)=0.0135 - ENDIF - CNOMC(3,N,K)=FL(1)*CNOMC(1,N,K)+FL(2)*CNOMC(2,N,K) - CPOMC(3,N,K)=FL(1)*CPOMC(1,N,K)+FL(2)*CPOMC(2,N,K) -95 CONTINUE -C -C CALCULATE ELEVATION OF EACH GRID CELL -C - ALTY=0.0 - DO 9985 NX=NHW,NHE - DO 9980 NY=NVN,NVS - ZEROS(NY,NX)=ZERO*DH(NY,NX)*DV(NY,NX) - GAZI(NY,NX)=ASP(NY,NX)/57.29577951 - GSINA(NY,NX)=ABS(SIN(GAZI(NY,NX))) - GCOSA(NY,NX)=ABS(COS(GAZI(NY,NX))) - GSIN(NY,NX)=SIN(SL(1,NY,NX)/57.29577951)*GCOSA(NY,NX) - 2+SIN(SL(2,NY,NX)/57.29577951)*GSINA(NY,NX) - GCOS(NY,NX)=SQRT(1.0-GSIN(NY,NX)**2) - DO 240 N=1,4 - DGAZI=COS(GAZI(NY,NX)-YAZI(N)) - OMEGAG(N,NY,NX)=AMAX1(0.0,AMIN1(1.0,GCOS(NY,NX)*YSIN(N) - 2+GSIN(NY,NX)*YCOS(N)*DGAZI)) -240 CONTINUE - IF(ASP(NY,NX).GT.90.0.AND.ASP(NY,NX).LT.270.0)THEN - SLOPE(1,NY,NX)=SIN(SL(1,NY,NX)/57.29577951) - ELSE - SLOPE(1,NY,NX)=-SIN(SL(1,NY,NX)/57.29577951) - ENDIF - IF(ASP(NY,NX).GT.0.0.AND.ASP(NY,NX).LT.180.0)THEN - SLOPE(2,NY,NX)=SIN(SL(2,NY,NX)/57.29577951) - ELSE - SLOPE(2,NY,NX)=-SIN(SL(2,NY,NX)/57.29577951) - ENDIF - SLOPE(3,NY,NX)=-1.0 - IF(NX.EQ.NHW)THEN - IF(NY.EQ.NVN)THEN - ALT(NY,NX)=0.5*DH(NY,NX)*SLOPE(1,NY,NX) - 2+0.5*DV(NY,NX)*SLOPE(2,NY,NX) - ELSE - ALT(NY,NX)=ALT(NY-1,NX) - 2+0.5*DH(NY,NX)*SLOPE(1,NY,NX) - 4+0.5*DV(NY,NX)*(SLOPE(2,NY,NX)) - 5+0.5*DV(NY-1,NX)*SLOPE(2,NY-1,NX) - ENDIF - ELSE - IF(NY.EQ.NVN)THEN - ALT(NY,NX)=ALT(NY,NX-1) - 2+0.5*DH(NY,NX)*SLOPE(1,NY,NX) - 3+0.5*DH(NY,NX-1)*SLOPE(1,NY,NX-1) - ELSE - ALT(NY,NX)=(ALT(NY,NX-1) - 2+0.5*DH(NY,NX)*SLOPE(1,NY,NX) - 3+0.5*DH(NY,NX-1)*SLOPE(1,NY,NX-1) - 4+ALT(NY-1,NX) - 4+0.5*DV(NY,NX)*SLOPE(2,NY,NX) - 5+0.5*DV(NY-1,N)*SLOPE(2,NY-1,NX))/2.0 - ENDIF - ENDIF - IF(NX.EQ.NHW.AND.NY.EQ.NVN)THEN - ALTY=ALT(NY,NX) - 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) -1111 FORMAT(A8,2I4,20E12.4) -9980 CONTINUE -9985 CONTINUE -C -C INITIALIZE ACCUMULATORS AND MASS BALANCE CHECKS -C OF EACH GRID CELL -C - ALTZG=0.0 - CDPTHG=0.0 - DO 9995 NX=NHW,NHE - DO 9990 NY=NVN,NVS - DO 600 N=1,12 - TDTPX(NY,NX,N)=0.0 - TDTPN(NY,NX,N)=0.0 - TDRAD(NY,NX,N)=1.0 - TDWND(NY,NX,N)=1.0 - TDHUM(NY,NX,N)=1.0 - TDPRC(NY,NX,N)=1.0 - TDIRI(NY,NX,N)=1.0 - TDCO2(NY,NX,N)=1.0 - TDCN4(NY,NX,N)=1.0 - TDCNO(NY,NX,N)=1.0 -600 CONTINUE - IUTYP(NY,NX)=0 - IFNHB(NY,NX)=0 - IFNOB(NY,NX)=0 - IFPOB(NY,NX)=0 - IFLGS(NY,NX)=1 - IFLGT(NY,NX)=0 - ATCA(NY,NX)=ATCAI(NY,NX) - ATCS(NY,NX)=ATCAI(NY,NX) - ATKA(NY,NX)=ATCA(NY,NX)+273.15 - ATKS(NY,NX)=ATCS(NY,NX)+273.15 - URAIN(NY,NX)=0.0 - UCO2G(NY,NX)=0.0 - UCH4G(NY,NX)=0.0 - UOXYG(NY,NX)=0.0 - UN2GG(NY,NX)=0.0 - UN2OG(NY,NX)=0.0 - UNH3G(NY,NX)=0.0 - UN2GS(NY,NX)=0.0 - UCO2F(NY,NX)=0.0 - UCH4F(NY,NX)=0.0 - UOXYF(NY,NX)=0.0 - UN2OF(NY,NX)=0.0 - UNH3F(NY,NX)=0.0 - UPO4F(NY,NX)=0.0 - UORGF(NY,NX)=0.0 - UFERTN(NY,NX)=0.0 - UFERTP(NY,NX)=0.0 - UVOLO(NY,NX)=0.0 - UEVAP(NY,NX)=0.0 - URUN(NY,NX)=0.0 - USEDOU(NY,NX)=0.0 - UCOP(NY,NX)=0.0 - UDOCQ(NY,NX)=0.0 - UDOCD(NY,NX)=0.0 - UDONQ(NY,NX)=0.0 - UDOND(NY,NX)=0.0 - UDOPQ(NY,NX)=0.0 - UDOPD(NY,NX)=0.0 - UDICQ(NY,NX)=0.0 - UDICD(NY,NX)=0.0 - UDINQ(NY,NX)=0.0 - UDIND(NY,NX)=0.0 - UDIPQ(NY,NX)=0.0 - UDIPD(NY,NX)=0.0 - UIONOU(NY,NX)=0.0 - UXCSN(NY,NX)=0.0 - UXZSN(NY,NX)=0.0 - UXPSN(NY,NX)=0.0 - UDRAIN(NY,NX)=0.0 - ZDRAIN(NY,NX)=0.0 - PDRAIN(NY,NX)=0.0 - DPNH4(NY,NX)=0.0 - DPNO3(NY,NX)=0.0 - DPPO4(NY,NX)=0.0 - TCS(0,NY,NX)=ATCS(NY,NX) - TKS(0,NY,NX)=TCS(0,NY,NX)+273.15 - OXYS(0,NY,NX)=0.0 - FRADG(NY,NX)=1.0 - THRMG(NY,NX)=0.0 - THRMC(NY,NX)=0.0 - TRN(NY,NX)=0.0 - TLE(NY,NX)=0.0 - TSH(NY,NX)=0.0 - TGH(NY,NX)=0.0 - TLEC(NY,NX)=0.0 - TSHC(NY,NX)=0.0 - TLEX(NY,NX)=0.0 - TSHX(NY,NX)=0.0 - TCNET(NY,NX)=0.0 - TVOLWC(NY,NX)=0.0 - ARLFC(NY,NX)=0.0 - ARSTC(NY,NX)=0.0 - TFLWC(NY,NX)=0.0 - PPT(NY,NX)=0.0 - DYLN(NY,NX)=12.0 - DENS0(NY,NX)=0.100 - DENS1(NY,NX)=1.0 - VOLSS(NY,NX)=DPTHS(NY,NX)*DENS0(NY,NX)*DH(NY,NX)*DV(NY,NX) - VOLWS(NY,NX)=0.0 - VOLIS(NY,NX)=0.0 - VOLS(NY,NX)=VOLSS(NY,NX)/DENS0(NY,NX)+VOLWS(NY,NX)+VOLIS(NY,NX) - DPTHA(NY,NX)=9999.0 - TCW(NY,NX)=0.0 - TKW(NY,NX)=TCW(NY,NX)+273.15 - ALBX(NY,NX)=ALBS(NY,NX) - XHVSTC(NY,NX)=0.0 - XHVSTN(NY,NX)=0.0 - XHVSTP(NY,NX)=0.0 - ALT(NY,NX)=ALT(NY,NX)-ALTY - IF(NX.EQ.NHW.AND.NY.EQ.NVN)THEN - ALTZG=ALT(NY,NX) - ELSE - ALTZG=MIN(ALTZG,ALT(NY,NX)) - ENDIF - CDPTHG=AMAX1(CDPTHG,CDPTH(NU(NY,NX),NY,NX)) -C -C INITIALIZE ATMOSPHERE VARIABLES -C - CCO2EI(NY,NX)=CO2EI(NY,NX)*5.36E-04*273.15/ATKA(NY,NX) - CCO2E(NY,NX)=CO2E(NY,NX)*5.36E-04*273.15/ATKA(NY,NX) - CCH4E(NY,NX)=CH4E(NY,NX)*5.36E-04*273.15/ATKA(NY,NX) - COXYE(NY,NX)=OXYE(NY,NX)*1.43E-03*273.15/ATKA(NY,NX) - CZ2GE(NY,NX)=Z2GE(NY,NX)*1.25E-03*273.15/ATKA(NY,NX) - CZ2OE(NY,NX)=Z2OE(NY,NX)*1.25E-03*273.15/ATKA(NY,NX) - CNH3E(NY,NX)=ZNH3E(NY,NX)*6.25E-04*273.15/ATKA(NY,NX) - CH2GE(NY,NX)=H2GE(NY,NX)*8.92E-05*273.15/ATKA(NY,NX) -C -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) -2222 FORMAT(A8,2E12.4) -C -C CALCULATE WHETHER BOUNDARY SLOPES ALLOW RUNOFF -C - DO 9575 N=1,2 - DO 9575 NN=1,2 - IF(N.EQ.1)THEN - IF(NN.EQ.1)THEN - IF(NX.EQ.NHE)THEN - IF(ASP(NY,NX).GT.90.0.AND.ASP(NY,NX).LT.270.0 - 2.AND.SL(2,NY,NX).GT.0.0)THEN - IRCHG(NN,N,NY,NX)=0 - ELSE - IRCHG(NN,N,NY,NX)=1 - ENDIF - ELSE - GO TO 9575 - ENDIF - ELSEIF(NN.EQ.2)THEN - IF(NX.EQ.NHW)THEN - IF(ASP(NY,NX).LT.90.0.OR.ASP(NY,NX).GT.270.0 - 2.AND.SL(2,NY,NX).GT.0.0)THEN - IRCHG(NN,N,NY,NX)=0 - ELSE - IRCHG(NN,N,NY,NX)=1 - ENDIF - ELSE - GO TO 9575 - ENDIF - ENDIF - ELSEIF(N.EQ.2)THEN - IF(NN.EQ.1)THEN - IF(NY.EQ.NVS)THEN - IF(ASP(NY,NX).LT.180.0.AND.ASP(NY,NX).GT.0.0 - 2.AND.SL(1,NY,NX).GT.0.0)THEN - IRCHG(NN,N,NY,NX)=0 - ELSE - IRCHG(NN,N,NY,NX)=1 - ENDIF - ELSE - GO TO 9575 - ENDIF - ELSEIF(NN.EQ.2)THEN - IF(NY.EQ.NVN)THEN - IF(ASP(NY,NX).EQ.0)THEN - ASP2=360.0 - ELSE - ASP2=ASP(NY,NX) - ENDIF - IF(ASP2.GT.180.0.AND.ASP2.LT.360.0 - 2.AND.SL(1,NY,NX).GT.0.0)THEN - IRCHG(NN,N,NY,NX)=0 - ELSE - IRCHG(NN,N,NY,NX)=1 - ENDIF - ELSE - GO TO 9575 - ENDIF - ENDIF - ENDIF -9575 CONTINUE -C -C INITIALIZE WATER AND TEMPERATURE VARIABLES FOR SOIL LAYERS -C - PSIMS(NY,NX)=LOG(-PSIPS) - PSIMX(NY,NX)=LOG(-PSIFC(NY,NX)) - PSIMN(NY,NX)=LOG(-PSIWP(NY,NX)) - PSISD(NY,NX)=PSIMX(NY,NX)-PSIMS(NY,NX) - PSIMD(NY,NX)=PSIMN(NY,NX)-PSIMX(NY,NX) - NW(NY,NX)=0 - CORGC(0,NY,NX)=0.5E+06 -C -C DISTRIBUTION OF OM AMONG FRACTIONS OF DIFFERING -C BIOLOGICAL ACTIVITY -C - DO 1195 L=0,NL(NY,NX) -C -C LAYER DEPTHS AND THEIR PHYSICAL PROPOERTIES -C - DLYR(1,L,NY,NX)=DH(NY,NX) - DLYR(2,L,NY,NX)=DV(NY,NX) - AREA(3,L,NY,NX)=DLYR(1,L,NY,NX)*DLYR(2,L,NY,NX) - IF(L.EQ.0)THEN - TAREA=TAREA+AREA(3,L,NY,NX) - CDPTH(L,NY,NX)=0.0 - CDPTHZ(L,NY,NX)=0.0 - ORGC(L,NY,NX)=(RSC(0,L,NY,NX)+RSC(1,L,NY,NX)+RSC(2,L,NY,NX)) - 2*AREA(3,L,NY,NX) - VOLR(NY,NX)=(RSC(0,L,NY,NX)*1.0E-06/BKRS(0) - 2+RSC(1,L,NY,NX)*1.0E-06/BKRS(1)+RSC(2,L,NY,NX)*1.0E-06/BKRS(2)) - 2*AREA(3,L,NY,NX) - VOLT(L,NY,NX)=VOLR(NY,NX) - VOLX(L,NY,NX)=VOLT(L,NY,NX) - BKVL(L,NY,NX)=2.00E-06*ORGC(L,NY,NX) - DLYR(3,L,NY,NX)=VOLX(L,NY,NX)/AREA(3,L,NY,NX) - ELSE - DLYR(3,L,NY,NX)=(CDPTH(L,NY,NX)-CDPTH(L-1,NY,NX)) - DPTH(L,NY,NX)=0.5*(CDPTH(L,NY,NX)+CDPTH(L-1,NY,NX)) - CDPTHZ(L,NY,NX)=CDPTH(L,NY,NX)-CDPTH(NU(NY,NX),NY,NX) - 2+DLYR(3,NU(NY,NX),NY,NX) - DPTHZ(L,NY,NX)=0.5*(CDPTHZ(L,NY,NX)+CDPTHZ(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) - BKVL(L,NY,NX)=BKDS(L,NY,NX)*VOLX(L,NY,NX) - YDPTH(L,NY,NX)=ALT(NY,NX)-DPTH(L,NY,NX) - RTDNT(L,NY,NX)=0.0 - IF(BKDS(L,NY,NX).GT.0.0.AND.NW(NY,NX).EQ.0)NW(NY,NX)=L - ENDIF - AREA(1,L,NY,NX)=DLYR(3,L,NY,NX)*DLYR(2,L,NY,NX) - AREA(2,L,NY,NX)=DLYR(3,L,NY,NX)*DLYR(1,L,NY,NX) -1195 CONTINUE -C -C SURFACE WATER STORAGE AND LOWER HEAT SINK -C - ZS(NY,NX)=0.025 - DS=AMAX1(0.0,0.112*ZS(NY,NX)+3.10*ZS(NY,NX)**2 - 2-0.012*ZS(NY,NX)*GSIN(NY,NX)) - VOLWG(NY,NX)=VOLA(NU(NY,NX),NY,NX)+VOLAH(NU(NY,NX),NY,NX) - 2+DS*AREA(3,NU(NY,NX),NY,NX) - VHCPW(NY,NX)=2.095*VOLSS(NY,NX)+4.19*VOLWS(NY,NX) - 2+1.9274*VOLIS(NY,NX) - VHCPWX(NY,NX)=10.5E-03*AREA(3,NU(NY,NX),NY,NX) - VHCPRX(NY,NX)=10.5E-05*AREA(3,NU(NY,NX),NY,NX) - DPTHSK(NY,NX)=AMAX1(10.0,CDPTH(NL(NY,NX),NY,NX)+1.0) - TCNDG=8.1E-03 - TKSD(NY,NX)=ATKS(NY,NX)+2.052E-04*DPTHSK(NY,NX)/TCNDG -C -C INITIALIZE COMMUNITY CANOPY -C - ZT(NY,NX)=0.0 - ZL(0,NY,NX)=0.0 - DO 1925 L=1,JC - ZL(L,NY,NX)=0.0 - ARLFT(L,NY,NX)=0.0 - ARSTT(L,NY,NX)=0.0 - WGLFT(L,NY,NX)=0.0 -1925 CONTINUE -9990 CONTINUE -9995 CONTINUE -C -C INITIALIZE GRID CELL DIMENSIONS -C - DO 9895 NX=NHW,NHE - DO 9890 NY=NVN,NVS - ALTZ(NY,NX)=ALTZG - IF(BKDS(NU(NY,NX),NY,NX).GT.0.0)THEN - DTBLZ(NY,NX)=DTBLI(NY,NX)-(ALTZ(NY,NX)-ALT(NY,NX)) - 2*(1.0-DTBLG(NY,NX)) - DDRG(NY,NX)=AMAX1(0.0,DDRGI(NY,NX)-(ALTZ(NY,NX)-ALT(NY,NX)) - 2*(1.0-DTBLG(NY,NX))) - ELSE - DTBLZ(NY,NX)=0.0 - DDRG(NY,NX)=0.0 - ENDIF - DPTHT(NY,NX)=DTBLZ(NY,NX) - DO 4400 L=1,NL(NY,NX) - N1=NX - N2=NY - N3=L - DO 4320 N=NCN(N2,N1),3 - IF(N.EQ.1)THEN - IF(NX.EQ.NHE)THEN - GO TO 4320 - ELSE - N4=NX+1 - N5=NY - N6=L - ENDIF - ELSEIF(N.EQ.2)THEN - IF(NY.EQ.NVS)THEN - GO TO 4320 - ELSE - N4=NX - N5=NY+1 - N6=L - ENDIF - ELSEIF(N.EQ.3)THEN - IF(L.EQ.NL(NY,NX))THEN - GO TO 4320 - ELSE - N4=NX - N5=NY - N6=L+1 - ENDIF - ENDIF - DIST(N,N6,N5,N4)=0.5*(DLYR(N,N3,N2,N1)+DLYR(N,N6,N5,N4)) - XDPTH(N,N6,N5,N4)=AREA(N,N3,N2,N1)/DIST(N,N6,N5,N4) - DISP(N,N6,N5,N4)=0.20*DIST(N,N6,N5,N4)**1.07 -4320 CONTINUE - IF(L.EQ.NU(NY,NX))THEN - DIST(3,N3,N2,N1)=0.5*DLYR(3,N3,N2,N1) - XDPTH(3,N3,N2,N1)=AREA(3,N3,N2,N1)/DIST(3,N3,N2,N1) - DISP(3,N3,N2,N1)=0.20*DIST(3,N3,N2,N1)**1.07 - ENDIF -4400 CONTINUE -C -C INITIALIZE SOM FROM ORGANIC INPUTS IN SOIL FILE FROM 'READS' -C - TORGC=0.0 - DO 1190 L=NU(NY,NX),NL(NY,NX) - CORGCZ=CORGC(L,NY,NX) - CORGRZ=CORGR(L,NY,NX) - CORGNZ=CORGN(L,NY,NX) - CORGPZ=CORGP(L,NY,NX) - CORGCX(3)=CORGRZ - CORGCX(4)=AMAX1(0.0,CORGCZ-CORGCX(3)) - CORGNX(3)=AMIN1(CNRH(3)*CORGCX(3),CORGNZ) - CORGNX(4)=AMAX1(0.0,CORGNZ-CORGNX(3)) - CORGPX(3)=AMIN1(CPRH(3)*CORGCX(3),CORGPZ) - CORGPX(4)=AMAX1(0.0,CORGPZ-CORGPX(3)) - CORGL=AMAX1(0.0,CORGC(L,NY,NX)-CORGR(L,NY,NX)) - 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))) - IF(TORGM.GT.ZERO)THEN - HCX=LOG(0.5)/TORGM - ELSE - HCX=0.0 - ENDIF - DO 1200 L=0,NL(NY,NX) - IF(BKVL(L,NY,NX).GT.0.0)THEN - CORGCX(0)=RSC(0,L,NY,NX)*AREA(3,L,NY,NX)/BKVL(L,NY,NX) - CORGCX(1)=RSC(1,L,NY,NX)*AREA(3,L,NY,NX)/BKVL(L,NY,NX) - CORGCX(2)=RSC(2,L,NY,NX)*AREA(3,L,NY,NX)/BKVL(L,NY,NX) - CORGNX(0)=RSN(0,L,NY,NX)*AREA(3,L,NY,NX)/BKVL(L,NY,NX) - CORGNX(1)=RSN(1,L,NY,NX)*AREA(3,L,NY,NX)/BKVL(L,NY,NX) - CORGNX(2)=RSN(2,L,NY,NX)*AREA(3,L,NY,NX)/BKVL(L,NY,NX) - CORGPX(0)=RSP(0,L,NY,NX)*AREA(3,L,NY,NX)/BKVL(L,NY,NX) - CORGPX(1)=RSP(1,L,NY,NX)*AREA(3,L,NY,NX)/BKVL(L,NY,NX) - CORGPX(2)=RSP(2,L,NY,NX)*AREA(3,L,NY,NX)/BKVL(L,NY,NX) - ELSE - CORGCX(0)=0.5E+06 - CORGCX(1)=0.5E+06 - CORGCX(2)=0.5E+06 - CORGNX(0)=0.5E+05 - CORGNX(1)=0.5E+05 - CORGNX(2)=0.5E+05 - CORGPX(0)=0.5E+04 - CORGPX(1)=0.5E+04 - CORGPX(2)=0.5E+04 - ENDIF - IF(L.GT.0)THEN - CORGCZ=CORGC(L,NY,NX) - CORGRZ=CORGR(L,NY,NX) - CORGNZ=CORGN(L,NY,NX) - CORGPZ=CORGP(L,NY,NX) - IF(CORGCZ.GT.ZERO)THEN - CORGCX(3)=CORGRZ - CORGCX(4)=AMAX1(0.0,CORGCZ-CORGCX(3)) - CORGNX(3)=AMIN1(CNRH(3)*CORGCX(3),CORGNZ) - CORGNX(4)=AMAX1(0.0,CORGNZ-CORGNX(3)) - CORGPX(3)=AMIN1(CPRH(3)*CORGCX(3),CORGPZ) - CORGPX(4)=AMAX1(0.0,CORGPZ-CORGPX(3)) - ELSE - CORGCX(3)=0.0 - CORGCX(4)=0.0 - CORGNX(3)=0.0 - CORGNX(4)=0.0 - CORGPX(3)=0.0 - CORGPX(4)=0.0 - ENDIF - ELSE - CORGCX(3)=0.0 - CORGCX(4)=0.0 - CORGNX(3)=0.0 - CORGNX(4)=0.0 - CORGPX(3)=0.0 - CORGPX(4)=0.0 - ENDIF -C -C SURFACE RESIDUE -C - IF(L.EQ.0)THEN -C -C PREVIOUS COARSE WOODY RESIDUE -C - CFOSC(1,0,L,NY,NX)=0.000 - CFOSC(2,0,L,NY,NX)=0.045 - CFOSC(3,0,L,NY,NX)=0.660 - CFOSC(4,0,L,NY,NX)=0.295 -C -C MAIZE -C - IF(IXTYP(1,NY,NX).EQ.1)THEN - CFOSC(1,1,L,NY,NX)=0.080 - CFOSC(2,1,L,NY,NX)=0.245 - CFOSC(3,1,L,NY,NX)=0.613 - CFOSC(4,1,L,NY,NX)=0.062 -C -C WHEAT -C - ELSEIF(IXTYP(1,NY,NX).EQ.2)THEN - CFOSC(1,1,L,NY,NX)=0.125 - CFOSC(2,1,L,NY,NX)=0.171 - CFOSC(3,1,L,NY,NX)=0.560 - CFOSC(4,1,L,NY,NX)=0.144 -C -C SOYBEAN -C - ELSEIF(IXTYP(1,NY,NX).EQ.3)THEN - CFOSC(1,1,L,NY,NX)=0.138 - CFOSC(2,1,L,NY,NX)=0.426 - CFOSC(3,1,L,NY,NX)=0.316 - CFOSC(4,1,L,NY,NX)=0.120 -C -C NEW STRAW -C - ELSEIF(IXTYP(1,NY,NX).EQ.4)THEN - CFOSC(1,1,L,NY,NX)=0.036 - CFOSC(2,1,L,NY,NX)=0.044 - CFOSC(3,1,L,NY,NX)=0.767 - CFOSC(4,1,L,NY,NX)=0.153 -C -C OLD STRAW -C - ELSEIF(IXTYP(1,NY,NX).EQ.5)THEN - CFOSC(1,1,L,NY,NX)=0.075 - CFOSC(2,1,L,NY,NX)=0.125 - CFOSC(3,1,L,NY,NX)=0.550 - CFOSC(4,1,L,NY,NX)=0.250 -C -C COMPOST -C - ELSEIF(IXTYP(1,NY,NX).EQ.6)THEN - CFOSC(1,1,L,NY,NX)=0.143 - CFOSC(2,1,L,NY,NX)=0.015 - CFOSC(3,1,L,NY,NX)=0.640 - CFOSC(4,1,L,NY,NX)=0.202 -C -C GREEN MANURE -C - ELSEIF(IXTYP(1,NY,NX).EQ.7)THEN - CFOSC(1,1,L,NY,NX)=0.202 - CFOSC(2,1,L,NY,NX)=0.013 - CFOSC(3,1,L,NY,NX)=0.560 - CFOSC(4,1,L,NY,NX)=0.225 -C -C NEW DECIDUOUS FOREST -C - ELSEIF(IXTYP(1,NY,NX).EQ.8)THEN - CFOSC(1,1,L,NY,NX)=0.07 - CFOSC(2,1,L,NY,NX)=0.41 - CFOSC(3,1,L,NY,NX)=0.36 - CFOSC(4,1,L,NY,NX)=0.16 -C -C NEW CONIFEROUS FOREST -C - ELSEIF(IXTYP(1,NY,NX).EQ.9)THEN - CFOSC(1,1,L,NY,NX)=0.07 - CFOSC(2,1,L,NY,NX)=0.25 - CFOSC(3,1,L,NY,NX)=0.38 - CFOSC(4,1,L,NY,NX)=0.30 -C -C OLD DECIDUOUS FOREST -C - ELSEIF(IXTYP(1,NY,NX).EQ.10)THEN - CFOSC(1,1,L,NY,NX)=0.02 - CFOSC(2,1,L,NY,NX)=0.06 - CFOSC(3,1,L,NY,NX)=0.34 - CFOSC(4,1,L,NY,NX)=0.58 -C -C OLD CONIFEROUS FOREST -C - ELSEIF(IXTYP(1,NY,NX).EQ.11)THEN - CFOSC(1,1,L,NY,NX)=0.02 - CFOSC(2,1,L,NY,NX)=0.06 - CFOSC(3,1,L,NY,NX)=0.34 - CFOSC(4,1,L,NY,NX)=0.58 -C -C DEFAULT -C - ELSE - CFOSC(1,1,L,NY,NX)=0.075 - CFOSC(2,1,L,NY,NX)=0.125 - CFOSC(3,1,L,NY,NX)=0.550 - CFOSC(4,1,L,NY,NX)=0.250 - ENDIF -C -C PREVIOUS COARSE (K=0) AND FINE (K=1) ROOTS -C - ELSE - CFOSC(1,0,L,NY,NX)=0.00 - CFOSC(2,0,L,NY,NX)=0.00 - CFOSC(3,0,L,NY,NX)=0.20 - CFOSC(4,0,L,NY,NX)=0.80 - CFOSC(1,1,L,NY,NX)=0.02 - CFOSC(2,1,L,NY,NX)=0.06 - CFOSC(3,1,L,NY,NX)=0.34 - CFOSC(4,1,L,NY,NX)=0.58 - ENDIF -C -C ANIMAL MANURE -C -C -C RUMINANT -C - IF(IXTYP(2,NY,NX).EQ.1)THEN - CFOSC(1,2,L,NY,NX)=0.036 - CFOSC(2,2,L,NY,NX)=0.044 - CFOSC(3,2,L,NY,NX)=0.630 - CFOSC(4,2,L,NY,NX)=0.290 -C -C NON-RUMINANT -C - ELSEIF(IXTYP(2,NY,NX).EQ.2)THEN - CFOSC(1,2,L,NY,NX)=0.138 - CFOSC(2,2,L,NY,NX)=0.401 - CFOSC(3,2,L,NY,NX)=0.316 - CFOSC(4,2,L,NY,NX)=0.145 -C -C OTHER -C - ELSE - CFOSC(1,2,L,NY,NX)=0.138 - CFOSC(2,2,L,NY,NX)=0.401 - CFOSC(3,2,L,NY,NX)=0.316 - CFOSC(4,2,L,NY,NX)=0.145 - ENDIF -C -C POM -C - IF(L.NE.0)THEN - CFOSC(1,3,L,NY,NX)=1.00 - CFOSC(2,3,L,NY,NX)=0.00 - CFOSC(3,3,L,NY,NX)=0.00 - CFOSC(4,3,L,NY,NX)=0.00 -C -C HUMUS PARTITIONED TO DIFFERENT FRACTIONS -C BASED ON SOC ACCUMULATION -C - IF(CORGCX(4).GT.1.0E-32)THEN - FC0=0.60*EXP(-5.0*(AMIN1(CORGNX(4),10.0*CORGPX(4)) - 2/CORGCX(4))) - ELSE - FC0=0.60 - ENDIF - IF(ISOILR(NY,NX).NE.0)THEN - FCX=0.0 - ELSEIF(DPTH(L,NY,NX).GT.DTBLZ(NY,NX) - 2+CDPTH(NU(NY,NX),NY,NX)-CDPTHG)THEN - FCX=(EXP(HCX*TORGL(L)))**0.25 - ELSE - FCX=EXP(HCX*TORGL(L)) - ENDIF - FC1=FC0*FCX - CFOSC(1,4,L,NY,NX)=FC1 - CFOSC(2,4,L,NY,NX)=1.0-FC1 - CFOSC(3,4,L,NY,NX)=0.00 - CFOSC(4,4,L,NY,NX)=0.00 -C -C MICROBIAL DETRITUS TO HUMUS MAINTAINS EXISTING PARTITIONING -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 - 2,CORGCX(4),CORGNX(4),CORGPX(4),DPTH(L,NY,NX),DTBLZ(NY,NX) - 3,CDPTH(NU(NY,NX),NY,NX),CDPTHG -5432 FORMAT(A8,I4,20E12.4) - ENDIF -C -C LAYER SOIL, HEAT, WATER, ICE, GAS AND AIR CONTENTS -C - PSISE(L,NY,NX)=PSIPS - ROXYF(L,NY,NX)=0.0 - RCO2F(L,NY,NX)=0.0 - ROXYL(L,NY,NX)=0.0 - RCH4F(L,NY,NX)=0.0 - RCH4L(L,NY,NX)=0.0 - IF(L.GT.0)THEN - HYST(L,NY,NX)=1.0 - 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) - 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 - 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) - ELSEIF(THW(L,NY,NX).EQ.1.0)THEN - THW(L,NY,NX)=FC(L,NY,NX) - ELSEIF(THW(L,NY,NX).LE.0.0)THEN - THW(L,NY,NX)=WP(L,NY,NX) - ENDIF - IF(THI(L,NY,NX).GT.1.0.OR.DPTH(L,NY,NX).GE.DTBLZ(NY,NX))THEN - THI(L,NY,NX)=AMAX1(0.0,AMIN1(POROS(L,NY,NX) - 2,POROS(L,NY,NX)-THW(L,NY,NX))) - ELSEIF(THI(L,NY,NX).EQ.1.0)THEN - THI(L,NY,NX)=AMAX1(0.0,AMIN1(FC(L,NY,NX) - 2,POROS(L,NY,NX)-THW(L,NY,NX))) - ELSEIF(THI(L,NY,NX).LT.0.0)THEN - THI(L,NY,NX)=AMAX1(0.0,AMIN1(WP(L,NY,NX) - 2,POROS(L,NY,NX)-THW(L,NY,NX))) - ENDIF - THETW(L,NY,NX)=THW(L,NY,NX) - VOLW(L,NY,NX)=THETW(L,NY,NX)*VOLX(L,NY,NX) - VOLWX(L,NY,NX)=VOLW(L,NY,NX) - VOLWH(L,NY,NX)=THETW(L,NY,NX)*VOLAH(L,NY,NX) - THETI(L,NY,NX)=THI(L,NY,NX) - VOLI(L,NY,NX)=THETI(L,NY,NX)*VOLX(L,NY,NX) - VOLIH(L,NY,NX)=THETI(L,NY,NX)*VOLAH(L,NY,NX) - ENDIF - 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)) - 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) - 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) - 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) - TKS(L,NY,NX)=TCS(L,NY,NX)+273.15 - PSISA(L,NY,NX)=-2.5E-03 - ELSE - VOLW(L,NY,NX)=1.0E-06*ORGC(L,NY,NX) - VOLWX(L,NY,NX)=VOLW(L,NY,NX) - VOLI(L,NY,NX)=0.0 - IF(VOLX(L,NY,NX).GT.0.0)THEN - THETW(L,NY,NX)=AMAX1(0.001,VOLW(L,NY,NX)/VOLX(L,NY,NX)) - ELSE - THETW(L,NY,NX)=0.001 - ENDIF - THETP(L,NY,NX)=0.95-THETW(L,NY,NX) - THETI(L,NY,NX)=0.0 - VHCPR(NY,NX)=2.496E-06*ORGC(L,NY,NX)+4.19*VOLW(L,NY,NX) - 2+1.9274*VOLI(L,NY,NX) - ENDIF -C -C INITIALIZE SOM VARIABLES -C - DO 975 K=0,2 - CNOSCT(K)=0.0 - CPOSCT(K)=0.0 - IF(RSC(K,L,NY,NX).GT.ZEROS(NY,NX))THEN - RNT=0.0 - RPT=0.0 - DO 970 M=1,4 - RNT=RNT+RSC(K,L,NY,NX)*CFOSC(M,K,L,NY,NX)*CNOFC(M,K) - RPT=RPT+RSC(K,L,NY,NX)*CFOSC(M,K,L,NY,NX)*CPOFC(M,K) -970 CONTINUE - FRNT=RSN(K,L,NY,NX)/RNT - FRPT=RSP(K,L,NY,NX)/RPT - DO 960 M=1,4 - CNOSC(M,K,L,NY,NX)=CNOFC(M,K)*FRNT - CPOSC(M,K,L,NY,NX)=CPOFC(M,K)*FRPT - CNOSCT(K)=CNOSCT(K)+CFOSC(M,K,L,NY,NX)*CNOSC(M,K,L,NY,NX) - CPOSCT(K)=CPOSCT(K)+CFOSC(M,K,L,NY,NX)*CPOSC(M,K,L,NY,NX) -960 CONTINUE - ELSE - DO 965 M=1,4 - CNOSC(M,K,L,NY,NX)=CNRH(K) - CPOSC(M,K,L,NY,NX)=CPRH(K) -965 CONTINUE - CNOSCT(K)=CNRH(K) - CPOSCT(K)=CPRH(K) - ENDIF -975 CONTINUE - DO 990 K=3,4 - CNOSCT(K)=0.0 - CPOSCT(K)=0.0 - IF(CORGCX(K).GT.ZERO)THEN - DO 985 M=1,4 - CNOSC(M,K,L,NY,NX)=CORGNX(K)/CORGCX(K) - CPOSC(M,K,L,NY,NX)=CORGPX(K)/CORGCX(K) - CNOSCT(K)=CNOSCT(K)+CFOSC(M,K,L,NY,NX)*CNOSC(M,K,L,NY,NX) - CPOSCT(K)=CPOSCT(K)+CFOSC(M,K,L,NY,NX)*CPOSC(M,K,L,NY,NX) -985 CONTINUE - ELSE - DO 980 M=1,4 - CNOSC(M,K,L,NY,NX)=CNRH(K) - CPOSC(M,K,L,NY,NX)=CPRH(K) -980 CONTINUE - CNOSCT(K)=CNRH(K) - CPOSCT(K)=CPRH(K) - ENDIF -990 CONTINUE - TOSCI=0.0 - TOSNI=0.0 - TOSPI=0.0 - DO 995 K=0,4 - IF(L.EQ.0)THEN - KK=K - ELSE - KK=4 - ENDIF - OSCI(K)=CORGCX(K)*BKVL(L,NY,NX) - OSNI(K)=CORGNX(K)*BKVL(L,NY,NX) - OSPI(K)=CORGPX(K)*BKVL(L,NY,NX) - TOSCK(K)=OMCK(K)+ORCK(K)+OQCK(K)+OHCK(K) - TOSNK(K)=OMCI(1,K)*CNOMC(1,1,K)+OMCI(2,K)*CNOMC(2,1,K) - 2+ORCK(K)*CNRH(K)+OQCK(K)*CNOSCT(KK)+OHCK(K)*CNOSCT(KK) - TOSPK(K)=OMCI(1,K)*CPOMC(1,1,K)+OMCI(2,K)*CPOMC(2,1,K) - 2+ORCK(K)*CPRH(K)+OQCK(K)*CPOSCT(KK)+OHCK(K)*CPOSCT(KK) - TOSCI=TOSCI+OSCI(K)*TOSCK(K) - TOSNI=TOSNI+OSCI(K)*TOSNK(K) - TOSPI=TOSPI+OSCI(K)*TOSPK(K) - OSCX(K)=0.0 - OSNX(K)=0.0 - OSPX(K)=0.0 -995 CONTINUE - TOMC=0.0 - DO 8995 K=0,4 - IF(L.EQ.0)THEN - OSCM(K)=DCKR*CORGCX(K)*BKVL(L,NY,NX) - X=0.0 - KK=K - FOSCI=1.0 - FOSNI=1.0 - FOSPI=1.0 -C WRITE(*,2424)'OSCM',NX,NY,L,K,OSCM(K),CORGCX(K) -C 2,BKVL(L,NY,NX),CORGCX(K)*BKVL(L,NY,NX),FCX - ELSE - IF(K.LE.2)THEN - OSCM(K)=DCKR*CORGCX(K)*BKVL(L,NY,NX) - ELSE - OSCM(K)=FCX*CORGCX(K)*BKVL(L,NY,NX)*DCKM/(CORGCX(4)+DCKM) - ENDIF -2424 FORMAT(A8,4I4,12E12.4) - X=1.0 - KK=4 - IF(TOSCI.GT.ZEROS(NY,NX))THEN - FOSCI=AMIN1(1.0,OSCI(KK)/TOSCI) - FOSNI=AMIN1(1.0,OSCI(KK)*CNOSCT(KK)/TOSNI) - FOSPI=AMIN1(1.0,OSCI(KK)*CPOSCT(KK)/TOSPI) - ELSE - FOSCI=0.0 - FOSNI=0.0 - FOSPI=0.0 - ENDIF - ENDIF -C -C MICROBIAL C, N AND P -C - DO 7990 N=1,7 - DO 7985 M=1,3 - OMC(M,N,5,L,NY,NX)=0.0 - OMN(M,N,5,L,NY,NX)=0.0 - OMP(M,N,5,L,NY,NX)=0.0 -7985 CONTINUE -7990 CONTINUE - DO 8990 N=1,7 - DO 8991 M=1,3 - OMC1=AMAX1(0.0,OSCM(K)*OMCI(M,K)*OMCF(N)*FOSCI) - OMN1=AMAX1(0.0,OMC1*CNOMC(M,N,K)*FOSNI) - OMP1=AMAX1(0.0,OMC1*CPOMC(M,N,K)*FOSPI) - OMC(M,N,K,L,NY,NX)=OMC1 - OMN(M,N,K,L,NY,NX)=OMN1 - OMP(M,N,K,L,NY,NX)=OMP1 - OSCX(KK)=OSCX(KK)+OMC1 - OSNX(KK)=OSNX(KK)+OMN1 - OSPX(KK)=OSPX(KK)+OMP1 - DO 8992 NN=1,7 - OMC(M,NN,5,L,NY,NX)=OMC(M,NN,5,L,NY,NX)+OMC1*OMCA(NN) - OMN(M,NN,5,L,NY,NX)=OMN(M,NN,5,L,NY,NX)+OMN1*OMCA(NN) - OMP(M,NN,5,L,NY,NX)=OMP(M,NN,5,L,NY,NX)+OMP1*OMCA(NN) - OSCX(KK)=OSCX(KK)+OMC1*OMCA(NN) - OSNX(KK)=OSNX(KK)+OMN1*OMCA(NN) - OSPX(KK)=OSPX(KK)+OMP1*OMCA(NN) -8992 CONTINUE -8991 CONTINUE -8990 CONTINUE -C -C MICROBIAL RESIDUE C, N AND P -C - DO 8985 M=1,2 - ORC(M,K,L,NY,NX)=X*AMAX1(0.0,OSCM(K)*ORCI(M,K)*FOSCI) - ORN(M,K,L,NY,NX)=AMAX1(0.0,ORC(M,K,L,NY,NX)*CNOMC(M,1,K)*FOSNI) - ORP(M,K,L,NY,NX)=AMAX1(0.0,ORC(M,K,L,NY,NX)*CPOMC(M,1,K)*FOSPI) - OSCX(KK)=OSCX(KK)+ORC(M,K,L,NY,NX) - OSNX(KK)=OSNX(KK)+ORN(M,K,L,NY,NX) - OSPX(KK)=OSPX(KK)+ORP(M,K,L,NY,NX) -8985 CONTINUE -C -C DOC, DON AND DOP -C - OQC(K,L,NY,NX)=X*AMAX1(0.0,OSCM(K)*OQCK(K)*FOSCI) - OQN(K,L,NY,NX)=AMAX1(0.0,OQC(K,L,NY,NX)*CNOSCT(KK)*FOSNI) - OQP(K,L,NY,NX)=AMAX1(0.0,OQC(K,L,NY,NX)*CPOSCT(KK)*FOSPI) - OQA(K,L,NY,NX)=0.0 - OQCH(K,L,NY,NX)=0.0 - OQNH(K,L,NY,NX)=0.0 - OQPH(K,L,NY,NX)=0.0 - OQAH(K,L,NY,NX)=0.0 - OSCX(KK)=OSCX(KK)+OQC(K,L,NY,NX) - OSNX(KK)=OSNX(KK)+OQN(K,L,NY,NX) - OSPX(KK)=OSPX(KK)+OQP(K,L,NY,NX) -C -C ADSORBED C, N AND P -C - OHC(K,L,NY,NX)=X*AMAX1(0.0,OSCM(K)*OHCK(K)*FOSCI) - OHN(K,L,NY,NX)=AMAX1(0.0,OHC(K,L,NY,NX)*CNOSCT(KK)*FOSNI) - OHP(K,L,NY,NX)=AMAX1(0.0,OHC(K,L,NY,NX)*CPOSCT(KK)*FOSPI) - OHA(K,L,NY,NX)=0.0 - OSCX(KK)=OSCX(KK)+OHC(K,L,NY,NX)+OHA(K,L,NY,NX) - OSNX(KK)=OSNX(KK)+OHN(K,L,NY,NX) - OSPX(KK)=OSPX(KK)+OHP(K,L,NY,NX) -C -C HUMUS C, N AND P -C - DO 8980 M=1,4 - OSC(M,K,L,NY,NX)=AMAX1(0.0,CFOSC(M,K,L,NY,NX)*(OSCI(K)-OSCX(K))) - IF(CNOSCT(K).GT.ZERO)THEN - OSN(M,K,L,NY,NX)=AMAX1(0.0,CFOSC(M,K,L,NY,NX)*CNOSC(M,K,L,NY,NX) - 2/CNOSCT(K)*(OSNI(K)-OSNX(K))) - ELSE - OSN(M,K,L,NY,NX)=0.0 - ENDIF - IF(CPOSCT(K).GT.ZERO)THEN - OSP(M,K,L,NY,NX)=AMAX1(0.0,CFOSC(M,K,L,NY,NX)*CPOSC(M,K,L,NY,NX) - 2/CPOSCT(K)*(OSPI(K)-OSPX(K))) - ELSE - OSP(M,K,L,NY,NX)=0.0 - ENDIF - IF(K.EQ.0)THEN - OSA(M,K,L,NY,NX)=0.0 - ELSE - OSA(M,K,L,NY,NX)=OSC(M,K,L,NY,NX) - ENDIF -8980 CONTINUE -8995 CONTINUE - OC=0.0 - ON=0.0 - OP=0.0 - RC=0.0 - IF(L.EQ.0)THEN - DO 6975 K=0,5 - RC0(K,NY,NX)=0.0 - RA0(K,NY,NX)=0.0 -6975 CONTINUE - ENDIF - DO 6990 K=0,5 - DO 6990 N=1,7 - OC=OC+OMC(3,N,K,L,NY,NX) - ON=ON+OMN(3,N,K,L,NY,NX) - OP=OP+OMP(3,N,K,L,NY,NX) - IF(K.LE.2)THEN - RC=RC+OMC(3,N,K,L,NY,NX) - ENDIF - ROXYS(N,K,L,NY,NX)=0.0 - RVMX4(N,K,L,NY,NX)=0.0 - RVMX3(N,K,L,NY,NX)=0.0 - RVMX2(N,K,L,NY,NX)=0.0 - RVMX1(N,K,L,NY,NX)=0.0 - RINHO(N,K,L,NY,NX)=0.0 - RINOO(N,K,L,NY,NX)=0.0 - RIPOO(N,K,L,NY,NX)=0.0 - IF(L.EQ.0)THEN - RINHOR(N,K,NY,NX)=0.0 - RINOOR(N,K,NY,NX)=0.0 - RIPOOR(N,K,NY,NX)=0.0 - ENDIF - DO 6990 M=1,3 - OC=OC+OMC(M,N,K,L,NY,NX) - ON=ON+OMN(M,N,K,L,NY,NX) - OP=OP+OMP(M,N,K,L,NY,NX) - IF(K.LE.2)THEN - RC=RC+OMC(M,N,K,L,NY,NX) - ENDIF - RC0(K,NY,NX)=RC0(K,NY,NX)+OMC(M,N,K,L,NY,NX) - RA0(K,NY,NX)=RA0(K,NY,NX)+OMC(M,N,K,L,NY,NX) -6990 CONTINUE - DO 6995 K=0,4 - DO 6985 M=1,2 - OC=OC+ORC(M,K,L,NY,NX) - ON=ON+ORN(M,K,L,NY,NX) - OP=OP+ORP(M,K,L,NY,NX) - IF(K.LE.2)THEN - RC=RC+ORC(M,K,L,NY,NX) - ENDIF - IF(L.EQ.0)THEN - RC0(K,NY,NX)=RC0(K,NY,NX)+ORC(M,K,L,NY,NX) - RA0(K,NY,NX)=RA0(K,NY,NX)+ORC(M,K,L,NY,NX) - ENDIF -6985 CONTINUE - OC=OC+OQC(K,L,NY,NX)+OQCH(K,L,NY,NX)+OHC(K,L,NY,NX) - 2+OQA(K,L,NY,NX)+OQAH(K,L,NY,NX)+OHA(K,L,NY,NX) - ON=ON+OQN(K,L,NY,NX)+OQNH(K,L,NY,NX)+OHN(K,L,NY,NX) - OP=OP+OQP(K,L,NY,NX)+OQPH(K,L,NY,NX)+OHP(K,L,NY,NX) - OC=OC+OQA(K,L,NY,NX)+OQAH(K,L,NY,NX) - IF(K.LE.2)THEN - RC=RC+OQC(K,L,NY,NX)+OQCH(K,L,NY,NX)+OHC(K,L,NY,NX) - 2+OQA(K,L,NY,NX)+OQAH(K,L,NY,NX)+OHA(K,L,NY,NX) - RC=RC+OQA(K,L,NY,NX)+OQAH(K,L,NY,NX) - ENDIF - IF(L.EQ.0)THEN - RC0(K,NY,NX)=RC0(K,NY,NX)+OQC(K,L,NY,NX)+OQCH(K,L,NY,NX) - 2+OHC(K,L,NY,NX)+OQA(K,L,NY,NX)+OQAH(K,L,NY,NX)+OHA(K,L,NY,NX) - RA0(K,NY,NX)=RA0(K,NY,NX)+OQC(K,L,NY,NX)+OQCH(K,L,NY,NX) - 2+OHC(K,L,NY,NX)+OQA(K,L,NY,NX)+OQAH(K,L,NY,NX)+OHA(K,L,NY,NX) - ENDIF - DO 6980 M=1,4 - OC=OC+OSC(M,K,L,NY,NX) - ON=ON+OSN(M,K,L,NY,NX) - OP=OP+OSP(M,K,L,NY,NX) - IF(K.LE.2)THEN - RC=RC+OSC(M,K,L,NY,NX) - ENDIF - IF(L.EQ.0)THEN - RC0(K,NY,NX)=RC0(K,NY,NX)+OSC(M,K,L,NY,NX) - RA0(K,NY,NX)=RA0(K,NY,NX)+OSA(M,K,L,NY,NX) - ENDIF -6980 CONTINUE -6995 CONTINUE - ORGC(L,NY,NX)=OC - ORGR(L,NY,NX)=RC -C -C INITIALIZE FERTILIZER ARRAYS -C - ZNH4FA(L,NY,NX)=0.0 - ZNH3FA(L,NY,NX)=0.0 - ZNHUFA(L,NY,NX)=0.0 - ZNO3FA(L,NY,NX)=0.0 - IF(L.GT.0)THEN - ZNH4FB(L,NY,NX)=0.0 - ZNH3FB(L,NY,NX)=0.0 - ZNHUFB(L,NY,NX)=0.0 - ZNO3FB(L,NY,NX)=0.0 - WDNHB(L,NY,NX)=0.0 - DPNHB(L,NY,NX)=0.0 - WDNOB(L,NY,NX)=0.0 - DPNOB(L,NY,NX)=0.0 - WDPOB(L,NY,NX)=0.0 - DPPOB(L,NY,NX)=0.0 - ENDIF - VLNH4(L,NY,NX)=1.0 - VLNO3(L,NY,NX)=1.0 - VLPO4(L,NY,NX)=1.0 - VLNHB(L,NY,NX)=0.0 - VLNOB(L,NY,NX)=0.0 - VLPOB(L,NY,NX)=0.0 - ROXYX(L,NY,NX)=0.0 - RNH4X(L,NY,NX)=0.0 - RNO3X(L,NY,NX)=0.0 - RNO2X(L,NY,NX)=0.0 - RN2OX(L,NY,NX)=0.0 - RPO4X(L,NY,NX)=0.0 - RVMXC(L,NY,NX)=0.0 - RNHBX(L,NY,NX)=0.0 - RN3BX(L,NY,NX)=0.0 - RN2BX(L,NY,NX)=0.0 - RPOBX(L,NY,NX)=0.0 - RVMBC(L,NY,NX)=0.0 - DO 1250 K=0,4 - IF(L.GT.0)THEN - COCU(K,L,NY,NX)=0.0 - CONU(K,L,NY,NX)=0.0 - COPU(K,L,NY,NX)=0.0 - COAU(K,L,NY,NX)=0.0 - ENDIF -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 -9890 CONTINUE -9895 CONTINUE - RETURN - END + + SUBROUTINE starts(NHW,NHE,NVN,NVS) +C +C THIS SUBROUTINE INITIALIZES ALL SOIL VARIABLES +C + include "parameters.h" + include "blkc.h" + include "blk2a.h" + include "blk2b.h" + include "blk2c.h" + include "blk5.h" + include "blk8a.h" + include "blk8b.h" + include "blk11a.h" + include "blk11b.h" + include "blk13a.h" + include "blk13b.h" + include "blk13c.h" + include "blk16.h" + include "blk18a.h" + include "blk18b.h" + DIMENSION YSIN(4),YCOS(4),YAZI(4),ZAZI(4),OSCI(0:4),OSNI(0:4) + 2,ORCI(2,0:4),OSPI(0:4),OSCM(0:4),CORGCX(0:4) + 3,CORGNX(0:4),CORGPX(0:4),CNOSCT(0:4),CPOSCT(0:4) + 4,GSINA(JY,JX),GCOSA(JY,JX),ALTX(JV,JH) + 5,OSCX(0:4),OSNX(0:4),OSPX(0:4),OMCK(0:4),ORCK(0:4),OQCK(0:4) + 6,OHCK(0:4),TOSCK(0:4),TOSNK(0:4),TOSPK(0:4),TORGL(JZ) + PARAMETER (OQKM=12.0,DCKR=0.25,DCKM=2.5E+04,PSIPS=-0.5E-03) + DATA OMCI/0.005,0.050,0.005,0.050,0.050,0.005,0.050,0.050,0.005 + 2,0.005,0.050,0.005,0.005,0.050,0.005/ + DATA ORCI/0.01,0.05,0.01,0.05,0.01,0.05 + 2,0.001,0.005,0.001,0.005/ + DATA OMCK/0.01,0.01,0.01,0.01,0.01/ + DATA ORCK/0.25,0.25,0.25,0.25,0.25/ + DATA OQCK/0.005,0.005,0.005,0.005,0.005/ + DATA OHCK/0.05,0.05,0.05,0.05,0.05/ + DATA OMCF/0.20,0.20,0.30,0.20,0.050,0.025,0.025/ + DATA OMCA/0.06,0.02,0.01,0.0,0.01,0.0,0.0/ + DATA CNRH/3.33E-02,3.33E-02,3.33E-02,5.00E-02,12.50E-02/ + 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/ + NDIM=1 + IF(NHE.GT.NHW)NDIM=NDIM+1 + IF(NVS.GT.NVN)NDIM=NDIM+1 + XDIM=1.0/NDIM + ZERO=1.0E-16 + TAREA=0.0 + THETX=2.5E-03 + THETPI=0.00 + DENSI=0.92-THETPI +C +C INITIALIZE MASS BALANCE CHECKS +C + CRAIN=0.0 + HEATIN=0.0 + CO2GIN=0.0 + OXYGIN=0.0 + H2GIN=0.0 + TZIN=0.0 + ZN2GIN=0.0 + TPIN=0.0 + TORGF=0.0 + TORGN=0.0 + TORGP=0.0 + VOLWOU=0.0 + CEVAP=0.0 + CRUN=0.0 + HEATOU=0.0 + OXYGOU=0.0 + H2GOU=0.0 + TSEDOU=0.0 + TCOU=0.0 + TZOU=0.0 + TPOU=0.0 + XCSN=0.0 + XZSN=0.0 + XPSN=0.0 + TIONIN=0.0 + TIONOU=0.0 + VAP=2465.0 + VAPW=2834.0 + OXKM=0.064 + TYSIN=0.0 + ZSIN(1)=0.195 + ZSIN(2)=0.556 + ZSIN(3)=0.831 + ZSIN(4)=0.981 + ZCOS(1)=0.981 + ZCOS(2)=0.831 + ZCOS(3)=0.556 + ZCOS(4)=0.195 + DO 205 L=1,4 + ZAZI(L)=(L-0.5)*3.1416/4.0 +205 CONTINUE + DO 230 N=1,4 + YAZI(N)=3.1416*(2*N-1)/4.0 + YAGL=3.1416/4.0 + YSIN(N)=SIN(YAGL) + YCOS(N)=COS(YAGL) + TYSIN=TYSIN+YSIN(N) + DO 225 L=1,4 + DAZI=COS(ZAZI(L)-YAZI(N)) + DO 225 M=1,4 + OMEGY=ZCOS(M)*YSIN(N)+ZSIN(M)*YCOS(N)*DAZI + OMEGA(N,M,L)=ABS(OMEGY) + OMEGX(N,M,L)=OMEGA(N,M,L)/YSIN(N) + IF(ZCOS(M).GT.YSIN(N))THEN + OMEGZ=ACOS(OMEGY) + ELSE + OMEGZ=-ACOS(OMEGY) + ENDIF + IF(OMEGZ.GT.-1.5708)THEN + ZAGL=YAGL+2.0*OMEGZ + ELSE + ZAGL=YAGL-2.0*(3.1416+OMEGZ) + ENDIF + IF(ZAGL.GT.0.0.AND.ZAGL.LT.3.1416)THEN + IALBY(N,M,L)=1 + ELSE + IALBY(N,M,L)=2 + ENDIF +225 CONTINUE +230 CONTINUE +C +C INITIALIZE C-N AND C-P RATIOS OF RESIDUE AND SOIL +C + CNOFC(1,0)=0.005 + CNOFC(2,0)=0.005 + CNOFC(3,0)=0.005 + CNOFC(4,0)=0.020 + CPOFC(1,0)=0.0005 + CPOFC(2,0)=0.0005 + CPOFC(3,0)=0.0005 + CPOFC(4,0)=0.0020 + CNOFC(1,1)=0.020 + CNOFC(2,1)=0.020 + CNOFC(3,1)=0.020 + CNOFC(4,1)=0.020 + CPOFC(1,1)=0.0020 + CPOFC(2,1)=0.0020 + CPOFC(3,1)=0.0020 + CPOFC(4,1)=0.0020 + CNOFC(1,2)=0.005 + CNOFC(2,2)=0.005 + CNOFC(3,2)=0.005 + CNOFC(4,2)=0.020 + CPOFC(1,2)=0.0005 + CPOFC(2,2)=0.0005 + CPOFC(3,2)=0.0005 + CPOFC(4,2)=0.0020 + FL(1)=0.55 + FL(2)=0.45 + DO 95 K=0,5 + DO 95 N=1,7 + IF(K.LE.4.AND.N.EQ.3)THEN + CNOMC(1,N,K)=0.15 + CNOMC(2,N,K)=0.09 + CPOMC(1,N,K)=0.015 + CPOMC(2,N,K)=0.009 + ELSE + CNOMC(1,N,K)=0.225 + CNOMC(2,N,K)=0.135 + CPOMC(1,N,K)=0.0225 + CPOMC(2,N,K)=0.0135 + ENDIF + CNOMC(3,N,K)=FL(1)*CNOMC(1,N,K)+FL(2)*CNOMC(2,N,K) + CPOMC(3,N,K)=FL(1)*CPOMC(1,N,K)+FL(2)*CPOMC(2,N,K) +95 CONTINUE +C +C CALCULATE ELEVATION OF EACH GRID CELL +C + ALTY=0.0 + DO 9985 NX=NHW,NHE + DO 9980 NY=NVN,NVS + ZEROS(NY,NX)=ZERO*DH(NY,NX)*DV(NY,NX) + GAZI(NY,NX)=ASP(NY,NX)/57.29577951 + GSINA(NY,NX)=ABS(SIN(GAZI(NY,NX))) + GCOSA(NY,NX)=ABS(COS(GAZI(NY,NX))) + GSIN(NY,NX)=SIN(SL(1,NY,NX)/57.29577951)*GCOSA(NY,NX) + 2+SIN(SL(2,NY,NX)/57.29577951)*GSINA(NY,NX) + GCOS(NY,NX)=SQRT(1.0-GSIN(NY,NX)**2) + DO 240 N=1,4 + DGAZI=COS(GAZI(NY,NX)-YAZI(N)) + OMEGAG(N,NY,NX)=AMAX1(0.0,AMIN1(1.0,GCOS(NY,NX)*YSIN(N) + 2+GSIN(NY,NX)*YCOS(N)*DGAZI)) +240 CONTINUE + IF(ASP(NY,NX).GT.90.0.AND.ASP(NY,NX).LT.270.0)THEN + SLOPE(1,NY,NX)=SIN(SL(1,NY,NX)/57.29577951) + ELSE + SLOPE(1,NY,NX)=-SIN(SL(1,NY,NX)/57.29577951) + ENDIF + IF(ASP(NY,NX).GT.0.0.AND.ASP(NY,NX).LT.180.0)THEN + SLOPE(2,NY,NX)=SIN(SL(2,NY,NX)/57.29577951) + ELSE + SLOPE(2,NY,NX)=-SIN(SL(2,NY,NX)/57.29577951) + ENDIF + SLOPE(3,NY,NX)=-1.0 + IF(NX.EQ.NHW)THEN + IF(NY.EQ.NVN)THEN + ALT(NY,NX)=0.5*DH(NY,NX)*SLOPE(1,NY,NX) + 2+0.5*DV(NY,NX)*SLOPE(2,NY,NX) + ELSE + ALT(NY,NX)=ALT(NY-1,NX) + 2+0.5*DH(NY,NX)*SLOPE(1,NY,NX) + 4+0.5*DV(NY,NX)*(SLOPE(2,NY,NX)) + 5+0.5*DV(NY-1,NX)*SLOPE(2,NY-1,NX) + ENDIF + ELSE + IF(NY.EQ.NVN)THEN + ALT(NY,NX)=ALT(NY,NX-1) + 2+0.5*DH(NY,NX)*SLOPE(1,NY,NX) + 3+0.5*DH(NY,NX-1)*SLOPE(1,NY,NX-1) + ELSE + ALT(NY,NX)=(ALT(NY,NX-1) + 2+0.5*DH(NY,NX)*SLOPE(1,NY,NX) + 3+0.5*DH(NY,NX-1)*SLOPE(1,NY,NX-1) + 4+ALT(NY-1,NX) + 4+0.5*DV(NY,NX)*SLOPE(2,NY,NX) + 5+0.5*DV(NY-1,N)*SLOPE(2,NY-1,NX))/2.0 + ENDIF + ENDIF + IF(NX.EQ.NHW.AND.NY.EQ.NVN)THEN + ALTY=ALT(NY,NX) + 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) +1111 FORMAT(A8,2I4,20E12.4) +9980 CONTINUE +9985 CONTINUE +C +C INITIALIZE ACCUMULATORS AND MASS BALANCE CHECKS +C OF EACH GRID CELL +C + ALTZG=0.0 + CDPTHG=0.0 + DO 9995 NX=NHW,NHE + DO 9990 NY=NVN,NVS + DO 600 N=1,12 + TDTPX(NY,NX,N)=0.0 + TDTPN(NY,NX,N)=0.0 + TDRAD(NY,NX,N)=1.0 + TDWND(NY,NX,N)=1.0 + TDHUM(NY,NX,N)=1.0 + TDPRC(NY,NX,N)=1.0 + TDIRI(NY,NX,N)=1.0 + TDCO2(NY,NX,N)=1.0 + TDCN4(NY,NX,N)=1.0 + TDCNO(NY,NX,N)=1.0 +600 CONTINUE + IUTYP(NY,NX)=0 + IFNHB(NY,NX)=0 + IFNOB(NY,NX)=0 + IFPOB(NY,NX)=0 + IFLGS(NY,NX)=1 + IFLGT(NY,NX)=0 + ATCA(NY,NX)=ATCAI(NY,NX) + ATCS(NY,NX)=ATCAI(NY,NX) + ATKA(NY,NX)=ATCA(NY,NX)+273.15 + ATKS(NY,NX)=ATCS(NY,NX)+273.15 + URAIN(NY,NX)=0.0 + UCO2G(NY,NX)=0.0 + UCH4G(NY,NX)=0.0 + UOXYG(NY,NX)=0.0 + UN2GG(NY,NX)=0.0 + UN2OG(NY,NX)=0.0 + UNH3G(NY,NX)=0.0 + UN2GS(NY,NX)=0.0 + UCO2F(NY,NX)=0.0 + UCH4F(NY,NX)=0.0 + UOXYF(NY,NX)=0.0 + UN2OF(NY,NX)=0.0 + UNH3F(NY,NX)=0.0 + UPO4F(NY,NX)=0.0 + UORGF(NY,NX)=0.0 + UFERTN(NY,NX)=0.0 + UFERTP(NY,NX)=0.0 + UVOLO(NY,NX)=0.0 + UEVAP(NY,NX)=0.0 + URUN(NY,NX)=0.0 + USEDOU(NY,NX)=0.0 + UCOP(NY,NX)=0.0 + UDOCQ(NY,NX)=0.0 + UDOCD(NY,NX)=0.0 + UDONQ(NY,NX)=0.0 + UDOND(NY,NX)=0.0 + UDOPQ(NY,NX)=0.0 + UDOPD(NY,NX)=0.0 + UDICQ(NY,NX)=0.0 + UDICD(NY,NX)=0.0 + UDINQ(NY,NX)=0.0 + UDIND(NY,NX)=0.0 + UDIPQ(NY,NX)=0.0 + UDIPD(NY,NX)=0.0 + UIONOU(NY,NX)=0.0 + UXCSN(NY,NX)=0.0 + UXZSN(NY,NX)=0.0 + UXPSN(NY,NX)=0.0 + UDRAIN(NY,NX)=0.0 + ZDRAIN(NY,NX)=0.0 + PDRAIN(NY,NX)=0.0 + DPNH4(NY,NX)=0.0 + DPNO3(NY,NX)=0.0 + DPPO4(NY,NX)=0.0 + TCS(0,NY,NX)=ATCS(NY,NX) + TKS(0,NY,NX)=TCS(0,NY,NX)+273.15 + OXYS(0,NY,NX)=0.0 + FRADG(NY,NX)=1.0 + THRMG(NY,NX)=0.0 + THRMC(NY,NX)=0.0 + TRN(NY,NX)=0.0 + TLE(NY,NX)=0.0 + TSH(NY,NX)=0.0 + TGH(NY,NX)=0.0 + TLEC(NY,NX)=0.0 + TSHC(NY,NX)=0.0 + TLEX(NY,NX)=0.0 + TSHX(NY,NX)=0.0 + TCNET(NY,NX)=0.0 + TVOLWC(NY,NX)=0.0 + ARLFC(NY,NX)=0.0 + ARSTC(NY,NX)=0.0 + TFLWC(NY,NX)=0.0 + PPT(NY,NX)=0.0 + DYLN(NY,NX)=12.0 + DENS0(NY,NX)=0.100 + DENS1(NY,NX)=1.0 + VOLSS(NY,NX)=DPTHS(NY,NX)*DENS0(NY,NX)*DH(NY,NX)*DV(NY,NX) + VOLWS(NY,NX)=0.0 + VOLIS(NY,NX)=0.0 + VOLS(NY,NX)=VOLSS(NY,NX)/DENS0(NY,NX)+VOLWS(NY,NX)+VOLIS(NY,NX) + DPTHA(NY,NX)=9999.0 + TCW(NY,NX)=0.0 + TKW(NY,NX)=TCW(NY,NX)+273.15 + ALBX(NY,NX)=ALBS(NY,NX) + XHVSTC(NY,NX)=0.0 + XHVSTN(NY,NX)=0.0 + XHVSTP(NY,NX)=0.0 + ALT(NY,NX)=ALT(NY,NX)-ALTY + IF(NX.EQ.NHW.AND.NY.EQ.NVN)THEN + ALTZG=ALT(NY,NX) + ELSE + ALTZG=MIN(ALTZG,ALT(NY,NX)) + ENDIF + CDPTHG=AMAX1(CDPTHG,CDPTH(NU(NY,NX),NY,NX)) +C +C INITIALIZE ATMOSPHERE VARIABLES +C + CCO2EI(NY,NX)=CO2EI(NY,NX)*5.36E-04*273.15/ATKA(NY,NX) + CCO2E(NY,NX)=CO2E(NY,NX)*5.36E-04*273.15/ATKA(NY,NX) + CCH4E(NY,NX)=CH4E(NY,NX)*5.36E-04*273.15/ATKA(NY,NX) + COXYE(NY,NX)=OXYE(NY,NX)*1.43E-03*273.15/ATKA(NY,NX) + CZ2GE(NY,NX)=Z2GE(NY,NX)*1.25E-03*273.15/ATKA(NY,NX) + CZ2OE(NY,NX)=Z2OE(NY,NX)*1.25E-03*273.15/ATKA(NY,NX) + CNH3E(NY,NX)=ZNH3E(NY,NX)*6.25E-04*273.15/ATKA(NY,NX) + CH2GE(NY,NX)=H2GE(NY,NX)*8.92E-05*273.15/ATKA(NY,NX) +C +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) +2222 FORMAT(A8,2E12.4) +C +C CALCULATE WHETHER BOUNDARY SLOPES ALLOW RUNOFF +C + DO 9575 N=1,2 + DO 9575 NN=1,2 + IF(N.EQ.1)THEN + IF(NN.EQ.1)THEN + IF(NX.EQ.NHE)THEN + IF(ASP(NY,NX).GT.90.0.AND.ASP(NY,NX).LT.270.0 + 2.AND.SL(2,NY,NX).GT.0.0)THEN + IRCHG(NN,N,NY,NX)=0 + ELSE + IRCHG(NN,N,NY,NX)=1 + ENDIF + ELSE + GO TO 9575 + ENDIF + ELSEIF(NN.EQ.2)THEN + IF(NX.EQ.NHW)THEN + IF(ASP(NY,NX).LT.90.0.OR.ASP(NY,NX).GT.270.0 + 2.AND.SL(2,NY,NX).GT.0.0)THEN + IRCHG(NN,N,NY,NX)=0 + ELSE + IRCHG(NN,N,NY,NX)=1 + ENDIF + ELSE + GO TO 9575 + ENDIF + ENDIF + ELSEIF(N.EQ.2)THEN + IF(NN.EQ.1)THEN + IF(NY.EQ.NVS)THEN + IF(ASP(NY,NX).LT.180.0.AND.ASP(NY,NX).GT.0.0 + 2.AND.SL(1,NY,NX).GT.0.0)THEN + IRCHG(NN,N,NY,NX)=0 + ELSE + IRCHG(NN,N,NY,NX)=1 + ENDIF + ELSE + GO TO 9575 + ENDIF + ELSEIF(NN.EQ.2)THEN + IF(NY.EQ.NVN)THEN + IF(ASP(NY,NX).EQ.0)THEN + ASP2=360.0 + ELSE + ASP2=ASP(NY,NX) + ENDIF + IF(ASP2.GT.180.0.AND.ASP2.LT.360.0 + 2.AND.SL(1,NY,NX).GT.0.0)THEN + IRCHG(NN,N,NY,NX)=0 + ELSE + IRCHG(NN,N,NY,NX)=1 + ENDIF + ELSE + GO TO 9575 + ENDIF + ENDIF + ENDIF +9575 CONTINUE +C +C INITIALIZE WATER AND TEMPERATURE VARIABLES FOR SOIL LAYERS +C + PSIMS(NY,NX)=LOG(-PSIPS) + PSIMX(NY,NX)=LOG(-PSIFC(NY,NX)) + PSIMN(NY,NX)=LOG(-PSIWP(NY,NX)) + PSISD(NY,NX)=PSIMX(NY,NX)-PSIMS(NY,NX) + PSIMD(NY,NX)=PSIMN(NY,NX)-PSIMX(NY,NX) + NW(NY,NX)=0 + CORGC(0,NY,NX)=0.5E+06 +C +C DISTRIBUTION OF OM AMONG FRACTIONS OF DIFFERING +C BIOLOGICAL ACTIVITY +C + DO 1195 L=0,NL(NY,NX) +C +C LAYER DEPTHS AND THEIR PHYSICAL PROPOERTIES +C + DLYR(1,L,NY,NX)=DH(NY,NX) + DLYR(2,L,NY,NX)=DV(NY,NX) + AREA(3,L,NY,NX)=DLYR(1,L,NY,NX)*DLYR(2,L,NY,NX) + IF(L.EQ.0)THEN + TAREA=TAREA+AREA(3,L,NY,NX) + CDPTH(L,NY,NX)=0.0 + CDPTHZ(L,NY,NX)=0.0 + ORGC(L,NY,NX)=(RSC(0,L,NY,NX)+RSC(1,L,NY,NX)+RSC(2,L,NY,NX)) + 2*AREA(3,L,NY,NX) + VOLR(NY,NX)=(RSC(0,L,NY,NX)*1.0E-06/BKRS(0) + 2+RSC(1,L,NY,NX)*1.0E-06/BKRS(1)+RSC(2,L,NY,NX)*1.0E-06/BKRS(2)) + 2*AREA(3,L,NY,NX) + VOLT(L,NY,NX)=VOLR(NY,NX) + VOLX(L,NY,NX)=VOLT(L,NY,NX) + BKVL(L,NY,NX)=2.00E-06*ORGC(L,NY,NX) + DLYR(3,L,NY,NX)=VOLX(L,NY,NX)/AREA(3,L,NY,NX) + ELSE + DLYR(3,L,NY,NX)=(CDPTH(L,NY,NX)-CDPTH(L-1,NY,NX)) + DPTH(L,NY,NX)=0.5*(CDPTH(L,NY,NX)+CDPTH(L-1,NY,NX)) + CDPTHZ(L,NY,NX)=CDPTH(L,NY,NX)-CDPTH(NU(NY,NX),NY,NX) + 2+DLYR(3,NU(NY,NX),NY,NX) + DPTHZ(L,NY,NX)=0.5*(CDPTHZ(L,NY,NX)+CDPTHZ(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) + BKVL(L,NY,NX)=BKDS(L,NY,NX)*VOLX(L,NY,NX) + YDPTH(L,NY,NX)=ALT(NY,NX)-DPTH(L,NY,NX) + RTDNT(L,NY,NX)=0.0 + IF(BKDS(L,NY,NX).GT.0.0.AND.NW(NY,NX).EQ.0)NW(NY,NX)=L + ENDIF + AREA(1,L,NY,NX)=DLYR(3,L,NY,NX)*DLYR(2,L,NY,NX) + AREA(2,L,NY,NX)=DLYR(3,L,NY,NX)*DLYR(1,L,NY,NX) +1195 CONTINUE +C +C SURFACE WATER STORAGE AND LOWER HEAT SINK +C + VHCPW(NY,NX)=2.095*VOLSS(NY,NX)+4.19*VOLWS(NY,NX) + 2+1.9274*VOLIS(NY,NX) + VHCPWX(NY,NX)=10.5E-03*AREA(3,NU(NY,NX),NY,NX) + VHCPRX(NY,NX)=10.5E-05*AREA(3,NU(NY,NX),NY,NX) + DPTHSK(NY,NX)=AMAX1(10.0,CDPTH(NL(NY,NX),NY,NX)+1.0) + TCNDG=8.1E-03 + TKSD(NY,NX)=ATKS(NY,NX)+2.052E-04*DPTHSK(NY,NX)/TCNDG +C +C INITIALIZE COMMUNITY CANOPY +C + ZT(NY,NX)=0.0 + ZL(0,NY,NX)=0.0 + DO 1925 L=1,JC + ZL(L,NY,NX)=0.0 + ARLFT(L,NY,NX)=0.0 + ARSTT(L,NY,NX)=0.0 + WGLFT(L,NY,NX)=0.0 +1925 CONTINUE +9990 CONTINUE +9995 CONTINUE +C +C INITIALIZE GRID CELL DIMENSIONS +C + DO 9895 NX=NHW,NHE + DO 9890 NY=NVN,NVS + ALTZ(NY,NX)=ALTZG + IF(BKDS(NU(NY,NX),NY,NX).GT.0.0)THEN + DTBLZ(NY,NX)=DTBLI(NY,NX)-(ALTZ(NY,NX)-ALT(NY,NX)) + 2*(1.0-DTBLG(NY,NX)) + DDRG(NY,NX)=AMAX1(0.0,DDRGI(NY,NX)-(ALTZ(NY,NX)-ALT(NY,NX)) + 2*(1.0-DTBLG(NY,NX))) + ELSE + DTBLZ(NY,NX)=0.0 + DDRG(NY,NX)=0.0 + ENDIF + DPTHT(NY,NX)=DTBLZ(NY,NX) + DO 4400 L=1,NL(NY,NX) + N1=NX + N2=NY + N3=L + DO 4320 N=NCN(N2,N1),3 + IF(N.EQ.1)THEN + IF(NX.EQ.NHE)THEN + GO TO 4320 + ELSE + N4=NX+1 + N5=NY + N6=L + ENDIF + ELSEIF(N.EQ.2)THEN + IF(NY.EQ.NVS)THEN + GO TO 4320 + ELSE + N4=NX + N5=NY+1 + N6=L + ENDIF + ELSEIF(N.EQ.3)THEN + IF(L.EQ.NL(NY,NX))THEN + GO TO 4320 + ELSE + N4=NX + N5=NY + N6=L+1 + ENDIF + ENDIF + DIST(N,N6,N5,N4)=0.5*(DLYR(N,N3,N2,N1)+DLYR(N,N6,N5,N4)) + XDPTH(N,N6,N5,N4)=AREA(N,N3,N2,N1)/DIST(N,N6,N5,N4) + DISP(N,N6,N5,N4)=0.20*DIST(N,N6,N5,N4)**1.07 +4320 CONTINUE + IF(L.EQ.NU(NY,NX))THEN + DIST(3,N3,N2,N1)=0.5*DLYR(3,N3,N2,N1) + XDPTH(3,N3,N2,N1)=AREA(3,N3,N2,N1)/DIST(3,N3,N2,N1) + DISP(3,N3,N2,N1)=0.20*DIST(3,N3,N2,N1)**1.07 + ENDIF +4400 CONTINUE +C +C INITIALIZE SOM FROM ORGANIC INPUTS IN SOIL FILE FROM 'READS' +C + TORGC=0.0 + DO 1190 L=NU(NY,NX),NL(NY,NX) + CORGCZ=CORGC(L,NY,NX) + CORGRZ=CORGR(L,NY,NX) + CORGNZ=CORGN(L,NY,NX) + CORGPZ=CORGP(L,NY,NX) + CORGCX(3)=CORGRZ + CORGCX(4)=AMAX1(0.0,CORGCZ-CORGCX(3)) + CORGNX(3)=AMIN1(CNRH(3)*CORGCX(3),CORGNZ) + CORGNX(4)=AMAX1(0.0,CORGNZ-CORGNX(3)) + CORGPX(3)=AMIN1(CPRH(3)*CORGCX(3),CORGPZ) + CORGPX(4)=AMAX1(0.0,CORGPZ-CORGPX(3)) + CORGL=AMAX1(0.0,CORGC(L,NY,NX)-CORGR(L,NY,NX)) + 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))) + IF(TORGM.GT.ZERO)THEN + HCX=LOG(0.5)/TORGM + ELSE + HCX=0.0 + ENDIF + DO 1200 L=0,NL(NY,NX) + IF(BKVL(L,NY,NX).GT.0.0)THEN + CORGCX(0)=RSC(0,L,NY,NX)*AREA(3,L,NY,NX)/BKVL(L,NY,NX) + CORGCX(1)=RSC(1,L,NY,NX)*AREA(3,L,NY,NX)/BKVL(L,NY,NX) + CORGCX(2)=RSC(2,L,NY,NX)*AREA(3,L,NY,NX)/BKVL(L,NY,NX) + CORGNX(0)=RSN(0,L,NY,NX)*AREA(3,L,NY,NX)/BKVL(L,NY,NX) + CORGNX(1)=RSN(1,L,NY,NX)*AREA(3,L,NY,NX)/BKVL(L,NY,NX) + CORGNX(2)=RSN(2,L,NY,NX)*AREA(3,L,NY,NX)/BKVL(L,NY,NX) + CORGPX(0)=RSP(0,L,NY,NX)*AREA(3,L,NY,NX)/BKVL(L,NY,NX) + CORGPX(1)=RSP(1,L,NY,NX)*AREA(3,L,NY,NX)/BKVL(L,NY,NX) + CORGPX(2)=RSP(2,L,NY,NX)*AREA(3,L,NY,NX)/BKVL(L,NY,NX) + ELSE + CORGCX(0)=0.5E+06 + CORGCX(1)=0.5E+06 + CORGCX(2)=0.5E+06 + CORGNX(0)=0.5E+05 + CORGNX(1)=0.5E+05 + CORGNX(2)=0.5E+05 + CORGPX(0)=0.5E+04 + CORGPX(1)=0.5E+04 + CORGPX(2)=0.5E+04 + ENDIF + IF(L.GT.0)THEN + CORGCZ=CORGC(L,NY,NX) + CORGRZ=CORGR(L,NY,NX) + CORGNZ=CORGN(L,NY,NX) + CORGPZ=CORGP(L,NY,NX) + IF(CORGCZ.GT.ZERO)THEN + CORGCX(3)=CORGRZ + CORGCX(4)=AMAX1(0.0,CORGCZ-CORGCX(3)) + CORGNX(3)=AMIN1(CNRH(3)*CORGCX(3),CORGNZ) + CORGNX(4)=AMAX1(0.0,CORGNZ-CORGNX(3)) + CORGPX(3)=AMIN1(CPRH(3)*CORGCX(3),CORGPZ) + CORGPX(4)=AMAX1(0.0,CORGPZ-CORGPX(3)) + ELSE + CORGCX(3)=0.0 + CORGCX(4)=0.0 + CORGNX(3)=0.0 + CORGNX(4)=0.0 + CORGPX(3)=0.0 + CORGPX(4)=0.0 + ENDIF + ELSE + CORGCX(3)=0.0 + CORGCX(4)=0.0 + CORGNX(3)=0.0 + CORGNX(4)=0.0 + CORGPX(3)=0.0 + CORGPX(4)=0.0 + ENDIF +C +C SURFACE RESIDUE +C + IF(L.EQ.0)THEN +C +C PREVIOUS COARSE WOODY RESIDUE +C + CFOSC(1,0,L,NY,NX)=0.000 + CFOSC(2,0,L,NY,NX)=0.045 + CFOSC(3,0,L,NY,NX)=0.660 + CFOSC(4,0,L,NY,NX)=0.295 +C +C MAIZE +C + IF(IXTYP(1,NY,NX).EQ.1)THEN + CFOSC(1,1,L,NY,NX)=0.080 + CFOSC(2,1,L,NY,NX)=0.245 + CFOSC(3,1,L,NY,NX)=0.613 + CFOSC(4,1,L,NY,NX)=0.062 +C +C WHEAT +C + ELSEIF(IXTYP(1,NY,NX).EQ.2)THEN + CFOSC(1,1,L,NY,NX)=0.125 + CFOSC(2,1,L,NY,NX)=0.171 + CFOSC(3,1,L,NY,NX)=0.560 + CFOSC(4,1,L,NY,NX)=0.144 +C +C SOYBEAN +C + ELSEIF(IXTYP(1,NY,NX).EQ.3)THEN + CFOSC(1,1,L,NY,NX)=0.138 + CFOSC(2,1,L,NY,NX)=0.426 + CFOSC(3,1,L,NY,NX)=0.316 + CFOSC(4,1,L,NY,NX)=0.120 +C +C NEW STRAW +C + ELSEIF(IXTYP(1,NY,NX).EQ.4)THEN + CFOSC(1,1,L,NY,NX)=0.036 + CFOSC(2,1,L,NY,NX)=0.044 + CFOSC(3,1,L,NY,NX)=0.767 + CFOSC(4,1,L,NY,NX)=0.153 +C +C OLD STRAW +C + ELSEIF(IXTYP(1,NY,NX).EQ.5)THEN + CFOSC(1,1,L,NY,NX)=0.075 + CFOSC(2,1,L,NY,NX)=0.125 + CFOSC(3,1,L,NY,NX)=0.550 + CFOSC(4,1,L,NY,NX)=0.250 +C +C COMPOST +C + ELSEIF(IXTYP(1,NY,NX).EQ.6)THEN + CFOSC(1,1,L,NY,NX)=0.143 + CFOSC(2,1,L,NY,NX)=0.015 + CFOSC(3,1,L,NY,NX)=0.640 + CFOSC(4,1,L,NY,NX)=0.202 +C +C GREEN MANURE +C + ELSEIF(IXTYP(1,NY,NX).EQ.7)THEN + CFOSC(1,1,L,NY,NX)=0.202 + CFOSC(2,1,L,NY,NX)=0.013 + CFOSC(3,1,L,NY,NX)=0.560 + CFOSC(4,1,L,NY,NX)=0.225 +C +C NEW DECIDUOUS FOREST +C + ELSEIF(IXTYP(1,NY,NX).EQ.8)THEN + CFOSC(1,1,L,NY,NX)=0.07 + CFOSC(2,1,L,NY,NX)=0.41 + CFOSC(3,1,L,NY,NX)=0.36 + CFOSC(4,1,L,NY,NX)=0.16 +C +C NEW CONIFEROUS FOREST +C + ELSEIF(IXTYP(1,NY,NX).EQ.9)THEN + CFOSC(1,1,L,NY,NX)=0.07 + CFOSC(2,1,L,NY,NX)=0.25 + CFOSC(3,1,L,NY,NX)=0.38 + CFOSC(4,1,L,NY,NX)=0.30 +C +C OLD DECIDUOUS FOREST +C + ELSEIF(IXTYP(1,NY,NX).EQ.10)THEN + CFOSC(1,1,L,NY,NX)=0.02 + CFOSC(2,1,L,NY,NX)=0.06 + CFOSC(3,1,L,NY,NX)=0.34 + CFOSC(4,1,L,NY,NX)=0.58 +C +C OLD CONIFEROUS FOREST +C + ELSEIF(IXTYP(1,NY,NX).EQ.11)THEN + CFOSC(1,1,L,NY,NX)=0.02 + CFOSC(2,1,L,NY,NX)=0.06 + CFOSC(3,1,L,NY,NX)=0.34 + CFOSC(4,1,L,NY,NX)=0.58 +C +C DEFAULT +C + ELSE + CFOSC(1,1,L,NY,NX)=0.075 + CFOSC(2,1,L,NY,NX)=0.125 + CFOSC(3,1,L,NY,NX)=0.550 + CFOSC(4,1,L,NY,NX)=0.250 + ENDIF +C +C PREVIOUS COARSE (K=0) AND FINE (K=1) ROOTS +C + ELSE + CFOSC(1,0,L,NY,NX)=0.00 + CFOSC(2,0,L,NY,NX)=0.00 + CFOSC(3,0,L,NY,NX)=0.20 + CFOSC(4,0,L,NY,NX)=0.80 + CFOSC(1,1,L,NY,NX)=0.02 + CFOSC(2,1,L,NY,NX)=0.06 + CFOSC(3,1,L,NY,NX)=0.34 + CFOSC(4,1,L,NY,NX)=0.58 + ENDIF +C +C ANIMAL MANURE +C +C +C RUMINANT +C + IF(IXTYP(2,NY,NX).EQ.1)THEN + CFOSC(1,2,L,NY,NX)=0.036 + CFOSC(2,2,L,NY,NX)=0.044 + CFOSC(3,2,L,NY,NX)=0.630 + CFOSC(4,2,L,NY,NX)=0.290 +C +C NON-RUMINANT +C + ELSEIF(IXTYP(2,NY,NX).EQ.2)THEN + CFOSC(1,2,L,NY,NX)=0.138 + CFOSC(2,2,L,NY,NX)=0.401 + CFOSC(3,2,L,NY,NX)=0.316 + CFOSC(4,2,L,NY,NX)=0.145 +C +C OTHER +C + ELSE + CFOSC(1,2,L,NY,NX)=0.138 + CFOSC(2,2,L,NY,NX)=0.401 + CFOSC(3,2,L,NY,NX)=0.316 + CFOSC(4,2,L,NY,NX)=0.145 + ENDIF +C +C POM +C + IF(L.NE.0)THEN + CFOSC(1,3,L,NY,NX)=1.00 + CFOSC(2,3,L,NY,NX)=0.00 + CFOSC(3,3,L,NY,NX)=0.00 + CFOSC(4,3,L,NY,NX)=0.00 +C +C HUMUS PARTITIONED TO DIFFERENT FRACTIONS +C BASED ON SOC ACCUMULATION +C +C NATURAL SOILS +C +C + IF(ISOILR(NY,NX).EQ.0)THEN +C +C DRYLAND +C + IF(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 + FC0=FCY*EXP(-5.0*(AMIN1(CORGNX(4),10.0*CORGPX(4)) + 2/CORGCX(4))) + ELSE + FCO=FCY + ENDIF + FCX=EXP(HCX*TORGL(L)) +C +C WETLAND +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)) + 2/CORGCX(4))) + ELSE + FCO=FCY + ENDIF + FCX=(EXP(HCX*TORGL(L)))**0.50 + ENDIF + ELSE +C +C RECONSTRUCTED SOILS +C + FCY=0.60 + IF(CORGCX(4).GT.1.0E-32)THEN + FC0=FCY*EXP(-5.0*(AMIN1(CORGNX(4),10.0*CORGPX(4)) + 2/CORGCX(4))) + ELSE + FCO=FCY + ENDIF + FCX=0.10 + ENDIF + FC1=FC0*FCX + CFOSC(1,4,L,NY,NX)=FC1 + CFOSC(2,4,L,NY,NX)=1.0-FC1 + CFOSC(3,4,L,NY,NX)=0.00 + CFOSC(4,4,L,NY,NX)=0.00 +C +C MICROBIAL DETRITUS TO HUMUS MAINTAINS EXISTING PARTITIONING +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 + 2,CORGCX(4),CORGNX(4),CORGPX(4),DPTH(L,NY,NX),DTBLZ(NY,NX) + 3,CDPTH(NU(NY,NX),NY,NX),CDPTHG +5432 FORMAT(A8,I4,20E12.4) + ENDIF +C +C LAYER SOIL, HEAT, WATER, ICE, GAS AND AIR CONTENTS +C + PSISE(L,NY,NX)=PSIPS + ROXYF(L,NY,NX)=0.0 + RCO2F(L,NY,NX)=0.0 + ROXYL(L,NY,NX)=0.0 + RCH4F(L,NY,NX)=0.0 + RCH4L(L,NY,NX)=0.0 + IF(L.GT.0)THEN + HYST(L,NY,NX)=1.0 + 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) + 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 + 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) + ELSEIF(THW(L,NY,NX).EQ.1.0)THEN + THW(L,NY,NX)=FC(L,NY,NX) + ELSEIF(THW(L,NY,NX).LE.0.0)THEN + THW(L,NY,NX)=WP(L,NY,NX) + ENDIF + IF(THI(L,NY,NX).GT.1.0.OR.DPTH(L,NY,NX).GE.DTBLZ(NY,NX))THEN + THI(L,NY,NX)=AMAX1(0.0,AMIN1(POROS(L,NY,NX) + 2,POROS(L,NY,NX)-THW(L,NY,NX))) + ELSEIF(THI(L,NY,NX).EQ.1.0)THEN + THI(L,NY,NX)=AMAX1(0.0,AMIN1(FC(L,NY,NX) + 2,POROS(L,NY,NX)-THW(L,NY,NX))) + ELSEIF(THI(L,NY,NX).LT.0.0)THEN + THI(L,NY,NX)=AMAX1(0.0,AMIN1(WP(L,NY,NX) + 2,POROS(L,NY,NX)-THW(L,NY,NX))) + ENDIF + THETW(L,NY,NX)=THW(L,NY,NX) + VOLW(L,NY,NX)=THETW(L,NY,NX)*VOLX(L,NY,NX) + VOLWX(L,NY,NX)=VOLW(L,NY,NX) + VOLWH(L,NY,NX)=THETW(L,NY,NX)*VOLAH(L,NY,NX) + THETI(L,NY,NX)=THI(L,NY,NX) + VOLI(L,NY,NX)=THETI(L,NY,NX)*VOLX(L,NY,NX) + VOLIH(L,NY,NX)=THETI(L,NY,NX)*VOLAH(L,NY,NX) + ENDIF + 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)) + 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) + 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) + 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) + TKS(L,NY,NX)=TCS(L,NY,NX)+273.15 + PSISA(L,NY,NX)=-2.5E-03 + ELSE + VOLW(L,NY,NX)=1.0E-06*ORGC(L,NY,NX) + VOLWX(L,NY,NX)=VOLW(L,NY,NX) + VOLI(L,NY,NX)=0.0 + IF(VOLX(L,NY,NX).GT.0.0)THEN + THETW(L,NY,NX)=AMAX1(0.001,VOLW(L,NY,NX)/VOLX(L,NY,NX)) + ELSE + THETW(L,NY,NX)=0.001 + ENDIF + THETP(L,NY,NX)=0.95-THETW(L,NY,NX) + THETI(L,NY,NX)=0.0 + VHCPR(NY,NX)=2.496E-06*ORGC(L,NY,NX)+4.19*VOLW(L,NY,NX) + 2+1.9274*VOLI(L,NY,NX) + ENDIF +C +C INITIALIZE SOM VARIABLES +C + DO 975 K=0,2 + CNOSCT(K)=0.0 + CPOSCT(K)=0.0 + IF(RSC(K,L,NY,NX).GT.ZEROS(NY,NX))THEN + RNT=0.0 + RPT=0.0 + DO 970 M=1,4 + RNT=RNT+RSC(K,L,NY,NX)*CFOSC(M,K,L,NY,NX)*CNOFC(M,K) + RPT=RPT+RSC(K,L,NY,NX)*CFOSC(M,K,L,NY,NX)*CPOFC(M,K) +970 CONTINUE + FRNT=RSN(K,L,NY,NX)/RNT + FRPT=RSP(K,L,NY,NX)/RPT + DO 960 M=1,4 + CNOSC(M,K,L,NY,NX)=CNOFC(M,K)*FRNT + CPOSC(M,K,L,NY,NX)=CPOFC(M,K)*FRPT + CNOSCT(K)=CNOSCT(K)+CFOSC(M,K,L,NY,NX)*CNOSC(M,K,L,NY,NX) + CPOSCT(K)=CPOSCT(K)+CFOSC(M,K,L,NY,NX)*CPOSC(M,K,L,NY,NX) +960 CONTINUE + ELSE + DO 965 M=1,4 + CNOSC(M,K,L,NY,NX)=CNRH(K) + CPOSC(M,K,L,NY,NX)=CPRH(K) +965 CONTINUE + CNOSCT(K)=CNRH(K) + CPOSCT(K)=CPRH(K) + ENDIF +975 CONTINUE + DO 990 K=3,4 + CNOSCT(K)=0.0 + CPOSCT(K)=0.0 + IF(CORGCX(K).GT.ZERO)THEN + DO 985 M=1,4 + CNOSC(M,K,L,NY,NX)=CORGNX(K)/CORGCX(K) + CPOSC(M,K,L,NY,NX)=CORGPX(K)/CORGCX(K) + CNOSCT(K)=CNOSCT(K)+CFOSC(M,K,L,NY,NX)*CNOSC(M,K,L,NY,NX) + CPOSCT(K)=CPOSCT(K)+CFOSC(M,K,L,NY,NX)*CPOSC(M,K,L,NY,NX) +985 CONTINUE + ELSE + DO 980 M=1,4 + CNOSC(M,K,L,NY,NX)=CNRH(K) + CPOSC(M,K,L,NY,NX)=CPRH(K) +980 CONTINUE + CNOSCT(K)=CNRH(K) + CPOSCT(K)=CPRH(K) + ENDIF +990 CONTINUE + TOSCI=0.0 + TOSNI=0.0 + TOSPI=0.0 + DO 995 K=0,4 + IF(L.EQ.0)THEN + KK=K + ELSE + KK=4 + ENDIF + OSCI(K)=CORGCX(K)*BKVL(L,NY,NX) + OSNI(K)=CORGNX(K)*BKVL(L,NY,NX) + OSPI(K)=CORGPX(K)*BKVL(L,NY,NX) + TOSCK(K)=OMCK(K)+ORCK(K)+OQCK(K)+OHCK(K) + TOSNK(K)=OMCI(1,K)*CNOMC(1,1,K)+OMCI(2,K)*CNOMC(2,1,K) + 2+ORCK(K)*CNRH(K)+OQCK(K)*CNOSCT(KK)+OHCK(K)*CNOSCT(KK) + TOSPK(K)=OMCI(1,K)*CPOMC(1,1,K)+OMCI(2,K)*CPOMC(2,1,K) + 2+ORCK(K)*CPRH(K)+OQCK(K)*CPOSCT(KK)+OHCK(K)*CPOSCT(KK) + TOSCI=TOSCI+OSCI(K)*TOSCK(K) + TOSNI=TOSNI+OSCI(K)*TOSNK(K) + TOSPI=TOSPI+OSCI(K)*TOSPK(K) + OSCX(K)=0.0 + OSNX(K)=0.0 + OSPX(K)=0.0 +995 CONTINUE + TOMC=0.0 + DO 8995 K=0,4 + IF(L.EQ.0)THEN + OSCM(K)=DCKR*CORGCX(K)*BKVL(L,NY,NX) + X=0.0 + KK=K + FOSCI=1.0 + FOSNI=1.0 + FOSPI=1.0 +C WRITE(*,2424)'OSCM',NX,NY,L,K,OSCM(K),CORGCX(K) +C 2,BKVL(L,NY,NX),CORGCX(K)*BKVL(L,NY,NX),FCX + ELSE + IF(K.LE.2)THEN + OSCM(K)=DCKR*CORGCX(K)*BKVL(L,NY,NX) + ELSE + OSCM(K)=FCX*CORGCX(K)*BKVL(L,NY,NX)*DCKM/(CORGCX(4)+DCKM) + ENDIF +2424 FORMAT(A8,4I4,12E12.4) + X=1.0 + KK=4 + IF(TOSCI.GT.ZEROS(NY,NX))THEN + FOSCI=AMIN1(1.0,OSCI(KK)/TOSCI) + FOSNI=AMIN1(1.0,OSCI(KK)*CNOSCT(KK)/TOSNI) + FOSPI=AMIN1(1.0,OSCI(KK)*CPOSCT(KK)/TOSPI) + ELSE + FOSCI=0.0 + FOSNI=0.0 + FOSPI=0.0 + ENDIF + ENDIF +C +C MICROBIAL C, N AND P +C + DO 7990 N=1,7 + DO 7985 M=1,3 + OMC(M,N,5,L,NY,NX)=0.0 + OMN(M,N,5,L,NY,NX)=0.0 + OMP(M,N,5,L,NY,NX)=0.0 +7985 CONTINUE +7990 CONTINUE + DO 8990 N=1,7 + DO 8991 M=1,3 + OMC1=AMAX1(0.0,OSCM(K)*OMCI(M,K)*OMCF(N)*FOSCI) + OMN1=AMAX1(0.0,OMC1*CNOMC(M,N,K)*FOSNI) + OMP1=AMAX1(0.0,OMC1*CPOMC(M,N,K)*FOSPI) + OMC(M,N,K,L,NY,NX)=OMC1 + OMN(M,N,K,L,NY,NX)=OMN1 + OMP(M,N,K,L,NY,NX)=OMP1 + OSCX(KK)=OSCX(KK)+OMC1 + OSNX(KK)=OSNX(KK)+OMN1 + OSPX(KK)=OSPX(KK)+OMP1 + DO 8992 NN=1,7 + OMC(M,NN,5,L,NY,NX)=OMC(M,NN,5,L,NY,NX)+OMC1*OMCA(NN) + OMN(M,NN,5,L,NY,NX)=OMN(M,NN,5,L,NY,NX)+OMN1*OMCA(NN) + OMP(M,NN,5,L,NY,NX)=OMP(M,NN,5,L,NY,NX)+OMP1*OMCA(NN) + OSCX(KK)=OSCX(KK)+OMC1*OMCA(NN) + OSNX(KK)=OSNX(KK)+OMN1*OMCA(NN) + OSPX(KK)=OSPX(KK)+OMP1*OMCA(NN) +8992 CONTINUE +8991 CONTINUE +8990 CONTINUE +C +C MICROBIAL RESIDUE C, N AND P +C + DO 8985 M=1,2 + ORC(M,K,L,NY,NX)=X*AMAX1(0.0,OSCM(K)*ORCI(M,K)*FOSCI) + ORN(M,K,L,NY,NX)=AMAX1(0.0,ORC(M,K,L,NY,NX)*CNOMC(M,1,K)*FOSNI) + ORP(M,K,L,NY,NX)=AMAX1(0.0,ORC(M,K,L,NY,NX)*CPOMC(M,1,K)*FOSPI) + OSCX(KK)=OSCX(KK)+ORC(M,K,L,NY,NX) + OSNX(KK)=OSNX(KK)+ORN(M,K,L,NY,NX) + OSPX(KK)=OSPX(KK)+ORP(M,K,L,NY,NX) +8985 CONTINUE +C +C DOC, DON AND DOP +C + OQC(K,L,NY,NX)=X*AMAX1(0.0,OSCM(K)*OQCK(K)*FOSCI) + OQN(K,L,NY,NX)=AMAX1(0.0,OQC(K,L,NY,NX)*CNOSCT(KK)*FOSNI) + OQP(K,L,NY,NX)=AMAX1(0.0,OQC(K,L,NY,NX)*CPOSCT(KK)*FOSPI) + OQA(K,L,NY,NX)=0.0 + OQCH(K,L,NY,NX)=0.0 + OQNH(K,L,NY,NX)=0.0 + OQPH(K,L,NY,NX)=0.0 + OQAH(K,L,NY,NX)=0.0 + OSCX(KK)=OSCX(KK)+OQC(K,L,NY,NX) + OSNX(KK)=OSNX(KK)+OQN(K,L,NY,NX) + OSPX(KK)=OSPX(KK)+OQP(K,L,NY,NX) +C +C ADSORBED C, N AND P +C + OHC(K,L,NY,NX)=X*AMAX1(0.0,OSCM(K)*OHCK(K)*FOSCI) + OHN(K,L,NY,NX)=AMAX1(0.0,OHC(K,L,NY,NX)*CNOSCT(KK)*FOSNI) + OHP(K,L,NY,NX)=AMAX1(0.0,OHC(K,L,NY,NX)*CPOSCT(KK)*FOSPI) + OHA(K,L,NY,NX)=0.0 + OSCX(KK)=OSCX(KK)+OHC(K,L,NY,NX)+OHA(K,L,NY,NX) + OSNX(KK)=OSNX(KK)+OHN(K,L,NY,NX) + OSPX(KK)=OSPX(KK)+OHP(K,L,NY,NX) +C +C HUMUS C, N AND P +C + DO 8980 M=1,4 + OSC(M,K,L,NY,NX)=AMAX1(0.0,CFOSC(M,K,L,NY,NX)*(OSCI(K)-OSCX(K))) + IF(CNOSCT(K).GT.ZERO)THEN + OSN(M,K,L,NY,NX)=AMAX1(0.0,CFOSC(M,K,L,NY,NX)*CNOSC(M,K,L,NY,NX) + 2/CNOSCT(K)*(OSNI(K)-OSNX(K))) + ELSE + OSN(M,K,L,NY,NX)=0.0 + ENDIF + IF(CPOSCT(K).GT.ZERO)THEN + OSP(M,K,L,NY,NX)=AMAX1(0.0,CFOSC(M,K,L,NY,NX)*CPOSC(M,K,L,NY,NX) + 2/CPOSCT(K)*(OSPI(K)-OSPX(K))) + ELSE + OSP(M,K,L,NY,NX)=0.0 + ENDIF + IF(K.EQ.0)THEN + OSA(M,K,L,NY,NX)=0.0 + ELSE + OSA(M,K,L,NY,NX)=OSC(M,K,L,NY,NX) + ENDIF +8980 CONTINUE +8995 CONTINUE + OC=0.0 + ON=0.0 + OP=0.0 + RC=0.0 + IF(L.EQ.0)THEN + DO 6975 K=0,5 + RC0(K,NY,NX)=0.0 + RA0(K,NY,NX)=0.0 +6975 CONTINUE + ENDIF + DO 6990 K=0,5 + DO 6990 N=1,7 + OC=OC+OMC(3,N,K,L,NY,NX) + ON=ON+OMN(3,N,K,L,NY,NX) + OP=OP+OMP(3,N,K,L,NY,NX) + IF(K.LE.2)THEN + RC=RC+OMC(3,N,K,L,NY,NX) + ENDIF + ROXYS(N,K,L,NY,NX)=0.0 + RVMX4(N,K,L,NY,NX)=0.0 + RVMX3(N,K,L,NY,NX)=0.0 + RVMX2(N,K,L,NY,NX)=0.0 + RVMX1(N,K,L,NY,NX)=0.0 + RINHO(N,K,L,NY,NX)=0.0 + RINOO(N,K,L,NY,NX)=0.0 + RIPOO(N,K,L,NY,NX)=0.0 + IF(L.EQ.0)THEN + RINHOR(N,K,NY,NX)=0.0 + RINOOR(N,K,NY,NX)=0.0 + RIPOOR(N,K,NY,NX)=0.0 + ENDIF + DO 6990 M=1,3 + OC=OC+OMC(M,N,K,L,NY,NX) + ON=ON+OMN(M,N,K,L,NY,NX) + OP=OP+OMP(M,N,K,L,NY,NX) + IF(K.LE.2)THEN + RC=RC+OMC(M,N,K,L,NY,NX) + ENDIF + RC0(K,NY,NX)=RC0(K,NY,NX)+OMC(M,N,K,L,NY,NX) + RA0(K,NY,NX)=RA0(K,NY,NX)+OMC(M,N,K,L,NY,NX) +6990 CONTINUE + DO 6995 K=0,4 + DO 6985 M=1,2 + OC=OC+ORC(M,K,L,NY,NX) + ON=ON+ORN(M,K,L,NY,NX) + OP=OP+ORP(M,K,L,NY,NX) + IF(K.LE.2)THEN + RC=RC+ORC(M,K,L,NY,NX) + ENDIF + IF(L.EQ.0)THEN + RC0(K,NY,NX)=RC0(K,NY,NX)+ORC(M,K,L,NY,NX) + RA0(K,NY,NX)=RA0(K,NY,NX)+ORC(M,K,L,NY,NX) + ENDIF +6985 CONTINUE + OC=OC+OQC(K,L,NY,NX)+OQCH(K,L,NY,NX)+OHC(K,L,NY,NX) + 2+OQA(K,L,NY,NX)+OQAH(K,L,NY,NX)+OHA(K,L,NY,NX) + ON=ON+OQN(K,L,NY,NX)+OQNH(K,L,NY,NX)+OHN(K,L,NY,NX) + OP=OP+OQP(K,L,NY,NX)+OQPH(K,L,NY,NX)+OHP(K,L,NY,NX) + OC=OC+OQA(K,L,NY,NX)+OQAH(K,L,NY,NX) + IF(K.LE.2)THEN + RC=RC+OQC(K,L,NY,NX)+OQCH(K,L,NY,NX)+OHC(K,L,NY,NX) + 2+OQA(K,L,NY,NX)+OQAH(K,L,NY,NX)+OHA(K,L,NY,NX) + RC=RC+OQA(K,L,NY,NX)+OQAH(K,L,NY,NX) + ENDIF + IF(L.EQ.0)THEN + RC0(K,NY,NX)=RC0(K,NY,NX)+OQC(K,L,NY,NX)+OQCH(K,L,NY,NX) + 2+OHC(K,L,NY,NX)+OQA(K,L,NY,NX)+OQAH(K,L,NY,NX)+OHA(K,L,NY,NX) + RA0(K,NY,NX)=RA0(K,NY,NX)+OQC(K,L,NY,NX)+OQCH(K,L,NY,NX) + 2+OHC(K,L,NY,NX)+OQA(K,L,NY,NX)+OQAH(K,L,NY,NX)+OHA(K,L,NY,NX) + ENDIF + DO 6980 M=1,4 + OC=OC+OSC(M,K,L,NY,NX) + ON=ON+OSN(M,K,L,NY,NX) + OP=OP+OSP(M,K,L,NY,NX) + IF(K.LE.2)THEN + RC=RC+OSC(M,K,L,NY,NX) + ENDIF + IF(L.EQ.0)THEN + RC0(K,NY,NX)=RC0(K,NY,NX)+OSC(M,K,L,NY,NX) + RA0(K,NY,NX)=RA0(K,NY,NX)+OSA(M,K,L,NY,NX) + ENDIF +6980 CONTINUE +6995 CONTINUE + ORGC(L,NY,NX)=OC + ORGR(L,NY,NX)=RC +C +C INITIALIZE FERTILIZER ARRAYS +C + ZNH4FA(L,NY,NX)=0.0 + ZNH3FA(L,NY,NX)=0.0 + ZNHUFA(L,NY,NX)=0.0 + ZNO3FA(L,NY,NX)=0.0 + IF(L.GT.0)THEN + ZNH4FB(L,NY,NX)=0.0 + ZNH3FB(L,NY,NX)=0.0 + ZNHUFB(L,NY,NX)=0.0 + ZNO3FB(L,NY,NX)=0.0 + WDNHB(L,NY,NX)=0.0 + DPNHB(L,NY,NX)=0.0 + WDNOB(L,NY,NX)=0.0 + DPNOB(L,NY,NX)=0.0 + WDPOB(L,NY,NX)=0.0 + DPPOB(L,NY,NX)=0.0 + ENDIF + VLNH4(L,NY,NX)=1.0 + VLNO3(L,NY,NX)=1.0 + VLPO4(L,NY,NX)=1.0 + VLNHB(L,NY,NX)=0.0 + VLNOB(L,NY,NX)=0.0 + VLPOB(L,NY,NX)=0.0 + ROXYX(L,NY,NX)=0.0 + RNH4X(L,NY,NX)=0.0 + RNO3X(L,NY,NX)=0.0 + RNO2X(L,NY,NX)=0.0 + RN2OX(L,NY,NX)=0.0 + RPO4X(L,NY,NX)=0.0 + RP14X(L,NY,NX)=0.0 + RVMXC(L,NY,NX)=0.0 + RNHBX(L,NY,NX)=0.0 + RN3BX(L,NY,NX)=0.0 + RN2BX(L,NY,NX)=0.0 + RPOBX(L,NY,NX)=0.0 + RP1BX(L,NY,NX)=0.0 + RVMBC(L,NY,NX)=0.0 + DO 1250 K=0,4 + IF(L.GT.0)THEN + COCU(K,L,NY,NX)=0.0 + CONU(K,L,NY,NX)=0.0 + COPU(K,L,NY,NX)=0.0 + COAU(K,L,NY,NX)=0.0 + ENDIF +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 +9890 CONTINUE +9895 CONTINUE + RETURN + END + diff --git a/f77src/trnsfr.f b/f77src/trnsfr.f index 4526b31..4b240a9 100755 --- a/f77src/trnsfr.f +++ b/f77src/trnsfr.f @@ -1,4603 +1,4854 @@ - SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) -C -C THIS SUBROUTINE CALCULATES 3-DIMENSIONAL FLUXES OF ALL SOIL -C NON-SALT SOLUTES AND GASES -C - include "parameters.h" - include "blkc.h" - include "blk2a.h" - include "blk2b.h" - include "blk2c.h" - include "blk8a.h" - include "blk8b.h" - include "blk10.h" - include "blk11a.h" - include "blk11b.h" - include "blk13a.h" - include "blk13b.h" - include "blk13c.h" - include "blk15a.h" - include "blk15b.h" - include "blk18a.h" - include "blk18b.h" - include "blk19d.h" - include "blk20d.h" - include "blk20e.h" - include "blk21a.h" - include "blk21b.h" - include "blk22a.h" - include "blk22b.h" - include "blk22c.h" - DIMENSION CO2G2(JZ,JY,JX),CO2S2(0:JZ,JY,JX) - 2,CH4G2(JZ,JY,JX),CH4S2(0:JZ,JY,JX),OXYG2(JZ,JY,JX) - 3,OXYS2(0:JZ,JY,JX),Z2GG2(JZ,JY,JX),Z2GS2(0:JZ,JY,JX) - 4,Z2OG2(JZ,JY,JX),Z2OS2(0:JZ,JY,JX),ZN3G2(0:JZ,JY,JX) - 5,ZNH4S2(0:JZ,JY,JX),ZNH4B2(0:JZ,JY,JX),ZN3S2(0:JZ,JY,JX) - 6,ZNBS2(0:JZ,JY,JX),ZNO3S2(0:JZ,JY,JX),ZNO3B2(0:JZ,JY,JX) - 7,H2PO42(0:JZ,JY,JX),H2POB2(0:JZ,JY,JX),ZNO2S2(0:JZ,JY,JX) - 8,CGSGL2(JZ,JY,JX),CHSGL2(JZ,JY,JX),OGSGL2(JZ,JY,JX) - 9,ZGSGL2(JZ,JY,JX),Z2SGL2(JZ,JY,JX),ZHSGL2(JZ,JY,JX) - 7,OQC2(0:4,0:JZ,JY,JX),OQN2(0:4,0:JZ,JY,JX),OQP2(0:4,0:JZ,JY,JX) - 8,OQA2(0:4,0:JZ,JY,JX),OCSGL2(0:JZ,JY,JX),ONSGL2(0:JZ,JY,JX) - 9,OPSGL2(0:JZ,JY,JX),OASGL2(0:JZ,JY,JX),CHY0(0:JZ,JY,JX) - 1,CO2W2(JY,JX),CH4W2(JY,JX),OXYW2(JY,JX),ZNGW2(JY,JX) - 2,ZN2W2(JY,JX),ZN4W2(JY,JX),ZN3W2(JY,JX),ZNOW2(JY,JX) - 3,ZHPW2(JY,JX) - DIMENSION ROCSK2(0:4,0:JZ,JY,JX),RONSK2(0:4,0:JZ,JY,JX) - 2,ROPSK2(0:4,0:JZ,JY,JX),ROASK2(0:4,0:JZ,JY,JX) - 3,RCOSK2(0:JZ,JY,JX),ROXSK2(0:JZ,JY,JX),RCHSK2(0:JZ,JY,JX) - 4,RNGSK2(0:JZ,JY,JX),RN2SK2(0:JZ,JY,JX),RN4SK2(0:JZ,JY,JX) - 5,RN3SK2(0:JZ,JY,JX),RNOSK2(0:JZ,JY,JX),RHPSK2(0:JZ,JY,JX) - 6,R4BSK2(JZ,JY,JX),R3BSK2(JZ,JY,JX),RNBSK2(JZ,JY,JX) - 7,RHBSK2(JZ,JY,JX),RNXSK2(0:JZ,JY,JX),RNZSK2(JZ,JY,JX) - 8,RHGSK2(0:JZ,JY,JX),RNHSK2(0:JZ,JY,JX) - DIMENSION CLSGL2(0:JZ,JY,JX),CQSGL2(0:JZ,JY,JX),OLSGL2(0:JZ,JY,JX) - 2,ZNSGL2(0:JZ,JY,JX),ZLSGL2(0:JZ,JY,JX),ZVSGL2(0:JZ,JY,JX) - 3,HLSGL2(0:JZ,JY,JX),ZOSGL2(0:JZ,JY,JX),POSGL2(0:JZ,JY,JX) - 4,RCODFS(JY,JX),RCHDFS(JY,JX),ROXDFS(JY,JX),RNGDFS(JY,JX) - 5,RN2DFS(JY,JX),RN3DFS(JY,JX),RNBDFS(JY,JX),RHGDFS(JY,JX) - 6,RCODFR(JY,JX),RCHDFR(JY,JX),ROXDFR(JY,JX),RNGDFR(JY,JX) - 7,RN2DFR(JY,JX),RN3DFR(JY,JX),RHGDFR(JY,JX) - 8,RQROC(0:4,2,JV,JH),RQRON(0:4,2,JV,JH),RQROP(0:4,2,JV,JH) - 9,RQROA(0:4,2,JV,JH),RQRCOS(2,JV,JH),RQRCHS(2,JV,JH) - 1,RQROXS(2,JV,JH),RQRNGS(2,JV,JH),RQRN2S(2,JV,JH),RQRNH4(2,JV,JH) - 2,RQRNH3(2,JV,JH),RQRNO3(2,JV,JH),RQRH2P(2,JV,JH) - 3,RQRNO2(2,JV,JH),RQRHGS(2,JV,JH),FLWU(JZ,JY,JX) - 4,RQSCOS(2,JV,JH),RQSCHS(2,JV,JH),RQSOXS(2,JV,JH) - 5,RQSNGS(2,JV,JH),RQSN2S(2,JV,JH),RQSNH4(2,JV,JH) - 6,RQSNH3(2,JV,JH),RQSNO3(2,JV,JH),RQSH2P(2,JV,JH) - DIMENSION RCOFLS(3,0:JD,JV,JH),RCHFLS(3,0:JD,JV,JH) - 2,ROXFLS(3,0:JD,JV,JH),RNGFLS(3,0:JD,JV,JH),RN2FLS(3,0:JD,JV,JH) - 3,RHGFLS(3,0:JD,JV,JH),RN4FLW(3,0:JD,JV,JH),RN3FLW(3,0:JD,JV,JH) - 4,RNOFLW(3,0:JD,JV,JH),RNXFLS(3,0:JD,JV,JH),RH2PFS(3,0:JD,JV,JH) - 5,RN4FLB(3,0:JD,JV,JH),RN3FLB(3,0:JD,JV,JH),RNOFLB(3,0:JD,JV,JH) - 6,RNXFLB(3,0:JD,JV,JH),RH2BFB(3,0:JD,JV,JH),RCOFHS(3,JD,JV,JH) - 7,RCHFHS(3,JD,JV,JH),ROXFHS(3,JD,JV,JH),RNGFHS(3,JD,JV,JH) - 8,RN2FHS(3,JD,JV,JH),RN4FHW(3,JD,JV,JH),RN3FHW(3,JD,JV,JH) - 9,RNOFHW(3,JD,JV,JH),RH2PHS(3,JD,JV,JH),RN4FHB(3,JD,JV,JH) - 1,RN3FHB(3,JD,JV,JH),RNOFHB(3,JD,JV,JH),RH2BHB(3,JD,JV,JH) - 2,ROCFLS(0:4,3,0:JD,JV,JH),RONFLS(0:4,3,0:JD,JV,JH) - 3,ROPFLS(0:4,3,0:JD,JV,JH),ROAFLS(0:4,3,0:JD,JV,JH) - 4,ROCFHS(0:4,3,JD,JV,JH),RONFHS(0:4,3,JD,JV,JH) - 5,ROPFHS(0:4,3,JD,JV,JH),ROAFHS(0:4,3,JD,JV,JH) - 6,ROXFLG(3,JD,JV,JH),RN3FLG(3,JD,JV,JH),RCOFLG(3,JD,JV,JH) - 7,RCHFLG(3,JD,JV,JH),RNGFLG(3,JD,JV,JH),RN2FLG(3,JD,JV,JH) - 8,RNXFHS(3,JD,JV,JH),RNXFHB(3,JD,JV,JH) - DIMENSION RCODFG(0:JZ,JY,JX),RCHDFG(0:JZ,JY,JX) - 1,ROXDFG(0:JZ,JY,JX),RNGDFG(0:JZ,JY,JX),RN2DFG(0:JZ,JY,JX) - 2,RN3DFG(0:JZ,JY,JX),RNBDFG(0:JZ,JY,JX),TQROC(0:4,JY,JX) - 3,TQRON(0:4,JY,JX),TQROP(0:4,JY,JX),TQROA(0:4,JY,JX),TQRCOS(JY,JX) - 4,TQRCHS(JY,JX),TQROXS(JY,JX),TQRNGS(JY,JX),TQRN2S(JY,JX) - 5,TQRNH4(JY,JX),TQRNH3(JY,JX),TQRNO3(JY,JX),TQRH2P(JY,JX) - 7,TQRNO2(JY,JX),TQRHGS(JY,JX),TQSCOS(JY,JX) - 4,TQSCHS(JY,JX),TQSOXS(JY,JX),TQSNGS(JY,JX),TQSN2S(JY,JX) - 5,TQSNH4(JY,JX),TQSNH3(JY,JX),TQSNO3(JY,JX),TQSH2P(JY,JX) - 8,TOCFLS(0:4,JZ,JY,JX),TONFLS(0:4,JZ,JY,JX) - 8,TOPFLS(0:4,JZ,JY,JX),TOAFLS(0:4,JZ,JY,JX),TCOFLS(JZ,JY,JX) - 9,TCHFLS(JZ,JY,JX),TOXFLS(JZ,JY,JX),TNGFLS(JZ,JY,JX) - 1,TN2FLS(JZ,JY,JX),TN4FLW(JZ,JY,JX),TN3FLW(JZ,JY,JX) - 2,TNOFLW(JZ,JY,JX),TH2PFS(JZ,JY,JX),TN4FLB(JZ,JY,JX) - 3,TN3FLB(JZ,JY,JX),TNOFLB(JZ,JY,JX),TH2BFB(JZ,JY,JX) - 4,TNXFLS(JZ,JY,JX),TCOFLG(JZ,JY,JX),TCHFLG(JZ,JY,JX) - 5,TOXFLG(JZ,JY,JX),TNGFLG(JZ,JY,JX),TN2FLG(JZ,JY,JX) - 6,RN34SQ(0:JZ,JY,JX),RN34BQ(0:JZ,JY,JX) - DIMENSION TN3FLG(JZ,JY,JX),RCOBBL(JZ,JY,JX) - 4,RCHBBL(JZ,JY,JX),ROXBBL(JZ,JY,JX),RNGBBL(JZ,JY,JX) - 5,RN2BBL(JZ,JY,JX),RN3BBL(JZ,JY,JX),RNBBBL(JZ,JY,JX) - 6,RHGBBL(JZ,JY,JX) - DIMENSION CO2SH2(JZ,JY,JX),CH4SH2(JZ,JY,JX),OXYSH2(JZ,JY,JX) - 2,Z2GSH2(JZ,JY,JX),Z2OSH2(JZ,JY,JX),ZNH4H2(JZ,JY,JX) - 3,ZN4BH2(JZ,JY,JX),ZNH3H2(JZ,JY,JX),ZN3BH2(JZ,JY,JX) - 4,ZNO3H2(JZ,JY,JX),ZNOBH2(JZ,JY,JX),H2P4H2(JZ,JY,JX) - 5,H2PBH2(JZ,JY,JX),ZNO2H2(JZ,JY,JX),OQCH2(0:4,JZ,JY,JX) - 6,OQNH2(0:4,JZ,JY,JX),OQPH2(0:4,JZ,JY,JX),OQAH2(0:4,JZ,JY,JX) - 7,TOCFHS(0:4,JZ,JY,JX),TONFHS(0:4,JZ,JY,JX),TOPFHS(0:4,JZ,JY,JX) - 8,TOAFHS(0:4,JZ,JY,JX),TCOFHS(JZ,JY,JX),TCHFHS(JZ,JY,JX) - 9,TOXFHS(JZ,JY,JX),TNGFHS(JZ,JY,JX),TN2FHS(JZ,JY,JX) - 1,TN4FHW(JZ,JY,JX),TN3FHW(JZ,JY,JX),TNOFHW(JZ,JY,JX) - 2,TH2PHS(JZ,JY,JX),TN4FHB(JZ,JY,JX),TN3FHB(JZ,JY,JX) - 3,TNOFHB(JZ,JY,JX),TH2BHB(JZ,JY,JX),TNXFHS(JZ,JY,JX) - 4,ZNO2B2(JZ,JY,JX),ZN2BH2(JZ,JY,JX),TNXFLB(JZ,JY,JX) - 5,TNXFHB(JZ,JY,JX) - DIMENSION RCOFLZ(JZ,JY,JX),RCHFLZ(JZ,JY,JX) - 1,ROXFLZ(JZ,JY,JX),RNGFLZ(JZ,JY,JX) - 2,RN2FLZ(JZ,JY,JX),RN4FLZ(JZ,JY,JX),RN3FLZ(JZ,JY,JX) - 3,RNOFLZ(JZ,JY,JX),RH2PFZ(JZ,JY,JX),RN4FBZ(JZ,JY,JX) - 4,RN3FBZ(JZ,JY,JX),RNOFBZ(JZ,JY,JX),RH2BBZ(JZ,JY,JX) - DIMENSION ROCFXS(0:4,JZ,JY,JX),RONFXS(0:4,JZ,JY,JX) - 1,ROPFXS(0:4,JZ,JY,JX),ROAFXS(0:4,JZ,JY,JX),RCOFXS(JZ,JY,JX) - 2,RCHFXS(JZ,JY,JX),ROXFXS(JZ,JY,JX) - 3,RNGFXS(JZ,JY,JX),RN2FXS(JZ,JY,JX),RN4FXW(JZ,JY,JX) - 4,RN3FXW(JZ,JY,JX),RNOFXW(JZ,JY,JX),RH2PXS(JZ,JY,JX) - 5,RN4FXB(JZ,JY,JX),RN3FXB(JZ,JY,JX),RNOFXB(JZ,JY,JX) - 6,RH2BXB(JZ,JY,JX),RNXFXS(JZ,JY,JX),RNXFXB(JZ,JY,JX) - DIMENSION RFLOC(0:4),RFLON(0:4),RFLOP(0:4),RFLOA(0:4) - 2,RFHOC(0:4),RFHON(0:4),RFHOP(0:4),RFHOA(0:4) ,COQC1(0:4) - 3,COQC2(0:4),COQN1(0:4),COQN2(0:4),COQP1(0:4),COQP2(0:4) - 4,COQA1(0:4),COQA2(0:4),COQCH1(0:4),COQCH2(0:4) - 3,COQNH1(0:4),COQNH2(0:4),COQPH1(0:4),COQPH2(0:4) - 4,COQAH1(0:4),COQAH2(0:4),DFVOC(0:4),DFVON(0:4),DFVOP(0:4) - 5,DFVOA(0:4),DFHOC(0:4),DFHON(0:4),DFHOP(0:4),DFHOA(0:4) - DIMENSION THETW1(0:JZ,JY,JX) - 2,DCO2G(3,JZ,JY,JX),DCH4G(3,JZ,JY,JX) - 3,DOXYG(3,JZ,JY,JX),DZ2GG(3,JZ,JY,JX),DZ2OG(3,JZ,JY,JX) - 4,DNH3G(3,JZ,JY,JX),VOLWCO(0:JZ,JY,JX),VOLWCH(0:JZ,JY,JX) - 5,VOLWOX(0:JZ,JY,JX),VOLWNG(0:JZ,JY,JX),VOLWN2(0:JZ,JY,JX) - 6,VOLWN3(0:JZ,JY,JX),VOLWNB(0:JZ,JY,JX),VOLWHG(0:JZ,JY,JX) - 7,H2GG2(JZ,JY,JX),H2GS2(0:JZ,JY,JX),H2GSH2(JZ,JY,JX) - 8,HGSGL2(JZ,JY,JX),DH2GG(3,JZ,JY,JX),RHGFXS(JZ,JY,JX) - 2,RHGFLZ(JZ,JY,JX),RHGFLG(3,JD,JV,JH),THGFLS(JZ,JY,JX) - 3,THGFHS(JZ,JY,JX),RHGDFG(0:JZ,JY,JX),FLQM(3,JD,JV,JH) - 4,RHGFHS(3,JD,JV,JH),THGFLG(JZ,JY,JX),FLVM(JZ,JY,JX) - 5,THETH2(JZ,JY,JX),THETHL(JZ,JY,JX),VOLPMA(JZ,JY,JX) - 6,VOLPMB(JZ,JY,JX),VOLWMA(JZ,JY,JX),VOLWMB(JZ,JY,JX) - 7,VOLWXA(0:JZ,JY,JX),VOLWXB(JZ,JY,JX),PARGCO(JY,JX) - 8,PARGCH(JY,JX),PARGOX(JY,JX),PARGNG(JY,JX) - 9,PARGN2(JY,JX),PARGN3(JY,JX),PARGH2(JY,JX) - DIMENSION ROCFL0(0:2,JY,JX),RONFL0(0:2,JY,JX),ROPFL0(0:2,JY,JX) - 2,ROAFL0(0:2,JY,JX),ROCFL1(0:2,JY,JX),RONFL1(0:2,JY,JX) - 3,ROPFL1(0:2,JY,JX),ROAFL1(0:2,JY,JX),RCOFL0(JY,JX),RCHFL0(JY,JX) - 4,ROXFL0(JY,JX),RNGFL0(JY,JX),RN2FL0(JY,JX),RHGFL0(JY,JX) - 5,RN4FL0(JY,JX),RN3FL0(JY,JX),RNOFL0(JY,JX),RNXFL0(JY,JX) - 6,RH2PF0(JY,JX),RCOFL1(JY,JX),RCHFL1(JY,JX),ROXFL1(JY,JX) - 7,RNGFL1(JY,JX),RN2FL1(JY,JX),RHGFL1(JY,JX),RN4FL1(JY,JX) - 8,RN3FL1(JY,JX),RNOFL1(JY,JX),RNXFL1(JY,JX),RH2PF1(JY,JX) - 9,RN4FL2(JY,JX),RN3FL2(JY,JX),RNOFL2(JY,JX),RNXFL2(JY,JX) - 1,RH2BF2(JY,JX) - DIMENSION VOLCOR(JY,JX),VOLCHR(JY,JX),VOLOXR(JY,JX),VOLNGR(JY,JX) - 2,VOLN2R(JY,JX),VOLN3R(JY,JX),VOLHGR(JY,JX),VOLCOT(JY,JX) - 3,VOLCHT(JY,JX),VOLOXT(JY,JX),VOLNGT(JY,JX),VOLN2T(JY,JX) - 4,VOLN3T(JY,JX),VOLNBT(JY,JX),VOLHGT(JY,JX) - PARAMETER(DPN4=5.7E-07,XFRX=0.5,XFRS=0.05) - REAL*4 CCO2SQ,CCH4SQ,COXYSQ,CZ2GSQ,CZ2OSQ,CNH3SQ - 2,CNH3BQ,CH2GSQ -C -C TIME STEPS FOR SOLUTE AND GAS FLUX CALCULATIONS -C - XNPX=1.0*XNPH - DO 9995 NX=NHW,NHE - DO 9990 NY=NVN,NVS -C -C GAS AND SOLUTE SINKS AND SOURCES IN SURFACE RESIDUE FROM MICROBIAL -C TRANSFORMATIONS IN 'NITRO' + ROOT EXCHANGE IN 'EXTRACT' -C + EQUILIBRIA REACTIONS IN 'SOLUTE' AT SUB-HOURLY TIME STEP -C - RCOSK2(0,NY,NX)=RCO2O(0,NY,NX)*XNPG - RCHSK2(0,NY,NX)=RCH4O(0,NY,NX)*XNPG - RNGSK2(0,NY,NX)=(RN2G(0,NY,NX)+XN2GS(0,NY,NX))*XNPG - 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 - 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 - ROASK2(K,0,NY,NX)=-XOQAS(K,0,NY,NX)*XNPH -14 CONTINUE - RN4SK2(0,NY,NX)=(-XNH4S(0,NY,NX)-TRN4S(0,NY,NX))*XNPH - RN3SK2(0,NY,NX)=-TRN3S(0,NY,NX)*XNPH - RNOSK2(0,NY,NX)=(-XNO3S(0,NY,NX)-TRNO3(0,NY,NX))*XNPH - RNXSK2(0,NY,NX)=(-XNO2S(0,NY,NX)-TRNO2(0,NY,NX))*XNPH - RHPSK2(0,NY,NX)=(-XH2PS(0,NY,NX)-TRH2P(0,NY,NX))*XNPH - CO2S2(0,NY,NX)=CO2S(0,NY,NX) - CH4S2(0,NY,NX)=CH4S(0,NY,NX) - OXYS2(0,NY,NX)=OXYS(0,NY,NX) - 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 - 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) - OQA2(K,0,NY,NX)=OQA(K,0,NY,NX)-XOQAS(K,0,NY,NX) -9979 CONTINUE - ZNH4S2(0,NY,NX)=ZNH4S(0,NY,NX) - ZN3S2(0,NY,NX)=ZNH3S(0,NY,NX) - ZNO3S2(0,NY,NX)=ZNO3S(0,NY,NX) - ZNO2S2(0,NY,NX)=ZNO2S(0,NY,NX) - H2PO42(0,NY,NX)=H2PO4(0,NY,NX) - CHY0(0,NY,NX)=10.0**(-(PH(0,NY,NX)-3.0)) -C -C SURFACE SOLUTE FLUXES FROM ATMOSPHERE -C - DO 8855 K=0,4 - IF(K.LE.2)THEN - XOCFLS(K,3,0,NY,NX)=0.0 - XONFLS(K,3,0,NY,NX)=0.0 - XOPFLS(K,3,0,NY,NX)=0.0 - XOAFLS(K,3,0,NY,NX)=0.0 - ENDIF - XOCFLS(K,3,NU(NY,NX),NY,NX)=0.0 - XONFLS(K,3,NU(NY,NX),NY,NX)=0.0 - XOPFLS(K,3,NU(NY,NX),NY,NX)=0.0 - XOAFLS(K,3,NU(NY,NX),NY,NX)=0.0 - XOCFHS(K,3,NU(NY,NX),NY,NX)=0.0 - XONFHS(K,3,NU(NY,NX),NY,NX)=0.0 - XOPFHS(K,3,NU(NY,NX),NY,NX)=0.0 - XOAFHS(K,3,NU(NY,NX),NY,NX)=0.0 -8855 CONTINUE -C -C HOURLY SOLUTE FLUXES FROM ATMOSPHERE TO SNOWPACK -C IN SNOWFALL AND IRRIGATION ACCORDING TO CONCENTRATIONS -C ENTERED IN WEATHER AND IRRIGATION FILES -C - IF(PRECW(NY,NX).GT.0.0.OR.(PRECR(NY,NX).GT.0.0 - 2.AND.VHCPW(NY,NX).GT.VHCPWX(NY,NX)))THEN - XCOBLS(NY,NX)=FLQGQ(NY,NX)*CCOR(NY,NX)+FLQGI(NY,NX)*CCOQ(NY,NX) - XCHBLS(NY,NX)=FLQGQ(NY,NX)*CCHR(NY,NX)+FLQGI(NY,NX)*CCHQ(NY,NX) - XOXBLS(NY,NX)=FLQGQ(NY,NX)*COXR(NY,NX)+FLQGI(NY,NX)*COXQ(NY,NX) - XNGBLS(NY,NX)=FLQGQ(NY,NX)*CNNR(NY,NX)+FLQGI(NY,NX)*CNNQ(NY,NX) - XN2BLS(NY,NX)=FLQGQ(NY,NX)*CN2R(NY,NX)+FLQGI(NY,NX)*CN2Q(NY,NX) - XHGBLS(NY,NX)=0.0 - XN4BLW(NY,NX)=(FLQGQ(NY,NX)*CN4R(NY,NX)+FLQGI(NY,NX) - 2*CN4Q(I,NY,NX))*14.0 - XN3BLW(NY,NX)=(FLQGQ(NY,NX)*CN3R(NY,NX)+FLQGI(NY,NX) - 2*CN3Q(I,NY,NX))*14.0 - XNOBLW(NY,NX)=(FLQGQ(NY,NX)*CNOR(NY,NX)+FLQGI(NY,NX) - 2*CNOQ(I,NY,NX))*14.0 - XH2PBS(NY,NX)=(FLQGQ(NY,NX)*CPOR(NY,NX)+FLQGI(NY,NX) - 2*CPOQ(I,NY,NX))*31.0 -C -C HOURLY SOLUTE FLUXES FROM ATMOSPHERE TO SOIL SURFACE -C IF RAINFALL AND IRRIGATION IS ZERO IF SNOWPACK IS PRESENT -C - XCOFLS(3,0,NY,NX)=0.0 - XCHFLS(3,0,NY,NX)=0.0 - XOXFLS(3,0,NY,NX)=0.0 - XNGFLS(3,0,NY,NX)=0.0 - XN2FLS(3,0,NY,NX)=0.0 - XHGFLS(3,0,NY,NX)=0.0 - XN4FLW(3,0,NY,NX)=0.0 - XN3FLW(3,0,NY,NX)=0.0 - XNOFLW(3,0,NY,NX)=0.0 - XNXFLS(3,0,NY,NX)=0.0 - XH2PFS(3,0,NY,NX)=0.0 - XCOFLS(3,NU(NY,NX),NY,NX)=0.0 - XCHFLS(3,NU(NY,NX),NY,NX)=0.0 - XOXFLS(3,NU(NY,NX),NY,NX)=0.0 - XNGFLS(3,NU(NY,NX),NY,NX)=0.0 - XN2FLS(3,NU(NY,NX),NY,NX)=0.0 - XHGFLS(3,NU(NY,NX),NY,NX)=0.0 - XN4FLW(3,NU(NY,NX),NY,NX)=0.0 - XN3FLW(3,NU(NY,NX),NY,NX)=0.0 - XNOFLW(3,NU(NY,NX),NY,NX)=0.0 - XNXFLS(3,NU(NY,NX),NY,NX)=0.0 - XH2PFS(3,NU(NY,NX),NY,NX)=0.0 - XN4FLB(3,NU(NY,NX),NY,NX)=0.0 - XN3FLB(3,NU(NY,NX),NY,NX)=0.0 - XNOFLB(3,NU(NY,NX),NY,NX)=0.0 - XNXFLB(3,NU(NY,NX),NY,NX)=0.0 - XH2BFB(3,NU(NY,NX),NY,NX)=0.0 -C -C HOURLY SOLUTE FLUXES FROM ATMOSPHERE TO SOIL SURFACE -C IN RAINFALL AND IRRIGATION ACCORDING TO CONCENTRATIONS -C ENTERED IN WEATHER AND IRRIGATION FILES -C - ELSEIF((PRECQ(NY,NX).GT.0.0.OR.PRECI(NY,NX).GT.0.0) - 2.AND.VHCPW(NY,NX).LE.VHCPWX(NY,NX))THEN -C -C HOURLY SOLUTE FLUXES FROM ATMOSPHERE TO SNOWPACK -C IF SNOWFALL AND IRRIGATION IS ZERO AND SNOWPACK IS ABSENT -C - XCOBLS(NY,NX)=0.0 - XCHBLS(NY,NX)=0.0 - XOXBLS(NY,NX)=0.0 - XNGBLS(NY,NX)=0.0 - XN2BLS(NY,NX)=0.0 - XHGBLS(NY,NX)=0.0 - XN4BLW(NY,NX)=0.0 - XN3BLW(NY,NX)=0.0 - XNOBLW(NY,NX)=0.0 - XH2PBS(NY,NX)=0.0 - XCOFLS(3,0,NY,NX)=FLQRQ(NY,NX)*CCOR(NY,NX) - 2+FLQRI(NY,NX)*CCOQ(NY,NX) - XCHFLS(3,0,NY,NX)=FLQRQ(NY,NX)*CCHR(NY,NX) - 2+FLQRI(NY,NX)*CCHQ(NY,NX) - XOXFLS(3,0,NY,NX)=FLQRQ(NY,NX)*COXR(NY,NX) - 2+FLQRI(NY,NX)*COXQ(NY,NX) - XNGFLS(3,0,NY,NX)=FLQRQ(NY,NX)*CNNR(NY,NX) - 2+FLQRI(NY,NX)*CNNQ(NY,NX) - XN2FLS(3,0,NY,NX)=FLQRQ(NY,NX)*CN2R(NY,NX) - 2+FLQRI(NY,NX)*CN2Q(NY,NX) - XHGFLS(3,0,NY,NX)=0.0 - XN4FLW(3,0,NY,NX)=(FLQRQ(NY,NX)*CN4R(NY,NX)+FLQRI(NY,NX) - 2*CN4Q(I,NY,NX))*14.0 - XN3FLW(3,0,NY,NX)=(FLQRQ(NY,NX)*CN3R(NY,NX)+FLQRI(NY,NX) - 2*CN3Q(I,NY,NX))*14.0 - XNOFLW(3,0,NY,NX)=(FLQRQ(NY,NX)*CNOR(NY,NX)+FLQRI(NY,NX) - 2*CNOQ(I,NY,NX))*14.0 - XNXFLS(3,0,NY,NX)=0.0 - XH2PFS(3,0,NY,NX)=(FLQRQ(NY,NX)*CPOR(NY,NX)+FLQRI(NY,NX) - 2*CPOQ(I,NY,NX))*31.0 - XCOFLS(3,NU(NY,NX),NY,NX)=FLQGQ(NY,NX)*CCOR(NY,NX) - 2+FLQGI(NY,NX)*CCOQ(NY,NX) - XCHFLS(3,NU(NY,NX),NY,NX)=FLQGQ(NY,NX)*CCHR(NY,NX) - 2+FLQGI(NY,NX)*CCHQ(NY,NX) - XOXFLS(3,NU(NY,NX),NY,NX)=FLQGQ(NY,NX)*COXR(NY,NX) - 2+FLQGI(NY,NX)*COXQ(NY,NX) - XNGFLS(3,NU(NY,NX),NY,NX)=FLQGQ(NY,NX)*CNNR(NY,NX) - 2+FLQGI(NY,NX)*CNNQ(NY,NX) - XN2FLS(3,NU(NY,NX),NY,NX)=FLQGQ(NY,NX)*CN2R(NY,NX) - 2+FLQGI(NY,NX)*CN2Q(NY,NX) - XHGFLS(3,NU(NY,NX),NY,NX)=0.0 - XN4FLW(3,NU(NY,NX),NY,NX)=((FLQGQ(NY,NX)*CN4R(NY,NX)+FLQGI(NY,NX) - 2*CN4Q(I,NY,NX))*14.0)*VLNH4(NU(NY,NX),NY,NX) - XN3FLW(3,NU(NY,NX),NY,NX)=((FLQGQ(NY,NX)*CN3R(NY,NX)+FLQGI(NY,NX) - 2*CN3Q(I,NY,NX))*14.0)*VLNH4(NU(NY,NX),NY,NX) - XNOFLW(3,NU(NY,NX),NY,NX)=((FLQGQ(NY,NX)*CNOR(NY,NX)+FLQGI(NY,NX) - 2*CNOQ(I,NY,NX))*14.0)*VLNO3(NU(NY,NX),NY,NX) - XNXFLS(3,NU(NY,NX),NY,NX)=0.0 - XH2PFS(3,NU(NY,NX),NY,NX)=((FLQGQ(NY,NX)*CPOR(NY,NX)+FLQGI(NY,NX) - 2*CPOQ(I,NY,NX))*31.0)*VLPO4(NU(NY,NX),NY,NX) - XN4FLB(3,NU(NY,NX),NY,NX)=((FLQGQ(NY,NX)*CN4R(NY,NX)+FLQGI(NY,NX) - 2*CN4Q(I,NY,NX))*14.0)*VLNHB(NU(NY,NX),NY,NX) - XN3FLB(3,NU(NY,NX),NY,NX)=((FLQGQ(NY,NX)*CN3R(NY,NX)+FLQGI(NY,NX) - 2*CN3Q(I,NY,NX))*14.0)*VLNHB(NU(NY,NX),NY,NX) - XNOFLB(3,NU(NY,NX),NY,NX)=((FLQGQ(NY,NX)*CNOR(NY,NX)+FLQGI(NY,NX) - 2*CNOQ(I,NY,NX))*14.0)*VLNOB(NU(NY,NX),NY,NX) - XNXFLB(3,NU(NY,NX),NY,NX)=0.0 - XH2BFB(3,NU(NY,NX),NY,NX)=((FLQGQ(NY,NX)*CPOR(NY,NX)+FLQGI(NY,NX) - 2*CPOQ(I,NY,NX))*31.0)*VLPOB(NU(NY,NX),NY,NX) -C -C NO SOLUTE FLUXES FROM ATMOSPHERE -C - ELSE - XCOBLS(NY,NX)=0.0 - XCHBLS(NY,NX)=0.0 - XOXBLS(NY,NX)=0.0 - XNGBLS(NY,NX)=0.0 - XN2BLS(NY,NX)=0.0 - XHGBLS(NY,NX)=0.0 - XN4BLW(NY,NX)=0.0 - XN3BLW(NY,NX)=0.0 - XNOBLW(NY,NX)=0.0 - XH2PBS(NY,NX)=0.0 - XCOFLS(3,0,NY,NX)=0.0 - XCHFLS(3,0,NY,NX)=0.0 - XOXFLS(3,0,NY,NX)=0.0 - XNGFLS(3,0,NY,NX)=0.0 - XN2FLS(3,0,NY,NX)=0.0 - XHGFLS(3,0,NY,NX)=0.0 - XN4FLW(3,0,NY,NX)=0.0 - XN3FLW(3,0,NY,NX)=0.0 - XNOFLW(3,0,NY,NX)=0.0 - XNXFLS(3,0,NY,NX)=0.0 - XH2PFS(3,0,NY,NX)=0.0 - XCOFLS(3,NU(NY,NX),NY,NX)=0.0 - XCHFLS(3,NU(NY,NX),NY,NX)=0.0 - XOXFLS(3,NU(NY,NX),NY,NX)=0.0 - XNGFLS(3,NU(NY,NX),NY,NX)=0.0 - XN2FLS(3,NU(NY,NX),NY,NX)=0.0 - XHGFLS(3,NU(NY,NX),NY,NX)=0.0 - XN4FLW(3,NU(NY,NX),NY,NX)=0.0 - XN3FLW(3,NU(NY,NX),NY,NX)=0.0 - XNOFLW(3,NU(NY,NX),NY,NX)=0.0 - XNXFLS(3,NU(NY,NX),NY,NX)=0.0 - XH2PFS(3,NU(NY,NX),NY,NX)=0.0 - XN4FLB(3,NU(NY,NX),NY,NX)=0.0 - XN3FLB(3,NU(NY,NX),NY,NX)=0.0 - XNOFLB(3,NU(NY,NX),NY,NX)=0.0 - XNXFLB(3,NU(NY,NX),NY,NX)=0.0 - XH2BFB(3,NU(NY,NX),NY,NX)=0.0 - ENDIF -C -C HOURLY SOLUTE FLUXES FROM MELTING SNOWPACK TO -C RESIDUE AND SOIL SURFACE FROM SNOWMELT IN 'WATSUB' AND -C CONCENTRATIONS IN SNOWPACK -C - FLQTM=FLQGM(NY,NX)+FLQRM(NY,NX) - IF(FLQTM.GT.ZEROS(NY,NX))THEN - VOLWW=VOLWS(NY,NX)+VOLSS(NY,NX)+VOLIS(NY,NX)*0.92 - IF(VOLWW.GT.ZEROS(NY,NX))THEN - VFLWW=AMAX1(0.0,AMIN1(1.0,FLQTM/VOLWW)) - ELSE - VFLWW=1.0 - ENDIF - VFLWG=VFLWW*FLQGM(NY,NX)/FLQTM - VFLWR=VFLWW*FLQRM(NY,NX)/FLQTM - XCOBLS(NY,NX)=XCOBLS(NY,NX)-CO2W(NY,NX)*VFLWW - XCHBLS(NY,NX)=XCHBLS(NY,NX)-CH4W(NY,NX)*VFLWW - XOXBLS(NY,NX)=XOXBLS(NY,NX)-OXYW(NY,NX)*VFLWW - XNGBLS(NY,NX)=XNGBLS(NY,NX)-ZNGW(NY,NX)*VFLWW - XN2BLS(NY,NX)=XN2BLS(NY,NX)-ZN2W(NY,NX)*VFLWW - XN4BLW(NY,NX)=XN4BLW(NY,NX)-ZN4W(NY,NX)*VFLWW - XN3BLW(NY,NX)=XN3BLW(NY,NX)-ZN3W(NY,NX)*VFLWW - XNOBLW(NY,NX)=XNOBLW(NY,NX)-ZNOW(NY,NX)*VFLWW - XH2PBS(NY,NX)=XH2PBS(NY,NX)-ZHPW(NY,NX)*VFLWW - XCOFLS(3,0,NY,NX)=XCOFLS(3,0,NY,NX)+CO2W(NY,NX)*VFLWR - XCHFLS(3,0,NY,NX)=XCHFLS(3,0,NY,NX)+CH4W(NY,NX)*VFLWR - XOXFLS(3,0,NY,NX)=XOXFLS(3,0,NY,NX)+OXYW(NY,NX)*VFLWR - XNGFLS(3,0,NY,NX)=XNGFLS(3,0,NY,NX)+ZNGW(NY,NX)*VFLWR - XN2FLS(3,0,NY,NX)=XN2FLS(3,0,NY,NX)+ZN2W(NY,NX)*VFLWR - XN4FLW(3,0,NY,NX)=XN4FLW(3,0,NY,NX)+ZN4W(NY,NX)*VFLWR - XN3FLW(3,0,NY,NX)=XN3FLW(3,0,NY,NX)+ZN3W(NY,NX)*VFLWR - XNOFLW(3,0,NY,NX)=XNOFLW(3,0,NY,NX)+ZNOW(NY,NX)*VFLWR - XH2PFS(3,0,NY,NX)=XH2PFS(3,0,NY,NX)+ZHPW(NY,NX)*VFLWR - XCOFLS(3,NU(NY,NX),NY,NX)=XCOFLS(3,NU(NY,NX),NY,NX) - 2+CO2W(NY,NX)*VFLWG - XCHFLS(3,NU(NY,NX),NY,NX)=XCHFLS(3,NU(NY,NX),NY,NX) - 2+CH4W(NY,NX)*VFLWG - XOXFLS(3,NU(NY,NX),NY,NX)=XOXFLS(3,NU(NY,NX),NY,NX) - 2+OXYW(NY,NX)*VFLWG - XNGFLS(3,NU(NY,NX),NY,NX)=XNGFLS(3,NU(NY,NX),NY,NX) - 2+ZNGW(NY,NX)*VFLWG - XN2FLS(3,NU(NY,NX),NY,NX)=XN2FLS(3,NU(NY,NX),NY,NX) - 2+ZN2W(NY,NX)*VFLWG - XN4FLW(3,NU(NY,NX),NY,NX)=XN4FLW(3,NU(NY,NX),NY,NX) - 2+ZN4W(NY,NX)*VFLWG*VLNH4(NU(NY,NX),NY,NX) - XN3FLW(3,NU(NY,NX),NY,NX)=XN3FLW(3,NU(NY,NX),NY,NX) - 2+ZN3W(NY,NX)*VFLWG*VLNH4(NU(NY,NX),NY,NX) - XNOFLW(3,NU(NY,NX),NY,NX)=XNOFLW(3,NU(NY,NX),NY,NX) - 2+ZNOW(NY,NX)*VFLWG*VLNO3(NU(NY,NX),NY,NX) - XH2PFS(3,NU(NY,NX),NY,NX)=XH2PFS(3,NU(NY,NX),NY,NX) - 2+ZHPW(NY,NX)*VFLWG*VLPO4(NU(NY,NX),NY,NX) - XN4FLB(3,NU(NY,NX),NY,NX)=XN4FLB(3,NU(NY,NX),NY,NX) - 2+ZN4W(NY,NX)*VFLWG*VLNHB(NU(NY,NX),NY,NX) - XN3FLB(3,NU(NY,NX),NY,NX)=XN3FLB(3,NU(NY,NX),NY,NX) - 2+ZN3W(NY,NX)*VFLWG*VLNHB(NU(NY,NX),NY,NX) - XNOFLB(3,NU(NY,NX),NY,NX)=XNOFLB(3,NU(NY,NX),NY,NX) - 2+ZNOW(NY,NX)*VFLWG*VLNOB(NU(NY,NX),NY,NX) - XH2BFB(3,NU(NY,NX),NY,NX)=XH2BFB(3,NU(NY,NX),NY,NX) - 2+ZHPW(NY,NX)*VFLWG*VLPOB(NU(NY,NX),NY,NX) - ENDIF - XCOFHS(3,NU(NY,NX),NY,NX)=0.0 - XCHFHS(3,NU(NY,NX),NY,NX)=0.0 - XOXFHS(3,NU(NY,NX),NY,NX)=0.0 - XNGFHS(3,NU(NY,NX),NY,NX)=0.0 - XN2FHS(3,NU(NY,NX),NY,NX)=0.0 - XHGFHS(3,NU(NY,NX),NY,NX)=0.0 - XN4FHW(3,NU(NY,NX),NY,NX)=0.0 - XN3FHW(3,NU(NY,NX),NY,NX)=0.0 - XNOFHW(3,NU(NY,NX),NY,NX)=0.0 - XH2PHS(3,NU(NY,NX),NY,NX)=0.0 - XN4FHB(3,NU(NY,NX),NY,NX)=0.0 - XN3FHB(3,NU(NY,NX),NY,NX)=0.0 - XNOFHB(3,NU(NY,NX),NY,NX)=0.0 - XNXFHB(3,NU(NY,NX),NY,NX)=0.0 - XH2BHB(3,NU(NY,NX),NY,NX)=0.0 - XNXFHS(3,NU(NY,NX),NY,NX)=0.0 - CO2W2(NY,NX)=CO2W(NY,NX)+XCOBLS(NY,NX) - CH4W2(NY,NX)=CH4W(NY,NX)+XCHBLS(NY,NX) - OXYW2(NY,NX)=OXYW(NY,NX)+XOXBLS(NY,NX) - ZNGW2(NY,NX)=ZNGW(NY,NX)+XNGBLS(NY,NX) - ZN2W2(NY,NX)=ZN2W(NY,NX)+XN2BLS(NY,NX) - ZN4W2(NY,NX)=ZN4W(NY,NX)+XN4BLW(NY,NX) - ZN3W2(NY,NX)=ZN3W(NY,NX)+XN3BLW(NY,NX) - ZNOW2(NY,NX)=ZNOW(NY,NX)+XNOBLW(NY,NX) - ZHPW2(NY,NX)=ZHPW(NY,NX)+XH2PBS(NY,NX) -C -C GAS AND SOLUTE FLUXES AT SUB-HOURLY FLUX TIME STEP -C ENTERED IN SITE FILE -C - DO 9845 K=0,2 - ROCFL0(K,NY,NX)=XOCFLS(K,3,0,NY,NX)*XNPH - RONFL0(K,NY,NX)=XONFLS(K,3,0,NY,NX)*XNPH - ROPFL0(K,NY,NX)=XOPFLS(K,3,0,NY,NX)*XNPH - ROAFL0(K,NY,NX)=XOAFLS(K,3,0,NY,NX)*XNPH - ROCFL1(K,NY,NX)=XOCFLS(K,3,NU(NY,NX),NY,NX)*XNPH - RONFL1(K,NY,NX)=XONFLS(K,3,NU(NY,NX),NY,NX)*XNPH - ROPFL1(K,NY,NX)=XOPFLS(K,3,NU(NY,NX),NY,NX)*XNPH - ROAFL1(K,NY,NX)=XOAFLS(K,3,NU(NY,NX),NY,NX)*XNPH -9845 CONTINUE - RCOFL0(NY,NX)=XCOFLS(3,0,NY,NX)*XNPH - RCHFL0(NY,NX)=XCHFLS(3,0,NY,NX)*XNPH - ROXFL0(NY,NX)=XOXFLS(3,0,NY,NX)*XNPH - RNGFL0(NY,NX)=XNGFLS(3,0,NY,NX)*XNPH - RN2FL0(NY,NX)=XN2FLS(3,0,NY,NX)*XNPH - RHGFL0(NY,NX)=XHGFLS(3,0,NY,NX)*XNPH - RN4FL0(NY,NX)=XN4FLW(3,0,NY,NX)*XNPH - RN3FL0(NY,NX)=XN3FLW(3,0,NY,NX)*XNPH - RNOFL0(NY,NX)=XNOFLW(3,0,NY,NX)*XNPH - RNXFL0(NY,NX)=XNXFLS(3,0,NY,NX)*XNPH - RH2PF0(NY,NX)=XH2PFS(3,0,NY,NX)*XNPH - RCOFL1(NY,NX)=XCOFLS(3,NU(NY,NX),NY,NX)*XNPH - RCHFL1(NY,NX)=XCHFLS(3,NU(NY,NX),NY,NX)*XNPH - ROXFL1(NY,NX)=XOXFLS(3,NU(NY,NX),NY,NX)*XNPH - RNGFL1(NY,NX)=XNGFLS(3,NU(NY,NX),NY,NX)*XNPH - RN2FL1(NY,NX)=XN2FLS(3,NU(NY,NX),NY,NX)*XNPH - RHGFL1(NY,NX)=XHGFLS(3,NU(NY,NX),NY,NX)*XNPH - RN4FL1(NY,NX)=XN4FLW(3,NU(NY,NX),NY,NX)*XNPH - RN3FL1(NY,NX)=XN3FLW(3,NU(NY,NX),NY,NX)*XNPH - RNOFL1(NY,NX)=XNOFLW(3,NU(NY,NX),NY,NX)*XNPH - RNXFL1(NY,NX)=XNXFLS(3,NU(NY,NX),NY,NX)*XNPH - RH2PF1(NY,NX)=XH2PFS(3,NU(NY,NX),NY,NX)*XNPH - RN4FL2(NY,NX)=XN4FLB(3,NU(NY,NX),NY,NX)*XNPH - RN3FL2(NY,NX)=XN3FLB(3,NU(NY,NX),NY,NX)*XNPH - RNOFL2(NY,NX)=XNOFLB(3,NU(NY,NX),NY,NX)*XNPH - RNXFL2(NY,NX)=XNXFLB(3,NU(NY,NX),NY,NX)*XNPH - RH2BF2(NY,NX)=XH2BFB(3,NU(NY,NX),NY,NX)*XNPH -C IF(I.EQ.118.AND.NX.EQ.3.AND.NY.EQ.4)THEN -C WRITE(*,6767)'ROXFL0',I,J,NX,NY,ROXFL0(NY,NX),XOXFLS(3,0,NY,NX) -C 2,OXYW(NY,NX),VFLWR -6767 FORMAT(A8,4I4,12E12.4) -C ENDIF -C -C GAS AND SOLUTE SINKS AND SOURCES IN SOIL LAYERS FROM MICROBIAL -C TRANSFORMATIONS IN 'NITRO' + ROOT EXCHANGE IN 'EXTRACT' -C + EQUILIBRIA REACTIONS IN 'SOLUTE' AT SUB-HOURLY TIME STEP -C - CLSGL2(0,NY,NX)=CLSGL(0,NY,NX)*XNPH - CQSGL2(0,NY,NX)=CQSGL(0,NY,NX)*XNPH - OLSGL2(0,NY,NX)=OLSGL(0,NY,NX)*XNPH - ZLSGL2(0,NY,NX)=ZLSGL(0,NY,NX)*XNPH - ZNSGL2(0,NY,NX)=ZNSGL(0,NY,NX)*XNPH - ZVSGL2(0,NY,NX)=ZVSGL(0,NY,NX)*XNPH - HLSGL2(0,NY,NX)=HLSGL(0,NY,NX)*XNPH - OCSGL2(0,NY,NX)=OCSGL(0,NY,NX)*XNPH - ONSGL2(0,NY,NX)=ONSGL(0,NY,NX)*XNPH - OPSGL2(0,NY,NX)=OPSGL(0,NY,NX)*XNPH - OASGL2(0,NY,NX)=OASGL(0,NY,NX)*XNPH - ZOSGL2(0,NY,NX)=ZOSGL(0,NY,NX)*XNPH - POSGL2(0,NY,NX)=POSGL(0,NY,NX)*XNPH - PARGM=PARG(NY,NX)*XNPT - PARGCO(NY,NX)=PARGM*0.74 - PARGCH(NY,NX)=PARGM*1.04 - PARGOX(NY,NX)=PARGM*0.83 - PARGNG(NY,NX)=PARGM*0.86 - PARGN2(NY,NX)=PARGM*0.74 - PARGN3(NY,NX)=PARGM*1.02 - PARGH2(NY,NX)=PARGM*2.08 - DO 10 L=NU(NY,NX),NL(NY,NX) - CHY0(L,NY,NX)=10.0**(-(PH(L,NY,NX)-3.0)) - FLWU(L,NY,NX)=TUPWTR(L,NY,NX)*XNPH - RCOSK2(L,NY,NX)=(RCO2O(L,NY,NX)+TCO2S(L,NY,NX)+TRCO2(L,NY,NX)) - 2*XNPG - RCHSK2(L,NY,NX)=(RCH4O(L,NY,NX)+TUPCHS(L,NY,NX))*XNPG - RNGSK2(L,NY,NX)=(RN2G(L,NY,NX)+XN2GS(L,NY,NX)+TUPNF(L,NY,NX)) - 2*XNPG - RN2SK2(L,NY,NX)=(RN2O(L,NY,NX)+TUPN2S(L,NY,NX))*XNPG - RNHSK2(L,NY,NX)=-TRN3G(L,NY,NX)*XNPG - RHGSK2(L,NY,NX)=(RH2GO(L,NY,NX)+TUPHGS(L,NY,NX))*XNPG - DO 15 K=0,4 - ROCSK2(K,L,NY,NX)=-XOQCS(K,L,NY,NX)*XNPH - RONSK2(K,L,NY,NX)=-XOQNS(K,L,NY,NX)*XNPH - ROPSK2(K,L,NY,NX)=-XOQPS(K,L,NY,NX)*XNPH - ROASK2(K,L,NY,NX)=-XOQAS(K,L,NY,NX)*XNPH -15 CONTINUE - RN4SK2(L,NY,NX)=(-XNH4S(L,NY,NX)-TRN4S(L,NY,NX) - 2+TUPNH4(L,NY,NX))*XNPH - RN3SK2(L,NY,NX)=(-TRN3S(L,NY,NX)+TUPN3S(L,NY,NX))*XNPH - RNOSK2(L,NY,NX)=(-XNO3S(L,NY,NX)-TRNO3(L,NY,NX) - 2+TUPNO3(L,NY,NX))*XNPH - RNXSK2(L,NY,NX)=(-XNO2S(L,NY,NX)-TRNO2(L,NY,NX))*XNPH - RHPSK2(L,NY,NX)=(-XH2PS(L,NY,NX)-TRH2P(L,NY,NX) - 2+TUPH2P(L,NY,NX))*XNPH - R4BSK2(L,NY,NX)=(-XNH4B(L,NY,NX)-TRN4B(L,NY,NX) - 2+TUPNHB(L,NY,NX))*XNPH - R3BSK2(L,NY,NX)=(-TRN3B(L,NY,NX)+TUPN3B(L,NY,NX))*XNPH - RNBSK2(L,NY,NX)=(-XNO3B(L,NY,NX)-TRNOB(L,NY,NX) - 2+TUPNOB(L,NY,NX))*XNPH - RNZSK2(L,NY,NX)=(-XNO2B(L,NY,NX)-TRN2B(L,NY,NX))*XNPH - RHBSK2(L,NY,NX)=(-XH2BS(L,NY,NX)-TRH2B(L,NY,NX) - 2+TUPH2B(L,NY,NX))*XNPH -C -C HOURLY SOLUTE FLUXES FROM SUBSURFACE IRRIGATION -C - RCOFLU(L,NY,NX)=FLU(L,NY,NX)*CCOQ(NY,NX) - RCHFLU(L,NY,NX)=FLU(L,NY,NX)*CCHQ(NY,NX) - ROXFLU(L,NY,NX)=FLU(L,NY,NX)*COXQ(NY,NX) - RNGFLU(L,NY,NX)=FLU(L,NY,NX)*CNNQ(NY,NX) - RN2FLU(L,NY,NX)=FLU(L,NY,NX)*CN2Q(NY,NX) - RHGFLU(L,NY,NX)=0.0 - RN4FLU(L,NY,NX)=FLU(L,NY,NX)*CN4Q(I,NY,NX)*VLNH4(L,NY,NX)*14.0 - RN3FLU(L,NY,NX)=FLU(L,NY,NX)*CN3Q(I,NY,NX)*VLNH4(L,NY,NX)*14.0 - RNOFLU(L,NY,NX)=FLU(L,NY,NX)*CNOQ(I,NY,NX)*VLNO3(L,NY,NX)*14.0 - RH2PFU(L,NY,NX)=FLU(L,NY,NX)*CPOQ(I,NY,NX)*VLPO4(L,NY,NX)*31.0 - RN4FBU(L,NY,NX)=FLU(L,NY,NX)*CN4Q(I,NY,NX)*VLNHB(L,NY,NX)*14.0 - RN3FBU(L,NY,NX)=FLU(L,NY,NX)*CN3Q(I,NY,NX)*VLNHB(L,NY,NX)*14.0 - RNOFBU(L,NY,NX)=FLU(L,NY,NX)*CNOQ(I,NY,NX)*VLNOB(L,NY,NX)*14.0 - RH2BBU(L,NY,NX)=FLU(L,NY,NX)*CPOQ(I,NY,NX)*VLPOB(L,NY,NX)*31.0 -C -C SUB-HOURLY SOLUTE FLUXES FROM SUBSURFACE IRRIGATION -C - RCOFLZ(L,NY,NX)=RCOFLU(L,NY,NX)*XNPH - RCHFLZ(L,NY,NX)=RCHFLU(L,NY,NX)*XNPH - ROXFLZ(L,NY,NX)=ROXFLU(L,NY,NX)*XNPH - RNGFLZ(L,NY,NX)=RNGFLU(L,NY,NX)*XNPH - RN2FLZ(L,NY,NX)=RN2FLU(L,NY,NX)*XNPH - RHGFLZ(L,NY,NX)=RHGFLU(L,NY,NX)*XNPH - RN4FLZ(L,NY,NX)=RN4FLU(L,NY,NX)*XNPH - RN3FLZ(L,NY,NX)=RN3FLU(L,NY,NX)*XNPH - RNOFLZ(L,NY,NX)=RNOFLU(L,NY,NX)*XNPH - RH2PFZ(L,NY,NX)=RH2PFU(L,NY,NX)*XNPH - RN4FBZ(L,NY,NX)=RN4FBU(L,NY,NX)*XNPH - RN3FBZ(L,NY,NX)=RN3FBU(L,NY,NX)*XNPH - RNOFBZ(L,NY,NX)=RNOFBU(L,NY,NX)*XNPH - RH2BBZ(L,NY,NX)=RH2BBU(L,NY,NX)*XNPH -C -C GAS AND SOLUTE DIFFUSIVITIES AT SUB-HOURLY TIME STEP -C - OCSGL2(L,NY,NX)=OCSGL(L,NY,NX)*XNPH - ONSGL2(L,NY,NX)=ONSGL(L,NY,NX)*XNPH - OPSGL2(L,NY,NX)=OPSGL(L,NY,NX)*XNPH - OASGL2(L,NY,NX)=OASGL(L,NY,NX)*XNPH - CLSGL2(L,NY,NX)=CLSGL(L,NY,NX)*XNPH - CQSGL2(L,NY,NX)=CQSGL(L,NY,NX)*XNPH - OLSGL2(L,NY,NX)=OLSGL(L,NY,NX)*XNPH - ZLSGL2(L,NY,NX)=ZLSGL(L,NY,NX)*XNPH - ZVSGL2(L,NY,NX)=ZVSGL(L,NY,NX)*XNPH - ZNSGL2(L,NY,NX)=ZNSGL(L,NY,NX)*XNPH - HLSGL2(L,NY,NX)=HLSGL(L,NY,NX)*XNPH - ZOSGL2(L,NY,NX)=ZOSGL(L,NY,NX)*XNPH - POSGL2(L,NY,NX)=POSGL(L,NY,NX)*XNPH - CGSGL2(L,NY,NX)=CGSGL(L,NY,NX)*XNPG - CHSGL2(L,NY,NX)=CHSGL(L,NY,NX)*XNPG - OGSGL2(L,NY,NX)=OGSGL(L,NY,NX)*XNPG - ZGSGL2(L,NY,NX)=ZGSGL(L,NY,NX)*XNPG - Z2SGL2(L,NY,NX)=Z2SGL(L,NY,NX)*XNPG - ZHSGL2(L,NY,NX)=ZHSGL(L,NY,NX)*XNPG - HGSGL2(L,NY,NX)=HGSGL(L,NY,NX)*XNPG -C -C STATE VARIABLES FOR GASES AND SOLUTES USED IN 'TRNSFR' -C TO STORE SUB-HOURLY CHANGES DURING FLUX CALCULATIONS -C INCLUDING TRANSFORMATIONS FROM 'NITRO', 'UPTAKE' AND 'SOLUTE' -C - CO2G2(L,NY,NX)=CO2G(L,NY,NX) - CH4G2(L,NY,NX)=CH4G(L,NY,NX) - OXYG2(L,NY,NX)=OXYG(L,NY,NX) - ZN3G2(L,NY,NX)=ZNH3G(L,NY,NX) - Z2GG2(L,NY,NX)=Z2GG(L,NY,NX) - Z2OG2(L,NY,NX)=Z2OG(L,NY,NX) - H2GG2(L,NY,NX)=H2GG(L,NY,NX) - CO2S2(L,NY,NX)=CO2S(L,NY,NX) - CH4S2(L,NY,NX)=CH4S(L,NY,NX) - OXYS2(L,NY,NX)=OXYS(L,NY,NX) - Z2GS2(L,NY,NX)=Z2GS(L,NY,NX) - Z2OS2(L,NY,NX)=Z2OS(L,NY,NX) - H2GS2(L,NY,NX)=H2GS(L,NY,NX) - DO 9980 K=0,4 - OQC2(K,L,NY,NX)=OQC(K,L,NY,NX)-XOQCS(K,L,NY,NX) - OQN2(K,L,NY,NX)=OQN(K,L,NY,NX)-XOQNS(K,L,NY,NX) - OQP2(K,L,NY,NX)=OQP(K,L,NY,NX)-XOQPS(K,L,NY,NX) - OQA2(K,L,NY,NX)=OQA(K,L,NY,NX)-XOQAS(K,L,NY,NX) - OQCH2(K,L,NY,NX)=OQCH(K,L,NY,NX) - OQNH2(K,L,NY,NX)=OQNH(K,L,NY,NX) - OQPH2(K,L,NY,NX)=OQPH(K,L,NY,NX) - OQAH2(K,L,NY,NX)=OQAH(K,L,NY,NX) -9980 CONTINUE - ZNH4S2(L,NY,NX)=ZNH4S(L,NY,NX) - ZN3S2(L,NY,NX)=ZNH3S(L,NY,NX) - ZNO3S2(L,NY,NX)=ZNO3S(L,NY,NX) - ZNO2S2(L,NY,NX)=ZNO2S(L,NY,NX) - H2PO42(L,NY,NX)=H2PO4(L,NY,NX) - ZNH4B2(L,NY,NX)=ZNH4B(L,NY,NX) - ZNBS2(L,NY,NX)=ZNH3B(L,NY,NX) - ZNO3B2(L,NY,NX)=ZNO3B(L,NY,NX) - ZNO2B2(L,NY,NX)=ZNO2B(L,NY,NX) - H2POB2(L,NY,NX)=H2POB(L,NY,NX) - CO2SH2(L,NY,NX)=CO2SH(L,NY,NX) - CH4SH2(L,NY,NX)=CH4SH(L,NY,NX) - OXYSH2(L,NY,NX)=OXYSH(L,NY,NX) - Z2GSH2(L,NY,NX)=Z2GSH(L,NY,NX) - Z2OSH2(L,NY,NX)=Z2OSH(L,NY,NX) - H2GSH2(L,NY,NX)=H2GSH(L,NY,NX) - ZNH4H2(L,NY,NX)=ZNH4SH(L,NY,NX) - ZNH3H2(L,NY,NX)=ZNH3SH(L,NY,NX) - ZNO3H2(L,NY,NX)=ZNO3SH(L,NY,NX) - ZNO2H2(L,NY,NX)=ZNO2SH(L,NY,NX) - H2P4H2(L,NY,NX)=H2PO4H(L,NY,NX) - ZN4BH2(L,NY,NX)=ZNH4BH(L,NY,NX) - ZN3BH2(L,NY,NX)=ZNH3BH(L,NY,NX) - ZNOBH2(L,NY,NX)=ZNO3BH(L,NY,NX) - ZN2BH2(L,NY,NX)=ZNO2BH(L,NY,NX) - H2PBH2(L,NY,NX)=H2POBH(L,NY,NX) -C IF(CDPTH(L,NY,NX).LT.DPNH4(NY,NX).AND.ROWN(NY,NX).GT.0.0)THEN -C VLNHB(L,NY,NX)=WDNHB(L,NY,NX)/ROWN(NY,NX) -C ELSE -C VLNHB(L,NY,NX)=0.0 -C ENDIF -C VLNH4(L,NY,NX)=1.0-VLNHB(L,NY,NX) -C IF(CDPTH(L-1,NY,NX).LT.DPNO3(NY,NX).AND.ROWO(NY,NX).GT.0.0)THEN -C VLNOB(L,NY,NX)=WDNOB(L,NY,NX)/ROWO(NY,NX) -C ELSE -C VLNOB(L,NY,NX)=0.0 -C ENDIF -C VLNO3(L,NY,NX)=1.0-VLNOB(L,NY,NX) -C IF(CDPTH(L,NY,NX).LT.DPPO4(NY,NX).AND.ROWP(NY,NX).GT.0.0)THEN -C VLPOB(L,NY,NX)=WDPOB(L,NY,NX)/ROWP(NY,NX) -C ELSE -C VLPOB(L,NY,NX)=0.0 -C ENDIF -C VLPO4(L,NY,NX)=1.0-VLPOB(L,NY,NX) -10 CONTINUE -9990 CONTINUE - -9995 CONTINUE -C -C TIME STEP USED IN GAS AND SOLUTE FLUX CALCULATIONS -C - MX=0 - DO 30 MM=1,NPG - M=MIN(NPH,INT((MM-1)*XNPT)+1) - DO 9895 NX=NHW,NHE - DO 9890 NY=NVN,NVS - IF(M.NE.MX)THEN -C -C RESET RUNOFF SOLUTE FLUX ACCUMULATORS -C - DO 9880 K=0,2 - TQROC(K,NY,NX)=0.0 - TQRON(K,NY,NX)=0.0 - TQROP(K,NY,NX)=0.0 - TQROA(K,NY,NX)=0.0 - OQC2(K,0,NY,NX)=OQC2(K,0,NY,NX)-ROCSK2(K,0,NY,NX) - OQN2(K,0,NY,NX)=OQN2(K,0,NY,NX)-RONSK2(K,0,NY,NX) - OQP2(K,0,NY,NX)=OQP2(K,0,NY,NX)-ROPSK2(K,0,NY,NX) - OQA2(K,0,NY,NX)=OQA2(K,0,NY,NX)-ROASK2(K,0,NY,NX) -9880 CONTINUE - TQRCOS(NY,NX)=0.0 - TQRCHS(NY,NX)=0.0 - TQROXS(NY,NX)=0.0 - TQRNGS(NY,NX)=0.0 - TQRN2S(NY,NX)=0.0 - TQRHGS(NY,NX)=0.0 - TQRNH4(NY,NX)=0.0 - TQRNH3(NY,NX)=0.0 - TQRNO3(NY,NX)=0.0 - TQRNO2(NY,NX)=0.0 - TQRH2P(NY,NX)=0.0 - TQSCOS(NY,NX)=0.0 - TQSCHS(NY,NX)=0.0 - TQSOXS(NY,NX)=0.0 - TQSNGS(NY,NX)=0.0 - TQSN2S(NY,NX)=0.0 - TQSNH4(NY,NX)=0.0 - TQSNH3(NY,NX)=0.0 - TQSNO3(NY,NX)=0.0 - TQSH2P(NY,NX)=0.0 - ZNH4S2(0,NY,NX)=ZNH4S2(0,NY,NX)-RN4SK2(0,NY,NX) - ZN3S2(0,NY,NX)=ZN3S2(0,NY,NX)-RN3SK2(0,NY,NX) - ZNO3S2(0,NY,NX)=ZNO3S2(0,NY,NX)-RNOSK2(0,NY,NX) - ZNO2S2(0,NY,NX)=ZNO2S2(0,NY,NX)-RNXSK2(0,NY,NX) - H2PO42(0,NY,NX)=H2PO42(0,NY,NX)-RHPSK2(0,NY,NX) - ROXSK2(0,NY,NX)=ROXSK(M,0,NY,NX)*XNPT - ENDIF - CO2S2(0,NY,NX)=CO2S2(0,NY,NX)-RCOSK2(0,NY,NX) - CH4S2(0,NY,NX)=CH4S2(0,NY,NX)-RCHSK2(0,NY,NX) - OXYS2(0,NY,NX)=OXYS2(0,NY,NX)-ROXSK2(0,NY,NX) - Z2GS2(0,NY,NX)=Z2GS2(0,NY,NX)-RNGSK2(0,NY,NX) - Z2OS2(0,NY,NX)=Z2OS2(0,NY,NX)-RN2SK2(0,NY,NX) - H2GS2(0,NY,NX)=H2GS2(0,NY,NX)-RHGSK2(0,NY,NX) - ZN3G2(0,NY,NX)=ZN3G2(0,NY,NX)-RNHSK2(0,NY,NX) -C -C RESET SOIL SOLUTE FLUX ACCUMULATORS -C - DO 9885 L=NU(NY,NX),NL(NY,NX) - IF(M.NE.MX)THEN - DO 9875 K=0,4 - TOCFLS(K,L,NY,NX)=0.0 - TONFLS(K,L,NY,NX)=0.0 - TOPFLS(K,L,NY,NX)=0.0 - TOAFLS(K,L,NY,NX)=0.0 - TOCFHS(K,L,NY,NX)=0.0 - TONFHS(K,L,NY,NX)=0.0 - TOPFHS(K,L,NY,NX)=0.0 - TOAFHS(K,L,NY,NX)=0.0 - OQC2(K,L,NY,NX)=OQC2(K,L,NY,NX)-ROCSK2(K,L,NY,NX) - OQN2(K,L,NY,NX)=OQN2(K,L,NY,NX)-RONSK2(K,L,NY,NX) - OQP2(K,L,NY,NX)=OQP2(K,L,NY,NX)-ROPSK2(K,L,NY,NX) - OQA2(K,L,NY,NX)=OQA2(K,L,NY,NX)-ROASK2(K,L,NY,NX) -9875 CONTINUE - TCOFLS(L,NY,NX)=0.0 - TCHFLS(L,NY,NX)=0.0 - TOXFLS(L,NY,NX)=0.0 - TNGFLS(L,NY,NX)=0.0 - TN2FLS(L,NY,NX)=0.0 - THGFLS(L,NY,NX)=0.0 - TN4FLW(L,NY,NX)=0.0 - TN3FLW(L,NY,NX)=0.0 - TNOFLW(L,NY,NX)=0.0 - TNXFLS(L,NY,NX)=0.0 - TH2PFS(L,NY,NX)=0.0 - TN4FLB(L,NY,NX)=0.0 - TN3FLB(L,NY,NX)=0.0 - TNOFLB(L,NY,NX)=0.0 - TNXFLB(L,NY,NX)=0.0 - TH2BFB(L,NY,NX)=0.0 - TCOFHS(L,NY,NX)=0.0 - TCHFHS(L,NY,NX)=0.0 - TOXFHS(L,NY,NX)=0.0 - TNGFHS(L,NY,NX)=0.0 - TN2FHS(L,NY,NX)=0.0 - THGFHS(L,NY,NX)=0.0 - TN4FHW(L,NY,NX)=0.0 - TN3FHW(L,NY,NX)=0.0 - TNOFHW(L,NY,NX)=0.0 - TNXFHS(L,NY,NX)=0.0 - TH2PHS(L,NY,NX)=0.0 - TN4FHB(L,NY,NX)=0.0 - TN3FHB(L,NY,NX)=0.0 - TNOFHB(L,NY,NX)=0.0 - TNXFHB(L,NY,NX)=0.0 - TH2BHB(L,NY,NX)=0.0 - ZNH4S2(L,NY,NX)=ZNH4S2(L,NY,NX)-RN4SK2(L,NY,NX) - ZN3S2(L,NY,NX)=ZN3S2(L,NY,NX)-RN3SK2(L,NY,NX) - ZNO3S2(L,NY,NX)=ZNO3S2(L,NY,NX)-RNOSK2(L,NY,NX) - ZNO2S2(L,NY,NX)=ZNO2S2(L,NY,NX)-RNXSK2(L,NY,NX) - H2PO42(L,NY,NX)=H2PO42(L,NY,NX)-RHPSK2(L,NY,NX) - ZNH4B2(L,NY,NX)=ZNH4B2(L,NY,NX)-R4BSK2(L,NY,NX) - ZNBS2(L,NY,NX)=ZNBS2(L,NY,NX)-R3BSK2(L,NY,NX) - ZNO3B2(L,NY,NX)=ZNO3B2(L,NY,NX)-RNBSK2(L,NY,NX) - ZNO2B2(L,NY,NX)=ZNO2B2(L,NY,NX)-RNZSK2(L,NY,NX) - H2POB2(L,NY,NX)=H2POB2(L,NY,NX)-RHBSK2(L,NY,NX) - ROXSK2(L,NY,NX)=ROXSK(M,L,NY,NX)*XNPT - ENDIF -C -C SOIL GAS FLUX ACCUMULATORS -C - TCOFLG(L,NY,NX)=0.0 - TCHFLG(L,NY,NX)=0.0 - TOXFLG(L,NY,NX)=0.0 - TNGFLG(L,NY,NX)=0.0 - TN2FLG(L,NY,NX)=0.0 - TN3FLG(L,NY,NX)=0.0 - THGFLG(L,NY,NX)=0.0 - CO2S2(L,NY,NX)=CO2S2(L,NY,NX)-RCOSK2(L,NY,NX) - CH4S2(L,NY,NX)=CH4S2(L,NY,NX)-RCHSK2(L,NY,NX) - OXYS2(L,NY,NX)=OXYS2(L,NY,NX)-ROXSK2(L,NY,NX) - Z2GS2(L,NY,NX)=Z2GS2(L,NY,NX)-RNGSK2(L,NY,NX) - 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) -9885 CONTINUE -C -C SOLUTE FLUXES AT SOIL SURFACE FROM SURFACE WATER -C CONTENTS, WATER FLUXES 'FLQM' AND ATMOSPHERE BOUNDARY -C LAYER RESISTANCES 'PARGM' FROM 'WATSUB' -C - IF(M.NE.MX)THEN - VOLWMA(NU(NY,NX),NY,NX)=VOLWM(M,NU(NY,NX),NY,NX) - 2*VLNH4(NU(NY,NX),NY,NX) - VOLWMB(NU(NY,NX),NY,NX)=VOLWM(M,NU(NY,NX),NY,NX) - 2*VLNHB(NU(NY,NX),NY,NX) - VOLWXA(NU(NY,NX),NY,NX)=14.0*VOLWMA(NU(NY,NX),NY,NX) - VOLWXB(NU(NY,NX),NY,NX)=14.0*VOLWMB(NU(NY,NX),NY,NX) - VOLWOA=VOLWM(M,NU(NY,NX),NY,NX)*VLNO3(NU(NY,NX),NY,NX) - VOLWOB=VOLWM(M,NU(NY,NX),NY,NX)*VLNOB(NU(NY,NX),NY,NX) - VOLWPA=VOLWM(M,NU(NY,NX),NY,NX)*VLPO4(NU(NY,NX),NY,NX) - VOLWPB=VOLWM(M,NU(NY,NX),NY,NX)*VLPOB(NU(NY,NX),NY,NX) - VOLPMA(NU(NY,NX),NY,NX)=VOLPM(M,NU(NY,NX),NY,NX) - 2*VLNH4(NU(NY,NX),NY,NX) - VOLPMB(NU(NY,NX),NY,NX)=VOLPM(M,NU(NY,NX),NY,NX) - 2*VLNHB(NU(NY,NX),NY,NX) - THETW1(NU(NY,NX),NY,NX)=AMAX1(0.0,VOLWM(M,NU(NY,NX),NY,NX) - 2/VOLX(NU(NY,NX),NY,NX)) - FLVM(NU(NY,NX),NY,NX)=FLPM(M,NU(NY,NX),NY,NX)*XNPT - FLQM(3,NU(NY,NX),NY,NX)=(FLWM(M,3,NU(NY,NX),NY,NX) - 2+FLWHM(M,3,NU(NY,NX),NY,NX))*XNPT -C -C SURFACE EXCHANGE OF AQUEOUS CO2, CH4, O2, N2, NH3 -C THROUGH VOLATILIZATION-DISSOLUTION FROM AQUEOUS -C DIFFUSIVITIES IN SURFACE RESIDUE -C - IF(VOLWM(M,0,NY,NX).GT.ZEROS(NY,NX))THEN - 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) - VOLWNG(0,NY,NX)=VOLWM(M,0,NY,NX)*SN2GL(0,NY,NX) - VOLWN2(0,NY,NX)=VOLWM(M,0,NY,NX)*SN2OL(0,NY,NX) - VOLWN3(0,NY,NX)=VOLWM(M,0,NY,NX)*SNH3L(0,NY,NX) - VOLWHG(0,NY,NX)=VOLWM(M,0,NY,NX)*SH2GL(0,NY,NX) - VOLWXA(0,NY,NX)=14.0*VOLWM(M,0,NY,NX) - TORT0=TORT(M,0,NY,NX)*AREA(3,NU(NY,NX),NY,NX) - 2/(0.5*DLYR(3,0,NY,NX)) - DFGSCO=CLSGL2(0,NY,NX)*TORT0 - DFGSCH=CQSGL2(0,NY,NX)*TORT0 - DFGSOX=OLSGL2(0,NY,NX)*TORT0 - DFGSNG=ZLSGL2(0,NY,NX)*TORT0 - DFGSN2=ZNSGL2(0,NY,NX)*TORT0 - DFGSN3=ZVSGL2(0,NY,NX)*TORT0 - DFGSHL=HLSGL2(0,NY,NX)*TORT0 - CO2S2X=AMAX1(0.0,CO2S2(0,NY,NX)) - CH4S2X=AMAX1(0.0,CH4S2(0,NY,NX)) - OXYS2X=AMAX1(0.0,OXYS2(0,NY,NX)) - Z2GS2X=AMAX1(0.0,Z2GS2(0,NY,NX)) - Z2OS2X=AMAX1(0.0,Z2OS2(0,NY,NX)) - ZN3S2X=AMAX1(0.0,ZN3S2(0,NY,NX)) - H2GS2X=AMAX1(0.0,H2GS2(0,NY,NX)) -C -C EQUILIBRIUM CONCENTRATIONS AT RESIDUE SURFACE AT WHICH -C AQUEOUS DIFFUSION THROUGH RESIDUE SURFACE LAYER = GASEOUS -C DIFFUSION THROUGH ATMOSPHERE BOUNDARY LAYER CALCULATED -C FROM AQUEOUS DIFFUSIVITY AND BOUNDARY LAYER CONDUCTANCE -C - CO2GQ=(PARR(NY,NX)*CCO2E(NY,NX)*VOLWCO(0,NY,NX)+DFGSCO - 2*CO2S2X)/(DFGSCO+PARR(NY,NX)) - CH4GQ=(PARR(NY,NX)*CCH4E(NY,NX)*VOLWCH(0,NY,NX)+DFGSCH - 2*CH4S2X)/(DFGSCH+PARR(NY,NX)) - OXYGQ=(PARR(NY,NX)*COXYE(NY,NX)*VOLWOX(0,NY,NX)+DFGSOX - 2*OXYS2X)/(DFGSOX+PARR(NY,NX)) - Z2GGQ=(PARR(NY,NX)*CZ2GE(NY,NX)*VOLWNG(0,NY,NX)+DFGSNG - 2*Z2GS2X)/(DFGSNG+PARR(NY,NX)) - Z2OGQ=(PARR(NY,NX)*CZ2OE(NY,NX)*VOLWN2(0,NY,NX)+DFGSN2 - 2*Z2OS2X)/(DFGSN2+PARR(NY,NX)) - ZN3GQ=(PARR(NY,NX)*CNH3E(NY,NX)*VOLWN3(0,NY,NX)+DFGSN3 - 2*ZN3S2X)/(DFGSN3+PARR(NY,NX)) - H2GGQ=(PARR(NY,NX)*CH2GE(NY,NX)*VOLWHG(0,NY,NX)+DFGSHL - 2*H2GS2X)/(DFGSHL+PARR(NY,NX)) -C -C SURFACE VOLATILIZATION-DISSOLUTION FROM DIFFERENCES -C BETWEEN ATMOSPHERIC AND RESIDUE SURFACE EQUILIBRIUM -C CONCENTRATIONS -C - RCODFR(NY,NX)=CO2GQ-CO2S2X - RCHDFR(NY,NX)=CH4GQ-CH4S2X - ROXDFR(NY,NX)=OXYGQ-OXYS2X - RNGDFR(NY,NX)=Z2GGQ-Z2GS2X - RN2DFR(NY,NX)=Z2OGQ-Z2OS2X - RN3DFR(NY,NX)=ZN3GQ-ZN3S2X - RHGDFR(NY,NX)=H2GGQ-H2GS2X -C -C ACCUMULATE HOURLY FLUXES -C - XCODFR(NY,NX)=XCODFR(NY,NX)+RCODFR(NY,NX) - XCHDFR(NY,NX)=XCHDFR(NY,NX)+RCHDFR(NY,NX) - XOXDFR(NY,NX)=XOXDFR(NY,NX)+ROXDFR(NY,NX) - XNGDFR(NY,NX)=XNGDFR(NY,NX)+RNGDFR(NY,NX) - 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 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) -C 4,DLYR(3,0,NY,NX),VOLWM(M,0,NY,NX) -C WRITE(*,1118)'RCHDFR',I,J,NX,NY,M,MM,RCHDFR(NY,NX) -C 2,CH4GQ,CH4S2(0,NY,NX),PARR(NY,NX),CCH4E(NY,NX) -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) -1118 FORMAT(A8,6I4,20E12.4) -C ENDIF - ELSE - RCODFR(NY,NX)=0.0 - RCHDFR(NY,NX)=0.0 - ROXDFR(NY,NX)=0.0 - RNGDFR(NY,NX)=0.0 - RN2DFR(NY,NX)=0.0 - RN3DFR(NY,NX)=0.0 - RHGDFR(NY,NX)=0.0 - ENDIF - RCODXR=RCODFR(NY,NX)*XNPT - RCHDXR=RCHDFR(NY,NX)*XNPT - ROXDXR=ROXDFR(NY,NX)*XNPT - RNGDXR=RNGDFR(NY,NX)*XNPT - RN2DXR=RN2DFR(NY,NX)*XNPT - RN3DXR=RN3DFR(NY,NX)*XNPT - RHGDXR=RHGDFR(NY,NX)*XNPT -C -C SURFACE EXCHANGE OF AQUEOUS CO2, CH4, O2, N2, NH3 -C THROUGH VOLATILIZATION-DISSOLUTION FROM AQUEOUS -C DIFFUSIVITIES IN SURFACE SOIL LAYER -C - IF(VOLWM(M,NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN - VOLWCO(NU(NY,NX),NY,NX)=VOLWM(M,NU(NY,NX),NY,NX) - 2*SCO2L(NU(NY,NX),NY,NX) - VOLWCH(NU(NY,NX),NY,NX)=VOLWM(M,NU(NY,NX),NY,NX) - 2*SCH4L(NU(NY,NX),NY,NX) - VOLWOX(NU(NY,NX),NY,NX)=VOLWM(M,NU(NY,NX),NY,NX) - 2*SOXYL(NU(NY,NX),NY,NX) - VOLWNG(NU(NY,NX),NY,NX)=VOLWM(M,NU(NY,NX),NY,NX) - 2*SN2GL(NU(NY,NX),NY,NX) - VOLWN2(NU(NY,NX),NY,NX)=VOLWM(M,NU(NY,NX),NY,NX) - 2*SN2OL(NU(NY,NX),NY,NX) - VOLWN3(NU(NY,NX),NY,NX)=VOLWMA(NU(NY,NX),NY,NX) - 2*SNH3L(NU(NY,NX),NY,NX) - VOLWNB(NU(NY,NX),NY,NX)=VOLWMB(NU(NY,NX),NY,NX) - 2*SNH3L(NU(NY,NX),NY,NX) - VOLWHG(NU(NY,NX),NY,NX)=VOLWM(M,NU(NY,NX),NY,NX) - 2*SH2GL(NU(NY,NX),NY,NX) - TORT1=TORT(M,NU(NY,NX),NY,NX)*AREA(3,NU(NY,NX),NY,NX) - 2/(0.5*DLYR(3,NU(NY,NX),NY,NX)) - DFGSCO=CLSGL2(NU(NY,NX),NY,NX)*TORT1 - DFGSCH=CQSGL2(NU(NY,NX),NY,NX)*TORT1 - DFGSOX=OLSGL2(NU(NY,NX),NY,NX)*TORT1 - DFGSNG=ZLSGL2(NU(NY,NX),NY,NX)*TORT1 - DFGSN2=ZNSGL2(NU(NY,NX),NY,NX)*TORT1 - DFGSN3=ZVSGL2(NU(NY,NX),NY,NX)*TORT1 - DFGSHL=HLSGL2(NU(NY,NX),NY,NX)*TORT1 - CO2S2X=AMAX1(0.0,CO2S2(NU(NY,NX),NY,NX)) - CH4S2X=AMAX1(0.0,CH4S2(NU(NY,NX),NY,NX)) - OXYS2X=AMAX1(0.0,OXYS2(NU(NY,NX),NY,NX)) - Z2GS2X=AMAX1(0.0,Z2GS2(NU(NY,NX),NY,NX)) - Z2OS2X=AMAX1(0.0,Z2OS2(NU(NY,NX),NY,NX)) - ZN3S2X=AMAX1(0.0,ZN3S2(NU(NY,NX),NY,NX)) - ZNBS2X=AMAX1(0.0,ZNBS2(NU(NY,NX),NY,NX)) - H2GS2X=AMAX1(0.0,H2GS2(NU(NY,NX),NY,NX)) -C -C EQUILIBRIUM CONCENTRATIONS AT SOIL SURFACE AT WHICH -C AQUEOUS DIFFUSION THROUGH SOIL SURFACE LAYER = GASEOUS -C DIFFUSION THROUGH ATMOSPHERE BOUNDARY LAYER CALCULATED -C FROM AQUEOUS DIFFUSIVITY AND BOUNDARY LAYER CONDUCTANCE -C - CO2GQ=(PARG(NY,NX)*CCO2E(NY,NX)*VOLWCO(NU(NY,NX),NY,NX) - 2+DFGSCO*CO2S2X)/(DFGSCO+PARG(NY,NX)) - CH4GQ=(PARG(NY,NX)*CCH4E(NY,NX)*VOLWCH(NU(NY,NX),NY,NX) - 2+DFGSCH*CH4S2X)/(DFGSCH+PARG(NY,NX)) - OXYGQ=(PARG(NY,NX)*COXYE(NY,NX)*VOLWOX(NU(NY,NX),NY,NX) - 2+DFGSOX*OXYS2X)/(DFGSOX+PARG(NY,NX)) - Z2GGQ=(PARG(NY,NX)*CZ2GE(NY,NX)*VOLWNG(NU(NY,NX),NY,NX) - 2+DFGSNG*Z2GS2X)/(DFGSNG+PARG(NY,NX)) - Z2OGQ=(PARG(NY,NX)*CZ2OE(NY,NX)*VOLWN2(NU(NY,NX),NY,NX) - 2+DFGSN2*Z2OS2X)/(DFGSN2+PARG(NY,NX)) - ZN3GQ=(PARG(NY,NX)*CNH3E(NY,NX)*VOLWN3(NU(NY,NX),NY,NX) - 2+DFGSN3*ZN3S2X)/(DFGSN3+PARG(NY,NX)) - ZNBGQ=(PARG(NY,NX)*CNH3E(NY,NX)*VOLWNB(NU(NY,NX),NY,NX) - 2+DFGSN3*ZNBS2X)/(DFGSN3+PARG(NY,NX)) - H2GGQ=(PARG(NY,NX)*CH2GE(NY,NX)*VOLWHG(NU(NY,NX),NY,NX) - 2+DFGSHL*H2GS2X)/(DFGSHL+PARG(NY,NX)) -C -C SURFACE VOLATILIZATION-DISSOLUTION FROM DIFFERENCES -C BETWEEN ATMOSPHERIC AND SOIL SURFACE EQUILIBRIUM -C CONCENTRATIONS -C - RCODFS(NY,NX)=CO2GQ-CO2S2X - RCHDFS(NY,NX)=CH4GQ-CH4S2X - ROXDFS(NY,NX)=OXYGQ-OXYS2X - RNGDFS(NY,NX)=Z2GGQ-Z2GS2X - RN2DFS(NY,NX)=Z2OGQ-Z2OS2X - RN3DFS(NY,NX)=ZN3GQ-ZN3S2X - RNBDFS(NY,NX)=ZNBGQ-ZNBS2X - RHGDFS(NY,NX)=H2GGQ-H2GS2X -C -C ACCUMULATE HOURLY FLUXES -C - XCODFS(NY,NX)=XCODFS(NY,NX)+RCODFS(NY,NX) - XCHDFS(NY,NX)=XCHDFS(NY,NX)+RCHDFS(NY,NX) - XOXDFS(NY,NX)=XOXDFS(NY,NX)+ROXDFS(NY,NX) - XNGDFS(NY,NX)=XNGDFS(NY,NX)+RNGDFS(NY,NX) - XN2DFS(NY,NX)=XN2DFS(NY,NX)+RN2DFS(NY,NX) - XN3DFS(NY,NX)=XN3DFS(NY,NX)+RN3DFS(NY,NX) - 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)'RCHDFS',I,J,NX,NY,M,MM,RCHDFS(NY,NX) -C 2,CH4GQ,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 3,COXYE(NY,NX),VOLWOX(NU(NY,NX),NY,NX),DFGSOX,TORT(M,0,NY,NX) -C 4,XOXDFS(NY,NX) -C ENDIF - ELSE - RCODFS(NY,NX)=0.0 - RCHDFS(NY,NX)=0.0 - ROXDFS(NY,NX)=0.0 - RNGDFS(NY,NX)=0.0 - RN2DFS(NY,NX)=0.0 - RN3DFS(NY,NX)=0.0 - RNBDFS(NY,NX)=0.0 - RHGDFS(NY,NX)=0.0 - ENDIF - RCODXS=RCODFS(NY,NX)*XNPT - RCHDXS=RCHDFS(NY,NX)*XNPT - ROXDXS=ROXDFS(NY,NX)*XNPT - RNGDXS=RNGDFS(NY,NX)*XNPT - RN2DXS=RN2DFS(NY,NX)*XNPT - RN3DXS=RN3DFS(NY,NX)*XNPT - RNBDXS=RNBDFS(NY,NX)*XNPT - RHGDXS=RHGDFS(NY,NX)*XNPT -C -C CONVECTIVE SOLUTE EXCHANGE BETWEEN RESIDUE AND SOIL SURFACE -C - FLWRM1=FLWRM(M,NY,NX) -C -C IF WATER FLUX FROM 'WATSUB' IS FROM RESIDUE TO -C SOIL SURFACE THEN CONVECTIVE TRANSPORT IS THE PRODUCT -C OF WATER FLUX AND MICROPORE GAS OR SOLUTE CONCENTRATIONS -C IN RESIDUE -C - IF(FLWRM1.GT.0.0)THEN - IF(VOLWM(M,0,NY,NX).GT.ZEROS(NY,NX))THEN - VFLW=AMAX1(0.0,AMIN1(XFRX,FLWRM1/VOLWM(M,0,NY,NX))) - ELSE - VFLW=XFRX - ENDIF - DO 8820 K=0,2 - 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)) - RFLOA(K)=VFLW*AMAX1(0.0,OQA2(K,0,NY,NX)) -8820 CONTINUE - RFLCOS=VFLW*AMAX1(0.0,CO2S2(0,NY,NX)) - RFLCHS=VFLW*AMAX1(0.0,CH4S2(0,NY,NX)) - RFLOXS=VFLW*AMAX1(0.0,OXYS2(0,NY,NX)) - RFLNGS=VFLW*AMAX1(0.0,Z2GS2(0,NY,NX)) - RFLN2S=VFLW*AMAX1(0.0,Z2OS2(0,NY,NX)) - RFLHGS=VFLW*AMAX1(0.0,H2GS2(0,NY,NX)) - RFLNH4=VFLW*AMAX1(0.0,ZNH4S2(0,NY,NX))*VLNH4(NU(NY,NX),NY,NX) - RFLNH3=VFLW*AMAX1(0.0,ZN3S2(0,NY,NX))*VLNH4(NU(NY,NX),NY,NX) - RFLNO3=VFLW*AMAX1(0.0,ZNO3S2(0,NY,NX))*VLNO3(NU(NY,NX),NY,NX) - RFLNO2=VFLW*AMAX1(0.0,ZNO2S2(0,NY,NX))*VLNO3(NU(NY,NX),NY,NX) - RFLPO4=VFLW*AMAX1(0.0,H2PO42(0,NY,NX))*VLPO4(NU(NY,NX),NY,NX) - RFLN4B=VFLW*AMAX1(0.0,ZNH4S2(0,NY,NX))*VLNHB(NU(NY,NX),NY,NX) - RFLN3B=VFLW*AMAX1(0.0,ZN3S2(0,NY,NX))*VLNHB(NU(NY,NX),NY,NX) - RFLNOB=VFLW*AMAX1(0.0,ZNO3S2(0,NY,NX))*VLNOB(NU(NY,NX),NY,NX) - RFLN2B=VFLW*AMAX1(0.0,ZNO2S2(0,NY,NX))*VLNOB(NU(NY,NX),NY,NX) - RFLPOB=VFLW*AMAX1(0.0,H2PO42(0,NY,NX))*VLPOB(NU(NY,NX),NY,NX) -C -C IF WATER FLUX FROM 'WATSUB' IS TO RESIDUE FROM -C SOIL SURFACE THEN CONVECTIVE TRANSPORT IS THE PRODUCT -C OF WATER FLUX AND MICROPORE GAS OR SOLUTE CONCENTRATIONS -C IN SOIL SURFACE -C - ELSE - IF(VOLWM(M,NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN - VFLW=AMIN1(0.0,AMAX1(-XFRX,FLWRM1/VOLWM(M,NU(NY,NX),NY,NX))) - ELSE - VFLW=-XFRX - ENDIF - DO 8815 K=0,2 - 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)) - RFLOA(K)=VFLW*AMAX1(0.0,OQA2(K,NU(NY,NX),NY,NX)) -8815 CONTINUE - RFLCOS=VFLW*AMAX1(0.0,CO2S2(NU(NY,NX),NY,NX)) - RFLCHS=VFLW*AMAX1(0.0,CH4S2(NU(NY,NX),NY,NX)) - RFLOXS=VFLW*AMAX1(0.0,OXYS2(NU(NY,NX),NY,NX)) - RFLNGS=VFLW*AMAX1(0.0,Z2GS2(NU(NY,NX),NY,NX)) - RFLN2S=VFLW*AMAX1(0.0,Z2OS2(NU(NY,NX),NY,NX)) - RFLHGS=VFLW*AMAX1(0.0,H2GS2(NU(NY,NX),NY,NX)) - RFLNH4=VFLW*AMAX1(0.0,ZNH4S2(NU(NY,NX),NY,NX)) - RFLNH3=VFLW*AMAX1(0.0,ZN3S2(NU(NY,NX),NY,NX)) - RFLNO3=VFLW*AMAX1(0.0,ZNO3S2(NU(NY,NX),NY,NX)) - RFLNO2=VFLW*AMAX1(0.0,ZNO2S2(NU(NY,NX),NY,NX)) - RFLPO4=VFLW*AMAX1(0.0,H2PO42(NU(NY,NX),NY,NX)) - RFLN4B=VFLW*AMAX1(0.0,ZNH4B2(NU(NY,NX),NY,NX)) - RFLN3B=VFLW*AMAX1(0.0,ZNBS2(NU(NY,NX),NY,NX)) - RFLNOB=VFLW*AMAX1(0.0,ZNO3B2(NU(NY,NX),NY,NX)) - RFLN2B=VFLW*AMAX1(0.0,ZNO2B2(NU(NY,NX),NY,NX)) - RFLPOB=VFLW*AMAX1(0.0,H2POB2(NU(NY,NX),NY,NX)) - ENDIF -C -C DIFFUSIVE FLUXES OF GASES AND SOLUTES BETWEEN RESIDUE AND -C SOIL SURFACE FROM AQUEOUS DIFFUSIVITIES -C AND CONCENTRATION DIFFERENCES -C - IF(THETW1(0,NY,NX).GT.THETY(0,NY,NX) - 2.AND.THETW1(NU(NY,NX),NY,NX).GT.THETY(NU(NY,NX),NY,NX))THEN -C -C MICROPORE CONCENTRATIONS FROM WATER IN RESIDUE AND SOIL SURFACE -C - DO 8810 K=0,2 - 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)) - COQA1(K)=AMAX1(0.0,OQA2(K,0,NY,NX)/VOLWM(M,0,NY,NX)) - COQC2(K)=AMAX1(0.0,OQC2(K,NU(NY,NX),NY,NX) - 2/VOLWM(M,NU(NY,NX),NY,NX)) - COQN2(K)=AMAX1(0.0,OQN2(K,NU(NY,NX),NY,NX) - 2/VOLWM(M,NU(NY,NX),NY,NX)) - COQP2(K)=AMAX1(0.0,OQP2(K,NU(NY,NX),NY,NX) - 2/VOLWM(M,NU(NY,NX),NY,NX)) - COQA2(K)=AMAX1(0.0,OQA2(K,NU(NY,NX),NY,NX) - 2/VOLWM(M,NU(NY,NX),NY,NX)) -8810 CONTINUE - CCO2S1=AMAX1(0.0,CO2S2(0,NY,NX)/VOLWM(M,0,NY,NX)) - CCH4S1=AMAX1(0.0,CH4S2(0,NY,NX)/VOLWM(M,0,NY,NX)) - COXYS1=AMAX1(0.0,OXYS2(0,NY,NX)/VOLWM(M,0,NY,NX)) - CZ2GS1=AMAX1(0.0,Z2GS2(0,NY,NX)/VOLWM(M,0,NY,NX)) - CZ2OS1=AMAX1(0.0,Z2OS2(0,NY,NX)/VOLWM(M,0,NY,NX)) - CH2GS1=AMAX1(0.0,H2GS2(0,NY,NX)/VOLWM(M,0,NY,NX)) - CNH4S1=AMAX1(0.0,ZNH4S2(0,NY,NX)/VOLWM(M,0,NY,NX)) - CNH3S1=AMAX1(0.0,ZN3S2(0,NY,NX)/VOLWM(M,0,NY,NX)) - CNO3S1=AMAX1(0.0,ZNO3S2(0,NY,NX)/VOLWM(M,0,NY,NX)) - CNO2S1=AMAX1(0.0,ZNO2S2(0,NY,NX)/VOLWM(M,0,NY,NX)) - CPO4S1=AMAX1(0.0,H2PO42(0,NY,NX)/VOLWM(M,0,NY,NX)) - CCO2S2=AMAX1(0.0,CO2S2(NU(NY,NX),NY,NX)/VOLWM(M,NU(NY,NX),NY,NX)) - CCH4S2=AMAX1(0.0,CH4S2(NU(NY,NX),NY,NX)/VOLWM(M,NU(NY,NX),NY,NX)) - COXYS2=AMAX1(0.0,OXYS2(NU(NY,NX),NY,NX)/VOLWM(M,NU(NY,NX),NY,NX)) - CZ2GS2=AMAX1(0.0,Z2GS2(NU(NY,NX),NY,NX)/VOLWM(M,NU(NY,NX),NY,NX)) - CZ2OS2=AMAX1(0.0,Z2OS2(NU(NY,NX),NY,NX)/VOLWM(M,NU(NY,NX),NY,NX)) - CH2GS2=AMAX1(0.0,H2GS2(NU(NY,NX),NY,NX)/VOLWM(M,NU(NY,NX),NY,NX)) - IF(VOLWMA(NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN - CNH3S2=AMAX1(0.0,ZN3S2(NU(NY,NX),NY,NX)/VOLWMA(NU(NY,NX),NY,NX)) - CNH4S2=AMAX1(0.0,ZNH4S2(NU(NY,NX),NY,NX)/VOLWMA(NU(NY,NX),NY,NX)) - ELSE - CNH3S2=0.0 - CNH4S2=0.0 - ENDIF - IF(VOLWOA.GT.ZEROS(NY,NX))THEN - CNO3S2=AMAX1(0.0,ZNO3S2(NU(NY,NX),NY,NX)/VOLWOA) - CNO2S2=AMAX1(0.0,ZNO2S2(NU(NY,NX),NY,NX)/VOLWOA) - ELSE - CNO3S2=0.0 - CNO2S2=0.0 - ENDIF - IF(VOLWPA.GT.ZEROS(NY,NX))THEN - CPO4S2=AMAX1(0.0,H2PO42(NU(NY,NX),NY,NX)/VOLWPA) - ELSE - CPO4S2=0.0 - ENDIF - IF(VOLWMB(NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN - CNH3B2=AMAX1(0.0,ZNBS2(NU(NY,NX),NY,NX)/VOLWMB(NU(NY,NX),NY,NX)) - CNH4B2=AMAX1(0.0,ZNH4B2(NU(NY,NX),NY,NX)/VOLWMB(NU(NY,NX),NY,NX)) - ELSE - CNH3B2=CNH3S2 - CNH4B2=CNH4S2 - ENDIF - IF(VOLWOB.GT.ZEROS(NY,NX))THEN - CNO3B2=AMAX1(0.0,ZNO3B2(NU(NY,NX),NY,NX)/VOLWOB) - CNO2B2=AMAX1(0.0,ZNO2B2(NU(NY,NX),NY,NX)/VOLWOB) - ELSE - CNO3B2=CNO3S2 - CNO2B2=CNO2S2 - ENDIF - IF(VOLWPB.GT.ZEROS(NY,NX))THEN - CPO4B2=AMAX1(0.0,H2POB2(NU(NY,NX),NY,NX)/VOLWPB) - ELSE - CPO4B2=CPO4S2 - ENDIF -C -C DIFFUSIVITIES IN RESIDUE AND SOIL SURFACE -C - TORT0=TORT(M,0,NY,NX)*AREA(3,NU(NY,NX),NY,NX) - 2/DLYR(3,0,NY,NX) - TORT1=TORT(M,NU(NY,NX),NY,NX)*AREA(3,NU(NY,NX),NY,NX) - 2/DLYR(3,NU(NY,NX),NY,NX) - DISPN=DISP(3,NU(NY,NX),NY,NX)*ABS(FLWRM1/AREA(3,NU(NY,NX),NY,NX)) - DIFOC0=(OCSGL2(0,NY,NX)*TORT0+DISPN) - DIFON0=(ONSGL2(0,NY,NX)*TORT0+DISPN) - DIFOP0=(OPSGL2(0,NY,NX)*TORT0+DISPN) - DIFOA0=(OASGL2(0,NY,NX)*TORT0+DISPN) - DIFNH0=(ZNSGL2(0,NY,NX)*TORT0+DISPN) - DIFNO0=(ZOSGL2(0,NY,NX)*TORT0+DISPN) - DIFPO0=(POSGL2(0,NY,NX)*TORT0+DISPN) - DIFCS0=(CLSGL2(0,NY,NX)*TORT0+DISPN) - DIFCQ0=(CQSGL2(0,NY,NX)*TORT0+DISPN) - DIFOS0=(OLSGL2(0,NY,NX)*TORT0+DISPN) - DIFNG0=(ZLSGL2(0,NY,NX)*TORT0+DISPN) - DIFN20=(ZVSGL2(0,NY,NX)*TORT0+DISPN) - DIFHG0=(HLSGL2(0,NY,NX)*TORT0+DISPN) - DIFOC1=(OCSGL2(NU(NY,NX),NY,NX)*TORT1+DISPN) - DIFON1=(ONSGL2(NU(NY,NX),NY,NX)*TORT1+DISPN) - DIFOP1=(OPSGL2(NU(NY,NX),NY,NX)*TORT1+DISPN) - DIFOA1=(OASGL2(NU(NY,NX),NY,NX)*TORT1+DISPN) - DIFNH1=(ZNSGL2(NU(NY,NX),NY,NX)*TORT1+DISPN) - DIFNO1=(ZOSGL2(NU(NY,NX),NY,NX)*TORT1+DISPN) - DIFPO1=(POSGL2(NU(NY,NX),NY,NX)*TORT1+DISPN) - DIFCS1=(CLSGL2(NU(NY,NX),NY,NX)*TORT1+DISPN) - DIFCQ1=(CQSGL2(NU(NY,NX),NY,NX)*TORT1+DISPN) - DIFOS1=(OLSGL2(NU(NY,NX),NY,NX)*TORT1+DISPN) - DIFNG1=(ZLSGL2(NU(NY,NX),NY,NX)*TORT1+DISPN) - DIFN21=(ZVSGL2(NU(NY,NX),NY,NX)*TORT1+DISPN) - DIFHG1=(HLSGL2(NU(NY,NX),NY,NX)*TORT1+DISPN) - DIFOC=DIFOC0*DIFOC1/(DIFOC0+DIFOC1) - DIFON=DIFON0*DIFON1/(DIFON0+DIFON1) - DIFOP=DIFOP0*DIFOP1/(DIFOP0+DIFOP1) - DIFOA=DIFOA0*DIFOA1/(DIFOA0+DIFOA1) - DIFNH=DIFNH0*DIFNH1/(DIFNH0+DIFNH1) - DIFNO=DIFNO0*DIFNO1/(DIFNO0+DIFNO1) - DIFPO=DIFPO0*DIFPO1/(DIFPO0+DIFPO1) - DIFCS=DIFCS0*DIFCS1/(DIFCS0+DIFCS1) - DIFCQ=DIFCQ0*DIFCQ1/(DIFCQ0+DIFCQ1) - DIFOS=DIFOS0*DIFOS1/(DIFOS0+DIFOS1) - DIFNG=DIFNG0*DIFNG1/(DIFNG0+DIFNG1) - DIFN2=DIFN20*DIFN21/(DIFN20+DIFN21) - DIFHG=DIFHG0*DIFHG1/(DIFHG0+DIFHG1) -C -C DIFFUSIVE FLUXES BETWEEN CURRENT AND ADJACENT GRID CELL -C MICROPORES -C - DO 8805 K=0,2 - DFVOC(K)=DIFOC*(COQC1(K)-COQC2(K)) - DFVON(K)=DIFON*(COQN1(K)-COQN2(K)) - DFVOP(K)=DIFOP*(COQP1(K)-COQP2(K)) - DFVOA(K)=DIFOA*(COQA1(K)-COQA2(K)) -8805 CONTINUE - DFVCOS=DIFCS*(CCO2S1-CCO2S2) - DFVCHS=DIFCQ*(CCH4S1-CCH4S2) - DFVOXS=DIFOS*(COXYS1-COXYS2) - DFVNGS=DIFNG*(CZ2GS1-CZ2GS2) - DFVN2S=DIFN2*(CZ2OS1-CZ2OS2) - DFVHGS=DIFHG*(CH2GS1-CH2GS2) - DFVNH4=DIFNH*(CNH4S1-CNH4S2)*VLNH4(NU(NY,NX),NY,NX) - DFVNH3=DIFNH*(CNH3S1-CNH3S2)*VLNH4(NU(NY,NX),NY,NX) - DFVNO3=DIFNO*(CNO3S1-CNO3S2)*VLNO3(NU(NY,NX),NY,NX) - DFVNO2=DIFNO*(CNO2S1-CNO2S2)*VLNO3(NU(NY,NX),NY,NX) - DFVPO4=DIFPO*(CPO4S1-CPO4S2)*VLPO4(NU(NY,NX),NY,NX) - DFVN4B=DIFNH*(CNH4S1-CNH4B2)*VLNHB(NU(NY,NX),NY,NX) - DFVN3B=DIFNH*(CNH3S1-CNH3B2)*VLNHB(NU(NY,NX),NY,NX) - DFVNOB=DIFNO*(CNO3S1-CNO3B2)*VLNOB(NU(NY,NX),NY,NX) - DFVN2B=DIFNO*(CNO2S1-CNO2B2)*VLNOB(NU(NY,NX),NY,NX) - DFVPOB=DIFPO*(CPO4S1-CPO4B2)*VLPOB(NU(NY,NX),NY,NX) - ELSE - DO 8905 K=0,2 - DFVOC(K)=0.0 - DFVON(K)=0.0 - DFVOP(K)=0.0 - DFVOA(K)=0.0 -8905 CONTINUE - DFVCOS=0.0 - DFVCHS=0.0 - DFVOXS=0.0 - DFVNGS=0.0 - DFVN2S=0.0 - DFVHGS=0.0 - DFVNH4=0.0 - DFVNH3=0.0 - DFVNO3=0.0 - DFVNO2=0.0 - DFVPO4=0.0 - DFVN4B=0.0 - DFVN3B=0.0 - DFVNOB=0.0 - DFVN2B=0.0 - DFVPOB=0.0 - ENDIF -C -C TOTAL MICROPORE AND MACROPORE SOLUTE TRANSPORT FLUXES BETWEEN -C ADJACENT GRID CELLS = CONVECTIVE + DIFFUSIVE FLUXES -C - DO 9760 K=0,2 - ROCFLS(K,3,0,NY,NX)=ROCFL0(K,NY,NX)-RFLOC(K)-DFVOC(K) - RONFLS(K,3,0,NY,NX)=RONFL0(K,NY,NX)-RFLON(K)-DFVON(K) - ROPFLS(K,3,0,NY,NX)=ROPFL0(K,NY,NX)-RFLOP(K)-DFVOP(K) - ROAFLS(K,3,0,NY,NX)=ROAFL0(K,NY,NX)-RFLOA(K)-DFVOA(K) - ROCFLS(K,3,NU(NY,NX),NY,NX)=ROCFL1(K,NY,NX)+RFLOC(K)+DFVOC(K) - 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 - ROXFLS(3,0,NY,NX)=ROXFL0(NY,NX)-RFLOXS-DFVOXS - RNGFLS(3,0,NY,NX)=RNGFL0(NY,NX)-RFLNGS-DFVNGS - RN2FLS(3,0,NY,NX)=RN2FL0(NY,NX)-RFLN2S-DFVN2S - RHGFLS(3,0,NY,NX)=RHGFL0(NY,NX)-RFLHGS-DFVHGS - RN4FLW(3,0,NY,NX)=RN4FL0(NY,NX)-RFLNH4-DFVNH4-RFLN4B-DFVN4B - RN3FLW(3,0,NY,NX)=RN3FL0(NY,NX)-RFLNH3-DFVNH3-RFLN3B-DFVN3B - RNOFLW(3,0,NY,NX)=RNOFL0(NY,NX)-RFLNO3-DFVNO3-RFLNOB-DFVNOB - RNXFLS(3,0,NY,NX)=RNXFL0(NY,NX)-RFLNO2-DFVNO2-RFLN2B-DFVN2B - RH2PFS(3,0,NY,NX)=RH2PF0(NY,NX)-RFLPO4-DFVPO4-RFLPOB-DFVPOB - RCOFLS(3,NU(NY,NX),NY,NX)=RCOFL1(NY,NX)+RFLCOS+DFVCOS - RCHFLS(3,NU(NY,NX),NY,NX)=RCHFL1(NY,NX)+RFLCHS+DFVCHS - ROXFLS(3,NU(NY,NX),NY,NX)=ROXFL1(NY,NX)+RFLOXS+DFVOXS - RNGFLS(3,NU(NY,NX),NY,NX)=RNGFL1(NY,NX)+RFLNGS+DFVNGS - RN2FLS(3,NU(NY,NX),NY,NX)=RN2FL1(NY,NX)+RFLN2S+DFVN2S - RHGFLS(3,NU(NY,NX),NY,NX)=RHGFL1(NY,NX)+RFLHGS+DFVHGS - RN4FLW(3,NU(NY,NX),NY,NX)=RN4FL1(NY,NX)+RFLNH4+DFVNH4 - RN3FLW(3,NU(NY,NX),NY,NX)=RN3FL1(NY,NX)+RFLNH3+DFVNH3 - RNOFLW(3,NU(NY,NX),NY,NX)=RNOFL1(NY,NX)+RFLNO3+DFVNO3 - RNXFLS(3,NU(NY,NX),NY,NX)=RNXFL1(NY,NX)+RFLNO2+DFVNO2 - RH2PFS(3,NU(NY,NX),NY,NX)=RH2PF1(NY,NX)+RFLPO4+DFVPO4 - RN4FLB(3,NU(NY,NX),NY,NX)=RN4FL2(NY,NX)+RFLN4B+DFVN4B - RN3FLB(3,NU(NY,NX),NY,NX)=RN3FL2(NY,NX)+RFLN3B+DFVN3B - RNOFLB(3,NU(NY,NX),NY,NX)=RNOFL2(NY,NX)+RFLNOB+DFVNOB - RNXFLB(3,NU(NY,NX),NY,NX)=RNXFL2(NY,NX)+RFLN2B+DFVN2B - RH2BFB(3,NU(NY,NX),NY,NX)=RH2BF2(NY,NX)+RFLPOB+DFVPOB - 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 - XNGFLS(3,0,NY,NX)=XNGFLS(3,0,NY,NX)-RFLNGS-DFVNGS - XN2FLS(3,0,NY,NX)=XN2FLS(3,0,NY,NX)-RFLN2S-DFVN2S - XHGFLS(3,0,NY,NX)=XHGFLS(3,0,NY,NX)-RFLHGS-DFVHGS - XN4FLW(3,0,NY,NX)=XN4FLW(3,0,NY,NX)-RFLNH4-DFVNH4-RFLN4B-DFVN4B - XN3FLW(3,0,NY,NX)=XN3FLW(3,0,NY,NX)-RFLNH3-DFVNH3-RFLN3B-DFVN3B - XNOFLW(3,0,NY,NX)=XNOFLW(3,0,NY,NX)-RFLNO3-DFVNO3-RFLNOB-DFVNOB - XNXFLS(3,0,NY,NX)=XNXFLS(3,0,NY,NX)-RFLNO2-DFVNO2-RFLN2B-DFVN2B - XH2PFS(3,0,NY,NX)=XH2PFS(3,0,NY,NX)-RFLPO4-DFVPO4-RFLPOB-DFVPOB - XCOFLS(3,NU(NY,NX),NY,NX)=XCOFLS(3,NU(NY,NX),NY,NX)+RFLCOS+DFVCOS - XCHFLS(3,NU(NY,NX),NY,NX)=XCHFLS(3,NU(NY,NX),NY,NX)+RFLCHS+DFVCHS - XOXFLS(3,NU(NY,NX),NY,NX)=XOXFLS(3,NU(NY,NX),NY,NX)+RFLOXS+DFVOXS - XNGFLS(3,NU(NY,NX),NY,NX)=XNGFLS(3,NU(NY,NX),NY,NX)+RFLNGS+DFVNGS - XN2FLS(3,NU(NY,NX),NY,NX)=XN2FLS(3,NU(NY,NX),NY,NX)+RFLN2S+DFVN2S - XHGFLS(3,NU(NY,NX),NY,NX)=XHGFLS(3,NU(NY,NX),NY,NX)+RFLHGS+DFVHGS - XN4FLW(3,NU(NY,NX),NY,NX)=XN4FLW(3,NU(NY,NX),NY,NX)+RFLNH4+DFVNH4 - XN3FLW(3,NU(NY,NX),NY,NX)=XN3FLW(3,NU(NY,NX),NY,NX)+RFLNH3+DFVNH3 - XNOFLW(3,NU(NY,NX),NY,NX)=XNOFLW(3,NU(NY,NX),NY,NX)+RFLNO3+DFVNO3 - XNXFLS(3,NU(NY,NX),NY,NX)=XNXFLS(3,NU(NY,NX),NY,NX)+RFLNO2+DFVNO2 - XH2PFS(3,NU(NY,NX),NY,NX)=XH2PFS(3,NU(NY,NX),NY,NX)+RFLPO4+DFVPO4 - XN4FLB(3,NU(NY,NX),NY,NX)=XN4FLB(3,NU(NY,NX),NY,NX)+RFLN4B+DFVN4B - XN3FLB(3,NU(NY,NX),NY,NX)=XN3FLB(3,NU(NY,NX),NY,NX)+RFLN3B+DFVN3B - XNOFLB(3,NU(NY,NX),NY,NX)=XNOFLB(3,NU(NY,NX),NY,NX)+RFLNOB+DFVNOB - XNXFLB(3,NU(NY,NX),NY,NX)=XNXFLB(3,NU(NY,NX),NY,NX)+RFLN2B+DFVN2B - XH2BFB(3,NU(NY,NX),NY,NX)=XH2BFB(3,NU(NY,NX),NY,NX)+RFLPOB+DFVPOB -C IF(I.EQ.118.AND.NX.EQ.3.AND.NY.EQ.4)THEN -C WRITE(*,3434)'ROXFLS',I,J,NX,NY,M,MM,ROXFLS(3,0,NY,NX) -C 2,XOXFLS(3,0,NY,NX),ROXFL0(NY,NX),RFLOXS,DFVOXS -3434 FORMAT(A8,6I4,12E12.4) -C ENDIF -C -C MACROPORE-MICROPORE SOLUTE EXCHANGE IN SOIL -C SURFACE LAYER FROM WATER EXCHANGE IN 'WATSUB' AND -C FROM MACROPORE OR MICROPORE SOLUTE CONCENTRATIONS -C -C -C MACROPORE TO MICROPORE TRANSFER -C - IF(FINHM(M,NU(NY,NX),NY,NX).GT.0.0)THEN - IF(VOLWHM(M,NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN - VFLW=AMAX1(0.0,AMIN1(XFRX,FINHM(M,NU(NY,NX),NY,NX) - 2/VOLWHM(M,NU(NY,NX),NY,NX))) - ELSE - VFLW=XFRX - ENDIF - DO 9870 K=0,4 - RFLOC(K)=VFLW*AMAX1(0.0,OQCH2(K,NU(NY,NX),NY,NX)) - RFLON(K)=VFLW*AMAX1(0.0,OQNH2(K,NU(NY,NX),NY,NX)) - RFLOP(K)=VFLW*AMAX1(0.0,OQPH2(K,NU(NY,NX),NY,NX)) - RFLOA(K)=VFLW*AMAX1(0.0,OQAH2(K,NU(NY,NX),NY,NX)) -9870 CONTINUE - RFLCOS=VFLW*AMAX1(0.0,CO2SH2(NU(NY,NX),NY,NX)) - RFLCHS=VFLW*AMAX1(0.0,CH4SH2(NU(NY,NX),NY,NX)) - RFLOXS=VFLW*AMAX1(0.0,OXYSH2(NU(NY,NX),NY,NX)) - RFLNGS=VFLW*AMAX1(0.0,Z2GSH2(NU(NY,NX),NY,NX)) - RFLN2S=VFLW*AMAX1(0.0,Z2OSH2(NU(NY,NX),NY,NX)) - RFLHGS=VFLW*AMAX1(0.0,H2GSH2(NU(NY,NX),NY,NX)) - RFLNH4=VFLW*AMAX1(0.0,ZNH4H2(NU(NY,NX),NY,NX)) - 2*VLNH4(NU(NY,NX),NY,NX) - RFLNH3=VFLW*AMAX1(0.0,ZNH3H2(NU(NY,NX),NY,NX)) - 2*VLNH4(NU(NY,NX),NY,NX) - RFLNO3=VFLW*AMAX1(0.0,ZNO3H2(NU(NY,NX),NY,NX)) - 2*VLNO3(NU(NY,NX),NY,NX) - RFLNO2=VFLW*AMAX1(0.0,ZNO2H2(NU(NY,NX),NY,NX)) - 2*VLNO3(NU(NY,NX),NY,NX) - RFLPO4=VFLW*AMAX1(0.0,H2P4H2(NU(NY,NX),NY,NX)) - 2*VLPO4(NU(NY,NX),NY,NX) - RFLN4B=VFLW*AMAX1(0.0,ZN4BH2(NU(NY,NX),NY,NX)) - 2*VLNHB(NU(NY,NX),NY,NX) - RFLN3B=VFLW*AMAX1(0.0,ZN3BH2(NU(NY,NX),NY,NX)) - 2*VLNHB(NU(NY,NX),NY,NX) - RFLNOB=VFLW*AMAX1(0.0,ZNOBH2(NU(NY,NX),NY,NX)) - 2*VLNOB(NU(NY,NX),NY,NX) - RFLN2B=VFLW*AMAX1(0.0,ZN2BH2(NU(NY,NX),NY,NX)) - 2*VLNOB(NU(NY,NX),NY,NX) - RFLPOB=VFLW*AMAX1(0.0,H2PBH2(NU(NY,NX),NY,NX)) - 2*VLPOB(NU(NY,NX),NY,NX) -C -C MICROPORE TO MACROPORE TRANSFER -C - ELSEIF(FINHM(M,NU(NY,NX),NY,NX).LT.0.0)THEN - IF(VOLWM(M,NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN - VFLW=AMIN1(0.0,AMAX1(-XFRX,FINHM(M,NU(NY,NX),NY,NX) - 2/VOLWM(M,NU(NY,NX),NY,NX))) - ELSE - VFLW=-XFRX - ENDIF - DO 9865 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)) - RFLOA(K)=VFLW*AMAX1(0.0,OQA2(K,NU(NY,NX),NY,NX)) -9865 CONTINUE - RFLCOS=VFLW*AMAX1(0.0,CO2S2(NU(NY,NX),NY,NX)) - RFLCHS=VFLW*AMAX1(0.0,CH4S2(NU(NY,NX),NY,NX)) - RFLOXS=VFLW*AMAX1(0.0,OXYS2(NU(NY,NX),NY,NX)) - RFLNGS=VFLW*AMAX1(0.0,Z2GS2(NU(NY,NX),NY,NX)) - RFLN2S=VFLW*AMAX1(0.0,Z2OS2(NU(NY,NX),NY,NX)) - RFLHGS=VFLW*AMAX1(0.0,H2GS2(NU(NY,NX),NY,NX)) - RFLNH4=VFLW*AMAX1(0.0,ZNH4S2(NU(NY,NX),NY,NX)) - 2*VLNH4(NU(NY,NX),NY,NX) - RFLNH3=VFLW*AMAX1(0.0,ZN3S2(NU(NY,NX),NY,NX)) - 2*VLNH4(NU(NY,NX),NY,NX) - RFLNO3=VFLW*AMAX1(0.0,ZNO3S2(NU(NY,NX),NY,NX)) - 2*VLNO3(NU(NY,NX),NY,NX) - RFLNO2=VFLW*AMAX1(0.0,ZNO2S2(NU(NY,NX),NY,NX)) - 2*VLNO3(NU(NY,NX),NY,NX) - RFLPO4=VFLW*AMAX1(0.0,H2PO42(NU(NY,NX),NY,NX)) - 2*VLPO4(NU(NY,NX),NY,NX) - RFLN4B=VFLW*AMAX1(0.0,ZNH4B2(NU(NY,NX),NY,NX)) - 2*VLNHB(NU(NY,NX),NY,NX) - RFLN3B=VFLW*AMAX1(0.0,ZNBS2(NU(NY,NX),NY,NX)) - 2*VLNHB(NU(NY,NX),NY,NX) - RFLNOB=VFLW*AMAX1(0.0,ZNO3B2(NU(NY,NX),NY,NX)) - 2*VLNOB(NU(NY,NX),NY,NX) - RFLN2B=VFLW*AMAX1(0.0,ZNO2B2(NU(NY,NX),NY,NX)) - 2*VLNOB(NU(NY,NX),NY,NX) - RFLPOB=VFLW*AMAX1(0.0,H2POB2(NU(NY,NX),NY,NX)) - 2*VLPOB(NU(NY,NX),NY,NX) -C -C NO MACROPORE TO MICROPORE TRANSFER -C - ELSE - DO 9860 K=0,4 - RFLOC(K)=0.0 - RFLON(K)=0.0 - RFLOP(K)=0.0 - RFLOA(K)=0.0 -9860 CONTINUE - RFLCOS=0.0 - RFLCHS=0.0 - RFLOXS=0.0 - RFLNGS=0.0 - RFLN2S=0.0 - RFLHGS=0.0 - RFLNH4=0.0 - RFLNH3=0.0 - RFLNO3=0.0 - RFLNO2=0.0 - RFLPO4=0.0 - RFLN4B=0.0 - RFLN3B=0.0 - RFLNOB=0.0 - RFLN2B=0.0 - RFLPOB=0.0 - ENDIF -C -C DIFFUSIVE FLUXES OF SOLUTES BETWEEN MICROPORES AND -C MACROPORES FROM AQUEOUS DIFFUSIVITIES AND CONCENTRATION DIFFERENCES -C -C -C DIFFUSIVE FLUXES OF SOLUTES BETWEEN MICROPORES AND -C MACROPORES FROM AQUEOUS DIFFUSIVITIES AND CONCENTRATION DIFFERENCES -C - IF(VOLWHM(M,NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN - 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 - DFVOC(K)=XNPX*(OQCH2(K,NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-OQC2(K,NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - DFVON(K)=XNPX*(OQNH2(K,NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-OQN2(K,NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - DFVOP(K)=XNPX*(OQPH2(K,NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-OQP2(K,NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - DFVOA(K)=XNPX*(OQAH2(K,NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-OQA2(K,NU(NY,NX),NY,NX)*VOLWHS)/VOLWT -8835 CONTINUE - DFVCOS=XNPX*(CO2SH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-CO2S2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - DFVCHS=XNPX*(CH4SH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-CH4S2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - DFVOXS=XNPX*(OXYSH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-OXYS2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - DFVNGS=XNPX*(Z2GSH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-Z2GS2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - DFVN2S=XNPX*(Z2OSH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-Z2OS2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - DFVHGS=XNPX*(H2GSH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-H2GS2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - DFVNH4=XNPX*(ZNH4H2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZNH4S2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - 3*VLNH4(NU(NY,NX),NY,NX) - DFVNH3=XNPX*(ZNH3H2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZN3S2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - 3*VLNH4(NU(NY,NX),NY,NX) - DFVNO3=XNPX*(ZNO3H2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZNO3S2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - 3*VLNO3(NU(NY,NX),NY,NX) - DFVNO2=XNPX*(ZNO2H2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZNO2S2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - 3*VLNO3(NU(NY,NX),NY,NX) - DFVPO4=XNPX*(H2P4H2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-H2PO42(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - 3*VLPO4(NU(NY,NX),NY,NX) - DFVN4B=XNPX*(ZN4BH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZNH4B2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - 3*VLNHB(NU(NY,NX),NY,NX) - DFVN3B=XNPX*(ZN3BH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZNBS2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - 3*VLNHB(NU(NY,NX),NY,NX) - DFVNOB=XNPX*(ZNOBH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZNO3B2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - 3*VLNOB(NU(NY,NX),NY,NX) - DFVN2B=XNPX*(ZN2BH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZNO2B2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - 3*VLNOB(NU(NY,NX),NY,NX) - DFVPOB=XNPX*(H2PBH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-H2POB2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - 3*VLPOB(NU(NY,NX),NY,NX) - ELSE - DO 8935 K=0,2 - DFVOC(K)=0.0 - DFVON(K)=0.0 - DFVOP(K)=0.0 - DFVOA(K)=0.0 -8935 CONTINUE - DFVCOS=0.0 - DFVCHS=0.0 - DFVOXS=0.0 - DFVNGS=0.0 - DFVN2S=0.0 - DFVHGS=0.0 - DFVNH4=0.0 - DFVNH3=0.0 - DFVNO3=0.0 - DFVNO2=0.0 - DFVPO4=0.0 - DFVN4B=0.0 - DFVN3B=0.0 - DFVNOB=0.0 - DFVN2B=0.0 - DFVPOB=0.0 - ENDIF -C -C TOTAL CONVECTIVE +DIFFUSIVE TRANSFER BETWEEN MACROPOES AND MICROPORES -C - DO 9940 K=0,4 - ROCFXS(K,NU(NY,NX),NY,NX)=RFLOC(K)+DFVOC(K) - 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 - ROXFXS(NU(NY,NX),NY,NX)=RFLOXS+DFVOXS - RNGFXS(NU(NY,NX),NY,NX)=RFLNGS+DFVNGS - RN2FXS(NU(NY,NX),NY,NX)=RFLN2S+DFVN2S - RHGFXS(NU(NY,NX),NY,NX)=RFLHGS+DFVHGS - RN4FXW(NU(NY,NX),NY,NX)=RFLNH4+DFVNH4 - RN3FXW(NU(NY,NX),NY,NX)=RFLNH3+DFVNH3 - RNOFXW(NU(NY,NX),NY,NX)=RFLNO3+DFVNO3 - RNXFXS(NU(NY,NX),NY,NX)=RFLNO2+DFVNO2 - RH2PXS(NU(NY,NX),NY,NX)=RFLPO4+DFVPO4 - RN4FXB(NU(NY,NX),NY,NX)=RFLN4B+DFVN4B - RN3FXB(NU(NY,NX),NY,NX)=RFLN3B+DFVN3B - RNOFXB(NU(NY,NX),NY,NX)=RFLNOB+DFVNOB - RNXFXB(NU(NY,NX),NY,NX)=RFLN2B+DFVN2B - RH2BXB(NU(NY,NX),NY,NX)=RFLPOB+DFVPOB -C -C ACCUMULATE HOURLY FLUXES -C - DO 9935 K=0,4 - 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) -9935 CONTINUE - XCOFXS(NU(NY,NX),NY,NX)=XCOFXS(NU(NY,NX),NY,NX) - 2+RCOFXS(NU(NY,NX),NY,NX) - XCHFXS(NU(NY,NX),NY,NX)=XCHFXS(NU(NY,NX),NY,NX) - 2+RCHFXS(NU(NY,NX),NY,NX) - XOXFXS(NU(NY,NX),NY,NX)=XOXFXS(NU(NY,NX),NY,NX) - 2+ROXFXS(NU(NY,NX),NY,NX) - XNGFXS(NU(NY,NX),NY,NX)=XNGFXS(NU(NY,NX),NY,NX) - 2+RNGFXS(NU(NY,NX),NY,NX) - XN2FXS(NU(NY,NX),NY,NX)=XN2FXS(NU(NY,NX),NY,NX) - 2+RN2FXS(NU(NY,NX),NY,NX) - XHGFXS(NU(NY,NX),NY,NX)=XHGFXS(NU(NY,NX),NY,NX) - 2+RHGFXS(NU(NY,NX),NY,NX) - XN4FXW(NU(NY,NX),NY,NX)=XN4FXW(NU(NY,NX),NY,NX) - 2+RN4FXW(NU(NY,NX),NY,NX) - XN3FXW(NU(NY,NX),NY,NX)=XN3FXW(NU(NY,NX),NY,NX) - 2+RN3FXW(NU(NY,NX),NY,NX) - XNOFXW(NU(NY,NX),NY,NX)=XNOFXW(NU(NY,NX),NY,NX) - 2+RNOFXW(NU(NY,NX),NY,NX) - XNXFXS(NU(NY,NX),NY,NX)=XNXFXS(NU(NY,NX),NY,NX) - 2+RNXFXS(NU(NY,NX),NY,NX) - XH2PXS(NU(NY,NX),NY,NX)=XH2PXS(NU(NY,NX),NY,NX) - 2+RH2PXS(NU(NY,NX),NY,NX) - XN4FXB(NU(NY,NX),NY,NX)=XN4FXB(NU(NY,NX),NY,NX) - 2+RN4FXB(NU(NY,NX),NY,NX) - XN3FXB(NU(NY,NX),NY,NX)=XN3FXB(NU(NY,NX),NY,NX) - 2+RN3FXB(NU(NY,NX),NY,NX) - XNOFXB(NU(NY,NX),NY,NX)=XNOFXB(NU(NY,NX),NY,NX) - 2+RNOFXB(NU(NY,NX),NY,NX) - XNXFXB(NU(NY,NX),NY,NX)=XNXFXB(NU(NY,NX),NY,NX) - 2+RNXFXB(NU(NY,NX),NY,NX) - XH2BXB(NU(NY,NX),NY,NX)=XH2BXB(NU(NY,NX),NY,NX) - 2+RH2BXB(NU(NY,NX),NY,NX) -C -C SOLUTE TRANSPORT FROM WATER OVERLAND FLOW -C IN 'WATSUB' AND FROM SOLUTE CONCENTRATIONS -C IN SOIL SURFACE LAYER -C - N1=NX - N2=NY -C -C LOCATE INTERNAL BOUNDARIES BETWEEN ADJACENT GRID CELLS -C - DO 4310 N=1,2 - IF(N.EQ.1)THEN - IF(NX.EQ.NHE)THEN - GO TO 4310 - ELSE - N4=NX+1 - N5=NY - ENDIF - ELSEIF(N.EQ.2)THEN - IF(NY.EQ.NVS)THEN - GO TO 4310 - ELSE - N4=NX - N5=NY+1 - ENDIF - ENDIF -C -C IF NO OVERLAND FLOW THEN NO TRANSPORT -C - IF(QRM(M,N,N5,N4).EQ.0.0)THEN - DO 9840 K=0,2 - RQROC(K,N,N5,N4)=0.0 - RQRON(K,N,N5,N4)=0.0 - RQROP(K,N,N5,N4)=0.0 - RQROA(K,N,N5,N4)=0.0 -9840 CONTINUE - RQRCOS(N,N5,N4)=0.0 - RQRCHS(N,N5,N4)=0.0 - RQROXS(N,N5,N4)=0.0 - RQRNGS(N,N5,N4)=0.0 - RQRN2S(N,N5,N4)=0.0 - RQRHGS(N,N5,N4)=0.0 - RQRNH4(N,N5,N4)=0.0 - RQRNH3(N,N5,N4)=0.0 - RQRNO3(N,N5,N4)=0.0 - RQRNO2(N,N5,N4)=0.0 - RQRH2P(N,N5,N4)=0.0 -C -C IF OVERLAND FLOW IS FROM CURRENT TO ADJACENT GRID CELL -C - ELSEIF(QRM(M,N,N5,N4).GT.0.0)THEN - IF(VOLWM(M,0,N2,N1).GT.ZEROS(N2,N1))THEN - VFLW=AMAX1(0.0,AMIN1(XFRX,QRM(M,N,N5,N4)/VOLWM(M,0,N2,N1))) - ELSE - VFLW=XFRX - ENDIF - DO 9835 K=0,2 - 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)) - RQROA(K,N,N5,N4)=VFLW*AMAX1(0.0,OQA2(K,0,N2,N1)) -9835 CONTINUE - RQRCOS(N,N5,N4)=VFLW*AMAX1(0.0,CO2S2(0,N2,N1)) - RQRCHS(N,N5,N4)=VFLW*AMAX1(0.0,CH4S2(0,N2,N1)) - RQROXS(N,N5,N4)=VFLW*AMAX1(0.0,OXYS2(0,N2,N1)) - RQRNGS(N,N5,N4)=VFLW*AMAX1(0.0,Z2GS2(0,N2,N1)) - RQRN2S(N,N5,N4)=VFLW*AMAX1(0.0,Z2OS2(0,N2,N1)) - RQRHGS(N,N5,N4)=VFLW*AMAX1(0.0,H2GS2(0,N2,N1)) - RQRNH4(N,N5,N4)=VFLW*AMAX1(0.0,ZNH4S2(0,N2,N1)) - RQRNH3(N,N5,N4)=VFLW*AMAX1(0.0,ZN3S2(0,N2,N1)) - RQRNO3(N,N5,N4)=VFLW*AMAX1(0.0,ZNO3S2(0,N2,N1)) - RQRNO2(N,N5,N4)=VFLW*AMAX1(0.0,ZNO2S2(0,N2,N1)) - RQRH2P(N,N5,N4)=VFLW*AMAX1(0.0,H2PO42(0,N2,N1)) -C -C IF OVERLAND FLOW IS TO CURRENT FROM ADJACENT GRID CELL -C - ELSEIF(QRM(M,N,N5,N4).LT.0.0)THEN - IF(VOLWM(M,0,N5,N4).GT.ZEROS(N5,N4))THEN - VFLW=AMIN1(0.0,AMAX1(-XFRX,QRM(M,N,N5,N4)/VOLWM(M,0,N5,N4))) - ELSE - VFLW=-XFRX - ENDIF - DO 9830 K=0,2 - 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)) - RQROA(K,N,N5,N4)=VFLW*AMAX1(0.0,OQA2(K,0,N5,N4)) -9830 CONTINUE - RQRCOS(N,N5,N4)=VFLW*AMAX1(0.0,CO2S2(0,N5,N4)) - RQRCHS(N,N5,N4)=VFLW*AMAX1(0.0,CH4S2(0,N5,N4)) - RQROXS(N,N5,N4)=VFLW*AMAX1(0.0,OXYS2(0,N5,N4)) - RQRNGS(N,N5,N4)=VFLW*AMAX1(0.0,Z2GS2(0,N5,N4)) - RQRN2S(N,N5,N4)=VFLW*AMAX1(0.0,Z2OS2(0,N5,N4)) - RQRHGS(N,N5,N4)=VFLW*AMAX1(0.0,H2GS2(0,N5,N4)) - RQRNH4(N,N5,N4)=VFLW*AMAX1(0.0,ZNH4S2(0,N5,N4)) - RQRNH3(N,N5,N4)=VFLW*AMAX1(0.0,ZN3S2(0,N5,N4)) - RQRNO3(N,N5,N4)=VFLW*AMAX1(0.0,ZNO3S2(0,N5,N4)) - RQRNO2(N,N5,N4)=VFLW*AMAX1(0.0,ZNO2S2(0,N5,N4)) - RQRH2P(N,N5,N4)=VFLW*AMAX1(0.0,H2PO42(0,N5,N4)) - ENDIF -C -C ACCUMULATE HOURLY FLUXES -C - DO 9825 K=0,2 - 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) - XOAQRS(K,N,N5,N4)=XOAQRS(K,N,N5,N4)+RQROA(K,N,N5,N4) -9825 CONTINUE - XCOQRS(N,N5,N4)=XCOQRS(N,N5,N4)+RQRCOS(N,N5,N4) - XCHQRS(N,N5,N4)=XCHQRS(N,N5,N4)+RQRCHS(N,N5,N4) - XOXQRS(N,N5,N4)=XOXQRS(N,N5,N4)+RQROXS(N,N5,N4) - XNGQRS(N,N5,N4)=XNGQRS(N,N5,N4)+RQRNGS(N,N5,N4) - XN2QRS(N,N5,N4)=XN2QRS(N,N5,N4)+RQRN2S(N,N5,N4) - XHGQRS(N,N5,N4)=XHGQRS(N,N5,N4)+RQRHGS(N,N5,N4) - XN4QRW(N,N5,N4)=XN4QRW(N,N5,N4)+RQRNH4(N,N5,N4) - XN3QRW(N,N5,N4)=XN3QRW(N,N5,N4)+RQRNH3(N,N5,N4) - XNOQRW(N,N5,N4)=XNOQRW(N,N5,N4)+RQRNO3(N,N5,N4) - XNXQRS(N,N5,N4)=XNXQRS(N,N5,N4)+RQRNO2(N,N5,N4) - XP4QRW(N,N5,N4)=XP4QRW(N,N5,N4)+RQRH2P(N,N5,N4) -C -C IF NO SNOW DRIFT THEN NO TRANSPORT -C - IF(QSM(M,N,N5,N4).EQ.0.0)THEN - RQSCOS(N,N5,N4)=0.0 - RQSCHS(N,N5,N4)=0.0 - RQSOXS(N,N5,N4)=0.0 - RQSNGS(N,N5,N4)=0.0 - RQSN2S(N,N5,N4)=0.0 - RQSNH4(N,N5,N4)=0.0 - RQSNH3(N,N5,N4)=0.0 - RQSNO3(N,N5,N4)=0.0 - RQSH2P(N,N5,N4)=0.0 -C -C IF DRIFT IS FROM CURRENT TO ADJACENT GRID CELL -C - ELSEIF(QSM(M,N,N5,N4).GT.0.0)THEN - IF(VOLS(N2,N1).GT.ZEROS(N2,N1))THEN - VFLW=AMAX1(0.0,AMIN1(XFRX,QSM(M,N,N5,N4)/VOLS(N2,N1))) - ELSE - VFLW=XFRX - ENDIF - RQSCOS(N,N5,N4)=VFLW*AMAX1(0.0,CO2W2(N2,N1)) - RQSCHS(N,N5,N4)=VFLW*AMAX1(0.0,CH4W2(N2,N1)) - RQSOXS(N,N5,N4)=VFLW*AMAX1(0.0,OXYW2(N2,N1)) - RQSNGS(N,N5,N4)=VFLW*AMAX1(0.0,ZNGW2(N2,N1)) - RQSN2S(N,N5,N4)=VFLW*AMAX1(0.0,ZN2W2(N2,N1)) - RQSNH4(N,N5,N4)=VFLW*AMAX1(0.0,ZN4W2(N2,N1)) - RQSNH3(N,N5,N4)=VFLW*AMAX1(0.0,ZN3W2(N2,N1)) - RQSNO3(N,N5,N4)=VFLW*AMAX1(0.0,ZNOW2(N2,N1)) - RQSH2P(N,N5,N4)=VFLW*AMAX1(0.0,ZHPW2(N2,N1)) -C -C IF DRIFT IS TO CURRENT FROM ADJACENT GRID CELL -C - ELSEIF(QSM(M,N,N5,N4).LT.0.0)THEN - IF(VOLS(N5,N4).GT.ZEROS(N5,N4))THEN - VFLW=AMIN1(0.0,AMAX1(-XFRX,QSM(M,N,N5,N4)/VOLS(N5,N4))) - ELSE - VFLW=-XFRX - ENDIF - RQSCOS(N,N5,N4)=VFLW*AMAX1(0.0,CO2W2(N5,N4)) - RQSCHS(N,N5,N4)=VFLW*AMAX1(0.0,CH4W2(N5,N4)) - RQSOXS(N,N5,N4)=VFLW*AMAX1(0.0,OXYW2(N5,N4)) - RQSNGS(N,N5,N4)=VFLW*AMAX1(0.0,ZNGW2(N5,N4)) - RQSN2S(N,N5,N4)=VFLW*AMAX1(0.0,ZN2W2(N5,N4)) - RQSNH4(N,N5,N4)=VFLW*AMAX1(0.0,ZN4W2(N5,N4)) - RQSNH3(N,N5,N4)=VFLW*AMAX1(0.0,ZN3W2(N5,N4)) - RQSNO3(N,N5,N4)=VFLW*AMAX1(0.0,ZNOW2(N5,N4)) - RQSH2P(N,N5,N4)=VFLW*AMAX1(0.0,ZHPW2(N5,N4)) - ENDIF -C -C ACCUMULATE HOURLY FLUXES -C - XCOQSS(N,N5,N4)=XCOQSS(N,N5,N4)+RQSCOS(N,N5,N4) - XCHQSS(N,N5,N4)=XCHQSS(N,N5,N4)+RQSCHS(N,N5,N4) - XOXQSS(N,N5,N4)=XOXQSS(N,N5,N4)+RQSOXS(N,N5,N4) - XNGQSS(N,N5,N4)=XNGQSS(N,N5,N4)+RQSNGS(N,N5,N4) - XN2QSS(N,N5,N4)=XN2QSS(N,N5,N4)+RQSN2S(N,N5,N4) - XN4QSS(N,N5,N4)=XN4QSS(N,N5,N4)+RQSNH4(N,N5,N4) - XN3QSS(N,N5,N4)=XN3QSS(N,N5,N4)+RQSNH3(N,N5,N4) - XNOQSS(N,N5,N4)=XNOQSS(N,N5,N4)+RQSNO3(N,N5,N4) - XP4QSS(N,N5,N4)=XP4QSS(N,N5,N4)+RQSH2P(N,N5,N4) -C IF(I.EQ.118.AND.NX.EQ.3.AND.NY.EQ.4)THEN -C WRITE(*,6969)'XOXQSS',I,J,N4,N5,N,M,MM,XOXQSS(N,N5,N4) -C 2,RQSOXS(N,N5,N4),VFLW,OXYW2(N2,N1),OXYW2(N5,N4) -C 3,QSM(M,N,N5,N4),VOLS(N2,N1),VOLS(N5,N4) -6969 FORMAT(A8,7I4,20E12.4) -C ENDIF -4310 CONTINUE - ENDIF -C -C VOLATILIZATION-DISSOLUTION OF GASES IN RESIDUE AND SOIL SURFACE -C LAYERS FROM GASEOUS CONCENTRATIONS VS. THEIR AQUEOUS -C EQUIVALENTS DEPENDING ON SOLUBILITY FROM 'HOUR1' -C AND TRANSFER COEFFICIENT 'DFGS' FROM 'WATSUB' -C - IF(VOLWM(M,0,NY,NX).GT.ZEROS(NY,NX))THEN - CO2G0=CCO2G(0,NY,NX)*VOLPM(M,0,NY,NX) - CH4G0=CCH4G(0,NY,NX)*VOLPM(M,0,NY,NX) - OXYG0=COXYG(0,NY,NX)*VOLPM(M,0,NY,NX) - Z2GG0=CZ2GG(0,NY,NX)*VOLPM(M,0,NY,NX) - Z2OG0=CZ2OG(0,NY,NX)*VOLPM(M,0,NY,NX) - ZN3G0=CNH3G(0,NY,NX)*VOLPM(M,0,NY,NX) - H2GG0=CH2GG(0,NY,NX)*VOLPM(M,0,NY,NX) - VOLCOR(NY,NX)=VOLWCO(0,NY,NX)+VOLPM(M,0,NY,NX) - VOLCHR(NY,NX)=VOLWCH(0,NY,NX)+VOLPM(M,0,NY,NX) - VOLOXR(NY,NX)=VOLWOX(0,NY,NX)+VOLPM(M,0,NY,NX) - VOLNGR(NY,NX)=VOLWNG(0,NY,NX)+VOLPM(M,0,NY,NX) - VOLN2R(NY,NX)=VOLWN2(0,NY,NX)+VOLPM(M,0,NY,NX) - VOLN3R(NY,NX)=VOLWN3(0,NY,NX)+VOLPM(M,0,NY,NX) - VOLHGR(NY,NX)=VOLWHG(0,NY,NX)+VOLPM(M,0,NY,NX) - RCODFG(0,NY,NX)=DFGS(M,0,NY,NX) - 2*(AMAX1(ZEROS(NY,NX),CO2G0)*VOLWCO(0,NY,NX) - 3-AMAX1(ZEROS(NY,NX),CO2S2(0,NY,NX)+RCODXR) - 4*VOLPM(M,0,NY,NX))/VOLCOR(NY,NX) - RCHDFG(0,NY,NX)=DFGS(M,0,NY,NX) - 2*(AMAX1(ZEROS(NY,NX),CH4G0)*VOLWCH(0,NY,NX) - 3-AMAX1(ZEROS(NY,NX),CH4S2(0,NY,NX)+RCHDXR) - 4*VOLPM(M,0,NY,NX))/VOLCHR(NY,NX) - ROXDFG(0,NY,NX)=DFGS(M,0,NY,NX) - 2*(AMAX1(ZEROS(NY,NX),OXYG0)*VOLWOX(0,NY,NX) - 3-AMAX1(ZEROS(NY,NX),OXYS2(0,NY,NX)+ROXDXR) - 4*VOLPM(M,0,NY,NX))/VOLOXR(NY,NX) - RNGDFG(0,NY,NX)=DFGS(M,0,NY,NX) - 2*(AMAX1(ZEROS(NY,NX),Z2GG0)*VOLWNG(0,NY,NX) - 3-AMAX1(ZEROS(NY,NX),Z2GS2(0,NY,NX)+RNGDXR) - 4*VOLPM(M,0,NY,NX))/VOLNGR(NY,NX) - RN2DFG(0,NY,NX)=DFGS(M,0,NY,NX) - 2*(AMAX1(ZEROS(NY,NX),Z2OG0)*VOLWN2(0,NY,NX) - 3-AMAX1(ZEROS(NY,NX),Z2OS2(0,NY,NX)+RN2DXR) - 4*VOLPM(M,0,NY,NX))/VOLN2R(NY,NX) - RN3DFG(0,NY,NX)=DFGS(M,0,NY,NX) - 2*(AMAX1(ZEROS(NY,NX),ZN3G0)*VOLWN3(0,NY,NX) - 3-AMAX1(ZEROS(NY,NX),ZN3S2(0,NY,NX)+RN3DXR) - 4*VOLPM(M,0,NY,NX))/VOLN3R(NY,NX) - CNH3S0=AMAX1(0.0,(ZN3S2(0,NY,NX)+RN3DFG(0,NY,NX))) - 2/VOLWXA(0,NY,NX) - CNH4S0=AMAX1(0.0,ZNH4S2(0,NY,NX)) - 2/VOLWXA(0,NY,NX) - RN34SQ(0,NY,NX)=VOLWXA(0,NY,NX) - 2*(CHY0(0,NY,NX)*CNH3S0-DPN4*CNH4S0)/(DPN4+CHY0(0,NY,NX)) - RHGDFG(0,NY,NX)=DFGS(M,0,NY,NX) - 2*(AMAX1(ZEROS(NY,NX),H2GG0)*VOLWHG(0,NY,NX) - 3-AMAX1(ZEROS(NY,NX),H2GS2(0,NY,NX)+RHGDXR) - 4*VOLPM(M,0,NY,NX))/VOLHGR(NY,NX) -C -C ACCUMULATE HOURLY FLUXES -C - XCODFG(0,NY,NX)=XCODFG(0,NY,NX)+RCODFG(0,NY,NX) - XCHDFG(0,NY,NX)=XCHDFG(0,NY,NX)+RCHDFG(0,NY,NX) - XOXDFG(0,NY,NX)=XOXDFG(0,NY,NX)+ROXDFG(0,NY,NX) - XNGDFG(0,NY,NX)=XNGDFG(0,NY,NX)+RNGDFG(0,NY,NX) - XN2DFG(0,NY,NX)=XN2DFG(0,NY,NX)+RN2DFG(0,NY,NX) - XN3DFG(0,NY,NX)=XN3DFG(0,NY,NX)+RN3DFG(0,NY,NX) - XN34SQ(0,NY,NX)=XN34SQ(0,NY,NX)+RN34SQ(0,NY,NX) - XHGDFG(0,NY,NX)=XHGDFG(0,NY,NX)+RHGDFG(0,NY,NX) -C IF(J.EQ.24)THEN -C WRITE(*,323)'RCHDFG',I,J,NX,NY,M,MM,RCHDFG(0,NY,NX) -C 2,DFGS(M,0,NY,NX),CH4G0,VOLWCH(0,NY,NX),CH4S2(0,NY,NX) -C 3,VOLPM(M,0,NY,NX),VOLCHR(NY,NX),RCHDXR -C WRITE(*,323)'ROXDFG',I,J,NX,NY,M,MM,ROXDFG(0,NY,NX) -C 2,DFGS(M,0,NY,NX),OXYG0,VOLWOX(0,NY,NX),OXYS2(0,NY,NX) -C 3,VOLPM(M,0,NY,NX),VOLOXR(NY,NX),ROXDXR,XOXDFG(0,NY,NX) -323 FORMAT(A8,6I4,30E12.4) -C ENDIF - ELSE - RCODFG(0,NY,NX)=0.0 - RCHDFG(0,NY,NX)=0.0 - ROXDFG(0,NY,NX)=0.0 - RNGDFG(0,NY,NX)=0.0 - RN2DFG(0,NY,NX)=0.0 - RN3DFG(0,NY,NX)=0.0 - RN34SQ(0,NY,NX)=0.0 - RHGDFG(0,NY,NX)=0.0 - ENDIF -C -C SURFACE GAS EXCHANGE FROM GAS DIFFUSIVITY THROUGH -C SOIL SURFACE LAYER AND THROUGH ATMOSPHERE BOUNDARY -C LAYER -C - IF(THETPM(M,NU(NY,NX),NY,NX).GT.THETX - 2.AND.BKDS(NU(NY,NX),NY,NX).GT.0.0)THEN -C -C GASEOUS DIFFUSIVITIES -C - DFLG2=AMAX1(0.0,THETPM(M,NU(NY,NX),NY,NX))**2 - 2/POROQ(NU(NY,NX),NY,NX)*AREA(3,NU(NY,NX),NY,NX) - 3/AMAX1(0.001,DLYR(3,NU(NY,NX),NY,NX)) - DCO2G(3,NU(NY,NX),NY,NX)=DFLG2*CGSGL2(NU(NY,NX),NY,NX) - DCH4G(3,NU(NY,NX),NY,NX)=DFLG2*CHSGL2(NU(NY,NX),NY,NX) - DOXYG(3,NU(NY,NX),NY,NX)=DFLG2*OGSGL2(NU(NY,NX),NY,NX) - DZ2GG(3,NU(NY,NX),NY,NX)=DFLG2*ZGSGL2(NU(NY,NX),NY,NX) - DZ2OG(3,NU(NY,NX),NY,NX)=DFLG2*Z2SGL2(NU(NY,NX),NY,NX) - DNH3G(3,NU(NY,NX),NY,NX)=DFLG2*ZHSGL2(NU(NY,NX),NY,NX) - DH2GG(3,NU(NY,NX),NY,NX)=DFLG2*HGSGL2(NU(NY,NX),NY,NX) -C -C SURFACE GAS CONCENTRATIONS -C - CCO2G2=AMAX1(0.0,CO2G2(NU(NY,NX),NY,NX) - 2/VOLPM(M,NU(NY,NX),NY,NX)) - CCH4G2=AMAX1(0.0,CH4G2(NU(NY,NX),NY,NX) - 2/VOLPM(M,NU(NY,NX),NY,NX)) - COXYG2=AMAX1(0.0,OXYG2(NU(NY,NX),NY,NX) - 2/VOLPM(M,NU(NY,NX),NY,NX)) - CZ2GG2=AMAX1(0.0,Z2GG2(NU(NY,NX),NY,NX) - 2/VOLPM(M,NU(NY,NX),NY,NX)) - CZ2OG2=AMAX1(0.0,Z2OG2(NU(NY,NX),NY,NX) - 2/VOLPM(M,NU(NY,NX),NY,NX)) - CNH3G2=AMAX1(0.0,ZN3G2(NU(NY,NX),NY,NX) - 2/VOLPM(M,NU(NY,NX),NY,NX)) - CH2GG2=AMAX1(0.0,H2GG2(NU(NY,NX),NY,NX) - 2/VOLPM(M,NU(NY,NX),NY,NX)) -C -C EQUILIBRIUM CONCENTRATIONS AT SOIL SURFACE AT WHICH -C GASEOUS DIFFUSION THROUGH SOIL SURFACE LAYER = GASEOUS -C DIFFUSION THROUGH ATMOSPHERE BOUNDARY LAYER CALCULATED -C FROM GASEOUS DIFFUSIVITY AND BOUNDARY LAYER CONDUCTANCE -C - DCO2GQ=DCO2G(3,NU(NY,NX),NY,NX)*PARGCO(NY,NX) - 2/(DCO2G(3,NU(NY,NX),NY,NX)+PARGCO(NY,NX)) - DCH4GQ=DCH4G(3,NU(NY,NX),NY,NX)*PARGCH(NY,NX) - 2/(DCH4G(3,NU(NY,NX),NY,NX)+PARGCH(NY,NX)) - DOXYGQ=DOXYG(3,NU(NY,NX),NY,NX)*PARGOX(NY,NX) - 2/(DOXYG(3,NU(NY,NX),NY,NX)+PARGOX(NY,NX)) - DZ2GGQ=DZ2GG(3,NU(NY,NX),NY,NX)*PARGNG(NY,NX) - 2/(DZ2GG(3,NU(NY,NX),NY,NX)+PARGNG(NY,NX)) - DZ2OGQ=DZ2OG(3,NU(NY,NX),NY,NX)*PARGN2(NY,NX) - 2/(DZ2OG(3,NU(NY,NX),NY,NX)+PARGN2(NY,NX)) - DNH3GQ=DNH3G(3,NU(NY,NX),NY,NX)*PARGN3(NY,NX) - 2/(DNH3G(3,NU(NY,NX),NY,NX)+PARGN3(NY,NX)) - DH2GGQ=DH2GG(3,NU(NY,NX),NY,NX)*PARGH2(NY,NX) - 2/(DH2GG(3,NU(NY,NX),NY,NX)+PARGH2(NY,NX)) - DFVCOG=DCO2GQ*(CCO2E(NY,NX)-CCO2G2) - DFVCHG=DCH4GQ*(CCH4E(NY,NX)-CCH4G2) - DFVOXG=DOXYGQ*(COXYE(NY,NX)-COXYG2) - DFVNGG=DZ2GGQ*(CZ2GE(NY,NX)-CZ2GG2) - DFVN2G=DZ2OGQ*(CZ2OE(NY,NX)-CZ2OG2) - DFVN3G=DNH3GQ*(CNH3E(NY,NX)-CNH3G2) - DFVHGG=DH2GGQ*(CH2GE(NY,NX)-CH2GG2) -C -C CONVECTIVE GAS TRANSFER DRIVEN BY SURFACE WATER FLUXES -C FROM 'WATSUB' AND GAS CONCENTRATIONS IN THE SOIL SURFACE -C OR THE ATMOSPHERE DEPENDING ON WATER FLUX DIRECTION -C - IF(FLQM(3,NU(NY,NX),NY,NX).GT.0.0)THEN - IF(VOLPM(M,NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN - VFLW=-AMAX1(0.0,AMIN1(XFRX,FLQM(3,NU(NY,NX),NY,NX) - 2/VOLPM(M,NU(NY,NX),NY,NX))) - ELSE - VFLW=-XFRX - ENDIF - RFLCOG=VFLW*AMAX1(0.0,CO2G2(NU(NY,NX),NY,NX)) - RFLCHG=VFLW*AMAX1(0.0,CH4G2(NU(NY,NX),NY,NX)) - RFLOXG=VFLW*AMAX1(0.0,OXYG2(NU(NY,NX),NY,NX)) - RFLNGG=VFLW*AMAX1(0.0,Z2GG2(NU(NY,NX),NY,NX)) - RFLN2G=VFLW*AMAX1(0.0,Z2OG2(NU(NY,NX),NY,NX)) - RFLN3G=VFLW*AMAX1(0.0,ZN3G2(NU(NY,NX),NY,NX)) - RFLH2G=VFLW*AMAX1(0.0,H2GG2(NU(NY,NX),NY,NX)) - ELSE - RFLCOG=-FLQM(3,NU(NY,NX),NY,NX)*CCO2E(NY,NX) - RFLCHG=-FLQM(3,NU(NY,NX),NY,NX)*CCH4E(NY,NX) - RFLOXG=-FLQM(3,NU(NY,NX),NY,NX)*COXYE(NY,NX) - RFLNGG=-FLQM(3,NU(NY,NX),NY,NX)*CZ2GE(NY,NX) - RFLN2G=-FLQM(3,NU(NY,NX),NY,NX)*CZ2OE(NY,NX) - RFLN3G=-FLQM(3,NU(NY,NX),NY,NX)*CNH3E(NY,NX) - RFLH2G=-FLQM(3,NU(NY,NX),NY,NX)*CH2GE(NY,NX) - ENDIF -C -C SURFACE GAS FLUX FROM DIFFERENCES -C BETWEEN ATMOSPHERIC AND SOIL SURFACE EQUILIBRIUM -C CONCENTRATIONS + CONVECTIVE FLUX -C - RCOFLG(3,NU(NY,NX),NY,NX)=DFVCOG+RFLCOG - RCHFLG(3,NU(NY,NX),NY,NX)=DFVCHG+RFLCHG - ROXFLG(3,NU(NY,NX),NY,NX)=DFVOXG+RFLOXG - RNGFLG(3,NU(NY,NX),NY,NX)=DFVNGG+RFLNGG - RN2FLG(3,NU(NY,NX),NY,NX)=DFVN2G+RFLN2G - RN3FLG(3,NU(NY,NX),NY,NX)=DFVN3G+RFLN3G - RHGFLG(3,NU(NY,NX),NY,NX)=DFVHGG+RFLH2G -C -C ACCUMULATE HOURLY FLUXES -C - XCOFLG(3,NU(NY,NX),NY,NX)=XCOFLG(3,NU(NY,NX),NY,NX) - 2+RCOFLG(3,NU(NY,NX),NY,NX) - XCHFLG(3,NU(NY,NX),NY,NX)=XCHFLG(3,NU(NY,NX),NY,NX) - 2+RCHFLG(3,NU(NY,NX),NY,NX) - XOXFLG(3,NU(NY,NX),NY,NX)=XOXFLG(3,NU(NY,NX),NY,NX) - 2+ROXFLG(3,NU(NY,NX),NY,NX) - XNGFLG(3,NU(NY,NX),NY,NX)=XNGFLG(3,NU(NY,NX),NY,NX) - 2+RNGFLG(3,NU(NY,NX),NY,NX) - XN2FLG(3,NU(NY,NX),NY,NX)=XN2FLG(3,NU(NY,NX),NY,NX) - 2+RN2FLG(3,NU(NY,NX),NY,NX) - XN3FLG(3,NU(NY,NX),NY,NX)=XN3FLG(3,NU(NY,NX),NY,NX) - 2+RN3FLG(3,NU(NY,NX),NY,NX) - XHGFLG(3,NU(NY,NX),NY,NX)=XHGFLG(3,NU(NY,NX),NY,NX) - 2+RHGFLG(3,NU(NY,NX),NY,NX) -C IF(J.EQ.24)THEN -C WRITE(*,3131)'ROXFLG',I,J,NX,NY,M,MM,XOXFLG(3,NU(NY,NX),NY,NX) -C 2,ROXFLG(3,NU(NY,NX),NY,NX),DFVOXG,RFLOXG,COXYE(NY,NX) -C 2,COXYG2,DOXYGQ,OXYG2(NU(NY,NX),NY,NX),FLQM(3,NU(NY,NX),NY,NX) -C 3,VFLW,DOXYG(3,NU(NY,NX),NY,NX),PARGOX(NY,NX) -C 4,THETPM(M,NU(NY,NX),NY,NX),VOLPM(M,NU(NY,NX),NY,NX) -C 5,DFGS(M,NU(NY,NX),NY,NX) -C WRITE(*,3131)'RNGFLG',I,J,NX,NY,M,MM,XNGFLG(3,NU(NY,NX),NY,NX) -C 2,RNGFLG(3,NU(NY,NX),NY,NX),DFVNGG,RFLNGG,CZ2GE(NY,NX) -C 2,CZ2GG2,DZ2GGQ,Z2GG2(NU(NY,NX),NY,NX),FLQM(3,NU(NY,NX),NY,NX) -C 3,VFLW,DZ2GG(3,NU(NY,NX),NY,NX),PARGNG(NY,NX) -C 4,THETPM(M,NU(NY,NX),NY,NX),VOLPM(M,NU(NY,NX),NY,NX) -3131 FORMAT(A8,6I4,30E12.4) -C ENDIF -C -C SOIL SURFACE -C - IF(THETW1(NU(NY,NX),NY,NX).GT.THETY(NU(NY,NX),NY,NX))THEN - VOLCOT(NY,NX)=VOLWCO(NU(NY,NX),NY,NX)+VOLPM(M,NU(NY,NX),NY,NX) - VOLCHT(NY,NX)=VOLWCH(NU(NY,NX),NY,NX)+VOLPM(M,NU(NY,NX),NY,NX) - VOLOXT(NY,NX)=VOLWOX(NU(NY,NX),NY,NX)+VOLPM(M,NU(NY,NX),NY,NX) - VOLNGT(NY,NX)=VOLWNG(NU(NY,NX),NY,NX)+VOLPM(M,NU(NY,NX),NY,NX) - VOLN2T(NY,NX)=VOLWN2(NU(NY,NX),NY,NX)+VOLPM(M,NU(NY,NX),NY,NX) - VOLN3T(NY,NX)=VOLWN3(NU(NY,NX),NY,NX)+VOLPMA(NU(NY,NX),NY,NX) - VOLNBT(NY,NX)=VOLWNB(NU(NY,NX),NY,NX)+VOLPMB(NU(NY,NX),NY,NX) - VOLHGT(NY,NX)=VOLWHG(NU(NY,NX),NY,NX)+VOLPM(M,NU(NY,NX),NY,NX) - RCODFG(NU(NY,NX),NY,NX)=DFGS(M,NU(NY,NX),NY,NX) - 2*(AMAX1(ZEROS(NY,NX),CO2G2(NU(NY,NX),NY,NX)) - 3*VOLWCO(NU(NY,NX),NY,NX)-AMAX1(ZEROS(NY,NX) - 2,CO2S2(NU(NY,NX),NY,NX)+RCODXS) - 4*VOLPM(M,NU(NY,NX),NY,NX))/VOLCOT(NY,NX) - RCHDFG(NU(NY,NX),NY,NX)=DFGS(M,NU(NY,NX),NY,NX) - 2*(AMAX1(ZEROS(NY,NX),CH4G2(NU(NY,NX),NY,NX)) - 3*VOLWCH(NU(NY,NX),NY,NX)-AMAX1(ZEROS(NY,NX) - 2,CH4S2(NU(NY,NX),NY,NX)+RCHDXS) - 4*VOLPM(M,NU(NY,NX),NY,NX))/VOLCHT(NY,NX) - ROXDFG(NU(NY,NX),NY,NX)=DFGS(M,NU(NY,NX),NY,NX) - 2*(AMAX1(ZEROS(NY,NX),OXYG2(NU(NY,NX),NY,NX)) - 3*VOLWOX(NU(NY,NX),NY,NX)-AMAX1(ZEROS(NY,NX) - 2,OXYS2(NU(NY,NX),NY,NX)+ROXDXS) - 4*VOLPM(M,NU(NY,NX),NY,NX))/VOLOXT(NY,NX) - RNGDFG(NU(NY,NX),NY,NX)=DFGS(M,NU(NY,NX),NY,NX) - 2*(AMAX1(ZEROS(NY,NX),Z2GG2(NU(NY,NX),NY,NX)) - 3*VOLWNG(NU(NY,NX),NY,NX)-AMAX1(ZEROS(NY,NX) - 4,Z2GS2(NU(NY,NX),NY,NX)+RNGDXS) - 4*VOLPM(M,NU(NY,NX),NY,NX))/VOLNGT(NY,NX) - RN2DFG(NU(NY,NX),NY,NX)=DFGS(M,NU(NY,NX),NY,NX) - 2*(AMAX1(ZEROS(NY,NX),Z2OG2(NU(NY,NX),NY,NX)) - 3*VOLWN2(NU(NY,NX),NY,NX)-AMAX1(ZEROS(NY,NX) - 2,Z2OS2(NU(NY,NX),NY,NX)+RN2DXS) - 4*VOLPM(M,NU(NY,NX),NY,NX))/VOLN2T(NY,NX) - IF(VOLN3T(NY,NX).GT.ZEROS(NY,NX) - 2.AND.VOLWXA(NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN - RN3DFG(NU(NY,NX),NY,NX)=DFGS(M,NU(NY,NX),NY,NX) - 2*(AMAX1(ZEROS(NY,NX),ZN3G2(NU(NY,NX),NY,NX)) - 3*VOLWN3(NU(NY,NX),NY,NX)-AMAX1(ZEROS(NY,NX) - 4,ZN3S2(NU(NY,NX),NY,NX)+RN3DXS) - 5*VOLPMA(NU(NY,NX),NY,NX))/VOLN3T(NY,NX) - CNH3S0=AMAX1(0.0,(ZN3S2(NU(NY,NX),NY,NX) - 2+RN3DFG(NU(NY,NX),NY,NX))/VOLWXA(NU(NY,NX),NY,NX)) - CNH4S0=AMAX1(0.0,ZNH4S2(NU(NY,NX),NY,NX)) - 2/VOLWXA(NU(NY,NX),NY,NX) - RN34SQ(NU(NY,NX),NY,NX)=VOLWXA(NU(NY,NX),NY,NX) - 2*(CHY0(NU(NY,NX),NY,NX)*CNH3S0-DPN4*CNH4S0) - 3/(DPN4+CHY0(NU(NY,NX),NY,NX)) - ELSE - RN3DFG(NU(NY,NX),NY,NX)=0.0 - RN34SQ(NU(NY,NX),NY,NX)=0.0 - ENDIF - IF(VOLNBT(NY,NX).GT.ZEROS(NY,NX) - 2.AND.VOLWXB(NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN - RNBDFG(NU(NY,NX),NY,NX)=DFGS(M,NU(NY,NX),NY,NX) - 2*(AMAX1(ZEROS(NY,NX),ZN3G2(NU(NY,NX),NY,NX)) - 3*VOLWNB(NU(NY,NX),NY,NX)-AMAX1(ZEROS(NY,NX) - 4,ZNBS2(NU(NY,NX),NY,NX)+RNBDXS) - 5*VOLPMB(NU(NY,NX),NY,NX))/VOLNBT(NY,NX) - CNH3B0=AMAX1(0.0,(ZNBS2(NU(NY,NX),NY,NX) - 2+RNBDFG(NU(NY,NX),NY,NX))/VOLWXB(NU(NY,NX),NY,NX)) - CNH4B0=AMAX1(0.0,ZNH4B2(NU(NY,NX),NY,NX)) - 2/VOLWXB(NU(NY,NX),NY,NX) - RN34BQ(NU(NY,NX),NY,NX)=VOLWXB(NU(NY,NX),NY,NX) - 2*(CHY0(NU(NY,NX),NY,NX)*CNH3B0-DPN4*CNH4B0) - 3/(DPN4+CHY0(NU(NY,NX),NY,NX)) - ELSE - RNBDFG(NU(NY,NX),NY,NX)=0.0 - RN34BQ(NU(NY,NX),NY,NX)=0.0 - ENDIF - RHGDFG(NU(NY,NX),NY,NX)=DFGS(M,NU(NY,NX),NY,NX) - 2*(AMAX1(ZEROS(NY,NX),H2GG2(NU(NY,NX),NY,NX)) - 3*VOLWHG(NU(NY,NX),NY,NX)-AMAX1(ZEROS(NY,NX) - 4,H2GS2(NU(NY,NX),NY,NX)+RHGDXS) - 4*VOLPM(M,NU(NY,NX),NY,NX))/VOLHGT(NY,NX) -C IF(J.EQ.12)THEN -C WRITE(*,323)'RN3FLG',I,J,NX,NY,M,MM,RN3FLG(3,NU(NY,NX),NY,NX) -C 2,DNH3GQ,CNH3E(NY,NX),CNH3G2,FLQM(3,NU(NY,NX),NY,NX),CNH3GV -C 2,CNH3B2,ZNBS2(NU(NY,NX),NY,NX),RNBDFG(NU(NY,NX),NY,NX) -C 3,DFGS(M,NU(NY,NX),NY,NX),ZN3G2B,VOLPMB(NU(NY,NX),NY,NX) -C 4,ZNBS2(NU(NY,NX),NY,NX),VOLWNB(NU(NY,NX),NY,NX) -C 5,VOLWMB,SNH3L(NU(NY,NX),NY,NX) -C WRITE(*,323)'RNGDFG',I,J,NX,NY,M,MM,RNGDFG(NU(NY,NX),NY,NX) -C 2,DFGS(M,NU(NY,NX),NY,NX),Z2GG2(NU(NY,NX),NY,NX) -C 3,VOLWNG(NU(NY,NX),NY,NX),Z2GS2(NU(NY,NX),NY,NX) -C 4,RNGDFS(NY,NX),VOLPM(M,NU(NY,NX),NY,NX),VOLNGT(NY,NX) -C ENDIF -C -C ACCUMULATE HOURLY FLUXES -C - XCODFG(NU(NY,NX),NY,NX)=XCODFG(NU(NY,NX),NY,NX) - 2+RCODFG(NU(NY,NX),NY,NX) - XCHDFG(NU(NY,NX),NY,NX)=XCHDFG(NU(NY,NX),NY,NX) - 2+RCHDFG(NU(NY,NX),NY,NX) - XOXDFG(NU(NY,NX),NY,NX)=XOXDFG(NU(NY,NX),NY,NX) - 2+ROXDFG(NU(NY,NX),NY,NX) - XNGDFG(NU(NY,NX),NY,NX)=XNGDFG(NU(NY,NX),NY,NX) - 2+RNGDFG(NU(NY,NX),NY,NX) - XN2DFG(NU(NY,NX),NY,NX)=XN2DFG(NU(NY,NX),NY,NX) - 2+RN2DFG(NU(NY,NX),NY,NX) - XN3DFG(NU(NY,NX),NY,NX)=XN3DFG(NU(NY,NX),NY,NX) - 2+RN3DFG(NU(NY,NX),NY,NX) - XN34SQ(NU(NY,NX),NY,NX)=XN34SQ(NU(NY,NX),NY,NX) - 2+RN34SQ(NU(NY,NX),NY,NX) - XNBDFG(NU(NY,NX),NY,NX)=XNBDFG(NU(NY,NX),NY,NX) - 2+RNBDFG(NU(NY,NX),NY,NX) - XN34BQ(NU(NY,NX),NY,NX)=XN34BQ(NU(NY,NX),NY,NX) - 2+RN34BQ(NU(NY,NX),NY,NX) - XHGDFG(NU(NY,NX),NY,NX)=XHGDFG(NU(NY,NX),NY,NX) - 2+RHGDFG(NU(NY,NX),NY,NX) -C WRITE(*,3131)'ROXDFG',I,J,NX,NY,M,MM,XOXDFG(NU(NY,NX),NY,NX) -C 2,ROXDFG(NU(NY,NX),NY,NX),DFGS(M,NU(NY,NX),NY,NX) -C 2,AMAX1(ZEROS(NY,NX),OXYG2(NU(NY,NX),NY,NX)) -C 3,VOLWOX(NU(NY,NX),NY,NX),AMAX1(ZEROS(NY,NX) -C 4,OXYS2(NU(NY,NX),NY,NX)),VOLPM(M,NU(NY,NX),NY,NX) - ELSE - RCODFG(NU(NY,NX),NY,NX)=0.0 - RCHDFG(NU(NY,NX),NY,NX)=0.0 - ROXDFG(NU(NY,NX),NY,NX)=0.0 - RNGDFG(NU(NY,NX),NY,NX)=0.0 - RN2DFG(NU(NY,NX),NY,NX)=0.0 - RN3DFG(NU(NY,NX),NY,NX)=0.0 - RN34SQ(NU(NY,NX),NY,NX)=0.0 - RNBDFG(NU(NY,NX),NY,NX)=0.0 - RN34BQ(NU(NY,NX),NY,NX)=0.0 - RHGDFG(NU(NY,NX),NY,NX)=0.0 - ENDIF - ELSE - RCOFLG(3,NU(NY,NX),NY,NX)=0.0 - RCHFLG(3,NU(NY,NX),NY,NX)=0.0 - ROXFLG(3,NU(NY,NX),NY,NX)=0.0 - RNGFLG(3,NU(NY,NX),NY,NX)=0.0 - RN2FLG(3,NU(NY,NX),NY,NX)=0.0 - RN3FLG(3,NU(NY,NX),NY,NX)=0.0 - RHGFLG(3,NU(NY,NX),NY,NX)=0.0 - RCODFG(NU(NY,NX),NY,NX)=0.0 - RCHDFG(NU(NY,NX),NY,NX)=0.0 - ROXDFG(NU(NY,NX),NY,NX)=0.0 - RN2DFG(NU(NY,NX),NY,NX)=0.0 - RNGDFG(NU(NY,NX),NY,NX)=0.0 - RN3DFG(NU(NY,NX),NY,NX)=0.0 - RN34SQ(NU(NY,NX),NY,NX)=0.0 - RNBDFG(NU(NY,NX),NY,NX)=0.0 - RN34BQ(NU(NY,NX),NY,NX)=0.0 - RHGDFG(NU(NY,NX),NY,NX)=0.0 - ENDIF -C -C SOLUTE FLUXES BETWEEN ADJACENT GRID CELLS -C - IFLGB=0 - DO 125 L=1,NL(NY,NX) - N1=NX - N2=NY - N3=L -C -C LOCATE INTERNAL BOUNDARIES BETWEEN ADJACENT GRID CELLS -C - DO 120 N=NCN(N2,N1),3 - IF(N.EQ.1)THEN - IF(NX.EQ.NHE)THEN - GO TO 120 - ELSE - N4=NX+1 - N5=NY - N6=L - ENDIF - ELSEIF(N.EQ.2)THEN - IF(NY.EQ.NVS)THEN - GO TO 120 - ELSE - N4=NX - N5=NY+1 - N6=L - ENDIF - ELSEIF(N.EQ.3)THEN - IF(L.EQ.NL(NY,NX))THEN - GO TO 120 - ELSE - N4=NX - N5=NY - N6=L+1 - ENDIF - ENDIF - IF(N3.GE.NU(N2,N1).AND.N6.GE.NU(N5,N4))THEN - IF(M.NE.MX)THEN -C -C SOLUTE FLUXES BETWEEN ADJACENT GRID CELLS FROM -C WATER CONTENTS AND WATER FLUXES 'FLQM' FROM 'WATSUB' -C - VOLW4A=VOLWM(M,N3,N2,N1)*VLNH4(N3,N2,N1) - VOLW4B=VOLWM(M,N3,N2,N1)*VLNHB(N3,N2,N1) - VOLH4A=VOLWHM(M,N3,N2,N1)*VLNH4(N3,N2,N1) - VOLH4B=VOLWHM(M,N3,N2,N1)*VLNHB(N3,N2,N1) - VOLW3A=VOLWM(M,N3,N2,N1)*VLNO3(N3,N2,N1) - VOLW3B=VOLWM(M,N3,N2,N1)*VLNOB(N3,N2,N1) - VOLH3A=VOLWHM(M,N3,N2,N1)*VLNO3(N3,N2,N1) - VOLH3B=VOLWHM(M,N3,N2,N1)*VLNOB(N3,N2,N1) - VOLW2A=VOLWM(M,N3,N2,N1)*VLPO4(N3,N2,N1) - VOLW2B=VOLWM(M,N3,N2,N1)*VLPOB(N3,N2,N1) - VOLH2A=VOLWHM(M,N3,N2,N1)*VLPO4(N3,N2,N1) - VOLH2B=VOLWHM(M,N3,N2,N1)*VLPOB(N3,N2,N1) - VOLWMA(N6,N5,N4)=VOLWM(M,N6,N5,N4)*VLNH4(N6,N5,N4) - VOLWMB(N6,N5,N4)=VOLWM(M,N6,N5,N4)*VLNHB(N6,N5,N4) - VOLWXA(N6,N5,N4)=14.0*VOLWMA(N6,N5,N4) - VOLWXB(N6,N5,N4)=14.0*VOLWMB(N6,N5,N4) - VOLWOA=VOLWM(M,N6,N5,N4)*VLNO3(N6,N5,N4) - VOLWOB=VOLWM(M,N6,N5,N4)*VLNOB(N6,N5,N4) - VOLHOA=VOLWHM(M,N6,N5,N4)*VLNO3(N6,N5,N4) - VOLHOB=VOLWHM(M,N6,N5,N4)*VLNOB(N6,N5,N4) - VOLWPA=VOLWM(M,N6,N5,N4)*VLPO4(N6,N5,N4) - VOLWPB=VOLWM(M,N6,N5,N4)*VLPOB(N6,N5,N4) - VOLHPA=VOLWHM(M,N6,N5,N4)*VLPO4(N6,N5,N4) - VOLHPB=VOLWHM(M,N6,N5,N4)*VLPOB(N6,N5,N4) - VOLPMA(N6,N5,N4)=VOLPM(M,N6,N5,N4)*VLNH4(N6,N5,N4) - VOLPMB(N6,N5,N4)=VOLPM(M,N6,N5,N4)*VLNHB(N6,N5,N4) - THETW1(N3,N2,N1)=AMAX1(0.0,VOLWM(M,N3,N2,N1)/VOLX(N3,N2,N1)) - THETW1(N6,N5,N4)=AMAX1(0.0,VOLWM(M,N6,N5,N4)/VOLX(N6,N5,N4)) - FLVM(N6,N5,N4)=FLPM(M,N6,N5,N4)*XNPT -C -C GASEOUS SOLUBILITIES -C - IF(N.EQ.3)THEN - VOLWCO(N6,N5,N4)=VOLWM(M,N6,N5,N4)*SCO2L(N6,N5,N4) - VOLWCH(N6,N5,N4)=VOLWM(M,N6,N5,N4)*SCH4L(N6,N5,N4) - VOLWOX(N6,N5,N4)=VOLWM(M,N6,N5,N4)*SOXYL(N6,N5,N4) - VOLWNG(N6,N5,N4)=VOLWM(M,N6,N5,N4)*SN2GL(N6,N5,N4) - VOLWN2(N6,N5,N4)=VOLWM(M,N6,N5,N4)*SN2OL(N6,N5,N4) - VOLWN3(N6,N5,N4)=VOLWMA(N6,N5,N4)*SNH3L(N6,N5,N4) - VOLWNB(N6,N5,N4)=VOLWMB(N6,N5,N4)*SNH3L(N6,N5,N4) - VOLWHG(N6,N5,N4)=VOLWM(M,N6,N5,N4)*SH2GL(N6,N5,N4) - ENDIF - FLQM(N,N6,N5,N4)=(FLWM(M,N,N6,N5,N4)+FLWHM(M,N,N6,N5,N4))*XNPT -C -C SOLUTE TRANSPORT IN MICROPORES -C - IF(FLWM(M,N,N6,N5,N4).GT.0.0)THEN -C -C IF MICROPORE WATER FLUX FROM 'WATSUB' IS FROM CURRENT TO -C ADJACENT GRID CELL THEN CONVECTIVE TRANSPORT IS THE PRODUCT -C OF WATER FLUX AND MICROPORE GAS OR SOLUTE CONCENTRATIONS -C IN CURRENT GRID CELL -C - IF(VOLWM(M,N3,N2,N1).GT.ZEROS(N2,N1))THEN - VFLW=AMAX1(0.0,AMIN1(XFRX,FLWM(M,N,N6,N5,N4) - 2/VOLWM(M,N3,N2,N1))) - ELSE - VFLW=XFRX - ENDIF - DO 9820 K=0,4 - RFLOC(K)=VFLW*AMAX1(0.0,OQC2(K,N3,N2,N1)) - RFLON(K)=VFLW*AMAX1(0.0,OQN2(K,N3,N2,N1)) - RFLOP(K)=VFLW*AMAX1(0.0,OQP2(K,N3,N2,N1)) - RFLOA(K)=VFLW*AMAX1(0.0,OQA2(K,N3,N2,N1)) -9820 CONTINUE - RFLCOS=VFLW*AMAX1(0.0,CO2S2(N3,N2,N1)) - RFLCHS=VFLW*AMAX1(0.0,CH4S2(N3,N2,N1)) - RFLOXS=VFLW*AMAX1(0.0,OXYS2(N3,N2,N1)) - RFLNGS=VFLW*AMAX1(0.0,Z2GS2(N3,N2,N1)) - RFLN2S=VFLW*AMAX1(0.0,Z2OS2(N3,N2,N1)) - RFLHGS=VFLW*AMAX1(0.0,H2GS2(N3,N2,N1)) - RFLNH4=VFLW*AMAX1(0.0,ZNH4S2(N3,N2,N1)) - RFLNH3=VFLW*AMAX1(0.0,ZN3S2(N3,N2,N1)) - RFLNO3=VFLW*AMAX1(0.0,ZNO3S2(N3,N2,N1)) - RFLNO2=VFLW*AMAX1(0.0,ZNO2S2(N3,N2,N1)) - RFLPO4=VFLW*AMAX1(0.0,H2PO42(N3,N2,N1)) - RFLN4B=VFLW*AMAX1(0.0,ZNH4B2(N3,N2,N1)) - RFLN3B=VFLW*AMAX1(0.0,ZNBS2(N3,N2,N1)) - RFLNOB=VFLW*AMAX1(0.0,ZNO3B2(N3,N2,N1)) - RFLN2B=VFLW*AMAX1(0.0,ZNO2B2(N3,N2,N1)) - RFLPOB=VFLW*AMAX1(0.0,H2POB2(N3,N2,N1)) - ELSE -C -C IF MICROPORE WATER FLUX FROM 'WATSUB' IS TO CURRENT FROM -C ADJACENT GRID CELL THEN CONVECTIVE TRANSPORT IS THE PRODUCT -C OF WATER FLUX AND MICROPORE GAS OR SOLUTE CONCENTRATIONS -C IN ADJACENT GRID CELL -C - IF(VOLWM(M,N6,N5,N4).GT.ZEROS(N5,N4))THEN - VFLW=AMIN1(0.0,AMAX1(-XFRX,FLWM(M,N,N6,N5,N4) - 2/VOLWM(M,N6,N5,N4))) - ELSE - VFLW=-XFRX - ENDIF - DO 9815 K=0,4 - RFLOC(K)=VFLW*AMAX1(0.0,OQC2(K,N6,N5,N4)) - RFLON(K)=VFLW*AMAX1(0.0,OQN2(K,N6,N5,N4)) - RFLOP(K)=VFLW*AMAX1(0.0,OQP2(K,N6,N5,N4)) - RFLOA(K)=VFLW*AMAX1(0.0,OQA2(K,N6,N5,N4)) -9815 CONTINUE - RFLCOS=VFLW*AMAX1(0.0,CO2S2(N6,N5,N4)) - RFLCHS=VFLW*AMAX1(0.0,CH4S2(N6,N5,N4)) - RFLOXS=VFLW*AMAX1(0.0,OXYS2(N6,N5,N4)) - RFLNGS=VFLW*AMAX1(0.0,Z2GS2(N6,N5,N4)) - RFLN2S=VFLW*AMAX1(0.0,Z2OS2(N6,N5,N4)) - RFLHGS=VFLW*AMAX1(0.0,H2GS2(N6,N5,N4)) - RFLNH4=VFLW*AMAX1(0.0,ZNH4S2(N6,N5,N4)) - RFLNH3=VFLW*AMAX1(0.0,ZN3S2(N6,N5,N4)) - RFLNO3=VFLW*AMAX1(0.0,ZNO3S2(N6,N5,N4)) - RFLNO2=VFLW*AMAX1(0.0,ZNO2S2(N6,N5,N4)) - RFLPO4=VFLW*AMAX1(0.0,H2PO42(N6,N5,N4)) - RFLN4B=VFLW*AMAX1(0.0,ZNH4B2(N6,N5,N4)) - RFLN3B=VFLW*AMAX1(0.0,ZNBS2(N6,N5,N4)) - RFLNOB=VFLW*AMAX1(0.0,ZNO3B2(N6,N5,N4)) - RFLN2B=VFLW*AMAX1(0.0,ZNO2B2(N6,N5,N4)) - RFLPOB=VFLW*AMAX1(0.0,H2POB2(N6,N5,N4)) - ENDIF -C -C DIFFUSIVE FLUXES OF GASES AND SOLUTES BETWEEN CURRENT AND -C ADJACENT GRID CELL MICROPORES FROM AQUEOUS DIFFUSIVITIES -C AND CONCENTRATION DIFFERENCES -C - IF(THETW1(N3,N2,N1).GT.THETY(N3,N2,N1) - 2.AND.THETW1(N6,N5,N4).GT.THETY(N6,N5,N4))THEN -C -C MICROPORE CONCENTRATIONS FROM WATER-FILLED POROSITY -C IN CURRENT AND ADJACENT GRID CELLS -C - DO 9810 K=0,4 - COQC1(K)=AMAX1(0.0,OQC2(K,N3,N2,N1)/VOLWM(M,N3,N2,N1)) - COQN1(K)=AMAX1(0.0,OQN2(K,N3,N2,N1)/VOLWM(M,N3,N2,N1)) - COQP1(K)=AMAX1(0.0,OQP2(K,N3,N2,N1)/VOLWM(M,N3,N2,N1)) - COQA1(K)=AMAX1(0.0,OQA2(K,N3,N2,N1)/VOLWM(M,N3,N2,N1)) - COQC2(K)=AMAX1(0.0,OQC2(K,N6,N5,N4)/VOLWM(M,N6,N5,N4)) - COQN2(K)=AMAX1(0.0,OQN2(K,N6,N5,N4)/VOLWM(M,N6,N5,N4)) - COQP2(K)=AMAX1(0.0,OQP2(K,N6,N5,N4)/VOLWM(M,N6,N5,N4)) - COQA2(K)=AMAX1(0.0,OQA2(K,N6,N5,N4)/VOLWM(M,N6,N5,N4)) -9810 CONTINUE - CCO2S1=AMAX1(0.0,CO2S2(N3,N2,N1)/VOLWM(M,N3,N2,N1)) - CCH4S1=AMAX1(0.0,CH4S2(N3,N2,N1)/VOLWM(M,N3,N2,N1)) - COXYS1=AMAX1(0.0,OXYS2(N3,N2,N1)/VOLWM(M,N3,N2,N1)) - CZ2GS1=AMAX1(0.0,Z2GS2(N3,N2,N1)/VOLWM(M,N3,N2,N1)) - CZ2OS1=AMAX1(0.0,Z2OS2(N3,N2,N1)/VOLWM(M,N3,N2,N1)) - CH2GS1=AMAX1(0.0,H2GS2(N3,N2,N1)/VOLWM(M,N3,N2,N1)) - IF(VOLW4A.GT.ZEROS(N2,N1))THEN - CNH4S1=AMAX1(0.0,ZNH4S2(N3,N2,N1)/VOLW4A) - CNH3S1=AMAX1(0.0,ZN3S2(N3,N2,N1)/VOLW4A) - ELSE - CNH4S1=0.0 - CNH3S1=0.0 - ENDIF - IF(VOLW3A.GT.ZEROS(N2,N1))THEN - CNO3S1=AMAX1(0.0,ZNO3S2(N3,N2,N1)/VOLW3A) - CNO2S1=AMAX1(0.0,ZNO2S2(N3,N2,N1)/VOLW3A) - ELSE - CNO3S1=0.0 - CNO2S1=0.0 - ENDIF - IF(VOLW2A.GT.ZEROS(N2,N1))THEN - CPO4S1=AMAX1(0.0,H2PO42(N3,N2,N1)/VOLW2A) - ELSE - CPO4S1=0.0 - ENDIF - IF(VOLW4B.GT.ZEROS(N2,N1))THEN - CNH4B1=AMAX1(0.0,ZNH4B2(N3,N2,N1)/VOLW4B) - CNH3B1=AMAX1(0.0,ZNBS2(N3,N2,N1)/VOLW4B) - ELSE - CNH4B1=0.0 - CNH3B1=0.0 - ENDIF - IF(VOLW3B.GT.ZEROS(N2,N1))THEN - CNO3B1=AMAX1(0.0,ZNO3B2(N3,N2,N1)/VOLW3B) - CNO2B1=AMAX1(0.0,ZNO2B2(N3,N2,N1)/VOLW3B) - ELSE - CNO3B1=CNO3S1 - CNO2B1=CNO2S1 - ENDIF - IF(VOLW2B.GT.ZEROS(N2,N1))THEN - CPO4B1=AMAX1(0.0,H2POB2(N3,N2,N1)/VOLW2B) - ELSE - CPO4B1=CPO4S1 - ENDIF - CCO2S2=AMAX1(0.0,CO2S2(N6,N5,N4)/VOLWM(M,N6,N5,N4)) - CCH4S2=AMAX1(0.0,CH4S2(N6,N5,N4)/VOLWM(M,N6,N5,N4)) - COXYS2=AMAX1(0.0,OXYS2(N6,N5,N4)/VOLWM(M,N6,N5,N4)) - CZ2GS2=AMAX1(0.0,Z2GS2(N6,N5,N4)/VOLWM(M,N6,N5,N4)) - CZ2OS2=AMAX1(0.0,Z2OS2(N6,N5,N4)/VOLWM(M,N6,N5,N4)) - CH2GS2=AMAX1(0.0,H2GS2(N6,N5,N4)/VOLWM(M,N6,N5,N4)) - IF(VOLWMA(N6,N5,N4).GT.ZEROS(N5,N4))THEN - CNH3S2=AMAX1(0.0,ZN3S2(N6,N5,N4)/VOLWMA(N6,N5,N4)) - CNH4S2=AMAX1(0.0,ZNH4S2(N6,N5,N4)/VOLWMA(N6,N5,N4)) - ELSE - CNH3S2=0.0 - CNH4S2=0.0 - ENDIF - IF(VOLWOA.GT.ZEROS(N5,N4))THEN - CNO3S2=AMAX1(0.0,ZNO3S2(N6,N5,N4)/VOLWOA) - CNO2S2=AMAX1(0.0,ZNO2S2(N6,N5,N4)/VOLWOA) - ELSE - CNO3S2=0.0 - CNO2S2=0.0 - ENDIF - IF(VOLWPA.GT.ZEROS(N5,N4))THEN - CPO4S2=AMAX1(0.0,H2PO42(N6,N5,N4)/VOLWPA) - ELSE - CPO4S2=0.0 - ENDIF - IF(VOLWMB(N6,N5,N4).GT.ZEROS(N5,N4))THEN - CNH3B2=AMAX1(0.0,ZNBS2(N6,N5,N4)/VOLWMB(N6,N5,N4)) - CNH4B2=AMAX1(0.0,ZNH4B2(N6,N5,N4)/VOLWMB(N6,N5,N4)) - ELSE - CNH3B2=CNH3S2 - CNH4B2=CNH4S2 - ENDIF - IF(VOLWOB.GT.ZEROS(N5,N4))THEN - CNO3B2=AMAX1(0.0,ZNO3B2(N6,N5,N4)/VOLWOB) - CNO2B2=AMAX1(0.0,ZNO2B2(N6,N5,N4)/VOLWOB) - ELSE - CNO3B2=CNO3S2 - CNO2B2=CNO2S2 - ENDIF - IF(VOLWPB.GT.ZEROS(N5,N4))THEN - CPO4B2=AMAX1(0.0,H2POB2(N6,N5,N4)/VOLWPB) - ELSE - CPO4B2=CPO4S2 - ENDIF -C -C DIFFUSIVITIES IN CURRENT AND ADJACENT GRID CELL MICROPORES -C - TORTL=(TORT(M,N3,N2,N1)*DLYR(N,N3,N2,N1) - 2+TORT(M,N6,N5,N4)*DLYR(N,N6,N5,N4)) - 3/(DLYR(N,N3,N2,N1)+DLYR(N,N6,N5,N4)) - DISPN=DISP(N,N6,N5,N4)*ABS(FLWM(M,N,N6,N5,N4)/AREA(N,N6,N5,N4)) - DIFOC=(OCSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) - DIFON=(ONSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) - DIFOP=(OPSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) - DIFOA=(OASGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) - DIFNH=(ZNSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) - DIFNO=(ZOSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) - DIFPO=(POSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) - DIFCS=(CLSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) - DIFCQ=(CQSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) - DIFOS=(OLSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) - DIFNG=(ZLSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) - DIFN2=(ZVSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) - DIFHG=(HLSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) -C -C DIFFUSIVE FLUXES BETWEEN CURRENT AND ADJACENT GRID CELL -C MICROPORES -C - DO 9805 K=0,4 - DFVOC(K)=DIFOC*(COQC1(K)-COQC2(K)) - DFVON(K)=DIFON*(COQN1(K)-COQN2(K)) - DFVOP(K)=DIFOP*(COQP1(K)-COQP2(K)) - DFVOA(K)=DIFOA*(COQA1(K)-COQA2(K)) -9805 CONTINUE - DFVCOS=DIFCS*(CCO2S1-CCO2S2) - DFVCHS=DIFCQ*(CCH4S1-CCH4S2) - DFVOXS=DIFOS*(COXYS1-COXYS2) - DFVNGS=DIFNG*(CZ2GS1-CZ2GS2) - DFVN2S=DIFN2*(CZ2OS1-CZ2OS2) - DFVHGS=DIFHG*(CH2GS1-CH2GS2) - DFVNH4=DIFNH*(CNH4S1-CNH4S2)*AMIN1(VLNH4(N3,N2,N1) - 2,VLNH4(N6,N5,N4)) - DFVNH3=DIFNH*(CNH3S1-CNH3S2)*AMIN1(VLNH4(N3,N2,N1) - 2,VLNH4(N6,N5,N4)) - DFVNO3=DIFNO*(CNO3S1-CNO3S2)*AMIN1(VLNO3(N3,N2,N1) - 2,VLNO3(N6,N5,N4)) - DFVNO2=DIFNO*(CNO2S1-CNO2S2)*AMIN1(VLNO3(N3,N2,N1) - 2,VLNO3(N6,N5,N4)) - DFVPO4=DIFPO*(CPO4S1-CPO4S2)*AMIN1(VLPO4(N3,N2,N1) - 2,VLPO4(N6,N5,N4)) - DFVN4B=DIFNH*(CNH4B1-CNH4B2)*AMIN1(VLNHB(N3,N2,N1) - 2,VLNHB(N6,N5,N4)) - DFVN3B=DIFNH*(CNH3B1-CNH3B2)*AMIN1(VLNHB(N3,N2,N1) - 2,VLNHB(N6,N5,N4)) - DFVNOB=DIFNO*(CNO3B1-CNO3B2)*AMIN1(VLNOB(N3,N2,N1) - 2,VLNOB(N6,N5,N4)) - DFVN2B=DIFNO*(CNO2B1-CNO2B2)*AMIN1(VLNOB(N3,N2,N1) - 2,VLNOB(N6,N5,N4)) - DFVPOB=DIFPO*(CPO4B1-CPO4B2)*AMIN1(VLPOB(N3,N2,N1) - 2,VLPOB(N6,N5,N4)) - ELSE - DO 9905 K=0,4 - DFVOC(K)=0.0 - DFVON(K)=0.0 - DFVOP(K)=0.0 - DFVOA(K)=0.0 -9905 CONTINUE - DFVCOS=0.0 - DFVCHS=0.0 - DFVOXS=0.0 - DFVNGS=0.0 - DFVN2S=0.0 - DFVHGS=0.0 - DFVNH4=0.0 - DFVNH3=0.0 - DFVNO3=0.0 - DFVNO2=0.0 - DFVPO4=0.0 - DFVN4B=0.0 - DFVN3B=0.0 - DFVNOB=0.0 - DFVN2B=0.0 - DFVPOB=0.0 - ENDIF -C -C SOLUTE TRANSPORT IN MACROPORES -C - IF(FLWHM(M,N,N6,N5,N4).GT.0.0)THEN -C -C IF MACROPORE WATER FLUX FROM 'WATSUB' IS FROM CURRENT TO -C ADJACENT GRID CELL THEN CONVECTIVE TRANSPORT IS THE PRODUCT -C OF WATER FLUX AND MACROPORE SOLUTE CONCENTRATIONS IN CURRENT -C GRID CELL -C - IF(VOLWHM(M,N3,N2,N1).GT.ZEROS(N2,N1))THEN - VFLW=AMAX1(0.0,AMIN1(XFRX,FLWHM(M,N,N6,N5,N4) - 2/VOLWHM(M,N3,N2,N1))) - ELSE - VFLW=XFRX - ENDIF -C -C ACCOUNT FOR OVERLAND TRANSPORT IN THE SURFACE SOIL LAYER -C - IF(N.EQ.3.AND.VOLAH(N6,N5,N4).GT.VOLWHM(M,N6,N5,N4))THEN - DO 9800 K=0,4 - RFHOC(K)=VFLW*AMAX1(0.0,(OQCH2(K,N3,N2,N1) - 2-AMIN1(0.0,ROCFXS(K,NU(N2,N1),N2,N1)))) - RFHON(K)=VFLW*AMAX1(0.0,(OQNH2(K,N3,N2,N1) - 2-AMIN1(0.0,RONFXS(K,NU(N2,N1),N2,N1)))) - RFHOP(K)=VFLW*AMAX1(0.0,(OQPH2(K,N3,N2,N1) - 2-AMIN1(0.0,ROPFXS(K,NU(N2,N1),N2,N1)))) - RFHOA(K)=VFLW*AMAX1(0.0,(OQAH2(K,N3,N2,N1) - 2-AMIN1(0.0,ROAFXS(K,NU(N2,N1),N2,N1)))) -9800 CONTINUE - RFHCOS=VFLW*AMAX1(0.0,(CO2SH2(N3,N2,N1) - 2-AMIN1(0.0,RCOFXS(NU(N2,N1),N2,N1)))) - RFHCHS=VFLW*AMAX1(0.0,(CH4SH2(N3,N2,N1) - 2-AMIN1(0.0,RCHFXS(NU(N2,N1),N2,N1)))) - RFHOXS=VFLW*AMAX1(0.0,(OXYSH2(N3,N2,N1) - 2-AMIN1(0.0,ROXFXS(NU(N2,N1),N2,N1)))) - RFHNGS=VFLW*AMAX1(0.0,(Z2GSH2(N3,N2,N1) - 2-AMIN1(0.0,RNGFXS(NU(N2,N1),N2,N1)))) - RFHN2S=VFLW*AMAX1(0.0,(Z2OSH2(N3,N2,N1) - 2-AMIN1(0.0,RN2FXS(NU(N2,N1),N2,N1)))) - RFHHGS=VFLW*AMAX1(0.0,(H2GSH2(N3,N2,N1) - 2-AMIN1(0.0,RHGFXS(NU(N2,N1),N2,N1)))) - RFHNH4=VFLW*AMAX1(0.0,(ZNH4H2(N3,N2,N1) - 2-AMIN1(0.0,RN4FXW(NU(N2,N1),N2,N1)*VLNH4(N3,N2,N1)))) - 3*VLNH4(N6,N5,N4) - RFHNH3=VFLW*AMAX1(0.0,(ZNH3H2(N3,N2,N1) - 2-AMIN1(0.0,RN3FXW(NU(N2,N1),N2,N1)*VLNH4(N3,N2,N1)))) - 3*VLNH4(N6,N5,N4) - RFHNO3=VFLW*AMAX1(0.0,(ZNO3H2(N3,N2,N1) - 2-AMIN1(0.0,RNOFXW(NU(N2,N1),N2,N1)*VLNO3(N3,N2,N1)))) - 3*VLNO3(N6,N5,N4) - RFHNO2=VFLW*AMAX1(0.0,(ZNO2H2(N3,N2,N1) - 2-AMIN1(0.0,RNXFXS(NU(N2,N1),N2,N1)*VLNO3(N3,N2,N1)))) - 3*VLNO3(N6,N5,N4) - RFHPO4=VFLW*AMAX1(0.0,(H2P4H2(N3,N2,N1) - 2-AMIN1(0.0,RH2PXS(NU(N2,N1),N2,N1)*VLPO4(N3,N2,N1)))) - 3*VLPO4(N6,N5,N4) - RFHN4B=VFLW*AMAX1(0.0,(ZN4BH2(N3,N2,N1) - 2-AMIN1(0.0,RN4FXB(NU(N2,N1),N2,N1)*VLNHB(N3,N2,N1)))) - 3*VLNHB(N6,N5,N4) - RFHN3B=VFLW*AMAX1(0.0,(ZN3BH2(N3,N2,N1) - 2-AMIN1(0.0,RN3FXB(NU(N2,N1),N2,N1)*VLNHB(N3,N2,N1)))) - 3*VLNHB(N6,N5,N4) - RFHNOB=VFLW*AMAX1(0.0,(ZNOBH2(N3,N2,N1) - 2-AMIN1(0.0,RNOFXB(NU(N2,N1),N2,N1)*VLNOB(N3,N2,N1)))) - 3*VLNOB(N6,N5,N4) - RFHN2B=VFLW*AMAX1(0.0,(ZN2BH2(N3,N2,N1) - 2-AMIN1(0.0,RNXFXB(NU(N2,N1),N2,N1)*VLNOB(N3,N2,N1)))) - 3*VLNOB(N6,N5,N4) - RFHPOB=VFLW*AMAX1(0.0,(H2PBH2(N3,N2,N1) - 2-AMIN1(0.0,RH2BXB(NU(N2,N1),N2,N1)*VLPOB(N3,N2,N1)))) - 3*VLPOB(N6,N5,N4) -C -C IF NOT IN THE SURFACE LAYER -C - ELSE - DO 9850 K=0,4 - RFHOC(K)=VFLW*AMAX1(0.0,OQCH2(K,N3,N2,N1)) - RFHON(K)=VFLW*AMAX1(0.0,OQNH2(K,N3,N2,N1)) - RFHOP(K)=VFLW*AMAX1(0.0,OQPH2(K,N3,N2,N1)) - RFHOA(K)=VFLW*AMAX1(0.0,OQAH2(K,N3,N2,N1)) -9850 CONTINUE - RFHCOS=VFLW*AMAX1(0.0,CO2SH2(N3,N2,N1)) - RFHCHS=VFLW*AMAX1(0.0,CH4SH2(N3,N2,N1)) - RFHOXS=VFLW*AMAX1(0.0,OXYSH2(N3,N2,N1)) - RFHNGS=VFLW*AMAX1(0.0,Z2GSH2(N3,N2,N1)) - RFHN2S=VFLW*AMAX1(0.0,Z2OSH2(N3,N2,N1)) - RFHHGS=VFLW*AMAX1(0.0,H2GSH2(N3,N2,N1)) - RFHNH4=VFLW*AMAX1(0.0,ZNH4H2(N3,N2,N1))*VLNH4(N6,N5,N4) - RFHNH3=VFLW*AMAX1(0.0,ZNH3H2(N3,N2,N1))*VLNH4(N6,N5,N4) - RFHNO3=VFLW*AMAX1(0.0,ZNO3H2(N3,N2,N1))*VLNO3(N6,N5,N4) - RFHNO2=VFLW*AMAX1(0.0,ZNO2H2(N3,N2,N1))*VLNO3(N6,N5,N4) - RFHPO4=VFLW*AMAX1(0.0,H2P4H2(N3,N2,N1))*VLPO4(N6,N5,N4) - RFHN4B=VFLW*AMAX1(0.0,ZN4BH2(N3,N2,N1))*VLNHB(N6,N5,N4) - RFHN3B=VFLW*AMAX1(0.0,ZN3BH2(N3,N2,N1))*VLNHB(N6,N5,N4) - RFHNOB=VFLW*AMAX1(0.0,ZNOBH2(N3,N2,N1))*VLNOB(N6,N5,N4) - RFHN2B=VFLW*AMAX1(0.0,ZN2BH2(N3,N2,N1))*VLNOB(N6,N5,N4) - RFHPOB=VFLW*AMAX1(0.0,H2PBH2(N3,N2,N1))*VLPOB(N6,N5,N4) - ENDIF - ELSEIF(FLWHM(M,N,N6,N5,N4).LT.0.0)THEN -C -C IF MACROPORE WATER FLUX FROM 'WATSUB' IS FROM ADJACENT TO -C CURRENT GRID CELL THEN CONVECTIVE TRANSPORT IS THE PRODUCT -C OF WATER FLUX AND MACROPORE SOLUTE CONCENTRATIONS IN ADJACENT -C GRID CELL -C - IF(VOLWHM(M,N6,N5,N4).GT.ZEROS(N5,N4))THEN - VFLW=AMIN1(0.0,AMAX1(-XFRX,FLWHM(M,N,N6,N5,N4) - 2/VOLWHM(M,N6,N5,N4))) - ELSE - VFLW=-XFRX - ENDIF - DO 9665 K=0,4 - RFHOC(K)=VFLW*AMAX1(0.0,OQCH2(K,N6,N5,N4)) - RFHON(K)=VFLW*AMAX1(0.0,OQNH2(K,N6,N5,N4)) - RFHOP(K)=VFLW*AMAX1(0.0,OQPH2(K,N6,N5,N4)) - RFHOA(K)=VFLW*AMAX1(0.0,OQAH2(K,N6,N5,N4)) -9665 CONTINUE - RFHCOS=VFLW*AMAX1(0.0,CO2SH2(N6,N5,N4)) - RFHCHS=VFLW*AMAX1(0.0,CH4SH2(N6,N5,N4)) - RFHOXS=VFLW*AMAX1(0.0,OXYSH2(N6,N5,N4)) - RFHNGS=VFLW*AMAX1(0.0,Z2GSH2(N6,N5,N4)) - RFHN2S=VFLW*AMAX1(0.0,Z2OSH2(N6,N5,N4)) - RFHHGS=VFLW*AMAX1(0.0,H2GSH2(N6,N5,N4)) - RFHNH4=VFLW*AMAX1(0.0,ZNH4H2(N6,N5,N4))*VLNH4(N6,N5,N4) - RFHNH3=VFLW*AMAX1(0.0,ZNH3H2(N6,N5,N4))*VLNH4(N6,N5,N4) - RFHNO3=VFLW*AMAX1(0.0,ZNO3H2(N6,N5,N4))*VLNO3(N6,N5,N4) - RFHNO2=VFLW*AMAX1(0.0,ZNO2H2(N6,N5,N4))*VLNO3(N6,N5,N4) - RFHPO4=VFLW*AMAX1(0.0,H2P4H2(N6,N5,N4))*VLPO4(N6,N5,N4) - RFHN4B=VFLW*AMAX1(0.0,ZN4BH2(N6,N5,N4))*VLNHB(N6,N5,N4) - RFHN3B=VFLW*AMAX1(0.0,ZN3BH2(N6,N5,N4))*VLNHB(N6,N5,N4) - RFHNOB=VFLW*AMAX1(0.0,ZNOBH2(N6,N5,N4))*VLNOB(N6,N5,N4) - RFHN2B=VFLW*AMAX1(0.0,ZN2BH2(N6,N5,N4))*VLNOB(N6,N5,N4) - RFHPOB=VFLW*AMAX1(0.0,H2PBH2(N6,N5,N4))*VLPOB(N6,N5,N4) - ELSE -C -C NO MACROPORE FLUX -C - DO 9795 K=0,4 - RFHOC(K)=0.0 - RFHON(K)=0.0 - RFHOP(K)=0.0 - RFHOA(K)=0.0 -9795 CONTINUE - RFHCOS=0.0 - RFHCHS=0.0 - RFHOXS=0.0 - RFHNGS=0.0 - RFHN2S=0.0 - RFHHGS=0.0 - RFHNH4=0.0 - RFHNH3=0.0 - RFHNO3=0.0 - RFHNO2=0.0 - RFHPO4=0.0 - RFHN4B=0.0 - RFHN3B=0.0 - RFHNOB=0.0 - RFHN2B=0.0 - RFHPOB=0.0 - ENDIF -C -C DIFFUSIVE FLUXES OF GASES AND SOLUTES BETWEEN CURRENT AND -C ADJACENT GRID CELL MACROPORES FROM AQUEOUS DIFFUSIVITIES -C AND CONCENTRATION DIFFERENCES -C - IF(VOLWHM(M,N3,N2,N1).GT.THETY(N3,N2,N1)*VOLAH(N3,N2,N1) - 2.AND.VOLWHM(M,N6,N5,N4).GT.THETY(N6,N5,N4)*VOLAH(N6,N5,N4))THEN -C -C MACROPORE CONCENTRATIONS IN CURRENT AND ADJACENT GRID CELLS -C - DO 9790 K=0,4 - COQCH1(K)=AMAX1(0.0,OQCH2(K,N3,N2,N1)/VOLWHM(M,N3,N2,N1)) - COQNH1(K)=AMAX1(0.0,OQNH2(K,N3,N2,N1)/VOLWHM(M,N3,N2,N1)) - COQPH1(K)=AMAX1(0.0,OQPH2(K,N3,N2,N1)/VOLWHM(M,N3,N2,N1)) - COQAH1(K)=AMAX1(0.0,OQAH2(K,N3,N2,N1)/VOLWHM(M,N3,N2,N1)) - COQCH2(K)=AMAX1(0.0,OQCH2(K,N6,N5,N4)/VOLWHM(M,N6,N5,N4)) - COQNH2(K)=AMAX1(0.0,OQNH2(K,N6,N5,N4)/VOLWHM(M,N6,N5,N4)) - COQPH2(K)=AMAX1(0.0,OQPH2(K,N6,N5,N4)/VOLWHM(M,N6,N5,N4)) - COQAH2(K)=AMAX1(0.0,OQAH2(K,N6,N5,N4)/VOLWHM(M,N6,N5,N4)) -9790 CONTINUE - CCO2SH1=AMAX1(0.0,CO2SH2(N3,N2,N1)/VOLWHM(M,N3,N2,N1)) - CCH4SH1=AMAX1(0.0,CH4SH2(N3,N2,N1)/VOLWHM(M,N3,N2,N1)) - COXYSH1=AMAX1(0.0,OXYSH2(N3,N2,N1)/VOLWHM(M,N3,N2,N1)) - CZ2GSH1=AMAX1(0.0,Z2GSH2(N3,N2,N1)/VOLWHM(M,N3,N2,N1)) - CZ2OSH1=AMAX1(0.0,Z2OSH2(N3,N2,N1)/VOLWHM(M,N3,N2,N1)) - CH2GSH1=AMAX1(0.0,H2GSH2(N3,N2,N1)/VOLWHM(M,N3,N2,N1)) - IF(VOLH4A.GT.ZEROS(N2,N1))THEN - CNH4SH1=AMAX1(0.0,ZNH4H2(N3,N2,N1)/VOLH4A) - CNH3SH1=AMAX1(0.0,ZNH3H2(N3,N2,N1)/VOLH4A) - ELSE - CNH4SH1=0.0 - CNH3SH1=0.0 - ENDIF - IF(VOLH3A.GT.ZEROS(N2,N1))THEN - CNO3SH1=AMAX1(0.0,ZNO3H2(N3,N2,N1)/VOLH3A) - CNO2SH1=AMAX1(0.0,ZNO2H2(N3,N2,N1)/VOLH3A) - ELSE - CNO3SH1=0.0 - CNO2SH1=0.0 - ENDIF - IF(VOLH2A.GT.ZEROS(N2,N1))THEN - CPO4SH1=AMAX1(0.0,H2P4H2(N3,N2,N1)/VOLH2A) - ELSE - CPO4SH1=0.0 - ENDIF - IF(VOLH4B.GT.ZEROS(N2,N1))THEN - CNH4BH1=AMAX1(0.0,ZN4BH2(N3,N2,N1)/VOLH4B) - CNH3BH1=AMAX1(0.0,ZN3BH2(N3,N2,N1)/VOLH4B) - ELSE - CNH4BH1=CNH4SH1 - CNH3BH1=CNH3SH1 - ENDIF - IF(VOLH3B.GT.ZEROS(N2,N1))THEN - CNO3BH1=AMAX1(0.0,ZNOBH2(N3,N2,N1)/VOLH3B) - CNO2BH1=AMAX1(0.0,ZN2BH2(N3,N2,N1)/VOLH3B) - ELSE - CNO3BH1=CNO3SH1 - CNO2BH1=CNO2SH1 - ENDIF - IF(VOLH2B.GT.ZEROS(N2,N1))THEN - CPO4BH1=AMAX1(0.0,H2PBH2(N3,N2,N1)/VOLH2B) - ELSE - CPO4BH1=CPO4SH1 - ENDIF - CCO2SH2=AMAX1(0.0,CO2SH2(N6,N5,N4)/VOLWHM(M,N6,N5,N4)) - CCH4SH2=AMAX1(0.0,CH4SH2(N6,N5,N4)/VOLWHM(M,N6,N5,N4)) - COXYSH2=AMAX1(0.0,OXYSH2(N6,N5,N4)/VOLWHM(M,N6,N5,N4)) - CZ2GSH2=AMAX1(0.0,Z2GSH2(N6,N5,N4)/VOLWHM(M,N6,N5,N4)) - CZ2OSH2=AMAX1(0.0,Z2OSH2(N6,N5,N4)/VOLWHM(M,N6,N5,N4)) - CH2GSH2=AMAX1(0.0,H2GSH2(N6,N5,N4)/VOLWHM(M,N6,N5,N4)) - VOLHMA=VOLWHM(M,N6,N5,N4)*VLNH4(N6,N5,N4) - IF(VOLHMA.GT.ZEROS(N5,N4))THEN - CNH4SH2=AMAX1(0.0,ZNH4H2(N6,N5,N4)/VOLHMA) - CNH3SH2=AMAX1(0.0,ZNH3H2(N6,N5,N4)/VOLHMA) - ELSE - CNH4SH2=0.0 - CNH3SH2=0.0 - ENDIF - VOLHOA=VOLWHM(M,N6,N5,N4)*VLNO3(N6,N5,N4) - IF(VOLHOA.GT.ZEROS(N5,N4))THEN - CNO3SH2=AMAX1(0.0,ZNO3H2(N6,N5,N4)/VOLHOA) - CNO2SH2=AMAX1(0.0,ZNO2H2(N6,N5,N4)/VOLHOA) - ELSE - CNO3SH2=0.0 - CNO2SH2=0.0 - ENDIF - VOLHPA=VOLWHM(M,N6,N5,N4)*VLPO4(N6,N5,N4) - IF(VOLHPA.GT.ZEROS(N5,N4))THEN - CPO4SH2=AMAX1(0.0,H2P4H2(N6,N5,N4)/VOLHPA) - ELSE - CPO4SH2=0.0 - ENDIF - VOLHMB=VOLWHM(M,N6,N5,N4)*VLNHB(N6,N5,N4) - IF(VOLHMB.GT.ZEROS(N5,N4))THEN - CNH4BH2=AMAX1(0.0,ZN4BH2(N6,N5,N4)/VOLHMB) - CNH3BH2=AMAX1(0.0,ZN3BH2(N6,N5,N4)/VOLHMB) - ELSE - CNH4BH2=CNH4SH2 - CNH3BH2=CNH3SH2 - ENDIF - VOLHOB=VOLWHM(M,N6,N5,N4)*VLNOB(N6,N5,N4) - IF(VOLHOB.GT.ZEROS(N5,N4))THEN - CNO3BH2=AMAX1(0.0,ZNOBH2(N6,N5,N4)/VOLHOB) - CNO2BH2=AMAX1(0.0,ZN2BH2(N6,N5,N4)/VOLHOB) - ELSE - CNO3BH2=CNO3SH2 - CNO2BH2=CNO2SH2 - ENDIF - VOLHPB=VOLWHM(M,N6,N5,N4)*VLPOB(N6,N5,N4) - IF(VOLHPB.GT.ZEROS(N5,N4))THEN - CPO4BH2=AMAX1(0.0,H2PBH2(N6,N5,N4)/VOLHPB) - ELSE - CPO4BH2=CPO4SH2 - ENDIF -C -C DIFFUSIVITIES IN CURRENT AND ADJACENT GRID CELL MACROPORES -C - TORTL=(TORTH(M,N3,N2,N1)*DLYR(N,N3,N2,N1) - 2+TORTH(M,N6,N5,N4)*DLYR(N,N6,N5,N4)) - 3/(DLYR(N,N3,N2,N1)+DLYR(N,N6,N5,N4)) - DISPN=DISP(N,N6,N5,N4)*ABS(FLWHM(M,N,N6,N5,N4)/AREA(N,N6,N5,N4)) - DIFOC=(OCSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) - DIFON=(ONSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) - DIFOP=(OPSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) - DIFOA=(OASGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) - DIFNH=(ZNSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) - DIFNO=(ZOSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) - DIFPO=(POSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) - DIFCS=(CLSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) - DIFCQ=(CQSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) - DIFOS=(OLSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) - DIFNG=(ZLSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) - DIFN2=(ZVSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) - DIFHG=(HLSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) -C -C DIFFUSIVE FLUXES BETWEEN CURRENT AND ADJACENT GRID CELL -C MACROPORES -C - DO 9785 K=0,4 - DFHOC(K)=DIFOC*(COQCH1(K)-COQCH2(K)) - DFHON(K)=DIFON*(COQNH1(K)-COQNH2(K)) - DFHOP(K)=DIFOP*(COQPH1(K)-COQPH2(K)) - DFHOA(K)=DIFOA*(COQAH1(K)-COQAH2(K)) -C WRITE(*,2121)'DFHOC',I,J,M,N4,N5,N6,K,DFHOC(K),OQCH2(K,N3,N2,N1) -C 2,OQCH2(K,N6,N5,N4),DIFOC,COQCH1(K),COQCH2(K) -2121 FORMAT(A8,7I4,20E12.4) -9785 CONTINUE - DFHCOS=DIFCS*(CCO2SH1-CCO2SH2) - DFHCHS=DIFCQ*(CCH4SH1-CCH4SH2) - DFHOXS=DIFOS*(COXYSH1-COXYSH2) - DFHNGS=DIFNG*(CZ2GSH1-CZ2GSH2) - DFHN2S=DIFN2*(CZ2OSH1-CZ2OSH2) - DFHHGS=DIFNH*(CH2GSH1-CH2GSH2) - DFHNH4=DIFNH*(CNH4SH1-CNH4SH2)*AMIN1(VLNH4(N3,N2,N1) - 2,VLNH4(N6,N5,N4)) - DFHNH3=DIFNH*(CNH3SH1-CNH3SH2)*AMIN1(VLNH4(N3,N2,N1) - 2,VLNH4(N6,N5,N4)) - DFHNO3=DIFNO*(CNO3SH1-CNO3SH2)*AMIN1(VLNO3(N3,N2,N1) - 2,VLNO3(N6,N5,N4)) - DFHNO2=DIFNO*(CNO2SH1-CNO2SH2)*AMIN1(VLNO3(N3,N2,N1) - 2,VLNO3(N6,N5,N4)) - DFHPO4=DIFPO*(CPO4SH1-CPO4SH2)*AMIN1(VLPO4(N3,N2,N1) - 2,VLPO4(N6,N5,N4)) - DFHN4B=DIFNH*(CNH4BH1-CNH4BH2)*AMIN1(VLNHB(N3,N2,N1) - 2,VLNHB(N6,N5,N4)) - DFHN3B=DIFNH*(CNH3BH1-CNH3BH2)*AMIN1(VLNHB(N3,N2,N1) - 2,VLNHB(N6,N5,N4)) - DFHNOB=DIFNO*(CNO3BH1-CNO3BH2)*AMIN1(VLNOB(N3,N2,N1) - 2,VLNOB(N6,N5,N4)) - DFHN2B=DIFNO*(CNO2BH1-CNO2BH2)*AMIN1(VLNOB(N3,N2,N1) - 2,VLNOB(N6,N5,N4)) - DFHPOB=DIFPO*(CPO4BH1-CPO4BH2)*AMIN1(VLPOB(N3,N2,N1) - 2,VLPOB(N6,N5,N4)) - ELSE - DO 9780 K=0,4 - DFHOC(K)=0.0 - DFHON(K)=0.0 - DFHOP(K)=0.0 - DFHOA(K)=0.0 -9780 CONTINUE - DFHCOS=0.0 - DFHCHS=0.0 - DFHOXS=0.0 - DFHNGS=0.0 - DFHN2S=0.0 - DFHHGS=0.0 - DFHNH4=0.0 - DFHNH3=0.0 - DFHNO3=0.0 - DFHNO2=0.0 - DFHPO4=0.0 - DFHN4B=0.0 - DFHN3B=0.0 - DFHNOB=0.0 - DFHN2B=0.0 - DFHPOB=0.0 - ENDIF -C -C TOTAL MICROPORE AND MACROPORE SOLUTE TRANSPORT FLUXES BETWEEN -C ADJACENT GRID CELLS = CONVECTIVE + DIFFUSIVE FLUXES -C - DO 9765 K=0,4 - ROCFLS(K,N,N6,N5,N4)=RFLOC(K)+DFVOC(K) - RONFLS(K,N,N6,N5,N4)=RFLON(K)+DFVON(K) - ROPFLS(K,N,N6,N5,N4)=RFLOP(K)+DFVOP(K) - ROAFLS(K,N,N6,N5,N4)=RFLOA(K)+DFVOA(K) - ROCFHS(K,N,N6,N5,N4)=RFHOC(K)+DFHOC(K) - RONFHS(K,N,N6,N5,N4)=RFHON(K)+DFHON(K) - ROPFHS(K,N,N6,N5,N4)=RFHOP(K)+DFHOP(K) - ROAFHS(K,N,N6,N5,N4)=RFHOA(K)+DFHOA(K) -9765 CONTINUE - RCOFLS(N,N6,N5,N4)=RFLCOS+DFVCOS - RCHFLS(N,N6,N5,N4)=RFLCHS+DFVCHS - ROXFLS(N,N6,N5,N4)=RFLOXS+DFVOXS - RNGFLS(N,N6,N5,N4)=RFLNGS+DFVNGS - RN2FLS(N,N6,N5,N4)=RFLN2S+DFVN2S - RHGFLS(N,N6,N5,N4)=RFLHGS+DFVHGS - RN4FLW(N,N6,N5,N4)=RFLNH4+DFVNH4 - RN3FLW(N,N6,N5,N4)=RFLNH3+DFVNH3 - RNOFLW(N,N6,N5,N4)=RFLNO3+DFVNO3 - RNXFLS(N,N6,N5,N4)=RFLNO2+DFVNO2 - RH2PFS(N,N6,N5,N4)=RFLPO4+DFVPO4 - RN4FLB(N,N6,N5,N4)=RFLN4B+DFVN4B - RN3FLB(N,N6,N5,N4)=RFLN3B+DFVN3B - RNOFLB(N,N6,N5,N4)=RFLNOB+DFVNOB - RNXFLB(N,N6,N5,N4)=RFLN2B+DFVN2B - RH2BFB(N,N6,N5,N4)=RFLPOB+DFVPOB - RCOFHS(N,N6,N5,N4)=RFHCOS+DFHCOS - RCHFHS(N,N6,N5,N4)=RFHCHS+DFHCHS - ROXFHS(N,N6,N5,N4)=RFHOXS+DFHOXS - RNGFHS(N,N6,N5,N4)=RFHNGS+DFHNGS - RN2FHS(N,N6,N5,N4)=RFHN2S+DFHN2S - RHGFHS(N,N6,N5,N4)=RFHHGS+DFHHGS - RN4FHW(N,N6,N5,N4)=RFHNH4+DFHNH4 - RN3FHW(N,N6,N5,N4)=RFHNH3+DFHNH3 - RNOFHW(N,N6,N5,N4)=RFHNO3+DFHNO3 - RNXFHS(N,N6,N5,N4)=RFHNO2+DFHNO2 - RH2PHS(N,N6,N5,N4)=RFHPO4+DFHPO4 - RN4FHB(N,N6,N5,N4)=RFHN4B+DFHN4B - RN3FHB(N,N6,N5,N4)=RFHN3B+DFHN3B - RNOFHB(N,N6,N5,N4)=RFHNOB+DFHNOB - RNXFHB(N,N6,N5,N4)=RFHN2B+DFHN2B - RH2BHB(N,N6,N5,N4)=RFHPOB+DFHPOB -C IF(M.NE.MX.AND.I.GE.180.AND.I.LE.200)THEN -C WRITE(*,443)'DFVCO2',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)'RH2PFS',I,J,N4,N5,N6,M,MM,N -C 2,RH2PFS(N,N6,N5,N4),RFLPO4,DFVPO4,DIFPO,CPO4S1,CPO4S2 -C 3,VLPO4(N3,N2,N1),VLPO4(N6,N5,N4),VOLW2A,VOLWPA -C 4,H2PO42(N3,N2,N1),H2PO42(N6,N5,N4) -443 FORMAT(A8,8I4,20E12.4) -C ENDIF -C -C ACCUMULATE HOURLY FLUXES -C - DO 9755 K=0,4 - XOCFLS(K,N,N6,N5,N4)=XOCFLS(K,N,N6,N5,N4)+ROCFLS(K,N,N6,N5,N4) - XONFLS(K,N,N6,N5,N4)=XONFLS(K,N,N6,N5,N4)+RONFLS(K,N,N6,N5,N4) - XOPFLS(K,N,N6,N5,N4)=XOPFLS(K,N,N6,N5,N4)+ROPFLS(K,N,N6,N5,N4) - XOAFLS(K,N,N6,N5,N4)=XOAFLS(K,N,N6,N5,N4)+ROAFLS(K,N,N6,N5,N4) - XOCFHS(K,N,N6,N5,N4)=XOCFHS(K,N,N6,N5,N4)+ROCFHS(K,N,N6,N5,N4) - XONFHS(K,N,N6,N5,N4)=XONFHS(K,N,N6,N5,N4)+RONFHS(K,N,N6,N5,N4) - XOPFHS(K,N,N6,N5,N4)=XOPFHS(K,N,N6,N5,N4)+ROPFHS(K,N,N6,N5,N4) - XOAFHS(K,N,N6,N5,N4)=XOAFHS(K,N,N6,N5,N4)+ROAFHS(K,N,N6,N5,N4) -9755 CONTINUE - XCOFLS(N,N6,N5,N4)=XCOFLS(N,N6,N5,N4)+RCOFLS(N,N6,N5,N4) - XCHFLS(N,N6,N5,N4)=XCHFLS(N,N6,N5,N4)+RCHFLS(N,N6,N5,N4) - XOXFLS(N,N6,N5,N4)=XOXFLS(N,N6,N5,N4)+ROXFLS(N,N6,N5,N4) - XNGFLS(N,N6,N5,N4)=XNGFLS(N,N6,N5,N4)+RNGFLS(N,N6,N5,N4) - XN2FLS(N,N6,N5,N4)=XN2FLS(N,N6,N5,N4)+RN2FLS(N,N6,N5,N4) - XHGFLS(N,N6,N5,N4)=XHGFLS(N,N6,N5,N4)+RHGFLS(N,N6,N5,N4) - XN4FLW(N,N6,N5,N4)=XN4FLW(N,N6,N5,N4)+RN4FLW(N,N6,N5,N4) - XN3FLW(N,N6,N5,N4)=XN3FLW(N,N6,N5,N4)+RN3FLW(N,N6,N5,N4) - XNOFLW(N,N6,N5,N4)=XNOFLW(N,N6,N5,N4)+RNOFLW(N,N6,N5,N4) - XNXFLS(N,N6,N5,N4)=XNXFLS(N,N6,N5,N4)+RNXFLS(N,N6,N5,N4) - XH2PFS(N,N6,N5,N4)=XH2PFS(N,N6,N5,N4)+RH2PFS(N,N6,N5,N4) - XN4FLB(N,N6,N5,N4)=XN4FLB(N,N6,N5,N4)+RN4FLB(N,N6,N5,N4) - XN3FLB(N,N6,N5,N4)=XN3FLB(N,N6,N5,N4)+RN3FLB(N,N6,N5,N4) - XNOFLB(N,N6,N5,N4)=XNOFLB(N,N6,N5,N4)+RNOFLB(N,N6,N5,N4) - XNXFLB(N,N6,N5,N4)=XNXFLB(N,N6,N5,N4)+RNXFLB(N,N6,N5,N4) - XH2BFB(N,N6,N5,N4)=XH2BFB(N,N6,N5,N4)+RH2BFB(N,N6,N5,N4) - XCOFHS(N,N6,N5,N4)=XCOFHS(N,N6,N5,N4)+RCOFHS(N,N6,N5,N4) - XCHFHS(N,N6,N5,N4)=XCHFHS(N,N6,N5,N4)+RCHFHS(N,N6,N5,N4) - XOXFHS(N,N6,N5,N4)=XOXFHS(N,N6,N5,N4)+ROXFHS(N,N6,N5,N4) - XNGFHS(N,N6,N5,N4)=XNGFHS(N,N6,N5,N4)+RNGFHS(N,N6,N5,N4) - XN2FHS(N,N6,N5,N4)=XN2FHS(N,N6,N5,N4)+RN2FHS(N,N6,N5,N4) - XHGFHS(N,N6,N5,N4)=XHGFHS(N,N6,N5,N4)+RHGFHS(N,N6,N5,N4) - XN4FHW(N,N6,N5,N4)=XN4FHW(N,N6,N5,N4)+RN4FHW(N,N6,N5,N4) - XN3FHW(N,N6,N5,N4)=XN3FHW(N,N6,N5,N4)+RN3FHW(N,N6,N5,N4) - XNOFHW(N,N6,N5,N4)=XNOFHW(N,N6,N5,N4)+RNOFHW(N,N6,N5,N4) - XNXFHS(N,N6,N5,N4)=XNXFHS(N,N6,N5,N4)+RNXFHS(N,N6,N5,N4) - XH2PHS(N,N6,N5,N4)=XH2PHS(N,N6,N5,N4)+RH2PHS(N,N6,N5,N4) - XN4FHB(N,N6,N5,N4)=XN4FHB(N,N6,N5,N4)+RN4FHB(N,N6,N5,N4) - XN3FHB(N,N6,N5,N4)=XN3FHB(N,N6,N5,N4)+RN3FHB(N,N6,N5,N4) - XNOFHB(N,N6,N5,N4)=XNOFHB(N,N6,N5,N4)+RNOFHB(N,N6,N5,N4) - XNXFHB(N,N6,N5,N4)=XNXFHB(N,N6,N5,N4)+RNXFHB(N,N6,N5,N4) - XH2BHB(N,N6,N5,N4)=XH2BHB(N,N6,N5,N4)+RH2BHB(N,N6,N5,N4) -C -C MACROPORE-MICROPORE SOLUTE EXCHANGE WITHIN SOIL -C LAYER FROM WATER EXCHANGE IN 'WATSUB' AND -C FROM MACROPORE OR MICROPORE SOLUTE CONCENTRATIONS -C - IF(N.EQ.3)THEN -C -C MACROPORE TO MICROPORE TRANSFER -C - IF(FINHM(M,N6,N5,N4).GT.0.0)THEN - IF(VOLWHM(M,N6,N5,N4).GT.ZEROS(N5,N4))THEN - VFLW=AMAX1(0.0,AMIN1(XFRX,FINHM(M,N6,N5,N4) - 2/VOLWHM(M,N6,N5,N4))) - ELSE - VFLW=XFRX - ENDIF - DO 9970 K=0,4 - RFLOC(K)=VFLW*AMAX1(0.0,OQCH2(K,N6,N5,N4)) - RFLON(K)=VFLW*AMAX1(0.0,OQNH2(K,N6,N5,N4)) - RFLOP(K)=VFLW*AMAX1(0.0,OQPH2(K,N6,N5,N4)) - RFLOA(K)=VFLW*AMAX1(0.0,OQAH2(K,N6,N5,N4)) -9970 CONTINUE - RFLCOS=VFLW*AMAX1(0.0,CO2SH2(N6,N5,N4)) - RFLCHS=VFLW*AMAX1(0.0,CH4SH2(N6,N5,N4)) - RFLOXS=VFLW*AMAX1(0.0,OXYSH2(N6,N5,N4)) - RFLNGS=VFLW*AMAX1(0.0,Z2GSH2(N6,N5,N4)) - RFLN2S=VFLW*AMAX1(0.0,Z2OSH2(N6,N5,N4)) - RFLHGS=VFLW*AMAX1(0.0,H2GSH2(N6,N5,N4)) - RFLNH4=VFLW*AMAX1(0.0,ZNH4H2(N6,N5,N4))*VLNH4(N6,N5,N4) - RFLNH3=VFLW*AMAX1(0.0,ZNH3H2(N6,N5,N4))*VLNH4(N6,N5,N4) - RFLNO3=VFLW*AMAX1(0.0,ZNO3H2(N6,N5,N4))*VLNO3(N6,N5,N4) - RFLNO2=VFLW*AMAX1(0.0,ZNO2H2(N6,N5,N4))*VLNO3(N6,N5,N4) - RFLPO4=VFLW*AMAX1(0.0,H2P4H2(N6,N5,N4))*VLPO4(N6,N5,N4) - RFLN4B=VFLW*AMAX1(0.0,ZN4BH2(N6,N5,N4))*VLNHB(N6,N5,N4) - RFLN3B=VFLW*AMAX1(0.0,ZN3BH2(N6,N5,N4))*VLNHB(N6,N5,N4) - RFLNOB=VFLW*AMAX1(0.0,ZNOBH2(N6,N5,N4))*VLNOB(N6,N5,N4) - RFLN2B=VFLW*AMAX1(0.0,ZN2BH2(N6,N5,N4))*VLNOB(N6,N5,N4) - RFLPOB=VFLW*AMAX1(0.0,H2PBH2(N6,N5,N4))*VLPOB(N6,N5,N4) -C -C MICROPORE TO MACROPORE TRANSFER -C - ELSEIF(FINHM(M,N6,N5,N4).LT.0.0)THEN - IF(VOLWM(M,N6,N5,N4).GT.ZEROS(N5,N4))THEN - VFLW=AMIN1(0.0,AMAX1(-XFRX,FINHM(M,N6,N5,N4) - 2/VOLWM(M,N6,N5,N4))) - ELSE - VFLW=-XFRX - ENDIF - DO 9965 K=0,4 - RFLOC(K)=VFLW*AMAX1(0.0,OQC2(K,N6,N5,N4)) - RFLON(K)=VFLW*AMAX1(0.0,OQN2(K,N6,N5,N4)) - RFLOP(K)=VFLW*AMAX1(0.0,OQP2(K,N6,N5,N4)) - RFLOA(K)=VFLW*AMAX1(0.0,OQA2(K,N6,N5,N4)) -9965 CONTINUE - RFLCOS=VFLW*AMAX1(0.0,CO2S2(N6,N5,N4)) - RFLCHS=VFLW*AMAX1(0.0,CH4S2(N6,N5,N4)) - RFLOXS=VFLW*AMAX1(0.0,OXYS2(N6,N5,N4)) - RFLNGS=VFLW*AMAX1(0.0,Z2GS2(N6,N5,N4)) - RFLN2S=VFLW*AMAX1(0.0,Z2OS2(N6,N5,N4)) - RFLHGS=VFLW*AMAX1(0.0,H2GS2(N6,N5,N4)) - RFLNH4=VFLW*AMAX1(0.0,ZNH4S2(N6,N5,N4))*VLNH4(N6,N5,N4) - RFLNH3=VFLW*AMAX1(0.0,ZN3S2(N6,N5,N4))*VLNH4(N6,N5,N4) - RFLNO3=VFLW*AMAX1(0.0,ZNO3S2(N6,N5,N4))*VLNO3(N6,N5,N4) - RFLNO2=VFLW*AMAX1(0.0,ZNO2S2(N6,N5,N4))*VLNO3(N6,N5,N4) - RFLPO4=VFLW*AMAX1(0.0,H2PO42(N6,N5,N4))*VLPO4(N6,N5,N4) - RFLN4B=VFLW*AMAX1(0.0,ZNH4B2(N6,N5,N4))*VLNHB(N6,N5,N4) - RFLN3B=VFLW*AMAX1(0.0,ZNBS2(N6,N5,N4))*VLNHB(N6,N5,N4) - RFLNOB=VFLW*AMAX1(0.0,ZNO3B2(N6,N5,N4))*VLNOB(N6,N5,N4) - RFLN2B=VFLW*AMAX1(0.0,ZNO2B2(N6,N5,N4))*VLNOB(N6,N5,N4) - RFLPOB=VFLW*AMAX1(0.0,H2POB2(N6,N5,N4))*VLPOB(N6,N5,N4) -C -C NO MACROPORE TO MICROPORE TRANSFER -C - ELSE - DO 9960 K=0,4 - RFLOC(K)=0.0 - RFLON(K)=0.0 - RFLOP(K)=0.0 - RFLOA(K)=0.0 -9960 CONTINUE - RFLCOS=0.0 - RFLCHS=0.0 - RFLOXS=0.0 - RFLNGS=0.0 - RFLN2S=0.0 - RFLHGS=0.0 - RFLNH4=0.0 - RFLNH3=0.0 - RFLNO3=0.0 - RFLNO2=0.0 - RFLPO4=0.0 - RFLN4B=0.0 - RFLN3B=0.0 - RFLNOB=0.0 - RFLN2B=0.0 - RFLPOB=0.0 - ENDIF -C -C DIFFUSIVE FLUXES OF SOLUTES BETWEEN MICROPORES AND -C MACROPORES FROM AQUEOUS DIFFUSIVITIES AND CONCENTRATION 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*(OQCH2(K,N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-OQC2(K,N6,N5,N4)*VOLWHS)/VOLWT - DFVON(K)=XNPX*(OQNH2(K,N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-OQN2(K,N6,N5,N4)*VOLWHS)/VOLWT - DFVOP(K)=XNPX*(OQPH2(K,N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-OQP2(K,N6,N5,N4)*VOLWHS)/VOLWT - DFVOA(K)=XNPX*(OQAH2(K,N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-OQA2(K,N6,N5,N4)*VOLWHS)/VOLWT -9955 CONTINUE - DFVCOS=XNPX*(CO2SH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-CO2S2(N6,N5,N4)*VOLWHS)/VOLWT - DFVCHS=XNPX*(CH4SH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-CH4S2(N6,N5,N4)*VOLWHS)/VOLWT - DFVOXS=XNPX*(OXYSH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-OXYS2(N6,N5,N4)*VOLWHS)/VOLWT - DFVNGS=XNPX*(Z2GSH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-Z2GS2(N6,N5,N4)*VOLWHS)/VOLWT - DFVN2S=XNPX*(Z2OSH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-Z2OS2(N6,N5,N4)*VOLWHS)/VOLWT - DFVHGS=XNPX*(H2GSH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-H2GS2(N6,N5,N4)*VOLWHS)/VOLWT - DFVNH4=XNPX*(ZNH4H2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZNH4S2(N6,N5,N4)*VOLWHS)/VOLWT - 3*VLNH4(N6,N5,N4) - DFVNH3=XNPX*(ZNH3H2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZN3S2(N6,N5,N4)*VOLWHS)/VOLWT - 3*VLNH4(N6,N5,N4) - DFVNO3=XNPX*(ZNO3H2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZNO3S2(N6,N5,N4)*VOLWHS)/VOLWT - 3*VLNO3(N6,N5,N4) - DFVNO2=XNPX*(ZNO2H2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZNO2S2(N6,N5,N4)*VOLWHS)/VOLWT - 3*VLNO3(N6,N5,N4) - DFVPO4=XNPX*(H2P4H2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-H2PO42(N6,N5,N4)*VOLWHS)/VOLWT - 3*VLPO4(N6,N5,N4) - DFVN4B=XNPX*(ZN4BH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZNH4B2(N6,N5,N4)*VOLWHS)/VOLWT - 3*VLNHB(N6,N5,N4) - DFVN3B=XNPX*(ZN3BH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZNBS2(N6,N5,N4)*VOLWHS)/VOLWT - 3*VLNHB(N6,N5,N4) - DFVNOB=XNPX*(ZNOBH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZNO3B2(N6,N5,N4)*VOLWHS)/VOLWT - 3*VLNOB(N6,N5,N4) - DFVN2B=XNPX*(ZN2BH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZNO2B2(N6,N5,N4)*VOLWHS)/VOLWT - 3*VLNOB(N6,N5,N4) - DFVPOB=XNPX*(H2PBH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-H2POB2(N6,N5,N4)*VOLWHS)/VOLWT - 3*VLPOB(N6,N5,N4) - ELSE - DO 9975 K=0,2 - DFVOC(K)=0.0 - DFVON(K)=0.0 - DFVOP(K)=0.0 - DFVOA(K)=0.0 -9975 CONTINUE - DFVCOS=0.0 - DFVCHS=0.0 - DFVOXS=0.0 - DFVNGS=0.0 - DFVN2S=0.0 - DFVHGS=0.0 - DFVNH4=0.0 - DFVNH3=0.0 - DFVNO3=0.0 - DFVNO2=0.0 - DFVPO4=0.0 - DFVN4B=0.0 - DFVN3B=0.0 - DFVNOB=0.0 - DFVN2B=0.0 - DFVPOB=0.0 - ENDIF -C -C TOTAL CONVECTIVE +DIFFUSIVE TRANSFER BETWEEN MACROPOES AND MICROPORES -C - DO 9950 K=0,4 - ROCFXS(K,N6,N5,N4)=RFLOC(K)+DFVOC(K) - 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 - ROXFXS(N6,N5,N4)=RFLOXS+DFVOXS - RNGFXS(N6,N5,N4)=RFLNGS+DFVNGS - RN2FXS(N6,N5,N4)=RFLN2S+DFVN2S - RHGFXS(N6,N5,N4)=RFLHGS+DFVHGS - RN4FXW(N6,N5,N4)=RFLNH4+DFVNH4 - RN3FXW(N6,N5,N4)=RFLNH3+DFVNH3 - RNOFXW(N6,N5,N4)=RFLNO3+DFVNO3 - RNXFXS(N6,N5,N4)=RFLNO2+DFVNO2 - RH2PXS(N6,N5,N4)=RFLPO4+DFVPO4 - RN4FXB(N6,N5,N4)=RFLN4B+DFVN4B - RN3FXB(N6,N5,N4)=RFLN3B+DFVN3B - RNOFXB(N6,N5,N4)=RFLNOB+DFVNOB - RNXFXB(N6,N5,N4)=RFLN2B+DFVN2B - RH2BXB(N6,N5,N4)=RFLPOB+DFVPOB -C -C ACCUMULATE HOURLY FLUXES -C - DO 9945 K=0,4 - XOCFXS(K,N6,N5,N4)=XOCFXS(K,N6,N5,N4)+ROCFXS(K,N6,N5,N4) - XONFXS(K,N6,N5,N4)=XONFXS(K,N6,N5,N4)+RONFXS(K,N6,N5,N4) - XOPFXS(K,N6,N5,N4)=XOPFXS(K,N6,N5,N4)+ROPFXS(K,N6,N5,N4) - XOAFXS(K,N6,N5,N4)=XOAFXS(K,N6,N5,N4)+ROAFXS(K,N6,N5,N4) -9945 CONTINUE - XCOFXS(N6,N5,N4)=XCOFXS(N6,N5,N4)+RCOFXS(N6,N5,N4) - XCHFXS(N6,N5,N4)=XCHFXS(N6,N5,N4)+RCHFXS(N6,N5,N4) - XOXFXS(N6,N5,N4)=XOXFXS(N6,N5,N4)+ROXFXS(N6,N5,N4) - XNGFXS(N6,N5,N4)=XNGFXS(N6,N5,N4)+RNGFXS(N6,N5,N4) - XN2FXS(N6,N5,N4)=XN2FXS(N6,N5,N4)+RN2FXS(N6,N5,N4) - XHGFXS(N6,N5,N4)=XHGFXS(N6,N5,N4)+RHGFXS(N6,N5,N4) - XN4FXW(N6,N5,N4)=XN4FXW(N6,N5,N4)+RN4FXW(N6,N5,N4) - XN3FXW(N6,N5,N4)=XN3FXW(N6,N5,N4)+RN3FXW(N6,N5,N4) - XNOFXW(N6,N5,N4)=XNOFXW(N6,N5,N4)+RNOFXW(N6,N5,N4) - XNXFXS(N6,N5,N4)=XNXFXS(N6,N5,N4)+RNXFXS(N6,N5,N4) - XH2PXS(N6,N5,N4)=XH2PXS(N6,N5,N4)+RH2PXS(N6,N5,N4) - XN4FXB(N6,N5,N4)=XN4FXB(N6,N5,N4)+RN4FXB(N6,N5,N4) - XN3FXB(N6,N5,N4)=XN3FXB(N6,N5,N4)+RN3FXB(N6,N5,N4) - XNOFXB(N6,N5,N4)=XNOFXB(N6,N5,N4)+RNOFXB(N6,N5,N4) - XNXFXB(N6,N5,N4)=XNXFXB(N6,N5,N4)+RNXFXB(N6,N5,N4) - XH2BXB(N6,N5,N4)=XH2BXB(N6,N5,N4)+RH2BXB(N6,N5,N4) - ENDIF - ENDIF -C -C GASEOUS TRANSPORT FROM GASEOUS DIFFUSIVITY AND CONCENTRATION -C DIFFERENCES BETWEEN ADJACENT GRID CELLS -C -C -C GASEOUS DIFFUSIVITIES -C - IF(THETPM(M,N3,N2,N1).GT.THETX - 2.AND.THETPM(M,N6,N5,N4).GT.THETX - 3.AND.VOLPM(M,N3,N2,N1).GT.ZEROS(N2,N1) - 4.AND.VOLPM(M,N6,N5,N4).GT.ZEROS(N5,N4))THEN - DFLG2=2.0*AMAX1(0.0,THETPM(M,N3,N2,N1))**2/POROQ(N3,N2,N1) - 2*AREA(N,N3,N2,N1)/DLYR(N,N3,N2,N1) - DFLGL=2.0*AMAX1(0.0,THETPM(M,N6,N5,N4))**2/POROQ(N6,N5,N4) - 2*AREA(N,N6,N5,N4)/DLYR(N,N6,N5,N4) - CNDC1=DFLG2*CGSGL2(N3,N2,N1) - CND41=DFLG2*CHSGL2(N3,N2,N1) - CNDO1=DFLG2*OGSGL2(N3,N2,N1) - CNDG1=DFLG2*ZGSGL2(N3,N2,N1) - CND21=DFLG2*Z2SGL2(N3,N2,N1) - CNDH1=DFLG2*ZHSGL2(N3,N2,N1) - CNHG1=DFLG2*HGSGL2(N3,N2,N1) - CNDC2=DFLGL*CGSGL2(N6,N5,N4) - CND42=DFLGL*CHSGL2(N6,N5,N4) - CNDO2=DFLGL*OGSGL2(N6,N5,N4) - CNDG2=DFLGL*ZGSGL2(N6,N5,N4) - CND22=DFLGL*Z2SGL2(N6,N5,N4) - CNDH2=DFLGL*ZHSGL2(N6,N5,N4) - CNHG2=DFLGL*HGSGL2(N6,N5,N4) -C -C GASOUS CONDUCTANCES -C - DCO2G(N,N6,N5,N4)=(CNDC1*CNDC2)/(CNDC1+CNDC2) - DCH4G(N,N6,N5,N4)=(CND41*CND42)/(CND41+CND42) - DOXYG(N,N6,N5,N4)=(CNDO1*CNDO2)/(CNDO1+CNDO2) - DZ2GG(N,N6,N5,N4)=(CNDG1*CNDG2)/(CNDG1+CNDG2) - DZ2OG(N,N6,N5,N4)=(CND21*CND22)/(CND21+CND22) - DNH3G(N,N6,N5,N4)=(CNDH1*CNDH2)/(CNDH1+CNDH2) - DH2GG(N,N6,N5,N4)=(CNHG1*CNHG2)/(CNHG1+CNHG2) -C -C GASEOUS CONCENTRATIONS FROM AIR-FILLED POROSITY -C IN CURRENT AND ADJACENT GRID CELLS -C - CCO2G1=AMAX1(0.0,CO2G2(N3,N2,N1)/VOLPM(M,N3,N2,N1)) - CCH4G1=AMAX1(0.0,CH4G2(N3,N2,N1)/VOLPM(M,N3,N2,N1)) - COXYG1=AMAX1(0.0,OXYG2(N3,N2,N1)/VOLPM(M,N3,N2,N1)) - CZ2GG1=AMAX1(0.0,Z2GG2(N3,N2,N1)/VOLPM(M,N3,N2,N1)) - CZ2OG1=AMAX1(0.0,Z2OG2(N3,N2,N1)/VOLPM(M,N3,N2,N1)) - CNH3G1=AMAX1(0.0,ZN3G2(N3,N2,N1)/VOLPM(M,N3,N2,N1)) - CH2GG1=AMAX1(0.0,H2GG2(N3,N2,N1)/VOLPM(M,N3,N2,N1)) - CCO2G2=AMAX1(0.0,CO2G2(N6,N5,N4)/VOLPM(M,N6,N5,N4)) - CCH4G2=AMAX1(0.0,CH4G2(N6,N5,N4)/VOLPM(M,N6,N5,N4)) - COXYG2=AMAX1(0.0,OXYG2(N6,N5,N4)/VOLPM(M,N6,N5,N4)) - CZ2GG2=AMAX1(0.0,Z2GG2(N6,N5,N4)/VOLPM(M,N6,N5,N4)) - CZ2OG2=AMAX1(0.0,Z2OG2(N6,N5,N4)/VOLPM(M,N6,N5,N4)) - CNH3G2=AMAX1(0.0,ZN3G2(N6,N5,N4)/VOLPM(M,N6,N5,N4)) - CH2GG2=AMAX1(0.0,H2GG2(N6,N5,N4)/VOLPM(M,N6,N5,N4)) -C -C CONVECTIVE GAS TRANSFER DRIVEN BY SOIL WATER FLUXES -C FROM 'WATSUB' AND GAS CONCENTRATIONS IN THE ADJACENT GRID CELLS -C DEPENDING ON WATER FLUX DIRECTION -C - DFVCOG=DCO2G(N,N6,N5,N4)*(CCO2G1-CCO2G2) - DFVCHG=DCH4G(N,N6,N5,N4)*(CCH4G1-CCH4G2) - DFVOXG=DOXYG(N,N6,N5,N4)*(COXYG1-COXYG2) - DFVNGG=DZ2GG(N,N6,N5,N4)*(CZ2GG1-CZ2GG2) - DFVN2G=DZ2OG(N,N6,N5,N4)*(CZ2OG1-CZ2OG2) - DFVN3G=DNH3G(N,N6,N5,N4)*(CNH3G1-CNH3G2) - DFVHGG=DH2GG(N,N6,N5,N4)*(CH2GG1-CH2GG2) - IF(FLQM(N,N6,N5,N4).GT.0.0)THEN - IF(VOLPM(M,N6,N5,N4).GT.ZEROS(N5,N4))THEN - VFLW=-AMAX1(0.0,AMIN1(XFRX,FLQM(N,N6,N5,N4) - 2/VOLPM(M,N6,N5,N4))) - ELSE - VFLW=-XFRX - ENDIF - RFLCOG=VFLW*AMAX1(0.0,CO2G2(N6,N5,N4)) - RFLCHG=VFLW*AMAX1(0.0,CH4G2(N6,N5,N4)) - RFLOXG=VFLW*AMAX1(0.0,OXYG2(N6,N5,N4)) - RFLNGG=VFLW*AMAX1(0.0,Z2GG2(N6,N5,N4)) - RFLN2G=VFLW*AMAX1(0.0,Z2OG2(N6,N5,N4)) - RFLN3G=VFLW*AMAX1(0.0,ZN3G2(N6,N5,N4)) - RFLH2G=VFLW*AMAX1(0.0,H2GG2(N6,N5,N4)) - ELSE - IF(VOLPM(M,N3,N2,N1).GT.ZEROS(N2,N1))THEN - VFLW=-AMIN1(0.0,AMAX1(-XFRX,FLQM(N,N6,N5,N4) - 2/VOLPM(M,N3,N2,N1))) - ELSE - VFLW=XFRX - ENDIF - RFLCOG=VFLW*AMAX1(0.0,CO2G2(N3,N2,N1)) - RFLCHG=VFLW*AMAX1(0.0,CH4G2(N3,N2,N1)) - RFLOXG=VFLW*AMAX1(0.0,OXYG2(N3,N2,N1)) - RFLNGG=VFLW*AMAX1(0.0,Z2GG2(N3,N2,N1)) - RFLN2G=VFLW*AMAX1(0.0,Z2OG2(N3,N2,N1)) - RFLN3G=VFLW*AMAX1(0.0,ZN3G2(N3,N2,N1)) - RFLH2G=VFLW*AMAX1(0.0,H2GG2(N3,N2,N1)) - ENDIF -C -C SOIL GAS FLUX FROM DIFFERENCES -C BETWEEN CURRENT AND EQUILIBRIUM -C CONCENTRATIONS + CONVECTIVE FLUX -C - RCOFLG(N,N6,N5,N4)=DFVCOG+RFLCOG - RCHFLG(N,N6,N5,N4)=DFVCHG+RFLCHG - ROXFLG(N,N6,N5,N4)=DFVOXG+RFLOXG - RNGFLG(N,N6,N5,N4)=DFVNGG+RFLNGG - RN2FLG(N,N6,N5,N4)=DFVN2G+RFLN2G - RN3FLG(N,N6,N5,N4)=DFVN3G+RFLN3G - RHGFLG(N,N6,N5,N4)=DFVHGG+RFLH2G -C IF(I.EQ.43)THEN -C WRITE(*,3133)'ROXFL2',I,J,M,MM,N1,N2,N3,N,XOXFLG(N,N6,N5,N4) -C 2,ROXFLG(N,N6,N5,N4),DFVOXG,RFLOXG,COXYG1,COXYG2 -C 3,OXYG2(N3,N2,N1),OXYG2(N6,N5,N4) -C 4,FLQM(N,N6,N5,N4),VFLW,DOXYG(N,N6,N5,N4) -C 5,THETPM(M,N3,N2,N1),THETPM(M,N6,N5,N4) -C 5,VOLPM(M,N3,N2,N1),VOLPM(M,N6,N5,N4) -C WRITE(*,3133)'RNGFLG',I,J,M,MM,N4,N4,N6,N,RNGFLG(N,N6,N5,N4) -C 2,DFVNGG,RFLNGG,DZ2GG(N,N6,N5,N4),CZ2GG1,CZ2GG2 -3133 FORMAT(A8,8I4,20E12.4) -C ENDIF -C -C ACCUMULATE HOURLY FLUXES -C - XCOFLG(N,N6,N5,N4)=XCOFLG(N,N6,N5,N4)+RCOFLG(N,N6,N5,N4) - XCHFLG(N,N6,N5,N4)=XCHFLG(N,N6,N5,N4)+RCHFLG(N,N6,N5,N4) - XOXFLG(N,N6,N5,N4)=XOXFLG(N,N6,N5,N4)+ROXFLG(N,N6,N5,N4) - XNGFLG(N,N6,N5,N4)=XNGFLG(N,N6,N5,N4)+RNGFLG(N,N6,N5,N4) - XN2FLG(N,N6,N5,N4)=XN2FLG(N,N6,N5,N4)+RN2FLG(N,N6,N5,N4) - XN3FLG(N,N6,N5,N4)=XN3FLG(N,N6,N5,N4)+RN3FLG(N,N6,N5,N4) - XHGFLG(N,N6,N5,N4)=XHGFLG(N,N6,N5,N4)+RHGFLG(N,N6,N5,N4) - ELSE - RCOFLG(N,N6,N5,N4)=0.0 - RCHFLG(N,N6,N5,N4)=0.0 - ROXFLG(N,N6,N5,N4)=0.0 - RNGFLG(N,N6,N5,N4)=0.0 - RN2FLG(N,N6,N5,N4)=0.0 - RN3FLG(N,N6,N5,N4)=0.0 - RHGFLG(N,N6,N5,N4)=0.0 - ENDIF -C -C VOLATILIZATION-DISSOLUTION OF GASES IN SOIL -C LAYER FROM GASEOUS CONCENTRATIONS VS. THEIR AQUEOUS -C EQUIVALENTS DEPENDING ON SOLUBILITY FROM 'HOUR1' -C AND TRANSFER COEFFICIENT 'DFGS' FROM 'WATSUB' -C - IF(N.EQ.3)THEN - IF(THETPM(M,N6,N5,N4).GT.THETX)THEN - RCODFG(N6,N5,N4)=DFGS(M,N6,N5,N4)*(AMAX1(ZEROS(N5,N4) - 2,CO2G2(N6,N5,N4))*VOLWCO(N6,N5,N4) - 3-CO2S2(N6,N5,N4)*VOLPM(M,N6,N5,N4)) - 4/(VOLWCO(N6,N5,N4)+VOLPM(M,N6,N5,N4)) - RCHDFG(N6,N5,N4)=DFGS(M,N6,N5,N4)*(AMAX1(ZEROS(N5,N4) - 2,CH4G2(N6,N5,N4))*VOLWCH(N6,N5,N4) - 3-CH4S2(N6,N5,N4)*VOLPM(M,N6,N5,N4)) - 4/(VOLWCH(N6,N5,N4)+VOLPM(M,N6,N5,N4)) - ROXDFG(N6,N5,N4)=DFGS(M,N6,N5,N4)*(AMAX1(ZEROS(N5,N4) - 2,OXYG2(N6,N5,N4))*VOLWOX(N6,N5,N4) - 3-OXYS2(N6,N5,N4)*VOLPM(M,N6,N5,N4)) - 4/(VOLWOX(N6,N5,N4)+VOLPM(M,N6,N5,N4)) - RNGDFG(N6,N5,N4)=DFGS(M,N6,N5,N4)*(AMAX1(ZEROS(N5,N4) - 2,Z2GG2(N6,N5,N4))*VOLWNG(N6,N5,N4) - 3-Z2GS2(N6,N5,N4)*VOLPM(M,N6,N5,N4)) - 4/(VOLWNG(N6,N5,N4)+VOLPM(M,N6,N5,N4)) - RN2DFG(N6,N5,N4)=DFGS(M,N6,N5,N4)*(AMAX1(ZEROS(N5,N4) - 2,Z2OG2(N6,N5,N4))*VOLWN2(N6,N5,N4) - 3-Z2OS2(N6,N5,N4)*VOLPM(M,N6,N5,N4)) - 3/(VOLWN2(N6,N5,N4)+VOLPM(M,N6,N5,N4)) - IF(VOLPMA(N6,N5,N4).GT.ZEROS(N5,N4) - 2.AND.VOLWXA(N6,N5,N4).GT.ZEROS(N5,N4))THEN - RN3DFG(N6,N5,N4)=DFGS(M,N6,N5,N4)*(AMAX1(ZEROS(N5,N4) - 2,ZN3G2(N6,N5,N4))*VOLWN3(N6,N5,N4) - 3-ZN3S2(N6,N5,N4)*VOLPMA(N6,N5,N4)) - 4/(VOLWN3(N6,N5,N4)+VOLPMA(N6,N5,N4)) - CNH3S0=AMAX1(0.0,(ZN3S2(N6,N5,N4)+RN3DFG(N6,N5,N4)) - 2/VOLWXA(N6,N5,N4)) - CNH4S0=AMAX1(0.0,ZNH4S2(N6,N5,N4)) - 2/VOLWXA(N6,N5,N4) - RN34SQ(N6,N5,N4)=VOLWXA(N6,N5,N4) - 2*(CHY0(N6,N5,N4)*CNH3S0-DPN4*CNH4S0)/(DPN4+CHY0(N6,N5,N4)) - ELSE - RN3DFG(N6,N5,N4)=0.0 - RN34SQ(N6,N5,N4)=0.0 - ENDIF - IF(VOLPMB(N6,N5,N4).GT.ZEROS(N5,N4) - 2.AND.VOLWXB(N6,N5,N4).GT.ZEROS(N5,N4))THEN - RNBDFG(N6,N5,N4)=DFGS(M,N6,N5,N4)*(AMAX1(ZEROS(N5,N4) - 2,ZN3G2(N6,N5,N4))*VOLWNB(N6,N5,N4) - 3-ZNBS2(N6,N5,N4)*VOLPMB(N6,N5,N4)) - 4/(VOLWNB(N6,N5,N4)+VOLPMB(N6,N5,N4)) - CNH3B0=AMAX1(0.0,(ZNBS2(N6,N5,N4)+RNBDFG(N6,N5,N4)) - 2/VOLWXB(N6,N5,N4)) - CNH4B0=AMAX1(0.0,ZNH4B2(N6,N5,N4))/VOLWXB(N6,N5,N4) - RN34BQ(N6,N5,N4)=VOLWXB(N6,N5,N4) - 2*(CHY0(N6,N5,N4)*CNH3B0-DPN4*CNH4B0)/(DPN4+CHY0(N6,N5,N4)) - ELSE - RNBDFG(N6,N5,N4)=0.0 - RN34BQ(N6,N5,N4)=0.0 - ENDIF - RHGDFG(N6,N5,N4)=DFGS(M,N6,N5,N4)*(AMAX1(ZEROS(N5,N4) - 2,H2GG2(N6,N5,N4))*VOLWHG(N6,N5,N4) - 3-H2GS2(N6,N5,N4)*VOLPM(M,N6,N5,N4)) - 4/(VOLWHG(N6,N5,N4)+VOLPM(M,N6,N5,N4)) -C IF(I.EQ.43)THEN -C WRITE(*,6666)'RN3DFG',I,J,M,MM,N4,N5,N6,RN3DFG(N6,N5,N4) -C 2,DFGS(M,N6,N5,N4),ZN3S2A,VOLWN3(N6,N5,N4),ZN3S2(N6,N5,N4) -C 3,VOLPMA(N6,N5,N4),RNBDFG(N6,N5,N4),ZN3S2B -C 4,VOLWNB(N6,N5,N4),ZNBS2(N6,N5,N4),VOLPMB(N6,N5,N4) -C WRITE(*,6666)'RCHDFG',I,J,M,MM,N4,N5,N6,RCHDFG(N6,N5,N4) -C 2,DFGS(M,N6,N5,N4),CH4G2(N6,N5,N4),VOLWCH(N6,N5,N4) -C 3,CH4S2(N6,N5,N4),VOLWM(M,N6,N5,N4),THETPM(M,N6,N5,N4) -C 4,SCH4L(N6,N5,N4),XCHDFG(N6,N5,N4) -C WRITE(*,6666)'RNGDFG',I,J,M,MM,N4,N5,N6 -C 2,RNGDFG(N6,N5,N4),DFGS(M,N6,N5,N4),Z2GG2(N6,N5,N4) -C 3,VOLWNG(N6,N5,N4),Z2GS2(N6,N5,N4),VOLPM(M,N6,N5,N4) -C 4,VOLWNG(N6,N5,N4),VOLPM(M,N6,N5,N4) -6666 FORMAT(A8,7I4,20E12.4) -C ENDIF -C -C ACCUMULATE HOURLY FLUXES -C - XCODFG(N6,N5,N4)=XCODFG(N6,N5,N4)+RCODFG(N6,N5,N4) - XCHDFG(N6,N5,N4)=XCHDFG(N6,N5,N4)+RCHDFG(N6,N5,N4) - XOXDFG(N6,N5,N4)=XOXDFG(N6,N5,N4)+ROXDFG(N6,N5,N4) - XNGDFG(N6,N5,N4)=XNGDFG(N6,N5,N4)+RNGDFG(N6,N5,N4) - XN2DFG(N6,N5,N4)=XN2DFG(N6,N5,N4)+RN2DFG(N6,N5,N4) - XN3DFG(N6,N5,N4)=XN3DFG(N6,N5,N4)+RN3DFG(N6,N5,N4) - XN34SQ(N6,N5,N4)=XN34SQ(N6,N5,N4)+RN34SQ(N6,N5,N4) - XNBDFG(N6,N5,N4)=XNBDFG(N6,N5,N4)+RNBDFG(N6,N5,N4) - XN34BQ(N6,N5,N4)=XN34BQ(N6,N5,N4)+RN34BQ(N6,N5,N4) - XHGDFG(N6,N5,N4)=XHGDFG(N6,N5,N4)+RHGDFG(N6,N5,N4) - ELSE - RCODFG(N6,N5,N4)=0.0 - RCHDFG(N6,N5,N4)=0.0 - ROXDFG(N6,N5,N4)=0.0 - RNGDFG(N6,N5,N4)=0.0 - RN2DFG(N6,N5,N4)=0.0 - RN3DFG(N6,N5,N4)=0.0 - RN34SQ(N6,N5,N4)=0.0 - RNBDFG(N6,N5,N4)=0.0 - RN34BQ(N6,N5,N4)=0.0 - RHGDFG(N6,N5,N4)=0.0 - ENDIF - ENDIF - ELSEIF(N.NE.3)THEN - DCO2G(N,N6,N5,N4)=0.0 - DCH4G(N,N6,N5,N4)=0.0 - DOXYG(N,N6,N5,N4)=0.0 - DZ2GG(N,N6,N5,N4)=0.0 - DZ2OG(N,N6,N5,N4)=0.0 - DNH3G(N,N6,N5,N4)=0.0 - DH2GG(N,N6,N5,N4)=0.0 - DO 9750 K=0,4 - ROCFLS(K,N,N6,N5,N4)=0.0 - RONFLS(K,N,N6,N5,N4)=0.0 - ROPFLS(K,N,N6,N5,N4)=0.0 - ROAFLS(K,N,N6,N5,N4)=0.0 - ROCFHS(K,N,N6,N5,N4)=0.0 - RONFHS(K,N,N6,N5,N4)=0.0 - ROPFHS(K,N,N6,N5,N4)=0.0 - ROAFHS(K,N,N6,N5,N4)=0.0 -9750 CONTINUE - RCOFLS(N,N6,N5,N4)=0.0 - RCHFLS(N,N6,N5,N4)=0.0 - ROXFLS(N,N6,N5,N4)=0.0 - RNGFLS(N,N6,N5,N4)=0.0 - RN2FLS(N,N6,N5,N4)=0.0 - RHGFLS(N,N6,N5,N4)=0.0 - RN4FLW(N,N6,N5,N4)=0.0 - RN3FLW(N,N6,N5,N4)=0.0 - RNOFLW(N,N6,N5,N4)=0.0 - RNXFLS(N,N6,N5,N4)=0.0 - RH2PFS(N,N6,N5,N4)=0.0 - RN4FLB(N,N6,N5,N4)=0.0 - RN3FLB(N,N6,N5,N4)=0.0 - RNOFLB(N,N6,N5,N4)=0.0 - RNXFLB(N,N6,N5,N4)=0.0 - RH2BFB(N,N6,N5,N4)=0.0 - RCOFHS(N,N6,N5,N4)=0.0 - RCHFHS(N,N6,N5,N4)=0.0 - ROXFHS(N,N6,N5,N4)=0.0 - RNGFHS(N,N6,N5,N4)=0.0 - RN2FHS(N,N6,N5,N4)=0.0 - RHGFHS(N,N6,N5,N4)=0.0 - RN4FHW(N,N6,N5,N4)=0.0 - RN3FHW(N,N6,N5,N4)=0.0 - RNOFHW(N,N6,N5,N4)=0.0 - RNXFHS(N,N6,N5,N4)=0.0 - RH2PHS(N,N6,N5,N4)=0.0 - RN4FHB(N,N6,N5,N4)=0.0 - RN3FHB(N,N6,N5,N4)=0.0 - RNOFHB(N,N6,N5,N4)=0.0 - RNXFHB(N,N6,N5,N4)=0.0 - RH2BHB(N,N6,N5,N4)=0.0 - RCOFLG(N,N6,N5,N4)=0.0 - RCHFLG(N,N6,N5,N4)=0.0 - ROXFLG(N,N6,N5,N4)=0.0 - RNGFLG(N,N6,N5,N4)=0.0 - RN2FLG(N,N6,N5,N4)=0.0 - RN3FLG(N,N6,N5,N4)=0.0 - RHGFLG(N,N6,N5,N4)=0.0 - ENDIF -120 CONTINUE -C -C CHECK FOR BUBBLING IF THE SUM OF ALL GASEOUS EQUIVALENT -C PARTIAL CONCENTRATIONS EXCEEDS ATMOSPHERIC PRESSURE -C - IF(N3.GE.NU(N2,N1).AND.M.NE.MX)THEN - THETW1(N3,N2,N1)=AMAX1(0.0,VOLWM(M,N3,N2,N1)/VOLX(N3,N2,N1)) - IF(THETW1(N3,N2,N1).GT.THETY(N3,N2,N1).AND.IFLGB.EQ.0)THEN - SCO2X=12.0*SCO2L(N3,N2,N1) - SCH4X=12.0*SCH4L(N3,N2,N1) - SOXYX=32.0*SOXYL(N3,N2,N1) - SN2GX=28.0*SN2GL(N3,N2,N1) - SN2OX=28.0*SN2OL(N3,N2,N1) - SNH3X=14.0*SNH3L(N3,N2,N1) - SH2GX=2.0*SH2GL(N3,N2,N1) -C -C GASEOUS EQUIVALENT PARTIAL CONCENTRATIONS -C - VCO2G2=CO2S2(N3,N2,N1)/SCO2X - VCH4G2=CH4S2(N3,N2,N1)/SCH4X - VOXYG2=OXYS2(N3,N2,N1)/SOXYX - VZ2GG2=Z2GS2(N3,N2,N1)/SN2GX - VZ2OG2=Z2OS2(N3,N2,N1)/SN2OX - VNH3G2=ZN3S2(N3,N2,N1)/SNH3X - VNHBG2=ZNBS2(N3,N2,N1)/SNH3X - VH2GG2=H2GS2(N3,N2,N1)/SH2GX -C -C GASEOUS EQUIVALENT ATMOSPHERIC CONCENTRATION -C - VTATM=AMAX1(0.0,1.2194E+04*VOLWM(M,N3,N2,N1)/TKS(N3,N2,N1)) - VTGAS=VCO2G2+VCH4G2+VOXYG2+VZ2GG2+VZ2OG2+VNH3G2+VNHBG2+VH2GG2 -C -C PROPORTIONAL REMOVAL OF EXCESS AQUEOUS GASES -C - IF(VTGAS.GT.VTATM)THEN - DVTGAS=VTATM-VTGAS - RCOBBL(N3,N2,N1)=AMIN1(0.0,DVTGAS*VCO2G2/VTGAS)*SCO2X - RCHBBL(N3,N2,N1)=AMIN1(0.0,DVTGAS*VCH4G2/VTGAS)*SCH4X - ROXBBL(N3,N2,N1)=AMIN1(0.0,DVTGAS*VOXYG2/VTGAS)*SOXYX - RNGBBL(N3,N2,N1)=AMIN1(0.0,DVTGAS*VZ2GG2/VTGAS)*SN2GX - RN2BBL(N3,N2,N1)=AMIN1(0.0,DVTGAS*VZ2OG2/VTGAS)*SN2OX - RN3BBL(N3,N2,N1)=AMIN1(0.0,DVTGAS*VNH3G2/VTGAS)*SNH3X - RNBBBL(N3,N2,N1)=AMIN1(0.0,DVTGAS*VNHBG2/VTGAS)*SNH3X - RHGBBL(N3,N2,N1)=AMIN1(0.0,DVTGAS*VH2GG2/VTGAS)*SH2GX -C -C ACCUMULATE HOURLY FLUXES -C - XCOBBL(N3,N2,N1)=XCOBBL(N3,N2,N1)+RCOBBL(N3,N2,N1) - XCHBBL(N3,N2,N1)=XCHBBL(N3,N2,N1)+RCHBBL(N3,N2,N1) - XOXBBL(N3,N2,N1)=XOXBBL(N3,N2,N1)+ROXBBL(N3,N2,N1) - XNGBBL(N3,N2,N1)=XNGBBL(N3,N2,N1)+RNGBBL(N3,N2,N1) - XN2BBL(N3,N2,N1)=XN2BBL(N3,N2,N1)+RN2BBL(N3,N2,N1) - XN3BBL(N3,N2,N1)=XN3BBL(N3,N2,N1)+RN3BBL(N3,N2,N1) - XNBBBL(N3,N2,N1)=XNBBBL(N3,N2,N1)+RNBBBL(N3,N2,N1) - XHGBBL(N3,N2,N1)=XHGBBL(N3,N2,N1)+RHGBBL(N3,N2,N1) - ELSE - RCOBBL(N3,N2,N1)=0.0 - RCHBBL(N3,N2,N1)=0.0 - ROXBBL(N3,N2,N1)=0.0 - RNGBBL(N3,N2,N1)=0.0 - RN2BBL(N3,N2,N1)=0.0 - RN3BBL(N3,N2,N1)=0.0 - RNBBBL(N3,N2,N1)=0.0 - RHGBBL(N3,N2,N1)=0.0 - ENDIF - ELSE - IFLGB=1 - RCOBBL(N3,N2,N1)=0.0 - RCHBBL(N3,N2,N1)=0.0 - ROXBBL(N3,N2,N1)=0.0 - RNGBBL(N3,N2,N1)=0.0 - RN2BBL(N3,N2,N1)=0.0 - RN3BBL(N3,N2,N1)=0.0 - RNBBBL(N3,N2,N1)=0.0 - RHGBBL(N3,N2,N1)=0.0 - ENDIF -C IF(N1.EQ.2.AND.N2.EQ.1.AND.N3.EQ.13)THEN -C WRITE(*,6688)'BUBBL',I,J,N1,N2,N3,M,MM,IFLGB,VTGAS,VTATM -C 2,DVTGAS,SOXYX,VCO2G2,VCH4G2,VOXYG2,VZ2GG2,VZ2OG2 -C 3,VNH3G2,VNHBG2,VH2GG2,ROXBBL(N3,N2,N1),XOXBBL(N3,N2,N1) -C 4,OXYS2(N3,N2,N1),VOLWM(M,N3,N2,N1) -6688 FORMAT(A8,8I4,20E12.4) -C ENDIF - ENDIF -125 CONTINUE -9890 CONTINUE -9895 CONTINUE -C -C BOUNDARY SOLUTE AND GAS FLUXES -C - DO 9595 NX=NHW,NHE - DO 9590 NY=NVN,NVS - DO 9585 L=NU(NY,NX),NL(NY,NX) - N1=NX - N2=NY - N3=L -C -C LOCATE ALL EXTERNAL BOUNDARIES AND SET BOUNDARY CONDITIONS -C ENTERED IN 'READS' -C - DO 9580 N=1,3 - DO 9575 NN=1,2 - IF(N.EQ.1)THEN - N4=NX+1 - N5=NY - N6=L - IF(NN.EQ.1)THEN - IF(NX.EQ.NHE)THEN - M1=NX - M2=NY - M3=L - M4=NX+1 - M5=NY - M6=L - XN=-1.0 - ELSE - GO TO 9575 - ENDIF - ELSEIF(NN.EQ.2)THEN - IF(NX.EQ.NHW)THEN - M1=NX - M2=NY - M3=L - M4=NX - M5=NY - M6=L - XN=1.0 - ELSE - GO TO 9575 - ENDIF - ENDIF - ELSEIF(N.EQ.2)THEN - N4=NX - N5=NY+1 - N6=L - IF(NN.EQ.1)THEN - IF(NY.EQ.NVS)THEN - M1=NX - M2=NY - M3=L - M4=NX - M5=NY+1 - M6=L - XN=-1.0 - ELSE - GO TO 9575 - ENDIF - ELSEIF(NN.EQ.2)THEN - IF(NY.EQ.NVN)THEN - M1=NX - M2=NY - M3=L - M4=NX - M5=NY - M6=L - XN=1.0 - ELSE - GO TO 9575 - ENDIF - ENDIF - ELSEIF(N.EQ.3)THEN - N1=NX - N2=NY - N3=L - N4=NX - N5=NY - N6=L+1 - IF(NN.EQ.1)THEN - IF(L.EQ.NL(NY,NX))THEN - M1=NX - M2=NY - M3=L - M4=NX - M5=NY - M6=L+1 - XN=-1.0 - ELSE - GO TO 9575 - ENDIF - ELSEIF(NN.EQ.2)THEN - GO TO 9575 - ENDIF - ENDIF -C -C SURFACE SOLUTE TRANSPORT FROM BOUNDARY SURFACE -C RUNOFF IN 'WATSUB' AND CONCENTRATIONS IN THE SURFACE SOIL LAYER -C - IF(M.NE.MX)THEN - IF(M3.EQ.NU(M2,M1).AND.N.NE.3)THEN -C -C NO RUNOFF -C - IF(QRM(M,N,M5,M4).EQ.0.0)THEN - DO 9570 K=0,2 - RQROC(K,N,M5,M4)=0.0 - RQRON(K,N,M5,M4)=0.0 - RQROP(K,N,M5,M4)=0.0 - RQROA(K,N,M5,M4)=0.0 -9570 CONTINUE - RQRCOS(N,M5,M4)=0.0 - RQRCHS(N,M5,M4)=0.0 - RQROXS(N,M5,M4)=0.0 - RQRNGS(N,M5,M4)=0.0 - RQRN2S(N,M5,M4)=0.0 - RQRHGS(N,M5,M4)=0.0 - RQRNH4(N,M5,M4)=0.0 - RQRNH3(N,M5,M4)=0.0 - RQRNO3(N,M5,M4)=0.0 - RQRNO2(N,M5,M4)=0.0 - RQRH2P(N,M5,M4)=0.0 -C -C SOLUTE LOSS FROM RUNOFF DEPENDING ON ASPECT -C AND BOUNDARY CONDITIONS SET IN SITE FILE -C - ELSEIF(NN.EQ.1.AND.QRM(M,N,M5,M4).GT.0.0 - 2.OR.NN.EQ.2.AND.QRM(M,N,M5,M4).LT.0.0)THEN - IF(VOLWM(M,0,M2,M1).GT.ZEROS(M2,M1))THEN - VFLW=AMAX1(-XFRX,AMIN1(XFRX,QRM(M,N,M5,M4) - 2/VOLWM(M,0,M2,M1))) - ELSE - VFLW=0.0 - ENDIF - DO 9540 K=0,2 - 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)) - RQROA(K,N,M5,M4)=VFLW*AMAX1(0.0,OQA2(K,0,M2,M1)) -9540 CONTINUE - RQRCOS(N,M5,M4)=VFLW*AMAX1(0.0,CO2S2(0,M2,M1)) - RQRCHS(N,M5,M4)=VFLW*AMAX1(0.0,CH4S2(0,M2,M1)) - RQROXS(N,M5,M4)=VFLW*AMAX1(0.0,OXYS2(0,M2,M1)) - RQRNGS(N,M5,M4)=VFLW*AMAX1(0.0,Z2GS2(0,M2,M1)) - RQRN2S(N,M5,M4)=VFLW*AMAX1(0.0,Z2OS2(0,M2,M1)) - RQRHGS(N,M5,M4)=VFLW*AMAX1(0.0,H2GS2(0,M2,M1)) - RQRNH4(N,M5,M4)=VFLW*AMAX1(0.0,ZNH4S2(0,M2,M1)) - RQRNH3(N,M5,M4)=VFLW*AMAX1(0.0,ZN3S2(0,M2,M1)) - RQRNO3(N,M5,M4)=VFLW*AMAX1(0.0,ZNO3S2(0,M2,M1)) - RQRNO2(N,M5,M4)=VFLW*AMAX1(0.0,ZNO2S2(0,M2,M1)) - RQRH2P(N,M5,M4)=VFLW*AMAX1(0.0,H2PO42(0,M2,M1)) -C WRITE(18,1114)'RUNX',I,J,M,M1,M2,M3,N,QRM(M,N,M5,M4) -C 2,RQRH2P(N,M5,M4),(RQROP(K,N,M5,M4),K=1,4) -1114 FORMAT(A8,7I4,20E12.4) -C -C SOLUTE GAIN FROM RUNON DEPENDING ON ASPECT -C AND BOUNDARY CONDITIONS SET IN SITE FILE -C - ELSE - DO 9640 K=0,2 - RQROC(K,N,M5,M4)=0.0 - RQRON(K,N,M5,M4)=0.0 - RQROP(K,N,M5,M4)=0.0 - RQROA(K,N,M5,M4)=0.0 -9640 CONTINUE - RQRCOS(N,M5,M4)=QRM(M,N,M5,M4)*CCOU - RQRCHS(N,M5,M4)=QRM(M,N,M5,M4)*CCHU - RQROXS(N,M5,M4)=QRM(M,N,M5,M4)*COXU - RQRNGS(N,M5,M4)=QRM(M,N,M5,M4)*CNNU - RQRN2S(N,M5,M4)=QRM(M,N,M5,M4)*CN2U - RQRHGS(N,M5,M4)=0.0 - RQRNH4(N,M5,M4)=0.0 - RQRNH3(N,M5,M4)=0.0 - RQRNO3(N,M5,M4)=0.0 - RQRNO2(N,M5,M4)=0.0 - RQRH2P(N,M5,M4)=0.0 - ENDIF - RQSCOS(N,M5,M4)=0.0 - RQSCHS(N,M5,M4)=0.0 - RQSOXS(N,M5,M4)=0.0 - RQSNGS(N,M5,M4)=0.0 - RQSN2S(N,M5,M4)=0.0 - RQSNH4(N,M5,M4)=0.0 - RQSNH3(N,M5,M4)=0.0 - RQSNO3(N,M5,M4)=0.0 - RQSH2P(N,M5,M4)=0.0 -C -C ACCUMULATE HOURLY FLUXES -C - DO 9565 K=0,2 - 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) - XOAQRS(K,N,M5,M4)=XOAQRS(K,N,M5,M4)+RQROA(K,N,M5,M4) -9565 CONTINUE - XCOQRS(N,M5,M4)=XCOQRS(N,M5,M4)+RQRCOS(N,M5,M4) - XCHQRS(N,M5,M4)=XCHQRS(N,M5,M4)+RQRCHS(N,M5,M4) - XOXQRS(N,M5,M4)=XOXQRS(N,M5,M4)+RQROXS(N,M5,M4) - XNGQRS(N,M5,M4)=XNGQRS(N,M5,M4)+RQRNGS(N,M5,M4) - XN2QRS(N,M5,M4)=XN2QRS(N,M5,M4)+RQRN2S(N,M5,M4) - XHGQRS(N,M5,M4)=XHGQRS(N,M5,M4)+RQRHGS(N,M5,M4) - XN4QRW(N,M5,M4)=XN4QRW(N,M5,M4)+RQRNH4(N,M5,M4) - XN3QRW(N,M5,M4)=XN3QRW(N,M5,M4)+RQRNH3(N,M5,M4) - XNOQRW(N,M5,M4)=XNOQRW(N,M5,M4)+RQRNO3(N,M5,M4) - XNXQRS(N,M5,M4)=XNXQRS(N,M5,M4)+RQRNO2(N,M5,M4) - XP4QRW(N,M5,M4)=XP4QRW(N,M5,M4)+RQRH2P(N,M5,M4) - XCOQSS(N,M5,M4)=XCOQSS(N,M5,M4)+RQSCOS(N,M5,M4) - XCHQSS(N,M5,M4)=XCHQSS(N,M5,M4)+RQSCHS(N,M5,M4) - XOXQSS(N,M5,M4)=XOXQSS(N,M5,M4)+RQSOXS(N,M5,M4) - XNGQSS(N,M5,M4)=XNGQSS(N,M5,M4)+RQSNGS(N,M5,M4) - XN2QSS(N,M5,M4)=XN2QSS(N,M5,M4)+RQSN2S(N,M5,M4) - XN4QSS(N,M5,M4)=XN4QSS(N,M5,M4)+RQSNH4(N,M5,M4) - XN3QSS(N,M5,M4)=XN3QSS(N,M5,M4)+RQSNH3(N,M5,M4) - XNOQSS(N,M5,M4)=XNOQSS(N,M5,M4)+RQSNO3(N,M5,M4) - XP4QSS(N,M5,M4)=XP4QSS(N,M5,M4)+RQSH2P(N,M5,M4) - ENDIF -C -C SOLUTE LOSS WITH SUBSURFACE MICROPORE WATER LOSS -C - IF(NCN(M2,M1).NE.3.OR.N.EQ.3)THEN - IF(NN.EQ.1.AND.FLWM(M,N,M6,M5,M4).GT.0.0 - 2.OR.NN.EQ.2.AND.FLWM(M,N,M6,M5,M4).LT.0.0)THEN - IF(VOLWM(M,M3,M2,M1).GT.ZEROS(M2,M1))THEN - VFLW=AMAX1(-XFRX,AMIN1(XFRX,FLWM(M,N,M6,M5,M4) - 2/VOLWM(M,M3,M2,M1))) - ELSE - VFLW=0.0 - ENDIF - DO 9520 K=0,4 - ROCFLS(K,N,M6,M5,M4)=VFLW*AMAX1(0.0,OQC2(K,M3,M2,M1)) - RONFLS(K,N,M6,M5,M4)=VFLW*AMAX1(0.0,OQN2(K,M3,M2,M1)) - ROPFLS(K,N,M6,M5,M4)=VFLW*AMAX1(0.0,OQP2(K,M3,M2,M1)) - ROAFLS(K,N,M6,M5,M4)=VFLW*AMAX1(0.0,OQA2(K,M3,M2,M1)) -9520 CONTINUE - RCOFLS(N,M6,M5,M4)=VFLW*AMAX1(0.0,CO2S2(M3,M2,M1)) - RCHFLS(N,M6,M5,M4)=VFLW*AMAX1(0.0,CH4S2(M3,M2,M1)) - ROXFLS(N,M6,M5,M4)=VFLW*AMAX1(0.0,OXYS2(M3,M2,M1)) - RNGFLS(N,M6,M5,M4)=VFLW*AMAX1(0.0,Z2GS2(M3,M2,M1)) - RN2FLS(N,M6,M5,M4)=VFLW*AMAX1(0.0,Z2OS2(M3,M2,M1)) - RHGFLS(N,M6,M5,M4)=VFLW*AMAX1(0.0,H2GS2(M3,M2,M1)) - RN4FLW(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZNH4S2(M3,M2,M1)) - 2*VLNH4(M3,M2,M1) - RN3FLW(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZN3S2(M3,M2,M1)) - 2*VLNH4(M3,M2,M1) - RNOFLW(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZNO3S2(M3,M2,M1)) - 2*VLNO3(M3,M2,M1) - RNXFLS(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZNO2S2(M3,M2,M1)) - 2*VLNO3(M3,M2,M1) - RH2PFS(N,M6,M5,M4)=VFLW*AMAX1(0.0,H2PO42(M3,M2,M1)) - 2*VLPO4(M3,M2,M1) - RN4FLB(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZNH4B2(M3,M2,M1)) - 2*VLNHB(M3,M2,M1) - RN3FLB(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZNBS2(M3,M2,M1)) - 2*VLNHB(M3,M2,M1) - RNOFLB(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZNO3B2(M3,M2,M1)) - 2*VLNOB(M3,M2,M1) - RNXFLB(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZNO2B2(M3,M2,M1)) - 2*VLNOB(M3,M2,M1) - RH2BFB(N,M6,M5,M4)=VFLW*AMAX1(0.0,H2POB2(M3,M2,M1)) - 2*VLPOB(M3,M2,M1) -C IF(J.EQ.15)THEN -C WRITE(*,8765)'LEACH',I,J,M,M6,M5,M4,RNOFLW(N,M6,M5,M4) -C 2,VFLW,ZNO3S2(M3,M2,M1),VLNO3(M3,M2,M1),FLWM(M,N,M6,M5,M4) -C 3,VOLWM(M,M3,M2,M1) -8765 FORMAT(A8,6I4,20E12.4) -C ENDIF -C -C NO SOLUTE GAIN WITH SUBSURFACE MICROPORE WATER GAIN -C - ELSE - DO 9515 K=0,4 - ROCFLS(K,N,M6,M5,M4)=0.0 - RONFLS(K,N,M6,M5,M4)=0.0 - ROPFLS(K,N,M6,M5,M4)=0.0 - ROAFLS(K,N,M6,M5,M4)=0.0 -9515 CONTINUE - RCOFLS(N,M6,M5,M4)=0.0 - RCHFLS(N,M6,M5,M4)=0.0 - ROXFLS(N,M6,M5,M4)=0.0 - RNGFLS(N,M6,M5,M4)=0.0 - RN2FLS(N,M6,M5,M4)=0.0 - RHGFLS(N,M6,M5,M4)=0.0 - RN4FLW(N,M6,M5,M4)=0.0 - RN3FLW(N,M6,M5,M4)=0.0 - RNOFLW(N,M6,M5,M4)=0.0 - RNXFLS(N,M6,M5,M4)=0.0 - RH2PFS(N,M6,M5,M4)=0.0 - RN4FLB(N,M6,M5,M4)=0.0 - RN3FLB(N,M6,M5,M4)=0.0 - RNOFLB(N,M6,M5,M4)=0.0 - RNXFLB(N,M6,M5,M4)=0.0 - RH2BFB(N,M6,M5,M4)=0.0 - ENDIF -C IF(M.NE.MX.AND.I.GE.180.AND.I.LE.200)THEN -C WRITE(*,1115)'LEACHX',I,J,M1,M2,M3,M,MM,N -C 1,RCOFLS(N,M6,M5,M4),VFLW,CO2S2(M3,M2,M1) -C 2,RH2PFS(N,M6,M5,M4),(ROPFLS(K,N,M6,M5,M4),K=1,4) -C 4,VOLWM(M,M3,M2,M1),FLWM(M,N,M6,M5,M4),VFLW -1115 FORMAT(A8,8I4,20E12.4) -C ENDIF -C -C SOLUTE LOSS WITH SUBSURFACE MACROPORE WATER LOSS -C - IF(NN.EQ.1.AND.FLWHM(M,N,M6,M5,M4).GT.0.0 - 2.OR.NN.EQ.2.AND.FLWHM(M,N,M6,M5,M4).LT.0.0)THEN - IF(VOLWHM(M,M3,M2,M1).GT.ZEROS(M2,M1))THEN - VFLW=AMAX1(-XFRX,AMIN1(XFRX,FLWHM(M,N,M6,M5,M4) - 2/VOLWHM(M,M3,M2,M1))) - ELSE - VFLW=0.0 - ENDIF - DO 9535 K=0,4 - ROCFHS(K,N,M6,M5,M4)=VFLW*AMAX1(0.0,OQCH2(K,M3,M2,M1)) - RONFHS(K,N,M6,M5,M4)=VFLW*AMAX1(0.0,OQNH2(K,M3,M2,M1)) - ROPFHS(K,N,M6,M5,M4)=VFLW*AMAX1(0.0,OQPH2(K,M3,M2,M1)) - ROAFHS(K,N,M6,M5,M4)=VFLW*AMAX1(0.0,OQAH2(K,M3,M2,M1)) -9535 CONTINUE - RCOFHS(N,M6,M5,M4)=VFLW*AMAX1(0.0,CO2SH2(M3,M2,M1)) - RCHFHS(N,M6,M5,M4)=VFLW*AMAX1(0.0,CH4SH2(M3,M2,M1)) - ROXFHS(N,M6,M5,M4)=VFLW*AMAX1(0.0,OXYSH2(M3,M2,M1)) - RNGFHS(N,M6,M5,M4)=VFLW*AMAX1(0.0,Z2GSH2(M3,M2,M1)) - RN2FHS(N,M6,M5,M4)=VFLW*AMAX1(0.0,Z2OSH2(M3,M2,M1)) - RHGFHS(N,M6,M5,M4)=VFLW*AMAX1(0.0,H2GSH2(M3,M2,M1)) - RN4FHW(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZNH4H2(M3,M2,M1)) - 2*VLNH4(M3,M2,M1) - RN3FHW(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZNH3H2(M3,M2,M1)) - 2*VLNH4(M3,M2,M1) - RNOFHW(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZNO3H2(M3,M2,M1)) - 2*VLNO3(M3,M2,M1) - RNXFHS(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZNO2H2(M3,M2,M1)) - 2*VLNO3(M3,M2,M1) - RH2PHS(N,M6,M5,M4)=VFLW*AMAX1(0.0,H2P4H2(M3,M2,M1)) - 2*VLPO4(M3,M2,M1) - RN4FHB(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZN4BH2(M3,M2,M1)) - 2*VLNHB(M3,M2,M1) - RN3FHB(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZN3BH2(M3,M2,M1)) - 2*VLNHB(M3,M2,M1) - RNOFHB(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZNOBH2(M3,M2,M1)) - 2*VLNOB(M3,M2,M1) - RNXFHB(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZN2BH2(M3,M2,M1)) - 2*VLNOB(M3,M2,M1) - RH2BHB(N,M6,M5,M4)=VFLW*AMAX1(0.0,H2PBH2(M3,M2,M1)) - 2*VLPOB(M3,M2,M1) -C -C NO SOLUTE GAIN IN SUBSURFACE MACROPORES -C - ELSE - DO 9530 K=0,4 - ROCFHS(K,N,M6,M5,M4)=0.0 - RONFHS(K,N,M6,M5,M4)=0.0 - ROPFHS(K,N,M6,M5,M4)=0.0 - ROAFHS(K,N,M6,M5,M4)=0.0 -9530 CONTINUE - RCOFHS(N,M6,M5,M4)=0.0 - RCHFHS(N,M6,M5,M4)=0.0 - ROXFHS(N,M6,M5,M4)=0.0 - RNGFHS(N,M6,M5,M4)=0.0 - RN2FHS(N,M6,M5,M4)=0.0 - RN4FHW(N,M6,M5,M4)=0.0 - RHGFHS(N,M6,M5,M4)=0.0 - RN3FHW(N,M6,M5,M4)=0.0 - RNOFHW(N,M6,M5,M4)=0.0 - RNXFHS(N,M6,M5,M4)=0.0 - RH2PHS(N,M6,M5,M4)=0.0 - RN4FHB(N,M6,M5,M4)=0.0 - RN3FHB(N,M6,M5,M4)=0.0 - RNOFHB(N,M6,M5,M4)=0.0 - RNXFHB(N,M6,M5,M4)=0.0 - RH2BHB(N,M6,M5,M4)=0.0 - ENDIF -C -C ACCUMULATE HOURLY FLUXES -C - DO 9555 K=0,4 - XOCFLS(K,N,M6,M5,M4)=XOCFLS(K,N,M6,M5,M4)+ROCFLS(K,N,M6,M5,M4) - XONFLS(K,N,M6,M5,M4)=XONFLS(K,N,M6,M5,M4)+RONFLS(K,N,M6,M5,M4) - XOPFLS(K,N,M6,M5,M4)=XOPFLS(K,N,M6,M5,M4)+ROPFLS(K,N,M6,M5,M4) - XOAFLS(K,N,M6,M5,M4)=XOAFLS(K,N,M6,M5,M4)+ROAFLS(K,N,M6,M5,M4) - XOCFHS(K,N,M6,M5,M4)=XOCFHS(K,N,M6,M5,M4)+ROCFHS(K,N,M6,M5,M4) - XONFHS(K,N,M6,M5,M4)=XONFHS(K,N,M6,M5,M4)+RONFHS(K,N,M6,M5,M4) - XOPFHS(K,N,M6,M5,M4)=XOPFHS(K,N,M6,M5,M4)+ROPFHS(K,N,M6,M5,M4) - XOAFHS(K,N,M6,M5,M4)=XOAFHS(K,N,M6,M5,M4)+ROAFHS(K,N,M6,M5,M4) -9555 CONTINUE - XCOFLS(N,M6,M5,M4)=XCOFLS(N,M6,M5,M4)+RCOFLS(N,M6,M5,M4) - XCHFLS(N,M6,M5,M4)=XCHFLS(N,M6,M5,M4)+RCHFLS(N,M6,M5,M4) - XOXFLS(N,M6,M5,M4)=XOXFLS(N,M6,M5,M4)+ROXFLS(N,M6,M5,M4) - XNGFLS(N,M6,M5,M4)=XNGFLS(N,M6,M5,M4)+RNGFLS(N,M6,M5,M4) - XN2FLS(N,M6,M5,M4)=XN2FLS(N,M6,M5,M4)+RN2FLS(N,M6,M5,M4) - XHGFLS(N,M6,M5,M4)=XHGFLS(N,M6,M5,M4)+RHGFLS(N,M6,M5,M4) - XN4FLW(N,M6,M5,M4)=XN4FLW(N,M6,M5,M4)+RN4FLW(N,M6,M5,M4) - XN3FLW(N,M6,M5,M4)=XN3FLW(N,M6,M5,M4)+RN3FLW(N,M6,M5,M4) - XNOFLW(N,M6,M5,M4)=XNOFLW(N,M6,M5,M4)+RNOFLW(N,M6,M5,M4) - XNXFLS(N,M6,M5,M4)=XNXFLS(N,M6,M5,M4)+RNXFLS(N,M6,M5,M4) - XH2PFS(N,M6,M5,M4)=XH2PFS(N,M6,M5,M4)+RH2PFS(N,M6,M5,M4) - XN4FLB(N,M6,M5,M4)=XN4FLB(N,M6,M5,M4)+RN4FLB(N,M6,M5,M4) - XN3FLB(N,M6,M5,M4)=XN3FLB(N,M6,M5,M4)+RN3FLB(N,M6,M5,M4) - XNOFLB(N,M6,M5,M4)=XNOFLB(N,M6,M5,M4)+RNOFLB(N,M6,M5,M4) - XNXFLB(N,M6,M5,M4)=XNXFLB(N,M6,M5,M4)+RNXFLB(N,M6,M5,M4) - XH2BFB(N,M6,M5,M4)=XH2BFB(N,M6,M5,M4)+RH2BFB(N,M6,M5,M4) - XCOFHS(N,M6,M5,M4)=XCOFHS(N,M6,M5,M4)+RCOFHS(N,M6,M5,M4) - XCHFHS(N,M6,M5,M4)=XCHFHS(N,M6,M5,M4)+RCHFHS(N,M6,M5,M4) - XOXFHS(N,M6,M5,M4)=XOXFHS(N,M6,M5,M4)+ROXFHS(N,M6,M5,M4) - XNGFHS(N,M6,M5,M4)=XNGFHS(N,M6,M5,M4)+RNGFHS(N,M6,M5,M4) - XN2FHS(N,M6,M5,M4)=XN2FHS(N,M6,M5,M4)+RN2FHS(N,M6,M5,M4) - XHGFHS(N,M6,M5,M4)=XHGFHS(N,M6,M5,M4)+RHGFHS(N,M6,M5,M4) - XN4FHW(N,M6,M5,M4)=XN4FHW(N,M6,M5,M4)+RN4FHW(N,M6,M5,M4) - XN3FHW(N,M6,M5,M4)=XN3FHW(N,M6,M5,M4)+RN3FHW(N,M6,M5,M4) - XNOFHW(N,M6,M5,M4)=XNOFHW(N,M6,M5,M4)+RNOFHW(N,M6,M5,M4) - XNXFHS(N,M6,M5,M4)=XNXFHS(N,M6,M5,M4)+RNXFHS(N,M6,M5,M4) - XH2PHS(N,M6,M5,M4)=XH2PHS(N,M6,M5,M4)+RH2PHS(N,M6,M5,M4) - XN4FHB(N,M6,M5,M4)=XN4FHB(N,M6,M5,M4)+RN4FHB(N,M6,M5,M4) - XN3FHB(N,M6,M5,M4)=XN3FHB(N,M6,M5,M4)+RN3FHB(N,M6,M5,M4) - XNOFHB(N,M6,M5,M4)=XNOFHB(N,M6,M5,M4)+RNOFHB(N,M6,M5,M4) - XNXFHB(N,M6,M5,M4)=XNXFHB(N,M6,M5,M4)+RNXFHB(N,M6,M5,M4) - XH2BHB(N,M6,M5,M4)=XH2BHB(N,M6,M5,M4)+RH2BHB(N,M6,M5,M4) - ENDIF - ENDIF -C -C NO GASOUS GAIN WITH SUBSURFACE MICROPORE WATER LOSS -C - FLGM=(FLWM(M,N,M6,M5,M4)+FLWHM(M,N,M6,M5,M4))*XNPT -C IF(NN.EQ.1.AND.FLGM.GT.0.0 -C 2.OR.NN.EQ.2.AND.FLGM.LT.0.0)THEN -C IF(VOLPM(M,M3,M2,M1).GT.ZEROS(M2,M1))THEN -C VFLW=-AMAX1(-XFRX,AMIN1(XFRX,FLGM -C 2/VOLPM(M,M3,M2,M1))) -C ELSE -C VFLW=0.0 -C ENDIF -C RCOFLG(N,M6,M5,M4)=VFLW*AMAX1(0.0,CO2G2(M3,M2,M1)) -C RCHFLG(N,M6,M5,M4)=VFLW*AMAX1(0.0,CH4G2(M3,M2,M1)) -C ROXFLG(N,M6,M5,M4)=VFLW*AMAX1(0.0,OXYG2(M3,M2,M1)) -C RNGFLG(N,M6,M5,M4)=VFLW*AMAX1(0.0,Z2GG2(M3,M2,M1)) -C RN2FLG(N,M6,M5,M4)=VFLW*AMAX1(0.0,Z2OG2(M3,M2,M1)) -C RN3FLG(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZN3G2(M3,M2,M1)) -C RHGFLG(N,M6,M5,M4)=VFLW*AMAX1(0.0,H2GG2(M3,M2,M1)) -C XCOFLG(N,M6,M5,M4)=XCOFLG(N,M6,M5,M4)+RCOFLG(N,M6,M5,M4) -C XCHFLG(N,M6,M5,M4)=XCHFLG(N,M6,M5,M4)+RCHFLG(N,M6,M5,M4) -C XOXFLG(N,M6,M5,M4)=XOXFLG(N,M6,M5,M4)+ROXFLG(N,M6,M5,M4) -C XNGFLG(N,M6,M5,M4)=XNGFLG(N,M6,M5,M4)+RNGFLG(N,M6,M5,M4) -C XN2FLG(N,M6,M5,M4)=XN2FLG(N,M6,M5,M4)+RN2FLG(N,M6,M5,M4) -C XN3FLG(N,M6,M5,M4)=XN3FLG(N,M6,M5,M4)+RN3FLG(N,M6,M5,M4) -C XHGFLG(N,M6,M5,M4)=XHGFLG(N,M6,M5,M4)+RHGFLG(N,M6,M5,M4) -C IF(FLGM.NE.0.0)THEN -C WRITE(*,8766)'GAS IN',I,J,M,MM,N,NN,M3,M2,M1,M6,M5,M4 -C 2,VFLW,VOLPM(M,M3,M2,M1),ROXFLG(N,M6,M5,M4) -C 3,OXYG2(M3,M2,M1),FLGM,FLWM(M,N,M6,M5,M4) -C 4,FLWHM(M,N,M6,M5,M4) -8766 FORMAT(A8,12I4,20E12.4) -C ENDIF -C -C GASOUS LOSS WITH SUBSURFACE MICROPORE WATER GAIN -C - IF(NN.EQ.1.AND.FLGM.LT.0.0 - 2.OR.NN.EQ.2.AND.FLGM.GT.0.0)THEN - IF(VOLPM(M,M3,M2,M1).GT.ZEROS(M2,M1))THEN - VFLW=-AMAX1(-XFRX,AMIN1(XFRX,FLGM - 2/VOLPM(M,M3,M2,M1))) - ELSE - VFLW=0.0 - ENDIF - RCOFLG(N,M6,M5,M4)=VFLW*AMAX1(0.0,CO2G2(M3,M2,M1)) - RCHFLG(N,M6,M5,M4)=VFLW*AMAX1(0.0,CH4G2(M3,M2,M1)) - ROXFLG(N,M6,M5,M4)=VFLW*AMAX1(0.0,OXYG2(M3,M2,M1)) - RNGFLG(N,M6,M5,M4)=VFLW*AMAX1(0.0,Z2GG2(M3,M2,M1)) - RN2FLG(N,M6,M5,M4)=VFLW*AMAX1(0.0,Z2OG2(M3,M2,M1)) - RN3FLG(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZN3G2(M3,M2,M1)) - RHGFLG(N,M6,M5,M4)=VFLW*AMAX1(0.0,H2GG2(M3,M2,M1)) - XCOFLG(N,M6,M5,M4)=XCOFLG(N,M6,M5,M4)+RCOFLG(N,M6,M5,M4) - XCHFLG(N,M6,M5,M4)=XCHFLG(N,M6,M5,M4)+RCHFLG(N,M6,M5,M4) - XOXFLG(N,M6,M5,M4)=XOXFLG(N,M6,M5,M4)+ROXFLG(N,M6,M5,M4) - XNGFLG(N,M6,M5,M4)=XNGFLG(N,M6,M5,M4)+RNGFLG(N,M6,M5,M4) - XN2FLG(N,M6,M5,M4)=XN2FLG(N,M6,M5,M4)+RN2FLG(N,M6,M5,M4) - XN3FLG(N,M6,M5,M4)=XN3FLG(N,M6,M5,M4)+RN3FLG(N,M6,M5,M4) - XHGFLG(N,M6,M5,M4)=XHGFLG(N,M6,M5,M4)+RHGFLG(N,M6,M5,M4) -C IF(FLGM.NE.0.0)THEN -C WRITE(*,8766)'GAS OUT',I,J,M,MM,N,NN,M3,M2,M1,M6,M5,M4 -C 2,VFLW,VOLPM(M,M3,M2,M1),ROXFLG(N,M6,M5,M4) -C 3,OXYG2(M3,M2,M1),FLGM,FLWM(M,N,M6,M5,M4) -C 4,FLWHM(M,N,M6,M5,M4) -C ENDIF - ELSE - RCOFLG(N,M6,M5,M4)=0.0 - RCHFLG(N,M6,M5,M4)=0.0 - ROXFLG(N,M6,M5,M4)=0.0 - RNGFLG(N,M6,M5,M4)=0.0 - RN2FLG(N,M6,M5,M4)=0.0 - RN3FLG(N,M6,M5,M4)=0.0 - RHGFLG(N,M6,M5,M4)=0.0 - ENDIF -9575 CONTINUE -C -C TOTAL GAS AND SOLUTE FLUXES IN EACH GRID CELL -C - IF(M.NE.MX)THEN - IF(L.EQ.NU(N2,N1).AND.N.NE.3)THEN -C -C TOTAL OVERLAND FLUX -C - DO 9550 K=0,2 - 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) - TQROA(K,N2,N1)=TQROA(K,N2,N1)+RQROA(K,N,N2,N1)-RQROA(K,N,N5,N4) -9550 CONTINUE - TQRCOS(N2,N1)=TQRCOS(N2,N1)+RQRCOS(N,N2,N1)-RQRCOS(N,N5,N4) - TQRCHS(N2,N1)=TQRCHS(N2,N1)+RQRCHS(N,N2,N1)-RQRCHS(N,N5,N4) - TQROXS(N2,N1)=TQROXS(N2,N1)+RQROXS(N,N2,N1)-RQROXS(N,N5,N4) - TQRNGS(N2,N1)=TQRNGS(N2,N1)+RQRNGS(N,N2,N1)-RQRNGS(N,N5,N4) - TQRN2S(N2,N1)=TQRN2S(N2,N1)+RQRN2S(N,N2,N1)-RQRN2S(N,N5,N4) - TQRHGS(N2,N1)=TQRHGS(N2,N1)+RQRHGS(N,N2,N1)-RQRHGS(N,N5,N4) - TQRNH4(N2,N1)=TQRNH4(N2,N1)+RQRNH4(N,N2,N1)-RQRNH4(N,N5,N4) - TQRNH3(N2,N1)=TQRNH3(N2,N1)+RQRNH3(N,N2,N1)-RQRNH3(N,N5,N4) - TQRNO3(N2,N1)=TQRNO3(N2,N1)+RQRNO3(N,N2,N1)-RQRNO3(N,N5,N4) - TQRNO2(N2,N1)=TQRNO2(N2,N1)+RQRNO2(N,N2,N1)-RQRNO2(N,N5,N4) - TQRH2P(N2,N1)=TQRH2P(N2,N1)+RQRH2P(N,N2,N1)-RQRH2P(N,N5,N4) - TQSCOS(N2,N1)=TQSCOS(N2,N1)+RQSCOS(N,N2,N1)-RQSCOS(N,N5,N4) - TQSCHS(N2,N1)=TQSCHS(N2,N1)+RQSCHS(N,N2,N1)-RQSCHS(N,N5,N4) - TQSOXS(N2,N1)=TQSOXS(N2,N1)+RQSOXS(N,N2,N1)-RQSOXS(N,N5,N4) - TQSNGS(N2,N1)=TQSNGS(N2,N1)+RQSNGS(N,N2,N1)-RQSNGS(N,N5,N4) - TQSN2S(N2,N1)=TQSN2S(N2,N1)+RQSN2S(N,N2,N1)-RQSN2S(N,N5,N4) - TQSNH4(N2,N1)=TQSNH4(N2,N1)+RQSNH4(N,N2,N1)-RQSNH4(N,N5,N4) - TQSNH3(N2,N1)=TQSNH3(N2,N1)+RQSNH3(N,N2,N1)-RQSNH3(N,N5,N4) - TQSNO3(N2,N1)=TQSNO3(N2,N1)+RQSNO3(N,N2,N1)-RQSNO3(N,N5,N4) - TQSH2P(N2,N1)=TQSH2P(N2,N1)+RQSH2P(N,N2,N1)-RQSH2P(N,N5,N4) - ENDIF - ENDIF -C -C TOTAL SOLUTE FLUX IN MICROPORES AND MACROPORES -C - IF(M.NE.MX)THEN - IF(NCN(N2,N1).NE.3.OR.N.EQ.3)THEN - DO 9545 K=0,4 - TOCFLS(K,N3,N2,N1)=TOCFLS(K,N3,N2,N1)+ROCFLS(K,N,N3,N2,N1) - 2-ROCFLS(K,N,N6,N5,N4) - TONFLS(K,N3,N2,N1)=TONFLS(K,N3,N2,N1)+RONFLS(K,N,N3,N2,N1) - 2-RONFLS(K,N,N6,N5,N4) - TOPFLS(K,N3,N2,N1)=TOPFLS(K,N3,N2,N1)+ROPFLS(K,N,N3,N2,N1) - 2-ROPFLS(K,N,N6,N5,N4) - TOAFLS(K,N3,N2,N1)=TOAFLS(K,N3,N2,N1)+ROAFLS(K,N,N3,N2,N1) - 2-ROAFLS(K,N,N6,N5,N4) - TOCFHS(K,N3,N2,N1)=TOCFHS(K,N3,N2,N1)+ROCFHS(K,N,N3,N2,N1) - 2-ROCFHS(K,N,N6,N5,N4) - TONFHS(K,N3,N2,N1)=TONFHS(K,N3,N2,N1)+RONFHS(K,N,N3,N2,N1) - 2-RONFHS(K,N,N6,N5,N4) - TOPFHS(K,N3,N2,N1)=TOPFHS(K,N3,N2,N1)+ROPFHS(K,N,N3,N2,N1) - 2-ROPFHS(K,N,N6,N5,N4) - TOAFHS(K,N3,N2,N1)=TOAFHS(K,N3,N2,N1)+ROAFHS(K,N,N3,N2,N1) - 2-ROAFHS(K,N,N6,N5,N4) -9545 CONTINUE - TCOFLS(N3,N2,N1)=TCOFLS(N3,N2,N1)+RCOFLS(N,N3,N2,N1) - 2-RCOFLS(N,N6,N5,N4) - TCHFLS(N3,N2,N1)=TCHFLS(N3,N2,N1)+RCHFLS(N,N3,N2,N1) - 2-RCHFLS(N,N6,N5,N4) - TOXFLS(N3,N2,N1)=TOXFLS(N3,N2,N1)+ROXFLS(N,N3,N2,N1) - 2-ROXFLS(N,N6,N5,N4) - TNGFLS(N3,N2,N1)=TNGFLS(N3,N2,N1)+RNGFLS(N,N3,N2,N1) - 2-RNGFLS(N,N6,N5,N4) - TN2FLS(N3,N2,N1)=TN2FLS(N3,N2,N1)+RN2FLS(N,N3,N2,N1) - 2-RN2FLS(N,N6,N5,N4) - THGFLS(N3,N2,N1)=THGFLS(N3,N2,N1)+RHGFLS(N,N3,N2,N1) - 2-RHGFLS(N,N6,N5,N4) - TN4FLW(N3,N2,N1)=TN4FLW(N3,N2,N1)+RN4FLW(N,N3,N2,N1) - 2-RN4FLW(N,N6,N5,N4) - TN3FLW(N3,N2,N1)=TN3FLW(N3,N2,N1)+RN3FLW(N,N3,N2,N1) - 2-RN3FLW(N,N6,N5,N4) - TNOFLW(N3,N2,N1)=TNOFLW(N3,N2,N1)+RNOFLW(N,N3,N2,N1) - 2-RNOFLW(N,N6,N5,N4) - TNXFLS(N3,N2,N1)=TNXFLS(N3,N2,N1)+RNXFLS(N,N3,N2,N1) - 2-RNXFLS(N,N6,N5,N4) - TH2PFS(N3,N2,N1)=TH2PFS(N3,N2,N1)+RH2PFS(N,N3,N2,N1) - 2-RH2PFS(N,N6,N5,N4) - TN4FLB(N3,N2,N1)=TN4FLB(N3,N2,N1)+RN4FLB(N,N3,N2,N1) - 2-RN4FLB(N,N6,N5,N4) - TN3FLB(N3,N2,N1)=TN3FLB(N3,N2,N1)+RN3FLB(N,N3,N2,N1) - 2-RN3FLB(N,N6,N5,N4) - TNOFLB(N3,N2,N1)=TNOFLB(N3,N2,N1)+RNOFLB(N,N3,N2,N1) - 2-RNOFLB(N,N6,N5,N4) - TNXFLB(N3,N2,N1)=TNXFLB(N3,N2,N1)+RNXFLB(N,N3,N2,N1) - 2-RNXFLB(N,N6,N5,N4) - TH2BFB(N3,N2,N1)=TH2BFB(N3,N2,N1)+RH2BFB(N,N3,N2,N1) - 2-RH2BFB(N,N6,N5,N4) - TCOFHS(N3,N2,N1)=TCOFHS(N3,N2,N1)+RCOFHS(N,N3,N2,N1) - 2-RCOFHS(N,N6,N5,N4) - TCHFHS(N3,N2,N1)=TCHFHS(N3,N2,N1)+RCHFHS(N,N3,N2,N1) - 2-RCHFHS(N,N6,N5,N4) - TOXFHS(N3,N2,N1)=TOXFHS(N3,N2,N1)+ROXFHS(N,N3,N2,N1) - 2-ROXFHS(N,N6,N5,N4) - TNGFHS(N3,N2,N1)=TNGFHS(N3,N2,N1)+RNGFHS(N,N3,N2,N1) - 2-RNGFHS(N,N6,N5,N4) - TN2FHS(N3,N2,N1)=TN2FHS(N3,N2,N1)+RN2FHS(N,N3,N2,N1) - 2-RN2FHS(N,N6,N5,N4) - THGFHS(N3,N2,N1)=THGFHS(N3,N2,N1)+RHGFHS(N,N3,N2,N1) - 2-RHGFHS(N,N6,N5,N4) - TN4FHW(N3,N2,N1)=TN4FHW(N3,N2,N1)+RN4FHW(N,N3,N2,N1) - 2-RN4FHW(N,N6,N5,N4) - TN3FHW(N3,N2,N1)=TN3FHW(N3,N2,N1)+RN3FHW(N,N3,N2,N1) - 2-RN3FHW(N,N6,N5,N4) - TNOFHW(N3,N2,N1)=TNOFHW(N3,N2,N1)+RNOFHW(N,N3,N2,N1) - 2-RNOFHW(N,N6,N5,N4) - TNXFHS(N3,N2,N1)=TNXFHS(N3,N2,N1)+RNXFHS(N,N3,N2,N1) - 2-RNXFHS(N,N6,N5,N4) - TH2PHS(N3,N2,N1)=TH2PHS(N3,N2,N1)+RH2PHS(N,N3,N2,N1) - 2-RH2PHS(N,N6,N5,N4) - TN4FHB(N3,N2,N1)=TN4FHB(N3,N2,N1)+RN4FHB(N,N3,N2,N1) - 2-RN4FHB(N,N6,N5,N4) - TN3FHB(N3,N2,N1)=TN3FHB(N3,N2,N1)+RN3FHB(N,N3,N2,N1) - 2-RN3FHB(N,N6,N5,N4) - TNOFHB(N3,N2,N1)=TNOFHB(N3,N2,N1)+RNOFHB(N,N3,N2,N1) - 2-RNOFHB(N,N6,N5,N4) - TNXFHB(N3,N2,N1)=TNXFHB(N3,N2,N1)+RNXFHB(N,N3,N2,N1) - 2-RNXFHB(N,N6,N5,N4) - TH2BHB(N3,N2,N1)=TH2BHB(N3,N2,N1)+RH2BHB(N,N3,N2,N1) - 2-RH2BHB(N,N6,N5,N4) - ENDIF - ENDIF -C -C TOTAL GAS FLUX -C -C IF(NCN(N2,N1).NE.3.OR.N.EQ.3)THEN - TCOFLG(N3,N2,N1)=TCOFLG(N3,N2,N1)+RCOFLG(N,N3,N2,N1) - 2-RCOFLG(N,N6,N5,N4) - TCHFLG(N3,N2,N1)=TCHFLG(N3,N2,N1)+RCHFLG(N,N3,N2,N1) - 2-RCHFLG(N,N6,N5,N4) - TOXFLG(N3,N2,N1)=TOXFLG(N3,N2,N1)+ROXFLG(N,N3,N2,N1) - 2-ROXFLG(N,N6,N5,N4) - TNGFLG(N3,N2,N1)=TNGFLG(N3,N2,N1)+RNGFLG(N,N3,N2,N1) - 2-RNGFLG(N,N6,N5,N4) - TN2FLG(N3,N2,N1)=TN2FLG(N3,N2,N1)+RN2FLG(N,N3,N2,N1) - 2-RN2FLG(N,N6,N5,N4) - TN3FLG(N3,N2,N1)=TN3FLG(N3,N2,N1)+RN3FLG(N,N3,N2,N1) - 2-RN3FLG(N,N6,N5,N4) - THGFLG(N3,N2,N1)=THGFLG(N3,N2,N1)+RHGFLG(N,N3,N2,N1) - 2-RHGFLG(N,N6,N5,N4) -C ENDIF -9580 CONTINUE -9585 CONTINUE -9590 CONTINUE -9595 CONTINUE -C -C UPDATE STATE VARIABLES FROM TOTAL FLUXES CALCULATED ABOVE -C - IF(MM.NE.NPG)THEN - DO 9695 NX=NHW,NHE - DO 9690 NY=NVN,NVS - IF(M.NE.MX)THEN -C -C STATE VARIABLES FOR SOLUTES IN MICROPORES AND MACROPORES IN -C SOIL SURFACE LAYER FROM OVERLAND FLOW AND SURFACE VOLATILIZATION- -C DISSOLUTION -C - DO 9681 K=0,2 - 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) - OQA2(K,0,NY,NX)=OQA2(K,0,NY,NX)+ROAFLS(K,3,0,NY,NX) -9681 CONTINUE - CO2S2(0,NY,NX)=CO2S2(0,NY,NX)+RCODFR(NY,NX)+RCOFLS(3,0,NY,NX) - CH4S2(0,NY,NX)=CH4S2(0,NY,NX)+RCHDFR(NY,NX)+RCHFLS(3,0,NY,NX) - OXYS2(0,NY,NX)=OXYS2(0,NY,NX)+ROXDFR(NY,NX)+ROXFLS(3,0,NY,NX) - Z2GS2(0,NY,NX)=Z2GS2(0,NY,NX)+RNGDFR(NY,NX)+RNGFLS(3,0,NY,NX) - Z2OS2(0,NY,NX)=Z2OS2(0,NY,NX)+RN2DFR(NY,NX)+RN2FLS(3,0,NY,NX) - H2GS2(0,NY,NX)=H2GS2(0,NY,NX)+RHGDFR(NY,NX)+RHGFLS(3,0,NY,NX) - ZNH4S2(0,NY,NX)=ZNH4S2(0,NY,NX)+RN4FLW(3,0,NY,NX) - ZN3S2(0,NY,NX)=ZN3S2(0,NY,NX)+RN3DFR(NY,NX)+RN3FLW(3,0,NY,NX) - ZNO3S2(0,NY,NX)=ZNO3S2(0,NY,NX)+RNOFLW(3,0,NY,NX) - ZNO2S2(0,NY,NX)=ZNO2S2(0,NY,NX)+RNXFLS(3,0,NY,NX) - H2PO42(0,NY,NX)=H2PO42(0,NY,NX)+RH2PFS(3,0,NY,NX) - CO2S2(NU(NY,NX),NY,NX)=CO2S2(NU(NY,NX),NY,NX)+RCODFS(NY,NX) - CH4S2(NU(NY,NX),NY,NX)=CH4S2(NU(NY,NX),NY,NX)+RCHDFS(NY,NX) - OXYS2(NU(NY,NX),NY,NX)=OXYS2(NU(NY,NX),NY,NX)+ROXDFS(NY,NX) - Z2GS2(NU(NY,NX),NY,NX)=Z2GS2(NU(NY,NX),NY,NX)+RNGDFS(NY,NX) - Z2OS2(NU(NY,NX),NY,NX)=Z2OS2(NU(NY,NX),NY,NX)+RN2DFS(NY,NX) - 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) - DO 9680 K=0,2 - 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) - OQA2(K,0,NY,NX)=OQA2(K,0,NY,NX)+TQROA(K,NY,NX) -9680 CONTINUE - CO2S2(0,NY,NX)=CO2S2(0,NY,NX)+TQRCOS(NY,NX) - CH4S2(0,NY,NX)=CH4S2(0,NY,NX)+TQRCHS(NY,NX) - OXYS2(0,NY,NX)=OXYS2(0,NY,NX)+TQROXS(NY,NX) - Z2GS2(0,NY,NX)=Z2GS2(0,NY,NX)+TQRNGS(NY,NX) - Z2OS2(0,NY,NX)=Z2OS2(0,NY,NX)+TQRN2S(NY,NX) - H2GS2(0,NY,NX)=H2GS2(0,NY,NX)+TQRHGS(NY,NX) - ZNH4S2(0,NY,NX)=ZNH4S2(0,NY,NX)+TQRNH4(NY,NX) - ZN3S2(0,NY,NX)=ZN3S2(0,NY,NX)+TQRNH3(NY,NX) - ZNO3S2(0,NY,NX)=ZNO3S2(0,NY,NX)+TQRNO3(NY,NX) - ZNO2S2(0,NY,NX)=ZNO2S2(0,NY,NX)+TQRNO2(NY,NX) - H2PO42(0,NY,NX)=H2PO42(0,NY,NX)+TQRH2P(NY,NX) -C IF(I.EQ.87)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) -C WRITE(*,8787)'OXYS20',I,J,NX,NY,M,MM,OXYS2(0,NY,NX) -C 2,ROXDFR(NY,NX),ROXFLS(3,0,NY,NX),ROXSK2(0,NY,NX) -C 3,TQROXS(NY,NX),ROXDFG(0,NY,NX),XOXFLS(3,0,NY,NX) -8787 FORMAT(A8,6I4,12E12.4) -C ENDIF - CO2W2(NY,NX)=CO2W2(NY,NX)+TQSCOS(NY,NX) - CH4W2(NY,NX)=CH4W2(NY,NX)+TQSCHS(NY,NX) - OXYW2(NY,NX)=OXYW2(NY,NX)+TQSOXS(NY,NX) - ZNGW2(NY,NX)=ZNGW2(NY,NX)+TQSNGS(NY,NX) - ZN2W2(NY,NX)=ZN2W2(NY,NX)+TQSN2S(NY,NX) - ZN4W2(NY,NX)=ZN4W2(NY,NX)+TQSNH4(NY,NX) - ZN3W2(NY,NX)=ZN3W2(NY,NX)+TQSNH3(NY,NX) - ZNOW2(NY,NX)=ZNOW2(NY,NX)+TQSNO3(NY,NX) - ZHPW2(NY,NX)=ZHPW2(NY,NX)+TQSH2P(NY,NX) -C IF(I.EQ.118.AND.NX.EQ.3.AND.NY.EQ.4)THEN -C WRITE(*,6868)'OXYW2',I,J,NX,NY,M,MM,OXYW2(NY,NX) -C 2,TQSOXS(NY,NX),XOXBLS(NY,NX) -6868 FORMAT(A8,6I4,12E12.4) -C ENDIF - ENDIF -C -C STATE VARIABLES FOR GASES AND FOR SOLUTES IN MICROPORES AND -C MACROPORES IN SOIL LAYERS FROM SUBSURFACE FLOW, MICROBIAL -C AND ROOT EXCHANGE IN 'NITRO' AND 'UPTAKE', AND EQUILIBRIUM -C REACTIONS IN 'SOLUTE' -C - DO 9685 L=NU(NY,NX),NL(NY,NX) - IF(M.NE.MX)THEN - CO2S2(L,NY,NX)=CO2S2(L,NY,NX)+TCOFLS(L,NY,NX)+RCOFXS(L,NY,NX) - 2+RCOFLZ(L,NY,NX)+RCOBBL(L,NY,NX) - CH4S2(L,NY,NX)=CH4S2(L,NY,NX)+TCHFLS(L,NY,NX)+RCHFXS(L,NY,NX) - 2+RCHFLZ(L,NY,NX)+RCHBBL(L,NY,NX) - OXYS2(L,NY,NX)=OXYS2(L,NY,NX)+TOXFLS(L,NY,NX)+ROXFXS(L,NY,NX) - 2+ROXFLZ(L,NY,NX)+ROXBBL(L,NY,NX) - Z2GS2(L,NY,NX)=Z2GS2(L,NY,NX)+TNGFLS(L,NY,NX)+RNGFXS(L,NY,NX) - 2+RNGFLZ(L,NY,NX)+RNGBBL(L,NY,NX) - Z2OS2(L,NY,NX)=Z2OS2(L,NY,NX)+TN2FLS(L,NY,NX)+RN2FXS(L,NY,NX) - 2+RN2FLZ(L,NY,NX)+RN2BBL(L,NY,NX) - ZN3S2(L,NY,NX)=ZN3S2(L,NY,NX)+TN3FLW(L,NY,NX)+RN3FXW(L,NY,NX) - 2+RN3FLZ(L,NY,NX)+RN3BBL(L,NY,NX) - ZNBS2(L,NY,NX)=ZNBS2(L,NY,NX)+TN3FLB(L,NY,NX)+RN3FXB(L,NY,NX) - 2+RN3FBZ(L,NY,NX)+RNBBBL(L,NY,NX) - H2GS2(L,NY,NX)=H2GS2(L,NY,NX)+THGFLS(L,NY,NX)+RHGFXS(L,NY,NX) - 2+RHGFLZ(L,NY,NX)+RHGBBL(L,NY,NX) - DO 9675 K=0,4 - OQC2(K,L,NY,NX)=OQC2(K,L,NY,NX)+TOCFLS(K,L,NY,NX) - 2+ROCFXS(K,L,NY,NX) - OQN2(K,L,NY,NX)=OQN2(K,L,NY,NX)+TONFLS(K,L,NY,NX) - 2+RONFXS(K,L,NY,NX) - OQP2(K,L,NY,NX)=OQP2(K,L,NY,NX)+TOPFLS(K,L,NY,NX) - 2+ROPFXS(K,L,NY,NX) - OQA2(K,L,NY,NX)=OQA2(K,L,NY,NX)+TOAFLS(K,L,NY,NX) - 2+ROAFXS(K,L,NY,NX) - OQCH2(K,L,NY,NX)=OQCH2(K,L,NY,NX)+TOCFHS(K,L,NY,NX) - 2-ROCFXS(K,L,NY,NX) - OQNH2(K,L,NY,NX)=OQNH2(K,L,NY,NX)+TONFHS(K,L,NY,NX) - 2-RONFXS(K,L,NY,NX) - OQPH2(K,L,NY,NX)=OQPH2(K,L,NY,NX)+TOPFHS(K,L,NY,NX) - 2-ROPFXS(K,L,NY,NX) - OQAH2(K,L,NY,NX)=OQAH2(K,L,NY,NX)+TOAFHS(K,L,NY,NX) - 2-ROAFXS(K,L,NY,NX) -9675 CONTINUE - ZNH4S2(L,NY,NX)=ZNH4S2(L,NY,NX)+TN4FLW(L,NY,NX)+RN4FXW(L,NY,NX) - 2+RN4FLZ(L,NY,NX) - ZNO3S2(L,NY,NX)=ZNO3S2(L,NY,NX)+TNOFLW(L,NY,NX)+RNOFXW(L,NY,NX) - 2+RNOFLZ(L,NY,NX) - ZNO2S2(L,NY,NX)=ZNO2S2(L,NY,NX)+TNXFLS(L,NY,NX)+RNXFXS(L,NY,NX) - H2PO42(L,NY,NX)=H2PO42(L,NY,NX)+TH2PFS(L,NY,NX)+RH2PXS(L,NY,NX) - 2+RH2PFZ(L,NY,NX) - ZNH4B2(L,NY,NX)=ZNH4B2(L,NY,NX)+TN4FLB(L,NY,NX)+RN4FXB(L,NY,NX) - 2+RN4FBZ(L,NY,NX) - ZNO3B2(L,NY,NX)=ZNO3B2(L,NY,NX)+TNOFLB(L,NY,NX)+RNOFXB(L,NY,NX) - 2+RNOFBZ(L,NY,NX) - ZNO2B2(L,NY,NX)=ZNO2B2(L,NY,NX)+TNXFLB(L,NY,NX)+RNXFXB(L,NY,NX) - H2POB2(L,NY,NX)=H2POB2(L,NY,NX)+TH2BFB(L,NY,NX)+RH2BXB(L,NY,NX) - 2+RH2BBZ(L,NY,NX) - CO2SH2(L,NY,NX)=CO2SH2(L,NY,NX)+TCOFHS(L,NY,NX)-RCOFXS(L,NY,NX) - CH4SH2(L,NY,NX)=CH4SH2(L,NY,NX)+TCHFHS(L,NY,NX)-RCHFXS(L,NY,NX) - OXYSH2(L,NY,NX)=OXYSH2(L,NY,NX)+TOXFHS(L,NY,NX)-ROXFXS(L,NY,NX) - Z2GSH2(L,NY,NX)=Z2GSH2(L,NY,NX)+TNGFHS(L,NY,NX)-RNGFXS(L,NY,NX) - Z2OSH2(L,NY,NX)=Z2OSH2(L,NY,NX)+TN2FHS(L,NY,NX)-RN2FXS(L,NY,NX) - H2GSH2(L,NY,NX)=H2GSH2(L,NY,NX)+THGFHS(L,NY,NX)-RHGFXS(L,NY,NX) - ZNH4H2(L,NY,NX)=ZNH4H2(L,NY,NX)+TN4FHW(L,NY,NX)-RN4FXW(L,NY,NX) - ZNH3H2(L,NY,NX)=ZNH3H2(L,NY,NX)+TN3FHW(L,NY,NX)-RN3FXW(L,NY,NX) - ZNO3H2(L,NY,NX)=ZNO3H2(L,NY,NX)+TNOFHW(L,NY,NX)-RNOFXW(L,NY,NX) - ZNO2H2(L,NY,NX)=ZNO2H2(L,NY,NX)+TNXFHS(L,NY,NX)-RNXFXS(L,NY,NX) - H2P4H2(L,NY,NX)=H2P4H2(L,NY,NX)+TH2PHS(L,NY,NX)-RH2PXS(L,NY,NX) - ZN4BH2(L,NY,NX)=ZN4BH2(L,NY,NX)+TN4FHB(L,NY,NX)-RN4FXB(L,NY,NX) - ZN3BH2(L,NY,NX)=ZN3BH2(L,NY,NX)+TN3FHB(L,NY,NX)-RN3FXB(L,NY,NX) - ZNOBH2(L,NY,NX)=ZNOBH2(L,NY,NX)+TNOFHB(L,NY,NX)-RNOFXB(L,NY,NX) - ZN2BH2(L,NY,NX)=ZN2BH2(L,NY,NX)+TNXFHB(L,NY,NX)-RNXFXB(L,NY,NX) - H2PBH2(L,NY,NX)=H2PBH2(L,NY,NX)+TH2BHB(L,NY,NX)-RH2BXB(L,NY,NX) - ENDIF - CO2S2(L,NY,NX)=CO2S2(L,NY,NX)+RCODFG(L,NY,NX) - CH4S2(L,NY,NX)=CH4S2(L,NY,NX)+RCHDFG(L,NY,NX) - OXYS2(L,NY,NX)=OXYS2(L,NY,NX)+ROXDFG(L,NY,NX) - Z2GS2(L,NY,NX)=Z2GS2(L,NY,NX)+RNGDFG(L,NY,NX) - Z2OS2(L,NY,NX)=Z2OS2(L,NY,NX)+RN2DFG(L,NY,NX) - ZN3S2(L,NY,NX)=ZN3S2(L,NY,NX)+RN3DFG(L,NY,NX)-RN34SQ(L,NY,NX) - ZNH4S2(L,NY,NX)=ZNH4S2(L,NY,NX)+RN34SQ(L,NY,NX) - ZNBS2(L,NY,NX)=ZNBS2(L,NY,NX)+RNBDFG(L,NY,NX)-RN34BQ(L,NY,NX) - ZNH4B2(L,NY,NX)=ZNH4B2(L,NY,NX)+RN34BQ(L,NY,NX) - H2GS2(L,NY,NX)=H2GS2(L,NY,NX)+RHGDFG(L,NY,NX) - CO2G2(L,NY,NX)=CO2G2(L,NY,NX)+TCOFLG(L,NY,NX)-RCODFG(L,NY,NX) - CH4G2(L,NY,NX)=CH4G2(L,NY,NX)+TCHFLG(L,NY,NX)-RCHDFG(L,NY,NX) - OXYG2(L,NY,NX)=OXYG2(L,NY,NX)+TOXFLG(L,NY,NX)-ROXDFG(L,NY,NX) - Z2GG2(L,NY,NX)=Z2GG2(L,NY,NX)+TNGFLG(L,NY,NX)-RNGDFG(L,NY,NX) - Z2OG2(L,NY,NX)=Z2OG2(L,NY,NX)+TN2FLG(L,NY,NX)-RN2DFG(L,NY,NX) - 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(I.EQ.87.AND.L.EQ.NU(NY,NX))THEN -C WRITE(*,444)'CO2S2',I,J,M,MM,NX,NY,L -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) -C 3,RCODFS(NY,NX),PARG(NY,NX),CCO2E(NY,NX),CCO2SQ -C 4,CO2S2(L,NY,NX)/VOLWM(M,L,NY,NX) -C WRITE(*,444)'OXYS2',I,J,M,MX,NX,NY,L -C 2,OXYS2(L,NY,NX),TOXFLS(L,NY,NX),ROXFXS(L,NY,NX) -C 3,ROXFLZ(L,NY,NX),ROXBBL(L,NY,NX),ROXDFG(L,NY,NX) -C 4,ROXSK(M,L,NY,NX),OXYG2(L,NY,NX),ROXFLS(3,L,NY,NX) -C 5,ROXFLS(3,L+1,NY,NX),ROXDFS(NY,NX),ROXSK2(L,NY,NX) -C 6,ROXSK(M,L,NY,NX),VOLWM(M,L,NY,NX) -C WRITE(*,444)'OXYSH2',I,J,M,MX,NX,NY,L -C 2,OXYSH2(L,NY,NX),TOXFHS(L,NY,NX),ROXFXS(L,NY,NX) -C WRITE(*,444)'CH4S2',I,J,NX,NY,L,M,MM,CH4S2(L,NY,NX) -C 2,TCHFLS(L,NY,NX),RCHFXS(L,NY,NX),RCHFLZ(L,NY,NX) -C 3,RCHBBL(L,NY,NX),RCHDFG(L,NY,NX),RCHSK2(L,NY,NX) -C 4,RCHFLS(3,L,NY,NX),RCHFLS(3,L+1,NY,NX) -C 5,RCHDFR(NY,NX),RCHFLS(3,L,NY,NX),RCHSK2(L,NY,NX) -C 3,TQRCHS(NY,NX),RCHDFG(L,NY,NX),XCHFLS(3,L,NY,NX) -C 6,CH4G2(L,NY,NX),TCHFLG(L,NY,NX) -C WRITE(*,444)'Z2GS2',I,J,M,MX,NX,NY,L -C 2,Z2GS2(L,NY,NX),RNGDFG(L,NY,NX),RNGSK2(L,NY,NX) -C 3,RNGDFS(NY,NX),RNGFLS(3,0,NY,NX),TQRNGS(NY,NX) -C 4,TNGFLS(L,NY,NX),RNGFXS(L,NY,NX),RNGFLZ(L,NY,NX) -C 2,RNGBBL(L,NY,NX),Z2GG2(L,NY,NX),TNGFLG(L,NY,NX) -C WRITE(*,444)'ZN3G2',I,J,M,MM,NX,NY,L,ZN3G2(L,NY,NX) -C 2,TN3FLG(L,NY,NX),RN3DFG(L,NY,NX),RN34SQ(L,NY,NX),RNBDFG(L,NY,NX) -C 3,RN34BQ(L,NY,NX),ZN3S2(L,NY,NX),ZNBS2(L,NY,NX) -C 3,ZNH4S2(L,NY,NX),ZNH4B2(L,NY,NX),RNHSK2(L,NY,NX) -C WRITE(*,444)'OXYG2',I,J,M,MM,NX,NY,L,OXYG2(L,NY,NX) -C 2,TOXFLG(L,NY,NX),ROXDFG(L,NY,NX),OXYS2(L,NY,NX) -C 3,ROXFLG(3,L,NY,NX),ROXFLG(3,L+1,NY,NX),DOXYG(3,L,NY,NX) -C 4,THETPM(M,L,NY,NX),PARGOX(NY,NX) -C 6,XOXFLG(3,L,NY,NX),XOXFLG(3,L+1,NY,NX) -C 7,COXYE(NY,NX),FLQM(N,L,NY,NX) -C WRITE(*,444)'N2OG2',I,J,M,MM,NX,NY,L,Z2OG2(L,NY,NX) -C 2,Z2OS2(L,NY,NX),Z2OSH2(L,NY,NX),TN2FLG(L,NY,NX),RN2DFG(L,NY,NX) -C 3,TN2FLS(L,NY,NX),RN2FXS(L,NY,NX),RN2FLZ(L,NY,NX),RN2BBL(L,NY,NX) -C 2,TN2FHS(L,NY,NX),RN2SK2(L,NY,NX),RN2O(L,NY,NX),TUPN2S(L,NY,NX) -C WRITE(*,444)'H2GS2',I,J,NX,NY,M,MM,L,H2GS2(L,NY,NX) -C 2,THGFLS(L,NY,NX),RHGFXS(L,NY,NX),RHGFLZ(L,NY,NX),RHGBBL(L,NY,NX) -C 3,H2GSH2(L,NY,NX),THGFHS(L,NY,NX),RHGDFG(L,NY,NX),RHGSK2(L,NY,NX) -C 4,RH2GO(L,NY,NX),TUPHGS(L,NY,NX) -444 FORMAT(A8,7I4,20E16.6) -C ENDIF -9685 CONTINUE - CO2S2(0,NY,NX)=CO2S2(0,NY,NX)+RCODFG(0,NY,NX) - CH4S2(0,NY,NX)=CH4S2(0,NY,NX)+RCHDFG(0,NY,NX) - OXYS2(0,NY,NX)=OXYS2(0,NY,NX)+ROXDFG(0,NY,NX) - Z2GS2(0,NY,NX)=Z2GS2(0,NY,NX)+RNGDFG(0,NY,NX) - Z2OS2(0,NY,NX)=Z2OS2(0,NY,NX)+RN2DFG(0,NY,NX) - ZN3S2(0,NY,NX)=ZN3S2(0,NY,NX)+RN3DFG(0,NY,NX) - H2GS2(0,NY,NX)=H2GS2(0,NY,NX)+RHGDFG(0,NY,NX) - ZN3S2(0,NY,NX)=ZN3S2(0,NY,NX)-RN34SQ(0,NY,NX) - ZNH4S2(0,NY,NX)=ZNH4S2(0,NY,NX)+RN34SQ(0,NY,NX) -C IF(I.EQ.87)THEN -C WRITE(*,1119)'OXYS20',I,J,NX,NY,M,MM,OXYS2(0,NY,NX) -C 2,ROXDFG(0,NY,NX),ROXDFR(NY,NX),ROXFLS(3,0,NY,NX) -C 3,TQROXS(NY,NX),ROXSK2(0,NY,NX),OXYS2(0,NY,NX)/VOLWM(M,0,NY,NX) -C 4,VOLWM(M,0,NY,NX)/VOLA(0,NY,NX),VOLPM(M,0,NY,NX)/VOLA(0,NY,NX) -C 5,VOLWM(M,0,NY,NX),VOLA(0,NY,NX),VOLWG(NY,NX),DFGS(M,0,NY,NX) -C 6,VOLPM(M,NU(NY,NX),NY,NX),VOLWM(M,NU(NY,NX),NY,NX) -C 7,VOLWHM(M,NU(NY,NX),NY,NX) -C WRITE(*,1119)'CH4S2G',I,J,NX,NY,M,MM,CH4S2(0,NY,NX) -C 2,RCHDFG(0,NY,NX) -1119 FORMAT(A8,6I4,20E12.4) -C ENDIF -9690 CONTINUE -9695 CONTINUE - ENDIF - MX=M -30 CONTINUE - RETURN - END - - + SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) +C +C THIS SUBROUTINE CALCULATES 3-DIMENSIONAL FLUXES OF ALL SOIL +C NON-SALT SOLUTES AND GASES +C + include "parameters.h" + include "blkc.h" + include "blk2a.h" + include "blk2b.h" + include "blk2c.h" + include "blk8a.h" + include "blk8b.h" + include "blk10.h" + include "blk11a.h" + include "blk11b.h" + include "blk13a.h" + include "blk13b.h" + include "blk13c.h" + include "blk15a.h" + include "blk15b.h" + include "blk18a.h" + include "blk18b.h" + include "blk19d.h" + include "blk20d.h" + include "blk20e.h" + include "blk21a.h" + include "blk21b.h" + include "blk22a.h" + include "blk22b.h" + include "blk22c.h" + DIMENSION CO2G2(JZ,JY,JX),CO2S2(0:JZ,JY,JX) + 2,CH4G2(JZ,JY,JX),CH4S2(0:JZ,JY,JX),OXYG2(JZ,JY,JX) + 3,OXYS2(0:JZ,JY,JX),Z2GG2(JZ,JY,JX),Z2GS2(0:JZ,JY,JX) + 4,Z2OG2(JZ,JY,JX),Z2OS2(0:JZ,JY,JX),ZN3G2(0:JZ,JY,JX) + 5,ZNH4S2(0:JZ,JY,JX),ZNH4B2(0:JZ,JY,JX),ZN3S2(0:JZ,JY,JX) + 6,ZNBS2(0:JZ,JY,JX),ZNO3S2(0:JZ,JY,JX),ZNO3B2(0:JZ,JY,JX) + 7,H2PO42(0:JZ,JY,JX),H2POB2(0:JZ,JY,JX),ZNO2S2(0:JZ,JY,JX) + 8,CGSGL2(JZ,JY,JX),CHSGL2(JZ,JY,JX),OGSGL2(JZ,JY,JX) + 9,ZGSGL2(JZ,JY,JX),Z2SGL2(JZ,JY,JX),ZHSGL2(JZ,JY,JX) + 7,OQC2(0:4,0:JZ,JY,JX),OQN2(0:4,0:JZ,JY,JX),OQP2(0:4,0:JZ,JY,JX) + 8,OQA2(0:4,0:JZ,JY,JX),OCSGL2(0:JZ,JY,JX),ONSGL2(0:JZ,JY,JX) + 9,OPSGL2(0:JZ,JY,JX),OASGL2(0:JZ,JY,JX),CHY0(0:JZ,JY,JX) + 1,CO2W2(JY,JX),CH4W2(JY,JX),OXYW2(JY,JX),ZNGW2(JY,JX) + 2,ZN2W2(JY,JX),ZN4W2(JY,JX),ZN3W2(JY,JX),ZNOW2(JY,JX) + 3,ZHPW2(JY,JX),H1PO42(0:JZ,JY,JX),H1POB2(0:JZ,JY,JX) + 4,Z1PW2(JY,JX) + DIMENSION ROCSK2(0:4,0:JZ,JY,JX),RONSK2(0:4,0:JZ,JY,JX) + 2,ROPSK2(0:4,0:JZ,JY,JX),ROASK2(0:4,0:JZ,JY,JX) + 3,RCOSK2(0:JZ,JY,JX),ROXSK2(0:JZ,JY,JX),RCHSK2(0:JZ,JY,JX) + 4,RNGSK2(0:JZ,JY,JX),RN2SK2(0:JZ,JY,JX),RN4SK2(0:JZ,JY,JX) + 5,RN3SK2(0:JZ,JY,JX),RNOSK2(0:JZ,JY,JX),RHPSK2(0:JZ,JY,JX) + 6,R4BSK2(JZ,JY,JX),R3BSK2(JZ,JY,JX),RNBSK2(JZ,JY,JX) + 7,RHBSK2(JZ,JY,JX),RNXSK2(0:JZ,JY,JX),RNZSK2(JZ,JY,JX) + 8,RHGSK2(0:JZ,JY,JX),RNHSK2(0:JZ,JY,JX),R1PSK2(0:JZ,JY,JX) + DIMENSION CLSGL2(0:JZ,JY,JX),CQSGL2(0:JZ,JY,JX),OLSGL2(0:JZ,JY,JX) + 2,ZNSGL2(0:JZ,JY,JX),ZLSGL2(0:JZ,JY,JX),ZVSGL2(0:JZ,JY,JX) + 3,HLSGL2(0:JZ,JY,JX),ZOSGL2(0:JZ,JY,JX),POSGL2(0:JZ,JY,JX) + 4,RCODFS(JY,JX),RCHDFS(JY,JX),ROXDFS(JY,JX),RNGDFS(JY,JX) + 5,RN2DFS(JY,JX),RN3DFS(JY,JX),RNBDFS(JY,JX),RHGDFS(JY,JX) + 6,RCODFR(JY,JX),RCHDFR(JY,JX),ROXDFR(JY,JX),RNGDFR(JY,JX) + 7,RN2DFR(JY,JX),RN3DFR(JY,JX),RHGDFR(JY,JX),R1BSK2(JZ,JY,JX) + 8,RQROC(0:4,2,JV,JH),RQRON(0:4,2,JV,JH),RQROP(0:4,2,JV,JH) + 9,RQROA(0:4,2,JV,JH),RQRCOS(2,JV,JH),RQRCHS(2,JV,JH) + 1,RQROXS(2,JV,JH),RQRNGS(2,JV,JH),RQRN2S(2,JV,JH),RQRNH4(2,JV,JH) + 2,RQRNH3(2,JV,JH),RQRNO3(2,JV,JH),RQRH2P(2,JV,JH) + 3,RQRNO2(2,JV,JH),RQRHGS(2,JV,JH),FLWU(JZ,JY,JX) + 4,RQSCOS(2,JV,JH),RQSCHS(2,JV,JH),RQSOXS(2,JV,JH) + 5,RQSNGS(2,JV,JH),RQSN2S(2,JV,JH),RQSNH4(2,JV,JH) + 6,RQSNH3(2,JV,JH),RQSNO3(2,JV,JH),RQSH2P(2,JV,JH) + 7,RQRH1P(2,JV,JH),RQSH1P(2,JV,JH) + DIMENSION RCOFLS(3,0:JD,JV,JH),RCHFLS(3,0:JD,JV,JH) + 2,ROXFLS(3,0:JD,JV,JH),RNGFLS(3,0:JD,JV,JH),RN2FLS(3,0:JD,JV,JH) + 3,RHGFLS(3,0:JD,JV,JH),RN4FLW(3,0:JD,JV,JH),RN3FLW(3,0:JD,JV,JH) + 4,RNOFLW(3,0:JD,JV,JH),RNXFLS(3,0:JD,JV,JH),RH2PFS(3,0:JD,JV,JH) + 5,RN4FLB(3,0:JD,JV,JH),RN3FLB(3,0:JD,JV,JH),RNOFLB(3,0:JD,JV,JH) + 6,RNXFLB(3,0:JD,JV,JH),RH2BFB(3,0:JD,JV,JH),RCOFHS(3,JD,JV,JH) + 7,RCHFHS(3,JD,JV,JH),ROXFHS(3,JD,JV,JH),RNGFHS(3,JD,JV,JH) + 8,RN2FHS(3,JD,JV,JH),RN4FHW(3,JD,JV,JH),RN3FHW(3,JD,JV,JH) + 9,RNOFHW(3,JD,JV,JH),RH2PHS(3,JD,JV,JH),RN4FHB(3,JD,JV,JH) + 1,RN3FHB(3,JD,JV,JH),RNOFHB(3,JD,JV,JH),RH2BHB(3,JD,JV,JH) + 2,ROCFLS(0:4,3,0:JD,JV,JH),RONFLS(0:4,3,0:JD,JV,JH) + 3,ROPFLS(0:4,3,0:JD,JV,JH),ROAFLS(0:4,3,0:JD,JV,JH) + 4,ROCFHS(0:4,3,JD,JV,JH),RONFHS(0:4,3,JD,JV,JH) + 5,ROPFHS(0:4,3,JD,JV,JH),ROAFHS(0:4,3,JD,JV,JH) + 6,ROXFLG(3,JD,JV,JH),RN3FLG(3,JD,JV,JH),RCOFLG(3,JD,JV,JH) + 7,RCHFLG(3,JD,JV,JH),RNGFLG(3,JD,JV,JH),RN2FLG(3,JD,JV,JH) + 8,RNXFHS(3,JD,JV,JH),RNXFHB(3,JD,JV,JH),RH1PFS(3,0:JD,JV,JH) + 9,RH1BFB(3,0:JD,JV,JH),RH1PHS(3,JD,JV,JH),RH1BHB(3,JD,JV,JH) + DIMENSION RCODFG(0:JZ,JY,JX),RCHDFG(0:JZ,JY,JX) + 1,ROXDFG(0:JZ,JY,JX),RNGDFG(0:JZ,JY,JX),RN2DFG(0:JZ,JY,JX) + 2,RN3DFG(0:JZ,JY,JX),RNBDFG(0:JZ,JY,JX),TQROC(0:4,JY,JX) + 3,TQRON(0:4,JY,JX),TQROP(0:4,JY,JX),TQROA(0:4,JY,JX) + 4,TQRCHS(JY,JX),TQROXS(JY,JX),TQRNGS(JY,JX),TQRN2S(JY,JX) + 5,TQRNH4(JY,JX),TQRNH3(JY,JX),TQRNO3(JY,JX),TQRH2P(JY,JX) + 7,TQRNO2(JY,JX),TQRHGS(JY,JX),TQSCOS(JY,JX),TQRCOS(JY,JX) + 4,TQSCHS(JY,JX),TQSOXS(JY,JX),TQSNGS(JY,JX),TQSN2S(JY,JX) + 5,TQSNH4(JY,JX),TQSNH3(JY,JX),TQSNO3(JY,JX),TQSH1P(JY,JX) + 8,TQSH2P(JY,JX),TOCFLS(0:4,JZ,JY,JX),TONFLS(0:4,JZ,JY,JX) + 8,TOPFLS(0:4,JZ,JY,JX),TOAFLS(0:4,JZ,JY,JX),TCOFLS(JZ,JY,JX) + 9,TCHFLS(JZ,JY,JX),TOXFLS(JZ,JY,JX),TNGFLS(JZ,JY,JX) + 1,TN2FLS(JZ,JY,JX),TN4FLW(JZ,JY,JX),TN3FLW(JZ,JY,JX) + 2,TNOFLW(JZ,JY,JX),TH2PFS(JZ,JY,JX),TN4FLB(JZ,JY,JX) + 3,TN3FLB(JZ,JY,JX),TNOFLB(JZ,JY,JX),TH2BFB(JZ,JY,JX) + 4,TNXFLS(JZ,JY,JX),TCOFLG(JZ,JY,JX),TCHFLG(JZ,JY,JX) + 5,TOXFLG(JZ,JY,JX),TNGFLG(JZ,JY,JX),TN2FLG(JZ,JY,JX) + 6,TQRH1P(JY,JX),TH1PFS(JZ,JY,JX),TH1BFB(JZ,JY,JX) + DIMENSION TN3FLG(JZ,JY,JX),RCOBBL(JZ,JY,JX) + 4,RCHBBL(JZ,JY,JX),ROXBBL(JZ,JY,JX),RNGBBL(JZ,JY,JX) + 5,RN2BBL(JZ,JY,JX),RN3BBL(JZ,JY,JX),RNBBBL(JZ,JY,JX) + 6,RHGBBL(JZ,JY,JX) + DIMENSION CO2SH2(JZ,JY,JX),CH4SH2(JZ,JY,JX),OXYSH2(JZ,JY,JX) + 2,Z2GSH2(JZ,JY,JX),Z2OSH2(JZ,JY,JX),ZNH4H2(JZ,JY,JX) + 3,ZN4BH2(JZ,JY,JX),ZNH3H2(JZ,JY,JX),ZN3BH2(JZ,JY,JX) + 4,ZNO3H2(JZ,JY,JX),ZNOBH2(JZ,JY,JX),H2P4H2(JZ,JY,JX) + 5,H2PBH2(JZ,JY,JX),ZNO2H2(JZ,JY,JX),OQCH2(0:4,JZ,JY,JX) + 6,OQNH2(0:4,JZ,JY,JX),OQPH2(0:4,JZ,JY,JX),OQAH2(0:4,JZ,JY,JX) + 7,TOCFHS(0:4,JZ,JY,JX),TONFHS(0:4,JZ,JY,JX),TOPFHS(0:4,JZ,JY,JX) + 8,TOAFHS(0:4,JZ,JY,JX),TCOFHS(JZ,JY,JX),TCHFHS(JZ,JY,JX) + 9,TOXFHS(JZ,JY,JX),TNGFHS(JZ,JY,JX),TN2FHS(JZ,JY,JX) + 1,TN4FHW(JZ,JY,JX),TN3FHW(JZ,JY,JX),TNOFHW(JZ,JY,JX) + 2,TH2PHS(JZ,JY,JX),TN4FHB(JZ,JY,JX),TN3FHB(JZ,JY,JX) + 3,TNOFHB(JZ,JY,JX),TH2BHB(JZ,JY,JX),TNXFHS(JZ,JY,JX) + 4,ZNO2B2(JZ,JY,JX),ZN2BH2(JZ,JY,JX),TNXFLB(JZ,JY,JX) + 5,TNXFHB(JZ,JY,JX),H1P4H2(JZ,JY,JX),H1PBH2(JZ,JY,JX) + 6,TH1PHS(JZ,JY,JX),TH1BHB(JZ,JY,JX) + DIMENSION RCOFLZ(JZ,JY,JX),RCHFLZ(JZ,JY,JX) + 1,ROXFLZ(JZ,JY,JX),RNGFLZ(JZ,JY,JX) + 2,RN2FLZ(JZ,JY,JX),RN4FLZ(JZ,JY,JX),RN3FLZ(JZ,JY,JX) + 3,RNOFLZ(JZ,JY,JX),RH2PFZ(JZ,JY,JX),RN4FBZ(JZ,JY,JX) + 4,RN3FBZ(JZ,JY,JX),RNOFBZ(JZ,JY,JX),RH2BBZ(JZ,JY,JX) + 5,RH1PFZ(JZ,JY,JX),RH1BBZ(JZ,JY,JX) + DIMENSION ROCFXS(0:4,JZ,JY,JX),RONFXS(0:4,JZ,JY,JX) + 1,ROPFXS(0:4,JZ,JY,JX),ROAFXS(0:4,JZ,JY,JX),RCOFXS(JZ,JY,JX) + 2,RCHFXS(JZ,JY,JX),ROXFXS(JZ,JY,JX) + 3,RNGFXS(JZ,JY,JX),RN2FXS(JZ,JY,JX),RN4FXW(JZ,JY,JX) + 4,RN3FXW(JZ,JY,JX),RNOFXW(JZ,JY,JX),RH2PXS(JZ,JY,JX) + 5,RN4FXB(JZ,JY,JX),RN3FXB(JZ,JY,JX),RNOFXB(JZ,JY,JX) + 6,RH2BXB(JZ,JY,JX),RNXFXS(JZ,JY,JX),RNXFXB(JZ,JY,JX) + 7,RH1PXS(JZ,JY,JX),RH1BXB(JZ,JY,JX) + DIMENSION RFLOC(0:4),RFLON(0:4),RFLOP(0:4),RFLOA(0:4) + 2,RFHOC(0:4),RFHON(0:4),RFHOP(0:4),RFHOA(0:4) ,COQC1(0:4) + 3,COQC2(0:4),COQN1(0:4),COQN2(0:4),COQP1(0:4),COQP2(0:4) + 4,COQA1(0:4),COQA2(0:4),COQCH1(0:4),COQCH2(0:4) + 3,COQNH1(0:4),COQNH2(0:4),COQPH1(0:4),COQPH2(0:4) + 4,COQAH1(0:4),COQAH2(0:4),DFVOC(0:4),DFVON(0:4),DFVOP(0:4) + 5,DFVOA(0:4),DFHOC(0:4),DFHON(0:4),DFHOP(0:4),DFHOA(0:4) + DIMENSION THETW1(0:JZ,JY,JX) + 2,DCO2G(3,JZ,JY,JX),DCH4G(3,JZ,JY,JX) + 3,DOXYG(3,JZ,JY,JX),DZ2GG(3,JZ,JY,JX),DZ2OG(3,JZ,JY,JX) + 4,DNH3G(3,JZ,JY,JX),VOLWCO(0:JZ,JY,JX),VOLWCH(0:JZ,JY,JX) + 5,VOLWOX(0:JZ,JY,JX),VOLWNG(0:JZ,JY,JX),VOLWN2(0:JZ,JY,JX) + 6,VOLWN3(0:JZ,JY,JX),VOLWNB(0:JZ,JY,JX),VOLWHG(0:JZ,JY,JX) + 7,H2GG2(JZ,JY,JX),H2GS2(0:JZ,JY,JX),H2GSH2(JZ,JY,JX) + 8,HGSGL2(JZ,JY,JX),DH2GG(3,JZ,JY,JX),RHGFXS(JZ,JY,JX) + 2,RHGFLZ(JZ,JY,JX),RHGFLG(3,JD,JV,JH),THGFLS(JZ,JY,JX) + 3,THGFHS(JZ,JY,JX),RHGDFG(0:JZ,JY,JX),FLQM(3,JD,JV,JH) + 4,RHGFHS(3,JD,JV,JH),THGFLG(JZ,JY,JX),FLVM(JZ,JY,JX) + 5,THETH2(JZ,JY,JX),THETHL(JZ,JY,JX),VOLPMA(JZ,JY,JX) + 6,VOLPMB(JZ,JY,JX),VOLWMA(JZ,JY,JX),VOLWMB(JZ,JY,JX) + 7,VOLWXA(0:JZ,JY,JX),VOLWXB(JZ,JY,JX),PARGCO(JY,JX) + 8,PARGCH(JY,JX),PARGOX(JY,JX),PARGNG(JY,JX) + 9,PARGN2(JY,JX),PARGN3(JY,JX),PARGH2(JY,JX) + DIMENSION ROCFL0(0:2,JY,JX),RONFL0(0:2,JY,JX),ROPFL0(0:2,JY,JX) + 2,ROAFL0(0:2,JY,JX),ROCFL1(0:2,JY,JX),RONFL1(0:2,JY,JX) + 3,ROPFL1(0:2,JY,JX),ROAFL1(0:2,JY,JX),RCOFL0(JY,JX),RCHFL0(JY,JX) + 4,ROXFL0(JY,JX),RNGFL0(JY,JX),RN2FL0(JY,JX),RHGFL0(JY,JX) + 5,RN4FL0(JY,JX),RN3FL0(JY,JX),RNOFL0(JY,JX),RNXFL0(JY,JX) + 6,RH2PF0(JY,JX),RCOFL1(JY,JX),RCHFL1(JY,JX),ROXFL1(JY,JX) + 7,RNGFL1(JY,JX),RN2FL1(JY,JX),RHGFL1(JY,JX),RN4FL1(JY,JX) + 8,RN3FL1(JY,JX),RNOFL1(JY,JX),RNXFL1(JY,JX),RH2PF1(JY,JX) + 9,RN4FL2(JY,JX),RN3FL2(JY,JX),RNOFL2(JY,JX),RNXFL2(JY,JX) + 1,RH2BF2(JY,JX),RH1PF0(JY,JX),RH1PF1(JY,JX),RH1BF2(JY,JX) + DIMENSION VOLCOR(JY,JX),VOLCHR(JY,JX),VOLOXR(JY,JX),VOLNGR(JY,JX) + 2,VOLN2R(JY,JX),VOLN3R(JY,JX),VOLHGR(JY,JX),VOLCOT(JY,JX) + 3,VOLCHT(JY,JX),VOLOXT(JY,JX),VOLNGT(JY,JX),VOLN2T(JY,JX) + 4,VOLN3T(JY,JX),VOLNBT(JY,JX),VOLHGT(JY,JX) + PARAMETER(DPN4=5.7E-07,XFRX=0.5,XFRS=0.05) + REAL*4 CCO2SQ,CCH4SQ,COXYSQ,CZ2GSQ,CZ2OSQ,CNH3SQ + 2,CNH3BQ,CH2GSQ +C +C TIME STEPS FOR SOLUTE AND GAS FLUX CALCULATIONS +C + XNPX=1.0*XNPH + DO 9995 NX=NHW,NHE + DO 9990 NY=NVN,NVS +C +C GAS AND SOLUTE SINKS AND SOURCES IN SURFACE RESIDUE FROM MICROBIAL +C TRANSFORMATIONS IN 'NITRO' + ROOT EXCHANGE IN 'EXTRACT' +C + EQUILIBRIA REACTIONS IN 'SOLUTE' AT SUB-HOURLY TIME STEP +C + RCOSK2(0,NY,NX)=RCO2O(0,NY,NX)*XNPG + RCHSK2(0,NY,NX)=RCH4O(0,NY,NX)*XNPG + RNGSK2(0,NY,NX)=(RN2G(0,NY,NX)+XN2GS(0,NY,NX))*XNPG + 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 + 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 + ROASK2(K,0,NY,NX)=-XOQAS(K,0,NY,NX)*XNPH +14 CONTINUE + RN4SK2(0,NY,NX)=(-XNH4S(0,NY,NX)-TRN4S(0,NY,NX))*XNPH + RN3SK2(0,NY,NX)=-TRN3S(0,NY,NX)*XNPH + RNOSK2(0,NY,NX)=(-XNO3S(0,NY,NX)-TRNO3(0,NY,NX))*XNPH + RNXSK2(0,NY,NX)=(-XNO2S(0,NY,NX)-TRNO2(0,NY,NX))*XNPH + RHPSK2(0,NY,NX)=(-XH2PS(0,NY,NX)-TRH2P(0,NY,NX))*XNPH + R1PSK2(0,NY,NX)=(-XH1PS(0,NY,NX)-TRH1P(0,NY,NX))*XNPH + CO2S2(0,NY,NX)=CO2S(0,NY,NX) + CH4S2(0,NY,NX)=CH4S(0,NY,NX) + OXYS2(0,NY,NX)=OXYS(0,NY,NX) + 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 + 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) + OQA2(K,0,NY,NX)=OQA(K,0,NY,NX)-XOQAS(K,0,NY,NX) +9979 CONTINUE + ZNH4S2(0,NY,NX)=ZNH4S(0,NY,NX) + ZN3S2(0,NY,NX)=ZNH3S(0,NY,NX) + ZNO3S2(0,NY,NX)=ZNO3S(0,NY,NX) + ZNO2S2(0,NY,NX)=ZNO2S(0,NY,NX) + H1PO42(0,NY,NX)=H1PO4(0,NY,NX) + H2PO42(0,NY,NX)=H2PO4(0,NY,NX) + CHY0(0,NY,NX)=10.0**(-(PH(0,NY,NX)-3.0)) +C +C SURFACE SOLUTE FLUXES FROM ATMOSPHERE +C + DO 8855 K=0,4 + IF(K.LE.2)THEN + XOCFLS(K,3,0,NY,NX)=0.0 + XONFLS(K,3,0,NY,NX)=0.0 + XOPFLS(K,3,0,NY,NX)=0.0 + XOAFLS(K,3,0,NY,NX)=0.0 + ENDIF + XOCFLS(K,3,NU(NY,NX),NY,NX)=0.0 + XONFLS(K,3,NU(NY,NX),NY,NX)=0.0 + XOPFLS(K,3,NU(NY,NX),NY,NX)=0.0 + XOAFLS(K,3,NU(NY,NX),NY,NX)=0.0 + XOCFHS(K,3,NU(NY,NX),NY,NX)=0.0 + XONFHS(K,3,NU(NY,NX),NY,NX)=0.0 + XOPFHS(K,3,NU(NY,NX),NY,NX)=0.0 + XOAFHS(K,3,NU(NY,NX),NY,NX)=0.0 +8855 CONTINUE +C +C HOURLY SOLUTE FLUXES FROM ATMOSPHERE TO SNOWPACK +C IN SNOWFALL AND IRRIGATION ACCORDING TO CONCENTRATIONS +C ENTERED IN WEATHER AND IRRIGATION FILES +C + IF(PRECW(NY,NX).GT.0.0.OR.(PRECR(NY,NX).GT.0.0 + 2.AND.VHCPW(NY,NX).GT.VHCPWX(NY,NX)))THEN + XCOBLS(NY,NX)=FLQGQ(NY,NX)*CCOR(NY,NX)+FLQGI(NY,NX)*CCOQ(NY,NX) + XCHBLS(NY,NX)=FLQGQ(NY,NX)*CCHR(NY,NX)+FLQGI(NY,NX)*CCHQ(NY,NX) + XOXBLS(NY,NX)=FLQGQ(NY,NX)*COXR(NY,NX)+FLQGI(NY,NX)*COXQ(NY,NX) + XNGBLS(NY,NX)=FLQGQ(NY,NX)*CNNR(NY,NX)+FLQGI(NY,NX)*CNNQ(NY,NX) + XN2BLS(NY,NX)=FLQGQ(NY,NX)*CN2R(NY,NX)+FLQGI(NY,NX)*CN2Q(NY,NX) + XHGBLS(NY,NX)=0.0 + XN4BLW(NY,NX)=(FLQGQ(NY,NX)*CN4R(NY,NX)+FLQGI(NY,NX) + 2*CN4Q(I,NY,NX))*14.0 + XN3BLW(NY,NX)=(FLQGQ(NY,NX)*CN3R(NY,NX)+FLQGI(NY,NX) + 2*CN3Q(I,NY,NX))*14.0 + XNOBLW(NY,NX)=(FLQGQ(NY,NX)*CNOR(NY,NX)+FLQGI(NY,NX) + 2*CNOQ(I,NY,NX))*14.0 + XH1PBS(NY,NX)=(FLQGQ(NY,NX)*CH1PR(NY,NX)+FLQGI(NY,NX) + 2*CH1PQ(I,NY,NX))*31.0 + XH2PBS(NY,NX)=(FLQGQ(NY,NX)*CPOR(NY,NX)+FLQGI(NY,NX) + 2*CPOQ(I,NY,NX))*31.0 +C +C HOURLY SOLUTE FLUXES FROM ATMOSPHERE TO SOIL SURFACE +C IF RAINFALL AND IRRIGATION IS ZERO IF SNOWPACK IS PRESENT +C + XCOFLS(3,0,NY,NX)=0.0 + XCHFLS(3,0,NY,NX)=0.0 + XOXFLS(3,0,NY,NX)=0.0 + XNGFLS(3,0,NY,NX)=0.0 + XN2FLS(3,0,NY,NX)=0.0 + XHGFLS(3,0,NY,NX)=0.0 + XN4FLW(3,0,NY,NX)=0.0 + XN3FLW(3,0,NY,NX)=0.0 + XNOFLW(3,0,NY,NX)=0.0 + XNXFLS(3,0,NY,NX)=0.0 + XH1PFS(3,0,NY,NX)=0.0 + XH2PFS(3,0,NY,NX)=0.0 + XCOFLS(3,NU(NY,NX),NY,NX)=0.0 + XCHFLS(3,NU(NY,NX),NY,NX)=0.0 + XOXFLS(3,NU(NY,NX),NY,NX)=0.0 + XNGFLS(3,NU(NY,NX),NY,NX)=0.0 + XN2FLS(3,NU(NY,NX),NY,NX)=0.0 + XHGFLS(3,NU(NY,NX),NY,NX)=0.0 + XN4FLW(3,NU(NY,NX),NY,NX)=0.0 + XN3FLW(3,NU(NY,NX),NY,NX)=0.0 + XNOFLW(3,NU(NY,NX),NY,NX)=0.0 + XNXFLS(3,NU(NY,NX),NY,NX)=0.0 + XH1PFS(3,NU(NY,NX),NY,NX)=0.0 + XH2PFS(3,NU(NY,NX),NY,NX)=0.0 + XN4FLB(3,NU(NY,NX),NY,NX)=0.0 + XN3FLB(3,NU(NY,NX),NY,NX)=0.0 + XNOFLB(3,NU(NY,NX),NY,NX)=0.0 + XNXFLB(3,NU(NY,NX),NY,NX)=0.0 + XH1BFB(3,NU(NY,NX),NY,NX)=0.0 + XH2BFB(3,NU(NY,NX),NY,NX)=0.0 +C +C HOURLY SOLUTE FLUXES FROM ATMOSPHERE TO SOIL SURFACE +C IN RAINFALL AND IRRIGATION ACCORDING TO CONCENTRATIONS +C ENTERED IN WEATHER AND IRRIGATION FILES +C + ELSEIF((PRECQ(NY,NX).GT.0.0.OR.PRECI(NY,NX).GT.0.0) + 2.AND.VHCPW(NY,NX).LE.VHCPWX(NY,NX))THEN +C +C HOURLY SOLUTE FLUXES FROM ATMOSPHERE TO SNOWPACK +C IF SNOWFALL AND IRRIGATION IS ZERO AND SNOWPACK IS ABSENT +C + XCOBLS(NY,NX)=0.0 + XCHBLS(NY,NX)=0.0 + XOXBLS(NY,NX)=0.0 + XNGBLS(NY,NX)=0.0 + XN2BLS(NY,NX)=0.0 + XHGBLS(NY,NX)=0.0 + XN4BLW(NY,NX)=0.0 + XN3BLW(NY,NX)=0.0 + XNOBLW(NY,NX)=0.0 + XH1PBS(NY,NX)=0.0 + XH2PBS(NY,NX)=0.0 + XCOFLS(3,0,NY,NX)=FLQRQ(NY,NX)*CCOR(NY,NX) + 2+FLQRI(NY,NX)*CCOQ(NY,NX) + XCHFLS(3,0,NY,NX)=FLQRQ(NY,NX)*CCHR(NY,NX) + 2+FLQRI(NY,NX)*CCHQ(NY,NX) + XOXFLS(3,0,NY,NX)=FLQRQ(NY,NX)*COXR(NY,NX) + 2+FLQRI(NY,NX)*COXQ(NY,NX) + XNGFLS(3,0,NY,NX)=FLQRQ(NY,NX)*CNNR(NY,NX) + 2+FLQRI(NY,NX)*CNNQ(NY,NX) + XN2FLS(3,0,NY,NX)=FLQRQ(NY,NX)*CN2R(NY,NX) + 2+FLQRI(NY,NX)*CN2Q(NY,NX) + XHGFLS(3,0,NY,NX)=0.0 + XN4FLW(3,0,NY,NX)=(FLQRQ(NY,NX)*CN4R(NY,NX)+FLQRI(NY,NX) + 2*CN4Q(I,NY,NX))*14.0 + XN3FLW(3,0,NY,NX)=(FLQRQ(NY,NX)*CN3R(NY,NX)+FLQRI(NY,NX) + 2*CN3Q(I,NY,NX))*14.0 + XNOFLW(3,0,NY,NX)=(FLQRQ(NY,NX)*CNOR(NY,NX)+FLQRI(NY,NX) + 2*CNOQ(I,NY,NX))*14.0 + XNXFLS(3,0,NY,NX)=0.0 + XH1PFS(3,0,NY,NX)=(FLQRQ(NY,NX)*CH1PR(NY,NX)+FLQRI(NY,NX) + 2*CH1PQ(I,NY,NX))*31.0 + XH2PFS(3,0,NY,NX)=(FLQRQ(NY,NX)*CPOR(NY,NX)+FLQRI(NY,NX) + 2*CPOQ(I,NY,NX))*31.0 + XCOFLS(3,NU(NY,NX),NY,NX)=FLQGQ(NY,NX)*CCOR(NY,NX) + 2+FLQGI(NY,NX)*CCOQ(NY,NX) + XCHFLS(3,NU(NY,NX),NY,NX)=FLQGQ(NY,NX)*CCHR(NY,NX) + 2+FLQGI(NY,NX)*CCHQ(NY,NX) + XOXFLS(3,NU(NY,NX),NY,NX)=FLQGQ(NY,NX)*COXR(NY,NX) + 2+FLQGI(NY,NX)*COXQ(NY,NX) + XNGFLS(3,NU(NY,NX),NY,NX)=FLQGQ(NY,NX)*CNNR(NY,NX) + 2+FLQGI(NY,NX)*CNNQ(NY,NX) + XN2FLS(3,NU(NY,NX),NY,NX)=FLQGQ(NY,NX)*CN2R(NY,NX) + 2+FLQGI(NY,NX)*CN2Q(NY,NX) + XHGFLS(3,NU(NY,NX),NY,NX)=0.0 + XN4FLW(3,NU(NY,NX),NY,NX)=((FLQGQ(NY,NX)*CN4R(NY,NX) + 2+FLQGI(NY,NX)*CN4Q(I,NY,NX))*14.0)*VLNH4(NU(NY,NX),NY,NX) + XN3FLW(3,NU(NY,NX),NY,NX)=((FLQGQ(NY,NX)*CN3R(NY,NX) + 2+FLQGI(NY,NX)*CN3Q(I,NY,NX))*14.0)*VLNH4(NU(NY,NX),NY,NX) + XNOFLW(3,NU(NY,NX),NY,NX)=((FLQGQ(NY,NX)*CNOR(NY,NX) + 2+FLQGI(NY,NX)*CNOQ(I,NY,NX))*14.0)*VLNO3(NU(NY,NX),NY,NX) + XNXFLS(3,NU(NY,NX),NY,NX)=0.0 + XH1PFS(3,NU(NY,NX),NY,NX)=((FLQGQ(NY,NX)*CH1PR(NY,NX) + 2+FLQGI(NY,NX)*CH1PQ(I,NY,NX))*31.0)*VLPO4(NU(NY,NX),NY,NX) + XH2PFS(3,NU(NY,NX),NY,NX)=((FLQGQ(NY,NX)*CPOR(NY,NX) + 2+FLQGI(NY,NX)*CPOQ(I,NY,NX))*31.0)*VLPO4(NU(NY,NX),NY,NX) + XN4FLB(3,NU(NY,NX),NY,NX)=((FLQGQ(NY,NX)*CN4R(NY,NX) + 2+FLQGI(NY,NX)*CN4Q(I,NY,NX))*14.0)*VLNHB(NU(NY,NX),NY,NX) + XN3FLB(3,NU(NY,NX),NY,NX)=((FLQGQ(NY,NX)*CN3R(NY,NX) + 2+FLQGI(NY,NX)*CN3Q(I,NY,NX))*14.0)*VLNHB(NU(NY,NX),NY,NX) + XNOFLB(3,NU(NY,NX),NY,NX)=((FLQGQ(NY,NX)*CNOR(NY,NX) + 2+FLQGI(NY,NX)*CNOQ(I,NY,NX))*14.0)*VLNOB(NU(NY,NX),NY,NX) + XNXFLB(3,NU(NY,NX),NY,NX)=0.0 + XH1BFB(3,NU(NY,NX),NY,NX)=((FLQGQ(NY,NX)*CH1PR(NY,NX) + 2+FLQGI(NY,NX)*CH1PQ(I,NY,NX))*31.0)*VLPOB(NU(NY,NX),NY,NX) + XH2BFB(3,NU(NY,NX),NY,NX)=((FLQGQ(NY,NX)*CPOR(NY,NX) + 2+FLQGI(NY,NX)*CPOQ(I,NY,NX))*31.0)*VLPOB(NU(NY,NX),NY,NX) +C +C NO SOLUTE FLUXES FROM ATMOSPHERE +C + ELSE + XCOBLS(NY,NX)=0.0 + XCHBLS(NY,NX)=0.0 + XOXBLS(NY,NX)=0.0 + XNGBLS(NY,NX)=0.0 + XN2BLS(NY,NX)=0.0 + XHGBLS(NY,NX)=0.0 + XN4BLW(NY,NX)=0.0 + XN3BLW(NY,NX)=0.0 + XNOBLW(NY,NX)=0.0 + XH1PBS(NY,NX)=0.0 + XH2PBS(NY,NX)=0.0 + XCOFLS(3,0,NY,NX)=0.0 + XCHFLS(3,0,NY,NX)=0.0 + XOXFLS(3,0,NY,NX)=0.0 + XNGFLS(3,0,NY,NX)=0.0 + XN2FLS(3,0,NY,NX)=0.0 + XHGFLS(3,0,NY,NX)=0.0 + XN4FLW(3,0,NY,NX)=0.0 + XN3FLW(3,0,NY,NX)=0.0 + XNOFLW(3,0,NY,NX)=0.0 + XNXFLS(3,0,NY,NX)=0.0 + XH1PFS(3,0,NY,NX)=0.0 + XH2PFS(3,0,NY,NX)=0.0 + XCOFLS(3,NU(NY,NX),NY,NX)=0.0 + XCHFLS(3,NU(NY,NX),NY,NX)=0.0 + XOXFLS(3,NU(NY,NX),NY,NX)=0.0 + XNGFLS(3,NU(NY,NX),NY,NX)=0.0 + XN2FLS(3,NU(NY,NX),NY,NX)=0.0 + XHGFLS(3,NU(NY,NX),NY,NX)=0.0 + XN4FLW(3,NU(NY,NX),NY,NX)=0.0 + XN3FLW(3,NU(NY,NX),NY,NX)=0.0 + XNOFLW(3,NU(NY,NX),NY,NX)=0.0 + XNXFLS(3,NU(NY,NX),NY,NX)=0.0 + XH1PFS(3,NU(NY,NX),NY,NX)=0.0 + XH2PFS(3,NU(NY,NX),NY,NX)=0.0 + XN4FLB(3,NU(NY,NX),NY,NX)=0.0 + XN3FLB(3,NU(NY,NX),NY,NX)=0.0 + XNOFLB(3,NU(NY,NX),NY,NX)=0.0 + XNXFLB(3,NU(NY,NX),NY,NX)=0.0 + XH1BFB(3,NU(NY,NX),NY,NX)=0.0 + XH2BFB(3,NU(NY,NX),NY,NX)=0.0 + ENDIF +C +C HOURLY SOLUTE FLUXES FROM MELTING SNOWPACK TO +C RESIDUE AND SOIL SURFACE FROM SNOWMELT IN 'WATSUB' AND +C CONCENTRATIONS IN SNOWPACK +C + FLQTM=FLQGM(NY,NX)+FLQRM(NY,NX) + IF(FLQTM.GT.ZEROS(NY,NX))THEN + VOLWW=VOLWS(NY,NX)+VOLSS(NY,NX)+VOLIS(NY,NX)*DENSI + IF(VOLWW.GT.ZEROS(NY,NX))THEN + VFLWW=AMAX1(0.0,AMIN1(1.0,FLQTM/VOLWW)) + ELSE + VFLWW=1.0 + ENDIF + VFLWG=VFLWW*FLQGM(NY,NX)/FLQTM + VFLWR=VFLWW*FLQRM(NY,NX)/FLQTM + XCOBLS(NY,NX)=XCOBLS(NY,NX)-CO2W(NY,NX)*VFLWW + XCHBLS(NY,NX)=XCHBLS(NY,NX)-CH4W(NY,NX)*VFLWW + XOXBLS(NY,NX)=XOXBLS(NY,NX)-OXYW(NY,NX)*VFLWW + XNGBLS(NY,NX)=XNGBLS(NY,NX)-ZNGW(NY,NX)*VFLWW + XN2BLS(NY,NX)=XN2BLS(NY,NX)-ZN2W(NY,NX)*VFLWW + XN4BLW(NY,NX)=XN4BLW(NY,NX)-ZN4W(NY,NX)*VFLWW + XN3BLW(NY,NX)=XN3BLW(NY,NX)-ZN3W(NY,NX)*VFLWW + XNOBLW(NY,NX)=XNOBLW(NY,NX)-ZNOW(NY,NX)*VFLWW + XH1PBS(NY,NX)=XH1PBS(NY,NX)-Z1PW(NY,NX)*VFLWW + XH2PBS(NY,NX)=XH2PBS(NY,NX)-ZHPW(NY,NX)*VFLWW + XCOFLS(3,0,NY,NX)=XCOFLS(3,0,NY,NX)+CO2W(NY,NX)*VFLWR + XCHFLS(3,0,NY,NX)=XCHFLS(3,0,NY,NX)+CH4W(NY,NX)*VFLWR + XOXFLS(3,0,NY,NX)=XOXFLS(3,0,NY,NX)+OXYW(NY,NX)*VFLWR + XNGFLS(3,0,NY,NX)=XNGFLS(3,0,NY,NX)+ZNGW(NY,NX)*VFLWR + XN2FLS(3,0,NY,NX)=XN2FLS(3,0,NY,NX)+ZN2W(NY,NX)*VFLWR + XN4FLW(3,0,NY,NX)=XN4FLW(3,0,NY,NX)+ZN4W(NY,NX)*VFLWR + XN3FLW(3,0,NY,NX)=XN3FLW(3,0,NY,NX)+ZN3W(NY,NX)*VFLWR + XNOFLW(3,0,NY,NX)=XNOFLW(3,0,NY,NX)+ZNOW(NY,NX)*VFLWR + XH1PFS(3,0,NY,NX)=XH1PFS(3,0,NY,NX)+Z1PW(NY,NX)*VFLWR + XH2PFS(3,0,NY,NX)=XH2PFS(3,0,NY,NX)+ZHPW(NY,NX)*VFLWR + XCOFLS(3,NU(NY,NX),NY,NX)=XCOFLS(3,NU(NY,NX),NY,NX) + 2+CO2W(NY,NX)*VFLWG + XCHFLS(3,NU(NY,NX),NY,NX)=XCHFLS(3,NU(NY,NX),NY,NX) + 2+CH4W(NY,NX)*VFLWG + XOXFLS(3,NU(NY,NX),NY,NX)=XOXFLS(3,NU(NY,NX),NY,NX) + 2+OXYW(NY,NX)*VFLWG + XNGFLS(3,NU(NY,NX),NY,NX)=XNGFLS(3,NU(NY,NX),NY,NX) + 2+ZNGW(NY,NX)*VFLWG + XN2FLS(3,NU(NY,NX),NY,NX)=XN2FLS(3,NU(NY,NX),NY,NX) + 2+ZN2W(NY,NX)*VFLWG + XN4FLW(3,NU(NY,NX),NY,NX)=XN4FLW(3,NU(NY,NX),NY,NX) + 2+ZN4W(NY,NX)*VFLWG*VLNH4(NU(NY,NX),NY,NX) + XN3FLW(3,NU(NY,NX),NY,NX)=XN3FLW(3,NU(NY,NX),NY,NX) + 2+ZN3W(NY,NX)*VFLWG*VLNH4(NU(NY,NX),NY,NX) + XNOFLW(3,NU(NY,NX),NY,NX)=XNOFLW(3,NU(NY,NX),NY,NX) + 2+ZNOW(NY,NX)*VFLWG*VLNO3(NU(NY,NX),NY,NX) + XH1PFS(3,NU(NY,NX),NY,NX)=XH1PFS(3,NU(NY,NX),NY,NX) + 2+Z1PW(NY,NX)*VFLWG*VLPO4(NU(NY,NX),NY,NX) + XH2PFS(3,NU(NY,NX),NY,NX)=XH2PFS(3,NU(NY,NX),NY,NX) + 2+ZHPW(NY,NX)*VFLWG*VLPO4(NU(NY,NX),NY,NX) + XN4FLB(3,NU(NY,NX),NY,NX)=XN4FLB(3,NU(NY,NX),NY,NX) + 2+ZN4W(NY,NX)*VFLWG*VLNHB(NU(NY,NX),NY,NX) + XN3FLB(3,NU(NY,NX),NY,NX)=XN3FLB(3,NU(NY,NX),NY,NX) + 2+ZN3W(NY,NX)*VFLWG*VLNHB(NU(NY,NX),NY,NX) + XNOFLB(3,NU(NY,NX),NY,NX)=XNOFLB(3,NU(NY,NX),NY,NX) + 2+ZNOW(NY,NX)*VFLWG*VLNOB(NU(NY,NX),NY,NX) + XH1BFB(3,NU(NY,NX),NY,NX)=XH1BFB(3,NU(NY,NX),NY,NX) + 2+Z1PW(NY,NX)*VFLWG*VLPOB(NU(NY,NX),NY,NX) + XH2BFB(3,NU(NY,NX),NY,NX)=XH2BFB(3,NU(NY,NX),NY,NX) + 2+ZHPW(NY,NX)*VFLWG*VLPOB(NU(NY,NX),NY,NX) + ENDIF + XCOFHS(3,NU(NY,NX),NY,NX)=0.0 + XCHFHS(3,NU(NY,NX),NY,NX)=0.0 + XOXFHS(3,NU(NY,NX),NY,NX)=0.0 + XNGFHS(3,NU(NY,NX),NY,NX)=0.0 + XN2FHS(3,NU(NY,NX),NY,NX)=0.0 + XHGFHS(3,NU(NY,NX),NY,NX)=0.0 + XN4FHW(3,NU(NY,NX),NY,NX)=0.0 + XN3FHW(3,NU(NY,NX),NY,NX)=0.0 + XNOFHW(3,NU(NY,NX),NY,NX)=0.0 + XH1PHS(3,NU(NY,NX),NY,NX)=0.0 + XH2PHS(3,NU(NY,NX),NY,NX)=0.0 + XN4FHB(3,NU(NY,NX),NY,NX)=0.0 + XN3FHB(3,NU(NY,NX),NY,NX)=0.0 + XNOFHB(3,NU(NY,NX),NY,NX)=0.0 + XNXFHB(3,NU(NY,NX),NY,NX)=0.0 + XH1BHB(3,NU(NY,NX),NY,NX)=0.0 + XH2BHB(3,NU(NY,NX),NY,NX)=0.0 + XNXFHS(3,NU(NY,NX),NY,NX)=0.0 + CO2W2(NY,NX)=CO2W(NY,NX)+XCOBLS(NY,NX) + CH4W2(NY,NX)=CH4W(NY,NX)+XCHBLS(NY,NX) + OXYW2(NY,NX)=OXYW(NY,NX)+XOXBLS(NY,NX) + ZNGW2(NY,NX)=ZNGW(NY,NX)+XNGBLS(NY,NX) + ZN2W2(NY,NX)=ZN2W(NY,NX)+XN2BLS(NY,NX) + ZN4W2(NY,NX)=ZN4W(NY,NX)+XN4BLW(NY,NX) + ZN3W2(NY,NX)=ZN3W(NY,NX)+XN3BLW(NY,NX) + ZNOW2(NY,NX)=ZNOW(NY,NX)+XNOBLW(NY,NX) + Z1PW2(NY,NX)=Z1PW(NY,NX)+XH1PBS(NY,NX) + ZHPW2(NY,NX)=ZHPW(NY,NX)+XH2PBS(NY,NX) +C +C GAS AND SOLUTE FLUXES AT SUB-HOURLY FLUX TIME STEP +C ENTERED IN SITE FILE +C + DO 9845 K=0,2 + ROCFL0(K,NY,NX)=XOCFLS(K,3,0,NY,NX)*XNPH + RONFL0(K,NY,NX)=XONFLS(K,3,0,NY,NX)*XNPH + ROPFL0(K,NY,NX)=XOPFLS(K,3,0,NY,NX)*XNPH + ROAFL0(K,NY,NX)=XOAFLS(K,3,0,NY,NX)*XNPH + ROCFL1(K,NY,NX)=XOCFLS(K,3,NU(NY,NX),NY,NX)*XNPH + RONFL1(K,NY,NX)=XONFLS(K,3,NU(NY,NX),NY,NX)*XNPH + ROPFL1(K,NY,NX)=XOPFLS(K,3,NU(NY,NX),NY,NX)*XNPH + ROAFL1(K,NY,NX)=XOAFLS(K,3,NU(NY,NX),NY,NX)*XNPH +9845 CONTINUE + RCOFL0(NY,NX)=XCOFLS(3,0,NY,NX)*XNPH + RCHFL0(NY,NX)=XCHFLS(3,0,NY,NX)*XNPH + ROXFL0(NY,NX)=XOXFLS(3,0,NY,NX)*XNPH + RNGFL0(NY,NX)=XNGFLS(3,0,NY,NX)*XNPH + RN2FL0(NY,NX)=XN2FLS(3,0,NY,NX)*XNPH + RHGFL0(NY,NX)=XHGFLS(3,0,NY,NX)*XNPH + RN4FL0(NY,NX)=XN4FLW(3,0,NY,NX)*XNPH + RN3FL0(NY,NX)=XN3FLW(3,0,NY,NX)*XNPH + RNOFL0(NY,NX)=XNOFLW(3,0,NY,NX)*XNPH + RNXFL0(NY,NX)=XNXFLS(3,0,NY,NX)*XNPH + RH1PF0(NY,NX)=XH1PFS(3,0,NY,NX)*XNPH + RH2PF0(NY,NX)=XH2PFS(3,0,NY,NX)*XNPH + RCOFL1(NY,NX)=XCOFLS(3,NU(NY,NX),NY,NX)*XNPH + RCHFL1(NY,NX)=XCHFLS(3,NU(NY,NX),NY,NX)*XNPH + ROXFL1(NY,NX)=XOXFLS(3,NU(NY,NX),NY,NX)*XNPH + RNGFL1(NY,NX)=XNGFLS(3,NU(NY,NX),NY,NX)*XNPH + RN2FL1(NY,NX)=XN2FLS(3,NU(NY,NX),NY,NX)*XNPH + RHGFL1(NY,NX)=XHGFLS(3,NU(NY,NX),NY,NX)*XNPH + RN4FL1(NY,NX)=XN4FLW(3,NU(NY,NX),NY,NX)*XNPH + RN3FL1(NY,NX)=XN3FLW(3,NU(NY,NX),NY,NX)*XNPH + RNOFL1(NY,NX)=XNOFLW(3,NU(NY,NX),NY,NX)*XNPH + RNXFL1(NY,NX)=XNXFLS(3,NU(NY,NX),NY,NX)*XNPH + RH1PF1(NY,NX)=XH1PFS(3,NU(NY,NX),NY,NX)*XNPH + RH2PF1(NY,NX)=XH2PFS(3,NU(NY,NX),NY,NX)*XNPH + RN4FL2(NY,NX)=XN4FLB(3,NU(NY,NX),NY,NX)*XNPH + RN3FL2(NY,NX)=XN3FLB(3,NU(NY,NX),NY,NX)*XNPH + RNOFL2(NY,NX)=XNOFLB(3,NU(NY,NX),NY,NX)*XNPH + RNXFL2(NY,NX)=XNXFLB(3,NU(NY,NX),NY,NX)*XNPH + RH1BF2(NY,NX)=XH1BFB(3,NU(NY,NX),NY,NX)*XNPH + RH2BF2(NY,NX)=XH2BFB(3,NU(NY,NX),NY,NX)*XNPH +C IF(I.EQ.118.AND.NX.EQ.3.AND.NY.EQ.4)THEN +C WRITE(*,6767)'ROXFL0',I,J,NX,NY,ROXFL0(NY,NX),XOXFLS(3,0,NY,NX) +C 2,OXYW(NY,NX),VFLWR +6767 FORMAT(A8,4I4,12E12.4) +C ENDIF +C +C GAS AND SOLUTE SINKS AND SOURCES IN SOIL LAYERS FROM MICROBIAL +C TRANSFORMATIONS IN 'NITRO' + ROOT EXCHANGE IN 'EXTRACT' +C + EQUILIBRIA REACTIONS IN 'SOLUTE' AT SUB-HOURLY TIME STEP +C + CLSGL2(0,NY,NX)=CLSGL(0,NY,NX)*XNPH + CQSGL2(0,NY,NX)=CQSGL(0,NY,NX)*XNPH + OLSGL2(0,NY,NX)=OLSGL(0,NY,NX)*XNPH + ZLSGL2(0,NY,NX)=ZLSGL(0,NY,NX)*XNPH + ZNSGL2(0,NY,NX)=ZNSGL(0,NY,NX)*XNPH + ZVSGL2(0,NY,NX)=ZVSGL(0,NY,NX)*XNPH + HLSGL2(0,NY,NX)=HLSGL(0,NY,NX)*XNPH + OCSGL2(0,NY,NX)=OCSGL(0,NY,NX)*XNPH + ONSGL2(0,NY,NX)=ONSGL(0,NY,NX)*XNPH + OPSGL2(0,NY,NX)=OPSGL(0,NY,NX)*XNPH + OASGL2(0,NY,NX)=OASGL(0,NY,NX)*XNPH + ZOSGL2(0,NY,NX)=ZOSGL(0,NY,NX)*XNPH + POSGL2(0,NY,NX)=POSGL(0,NY,NX)*XNPH + PARGM=PARG(NY,NX)*XNPT + PARGCO(NY,NX)=PARGM*0.74 + PARGCH(NY,NX)=PARGM*1.04 + PARGOX(NY,NX)=PARGM*0.83 + PARGNG(NY,NX)=PARGM*0.86 + PARGN2(NY,NX)=PARGM*0.74 + PARGN3(NY,NX)=PARGM*1.02 + PARGH2(NY,NX)=PARGM*2.08 + DO 10 L=NU(NY,NX),NL(NY,NX) + CHY0(L,NY,NX)=10.0**(-(PH(L,NY,NX)-3.0)) + FLWU(L,NY,NX)=TUPWTR(L,NY,NX)*XNPH + RCOSK2(L,NY,NX)=(RCO2O(L,NY,NX)+TCO2S(L,NY,NX)+TRCO2(L,NY,NX)) + 2*XNPG + RCHSK2(L,NY,NX)=(RCH4O(L,NY,NX)+TUPCHS(L,NY,NX))*XNPG + RNGSK2(L,NY,NX)=(RN2G(L,NY,NX)+XN2GS(L,NY,NX)+TUPNF(L,NY,NX)) + 2*XNPG + RN2SK2(L,NY,NX)=(RN2O(L,NY,NX)+TUPN2S(L,NY,NX))*XNPG + RNHSK2(L,NY,NX)=-TRN3G(L,NY,NX)*XNPG + RHGSK2(L,NY,NX)=(RH2GO(L,NY,NX)+TUPHGS(L,NY,NX))*XNPG + DO 15 K=0,4 + ROCSK2(K,L,NY,NX)=-XOQCS(K,L,NY,NX)*XNPH + RONSK2(K,L,NY,NX)=-XOQNS(K,L,NY,NX)*XNPH + ROPSK2(K,L,NY,NX)=-XOQPS(K,L,NY,NX)*XNPH + ROASK2(K,L,NY,NX)=-XOQAS(K,L,NY,NX)*XNPH +15 CONTINUE + RN4SK2(L,NY,NX)=(-XNH4S(L,NY,NX)-TRN4S(L,NY,NX) + 2+TUPNH4(L,NY,NX))*XNPH + RN3SK2(L,NY,NX)=(-TRN3S(L,NY,NX)+TUPN3S(L,NY,NX))*XNPH + RNOSK2(L,NY,NX)=(-XNO3S(L,NY,NX)-TRNO3(L,NY,NX) + 2+TUPNO3(L,NY,NX))*XNPH + RNXSK2(L,NY,NX)=(-XNO2S(L,NY,NX)-TRNO2(L,NY,NX))*XNPH + RHPSK2(L,NY,NX)=(-XH2PS(L,NY,NX)-TRH2P(L,NY,NX) + 2+TUPH2P(L,NY,NX))*XNPH + R1PSK2(L,NY,NX)=(-XH1PS(L,NY,NX)-TRH1P(L,NY,NX) + 2+TUPH1P(L,NY,NX))*XNPH + R4BSK2(L,NY,NX)=(-XNH4B(L,NY,NX)-TRN4B(L,NY,NX) + 2+TUPNHB(L,NY,NX))*XNPH + R3BSK2(L,NY,NX)=(-TRN3B(L,NY,NX)+TUPN3B(L,NY,NX))*XNPH + RNBSK2(L,NY,NX)=(-XNO3B(L,NY,NX)-TRNOB(L,NY,NX) + 2+TUPNOB(L,NY,NX))*XNPH + RNZSK2(L,NY,NX)=(-XNO2B(L,NY,NX)-TRN2B(L,NY,NX))*XNPH + RHBSK2(L,NY,NX)=(-XH2BS(L,NY,NX)-TRH2B(L,NY,NX) + 2+TUPH2B(L,NY,NX))*XNPH + R1BSK2(L,NY,NX)=(-XH1BS(L,NY,NX)-TRH1B(L,NY,NX) + 2+TUPH1B(L,NY,NX))*XNPH +C +C HOURLY SOLUTE FLUXES FROM SUBSURFACE IRRIGATION +C + RCOFLU(L,NY,NX)=FLU(L,NY,NX)*CCOQ(NY,NX) + RCHFLU(L,NY,NX)=FLU(L,NY,NX)*CCHQ(NY,NX) + ROXFLU(L,NY,NX)=FLU(L,NY,NX)*COXQ(NY,NX) + RNGFLU(L,NY,NX)=FLU(L,NY,NX)*CNNQ(NY,NX) + RN2FLU(L,NY,NX)=FLU(L,NY,NX)*CN2Q(NY,NX) + RHGFLU(L,NY,NX)=0.0 + RN4FLU(L,NY,NX)=FLU(L,NY,NX)*CN4Q(I,NY,NX)*VLNH4(L,NY,NX)*14.0 + RN3FLU(L,NY,NX)=FLU(L,NY,NX)*CN3Q(I,NY,NX)*VLNH4(L,NY,NX)*14.0 + RNOFLU(L,NY,NX)=FLU(L,NY,NX)*CNOQ(I,NY,NX)*VLNO3(L,NY,NX)*14.0 + RH1PFU(L,NY,NX)=FLU(L,NY,NX)*CH1PQ(I,NY,NX)*VLPO4(L,NY,NX)*31.0 + RH2PFU(L,NY,NX)=FLU(L,NY,NX)*CPOQ(I,NY,NX)*VLPO4(L,NY,NX)*31.0 + RN4FBU(L,NY,NX)=FLU(L,NY,NX)*CN4Q(I,NY,NX)*VLNHB(L,NY,NX)*14.0 + RN3FBU(L,NY,NX)=FLU(L,NY,NX)*CN3Q(I,NY,NX)*VLNHB(L,NY,NX)*14.0 + RNOFBU(L,NY,NX)=FLU(L,NY,NX)*CNOQ(I,NY,NX)*VLNOB(L,NY,NX)*14.0 + RH1BBU(L,NY,NX)=FLU(L,NY,NX)*CH1PQ(I,NY,NX)*VLPOB(L,NY,NX)*31.0 + RH2BBU(L,NY,NX)=FLU(L,NY,NX)*CPOQ(I,NY,NX)*VLPOB(L,NY,NX)*31.0 +C +C SUB-HOURLY SOLUTE FLUXES FROM SUBSURFACE IRRIGATION +C + RCOFLZ(L,NY,NX)=RCOFLU(L,NY,NX)*XNPH + RCHFLZ(L,NY,NX)=RCHFLU(L,NY,NX)*XNPH + ROXFLZ(L,NY,NX)=ROXFLU(L,NY,NX)*XNPH + RNGFLZ(L,NY,NX)=RNGFLU(L,NY,NX)*XNPH + RN2FLZ(L,NY,NX)=RN2FLU(L,NY,NX)*XNPH + RHGFLZ(L,NY,NX)=RHGFLU(L,NY,NX)*XNPH + RN4FLZ(L,NY,NX)=RN4FLU(L,NY,NX)*XNPH + RN3FLZ(L,NY,NX)=RN3FLU(L,NY,NX)*XNPH + RNOFLZ(L,NY,NX)=RNOFLU(L,NY,NX)*XNPH + RH1PFZ(L,NY,NX)=RH1PFU(L,NY,NX)*XNPH + RH2PFZ(L,NY,NX)=RH2PFU(L,NY,NX)*XNPH + RN4FBZ(L,NY,NX)=RN4FBU(L,NY,NX)*XNPH + RN3FBZ(L,NY,NX)=RN3FBU(L,NY,NX)*XNPH + RNOFBZ(L,NY,NX)=RNOFBU(L,NY,NX)*XNPH + RH1BBZ(L,NY,NX)=RH1BBU(L,NY,NX)*XNPH + RH2BBZ(L,NY,NX)=RH2BBU(L,NY,NX)*XNPH +C +C GAS AND SOLUTE DIFFUSIVITIES AT SUB-HOURLY TIME STEP +C + OCSGL2(L,NY,NX)=OCSGL(L,NY,NX)*XNPH + ONSGL2(L,NY,NX)=ONSGL(L,NY,NX)*XNPH + OPSGL2(L,NY,NX)=OPSGL(L,NY,NX)*XNPH + OASGL2(L,NY,NX)=OASGL(L,NY,NX)*XNPH + CLSGL2(L,NY,NX)=CLSGL(L,NY,NX)*XNPH + CQSGL2(L,NY,NX)=CQSGL(L,NY,NX)*XNPH + OLSGL2(L,NY,NX)=OLSGL(L,NY,NX)*XNPH + ZLSGL2(L,NY,NX)=ZLSGL(L,NY,NX)*XNPH + ZVSGL2(L,NY,NX)=ZVSGL(L,NY,NX)*XNPH + ZNSGL2(L,NY,NX)=ZNSGL(L,NY,NX)*XNPH + HLSGL2(L,NY,NX)=HLSGL(L,NY,NX)*XNPH + ZOSGL2(L,NY,NX)=ZOSGL(L,NY,NX)*XNPH + POSGL2(L,NY,NX)=POSGL(L,NY,NX)*XNPH + CGSGL2(L,NY,NX)=CGSGL(L,NY,NX)*XNPG + CHSGL2(L,NY,NX)=CHSGL(L,NY,NX)*XNPG + OGSGL2(L,NY,NX)=OGSGL(L,NY,NX)*XNPG + ZGSGL2(L,NY,NX)=ZGSGL(L,NY,NX)*XNPG + Z2SGL2(L,NY,NX)=Z2SGL(L,NY,NX)*XNPG + ZHSGL2(L,NY,NX)=ZHSGL(L,NY,NX)*XNPG + HGSGL2(L,NY,NX)=HGSGL(L,NY,NX)*XNPG +C +C STATE VARIABLES FOR GASES AND SOLUTES USED IN 'TRNSFR' +C TO STORE SUB-HOURLY CHANGES DURING FLUX CALCULATIONS +C INCLUDING TRANSFORMATIONS FROM 'NITRO', 'UPTAKE' AND 'SOLUTE' +C + CO2G2(L,NY,NX)=CO2G(L,NY,NX) + CH4G2(L,NY,NX)=CH4G(L,NY,NX) + OXYG2(L,NY,NX)=OXYG(L,NY,NX) + ZN3G2(L,NY,NX)=ZNH3G(L,NY,NX) + Z2GG2(L,NY,NX)=Z2GG(L,NY,NX) + Z2OG2(L,NY,NX)=Z2OG(L,NY,NX) + H2GG2(L,NY,NX)=H2GG(L,NY,NX) + CO2S2(L,NY,NX)=CO2S(L,NY,NX) + CH4S2(L,NY,NX)=CH4S(L,NY,NX) + OXYS2(L,NY,NX)=OXYS(L,NY,NX) + Z2GS2(L,NY,NX)=Z2GS(L,NY,NX) + Z2OS2(L,NY,NX)=Z2OS(L,NY,NX) + H2GS2(L,NY,NX)=H2GS(L,NY,NX) + DO 9980 K=0,4 + OQC2(K,L,NY,NX)=OQC(K,L,NY,NX)-XOQCS(K,L,NY,NX) + OQN2(K,L,NY,NX)=OQN(K,L,NY,NX)-XOQNS(K,L,NY,NX) + OQP2(K,L,NY,NX)=OQP(K,L,NY,NX)-XOQPS(K,L,NY,NX) + OQA2(K,L,NY,NX)=OQA(K,L,NY,NX)-XOQAS(K,L,NY,NX) + OQCH2(K,L,NY,NX)=OQCH(K,L,NY,NX) + OQNH2(K,L,NY,NX)=OQNH(K,L,NY,NX) + OQPH2(K,L,NY,NX)=OQPH(K,L,NY,NX) + OQAH2(K,L,NY,NX)=OQAH(K,L,NY,NX) +9980 CONTINUE + ZNH4S2(L,NY,NX)=ZNH4S(L,NY,NX) + ZN3S2(L,NY,NX)=ZNH3S(L,NY,NX) + ZNO3S2(L,NY,NX)=ZNO3S(L,NY,NX) + ZNO2S2(L,NY,NX)=ZNO2S(L,NY,NX) + H1PO42(L,NY,NX)=H1PO4(L,NY,NX) + H2PO42(L,NY,NX)=H2PO4(L,NY,NX) + ZNH4B2(L,NY,NX)=ZNH4B(L,NY,NX) + ZNBS2(L,NY,NX)=ZNH3B(L,NY,NX) + ZNO3B2(L,NY,NX)=ZNO3B(L,NY,NX) + ZNO2B2(L,NY,NX)=ZNO2B(L,NY,NX) + H2POB2(L,NY,NX)=H2POB(L,NY,NX) + CO2SH2(L,NY,NX)=CO2SH(L,NY,NX) + CH4SH2(L,NY,NX)=CH4SH(L,NY,NX) + OXYSH2(L,NY,NX)=OXYSH(L,NY,NX) + Z2GSH2(L,NY,NX)=Z2GSH(L,NY,NX) + Z2OSH2(L,NY,NX)=Z2OSH(L,NY,NX) + H2GSH2(L,NY,NX)=H2GSH(L,NY,NX) + ZNH4H2(L,NY,NX)=ZNH4SH(L,NY,NX) + ZNH3H2(L,NY,NX)=ZNH3SH(L,NY,NX) + ZNO3H2(L,NY,NX)=ZNO3SH(L,NY,NX) + ZNO2H2(L,NY,NX)=ZNO2SH(L,NY,NX) + H1P4H2(L,NY,NX)=H1PO4H(L,NY,NX) + H2P4H2(L,NY,NX)=H2PO4H(L,NY,NX) + ZN4BH2(L,NY,NX)=ZNH4BH(L,NY,NX) + ZN3BH2(L,NY,NX)=ZNH3BH(L,NY,NX) + ZNOBH2(L,NY,NX)=ZNO3BH(L,NY,NX) + ZN2BH2(L,NY,NX)=ZNO2BH(L,NY,NX) + H1PBH2(L,NY,NX)=H1POBH(L,NY,NX) + H2PBH2(L,NY,NX)=H2POBH(L,NY,NX) +C IF(CDPTH(L,NY,NX).LT.DPNH4(NY,NX).AND.ROWN(NY,NX).GT.0.0)THEN +C VLNHB(L,NY,NX)=WDNHB(L,NY,NX)/ROWN(NY,NX) +C ELSE +C VLNHB(L,NY,NX)=0.0 +C ENDIF +C VLNH4(L,NY,NX)=1.0-VLNHB(L,NY,NX) +C IF(CDPTH(L-1,NY,NX).LT.DPNO3(NY,NX).AND.ROWO(NY,NX).GT.0.0)THEN +C VLNOB(L,NY,NX)=WDNOB(L,NY,NX)/ROWO(NY,NX) +C ELSE +C VLNOB(L,NY,NX)=0.0 +C ENDIF +C VLNO3(L,NY,NX)=1.0-VLNOB(L,NY,NX) +C IF(CDPTH(L,NY,NX).LT.DPPO4(NY,NX).AND.ROWP(NY,NX).GT.0.0)THEN +C VLPOB(L,NY,NX)=WDPOB(L,NY,NX)/ROWP(NY,NX) +C ELSE +C VLPOB(L,NY,NX)=0.0 +C ENDIF +C VLPO4(L,NY,NX)=1.0-VLPOB(L,NY,NX) +10 CONTINUE +9990 CONTINUE + +9995 CONTINUE +C +C TIME STEP USED IN GAS AND SOLUTE FLUX CALCULATIONS +C + MX=0 + DO 30 MM=1,NPG + M=MIN(NPH,INT((MM-1)*XNPT)+1) + DO 9895 NX=NHW,NHE + DO 9890 NY=NVN,NVS + IF(M.NE.MX)THEN +C +C RESET RUNOFF SOLUTE FLUX ACCUMULATORS +C + DO 9880 K=0,2 + TQROC(K,NY,NX)=0.0 + TQRON(K,NY,NX)=0.0 + TQROP(K,NY,NX)=0.0 + TQROA(K,NY,NX)=0.0 + OQC2(K,0,NY,NX)=OQC2(K,0,NY,NX)-ROCSK2(K,0,NY,NX) + OQN2(K,0,NY,NX)=OQN2(K,0,NY,NX)-RONSK2(K,0,NY,NX) + OQP2(K,0,NY,NX)=OQP2(K,0,NY,NX)-ROPSK2(K,0,NY,NX) + OQA2(K,0,NY,NX)=OQA2(K,0,NY,NX)-ROASK2(K,0,NY,NX) +9880 CONTINUE + TQRCOS(NY,NX)=0.0 + TQRCHS(NY,NX)=0.0 + TQROXS(NY,NX)=0.0 + TQRNGS(NY,NX)=0.0 + TQRN2S(NY,NX)=0.0 + TQRHGS(NY,NX)=0.0 + TQRNH4(NY,NX)=0.0 + TQRNH3(NY,NX)=0.0 + TQRNO3(NY,NX)=0.0 + TQRNO2(NY,NX)=0.0 + TQRH1P(NY,NX)=0.0 + TQRH2P(NY,NX)=0.0 + TQSCOS(NY,NX)=0.0 + TQSCHS(NY,NX)=0.0 + TQSOXS(NY,NX)=0.0 + TQSNGS(NY,NX)=0.0 + TQSN2S(NY,NX)=0.0 + TQSNH4(NY,NX)=0.0 + TQSNH3(NY,NX)=0.0 + TQSNO3(NY,NX)=0.0 + TQSH1P(NY,NX)=0.0 + TQSH2P(NY,NX)=0.0 + ZNH4S2(0,NY,NX)=ZNH4S2(0,NY,NX)-RN4SK2(0,NY,NX) + ZN3S2(0,NY,NX)=ZN3S2(0,NY,NX)-RN3SK2(0,NY,NX) + ZNO3S2(0,NY,NX)=ZNO3S2(0,NY,NX)-RNOSK2(0,NY,NX) + ZNO2S2(0,NY,NX)=ZNO2S2(0,NY,NX)-RNXSK2(0,NY,NX) + H2PO42(0,NY,NX)=H2PO42(0,NY,NX)-RHPSK2(0,NY,NX) + H1PO42(0,NY,NX)=H1PO42(0,NY,NX)-R1PSK2(0,NY,NX) + ROXSK2(0,NY,NX)=ROXSK(M,0,NY,NX)*XNPT + ENDIF + CO2S2(0,NY,NX)=CO2S2(0,NY,NX)-RCOSK2(0,NY,NX) + CH4S2(0,NY,NX)=CH4S2(0,NY,NX)-RCHSK2(0,NY,NX) + OXYS2(0,NY,NX)=OXYS2(0,NY,NX)-ROXSK2(0,NY,NX) + Z2GS2(0,NY,NX)=Z2GS2(0,NY,NX)-RNGSK2(0,NY,NX) + Z2OS2(0,NY,NX)=Z2OS2(0,NY,NX)-RN2SK2(0,NY,NX) + H2GS2(0,NY,NX)=H2GS2(0,NY,NX)-RHGSK2(0,NY,NX) + ZN3G2(0,NY,NX)=ZN3G2(0,NY,NX)-RNHSK2(0,NY,NX) +C +C RESET SOIL SOLUTE FLUX ACCUMULATORS +C + DO 9885 L=NU(NY,NX),NL(NY,NX) + IF(M.NE.MX)THEN + DO 9875 K=0,4 + TOCFLS(K,L,NY,NX)=0.0 + TONFLS(K,L,NY,NX)=0.0 + TOPFLS(K,L,NY,NX)=0.0 + TOAFLS(K,L,NY,NX)=0.0 + TOCFHS(K,L,NY,NX)=0.0 + TONFHS(K,L,NY,NX)=0.0 + TOPFHS(K,L,NY,NX)=0.0 + TOAFHS(K,L,NY,NX)=0.0 + OQC2(K,L,NY,NX)=OQC2(K,L,NY,NX)-ROCSK2(K,L,NY,NX) + OQN2(K,L,NY,NX)=OQN2(K,L,NY,NX)-RONSK2(K,L,NY,NX) + OQP2(K,L,NY,NX)=OQP2(K,L,NY,NX)-ROPSK2(K,L,NY,NX) + OQA2(K,L,NY,NX)=OQA2(K,L,NY,NX)-ROASK2(K,L,NY,NX) +9875 CONTINUE + TCOFLS(L,NY,NX)=0.0 + TCHFLS(L,NY,NX)=0.0 + TOXFLS(L,NY,NX)=0.0 + TNGFLS(L,NY,NX)=0.0 + TN2FLS(L,NY,NX)=0.0 + THGFLS(L,NY,NX)=0.0 + TN4FLW(L,NY,NX)=0.0 + TN3FLW(L,NY,NX)=0.0 + TNOFLW(L,NY,NX)=0.0 + TNXFLS(L,NY,NX)=0.0 + TH1PFS(L,NY,NX)=0.0 + TH2PFS(L,NY,NX)=0.0 + TN4FLB(L,NY,NX)=0.0 + TN3FLB(L,NY,NX)=0.0 + TNOFLB(L,NY,NX)=0.0 + TNXFLB(L,NY,NX)=0.0 + TH1BFB(L,NY,NX)=0.0 + TH2BFB(L,NY,NX)=0.0 + TCOFHS(L,NY,NX)=0.0 + TCHFHS(L,NY,NX)=0.0 + TOXFHS(L,NY,NX)=0.0 + TNGFHS(L,NY,NX)=0.0 + TN2FHS(L,NY,NX)=0.0 + THGFHS(L,NY,NX)=0.0 + TN4FHW(L,NY,NX)=0.0 + TN3FHW(L,NY,NX)=0.0 + TNOFHW(L,NY,NX)=0.0 + TNXFHS(L,NY,NX)=0.0 + TH1PHS(L,NY,NX)=0.0 + TH2PHS(L,NY,NX)=0.0 + TN4FHB(L,NY,NX)=0.0 + TN3FHB(L,NY,NX)=0.0 + TNOFHB(L,NY,NX)=0.0 + TNXFHB(L,NY,NX)=0.0 + TH1BHB(L,NY,NX)=0.0 + TH2BHB(L,NY,NX)=0.0 + ZNH4S2(L,NY,NX)=ZNH4S2(L,NY,NX)-RN4SK2(L,NY,NX) + ZN3S2(L,NY,NX)=ZN3S2(L,NY,NX)-RN3SK2(L,NY,NX) + ZNO3S2(L,NY,NX)=ZNO3S2(L,NY,NX)-RNOSK2(L,NY,NX) + ZNO2S2(L,NY,NX)=ZNO2S2(L,NY,NX)-RNXSK2(L,NY,NX) + H2PO42(L,NY,NX)=H2PO42(L,NY,NX)-RHPSK2(L,NY,NX) + H1PO42(L,NY,NX)=H1PO42(L,NY,NX)-R1PSK2(L,NY,NX) + ZNH4B2(L,NY,NX)=ZNH4B2(L,NY,NX)-R4BSK2(L,NY,NX) + ZNBS2(L,NY,NX)=ZNBS2(L,NY,NX)-R3BSK2(L,NY,NX) + ZNO3B2(L,NY,NX)=ZNO3B2(L,NY,NX)-RNBSK2(L,NY,NX) + ZNO2B2(L,NY,NX)=ZNO2B2(L,NY,NX)-RNZSK2(L,NY,NX) + H2POB2(L,NY,NX)=H2POB2(L,NY,NX)-RHBSK2(L,NY,NX) + H1POB2(L,NY,NX)=H1POB2(L,NY,NX)-R1BSK2(L,NY,NX) + ROXSK2(L,NY,NX)=ROXSK(M,L,NY,NX)*XNPT + ENDIF +C +C SOIL GAS FLUX ACCUMULATORS +C + TCOFLG(L,NY,NX)=0.0 + TCHFLG(L,NY,NX)=0.0 + TOXFLG(L,NY,NX)=0.0 + TNGFLG(L,NY,NX)=0.0 + TN2FLG(L,NY,NX)=0.0 + TN3FLG(L,NY,NX)=0.0 + THGFLG(L,NY,NX)=0.0 + CO2S2(L,NY,NX)=CO2S2(L,NY,NX)-RCOSK2(L,NY,NX) + CH4S2(L,NY,NX)=CH4S2(L,NY,NX)-RCHSK2(L,NY,NX) + OXYS2(L,NY,NX)=OXYS2(L,NY,NX)-ROXSK2(L,NY,NX) + Z2GS2(L,NY,NX)=Z2GS2(L,NY,NX)-RNGSK2(L,NY,NX) + 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) +9885 CONTINUE +C +C SOLUTE FLUXES AT SOIL SURFACE FROM SURFACE WATER +C CONTENTS, WATER FLUXES 'FLQM' AND ATMOSPHERE BOUNDARY +C LAYER RESISTANCES 'PARGM' FROM 'WATSUB' +C + IF(M.NE.MX)THEN + VOLWMA(NU(NY,NX),NY,NX)=VOLWM(M,NU(NY,NX),NY,NX) + 2*VLNH4(NU(NY,NX),NY,NX) + VOLWMB(NU(NY,NX),NY,NX)=VOLWM(M,NU(NY,NX),NY,NX) + 2*VLNHB(NU(NY,NX),NY,NX) + VOLWXA(NU(NY,NX),NY,NX)=14.0*VOLWMA(NU(NY,NX),NY,NX) + VOLWXB(NU(NY,NX),NY,NX)=14.0*VOLWMB(NU(NY,NX),NY,NX) + VOLWOA=VOLWM(M,NU(NY,NX),NY,NX)*VLNO3(NU(NY,NX),NY,NX) + VOLWOB=VOLWM(M,NU(NY,NX),NY,NX)*VLNOB(NU(NY,NX),NY,NX) + VOLWPA=VOLWM(M,NU(NY,NX),NY,NX)*VLPO4(NU(NY,NX),NY,NX) + VOLWPB=VOLWM(M,NU(NY,NX),NY,NX)*VLPOB(NU(NY,NX),NY,NX) + VOLPMA(NU(NY,NX),NY,NX)=VOLPM(M,NU(NY,NX),NY,NX) + 2*VLNH4(NU(NY,NX),NY,NX) + VOLPMB(NU(NY,NX),NY,NX)=VOLPM(M,NU(NY,NX),NY,NX) + 2*VLNHB(NU(NY,NX),NY,NX) + THETW1(NU(NY,NX),NY,NX)=AMAX1(0.0,VOLWM(M,NU(NY,NX),NY,NX) + 2/VOLX(NU(NY,NX),NY,NX)) + FLVM(NU(NY,NX),NY,NX)=FLPM(M,NU(NY,NX),NY,NX)*XNPT + FLQM(3,NU(NY,NX),NY,NX)=(FLWM(M,3,NU(NY,NX),NY,NX) + 2+FLWHM(M,3,NU(NY,NX),NY,NX))*XNPT +C +C SURFACE EXCHANGE OF AQUEOUS CO2, CH4, O2, N2, NH3 +C THROUGH VOLATILIZATION-DISSOLUTION FROM AQUEOUS +C DIFFUSIVITIES IN SURFACE RESIDUE +C + IF(VOLWM(M,0,NY,NX).GT.ZEROS(NY,NX))THEN + 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) + VOLWNG(0,NY,NX)=VOLWM(M,0,NY,NX)*SN2GL(0,NY,NX) + VOLWN2(0,NY,NX)=VOLWM(M,0,NY,NX)*SN2OL(0,NY,NX) + VOLWN3(0,NY,NX)=VOLWM(M,0,NY,NX)*SNH3L(0,NY,NX) + VOLWHG(0,NY,NX)=VOLWM(M,0,NY,NX)*SH2GL(0,NY,NX) + VOLWXA(0,NY,NX)=14.0*VOLWM(M,0,NY,NX) + TORT0=TORT(M,0,NY,NX)*AREA(3,NU(NY,NX),NY,NX) + 2/(0.5*DLYR(3,0,NY,NX)) + DFGSCO=CLSGL2(0,NY,NX)*TORT0 + DFGSCH=CQSGL2(0,NY,NX)*TORT0 + DFGSOX=OLSGL2(0,NY,NX)*TORT0 + DFGSNG=ZLSGL2(0,NY,NX)*TORT0 + DFGSN2=ZNSGL2(0,NY,NX)*TORT0 + DFGSN3=ZVSGL2(0,NY,NX)*TORT0 + DFGSHL=HLSGL2(0,NY,NX)*TORT0 + CO2S2X=AMAX1(0.0,CO2S2(0,NY,NX)) + CH4S2X=AMAX1(0.0,CH4S2(0,NY,NX)) + OXYS2X=AMAX1(0.0,OXYS2(0,NY,NX)) + Z2GS2X=AMAX1(0.0,Z2GS2(0,NY,NX)) + Z2OS2X=AMAX1(0.0,Z2OS2(0,NY,NX)) + ZN3S2X=AMAX1(0.0,ZN3S2(0,NY,NX)) + H2GS2X=AMAX1(0.0,H2GS2(0,NY,NX)) +C +C EQUILIBRIUM CONCENTRATIONS AT RESIDUE SURFACE AT WHICH +C AQUEOUS DIFFUSION THROUGH RESIDUE SURFACE LAYER = GASEOUS +C DIFFUSION THROUGH ATMOSPHERE BOUNDARY LAYER CALCULATED +C FROM AQUEOUS DIFFUSIVITY AND BOUNDARY LAYER CONDUCTANCE +C + CO2GQ=(PARR(NY,NX)*CCO2E(NY,NX)*VOLWCO(0,NY,NX)+DFGSCO + 2*CO2S2X)/(DFGSCO+PARR(NY,NX)) + CH4GQ=(PARR(NY,NX)*CCH4E(NY,NX)*VOLWCH(0,NY,NX)+DFGSCH + 2*CH4S2X)/(DFGSCH+PARR(NY,NX)) + OXYGQ=(PARR(NY,NX)*COXYE(NY,NX)*VOLWOX(0,NY,NX)+DFGSOX + 2*OXYS2X)/(DFGSOX+PARR(NY,NX)) + Z2GGQ=(PARR(NY,NX)*CZ2GE(NY,NX)*VOLWNG(0,NY,NX)+DFGSNG + 2*Z2GS2X)/(DFGSNG+PARR(NY,NX)) + Z2OGQ=(PARR(NY,NX)*CZ2OE(NY,NX)*VOLWN2(0,NY,NX)+DFGSN2 + 2*Z2OS2X)/(DFGSN2+PARR(NY,NX)) + ZN3GQ=(PARR(NY,NX)*CNH3E(NY,NX)*VOLWN3(0,NY,NX)+DFGSN3 + 2*ZN3S2X)/(DFGSN3+PARR(NY,NX)) + H2GGQ=(PARR(NY,NX)*CH2GE(NY,NX)*VOLWHG(0,NY,NX)+DFGSHL + 2*H2GS2X)/(DFGSHL+PARR(NY,NX)) +C +C SURFACE VOLATILIZATION-DISSOLUTION FROM DIFFERENCES +C BETWEEN ATMOSPHERIC AND RESIDUE SURFACE EQUILIBRIUM +C CONCENTRATIONS +C + RCODFR(NY,NX)=CO2GQ-CO2S2X + RCHDFR(NY,NX)=CH4GQ-CH4S2X + ROXDFR(NY,NX)=OXYGQ-OXYS2X + RNGDFR(NY,NX)=Z2GGQ-Z2GS2X + RN2DFR(NY,NX)=Z2OGQ-Z2OS2X + RN3DFR(NY,NX)=ZN3GQ-ZN3S2X + RHGDFR(NY,NX)=H2GGQ-H2GS2X +C +C ACCUMULATE HOURLY FLUXES +C + XCODFR(NY,NX)=XCODFR(NY,NX)+RCODFR(NY,NX) + XCHDFR(NY,NX)=XCHDFR(NY,NX)+RCHDFR(NY,NX) + XOXDFR(NY,NX)=XOXDFR(NY,NX)+ROXDFR(NY,NX) + XNGDFR(NY,NX)=XNGDFR(NY,NX)+RNGDFR(NY,NX) + 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 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) +C 4,DLYR(3,0,NY,NX),VOLWM(M,0,NY,NX) +C WRITE(*,1118)'RCHDFR',I,J,NX,NY,M,MM,RCHDFR(NY,NX) +C 2,CH4GQ,CH4S2(0,NY,NX),PARR(NY,NX),CCH4E(NY,NX) +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) +1118 FORMAT(A8,6I4,20E12.4) +C ENDIF + ELSE + RCODFR(NY,NX)=0.0 + RCHDFR(NY,NX)=0.0 + ROXDFR(NY,NX)=0.0 + RNGDFR(NY,NX)=0.0 + RN2DFR(NY,NX)=0.0 + RN3DFR(NY,NX)=0.0 + RHGDFR(NY,NX)=0.0 + ENDIF + RCODXR=RCODFR(NY,NX)*XNPT + RCHDXR=RCHDFR(NY,NX)*XNPT + ROXDXR=ROXDFR(NY,NX)*XNPT + RNGDXR=RNGDFR(NY,NX)*XNPT + RN2DXR=RN2DFR(NY,NX)*XNPT + RN3DXR=RN3DFR(NY,NX)*XNPT + RHGDXR=RHGDFR(NY,NX)*XNPT +C +C SURFACE EXCHANGE OF AQUEOUS CO2, CH4, O2, N2, NH3 +C THROUGH VOLATILIZATION-DISSOLUTION FROM AQUEOUS +C DIFFUSIVITIES IN SURFACE SOIL LAYER +C + IF(VOLWM(M,NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN + VOLWCO(NU(NY,NX),NY,NX)=VOLWM(M,NU(NY,NX),NY,NX) + 2*SCO2L(NU(NY,NX),NY,NX) + VOLWCH(NU(NY,NX),NY,NX)=VOLWM(M,NU(NY,NX),NY,NX) + 2*SCH4L(NU(NY,NX),NY,NX) + VOLWOX(NU(NY,NX),NY,NX)=VOLWM(M,NU(NY,NX),NY,NX) + 2*SOXYL(NU(NY,NX),NY,NX) + VOLWNG(NU(NY,NX),NY,NX)=VOLWM(M,NU(NY,NX),NY,NX) + 2*SN2GL(NU(NY,NX),NY,NX) + VOLWN2(NU(NY,NX),NY,NX)=VOLWM(M,NU(NY,NX),NY,NX) + 2*SN2OL(NU(NY,NX),NY,NX) + VOLWN3(NU(NY,NX),NY,NX)=VOLWMA(NU(NY,NX),NY,NX) + 2*SNH3L(NU(NY,NX),NY,NX) + VOLWNB(NU(NY,NX),NY,NX)=VOLWMB(NU(NY,NX),NY,NX) + 2*SNH3L(NU(NY,NX),NY,NX) + VOLWHG(NU(NY,NX),NY,NX)=VOLWM(M,NU(NY,NX),NY,NX) + 2*SH2GL(NU(NY,NX),NY,NX) + TORT1=TORT(M,NU(NY,NX),NY,NX)*AREA(3,NU(NY,NX),NY,NX) + 2/(0.5*DLYR(3,NU(NY,NX),NY,NX)) + DFGSCO=CLSGL2(NU(NY,NX),NY,NX)*TORT1 + DFGSCH=CQSGL2(NU(NY,NX),NY,NX)*TORT1 + DFGSOX=OLSGL2(NU(NY,NX),NY,NX)*TORT1 + DFGSNG=ZLSGL2(NU(NY,NX),NY,NX)*TORT1 + DFGSN2=ZNSGL2(NU(NY,NX),NY,NX)*TORT1 + DFGSN3=ZVSGL2(NU(NY,NX),NY,NX)*TORT1 + DFGSHL=HLSGL2(NU(NY,NX),NY,NX)*TORT1 + CO2S2X=AMAX1(0.0,CO2S2(NU(NY,NX),NY,NX)) + CH4S2X=AMAX1(0.0,CH4S2(NU(NY,NX),NY,NX)) + OXYS2X=AMAX1(0.0,OXYS2(NU(NY,NX),NY,NX)) + Z2GS2X=AMAX1(0.0,Z2GS2(NU(NY,NX),NY,NX)) + Z2OS2X=AMAX1(0.0,Z2OS2(NU(NY,NX),NY,NX)) + ZN3S2X=AMAX1(0.0,ZN3S2(NU(NY,NX),NY,NX)) + ZNBS2X=AMAX1(0.0,ZNBS2(NU(NY,NX),NY,NX)) + H2GS2X=AMAX1(0.0,H2GS2(NU(NY,NX),NY,NX)) +C +C EQUILIBRIUM CONCENTRATIONS AT SOIL SURFACE AT WHICH +C AQUEOUS DIFFUSION THROUGH SOIL SURFACE LAYER = GASEOUS +C DIFFUSION THROUGH ATMOSPHERE BOUNDARY LAYER CALCULATED +C FROM AQUEOUS DIFFUSIVITY AND BOUNDARY LAYER CONDUCTANCE +C + CO2GQ=(PARG(NY,NX)*CCO2E(NY,NX)*VOLWCO(NU(NY,NX),NY,NX) + 2+DFGSCO*CO2S2X)/(DFGSCO+PARG(NY,NX)) + CH4GQ=(PARG(NY,NX)*CCH4E(NY,NX)*VOLWCH(NU(NY,NX),NY,NX) + 2+DFGSCH*CH4S2X)/(DFGSCH+PARG(NY,NX)) + OXYGQ=(PARG(NY,NX)*COXYE(NY,NX)*VOLWOX(NU(NY,NX),NY,NX) + 2+DFGSOX*OXYS2X)/(DFGSOX+PARG(NY,NX)) + Z2GGQ=(PARG(NY,NX)*CZ2GE(NY,NX)*VOLWNG(NU(NY,NX),NY,NX) + 2+DFGSNG*Z2GS2X)/(DFGSNG+PARG(NY,NX)) + Z2OGQ=(PARG(NY,NX)*CZ2OE(NY,NX)*VOLWN2(NU(NY,NX),NY,NX) + 2+DFGSN2*Z2OS2X)/(DFGSN2+PARG(NY,NX)) + ZN3GQ=(PARG(NY,NX)*CNH3E(NY,NX)*VOLWN3(NU(NY,NX),NY,NX) + 2+DFGSN3*ZN3S2X)/(DFGSN3+PARG(NY,NX)) + ZNBGQ=(PARG(NY,NX)*CNH3E(NY,NX)*VOLWNB(NU(NY,NX),NY,NX) + 2+DFGSN3*ZNBS2X)/(DFGSN3+PARG(NY,NX)) + H2GGQ=(PARG(NY,NX)*CH2GE(NY,NX)*VOLWHG(NU(NY,NX),NY,NX) + 2+DFGSHL*H2GS2X)/(DFGSHL+PARG(NY,NX)) +C +C SURFACE VOLATILIZATION-DISSOLUTION FROM DIFFERENCES +C BETWEEN ATMOSPHERIC AND SOIL SURFACE EQUILIBRIUM +C CONCENTRATIONS +C + RCODFS(NY,NX)=CO2GQ-CO2S2X + RCHDFS(NY,NX)=CH4GQ-CH4S2X + ROXDFS(NY,NX)=OXYGQ-OXYS2X + RNGDFS(NY,NX)=Z2GGQ-Z2GS2X + RN2DFS(NY,NX)=Z2OGQ-Z2OS2X + RN3DFS(NY,NX)=ZN3GQ-ZN3S2X + RNBDFS(NY,NX)=ZNBGQ-ZNBS2X + RHGDFS(NY,NX)=H2GGQ-H2GS2X +C +C ACCUMULATE HOURLY FLUXES +C + XCODFS(NY,NX)=XCODFS(NY,NX)+RCODFS(NY,NX) + XCHDFS(NY,NX)=XCHDFS(NY,NX)+RCHDFS(NY,NX) + XOXDFS(NY,NX)=XOXDFS(NY,NX)+ROXDFS(NY,NX) + XNGDFS(NY,NX)=XNGDFS(NY,NX)+RNGDFS(NY,NX) + XN2DFS(NY,NX)=XN2DFS(NY,NX)+RN2DFS(NY,NX) + XN3DFS(NY,NX)=XN3DFS(NY,NX)+RN3DFS(NY,NX) + 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)'RCHDFS',I,J,NX,NY,M,MM,RCHDFS(NY,NX) +C 2,CH4GQ,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 3,COXYE(NY,NX),VOLWOX(NU(NY,NX),NY,NX),DFGSOX,TORT(M,0,NY,NX) +C 4,XOXDFS(NY,NX) +C ENDIF + ELSE + RCODFS(NY,NX)=0.0 + RCHDFS(NY,NX)=0.0 + ROXDFS(NY,NX)=0.0 + RNGDFS(NY,NX)=0.0 + RN2DFS(NY,NX)=0.0 + RN3DFS(NY,NX)=0.0 + RNBDFS(NY,NX)=0.0 + RHGDFS(NY,NX)=0.0 + ENDIF + RCODXS=RCODFS(NY,NX)*XNPT + RCHDXS=RCHDFS(NY,NX)*XNPT + ROXDXS=ROXDFS(NY,NX)*XNPT + RNGDXS=RNGDFS(NY,NX)*XNPT + RN2DXS=RN2DFS(NY,NX)*XNPT + RN3DXS=RN3DFS(NY,NX)*XNPT + RNBDXS=RNBDFS(NY,NX)*XNPT + RHGDXS=RHGDFS(NY,NX)*XNPT +C +C CONVECTIVE SOLUTE EXCHANGE BETWEEN RESIDUE AND SOIL SURFACE +C + FLWRM1=FLWRM(M,NY,NX) +C +C IF WATER FLUX FROM 'WATSUB' IS FROM RESIDUE TO +C SOIL SURFACE THEN CONVECTIVE TRANSPORT IS THE PRODUCT +C OF WATER FLUX AND MICROPORE GAS OR SOLUTE CONCENTRATIONS +C IN RESIDUE +C + IF(FLWRM1.GT.0.0)THEN + IF(VOLWM(M,0,NY,NX).GT.ZEROS(NY,NX))THEN + VFLW=AMAX1(0.0,AMIN1(XFRX,FLWRM1/VOLWM(M,0,NY,NX))) + ELSE + VFLW=XFRX + ENDIF + DO 8820 K=0,2 + 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)) + RFLOA(K)=VFLW*AMAX1(0.0,OQA2(K,0,NY,NX)) +8820 CONTINUE + RFLCOS=VFLW*AMAX1(0.0,CO2S2(0,NY,NX)) + RFLCHS=VFLW*AMAX1(0.0,CH4S2(0,NY,NX)) + RFLOXS=VFLW*AMAX1(0.0,OXYS2(0,NY,NX)) + RFLNGS=VFLW*AMAX1(0.0,Z2GS2(0,NY,NX)) + RFLN2S=VFLW*AMAX1(0.0,Z2OS2(0,NY,NX)) + RFLHGS=VFLW*AMAX1(0.0,H2GS2(0,NY,NX)) + RFLNH4=VFLW*AMAX1(0.0,ZNH4S2(0,NY,NX))*VLNH4(NU(NY,NX),NY,NX) + RFLNH3=VFLW*AMAX1(0.0,ZN3S2(0,NY,NX))*VLNH4(NU(NY,NX),NY,NX) + RFLNO3=VFLW*AMAX1(0.0,ZNO3S2(0,NY,NX))*VLNO3(NU(NY,NX),NY,NX) + RFLNO2=VFLW*AMAX1(0.0,ZNO2S2(0,NY,NX))*VLNO3(NU(NY,NX),NY,NX) + RFLP14=VFLW*AMAX1(0.0,H1PO42(0,NY,NX))*VLPO4(NU(NY,NX),NY,NX) + RFLPO4=VFLW*AMAX1(0.0,H2PO42(0,NY,NX))*VLPO4(NU(NY,NX),NY,NX) + RFLN4B=VFLW*AMAX1(0.0,ZNH4S2(0,NY,NX))*VLNHB(NU(NY,NX),NY,NX) + RFLN3B=VFLW*AMAX1(0.0,ZN3S2(0,NY,NX))*VLNHB(NU(NY,NX),NY,NX) + RFLNOB=VFLW*AMAX1(0.0,ZNO3S2(0,NY,NX))*VLNOB(NU(NY,NX),NY,NX) + RFLN2B=VFLW*AMAX1(0.0,ZNO2S2(0,NY,NX))*VLNOB(NU(NY,NX),NY,NX) + RFLP1B=VFLW*AMAX1(0.0,H1PO42(0,NY,NX))*VLPOB(NU(NY,NX),NY,NX) + RFLPOB=VFLW*AMAX1(0.0,H2PO42(0,NY,NX))*VLPOB(NU(NY,NX),NY,NX) +C +C IF WATER FLUX FROM 'WATSUB' IS TO RESIDUE FROM +C SOIL SURFACE THEN CONVECTIVE TRANSPORT IS THE PRODUCT +C OF WATER FLUX AND MICROPORE GAS OR SOLUTE CONCENTRATIONS +C IN SOIL SURFACE +C + ELSE + IF(VOLWM(M,NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN + VFLW=AMIN1(0.0,AMAX1(-XFRX,FLWRM1/VOLWM(M,NU(NY,NX),NY,NX))) + ELSE + VFLW=-XFRX + ENDIF + DO 8815 K=0,2 + 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)) + RFLOA(K)=VFLW*AMAX1(0.0,OQA2(K,NU(NY,NX),NY,NX)) +8815 CONTINUE + RFLCOS=VFLW*AMAX1(0.0,CO2S2(NU(NY,NX),NY,NX)) + RFLCHS=VFLW*AMAX1(0.0,CH4S2(NU(NY,NX),NY,NX)) + RFLOXS=VFLW*AMAX1(0.0,OXYS2(NU(NY,NX),NY,NX)) + RFLNGS=VFLW*AMAX1(0.0,Z2GS2(NU(NY,NX),NY,NX)) + RFLN2S=VFLW*AMAX1(0.0,Z2OS2(NU(NY,NX),NY,NX)) + RFLHGS=VFLW*AMAX1(0.0,H2GS2(NU(NY,NX),NY,NX)) + RFLNH4=VFLW*AMAX1(0.0,ZNH4S2(NU(NY,NX),NY,NX)) + RFLNH3=VFLW*AMAX1(0.0,ZN3S2(NU(NY,NX),NY,NX)) + RFLNO3=VFLW*AMAX1(0.0,ZNO3S2(NU(NY,NX),NY,NX)) + RFLNO2=VFLW*AMAX1(0.0,ZNO2S2(NU(NY,NX),NY,NX)) + RFLP14=VFLW*AMAX1(0.0,H1PO42(NU(NY,NX),NY,NX)) + RFLPO4=VFLW*AMAX1(0.0,H2PO42(NU(NY,NX),NY,NX)) + RFLN4B=VFLW*AMAX1(0.0,ZNH4B2(NU(NY,NX),NY,NX)) + RFLN3B=VFLW*AMAX1(0.0,ZNBS2(NU(NY,NX),NY,NX)) + RFLNOB=VFLW*AMAX1(0.0,ZNO3B2(NU(NY,NX),NY,NX)) + RFLN2B=VFLW*AMAX1(0.0,ZNO2B2(NU(NY,NX),NY,NX)) + RFLP1B=VFLW*AMAX1(0.0,H1POB2(NU(NY,NX),NY,NX)) + RFLPOB=VFLW*AMAX1(0.0,H2POB2(NU(NY,NX),NY,NX)) + ENDIF +C +C DIFFUSIVE FLUXES OF GASES AND SOLUTES BETWEEN RESIDUE AND +C SOIL SURFACE FROM AQUEOUS DIFFUSIVITIES +C AND CONCENTRATION DIFFERENCES +C + IF(THETW1(0,NY,NX).GT.THETY(0,NY,NX) + 2.AND.THETW1(NU(NY,NX),NY,NX).GT.THETY(NU(NY,NX),NY,NX))THEN +C +C MICROPORE CONCENTRATIONS FROM WATER IN RESIDUE AND SOIL SURFACE +C + DO 8810 K=0,2 + 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)) + COQA1(K)=AMAX1(0.0,OQA2(K,0,NY,NX)/VOLWM(M,0,NY,NX)) + COQC2(K)=AMAX1(0.0,OQC2(K,NU(NY,NX),NY,NX) + 2/VOLWM(M,NU(NY,NX),NY,NX)) + COQN2(K)=AMAX1(0.0,OQN2(K,NU(NY,NX),NY,NX) + 2/VOLWM(M,NU(NY,NX),NY,NX)) + COQP2(K)=AMAX1(0.0,OQP2(K,NU(NY,NX),NY,NX) + 2/VOLWM(M,NU(NY,NX),NY,NX)) + COQA2(K)=AMAX1(0.0,OQA2(K,NU(NY,NX),NY,NX) + 2/VOLWM(M,NU(NY,NX),NY,NX)) +8810 CONTINUE + CCO2S1=AMAX1(0.0,CO2S2(0,NY,NX)/VOLWM(M,0,NY,NX)) + CCH4S1=AMAX1(0.0,CH4S2(0,NY,NX)/VOLWM(M,0,NY,NX)) + COXYS1=AMAX1(0.0,OXYS2(0,NY,NX)/VOLWM(M,0,NY,NX)) + CZ2GS1=AMAX1(0.0,Z2GS2(0,NY,NX)/VOLWM(M,0,NY,NX)) + CZ2OS1=AMAX1(0.0,Z2OS2(0,NY,NX)/VOLWM(M,0,NY,NX)) + CH2GS1=AMAX1(0.0,H2GS2(0,NY,NX)/VOLWM(M,0,NY,NX)) + CNH4S1=AMAX1(0.0,ZNH4S2(0,NY,NX)/VOLWM(M,0,NY,NX)) + CNH3S1=AMAX1(0.0,ZN3S2(0,NY,NX)/VOLWM(M,0,NY,NX)) + CNO3S1=AMAX1(0.0,ZNO3S2(0,NY,NX)/VOLWM(M,0,NY,NX)) + CNO2S1=AMAX1(0.0,ZNO2S2(0,NY,NX)/VOLWM(M,0,NY,NX)) + CP14S1=AMAX1(0.0,H1PO42(0,NY,NX)/VOLWM(M,0,NY,NX)) + CPO4S1=AMAX1(0.0,H2PO42(0,NY,NX)/VOLWM(M,0,NY,NX)) + CCO2S2=AMAX1(0.0,CO2S2(NU(NY,NX),NY,NX) + 2/VOLWM(M,NU(NY,NX),NY,NX)) + CCH4S2=AMAX1(0.0,CH4S2(NU(NY,NX),NY,NX) + 2/VOLWM(M,NU(NY,NX),NY,NX)) + COXYS2=AMAX1(0.0,OXYS2(NU(NY,NX),NY,NX) + 2/VOLWM(M,NU(NY,NX),NY,NX)) + CZ2GS2=AMAX1(0.0,Z2GS2(NU(NY,NX),NY,NX) + 2/VOLWM(M,NU(NY,NX),NY,NX)) + CZ2OS2=AMAX1(0.0,Z2OS2(NU(NY,NX),NY,NX) + 2/VOLWM(M,NU(NY,NX),NY,NX)) + CH2GS2=AMAX1(0.0,H2GS2(NU(NY,NX),NY,NX) + 2/VOLWM(M,NU(NY,NX),NY,NX)) + IF(VOLWMA(NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN + CNH3S2=AMAX1(0.0,ZN3S2(NU(NY,NX),NY,NX) + 2/VOLWMA(NU(NY,NX),NY,NX)) + CNH4S2=AMAX1(0.0,ZNH4S2(NU(NY,NX),NY,NX) + 2/VOLWMA(NU(NY,NX),NY,NX)) + ELSE + CNH3S2=0.0 + CNH4S2=0.0 + ENDIF + IF(VOLWOA.GT.ZEROS(NY,NX))THEN + CNO3S2=AMAX1(0.0,ZNO3S2(NU(NY,NX),NY,NX)/VOLWOA) + CNO2S2=AMAX1(0.0,ZNO2S2(NU(NY,NX),NY,NX)/VOLWOA) + ELSE + CNO3S2=0.0 + CNO2S2=0.0 + ENDIF + IF(VOLWPA.GT.ZEROS(NY,NX))THEN + CP14S2=AMAX1(0.0,H1PO42(NU(NY,NX),NY,NX)/VOLWPA) + CPO4S2=AMAX1(0.0,H2PO42(NU(NY,NX),NY,NX)/VOLWPA) + ELSE + CP14S2=0.0 + CPO4S2=0.0 + ENDIF + IF(VOLWMB(NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN + CNH3B2=AMAX1(0.0,ZNBS2(NU(NY,NX),NY,NX) + 2/VOLWMB(NU(NY,NX),NY,NX)) + CNH4B2=AMAX1(0.0,ZNH4B2(NU(NY,NX),NY,NX) + 2/VOLWMB(NU(NY,NX),NY,NX)) + ELSE + CNH3B2=CNH3S2 + CNH4B2=CNH4S2 + ENDIF + IF(VOLWOB.GT.ZEROS(NY,NX))THEN + CNO3B2=AMAX1(0.0,ZNO3B2(NU(NY,NX),NY,NX)/VOLWOB) + CNO2B2=AMAX1(0.0,ZNO2B2(NU(NY,NX),NY,NX)/VOLWOB) + ELSE + CNO3B2=CNO3S2 + CNO2B2=CNO2S2 + ENDIF + IF(VOLWPB.GT.ZEROS(NY,NX))THEN + CP14B2=AMAX1(0.0,H2POB2(NU(NY,NX),NY,NX)/VOLWPB) + CPO4B2=AMAX1(0.0,H2POB2(NU(NY,NX),NY,NX)/VOLWPB) + ELSE + CP14B2=CP14S2 + CPO4B2=CPO4S2 + ENDIF +C +C DIFFUSIVITIES IN RESIDUE AND SOIL SURFACE +C + TORT0=TORT(M,0,NY,NX)*AREA(3,NU(NY,NX),NY,NX) + 2/DLYR(3,0,NY,NX) + TORT1=TORT(M,NU(NY,NX),NY,NX)*AREA(3,NU(NY,NX),NY,NX) + 2/DLYR(3,NU(NY,NX),NY,NX) + DISPN=DISP(3,NU(NY,NX),NY,NX)*ABS(FLWRM1/AREA(3,NU(NY,NX),NY,NX)) + DIFOC0=(OCSGL2(0,NY,NX)*TORT0+DISPN) + DIFON0=(ONSGL2(0,NY,NX)*TORT0+DISPN) + DIFOP0=(OPSGL2(0,NY,NX)*TORT0+DISPN) + DIFOA0=(OASGL2(0,NY,NX)*TORT0+DISPN) + DIFNH0=(ZNSGL2(0,NY,NX)*TORT0+DISPN) + DIFNO0=(ZOSGL2(0,NY,NX)*TORT0+DISPN) + DIFPO0=(POSGL2(0,NY,NX)*TORT0+DISPN) + DIFCS0=(CLSGL2(0,NY,NX)*TORT0+DISPN) + DIFCQ0=(CQSGL2(0,NY,NX)*TORT0+DISPN) + DIFOS0=(OLSGL2(0,NY,NX)*TORT0+DISPN) + DIFNG0=(ZLSGL2(0,NY,NX)*TORT0+DISPN) + DIFN20=(ZVSGL2(0,NY,NX)*TORT0+DISPN) + DIFHG0=(HLSGL2(0,NY,NX)*TORT0+DISPN) + DIFOC1=(OCSGL2(NU(NY,NX),NY,NX)*TORT1+DISPN) + DIFON1=(ONSGL2(NU(NY,NX),NY,NX)*TORT1+DISPN) + DIFOP1=(OPSGL2(NU(NY,NX),NY,NX)*TORT1+DISPN) + DIFOA1=(OASGL2(NU(NY,NX),NY,NX)*TORT1+DISPN) + DIFNH1=(ZNSGL2(NU(NY,NX),NY,NX)*TORT1+DISPN) + DIFNO1=(ZOSGL2(NU(NY,NX),NY,NX)*TORT1+DISPN) + DIFPO1=(POSGL2(NU(NY,NX),NY,NX)*TORT1+DISPN) + DIFCS1=(CLSGL2(NU(NY,NX),NY,NX)*TORT1+DISPN) + DIFCQ1=(CQSGL2(NU(NY,NX),NY,NX)*TORT1+DISPN) + DIFOS1=(OLSGL2(NU(NY,NX),NY,NX)*TORT1+DISPN) + DIFNG1=(ZLSGL2(NU(NY,NX),NY,NX)*TORT1+DISPN) + DIFN21=(ZVSGL2(NU(NY,NX),NY,NX)*TORT1+DISPN) + DIFHG1=(HLSGL2(NU(NY,NX),NY,NX)*TORT1+DISPN) + DIFOC=DIFOC0*DIFOC1/(DIFOC0+DIFOC1) + DIFON=DIFON0*DIFON1/(DIFON0+DIFON1) + DIFOP=DIFOP0*DIFOP1/(DIFOP0+DIFOP1) + DIFOA=DIFOA0*DIFOA1/(DIFOA0+DIFOA1) + DIFNH=DIFNH0*DIFNH1/(DIFNH0+DIFNH1) + DIFNO=DIFNO0*DIFNO1/(DIFNO0+DIFNO1) + DIFPO=DIFPO0*DIFPO1/(DIFPO0+DIFPO1) + DIFCS=DIFCS0*DIFCS1/(DIFCS0+DIFCS1) + DIFCQ=DIFCQ0*DIFCQ1/(DIFCQ0+DIFCQ1) + DIFOS=DIFOS0*DIFOS1/(DIFOS0+DIFOS1) + DIFNG=DIFNG0*DIFNG1/(DIFNG0+DIFNG1) + DIFN2=DIFN20*DIFN21/(DIFN20+DIFN21) + DIFHG=DIFHG0*DIFHG1/(DIFHG0+DIFHG1) +C +C DIFFUSIVE FLUXES BETWEEN CURRENT AND ADJACENT GRID CELL +C MICROPORES +C + DO 8805 K=0,2 + DFVOC(K)=DIFOC*(COQC1(K)-COQC2(K)) + DFVON(K)=DIFON*(COQN1(K)-COQN2(K)) + DFVOP(K)=DIFOP*(COQP1(K)-COQP2(K)) + DFVOA(K)=DIFOA*(COQA1(K)-COQA2(K)) +8805 CONTINUE + DFVCOS=DIFCS*(CCO2S1-CCO2S2) + DFVCHS=DIFCQ*(CCH4S1-CCH4S2) + DFVOXS=DIFOS*(COXYS1-COXYS2) + DFVNGS=DIFNG*(CZ2GS1-CZ2GS2) + DFVN2S=DIFN2*(CZ2OS1-CZ2OS2) + DFVHGS=DIFHG*(CH2GS1-CH2GS2) + DFVNH4=DIFNH*(CNH4S1-CNH4S2)*VLNH4(NU(NY,NX),NY,NX) + DFVNH3=DIFNH*(CNH3S1-CNH3S2)*VLNH4(NU(NY,NX),NY,NX) + DFVNO3=DIFNO*(CNO3S1-CNO3S2)*VLNO3(NU(NY,NX),NY,NX) + DFVNO2=DIFNO*(CNO2S1-CNO2S2)*VLNO3(NU(NY,NX),NY,NX) + DFVP14=DIFPO*(CP14S1-CP14S2)*VLPO4(NU(NY,NX),NY,NX) + DFVPO4=DIFPO*(CPO4S1-CPO4S2)*VLPO4(NU(NY,NX),NY,NX) + DFVN4B=DIFNH*(CNH4S1-CNH4B2)*VLNHB(NU(NY,NX),NY,NX) + DFVN3B=DIFNH*(CNH3S1-CNH3B2)*VLNHB(NU(NY,NX),NY,NX) + DFVNOB=DIFNO*(CNO3S1-CNO3B2)*VLNOB(NU(NY,NX),NY,NX) + DFVN2B=DIFNO*(CNO2S1-CNO2B2)*VLNOB(NU(NY,NX),NY,NX) + 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 + DFVOC(K)=0.0 + DFVON(K)=0.0 + DFVOP(K)=0.0 + DFVOA(K)=0.0 +8905 CONTINUE + DFVCOS=0.0 + DFVCHS=0.0 + DFVOXS=0.0 + DFVNGS=0.0 + DFVN2S=0.0 + DFVHGS=0.0 + DFVNH4=0.0 + DFVNH3=0.0 + DFVNO3=0.0 + DFVNO2=0.0 + DFVP14=0.0 + DFVPO4=0.0 + DFVN4B=0.0 + DFVN3B=0.0 + DFVNOB=0.0 + DFVN2B=0.0 + DFVP1B=0.0 + DFVPOB=0.0 + ENDIF +C +C TOTAL MICROPORE AND MACROPORE SOLUTE TRANSPORT FLUXES BETWEEN +C ADJACENT GRID CELLS = CONVECTIVE + DIFFUSIVE FLUXES +C + DO 9760 K=0,2 + ROCFLS(K,3,0,NY,NX)=ROCFL0(K,NY,NX)-RFLOC(K)-DFVOC(K) + RONFLS(K,3,0,NY,NX)=RONFL0(K,NY,NX)-RFLON(K)-DFVON(K) + ROPFLS(K,3,0,NY,NX)=ROPFL0(K,NY,NX)-RFLOP(K)-DFVOP(K) + ROAFLS(K,3,0,NY,NX)=ROAFL0(K,NY,NX)-RFLOA(K)-DFVOA(K) + ROCFLS(K,3,NU(NY,NX),NY,NX)=ROCFL1(K,NY,NX)+RFLOC(K)+DFVOC(K) + 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 + ROXFLS(3,0,NY,NX)=ROXFL0(NY,NX)-RFLOXS-DFVOXS + RNGFLS(3,0,NY,NX)=RNGFL0(NY,NX)-RFLNGS-DFVNGS + RN2FLS(3,0,NY,NX)=RN2FL0(NY,NX)-RFLN2S-DFVN2S + RHGFLS(3,0,NY,NX)=RHGFL0(NY,NX)-RFLHGS-DFVHGS + RN4FLW(3,0,NY,NX)=RN4FL0(NY,NX)-RFLNH4-DFVNH4-RFLN4B-DFVN4B + RN3FLW(3,0,NY,NX)=RN3FL0(NY,NX)-RFLNH3-DFVNH3-RFLN3B-DFVN3B + RNOFLW(3,0,NY,NX)=RNOFL0(NY,NX)-RFLNO3-DFVNO3-RFLNOB-DFVNOB + RNXFLS(3,0,NY,NX)=RNXFL0(NY,NX)-RFLNO2-DFVNO2-RFLN2B-DFVN2B + RH1PFS(3,0,NY,NX)=RH1PF0(NY,NX)-RFLP14-DFVP14-RFLP1B-DFVP1B + RH2PFS(3,0,NY,NX)=RH2PF0(NY,NX)-RFLPO4-DFVPO4-RFLPOB-DFVPOB + RCOFLS(3,NU(NY,NX),NY,NX)=RCOFL1(NY,NX)+RFLCOS+DFVCOS + RCHFLS(3,NU(NY,NX),NY,NX)=RCHFL1(NY,NX)+RFLCHS+DFVCHS + ROXFLS(3,NU(NY,NX),NY,NX)=ROXFL1(NY,NX)+RFLOXS+DFVOXS + RNGFLS(3,NU(NY,NX),NY,NX)=RNGFL1(NY,NX)+RFLNGS+DFVNGS + RN2FLS(3,NU(NY,NX),NY,NX)=RN2FL1(NY,NX)+RFLN2S+DFVN2S + RHGFLS(3,NU(NY,NX),NY,NX)=RHGFL1(NY,NX)+RFLHGS+DFVHGS + RN4FLW(3,NU(NY,NX),NY,NX)=RN4FL1(NY,NX)+RFLNH4+DFVNH4 + RN3FLW(3,NU(NY,NX),NY,NX)=RN3FL1(NY,NX)+RFLNH3+DFVNH3 + RNOFLW(3,NU(NY,NX),NY,NX)=RNOFL1(NY,NX)+RFLNO3+DFVNO3 + RNXFLS(3,NU(NY,NX),NY,NX)=RNXFL1(NY,NX)+RFLNO2+DFVNO2 + RH1PFS(3,NU(NY,NX),NY,NX)=RH1PF1(NY,NX)+RFLP14+DFVP14 + RH2PFS(3,NU(NY,NX),NY,NX)=RH2PF1(NY,NX)+RFLPO4+DFVPO4 + RN4FLB(3,NU(NY,NX),NY,NX)=RN4FL2(NY,NX)+RFLN4B+DFVN4B + RN3FLB(3,NU(NY,NX),NY,NX)=RN3FL2(NY,NX)+RFLN3B+DFVN3B + RNOFLB(3,NU(NY,NX),NY,NX)=RNOFL2(NY,NX)+RFLNOB+DFVNOB + 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 + 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 + XNGFLS(3,0,NY,NX)=XNGFLS(3,0,NY,NX)-RFLNGS-DFVNGS + XN2FLS(3,0,NY,NX)=XN2FLS(3,0,NY,NX)-RFLN2S-DFVN2S + XHGFLS(3,0,NY,NX)=XHGFLS(3,0,NY,NX)-RFLHGS-DFVHGS + XN4FLW(3,0,NY,NX)=XN4FLW(3,0,NY,NX)-RFLNH4-DFVNH4-RFLN4B-DFVN4B + XN3FLW(3,0,NY,NX)=XN3FLW(3,0,NY,NX)-RFLNH3-DFVNH3-RFLN3B-DFVN3B + XNOFLW(3,0,NY,NX)=XNOFLW(3,0,NY,NX)-RFLNO3-DFVNO3-RFLNOB-DFVNOB + XNXFLS(3,0,NY,NX)=XNXFLS(3,0,NY,NX)-RFLNO2-DFVNO2-RFLN2B-DFVN2B + XH1PFS(3,0,NY,NX)=XH1PFS(3,0,NY,NX)-RFLP14-DFVP14-RFLP1B-DFVP1B + XH2PFS(3,0,NY,NX)=XH2PFS(3,0,NY,NX)-RFLPO4-DFVPO4-RFLPOB-DFVPOB + XCOFLS(3,NU(NY,NX),NY,NX)=XCOFLS(3,NU(NY,NX),NY,NX) + 2+RFLCOS+DFVCOS + XCHFLS(3,NU(NY,NX),NY,NX)=XCHFLS(3,NU(NY,NX),NY,NX) + 2+RFLCHS+DFVCHS + XOXFLS(3,NU(NY,NX),NY,NX)=XOXFLS(3,NU(NY,NX),NY,NX) + 2+RFLOXS+DFVOXS + XNGFLS(3,NU(NY,NX),NY,NX)=XNGFLS(3,NU(NY,NX),NY,NX) + 2+RFLNGS+DFVNGS + XN2FLS(3,NU(NY,NX),NY,NX)=XN2FLS(3,NU(NY,NX),NY,NX) + 2+RFLN2S+DFVN2S + XHGFLS(3,NU(NY,NX),NY,NX)=XHGFLS(3,NU(NY,NX),NY,NX) + 2+RFLHGS+DFVHGS + XN4FLW(3,NU(NY,NX),NY,NX)=XN4FLW(3,NU(NY,NX),NY,NX) + 2+RFLNH4+DFVNH4 + XN3FLW(3,NU(NY,NX),NY,NX)=XN3FLW(3,NU(NY,NX),NY,NX) + 2+RFLNH3+DFVNH3 + XNOFLW(3,NU(NY,NX),NY,NX)=XNOFLW(3,NU(NY,NX),NY,NX) + 2+RFLNO3+DFVNO3 + XNXFLS(3,NU(NY,NX),NY,NX)=XNXFLS(3,NU(NY,NX),NY,NX) + 2+RFLNO2+DFVNO2 + XH1PFS(3,NU(NY,NX),NY,NX)=XH1PFS(3,NU(NY,NX),NY,NX) + 2+RFLP14+DFVP14 + XH2PFS(3,NU(NY,NX),NY,NX)=XH2PFS(3,NU(NY,NX),NY,NX) + 2+RFLPO4+DFVPO4 + XN4FLB(3,NU(NY,NX),NY,NX)=XN4FLB(3,NU(NY,NX),NY,NX) + 2+RFLN4B+DFVN4B + XN3FLB(3,NU(NY,NX),NY,NX)=XN3FLB(3,NU(NY,NX),NY,NX) + 2+RFLN3B+DFVN3B + XNOFLB(3,NU(NY,NX),NY,NX)=XNOFLB(3,NU(NY,NX),NY,NX) + 2+RFLNOB+DFVNOB + XNXFLB(3,NU(NY,NX),NY,NX)=XNXFLB(3,NU(NY,NX),NY,NX) + 2+RFLN2B+DFVN2B + XH1BFB(3,NU(NY,NX),NY,NX)=XH1BFB(3,NU(NY,NX),NY,NX) + 2+RFLP1B+DFVP1B + XH2BFB(3,NU(NY,NX),NY,NX)=XH2BFB(3,NU(NY,NX),NY,NX) + 2+RFLPOB+DFVPOB +C IF(I.EQ.118.AND.NX.EQ.3.AND.NY.EQ.4)THEN +C WRITE(*,3434)'ROXFLS',I,J,NX,NY,M,MM,ROXFLS(3,0,NY,NX) +C 2,XOXFLS(3,0,NY,NX),ROXFL0(NY,NX),RFLOXS,DFVOXS +3434 FORMAT(A8,6I4,12E12.4) +C ENDIF +C +C MACROPORE-MICROPORE SOLUTE EXCHANGE IN SOIL +C SURFACE LAYER FROM WATER EXCHANGE IN 'WATSUB' AND +C FROM MACROPORE OR MICROPORE SOLUTE CONCENTRATIONS +C +C +C MACROPORE TO MICROPORE TRANSFER +C + IF(FINHM(M,NU(NY,NX),NY,NX).GT.0.0)THEN + IF(VOLWHM(M,NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN + VFLW=AMAX1(0.0,AMIN1(XFRX,FINHM(M,NU(NY,NX),NY,NX) + 2/VOLWHM(M,NU(NY,NX),NY,NX))) + ELSE + VFLW=XFRX + ENDIF + DO 9870 K=0,4 + RFLOC(K)=VFLW*AMAX1(0.0,OQCH2(K,NU(NY,NX),NY,NX)) + RFLON(K)=VFLW*AMAX1(0.0,OQNH2(K,NU(NY,NX),NY,NX)) + RFLOP(K)=VFLW*AMAX1(0.0,OQPH2(K,NU(NY,NX),NY,NX)) + RFLOA(K)=VFLW*AMAX1(0.0,OQAH2(K,NU(NY,NX),NY,NX)) +9870 CONTINUE + RFLCOS=VFLW*AMAX1(0.0,CO2SH2(NU(NY,NX),NY,NX)) + RFLCHS=VFLW*AMAX1(0.0,CH4SH2(NU(NY,NX),NY,NX)) + RFLOXS=VFLW*AMAX1(0.0,OXYSH2(NU(NY,NX),NY,NX)) + RFLNGS=VFLW*AMAX1(0.0,Z2GSH2(NU(NY,NX),NY,NX)) + RFLN2S=VFLW*AMAX1(0.0,Z2OSH2(NU(NY,NX),NY,NX)) + RFLHGS=VFLW*AMAX1(0.0,H2GSH2(NU(NY,NX),NY,NX)) + RFLNH4=VFLW*AMAX1(0.0,ZNH4H2(NU(NY,NX),NY,NX)) + 2*VLNH4(NU(NY,NX),NY,NX) + RFLNH3=VFLW*AMAX1(0.0,ZNH3H2(NU(NY,NX),NY,NX)) + 2*VLNH4(NU(NY,NX),NY,NX) + RFLNO3=VFLW*AMAX1(0.0,ZNO3H2(NU(NY,NX),NY,NX)) + 2*VLNO3(NU(NY,NX),NY,NX) + RFLNO2=VFLW*AMAX1(0.0,ZNO2H2(NU(NY,NX),NY,NX)) + 2*VLNO3(NU(NY,NX),NY,NX) + RFLP14=VFLW*AMAX1(0.0,H1P4H2(NU(NY,NX),NY,NX)) + 2*VLPO4(NU(NY,NX),NY,NX) + RFLPO4=VFLW*AMAX1(0.0,H2P4H2(NU(NY,NX),NY,NX)) + 2*VLPO4(NU(NY,NX),NY,NX) + RFLN4B=VFLW*AMAX1(0.0,ZN4BH2(NU(NY,NX),NY,NX)) + 2*VLNHB(NU(NY,NX),NY,NX) + RFLN3B=VFLW*AMAX1(0.0,ZN3BH2(NU(NY,NX),NY,NX)) + 2*VLNHB(NU(NY,NX),NY,NX) + RFLNOB=VFLW*AMAX1(0.0,ZNOBH2(NU(NY,NX),NY,NX)) + 2*VLNOB(NU(NY,NX),NY,NX) + RFLN2B=VFLW*AMAX1(0.0,ZN2BH2(NU(NY,NX),NY,NX)) + 2*VLNOB(NU(NY,NX),NY,NX) + RFLP1B=VFLW*AMAX1(0.0,H1PBH2(NU(NY,NX),NY,NX)) + 2*VLPOB(NU(NY,NX),NY,NX) + RFLPOB=VFLW*AMAX1(0.0,H2PBH2(NU(NY,NX),NY,NX)) + 2*VLPOB(NU(NY,NX),NY,NX) +C +C MICROPORE TO MACROPORE TRANSFER +C + ELSEIF(FINHM(M,NU(NY,NX),NY,NX).LT.0.0)THEN + IF(VOLWM(M,NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN + VFLW=AMIN1(0.0,AMAX1(-XFRX,FINHM(M,NU(NY,NX),NY,NX) + 2/VOLWM(M,NU(NY,NX),NY,NX))) + ELSE + VFLW=-XFRX + ENDIF + DO 9865 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)) + RFLOA(K)=VFLW*AMAX1(0.0,OQA2(K,NU(NY,NX),NY,NX)) +9865 CONTINUE + RFLCOS=VFLW*AMAX1(0.0,CO2S2(NU(NY,NX),NY,NX)) + RFLCHS=VFLW*AMAX1(0.0,CH4S2(NU(NY,NX),NY,NX)) + RFLOXS=VFLW*AMAX1(0.0,OXYS2(NU(NY,NX),NY,NX)) + RFLNGS=VFLW*AMAX1(0.0,Z2GS2(NU(NY,NX),NY,NX)) + RFLN2S=VFLW*AMAX1(0.0,Z2OS2(NU(NY,NX),NY,NX)) + RFLHGS=VFLW*AMAX1(0.0,H2GS2(NU(NY,NX),NY,NX)) + RFLNH4=VFLW*AMAX1(0.0,ZNH4S2(NU(NY,NX),NY,NX)) + 2*VLNH4(NU(NY,NX),NY,NX) + RFLNH3=VFLW*AMAX1(0.0,ZN3S2(NU(NY,NX),NY,NX)) + 2*VLNH4(NU(NY,NX),NY,NX) + RFLNO3=VFLW*AMAX1(0.0,ZNO3S2(NU(NY,NX),NY,NX)) + 2*VLNO3(NU(NY,NX),NY,NX) + RFLNO2=VFLW*AMAX1(0.0,ZNO2S2(NU(NY,NX),NY,NX)) + 2*VLNO3(NU(NY,NX),NY,NX) + RFLP14=VFLW*AMAX1(0.0,H1PO42(NU(NY,NX),NY,NX)) + 2*VLPO4(NU(NY,NX),NY,NX) + RFLPO4=VFLW*AMAX1(0.0,H2PO42(NU(NY,NX),NY,NX)) + 2*VLPO4(NU(NY,NX),NY,NX) + RFLN4B=VFLW*AMAX1(0.0,ZNH4B2(NU(NY,NX),NY,NX)) + 2*VLNHB(NU(NY,NX),NY,NX) + RFLN3B=VFLW*AMAX1(0.0,ZNBS2(NU(NY,NX),NY,NX)) + 2*VLNHB(NU(NY,NX),NY,NX) + RFLNOB=VFLW*AMAX1(0.0,ZNO3B2(NU(NY,NX),NY,NX)) + 2*VLNOB(NU(NY,NX),NY,NX) + RFLN2B=VFLW*AMAX1(0.0,ZNO2B2(NU(NY,NX),NY,NX)) + 2*VLNOB(NU(NY,NX),NY,NX) + RFLP1B=VFLW*AMAX1(0.0,H1POB2(NU(NY,NX),NY,NX)) + 2*VLPOB(NU(NY,NX),NY,NX) + RFLPOB=VFLW*AMAX1(0.0,H2POB2(NU(NY,NX),NY,NX)) + 2*VLPOB(NU(NY,NX),NY,NX) +C +C NO MACROPORE TO MICROPORE TRANSFER +C + ELSE + DO 9860 K=0,4 + RFLOC(K)=0.0 + RFLON(K)=0.0 + RFLOP(K)=0.0 + RFLOA(K)=0.0 +9860 CONTINUE + RFLCOS=0.0 + RFLCHS=0.0 + RFLOXS=0.0 + RFLNGS=0.0 + RFLN2S=0.0 + RFLHGS=0.0 + RFLNH4=0.0 + RFLNH3=0.0 + RFLNO3=0.0 + RFLNO2=0.0 + RFLP14=0.0 + RFLPO4=0.0 + RFLN4B=0.0 + RFLN3B=0.0 + RFLNOB=0.0 + RFLN2B=0.0 + RFLP1B=0.0 + RFLPOB=0.0 + ENDIF +C +C DIFFUSIVE FLUXES OF SOLUTES BETWEEN MICROPORES AND +C MACROPORES FROM AQUEOUS DIFFUSIVITIES AND CONCENTRATION DIFFERENCES +C +C +C DIFFUSIVE FLUXES OF SOLUTES BETWEEN MICROPORES AND +C MACROPORES FROM AQUEOUS DIFFUSIVITIES AND CONCENTRATION DIFFERENCES +C + IF(VOLWHM(M,NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN + 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 + 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 + DFVON(K)=XNPX*( AMAX1(0.0,OQNH2(K,NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,OQN2(K,NU(NY,NX),NY,NX))*VOLWHS)/VOLWT + DFVOP(K)=XNPX*( AMAX1(0.0,OQPH2(K,NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,OQP2(K,NU(NY,NX),NY,NX))*VOLWHS)/VOLWT + DFVOA(K)=XNPX*( AMAX1(0.0,OQAH2(K,NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,OQA2(K,NU(NY,NX),NY,NX))*VOLWHS)/VOLWT +8835 CONTINUE + DFVCOS=XNPX*( AMAX1(0.0,CO2SH2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,CO2S2(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT + DFVCHS=XNPX*( AMAX1(0.0,CH4SH2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,CH4S2(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT + DFVOXS=XNPX*( AMAX1(0.0,OXYSH2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,OXYS2(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT + DFVNGS=XNPX*( AMAX1(0.0,Z2GSH2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,Z2GS2(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT + DFVN2S=XNPX*( AMAX1(0.0,Z2OSH2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,Z2OS2(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT + DFVHGS=XNPX*( AMAX1(0.0,H2GSH2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,H2GS2(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT + DFVNH4=XNPX*( AMAX1(0.0,ZNH4H2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,ZNH4S2(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT + 3*VLNH4(NU(NY,NX),NY,NX) + DFVNH3=XNPX*( AMAX1(0.0,ZNH3H2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,ZN3S2(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT + 3*VLNH4(NU(NY,NX),NY,NX) + DFVNO3=XNPX*( AMAX1(0.0,ZNO3H2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,ZNO3S2(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT + 3*VLNO3(NU(NY,NX),NY,NX) + DFVNO2=XNPX*( AMAX1(0.0,ZNO2H2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,ZNO2S2(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT + 3*VLNO3(NU(NY,NX),NY,NX) + DFVP14=XNPX*( AMAX1(0.0,H1P4H2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,H1PO42(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT + 3*VLPO4(NU(NY,NX),NY,NX) + DFVPO4=XNPX*( AMAX1(0.0,H2P4H2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,H2PO42(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT + 3*VLPO4(NU(NY,NX),NY,NX) + DFVN4B=XNPX*( AMAX1(0.0,ZN4BH2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,ZNH4B2(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT + 3*VLNHB(NU(NY,NX),NY,NX) + DFVN3B=XNPX*( AMAX1(0.0,ZN3BH2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,ZNBS2(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT + 3*VLNHB(NU(NY,NX),NY,NX) + DFVNOB=XNPX*( AMAX1(0.0,ZNOBH2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,ZNO3B2(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT + 3*VLNOB(NU(NY,NX),NY,NX) + DFVN2B=XNPX*( AMAX1(0.0,ZN2BH2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,ZNO2B2(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT + 3*VLNOB(NU(NY,NX),NY,NX) + DFVP1B=XNPX*( AMAX1(0.0,H1PBH2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,H1POB2(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT + 3*VLPOB(NU(NY,NX),NY,NX) + DFVPOB=XNPX*( AMAX1(0.0,H2PBH2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 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 + DFVOC(K)=0.0 + DFVON(K)=0.0 + DFVOP(K)=0.0 + DFVOA(K)=0.0 +8935 CONTINUE + DFVCOS=0.0 + DFVCHS=0.0 + DFVOXS=0.0 + DFVNGS=0.0 + DFVN2S=0.0 + DFVHGS=0.0 + DFVNH4=0.0 + DFVNH3=0.0 + DFVNO3=0.0 + DFVNO2=0.0 + DFVP14=0.0 + DFVPO4=0.0 + DFVN4B=0.0 + DFVN3B=0.0 + DFVNOB=0.0 + DFVN2B=0.0 + DFVP1B=0.0 + DFVPOB=0.0 + ENDIF +C +C TOTAL CONVECTIVE +DIFFUSIVE TRANSFER BETWEEN MACROPOES AND MICROPORES +C + DO 9940 K=0,4 + ROCFXS(K,NU(NY,NX),NY,NX)=RFLOC(K)+DFVOC(K) + 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 + ROXFXS(NU(NY,NX),NY,NX)=RFLOXS+DFVOXS + RNGFXS(NU(NY,NX),NY,NX)=RFLNGS+DFVNGS + RN2FXS(NU(NY,NX),NY,NX)=RFLN2S+DFVN2S + RHGFXS(NU(NY,NX),NY,NX)=RFLHGS+DFVHGS + RN4FXW(NU(NY,NX),NY,NX)=RFLNH4+DFVNH4 + RN3FXW(NU(NY,NX),NY,NX)=RFLNH3+DFVNH3 + RNOFXW(NU(NY,NX),NY,NX)=RFLNO3+DFVNO3 + RNXFXS(NU(NY,NX),NY,NX)=RFLNO2+DFVNO2 + RH1PXS(NU(NY,NX),NY,NX)=RFLP14+DFVP14 + RH2PXS(NU(NY,NX),NY,NX)=RFLPO4+DFVPO4 + RN4FXB(NU(NY,NX),NY,NX)=RFLN4B+DFVN4B + RN3FXB(NU(NY,NX),NY,NX)=RFLN3B+DFVN3B + RNOFXB(NU(NY,NX),NY,NX)=RFLNOB+DFVNOB + RNXFXB(NU(NY,NX),NY,NX)=RFLN2B+DFVN2B + RH1BXB(NU(NY,NX),NY,NX)=RFLP1B+DFVP1B + RH2BXB(NU(NY,NX),NY,NX)=RFLPOB+DFVPOB +C +C ACCUMULATE HOURLY FLUXES +C + DO 9935 K=0,4 + 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) +9935 CONTINUE + XCOFXS(NU(NY,NX),NY,NX)=XCOFXS(NU(NY,NX),NY,NX) + 2+RCOFXS(NU(NY,NX),NY,NX) + XCHFXS(NU(NY,NX),NY,NX)=XCHFXS(NU(NY,NX),NY,NX) + 2+RCHFXS(NU(NY,NX),NY,NX) + XOXFXS(NU(NY,NX),NY,NX)=XOXFXS(NU(NY,NX),NY,NX) + 2+ROXFXS(NU(NY,NX),NY,NX) + XNGFXS(NU(NY,NX),NY,NX)=XNGFXS(NU(NY,NX),NY,NX) + 2+RNGFXS(NU(NY,NX),NY,NX) + XN2FXS(NU(NY,NX),NY,NX)=XN2FXS(NU(NY,NX),NY,NX) + 2+RN2FXS(NU(NY,NX),NY,NX) + XHGFXS(NU(NY,NX),NY,NX)=XHGFXS(NU(NY,NX),NY,NX) + 2+RHGFXS(NU(NY,NX),NY,NX) + XN4FXW(NU(NY,NX),NY,NX)=XN4FXW(NU(NY,NX),NY,NX) + 2+RN4FXW(NU(NY,NX),NY,NX) + XN3FXW(NU(NY,NX),NY,NX)=XN3FXW(NU(NY,NX),NY,NX) + 2+RN3FXW(NU(NY,NX),NY,NX) + XNOFXW(NU(NY,NX),NY,NX)=XNOFXW(NU(NY,NX),NY,NX) + 2+RNOFXW(NU(NY,NX),NY,NX) + XNXFXS(NU(NY,NX),NY,NX)=XNXFXS(NU(NY,NX),NY,NX) + 2+RNXFXS(NU(NY,NX),NY,NX) + XH1PXS(NU(NY,NX),NY,NX)=XH1PXS(NU(NY,NX),NY,NX) + 2+RH1PXS(NU(NY,NX),NY,NX) + XH2PXS(NU(NY,NX),NY,NX)=XH2PXS(NU(NY,NX),NY,NX) + 2+RH2PXS(NU(NY,NX),NY,NX) + XN4FXB(NU(NY,NX),NY,NX)=XN4FXB(NU(NY,NX),NY,NX) + 2+RN4FXB(NU(NY,NX),NY,NX) + XN3FXB(NU(NY,NX),NY,NX)=XN3FXB(NU(NY,NX),NY,NX) + 2+RN3FXB(NU(NY,NX),NY,NX) + XNOFXB(NU(NY,NX),NY,NX)=XNOFXB(NU(NY,NX),NY,NX) + 2+RNOFXB(NU(NY,NX),NY,NX) + XNXFXB(NU(NY,NX),NY,NX)=XNXFXB(NU(NY,NX),NY,NX) + 2+RNXFXB(NU(NY,NX),NY,NX) + XH1BXB(NU(NY,NX),NY,NX)=XH1BXB(NU(NY,NX),NY,NX) + 2+RH1BXB(NU(NY,NX),NY,NX) + XH2BXB(NU(NY,NX),NY,NX)=XH2BXB(NU(NY,NX),NY,NX) + 2+RH2BXB(NU(NY,NX),NY,NX) +C IF(I.EQ.235.AND.J.GE.22)THEN +C WRITE(*,441)'RH1BXB',I,J,M,NX,NY,RH1BXB(NU(NY,NX),NY,NX) +C 2,RFLP1B,DFVP1B,XH1BXB(NU(NY,NX),NY,NX),H1PBH2(NU(NY,NX),NY,NX) +C 2,H1POB2(NU(NY,NX),NY,NX) +441 FORMAT(A8,5I4,20E16.6) +C ENDIF +C +C SOLUTE TRANSPORT FROM WATER OVERLAND FLOW +C IN 'WATSUB' AND FROM SOLUTE CONCENTRATIONS +C IN SOIL SURFACE LAYER +C + N1=NX + N2=NY +C +C LOCATE INTERNAL BOUNDARIES BETWEEN ADJACENT GRID CELLS +C + DO 4310 N=1,2 + IF(N.EQ.1)THEN + IF(NX.EQ.NHE)THEN + GO TO 4310 + ELSE + N4=NX+1 + N5=NY + ENDIF + ELSEIF(N.EQ.2)THEN + IF(NY.EQ.NVS)THEN + GO TO 4310 + ELSE + N4=NX + N5=NY+1 + ENDIF + ENDIF +C +C IF NO OVERLAND FLOW THEN NO TRANSPORT +C + IF(QRM(M,N,N5,N4).EQ.0.0)THEN + DO 9840 K=0,2 + RQROC(K,N,N5,N4)=0.0 + RQRON(K,N,N5,N4)=0.0 + RQROP(K,N,N5,N4)=0.0 + RQROA(K,N,N5,N4)=0.0 +9840 CONTINUE + RQRCOS(N,N5,N4)=0.0 + RQRCHS(N,N5,N4)=0.0 + RQROXS(N,N5,N4)=0.0 + RQRNGS(N,N5,N4)=0.0 + RQRN2S(N,N5,N4)=0.0 + RQRHGS(N,N5,N4)=0.0 + RQRNH4(N,N5,N4)=0.0 + RQRNH3(N,N5,N4)=0.0 + RQRNO3(N,N5,N4)=0.0 + RQRNO2(N,N5,N4)=0.0 + RQRH1P(N,N5,N4)=0.0 + RQRH2P(N,N5,N4)=0.0 +C +C IF OVERLAND FLOW IS FROM CURRENT TO ADJACENT GRID CELL +C + ELSEIF(QRM(M,N,N5,N4).GT.0.0)THEN + IF(VOLWM(M,0,N2,N1).GT.ZEROS(N2,N1))THEN + VFLW=AMAX1(0.0,AMIN1(XFRX,QRM(M,N,N5,N4)/VOLWM(M,0,N2,N1))) + ELSE + VFLW=XFRX + ENDIF + DO 9835 K=0,2 + 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)) + RQROA(K,N,N5,N4)=VFLW*AMAX1(0.0,OQA2(K,0,N2,N1)) +9835 CONTINUE + RQRCOS(N,N5,N4)=VFLW*AMAX1(0.0,CO2S2(0,N2,N1)) + RQRCHS(N,N5,N4)=VFLW*AMAX1(0.0,CH4S2(0,N2,N1)) + RQROXS(N,N5,N4)=VFLW*AMAX1(0.0,OXYS2(0,N2,N1)) + RQRNGS(N,N5,N4)=VFLW*AMAX1(0.0,Z2GS2(0,N2,N1)) + RQRN2S(N,N5,N4)=VFLW*AMAX1(0.0,Z2OS2(0,N2,N1)) + RQRHGS(N,N5,N4)=VFLW*AMAX1(0.0,H2GS2(0,N2,N1)) + RQRNH4(N,N5,N4)=VFLW*AMAX1(0.0,ZNH4S2(0,N2,N1)) + RQRNH3(N,N5,N4)=VFLW*AMAX1(0.0,ZN3S2(0,N2,N1)) + RQRNO3(N,N5,N4)=VFLW*AMAX1(0.0,ZNO3S2(0,N2,N1)) + RQRNO2(N,N5,N4)=VFLW*AMAX1(0.0,ZNO2S2(0,N2,N1)) + RQRH1P(N,N5,N4)=VFLW*AMAX1(0.0,H1PO42(0,N2,N1)) + RQRH2P(N,N5,N4)=VFLW*AMAX1(0.0,H2PO42(0,N2,N1)) +C +C IF OVERLAND FLOW IS TO CURRENT FROM ADJACENT GRID CELL +C + ELSEIF(QRM(M,N,N5,N4).LT.0.0)THEN + IF(VOLWM(M,0,N5,N4).GT.ZEROS(N5,N4))THEN + VFLW=AMIN1(0.0,AMAX1(-XFRX,QRM(M,N,N5,N4)/VOLWM(M,0,N5,N4))) + ELSE + VFLW=-XFRX + ENDIF + DO 9830 K=0,2 + 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)) + RQROA(K,N,N5,N4)=VFLW*AMAX1(0.0,OQA2(K,0,N5,N4)) +9830 CONTINUE + RQRCOS(N,N5,N4)=VFLW*AMAX1(0.0,CO2S2(0,N5,N4)) + RQRCHS(N,N5,N4)=VFLW*AMAX1(0.0,CH4S2(0,N5,N4)) + RQROXS(N,N5,N4)=VFLW*AMAX1(0.0,OXYS2(0,N5,N4)) + RQRNGS(N,N5,N4)=VFLW*AMAX1(0.0,Z2GS2(0,N5,N4)) + RQRN2S(N,N5,N4)=VFLW*AMAX1(0.0,Z2OS2(0,N5,N4)) + RQRHGS(N,N5,N4)=VFLW*AMAX1(0.0,H2GS2(0,N5,N4)) + RQRNH4(N,N5,N4)=VFLW*AMAX1(0.0,ZNH4S2(0,N5,N4)) + RQRNH3(N,N5,N4)=VFLW*AMAX1(0.0,ZN3S2(0,N5,N4)) + RQRNO3(N,N5,N4)=VFLW*AMAX1(0.0,ZNO3S2(0,N5,N4)) + RQRNO2(N,N5,N4)=VFLW*AMAX1(0.0,ZNO2S2(0,N5,N4)) + RQRH1P(N,N5,N4)=VFLW*AMAX1(0.0,H1PO42(0,N5,N4)) + RQRH2P(N,N5,N4)=VFLW*AMAX1(0.0,H2PO42(0,N5,N4)) + ENDIF +C +C ACCUMULATE HOURLY FLUXES +C + DO 9825 K=0,2 + 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) + XOAQRS(K,N,N5,N4)=XOAQRS(K,N,N5,N4)+RQROA(K,N,N5,N4) +9825 CONTINUE + XCOQRS(N,N5,N4)=XCOQRS(N,N5,N4)+RQRCOS(N,N5,N4) + XCHQRS(N,N5,N4)=XCHQRS(N,N5,N4)+RQRCHS(N,N5,N4) + XOXQRS(N,N5,N4)=XOXQRS(N,N5,N4)+RQROXS(N,N5,N4) + XNGQRS(N,N5,N4)=XNGQRS(N,N5,N4)+RQRNGS(N,N5,N4) + XN2QRS(N,N5,N4)=XN2QRS(N,N5,N4)+RQRN2S(N,N5,N4) + XHGQRS(N,N5,N4)=XHGQRS(N,N5,N4)+RQRHGS(N,N5,N4) + XN4QRW(N,N5,N4)=XN4QRW(N,N5,N4)+RQRNH4(N,N5,N4) + XN3QRW(N,N5,N4)=XN3QRW(N,N5,N4)+RQRNH3(N,N5,N4) + XNOQRW(N,N5,N4)=XNOQRW(N,N5,N4)+RQRNO3(N,N5,N4) + XNXQRS(N,N5,N4)=XNXQRS(N,N5,N4)+RQRNO2(N,N5,N4) + XP1QRW(N,N5,N4)=XP1QRW(N,N5,N4)+RQRH1P(N,N5,N4) + XP4QRW(N,N5,N4)=XP4QRW(N,N5,N4)+RQRH2P(N,N5,N4) +C +C IF NO SNOW DRIFT THEN NO TRANSPORT +C + IF(QSM(M,N,N5,N4).EQ.0.0)THEN + RQSCOS(N,N5,N4)=0.0 + RQSCHS(N,N5,N4)=0.0 + RQSOXS(N,N5,N4)=0.0 + RQSNGS(N,N5,N4)=0.0 + RQSN2S(N,N5,N4)=0.0 + RQSNH4(N,N5,N4)=0.0 + RQSNH3(N,N5,N4)=0.0 + RQSNO3(N,N5,N4)=0.0 + RQSH1P(N,N5,N4)=0.0 + RQSH2P(N,N5,N4)=0.0 +C +C IF DRIFT IS FROM CURRENT TO ADJACENT GRID CELL +C + ELSEIF(QSM(M,N,N5,N4).GT.0.0)THEN + IF(VOLS(N2,N1).GT.ZEROS(N2,N1))THEN + VFLW=AMAX1(0.0,AMIN1(XFRX,QSM(M,N,N5,N4)/VOLS(N2,N1))) + ELSE + VFLW=XFRX + ENDIF + RQSCOS(N,N5,N4)=VFLW*AMAX1(0.0,CO2W2(N2,N1)) + RQSCHS(N,N5,N4)=VFLW*AMAX1(0.0,CH4W2(N2,N1)) + RQSOXS(N,N5,N4)=VFLW*AMAX1(0.0,OXYW2(N2,N1)) + RQSNGS(N,N5,N4)=VFLW*AMAX1(0.0,ZNGW2(N2,N1)) + RQSN2S(N,N5,N4)=VFLW*AMAX1(0.0,ZN2W2(N2,N1)) + RQSNH4(N,N5,N4)=VFLW*AMAX1(0.0,ZN4W2(N2,N1)) + RQSNH3(N,N5,N4)=VFLW*AMAX1(0.0,ZN3W2(N2,N1)) + RQSNO3(N,N5,N4)=VFLW*AMAX1(0.0,ZNOW2(N2,N1)) + RQSH1P(N,N5,N4)=VFLW*AMAX1(0.0,Z1PW2(N2,N1)) + RQSH2P(N,N5,N4)=VFLW*AMAX1(0.0,ZHPW2(N2,N1)) +C +C IF DRIFT IS TO CURRENT FROM ADJACENT GRID CELL +C + ELSEIF(QSM(M,N,N5,N4).LT.0.0)THEN + IF(VOLS(N5,N4).GT.ZEROS(N5,N4))THEN + VFLW=AMIN1(0.0,AMAX1(-XFRX,QSM(M,N,N5,N4)/VOLS(N5,N4))) + ELSE + VFLW=-XFRX + ENDIF + RQSCOS(N,N5,N4)=VFLW*AMAX1(0.0,CO2W2(N5,N4)) + RQSCHS(N,N5,N4)=VFLW*AMAX1(0.0,CH4W2(N5,N4)) + RQSOXS(N,N5,N4)=VFLW*AMAX1(0.0,OXYW2(N5,N4)) + RQSNGS(N,N5,N4)=VFLW*AMAX1(0.0,ZNGW2(N5,N4)) + RQSN2S(N,N5,N4)=VFLW*AMAX1(0.0,ZN2W2(N5,N4)) + RQSNH4(N,N5,N4)=VFLW*AMAX1(0.0,ZN4W2(N5,N4)) + RQSNH3(N,N5,N4)=VFLW*AMAX1(0.0,ZN3W2(N5,N4)) + RQSNO3(N,N5,N4)=VFLW*AMAX1(0.0,ZNOW2(N5,N4)) + RQSH1P(N,N5,N4)=VFLW*AMAX1(0.0,Z1PW2(N5,N4)) + RQSH2P(N,N5,N4)=VFLW*AMAX1(0.0,ZHPW2(N5,N4)) + ENDIF +C +C ACCUMULATE HOURLY FLUXES +C + XCOQSS(N,N5,N4)=XCOQSS(N,N5,N4)+RQSCOS(N,N5,N4) + XCHQSS(N,N5,N4)=XCHQSS(N,N5,N4)+RQSCHS(N,N5,N4) + XOXQSS(N,N5,N4)=XOXQSS(N,N5,N4)+RQSOXS(N,N5,N4) + XNGQSS(N,N5,N4)=XNGQSS(N,N5,N4)+RQSNGS(N,N5,N4) + XN2QSS(N,N5,N4)=XN2QSS(N,N5,N4)+RQSN2S(N,N5,N4) + XN4QSS(N,N5,N4)=XN4QSS(N,N5,N4)+RQSNH4(N,N5,N4) + XN3QSS(N,N5,N4)=XN3QSS(N,N5,N4)+RQSNH3(N,N5,N4) + XNOQSS(N,N5,N4)=XNOQSS(N,N5,N4)+RQSNO3(N,N5,N4) + XP1QSS(N,N5,N4)=XP1QSS(N,N5,N4)+RQSH1P(N,N5,N4) + XP4QSS(N,N5,N4)=XP4QSS(N,N5,N4)+RQSH2P(N,N5,N4) +C IF(I.EQ.118.AND.NX.EQ.3.AND.NY.EQ.4)THEN +C WRITE(*,6969)'XOXQSS',I,J,N4,N5,N,M,MM,XOXQSS(N,N5,N4) +C 2,RQSOXS(N,N5,N4),VFLW,OXYW2(N2,N1),OXYW2(N5,N4) +C 3,QSM(M,N,N5,N4),VOLS(N2,N1),VOLS(N5,N4) +6969 FORMAT(A8,7I4,20E12.4) +C ENDIF +4310 CONTINUE + ENDIF +C +C VOLATILIZATION-DISSOLUTION OF GASES IN RESIDUE AND SOIL SURFACE +C LAYERS FROM GASEOUS CONCENTRATIONS VS. THEIR AQUEOUS +C EQUIVALENTS DEPENDING ON SOLUBILITY FROM 'HOUR1' +C AND TRANSFER COEFFICIENT 'DFGS' FROM 'WATSUB' +C + IF(VOLWM(M,0,NY,NX).GT.ZEROS(NY,NX))THEN + CO2G0=CCO2G(0,NY,NX)*VOLPM(M,0,NY,NX) + CH4G0=CCH4G(0,NY,NX)*VOLPM(M,0,NY,NX) + OXYG0=COXYG(0,NY,NX)*VOLPM(M,0,NY,NX) + Z2GG0=CZ2GG(0,NY,NX)*VOLPM(M,0,NY,NX) + Z2OG0=CZ2OG(0,NY,NX)*VOLPM(M,0,NY,NX) + ZN3G0=CNH3G(0,NY,NX)*VOLPM(M,0,NY,NX) + H2GG0=CH2GG(0,NY,NX)*VOLPM(M,0,NY,NX) + VOLCOR(NY,NX)=VOLWCO(0,NY,NX)+VOLPM(M,0,NY,NX) + VOLCHR(NY,NX)=VOLWCH(0,NY,NX)+VOLPM(M,0,NY,NX) + VOLOXR(NY,NX)=VOLWOX(0,NY,NX)+VOLPM(M,0,NY,NX) + VOLNGR(NY,NX)=VOLWNG(0,NY,NX)+VOLPM(M,0,NY,NX) + VOLN2R(NY,NX)=VOLWN2(0,NY,NX)+VOLPM(M,0,NY,NX) + VOLN3R(NY,NX)=VOLWN3(0,NY,NX)+VOLPM(M,0,NY,NX) + VOLHGR(NY,NX)=VOLWHG(0,NY,NX)+VOLPM(M,0,NY,NX) + RCODFG(0,NY,NX)=DFGS(M,0,NY,NX) + 2*(AMAX1(ZEROS(NY,NX),CO2G0)*VOLWCO(0,NY,NX) + 3-AMAX1(ZEROS(NY,NX),CO2S2(0,NY,NX)+RCODXR) + 4*VOLPM(M,0,NY,NX))/VOLCOR(NY,NX) + RCHDFG(0,NY,NX)=DFGS(M,0,NY,NX) + 2*(AMAX1(ZEROS(NY,NX),CH4G0)*VOLWCH(0,NY,NX) + 3-AMAX1(ZEROS(NY,NX),CH4S2(0,NY,NX)+RCHDXR) + 4*VOLPM(M,0,NY,NX))/VOLCHR(NY,NX) + ROXDFG(0,NY,NX)=DFGS(M,0,NY,NX) + 2*(AMAX1(ZEROS(NY,NX),OXYG0)*VOLWOX(0,NY,NX) + 3-AMAX1(ZEROS(NY,NX),OXYS2(0,NY,NX)+ROXDXR) + 4*VOLPM(M,0,NY,NX))/VOLOXR(NY,NX) + RNGDFG(0,NY,NX)=DFGS(M,0,NY,NX) + 2*(AMAX1(ZEROS(NY,NX),Z2GG0)*VOLWNG(0,NY,NX) + 3-AMAX1(ZEROS(NY,NX),Z2GS2(0,NY,NX)+RNGDXR) + 4*VOLPM(M,0,NY,NX))/VOLNGR(NY,NX) + RN2DFG(0,NY,NX)=DFGS(M,0,NY,NX) + 2*(AMAX1(ZEROS(NY,NX),Z2OG0)*VOLWN2(0,NY,NX) + 3-AMAX1(ZEROS(NY,NX),Z2OS2(0,NY,NX)+RN2DXR) + 4*VOLPM(M,0,NY,NX))/VOLN2R(NY,NX) + RN3DFG(0,NY,NX)=DFGS(M,0,NY,NX) + 2*(AMAX1(ZEROS(NY,NX),ZN3G0)*VOLWN3(0,NY,NX) + 3-AMAX1(ZEROS(NY,NX),ZN3S2(0,NY,NX)+RN3DXR) + 4*VOLPM(M,0,NY,NX))/VOLN3R(NY,NX) + CNH3S0=AMAX1(0.0,(ZN3S2(0,NY,NX)+RN3DFG(0,NY,NX))) + 2/VOLWXA(0,NY,NX) + CNH4S0=AMAX1(0.0,ZNH4S2(0,NY,NX)) + 2/VOLWXA(0,NY,NX) + RHGDFG(0,NY,NX)=DFGS(M,0,NY,NX) + 2*(AMAX1(ZEROS(NY,NX),H2GG0)*VOLWHG(0,NY,NX) + 3-AMAX1(ZEROS(NY,NX),H2GS2(0,NY,NX)+RHGDXR) + 4*VOLPM(M,0,NY,NX))/VOLHGR(NY,NX) +C +C ACCUMULATE HOURLY FLUXES +C + XCODFG(0,NY,NX)=XCODFG(0,NY,NX)+RCODFG(0,NY,NX) + XCHDFG(0,NY,NX)=XCHDFG(0,NY,NX)+RCHDFG(0,NY,NX) + XOXDFG(0,NY,NX)=XOXDFG(0,NY,NX)+ROXDFG(0,NY,NX) + XNGDFG(0,NY,NX)=XNGDFG(0,NY,NX)+RNGDFG(0,NY,NX) + XN2DFG(0,NY,NX)=XN2DFG(0,NY,NX)+RN2DFG(0,NY,NX) + XN3DFG(0,NY,NX)=XN3DFG(0,NY,NX)+RN3DFG(0,NY,NX) + XHGDFG(0,NY,NX)=XHGDFG(0,NY,NX)+RHGDFG(0,NY,NX) +C IF(J.EQ.24)THEN +C WRITE(*,323)'RCHDFG',I,J,NX,NY,M,MM,RCHDFG(0,NY,NX) +C 2,DFGS(M,0,NY,NX),CH4G0,VOLWCH(0,NY,NX),CH4S2(0,NY,NX) +C 3,VOLPM(M,0,NY,NX),VOLCHR(NY,NX),RCHDXR +C WRITE(*,323)'ROXDFG',I,J,NX,NY,M,MM,ROXDFG(0,NY,NX) +C 2,DFGS(M,0,NY,NX),OXYG0,VOLWOX(0,NY,NX),OXYS2(0,NY,NX) +C 3,VOLPM(M,0,NY,NX),VOLOXR(NY,NX),ROXDXR,XOXDFG(0,NY,NX) +323 FORMAT(A8,6I4,30E12.4) +C ENDIF + ELSE + RCODFG(0,NY,NX)=0.0 + RCHDFG(0,NY,NX)=0.0 + ROXDFG(0,NY,NX)=0.0 + RNGDFG(0,NY,NX)=0.0 + RN2DFG(0,NY,NX)=0.0 + RN3DFG(0,NY,NX)=0.0 + RHGDFG(0,NY,NX)=0.0 + ENDIF +C +C SURFACE GAS EXCHANGE FROM GAS DIFFUSIVITY THROUGH +C SOIL SURFACE LAYER AND THROUGH ATMOSPHERE BOUNDARY +C LAYER +C + IF(THETPM(M,NU(NY,NX),NY,NX).GT.THETX + 2.AND.BKDS(NU(NY,NX),NY,NX).GT.0.0)THEN +C +C GASEOUS DIFFUSIVITIES +C + DFLG2=AMAX1(0.0,THETPM(M,NU(NY,NX),NY,NX))**2 + 2/POROQ(NU(NY,NX),NY,NX)*AREA(3,NU(NY,NX),NY,NX) + 3/AMAX1(0.001,DLYR(3,NU(NY,NX),NY,NX)) + DCO2G(3,NU(NY,NX),NY,NX)=DFLG2*CGSGL2(NU(NY,NX),NY,NX) + DCH4G(3,NU(NY,NX),NY,NX)=DFLG2*CHSGL2(NU(NY,NX),NY,NX) + DOXYG(3,NU(NY,NX),NY,NX)=DFLG2*OGSGL2(NU(NY,NX),NY,NX) + DZ2GG(3,NU(NY,NX),NY,NX)=DFLG2*ZGSGL2(NU(NY,NX),NY,NX) + DZ2OG(3,NU(NY,NX),NY,NX)=DFLG2*Z2SGL2(NU(NY,NX),NY,NX) + DNH3G(3,NU(NY,NX),NY,NX)=DFLG2*ZHSGL2(NU(NY,NX),NY,NX) + DH2GG(3,NU(NY,NX),NY,NX)=DFLG2*HGSGL2(NU(NY,NX),NY,NX) +C +C SURFACE GAS CONCENTRATIONS +C + CCO2G2=AMAX1(0.0,CO2G2(NU(NY,NX),NY,NX) + 2/VOLPM(M,NU(NY,NX),NY,NX)) + CCH4G2=AMAX1(0.0,CH4G2(NU(NY,NX),NY,NX) + 2/VOLPM(M,NU(NY,NX),NY,NX)) + COXYG2=AMAX1(0.0,OXYG2(NU(NY,NX),NY,NX) + 2/VOLPM(M,NU(NY,NX),NY,NX)) + CZ2GG2=AMAX1(0.0,Z2GG2(NU(NY,NX),NY,NX) + 2/VOLPM(M,NU(NY,NX),NY,NX)) + CZ2OG2=AMAX1(0.0,Z2OG2(NU(NY,NX),NY,NX) + 2/VOLPM(M,NU(NY,NX),NY,NX)) + CNH3G2=AMAX1(0.0,ZN3G2(NU(NY,NX),NY,NX) + 2/VOLPM(M,NU(NY,NX),NY,NX)) + CH2GG2=AMAX1(0.0,H2GG2(NU(NY,NX),NY,NX) + 2/VOLPM(M,NU(NY,NX),NY,NX)) +C +C EQUILIBRIUM CONCENTRATIONS AT SOIL SURFACE AT WHICH +C GASEOUS DIFFUSION THROUGH SOIL SURFACE LAYER = GASEOUS +C DIFFUSION THROUGH ATMOSPHERE BOUNDARY LAYER CALCULATED +C FROM GASEOUS DIFFUSIVITY AND BOUNDARY LAYER CONDUCTANCE +C + DCO2GQ=DCO2G(3,NU(NY,NX),NY,NX)*PARGCO(NY,NX) + 2/(DCO2G(3,NU(NY,NX),NY,NX)+PARGCO(NY,NX)) + DCH4GQ=DCH4G(3,NU(NY,NX),NY,NX)*PARGCH(NY,NX) + 2/(DCH4G(3,NU(NY,NX),NY,NX)+PARGCH(NY,NX)) + DOXYGQ=DOXYG(3,NU(NY,NX),NY,NX)*PARGOX(NY,NX) + 2/(DOXYG(3,NU(NY,NX),NY,NX)+PARGOX(NY,NX)) + DZ2GGQ=DZ2GG(3,NU(NY,NX),NY,NX)*PARGNG(NY,NX) + 2/(DZ2GG(3,NU(NY,NX),NY,NX)+PARGNG(NY,NX)) + DZ2OGQ=DZ2OG(3,NU(NY,NX),NY,NX)*PARGN2(NY,NX) + 2/(DZ2OG(3,NU(NY,NX),NY,NX)+PARGN2(NY,NX)) + DNH3GQ=DNH3G(3,NU(NY,NX),NY,NX)*PARGN3(NY,NX) + 2/(DNH3G(3,NU(NY,NX),NY,NX)+PARGN3(NY,NX)) + DH2GGQ=DH2GG(3,NU(NY,NX),NY,NX)*PARGH2(NY,NX) + 2/(DH2GG(3,NU(NY,NX),NY,NX)+PARGH2(NY,NX)) + DFVCOG=DCO2GQ*(CCO2E(NY,NX)-CCO2G2) + DFVCHG=DCH4GQ*(CCH4E(NY,NX)-CCH4G2) + DFVOXG=DOXYGQ*(COXYE(NY,NX)-COXYG2) + DFVNGG=DZ2GGQ*(CZ2GE(NY,NX)-CZ2GG2) + DFVN2G=DZ2OGQ*(CZ2OE(NY,NX)-CZ2OG2) + DFVN3G=DNH3GQ*(CNH3E(NY,NX)-CNH3G2) + DFVHGG=DH2GGQ*(CH2GE(NY,NX)-CH2GG2) +C +C CONVECTIVE GAS TRANSFER DRIVEN BY SURFACE WATER FLUXES +C FROM 'WATSUB' AND GAS CONCENTRATIONS IN THE SOIL SURFACE +C OR THE ATMOSPHERE DEPENDING ON WATER FLUX DIRECTION +C + IF(FLQM(3,NU(NY,NX),NY,NX).GT.0.0)THEN + IF(VOLPM(M,NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN + VFLW=-AMAX1(0.0,AMIN1(XFRX,FLQM(3,NU(NY,NX),NY,NX) + 2/VOLPM(M,NU(NY,NX),NY,NX))) + ELSE + VFLW=-XFRX + ENDIF + RFLCOG=VFLW*AMAX1(0.0,CO2G2(NU(NY,NX),NY,NX)) + RFLCHG=VFLW*AMAX1(0.0,CH4G2(NU(NY,NX),NY,NX)) + RFLOXG=VFLW*AMAX1(0.0,OXYG2(NU(NY,NX),NY,NX)) + RFLNGG=VFLW*AMAX1(0.0,Z2GG2(NU(NY,NX),NY,NX)) + RFLN2G=VFLW*AMAX1(0.0,Z2OG2(NU(NY,NX),NY,NX)) + RFLN3G=VFLW*AMAX1(0.0,ZN3G2(NU(NY,NX),NY,NX)) + RFLH2G=VFLW*AMAX1(0.0,H2GG2(NU(NY,NX),NY,NX)) + ELSE + RFLCOG=-FLQM(3,NU(NY,NX),NY,NX)*CCO2E(NY,NX) + RFLCHG=-FLQM(3,NU(NY,NX),NY,NX)*CCH4E(NY,NX) + RFLOXG=-FLQM(3,NU(NY,NX),NY,NX)*COXYE(NY,NX) + RFLNGG=-FLQM(3,NU(NY,NX),NY,NX)*CZ2GE(NY,NX) + RFLN2G=-FLQM(3,NU(NY,NX),NY,NX)*CZ2OE(NY,NX) + RFLN3G=-FLQM(3,NU(NY,NX),NY,NX)*CNH3E(NY,NX) + RFLH2G=-FLQM(3,NU(NY,NX),NY,NX)*CH2GE(NY,NX) + ENDIF +C +C SURFACE GAS FLUX FROM DIFFERENCES +C BETWEEN ATMOSPHERIC AND SOIL SURFACE EQUILIBRIUM +C CONCENTRATIONS + CONVECTIVE FLUX +C + RCOFLG(3,NU(NY,NX),NY,NX)=DFVCOG+RFLCOG + RCHFLG(3,NU(NY,NX),NY,NX)=DFVCHG+RFLCHG + ROXFLG(3,NU(NY,NX),NY,NX)=DFVOXG+RFLOXG + RNGFLG(3,NU(NY,NX),NY,NX)=DFVNGG+RFLNGG + RN2FLG(3,NU(NY,NX),NY,NX)=DFVN2G+RFLN2G + RN3FLG(3,NU(NY,NX),NY,NX)=DFVN3G+RFLN3G + RHGFLG(3,NU(NY,NX),NY,NX)=DFVHGG+RFLH2G +C +C ACCUMULATE HOURLY FLUXES +C + XCOFLG(3,NU(NY,NX),NY,NX)=XCOFLG(3,NU(NY,NX),NY,NX) + 2+RCOFLG(3,NU(NY,NX),NY,NX) + XCHFLG(3,NU(NY,NX),NY,NX)=XCHFLG(3,NU(NY,NX),NY,NX) + 2+RCHFLG(3,NU(NY,NX),NY,NX) + XOXFLG(3,NU(NY,NX),NY,NX)=XOXFLG(3,NU(NY,NX),NY,NX) + 2+ROXFLG(3,NU(NY,NX),NY,NX) + XNGFLG(3,NU(NY,NX),NY,NX)=XNGFLG(3,NU(NY,NX),NY,NX) + 2+RNGFLG(3,NU(NY,NX),NY,NX) + XN2FLG(3,NU(NY,NX),NY,NX)=XN2FLG(3,NU(NY,NX),NY,NX) + 2+RN2FLG(3,NU(NY,NX),NY,NX) + XN3FLG(3,NU(NY,NX),NY,NX)=XN3FLG(3,NU(NY,NX),NY,NX) + 2+RN3FLG(3,NU(NY,NX),NY,NX) + XHGFLG(3,NU(NY,NX),NY,NX)=XHGFLG(3,NU(NY,NX),NY,NX) + 2+RHGFLG(3,NU(NY,NX),NY,NX) +C IF(J.EQ.24)THEN +C WRITE(*,3131)'ROXFLG',I,J,NX,NY,M,MM,XOXFLG(3,NU(NY,NX),NY,NX) +C 2,ROXFLG(3,NU(NY,NX),NY,NX),DFVOXG,RFLOXG,COXYE(NY,NX) +C 2,COXYG2,DOXYGQ,OXYG2(NU(NY,NX),NY,NX),FLQM(3,NU(NY,NX),NY,NX) +C 3,VFLW,DOXYG(3,NU(NY,NX),NY,NX),PARGOX(NY,NX) +C 4,THETPM(M,NU(NY,NX),NY,NX),VOLPM(M,NU(NY,NX),NY,NX) +C 5,DFGS(M,NU(NY,NX),NY,NX) +C WRITE(*,3131)'RNGFLG',I,J,NX,NY,M,MM,XNGFLG(3,NU(NY,NX),NY,NX) +C 2,RNGFLG(3,NU(NY,NX),NY,NX),DFVNGG,RFLNGG,CZ2GE(NY,NX) +C 2,CZ2GG2,DZ2GGQ,Z2GG2(NU(NY,NX),NY,NX),FLQM(3,NU(NY,NX),NY,NX) +C 3,VFLW,DZ2GG(3,NU(NY,NX),NY,NX),PARGNG(NY,NX) +C 4,THETPM(M,NU(NY,NX),NY,NX),VOLPM(M,NU(NY,NX),NY,NX) +3131 FORMAT(A8,6I4,30E12.4) +C ENDIF +C +C SOIL SURFACE +C + IF(THETW1(NU(NY,NX),NY,NX).GT.THETY(NU(NY,NX),NY,NX))THEN + VOLCOT(NY,NX)=VOLWCO(NU(NY,NX),NY,NX)+VOLPM(M,NU(NY,NX),NY,NX) + VOLCHT(NY,NX)=VOLWCH(NU(NY,NX),NY,NX)+VOLPM(M,NU(NY,NX),NY,NX) + VOLOXT(NY,NX)=VOLWOX(NU(NY,NX),NY,NX)+VOLPM(M,NU(NY,NX),NY,NX) + VOLNGT(NY,NX)=VOLWNG(NU(NY,NX),NY,NX)+VOLPM(M,NU(NY,NX),NY,NX) + VOLN2T(NY,NX)=VOLWN2(NU(NY,NX),NY,NX)+VOLPM(M,NU(NY,NX),NY,NX) + VOLN3T(NY,NX)=VOLWN3(NU(NY,NX),NY,NX)+VOLPMA(NU(NY,NX),NY,NX) + VOLNBT(NY,NX)=VOLWNB(NU(NY,NX),NY,NX)+VOLPMB(NU(NY,NX),NY,NX) + VOLHGT(NY,NX)=VOLWHG(NU(NY,NX),NY,NX)+VOLPM(M,NU(NY,NX),NY,NX) + RCODFG(NU(NY,NX),NY,NX)=DFGS(M,NU(NY,NX),NY,NX) + 2*(AMAX1(ZEROS(NY,NX),CO2G2(NU(NY,NX),NY,NX)) + 3*VOLWCO(NU(NY,NX),NY,NX)-AMAX1(ZEROS(NY,NX) + 2,CO2S2(NU(NY,NX),NY,NX)+RCODXS) + 4*VOLPM(M,NU(NY,NX),NY,NX))/VOLCOT(NY,NX) + RCHDFG(NU(NY,NX),NY,NX)=DFGS(M,NU(NY,NX),NY,NX) + 2*(AMAX1(ZEROS(NY,NX),CH4G2(NU(NY,NX),NY,NX)) + 3*VOLWCH(NU(NY,NX),NY,NX)-AMAX1(ZEROS(NY,NX) + 2,CH4S2(NU(NY,NX),NY,NX)+RCHDXS) + 4*VOLPM(M,NU(NY,NX),NY,NX))/VOLCHT(NY,NX) + ROXDFG(NU(NY,NX),NY,NX)=DFGS(M,NU(NY,NX),NY,NX) + 2*(AMAX1(ZEROS(NY,NX),OXYG2(NU(NY,NX),NY,NX)) + 3*VOLWOX(NU(NY,NX),NY,NX)-AMAX1(ZEROS(NY,NX) + 2,OXYS2(NU(NY,NX),NY,NX)+ROXDXS) + 4*VOLPM(M,NU(NY,NX),NY,NX))/VOLOXT(NY,NX) + RNGDFG(NU(NY,NX),NY,NX)=DFGS(M,NU(NY,NX),NY,NX) + 2*(AMAX1(ZEROS(NY,NX),Z2GG2(NU(NY,NX),NY,NX)) + 3*VOLWNG(NU(NY,NX),NY,NX)-AMAX1(ZEROS(NY,NX) + 4,Z2GS2(NU(NY,NX),NY,NX)+RNGDXS) + 4*VOLPM(M,NU(NY,NX),NY,NX))/VOLNGT(NY,NX) + RN2DFG(NU(NY,NX),NY,NX)=DFGS(M,NU(NY,NX),NY,NX) + 2*(AMAX1(ZEROS(NY,NX),Z2OG2(NU(NY,NX),NY,NX)) + 3*VOLWN2(NU(NY,NX),NY,NX)-AMAX1(ZEROS(NY,NX) + 2,Z2OS2(NU(NY,NX),NY,NX)+RN2DXS) + 4*VOLPM(M,NU(NY,NX),NY,NX))/VOLN2T(NY,NX) + IF(VOLN3T(NY,NX).GT.ZEROS(NY,NX) + 2.AND.VOLWXA(NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN + RN3DFG(NU(NY,NX),NY,NX)=DFGS(M,NU(NY,NX),NY,NX) + 2*(AMAX1(ZEROS(NY,NX),ZN3G2(NU(NY,NX),NY,NX)) + 3*VOLWN3(NU(NY,NX),NY,NX)-AMAX1(ZEROS(NY,NX) + 4,ZN3S2(NU(NY,NX),NY,NX)+RN3DXS) + 5*VOLPMA(NU(NY,NX),NY,NX))/VOLN3T(NY,NX) + CNH3S0=AMAX1(0.0,(ZN3S2(NU(NY,NX),NY,NX) + 2+RN3DFG(NU(NY,NX),NY,NX))/VOLWXA(NU(NY,NX),NY,NX)) + CNH4S0=AMAX1(0.0,ZNH4S2(NU(NY,NX),NY,NX)) + 2/VOLWXA(NU(NY,NX),NY,NX) + ELSE + RN3DFG(NU(NY,NX),NY,NX)=0.0 + ENDIF + IF(VOLNBT(NY,NX).GT.ZEROS(NY,NX) + 2.AND.VOLWXB(NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN + RNBDFG(NU(NY,NX),NY,NX)=DFGS(M,NU(NY,NX),NY,NX) + 2*(AMAX1(ZEROS(NY,NX),ZN3G2(NU(NY,NX),NY,NX)) + 3*VOLWNB(NU(NY,NX),NY,NX)-AMAX1(ZEROS(NY,NX) + 4,ZNBS2(NU(NY,NX),NY,NX)+RNBDXS) + 5*VOLPMB(NU(NY,NX),NY,NX))/VOLNBT(NY,NX) + CNH3B0=AMAX1(0.0,(ZNBS2(NU(NY,NX),NY,NX) + 2+RNBDFG(NU(NY,NX),NY,NX))/VOLWXB(NU(NY,NX),NY,NX)) + CNH4B0=AMAX1(0.0,ZNH4B2(NU(NY,NX),NY,NX)) + 2/VOLWXB(NU(NY,NX),NY,NX) + ELSE + RNBDFG(NU(NY,NX),NY,NX)=0.0 + ENDIF + RHGDFG(NU(NY,NX),NY,NX)=DFGS(M,NU(NY,NX),NY,NX) + 2*(AMAX1(ZEROS(NY,NX),H2GG2(NU(NY,NX),NY,NX)) + 3*VOLWHG(NU(NY,NX),NY,NX)-AMAX1(ZEROS(NY,NX) + 4,H2GS2(NU(NY,NX),NY,NX)+RHGDXS) + 4*VOLPM(M,NU(NY,NX),NY,NX))/VOLHGT(NY,NX) +C IF(J.EQ.12)THEN +C WRITE(*,323)'RN3FLG',I,J,NX,NY,M,MM,RN3FLG(3,NU(NY,NX),NY,NX) +C 2,DNH3GQ,CNH3E(NY,NX),CNH3G2,FLQM(3,NU(NY,NX),NY,NX),CNH3GV +C 2,CNH3B2,ZNBS2(NU(NY,NX),NY,NX),RNBDFG(NU(NY,NX),NY,NX) +C 3,DFGS(M,NU(NY,NX),NY,NX),ZN3G2B,VOLPMB(NU(NY,NX),NY,NX) +C 4,ZNBS2(NU(NY,NX),NY,NX),VOLWNB(NU(NY,NX),NY,NX) +C 5,VOLWMB,SNH3L(NU(NY,NX),NY,NX) +C WRITE(*,323)'RNGDFG',I,J,NX,NY,M,MM,RNGDFG(NU(NY,NX),NY,NX) +C 2,DFGS(M,NU(NY,NX),NY,NX),Z2GG2(NU(NY,NX),NY,NX) +C 3,VOLWNG(NU(NY,NX),NY,NX),Z2GS2(NU(NY,NX),NY,NX) +C 4,RNGDFS(NY,NX),VOLPM(M,NU(NY,NX),NY,NX),VOLNGT(NY,NX) +C ENDIF +C +C ACCUMULATE HOURLY FLUXES +C + XCODFG(NU(NY,NX),NY,NX)=XCODFG(NU(NY,NX),NY,NX) + 2+RCODFG(NU(NY,NX),NY,NX) + XCHDFG(NU(NY,NX),NY,NX)=XCHDFG(NU(NY,NX),NY,NX) + 2+RCHDFG(NU(NY,NX),NY,NX) + XOXDFG(NU(NY,NX),NY,NX)=XOXDFG(NU(NY,NX),NY,NX) + 2+ROXDFG(NU(NY,NX),NY,NX) + XNGDFG(NU(NY,NX),NY,NX)=XNGDFG(NU(NY,NX),NY,NX) + 2+RNGDFG(NU(NY,NX),NY,NX) + XN2DFG(NU(NY,NX),NY,NX)=XN2DFG(NU(NY,NX),NY,NX) + 2+RN2DFG(NU(NY,NX),NY,NX) + XN3DFG(NU(NY,NX),NY,NX)=XN3DFG(NU(NY,NX),NY,NX) + 2+RN3DFG(NU(NY,NX),NY,NX) + XNBDFG(NU(NY,NX),NY,NX)=XNBDFG(NU(NY,NX),NY,NX) + 2+RNBDFG(NU(NY,NX),NY,NX) + XHGDFG(NU(NY,NX),NY,NX)=XHGDFG(NU(NY,NX),NY,NX) + 2+RHGDFG(NU(NY,NX),NY,NX) +C WRITE(*,3131)'ROXDFG',I,J,NX,NY,M,MM,XOXDFG(NU(NY,NX),NY,NX) +C 2,ROXDFG(NU(NY,NX),NY,NX),DFGS(M,NU(NY,NX),NY,NX) +C 2,AMAX1(ZEROS(NY,NX),OXYG2(NU(NY,NX),NY,NX)) +C 3,VOLWOX(NU(NY,NX),NY,NX),AMAX1(ZEROS(NY,NX) +C 4,OXYS2(NU(NY,NX),NY,NX)),VOLPM(M,NU(NY,NX),NY,NX) + ELSE + RCODFG(NU(NY,NX),NY,NX)=0.0 + RCHDFG(NU(NY,NX),NY,NX)=0.0 + ROXDFG(NU(NY,NX),NY,NX)=0.0 + RNGDFG(NU(NY,NX),NY,NX)=0.0 + RN2DFG(NU(NY,NX),NY,NX)=0.0 + RN3DFG(NU(NY,NX),NY,NX)=0.0 + RNBDFG(NU(NY,NX),NY,NX)=0.0 + RHGDFG(NU(NY,NX),NY,NX)=0.0 + ENDIF + ELSE + RCOFLG(3,NU(NY,NX),NY,NX)=0.0 + RCHFLG(3,NU(NY,NX),NY,NX)=0.0 + ROXFLG(3,NU(NY,NX),NY,NX)=0.0 + RNGFLG(3,NU(NY,NX),NY,NX)=0.0 + RN2FLG(3,NU(NY,NX),NY,NX)=0.0 + RN3FLG(3,NU(NY,NX),NY,NX)=0.0 + RHGFLG(3,NU(NY,NX),NY,NX)=0.0 + RCODFG(NU(NY,NX),NY,NX)=0.0 + RCHDFG(NU(NY,NX),NY,NX)=0.0 + ROXDFG(NU(NY,NX),NY,NX)=0.0 + RN2DFG(NU(NY,NX),NY,NX)=0.0 + RNGDFG(NU(NY,NX),NY,NX)=0.0 + RN3DFG(NU(NY,NX),NY,NX)=0.0 + RNBDFG(NU(NY,NX),NY,NX)=0.0 + RHGDFG(NU(NY,NX),NY,NX)=0.0 + ENDIF +C +C SOLUTE FLUXES BETWEEN ADJACENT GRID CELLS +C + IFLGB=0 + DO 125 L=1,NL(NY,NX) + N1=NX + N2=NY + N3=L +C +C LOCATE INTERNAL BOUNDARIES BETWEEN ADJACENT GRID CELLS +C + DO 120 N=NCN(N2,N1),3 + IF(N.EQ.1)THEN + IF(NX.EQ.NHE)THEN + GO TO 120 + ELSE + N4=NX+1 + N5=NY + N6=L + ENDIF + ELSEIF(N.EQ.2)THEN + IF(NY.EQ.NVS)THEN + GO TO 120 + ELSE + N4=NX + N5=NY+1 + N6=L + ENDIF + ELSEIF(N.EQ.3)THEN + IF(L.EQ.NL(NY,NX))THEN + GO TO 120 + ELSE + N4=NX + N5=NY + N6=L+1 + ENDIF + ENDIF + IF(N3.GE.NU(N2,N1).AND.N6.GE.NU(N5,N4))THEN + IF(M.NE.MX)THEN +C +C SOLUTE FLUXES BETWEEN ADJACENT GRID CELLS FROM +C WATER CONTENTS AND WATER FLUXES 'FLQM' FROM 'WATSUB' +C + VOLW4A=VOLWM(M,N3,N2,N1)*VLNH4(N3,N2,N1) + VOLW4B=VOLWM(M,N3,N2,N1)*VLNHB(N3,N2,N1) + VOLH4A=VOLWHM(M,N3,N2,N1)*VLNH4(N3,N2,N1) + VOLH4B=VOLWHM(M,N3,N2,N1)*VLNHB(N3,N2,N1) + VOLW3A=VOLWM(M,N3,N2,N1)*VLNO3(N3,N2,N1) + VOLW3B=VOLWM(M,N3,N2,N1)*VLNOB(N3,N2,N1) + VOLH3A=VOLWHM(M,N3,N2,N1)*VLNO3(N3,N2,N1) + VOLH3B=VOLWHM(M,N3,N2,N1)*VLNOB(N3,N2,N1) + VOLW2A=VOLWM(M,N3,N2,N1)*VLPO4(N3,N2,N1) + VOLW2B=VOLWM(M,N3,N2,N1)*VLPOB(N3,N2,N1) + VOLH2A=VOLWHM(M,N3,N2,N1)*VLPO4(N3,N2,N1) + VOLH2B=VOLWHM(M,N3,N2,N1)*VLPOB(N3,N2,N1) + VOLWMA(N6,N5,N4)=VOLWM(M,N6,N5,N4)*VLNH4(N6,N5,N4) + VOLWMB(N6,N5,N4)=VOLWM(M,N6,N5,N4)*VLNHB(N6,N5,N4) + VOLWXA(N6,N5,N4)=14.0*VOLWMA(N6,N5,N4) + VOLWXB(N6,N5,N4)=14.0*VOLWMB(N6,N5,N4) + VOLWOA=VOLWM(M,N6,N5,N4)*VLNO3(N6,N5,N4) + VOLWOB=VOLWM(M,N6,N5,N4)*VLNOB(N6,N5,N4) + VOLHOA=VOLWHM(M,N6,N5,N4)*VLNO3(N6,N5,N4) + VOLHOB=VOLWHM(M,N6,N5,N4)*VLNOB(N6,N5,N4) + VOLWPA=VOLWM(M,N6,N5,N4)*VLPO4(N6,N5,N4) + VOLWPB=VOLWM(M,N6,N5,N4)*VLPOB(N6,N5,N4) + VOLHPA=VOLWHM(M,N6,N5,N4)*VLPO4(N6,N5,N4) + VOLHPB=VOLWHM(M,N6,N5,N4)*VLPOB(N6,N5,N4) + VOLPMA(N6,N5,N4)=VOLPM(M,N6,N5,N4)*VLNH4(N6,N5,N4) + VOLPMB(N6,N5,N4)=VOLPM(M,N6,N5,N4)*VLNHB(N6,N5,N4) + THETW1(N3,N2,N1)=AMAX1(0.0,VOLWM(M,N3,N2,N1)/VOLX(N3,N2,N1)) + THETW1(N6,N5,N4)=AMAX1(0.0,VOLWM(M,N6,N5,N4)/VOLX(N6,N5,N4)) + FLVM(N6,N5,N4)=FLPM(M,N6,N5,N4)*XNPT +C +C GASEOUS SOLUBILITIES +C + IF(N.EQ.3)THEN + VOLWCO(N6,N5,N4)=VOLWM(M,N6,N5,N4)*SCO2L(N6,N5,N4) + VOLWCH(N6,N5,N4)=VOLWM(M,N6,N5,N4)*SCH4L(N6,N5,N4) + VOLWOX(N6,N5,N4)=VOLWM(M,N6,N5,N4)*SOXYL(N6,N5,N4) + VOLWNG(N6,N5,N4)=VOLWM(M,N6,N5,N4)*SN2GL(N6,N5,N4) + VOLWN2(N6,N5,N4)=VOLWM(M,N6,N5,N4)*SN2OL(N6,N5,N4) + VOLWN3(N6,N5,N4)=VOLWMA(N6,N5,N4)*SNH3L(N6,N5,N4) + VOLWNB(N6,N5,N4)=VOLWMB(N6,N5,N4)*SNH3L(N6,N5,N4) + VOLWHG(N6,N5,N4)=VOLWM(M,N6,N5,N4)*SH2GL(N6,N5,N4) + ENDIF + FLQM(N,N6,N5,N4)=(FLWM(M,N,N6,N5,N4)+FLWHM(M,N,N6,N5,N4))*XNPT +C +C SOLUTE TRANSPORT IN MICROPORES +C + IF(FLWM(M,N,N6,N5,N4).GT.0.0)THEN +C +C IF MICROPORE WATER FLUX FROM 'WATSUB' IS FROM CURRENT TO +C ADJACENT GRID CELL THEN CONVECTIVE TRANSPORT IS THE PRODUCT +C OF WATER FLUX AND MICROPORE GAS OR SOLUTE CONCENTRATIONS +C IN CURRENT GRID CELL +C + IF(VOLWM(M,N3,N2,N1).GT.ZEROS(N2,N1))THEN + VFLW=AMAX1(0.0,AMIN1(XFRX,FLWM(M,N,N6,N5,N4) + 2/VOLWM(M,N3,N2,N1))) + ELSE + VFLW=XFRX + ENDIF + DO 9820 K=0,4 + RFLOC(K)=VFLW*AMAX1(0.0,OQC2(K,N3,N2,N1)) + RFLON(K)=VFLW*AMAX1(0.0,OQN2(K,N3,N2,N1)) + RFLOP(K)=VFLW*AMAX1(0.0,OQP2(K,N3,N2,N1)) + RFLOA(K)=VFLW*AMAX1(0.0,OQA2(K,N3,N2,N1)) +9820 CONTINUE + RFLCOS=VFLW*AMAX1(0.0,CO2S2(N3,N2,N1)) + RFLCHS=VFLW*AMAX1(0.0,CH4S2(N3,N2,N1)) + RFLOXS=VFLW*AMAX1(0.0,OXYS2(N3,N2,N1)) + RFLNGS=VFLW*AMAX1(0.0,Z2GS2(N3,N2,N1)) + RFLN2S=VFLW*AMAX1(0.0,Z2OS2(N3,N2,N1)) + RFLHGS=VFLW*AMAX1(0.0,H2GS2(N3,N2,N1)) + RFLNH4=VFLW*AMAX1(0.0,ZNH4S2(N3,N2,N1)) + RFLNH3=VFLW*AMAX1(0.0,ZN3S2(N3,N2,N1)) + RFLNO3=VFLW*AMAX1(0.0,ZNO3S2(N3,N2,N1)) + RFLNO2=VFLW*AMAX1(0.0,ZNO2S2(N3,N2,N1)) + RFLP14=VFLW*AMAX1(0.0,H1PO42(N3,N2,N1)) + RFLPO4=VFLW*AMAX1(0.0,H2PO42(N3,N2,N1)) + RFLN4B=VFLW*AMAX1(0.0,ZNH4B2(N3,N2,N1)) + RFLN3B=VFLW*AMAX1(0.0,ZNBS2(N3,N2,N1)) + RFLNOB=VFLW*AMAX1(0.0,ZNO3B2(N3,N2,N1)) + RFLN2B=VFLW*AMAX1(0.0,ZNO2B2(N3,N2,N1)) + RFLP1B=VFLW*AMAX1(0.0,H1POB2(N3,N2,N1)) + RFLPOB=VFLW*AMAX1(0.0,H2POB2(N3,N2,N1)) + ELSE +C +C IF MICROPORE WATER FLUX FROM 'WATSUB' IS TO CURRENT FROM +C ADJACENT GRID CELL THEN CONVECTIVE TRANSPORT IS THE PRODUCT +C OF WATER FLUX AND MICROPORE GAS OR SOLUTE CONCENTRATIONS +C IN ADJACENT GRID CELL +C + IF(VOLWM(M,N6,N5,N4).GT.ZEROS(N5,N4))THEN + VFLW=AMIN1(0.0,AMAX1(-XFRX,FLWM(M,N,N6,N5,N4) + 2/VOLWM(M,N6,N5,N4))) + ELSE + VFLW=-XFRX + ENDIF + DO 9815 K=0,4 + RFLOC(K)=VFLW*AMAX1(0.0,OQC2(K,N6,N5,N4)) + RFLON(K)=VFLW*AMAX1(0.0,OQN2(K,N6,N5,N4)) + RFLOP(K)=VFLW*AMAX1(0.0,OQP2(K,N6,N5,N4)) + RFLOA(K)=VFLW*AMAX1(0.0,OQA2(K,N6,N5,N4)) +9815 CONTINUE + RFLCOS=VFLW*AMAX1(0.0,CO2S2(N6,N5,N4)) + RFLCHS=VFLW*AMAX1(0.0,CH4S2(N6,N5,N4)) + RFLOXS=VFLW*AMAX1(0.0,OXYS2(N6,N5,N4)) + RFLNGS=VFLW*AMAX1(0.0,Z2GS2(N6,N5,N4)) + RFLN2S=VFLW*AMAX1(0.0,Z2OS2(N6,N5,N4)) + RFLHGS=VFLW*AMAX1(0.0,H2GS2(N6,N5,N4)) + RFLNH4=VFLW*AMAX1(0.0,ZNH4S2(N6,N5,N4)) + RFLNH3=VFLW*AMAX1(0.0,ZN3S2(N6,N5,N4)) + RFLNO3=VFLW*AMAX1(0.0,ZNO3S2(N6,N5,N4)) + RFLNO2=VFLW*AMAX1(0.0,ZNO2S2(N6,N5,N4)) + RFLP14=VFLW*AMAX1(0.0,H1PO42(N6,N5,N4)) + RFLPO4=VFLW*AMAX1(0.0,H2PO42(N6,N5,N4)) + RFLN4B=VFLW*AMAX1(0.0,ZNH4B2(N6,N5,N4)) + RFLN3B=VFLW*AMAX1(0.0,ZNBS2(N6,N5,N4)) + RFLNOB=VFLW*AMAX1(0.0,ZNO3B2(N6,N5,N4)) + RFLN2B=VFLW*AMAX1(0.0,ZNO2B2(N6,N5,N4)) + RFLP1B=VFLW*AMAX1(0.0,H1POB2(N6,N5,N4)) + RFLPOB=VFLW*AMAX1(0.0,H2POB2(N6,N5,N4)) + ENDIF +C +C DIFFUSIVE FLUXES OF GASES AND SOLUTES BETWEEN CURRENT AND +C ADJACENT GRID CELL MICROPORES FROM AQUEOUS DIFFUSIVITIES +C AND CONCENTRATION DIFFERENCES +C + IF(THETW1(N3,N2,N1).GT.THETY(N3,N2,N1) + 2.AND.THETW1(N6,N5,N4).GT.THETY(N6,N5,N4))THEN +C +C MICROPORE CONCENTRATIONS FROM WATER-FILLED POROSITY +C IN CURRENT AND ADJACENT GRID CELLS +C + DO 9810 K=0,4 + COQC1(K)=AMAX1(0.0,OQC2(K,N3,N2,N1)/VOLWM(M,N3,N2,N1)) + COQN1(K)=AMAX1(0.0,OQN2(K,N3,N2,N1)/VOLWM(M,N3,N2,N1)) + COQP1(K)=AMAX1(0.0,OQP2(K,N3,N2,N1)/VOLWM(M,N3,N2,N1)) + COQA1(K)=AMAX1(0.0,OQA2(K,N3,N2,N1)/VOLWM(M,N3,N2,N1)) + COQC2(K)=AMAX1(0.0,OQC2(K,N6,N5,N4)/VOLWM(M,N6,N5,N4)) + COQN2(K)=AMAX1(0.0,OQN2(K,N6,N5,N4)/VOLWM(M,N6,N5,N4)) + COQP2(K)=AMAX1(0.0,OQP2(K,N6,N5,N4)/VOLWM(M,N6,N5,N4)) + COQA2(K)=AMAX1(0.0,OQA2(K,N6,N5,N4)/VOLWM(M,N6,N5,N4)) +9810 CONTINUE + CCO2S1=AMAX1(0.0,CO2S2(N3,N2,N1)/VOLWM(M,N3,N2,N1)) + CCH4S1=AMAX1(0.0,CH4S2(N3,N2,N1)/VOLWM(M,N3,N2,N1)) + COXYS1=AMAX1(0.0,OXYS2(N3,N2,N1)/VOLWM(M,N3,N2,N1)) + CZ2GS1=AMAX1(0.0,Z2GS2(N3,N2,N1)/VOLWM(M,N3,N2,N1)) + CZ2OS1=AMAX1(0.0,Z2OS2(N3,N2,N1)/VOLWM(M,N3,N2,N1)) + CH2GS1=AMAX1(0.0,H2GS2(N3,N2,N1)/VOLWM(M,N3,N2,N1)) + IF(VOLW4A.GT.ZEROS(N2,N1))THEN + CNH4S1=AMAX1(0.0,ZNH4S2(N3,N2,N1)/VOLW4A) + CNH3S1=AMAX1(0.0,ZN3S2(N3,N2,N1)/VOLW4A) + ELSE + CNH4S1=0.0 + CNH3S1=0.0 + ENDIF + IF(VOLW3A.GT.ZEROS(N2,N1))THEN + CNO3S1=AMAX1(0.0,ZNO3S2(N3,N2,N1)/VOLW3A) + CNO2S1=AMAX1(0.0,ZNO2S2(N3,N2,N1)/VOLW3A) + ELSE + CNO3S1=0.0 + CNO2S1=0.0 + ENDIF + IF(VOLW2A.GT.ZEROS(N2,N1))THEN + CP14S1=AMAX1(0.0,H1PO42(N3,N2,N1)/VOLW2A) + CPO4S1=AMAX1(0.0,H2PO42(N3,N2,N1)/VOLW2A) + ELSE + CP14S1=0.0 + CPO4S1=0.0 + ENDIF + IF(VOLW4B.GT.ZEROS(N2,N1))THEN + CNH4B1=AMAX1(0.0,ZNH4B2(N3,N2,N1)/VOLW4B) + CNH3B1=AMAX1(0.0,ZNBS2(N3,N2,N1)/VOLW4B) + ELSE + CNH4B1=0.0 + CNH3B1=0.0 + ENDIF + IF(VOLW3B.GT.ZEROS(N2,N1))THEN + CNO3B1=AMAX1(0.0,ZNO3B2(N3,N2,N1)/VOLW3B) + CNO2B1=AMAX1(0.0,ZNO2B2(N3,N2,N1)/VOLW3B) + ELSE + CNO3B1=CNO3S1 + CNO2B1=CNO2S1 + ENDIF + IF(VOLW2B.GT.ZEROS(N2,N1))THEN + CP14B1=AMAX1(0.0,H1POB2(N3,N2,N1)/VOLW2B) + CPO4B1=AMAX1(0.0,H2POB2(N3,N2,N1)/VOLW2B) + ELSE + CP14B1=CP14S1 + CPO4B1=CPO4S1 + ENDIF + CCO2S2=AMAX1(0.0,CO2S2(N6,N5,N4)/VOLWM(M,N6,N5,N4)) + CCH4S2=AMAX1(0.0,CH4S2(N6,N5,N4)/VOLWM(M,N6,N5,N4)) + COXYS2=AMAX1(0.0,OXYS2(N6,N5,N4)/VOLWM(M,N6,N5,N4)) + CZ2GS2=AMAX1(0.0,Z2GS2(N6,N5,N4)/VOLWM(M,N6,N5,N4)) + CZ2OS2=AMAX1(0.0,Z2OS2(N6,N5,N4)/VOLWM(M,N6,N5,N4)) + CH2GS2=AMAX1(0.0,H2GS2(N6,N5,N4)/VOLWM(M,N6,N5,N4)) + IF(VOLWMA(N6,N5,N4).GT.ZEROS(N5,N4))THEN + CNH3S2=AMAX1(0.0,ZN3S2(N6,N5,N4)/VOLWMA(N6,N5,N4)) + CNH4S2=AMAX1(0.0,ZNH4S2(N6,N5,N4)/VOLWMA(N6,N5,N4)) + ELSE + CNH3S2=0.0 + CNH4S2=0.0 + ENDIF + IF(VOLWOA.GT.ZEROS(N5,N4))THEN + CNO3S2=AMAX1(0.0,ZNO3S2(N6,N5,N4)/VOLWOA) + CNO2S2=AMAX1(0.0,ZNO2S2(N6,N5,N4)/VOLWOA) + ELSE + CNO3S2=0.0 + CNO2S2=0.0 + ENDIF + IF(VOLWPA.GT.ZEROS(N5,N4))THEN + CP14S2=AMAX1(0.0,H1PO42(N6,N5,N4)/VOLWPA) + CPO4S2=AMAX1(0.0,H2PO42(N6,N5,N4)/VOLWPA) + ELSE + CP14S2=0.0 + CPO4S2=0.0 + ENDIF + IF(VOLWMB(N6,N5,N4).GT.ZEROS(N5,N4))THEN + CNH3B2=AMAX1(0.0,ZNBS2(N6,N5,N4)/VOLWMB(N6,N5,N4)) + CNH4B2=AMAX1(0.0,ZNH4B2(N6,N5,N4)/VOLWMB(N6,N5,N4)) + ELSE + CNH3B2=CNH3S2 + CNH4B2=CNH4S2 + ENDIF + IF(VOLWOB.GT.ZEROS(N5,N4))THEN + CNO3B2=AMAX1(0.0,ZNO3B2(N6,N5,N4)/VOLWOB) + CNO2B2=AMAX1(0.0,ZNO2B2(N6,N5,N4)/VOLWOB) + ELSE + CNO3B2=CNO3S2 + CNO2B2=CNO2S2 + ENDIF + IF(VOLWPB.GT.ZEROS(N5,N4))THEN + CP14B2=AMAX1(0.0,H1POB2(N6,N5,N4)/VOLWPB) + CPO4B2=AMAX1(0.0,H2POB2(N6,N5,N4)/VOLWPB) + ELSE + CP14B2=CP14S2 + CPO4B2=CPO4S2 + ENDIF +C +C DIFFUSIVITIES IN CURRENT AND ADJACENT GRID CELL MICROPORES +C + TORTL=(TORT(M,N3,N2,N1)*DLYR(N,N3,N2,N1) + 2+TORT(M,N6,N5,N4)*DLYR(N,N6,N5,N4)) + 3/(DLYR(N,N3,N2,N1)+DLYR(N,N6,N5,N4)) + DISPN=DISP(N,N6,N5,N4)*ABS(FLWM(M,N,N6,N5,N4)/AREA(N,N6,N5,N4)) + DIFOC=(OCSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFON=(ONSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFOP=(OPSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFOA=(OASGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFNH=(ZNSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFNO=(ZOSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFPO=(POSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFCS=(CLSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFCQ=(CQSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFOS=(OLSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFNG=(ZLSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFN2=(ZVSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFHG=(HLSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) +C +C DIFFUSIVE FLUXES BETWEEN CURRENT AND ADJACENT GRID CELL +C MICROPORES +C + DO 9805 K=0,4 + DFVOC(K)=DIFOC*(COQC1(K)-COQC2(K)) + DFVON(K)=DIFON*(COQN1(K)-COQN2(K)) + DFVOP(K)=DIFOP*(COQP1(K)-COQP2(K)) + DFVOA(K)=DIFOA*(COQA1(K)-COQA2(K)) +9805 CONTINUE + DFVCOS=DIFCS*(CCO2S1-CCO2S2) + DFVCHS=DIFCQ*(CCH4S1-CCH4S2) + DFVOXS=DIFOS*(COXYS1-COXYS2) + DFVNGS=DIFNG*(CZ2GS1-CZ2GS2) + DFVN2S=DIFN2*(CZ2OS1-CZ2OS2) + DFVHGS=DIFHG*(CH2GS1-CH2GS2) + DFVNH4=DIFNH*(CNH4S1-CNH4S2)*AMIN1(VLNH4(N3,N2,N1) + 2,VLNH4(N6,N5,N4)) + DFVNH3=DIFNH*(CNH3S1-CNH3S2)*AMIN1(VLNH4(N3,N2,N1) + 2,VLNH4(N6,N5,N4)) + DFVNO3=DIFNO*(CNO3S1-CNO3S2)*AMIN1(VLNO3(N3,N2,N1) + 2,VLNO3(N6,N5,N4)) + DFVNO2=DIFNO*(CNO2S1-CNO2S2)*AMIN1(VLNO3(N3,N2,N1) + 2,VLNO3(N6,N5,N4)) + DFVP14=DIFPO*(CP14S1-CP14S2)*AMIN1(VLPO4(N3,N2,N1) + 2,VLPO4(N6,N5,N4)) + DFVPO4=DIFPO*(CPO4S1-CPO4S2)*AMIN1(VLPO4(N3,N2,N1) + 2,VLPO4(N6,N5,N4)) + DFVN4B=DIFNH*(CNH4B1-CNH4B2)*AMIN1(VLNHB(N3,N2,N1) + 2,VLNHB(N6,N5,N4)) + DFVN3B=DIFNH*(CNH3B1-CNH3B2)*AMIN1(VLNHB(N3,N2,N1) + 2,VLNHB(N6,N5,N4)) + DFVNOB=DIFNO*(CNO3B1-CNO3B2)*AMIN1(VLNOB(N3,N2,N1) + 2,VLNOB(N6,N5,N4)) + DFVN2B=DIFNO*(CNO2B1-CNO2B2)*AMIN1(VLNOB(N3,N2,N1) + 2,VLNOB(N6,N5,N4)) + DFVP1B=DIFPO*(CP14B1-CP14B2)*AMIN1(VLPOB(N3,N2,N1) + 2,VLPOB(N6,N5,N4)) + DFVPOB=DIFPO*(CPO4B1-CPO4B2)*AMIN1(VLPOB(N3,N2,N1) + 2,VLPOB(N6,N5,N4)) + ELSE + DO 9905 K=0,4 + DFVOC(K)=0.0 + DFVON(K)=0.0 + DFVOP(K)=0.0 + DFVOA(K)=0.0 +9905 CONTINUE + DFVCOS=0.0 + DFVCHS=0.0 + DFVOXS=0.0 + DFVNGS=0.0 + DFVN2S=0.0 + DFVHGS=0.0 + DFVNH4=0.0 + DFVNH3=0.0 + DFVNO3=0.0 + DFVNO2=0.0 + DFVP14=0.0 + DFVPO4=0.0 + DFVN4B=0.0 + DFVN3B=0.0 + DFVNOB=0.0 + DFVN2B=0.0 + DFVP1B=0.0 + DFVPOB=0.0 + ENDIF +C +C SOLUTE TRANSPORT IN MACROPORES +C + IF(FLWHM(M,N,N6,N5,N4).GT.0.0)THEN +C +C IF MACROPORE WATER FLUX FROM 'WATSUB' IS FROM CURRENT TO +C ADJACENT GRID CELL THEN CONVECTIVE TRANSPORT IS THE PRODUCT +C OF WATER FLUX AND MACROPORE SOLUTE CONCENTRATIONS IN CURRENT +C GRID CELL +C + IF(VOLWHM(M,N3,N2,N1).GT.ZEROS(N2,N1))THEN + VFLW=AMAX1(0.0,AMIN1(XFRX,FLWHM(M,N,N6,N5,N4) + 2/VOLWHM(M,N3,N2,N1))) + ELSE + VFLW=XFRX + ENDIF +C +C ACCOUNT FOR OVERLAND TRANSPORT IN THE SURFACE SOIL LAYER +C + IF(N.EQ.3.AND.VOLAH(N6,N5,N4).GT.VOLWHM(M,N6,N5,N4))THEN + DO 9800 K=0,4 + RFHOC(K)=VFLW*AMAX1(0.0,(OQCH2(K,N3,N2,N1) + 2-AMIN1(0.0,ROCFXS(K,NU(N2,N1),N2,N1)))) + RFHON(K)=VFLW*AMAX1(0.0,(OQNH2(K,N3,N2,N1) + 2-AMIN1(0.0,RONFXS(K,NU(N2,N1),N2,N1)))) + RFHOP(K)=VFLW*AMAX1(0.0,(OQPH2(K,N3,N2,N1) + 2-AMIN1(0.0,ROPFXS(K,NU(N2,N1),N2,N1)))) + RFHOA(K)=VFLW*AMAX1(0.0,(OQAH2(K,N3,N2,N1) + 2-AMIN1(0.0,ROAFXS(K,NU(N2,N1),N2,N1)))) +9800 CONTINUE + RFHCOS=VFLW*AMAX1(0.0,(CO2SH2(N3,N2,N1) + 2-AMIN1(0.0,RCOFXS(NU(N2,N1),N2,N1)))) + RFHCHS=VFLW*AMAX1(0.0,(CH4SH2(N3,N2,N1) + 2-AMIN1(0.0,RCHFXS(NU(N2,N1),N2,N1)))) + RFHOXS=VFLW*AMAX1(0.0,(OXYSH2(N3,N2,N1) + 2-AMIN1(0.0,ROXFXS(NU(N2,N1),N2,N1)))) + RFHNGS=VFLW*AMAX1(0.0,(Z2GSH2(N3,N2,N1) + 2-AMIN1(0.0,RNGFXS(NU(N2,N1),N2,N1)))) + RFHN2S=VFLW*AMAX1(0.0,(Z2OSH2(N3,N2,N1) + 2-AMIN1(0.0,RN2FXS(NU(N2,N1),N2,N1)))) + RFHHGS=VFLW*AMAX1(0.0,(H2GSH2(N3,N2,N1) + 2-AMIN1(0.0,RHGFXS(NU(N2,N1),N2,N1)))) + RFHNH4=VFLW*AMAX1(0.0,(ZNH4H2(N3,N2,N1) + 2-AMIN1(0.0,RN4FXW(NU(N2,N1),N2,N1)*VLNH4(N3,N2,N1)))) + 3*VLNH4(N6,N5,N4) + RFHNH3=VFLW*AMAX1(0.0,(ZNH3H2(N3,N2,N1) + 2-AMIN1(0.0,RN3FXW(NU(N2,N1),N2,N1)*VLNH4(N3,N2,N1)))) + 3*VLNH4(N6,N5,N4) + RFHNO3=VFLW*AMAX1(0.0,(ZNO3H2(N3,N2,N1) + 2-AMIN1(0.0,RNOFXW(NU(N2,N1),N2,N1)*VLNO3(N3,N2,N1)))) + 3*VLNO3(N6,N5,N4) + RFHNO2=VFLW*AMAX1(0.0,(ZNO2H2(N3,N2,N1) + 2-AMIN1(0.0,RNXFXS(NU(N2,N1),N2,N1)*VLNO3(N3,N2,N1)))) + 3*VLNO3(N6,N5,N4) + RFHP14=VFLW*AMAX1(0.0,(H1P4H2(N3,N2,N1) + 2-AMIN1(0.0,RH1PXS(NU(N2,N1),N2,N1)*VLPO4(N3,N2,N1)))) + 3*VLPO4(N6,N5,N4) + RFHPO4=VFLW*AMAX1(0.0,(H2P4H2(N3,N2,N1) + 2-AMIN1(0.0,RH2PXS(NU(N2,N1),N2,N1)*VLPO4(N3,N2,N1)))) + 3*VLPO4(N6,N5,N4) + RFHN4B=VFLW*AMAX1(0.0,(ZN4BH2(N3,N2,N1) + 2-AMIN1(0.0,RN4FXB(NU(N2,N1),N2,N1)*VLNHB(N3,N2,N1)))) + 3*VLNHB(N6,N5,N4) + RFHN3B=VFLW*AMAX1(0.0,(ZN3BH2(N3,N2,N1) + 2-AMIN1(0.0,RN3FXB(NU(N2,N1),N2,N1)*VLNHB(N3,N2,N1)))) + 3*VLNHB(N6,N5,N4) + RFHNOB=VFLW*AMAX1(0.0,(ZNOBH2(N3,N2,N1) + 2-AMIN1(0.0,RNOFXB(NU(N2,N1),N2,N1)*VLNOB(N3,N2,N1)))) + 3*VLNOB(N6,N5,N4) + RFHN2B=VFLW*AMAX1(0.0,(ZN2BH2(N3,N2,N1) + 2-AMIN1(0.0,RNXFXB(NU(N2,N1),N2,N1)*VLNOB(N3,N2,N1)))) + 3*VLNOB(N6,N5,N4) + RFHP1B=VFLW*AMAX1(0.0,(H1PBH2(N3,N2,N1) + 2-AMIN1(0.0,RH1BXB(NU(N2,N1),N2,N1)*VLPOB(N3,N2,N1)))) + 3*VLPOB(N6,N5,N4) + RFHPOB=VFLW*AMAX1(0.0,(H2PBH2(N3,N2,N1) + 2-AMIN1(0.0,RH2BXB(NU(N2,N1),N2,N1)*VLPOB(N3,N2,N1)))) + 3*VLPOB(N6,N5,N4) +C +C IF NOT IN THE SURFACE LAYER +C + ELSE + DO 9850 K=0,4 + RFHOC(K)=VFLW*AMAX1(0.0,OQCH2(K,N3,N2,N1)) + RFHON(K)=VFLW*AMAX1(0.0,OQNH2(K,N3,N2,N1)) + RFHOP(K)=VFLW*AMAX1(0.0,OQPH2(K,N3,N2,N1)) + RFHOA(K)=VFLW*AMAX1(0.0,OQAH2(K,N3,N2,N1)) +9850 CONTINUE + RFHCOS=VFLW*AMAX1(0.0,CO2SH2(N3,N2,N1)) + RFHCHS=VFLW*AMAX1(0.0,CH4SH2(N3,N2,N1)) + RFHOXS=VFLW*AMAX1(0.0,OXYSH2(N3,N2,N1)) + RFHNGS=VFLW*AMAX1(0.0,Z2GSH2(N3,N2,N1)) + RFHN2S=VFLW*AMAX1(0.0,Z2OSH2(N3,N2,N1)) + RFHHGS=VFLW*AMAX1(0.0,H2GSH2(N3,N2,N1)) + RFHNH4=VFLW*AMAX1(0.0,ZNH4H2(N3,N2,N1))*VLNH4(N6,N5,N4) + RFHNH3=VFLW*AMAX1(0.0,ZNH3H2(N3,N2,N1))*VLNH4(N6,N5,N4) + RFHNO3=VFLW*AMAX1(0.0,ZNO3H2(N3,N2,N1))*VLNO3(N6,N5,N4) + RFHNO2=VFLW*AMAX1(0.0,ZNO2H2(N3,N2,N1))*VLNO3(N6,N5,N4) + RFHP14=VFLW*AMAX1(0.0,H1P4H2(N3,N2,N1))*VLPO4(N6,N5,N4) + RFHPO4=VFLW*AMAX1(0.0,H2P4H2(N3,N2,N1))*VLPO4(N6,N5,N4) + RFHN4B=VFLW*AMAX1(0.0,ZN4BH2(N3,N2,N1))*VLNHB(N6,N5,N4) + RFHN3B=VFLW*AMAX1(0.0,ZN3BH2(N3,N2,N1))*VLNHB(N6,N5,N4) + RFHNOB=VFLW*AMAX1(0.0,ZNOBH2(N3,N2,N1))*VLNOB(N6,N5,N4) + RFHN2B=VFLW*AMAX1(0.0,ZN2BH2(N3,N2,N1))*VLNOB(N6,N5,N4) + RFHP1B=VFLW*AMAX1(0.0,H1PBH2(N3,N2,N1))*VLPOB(N6,N5,N4) + RFHPOB=VFLW*AMAX1(0.0,H2PBH2(N3,N2,N1))*VLPOB(N6,N5,N4) + ENDIF + ELSEIF(FLWHM(M,N,N6,N5,N4).LT.0.0)THEN +C +C IF MACROPORE WATER FLUX FROM 'WATSUB' IS FROM ADJACENT TO +C CURRENT GRID CELL THEN CONVECTIVE TRANSPORT IS THE PRODUCT +C OF WATER FLUX AND MACROPORE SOLUTE CONCENTRATIONS IN ADJACENT +C GRID CELL +C + IF(VOLWHM(M,N6,N5,N4).GT.ZEROS(N5,N4))THEN + VFLW=AMIN1(0.0,AMAX1(-XFRX,FLWHM(M,N,N6,N5,N4) + 2/VOLWHM(M,N6,N5,N4))) + ELSE + VFLW=-XFRX + ENDIF + DO 9665 K=0,4 + RFHOC(K)=VFLW*AMAX1(0.0,OQCH2(K,N6,N5,N4)) + RFHON(K)=VFLW*AMAX1(0.0,OQNH2(K,N6,N5,N4)) + RFHOP(K)=VFLW*AMAX1(0.0,OQPH2(K,N6,N5,N4)) + RFHOA(K)=VFLW*AMAX1(0.0,OQAH2(K,N6,N5,N4)) +9665 CONTINUE + RFHCOS=VFLW*AMAX1(0.0,CO2SH2(N6,N5,N4)) + RFHCHS=VFLW*AMAX1(0.0,CH4SH2(N6,N5,N4)) + RFHOXS=VFLW*AMAX1(0.0,OXYSH2(N6,N5,N4)) + RFHNGS=VFLW*AMAX1(0.0,Z2GSH2(N6,N5,N4)) + RFHN2S=VFLW*AMAX1(0.0,Z2OSH2(N6,N5,N4)) + RFHHGS=VFLW*AMAX1(0.0,H2GSH2(N6,N5,N4)) + RFHNH4=VFLW*AMAX1(0.0,ZNH4H2(N6,N5,N4))*VLNH4(N6,N5,N4) + RFHNH3=VFLW*AMAX1(0.0,ZNH3H2(N6,N5,N4))*VLNH4(N6,N5,N4) + RFHNO3=VFLW*AMAX1(0.0,ZNO3H2(N6,N5,N4))*VLNO3(N6,N5,N4) + RFHNO2=VFLW*AMAX1(0.0,ZNO2H2(N6,N5,N4))*VLNO3(N6,N5,N4) + RFHP14=VFLW*AMAX1(0.0,H1P4H2(N6,N5,N4))*VLPO4(N6,N5,N4) + RFHPO4=VFLW*AMAX1(0.0,H2P4H2(N6,N5,N4))*VLPO4(N6,N5,N4) + RFHN4B=VFLW*AMAX1(0.0,ZN4BH2(N6,N5,N4))*VLNHB(N6,N5,N4) + RFHN3B=VFLW*AMAX1(0.0,ZN3BH2(N6,N5,N4))*VLNHB(N6,N5,N4) + RFHNOB=VFLW*AMAX1(0.0,ZNOBH2(N6,N5,N4))*VLNOB(N6,N5,N4) + RFHN2B=VFLW*AMAX1(0.0,ZN2BH2(N6,N5,N4))*VLNOB(N6,N5,N4) + RFHP1B=VFLW*AMAX1(0.0,H1PBH2(N6,N5,N4))*VLPOB(N6,N5,N4) + RFHPOB=VFLW*AMAX1(0.0,H2PBH2(N6,N5,N4))*VLPOB(N6,N5,N4) + ELSE +C +C NO MACROPORE FLUX +C + DO 9795 K=0,4 + RFHOC(K)=0.0 + RFHON(K)=0.0 + RFHOP(K)=0.0 + RFHOA(K)=0.0 +9795 CONTINUE + RFHCOS=0.0 + RFHCHS=0.0 + RFHOXS=0.0 + RFHNGS=0.0 + RFHN2S=0.0 + RFHHGS=0.0 + RFHNH4=0.0 + RFHNH3=0.0 + RFHNO3=0.0 + RFHNO2=0.0 + RFHP14=0.0 + RFHPO4=0.0 + RFHN4B=0.0 + RFHN3B=0.0 + RFHNOB=0.0 + RFHN2B=0.0 + RFHP1B=0.0 + RFHPOB=0.0 + ENDIF +C +C DIFFUSIVE FLUXES OF GASES AND SOLUTES BETWEEN CURRENT AND +C ADJACENT GRID CELL MACROPORES FROM AQUEOUS DIFFUSIVITIES +C AND CONCENTRATION DIFFERENCES +C + IF(VOLWHM(M,N3,N2,N1).GT.THETY(N3,N2,N1)*VOLAH(N3,N2,N1) + 2.AND.VOLWHM(M,N6,N5,N4).GT.THETY(N6,N5,N4)*VOLAH(N6,N5,N4))THEN +C +C MACROPORE CONCENTRATIONS IN CURRENT AND ADJACENT GRID CELLS +C + DO 9790 K=0,4 + COQCH1(K)=AMAX1(0.0,OQCH2(K,N3,N2,N1)/VOLWHM(M,N3,N2,N1)) + COQNH1(K)=AMAX1(0.0,OQNH2(K,N3,N2,N1)/VOLWHM(M,N3,N2,N1)) + COQPH1(K)=AMAX1(0.0,OQPH2(K,N3,N2,N1)/VOLWHM(M,N3,N2,N1)) + COQAH1(K)=AMAX1(0.0,OQAH2(K,N3,N2,N1)/VOLWHM(M,N3,N2,N1)) + COQCH2(K)=AMAX1(0.0,OQCH2(K,N6,N5,N4)/VOLWHM(M,N6,N5,N4)) + COQNH2(K)=AMAX1(0.0,OQNH2(K,N6,N5,N4)/VOLWHM(M,N6,N5,N4)) + COQPH2(K)=AMAX1(0.0,OQPH2(K,N6,N5,N4)/VOLWHM(M,N6,N5,N4)) + COQAH2(K)=AMAX1(0.0,OQAH2(K,N6,N5,N4)/VOLWHM(M,N6,N5,N4)) +9790 CONTINUE + CCO2SH1=AMAX1(0.0,CO2SH2(N3,N2,N1)/VOLWHM(M,N3,N2,N1)) + CCH4SH1=AMAX1(0.0,CH4SH2(N3,N2,N1)/VOLWHM(M,N3,N2,N1)) + COXYSH1=AMAX1(0.0,OXYSH2(N3,N2,N1)/VOLWHM(M,N3,N2,N1)) + CZ2GSH1=AMAX1(0.0,Z2GSH2(N3,N2,N1)/VOLWHM(M,N3,N2,N1)) + CZ2OSH1=AMAX1(0.0,Z2OSH2(N3,N2,N1)/VOLWHM(M,N3,N2,N1)) + CH2GSH1=AMAX1(0.0,H2GSH2(N3,N2,N1)/VOLWHM(M,N3,N2,N1)) + IF(VOLH4A.GT.ZEROS(N2,N1))THEN + CNH4SH1=AMAX1(0.0,ZNH4H2(N3,N2,N1)/VOLH4A) + CNH3SH1=AMAX1(0.0,ZNH3H2(N3,N2,N1)/VOLH4A) + ELSE + CNH4SH1=0.0 + CNH3SH1=0.0 + ENDIF + IF(VOLH3A.GT.ZEROS(N2,N1))THEN + CNO3SH1=AMAX1(0.0,ZNO3H2(N3,N2,N1)/VOLH3A) + CNO2SH1=AMAX1(0.0,ZNO2H2(N3,N2,N1)/VOLH3A) + ELSE + CNO3SH1=0.0 + CNO2SH1=0.0 + ENDIF + IF(VOLH2A.GT.ZEROS(N2,N1))THEN + CP14SH1=AMAX1(0.0,H1P4H2(N3,N2,N1)/VOLH2A) + CPO4SH1=AMAX1(0.0,H2P4H2(N3,N2,N1)/VOLH2A) + ELSE + CP14SH1=0.0 + CPO4SH1=0.0 + ENDIF + IF(VOLH4B.GT.ZEROS(N2,N1))THEN + CNH4BH1=AMAX1(0.0,ZN4BH2(N3,N2,N1)/VOLH4B) + CNH3BH1=AMAX1(0.0,ZN3BH2(N3,N2,N1)/VOLH4B) + ELSE + CNH4BH1=CNH4SH1 + CNH3BH1=CNH3SH1 + ENDIF + IF(VOLH3B.GT.ZEROS(N2,N1))THEN + CNO3BH1=AMAX1(0.0,ZNOBH2(N3,N2,N1)/VOLH3B) + CNO2BH1=AMAX1(0.0,ZN2BH2(N3,N2,N1)/VOLH3B) + ELSE + CNO3BH1=CNO3SH1 + CNO2BH1=CNO2SH1 + ENDIF + IF(VOLH2B.GT.ZEROS(N2,N1))THEN + CP14BH1=AMAX1(0.0,H1PBH2(N3,N2,N1)/VOLH2B) + CPO4BH1=AMAX1(0.0,H2PBH2(N3,N2,N1)/VOLH2B) + ELSE + CP14BH1=CP14SH1 + CPO4BH1=CPO4SH1 + ENDIF + CCO2SH2=AMAX1(0.0,CO2SH2(N6,N5,N4)/VOLWHM(M,N6,N5,N4)) + CCH4SH2=AMAX1(0.0,CH4SH2(N6,N5,N4)/VOLWHM(M,N6,N5,N4)) + COXYSH2=AMAX1(0.0,OXYSH2(N6,N5,N4)/VOLWHM(M,N6,N5,N4)) + CZ2GSH2=AMAX1(0.0,Z2GSH2(N6,N5,N4)/VOLWHM(M,N6,N5,N4)) + CZ2OSH2=AMAX1(0.0,Z2OSH2(N6,N5,N4)/VOLWHM(M,N6,N5,N4)) + CH2GSH2=AMAX1(0.0,H2GSH2(N6,N5,N4)/VOLWHM(M,N6,N5,N4)) + VOLHMA=VOLWHM(M,N6,N5,N4)*VLNH4(N6,N5,N4) + IF(VOLHMA.GT.ZEROS(N5,N4))THEN + CNH4SH2=AMAX1(0.0,ZNH4H2(N6,N5,N4)/VOLHMA) + CNH3SH2=AMAX1(0.0,ZNH3H2(N6,N5,N4)/VOLHMA) + ELSE + CNH4SH2=0.0 + CNH3SH2=0.0 + ENDIF + VOLHOA=VOLWHM(M,N6,N5,N4)*VLNO3(N6,N5,N4) + IF(VOLHOA.GT.ZEROS(N5,N4))THEN + CNO3SH2=AMAX1(0.0,ZNO3H2(N6,N5,N4)/VOLHOA) + CNO2SH2=AMAX1(0.0,ZNO2H2(N6,N5,N4)/VOLHOA) + ELSE + CNO3SH2=0.0 + CNO2SH2=0.0 + ENDIF + VOLHPA=VOLWHM(M,N6,N5,N4)*VLPO4(N6,N5,N4) + IF(VOLHPA.GT.ZEROS(N5,N4))THEN + CP14SH2=AMAX1(0.0,H1P4H2(N6,N5,N4)/VOLHPA) + CPO4SH2=AMAX1(0.0,H2P4H2(N6,N5,N4)/VOLHPA) + ELSE + CP14SH2=0.0 + CPO4SH2=0.0 + ENDIF + VOLHMB=VOLWHM(M,N6,N5,N4)*VLNHB(N6,N5,N4) + IF(VOLHMB.GT.ZEROS(N5,N4))THEN + CNH4BH2=AMAX1(0.0,ZN4BH2(N6,N5,N4)/VOLHMB) + CNH3BH2=AMAX1(0.0,ZN3BH2(N6,N5,N4)/VOLHMB) + ELSE + CNH4BH2=CNH4SH2 + CNH3BH2=CNH3SH2 + ENDIF + VOLHOB=VOLWHM(M,N6,N5,N4)*VLNOB(N6,N5,N4) + IF(VOLHOB.GT.ZEROS(N5,N4))THEN + CNO3BH2=AMAX1(0.0,ZNOBH2(N6,N5,N4)/VOLHOB) + CNO2BH2=AMAX1(0.0,ZN2BH2(N6,N5,N4)/VOLHOB) + ELSE + CNO3BH2=CNO3SH2 + CNO2BH2=CNO2SH2 + ENDIF + VOLHPB=VOLWHM(M,N6,N5,N4)*VLPOB(N6,N5,N4) + IF(VOLHPB.GT.ZEROS(N5,N4))THEN + CP14BH2=AMAX1(0.0,H1PBH2(N6,N5,N4)/VOLHPB) + CPO4BH2=AMAX1(0.0,H2PBH2(N6,N5,N4)/VOLHPB) + ELSE + CP14BH2=CP14SH2 + CPO4BH2=CPO4SH2 + ENDIF +C +C DIFFUSIVITIES IN CURRENT AND ADJACENT GRID CELL MACROPORES +C + TORTL=(TORTH(M,N3,N2,N1)*DLYR(N,N3,N2,N1) + 2+TORTH(M,N6,N5,N4)*DLYR(N,N6,N5,N4)) + 3/(DLYR(N,N3,N2,N1)+DLYR(N,N6,N5,N4)) + DISPN=DISP(N,N6,N5,N4)*ABS(FLWHM(M,N,N6,N5,N4)/AREA(N,N6,N5,N4)) + DIFOC=(OCSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFON=(ONSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFOP=(OPSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFOA=(OASGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFNH=(ZNSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFNO=(ZOSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFPO=(POSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFCS=(CLSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFCQ=(CQSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFOS=(OLSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFNG=(ZLSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFN2=(ZVSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFHG=(HLSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) +C +C DIFFUSIVE FLUXES BETWEEN CURRENT AND ADJACENT GRID CELL +C MACROPORES +C + DO 9785 K=0,4 + DFHOC(K)=DIFOC*(COQCH1(K)-COQCH2(K)) + DFHON(K)=DIFON*(COQNH1(K)-COQNH2(K)) + DFHOP(K)=DIFOP*(COQPH1(K)-COQPH2(K)) + DFHOA(K)=DIFOA*(COQAH1(K)-COQAH2(K)) +C WRITE(*,2121)'DFHOC',I,J,M,N4,N5,N6,K,DFHOC(K),OQCH2(K,N3,N2,N1) +C 2,OQCH2(K,N6,N5,N4),DIFOC,COQCH1(K),COQCH2(K) +2121 FORMAT(A8,7I4,20E12.4) +9785 CONTINUE + DFHCOS=DIFCS*(CCO2SH1-CCO2SH2) + DFHCHS=DIFCQ*(CCH4SH1-CCH4SH2) + DFHOXS=DIFOS*(COXYSH1-COXYSH2) + DFHNGS=DIFNG*(CZ2GSH1-CZ2GSH2) + DFHN2S=DIFN2*(CZ2OSH1-CZ2OSH2) + DFHHGS=DIFNH*(CH2GSH1-CH2GSH2) + DFHNH4=DIFNH*(CNH4SH1-CNH4SH2)*AMIN1(VLNH4(N3,N2,N1) + 2,VLNH4(N6,N5,N4)) + DFHNH3=DIFNH*(CNH3SH1-CNH3SH2)*AMIN1(VLNH4(N3,N2,N1) + 2,VLNH4(N6,N5,N4)) + DFHNO3=DIFNO*(CNO3SH1-CNO3SH2)*AMIN1(VLNO3(N3,N2,N1) + 2,VLNO3(N6,N5,N4)) + DFHNO2=DIFNO*(CNO2SH1-CNO2SH2)*AMIN1(VLNO3(N3,N2,N1) + 2,VLNO3(N6,N5,N4)) + DFHP14=DIFPO*(CP14SH1-CP14SH2)*AMIN1(VLPO4(N3,N2,N1) + 2,VLPO4(N6,N5,N4)) + DFHPO4=DIFPO*(CPO4SH1-CPO4SH2)*AMIN1(VLPO4(N3,N2,N1) + 2,VLPO4(N6,N5,N4)) + DFHN4B=DIFNH*(CNH4BH1-CNH4BH2)*AMIN1(VLNHB(N3,N2,N1) + 2,VLNHB(N6,N5,N4)) + DFHN3B=DIFNH*(CNH3BH1-CNH3BH2)*AMIN1(VLNHB(N3,N2,N1) + 2,VLNHB(N6,N5,N4)) + DFHNOB=DIFNO*(CNO3BH1-CNO3BH2)*AMIN1(VLNOB(N3,N2,N1) + 2,VLNOB(N6,N5,N4)) + DFHN2B=DIFNO*(CNO2BH1-CNO2BH2)*AMIN1(VLNOB(N3,N2,N1) + 2,VLNOB(N6,N5,N4)) + DFHP1B=DIFPO*(CP14BH1-CP14BH2)*AMIN1(VLPOB(N3,N2,N1) + 2,VLPOB(N6,N5,N4)) + DFHPOB=DIFPO*(CPO4BH1-CPO4BH2)*AMIN1(VLPOB(N3,N2,N1) + 2,VLPOB(N6,N5,N4)) + ELSE + DO 9780 K=0,4 + DFHOC(K)=0.0 + DFHON(K)=0.0 + DFHOP(K)=0.0 + DFHOA(K)=0.0 +9780 CONTINUE + DFHCOS=0.0 + DFHCHS=0.0 + DFHOXS=0.0 + DFHNGS=0.0 + DFHN2S=0.0 + DFHHGS=0.0 + DFHNH4=0.0 + DFHNH3=0.0 + DFHNO3=0.0 + DFHNO2=0.0 + DFHP14=0.0 + DFHPO4=0.0 + DFHN4B=0.0 + DFHN3B=0.0 + DFHNOB=0.0 + DFHN2B=0.0 + DFHP1B=0.0 + DFHPOB=0.0 + ENDIF +C +C TOTAL MICROPORE AND MACROPORE SOLUTE TRANSPORT FLUXES BETWEEN +C ADJACENT GRID CELLS = CONVECTIVE + DIFFUSIVE FLUXES +C + DO 9765 K=0,4 + ROCFLS(K,N,N6,N5,N4)=RFLOC(K)+DFVOC(K) + RONFLS(K,N,N6,N5,N4)=RFLON(K)+DFVON(K) + ROPFLS(K,N,N6,N5,N4)=RFLOP(K)+DFVOP(K) + ROAFLS(K,N,N6,N5,N4)=RFLOA(K)+DFVOA(K) + ROCFHS(K,N,N6,N5,N4)=RFHOC(K)+DFHOC(K) + RONFHS(K,N,N6,N5,N4)=RFHON(K)+DFHON(K) + ROPFHS(K,N,N6,N5,N4)=RFHOP(K)+DFHOP(K) + ROAFHS(K,N,N6,N5,N4)=RFHOA(K)+DFHOA(K) +9765 CONTINUE + RCOFLS(N,N6,N5,N4)=RFLCOS+DFVCOS + RCHFLS(N,N6,N5,N4)=RFLCHS+DFVCHS + ROXFLS(N,N6,N5,N4)=RFLOXS+DFVOXS + RNGFLS(N,N6,N5,N4)=RFLNGS+DFVNGS + RN2FLS(N,N6,N5,N4)=RFLN2S+DFVN2S + RHGFLS(N,N6,N5,N4)=RFLHGS+DFVHGS + RN4FLW(N,N6,N5,N4)=RFLNH4+DFVNH4 + RN3FLW(N,N6,N5,N4)=RFLNH3+DFVNH3 + RNOFLW(N,N6,N5,N4)=RFLNO3+DFVNO3 + RNXFLS(N,N6,N5,N4)=RFLNO2+DFVNO2 + RH1PFS(N,N6,N5,N4)=RFLP14+DFVP14 + RH2PFS(N,N6,N5,N4)=RFLPO4+DFVPO4 + RN4FLB(N,N6,N5,N4)=RFLN4B+DFVN4B + RN3FLB(N,N6,N5,N4)=RFLN3B+DFVN3B + RNOFLB(N,N6,N5,N4)=RFLNOB+DFVNOB + RNXFLB(N,N6,N5,N4)=RFLN2B+DFVN2B + RH1BFB(N,N6,N5,N4)=RFLP1B+DFVP1B + RH2BFB(N,N6,N5,N4)=RFLPOB+DFVPOB + RCOFHS(N,N6,N5,N4)=RFHCOS+DFHCOS + RCHFHS(N,N6,N5,N4)=RFHCHS+DFHCHS + ROXFHS(N,N6,N5,N4)=RFHOXS+DFHOXS + RNGFHS(N,N6,N5,N4)=RFHNGS+DFHNGS + RN2FHS(N,N6,N5,N4)=RFHN2S+DFHN2S + RHGFHS(N,N6,N5,N4)=RFHHGS+DFHHGS + RN4FHW(N,N6,N5,N4)=RFHNH4+DFHNH4 + RN3FHW(N,N6,N5,N4)=RFHNH3+DFHNH3 + RNOFHW(N,N6,N5,N4)=RFHNO3+DFHNO3 + RNXFHS(N,N6,N5,N4)=RFHNO2+DFHNO2 + RH1PHS(N,N6,N5,N4)=RFHP14+DFHP14 + RH2PHS(N,N6,N5,N4)=RFHPO4+DFHPO4 + RN4FHB(N,N6,N5,N4)=RFHN4B+DFHN4B + RN3FHB(N,N6,N5,N4)=RFHN3B+DFHN3B + RNOFHB(N,N6,N5,N4)=RFHNOB+DFHNOB + RNXFHB(N,N6,N5,N4)=RFHN2B+DFHN2B + 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 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 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 +C 2,RH2PFS(N,N6,N5,N4),RFLPO4,DFVPO4,DIFPO,CPO4S1,CPO4S2 +C 3,VLPO4(N3,N2,N1),VLPO4(N6,N5,N4),VOLW2A,VOLWPA +C 4,H2PO42(N3,N2,N1),H2PO42(N6,N5,N4) +443 FORMAT(A8,8I4,20E12.4) +C ENDIF +C +C ACCUMULATE HOURLY FLUXES +C + DO 9755 K=0,4 + XOCFLS(K,N,N6,N5,N4)=XOCFLS(K,N,N6,N5,N4)+ROCFLS(K,N,N6,N5,N4) + XONFLS(K,N,N6,N5,N4)=XONFLS(K,N,N6,N5,N4)+RONFLS(K,N,N6,N5,N4) + XOPFLS(K,N,N6,N5,N4)=XOPFLS(K,N,N6,N5,N4)+ROPFLS(K,N,N6,N5,N4) + XOAFLS(K,N,N6,N5,N4)=XOAFLS(K,N,N6,N5,N4)+ROAFLS(K,N,N6,N5,N4) + XOCFHS(K,N,N6,N5,N4)=XOCFHS(K,N,N6,N5,N4)+ROCFHS(K,N,N6,N5,N4) + XONFHS(K,N,N6,N5,N4)=XONFHS(K,N,N6,N5,N4)+RONFHS(K,N,N6,N5,N4) + XOPFHS(K,N,N6,N5,N4)=XOPFHS(K,N,N6,N5,N4)+ROPFHS(K,N,N6,N5,N4) + XOAFHS(K,N,N6,N5,N4)=XOAFHS(K,N,N6,N5,N4)+ROAFHS(K,N,N6,N5,N4) +9755 CONTINUE + XCOFLS(N,N6,N5,N4)=XCOFLS(N,N6,N5,N4)+RCOFLS(N,N6,N5,N4) + XCHFLS(N,N6,N5,N4)=XCHFLS(N,N6,N5,N4)+RCHFLS(N,N6,N5,N4) + XOXFLS(N,N6,N5,N4)=XOXFLS(N,N6,N5,N4)+ROXFLS(N,N6,N5,N4) + XNGFLS(N,N6,N5,N4)=XNGFLS(N,N6,N5,N4)+RNGFLS(N,N6,N5,N4) + XN2FLS(N,N6,N5,N4)=XN2FLS(N,N6,N5,N4)+RN2FLS(N,N6,N5,N4) + XHGFLS(N,N6,N5,N4)=XHGFLS(N,N6,N5,N4)+RHGFLS(N,N6,N5,N4) + XN4FLW(N,N6,N5,N4)=XN4FLW(N,N6,N5,N4)+RN4FLW(N,N6,N5,N4) + XN3FLW(N,N6,N5,N4)=XN3FLW(N,N6,N5,N4)+RN3FLW(N,N6,N5,N4) + XNOFLW(N,N6,N5,N4)=XNOFLW(N,N6,N5,N4)+RNOFLW(N,N6,N5,N4) + XNXFLS(N,N6,N5,N4)=XNXFLS(N,N6,N5,N4)+RNXFLS(N,N6,N5,N4) + XH1PFS(N,N6,N5,N4)=XH1PFS(N,N6,N5,N4)+RH1PFS(N,N6,N5,N4) + XH2PFS(N,N6,N5,N4)=XH2PFS(N,N6,N5,N4)+RH2PFS(N,N6,N5,N4) + XN4FLB(N,N6,N5,N4)=XN4FLB(N,N6,N5,N4)+RN4FLB(N,N6,N5,N4) + XN3FLB(N,N6,N5,N4)=XN3FLB(N,N6,N5,N4)+RN3FLB(N,N6,N5,N4) + XNOFLB(N,N6,N5,N4)=XNOFLB(N,N6,N5,N4)+RNOFLB(N,N6,N5,N4) + XNXFLB(N,N6,N5,N4)=XNXFLB(N,N6,N5,N4)+RNXFLB(N,N6,N5,N4) + XH2BFB(N,N6,N5,N4)=XH2BFB(N,N6,N5,N4)+RH2BFB(N,N6,N5,N4) + XCOFHS(N,N6,N5,N4)=XCOFHS(N,N6,N5,N4)+RCOFHS(N,N6,N5,N4) + XCHFHS(N,N6,N5,N4)=XCHFHS(N,N6,N5,N4)+RCHFHS(N,N6,N5,N4) + XOXFHS(N,N6,N5,N4)=XOXFHS(N,N6,N5,N4)+ROXFHS(N,N6,N5,N4) + XNGFHS(N,N6,N5,N4)=XNGFHS(N,N6,N5,N4)+RNGFHS(N,N6,N5,N4) + XN2FHS(N,N6,N5,N4)=XN2FHS(N,N6,N5,N4)+RN2FHS(N,N6,N5,N4) + XHGFHS(N,N6,N5,N4)=XHGFHS(N,N6,N5,N4)+RHGFHS(N,N6,N5,N4) + XN4FHW(N,N6,N5,N4)=XN4FHW(N,N6,N5,N4)+RN4FHW(N,N6,N5,N4) + XN3FHW(N,N6,N5,N4)=XN3FHW(N,N6,N5,N4)+RN3FHW(N,N6,N5,N4) + XNOFHW(N,N6,N5,N4)=XNOFHW(N,N6,N5,N4)+RNOFHW(N,N6,N5,N4) + XNXFHS(N,N6,N5,N4)=XNXFHS(N,N6,N5,N4)+RNXFHS(N,N6,N5,N4) + XH1PHS(N,N6,N5,N4)=XH1PHS(N,N6,N5,N4)+RH1PHS(N,N6,N5,N4) + XH2PHS(N,N6,N5,N4)=XH2PHS(N,N6,N5,N4)+RH2PHS(N,N6,N5,N4) + XN4FHB(N,N6,N5,N4)=XN4FHB(N,N6,N5,N4)+RN4FHB(N,N6,N5,N4) + XN3FHB(N,N6,N5,N4)=XN3FHB(N,N6,N5,N4)+RN3FHB(N,N6,N5,N4) + XNOFHB(N,N6,N5,N4)=XNOFHB(N,N6,N5,N4)+RNOFHB(N,N6,N5,N4) + XNXFHB(N,N6,N5,N4)=XNXFHB(N,N6,N5,N4)+RNXFHB(N,N6,N5,N4) + XH1BHB(N,N6,N5,N4)=XH1BHB(N,N6,N5,N4)+RH1BHB(N,N6,N5,N4) + XH2BHB(N,N6,N5,N4)=XH2BHB(N,N6,N5,N4)+RH2BHB(N,N6,N5,N4) +C +C MACROPORE-MICROPORE SOLUTE EXCHANGE WITHIN SOIL +C LAYER FROM WATER EXCHANGE IN 'WATSUB' AND +C FROM MACROPORE OR MICROPORE SOLUTE CONCENTRATIONS +C + IF(N.EQ.3)THEN +C +C MACROPORE TO MICROPORE TRANSFER +C + IF(FINHM(M,N6,N5,N4).GT.0.0)THEN + IF(VOLWHM(M,N6,N5,N4).GT.ZEROS(N5,N4))THEN + VFLW=AMAX1(0.0,AMIN1(XFRX,FINHM(M,N6,N5,N4) + 2/VOLWHM(M,N6,N5,N4))) + ELSE + VFLW=XFRX + ENDIF + DO 9970 K=0,4 + RFLOC(K)=VFLW*AMAX1(0.0,OQCH2(K,N6,N5,N4)) + RFLON(K)=VFLW*AMAX1(0.0,OQNH2(K,N6,N5,N4)) + RFLOP(K)=VFLW*AMAX1(0.0,OQPH2(K,N6,N5,N4)) + RFLOA(K)=VFLW*AMAX1(0.0,OQAH2(K,N6,N5,N4)) +9970 CONTINUE + RFLCOS=VFLW*AMAX1(0.0,CO2SH2(N6,N5,N4)) + RFLCHS=VFLW*AMAX1(0.0,CH4SH2(N6,N5,N4)) + RFLOXS=VFLW*AMAX1(0.0,OXYSH2(N6,N5,N4)) + RFLNGS=VFLW*AMAX1(0.0,Z2GSH2(N6,N5,N4)) + RFLN2S=VFLW*AMAX1(0.0,Z2OSH2(N6,N5,N4)) + RFLHGS=VFLW*AMAX1(0.0,H2GSH2(N6,N5,N4)) + RFLNH4=VFLW*AMAX1(0.0,ZNH4H2(N6,N5,N4))*VLNH4(N6,N5,N4) + RFLNH3=VFLW*AMAX1(0.0,ZNH3H2(N6,N5,N4))*VLNH4(N6,N5,N4) + RFLNO3=VFLW*AMAX1(0.0,ZNO3H2(N6,N5,N4))*VLNO3(N6,N5,N4) + RFLNO2=VFLW*AMAX1(0.0,ZNO2H2(N6,N5,N4))*VLNO3(N6,N5,N4) + RFLP14=VFLW*AMAX1(0.0,H1P4H2(N6,N5,N4))*VLPO4(N6,N5,N4) + RFLPO4=VFLW*AMAX1(0.0,H2P4H2(N6,N5,N4))*VLPO4(N6,N5,N4) + RFLN4B=VFLW*AMAX1(0.0,ZN4BH2(N6,N5,N4))*VLNHB(N6,N5,N4) + RFLN3B=VFLW*AMAX1(0.0,ZN3BH2(N6,N5,N4))*VLNHB(N6,N5,N4) + RFLNOB=VFLW*AMAX1(0.0,ZNOBH2(N6,N5,N4))*VLNOB(N6,N5,N4) + RFLN2B=VFLW*AMAX1(0.0,ZN2BH2(N6,N5,N4))*VLNOB(N6,N5,N4) + RFLP1B=VFLW*AMAX1(0.0,H1PBH2(N6,N5,N4))*VLPOB(N6,N5,N4) + RFLPOB=VFLW*AMAX1(0.0,H2PBH2(N6,N5,N4))*VLPOB(N6,N5,N4) +C +C MICROPORE TO MACROPORE TRANSFER +C + ELSEIF(FINHM(M,N6,N5,N4).LT.0.0)THEN + IF(VOLWM(M,N6,N5,N4).GT.ZEROS(N5,N4))THEN + VFLW=AMIN1(0.0,AMAX1(-XFRX,FINHM(M,N6,N5,N4) + 2/VOLWM(M,N6,N5,N4))) + ELSE + VFLW=-XFRX + ENDIF + DO 9965 K=0,4 + RFLOC(K)=VFLW*AMAX1(0.0,OQC2(K,N6,N5,N4)) + RFLON(K)=VFLW*AMAX1(0.0,OQN2(K,N6,N5,N4)) + RFLOP(K)=VFLW*AMAX1(0.0,OQP2(K,N6,N5,N4)) + RFLOA(K)=VFLW*AMAX1(0.0,OQA2(K,N6,N5,N4)) +9965 CONTINUE + RFLCOS=VFLW*AMAX1(0.0,CO2S2(N6,N5,N4)) + RFLCHS=VFLW*AMAX1(0.0,CH4S2(N6,N5,N4)) + RFLOXS=VFLW*AMAX1(0.0,OXYS2(N6,N5,N4)) + RFLNGS=VFLW*AMAX1(0.0,Z2GS2(N6,N5,N4)) + RFLN2S=VFLW*AMAX1(0.0,Z2OS2(N6,N5,N4)) + RFLHGS=VFLW*AMAX1(0.0,H2GS2(N6,N5,N4)) + RFLNH4=VFLW*AMAX1(0.0,ZNH4S2(N6,N5,N4))*VLNH4(N6,N5,N4) + RFLNH3=VFLW*AMAX1(0.0,ZN3S2(N6,N5,N4))*VLNH4(N6,N5,N4) + RFLNO3=VFLW*AMAX1(0.0,ZNO3S2(N6,N5,N4))*VLNO3(N6,N5,N4) + RFLNO2=VFLW*AMAX1(0.0,ZNO2S2(N6,N5,N4))*VLNO3(N6,N5,N4) + RFLP14=VFLW*AMAX1(0.0,H1PO42(N6,N5,N4))*VLPO4(N6,N5,N4) + RFLPO4=VFLW*AMAX1(0.0,H2PO42(N6,N5,N4))*VLPO4(N6,N5,N4) + RFLN4B=VFLW*AMAX1(0.0,ZNH4B2(N6,N5,N4))*VLNHB(N6,N5,N4) + RFLN3B=VFLW*AMAX1(0.0,ZNBS2(N6,N5,N4))*VLNHB(N6,N5,N4) + RFLNOB=VFLW*AMAX1(0.0,ZNO3B2(N6,N5,N4))*VLNOB(N6,N5,N4) + RFLN2B=VFLW*AMAX1(0.0,ZNO2B2(N6,N5,N4))*VLNOB(N6,N5,N4) + RFLP1B=VFLW*AMAX1(0.0,H1POB2(N6,N5,N4))*VLPOB(N6,N5,N4) + RFLPOB=VFLW*AMAX1(0.0,H2POB2(N6,N5,N4))*VLPOB(N6,N5,N4) +C +C NO MACROPORE TO MICROPORE TRANSFER +C + ELSE + DO 9960 K=0,4 + RFLOC(K)=0.0 + RFLON(K)=0.0 + RFLOP(K)=0.0 + RFLOA(K)=0.0 +9960 CONTINUE + RFLCOS=0.0 + RFLCHS=0.0 + RFLOXS=0.0 + RFLNGS=0.0 + RFLN2S=0.0 + RFLHGS=0.0 + RFLNH4=0.0 + RFLNH3=0.0 + RFLNO3=0.0 + RFLNO2=0.0 + RFLP14=0.0 + RFLPO4=0.0 + RFLN4B=0.0 + RFLN3B=0.0 + RFLNOB=0.0 + RFLN2B=0.0 + RFLP1B=0.0 + RFLPOB=0.0 + ENDIF +C +C DIFFUSIVE FLUXES OF SOLUTES BETWEEN MICROPORES AND +C MACROPORES FROM AQUEOUS DIFFUSIVITIES AND CONCENTRATION 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 +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 + DFVCHS=XNPX*(AMAX1(0.0,CH4SH2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,CH4S2(N6,N5,N4))*VOLWHS)/VOLWT + DFVOXS=XNPX*(AMAX1(0.0,OXYSH2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,OXYS2(N6,N5,N4))*VOLWHS)/VOLWT + DFVNGS=XNPX*(AMAX1(0.0,Z2GSH2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,Z2GS2(N6,N5,N4))*VOLWHS)/VOLWT + DFVN2S=XNPX*(AMAX1(0.0,Z2OSH2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,Z2OS2(N6,N5,N4))*VOLWHS)/VOLWT + DFVHGS=XNPX*(AMAX1(0.0,H2GSH2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,H2GS2(N6,N5,N4))*VOLWHS)/VOLWT + DFVNH4=XNPX*(AMAX1(0.0,ZNH4H2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,ZNH4S2(N6,N5,N4))*VOLWHS)/VOLWT + 3*VLNH4(N6,N5,N4) + DFVNH3=XNPX*(AMAX1(0.0,ZNH3H2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,ZN3S2(N6,N5,N4))*VOLWHS)/VOLWT + 3*VLNH4(N6,N5,N4) + DFVNO3=XNPX*(AMAX1(0.0,ZNO3H2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,ZNO3S2(N6,N5,N4))*VOLWHS)/VOLWT + 3*VLNO3(N6,N5,N4) + DFVNO2=XNPX*(AMAX1(0.0,ZNO2H2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,ZNO2S2(N6,N5,N4))*VOLWHS)/VOLWT + 3*VLNO3(N6,N5,N4) + DFVP14=XNPX*(AMAX1(0.0,H1P4H2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,H1PO42(N6,N5,N4))*VOLWHS)/VOLWT + 3*VLPO4(N6,N5,N4) + DFVPO4=XNPX*(AMAX1(0.0,H2P4H2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,H2PO42(N6,N5,N4))*VOLWHS)/VOLWT + 3*VLPO4(N6,N5,N4) + DFVN4B=XNPX*(AMAX1(0.0,ZN4BH2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,ZNH4B2(N6,N5,N4))*VOLWHS)/VOLWT + 3*VLNHB(N6,N5,N4) + DFVN3B=XNPX*(AMAX1(0.0,ZN3BH2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,ZNBS2(N6,N5,N4))*VOLWHS)/VOLWT + 3*VLNHB(N6,N5,N4) + DFVNOB=XNPX*(AMAX1(0.0,ZNOBH2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,ZNO3B2(N6,N5,N4))*VOLWHS)/VOLWT + 3*VLNOB(N6,N5,N4) + DFVN2B=XNPX*(AMAX1(0.0,ZN2BH2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,ZNO2B2(N6,N5,N4))*VOLWHS)/VOLWT + 3*VLNOB(N6,N5,N4) + DFVP1B=XNPX*(AMAX1(0.0,H1PBH2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,H1POB2(N6,N5,N4))*VOLWHS)/VOLWT + 3*VLPOB(N6,N5,N4) + DFVPOB=XNPX*(AMAX1(0.0,H2PBH2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,H2POB2(N6,N5,N4))*VOLWHS)/VOLWT + 3*VLPOB(N6,N5,N4) + ELSE + DO 9975 K=0,2 + DFVOC(K)=0.0 + DFVON(K)=0.0 + DFVOP(K)=0.0 + DFVOA(K)=0.0 +9975 CONTINUE + DFVCOS=0.0 + DFVCHS=0.0 + DFVOXS=0.0 + DFVNGS=0.0 + DFVN2S=0.0 + DFVHGS=0.0 + DFVNH4=0.0 + DFVNH3=0.0 + DFVNO3=0.0 + DFVNO2=0.0 + DFVP14=0.0 + DFVPO4=0.0 + DFVN4B=0.0 + DFVN3B=0.0 + DFVNOB=0.0 + DFVN2B=0.0 + DFVP1B=0.0 + DFVPOB=0.0 + ENDIF +C +C TOTAL CONVECTIVE +DIFFUSIVE TRANSFER BETWEEN MACROPOES AND MICROPORES +C + DO 9950 K=0,4 + ROCFXS(K,N6,N5,N4)=RFLOC(K)+DFVOC(K) + 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 + ROXFXS(N6,N5,N4)=RFLOXS+DFVOXS + RNGFXS(N6,N5,N4)=RFLNGS+DFVNGS + RN2FXS(N6,N5,N4)=RFLN2S+DFVN2S + RHGFXS(N6,N5,N4)=RFLHGS+DFVHGS + RN4FXW(N6,N5,N4)=RFLNH4+DFVNH4 + RN3FXW(N6,N5,N4)=RFLNH3+DFVNH3 + RNOFXW(N6,N5,N4)=RFLNO3+DFVNO3 + RNXFXS(N6,N5,N4)=RFLNO2+DFVNO2 + RH1PXS(N6,N5,N4)=RFLP14+DFVP14 + RH2PXS(N6,N5,N4)=RFLPO4+DFVPO4 + RN4FXB(N6,N5,N4)=RFLN4B+DFVN4B + RN3FXB(N6,N5,N4)=RFLN3B+DFVN3B + RNOFXB(N6,N5,N4)=RFLNOB+DFVNOB + RNXFXB(N6,N5,N4)=RFLN2B+DFVN2B + RH1BXB(N6,N5,N4)=RFLP1B+DFVP1B + RH2BXB(N6,N5,N4)=RFLPOB+DFVPOB +C +C ACCUMULATE HOURLY FLUXES +C + DO 9945 K=0,4 + XOCFXS(K,N6,N5,N4)=XOCFXS(K,N6,N5,N4)+ROCFXS(K,N6,N5,N4) + XONFXS(K,N6,N5,N4)=XONFXS(K,N6,N5,N4)+RONFXS(K,N6,N5,N4) + XOPFXS(K,N6,N5,N4)=XOPFXS(K,N6,N5,N4)+ROPFXS(K,N6,N5,N4) + XOAFXS(K,N6,N5,N4)=XOAFXS(K,N6,N5,N4)+ROAFXS(K,N6,N5,N4) +9945 CONTINUE + XCOFXS(N6,N5,N4)=XCOFXS(N6,N5,N4)+RCOFXS(N6,N5,N4) + XCHFXS(N6,N5,N4)=XCHFXS(N6,N5,N4)+RCHFXS(N6,N5,N4) + XOXFXS(N6,N5,N4)=XOXFXS(N6,N5,N4)+ROXFXS(N6,N5,N4) + XNGFXS(N6,N5,N4)=XNGFXS(N6,N5,N4)+RNGFXS(N6,N5,N4) + XN2FXS(N6,N5,N4)=XN2FXS(N6,N5,N4)+RN2FXS(N6,N5,N4) + XHGFXS(N6,N5,N4)=XHGFXS(N6,N5,N4)+RHGFXS(N6,N5,N4) + XN4FXW(N6,N5,N4)=XN4FXW(N6,N5,N4)+RN4FXW(N6,N5,N4) + XN3FXW(N6,N5,N4)=XN3FXW(N6,N5,N4)+RN3FXW(N6,N5,N4) + XNOFXW(N6,N5,N4)=XNOFXW(N6,N5,N4)+RNOFXW(N6,N5,N4) + XNXFXS(N6,N5,N4)=XNXFXS(N6,N5,N4)+RNXFXS(N6,N5,N4) + XH1PXS(N6,N5,N4)=XH1PXS(N6,N5,N4)+RH1PXS(N6,N5,N4) + XH2PXS(N6,N5,N4)=XH2PXS(N6,N5,N4)+RH2PXS(N6,N5,N4) + XN4FXB(N6,N5,N4)=XN4FXB(N6,N5,N4)+RN4FXB(N6,N5,N4) + XN3FXB(N6,N5,N4)=XN3FXB(N6,N5,N4)+RN3FXB(N6,N5,N4) + XNOFXB(N6,N5,N4)=XNOFXB(N6,N5,N4)+RNOFXB(N6,N5,N4) + XNXFXB(N6,N5,N4)=XNXFXB(N6,N5,N4)+RNXFXB(N6,N5,N4) + XH1BXB(N6,N5,N4)=XH1BXB(N6,N5,N4)+RH1BXB(N6,N5,N4) + XH2BXB(N6,N5,N4)=XH2BXB(N6,N5,N4)+RH2BXB(N6,N5,N4) + ENDIF + ENDIF +C +C GASEOUS TRANSPORT FROM GASEOUS DIFFUSIVITY AND CONCENTRATION +C DIFFERENCES BETWEEN ADJACENT GRID CELLS +C +C +C GASEOUS DIFFUSIVITIES +C + IF(THETPM(M,N3,N2,N1).GT.THETX + 2.AND.THETPM(M,N6,N5,N4).GT.THETX + 3.AND.VOLPM(M,N3,N2,N1).GT.ZEROS(N2,N1) + 4.AND.VOLPM(M,N6,N5,N4).GT.ZEROS(N5,N4))THEN + DFLG2=2.0*AMAX1(0.0,THETPM(M,N3,N2,N1))**2/POROQ(N3,N2,N1) + 2*AREA(N,N3,N2,N1)/DLYR(N,N3,N2,N1) + DFLGL=2.0*AMAX1(0.0,THETPM(M,N6,N5,N4))**2/POROQ(N6,N5,N4) + 2*AREA(N,N6,N5,N4)/DLYR(N,N6,N5,N4) + CNDC1=DFLG2*CGSGL2(N3,N2,N1) + CND41=DFLG2*CHSGL2(N3,N2,N1) + CNDO1=DFLG2*OGSGL2(N3,N2,N1) + CNDG1=DFLG2*ZGSGL2(N3,N2,N1) + CND21=DFLG2*Z2SGL2(N3,N2,N1) + CNDH1=DFLG2*ZHSGL2(N3,N2,N1) + CNHG1=DFLG2*HGSGL2(N3,N2,N1) + CNDC2=DFLGL*CGSGL2(N6,N5,N4) + CND42=DFLGL*CHSGL2(N6,N5,N4) + CNDO2=DFLGL*OGSGL2(N6,N5,N4) + CNDG2=DFLGL*ZGSGL2(N6,N5,N4) + CND22=DFLGL*Z2SGL2(N6,N5,N4) + CNDH2=DFLGL*ZHSGL2(N6,N5,N4) + CNHG2=DFLGL*HGSGL2(N6,N5,N4) +C +C GASOUS CONDUCTANCES +C + DCO2G(N,N6,N5,N4)=(CNDC1*CNDC2)/(CNDC1+CNDC2) + DCH4G(N,N6,N5,N4)=(CND41*CND42)/(CND41+CND42) + DOXYG(N,N6,N5,N4)=(CNDO1*CNDO2)/(CNDO1+CNDO2) + DZ2GG(N,N6,N5,N4)=(CNDG1*CNDG2)/(CNDG1+CNDG2) + DZ2OG(N,N6,N5,N4)=(CND21*CND22)/(CND21+CND22) + DNH3G(N,N6,N5,N4)=(CNDH1*CNDH2)/(CNDH1+CNDH2) + DH2GG(N,N6,N5,N4)=(CNHG1*CNHG2)/(CNHG1+CNHG2) +C +C GASEOUS CONCENTRATIONS FROM AIR-FILLED POROSITY +C IN CURRENT AND ADJACENT GRID CELLS +C + CCO2G1=AMAX1(0.0,CO2G2(N3,N2,N1)/VOLPM(M,N3,N2,N1)) + CCH4G1=AMAX1(0.0,CH4G2(N3,N2,N1)/VOLPM(M,N3,N2,N1)) + COXYG1=AMAX1(0.0,OXYG2(N3,N2,N1)/VOLPM(M,N3,N2,N1)) + CZ2GG1=AMAX1(0.0,Z2GG2(N3,N2,N1)/VOLPM(M,N3,N2,N1)) + CZ2OG1=AMAX1(0.0,Z2OG2(N3,N2,N1)/VOLPM(M,N3,N2,N1)) + CNH3G1=AMAX1(0.0,ZN3G2(N3,N2,N1)/VOLPM(M,N3,N2,N1)) + CH2GG1=AMAX1(0.0,H2GG2(N3,N2,N1)/VOLPM(M,N3,N2,N1)) + CCO2G2=AMAX1(0.0,CO2G2(N6,N5,N4)/VOLPM(M,N6,N5,N4)) + CCH4G2=AMAX1(0.0,CH4G2(N6,N5,N4)/VOLPM(M,N6,N5,N4)) + COXYG2=AMAX1(0.0,OXYG2(N6,N5,N4)/VOLPM(M,N6,N5,N4)) + CZ2GG2=AMAX1(0.0,Z2GG2(N6,N5,N4)/VOLPM(M,N6,N5,N4)) + CZ2OG2=AMAX1(0.0,Z2OG2(N6,N5,N4)/VOLPM(M,N6,N5,N4)) + CNH3G2=AMAX1(0.0,ZN3G2(N6,N5,N4)/VOLPM(M,N6,N5,N4)) + CH2GG2=AMAX1(0.0,H2GG2(N6,N5,N4)/VOLPM(M,N6,N5,N4)) +C +C CONVECTIVE GAS TRANSFER DRIVEN BY SOIL WATER FLUXES +C FROM 'WATSUB' AND GAS CONCENTRATIONS IN THE ADJACENT GRID CELLS +C DEPENDING ON WATER FLUX DIRECTION +C + DFVCOG=DCO2G(N,N6,N5,N4)*(CCO2G1-CCO2G2) + DFVCHG=DCH4G(N,N6,N5,N4)*(CCH4G1-CCH4G2) + DFVOXG=DOXYG(N,N6,N5,N4)*(COXYG1-COXYG2) + DFVNGG=DZ2GG(N,N6,N5,N4)*(CZ2GG1-CZ2GG2) + DFVN2G=DZ2OG(N,N6,N5,N4)*(CZ2OG1-CZ2OG2) + DFVN3G=DNH3G(N,N6,N5,N4)*(CNH3G1-CNH3G2) + DFVHGG=DH2GG(N,N6,N5,N4)*(CH2GG1-CH2GG2) + IF(FLQM(N,N6,N5,N4).GT.0.0)THEN + IF(VOLPM(M,N6,N5,N4).GT.ZEROS(N5,N4))THEN + VFLW=-AMAX1(0.0,AMIN1(XFRX,FLQM(N,N6,N5,N4) + 2/VOLPM(M,N6,N5,N4))) + ELSE + VFLW=-XFRX + ENDIF + RFLCOG=VFLW*AMAX1(0.0,CO2G2(N6,N5,N4)) + RFLCHG=VFLW*AMAX1(0.0,CH4G2(N6,N5,N4)) + RFLOXG=VFLW*AMAX1(0.0,OXYG2(N6,N5,N4)) + RFLNGG=VFLW*AMAX1(0.0,Z2GG2(N6,N5,N4)) + RFLN2G=VFLW*AMAX1(0.0,Z2OG2(N6,N5,N4)) + RFLN3G=VFLW*AMAX1(0.0,ZN3G2(N6,N5,N4)) + RFLH2G=VFLW*AMAX1(0.0,H2GG2(N6,N5,N4)) + ELSE + IF(VOLPM(M,N3,N2,N1).GT.ZEROS(N2,N1))THEN + VFLW=-AMIN1(0.0,AMAX1(-XFRX,FLQM(N,N6,N5,N4) + 2/VOLPM(M,N3,N2,N1))) + ELSE + VFLW=XFRX + ENDIF + RFLCOG=VFLW*AMAX1(0.0,CO2G2(N3,N2,N1)) + RFLCHG=VFLW*AMAX1(0.0,CH4G2(N3,N2,N1)) + RFLOXG=VFLW*AMAX1(0.0,OXYG2(N3,N2,N1)) + RFLNGG=VFLW*AMAX1(0.0,Z2GG2(N3,N2,N1)) + RFLN2G=VFLW*AMAX1(0.0,Z2OG2(N3,N2,N1)) + RFLN3G=VFLW*AMAX1(0.0,ZN3G2(N3,N2,N1)) + RFLH2G=VFLW*AMAX1(0.0,H2GG2(N3,N2,N1)) + ENDIF +C +C SOIL GAS FLUX FROM DIFFERENCES +C BETWEEN CURRENT AND EQUILIBRIUM +C CONCENTRATIONS + CONVECTIVE FLUX +C + RCOFLG(N,N6,N5,N4)=DFVCOG+RFLCOG + RCHFLG(N,N6,N5,N4)=DFVCHG+RFLCHG + ROXFLG(N,N6,N5,N4)=DFVOXG+RFLOXG + RNGFLG(N,N6,N5,N4)=DFVNGG+RFLNGG + RN2FLG(N,N6,N5,N4)=DFVN2G+RFLN2G + RN3FLG(N,N6,N5,N4)=DFVN3G+RFLN3G + RHGFLG(N,N6,N5,N4)=DFVHGG+RFLH2G +C IF(I.EQ.43)THEN +C WRITE(*,3133)'ROXFL2',I,J,M,MM,N1,N2,N3,N,XOXFLG(N,N6,N5,N4) +C 2,ROXFLG(N,N6,N5,N4),DFVOXG,RFLOXG,COXYG1,COXYG2 +C 3,OXYG2(N3,N2,N1),OXYG2(N6,N5,N4) +C 4,FLQM(N,N6,N5,N4),VFLW,DOXYG(N,N6,N5,N4) +C 5,THETPM(M,N3,N2,N1),THETPM(M,N6,N5,N4) +C 5,VOLPM(M,N3,N2,N1),VOLPM(M,N6,N5,N4) +C WRITE(*,3133)'RNGFLG',I,J,M,MM,N4,N4,N6,N,RNGFLG(N,N6,N5,N4) +C 2,DFVNGG,RFLNGG,DZ2GG(N,N6,N5,N4),CZ2GG1,CZ2GG2 +3133 FORMAT(A8,8I4,20E12.4) +C ENDIF +C +C ACCUMULATE HOURLY FLUXES +C + XCOFLG(N,N6,N5,N4)=XCOFLG(N,N6,N5,N4)+RCOFLG(N,N6,N5,N4) + XCHFLG(N,N6,N5,N4)=XCHFLG(N,N6,N5,N4)+RCHFLG(N,N6,N5,N4) + XOXFLG(N,N6,N5,N4)=XOXFLG(N,N6,N5,N4)+ROXFLG(N,N6,N5,N4) + XNGFLG(N,N6,N5,N4)=XNGFLG(N,N6,N5,N4)+RNGFLG(N,N6,N5,N4) + XN2FLG(N,N6,N5,N4)=XN2FLG(N,N6,N5,N4)+RN2FLG(N,N6,N5,N4) + XN3FLG(N,N6,N5,N4)=XN3FLG(N,N6,N5,N4)+RN3FLG(N,N6,N5,N4) + XHGFLG(N,N6,N5,N4)=XHGFLG(N,N6,N5,N4)+RHGFLG(N,N6,N5,N4) + ELSE + RCOFLG(N,N6,N5,N4)=0.0 + RCHFLG(N,N6,N5,N4)=0.0 + ROXFLG(N,N6,N5,N4)=0.0 + RNGFLG(N,N6,N5,N4)=0.0 + RN2FLG(N,N6,N5,N4)=0.0 + RN3FLG(N,N6,N5,N4)=0.0 + RHGFLG(N,N6,N5,N4)=0.0 + ENDIF +C +C VOLATILIZATION-DISSOLUTION OF GASES IN SOIL +C LAYER FROM GASEOUS CONCENTRATIONS VS. THEIR AQUEOUS +C EQUIVALENTS DEPENDING ON SOLUBILITY FROM 'HOUR1' +C AND TRANSFER COEFFICIENT 'DFGS' FROM 'WATSUB' +C + IF(N.EQ.3)THEN + IF(THETPM(M,N6,N5,N4).GT.THETX)THEN + RCODFG(N6,N5,N4)=DFGS(M,N6,N5,N4)*(AMAX1(ZEROS(N5,N4) + 2,CO2G2(N6,N5,N4))*VOLWCO(N6,N5,N4) + 3-CO2S2(N6,N5,N4)*VOLPM(M,N6,N5,N4)) + 4/(VOLWCO(N6,N5,N4)+VOLPM(M,N6,N5,N4)) + RCHDFG(N6,N5,N4)=DFGS(M,N6,N5,N4)*(AMAX1(ZEROS(N5,N4) + 2,CH4G2(N6,N5,N4))*VOLWCH(N6,N5,N4) + 3-CH4S2(N6,N5,N4)*VOLPM(M,N6,N5,N4)) + 4/(VOLWCH(N6,N5,N4)+VOLPM(M,N6,N5,N4)) + ROXDFG(N6,N5,N4)=DFGS(M,N6,N5,N4)*(AMAX1(ZEROS(N5,N4) + 2,OXYG2(N6,N5,N4))*VOLWOX(N6,N5,N4) + 3-OXYS2(N6,N5,N4)*VOLPM(M,N6,N5,N4)) + 4/(VOLWOX(N6,N5,N4)+VOLPM(M,N6,N5,N4)) + RNGDFG(N6,N5,N4)=DFGS(M,N6,N5,N4)*(AMAX1(ZEROS(N5,N4) + 2,Z2GG2(N6,N5,N4))*VOLWNG(N6,N5,N4) + 3-Z2GS2(N6,N5,N4)*VOLPM(M,N6,N5,N4)) + 4/(VOLWNG(N6,N5,N4)+VOLPM(M,N6,N5,N4)) + RN2DFG(N6,N5,N4)=DFGS(M,N6,N5,N4)*(AMAX1(ZEROS(N5,N4) + 2,Z2OG2(N6,N5,N4))*VOLWN2(N6,N5,N4) + 3-Z2OS2(N6,N5,N4)*VOLPM(M,N6,N5,N4)) + 3/(VOLWN2(N6,N5,N4)+VOLPM(M,N6,N5,N4)) + IF(VOLPMA(N6,N5,N4).GT.ZEROS(N5,N4) + 2.AND.VOLWXA(N6,N5,N4).GT.ZEROS(N5,N4))THEN + RN3DFG(N6,N5,N4)=DFGS(M,N6,N5,N4)*(AMAX1(ZEROS(N5,N4) + 2,ZN3G2(N6,N5,N4))*VOLWN3(N6,N5,N4) + 3-ZN3S2(N6,N5,N4)*VOLPMA(N6,N5,N4)) + 4/(VOLWN3(N6,N5,N4)+VOLPMA(N6,N5,N4)) + CNH3S0=AMAX1(0.0,(ZN3S2(N6,N5,N4)+RN3DFG(N6,N5,N4)) + 2/VOLWXA(N6,N5,N4)) + CNH4S0=AMAX1(0.0,ZNH4S2(N6,N5,N4)) + 2/VOLWXA(N6,N5,N4) + ELSE + RN3DFG(N6,N5,N4)=0.0 + ENDIF + IF(VOLPMB(N6,N5,N4).GT.ZEROS(N5,N4) + 2.AND.VOLWXB(N6,N5,N4).GT.ZEROS(N5,N4))THEN + RNBDFG(N6,N5,N4)=DFGS(M,N6,N5,N4)*(AMAX1(ZEROS(N5,N4) + 2,ZN3G2(N6,N5,N4))*VOLWNB(N6,N5,N4) + 3-ZNBS2(N6,N5,N4)*VOLPMB(N6,N5,N4)) + 4/(VOLWNB(N6,N5,N4)+VOLPMB(N6,N5,N4)) + CNH3B0=AMAX1(0.0,(ZNBS2(N6,N5,N4)+RNBDFG(N6,N5,N4)) + 2/VOLWXB(N6,N5,N4)) + CNH4B0=AMAX1(0.0,ZNH4B2(N6,N5,N4))/VOLWXB(N6,N5,N4) + ELSE + RNBDFG(N6,N5,N4)=0.0 + ENDIF + RHGDFG(N6,N5,N4)=DFGS(M,N6,N5,N4)*(AMAX1(ZEROS(N5,N4) + 2,H2GG2(N6,N5,N4))*VOLWHG(N6,N5,N4) + 3-H2GS2(N6,N5,N4)*VOLPM(M,N6,N5,N4)) + 4/(VOLWHG(N6,N5,N4)+VOLPM(M,N6,N5,N4)) +C IF(I.EQ.43)THEN +C WRITE(*,6666)'RN3DFG',I,J,M,MM,N4,N5,N6,RN3DFG(N6,N5,N4) +C 2,DFGS(M,N6,N5,N4),ZN3S2A,VOLWN3(N6,N5,N4),ZN3S2(N6,N5,N4) +C 3,VOLPMA(N6,N5,N4),RNBDFG(N6,N5,N4),ZN3S2B +C 4,VOLWNB(N6,N5,N4),ZNBS2(N6,N5,N4),VOLPMB(N6,N5,N4) +C WRITE(*,6666)'RCHDFG',I,J,M,MM,N4,N5,N6,RCHDFG(N6,N5,N4) +C 2,DFGS(M,N6,N5,N4),CH4G2(N6,N5,N4),VOLWCH(N6,N5,N4) +C 3,CH4S2(N6,N5,N4),VOLWM(M,N6,N5,N4),THETPM(M,N6,N5,N4) +C 4,SCH4L(N6,N5,N4),XCHDFG(N6,N5,N4) +C WRITE(*,6666)'RNGDFG',I,J,M,MM,N4,N5,N6 +C 2,RNGDFG(N6,N5,N4),DFGS(M,N6,N5,N4),Z2GG2(N6,N5,N4) +C 3,VOLWNG(N6,N5,N4),Z2GS2(N6,N5,N4),VOLPM(M,N6,N5,N4) +C 4,VOLWNG(N6,N5,N4),VOLPM(M,N6,N5,N4) +6666 FORMAT(A8,7I4,20E12.4) +C ENDIF +C +C ACCUMULATE HOURLY FLUXES +C + XCODFG(N6,N5,N4)=XCODFG(N6,N5,N4)+RCODFG(N6,N5,N4) + XCHDFG(N6,N5,N4)=XCHDFG(N6,N5,N4)+RCHDFG(N6,N5,N4) + XOXDFG(N6,N5,N4)=XOXDFG(N6,N5,N4)+ROXDFG(N6,N5,N4) + XNGDFG(N6,N5,N4)=XNGDFG(N6,N5,N4)+RNGDFG(N6,N5,N4) + XN2DFG(N6,N5,N4)=XN2DFG(N6,N5,N4)+RN2DFG(N6,N5,N4) + XN3DFG(N6,N5,N4)=XN3DFG(N6,N5,N4)+RN3DFG(N6,N5,N4) + XNBDFG(N6,N5,N4)=XNBDFG(N6,N5,N4)+RNBDFG(N6,N5,N4) + XHGDFG(N6,N5,N4)=XHGDFG(N6,N5,N4)+RHGDFG(N6,N5,N4) + ELSE + RCODFG(N6,N5,N4)=0.0 + RCHDFG(N6,N5,N4)=0.0 + ROXDFG(N6,N5,N4)=0.0 + RNGDFG(N6,N5,N4)=0.0 + RN2DFG(N6,N5,N4)=0.0 + RN3DFG(N6,N5,N4)=0.0 + RNBDFG(N6,N5,N4)=0.0 + RHGDFG(N6,N5,N4)=0.0 + ENDIF + ENDIF + ELSEIF(N.NE.3)THEN + DCO2G(N,N6,N5,N4)=0.0 + DCH4G(N,N6,N5,N4)=0.0 + DOXYG(N,N6,N5,N4)=0.0 + DZ2GG(N,N6,N5,N4)=0.0 + DZ2OG(N,N6,N5,N4)=0.0 + DNH3G(N,N6,N5,N4)=0.0 + DH2GG(N,N6,N5,N4)=0.0 + DO 9750 K=0,4 + ROCFLS(K,N,N6,N5,N4)=0.0 + RONFLS(K,N,N6,N5,N4)=0.0 + ROPFLS(K,N,N6,N5,N4)=0.0 + ROAFLS(K,N,N6,N5,N4)=0.0 + ROCFHS(K,N,N6,N5,N4)=0.0 + RONFHS(K,N,N6,N5,N4)=0.0 + ROPFHS(K,N,N6,N5,N4)=0.0 + ROAFHS(K,N,N6,N5,N4)=0.0 +9750 CONTINUE + RCOFLS(N,N6,N5,N4)=0.0 + RCHFLS(N,N6,N5,N4)=0.0 + ROXFLS(N,N6,N5,N4)=0.0 + RNGFLS(N,N6,N5,N4)=0.0 + RN2FLS(N,N6,N5,N4)=0.0 + RHGFLS(N,N6,N5,N4)=0.0 + RN4FLW(N,N6,N5,N4)=0.0 + RN3FLW(N,N6,N5,N4)=0.0 + RNOFLW(N,N6,N5,N4)=0.0 + RNXFLS(N,N6,N5,N4)=0.0 + RH1PFS(N,N6,N5,N4)=0.0 + RH2PFS(N,N6,N5,N4)=0.0 + RN4FLB(N,N6,N5,N4)=0.0 + RN3FLB(N,N6,N5,N4)=0.0 + RNOFLB(N,N6,N5,N4)=0.0 + RNXFLB(N,N6,N5,N4)=0.0 + RH2BFB(N,N6,N5,N4)=0.0 + RCOFHS(N,N6,N5,N4)=0.0 + RCHFHS(N,N6,N5,N4)=0.0 + ROXFHS(N,N6,N5,N4)=0.0 + RNGFHS(N,N6,N5,N4)=0.0 + RN2FHS(N,N6,N5,N4)=0.0 + RHGFHS(N,N6,N5,N4)=0.0 + RN4FHW(N,N6,N5,N4)=0.0 + RN3FHW(N,N6,N5,N4)=0.0 + RNOFHW(N,N6,N5,N4)=0.0 + RNXFHS(N,N6,N5,N4)=0.0 + RH1PHS(N,N6,N5,N4)=0.0 + RH2PHS(N,N6,N5,N4)=0.0 + RN4FHB(N,N6,N5,N4)=0.0 + RN3FHB(N,N6,N5,N4)=0.0 + RNOFHB(N,N6,N5,N4)=0.0 + RNXFHB(N,N6,N5,N4)=0.0 + RH1BHB(N,N6,N5,N4)=0.0 + RH2BHB(N,N6,N5,N4)=0.0 + RCOFLG(N,N6,N5,N4)=0.0 + RCHFLG(N,N6,N5,N4)=0.0 + ROXFLG(N,N6,N5,N4)=0.0 + RNGFLG(N,N6,N5,N4)=0.0 + RN2FLG(N,N6,N5,N4)=0.0 + RN3FLG(N,N6,N5,N4)=0.0 + RHGFLG(N,N6,N5,N4)=0.0 + ENDIF +120 CONTINUE +C +C CHECK FOR BUBBLING IF THE SUM OF ALL GASEOUS EQUIVALENT +C PARTIAL CONCENTRATIONS EXCEEDS ATMOSPHERIC PRESSURE +C + IF(N3.GE.NU(N2,N1).AND.M.NE.MX)THEN + THETW1(N3,N2,N1)=AMAX1(0.0,VOLWM(M,N3,N2,N1)/VOLX(N3,N2,N1)) + IF(THETW1(N3,N2,N1).GT.THETY(N3,N2,N1).AND.IFLGB.EQ.0)THEN + SCO2X=12.0*SCO2L(N3,N2,N1) + SCH4X=12.0*SCH4L(N3,N2,N1) + SOXYX=32.0*SOXYL(N3,N2,N1) + SN2GX=28.0*SN2GL(N3,N2,N1) + SN2OX=28.0*SN2OL(N3,N2,N1) + SNH3X=14.0*SNH3L(N3,N2,N1) + SH2GX=2.0*SH2GL(N3,N2,N1) +C +C GASEOUS EQUIVALENT PARTIAL CONCENTRATIONS +C + VCO2G2=CO2S2(N3,N2,N1)/SCO2X + VCH4G2=CH4S2(N3,N2,N1)/SCH4X + VOXYG2=OXYS2(N3,N2,N1)/SOXYX + VZ2GG2=Z2GS2(N3,N2,N1)/SN2GX + VZ2OG2=Z2OS2(N3,N2,N1)/SN2OX + VNH3G2=ZN3S2(N3,N2,N1)/SNH3X + VNHBG2=ZNBS2(N3,N2,N1)/SNH3X + VH2GG2=H2GS2(N3,N2,N1)/SH2GX +C +C GASEOUS EQUIVALENT ATMOSPHERIC CONCENTRATION +C + VTATM=AMAX1(0.0,1.2194E+04*VOLWM(M,N3,N2,N1)/TKS(N3,N2,N1)) + VTGAS=VCO2G2+VCH4G2+VOXYG2+VZ2GG2+VZ2OG2+VNH3G2+VNHBG2+VH2GG2 +C +C PROPORTIONAL REMOVAL OF EXCESS AQUEOUS GASES +C + IF(VTGAS.GT.VTATM)THEN + DVTGAS=VTATM-VTGAS + RCOBBL(N3,N2,N1)=AMIN1(0.0,DVTGAS*VCO2G2/VTGAS)*SCO2X + RCHBBL(N3,N2,N1)=AMIN1(0.0,DVTGAS*VCH4G2/VTGAS)*SCH4X + ROXBBL(N3,N2,N1)=AMIN1(0.0,DVTGAS*VOXYG2/VTGAS)*SOXYX + RNGBBL(N3,N2,N1)=AMIN1(0.0,DVTGAS*VZ2GG2/VTGAS)*SN2GX + RN2BBL(N3,N2,N1)=AMIN1(0.0,DVTGAS*VZ2OG2/VTGAS)*SN2OX + RN3BBL(N3,N2,N1)=AMIN1(0.0,DVTGAS*VNH3G2/VTGAS)*SNH3X + RNBBBL(N3,N2,N1)=AMIN1(0.0,DVTGAS*VNHBG2/VTGAS)*SNH3X + RHGBBL(N3,N2,N1)=AMIN1(0.0,DVTGAS*VH2GG2/VTGAS)*SH2GX +C +C ACCUMULATE HOURLY FLUXES +C + XCOBBL(N3,N2,N1)=XCOBBL(N3,N2,N1)+RCOBBL(N3,N2,N1) + XCHBBL(N3,N2,N1)=XCHBBL(N3,N2,N1)+RCHBBL(N3,N2,N1) + XOXBBL(N3,N2,N1)=XOXBBL(N3,N2,N1)+ROXBBL(N3,N2,N1) + XNGBBL(N3,N2,N1)=XNGBBL(N3,N2,N1)+RNGBBL(N3,N2,N1) + XN2BBL(N3,N2,N1)=XN2BBL(N3,N2,N1)+RN2BBL(N3,N2,N1) + XN3BBL(N3,N2,N1)=XN3BBL(N3,N2,N1)+RN3BBL(N3,N2,N1) + XNBBBL(N3,N2,N1)=XNBBBL(N3,N2,N1)+RNBBBL(N3,N2,N1) + XHGBBL(N3,N2,N1)=XHGBBL(N3,N2,N1)+RHGBBL(N3,N2,N1) + ELSE + RCOBBL(N3,N2,N1)=0.0 + RCHBBL(N3,N2,N1)=0.0 + ROXBBL(N3,N2,N1)=0.0 + RNGBBL(N3,N2,N1)=0.0 + RN2BBL(N3,N2,N1)=0.0 + RN3BBL(N3,N2,N1)=0.0 + RNBBBL(N3,N2,N1)=0.0 + RHGBBL(N3,N2,N1)=0.0 + ENDIF + ELSE + IFLGB=1 + RCOBBL(N3,N2,N1)=0.0 + RCHBBL(N3,N2,N1)=0.0 + ROXBBL(N3,N2,N1)=0.0 + RNGBBL(N3,N2,N1)=0.0 + RN2BBL(N3,N2,N1)=0.0 + RN3BBL(N3,N2,N1)=0.0 + RNBBBL(N3,N2,N1)=0.0 + RHGBBL(N3,N2,N1)=0.0 + ENDIF +C IF(N1.EQ.2.AND.N2.EQ.1.AND.N3.EQ.13)THEN +C WRITE(*,6688)'BUBBL',I,J,N1,N2,N3,M,MM,IFLGB,VTGAS,VTATM +C 2,DVTGAS,SOXYX,VCO2G2,VCH4G2,VOXYG2,VZ2GG2,VZ2OG2 +C 3,VNH3G2,VNHBG2,VH2GG2,ROXBBL(N3,N2,N1),XOXBBL(N3,N2,N1) +C 4,OXYS2(N3,N2,N1),VOLWM(M,N3,N2,N1) +6688 FORMAT(A8,8I4,20E12.4) +C ENDIF + ENDIF +125 CONTINUE +9890 CONTINUE +9895 CONTINUE +C +C BOUNDARY SOLUTE AND GAS FLUXES +C + DO 9595 NX=NHW,NHE + DO 9590 NY=NVN,NVS + DO 9585 L=NU(NY,NX),NL(NY,NX) + N1=NX + N2=NY + N3=L +C +C LOCATE ALL EXTERNAL BOUNDARIES AND SET BOUNDARY CONDITIONS +C ENTERED IN 'READS' +C + DO 9580 N=1,3 + DO 9575 NN=1,2 + IF(N.EQ.1)THEN + N4=NX+1 + N5=NY + N6=L + IF(NN.EQ.1)THEN + IF(NX.EQ.NHE)THEN + M1=NX + M2=NY + M3=L + M4=NX+1 + M5=NY + M6=L + XN=-1.0 + ELSE + GO TO 9575 + ENDIF + ELSEIF(NN.EQ.2)THEN + IF(NX.EQ.NHW)THEN + M1=NX + M2=NY + M3=L + M4=NX + M5=NY + M6=L + XN=1.0 + ELSE + GO TO 9575 + ENDIF + ENDIF + ELSEIF(N.EQ.2)THEN + N4=NX + N5=NY+1 + N6=L + IF(NN.EQ.1)THEN + IF(NY.EQ.NVS)THEN + M1=NX + M2=NY + M3=L + M4=NX + M5=NY+1 + M6=L + XN=-1.0 + ELSE + GO TO 9575 + ENDIF + ELSEIF(NN.EQ.2)THEN + IF(NY.EQ.NVN)THEN + M1=NX + M2=NY + M3=L + M4=NX + M5=NY + M6=L + XN=1.0 + ELSE + GO TO 9575 + ENDIF + ENDIF + ELSEIF(N.EQ.3)THEN + N1=NX + N2=NY + N3=L + N4=NX + N5=NY + N6=L+1 + IF(NN.EQ.1)THEN + IF(L.EQ.NL(NY,NX))THEN + M1=NX + M2=NY + M3=L + M4=NX + M5=NY + M6=L+1 + XN=-1.0 + ELSE + GO TO 9575 + ENDIF + ELSEIF(NN.EQ.2)THEN + GO TO 9575 + ENDIF + ENDIF +C +C SURFACE SOLUTE TRANSPORT FROM BOUNDARY SURFACE +C RUNOFF IN 'WATSUB' AND CONCENTRATIONS IN THE SURFACE SOIL LAYER +C + IF(M.NE.MX)THEN + IF(M3.EQ.NU(M2,M1).AND.N.NE.3)THEN +C +C NO RUNOFF +C + IF(QRM(M,N,M5,M4).EQ.0.0)THEN + DO 9570 K=0,2 + RQROC(K,N,M5,M4)=0.0 + RQRON(K,N,M5,M4)=0.0 + RQROP(K,N,M5,M4)=0.0 + RQROA(K,N,M5,M4)=0.0 +9570 CONTINUE + RQRCOS(N,M5,M4)=0.0 + RQRCHS(N,M5,M4)=0.0 + RQROXS(N,M5,M4)=0.0 + RQRNGS(N,M5,M4)=0.0 + RQRN2S(N,M5,M4)=0.0 + RQRHGS(N,M5,M4)=0.0 + RQRNH4(N,M5,M4)=0.0 + RQRNH3(N,M5,M4)=0.0 + RQRNO3(N,M5,M4)=0.0 + RQRNO2(N,M5,M4)=0.0 + RQRH1P(N,M5,M4)=0.0 + RQRH2P(N,M5,M4)=0.0 +C +C SOLUTE LOSS FROM RUNOFF DEPENDING ON ASPECT +C AND BOUNDARY CONDITIONS SET IN SITE FILE +C + ELSEIF(NN.EQ.1.AND.QRM(M,N,M5,M4).GT.0.0 + 2.OR.NN.EQ.2.AND.QRM(M,N,M5,M4).LT.0.0)THEN + IF(VOLWM(M,0,M2,M1).GT.ZEROS(M2,M1))THEN + VFLW=AMAX1(-XFRX,AMIN1(XFRX,QRM(M,N,M5,M4) + 2/VOLWM(M,0,M2,M1))) + ELSE + VFLW=0.0 + ENDIF + DO 9540 K=0,2 + 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)) + RQROA(K,N,M5,M4)=VFLW*AMAX1(0.0,OQA2(K,0,M2,M1)) +9540 CONTINUE + RQRCOS(N,M5,M4)=VFLW*AMAX1(0.0,CO2S2(0,M2,M1)) + RQRCHS(N,M5,M4)=VFLW*AMAX1(0.0,CH4S2(0,M2,M1)) + RQROXS(N,M5,M4)=VFLW*AMAX1(0.0,OXYS2(0,M2,M1)) + RQRNGS(N,M5,M4)=VFLW*AMAX1(0.0,Z2GS2(0,M2,M1)) + RQRN2S(N,M5,M4)=VFLW*AMAX1(0.0,Z2OS2(0,M2,M1)) + RQRHGS(N,M5,M4)=VFLW*AMAX1(0.0,H2GS2(0,M2,M1)) + RQRNH4(N,M5,M4)=VFLW*AMAX1(0.0,ZNH4S2(0,M2,M1)) + RQRNH3(N,M5,M4)=VFLW*AMAX1(0.0,ZN3S2(0,M2,M1)) + RQRNO3(N,M5,M4)=VFLW*AMAX1(0.0,ZNO3S2(0,M2,M1)) + RQRNO2(N,M5,M4)=VFLW*AMAX1(0.0,ZNO2S2(0,M2,M1)) + RQRH1P(N,M5,M4)=VFLW*AMAX1(0.0,H1PO42(0,M2,M1)) + RQRH2P(N,M5,M4)=VFLW*AMAX1(0.0,H2PO42(0,M2,M1)) +C WRITE(18,1114)'RUNX',I,J,M,M1,M2,M3,N,QRM(M,N,M5,M4) +C 2,RQRH2P(N,M5,M4),(RQROP(K,N,M5,M4),K=1,4) +1114 FORMAT(A8,7I4,20E12.4) +C +C SOLUTE GAIN FROM RUNON DEPENDING ON ASPECT +C AND BOUNDARY CONDITIONS SET IN SITE FILE +C + ELSE + DO 9640 K=0,2 + RQROC(K,N,M5,M4)=0.0 + RQRON(K,N,M5,M4)=0.0 + RQROP(K,N,M5,M4)=0.0 + RQROA(K,N,M5,M4)=0.0 +9640 CONTINUE + RQRCOS(N,M5,M4)=QRM(M,N,M5,M4)*CCOU + RQRCHS(N,M5,M4)=QRM(M,N,M5,M4)*CCHU + RQROXS(N,M5,M4)=QRM(M,N,M5,M4)*COXU + RQRNGS(N,M5,M4)=QRM(M,N,M5,M4)*CNNU + RQRN2S(N,M5,M4)=QRM(M,N,M5,M4)*CN2U + RQRHGS(N,M5,M4)=0.0 + RQRNH4(N,M5,M4)=0.0 + RQRNH3(N,M5,M4)=0.0 + RQRNO3(N,M5,M4)=0.0 + RQRNO2(N,M5,M4)=0.0 + RQRH1P(N,M5,M4)=0.0 + RQRH2P(N,M5,M4)=0.0 + ENDIF + RQSCOS(N,M5,M4)=0.0 + RQSCHS(N,M5,M4)=0.0 + RQSOXS(N,M5,M4)=0.0 + RQSNGS(N,M5,M4)=0.0 + RQSN2S(N,M5,M4)=0.0 + RQSNH4(N,M5,M4)=0.0 + RQSNH3(N,M5,M4)=0.0 + RQSNO3(N,M5,M4)=0.0 + RQSH1P(N,M5,M4)=0.0 + RQSH2P(N,M5,M4)=0.0 +C +C ACCUMULATE HOURLY FLUXES +C + DO 9565 K=0,2 + 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) + XOAQRS(K,N,M5,M4)=XOAQRS(K,N,M5,M4)+RQROA(K,N,M5,M4) +9565 CONTINUE + XCOQRS(N,M5,M4)=XCOQRS(N,M5,M4)+RQRCOS(N,M5,M4) + XCHQRS(N,M5,M4)=XCHQRS(N,M5,M4)+RQRCHS(N,M5,M4) + XOXQRS(N,M5,M4)=XOXQRS(N,M5,M4)+RQROXS(N,M5,M4) + XNGQRS(N,M5,M4)=XNGQRS(N,M5,M4)+RQRNGS(N,M5,M4) + XN2QRS(N,M5,M4)=XN2QRS(N,M5,M4)+RQRN2S(N,M5,M4) + XHGQRS(N,M5,M4)=XHGQRS(N,M5,M4)+RQRHGS(N,M5,M4) + XN4QRW(N,M5,M4)=XN4QRW(N,M5,M4)+RQRNH4(N,M5,M4) + XN3QRW(N,M5,M4)=XN3QRW(N,M5,M4)+RQRNH3(N,M5,M4) + XNOQRW(N,M5,M4)=XNOQRW(N,M5,M4)+RQRNO3(N,M5,M4) + XNXQRS(N,M5,M4)=XNXQRS(N,M5,M4)+RQRNO2(N,M5,M4) + XP1QRW(N,M5,M4)=XP1QRW(N,M5,M4)+RQRH1P(N,M5,M4) + XP4QRW(N,M5,M4)=XP4QRW(N,M5,M4)+RQRH2P(N,M5,M4) + XCOQSS(N,M5,M4)=XCOQSS(N,M5,M4)+RQSCOS(N,M5,M4) + XCHQSS(N,M5,M4)=XCHQSS(N,M5,M4)+RQSCHS(N,M5,M4) + XOXQSS(N,M5,M4)=XOXQSS(N,M5,M4)+RQSOXS(N,M5,M4) + XNGQSS(N,M5,M4)=XNGQSS(N,M5,M4)+RQSNGS(N,M5,M4) + XN2QSS(N,M5,M4)=XN2QSS(N,M5,M4)+RQSN2S(N,M5,M4) + XN4QSS(N,M5,M4)=XN4QSS(N,M5,M4)+RQSNH4(N,M5,M4) + XN3QSS(N,M5,M4)=XN3QSS(N,M5,M4)+RQSNH3(N,M5,M4) + XNOQSS(N,M5,M4)=XNOQSS(N,M5,M4)+RQSNO3(N,M5,M4) + XP1QSS(N,M5,M4)=XP1QSS(N,M5,M4)+RQSH1P(N,M5,M4) + XP4QSS(N,M5,M4)=XP4QSS(N,M5,M4)+RQSH2P(N,M5,M4) + ENDIF +C +C SOLUTE LOSS WITH SUBSURFACE MICROPORE WATER LOSS +C + IF(NCN(M2,M1).NE.3.OR.N.EQ.3)THEN + IF(NN.EQ.1.AND.FLWM(M,N,M6,M5,M4).GT.0.0 + 2.OR.NN.EQ.2.AND.FLWM(M,N,M6,M5,M4).LT.0.0)THEN + IF(VOLWM(M,M3,M2,M1).GT.ZEROS(M2,M1))THEN + VFLW=AMAX1(-XFRX,AMIN1(XFRX,FLWM(M,N,M6,M5,M4) + 2/VOLWM(M,M3,M2,M1))) + ELSE + VFLW=0.0 + ENDIF + DO 9520 K=0,4 + ROCFLS(K,N,M6,M5,M4)=VFLW*AMAX1(0.0,OQC2(K,M3,M2,M1)) + RONFLS(K,N,M6,M5,M4)=VFLW*AMAX1(0.0,OQN2(K,M3,M2,M1)) + ROPFLS(K,N,M6,M5,M4)=VFLW*AMAX1(0.0,OQP2(K,M3,M2,M1)) + ROAFLS(K,N,M6,M5,M4)=VFLW*AMAX1(0.0,OQA2(K,M3,M2,M1)) +9520 CONTINUE + RCOFLS(N,M6,M5,M4)=VFLW*AMAX1(0.0,CO2S2(M3,M2,M1)) + RCHFLS(N,M6,M5,M4)=VFLW*AMAX1(0.0,CH4S2(M3,M2,M1)) + ROXFLS(N,M6,M5,M4)=VFLW*AMAX1(0.0,OXYS2(M3,M2,M1)) + RNGFLS(N,M6,M5,M4)=VFLW*AMAX1(0.0,Z2GS2(M3,M2,M1)) + RN2FLS(N,M6,M5,M4)=VFLW*AMAX1(0.0,Z2OS2(M3,M2,M1)) + RHGFLS(N,M6,M5,M4)=VFLW*AMAX1(0.0,H2GS2(M3,M2,M1)) + RN4FLW(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZNH4S2(M3,M2,M1)) + 2*VLNH4(M3,M2,M1) + RN3FLW(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZN3S2(M3,M2,M1)) + 2*VLNH4(M3,M2,M1) + RNOFLW(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZNO3S2(M3,M2,M1)) + 2*VLNO3(M3,M2,M1) + RNXFLS(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZNO2S2(M3,M2,M1)) + 2*VLNO3(M3,M2,M1) + RH1PFS(N,M6,M5,M4)=VFLW*AMAX1(0.0,H1PO42(M3,M2,M1)) + 2*VLPO4(M3,M2,M1) + RH2PFS(N,M6,M5,M4)=VFLW*AMAX1(0.0,H2PO42(M3,M2,M1)) + 2*VLPO4(M3,M2,M1) + RN4FLB(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZNH4B2(M3,M2,M1)) + 2*VLNHB(M3,M2,M1) + RN3FLB(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZNBS2(M3,M2,M1)) + 2*VLNHB(M3,M2,M1) + RNOFLB(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZNO3B2(M3,M2,M1)) + 2*VLNOB(M3,M2,M1) + RNXFLB(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZNO2B2(M3,M2,M1)) + 2*VLNOB(M3,M2,M1) + RH2BFB(N,M6,M5,M4)=VFLW*AMAX1(0.0,H2POB2(M3,M2,M1)) + 2*VLPOB(M3,M2,M1) +C IF(J.EQ.15)THEN +C WRITE(*,8765)'LEACH',I,J,M,M6,M5,M4,RNOFLW(N,M6,M5,M4) +C 2,VFLW,ZNO3S2(M3,M2,M1),VLNO3(M3,M2,M1),FLWM(M,N,M6,M5,M4) +C 3,VOLWM(M,M3,M2,M1) +8765 FORMAT(A8,6I4,20E12.4) +C ENDIF +C +C NO SOLUTE GAIN WITH SUBSURFACE MICROPORE WATER GAIN +C + ELSE + DO 9515 K=0,4 + ROCFLS(K,N,M6,M5,M4)=0.0 + RONFLS(K,N,M6,M5,M4)=0.0 + ROPFLS(K,N,M6,M5,M4)=0.0 + ROAFLS(K,N,M6,M5,M4)=0.0 +9515 CONTINUE + RCOFLS(N,M6,M5,M4)=0.0 + RCHFLS(N,M6,M5,M4)=0.0 + ROXFLS(N,M6,M5,M4)=0.0 + RNGFLS(N,M6,M5,M4)=0.0 + RN2FLS(N,M6,M5,M4)=0.0 + RHGFLS(N,M6,M5,M4)=0.0 + RN4FLW(N,M6,M5,M4)=0.0 + RN3FLW(N,M6,M5,M4)=0.0 + RNOFLW(N,M6,M5,M4)=0.0 + RNXFLS(N,M6,M5,M4)=0.0 + RH1PFS(N,M6,M5,M4)=0.0 + RH2PFS(N,M6,M5,M4)=0.0 + RN4FLB(N,M6,M5,M4)=0.0 + RN3FLB(N,M6,M5,M4)=0.0 + RNOFLB(N,M6,M5,M4)=0.0 + RNXFLB(N,M6,M5,M4)=0.0 + RH2BFB(N,M6,M5,M4)=0.0 + ENDIF +C IF(M.NE.MX.AND.I.GE.180.AND.I.LE.200)THEN +C WRITE(*,1115)'LEACHX',I,J,M1,M2,M3,M,MM,N +C 1,RCOFLS(N,M6,M5,M4),VFLW,CO2S2(M3,M2,M1) +C 2,RH2PFS(N,M6,M5,M4),(ROPFLS(K,N,M6,M5,M4),K=1,4) +C 4,VOLWM(M,M3,M2,M1),FLWM(M,N,M6,M5,M4),VFLW +1115 FORMAT(A8,8I4,20E12.4) +C ENDIF +C +C SOLUTE LOSS WITH SUBSURFACE MACROPORE WATER LOSS +C + IF(NN.EQ.1.AND.FLWHM(M,N,M6,M5,M4).GT.0.0 + 2.OR.NN.EQ.2.AND.FLWHM(M,N,M6,M5,M4).LT.0.0)THEN + IF(VOLWHM(M,M3,M2,M1).GT.ZEROS(M2,M1))THEN + VFLW=AMAX1(-XFRX,AMIN1(XFRX,FLWHM(M,N,M6,M5,M4) + 2/VOLWHM(M,M3,M2,M1))) + ELSE + VFLW=0.0 + ENDIF + DO 9535 K=0,4 + ROCFHS(K,N,M6,M5,M4)=VFLW*AMAX1(0.0,OQCH2(K,M3,M2,M1)) + RONFHS(K,N,M6,M5,M4)=VFLW*AMAX1(0.0,OQNH2(K,M3,M2,M1)) + ROPFHS(K,N,M6,M5,M4)=VFLW*AMAX1(0.0,OQPH2(K,M3,M2,M1)) + ROAFHS(K,N,M6,M5,M4)=VFLW*AMAX1(0.0,OQAH2(K,M3,M2,M1)) +9535 CONTINUE + RCOFHS(N,M6,M5,M4)=VFLW*AMAX1(0.0,CO2SH2(M3,M2,M1)) + RCHFHS(N,M6,M5,M4)=VFLW*AMAX1(0.0,CH4SH2(M3,M2,M1)) + ROXFHS(N,M6,M5,M4)=VFLW*AMAX1(0.0,OXYSH2(M3,M2,M1)) + RNGFHS(N,M6,M5,M4)=VFLW*AMAX1(0.0,Z2GSH2(M3,M2,M1)) + RN2FHS(N,M6,M5,M4)=VFLW*AMAX1(0.0,Z2OSH2(M3,M2,M1)) + RHGFHS(N,M6,M5,M4)=VFLW*AMAX1(0.0,H2GSH2(M3,M2,M1)) + RN4FHW(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZNH4H2(M3,M2,M1)) + 2*VLNH4(M3,M2,M1) + RN3FHW(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZNH3H2(M3,M2,M1)) + 2*VLNH4(M3,M2,M1) + RNOFHW(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZNO3H2(M3,M2,M1)) + 2*VLNO3(M3,M2,M1) + RNXFHS(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZNO2H2(M3,M2,M1)) + 2*VLNO3(M3,M2,M1) + RH1PHS(N,M6,M5,M4)=VFLW*AMAX1(0.0,H1P4H2(M3,M2,M1)) + 2*VLPO4(M3,M2,M1) + RH2PHS(N,M6,M5,M4)=VFLW*AMAX1(0.0,H2P4H2(M3,M2,M1)) + 2*VLPO4(M3,M2,M1) + RN4FHB(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZN4BH2(M3,M2,M1)) + 2*VLNHB(M3,M2,M1) + RN3FHB(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZN3BH2(M3,M2,M1)) + 2*VLNHB(M3,M2,M1) + RNOFHB(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZNOBH2(M3,M2,M1)) + 2*VLNOB(M3,M2,M1) + RNXFHB(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZN2BH2(M3,M2,M1)) + 2*VLNOB(M3,M2,M1) + RH1BHB(N,M6,M5,M4)=VFLW*AMAX1(0.0,H1PBH2(M3,M2,M1)) + 2*VLPOB(M3,M2,M1) + RH2BHB(N,M6,M5,M4)=VFLW*AMAX1(0.0,H2PBH2(M3,M2,M1)) + 2*VLPOB(M3,M2,M1) +C +C NO SOLUTE GAIN IN SUBSURFACE MACROPORES +C + ELSE + DO 9530 K=0,4 + ROCFHS(K,N,M6,M5,M4)=0.0 + RONFHS(K,N,M6,M5,M4)=0.0 + ROPFHS(K,N,M6,M5,M4)=0.0 + ROAFHS(K,N,M6,M5,M4)=0.0 +9530 CONTINUE + RCOFHS(N,M6,M5,M4)=0.0 + RCHFHS(N,M6,M5,M4)=0.0 + ROXFHS(N,M6,M5,M4)=0.0 + RNGFHS(N,M6,M5,M4)=0.0 + RN2FHS(N,M6,M5,M4)=0.0 + RN4FHW(N,M6,M5,M4)=0.0 + RHGFHS(N,M6,M5,M4)=0.0 + RN3FHW(N,M6,M5,M4)=0.0 + RNOFHW(N,M6,M5,M4)=0.0 + RNXFHS(N,M6,M5,M4)=0.0 + RH1PHS(N,M6,M5,M4)=0.0 + RH2PHS(N,M6,M5,M4)=0.0 + RN4FHB(N,M6,M5,M4)=0.0 + RN3FHB(N,M6,M5,M4)=0.0 + RNOFHB(N,M6,M5,M4)=0.0 + RNXFHB(N,M6,M5,M4)=0.0 + RH1BHB(N,M6,M5,M4)=0.0 + RH2BHB(N,M6,M5,M4)=0.0 + ENDIF +C +C ACCUMULATE HOURLY FLUXES +C + DO 9555 K=0,4 + XOCFLS(K,N,M6,M5,M4)=XOCFLS(K,N,M6,M5,M4)+ROCFLS(K,N,M6,M5,M4) + XONFLS(K,N,M6,M5,M4)=XONFLS(K,N,M6,M5,M4)+RONFLS(K,N,M6,M5,M4) + XOPFLS(K,N,M6,M5,M4)=XOPFLS(K,N,M6,M5,M4)+ROPFLS(K,N,M6,M5,M4) + XOAFLS(K,N,M6,M5,M4)=XOAFLS(K,N,M6,M5,M4)+ROAFLS(K,N,M6,M5,M4) + XOCFHS(K,N,M6,M5,M4)=XOCFHS(K,N,M6,M5,M4)+ROCFHS(K,N,M6,M5,M4) + XONFHS(K,N,M6,M5,M4)=XONFHS(K,N,M6,M5,M4)+RONFHS(K,N,M6,M5,M4) + XOPFHS(K,N,M6,M5,M4)=XOPFHS(K,N,M6,M5,M4)+ROPFHS(K,N,M6,M5,M4) + XOAFHS(K,N,M6,M5,M4)=XOAFHS(K,N,M6,M5,M4)+ROAFHS(K,N,M6,M5,M4) +9555 CONTINUE + XCOFLS(N,M6,M5,M4)=XCOFLS(N,M6,M5,M4)+RCOFLS(N,M6,M5,M4) + XCHFLS(N,M6,M5,M4)=XCHFLS(N,M6,M5,M4)+RCHFLS(N,M6,M5,M4) + XOXFLS(N,M6,M5,M4)=XOXFLS(N,M6,M5,M4)+ROXFLS(N,M6,M5,M4) + XNGFLS(N,M6,M5,M4)=XNGFLS(N,M6,M5,M4)+RNGFLS(N,M6,M5,M4) + XN2FLS(N,M6,M5,M4)=XN2FLS(N,M6,M5,M4)+RN2FLS(N,M6,M5,M4) + XHGFLS(N,M6,M5,M4)=XHGFLS(N,M6,M5,M4)+RHGFLS(N,M6,M5,M4) + XN4FLW(N,M6,M5,M4)=XN4FLW(N,M6,M5,M4)+RN4FLW(N,M6,M5,M4) + XN3FLW(N,M6,M5,M4)=XN3FLW(N,M6,M5,M4)+RN3FLW(N,M6,M5,M4) + XNOFLW(N,M6,M5,M4)=XNOFLW(N,M6,M5,M4)+RNOFLW(N,M6,M5,M4) + XNXFLS(N,M6,M5,M4)=XNXFLS(N,M6,M5,M4)+RNXFLS(N,M6,M5,M4) + XH1PFS(N,M6,M5,M4)=XH1PFS(N,M6,M5,M4)+RH1PFS(N,M6,M5,M4) + XH2PFS(N,M6,M5,M4)=XH2PFS(N,M6,M5,M4)+RH2PFS(N,M6,M5,M4) + XN4FLB(N,M6,M5,M4)=XN4FLB(N,M6,M5,M4)+RN4FLB(N,M6,M5,M4) + XN3FLB(N,M6,M5,M4)=XN3FLB(N,M6,M5,M4)+RN3FLB(N,M6,M5,M4) + XNOFLB(N,M6,M5,M4)=XNOFLB(N,M6,M5,M4)+RNOFLB(N,M6,M5,M4) + XNXFLB(N,M6,M5,M4)=XNXFLB(N,M6,M5,M4)+RNXFLB(N,M6,M5,M4) + XH2BFB(N,M6,M5,M4)=XH2BFB(N,M6,M5,M4)+RH2BFB(N,M6,M5,M4) + XCOFHS(N,M6,M5,M4)=XCOFHS(N,M6,M5,M4)+RCOFHS(N,M6,M5,M4) + XCHFHS(N,M6,M5,M4)=XCHFHS(N,M6,M5,M4)+RCHFHS(N,M6,M5,M4) + XOXFHS(N,M6,M5,M4)=XOXFHS(N,M6,M5,M4)+ROXFHS(N,M6,M5,M4) + XNGFHS(N,M6,M5,M4)=XNGFHS(N,M6,M5,M4)+RNGFHS(N,M6,M5,M4) + XN2FHS(N,M6,M5,M4)=XN2FHS(N,M6,M5,M4)+RN2FHS(N,M6,M5,M4) + XHGFHS(N,M6,M5,M4)=XHGFHS(N,M6,M5,M4)+RHGFHS(N,M6,M5,M4) + XN4FHW(N,M6,M5,M4)=XN4FHW(N,M6,M5,M4)+RN4FHW(N,M6,M5,M4) + XN3FHW(N,M6,M5,M4)=XN3FHW(N,M6,M5,M4)+RN3FHW(N,M6,M5,M4) + XNOFHW(N,M6,M5,M4)=XNOFHW(N,M6,M5,M4)+RNOFHW(N,M6,M5,M4) + XNXFHS(N,M6,M5,M4)=XNXFHS(N,M6,M5,M4)+RNXFHS(N,M6,M5,M4) + XH1PHS(N,M6,M5,M4)=XH1PHS(N,M6,M5,M4)+RH1PHS(N,M6,M5,M4) + XH2PHS(N,M6,M5,M4)=XH2PHS(N,M6,M5,M4)+RH2PHS(N,M6,M5,M4) + XN4FHB(N,M6,M5,M4)=XN4FHB(N,M6,M5,M4)+RN4FHB(N,M6,M5,M4) + XN3FHB(N,M6,M5,M4)=XN3FHB(N,M6,M5,M4)+RN3FHB(N,M6,M5,M4) + XNOFHB(N,M6,M5,M4)=XNOFHB(N,M6,M5,M4)+RNOFHB(N,M6,M5,M4) + XNXFHB(N,M6,M5,M4)=XNXFHB(N,M6,M5,M4)+RNXFHB(N,M6,M5,M4) + XH1BHB(N,M6,M5,M4)=XH1BHB(N,M6,M5,M4)+RH1BHB(N,M6,M5,M4) + XH2BHB(N,M6,M5,M4)=XH2BHB(N,M6,M5,M4)+RH2BHB(N,M6,M5,M4) + ENDIF + ENDIF +C +C NO GASOUS GAIN WITH SUBSURFACE MICROPORE WATER LOSS +C + FLGM=(FLWM(M,N,M6,M5,M4)+FLWHM(M,N,M6,M5,M4))*XNPT +C IF(NN.EQ.1.AND.FLGM.GT.0.0 +C 2.OR.NN.EQ.2.AND.FLGM.LT.0.0)THEN +C IF(VOLPM(M,M3,M2,M1).GT.ZEROS(M2,M1))THEN +C VFLW=-AMAX1(-XFRX,AMIN1(XFRX,FLGM +C 2/VOLPM(M,M3,M2,M1))) +C ELSE +C VFLW=0.0 +C ENDIF +C RCOFLG(N,M6,M5,M4)=VFLW*AMAX1(0.0,CO2G2(M3,M2,M1)) +C RCHFLG(N,M6,M5,M4)=VFLW*AMAX1(0.0,CH4G2(M3,M2,M1)) +C ROXFLG(N,M6,M5,M4)=VFLW*AMAX1(0.0,OXYG2(M3,M2,M1)) +C RNGFLG(N,M6,M5,M4)=VFLW*AMAX1(0.0,Z2GG2(M3,M2,M1)) +C RN2FLG(N,M6,M5,M4)=VFLW*AMAX1(0.0,Z2OG2(M3,M2,M1)) +C RN3FLG(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZN3G2(M3,M2,M1)) +C RHGFLG(N,M6,M5,M4)=VFLW*AMAX1(0.0,H2GG2(M3,M2,M1)) +C XCOFLG(N,M6,M5,M4)=XCOFLG(N,M6,M5,M4)+RCOFLG(N,M6,M5,M4) +C XCHFLG(N,M6,M5,M4)=XCHFLG(N,M6,M5,M4)+RCHFLG(N,M6,M5,M4) +C XOXFLG(N,M6,M5,M4)=XOXFLG(N,M6,M5,M4)+ROXFLG(N,M6,M5,M4) +C XNGFLG(N,M6,M5,M4)=XNGFLG(N,M6,M5,M4)+RNGFLG(N,M6,M5,M4) +C XN2FLG(N,M6,M5,M4)=XN2FLG(N,M6,M5,M4)+RN2FLG(N,M6,M5,M4) +C XN3FLG(N,M6,M5,M4)=XN3FLG(N,M6,M5,M4)+RN3FLG(N,M6,M5,M4) +C XHGFLG(N,M6,M5,M4)=XHGFLG(N,M6,M5,M4)+RHGFLG(N,M6,M5,M4) +C IF(FLGM.NE.0.0)THEN +C WRITE(*,8766)'GAS IN',I,J,M,MM,N,NN,M3,M2,M1,M6,M5,M4 +C 2,VFLW,VOLPM(M,M3,M2,M1),ROXFLG(N,M6,M5,M4) +C 3,OXYG2(M3,M2,M1),FLGM,FLWM(M,N,M6,M5,M4) +C 4,FLWHM(M,N,M6,M5,M4) +8766 FORMAT(A8,12I4,20E12.4) +C ENDIF +C +C GASOUS LOSS WITH SUBSURFACE MICROPORE WATER GAIN +C + IF(NN.EQ.1.AND.FLGM.LT.0.0 + 2.OR.NN.EQ.2.AND.FLGM.GT.0.0)THEN + IF(VOLPM(M,M3,M2,M1).GT.ZEROS(M2,M1))THEN + VFLW=-AMAX1(-XFRX,AMIN1(XFRX,FLGM + 2/VOLPM(M,M3,M2,M1))) + ELSE + VFLW=0.0 + ENDIF + RCOFLG(N,M6,M5,M4)=VFLW*AMAX1(0.0,CO2G2(M3,M2,M1)) + RCHFLG(N,M6,M5,M4)=VFLW*AMAX1(0.0,CH4G2(M3,M2,M1)) + ROXFLG(N,M6,M5,M4)=VFLW*AMAX1(0.0,OXYG2(M3,M2,M1)) + RNGFLG(N,M6,M5,M4)=VFLW*AMAX1(0.0,Z2GG2(M3,M2,M1)) + RN2FLG(N,M6,M5,M4)=VFLW*AMAX1(0.0,Z2OG2(M3,M2,M1)) + RN3FLG(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZN3G2(M3,M2,M1)) + RHGFLG(N,M6,M5,M4)=VFLW*AMAX1(0.0,H2GG2(M3,M2,M1)) + XCOFLG(N,M6,M5,M4)=XCOFLG(N,M6,M5,M4)+RCOFLG(N,M6,M5,M4) + XCHFLG(N,M6,M5,M4)=XCHFLG(N,M6,M5,M4)+RCHFLG(N,M6,M5,M4) + XOXFLG(N,M6,M5,M4)=XOXFLG(N,M6,M5,M4)+ROXFLG(N,M6,M5,M4) + XNGFLG(N,M6,M5,M4)=XNGFLG(N,M6,M5,M4)+RNGFLG(N,M6,M5,M4) + XN2FLG(N,M6,M5,M4)=XN2FLG(N,M6,M5,M4)+RN2FLG(N,M6,M5,M4) + XN3FLG(N,M6,M5,M4)=XN3FLG(N,M6,M5,M4)+RN3FLG(N,M6,M5,M4) + XHGFLG(N,M6,M5,M4)=XHGFLG(N,M6,M5,M4)+RHGFLG(N,M6,M5,M4) +C IF(FLGM.NE.0.0)THEN +C WRITE(*,8766)'GAS OUT',I,J,M,MM,N,NN,M3,M2,M1,M6,M5,M4 +C 2,VFLW,VOLPM(M,M3,M2,M1),ROXFLG(N,M6,M5,M4) +C 3,OXYG2(M3,M2,M1),FLGM,FLWM(M,N,M6,M5,M4) +C 4,FLWHM(M,N,M6,M5,M4) +C ENDIF + ELSE + RCOFLG(N,M6,M5,M4)=0.0 + RCHFLG(N,M6,M5,M4)=0.0 + ROXFLG(N,M6,M5,M4)=0.0 + RNGFLG(N,M6,M5,M4)=0.0 + RN2FLG(N,M6,M5,M4)=0.0 + RN3FLG(N,M6,M5,M4)=0.0 + RHGFLG(N,M6,M5,M4)=0.0 + ENDIF +9575 CONTINUE +C +C TOTAL GAS AND SOLUTE FLUXES IN EACH GRID CELL +C + IF(M.NE.MX)THEN + IF(L.EQ.NU(N2,N1).AND.N.NE.3)THEN +C +C TOTAL OVERLAND FLUX +C + DO 9550 K=0,2 + 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) + TQROA(K,N2,N1)=TQROA(K,N2,N1)+RQROA(K,N,N2,N1)-RQROA(K,N,N5,N4) +9550 CONTINUE + TQRCOS(N2,N1)=TQRCOS(N2,N1)+RQRCOS(N,N2,N1)-RQRCOS(N,N5,N4) + TQRCHS(N2,N1)=TQRCHS(N2,N1)+RQRCHS(N,N2,N1)-RQRCHS(N,N5,N4) + TQROXS(N2,N1)=TQROXS(N2,N1)+RQROXS(N,N2,N1)-RQROXS(N,N5,N4) + TQRNGS(N2,N1)=TQRNGS(N2,N1)+RQRNGS(N,N2,N1)-RQRNGS(N,N5,N4) + TQRN2S(N2,N1)=TQRN2S(N2,N1)+RQRN2S(N,N2,N1)-RQRN2S(N,N5,N4) + TQRHGS(N2,N1)=TQRHGS(N2,N1)+RQRHGS(N,N2,N1)-RQRHGS(N,N5,N4) + TQRNH4(N2,N1)=TQRNH4(N2,N1)+RQRNH4(N,N2,N1)-RQRNH4(N,N5,N4) + TQRNH3(N2,N1)=TQRNH3(N2,N1)+RQRNH3(N,N2,N1)-RQRNH3(N,N5,N4) + TQRNO3(N2,N1)=TQRNO3(N2,N1)+RQRNO3(N,N2,N1)-RQRNO3(N,N5,N4) + TQRNO2(N2,N1)=TQRNO2(N2,N1)+RQRNO2(N,N2,N1)-RQRNO2(N,N5,N4) + TQRH1P(N2,N1)=TQRH1P(N2,N1)+RQRH1P(N,N2,N1)-RQRH1P(N,N5,N4) + TQRH2P(N2,N1)=TQRH2P(N2,N1)+RQRH2P(N,N2,N1)-RQRH2P(N,N5,N4) + TQSCOS(N2,N1)=TQSCOS(N2,N1)+RQSCOS(N,N2,N1)-RQSCOS(N,N5,N4) + TQSCHS(N2,N1)=TQSCHS(N2,N1)+RQSCHS(N,N2,N1)-RQSCHS(N,N5,N4) + TQSOXS(N2,N1)=TQSOXS(N2,N1)+RQSOXS(N,N2,N1)-RQSOXS(N,N5,N4) + TQSNGS(N2,N1)=TQSNGS(N2,N1)+RQSNGS(N,N2,N1)-RQSNGS(N,N5,N4) + TQSN2S(N2,N1)=TQSN2S(N2,N1)+RQSN2S(N,N2,N1)-RQSN2S(N,N5,N4) + TQSNH4(N2,N1)=TQSNH4(N2,N1)+RQSNH4(N,N2,N1)-RQSNH4(N,N5,N4) + TQSNH3(N2,N1)=TQSNH3(N2,N1)+RQSNH3(N,N2,N1)-RQSNH3(N,N5,N4) + TQSNO3(N2,N1)=TQSNO3(N2,N1)+RQSNO3(N,N2,N1)-RQSNO3(N,N5,N4) + TQSH1P(N2,N1)=TQSH1P(N2,N1)+RQSH1P(N,N2,N1)-RQSH1P(N,N5,N4) + TQSH2P(N2,N1)=TQSH2P(N2,N1)+RQSH2P(N,N2,N1)-RQSH2P(N,N5,N4) + ENDIF + ENDIF +C +C TOTAL SOLUTE FLUX IN MICROPORES AND MACROPORES +C + IF(M.NE.MX)THEN + IF(NCN(N2,N1).NE.3.OR.N.EQ.3)THEN + DO 9545 K=0,4 + TOCFLS(K,N3,N2,N1)=TOCFLS(K,N3,N2,N1)+ROCFLS(K,N,N3,N2,N1) + 2-ROCFLS(K,N,N6,N5,N4) + TONFLS(K,N3,N2,N1)=TONFLS(K,N3,N2,N1)+RONFLS(K,N,N3,N2,N1) + 2-RONFLS(K,N,N6,N5,N4) + TOPFLS(K,N3,N2,N1)=TOPFLS(K,N3,N2,N1)+ROPFLS(K,N,N3,N2,N1) + 2-ROPFLS(K,N,N6,N5,N4) + TOAFLS(K,N3,N2,N1)=TOAFLS(K,N3,N2,N1)+ROAFLS(K,N,N3,N2,N1) + 2-ROAFLS(K,N,N6,N5,N4) + TOCFHS(K,N3,N2,N1)=TOCFHS(K,N3,N2,N1)+ROCFHS(K,N,N3,N2,N1) + 2-ROCFHS(K,N,N6,N5,N4) + TONFHS(K,N3,N2,N1)=TONFHS(K,N3,N2,N1)+RONFHS(K,N,N3,N2,N1) + 2-RONFHS(K,N,N6,N5,N4) + TOPFHS(K,N3,N2,N1)=TOPFHS(K,N3,N2,N1)+ROPFHS(K,N,N3,N2,N1) + 2-ROPFHS(K,N,N6,N5,N4) + TOAFHS(K,N3,N2,N1)=TOAFHS(K,N3,N2,N1)+ROAFHS(K,N,N3,N2,N1) + 2-ROAFHS(K,N,N6,N5,N4) +9545 CONTINUE + TCOFLS(N3,N2,N1)=TCOFLS(N3,N2,N1)+RCOFLS(N,N3,N2,N1) + 2-RCOFLS(N,N6,N5,N4) + TCHFLS(N3,N2,N1)=TCHFLS(N3,N2,N1)+RCHFLS(N,N3,N2,N1) + 2-RCHFLS(N,N6,N5,N4) + TOXFLS(N3,N2,N1)=TOXFLS(N3,N2,N1)+ROXFLS(N,N3,N2,N1) + 2-ROXFLS(N,N6,N5,N4) + TNGFLS(N3,N2,N1)=TNGFLS(N3,N2,N1)+RNGFLS(N,N3,N2,N1) + 2-RNGFLS(N,N6,N5,N4) + TN2FLS(N3,N2,N1)=TN2FLS(N3,N2,N1)+RN2FLS(N,N3,N2,N1) + 2-RN2FLS(N,N6,N5,N4) + THGFLS(N3,N2,N1)=THGFLS(N3,N2,N1)+RHGFLS(N,N3,N2,N1) + 2-RHGFLS(N,N6,N5,N4) + TN4FLW(N3,N2,N1)=TN4FLW(N3,N2,N1)+RN4FLW(N,N3,N2,N1) + 2-RN4FLW(N,N6,N5,N4) + TN3FLW(N3,N2,N1)=TN3FLW(N3,N2,N1)+RN3FLW(N,N3,N2,N1) + 2-RN3FLW(N,N6,N5,N4) + TNOFLW(N3,N2,N1)=TNOFLW(N3,N2,N1)+RNOFLW(N,N3,N2,N1) + 2-RNOFLW(N,N6,N5,N4) + TNXFLS(N3,N2,N1)=TNXFLS(N3,N2,N1)+RNXFLS(N,N3,N2,N1) + 2-RNXFLS(N,N6,N5,N4) + TH1PFS(N3,N2,N1)=TH1PFS(N3,N2,N1)+RH1PFS(N,N3,N2,N1) + 2-RH1PFS(N,N6,N5,N4) + TH2PFS(N3,N2,N1)=TH2PFS(N3,N2,N1)+RH2PFS(N,N3,N2,N1) + 2-RH2PFS(N,N6,N5,N4) + TN4FLB(N3,N2,N1)=TN4FLB(N3,N2,N1)+RN4FLB(N,N3,N2,N1) + 2-RN4FLB(N,N6,N5,N4) + TN3FLB(N3,N2,N1)=TN3FLB(N3,N2,N1)+RN3FLB(N,N3,N2,N1) + 2-RN3FLB(N,N6,N5,N4) + TNOFLB(N3,N2,N1)=TNOFLB(N3,N2,N1)+RNOFLB(N,N3,N2,N1) + 2-RNOFLB(N,N6,N5,N4) + TNXFLB(N3,N2,N1)=TNXFLB(N3,N2,N1)+RNXFLB(N,N3,N2,N1) + 2-RNXFLB(N,N6,N5,N4) + TH1BFB(N3,N2,N1)=TH1BFB(N3,N2,N1)+RH1BFB(N,N3,N2,N1) + 2-RH1BFB(N,N6,N5,N4) + TH2BFB(N3,N2,N1)=TH2BFB(N3,N2,N1)+RH2BFB(N,N3,N2,N1) + 2-RH2BFB(N,N6,N5,N4) + TCOFHS(N3,N2,N1)=TCOFHS(N3,N2,N1)+RCOFHS(N,N3,N2,N1) + 2-RCOFHS(N,N6,N5,N4) + TCHFHS(N3,N2,N1)=TCHFHS(N3,N2,N1)+RCHFHS(N,N3,N2,N1) + 2-RCHFHS(N,N6,N5,N4) + TOXFHS(N3,N2,N1)=TOXFHS(N3,N2,N1)+ROXFHS(N,N3,N2,N1) + 2-ROXFHS(N,N6,N5,N4) + TNGFHS(N3,N2,N1)=TNGFHS(N3,N2,N1)+RNGFHS(N,N3,N2,N1) + 2-RNGFHS(N,N6,N5,N4) + TN2FHS(N3,N2,N1)=TN2FHS(N3,N2,N1)+RN2FHS(N,N3,N2,N1) + 2-RN2FHS(N,N6,N5,N4) + THGFHS(N3,N2,N1)=THGFHS(N3,N2,N1)+RHGFHS(N,N3,N2,N1) + 2-RHGFHS(N,N6,N5,N4) + TN4FHW(N3,N2,N1)=TN4FHW(N3,N2,N1)+RN4FHW(N,N3,N2,N1) + 2-RN4FHW(N,N6,N5,N4) + TN3FHW(N3,N2,N1)=TN3FHW(N3,N2,N1)+RN3FHW(N,N3,N2,N1) + 2-RN3FHW(N,N6,N5,N4) + TNOFHW(N3,N2,N1)=TNOFHW(N3,N2,N1)+RNOFHW(N,N3,N2,N1) + 2-RNOFHW(N,N6,N5,N4) + TNXFHS(N3,N2,N1)=TNXFHS(N3,N2,N1)+RNXFHS(N,N3,N2,N1) + 2-RNXFHS(N,N6,N5,N4) + TH1PHS(N3,N2,N1)=TH1PHS(N3,N2,N1)+RH1PHS(N,N3,N2,N1) + 2-RH1PHS(N,N6,N5,N4) + TH2PHS(N3,N2,N1)=TH2PHS(N3,N2,N1)+RH2PHS(N,N3,N2,N1) + 2-RH2PHS(N,N6,N5,N4) + TN4FHB(N3,N2,N1)=TN4FHB(N3,N2,N1)+RN4FHB(N,N3,N2,N1) + 2-RN4FHB(N,N6,N5,N4) + TN3FHB(N3,N2,N1)=TN3FHB(N3,N2,N1)+RN3FHB(N,N3,N2,N1) + 2-RN3FHB(N,N6,N5,N4) + TNOFHB(N3,N2,N1)=TNOFHB(N3,N2,N1)+RNOFHB(N,N3,N2,N1) + 2-RNOFHB(N,N6,N5,N4) + TNXFHB(N3,N2,N1)=TNXFHB(N3,N2,N1)+RNXFHB(N,N3,N2,N1) + 2-RNXFHB(N,N6,N5,N4) + TH1BHB(N3,N2,N1)=TH1BHB(N3,N2,N1)+RH1BHB(N,N3,N2,N1) + 2-RH1BHB(N,N6,N5,N4) + TH2BHB(N3,N2,N1)=TH2BHB(N3,N2,N1)+RH2BHB(N,N3,N2,N1) + 2-RH2BHB(N,N6,N5,N4) + ENDIF + ENDIF +C +C TOTAL GAS FLUX +C +C IF(NCN(N2,N1).NE.3.OR.N.EQ.3)THEN + TCOFLG(N3,N2,N1)=TCOFLG(N3,N2,N1)+RCOFLG(N,N3,N2,N1) + 2-RCOFLG(N,N6,N5,N4) + TCHFLG(N3,N2,N1)=TCHFLG(N3,N2,N1)+RCHFLG(N,N3,N2,N1) + 2-RCHFLG(N,N6,N5,N4) + TOXFLG(N3,N2,N1)=TOXFLG(N3,N2,N1)+ROXFLG(N,N3,N2,N1) + 2-ROXFLG(N,N6,N5,N4) + TNGFLG(N3,N2,N1)=TNGFLG(N3,N2,N1)+RNGFLG(N,N3,N2,N1) + 2-RNGFLG(N,N6,N5,N4) + TN2FLG(N3,N2,N1)=TN2FLG(N3,N2,N1)+RN2FLG(N,N3,N2,N1) + 2-RN2FLG(N,N6,N5,N4) + TN3FLG(N3,N2,N1)=TN3FLG(N3,N2,N1)+RN3FLG(N,N3,N2,N1) + 2-RN3FLG(N,N6,N5,N4) + THGFLG(N3,N2,N1)=THGFLG(N3,N2,N1)+RHGFLG(N,N3,N2,N1) + 2-RHGFLG(N,N6,N5,N4) +C ENDIF +9580 CONTINUE +9585 CONTINUE +9590 CONTINUE +9595 CONTINUE +C +C UPDATE STATE VARIABLES FROM TOTAL FLUXES CALCULATED ABOVE +C + IF(MM.NE.NPG)THEN + DO 9695 NX=NHW,NHE + DO 9690 NY=NVN,NVS + IF(M.NE.MX)THEN +C +C STATE VARIABLES FOR SOLUTES IN MICROPORES AND MACROPORES IN +C SOIL SURFACE LAYER FROM OVERLAND FLOW AND SURFACE VOLATILIZATION- +C DISSOLUTION +C + DO 9681 K=0,2 + 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) + OQA2(K,0,NY,NX)=OQA2(K,0,NY,NX)+ROAFLS(K,3,0,NY,NX) +9681 CONTINUE + CO2S2(0,NY,NX)=CO2S2(0,NY,NX)+RCODFR(NY,NX)+RCOFLS(3,0,NY,NX) + CH4S2(0,NY,NX)=CH4S2(0,NY,NX)+RCHDFR(NY,NX)+RCHFLS(3,0,NY,NX) + OXYS2(0,NY,NX)=OXYS2(0,NY,NX)+ROXDFR(NY,NX)+ROXFLS(3,0,NY,NX) + Z2GS2(0,NY,NX)=Z2GS2(0,NY,NX)+RNGDFR(NY,NX)+RNGFLS(3,0,NY,NX) + Z2OS2(0,NY,NX)=Z2OS2(0,NY,NX)+RN2DFR(NY,NX)+RN2FLS(3,0,NY,NX) + H2GS2(0,NY,NX)=H2GS2(0,NY,NX)+RHGDFR(NY,NX)+RHGFLS(3,0,NY,NX) + ZNH4S2(0,NY,NX)=ZNH4S2(0,NY,NX)+RN4FLW(3,0,NY,NX) + ZN3S2(0,NY,NX)=ZN3S2(0,NY,NX)+RN3DFR(NY,NX)+RN3FLW(3,0,NY,NX) + ZNO3S2(0,NY,NX)=ZNO3S2(0,NY,NX)+RNOFLW(3,0,NY,NX) + ZNO2S2(0,NY,NX)=ZNO2S2(0,NY,NX)+RNXFLS(3,0,NY,NX) + H1PO42(0,NY,NX)=H1PO42(0,NY,NX)+RH1PFS(3,0,NY,NX) + H2PO42(0,NY,NX)=H2PO42(0,NY,NX)+RH2PFS(3,0,NY,NX) + CO2S2(NU(NY,NX),NY,NX)=CO2S2(NU(NY,NX),NY,NX)+RCODFS(NY,NX) + CH4S2(NU(NY,NX),NY,NX)=CH4S2(NU(NY,NX),NY,NX)+RCHDFS(NY,NX) + OXYS2(NU(NY,NX),NY,NX)=OXYS2(NU(NY,NX),NY,NX)+ROXDFS(NY,NX) + Z2GS2(NU(NY,NX),NY,NX)=Z2GS2(NU(NY,NX),NY,NX)+RNGDFS(NY,NX) + Z2OS2(NU(NY,NX),NY,NX)=Z2OS2(NU(NY,NX),NY,NX)+RN2DFS(NY,NX) + 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 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 + 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) + OQA2(K,0,NY,NX)=OQA2(K,0,NY,NX)+TQROA(K,NY,NX) +9680 CONTINUE + CO2S2(0,NY,NX)=CO2S2(0,NY,NX)+TQRCOS(NY,NX) + CH4S2(0,NY,NX)=CH4S2(0,NY,NX)+TQRCHS(NY,NX) + OXYS2(0,NY,NX)=OXYS2(0,NY,NX)+TQROXS(NY,NX) + Z2GS2(0,NY,NX)=Z2GS2(0,NY,NX)+TQRNGS(NY,NX) + Z2OS2(0,NY,NX)=Z2OS2(0,NY,NX)+TQRN2S(NY,NX) + H2GS2(0,NY,NX)=H2GS2(0,NY,NX)+TQRHGS(NY,NX) + ZNH4S2(0,NY,NX)=ZNH4S2(0,NY,NX)+TQRNH4(NY,NX) + ZN3S2(0,NY,NX)=ZN3S2(0,NY,NX)+TQRNH3(NY,NX) + ZNO3S2(0,NY,NX)=ZNO3S2(0,NY,NX)+TQRNO3(NY,NX) + 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 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) +C WRITE(*,8787)'OXYS20',I,J,NX,NY,M,MM,OXYS2(0,NY,NX) +C 2,ROXDFR(NY,NX),ROXFLS(3,0,NY,NX),ROXSK2(0,NY,NX) +C 3,TQROXS(NY,NX),ROXDFG(0,NY,NX),XOXFLS(3,0,NY,NX) +8787 FORMAT(A8,6I4,12E12.4) +C ENDIF + CO2W2(NY,NX)=CO2W2(NY,NX)+TQSCOS(NY,NX) + CH4W2(NY,NX)=CH4W2(NY,NX)+TQSCHS(NY,NX) + OXYW2(NY,NX)=OXYW2(NY,NX)+TQSOXS(NY,NX) + ZNGW2(NY,NX)=ZNGW2(NY,NX)+TQSNGS(NY,NX) + ZN2W2(NY,NX)=ZN2W2(NY,NX)+TQSN2S(NY,NX) + ZN4W2(NY,NX)=ZN4W2(NY,NX)+TQSNH4(NY,NX) + ZN3W2(NY,NX)=ZN3W2(NY,NX)+TQSNH3(NY,NX) + ZNOW2(NY,NX)=ZNOW2(NY,NX)+TQSNO3(NY,NX) + Z1PW2(NY,NX)=Z1PW2(NY,NX)+TQSH1P(NY,NX) + ZHPW2(NY,NX)=ZHPW2(NY,NX)+TQSH2P(NY,NX) +C IF(I.EQ.118.AND.NX.EQ.3.AND.NY.EQ.4)THEN +C WRITE(*,6868)'OXYW2',I,J,NX,NY,M,MM,OXYW2(NY,NX) +C 2,TQSOXS(NY,NX),XOXBLS(NY,NX) +6868 FORMAT(A8,6I4,12E12.4) +C ENDIF + ENDIF +C +C STATE VARIABLES FOR GASES AND FOR SOLUTES IN MICROPORES AND +C MACROPORES IN SOIL LAYERS FROM SUBSURFACE FLOW, MICROBIAL +C AND ROOT EXCHANGE IN 'NITRO' AND 'UPTAKE', AND EQUILIBRIUM +C REACTIONS IN 'SOLUTE' +C + DO 9685 L=NU(NY,NX),NL(NY,NX) + IF(M.NE.MX)THEN + CO2S2(L,NY,NX)=CO2S2(L,NY,NX)+TCOFLS(L,NY,NX)+RCOFXS(L,NY,NX) + 2+RCOFLZ(L,NY,NX)+RCOBBL(L,NY,NX) + CH4S2(L,NY,NX)=CH4S2(L,NY,NX)+TCHFLS(L,NY,NX)+RCHFXS(L,NY,NX) + 2+RCHFLZ(L,NY,NX)+RCHBBL(L,NY,NX) + OXYS2(L,NY,NX)=OXYS2(L,NY,NX)+TOXFLS(L,NY,NX)+ROXFXS(L,NY,NX) + 2+ROXFLZ(L,NY,NX)+ROXBBL(L,NY,NX) + Z2GS2(L,NY,NX)=Z2GS2(L,NY,NX)+TNGFLS(L,NY,NX)+RNGFXS(L,NY,NX) + 2+RNGFLZ(L,NY,NX)+RNGBBL(L,NY,NX) + Z2OS2(L,NY,NX)=Z2OS2(L,NY,NX)+TN2FLS(L,NY,NX)+RN2FXS(L,NY,NX) + 2+RN2FLZ(L,NY,NX)+RN2BBL(L,NY,NX) + ZN3S2(L,NY,NX)=ZN3S2(L,NY,NX)+TN3FLW(L,NY,NX)+RN3FXW(L,NY,NX) + 2+RN3FLZ(L,NY,NX)+RN3BBL(L,NY,NX) + ZNBS2(L,NY,NX)=ZNBS2(L,NY,NX)+TN3FLB(L,NY,NX)+RN3FXB(L,NY,NX) + 2+RN3FBZ(L,NY,NX)+RNBBBL(L,NY,NX) + H2GS2(L,NY,NX)=H2GS2(L,NY,NX)+THGFLS(L,NY,NX)+RHGFXS(L,NY,NX) + 2+RHGFLZ(L,NY,NX)+RHGBBL(L,NY,NX) + DO 9675 K=0,4 + OQC2(K,L,NY,NX)=OQC2(K,L,NY,NX)+TOCFLS(K,L,NY,NX) + 2+ROCFXS(K,L,NY,NX) + OQN2(K,L,NY,NX)=OQN2(K,L,NY,NX)+TONFLS(K,L,NY,NX) + 2+RONFXS(K,L,NY,NX) + OQP2(K,L,NY,NX)=OQP2(K,L,NY,NX)+TOPFLS(K,L,NY,NX) + 2+ROPFXS(K,L,NY,NX) + OQA2(K,L,NY,NX)=OQA2(K,L,NY,NX)+TOAFLS(K,L,NY,NX) + 2+ROAFXS(K,L,NY,NX) + OQCH2(K,L,NY,NX)=OQCH2(K,L,NY,NX)+TOCFHS(K,L,NY,NX) + 2-ROCFXS(K,L,NY,NX) + OQNH2(K,L,NY,NX)=OQNH2(K,L,NY,NX)+TONFHS(K,L,NY,NX) + 2-RONFXS(K,L,NY,NX) + OQPH2(K,L,NY,NX)=OQPH2(K,L,NY,NX)+TOPFHS(K,L,NY,NX) + 2-ROPFXS(K,L,NY,NX) + OQAH2(K,L,NY,NX)=OQAH2(K,L,NY,NX)+TOAFHS(K,L,NY,NX) + 2-ROAFXS(K,L,NY,NX) +9675 CONTINUE + ZNH4S2(L,NY,NX)=ZNH4S2(L,NY,NX)+TN4FLW(L,NY,NX)+RN4FXW(L,NY,NX) + 2+RN4FLZ(L,NY,NX) + ZNO3S2(L,NY,NX)=ZNO3S2(L,NY,NX)+TNOFLW(L,NY,NX)+RNOFXW(L,NY,NX) + 2+RNOFLZ(L,NY,NX) + ZNO2S2(L,NY,NX)=ZNO2S2(L,NY,NX)+TNXFLS(L,NY,NX)+RNXFXS(L,NY,NX) + H1PO42(L,NY,NX)=H1PO42(L,NY,NX)+TH1PFS(L,NY,NX)+RH1PXS(L,NY,NX) + 2+RH1PFZ(L,NY,NX) + H2PO42(L,NY,NX)=H2PO42(L,NY,NX)+TH2PFS(L,NY,NX)+RH2PXS(L,NY,NX) + 2+RH2PFZ(L,NY,NX) + ZNH4B2(L,NY,NX)=ZNH4B2(L,NY,NX)+TN4FLB(L,NY,NX)+RN4FXB(L,NY,NX) + 2+RN4FBZ(L,NY,NX) + ZNO3B2(L,NY,NX)=ZNO3B2(L,NY,NX)+TNOFLB(L,NY,NX)+RNOFXB(L,NY,NX) + 2+RNOFBZ(L,NY,NX) + ZNO2B2(L,NY,NX)=ZNO2B2(L,NY,NX)+TNXFLB(L,NY,NX)+RNXFXB(L,NY,NX) + H1POB2(L,NY,NX)=H1POB2(L,NY,NX)+TH1BFB(L,NY,NX)+RH1BXB(L,NY,NX) + 2+RH1BBZ(L,NY,NX) + H2POB2(L,NY,NX)=H2POB2(L,NY,NX)+TH2BFB(L,NY,NX)+RH2BXB(L,NY,NX) + 2+RH2BBZ(L,NY,NX) + CO2SH2(L,NY,NX)=CO2SH2(L,NY,NX)+TCOFHS(L,NY,NX)-RCOFXS(L,NY,NX) + CH4SH2(L,NY,NX)=CH4SH2(L,NY,NX)+TCHFHS(L,NY,NX)-RCHFXS(L,NY,NX) + OXYSH2(L,NY,NX)=OXYSH2(L,NY,NX)+TOXFHS(L,NY,NX)-ROXFXS(L,NY,NX) + Z2GSH2(L,NY,NX)=Z2GSH2(L,NY,NX)+TNGFHS(L,NY,NX)-RNGFXS(L,NY,NX) + Z2OSH2(L,NY,NX)=Z2OSH2(L,NY,NX)+TN2FHS(L,NY,NX)-RN2FXS(L,NY,NX) + H2GSH2(L,NY,NX)=H2GSH2(L,NY,NX)+THGFHS(L,NY,NX)-RHGFXS(L,NY,NX) + ZNH4H2(L,NY,NX)=ZNH4H2(L,NY,NX)+TN4FHW(L,NY,NX)-RN4FXW(L,NY,NX) + ZNH3H2(L,NY,NX)=ZNH3H2(L,NY,NX)+TN3FHW(L,NY,NX)-RN3FXW(L,NY,NX) + ZNO3H2(L,NY,NX)=ZNO3H2(L,NY,NX)+TNOFHW(L,NY,NX)-RNOFXW(L,NY,NX) + ZNO2H2(L,NY,NX)=ZNO2H2(L,NY,NX)+TNXFHS(L,NY,NX)-RNXFXS(L,NY,NX) + H1P4H2(L,NY,NX)=H1P4H2(L,NY,NX)+TH1PHS(L,NY,NX)-RH1PXS(L,NY,NX) + H2P4H2(L,NY,NX)=H2P4H2(L,NY,NX)+TH2PHS(L,NY,NX)-RH2PXS(L,NY,NX) + ZN4BH2(L,NY,NX)=ZN4BH2(L,NY,NX)+TN4FHB(L,NY,NX)-RN4FXB(L,NY,NX) + ZN3BH2(L,NY,NX)=ZN3BH2(L,NY,NX)+TN3FHB(L,NY,NX)-RN3FXB(L,NY,NX) + ZNOBH2(L,NY,NX)=ZNOBH2(L,NY,NX)+TNOFHB(L,NY,NX)-RNOFXB(L,NY,NX) + ZN2BH2(L,NY,NX)=ZN2BH2(L,NY,NX)+TNXFHB(L,NY,NX)-RNXFXB(L,NY,NX) + H1PBH2(L,NY,NX)=H1PBH2(L,NY,NX)+TH1BHB(L,NY,NX)-RH1BXB(L,NY,NX) + H2PBH2(L,NY,NX)=H2PBH2(L,NY,NX)+TH2BHB(L,NY,NX)-RH2BXB(L,NY,NX) + ENDIF + CO2S2(L,NY,NX)=CO2S2(L,NY,NX)+RCODFG(L,NY,NX) + CH4S2(L,NY,NX)=CH4S2(L,NY,NX)+RCHDFG(L,NY,NX) + OXYS2(L,NY,NX)=OXYS2(L,NY,NX)+ROXDFG(L,NY,NX) + Z2GS2(L,NY,NX)=Z2GS2(L,NY,NX)+RNGDFG(L,NY,NX) + Z2OS2(L,NY,NX)=Z2OS2(L,NY,NX)+RN2DFG(L,NY,NX) + ZN3S2(L,NY,NX)=ZN3S2(L,NY,NX)+RN3DFG(L,NY,NX) + ZNBS2(L,NY,NX)=ZNBS2(L,NY,NX)+RNBDFG(L,NY,NX) + H2GS2(L,NY,NX)=H2GS2(L,NY,NX)+RHGDFG(L,NY,NX) + CO2G2(L,NY,NX)=CO2G2(L,NY,NX)+TCOFLG(L,NY,NX)-RCODFG(L,NY,NX) + CH4G2(L,NY,NX)=CH4G2(L,NY,NX)+TCHFLG(L,NY,NX)-RCHDFG(L,NY,NX) + OXYG2(L,NY,NX)=OXYG2(L,NY,NX)+TOXFLG(L,NY,NX)-ROXDFG(L,NY,NX) + Z2GG2(L,NY,NX)=Z2GG2(L,NY,NX)+TNGFLG(L,NY,NX)-RNGDFG(L,NY,NX) + Z2OG2(L,NY,NX)=Z2OG2(L,NY,NX)+TN2FLG(L,NY,NX)-RN2DFG(L,NY,NX) + 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 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) +C 3,RCODFS(NY,NX),PARG(NY,NX),CCO2E(NY,NX),CCO2SQ +C 4,CO2S2(L,NY,NX)/VOLWM(M,L,NY,NX) +C WRITE(*,444)'OXYS2',I,J,M,MX,NX,NY,L +C 2,OXYS2(L,NY,NX),TOXFLS(L,NY,NX),ROXFXS(L,NY,NX) +C 3,ROXFLZ(L,NY,NX),ROXBBL(L,NY,NX),ROXDFG(L,NY,NX) +C 4,ROXSK(M,L,NY,NX),OXYG2(L,NY,NX),ROXFLS(3,L,NY,NX) +C 5,ROXFLS(3,L+1,NY,NX),ROXDFS(NY,NX),ROXSK2(L,NY,NX) +C 6,ROXSK(M,L,NY,NX),VOLWM(M,L,NY,NX) +C WRITE(*,444)'OXYSH2',I,J,M,MX,NX,NY,L +C 2,OXYSH2(L,NY,NX),TOXFHS(L,NY,NX),ROXFXS(L,NY,NX) +C WRITE(*,444)'CH4S2',I,J,NX,NY,L,M,MM,CH4S2(L,NY,NX) +C 2,TCHFLS(L,NY,NX),RCHFXS(L,NY,NX),RCHFLZ(L,NY,NX) +C 3,RCHBBL(L,NY,NX),RCHDFG(L,NY,NX),RCHSK2(L,NY,NX) +C 4,RCHFLS(3,L,NY,NX),RCHFLS(3,L+1,NY,NX) +C 5,RCHDFR(NY,NX),RCHFLS(3,L,NY,NX),RCHSK2(L,NY,NX) +C 3,TQRCHS(NY,NX),RCHDFG(L,NY,NX),XCHFLS(3,L,NY,NX) +C 6,CH4G2(L,NY,NX),TCHFLG(L,NY,NX) +C WRITE(*,444)'Z2GS2',I,J,M,MX,NX,NY,L +C 2,Z2GS2(L,NY,NX),RNGDFG(L,NY,NX),RNGSK2(L,NY,NX) +C 3,RNGDFS(NY,NX),RNGFLS(3,0,NY,NX),TQRNGS(NY,NX) +C 4,TNGFLS(L,NY,NX),RNGFXS(L,NY,NX),RNGFLZ(L,NY,NX) +C 2,RNGBBL(L,NY,NX),Z2GG2(L,NY,NX),TNGFLG(L,NY,NX) +C WRITE(*,444)'ZN3G2',I,J,M,MM,NX,NY,L,ZN3G2(L,NY,NX) +C 2,TN3FLG(L,NY,NX),RN3DFG(L,NY,NX),RNBDFG(L,NY,NX) +C 3,ZN3S2(L,NY,NX),ZNBS2(L,NY,NX) +C 3,ZNH4S2(L,NY,NX),ZNH4B2(L,NY,NX),RNHSK2(L,NY,NX) +C WRITE(*,444)'OXYG2',I,J,M,MM,NX,NY,L,OXYG2(L,NY,NX) +C 2,TOXFLG(L,NY,NX),ROXDFG(L,NY,NX),OXYS2(L,NY,NX) +C 3,ROXFLG(3,L,NY,NX),ROXFLG(3,L+1,NY,NX),DOXYG(3,L,NY,NX) +C 4,THETPM(M,L,NY,NX),PARGOX(NY,NX) +C 6,XOXFLG(3,L,NY,NX),XOXFLG(3,L+1,NY,NX) +C 7,COXYE(NY,NX),FLQM(N,L,NY,NX) +C WRITE(*,444)'N2OG2',I,J,M,MM,NX,NY,L,Z2OG2(L,NY,NX) +C 2,Z2OS2(L,NY,NX),Z2OSH2(L,NY,NX),TN2FLG(L,NY,NX),RN2DFG(L,NY,NX) +C 3,TN2FLS(L,NY,NX),RN2FXS(L,NY,NX),RN2FLZ(L,NY,NX),RN2BBL(L,NY,NX) +C 2,TN2FHS(L,NY,NX),RN2SK2(L,NY,NX),RN2O(L,NY,NX),TUPN2S(L,NY,NX) +C WRITE(*,444)'H2GS2',I,J,NX,NY,M,MM,L,H2GS2(L,NY,NX) +C 2,THGFLS(L,NY,NX),RHGFXS(L,NY,NX),RHGFLZ(L,NY,NX),RHGBBL(L,NY,NX) +C 3,H2GSH2(L,NY,NX),THGFHS(L,NY,NX),RHGDFG(L,NY,NX),RHGSK2(L,NY,NX) +C 4,RH2GO(L,NY,NX),TUPHGS(L,NY,NX) +C WRITE(*,444)'H1PO42',I,J,M,MM,NX,NY,L,H1PO42(L,NY,NX) +C 2,TH1PFS(L,NY,NX),RH1PXS(L,NY,NX),RH1PFZ(L,NY,NX) +C 3,H2PO42(L,NY,NX),TH2PFS(L,NY,NX),RH2PXS(L,NY,NX) +C 2,RH2PFZ(L,NY,NX),RH1PFS(3,L,NY,NX),RH1PFS(3,L+1,NY,NX) +C 2,H1POB2(L,NY,NX),H1PBH2(L,NY,NX),XH1BXB(L,NY,NX) +444 FORMAT(A8,7I4,20E16.6) +C ENDIF +9685 CONTINUE + CO2S2(0,NY,NX)=CO2S2(0,NY,NX)+RCODFG(0,NY,NX) + CH4S2(0,NY,NX)=CH4S2(0,NY,NX)+RCHDFG(0,NY,NX) + OXYS2(0,NY,NX)=OXYS2(0,NY,NX)+ROXDFG(0,NY,NX) + Z2GS2(0,NY,NX)=Z2GS2(0,NY,NX)+RNGDFG(0,NY,NX) + Z2OS2(0,NY,NX)=Z2OS2(0,NY,NX)+RN2DFG(0,NY,NX) + ZN3S2(0,NY,NX)=ZN3S2(0,NY,NX)+RN3DFG(0,NY,NX) + H2GS2(0,NY,NX)=H2GS2(0,NY,NX)+RHGDFG(0,NY,NX) +C IF(J.EQ.12)THEN +C WRITE(*,1119)'OXYS20',I,J,M,MX,NX,NY,OXYS2(0,NY,NX) +C 2,ROXDFG(0,NY,NX),ROXDFR(NY,NX),ROXFLS(3,0,NY,NX) +C 3,TQROXS(NY,NX),ROXSK2(0,NY,NX),OXYS2(0,NY,NX)/VOLWM(M,0,NY,NX) +C 4,VOLWM(M,0,NY,NX)/VOLA(0,NY,NX),VOLPM(M,0,NY,NX)/VOLA(0,NY,NX) +C 5,VOLWM(M,0,NY,NX),VOLA(0,NY,NX),VOLWG(NY,NX),DFGS(M,0,NY,NX) +C 6,VOLPM(M,NU(NY,NX),NY,NX),VOLWM(M,NU(NY,NX),NY,NX) +C 7,VOLWHM(M,NU(NY,NX),NY,NX) +C WRITE(*,1119)'CH4S2G',I,J,NX,NY,M,MM,CH4S2(0,NY,NX) +C 2,RCHDFG(0,NY,NX) +1119 FORMAT(A8,6I4,20E12.4) +C ENDIF +9690 CONTINUE +9695 CONTINUE + ENDIF + MX=M +30 CONTINUE + RETURN + END + + + diff --git a/f77src/trnsfrs.f b/f77src/trnsfrs.f index e66a88e..c1927c4 100755 --- a/f77src/trnsfrs.f +++ b/f77src/trnsfrs.f @@ -43,10 +43,10 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) 9,ZCAH2(0:JZ,JY,JX),ZCAS2(0:JZ,JY,JX),ZMGO2(0:JZ,JY,JX) 1,ZMGC2(0:JZ,JY,JX),ZMGH2(0:JZ,JY,JX),ZMGS2(0:JZ,JY,JX) 2,ZNAC2(0:JZ,JY,JX),ZNAS2(0:JZ,JY,JX),ZKAS2(0:JZ,JY,JX) - 3,H0PO42(0:JZ,JY,JX),H1PO42(0:JZ,JY,JX),H3PO42(0:JZ,JY,JX) + 3,H0PO42(0:JZ,JY,JX),H3PO42(0:JZ,JY,JX) 4,ZFE1P2(0:JZ,JY,JX),ZFE2P2(0:JZ,JY,JX),ZCA0P2(0:JZ,JY,JX) 5,ZCA1P2(0:JZ,JY,JX),ZCA2P2(0:JZ,JY,JX),ZMG1P2(0:JZ,JY,JX) - 6,H0POB2(JZ,JY,JX),H1POB2(JZ,JY,JX),H3POB2(JZ,JY,JX) + 6,H0POB2(JZ,JY,JX),H3POB2(JZ,JY,JX) 7,ZF1PB2(JZ,JY,JX),ZF2PB2(JZ,JY,JX),ZC0PB2(JZ,JY,JX) 8,ZC1PB2(JZ,JY,JX),ZC2PB2(JZ,JY,JX),ZM1PB2(JZ,JY,JX) DIMENSION ZALW2(JY,JX),ZFEW2(JY,JX),ZHYW2(JY,JX),ZCAW2(JY,JX) @@ -57,7 +57,7 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) 6,ZFEH4W2(JY,JX),ZFESW2(JY,JX),ZCAOW2(JY,JX),ZCACW2(JY,JX) 7,ZCAHW2(JY,JX),ZCASW2(JY,JX),ZMGOW2(JY,JX),ZMGCW2(JY,JX) 8,ZMGHW2(JY,JX),ZMGSW2(JY,JX),ZNACW2(JY,JX),ZNASW2(JY,JX) - 9,ZKASW2(JY,JX),H0PO4W2(JY,JX),H1PO4W2(JY,JX),H3PO4W2(JY,JX) + 9,ZKASW2(JY,JX),H0PO4W2(JY,JX),H3PO4W2(JY,JX) 1,ZFE1PW2(JY,JX),ZFE2PW2(JY,JX),ZCA0PW2(JY,JX),ZCA1PW2(JY,JX) 2,ZCA2PW2(JY,JX),ZMG1PW2(JY,JX) DIMENSION ZALH2(JZ,JY,JX),ZFEH2(JZ,JY,JX),ZHYH2(JZ,JY,JX) @@ -71,10 +71,10 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) 9,ZCAHH2(JZ,JY,JX),ZCASH2(JZ,JY,JX),ZMGOH2(JZ,JY,JX) 1,ZMGCH2(JZ,JY,JX),ZMGHH2(JZ,JY,JX),ZMGSH2(JZ,JY,JX) 2,ZNACH2(JZ,JY,JX),ZNASH2(JZ,JY,JX),ZKASH2(JZ,JY,JX) - 3,H0P4H2(JZ,JY,JX),H1P4H2(JZ,JY,JX),H3P4H2(JZ,JY,JX) + 3,H0P4H2(JZ,JY,JX),H3P4H2(JZ,JY,JX) 4,ZF1PH2(JZ,JY,JX),ZF2PH2(JZ,JY,JX),ZC0PH2(JZ,JY,JX) 5,ZC1PH2(JZ,JY,JX),ZC2PH2(JZ,JY,JX),ZM1PH2(JZ,JY,JX) - 6,H0PBH2(JZ,JY,JX),H1PBH2(JZ,JY,JX),H3PBH2(JZ,JY,JX) + 6,H0PBH2(JZ,JY,JX),H3PBH2(JZ,JY,JX) 7,ZF1BH2(JZ,JY,JX),ZF2BH2(JZ,JY,JX),ZC0BH2(JZ,JY,JX) 8,ZC1BH2(JZ,JY,JX),ZC2BH2(JZ,JY,JX),ZM1BH2(JZ,JY,JX) DIMENSION ALSGL2(JZ,JY,JX),FESGL2(JZ,JY,JX),HYSGL2(JZ,JY,JX) @@ -90,9 +90,9 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) 2,RQRFES(2,JV,JH),RQRCAO(2,JV,JH),RQRCAC(2,JV,JH) 3,RQRCAH(2,JV,JH),RQRCAS(2,JV,JH),RQRMGO(2,JV,JH),RQRMGC(2,JV,JH) 4,RQRMGH(2,JV,JH),RQRMGS(2,JV,JH),RQRNAC(2,JV,JH),RQRNAS(2,JV,JH) - 5,RQRKAS(2,JV,JH),RQRH0P(2,JV,JH),RQRH1P(2,JV,JH),RQRH3P(2,JV,JH) + 5,RQRKAS(2,JV,JH),RQRH0P(2,JV,JH),RQRH3P(2,JV,JH) 6,RQRF1P(2,JV,JH),RQRF2P(2,JV,JH),RQRC0P(2,JV,JH),RQRC1P(2,JV,JH) - 7,RQRC2P(2,JV,JH),RQRM1P(2,JV,JH),RQRH0B(2,JV,JH),RQRH1B(2,JV,JH) + 7,RQRC2P(2,JV,JH),RQRM1P(2,JV,JH),RQRH0B(2,JV,JH) 8,RQRH3B(2,JV,JH),RQRF1B(2,JV,JH),RQRF2B(2,JV,JH),RQRC0B(2,JV,JH) 9,RQRC1B(2,JV,JH),RQRC2B(2,JV,JH),RQRM1B(2,JV,JH) 5,RQSAL(2,JV,JH),RQSFE(2,JV,JH),RQSHY(2,JV,JH),RQSCA(2,JV,JH) @@ -104,7 +104,7 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) 2,RQSFES(2,JV,JH),RQSCAO(2,JV,JH),RQSCAC(2,JV,JH) 3,RQSCAH(2,JV,JH),RQSCAS(2,JV,JH),RQSMGO(2,JV,JH),RQSMGC(2,JV,JH) 4,RQSMGH(2,JV,JH),RQSMGS(2,JV,JH),RQSNAC(2,JV,JH),RQSNAS(2,JV,JH) - 5,RQSKAS(2,JV,JH),RQSH0P(2,JV,JH),RQSH1P(2,JV,JH),RQSH3P(2,JV,JH) + 5,RQSKAS(2,JV,JH),RQSH0P(2,JV,JH),RQSH3P(2,JV,JH) 6,RQSF1P(2,JV,JH),RQSF2P(2,JV,JH),RQSC0P(2,JV,JH),RQSC1P(2,JV,JH) 7,RQSC2P(2,JV,JH),RQSM1P(2,JV,JH) DIMENSION RALFLS(3,0:JD,JV,JH),RFEFLS(3,0:JD,JV,JH) @@ -119,10 +119,10 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) 1,RCASFS(3,0:JD,JV,JH),RMGOFS(3,0:JD,JV,JH),RMGCFS(3,0:JD,JV,JH) 2,RMGHFS(3,0:JD,JV,JH),RMGSFS(3,0:JD,JV,JH),RNACFS(3,0:JD,JV,JH) 3,RNASFS(3,0:JD,JV,JH),RKASFS(3,0:JD,JV,JH),RH0PFS(3,0:JD,JV,JH) - 4,RH1PFS(3,0:JD,JV,JH),RH3PFS(3,0:JD,JV,JH),RF1PFS(3,0:JD,JV,JH) + 4,RH3PFS(3,0:JD,JV,JH),RF1PFS(3,0:JD,JV,JH) 5,RF2PFS(3,0:JD,JV,JH),RC0PFS(3,0:JD,JV,JH),RC1PFS(3,0:JD,JV,JH) 6,RC2PFS(3,0:JD,JV,JH),RM1PFS(3,0:JD,JV,JH),RH0BFB(3,0:JD,JV,JH) - 7,RH1BFB(3,0:JD,JV,JH),RH3BFB(3,0:JD,JV,JH),RF1BFB(3,0:JD,JV,JH) + 7,RH3BFB(3,0:JD,JV,JH),RF1BFB(3,0:JD,JV,JH) 8,RF2BFB(3,0:JD,JV,JH),RC0BFB(3,0:JD,JV,JH),RC1BFB(3,0:JD,JV,JH) 9,RC2BFB(3,0:JD,JV,JH),RM1BFB(3,0:JD,JV,JH) DIMENSION RALFHS(3,JD,JV,JH),RFEFHS(3,JD,JV,JH) @@ -137,10 +137,10 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) 1,RCASHS(3,JD,JV,JH),RMGOHS(3,JD,JV,JH),RMGCHS(3,JD,JV,JH) 2,RMGHHS(3,JD,JV,JH),RMGSHS(3,JD,JV,JH),RNACHS(3,JD,JV,JH) 3,RNASHS(3,JD,JV,JH),RKASHS(3,JD,JV,JH),RH0PHS(3,JD,JV,JH) - 4,RH1PHS(3,JD,JV,JH),RH3PHS(3,JD,JV,JH),RF1PHS(3,JD,JV,JH) + 4,RH3PHS(3,JD,JV,JH),RF1PHS(3,JD,JV,JH) 5,RF2PHS(3,JD,JV,JH),RC0PHS(3,JD,JV,JH),RC1PHS(3,JD,JV,JH) 6,RC2PHS(3,JD,JV,JH),RM1PHS(3,JD,JV,JH),RH0BHB(3,JD,JV,JH) - 7,RH1BHB(3,JD,JV,JH),RH3BHB(3,JD,JV,JH),RF1BHB(3,JD,JV,JH) + 7,RH3BHB(3,JD,JV,JH),RF1BHB(3,JD,JV,JH) 8,RF2BHB(3,JD,JV,JH),RC0BHB(3,JD,JV,JH),RC1BHB(3,JD,JV,JH) 9,RC2BHB(3,JD,JV,JH),RM1BHB(3,JD,JV,JH) DIMENSION TQRAL(JY,JX),TQRFE(JY,JX),TQRHY(JY,JX) @@ -151,7 +151,7 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) 6,TQRFE3(JY,JX),TQRFE4(JY,JX),TQRFES(JY,JX),TQRCAO(JY,JX) 7,TQRCAC(JY,JX),TQRCAH(JY,JX),TQRCAS(JY,JX),TQRMGO(JY,JX) 8,TQRMGC(JY,JX),TQRMGH(JY,JX),TQRMGS(JY,JX),TQRNAC(JY,JX) - 9,TQRNAS(JY,JX),TQRKAS(JY,JX),TQRH0P(JY,JX),TQRH1P(JY,JX) + 9,TQRNAS(JY,JX),TQRKAS(JY,JX),TQRH0P(JY,JX) 1,TQRH3P(JY,JX),TQRF1P(JY,JX),TQRF2P(JY,JX),TQRC0P(JY,JX) 2,TQRC1P(JY,JX),TQRC2P(JY,JX),TQRM1P(JY,JX) DIMENSION TQSAL(JY,JX),TQSFE(JY,JX),TQSHY(JY,JX) @@ -162,7 +162,7 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) 6,TQSFE3(JY,JX),TQSFE4(JY,JX),TQSFES(JY,JX),TQSCAO(JY,JX) 7,TQSCAC(JY,JX),TQSCAH(JY,JX),TQSCAS(JY,JX),TQSMGO(JY,JX) 8,TQSMGC(JY,JX),TQSMGH(JY,JX),TQSMGS(JY,JX),TQSNAC(JY,JX) - 9,TQSNAS(JY,JX),TQSKAS(JY,JX),TQSH0P(JY,JX),TQSH1P(JY,JX) + 9,TQSNAS(JY,JX),TQSKAS(JY,JX),TQSH0P(JY,JX) 1,TQSH3P(JY,JX),TQSF1P(JY,JX),TQSF2P(JY,JX),TQSC0P(JY,JX) 2,TQSC1P(JY,JX),TQSC2P(JY,JX),TQSM1P(JY,JX) DIMENSION TALFLS(JZ,JY,JX),TFEFLS(JZ,JY,JX) @@ -177,10 +177,10 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) 9,TCASFS(JZ,JY,JX),TMGOFS(JZ,JY,JX),TMGCFS(JZ,JY,JX) 1,TMGHFS(JZ,JY,JX),TMGSFS(JZ,JY,JX),TNACFS(JZ,JY,JX) 2,TNASFS(JZ,JY,JX),TKASFS(JZ,JY,JX),TH0PFS(JZ,JY,JX) - 3,TH1PFS(JZ,JY,JX),TH3PFS(JZ,JY,JX),TF1PFS(JZ,JY,JX) + 3,TH3PFS(JZ,JY,JX),TF1PFS(JZ,JY,JX) 4,TF2PFS(JZ,JY,JX),TC0PFS(JZ,JY,JX),TC1PFS(JZ,JY,JX) 5,TC2PFS(JZ,JY,JX),TM1PFS(JZ,JY,JX),TH0BFB(JZ,JY,JX) - 6,TH1BFB(JZ,JY,JX),TH3BFB(JZ,JY,JX),TF1BFB(JZ,JY,JX) + 6,TH3BFB(JZ,JY,JX),TF1BFB(JZ,JY,JX) 7,TF2BFB(JZ,JY,JX),TC0BFB(JZ,JY,JX),TC1BFB(JZ,JY,JX) 8,TC2BFB(JZ,JY,JX),TM1BFB(JZ,JY,JX) DIMENSION TALFHS(JZ,JY,JX),TFEFHS(JZ,JY,JX) @@ -195,10 +195,10 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) 9,TCASHS(JZ,JY,JX),TMGOHS(JZ,JY,JX),TMGCHS(JZ,JY,JX) 1,TMGHHS(JZ,JY,JX),TMGSHS(JZ,JY,JX),TNACHS(JZ,JY,JX) 2,TNASHS(JZ,JY,JX),TKASHS(JZ,JY,JX),TH0PHS(JZ,JY,JX) - 3,TH1PHS(JZ,JY,JX),TH3PHS(JZ,JY,JX),TF1PHS(JZ,JY,JX) + 3,TH3PHS(JZ,JY,JX),TF1PHS(JZ,JY,JX) 4,TF2PHS(JZ,JY,JX),TC0PHS(JZ,JY,JX),TC1PHS(JZ,JY,JX) 5,TC2PHS(JZ,JY,JX),TM1PHS(JZ,JY,JX),TH0BHB(JZ,JY,JX) - 6,TH1BHB(JZ,JY,JX),TH3BHB(JZ,JY,JX),TF1BHB(JZ,JY,JX) + 6,TH3BHB(JZ,JY,JX),TF1BHB(JZ,JY,JX) 7,TF2BHB(JZ,JY,JX),TC0BHB(JZ,JY,JX),TC1BHB(JZ,JY,JX) 8,TC2BHB(JZ,JY,JX),TM1BHB(JZ,JY,JX) DIMENSION RALFLZ(JZ,JY,JX) @@ -213,10 +213,10 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) 4,RCAHFZ(JZ,JY,JX),RCASFZ(JZ,JY,JX),RMGOFZ(JZ,JY,JX) 5,RMGCFZ(JZ,JY,JX),RMGHFZ(JZ,JY,JX),RMGSFZ(JZ,JY,JX) 6,RNACFZ(JZ,JY,JX),RNASFZ(JZ,JY,JX),RKASFZ(JZ,JY,JX) - DIMENSION RH0PFZ(JZ,JY,JX),RH1PFZ(JZ,JY,JX),RH3PFZ(JZ,JY,JX) + DIMENSION RH0PFZ(JZ,JY,JX),RH3PFZ(JZ,JY,JX) 1,RF1PFZ(JZ,JY,JX),RF2PFZ(JZ,JY,JX),RC0PFZ(JZ,JY,JX) 2,RC1PFZ(JZ,JY,JX),RC2PFZ(JZ,JY,JX),RM1PFZ(JZ,JY,JX) - 3,RH0BBZ(JZ,JY,JX),RH1BBZ(JZ,JY,JX),RH3BBZ(JZ,JY,JX) + 3,RH0BBZ(JZ,JY,JX),RH3BBZ(JZ,JY,JX) 4,RF1BBZ(JZ,JY,JX),RF2BBZ(JZ,JY,JX),RC0BBZ(JZ,JY,JX) 5,RC1BBZ(JZ,JY,JX),RC2BBZ(JZ,JY,JX),RM1BBZ(JZ,JY,JX) DIMENSION RALFXS(JZ,JY,JX) @@ -231,10 +231,10 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) 6,RCASXS(JZ,JY,JX),RMGOXS(JZ,JY,JX),RMGCXS(JZ,JY,JX) 7,RMGHXS(JZ,JY,JX),RMGSXS(JZ,JY,JX),RNACXS(JZ,JY,JX) 8,RNASXS(JZ,JY,JX),RKASXS(JZ,JY,JX) - DIMENSION RH0PXS(JZ,JY,JX),RH1PXS(JZ,JY,JX),RH3PXS(JZ,JY,JX) + DIMENSION RH0PXS(JZ,JY,JX),RH3PXS(JZ,JY,JX) 1,RF1PXS(JZ,JY,JX),RF2PXS(JZ,JY,JX),RC0PXS(JZ,JY,JX) 2,RC1PXS(JZ,JY,JX),RC2PXS(JZ,JY,JX),RM1PXS(JZ,JY,JX) - 3,RH0BXB(JZ,JY,JX),RH1BXB(JZ,JY,JX),RH3BXB(JZ,JY,JX) + 3,RH0BXB(JZ,JY,JX),RH3BXB(JZ,JY,JX) 4,RF1BXB(JZ,JY,JX),RF2BXB(JZ,JY,JX),RC0BXB(JZ,JY,JX) 5,RC1BXB(JZ,JY,JX),RC2BXB(JZ,JY,JX),RM1BXB(JZ,JY,JX) DIMENSION THETW1(0:JZ,JY,JX),FLWU(JZ,JY,JX) @@ -310,8 +310,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) 2*CKASQ(I,NY,NX) XH0PBS(NY,NX)=PRECQ(NY,NX)*CH0PR(NY,NX)+PRECI(NY,NX) 2*CH0PQ(I,NY,NX) - XH1PBS(NY,NX)=PRECQ(NY,NX)*CH1PR(NY,NX)+PRECI(NY,NX) - 2*CH1PQ(I,NY,NX) XH3PBS(NY,NX)=PRECQ(NY,NX)*CH3PR(NY,NX)+PRECI(NY,NX) 2*CH3PQ(I,NY,NX) XF1PBS(NY,NX)=PRECQ(NY,NX)*CF1PR(NY,NX)+PRECI(NY,NX) @@ -364,7 +362,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) XNASFS(3,0,NY,NX)=0.0 XKASFS(3,0,NY,NX)=0.0 XH0PFS(3,0,NY,NX)=0.0 - XH1PFS(3,0,NY,NX)=0.0 XH3PFS(3,0,NY,NX)=0.0 XF1PFS(3,0,NY,NX)=0.0 XF2PFS(3,0,NY,NX)=0.0 @@ -406,7 +403,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) XNASFS(3,NU(NY,NX),NY,NX)=0.0 XKASFS(3,NU(NY,NX),NY,NX)=0.0 XH0PFS(3,NU(NY,NX),NY,NX)=0.0 - XH1PFS(3,NU(NY,NX),NY,NX)=0.0 XH3PFS(3,NU(NY,NX),NY,NX)=0.0 XF1PFS(3,NU(NY,NX),NY,NX)=0.0 XF2PFS(3,NU(NY,NX),NY,NX)=0.0 @@ -415,7 +411,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) XC2PFS(3,NU(NY,NX),NY,NX)=0.0 XM1PFS(3,NU(NY,NX),NY,NX)=0.0 XH0BFB(3,NU(NY,NX),NY,NX)=0.0 - XH1BFB(3,NU(NY,NX),NY,NX)=0.0 XH3BFB(3,NU(NY,NX),NY,NX)=0.0 XF1BFB(3,NU(NY,NX),NY,NX)=0.0 XF2BFB(3,NU(NY,NX),NY,NX)=0.0 @@ -498,8 +493,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) 2*CKASQ(I,NY,NX) XH0PFS(3,0,NY,NX)=FLQRQ(NY,NX)*CH0PR(NY,NX)+FLQRI(NY,NX) 2*CH0PQ(I,NY,NX) - XH1PFS(3,0,NY,NX)=FLQRQ(NY,NX)*CH1PR(NY,NX)+FLQRI(NY,NX) - 2*CH1PQ(I,NY,NX) XH3PFS(3,0,NY,NX)=FLQRQ(NY,NX)*CH3PR(NY,NX)+FLQRI(NY,NX) 2*CH3PQ(I,NY,NX) XF1PFS(3,0,NY,NX)=FLQRQ(NY,NX)*CF1PR(NY,NX)+FLQRI(NY,NX) @@ -582,8 +575,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) 2*CKASQ(I,NY,NX) XH0PFS(3,NU(NY,NX),NY,NX)=(FLQGQ(NY,NX)*CH0PR(NY,NX)+FLQGI(NY,NX) 2*CH0PQ(I,NY,NX))*VLPO4(NU(NY,NX),NY,NX) - XH1PFS(3,NU(NY,NX),NY,NX)=(FLQGQ(NY,NX)*CH1PR(NY,NX)+FLQGI(NY,NX) - 2*CH1PQ(I,NY,NX))*VLPO4(NU(NY,NX),NY,NX) XH3PFS(3,NU(NY,NX),NY,NX)=(FLQGQ(NY,NX)*CH3PR(NY,NX)+FLQGI(NY,NX) 2*CH3PQ(I,NY,NX))*VLPO4(NU(NY,NX),NY,NX) XF1PFS(3,NU(NY,NX),NY,NX)=(FLQGQ(NY,NX)*CF1PR(NY,NX)+FLQGI(NY,NX) @@ -600,8 +591,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) 2*CM1PQ(I,NY,NX))*VLPO4(NU(NY,NX),NY,NX) XH0BFB(3,NU(NY,NX),NY,NX)=(FLQGQ(NY,NX)*CH0PR(NY,NX)+FLQGI(NY,NX) 2*CH0PQ(I,NY,NX))*VLPOB(NU(NY,NX),NY,NX) - XH1BFB(3,NU(NY,NX),NY,NX)=(FLQGQ(NY,NX)*CH1PR(NY,NX)+FLQGI(NY,NX) - 2*CH1PQ(I,NY,NX))*VLPOB(NU(NY,NX),NY,NX) XH3BFB(3,NU(NY,NX),NY,NX)=(FLQGQ(NY,NX)*CH3PR(NY,NX)+FLQGI(NY,NX) 2*CH3PQ(I,NY,NX))*VLPOB(NU(NY,NX),NY,NX) XF1BFB(3,NU(NY,NX),NY,NX)=(FLQGQ(NY,NX)*CF1PR(NY,NX)+FLQGI(NY,NX) @@ -654,7 +643,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) XNASBS(NY,NX)=0.0 XKASBS(NY,NX)=0.0 XH0PBS(NY,NX)=0.0 - XH1PBS(NY,NX)=0.0 XH3PBS(NY,NX)=0.0 XF1PBS(NY,NX)=0.0 XF2PBS(NY,NX)=0.0 @@ -700,7 +688,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) XNASBS(NY,NX)=0.0 XKASBS(NY,NX)=0.0 XH0PBS(NY,NX)=0.0 - XH1PBS(NY,NX)=0.0 XH3PBS(NY,NX)=0.0 XF1PBS(NY,NX)=0.0 XF2PBS(NY,NX)=0.0 @@ -742,7 +729,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) XNASFS(3,0,NY,NX)=0.0 XKASFS(3,0,NY,NX)=0.0 XH0PFS(3,0,NY,NX)=0.0 - XH1PFS(3,0,NY,NX)=0.0 XH3PFS(3,0,NY,NX)=0.0 XF1PFS(3,0,NY,NX)=0.0 XF2PFS(3,0,NY,NX)=0.0 @@ -784,7 +770,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) XNASFS(3,NU(NY,NX),NY,NX)=0.0 XKASFS(3,NU(NY,NX),NY,NX)=0.0 XH0PFS(3,NU(NY,NX),NY,NX)=0.0 - XH1PFS(3,NU(NY,NX),NY,NX)=0.0 XH3PFS(3,NU(NY,NX),NY,NX)=0.0 XF1PFS(3,NU(NY,NX),NY,NX)=0.0 XF2PFS(3,NU(NY,NX),NY,NX)=0.0 @@ -793,7 +778,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) XC2PFS(3,NU(NY,NX),NY,NX)=0.0 XM1PFS(3,NU(NY,NX),NY,NX)=0.0 XH0BFB(3,NU(NY,NX),NY,NX)=0.0 - XH1BFB(3,NU(NY,NX),NY,NX)=0.0 XH3BFB(3,NU(NY,NX),NY,NX)=0.0 XF1BFB(3,NU(NY,NX),NY,NX)=0.0 XF2BFB(3,NU(NY,NX),NY,NX)=0.0 @@ -808,7 +792,7 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) C CONCENTRATIONS IN SNOWPACK C IF(FLQGM(NY,NX)+FLQRM(NY,NX).GT.0.0)THEN - VOLWW=VOLWS(NY,NX)+VOLSS(NY,NX)+VOLIS(NY,NX)*0.92 + VOLWW=VOLWS(NY,NX)+VOLSS(NY,NX)+VOLIS(NY,NX)*DENSI FLQTM=FLQGM(NY,NX)+FLQRM(NY,NX) CALW=FLQTM*ZALW(NY,NX)/VOLWW CFEW=FLQTM*ZFEW(NY,NX)/VOLWW @@ -844,7 +828,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) CNASW=FLQTM*ZNASW(NY,NX)/VOLWW CKASW=FLQTM*ZKASW(NY,NX)/VOLWW CH0PW=FLQTM*H0PO4W(NY,NX)/VOLWW - CH1PW=FLQTM*H1PO4W(NY,NX)/VOLWW CH3PW=FLQTM*H3PO4W(NY,NX)/VOLWW CF1PW=FLQTM*ZFE1PW(NY,NX)/VOLWW CF2PW=FLQTM*ZFE2PW(NY,NX)/VOLWW @@ -886,7 +869,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) XNASBS(NY,NX)=XNASBS(NY,NX)-CNASW XKASBS(NY,NX)=XKASBS(NY,NX)-CKASW XH0PBS(NY,NX)=XH0PBS(NY,NX)-CH0PW - XH1PBS(NY,NX)=XH1PBS(NY,NX)-CH1PW XH3PBS(NY,NX)=XH3PBS(NY,NX)-CH3PW XF1PBS(NY,NX)=XF1PBS(NY,NX)-CF1PW XF2PBS(NY,NX)=XF2PBS(NY,NX)-CF2PW @@ -928,7 +910,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) ZNASW2(NY,NX)=ZNASW(NY,NX)+XNASBS(NY,NX) ZKASW2(NY,NX)=ZKASW(NY,NX)+XKASBS(NY,NX) H0PO4W2(NY,NX)=H0PO4W(NY,NX)+XH0PBS(NY,NX) - H1PO4W2(NY,NX)=H1PO4W(NY,NX)+XH1PBS(NY,NX) H3PO4W2(NY,NX)=H3PO4W(NY,NX)+XH3PBS(NY,NX) ZFE1PW2(NY,NX)=ZFE1PW(NY,NX)+XF1PBS(NY,NX) ZFE2PW2(NY,NX)=ZFE2PW(NY,NX)+XF2PBS(NY,NX) @@ -975,7 +956,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) XNASFS(3,0,NY,NX)=XNASFS(3,0,NY,NX)+CNASW*VFLWR XKASFS(3,0,NY,NX)=XKASFS(3,0,NY,NX)+CKASW*VFLWR XH0PFS(3,0,NY,NX)=XH0PFS(3,0,NY,NX)+CH0PW*VFLWR - XH1PFS(3,0,NY,NX)=XH1PFS(3,0,NY,NX)+CH1PW*VFLWR XH3PFS(3,0,NY,NX)=XH3PFS(3,0,NY,NX)+CH3PW*VFLWR XF1PFS(3,0,NY,NX)=XF1PFS(3,0,NY,NX)+CF1PW*VFLWR XF2PFS(3,0,NY,NX)=XF2PFS(3,0,NY,NX)+CF2PW*VFLWR @@ -1018,8 +998,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) XKASFS(3,NU(NY,NX),NY,NX)=XKASFS(3,NU(NY,NX),NY,NX)+CKASW*VFLWG XH0PFS(3,NU(NY,NX),NY,NX)=XH0PFS(3,NU(NY,NX),NY,NX) 2+CH0PW*VLPO4(NU(NY,NX),NY,NX)*VFLWG - XH1PFS(3,NU(NY,NX),NY,NX)=XH1PFS(3,NU(NY,NX),NY,NX) - 2+CH1PW*VLPO4(NU(NY,NX),NY,NX)*VFLWG XH3PFS(3,NU(NY,NX),NY,NX)=XH3PFS(3,NU(NY,NX),NY,NX) 2+CH3PW*VLPO4(NU(NY,NX),NY,NX)*VFLWG XF1PFS(3,NU(NY,NX),NY,NX)=XF1PFS(3,NU(NY,NX),NY,NX) @@ -1036,8 +1014,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) 2+CM1PW*VLPO4(NU(NY,NX),NY,NX)*VFLWG XH0BFB(3,NU(NY,NX),NY,NX)=XH0BFB(3,NU(NY,NX),NY,NX) 2+CH0PW*VLPOB(NU(NY,NX),NY,NX)*VFLWG - XH1BFB(3,NU(NY,NX),NY,NX)=XH1BFB(3,NU(NY,NX),NY,NX) - 2+CH1PW*VLPOB(NU(NY,NX),NY,NX)*VFLWG XH3BFB(3,NU(NY,NX),NY,NX)=XH3BFB(3,NU(NY,NX),NY,NX) 2+CH3PW*VLPOB(NU(NY,NX),NY,NX)*VFLWG XF1BFB(3,NU(NY,NX),NY,NX)=XF1BFB(3,NU(NY,NX),NY,NX) @@ -1087,7 +1063,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) XNASHS(3,NU(NY,NX),NY,NX)=0.0 XKASHS(3,NU(NY,NX),NY,NX)=0.0 XH0PHS(3,NU(NY,NX),NY,NX)=0.0 - XH1PHS(3,NU(NY,NX),NY,NX)=0.0 XH3PHS(3,NU(NY,NX),NY,NX)=0.0 XF1PHS(3,NU(NY,NX),NY,NX)=0.0 XF2PHS(3,NU(NY,NX),NY,NX)=0.0 @@ -1096,7 +1071,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) XC2PHS(3,NU(NY,NX),NY,NX)=0.0 XM1PHS(3,NU(NY,NX),NY,NX)=0.0 XH0BHB(3,NU(NY,NX),NY,NX)=0.0 - XH1BHB(3,NU(NY,NX),NY,NX)=0.0 XH3BHB(3,NU(NY,NX),NY,NX)=0.0 XF1BHB(3,NU(NY,NX),NY,NX)=0.0 XF2BHB(3,NU(NY,NX),NY,NX)=0.0 @@ -1142,7 +1116,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RNASF0=XNASFS(3,0,NY,NX)*XNPH RKASF0=XKASFS(3,0,NY,NX)*XNPH RH0PF0=XH0PFS(3,0,NY,NX)*XNPH - RH1PF0=XH1PFS(3,0,NY,NX)*XNPH RH3PF0=XH3PFS(3,0,NY,NX)*XNPH RF1PF0=XF1PFS(3,0,NY,NX)*XNPH RF2PF0=XF2PFS(3,0,NY,NX)*XNPH @@ -1184,7 +1157,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RNASF1=XNASFS(3,NU(NY,NX),NY,NX)*XNPH RKASF1=XKASFS(3,NU(NY,NX),NY,NX)*XNPH RH0PF1=XH0PFS(3,NU(NY,NX),NY,NX)*XNPH - RH1PF1=XH1PFS(3,NU(NY,NX),NY,NX)*XNPH RH3PF1=XH3PFS(3,NU(NY,NX),NY,NX)*XNPH RF1PF1=XF1PFS(3,NU(NY,NX),NY,NX)*XNPH RF2PF1=XF2PFS(3,NU(NY,NX),NY,NX)*XNPH @@ -1193,7 +1165,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RC2PF1=XC2PFS(3,NU(NY,NX),NY,NX)*XNPH RM1PF1=XM1PFS(3,NU(NY,NX),NY,NX)*XNPH RH0BF2=XH0BFB(3,NU(NY,NX),NY,NX)*XNPH - RH1BF2=XH1BFB(3,NU(NY,NX),NY,NX)*XNPH RH3BF2=XH3BFB(3,NU(NY,NX),NY,NX)*XNPH RF1BF2=XF1BFB(3,NU(NY,NX),NY,NX)*XNPH RF2BF2=XF2BFB(3,NU(NY,NX),NY,NX)*XNPH @@ -1235,7 +1206,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RNASHS(3,NU(NY,NX),NY,NX)=XNASHS(3,NU(NY,NX),NY,NX)*XNPH RKASHS(3,NU(NY,NX),NY,NX)=XKASHS(3,NU(NY,NX),NY,NX)*XNPH RH0PHS(3,NU(NY,NX),NY,NX)=XH0PHS(3,NU(NY,NX),NY,NX)*XNPH - RH1PHS(3,NU(NY,NX),NY,NX)=XH1PHS(3,NU(NY,NX),NY,NX)*XNPH RH3PHS(3,NU(NY,NX),NY,NX)=XH3PHS(3,NU(NY,NX),NY,NX)*XNPH RF1PHS(3,NU(NY,NX),NY,NX)=XF1PHS(3,NU(NY,NX),NY,NX)*XNPH RF2PHS(3,NU(NY,NX),NY,NX)=XF2PHS(3,NU(NY,NX),NY,NX)*XNPH @@ -1244,7 +1214,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RC2PHS(3,NU(NY,NX),NY,NX)=XC2PHS(3,NU(NY,NX),NY,NX)*XNPH RM1PHS(3,NU(NY,NX),NY,NX)=XM1PHS(3,NU(NY,NX),NY,NX)*XNPH RH0BHB(3,NU(NY,NX),NY,NX)=XH0BHB(3,NU(NY,NX),NY,NX)*XNPH - RH1BHB(3,NU(NY,NX),NY,NX)=XH1BHB(3,NU(NY,NX),NY,NX)*XNPH RH3BHB(3,NU(NY,NX),NY,NX)=XH3BHB(3,NU(NY,NX),NY,NX)*XNPH RF1BHB(3,NU(NY,NX),NY,NX)=XF1BHB(3,NU(NY,NX),NY,NX)*XNPH RF2BHB(3,NU(NY,NX),NY,NX)=XF2BHB(3,NU(NY,NX),NY,NX)*XNPH @@ -1291,7 +1260,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RNASFU(L,NY,NX)=FLU(L,NY,NX)*CNASQ(I,NY,NX) RKASFU(L,NY,NX)=FLU(L,NY,NX)*CKASQ(I,NY,NX) RH0PFU(L,NY,NX)=FLU(L,NY,NX)*CH0PQ(I,NY,NX)*VLPO4(L,NY,NX) - RH1PFU(L,NY,NX)=FLU(L,NY,NX)*CH1PQ(I,NY,NX)*VLPO4(L,NY,NX) RH3PFU(L,NY,NX)=FLU(L,NY,NX)*CH3PQ(I,NY,NX)*VLPO4(L,NY,NX) RF1PFU(L,NY,NX)=FLU(L,NY,NX)*CF1PQ(I,NY,NX)*VLPO4(L,NY,NX) RF2PFU(L,NY,NX)=FLU(L,NY,NX)*CF2PQ(I,NY,NX)*VLPO4(L,NY,NX) @@ -1300,7 +1268,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RC2PFU(L,NY,NX)=FLU(L,NY,NX)*CC2PQ(I,NY,NX)*VLPO4(L,NY,NX) RM1PFU(L,NY,NX)=FLU(L,NY,NX)*CM1PQ(I,NY,NX)*VLPO4(L,NY,NX) RH0BBU(L,NY,NX)=FLU(L,NY,NX)*CH0PQ(I,NY,NX)*VLPOB(L,NY,NX) - RH1BBU(L,NY,NX)=FLU(L,NY,NX)*CH1PQ(I,NY,NX)*VLPOB(L,NY,NX) RH3BBU(L,NY,NX)=FLU(L,NY,NX)*CH3PQ(I,NY,NX)*VLPOB(L,NY,NX) RF1BBU(L,NY,NX)=FLU(L,NY,NX)*CF1PQ(I,NY,NX)*VLPOB(L,NY,NX) RF2BBU(L,NY,NX)=FLU(L,NY,NX)*CF2PQ(I,NY,NX)*VLPOB(L,NY,NX) @@ -1345,7 +1312,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RNASFZ(L,NY,NX)=RNASFU(L,NY,NX)*XNPH RKASFZ(L,NY,NX)=RKASFU(L,NY,NX)*XNPH RH0PFZ(L,NY,NX)=RH0PFU(L,NY,NX)*XNPH - RH1PFZ(L,NY,NX)=RH1PFU(L,NY,NX)*XNPH RH3PFZ(L,NY,NX)=RH3PFU(L,NY,NX)*XNPH RF1PFZ(L,NY,NX)=RF1PFU(L,NY,NX)*XNPH RF2PFZ(L,NY,NX)=RF2PFU(L,NY,NX)*XNPH @@ -1354,7 +1320,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RC2PFZ(L,NY,NX)=RC2PFU(L,NY,NX)*XNPH RM1PFZ(L,NY,NX)=RM1PFU(L,NY,NX)*XNPH RH0BBZ(L,NY,NX)=RH0BBU(L,NY,NX)*XNPH - RH1BBZ(L,NY,NX)=RH1BBU(L,NY,NX)*XNPH RH3BBZ(L,NY,NX)=RH3BBU(L,NY,NX)*XNPH RF1BBZ(L,NY,NX)=RF1BBU(L,NY,NX)*XNPH RF2BBZ(L,NY,NX)=RF2BBU(L,NY,NX)*XNPH @@ -1385,7 +1350,8 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) C ZAL2(L,NY,NX)=ZAL(L,NY,NX)+TRAL(L,NY,NX)*XNPH ZFE2(L,NY,NX)=ZFE(L,NY,NX)+TRFE(L,NY,NX)*XNPH - ZHY2(L,NY,NX)=ZHY(L,NY,NX)+TRHY(L,NY,NX)*XNPH + ZHY2(L,NY,NX)=ZHY(L,NY,NX)+(TRHY(L,NY,NX) + 2+XZHYS(L,NY,NX))*XNPH ZCA2(L,NY,NX)=ZCA(L,NY,NX)+TRCA(L,NY,NX)*XNPH ZMG2(L,NY,NX)=ZMG(L,NY,NX)+TRMG(L,NY,NX)*XNPH ZNA2(L,NY,NX)=ZNA(L,NY,NX)+TRNA(L,NY,NX)*XNPH @@ -1417,7 +1383,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) ZNAS2(L,NY,NX)=ZNAS(L,NY,NX)+TRNAS(L,NY,NX)*XNPH ZKAS2(L,NY,NX)=ZKAS(L,NY,NX)+TRKAS(L,NY,NX)*XNPH H0PO42(L,NY,NX)=H0PO4(L,NY,NX)+TRH0P(L,NY,NX)*XNPH - H1PO42(L,NY,NX)=H1PO4(L,NY,NX)+TRH1P(L,NY,NX)*XNPH H3PO42(L,NY,NX)=H3PO4(L,NY,NX)+TRH3P(L,NY,NX)*XNPH ZFE1P2(L,NY,NX)=ZFE1P(L,NY,NX)+TRF1P(L,NY,NX)*XNPH ZFE2P2(L,NY,NX)=ZFE2P(L,NY,NX)+TRF2P(L,NY,NX)*XNPH @@ -1426,7 +1391,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) ZCA2P2(L,NY,NX)=ZCA2P(L,NY,NX)+TRC2P(L,NY,NX)*XNPH ZMG1P2(L,NY,NX)=ZMG1P(L,NY,NX)+TRM1P(L,NY,NX)*XNPH H0POB2(L,NY,NX)=H0POB(L,NY,NX)+TRH0B(L,NY,NX)*XNPH - H1POB2(L,NY,NX)=H1POB(L,NY,NX)+TRH1B(L,NY,NX)*XNPH H3POB2(L,NY,NX)=H3POB(L,NY,NX)+TRH3B(L,NY,NX)*XNPH ZF1PB2(L,NY,NX)=ZFE1PB(L,NY,NX)+TRF1B(L,NY,NX)*XNPH ZF2PB2(L,NY,NX)=ZFE2PB(L,NY,NX)+TRF2B(L,NY,NX)*XNPH @@ -1468,7 +1432,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) ZNASH2(L,NY,NX)=ZNASH(L,NY,NX) ZKASH2(L,NY,NX)=ZKASH(L,NY,NX) H0P4H2(L,NY,NX)=H0PO4H(L,NY,NX) - H1P4H2(L,NY,NX)=H1PO4H(L,NY,NX) H3P4H2(L,NY,NX)=H3PO4H(L,NY,NX) ZF1PH2(L,NY,NX)=ZFE1PH(L,NY,NX) ZF2PH2(L,NY,NX)=ZFE2PH(L,NY,NX) @@ -1477,7 +1440,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) ZC2PH2(L,NY,NX)=ZCA2PH(L,NY,NX) ZM1PH2(L,NY,NX)=ZMG1PH(L,NY,NX) H0PBH2(L,NY,NX)=H0POBH(L,NY,NX) - H1PBH2(L,NY,NX)=H1POBH(L,NY,NX) H3PBH2(L,NY,NX)=H3POBH(L,NY,NX) ZF1BH2(L,NY,NX)=ZFE1BH(L,NY,NX) ZF2BH2(L,NY,NX)=ZFE2BH(L,NY,NX) @@ -1533,7 +1495,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) TQRNAS(NY,NX)=0.0 TQRKAS(NY,NX)=0.0 TQRH0P(NY,NX)=0.0 - TQRH1P(NY,NX)=0.0 TQRH3P(NY,NX)=0.0 TQRF1P(NY,NX)=0.0 TQRF2P(NY,NX)=0.0 @@ -1575,7 +1536,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) TQSNAS(NY,NX)=0.0 TQSKAS(NY,NX)=0.0 TQSH0P(NY,NX)=0.0 - TQSH1P(NY,NX)=0.0 TQSH3P(NY,NX)=0.0 TQSF1P(NY,NX)=0.0 TQSF2P(NY,NX)=0.0 @@ -1621,7 +1581,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) TNASFS(L,NY,NX)=0.0 TKASFS(L,NY,NX)=0.0 TH0PFS(L,NY,NX)=0.0 - TH1PFS(L,NY,NX)=0.0 TH3PFS(L,NY,NX)=0.0 TF1PFS(L,NY,NX)=0.0 TF2PFS(L,NY,NX)=0.0 @@ -1630,7 +1589,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) TC2PFS(L,NY,NX)=0.0 TM1PFS(L,NY,NX)=0.0 TH0BFB(L,NY,NX)=0.0 - TH1BFB(L,NY,NX)=0.0 TH3BFB(L,NY,NX)=0.0 TF1BFB(L,NY,NX)=0.0 TF2BFB(L,NY,NX)=0.0 @@ -1672,7 +1630,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) TNASHS(L,NY,NX)=0.0 TKASHS(L,NY,NX)=0.0 TH0PHS(L,NY,NX)=0.0 - TH1PHS(L,NY,NX)=0.0 TH3PHS(L,NY,NX)=0.0 TF1PHS(L,NY,NX)=0.0 TF2PHS(L,NY,NX)=0.0 @@ -1681,7 +1638,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) TC2PHS(L,NY,NX)=0.0 TM1PHS(L,NY,NX)=0.0 TH0BHB(L,NY,NX)=0.0 - TH1BHB(L,NY,NX)=0.0 TH3BHB(L,NY,NX)=0.0 TF1BHB(L,NY,NX)=0.0 TF2BHB(L,NY,NX)=0.0 @@ -1740,7 +1696,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RFLNAS=VFLW*AMAX1(0.0,ZNAS2(0,NY,NX)) RFLKAS=VFLW*AMAX1(0.0,ZKAS2(0,NY,NX)) RFLH0P=VFLW*AMAX1(0.0,H0PO42(0,NY,NX))*VLPO4(NU(NY,NX),NY,NX) - RFLH1P=VFLW*AMAX1(0.0,H1PO42(0,NY,NX))*VLPO4(NU(NY,NX),NY,NX) RFLH3P=VFLW*AMAX1(0.0,H3PO42(0,NY,NX))*VLPO4(NU(NY,NX),NY,NX) RFLF1P=VFLW*AMAX1(0.0,ZFE1P2(0,NY,NX))*VLPO4(NU(NY,NX),NY,NX) RFLF2P=VFLW*AMAX1(0.0,ZFE2P2(0,NY,NX))*VLPO4(NU(NY,NX),NY,NX) @@ -1749,7 +1704,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RFLC2P=VFLW*AMAX1(0.0,ZCA2P2(0,NY,NX))*VLPO4(NU(NY,NX),NY,NX) RFLM1P=VFLW*AMAX1(0.0,ZMG1P2(0,NY,NX))*VLPO4(NU(NY,NX),NY,NX) RFLH0B=VFLW*AMAX1(0.0,H0PO42(0,NY,NX))*VLPOB(NU(NY,NX),NY,NX) - RFLH1B=VFLW*AMAX1(0.0,H1PO42(0,NY,NX))*VLPOB(NU(NY,NX),NY,NX) RFLH3B=VFLW*AMAX1(0.0,H3PO42(0,NY,NX))*VLPOB(NU(NY,NX),NY,NX) RFLF1B=VFLW*AMAX1(0.0,ZFE1P2(0,NY,NX))*VLPOB(NU(NY,NX),NY,NX) RFLF2B=VFLW*AMAX1(0.0,ZFE2P2(0,NY,NX))*VLPOB(NU(NY,NX),NY,NX) @@ -1803,7 +1757,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RFLNAS=VFLW*AMAX1(0.0,ZNAS2(NU(NY,NX),NY,NX)) RFLKAS=VFLW*AMAX1(0.0,ZKAS2(NU(NY,NX),NY,NX)) RFLH0P=VFLW*AMAX1(0.0,H0PO42(NU(NY,NX),NY,NX)) - RFLH1P=VFLW*AMAX1(0.0,H1PO42(NU(NY,NX),NY,NX)) RFLH3P=VFLW*AMAX1(0.0,H3PO42(NU(NY,NX),NY,NX)) RFLF1P=VFLW*AMAX1(0.0,ZFE1P2(NU(NY,NX),NY,NX)) RFLF2P=VFLW*AMAX1(0.0,ZFE2P2(NU(NY,NX),NY,NX)) @@ -1812,7 +1765,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RFLC2P=VFLW*AMAX1(0.0,ZCA2P2(NU(NY,NX),NY,NX)) RFLM1P=VFLW*AMAX1(0.0,ZMG1P2(NU(NY,NX),NY,NX)) RFLH0B=VFLW*AMAX1(0.0,H0POB2(NU(NY,NX),NY,NX)) - RFLH1B=VFLW*AMAX1(0.0,H1POB2(NU(NY,NX),NY,NX)) RFLH3B=VFLW*AMAX1(0.0,H3POB2(NU(NY,NX),NY,NX)) RFLF1B=VFLW*AMAX1(0.0,ZF1PB2(NU(NY,NX),NY,NX)) RFLF2B=VFLW*AMAX1(0.0,ZF2PB2(NU(NY,NX),NY,NX)) @@ -1871,7 +1823,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) CNAS1=AMAX1(0.0,ZNAS2(0,NY,NX)/VOLWM(M,0,NY,NX)) CKAS1=AMAX1(0.0,ZKAS2(0,NY,NX)/VOLWM(M,0,NY,NX)) C0PO41=AMAX1(0.0,H0PO42(0,NY,NX)/VOLWM(M,0,NY,NX)) - C1PO41=AMAX1(0.0,H1PO42(0,NY,NX)/VOLWM(M,0,NY,NX)) C3PO41=AMAX1(0.0,H3PO42(0,NY,NX)/VOLWM(M,0,NY,NX)) CFE1P1=AMAX1(0.0,ZFE1P2(0,NY,NX)/VOLWM(M,0,NY,NX)) CFE2P1=AMAX1(0.0,ZFE2P2(0,NY,NX)/VOLWM(M,0,NY,NX)) @@ -1914,7 +1865,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) CKAS2=AMAX1(0.0,ZKAS2(NU(NY,NX),NY,NX)/VOLWM(M,NU(NY,NX),NY,NX)) IF(VOLWPA.GT.ZEROS(NY,NX))THEN C0PO42=AMAX1(0.0,H0PO42(NU(NY,NX),NY,NX)/VOLWPA) - C1PO42=AMAX1(0.0,H1PO42(NU(NY,NX),NY,NX)/VOLWPA) C3PO42=AMAX1(0.0,H3PO42(NU(NY,NX),NY,NX)/VOLWPA) CFE1P2=AMAX1(0.0,ZFE1P2(NU(NY,NX),NY,NX)/VOLWPA) CFE2P2=AMAX1(0.0,ZFE2P2(NU(NY,NX),NY,NX)/VOLWPA) @@ -1924,7 +1874,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) CMG1P2=AMAX1(0.0,ZMG1P2(NU(NY,NX),NY,NX)/VOLWPA) ELSE C0PO42=0.0 - C1PO42=0.0 C3PO42=0.0 CFE1P2=0.0 CFE2P2=0.0 @@ -1935,7 +1884,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) ENDIF IF(VOLWPB.GT.ZEROS(NY,NX))THEN C0POB2=AMAX1(0.0,H0POB2(NU(NY,NX),NY,NX)/VOLWPB) - C1POB2=AMAX1(0.0,H1POB2(NU(NY,NX),NY,NX)/VOLWPB) C3POB2=AMAX1(0.0,H3POB2(NU(NY,NX),NY,NX)/VOLWPB) CF1PB2=AMAX1(0.0,ZF1PB2(NU(NY,NX),NY,NX)/VOLWPB) CF2PB2=AMAX1(0.0,ZF2PB2(NU(NY,NX),NY,NX)/VOLWPB) @@ -1945,7 +1893,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) CM1PB2=AMAX1(0.0,ZM1PB2(NU(NY,NX),NY,NX)/VOLWPB) ELSE C0POB2=C0PO42 - C1POB2=C1PO42 C3POB2=C3PO42 CF1PB2=CFE1P2 CF2PB2=CFE2P2 @@ -2009,7 +1956,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) DFVNAS=DIFNA*(CNAS1-CNAS2) DFVKAS=DIFKA*(CKAS1-CKAS2) DFVH0P=DIFPO*(C0PO41-C0PO42)*VLPO4(NU(NY,NX),NY,NX) - DFVH1P=DIFPO*(C1PO41-C1PO42)*VLPO4(NU(NY,NX),NY,NX) DFVH3P=DIFPO*(C3PO41-C3PO42)*VLPO4(NU(NY,NX),NY,NX) DFVF1P=DIFPO*(CFE1P1-CFE1P2)*VLPO4(NU(NY,NX),NY,NX) DFVF2P=DIFPO*(CFE2P1-CFE2P2)*VLPO4(NU(NY,NX),NY,NX) @@ -2018,7 +1964,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) DFVC2P=DIFPO*(CCA2P1-CCA2P2)*VLPO4(NU(NY,NX),NY,NX) DFVM1P=DIFPO*(CMG1P1-CMG1P2)*VLPO4(NU(NY,NX),NY,NX) DFVH0B=DIFPO*(C0PO41-C0POB2)*VLPOB(NU(NY,NX),NY,NX) - DFVH1B=DIFPO*(C1PO41-C1POB2)*VLPOB(NU(NY,NX),NY,NX) DFVH3B=DIFPO*(C3PO41-C3POB2)*VLPOB(NU(NY,NX),NY,NX) DFVF1B=DIFPO*(CFE1P1-CF1PB2)*VLPOB(NU(NY,NX),NY,NX) DFVF2B=DIFPO*(CFE2P1-CF2PB2)*VLPOB(NU(NY,NX),NY,NX) @@ -2061,7 +2006,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) DFVNAS=0.0 DFVKAS=0.0 DFVH0P=0.0 - DFVH1P=0.0 DFVH3P=0.0 DFVF1P=0.0 DFVF2P=0.0 @@ -2070,7 +2014,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) DFVC2P=0.0 DFVM1P=0.0 DFVH0B=0.0 - DFVH1B=0.0 DFVH3B=0.0 DFVF1B=0.0 DFVF2B=0.0 @@ -2117,7 +2060,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RNASFS(3,0,NY,NX)=RNASF0-RFLNAS-DFVNAS RKASFS(3,0,NY,NX)=RKASF0-RFLKAS-DFVKAS RH0PFS(3,0,NY,NX)=RH0PF0-RFLH0P-DFVH0P-RFLH0B-DFVH0B - RH1PFS(3,0,NY,NX)=RH1PF0-RFLH1P-DFVH1P-RFLH1B-DFVH1B RH3PFS(3,0,NY,NX)=RH3PF0-RFLH3P-DFVH3P-RFLH3B-DFVH3B RF1PFS(3,0,NY,NX)=RF1PF0-RFLF1P-DFVF1P-RFLF1B-DFVF1B RF2PFS(3,0,NY,NX)=RF2PF0-RFLF2P-DFVF2P-RFLF2B-DFVF2B @@ -2159,7 +2101,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RNASFS(3,NU(NY,NX),NY,NX)=RNASF1+RFLNAS+DFVNAS RKASFS(3,NU(NY,NX),NY,NX)=RKASF1+RFLKAS+DFVKAS RH0PFS(3,NU(NY,NX),NY,NX)=RH0PF1+RFLH0P+DFVH0P - RH1PFS(3,NU(NY,NX),NY,NX)=RH1PF1+RFLH1P+DFVH1P RH3PFS(3,NU(NY,NX),NY,NX)=RH3PF1+RFLH3P+DFVH3P RF1PFS(3,NU(NY,NX),NY,NX)=RF1PF1+RFLF1P+DFVF1P RF2PFS(3,NU(NY,NX),NY,NX)=RF2PF1+RFLF2P+DFVF2P @@ -2168,7 +2109,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RC2PFS(3,NU(NY,NX),NY,NX)=RC2PF1+RFLC2P+DFVC2P RM1PFS(3,NU(NY,NX),NY,NX)=RM1PF1+RFLM1P+DFVM1P RH0BFB(3,NU(NY,NX),NY,NX)=RH0BF2+RFLH0B+DFVH0B - RH1BFB(3,NU(NY,NX),NY,NX)=RH1BF2+RFLH1B+DFVH1B RH3BFB(3,NU(NY,NX),NY,NX)=RH3BF2+RFLH3B+DFVH3B RF1BFB(3,NU(NY,NX),NY,NX)=RF1BF2+RFLF1B+DFVF1B RF2BFB(3,NU(NY,NX),NY,NX)=RF2BF2+RFLF2B+DFVF2B @@ -2213,7 +2153,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) XNASFS(3,0,NY,NX)=XNASFS(3,0,NY,NX)-RFLNAS-DFVNAS XKASFS(3,0,NY,NX)=XKASFS(3,0,NY,NX)-RFLKAS-DFVKAS XH0PFS(3,0,NY,NX)=XH0PFS(3,0,NY,NX)-RFLH0P-DFVH0P-RFLH0B-DFVH0B - XH1PFS(3,0,NY,NX)=XH1PFS(3,0,NY,NX)-RFLH1P-DFVH1P-RFLH1B-DFVH1B XH3PFS(3,0,NY,NX)=XH3PFS(3,0,NY,NX)-RFLH3P-DFVH3P-RFLH3B-DFVH3B XF1PFS(3,0,NY,NX)=XF1PFS(3,0,NY,NX)-RFLF1P-DFVF1P-RFLF1B-DFVF1B XF2PFS(3,0,NY,NX)=XF2PFS(3,0,NY,NX)-RFLF2P-DFVF2P-RFLF2B-DFVF2B @@ -2233,45 +2172,80 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) XCLFLS(3,NU(NY,NX),NY,NX)=XCLFLS(3,NU(NY,NX),NY,NX)+RFLCL+DFVCL XC3FLS(3,NU(NY,NX),NY,NX)=XC3FLS(3,NU(NY,NX),NY,NX)+RFLC3+DFVC3 XHCFLS(3,NU(NY,NX),NY,NX)=XHCFLS(3,NU(NY,NX),NY,NX)+RFLHC+DFVHC - XAL1FS(3,NU(NY,NX),NY,NX)=XAL1FS(3,NU(NY,NX),NY,NX)+RFLAL1+DFVAL1 - XAL2FS(3,NU(NY,NX),NY,NX)=XAL2FS(3,NU(NY,NX),NY,NX)+RFLAL2+DFVAL2 - XAL3FS(3,NU(NY,NX),NY,NX)=XAL3FS(3,NU(NY,NX),NY,NX)+RFLAL3+DFVAL3 - XAL4FS(3,NU(NY,NX),NY,NX)=XAL4FS(3,NU(NY,NX),NY,NX)+RFLAL4+DFVAL4 - XALSFS(3,NU(NY,NX),NY,NX)=XALSFS(3,NU(NY,NX),NY,NX)+RFLALS+DFVALS - XFE1FS(3,NU(NY,NX),NY,NX)=XFE1FS(3,NU(NY,NX),NY,NX)+RFLFE1+DFVFE1 - XFE2FS(3,NU(NY,NX),NY,NX)=XFE2FS(3,NU(NY,NX),NY,NX)+RFLFE2+DFVFE2 - XFE3FS(3,NU(NY,NX),NY,NX)=XFE3FS(3,NU(NY,NX),NY,NX)+RFLFE3+DFVFE3 - XFE4FS(3,NU(NY,NX),NY,NX)=XFE4FS(3,NU(NY,NX),NY,NX)+RFLFE4+DFVFE4 - XFESFS(3,NU(NY,NX),NY,NX)=XFESFS(3,NU(NY,NX),NY,NX)+RFLFES+DFVFES - XCAOFS(3,NU(NY,NX),NY,NX)=XCAOFS(3,NU(NY,NX),NY,NX)+RFLCAO+DFVCAO - XCACFS(3,NU(NY,NX),NY,NX)=XCACFS(3,NU(NY,NX),NY,NX)+RFLCAC+DFVCAC - XCAHFS(3,NU(NY,NX),NY,NX)=XCAHFS(3,NU(NY,NX),NY,NX)+RFLCAH+DFVCAH - XCASFS(3,NU(NY,NX),NY,NX)=XCASFS(3,NU(NY,NX),NY,NX)+RFLCAS+DFVCAS - XMGOFS(3,NU(NY,NX),NY,NX)=XMGOFS(3,NU(NY,NX),NY,NX)+RFLMGO+DFVMGO - XMGCFS(3,NU(NY,NX),NY,NX)=XMGCFS(3,NU(NY,NX),NY,NX)+RFLMGC+DFVMGC - XMGHFS(3,NU(NY,NX),NY,NX)=XMGHFS(3,NU(NY,NX),NY,NX)+RFLMGH+DFVMGH - XMGSFS(3,NU(NY,NX),NY,NX)=XMGSFS(3,NU(NY,NX),NY,NX)+RFLMGS+DFVMGS - XNACFS(3,NU(NY,NX),NY,NX)=XNACFS(3,NU(NY,NX),NY,NX)+RFLNAC+DFVNAC - XNASFS(3,NU(NY,NX),NY,NX)=XNASFS(3,NU(NY,NX),NY,NX)+RFLNAS+DFVNAS - XKASFS(3,NU(NY,NX),NY,NX)=XKASFS(3,NU(NY,NX),NY,NX)+RFLKAS+DFVKAS - XH0PFS(3,NU(NY,NX),NY,NX)=XH0PFS(3,NU(NY,NX),NY,NX)+RFLH0P+DFVH0P - XH1PFS(3,NU(NY,NX),NY,NX)=XH1PFS(3,NU(NY,NX),NY,NX)+RFLH1P+DFVH1P - XH3PFS(3,NU(NY,NX),NY,NX)=XH3PFS(3,NU(NY,NX),NY,NX)+RFLH3P+DFVH3P - XF1PFS(3,NU(NY,NX),NY,NX)=XF1PFS(3,NU(NY,NX),NY,NX)+RFLF1P+DFVF1P - XF2PFS(3,NU(NY,NX),NY,NX)=XF2PFS(3,NU(NY,NX),NY,NX)+RFLF2P+DFVF2P - XC0PFS(3,NU(NY,NX),NY,NX)=XC0PFS(3,NU(NY,NX),NY,NX)+RFLC0P+DFVC0P - XC1PFS(3,NU(NY,NX),NY,NX)=XC1PFS(3,NU(NY,NX),NY,NX)+RFLC1P+DFVC1P - XC2PFS(3,NU(NY,NX),NY,NX)=XC2PFS(3,NU(NY,NX),NY,NX)+RFLC2P+DFVC2P - XM1PFS(3,NU(NY,NX),NY,NX)=XM1PFS(3,NU(NY,NX),NY,NX)+RFLM1P+DFVM1P - XH0BFB(3,NU(NY,NX),NY,NX)=XH0BFB(3,NU(NY,NX),NY,NX)+RFLH0B+DFVH0B - XH1BFB(3,NU(NY,NX),NY,NX)=XH1BFB(3,NU(NY,NX),NY,NX)+RFLH1B+DFVH1B - XH3BFB(3,NU(NY,NX),NY,NX)=XH3BFB(3,NU(NY,NX),NY,NX)+RFLH3B+DFVH3B - XF1BFB(3,NU(NY,NX),NY,NX)=XF1BFB(3,NU(NY,NX),NY,NX)+RFLF1B+DFVF1B - XF2BFB(3,NU(NY,NX),NY,NX)=XF2BFB(3,NU(NY,NX),NY,NX)+RFLF2B+DFVF2B - XC0BFB(3,NU(NY,NX),NY,NX)=XC0BFB(3,NU(NY,NX),NY,NX)+RFLC0B+DFVC0B - XC1BFB(3,NU(NY,NX),NY,NX)=XC1BFB(3,NU(NY,NX),NY,NX)+RFLC1B+DFVC1B - XC2BFB(3,NU(NY,NX),NY,NX)=XC2BFB(3,NU(NY,NX),NY,NX)+RFLC2B+DFVC2B - XM1BFB(3,NU(NY,NX),NY,NX)=XM1BFB(3,NU(NY,NX),NY,NX)+RFLM1B+DFVM1B + XAL1FS(3,NU(NY,NX),NY,NX)=XAL1FS(3,NU(NY,NX),NY,NX) + 2+RFLAL1+DFVAL1 + XAL2FS(3,NU(NY,NX),NY,NX)=XAL2FS(3,NU(NY,NX),NY,NX) + 2+RFLAL2+DFVAL2 + XAL3FS(3,NU(NY,NX),NY,NX)=XAL3FS(3,NU(NY,NX),NY,NX) + 2+RFLAL3+DFVAL3 + XAL4FS(3,NU(NY,NX),NY,NX)=XAL4FS(3,NU(NY,NX),NY,NX) + 2+RFLAL4+DFVAL4 + XALSFS(3,NU(NY,NX),NY,NX)=XALSFS(3,NU(NY,NX),NY,NX) + 2+RFLALS+DFVALS + XFE1FS(3,NU(NY,NX),NY,NX)=XFE1FS(3,NU(NY,NX),NY,NX) + 2+RFLFE1+DFVFE1 + XFE2FS(3,NU(NY,NX),NY,NX)=XFE2FS(3,NU(NY,NX),NY,NX) + 2+RFLFE2+DFVFE2 + XFE3FS(3,NU(NY,NX),NY,NX)=XFE3FS(3,NU(NY,NX),NY,NX) + 2+RFLFE3+DFVFE3 + XFE4FS(3,NU(NY,NX),NY,NX)=XFE4FS(3,NU(NY,NX),NY,NX) + 2+RFLFE4+DFVFE4 + XFESFS(3,NU(NY,NX),NY,NX)=XFESFS(3,NU(NY,NX),NY,NX) + 2+RFLFES+DFVFES + XCAOFS(3,NU(NY,NX),NY,NX)=XCAOFS(3,NU(NY,NX),NY,NX) + 2+RFLCAO+DFVCAO + XCACFS(3,NU(NY,NX),NY,NX)=XCACFS(3,NU(NY,NX),NY,NX) + 2+RFLCAC+DFVCAC + XCAHFS(3,NU(NY,NX),NY,NX)=XCAHFS(3,NU(NY,NX),NY,NX) + 2+RFLCAH+DFVCAH + XCASFS(3,NU(NY,NX),NY,NX)=XCASFS(3,NU(NY,NX),NY,NX) + 2+RFLCAS+DFVCAS + XMGOFS(3,NU(NY,NX),NY,NX)=XMGOFS(3,NU(NY,NX),NY,NX) + 2+RFLMGO+DFVMGO + XMGCFS(3,NU(NY,NX),NY,NX)=XMGCFS(3,NU(NY,NX),NY,NX) + 2+RFLMGC+DFVMGC + XMGHFS(3,NU(NY,NX),NY,NX)=XMGHFS(3,NU(NY,NX),NY,NX) + 2+RFLMGH+DFVMGH + XMGSFS(3,NU(NY,NX),NY,NX)=XMGSFS(3,NU(NY,NX),NY,NX) + 2+RFLMGS+DFVMGS + XNACFS(3,NU(NY,NX),NY,NX)=XNACFS(3,NU(NY,NX),NY,NX) + 2+RFLNAC+DFVNAC + XNASFS(3,NU(NY,NX),NY,NX)=XNASFS(3,NU(NY,NX),NY,NX) + 2+RFLNAS+DFVNAS + XKASFS(3,NU(NY,NX),NY,NX)=XKASFS(3,NU(NY,NX),NY,NX) + 2+RFLKAS+DFVKAS + XH0PFS(3,NU(NY,NX),NY,NX)=XH0PFS(3,NU(NY,NX),NY,NX) + 2+RFLH0P+DFVH0P + XH3PFS(3,NU(NY,NX),NY,NX)=XH3PFS(3,NU(NY,NX),NY,NX) + 2+RFLH3P+DFVH3P + XF1PFS(3,NU(NY,NX),NY,NX)=XF1PFS(3,NU(NY,NX),NY,NX) + 2+RFLF1P+DFVF1P + XF2PFS(3,NU(NY,NX),NY,NX)=XF2PFS(3,NU(NY,NX),NY,NX) + 2+RFLF2P+DFVF2P + XC0PFS(3,NU(NY,NX),NY,NX)=XC0PFS(3,NU(NY,NX),NY,NX) + 2+RFLC0P+DFVC0P + XC1PFS(3,NU(NY,NX),NY,NX)=XC1PFS(3,NU(NY,NX),NY,NX) + 2+RFLC1P+DFVC1P + XC2PFS(3,NU(NY,NX),NY,NX)=XC2PFS(3,NU(NY,NX),NY,NX) + 2+RFLC2P+DFVC2P + XM1PFS(3,NU(NY,NX),NY,NX)=XM1PFS(3,NU(NY,NX),NY,NX) + 2+RFLM1P+DFVM1P + XH0BFB(3,NU(NY,NX),NY,NX)=XH0BFB(3,NU(NY,NX),NY,NX) + 2+RFLH0B+DFVH0B + XH3BFB(3,NU(NY,NX),NY,NX)=XH3BFB(3,NU(NY,NX),NY,NX) + 2+RFLH3B+DFVH3B + XF1BFB(3,NU(NY,NX),NY,NX)=XF1BFB(3,NU(NY,NX),NY,NX) + 2+RFLF1B+DFVF1B + XF2BFB(3,NU(NY,NX),NY,NX)=XF2BFB(3,NU(NY,NX),NY,NX) + 2+RFLF2B+DFVF2B + XC0BFB(3,NU(NY,NX),NY,NX)=XC0BFB(3,NU(NY,NX),NY,NX) + 2+RFLC0B+DFVC0B + XC1BFB(3,NU(NY,NX),NY,NX)=XC1BFB(3,NU(NY,NX),NY,NX) + 2+RFLC1B+DFVC1B + XC2BFB(3,NU(NY,NX),NY,NX)=XC2BFB(3,NU(NY,NX),NY,NX) + 2+RFLC2B+DFVC2B + XM1BFB(3,NU(NY,NX),NY,NX)=XM1BFB(3,NU(NY,NX),NY,NX) + 2+RFLM1B+DFVM1B C C MACROPORE-MICROPORE SOLUTE EXCHANGE IN SOIL C SURFACE LAYER FROM WATER EXCHANGE IN 'WATSUB' AND @@ -2321,8 +2295,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RFLNAS=VFLW*AMAX1(0.0,ZNASH2(NU(NY,NX),NY,NX)) RFLKAS=VFLW*AMAX1(0.0,ZKASH2(NU(NY,NX),NY,NX)) RFLH0P=VFLW*AMAX1(0.0,H0P4H2(NU(NY,NX),NY,NX)) - 2*VLPO4(NU(NY,NX),NY,NX) - RFLH1P=VFLW*AMAX1(0.0,H1P4H2(NU(NY,NX),NY,NX)) 2*VLPO4(NU(NY,NX),NY,NX) RFLH3P=VFLW*AMAX1(0.0,H3P4H2(NU(NY,NX),NY,NX)) 2*VLPO4(NU(NY,NX),NY,NX) @@ -2339,8 +2311,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RFLM1P=VFLW*AMAX1(0.0,ZM1PH2(NU(NY,NX),NY,NX)) 2*VLPO4(NU(NY,NX),NY,NX) RFLH0B=VFLW*AMAX1(0.0,H0PBH2(NU(NY,NX),NY,NX)) - 2*VLPOB(NU(NY,NX),NY,NX) - RFLH1B=VFLW*AMAX1(0.0,H1PBH2(NU(NY,NX),NY,NX)) 2*VLPOB(NU(NY,NX),NY,NX) RFLH3B=VFLW*AMAX1(0.0,H3PBH2(NU(NY,NX),NY,NX)) 2*VLPOB(NU(NY,NX),NY,NX) @@ -2400,8 +2370,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RFLNAS=VFLW*AMAX1(0.0,ZNAS2(NU(NY,NX),NY,NX)) RFLKAS=VFLW*AMAX1(0.0,ZKAS2(NU(NY,NX),NY,NX)) RFLH0P=VFLW*AMAX1(0.0,H0PO42(NU(NY,NX),NY,NX)) - 2*VLPO4(NU(NY,NX),NY,NX) - RFLH1P=VFLW*AMAX1(0.0,H1PO42(NU(NY,NX),NY,NX)) 2*VLPO4(NU(NY,NX),NY,NX) RFLH3P=VFLW*AMAX1(0.0,H3PO42(NU(NY,NX),NY,NX)) 2*VLPO4(NU(NY,NX),NY,NX) @@ -2418,8 +2386,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RFLM1P=VFLW*AMAX1(0.0,ZMG1P2(NU(NY,NX),NY,NX)) 2*VLPO4(NU(NY,NX),NY,NX) RFLH0B=VFLW*AMAX1(0.0,H0POB2(NU(NY,NX),NY,NX)) - 2*VLPOB(NU(NY,NX),NY,NX) - RFLH1B=VFLW*AMAX1(0.0,H1POB2(NU(NY,NX),NY,NX)) 2*VLPOB(NU(NY,NX),NY,NX) RFLH3B=VFLW*AMAX1(0.0,H3POB2(NU(NY,NX),NY,NX)) 2*VLPOB(NU(NY,NX),NY,NX) @@ -2473,7 +2439,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RFLNAS=0.0 RFLKAS=0.0 RFLH0P=0.0 - RFLH1P=0.0 RFLH3P=0.0 RFLF1P=0.0 RFLF2P=0.0 @@ -2482,7 +2447,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RFLC2P=0.0 RFLM1P=0.0 RFLH0B=0.0 - RFLH1B=0.0 RFLH3B=0.0 RFLF1B=0.0 RFLF2B=0.0 @@ -2494,136 +2458,176 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) C C DIFFUSIVE FLUXES OF SOLUTES BETWEEN MICROPORES AND C MACROPORES FROM AQUEOUS DIFFUSIVITIES AND CONCENTRATION DIFFERENCES -C -C -C DIFFUSIVE FLUXES OF SOLUTES BETWEEN MICROPORES AND -C MACROPORES FROM AQUEOUS DIFFUSIVITIES AND CONCENTRATION DIFFERENCES C IF(VOLWHM(M,NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN 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 - DFVAL=XNPX*(ZALH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZAL2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - DFVFE=XNPX*(ZFEH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZFE2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - DFVHY=XNPX*(ZHYH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZHY2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - DFVCA=XNPX*(ZCCH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZCA2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - DFVMG=XNPX*(ZMAH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZMG2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - DFVNA=XNPX*(ZNAH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZNA2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - DFVKA=XNPX*(ZKAH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZKA2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - DFVOH=XNPX*(ZOHH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZOH2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - DFVSO=XNPX*(ZSO4H2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZSO42(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - DFVCL=XNPX*(ZCLH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZCL2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - DFVC3=XNPX*(ZCO3H2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZCO32(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - DFVHC=XNPX*(ZHCOH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZHCO32(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - DFVAL1=XNPX*(ZAL1H2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZAL12(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - DFVAL2=XNPX*(ZAL2H2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZAL22(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - DFVAL3=XNPX*(ZAL3H2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZAL32(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - DFVAL4=XNPX*(ZAL4H2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZAL42(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - DFVALS=XNPX*(ZALSH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZALS2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - DFVFE1=XNPX*(ZFE1H2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZFE12(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - DFVF22=XNPX*(ZFE2H2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZFE22(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - DFVFE3=XNPX*(ZFE3H2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZFE32(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - DFVFE4=XNPX*(ZFE4H2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZFE42(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - DFVFES=XNPX*(ZFESH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZFES2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - DFVCAO=XNPX*(ZCAOH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZCAO2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - DFVCAC=XNPX*(ZCACH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZCAC2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - DFVCAH=XNPX*(ZCAHH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZCAH2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - DFVCAS=XNPX*(ZCASH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZCAS2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - DFVMGO=XNPX*(ZMGOH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZMGO2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - DFVMGC=XNPX*(ZMGCH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZMGC2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - DFVMGH=XNPX*(ZMGHH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZMGH2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - DFVMGS=XNPX*(ZMGSH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZMGS2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - DFVNAC=XNPX*(ZNACH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZNAC2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - DFVNAS=XNPX*(ZNASH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZNAS2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - DFVKAS=XNPX*(ZKASH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZKAS2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - DFVNAC=XNPX*(ZNACH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZNAC2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - DFVH0P=XNPX*(H0P4H2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-H0PO42(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT + DFVAL=XNPX*(AMAX1(0.0,ZALH2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,ZAL2(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT + DFVFE=XNPX*(AMAX1(0.0,ZFEH2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,ZFE2(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT + DFVHY=XNPX*(AMAX1(0.0,ZHYH2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,ZHY2(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT + DFVCA=XNPX*(AMAX1(0.0,ZCCH2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,ZCA2(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT + DFVMG=XNPX*(AMAX1(0.0,ZMAH2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,ZMG2(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT + DFVNA=XNPX*(AMAX1(0.0,ZNAH2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,ZNA2(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT + DFVKA=XNPX*(AMAX1(0.0,ZKAH2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,ZKA2(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT + DFVOH=XNPX*(AMAX1(0.0,ZOHH2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,ZOH2(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT + DFVSO=XNPX*(AMAX1(0.0,ZSO4H2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,ZSO42(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT + DFVCL=XNPX*(AMAX1(0.0,ZCLH2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,ZCL2(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT + DFVC3=XNPX*(AMAX1(0.0,ZCO3H2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,ZCO32(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT + DFVHC=XNPX*(AMAX1(0.0,ZHCOH2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,ZHCO32(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT + DFVAL1=XNPX*(AMAX1(0.0,ZAL1H2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,ZAL12(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT + DFVAL2=XNPX*(AMAX1(0.0,ZAL2H2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,ZAL22(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT + DFVAL3=XNPX*(AMAX1(0.0,ZAL3H2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,ZAL32(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT + DFVAL4=XNPX*(AMAX1(0.0,ZAL4H2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,ZAL42(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT + DFVALS=XNPX*(AMAX1(0.0,ZALSH2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,ZALS2(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT + DFVFE1=XNPX*(AMAX1(0.0,ZFE1H2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,ZFE12(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT + DFVF22=XNPX*(AMAX1(0.0,ZFE2H2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,ZFE22(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT + DFVFE3=XNPX*(AMAX1(0.0,ZFE3H2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,ZFE32(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT + DFVFE4=XNPX*(AMAX1(0.0,ZFE4H2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,ZFE42(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT + DFVFES=XNPX*(AMAX1(0.0,ZFESH2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,ZFES2(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT + DFVCAO=XNPX*(AMAX1(0.0,ZCAOH2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,ZCAO2(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT + DFVCAC=XNPX*(AMAX1(0.0,ZCACH2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,ZCAC2(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT + DFVCAH=XNPX*(AMAX1(0.0,ZCAHH2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,ZCAH2(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT + DFVCAS=XNPX*(AMAX1(0.0,ZCASH2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,ZCAS2(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT + DFVMGO=XNPX*(AMAX1(0.0,ZMGOH2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,ZMGO2(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT + DFVMGC=XNPX*(AMAX1(0.0,ZMGCH2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,ZMGC2(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT + DFVMGH=XNPX*(AMAX1(0.0,ZMGHH2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,ZMGH2(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT + DFVMGS=XNPX*(AMAX1(0.0,ZMGSH2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,ZMGS2(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT + DFVNAC=XNPX*(AMAX1(0.0,ZNACH2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,ZNAC2(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT + DFVNAS=XNPX*(AMAX1(0.0,ZNASH2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,ZNAS2(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT + DFVKAS=XNPX*(AMAX1(0.0,ZKASH2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,ZKAS2(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT + DFVNAC=XNPX*(AMAX1(0.0,ZNACH2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,ZNAC2(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT + DFVH0P=XNPX*(AMAX1(0.0,H0P4H2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,H0PO42(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT 2*VLPO4(NU(NY,NX),NY,NX) - DFVH1P=XNPX*(H1P4H2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-H1PO42(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT + DFVH3P=XNPX*(AMAX1(0.0,H3P4H2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,H3PO42(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT 2*VLPO4(NU(NY,NX),NY,NX) - DFVH3P=XNPX*(H3P4H2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-H3PO42(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT + DFVF1P=XNPX*(AMAX1(0.0,ZF1PH2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,ZFE1P2(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT 2*VLPO4(NU(NY,NX),NY,NX) - DFVF1P=XNPX*(ZF1PH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZFE1P2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT + DFVF2P=XNPX*(AMAX1(0.0,ZF2PH2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,ZFE2P2(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT 2*VLPO4(NU(NY,NX),NY,NX) - DFVF2P=XNPX*(ZF2PH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZFE2P2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT + DFVC0P=XNPX*(AMAX1(0.0,ZC0PH2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,ZCA0P2(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT 2*VLPO4(NU(NY,NX),NY,NX) - DFVC0P=XNPX*(ZC0PH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZCA0P2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT + DFVC1P=XNPX*(AMAX1(0.0,ZC1PH2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,ZCA1P2(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT 2*VLPO4(NU(NY,NX),NY,NX) - DFVC1P=XNPX*(ZC1PH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZCA1P2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT + DFVC2P=XNPX*(AMAX1(0.0,ZC2PH2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,ZCA2P2(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT 2*VLPO4(NU(NY,NX),NY,NX) - DFVC2P=XNPX*(ZC2PH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZCA2P2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT + DFVM1P=XNPX*(AMAX1(0.0,ZM1PH2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,ZMG1P2(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT 2*VLPO4(NU(NY,NX),NY,NX) - DFVM1P=XNPX*(ZM1PH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZMG1P2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - 2*VLPO4(NU(NY,NX),NY,NX) - DFVH0B=XNPX*(H0PBH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-H0POB2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT - 2*VLPOB(NU(NY,NX),NY,NX) - DFVH1B=XNPX*(H1PBH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-H1POB2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT + DFVH0B=XNPX*(AMAX1(0.0,H0PBH2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,H0POB2(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT 2*VLPOB(NU(NY,NX),NY,NX) - DFVH3B=XNPX*(H3PBH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-H3POB2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT + DFVH3B=XNPX*(AMAX1(0.0,H3PBH2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,H3POB2(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT 2*VLPOB(NU(NY,NX),NY,NX) - DFVF1B=XNPX*(ZF1BH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZF1PB2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT + DFVF1B=XNPX*(AMAX1(0.0,ZF1BH2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,ZF1PB2(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT 2*VLPOB(NU(NY,NX),NY,NX) - DFVF2B=XNPX*(ZF2BH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZF2PB2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT + DFVF2B=XNPX*(AMAX1(0.0,ZF2BH2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,ZF2PB2(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT 2*VLPOB(NU(NY,NX),NY,NX) - DFVC0B=XNPX*(ZC0BH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZC0PB2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT + DFVC0B=XNPX*(AMAX1(0.0,ZC0BH2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,ZC0PB2(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT 2*VLPOB(NU(NY,NX),NY,NX) - DFVC1B=XNPX*(ZC1BH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZC1PB2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT + DFVC1B=XNPX*(AMAX1(0.0,ZC1BH2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,ZC1PB2(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT 2*VLPOB(NU(NY,NX),NY,NX) - DFVC2B=XNPX*(ZC2BH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZC2PB2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT + DFVC2B=XNPX*(AMAX1(0.0,ZC2BH2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,ZC2PB2(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT 2*VLPOB(NU(NY,NX),NY,NX) - DFVM1B=XNPX*(ZM1BH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZM1PB2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT + DFVM1B=XNPX*(AMAX1(0.0,ZM1BH2(NU(NY,NX),NY,NX)) + 2*VOLWM(M,NU(NY,NX),NY,NX) + 2-AMAX1(0.0,ZM1PB2(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT 2*VLPOB(NU(NY,NX),NY,NX) ELSE DFVAL=0.0 @@ -2660,7 +2664,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) DFVNAS=0.0 DFVKAS=0.0 DFVH0P=0.0 - DFVH1P=0.0 DFVH3P=0.0 DFVF1P=0.0 DFVF2P=0.0 @@ -2669,7 +2672,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) DFVC2P=0.0 DFVM1P=0.0 DFVH0B=0.0 - DFVH1B=0.0 DFVH3B=0.0 DFVF1B=0.0 DFVF2B=0.0 @@ -2715,7 +2717,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RNASXS(NU(NY,NX),NY,NX)=RFLNAS+DFVNAS RKASXS(NU(NY,NX),NY,NX)=RFLKAS+DFVKAS RH0PXS(NU(NY,NX),NY,NX)=RFLH0P+DFVH0P - RH1PXS(NU(NY,NX),NY,NX)=RFLH1P+DFVH1P RH3PXS(NU(NY,NX),NY,NX)=RFLH3P+DFVH3P RF1PXS(NU(NY,NX),NY,NX)=RFLF1P+DFVF1P RF2PXS(NU(NY,NX),NY,NX)=RFLF2P+DFVF2P @@ -2724,7 +2725,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RC2PXS(NU(NY,NX),NY,NX)=RFLC2P+DFVC2P RM1PXS(NU(NY,NX),NY,NX)=RFLM1P+DFVM1P RH0BXB(NU(NY,NX),NY,NX)=RFLH0B+DFVH0B - RH1BXB(NU(NY,NX),NY,NX)=RFLH1B+DFVH1B RH3BXB(NU(NY,NX),NY,NX)=RFLH3B+DFVH3B RF1BXB(NU(NY,NX),NY,NX)=RFLF1B+DFVF1B RF2BXB(NU(NY,NX),NY,NX)=RFLF2B+DFVF2B @@ -2800,8 +2800,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) 2+RKASXS(NU(NY,NX),NY,NX) XH0PXS(NU(NY,NX),NY,NX)=XH0PXS(NU(NY,NX),NY,NX) 2+RH0PXS(NU(NY,NX),NY,NX) - XH1PXS(NU(NY,NX),NY,NX)=XH1PXS(NU(NY,NX),NY,NX) - 2+RH1PXS(NU(NY,NX),NY,NX) XH3PXS(NU(NY,NX),NY,NX)=XH3PXS(NU(NY,NX),NY,NX) 2+RH3PXS(NU(NY,NX),NY,NX) XF1PXS(NU(NY,NX),NY,NX)=XF1PXS(NU(NY,NX),NY,NX) @@ -2818,8 +2816,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) 2+RM1PXS(NU(NY,NX),NY,NX) XH0BXB(NU(NY,NX),NY,NX)=XH0BXB(NU(NY,NX),NY,NX) 2+RH0BXB(NU(NY,NX),NY,NX) - XH1BXB(NU(NY,NX),NY,NX)=XH1BXB(NU(NY,NX),NY,NX) - 2+RH1BXB(NU(NY,NX),NY,NX) XH3BXB(NU(NY,NX),NY,NX)=XH3BXB(NU(NY,NX),NY,NX) 2+RH3BXB(NU(NY,NX),NY,NX) XF1BXB(NU(NY,NX),NY,NX)=XF1BXB(NU(NY,NX),NY,NX) @@ -2898,7 +2894,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RQRNAS(N,N5,N4)=0.0 RQRKAS(N,N5,N4)=0.0 RQRH0P(N,N5,N4)=0.0 - RQRH1P(N,N5,N4)=0.0 RQRH3P(N,N5,N4)=0.0 RQRF1P(N,N5,N4)=0.0 RQRF2P(N,N5,N4)=0.0 @@ -2907,7 +2902,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RQRC2P(N,N5,N4)=0.0 RQRM1P(N,N5,N4)=0.0 RQRH0B(N,N5,N4)=0.0 - RQRH1B(N,N5,N4)=0.0 RQRH3B(N,N5,N4)=0.0 RQRF1B(N,N5,N4)=0.0 RQRF2B(N,N5,N4)=0.0 @@ -2959,7 +2953,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RQRNAS(N,N5,N4)=VFLW*AMAX1(0.0,ZNAS2(0,N2,N1)) RQRKAS(N,N5,N4)=VFLW*AMAX1(0.0,ZKAS2(0,N2,N1)) RQRH0P(N,N5,N4)=VFLW*AMAX1(0.0,H0PO42(0,N2,N1)) - RQRH1P(N,N5,N4)=VFLW*AMAX1(0.0,H1PO42(0,N2,N1)) RQRH3P(N,N5,N4)=VFLW*AMAX1(0.0,H3PO42(0,N2,N1)) RQRF1P(N,N5,N4)=VFLW*AMAX1(0.0,ZFE1P2(0,N2,N1)) RQRF2P(N,N5,N4)=VFLW*AMAX1(0.0,ZFE2P2(0,N2,N1)) @@ -3011,7 +3004,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RQRNAS(N,N5,N4)=VFLW*AMAX1(0.0,ZNAS2(0,N5,N4)) RQRKAS(N,N5,N4)=VFLW*AMAX1(0.0,ZKAS2(0,N5,N4)) RQRH0P(N,N5,N4)=VFLW*AMAX1(0.0,H0PO42(0,N5,N4)) - RQRH1P(N,N5,N4)=VFLW*AMAX1(0.0,H1PO42(0,N5,N4)) RQRH3P(N,N5,N4)=VFLW*AMAX1(0.0,H3PO42(0,N5,N4)) RQRF1P(N,N5,N4)=VFLW*AMAX1(0.0,ZFE1P2(0,N5,N4)) RQRF2P(N,N5,N4)=VFLW*AMAX1(0.0,ZFE2P2(0,N5,N4)) @@ -3057,7 +3049,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) XQRNAS(N,N5,N4)=XQRNAS(N,N5,N4)+RQRNAS(N,N5,N4) XQRKAS(N,N5,N4)=XQRKAS(N,N5,N4)+RQRKAS(N,N5,N4) XQRH0P(N,N5,N4)=XQRH0P(N,N5,N4)+RQRH0P(N,N5,N4) - XQRH1P(N,N5,N4)=XQRH1P(N,N5,N4)+RQRH1P(N,N5,N4) XQRH3P(N,N5,N4)=XQRH3P(N,N5,N4)+RQRH3P(N,N5,N4) XQRF1P(N,N5,N4)=XQRF1P(N,N5,N4)+RQRF1P(N,N5,N4) XQRF2P(N,N5,N4)=XQRF2P(N,N5,N4)+RQRF2P(N,N5,N4) @@ -3103,7 +3094,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RQSNAS(N,N5,N4)=0.0 RQSKAS(N,N5,N4)=0.0 RQSH0P(N,N5,N4)=0.0 - RQSH1P(N,N5,N4)=0.0 RQSH3P(N,N5,N4)=0.0 RQSF1P(N,N5,N4)=0.0 RQSF2P(N,N5,N4)=0.0 @@ -3154,7 +3144,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RQSNAS(N,N5,N4)=VFLW*AMAX1(0.0,ZNASW2(N2,N1)) RQSKAS(N,N5,N4)=VFLW*AMAX1(0.0,ZKASW2(N2,N1)) RQSH0P(N,N5,N4)=VFLW*AMAX1(0.0,H0PO4W2(N2,N1)) - RQSH1P(N,N5,N4)=VFLW*AMAX1(0.0,H1PO4W2(N2,N1)) RQSH3P(N,N5,N4)=VFLW*AMAX1(0.0,H3PO4W2(N2,N1)) RQSF1P(N,N5,N4)=VFLW*AMAX1(0.0,ZFE1PW2(N2,N1)) RQSF2P(N,N5,N4)=VFLW*AMAX1(0.0,ZFE2PW2(N2,N1)) @@ -3205,7 +3194,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RQSNAS(N,N5,N4)=VFLW*AMAX1(0.0,ZNASW2(N5,N4)) RQSKAS(N,N5,N4)=VFLW*AMAX1(0.0,ZKASW2(N5,N4)) RQSH0P(N,N5,N4)=VFLW*AMAX1(0.0,H0PO4W2(N5,N4)) - RQSH1P(N,N5,N4)=VFLW*AMAX1(0.0,H1PO4W2(N5,N4)) RQSH3P(N,N5,N4)=VFLW*AMAX1(0.0,H3PO4W2(N5,N4)) RQSF1P(N,N5,N4)=VFLW*AMAX1(0.0,ZFE1PW2(N5,N4)) RQSF2P(N,N5,N4)=VFLW*AMAX1(0.0,ZFE2PW2(N5,N4)) @@ -3251,7 +3239,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) XQSNAS(N,N5,N4)=XQSNAS(N,N5,N4)+RQSNAS(N,N5,N4) XQSKAS(N,N5,N4)=XQSKAS(N,N5,N4)+RQSKAS(N,N5,N4) XQSH0P(N,N5,N4)=XQSH0P(N,N5,N4)+RQSH0P(N,N5,N4) - XQSH1P(N,N5,N4)=XQSH1P(N,N5,N4)+RQSH1P(N,N5,N4) XQSH3P(N,N5,N4)=XQSH3P(N,N5,N4)+RQSH3P(N,N5,N4) XQSF1P(N,N5,N4)=XQSF1P(N,N5,N4)+RQSF1P(N,N5,N4) XQSF2P(N,N5,N4)=XQSF2P(N,N5,N4)+RQSF2P(N,N5,N4) @@ -3356,7 +3343,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RFLNAS=VFLW*AMAX1(0.0,ZNAS2(N3,N2,N1)) RFLKAS=VFLW*AMAX1(0.0,ZKAS2(N3,N2,N1)) RFLH0P=VFLW*AMAX1(0.0,H0PO42(N3,N2,N1))*VLPO4(N3,N2,N1) - RFLH1P=VFLW*AMAX1(0.0,H1PO42(N3,N2,N1))*VLPO4(N3,N2,N1) RFLH3P=VFLW*AMAX1(0.0,H3PO42(N3,N2,N1))*VLPO4(N3,N2,N1) RFLF1P=VFLW*AMAX1(0.0,ZFE1P2(N3,N2,N1))*VLPO4(N3,N2,N1) RFLF2P=VFLW*AMAX1(0.0,ZFE2P2(N3,N2,N1))*VLPO4(N3,N2,N1) @@ -3365,7 +3351,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RFLC2P=VFLW*AMAX1(0.0,ZCA2P2(N3,N2,N1))*VLPO4(N3,N2,N1) RFLM1P=VFLW*AMAX1(0.0,ZMG1P2(N3,N2,N1))*VLPO4(N3,N2,N1) RFLH0B=VFLW*AMAX1(0.0,H0POB2(N3,N2,N1))*VLPOB(N3,N2,N1) - RFLH1B=VFLW*AMAX1(0.0,H1POB2(N3,N2,N1))*VLPOB(N3,N2,N1) RFLH3B=VFLW*AMAX1(0.0,H3POB2(N3,N2,N1))*VLPOB(N3,N2,N1) RFLF1B=VFLW*AMAX1(0.0,ZF1PB2(N3,N2,N1))*VLPOB(N3,N2,N1) RFLF2B=VFLW*AMAX1(0.0,ZF2PB2(N3,N2,N1))*VLPOB(N3,N2,N1) @@ -3420,7 +3405,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RFLNAS=VFLW*AMAX1(0.0,ZNAS2(N6,N5,N4)) RFLKAS=VFLW*AMAX1(0.0,ZKAS2(N6,N5,N4)) RFLH0P=VFLW*AMAX1(0.0,H0PO42(N6,N5,N4)) - RFLH1P=VFLW*AMAX1(0.0,H1PO42(N6,N5,N4)) RFLH3P=VFLW*AMAX1(0.0,H3PO42(N6,N5,N4)) RFLF1P=VFLW*AMAX1(0.0,ZFE1P2(N6,N5,N4)) RFLF2P=VFLW*AMAX1(0.0,ZFE2P2(N6,N5,N4)) @@ -3429,7 +3413,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RFLC2P=VFLW*AMAX1(0.0,ZCA2P2(N6,N5,N4)) RFLM1P=VFLW*AMAX1(0.0,ZMG1P2(N6,N5,N4)) RFLH0B=VFLW*AMAX1(0.0,H0POB2(N6,N5,N4)) - RFLH1B=VFLW*AMAX1(0.0,H1POB2(N6,N5,N4)) RFLH3B=VFLW*AMAX1(0.0,H3POB2(N6,N5,N4)) RFLF1B=VFLW*AMAX1(0.0,ZF1PB2(N6,N5,N4)) RFLF2B=VFLW*AMAX1(0.0,ZF2PB2(N6,N5,N4)) @@ -3488,7 +3471,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) CKAS1=AMAX1(0.0,ZKAS2(N3,N2,N1)/VOLWM(M,N3,N2,N1)) IF(VLWPA1.GT.ZEROS(N2,N1))THEN C0PO41=AMAX1(0.0,H0PO42(N3,N2,N1)/VLWPA1) - C1PO41=AMAX1(0.0,H1PO42(N3,N2,N1)/VLWPA1) C3PO41=AMAX1(0.0,H3PO42(N3,N2,N1)/VLWPA1) CFE1P1=AMAX1(0.0,ZFE1P2(N3,N2,N1)/VLWPA1) CFE2P1=AMAX1(0.0,ZFE2P2(N3,N2,N1)/VLWPA1) @@ -3498,7 +3480,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) CMG1P1=AMAX1(0.0,ZMG1P2(N3,N2,N1)/VLWPA1) ELSE C0PO41=0.0 - C1PO41=0.0 C3PO41=0.0 CFE1P1=0.0 CFE2P1=0.0 @@ -3509,7 +3490,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) ENDIF IF(VLWPB1.GT.ZEROS(N2,N1))THEN C0POB1=AMAX1(0.0,H0POB2(N3,N2,N1)/VLWPB1) - C1POB1=AMAX1(0.0,H1POB2(N3,N2,N1)/VLWPB1) C3POB1=AMAX1(0.0,H3POB2(N3,N2,N1)/VLWPB1) CF1PB1=AMAX1(0.0,ZF1PB2(N3,N2,N1)/VLWPB1) CF2PB1=AMAX1(0.0,ZF2PB2(N3,N2,N1)/VLWPB1) @@ -3519,7 +3499,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) CM1PB1=AMAX1(0.0,ZM1PB2(N3,N2,N1)/VLWPB1) ELSE C0POB1=C0PO41 - C1POB1=C1PO41 C3POB1=C3PO41 CF1PB1=CFE1P1 CF2PB1=CFE2P1 @@ -3563,7 +3542,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) CKAS2=AMAX1(0.0,ZKAS2(N6,N5,N4)/VOLWM(M,N6,N5,N4)) IF(VLWPA2.GT.ZEROS(N5,N4))THEN C0PO42=AMAX1(0.0,H0PO42(N6,N5,N4)/VOLWM(M,N6,N5,N4)) - C1PO42=AMAX1(0.0,H1PO42(N6,N5,N4)/VOLWM(M,N6,N5,N4)) C3PO42=AMAX1(0.0,H3PO42(N6,N5,N4)/VOLWM(M,N6,N5,N4)) CFE1P2=AMAX1(0.0,ZFE1P2(N6,N5,N4)/VOLWM(M,N6,N5,N4)) CFE2P2=AMAX1(0.0,ZFE2P2(N6,N5,N4)/VOLWM(M,N6,N5,N4)) @@ -3573,7 +3551,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) CMG1P2=AMAX1(0.0,ZMG1P2(N6,N5,N4)/VOLWM(M,N6,N5,N4)) ELSE C0PO42=0.0 - C1PO42=0.0 C3PO42=0.0 CFE1P2=0.0 CFE2P2=0.0 @@ -3584,7 +3561,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) ENDIF IF(VLWPB2.GT.ZEROS(N5,N4))THEN C0POB2=AMAX1(0.0,H0POB2(N6,N5,N4)/VOLWM(M,N6,N5,N4)) - C1POB2=AMAX1(0.0,H1POB2(N6,N5,N4)/VOLWM(M,N6,N5,N4)) C3POB2=AMAX1(0.0,H3POB2(N6,N5,N4)/VOLWM(M,N6,N5,N4)) CF1PB2=AMAX1(0.0,ZF1PB2(N6,N5,N4)/VOLWM(M,N6,N5,N4)) CF2PB2=AMAX1(0.0,ZF2PB2(N6,N5,N4)/VOLWM(M,N6,N5,N4)) @@ -3594,7 +3570,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) CM1PB2=AMAX1(0.0,ZM1PB2(N6,N5,N4)/VOLWM(M,N6,N5,N4)) ELSE C0POB2=C0PO42 - C1POB2=C1PO42 C3POB2=C3PO42 CF1PB2=CFE1P2 CF2PB2=CFE2P2 @@ -3662,7 +3637,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) C MICROPORES C DFVH0P=DIFPO*(C0PO41-C0PO42)*VLPO4(N6,N5,N4) - DFVH1P=DIFPO*(C1PO41-C1PO42)*VLPO4(N6,N5,N4) DFVH3P=DIFPO*(C3PO41-C3PO42)*VLPO4(N6,N5,N4) DFVF1P=DIFPO*(CFE1P1-CFE1P2)*VLPO4(N6,N5,N4) DFVF2P=DIFPO*(CFE2P1-CFE2P2)*VLPO4(N6,N5,N4) @@ -3671,7 +3645,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) DFVC2P=DIFPO*(CCA2P1-CCA2P2)*VLPO4(N6,N5,N4) DFVM1P=DIFPO*(CMG1P1-CMG1P2)*VLPO4(N6,N5,N4) DFVH0B=DIFPO*(C0POB1-C0POB2)*VLPOB(N6,N5,N4) - DFVH1B=DIFPO*(C1POB1-C1POB2)*VLPOB(N6,N5,N4) DFVH3B=DIFPO*(C3POB1-C3POB2)*VLPOB(N6,N5,N4) DFVF1B=DIFPO*(CF1PB1-CF1PB2)*VLPOB(N6,N5,N4) DFVF2B=DIFPO*(CF2PB1-CF2PB2)*VLPOB(N6,N5,N4) @@ -3714,7 +3687,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) DFVNAS=0.0 DFVKAS=0.0 DFVH0P=0.0 - DFVH1P=0.0 DFVH3P=0.0 DFVF1P=0.0 DFVF2P=0.0 @@ -3723,7 +3695,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) DFVC2P=0.0 DFVM1P=0.0 DFVH0B=0.0 - DFVH1B=0.0 DFVH3B=0.0 DFVF1B=0.0 DFVF2B=0.0 @@ -3820,8 +3791,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) 2-AMIN1(0.0,RKASXS(NU(N2,N1),N2,N1)))) RFHH0P=VFLW*AMAX1(0.0,(H0P4H2(N3,N2,N1) 2-AMIN1(0.0,RH0PXS(NU(N2,N1),N2,N1))))*VLPO4(N3,N2,N1) - RFHH1P=VFLW*AMAX1(0.0,(H1P4H2(N3,N2,N1) - 2-AMIN1(0.0,RH1PXS(NU(N2,N1),N2,N1))))*VLPO4(N3,N2,N1) RFHH3P=VFLW*AMAX1(0.0,(H3P4H2(N3,N2,N1) 2-AMIN1(0.0,RH3PXS(NU(N2,N1),N2,N1))))*VLPO4(N3,N2,N1) RFHF1P=VFLW*AMAX1(0.0,(ZF1PH2(N3,N2,N1) @@ -3838,8 +3807,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) 2-AMIN1(0.0,RM1PXS(NU(N2,N1),N2,N1))))*VLPO4(N3,N2,N1) RFHH0B=VFLW*AMAX1(0.0,(H0PBH2(N3,N2,N1) 2-AMIN1(0.0,RH0BXB(NU(N2,N1),N2,N1))))*VLPOB(N3,N2,N1) - RFHH1B=VFLW*AMAX1(0.0,(H1PBH2(N3,N2,N1) - 2-AMIN1(0.0,RH1BXB(NU(N2,N1),N2,N1))))*VLPOB(N3,N2,N1) RFHH3B=VFLW*AMAX1(0.0,(H3PBH2(N3,N2,N1) 2-AMIN1(0.0,RH3BXB(NU(N2,N1),N2,N1))))*VLPOB(N3,N2,N1) RFHF1B=VFLW*AMAX1(0.0,(ZF1BH2(N3,N2,N1) @@ -3892,7 +3859,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RFHNAS=VFLW*AMAX1(0.0,ZNASH2(N3,N2,N1)) RFHKAS=VFLW*AMAX1(0.0,ZKASH2(N3,N2,N1)) RFHH0P=VFLW*AMAX1(0.0,H0P4H2(N3,N2,N1))*VLPO4(N6,N5,N4) - RFHH1P=VFLW*AMAX1(0.0,H1P4H2(N3,N2,N1))*VLPO4(N6,N5,N4) RFHH3P=VFLW*AMAX1(0.0,H3P4H2(N3,N2,N1))*VLPO4(N6,N5,N4) RFHF1P=VFLW*AMAX1(0.0,ZF1PH2(N3,N2,N1))*VLPO4(N6,N5,N4) RFHF2P=VFLW*AMAX1(0.0,ZF2PH2(N3,N2,N1))*VLPO4(N6,N5,N4) @@ -3901,7 +3867,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RFHC2P=VFLW*AMAX1(0.0,ZC2PH2(N3,N2,N1))*VLPO4(N6,N5,N4) RFHM1P=VFLW*AMAX1(0.0,ZM1PH2(N3,N2,N1))*VLPO4(N6,N5,N4) RFHH0B=VFLW*AMAX1(0.0,H0PBH2(N3,N2,N1))*VLPOB(N6,N5,N4) - RFHH1B=VFLW*AMAX1(0.0,H1PBH2(N3,N2,N1))*VLPOB(N6,N5,N4) RFHH3B=VFLW*AMAX1(0.0,H3PBH2(N3,N2,N1))*VLPOB(N6,N5,N4) RFHF1B=VFLW*AMAX1(0.0,ZF1BH2(N3,N2,N1))*VLPOB(N6,N5,N4) RFHF2B=VFLW*AMAX1(0.0,ZF2BH2(N3,N2,N1))*VLPOB(N6,N5,N4) @@ -3957,7 +3922,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RFHNAS=VFLW*AMAX1(0.0,ZNASH2(N6,N5,N4)) RFHKAS=VFLW*AMAX1(0.0,ZKASH2(N6,N5,N4)) RFHH0P=VFLW*AMAX1(0.0,H0P4H2(N6,N5,N4))*VLPO4(N6,N5,N4) - RFHH1P=VFLW*AMAX1(0.0,H1P4H2(N6,N5,N4))*VLPO4(N6,N5,N4) RFHH3P=VFLW*AMAX1(0.0,H3P4H2(N6,N5,N4))*VLPO4(N6,N5,N4) RFHF1P=VFLW*AMAX1(0.0,ZF1PH2(N6,N5,N4))*VLPO4(N6,N5,N4) RFHF2P=VFLW*AMAX1(0.0,ZF2PH2(N6,N5,N4))*VLPO4(N6,N5,N4) @@ -3966,7 +3930,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RFHC2P=VFLW*AMAX1(0.0,ZC2PH2(N6,N5,N4))*VLPO4(N6,N5,N4) RFHM1P=VFLW*AMAX1(0.0,ZM1PH2(N6,N5,N4))*VLPO4(N6,N5,N4) RFHH0B=VFLW*AMAX1(0.0,H0PBH2(N6,N5,N4))*VLPOB(N6,N5,N4) - RFHH1B=VFLW*AMAX1(0.0,H1PBH2(N6,N5,N4))*VLPOB(N6,N5,N4) RFHH3B=VFLW*AMAX1(0.0,H3PBH2(N6,N5,N4))*VLPOB(N6,N5,N4) RFHF1B=VFLW*AMAX1(0.0,ZF1BH2(N6,N5,N4))*VLPOB(N6,N5,N4) RFHF2B=VFLW*AMAX1(0.0,ZF2BH2(N6,N5,N4))*VLPOB(N6,N5,N4) @@ -4012,7 +3975,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RFHNAS=0.0 RFHKAS=0.0 RFHH0P=0.0 - RFHH1P=0.0 RFHH3P=0.0 RFHF1P=0.0 RFHF2P=0.0 @@ -4021,7 +3983,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RFHC2P=0.0 RFHM1P=0.0 RFHH0B=0.0 - RFHH1B=0.0 RFHH3B=0.0 RFHF1B=0.0 RFHF2B=0.0 @@ -4074,7 +4035,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) CNAS1=AMAX1(0.0,ZNASH2(N3,N2,N1)/VOLWHM(M,N3,N2,N1)) CKAS1=AMAX1(0.0,ZKASH2(N3,N2,N1)/VOLWHM(M,N3,N2,N1)) C0PO41=AMAX1(0.0,H0P4H2(N3,N2,N1)/VOLWHM(M,N3,N2,N1)) - C1PO41=AMAX1(0.0,H1P4H2(N3,N2,N1)/VOLWHM(M,N3,N2,N1)) C3PO41=AMAX1(0.0,H3P4H2(N3,N2,N1)/VOLWHM(M,N3,N2,N1)) CFE1P1=AMAX1(0.0,ZF1PH2(N3,N2,N1)/VOLWHM(M,N3,N2,N1)) CFE2P1=AMAX1(0.0,ZF2PH2(N3,N2,N1)/VOLWHM(M,N3,N2,N1)) @@ -4083,7 +4043,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) CCA2P1=AMAX1(0.0,ZC2PH2(N3,N2,N1)/VOLWHM(M,N3,N2,N1)) CMG1P1=AMAX1(0.0,ZM1PH2(N3,N2,N1)/VOLWHM(M,N3,N2,N1)) C0POB1=AMAX1(0.0,H0PBH2(N3,N2,N1)/VOLWHM(M,N3,N2,N1)) - C1POB1=AMAX1(0.0,H1PBH2(N3,N2,N1)/VOLWHM(M,N3,N2,N1)) C3POB1=AMAX1(0.0,H3PBH2(N3,N2,N1)/VOLWHM(M,N3,N2,N1)) CF1PB1=AMAX1(0.0,ZF1BH2(N3,N2,N1)/VOLWHM(M,N3,N2,N1)) CF2PB1=AMAX1(0.0,ZF2BH2(N3,N2,N1)/VOLWHM(M,N3,N2,N1)) @@ -4125,7 +4084,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) CNAS2=AMAX1(0.0,ZNASH2(N6,N5,N4)/VOLWHM(M,N6,N5,N4)) CKAS2=AMAX1(0.0,ZKASH2(N6,N5,N4)/VOLWHM(M,N6,N5,N4)) C0PO42=AMAX1(0.0,H0P4H2(N6,N5,N4)/VOLWHM(M,N6,N5,N4)) - C1PO42=AMAX1(0.0,H1P4H2(N6,N5,N4)/VOLWHM(M,N6,N5,N4)) C3PO42=AMAX1(0.0,H3P4H2(N6,N5,N4)/VOLWHM(M,N6,N5,N4)) CFE1P2=AMAX1(0.0,ZF1PH2(N6,N5,N4)/VOLWHM(M,N6,N5,N4)) CFE2P2=AMAX1(0.0,ZF2PH2(N6,N5,N4)/VOLWHM(M,N6,N5,N4)) @@ -4134,7 +4092,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) CCA2P2=AMAX1(0.0,ZC2PH2(N6,N5,N4)/VOLWHM(M,N6,N5,N4)) CMG1P2=AMAX1(0.0,ZM1PH2(N6,N5,N4)/VOLWHM(M,N6,N5,N4)) C0POB2=AMAX1(0.0,H0PBH2(N6,N5,N4)/VOLWHM(M,N6,N5,N4)) - C1POB2=AMAX1(0.0,H1PBH2(N6,N5,N4)/VOLWHM(M,N6,N5,N4)) C3POB2=AMAX1(0.0,H3PBH2(N6,N5,N4)/VOLWHM(M,N6,N5,N4)) CF1PB2=AMAX1(0.0,ZF1BH2(N6,N5,N4)/VOLWHM(M,N6,N5,N4)) CF2PB2=AMAX1(0.0,ZF2BH2(N6,N5,N4)/VOLWHM(M,N6,N5,N4)) @@ -4201,7 +4158,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) DFHNAS=DIFNA*(CNAS1-CNAS2) DFHKAS=DIFKA*(CKAS1-CKAS2) DFHH0P=DIFPO*(C0PO41-C0PO42)*VLPO4(N6,N5,N4) - DFHH1P=DIFPO*(C1PO41-C1PO42)*VLPO4(N6,N5,N4) DFHH3P=DIFPO*(C3PO41-C3PO42)*VLPO4(N6,N5,N4) DFHF1P=DIFPO*(CFE1P1-CFE1P2)*VLPO4(N6,N5,N4) DFHF2P=DIFPO*(CFE2P1-CFE2P2)*VLPO4(N6,N5,N4) @@ -4210,7 +4166,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) DFHC2P=DIFPO*(CCA2P1-CCA2P2)*VLPO4(N6,N5,N4) DFHM1P=DIFPO*(CMG1P1-CMG1P2)*VLPO4(N6,N5,N4) DFHH0B=DIFPO*(C0POB1-C0POB2)*VLPOB(N6,N5,N4) - DFHH1B=DIFPO*(C1POB1-C1POB2)*VLPOB(N6,N5,N4) DFHH3B=DIFPO*(C3POB1-C3POB2)*VLPOB(N6,N5,N4) DFHF1B=DIFPO*(CF1PB1-CF1PB2)*VLPOB(N6,N5,N4) DFHF2B=DIFPO*(CF2PB1-CF2PB2)*VLPOB(N6,N5,N4) @@ -4253,7 +4208,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) DFHNAS=0.0 DFHKAS=0.0 DFHH0P=0.0 - DFHH1P=0.0 DFHH3P=0.0 DFHF1P=0.0 DFHF2P=0.0 @@ -4262,7 +4216,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) DFHC2P=0.0 DFHM1P=0.0 DFHH0B=0.0 - DFHH1B=0.0 DFHH3B=0.0 DFHF1B=0.0 DFHF2B=0.0 @@ -4309,7 +4262,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RNASFS(N,N6,N5,N4)=RFLNAS+DFVNAS RKASFS(N,N6,N5,N4)=RFLKAS+DFVKAS RH0PFS(N,N6,N5,N4)=RFLH0P+DFVH0P - RH1PFS(N,N6,N5,N4)=RFLH1P+DFVH1P RH3PFS(N,N6,N5,N4)=RFLH3P+DFVH3P RF1PFS(N,N6,N5,N4)=RFLF1P+DFVF1P RF2PFS(N,N6,N5,N4)=RFLF2P+DFVF2P @@ -4318,7 +4270,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RC2PFS(N,N6,N5,N4)=RFLC2P+DFVC2P RM1PFS(N,N6,N5,N4)=RFLM1P+DFVM1P RH0BFB(N,N6,N5,N4)=RFLH0B+DFVH0B - RH1BFB(N,N6,N5,N4)=RFLH1B+DFVH1B RH3BFB(N,N6,N5,N4)=RFLH3B+DFVH3B RF1BFB(N,N6,N5,N4)=RFLF1B+DFVF1B RF2BFB(N,N6,N5,N4)=RFLF2B+DFVF2B @@ -4360,7 +4311,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RNASHS(N,N6,N5,N4)=RFHNAS+DFHNAS RKASHS(N,N6,N5,N4)=RFHKAS+DFHKAS RH0PHS(N,N6,N5,N4)=RFHH0P+DFHH0P - RH1PHS(N,N6,N5,N4)=RFHH1P+DFHH1P RH3PHS(N,N6,N5,N4)=RFHH3P+DFHH3P RF1PHS(N,N6,N5,N4)=RFHF1P+DFHF1P RF2PHS(N,N6,N5,N4)=RFHF2P+DFHF2P @@ -4369,7 +4319,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RC2PHS(N,N6,N5,N4)=RFHC2P+DFHC2P RM1PHS(N,N6,N5,N4)=RFHM1P+DFHM1P RH0BHB(N,N6,N5,N4)=RFHH0B+DFHH0B - RH1BHB(N,N6,N5,N4)=RFHH1B+DFHH1B RH3BHB(N,N6,N5,N4)=RFHH3B+DFHH3B RF1BHB(N,N6,N5,N4)=RFHF1B+DFHF1B RF2BHB(N,N6,N5,N4)=RFHF2B+DFHF2B @@ -4414,7 +4363,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) XNASFS(N,N6,N5,N4)=XNASFS(N,N6,N5,N4)+RNASFS(N,N6,N5,N4) XKASFS(N,N6,N5,N4)=XKASFS(N,N6,N5,N4)+RKASFS(N,N6,N5,N4) XH0PFS(N,N6,N5,N4)=XH0PFS(N,N6,N5,N4)+RH0PFS(N,N6,N5,N4) - XH1PFS(N,N6,N5,N4)=XH1PFS(N,N6,N5,N4)+RH1PFS(N,N6,N5,N4) XH3PFS(N,N6,N5,N4)=XH3PFS(N,N6,N5,N4)+RH3PFS(N,N6,N5,N4) XF1PFS(N,N6,N5,N4)=XF1PFS(N,N6,N5,N4)+RF1PFS(N,N6,N5,N4) XF2PFS(N,N6,N5,N4)=XF2PFS(N,N6,N5,N4)+RF2PFS(N,N6,N5,N4) @@ -4423,7 +4371,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) XC2PFS(N,N6,N5,N4)=XC2PFS(N,N6,N5,N4)+RC2PFS(N,N6,N5,N4) XM1PFS(N,N6,N5,N4)=XM1PFS(N,N6,N5,N4)+RM1PFS(N,N6,N5,N4) XH0BFB(N,N6,N5,N4)=XH0BFB(N,N6,N5,N4)+RH0BFB(N,N6,N5,N4) - XH1BFB(N,N6,N5,N4)=XH1BFB(N,N6,N5,N4)+RH1BFB(N,N6,N5,N4) XH3BFB(N,N6,N5,N4)=XH3BFB(N,N6,N5,N4)+RH3BFB(N,N6,N5,N4) XF1BFB(N,N6,N5,N4)=XF1BFB(N,N6,N5,N4)+RF1BFB(N,N6,N5,N4) XF2BFB(N,N6,N5,N4)=XF2BFB(N,N6,N5,N4)+RF2BFB(N,N6,N5,N4) @@ -4465,7 +4412,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) XNASHS(N,N6,N5,N4)=XNASHS(N,N6,N5,N4)+RNASHS(N,N6,N5,N4) XKASHS(N,N6,N5,N4)=XKASHS(N,N6,N5,N4)+RKASHS(N,N6,N5,N4) XH0PHS(N,N6,N5,N4)=XH0PHS(N,N6,N5,N4)+RH0PHS(N,N6,N5,N4) - XH1PHS(N,N6,N5,N4)=XH1PHS(N,N6,N5,N4)+RH1PHS(N,N6,N5,N4) XH3PHS(N,N6,N5,N4)=XH3PHS(N,N6,N5,N4)+RH3PHS(N,N6,N5,N4) XF1PHS(N,N6,N5,N4)=XF1PHS(N,N6,N5,N4)+RF1PHS(N,N6,N5,N4) XF2PHS(N,N6,N5,N4)=XF2PHS(N,N6,N5,N4)+RF2PHS(N,N6,N5,N4) @@ -4474,7 +4420,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) XC2PHS(N,N6,N5,N4)=XC2PHS(N,N6,N5,N4)+RC2PHS(N,N6,N5,N4) XM1PHS(N,N6,N5,N4)=XM1PHS(N,N6,N5,N4)+RM1PHS(N,N6,N5,N4) XH0BHB(N,N6,N5,N4)=XH0BHB(N,N6,N5,N4)+RH0BHB(N,N6,N5,N4) - XH1BHB(N,N6,N5,N4)=XH1BHB(N,N6,N5,N4)+RH1BHB(N,N6,N5,N4) XH3BHB(N,N6,N5,N4)=XH3BHB(N,N6,N5,N4)+RH3BHB(N,N6,N5,N4) XF1BHB(N,N6,N5,N4)=XF1BHB(N,N6,N5,N4)+RF1BHB(N,N6,N5,N4) XF2BHB(N,N6,N5,N4)=XF2BHB(N,N6,N5,N4)+RF2BHB(N,N6,N5,N4) @@ -4532,8 +4477,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RFLNAS=VFLW*AMAX1(0.0,ZNASH2(N6,N5,N4)) RFLKAS=VFLW*AMAX1(0.0,ZKASH2(N6,N5,N4)) RFLH0P=VFLW*AMAX1(0.0,H0P4H2(N6,N5,N4)) - 2*VLPO4(N6,N5,N4) - RFLH1P=VFLW*AMAX1(0.0,H1P4H2(N6,N5,N4)) 2*VLPO4(N6,N5,N4) RFLH3P=VFLW*AMAX1(0.0,H3P4H2(N6,N5,N4)) 2*VLPO4(N6,N5,N4) @@ -4550,8 +4493,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RFLM1P=VFLW*AMAX1(0.0,ZM1PH2(N6,N5,N4)) 2*VLPO4(N6,N5,N4) RFLH0B=VFLW*AMAX1(0.0,H0PBH2(N6,N5,N4)) - 2*VLPOB(N6,N5,N4) - RFLH1B=VFLW*AMAX1(0.0,H1PBH2(N6,N5,N4)) 2*VLPOB(N6,N5,N4) RFLH3B=VFLW*AMAX1(0.0,H3PBH2(N6,N5,N4)) 2*VLPOB(N6,N5,N4) @@ -4611,8 +4552,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RFLNAS=VFLW*AMAX1(0.0,ZNAS2(N6,N5,N4)) RFLKAS=VFLW*AMAX1(0.0,ZKAS2(N6,N5,N4)) RFLH0P=VFLW*AMAX1(0.0,H0PO42(N6,N5,N4)) - 2*VLPO4(N6,N5,N4) - RFLH1P=VFLW*AMAX1(0.0,H1PO42(N6,N5,N4)) 2*VLPO4(N6,N5,N4) RFLH3P=VFLW*AMAX1(0.0,H3PO42(N6,N5,N4)) 2*VLPO4(N6,N5,N4) @@ -4629,8 +4568,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RFLM1P=VFLW*AMAX1(0.0,ZMG1P2(N6,N5,N4)) 2*VLPO4(N6,N5,N4) RFLH0B=VFLW*AMAX1(0.0,H0POB2(N6,N5,N4)) - 2*VLPOB(N6,N5,N4) - RFLH1B=VFLW*AMAX1(0.0,H1POB2(N6,N5,N4)) 2*VLPOB(N6,N5,N4) RFLH3B=VFLW*AMAX1(0.0,H3POB2(N6,N5,N4)) 2*VLPOB(N6,N5,N4) @@ -4684,7 +4621,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RFLNAS=0.0 RFLKAS=0.0 RFLH0P=0.0 - RFLH1P=0.0 RFLH3P=0.0 RFLF1P=0.0 RFLF2P=0.0 @@ -4693,7 +4629,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RFLC2P=0.0 RFLM1P=0.0 RFLH0B=0.0 - RFLH1B=0.0 RFLH3B=0.0 RFLF1B=0.0 RFLF2B=0.0 @@ -4713,127 +4648,121 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) IF(VOLWHM(M,N6,N5,N4).GT.ZEROS(NY,NX))THEN VOLWHS=AMIN1(XFRS*VOLT(N6,N5,N4),VOLWHM(M,N6,N5,N4)) VOLWT=VOLWM(M,N6,N5,N4)+VOLWHS - DFVAL=XNPX*(ZALH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZAL2(N6,N5,N4)*VOLWHS)/VOLWT - DFVFE=XNPX*(ZFEH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZFE2(N6,N5,N4)*VOLWHS)/VOLWT - DFVHY=XNPX*(ZHYH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZHY2(N6,N5,N4)*VOLWHS)/VOLWT - DFVCA=XNPX*(ZCCH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZCA2(N6,N5,N4)*VOLWHS)/VOLWT - DFVMG=XNPX*(ZMAH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZMG2(N6,N5,N4)*VOLWHS)/VOLWT - DFVNA=XNPX*(ZNAH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZNA2(N6,N5,N4)*VOLWHS)/VOLWT - DFVKA=XNPX*(ZKAH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZKA2(N6,N5,N4)*VOLWHS)/VOLWT - DFVOH=XNPX*(ZOHH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZOH2(N6,N5,N4)*VOLWHS)/VOLWT - DFVSO=XNPX*(ZSO4H2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZSO42(N6,N5,N4)*VOLWHS)/VOLWT - DFVCL=XNPX*(ZCLH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZCL2(N6,N5,N4)*VOLWHS)/VOLWT - DFVC3=XNPX*(ZCO3H2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZCO32(N6,N5,N4)*VOLWHS)/VOLWT - DFVHC=XNPX*(ZHCOH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZHCO32(N6,N5,N4)*VOLWHS)/VOLWT - DFVAL1=XNPX*(ZAL1H2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZAL12(N6,N5,N4)*VOLWHS)/VOLWT - DFVAL2=XNPX*(ZAL2H2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZAL22(N6,N5,N4)*VOLWHS)/VOLWT - DFVAL3=XNPX*(ZAL3H2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZAL32(N6,N5,N4)*VOLWHS)/VOLWT - DFVAL4=XNPX*(ZAL4H2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZAL42(N6,N5,N4)*VOLWHS)/VOLWT - DFVALS=XNPX*(ZALSH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZALS2(N6,N5,N4)*VOLWHS)/VOLWT - DFVFE1=XNPX*(ZFE1H2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZFE12(N6,N5,N4)*VOLWHS)/VOLWT - DFVF22=XNPX*(ZFE2H2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZFE22(N6,N5,N4)*VOLWHS)/VOLWT - DFVFE3=XNPX*(ZFE3H2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZFE32(N6,N5,N4)*VOLWHS)/VOLWT - DFVFE4=XNPX*(ZFE4H2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZFE42(N6,N5,N4)*VOLWHS)/VOLWT - DFVFES=XNPX*(ZFESH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZFES2(N6,N5,N4)*VOLWHS)/VOLWT - DFVCAO=XNPX*(ZCAOH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZCAO2(N6,N5,N4)*VOLWHS)/VOLWT - DFVCAC=XNPX*(ZCACH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZCAC2(N6,N5,N4)*VOLWHS)/VOLWT - DFVCAH=XNPX*(ZCAHH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZCAH2(N6,N5,N4)*VOLWHS)/VOLWT - DFVCAS=XNPX*(ZCASH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZCAS2(N6,N5,N4)*VOLWHS)/VOLWT - DFVMGO=XNPX*(ZMGOH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZMGO2(N6,N5,N4)*VOLWHS)/VOLWT - DFVMGC=XNPX*(ZMGCH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZMGC2(N6,N5,N4)*VOLWHS)/VOLWT - DFVMGH=XNPX*(ZMGHH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZMGH2(N6,N5,N4)*VOLWHS)/VOLWT - DFVMGS=XNPX*(ZMGSH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZMGS2(N6,N5,N4)*VOLWHS)/VOLWT - DFVNAC=XNPX*(ZNACH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZNAC2(N6,N5,N4)*VOLWHS)/VOLWT - DFVNAS=XNPX*(ZNASH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZNAS2(N6,N5,N4)*VOLWHS)/VOLWT - DFVKAS=XNPX*(ZKASH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZKAS2(N6,N5,N4)*VOLWHS)/VOLWT - DFVNAC=XNPX*(ZNACH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZNAC2(N6,N5,N4)*VOLWHS)/VOLWT - DFVH0P=XNPX*(H0P4H2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-H0PO42(N6,N5,N4)*VOLWHS)/VOLWT - 2*VLPO4(N6,N5,N4) - DFVH1P=XNPX*(H1P4H2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-H1PO42(N6,N5,N4)*VOLWHS)/VOLWT + DFVAL=XNPX*(AMAX1(0.0,ZALH2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,ZAL2(N6,N5,N4))*VOLWHS)/VOLWT + DFVFE=XNPX*(AMAX1(0.0,ZFEH2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,ZFE2(N6,N5,N4))*VOLWHS)/VOLWT + DFVHY=XNPX*(AMAX1(0.0,ZHYH2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,ZHY2(N6,N5,N4))*VOLWHS)/VOLWT + DFVCA=XNPX*(AMAX1(0.0,ZCCH2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,ZCA2(N6,N5,N4))*VOLWHS)/VOLWT + DFVMG=XNPX*(AMAX1(0.0,ZMAH2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,ZMG2(N6,N5,N4))*VOLWHS)/VOLWT + DFVNA=XNPX*(AMAX1(0.0,ZNAH2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,ZNA2(N6,N5,N4))*VOLWHS)/VOLWT + DFVKA=XNPX*(AMAX1(0.0,ZKAH2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,ZKA2(N6,N5,N4))*VOLWHS)/VOLWT + DFVOH=XNPX*(AMAX1(0.0,ZOHH2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,ZOH2(N6,N5,N4))*VOLWHS)/VOLWT + DFVSO=XNPX*(AMAX1(0.0,ZSO4H2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,ZSO42(N6,N5,N4))*VOLWHS)/VOLWT + DFVCL=XNPX*(AMAX1(0.0,ZCLH2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,ZCL2(N6,N5,N4))*VOLWHS)/VOLWT + DFVC3=XNPX*(AMAX1(0.0,ZCO3H2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,ZCO32(N6,N5,N4))*VOLWHS)/VOLWT + DFVHC=XNPX*(AMAX1(0.0,ZHCOH2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,ZHCO32(N6,N5,N4))*VOLWHS)/VOLWT + DFVAL1=XNPX*(AMAX1(0.0,ZAL1H2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,ZAL12(N6,N5,N4))*VOLWHS)/VOLWT + DFVAL2=XNPX*(AMAX1(0.0,ZAL2H2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,ZAL22(N6,N5,N4))*VOLWHS)/VOLWT + DFVAL3=XNPX*(AMAX1(0.0,ZAL3H2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,ZAL32(N6,N5,N4))*VOLWHS)/VOLWT + DFVAL4=XNPX*(AMAX1(0.0,ZAL4H2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,ZAL42(N6,N5,N4))*VOLWHS)/VOLWT + DFVALS=XNPX*(AMAX1(0.0,ZALSH2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,ZALS2(N6,N5,N4))*VOLWHS)/VOLWT + DFVFE1=XNPX*(AMAX1(0.0,ZFE1H2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,ZFE12(N6,N5,N4))*VOLWHS)/VOLWT + DFVF22=XNPX*(AMAX1(0.0,ZFE2H2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,ZFE22(N6,N5,N4))*VOLWHS)/VOLWT + DFVFE3=XNPX*(AMAX1(0.0,ZFE3H2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,ZFE32(N6,N5,N4))*VOLWHS)/VOLWT + DFVFE4=XNPX*(AMAX1(0.0,ZFE4H2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,ZFE42(N6,N5,N4))*VOLWHS)/VOLWT + DFVFES=XNPX*(AMAX1(0.0,ZFESH2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,ZFES2(N6,N5,N4))*VOLWHS)/VOLWT + DFVCAO=XNPX*(AMAX1(0.0,ZCAOH2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,ZCAO2(N6,N5,N4))*VOLWHS)/VOLWT + DFVCAC=XNPX*(AMAX1(0.0,ZCACH2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,ZCAC2(N6,N5,N4))*VOLWHS)/VOLWT + DFVCAH=XNPX*(AMAX1(0.0,ZCAHH2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,ZCAH2(N6,N5,N4))*VOLWHS)/VOLWT + DFVCAS=XNPX*(AMAX1(0.0,ZCASH2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,ZCAS2(N6,N5,N4))*VOLWHS)/VOLWT + DFVMGO=XNPX*(AMAX1(0.0,ZMGOH2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,ZMGO2(N6,N5,N4))*VOLWHS)/VOLWT + DFVMGC=XNPX*(AMAX1(0.0,ZMGCH2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,ZMGC2(N6,N5,N4))*VOLWHS)/VOLWT + DFVMGH=XNPX*(AMAX1(0.0,ZMGHH2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,ZMGH2(N6,N5,N4))*VOLWHS)/VOLWT + DFVMGS=XNPX*(AMAX1(0.0,ZMGSH2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,ZMGS2(N6,N5,N4))*VOLWHS)/VOLWT + DFVNAC=XNPX*(AMAX1(0.0,ZNACH2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,ZNAC2(N6,N5,N4))*VOLWHS)/VOLWT + DFVNAS=XNPX*(AMAX1(0.0,ZNASH2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,ZNAS2(N6,N5,N4))*VOLWHS)/VOLWT + DFVKAS=XNPX*(AMAX1(0.0,ZKASH2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,ZKAS2(N6,N5,N4))*VOLWHS)/VOLWT + DFVNAC=XNPX*(AMAX1(0.0,ZNACH2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,ZNAC2(N6,N5,N4))*VOLWHS)/VOLWT + DFVH0P=XNPX*(AMAX1(0.0,H0P4H2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,H0PO42(N6,N5,N4))*VOLWHS)/VOLWT 2*VLPO4(N6,N5,N4) - DFVH3P=XNPX*(H3P4H2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-H3PO42(N6,N5,N4)*VOLWHS)/VOLWT + DFVH3P=XNPX*(AMAX1(0.0,H3P4H2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,H3PO42(N6,N5,N4))*VOLWHS)/VOLWT 2*VLPO4(N6,N5,N4) - DFVF1P=XNPX*(ZF1PH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZFE1P2(N6,N5,N4)*VOLWHS)/VOLWT + DFVF1P=XNPX*(AMAX1(0.0,ZF1PH2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,ZFE1P2(N6,N5,N4))*VOLWHS)/VOLWT 2*VLPO4(N6,N5,N4) - DFVF2P=XNPX*(ZF2PH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZFE2P2(N6,N5,N4)*VOLWHS)/VOLWT + DFVF2P=XNPX*(AMAX1(0.0,ZF2PH2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,ZFE2P2(N6,N5,N4))*VOLWHS)/VOLWT 2*VLPO4(N6,N5,N4) - DFVC0P=XNPX*(ZC0PH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZCA0P2(N6,N5,N4)*VOLWHS)/VOLWT + DFVC0P=XNPX*(AMAX1(0.0,ZC0PH2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,ZCA0P2(N6,N5,N4))*VOLWHS)/VOLWT 2*VLPO4(N6,N5,N4) - DFVC1P=XNPX*(ZC1PH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZCA1P2(N6,N5,N4)*VOLWHS)/VOLWT + DFVC1P=XNPX*(AMAX1(0.0,ZC1PH2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,ZCA1P2(N6,N5,N4))*VOLWHS)/VOLWT 2*VLPO4(N6,N5,N4) - DFVC2P=XNPX*(ZC2PH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZCA2P2(N6,N5,N4)*VOLWHS)/VOLWT + DFVC2P=XNPX*(AMAX1(0.0,ZC2PH2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,ZCA2P2(N6,N5,N4))*VOLWHS)/VOLWT 2*VLPO4(N6,N5,N4) - DFVM1P=XNPX*(ZM1PH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZMG1P2(N6,N5,N4)*VOLWHS)/VOLWT + DFVM1P=XNPX*(AMAX1(0.0,ZM1PH2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,ZMG1P2(N6,N5,N4))*VOLWHS)/VOLWT 2*VLPO4(N6,N5,N4) - DFVH0B=XNPX*(H0PBH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-H0POB2(N6,N5,N4)*VOLWHS)/VOLWT - 2*VLPOB(N6,N5,N4) - DFVH1B=XNPX*(H1PBH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-H1POB2(N6,N5,N4)*VOLWHS)/VOLWT + DFVH0B=XNPX*(AMAX1(0.0,H0PBH2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,H0POB2(N6,N5,N4))*VOLWHS)/VOLWT 2*VLPOB(N6,N5,N4) - DFVH3B=XNPX*(H3PBH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-H3POB2(N6,N5,N4)*VOLWHS)/VOLWT + DFVH3B=XNPX*(AMAX1(0.0,H3PBH2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,H3POB2(N6,N5,N4))*VOLWHS)/VOLWT 2*VLPOB(N6,N5,N4) - DFVF1B=XNPX*(ZF1BH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZF1PB2(N6,N5,N4)*VOLWHS)/VOLWT + DFVF1B=XNPX*(AMAX1(0.0,ZF1BH2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,ZF1PB2(N6,N5,N4))*VOLWHS)/VOLWT 2*VLPOB(N6,N5,N4) - DFVF2B=XNPX*(ZF2BH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZF2PB2(N6,N5,N4)*VOLWHS)/VOLWT + DFVF2B=XNPX*(AMAX1(0.0,ZF2BH2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,ZF2PB2(N6,N5,N4))*VOLWHS)/VOLWT 2*VLPOB(N6,N5,N4) - DFVC0B=XNPX*(ZC0BH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZC0PB2(N6,N5,N4)*VOLWHS)/VOLWT + DFVC0B=XNPX*(AMAX1(0.0,ZC0BH2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,ZC0PB2(N6,N5,N4))*VOLWHS)/VOLWT 2*VLPOB(N6,N5,N4) - DFVC1B=XNPX*(ZC1BH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZC1PB2(N6,N5,N4)*VOLWHS)/VOLWT + DFVC1B=XNPX*(AMAX1(0.0,ZC1BH2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,ZC1PB2(N6,N5,N4))*VOLWHS)/VOLWT 2*VLPOB(N6,N5,N4) - DFVC2B=XNPX*(ZC2BH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZC2PB2(N6,N5,N4)*VOLWHS)/VOLWT + DFVC2B=XNPX*(AMAX1(0.0,ZC2BH2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,ZC2PB2(N6,N5,N4))*VOLWHS)/VOLWT 2*VLPOB(N6,N5,N4) - DFVM1B=XNPX*(ZM1BH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZM1PB2(N6,N5,N4)*VOLWHS)/VOLWT + DFVM1B=XNPX*(AMAX1(0.0,ZM1BH2(N6,N5,N4))*VOLWM(M,N6,N5,N4) + 2-AMAX1(0.0,ZM1PB2(N6,N5,N4))*VOLWHS)/VOLWT 2*VLPOB(N6,N5,N4) ELSE DFVAL=0.0 @@ -4870,7 +4799,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) DFVNAS=0.0 DFVKAS=0.0 DFVH0P=0.0 - DFVH1P=0.0 DFVH3P=0.0 DFVF1P=0.0 DFVF2P=0.0 @@ -4879,7 +4807,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) DFVC2P=0.0 DFVM1P=0.0 DFVH0B=0.0 - DFVH1B=0.0 DFVH3B=0.0 DFVF1B=0.0 DFVF2B=0.0 @@ -4925,7 +4852,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RNASXS(N6,N5,N4)=RFLNAS+DFVNAS RKASXS(N6,N5,N4)=RFLKAS+DFVKAS RH0PXS(N6,N5,N4)=RFLH0P+DFVH0P - RH1PXS(N6,N5,N4)=RFLH1P+DFVH1P RH3PXS(N6,N5,N4)=RFLH3P+DFVH3P RF1PXS(N6,N5,N4)=RFLF1P+DFVF1P RF2PXS(N6,N5,N4)=RFLF2P+DFVF2P @@ -4934,7 +4860,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RC2PXS(N6,N5,N4)=RFLC2P+DFVC2P RM1PXS(N6,N5,N4)=RFLM1P+DFVM1P RH0BXB(N6,N5,N4)=RFLH0B+DFVH0B - RH1BXB(N6,N5,N4)=RFLH1B+DFVH1B RH3BXB(N6,N5,N4)=RFLH3B+DFVH3B RF1BXB(N6,N5,N4)=RFLF1B+DFVF1B RF2BXB(N6,N5,N4)=RFLF2B+DFVF2B @@ -4979,7 +4904,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) XNASXS(N6,N5,N4)=XNASXS(N6,N5,N4)+RNASXS(N6,N5,N4) XKASXS(N6,N5,N4)=XKASXS(N6,N5,N4)+RKASXS(N6,N5,N4) XH0PXS(N6,N5,N4)=XH0PXS(N6,N5,N4)+RH0PXS(N6,N5,N4) - XH1PXS(N6,N5,N4)=XH1PXS(N6,N5,N4)+RH1PXS(N6,N5,N4) XH3PXS(N6,N5,N4)=XH3PXS(N6,N5,N4)+RH3PXS(N6,N5,N4) XF1PXS(N6,N5,N4)=XF1PXS(N6,N5,N4)+RF1PXS(N6,N5,N4) XF2PXS(N6,N5,N4)=XF2PXS(N6,N5,N4)+RF2PXS(N6,N5,N4) @@ -4988,7 +4912,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) XC2PXS(N6,N5,N4)=XC2PXS(N6,N5,N4)+RC2PXS(N6,N5,N4) XM1PXS(N6,N5,N4)=XM1PXS(N6,N5,N4)+RM1PXS(N6,N5,N4) XH0BXB(N6,N5,N4)=XH0BXB(N6,N5,N4)+RH0BXB(N6,N5,N4) - XH1BXB(N6,N5,N4)=XH1BXB(N6,N5,N4)+RH1BXB(N6,N5,N4) XH3BXB(N6,N5,N4)=XH3BXB(N6,N5,N4)+RH3BXB(N6,N5,N4) XF1BXB(N6,N5,N4)=XF1BXB(N6,N5,N4)+RF1BXB(N6,N5,N4) XF2BXB(N6,N5,N4)=XF2BXB(N6,N5,N4)+RF2BXB(N6,N5,N4) @@ -5034,7 +4957,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RNASFS(N,N6,N5,N4)=0.0 RKASFS(N,N6,N5,N4)=0.0 RH0PFS(N,N6,N5,N4)=0.0 - RH1PFS(N,N6,N5,N4)=0.0 RH3PFS(N,N6,N5,N4)=0.0 RF1PFS(N,N6,N5,N4)=0.0 RF2PFS(N,N6,N5,N4)=0.0 @@ -5043,7 +4965,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RC2PFS(N,N6,N5,N4)=0.0 RM1PFS(N,N6,N5,N4)=0.0 RH0BFB(N,N6,N5,N4)=0.0 - RH1BFB(N,N6,N5,N4)=0.0 RH3BFB(N,N6,N5,N4)=0.0 RF1BFB(N,N6,N5,N4)=0.0 RF2BFB(N,N6,N5,N4)=0.0 @@ -5085,7 +5006,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RNASHS(N,N6,N5,N4)=0.0 RKASHS(N,N6,N5,N4)=0.0 RH0PHS(N,N6,N5,N4)=0.0 - RH1PHS(N,N6,N5,N4)=0.0 RH3PHS(N,N6,N5,N4)=0.0 RF1PHS(N,N6,N5,N4)=0.0 RF2PHS(N,N6,N5,N4)=0.0 @@ -5094,7 +5014,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RC2PHS(N,N6,N5,N4)=0.0 RM1PHS(N,N6,N5,N4)=0.0 RH0BHB(N,N6,N5,N4)=0.0 - RH1BHB(N,N6,N5,N4)=0.0 RH3BHB(N,N6,N5,N4)=0.0 RF1BHB(N,N6,N5,N4)=0.0 RF2BHB(N,N6,N5,N4)=0.0 @@ -5248,7 +5167,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RQRNAS(N,M5,M4)=0.0 RQRKAS(N,M5,M4)=0.0 RQRH0P(N,M5,M4)=0.0 - RQRH1P(N,M5,M4)=0.0 RQRH3P(N,M5,M4)=0.0 RQRF1P(N,M5,M4)=0.0 RQRF2P(N,M5,M4)=0.0 @@ -5301,7 +5219,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RQRNAS(N,M5,M4)=VFLW*AMAX1(0.0,ZNAS2(0,M2,M1)) RQRKAS(N,M5,M4)=VFLW*AMAX1(0.0,ZKAS2(0,M2,M1)) RQRH0P(N,M5,M4)=VFLW*AMAX1(0.0,H0PO42(0,M2,M1)) - RQRH1P(N,M5,M4)=VFLW*AMAX1(0.0,H1PO42(0,M2,M1)) RQRH3P(N,M5,M4)=VFLW*AMAX1(0.0,H3PO42(0,M2,M1)) RQRF1P(N,M5,M4)=VFLW*AMAX1(0.0,ZFE1P2(0,M2,M1)) RQRF2P(N,M5,M4)=VFLW*AMAX1(0.0,ZFE2P2(0,M2,M1)) @@ -5310,9 +5227,10 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RQRC2P(N,M5,M4)=VFLW*AMAX1(0.0,ZCA2P2(0,M2,M1)) RQRM1P(N,M5,M4)=VFLW*AMAX1(0.0,ZMG1P2(0,M2,M1)) C WRITE(19,1114)'RUNS',I,J,M,M1,M2,M3,N,NN,QRM(M,N,M5,M4) -C 2,VFLW,RQRH0P(N,M5,M4)*31.0,RQRH1P(N,M5,M4)*31.0 +C 2,VFLW,RQRH0P(N,M5,M4)*31.0 C 3,RQRH3P(N,M5,M4)*31.0 -1114 FORMAT(A8,8I4,20E12.4) +C 4,RQRHY(N,M5,M4),RQROH(N,M5,M4),ZHY2(0,M2,M1),ZOH2(0,M2,M1) +1114 FORMAT(A8,8I4,20F16.9) C C SOLUTE GAIN FROM RUNON DEPENDING ON ASPECT C AND BOUNDARY CONDITIONS SET IN SITE FILE @@ -5352,7 +5270,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RQRNAS(N,M5,M4)=0.0 RQRKAS(N,M5,M4)=0.0 RQRH0P(N,M5,M4)=0.0 - RQRH1P(N,M5,M4)=0.0 RQRH3P(N,M5,M4)=0.0 RQRF1P(N,M5,M4)=0.0 RQRF2P(N,M5,M4)=0.0 @@ -5395,7 +5312,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RQSNAS(N,M5,M4)=0.0 RQSKAS(N,M5,M4)=0.0 RQSH0P(N,M5,M4)=0.0 - RQSH1P(N,M5,M4)=0.0 RQSH3P(N,M5,M4)=0.0 RQSF1P(N,M5,M4)=0.0 RQSF2P(N,M5,M4)=0.0 @@ -5440,7 +5356,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) XQRNAS(N,M5,M4)=XQRNAS(N,M5,M4)+RQRNAS(N,M5,M4) XQRKAS(N,M5,M4)=XQRKAS(N,M5,M4)+RQRKAS(N,M5,M4) XQRH0P(N,M5,M4)=XQRH0P(N,M5,M4)+RQRH0P(N,M5,M4) - XQRH1P(N,M5,M4)=XQRH1P(N,M5,M4)+RQRH1P(N,M5,M4) XQRH3P(N,M5,M4)=XQRH3P(N,M5,M4)+RQRH3P(N,M5,M4) XQRF1P(N,M5,M4)=XQRF1P(N,M5,M4)+RQRF1P(N,M5,M4) XQRF2P(N,M5,M4)=XQRF2P(N,M5,M4)+RQRF2P(N,M5,M4) @@ -5495,8 +5410,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RNASFS(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZNAS2(M3,M2,M1)) RKASFS(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZKAS2(M3,M2,M1)) RH0PFS(N,M6,M5,M4)=VFLW*AMAX1(0.0,H0PO42(M3,M2,M1)) - 2*VLPO4(M3,M2,M1) - RH1PFS(N,M6,M5,M4)=VFLW*AMAX1(0.0,H1PO42(M3,M2,M1)) 2*VLPO4(M3,M2,M1) RH3PFS(N,M6,M5,M4)=VFLW*AMAX1(0.0,H3PO42(M3,M2,M1)) 2*VLPO4(M3,M2,M1) @@ -5513,8 +5426,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RM1PFS(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZMG1P2(M3,M2,M1)) 2*VLPO4(M3,M2,M1) RH0BFB(N,M6,M5,M4)=VFLW*AMAX1(0.0,H0POB2(M3,M2,M1)) - 2*VLPOB(M3,M2,M1) - RH1BFB(N,M6,M5,M4)=VFLW*AMAX1(0.0,H1POB2(M3,M2,M1)) 2*VLPOB(M3,M2,M1) RH3BFB(N,M6,M5,M4)=VFLW*AMAX1(0.0,H3POB2(M3,M2,M1)) 2*VLPOB(M3,M2,M1) @@ -5530,12 +5441,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) 2*VLPOB(M3,M2,M1) RM1BFB(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZM1PB2(M3,M2,M1)) 2*VLPOB(M3,M2,M1) -C IF(M3.EQ.NL.AND.N.EQ.3)THEN -C WRITE(19,1115)'LEACHS',I,J,M,M1,M2,M3,N,NN,FLWM(M,N,M6,M5,M4) -C 2,VFLW,RH0PFS(N,M6,M5,M4)*31.0,RH1PFS(N,M6,M5,M4)*31.0 -C 3,RH3PFS(N,M6,M5,M4)*31.0 -1115 FORMAT(A8,8I4,20E12.4) -C ENDIF C C SOLUTE GAIN WITH SUBSURFACE MICROPORE WATER GAIN C @@ -5574,8 +5479,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RNASFS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CNASU(L,NY,NX) RKASFS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CKASU(L,NY,NX) RH0PFS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CH0PU(L,NY,NX) - 2*VLPO4(L,NY,NX) - RH1PFS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CH1PU(L,NY,NX) 2*VLPO4(L,NY,NX) RH3PFS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CH3PU(L,NY,NX) 2*VLPO4(L,NY,NX) @@ -5592,8 +5495,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RM1PFS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CM1PU(L,NY,NX) 2*VLPO4(L,NY,NX) RH0BFB(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CH0PU(L,NY,NX) - 2*VLPOB(L,NY,NX) - RH1BFB(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CH1PU(L,NY,NX) 2*VLPOB(L,NY,NX) RH3BFB(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CH3PU(L,NY,NX) 2*VLPOB(L,NY,NX) @@ -5655,8 +5556,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RNASHS(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZNASH2(M3,M2,M1)) RKASHS(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZKASH2(M3,M2,M1)) RH0PHS(N,M6,M5,M4)=VFLW*AMAX1(0.0,H0P4H2(M3,M2,M1)) - 2*VLPO4(M3,M2,M1) - RH1PHS(N,M6,M5,M4)=VFLW*AMAX1(0.0,H1P4H2(M3,M2,M1)) 2*VLPO4(M3,M2,M1) RH3PHS(N,M6,M5,M4)=VFLW*AMAX1(0.0,H3P4H2(M3,M2,M1)) 2*VLPO4(M3,M2,M1) @@ -5673,8 +5572,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RM1PHS(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZM1PH2(M3,M2,M1)) 2*VLPO4(M3,M2,M1) RH0BHB(N,M6,M5,M4)=VFLW*AMAX1(0.0,H0PBH2(M3,M2,M1)) - 2*VLPOB(M3,M2,M1) - RH1BHB(N,M6,M5,M4)=VFLW*AMAX1(0.0,H1PBH2(M3,M2,M1)) 2*VLPOB(M3,M2,M1) RH3BHB(N,M6,M5,M4)=VFLW*AMAX1(0.0,H3PBH2(M3,M2,M1)) 2*VLPOB(M3,M2,M1) @@ -5728,7 +5625,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RNASHS(N,M6,M5,M4)=0.0 RKASHS(N,M6,M5,M4)=0.0 RH0PHS(N,M6,M5,M4)=0.0 - RH1PHS(N,M6,M5,M4)=0.0 RH3PHS(N,M6,M5,M4)=0.0 RF1PHS(N,M6,M5,M4)=0.0 RF2PHS(N,M6,M5,M4)=0.0 @@ -5737,7 +5633,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RC2PHS(N,M6,M5,M4)=0.0 RM1PHS(N,M6,M5,M4)=0.0 RH0BHB(N,M6,M5,M4)=0.0 - RH1BHB(N,M6,M5,M4)=0.0 RH3BHB(N,M6,M5,M4)=0.0 RF1BHB(N,M6,M5,M4)=0.0 RF2BHB(N,M6,M5,M4)=0.0 @@ -5783,7 +5678,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) XNASFS(N,M6,M5,M4)=XNASFS(N,M6,M5,M4)+RNASFS(N,M6,M5,M4) XKASFS(N,M6,M5,M4)=XKASFS(N,M6,M5,M4)+RKASFS(N,M6,M5,M4) XH0PFS(N,M6,M5,M4)=XH0PFS(N,M6,M5,M4)+RH0PFS(N,M6,M5,M4) - XH1PFS(N,M6,M5,M4)=XH1PFS(N,M6,M5,M4)+RH1PFS(N,M6,M5,M4) XH3PFS(N,M6,M5,M4)=XH3PFS(N,M6,M5,M4)+RH3PFS(N,M6,M5,M4) XF1PFS(N,M6,M5,M4)=XF1PFS(N,M6,M5,M4)+RF1PFS(N,M6,M5,M4) XF2PFS(N,M6,M5,M4)=XF2PFS(N,M6,M5,M4)+RF2PFS(N,M6,M5,M4) @@ -5792,7 +5686,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) XC2PFS(N,M6,M5,M4)=XC2PFS(N,M6,M5,M4)+RC2PFS(N,M6,M5,M4) XM1PFS(N,M6,M5,M4)=XM1PFS(N,M6,M5,M4)+RM1PFS(N,M6,M5,M4) XH0BFB(N,M6,M5,M4)=XH0BFB(N,M6,M5,M4)+RH0BFB(N,M6,M5,M4) - XH1BFB(N,M6,M5,M4)=XH1BFB(N,M6,M5,M4)+RH1BFB(N,M6,M5,M4) XH3BFB(N,M6,M5,M4)=XH3BFB(N,M6,M5,M4)+RH3BFB(N,M6,M5,M4) XF1BFB(N,M6,M5,M4)=XF1BFB(N,M6,M5,M4)+RF1BFB(N,M6,M5,M4) XF2BFB(N,M6,M5,M4)=XF2BFB(N,M6,M5,M4)+RF2BFB(N,M6,M5,M4) @@ -5834,7 +5727,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) XNASHS(N,M6,M5,M4)=XNASHS(N,M6,M5,M4)+RNASHS(N,M6,M5,M4) XKASHS(N,M6,M5,M4)=XKASHS(N,M6,M5,M4)+RKASHS(N,M6,M5,M4) XH0PHS(N,M6,M5,M4)=XH0PHS(N,M6,M5,M4)+RH0PHS(N,M6,M5,M4) - XH1PHS(N,M6,M5,M4)=XH1PHS(N,M6,M5,M4)+RH1PHS(N,M6,M5,M4) XH3PHS(N,M6,M5,M4)=XH3PHS(N,M6,M5,M4)+RH3PHS(N,M6,M5,M4) XF1PHS(N,M6,M5,M4)=XF1PHS(N,M6,M5,M4)+RF1PHS(N,M6,M5,M4) XF2PHS(N,M6,M5,M4)=XF2PHS(N,M6,M5,M4)+RF2PHS(N,M6,M5,M4) @@ -5843,7 +5735,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) XC2PHS(N,M6,M5,M4)=XC2PHS(N,M6,M5,M4)+RC2PHS(N,M6,M5,M4) XM1PHS(N,M6,M5,M4)=XM1PHS(N,M6,M5,M4)+RM1PHS(N,M6,M5,M4) XH0BHB(N,M6,M5,M4)=XH0BHB(N,M6,M5,M4)+RH0BHB(N,M6,M5,M4) - XH1BHB(N,M6,M5,M4)=XH1BHB(N,M6,M5,M4)+RH1BHB(N,M6,M5,M4) XH3BHB(N,M6,M5,M4)=XH3BHB(N,M6,M5,M4)+RH3BHB(N,M6,M5,M4) XF1BHB(N,M6,M5,M4)=XF1BHB(N,M6,M5,M4)+RF1BHB(N,M6,M5,M4) XF2BHB(N,M6,M5,M4)=XF2BHB(N,M6,M5,M4)+RF2BHB(N,M6,M5,M4) @@ -5894,7 +5785,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) TQRNAS(N2,N1)=TQRNAS(N2,N1)+RQRNAS(N,N2,N1)-RQRNAS(N,N5,N4) TQRKAS(N2,N1)=TQRKAS(N2,N1)+RQRKAS(N,N2,N1)-RQRKAS(N,N5,N4) TQRH0P(N2,N1)=TQRH0P(N2,N1)+RQRH0P(N,N2,N1)-RQRH0P(N,N5,N4) - TQRH1P(N2,N1)=TQRH1P(N2,N1)+RQRH1P(N,N2,N1)-RQRH1P(N,N5,N4) TQRH3P(N2,N1)=TQRH3P(N2,N1)+RQRH3P(N,N2,N1)-RQRH3P(N,N5,N4) TQRF1P(N2,N1)=TQRF1P(N2,N1)+RQRF1P(N,N2,N1)-RQRF1P(N,N5,N4) TQRF2P(N2,N1)=TQRF2P(N2,N1)+RQRF2P(N,N2,N1)-RQRF2P(N,N5,N4) @@ -5936,7 +5826,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) TQSNAS(N2,N1)=TQSNAS(N2,N1)+RQSNAS(N,N2,N1)-RQSNAS(N,N5,N4) TQSKAS(N2,N1)=TQSKAS(N2,N1)+RQSKAS(N,N2,N1)-RQSKAS(N,N5,N4) TQSH0P(N2,N1)=TQSH0P(N2,N1)+RQSH0P(N,N2,N1)-RQSH0P(N,N5,N4) - TQSH1P(N2,N1)=TQSH1P(N2,N1)+RQSH1P(N,N2,N1)-RQSH1P(N,N5,N4) TQSH3P(N2,N1)=TQSH3P(N2,N1)+RQSH3P(N,N2,N1)-RQSH3P(N,N5,N4) TQSF1P(N2,N1)=TQSF1P(N2,N1)+RQSF1P(N,N2,N1)-RQSF1P(N,N5,N4) TQSF2P(N2,N1)=TQSF2P(N2,N1)+RQSF2P(N,N2,N1)-RQSF2P(N,N5,N4) @@ -6016,8 +5905,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) 2-RKASFS(N,N6,N5,N4) TH0PFS(N3,N2,N1)=TH0PFS(N3,N2,N1)+RH0PFS(N,N3,N2,N1) 2-RH0PFS(N,N6,N5,N4) - TH1PFS(N3,N2,N1)=TH1PFS(N3,N2,N1)+RH1PFS(N,N3,N2,N1) - 2-RH1PFS(N,N6,N5,N4) TH3PFS(N3,N2,N1)=TH3PFS(N3,N2,N1)+RH3PFS(N,N3,N2,N1) 2-RH3PFS(N,N6,N5,N4) TF1PFS(N3,N2,N1)=TF1PFS(N3,N2,N1)+RF1PFS(N,N3,N2,N1) @@ -6034,8 +5921,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) 2-RM1PFS(N,N6,N5,N4) TH0BFB(N3,N2,N1)=TH0BFB(N3,N2,N1)+RH0BFB(N,N3,N2,N1) 2-RH0BFB(N,N6,N5,N4) - TH1BFB(N3,N2,N1)=TH1BFB(N3,N2,N1)+RH1BFB(N,N3,N2,N1) - 2-RH1BFB(N,N6,N5,N4) TH3BFB(N3,N2,N1)=TH3BFB(N3,N2,N1)+RH3BFB(N,N3,N2,N1) 2-RH3BFB(N,N6,N5,N4) TF1BFB(N3,N2,N1)=TF1BFB(N3,N2,N1)+RF1BFB(N,N3,N2,N1) @@ -6118,8 +6003,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) 2-RKASHS(N,N6,N5,N4) TH0PHS(N3,N2,N1)=TH0PHS(N3,N2,N1)+RH0PHS(N,N3,N2,N1) 2-RH0PHS(N,N6,N5,N4) - TH1PHS(N3,N2,N1)=TH1PHS(N3,N2,N1)+RH1PHS(N,N3,N2,N1) - 2-RH1PHS(N,N6,N5,N4) TH3PHS(N3,N2,N1)=TH3PHS(N3,N2,N1)+RH3PHS(N,N3,N2,N1) 2-RH3PHS(N,N6,N5,N4) TF1PHS(N3,N2,N1)=TF1PHS(N3,N2,N1)+RF1PHS(N,N3,N2,N1) @@ -6136,8 +6019,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) 2-RM1PHS(N,N6,N5,N4) TH0BHB(N3,N2,N1)=TH0BHB(N3,N2,N1)+RH0BHB(N,N3,N2,N1) 2-RH0BHB(N,N6,N5,N4) - TH1BHB(N3,N2,N1)=TH1BHB(N3,N2,N1)+RH1BHB(N,N3,N2,N1) - 2-RH1BHB(N,N6,N5,N4) TH3BHB(N3,N2,N1)=TH3BHB(N3,N2,N1)+RH3BHB(N,N3,N2,N1) 2-RH3BHB(N,N6,N5,N4) TF1BHB(N3,N2,N1)=TF1BHB(N3,N2,N1)+RF1BHB(N,N3,N2,N1) @@ -6167,48 +6048,47 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) C STATE VARIABLES FOR SOLUTES IN MICROPORES AND MACROPORES IN C SOIL SURFACE LAYER FROM OVERLAND FLOW C - ZAL2(0,NY,NX)=ZAL2(0,NY,NX)+TQRAL(NY,NX) - ZFE2(0,NY,NX)=ZFE2(0,NY,NX)+TQRFE(NY,NX) - ZHY2(0,NY,NX)=ZHY2(0,NY,NX)+TQRHY(NY,NX) - ZCA2(0,NY,NX)=ZCA2(0,NY,NX)+TQRCA(NY,NX) - ZMG2(0,NY,NX)=ZMG2(0,NY,NX)+TQRMG(NY,NX) - ZNA2(0,NY,NX)=ZNA2(0,NY,NX)+TQRNA(NY,NX) - ZKA2(0,NY,NX)=ZKA2(0,NY,NX)+TQRKA(NY,NX) - ZOH2(0,NY,NX)=ZOH2(0,NY,NX)+TQROH(NY,NX) - ZSO42(0,NY,NX)=ZSO42(0,NY,NX)+TQRSO(NY,NX) - ZCL2(0,NY,NX)=ZCL2(0,NY,NX)+TQRCL(NY,NX) - ZCO32(0,NY,NX)=ZCO32(0,NY,NX)+TQRC3(NY,NX) - ZHCO32(0,NY,NX)=ZHCO32(0,NY,NX)+TQRHC(NY,NX) - ZAL12(0,NY,NX)=ZAL12(0,NY,NX)+TQRAL1(NY,NX) - ZAL22(0,NY,NX)=ZAL22(0,NY,NX)+TQRAL2(NY,NX) - ZAL32(0,NY,NX)=ZAL32(0,NY,NX)+TQRAL3(NY,NX) - ZAL42(0,NY,NX)=ZAL42(0,NY,NX)+TQRAL4(NY,NX) - ZALS2(0,NY,NX)=ZALS2(0,NY,NX)+TQRALS(NY,NX) - ZFE12(0,NY,NX)=ZFE12(0,NY,NX)+TQRFE1(NY,NX) - ZFE22(0,NY,NX)=ZFE22(0,NY,NX)+TQRFE2(NY,NX) - ZFE32(0,NY,NX)=ZFE32(0,NY,NX)+TQRFE3(NY,NX) - ZFE42(0,NY,NX)=ZFE42(0,NY,NX)+TQRFE4(NY,NX) - ZFES2(0,NY,NX)=ZFES2(0,NY,NX)+TQRFES(NY,NX) - ZCAO2(0,NY,NX)=ZCAO2(0,NY,NX)+TQRCAO(NY,NX) - ZCAC2(0,NY,NX)=ZCAC2(0,NY,NX)+TQRCAC(NY,NX) - ZCAH2(0,NY,NX)=ZCAH2(0,NY,NX)+TQRCAH(NY,NX) - ZCAS2(0,NY,NX)=ZCAS2(0,NY,NX)+TQRCAS(NY,NX) - ZMGO2(0,NY,NX)=ZMGO2(0,NY,NX)+TQRMGO(NY,NX) - ZMGC2(0,NY,NX)=ZMGC2(0,NY,NX)+TQRMGC(NY,NX) - ZMGH2(0,NY,NX)=ZMGH2(0,NY,NX)+TQRMGH(NY,NX) - ZMGS2(0,NY,NX)=ZMGS2(0,NY,NX)+TQRMGS(NY,NX) - ZNAC2(0,NY,NX)=ZNAC2(0,NY,NX)+TQRNAC(NY,NX) - ZNAS2(0,NY,NX)=ZNAS2(0,NY,NX)+TQRNAS(NY,NX) - ZKAS2(0,NY,NX)=ZKAS2(0,NY,NX)+TQRKAS(NY,NX) - H0PO42(0,NY,NX)=H0PO42(0,NY,NX)+TQRH0P(NY,NX) - H1PO42(0,NY,NX)=H1PO42(0,NY,NX)+TQRH1P(NY,NX) - H3PO42(0,NY,NX)=H3PO42(0,NY,NX)+TQRH3P(NY,NX) - ZFE1P2(0,NY,NX)=ZFE1P2(0,NY,NX)+TQRF1P(NY,NX) - ZFE2P2(0,NY,NX)=ZFE2P2(0,NY,NX)+TQRF2P(NY,NX) - ZCA0P2(0,NY,NX)=ZCA0P2(0,NY,NX)+TQRC0P(NY,NX) - ZCA1P2(0,NY,NX)=ZCA1P2(0,NY,NX)+TQRC1P(NY,NX) - ZCA2P2(0,NY,NX)=ZCA2P2(0,NY,NX)+TQRC2P(NY,NX) - ZMG1P2(0,NY,NX)=ZMG1P2(0,NY,NX)+TQRM1P(NY,NX) + ZAL2(0,NY,NX)=ZAL2(0,NY,NX)+TQRAL(NY,NX)+RALFLS(3,0,NY,NX) + ZFE2(0,NY,NX)=ZFE2(0,NY,NX)+TQRFE(NY,NX)+RFEFLS(3,0,NY,NX) + ZHY2(0,NY,NX)=ZHY2(0,NY,NX)+TQRHY(NY,NX)+RHYFLS(3,0,NY,NX) + ZCA2(0,NY,NX)=ZCA2(0,NY,NX)+TQRCA(NY,NX)+RCAFLS(3,0,NY,NX) + ZMG2(0,NY,NX)=ZMG2(0,NY,NX)+TQRMG(NY,NX)+RMGFLS(3,0,NY,NX) + ZNA2(0,NY,NX)=ZNA2(0,NY,NX)+TQRNA(NY,NX)+RNAFLS(3,0,NY,NX) + ZKA2(0,NY,NX)=ZKA2(0,NY,NX)+TQRKA(NY,NX)+RKAFLS(3,0,NY,NX) + ZOH2(0,NY,NX)=ZOH2(0,NY,NX)+TQROH(NY,NX)+ROHFLS(3,0,NY,NX) + ZSO42(0,NY,NX)=ZSO42(0,NY,NX)+TQRSO(NY,NX)+RSOFLS(3,0,NY,NX) + ZCL2(0,NY,NX)=ZCL2(0,NY,NX)+TQRCL(NY,NX)+RCLFLS(3,0,NY,NX) + ZCO32(0,NY,NX)=ZCO32(0,NY,NX)+TQRC3(NY,NX)+RC3FLS(3,0,NY,NX) + ZHCO32(0,NY,NX)=ZHCO32(0,NY,NX)+TQRHC(NY,NX)+RHCFLS(3,0,NY,NX) + ZAL12(0,NY,NX)=ZAL12(0,NY,NX)+TQRAL1(NY,NX)+RAL1FS(3,0,NY,NX) + ZAL22(0,NY,NX)=ZAL22(0,NY,NX)+TQRAL2(NY,NX)+RAL2FS(3,0,NY,NX) + ZAL32(0,NY,NX)=ZAL32(0,NY,NX)+TQRAL3(NY,NX)+RAL3FS(3,0,NY,NX) + ZAL42(0,NY,NX)=ZAL42(0,NY,NX)+TQRAL4(NY,NX)+RAL4FS(3,0,NY,NX) + ZALS2(0,NY,NX)=ZALS2(0,NY,NX)+TQRALS(NY,NX)+RALSFS(3,0,NY,NX) + ZFE12(0,NY,NX)=ZFE12(0,NY,NX)+TQRFE1(NY,NX)+RFE1FS(3,0,NY,NX) + ZFE22(0,NY,NX)=ZFE22(0,NY,NX)+TQRFE2(NY,NX)+RFE2FS(3,0,NY,NX) + ZFE32(0,NY,NX)=ZFE32(0,NY,NX)+TQRFE3(NY,NX)+RFE3FS(3,0,NY,NX) + ZFE42(0,NY,NX)=ZFE42(0,NY,NX)+TQRFE4(NY,NX)+RFE4FS(3,0,NY,NX) + ZFES2(0,NY,NX)=ZFES2(0,NY,NX)+TQRFES(NY,NX)+RFESFS(3,0,NY,NX) + ZCAO2(0,NY,NX)=ZCAO2(0,NY,NX)+TQRCAO(NY,NX)+RCAOFS(3,0,NY,NX) + ZCAC2(0,NY,NX)=ZCAC2(0,NY,NX)+TQRCAC(NY,NX)+RCACFS(3,0,NY,NX) + ZCAH2(0,NY,NX)=ZCAH2(0,NY,NX)+TQRCAH(NY,NX)+RCAHFS(3,0,NY,NX) + ZCAS2(0,NY,NX)=ZCAS2(0,NY,NX)+TQRCAS(NY,NX)+RCASFS(3,0,NY,NX) + ZMGO2(0,NY,NX)=ZMGO2(0,NY,NX)+TQRMGO(NY,NX)+RMGOFS(3,0,NY,NX) + ZMGC2(0,NY,NX)=ZMGC2(0,NY,NX)+TQRMGC(NY,NX)+RMGCFS(3,0,NY,NX) + ZMGH2(0,NY,NX)=ZMGH2(0,NY,NX)+TQRMGH(NY,NX)+RMGHFS(3,0,NY,NX) + ZMGS2(0,NY,NX)=ZMGS2(0,NY,NX)+TQRMGS(NY,NX)+RMGSFS(3,0,NY,NX) + ZNAC2(0,NY,NX)=ZNAC2(0,NY,NX)+TQRNAC(NY,NX)+RNACFS(3,0,NY,NX) + ZNAS2(0,NY,NX)=ZNAS2(0,NY,NX)+TQRNAS(NY,NX)+RNASFS(3,0,NY,NX) + ZKAS2(0,NY,NX)=ZKAS2(0,NY,NX)+TQRKAS(NY,NX)+RKASFS(3,0,NY,NX) + H0PO42(0,NY,NX)=H0PO42(0,NY,NX)+TQRH0P(NY,NX)+RH0PFS(3,0,NY,NX) + H3PO42(0,NY,NX)=H3PO42(0,NY,NX)+TQRH3P(NY,NX)+RH3PFS(3,0,NY,NX) + ZFE1P2(0,NY,NX)=ZFE1P2(0,NY,NX)+TQRF1P(NY,NX)+RF1PFS(3,0,NY,NX) + ZFE2P2(0,NY,NX)=ZFE2P2(0,NY,NX)+TQRF2P(NY,NX)+RF2PFS(3,0,NY,NX) + ZCA0P2(0,NY,NX)=ZCA0P2(0,NY,NX)+TQRC0P(NY,NX)+RC0PFS(3,0,NY,NX) + ZCA1P2(0,NY,NX)=ZCA1P2(0,NY,NX)+TQRC1P(NY,NX)+RC1PFS(3,0,NY,NX) + ZCA2P2(0,NY,NX)=ZCA2P2(0,NY,NX)+TQRC2P(NY,NX)+RC2PFS(3,0,NY,NX) + ZMG1P2(0,NY,NX)=ZMG1P2(0,NY,NX)+TQRM1P(NY,NX)+RM1PFS(3,0,NY,NX) ZALW2(NY,NX)=ZALW2(NY,NX)+TQSAL(NY,NX) ZFEW2(NY,NX)=ZFEW2(NY,NX)+TQSFE(NY,NX) ZHYW2(NY,NX)=ZHYW2(NY,NX)+TQSHY(NY,NX) @@ -6243,7 +6123,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) ZNASW2(NY,NX)=ZNASW2(NY,NX)+TQSNAS(NY,NX) ZKASW2(NY,NX)=ZKASW2(NY,NX)+TQSKAS(NY,NX) H0PO4W2(NY,NX)=H0PO4W2(NY,NX)+TQSH0P(NY,NX) - H1PO4W2(NY,NX)=H1PO4W2(NY,NX)+TQSH1P(NY,NX) H3PO4W2(NY,NX)=H3PO4W2(NY,NX)+TQSH3P(NY,NX) ZFE1PW2(NY,NX)=ZFE1PW2(NY,NX)+TQSF1P(NY,NX) ZFE2PW2(NY,NX)=ZFE2PW2(NY,NX)+TQSF2P(NY,NX) @@ -6262,7 +6141,7 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) ZFE2(L,NY,NX)=ZFE2(L,NY,NX)+TFEFLS(L,NY,NX)+RFEFXS(L,NY,NX) 2+RFEFLZ(L,NY,NX)+TRFE(L,NY,NX)*XNPH ZHY2(L,NY,NX)=ZHY2(L,NY,NX)+THYFLS(L,NY,NX)+RHYFXS(L,NY,NX) - 2+RHYFLZ(L,NY,NX)+TRHY(L,NY,NX)*XNPH + 2+RHYFLZ(L,NY,NX)+(TRHY(L,NY,NX)+XZHYS(L,NY,NX))*XNPH ZCA2(L,NY,NX)=ZCA2(L,NY,NX)+TCAFLS(L,NY,NX)+RCAFXS(L,NY,NX) 2+RCAFLZ(L,NY,NX)+TRCA(L,NY,NX)*XNPH ZMG2(L,NY,NX)=ZMG2(L,NY,NX)+TMGFLS(L,NY,NX)+RMGFXS(L,NY,NX) @@ -6325,8 +6204,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) 2+RKASFZ(L,NY,NX)+TRKAS(L,NY,NX)*XNPH H0PO42(L,NY,NX)=H0PO42(L,NY,NX)+TH0PFS(L,NY,NX)+RH0PXS(L,NY,NX) 2+RH0PFZ(L,NY,NX)+TRH0P(L,NY,NX)*XNPH - H1PO42(L,NY,NX)=H1PO42(L,NY,NX)+TH1PFS(L,NY,NX)+RH1PXS(L,NY,NX) - 2+RH1PFZ(L,NY,NX)+TRH1P(L,NY,NX)*XNPH H3PO42(L,NY,NX)=H3PO42(L,NY,NX)+TH3PFS(L,NY,NX)+RH3PXS(L,NY,NX) 2+RH3PFZ(L,NY,NX)+TRH3P(L,NY,NX)*XNPH ZFE1P2(L,NY,NX)=ZFE1P2(L,NY,NX)+TF1PFS(L,NY,NX)+RF1PXS(L,NY,NX) @@ -6343,8 +6220,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) 2+RM1PFZ(L,NY,NX)+TRM1P(L,NY,NX)*XNPH H0POB2(L,NY,NX)=H0POB2(L,NY,NX)+TH0BFB(L,NY,NX)+RH0BXB(L,NY,NX) 2+RH0BBZ(L,NY,NX)+TRH0B(L,NY,NX)*XNPH - H1POB2(L,NY,NX)=H1POB2(L,NY,NX)+TH1BFB(L,NY,NX)+RH1BXB(L,NY,NX) - 2+RH1BBZ(L,NY,NX)+TRH1B(L,NY,NX)*XNPH H3POB2(L,NY,NX)=H3POB2(L,NY,NX)+TH3BFB(L,NY,NX)+RH3BXB(L,NY,NX) 2+RH3BBZ(L,NY,NX)+TRH3B(L,NY,NX)*XNPH ZF1PB2(L,NY,NX)=ZF1PB2(L,NY,NX)+TF1BFB(L,NY,NX)+RF1BXB(L,NY,NX) @@ -6393,7 +6268,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) ZNASH2(L,NY,NX)=ZNASH2(L,NY,NX)+TNASHS(L,NY,NX)-RNASXS(L,NY,NX) ZKASH2(L,NY,NX)=ZKASH2(L,NY,NX)+TKASHS(L,NY,NX)-RKASXS(L,NY,NX) H0P4H2(L,NY,NX)=H0P4H2(L,NY,NX)+TH0PHS(L,NY,NX)-RH0PXS(L,NY,NX) - H1P4H2(L,NY,NX)=H1P4H2(L,NY,NX)+TH1PHS(L,NY,NX)-RH1PXS(L,NY,NX) H3P4H2(L,NY,NX)=H3P4H2(L,NY,NX)+TH3PHS(L,NY,NX)-RH3PXS(L,NY,NX) ZF1PH2(L,NY,NX)=ZF1PH2(L,NY,NX)+TF1PHS(L,NY,NX)-RF1PXS(L,NY,NX) ZF2PH2(L,NY,NX)=ZF2PH2(L,NY,NX)+TF2PHS(L,NY,NX)-RF2PXS(L,NY,NX) @@ -6402,7 +6276,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) ZC2PH2(L,NY,NX)=ZC2PH2(L,NY,NX)+TC2PHS(L,NY,NX)-RC2PXS(L,NY,NX) ZM1PH2(L,NY,NX)=ZM1PH2(L,NY,NX)+TM1PHS(L,NY,NX)-RM1PXS(L,NY,NX) H0PBH2(L,NY,NX)=H0PBH2(L,NY,NX)+TH0BHB(L,NY,NX)-RH0BXB(L,NY,NX) - H1PBH2(L,NY,NX)=H1PBH2(L,NY,NX)+TH1BHB(L,NY,NX)-RH1BXB(L,NY,NX) H3PBH2(L,NY,NX)=H3PBH2(L,NY,NX)+TH3BHB(L,NY,NX)-RH3BXB(L,NY,NX) ZF1BH2(L,NY,NX)=ZF1BH2(L,NY,NX)+TF1BHB(L,NY,NX)-RF1BXB(L,NY,NX) ZF2BH2(L,NY,NX)=ZF2BH2(L,NY,NX)+TF2BHB(L,NY,NX)-RF2BXB(L,NY,NX) diff --git a/f77src/uptake.f b/f77src/uptake.f index 192669e..3c33e4a 100755 --- a/f77src/uptake.f +++ b/f77src/uptake.f @@ -73,6 +73,7 @@ SUBROUTINE uptake(I,J,NHW,NHE,NVN,NVS) UPNH4(NZ,NY,NX)=0.0 UPNO3(NZ,NY,NX)=0.0 UPH2P(NZ,NY,NX)=0.0 + UPH1P(NZ,NY,NX)=0.0 UPNF(NZ,NY,NX)=0.0 C C RESET UPTAKE ARRAYS @@ -790,6 +791,8 @@ SUBROUTINE uptake(I,J,NHW,NHE,NVN,NVS) TFNOBX=0.0 TFPO4X=0.0 TFPOBX=0.0 + TFP14X=0.0 + TFP1BX=0.0 C C ROOT UPTAKE CAPACITY 'FWSRT' DEPENDS ON ROOT PROTEIN CONTENT C RELATIVE TO 5% FOR WHICH ACTIVE UPTAKE PARAMETERS ARE DEFINED @@ -874,13 +877,25 @@ SUBROUTINE uptake(I,J,NHW,NHE,NVN,NVS) ELSE FPOBX=FPQ(L,NZ) ENDIF + IF(RP14Y(L,NY,NX).GT.ZEROS(NY,NX))THEN + FP14X=AMAX1(FPP(L,NZ),RUPP1P(N,L,NZ,NY,NX)/RP14Y(L,NY,NX)) + ELSE + FP14X=FPQ(L,NZ) + ENDIF + IF(RP1BY(L,NY,NX).GT.ZEROS(NY,NX))THEN + FP1BX=AMAX1(FPP(L,NZ),RUPP1B(N,L,NZ,NY,NX)/RP1BY(L,NY,NX)) + ELSE + FP1BX=FPQ(L,NZ) + ENDIF TFOXYX=TFOXYX+FOXYX TFNH4X=TFNH4X+FNH4X TFNO3X=TFNO3X+FNO3X TFPO4X=TFPO4X+FPO4X + TFP14X=TFP14X+FP14X TFNHBX=TFNHBX+FNHBX TFNOBX=TFNOBX+FNOBX TFPOBX=TFPOBX+FPOBX + TFP1BX=TFP1BX+FP1BX C C ROOT O2 DEMAND CALCULATED FROM O2 NON-LIMITED RESPIRATION RATE C @@ -1696,24 +1711,26 @@ SUBROUTINE uptake(I,J,NHW,NHE,NVN,NVS) RUONOB(N,L,NZ,NY,NX)=0.0 RUCNOB(N,L,NZ,NY,NX)=0.0 ENDIF - IF(FPUP.GT.1.0E-06)THEN C C PARAMETERS FOR RADIAL MASS FLOW AND DIFFUSION OF PO4 C FROM SOIL TO ROOT +C + IF(FPUP.GT.1.0E-06)THEN +C +C H2PO4/HPO4 UPTAKE C POSGX=POSGL(L,NY,NX)*TORT(NPH,L,NY,NX) PATHL=AMIN1(PATH(N,L),RRADL(N,L)+SQRT(2.0*POSGX)) DIFFL=POSGX*RTARR(N,L)/LOG(PATHL/RRADL(N,L)) C -C PO4 UPTAKE IN NON-BAND SOIL ZONE +C H2PO4 UPTAKE IN NON-BAND SOIL ZONE C IF(VLPO4(L,NY,NX).GT.ZERO.AND.CH2P4(L,NY,NX) 2.GT.UPMNPO(N,NZ,NY,NX))THEN - FH2P=CPO4S(L,NY,NX)/CH2P4(L,NY,NX) RMFH2P=UPWTRP*VLPO4(L,NY,NX) - DIFPO=DIFFL*FH2P*VLPO4(L,NY,NX) + DIFPO=DIFFL*VLPO4(L,NY,NX) C -C PO4 UPTAKE DEMAND FROM ROOT UPTAKE PARAMETERS ENTERED IN 'READQ' +C H2PO4 UPTAKE DEMAND FROM ROOT UPTAKE PARAMETERS ENTERED IN 'READQ' C AND FROM ROOT SURFACE AREA, C AND N CONSTRAINTS CALCULATED ABOVE C UPMXP=UPMXPO(N,NZ,NY,NX)*RTARP(N,L,NZ,NY,NX) @@ -1721,7 +1738,7 @@ SUBROUTINE uptake(I,J,NHW,NHE,NVN,NVS) UPMX=UPMXP*WFR(N,L,NZ,NY,NX) C C SOLUTION FOR MASS FLOW + DIFFUSION OF PO4 IN AQUEOUS PHASE OF -C SOIL = ACTIVE UPTAKE OF PO4 BY ROOT, CONSTRAINED BY COMPETITION +C SOIL = ACTIVE UPTAKE OF H2PO4 BY ROOT, CONSTRAINED BY COMPETITION C WITH OTHER ROOT AND MICROBIAL POPULATIONS C X=(DIFPO+RMFH2P)*CH2P4(L,NY,NX) @@ -1744,7 +1761,7 @@ SUBROUTINE uptake(I,J,NHW,NHE,NVN,NVS) C 2,H2PO4(L,NY,NX),RUPPOP(N,L,NZ,NY,NX),UPMX,DIFPO,UPKMPO(N,NZ,NY,NX) C 3,UPMNPO(N,NZ,NY,NX),RMFH2P,CH2P4(L,NY,NX),UPMXP,WFR(N,L,NZ,NY,NX) C 4,FCUP,FZUP,FPUP,UPMXPO(N,NZ,NY,NX),RTARP(N,L,NZ,NY,NX),FWSRT -C 5,TFN4(L,NZ,NY,NX),DIFFL,FH2P,CPO4S(L,NY,NX),CPOOLR(N,L,NZ,NY,NX) +C 5,TFN4(L,NZ,NY,NX),DIFFL,CPO4S(L,NY,NX),CPOOLR(N,L,NZ,NY,NX) C 6,PPOOLR(N,L,NZ,NY,NX),RTKH2P,PP(NZ,NY,NX) C 2,RTLGP(N,L,NZ,NY,NX) 2223 FORMAT(A8,5I4,40E12.4) @@ -1756,15 +1773,14 @@ SUBROUTINE uptake(I,J,NHW,NHE,NVN,NVS) RUCH2P(N,L,NZ,NY,NX)=0.0 ENDIF C -C PO4 UPTAKE IN BAND SOIL ZONE +C H2PO4 UPTAKE IN BAND SOIL ZONE C - IF(VLPOB(L,NY,NX).GT.ZERO.AND.CH2PB(L,NY,NX) + IF(VLPOB(L,NY,NX).GT.ZERO.AND.CH2P4B(L,NY,NX) 2.GT.UPMNPO(N,NZ,NY,NX))THEN - FH2P=CPO4B(L,NY,NX)/CH2PB(L,NY,NX) RMFH2B=UPWTRP*VLPOB(L,NY,NX) - DIFPO=DIFFL*FH2P*VLPOB(L,NY,NX) + DIFPO=DIFFL*VLPOB(L,NY,NX) C -C PO4 UPTAKE DEMAND FROM ROOT UPTAKE PARAMETERS ENTERED IN 'READQ' +C H2PO4 UPTAKE DEMAND FROM ROOT UPTAKE PARAMETERS ENTERED IN 'READQ' C AND FROM ROOT SURFACE AREA, C AND N CONSTRAINTS CALCULATED ABOVE C UPMXP=UPMXPO(N,NZ,NY,NX)*RTARP(N,L,NZ,NY,NX) @@ -1772,10 +1788,10 @@ SUBROUTINE uptake(I,J,NHW,NHE,NVN,NVS) UPMX=UPMXP*WFR(N,L,NZ,NY,NX) C C SOLUTION FOR MASS FLOW + DIFFUSION OF PO4 IN AQUEOUS PHASE OF -C SOIL = ACTIVE UPTAKE OF PO4 BY ROOT, CONSTRAINED BY COMPETITION +C SOIL = ACTIVE UPTAKE OF H2PO4 BY ROOT, CONSTRAINED BY COMPETITION C WITH OTHER ROOT AND MICROBIAL POPULATIONS C - X=(DIFPO+RMFH2B)*CH2PB(L,NY,NX) + X=(DIFPO+RMFH2B)*CH2P4B(L,NY,NX) Y=DIFPO*UPMNPO(N,NZ,NY,NX) B=-UPMX-DIFPO*UPKMPO(N,NZ,NY,NX)-X+Y C=(X-Y)*UPMX @@ -1796,6 +1812,96 @@ SUBROUTINE uptake(I,J,NHW,NHE,NVN,NVS) RUOH2B(N,L,NZ,NY,NX)=0.0 RUCH2B(N,L,NZ,NY,NX)=0.0 ENDIF +C +C HPO4 UPTAKE IN NON-BAND SOIL ZONE +C + IF(VLPO4(L,NY,NX).GT.ZERO.AND.CH1P4(L,NY,NX) + 2.GT.UPMNPO(N,NZ,NY,NX))THEN + RMFH1P=UPWTRP*VLPO4(L,NY,NX) + DIFPO=DIFFL*VLPO4(L,NY,NX) +C +C HPO4 UPTAKE DEMAND FROM ROOT UPTAKE PARAMETERS ENTERED IN 'READQ' +C AND FROM ROOT SURFACE AREA, C AND N CONSTRAINTS CALCULATED ABOVE +C + UPMXP=0.1*UPMXPO(N,NZ,NY,NX)*RTARP(N,L,NZ,NY,NX) + 2*FWSRT*TFN4(L,NZ,NY,NX)*VLPO4(L,NY,NX)*AMIN1(FCUP,FPUP) + UPMX=UPMXP*WFR(N,L,NZ,NY,NX) +C +C SOLUTION FOR MASS FLOW + DIFFUSION OF HPO4 IN AQUEOUS PHASE OF +C SOIL = ACTIVE UPTAKE OF HPO4 BY ROOT, CONSTRAINED BY COMPETITION +C WITH OTHER ROOT AND MICROBIAL POPULATIONS +C + X=(DIFPO+RMFH1P)*CH1P4(L,NY,NX) + Y=DIFPO*UPMNPO(N,NZ,NY,NX) + B=-UPMX-DIFPO*UPKMPO(N,NZ,NY,NX)-X+Y + C=(X-Y)*UPMX + RTKH1P=(-B-SQRT(B*B-4.0*C))/2.0 + BP=-UPMXP-DIFPO*UPKMPO(N,NZ,NY,NX)-X+Y + CP=(X-Y)*UPMXP + RTKHPP=(-BP-SQRT(BP*BP-4.0*CP))/2.0 + H1POM=UPMNPO(N,NZ,NY,NX)*VOLW(L,NY,NX)*VLPO4(L,NY,NX) + H1POX=AMAX1(0.0,FP14X*(H1PO4(L,NY,NX)-H1POM)) + RUPP1P(N,L,NZ,NY,NX)=AMAX1(0.0,RTKH1P*PP(NZ,NY,NX)) + RUPH1P(N,L,NZ,NY,NX)=AMIN1(H1POX,RUPP1P(N,L,NZ,NY,NX)) + RUOH1P(N,L,NZ,NY,NX)=AMIN1(H1POX,AMAX1(0.0 + 2,RTKHPP*PP(NZ,NY,NX))) + RUCH1P(N,L,NZ,NY,NX)=RUPH1P(N,L,NZ,NY,NX)/FCUP +C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.NZ.EQ.3)THEN +C WRITE(*,2226)'UPPO4',I,J,NZ,L,N,RUPH2P(N,L,NZ,NY,NX),FPO4X +C 2,H2PO4(L,NY,NX),RUPPOP(N,L,NZ,NY,NX),UPMX,DIFPO,UPKMPO(N,NZ,NY,NX) +C 3,UPMNPO(N,NZ,NY,NX),RMFH2P,CH2P4(L,NY,NX),UPMXP,WFR(N,L,NZ,NY,NX) +C 4,FCUP,FZUP,FPUP,UPMXPO(N,NZ,NY,NX),RTARP(N,L,NZ,NY,NX),FWSRT +C 5,TFN4(L,NZ,NY,NX),DIFFL,FH2P,CPO4S(L,NY,NX),CPOOLR(N,L,NZ,NY,NX) +C 6,PPOOLR(N,L,NZ,NY,NX),RTKH2P,PP(NZ,NY,NX) +C 2,RTLGP(N,L,NZ,NY,NX) +2226 FORMAT(A8,5I4,40E12.4) +C ENDIF + ELSE + RUPP1P(N,L,NZ,NY,NX)=0.0 + RUPH1P(N,L,NZ,NY,NX)=0.0 + RUOH1P(N,L,NZ,NY,NX)=0.0 + RUCH1P(N,L,NZ,NY,NX)=0.0 + ENDIF +C +C HPO4 UPTAKE IN BAND SOIL ZONE +C + IF(VLPOB(L,NY,NX).GT.ZERO.AND.CH1P4B(L,NY,NX) + 2.GT.UPMNPO(N,NZ,NY,NX))THEN + RMFH2B=UPWTRP*VLPOB(L,NY,NX) + DIFPO=DIFFL*VLPOB(L,NY,NX) +C +C HPO4 UPTAKE DEMAND FROM ROOT UPTAKE PARAMETERS ENTERED IN 'READQ' +C AND FROM ROOT SURFACE AREA, C AND N CONSTRAINTS CALCULATED ABOVE +C + UPMXP=0.1*UPMXPO(N,NZ,NY,NX)*RTARP(N,L,NZ,NY,NX) + 2*FWSRT*TFN4(L,NZ,NY,NX)*VLPOB(L,NY,NX)*AMIN1(FCUP,FPUP) + UPMX=UPMXP*WFR(N,L,NZ,NY,NX) +C +C SOLUTION FOR MASS FLOW + DIFFUSION OF HPO4 IN AQUEOUS PHASE OF +C SOIL = ACTIVE UPTAKE OF HPO4 BY ROOT, CONSTRAINED BY COMPETITION +C WITH OTHER ROOT AND MICROBIAL POPULATIONS +C + X=(DIFPO+RMFH2B)*CH1P4B(L,NY,NX) + Y=DIFPO*UPMNPO(N,NZ,NY,NX) + B=-UPMX-DIFPO*UPKMPO(N,NZ,NY,NX)-X+Y + C=(X-Y)*UPMX + RTKH1B=(-B-SQRT(B*B-4.0*C))/2.0 + BP=-UPMXP-DIFPO*UPKMPO(N,NZ,NY,NX)-X+Y + CP=(X-Y)*UPMXP + RTKHPB=(-BP-SQRT(BP*BP-4.0*CP))/2.0 + H1PXM=UPMNPO(N,NZ,NY,NX)*VOLW(L,NY,NX)*VLPOB(L,NY,NX) + H1PXB=AMAX1(0.0,FP1BX*(H1POB(L,NY,NX)-H1PXM)) + RUPP1B(N,L,NZ,NY,NX)=AMAX1(0.0,RTKH1B*PP(NZ,NY,NX)) + RUPH1B(N,L,NZ,NY,NX)=AMIN1(H1PXB,RUPP1B(N,L,NZ,NY,NX)) + RUOH1B(N,L,NZ,NY,NX)=AMIN1(H1PXB + 2,AMAX1(0.0,RTKHPB*PP(NZ,NY,NX))) + RUCH1B(N,L,NZ,NY,NX)=RUPH1B(N,L,NZ,NY,NX)/FCUP + ELSE + RUPP1B(N,L,NZ,NY,NX)=0.0 + RUPH1B(N,L,NZ,NY,NX)=0.0 + RUOH1B(N,L,NZ,NY,NX)=0.0 + RUCH1B(N,L,NZ,NY,NX)=0.0 + ENDIF ELSE RUPPOP(N,L,NZ,NY,NX)=0.0 RUPH2P(N,L,NZ,NY,NX)=0.0 @@ -1805,6 +1911,14 @@ SUBROUTINE uptake(I,J,NHW,NHE,NVN,NVS) RUPH2B(N,L,NZ,NY,NX)=0.0 RUOH2B(N,L,NZ,NY,NX)=0.0 RUCH2B(N,L,NZ,NY,NX)=0.0 + RUPP1P(N,L,NZ,NY,NX)=0.0 + RUPH1P(N,L,NZ,NY,NX)=0.0 + RUOH1P(N,L,NZ,NY,NX)=0.0 + RUCH1P(N,L,NZ,NY,NX)=0.0 + RUPP1B(N,L,NZ,NY,NX)=0.0 + RUPH1B(N,L,NZ,NY,NX)=0.0 + RUOH1B(N,L,NZ,NY,NX)=0.0 + RUCH1B(N,L,NZ,NY,NX)=0.0 ENDIF ELSE RUNNHP(N,L,NZ,NY,NX)=0.0 @@ -1831,6 +1945,14 @@ SUBROUTINE uptake(I,J,NHW,NHE,NVN,NVS) RUPH2B(N,L,NZ,NY,NX)=0.0 RUOH2B(N,L,NZ,NY,NX)=0.0 RUCH2B(N,L,NZ,NY,NX)=0.0 + RUPP1P(N,L,NZ,NY,NX)=0.0 + RUPH1P(N,L,NZ,NY,NX)=0.0 + RUOH1P(N,L,NZ,NY,NX)=0.0 + RUCH1P(N,L,NZ,NY,NX)=0.0 + RUPP1B(N,L,NZ,NY,NX)=0.0 + RUPH1B(N,L,NZ,NY,NX)=0.0 + RUOH1B(N,L,NZ,NY,NX)=0.0 + RUCH1B(N,L,NZ,NY,NX)=0.0 ENDIF ELSE RCOFLA(N,L,NZ,NY,NX)=0.0 @@ -1880,6 +2002,14 @@ SUBROUTINE uptake(I,J,NHW,NHE,NVN,NVS) RUPH2B(N,L,NZ,NY,NX)=0.0 RUOH2B(N,L,NZ,NY,NX)=0.0 RUCH2B(N,L,NZ,NY,NX)=0.0 + RUPP1P(N,L,NZ,NY,NX)=0.0 + RUPH1P(N,L,NZ,NY,NX)=0.0 + RUOH1P(N,L,NZ,NY,NX)=0.0 + RUCH1P(N,L,NZ,NY,NX)=0.0 + RUPP1B(N,L,NZ,NY,NX)=0.0 + RUPH1B(N,L,NZ,NY,NX)=0.0 + RUOH1B(N,L,NZ,NY,NX)=0.0 + RUCH1B(N,L,NZ,NY,NX)=0.0 IF(N.EQ.1)RUPNF(L,NZ,NY,NX)=0.0 ENDIF C @@ -1899,6 +2029,8 @@ SUBROUTINE uptake(I,J,NHW,NHE,NVN,NVS) 2+RUPNOB(N,L,NZ,NY,NX) UPH2P(NZ,NY,NX)=UPH2P(NZ,NY,NX)+RUPH2P(N,L,NZ,NY,NX) 2+RUPH2B(N,L,NZ,NY,NX) + UPH1P(NZ,NY,NX)=UPH1P(NZ,NY,NX)+RUPH1P(N,L,NZ,NY,NX) + 2+RUPH1B(N,L,NZ,NY,NX) C IF(J.EQ.12)THEN C WRITE(*,8765)'PLANT',I,J,NX,NY,L,NZ,N,TFOXYX,TFNH4X C 2,TFNO3X,TFPO4X,TFNHBX,TFNOBX,TFPOBX diff --git a/f77src/watsub.f b/f77src/watsub.f index 8e617fd..4b53735 100755 --- a/f77src/watsub.f +++ b/f77src/watsub.f @@ -1,3098 +1,3103 @@ - - SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) -C -C THIS SUBROUTINE CACULATES ENERGY BALANCES OF SNOW, RESIDUE -C AND SOIL SURFACES, FREEZING, THAWING, AND HEAT AND WATER -C TRANSFER THROUGH SOIL PROFILES -C - include "parameters.h" - include "blkc.h" - include "blk2a.h" - include "blk2b.h" - include "blk2c.h" - include "blk5.h" - include "blk8a.h" - include "blk8b.h" - include "blk10.h" - include "blk11a.h" - include "blk11b.h" - include "blk13a.h" - include "blk13b.h" - include "blk13c.h" - include "blk15a.h" - include "blk15b.h" - include "blk22a.h" - include "blk22b.h" - include "blk22c.h" - include "blktest.h" - DIMENSION VOLWX1(JZ,JY,JX) - 2,TVOL1(JY,JX),TVOLW(JY,JX),FMAC(JZ,JY,JX),FGRD(JZ,JY,JX) - 3,VOLW1(0:JZ,JY,JX),VOLI1(0:JZ,JY,JX),VOLPX1(JZ,JY,JX) - 4,VHCP1(JZ,JY,JX),TK1(0:JZ,JY,JX),TWFLXL(JZ,JY,JX),TTFLXL(JZ,JY,JX) - 5,VOLP1(0:JZ,JY,JX),WGSG1(JZ,JY,JX),TWFLXH(JZ,JY,JX) - 6,VOLS0(JY,JX),VOLI0(JY,JX),VOLW0(JY,JX),VOLS1(JY,JX) - 7,DPTHS0(JY,JX),VHCP0(JY,JX),TK0(JY,JX),AREAU(JZ,JY,JX) - 8,FLQ0S(JY,JX),FLQ0W(JY,JX),FLQ1(JY,JX),FLH1(JY,JX) - 9,FLY1(JY,JX),HWFLQ0(JY,JX),HWFLQ1(JY,JX),HWFLY1(JY,JX) - 1,RAR(JY,JX),RAGS(JY,JX),WGSG0(JY,JX),WRP(0:JZ,JY,JX),RARG(JY,JX) - 2,RAGR(JY,JX),RAGW(JY,JX),BARE(JY,JX),CVRD(JY,JX),PAREG(JY,JX) - 3,RAG(JY,JX),PARSG(JY,JX),PARER(JY,JX),PARSR(JY,JX),WGSGR0(JY,JX) - 4,VPQ(JY,JX),TKQ(JY,JX),VHCPR1(JY,JX),QR1(2,JV,JH),HQR1(2,JV,JH) - 5,QS1(2,JV,JH),QW1(2,JV,JH),QI1(2,JV,JH),HQS1(2,JV,JH) - 6,TQR1(JY,JX),THQR1(JY,JX),TQS1(JY,JX),TQW1(JY,JX) - 7,TQI1(JY,JX),THQS1(JY,JX),EVAP(JY,JX) - 8,EVAPS(JY,JX),EVAPR(JY,JX),TFLX0(JY,JX),WFLXA(JY,JX),WFLXB(JY,JX) - 9,FLW0L(JY,JX),FLW0S(JY,JX),HFLW0L(JY,JX),RFLWV(JY,JX),FLWRL(JY,JX) - 1,HFLWRL(JY,JX),FINHL(JZ,JY,JX),FLWVL(JZ,JY,JX),FLWL(3,JD,JV,JH) - DIMENSION FLWHL(3,JD,JV,JH),HFLWL(3,JD,JV,JH),AVCNHL(3,JD,JV,JH) - 2,TFLWL(JZ,JY,JX),TFLWHL(JZ,JY,JX),THFLWL(JZ,JY,JX) - 3,WFLXL(3,JZ,JY,JX),TFLXL(3,JZ,JY,JX),FLWZ1(JY,JX),FLWS1(JY,JX) - 4,FLWI1(JY,JX),FLSI1(JY,JX),HFLWZ1(JY,JX),HFLSI1(JY,JX) - 5,THRYW(JY,JX),THRMW(JY,JX),THRMS(JY,JX),THRMR(JY,JX) - 6,THRYG(JY,JX),THRYR(JY,JX),RADXW(JY,JX),RADXG(JY,JX) - 7,RADXR(JY,JX),FLWLX(3,JD,JV,JH),TFLWLX(JZ,JY,JX) - 8,FLU1(JZ,JY,JX),HWFLU1(JZ,JY,JX),PSISM1(0:JZ,JY,JX) - 4,ALTG(JY,JX),WFLXLH(3,JZ,JY,JX),DLYRR(JY,JX),WFLXR(JY,JX) - 6,TFLXR(JY,JX),HCNDR(JY,JX),CNDH1(JZ,JY,JX) - 7,THETWX(0:JZ,JY,JX),THETIX(0:JZ,JY,JX),THETPX(0:JZ,JY,JX) - 8,VOLAH1(JZ,JY,JX),VOLWH1(JZ,JY,JX),VOLPH1(JZ,JY,JX) - 9,VOLIH1(JZ,JY,JX),THETPY(0:JZ,JY,JX) - PARAMETER (THETPI=0.00,EMMS=0.98,EMMW=0.98,EMMR=0.98 - 2,RACX=0.0278,RARX=0.0139,RZ=0.0278,RZR=0.0278,RZW=0.0278 - 3,RAM=1.39E-03,HYSTK=1.00,FQS=1.0E-00,DPTHSX=0.05,FPSISR=-4.0) - PARAMETER (Z1S=0.0175,Z2SW=12.0,Z2SD=12.0,Z3SX=0.50 - 2,Z1R=0.0175,Z2RW=3.0,Z2RD=12.0,Z3R=0.50) - PARAMETER (VISCW=1.18E-06,VISCA=1.44E-05,DIFFW=1.45E-07 - 2,DIFFA=2.01E-05,EXPNW=2.07E-04,EXPNA=3.66E-03,GRAV=9.8 - 3,RYLXW=GRAV*EXPNW/(VISCW*DIFFW),RYLXA=GRAV*EXPNA/(VISCA*DIFFA) - 4,PRNTW=VISCW/DIFFW,PRNTA=VISCA/DIFFA - 5,DNUSW=(1.0+(0.492/PRNTW)**0.5625)**0.4444 - 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 - 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 - FQSM=FQS*XNPH - DO 9995 NX=NHW,NHE - DO 9990 NY=NVN,NVS -C -C SET INTERNAL TIME STEPS FROM CYCLES PER HOUR ENTERED IN 'READS' -C XNPH = INTERNAL TIME STEP FOR SNOWPACK, SOIL PROFILE -C XNPR = INTERNAL TIME STEP FOR SURFACE RESIDUE -C - XNPHR=XNPH*XNPR - HYSTX=HYSTK -C -C ADJUST SURFACE ELEVATION USED IN RUNOFF FOR EROSION -C - ALTG(NY,NX)=ALT(NY,NX)-CDPTH(NU(NY,NX),NY,NX) - 2+DLYR(3,NU(NY,NX),NY,NX) -C -C ENTER STATE VARIABLES AND DRIVERS INTO LOCAL ARRAYS -C FOR USE AT INTERNAL TIME STEP -C - VOLS0(NY,NX)=VOLSS(NY,NX) - VOLI0(NY,NX)=VOLIS(NY,NX) - VOLW0(NY,NX)=VOLWS(NY,NX) - VOLS1(NY,NX)=VOLS(NY,NX) - DPTHS0(NY,NX)=DPTHS(NY,NX) - VHCP0(NY,NX)=VHCPW(NY,NX) - TK0(NY,NX)=TKW(NY,NX) - WFLXR(NY,NX)=0.0 - TFLXR(NY,NX)=0.0 - DO 65 L=NU(NY,NX),NL(NY,NX) - IF(CDPTH(L,NY,NX).GE.WDPTH(I,NY,NX))THEN - LWDPTH=L - GO TO 55 - ENDIF -65 CONTINUE -55 CONTINUE -C -C SET INITIAL SOIL VALUES -C - DO 30 L=NU(NY,NX),NL(NY,NX) -C -C ENTER STATE VARIABLES AND DRIVERS INTO LOCAL ARRAYS -C FOR USE AT INTERNAL TIME STEP -C - PSISM1(L,NY,NX)=PSISM(L,NY,NX) - VOLW1(L,NY,NX)=VOLW(L,NY,NX) - VOLWX1(L,NY,NX)=VOLWX(L,NY,NX) - VOLI1(L,NY,NX)=VOLI(L,NY,NX) - VOLWH1(L,NY,NX)=VOLWH(L,NY,NX) - VOLIH1(L,NY,NX)=VOLIH(L,NY,NX) - VOLP1(L,NY,NX)=AMAX1(0.0,VOLA(L,NY,NX)-VOLW1(L,NY,NX) - 2-VOLI1(L,NY,NX)) - VOLAH1(L,NY,NX)=AMAX1(0.0,VOLAH(L,NY,NX)-FVOLAH*CCLAY(L,NY,NX) - 2*(VOLW1(L,NY,NX)/VOLX(L,NY,NX)-WP(L,NY,NX))*VOLT(L,NY,NX)) - VOLPH1(L,NY,NX)=AMAX1(0.0,VOLAH1(L,NY,NX)-VOLWH1(L,NY,NX) - 2-VOLIH1(L,NY,NX)) - VOLPX1(L,NY,NX)=VOLP1(L,NY,NX)*HYST(L,NY,NX) - VOLWM(1,L,NY,NX)=VOLW1(L,NY,NX) - VOLWHM(1,L,NY,NX)=VOLWH1(L,NY,NX) - VOLPM(1,L,NY,NX)=VOLP1(L,NY,NX)+VOLPH1(L,NY,NX) - 2+THETPI*(VOLI1(L,NY,NX)+VOLIH1(L,NY,NX)) - THETWX(L,NY,NX)=AMAX1(0.0,(VOLW1(L,NY,NX)+VOLWH1(L,NY,NX)) - 2/VOLT(L,NY,NX)) - THETIX(L,NY,NX)=AMAX1(0.0,(VOLI1(L,NY,NX)+VOLIH1(L,NY,NX)) - 2/VOLT(L,NY,NX)) - THETPX(L,NY,NX)=AMAX1(0.0,(VOLP1(L,NY,NX)+VOLPH1(L,NY,NX)) - 2/VOLT(L,NY,NX)) - THETPM(1,L,NY,NX)=THETPX(L,NY,NX) - VHCP1(L,NY,NX)=VHCM(L,NY,NX)+4.19*(VOLW1(L,NY,NX) - 2+VOLWH1(L,NY,NX))+1.9274*(VOLI1(L,NY,NX)+VOLIH1(L,NY,NX)) - IF(VOLA(L,NY,NX)+VOLAH(L,NY,NX).GT.ZEROS(NY,NX))THEN - THETPY(L,NY,NX)=AMAX1(0.0,(VOLP1(L,NY,NX)+VOLPH1(L,NY,NX)) - 2/(VOLA(L,NY,NX)+VOLAH(L,NY,NX))) - ELSE - THETPY(L,NY,NX)=0.0 - ENDIF -C -C MACROPOROSITY -C - IF(VOLAH(L,NY,NX).GT.ZEROS(NY,NX))THEN - FMAC(L,NY,NX)=FHOL(L,NY,NX)*VOLAH1(L,NY,NX)/VOLAH(L,NY,NX) - CNDH1(L,NY,NX)=XNPH*NHOL(L,NY,NX)*CNDH(L,NY,NX) - 2*(VOLAH1(L,NY,NX)/VOLAH(L,NY,NX))**2 - ELSE - FMAC(L,NY,NX)=0.0 - CNDH1(L,NY,NX)=0.0 - ENDIF - FGRD(L,NY,NX)=1.0-FMAC(L,NY,NX) - TK1(L,NY,NX)=TKS(L,NY,NX) - IF(L.EQ.LWDPTH)THEN - FLU(L,NY,NX)=PRECU(NY,NX) - HWFLU(L,NY,NX)=4.19*TKA(NY,NX)*PRECU(NY,NX) - FLU1(L,NY,NX)=FLU(L,NY,NX)*XNPH - HWFLU1(L,NY,NX)=HWFLU(L,NY,NX)*XNPH - ELSE - FLU(L,NY,NX)=0.0 - HWFLU(L,NY,NX)=0.0 - FLU1(L,NY,NX)=0.0 - HWFLU1(L,NY,NX)=0.0 - ENDIF - IF(CDPTH(L,NY,NX).GE.DTBLX(NY,NX))THEN - AREAU(L,NY,NX)=AMIN1(1.0,AMAX1(0.0 - 2,(CDPTH(L,NY,NX)-DTBLX(NY,NX)) - 2/DLYR(3,L,NY,NX))) - ELSE - AREAU(L,NY,NX)=0.0 - ENDIF -30 CONTINUE -C -C ENTER STATE VARIABLES AND DRIVERS INTO LOCAL ARRAYS -C FOR USE AT INTERNAL TIME STEP -C - THRMG(NY,NX)=0.0 - FLQGM(NY,NX)=0.0 -C -C INITIALIZE SNOW AND SOIL-RESIDUE THERMAL CONDUCTIVITIES -C - VHCPR1(NY,NX)=2.496E-06*ORGC(0,NY,NX)+4.19*VOLW(0,NY,NX) - 2+1.9274*VOLI(0,NY,NX) - VOLW1(0,NY,NX)=AMAX1(0.0,VOLW(0,NY,NX)) - VOLI1(0,NY,NX)=AMAX1(0.0,VOLI(0,NY,NX)) - VOLP1(0,NY,NX)=AMAX1(0.0,VOLA(0,NY,NX)-VOLW1(0,NY,NX) - 2-VOLI1(0,NY,NX)) - VOLWM(1,0,NY,NX)=VOLW1(0,NY,NX) - VOLPM(1,0,NY,NX)=VOLP1(0,NY,NX) - TVOL1(NY,NX)=AMAX1(0.0,VOLW1(0,NY,NX)+VOLI1(0,NY,NX) - 2-VOLWRX(NY,NX)) - TVOLW(NY,NX)=AMAX1(0.0,VOLW1(0,NY,NX)-VOLWRX(NY,NX)) - VOLGM(1,NY,NX)=AMAX1(0.0,TVOL1(NY,NX)) - IF(VOLR(NY,NX).GT.ZEROS(NY,NX))THEN - THETWX(0,NY,NX)=AMAX1(0.0,VOLW1(0,NY,NX)/VOLR(NY,NX)) - THETIX(0,NY,NX)=AMAX1(0.0,VOLI1(0,NY,NX)/VOLR(NY,NX)) - THETPX(0,NY,NX)=AMAX1(0.0,VOLP1(0,NY,NX)/VOLR(NY,NX)) - ELSE - THETWX(0,NY,NX)=0.0 - THETIX(0,NY,NX)=0.0 - THETPX(0,NY,NX)=0.0 - ENDIF - THETPM(1,0,NY,NX)=THETPX(0,NY,NX) - PSISM1(0,NY,NX)=PSISM(0,NY,NX) - TK1(0,NY,NX)=TKS(0,NY,NX) -C -C RESIDUE COVERAGE OF SOIL SURFACE -C - IF(BKDS(NU(NY,NX),NY,NX).GT.ZERO)THEN - BARE(NY,NX)=AMAX1(0.0,EXP(-0.8E-02*(TRC0(NY,NX)/AREA(3,0,NY,NX))) - 2-AMIN1(1.0,TVOLW(NY,NX)/VOLWG(NY,NX))) - ELSE - BARE(NY,NX)=0.0 - ENDIF - CVRD(NY,NX)=1.0-BARE(NY,NX) - PRECD(NY,NX)=PRECA(NY,NX)*FRADG(NY,NX)*BARE(NY,NX) - PRECB(NY,NX)=(PRECA(NY,NX)-PRECD(NY,NX)-TFLWC(NY,NX))*BARE(NY,NX) -C -C VARIABLES TO TRANSFER SNOWPACK INTO SOIL SURFACE AT FINAL MELT -C - IF(VHCPW(NY,NX).LE.VHCPWX(NY,NX).AND.DPTHS(NY,NX).GT.0.0 - 2.AND.TKA(NY,NX).GT.273.15)THEN - FLWZ=VOLWS(NY,NX) - FLWS=VOLSS(NY,NX)/0.92 - FLWI=VOLIS(NY,NX) - FLWSI(NY,NX)=FLWS+FLWI - HFLWZ=4.19*FLWZ*TKW(NY,NX) - HFLWSI(NY,NX)=1.9274*(FLWS+FLWI)*TKW(NY,NX) - WDISP=VOLWS(NY,NX)+VOLSS(NY,NX)+VOLIS(NY,NX)*0.92 - ELSE - FLWZ=0.0 - FLWS=0.0 - FLWI=0.0 - HFLWZ=0.0 - FLWSI(NY,NX)=0.0 - HFLWSI(NY,NX)=0.0 - WDISP=0.0 - ENDIF -C -C RESIDUE WATER ABSORPTION CAPACITY -C - HCNDRX=HCNDRR*CVRD(NY,NX) - HCNDR(NY,NX)=HCNDRX*XNPH - DLYRR(NY,NX)=AMIN1(5.0E-02,AMAX1(1.0E-06,DLYR(3,0,NY,NX))) -C -C DISCHARGE OF MELTWATER AND ITS HEAT FROM SNOWPACK -C TO RESIDUE, SOIL SURFACE AND MACROPORES -C - IF(VHCPW(NY,NX).GT.VHCPWX(NY,NX))THEN - WMELT=AMAX1(0.0,AMAX1(0.0,VOLWS(NY,NX)) - 2-0.05*AMAX1(0.0,VOLSS(NY,NX))) - FLWQR=WMELT*CVRD(NY,NX) - HFLWQR=4.19*TKW(NY,NX)*FLWQR - FLWQG=WMELT-FLWQR - HFLWQG=4.19*TKW(NY,NX)*FLWQG - FLWQGS=FLWQG*FGRD(NU(NY,NX),NY,NX) - FLWQGH=FLWQG*FMAC(NU(NY,NX),NY,NX) - ELSE - WMELT=0.0 - FLWQR=0.0 - HFLWQR=0.0 - FLWQG=0.0 - HFLWQG=0.0 - FLWQGS=0.0 - FLWQGH=0.0 - ENDIF - FLQRM(NY,NX)=FLWQR - FLQGM(NY,NX)=FLWQG+WDISP -C -C DISTRIBUTION OF PRECIPITATION AND ITS HEAT AMONG SURFACE -C RESIDUE, SOIL SURFACE, AND MACROPORES -C - IF(PRECA(NY,NX).GT.0.0.OR.PRECW(NY,NX).GT.0.0)THEN - IF(VHCPW(NY,NX).GT.VHCPWX(NY,NX))THEN - FLWQW=PRECA(NY,NX)-TFLWC(NY,NX) - FLWSW=PRECW(NY,NX) - HFLWSW=2.095*TKA(NY,NX)*FLWSW+4.19*TKA(NY,NX)*FLWQW - FLWQBX=0.0 - HFLWQB=0.0 - FLWQAX=0.0 - HFLWQA=0.0 - FLWQAS=0.0 - FLWQAH=0.0 - ELSE - FLWQW=0.0 - FLWSW=PRECW(NY,NX) - HFLWSW=2.095*TKA(NY,NX)*FLWSW - FLWQBX=(PRECA(NY,NX)-TFLWC(NY,NX))*CVRD(NY,NX) - HFLWQB=4.19*TKA(NY,NX)*FLWQBX - FLWQAX=PRECA(NY,NX)-TFLWC(NY,NX)-FLWQBX - HFLWQA=4.19*TKA(NY,NX)*FLWQAX - FLWQAS=FLWQAX*FGRD(NU(NY,NX),NY,NX) - FLWQAH=FLWQAX*FMAC(NU(NY,NX),NY,NX) - ENDIF - ELSE - IF(VHCPW(NY,NX).GT.VHCPWX(NY,NX))THEN - FLWQW=-TFLWC(NY,NX) - FLWSW=0.0 - HFLWSW=4.19*TKA(NY,NX)*FLWQW - FLWQBX=0.0 - HFLWQB=0.0 - FLWQAX=0.0 - HFLWQA=0.0 - FLWQAS=0.0 - FLWQAH=0.0 - ELSE - FLWQW=0.0 - FLWSW=0.0 - HFLWSW=0.0 - FLWQBX=-TFLWC(NY,NX)*CVRD(NY,NX) - HFLWQB=4.19*TKA(NY,NX)*FLWQBX - FLWQAX=-TFLWC(NY,NX)-FLWQBX - HFLWQA=4.19*TKA(NY,NX)*FLWQAX - FLWQAS=FLWQAX*FGRD(NU(NY,NX),NY,NX) - FLWQAH=FLWQAX*FMAC(NU(NY,NX),NY,NX) - ENDIF - ENDIF -C -C PRECIP ON SNOW -C - IF(PRECW(NY,NX).GT.0.0.OR.(PRECR(NY,NX).GT.0.0 - 2.AND.VHCPW(NY,NX).GT.VHCPWX(NY,NX)))THEN - FLQRQ(NY,NX)=0.0 - FLQRI(NY,NX)=0.0 - FLQGQ(NY,NX)=PRECQ(NY,NX) - FLQGI(NY,NX)=PRECI(NY,NX) - ELSEIF((PRECQ(NY,NX).GT.0.0.OR.PRECI(NY,NX).GT.0.0) - 2.AND.VHCPW(NY,NX).LE.VHCPWX(NY,NX))THEN - FLQRQ(NY,NX)=FLWQBX*PRECQ(NY,NX)/(PRECQ(NY,NX)+PRECI(NY,NX)) - FLQRI(NY,NX)=FLWQBX*PRECI(NY,NX)/(PRECQ(NY,NX)+PRECI(NY,NX)) - FLQGQ(NY,NX)=PRECQ(NY,NX)-FLQRQ(NY,NX) - FLQGI(NY,NX)=PRECI(NY,NX)-FLQRI(NY,NX) - ELSE - FLQRQ(NY,NX)=0.0 - FLQRI(NY,NX)=0.0 - FLQGQ(NY,NX)=0.0 - FLQGI(NY,NX)=0.0 - ENDIF -C -C GATHER PRECIPITATION AND MELTWATER FLUXES AND THEIR HEATS -C AMONG ATMOSPHERE, SNOWPACK, RESIDUE AND SOIL SURFACES -C INTO LOCAL ARRAYS FOR USE IN MASS AND ENERGY EXCHANGE -C ALGORITHMS -C - FLQ0W(NY,NX)=(FLWQW-FLWQR-FLWQGS-FLWQGH)*XNPH - FLQ0S(NY,NX)=FLWSW*XNPH - HWFLQ0(NY,NX)=(HFLWSW-HFLWQG-HFLWQR)*XNPH - FLQ1(NY,NX)=(FLWQAS+FLWQGS+FLWZ)*XNPH - FLH1(NY,NX)=(FLWQAH+FLWQGH)*XNPH - FLY1(NY,NX)=(FLWQBX+FLWQR)*XNPH - HWFLQ1(NY,NX)=(HFLWQA+HFLWQG+HFLWZ)*XNPH - HWFLY1(NY,NX)=(HFLWQB+HFLWQR)*XNPH - FLWZ1(NY,NX)=FLWZ*XNPH - FLWS1(NY,NX)=FLWS*0.92*XNPH - FLWI1(NY,NX)=FLWI*XNPH - HFLWZ1(NY,NX)=HFLWZ*XNPH - FLSI1(NY,NX)=FLWSI(NY,NX)*XNPH - HFLSI1(NY,NX)=HFLWSI(NY,NX)*XNPH - RFLWV(NY,NX)=1.0E-02*XNPH -C IF(I.EQ.118.AND.NX.EQ.3.AND.NY.EQ.4)THEN -C WRITE(*,4422)'FLQ0W',I,J,FLQ0W(NY,NX),FLWQW -C 2,FLWQR,FLWQGS,FLWQGH,XNPH -C WRITE(*,4422)'FLY',I,J,PRECA(NY,NX),TFLWC(NY,NX),FLY1(NY,NX) -C 2,PSISM1(0,NY,NX),PSISM(0,NY,NX) -C 2,FLQ1(NY,NX),FLH1(NY,NX),FLWQBX,FLWQR -C 2,FLWQAS,FLWQGS,FLWZ,FLWQAH,FLWQGH -C 3,FGRD(NU(NY,NX),NY,NX),FMAC(NU(NY,NX),NY,NX) -C 4,FHOL(L,NY,NX),VOLAH1(L,NY,NX),VOLAH(L,NY,NX) -C 5,FLWQAX,PRECA(NY,NX),TFLWC(NY,NX),FLWQBX,CVRD(NY,NX) -C 6,BARE(NY,NX),TRC0(NY,NX),TVOLW(NY,NX),VOLWG(NY,NX) -C 7,VOLW1(0,NY,NX),VOLWRX(NY,NX) -4422 FORMAT(A8,2I4,40E12.4) -C ENDIF -C -C INITIALIZE PARAMETERS, FLUXES FOR ENERGY EXCHANGE -C AT SNOW, RESIDUE AND SOIL SURFACES -C - RADXW(NY,NX)=RADG(NY,NX)*XNPH - RADXG(NY,NX)=RADXW(NY,NX)*BARE(NY,NX) - RADXR(NY,NX)=RADXW(NY,NX)*CVRD(NY,NX)*XNPR - THRYW(NY,NX)=(THS(NY,NX)*FRADG(NY,NX)+THRMCX(NY,NX))*XNPH - THRYG(NY,NX)=THRYW(NY,NX)*BARE(NY,NX) - THRYR(NY,NX)=THRYW(NY,NX)*CVRD(NY,NX)*XNPR - THRMW(NY,NX)=EMMW*2.04E-10*AREA(3,NU(NY,NX),NY,NX)*XNPH - THRMS(NY,NX)=EMMS*2.04E-10*AREA(3,NU(NY,NX),NY,NX)*XNPH - 2*BARE(NY,NX) - THRMR(NY,NX)=EMMR*2.04E-10*AREA(3,NU(NY,NX),NY,NX)*XNPHR - 2*CVRD(NY,NX) -C -C AERODYNAMIC RESISTANCE OF CANOPY TO SNOW/RESIDUE/SOIL -C SURFACE ENERGY EXCHANGE WITH ATMOSPHERE -C - ALFZ=2.0*(1.0-FRADG(NY,NX)) - IF(RAB(NY,NX).GT.ZERO.AND.ZT(NY,NX).GT.ZS(NY,NX) - 2.AND.ALFZ.GT.ZERO)THEN - RAC(NY,NX)=AMIN1(RACX,AMAX1(0.0,ZT(NY,NX)*EXP(ALFZ) - 2/(ALFZ/RAB(NY,NX))*AMAX1(0.0,EXP(-ALFZ*ZS(NY,NX)/ZT(NY,NX)) - 3-EXP(-ALFZ*(ZD(NY,NX)+ZR(NY,NX))/ZT(NY,NX))))) - UAG=UA(NY,NX)*EXP(-ALFZ) - ELSE - RAC(NY,NX)=0.0 - UAG=UA(NY,NX) - ENDIF - VPQ(NY,NX)=VPA(NY,NX)-1.0*TLEX(NY,NX) - 2/(VAP*AREA(3,NU(NY,NX),NY,NX)) - TKQ(NY,NX)=TKA(NY,NX)-1.0*TSHX(NY,NX) - 2/(1.25E-03*AREA(3,NU(NY,NX),NY,NX)) -C -C AERODYNAMIC RESISTANCE OF RESIDUE AND SOIL -C SURFACE TO ENERGY EXCHANGE WITH ATMOSPHERE -C Soil Sci. Soc. Am. J. 48:25-32 -C - WGSG0(NY,NX)=WGSGW(NY,NX)*XNPH - WGSGR0(NY,NX)=WGSGR(NY,NX)*XNPH - DO 25 L=NU(NY,NX),NL(NY,NX) - IF(POROS(L,NY,NX).GT.0.0)THEN - WFPS=THETW(L,NY,NX)/POROS(L,NY,NX) - ELSE - WFPS=1.0 - ENDIF - FWGWP=AMAX1(1.0,10.0-50.0*WP(L,NY,NX)) - FWGSG=9.5+2.0*WFPS-8.5*EXP(-((FWGWP*WFPS)**3)) - WGSG1(L,NY,NX)=FWGSG*WGSGL(L,NY,NX)*XNPH -25 CONTINUE - RAR(NY,NX)=DLYRR(NY,NX)/WGSGR(NY,NX) - RAG(NY,NX)=RAC(NY,NX)+RAB(NY,NX) - RAGW(NY,NX)=RAG(NY,NX) - RAGR(NY,NX)=RAG(NY,NX)+RARX - RARG(NY,NX)=RAGR(NY,NX) - RAR1=RAR(NY,NX)/AMAX1(THETX,THETPX(0,NY,NX))**2.33 - RAGS(NY,NX)=RAG(NY,NX)+RAR1 - PARR(NY,NX)=AREA(3,NU(NY,NX),NY,NX)*XNPH/RAGR(NY,NX) - PARG(NY,NX)=AREA(3,NU(NY,NX),NY,NX)*XNPH/RAGS(NY,NX) - PAREG(NY,NX)=AREA(3,NU(NY,NX),NY,NX)*XNPH - PARER(NY,NX)=PAREG(NY,NX)*XNPR*CVRD(NY,NX) - PARSG(NY,NX)=1.25E-03*AREA(3,NU(NY,NX),NY,NX)*XNPH - PARSR(NY,NX)=PARSG(NY,NX)*XNPR*CVRD(NY,NX) -C IF(J.EQ.24)THEN -C WRITE(*,3111)'RAC',I,J,ALFZ,RAC(NY,NX),ZT(NY,NX),RAB(NY,NX) -C 2,RAR(NY,NX),RAR1,PARG(NY,NX),PARR(NY,NX) -C 3,DLYRR(NY,NX),RAG(NY,NX),RAGS(NY,NX),RAGR(NY,NX) -C 4,THETPX(0,NY,NX),WGSGR(NY,NX),VOLW1(0,NY,NX) -C 5,VOLI1(0,NY,NX),VOLP1(0,NY,NX),VOLR(NY,NX),VOLA(0,NY,NX) -C 4,TLEX(NY,NX),TSHX(NY,NX),RADG(NY,NX),THS(NY,NX) -C 5,FRADG(NY,NX),THRMCX(NY,NX),ZS(NY,NX) -3111 FORMAT(A8,2I4,30E12.4) -C ENDIF -9990 CONTINUE -9995 CONTINUE -C -C INITIALIZE SOIL HYDRAULIC PARAMETERS IN LOCAL ARRAYS -C FOR LATER USE IN WATER TRANSFER ALGORITHMS -C - DO 9985 NX=NHW,NHE - DO 9980 NY=NVN,NVS - DO 35 L=NU(NY,NX),NL(NY,NX) - DO 40 N=NCN(NY,NX),3 - TFLXL(N,L,NY,NX)=0.0 - WFLXL(N,L,NY,NX)=0.0 - WFLXLH(N,L,NY,NX)=0.0 - N1=NX - N2=NY - N3=L - IF(N.EQ.1)THEN - IF(NX.EQ.NHE)THEN - GO TO 50 - ELSE - N4=NX+1 - N5=NY - N6=L - ENDIF - ELSEIF(N.EQ.2)THEN - IF(NY.EQ.NVS)THEN - GO TO 50 - ELSE - N4=NX - N5=NY+1 - N6=L - ENDIF - ELSEIF(N.EQ.3)THEN - IF(L.EQ.NL(NY,NX))THEN - GO TO 50 - ELSE - N4=NX - N5=NY - N6=L+1 - ENDIF - ENDIF -C -C MACROPORE CONDUCTIVITY FROM 'HOUR1' AND GRAVITATIONAL -C GRADIENT USED TO CALCULATE MACROPORE FLOW FOR USE BELOW -C - IF(CNDH1(N3,N2,N1).GT.ZERO.AND.CNDH1(N6,N5,N4) - 2.GT.ZERO)THEN - AVCNHL(N,N6,N5,N4)=2.0*CNDH1(N3,N2,N1)*CNDH1(N6,N5,N4) - 2/(CNDH1(N3,N2,N1)*DLYR(N,N6,N5,N4)+CNDH1(N6,N5,N4) - 3*DLYR(N,N3,N2,N1)) - ELSE - AVCNHL(N,N6,N5,N4)=0.0 - ENDIF -50 CONTINUE -40 CONTINUE -35 CONTINUE -9980 CONTINUE -9985 CONTINUE -C -C DYNAMIC LOOP FOR FLUX CALCULATIONS -C - DO 3320 M=1,NPH - DO 9895 NX=NHW,NHE - DO 9890 NY=NVN,NVS - TQR1(NY,NX)=0.0 - THQR1(NY,NX)=0.0 - TQS1(NY,NX)=0.0 - TQW1(NY,NX)=0.0 - TQI1(NY,NX)=0.0 - THQS1(NY,NX)=0.0 -C -C WATER REPELLENCY AND GAS EXCHANGE COEFFICIENTS -C - WRP(0,NY,NX)=1.0/(1.0+(AMAX1(-1.5 - 2,PSISM1(0,NY,NX))/PSISXR)**3) - IF(VOLA(0,NY,NX).GT.VOLI1(0,NY,NX) - 2.AND.VOLP1(0,NY,NX).GT.ZEROS(NY,NX))THEN - THETWA=AMAX1(0.0,AMIN1(1.0 - 2,VOLW1(0,NY,NX)/(VOLA(0,NY,NX)-VOLI1(0,NY,NX)))) - TFND1=(TK1(0,NY,NX)/298.15)**6 - IF(THETWA.GT.Z3R)THEN - DFGS(M,0,NY,NX)=AMAX1(0.0 - 2,TFND1*XNPD/((Z1R**-1)*EXP(Z2RW*(THETWA-Z3R)))) - ELSE - DFGS(M,0,NY,NX)=AMIN1(1.0 - 2,TFND1*XNPD/((Z1R**-1)*EXP(Z2RD*(THETWA-Z3R)))) - ENDIF - 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) - ELSE - THETWT=0.0 - ENDIF - TORT(M,0,NY,NX)=0.7*THETWT**2 - DO 9885 L=NU(NY,NX),NL(NY,NX) - TWFLXL(L,NY,NX)=0.0 - TWFLXH(L,NY,NX)=0.0 - TTFLXL(L,NY,NX)=0.0 - TFLWL(L,NY,NX)=0.0 - TFLWLX(L,NY,NX)=0.0 - TFLWHL(L,NY,NX)=0.0 - THFLWL(L,NY,NX)=0.0 - WRP(L,NY,NX)=1.0/(1.0+(AMAX1(-1.5 - 2,PSISM1(L,NY,NX))/PSISX)**3) - VOLWT=VOLW1(L,NY,NX)+VOLWH1(L,NY,NX) - VOLAT=VOLA(L,NY,NX)+VOLAH(L,NY,NX) - 2-VOLI1(L,NY,NX)-VOLIH1(L,NY,NX) - IF(VOLAT.GT.ZEROS(NY,NX) - 2.AND.VOLP1(L,NY,NX).GT.ZEROS(NY,NX))THEN - THETWA=AMAX1(0.0,AMIN1(1.0,VOLWT/VOLAT)) - TFND1=(TK1(L,NY,NX)/298.15)**6 - Z3S=AMAX1(Z3SX,FC(L,NY,NX)/POROS(L,NY,NX)) - IF(THETWA.GT.Z3S)THEN - DFGS(M,L,NY,NX)=AMAX1(0.0 - 2,TFND1*XNPD/((Z1S**-1)*EXP(Z2SW*(THETWA-Z3S)))) - ELSE - DFGS(M,L,NY,NX)=AMIN1(1.0 - 2,TFND1*XNPD/((Z1S**-1)*EXP(Z2SD*(THETWA-Z3S)))) - ENDIF - ELSE - DFGS(M,L,NY,NX)=0.0 - ENDIF -C IF(L.EQ.NU(NY,NX))THEN -C WRITE(*,3377)'DFGS',I,J,M,NX,NY,L,DFGS(M+1,L,NY,NX) -C 2,XNPD,TFACL,Z1S,Z2S,THETWA,Z3S,Z2S*(THETWA-Z3S) -C 3,EXP(Z2S*(THETWA-Z3S)),Z1S**-1 -C 4,(Z1S**-1)*EXP(Z2S*(THETWA-Z3S)) - THETWT=VOLWM(M,L,NY,NX)/VOLX(L,NY,NX) - TORT(M,L,NY,NX)=XDIM*0.7*THETWT**2*(1.0-FHOL(L,NY,NX)) - IF(VOLAH(L,NY,NX).GT.ZEROS(NY,NX))THEN - THETWH=VOLWHM(M,L,NY,NX)/VOLAH(L,NY,NX) - TORTH(M,L,NY,NX)=XDIM*AMIN1(1.0,2.8*THETWH**3)*FHOL(L,NY,NX) - ELSE - TORTH(M,L,NY,NX)=0.0 - ENDIF -9885 CONTINUE -C -C REDISTRIBUTE INCOMING MELTWATER OR PRECIPITATION -C BETWEEN RESIDUE AND SOIL SURFACE -C - VOLWRM=AMAX1(0.0,VOLWRX(NY,NX)-VOLW1(0,NY,NX)-VOLI1(0,NY,NX)) - FLWR1=AMAX1(0.0,FLY1(NY,NX)-VOLWRM) - HFLWR1=4.19*TKA(NY,NX)*FLWR1 - FLYM=FLY1(NY,NX)-FLWR1 - HWFLYM=HWFLY1(NY,NX)-HFLWR1 - FLQM=FLQ1(NY,NX)+FLWR1*FGRD(NU(NY,NX),NY,NX) - FLHM=FLH1(NY,NX)+FLWR1*FMAC(NU(NY,NX),NY,NX) - HWFLQM=HWFLQ1(NY,NX)+HFLWR1 -C -C REDISTRIBUTE SURFACE WATER FROM WATER REPELLANCY -C -C FLWPR=FLYM*(1.0-WRP(0,NY,NX)) -C HFLWPR=4.19*TKA(NY,NX)*FLWPR -C FLYM=FLYM-FLWPR -C HWFLYM=HWFLYM-HFLWPR -C FLQM=FLQM+FLWPR*FGRD(NU(NY,NX),NY,NX) -C FLHM=FLHM+FLWPR*FMAC(NU(NY,NX),NY,NX) -C HWFLQM=HWFLQM+HFLWPR -C FLWP1=FLQM*(1.0-WRP(NU(NY,NX),NY,NX)) -C FLQM=FLQM-FLWP1 -C FLHM=FLHM+FLWP1 - FLYM2=FLYM*XNPR - HWFLM2=HWFLYM*XNPR -C IF(NX.EQ.4.AND.NY.EQ.5)THEN -C WRITE(*,3132)'FLWR1',I,J,M,NX,NY,FLY1(NY,NX),FLQ1(NY,NX) -C 2,VHCP0(NY,NX),VHCPWX(NY,NX) -C 2,FLH1(NY,NX),FLYM,FLQM,FLHM,VOLWRM,FLWR1 -C 3,FMAC(NU(NY,NX),NY,NX),FGRD(NU(NY,NX),NY,NX) -C 5,VOLAH(NU(NY,NX),NY,NX),FVOLAH,CCLAY(NU(NY,NX),NY,NX) -C 4,VOLW1(NU(NY,NX),NY,NX),VOLX(NU(NY,NX),NY,NX),WP(L,NY,NX) -C 2,VOLT(NU(NY,NX),NY,NX),VOLAH1(NU(NY,NX),NY,NX) -C 5,VOLWRX(NY,NX),VOLW1(0,NY,NX),VOLI1(0,NY,NX) -C 6,WRP(0,NY,NX),WRP(NU(NY,NX),NY,NX),PSISM1(0,NY,NX) -C 7,PSISM1(NU(NY,NX),NY,NX) -3132 FORMAT(A8,5I4,40E12.4) -C ENDIF -C -C ENERGY EXCHANGE AT SNOW SURFACE IF PRESENT -C - IF(VHCP0(NY,NX).GT.VHCPWX(NY,NX))THEN -C -C PHYSICAL AND HYDRAULIC PROPERTIES OF SNOWPACK INCLUDING -C AIR AND WATER-FILLED POROSITY, WATER POTENTIAL OF UNDERLYING -C SOIL SURFACE USED IN FLUX CALCULATIONS -C - DENSS=AMIN1(0.6,DENS0(NY,NX)+DENS1(NY,NX)*VOLS0(NY,NX) - 2/AREA(3,NU(NY,NX),NY,NX)) - VOLS1(NY,NX)=VOLS0(NY,NX)/DENSS+VOLW0(NY,NX)+VOLI0(NY,NX) - DPTHS0(NY,NX)=VOLS1(NY,NX)/AREA(3,NU(NY,NX),NY,NX) - THETP0=AMAX1(THETPI,1.0-(VOLS0(NY,NX)+VOLI0(NY,NX) - 2+VOLW0(NY,NX))/VOLS1(NY,NX)) - 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))) -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) - 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 - PSISM1(NU(NY,NX),NY,NX)=-EXP(PSIMS(NY,NX) - 2+(((PSL(NU(NY,NX),NY,NX)-LOG(THETW1)) - 3/PSD(NU(NY,NX),NY,NX))**SRP(NU(NY,NX),NY,NX)*PSISD(NY,NX))) - ELSE - PSISM1(NU(NY,NX),NY,NX)=PSISE(NU(NY,NX),NY,NX) - ENDIF -C ELSE -C PSISM1(NU(NY,NX),NY,NX)=PSISE(NU(NY,NX),NY,NX) -C ENDIF - PSISV1=PSISM1(NU(NY,NX),NY,NX)+PSISO(NU(NY,NX),NY,NX) -C -C SNOWPACK ALBEDO, NET RADIATION -C - ALBW=(0.85*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) - RFLX1=(1.0-ALBG)*RADXW(NY,NX)+THRYW(NY,NX) - THRMX=THRMW(NY,NX)*TKW(NY,NX)**4 - RFLX=RFLX1-THRMX -C -C AERODYNAMIC RESISTANCE ABOVE SNOWPACK INCLUDING -C RESISTANCE IMPOSED BY PLANT CANOPY -C - RI=AMAX1(-0.3,AMIN1(0.075,RIB(NY,NX)*(TKQ(NY,NX)-TKW(NY,NX)))) - RAGX=AMAX1(RAM,0.75*RAGW(NY,NX),AMIN1(1.33*RAGW(NY,NX) - 2,RAG(NY,NX)/(1.0-10.0*RI))) - RAGW(NY,NX)=RAGX - RA=RAGX -C -C PARAMETERS FOR CALCULATING LATENT AND SENSIBLE HEAT FLUXES -C - PARE=PAREG(NY,NX)/(RA+RZW) - PARS=PARSG(NY,NX)/RA - TKW1=TK0(NY,NX) - TK11=TK1(NU(NY,NX),NY,NX) - VP0=2.173E-03/TKW1 - 2*0.61*EXP(5360.0*(3.661E-03-1.0/TKW1)) - VP1=2.173E-03/TK11 - 2*0.61*EXP(5360.0*(3.661E-03-1.0/TK11)) - 3*EXP(18.0*PSISV1/(8.3143*TK11)) - EVAPT=PARE*(VPQ(NY,NX)-VP0) - EVAP(NY,NX)=AMAX1(EVAPT,-AMAX1(0.0,VOLW0(NY,NX))) - EVAPX=AMIN1(0.0,EVAPT-EVAP(NY,NX)) - EVAPS(NY,NX)=AMAX1(EVAPX,-AMAX1(0.0,VOLS0(NY,NX))) - EFLX=EVAP(NY,NX)*VAP+EVAPS(NY,NX)*(VAP+333.0) - IF(EVAPT.LT.0.0)THEN - VFLX=(EVAP(NY,NX)*4.19+EVAPS(NY,NX)*2.095)*TK0(NY,NX) - ELSE - VFLX=(EVAP(NY,NX)*4.19+EVAPS(NY,NX)*2.095)*TKQ(NY,NX) - ENDIF -C -C SOLVE FOR SNOWPACK SURFACE TEMPERATURE AT WHICH ENERGY -C BALANCE OCCURS, SOLVE LATENT, SENSIBLE AND STORAGE HEAT FLUXES -C - SFLX=PARS*(TKQ(NY,NX)-TK0(NY,NX)) - HFLW0=RFLX+EFLX+SFLX+VFLX -C -C VAPOR PRESSURES AND CONDUCTIVITY BETWEEN SNOWPACK -C AND SOIL SURFACE -C - CNV0=THETP0**1.33*WGSG0(NY,NX) - CNV1=THETPX(NU(NY,NX),NY,NX)**2/POROQ(NU(NY,NX),NY,NX) - 2*WGSG1(NU(NY,NX),NY,NX) - IF(CNV0.GT.ZERO.AND.CNV1.GT.ZERO)THEN - AVCNV1=2.0*CNV0*CNV1 - 2/(CNV0*DLYR(3,NU(NY,NX),NY,NX)+CNV1*DPTHS0(NY,NX)) - ELSE - AVCNV1=2.0*CNV0 - 2/(DLYR(3,NU(NY,NX),NY,NX)+DPTHS0(NY,NX)) - ENDIF -C -C HEAT AND VAPOR FLUXES BETWEEN SNOWPACK AND SOIL SURFACE -C - TKY=(TK0(NY,NX)*VHCP0(NY,NX)+TK1(NU(NY,NX),NY,NX) - 2*VHCP1(NU(NY,NX),NY,NX))/(VHCP0(NY,NX)+VHCP1(NU(NY,NX),NY,NX)) - HFLWX=(TK0(NY,NX)-TKY)*VHCP0(NY,NX)*FHFLX*XDIM - FLVX=AVCNV1*(VP0-VP1)*AREA(3,NU(NY,NX),NY,NX)*BARE(NY,NX) - IF(FLVX.GE.0.0)THEN - FLV1=AMIN1(FLVX,VOLW0(NY,NX)*XNPH) - IF(HFLWX.GE.0.0)THEN - FLV1=AMIN1(FLV1,HFLWX/(4.19*TK0(NY,NX)+VAP)) - ENDIF - HWFLV1=(4.19*TK0(NY,NX)+VAP)*FLV1 - ELSE - FLV1=AMAX1(FLVX,-VOLW1(NU(NY,NX),NY,NX)*XNPH) - IF(HFLWX.LT.0.0)THEN - FLV1=AMAX1(FLV1,HFLWX/(4.19*TK1(NU(NY,NX),NY,NX)+VAP)) - ENDIF - HWFLV1=(4.19*TK1(NU(NY,NX),NY,NX)+VAP)*FLV1 - ENDIF - IF(VOLS1(NY,NX).GT.ZEROS(NY,NX))THEN - DENSW=(VOLS0(NY,NX)+VOLW0(NY,NX)+VOLI0(NY,NX))/VOLS1(NY,NX) - ELSE - DENSW=DENS0(NY,NX) - ENDIF -C -C J GLACIOL 43:26-41 -C - IF(DENSW.LT.0.156)THEN - TCNDW=8.28E-05+8.42E-04*DENSW - ELSE - TCNDW=4.97E-04-3.64E-03*DENSW+1.16E-02*DENSW**2 - ENDIF - WTHET1=1.467-0.467*THETPY(NU(NY,NX),NY,NX) - TCND1=(STC(NU(NY,NX),NY,NX)+THETWX(NU(NY,NX),NY,NX)*2.067E-03 - 2+0.611*THETIX(NU(NY,NX),NY,NX)*7.844E-03 - 3+WTHET1*THETPX(NU(NY,NX),NY,NX)*9.050E-05) - 4/(DTC(NU(NY,NX),NY,NX)+THETWX(NU(NY,NX),NY,NX) - 5+0.611*THETIX(NU(NY,NX),NY,NX)+WTHET1*THETPX(NU(NY,NX),NY,NX)) - IF(BARE(NY,NX).GT.ZERO)THEN - TCNDW1=TCNDW*XNPH - TCND1W=TCND1*XNPH - ATCND0=2.0*TCNDW1*TCND1W/(TCNDW1*DLYR(3,NU(NY,NX),NY,NX) - 2+TCND1W*DPTHS0(NY,NX))*BARE(NY,NX) - ELSE - ATCND0=0.0 - ENDIF - TK0X=TK0(NY,NX)-HWFLV1/VHCP0(NY,NX) - TK1X=TK1(NU(NY,NX),NY,NX)+HWFLV1/VHCP1(NU(NY,NX),NY,NX) - TKY=(TK0X*VHCP0(NY,NX)+TK1X*VHCP1(NU(NY,NX),NY,NX)) - 2/(VHCP0(NY,NX)+VHCP1(NU(NY,NX),NY,NX)) - HFLWX=(TK0X-TKY)*VHCP0(NY,NX)*FHFLX*XDIM - HFLWC=ATCND0*(TK0X-TK1X)*AREA(3,NU(NY,NX),NY,NX) - IF(HFLWC.GE.0.0)THEN - HFLC01=AMAX1(0.0,AMIN1(HFLWX,HFLWC)) - ELSE - HFLC01=AMIN1(0.0,AMAX1(HFLWX,HFLWC)) - ENDIF -C IF(NX.EQ.4.AND.NY.EQ.4)THEN -C WRITE(*,1113)'EFLX0',I,J,M,NX,NY,RFLX,EFLX,SFLX,VFLX,HFLW0 -C 2,RADXW(NY,NX),THRYW(NY,NX),ALBG,RADG(NY,NX),THS(NY,NX) -C 3,FRADG(NY,NX),THRMCX(NY,NX),TK0(NY,NX) -C 2,TKA(NY,NX),TKQ(NY,NX),VPQ(NY,NX),VP0,VP1,PARE,PARS,EVAPT -C 3,VHCP0(NY,NX),RA,RI,RZ,RAGX,RAGW(NY,NX),RAG(NY,NX),RAB(NY,NX) -C 4,WFLXA(NY,NX),WFLXB(NY,NX),CNV0,PARG(NY,NX),UA(NY,NX),UAG,ALFZ -C 5,THETP0,VOLS0(NY,NX),VOLI0(NY,NX),VOLW0(NY,NX),VOLS1(NY,NX) -C 6,WGSG0(NY,NX),WGSG1(NU(NY,NX),NY,NX),DPTHS0(NY,NX) -C 7,VOLW1(NU(NY,NX),NY,NX),FLQM,FLYM,WMELT -C 8,HWFLQM,HWFLV1,HFLC01,HFLCR1 -C 9,WGSG0(NY,NX),THETPY(NU(NY,NX),NY,NX) -C 1,DENSS(NY,NX),VOLS0(NY,NX),VOLS1(NY,NX),TCNDW -1113 FORMAT(A8,5I4,60E12.4) -C ENDIF -C -C HEAT FLUX BETWEEN SNOWPACK AND SURFACE RESIDUE -C - FLVR=0.0 - HWFLVR=0.0 - FLVS=0.0 - HWFLVS=0.0 - HFLC0R=0.0 - HFLCR1=0.0 - IF(VHCPR1(NY,NX).GT.VHCPRX(NY,NX))THEN - TK0X=TK0(NY,NX) - TKXR=TK1(0,NY,NX) - TK1X=TK1(NU(NY,NX),NY,NX) - CNV01=CNV0*XNPR - CNV11=CNV1*XNPR - CNVR1=THETPX(0,NY,NX)**2/POROQ(0,NY,NX)*WGSGR0(NY,NX)*XNPR - IF(CVRD(NY,NX).GT.ZERO)THEN - IF(CNV01.GT.ZERO.AND.CNVR1.GT.ZERO)THEN - AVCNVR=2.0*CNVR1*CNV01 - 2/(CNV01*DLYRR(NY,NX)+CNVR1*DPTHS0(NY,NX))*CVRD(NY,NX) - ELSE - AVCNVR=2.0*CNV01 - 2/(DLYRR(NY,NX)+DPTHS0(NY,NX))*CVRD(NY,NX) - ENDIF - IF(CNVR1.GT.ZERO.AND.CNV11.GT.ZERO)THEN - AVCNVS=2.0*CNVR1*CNV11 - 2/(CNVR1*DLYR(3,NU(NY,NX),NY,NX)+CNV11*DLYRR(NY,NX))*CVRD(NY,NX) - ELSE - AVCNVS=2.0*CNV11 - 2/(DLYR(3,NU(NY,NX),NY,NX)+DLYRR(NY,NX))*CVRD(NY,NX) - ENDIF - THETRR=AMAX1(0.0,1.0-THETPX(0,NY,NX)-THETWX(0,NY,NX) - 2-THETIX(0,NY,NX)) - TCNDR=(0.779*THETRR*9.050E-04+0.622*THETWX(0,NY,NX) - 2*2.067E-03+0.380*THETIX(0,NY,NX)*7.844E-03+THETPX(0,NY,NX) - 3*9.050E-05)/(0.779*THETRR+0.622*THETWX(0,NY,NX) - 4+0.380*THETIX(0,NY,NX)+THETPX(0,NY,NX)) - IF(TCNDW.GT.ZERO.AND.TCNDR.GT.ZERO)THEN - TCNDW1=TCNDW*XNPHR - TCNDR1=TCNDR*XNPHR - ATCNDR=2.0*TCNDW1*TCNDR1 - 2/(TCNDW1*DLYRR(NY,NX)+TCNDR1*DPTHS0(NY,NX))*CVRD(NY,NX) - ELSE - ATCNDR=0.0 - ENDIF - IF(TCNDR.GT.ZERO.AND.TCND1.GT.ZERO)THEN - TCND11=TCND1*XNPHR - ATCNDS=2.0*TCNDR1*TCND11 - 2/(TCNDR1*DLYR(3,NU(NY,NX),NY,NX)+TCND11*DLYRR(NY,NX))*CVRD(NY,NX) - ELSE - ATCNDS=0.0 - ENDIF - ELSE - AVCNVR=0.0 - AVCNVS=0.0 - ATCNDR=0.0 - ATCNDS=0.0 - ENDIF - DO 4000 N=1,NPR - VP0=2.173E-03/TK0X - 2*0.61*EXP(5360.0*(3.661E-03-1.0/TK0X)) - VPR=2.173E-03/TKXR - 2*0.61*EXP(5360.0*(3.661E-03-1.0/TKXR)) - 3*EXP(18.0*PSISM1(0,NY,NX)/(8.3143*TKXR)) - TKY=(TKXR*VHCPR1(NY,NX)+TK0X*VHCP0(NY,NX)) - 2/(VHCPR1(NY,NX)+VHCP0(NY,NX)) - HFLWX=(TKY-TKXR)*VHCPR1(NY,NX)*FHFLX*XDIM - FLVX=AVCNVR*(VP0-VPR)*AREA(3,NU(NY,NX),NY,NX) - IF(FLVX.GE.0.0)THEN - FLVR1=AMIN1(FLVX,VOLW0(NY,NX)*XNPHR) - IF(HFLWX.GE.0.0)THEN - FLVR1=AMIN1(FLVR1,HFLWX/(4.19*TK0X+VAP)) - ENDIF - HWFLVR1=(4.19*TK0X+VAP)*FLVR1 - ELSE - FLVR1=AMAX1(FLVX,-VOLW1(0,NY,NX)*XNPHR) - IF(HFLWX.LT.0.0)THEN - FLVR1=AMAX1(FLVR1,HFLWX/(4.19*TKXR+VAP)) - ENDIF - HWFLVR1=(4.19*TKXR+VAP)*FLVR1 - ENDIF - TK0X=TK0X-HWFLVR1/VHCP0(NY,NX) - TKXR=TKXR+HWFLVR1/VHCPR1(NY,NX) - TKY=(TKXR*VHCPR1(NY,NX)+TK0X*VHCP0(NY,NX)) - 2/(VHCPR1(NY,NX)+VHCP0(NY,NX)) - HFLWX=(TKY-TKXR)*VHCPR1(NY,NX)*FHFLX*XDIM - HFLWC=ATCNDR*(TK0X-TKXR)*AREA(3,NU(NY,NX),NY,NX) - IF(HFLWC.GE.0.0)THEN - HFLC0R1=AMAX1(0.0,AMIN1(HFLWX,HFLWC)) - ELSE - HFLC0R1=AMIN1(0.0,AMAX1(HFLWX,HFLWC)) - ENDIF - TK0X=TK0X-HFLC0R1/VHCP0(NY,NX) - TKXR=TKXR+HFLC0R1/VHCPR1(NY,NX) -C -C HEAT FLUX BETWEEN SURFACE RESIDUE AND SOIL SURFACE UNDER SNOWPACK -C - VP1=2.173E-03/TK1X - 2*0.61*EXP(5360.0*(3.661E-03-1.0/TK1X)) - 3*EXP(18.0*PSISV1/(8.3143*TK1X)) - TKY=(TKXR*VHCPR1(NY,NX)+TK1X*VHCP1(NU(NY,NX),NY,NX)) - 2/(VHCPR1(NY,NX)+VHCP1(NU(NY,NX),NY,NX)) - HFLWX=(TKXR-TKY)*VHCPR1(NY,NX)*FHFLX*XDIM - FLVX=AVCNVS*(VPR-VP1)*AREA(3,NU(NY,NX),NY,NX) - IF(FLVX.GE.0.0)THEN - FLVS1=AMIN1(FLVX,VOLW1(0,NY,NX)*XNPHR) - IF(HFLWX.GE.0.0)THEN - FLVS1=AMIN1(FLVS1,HFLWX/(4.19*TKXR+VAP)) - ENDIF - HWFLVS1=(4.19*TKXR+VAP)*FLVS1 - ELSE - FLVS1=AMAX1(FLVX,-VOLW1(NU(NY,NX),NY,NX)*XNPHR) - IF(HFLWX.LT.0.0)THEN - FLVS1=AMAX1(FLVS1,HFLWX/(4.19*TK1X+VAP)) - ENDIF - HWFLVS1=(4.19*TK1X+VAP)*FLVS1 - ENDIF - TKXR=TKXR-HWFLVS1/VHCPR1(NY,NX) - TK1X=TK1X+HWFLVS1/VHCP1(NU(NY,NX),NY,NX) - TKY=(TKXR*VHCPR1(NY,NX)+TK1X*VHCP1(NU(NY,NX),NY,NX)) - 2/(VHCPR1(NY,NX)+VHCP1(NU(NY,NX),NY,NX)) - HFLWX=(TKXR-TKY)*VHCPR1(NY,NX)*FHFLX*XDIM - HFLWC=ATCNDS*(TKXR-TK1X)*AREA(3,NU(NY,NX),NY,NX) - IF(HFLWC.GE.0.0)THEN - HFLCR11=AMAX1(0.0,AMIN1(HFLWX,HFLWC)) - ELSE - HFLCR11=AMIN1(0.0,AMAX1(HFLWX,HFLWC)) - ENDIF - TKXR=TKXR-HFLCR11/VHCPR1(NY,NX) - TK1X=TK1X+HFLCR11/VHCP1(NU(NY,NX),NY,NX) - FLVR=FLVR+FLVR1 - HWFLVR=HWFLVR+HWFLVR1 - FLVS=FLVS+FLVS1 - HWFLVS=HWFLVS+HWFLVS1 - HFLC0R=HFLC0R+HFLC0R1 - HFLCR1=HFLCR1+HFLCR11 -C IF(NX.EQ.4.AND.NY.EQ.5)THEN -C WRITE(*,1114)'FLVR0',I,J,M,NX,NY,N,TK0(NY,NX),TK1(0,NY,NX) -C 2,TK1(NU(NY,NX),NY,NX),TK0X,TKXR,TK1X,FLVR1,HWFLVR1,FLVS1 -C 4,HWFLVS1,HFLC0R1,HFLCR11,FLVR,HWFLVR,FLVS,HWFLVS -C 3,HFLC0R,HFLCR1,VPQ(NY,NX),VP0,VPR,VP1,PSISM1(0,NY,NX),PSISV1 -C 5,AVCNVR,ATCNDR,AVCNVS,ATCNDS,VHCP0(NY,NX),VHCPR1(NY,NX) -C 6,VHCP1(NU(NY,NX),NY,NX),DLYRR(NY,NX),DPTHS0(NY,NX),CNV01,CNVR1 -C 7,CNV11,CNV1,THETPX(NU(NY,NX),NY,NX),POROQ(NU(NY,NX),NY,NX) -C 2,WGSG1(NU(NY,NX),NY,NX),CVRD(NY,NX) -1114 FORMAT(A8,6I4,60E12.4) -C ENDIF -4000 CONTINUE - IF(VOLWRX(NY,NX).GT.ZEROS(NY,NX))THEN - THETWR=AMAX1(0.01,AMIN1(1.0,VOLW1(0,NY,NX)/VOLWRX(NY,NX))) - ELSE - THETWR=1.0 - ENDIF - PSISM1(0,NY,NX)=PSISE(0,NY,NX)*THETWR**FPSISR - ELSE - PSISM1(0,NY,NX)=PSISM1(NU(NY,NX),NY,NX) - ENDIF - EVAPR(NY,NX)=0.0 - RFLXR=0.0 - EFLXR=0.0 - VFLXR=0.0 - SFLXR=0.0 -C -C GATHER WATER, VAPOR AND HEAT FLUXES INTO FLUX ARRAYS -C FOR LATER UPDATES TO STATE VARIABLES -C - FLW0S(NY,NX)=FLQ0S(NY,NX)+EVAPS(NY,NX) - FLW0L(NY,NX)=FLQ0W(NY,NX)+EVAP(NY,NX)-FLV1-FLVR - HFLW0L(NY,NX)=HWFLQ0(NY,NX)+HFLW0-HWFLV1-HWFLVR-HFLC01-HFLC0R - FLWL(3,NU(NY,NX),NY,NX)=FLQM+FLV1+FLVS - FLWLX(3,NU(NY,NX),NY,NX)=FLQM+FLV1 - FLWHL(3,NU(NY,NX),NY,NX)=FLHM - HFLWL(3,NU(NY,NX),NY,NX)=HWFLQM+HWFLV1+HWFLVS+HFLC01+HFLCR1 - FLWRL(NY,NX)=FLYM+FLVR-FLVS - HFLWRL(NY,NX)=HWFLYM+HFLC0R-HFLCR1+HWFLVR-HWFLVS - FLWVL(NU(NY,NX),NY,NX)=0.0 - FLWV(NU(NY,NX),NY,NX)=FLWV(NU(NY,NX),NY,NX) - 2+FLWVL(NU(NY,NX),NY,NX) -C IF(NX.EQ.2.AND.NY.EQ.2)THEN -C WRITE(*,7753)'FLW0L',I,J,M,NX,NY,FLW0L(NY,NX) -C 2,FLQ0W(NY,NX),EVAP(NY,NX),FLV1,FLVR,VOLW0(NY,NX) -C 2,FLW0S(NY,NX),FLQ0S(NY,NX),EVAPS(NY,NX) -C 3,EVAPT,PARE,VPQ(NY,NX),VP0,TK0(NY,NX),HFLW0L(NY,NX) -C 4,HWFLQ0(NY,NX),HFLW0,HWFLV1,HWFLVR,HFLC01,HFLC0R -C WRITE(*,7753)'FLWRL',I,J,M,NX,NY,FLWRL(NY,NX) -C 3,PSISM1(0,NY,NX),PSISE(0,NY,NX) -C 2,FLYM,FLVR,FLVS,HFLWRL(NY,NX),VOLW1(0,NY,NX) -C 2,HWFLYM,HFLC0R,HFLCR1,HWFLVR,HWFLVS -7753 FORMAT(A8,5I4,30E12.4) -C ENDIF -C -C FREEZE-THAW IN SNOWPACK FROM NET CHANGE IN SNOWPACK -C HEAT STORAGE -C - TFLX=3.6785E-01*(273.15*(2.095*FLW0S(NY,NX)+4.19*FLW0L(NY,NX)) - 2+VHCP0(NY,NX)*(273.15-TK0(NY,NX))-HFLW0L(NY,NX)) - IF(TFLX.LT.0.0)THEN - TVOLWS=VOLS0(NY,NX)+0.92*VOLI0(NY,NX) - IF(TVOLWS.GT.ZEROS(NY,NX))THEN - FVOLS0=VOLS0(NY,NX)/TVOLWS - FVOLI0=0.92*VOLI0(NY,NX)/TVOLWS - ELSE - FVOLS0=0.0 - FVOLI0=0.0 - ENDIF - TFLX0(NY,NX)=AMAX1(-333.0*TVOLWS*XNPH,TFLX) - WFLXA(NY,NX)=-TFLX0(NY,NX)*FVOLS0/333.0 - WFLXB(NY,NX)=-TFLX0(NY,NX)*FVOLI0/333.0 - ELSE - TFLX0(NY,NX)=AMIN1(333.0*VOLW0(NY,NX)*XNPH,TFLX) - WFLXA(NY,NX)=0.0 - WFLXB(NY,NX)=-TFLX0(NY,NX)/333.0 - ENDIF -C -C TOTAL SNOWPACK WATER, VAPOR AND HEAT FLUXES -C - TFLWS(NY,NX)=TFLWS(NY,NX)+FLW0S(NY,NX) - 2-WFLXA(NY,NX)-FLWS1(NY,NX) - TFLWW(NY,NX)=TFLWW(NY,NX)+FLW0L(NY,NX) - 2+WFLXA(NY,NX)+WFLXB(NY,NX)-FLWZ1(NY,NX) - TFLWI(NY,NX)=TFLWI(NY,NX)-WFLXB(NY,NX)/0.92-FLWI1(NY,NX) - THFLWW(NY,NX)=THFLWW(NY,NX)+HFLW0L(NY,NX)+TFLX0(NY,NX) - 2-HFLWZ1(NY,NX)-HFLSI1(NY,NX) - HTHAWW(NY,NX)=HTHAWW(NY,NX)+TFLX0(NY,NX) - THRMG(NY,NX)=THRMG(NY,NX)+THRMX -C IF(NX.EQ.4.AND.NY.EQ.4)THEN -C WRITE(*,7754)'THFLWW',I,J,M,NX,NY,THFLWW(NY,NX) -C 2,HFLW0L(NY,NX),TFLX0(NY,NX) -C 2,HFLWZ1(NY,NX),HFLSI1(NY,NX) -C ENDIF -C -C ENERGY EXCHANGE AT SOIL SURFACE IF EXPOSED -C - ELSE -C -C PHYSICAL AND HYDRAULIC PROPERTIES OF SOIL SURFACE INCLUDING -C AIR AND WATER-FILLED POROSITY, AND WATER POTENTIAL USED IN -C FLUX CALCULATIONS -C -C IF(BKVL(NU(NY,NX),NY,NX).GT.0.0)THEN - 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) - 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 - PSISM1(NU(NY,NX),NY,NX)=-EXP(PSIMS(NY,NX) - 2+(((PSL(NU(NY,NX),NY,NX)-LOG(THETW1)) - 3/PSD(NU(NY,NX),NY,NX))**SRP(NU(NY,NX),NY,NX)*PSISD(NY,NX))) - ELSE - PSISM1(NU(NY,NX),NY,NX)=PSISE(NU(NY,NX),NY,NX) - ENDIF -C ELSE -C PSISM1(NU(NY,NX),NY,NX)=PSISE(NU(NY,NX),NY,NX) -C ENDIF - PSISV1=PSISM1(NU(NY,NX),NY,NX)+PSISO(NU(NY,NX),NY,NX) -C IF(NX.EQ.4.AND.NY.EQ.5)THEN -C WRITE(*,3232)'PSISV1',I,J,M,NX,NY,NU(NY,NX),PSISV1 -C 2,PSISM1(NU(NY,NX),NY,NX),PSISO(NU(NY,NX),NY,NX) -C 3,THETWX(NU(NY,NX),NY,NX),THETW1,POROS(NU(NY,NX),NY,NX) -C 4,PSL(NU(NY,NX),NY,NX),LOG(THETW1),PSD(NU(NY,NX),NY,NX) -C 5,SRP(NU(NY,NX),NY,NX) -3232 FORMAT(A8,6I4,12E12.4) -C ENDIF -C -C SOIL SURFACE ALBEDO, NET RADIATION -C - VOLWXG=VOLW1(NU(NY,NX),NY,NX)+VOLWH1(NU(NY,NX),NY,NX) - VOLIXG=VOLI1(NU(NY,NX),NY,NX)+VOLIH1(NU(NY,NX),NY,NX) - ALBG=(ALBS(NY,NX)*BKVL(NU(NY,NX),NY,NX)+0.06*VOLWXG - 2+0.30*VOLIXG)/(BKVL(NU(NY,NX),NY,NX)+VOLWXG+VOLIXG) - RFLX1=(1.0-ALBG)*RADXG(NY,NX)+THRYG(NY,NX) - THRMA=THRMS(NY,NX)*TK1(NU(NY,NX),NY,NX)**4 - RFLX=RFLX1-THRMA -C -C AERODYNAMIC RESISTANCE ABOVE SOIL SURFACE INCLUDING -C RESISTANCE IMPOSED BY PLANT CANOPY -C - RAR1=RAR(NY,NX)/AMAX1(THETX,THETPX(0,NY,NX))**2.33 - RAGZ=RAG(NY,NX)+RAR1 - RI=AMAX1(-0.3,AMIN1(0.075,RIB(NY,NX)*(TKQ(NY,NX) - 2-TK1(NU(NY,NX),NY,NX)))) - RAGX=AMAX1(RAM,0.75*RAGS(NY,NX),AMIN1(1.33*RAGS(NY,NX) - 2,RAGZ/(1.0-10.0*RI))) - RAGS(NY,NX)=RAGX - RA=RAGX -C -C PARAMETERS FOR CALCULATING LATENT AND SENSIBLE HEAT FLUXES -C - PARE=PAREG(NY,NX)/(RA+RZ) - PARS=PARSG(NY,NX)/RA - TKX1=TK1(NU(NY,NX),NY,NX) - VP1=2.173E-03/TKX1 - 2*0.61*EXP(5360.0*(3.661E-03-1.0/TKX1)) - 3*EXP(18.0*PSISV1/(8.3143*TKX1)) - EVAP(NY,NX)=AMAX1(PARE*(VPQ(NY,NX)-VP1) - 2,-AMAX1(0.0,VOLW1(NU(NY,NX),NY,NX))*XNPH) - EVAPS(NY,NX)=0.0 - EFLX=EVAP(NY,NX)*VAP - IF(EVAP(NY,NX).LT.0.0)THEN - VFLX=EVAP(NY,NX)*4.19*TK1(NU(NY,NX),NY,NX) - ELSE - VFLX=EVAP(NY,NX)*4.19*TKQ(NY,NX) - ENDIF -C IF(NX.EQ.4.AND.NY.EQ.5)THEN -C WRITE(*,3376)'EVAP',I,J,M,NX,NY,EVAP(NY,NX),RFLX,RFLX1,THRMA -C 3,THETPX(0,NY,NX),VHCPR1(NY,NX),CVRD(NY,NX) -C 2,PARE,VPQ(NY,NX),VP1,RA,RAZ,RAGS(NY,NX),RI,RAR1,RAR(NY,NX),RAGZ -C 3,RAG(NY,NX),RIB(NY,NX),TKX1,PSISV1,VOLW1(NU(NY,NX),NY,NX) -C 4,DLYRR(NY,NX),WGSGR(NY,NX),VOLX(0,NY,NX),ORGC(0,NY,NX) -C 5,VOLA(0,NY,NX),VOLW1(0,NY,NX),VOLI1(0,NY,NX),VOLP1(0,NY,NX) -C ENDIF -C -C SOLVE FOR SOIL SURFACE TEMPERATURE AT WHICH ENERGY -C BALANCE OCCURS, SOLVE LATENT, SENSIBLE AND STORAGE HEAT FLUXES -C - SFLX=PARS*(TKQ(NY,NX)-TK1(NU(NY,NX),NY,NX)) - HFLW1=RFLX+EFLX+SFLX+VFLX -C IF(I.EQ.208)THEN -C WRITE(*,1112)'EFLX',I,J,M,NX,NY,TK1(NU(NY,NX),NY,NX) -C 2,RFLX,EFLX,SFLX,VFLX,HFLW1,RA,RAC(NY,NX),RAG(NY,NX),RAS1,RAGZ,RAR1 -C 3,RAGX,RI,RAGS(NY,NX),VOLW1(NU(NY,NX),NY,NX),VOLI1(NU(NY,NX),NY,NX) -C 4,RADXG(NY,NX),THRYG(NY,NX),THRMA,THRYW(NY,NX),THS(NY,NX) -C 5,BARE(NY,NX),PARG(NY,NX),VPQ(NY,NX),VP1,FRADG(NY,NX),THRMCX(NY,NX) -C 5,PSISM1(NU(NY,NX),NY,NX),PSISO(NU(NY,NX),NY,NX) -C 6,FLQM,EVAP(NY,NX),PARE,HFLW1,PARS,PARSG(NY,NX),HWFLQM -C 7,ATCNDS,TCND1,THETPY(NU(NY,NX),NY,NX),RAR(NY,NX),THETPY(0,NY,NX) -C 8,VHCP1(NU(NY,NX),NY,NX),PARS -C 3,TKQ(NY,NX) -1112 FORMAT(A8,5I4,60E12.4) -C ENDIF -C -C ENERGY BALANCE AT RESIDUE SURFACE -C - IF(VHCPR1(NY,NX).GT.VHCPRX(NY,NX))THEN -C -C PARAMETERS FOR CALCULATING LATENT AND SENSIBLE HEAT FLUXES -C - EVAPR(NY,NX)=0.0 - RFLXR=0.0 - EFLXR=0.0 - VFLXR=0.0 - SFLXR=0.0 - HFLR1=0.0 - FLV1=0.0 - HWFLV1=0.0 - HFLCR1=0.0 - THRMZ=0.0 -C -C NET RADIATION AT RESIDUE SURFACE -C - ALBR=(0.20*BKVL(0,NY,NX)+0.06*VOLW1(0,NY,NX)+0.30 - 2*VOLI1(0,NY,NX))/(BKVL(0,NY,NX)+VOLW1(0,NY,NX)+VOLI1(0,NY,NX)) - RFLX1=(1.0-ALBR)*RADXR(NY,NX)+THRYR(NY,NX) - TKR1=TK1(0,NY,NX) - VOLWR2=VOLW1(0,NY,NX) - VHCPR2=VHCPR1(NY,NX) - TKS1=TK1(NU(NY,NX),NY,NX) - HFLW2=HFLW1*XNPR - VOLW12=VOLW1(NU(NY,NX),NY,NX) - VHCP12=VHCP1(NU(NY,NX),NY,NX) -C -C THERMAL CONDUCTIVITY BETWEEN SURFACE RESIDUE AND SOIL SURFACE -C - CNVR=THETPX(0,NY,NX)**2/POROQ(0,NY,NX)*WGSGR0(NY,NX)*XNPR - CNV1=THETPX(NU(NY,NX),NY,NX)**2/POROQ(NU(NY,NX),NY,NX)*XNPR - 2*WGSG1(NU(NY,NX),NY,NX) - IF(CVRD(NY,NX).GT.ZERO)THEN - IF(CNVR.GT.ZERO.AND.CNV1.GT.ZERO)THEN - AVCNVS=2.0*CNVR*CNV1 - 2/(CNVR*DLYR(3,NU(NY,NX),NY,NX)+CNV1*DLYRR(NY,NX))*CVRD(NY,NX) - ELSE - AVCNVS=2.0*CNVR - 2/(DLYR(3,NU(NY,NX),NY,NX)+DLYRR(NY,NX))*CVRD(NY,NX) - ENDIF - ELSE - AVCNVS=0.0 - ENDIF - THETRR=AMAX1(0.0,1.0-THETPX(0,NY,NX)-THETWX(0,NY,NX) - 2-THETIX(0,NY,NX)) - DTKX=ABS(TK1(0,NY,NX)-TK1(NU(NY,NX),NY,NX))*1.0E-06 - DTHW0=AMAX1(0.0,THETWX(0,NY,NX)-TRBW)**3 - DTHA0=AMAX1(0.0,THETPX(0,NY,NX)-TRBA)**3 - DTHW1=AMAX1(0.0,THETWX(NU(NY,NX),NY,NX)-TRBW)**3 - DTHA1=AMAX1(0.0,THETPX(NU(NY,NX),NY,NX)-TRBA)**3 - RYLXW0=DTKX*DTHW0 - RYLXA0=DTKX*DTHA0 - RYLXW1=DTKX*DTHW1 - RYLXA1=DTKX*DTHA1 - RYLNW0=AMIN1(1.0E+04,RYLXW*RYLXW0) - RYLNA0=AMIN1(1.0E+04,RYLXA*RYLXA0) - RYLNW1=AMIN1(1.0E+04,RYLXW*RYLXW1) - RYLNA1=AMIN1(1.0E+04,RYLXA*RYLXA1) - XNUSW0=AMAX1(1.0,0.68+0.67*RYLNW0**0.25/DNUSW) - XNUSA0=AMAX1(1.0,0.68+0.67*RYLNA0**0.25/DNUSA) - XNUSW1=AMAX1(1.0,0.68+0.67*RYLNW1**0.25/DNUSW) - XNUSA1=AMAX1(1.0,0.68+0.67*RYLNA1**0.25/DNUSA) - TCNDW0=2.067E-03*XNUSW0 - TCNDA0=9.050E-05*XNUSA0 - TCNDW1=2.067E-03*XNUSW1 - TCNDA1=9.050E-05*XNUSA1 - WTHET0=1.467-0.467*THETPY(0,NY,NX) - TCNDR=(0.779*THETRR*9.050E-04+0.622*THETWX(0,NY,NX)*TCNDW0 - 2+0.380*THETIX(0,NY,NX)*7.844E-03 - 3+WTHET0*THETPX(0,NY,NX)*TCNDA0) - 4/(0.779*THETRR+0.622*THETWX(0,NY,NX) - 5+0.380*THETIX(0,NY,NX)+WTHET0*THETPX(0,NY,NX)) - TCNDR1=TCNDR*XNPHR - WTHET1=1.467-0.467*THETPY(NU(NY,NX),NY,NX) - TCND1=(STC(NU(NY,NX),NY,NX)+THETWX(NU(NY,NX),NY,NX)*TCNDW1 - 2+0.611*THETIX(NU(NY,NX),NY,NX)*7.844E-03 - 3+WTHET1*THETPX(NU(NY,NX),NY,NX)*TCNDA1) - 4/(DTC(NU(NY,NX),NY,NX)+THETWX(NU(NY,NX),NY,NX) - 5+0.611*THETIX(NU(NY,NX),NY,NX)+WTHET1*THETPX(NU(NY,NX),NY,NX)) - TCND1R=TCND1*XNPHR - ATCNDR=2.0*TCNDR1*TCND1R/(TCNDR1*DLYR(3,NU(NY,NX),NY,NX) - 2+TCND1R*DLYRR(NY,NX))*CVRD(NY,NX) -C -C SMALLER TIME STEP FOR SOLVING SURFACE RESIDUE ENERGY EXCHANGE -C - DO 5000 N=1,NPR - IF(VHCPR2.GT.VHCPRX(NY,NX))THEN -C -C AERODYNAMIC RESISTANCE ABOVE RESIDUE INCLUDING -C RESISTANCE IMPOSED BY PLANT CANOPY -C - RI=AMAX1(-0.3,AMIN1(0.075,RIB(NY,NX)*(TKQ(NY,NX)-TKR1))) - RAGX=AMAX1(RAM,0.75*RAGR(NY,NX),AMIN1(1.33*RAGR(NY,NX) - 2,RARG(NY,NX)/(1.0-10.0*RI))) - RAGR(NY,NX)=RAGX - RA=RAGX - PARE=PARER(NY,NX)/(RA+RZR) - PARS=PARSR(NY,NX)/RA -C -C NET RADIATION AT RESIDUE SURFACE -C - THRMZ2=THRMR(NY,NX)*TKR1**4 - RFLXR2=RFLX1-THRMZ2 - IF(VOLWRX(NY,NX).GT.ZEROS(NY,NX))THEN - THETWR=AMAX1(0.01,AMIN1(1.0,VOLWR2/VOLWRX(NY,NX))) - ELSE - THETWR=1.0 - ENDIF - PSISM1(0,NY,NX)=PSISE(0,NY,NX)*THETWR**-4.0 -C -C VAPOR FLUX AT RESIDUE SURFACE -C - VPR=2.173E-03/TKR1 - 2*0.61*EXP(5360.0*(3.661E-03-1.0/TKR1)) - 3*EXP(18.0*PSISM1(0,NY,NX)/(8.3143*TKR1)) - VP1=2.173E-03/TKS1 - 2*0.61*EXP(5360.0*(3.661E-03-1.0/TKS1)) - 3*EXP(18.0*PSISV1/(8.3143*TKS1)) - EVAPR2=AMIN1(VOLWRM*XNPHR,AMAX1(-AMAX1(0.0,VOLWR2)*XNPHR - 2,PARE*(VPQ(NY,NX)-VPR))) - EFLXR2=EVAPR2*VAP - VFLXR2=EVAPR2*4.19*TKR1 -C -C SOLVE FOR RESIDUE SURFACE TEMPERATURE AT WHICH ENERGY -C BALANCE OCCURS, SOLVE LATENT, SENSIBLE AND STORAGE HEAT FLUXES -C - TKY=(TKR1*VHCPR2+TKS1*VHCP12)/(VHCPR2+VHCP12) - HFLWX=(TKR1-TKY)*VHCPR2*FHFLX*XDIM - FLVX=AVCNVS*(VPR-VP1)*AREA(3,NU(NY,NX),NY,NX) - IF(FLVX.GE.0.0)THEN - FLV2=AMIN1(FLVX,VOLWR2*XNPHR) - IF(HFLWX.GE.0.0)THEN - FLV2=AMIN1(FLV2,HFLWX/(4.19*TKR1+VAP)) - ENDIF - HWFLV2=(4.19*TKR1+VAP)*FLV2 - ELSE - FLV2=AMAX1(FLVX,-VOLW12*XNPHR) - IF(HFLWX.LT.0.0)THEN - FLV2=AMAX1(FLV2,HFLWX/(4.19*TKS1+VAP)) - ENDIF - HWFLV2=(4.19*TKS1+VAP)*FLV2 - ENDIF - TKXR=TKR1-HWFLV2/VHCPR2 - TK1X=TKS1+HWFLV2/VHCP12 - TKY=(TKXR*VHCPR2+TK1X*VHCP12)/(VHCPR2+VHCP12) - HFLWX=(TKXR-TKY)*VHCPR2*FHFLX*XDIM - HFLWC=ATCNDR*(TKXR-TK1X)*AREA(3,0,NY,NX) - IF(HFLWC.GE.0.0)THEN - HFLCR2=AMAX1(0.0,AMIN1(HFLWX,HFLWC)) - ELSE - HFLCR2=AMIN1(0.0,AMAX1(HFLWX,HFLWC)) - ENDIF - SFLXR2=PARS*(TKQ(NY,NX)-TKR1) - HFLR2=RFLXR2+EFLXR2+SFLXR2+VFLXR2 -C -C AGGREGATE WATER AND ENERGY FLUXES FROM RESIDUE TIME STEP -C TO MODEL TIME STEP -C - EVAPR(NY,NX)=EVAPR(NY,NX)+EVAPR2 - RFLXR=RFLXR+RFLXR2 - EFLXR=EFLXR+EFLXR2 - VFLXR=VFLXR+VFLXR2 - SFLXR=SFLXR+SFLXR2 - HFLR1=HFLR1+HFLR2 - FLV1=FLV1+FLV2 - HWFLV1=HWFLV1+HWFLV2 - HFLCR1=HFLCR1+HFLCR2 - THRMZ=THRMZ+THRMZ2 - ELSE - EVAPR2=0.0 - RFLXR2=0.0 - EFLXR2=0.0 - VFLXR2=0.0 - SFLXR2=0.0 - HFLR2=0.0 - FLV2=0.0 - HWFLV2=0.0 - HFLCR2=0.0 - THRMZ2=0.0 - ENDIF - VOLWR2=VOLWR2+FLYM2+EVAPR2-FLV2 - VOLW12=VOLW12+FLV2 - ENGYR=VHCPR2*TKR1 - VHCPR2=2.496E-06*ORGC(0,NY,NX)+4.19*VOLWR2 - 2+1.9274*VOLI1(0,NY,NX) - VHCP12=VHCP12+4.19*FLV2 - TKR1=(ENGYR+HWFLM2+HFLR2-HWFLV2-HFLCR2)/VHCPR2 - TKS1X=TKS1 - TKS1=TKS1+(HFLW2+HWFLV2+HFLCR2)/VHCP12 -C IF(NX.EQ.1.AND.NY.EQ.6)THEN -C WRITE(*,1111)'EFLXR2',I,J,M,NX,NY,N,TKR1,TKS1,TKQ(NY,NX) -C 2,EFLXR2,SFLXR2,VFLXR2,FLV2,FLVX,VPR,VP1,AVCNVS,PSISE(0,NY,NX) -C 3,PSISM1(0,NY,NX),PSISV1,THETWR,VOLWR2,VOLWRX(NY,NX),TRC0(NY,NX) -C 4,PARS,PARE,RA,RZR,RI,TKQ(NY,NX),VOLWR2,VOLW12,HFLWX,FLV1 -C 5,VOLW1(NU(NY,NX),NY,NX),THRMZ2,VOLW1(0,NY,NX) -C 3,HWFLV2,HFLCR2,HWFLM2,RA,RAGX,RAG(NY,NX),RAB(NY,NX),RAC(NY,NX) -C 4,RZR,RZ,PARS -C 4,RAR1,PARE,VPQ(NY,NX),EVAPR(NY,NX),EVAPR2 -C 5,VHCPR2,VHCP12,CNVR,CNV1,VOLX(0,NY,NX) -C 5,ATCNDR,TCNDR,TCNDR1,TCND1R,DLYR(3,NU(NY,NX),NY,NX) -C 6,DLYRR(NY,NX),DLYR(3,0,NY,NX),POROQ(0,NY,NX),WGSGR(NY,NX) -C 7,THETWX(0,NY,NX),THETIX(0,NY,NX),THETPY(0,NY,NX),ORGC(0,NY,NX) -C 8,CVRD(NY,NX),EFLXR,EFLX,TRA0(NY,NX),ATCNDR*(TKR1-TKS1),TKS1X -1111 FORMAT(A8,6I4,100E12.4) -C ENDIF -5000 CONTINUE -C -C IF NO SURFACE RESIDUE -C - ELSE - TK1(0,NY,NX)=TK1(NU(NY,NX),NY,NX) - EVAPR(NY,NX)=0.0 - RFLXR=0.0 - EFLXR=0.0 - VFLXR=0.0 - SFLXR=0.0 - HFLR1=0.0 - FLV1=0.0 - HWFLV1=0.0 - HFLCR1=0.0 - THRMZ=0.0 - ENDIF -C -C GATHER WATER, VAPOR AND HEAT FLUXES INTO FLUX ARRAYS -C FOR LATER UPDATES TO STATE VARIABLES -C - FLWL(3,NU(NY,NX),NY,NX)=FLQM+EVAP(NY,NX)+FLV1 - FLWLX(3,NU(NY,NX),NY,NX)=FLQM+EVAP(NY,NX)+FLV1 - FLWHL(3,NU(NY,NX),NY,NX)=FLHM - HFLWL(3,NU(NY,NX),NY,NX)=HWFLQM+HFLW1+HWFLV1+HFLCR1 - FLWRL(NY,NX)=FLYM+EVAPR(NY,NX)-FLV1 - HFLWRL(NY,NX)=HWFLYM+HFLR1-HWFLV1-HFLCR1 - FLWVL(NU(NY,NX),NY,NX)=RFLWV(NY,NX)*(VOLW1(NU(NY,NX),NY,NX) - 2-VOLWX1(NU(NY,NX),NY,NX)) - FLWV(NU(NY,NX),NY,NX)=FLWV(NU(NY,NX),NY,NX) - 2+FLWVL(NU(NY,NX),NY,NX) -C IF(NX.EQ.1.AND.NY.EQ.6)THEN -C WRITE(*,3376)'FLW1',I,J,M,NX,NY,FLWL(3,NU(NY,NX),NY,NX) -C 2,PSISM1(0,NY,NX),PSISM1(NU(NY,NX),NY,NX),VOLWRX(NY,NX) -C 3,VOLW1(0,NY,NX),VOLW1(NU(NY,NX),NY,NX),THETWX(NU(NY,NX),NY,NX) -C 2,FLQM,EVAP(NY,NX),PARE,VPQ(NY,NX),VP1 -C 4,FLWRL(NY,NX),FLYM,EVAPR(NY,NX),FLV1 -C WRITE(*,3376)'HFLW1',I,J,M,NX,NY,HFLWL(3,NU(NY,NX),NY,NX) -C 2,HWFLQM,HFLW1,HWFLV1,HFLCR1,HFLWRL(NY,NX),HWFLYM -C 3,HFLR1,HWFLV1,HFLCR1 -3376 FORMAT(A8,5I4,40E12.4) -C ENDIF -C -C HEAT AND WATER TRANSFER WITH RESIDUAL SNOWPACK -C - TFLWS(NY,NX)=TFLWS(NY,NX)+FLQ0S(NY,NX)-FLWS1(NY,NX) - TFLWW(NY,NX)=TFLWW(NY,NX)+FLQ0W(NY,NX)-FLWZ1(NY,NX) - TFLWI(NY,NX)=TFLWI(NY,NX)-FLWI1(NY,NX) - THFLWW(NY,NX)=THFLWW(NY,NX)+HWFLQ0(NY,NX)-HFLWZ1(NY,NX) - 2-HFLSI1(NY,NX) - THRMG(NY,NX)=THRMG(NY,NX)+THRMA+THRMZ -C IF(NX.EQ.4.AND.NY.EQ.4)THEN -C WRITE(*,7754)'THFLWS',I,J,M,NX,NY,THFLWW(NY,NX) -C 2,HWFLQ0(NY,NX),HFLWZ1(NY,NX) -C 2-HFLSI1(NY,NX) -C ENDIF - ENDIF -C -C CAPILLARY EXCHANGE OF WATER BETWEEN SOIL SURFACE AND RESIDUE -C - CNDR=HCNDR(NY,NX)*(PSISE(0,NY,NX)/PSISM1(0,NY,NX))**3 - IF(VOLW1(0,NY,NX).GE.VOLWRX(NY,NX))THEN - CND1=HCND(3,1,NU(NY,NX),NY,NX)*XNPH - ELSE - K1=MAX(1,MIN(100,INT(100.0*(AMAX1(0.0,POROS(NU(NY,NX),NY,NX) - 2-THETWX(NU(NY,NX),NY,NX)))/POROS(NU(NY,NX),NY,NX))+1)) - CND1=HCND(3,K1,NU(NY,NX),NY,NX)*XNPH - ENDIF - AVCND1=2.0*CNDR*CND1/(CNDR*DLYR(3,NU(NY,NX),NY,NX) - 2+CND1*DLYRR(NY,NX)) - FLXQR=AVCND1*(PSISM1(0,NY,NX)-PSISM1(NU(NY,NX),NY,NX)) - 2*AREA(3,NU(NY,NX),NY,NX) - IF(FLXQR.LT.0.0)THEN - FLXSR=AMAX1(FLXQR,-XNPH*AMIN1(VOLW1(NU(NY,NX),NY,NX) - 2,AMAX1(0.0,VOLWRX(NY,NX)-VOLW1(0,NY,NX)-VOLI1(0,NY,NX)))) - ELSE - FLXSR=AMIN1(FLXQR,XNPH*VOLW1(0,NY,NX)) - FLXSR=AMIN1(FLXSR,XNPH*VOLP1(NU(NY,NX),NY,NX)) - ENDIF - IF(FLXSR.GT.0.0)THEN - HFLXSR=4.19*TK1(0,NY,NX)*FLXSR - ELSE - HFLXSR=4.19*TK1(NU(NY,NX),NY,NX)*FLXSR - ENDIF - FLWL(3,NU(NY,NX),NY,NX)=FLWL(3,NU(NY,NX),NY,NX)+FLXSR - HFLWL(3,NU(NY,NX),NY,NX)=HFLWL(3,NU(NY,NX),NY,NX)+HFLXSR - FLWRL(NY,NX)=FLWRL(NY,NX)-FLXSR - HFLWRL(NY,NX)=HFLWRL(NY,NX)-HFLXSR - FLWRM(M,NY,NX)=FLXSR -C IF(NX.EQ.1.AND.NY.EQ.6)THEN -C WRITE(*,4322)'FLWLY',I,J,M,NX,NY,FLWRL(NY,NX),FLWLY,FLWLYR -C 2,FLWLYH,FLXSR,VOLX(NU(NY,NX),NY,NX),VOLA(NU(NY,NX),NY,NX) -C 3,VOLP1(NU(NY,NX),NY,NX),VOLW1(NU(NY,NX),NY,NX) -C 3,VOLI1(NU(NY,NX),NY,NX),VOLP1(0,NY,NX),VOLW1(0,NY,NX) -C 3,VOLI1(0,NY,NX),FLXQR,PSISM1(0,NY,NX) -C 4,PSISM1(NU(NY,NX),NY,NX),AVCND1 -C 2,VOLAH1(NU(NY,NX),NY,NX),VOLPH1(NU(NY,NX),NY,NX) -C 2,VOLWH1(NU(NY,NX),NY,NX),VOLIH1(NU(NY,NX),NY,NX) -4322 FORMAT(A8,5I4,40E12.4) -C ENDIF -C -C MOVE WATER UP DURING PRECIPITATION OR FREEZING -C - IF(VOLW1(NU(NY,NX),NY,NX)+VOLI1(NU(NY,NX),NY,NX) - 2.GT.VOLA(NU(NY,NX),NY,NX))THEN - FLWLY=AMIN1(0.0,AMAX1(-XNPH*VOLW1(NU(NY,NX),NY,NX) - 2,VOLA(NU(NY,NX),NY,NX)-VOLW1(NU(NY,NX),NY,NX) - 3-VOLI1(NU(NY,NX),NY,NX))) - HFLWLY=FLWLY*4.19*TK1(NU(NY,NX),NY,NX) - FLWL(3,NU(NY,NX),NY,NX)=FLWL(3,NU(NY,NX),NY,NX)+FLWLY - HFLWL(3,NU(NY,NX),NY,NX)=HFLWL(3,NU(NY,NX),NY,NX)+HFLWLY - FLWLYR=AMIN1(0.0,FLWLY+VOLPH1(NU(NY,NX),NY,NX)) - HFLWYR=FLWLYR*4.19*TK1(NU(NY,NX),NY,NX) - FLWLYH=FLWLY-FLWLYR - HFLWYH=FLWLYH*4.19*TK1(NU(NY,NX),NY,NX) - FLWRL(NY,NX)=FLWRL(NY,NX)-FLWLYR - HFLWRL(NY,NX)=HFLWRL(NY,NX)-HFLWYR - FLWHL(3,NU(NY,NX),NY,NX)=FLWHL(3,NU(NY,NX),NY,NX)-FLWLYH - HFLWL(3,NU(NY,NX),NY,NX)=HFLWL(3,NU(NY,NX),NY,NX)-HFLWYH - ENDIF - IF(VOLWH1(NU(NY,NX),NY,NX)+VOLIH1(NU(NY,NX),NY,NX) - 2.GT.VOLAH1(NU(NY,NX),NY,NX))THEN - FLWHY=AMIN1(0.0,AMAX1(-XNPH*VOLWH1(NU(NY,NX),NY,NX) - 2,VOLAH1(NU(NY,NX),NY,NX)-VOLWH1(NU(NY,NX),NY,NX) - 3-VOLIH1(NU(NY,NX),NY,NX))) - HFLWHY=FLWHY*4.19*TK1(NU(NY,NX),NY,NX) - FLWHL(3,NU(NY,NX),NY,NX)=FLWHL(3,NU(NY,NX),NY,NX)+FLWHY - HFLWL(3,NU(NY,NX),NY,NX)=HFLWL(3,NU(NY,NX),NY,NX)+HFLWHY - FLWRL(NY,NX)=FLWRL(NY,NX)-FLWHY - HFLWRL(NY,NX)=HFLWRL(NY,NX)-HFLWHY -C IF(NX.EQ.1.AND.NY.EQ.6)THEN -C WRITE(*,4324)'FLWHY',I,J,M,NX,NY,FLWRL(NY,NX),FLWHY -C 2,VOLAH1(NU(NY,NX),NY,NX),VOLPH1(NU(NY,NX),NY,NX) -C 2,VOLWH1(NU(NY,NX),NY,NX),VOLIH1(NU(NY,NX),NY,NX) -C 2,VOLAH1(NU(NY,NX)+1,NY,NX),VOLPH1(NU(NY,NX)+1,NY,NX) -C 2,VOLWH1(NU(NY,NX)+1,NY,NX),VOLIH1(NU(NY,NX)+1,NY,NX) -C 3,VOLW1(0,NY,NX) -4324 FORMAT(A8,5I4,30E12.4) -C ENDIF - ENDIF -C IF((I/10)*10.EQ.I)THEN -C WRITE(*,4321)'HCNDR',I,J,M,NX,NY,K1,AVCND1,CNDR,CND1,DLYRR(NY,NX) -C 2,PSISM1(0,NY,NX),PSISM1(NU(NY,NX),NY,NX),FLXQR,FLXSR,HFLXSR -C 3,VOLWR2,TRA0(NY,NX),EVAPR(NY,NX),VOLWRX(NY,NX)-VOLW1(0,NY,NX) -C 2-VOLI1(0,NY,NX),VOLW1(NU(NY,NX),NY,NX),VOLW1(0,NY,NX) -C 4,VOLP1(NU(NY,NX),NY,NX),POROS(NU(NY,NX),NY,NX) -C 5,VOLWG(NY,NX),FLYM,HCNDR(NY,NX),PSISE(0,NY,NX),PSISM1(0,NY,NX) -C 6,THETWR,VHCPR1(NY,NX),VHCPRX(NY,NX) -4321 FORMAT(A8,6I4,30E12.4) -C ENDIF -C -C OVERLAND FLOW INTO MACROPORES WHEN WATER STORAGE CAPACITY -C OF THE SOIL SURFACE IS EXCEEDED -C - IF(VOLPH1(NU(NY,NX),NY,NX).GT.0.0)THEN - IF(VOLW1(0,NY,NX).GT.VOLWRX(NY,NX))THEN - AVCNH1=2.0*CNDH1(NU(NY,NX),NY,NX)/DLYR(3,NU(NY,NX),NY,NX) - FLWHX=AVCNH1*0.0098*DPTH(NU(NY,NX),NY,NX)*AREA(3,NU(NY,NX),NY,NX) - FINHR=AMIN1(VOLPH1(NU(NY,NX),NY,NX) - 2,VOLW1(0,NY,NX)-VOLWRX(NY,NX),FLWHX) - HFINHR=FINHR*4.19*TK1(0,NY,NX) - FLWRL(NY,NX)=FLWRL(NY,NX)-FINHR - HFLWRL(NY,NX)=HFLWRL(NY,NX)-HFINHR - FLWHL(3,NU(NY,NX),NY,NX)=FLWHL(3,NU(NY,NX),NY,NX)+FINHR - HFLWL(3,NU(NY,NX),NY,NX)=HFLWL(3,NU(NY,NX),NY,NX)+HFINHR -C IF(NX.EQ.1.AND.NY.EQ.6)THEN -C WRITE(*,4357)'FINHR',I,J,M,NX,NY,FLWRL(NY,NX),FINHR -C 2,VOLPH1(NU(NY,NX),NY,NX),TVOLW(NY,NX),FLWHX,VOLW1(0,NY,NX) -C 3,VOLWRX(NY,NX),FLWHL(3,NU(NY,NX),NY,NX) -C 4,HFINHR,TK1(0,NY,NX),HFLWRL(NY,NX),HFLWL(3,NU(NY,NX),NY,NX) -4357 FORMAT(A8,5I4,40E12.4) -C ENDIF - ENDIF - ENDIF -C -C FREEZE-THAW IN RESIDUE SURFACE FROM NET CHANGE IN RESIDUE -C SURFACE HEAT STORAGE -C - TFREEZ=-9.0959E+04/(PSISM1(0,NY,NX)-333.0) - IF((TK1(0,NY,NX).LT.TFREEZ - 2.AND.VOLW1(0,NY,NX).GT.ZERO*VOLA(0,NY,NX)) - 3.OR.(TK1(0,NY,NX).GT.TFREEZ - 4.AND.VOLI1(0,NY,NX).GT.ZERO*VOLA(0,NY,NX)))THEN - TFLX1=1.0/(1.0+TFREEZ*6.2913E-03) - 2*(TFREEZ*4.19*FLWRL(NY,NX) - 3+VHCPR1(NY,NX)*(TFREEZ-TK1(0,NY,NX)) - 4-HFLWRL(NY,NX)) - IF(TFLX1.LT.0.0)THEN - TFLX=AMAX1(-333.0*0.92*VOLI1(0,NY,NX)*XNPH - 2,-VHCPR1(NY,NX)*XNPH,TFLX1) - ELSE - TFLX=AMIN1(333.0*VOLW1(0,NY,NX)*XNPH - 2,VHCPR1(NY,NX)*XNPH,TFLX1) - ENDIF - WFLX=-TFLX/333.0 - IF(WFLX.GT.0.0.AND.VOLI1(0,NY,NX) - 2.GT.ZEROS(NY,NX))THEN - WFLXR(NY,NX)=WFLX - TFLXR(NY,NX)=TFLX - ELSEIF(WFLX.LT.0.0.AND.VOLW1(0,NY,NX) - 2.GT.ZEROS(NY,NX))THEN - WFLXR(NY,NX)=WFLX - TFLXR(NY,NX)=TFLX - ELSE - WFLXR(NY,NX)=0.0 - TFLXR(NY,NX)=0.0 - ENDIF - ELSE - WFLXR(NY,NX)=0.0 - TFLXR(NY,NX)=0.0 - ENDIF -C WRITE(*,5352)'TFLXR',I,J,M,WFLXR(NY,NX),TFLXR(NY,NX) -C 2,PSISV0,THETWR,TFLX,WFLX,VOLI1(0,NY,NX),VOLW1(0,NY,NX) -C 3,TKXR,TFREEZ,PSISV0 -5352 FORMAT(A8,3I4,20E12.4) -C -C FREEZE-THAW IN SOIL SURFACE MICROPORE FROM NET CHANGE IN SOIL -C SURFACE HEAT STORAGE -C - TFREEZ=-9.0959E+04/(PSISV1-333.0) - IF((TK1(NU(NY,NX),NY,NX).LT.TFREEZ - 2.AND.VOLW1(NU(NY,NX),NY,NX).GT.ZERO*VOLA(NU(NY,NX),NY,NX) - 3.AND.VOLI1(NU(NY,NX),NY,NX).LT.VOLA(NU(NY,NX),NY,NX)) - 4.OR.(TK1(NU(NY,NX),NY,NX).GT.TFREEZ - 5.AND.VOLI1(NU(NY,NX),NY,NX).GT.ZERO*VOLA(NU(NY,NX),NY,NX)))THEN - TFLX1=FGRD(NU(NY,NX),NY,NX)*(1.0/(1.0+TFREEZ*6.2913E-03) - 2*(TFREEZ*4.19*(FLWL(3,NU(NY,NX),NY,NX)+FLWHL(3,NU(NY,NX),NY,NX)) - 3+VHCP1(NU(NY,NX),NY,NX)*(TFREEZ-TK1(NU(NY,NX),NY,NX)) - 4-HFLWL(3,NU(NY,NX),NY,NX))) - IF(TFLX1.LT.0.0)THEN - TFLX=AMAX1(-333.0*0.92*VOLI1(NU(NY,NX),NY,NX)*XNPH,TFLX1) - ELSE - TFLX=AMIN1(333.0*VOLW1(NU(NY,NX),NY,NX)*XNPH,TFLX1) - ENDIF - WFLX=-TFLX/333.0 - IF(WFLX.GT.0.0.AND.VOLI1(NU(NY,NX),NY,NX) - 2.GT.ZEROS(NY,NX))THEN - WFLXL(3,NU(NY,NX),NY,NX)=WFLX - ELSEIF(WFLX.LT.0.0.AND.VOLW1(NU(NY,NX),NY,NX) - 2.GT.ZEROS(NY,NX))THEN - WFLXL(3,NU(NY,NX),NY,NX)=WFLX - ELSE - TFLX=0.0 - WFLXL(3,NU(NY,NX),NY,NX)=0.0 - ENDIF - ELSE - TFLX=0.0 - WFLXL(3,NU(NY,NX),NY,NX)=0.0 - ENDIF -C -C FREEZE-THAW IN SOIL SURFACE MACROPORE FROM NET CHANGE IN SOIL -C SURFACE HEAT STORAGE -C - IF((TK1(NU(NY,NX),NY,NX).LT.273.15.AND.VOLWH1(NU(NY,NX),NY,NX) - 2.GT.ZERO*VOLT(NU(NY,NX),NY,NX)).OR.(TK1(NU(NY,NX),NY,NX) - 3.GT.273.15.AND.VOLIH1(NU(NY,NX),NY,NX) - 4.GT.ZERO*VOLT(NU(NY,NX),NY,NX)))THEN - TFLX1=FMAC(NU(NY,NX),NY,NX)*(1.0/(1.0+273.15*6.2913E-03) - 2*(273.15*4.19*(FLWL(3,NU(NY,NX),NY,NX)+FLWHL(3,NU(NY,NX),NY,NX)) - 3+VHCP1(NU(NY,NX),NY,NX)*(273.15-TK1(NU(NY,NX),NY,NX)) - 4-HFLWL(3,NU(NY,NX),NY,NX))) - IF(TFLX1.LT.0.0)THEN - TFLXH=AMAX1(-333.0*0.92*VOLIH1(NU(NY,NX),NY,NX)*XNPH,TFLX1) - ELSE - TFLXH=AMIN1(333.0*VOLWH1(NU(NY,NX),NY,NX)*XNPH,TFLX1) - ENDIF - WFLXH=-TFLXH/333.0 - IF(WFLXH.GT.0.0.AND.VOLIH1(NU(NY,NX),NY,NX) - 2.GT.ZEROS(NY,NX))THEN - WFLXLH(3,NU(NY,NX),NY,NX)=WFLXH - ELSEIF(WFLXH.LT.0.0.AND.VOLWH1(NU(NY,NX),NY,NX) - 2.GT.ZEROS(NY,NX))THEN - WFLXLH(3,NU(NY,NX),NY,NX)=WFLXH - ELSE - TFLXH=0.0 - WFLXLH(3,NU(NY,NX),NY,NX)=0.0 - ENDIF - ELSE - TFLXH=0.0 - WFLXLH(3,NU(NY,NX),NY,NX)=0.0 - ENDIF - TFLXL(3,NU(NY,NX),NY,NX)=TFLX+TFLXH -C IF(NY.EQ.1)THEN -C WRITE(*,4358)'TFLX',I,J,M,TFREEZ,TK1(NU(NY,NX),NY,NX),PSISV1 -C 2,TFLX,TFLXH,TFLXL(3,NU(NY,NX),NY,NX),WFLX,WFLXH -C 2,WFLXL(3,NU(NY,NX),NY,NX),WFLXLH(3,NU(NY,NX),NY,NX) -C 4,VOLW1(NU(NY,NX),NY,NX),VOLWH1(NU(NY,NX),NY,NX) -C 4,VOLI1(NU(NY,NX),NY,NX),VOLIH1(NU(NY,NX),NY,NX) -C 5,FGRD(NU(NY,NX),NY,NX),FMAC(NU(NY,NX),NY,NX) -4358 FORMAT(A8,3I4,20E12.4) -C ENDIF -C -C -C THICKNESS OF WATER FILMS FOR GAS EXCHANGE IN 'TRNSFR' -C - IF(VHCPR1(NY,NX).GT.VHCPRX(NY,NX))THEN - FILM(M,0,NY,NX)=AMAX1(1.0E-06 - 2,EXP(-13.650-0.857*LOG(-PSISM1(0,NY,NX)))) - ELSE - FILM(M,0,NY,NX)=1.0E-03 - ENDIF -C IF(BKVL(NU(NY,NX),NY,NX).GT.0.0)THEN - FILM(M,NU(NY,NX),NY,NX)=AMAX1(1.0E-06 - 2,EXP(-13.650-0.857*LOG(-PSISM1(NU(NY,NX),NY,NX)))) -C ELSE -C FILM(M,NU(NY,NX),NY,NX)=DLYR(3,NU(NY,NX),NY,NX) -C ENDIF -C -C OVERLAND FLOW WHEN WATER STORAGE CAPACITY -C OF THE SOIL SURFACE PLUS MACROPORES IS EXCEEDED -C - N1=NX - N2=NY - TVOLZ1=AMAX1(0.0,VOLW1(0,N2,N1)+VOLI1(0,N2,N1)-VOLWRX(N2,N1)) - VOLWZ1=AMAX1(0.0,VOLW1(0,N2,N1)-VOLWRX(N2,N1)) -C -C LOCATE INTERNAL BOUNDARIES BETWEEN ADJACENT GRID CELLS -C - DO 4310 N=1,2 - IF(N.EQ.1)THEN - IF(NX.EQ.NHE)THEN - GO TO 4310 - ELSE - N4=NX+1 - N5=NY - WDTH=DLYR(2,NU(NY,NX),NY,NX) - ENDIF - ELSEIF(N.EQ.2)THEN - IF(NY.EQ.NVS)THEN - GO TO 4310 - ELSE - N4=NX - N5=NY+1 - WDTH=DLYR(1,NU(NY,NX),NY,NX) - ENDIF - ENDIF -C -C ELEVATION OF EACH PAIR OF ADJACENT GRID CELLS -C - TVOLZ2=AMAX1(0.0,VOLW1(0,N5,N4)+VOLI1(0,N5,N4)-VOLWRX(N5,N4)) - VOLWZ2=AMAX1(0.0,VOLW1(0,N5,N4)-VOLWRX(N5,N4)) - ALT1=ALTG(N2,N1)+TVOLZ1/AREA(3,NU(N2,N1),N2,N1) - ALT2=ALTG(N5,N4)+TVOLZ2/AREA(3,NU(N5,N4),N5,N4) -C -C EXCESS SURFACE WATER DEPTH, WETTED PERIMETER, SLOPE, VELOCITY -C - IF(ALT1.GT.ALT2.AND.TVOLZ1.GT.VOLWG(N2,N1))THEN - QRX1=TVOLZ1-VOLWG(N2,N1) - D=QRX1/AREA(3,NU(N2,N1),N2,N1) - R=D/2.828 - S=(ALT1-ALT2)/DIST(N,NU(N5,N4),N5,N4) - V=R**0.67*SQRT(S)/ZM(N2,N1) -C -C RUNOFF -C - Q=V*D*AMIN1(1.0,D/ZS(N2,N1))*WDTH*3.6E+03*XNPH - QRQ1=AMAX1(0.0,((ALT1-ALT2)*AREA(3,NU(N2,N1),N2,N1) - 2*AREA(3,NU(N5,N4),N5,N4)-TVOLZ2*AREA(3,NU(N2,N1),N2,N1) - 3+TVOLZ1*AREA(3,NU(N5,N4),N5,N4)) - 4/(AREA(3,NU(N2,N1),N2,N1)+AREA(3,NU(N5,N4),N5,N4))) - QR1(N,N5,N4)=AMIN1(Q,0.25*QRQ1,0.25*QRX1)*VOLWZ1/TVOLZ1 - HQR1(N,N5,N4)=4.19*TK1(0,N2,N1)*QR1(N,N5,N4) -C -C EXCESS SURFACE WATER DEPTH, WETTED PERIMETER, SLOPE, VELOCITY -C - ELSEIF(ALT1.LT.ALT2.AND.TVOLZ2.GT.VOLWG(N5,N4))THEN - QRX1=TVOLZ2-VOLWG(N5,N4) - D=QRX1/AREA(3,NU(N5,N4),N5,N4) - R=D/2.828 - S=(ALT2-ALT1)/DIST(N,NU(N5,N4),N5,N4) - V=R**0.67*SQRT(S)/ZM(N5,N4) -C -C RUNON -C - Q=V*D*AMIN1(1.0,D/ZS(N5,N4))*DLYR(N,NU(N5,N4),N5,N4) - 2*3.6E+03*XNPH - QRQ1=AMIN1(0.0,((ALT1-ALT2)*AREA(3,NU(N2,N1),N2,N1) - 2*AREA(3,NU(N5,N4),N5,N4)-TVOLZ2*AREA(3,NU(N2,N1),N2,N1) - 3+TVOLZ1*AREA(3,NU(N5,N4),N5,N4)) - 4/(AREA(3,NU(N2,N1),N2,N1)+AREA(3,NU(N5,N4),N5,N4))) - QR1(N,N5,N4)=AMAX1(-Q,0.25*QRQ1,-0.25*QRX1)*VOLWZ2/TVOLZ2 - HQR1(N,N5,N4)=4.19*TK1(0,N5,N4)*QR1(N,N5,N4) - ELSE - QR1(N,N5,N4)=0.0 - HQR1(N,N5,N4)=0.0 - V=0.0 - ENDIF - QR(N,N5,N4)=QR(N,N5,N4)+QR1(N,N5,N4) - HQR(N,N5,N4)=HQR(N,N5,N4)+HQR1(N,N5,N4) - QRM(M,N,N5,N4)=QR1(N,N5,N4) - QRV(M,N,N5,N4)=V -C IF(I.EQ.186)THEN -C WRITE(*,5555)'QR1',I,J,M,N1,N2,N4,N5,N,QR1(N,N5,N4) -C 2,ALT1,ALT2,ALTG(N2,N1),ALTG(N5,N4),QRX1,D,R,S,V,Q,QRQ1 -C 2,VOLW1(0,N2,N1),VOLI1(0,N2,N1) -C 3,VOLW1(0,N5,N4),VOLI1(0,N5,N4) -C 4,VOLWZ1,VOLWZ2,TVOLZ1,TVOLZ2,VOLWG(N2,N1),VOLWG(N5,N4) -C 5,QR(N,N5,N4),TVOLW(N5,N4),FVOLW2,FVOLH2 -C 6,DIST(N,NU(N5,N4),N5,N4) -5555 FORMAT(A8,8I4,30E12.4) -C ENDIF -C -C SNOW REDISTRIBUTION -C - ALTS1=ALTG(N2,N1)+DPTHS0(N2,N1) - ALTS2=ALTG(N5,N4)+DPTHS0(N5,N4) - SS=(ALTS1-ALTS2)/DIST(N,NU(N5,N4),N5,N4) - QSX=FQSM*SS/AMAX1(1.0,DIST(N,NU(N5,N4),N5,N4)**2) - IF(SS.GT.0.0.AND.DPTHS0(N2,N1).GT.DPTHSX)THEN - QS1(N,N5,N4)=QSX*VOLS0(N2,N1) - QW1(N,N5,N4)=QSX*VOLW0(N2,N1) - QI1(N,N5,N4)=QSX*VOLI0(N2,N1) - HQS1(N,N5,N4)=TK0(N2,N1)*(2.095*QS1(N,N5,N4) - 2+4.19*QW1(N,N5,N4)+1.9274*QI1(N,N5,N4)) - ELSEIF(SS.LT.0.0.AND.DPTHS0(N5,N4).GT.DPTHSX)THEN - QS1(N,N5,N4)=QSX*VOLS0(N5,N4) - QW1(N,N5,N4)=QSX*VOLW0(N5,N4) - QI1(N,N5,N4)=QSX*VOLI0(N5,N4) - HQS1(N,N5,N4)=TK0(N5,N4)*(2.095*QS1(N,N5,N4) - 2+4.19*QW1(N,N5,N4)+1.9274*QI1(N,N5,N4)) - ELSE - QS1(N,N5,N4)=0.0 - QW1(N,N5,N4)=0.0 - QI1(N,N5,N4)=0.0 - HQS1(N,N5,N4)=0.0 - ENDIF - QS(N,N5,N4)=QS(N,N5,N4)+QS1(N,N5,N4) - QW(N,N5,N4)=QW(N,N5,N4)+QW1(N,N5,N4) - QI(N,N5,N4)=QI(N,N5,N4)+QI1(N,N5,N4) - HQS(N,N5,N4)=HQS(N,N5,N4)+HQS1(N,N5,N4) - QSM(M,N,N5,N4)=QS1(N,N5,N4) -C IF(NX.EQ.2.AND.NY.EQ.5)THEN -C WRITE(*,5556)'QS1',I,J,M,N1,N2,N4,N5,N,QSX,QS1(N,N5,N4) -C 2,QW1(N,N5,N4),QI1(N,N5,N4),VOLS0(N2,N1),VOLW0(N2,N1) -C 3,VOLI0(N2,N1),ALTS1,ALTS2,ALTG(N2,N1),ALTG(N5,N4) -C 4,DIST(N,NU(N5,N4),N5,N4),SS,DPTHS0(N2,N1),DPTHS0(N5,N4) -C 5,VOLS1(N2,N1),VOLS1(N5,N4),VOLWG(N2,N1),VOLWG(N5,N4) -5556 FORMAT(A8,8I4,30E12.4) -C ENDIF -4310 CONTINUE -C -C TOTAL WATER, VAPOR AND HEAT FLUXES THROUGH SURFACE RESIDUE -C AND SOIL SURFACE -C - THAWR(NY,NX)=THAWR(NY,NX)+WFLXR(NY,NX) - HTHAWR(NY,NX)=HTHAWR(NY,NX)+TFLXR(NY,NX) - THAW(3,NU(NY,NX),NY,NX)=THAW(3,NU(NY,NX),NY,NX) - 2+WFLXL(3,NU(NY,NX),NY,NX) - THAWH(3,NU(NY,NX),NY,NX)=THAWH(3,NU(NY,NX),NY,NX) - 2+WFLXLH(3,NU(NY,NX),NY,NX) - HTHAW(3,NU(NY,NX),NY,NX)=HTHAW(3,NU(NY,NX),NY,NX) - 2+TFLXL(3,NU(NY,NX),NY,NX) - FLW(3,NU(NY,NX),NY,NX)=FLW(3,NU(NY,NX),NY,NX) - 2+FLWL(3,NU(NY,NX),NY,NX) - FLWX(3,NU(NY,NX),NY,NX)=FLWX(3,NU(NY,NX),NY,NX) - 2+FLWLX(3,NU(NY,NX),NY,NX) - FLWH(3,NU(NY,NX),NY,NX)=FLWH(3,NU(NY,NX),NY,NX) - 2+FLWHL(3,NU(NY,NX),NY,NX) - HFLW(3,NU(NY,NX),NY,NX)=HFLW(3,NU(NY,NX),NY,NX) - 2+HFLWL(3,NU(NY,NX),NY,NX) - FLWR(NY,NX)=FLWR(NY,NX)+FLWRL(NY,NX) - HFLWR(NY,NX)=HFLWR(NY,NX)+HFLWRL(NY,NX) - HEATI(NY,NX)=HEATI(NY,NX)+RFLX+RFLXR - HEATS(NY,NX)=HEATS(NY,NX)+SFLX+SFLXR - HEATE(NY,NX)=HEATE(NY,NX)+EFLX+EFLXR - HEATV(NY,NX)=HEATV(NY,NX)+VFLX+VFLXR - HEATH(NY,NX)=HEATH(NY,NX)+RFLX+RFLXR - 2+SFLX+SFLXR+EFLX+EFLXR+VFLX+VFLXR - TEVAPG(NY,NX)=TEVAPG(NY,NX)+EVAP(NY,NX)+EVAPS(NY,NX)+EVAPR(NY,NX) - VOLWX1(NU(NY,NX),NY,NX)=VOLW1(NU(NY,NX),NY,NX) - HYSM(M,NU(NY,NX),NY,NX)=HYST(NU(NY,NX),NY,NX) - FLWM(M,3,NU(NY,NX),NY,NX)=FLWL(3,NU(NY,NX),NY,NX) - FLWHM(M,3,NU(NY,NX),NY,NX)=FLWHL(3,NU(NY,NX),NY,NX) -C -C DELAYED MIGRATION OF PRECIPITATION OR MELTWATER INTO MICROPORES -C - IF(FLQM.GT.0.0.AND.VOLPX1(NU(NY,NX),NY,NX).GT.ZEROS(NY,NX) - 2.AND.HYST(NU(NY,NX),NY,NX).GT.ZERO)THEN - HYST(NU(NY,NX),NY,NX)=AMIN1(1.0,AMAX1(0.0,HYST(NU(NY,NX),NY,NX) - 2-FLQM/VOLPX1(NU(NY,NX),NY,NX))) - ENDIF - HYST(NU(NY,NX),NY,NX)=HYST(NU(NY,NX),NY,NX) - 2+(1.0-HYST(NU(NY,NX),NY,NX))*HYSTX -C -C INFILTRATION OF WATER FROM MACROPORES INTO MICROPORES -C - IF(VOLWH1(NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN - FINHX=XNPH*6.283*HCND(2,1,NU(NY,NX),NY,NX)*AREA(3,NU(NY,NX),NY,NX) - 2*(PSISE(NU(NY,NX),NY,NX)-PSISM1(NU(NY,NX),NY,NX)) - 3/LOG(PHOL(NU(NY,NX),NY,NX)/HRAD(NU(NY,NX),NY,NX)) - IF(FINHX.GT.0.0)THEN - FINHL(NU(NY,NX),NY,NX)=AMAX1(0.0,AMIN1(FINHX - 2,XNPH*VOLWH1(NU(NY,NX),NY,NX),VOLPX1(NU(NY,NX),NY,NX))) - ELSE - FINHL(NU(NY,NX),NY,NX)=AMIN1(0.0,AMAX1(FINHX - 2,-VOLPH1(NU(NY,NX),NY,NX),-XNPH*VOLW1(NU(NY,NX),NY,NX))) - ENDIF - FINHM(M,NU(NY,NX),NY,NX)=FINHL(NU(NY,NX),NY,NX) - FINH(NU(NY,NX),NY,NX)=FINH(NU(NY,NX),NY,NX)+FINHL(NU(NY,NX),NY,NX) -C IF(J.EQ.12.AND.M.EQ.1)THEN -C WRITE(*,3367)'HOLE',I,J,M,NX,NY -C 2,FINHL(NU(NY,NX),NY,NX),FINHX -C 2,VOLWH1(NU(NY,NX),NY,NX),VOLPH1(NU(NY,NX),NY,NX) -C 3,VOLAH1(NU(NY,NX),NY,NX),PSISE(NU(NY,NX),NY,NX) -C 4,PSISM1(NU(NY,NX),NY,NX),VOLW1(NU(NY,NX),NY,NX) -C 5,HCND(2,1,NU(NY,NX),NY,NX),PHOL(NU(NY,NX),NY,NX) -C 5,HRAD(NU(NY,NX),NY,NX) -3367 FORMAT(A8,5I4,20E12.4) -C ENDIF - ELSE - FINHM(M,NU(NY,NX),NY,NX)=0.0 - FINHL(NU(NY,NX),NY,NX)=0.0 - ENDIF -C -C WATER AND ENERGY TRANSFER THROUGH SOIL PROFILE -C - IFLGH=0 - DO 4400 L=1,NL(NY,NX) -C -C CALCULATE CHANGE IN THICKNESS OF ICE LAYER -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 -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) -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 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) -C 3,CDPTH(L,NY,NX),DPTH(L,NY,NX),YDPTH(L,NY,NX),DLYR(3,L,NY,NX) -C 4,VOLP1(L,NY,NX) -910 FORMAT(A8,5I4,12E16.8) -C ENDIF - ENDIF - ENDIF -C -C END THICKNESS -C - N1=NX - N2=NY - N3=L -C -C LOCATE INTERNAL BOUNDARIES BETWEEN ADJACENT GRID CELLS -C - DO 4320 N=NCN(N2,N1),3 - IF(N.EQ.1)THEN - IF(NX.EQ.NHE)THEN - GO TO 4320 - ELSE - N4=NX+1 - N5=NY - N6=L -C -C ARTIFICIAL SOIL WARMING – PREVENT LATERAL FLOW -C -C IF(N2.EQ.2.AND.(N1.EQ.2.OR.N1.EQ.3).AND.L.LE.15)THEN -C GO TO 4320 -C ENDIF - ENDIF - ELSEIF(N.EQ.2)THEN - IF(NY.EQ.NVS)THEN - GO TO 4320 - ELSE - N4=NX - N5=NY+1 - N6=L -C -C ARTIFICIAL SOIL WARMING – PREVENT LATERAL FLOW -C -C IF(N1.EQ.3.AND.(N2.EQ.1.OR.N2.EQ.2).AND.L.LE.15)THEN -C GO TO 4320 -C ENDIF - ENDIF - ELSEIF(N.EQ.3)THEN - IF(L.EQ.NL(NY,NX))THEN - GO TO 4320 - ELSE - N4=NX - N5=NY - N6=L+1 - ENDIF - ENDIF -C -C POROSITIES 'THETP*', WATER CONTENTS 'THETA*', AND POTENTIALS -C 'PSIS*' FOR EACH GRID CELL -C - IF(N3.GE.NU(N2,N1).AND.N6.GE.NU(N5,N4) - 2.AND.N3.LE.NL(N2,N1).AND.N6.LE.NL(N5,N4))THEN - THETP1=AMAX1(0.0,VOLPX1(N3,N2,N1)/VOLX(N3,N2,N1)) - THETPL=AMAX1(0.0,VOLPX1(N6,N5,N4)/VOLX(N6,N5,N4)) - THETA1=AMAX1(THETY(N3,N2,N1),AMIN1(POROS(N3,N2,N1) - 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 - IF(THETA1.LT.FC(N3,N2,N1))THEN - PSISA1=AMAX1(HYGR,-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 - PSISA1=-EXP(PSIMS(N2,N1) - 2+(((PSL(N3,N2,N1)-LOG(THETA1)) - 3/PSD(N3,N2,N1))**SRP(N3,N2,N1)*PSISD(N2,N1))) - ELSE - PSISA1=PSISE(N3,N2,N1) - ENDIF -C ELSE -C PSISA1=PSISE(N3,N2,N1) -C ENDIF -C IF(BKVL(N6,N5,N4).GT.0.0)THEN - IF(THETAL.LT.FC(N6,N5,N4))THEN - PSISAL=AMAX1(HYGR,-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 - PSISAL=-EXP(PSIMS(N5,N4) - 2+(((PSL(N6,N5,N4)-LOG(THETAL)) - 3/PSD(N6,N5,N4))**SRP(N6,N5,N4)*PSISD(N5,N4))) - ELSE - PSISAL=PSISE(N6,N5,N4) - ENDIF -C ELSE -C PSISAL=PSISE(N6,N5,N4) -C ENDIF -C IF(J.GE.20)THEN -C WRITE(*,7272)'PSIM',I,J,N1,N2,N3,N4,N5,N6,M,PSISM1(N6,N5,N4) -C 2,PSIMX(N5,N4),FCL(N6,N5,N4),THETWL,FCD(N6,N5,N4),PSIMD(N5,N4) -C 3,POROS(N6,N5,N4),PSIMS(N5,N4),PSL(N6,N5,N4),PSD(N6,N5,N4) -C 4,SRP(N6,N5,N4),PSISD(N5,N4),THETAL,PSISE(N6,N5,N4) -C 5,THETAL-POROS(N6,N5,N4),PSISA1,PSISAL -7272 FORMAT(A8,9I4,20E12.4) -C ENDIF -C -C DARCY FLOW IF BOTH CELLS ARE SATURATED -C (CURRENT WATER POTENTIAL > AIR ENTRY WATER POTENTIAL) -C - IF(PSISA1.GT.PSISA(N3,N2,N1) - 2.AND.PSISAL.GT.PSISA(N6,N5,N4))THEN - THETW1=THETA1 - THETWL=THETAL - CND1=HCND(N,1,N3,N2,N1)*XNPH - CNDL=HCND(N,1,N6,N5,N4)*XNPH - PSISM1(N3,N2,N1)=PSISA1 - PSISM1(N6,N5,N4)=PSISAL - IF(PSISM1(N3,N2,N1).GE.PSISM1(N6,N5,N4) - 2.AND.VOLW1(N3,N2,N1).GT.ZEROS(N2,N1))THEN - FLGX=VOLWX1(N3,N2,N1)/VOLW1(N3,N2,N1) - ELSEIF(VOLW1(N6,N5,N4).GT.ZEROS(N5,N4))THEN - FLGX=VOLWX1(N6,N5,N4)/VOLW1(N6,N5,N4) - ELSE - FLGX=0.0 - ENDIF -C -C GREEN-AMPT FLOW IF ONE LAYER IS SATURATED -C (CURRENT WATER POTENTIAL < AIR ENTRY WATER POENTIAL) -C -C -C GREEN-AMPT FLOW IF SOURCE CELL SATURATED -C - ELSEIF(PSISA1.GT.PSISA(N3,N2,N1))THEN - THETW1=THETA1 - THETWL=AMAX1(THETY(N6,N5,N4),AMIN1(POROS(N6,N5,N4) - 2,VOLWX1(N6,N5,N4)/VOLX(N6,N5,N4))) - 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 - IF(THETWL.LT.FC(N6,N5,N4))THEN - PSISM1(N6,N5,N4)=AMAX1(HYGR,-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 - PSISM1(N6,N5,N4)=-EXP(PSIMS(N5,N4) - 2+(((PSL(N6,N5,N4)-LOG(THETWL)) - 3/PSD(N6,N5,N4))**SRP(N6,N5,N4)*PSISD(N5,N4))) - ELSE - PSISM1(N6,N5,N4)=PSISE(N6,N5,N4) - ENDIF -C ELSE -C PSISM1(N6,N5,N4)=PSISE(N6,N5,N4) -C ENDIF - FLGX=0.0 -C -C GREEN-AMPT FLOW IF ADJACENT CELL SATURATED -C - ELSEIF(PSISAL.GT.PSISA(N6,N5,N4))THEN - THETW1=AMAX1(THETY(N3,N2,N1),AMIN1(POROS(N3,N2,N1) - 2,VOLWX1(N3,N2,N1)/VOLX(N3,N2,N1))) - 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 - IF(THETW1.LT.FC(N3,N2,N1))THEN - PSISM1(N3,N2,N1)=AMAX1(HYGR,-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 - PSISM1(N3,N2,N1)=-EXP(PSIMS(N2,N1) - 2+(((PSL(N3,N2,N1)-LOG(THETW1)) - 3/PSD(N3,N2,N1))**SRP(N3,N2,N1)*PSISD(N2,N1))) - ELSE - PSISM1(N3,N2,N1)=PSISE(N3,N2,N1) - ENDIF -C ELSE -C PSISM1(N3,N2,N1)=PSISE(N3,N2,N1) -C ENDIF - FLGX=0.0 -C -C RICHARDS FLOW IF NEITHER CELL IS SATURATED -C (CURRENT WATER POTENTIAL < AIR ENTRY WATER POTENTIAL) -C - ELSE - THETW1=THETA1 - THETWL=THETAL - K1=MAX(1,MIN(100,INT(100.0*(POROS(N3,N2,N1)-THETA1) - 2/POROS(N3,N2,N1))+1)) - CND1=HCND(N,K1,N3,N2,N1)*XNPH - KL=MAX(1,MIN(100,INT(100.0*(POROS(N6,N5,N4)-THETAL) - 2/POROS(N6,N5,N4))+1)) - CNDL=HCND(N,KL,N6,N5,N4)*XNPH - PSISM1(N3,N2,N1)=PSISA1 - PSISM1(N6,N5,N4)=PSISAL - IF(PSISM1(N3,N2,N1).GE.PSISM1(N6,N5,N4) - 2.AND.VOLW1(N3,N2,N1).GT.ZEROS(N2,N1))THEN - FLGX=VOLWX1(N3,N2,N1)/VOLW1(N3,N2,N1) - ELSEIF(VOLW1(N6,N5,N4).GT.ZEROS(N5,N4))THEN - FLGX=VOLWX1(N6,N5,N4)/VOLW1(N6,N5,N4) - ELSE - FLGX=0.0 - ENDIF - ENDIF -C -C TOTAL SOIL WATER POTENTIAL = MATRIC, GRAVIMETRIC + OSMOTIC -C - PSIST1=PSISM1(N3,N2,N1)+PSISH(N3,N2,N1)+0.03*PSISO(N3,N2,N1) - PSISTL=PSISM1(N6,N5,N4)+PSISH(N6,N5,N4)+0.03*PSISO(N6,N5,N4) - PSISV1=PSISM1(N3,N2,N1)+PSISO(N3,N2,N1) - PSISVL=PSISM1(N6,N5,N4)+PSISO(N6,N5,N4) -C -C HYDRAULIC CONDUCTIVITY FROM CURRENT WATER CONTENT -C AND LOOKUP ARRAY GENERATED IN 'HOUR1' -C - IF(CND1.GT.ZERO.AND.CNDL.GT.ZERO)THEN - AVCNDL=2.0*CND1*CNDL/(CND1*DLYR(N,N6,N5,N4) - 2+CNDL*DLYR(N,N3,N2,N1)) - ELSE - AVCNDL=0.0 - ENDIF -C -C WATER FLUX FROM WATER POTENTIALS, HYDRAULIC CONDUCTIVITY -C CONSTRAINED BY WATER POTENTIAL GRADIENT, COUPLED WITH -C CONVECTIVE HEAT FLUX FROM WATER FLUX -C - FLQX=AVCNDL*(PSIST1-PSISTL)*AREA(N,N3,N2,N1) - IF(FLQX.GE.0.0)THEN - FLQL=AMAX1(0.0,AMIN1(FLQX,VOLW1(N3,N2,N1)*XNPH)) - FLQL=AMIN1(FLQL,VOLP1(N6,N5,N4)*XNPH) - HWFLQL=4.19*TK1(N3,N2,N1)*FLQL - ELSE - FLQL=AMIN1(0.0,AMAX1(FLQX,-VOLW1(N6,N5,N4)*XNPH)) - FLQL=AMAX1(FLQL,-VOLP1(N3,N2,N1)*XNPH) - HWFLQL=4.19*TK1(N6,N5,N4)*FLQL - ENDIF - FLQ2=FLGX*FLQL -C -C INFILTRATION OF WATER FROM MACROPORES INTO MICROPORES -C - IF(N.EQ.3.AND.VOLWH1(N6,N5,N4).GT.ZEROS(N5,N4))THEN - FINHX=XNPH*6.283*HCND(2,1,N6,N5,N4)*AREA(3,N6,N5,N4) - 2*(PSISE(N6,N5,N4)-PSISM1(N6,N5,N4)) - 3/LOG(PHOL(N6,N5,N4)/HRAD(N6,N5,N4)) - IF(FINHX.GT.0.0)THEN - FINHL(N6,N5,N4)=AMAX1(0.0,AMIN1(FINHX,XNPH*VOLWH1(N6,N5,N4) - 2,VOLPX1(N6,N5,N4))) - ELSE - FINHL(N6,N5,N4)=AMIN1(0.0,AMAX1(FINHX,-VOLPH1(N6,N5,N4) - 2,-XNPH*VOLW1(N6,N5,N4))) - ENDIF - FINHM(M,N6,N5,N4)=FINHL(N6,N5,N4) - FINH(N6,N5,N4)=FINH(N6,N5,N4)+FINHL(N6,N5,N4) -C IF(NX.EQ.1.AND.NY.EQ.1)THEN -C WRITE(*,3366)'FINHL',I,J,M,N4,N5,N6,IFLGH,FINHL(N6,N5,N4) -C 3,FINHX,VOLWH1(N6,N5,N4),VOLPH1(N6,N5,N4),VOLP1(N6,N5,N4) -C 4,PSISM1(N6,N5,N4),HCND(2,1,N6,N5,N4),PHOL(N6,N5,N4) -C 5,HRAD(N6,N5,N4) -3366 FORMAT(A8,7I4,20E12.4) -C ENDIF - ELSE - FINHL(N6,N5,N4)=0.0 - FINHM(M,N6,N5,N4)=0.0 - ENDIF -C -C MACROPORE FLOW FROM POISEUILLE FLOW IF MACROPORES PRESENT -C - IF(VOLAH1(N3,N2,N1).GT.ZEROS(N2,N1) - 2.AND.VOLAH1(N6,N5,N4).GT.ZEROS(N5,N4).AND.IFLGH.EQ.0)THEN - PSISH1=PSISH(N3,N2,N1)+0.0098*DLYR(3,N3,N2,N1) - 2*(AMIN1(1.0,AMAX1(0.0,VOLWH1(N3,N2,N1)/VOLAH1(N3,N2,N1)))-0.5) - PSISHL=PSISH(N6,N5,N4)+0.0098*DLYR(3,N6,N5,N4) - 2*(AMIN1(1.0,AMAX1(0.0,VOLWH1(N6,N5,N4)/VOLAH1(N6,N5,N4)))-0.5) - FLWHX=AVCNHL(N,N6,N5,N4)*(PSISH1-PSISHL)*AREA(N,N3,N2,N1) -C -C MACROPORE FLOW IF GRAVITATIONAL GRADIENT IS POSITIVE -C AND MACROPORE POROSITY EXISTS IN ADJACENT CELL -C - IF(N.NE.3)THEN - IF(PSISH1.GT.PSISHL)THEN - FLWHL(N,N6,N5,N4)=AMAX1(0.0,AMIN1(AMIN1(VOLWH1(N3,N2,N1) - 2,VOLPH1(N6,N5,N4))*0.5*XDIM,FLWHX)) - ELSEIF(PSISH1.LT.PSISHL)THEN - FLWHL(N,N6,N5,N4)=AMIN1(0.0,AMAX1(AMAX1(-VOLWH1(N6,N5,N4) - 2,-VOLPH1(N3,N2,N1))*0.5*XDIM,FLWHX)) - ELSE - FLWHL(N,N6,N5,N4)=0.0 - ENDIF - ELSE - FLWHL(N,N6,N5,N4)=AMAX1(0.0,AMIN1(AMIN1(VOLWH1(N3,N2,N1) - 2+FLWHL(N,N3,N2,N1)-FINHL(N3,N2,N1) - 3,VOLPH1(N6,N5,N4))*XDIM,FLWHX)) - ENDIF - FLWHM(M,N,N6,N5,N4)=FLWHL(N,N6,N5,N4) -C IF(N4.EQ.1)THEN -C WRITE(*,5478)'FLWH',I,J,M,N1,N2,N3,IFLGH -C 2,FINHL(N3,N2,N1),FLHM,FLWHX,FLWHL(N,N3,N2,N1),FLWHL(N,N6,N5,N4) -C 2,AVCNHL(N,N6,N5,N4),PSISH(N3,N2,N1),PSISH(N6,N5,N4) -C 3,VOLPH1(N3,N2,N1),VOLPH1(N6,N5,N4),VOLWH1(N3,N2,N1) -C 4,VOLWH1(N6,N5,N4),VOLAH1(N3,N2,N1),VOLAH1(N6,N5,N4) -C 5,DLYR(N,N6,N5,N4),DLYR(N,N3,N2,N1),AREA(N,N3,N2,N1) -C 7,CNDH1(N3,N2,N1),CNDH1(N6,N5,N4),XNPH,XDIM,HWFLHL -5478 FORMAT(A8,7I4,30E12.4) -C ENDIF - ELSE - FLWHL(N,N6,N5,N4)=0.0 - FLWHM(M,N,N6,N5,N4)=0.0 - IF(VOLPH1(N6,N5,N4).LE.0.0)IFLGH=1 - ENDIF -C -C CONVECTIVE HEAT FLOW FROM MACROPORE FLOW -C - IF(FLWHL(N,N6,N5,N4).GT.0.0)THEN - HWFLHL=4.19*TK1(N3,N2,N1)*FLWHL(N,N6,N5,N4) - ELSE - HWFLHL=4.19*TK1(N6,N5,N4)*FLWHL(N,N6,N5,N4) - ENDIF -C -C VAPOR PRESSURE AND DIFFUSIVITY IN EACH GRID CELL -C - TK11=TK1(N3,N2,N1) - TK12=TK1(N6,N5,N4) - VP1=2.173E-03/TK11 - 2*0.61*EXP(5360.0*(3.661E-03-1.0/TK11)) - 3*EXP(18.0*PSISV1/(8.3143*TK11)) - VPL=2.173E-03/TK12 - 2*0.61*EXP(5360.0*(3.661E-03-1.0/TK12)) - 3*EXP(18.0*PSISVL/(8.3143*TK12)) - CNV1=THETP1**2/POROQ(N3,N2,N1)*WGSG1(N3,N2,N1) - CNVL=THETPL**2/POROQ(N6,N5,N4)*WGSG1(N6,N5,N4) - IF(CNV1.GT.ZERO.AND.CNVL.GT.ZERO)THEN - AVCNVL=2.0*CNV1*CNVL - 2/(CNV1*DLYR(N,N6,N5,N4)+CNVL*DLYR(N,N3,N2,N1)) - ELSE - AVCNVL=0.0 - ENDIF -C -C VAPOR FLUX FROM VAPOR PRESSURE AND DIFFUSIVITY, -C AND CONVECTIVE HEAT FLUX FROM VAPOR FLUX -C - TKY=(VHCP1(N3,N2,N1)*TK1(N3,N2,N1)+VHCP1(N6,N5,N4)*TK1(N6,N5,N4)) - 2/(VHCP1(N3,N2,N1)+VHCP1(N6,N5,N4)) - HFLWX=(TKY-TK1(N6,N5,N4))*VHCP1(N6,N5,N4)*FHFLX*XDIM - FLVX=AVCNVL*(VP1-VPL)*AREA(N,N3,N2,N1) - IF(FLVX.GE.0.0)THEN - FLVL=AMIN1(FLVX,VOLW1(N3,N2,N1)*XNPH) - IF(HFLWX.GE.0.0)THEN - FLVL=AMIN1(FLVL,HFLWX/(4.19*TK1(N3,N2,N1)+VAP)) - ENDIF - HWFLVL=(4.19*TK1(N3,N2,N1)+VAP)*FLVL - ELSE - FLVL=AMAX1(FLVX,-VOLW1(N6,N5,N4)*XNPH) - IF(HFLWX.LT.0.0)THEN - FLVL=AMAX1(FLVL,HFLWX/(4.19*TK1(N6,N5,N4)+VAP)) - ENDIF - HWFLVL=(4.19*TK1(N6,N5,N4)+VAP)*FLVL - ENDIF - 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 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 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 ENDIF -C -C THERMAL CONDUCTIVITY -C - DTKX=ABS(TK1(N3,N2,N1)-TK1(N6,N5,N4))*1.0E-06 - DTHW1=AMAX1(0.0,THETWX(N3,N2,N1)-TRBW)**3 - DTHA1=AMAX1(0.0,THETPX(N3,N2,N1)-TRBA)**3 - DTHW2=AMAX1(0.0,THETWX(N6,N5,N4)-TRBW)**3 - DTHA2=AMAX1(0.0,THETPX(N6,N5,N4)-TRBA)**3 - RYLXW1=DTKX*DTHW1 - RYLXA1=DTKX*DTHA1 - RYLXW2=DTKX*DTHW2 - RYLXA2=DTKX*DTHA2 - RYLNW1=AMIN1(1.0E+04,RYLXW*RYLXW1) - RYLNA1=AMIN1(1.0E+04,RYLXA*RYLXA1) - RYLNW2=AMIN1(1.0E+04,RYLXW*RYLXW2) - RYLNA2=AMIN1(1.0E+04,RYLXA*RYLXA2) - XNUSW1=AMAX1(1.0,0.68+0.67*RYLNW1**0.25/DNUSW) - XNUSA1=AMAX1(1.0,0.68+0.67*RYLNA1**0.25/DNUSA) - XNUSW2=AMAX1(1.0,0.68+0.67*RYLNW2**0.25/DNUSW) - XNUSA2=AMAX1(1.0,0.68+0.67*RYLNA2**0.25/DNUSA) - TCNDW1=2.067E-03*XNUSW1 - TCNDA1=9.050E-05*XNUSA1 - TCNDW2=2.067E-03*XNUSW2 - TCNDA2=9.050E-05*XNUSA2 - WTHET1=1.467-0.467*THETPY(N3,N2,N1) - TCND1=(STC(N3,N2,N1)+THETWX(N3,N2,N1)*TCNDW1 - 2+0.611*THETIX(N3,N2,N1)*7.844E-03 - 3+WTHET1*THETPX(N3,N2,N1)*TCNDA1) - 4/(DTC(N3,N2,N1)+THETWX(N3,N2,N1)+0.611*THETIX(N3,N2,N1) - 5+WTHET1*THETPX(N3,N2,N1)) - WTHET2=1.467-0.467*THETPY(N6,N5,N4) - TCND2=(STC(N6,N5,N4)+THETWX(N6,N5,N4)*TCNDW2 - 2+0.611*THETIX(N6,N5,N4)*7.844E-03 - 3+WTHET2*THETPX(N6,N5,N4)*TCNDA2) - 4/(DTC(N6,N5,N4)+THETWX(N6,N5,N4)+0.611*THETIX(N6,N5,N4) - 5+WTHET2*THETPX(N6,N5,N4)) - ATCND1=(2.0*TCND1*TCND2)/(TCND1*DLYR(N,N6,N5,N4) - 3+TCND2*DLYR(N,N3,N2,N1))*XNPH -C -C HEAT FLOW FROM THERMAL CONDUCTIVITY AND TEMPERATURE GRADIENT -C - TK1X=TK1(N3,N2,N1)-HWFLVL/VHCP1(N3,N2,N1) - TKLX=TK1(N6,N5,N4)+HWFLVL/VHCP1(N6,N5,N4) - TKY=(VHCP1(N3,N2,N1)*TK1X+VHCP1(N6,N5,N4)*TKLX) - 2/(VHCP1(N3,N2,N1)+VHCP1(N6,N5,N4)) - HFLWX=(TKY-TKLX)*VHCP1(N6,N5,N4)*FHFLX*XDIM - HFLWC=ATCND1*(TK1X-TKLX)*AREA(N,N3,N2,N1) - IF(HFLWC.GE.0.0)THEN - HFLWC=AMAX1(0.0,AMIN1(HFLWC,HFLWX)) - ELSE - HFLWC=AMIN1(0.0,AMAX1(HFLWC,HFLWX)) - ENDIF - HFLWL(N,N6,N5,N4)=HWFLWL+HWFLHL+HFLWC -C IF((I/10)*10.EQ.I.AND.N5.EQ.2.AND.J.EQ.15.AND.N.EQ.3)THEN -C WRITE(*,8765)'HFLWL',I,J,N4,N5,N6,N,M,HFLWL(N,N6,N5,N4) -C 2,TCND1,TCND2,ATCND1,DTKX,DTHP1,DTHP2,THETPX(N3,N2,N1) -C 3,THETPX(N6,N5,N4),RYLNA1,RYLNA2,DNUSA,XNUSA1,XNUSA2 -C 4,TCNDA1,TCNDA2,RYLNW1,RYLNW2,DNUSW,XNUSW1,XNUSW2 -C 5,TCNDW1,TCNDW2 -8765 FORMAT(A8,7I4,60E12.4) -C ENDIF -C -C MOVE WATER UP DURING PRECIPITATION OR FREEZING -C - IF(N.EQ.3)THEN - IF(VOLW1(N6,N5,N4)+VOLI1(N6,N5,N4).GT.VOLA(N6,N5,N4))THEN - FLWLY=AMIN1(0.0,AMAX1(-XNPH*VOLW1(N6,N5,N4) - 2,VOLA(N6,N5,N4)-VOLW1(N6,N5,N4)-VOLI1(N6,N5,N4))) - FLWLY=AMAX1(FLWLY,-VOLP1(N3,N2,N1)) - HFLWLY=FLWLY*4.19*TK1(N6,N5,N4) - FLWL(N,N6,N5,N4)=FLWL(N,N6,N5,N4)+FLWLY - HFLWL(N,N6,N5,N4)=HFLWL(N,N6,N5,N4)+HFLWLY - ENDIF - IF(VOLWH1(N6,N5,N4)+VOLIH1(N6,N5,N4).GT.VOLAH1(N6,N5,N4))THEN - FLWHY=AMIN1(0.0,AMAX1(-XNPH*VOLWH1(N6,N5,N4),-VOLPH1(N3,N2,N1) - 2,VOLAH1(N6,N5,N4)-VOLWH1(N6,N5,N4)-VOLIH1(N6,N5,N4))) - HFLWHY=FLWHY*4.19*TK1(N6,N5,N4) - FLWHL(N,N6,N5,N4)=FLWHL(N,N6,N5,N4)+FLWHY - HFLWL(N,N6,N5,N4)=HFLWL(N,N6,N5,N4)+HFLWHY - ENDIF - IF(PSISAL.GT.PSISA(N6,N5,N4))THEN - FLWVL(N6,N5,N4)=VOLW1(N6,N5,N4)-VOLWX1(N6,N5,N4) - ELSE - FLWVL(N6,N5,N4)=RFLWV(N5,N4)*(VOLW1(N6,N5,N4)-VOLWX1(N6,N5,N4)) - ENDIF - FLWV(N6,N5,N4)=FLWV(N6,N5,N4)+FLWVL(N6,N5,N4) - ENDIF -C -C FREEZE-THAW IN SOIL LAYER MICROPORE FROM NET CHANGE IN SOIL -C LAYER HEAT STORAGE -C - IF(N.EQ.3)THEN - TFREEZ=-9.0959E+04/(PSISVL-333.0) - IF((TK1(N6,N5,N4).LT.TFREEZ - 2.AND.VOLW1(N6,N5,N4).GT.ZERO*VOLA(N6,N5,N4) - 3.AND.VOLI1(N6,N5,N4).LT.VOLA(N6,N5,N4)) - 4.OR.(TK1(N6,N5,N4).GT.TFREEZ - 5.AND.VOLI1(N6,N5,N4).GT.ZERO*VOLT(N6,N5,N4)))THEN - TFLX1=FGRD(N6,N5,N4)*(1.0/(1.0+TFREEZ*6.2913E-03) - 2*(TFREEZ*4.19*(FLWL(N,N6,N5,N4)+FLWHL(N,N6,N5,N4)) - 2+VHCP1(N6,N5,N4)*(TFREEZ-TK1(N6,N5,N4)) - 3-HFLWL(N,N6,N5,N4))) - IF(TFLX1.LT.0.0)THEN - TFLX=AMAX1(-333.0*0.92*VOLI1(N6,N5,N4)*XNPH,TFLX1) - ELSE - TFLX=AMIN1(333.0*VOLW1(N6,N5,N4)*XNPH,TFLX1) - ENDIF - WFLX=-TFLX/333.0 - IF(WFLX.GT.0.0.AND.VOLI1(N6,N5,N4).GT.ZEROS(N5,N4))THEN - WFLXL(N,N6,N5,N4)=WFLX - ELSEIF(WFLX.LT.0.0.AND.VOLW1(N6,N5,N4).GT.ZEROS(N5,N4))THEN - WFLXL(N,N6,N5,N4)=WFLX - ELSE - TFLX=0.0 - WFLXL(N,N6,N5,N4)=0.0 - ENDIF - ELSE - TFLX=0.0 - WFLXL(N,N6,N5,N4)=0.0 - ENDIF -C -C FREEZE-THAW IN SOIL LAYER MACROPORE FROM NET CHANGE IN SOIL -C LAYER HEAT STORAGE -C - IF((TK1(N6,N5,N4).LT.273.15.AND.VOLWH1(N6,N5,N4) - 2.GT.ZERO*VOLT(N6,N5,N4)).OR.(TK1(N6,N5,N4).GT.273.15 - 3.AND.VOLIH1(N6,N5,N4).GT.ZERO*VOLT(N6,N5,N4)))THEN - TFLX1=FMAC(N6,N5,N4)*(1.0/(1.0+273.15*6.2913E-03) - 2*(273.15*4.19*(FLWL(N,N6,N5,N4)+FLWHL(N,N6,N5,N4)) - 2+VHCP1(N6,N5,N4)*(273.15-TK1(N6,N5,N4)) - 3-HFLWL(N,N6,N5,N4))) - IF(TFLX1.LT.0.0)THEN - TFLXH=AMAX1(-333.0*0.92*VOLIH1(N6,N5,N4)*XNPH,TFLX1) - ELSE - TFLXH=AMIN1(333.0*VOLWH1(N6,N5,N4)*XNPH,TFLX1) - ENDIF - WFLXH=-TFLXH/333.0 - IF(WFLXH.GT.0.0.AND.VOLIH1(N6,N5,N4).GT.ZEROS(N5,N4))THEN - WFLXLH(N,N6,N5,N4)=WFLXH - ELSEIF(WFLXH.LT.0.0.AND.VOLWH1(N6,N5,N4).GT.ZEROS(N5,N4))THEN - WFLXLH(N,N6,N5,N4)=WFLXH - ELSE - TFLXH=0.0 - WFLXLH(N,N6,N5,N4)=0.0 - ENDIF - ELSE - TFLXH=0.0 - WFLXLH(N,N6,N5,N4)=0.0 - ENDIF - TFLXL(N,N6,N5,N4)=TFLX+TFLXH -C IF(NY.EQ.1)THEN -C WRITE(*,4359)'TFLX',I,J,M,N4,N5,N6,TFREEZ,TK1(N6,N5,N4),PSISVL -C 2,TFLX,TFLXH,TFLXL(N,N6,N5,N4),WFLX,WFLXH -C 2,WFLXL(N,N6,N5,N4),WFLXLH(N,N6,N5,N4) -C 4,VOLW1(N6,N5,N4),VOLWH1(N6,N5,N4) -C 4,VOLI1(N6,N5,N4),VOLIH1(N6,N5,N4) -C 5,FGRD(N6,N5,N4),FMAC(N6,N5,N4) -4359 FORMAT(A8,6I4,20E12.4) -C ENDIF - ENDIF -C -C TOTAL WATER, VAPOR AND HEAT FLUXES -C - THAW(N,N6,N5,N4)=THAW(N,N6,N5,N4)+WFLXL(N,N6,N5,N4) - THAWH(N,N6,N5,N4)=THAWH(N,N6,N5,N4)+WFLXLH(N,N6,N5,N4) - HTHAW(N,N6,N5,N4)=HTHAW(N,N6,N5,N4)+TFLXL(N,N6,N5,N4) - FLW(N,N6,N5,N4)=FLW(N,N6,N5,N4)+FLWL(N,N6,N5,N4) - FLWX(N,N6,N5,N4)=FLWX(N,N6,N5,N4)+FLWLX(N,N6,N5,N4) - FLWH(N,N6,N5,N4)=FLWH(N,N6,N5,N4)+FLWHL(N,N6,N5,N4) - HFLW(N,N6,N5,N4)=HFLW(N,N6,N5,N4)+HFLWL(N,N6,N5,N4) - FLWM(M,N,N6,N5,N4)=FLWL(N,N6,N5,N4) - IF(N.EQ.3)THEN - HYSM(M,N6,N5,N4)=HYST(N6,N5,N4) - IF(PSISA1.GT.PSISA(N3,N2,N1).AND.VOLPX1(N6,N5,N4).GT.ZEROS(N5,N4) - 2.AND.HYST(N6,N5,N4).GT.ZERO)THEN - HYST(N6,N5,N4)=AMIN1(1.0,AMAX1(0.0,HYST(N6,N5,N4) - 2-FLWL(N,N6,N5,N4)/VOLPX1(N6,N5,N4))) - ENDIF -C -C WATER FILM THICKNESS FOR CALCULATING GAS EXCHANGE IN 'TRNSFR' -C -C IF(BKVL(N6,N5,N4).GT.0.0)THEN - FILM(M,N6,N5,N4)=AMAX1(1.0E-06 - 2,EXP(-13.833-0.857*LOG(-PSISM1(N6,N5,N4)))) -C ELSE -C FILM(M,N6,N5,N4)=DLYR(3,N6,N5,N4) -C ENDIF - HYST(N6,N5,N4)=HYST(N6,N5,N4)+(1.0-HYST(N6,N5,N4))*HYSTX - ENDIF - ELSEIF(N.NE.3)THEN - FLWL(N,N6,N5,N4)=0.0 - FLWLX(N,N6,N5,N4)=0.0 - FLWHL(N,N6,N5,N4)=0.0 - HFLWL(N,N6,N5,N4)=0.0 - FLWHM(M,N,N6,N5,N4)=0.0 - ENDIF -4320 CONTINUE -4400 CONTINUE -9890 CONTINUE -9895 CONTINUE -C -C BOUNDARY WATER AND HEAT FLUXES -C - DO 9595 NX=NHW,NHE - DO 9590 NY=NVN,NVS - DO 9585 L=NU(NY,NX),NL(NY,NX) - TVOLZ1=TVOL1(NY,NX) - VOLWZ1=TVOLW(NY,NX) - VOLP2=VOLP1(L,NY,NX) - VOLPX2=VOLPX1(L,NY,NX) - VOLPH2=VOLPH1(L,NY,NX) -C -C IDENTIFY CONDITIONS FOR MICROPRE DISCHARGE TO WATER TABLE -C - IF(IPRC(NY,NX).NE.0.AND.DPTH(L,NY,NX).LT.DTBLX(NY,NX))THEN - IF(PSISM1(L,NY,NX).GE.PSISE(L,NY,NX) - 2+0.0098*(DPTH(L,NY,NX)-DTBLX(NY,NX)))THEN - IFLGU=0 - DO 9565 LL=MIN(L+1,NL(NY,NX)),NL(NY,NX) - IF(DPTH(LL,NY,NX).LT.DTBLX(NY,NX))THEN - IF((PSISM1(LL,NY,NX).LT.PSISA(LL,NY,NX).AND.L.NE.NL(NY,NX)) - 2.OR.DPTH(LL,NY,NX).GT.DPTHA(NY,NX))THEN - IFLGU=1 - ENDIF - ENDIF -9565 CONTINUE - ELSE - IFLGU=1 - ENDIF - ELSE - IFLGU=1 - ENDIF -C -C IDENTIFY CONDITIONS FOR MACROPORE DISCHARGE TO WATER TABLE -C - IF(VOLAH1(L,NY,NX).GT.ZEROS(NY,NX))THEN - DPTHH=CDPTH(L,NY,NX)-(VOLWH1(L,NY,NX)+VOLIH1(L,NY,NX)) - 2/VOLAH1(L,NY,NX)*DLYR(3,L,NY,NX) - ELSE - DPTHH=CDPTH(L,NY,NX) - ENDIF - IF(IPRC(NY,NX).NE.0.AND.DPTHH.LT.DTBLX(NY,NX) - 2.AND.VOLWH1(L,NY,NX).GT.ZEROS(NY,NX))THEN - IFLGUH=0 - DO 9566 LL=MIN(L+1,NL(NY,NX)),NL(NY,NX) - IF(DPTH(LL,NY,NX).LT.DTBLX(NY,NX))THEN - IF(VOLAH1(LL,NY,NX).LE.ZEROS(NY,NX))THEN - IFLGUH=1 - ENDIF - ENDIF -9566 CONTINUE - ELSE - IFLGUH=1 - ENDIF -C IF((I/30)*30.EQ.I.AND.M.EQ.1)THEN -C WRITE(*,9567)'IFLGU',I,J,M,NX,NY,L,IFLGU,IFLGUH,PSISM1(L,NY,NX) -C 2,PSISE(L,NY,NX),DPTH(L,NY,NX),DTBLX(NY,NX),PSISE(L,NY,NX) -C 2+0.0098*(DPTH(L,NY,NX)-DTBLX(NY,NX)),THETX -C 3,VOLAH1(L,NY,NX),VOLWH1(L,NY,NX),VOLIH1(L,NY,NX),CDPTH(L,NY,NX) -C 4,DLYR(3,L,NY,NX),DTBLZ(NY,NX),DPTHH -9567 FORMAT(A8,8I4,20E12.4) -C ENDIF -C -C LOCATE ALL EXTERNAL BOUNDARIES AND SET BOUNDARY CONDITIONS -C ENTERED IN 'READS' -C - N1=NX - N2=NY - N3=L - DO 9580 N=1,3 - DO 9575 NN=1,2 - IF(N.EQ.1)THEN - N4=NX+1 - N5=NY - N6=L - WDTH=DLYR(2,NU(NY,NX),NY,NX) - IF(NN.EQ.1)THEN - IF(NX.EQ.NHE)THEN - M1=NX - M2=NY - M3=L - M4=NX+1 - M5=NY - M6=L - XN=-1.0 - RCHQF=RCHQE(M2,M1) - RCHGFU=RCHGEU(M2,M1) - RCHGFT=RCHGET(M2,M1) - ELSE - GO TO 9575 - ENDIF - ELSEIF(NN.EQ.2)THEN - IF(NX.EQ.NHW)THEN - M1=NX+1 - M2=NY - M3=L - M4=NX - M5=NY - M6=L - XN=1.0 - RCHQF=RCHQW(M5,M4) - RCHGFU=RCHGWU(M5,M4) - RCHGFT=RCHGWT(M5,M4) - ELSE - GO TO 9575 - ENDIF - ENDIF - ELSEIF(N.EQ.2)THEN - N4=NX - N5=NY+1 - N6=L - WDTH=DLYR(1,NU(NY,NX),NY,NX) - IF(NN.EQ.1)THEN - IF(NY.EQ.NVS)THEN - M1=NX - M2=NY - M3=L - M4=NX - M5=NY+1 - M6=L - XN=-1.0 - RCHQF=RCHQS(M2,M1) - RCHGFU=RCHGSU(M2,M1) - RCHGFT=RCHGST(M2,M1) - ELSE - GO TO 9575 - ENDIF - ELSEIF(NN.EQ.2)THEN - IF(NY.EQ.NVN)THEN - M1=NX - M2=NY+1 - M3=L - M4=NX - M5=NY - M6=L - XN=1.0 - RCHQF=RCHQN(M5,M4) - RCHGFU=RCHGNU(M5,M4) - RCHGFT=RCHGNT(M5,M4) - ELSE - GO TO 9575 - ENDIF - ENDIF - ELSEIF(N.EQ.3)THEN - N4=NX - N5=NY - N6=L+1 - IF(NN.EQ.1)THEN - IF(L.EQ.NL(NY,NX))THEN - M1=NX - M2=NY - M3=L - M4=NX - M5=NY - M6=L+1 - XN=-1.0 - RCHGFU=RCHGD(M2,M1) - RCHGFT=1.0 - ELSE - GO TO 9575 - ENDIF - ELSEIF(NN.EQ.2)THEN - GO TO 9575 - ENDIF - ENDIF -C -C BOUNDARY SURFACE RUNOFF DEPENDING ON ASPECT, SLOPE -C VELOCITY, HYDRAULIC RADIUS AND SURFACE WATER STORAGE -C - IF(L.EQ.NU(N2,N1).AND.N.NE.3)THEN - IF(IRCHG(NN,N,N2,N1).EQ.0.OR.RCHQF.EQ.0.0)THEN - V=0.0 - QR1(N,M5,M4)=0.0 - HQR1(N,M5,M4)=0.0 - ELSE -C -C RUNOFF -C - ALT1=ALTG(N2,N1)+TVOLZ1/AREA(3,NU(N2,N1),N2,N1) - ALT2=ALTG(N2,N1)+VOLWG(N2,N1)/AREA(3,NU(N2,N1),N2,N1) - 2-GSIN(N2,N1)*DLYR(N,NU(N2,N1),N2,N1) - IF(ALT1.GT.ALT2.AND.TVOLZ1.GT.VOLWG(N2,N1))THEN - QRX1=TVOLZ1-VOLWG(N2,N1) - D=QRX1/AREA(3,0,N2,N1) - R=D/2.828 - S=(ALT1-ALT2)/DLYR(N,NU(N2,N1),N2,N1) - V=R**0.67*SQRT(S)/ZM(N2,N1) - Q=V*D*AMIN1(1.0,D/ZS(N2,N1))*WDTH*3.6E+03*XNPH*RCHQF - QR1(N,M5,M4)=-XN*AMIN1(Q,0.25*QRX1)*VOLWZ1/TVOLZ1*RCHQF - HQR1(N,M5,M4)=4.19*TK1(0,N2,N1)*QR1(N,M5,M4) - VOLWZ1=VOLWZ1+XN*QR1(N,M5,M4) - TVOLZ1=TVOLZ1+XN*QR1(N,M5,M4) - ELSEIF(DTBLX(N2,N1).LT.0.0)THEN -C -C RUNON -C - QRX1=AMIN1(0.0,DTBLX(N2,N1)+TVOLZ1/AREA(3,NU(N2,N1),N2,N1)) - 2*AREA(3,NU(N2,N1),N2,N1) - QR1(N,M5,M4)=-XN*0.25*QRX1*RCHQF - HQR1(N,M5,M4)=4.19*TK1(0,N2,N1)*QR1(N,M5,M4) - VOLWZ1=VOLWZ1+XN*QR1(N,M5,M4) - TVOLZ1=TVOLZ1+XN*QR1(N,M5,M4) - ELSE - V=0.0 - QR1(N,M5,M4)=0.0 - HQR1(N,M5,M4)=0.0 - ENDIF - QR(N,M5,M4)=QR(N,M5,M4)+QR1(N,M5,M4) - HQR(N,M5,M4)=HQR(N,M5,M4)+HQR1(N,M5,M4) - QRM(M,N,M5,M4)=QR1(N,M5,M4) - QRV(M,N,M5,M4)=V - QS1(N,M5,M4)=0.0 - QW1(N,M5,M4)=0.0 - QI1(N,M5,M4)=0.0 - HQS1(N,M5,M4)=0.0 - QS(N,M5,M4)=QS(N,M5,M4)+QS1(N,M5,M4) - QW(N,M5,M4)=QW(N,M5,M4)+QW1(N,M5,M4) - QI(N,M5,M4)=QI(N,M5,M4)+QI1(N,M5,M4) - HQS(N,M5,M4)=HQS(N,M5,M4)+HQS1(N,M5,M4) - QSM(M,N,M5,M4)=QS1(N,M5,M4) -C IF((I/10)*10.EQ.I.AND.M.EQ.NPH)THEN -C WRITE(*,7744)'QRB',I,J,M,N1,N2,N3,M4,M5,M6,N,NN,IRCHG(NN,N,N2,N1) -C 2,QR(N,M5,M4),QR1(N,M5,M4),Q,QRX1,V,S,D,ALT1,ALT2,ZM(N2,N1) -C 3,ZS(N2,N1),VOLWZ1,TVOLZ1,RCHQF,VOLWG(N2,N1),VOLW1(0,N2,N1) -C 4,VOLI1(0,N2,N1),TVOLW(N2,N1),FVOLW1,FVOLH1,PSISM1(0,N2,N1) -C 7,VOLWRX(N2,N1),FLWL(3,0,N2,N1),FLWRL(N2,N1) -7744 FORMAT(A8,12I4,30E12.4) -C ENDIF - ENDIF - ENDIF -C -C BOUNDARY SUBSURFACE WATER AND HEAT TRANSFER DEPENDING -C ON LEVEL OF WATER TABLE -C - IF(NCN(N2,N1).NE.3.OR.N.EQ.3)THEN -C -C IF NO WATER TABLE -C - IF(IPRC(N2,N1).EQ.0.OR.N.EQ.3)THEN - THETA1=AMAX1(THETY(N3,N2,N1),AMIN1(POROS(N3,N2,N1) - 2,VOLW1(N3,N2,N1)/VOLX(N3,N2,N1))) - THETAX=AMAX1(THETY(N3,N2,N1),AMIN1(POROS(N3,N2,N1) - 2,VOLWX1(N3,N2,N1)/VOLX(N3,N2,N1))) - K1=MAX(1,MIN(100,INT(100.0*(POROS(N3,N2,N1) - 2-THETA1)/POROS(N3,N2,N1))+1)) - KX=MAX(1,MIN(100,INT(100.0*(POROS(N3,N2,N1) - 2-THETAX)/POROS(N3,N2,N1))+1)) - CND1=HCND(N,K1,N3,N2,N1)*XNPH - CNDX=HCND(N,KX,N3,N2,N1)*XNPH - FLWL(N,M6,M5,M4)=AMIN1(VOLW1(N3,N2,N1)*XNPH - 2,XN*0.0098*-ABS(SLOPE(N,N2,N1))*CND1*AREA(3,N3,N2,N1)) - 3*RCHGFU*RCHGFT - FLWLX(N,M6,M5,M4)=AMIN1(VOLWX1(N3,N2,N1)*XNPH - 2,XN*0.0098*-ABS(SLOPE(N,N2,N1))*CNDX*AREA(3,N3,N2,N1)) - 3*RCHGFU*RCHGFT - FLWHL(N,M6,M5,M4)=AMIN1(VOLWH1(L,NY,NX) - 2,XN*0.0098*-ABS(SLOPE(N,N2,N1))*CNDH1(L,NY,NX)*AREA(3,N3,N2,N1)) - 3*RCHGFU*RCHGFT - HFLWL(N,M6,M5,M4)=4.19*TK1(N3,N2,N1) - 2*(FLWL(N,M6,M5,M4)+FLWHL(N,M6,M5,M4)) -C IF(J.EQ.12.AND.M.EQ.1)THEN -C WRITE(*,4443)'ABV',I,J,M,N,NN,M4,M5,M6,XN,FLWL(N,M6,M5,M4) -C 2,VOLP2,RCHGFU,VOLX(N3,N2,N1),VOLW1(N3,N2,N1) -C 3,VOLWH1(N3,N2,N1),VOLPH1(N3,N2,N1),VOLPH2,VOLI1(N3,N2,N1) -C 4,VOLIH1(N3,N2,N1),VOLP1(N3,N2,N1),HFLWL(N,M6,M5,M4) -C 5,PSISM1(N3,N2,N1),PSISE(N3,N2,N1),FLWHL(N,M6,M5,M4),DDRG(N2,N1) -C 6,SLOPE(N,N2,N1) -4443 FORMAT(A8,8I4,30E12.4) -C ENDIF - ELSE -C -C MICROPORE DISCHARGE ABOVE WATER TABLE -C - IF(IFLGU.EQ.0.AND.RCHGFT.NE.0.0)THEN - PSISWD=XN*0.005*SLOPE(N,N2,N1)*DLYR(N,N3,N2,N1) - 2*(1.0-DTBLG(N2,N1)) - PSISWT=AMIN1(0.0,PSISE(N3,N2,N1)-PSISM1(N3,N2,N1) - 2+0.0098*(DPTH(N3,N2,N1)-DTBLX(N2,N1)) - 3-0.0098*AMAX1(0.0,DPTH(N3,N2,N1)-DPTHT(N2,N1))) - IF(PSISWT.LT.0.0)PSISWT=PSISWT-PSISWD - FLWT=PSISWT*HCND(N,1,N3,N2,N1)*XNPH*AREA(N,N3,N2,N1) - 2*(1.0-AREAU(N3,N2,N1))/(RCHGFU+1.0)*RCHGFT - FLWL(N,M6,M5,M4)=XN*FLWT - FLWLX(N,M6,M5,M4)=XN*FLWT - HFLWL(N,M6,M5,M4)=4.19*TK1(N3,N2,N1)*XN*FLWT -C WRITE(*,4445)'DISCHMI',I,J,M,N1,N2,N3,M4,M5,M6,N,NN,XN -C 2,FLWL(N,M6,M5,M4),FLWT,PSISWT,HCND(N,1,N3,N2,N1) -C 3,AREA(N,N3,N2,N1),AREAU(N3,N2,N1),RCHGFU,RCHGFT -4445 FORMAT(A8,11I4,30E12.4) - ELSE - FLWL(N,M6,M5,M4)=0.0 - FLWLX(N,M6,M5,M4)=0.0 - HFLWL(N,M6,M5,M4)=0.0 - ENDIF -C -C MACROPORE DISCHARGE ABOVE WATER TABLE -C - IF(IFLGUH.EQ.0.AND.RCHGFT.NE.0.0)THEN - PSISWD=XN*0.005*SLOPE(N,N2,N1)*DLYR(N,N3,N2,N1) - 2*(1.0-DTBLG(N2,N1)) - PSISWTH=0.0098*(DPTHH-DTBLX(N2,N1)) - 2-0.0098*AMAX1(0.0,DPTHH-DPTHT(N2,N1)) - IF(PSISWTH.LT.0.0)PSISWTH=PSISWTH-PSISWD - FLWTH=PSISWTH*CNDH1(N3,N2,N1)*AREA(N,N3,N2,N1) - 2*(1.0-AREAU(N3,N2,N1))/(RCHGFU+1.0)*RCHGFT - FLWTHL=AMAX1(FLWTH,AMIN1(0.0,-XNPH*(VOLWH1(N3,N2,N1) - 2+FLWHL(3,N3,N2,N1)-FLWHL(3,N3+1,N2,N1)-FINHL(N3,N2,N1)))) - FLWHL(N,M6,M5,M4)=XN*FLWTHL - HFLWL(N,M6,M5,M4)=HFLWL(N,M6,M5,M4)+4.19*TK1(N3,N2,N1)*XN*FLWTHL -C WRITE(*,4446)'DISCHMA',I,J,M,N1,N2,N3,M4,M5,M6,N,NN,XN -C 2,FLWHL(N,M6,M5,M4),FLWTHL,FLWTH,PSISWTH,CNDH1(N3,N2,N1) -C 3,DPTH(N3,N2,N1),DLYR(3,N3,N2,N1),DPTHH,VOLWH1(N3,N2,N1) -C 4,VOLIH1(L,NY,NX),VOLAH1(N3,N2,N1),DTBLX(N2,N1),PSISWD -4446 FORMAT(A8,11I4,30E12.4) - ELSE - FLWHL(N,M6,M5,M4)=0.0 - ENDIF -C -C MICROPORE RECHARGE BELOW WATER TABLE -C - IF(IPRC(N2,N1).NE.3.AND.DPTH(N3,N2,N1).GT.DTBLX(N2,N1) -C 2.AND.DPTHA(N2,N1).GT.DTBLX(N2,N1) - 2.AND.(BKDS(N3,N2,N1).EQ.0.0.OR.VOLP2.GT.0.0))THEN - PSISWD=XN*0.005*SLOPE(N,N2,N1)*DLYR(N,N3,N2,N1) - 2*(1.0-DTBLG(N2,N1)) - PSISUT=AMAX1(0.0,PSISE(N3,N2,N1)-PSISM1(N3,N2,N1) - 2+0.0098*(DPTH(N3,N2,N1)-DTBLX(N2,N1))) - IF(PSISUT.GT.0.0)PSISUT=PSISUT+PSISWD - FLWU=PSISUT*HCND(N,1,N3,N2,N1)*XNPH*AREA(N,N3,N2,N1) - 2*AREAU(N3,N2,N1)/(RCHGFU+1.0)*RCHGFT - FLWUL=AMIN1(FLWU,AMAX1(0.0,VOLP2)) - FLWUX=AMIN1(FLWU,AMAX1(0.0,VOLPX2)) - FLWL(N,M6,M5,M4)=FLWL(N,M6,M5,M4)+XN*FLWUL - FLWLX(N,M6,M5,M4)=FLWLX(N,M6,M5,M4)+XN*FLWUX - HFLWL(N,M6,M5,M4)=HFLWL(N,M6,M5,M4)+4.19*TK1(N3,N2,N1) - 2*XN*FLWUL -C IF((I/30)*30.EQ.I.AND.J.EQ.15)THEN -C WRITE(*,4444)'RECHGMI',I,J,M,N1,N2,N3,M4,M5,M6,N,NN,IFLGU,XN -C 2,FLWL(N,M6,M5,M4),AREAU(N3,N2,N1),RCHGFT,VOLP2,FLWT -C 3,FLWU,FLWUL,PSISM1(N3,N2,N1),PSISA(N3,N2,N1) -C 4,PSISWT,PSISUT,PSISUTH,HCND(N,1,N3,N2,N1) -C 5,DTBLX(N2,N1),CDPTH(N3,N2,N1),DPTHT(N2,N1) -C 6,DDRG(N2,N1),DPTH(N3,N2,N1),VOLW1(N3,N2,N1),VOLI1(N3,N2,N1) -C 7,VOLX(N3,N2,N1),VOLP1(N3,N2,N1) -C 8,RCHGFU,AREA(N,N3,N2,N1) -C 9,FINHL(N3,N2,N1),DLYR(N,N3,N2,N1),DLYR(3,N3,N2,N1),PSISWD -C 1,SLOPE(N,N2,N1) -4444 FORMAT(A8,12I4,40E12.4) -C ENDIF - ENDIF -C -C MACROPORE RECHARGE BELOW WATER TABLE -C - IF(IPRC(N2,N1).NE.3.AND.DPTHH.GT.DTBLX(N2,N1) -C 2.AND.DPTHA(N2,N1).GT.DTBLX(N2,N1) - 2.AND.VOLPH2.GT.0.0)THEN - PSISWD=XN*0.005*SLOPE(N,N2,N1)*DLYR(N,N3,N2,N1) - 2*(1.0-DTBLG(N2,N1)) - PSISUTH=0.0098*(DPTHH-DTBLX(N2,N1)) - IF(PSISUTH.GT.0.0)PSISUTH=PSISUTH+PSISWD - FLWUH=PSISUTH*CNDH1(N3,N2,N1)*AREA(N,N3,N2,N1) - 2*AREAU(N3,N2,N1)/(RCHGFU+1.0)*RCHGFT - FLWUHL=AMIN1(FLWUH,AMAX1(0.0,XNPH*(VOLPH2 - 2-FLWHL(3,N3,N2,N1)+FLWHL(3,N3+1,N2,N1)+FINHL(N3,N2,N1)))) - FLWHL(N,M6,M5,M4)=FLWHL(N,M6,M5,M4)+XN*FLWUHL - HFLWL(N,M6,M5,M4)=HFLWL(N,M6,M5,M4)+4.19*TK1(N3,N2,N1) - 2*XN*FLWUHL -C IF(I.GT.208.AND.J.EQ.21)THEN -C WRITE(*,4447)'RECHGMA',I,J,M,N1,N2,N3,M4,M5,M6,N,NN,IFLGU,XN -C 2,AREAU(N3,N2,N1),FLWUH,FLWUHL,DPTHH,PSISUTH,CNDH1(N3,N2,N1) -C 5,FLWHL(N,M6,M5,M4),DTBLX(N2,N1),CDPTH(N3,N2,N1),DPTHT(N2,N1) -C 6,DDRG(N2,N1),DPTH(N3,N2,N1),VOLWH1(N3,N2,N1),VOLPH1(N3,N2,N1) -C 8,FLWHL(3,N3,N2,N1),FLWHL(3,N3+1,N2,N1),RCHGFU,AREA(N,N3,N2,N1) -C 9,FINHL(N3,N2,N1),DLYR(N,N3,N2,N1),DLYR(3,N3,N2,N1),PSISWD -C 1,SLOPE(N,N2,N1) -4447 FORMAT(A8,12I4,40E12.4) -C ENDIF - ENDIF - ENDIF -C -C SUBSURFACE HEAT SOURCE/SINK -C - IF(N.EQ.3.AND.IETYP(N2,N1).NE.-2)THEN - HFLWL(N,M6,M5,M4)=HFLWL(N,M6,M5,M4)+(TK1(N3,N2,N1) - 2-TKSD(N2,N1))*TCNDG/(DPTHSK(N2,N1)-CDPTH(N3,N2,N1)) - 3*AREA(N,N3,N2,N1)*XNPH - ENDIF - VOLP2=VOLP2-XN*FLWL(N,M6,M5,M4) - VOLPX2=VOLPX2-XN*FLWLX(N,M6,M5,M4) - VOLPH2=VOLPH2-XN*FLWHL(N,M6,M5,M4) - FLWLD=0.0 - FLWLXD=0.0 - FLWHLD=0.0 - FLW(N,M6,M5,M4)=FLW(N,M6,M5,M4)+FLWL(N,M6,M5,M4) - FLWX(N,M6,M5,M4)=FLWX(N,M6,M5,M4)+FLWLX(N,M6,M5,M4) - FLWH(N,M6,M5,M4)=FLWH(N,M6,M5,M4)+FLWHL(N,M6,M5,M4) - HFLW(N,M6,M5,M4)=HFLW(N,M6,M5,M4)+HFLWL(N,M6,M5,M4) - FLWM(M,N,M6,M5,M4)=FLWL(N,M6,M5,M4) - FLWHM(M,N,M6,M5,M4)=FLWHL(N,M6,M5,M4) - ENDIF -9575 CONTINUE -C -C TOTAL WATER AND HEAT FLUXES IN EACH GRID CELL -C - IF(L.EQ.NU(N2,N1).AND.N.NE.3)THEN - TQR1(N2,N1)=TQR1(N2,N1)+QR1(N,N2,N1)-QR1(N,N5,N4) - THQR1(N2,N1)=THQR1(N2,N1)+HQR1(N,N2,N1)-HQR1(N,N5,N4) - TQS1(N2,N1)=TQS1(N2,N1)+QS1(N,N2,N1)-QS1(N,N5,N4) - TQW1(N2,N1)=TQW1(N2,N1)+QW1(N,N2,N1)-QW1(N,N5,N4) - TQI1(N2,N1)=TQI1(N2,N1)+QI1(N,N2,N1)-QI1(N,N5,N4) - THQS1(N2,N1)=THQS1(N2,N1)+HQS1(N,N2,N1)-HQS1(N,N5,N4) - ENDIF - IF(NCN(N2,N1).NE.3.OR.N.EQ.3)THEN - TFLWL(N3,N2,N1)=TFLWL(N3,N2,N1)+FLWL(N,N3,N2,N1) - 2-FLWL(N,N6,N5,N4) - TFLWLX(N3,N2,N1)=TFLWLX(N3,N2,N1)+FLWLX(N,N3,N2,N1) - 2-FLWLX(N,N6,N5,N4) - TFLWHL(N3,N2,N1)=TFLWHL(N3,N2,N1)+FLWHL(N,N3,N2,N1) - 2-FLWHL(N,N6,N5,N4) - THFLWL(N3,N2,N1)=THFLWL(N3,N2,N1)+HFLWL(N,N3,N2,N1) - 2-HFLWL(N,N6,N5,N4) - TWFLXL(N3,N2,N1)=TWFLXL(N3,N2,N1)+WFLXL(N,N3,N2,N1) - TWFLXH(N3,N2,N1)=TWFLXH(N3,N2,N1)+WFLXLH(N,N3,N2,N1) - TTFLXL(N3,N2,N1)=TTFLXL(N3,N2,N1)+TFLXL(N,N3,N2,N1) -C IF(L.EQ.NU(NY,NX))THEN -C WRITE(*,3378)'THFLWL',I,J,M,N1,N2,N3,N4,N5,N6,N,THFLWL(N3,N2,N1) -C 3,HFLWL(N,N3,N2,N1),HFLWL(N,N6,N5,N4),TFLWL(N3,N2,N1) -C 3,FLWL(N,N3,N2,N1),FLWL(N,N6,N5,N4),TFLWHL(N3,N2,N1) -C 3,FLWHL(N,N3,N2,N1),FLWHL(N,N6,N5,N4) -3378 FORMAT(A8,10I4,20E12.4) -C ENDIF - ENDIF -9580 CONTINUE -9585 CONTINUE -9590 CONTINUE -9595 CONTINUE -C -C UPDATE STATE VARIABLES FROM FLUXES CALCULATED ABOVE -C - IF(M.NE.NPH)THEN - DO 9795 NX=NHW,NHE - DO 9790 NY=NVN,NVS -C -C SNOWPACK WATER, ICE, SNOW AND TEMPERATURE -C - IF(VHCP0(NY,NX).GT.VHCPWX(NY,NX))THEN - VOLS0(NY,NX)=VOLS0(NY,NX)+FLW0S(NY,NX) - 2-WFLXA(NY,NX)-FLWS1(NY,NX)+TQS1(NY,NX) - VOLW0(NY,NX)=VOLW0(NY,NX)+FLW0L(NY,NX) - 2+WFLXA(NY,NX)+WFLXB(NY,NX)-FLWZ1(NY,NX)+TQW1(NY,NX) - VOLI0(NY,NX)=VOLI0(NY,NX) - 2-WFLXB(NY,NX)/0.92-FLWI1(NY,NX)+TQI1(NY,NX) - ENGY0=VHCP0(NY,NX)*TK0(NY,NX) - VHCP0(NY,NX)=2.095*VOLS0(NY,NX)+4.19*VOLW0(NY,NX) - 2+1.9274*VOLI0(NY,NX) - TK0(NY,NX)=(ENGY0+HFLW0L(NY,NX)+TFLX0(NY,NX)-HFLWZ1(NY,NX) - 2-HFLSI1(NY,NX)+THQS1(NY,NX))/VHCP0(NY,NX) - ELSE - VOLS0(NY,NX)=VOLS0(NY,NX)+FLQ0S(NY,NX)-FLWS1(NY,NX)+TQS1(NY,NX) - VOLW0(NY,NX)=VOLW0(NY,NX)+FLQ0W(NY,NX)-FLWZ1(NY,NX)+TQW1(NY,NX) - VOLI0(NY,NX)=VOLI0(NY,NX)-FLWI1(NY,NX)+TQI1(NY,NX) - VHCP0(NY,NX)=2.095*VOLS0(NY,NX)+4.19*VOLW0(NY,NX) - 2+1.9274*VOLI0(NY,NX) - TK0(NY,NX)=TKQ(NY,NX) - ENDIF -C IF(NX.EQ.2.AND.NY.EQ.2)THEN -C WRITE(*,7754)'TKW',I,J,M,NX,NY,TK0(NY,NX) -C 3,VOLS0(NY,NX),VOLW0(NY,NX),VOLI0(NY,NX),VOLS1(NY,NX) -C 3,FLW0S(NY,NX),WFLXA(NY,NX),FLWS1(NY,NX),TQS1(NY,NX) -C 4,FLW0L(NY,NX),WFLXB(NY,NX),FLWZ1(NY,NX),TQW1(NY,NX) -C 5,FLWI1(NY,NX),TQI1(NY,NX),THFLWW(NY,NX),HWFLQ0(NY,NX) -C 2,HFLW0L(NY,NX),TFLX0(NY,NX),HFLWZ1(NY,NX),HFLSI1(NY,NX) -C 4,THQS1(NY,NX),VHCP0(NY,NX),VHCPWX(NY,NX) -C ENDIF -C -C SURFACE RESIDUE WATER AND TEMPERATURE -C - TVOL1(NY,NX)=AMAX1(0.0,VOLW1(0,NY,NX)+VOLI1(0,NY,NX) - 2-VOLWRX(NY,NX)) - TVOLW(NY,NX)=AMAX1(0.0,VOLW1(0,NY,NX)-VOLWRX(NY,NX)) - VOLGM(M+1,NY,NX)=AMAX1(0.0,TVOL1(NY,NX)) -C VOLXP2=(VOLP1(NU(NY,NX),NY,NX)+VOLPH1(NU(NY,NX),NY,NX)) -C 2*AMIN1(1.0,(VOLA(NU(NY,NX),NY,NX)+VOLAH1(NU(NY,NX),NY,NX)) -C 3/TVOL1(NY,NX)) -C VOLPX1(NU(NY,NX),NY,NX)=VOLXP2*HYST(NU(NY,NX),NY,NX) - VOLW1(0,NY,NX)=AMAX1(0.0,VOLW1(0,NY,NX)+FLWRL(NY,NX)+WFLXR(NY,NX) - 2+TQR1(NY,NX)) - VOLI1(0,NY,NX)=AMAX1(0.0,VOLI1(0,NY,NX)-WFLXR(NY,NX)/0.92) - VOLP1(0,NY,NX)=AMAX1(0.0,VOLA(0,NY,NX)-VOLW1(0,NY,NX) - 2-VOLI1(0,NY,NX)) - VOLWM(M+1,0,NY,NX)=VOLW1(0,NY,NX) - VOLPM(M+1,0,NY,NX)=VOLP1(0,NY,NX) - IF(VOLR(NY,NX).GT.ZEROS(NY,NX))THEN - THETWX(0,NY,NX)=AMAX1(0.0,VOLW1(0,NY,NX)/VOLR(NY,NX)) - THETIX(0,NY,NX)=AMAX1(0.0,VOLI1(0,NY,NX)/VOLR(NY,NX)) - THETPX(0,NY,NX)=AMAX1(0.0,VOLP1(0,NY,NX)/VOLR(NY,NX)) - ELSE - THETWX(0,NY,NX)=0.0 - THETIX(0,NY,NX)=0.0 - THETPX(0,NY,NX)=0.0 - ENDIF - THETPM(M+1,0,NY,NX)=THETPX(0,NY,NX) -C IF(NX.EQ.1.AND.NY.EQ.6)THEN -C WRITE(*,7752)'VOLW10',I,J,M,NX,NY,VOLW1(0,NY,NX) -C 2,VOLI1(0,NY,NX),VOLP1(0,NY,NX),FLWRL(NY,NX),WFLXR(NY,NX) -C 2,TQR1(NY,NX),TRC0(NY,NX),VHCPR1(NY,NX),VHCPRX(NY,NX),CVRD(NY,NX) -C 4,FLWR(NY,NX),VOLA(0,NY,NX),VOLWRX(NY,NX),VOLR(NY,NX) -C 2,ORGC(0,NY,NX),PSISM1(0,NY,NX) -7752 FORMAT(A8,5I4,20E12.4) -C ENDIF - ENGYR=VHCPR1(NY,NX)*TK1(0,NY,NX) - VHCPR1(NY,NX)=2.496E-06*ORGC(0,NY,NX)+4.19*VOLW1(0,NY,NX) - 2+1.9274*VOLI1(0,NY,NX) - IF(VHCPR1(NY,NX).GT.VHCPRX(NY,NX))THEN - TK1(0,NY,NX)=(ENGYR+HFLWRL(NY,NX)+TFLXR(NY,NX) - 2+THQR1(NY,NX))/VHCPR1(NY,NX) -C WRITE(*,7754)'TKR',I,J,M,NX,NY,TK1(0,NY,NX),ENGYR,HFLWRL(NY,NX) -C 2,TFLXR(NY,NX),THQR1(NY,NX),VHCPR1(NY,NX),VOLW1(0,NY,NX) -7754 FORMAT(A8,5I4,30E12.4) - ELSE - TK1(0,NY,NX)=TK1(NU(NY,NX),NY,NX) - ENDIF -C -C SOIL SURFACE WATER FROM RUNOFF -C - VOLI1(NU(NY,NX),NY,NX)=VOLI1(NU(NY,NX),NY,NX)+FLSI1(NY,NX) - ENGY1=VHCP1(NU(NY,NX),NY,NX)*TK1(NU(NY,NX),NY,NX) - VHCP1(NU(NY,NX),NY,NX)=VHCM(NU(NY,NX),NY,NX) - 2+4.19*(VOLW1(NU(NY,NX),NY,NX)+VOLWH1(NU(NY,NX),NY,NX)) - 3+1.9274*(VOLI1(NU(NY,NX),NY,NX)+VOLIH1(NU(NY,NX),NY,NX)) - TK1(NU(NY,NX),NY,NX)=(ENGY1+HFLSI1(NY,NX)) - 2/VHCP1(NU(NY,NX),NY,NX) -C WRITE(*,7755)'TQR',I,J,M,NX,NY,VOLW1(NU(NY,NX),NY,NX) -C 2,VOLWH1(NU(NY,NX),NY,NX),TQR1(NY,NX) -C WRITE(*,7755)'TK1',I,J,M,NX,NY,TK1(NU(NY,NX),NY,NX) -C 2,VHCP1(NU(NY,NX),NY,NX),VHCM(NU(NY,NX),NY,NX) -C 2,ENGY1,THQR1(NY,NX),HFLSI1(NY,NX),TQR1(NY,NX) -C 3,VOLW1(NU(NY,NX),NY,NX),VOLWH1(NU(NY,NX),NY,NX) -C 4,VOLI1(NU(NY,NX),NY,NX),FLSI1(NY,NX) -7755 FORMAT(A8,5I4,20E12.4) -C -C SOIL LAYER WATER, ICE AND TEMPERATURE -C - DO 9785 L=NU(NY,NX),NL(NY,NX) - VOLW1(L,NY,NX)=VOLW1(L,NY,NX)+TFLWL(L,NY,NX) - 2+FINHL(L,NY,NX)+TWFLXL(L,NY,NX)+FLU1(L,NY,NX) - VOLWX1(L,NY,NX)=VOLWX1(L,NY,NX)+TFLWLX(L,NY,NX) - 2+FINHL(L,NY,NX)+TWFLXL(L,NY,NX)+FLU1(L,NY,NX)+FLWVL(L,NY,NX) - VOLWX1(L,NY,NX)=AMIN1(VOLW1(L,NY,NX),VOLWX1(L,NY,NX)) - VOLI1(L,NY,NX)=VOLI1(L,NY,NX)-TWFLXL(L,NY,NX)/0.92 - VOLWH1(L,NY,NX)=VOLWH1(L,NY,NX)+TFLWHL(L,NY,NX) - 2-FINHL(L,NY,NX)+TWFLXH(L,NY,NX) - VOLIH1(L,NY,NX)=VOLIH1(L,NY,NX)-TWFLXH(L,NY,NX)/0.92 - VOLP1(L,NY,NX)=AMAX1(0.0,VOLA(L,NY,NX)-VOLW1(L,NY,NX) - 2-VOLI1(L,NY,NX)) - VOLAH1(L,NY,NX)=AMAX1(0.0,VOLAH(L,NY,NX)-FVOLAH*CCLAY(L,NY,NX) - 2*(VOLW1(L,NY,NX)/VOLX(L,NY,NX)-WP(L,NY,NX))*VOLT(L,NY,NX)) - VOLPH1(L,NY,NX)=AMAX1(0.0,VOLAH1(L,NY,NX)-VOLWH1(L,NY,NX) - 2-VOLIH1(L,NY,NX)) - VOLPX1(L,NY,NX)=VOLP1(L,NY,NX)*HYST(L,NY,NX) - VOLWM(M+1,L,NY,NX)=VOLW1(L,NY,NX) - VOLWHM(M+1,L,NY,NX)=VOLWH1(L,NY,NX) - VOLPM(M+1,L,NY,NX)=VOLP1(L,NY,NX)+VOLPH1(L,NY,NX) -C 2+THETPI*(VOLI1(L,NY,NX)+VOLIH1(L,NY,NX)) - FLPM(M,L,NY,NX)=VOLPM(M,L,NY,NX)-VOLPM(M+1,L,NY,NX) - THETWX(L,NY,NX)=AMAX1(0.0,(VOLW1(L,NY,NX)+VOLWH1(L,NY,NX)) - 2/VOLT(L,NY,NX)) - THETIX(L,NY,NX)=AMAX1(0.0,(VOLI1(L,NY,NX)+VOLIH1(L,NY,NX)) - 2/VOLT(L,NY,NX)) - THETPX(L,NY,NX)=AMAX1(0.0,(VOLP1(L,NY,NX)+VOLPH1(L,NY,NX)) - 2/VOLT(L,NY,NX)) - THETPM(M+1,L,NY,NX)=THETPX(L,NY,NX) - IF(VOLA(L,NY,NX)+VOLAH(L,NY,NX).GT.ZEROS(NY,NX))THEN - THETPY(L,NY,NX)=AMAX1(0.0,(VOLP1(L,NY,NX)+VOLPH1(L,NY,NX)) - 2/(VOLA(L,NY,NX)+VOLAH(L,NY,NX))) - ELSE - THETPY(L,NY,NX)=0.0 - ENDIF - IF(VOLAH(L,NY,NX).GT.ZEROS(NY,NX))THEN - FMAC(L,NY,NX)=FHOL(L,NY,NX)*VOLAH1(L,NY,NX)/VOLAH(L,NY,NX) - CNDH1(L,NY,NX)=XNPH*NHOL(L,NY,NX)*CNDH(L,NY,NX) - 2*(VOLAH1(L,NY,NX)/VOLAH(L,NY,NX))**2 - ELSE - FMAC(L,NY,NX)=0.0 - CNDH1(L,NY,NX)=0.0 - ENDIF - FGRD(L,NY,NX)=1.0-FMAC(L,NY,NX) - TKXX=TK1(L,NY,NX) - VHXX=VHCP1(L,NY,NX) - ENGY1=VHCP1(L,NY,NX)*TK1(L,NY,NX) - VHCP1(L,NY,NX)=VHCM(L,NY,NX)+4.19*(VOLW1(L,NY,NX) - 2+VOLWH1(L,NY,NX))+1.9274*(VOLI1(L,NY,NX)+VOLIH1(L,NY,NX)) -C -C ARTIFICIAL SOIL WARMING -C -C IF(NX.EQ.3.AND.NY.EQ.2.AND.L.GT.NU(NY,NX) -C 3.AND.L.LE.17.AND.I.GE.152.AND.I.LE.304)THEN -C THFLWL(L,NY,NX)=THFLWL(L,NY,NX) -C 2+(TKSZ(I,J,L)-TK1(L,NY,NX))*VHCP1(L,NY,NX)*XNPH -C WRITE(*,3379)'TKSZ',I,J,M,NX,NY,L,TKSZ(I,J,L) -C 2,TK1(L,NY,NX),VHCP1(L,NY,NX),THFLWL(L,NY,NX) -3379 FORMAT(A8,6I4,12E12.4) -C ENDIF -C -C ARTIFICIAL SOIL WARMING -C - TK1(L,NY,NX)=(ENGY1+THFLWL(L,NY,NX)+TTFLXL(L,NY,NX) - 2+HWFLU1(L,NY,NX))/VHCP1(L,NY,NX) -C IF(J.EQ.24.AND.L.EQ.NU(NY,NX))THEN -C WRITE(*,3377)'VOLW1',I,J,M,NX,NY,L,VOLW1(L,NY,NX) -C 2,VOLWH1(L,NY,NX),VOLI1(L,NY,NX),VOLIH1(L,NY,NX) -C 3,VOLP1(L,NY,NX),VOLPH1(L,NY,NX),VOLT(L,NY,NX) -C 4,VOLA(L,NY,NX),VOLAH(L,NY,NX) -C 5,VOLPM(M,L,NY,NX),VOLPM(M+1,L,NY,NX) -C 2,TFLWL(L,NY,NX),FINHL(L,NY,NX),TWFLXL(L,NY,NX),FLU1(L,NY,NX) -C 3,TQR1(NY,NX),VOLP1(L,NY,NX) -C 5,VOLPX1(L,NY,NX),HYST(L,NY,NX),PSISM1(L,NY,NX) -C 6,FLWL(3,L,NY,NX),FLWL(3,L+1,NY,NX) -C 7,FLWL(2,L,NY,NX),FLWL(2,L,NY+1,NX) -C 8,FLWL(1,L,NY,NX),FLWL(1,L,NY,NX+1) -C 9,FLPM(M,L,NY,NX) -C WRITE(*,3377)'VOLWH1',I,J,M,NX,NY,L,VOLWH1(L,NY,NX) -C 2,TFLWHL(L,NY,NX),FINHL(L,NY,NX),VOLIH1(L,NY,NX) -C 4,TWFLXH(L,NY,NX),TQR1(NY,NX),VOLPH1(L,NY,NX) -C 5,FLWHL(2,L,NY,NX),FLWHL(2,L,NY+1,NX) -C WRITE(*,3377)'TKL',I,J,M,NX,NY,L,TK1(L,NY,NX),ENGY1 -C 2,THFLWL(L,NY,NX),TTFLXL(L,NY,NX),HWFLU1(L,NY,NX),VHCP1(L,NY,NX) -C 3,VHCM(L,NY,NX),VOLW1(L,NY,NX),VOLWH1(L,NY,NX),VOLI1(L,NY,NX) -C 4,THETW(L,NY,NX),THETI(L,NY,NX),FINHL(L,NY,NX),THQR1(NY,NX) -C 5,HFLSI1(NY,NX),HFLWL(2,L,NY,NX),HFLWL(2,L,NY+1,NX) -3377 FORMAT(A8,6I4,40E12.4) -C ENDIF -9785 CONTINUE -9790 CONTINUE -9795 CONTINUE - ENDIF -3320 CONTINUE - RETURN - END + + SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) +C +C THIS SUBROUTINE CACULATES ENERGY BALANCES OF SNOW, RESIDUE +C AND SOIL SURFACES, FREEZING, THAWING, AND HEAT AND WATER +C TRANSFER THROUGH SOIL PROFILES +C + include "parameters.h" + include "blkc.h" + include "blk2a.h" + include "blk2b.h" + include "blk2c.h" + include "blk5.h" + include "blk8a.h" + include "blk8b.h" + include "blk10.h" + include "blk11a.h" + include "blk11b.h" + include "blk13a.h" + include "blk13b.h" + include "blk13c.h" + include "blk15a.h" + include "blk15b.h" + include "blk22a.h" + include "blk22b.h" + include "blk22c.h" + include "blktest.h" + DIMENSION VOLWX1(JZ,JY,JX) + 2,TVOL1(JY,JX),TVOLW(JY,JX),FMAC(JZ,JY,JX),FGRD(JZ,JY,JX) + 3,VOLW1(0:JZ,JY,JX),VOLI1(0:JZ,JY,JX),VOLPX1(JZ,JY,JX) + 4,VHCP1(JZ,JY,JX),TK1(0:JZ,JY,JX),TWFLXL(JZ,JY,JX),TTFLXL(JZ,JY,JX) + 5,VOLP1(0:JZ,JY,JX),WGSG1(JZ,JY,JX),TWFLXH(JZ,JY,JX) + 6,VOLS0(JY,JX),VOLI0(JY,JX),VOLW0(JY,JX),VOLS1(JY,JX) + 7,DPTHS0(JY,JX),VHCP0(JY,JX),TK0(JY,JX),AREAU(JZ,JY,JX) + 8,FLQ0S(JY,JX),FLQ0W(JY,JX),FLQ1(JY,JX),FLH1(JY,JX) + 9,FLY1(JY,JX),HWFLQ0(JY,JX),HWFLQ1(JY,JX),HWFLY1(JY,JX) + 1,RAR(JY,JX),RAGS(JY,JX),WGSG0(JY,JX),WRP(0:JZ,JY,JX),RARG(JY,JX) + 2,RAGR(JY,JX),RAGW(JY,JX),BARE(JY,JX),CVRD(JY,JX),PAREG(JY,JX) + 3,RAG(JY,JX),PARSG(JY,JX),PARER(JY,JX),PARSR(JY,JX),WGSGR0(JY,JX) + 4,VPQ(JY,JX),TKQ(JY,JX),VHCPR1(JY,JX),QR1(2,JV,JH),HQR1(2,JV,JH) + 5,QS1(2,JV,JH),QW1(2,JV,JH),QI1(2,JV,JH),HQS1(2,JV,JH) + 6,TQR1(JY,JX),THQR1(JY,JX),TQS1(JY,JX),TQW1(JY,JX) + 7,TQI1(JY,JX),THQS1(JY,JX),EVAP(JY,JX) + 8,EVAPS(JY,JX),EVAPR(JY,JX),TFLX0(JY,JX),WFLXA(JY,JX),WFLXB(JY,JX) + 9,FLW0L(JY,JX),FLW0S(JY,JX),HFLW0L(JY,JX),RFLWV(JY,JX),FLWRL(JY,JX) + 1,HFLWRL(JY,JX),FINHL(JZ,JY,JX),FLWVL(JZ,JY,JX),FLWL(3,JD,JV,JH) + DIMENSION FLWHL(3,JD,JV,JH),HFLWL(3,JD,JV,JH),AVCNHL(3,JD,JV,JH) + 2,TFLWL(JZ,JY,JX),TFLWHL(JZ,JY,JX),THFLWL(JZ,JY,JX) + 3,WFLXL(3,JZ,JY,JX),TFLXL(3,JZ,JY,JX),FLWZ1(JY,JX),FLWS1(JY,JX) + 4,FLWI1(JY,JX),FLSI1(JY,JX),HFLWZ1(JY,JX),HFLSI1(JY,JX) + 5,THRYW(JY,JX),THRMW(JY,JX),THRMS(JY,JX),THRMR(JY,JX) + 6,THRYG(JY,JX),THRYR(JY,JX),RADXW(JY,JX),RADXG(JY,JX) + 7,RADXR(JY,JX),FLWLX(3,JD,JV,JH),TFLWLX(JZ,JY,JX) + 8,FLU1(JZ,JY,JX),HWFLU1(JZ,JY,JX),PSISM1(0:JZ,JY,JX) + 4,ALTG(JY,JX),WFLXLH(3,JZ,JY,JX),DLYRR(JY,JX),WFLXR(JY,JX) + 6,TFLXR(JY,JX),HCNDR(JY,JX),CNDH1(JZ,JY,JX) + 7,THETWX(0:JZ,JY,JX),THETIX(0:JZ,JY,JX),THETPX(0:JZ,JY,JX) + 8,VOLAH1(JZ,JY,JX),VOLWH1(JZ,JY,JX),VOLPH1(JZ,JY,JX) + 9,VOLIH1(JZ,JY,JX),THETPY(0:JZ,JY,JX) + PARAMETER (EMMS=0.98,EMMW=0.98,EMMR=0.98 + 2,RACX=0.0278,RARX=0.0139,RZ=0.0278,RZR=0.0278,RZW=0.0278 + 3,RAM=1.39E-03,HYSTK=1.00,FQS=1.0E-00,DPTHSX=0.05,FPSISR=-4.0) + PARAMETER (Z1S=0.0125,Z2SW=12.0,Z2SD=12.0,Z3SX=0.50 + 2,Z1R=0.0125,Z2RW=3.0,Z2RD=12.0,Z3R=0.50) + PARAMETER (VISCW=1.18E-06,VISCA=1.44E-05,DIFFW=1.45E-07 + 2,DIFFA=2.01E-05,EXPNW=2.07E-04,EXPNA=3.66E-03,GRAV=9.8 + 3,RYLXW=GRAV*EXPNW/(VISCW*DIFFW),RYLXA=GRAV*EXPNA/(VISCA*DIFFA) + 4,PRNTW=VISCW/DIFFW,PRNTA=VISCA/DIFFA + 5,DNUSW=(1.0+(0.492/PRNTW)**0.5625)**0.4444 + 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 + 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 + FQSM=FQS*XNPH + DO 9995 NX=NHW,NHE + DO 9990 NY=NVN,NVS +C +C SET INTERNAL TIME STEPS FROM CYCLES PER HOUR ENTERED IN 'READS' +C XNPH = INTERNAL TIME STEP FOR SNOWPACK, SOIL PROFILE +C XNPR = INTERNAL TIME STEP FOR SURFACE RESIDUE +C + XNPHR=XNPH*XNPR + HYSTX=HYSTK +C +C ADJUST SURFACE ELEVATION USED IN RUNOFF FOR EROSION +C + ALTG(NY,NX)=ALT(NY,NX)-CDPTH(NU(NY,NX),NY,NX) + 2+DLYR(3,NU(NY,NX),NY,NX) +C +C ENTER STATE VARIABLES AND DRIVERS INTO LOCAL ARRAYS +C FOR USE AT INTERNAL TIME STEP +C + VOLS0(NY,NX)=VOLSS(NY,NX) + VOLI0(NY,NX)=VOLIS(NY,NX) + VOLW0(NY,NX)=VOLWS(NY,NX) + VOLS1(NY,NX)=VOLS(NY,NX) + DPTHS0(NY,NX)=DPTHS(NY,NX) + VHCP0(NY,NX)=VHCPW(NY,NX) + TK0(NY,NX)=TKW(NY,NX) + WFLXR(NY,NX)=0.0 + TFLXR(NY,NX)=0.0 + DO 65 L=NU(NY,NX),NL(NY,NX) + IF(CDPTH(L,NY,NX).GE.WDPTH(I,NY,NX))THEN + LWDPTH=L + GO TO 55 + ENDIF +65 CONTINUE +55 CONTINUE +C +C SET INITIAL SOIL VALUES +C + DO 30 L=NU(NY,NX),NL(NY,NX) +C +C ENTER STATE VARIABLES AND DRIVERS INTO LOCAL ARRAYS +C FOR USE AT INTERNAL TIME STEP +C + PSISM1(L,NY,NX)=PSISM(L,NY,NX) + VOLW1(L,NY,NX)=VOLW(L,NY,NX) + VOLWX1(L,NY,NX)=VOLWX(L,NY,NX) + VOLI1(L,NY,NX)=VOLI(L,NY,NX) + VOLWH1(L,NY,NX)=VOLWH(L,NY,NX) + VOLIH1(L,NY,NX)=VOLIH(L,NY,NX) + VOLP1(L,NY,NX)=AMAX1(0.0,VOLA(L,NY,NX)-VOLW1(L,NY,NX) + 2-VOLI1(L,NY,NX)) + VOLAH1(L,NY,NX)=AMAX1(0.0,VOLAH(L,NY,NX)-FVOLAH*CCLAY(L,NY,NX) + 2*(VOLW1(L,NY,NX)/VOLX(L,NY,NX)-WP(L,NY,NX))*VOLT(L,NY,NX)) + VOLPH1(L,NY,NX)=AMAX1(0.0,VOLAH1(L,NY,NX)-VOLWH1(L,NY,NX) + 2-VOLIH1(L,NY,NX)) + VOLPX1(L,NY,NX)=VOLP1(L,NY,NX)*HYST(L,NY,NX) + VOLWM(1,L,NY,NX)=VOLW1(L,NY,NX) + VOLWHM(1,L,NY,NX)=VOLWH1(L,NY,NX) + VOLPM(1,L,NY,NX)=VOLP1(L,NY,NX)+VOLPH1(L,NY,NX) + 2+THETPI*(VOLI1(L,NY,NX)+VOLIH1(L,NY,NX)) + THETWX(L,NY,NX)=AMAX1(0.0,(VOLW1(L,NY,NX)+VOLWH1(L,NY,NX)) + 2/VOLT(L,NY,NX)) + THETIX(L,NY,NX)=AMAX1(0.0,(VOLI1(L,NY,NX)+VOLIH1(L,NY,NX)) + 2/VOLT(L,NY,NX)) + THETPX(L,NY,NX)=AMAX1(0.0,(VOLP1(L,NY,NX)+VOLPH1(L,NY,NX)) + 2/VOLT(L,NY,NX)) + THETPM(1,L,NY,NX)=THETPX(L,NY,NX) + VHCP1(L,NY,NX)=VHCM(L,NY,NX)+4.19*(VOLW1(L,NY,NX) + 2+VOLWH1(L,NY,NX))+1.9274*(VOLI1(L,NY,NX)+VOLIH1(L,NY,NX)) + IF(VOLA(L,NY,NX)+VOLAH(L,NY,NX).GT.ZEROS(NY,NX))THEN + THETPY(L,NY,NX)=AMAX1(0.0,(VOLP1(L,NY,NX)+VOLPH1(L,NY,NX)) + 2/(VOLA(L,NY,NX)+VOLAH(L,NY,NX))) + ELSE + THETPY(L,NY,NX)=0.0 + ENDIF +C +C MACROPOROSITY +C + IF(VOLAH(L,NY,NX).GT.ZEROS(NY,NX))THEN + FMAC(L,NY,NX)=FHOL(L,NY,NX)*VOLAH1(L,NY,NX)/VOLAH(L,NY,NX) + CNDH1(L,NY,NX)=XNPH*NHOL(L,NY,NX)*CNDH(L,NY,NX) + 2*(VOLAH1(L,NY,NX)/VOLAH(L,NY,NX))**2 + ELSE + FMAC(L,NY,NX)=0.0 + CNDH1(L,NY,NX)=0.0 + ENDIF + FGRD(L,NY,NX)=1.0-FMAC(L,NY,NX) + TK1(L,NY,NX)=TKS(L,NY,NX) + IF(L.EQ.LWDPTH)THEN + FLU(L,NY,NX)=PRECU(NY,NX) + HWFLU(L,NY,NX)=4.19*TKA(NY,NX)*PRECU(NY,NX) + FLU1(L,NY,NX)=FLU(L,NY,NX)*XNPH + HWFLU1(L,NY,NX)=HWFLU(L,NY,NX)*XNPH + ELSE + FLU(L,NY,NX)=0.0 + HWFLU(L,NY,NX)=0.0 + FLU1(L,NY,NX)=0.0 + HWFLU1(L,NY,NX)=0.0 + ENDIF + IF(CDPTH(L,NY,NX).GE.DTBLX(NY,NX))THEN + AREAU(L,NY,NX)=AMIN1(1.0,AMAX1(0.0 + 2,(CDPTH(L,NY,NX)-DTBLX(NY,NX)) + 2/DLYR(3,L,NY,NX))) + ELSE + AREAU(L,NY,NX)=0.0 + ENDIF +30 CONTINUE +C +C ENTER STATE VARIABLES AND DRIVERS INTO LOCAL ARRAYS +C FOR USE AT INTERNAL TIME STEP +C + THRMG(NY,NX)=0.0 + FLQGM(NY,NX)=0.0 +C +C INITIALIZE SNOW AND SOIL-RESIDUE THERMAL CONDUCTIVITIES +C + VHCPR1(NY,NX)=2.496E-06*ORGC(0,NY,NX)+4.19*VOLW(0,NY,NX) + 2+1.9274*VOLI(0,NY,NX) + VOLW1(0,NY,NX)=AMAX1(0.0,VOLW(0,NY,NX)) + VOLI1(0,NY,NX)=AMAX1(0.0,VOLI(0,NY,NX)) + VOLP1(0,NY,NX)=AMAX1(0.0,VOLA(0,NY,NX)-VOLW1(0,NY,NX) + 2-VOLI1(0,NY,NX)) + VOLWM(1,0,NY,NX)=VOLW1(0,NY,NX) + VOLPM(1,0,NY,NX)=VOLP1(0,NY,NX) + TVOL1(NY,NX)=AMAX1(0.0,VOLW1(0,NY,NX)+VOLI1(0,NY,NX) + 2-VOLWRX(NY,NX)) + TVOLW(NY,NX)=AMAX1(0.0,VOLW1(0,NY,NX)-VOLWRX(NY,NX)) + VOLGM(1,NY,NX)=AMAX1(0.0,TVOL1(NY,NX)) + IF(VOLR(NY,NX).GT.ZEROS(NY,NX))THEN + THETWX(0,NY,NX)=AMAX1(0.0,VOLW1(0,NY,NX)/VOLR(NY,NX)) + THETIX(0,NY,NX)=AMAX1(0.0,VOLI1(0,NY,NX)/VOLR(NY,NX)) + THETPX(0,NY,NX)=AMAX1(0.0,VOLP1(0,NY,NX)/VOLR(NY,NX)) + 2*AMAX1(0.0,(1.0-TVOL1(NY,NX)/VOLWD(NY,NX))) + ELSE + THETWX(0,NY,NX)=0.0 + THETIX(0,NY,NX)=0.0 + THETPX(0,NY,NX)=0.0 + ENDIF + THETPM(1,0,NY,NX)=THETPX(0,NY,NX) + PSISM1(0,NY,NX)=PSISM(0,NY,NX) + TK1(0,NY,NX)=TKS(0,NY,NX) +C WRITE(*,7751)'THETPX',I,J,NX,NY,VOLW1(0,NY,NX) +C 2,VOLI1(0,NY,NX),VOLP1(0,NY,NX), THETWX(0,NY,NX) +C 3,THETIX(0,NY,NX),THETPX(0,NY,NX),TVOL1(NY,NX),VOLWD(NY,NX) +C 4,VOLWG(NY,NX),ZS(NY,NX) +7751 FORMAT(A8,4I4,20E12.4) +C +C RESIDUE COVERAGE OF SOIL SURFACE +C + IF(BKDS(NU(NY,NX),NY,NX).GT.ZERO)THEN + BARE(NY,NX)=AMAX1(0.0,EXP(-0.8E-02*(TRC0(NY,NX) + 2/AREA(3,0,NY,NX)))-AMIN1(1.0,TVOLW(NY,NX)/VOLWG(NY,NX))) + ELSE + BARE(NY,NX)=0.0 + ENDIF + CVRD(NY,NX)=1.0-BARE(NY,NX) + PRECD(NY,NX)=PRECA(NY,NX)*FRADG(NY,NX)*BARE(NY,NX) + PRECB(NY,NX)=(PRECA(NY,NX)-PRECD(NY,NX) + 2-TFLWC(NY,NX))*BARE(NY,NX) +C +C VARIABLES TO TRANSFER SNOWPACK INTO SOIL SURFACE AT FINAL MELT +C + IF(VHCPW(NY,NX).LE.VHCPWX(NY,NX).AND.DPTHS(NY,NX).GT.0.0 + 2.AND.TKA(NY,NX).GT.273.15)THEN + FLWZ=VOLWS(NY,NX) + FLWS=VOLSS(NY,NX)/DENSI + FLWI=VOLIS(NY,NX) + FLWSI(NY,NX)=FLWS+FLWI + HFLWZ=4.19*FLWZ*TKW(NY,NX) + HFLWSI(NY,NX)=1.9274*(FLWS+FLWI)*TKW(NY,NX) + WDISP=VOLWS(NY,NX)+VOLSS(NY,NX)+VOLIS(NY,NX)*DENSI + ELSE + FLWZ=0.0 + FLWS=0.0 + FLWI=0.0 + HFLWZ=0.0 + FLWSI(NY,NX)=0.0 + HFLWSI(NY,NX)=0.0 + WDISP=0.0 + ENDIF +C +C RESIDUE WATER ABSORPTION CAPACITY +C + HCNDRX=HCNDRR*CVRD(NY,NX) + HCNDR(NY,NX)=HCNDRX*XNPH + DLYRR(NY,NX)=AMIN1(5.0E-02,AMAX1(1.0E-06,DLYR(3,0,NY,NX))) +C +C DISCHARGE OF MELTWATER AND ITS HEAT FROM SNOWPACK +C TO RESIDUE, SOIL SURFACE AND MACROPORES +C + IF(VHCPW(NY,NX).GT.VHCPWX(NY,NX))THEN + WMELT=AMAX1(0.0,AMAX1(0.0,VOLWS(NY,NX)) + 2-0.05*AMAX1(0.0,VOLSS(NY,NX))) + FLWQR=WMELT*CVRD(NY,NX) + HFLWQR=4.19*TKW(NY,NX)*FLWQR + FLWQG=WMELT-FLWQR + HFLWQG=4.19*TKW(NY,NX)*FLWQG + FLWQGS=FLWQG*FGRD(NU(NY,NX),NY,NX) + FLWQGH=FLWQG*FMAC(NU(NY,NX),NY,NX) + ELSE + WMELT=0.0 + FLWQR=0.0 + HFLWQR=0.0 + FLWQG=0.0 + HFLWQG=0.0 + FLWQGS=0.0 + FLWQGH=0.0 + ENDIF + FLQRM(NY,NX)=FLWQR + FLQGM(NY,NX)=FLWQG+WDISP +C +C DISTRIBUTION OF PRECIPITATION AND ITS HEAT AMONG SURFACE +C RESIDUE, SOIL SURFACE, AND MACROPORES +C + IF(PRECA(NY,NX).GT.0.0.OR.PRECW(NY,NX).GT.0.0)THEN + IF(VHCPW(NY,NX).GT.VHCPWX(NY,NX))THEN + FLWQW=PRECA(NY,NX)-TFLWC(NY,NX) + FLWSW=PRECW(NY,NX) + HFLWSW=2.095*TKA(NY,NX)*FLWSW+4.19*TKA(NY,NX)*FLWQW + FLWQBX=0.0 + HFLWQB=0.0 + FLWQAX=0.0 + HFLWQA=0.0 + FLWQAS=0.0 + FLWQAH=0.0 + ELSE + FLWQW=0.0 + FLWSW=PRECW(NY,NX) + HFLWSW=2.095*TKA(NY,NX)*FLWSW + FLWQBX=(PRECA(NY,NX)-TFLWC(NY,NX))*CVRD(NY,NX) + HFLWQB=4.19*TKA(NY,NX)*FLWQBX + FLWQAX=PRECA(NY,NX)-TFLWC(NY,NX)-FLWQBX + HFLWQA=4.19*TKA(NY,NX)*FLWQAX + FLWQAS=FLWQAX*FGRD(NU(NY,NX),NY,NX) + FLWQAH=FLWQAX*FMAC(NU(NY,NX),NY,NX) + ENDIF + ELSE + IF(VHCPW(NY,NX).GT.VHCPWX(NY,NX))THEN + FLWQW=-TFLWC(NY,NX) + FLWSW=0.0 + HFLWSW=4.19*TKA(NY,NX)*FLWQW + FLWQBX=0.0 + HFLWQB=0.0 + FLWQAX=0.0 + HFLWQA=0.0 + FLWQAS=0.0 + FLWQAH=0.0 + ELSE + FLWQW=0.0 + FLWSW=0.0 + HFLWSW=0.0 + FLWQBX=-TFLWC(NY,NX)*CVRD(NY,NX) + HFLWQB=4.19*TKA(NY,NX)*FLWQBX + FLWQAX=-TFLWC(NY,NX)-FLWQBX + HFLWQA=4.19*TKA(NY,NX)*FLWQAX + FLWQAS=FLWQAX*FGRD(NU(NY,NX),NY,NX) + FLWQAH=FLWQAX*FMAC(NU(NY,NX),NY,NX) + ENDIF + ENDIF +C +C PRECIP ON SNOW +C + IF(PRECW(NY,NX).GT.0.0.OR.(PRECR(NY,NX).GT.0.0 + 2.AND.VHCPW(NY,NX).GT.VHCPWX(NY,NX)))THEN + FLQRQ(NY,NX)=0.0 + FLQRI(NY,NX)=0.0 + FLQGQ(NY,NX)=PRECQ(NY,NX) + FLQGI(NY,NX)=PRECI(NY,NX) + ELSEIF((PRECQ(NY,NX).GT.0.0.OR.PRECI(NY,NX).GT.0.0) + 2.AND.VHCPW(NY,NX).LE.VHCPWX(NY,NX))THEN + FLQRQ(NY,NX)=FLWQBX*PRECQ(NY,NX)/(PRECQ(NY,NX)+PRECI(NY,NX)) + FLQRI(NY,NX)=FLWQBX*PRECI(NY,NX)/(PRECQ(NY,NX)+PRECI(NY,NX)) + FLQGQ(NY,NX)=PRECQ(NY,NX)-FLQRQ(NY,NX) + FLQGI(NY,NX)=PRECI(NY,NX)-FLQRI(NY,NX) + ELSE + FLQRQ(NY,NX)=0.0 + FLQRI(NY,NX)=0.0 + FLQGQ(NY,NX)=0.0 + FLQGI(NY,NX)=0.0 + ENDIF +C +C GATHER PRECIPITATION AND MELTWATER FLUXES AND THEIR HEATS +C AMONG ATMOSPHERE, SNOWPACK, RESIDUE AND SOIL SURFACES +C INTO LOCAL ARRAYS FOR USE IN MASS AND ENERGY EXCHANGE +C ALGORITHMS +C + FLQ0W(NY,NX)=(FLWQW-FLWQR-FLWQGS-FLWQGH)*XNPH + FLQ0S(NY,NX)=FLWSW*XNPH + HWFLQ0(NY,NX)=(HFLWSW-HFLWQG-HFLWQR)*XNPH + FLQ1(NY,NX)=(FLWQAS+FLWQGS+FLWZ)*XNPH + FLH1(NY,NX)=(FLWQAH+FLWQGH)*XNPH + FLY1(NY,NX)=(FLWQBX+FLWQR)*XNPH + HWFLQ1(NY,NX)=(HFLWQA+HFLWQG+HFLWZ)*XNPH + HWFLY1(NY,NX)=(HFLWQB+HFLWQR)*XNPH + FLWZ1(NY,NX)=FLWZ*XNPH + FLWS1(NY,NX)=FLWS*DENSI*XNPH + FLWI1(NY,NX)=FLWI*XNPH + HFLWZ1(NY,NX)=HFLWZ*XNPH + FLSI1(NY,NX)=FLWSI(NY,NX)*XNPH + HFLSI1(NY,NX)=HFLWSI(NY,NX)*XNPH + RFLWV(NY,NX)=1.0E-02*XNPH +C IF(I.EQ.118.AND.NX.EQ.3.AND.NY.EQ.4)THEN +C WRITE(*,4422)'FLQ0W',I,J,FLQ0W(NY,NX),FLWQW +C 2,FLWQR,FLWQGS,FLWQGH,XNPH +C WRITE(*,4422)'FLY',I,J,PRECA(NY,NX),TFLWC(NY,NX),FLY1(NY,NX) +C 2,PSISM1(0,NY,NX),PSISM(0,NY,NX) +C 2,FLQ1(NY,NX),FLH1(NY,NX),FLWQBX,FLWQR +C 2,FLWQAS,FLWQGS,FLWZ,FLWQAH,FLWQGH +C 3,FGRD(NU(NY,NX),NY,NX),FMAC(NU(NY,NX),NY,NX) +C 4,FHOL(L,NY,NX),VOLAH1(L,NY,NX),VOLAH(L,NY,NX) +C 5,FLWQAX,PRECA(NY,NX),TFLWC(NY,NX),FLWQBX,CVRD(NY,NX) +C 6,BARE(NY,NX),TRC0(NY,NX),TVOLW(NY,NX),VOLWG(NY,NX) +C 7,VOLW1(0,NY,NX),VOLWRX(NY,NX) +4422 FORMAT(A8,2I4,40E12.4) +C ENDIF +C +C INITIALIZE PARAMETERS, FLUXES FOR ENERGY EXCHANGE +C AT SNOW, RESIDUE AND SOIL SURFACES +C + RADXW(NY,NX)=RADG(NY,NX)*XNPH + RADXG(NY,NX)=RADXW(NY,NX)*BARE(NY,NX) + RADXR(NY,NX)=RADXW(NY,NX)*CVRD(NY,NX)*XNPR + THRYW(NY,NX)=(THS(NY,NX)*FRADG(NY,NX)+THRMCX(NY,NX))*XNPH + THRYG(NY,NX)=THRYW(NY,NX)*BARE(NY,NX) + THRYR(NY,NX)=THRYW(NY,NX)*CVRD(NY,NX)*XNPR + THRMW(NY,NX)=EMMW*2.04E-10*AREA(3,NU(NY,NX),NY,NX)*XNPH + THRMS(NY,NX)=EMMS*2.04E-10*AREA(3,NU(NY,NX),NY,NX)*XNPH + 2*BARE(NY,NX) + THRMR(NY,NX)=EMMR*2.04E-10*AREA(3,NU(NY,NX),NY,NX)*XNPHR + 2*CVRD(NY,NX) +C +C AERODYNAMIC RESISTANCE OF CANOPY TO SNOW/RESIDUE/SOIL +C SURFACE ENERGY EXCHANGE WITH ATMOSPHERE +C + ALFZ=2.0*(1.0-FRADG(NY,NX)) + IF(RAB(NY,NX).GT.ZERO.AND.ZT(NY,NX).GT.ZS(NY,NX) + 2.AND.ALFZ.GT.ZERO)THEN + RAC(NY,NX)=AMIN1(RACX,AMAX1(0.0,ZT(NY,NX)*EXP(ALFZ) + 2/(ALFZ/RAB(NY,NX))*AMAX1(0.0,EXP(-ALFZ*ZS(NY,NX)/ZT(NY,NX)) + 3-EXP(-ALFZ*(ZD(NY,NX)+ZR(NY,NX))/ZT(NY,NX))))) + UAG=UA(NY,NX)*EXP(-ALFZ) + ELSE + RAC(NY,NX)=0.0 + UAG=UA(NY,NX) + ENDIF + VPQ(NY,NX)=VPA(NY,NX)-1.0*TLEX(NY,NX) + 2/(VAP*AREA(3,NU(NY,NX),NY,NX)) + TKQ(NY,NX)=TKA(NY,NX)-1.0*TSHX(NY,NX) + 2/(1.25E-03*AREA(3,NU(NY,NX),NY,NX)) +C +C AERODYNAMIC RESISTANCE OF RESIDUE AND SOIL +C SURFACE TO ENERGY EXCHANGE WITH ATMOSPHERE +C Soil Sci. Soc. Am. J. 48:25-32 +C + WGSG0(NY,NX)=WGSGW(NY,NX)*XNPH + WGSGR0(NY,NX)=WGSGR(NY,NX)*XNPH + DO 25 L=NU(NY,NX),NL(NY,NX) + IF(POROS(L,NY,NX).GT.0.0)THEN + WFPS=THETW(L,NY,NX)/POROS(L,NY,NX) + ELSE + WFPS=1.0 + ENDIF + FWGWP=AMAX1(1.0,10.0-50.0*WP(L,NY,NX)) + FWGSG=9.5+2.0*WFPS-8.5*EXP(-((FWGWP*WFPS)**3)) + WGSG1(L,NY,NX)=FWGSG*WGSGL(L,NY,NX)*XNPH +25 CONTINUE + RAR(NY,NX)=DLYRR(NY,NX)/WGSGR(NY,NX) + RAG(NY,NX)=RAC(NY,NX)+RAB(NY,NX) + RAGW(NY,NX)=RAG(NY,NX) + RAGR(NY,NX)=RAG(NY,NX)+RARX + RARG(NY,NX)=RAGR(NY,NX) + RAR1=RAR(NY,NX)/AMAX1(ZERO,THETPX(0,NY,NX))**2.33 + RAGS(NY,NX)=RAG(NY,NX)+RAR1 + PARR(NY,NX)=AREA(3,NU(NY,NX),NY,NX)*XNPH/RAGR(NY,NX) + PARG(NY,NX)=AREA(3,NU(NY,NX),NY,NX)*XNPH/RAGS(NY,NX) + PAREG(NY,NX)=AREA(3,NU(NY,NX),NY,NX)*XNPH + PARER(NY,NX)=PAREG(NY,NX)*XNPR*CVRD(NY,NX) + PARSG(NY,NX)=1.25E-03*AREA(3,NU(NY,NX),NY,NX)*XNPH + PARSR(NY,NX)=PARSG(NY,NX)*XNPR*CVRD(NY,NX) +C IF(J.EQ.24)THEN +C WRITE(*,3111)'RAC',I,J,ALFZ,RAC(NY,NX),ZT(NY,NX),RAB(NY,NX) +C 2,RAR(NY,NX),RAR1,PARG(NY,NX),PARR(NY,NX) +C 3,DLYRR(NY,NX),RAG(NY,NX),RAGS(NY,NX),RAGR(NY,NX) +C 4,THETPX(0,NY,NX),WGSGR(NY,NX),VOLW1(0,NY,NX) +C 5,VOLI1(0,NY,NX),VOLP1(0,NY,NX),VOLR(NY,NX),VOLA(0,NY,NX) +C 4,TLEX(NY,NX),TSHX(NY,NX),RADG(NY,NX),THS(NY,NX) +C 5,FRADG(NY,NX),THRMCX(NY,NX),ZS(NY,NX) +3111 FORMAT(A8,2I4,30E12.4) +C ENDIF +9990 CONTINUE +9995 CONTINUE +C +C INITIALIZE SOIL HYDRAULIC PARAMETERS IN LOCAL ARRAYS +C FOR LATER USE IN WATER TRANSFER ALGORITHMS +C + DO 9985 NX=NHW,NHE + DO 9980 NY=NVN,NVS + DO 35 L=NU(NY,NX),NL(NY,NX) + DO 40 N=NCN(NY,NX),3 + TFLXL(N,L,NY,NX)=0.0 + WFLXL(N,L,NY,NX)=0.0 + WFLXLH(N,L,NY,NX)=0.0 + N1=NX + N2=NY + N3=L + IF(N.EQ.1)THEN + IF(NX.EQ.NHE)THEN + GO TO 50 + ELSE + N4=NX+1 + N5=NY + N6=L + ENDIF + ELSEIF(N.EQ.2)THEN + IF(NY.EQ.NVS)THEN + GO TO 50 + ELSE + N4=NX + N5=NY+1 + N6=L + ENDIF + ELSEIF(N.EQ.3)THEN + IF(L.EQ.NL(NY,NX))THEN + GO TO 50 + ELSE + N4=NX + N5=NY + N6=L+1 + ENDIF + ENDIF +C +C MACROPORE CONDUCTIVITY FROM 'HOUR1' AND GRAVITATIONAL +C GRADIENT USED TO CALCULATE MACROPORE FLOW FOR USE BELOW +C + IF(CNDH1(N3,N2,N1).GT.ZERO.AND.CNDH1(N6,N5,N4) + 2.GT.ZERO)THEN + AVCNHL(N,N6,N5,N4)=2.0*CNDH1(N3,N2,N1)*CNDH1(N6,N5,N4) + 2/(CNDH1(N3,N2,N1)*DLYR(N,N6,N5,N4)+CNDH1(N6,N5,N4) + 3*DLYR(N,N3,N2,N1)) + ELSE + AVCNHL(N,N6,N5,N4)=0.0 + ENDIF +50 CONTINUE +40 CONTINUE +35 CONTINUE +9980 CONTINUE +9985 CONTINUE +C +C DYNAMIC LOOP FOR FLUX CALCULATIONS +C + DO 3320 M=1,NPH + DO 9895 NX=NHW,NHE + DO 9890 NY=NVN,NVS + TQR1(NY,NX)=0.0 + THQR1(NY,NX)=0.0 + TQS1(NY,NX)=0.0 + TQW1(NY,NX)=0.0 + TQI1(NY,NX)=0.0 + THQS1(NY,NX)=0.0 +C +C WATER REPELLENCY AND GAS EXCHANGE COEFFICIENTS +C + WRP(0,NY,NX)=1.0/(1.0+(AMAX1(-1.5 + 2,PSISM1(0,NY,NX))/PSISXR)**3) + IF(VOLA(0,NY,NX).GT.VOLI1(0,NY,NX) + 2.AND.VOLP1(0,NY,NX).GT.ZEROS(NY,NX))THEN + THETWA=AMAX1(0.0,AMIN1(1.0 + 2,VOLW1(0,NY,NX)/(VOLA(0,NY,NX)-VOLI1(0,NY,NX)))) + TFND1=(TK1(0,NY,NX)/298.15)**6 + IF(THETWA.GT.Z3R)THEN + DFGS(M,0,NY,NX)=AMAX1(0.0 + 2,TFND1*XNPD/((Z1R**-1)*EXP(Z2RW*(THETWA-Z3R)))) + ELSE + DFGS(M,0,NY,NX)=AMIN1(1.0 + 2,TFND1*XNPD/((Z1R**-1)*EXP(Z2RD*(THETWA-Z3R)))) + ENDIF + 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) + ELSE + THETWT=0.0 + ENDIF + TORT(M,0,NY,NX)=0.7*THETWT**2 + DO 9885 L=NU(NY,NX),NL(NY,NX) + TWFLXL(L,NY,NX)=0.0 + TWFLXH(L,NY,NX)=0.0 + TTFLXL(L,NY,NX)=0.0 + TFLWL(L,NY,NX)=0.0 + TFLWLX(L,NY,NX)=0.0 + TFLWHL(L,NY,NX)=0.0 + THFLWL(L,NY,NX)=0.0 + WRP(L,NY,NX)=1.0/(1.0+(AMAX1(-1.5 + 2,PSISM1(L,NY,NX))/PSISX)**3) + VOLWT=VOLW1(L,NY,NX)+VOLWH1(L,NY,NX) + VOLAT=VOLA(L,NY,NX)+VOLAH(L,NY,NX) + 2-VOLI1(L,NY,NX)-VOLIH1(L,NY,NX) + IF(VOLAT.GT.ZEROS(NY,NX) + 2.AND.VOLP1(L,NY,NX).GT.ZEROS(NY,NX))THEN + THETWA=AMAX1(0.0,AMIN1(1.0,VOLWT/VOLAT)) + TFND1=(TK1(L,NY,NX)/298.15)**6 + Z3S=AMAX1(Z3SX,FC(L,NY,NX)/POROS(L,NY,NX)) + IF(THETWA.GT.Z3S)THEN + DFGS(M,L,NY,NX)=AMAX1(0.0 + 2,TFND1*XNPD/((Z1S**-1)*EXP(Z2SW*(THETWA-Z3S)))) + ELSE + DFGS(M,L,NY,NX)=AMIN1(1.0 + 2,TFND1*XNPD/((Z1S**-1)*EXP(Z2SD*(THETWA-Z3S)))) + ENDIF + ELSE + DFGS(M,L,NY,NX)=0.0 + ENDIF +C IF(L.EQ.NU(NY,NX))THEN +C WRITE(*,3377)'DFGS',I,J,M,NX,NY,L,DFGS(M+1,L,NY,NX) +C 2,XNPD,TFACL,Z1S,Z2S,THETWA,Z3S,Z2S*(THETWA-Z3S) +C 3,EXP(Z2S*(THETWA-Z3S)),Z1S**-1 +C 4,(Z1S**-1)*EXP(Z2S*(THETWA-Z3S)) + THETWT=VOLWM(M,L,NY,NX)/VOLX(L,NY,NX) + TORT(M,L,NY,NX)=0.7*THETWT**2*(1.0-FHOL(L,NY,NX)) + IF(VOLAH(L,NY,NX).GT.ZEROS(NY,NX))THEN + THETWH=VOLWHM(M,L,NY,NX)/VOLAH(L,NY,NX) + TORTH(M,L,NY,NX)=XDIM*AMIN1(1.0,2.8*THETWH**3)*FHOL(L,NY,NX) + ELSE + TORTH(M,L,NY,NX)=0.0 + ENDIF +9885 CONTINUE +C +C REDISTRIBUTE INCOMING MELTWATER OR PRECIPITATION +C BETWEEN RESIDUE AND SOIL SURFACE +C + VOLWRM=AMAX1(0.0,VOLWRX(NY,NX)-VOLW1(0,NY,NX)-VOLI1(0,NY,NX)) + FLWR1=AMAX1(0.0,FLY1(NY,NX)-VOLWRM) + HFLWR1=4.19*TKA(NY,NX)*FLWR1 + FLYM=FLY1(NY,NX)-FLWR1 + HWFLYM=HWFLY1(NY,NX)-HFLWR1 + FLQM=FLQ1(NY,NX)+FLWR1*FGRD(NU(NY,NX),NY,NX) + FLHM=FLH1(NY,NX)+FLWR1*FMAC(NU(NY,NX),NY,NX) + HWFLQM=HWFLQ1(NY,NX)+HFLWR1 +C +C REDISTRIBUTE SURFACE WATER FROM WATER REPELLANCY +C +C FLWPR=FLYM*(1.0-WRP(0,NY,NX)) +C HFLWPR=4.19*TKA(NY,NX)*FLWPR +C FLYM=FLYM-FLWPR +C HWFLYM=HWFLYM-HFLWPR +C FLQM=FLQM+FLWPR*FGRD(NU(NY,NX),NY,NX) +C FLHM=FLHM+FLWPR*FMAC(NU(NY,NX),NY,NX) +C HWFLQM=HWFLQM+HFLWPR +C FLWP1=FLQM*(1.0-WRP(NU(NY,NX),NY,NX)) +C FLQM=FLQM-FLWP1 +C FLHM=FLHM+FLWP1 + FLYM2=FLYM*XNPR + HWFLM2=HWFLYM*XNPR +C IF(NX.EQ.4.AND.NY.EQ.5)THEN +C WRITE(*,3132)'FLWR1',I,J,M,NX,NY,FLY1(NY,NX),FLQ1(NY,NX) +C 2,VHCP0(NY,NX),VHCPWX(NY,NX) +C 2,FLH1(NY,NX),FLYM,FLQM,FLHM,VOLWRM,FLWR1 +C 3,FMAC(NU(NY,NX),NY,NX),FGRD(NU(NY,NX),NY,NX) +C 5,VOLAH(NU(NY,NX),NY,NX),FVOLAH,CCLAY(NU(NY,NX),NY,NX) +C 4,VOLW1(NU(NY,NX),NY,NX),VOLX(NU(NY,NX),NY,NX),WP(L,NY,NX) +C 2,VOLT(NU(NY,NX),NY,NX),VOLAH1(NU(NY,NX),NY,NX) +C 5,VOLWRX(NY,NX),VOLW1(0,NY,NX),VOLI1(0,NY,NX) +C 6,WRP(0,NY,NX),WRP(NU(NY,NX),NY,NX),PSISM1(0,NY,NX) +C 7,PSISM1(NU(NY,NX),NY,NX) +3132 FORMAT(A8,5I4,40E12.4) +C ENDIF +C +C ENERGY EXCHANGE AT SNOW SURFACE IF PRESENT +C + IF(VHCP0(NY,NX).GT.VHCPWX(NY,NX))THEN +C +C PHYSICAL AND HYDRAULIC PROPERTIES OF SNOWPACK INCLUDING +C AIR AND WATER-FILLED POROSITY, WATER POTENTIAL OF UNDERLYING +C SOIL SURFACE USED IN FLUX CALCULATIONS +C + DENSS=AMIN1(0.6,DENS0(NY,NX)+DENS1(NY,NX)*VOLS0(NY,NX) + 2/AREA(3,NU(NY,NX),NY,NX)) + VOLS1(NY,NX)=VOLS0(NY,NX)/DENSS+VOLW0(NY,NX)+VOLI0(NY,NX) + DPTHS0(NY,NX)=VOLS1(NY,NX)/AREA(3,NU(NY,NX),NY,NX) + THETP0=AMAX1(THETPI,1.0-(VOLS0(NY,NX)+VOLI0(NY,NX) + 2+VOLW0(NY,NX))/VOLS1(NY,NX)) + 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))) +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) + 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 + PSISM1(NU(NY,NX),NY,NX)=-EXP(PSIMS(NY,NX) + 2+(((PSL(NU(NY,NX),NY,NX)-LOG(THETW1)) + 3/PSD(NU(NY,NX),NY,NX))**SRP(NU(NY,NX),NY,NX)*PSISD(NY,NX))) + ELSE + PSISM1(NU(NY,NX),NY,NX)=PSISE(NU(NY,NX),NY,NX) + ENDIF +C ELSE +C PSISM1(NU(NY,NX),NY,NX)=PSISE(NU(NY,NX),NY,NX) +C ENDIF + PSISV1=PSISM1(NU(NY,NX),NY,NX)+PSISO(NU(NY,NX),NY,NX) +C +C SNOWPACK ALBEDO, NET RADIATION +C + ALBW=(0.85*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) + RFLX1=(1.0-ALBG)*RADXW(NY,NX)+THRYW(NY,NX) + THRMX=THRMW(NY,NX)*TKW(NY,NX)**4 + RFLX=RFLX1-THRMX +C +C AERODYNAMIC RESISTANCE ABOVE SNOWPACK INCLUDING +C RESISTANCE IMPOSED BY PLANT CANOPY +C + RI=AMAX1(-0.3,AMIN1(0.075,RIB(NY,NX)*(TKQ(NY,NX)-TKW(NY,NX)))) + RAGX=AMAX1(RAM,0.75*RAGW(NY,NX),AMIN1(1.33*RAGW(NY,NX) + 2,RAG(NY,NX)/(1.0-10.0*RI))) + RAGW(NY,NX)=RAGX + RA=RAGX +C +C PARAMETERS FOR CALCULATING LATENT AND SENSIBLE HEAT FLUXES +C + PARE=PAREG(NY,NX)/(RA+RZW) + PARS=PARSG(NY,NX)/RA + TKW1=TK0(NY,NX) + TK11=TK1(NU(NY,NX),NY,NX) + VP0=2.173E-03/TKW1 + 2*0.61*EXP(5360.0*(3.661E-03-1.0/TKW1)) + VP1=2.173E-03/TK11 + 2*0.61*EXP(5360.0*(3.661E-03-1.0/TK11)) + 3*EXP(18.0*PSISV1/(8.3143*TK11)) + EVAPT=PARE*(VPQ(NY,NX)-VP0) + EVAP(NY,NX)=AMAX1(EVAPT,-AMAX1(0.0,VOLW0(NY,NX))) + EVAPX=AMIN1(0.0,EVAPT-EVAP(NY,NX)) + EVAPS(NY,NX)=AMAX1(EVAPX,-AMAX1(0.0,VOLS0(NY,NX))) + EFLX=EVAP(NY,NX)*VAP+EVAPS(NY,NX)*(VAP+333.0) + IF(EVAPT.LT.0.0)THEN + VFLX=(EVAP(NY,NX)*4.19+EVAPS(NY,NX)*2.095)*TK0(NY,NX) + ELSE + VFLX=(EVAP(NY,NX)*4.19+EVAPS(NY,NX)*2.095)*TKQ(NY,NX) + ENDIF +C +C SOLVE FOR SNOWPACK SURFACE TEMPERATURE AT WHICH ENERGY +C BALANCE OCCURS, SOLVE LATENT, SENSIBLE AND STORAGE HEAT FLUXES +C + SFLX=PARS*(TKQ(NY,NX)-TK0(NY,NX)) + HFLW0=RFLX+EFLX+SFLX+VFLX +C +C VAPOR PRESSURES AND CONDUCTIVITY BETWEEN SNOWPACK +C AND SOIL SURFACE +C + CNV0=THETP0**1.33*WGSG0(NY,NX) + CNV1=THETPX(NU(NY,NX),NY,NX)**2/POROQ(NU(NY,NX),NY,NX) + 2*WGSG1(NU(NY,NX),NY,NX) + IF(CNV0.GT.ZERO.AND.CNV1.GT.ZERO)THEN + AVCNV1=2.0*CNV0*CNV1 + 2/(CNV0*DLYR(3,NU(NY,NX),NY,NX)+CNV1*DPTHS0(NY,NX)) + ELSE + AVCNV1=2.0*CNV0 + 2/(DLYR(3,NU(NY,NX),NY,NX)+DPTHS0(NY,NX)) + ENDIF +C +C HEAT AND VAPOR FLUXES BETWEEN SNOWPACK AND SOIL SURFACE +C + TKY=(TK0(NY,NX)*VHCP0(NY,NX)+TK1(NU(NY,NX),NY,NX) + 2*VHCP1(NU(NY,NX),NY,NX))/(VHCP0(NY,NX)+VHCP1(NU(NY,NX),NY,NX)) + HFLWX=(TK0(NY,NX)-TKY)*VHCP0(NY,NX)*FHFLX*XDIM + FLVX=AVCNV1*(VP0-VP1)*AREA(3,NU(NY,NX),NY,NX)*BARE(NY,NX) + IF(FLVX.GE.0.0)THEN + FLV1=AMIN1(FLVX,VOLW0(NY,NX)*XNPH) + IF(HFLWX.GE.0.0)THEN + FLV1=AMIN1(FLV1,HFLWX/(4.19*TK0(NY,NX)+VAP)) + ENDIF + HWFLV1=(4.19*TK0(NY,NX)+VAP)*FLV1 + ELSE + FLV1=AMAX1(FLVX,-VOLW1(NU(NY,NX),NY,NX)*XNPH) + IF(HFLWX.LT.0.0)THEN + FLV1=AMAX1(FLV1,HFLWX/(4.19*TK1(NU(NY,NX),NY,NX)+VAP)) + ENDIF + HWFLV1=(4.19*TK1(NU(NY,NX),NY,NX)+VAP)*FLV1 + ENDIF + IF(VOLS1(NY,NX).GT.ZEROS(NY,NX))THEN + DENSW=(VOLS0(NY,NX)+VOLW0(NY,NX)+VOLI0(NY,NX))/VOLS1(NY,NX) + ELSE + DENSW=DENS0(NY,NX) + ENDIF +C +C J GLACIOL 43:26-41 +C + IF(DENSW.LT.0.156)THEN + TCNDW=8.28E-05+8.42E-04*DENSW + ELSE + TCNDW=4.97E-04-3.64E-03*DENSW+1.16E-02*DENSW**2 + ENDIF + WTHET1=1.467-0.467*THETPY(NU(NY,NX),NY,NX) + TCND1=(STC(NU(NY,NX),NY,NX)+THETWX(NU(NY,NX),NY,NX)*2.067E-03 + 2+0.611*THETIX(NU(NY,NX),NY,NX)*7.844E-03 + 3+WTHET1*THETPX(NU(NY,NX),NY,NX)*9.050E-05) + 4/(DTC(NU(NY,NX),NY,NX)+THETWX(NU(NY,NX),NY,NX) + 5+0.611*THETIX(NU(NY,NX),NY,NX)+WTHET1*THETPX(NU(NY,NX),NY,NX)) + IF(BARE(NY,NX).GT.ZERO)THEN + TCNDW1=TCNDW*XNPH + TCND1W=TCND1*XNPH + ATCND0=2.0*TCNDW1*TCND1W/(TCNDW1*DLYR(3,NU(NY,NX),NY,NX) + 2+TCND1W*DPTHS0(NY,NX))*BARE(NY,NX) + ELSE + ATCND0=0.0 + ENDIF + TK0X=TK0(NY,NX)-HWFLV1/VHCP0(NY,NX) + TK1X=TK1(NU(NY,NX),NY,NX)+HWFLV1/VHCP1(NU(NY,NX),NY,NX) + TKY=(TK0X*VHCP0(NY,NX)+TK1X*VHCP1(NU(NY,NX),NY,NX)) + 2/(VHCP0(NY,NX)+VHCP1(NU(NY,NX),NY,NX)) + HFLWX=(TK0X-TKY)*VHCP0(NY,NX)*FHFLX*XDIM + HFLWC=ATCND0*(TK0X-TK1X)*AREA(3,NU(NY,NX),NY,NX) + IF(HFLWC.GE.0.0)THEN + HFLC01=AMAX1(0.0,AMIN1(HFLWX,HFLWC)) + ELSE + HFLC01=AMIN1(0.0,AMAX1(HFLWX,HFLWC)) + ENDIF +C IF(NX.EQ.4.AND.NY.EQ.4)THEN +C WRITE(*,1113)'EFLX0',I,J,M,NX,NY,RFLX,EFLX,SFLX,VFLX,HFLW0 +C 2,RADXW(NY,NX),THRYW(NY,NX),ALBG,RADG(NY,NX),THS(NY,NX) +C 3,FRADG(NY,NX),THRMCX(NY,NX),TK0(NY,NX) +C 2,TKA(NY,NX),TKQ(NY,NX),VPQ(NY,NX),VP0,VP1,PARE,PARS,EVAPT +C 3,VHCP0(NY,NX),RA,RI,RZ,RAGX,RAGW(NY,NX),RAG(NY,NX),RAB(NY,NX) +C 4,WFLXA(NY,NX),WFLXB(NY,NX),CNV0,PARG(NY,NX),UA(NY,NX),UAG,ALFZ +C 5,THETP0,VOLS0(NY,NX),VOLI0(NY,NX),VOLW0(NY,NX),VOLS1(NY,NX) +C 6,WGSG0(NY,NX),WGSG1(NU(NY,NX),NY,NX),DPTHS0(NY,NX) +C 7,VOLW1(NU(NY,NX),NY,NX),FLQM,FLYM,WMELT +C 8,HWFLQM,HWFLV1,HFLC01,HFLCR1 +C 9,WGSG0(NY,NX),THETPY(NU(NY,NX),NY,NX) +C 1,DENSS(NY,NX),VOLS0(NY,NX),VOLS1(NY,NX),TCNDW +1113 FORMAT(A8,5I4,60E12.4) +C ENDIF +C +C HEAT FLUX BETWEEN SNOWPACK AND SURFACE RESIDUE +C + FLVR=0.0 + HWFLVR=0.0 + FLVS=0.0 + HWFLVS=0.0 + HFLC0R=0.0 + HFLCR1=0.0 + IF(VHCPR1(NY,NX).GT.VHCPRX(NY,NX))THEN + TK0X=TK0(NY,NX) + TKXR=TK1(0,NY,NX) + TK1X=TK1(NU(NY,NX),NY,NX) + CNV01=CNV0*XNPR + CNV11=CNV1*XNPR + CNVR1=THETPX(0,NY,NX)**2/POROQ(0,NY,NX)*WGSGR0(NY,NX)*XNPR + IF(CVRD(NY,NX).GT.ZERO)THEN + IF(CNV01.GT.ZERO.AND.CNVR1.GT.ZERO)THEN + AVCNVR=2.0*CNVR1*CNV01 + 2/(CNV01*DLYRR(NY,NX)+CNVR1*DPTHS0(NY,NX))*CVRD(NY,NX) + ELSE + AVCNVR=2.0*CNV01 + 2/(DLYRR(NY,NX)+DPTHS0(NY,NX))*CVRD(NY,NX) + ENDIF + IF(CNVR1.GT.ZERO.AND.CNV11.GT.ZERO)THEN + AVCNVS=2.0*CNVR1*CNV11 + 2/(CNVR1*DLYR(3,NU(NY,NX),NY,NX)+CNV11*DLYRR(NY,NX))*CVRD(NY,NX) + ELSE + AVCNVS=2.0*CNV11 + 2/(DLYR(3,NU(NY,NX),NY,NX)+DLYRR(NY,NX))*CVRD(NY,NX) + ENDIF + THETRR=AMAX1(0.0,1.0-THETPX(0,NY,NX)-THETWX(0,NY,NX) + 2-THETIX(0,NY,NX)) + TCNDR=(0.779*THETRR*9.050E-04+0.622*THETWX(0,NY,NX) + 2*2.067E-03+0.380*THETIX(0,NY,NX)*7.844E-03+THETPX(0,NY,NX) + 3*9.050E-05)/(0.779*THETRR+0.622*THETWX(0,NY,NX) + 4+0.380*THETIX(0,NY,NX)+THETPX(0,NY,NX)) + IF(TCNDW.GT.ZERO.AND.TCNDR.GT.ZERO)THEN + TCNDW1=TCNDW*XNPHR + TCNDR1=TCNDR*XNPHR + ATCNDR=2.0*TCNDW1*TCNDR1 + 2/(TCNDW1*DLYRR(NY,NX)+TCNDR1*DPTHS0(NY,NX))*CVRD(NY,NX) + ELSE + ATCNDR=0.0 + ENDIF + IF(TCNDR.GT.ZERO.AND.TCND1.GT.ZERO)THEN + TCND11=TCND1*XNPHR + ATCNDS=2.0*TCNDR1*TCND11 + 2/(TCNDR1*DLYR(3,NU(NY,NX),NY,NX)+TCND11*DLYRR(NY,NX))*CVRD(NY,NX) + ELSE + ATCNDS=0.0 + ENDIF + ELSE + AVCNVR=0.0 + AVCNVS=0.0 + ATCNDR=0.0 + ATCNDS=0.0 + ENDIF + DO 4000 N=1,NPR + VP0=2.173E-03/TK0X + 2*0.61*EXP(5360.0*(3.661E-03-1.0/TK0X)) + VPR=2.173E-03/TKXR + 2*0.61*EXP(5360.0*(3.661E-03-1.0/TKXR)) + 3*EXP(18.0*PSISM1(0,NY,NX)/(8.3143*TKXR)) + TKY=(TKXR*VHCPR1(NY,NX)+TK0X*VHCP0(NY,NX)) + 2/(VHCPR1(NY,NX)+VHCP0(NY,NX)) + HFLWX=(TKY-TKXR)*VHCPR1(NY,NX)*FHFLX*XDIM + FLVX=AVCNVR*(VP0-VPR)*AREA(3,NU(NY,NX),NY,NX) + IF(FLVX.GE.0.0)THEN + FLVR1=AMIN1(FLVX,VOLW0(NY,NX)*XNPHR) + IF(HFLWX.GE.0.0)THEN + FLVR1=AMIN1(FLVR1,HFLWX/(4.19*TK0X+VAP)) + ENDIF + HWFLVR1=(4.19*TK0X+VAP)*FLVR1 + ELSE + FLVR1=AMAX1(FLVX,-VOLW1(0,NY,NX)*XNPHR) + IF(HFLWX.LT.0.0)THEN + FLVR1=AMAX1(FLVR1,HFLWX/(4.19*TKXR+VAP)) + ENDIF + HWFLVR1=(4.19*TKXR+VAP)*FLVR1 + ENDIF + TK0X=TK0X-HWFLVR1/VHCP0(NY,NX) + TKXR=TKXR+HWFLVR1/VHCPR1(NY,NX) + TKY=(TKXR*VHCPR1(NY,NX)+TK0X*VHCP0(NY,NX)) + 2/(VHCPR1(NY,NX)+VHCP0(NY,NX)) + HFLWX=(TKY-TKXR)*VHCPR1(NY,NX)*FHFLX*XDIM + HFLWC=ATCNDR*(TK0X-TKXR)*AREA(3,NU(NY,NX),NY,NX) + IF(HFLWC.GE.0.0)THEN + HFLC0R1=AMAX1(0.0,AMIN1(HFLWX,HFLWC)) + ELSE + HFLC0R1=AMIN1(0.0,AMAX1(HFLWX,HFLWC)) + ENDIF + TK0X=TK0X-HFLC0R1/VHCP0(NY,NX) + TKXR=TKXR+HFLC0R1/VHCPR1(NY,NX) +C +C HEAT FLUX BETWEEN SURFACE RESIDUE AND SOIL SURFACE UNDER SNOWPACK +C + VP1=2.173E-03/TK1X + 2*0.61*EXP(5360.0*(3.661E-03-1.0/TK1X)) + 3*EXP(18.0*PSISV1/(8.3143*TK1X)) + TKY=(TKXR*VHCPR1(NY,NX)+TK1X*VHCP1(NU(NY,NX),NY,NX)) + 2/(VHCPR1(NY,NX)+VHCP1(NU(NY,NX),NY,NX)) + HFLWX=(TKXR-TKY)*VHCPR1(NY,NX)*FHFLX*XDIM + FLVX=AVCNVS*(VPR-VP1)*AREA(3,NU(NY,NX),NY,NX) + IF(FLVX.GE.0.0)THEN + FLVS1=AMIN1(FLVX,VOLW1(0,NY,NX)*XNPHR) + IF(HFLWX.GE.0.0)THEN + FLVS1=AMIN1(FLVS1,HFLWX/(4.19*TKXR+VAP)) + ENDIF + HWFLVS1=(4.19*TKXR+VAP)*FLVS1 + ELSE + FLVS1=AMAX1(FLVX,-VOLW1(NU(NY,NX),NY,NX)*XNPHR) + IF(HFLWX.LT.0.0)THEN + FLVS1=AMAX1(FLVS1,HFLWX/(4.19*TK1X+VAP)) + ENDIF + HWFLVS1=(4.19*TK1X+VAP)*FLVS1 + ENDIF + TKXR=TKXR-HWFLVS1/VHCPR1(NY,NX) + TK1X=TK1X+HWFLVS1/VHCP1(NU(NY,NX),NY,NX) + TKY=(TKXR*VHCPR1(NY,NX)+TK1X*VHCP1(NU(NY,NX),NY,NX)) + 2/(VHCPR1(NY,NX)+VHCP1(NU(NY,NX),NY,NX)) + HFLWX=(TKXR-TKY)*VHCPR1(NY,NX)*FHFLX*XDIM + HFLWC=ATCNDS*(TKXR-TK1X)*AREA(3,NU(NY,NX),NY,NX) + IF(HFLWC.GE.0.0)THEN + HFLCR11=AMAX1(0.0,AMIN1(HFLWX,HFLWC)) + ELSE + HFLCR11=AMIN1(0.0,AMAX1(HFLWX,HFLWC)) + ENDIF + TKXR=TKXR-HFLCR11/VHCPR1(NY,NX) + TK1X=TK1X+HFLCR11/VHCP1(NU(NY,NX),NY,NX) + FLVR=FLVR+FLVR1 + HWFLVR=HWFLVR+HWFLVR1 + FLVS=FLVS+FLVS1 + HWFLVS=HWFLVS+HWFLVS1 + HFLC0R=HFLC0R+HFLC0R1 + HFLCR1=HFLCR1+HFLCR11 +C IF(NX.EQ.4.AND.NY.EQ.5)THEN +C WRITE(*,1114)'FLVR0',I,J,M,NX,NY,N,TK0(NY,NX),TK1(0,NY,NX) +C 2,TK1(NU(NY,NX),NY,NX),TK0X,TKXR,TK1X,FLVR1,HWFLVR1,FLVS1 +C 4,HWFLVS1,HFLC0R1,HFLCR11,FLVR,HWFLVR,FLVS,HWFLVS +C 3,HFLC0R,HFLCR1,VPQ(NY,NX),VP0,VPR,VP1,PSISM1(0,NY,NX),PSISV1 +C 5,AVCNVR,ATCNDR,AVCNVS,ATCNDS,VHCP0(NY,NX),VHCPR1(NY,NX) +C 6,VHCP1(NU(NY,NX),NY,NX),DLYRR(NY,NX),DPTHS0(NY,NX),CNV01,CNVR1 +C 7,CNV11,CNV1,THETPX(NU(NY,NX),NY,NX),POROQ(NU(NY,NX),NY,NX) +C 2,WGSG1(NU(NY,NX),NY,NX),CVRD(NY,NX) +1114 FORMAT(A8,6I4,60E12.4) +C ENDIF +4000 CONTINUE + IF(VOLWRX(NY,NX).GT.ZEROS(NY,NX))THEN + THETWR=AMAX1(0.01,AMIN1(1.0,VOLW1(0,NY,NX)/VOLWRX(NY,NX))) + ELSE + THETWR=1.0 + ENDIF + PSISM1(0,NY,NX)=PSISE(0,NY,NX)*THETWR**FPSISR + ELSE + PSISM1(0,NY,NX)=PSISM1(NU(NY,NX),NY,NX) + ENDIF + EVAPR(NY,NX)=0.0 + RFLXR=0.0 + EFLXR=0.0 + VFLXR=0.0 + SFLXR=0.0 +C +C GATHER WATER, VAPOR AND HEAT FLUXES INTO FLUX ARRAYS +C FOR LATER UPDATES TO STATE VARIABLES +C + FLW0S(NY,NX)=FLQ0S(NY,NX)+EVAPS(NY,NX) + FLW0L(NY,NX)=FLQ0W(NY,NX)+EVAP(NY,NX)-FLV1-FLVR + HFLW0L(NY,NX)=HWFLQ0(NY,NX)+HFLW0-HWFLV1-HWFLVR-HFLC01-HFLC0R + FLWL(3,NU(NY,NX),NY,NX)=FLQM+FLV1+FLVS + FLWLX(3,NU(NY,NX),NY,NX)=FLQM+FLV1 + FLWHL(3,NU(NY,NX),NY,NX)=FLHM + HFLWL(3,NU(NY,NX),NY,NX)=HWFLQM+HWFLV1+HWFLVS+HFLC01+HFLCR1 + FLWRL(NY,NX)=FLYM+FLVR-FLVS + HFLWRL(NY,NX)=HWFLYM+HFLC0R-HFLCR1+HWFLVR-HWFLVS + FLWVL(NU(NY,NX),NY,NX)=0.0 + FLWV(NU(NY,NX),NY,NX)=FLWV(NU(NY,NX),NY,NX) + 2+FLWVL(NU(NY,NX),NY,NX) +C IF(NX.EQ.2.AND.NY.EQ.2)THEN +C WRITE(*,7753)'FLW0L',I,J,M,NX,NY,FLW0L(NY,NX) +C 2,FLQ0W(NY,NX),EVAP(NY,NX),FLV1,FLVR,VOLW0(NY,NX) +C 2,FLW0S(NY,NX),FLQ0S(NY,NX),EVAPS(NY,NX) +C 3,EVAPT,PARE,VPQ(NY,NX),VP0,TK0(NY,NX),HFLW0L(NY,NX) +C 4,HWFLQ0(NY,NX),HFLW0,HWFLV1,HWFLVR,HFLC01,HFLC0R +C WRITE(*,7753)'FLWRL',I,J,M,NX,NY,FLWRL(NY,NX) +C 3,PSISM1(0,NY,NX),PSISE(0,NY,NX) +C 2,FLYM,FLVR,FLVS,HFLWRL(NY,NX),VOLW1(0,NY,NX) +C 2,HWFLYM,HFLC0R,HFLCR1,HWFLVR,HWFLVS +7753 FORMAT(A8,5I4,30E12.4) +C ENDIF +C +C FREEZE-THAW IN SNOWPACK FROM NET CHANGE IN SNOWPACK +C HEAT STORAGE +C + TFLX=3.6785E-01*(273.15*(2.095*FLW0S(NY,NX)+4.19*FLW0L(NY,NX)) + 2+VHCP0(NY,NX)*(273.15-TK0(NY,NX))-HFLW0L(NY,NX)) + IF(TFLX.LT.0.0)THEN + TVOLWS=VOLS0(NY,NX)+DENSI*VOLI0(NY,NX) + IF(TVOLWS.GT.ZEROS(NY,NX))THEN + FVOLS0=VOLS0(NY,NX)/TVOLWS + FVOLI0=DENSI*VOLI0(NY,NX)/TVOLWS + ELSE + FVOLS0=0.0 + FVOLI0=0.0 + ENDIF + TFLX0(NY,NX)=AMAX1(-333.0*TVOLWS*XNPH,TFLX) + WFLXA(NY,NX)=-TFLX0(NY,NX)*FVOLS0/333.0 + WFLXB(NY,NX)=-TFLX0(NY,NX)*FVOLI0/333.0 + ELSE + TFLX0(NY,NX)=AMIN1(333.0*VOLW0(NY,NX)*XNPH,TFLX) + WFLXA(NY,NX)=0.0 + WFLXB(NY,NX)=-TFLX0(NY,NX)/333.0 + ENDIF +C +C TOTAL SNOWPACK WATER, VAPOR AND HEAT FLUXES +C + TFLWS(NY,NX)=TFLWS(NY,NX)+FLW0S(NY,NX) + 2-WFLXA(NY,NX)-FLWS1(NY,NX) + TFLWW(NY,NX)=TFLWW(NY,NX)+FLW0L(NY,NX) + 2+WFLXA(NY,NX)+WFLXB(NY,NX)-FLWZ1(NY,NX) + TFLWI(NY,NX)=TFLWI(NY,NX)-WFLXB(NY,NX)/DENSI-FLWI1(NY,NX) + THFLWW(NY,NX)=THFLWW(NY,NX)+HFLW0L(NY,NX)+TFLX0(NY,NX) + 2-HFLWZ1(NY,NX)-HFLSI1(NY,NX) + HTHAWW(NY,NX)=HTHAWW(NY,NX)+TFLX0(NY,NX) + THRMG(NY,NX)=THRMG(NY,NX)+THRMX +C IF(NX.EQ.4.AND.NY.EQ.4)THEN +C WRITE(*,7754)'THFLWW',I,J,M,NX,NY,THFLWW(NY,NX) +C 2,HFLW0L(NY,NX),TFLX0(NY,NX) +C 2,HFLWZ1(NY,NX),HFLSI1(NY,NX) +C ENDIF +C +C ENERGY EXCHANGE AT SOIL SURFACE IF EXPOSED +C + ELSE +C +C PHYSICAL AND HYDRAULIC PROPERTIES OF SOIL SURFACE INCLUDING +C AIR AND WATER-FILLED POROSITY, AND WATER POTENTIAL USED IN +C FLUX CALCULATIONS +C +C IF(BKVL(NU(NY,NX),NY,NX).GT.0.0)THEN + 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) + 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 + PSISM1(NU(NY,NX),NY,NX)=-EXP(PSIMS(NY,NX) + 2+(((PSL(NU(NY,NX),NY,NX)-LOG(THETW1)) + 3/PSD(NU(NY,NX),NY,NX))**SRP(NU(NY,NX),NY,NX)*PSISD(NY,NX))) + ELSE + PSISM1(NU(NY,NX),NY,NX)=PSISE(NU(NY,NX),NY,NX) + ENDIF +C ELSE +C PSISM1(NU(NY,NX),NY,NX)=PSISE(NU(NY,NX),NY,NX) +C ENDIF + PSISV1=PSISM1(NU(NY,NX),NY,NX)+PSISO(NU(NY,NX),NY,NX) +C IF(NX.EQ.4.AND.NY.EQ.5)THEN +C WRITE(*,3232)'PSISV1',I,J,M,NX,NY,NU(NY,NX),PSISV1 +C 2,PSISM1(NU(NY,NX),NY,NX),PSISO(NU(NY,NX),NY,NX) +C 3,THETWX(NU(NY,NX),NY,NX),THETW1,POROS(NU(NY,NX),NY,NX) +C 4,PSL(NU(NY,NX),NY,NX),LOG(THETW1),PSD(NU(NY,NX),NY,NX) +C 5,SRP(NU(NY,NX),NY,NX) +3232 FORMAT(A8,6I4,12E12.4) +C ENDIF +C +C SOIL SURFACE ALBEDO, NET RADIATION +C + VOLWXG=VOLW1(NU(NY,NX),NY,NX)+VOLWH1(NU(NY,NX),NY,NX) + VOLIXG=VOLI1(NU(NY,NX),NY,NX)+VOLIH1(NU(NY,NX),NY,NX) + ALBG=(ALBS(NY,NX)*BKVL(NU(NY,NX),NY,NX)+0.06*VOLWXG + 2+0.30*VOLIXG)/(BKVL(NU(NY,NX),NY,NX)+VOLWXG+VOLIXG) + RFLX1=(1.0-ALBG)*RADXG(NY,NX)+THRYG(NY,NX) + THRMA=THRMS(NY,NX)*TK1(NU(NY,NX),NY,NX)**4 + RFLX=RFLX1-THRMA +C +C AERODYNAMIC RESISTANCE ABOVE SOIL SURFACE INCLUDING +C RESISTANCE IMPOSED BY PLANT CANOPY +C + RAR1=RAR(NY,NX)/AMAX1(THETX,THETPX(0,NY,NX))**2.33 + RAGZ=RAG(NY,NX)+RAR1 + RI=AMAX1(-0.3,AMIN1(0.075,RIB(NY,NX)*(TKQ(NY,NX) + 2-TK1(NU(NY,NX),NY,NX)))) + RAGX=AMAX1(RAM,0.75*RAGS(NY,NX),AMIN1(1.33*RAGS(NY,NX) + 2,RAGZ/(1.0-10.0*RI))) + RAGS(NY,NX)=RAGX + RA=RAGX +C +C PARAMETERS FOR CALCULATING LATENT AND SENSIBLE HEAT FLUXES +C + PARE=PAREG(NY,NX)/(RA+RZ) + PARS=PARSG(NY,NX)/RA + TKX1=TK1(NU(NY,NX),NY,NX) + VP1=2.173E-03/TKX1 + 2*0.61*EXP(5360.0*(3.661E-03-1.0/TKX1)) + 3*EXP(18.0*PSISV1/(8.3143*TKX1)) + EVAP(NY,NX)=AMAX1(PARE*(VPQ(NY,NX)-VP1) + 2,-AMAX1(0.0,VOLW1(NU(NY,NX),NY,NX))*XNPH) + EVAPS(NY,NX)=0.0 + EFLX=EVAP(NY,NX)*VAP + IF(EVAP(NY,NX).LT.0.0)THEN + VFLX=EVAP(NY,NX)*4.19*TK1(NU(NY,NX),NY,NX) + ELSE + VFLX=EVAP(NY,NX)*4.19*TKQ(NY,NX) + ENDIF +C IF(NX.EQ.4.AND.NY.EQ.5)THEN +C WRITE(*,3376)'EVAP',I,J,M,NX,NY,EVAP(NY,NX),RFLX,RFLX1,THRMA +C 3,THETPX(0,NY,NX),VHCPR1(NY,NX),CVRD(NY,NX) +C 2,PARE,VPQ(NY,NX),VP1,RA,RAZ,RAGS(NY,NX),RI,RAR1,RAR(NY,NX),RAGZ +C 3,RAG(NY,NX),RIB(NY,NX),TKX1,PSISV1,VOLW1(NU(NY,NX),NY,NX) +C 4,DLYRR(NY,NX),WGSGR(NY,NX),VOLX(0,NY,NX),ORGC(0,NY,NX) +C 5,VOLA(0,NY,NX),VOLW1(0,NY,NX),VOLI1(0,NY,NX),VOLP1(0,NY,NX) +C ENDIF +C +C SOLVE FOR SOIL SURFACE TEMPERATURE AT WHICH ENERGY +C BALANCE OCCURS, SOLVE LATENT, SENSIBLE AND STORAGE HEAT FLUXES +C + SFLX=PARS*(TKQ(NY,NX)-TK1(NU(NY,NX),NY,NX)) + HFLW1=RFLX+EFLX+SFLX+VFLX +C IF(I.EQ.208)THEN +C WRITE(*,1112)'EFLX',I,J,M,NX,NY,TK1(NU(NY,NX),NY,NX) +C 2,RFLX,EFLX,SFLX,VFLX,HFLW1,RA,RAC(NY,NX),RAG(NY,NX),RAS1,RAGZ,RAR1 +C 3,RAGX,RI,RAGS(NY,NX),VOLW1(NU(NY,NX),NY,NX),VOLI1(NU(NY,NX),NY,NX) +C 4,RADXG(NY,NX),THRYG(NY,NX),THRMA,THRYW(NY,NX),THS(NY,NX) +C 5,BARE(NY,NX),PARG(NY,NX),VPQ(NY,NX),VP1,FRADG(NY,NX),THRMCX(NY,NX) +C 5,PSISM1(NU(NY,NX),NY,NX),PSISO(NU(NY,NX),NY,NX) +C 6,FLQM,EVAP(NY,NX),PARE,HFLW1,PARS,PARSG(NY,NX),HWFLQM +C 7,ATCNDS,TCND1,THETPY(NU(NY,NX),NY,NX),RAR(NY,NX),THETPY(0,NY,NX) +C 8,VHCP1(NU(NY,NX),NY,NX),PARS +C 3,TKQ(NY,NX) +1112 FORMAT(A8,5I4,60E12.4) +C ENDIF +C +C ENERGY BALANCE AT RESIDUE SURFACE +C + IF(VHCPR1(NY,NX).GT.VHCPRX(NY,NX))THEN +C +C PARAMETERS FOR CALCULATING LATENT AND SENSIBLE HEAT FLUXES +C + EVAPR(NY,NX)=0.0 + RFLXR=0.0 + EFLXR=0.0 + VFLXR=0.0 + SFLXR=0.0 + HFLR1=0.0 + FLV1=0.0 + HWFLV1=0.0 + HFLCR1=0.0 + THRMZ=0.0 +C +C NET RADIATION AT RESIDUE SURFACE +C + ALBR=(0.20*BKVL(0,NY,NX)+0.06*VOLW1(0,NY,NX)+0.30 + 2*VOLI1(0,NY,NX))/(BKVL(0,NY,NX)+VOLW1(0,NY,NX)+VOLI1(0,NY,NX)) + RFLX1=(1.0-ALBR)*RADXR(NY,NX)+THRYR(NY,NX) + TKR1=TK1(0,NY,NX) + VOLWR2=VOLW1(0,NY,NX) + VHCPR2=VHCPR1(NY,NX) + TKS1=TK1(NU(NY,NX),NY,NX) + HFLW2=HFLW1*XNPR + VOLW12=VOLW1(NU(NY,NX),NY,NX) + VHCP12=VHCP1(NU(NY,NX),NY,NX) +C +C THERMAL CONDUCTIVITY BETWEEN SURFACE RESIDUE AND SOIL SURFACE +C + CNVR=THETPX(0,NY,NX)**2/POROQ(0,NY,NX)*WGSGR0(NY,NX)*XNPR + CNV1=THETPX(NU(NY,NX),NY,NX)**2/POROQ(NU(NY,NX),NY,NX)*XNPR + 2*WGSG1(NU(NY,NX),NY,NX) + IF(CVRD(NY,NX).GT.ZERO)THEN + IF(CNVR.GT.ZERO.AND.CNV1.GT.ZERO)THEN + AVCNVS=2.0*CNVR*CNV1 + 2/(CNVR*DLYR(3,NU(NY,NX),NY,NX)+CNV1*DLYRR(NY,NX))*CVRD(NY,NX) + ELSE + AVCNVS=2.0*CNVR + 2/(DLYR(3,NU(NY,NX),NY,NX)+DLYRR(NY,NX))*CVRD(NY,NX) + ENDIF + ELSE + AVCNVS=0.0 + ENDIF + THETRR=AMAX1(0.0,1.0-THETPX(0,NY,NX)-THETWX(0,NY,NX) + 2-THETIX(0,NY,NX)) + DTKX=ABS(TK1(0,NY,NX)-TK1(NU(NY,NX),NY,NX))*1.0E-06 + DTHW0=AMAX1(0.0,THETWX(0,NY,NX)-TRBW)**3 + DTHA0=AMAX1(0.0,THETPX(0,NY,NX)-TRBA)**3 + DTHW1=AMAX1(0.0,THETWX(NU(NY,NX),NY,NX)-TRBW)**3 + DTHA1=AMAX1(0.0,THETPX(NU(NY,NX),NY,NX)-TRBA)**3 + RYLXW0=DTKX*DTHW0 + RYLXA0=DTKX*DTHA0 + RYLXW1=DTKX*DTHW1 + RYLXA1=DTKX*DTHA1 + RYLNW0=AMIN1(1.0E+04,RYLXW*RYLXW0) + RYLNA0=AMIN1(1.0E+04,RYLXA*RYLXA0) + RYLNW1=AMIN1(1.0E+04,RYLXW*RYLXW1) + RYLNA1=AMIN1(1.0E+04,RYLXA*RYLXA1) + XNUSW0=AMAX1(1.0,0.68+0.67*RYLNW0**0.25/DNUSW) + XNUSA0=AMAX1(1.0,0.68+0.67*RYLNA0**0.25/DNUSA) + XNUSW1=AMAX1(1.0,0.68+0.67*RYLNW1**0.25/DNUSW) + XNUSA1=AMAX1(1.0,0.68+0.67*RYLNA1**0.25/DNUSA) + TCNDW0=2.067E-03*XNUSW0 + TCNDA0=9.050E-05*XNUSA0 + TCNDW1=2.067E-03*XNUSW1 + TCNDA1=9.050E-05*XNUSA1 + WTHET0=1.467-0.467*THETPY(0,NY,NX) + TCNDR=(0.779*THETRR*9.050E-04+0.622*THETWX(0,NY,NX)*TCNDW0 + 2+0.380*THETIX(0,NY,NX)*7.844E-03 + 3+WTHET0*THETPX(0,NY,NX)*TCNDA0) + 4/(0.779*THETRR+0.622*THETWX(0,NY,NX) + 5+0.380*THETIX(0,NY,NX)+WTHET0*THETPX(0,NY,NX)) + TCNDR1=TCNDR*XNPHR + WTHET1=1.467-0.467*THETPY(NU(NY,NX),NY,NX) + TCND1=(STC(NU(NY,NX),NY,NX)+THETWX(NU(NY,NX),NY,NX)*TCNDW1 + 2+0.611*THETIX(NU(NY,NX),NY,NX)*7.844E-03 + 3+WTHET1*THETPX(NU(NY,NX),NY,NX)*TCNDA1) + 4/(DTC(NU(NY,NX),NY,NX)+THETWX(NU(NY,NX),NY,NX) + 5+0.611*THETIX(NU(NY,NX),NY,NX)+WTHET1*THETPX(NU(NY,NX),NY,NX)) + TCND1R=TCND1*XNPHR + ATCNDR=2.0*TCNDR1*TCND1R/(TCNDR1*DLYR(3,NU(NY,NX),NY,NX) + 2+TCND1R*DLYRR(NY,NX))*CVRD(NY,NX) +C +C SMALLER TIME STEP FOR SOLVING SURFACE RESIDUE ENERGY EXCHANGE +C + DO 5000 N=1,NPR + IF(VHCPR2.GT.VHCPRX(NY,NX))THEN +C +C AERODYNAMIC RESISTANCE ABOVE RESIDUE INCLUDING +C RESISTANCE IMPOSED BY PLANT CANOPY +C + RI=AMAX1(-0.3,AMIN1(0.075,RIB(NY,NX)*(TKQ(NY,NX)-TKR1))) + RAGX=AMAX1(RAM,0.75*RAGR(NY,NX),AMIN1(1.33*RAGR(NY,NX) + 2,RARG(NY,NX)/(1.0-10.0*RI))) + RAGR(NY,NX)=RAGX + RA=RAGX + PARE=PARER(NY,NX)/(RA+RZR) + PARS=PARSR(NY,NX)/RA +C +C NET RADIATION AT RESIDUE SURFACE +C + THRMZ2=THRMR(NY,NX)*TKR1**4 + RFLXR2=RFLX1-THRMZ2 + IF(VOLWRX(NY,NX).GT.ZEROS(NY,NX))THEN + THETWR=AMAX1(0.01,AMIN1(1.0,VOLWR2/VOLWRX(NY,NX))) + ELSE + THETWR=1.0 + ENDIF + PSISM1(0,NY,NX)=PSISE(0,NY,NX)*THETWR**-4.0 +C +C VAPOR FLUX AT RESIDUE SURFACE +C + VPR=2.173E-03/TKR1 + 2*0.61*EXP(5360.0*(3.661E-03-1.0/TKR1)) + 3*EXP(18.0*PSISM1(0,NY,NX)/(8.3143*TKR1)) + VP1=2.173E-03/TKS1 + 2*0.61*EXP(5360.0*(3.661E-03-1.0/TKS1)) + 3*EXP(18.0*PSISV1/(8.3143*TKS1)) + EVAPR2=AMIN1(VOLWRM*XNPHR,AMAX1(-AMAX1(0.0,VOLWR2)*XNPHR + 2,PARE*(VPQ(NY,NX)-VPR))) + EFLXR2=EVAPR2*VAP + VFLXR2=EVAPR2*4.19*TKR1 +C +C SOLVE FOR RESIDUE SURFACE TEMPERATURE AT WHICH ENERGY +C BALANCE OCCURS, SOLVE LATENT, SENSIBLE AND STORAGE HEAT FLUXES +C + TKY=(TKR1*VHCPR2+TKS1*VHCP12)/(VHCPR2+VHCP12) + HFLWX=(TKR1-TKY)*VHCPR2*FHFLX*XDIM + FLVX=AVCNVS*(VPR-VP1)*AREA(3,NU(NY,NX),NY,NX) + IF(FLVX.GE.0.0)THEN + FLV2=AMIN1(FLVX,VOLWR2*XNPHR) + IF(HFLWX.GE.0.0)THEN + FLV2=AMIN1(FLV2,HFLWX/(4.19*TKR1+VAP)) + ENDIF + HWFLV2=(4.19*TKR1+VAP)*FLV2 + ELSE + FLV2=AMAX1(FLVX,-VOLW12*XNPHR) + IF(HFLWX.LT.0.0)THEN + FLV2=AMAX1(FLV2,HFLWX/(4.19*TKS1+VAP)) + ENDIF + HWFLV2=(4.19*TKS1+VAP)*FLV2 + ENDIF + TKXR=TKR1-HWFLV2/VHCPR2 + TK1X=TKS1+HWFLV2/VHCP12 + TKY=(TKXR*VHCPR2+TK1X*VHCP12)/(VHCPR2+VHCP12) + HFLWX=(TKXR-TKY)*VHCPR2*FHFLX*XDIM + HFLWC=ATCNDR*(TKXR-TK1X)*AREA(3,0,NY,NX) + IF(HFLWC.GE.0.0)THEN + HFLCR2=AMAX1(0.0,AMIN1(HFLWX,HFLWC)) + ELSE + HFLCR2=AMIN1(0.0,AMAX1(HFLWX,HFLWC)) + ENDIF + SFLXR2=PARS*(TKQ(NY,NX)-TKR1) + HFLR2=RFLXR2+EFLXR2+SFLXR2+VFLXR2 +C +C AGGREGATE WATER AND ENERGY FLUXES FROM RESIDUE TIME STEP +C TO MODEL TIME STEP +C + EVAPR(NY,NX)=EVAPR(NY,NX)+EVAPR2 + RFLXR=RFLXR+RFLXR2 + EFLXR=EFLXR+EFLXR2 + VFLXR=VFLXR+VFLXR2 + SFLXR=SFLXR+SFLXR2 + HFLR1=HFLR1+HFLR2 + FLV1=FLV1+FLV2 + HWFLV1=HWFLV1+HWFLV2 + HFLCR1=HFLCR1+HFLCR2 + THRMZ=THRMZ+THRMZ2 + ELSE + EVAPR2=0.0 + RFLXR2=0.0 + EFLXR2=0.0 + VFLXR2=0.0 + SFLXR2=0.0 + HFLR2=0.0 + FLV2=0.0 + HWFLV2=0.0 + HFLCR2=0.0 + THRMZ2=0.0 + ENDIF + VOLWR2=VOLWR2+FLYM2+EVAPR2-FLV2 + VOLW12=VOLW12+FLV2 + ENGYR=VHCPR2*TKR1 + VHCPR2=2.496E-06*ORGC(0,NY,NX)+4.19*VOLWR2 + 2+1.9274*VOLI1(0,NY,NX) + VHCP12=VHCP12+4.19*FLV2 + TKR1=(ENGYR+HWFLM2+HFLR2-HWFLV2-HFLCR2)/VHCPR2 + TKS1X=TKS1 + TKS1=TKS1+(HFLW2+HWFLV2+HFLCR2)/VHCP12 +C IF(NX.EQ.1.AND.NY.EQ.6)THEN +C WRITE(*,1111)'EFLXR2',I,J,M,NX,NY,N,TKR1,TKS1,TKQ(NY,NX) +C 2,EFLXR2,SFLXR2,VFLXR2,FLV2,FLVX,VPR,VP1,AVCNVS,PSISE(0,NY,NX) +C 3,PSISM1(0,NY,NX),PSISV1,THETWR,VOLWR2,VOLWRX(NY,NX),TRC0(NY,NX) +C 4,PARS,PARE,RA,RZR,RI,TKQ(NY,NX),VOLWR2,VOLW12,HFLWX,FLV1 +C 5,VOLW1(NU(NY,NX),NY,NX),THRMZ2,VOLW1(0,NY,NX) +C 3,HWFLV2,HFLCR2,HWFLM2,RA,RAGX,RAG(NY,NX),RAB(NY,NX),RAC(NY,NX) +C 4,RZR,RZ,PARS +C 4,RAR1,PARE,VPQ(NY,NX),EVAPR(NY,NX),EVAPR2 +C 5,VHCPR2,VHCP12,CNVR,CNV1,VOLX(0,NY,NX) +C 5,ATCNDR,TCNDR,TCNDR1,TCND1R,DLYR(3,NU(NY,NX),NY,NX) +C 6,DLYRR(NY,NX),DLYR(3,0,NY,NX),POROQ(0,NY,NX),WGSGR(NY,NX) +C 7,THETWX(0,NY,NX),THETIX(0,NY,NX),THETPY(0,NY,NX),ORGC(0,NY,NX) +C 8,CVRD(NY,NX),EFLXR,EFLX,TRA0(NY,NX),ATCNDR*(TKR1-TKS1),TKS1X +1111 FORMAT(A8,6I4,100E12.4) +C ENDIF +5000 CONTINUE +C +C IF NO SURFACE RESIDUE +C + ELSE + TK1(0,NY,NX)=TK1(NU(NY,NX),NY,NX) + EVAPR(NY,NX)=0.0 + RFLXR=0.0 + EFLXR=0.0 + VFLXR=0.0 + SFLXR=0.0 + HFLR1=0.0 + FLV1=0.0 + HWFLV1=0.0 + HFLCR1=0.0 + THRMZ=0.0 + ENDIF +C +C GATHER WATER, VAPOR AND HEAT FLUXES INTO FLUX ARRAYS +C FOR LATER UPDATES TO STATE VARIABLES +C + FLWL(3,NU(NY,NX),NY,NX)=FLQM+EVAP(NY,NX)+FLV1 + FLWLX(3,NU(NY,NX),NY,NX)=FLQM+EVAP(NY,NX)+FLV1 + FLWHL(3,NU(NY,NX),NY,NX)=FLHM + HFLWL(3,NU(NY,NX),NY,NX)=HWFLQM+HFLW1+HWFLV1+HFLCR1 + FLWRL(NY,NX)=FLYM+EVAPR(NY,NX)-FLV1 + HFLWRL(NY,NX)=HWFLYM+HFLR1-HWFLV1-HFLCR1 + FLWVL(NU(NY,NX),NY,NX)=RFLWV(NY,NX)*(VOLW1(NU(NY,NX),NY,NX) + 2-VOLWX1(NU(NY,NX),NY,NX)) + FLWV(NU(NY,NX),NY,NX)=FLWV(NU(NY,NX),NY,NX) + 2+FLWVL(NU(NY,NX),NY,NX) +C IF(NX.EQ.1.AND.NY.EQ.6)THEN +C WRITE(*,3376)'FLW1',I,J,M,NX,NY,FLWL(3,NU(NY,NX),NY,NX) +C 2,PSISM1(0,NY,NX),PSISM1(NU(NY,NX),NY,NX),VOLWRX(NY,NX) +C 3,VOLW1(0,NY,NX),VOLW1(NU(NY,NX),NY,NX),THETWX(NU(NY,NX),NY,NX) +C 2,FLQM,EVAP(NY,NX),PARE,VPQ(NY,NX),VP1 +C 4,FLWRL(NY,NX),FLYM,EVAPR(NY,NX),FLV1 +C WRITE(*,3376)'HFLW1',I,J,M,NX,NY,HFLWL(3,NU(NY,NX),NY,NX) +C 2,HWFLQM,HFLW1,HWFLV1,HFLCR1,HFLWRL(NY,NX),HWFLYM +C 3,HFLR1,HWFLV1,HFLCR1 +3376 FORMAT(A8,5I4,40E12.4) +C ENDIF +C +C HEAT AND WATER TRANSFER WITH RESIDUAL SNOWPACK +C + TFLWS(NY,NX)=TFLWS(NY,NX)+FLQ0S(NY,NX)-FLWS1(NY,NX) + TFLWW(NY,NX)=TFLWW(NY,NX)+FLQ0W(NY,NX)-FLWZ1(NY,NX) + TFLWI(NY,NX)=TFLWI(NY,NX)-FLWI1(NY,NX) + THFLWW(NY,NX)=THFLWW(NY,NX)+HWFLQ0(NY,NX)-HFLWZ1(NY,NX) + 2-HFLSI1(NY,NX) + THRMG(NY,NX)=THRMG(NY,NX)+THRMA+THRMZ +C IF(NX.EQ.4.AND.NY.EQ.4)THEN +C WRITE(*,7754)'THFLWS',I,J,M,NX,NY,THFLWW(NY,NX) +C 2,HWFLQ0(NY,NX),HFLWZ1(NY,NX) +C 2-HFLSI1(NY,NX) +C ENDIF + ENDIF +C +C CAPILLARY EXCHANGE OF WATER BETWEEN SOIL SURFACE AND RESIDUE +C + CNDR=HCNDR(NY,NX)*(PSISE(0,NY,NX)/PSISM1(0,NY,NX))**3 + IF(VOLW1(0,NY,NX).GE.VOLWRX(NY,NX))THEN + CND1=HCND(3,1,NU(NY,NX),NY,NX)*XNPH + ELSE + K1=MAX(1,MIN(100,INT(100.0*(AMAX1(0.0,POROS(NU(NY,NX),NY,NX) + 2-THETWX(NU(NY,NX),NY,NX)))/POROS(NU(NY,NX),NY,NX))+1)) + CND1=HCND(3,K1,NU(NY,NX),NY,NX)*XNPH + ENDIF + AVCND1=2.0*CNDR*CND1/(CNDR*DLYR(3,NU(NY,NX),NY,NX) + 2+CND1*DLYRR(NY,NX)) + FLXQR=AVCND1*(PSISM1(0,NY,NX)-PSISM1(NU(NY,NX),NY,NX)) + 2*AREA(3,NU(NY,NX),NY,NX) + IF(FLXQR.LT.0.0)THEN + FLXSR=AMAX1(FLXQR,-XNPH*AMIN1(VOLW1(NU(NY,NX),NY,NX) + 2,AMAX1(0.0,VOLWRX(NY,NX)-VOLW1(0,NY,NX)-VOLI1(0,NY,NX)))) + ELSE + FLXSR=AMIN1(FLXQR,XNPH*VOLW1(0,NY,NX)) + FLXSR=AMIN1(FLXSR,XNPH*VOLP1(NU(NY,NX),NY,NX)) + ENDIF + IF(FLXSR.GT.0.0)THEN + HFLXSR=4.19*TK1(0,NY,NX)*FLXSR + ELSE + HFLXSR=4.19*TK1(NU(NY,NX),NY,NX)*FLXSR + ENDIF + FLWL(3,NU(NY,NX),NY,NX)=FLWL(3,NU(NY,NX),NY,NX)+FLXSR + HFLWL(3,NU(NY,NX),NY,NX)=HFLWL(3,NU(NY,NX),NY,NX)+HFLXSR + FLWRL(NY,NX)=FLWRL(NY,NX)-FLXSR + HFLWRL(NY,NX)=HFLWRL(NY,NX)-HFLXSR + FLWRM(M,NY,NX)=FLXSR +C IF(NX.EQ.1.AND.NY.EQ.6)THEN +C WRITE(*,4322)'FLWLY',I,J,M,NX,NY,FLWRL(NY,NX),FLWLY,FLWLYR +C 2,FLWLYH,FLXSR,VOLX(NU(NY,NX),NY,NX),VOLA(NU(NY,NX),NY,NX) +C 3,VOLP1(NU(NY,NX),NY,NX),VOLW1(NU(NY,NX),NY,NX) +C 3,VOLI1(NU(NY,NX),NY,NX),VOLP1(0,NY,NX),VOLW1(0,NY,NX) +C 3,VOLI1(0,NY,NX),FLXQR,PSISM1(0,NY,NX) +C 4,PSISM1(NU(NY,NX),NY,NX),AVCND1 +C 2,VOLAH1(NU(NY,NX),NY,NX),VOLPH1(NU(NY,NX),NY,NX) +C 2,VOLWH1(NU(NY,NX),NY,NX),VOLIH1(NU(NY,NX),NY,NX) +4322 FORMAT(A8,5I4,40E12.4) +C ENDIF +C +C MOVE WATER UP DURING PRECIPITATION OR FREEZING +C + IF(VOLW1(NU(NY,NX),NY,NX)+VOLI1(NU(NY,NX),NY,NX) + 2.GT.VOLA(NU(NY,NX),NY,NX))THEN + FLWLY=AMIN1(0.0,AMAX1(-XNPH*VOLW1(NU(NY,NX),NY,NX) + 2,VOLA(NU(NY,NX),NY,NX)-VOLW1(NU(NY,NX),NY,NX) + 3-VOLI1(NU(NY,NX),NY,NX))) + HFLWLY=FLWLY*4.19*TK1(NU(NY,NX),NY,NX) + FLWL(3,NU(NY,NX),NY,NX)=FLWL(3,NU(NY,NX),NY,NX)+FLWLY + HFLWL(3,NU(NY,NX),NY,NX)=HFLWL(3,NU(NY,NX),NY,NX)+HFLWLY + FLWLYR=AMIN1(0.0,FLWLY+VOLPH1(NU(NY,NX),NY,NX)) + HFLWYR=FLWLYR*4.19*TK1(NU(NY,NX),NY,NX) + FLWLYH=FLWLY-FLWLYR + HFLWYH=FLWLYH*4.19*TK1(NU(NY,NX),NY,NX) + FLWRL(NY,NX)=FLWRL(NY,NX)-FLWLYR + HFLWRL(NY,NX)=HFLWRL(NY,NX)-HFLWYR + FLWHL(3,NU(NY,NX),NY,NX)=FLWHL(3,NU(NY,NX),NY,NX)-FLWLYH + HFLWL(3,NU(NY,NX),NY,NX)=HFLWL(3,NU(NY,NX),NY,NX)-HFLWYH + ENDIF + IF(VOLWH1(NU(NY,NX),NY,NX)+VOLIH1(NU(NY,NX),NY,NX) + 2.GT.VOLAH1(NU(NY,NX),NY,NX))THEN + FLWHY=AMIN1(0.0,AMAX1(-XNPH*VOLWH1(NU(NY,NX),NY,NX) + 2,VOLAH1(NU(NY,NX),NY,NX)-VOLWH1(NU(NY,NX),NY,NX) + 3-VOLIH1(NU(NY,NX),NY,NX))) + HFLWHY=FLWHY*4.19*TK1(NU(NY,NX),NY,NX) + FLWHL(3,NU(NY,NX),NY,NX)=FLWHL(3,NU(NY,NX),NY,NX)+FLWHY + HFLWL(3,NU(NY,NX),NY,NX)=HFLWL(3,NU(NY,NX),NY,NX)+HFLWHY + FLWRL(NY,NX)=FLWRL(NY,NX)-FLWHY + HFLWRL(NY,NX)=HFLWRL(NY,NX)-HFLWHY +C IF(NX.EQ.1.AND.NY.EQ.6)THEN +C WRITE(*,4324)'FLWHY',I,J,M,NX,NY,FLWRL(NY,NX),FLWHY +C 2,VOLAH1(NU(NY,NX),NY,NX),VOLPH1(NU(NY,NX),NY,NX) +C 2,VOLWH1(NU(NY,NX),NY,NX),VOLIH1(NU(NY,NX),NY,NX) +C 2,VOLAH1(NU(NY,NX)+1,NY,NX),VOLPH1(NU(NY,NX)+1,NY,NX) +C 2,VOLWH1(NU(NY,NX)+1,NY,NX),VOLIH1(NU(NY,NX)+1,NY,NX) +C 3,VOLW1(0,NY,NX) +4324 FORMAT(A8,5I4,30E12.4) +C ENDIF + ENDIF +C IF((I/10)*10.EQ.I)THEN +C WRITE(*,4321)'HCNDR',I,J,M,NX,NY,K1,AVCND1,CNDR,CND1,DLYRR(NY,NX) +C 2,PSISM1(0,NY,NX),PSISM1(NU(NY,NX),NY,NX),FLXQR,FLXSR,HFLXSR +C 3,VOLWR2,TRA0(NY,NX),EVAPR(NY,NX),VOLWRX(NY,NX)-VOLW1(0,NY,NX) +C 2-VOLI1(0,NY,NX),VOLW1(NU(NY,NX),NY,NX),VOLW1(0,NY,NX) +C 4,VOLP1(NU(NY,NX),NY,NX),POROS(NU(NY,NX),NY,NX) +C 5,VOLWG(NY,NX),FLYM,HCNDR(NY,NX),PSISE(0,NY,NX),PSISM1(0,NY,NX) +C 6,THETWR,VHCPR1(NY,NX),VHCPRX(NY,NX) +4321 FORMAT(A8,6I4,30E12.4) +C ENDIF +C +C OVERLAND FLOW INTO MACROPORES WHEN WATER STORAGE CAPACITY +C OF THE SOIL SURFACE IS EXCEEDED +C + IF(VOLPH1(NU(NY,NX),NY,NX).GT.0.0)THEN + IF(VOLW1(0,NY,NX).GT.VOLWRX(NY,NX))THEN + AVCNH1=2.0*CNDH1(NU(NY,NX),NY,NX)/DLYR(3,NU(NY,NX),NY,NX) + FLWHX=AVCNH1*0.0098*DPTH(NU(NY,NX),NY,NX)*AREA(3,NU(NY,NX),NY,NX) + FINHR=AMIN1(VOLPH1(NU(NY,NX),NY,NX) + 2,VOLW1(0,NY,NX)-VOLWRX(NY,NX),FLWHX) + HFINHR=FINHR*4.19*TK1(0,NY,NX) + FLWRL(NY,NX)=FLWRL(NY,NX)-FINHR + HFLWRL(NY,NX)=HFLWRL(NY,NX)-HFINHR + FLWHL(3,NU(NY,NX),NY,NX)=FLWHL(3,NU(NY,NX),NY,NX)+FINHR + HFLWL(3,NU(NY,NX),NY,NX)=HFLWL(3,NU(NY,NX),NY,NX)+HFINHR +C IF(NX.EQ.1.AND.NY.EQ.6)THEN +C WRITE(*,4357)'FINHR',I,J,M,NX,NY,FLWRL(NY,NX),FINHR +C 2,VOLPH1(NU(NY,NX),NY,NX),TVOLW(NY,NX),FLWHX,VOLW1(0,NY,NX) +C 3,VOLWRX(NY,NX),FLWHL(3,NU(NY,NX),NY,NX) +C 4,HFINHR,TK1(0,NY,NX),HFLWRL(NY,NX),HFLWL(3,NU(NY,NX),NY,NX) +4357 FORMAT(A8,5I4,40E12.4) +C ENDIF + ENDIF + ENDIF +C +C FREEZE-THAW IN RESIDUE SURFACE FROM NET CHANGE IN RESIDUE +C SURFACE HEAT STORAGE +C + TFREEZ=-9.0959E+04/(PSISM1(0,NY,NX)-333.0) + IF((TK1(0,NY,NX).LT.TFREEZ + 2.AND.VOLW1(0,NY,NX).GT.ZERO*VOLA(0,NY,NX)) + 3.OR.(TK1(0,NY,NX).GT.TFREEZ + 4.AND.VOLI1(0,NY,NX).GT.ZERO*VOLA(0,NY,NX)))THEN + TFLX1=1.0/(1.0+TFREEZ*6.2913E-03) + 2*(TFREEZ*4.19*FLWRL(NY,NX) + 3+VHCPR1(NY,NX)*(TFREEZ-TK1(0,NY,NX)) + 4-HFLWRL(NY,NX)) + IF(TFLX1.LT.0.0)THEN + TFLX=AMAX1(-333.0*DENSI*VOLI1(0,NY,NX)*XNPH,TFLX1) + ELSE + TFLX=AMIN1(333.0*VOLW1(0,NY,NX)*XNPH,TFLX1) + ENDIF + WFLX=-TFLX/333.0 + IF(WFLX.GT.0.0.AND.VOLI1(0,NY,NX) + 2.GT.ZEROS(NY,NX))THEN + WFLXR(NY,NX)=WFLX + TFLXR(NY,NX)=TFLX + ELSEIF(WFLX.LT.0.0.AND.VOLW1(0,NY,NX) + 2.GT.ZEROS(NY,NX))THEN + WFLXR(NY,NX)=WFLX + TFLXR(NY,NX)=TFLX + ELSE + WFLXR(NY,NX)=0.0 + TFLXR(NY,NX)=0.0 + ENDIF + ELSE + WFLXR(NY,NX)=0.0 + TFLXR(NY,NX)=0.0 + ENDIF +C WRITE(*,5352)'TFLXR',I,J,M,WFLXR(NY,NX),TFLXR(NY,NX) +C 2,PSISV0,THETWR,TFLX,WFLX,VOLI1(0,NY,NX),VOLW1(0,NY,NX) +C 3,TKXR,TFREEZ,PSISV0 +5352 FORMAT(A8,3I4,20E12.4) +C +C FREEZE-THAW IN SOIL SURFACE MICROPORE FROM NET CHANGE IN SOIL +C SURFACE HEAT STORAGE +C + TFREEZ=-9.0959E+04/(PSISV1-333.0) + IF((TK1(NU(NY,NX),NY,NX).LT.TFREEZ + 2.AND.VOLW1(NU(NY,NX),NY,NX).GT.ZERO*VOLA(NU(NY,NX),NY,NX) + 3.AND.VOLI1(NU(NY,NX),NY,NX).LT.VOLA(NU(NY,NX),NY,NX)) + 4.OR.(TK1(NU(NY,NX),NY,NX).GT.TFREEZ + 5.AND.VOLI1(NU(NY,NX),NY,NX).GT.ZERO*VOLA(NU(NY,NX),NY,NX)))THEN + TFLX1=FGRD(NU(NY,NX),NY,NX)*(1.0/(1.0+TFREEZ*6.2913E-03) + 2*(TFREEZ*4.19*(FLWL(3,NU(NY,NX),NY,NX)+FLWHL(3,NU(NY,NX),NY,NX)) + 3+VHCP1(NU(NY,NX),NY,NX)*(TFREEZ-TK1(NU(NY,NX),NY,NX)) + 4-HFLWL(3,NU(NY,NX),NY,NX))) + IF(TFLX1.LT.0.0)THEN + TFLX=AMAX1(-333.0*DENSI*VOLI1(NU(NY,NX),NY,NX)*XNPH,TFLX1) + ELSE + TFLX=AMIN1(333.0*VOLW1(NU(NY,NX),NY,NX)*XNPH,TFLX1) + ENDIF + WFLX=-TFLX/333.0 + IF(WFLX.GT.0.0.AND.VOLI1(NU(NY,NX),NY,NX) + 2.GT.ZEROS(NY,NX))THEN + WFLXL(3,NU(NY,NX),NY,NX)=WFLX + ELSEIF(WFLX.LT.0.0.AND.VOLW1(NU(NY,NX),NY,NX) + 2.GT.ZEROS(NY,NX))THEN + WFLXL(3,NU(NY,NX),NY,NX)=WFLX + ELSE + TFLX=0.0 + WFLXL(3,NU(NY,NX),NY,NX)=0.0 + ENDIF + ELSE + TFLX=0.0 + WFLXL(3,NU(NY,NX),NY,NX)=0.0 + ENDIF +C +C FREEZE-THAW IN SOIL SURFACE MACROPORE FROM NET CHANGE IN SOIL +C SURFACE HEAT STORAGE +C + IF((TK1(NU(NY,NX),NY,NX).LT.273.15.AND.VOLWH1(NU(NY,NX),NY,NX) + 2.GT.ZERO*VOLT(NU(NY,NX),NY,NX)).OR.(TK1(NU(NY,NX),NY,NX) + 3.GT.273.15.AND.VOLIH1(NU(NY,NX),NY,NX) + 4.GT.ZERO*VOLT(NU(NY,NX),NY,NX)))THEN + TFLX1=FMAC(NU(NY,NX),NY,NX)*(1.0/(1.0+273.15*6.2913E-03) + 2*(273.15*4.19*(FLWL(3,NU(NY,NX),NY,NX)+FLWHL(3,NU(NY,NX),NY,NX)) + 3+VHCP1(NU(NY,NX),NY,NX)*(273.15-TK1(NU(NY,NX),NY,NX)) + 4-HFLWL(3,NU(NY,NX),NY,NX))) + IF(TFLX1.LT.0.0)THEN + TFLXH=AMAX1(-333.0*DENSI*VOLIH1(NU(NY,NX),NY,NX)*XNPH,TFLX1) + ELSE + TFLXH=AMIN1(333.0*VOLWH1(NU(NY,NX),NY,NX)*XNPH,TFLX1) + ENDIF + WFLXH=-TFLXH/333.0 + IF(WFLXH.GT.0.0.AND.VOLIH1(NU(NY,NX),NY,NX) + 2.GT.ZEROS(NY,NX))THEN + WFLXLH(3,NU(NY,NX),NY,NX)=WFLXH + ELSEIF(WFLXH.LT.0.0.AND.VOLWH1(NU(NY,NX),NY,NX) + 2.GT.ZEROS(NY,NX))THEN + WFLXLH(3,NU(NY,NX),NY,NX)=WFLXH + ELSE + TFLXH=0.0 + WFLXLH(3,NU(NY,NX),NY,NX)=0.0 + ENDIF + ELSE + TFLXH=0.0 + WFLXLH(3,NU(NY,NX),NY,NX)=0.0 + ENDIF + TFLXL(3,NU(NY,NX),NY,NX)=TFLX+TFLXH +C IF(NY.EQ.1)THEN +C WRITE(*,4358)'TFLX',I,J,M,TFREEZ,TK1(NU(NY,NX),NY,NX),PSISV1 +C 2,TFLX,TFLXH,TFLXL(3,NU(NY,NX),NY,NX),WFLX,WFLXH +C 2,WFLXL(3,NU(NY,NX),NY,NX),WFLXLH(3,NU(NY,NX),NY,NX) +C 4,VOLW1(NU(NY,NX),NY,NX),VOLWH1(NU(NY,NX),NY,NX) +C 4,VOLI1(NU(NY,NX),NY,NX),VOLIH1(NU(NY,NX),NY,NX) +C 5,FGRD(NU(NY,NX),NY,NX),FMAC(NU(NY,NX),NY,NX) +4358 FORMAT(A8,3I4,20E12.4) +C ENDIF +C +C +C THICKNESS OF WATER FILMS FOR GAS EXCHANGE IN 'TRNSFR' +C + IF(VHCPR1(NY,NX).GT.VHCPRX(NY,NX))THEN + FILM(M,0,NY,NX)=AMAX1(1.0E-06 + 2,EXP(-13.650-0.857*LOG(-PSISM1(0,NY,NX)))) + ELSE + FILM(M,0,NY,NX)=1.0E-03 + ENDIF +C IF(BKVL(NU(NY,NX),NY,NX).GT.0.0)THEN + FILM(M,NU(NY,NX),NY,NX)=AMAX1(1.0E-06 + 2,EXP(-13.650-0.857*LOG(-PSISM1(NU(NY,NX),NY,NX)))) +C ELSE +C FILM(M,NU(NY,NX),NY,NX)=DLYR(3,NU(NY,NX),NY,NX) +C ENDIF +C +C OVERLAND FLOW WHEN WATER STORAGE CAPACITY +C OF THE SOIL SURFACE PLUS MACROPORES IS EXCEEDED +C + N1=NX + N2=NY + TVOLZ1=AMAX1(0.0,VOLW1(0,N2,N1)+VOLI1(0,N2,N1)-VOLWRX(N2,N1)) + VOLWZ1=AMAX1(0.0,VOLW1(0,N2,N1)-VOLWRX(N2,N1)) +C +C LOCATE INTERNAL BOUNDARIES BETWEEN ADJACENT GRID CELLS +C + DO 4310 N=1,2 + IF(N.EQ.1)THEN + IF(NX.EQ.NHE)THEN + GO TO 4310 + ELSE + N4=NX+1 + N5=NY + WDTH=DLYR(2,NU(NY,NX),NY,NX) + ENDIF + ELSEIF(N.EQ.2)THEN + IF(NY.EQ.NVS)THEN + GO TO 4310 + ELSE + N4=NX + N5=NY+1 + WDTH=DLYR(1,NU(NY,NX),NY,NX) + ENDIF + ENDIF +C +C ELEVATION OF EACH PAIR OF ADJACENT GRID CELLS +C + TVOLZ2=AMAX1(0.0,VOLW1(0,N5,N4)+VOLI1(0,N5,N4)-VOLWRX(N5,N4)) + VOLWZ2=AMAX1(0.0,VOLW1(0,N5,N4)-VOLWRX(N5,N4)) + ALT1=ALTG(N2,N1)+TVOLZ1/AREA(3,NU(N2,N1),N2,N1) + ALT2=ALTG(N5,N4)+TVOLZ2/AREA(3,NU(N5,N4),N5,N4) +C +C EXCESS SURFACE WATER DEPTH, WETTED PERIMETER, SLOPE, VELOCITY +C + IF(ALT1.GT.ALT2.AND.TVOLZ1.GT.VOLWG(N2,N1))THEN + QRX1=TVOLZ1-VOLWG(N2,N1) + D=QRX1/AREA(3,NU(N2,N1),N2,N1) + R=D/2.828 + S=(ALT1-ALT2)/DIST(N,NU(N5,N4),N5,N4) + V=R**0.67*SQRT(S)/ZM(N2,N1) +C +C RUNOFF +C + Q=V*D*AMIN1(1.0,D/ZS(N2,N1))*WDTH*3.6E+03*XNPH + QRQ1=AMAX1(0.0,((ALT1-ALT2)*AREA(3,NU(N2,N1),N2,N1) + 2*AREA(3,NU(N5,N4),N5,N4)-TVOLZ2*AREA(3,NU(N2,N1),N2,N1) + 3+TVOLZ1*AREA(3,NU(N5,N4),N5,N4)) + 4/(AREA(3,NU(N2,N1),N2,N1)+AREA(3,NU(N5,N4),N5,N4))) + QR1(N,N5,N4)=AMIN1(Q,0.25*QRQ1,0.25*QRX1)*VOLWZ1/TVOLZ1 + HQR1(N,N5,N4)=4.19*TK1(0,N2,N1)*QR1(N,N5,N4) +C +C EXCESS SURFACE WATER DEPTH, WETTED PERIMETER, SLOPE, VELOCITY +C + ELSEIF(ALT1.LT.ALT2.AND.TVOLZ2.GT.VOLWG(N5,N4))THEN + QRX1=TVOLZ2-VOLWG(N5,N4) + D=QRX1/AREA(3,NU(N5,N4),N5,N4) + R=D/2.828 + S=(ALT2-ALT1)/DIST(N,NU(N5,N4),N5,N4) + V=R**0.67*SQRT(S)/ZM(N5,N4) +C +C RUNON +C + Q=V*D*AMIN1(1.0,D/ZS(N5,N4))*DLYR(N,NU(N5,N4),N5,N4) + 2*3.6E+03*XNPH + QRQ1=AMIN1(0.0,((ALT1-ALT2)*AREA(3,NU(N2,N1),N2,N1) + 2*AREA(3,NU(N5,N4),N5,N4)-TVOLZ2*AREA(3,NU(N2,N1),N2,N1) + 3+TVOLZ1*AREA(3,NU(N5,N4),N5,N4)) + 4/(AREA(3,NU(N2,N1),N2,N1)+AREA(3,NU(N5,N4),N5,N4))) + QR1(N,N5,N4)=AMAX1(-Q,0.25*QRQ1,-0.25*QRX1)*VOLWZ2/TVOLZ2 + HQR1(N,N5,N4)=4.19*TK1(0,N5,N4)*QR1(N,N5,N4) + ELSE + QR1(N,N5,N4)=0.0 + HQR1(N,N5,N4)=0.0 + V=0.0 + ENDIF + QR(N,N5,N4)=QR(N,N5,N4)+QR1(N,N5,N4) + HQR(N,N5,N4)=HQR(N,N5,N4)+HQR1(N,N5,N4) + QRM(M,N,N5,N4)=QR1(N,N5,N4) + QRV(M,N,N5,N4)=V +C IF(I.EQ.186)THEN +C WRITE(*,5555)'QR1',I,J,M,N1,N2,N4,N5,N,QR1(N,N5,N4) +C 2,ALT1,ALT2,ALTG(N2,N1),ALTG(N5,N4),QRX1,D,R,S,V,Q,QRQ1 +C 2,VOLW1(0,N2,N1),VOLI1(0,N2,N1) +C 3,VOLW1(0,N5,N4),VOLI1(0,N5,N4) +C 4,VOLWZ1,VOLWZ2,TVOLZ1,TVOLZ2,VOLWG(N2,N1),VOLWG(N5,N4) +C 5,QR(N,N5,N4),TVOLW(N5,N4),FVOLW2,FVOLH2 +C 6,DIST(N,NU(N5,N4),N5,N4) +5555 FORMAT(A8,8I4,30E12.4) +C ENDIF +C +C SNOW REDISTRIBUTION +C + ALTS1=ALTG(N2,N1)+DPTHS0(N2,N1) + ALTS2=ALTG(N5,N4)+DPTHS0(N5,N4) + SS=(ALTS1-ALTS2)/DIST(N,NU(N5,N4),N5,N4) + QSX=FQSM*SS/AMAX1(1.0,DIST(N,NU(N5,N4),N5,N4)**2) + IF(SS.GT.0.0.AND.DPTHS0(N2,N1).GT.DPTHSX)THEN + QS1(N,N5,N4)=QSX*VOLS0(N2,N1) + QW1(N,N5,N4)=QSX*VOLW0(N2,N1) + QI1(N,N5,N4)=QSX*VOLI0(N2,N1) + HQS1(N,N5,N4)=TK0(N2,N1)*(2.095*QS1(N,N5,N4) + 2+4.19*QW1(N,N5,N4)+1.9274*QI1(N,N5,N4)) + ELSEIF(SS.LT.0.0.AND.DPTHS0(N5,N4).GT.DPTHSX)THEN + QS1(N,N5,N4)=QSX*VOLS0(N5,N4) + QW1(N,N5,N4)=QSX*VOLW0(N5,N4) + QI1(N,N5,N4)=QSX*VOLI0(N5,N4) + HQS1(N,N5,N4)=TK0(N5,N4)*(2.095*QS1(N,N5,N4) + 2+4.19*QW1(N,N5,N4)+1.9274*QI1(N,N5,N4)) + ELSE + QS1(N,N5,N4)=0.0 + QW1(N,N5,N4)=0.0 + QI1(N,N5,N4)=0.0 + HQS1(N,N5,N4)=0.0 + ENDIF + QS(N,N5,N4)=QS(N,N5,N4)+QS1(N,N5,N4) + QW(N,N5,N4)=QW(N,N5,N4)+QW1(N,N5,N4) + QI(N,N5,N4)=QI(N,N5,N4)+QI1(N,N5,N4) + HQS(N,N5,N4)=HQS(N,N5,N4)+HQS1(N,N5,N4) + QSM(M,N,N5,N4)=QS1(N,N5,N4) +C IF(NX.EQ.2.AND.NY.EQ.5)THEN +C WRITE(*,5556)'QS1',I,J,M,N1,N2,N4,N5,N,QSX,QS1(N,N5,N4) +C 2,QW1(N,N5,N4),QI1(N,N5,N4),VOLS0(N2,N1),VOLW0(N2,N1) +C 3,VOLI0(N2,N1),ALTS1,ALTS2,ALTG(N2,N1),ALTG(N5,N4) +C 4,DIST(N,NU(N5,N4),N5,N4),SS,DPTHS0(N2,N1),DPTHS0(N5,N4) +C 5,VOLS1(N2,N1),VOLS1(N5,N4),VOLWG(N2,N1),VOLWG(N5,N4) +5556 FORMAT(A8,8I4,30E12.4) +C ENDIF +4310 CONTINUE +C +C TOTAL WATER, VAPOR AND HEAT FLUXES THROUGH SURFACE RESIDUE +C AND SOIL SURFACE +C + THAWR(NY,NX)=THAWR(NY,NX)+WFLXR(NY,NX) + HTHAWR(NY,NX)=HTHAWR(NY,NX)+TFLXR(NY,NX) + THAW(3,NU(NY,NX),NY,NX)=THAW(3,NU(NY,NX),NY,NX) + 2+WFLXL(3,NU(NY,NX),NY,NX) + THAWH(3,NU(NY,NX),NY,NX)=THAWH(3,NU(NY,NX),NY,NX) + 2+WFLXLH(3,NU(NY,NX),NY,NX) + HTHAW(3,NU(NY,NX),NY,NX)=HTHAW(3,NU(NY,NX),NY,NX) + 2+TFLXL(3,NU(NY,NX),NY,NX) + FLW(3,NU(NY,NX),NY,NX)=FLW(3,NU(NY,NX),NY,NX) + 2+FLWL(3,NU(NY,NX),NY,NX) + FLWX(3,NU(NY,NX),NY,NX)=FLWX(3,NU(NY,NX),NY,NX) + 2+FLWLX(3,NU(NY,NX),NY,NX) + FLWH(3,NU(NY,NX),NY,NX)=FLWH(3,NU(NY,NX),NY,NX) + 2+FLWHL(3,NU(NY,NX),NY,NX) + HFLW(3,NU(NY,NX),NY,NX)=HFLW(3,NU(NY,NX),NY,NX) + 2+HFLWL(3,NU(NY,NX),NY,NX) + FLWR(NY,NX)=FLWR(NY,NX)+FLWRL(NY,NX) + HFLWR(NY,NX)=HFLWR(NY,NX)+HFLWRL(NY,NX) + HEATI(NY,NX)=HEATI(NY,NX)+RFLX+RFLXR + HEATS(NY,NX)=HEATS(NY,NX)+SFLX+SFLXR + HEATE(NY,NX)=HEATE(NY,NX)+EFLX+EFLXR + HEATV(NY,NX)=HEATV(NY,NX)+VFLX+VFLXR + HEATH(NY,NX)=HEATH(NY,NX)+RFLX+RFLXR + 2+SFLX+SFLXR+EFLX+EFLXR+VFLX+VFLXR + TEVAPG(NY,NX)=TEVAPG(NY,NX)+EVAP(NY,NX)+EVAPS(NY,NX)+EVAPR(NY,NX) + VOLWX1(NU(NY,NX),NY,NX)=VOLW1(NU(NY,NX),NY,NX) + HYSM(M,NU(NY,NX),NY,NX)=HYST(NU(NY,NX),NY,NX) + FLWM(M,3,NU(NY,NX),NY,NX)=FLWL(3,NU(NY,NX),NY,NX) + FLWHM(M,3,NU(NY,NX),NY,NX)=FLWHL(3,NU(NY,NX),NY,NX) +C +C DELAYED MIGRATION OF PRECIPITATION OR MELTWATER INTO MICROPORES +C + IF(FLQM.GT.0.0.AND.VOLPX1(NU(NY,NX),NY,NX).GT.ZEROS(NY,NX) + 2.AND.HYST(NU(NY,NX),NY,NX).GT.ZERO)THEN + HYST(NU(NY,NX),NY,NX)=AMIN1(1.0,AMAX1(0.0,HYST(NU(NY,NX),NY,NX) + 2-FLQM/VOLPX1(NU(NY,NX),NY,NX))) + ENDIF + HYST(NU(NY,NX),NY,NX)=HYST(NU(NY,NX),NY,NX) + 2+(1.0-HYST(NU(NY,NX),NY,NX))*HYSTX +C +C INFILTRATION OF WATER FROM MACROPORES INTO MICROPORES +C + IF(VOLWH1(NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN + FINHX=XNPH*6.283*HCND(2,1,NU(NY,NX),NY,NX)*AREA(3,NU(NY,NX),NY,NX) + 2*(PSISE(NU(NY,NX),NY,NX)-PSISM1(NU(NY,NX),NY,NX)) + 3/LOG(PHOL(NU(NY,NX),NY,NX)/HRAD(NU(NY,NX),NY,NX)) + IF(FINHX.GT.0.0)THEN + FINHL(NU(NY,NX),NY,NX)=AMAX1(0.0,AMIN1(FINHX + 2,XNPH*VOLWH1(NU(NY,NX),NY,NX),VOLPX1(NU(NY,NX),NY,NX))) + ELSE + FINHL(NU(NY,NX),NY,NX)=AMIN1(0.0,AMAX1(FINHX + 2,-VOLPH1(NU(NY,NX),NY,NX),-XNPH*VOLW1(NU(NY,NX),NY,NX))) + ENDIF + FINHM(M,NU(NY,NX),NY,NX)=FINHL(NU(NY,NX),NY,NX) + FINH(NU(NY,NX),NY,NX)=FINH(NU(NY,NX),NY,NX)+FINHL(NU(NY,NX),NY,NX) +C IF(J.EQ.12.AND.M.EQ.1)THEN +C WRITE(*,3367)'HOLE',I,J,M,NX,NY +C 2,FINHL(NU(NY,NX),NY,NX),FINHX +C 2,VOLWH1(NU(NY,NX),NY,NX),VOLPH1(NU(NY,NX),NY,NX) +C 3,VOLAH1(NU(NY,NX),NY,NX),PSISE(NU(NY,NX),NY,NX) +C 4,PSISM1(NU(NY,NX),NY,NX),VOLW1(NU(NY,NX),NY,NX) +C 5,HCND(2,1,NU(NY,NX),NY,NX),PHOL(NU(NY,NX),NY,NX) +C 5,HRAD(NU(NY,NX),NY,NX) +3367 FORMAT(A8,5I4,20E12.4) +C ENDIF + ELSE + FINHM(M,NU(NY,NX),NY,NX)=0.0 + FINHL(NU(NY,NX),NY,NX)=0.0 + ENDIF +C +C WATER AND ENERGY TRANSFER THROUGH SOIL PROFILE +C + IFLGH=0 + DO 4400 L=1,NL(NY,NX) +C +C CALCULATE CHANGE IN THICKNESS OF ICE LAYER +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 +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) +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 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) +C 3,CDPTH(L,NY,NX),DPTH(L,NY,NX),YDPTH(L,NY,NX),DLYR(3,L,NY,NX) +C 4,VOLP1(L,NY,NX) +910 FORMAT(A8,5I4,12E16.8) +C ENDIF + ENDIF + ENDIF +C +C END THICKNESS +C + N1=NX + N2=NY + N3=L +C +C LOCATE INTERNAL BOUNDARIES BETWEEN ADJACENT GRID CELLS +C + DO 4320 N=NCN(N2,N1),3 + IF(N.EQ.1)THEN + IF(NX.EQ.NHE)THEN + GO TO 4320 + ELSE + N4=NX+1 + N5=NY + N6=L +C +C ARTIFICIAL SOIL WARMING – PREVENT LATERAL FLOW +C +C IF(N2.EQ.2.AND.(N1.EQ.2.OR.N1.EQ.3).AND.L.LE.15)THEN +C GO TO 4320 +C ENDIF + ENDIF + ELSEIF(N.EQ.2)THEN + IF(NY.EQ.NVS)THEN + GO TO 4320 + ELSE + N4=NX + N5=NY+1 + N6=L +C +C ARTIFICIAL SOIL WARMING – PREVENT LATERAL FLOW +C +C IF(N1.EQ.3.AND.(N2.EQ.1.OR.N2.EQ.2).AND.L.LE.15)THEN +C GO TO 4320 +C ENDIF + ENDIF + ELSEIF(N.EQ.3)THEN + IF(L.EQ.NL(NY,NX))THEN + GO TO 4320 + ELSE + N4=NX + N5=NY + N6=L+1 + ENDIF + ENDIF +C +C POROSITIES 'THETP*', WATER CONTENTS 'THETA*', AND POTENTIALS +C 'PSIS*' FOR EACH GRID CELL +C + IF(N3.GE.NU(N2,N1).AND.N6.GE.NU(N5,N4) + 2.AND.N3.LE.NL(N2,N1).AND.N6.LE.NL(N5,N4))THEN + THETP1=AMAX1(0.0,VOLPX1(N3,N2,N1)/VOLX(N3,N2,N1)) + THETPL=AMAX1(0.0,VOLPX1(N6,N5,N4)/VOLX(N6,N5,N4)) + THETA1=AMAX1(THETY(N3,N2,N1),AMIN1(POROS(N3,N2,N1) + 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 + IF(THETA1.LT.FC(N3,N2,N1))THEN + PSISA1=AMAX1(HYGR,-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 + PSISA1=-EXP(PSIMS(N2,N1) + 2+(((PSL(N3,N2,N1)-LOG(THETA1)) + 3/PSD(N3,N2,N1))**SRP(N3,N2,N1)*PSISD(N2,N1))) + ELSE + PSISA1=PSISE(N3,N2,N1) + ENDIF +C ELSE +C PSISA1=PSISE(N3,N2,N1) +C ENDIF +C IF(BKVL(N6,N5,N4).GT.0.0)THEN + IF(THETAL.LT.FC(N6,N5,N4))THEN + PSISAL=AMAX1(HYGR,-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 + PSISAL=-EXP(PSIMS(N5,N4) + 2+(((PSL(N6,N5,N4)-LOG(THETAL)) + 3/PSD(N6,N5,N4))**SRP(N6,N5,N4)*PSISD(N5,N4))) + ELSE + PSISAL=PSISE(N6,N5,N4) + ENDIF +C ELSE +C PSISAL=PSISE(N6,N5,N4) +C ENDIF +C IF(J.GE.20)THEN +C WRITE(*,7272)'PSIM',I,J,N1,N2,N3,N4,N5,N6,M,PSISM1(N6,N5,N4) +C 2,PSIMX(N5,N4),FCL(N6,N5,N4),THETWL,FCD(N6,N5,N4),PSIMD(N5,N4) +C 3,POROS(N6,N5,N4),PSIMS(N5,N4),PSL(N6,N5,N4),PSD(N6,N5,N4) +C 4,SRP(N6,N5,N4),PSISD(N5,N4),THETAL,PSISE(N6,N5,N4) +C 5,THETAL-POROS(N6,N5,N4),PSISA1,PSISAL +7272 FORMAT(A8,9I4,20E12.4) +C ENDIF +C +C DARCY FLOW IF BOTH CELLS ARE SATURATED +C (CURRENT WATER POTENTIAL > AIR ENTRY WATER POTENTIAL) +C + IF(PSISA1.GT.PSISA(N3,N2,N1) + 2.AND.PSISAL.GT.PSISA(N6,N5,N4))THEN + THETW1=THETA1 + THETWL=THETAL + CND1=HCND(N,1,N3,N2,N1)*XNPH + CNDL=HCND(N,1,N6,N5,N4)*XNPH + PSISM1(N3,N2,N1)=PSISA1 + PSISM1(N6,N5,N4)=PSISAL + IF(PSISM1(N3,N2,N1).GE.PSISM1(N6,N5,N4) + 2.AND.VOLW1(N3,N2,N1).GT.ZEROS(N2,N1))THEN + FLGX=VOLWX1(N3,N2,N1)/VOLW1(N3,N2,N1) + ELSEIF(VOLW1(N6,N5,N4).GT.ZEROS(N5,N4))THEN + FLGX=VOLWX1(N6,N5,N4)/VOLW1(N6,N5,N4) + ELSE + FLGX=0.0 + ENDIF +C +C GREEN-AMPT FLOW IF ONE LAYER IS SATURATED +C (CURRENT WATER POTENTIAL < AIR ENTRY WATER POENTIAL) +C +C +C GREEN-AMPT FLOW IF SOURCE CELL SATURATED +C + ELSEIF(PSISA1.GT.PSISA(N3,N2,N1))THEN + THETW1=THETA1 + THETWL=AMAX1(THETY(N6,N5,N4),AMIN1(POROS(N6,N5,N4) + 2,VOLWX1(N6,N5,N4)/VOLX(N6,N5,N4))) + 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 + IF(THETWL.LT.FC(N6,N5,N4))THEN + PSISM1(N6,N5,N4)=AMAX1(HYGR,-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 + PSISM1(N6,N5,N4)=-EXP(PSIMS(N5,N4) + 2+(((PSL(N6,N5,N4)-LOG(THETWL)) + 3/PSD(N6,N5,N4))**SRP(N6,N5,N4)*PSISD(N5,N4))) + ELSE + PSISM1(N6,N5,N4)=PSISE(N6,N5,N4) + ENDIF +C ELSE +C PSISM1(N6,N5,N4)=PSISE(N6,N5,N4) +C ENDIF + FLGX=0.0 +C +C GREEN-AMPT FLOW IF ADJACENT CELL SATURATED +C + ELSEIF(PSISAL.GT.PSISA(N6,N5,N4))THEN + THETW1=AMAX1(THETY(N3,N2,N1),AMIN1(POROS(N3,N2,N1) + 2,VOLWX1(N3,N2,N1)/VOLX(N3,N2,N1))) + 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 + IF(THETW1.LT.FC(N3,N2,N1))THEN + PSISM1(N3,N2,N1)=AMAX1(HYGR,-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 + PSISM1(N3,N2,N1)=-EXP(PSIMS(N2,N1) + 2+(((PSL(N3,N2,N1)-LOG(THETW1)) + 3/PSD(N3,N2,N1))**SRP(N3,N2,N1)*PSISD(N2,N1))) + ELSE + PSISM1(N3,N2,N1)=PSISE(N3,N2,N1) + ENDIF +C ELSE +C PSISM1(N3,N2,N1)=PSISE(N3,N2,N1) +C ENDIF + FLGX=0.0 +C +C RICHARDS FLOW IF NEITHER CELL IS SATURATED +C (CURRENT WATER POTENTIAL < AIR ENTRY WATER POTENTIAL) +C + ELSE + THETW1=THETA1 + THETWL=THETAL + K1=MAX(1,MIN(100,INT(100.0*(POROS(N3,N2,N1)-THETA1) + 2/POROS(N3,N2,N1))+1)) + CND1=HCND(N,K1,N3,N2,N1)*XNPH + KL=MAX(1,MIN(100,INT(100.0*(POROS(N6,N5,N4)-THETAL) + 2/POROS(N6,N5,N4))+1)) + CNDL=HCND(N,KL,N6,N5,N4)*XNPH + PSISM1(N3,N2,N1)=PSISA1 + PSISM1(N6,N5,N4)=PSISAL + IF(PSISM1(N3,N2,N1).GE.PSISM1(N6,N5,N4) + 2.AND.VOLW1(N3,N2,N1).GT.ZEROS(N2,N1))THEN + FLGX=VOLWX1(N3,N2,N1)/VOLW1(N3,N2,N1) + ELSEIF(VOLW1(N6,N5,N4).GT.ZEROS(N5,N4))THEN + FLGX=VOLWX1(N6,N5,N4)/VOLW1(N6,N5,N4) + ELSE + FLGX=0.0 + ENDIF + ENDIF +C +C TOTAL SOIL WATER POTENTIAL = MATRIC, GRAVIMETRIC + OSMOTIC +C + PSIST1=PSISM1(N3,N2,N1)+PSISH(N3,N2,N1)+0.03*PSISO(N3,N2,N1) + PSISTL=PSISM1(N6,N5,N4)+PSISH(N6,N5,N4)+0.03*PSISO(N6,N5,N4) + PSISV1=PSISM1(N3,N2,N1)+PSISO(N3,N2,N1) + PSISVL=PSISM1(N6,N5,N4)+PSISO(N6,N5,N4) +C +C HYDRAULIC CONDUCTIVITY FROM CURRENT WATER CONTENT +C AND LOOKUP ARRAY GENERATED IN 'HOUR1' +C + IF(CND1.GT.ZERO.AND.CNDL.GT.ZERO)THEN + AVCNDL=2.0*CND1*CNDL/(CND1*DLYR(N,N6,N5,N4) + 2+CNDL*DLYR(N,N3,N2,N1)) + ELSE + AVCNDL=0.0 + ENDIF +C +C WATER FLUX FROM WATER POTENTIALS, HYDRAULIC CONDUCTIVITY +C CONSTRAINED BY WATER POTENTIAL GRADIENT, COUPLED WITH +C CONVECTIVE HEAT FLUX FROM WATER FLUX +C + FLQX=AVCNDL*(PSIST1-PSISTL)*AREA(N,N3,N2,N1) + IF(FLQX.GE.0.0)THEN + FLQL=AMAX1(0.0,AMIN1(FLQX,VOLW1(N3,N2,N1)*XNPH)) + FLQL=AMIN1(FLQL,VOLP1(N6,N5,N4)*XNPH) + HWFLQL=4.19*TK1(N3,N2,N1)*FLQL + ELSE + FLQL=AMIN1(0.0,AMAX1(FLQX,-VOLW1(N6,N5,N4)*XNPH)) + FLQL=AMAX1(FLQL,-VOLP1(N3,N2,N1)*XNPH) + HWFLQL=4.19*TK1(N6,N5,N4)*FLQL + ENDIF + FLQ2=FLGX*FLQL +C +C INFILTRATION OF WATER FROM MACROPORES INTO MICROPORES +C + IF(N.EQ.3.AND.VOLWH1(N6,N5,N4).GT.ZEROS(N5,N4))THEN + FINHX=XNPH*6.283*HCND(2,1,N6,N5,N4)*AREA(3,N6,N5,N4) + 2*(PSISE(N6,N5,N4)-PSISM1(N6,N5,N4)) + 3/LOG(PHOL(N6,N5,N4)/HRAD(N6,N5,N4)) + IF(FINHX.GT.0.0)THEN + FINHL(N6,N5,N4)=AMAX1(0.0,AMIN1(FINHX,XNPH*VOLWH1(N6,N5,N4) + 2,VOLPX1(N6,N5,N4))) + ELSE + FINHL(N6,N5,N4)=AMIN1(0.0,AMAX1(FINHX,-VOLPH1(N6,N5,N4) + 2,-XNPH*VOLW1(N6,N5,N4))) + ENDIF + FINHM(M,N6,N5,N4)=FINHL(N6,N5,N4) + FINH(N6,N5,N4)=FINH(N6,N5,N4)+FINHL(N6,N5,N4) +C IF(NX.EQ.1.AND.NY.EQ.1)THEN +C WRITE(*,3366)'FINHL',I,J,M,N4,N5,N6,IFLGH,FINHL(N6,N5,N4) +C 3,FINHX,VOLWH1(N6,N5,N4),VOLPH1(N6,N5,N4),VOLP1(N6,N5,N4) +C 4,PSISM1(N6,N5,N4),HCND(2,1,N6,N5,N4),PHOL(N6,N5,N4) +C 5,HRAD(N6,N5,N4) +3366 FORMAT(A8,7I4,20E12.4) +C ENDIF + ELSE + FINHL(N6,N5,N4)=0.0 + FINHM(M,N6,N5,N4)=0.0 + ENDIF +C +C MACROPORE FLOW FROM POISEUILLE FLOW IF MACROPORES PRESENT +C + IF(VOLAH1(N3,N2,N1).GT.ZEROS(N2,N1) + 2.AND.VOLAH1(N6,N5,N4).GT.ZEROS(N5,N4).AND.IFLGH.EQ.0)THEN + PSISH1=PSISH(N3,N2,N1)+0.0098*DLYR(3,N3,N2,N1) + 2*(AMIN1(1.0,AMAX1(0.0,VOLWH1(N3,N2,N1)/VOLAH1(N3,N2,N1)))-0.5) + PSISHL=PSISH(N6,N5,N4)+0.0098*DLYR(3,N6,N5,N4) + 2*(AMIN1(1.0,AMAX1(0.0,VOLWH1(N6,N5,N4)/VOLAH1(N6,N5,N4)))-0.5) + FLWHX=AVCNHL(N,N6,N5,N4)*(PSISH1-PSISHL)*AREA(N,N3,N2,N1) +C +C MACROPORE FLOW IF GRAVITATIONAL GRADIENT IS POSITIVE +C AND MACROPORE POROSITY EXISTS IN ADJACENT CELL +C + IF(N.NE.3)THEN + IF(PSISH1.GT.PSISHL)THEN + FLWHL(N,N6,N5,N4)=AMAX1(0.0,AMIN1(AMIN1(VOLWH1(N3,N2,N1) + 2,VOLPH1(N6,N5,N4))*0.5*XDIM,FLWHX)) + ELSEIF(PSISH1.LT.PSISHL)THEN + FLWHL(N,N6,N5,N4)=AMIN1(0.0,AMAX1(AMAX1(-VOLWH1(N6,N5,N4) + 2,-VOLPH1(N3,N2,N1))*0.5*XDIM,FLWHX)) + ELSE + FLWHL(N,N6,N5,N4)=0.0 + ENDIF + ELSE + FLWHL(N,N6,N5,N4)=AMAX1(0.0,AMIN1(AMIN1(VOLWH1(N3,N2,N1) + 2+FLWHL(N,N3,N2,N1)-FINHL(N3,N2,N1) + 3,VOLPH1(N6,N5,N4))*XDIM,FLWHX)) + ENDIF + FLWHM(M,N,N6,N5,N4)=FLWHL(N,N6,N5,N4) +C IF(N4.EQ.1)THEN +C WRITE(*,5478)'FLWH',I,J,M,N1,N2,N3,IFLGH +C 2,FINHL(N3,N2,N1),FLHM,FLWHX,FLWHL(N,N3,N2,N1),FLWHL(N,N6,N5,N4) +C 2,AVCNHL(N,N6,N5,N4),PSISH(N3,N2,N1),PSISH(N6,N5,N4) +C 3,VOLPH1(N3,N2,N1),VOLPH1(N6,N5,N4),VOLWH1(N3,N2,N1) +C 4,VOLWH1(N6,N5,N4),VOLAH1(N3,N2,N1),VOLAH1(N6,N5,N4) +C 5,DLYR(N,N6,N5,N4),DLYR(N,N3,N2,N1),AREA(N,N3,N2,N1) +C 7,CNDH1(N3,N2,N1),CNDH1(N6,N5,N4),XNPH,XDIM,HWFLHL +5478 FORMAT(A8,7I4,30E12.4) +C ENDIF + ELSE + FLWHL(N,N6,N5,N4)=0.0 + FLWHM(M,N,N6,N5,N4)=0.0 + IF(VOLPH1(N6,N5,N4).LE.0.0)IFLGH=1 + ENDIF +C +C CONVECTIVE HEAT FLOW FROM MACROPORE FLOW +C + IF(FLWHL(N,N6,N5,N4).GT.0.0)THEN + HWFLHL=4.19*TK1(N3,N2,N1)*FLWHL(N,N6,N5,N4) + ELSE + HWFLHL=4.19*TK1(N6,N5,N4)*FLWHL(N,N6,N5,N4) + ENDIF +C +C VAPOR PRESSURE AND DIFFUSIVITY IN EACH GRID CELL +C + TK11=TK1(N3,N2,N1) + TK12=TK1(N6,N5,N4) + VP1=2.173E-03/TK11 + 2*0.61*EXP(5360.0*(3.661E-03-1.0/TK11)) + 3*EXP(18.0*PSISV1/(8.3143*TK11)) + VPL=2.173E-03/TK12 + 2*0.61*EXP(5360.0*(3.661E-03-1.0/TK12)) + 3*EXP(18.0*PSISVL/(8.3143*TK12)) + CNV1=THETP1**2/POROQ(N3,N2,N1)*WGSG1(N3,N2,N1) + CNVL=THETPL**2/POROQ(N6,N5,N4)*WGSG1(N6,N5,N4) + IF(CNV1.GT.ZERO.AND.CNVL.GT.ZERO)THEN + AVCNVL=2.0*CNV1*CNVL + 2/(CNV1*DLYR(N,N6,N5,N4)+CNVL*DLYR(N,N3,N2,N1)) + ELSE + AVCNVL=0.0 + ENDIF +C +C VAPOR FLUX FROM VAPOR PRESSURE AND DIFFUSIVITY, +C AND CONVECTIVE HEAT FLUX FROM VAPOR FLUX +C + TKY=(VHCP1(N3,N2,N1)*TK1(N3,N2,N1)+VHCP1(N6,N5,N4)*TK1(N6,N5,N4)) + 2/(VHCP1(N3,N2,N1)+VHCP1(N6,N5,N4)) + HFLWX=(TKY-TK1(N6,N5,N4))*VHCP1(N6,N5,N4)*FHFLX*XDIM + FLVX=AVCNVL*(VP1-VPL)*AREA(N,N3,N2,N1) + IF(FLVX.GE.0.0)THEN + FLVL=AMIN1(FLVX,VOLW1(N3,N2,N1)*XNPH) + IF(HFLWX.GE.0.0)THEN + FLVL=AMIN1(FLVL,HFLWX/(4.19*TK1(N3,N2,N1)+VAP)) + ENDIF + HWFLVL=(4.19*TK1(N3,N2,N1)+VAP)*FLVL + ELSE + FLVL=AMAX1(FLVX,-VOLW1(N6,N5,N4)*XNPH) + IF(HFLWX.LT.0.0)THEN + FLVL=AMAX1(FLVL,HFLWX/(4.19*TK1(N6,N5,N4)+VAP)) + ENDIF + HWFLVL=(4.19*TK1(N6,N5,N4)+VAP)*FLVL + ENDIF + 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 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 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 ENDIF +C +C THERMAL CONDUCTIVITY +C + DTKX=ABS(TK1(N3,N2,N1)-TK1(N6,N5,N4))*1.0E-06 + DTHW1=AMAX1(0.0,THETWX(N3,N2,N1)-TRBW)**3 + DTHA1=AMAX1(0.0,THETPX(N3,N2,N1)-TRBA)**3 + DTHW2=AMAX1(0.0,THETWX(N6,N5,N4)-TRBW)**3 + DTHA2=AMAX1(0.0,THETPX(N6,N5,N4)-TRBA)**3 + RYLXW1=DTKX*DTHW1 + RYLXA1=DTKX*DTHA1 + RYLXW2=DTKX*DTHW2 + RYLXA2=DTKX*DTHA2 + RYLNW1=AMIN1(1.0E+04,RYLXW*RYLXW1) + RYLNA1=AMIN1(1.0E+04,RYLXA*RYLXA1) + RYLNW2=AMIN1(1.0E+04,RYLXW*RYLXW2) + RYLNA2=AMIN1(1.0E+04,RYLXA*RYLXA2) + XNUSW1=AMAX1(1.0,0.68+0.67*RYLNW1**0.25/DNUSW) + XNUSA1=AMAX1(1.0,0.68+0.67*RYLNA1**0.25/DNUSA) + XNUSW2=AMAX1(1.0,0.68+0.67*RYLNW2**0.25/DNUSW) + XNUSA2=AMAX1(1.0,0.68+0.67*RYLNA2**0.25/DNUSA) + TCNDW1=2.067E-03*XNUSW1 + TCNDA1=9.050E-05*XNUSA1 + TCNDW2=2.067E-03*XNUSW2 + TCNDA2=9.050E-05*XNUSA2 + WTHET1=1.467-0.467*THETPY(N3,N2,N1) + TCND1=(STC(N3,N2,N1)+THETWX(N3,N2,N1)*TCNDW1 + 2+0.611*THETIX(N3,N2,N1)*7.844E-03 + 3+WTHET1*THETPX(N3,N2,N1)*TCNDA1) + 4/(DTC(N3,N2,N1)+THETWX(N3,N2,N1)+0.611*THETIX(N3,N2,N1) + 5+WTHET1*THETPX(N3,N2,N1)) + WTHET2=1.467-0.467*THETPY(N6,N5,N4) + TCND2=(STC(N6,N5,N4)+THETWX(N6,N5,N4)*TCNDW2 + 2+0.611*THETIX(N6,N5,N4)*7.844E-03 + 3+WTHET2*THETPX(N6,N5,N4)*TCNDA2) + 4/(DTC(N6,N5,N4)+THETWX(N6,N5,N4)+0.611*THETIX(N6,N5,N4) + 5+WTHET2*THETPX(N6,N5,N4)) + ATCND1=(2.0*TCND1*TCND2)/(TCND1*DLYR(N,N6,N5,N4) + 3+TCND2*DLYR(N,N3,N2,N1))*XNPH +C +C HEAT FLOW FROM THERMAL CONDUCTIVITY AND TEMPERATURE GRADIENT +C + TK1X=TK1(N3,N2,N1)-HWFLVL/VHCP1(N3,N2,N1) + TKLX=TK1(N6,N5,N4)+HWFLVL/VHCP1(N6,N5,N4) + TKY=(VHCP1(N3,N2,N1)*TK1X+VHCP1(N6,N5,N4)*TKLX) + 2/(VHCP1(N3,N2,N1)+VHCP1(N6,N5,N4)) + HFLWX=(TKY-TKLX)*VHCP1(N6,N5,N4)*FHFLX*XDIM + HFLWC=ATCND1*(TK1X-TKLX)*AREA(N,N3,N2,N1) + IF(HFLWC.GE.0.0)THEN + HFLWC=AMAX1(0.0,AMIN1(HFLWC,HFLWX)) + ELSE + HFLWC=AMIN1(0.0,AMAX1(HFLWC,HFLWX)) + ENDIF + HFLWL(N,N6,N5,N4)=HWFLWL+HWFLHL+HFLWC +C IF((I/10)*10.EQ.I.AND.N5.EQ.2.AND.J.EQ.15.AND.N.EQ.3)THEN +C WRITE(*,8765)'HFLWL',I,J,N4,N5,N6,N,M,HFLWL(N,N6,N5,N4) +C 2,TCND1,TCND2,ATCND1,DTKX,DTHP1,DTHP2,THETPX(N3,N2,N1) +C 3,THETPX(N6,N5,N4),RYLNA1,RYLNA2,DNUSA,XNUSA1,XNUSA2 +C 4,TCNDA1,TCNDA2,RYLNW1,RYLNW2,DNUSW,XNUSW1,XNUSW2 +C 5,TCNDW1,TCNDW2 +8765 FORMAT(A8,7I4,60E12.4) +C ENDIF +C +C MOVE WATER UP DURING PRECIPITATION OR FREEZING +C + IF(N.EQ.3)THEN + IF(VOLW1(N6,N5,N4)+VOLI1(N6,N5,N4).GT.VOLA(N6,N5,N4))THEN + FLWLY=AMIN1(0.0,AMAX1(-XNPH*VOLW1(N6,N5,N4) + 2,VOLA(N6,N5,N4)-VOLW1(N6,N5,N4)-VOLI1(N6,N5,N4))) + FLWLY=AMAX1(FLWLY,-VOLP1(N3,N2,N1)) + HFLWLY=FLWLY*4.19*TK1(N6,N5,N4) + FLWL(N,N6,N5,N4)=FLWL(N,N6,N5,N4)+FLWLY + HFLWL(N,N6,N5,N4)=HFLWL(N,N6,N5,N4)+HFLWLY + ENDIF + IF(VOLWH1(N6,N5,N4)+VOLIH1(N6,N5,N4).GT.VOLAH1(N6,N5,N4))THEN + FLWHY=AMIN1(0.0,AMAX1(-XNPH*VOLWH1(N6,N5,N4),-VOLPH1(N3,N2,N1) + 2,VOLAH1(N6,N5,N4)-VOLWH1(N6,N5,N4)-VOLIH1(N6,N5,N4))) + HFLWHY=FLWHY*4.19*TK1(N6,N5,N4) + FLWHL(N,N6,N5,N4)=FLWHL(N,N6,N5,N4)+FLWHY + HFLWL(N,N6,N5,N4)=HFLWL(N,N6,N5,N4)+HFLWHY + ENDIF + IF(PSISAL.GT.PSISA(N6,N5,N4))THEN + FLWVL(N6,N5,N4)=VOLW1(N6,N5,N4)-VOLWX1(N6,N5,N4) + ELSE + FLWVL(N6,N5,N4)=RFLWV(N5,N4)*(VOLW1(N6,N5,N4)-VOLWX1(N6,N5,N4)) + ENDIF + FLWV(N6,N5,N4)=FLWV(N6,N5,N4)+FLWVL(N6,N5,N4) + ENDIF +C +C FREEZE-THAW IN SOIL LAYER MICROPORE FROM NET CHANGE IN SOIL +C LAYER HEAT STORAGE +C + IF(N.EQ.3)THEN + TFREEZ=-9.0959E+04/(PSISVL-333.0) + IF((TK1(N6,N5,N4).LT.TFREEZ + 2.AND.VOLW1(N6,N5,N4).GT.ZERO*VOLA(N6,N5,N4) + 3.AND.VOLI1(N6,N5,N4).LT.VOLA(N6,N5,N4)) + 4.OR.(TK1(N6,N5,N4).GT.TFREEZ + 5.AND.VOLI1(N6,N5,N4).GT.ZERO*VOLT(N6,N5,N4)))THEN + TFLX1=FGRD(N6,N5,N4)*(1.0/(1.0+TFREEZ*6.2913E-03) + 2*(TFREEZ*4.19*(FLWL(N,N6,N5,N4)+FLWHL(N,N6,N5,N4)) + 2+VHCP1(N6,N5,N4)*(TFREEZ-TK1(N6,N5,N4)) + 3-HFLWL(N,N6,N5,N4))) + IF(TFLX1.LT.0.0)THEN + TFLX=AMAX1(-333.0*DENSI*VOLI1(N6,N5,N4)*XNPH,TFLX1) + ELSE + TFLX=AMIN1(333.0*VOLW1(N6,N5,N4)*XNPH,TFLX1) + ENDIF + WFLX=-TFLX/333.0 + IF(WFLX.GT.0.0.AND.VOLI1(N6,N5,N4).GT.ZEROS(N5,N4))THEN + WFLXL(N,N6,N5,N4)=WFLX + ELSEIF(WFLX.LT.0.0.AND.VOLW1(N6,N5,N4).GT.ZEROS(N5,N4))THEN + WFLXL(N,N6,N5,N4)=WFLX + ELSE + TFLX=0.0 + WFLXL(N,N6,N5,N4)=0.0 + ENDIF + ELSE + TFLX=0.0 + WFLXL(N,N6,N5,N4)=0.0 + ENDIF +C +C FREEZE-THAW IN SOIL LAYER MACROPORE FROM NET CHANGE IN SOIL +C LAYER HEAT STORAGE +C + IF((TK1(N6,N5,N4).LT.273.15.AND.VOLWH1(N6,N5,N4) + 2.GT.ZERO*VOLT(N6,N5,N4)).OR.(TK1(N6,N5,N4).GT.273.15 + 3.AND.VOLIH1(N6,N5,N4).GT.ZERO*VOLT(N6,N5,N4)))THEN + TFLX1=FMAC(N6,N5,N4)*(1.0/(1.0+273.15*6.2913E-03) + 2*(273.15*4.19*(FLWL(N,N6,N5,N4)+FLWHL(N,N6,N5,N4)) + 2+VHCP1(N6,N5,N4)*(273.15-TK1(N6,N5,N4)) + 3-HFLWL(N,N6,N5,N4))) + IF(TFLX1.LT.0.0)THEN + TFLXH=AMAX1(-333.0*DENSI*VOLIH1(N6,N5,N4)*XNPH,TFLX1) + ELSE + TFLXH=AMIN1(333.0*VOLWH1(N6,N5,N4)*XNPH,TFLX1) + ENDIF + WFLXH=-TFLXH/333.0 + IF(WFLXH.GT.0.0.AND.VOLIH1(N6,N5,N4).GT.ZEROS(N5,N4))THEN + WFLXLH(N,N6,N5,N4)=WFLXH + ELSEIF(WFLXH.LT.0.0.AND.VOLWH1(N6,N5,N4).GT.ZEROS(N5,N4))THEN + WFLXLH(N,N6,N5,N4)=WFLXH + ELSE + TFLXH=0.0 + WFLXLH(N,N6,N5,N4)=0.0 + ENDIF + ELSE + TFLXH=0.0 + WFLXLH(N,N6,N5,N4)=0.0 + ENDIF + TFLXL(N,N6,N5,N4)=TFLX+TFLXH +C IF(NY.EQ.1)THEN +C WRITE(*,4359)'TFLX',I,J,M,N4,N5,N6,TFREEZ,TK1(N6,N5,N4),PSISVL +C 2,TFLX,TFLXH,TFLXL(N,N6,N5,N4),WFLX,WFLXH +C 2,WFLXL(N,N6,N5,N4),WFLXLH(N,N6,N5,N4) +C 4,VOLW1(N6,N5,N4),VOLWH1(N6,N5,N4) +C 4,VOLI1(N6,N5,N4),VOLIH1(N6,N5,N4) +C 5,FGRD(N6,N5,N4),FMAC(N6,N5,N4) +4359 FORMAT(A8,6I4,20E12.4) +C ENDIF + ENDIF +C +C TOTAL WATER, VAPOR AND HEAT FLUXES +C + THAW(N,N6,N5,N4)=THAW(N,N6,N5,N4)+WFLXL(N,N6,N5,N4) + THAWH(N,N6,N5,N4)=THAWH(N,N6,N5,N4)+WFLXLH(N,N6,N5,N4) + HTHAW(N,N6,N5,N4)=HTHAW(N,N6,N5,N4)+TFLXL(N,N6,N5,N4) + FLW(N,N6,N5,N4)=FLW(N,N6,N5,N4)+FLWL(N,N6,N5,N4) + FLWX(N,N6,N5,N4)=FLWX(N,N6,N5,N4)+FLWLX(N,N6,N5,N4) + FLWH(N,N6,N5,N4)=FLWH(N,N6,N5,N4)+FLWHL(N,N6,N5,N4) + HFLW(N,N6,N5,N4)=HFLW(N,N6,N5,N4)+HFLWL(N,N6,N5,N4) + FLWM(M,N,N6,N5,N4)=FLWL(N,N6,N5,N4) + IF(N.EQ.3)THEN + HYSM(M,N6,N5,N4)=HYST(N6,N5,N4) + IF(PSISA1.GT.PSISA(N3,N2,N1).AND.VOLPX1(N6,N5,N4).GT.ZEROS(N5,N4) + 2.AND.HYST(N6,N5,N4).GT.ZERO)THEN + HYST(N6,N5,N4)=AMIN1(1.0,AMAX1(0.0,HYST(N6,N5,N4) + 2-FLWL(N,N6,N5,N4)/VOLPX1(N6,N5,N4))) + ENDIF +C +C WATER FILM THICKNESS FOR CALCULATING GAS EXCHANGE IN 'TRNSFR' +C +C IF(BKVL(N6,N5,N4).GT.0.0)THEN + FILM(M,N6,N5,N4)=AMAX1(1.0E-06 + 2,EXP(-13.833-0.857*LOG(-PSISM1(N6,N5,N4)))) +C ELSE +C FILM(M,N6,N5,N4)=DLYR(3,N6,N5,N4) +C ENDIF + HYST(N6,N5,N4)=HYST(N6,N5,N4)+(1.0-HYST(N6,N5,N4))*HYSTX + ENDIF + ELSEIF(N.NE.3)THEN + FLWL(N,N6,N5,N4)=0.0 + FLWLX(N,N6,N5,N4)=0.0 + FLWHL(N,N6,N5,N4)=0.0 + HFLWL(N,N6,N5,N4)=0.0 + FLWHM(M,N,N6,N5,N4)=0.0 + ENDIF +4320 CONTINUE +4400 CONTINUE +9890 CONTINUE +9895 CONTINUE +C +C BOUNDARY WATER AND HEAT FLUXES +C + DO 9595 NX=NHW,NHE + DO 9590 NY=NVN,NVS + DO 9585 L=NU(NY,NX),NL(NY,NX) + TVOLZ1=TVOL1(NY,NX) + VOLWZ1=TVOLW(NY,NX) + VOLP2=VOLP1(L,NY,NX) + VOLPX2=VOLPX1(L,NY,NX) + VOLPH2=VOLPH1(L,NY,NX) +C +C IDENTIFY CONDITIONS FOR MICROPRE DISCHARGE TO WATER TABLE +C + IF(IPRC(NY,NX).NE.0.AND.DPTH(L,NY,NX).LT.DTBLX(NY,NX))THEN + IF(PSISM1(L,NY,NX).GE.PSISE(L,NY,NX) + 2+0.0098*(DPTH(L,NY,NX)-DTBLX(NY,NX)))THEN + IFLGU=0 + DO 9565 LL=MIN(L+1,NL(NY,NX)),NL(NY,NX) + IF(DPTH(LL,NY,NX).LT.DTBLX(NY,NX))THEN + IF((PSISM1(LL,NY,NX).LT.PSISA(LL,NY,NX).AND.L.NE.NL(NY,NX)) + 2.OR.DPTH(LL,NY,NX).GT.DPTHA(NY,NX))THEN + IFLGU=1 + ENDIF + ENDIF +9565 CONTINUE + ELSE + IFLGU=1 + ENDIF + ELSE + IFLGU=1 + ENDIF +C +C IDENTIFY CONDITIONS FOR MACROPORE DISCHARGE TO WATER TABLE +C + IF(VOLAH1(L,NY,NX).GT.ZEROS(NY,NX))THEN + DPTHH=CDPTH(L,NY,NX)-(VOLWH1(L,NY,NX)+VOLIH1(L,NY,NX)) + 2/VOLAH1(L,NY,NX)*DLYR(3,L,NY,NX) + ELSE + DPTHH=CDPTH(L,NY,NX) + ENDIF + IF(IPRC(NY,NX).NE.0.AND.DPTHH.LT.DTBLX(NY,NX) + 2.AND.VOLWH1(L,NY,NX).GT.ZEROS(NY,NX))THEN + IFLGUH=0 + DO 9566 LL=MIN(L+1,NL(NY,NX)),NL(NY,NX) + IF(DPTH(LL,NY,NX).LT.DTBLX(NY,NX))THEN + IF(VOLAH1(LL,NY,NX).LE.ZEROS(NY,NX))THEN + IFLGUH=1 + ENDIF + ENDIF +9566 CONTINUE + ELSE + IFLGUH=1 + ENDIF +C IF((I/30)*30.EQ.I.AND.M.EQ.1)THEN +C WRITE(*,9567)'IFLGU',I,J,M,NX,NY,L,IFLGU,IFLGUH,PSISM1(L,NY,NX) +C 2,PSISE(L,NY,NX),DPTH(L,NY,NX),DTBLX(NY,NX),PSISE(L,NY,NX) +C 2+0.0098*(DPTH(L,NY,NX)-DTBLX(NY,NX)),THETX +C 3,VOLAH1(L,NY,NX),VOLWH1(L,NY,NX),VOLIH1(L,NY,NX),CDPTH(L,NY,NX) +C 4,DLYR(3,L,NY,NX),DTBLZ(NY,NX),DPTHH +9567 FORMAT(A8,8I4,20E12.4) +C ENDIF +C +C LOCATE ALL EXTERNAL BOUNDARIES AND SET BOUNDARY CONDITIONS +C ENTERED IN 'READS' +C + N1=NX + N2=NY + N3=L + DO 9580 N=1,3 + DO 9575 NN=1,2 + IF(N.EQ.1)THEN + N4=NX+1 + N5=NY + N6=L + WDTH=DLYR(2,NU(NY,NX),NY,NX) + IF(NN.EQ.1)THEN + IF(NX.EQ.NHE)THEN + M1=NX + M2=NY + M3=L + M4=NX+1 + M5=NY + M6=L + XN=-1.0 + RCHQF=RCHQE(M2,M1) + RCHGFU=RCHGEU(M2,M1) + RCHGFT=RCHGET(M2,M1) + ELSE + GO TO 9575 + ENDIF + ELSEIF(NN.EQ.2)THEN + IF(NX.EQ.NHW)THEN + M1=NX+1 + M2=NY + M3=L + M4=NX + M5=NY + M6=L + XN=1.0 + RCHQF=RCHQW(M5,M4) + RCHGFU=RCHGWU(M5,M4) + RCHGFT=RCHGWT(M5,M4) + ELSE + GO TO 9575 + ENDIF + ENDIF + ELSEIF(N.EQ.2)THEN + N4=NX + N5=NY+1 + N6=L + WDTH=DLYR(1,NU(NY,NX),NY,NX) + IF(NN.EQ.1)THEN + IF(NY.EQ.NVS)THEN + M1=NX + M2=NY + M3=L + M4=NX + M5=NY+1 + M6=L + XN=-1.0 + RCHQF=RCHQS(M2,M1) + RCHGFU=RCHGSU(M2,M1) + RCHGFT=RCHGST(M2,M1) + ELSE + GO TO 9575 + ENDIF + ELSEIF(NN.EQ.2)THEN + IF(NY.EQ.NVN)THEN + M1=NX + M2=NY+1 + M3=L + M4=NX + M5=NY + M6=L + XN=1.0 + RCHQF=RCHQN(M5,M4) + RCHGFU=RCHGNU(M5,M4) + RCHGFT=RCHGNT(M5,M4) + ELSE + GO TO 9575 + ENDIF + ENDIF + ELSEIF(N.EQ.3)THEN + N4=NX + N5=NY + N6=L+1 + IF(NN.EQ.1)THEN + IF(L.EQ.NL(NY,NX))THEN + M1=NX + M2=NY + M3=L + M4=NX + M5=NY + M6=L+1 + XN=-1.0 + RCHGFU=RCHGD(M2,M1) + RCHGFT=1.0 + ELSE + GO TO 9575 + ENDIF + ELSEIF(NN.EQ.2)THEN + GO TO 9575 + ENDIF + ENDIF +C +C BOUNDARY SURFACE RUNOFF DEPENDING ON ASPECT, SLOPE +C VELOCITY, HYDRAULIC RADIUS AND SURFACE WATER STORAGE +C + IF(L.EQ.NU(N2,N1).AND.N.NE.3)THEN + IF(IRCHG(NN,N,N2,N1).EQ.0.OR.RCHQF.EQ.0.0)THEN + V=0.0 + QR1(N,M5,M4)=0.0 + HQR1(N,M5,M4)=0.0 + ELSE +C +C RUNOFF +C + ALT1=ALTG(N2,N1)+TVOLZ1/AREA(3,NU(N2,N1),N2,N1) + ALT2=ALTG(N2,N1)+VOLWG(N2,N1)/AREA(3,NU(N2,N1),N2,N1) + 2-GSIN(N2,N1)*DLYR(N,NU(N2,N1),N2,N1) + IF(ALT1.GT.ALT2.AND.TVOLZ1.GT.VOLWG(N2,N1))THEN + QRX1=TVOLZ1-VOLWG(N2,N1) + D=QRX1/AREA(3,0,N2,N1) + R=D/2.828 + S=(ALT1-ALT2)/DLYR(N,NU(N2,N1),N2,N1) + V=R**0.67*SQRT(S)/ZM(N2,N1) + Q=V*D*AMIN1(1.0,D/ZS(N2,N1))*WDTH*3.6E+03*XNPH*RCHQF + QR1(N,M5,M4)=-XN*AMIN1(Q,0.25*QRX1)*VOLWZ1/TVOLZ1*RCHQF + HQR1(N,M5,M4)=4.19*TK1(0,N2,N1)*QR1(N,M5,M4) + VOLWZ1=VOLWZ1+XN*QR1(N,M5,M4) + TVOLZ1=TVOLZ1+XN*QR1(N,M5,M4) + ELSEIF(DTBLX(N2,N1).LT.0.0)THEN +C +C RUNON +C + QRX1=AMIN1(0.0,DTBLX(N2,N1)+TVOLZ1/AREA(3,NU(N2,N1),N2,N1)) + 2*AREA(3,NU(N2,N1),N2,N1) + QR1(N,M5,M4)=-XN*0.25*QRX1*RCHQF + HQR1(N,M5,M4)=4.19*TK1(0,N2,N1)*QR1(N,M5,M4) + VOLWZ1=VOLWZ1+XN*QR1(N,M5,M4) + TVOLZ1=TVOLZ1+XN*QR1(N,M5,M4) + ELSE + V=0.0 + QR1(N,M5,M4)=0.0 + HQR1(N,M5,M4)=0.0 + ENDIF + QR(N,M5,M4)=QR(N,M5,M4)+QR1(N,M5,M4) + HQR(N,M5,M4)=HQR(N,M5,M4)+HQR1(N,M5,M4) + QRM(M,N,M5,M4)=QR1(N,M5,M4) + QRV(M,N,M5,M4)=V + QS1(N,M5,M4)=0.0 + QW1(N,M5,M4)=0.0 + QI1(N,M5,M4)=0.0 + HQS1(N,M5,M4)=0.0 + QS(N,M5,M4)=QS(N,M5,M4)+QS1(N,M5,M4) + QW(N,M5,M4)=QW(N,M5,M4)+QW1(N,M5,M4) + QI(N,M5,M4)=QI(N,M5,M4)+QI1(N,M5,M4) + HQS(N,M5,M4)=HQS(N,M5,M4)+HQS1(N,M5,M4) + QSM(M,N,M5,M4)=QS1(N,M5,M4) +C IF((I/10)*10.EQ.I.AND.M.EQ.NPH)THEN +C WRITE(*,7744)'QRB',I,J,M,N1,N2,N3,M4,M5,M6,N,NN,IRCHG(NN,N,N2,N1) +C 2,QR(N,M5,M4),QR1(N,M5,M4),Q,QRX1,V,S,D,ALT1,ALT2,ZM(N2,N1) +C 3,ZS(N2,N1),VOLWZ1,TVOLZ1,RCHQF,VOLWG(N2,N1),VOLW1(0,N2,N1) +C 4,VOLI1(0,N2,N1),TVOLW(N2,N1),FVOLW1,FVOLH1,PSISM1(0,N2,N1) +C 7,VOLWRX(N2,N1),FLWL(3,0,N2,N1),FLWRL(N2,N1) +7744 FORMAT(A8,12I4,30E12.4) +C ENDIF + ENDIF + ENDIF +C +C BOUNDARY SUBSURFACE WATER AND HEAT TRANSFER DEPENDING +C ON LEVEL OF WATER TABLE +C + IF(NCN(N2,N1).NE.3.OR.N.EQ.3)THEN +C +C IF NO WATER TABLE +C + IF(IPRC(N2,N1).EQ.0.OR.N.EQ.3)THEN + THETA1=AMAX1(THETY(N3,N2,N1),AMIN1(POROS(N3,N2,N1) + 2,VOLW1(N3,N2,N1)/VOLX(N3,N2,N1))) + THETAX=AMAX1(THETY(N3,N2,N1),AMIN1(POROS(N3,N2,N1) + 2,VOLWX1(N3,N2,N1)/VOLX(N3,N2,N1))) + K1=MAX(1,MIN(100,INT(100.0*(POROS(N3,N2,N1) + 2-THETA1)/POROS(N3,N2,N1))+1)) + KX=MAX(1,MIN(100,INT(100.0*(POROS(N3,N2,N1) + 2-THETAX)/POROS(N3,N2,N1))+1)) + CND1=HCND(N,K1,N3,N2,N1)*XNPH + CNDX=HCND(N,KX,N3,N2,N1)*XNPH + FLWL(N,M6,M5,M4)=AMIN1(VOLW1(N3,N2,N1)*XNPH + 2,XN*0.0098*-ABS(SLOPE(N,N2,N1))*CND1*AREA(3,N3,N2,N1)) + 3*RCHGFU*RCHGFT + FLWLX(N,M6,M5,M4)=AMIN1(VOLWX1(N3,N2,N1)*XNPH + 2,XN*0.0098*-ABS(SLOPE(N,N2,N1))*CNDX*AREA(3,N3,N2,N1)) + 3*RCHGFU*RCHGFT + FLWHL(N,M6,M5,M4)=AMIN1(VOLWH1(L,NY,NX) + 2,XN*0.0098*-ABS(SLOPE(N,N2,N1))*CNDH1(L,NY,NX)*AREA(3,N3,N2,N1)) + 3*RCHGFU*RCHGFT + HFLWL(N,M6,M5,M4)=4.19*TK1(N3,N2,N1) + 2*(FLWL(N,M6,M5,M4)+FLWHL(N,M6,M5,M4)) +C IF(J.EQ.12.AND.M.EQ.1)THEN +C WRITE(*,4443)'ABV',I,J,M,N,NN,M4,M5,M6,XN,FLWL(N,M6,M5,M4) +C 2,VOLP2,RCHGFU,VOLX(N3,N2,N1),VOLW1(N3,N2,N1) +C 3,VOLWH1(N3,N2,N1),VOLPH1(N3,N2,N1),VOLPH2,VOLI1(N3,N2,N1) +C 4,VOLIH1(N3,N2,N1),VOLP1(N3,N2,N1),HFLWL(N,M6,M5,M4) +C 5,PSISM1(N3,N2,N1),PSISE(N3,N2,N1),FLWHL(N,M6,M5,M4),DDRG(N2,N1) +C 6,SLOPE(N,N2,N1) +4443 FORMAT(A8,8I4,30E12.4) +C ENDIF + ELSE +C +C MICROPORE DISCHARGE ABOVE WATER TABLE +C + IF(IFLGU.EQ.0.AND.RCHGFT.NE.0.0)THEN + PSISWD=XN*0.005*SLOPE(N,N2,N1)*DLYR(N,N3,N2,N1) + 2*(1.0-DTBLG(N2,N1)) + PSISWT=AMIN1(0.0,PSISE(N3,N2,N1)-PSISM1(N3,N2,N1) + 2+0.0098*(DPTH(N3,N2,N1)-DTBLX(N2,N1)) + 3-0.0098*AMAX1(0.0,DPTH(N3,N2,N1)-DPTHT(N2,N1))) + IF(PSISWT.LT.0.0)PSISWT=PSISWT-PSISWD + FLWT=PSISWT*HCND(N,1,N3,N2,N1)*XNPH*AREA(N,N3,N2,N1) + 2*(1.0-AREAU(N3,N2,N1))/(RCHGFU+1.0)*RCHGFT + FLWL(N,M6,M5,M4)=XN*FLWT + FLWLX(N,M6,M5,M4)=XN*FLWT + HFLWL(N,M6,M5,M4)=4.19*TK1(N3,N2,N1)*XN*FLWT +C WRITE(*,4445)'DISCHMI',I,J,M,N1,N2,N3,M4,M5,M6,N,NN,XN +C 2,FLWL(N,M6,M5,M4),FLWT,PSISWT,HCND(N,1,N3,N2,N1) +C 3,AREA(N,N3,N2,N1),AREAU(N3,N2,N1),RCHGFU,RCHGFT +4445 FORMAT(A8,11I4,30E12.4) + ELSE + FLWL(N,M6,M5,M4)=0.0 + FLWLX(N,M6,M5,M4)=0.0 + HFLWL(N,M6,M5,M4)=0.0 + ENDIF +C +C MACROPORE DISCHARGE ABOVE WATER TABLE +C + IF(IFLGUH.EQ.0.AND.RCHGFT.NE.0.0)THEN + PSISWD=XN*0.005*SLOPE(N,N2,N1)*DLYR(N,N3,N2,N1) + 2*(1.0-DTBLG(N2,N1)) + PSISWTH=0.0098*(DPTHH-DTBLX(N2,N1)) + 2-0.0098*AMAX1(0.0,DPTHH-DPTHT(N2,N1)) + IF(PSISWTH.LT.0.0)PSISWTH=PSISWTH-PSISWD + FLWTH=PSISWTH*CNDH1(N3,N2,N1)*AREA(N,N3,N2,N1) + 2*(1.0-AREAU(N3,N2,N1))/(RCHGFU+1.0)*RCHGFT + FLWTHL=AMAX1(FLWTH,AMIN1(0.0,-XNPH*(VOLWH1(N3,N2,N1) + 2+FLWHL(3,N3,N2,N1)-FLWHL(3,N3+1,N2,N1)-FINHL(N3,N2,N1)))) + FLWHL(N,M6,M5,M4)=XN*FLWTHL + HFLWL(N,M6,M5,M4)=HFLWL(N,M6,M5,M4)+4.19*TK1(N3,N2,N1)*XN*FLWTHL +C WRITE(*,4446)'DISCHMA',I,J,M,N1,N2,N3,M4,M5,M6,N,NN,XN +C 2,FLWHL(N,M6,M5,M4),FLWTHL,FLWTH,PSISWTH,CNDH1(N3,N2,N1) +C 3,DPTH(N3,N2,N1),DLYR(3,N3,N2,N1),DPTHH,VOLWH1(N3,N2,N1) +C 4,VOLIH1(L,NY,NX),VOLAH1(N3,N2,N1),DTBLX(N2,N1),PSISWD +4446 FORMAT(A8,11I4,30E12.4) + ELSE + FLWHL(N,M6,M5,M4)=0.0 + ENDIF +C +C MICROPORE RECHARGE BELOW WATER TABLE +C + IF(IPRC(N2,N1).NE.3.AND.DPTH(N3,N2,N1).GE.DTBLX(N2,N1) +C 2.AND.DPTHA(N2,N1).GT.DTBLX(N2,N1) + 2.AND.(BKDS(N3,N2,N1).EQ.0.0.OR.VOLP2.GT.0.0))THEN + PSISWD=XN*0.005*SLOPE(N,N2,N1)*DLYR(N,N3,N2,N1) + 2*(1.0-DTBLG(N2,N1)) + PSISUT=AMAX1(0.0,PSISE(N3,N2,N1)-PSISM1(N3,N2,N1) + 2+0.0098*(DPTH(N3,N2,N1)-DTBLX(N2,N1))) + IF(PSISUT.GT.0.0)PSISUT=PSISUT+PSISWD + FLWU=PSISUT*HCND(N,1,N3,N2,N1)*XNPH*AREA(N,N3,N2,N1) + 2*AREAU(N3,N2,N1)/(RCHGFU+1.0)*RCHGFT + FLWUL=AMIN1(FLWU,AMAX1(0.0,VOLP2)) + FLWUX=AMIN1(FLWU,AMAX1(0.0,VOLPX2)) + FLWL(N,M6,M5,M4)=FLWL(N,M6,M5,M4)+XN*FLWUL + FLWLX(N,M6,M5,M4)=FLWLX(N,M6,M5,M4)+XN*FLWUX + HFLWL(N,M6,M5,M4)=HFLWL(N,M6,M5,M4)+4.19*TK1(N3,N2,N1) + 2*XN*FLWUL +C IF((I/30)*30.EQ.I.AND.J.EQ.15)THEN +C WRITE(*,4444)'RECHGMI',I,J,M,N1,N2,N3,M4,M5,M6,N,NN,IFLGU,XN +C 2,FLWL(N,M6,M5,M4),AREAU(N3,N2,N1),RCHGFT,VOLP2,FLWT +C 3,FLWU,FLWUL,PSISM1(N3,N2,N1),PSISA(N3,N2,N1) +C 4,PSISWT,PSISUT,PSISUTH,HCND(N,1,N3,N2,N1) +C 5,DTBLX(N2,N1),CDPTH(N3,N2,N1),DPTHT(N2,N1) +C 6,DDRG(N2,N1),DPTH(N3,N2,N1),VOLW1(N3,N2,N1),VOLI1(N3,N2,N1) +C 7,VOLX(N3,N2,N1),VOLP1(N3,N2,N1) +C 8,RCHGFU,AREA(N,N3,N2,N1) +C 9,FINHL(N3,N2,N1),DLYR(N,N3,N2,N1),DLYR(3,N3,N2,N1),PSISWD +C 1,SLOPE(N,N2,N1) +4444 FORMAT(A8,12I4,40E12.4) +C ENDIF + ENDIF +C +C MACROPORE RECHARGE BELOW WATER TABLE +C + IF(IPRC(N2,N1).NE.3.AND.DPTHH.GT.DTBLX(N2,N1) +C 2.AND.DPTHA(N2,N1).GT.DTBLX(N2,N1) + 2.AND.VOLPH2.GT.0.0)THEN + PSISWD=XN*0.005*SLOPE(N,N2,N1)*DLYR(N,N3,N2,N1) + 2*(1.0-DTBLG(N2,N1)) + PSISUTH=0.0098*(DPTHH-DTBLX(N2,N1)) + IF(PSISUTH.GT.0.0)PSISUTH=PSISUTH+PSISWD + FLWUH=PSISUTH*CNDH1(N3,N2,N1)*AREA(N,N3,N2,N1) + 2*AREAU(N3,N2,N1)/(RCHGFU+1.0)*RCHGFT + FLWUHL=AMIN1(FLWUH,AMAX1(0.0,XNPH*(VOLPH2 + 2-FLWHL(3,N3,N2,N1)+FLWHL(3,N3+1,N2,N1)+FINHL(N3,N2,N1)))) + FLWHL(N,M6,M5,M4)=FLWHL(N,M6,M5,M4)+XN*FLWUHL + HFLWL(N,M6,M5,M4)=HFLWL(N,M6,M5,M4)+4.19*TK1(N3,N2,N1) + 2*XN*FLWUHL +C IF(I.GT.208.AND.J.EQ.21)THEN +C WRITE(*,4447)'RECHGMA',I,J,M,N1,N2,N3,M4,M5,M6,N,NN,IFLGU,XN +C 2,AREAU(N3,N2,N1),FLWUH,FLWUHL,DPTHH,PSISUTH,CNDH1(N3,N2,N1) +C 5,FLWHL(N,M6,M5,M4),DTBLX(N2,N1),CDPTH(N3,N2,N1),DPTHT(N2,N1) +C 6,DDRG(N2,N1),DPTH(N3,N2,N1),VOLWH1(N3,N2,N1),VOLPH1(N3,N2,N1) +C 8,FLWHL(3,N3,N2,N1),FLWHL(3,N3+1,N2,N1),RCHGFU,AREA(N,N3,N2,N1) +C 9,FINHL(N3,N2,N1),DLYR(N,N3,N2,N1),DLYR(3,N3,N2,N1),PSISWD +C 1,SLOPE(N,N2,N1) +4447 FORMAT(A8,12I4,40E12.4) +C ENDIF + ENDIF + ENDIF +C +C SUBSURFACE HEAT SOURCE/SINK +C + IF(N.EQ.3.AND.IETYP(N2,N1).NE.-2)THEN + HFLWL(N,M6,M5,M4)=HFLWL(N,M6,M5,M4)+(TK1(N3,N2,N1) + 2-TKSD(N2,N1))*TCNDG/(DPTHSK(N2,N1)-CDPTH(N3,N2,N1)) + 3*AREA(N,N3,N2,N1)*XNPH + ENDIF + VOLP2=VOLP2-XN*FLWL(N,M6,M5,M4) + VOLPX2=VOLPX2-XN*FLWLX(N,M6,M5,M4) + VOLPH2=VOLPH2-XN*FLWHL(N,M6,M5,M4) + FLWLD=0.0 + FLWLXD=0.0 + FLWHLD=0.0 + FLW(N,M6,M5,M4)=FLW(N,M6,M5,M4)+FLWL(N,M6,M5,M4) + FLWX(N,M6,M5,M4)=FLWX(N,M6,M5,M4)+FLWLX(N,M6,M5,M4) + FLWH(N,M6,M5,M4)=FLWH(N,M6,M5,M4)+FLWHL(N,M6,M5,M4) + HFLW(N,M6,M5,M4)=HFLW(N,M6,M5,M4)+HFLWL(N,M6,M5,M4) + FLWM(M,N,M6,M5,M4)=FLWL(N,M6,M5,M4) + FLWHM(M,N,M6,M5,M4)=FLWHL(N,M6,M5,M4) + ENDIF +9575 CONTINUE +C +C TOTAL WATER AND HEAT FLUXES IN EACH GRID CELL +C + IF(L.EQ.NU(N2,N1).AND.N.NE.3)THEN + TQR1(N2,N1)=TQR1(N2,N1)+QR1(N,N2,N1)-QR1(N,N5,N4) + THQR1(N2,N1)=THQR1(N2,N1)+HQR1(N,N2,N1)-HQR1(N,N5,N4) + TQS1(N2,N1)=TQS1(N2,N1)+QS1(N,N2,N1)-QS1(N,N5,N4) + TQW1(N2,N1)=TQW1(N2,N1)+QW1(N,N2,N1)-QW1(N,N5,N4) + TQI1(N2,N1)=TQI1(N2,N1)+QI1(N,N2,N1)-QI1(N,N5,N4) + THQS1(N2,N1)=THQS1(N2,N1)+HQS1(N,N2,N1)-HQS1(N,N5,N4) + ENDIF + IF(NCN(N2,N1).NE.3.OR.N.EQ.3)THEN + TFLWL(N3,N2,N1)=TFLWL(N3,N2,N1)+FLWL(N,N3,N2,N1) + 2-FLWL(N,N6,N5,N4) + TFLWLX(N3,N2,N1)=TFLWLX(N3,N2,N1)+FLWLX(N,N3,N2,N1) + 2-FLWLX(N,N6,N5,N4) + TFLWHL(N3,N2,N1)=TFLWHL(N3,N2,N1)+FLWHL(N,N3,N2,N1) + 2-FLWHL(N,N6,N5,N4) + THFLWL(N3,N2,N1)=THFLWL(N3,N2,N1)+HFLWL(N,N3,N2,N1) + 2-HFLWL(N,N6,N5,N4) + TWFLXL(N3,N2,N1)=TWFLXL(N3,N2,N1)+WFLXL(N,N3,N2,N1) + TWFLXH(N3,N2,N1)=TWFLXH(N3,N2,N1)+WFLXLH(N,N3,N2,N1) + TTFLXL(N3,N2,N1)=TTFLXL(N3,N2,N1)+TFLXL(N,N3,N2,N1) +C IF(L.EQ.NU(NY,NX))THEN +C WRITE(*,3378)'THFLWL',I,J,M,N1,N2,N3,N4,N5,N6,N,THFLWL(N3,N2,N1) +C 3,HFLWL(N,N3,N2,N1),HFLWL(N,N6,N5,N4),TFLWL(N3,N2,N1) +C 3,FLWL(N,N3,N2,N1),FLWL(N,N6,N5,N4),TFLWHL(N3,N2,N1) +C 3,FLWHL(N,N3,N2,N1),FLWHL(N,N6,N5,N4) +3378 FORMAT(A8,10I4,20E12.4) +C ENDIF + ENDIF +9580 CONTINUE +9585 CONTINUE +9590 CONTINUE +9595 CONTINUE +C +C UPDATE STATE VARIABLES FROM FLUXES CALCULATED ABOVE +C + IF(M.NE.NPH)THEN + DO 9795 NX=NHW,NHE + DO 9790 NY=NVN,NVS +C +C SNOWPACK WATER, ICE, SNOW AND TEMPERATURE +C + IF(VHCP0(NY,NX).GT.VHCPWX(NY,NX))THEN + VOLS0(NY,NX)=VOLS0(NY,NX)+FLW0S(NY,NX) + 2-WFLXA(NY,NX)-FLWS1(NY,NX)+TQS1(NY,NX) + VOLW0(NY,NX)=VOLW0(NY,NX)+FLW0L(NY,NX) + 2+WFLXA(NY,NX)+WFLXB(NY,NX)-FLWZ1(NY,NX)+TQW1(NY,NX) + VOLI0(NY,NX)=VOLI0(NY,NX) + 2-WFLXB(NY,NX)/DENSI-FLWI1(NY,NX)+TQI1(NY,NX) + ENGY0=VHCP0(NY,NX)*TK0(NY,NX) + VHCP0(NY,NX)=2.095*VOLS0(NY,NX)+4.19*VOLW0(NY,NX) + 2+1.9274*VOLI0(NY,NX) + TK0(NY,NX)=(ENGY0+HFLW0L(NY,NX)+TFLX0(NY,NX)-HFLWZ1(NY,NX) + 2-HFLSI1(NY,NX)+THQS1(NY,NX))/VHCP0(NY,NX) + ELSE + VOLS0(NY,NX)=VOLS0(NY,NX)+FLQ0S(NY,NX)-FLWS1(NY,NX)+TQS1(NY,NX) + VOLW0(NY,NX)=VOLW0(NY,NX)+FLQ0W(NY,NX)-FLWZ1(NY,NX)+TQW1(NY,NX) + VOLI0(NY,NX)=VOLI0(NY,NX)-FLWI1(NY,NX)+TQI1(NY,NX) + VHCP0(NY,NX)=2.095*VOLS0(NY,NX)+4.19*VOLW0(NY,NX) + 2+1.9274*VOLI0(NY,NX) + TK0(NY,NX)=TKQ(NY,NX) + ENDIF +C IF(NX.EQ.2.AND.NY.EQ.2)THEN +C WRITE(*,7754)'TKW',I,J,M,NX,NY,TK0(NY,NX) +C 3,VOLS0(NY,NX),VOLW0(NY,NX),VOLI0(NY,NX),VOLS1(NY,NX) +C 3,FLW0S(NY,NX),WFLXA(NY,NX),FLWS1(NY,NX),TQS1(NY,NX) +C 4,FLW0L(NY,NX),WFLXB(NY,NX),FLWZ1(NY,NX),TQW1(NY,NX) +C 5,FLWI1(NY,NX),TQI1(NY,NX),THFLWW(NY,NX),HWFLQ0(NY,NX) +C 2,HFLW0L(NY,NX),TFLX0(NY,NX),HFLWZ1(NY,NX),HFLSI1(NY,NX) +C 4,THQS1(NY,NX),VHCP0(NY,NX),VHCPWX(NY,NX) +C ENDIF +C +C SURFACE RESIDUE WATER AND TEMPERATURE +C + TVOL1(NY,NX)=AMAX1(0.0,VOLW1(0,NY,NX)+VOLI1(0,NY,NX) + 2-VOLWRX(NY,NX)) + TVOLW(NY,NX)=AMAX1(0.0,VOLW1(0,NY,NX)-VOLWRX(NY,NX)) + VOLGM(M+1,NY,NX)=AMAX1(0.0,TVOL1(NY,NX)) +C VOLXP2=(VOLP1(NU(NY,NX),NY,NX)+VOLPH1(NU(NY,NX),NY,NX)) +C 2*AMIN1(1.0,(VOLA(NU(NY,NX),NY,NX)+VOLAH1(NU(NY,NX),NY,NX)) +C 3/TVOL1(NY,NX)) +C VOLPX1(NU(NY,NX),NY,NX)=VOLXP2*HYST(NU(NY,NX),NY,NX) + VOLW1(0,NY,NX)=AMAX1(0.0,VOLW1(0,NY,NX)+FLWRL(NY,NX) + 2+WFLXR(NY,NX)+TQR1(NY,NX)) + VOLI1(0,NY,NX)=AMAX1(0.0,VOLI1(0,NY,NX)-WFLXR(NY,NX)/DENSI) + VOLP1(0,NY,NX)=AMAX1(0.0,VOLA(0,NY,NX)-VOLW1(0,NY,NX) + 2-VOLI1(0,NY,NX)) + VOLWM(M+1,0,NY,NX)=VOLW1(0,NY,NX) + VOLPM(M+1,0,NY,NX)=VOLP1(0,NY,NX) + IF(VOLR(NY,NX).GT.ZEROS(NY,NX))THEN + THETWX(0,NY,NX)=AMAX1(0.0,VOLW1(0,NY,NX)/VOLR(NY,NX)) + THETIX(0,NY,NX)=AMAX1(0.0,VOLI1(0,NY,NX)/VOLR(NY,NX)) + THETPX(0,NY,NX)=AMAX1(0.0,VOLP1(0,NY,NX)/VOLR(NY,NX)) + 2*AMAX1(0.0,(1.0-TVOL1(NY,NX)/VOLWD(NY,NX))) + ELSE + THETWX(0,NY,NX)=0.0 + THETIX(0,NY,NX)=0.0 + THETPX(0,NY,NX)=0.0 + ENDIF + THETPM(M+1,0,NY,NX)=THETPX(0,NY,NX) +C IF(NX.EQ.1.AND.NY.EQ.6)THEN +C WRITE(*,7752)'VOLW10',I,J,M,NX,NY,VOLW1(0,NY,NX) +C 2,VOLI1(0,NY,NX),VOLP1(0,NY,NX), THETWX(0,NY,NX) +C 3,THETIX(0,NY,NX),THETPX(0,NY,NX),TVOL1(NY,NX),VOLWD(NY,NX) +7752 FORMAT(A8,5I4,20E12.4) +C ENDIF + ENGYR=VHCPR1(NY,NX)*TK1(0,NY,NX) + VHCPR1(NY,NX)=2.496E-06*ORGC(0,NY,NX)+4.19*VOLW1(0,NY,NX) + 2+1.9274*VOLI1(0,NY,NX) + IF(VHCPR1(NY,NX).GT.VHCPRX(NY,NX))THEN + TK1(0,NY,NX)=(ENGYR+HFLWRL(NY,NX)+TFLXR(NY,NX) + 2+THQR1(NY,NX))/VHCPR1(NY,NX) +C WRITE(*,7754)'TKR',I,J,M,NX,NY,TK1(0,NY,NX),ENGYR,HFLWRL(NY,NX) +C 2,TFLXR(NY,NX),THQR1(NY,NX),VHCPR1(NY,NX),VOLW1(0,NY,NX) +7754 FORMAT(A8,5I4,30E12.4) + ELSE + TK1(0,NY,NX)=TK1(NU(NY,NX),NY,NX) + ENDIF +C +C SOIL SURFACE WATER FROM RUNOFF +C + VOLI1(NU(NY,NX),NY,NX)=VOLI1(NU(NY,NX),NY,NX)+FLSI1(NY,NX) + ENGY1=VHCP1(NU(NY,NX),NY,NX)*TK1(NU(NY,NX),NY,NX) + VHCP1(NU(NY,NX),NY,NX)=VHCM(NU(NY,NX),NY,NX) + 2+4.19*(VOLW1(NU(NY,NX),NY,NX)+VOLWH1(NU(NY,NX),NY,NX)) + 3+1.9274*(VOLI1(NU(NY,NX),NY,NX)+VOLIH1(NU(NY,NX),NY,NX)) + TK1(NU(NY,NX),NY,NX)=(ENGY1+HFLSI1(NY,NX)) + 2/VHCP1(NU(NY,NX),NY,NX) +C WRITE(*,7755)'TQR',I,J,M,NX,NY,VOLW1(NU(NY,NX),NY,NX) +C 2,VOLWH1(NU(NY,NX),NY,NX),TQR1(NY,NX) +C WRITE(*,7755)'TK1',I,J,M,NX,NY,TK1(NU(NY,NX),NY,NX) +C 2,VHCP1(NU(NY,NX),NY,NX),VHCM(NU(NY,NX),NY,NX) +C 2,ENGY1,THQR1(NY,NX),HFLSI1(NY,NX),TQR1(NY,NX) +C 3,VOLW1(NU(NY,NX),NY,NX),VOLWH1(NU(NY,NX),NY,NX) +C 4,VOLI1(NU(NY,NX),NY,NX),FLSI1(NY,NX) +7755 FORMAT(A8,5I4,20E12.4) +C +C SOIL LAYER WATER, ICE AND TEMPERATURE +C + DO 9785 L=NU(NY,NX),NL(NY,NX) + VOLW1(L,NY,NX)=VOLW1(L,NY,NX)+TFLWL(L,NY,NX) + 2+FINHL(L,NY,NX)+TWFLXL(L,NY,NX)+FLU1(L,NY,NX) + VOLWX1(L,NY,NX)=VOLWX1(L,NY,NX)+TFLWLX(L,NY,NX) + 2+FINHL(L,NY,NX)+TWFLXL(L,NY,NX)+FLU1(L,NY,NX)+FLWVL(L,NY,NX) + VOLWX1(L,NY,NX)=AMIN1(VOLW1(L,NY,NX),VOLWX1(L,NY,NX)) + VOLI1(L,NY,NX)=VOLI1(L,NY,NX)-TWFLXL(L,NY,NX)/DENSI + VOLWH1(L,NY,NX)=VOLWH1(L,NY,NX)+TFLWHL(L,NY,NX) + 2-FINHL(L,NY,NX)+TWFLXH(L,NY,NX) + VOLIH1(L,NY,NX)=VOLIH1(L,NY,NX)-TWFLXH(L,NY,NX)/DENSI + VOLP1(L,NY,NX)=AMAX1(0.0,VOLA(L,NY,NX)-VOLW1(L,NY,NX) + 2-VOLI1(L,NY,NX)) + VOLAH1(L,NY,NX)=AMAX1(0.0,VOLAH(L,NY,NX)-FVOLAH*CCLAY(L,NY,NX) + 2*(VOLW1(L,NY,NX)/VOLX(L,NY,NX)-WP(L,NY,NX))*VOLT(L,NY,NX)) + VOLPH1(L,NY,NX)=AMAX1(0.0,VOLAH1(L,NY,NX)-VOLWH1(L,NY,NX) + 2-VOLIH1(L,NY,NX)) + VOLPX1(L,NY,NX)=VOLP1(L,NY,NX)*HYST(L,NY,NX) + VOLWM(M+1,L,NY,NX)=VOLW1(L,NY,NX) + VOLWHM(M+1,L,NY,NX)=VOLWH1(L,NY,NX) + VOLPM(M+1,L,NY,NX)=VOLP1(L,NY,NX)+VOLPH1(L,NY,NX) + 2+THETPI*(VOLI1(L,NY,NX)+VOLIH1(L,NY,NX)) + FLPM(M,L,NY,NX)=VOLPM(M,L,NY,NX)-VOLPM(M+1,L,NY,NX) + THETWX(L,NY,NX)=AMAX1(0.0,(VOLW1(L,NY,NX)+VOLWH1(L,NY,NX)) + 2/VOLT(L,NY,NX)) + THETIX(L,NY,NX)=AMAX1(0.0,(VOLI1(L,NY,NX)+VOLIH1(L,NY,NX)) + 2/VOLT(L,NY,NX)) + THETPX(L,NY,NX)=AMAX1(0.0,(VOLP1(L,NY,NX)+VOLPH1(L,NY,NX)) + 2/VOLT(L,NY,NX)) + THETPM(M+1,L,NY,NX)=THETPX(L,NY,NX) + IF(VOLA(L,NY,NX)+VOLAH(L,NY,NX).GT.ZEROS(NY,NX))THEN + THETPY(L,NY,NX)=AMAX1(0.0,(VOLP1(L,NY,NX)+VOLPH1(L,NY,NX)) + 2/(VOLA(L,NY,NX)+VOLAH(L,NY,NX))) + ELSE + THETPY(L,NY,NX)=0.0 + ENDIF + IF(VOLAH(L,NY,NX).GT.ZEROS(NY,NX))THEN + FMAC(L,NY,NX)=FHOL(L,NY,NX)*VOLAH1(L,NY,NX)/VOLAH(L,NY,NX) + CNDH1(L,NY,NX)=XNPH*NHOL(L,NY,NX)*CNDH(L,NY,NX) + 2*(VOLAH1(L,NY,NX)/VOLAH(L,NY,NX))**2 + ELSE + FMAC(L,NY,NX)=0.0 + CNDH1(L,NY,NX)=0.0 + ENDIF + FGRD(L,NY,NX)=1.0-FMAC(L,NY,NX) + TKXX=TK1(L,NY,NX) + VHXX=VHCP1(L,NY,NX) + ENGY1=VHCP1(L,NY,NX)*TK1(L,NY,NX) + VHCP1(L,NY,NX)=VHCM(L,NY,NX)+4.19*(VOLW1(L,NY,NX) + 2+VOLWH1(L,NY,NX))+1.9274*(VOLI1(L,NY,NX)+VOLIH1(L,NY,NX)) +C +C ARTIFICIAL SOIL WARMING +C +C IF(NX.EQ.3.AND.NY.EQ.2.AND.L.GT.NU(NY,NX) +C 3.AND.L.LE.17.AND.I.GE.152.AND.I.LE.304)THEN +C THFLWL(L,NY,NX)=THFLWL(L,NY,NX) +C 2+(TKSZ(I,J,L)-TK1(L,NY,NX))*VHCP1(L,NY,NX)*XNPH +C WRITE(*,3379)'TKSZ',I,J,M,NX,NY,L,TKSZ(I,J,L) +C 2,TK1(L,NY,NX),VHCP1(L,NY,NX),THFLWL(L,NY,NX) +3379 FORMAT(A8,6I4,12E12.4) +C ENDIF +C +C ARTIFICIAL SOIL WARMING +C + TK1(L,NY,NX)=(ENGY1+THFLWL(L,NY,NX)+TTFLXL(L,NY,NX) + 2+HWFLU1(L,NY,NX))/VHCP1(L,NY,NX) +C IF(J.EQ.24.AND.L.EQ.NU(NY,NX))THEN +C WRITE(*,3377)'VOLW1',I,J,M,NX,NY,L,VOLW1(L,NY,NX) +C 2,VOLWH1(L,NY,NX),VOLI1(L,NY,NX),VOLIH1(L,NY,NX) +C 3,VOLP1(L,NY,NX),VOLPH1(L,NY,NX),VOLT(L,NY,NX) +C 4,VOLA(L,NY,NX),VOLAH(L,NY,NX) +C 5,VOLPM(M,L,NY,NX),VOLPM(M+1,L,NY,NX) +C 2,TFLWL(L,NY,NX),FINHL(L,NY,NX),TWFLXL(L,NY,NX),FLU1(L,NY,NX) +C 3,TQR1(NY,NX),VOLP1(L,NY,NX) +C 5,VOLPX1(L,NY,NX),HYST(L,NY,NX),PSISM1(L,NY,NX) +C 6,FLWL(3,L,NY,NX),FLWL(3,L+1,NY,NX) +C 7,FLWL(2,L,NY,NX),FLWL(2,L,NY+1,NX) +C 8,FLWL(1,L,NY,NX),FLWL(1,L,NY,NX+1) +C 9,FLPM(M,L,NY,NX) +C WRITE(*,3377)'VOLWH1',I,J,M,NX,NY,L,VOLWH1(L,NY,NX) +C 2,TFLWHL(L,NY,NX),FINHL(L,NY,NX),VOLIH1(L,NY,NX) +C 4,TWFLXH(L,NY,NX),TQR1(NY,NX),VOLPH1(L,NY,NX) +C 5,FLWHL(2,L,NY,NX),FLWHL(2,L,NY+1,NX) +C WRITE(*,3377)'TKL',I,J,M,NX,NY,L,TK1(L,NY,NX),ENGY1 +C 2,THFLWL(L,NY,NX),TTFLXL(L,NY,NX),HWFLU1(L,NY,NX),VHCP1(L,NY,NX) +C 3,VHCM(L,NY,NX),VOLW1(L,NY,NX),VOLWH1(L,NY,NX),VOLI1(L,NY,NX) +C 4,THETW(L,NY,NX),THETI(L,NY,NX),FINHL(L,NY,NX),THQR1(NY,NX) +C 5,HFLSI1(NY,NX),HFLWL(2,L,NY,NX),HFLWL(2,L,NY+1,NX) +3377 FORMAT(A8,6I4,40E12.4) +C ENDIF +9785 CONTINUE +9790 CONTINUE +9795 CONTINUE + ENDIF +3320 CONTINUE + RETURN + END + diff --git a/f77src/woutp.f b/f77src/woutp.f index dccdcd7..f130e23 100755 --- a/f77src/woutp.f +++ b/f77src/woutp.f @@ -223,9 +223,11 @@ SUBROUTINE woutp(I,NHW,NHE,NVN,NVS) WRITE(29,94)I,IDATA(3),NZ,(RUNNHP(N,L,NZ,NY,NX),L=1,NJ(NY,NX)) WRITE(29,94)I,IDATA(3),NZ,(RUNNOP(N,L,NZ,NY,NX),L=1,NJ(NY,NX)) WRITE(29,94)I,IDATA(3),NZ,(RUPPOP(N,L,NZ,NY,NX),L=1,NJ(NY,NX)) + WRITE(29,94)I,IDATA(3),NZ,(RUPP1P(N,L,NZ,NY,NX),L=1,NJ(NY,NX)) WRITE(29,94)I,IDATA(3),NZ,(RUNNBP(N,L,NZ,NY,NX),L=1,NJ(NY,NX)) WRITE(29,94)I,IDATA(3),NZ,(RUNNXP(N,L,NZ,NY,NX),L=1,NJ(NY,NX)) WRITE(29,94)I,IDATA(3),NZ,(RUPPBP(N,L,NZ,NY,NX),L=1,NJ(NY,NX)) + WRITE(29,94)I,IDATA(3),NZ,(RUPP1B(N,L,NZ,NY,NX),L=1,NJ(NY,NX)) WRITE(29,94)I,IDATA(3),NZ,(WFR(N,L,NZ,NY,NX),L=1,NJ(NY,NX)) WRITE(29,94)I,IDATA(3),NZ,(CPOOLR(N,L,NZ,NY,NX),L=1,NJ(NY,NX)) WRITE(29,94)I,IDATA(3),NZ,(ZPOOLR(N,L,NZ,NY,NX),L=1,NJ(NY,NX)) diff --git a/f77src/wouts.f b/f77src/wouts.f index b9de5c0..5aba849 100755 --- a/f77src/wouts.f +++ b/f77src/wouts.f @@ -35,7 +35,6 @@ SUBROUTINE wouts(I,NHW,NHE,NVN,NVS) WRITE(21,90)I,IDATA(3),CRAIN,TSEDOU 2,HEATIN,OXYGIN,TORGF,TORGN,TORGP,CO2GIN,ZN2GIN,VOLWOU,CEVAP,CRUN 3,HEATOU,OXYGOU,TCOU,TZOU,TPOU,TZIN,TPIN,XCSN,XZSN,XPSN - 4,TFERTN,TFERTP DO 9995 NX=NHW,NHE DO 9990 NY=NVN,NVS WRITE(21,95)I,IDATA(3),(TDTPX(NY,NX,N),N=1,12) @@ -50,7 +49,7 @@ SUBROUTINE wouts(I,NHW,NHE,NVN,NVS) 4,TVOLWC(NY,NX),VOLSS(NY,NX),VOLWS(NY,NX),VOLIS(NY,NX),VOLS(NY,NX) 5,DPTHS(NY,NX),TCW(NY,NX),TKW(NY,NX),VHCPW(NY,NX),VHCPR(NY,NX) 6,VOLWG(NY,NX),URAIN(NY,NX),ARLFC(NY,NX),ARSTC(NY,NX),PPT(NY,NX) - 7,ZM(NY,NX),UCO2G(NY,NX),UCH4G(NY,NX),UOXYG(NY,NX) + 7,VOLWD(NY,NX),ZM(NY,NX),UCO2G(NY,NX),UCH4G(NY,NX),UOXYG(NY,NX) 8,UN2GG(NY,NX),UN2OG(NY,NX),UNH3G(NY,NX),UN2GS(NY,NX),UCO2F(NY,NX) 9,UCH4F(NY,NX),UOXYF(NY,NX),UN2OF(NY,NX),UNH3F(NY,NX),UPO4F(NY,NX) 1,UORGF(NY,NX),UFERTN(NY,NX),UFERTP(NY,NX),UVOLO(NY,NX) @@ -62,7 +61,7 @@ SUBROUTINE wouts(I,NHW,NHE,NVN,NVS) 7,DPPO4(NY,NX),CO2W(NY,NX),CH4W(NY,NX),OXYW(NY,NX),ZN2W(NY,NX) 8,ZNGW(NY,NX),ZN4W(NY,NX),ZN3W(NY,NX),ZNOW(NY,NX),ZHPW(NY,NX) 9,H2GW(NY,NX),DETS(NY,NX),COHS(NY,NX),CER(NY,NX),XER(NY,NX) - 1,USEDOU(NY,NX),ROWN(NY,NX),ROWO(NY,NX),ROWP(NY,NX) + 1,USEDOU(NY,NX),ROWN(NY,NX),ROWO(NY,NX),ROWP(NY,NX),Z1PW(NY,NX) 2,DTBLZ(NY,NX),DDRG(NY,NX),TNBP(NY,NX),VOLR(NY,NX),SED(NY,NX) 3,TGPP(NY,NX),TRAU(NY,NX),TNPP(NY,NX),THRE(NY,NX) 4,TLEC(NY,NX),TSHC(NY,NX),DYLN(NY,NX),DYLX(NY,NX) @@ -76,7 +75,7 @@ SUBROUTINE wouts(I,NHW,NHE,NVN,NVS) 7,ZFEH4W(NY,NX),ZFESW(NY,NX),ZCAOW(NY,NX),ZCACW(NY,NX) 8,ZCAHW(NY,NX),ZCASW(NY,NX),ZMGOW(NY,NX),ZMGCW(NY,NX),ZMGHW(NY,NX) 9,ZMGSW(NY,NX),ZNACW(NY,NX),ZNASW(NY,NX),ZKASW(NY,NX),H0PO4W(NY,NX) - 1,H1PO4W(NY,NX),H3PO4W(NY,NX),ZFE1PW(NY,NX),ZFE2PW(NY,NX) + 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)) @@ -134,10 +133,12 @@ SUBROUTINE wouts(I,NHW,NHE,NVN,NVS) WRITE(21,91)I,IDATA(3),(RNO2X(L,NY,NX),L=0,NL(NY,NX)) WRITE(21,91)I,IDATA(3),(RN2OX(L,NY,NX),L=0,NL(NY,NX)) WRITE(21,91)I,IDATA(3),(RPO4X(L,NY,NX),L=0,NL(NY,NX)) + WRITE(21,91)I,IDATA(3),(RP14X(L,NY,NX),L=0,NL(NY,NX)) WRITE(21,91)I,IDATA(3),(RNHBX(L,NY,NX),L=0,NL(NY,NX)) WRITE(21,91)I,IDATA(3),(RN3BX(L,NY,NX),L=0,NL(NY,NX)) WRITE(21,91)I,IDATA(3),(RN2BX(L,NY,NX),L=0,NL(NY,NX)) WRITE(21,91)I,IDATA(3),(RPOBX(L,NY,NX),L=0,NL(NY,NX)) + WRITE(21,91)I,IDATA(3),(RP1BX(L,NY,NX),L=0,NL(NY,NX)) WRITE(21,95)I,IDATA(3),((ROQCX(K,L,NY,NX),L=0,NL(NY,NX)),K=0,4) WRITE(21,95)I,IDATA(3),((ROQAX(K,L,NY,NX),L=0,NL(NY,NX)),K=0,4) WRITE(21,91)I,IDATA(3),(VOLWH(L,NY,NX),L=1,NL(NY,NX)) @@ -213,7 +214,6 @@ SUBROUTINE wouts(I,NHW,NHE,NVN,NVS) WRITE(21,91)I,IDATA(3),(ZNAS(L,NY,NX),L=1,NL(NY,NX)) WRITE(21,91)I,IDATA(3),(ZKAS(L,NY,NX),L=1,NL(NY,NX)) WRITE(21,91)I,IDATA(3),(H0PO4(L,NY,NX),L=1,NL(NY,NX)) - WRITE(21,91)I,IDATA(3),(H1PO4(L,NY,NX),L=1,NL(NY,NX)) WRITE(21,91)I,IDATA(3),(H3PO4(L,NY,NX),L=1,NL(NY,NX)) WRITE(21,91)I,IDATA(3),(ZFE1P(L,NY,NX),L=1,NL(NY,NX)) WRITE(21,91)I,IDATA(3),(ZFE2P(L,NY,NX),L=1,NL(NY,NX)) @@ -222,7 +222,6 @@ SUBROUTINE wouts(I,NHW,NHE,NVN,NVS) WRITE(21,91)I,IDATA(3),(ZCA2P(L,NY,NX),L=1,NL(NY,NX)) WRITE(21,91)I,IDATA(3),(ZMG1P(L,NY,NX),L=1,NL(NY,NX)) WRITE(21,91)I,IDATA(3),(H0POB(L,NY,NX),L=1,NL(NY,NX)) - WRITE(21,91)I,IDATA(3),(H1POB(L,NY,NX),L=1,NL(NY,NX)) WRITE(21,91)I,IDATA(3),(H3POB(L,NY,NX),L=1,NL(NY,NX)) WRITE(21,91)I,IDATA(3),(ZFE1PB(L,NY,NX),L=1,NL(NY,NX)) WRITE(21,91)I,IDATA(3),(ZFE2PB(L,NY,NX),L=1,NL(NY,NX)) @@ -264,7 +263,6 @@ SUBROUTINE wouts(I,NHW,NHE,NVN,NVS) WRITE(21,91)I,IDATA(3),(ZNASH(L,NY,NX),L=1,NL(NY,NX)) WRITE(21,91)I,IDATA(3),(ZKASH(L,NY,NX),L=1,NL(NY,NX)) WRITE(21,91)I,IDATA(3),(H0PO4H(L,NY,NX),L=1,NL(NY,NX)) - WRITE(21,91)I,IDATA(3),(H1PO4H(L,NY,NX),L=1,NL(NY,NX)) WRITE(21,91)I,IDATA(3),(H3PO4H(L,NY,NX),L=1,NL(NY,NX)) WRITE(21,91)I,IDATA(3),(ZFE1PH(L,NY,NX),L=1,NL(NY,NX)) WRITE(21,91)I,IDATA(3),(ZFE2PH(L,NY,NX),L=1,NL(NY,NX)) @@ -273,7 +271,6 @@ SUBROUTINE wouts(I,NHW,NHE,NVN,NVS) WRITE(21,91)I,IDATA(3),(ZCA2PH(L,NY,NX),L=1,NL(NY,NX)) WRITE(21,91)I,IDATA(3),(ZMG1PH(L,NY,NX),L=1,NL(NY,NX)) WRITE(21,91)I,IDATA(3),(H0POBH(L,NY,NX),L=1,NL(NY,NX)) - WRITE(21,91)I,IDATA(3),(H1POBH(L,NY,NX),L=1,NL(NY,NX)) WRITE(21,91)I,IDATA(3),(H3POBH(L,NY,NX),L=1,NL(NY,NX)) WRITE(21,91)I,IDATA(3),(ZFE1BH(L,NY,NX),L=1,NL(NY,NX)) WRITE(21,91)I,IDATA(3),(ZFE2BH(L,NY,NX),L=1,NL(NY,NX)) @@ -283,6 +280,7 @@ SUBROUTINE wouts(I,NHW,NHE,NVN,NVS) WRITE(21,91)I,IDATA(3),(ZMG1BH(L,NY,NX),L=1,NL(NY,NX)) WRITE(21,91)I,IDATA(3),(XHY(L,NY,NX),L=1,NL(NY,NX)) WRITE(21,91)I,IDATA(3),(XAL(L,NY,NX),L=1,NL(NY,NX)) + WRITE(21,91)I,IDATA(3),(XFE(L,NY,NX),L=1,NL(NY,NX)) WRITE(21,91)I,IDATA(3),(XCA(L,NY,NX),L=1,NL(NY,NX)) WRITE(21,91)I,IDATA(3),(XMG(L,NY,NX),L=1,NL(NY,NX)) WRITE(21,91)I,IDATA(3),(XNA(L,NY,NX),L=1,NL(NY,NX)) @@ -307,7 +305,7 @@ SUBROUTINE wouts(I,NHW,NHE,NVN,NVS) WRITE(22,91)I,IDATA(3),(RIPOO(N,K,L,NY,NX),L=0,NL(NY,NX)) WRITE(22,91)I,IDATA(3),(RINHB(N,K,L,NY,NX),L=0,NL(NY,NX)) WRITE(22,91)I,IDATA(3),(RINOB(N,K,L,NY,NX),L=0,NL(NY,NX)) - WRITE(22,91)I,IDATA(3),(RIPOB(N,K,L,NY,NX),L=0,NL(NY,NX)) + WRITE(22,91)I,IDATA(3),(RIPBO(N,K,L,NY,NX),L=0,NL(NY,NX)) IF(K.LE.4)THEN WRITE(22,91)I,IDATA(3),(ROQCS(N,K,L,NY,NX),L=0,NL(NY,NX)) WRITE(22,91)I,IDATA(3),(ROQAS(N,K,L,NY,NX),L=0,NL(NY,NX)) @@ -371,7 +369,9 @@ SUBROUTINE wouts(I,NHW,NHE,NVN,NVS) WRITE(22,91)I,IDATA(3),(ZNO3SH(L,NY,NX),L=1,NL(NY,NX)) WRITE(22,91)I,IDATA(3),(ZNO2S(L,NY,NX),L=0,NL(NY,NX)) WRITE(22,91)I,IDATA(3),(ZNO2SH(L,NY,NX),L=1,NL(NY,NX)) + WRITE(22,91)I,IDATA(3),(H1PO4(L,NY,NX),L=0,NL(NY,NX)) WRITE(22,91)I,IDATA(3),(H2PO4(L,NY,NX),L=0,NL(NY,NX)) + WRITE(22,91)I,IDATA(3),(H1PO4H(L,NY,NX),L=1,NL(NY,NX)) WRITE(22,91)I,IDATA(3),(H2PO4H(L,NY,NX),L=1,NL(NY,NX)) WRITE(22,91)I,IDATA(3),(ZNH4B(L,NY,NX),L=0,NL(NY,NX)) WRITE(22,91)I,IDATA(3),(ZNH4BH(L,NY,NX),L=1,NL(NY,NX)) @@ -381,7 +381,9 @@ SUBROUTINE wouts(I,NHW,NHE,NVN,NVS) WRITE(22,91)I,IDATA(3),(ZNO3BH(L,NY,NX),L=1,NL(NY,NX)) WRITE(22,91)I,IDATA(3),(ZNO2B(L,NY,NX),L=0,NL(NY,NX)) WRITE(22,91)I,IDATA(3),(ZNO2BH(L,NY,NX),L=1,NL(NY,NX)) + WRITE(22,91)I,IDATA(3),(H1POB(L,NY,NX),L=0,NL(NY,NX)) WRITE(22,91)I,IDATA(3),(H2POB(L,NY,NX),L=0,NL(NY,NX)) + WRITE(22,91)I,IDATA(3),(H1POBH(L,NY,NX),L=1,NL(NY,NX)) WRITE(22,91)I,IDATA(3),(H2POBH(L,NY,NX),L=1,NL(NY,NX)) WRITE(22,91)I,IDATA(3),(WDNHB(L,NY,NX),L=1,NL(NY,NX)) WRITE(22,91)I,IDATA(3),(DPNHB(L,NY,NX),L=1,NL(NY,NX))