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/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 81a4430..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,TORTH(JZ,JY,JX) + 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,TORT(0:JZ,JY,JX),THAWR(JY,JX),HTHAWR(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 e9d2066..56cbdad 100755 --- a/f77src/blk12b.h +++ b/f77src/blk12b.h @@ -1,14 +1,18 @@ - 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) + 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),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/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/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 023ae58..a7b7d55 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) + 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/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/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 4c7dfec..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,102 +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(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 - 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 - CORP=0.20 - ZS(NY,NX)=0.04 - ENDIF - IF(ITILL(I,NY,NX).EQ.11)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 - ZS(NY,NX)=0.04 - ENDIF - IF(ITILL(I,NY,NX).EQ.14)THEN - CORP=0.05 - ZS(NY,NX)=0.04 - ENDIF - IF(ITILL(I,NY,NX).EQ.15)THEN - CORP=0.25 - ZS(NY,NX)=0.04 - ENDIF - IF(ITILL(I,NY,NX).EQ.16)THEN - CORP=0.15 - ZS(NY,NX)=0.04 - ENDIF - IF(ITILL(I,NY,NX).EQ.17)THEN - CORP=0.05 - ZS(NY,NX)=0.04 - ENDIF - IF(ITILL(I,NY,NX).EQ.18)THEN - CORP=0.10 - 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 - CORP=1.00 - ZS(NY,NX)=0.01 - ENDIF - 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 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 517ede4..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) @@ -166,9 +169,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 @@ -178,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/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..5d7b989 100755 --- a/f77src/grosub.f +++ b/f77src/grosub.f @@ -34,24 +34,23 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) 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) + 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) + 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,ATRPX=276.91,FSNR=2.884E-03,FLG4X=168.0 - 3,FLGZX=240.0,XFRX=2.5E-02,XFRY=2.5E-03,IFLGRX=960 + 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(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 @@ -59,32 +58,29 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) 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) + 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.067,0.167/ - DATA RCCY/0.333,0.333,0.133,0.333/ - DATA RCCX/0.250,0.750,0.750/ + 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.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 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.500,0.750/,FXRT/0.500,0.250/ + DATA FXSH/0.50,0.75/,FXRT/0.50,0.25/ DATA FRSV/0.025,0.025,0.001,0.001/ - DATA FXFV/0.05,0.005/,FXFZ/0.25,0.005/ + 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 @@ -269,13 +265,15 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) 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) +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) - TKSM=AMAX1(258.15,TKS(L,NY,NX))+OFFST(NZ,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) @@ -284,7 +282,7 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) 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) + 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 @@ -426,15 +424,14 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) 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 + 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 - ENDIF - IF(IWTYP(NZ,NY,NX).GE.2 + 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 @@ -946,9 +943,9 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) 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) + 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)) + 2+CCPOLB(NB,NZ,NY,NX)*CPKI)) ELSE CNPG=1.0 ENDIF @@ -1027,9 +1024,9 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) 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) + 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)) + 4+CCPOLB(NB,NZ,NY,NX)*CPKI)) ELSE CNPG=1.0 ENDIF @@ -1231,9 +1228,9 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) 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) + 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)) + 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 @@ -1377,13 +1374,13 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) 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) + 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)) + 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) + 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) + 2+CPPOLB(NB,NZ,NY,NX)/CPKI) ELSE CCC=0.0 CNC=0.0 @@ -1920,7 +1917,7 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) C SNCZ=FXFS*SNCR SNCT=SNCR+SNCZ - IF(SNCT.GT.ZEROP(NZ,NY,NX) + 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) @@ -2121,15 +2118,15 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) 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 +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 @@ -2587,21 +2584,53 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) 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.OR.IWTYP(NZ,NY,NX).NE.0)THEN + 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.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 + 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 @@ -2649,33 +2678,12 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) 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 + 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)) @@ -2721,16 +2729,21 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) 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 + IFLGA(NB,NZ,NY,NX)=0 ENDIF ENDIF ENDIF @@ -2739,7 +2752,7 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) 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 + IF(IFLGQ(NB,NZ,NY,NX).EQ.IFLGQX)THEN IFLGR(NB,NZ,NY,NX)=0 IFLGQ(NB,NZ,NY,NX)=0 ENDIF @@ -2809,9 +2822,9 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) 2010 CONTINUE ENDIF C -C SELF-SEEDING ANNUALS IF DROUGHT DECIDUOUS +C SELF-SEEDING ANNUALS IF COLD OR DROUGHT DECIDUOUS C - IF(J.EQ.INT(ZNOON(NY,NX)))THEN +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 @@ -2836,7 +2849,7 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) 3366 FORMAT(A8,8I8) ENDIF ENDIF - ENDIF +C ENDIF ENDIF C C TRANSFER C,N,P FROM SEASONAL STORAGE TO SHOOT AND ROOT @@ -2844,11 +2857,13 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) 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 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 @@ -2875,7 +2890,7 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) ELSE ATRPPD=1.0 ENDIF - DATRP=ATRPPD*TFN3(NZ,NY,NX)*WFNSG + 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 @@ -2883,7 +2898,7 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) 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 + 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) @@ -2891,7 +2906,7 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) 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 + 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) @@ -3010,7 +3025,8 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) 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 + 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)) @@ -3040,8 +3056,8 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) 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) + CNR=CWTRSV/(CWTRSV+CWTRSN/CNKI) + CPR=CWTRSV/(CWTRSV+CWTRSP/CPKI) ELSE CNR=0.0 CPR=0.0 @@ -3063,9 +3079,9 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) 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) + 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) + 2+CPPOLB(NB,NZ,NY,NX)/CPKI) ELSE CNL=0.0 CPL=0.0 @@ -3098,18 +3114,14 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) 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 + 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=FXFV(NS)*CPOOLD + 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 @@ -3118,8 +3130,8 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) 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 + 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 @@ -3127,20 +3139,19 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) 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 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(NS.EQ.0)THEN + 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=AMIN1(CPOOLR(1,L,NZ,NY,NX),AMAX1(-WTRSVB(NB,NZ,NY,NX) - 2,FXFV(NS)*CPOOLD)) + 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) @@ -3149,10 +3160,8 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) 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)) + 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 @@ -3161,7 +3170,7 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) 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) +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 @@ -3224,11 +3233,11 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) CPPOLN=1.0 ENDIF IF(CCPOLN.GT.ZERO)THEN - CCC=AMIN1(CZPOLN/(CZPOLN+CCPOLN/CNKI) - 2,CPPOLN/(CPPOLN+CCPOLN/CPKI)) - CNC=CCPOLN/(CCPOLN+CZPOLN*CNKI) - CPC=CCPOLN/(CCPOLN+CPPOLN*CPKI) - CNF=CCPOLN/(CCPOLN+CZPOLN*CNKF) + CCC=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 @@ -3281,7 +3290,7 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) C C NODULE C,N,P REMOBILIZATION AND DECOMPOSITION AND LEAKAGE C - RCCC=RCCZ(IBTYP(NZ,NY,NX))+CCC*RCCY(IBTYP(NZ,NY,NX)) + RCCC=RCCZN+CCC*RCCYN RCCN=CNC*RCCX(IGTYP(NZ,NY,NX)) RCCP=CPC*RCCQ(IGTYP(NZ,NY,NX)) SPNDX=SPNDL*RDNDBX @@ -3360,7 +3369,8 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) IF(CPOOL(NB,NZ,NY,NX).GT.ZEROP(NZ,NY,NX) 2.AND.WTLSB(NB,NZ,NY,NX).GT.ZEROL(NZ,NY,NX))THEN WTLSB1=WTLSB(NB,NZ,NY,NX) - WTNDB1=AMIN1(WTLSB(NB,NZ,NY,NX),WTNDB(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 @@ -3421,13 +3431,13 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) 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)) + 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)) + 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)) + 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 @@ -3439,19 +3449,24 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) 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) + 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,WFR(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 @@ -3551,8 +3566,8 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) 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)) + 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 @@ -3619,19 +3634,19 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) 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) + 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)) + 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) + 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) + 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)) + RCCC=RCCZR+CCC*RCCYR RCCN=CNC*RCCX(IGTYP(NZ,NY,NX)) RCCP=CPC*RCCQ(IGTYP(NZ,NY,NX)) IF(-RCO2XM.GT.0.0)THEN @@ -3750,6 +3765,7 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) 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) @@ -3785,8 +3801,8 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) 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)) + 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 @@ -3854,19 +3870,19 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) 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) + 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)) + 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) + 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) + 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)) + RCCC=RCCZR+CCC*RCCYR RCCN=CNC*RCCX(IGTYP(NZ,NY,NX)) RCCP=CPC*RCCQ(IGTYP(NZ,NY,NX)) IF(-RCO2XM.GT.0.0)THEN @@ -4459,11 +4475,11 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) CPPOLN=1.0 ENDIF IF(CCPOLN.GT.ZERO)THEN - CCC=AMIN1(CZPOLN/(CZPOLN+CCPOLN/CNKI) - 2,CPPOLN/(CPPOLN+CCPOLN/CPKI)) - CNC=CCPOLN/(CCPOLN+CZPOLN*CNKI) - CPC=CCPOLN/(CCPOLN+CPPOLN*CPKI) - CNF=CCPOLN/(CCPOLN+CZPOLN*CNKF) + CCC=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 @@ -4523,7 +4539,7 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) C C NODULE C,N,P REMOBILIZATION AND DECOMPOSITION C - RCCC=RCCZ(IBTYP(NZ,NY,NX))+CCC*RCCY(IBTYP(NZ,NY,NX)) + RCCC=RCCZN+CCC*RCCYN RCCN=CNC*RCCX(IGTYP(NZ,NY,NX)) RCCP=CPC*RCCQ(IGTYP(NZ,NY,NX)) SPNDX=SPNDL*RDNDLX @@ -4603,7 +4619,7 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) 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 + 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 @@ -4656,7 +4672,7 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) 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 + 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)) @@ -4670,7 +4686,7 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) 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(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 @@ -4780,9 +4796,9 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) 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 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 2+CPPOLR(N,L,NZ,NY,NX)/CPKI) C ELSE C CNL=0.0 C CPL=0.0 @@ -4865,7 +4881,7 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) 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 + 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 @@ -4875,12 +4891,7 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) 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) + 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 @@ -4961,7 +4972,7 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) 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) + 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 @@ -5298,7 +5309,7 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) C C CUT SHEATHS OR PETIOLES AND STALKS HARVESTED NODES AND LAYERS C - HTSTKX=-1.0 + 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) @@ -5306,11 +5317,12 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) 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) +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 @@ -5547,7 +5559,6 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) 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 @@ -5555,38 +5566,38 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) 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) + 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 - FHGT=0.0 + FHGTK=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)) + FHVSTS=AMAX1(0.0,1.0-FHGTK*EHVST(1,3,NZ,I,NY,NX)) ELSE - FHVST=AMAX1(0.0,1.0-THIN(NZ,I,NY,NX)) + FHVSTS=AMAX1(0.0,1.0-THIN(NZ,I,NY,NX)) ENDIF ELSE - FHVST=1.0 + FHVSTS=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))) + FHVSTS=AMAX1(0.0,AMIN1(1.0,1.0-WHVSTH/WTSTK(NZ,NY,NX))) ELSE - FHVST=1.0 + FHVSTS=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) + 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)=FHVST*HTNODX(K,NB,NZ,NY,NX) + 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),FHGT,FHVST,ARLF(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 @@ -5631,7 +5642,8 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) 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 + 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 @@ -5994,9 +6006,13 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) 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(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 @@ -6004,13 +6020,11 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) WTLS(NZ,NY,NX)=0.0 WVSTK(NZ,NY,NX)=0.0 C -C TERMINATE BRANCHES IF TILLAGE IMPLEMENT 20 IS SELECTED +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(XHVST.LE.1.0E-03)THEN - IDTHB(NB,NZ,NY,NX)=1 - ENDIF + IF(PP(NZ,NY,NX).LE.0.0)IDTHB(NB,NZ,NY,NX)=1 C C LITTERFALL FROM BRANCHES DURING TILLAGE C @@ -6164,12 +6178,15 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) 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 TERMINATE ROOTS IF TILLAGE IMPLEMENT 10 IS SELECTED C - IF(XHVST.LE.1.0E-03)THEN + 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 @@ -6333,12 +6350,10 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) 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 + 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 @@ -6358,8 +6373,7 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) 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)) + 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) @@ -6368,8 +6382,7 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) 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)) + 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) @@ -6378,8 +6391,7 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) 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)) + 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) @@ -6422,12 +6434,24 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) 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) + 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 @@ -6986,11 +7010,12 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) 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) + 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 @@ -7227,8 +7252,9 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) 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 +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 @@ -7426,6 +7452,7 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) 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) @@ -7511,3 +7538,6 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) 9995 CONTINUE RETURN END + + + diff --git a/f77src/hfunc.f b/f77src/hfunc.f index 8ce4cba..447a1ef 100755 --- a/f77src/hfunc.f +++ b/f77src/hfunc.f @@ -28,7 +28,7 @@ SUBROUTINE hfunc(I,J,NHW,NHE,NVN,NVS) include "blk16.h" include "blk18a.h" include "blk18b.h" - DIMENSION NBX(0:3),PSILY(0:2),FLG4Y(0:3) + 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) @@ -37,15 +37,14 @@ SUBROUTINE hfunc(I,J,NHW,NHE,NVN,NVS) 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 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) -4444 FORMAT(A8,4I8,A16,20I8) +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 @@ -216,7 +215,7 @@ SUBROUTINE hfunc(I,J,NHW,NHE,NVN,NVS) 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 + 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 @@ -247,6 +246,7 @@ SUBROUTINE hfunc(I,J,NHW,NHE,NVN,NVS) ENDIF ENDIF ENDIF +2224 FORMAT(A8,6I4) C C THE REST OF THE SUBROUTINE MODELS THE PHENOLOGY OF EACH BRANCH C @@ -256,6 +256,9 @@ SUBROUTINE hfunc(I,J,NHW,NHE,NVN,NVS) 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 @@ -314,9 +317,15 @@ SUBROUTINE hfunc(I,J,NHW,NHE,NVN,NVS) 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 + 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 @@ -328,23 +337,22 @@ SUBROUTINE hfunc(I,J,NHW,NHE,NVN,NVS) 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 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,5I4,20E12.4) +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)) - 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 + 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 @@ -352,7 +360,6 @@ SUBROUTINE hfunc(I,J,NHW,NHE,NVN,NVS) ENDIF ENDIF ENDIF - ENDIF C C STEM ELONGATION C @@ -398,9 +405,8 @@ SUBROUTINE hfunc(I,J,NHW,NHE,NVN,NVS) 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) + 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 @@ -427,14 +433,14 @@ SUBROUTINE hfunc(I,J,NHW,NHE,NVN,NVS) 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 +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 - ENDIF +C ENDIF ENDIF C C END SEED NUMBER SET PERIOD @@ -442,13 +448,13 @@ SUBROUTINE hfunc(I,J,NHW,NHE,NVN,NVS) 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 +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 - ENDIF +C ENDIF ENDIF C C END SEED SIZE SET PERIOD @@ -473,15 +479,6 @@ SUBROUTINE hfunc(I,J,NHW,NHE,NVN,NVS) 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 @@ -493,13 +490,13 @@ SUBROUTINE hfunc(I,J,NHW,NHE,NVN,NVS) VRNZ(NB,NZ,NY,NX)=VRNZ(NB,NZ,NY,NX)+1.0 ENDIF C -C CALCULATE EVERGREEN PHENOLOGY DURING LENGTHENING PHOTOPERIODS +C CALCULATE PHENOLOGY DURING LENGTHENING PHOTOPERIODS C - IF(IWTYP(NZ,NY,NX).EQ.0.AND.ISTYP(NZ,NY,NX).NE.0)THEN + 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).OR. - 2(ALAT(NY,NX).GT.0.0.AND.I.EQ.173) + 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 @@ -510,44 +507,47 @@ SUBROUTINE hfunc(I,J,NHW,NHE,NVN,NVS) 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) + 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 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).OR.DYLN(NY,NX).GE.DYLM(NY,NX)-2.0) - 2.AND.IFLGE(NB,NZ,NY,NX).EQ.0)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.5) + 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))THEN + 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 - 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) + 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 CALCULATE WINTER DECIDUOUS PHENOLOGY BY ACCUMULATING HOURS BELOW +C SPECIFIED TEMPERATURE 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(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 @@ -557,9 +557,15 @@ SUBROUTINE hfunc(I,J,NHW,NHE,NVN,NVS) 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 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 @@ -579,8 +585,8 @@ SUBROUTINE hfunc(I,J,NHW,NHE,NVN,NVS) 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 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 @@ -603,8 +609,9 @@ SUBROUTINE hfunc(I,J,NHW,NHE,NVN,NVS) ENDIF ENDIF C -C CALCULATE WINTER AND DROUGHT DECIDUOUS PHENOLOGY BY ACCUMULATING HOURS -C IN SPECIFIED TEMPERATURE RANGES DURING LENGTHENING PHOTOPERIODS +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) @@ -630,8 +637,9 @@ SUBROUTINE hfunc(I,J,NHW,NHE,NVN,NVS) 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 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 @@ -662,3 +670,4 @@ SUBROUTINE hfunc(I,J,NHW,NHE,NVN,NVS) 9995 CONTINUE RETURN END + diff --git a/f77src/hour1.f b/f77src/hour1.f index aec5a13..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 @@ -568,7 +569,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 @@ -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,22 +782,27 @@ 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)*SL(NY,NX)/57.29578) - 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 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 @@ -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,13 +941,15 @@ 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 - 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 @@ -972,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 @@ -1015,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 @@ -1024,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 @@ -1035,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 @@ -1065,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 @@ -1105,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 @@ -1114,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 @@ -1185,14 +1201,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)) @@ -1254,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 @@ -1283,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 @@ -1298,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) @@ -1312,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) @@ -1402,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 @@ -1575,16 +1595,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) @@ -1600,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 @@ -1608,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 @@ -1629,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 @@ -1649,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)) @@ -1686,18 +1717,19 @@ 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) 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) @@ -1705,9 +1737,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 @@ -2561,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) @@ -2818,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 @@ -2829,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 @@ -2851,3 +2883,4 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) XNPD=600.0*XNPG RETURN END + 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..0d25191 100755 --- a/f77src/nitro.f +++ b/f77src/nitro.f @@ -20,16 +20,17 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) 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),FOSRH(0:4),RUPOX(7,0:5) + 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) + 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) @@ -47,36 +48,37 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) 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) + 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) - 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) + 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.750 + 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 - 6,CNKI=1.0E+01,CPKI=1.0E+02) + 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.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 + 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,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 + 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 @@ -96,37 +98,32 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) 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 + 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/10.0,1.5/ + DATA SPORC/7.5,1.25/ 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 +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)) @@ -135,8 +132,8 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) 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)) + 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 @@ -147,21 +144,18 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) 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))) + 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 - 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))) + 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 @@ -195,10 +189,18 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) 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) + 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) @@ -309,19 +311,19 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) 690 CONTINUE DO 790 K=0,KL IF(TSRH.GT.ZEROS(NY,NX))THEN - FOSRH(K)=OSRH(K)/TSRH + FOSRH(K,L,NY,NX)=OSRH(K)/TSRH ELSE - FOSRH(K)=1.0 + 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).GT.ZERO)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))) + 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))) + 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)) @@ -367,10 +369,12 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) 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 @@ -398,8 +402,8 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) 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) + 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 @@ -437,18 +441,24 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) 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 +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 - DOMA=1.0E+06 + DO 770 M=1,2 + SPOMK(M)=1.0 + RMOMK(M)=1.0 +770 CONTINUE 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 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)) @@ -481,9 +491,19 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) 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)) + FPOBX=AMAX1(FMN,RIPBO(N,K,L,NY,NX)/RPOBY(L,NY,NX)) ELSE - FPB4X=AMAX1(FMN,FOMA(N,K)*VLPOB(L,NY,NX)) + 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 @@ -503,9 +523,11 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) TFNH4X=TFNH4X+FNH4X TFNO3X=TFNO3X+FNO3X TFPO4X=TFPO4X+FPO4X + TFP14X=TFP14X+FP14X TFNH4B=TFNH4B+FNB4X TFNO3B=TFNO3B+FNB3X - TFPO4B=TFPO4B+FPB4X + TFPO4B=TFPO4B+FPOBX + TFP14B=TFP14B+FP1BX C C FACTORS CONSTRAINING NH4, NO3, PO4 UPTAKE AMONG COMPETING C MICROBIAL POPULATIONS IN SURFACE RESIDUE @@ -515,19 +537,25 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) FNH4XR(N,K)=AMAX1(FMN,RINHOR(N,K,NY,NX) 2/RNH4Y(NU(NY,NX),NY,NX)) ELSE - FNH4XR(N,K)=0.0 + 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)=0.0 + 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)=0.0 + 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 @@ -535,6 +563,7 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) 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 @@ -562,12 +591,12 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) 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 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(N,K)=FOCA(K)*FSBSTC+FOAA(K)*FSBSTA + 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 @@ -594,12 +623,13 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) 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 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),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) +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 @@ -623,16 +653,15 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) 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 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 MICROBIAL -C COMPETITION FACTOR +C RESPIRATION RATES 'RGOMP' WITH UNLIMITED SUBSTRATE USED FOR +C MICROBIAL COMPETITION FACTOR C - FSBST(N,K)=COQC(K,L,NY,NX)/(COQC(K,L,NY,NX)+OQKM)*OXYI - SPOMC2=SPOMC2*OXYI + 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(N,K)*TFNX + RGOFZ=RGOFY*FSBST*TFNX RGOFX=AMAX1(0.0,OQC(K,L,NY,NX)*FOQC*ECHZ) RGOMP=AMIN1(RGOFX,RGOFZ) FGOCP=1.0 @@ -644,13 +673,13 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) 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 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),FOQC,COQC(K,L,NY,NX),OQC(K,L,NY,NX) +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(N,K),FOSRH(K),DOMA,SPOMC2,ROQCD(N,K) +C 6,FSBST,FOSRH(K,L,NY,NX),SPOMK(1),RMOMK(1),ROQCD(N,K) 5554 FORMAT(A8,7I4,60E12.4) C ENDIF C @@ -668,9 +697,9 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) 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) + 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(N,K)*TFNX + RGOGZ=RGOGY*FSBST*TFNX RGOGX=AMAX1(0.0,OQA(K,L,NY,NX)*FOQA*ECHZ) RGOMP=AMIN1(RGOGX,RGOGZ) FGOCP=0.0 @@ -688,7 +717,7 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) 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 +C 6,OHA(K,L,NY,NX),FSBST,SPOMK(1),RMOMK(1) 5552 FORMAT(A8,7I4,40E12.4) C ENDIF ENDIF @@ -702,8 +731,6 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) 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 @@ -731,9 +758,9 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) 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 + 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))) @@ -750,7 +777,7 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) 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 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 @@ -758,9 +785,9 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) 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 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 @@ -788,10 +815,10 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) 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 + 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))) @@ -816,7 +843,7 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) 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 +C 7,SPOMK(1),RMOMK(1) 6667 FORMAT(A8,5I4,50E12.4) C ENDIF C @@ -829,10 +856,10 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) 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 + 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))) + 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 @@ -840,7 +867,8 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) 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 +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 @@ -853,7 +881,7 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) C CH4 CONCENTRATIONS IN BAND AND NON-BAND SOIL ZONES C ECHZ=EO2X - VMXA=TFNG(N,K)*FCNP(N,K)*OMA(N,K)*VMX4 + 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 @@ -878,9 +906,9 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) CH4G1=CH4G1+RCH4F1 CH4S1=CH4S1+RCH4L1+RCH4S1 CCH4S1=AMAX1(0.0,CH4S1/VOLWM(M,L,NY,NX)) - FSBST(N,K)=CCH4S1/(CCH4S1+CCK4) + FSBST=CCH4S1/(CCH4S1+CCK4) RVOXP1=AMIN1(AMAX1(0.0,CH4S1)/(1.0+ECHO*ECHZ) - 2,VMXA1*FSBST(N,K)) + 2,VMXA1*FSBST) RGOMP1=RVOXP1*ECHO*ECHZ CH4S1=CH4S1-RVOXP1-RGOMP1 IF(THETPM(M,L,NY,NX).GT.THETX)THEN @@ -899,7 +927,7 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) 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 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 @@ -963,7 +991,7 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) 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 + 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 @@ -1108,8 +1136,8 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) 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))) + 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 @@ -1220,15 +1248,18 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) 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),COXYS(L,NY,NX),COXYG(L,NY,NX),ROXYM(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),ZERO +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) @@ -1284,14 +1315,15 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) 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 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,VMXD,VMXDS,VMXDB,TFNG(N,K),OMA(N,K),COMN,FCN2S,FCN2B +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,VMXDX,VMXDA,RVOXA(N),RVOXB(N) +C 4,ROXYD,ROXYD/VOLWZ,VMXDX,VMXDA,FNO2S,FNO2B 7777 FORMAT(A8,5I4,40E12.4) C ENDIF ELSE @@ -1329,13 +1361,17 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) 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 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,6I4,30E12.4) +7776 FORMAT(A8,8I6,30E12.4) C ENDIF C C MINERALIZATION-IMMOBILIZATION OF NO3 IN SOIL FROM MICROBIAL @@ -1361,36 +1397,66 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) RINB3(N,K)=RINOP*FNO3B ENDIF C -C MINERALIZATION-IMMOBILIZATION OF PO4 IN SOIL FROM MICROBIAL +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,CH2PB(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) - RIPOB(N,K,L,NY,NX)=FH2PB*RIPOX*CH2PY/(CH2PY+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)) - RIPB4(N,K)=AMIN1(FPB4X*AMAX1(0.0,(H2POB(L,NY,NX)-H2PBM)) - 2,RIPOB(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 - RIPOB(N,K,L,NY,NX)=0.0 + RIPBO(N,K,L,NY,NX)=0.0 RIPO4(N,K)=RIPOP*FH2PS - RIPB4(N,K)=RIPOP*FH2PB + 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),CH2PX,HPKU,VLPOB(L,NY,NX),CH2PY +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 @@ -1404,12 +1470,14 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) 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)) + 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) @@ -1430,46 +1498,62 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) 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)) + 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 PO4 IN SURFACE RESIDUE FROM +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,CH2PB(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,(H2P4T(NU(NY,NX))-H2P4M)) - 2,RIPOOR(N,K,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)),H2P4M,RIPOOR(N,K,NY,NX),RIPOPR +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 - 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 + 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 @@ -1484,25 +1568,26 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) 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) + 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*EN2F(N) + 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,FNFX,RGOMT +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=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+(RGOMT-RGN2F)/ECHZ + 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 @@ -1525,7 +1610,7 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) 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 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) @@ -1534,17 +1619,20 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) 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 + 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)/CNKI) + 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)/CPKI))) + 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)*CNKI)) + 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)*CPKI)) - RCCC=RCCZ+CCC*RCCY*(1.0-FSBST(N,K)) + 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 @@ -1552,6 +1640,14 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) 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 @@ -1568,7 +1664,7 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) C MICROBIAL DECOMPOSITION FROM BIOMASS, SPECIFIC DECOMPOSITION C RATE, TEMPERATURE C - SPOMX=SQRT(TFNG(N,K))*SPOMC(M)*SPOMC2 + 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) @@ -1580,7 +1676,7 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) 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 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) @@ -1687,16 +1783,20 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) 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 - RIPB4(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 @@ -1954,9 +2054,17 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) ELSE COQCK=0.1E+06 ENDIF - DCKD=DCKM(K)*(1.0+COQCK/DCKI) + 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 @@ -1975,21 +2083,22 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) 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) + 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/10)*10.EQ.I.AND.J.EQ.24.AND.L.LE.1)THEN +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),VOLX(L,NY,NX),ORGC(L,NY,NX),OSC(M,K,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) +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 @@ -2112,7 +2221,8 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) C C DOC ADSORPTION - DESORPTION C - IF(VOLWM(NPH,L,NY,NX).GT.ZEROS(NY,NX).AND.FOSRH(K).GT.ZERO)THEN + 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 @@ -2126,8 +2236,8 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) 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) + 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 @@ -2155,8 +2265,8 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) 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 +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 @@ -2365,8 +2475,9 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) C C INPUTS TO NONSTRUCTURAL POOLS C - CGROMC=CGOMC(N,K)-RGOMO(N,K)-RGOMD(N,K) + 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) @@ -2380,10 +2491,10 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) 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) + 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) + 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) @@ -2414,8 +2525,8 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) 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) + 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) @@ -2446,9 +2557,11 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) 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 @@ -2468,14 +2581,17 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) 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+RIPB4(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) @@ -2494,6 +2610,8 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) 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 @@ -2530,6 +2648,9 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) 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) @@ -2566,25 +2687,28 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) 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 - 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(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) +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 -2323 FORMAT(A8,3I4,12E12.4) C ENDIF ELSE RCO2O(L,NY,NX)=0.0 @@ -2597,12 +2721,13 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) 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 - XZHYS(L,NY,NX)=0.0 ENDIF C C ADJUST LAYERING OF SOC @@ -2767,3 +2892,6 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) 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/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 e5d62f0..1b78df5 100755 --- a/f77src/readi.f +++ b/f77src/readi.f @@ -1,475 +1,491 @@ - - 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)' 17 APR 2019' +5000 FORMAT(A16) + NF=1 + NFX=1 + NTZ=0 +C +C READ SITE DATA +C + READ(1,*)ALATG,ALTIG,ATCAG,IPRCG + READ(1,*)OXYEG,Z2GEG,CO2EIG,CH4EG,Z2OEG,ZNH3EG + READ(1,*)IETYPG,ISALTG,IERSNG,NCNG,DTBLIG,DDRGIG,DTBLGG + READ(1,*)RCHQNG,RCHQEG,RCHQSG,RCHQWG,RCHGNUG,RCHGEUG,RCHGSUG + 2,RCHGWUG,RCHGNTG,RCHGETG,RCHGSTG,RCHGWTG,RCHGDG + READ(1,*)(DHI(NX),NX=1,NHE) + READ(1,*)(DVI(NY),NY=1,NVS) + CLOSE(1) + DO 9895 NX=NHW,NHE + DO 9890 NY=NVN,NVS + ALAT(NY,NX)=ALATG + ALTI(NY,NX)=ALTIG + ATCAI(NY,NX)=ATCAG + IPRC(NY,NX)=IPRCG + OXYE(NY,NX)=OXYEG + Z2GE(NY,NX)=Z2GEG + CO2EI(NY,NX)=CO2EIG + CH4E(NY,NX)=CH4EG + Z2OE(NY,NX)=Z2OEG + ZNH3E(NY,NX)=ZNH3EG + IETYP(NY,NX)=IETYPG + IERSN(NY,NX)=IERSNG + NCN(NY,NX)=NCNG + DTBLI(NY,NX)=DTBLIG + DDRGI(NY,NX)=DDRGIG + DTBLG(NY,NX)=DTBLGG + RCHQN(NY,NX)=RCHQNG + RCHQE(NY,NX)=RCHQEG + RCHQS(NY,NX)=RCHQSG + RCHQW(NY,NX)=RCHQWG + RCHGNU(NY,NX)=RCHGNUG + RCHGEU(NY,NX)=RCHGEUG + RCHGSU(NY,NX)=RCHGSUG + RCHGWU(NY,NX)=RCHGWUG + RCHGNT(NY,NX)=RCHGNTG + RCHGET(NY,NX)=RCHGETG + RCHGST(NY,NX)=RCHGSTG + RCHGWT(NY,NX)=RCHGWTG + RCHGD(NY,NX)=RCHGDG + DH(NY,NX)=DHI(NX) + DV(NY,NX)=DVI(NY) + CO2E(NY,NX)=CO2EI(NY,NX) + H2GE(NY,NX)=1.0E-03 + IF(ALAT(NY,NX).GT.0.0)THEN + XI=173 + ELSE + XI=356 + ENDIF + DECDAY=XI+100 + DECLIN=SIN((DECDAY*0.9863)*1.7453E-02)*(-23.47) + AZI=SIN(ALAT(NY,NX)*1.7453E-02)*SIN(DECLIN*1.7453E-02) + DEC=COS(ALAT(NY,NX)*1.7453E-02)*COS(DECLIN*1.7453E-02) + IF(AZI/DEC.GE.1.0-TWILGT)THEN + DYLM(NY,NX)=24.0 + ELSEIF(AZI/DEC.LE.-1.0+TWILGT)THEN + DYLM(NY,NX)=0.0 + ELSE + DYLM(NY,NX)=12.0*(1.0+2.0/3.1416*ASIN(TWILGT+AZI/DEC)) + ENDIF +9890 CONTINUE +9895 CONTINUE + DO 9885 NX=NHW,NHE+1 + DO 9880 NY=NVN,NVS+1 + ISALT(NY,NX)=ISALTG +9880 CONTINUE +9885 CONTINUE +C +C READ TOPOGRAPHY DATA AND SOIL FILE NAME FOR EACH GRID CELL +C +50 READ(7,*,END=20)NH1,NV1,NH2,NV2,ASPX,SL2,SL1,DPTHSX + READ(7,52)DATA(7) +52 FORMAT(A16) +C +C OPEN AND READ SOIL FILE +C + OPEN(9,FILE=TRIM(PREFIX)//DATA(7),STATUS='OLD') + DO 9995 NX=NH1,NH2 + DO 9990 NY=NV1,NV2 +C +C SURFACE SLOPES AND ASPECTS +C + ASP(NY,NX)=ASPX + SL(1,NY,NX)=SL1 + SL(2,NY,NX)=SL2 + DPTHS(NY,NX)=DPTHSX + ASP(NY,NX)=450.0-ASP(NY,NX) + IF(ASP(NY,NX).GE.360.0)ASP(NY,NX)=ASP(NY,NX)-360.0 +C +C SURFACE RESIDUE C, N AND P +C + READ(9,*)PSIFC(NY,NX),PSIWP(NY,NX),ALBS(NY,NX),PH(0,NY,NX) + 2,RSC(1,0,NY,NX),RSN(1,0,NY,NX),RSP(1,0,NY,NX) + 3,RSC(0,0,NY,NX),RSN(0,0,NY,NX),RSP(0,0,NY,NX) + 4,RSC(2,0,NY,NX),RSN(2,0,NY,NX),RSP(2,0,NY,NX) + 5,IXTYP(1,NY,NX),IXTYP(2,NY,NX) + 6,NU(NY,NX),NJ(NY,NX),NL1,NL2,ISOILR(NY,NX) + NK(NY,NX)=NJ(NY,NX)+1 + NM(NY,NX)=NJ(NY,NX)+NL1 + NL(NY,NX)=NM(NY,NX)+NL2 +C +C PHYSICAL PROPERTIES +C + READ(9,*)(CDPTH(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(BKDS(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) +C +C HYDROLOGIC PROPERTIES +C + READ(9,*)(FC(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(WP(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(SCNV(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(SCNH(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) +C +C PHYSICAL PROPERTIES +C + READ(9,*)(CSAND(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(CSILT(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(FHOL(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(ROCK(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) +C +C CHEMICAL PROPERTIES +C + READ(9,*)(PH(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(CEC(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(AEC(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) +C +C ORGANIC C, N AND P CONCENTRATIONS +C + READ(9,*)(CORGC(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(CORGR(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(CORGN(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(CORGP(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) +C +C INORGANIC N AND P CONCENTRATIONS +C + READ(9,*)(CNH4(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(CNO3(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(CPO4(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) +C +C CATION AND ANION CONCENTRATIONS +C + READ(9,*)(CAL(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(CFE(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(CCA(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(CMG(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(CNA(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(CKA(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(CSO4(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(CCL(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) +C +C PRECIPITATED MINERAL CONCENTRATIONS +C + READ(9,*)(CALPO(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(CFEPO(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(CCAPD(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(CCAPH(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(CALOH(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(CFEOH(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(CCACO(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(CCASO(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) +C +C GAPON SELECTIVITY CO-EFFICIENTS +C + READ(9,*)(GKC4(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(GKCH(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(GKCA(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(GKCM(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(GKCN(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(GKCK(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) +C +C INITIAL WATER, ICE CONTENTS +C + READ(9,*)(THW(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(THI(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) +C +C INITIAL PLANT AND ANIMAL RESIDUE C, N AND P +C + READ(9,*)(RSC(1,L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(RSN(1,L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(RSP(1,L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(RSC(0,L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(RSN(0,L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(RSP(0,L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(RSC(2,L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(RSN(2,L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + READ(9,*)(RSP(2,L,NY,NX),L=NU(NY,NX),NM(NY,NX)) + REWIND(9) + RSC(1,0,NY,NX)=AMAX1(1.0E-03,RSC(1,0,NY,NX)) + RSN(1,0,NY,NX)=AMAX1(0.04E-03,RSN(1,0,NY,NX)) + RSP(1,0,NY,NX)=AMAX1(0.004E-03,RSP(1,0,NY,NX)) + CDPTH(0,NY,NX)=0.0 +C +C ADD SOIL BOUNDARY LAYERS ABOVE ROOTING ZONE +C + IF(NU(NY,NX).GT.1)THEN + DO 31 L=NU(NY,NX)-1,0,-1 + IF(BKDS(L+1,NY,NX).GT.0.025)THEN + CDPTH(L,NY,NX)=CDPTH(L+1,NY,NX)-0.01 + ELSE + CDPTH(L,NY,NX)=CDPTH(L+1,NY,NX)-0.02 + ENDIF + IF(L.GT.0)THEN + BKDS(L,NY,NX)=BKDS(L+1,NY,NX) + FC(L,NY,NX)=FC(L+1,NY,NX) + WP(L,NY,NX)=WP(L+1,NY,NX) + SCNV(L,NY,NX)=SCNV(L+1,NY,NX) + SCNH(L,NY,NX)=SCNH(L+1,NY,NX) + CSAND(L,NY,NX)=CSAND(L+1,NY,NX) + CSILT(L,NY,NX)=CSILT(L+1,NY,NX) + CCLAY(L,NY,NX)=CCLAY(L+1,NY,NX) + FHOL(L,NY,NX)=FHOL(L+1,NY,NX) + ROCK(L,NY,NX)=ROCK(L+1,NY,NX) + PH(L,NY,NX)=PH(L+1,NY,NX) + CEC(L,NY,NX)=CEC(L+1,NY,NX) + AEC(L,NY,NX)=AEC(L+1,NY,NX) + CORGC(L,NY,NX)=0.0*CORGC(L+1,NY,NX) + CORGR(L,NY,NX)=0.0*CORGR(L+1,NY,NX) + CORGN(L,NY,NX)=0.0*CORGN(L+1,NY,NX) + CORGP(L,NY,NX)=0.0*CORGP(L+1,NY,NX) + CNH4(L,NY,NX)=CNH4(L+1,NY,NX) + CNO3(L,NY,NX)=CNO3(L+1,NY,NX) + CPO4(L,NY,NX)=CPO4(L+1,NY,NX) + CAL(L,NY,NX)=CAL(L+1,NY,NX) + CFE(L,NY,NX)=CFE(L+1,NY,NX) + CCA(L,NY,NX)=CCA(L+1,NY,NX) + CMG(L,NY,NX)=CMG(L+1,NY,NX) + CNA(L,NY,NX)=CNA(L+1,NY,NX) + CKA(L,NY,NX)=CKA(L+1,NY,NX) + CSO4(L,NY,NX)=CSO4(L+1,NY,NX) + CCL(L,NY,NX)=CCL(L+1,NY,NX) + CALOH(L,NY,NX)=CALOH(L+1,NY,NX) + CFEOH(L,NY,NX)=CFEOH(L+1,NY,NX) + CCACO(L,NY,NX)=CCACO(L+1,NY,NX) + CCASO(L,NY,NX)=CCASO(L+1,NY,NX) + CALPO(L,NY,NX)=CALPO(L+1,NY,NX) + CFEPO(L,NY,NX)=CFEPO(L+1,NY,NX) + CCAPD(L,NY,NX)=CCAPD(L+1,NY,NX) + CCAPH(L,NY,NX)=CCAPH(L+1,NY,NX) + GKC4(L,NY,NX)=GKC4(L+1,NY,NX) + GKCH(L,NY,NX)=GKCH(L+1,NY,NX) + GKCA(L,NY,NX)=GKCA(L+1,NY,NX) + GKCM(L,NY,NX)=GKCM(L+1,NY,NX) + GKCN(L,NY,NX)=GKCN(L+1,NY,NX) + GKCK(L,NY,NX)=GKCK(L+1,NY,NX) + THW(L,NY,NX)=THW(L+1,NY,NX) + THI(L,NY,NX)=THI(L+1,NY,NX) + ISOIL(1,L,NY,NX)=ISOIL(1,L+1,NY,NX) + ISOIL(2,L,NY,NX)=ISOIL(2,L+1,NY,NX) + ISOIL(3,L,NY,NX)=ISOIL(3,L+1,NY,NX) + ISOIL(4,L,NY,NX)=ISOIL(4,L+1,NY,NX) + RSC(1,L,NY,NX)=0.0 + RSN(1,L,NY,NX)=0.0 + RSP(1,L,NY,NX)=0.0 + RSC(0,L,NY,NX)=0.0 + RSN(0,L,NY,NX)=0.0 + RSP(0,L,NY,NX)=0.0 + RSC(2,L,NY,NX)=0.0 + RSN(2,L,NY,NX)=0.0 + RSP(2,L,NY,NX)=0.0 + ENDIF +31 CONTINUE + ENDIF +C +C ADD SOIL BOUNDARY LAYERS BELOW ROOTING ZONE +C + DO 32 L=NM(NY,NX)+1,JZ + CDPTH(L,NY,NX)=2.0*CDPTH(L-1,NY,NX)-1.0*CDPTH(L-2,NY,NX) + BKDS(L,NY,NX)=BKDS(L-1,NY,NX) + FC(L,NY,NX)=FC(L-1,NY,NX) + WP(L,NY,NX)=WP(L-1,NY,NX) + SCNV(L,NY,NX)=SCNV(L-1,NY,NX) + SCNH(L,NY,NX)=SCNH(L-1,NY,NX) + CSAND(L,NY,NX)=CSAND(L-1,NY,NX) + CSILT(L,NY,NX)=CSILT(L-1,NY,NX) + CCLAY(L,NY,NX)=CCLAY(L-1,NY,NX) + FHOL(L,NY,NX)=FHOL(L-1,NY,NX) + ROCK(L,NY,NX)=ROCK(L-1,NY,NX) + PH(L,NY,NX)=PH(L-1,NY,NX) + CEC(L,NY,NX)=CEC(L-1,NY,NX) + AEC(L,NY,NX)=AEC(L-1,NY,NX) +C IF(IPRC(NY,NX).EQ.0)THEN + CORGC(L,NY,NX)=0.0*CORGC(L-1,NY,NX) + CORGR(L,NY,NX)=0.0*CORGR(L-1,NY,NX) + CORGN(L,NY,NX)=0.0*CORGN(L-1,NY,NX) + CORGP(L,NY,NX)=0.0*CORGP(L-1,NY,NX) +C ELSE +C CORGC(L,NY,NX)=CORGC(L-1,NY,NX) +C CORGR(L,NY,NX)=CORGR(L-1,NY,NX) +C CORGN(L,NY,NX)=CORGN(L-1,NY,NX) +C CORGP(L,NY,NX)=CORGP(L-1,NY,NX) +C ENDIF + CNH4(L,NY,NX)=CNH4(L-1,NY,NX) + CNO3(L,NY,NX)=CNO3(L-1,NY,NX) + CPO4(L,NY,NX)=CPO4(L-1,NY,NX) + CAL(L,NY,NX)=CAL(L-1,NY,NX) + CFE(L,NY,NX)=CFE(L-1,NY,NX) + CCA(L,NY,NX)=CCA(L-1,NY,NX) + CMG(L,NY,NX)=CMG(L-1,NY,NX) + CNA(L,NY,NX)=CNA(L-1,NY,NX) + CKA(L,NY,NX)=CKA(L-1,NY,NX) + CSO4(L,NY,NX)=CSO4(L-1,NY,NX) + CCL(L,NY,NX)=CCL(L-1,NY,NX) + CALOH(L,NY,NX)=CALOH(L-1,NY,NX) + CFEOH(L,NY,NX)=CFEOH(L-1,NY,NX) + CCACO(L,NY,NX)=CCACO(L-1,NY,NX) + CCASO(L,NY,NX)=CCASO(L-1,NY,NX) + CALPO(L,NY,NX)=CALPO(L-1,NY,NX) + CFEPO(L,NY,NX)=CFEPO(L-1,NY,NX) + CCAPD(L,NY,NX)=CCAPD(L-1,NY,NX) + CCAPH(L,NY,NX)=CCAPH(L-1,NY,NX) + GKC4(L,NY,NX)=GKC4(L-1,NY,NX) + GKCH(L,NY,NX)=GKCH(L-1,NY,NX) + GKCA(L,NY,NX)=GKCA(L-1,NY,NX) + GKCM(L,NY,NX)=GKCM(L-1,NY,NX) + GKCN(L,NY,NX)=GKCN(L-1,NY,NX) + GKCK(L,NY,NX)=GKCK(L-1,NY,NX) + THW(L,NY,NX)=THW(L-1,NY,NX) + THI(L,NY,NX)=THI(L-1,NY,NX) + ISOIL(1,L,NY,NX)=ISOIL(1,L-1,NY,NX) + ISOIL(2,L,NY,NX)=ISOIL(2,L-1,NY,NX) + ISOIL(3,L,NY,NX)=ISOIL(3,L-1,NY,NX) + ISOIL(4,L,NY,NX)=ISOIL(4,L-1,NY,NX) + RSC(1,L,NY,NX)=0.0 + RSN(1,L,NY,NX)=0.0 + RSP(1,L,NY,NX)=0.0 + RSC(0,L,NY,NX)=0.0 + RSN(0,L,NY,NX)=0.0 + RSP(0,L,NY,NX)=0.0 + RSC(2,L,NY,NX)=0.0 + RSN(2,L,NY,NX)=0.0 + RSP(2,L,NY,NX)=0.0 +32 CONTINUE +C +C CALCULATE DERIVED SOIL PROPERTIES FROM INPUT SOIL PROPERTIES +C + DO 28 L=1,NL(NY,NX) + FMPR(L,NY,NX)=(1.0-ROCK(L,NY,NX))*(1.0-FHOL(L,NY,NX)) + BKDS(L,NY,NX)=BKDS(L,NY,NX)/(1.0-FHOL(L,NY,NX)) + FC(L,NY,NX)=FC(L,NY,NX)/(1.0-FHOL(L,NY,NX)) + WP(L,NY,NX)=WP(L,NY,NX)/(1.0-FHOL(L,NY,NX)) + SCNV(L,NY,NX)=0.1*SCNV(L,NY,NX)*FMPR(L,NY,NX) + SCNH(L,NY,NX)=0.1*SCNH(L,NY,NX)*FMPR(L,NY,NX) + CCLAY(L,NY,NX)=AMAX1(0.0,1.0E+03-(CSAND(L,NY,NX) + 2+CSILT(L,NY,NX))) + CORGC(L,NY,NX)=CORGC(L,NY,NX)*1.0E+03 + CORGR(L,NY,NX)=CORGR(L,NY,NX)*1.0E+03 + CORGCX=CORGC(L,NY,NX)+(RSC(1,L,NY,NX)+RSC(0,L,NY,NX)) + 2/(BKDS(L,NY,NX)*(CDPTH(L,NY,NX)-CDPTH(L-1,NY,NX))) + CSAND(L,NY,NX)=CSAND(L,NY,NX) + 2*1.0E-03*AMAX1(0.0,(1.0-CORGCX/0.5E+06)) + CSILT(L,NY,NX)=CSILT(L,NY,NX) + 2*1.0E-03*AMAX1(0.0,(1.0-CORGCX/0.5E+06)) + CCLAY(L,NY,NX)=CCLAY(L,NY,NX) + 2*1.0E-03*AMAX1(0.0,(1.0-CORGCX/0.5E+06)) + CEC(L,NY,NX)=CEC(L,NY,NX)*10.0 + AEC(L,NY,NX)=AEC(L,NY,NX)*10.0 + CNH4(L,NY,NX)=CNH4(L,NY,NX)/14.0 + CNO3(L,NY,NX)=CNO3(L,NY,NX)/14.0 + CPO4(L,NY,NX)=CPO4(L,NY,NX)/31.0 + CAL(L,NY,NX)=CAL(L,NY,NX)/27.0 + CFE(L,NY,NX)=CFE(L,NY,NX)/56.0 + CCA(L,NY,NX)=CCA(L,NY,NX)/40.0 + CMG(L,NY,NX)=CMG(L,NY,NX)/24.3 + CNA(L,NY,NX)=CNA(L,NY,NX)/23.0 + CKA(L,NY,NX)=CKA(L,NY,NX)/39.1 + CSO4(L,NY,NX)=CSO4(L,NY,NX)/32.0 + CCL(L,NY,NX)=CCL(L,NY,NX)/35.5 + CALPO(L,NY,NX)=CALPO(L,NY,NX)/31.0 + CFEPO(L,NY,NX)=CFEPO(L,NY,NX)/31.0 + CCAPD(L,NY,NX)=CCAPD(L,NY,NX)/31.0 + CCAPH(L,NY,NX)=CCAPH(L,NY,NX)/(31.0*3.0) + CALOH(L,NY,NX)=CALOH(L,NY,NX)/27.0 + CFEOH(L,NY,NX)=CFEOH(L,NY,NX)/56.0 + CCACO(L,NY,NX)=CCACO(L,NY,NX)/40.0 + CCASO(L,NY,NX)=CCASO(L,NY,NX)/40.0 + IF(FC(L,NY,NX).LT.0.0)THEN + ISOIL(1,L,NY,NX)=1 + PSIFC(NY,NX)=-0.033 + ELSE + ISOIL(1,L,NY,NX)=0 + ENDIF + IF(WP(L,NY,NX).LT.0.0)THEN + ISOIL(2,L,NY,NX)=1 + PSIWP(NY,NX)=-1.5 + ELSE + ISOIL(2,L,NY,NX)=0 + ENDIF + IF(SCNV(L,NY,NX).LT.0.0)THEN + ISOIL(3,L,NY,NX)=1 + ELSE + ISOIL(3,L,NY,NX)=0 + ENDIF + IF(SCNH(L,NY,NX).LT.0.0)THEN + ISOIL(4,L,NY,NX)=1 + ELSE + ISOIL(4,L,NY,NX)=0 + ENDIF +C IF(BKDS(L,NY,NX).EQ.0.0)THEN +C FC(L,NY,NX)=1.0 +C WP(L,NY,NX)=1.0 +C ISOIL(1,L,NY,NX)=0 +C ISOIL(2,L,NY,NX)=0 +C CCLAY(L,NY,NX)=0.0 +C ENDIF +C +C BIOCHEMISTRY 130:117-131 +C + IF(CORGN(L,NY,NX).LT.0.0)THEN + CORGN(L,NY,NX)=AMIN1(0.125*CORGC(L,NY,NX) + 2,8.9E+02*(CORGC(L,NY,NX)/1.0E+04)**0.80) +C WRITE(*,1111)'CORGN',L,CORGN(L,NY,NX),CORGC(L,NY,NX) + ENDIF + IF(CORGP(L,NY,NX).LT.0.0)THEN + CORGP(L,NY,NX)=AMIN1(0.0125*CORGC(L,NY,NX) + 2,1.2E+02*(CORGC(L,NY,NX)/1.0E+04)**0.52) +C WRITE(*,1111)'CORGP',L,CORGP(L,NY,NX),CORGC(L,NY,NX) + ENDIF + IF(CEC(L,NY,NX).LT.0.0)THEN + CEC(L,NY,NX)=10.0*(200.0*2.0*CORGC(L,NY,NX)/1.0E+06 + 2+80.0*CCLAY(L,NY,NX)+20.0*CSILT(L,NY,NX) + 3+5.0*CSAND(L,NY,NX)) +C WRITE(*,1111)'CEC',L,CEC(L,NY,NX),CORGC(L,NY,NX) +C 2,CCLAY(L,NY,NX),CSILT(L,NY,NX),CSAND(L,NY,NX) +1111 FORMAT(A8,1I4,12E12.4) + ENDIF +28 CONTINUE +9990 CONTINUE +9995 CONTINUE + CLOSE(9) + GO TO 50 +20 CONTINUE + CLOSE(7) + DO 9975 NX=NHW,NHE + NL(NVS+1,NX)=NL(NVS,NX) +C WRITE(*,2223)'NHE',NX,NHW,NHE,NVS,NL(NVS,NX) +9975 CONTINUE + DO 9970 NY=NVN,NVS + NL(NY,NHE+1)=NL(NY,NHE) +C WRITE(*,2223)'NVS',NY,NVN,NVS,NHE,NL(NY,NHE) +2223 FORMAT(A8,6I4) +9970 CONTINUE + NL(NVS+1,NHE+1)=NL(NVS,NHE) + IOLD=0 + RETURN + END + + 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 b467ec5..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' @@ -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 @@ -193,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 @@ -313,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 @@ -330,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 @@ -492,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 @@ -584,7 +588,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..a059bd6 100755 --- a/f77src/redist.f +++ b/f77src/redist.f @@ -55,10 +55,12 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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) + 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) @@ -69,11 +71,11 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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) + 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),TQSAL(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) @@ -100,7 +102,7 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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) + 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) @@ -115,10 +117,10 @@ SUBROUTINE redist(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 TSANER(JY,JX),TSILER(JY,JX),TCLAER(JY,JX) @@ -133,7 +135,8 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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) + 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) @@ -162,8 +165,6 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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) @@ -173,6 +174,7 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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) @@ -209,7 +211,6 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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) @@ -218,7 +219,6 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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 @@ -260,30 +260,34 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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 + 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+ZHPW(NY,NX) - TW=ZALW(NY,NX)+ZFEW(NY,NX)+ZHYW(NY,NX)+ZCAW(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+H1PO4W(NY,NX)+ZCA0PW(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.0*(ZALH4W(NY,NX)+ZFEH4W(NY,NX))+H2GW(NY,NX) - TION=TION+TW + 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 @@ -293,9 +297,6 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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) @@ -324,9 +325,11 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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) @@ -457,6 +460,7 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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) @@ -466,15 +470,17 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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 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 P4=H2PO4(0,NY,NX) +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)-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 @@ -484,6 +490,7 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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 @@ -554,77 +561,88 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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 + 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 RUNOFF BOUNDARY FLUXES OF C, N AND P C - CX=XN*(XCOQRS(N,N5,N4)+XCHQRS(N,N5,N4) + CXR=XN*(XCOQRS(N,N5,N4)+XCHQRS(N,N5,N4) 2+XCOQSS(N,N5,N4)+XCHQSS(N,N5,N4)) - CQ=0.0 + CQR=0.0 DO 2575 K=0,4 - CQ=CQ+XN*(XOCQRS(K,N,N5,N4)+XOAQRS(K,N,N5,N4)) + CQR=CQR+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) + 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)) - ZG=XN*(XN2QRS(N,N5,N4)+XNGQRS(N,N5,N4) + ZGR=XN*(XN2QRS(N,N5,N4)+XNGQRS(N,N5,N4) 2+XN2QSS(N,N5,N4)+XNGQSS(N,N5,N4)) - ZQ=0.0 + ZOR=0.0 DO 2875 K=0,4 - ZQ=ZQ+XN*XONQRS(K,N,N5,N4) + ZOR=ZOR+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 + 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 - PQ=PQ+XN*XOPQRS(K,N,N5,N4) + POR=POR+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 + 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 - SQ1=XN*(XQRAL(N,N5,N4)+XQRFE(N,N5,N4)+XQRHY(N,N5,N4) + 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)+XHGQRS(N,N5,N4)+XQSAL(N,N5,N4)+XQSFE(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)) - SQ2=XN*2.0*(XQRHC(N,N5,N4)+XQRAL1(N,N5,N4)+XQRALS(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)+XQRH1P(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)+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) + 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)) - SQ4=XN*4.0*(XQRAL3(N,N5,N4)+XQRFE3(N,N5,N4)+XQRH3P(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)) - SQ=SQ1+SQ2+SQ3+SQ4 - TIONOU=TIONOU-SQ - UIONOU(NY,NX)=UIONOU(NY,NX)-SQ + 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 @@ -650,6 +668,7 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) ELSE ECNDQ=0.0 ENDIF + ENDIF C C RUNOFF BOUNDARY FLUXES OF SEDIMENT C @@ -660,90 +679,95 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) C C MICROBIAL C IN RUNOFF SEDIMENT C - CQ=0.0 + CQE=0.0 + CXE=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) + 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 - CQ=CQ+XN*ORCER(M,K,N,N5,N4) + CQE=CQE+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) + CQE=CQE+XN*OHCER(K,N,N5,N4) DO 3565 M=1,4 - CQ=CQ+XN*OSCER(M,K,N,N5,N4) + CQE=CQE+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 + 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 - ZQ=0.0 + ZXE=0.0 + ZGE=0.0 + ZQE=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) + 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 - ZQ=ZQ+XN*ORNER(M,K,N,N5,N4) + ZQE=ZQE+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) + ZQE=ZQE+XN*OHNER(K,N,N5,N4) DO 6865 M=1,4 - ZQ=ZQ+XN*OSNER(M,K,N,N5,N4) + ZQE=ZQE+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 + 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 - PQ=0.0 + PXE=0.0 + PQE=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) + 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 - PQ=PQ+XN*ORPER(M,K,N,N5,N4) + PQE=PQE+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) + PQE=PQE+XN*OHPER(K,N,N5,N4) DO 6765 M=1,4 - PQ=PQ+XN*OSPER(M,K,N,N5,N4) + PQE=PQE+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 + 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) @@ -760,9 +784,10 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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 + SQE=SQ1+SQ2+SQ3+SQ4 + TIONOU=TIONOU-SQE + UIONOU(NY,NX)=UIONOU(NY,NX)-SQE + ENDIF ENDIF ENDIF ENDIF @@ -770,106 +795,147 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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 - HEATOU=HEATOU-XN*HFLW(N,N6,N5,N4) C C SUBSURFACE BOUNDARY FLUXES OF CO2 AND DOC C - CO=0.0 + COD=0.0 DO 450 K=0,4 - CO=CO+XN*(XOCFLS(K,N,N6,N5,N4)+XOAFLS(K,N,N6,N5,N4) + 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 - CX=XN*(XCOFLS(N,N6,N5,N4)+XCOFHS(N,N6,N5,N4) + 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-CO-CX - UDOCD(NY,NX)=UDOCD(NY,NX)-CO - UDICD(NY,NX)=UDICD(NY,NX)-CX - TNBP(NY,NX)=TNBP(NY,NX)+CO+CX + 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 - OO=XN*(XOXFLS(N,N6,N5,N4)+XOXFHS(N,N6,N5,N4)+XOXFLG(N,N6,N5,N4)) - OXYGOU=OXYGOU-OO + 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 - ZO=0.0 + ZOD=0.0 DO 455 K=0,4 - ZO=ZO+XN*(XONFLS(K,N,N6,N5,N4)+XONFHS(K,N,N6,N5,N4)) + ZOD=ZOD+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) + 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)+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 + 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 - PO=0.0 + POD=0.0 DO 460 K=0,4 - PO=PO+XN*(XOPFLS(K,N,N6,N5,N4)+XOPFHS(K,N,N6,N5,N4)) + POD=POD+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 + 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 - SS=XN*(XALFLS(N,N6,N5,N4)+XFEFLS(N,N6,N5,N4)+XHYFLS(N,N6,N5,N4) + 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)+2.0*(XHCFLS(N,N6,N5,N4)+XAL1FS(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)+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) + 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))+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) + 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)+2.0*(XHCFHS(N,N6,N5,N4)+XAL1HS(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)+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) + 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))+XHGFHS(N,N6,N5,N4)) - SO=SS+SH + 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 @@ -912,6 +978,9 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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 @@ -952,6 +1021,7 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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 @@ -961,6 +1031,7 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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 @@ -997,7 +1068,6 @@ SUBROUTINE redist(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 @@ -1039,7 +1109,6 @@ SUBROUTINE redist(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 @@ -1067,12 +1136,14 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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 @@ -1154,11 +1225,13 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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 @@ -1170,11 +1243,13 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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 @@ -1218,7 +1293,6 @@ SUBROUTINE redist(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 @@ -1227,7 +1301,6 @@ SUBROUTINE redist(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 @@ -1269,7 +1342,6 @@ SUBROUTINE redist(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 @@ -1278,7 +1350,6 @@ SUBROUTINE redist(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 @@ -1334,6 +1405,7 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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) @@ -1343,8 +1415,9 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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(NY,NX).NE.0)THEN + 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) @@ -1379,7 +1452,6 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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) @@ -1421,7 +1493,6 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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) @@ -1452,12 +1523,14 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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) @@ -1572,6 +1645,8 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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) @@ -1582,6 +1657,8 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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) @@ -1604,6 +1681,8 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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) @@ -1614,6 +1693,8 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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) @@ -1699,8 +1780,6 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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) @@ -1717,8 +1796,6 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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) @@ -1801,8 +1878,6 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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) @@ -1819,8 +1894,6 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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) @@ -1845,8 +1918,8 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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 + 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) @@ -1862,7 +1935,7 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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 UVOLW(NY,NX)=UVOLW(NY,NX)-VOLW(0,NY,NX)-VOLI(0,NY,NX)*DENSI C C SURFACE BOUNDARY WATER FLUXES C @@ -1872,7 +1945,7 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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) + 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) @@ -1885,7 +1958,7 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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,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) @@ -1929,11 +2002,16 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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 - OXYGIN=OXYGIN+OI - OXYGOU=OXYGOU+OO + 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) @@ -1950,19 +2028,23 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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)) + ZSI=((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) + 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) @@ -1972,8 +2054,6 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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 @@ -1981,13 +2061,14 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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 + 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),XN2FLG(3,NU(NY,NX),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)) @@ -1996,22 +2077,41 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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 + 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) + 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 - 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 + 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 @@ -2025,47 +2125,61 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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) + 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)+CH1PR(NY,NX)+CC0PR(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))) - SI=PRECI(NY,NX)*(CALQ(I,NY,NX)+CFEQ(I,NY,NX)+CHYQ(I,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)+2.0*(CHCQ(I,NY,NX)+CAL1Q(I,NY,NX)+CALSQ(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)+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) + 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+SR+SI + 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 - SI=PRECU(NY,NX)*(CALQ(I,NY,NX)+CFEQ(I,NY,NX)+CHYQ(I,NY,NX) + 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)+2.0*(CHCQ(I,NY,NX)+CAL1Q(I,NY,NX)+CALSQ(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)+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) + 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))) - TIONIN=TIONIN+SI + TIONOU=TIONOU+SBU ENDIF C C GAS EXCHANGE FROM SURFACE VOLATILIZATION-DISSOLUTION @@ -2089,15 +2203,17 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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) + 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)-XN34SQ(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) - H2PO4(0,NY,NX)=H2PO4(0,NY,NX)+XH2PFS(3,0,NY,NX) - 2+XH2PS(0,NY,NX)+TRH2P(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) @@ -2119,6 +2235,23 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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) @@ -2132,17 +2265,24 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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 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),XN34SQ(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,20E12.4) +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 @@ -2174,6 +2314,7 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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) @@ -2210,7 +2351,6 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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) @@ -2220,6 +2360,64 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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 @@ -2255,12 +2453,14 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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) @@ -2328,69 +2528,11 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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 TOTAL C,N,P, SALTS IN SURFACE RESIDUE C RC=0.0 RN=0.0 @@ -2435,8 +2577,8 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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) + 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) @@ -2463,7 +2605,7 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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 + 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) @@ -2471,38 +2613,30 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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 - 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 - + 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) @@ -2512,6 +2646,9 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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) @@ -2538,7 +2675,6 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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) @@ -2546,22 +2682,41 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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) + 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) - 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)) + 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* - 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 + 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 @@ -2593,20 +2748,20 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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) + 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)+18.0E-06*TRH2O(L,NY,NX)+FLWV(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)/0.92 + 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)/0.92 + 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)) @@ -2638,7 +2793,7 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) C IF(J.EQ.15)THEN C WRITE(*,6547)'VOLW',I,J,NX,NY,L,VOLW(L,NY,NX),VOLW1 C 2,TFLW(L,NY,NX),FINH(L,NY,NX),TTHAW(L,NY,NX),TUPWTR(L,NY,NX) -C 3,FLU(L,NY,NX),18.0E-06*TRH2O(L,NY,NX),TQR(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) @@ -2647,7 +2802,7 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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 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 @@ -2687,19 +2842,23 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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) +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 - 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) + 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, @@ -2707,7 +2866,7 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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) + 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) @@ -2746,19 +2905,24 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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) + 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)+XN34SQ(L,NY,NX) + 3+XN4FXW(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 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) -4444 FORMAT(A8,5I4,30E12.4) +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) @@ -2770,24 +2934,28 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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) +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) - 3+XH2PXS(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-XN34BQ(L,NY,NX)+TRN3B(L,NY,NX)-TUPN3B(L,NY,NX)+RN3FBU(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)+XN34BQ(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) + 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) @@ -2809,7 +2977,7 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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 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 @@ -2843,276 +3011,89 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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 -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 GASES FROM VOLATILIZATION-DISSOLUTION AND GAS TRANSFER 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) + 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 - 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) + 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 - 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) + 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) @@ -3128,32 +3109,35 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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) + TLH2G=TLH2G-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 + 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)-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 + 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 @@ -3168,17 +3152,21 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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 + 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 @@ -3192,12 +3180,14 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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)+RIPOB(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) @@ -3213,7 +3203,7 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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 + 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) @@ -3224,6 +3214,8 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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) @@ -3236,10 +3228,13 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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) + 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) - TLNH4=TLNH4+ZNH - UNH4(NY,NX)=UNH4(NY,NX)+ZNH+14.0*(XN4(L,NY,NX)+XNB(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) @@ -3247,20 +3242,24 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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) + 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) - 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 + 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 @@ -3333,6 +3332,16 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) ORGC(L,NY,NX)=RC+OC ORGN(L,NY,NX)=RN+ON ORGR(L,NY,NX)=RC +C IF(L.EQ.1)THEN +C 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 @@ -3346,53 +3355,299 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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) +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)+2.0*(ZHCO3(L,NY,NX)+ZALOH1(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+H1PO4(L,NY,NX)+H1POB(L,NY,NX)+ZCA0P(L,NY,NX)+ZCA0PB(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))+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+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)+2.0*(ZHCO3H(L,NY,NX)+ZALO1H(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+H1PO4H(L,NY,NX)+H1POBH(L,NY,NX)+ZCA0PH(L,NY,NX)+ZCA0BH(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))+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 + 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 -125 CONTINUE +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) @@ -3637,6 +3892,8 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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) @@ -3649,6 +3906,8 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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) @@ -3731,6 +3990,8 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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) @@ -3741,6 +4002,8 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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) @@ -4009,12 +4272,14 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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) @@ -4056,11 +4321,13 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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) @@ -4398,15 +4665,12 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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)) + 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) @@ -4589,12 +4853,14 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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 @@ -4755,6 +5021,7 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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 @@ -4790,6 +5057,7 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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) @@ -4809,6 +5077,7 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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)) @@ -4924,12 +5193,14 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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) @@ -5060,8 +5331,8 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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 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)) @@ -5214,6 +5485,8 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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)) @@ -5226,6 +5499,8 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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)) @@ -5304,11 +5579,13 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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) @@ -5344,7 +5621,6 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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) @@ -5508,6 +5784,7 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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 @@ -5565,48 +5842,71 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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 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)*0.92,TQS(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)*PRECA(NY,NX) -C 3+2.095*TKA(NY,NX)*PRECW(NY,NX),HEATH(NY,NX),HTHAWW(NY,NX) +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),FLQGI(NY,NX)*COXQ +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 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(*,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 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),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 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 173e9da..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) @@ -72,11 +71,11 @@ 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) - 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/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..8bec419 100755 --- a/f77src/solute.f +++ b/f77src/solute.f @@ -1,4 +1,3 @@ - SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) C C THIS SUBROUTINE CALCULATES ALL SOLUTE TRANSFORMATIONS @@ -31,23 +30,23 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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 + 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 @@ -61,18 +60,19 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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 + 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=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 + 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 @@ -82,7 +82,7 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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 + IF(VOLWM(NPH,L,NY,NX).GT.ZEROS(NY,NX))THEN C C WATER VOLUME IN NON-BAND AND BAND SOIL ZONES C @@ -92,6 +92,23 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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 @@ -177,7 +194,7 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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) + XN41=AMAX1(0.0,XN4(L,NY,NX)/BKVLNH) ELSE RN4X=0.0 RN3X=0.0 @@ -193,7 +210,7 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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) + XN4B=AMAX1(0.0,XNB(L,NY,NX)/BKVLNB) ELSE RNBX=0.0 R3BX=0.0 @@ -213,23 +230,27 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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))/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 + 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 @@ -244,21 +265,25 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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 - 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 + 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 - CH2B1=0.0 + CH1PB=0.0 + CH2PB=0.0 XH01B=0.0 XH11B=0.0 XH21B=0.0 @@ -289,12 +314,12 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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 + 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)/VOLWM(NPH,L,NY,NX)) + 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)) @@ -332,8 +357,8 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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) - 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) @@ -343,7 +368,6 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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 @@ -354,7 +378,6 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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) @@ -364,7 +387,6 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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 @@ -376,22 +398,24 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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)) + 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)/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)) + 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 @@ -445,7 +469,7 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) CM1P1=AMAX1(ZERO,CM1P1) CH0PB=AMAX1(ZERO,CH0PB) CH1PB=AMAX1(ZERO,CH1PB) - CH2B1=AMAX1(ZERO,CH2B1) + CH2PB=AMAX1(ZERO,CH2PB) CH3PB=AMAX1(ZERO,CH3PB) CF1PB=AMAX1(ZERO,CF1PB) CF2PB=AMAX1(ZERO,CF2PB) @@ -453,7 +477,7 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) CC1PB=AMAX1(ZERO,CC1PB) CC2PB=AMAX1(ZERO,CC2PB) CM1PB=AMAX1(ZERO,CM1PB) - XCOO=AMAX1(0.0,XCOOH-XHC1-XALO21) + XCOO=AMAX1(0.0,XCOOH-XHC1-XALO21-XFEO21) C C IONIC STRENGTH FROM SUMS OF ION CONCENTRATIONS C @@ -467,10 +491,9 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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) + 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+CION1)) + 2+CC1+CA1)) CSTR2=SQRT(CSTR1) FSTR2=CSTR2/(1.0+CSTR2) C @@ -479,44 +502,6 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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 @@ -535,375 +520,233 @@ SUBROUTINE solute(I,J,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 + 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 - 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 - 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) + 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 - 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 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 - 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 - 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) + 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 - 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 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 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 - 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) + 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 - 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)) +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,M,MM,PCASO1,ACO31,AHCO31,ACO21,CHY1 -C 2,COH1,R2,P1,P2,P3,SP,Z,TX,RPCACX,RHCAC3,RHCACH,RHCACO +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 @@ -913,165 +756,67 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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 - NP3=0 - NP4=1 - SP=SYA0P1/A1A2A3 - ELSE - NR3=1 - NR4=0 + P1=AAL1 + NR1=1 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 - NP3=0 - NP4=1 - SP=SYA1P2/A12A2 - ELSE - NR3=1 - NR4=0 + P1=AALO1 + NR1=1 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 - ENDIF + SP=SHA4P2 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 @@ -1082,108 +827,45 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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) + 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 - 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 +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 @@ -1191,161 +873,65 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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 - NP3=0 - NP4=1 - SP=SYF0P1/A1A2A3 - ELSE - NR3=1 - NR4=0 + P1=AFE1 + NR1=1 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 - NP3=0 - NP4=1 - SP=SYF1P2/A12A2 - ELSE - NR3=1 - NR4=0 + P1=AFEO1 + NR1=1 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 @@ -1356,293 +942,127 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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) + 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 - 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 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) - 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 - 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) + 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 - 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 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 - 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) + 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 - 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 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=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) + 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 - 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 @@ -1653,16 +1073,6 @@ SUBROUTINE solute(I,J,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 @@ -1674,10 +1084,7 @@ SUBROUTINE solute(I,J,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 RPCAMX=0.0 @@ -1689,165 +1096,67 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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 + R1=AHY1 + P3=AHY1 IF(PY.EQ.AH1PB)THEN - P2=CH1PB + P2=AH1PB 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=CH2B1 + P2=AH2PB 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 - NP3=0 - NP4=1 - SP=SYA1P2/A12A2 - ELSE - NR3=1 - NR4=0 + P1=AALO1 + NR1=1 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 - 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 @@ -1858,264 +1167,103 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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) + 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 - 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 + R1=AHY1 + P3=AHY1 IF(PY.EQ.AH1PB)THEN - P2=CH1PB + P2=AH1PB 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 + P1=AFE1 + NR1=1 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=CH2B1 + P2=AH2PB 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 - NP3=0 - NP4=1 - SP=SYF1P2/A12A2 - ELSE - NR3=1 - NR4=0 + P1=AFEO1 + NR1=1 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 + SP=SHF4P2 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 @@ -2126,279 +1274,112 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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) + 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 - 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 + R1=AHY1 + P1=ACA1 IF(PX.EQ.AH1PB)THEN - P2=CH1PB - NR2=0 - NP3=0 - SP=SPCAD/A22 + P2=AH1PB + NR1=0 + SP=SPCAD 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 + P2=AH2PB + NR1=1 + SP=SHCAD2 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) + 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 - 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 + R1=AHY1 + P1=ACA1 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 + P2=AH1PB + NR1=4 + SP=SHCAH1 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 + P2=AH2PB + NR1=7 + SP=SHCAH2 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) + 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 - 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) + 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 - 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 @@ -2409,16 +1390,6 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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 @@ -2430,10 +1401,7 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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 @@ -2443,133 +1411,36 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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 -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)) + 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=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 + 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 - 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 + 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 - RYH1P=0.0 - RHH2P=0.0 - RHH1P=0.0 + RXH1P=0.0 ENDIF C C PHOSPHORUS ANION EXCHANGE IN BAND SOIL ZONE @@ -2579,131 +1450,32 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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)) + 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=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 + 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 - 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 + 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 - RYH1B=0.0 - RHH2B=0.0 - RHH1B=0.0 + RXH1B=0.0 ENDIF C C CATION EXCHANGE FROM GAPON SELECTIVITY COEFFICIENTS @@ -2713,322 +1485,217 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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 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*(FN4X*CN4X-XN41)/(1.0+FN4X) - RXNB=TADCX*(FN4X*CNBX-XN4B)/(1.0+FN4X) -C -C H EXCHANGE + RXN4=TADCX*(XN4Q-XN41)*AN41/XN4Q + RXNB=TADCX*(XNBQ-XN4B)*AN4B/XNBQ C - RXHY=TADCX*(FHYX*CHYX-XHY1)/(1.0+FHYX) +C H,AL,FE,CA,MG,NA,K EXCHANGE 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) + 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 AND ADSORPTION OF AL(OH)2 +C DISSOCIATION OF CARBOXYL RADICALS +C AND ADSORPTION OF AL AND FE (OH)2 C - DP=DPCOH/A1 - S0=CHY1+XCOO+DP - S1=AMAX1(0.0,S0**2-4.0*(CHY1*XCOO-DP*XHC1)) + S0=AHY1+XCOO+DPCOH + S1=AMAX1(0.0,S0**2-4.0*(AHY1*XCOO-DPCOH*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)) + 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 - DP=DPN4/A0 - S0=CHY1+CN31+DP - S1=AMAX1(0.0,S0**2-4.0*(CHY1*CN31-DP*CN41)) - RNH4=TSLX*(S0-SQRT(S1)) + RNH4=TSLX*(AHY1*AN31-DPN4*AN41)/(DPN4+AHY1) 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)) + RNHB=TSLX*(AHY1*AN3B-DPN4*AN4B)/(DPN4+AHY1) 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)) + 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 - DP=DPHCO/A2 - S0=CHY1+CCO31+DP - S1=AMAX1(0.0,S0**2-4.0*(CHY1*CCO31-DP*CHCO31)) + 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 - DP=DPAL1*A2A13D - S0=CAL1+COH1+DP - S1=AMAX1(0.0,S0**2-4.0*(CAL1*COH1-DP*CALO1)) - RALO1=TSLX*(S0-SQRT(S1)) + RALO1=TSLX*(AAL1*AOH1-DPAL1*AALO1)/(AOH1+DPAL1) 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)) + RALO2=TSLX*(AALO1*AOH1-DPAL2*AALO2)/(AOH1+DPAL2) 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)) + RALO3=TSLX*(AALO2*AOH1-DPAL3*AALO3)/(AOH1+DPAL3) 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)) + RALO4=TSLX*(AALO3*AOH1-DPAL4*AALO4)/(AOH1+DPAL4) 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)) + 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 - DP=DPFE1*A2A13D - S0=CFE1+COH1+DP - S1=AMAX1(0.0,S0**2-4.0*(CFE1*COH1-DP*CFEO1)) - RFEO1=TSLX*(S0-SQRT(S1)) + RFEO1=TSLX*(AFE1*AOH1-DPFE1*AFEO1)/(AOH1+DPFE1) 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)) + RFEO2=TSLX*(AFEO1*AOH1-DPFE2*AFEO2)/(AOH1+DPFE2) 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)) + RFEO3=TSLX*(AFEO2*AOH1-DPFE3*AFEO3)/(AOH1+DPFE3) 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)) + RFEO4=TSLX*(AFEO3*AOH1-DPFE4*AFEO4)/(AOH1+DPFE4) 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)) + 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 - DP=DPCAO/A2 - S0=CCA1+COH1+DP - S1=AMAX1(0.0,S0**2-4.0*(CCA1*COH1-DP*CCAO1)) - RCAO=TSLX*(S0-SQRT(S1)) + RCAO=TSLX*(ACA1*AOH1-DPCAO*ACAO1)/(AOH1+DPCAO) 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)) + 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 - DP=DPCAH/A2 - S0=CCA1+CHCO31+DP - S1=AMAX1(0.0,S0**2-4.0*(CCA1*CHCO31-DP*CCAH1)) + 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 - DP=DPCAS*A0A22 - S0=CCA1+CSO41+DP - S1=AMAX1(0.0,S0**2-4.0*(CCA1*CSO41-DP*CCAS1)) + 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 - DP=DPMGO/A2 - S0=CMG1+COH1+DP - S1=AMAX1(0.0,S0**2-4.0*(CMG1*COH1-DP*CMGO1)) - RMGO=TSLX*(S0-SQRT(S1)) + RMGO=TSLX*(AMG1*AOH1-DPMGO*AMGO1)/(AOH1+DPMGO) 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)) + 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 - DP=DPMGH/A2 - S0=CMG1+CHCO31+DP - S1=AMAX1(0.0,S0**2-4.0*(CMG1*CHCO31-DP*CMGH1)) + 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 - DP=DPMGS*A0A22 - S0=CMG1+CSO41+DP - S1=AMAX1(0.0,S0**2-4.0*(CMG1*CSO41-DP*CMGS1)) + 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 - DP=DPNAC/A2 - S0=CNA1+CCO31+DP - S1=AMAX1(0.0,S0**2-4.0*(CNA1*CCO31-DP*CNAC1)) + 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 - DP=DPNAS/A2 - S0=CNA1+CSO41+DP - S1=AMAX1(0.0,S0**2-4.0*(CNA1*CSO41-DP*CNAS1)) + 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 - DP=DPKAS/A2 - S0=CKA1+CSO41+DP - S1=AMAX1(0.0,S0**2-4.0*(CKA1*CSO41-DP*CKAS1)) + 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 @@ -3037,17 +1704,11 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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)) + RH1P=TSLX*(AH0P1*AHY1-DPH1P*AH1P1)/(DPH1P+AHY1) 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)) + 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) @@ -3057,51 +1718,42 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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)) + RH3P=TSLX*(AH2P1*AHY1-DPH3P*AH3P1)/(DPH3P+AHY1) 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)) + 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 - DP=DPF2P*A2A13D - S0=CFE1+CH2P1+DP - S1=AMAX1(0.0,S0**2-4.0*(CFE1*CH2P1-DP*CF2P1)) + 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 - DP=DPC0P*A1A23D - S0=CCA1+CH0P1+DP - S1=AMAX1(0.0,S0**2-4.0*(CCA1*CH0P1-DP*CC0P1)) + 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 - DP=DPC1P*A0A22 - S0=CCA1+CH1P1+DP - S1=AMAX1(0.0,S0**2-4.0*(CCA1*CH1P1-DP*CC1P1)) + 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 - DP=DPC2P/A2 - S0=CCA1+CH2P1+DP - S1=AMAX1(0.0,S0**2-4.0*(CCA1*CH2P1-DP*CC2P1)) + 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 - DP=DPM1P*A0A22 - S0=CMG1+CH1P1+DP - S1=AMAX1(0.0,S0**2-4.0*(CMG1*CH1P1-DP*CM1P1)) + 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 @@ -3121,65 +1773,50 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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)) + RH1B=TSLX*(AH0PB*AHY1-DPH1P*AH1PB)/(AHY1+DPH1P) 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)) + RH2B=TSLX*(AH1PB*AHY1-DPH2P*AH2PB)/(AHY1+DPH2P) 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)) + RH3B=TSLX*(AH2PB*AHY1-DPH3P*AH3PB)/(AHY1+DPH3P) 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)) + 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 - DP=DPF2P*A2A13D - S0=CFE1+CH2B1+DP - S1=AMAX1(0.0,S0**2-4.0*(CFE1*CH2B1-DP*CF2PB)) + 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 - DP=DPC0P*A1A23D - S0=CCA1+CH0PB+DP - S1=AMAX1(0.0,S0**2-4.0*(CCA1*CH0PB-DP*CC0PB)) + 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 - DP=DPC1P*A0A22 - S0=CCA1+CH1PB+DP - S1=AMAX1(0.0,S0**2-4.0*(CCA1*CH1PB-DP*CC1PB)) + 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 - DP=DPC2P/A2 - S0=CCA1+CH2B1+DP - S1=AMAX1(0.0,S0**2-4.0*(CCA1*CH2B1-DP*CC2PB)) + 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 - DP=DPM1P*A0A22 - S0=CMG1+CH1PB+DP - S1=AMAX1(0.0,S0**2-4.0*(CMG1*CH1PB-DP*CM1PB)) + 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 @@ -3192,6 +1829,7 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) RC2B=0.0 RM1B=0.0 ENDIF + C C TOTAL ION FLUXES FOR CURRENT ITERATION C FROM ALL REACTIONS ABOVE @@ -3200,13 +1838,14 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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 + 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 @@ -3216,10 +1855,9 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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) + 2+RHCAD2-RXOH2-RXOH1-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) + 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) @@ -3228,105 +1866,84 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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) + 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=-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) + 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=-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 + 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=-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 + 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-RYH1P-RHH2P-RHH1P + RXH1=RXOH1-RXOH2-RYH2P-RXH1P 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 + RX1P=RXH1P + RX2P=RXH2P+RYH2P 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 + 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=-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 + 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-RYH1B-RHH2B-RHH1B + RBH1=RXO1B-RXO2B-RYH2B-RXH1B 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) + 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 @@ -3380,7 +1997,7 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) CM1P1=CM1P1+RM1P CH0PB=CH0PB+RHB0 CH1PB=CH1PB+RHB1 - CH2B1=CH2B1+RHB2 + CH2PB=CH2PB+RHB2 CH3PB=CH3PB+RHB3 CF1PB=CF1PB+RF1B CF2PB=CF2PB+RF2B @@ -3391,42 +2008,42 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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 + 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,RYAL1,RYA0P1,RYA0P2,RYA0B1,RYA0B2,RXAL,RALO1,RALS +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,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,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 @@ -3435,12 +2052,14 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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 @@ -3478,19 +2097,17 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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 + 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 + 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 - 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 + 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 @@ -3534,12 +2151,14 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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 @@ -3564,9 +2183,6 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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 @@ -3578,8 +2194,8 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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 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) @@ -3611,8 +2227,6 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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) @@ -3658,12 +2272,14 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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 @@ -3688,9 +2304,33 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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 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 @@ -3703,22 +2343,22 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) C FOR THEIR EQUILIBRIUM CONSTANTS USING CURRENT C ION CONCENTRATION C - CCEC=AMAX1(ZERO,XCEC(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + 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,SYALO/COH1**3) + CAL1=AMAX1(ZERO,SPALO/COH1**3) ELSE - CAL1=AMAX1(ZERO,AMIN1(CAL(L,NY,NX),SYALO/COH1**3)) + CAL1=AMAX1(ZERO,AMIN1(CAL(L,NY,NX),SPALO/COH1**3)) ENDIF IF(CFE(L,NY,NX).LT.0.0)THEN - CFE1=AMAX1(ZERO,SYFEO/COH1**3) + CFE1=AMAX1(ZERO,SPFEO/COH1**3) ELSE - CFE1=AMAX1(ZERO,AMIN1(CFE(L,NY,NX),SYFEO/COH1**3)) + CFE1=AMAX1(ZERO,AMIN1(CFE(L,NY,NX),SPFEO/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)) + 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 @@ -3738,15 +2378,18 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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,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 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 @@ -3758,6 +2401,11 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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 @@ -3776,49 +2424,52 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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 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)) + 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=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)) + 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,AEP +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),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 +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 @@ -3829,13 +2480,14 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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,40E12.4) +2222 FORMAT(A8,3I4,40F14.7) C ENDIF C C PHOSPHORUS PRECIPITATION-DISSOLUTION IN BAND SOIL ZONE @@ -3845,27 +2497,27 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) C ALUMINUM PHOSPHATE (VARISCITE) C CH2PA=SYA0P2/(CAL1*COH1**2) - RPALBX=AMAX1(-PALPOB,TPD*(CH2B1-CH2PA)) + RPALBX=AMAX1(-PALPOB,TPD*(CH2PB-CH2PA)) C C IRON PHOSPHATE (STRENGITE) C CH2PF=SYF0P2/(CFE1*COH1**2) - RPFEBX=AMAX1(-PFEPOB,TPD*(CH2B1-CH2PF)) + RPFEBX=AMAX1(-PFEPOB,TPD*(CH2PB-CH2PF)) C C DICALCIUM PHOSPHATE C CH2PD=SYCAD2/(CCA1*COH1) - RPCDBX=AMAX1(-PCAPDB,TPD*(CH2B1-CH2PD)) + RPCDBX=AMAX1(-PCAPDB,TPD*(CH2PB-CH2PD)) C C HYDROXYAPATITE C CH2PH=(SYCAH2/(CCA1**5*COH1**7))**0.333 - RPCHBX=AMAX1(-PCAPHB,TPD*(CH2B1-CH2PH)) + RPCHBX=AMAX1(-PCAPHB,TPD*(CH2PB-CH2PH)) C C MONOCALCIUM PHOSPHATE C CH2PM=SQRT(SPCAM/CCA1) - RPCMBX=AMAX1(-PCAPMB*SPPO4,TPD*(CH2B1-CH2PM)) + RPCMBX=AMAX1(-PCAPMB*SPPO4,TPD*(CH2PB-CH2PM)) C C PHOSPHORUS ANION EXCHANGE IN BAND SOIL ZONE C CALCULATED FROM EXCHANGE EQUILIBRIA AMONG H2PO4-, @@ -3874,32 +2526,34 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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) + 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=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) + 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 @@ -3910,32 +2564,55 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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 - 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 + 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) - FCAQ=XCAQ/CCAX - FN4X=FCAQ*GKC4(L,NY,NX) + 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*(FN4X*CN41-XN41)/(1.0+FN4X) - RXNB=TADC*(FN4X*CN4B-XN4B)/(1.0+FN4X) + 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) +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 @@ -3952,7 +2629,7 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) RNHB=0.0 ENDIF C IF(J.EQ.12.AND.L.LE.6)THEN -C WRITE(*,2222)'RNH4',I,J,L,RNH4,CHY1,CN31,DPN4,CN41 +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) @@ -3965,8 +2642,12 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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 + 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 @@ -3975,17 +2656,6 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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' @@ -3994,7 +2664,9 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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 @@ -4016,19 +2688,13 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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 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 @@ -4046,7 +2712,7 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) C C NH4 BAND WIDTH C - DWNH4=0.5*SQRT(ZNSGL(L,NY,NX))*TORT(L,NY,NX) + 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 @@ -4112,7 +2778,7 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) C C NO3 BAND WIDTH C - DWNO3=0.5*SQRT(ZOSGL(L,NY,NX))*TORT(L,NY,NX) + 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 @@ -4172,7 +2838,7 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) C C PO4 BAND WIDTH C - DWPO4=0.5*SQRT(POSGL(L,NY,NX))*TORT(L,NY,NX) + 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 @@ -4207,7 +2873,7 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) C IF(ISALT(NY,NX).NE.0)THEN DZH0P=FVLPO4*H0PO4(L,NY,NX) - DZH1P=FVLPO4*H1PO4(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) @@ -4267,6 +2933,7 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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) @@ -4276,10 +2943,12 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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 @@ -4367,10 +3036,6 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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 @@ -4380,14 +3045,14 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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 - 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 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 @@ -4395,6 +3060,11 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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 @@ -4450,11 +3120,13 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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)) + 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 @@ -4462,26 +3134,26 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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)/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)) + 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,SYALO/COH1**3) - CFE1=AMAX1(ZERO,SYFEO/COH1**3) + 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)) - CALX=AMAX1(ZERO,CAL1)**0.333 - CCAX=AMAX1(ZERO,CCA1)**0.500 C C ALUMINUM PHOSPHATE (VARISCITE) C @@ -4524,29 +3196,49 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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)/VOLWM(NPH,0,NY,NX)) + CCEC0=AMAX1(0.0,COOH*ORGC(0,NY,NX)/BKVLX) 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) + 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=TADC*(FN4X*CN41-XN41)/(1.0+FN4X) + RXN4=TADC0*(XN4Q-XN41) 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 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),XNH4S(0,NY,NX),14.0*RSN4AA,RN4X -2223 FORMAT(A8,4I4,30E12.4) +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 @@ -4566,17 +3258,15 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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 + 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) @@ -4584,10 +3274,6 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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 @@ -4595,15 +3281,11 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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 + TRH1P(0,NY,NX)=TRH1P(0,NY,NX)*31.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) @@ -4613,3 +3295,5 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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/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 2fb70c9..b718eee 100755 --- a/f77src/startq.f +++ b/f77src/startq.f @@ -1,736 +1,737 @@ - 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 + UPH1P(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..f563a4a 100755 --- a/f77src/starts.f +++ b/f77src/starts.f @@ -21,8 +21,8 @@ SUBROUTINE starts(NHW,NHE,NVN,NVS) 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) + 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) @@ -47,6 +47,8 @@ SUBROUTINE starts(NHW,NHE,NVN,NVS) 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 @@ -54,19 +56,19 @@ SUBROUTINE starts(NHW,NHE,NVN,NVS) 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 - TFERTN=0.0 - TFERTP=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 @@ -171,81 +173,51 @@ SUBROUTINE starts(NHW,NHE,NVN,NVS) 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 + 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 - 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) + SLOPE(1,NY,NX)=SIN(SL(1,NY,NX)/57.29577951) ELSE - GSINX(NY,NX)=-GSIN(NY,NX) + 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 - GSINY(NY,NX)=GSIN(NY,NX) + SLOPE(2,NY,NX)=SIN(SL(2,NY,NX)/57.29577951) ELSE - GSINY(NY,NX)=-GSIN(NY,NX) + SLOPE(2,NY,NX)=-SIN(SL(2,NY,NX)/57.29577951) 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 + 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*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)) + 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)*(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)) + 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-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)) + 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 @@ -253,6 +225,10 @@ SUBROUTINE starts(NHW,NHE,NVN,NVS) ELSE ALTY=MAX(ALTY,ALT(NY,NX)) ENDIF + WRITE(18,1111)'ALT',NX,NY,ALT(NY,NX) + 2,DH(NY,NX),DV(NY,NX),ASP(NY,NX),GSIN(NY,NX) + 3,SLOPE(1,NY,NX),SLOPE(2,NY,NX) +1111 FORMAT(A8,2I4,20E12.4) 9980 CONTINUE 9985 CONTINUE C @@ -349,6 +325,7 @@ SUBROUTINE starts(NHW,NHE,NVN,NVS) 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) @@ -359,7 +336,6 @@ SUBROUTINE starts(NHW,NHE,NVN,NVS) 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 @@ -396,7 +372,7 @@ SUBROUTINE starts(NHW,NHE,NVN,NVS) 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 + 2.AND.SL(2,NY,NX).GT.0.0)THEN IRCHG(NN,N,NY,NX)=0 ELSE IRCHG(NN,N,NY,NX)=1 @@ -407,7 +383,7 @@ SUBROUTINE starts(NHW,NHE,NVN,NVS) 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 + 2.AND.SL(2,NY,NX).GT.0.0)THEN IRCHG(NN,N,NY,NX)=0 ELSE IRCHG(NN,N,NY,NX)=1 @@ -420,7 +396,7 @@ SUBROUTINE starts(NHW,NHE,NVN,NVS) 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 + 2.AND.SL(1,NY,NX).GT.0.0)THEN IRCHG(NN,N,NY,NX)=0 ELSE IRCHG(NN,N,NY,NX)=1 @@ -436,7 +412,7 @@ SUBROUTINE starts(NHW,NHE,NVN,NVS) ASP2=ASP(NY,NX) ENDIF IF(ASP2.GT.180.0.AND.ASP2.LT.360.0 - 2.AND.SL(NY,NX).GT.0.0)THEN + 2.AND.SL(1,NY,NX).GT.0.0)THEN IRCHG(NN,N,NY,NX)=0 ELSE IRCHG(NN,N,NY,NX)=1 @@ -500,10 +476,6 @@ SUBROUTINE starts(NHW,NHE,NVN,NVS) 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) @@ -540,11 +512,6 @@ SUBROUTINE starts(NHW,NHE,NVN,NVS) 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 @@ -589,8 +556,7 @@ SUBROUTINE starts(NHW,NHE,NVN,NVS) 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 + DO 1190 L=NU(NY,NX),NL(NY,NX) CORGCZ=CORGC(L,NY,NX) CORGRZ=CORGR(L,NY,NX) CORGNZ=CORGN(L,NY,NX) @@ -602,9 +568,6 @@ SUBROUTINE starts(NHW,NHE,NVN,NVS) 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 @@ -825,19 +788,48 @@ SUBROUTINE starts(NHW,NHE,NVN,NVS) 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=0.60*EXP(-5.0*(AMIN1(CORGNX(4),10.0*CORGPX(4)) + FC0=FCY*EXP(-5.0*(AMIN1(CORGNX(4),10.0*CORGPX(4)) 2/CORGCX(4))) ELSE - FC0=0.60 + FCO=FCY 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)) +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 @@ -1236,11 +1228,13 @@ SUBROUTINE starts(NHW,NHE,NVN,NVS) 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 @@ -1260,3 +1254,4 @@ SUBROUTINE starts(NHW,NHE,NVN,NVS) 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..4b240a9 100755 --- a/f77src/trnsfr.f +++ b/f77src/trnsfr.f @@ -42,7 +42,8 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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) + 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) @@ -50,14 +51,14 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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) + 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) + 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) @@ -66,6 +67,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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) @@ -82,17 +84,18 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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) + 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),TQRCOS(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) + 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),TQSH2P(JY,JX) - 8,TOCFLS(0:4,JZ,JY,JX),TONFLS(0:4,JZ,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) @@ -100,7 +103,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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) + 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) @@ -118,12 +121,14 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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) + 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) @@ -131,6 +136,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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) @@ -163,7 +169,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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) + 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) @@ -199,6 +205,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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) @@ -215,6 +222,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -255,6 +263,8 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -271,6 +281,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -282,11 +293,13 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -308,6 +321,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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) @@ -327,6 +341,8 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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) @@ -340,24 +356,28 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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) + 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 - 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) + 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 - 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) + 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 @@ -371,6 +391,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -382,6 +403,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -393,11 +415,13 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -407,7 +431,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 + 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 @@ -423,6 +447,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -432,6 +457,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -449,6 +475,8 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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) @@ -457,6 +485,8 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -469,11 +499,13 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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) @@ -484,6 +516,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -509,6 +542,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -520,11 +554,13 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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) @@ -582,6 +618,8 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -590,6 +628,8 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -602,10 +642,12 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -619,10 +661,12 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -679,6 +723,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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) @@ -695,11 +740,13 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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) @@ -755,6 +802,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -764,12 +812,14 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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) @@ -808,11 +858,13 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -824,22 +876,26 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -899,14 +955,15 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 + 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)) @@ -946,19 +1003,6 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -969,6 +1013,19 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) XN2DFR(NY,NX)=XN2DFR(NY,NX)+RN2DFR(NY,NX) XN3DFR(NY,NX)=XN3DFR(NY,NX)+RN3DFR(NY,NX) XHGDFR(NY,NX)=XHGDFR(NY,NX)+RHGDFR(NY,NX) +C IF(J.EQ.24)THEN +C 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 @@ -1007,14 +1064,15 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 + 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)) @@ -1058,14 +1116,6 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -1077,6 +1127,15 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -1127,11 +1186,13 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -1161,11 +1222,13 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -1202,16 +1265,25 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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)/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)) + 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)/VOLWMA(NU(NY,NX),NY,NX)) - CNH4S2=AMAX1(0.0,ZNH4S2(NU(NY,NX),NY,NX)/VOLWMA(NU(NY,NX),NY,NX)) + 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 @@ -1224,13 +1296,17 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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)/VOLWMB(NU(NY,NX),NY,NX)) - CNH4B2=AMAX1(0.0,ZNH4B2(NU(NY,NX),NY,NX)/VOLWMB(NU(NY,NX),NY,NX)) + 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 @@ -1243,16 +1319,18 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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(0,NY,NX)*AREA(3,NU(NY,NX),NY,NX) + TORT0=TORT(M,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) + 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) @@ -1314,11 +1392,13 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -1337,11 +1417,13 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -1384,6 +1466,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -1395,11 +1478,13 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -1411,23 +1496,44 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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)+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 + 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 @@ -1468,6 +1574,8 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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)) @@ -1478,6 +1586,8 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -1510,6 +1620,8 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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)) @@ -1520,6 +1632,8 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -1542,11 +1656,13 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -1562,56 +1678,84 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 + 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*(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 + 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*(ZNH3H2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZN3S2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT + 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*(ZNO3H2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZNO3S2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT + 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*(ZNO2H2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZNO2S2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT + 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) - DFVPO4=XNPX*(H2P4H2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-H2PO42(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT + 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) - DFVN4B=XNPX*(ZN4BH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZNH4B2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT + 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*(ZN3BH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZNBS2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT + 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*(ZNOBH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZNO3B2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT + 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*(ZN2BH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-ZNO2B2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT + 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) - DFVPOB=XNPX*(H2PBH2(NU(NY,NX),NY,NX)*VOLWM(M,NU(NY,NX),NY,NX) - 2-H2POB2(NU(NY,NX),NY,NX)*VOLWHS)/VOLWT + 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 @@ -1630,11 +1774,13 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -1664,11 +1810,13 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -1703,6 +1851,8 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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) @@ -1713,8 +1863,16 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -1761,6 +1919,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -1787,6 +1946,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -1813,6 +1973,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -1834,6 +1995,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -1847,6 +2009,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -1865,6 +2028,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -1883,6 +2047,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -1896,6 +2061,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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) @@ -1954,21 +2120,10 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -1978,8 +2133,16 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -1987,7 +2150,6 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -2111,12 +2273,13 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 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 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) @@ -2172,12 +2335,8 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -2190,12 +2349,8 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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)) @@ -2229,12 +2384,8 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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) @@ -2249,9 +2400,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -2268,9 +2417,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -2391,11 +2538,13 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -2426,11 +2575,13 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -2475,8 +2626,10 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -2494,8 +2647,10 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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)) @@ -2519,8 +2674,10 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -2538,31 +2695,32 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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(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)) + 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)) - 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 + 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 @@ -2587,6 +2745,8 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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) @@ -2597,6 +2757,8 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -2616,11 +2778,13 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -2677,6 +2841,9 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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) @@ -2692,6 +2859,9 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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) @@ -2715,11 +2885,13 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -2751,11 +2923,13 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -2777,11 +2951,13 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -2825,8 +3001,10 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -2844,8 +3022,10 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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)) @@ -2872,8 +3052,10 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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) @@ -2894,31 +3076,32 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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(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)) + 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) - 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 + 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 @@ -2928,6 +3111,9 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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) @@ -2943,6 +3129,8 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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) @@ -2953,6 +3141,8 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -2972,11 +3162,13 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -3003,11 +3195,13 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -3019,21 +3213,22 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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.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 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)'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 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) @@ -3062,6 +3257,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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) @@ -3078,11 +3274,13 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -3116,11 +3314,13 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -3148,11 +3348,13 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -3174,11 +3376,13 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -3189,56 +3393,62 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 + 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*(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 + 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*(ZNH3H2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZN3S2(N6,N5,N4)*VOLWHS)/VOLWT + 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*(ZNO3H2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZNO3S2(N6,N5,N4)*VOLWHS)/VOLWT + 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*(ZNO2H2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZNO2S2(N6,N5,N4)*VOLWHS)/VOLWT + 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) - DFVPO4=XNPX*(H2P4H2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-H2PO42(N6,N5,N4)*VOLWHS)/VOLWT + 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*(ZN4BH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZNH4B2(N6,N5,N4)*VOLWHS)/VOLWT + 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*(ZN3BH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZNBS2(N6,N5,N4)*VOLWHS)/VOLWT + 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*(ZNOBH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZNO3B2(N6,N5,N4)*VOLWHS)/VOLWT + 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*(ZN2BH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-ZNO2B2(N6,N5,N4)*VOLWHS)/VOLWT + 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) - DFVPOB=XNPX*(H2PBH2(N6,N5,N4)*VOLWM(M,N6,N5,N4) - 2-H2POB2(N6,N5,N4)*VOLWHS)/VOLWT + 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 @@ -3257,11 +3467,13 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -3291,11 +3503,13 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -3316,18 +3530,14 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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) -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 @@ -3508,11 +3718,8 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -3523,11 +3730,8 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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) @@ -3557,9 +3761,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -3568,9 +3770,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -3602,6 +3802,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -3618,11 +3819,13 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -3646,7 +3849,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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) + SH2GX=2.0*SH2GL(N3,N2,N1) C C GASEOUS EQUIVALENT PARTIAL CONCENTRATIONS C @@ -3841,6 +4044,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -3870,6 +4074,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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) @@ -3895,6 +4100,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -3905,6 +4111,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -3925,6 +4132,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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) @@ -3934,6 +4142,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -3968,6 +4177,8 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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)) @@ -4006,6 +4217,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -4051,6 +4263,8 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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)) @@ -4061,6 +4275,8 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -4083,11 +4299,13 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -4113,6 +4331,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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) @@ -4129,11 +4348,13 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -4235,6 +4456,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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) @@ -4244,6 +4466,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -4290,6 +4513,8 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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) @@ -4300,6 +4525,8 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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) @@ -4322,6 +4549,8 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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) @@ -4332,6 +4561,8 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -4387,6 +4618,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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) @@ -4396,6 +4628,10 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) ZN3S2(NU(NY,NX),NY,NX)=ZN3S2(NU(NY,NX),NY,NX)+RN3DFS(NY,NX) ZNBS2(NU(NY,NX),NY,NX)=ZNBS2(NU(NY,NX),NY,NX)+RNBDFS(NY,NX) H2GS2(NU(NY,NX),NY,NX)=H2GS2(NU(NY,NX),NY,NX)+RHGDFS(NY,NX) +C WRITE(*,442)'CO2S2',I,J,M,MX,NX,NY,CO2S2(0,NY,NX) +C 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) @@ -4412,6 +4648,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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) @@ -4430,6 +4667,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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) @@ -4484,6 +4722,8 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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) @@ -4491,6 +4731,8 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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) @@ -4503,11 +4745,13 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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) @@ -4515,10 +4759,8 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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) + 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) @@ -4528,14 +4770,13 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) ZN3G2(L,NY,NX)=ZN3G2(L,NY,NX)+TN3FLG(L,NY,NX)-RN3DFG(L,NY,NX) 2-RNBDFG(L,NY,NX) H2GG2(L,NY,NX)=H2GG2(L,NY,NX)+THGFLG(L,NY,NX)-RHGDFG(L,NY,NX) -C IF(I.EQ.22.AND.J.EQ.12.AND.L.EQ.2)THEN +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 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) @@ -4557,8 +4798,8 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 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) @@ -4574,6 +4815,11 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 @@ -4584,10 +4830,8 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 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) @@ -4605,3 +4849,6 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 30 CONTINUE RETURN END + + + diff --git a/f77src/trnsfrs.f b/f77src/trnsfrs.f index aee637d..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 @@ -1957,8 +1904,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)) @@ -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 @@ -3606,8 +3581,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)) @@ -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)) @@ -4145,8 +4102,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) @@ -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 ae10478..3c33e4a 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 @@ -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 @@ -1029,7 +1044,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 +1438,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 +1494,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 +1596,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 @@ -1684,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 - POSGX=POSGL(L,NY,NX)*TORT(L,NY,NX) + 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) @@ -1709,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) @@ -1732,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) @@ -1744,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) @@ -1760,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 @@ -1784,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 @@ -1793,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 @@ -1819,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 @@ -1838,9 +1972,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 @@ -1866,23 +2002,35 @@ 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 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) + 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 @@ -1903,3 +2051,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..4b53735 100755 --- a/f77src/watsub.f +++ b/f77src/watsub.f @@ -40,7 +40,7 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) 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) + 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) @@ -57,11 +57,11 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) 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 + 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.0175,Z2SW=12.0,Z2SD=12.0,Z3SX=0.50 - 2,Z1R=0.0175,Z2RW=3.0,Z2RD=12.0,Z3R=0.50) + 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) @@ -202,36 +202,49 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) 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)) + 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)/AREA(3,0,NY,NX))) - 2-AMIN1(1.0,TVOLW(NY,NX)/VOLWG(NY,NX))) + 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)-TFLWC(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)/0.92 + 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)*0.92 + WDISP=VOLWS(NY,NX)+VOLSS(NY,NX)+VOLIS(NY,NX)*DENSI ELSE FLWZ=0.0 FLWS=0.0 @@ -356,7 +369,7 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) 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 + FLWS1(NY,NX)=FLWS*DENSI*XNPH FLWI1(NY,NX)=FLWI*XNPH HFLWZ1(NY,NX)=HFLWZ*XNPH FLSI1(NY,NX)=FLWSI(NY,NX)*XNPH @@ -411,8 +424,8 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) 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 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 @@ -427,24 +440,25 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) 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 + 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 - 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) + 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(I.EQ.287)THEN +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 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,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) @@ -525,8 +539,9 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) 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))) + 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 @@ -538,6 +553,12 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) ELSE DFGS(M,0,NY,NX)=0.0 ENDIF + IF(VOLR(NY,NX).GT.ZEROS(NY,NX))THEN + THETWT=VOLWM(M,0,NY,NX)/VOLR(NY,NX) + 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 @@ -551,8 +572,9 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) 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 + 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 @@ -570,6 +592,14 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) 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 @@ -620,9 +650,9 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) 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) + 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(NY,NX)+VOLW0(NY,NX)+VOLI0(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)) @@ -975,10 +1005,10 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) 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) + TVOLWS=VOLS0(NY,NX)+DENSI*VOLI0(NY,NX) IF(TVOLWS.GT.ZEROS(NY,NX))THEN FVOLS0=VOLS0(NY,NX)/TVOLWS - FVOLI0=0.92*VOLI0(NY,NX)/TVOLWS + FVOLI0=DENSI*VOLI0(NY,NX)/TVOLWS ELSE FVOLS0=0.0 FVOLI0=0.0 @@ -998,7 +1028,7 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) 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) + 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) @@ -1057,7 +1087,7 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) 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 + 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)))) @@ -1383,8 +1413,8 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) 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) + 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) @@ -1507,11 +1537,9 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) 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) + TFLX=AMAX1(-333.0*DENSI*VOLI1(0,NY,NX)*XNPH,TFLX1) ELSE - TFLX=AMIN1(333.0*VOLW1(0,NY,NX)*XNPH - 2,VHCPR1(NY,NX)*XNPH*10.0,TFLX1) + 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) @@ -1549,7 +1577,7 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) 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) + 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 @@ -1581,7 +1609,7 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) 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) + 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 @@ -1727,7 +1755,6 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) 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) @@ -1750,7 +1777,7 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) 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 + 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) @@ -2047,9 +2074,11 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) ELSE THETW1=THETA1 THETWL=THETAL - K1=MIN(100,INT(100.0*(POROS(N3,N2,N1)-THETA1)/POROS(N3,N2,N1))+1) + 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=MIN(100,INT(100.0*(POROS(N6,N5,N4)-THETAL)/POROS(N6,N5,N4))+1) + 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 @@ -2336,7 +2365,7 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) 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) + TFLX=AMAX1(-333.0*DENSI*VOLI1(N6,N5,N4)*XNPH,TFLX1) ELSE TFLX=AMIN1(333.0*VOLW1(N6,N5,N4)*XNPH,TFLX1) ENDIF @@ -2365,7 +2394,7 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) 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) + TFLXH=AMAX1(-333.0*DENSI*VOLIH1(N6,N5,N4)*XNPH,TFLX1) ELSE TFLXH=AMIN1(333.0*VOLWH1(N6,N5,N4)*XNPH,TFLX1) ENDIF @@ -2445,7 +2474,7 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) VOLPX2=VOLPX1(L,NY,NX) VOLPH2=VOLPH1(L,NY,NX) C -C IDENTIFY CONDITIONS FOR MICROPORE DISCHARGE TO WATER TABLE +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) @@ -2453,7 +2482,7 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) 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)) + 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 @@ -2676,10 +2705,10 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) 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) + 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 @@ -2753,8 +2782,8 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) 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) + 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)) @@ -2787,7 +2816,7 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) 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) +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)) @@ -2884,7 +2913,7 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) 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) + 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) @@ -2918,23 +2947,28 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) 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) + 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) - 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)) + 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),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) +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) @@ -2976,10 +3010,10 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) 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 + 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)/0.92 + 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) @@ -3035,15 +3069,19 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) 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 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),VOLA(L,NY,NX) -C 5,VOLI1(L,NY,NX),VOLPX1(L,NY,NX),HYST(L,NY,NX),PSISM1(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),VOLPM(M,L,NY,NX),VOLPM(M+1,L,NY,NX) +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) @@ -3062,3 +3100,4 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) 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 574f354..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) @@ -46,11 +45,11 @@ 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) - 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))