From b945eb778c75381eb488d84e4878b3171bbdfe7e Mon Sep 17 00:00:00 2001 From: Jinyun Tang Date: Wed, 12 Feb 2020 14:22:03 -0800 Subject: [PATCH] incoporate pond pond incorporated as a soil with a BD of 0.0 (3rd line of the soil file --- f77src/BLOCKDATA001.f | 0 f77src/blk10.h | 0 f77src/blk11a.h | 18 +- f77src/blk11b.h | 0 f77src/blk12a.h | 0 f77src/blk12b.h | 0 f77src/blk13a.h | 0 f77src/blk13b.h | 0 f77src/blk13c.h | 0 f77src/blk13d.h | 0 f77src/blk14.h | 0 f77src/blk15a.h | 2 +- f77src/blk15b.h | 0 f77src/blk16.h | 0 f77src/blk17.h | 0 f77src/blk18a.h | 0 f77src/blk18b.h | 0 f77src/blk19a.h | 0 f77src/blk19b.h | 0 f77src/blk19c.h | 0 f77src/blk19d.h | 0 f77src/blk1cp.h | 0 f77src/blk1cr.h | 0 f77src/blk1g.h | 0 f77src/blk1n.h | 0 f77src/blk1p.h | 0 f77src/blk1s.h | 0 f77src/blk1u.h | 0 f77src/blk20a.h | 0 f77src/blk20b.h | 0 f77src/blk20c.h | 0 f77src/blk20d.h | 0 f77src/blk20e.h | 0 f77src/blk20f.h | 0 f77src/blk21a.h | 0 f77src/blk21b.h | 0 f77src/blk22a.h | 0 f77src/blk22b.h | 0 f77src/blk22c.h | 0 f77src/blk2a.h | 0 f77src/blk2b.h | 0 f77src/blk2c.h | 2 +- f77src/blk3.h | 0 f77src/blk5.h | 0 f77src/blk6.h | 0 f77src/blk8a.h | 8 +- f77src/blk8b.h | 7 +- f77src/blk9a.h | 2 +- f77src/blk9b.h | 0 f77src/blk9c.h | 0 f77src/blkc.h | 27 +- f77src/blktest.h | 0 f77src/day.f | 0 f77src/erosion.f | 0 f77src/exec.f | 0 f77src/extract.f | 0 f77src/filec.h | 0 f77src/fouts.f | 2 +- f77src/grosub.f | 195 +++--- f77src/hfunc.f | 16 +- f77src/hour1.f | 253 ++++--- f77src/nitro.f | 101 ++- f77src/outpd.f | 0 f77src/outph.f | 0 f77src/outsd.f | 2 +- f77src/outsh.f | 0 f77src/parameters.h | 0 f77src/readi.f | 30 +- f77src/readq.f | 0 f77src/reads.f | 2 +- f77src/redist.f | 1356 ++++++++++++++++++++++++++----------- f77src/routp.f | 0 f77src/routq.f | 0 f77src/routs.f | 7 +- f77src/soil.f | 0 f77src/solute.f | 317 ++++++--- f77src/starte.f | 164 +++-- f77src/startq.f | 1479 +++++++++++++++++++++-------------------- f77src/starts.f | 88 ++- f77src/stomate.f | 755 ++++++++++----------- f77src/trnsfr.f | 777 ++++++++++++++-------- f77src/trnsfrs.f | 1046 ++++++++++++++++++++--------- f77src/uptake.f | 52 +- f77src/visual.f | 0 f77src/watsub.f | 1463 +++++++++++++++++++++++----------------- f77src/woutp.f | 0 f77src/woutq.f | 0 f77src/wouts.f | 7 +- f77src/wthr.f | 0 89 files changed, 4968 insertions(+), 3210 deletions(-) mode change 100755 => 100644 f77src/BLOCKDATA001.f mode change 100755 => 100644 f77src/blk10.h mode change 100755 => 100644 f77src/blk11a.h mode change 100755 => 100644 f77src/blk11b.h mode change 100755 => 100644 f77src/blk12a.h mode change 100755 => 100644 f77src/blk12b.h mode change 100755 => 100644 f77src/blk13a.h mode change 100755 => 100644 f77src/blk13b.h mode change 100755 => 100644 f77src/blk13c.h mode change 100755 => 100644 f77src/blk13d.h mode change 100755 => 100644 f77src/blk14.h mode change 100755 => 100644 f77src/blk15a.h mode change 100755 => 100644 f77src/blk15b.h mode change 100755 => 100644 f77src/blk16.h mode change 100755 => 100644 f77src/blk17.h mode change 100755 => 100644 f77src/blk18a.h mode change 100755 => 100644 f77src/blk18b.h mode change 100755 => 100644 f77src/blk19a.h mode change 100755 => 100644 f77src/blk19b.h mode change 100755 => 100644 f77src/blk19c.h mode change 100755 => 100644 f77src/blk19d.h mode change 100755 => 100644 f77src/blk1cp.h mode change 100755 => 100644 f77src/blk1cr.h mode change 100755 => 100644 f77src/blk1g.h mode change 100755 => 100644 f77src/blk1n.h mode change 100755 => 100644 f77src/blk1p.h mode change 100755 => 100644 f77src/blk1s.h mode change 100755 => 100644 f77src/blk1u.h mode change 100755 => 100644 f77src/blk20a.h mode change 100755 => 100644 f77src/blk20b.h mode change 100755 => 100644 f77src/blk20c.h mode change 100755 => 100644 f77src/blk20d.h mode change 100755 => 100644 f77src/blk20e.h mode change 100755 => 100644 f77src/blk20f.h mode change 100755 => 100644 f77src/blk21a.h mode change 100755 => 100644 f77src/blk21b.h mode change 100755 => 100644 f77src/blk22a.h mode change 100755 => 100644 f77src/blk22b.h mode change 100755 => 100644 f77src/blk22c.h mode change 100755 => 100644 f77src/blk2a.h mode change 100755 => 100644 f77src/blk2b.h mode change 100755 => 100644 f77src/blk2c.h mode change 100755 => 100644 f77src/blk3.h mode change 100755 => 100644 f77src/blk5.h mode change 100755 => 100644 f77src/blk6.h mode change 100755 => 100644 f77src/blk8a.h mode change 100755 => 100644 f77src/blk8b.h mode change 100755 => 100644 f77src/blk9a.h mode change 100755 => 100644 f77src/blk9b.h mode change 100755 => 100644 f77src/blk9c.h mode change 100755 => 100644 f77src/blkc.h mode change 100755 => 100644 f77src/blktest.h mode change 100755 => 100644 f77src/day.f mode change 100755 => 100644 f77src/erosion.f mode change 100755 => 100644 f77src/exec.f mode change 100755 => 100644 f77src/extract.f mode change 100755 => 100644 f77src/filec.h mode change 100755 => 100644 f77src/grosub.f mode change 100755 => 100644 f77src/hfunc.f mode change 100755 => 100644 f77src/hour1.f mode change 100755 => 100644 f77src/nitro.f mode change 100755 => 100644 f77src/outpd.f mode change 100755 => 100644 f77src/outph.f mode change 100755 => 100644 f77src/outsd.f mode change 100755 => 100644 f77src/outsh.f mode change 100755 => 100644 f77src/parameters.h mode change 100755 => 100644 f77src/readi.f mode change 100755 => 100644 f77src/readq.f mode change 100755 => 100644 f77src/reads.f mode change 100755 => 100644 f77src/redist.f mode change 100755 => 100644 f77src/routp.f mode change 100755 => 100644 f77src/routq.f mode change 100755 => 100644 f77src/routs.f mode change 100755 => 100644 f77src/soil.f mode change 100755 => 100644 f77src/solute.f mode change 100755 => 100644 f77src/starte.f mode change 100755 => 100644 f77src/startq.f mode change 100755 => 100644 f77src/starts.f mode change 100755 => 100644 f77src/stomate.f mode change 100755 => 100644 f77src/trnsfr.f mode change 100755 => 100644 f77src/trnsfrs.f mode change 100755 => 100644 f77src/uptake.f mode change 100755 => 100644 f77src/visual.f mode change 100755 => 100644 f77src/watsub.f mode change 100755 => 100644 f77src/woutp.f mode change 100755 => 100644 f77src/woutq.f mode change 100755 => 100644 f77src/wouts.f mode change 100755 => 100644 f77src/wthr.f diff --git a/f77src/BLOCKDATA001.f b/f77src/BLOCKDATA001.f old mode 100755 new mode 100644 diff --git a/f77src/blk10.h b/f77src/blk10.h old mode 100755 new mode 100644 diff --git a/f77src/blk11a.h b/f77src/blk11a.h old mode 100755 new mode 100644 index 6f3d8a3..f57067d --- a/f77src/blk11a.h +++ b/f77src/blk11a.h @@ -1,20 +1,20 @@ - COMMON/BLK11A/TCS(0:JZ,JY,JX) + COMMON/BLK11A/BARE(JY,JX),CVRD(JY,JX),TCS(0:JZ,JY,JX) 2,TKS(0:JZ,JY,JX),TCW(JY,JX),TKW(JY,JX),RAC(JY,JX) - 3,TSMX(0:JZ,JY,JX),TSMN(0:JZ,JY,JX),VHCP(JZ,JY,JX),VHCPW(JY,JX) - 4,VHCPR(JY,JX),VOLW(0:JZ,JY,JX),VOLI(0:JZ,JY,JX),VOLP(0:JZ,JY,JX) + 3,TSMX(0:JZ,JY,JX),TSMN(0:JZ,JY,JX),VHCP(0:JZ,JY,JX),VHCPW(JY,JX) + 4,VOLW(0:JZ,JY,JX),VOLI(0:JZ,JY,JX),VOLP(0:JZ,JY,JX) 5,VOLWH(JZ,JY,JX),VOLT(0:JZ,JY,JX),VOLR(JY,JX),VOLWG(JY,JX) - 6,TVOLWC(JY,JX),VOLSS(JY,JX),VOLWS(JY,JX),VOLIS(JY,JX) + 6,TVOLG(JY,JX),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),VOLWD(JY,JX) - 1,VHCM(JZ,JY,JX),VOLWX(0:JZ,JY,JX),STC(JZ,JY,JX) + 1,VHCM(0: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) 4,THAWH(3,JZ,JY,JX),VOLIH(JZ,JY,JX),FLWSI(JY,JX),HFLWSI(JY,JX) 5,TFLWW(JY,JX),TFLWS(JY,JX),TFLWI(JY,JX),THFLWW(JY,JX),FLWR(JY,JX) 6,HFLWR(JY,JX),TFLWC(JY,JX),THRMG(JY,JX),HEATI(JY,JX),HEATE(JY,JX) 7,HEATS(JY,JX),HEATV(JY,JX),HEATH(JY,JX),TEVAPG(JY,JX) - 8,HYST(JZ,JY,JX),VHCPWX(JY,JX),VHCPRX(JY,JX),CGSGL(JZ,JY,JX) - 9,CLSGL(0:JZ,JY,JX),OGSGL(JZ,JY,JX),OLSGL(0:JZ,JY,JX) - 1,ZGSGL(JZ,JY,JX),CHSGL(JZ,JY,JX),CQSGL(0:JZ,JY,JX),VOLWRX(JY,JX) - + 8,HYST(JZ,JY,JX),VHCPWX(JY,JX),VHCPRX(JY,JX),VHCPNX(JY,JX) + 9,CGSGL(JZ,JY,JX),CLSGL(0:JZ,JY,JX),OGSGL(JZ,JY,JX) + 1,OLSGL(0:JZ,JY,JX),ZGSGL(JZ,JY,JX),CHSGL(JZ,JY,JX) + 2,CQSGL(0:JZ,JY,JX),VOLWRX(JY,JX) diff --git a/f77src/blk11b.h b/f77src/blk11b.h old mode 100755 new mode 100644 diff --git a/f77src/blk12a.h b/f77src/blk12a.h old mode 100755 new mode 100644 diff --git a/f77src/blk12b.h b/f77src/blk12b.h old mode 100755 new mode 100644 diff --git a/f77src/blk13a.h b/f77src/blk13a.h old mode 100755 new mode 100644 diff --git a/f77src/blk13b.h b/f77src/blk13b.h old mode 100755 new mode 100644 diff --git a/f77src/blk13c.h b/f77src/blk13c.h old mode 100755 new mode 100644 diff --git a/f77src/blk13d.h b/f77src/blk13d.h old mode 100755 new mode 100644 diff --git a/f77src/blk14.h b/f77src/blk14.h old mode 100755 new mode 100644 diff --git a/f77src/blk15a.h b/f77src/blk15a.h old mode 100755 new mode 100644 index 778d748..57f3e3b --- a/f77src/blk15a.h +++ b/f77src/blk15a.h @@ -20,4 +20,4 @@ 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) - + 1,FLWNU(JY,JX),FLWXNU(JY,JX),FLWHNU(JY,JX),HFLWNU(JY,JX) diff --git a/f77src/blk15b.h b/f77src/blk15b.h old mode 100755 new mode 100644 diff --git a/f77src/blk16.h b/f77src/blk16.h old mode 100755 new mode 100644 diff --git a/f77src/blk17.h b/f77src/blk17.h old mode 100755 new mode 100644 diff --git a/f77src/blk18a.h b/f77src/blk18a.h old mode 100755 new mode 100644 diff --git a/f77src/blk18b.h b/f77src/blk18b.h old mode 100755 new mode 100644 diff --git a/f77src/blk19a.h b/f77src/blk19a.h old mode 100755 new mode 100644 diff --git a/f77src/blk19b.h b/f77src/blk19b.h old mode 100755 new mode 100644 diff --git a/f77src/blk19c.h b/f77src/blk19c.h old mode 100755 new mode 100644 diff --git a/f77src/blk19d.h b/f77src/blk19d.h old mode 100755 new mode 100644 diff --git a/f77src/blk1cp.h b/f77src/blk1cp.h old mode 100755 new mode 100644 diff --git a/f77src/blk1cr.h b/f77src/blk1cr.h old mode 100755 new mode 100644 diff --git a/f77src/blk1g.h b/f77src/blk1g.h old mode 100755 new mode 100644 diff --git a/f77src/blk1n.h b/f77src/blk1n.h old mode 100755 new mode 100644 diff --git a/f77src/blk1p.h b/f77src/blk1p.h old mode 100755 new mode 100644 diff --git a/f77src/blk1s.h b/f77src/blk1s.h old mode 100755 new mode 100644 diff --git a/f77src/blk1u.h b/f77src/blk1u.h old mode 100755 new mode 100644 diff --git a/f77src/blk20a.h b/f77src/blk20a.h old mode 100755 new mode 100644 diff --git a/f77src/blk20b.h b/f77src/blk20b.h old mode 100755 new mode 100644 diff --git a/f77src/blk20c.h b/f77src/blk20c.h old mode 100755 new mode 100644 diff --git a/f77src/blk20d.h b/f77src/blk20d.h old mode 100755 new mode 100644 diff --git a/f77src/blk20e.h b/f77src/blk20e.h old mode 100755 new mode 100644 diff --git a/f77src/blk20f.h b/f77src/blk20f.h old mode 100755 new mode 100644 diff --git a/f77src/blk21a.h b/f77src/blk21a.h old mode 100755 new mode 100644 diff --git a/f77src/blk21b.h b/f77src/blk21b.h old mode 100755 new mode 100644 diff --git a/f77src/blk22a.h b/f77src/blk22a.h old mode 100755 new mode 100644 diff --git a/f77src/blk22b.h b/f77src/blk22b.h old mode 100755 new mode 100644 diff --git a/f77src/blk22c.h b/f77src/blk22c.h old mode 100755 new mode 100644 diff --git a/f77src/blk2a.h b/f77src/blk2a.h old mode 100755 new mode 100644 diff --git a/f77src/blk2b.h b/f77src/blk2b.h old mode 100755 new mode 100644 diff --git a/f77src/blk2c.h b/f77src/blk2c.h old mode 100755 new mode 100644 index f93a184..4f5261e --- a/f77src/blk2c.h +++ b/f77src/blk2c.h @@ -1,7 +1,7 @@ COMMON/BLK2C/CCOQ(JY,JX),CCHQ(JY,JX),COXQ(JY,JX),CNNQ(JY,JX) 2,CN2Q(JY,JX),COCU(0:4,JZ,JY,JX),CONU(0:4,JZ,JY,JX) 3,COAU(0:4,JZ,JY,JX),CN4U(JZ,JY,JX),CN3U(JZ,JY,JX),CNOU(JZ,JY,JX) - 4,CPOU(JZ,JY,JX),CNZU(JZ,JY,JX),CALU(JZ,JY,JX),CFEU(JZ,JY,JX) + 4,CH2PU(JZ,JY,JX),CNZU(JZ,JY,JX),CALU(JZ,JY,JX),CFEU(JZ,JY,JX) 5,CHYU(JZ,JY,JX),CCAU(JZ,JY,JX),CMGU(JZ,JY,JX),CNAU(JZ,JY,JX) 6,CKAU(JZ,JY,JX),COHU(JZ,JY,JX),CSOU(JZ,JY,JX),CCLU(JZ,JY,JX) 7,CC3U(JZ,JY,JX),CHCU(JZ,JY,JX),CAL1U(JZ,JY,JX),CAL2U(JZ,JY,JX) diff --git a/f77src/blk3.h b/f77src/blk3.h old mode 100755 new mode 100644 diff --git a/f77src/blk5.h b/f77src/blk5.h old mode 100755 new mode 100644 diff --git a/f77src/blk6.h b/f77src/blk6.h old mode 100755 new mode 100644 diff --git a/f77src/blk8a.h b/f77src/blk8a.h old mode 100755 new mode 100644 index 49b68c8..d71a8c6 --- a/f77src/blk8a.h +++ b/f77src/blk8a.h @@ -3,7 +3,7 @@ 2,BKDS(JZ,JY,JX),FC(JZ,JY,JX),WP(JZ,JY,JX),SCNV(JZ,JY,JX) 3,SCNH(JZ,JY,JX),CSAND(JZ,JY,JX),CSILT(JZ,JY,JX),CCLAY(JZ,JY,JX) 4,FHOL(JZ,JY,JX),PHOL(JZ,JY,JX),DHOL(JZ,JY,JX),HRAD(JZ,JY,JX) - 5,PH(0:JZ,JY,JX),CEC(JZ,JY,JX),AEC(JZ,JY,JX) + 5,BKDX(JZ,JY,JX),PH(0:JZ,JY,JX),CEC(JZ,JY,JX),AEC(JZ,JY,JX) 6,CORGC(0:JZ,JY,JX),CORGR(JZ,JY,JX),CORGN(JZ,JY,JX),CORGP(JZ,JY,JX) 7,CNH4(JZ,JY,JX),CNO3(JZ,JY,JX),CPO4(JZ,JY,JX),CAL(JZ,JY,JX) 8,CFE(JZ,JY,JX),CCA(JZ,JY,JX),CMG(JZ,JY,JX),CNA(JZ,JY,JX) @@ -14,6 +14,6 @@ 4,GKCN(JZ,JY,JX),GKCK(JZ,JY,JX),THW(JZ,JY,JX),THI(JZ,JY,JX) 5,RSC(0:2,0:JZ,JY,JX),RSN(0:2,0:JZ,JY,JX),RSP(0:2,0:JZ,JY,JX) 6,CNOFC(4,0:2),CPOFC(4,0:2),DETS(JY,JX),COHS(JY,JX),CER(JY,JX) - 7,XER(JY,JX),SLOPE(3,JY,JX),NU(JY,JX),NJ(JY,JX),NK(JY,JX),NL(JV,JH) - 8,ISOILR(JY,JX),NW(JY,JX),NHOL(JZ,JY,JX) - + 7,XER(JY,JX),SLOPE(3,JY,JX),CDPTHI(JY,JX),NU(JY,JX),NUI(JY,JX) + 8,NJ(JY,JX),NK(JY,JX),NL(JV,JH),ISOILR(JY,JX),NW(JY,JX) + 9,NHOL(JZ,JY,JX),NUM(JY,JX) diff --git a/f77src/blk8b.h b/f77src/blk8b.h old mode 100755 new mode 100644 index 46f1d59..026b46c --- a/f77src/blk8b.h +++ b/f77src/blk8b.h @@ -3,9 +3,10 @@ 3,WPL(JZ,JY,JX),PSD(JZ,JY,JX),FCD(JZ,JY,JX),ZD50(JY,JX) 4,VOLX(0:JZ,JY,JX),BKVL(0:JZ,JY,JX),SRP(JZ,JY,JX),FORGC,FVLWB,FCH4F 5,CNRH(0:4),CPRH(0:4),DIST(3,JD,JV,JH),XDPTH(3,JZ,JY,JX) - 6,YDPTH(JZ,JY,JX),POROQ(0:JZ,JY,JX),TFND(0:JZ,JY,JX),VOLXA(JY,JX) + 6,POROQ(0:JZ,JY,JX),TFND(0:JZ,JY,JX),VOLXA(JY,JX) 7,PSIMS(JY,JX),PSIMX(JY,JX),PSIMN(JY,JX),PSISD(JY,JX),PSIMD(JY,JX) 8,SAND(JZ,JY,JX),SILT(JZ,JY,JX),CLAY(JZ,JY,JX),CDPTHZ(0:JZ,JY,JX) 9,DPTHZ(JZ,JY,JX),AREA(3,0:JZ,JY,JX),DISP(3,JD,JV,JH),OXKM,PSIHY - 1,OMCI(3,0:4),OMCF(7),OMCA(7) - 2,IUTYP(JY,JX),IXTYP(2,JY,JX),IYTYP(0:2,366,JY,JX) + 1,VOLXI(0:JZ,JY,JX),DLYRI(3,0:JZ,JY,JX),OMCI(3,0:4),OMCF(7),OMCA(7) + 2,VOLAI(0:JZ,JY,JX),IUTYP(JY,JX),IXTYP(2,JY,JX) + 3,IYTYP(0:2,366,JY,JX) diff --git a/f77src/blk9a.h b/f77src/blk9a.h old mode 100755 new mode 100644 index cd224af..0e717d3 --- a/f77src/blk9a.h +++ b/f77src/blk9a.h @@ -4,7 +4,7 @@ 4,CHL4(JP,JY,JX),XRNI(JP,JY,JX),XRLA(JP,JY,JX),CTC(JP,JY,JX) 5,FCO2(JP,JY,JX),WDLF(JP,JY,JX),PB(JP,JY,JX),SLA1(JP,JY,JX) 6,SSL1(JP,JY,JX),SNL1(JP,JY,JX),VRNL(JC,JP,JY,JX),HTC(JP,JY,JX) - 7,FNOD(JP,JY,JX),DMLF(JP,JY,JX),DMSHE(JP,JY,JX) + 7,SSTX(JP,JY,JX),FNOD(JP,JY,JX),DMLF(JP,JY,JX),DMSHE(JP,JY,JX) 8,DMSTK(JP,JY,JX),DMRSV(JP,JY,JX),DMHSK(JP,JY,JX),DMEAR(JP,JY,JX) 9,DMGR(JP,JY,JX),DMRT(JP,JY,JX),DMND(JP,JY,JX),RSMX(JP,JY,JX) 1,RCMX(JP,JY,JX),RSMH(JP,JY,JX),CNLF(JP,JY,JX),CNSHE(JP,JY,JX) diff --git a/f77src/blk9b.h b/f77src/blk9b.h old mode 100755 new mode 100644 diff --git a/f77src/blk9c.h b/f77src/blk9c.h old mode 100755 new mode 100644 diff --git a/f77src/blkc.h b/f77src/blkc.h old mode 100755 new mode 100644 index 9d6273a..c13b72e --- a/f77src/blkc.h +++ b/f77src/blkc.h @@ -1,13 +1,14 @@ - COMMON/BLKC/DRAD(12),DTMPX(12),DTMPN(12),DHUM(12),DPREC(12) - 2,DIRRI(12),DWIND(12),DCO2E(12),DCN4R(12),DCNOR(12),TDIRI(JY,JX,12) - 3,TDTPX(JY,JX,12),TDTPN(JY,JX,12),TDRAD(JY,JX,12),TDHUM(JY,JX,12) - 4,TDPRC(JY,JX,12),TDWND(JY,JX,12),TDCO2(JY,JX,12),TDCN4(JY,JX,12) - 5,TDCNO(JY,JX,12),TAREA,XDIM,XCORP(JY,JX),ZERO,ZEROS(JY,JX) - 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(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) - 4,NP0(JY,JX),IFLGI(JP,JY,JX),IFLGC(JP,JY,JX),IETYP(JY,JX) + COMMON/BLKC/DRAD(12),DTMPX(12),DTMPN(12),DHUM(12),DPREC(12) + 2,DIRRI(12),DWIND(12),DCO2E(12),DCN4R(12),DCNOR(12),TDIRI(JY,JX,12) + 3,TDTPX(JY,JX,12),TDTPN(JY,JX,12),TDRAD(JY,JX,12),TDHUM(JY,JX,12) + 4,TDPRC(JY,JX,12),TDWND(JY,JX,12),TDCO2(JY,JX,12),TDCN4(JY,JX,12) + 5,TDCNO(JY,JX,12),TAREA,XDIM,XCORP(JY,JX),ZERO,ZERO2,ZEROS(JY,JX) + 6,ZEROP(JP,JY,JX),ZEROQ(JP,JY,JX),ZEROL(JP,JY,JX),XH(3,0:JZ,JY,JX) + 7,XHS(JY,JX),XNPH,XNPT,XNPG,XNPR,XNPD,ALAT(JY,JX),DOY,DYLM(JY,JX) + 8,ZEROS2(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(JV,JH) + 1,IERSN(JY,JX),NCN(JY,JX),NPX,NPY,NPH,NPT,NPG,IGO,ICLM,IMNG,IFLGW + 2,NPR,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) + 4,NP0(JY,JX),IFLGI(JP,JY,JX),IFLGC(JP,JY,JX),IETYP(JY,JX) diff --git a/f77src/blktest.h b/f77src/blktest.h old mode 100755 new mode 100644 diff --git a/f77src/day.f b/f77src/day.f old mode 100755 new mode 100644 diff --git a/f77src/erosion.f b/f77src/erosion.f old mode 100755 new mode 100644 diff --git a/f77src/exec.f b/f77src/exec.f old mode 100755 new mode 100644 diff --git a/f77src/extract.f b/f77src/extract.f old mode 100755 new mode 100644 diff --git a/f77src/filec.h b/f77src/filec.h old mode 100755 new mode 100644 diff --git a/f77src/fouts.f b/f77src/fouts.f index e6e33c4..620eada 100755 --- a/f77src/fouts.f +++ b/f77src/fouts.f @@ -397,7 +397,7 @@ SUBROUTINE fouts(NT,NE,NAX,NDX,NTX,NEX,NF,NFX,NHW,NHE,NVN,NVS) IF(L.EQ.45)HEAD(M)='PSI_11' IF(L.EQ.46)HEAD(M)='PSI_12' IF(L.EQ.47)HEAD(M)='PSI_15' - IF(L.EQ.48)HEAD(M)='PSI_LITTER' + IF(L.EQ.48)HEAD(M)='SURF_ELEV' IF(L.EQ.49)HEAD(M)='ACTV_LYR' IF(L.EQ.50)HEAD(M)='WTR_TBL' ENDIF diff --git a/f77src/grosub.f b/f77src/grosub.f old mode 100755 new mode 100644 index f973da3..90d89a4 --- a/f77src/grosub.f +++ b/f77src/grosub.f @@ -52,7 +52,7 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) 4,FSNKM=0.05,FXFS=1.0,FMYC=0.01) PARAMETER(CNKI=1.0E-01,CPKI=1.0E-02,CNKF=1.0) PARAMETER(RMPLT=0.010,PSILM=0.1,RCMN=1.560E+01,RTDPX=0.00 - 2,RTLGAX=1.0E-02,EMODR=5.0) + 2,RTLGAX=1.0E-03,EMODR=5.0) PARAMETER(QNTM=0.45,CURV=0.70,CURV2=2.0*CURV,CURV4=4.0*CURV 2,ELEC3=4.5,ELEC4=3.0,CO2KI=1.0E+03,FCO2B=0.02,FHCOB=1.0-FCO2B) PARAMETER(COMP4=0.5,FDML=6.0,FBS=0.2*FDML,FMP=0.8*FDML @@ -71,7 +71,7 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) DATA RCCY/0.333,0.333,0.333,0.333/ DATA RCCX/0.250,0.833,0.833/ DATA RCCQ/0.833,0.833,0.833/ - DATA RTSK/1.0,1.0,4.0/ + DATA RTSK/0.50,1.0,4.0/ DATA FXRN/0.50,0.05,0.50,0.05/ DATA FXFB/1.0E-02,1.0E-02,1.0E-05,1.0E-05/ DATA FPART1/1.00/,FPART2/0.40/ @@ -185,7 +185,7 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) WTHPG=0.0 C ENDIF C IF(NX.EQ.4.AND.NY.EQ.4.AND.NZ.EQ.2)THEN -C WRITE(*,2328)'IFLGC',I,J,NZ,IFLGC(NZ,NY,NX) +C WRITE(*,2328)'IFLGC1',I,J,NZ,IFLGC(NZ,NY,NX) C 2,IDTHP(NZ,NY,NX),IDTHR(NZ,NY,NX) 2328 FORMAT(A8,10I4) C ENDIF @@ -234,8 +234,8 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) 6 CONTINUE 9 CONTINUE IF(IBTYP(NZ,NY,NX).EQ.0.OR.IGTYP(NZ,NY,NX).LE.1 - 2.OR.WTSTK(NZ,NY,NX).LT.ZEROP(NZ,NY,NX) - 3.OR.WVSTK(NZ,NY,NX).LT.ZEROP(NZ,NY,NX))THEN + 2.OR.WTSTK(NZ,NY,NX).LE.ZEROP(NZ,NY,NX) + 3.OR.WVSTK(NZ,NY,NX).LE.ZEROP(NZ,NY,NX))THEN FWOOD(1)=1.0 FWODB(1)=1.0 ELSE @@ -1742,7 +1742,7 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) PPOOL(NB,NZ,NY,NX)=PPOOL(NB,NZ,NY,NX)+FSNCL*RCPL SNCLF=SNCLF-FSNCL*RCCL SNCT=SNCT-FSNCL*RCCL - IF(WTLFB(NB,NZ,NY,NX).LT.ZEROL(NZ,NY,NX))THEN + IF(WTLFB(NB,NZ,NY,NX).LE.ZEROL(NZ,NY,NX))THEN WTLFB(NB,NZ,NY,NX)=0.0 ARLFB(NB,NZ,NY,NX)=0.0 ENDIF @@ -1794,7 +1794,7 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) WGLFN(K,NB,NZ,NY,NX)=0.0 WGLFP(K,NB,NZ,NY,NX)=0.0 WSLF(K,NB,NZ,NY,NX)=0.0 - IF(WTLFB(NB,NZ,NY,NX).LT.ZEROL(NZ,NY,NX))THEN + IF(WTLFB(NB,NZ,NY,NX).LE.ZEROL(NZ,NY,NX))THEN WTLFB(NB,NZ,NY,NX)=0.0 ARLFB(NB,NZ,NY,NX)=0.0 ENDIF @@ -1865,7 +1865,7 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) PPOOL(NB,NZ,NY,NX)=PPOOL(NB,NZ,NY,NX)+FSNCS*RCPS SNCSH=SNCSH-FSNCS*RCCS SNCT=SNCT-FSNCS*RCCS - IF(WTSHEB(NB,NZ,NY,NX).LT.ZEROL(NZ,NY,NX))THEN + IF(WTSHEB(NB,NZ,NY,NX).LE.ZEROL(NZ,NY,NX))THEN WTSHEB(NB,NZ,NY,NX)=0.0 ENDIF C @@ -1901,7 +1901,7 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) WGSHN(K,NB,NZ,NY,NX)=0.0 WGSHP(K,NB,NZ,NY,NX)=0.0 WSSHE(K,NB,NZ,NY,NX)=0.0 - IF(WTSHEB(NB,NZ,NY,NX).LT.ZEROL(NZ,NY,NX))THEN + IF(WTSHEB(NB,NZ,NY,NX).LE.ZEROL(NZ,NY,NX))THEN WTSHEB(NB,NZ,NY,NX)=0.0 ENDIF ENDIF @@ -2261,12 +2261,12 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) LL=0 DO 550 L=JC,1,-1 IF(LU.EQ.1.AND.LL.EQ.1)GO TO 551 - IF((HTLFU.GT.ZL(L-1,NY,NX).OR.ZL(L-1,NY,NX).LT.ZERO) + IF((HTLFU.GT.ZL(L-1,NY,NX).OR.ZL(L-1,NY,NX).LE.ZERO) 2.AND.LU.EQ.0)THEN LHTLFU=MAX(1,L) LU=1 ENDIF - IF((HTLFL.GT.ZL(L-1,NY,NX).OR.ZL(L-1,NY,NX).LT.ZERO) + IF((HTLFL.GT.ZL(L-1,NY,NX).OR.ZL(L-1,NY,NX).LE.ZERO) 2.AND.LL.EQ.0)THEN LHTLFL=MAX(1,L) LL=1 @@ -2338,13 +2338,13 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) LL=0 DO 545 L=JC,1,-1 IF(LU.EQ.1.AND.LL.EQ.1)GO TO 546 - IF((HTLFB.GT.ZL(L-1,NY,NX).OR.ZL(L-1,NY,NX).LT.ZERO) + IF((HTLFB.GT.ZL(L-1,NY,NX).OR.ZL(L-1,NY,NX).LE.ZERO) 2.AND.LU.EQ.0)THEN LHTBRU=MAX(1,L) LU=1 ENDIF IF((HTBR.GT.ZL(L-1,NY,NX).OR.ZL(L-1,NY,NX) - 2.LT.ZERO).AND.LL.EQ.0)THEN + 2.LE.ZERO).AND.LL.EQ.0)THEN LHTBRL=MAX(1,L) LL=1 ENDIF @@ -2461,17 +2461,17 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) 3,CPPOLB(NB,NZ,NY,NX)/(CPPOLB(NB,NZ,NY,NX)+SETP)) IF(TCC(NZ,NY,NX).LT.CTC(NZ,NY,NX))THEN IF(IDAY(7,NB,NZ,NY,NX).EQ.0)THEN - FGRNX=0.002*(CTC(NZ,NY,NX)-TCC(NZ,NY,NX)) + FGRNX=SSTX(NZ,NY,NX)*(CTC(NZ,NY,NX)-TCC(NZ,NY,NX)) ELSEIF(IDAY(8,NB,NZ,NY,NX).EQ.0)THEN - FGRNX=0.002*(CTC(NZ,NY,NX)-TCC(NZ,NY,NX)) + FGRNX=SSTX(NZ,NY,NX)*(CTC(NZ,NY,NX)-TCC(NZ,NY,NX)) ELSE FGRNX=0.0 ENDIF ELSEIF(TCC(NZ,NY,NX).GT.HTC(NZ,NY,NX))THEN IF(IDAY(7,NB,NZ,NY,NX).EQ.0)THEN - FGRNX=0.002*(TCC(NZ,NY,NX)-HTC(NZ,NY,NX)) + FGRNX=SSTX(NZ,NY,NX)*(TCC(NZ,NY,NX)-HTC(NZ,NY,NX)) ELSEIF(IDAY(8,NB,NZ,NY,NX).EQ.0)THEN - FGRNX=0.002*(TCC(NZ,NY,NX)-HTC(NZ,NY,NX)) + FGRNX=SSTX(NZ,NY,NX)*(TCC(NZ,NY,NX)-HTC(NZ,NY,NX)) ELSE FGRNX=0.0 ENDIF @@ -2593,7 +2593,7 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) 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 + IF(FLG4(NB,NZ,NY,NX).GT.FLG4X+FLG4Y(IWTYP(NZ,NY,NX)))THEN VRNF(NB,NZ,NY,NX)=VRNX(NB,NZ,NY,NX)+0.5 ENDIF ENDIF @@ -3151,6 +3151,7 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) C ENDIF IF(ISTYP(NZ,NY,NX).EQ.0.AND.IDAY(8,NB,NZ,NY,NX).NE.0)THEN DO 2050 L=NU(NY,NX),NI(NZ,NY,NX) + IF(VOLX(L,NY,NX).GT.ZEROS(NY,NX))THEN 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 @@ -3185,6 +3186,7 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) C ENDIF ENDIF ENDIF + ENDIF 2050 CONTINUE ENDIF ENDIF @@ -3420,8 +3422,6 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) C ENDIF ENDIF ENDIF - - 105 CONTINUE C C ROOT GROWTH @@ -3431,8 +3431,9 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) C C FOR ROOTS (N=1) AND MYCORRHIZAE (N=2) IN EACH SOIL LAYER C - DO 4990 N=1,MY(NZ,NY,NX) + DO 4995 N=1,MY(NZ,NY,NX) DO 4990 L=NU(NY,NX),NI(NZ,NY,NX) + IF(VOLX(L,NY,NX).GT.ZEROS(NY,NX))THEN C C RESPIRATION FROM NUTRIENT UPTAKE CALCULATED IN 'UPTAKE': C ACTUAL, O2-UNLIMITED AND C-UNLIMITED @@ -3524,21 +3525,39 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) ENDIF RTNT(N)=RTNT(N)+RTSK2(N,L,NR) RLNT(N,L)=RLNT(N,L)+RTSK2(N,L,NR) -C IF(NZ.EQ.3)THEN -C WRITE(*,3341)'SINK',I,J,NX,NY,NZ,L,NR,N -C 2,RTSK1(N,L,NR),RTSK2(N,L,NR),RLNT(N,L),RTNT(N) -C 3,XRTN1,PP(NZ,NY,NX),RRAD1(N,L,NZ,NY,NX),RTDPP -C 4,RTN2(N,L,NR,NZ,NY,NX),RRAD2(N,L,NZ,NY,NX) -C 2,RTLGA(N,L,NZ,NY,NX) -3341 FORMAT(A8,8I4,20E12.4) +C IF(IYRC.EQ.2000.AND.I.LE.160)THEN +C WRITE(*,3341)'SINK',I,J,NX,NY,NZ,L,NR,N,RTDP1(N,NR,NZ,NY,NX) +C 2,HTCTL(NZ,NY,NX),RTSK1(N,L,NR),RTSK2(N,L,NR),RLNT(N,L),RTNT(N) +C 3,XRTN1,PP(NZ,NY,NX),RRAD1(N,L,NZ,NY,NX),RTDPS,RTDPP +C 4,RTDPL(NR,L),RTN2(N,L,NR,NZ,NY,NX),RRAD2(N,L,NZ,NY,NX) +C 2,RTLGA(N,L,NZ,NY,NX),CDPTHZ(L-1,NY,NX),CDPTHZ(L,NY,NX) +3341 FORMAT(A8,8I4,30E12.4) C ENDIF 4985 CONTINUE + ENDIF 4990 CONTINUE +4995 CONTINUE C C RESPIRATION AND GROWTH OF ROOT, MYCORRHIZAE IN EACH LAYER C DO 5010 N=1,MY(NZ,NY,NX) DO 5000 L=NU(NY,NX),NI(NZ,NY,NX) + IF(VOLX(L,NY,NX).GT.ZEROS(NY,NX))THEN +C WRITE(*,4994)'5004',I,J,NZ,N,L,NI(NZ,NY,NX) +C 2,NL(NY,NX),VOLX(L,NY,NX),CDPTHZ(L-1,NY,NX) + DO 5003 LZ=L+1,NL(NY,NX) +C WRITE(*,4994)'5003',I,J,NZ,N,L,LZ +C 2,LZ,VOLX(L,NY,NX),CDPTHZ(LZ,NY,NX) + IF(VOLX(LZ,NY,NX).GT.ZEROS(NY,NX) + 2.OR.LZ.EQ.NL(NY,NX))THEN + L1=LZ + GO TO 5004 + ENDIF +5003 CONTINUE +5004 CONTINUE +C WRITE(*,4994)'5005',I,J,NZ,N,L,LZ +C 2,L1,VOLX(L,NY,NX),CDPTHZ(L1,NY,NX) +4994 FORMAT(A8,7I4,12E12.4) C C WATER STRESS CONSTRAINT ON SECONDARY ROOT EXTENSION IMPOSED C BY ROOT TURGOR AND SOIL PENETRATION RESISTANCE @@ -3787,10 +3806,20 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) C PRIMARY ROOT EXTENSION C IF(N.EQ.1)THEN - IF(RTDP1(N,NR,NZ,NY,NX).GT.CDPTHZ(L-1,NY,NX) - 2.AND.ICHK1(N,NR).EQ.0)THEN + IF(BKDS(L,NY,NX).GT.ZERO)THEN + RTDP1X=RTDP1(N,NR,NZ,NY,NX)-CDPTHZ(0,NY,NX) + ELSE + RTDP1X=RTDP1(N,NR,NZ,NY,NX) + ENDIF +C IF(I.EQ.12)THEN +C WRITE(*,9874)'RTDP1',I,J,NZ,NR,L,L-1,L1,N,NINR(NR,NZ,NY,NX) +C 2,ICHK1(N,NR),RTDP1(N,NR,NZ,NY,NX),RTDP1X +C 3,CDPTHZ(L-1,NY,NX),CDPTHZ(L,NY,NX) +9874 FORMAT(A8,10I4,12E12.4) +C ENDIF + IF(RTDP1X.GT.CDPTHZ(L-1,NY,NX).AND.ICHK1(N,NR).EQ.0)THEN RTN1(N,L,NZ,NY,NX)=RTN1(N,L,NZ,NY,NX)+XRTN1 - IF(RTDP1(N,NR,NZ,NY,NX).LE.CDPTHZ(L,NY,NX))THEN + IF(RTDP1X.LE.CDPTHZ(L,NY,NX))THEN ICHK1(N,NR)=1 C C FRACTION OF PRIMARY ROOT SINK IN SOIL LAYER ATTRIBUTED TO CURRENT AXIS @@ -4098,7 +4127,7 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) GRTLGL=GRTWTG*RTLG1X(N,NZ,NY,NX)/PP(NZ,NY,NX)*WFNR*FWOOD(1) ENDIF IF(L.LT.NJ(NY,NX))THEN - GRTLGL=AMIN1(DLYR(3,L+1,NY,NX),GRTLGL) + GRTLGL=AMIN1(DLYR(3,L1,NY,NX),GRTLGL) ENDIF C C ALLOCATE PRIMARY ROOT GROWTH TO CURRENT @@ -4135,40 +4164,41 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) C OF CURRENT SOIL LAYER C IF(FGROZ.GT.0.0)THEN - WTRT1(N,L+1,NR,NZ,NY,NX)=WTRT1(N,L+1,NR,NZ,NY,NX) + WTRT1(N,L1,NR,NZ,NY,NX)=WTRT1(N,L1,NR,NZ,NY,NX) 2+GRTWTL*FGROZ - WTRT1N(N,L+1,NR,NZ,NY,NX)=WTRT1N(N,L+1,NR,NZ,NY,NX) + WTRT1N(N,L1,NR,NZ,NY,NX)=WTRT1N(N,L1,NR,NZ,NY,NX) 2+GRTWTN*FGROZ - WTRT1P(N,L+1,NR,NZ,NY,NX)=WTRT1P(N,L+1,NR,NZ,NY,NX) + WTRT1P(N,L1,NR,NZ,NY,NX)=WTRT1P(N,L1,NR,NZ,NY,NX) 2+GRTWTP*FGROZ - WSRTL(N,L+1,NZ,NY,NX)=WSRTL(N,L+1,NZ,NY,NX) - 2+AMIN1(CNWS(NZ,NY,NX)*WTRT1N(N,L+1,NR,NZ,NY,NX) - 2,CPWS(NZ,NY,NX)*WTRT1P(N,L+1,NR,NZ,NY,NX)) - WTRTD(N,L+1,NZ,NY,NX)=WTRTD(N,L+1,NZ,NY,NX) - 2+WTRT1(N,L+1,NR,NZ,NY,NX) - RTLG1(N,L+1,NR,NZ,NY,NX)=RTLG1(N,L+1,NR,NZ,NY,NX)+GRTLGL*FGROZ - RRAD1(N,L+1,NZ,NY,NX)=RRAD1(N,L,NZ,NY,NX) - RTLGZ=RTLGZ+RTLG1(N,L+1,NR,NZ,NY,NX) - WTRTZ=WTRTZ+WTRT1(N,L+1,NR,NZ,NY,NX) + WSRTL(N,L1,NZ,NY,NX)=WSRTL(N,L1,NZ,NY,NX) + 2+AMIN1(CNWS(NZ,NY,NX)*WTRT1N(N,L1,NR,NZ,NY,NX) + 2,CPWS(NZ,NY,NX)*WTRT1P(N,L1,NR,NZ,NY,NX)) + WTRTD(N,L1,NZ,NY,NX)=WTRTD(N,L1,NZ,NY,NX) + 2+WTRT1(N,L1,NR,NZ,NY,NX) + RTLG1(N,L1,NR,NZ,NY,NX)=RTLG1(N,L1,NR,NZ,NY,NX)+GRTLGL*FGROZ + RRAD1(N,L1,NZ,NY,NX)=RRAD1(N,L,NZ,NY,NX) + RTLGZ=RTLGZ+RTLG1(N,L1,NR,NZ,NY,NX) + WTRTZ=WTRTZ+WTRT1(N,L1,NR,NZ,NY,NX) XFRC=FRTN*CPOOLR(N,L,NZ,NY,NX) XFRN=FRTN*ZPOOLR(N,L,NZ,NY,NX) XFRP=FRTN*PPOOLR(N,L,NZ,NY,NX) CPOOLR(N,L,NZ,NY,NX)=CPOOLR(N,L,NZ,NY,NX)-XFRC ZPOOLR(N,L,NZ,NY,NX)=ZPOOLR(N,L,NZ,NY,NX)-XFRN PPOOLR(N,L,NZ,NY,NX)=PPOOLR(N,L,NZ,NY,NX)-XFRP - CPOOLR(N,L+1,NZ,NY,NX)=CPOOLR(N,L+1,NZ,NY,NX)+XFRC - ZPOOLR(N,L+1,NZ,NY,NX)=ZPOOLR(N,L+1,NZ,NY,NX)+XFRN - PPOOLR(N,L+1,NZ,NY,NX)=PPOOLR(N,L+1,NZ,NY,NX)+XFRP - PSIRT(N,L+1,NZ,NY,NX)=PSIRT(N,L,NZ,NY,NX) - PSIRO(N,L+1,NZ,NY,NX)=PSIRO(N,L,NZ,NY,NX) - PSIRG(N,L+1,NZ,NY,NX)=PSIRG(N,L,NZ,NY,NX) + CPOOLR(N,L1,NZ,NY,NX)=CPOOLR(N,L1,NZ,NY,NX)+XFRC + ZPOOLR(N,L1,NZ,NY,NX)=ZPOOLR(N,L1,NZ,NY,NX)+XFRN + PPOOLR(N,L1,NZ,NY,NX)=PPOOLR(N,L1,NZ,NY,NX)+XFRP + PSIRT(N,L1,NZ,NY,NX)=PSIRT(N,L,NZ,NY,NX) + PSIRO(N,L1,NZ,NY,NX)=PSIRO(N,L,NZ,NY,NX) + PSIRG(N,L1,NZ,NY,NX)=PSIRG(N,L,NZ,NY,NX) NINR(NR,NZ,NY,NX)=MAX(NG(NZ,NY,NX),L+1) C WRITE(*,9877)'INFIL',I,J,NZ,NR,L,N,NINR(NR,NZ,NY,NX) -C 2,FRTN,WTRTD(N,L+1,NZ,NY,NX),CPOOLR(N,L+1,NZ,NY,NX) +C 2,FRTN,WTRTD(N,L1,NZ,NY,NX),CPOOLR(N,L1,NZ,NY,NX) C 2,FGROZ,RTDP1(N,NR,NZ,NY,NX),GRTLGL,CDPTHZ(L,NY,NX) ENDIF -C IF((I/10)*10.EQ.I.AND.J.EQ.14.AND.NZ.EQ.1)THEN -C WRITE(*,9877)'RCO21',I,J,NZ,NR,L,N,NINR(NR,NZ,NY,NX) +C IF(I.EQ.12)THEN +C WRITE(*,9877)'RCO21',I,J,NZ,NR,L,L-1,L1,N,NINR(NR,NZ,NY,NX) +C 2,CDPTHZ(L,NY,NX),CDPTHZ(L-1,NY,NX),CDPTHZ(L1,NY,NX) C 2,RCO2TM,RCO2T,RMNCR,RCO2RM,RCO2R,RCO2GM,RCO2G C 3,RCO2XM,RCO2X,CGROR,SNCRM,SNCR,CNRDA,CPOOLR(N,L,NZ,NY,NX),FRTN C 4,TFN4(L,NZ,NY,NX),CNPG,FDBKX(NB1(NZ,NY,NX),NZ,NY,NX),WFNGR(N,L) @@ -4177,10 +4207,10 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) C 3,RCO2M(N,L,NZ,NY,NX),RCO2A(N,L,NZ,NY,NX),WFR(N,L,NZ,NY,NX) C 4,RTSK1(N,L,NR),RRAD1(N,L,NZ,NY,NX),RTDPP C 5,PSIRG(N,L,NZ,NY,NX),WFNR,WFNRG,FWOOD(1) -C 6,RTDP1(N,NR,NZ,NY,NX),FGROZ,RTWT1(N,NR,NZ,NY,NX),FSNC1 +C 6,FGROZ,RTWT1(N,NR,NZ,NY,NX),FSNC1 C 9,ZADD1,PADD1,ZPOOLR(N,L,NZ,NY,NX),PPOOLR(N,L,NZ,NY,NX) C 1,RUPNH4(N,L,NZ,NY,NX),RUPNO3(N,L,NZ,NY,NX) -9877 FORMAT(A8,7I4,100E12.4) +9877 FORMAT(A8,9I4,100E12.4) C ENDIF ENDIF C @@ -4191,8 +4221,9 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) C IF(L.EQ.NINR(NR,NZ,NY,NX))THEN DO 5115 LL=L,NG(NZ,NY,NX)+1,-1 - IF(RTDP1(N,NR,NZ,NY,NX).LT.CDPTHZ(LL-1,NY,NX) - 2.OR.RTDP1(N,NR,NZ,NY,NX).LT.SDPTH(NZ,NY,NX))THEN + IF(VOLX(LL-1,NY,NX).GT.ZEROS(NY,NX) + 2.AND.(RTDP1X.LT.CDPTHZ(LL-1,NY,NX) + 2.OR.RTDP1X.LT.SDPTH(NZ,NY,NX)))THEN IF(RLNT(N,LL).GT.ZEROP(NZ,NY,NX))THEN FRTN=(RTSK1(N,LL,NR)+RTSK2(N,LL,NR))/RLNT(N,LL) ELSE @@ -4385,7 +4416,11 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) IF(RTLGT.GT.ZEROP(NZ,NY,NX).AND.WTRTT.GT.ZEROP(NZ,NY,NX) 2.AND.PP(NZ,NY,NX).GT.ZEROP(NZ,NY,NX))THEN RTLGP(N,L,NZ,NY,NX)=RTLGT/PP(NZ,NY,NX) + IF(DLYR(3,L,NY,NX).GT.ZERO)THEN RTDNP(N,L,NZ,NY,NX)=RTLGP(N,L,NZ,NY,NX)/DLYR(3,L,NY,NX) + ELSE + RTDNP(N,L,NZ,NY,NX)=0.0 + ENDIF RTVL=AMAX1(RTAR1X(N,NZ,NY,NX)*RTLGX+RTAR2X(N,NZ,NY,NX)*RTLGL 2,WTRTT*DMVL(N,NZ,NY,NX)*PSIRG(N,L,NZ,NY,NX)) RTVLP(N,L,NZ,NY,NX)=PORT(N,NZ,NY,NX)*RTVL @@ -4436,6 +4471,7 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) ZH3P(N,L,NZ,NY,NX)=0.0 H2GP(N,L,NZ,NY,NX)=0.0 ENDIF + ENDIF 5000 CONTINUE 5010 CONTINUE C @@ -4444,8 +4480,12 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) C RTLGP(1,NG(NZ,NY,NX),NZ,NY,NX)=RTLGP(1,NG(NZ,NY,NX),NZ,NY,NX) 2+SDLG(NZ,NY,NX) + IF(DLYR(3,NG(NZ,NY,NX),NY,NX).GT.ZERO)THEN RTDNP(1,NG(NZ,NY,NX),NZ,NY,NX)=RTLGP(1,NG(NZ,NY,NX),NZ,NY,NX) 2/DLYR(3,NG(NZ,NY,NX),NY,NX) + ELSE + RTDNP(1,NG(NZ,NY,NX),NZ,NY,NX)=0.0 + ENDIF RTVL=RTVLP(1,NG(NZ,NY,NX),NZ,NY,NX)+RTVLW(1,NG(NZ,NY,NX),NZ,NY,NX) 2+SDVL(NZ,NY,NX)*PP(NZ,NY,NX) RTVLP(1,NG(NZ,NY,NX),NZ,NY,NX)=PORT(1,NZ,NY,NX)*RTVL @@ -4453,7 +4493,7 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) RTARP(1,NG(NZ,NY,NX),NZ,NY,NX)=RTARP(1,NG(NZ,NY,NX),NZ,NY,NX) 2+SDAR(NZ,NY,NX) IF(IDTHRN.EQ.NRT(NZ,NY,NX).OR.(WTRVC(NZ,NY,NX) - 2.LT.ZEROL(NZ,NY,NX).AND.ISTYP(NZ,NY,NX).NE.0))THEN + 2.LE.ZEROL(NZ,NY,NX).AND.ISTYP(NZ,NY,NX).NE.0))THEN IDTHR(NZ,NY,NX)=1 IDTHP(NZ,NY,NX)=1 ENDIF @@ -4629,6 +4669,15 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) WTNDL(L,NZ,NY,NX)=WTNDL(L,NZ,NY,NX)+GRNDG-RXNDLC-RXNSNC WTNDLN(L,NZ,NY,NX)=WTNDLN(L,NZ,NY,NX)+ZADDN-RXNDLN-RXNSNN WTNDLP(L,NZ,NY,NX)=WTNDLP(L,NZ,NY,NX)+PADDN-RXNDLP-RXNSNP +C IF(L.EQ.1)THEN +C WRITE(*,2122)'NODGR',I,J,NZ,L,RCNDLM,RCNDL,RMNDL,RGNDL,RGN2P +C 2,RGN2F,CGNDL,GRNDG,CCC,ZADDN,PADDN,SNCR,RCCC,RCCN,RCCP +C 8,RDNDLC,RDNDLN,RDNDLP,WFR(1,L,NZ,NY,NX) +C 3,WTNDL(L,NZ,NY,NX),WTNDLN(L,NZ,NY,NX),WTNDLP(L,NZ,NY,NX) +C 2,CPOOLN(L,NZ,NY,NX),ZPOOLN(L,NZ,NY,NX),PPOOLN(L,NZ,NY,NX) +C 5,FCNPF,TFN4(L,NZ,NY,NX),WFNGR(1,L),PSIRT(1,L,NZ,NY,NX) +2122 FORMAT(A8,4I4,60E14.6) +C ENDIF C C TRANSFER NON-STRUCTURAL C,N,P BETWEEN ROOT AND NODULES C FROM NON-STRUCTURAL C,N,P CONCENTRATION DIFFERENCES @@ -4667,15 +4716,6 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) ENDIF ENDIF ENDIF -C IF(L.EQ.1)THEN -C WRITE(*,2122)'NODGR',I,J,NZ,L,RCNDL,RMNDL,RGNDL,RGN2P -C 2,RGN2F,CGNDL,GRNDG,CCC,ZADDN,PADDN,SNCR,RCCC,RCCN,RCCP -C 8,FSNCN,RCCO,RDNDLC,RDNDLN,RDNDLP,WFR(1,L,NZ,NY,NX) -C 3,WTNDL(L,NZ,NY,NX),WTNDLN(L,NZ,NY,NX),WTNDLP(L,NZ,NY,NX) -C 2,CPOOLN(L,NZ,NY,NX),ZPOOLN(L,NZ,NY,NX),PPOOLN(L,NZ,NY,NX) -C 5,FCNPF,TFN4(L,NZ,NY,NX),WFNGR(1,L) -2122 FORMAT(A8,4I4,60E24.16) -C ENDIF ENDIF 5400 CONTINUE ENDIF @@ -7503,18 +7543,19 @@ SUBROUTINE grosub(I,J,NHW,NHE,NVN,NVS) 4+HVSTC(NZ,NY,NX)-VCO2F(NZ,NY,NX)-VCH4F(NZ,NY,NX) C IF(NZ.EQ.1)THEN C WRITE(*,1111)'BALC',I,J,NX,NY,NZ,BALC(NZ,NY,NX),WTSHT(NZ,NY,NX) -C 2,WTRT(NZ,NY,NX),WTND(NZ,NY,NX),WTRVC(NZ,NY,NX),TCO2T(NZ,NY,NX) -C 3,TCSNC(NZ,NY,NX),TCUPTK(NZ,NY,NX),CARBN(NZ,NY,NX) -C 2,RSETC(NZ,NY,NX),WTSTG(NZ,NY,NX),THVSTC(NZ,NY,NX) -C 3,HVSTC(NZ,NY,NX),CPOOLP(NZ,NY,NX) +C 2,WTRT(NZ,NY,NX),WTND(NZ,NY,NX),WTRVC(NZ,NY,NX),ZNPP(NZ,NY,NX) +C 3,TCSNC(NZ,NY,NX),TCUPTK(NZ,NY,NX),RSETC(NZ,NY,NX),WTSTG(NZ,NY,NX) +C 2,THVSTC(NZ,NY,NX),HVSTC(NZ,NY,NX),VCO2F(NZ,NY,NX),VCH4F(NZ,NY,NX) +C 5,CARBN(NZ,NY,NX),TCO2T(NZ,NY,NX) +C 3,((CSNC(M,1,L,NZ,NY,NX),M=1,4),L=0,NJ(NY,NX)) C 3,WTLF(NZ,NY,NX),WTSHE(NZ,NY,NX),WTSTK(NZ,NY,NX),WTRSV(NZ,NY,NX) C 3,WTHSK(NZ,NY,NX),WTEAR(NZ,NY,NX),WTGR(NZ,NY,NX) -C 5,VCO2F(NZ,NY,NX),VCH4F(NZ,NY,NX) -C 5,(WTLFB(NB,NZ,NY,NX),NB=1,5) -C 3,((CSNC(M,0,L,NZ,NY,NX),M=1,4),L=0,NL(NY,NX)) -C 4,((CPOOLR(N,L,NZ,NY,NX),L=1,NL(NY,NX)),N=1,2) -C 4,(CPOOLK(NB,NZ,NY,NX),NB=1,10) -1111 FORMAT(A8,5I4,200F18.6) +C 4,((CPOOLR(N,L,NZ,NY,NX),L=NU(NY,NX),NJ(NY,NX)),N=1,2) +C 5,(((WTRT1(N,L,NR,NZ,NY,NX),NR=1,NRT(NZ,NY,NX)) +C 2,L=NU(NY,NX),NJ(NY,NX)),N=1,2) +C 5,(((WTRT2(N,L,NR,NZ,NY,NX),NR=1,NRT(NZ,NY,NX)) +C 2,L=NU(NY,NX),NJ(NY,NX)),N=1,2) +1111 FORMAT(A8,5I4,200F16.8) C ENDIF C C PLANT N BALANCE = TOTAL N STATE VARIABLES + TOTAL N LITTERFALL diff --git a/f77src/hfunc.f b/f77src/hfunc.f old mode 100755 new mode 100644 index 3e908fe..307efc2 --- a/f77src/hfunc.f +++ b/f77src/hfunc.f @@ -41,9 +41,9 @@ SUBROUTINE hfunc(I,J,NHW,NHE,NVN,NVS) DO 9995 NX=NHW,NHE DO 9990 NY=NVN,NVS DO 9985 NZ=1,NP(NY,NX) -C WRITE(*,4444)'IFLGC',I,J,NX,NY,NZ,DATAP(NZ,NY,NX) -C 2,IDAY0(NZ,NY,NX),IDAYH(NZ,NY,NX),IYRC,IYRH(NZ,NY,NX) -C 3,IDTH(NZ,NY,NX),IYR0(NZ,NY,NX),IFLGC(NZ,NY,NX),IFLGT(NY,NX) +C WRITE(*,4444)'IFLGC',I,J,NX,NY,NZ,DATAP(NZ,NY,NX),IYRC +C 2,IDAY0(NZ,NY,NX),IDAYH(NZ,NY,NX),IYR0(NZ,NY,NX),IYRH(NZ,NY,NX) +C 3,IDTH(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) @@ -176,6 +176,10 @@ SUBROUTINE hfunc(I,J,NHW,NHE,NVN,NVS) C C EMERGENCE DATE FROM COTYLEDON HEIGHT, LEAF AREA, ROOT DEPTH C +C WRITE(*,223)'EMERG',I,J,NZ,NB1(NZ,NY,NX) +C 2,IDAY(1,NB1(NZ,NY,NX),NZ,NY,NX),HTCTL(NZ,NY,NX),SDPTH(NZ,NY,NX) +C 3,ARLSP,RTDP1(1,1,NZ,NY,NX) +223 FORMAT(A8,5I4,12E12.4) IF(IDAY(1,NB1(NZ,NY,NX),NZ,NY,NX).EQ.0)THEN ARLSP=ARLFP(NZ,NY,NX)+ARSTP(NZ,NY,NX) IF((HTCTL(NZ,NY,NX).GT.SDPTH(NZ,NY,NX)) @@ -270,8 +274,8 @@ SUBROUTINE hfunc(I,J,NHW,NHE,NVN,NVS) TKCO=TKG(NZ,NY,NX)+OFFST(NZ,NY,NX) RTK=8.3143*TKCO STK=710.0*TKCO - ACTV=1+EXP((197500-STK)/RTK)+EXP((STK-222500)/RTK) - TFNP=EXP(25.229-62500/RTK)/ACTV + ACTV=1+EXP((197500-STK)/RTK)+EXP((STK-218500)/RTK) + TFNP=EXP(24.269-60000/RTK)/ACTV RNI=AMAX1(0.0,TFNP*XRNI(NZ,NY,NX)) RLA=AMAX1(0.0,TFNP*XRLA(NZ,NY,NX)) C @@ -279,7 +283,7 @@ SUBROUTINE hfunc(I,J,NHW,NHE,NVN,NVS) C IF(ISTYP(NZ,NY,NX).EQ.0.AND.IDAY(6,NB,NZ,NY,NX).EQ.0)THEN WFNS=AMIN1(1.0,AMAX1(0.0,PSILG(NZ,NY,NX)-PSILM)) - WFNSP=WFNS**0.167 + WFNSP=WFNS**0.333 RNI=RNI*WFNSP RLA=RLA*WFNSP ENDIF diff --git a/f77src/hour1.f b/f77src/hour1.f old mode 100755 new mode 100644 index 1d01236..b5575dd --- a/f77src/hour1.f +++ b/f77src/hour1.f @@ -540,7 +540,24 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) C AFTER DISTURBANCES (E.G. TILLAGE, EROSION) C IF(IFLGS(NY,NX).NE.0)THEN - DO 9975 L=NU(NY,NX),NL(NY,NX) + XHS(NY,NX)=XNPH + IF(BKDS(NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN + XH(3,0,NY,NX)=XNPR + ELSE + XH(3,0,NY,NX)=1.0 + ENDIF + DO 9975 L=NUI(NY,NX),NL(NY,NX) + DO 9970 N=1,3 + IF(N.EQ.3)THEN + IF(BKDS(L,NY,NX).GT.ZEROS(NY,NX))THEN + XH(N,L,NY,NX)=XNPH + ELSE + XH(N,L,NY,NX)=1.0 + ENDIF + ELSE + XH(N,L,NY,NX)=XNPH + ENDIF +9970 CONTINUE C IF(FHOL(L,NY,NX).LT.0.0)THEN C THETH=EXP((PSIMS(NY,NX)-LOG(-PSISE(L,NY,NX)-PSIMA)) C 2*PSD(L,NY,NX)/PSISD(NY,NX)+PSL(L,NY,NX)) @@ -548,10 +565,17 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) C WRITE(*,3332)'FHOL',IYRC,L,FHOL(L,NY,NX),POROS(L,NY,NX) C 2,THETH,FC(L,NY,NX),PSISE(L,NY,NX),PSIMA,-PSISE(L,NY,NX)-PSIMA C ENDIF + AREA(1,L,NY,NX)=DLYR(3,L,NY,NX)*DLYR(2,L,NY,NX) + AREA(2,L,NY,NX)=DLYR(3,L,NY,NX)*DLYR(1,L,NY,NX) VOLT(L,NY,NX)=AREA(3,L,NY,NX)*DLYR(3,L,NY,NX) VOLX(L,NY,NX)=VOLT(L,NY,NX)*FMPR(L,NY,NX) - BKDS(L,NY,NX)=AMIN1(0.99*BKDSX,BKDS(L,NY,NX)) + IF(BKDX(L,NY,NX).GT.ZERO.AND.DLYR(3,L,NY,NX).GT.ZERO)THEN + BKDS(L,NY,NX)=AMIN1(0.99*BKDSX,BKDX(L,NY,NX) + 2*DLYRI(3,L,NY,NX)/DLYR(3,L,NY,NX)) 2/(1.0-FHOL(L,NY,NX)) + ELSE + BKDS(L,NY,NX)=0.0 + ENDIF BKVL(L,NY,NX)=BKDS(L,NY,NX)*VOLX(L,NY,NX) IF(BKVL(L,NY,NX).GT.0.0)THEN CORGC(L,NY,NX)=ORGC(L,NY,NX)/BKVL(L,NY,NX) @@ -579,9 +603,13 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) POROQ(L,NY,NX)=POROS(L,NY,NX)**0.667 VOLA(L,NY,NX)=POROS(L,NY,NX)*VOLX(L,NY,NX) VOLAH(L,NY,NX)=FHOL(L,NY,NX)*VOLT(L,NY,NX) + IF(BKDS(L,NY,NX).GT.ZERO)THEN 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)) + ELSE + VOLP(L,NY,NX)=0.0 + ENDIF 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 @@ -675,9 +703,17 @@ 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)) + IF(VOLT(L,NY,NX).GT.ZEROS(NY,NX))THEN THETP(L,NY,NX)=VOLP(L,NY,NX)/VOLT(L,NY,NX) + ELSE + THETP(L,NY,NX)=0.0 + ENDIF + IF(BKDS(L,NY,NX).GT.ZERO)THEN THETY(L,NY,NX)=EXP((PSIMX(NY,NX)-LOG(-PSIHY)) 2*FCD(L,NY,NX)/PSIMD(NY,NX)+FCL(L,NY,NX)) + ELSE + THETY(L,NY,NX)=ZERO + ENDIF C C SATURATED HYDRAULIC CONDUCTIVITY FROM SWC AT SATURATION VS. C -0.033 MPA (MINERAL SOILS) IF NOT ENTERED IN 'READS' @@ -707,11 +743,11 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) C WRITE(*,3332)'SCNH',IYRC,I,J,L,SCNH(L,NY,NX),POROS(L,NY,NX) C 2,THETF,FMPR(L,NY,NX) ENDIF - WRITE(*,3333)'PPTYS',I,J,NX,NY,L,ISOIL(1,L,NY,NX) - 2,ISOIL(2,L,NY,NX),ISOIL(3,L,NY,NX),ISOIL(4,L,NY,NX) - 3,SCNV(L,NY,NX),SCNH(L,NY,NX),POROS(L,NY,NX),THETF - 2,FC(L,NY,NX),WP(L,NY,NX),BKDS(L,NY,NX),THW(L,NY,NX) - 3,VOLW(L,NY,NX),THI(L,NY,NX),THETI(L,NY,NX) +C WRITE(*,3333)'PPTYS',I,J,NX,NY,L,ISOIL(1,L,NY,NX) +C 2,ISOIL(2,L,NY,NX),ISOIL(3,L,NY,NX),ISOIL(4,L,NY,NX) +C 3,SCNV(L,NY,NX),SCNH(L,NY,NX),POROS(L,NY,NX),THETF +C 2,FC(L,NY,NX),WP(L,NY,NX),BKDS(L,NY,NX),THW(L,NY,NX) +C 3,VOLW(L,NY,NX),THI(L,NY,NX),THETI(L,NY,NX) 3333 FORMAT(A8,9I4,20E12.4) C C HYDRAULIC CONDUCTIVITY FUNCTION FROM KSAT AND SOIL WATER RELEASE CURVE @@ -789,13 +825,13 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) 3+0.514*ROCK(L,NY,NX)*1.056E-02 DTC(L,NY,NX)=(1.253*VORGC+0.514*VMINL+0.386*VSAND) 2*FMPR(L,NY,NX)+0.514*ROCK(L,NY,NX) - VHCM(L,NY,NX)=((2.496*VORGC+2.385*VMINL+2.128*VSAND) - 2*FMPR(L,NY,NX)+2.128*ROCK(L,NY,NX)) - 3*AREA(3,L,NY,NX)*DLYR(3,L,NY,NX) +C VHCM(L,NY,NX)=((2.496*VORGC+2.385*VMINL+2.128*VSAND) +C 2*FMPR(L,NY,NX)+2.128*ROCK(L,NY,NX)) +C 3*AREA(3,L,NY,NX)*DLYR(3,L,NY,NX) ELSE STC(L,NY,NX)=0.0 DTC(L,NY,NX)=0.0 - VHCM(L,NY,NX)=0.0 +C VHCM(L,NY,NX)=0.0 ENDIF 9975 CONTINUE C @@ -804,18 +840,21 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) CORGC(0,NY,NX)=0.5E+06 FCR(NY,NX)=(-0.03/PSISE(0,NY,NX))**(1.0/FPSISR) THETY(0,NY,NX)=(PSIHY/PSISE(0,NY,NX))**(1.0/FPSISR) - DTBLX(NY,NX)=DTBLZ(NY,NX) + DTBLX(NY,NX)=DTBLZ(NY,NX)-CDPTH(NU(NY,NX)-1,NY,NX) C C SOIL SURFACE WATER STORAGE CAPACITY C + IF(BKDS(NU(NY,NX),NY,NX).GT.ZERO)THEN ZS(NY,NX)=0.025 + ELSE + ZS(NY,NX)=ZW + ENDIF 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) 2/BKVL(NU(NY,NX),NY,NX) @@ -842,6 +881,9 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) ZD50(NY,NX)=0.041*(1.0E-06*D50)**0.167 IFLGS(NY,NX)=0 ENDIF +C +C END OF RESET AFTER DISTURBANCE +C COHS(NY,NX)=2.0+2.0E-04*CORGC(NU(NY,NX),NY,NX) C 2+1.0E-04*RTDNT(NU(NY,NX),NY,NX) ORGCX=ORGC(0,NY,NX)/AREA(3,0,NY,NX) @@ -983,7 +1025,7 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) IFLGL=0 IFLGY=0 ICHKA=0 - DO 9985 L=NU(NY,NX),NL(NY,NX) + DO 9985 L=NUI(NY,NX),NL(NY,NX) FINH(L,NY,NX)=0.0 FLWV(L,NY,NX)=0.0 TCO2S(L,NY,NX)=0.0 @@ -1034,6 +1076,7 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) TRSO4(L,NY,NX)=0.0 TRCO3(L,NY,NX)=0.0 TRHCO(L,NY,NX)=0.0 + TRCO2(L,NY,NX)=0.0 TBCO2(L,NY,NX)=0.0 TRAL1(L,NY,NX)=0.0 TRAL2(L,NY,NX)=0.0 @@ -1185,46 +1228,20 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) XHGBBL(L,NY,NX)=0.0 RTDNT(L,NY,NX)=0.0 C -C CALCULATE SUBSIDENCE -C -C IF(BKDS(L,NY,NX).EQ.0.0)THEN -C 2.AND.CDPTH(L-1,NY,NX).LT.DPTHA(NY,NX))THEN -C DDLYR=(1.0-(VOLW(L,NY,NX)+VOLI(L,NY,NX))/VOLA(L,NY,NX)) -C 2*DLYR(3,L,NY,NX) -C IF(DLYR(3,L,NY,NX).GT.1.0E-03.OR.DDLYR.LT.0.0)THEN -C DO 900 LL=NU(NY,NX),L -C CDPTH(LL-1,NY,NX)=CDPTH(LL-1,NY,NX)+DDLYR -900 CONTINUE -C DO 905 LL=NU(NY,NX),L -C DLYR(3,LL,NY,NX)=(CDPTH(LL,NY,NX)-CDPTH(LL-1,NY,NX)) -C DPTH(LL,NY,NX)=0.5*(CDPTH(LL,NY,NX)+CDPTH(LL-1,NY,NX)) -C VOLT(L,NY,NX)=AREA(3,L,NY,NX)*DLYR(3,L,NY,NX) -C VOLX(L,NY,NX)=VOLT(L,NY,NX)*FMPR(L,NY,NX) -C VOLA(L,NY,NX)=POROS(L,NY,NX)*VOLX(L,NY,NX) -C IF((I/30)*30.EQ.I.AND.J.EQ.15)THEN -C WRITE(*,1114)'DDLYR',I,J,L,LL,DDLYR,VOLW(LL,NY,NX) -C 2,VOLI(LL,NY,NX),VOLA(LL,NY,NX),CDPTH(LL-1,NY,NX) -1114 FORMAT(A8,4I4,12E12.4) -C ENDIF -905 CONTINUE -C ENDIF -C ENDIF -C CDPTHZ(L,NY,NX)=CDPTH(L,NY,NX)-CDPTH(NU(NY,NX),NY,NX) -C 2+DLYR(3,NU(NY,NX),NY,NX) -C IF(L.EQ.NU(NY,NX))THEN -C DPTHZ(L,NY,NX)=0.5*CDPTHZ(L,NY,NX) -C ELSE -C DPTHZ(L,NY,NX)=0.5*(CDPTHZ(L,NY,NX)+CDPTHZ(L-1,NY,NX)) -C ENDIF -C C CALCULATE SOIL CONCENTRATIONS OF SOLUTES, GASES C + IF(VOLX(L,NY,NX).LE.ZEROS(NY,NX))THEN + THETW(L,NY,NX)=POROS(L,NY,NX) + THETI(L,NY,NX)=0.0 + THETP(L,NY,NX)=0.0 + ELSE THETW(L,NY,NX)=AMAX1(0.0,AMIN1(POROS(L,NY,NX) 2,VOLW(L,NY,NX)/VOLX(L,NY,NX))) THETI(L,NY,NX)=AMAX1(0.0,AMIN1(POROS(L,NY,NX) 2,VOLI(L,NY,NX)/VOLX(L,NY,NX))) THETP(L,NY,NX)=AMAX1(0.0,VOLP(L,NY,NX)/VOLT(L,NY,NX)) 2*HYST(L,NY,NX) + ENDIF THETPZ(L,NY,NX)=AMAX1(0.0,POROS(L,NY,NX)-THETW(L,NY,NX) 2-THETI(L,NY,NX)) IF(THETP(L,NY,NX).GT.THETX)THEN @@ -1448,11 +1465,16 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) CSTR(L,NY,NX)=0.0 CION(L,NY,NX)=0.0 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 IF(L.EQ.1)THEN +C WRITE(*,1113)'CION',I,J,NX,NY,L,CION(L,NY,NX) +C 2,ZC3,ZA3,ZC2,ZA2,ZC1,ZA1,ZN,VOLW(L,NY,NX) +C 3,ZAL(L,NY,NX),ZFE(L,NY,NX),ZNO3S(L,NY,NX),ZNO3B(L,NY,NX) +C 4,ZOH(L,NY,NX),ZHCO3(L,NY,NX),ZCL(L,NY,NX),ZALOH4(L,NY,NX) +C 5,ZFEOH4(L,NY,NX),ZNAC(L,NY,NX),ZNAS(L,NY,NX) +C 6,ZKAS(L,NY,NX),H2PO4(L,NY,NX),H2POB(L,NY,NX) +C 7,ZCA0P(L,NY,NX),ZCA0PB(L,NY,NX) +C ENDIF C C OSTWALD COEFFICIENTS FOR CO2, CH4, O2, N2, N2O, NH3 AND H2 C SOLUBILITY IN WATER @@ -1472,37 +1494,38 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) 2*EXP(0.513-0.0171*TCS(L,NY,NX))*FH2O SH2GL(L,NY,NX)=SH2GX/(EXP(AH2GX*CSTR(L,NY,NX))) 2*EXP(0.597-0.0199*TCS(L,NY,NX))*FH2O -C IF(BKVL(L,NY,NX).GT.0.0)THEN - IF(THETW(L,NY,NX).LT.FC(L,NY,NX))THEN + IF(BKVL(L,NY,NX).GT.0.0)THEN + THETW1=AMAX1(0.0,AMIN1(POROS(L,NY,NX) + 2,VOLW(L,NY,NX)/VOLXI(L,NY,NX))) + IF(THETW1.LT.FC(L,NY,NX))THEN PSISM(L,NY,NX)=AMAX1(PSIHY,-EXP(PSIMX(NY,NX) - 2+((FCL(L,NY,NX)-LOG(THETW(L,NY,NX))) + 2+((FCL(L,NY,NX)-LOG(THETW1)) 3/FCD(L,NY,NX)*PSIMD(NY,NX)))) - ELSEIF(THETW(L,NY,NX).LT.POROS(L,NY,NX)-DTHETW)THEN + ELSEIF(THETW1.LT.POROS(L,NY,NX)-DTHETW)THEN PSISM(L,NY,NX)=-EXP(PSIMS(NY,NX) - 2+(((PSL(L,NY,NX)-LOG(THETW(L,NY,NX))) + 2+(((PSL(L,NY,NX)-LOG(THETW1)) 3/PSD(L,NY,NX))**SRP(L,NY,NX)*PSISD(NY,NX))) ELSE PSISM(L,NY,NX)=PSISE(L,NY,NX) ENDIF -C ELSE -C PSISM(L,NY,NX)=PSISE(L,NY,NX) -C ENDIF + ELSE + PSISM(L,NY,NX)=PSISE(L,NY,NX) + ENDIF C C SOIL OSMOTIC, GRAVIMETRIC AND MATRIC WATER POTENTIALS C PSISO(L,NY,NX)=-8.3143E-06*TKS(L,NY,NX)*CION(L,NY,NX) - PSISH(L,NY,NX)=0.0098*YDPTH(L,NY,NX) + PSISH(L,NY,NX)=0.0098*(ALT(NY,NX)-DPTH(L,NY,NX)) PSIST(L,NY,NX)=AMIN1(0.0,PSISM(L,NY,NX)+PSISO(L,NY,NX) 2+PSISH(L,NY,NX)) C IF((I/30)*30.EQ.I.AND.J.EQ.15)THEN -C IF(I.GT.170.AND.NX.EQ.1.AND.NY.EQ.4)THEN C WRITE(*,1113)'PSISM1',I,J,NX,NY,L,PSISM(L,NY,NX),THETW(L,NY,NX) C 2,FC(L,NY,NX),WP(L,NY,NX),POROS(L,NY,NX),VOLP(L,NY,NX) C 3,VOLW(L,NY,NX),VOLI(L,NY,NX),VOLA(L,NY,NX),VOLT(L,NY,NX) C 4,CDPTH(L,NY,NX),DPTH(L,NY,NX),CDPTHZ(L,NY,NX),DPTHZ(L,NY,NX) C 5,DLYR(3,L,NY,NX),PSIST(L,NY,NX),PSISM(L,NY,NX),PSISO(L,NY,NX) C 2,PSISH(L,NY,NX),TKS(L,NY,NX),CION(L,NY,NX) -1113 FORMAT(A8,5I4,30E12.4) +1113 FORMAT(A8,5I4,50E12.4) C ENDIF C C SOIL RESISTANCE TO ROOT PENETRATION @@ -1541,8 +1564,12 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) GO TO 5701 ENDIF 5700 CONTINUE + IF(VOLAT.GT.ZEROS(NY,NX))THEN DPTHA(NY,NX)=CDPTH(L,NY,NX)-DLYR(3,L,NY,NX) 2*AMIN1(1.0,VOLIT/VOLAT) + ELSE + DPTHA(NY,NX)=CDPTH(L,NY,NX)-DLYR(3,L,NY,NX) + ENDIF ICHKA=1 GO TO 5702 5701 DPTHA(NY,NX)=9999.0 @@ -1611,13 +1638,13 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) C PHYSICAL PROPERTIES, AND WATER, GAS, AND MINERAL CONTENTS C OF SURFACE RESIDUE C - VOLWRX(NY,NX)=THETRX(0)*RC0(0,NY,NX)+THETRX(1)*RC0(1,NY,NX) - 2+THETRX(2)*RC0(2,NY,NX) - VOLR(NY,NX)=RC0(0,NY,NX)*1.0E-06/BKRS(0) - 2+RC0(1,NY,NX)*1.0E-06/BKRS(1)+RC0(2,NY,NX)*1.0E-06/BKRS(2) - TVOLG=AMAX1(0.0,VOLW(0,NY,NX)+VOLI(0,NY,NX) + VOLWRX(NY,NX)=AMAX1(0.0,THETRX(0)*RC0(0,NY,NX) + 2+THETRX(1)*RC0(1,NY,NX)+THETRX(2)*RC0(2,NY,NX)) + VOLR(NY,NX)=AMAX1(0.0,RC0(0,NY,NX)*1.0E-06/BKRS(0) + 2+RC0(1,NY,NX)*1.0E-06/BKRS(1)+RC0(2,NY,NX)*1.0E-06/BKRS(2)) + TVOLG0=AMAX1(0.0,VOLW(0,NY,NX)+VOLI(0,NY,NX) 2-VOLWRX(NY,NX)) - VOLT(0,NY,NX)=TVOLG+VOLR(NY,NX) + VOLT(0,NY,NX)=TVOLG0+VOLR(NY,NX) 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) @@ -2131,8 +2158,12 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) FSNOW=AMIN1((DPTHS(NY,NX)/0.07)**2,1.0) ALBG=FSNOW*ALBW+(1.0-FSNOW)*ALBS(NY,NX) ELSE + IF(VOLX(NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN THETW1=AMIN1(POROS(NU(NY,NX),NY,NX) 2,VOLW(NU(NY,NX),NY,NX)/VOLX(NU(NY,NX),NY,NX)) + ELSE + THETW1=0.0 + ENDIF ALBG=AMIN1(ALBX(NY,NX),ALBS(NY,NX) 2+AMAX1(0.0,ALBX(NY,NX)-THETW1)) ENDIF @@ -2226,18 +2257,20 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) FRADG(NY,NX)=FRADG(NY,NX)-FRADP(NZ,NY,NX) 145 CONTINUE ELSE + FRADG(NY,NX)=1.0 DO 146 NZ=1,NP(NY,NX) FRADP(NZ,NY,NX)=0.0 146 CONTINUE ENDIF C IF(NX.EQ.4.AND.NY.EQ.5)THEN C DO 140 NZ=1,NP(NY,NX) -C WRITE(19,1926)'CANOPY',IYRC,I,J,NX,NY,NZ,FRADP(NZ,NY,NX) +C WRITE(*,1926)'CANOPY',IYRC,I,J,NX,NY,NZ,FRADP(NZ,NY,NX) C 2,RADP(NZ,NY,NX)/AREA(3,NU(NY,NX),NY,NX),RAP(NY,NX) C 2,FRADG(NY,NX),ARLFS(NZ,NY,NX)/AREA(3,NU(NY,NX),NY,NX) C 3,ARLFP(NZ,NY,NX)/AREA(3,NU(NY,NX),NY,NX) C 4,ARSTP(NZ,NY,NX)/AREA(3,NU(NY,NX),NY,NX) -C 5,SSIN(NY,NX),DPTHS(NY,NX) +C 4,ARLSS(NY,NX)/AREA(3,NU(NY,NX),NY,NX) +C 5,SSIN(NY,NX),DPTHS(NY,NX),FRADPT 1926 FORMAT(A10,6I6,30E12.4) 140 CONTINUE C ENDIF @@ -2400,21 +2433,22 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) C C SOIL LAYER NUMBER AT DEPTH OF APPLICATION C - IF(Z4A+Z3A+ZUA+ZOA+Z4B+Z3B+ZUB+ZOB+PMA+PMB+PHA+CAC+CAS.GT.0.0)THEN + IF(Z4A+Z3A+ZUA+ZOA+Z4B+Z3B+ZUB+ZOB + 2+PMA+PMB+PHA+CAC+CAS.GT.0.0)THEN IF(FDPTH(I,NY,NX).LE.0.0.AND.Z4B+Z3B+ZUB+ZOB+PMB.EQ.0.0)THEN LFDPTH=0 - CVRD=1.0-EXP(-0.8E-02*(ORGC(0,NY,NX)/AREA(3,0,NY,NX))) + CVRDF=1.0-EXP(-0.8E-02*(ORGC(0,NY,NX)/AREA(3,0,NY,NX))) ELSE - DO 65 L=NU(NY,NX),JZ + DO 65 L=NUI(NY,NX),JZ IF(CDPTH(L,NY,NX).GE.FDPTH(I,NY,NX))THEN LFDPTH=L - CVRD=1.0 + CVRDF=1.0 GO TO 55 ENDIF 65 CONTINUE 55 CONTINUE ENDIF - BARE=1.0-CVRD + BAREF=1.0-CVRDF C C RESET WIDTH AND DEPTH OF NH4 FERTILIZER BAND IF NEW BAND APPLICATION C AND ADD REMAINS OF ANY EXISTING FERTILIZER BAND TO NEW BAND @@ -2423,7 +2457,7 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) 2.OR.ZNH3B(LFDPTH,NY,NX).GT.0.0).AND.IFNHB(NY,NX).EQ.0))THEN IFNHB(NY,NX)=1 ROWN(NY,NX)=ROWI(I,NY,NX) - DO 50 L=NU(NY,NX),JZ + DO 50 L=NUI(NY,NX),JZ IF(L.LT.LFDPTH)THEN DPNHB(L,NY,NX)=DLYR(3,L,NY,NX) WDNHB(L,NY,NX)=0.0 @@ -2434,8 +2468,12 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) DPNHB(L,NY,NX)=0.0 WDNHB(L,NY,NX)=0.0 ENDIF + IF(DLYR(3,L,NY,NX).GT.ZERO)THEN VLNHB(L,NY,NX)=AMIN1(0.999,WDNHB(L,NY,NX)/ROWN(NY,NX) 2*DPNHB(L,NY,NX)/DLYR(3,L,NY,NX)) + ELSE + VLNHB(L,NY,NX)=0.0 + ENDIF VLNH4(L,NY,NX)=1.0-VLNHB(L,NY,NX) ZNH4T=ZNH4S(L,NY,NX)+ZNH4B(L,NY,NX) ZNH3T=ZNH3S(L,NY,NX)+ZNH3B(L,NY,NX) @@ -2457,7 +2495,7 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) 2.OR.ZNO2B(LFDPTH,NY,NX).GT.0.0).AND.IFNOB(NY,NX).EQ.0))THEN IFNOB(NY,NX)=1 ROWO(NY,NX)=ROWI(I,NY,NX) - DO 45 L=NU(NY,NX),JZ + DO 45 L=NUI(NY,NX),JZ IF(L.LT.LFDPTH)THEN DPNOB(L,NY,NX)=DLYR(3,L,NY,NX) WDNOB(L,NY,NX)=0.0 @@ -2468,8 +2506,12 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) DPNOB(L,NY,NX)=0.0 WDNOB(L,NY,NX)=0.0 ENDIF + IF(DLYR(3,L,NY,NX).GT.ZERO)THEN VLNOB(L,NY,NX)=AMIN1(0.999,WDNOB(L,NY,NX)/ROWO(NY,NX) 2*DPNOB(L,NY,NX)/DLYR(3,L,NY,NX)) + ELSE + VLNOB(L,NY,NX)=0.0 + ENDIF VLNO3(L,NY,NX)=1.0-VLNOB(L,NY,NX) ZNO3T=ZNO3S(L,NY,NX)+ZNO3B(L,NY,NX) ZNO2T=ZNO2S(L,NY,NX)+ZNO2B(L,NY,NX) @@ -2488,7 +2530,7 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) 2.AND.IFPOB(NY,NX).EQ.0))THEN IFPOB(NY,NX)=1 ROWP(NY,NX)=ROWI(I,NY,NX) - DO 40 L=NU(NY,NX),JZ + DO 40 L=NUI(NY,NX),JZ IF(L.LT.LFDPTH)THEN DPPOB(L,NY,NX)=DLYR(3,L,NY,NX) WDPOB(L,NY,NX)=AMIN1(0.01,ROWP(NY,NX)) @@ -2499,8 +2541,12 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) DPPOB(L,NY,NX)=0.0 WDPOB(L,NY,NX)=0.0 ENDIF + IF(DLYR(3,L,NY,NX).GT.ZERO)THEN VLPOB(L,NY,NX)=AMIN1(0.999,WDPOB(L,NY,NX)/ROWP(NY,NX) 2*DPPOB(L,NY,NX)/DLYR(3,L,NY,NX)) + ELSE + VLPOB(L,NY,NX)=0.0 + ENDIF VLPO4(L,NY,NX)=1.0-VLPOB(L,NY,NX) H0PO4T=H0PO4(L,NY,NX)+H0POB(L,NY,NX) H1PO4T=H1PO4(L,NY,NX)+H1POB(L,NY,NX) @@ -2582,40 +2628,40 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) PHAX=PHA*AREA(3,LFDPTH,NY,NX)/93.0 CACX=CAC*AREA(3,LFDPTH,NY,NX)/40.0 CASX=CAS*AREA(3,LFDPTH,NY,NX)/40.0 - ZNH4FA(LFDPTH,NY,NX)=ZNH4FA(LFDPTH,NY,NX)+Z4AX*CVRD - ZNHUFA(LFDPTH,NY,NX)=ZNHUFA(LFDPTH,NY,NX)+ZUAX*CVRD - ZNO3FA(LFDPTH,NY,NX)=ZNO3FA(LFDPTH,NY,NX)+ZOAX*CVRD - ZNH4FB(LFDPTH,NY,NX)=ZNH4FB(LFDPTH,NY,NX)+Z4BX*CVRD - ZNHUFB(LFDPTH,NY,NX)=ZNHUFB(LFDPTH,NY,NX)+ZUBX*CVRD - ZNO3FB(LFDPTH,NY,NX)=ZNO3FB(LFDPTH,NY,NX)+ZOBX*CVRD + ZNH4FA(LFDPTH,NY,NX)=ZNH4FA(LFDPTH,NY,NX)+Z4AX*CVRDF + ZNHUFA(LFDPTH,NY,NX)=ZNHUFA(LFDPTH,NY,NX)+ZUAX*CVRDF + ZNO3FA(LFDPTH,NY,NX)=ZNO3FA(LFDPTH,NY,NX)+ZOAX*CVRDF + ZNH4FB(LFDPTH,NY,NX)=ZNH4FB(LFDPTH,NY,NX)+Z4BX*CVRDF + ZNHUFB(LFDPTH,NY,NX)=ZNHUFB(LFDPTH,NY,NX)+ZUBX*CVRDF + ZNO3FB(LFDPTH,NY,NX)=ZNO3FB(LFDPTH,NY,NX)+ZOBX*CVRDF PCAPM(LFDPTH,NY,NX)=PCAPM(LFDPTH,NY,NX) - 2+PMAX*VLPO4(LFDPTH,NY,NX)*CVRD + 2+PMAX*VLPO4(LFDPTH,NY,NX)*CVRDF PCPMB(LFDPTH,NY,NX)=PCPMB(LFDPTH,NY,NX) - 2+PMAX*VLPOB(LFDPTH,NY,NX)*CVRD+PMBX*CVRD + 2+PMAX*VLPOB(LFDPTH,NY,NX)*CVRDF+PMBX*CVRDF PCAPH(LFDPTH,NY,NX)=PCAPH(LFDPTH,NY,NX) - 2+PHAX*VLPO4(LFDPTH,NY,NX)*CVRD + 2+PHAX*VLPO4(LFDPTH,NY,NX)*CVRDF PCPHB(LFDPTH,NY,NX)=PCPHB(LFDPTH,NY,NX) - 2+PHAX*VLPOB(LFDPTH,NY,NX)*CVRD + 2+PHAX*VLPOB(LFDPTH,NY,NX)*CVRDF IF(LFDPTH.EQ.0)THEN - ZNH4FA(NU(NY,NX),NY,NX)=ZNH4FA(NU(NY,NX),NY,NX)+Z4AX*BARE + ZNH4FA(NU(NY,NX),NY,NX)=ZNH4FA(NU(NY,NX),NY,NX)+Z4AX*BAREF ZNH3FA(NU(NY,NX),NY,NX)=ZNH3FA(NU(NY,NX),NY,NX)+Z3AX - ZNHUFA(NU(NY,NX),NY,NX)=ZNHUFA(NU(NY,NX),NY,NX)+ZUAX*BARE - ZNO3FA(NU(NY,NX),NY,NX)=ZNO3FA(NU(NY,NX),NY,NX)+ZOAX*BARE - ZNH4FB(NU(NY,NX),NY,NX)=ZNH4FB(NU(NY,NX),NY,NX)+Z4BX*BARE + ZNHUFA(NU(NY,NX),NY,NX)=ZNHUFA(NU(NY,NX),NY,NX)+ZUAX*BAREF + ZNO3FA(NU(NY,NX),NY,NX)=ZNO3FA(NU(NY,NX),NY,NX)+ZOAX*BAREF + ZNH4FB(NU(NY,NX),NY,NX)=ZNH4FB(NU(NY,NX),NY,NX)+Z4BX*BAREF ZNH3FB(NU(NY,NX),NY,NX)=ZNH3FB(NU(NY,NX),NY,NX)+Z3BX - ZNHUFB(NU(NY,NX),NY,NX)=ZNHUFB(NU(NY,NX),NY,NX)+ZUBX*BARE - ZNO3FB(NU(NY,NX),NY,NX)=ZNO3FB(NU(NY,NX),NY,NX)+ZOBX*BARE + ZNHUFB(NU(NY,NX),NY,NX)=ZNHUFB(NU(NY,NX),NY,NX)+ZUBX*BAREF + ZNO3FB(NU(NY,NX),NY,NX)=ZNO3FB(NU(NY,NX),NY,NX)+ZOBX*BAREF PCAPM(NU(NY,NX),NY,NX)=PCAPM(NU(NY,NX),NY,NX) - 2+PMAX*VLPO4(NU(NY,NX),NY,NX)*BARE + 2+PMAX*VLPO4(NU(NY,NX),NY,NX)*BAREF PCPMB(NU(NY,NX),NY,NX)=PCPMB(NU(NY,NX),NY,NX) - 2+PMAX*VLPOB(NU(NY,NX),NY,NX)*BARE+PMBX*BARE + 2+PMAX*VLPOB(NU(NY,NX),NY,NX)*BAREF+PMBX*BAREF PCAPH(NU(NY,NX),NY,NX)=PCAPH(NU(NY,NX),NY,NX) - 2+PHAX*VLPO4(NU(NY,NX),NY,NX)*BARE + 2+PHAX*VLPO4(NU(NY,NX),NY,NX)*BAREF PCPHB(NU(NY,NX),NY,NX)=PCPHB(NU(NY,NX),NY,NX) - 2+PHAX*VLPOB(NU(NY,NX),NY,NX)*BARE + 2+PHAX*VLPOB(NU(NY,NX),NY,NX)*BAREF ELSE - ZNH3FA(LFDPTH,NY,NX)=ZNH3FA(LFDPTH,NY,NX)+Z3AX*CVRD - ZNH3FB(LFDPTH,NY,NX)=ZNH3FB(LFDPTH,NY,NX)+Z3BX*CVRD + ZNH3FA(LFDPTH,NY,NX)=ZNH3FA(LFDPTH,NY,NX)+Z3AX*CVRDF + ZNH3FB(LFDPTH,NY,NX)=ZNH3FB(LFDPTH,NY,NX)+Z3BX*CVRDF 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 @@ -2898,14 +2944,9 @@ SUBROUTINE hour1(I,J,NHW,NHE,NVN,NVS) ENDIF 8995 CONTINUE 8990 CONTINUE - NPH=NPX - NPT=NPY - NPG=NPH*NPT - XNPH=1.0/NPH - XNPT=1.0/NPT - XNPG=1.0/NPG - XNPD=600.0*XNPG RETURN END + + diff --git a/f77src/nitro.f b/f77src/nitro.f old mode 100755 new mode 100644 index bc57c9d..0a739cd --- a/f77src/nitro.f +++ b/f77src/nitro.f @@ -122,10 +122,11 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) C TRN2GD(NY,NX)=0.0 C ENDIF DO 998 L=0,NL(NY,NX) + IF(VOLX(L,NY,NX).GT.ZEROS(NY,NX))THEN IF(L.EQ.0.OR.L.GE.NU(NY,NX))THEN IF(L.EQ.0)THEN KL=2 - IF(VOLWRX(NY,NX).GT.ZEROS(NY,NX))THEN + IF(VOLWRX(NY,NX).GT.ZEROS2(NY,NX))THEN THETR=VOLW(0,NY,NX)/VOLWRX(NY,NX) THETZ=AMAX1(0.0,(AMIN1(FCR(NY,NX),THETR)-THETY(L,NY,NX))) VOLWZ=THETZ/(1.0+THETZ)*VOLWRX(NY,NX) @@ -317,7 +318,7 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) C C DOC CONCENTRATIONS C - IF(VOLWM(NPH,L,NY,NX).GT.ZEROS(NY,NX))THEN + IF(VOLWM(NPH,L,NY,NX).GT.ZEROS2(NY,NX))THEN IF(FOSRH(K,L,NY,NX).GT.ZERO)THEN COQC(K,L,NY,NX)=AMAX1(0.0,OQC(K,L,NY,NX) 2/(VOLWM(NPH,L,NY,NX)*FOSRH(K,L,NY,NX))) @@ -749,7 +750,7 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) C ECHZ=EO2X VMXX=VMXH*TFNG(N,K)*FCNP(N,K)*XCO2*OMA(N,K) - IF(VOLWZ.GT.ZEROS(NY,NX))THEN + IF(VOLWZ.GT.ZEROS2(NY,NX))THEN VMXA=VMXX/(1.0+VMXX/(VHKI*VOLWZ)) ELSE VMXA=0.0 @@ -773,7 +774,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.19.AND.L.LE.5)THEN +C IF(IYRC.EQ.2012.AND.I.EQ.151.AND.NX.EQ.1)THEN C WRITE(*,6666)'NITRI',I,J,L,K,N,RNNH4,RNNHB,VMXX,VMXA,VOLWZ C 2,CNH4S(L,NY,NX),CNH4B(L,NY,NX),14.0*XN4(L,NY,NX),14.0*XNB(L,NY,NX) C 3,ZNH4S(L,NY,NX),ZNH4B(L,NY,NX),COXYS(L,NY,NX),RGOMP @@ -892,7 +893,7 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) C TO MAINTAIN AQUEOUS CH4 CONCENTRATION DURING OXIDATION C DO 320 M=1,NPH - IF(VOLWM(M,L,NY,NX).GT.ZEROS(NY,NX))THEN + IF(VOLWM(M,L,NY,NX).GT.ZEROS2(NY,NX))THEN VOLWCH=VOLWM(M,L,NY,NX)*SCH4L(L,NY,NX) VOLWPM=VOLWCH+VOLPM(M,L,NY,NX) DO 325 MM=1,NPT @@ -1142,7 +1143,7 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) VMXDXB=0.0 ENDIF VMXDXT=VMXDXS+VMXDXB - IF(VOLWZ.GT.ZEROS(NY,NX).AND.FOSRH(K,L,NY,NX).GT.ZERO)THEN + IF(VOLWZ.GT.ZEROS2(NY,NX).AND.FOSRH(K,L,NY,NX).GT.ZERO)THEN FVMXDX=1.0/(1.0+VMXDXT/(VMKI*VOLWZ*FOSRH(K,L,NY,NX))) ELSE FVMXDX=0.0 @@ -1201,7 +1202,7 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) VMXDXB=0.0 ENDIF VMXDXT=VMXDXS+VMXDXB - IF(VOLWZ.GT.ZEROS(NY,NX).AND.FOSRH(K,L,NY,NX).GT.ZERO)THEN + IF(VOLWZ.GT.ZEROS2(NY,NX).AND.FOSRH(K,L,NY,NX).GT.ZERO)THEN FVMXDX=1.0/(1.0+VMXDXT/(VMKI*VOLWZ*FOSRH(K,L,NY,NX))) ELSE FVMXDX=0.0 @@ -1242,7 +1243,7 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) C VMXD1=(VMXD2-RDN2T)*2.0 VMXDXS=VMXD1*CZ2OS(L,NY,NX)/(CZ2OS(L,NY,NX)+Z1KM) - IF(VOLWZ.GT.ZEROS(NY,NX).AND.FOSRH(K,L,NY,NX).GT.ZERO)THEN + IF(VOLWZ.GT.ZEROS2(NY,NX).AND.FOSRH(K,L,NY,NX).GT.ZERO)THEN FVMXDX=1.0/(1.0+VMXDXS/(VMKI*VOLWZ*FOSRH(K,L,NY,NX))) ELSE FVMXDX=0.0 @@ -1309,7 +1310,7 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) VMXDXS=FNO2S*VMXD4*CNO2S(L,NY,NX)/(CNO2S(L,NY,NX)+Z2KM) VMXDXB=FNO2B*VMXD4*CNO2B(L,NY,NX)/(CNO2B(L,NY,NX)+Z2KM) VMXDXT=VMXDXS+VMXDXB - IF(VOLWZ.GT.ZEROS(NY,NX))THEN + IF(VOLWZ.GT.ZEROS2(NY,NX))THEN FVMXDX=1.0/(1.0+VMXDXT/(VMKI*VOLWZ)) ELSE FVMXDX=0.0 @@ -1380,12 +1381,11 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) 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 WRITE(*,7776)'RINH4',IYRC,I,J,NX,NY,L,K,N,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) +C 3,RINHO(N,K,L,NY,NX),CNH4S(L,NY,NX),FNH4X,ZNH4S(L,NY,NX) +C 4,ZNH4B(L,NY,NX),ZNH4T(L),OQN(K,L,NY,NX) 7776 FORMAT(A8,8I6,30E12.4) C ENDIF C @@ -1943,9 +1943,10 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) 2.AND.ROQCK(KK)+XOQCK(KK)+XFRK.GT.0.0)THEN XOQCK(K)=XOQCK(K)-XFRK XOQCK(KK)=XOQCK(KK)+XFRK -C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.LE.1)THEN +C IF(I.EQ.116)THEN C WRITE(*,4442)'XOQCK',I,J,NX,NY,L,K,KK,XFRC,ROQCK(K) C 2,OSRH(K),ROQCK(KK),OSRH(KK),XOQCK(K),XOQCK(KK) +C 3,OQC(K,L,NY,NX),OQC(KK,L,NY,NX) 4442 FORMAT(A8,7I4,12E12.4) C ENDIF ENDIF @@ -1953,9 +1954,10 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) 2.AND.OQC(KK,L,NY,NX)+XOQCZ(KK)+XFRC.GT.0.0)THEN XOQCZ(K)=XOQCZ(K)-XFRC XOQCZ(KK)=XOQCZ(KK)+XFRC -C IF((I/1)*1.EQ.I.AND.L.EQ.3.AND.K.EQ.1)THEN +C IF(I.EQ.116)THEN C WRITE(*,4442)'XOQCZ',I,J,NX,NY,L,K,KK,XFRC,OQC(K,L,NY,NX) C 2,OSRH(K),OQC(KK,L,NY,NX),OSRH(KK),XOQCZ(K),XOQCZ(KK) +C 3,OQC(K,L,NY,NX),OQC(KK,8,NY,NX) C ENDIF ENDIF IF(OQN(K,L,NY,NX)+XOQNZ(K)-XFRN.GT.0.0 @@ -1997,9 +1999,9 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) 2.AND.OMC(M,N,KK,L,NY,NX)+XOMCZ(M,N,KK)+XFMC.GT.0.0)THEN XOMCZ(M,N,K)=XOMCZ(M,N,K)-XFMC XOMCZ(M,N,KK)=XOMCZ(M,N,KK)+XFMC -C IF((I/10)*10.EQ.I.AND.J.EQ.24.AND.L.EQ.4)THEN +C IF(I.EQ.116)THEN C WRITE(*,4447)'XOMCZ',I,J,NX,NY,L,K,KK,N,M,XFMC,OMC(M,N,K,L,NY,NX) -C 2,OQC(K,L,NY,NX),OMC(M,N,KK,L,NY,NX),OQC(KK,L,NY,NX),OQCT +C 2,OQC(K,L,NY,NX),OMC(M,N,KK,L,NY,NX),OQC(KK,8,NY,NX) C 3,XOMCZ(M,N,K),XOMCZ(M,N,KK) 4447 FORMAT(A8,9I4,20E12.4) C ENDIF @@ -2065,7 +2067,7 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) C AQUEOUS CONCENTRATION OF BIOMASS TO CACULATE INHIBITION C CONSTANT FOR DECOMPOSITION C - IF(VOLWZ.GT.ZEROS(NY,NX))THEN + IF(VOLWZ.GT.ZEROS2(NY,NX))THEN COQCK=AMIN1(0.1E+06,ROQCK(K)/VOLWZ) ELSE COQCK=0.1E+06 @@ -2237,7 +2239,7 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) C C DOC ADSORPTION - DESORPTION C - IF(VOLWM(NPH,L,NY,NX).GT.ZEROS(NY,NX) + IF(VOLWM(NPH,L,NY,NX).GT.ZEROS2(NY,NX) 2.AND.FOSRH(K,L,NY,NX).GT.ZERO)THEN IF(L.EQ.0)THEN AECX=50.0 @@ -2276,11 +2278,12 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) ZSORP(K)=0.0 PSORP(K)=0.0 ENDIF -C IF(L.EQ.4.AND.K.EQ.1)THEN +C IF(I.EQ.116)THEN C WRITE(*,591)'CSORP',I,J,NX,NY,L,K,CSORP(K),CSORPA(K) C 1,OQC(K,L,NY,NX),OHC(K,L,NY,NX),OQA(K,L,NY,NX),OHA(K,L,NY,NX) -C 2,OQC(K,L,NY,NX)/VOLWM(NPH,L,NY,NX),OHC(K,L,NY,NX)/BKVL(L,NY,NX) -C 2,OQA(K,L,NY,NX)/VOLWM(NPH,L,NY,NX),OHA(K,L,NY,NX)/BKVL(L,NY,NX) +C 2,OQC(K,L,NY,NX)/VOLWM(NPH,L,NY,NX) +C 2,OQA(K,L,NY,NX)/VOLWM(NPH,L,NY,NX) +C 3,OHC(K,L,NY,NX)/BKVL(L,NY,NX),OHA(K,L,NY,NX)/BKVL(L,NY,NX) C 4,BKVL(L,NY,NX),VOLWM(NPH,L,NY,NX),FOCA(K),FOAA(K) C 5,FOSRH(K,L,NY,NX),TCGOQC(K),OQCX 591 FORMAT(A8,6I4,40E12.4) @@ -2404,10 +2407,10 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) OHN(K,L,NY,NX)=OHN(K,L,NY,NX)+ZSORP(K) OHP(K,L,NY,NX)=OHP(K,L,NY,NX)+PSORP(K) OHA(K,L,NY,NX)=OHA(K,L,NY,NX)+CSORPA(K) -C IF((I/1)*1.EQ.I.AND.L.EQ.3.AND.K.EQ.1)THEN +C IF(I.GT.190.AND.NX.EQ.1)THEN C WRITE(*,592)'OQC',I,J,NX,NY,L,K,OQC(K,L,NY,NX) C 2,(RCOSC(M,K),M=1,4),(RDORC(M,K),M=1,2),RDOHC(K) -C 2,(CGOQC(N,K),N=1,7),CSORP(K),OHC(K,L,NY,NX),OQCI +C 2,(CGOQC(N,K),N=1,7),CSORP(K),OHC(K,L,NY,NX) C 4,(WFN(N,K),N=1,7),OQA(K,L,NY,NX),RDOHA(K),(RCH3X(N,K),N=1,7) C 3,(CGOAC(N,K),N=1,7),CSORPA(K),OHA(K,L,NY,NX) C WRITE(*,592)'OQN',I,J,NX,NY,L,K,OQN(K,L,NY,NX) @@ -2431,6 +2434,7 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) 2-RXOMN(M,N,K)-RXMMN(M,N,K) OMP(M,N,K,L,NY,NX)=OMP(M,N,K,L,NY,NX)+CGOPS(M,N,K) 2-RXOMP(M,N,K)-RXMMP(M,N,K) +C WRITE(*,4441)'OMN2',I,J,NX,NY,L,K,N,M,OMN(M,N,K,L,NY,NX) C IF((I/30)*30.EQ.I.AND.J.EQ.15.AND.L.LE.6 C 2.AND.K.EQ.5.AND.N.EQ.2)THEN C WRITE(*,4488)'RDOMC',I,J,NX,NY,L,K,N,M,CGOMS(M,N,K),CGOQC(N,K) @@ -2517,6 +2521,9 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) C 2,CGOMS(1,N,K),CGOMS(2,N,K),CGROMC,OMP(3,N,K,L,NY,NX) C 3,CGOPS(1,N,K),CGOPS(2,N,K),CGOMP(N,K),RIPO4(N,K) C 4,CGOMC(N,K),RGOMO(N,K),RGOMD(N,K),RMOMT,WFN(N,K) +C 5,OMN(3,N,K,L,NY,NX),CGONS(M,N,K),R3OMN(M,N,K),R3MMN(M,N,K) +C 6,CGOMN(N,K),RINH4(N,K),RINB4(N,K),RINO3(N,K),RINB3(N,K) +C 7,RN2FX(N,K) 5556 FORMAT(A8,7I4,20E12.4) C ENDIF ENDIF @@ -2625,7 +2632,7 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) TRD2B=TRD2B+RDN2B(N,K) TRDNO=TRDNO+RDN2O(N,K) TRGOH=TRGOH+RH2GX(N,K) -C IF(L.EQ.NU(NY,NX))THEN +C IF(IYRC.EQ.2012.AND.I.EQ.151.AND.NX.EQ.1)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) @@ -2659,7 +2666,7 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) RUPOXO(L,NY,NX)=TUPOX RN2G(L,NY,NX)=-TRDNO RN2O(L,NY,NX)=-TRDN2-TRD2B-RCN2O-RCN2B+TRDNO -C IF((I/1)*1.EQ.I.AND.J.EQ.19.AND.L.LE.5)THEN +C IF(L.EQ.10)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 @@ -2744,6 +2751,10 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) C C ADJUST LAYERING OF SOC C +C IF(I.EQ.116)THEN +C WRITE(*,336)'LAYER',I,J,L,(OQC(K,L,NY,NX),K=0,4) +336 FORMAT(A8,3I4,20E12.4) +C ENDIF IF(L.EQ.0.OR.(L.GE.NU(NY,NX).AND.L.LT.NL(NY,NX)))THEN C 2.AND.CDPTH(L,NY,NX).LE.CDPTH(NU(NY,NX)-1,NY,NX)+0.60)THEN IF(L.EQ.0)THEN @@ -2754,7 +2765,13 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) FOSCXS=0.0 ENDIF ELSE - LL=L+1 + DO 1100 LN=L+1,NL(NY,NX) + IF(VOLX(LN,NY,NX).GT.ZEROS(NY,NX))THEN + LL=LN + GO TO 1101 + ENDIF +1100 CONTINUE +1101 CONTINUE OSCXD=(ORGR(L,NY,NX)*VOLT(LL,NY,NX)-ORGR(LL,NY,NX)*VOLT(L,NY,NX)) 2/(VOLT(L,NY,NX)+VOLT(LL,NY,NX)) IF(OSCXD.GT.0.0.AND.ORGR(L,NY,NX).GT.ZEROS(NY,NX))THEN @@ -2764,12 +2781,17 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) ELSE FOSCXD=0.0 ENDIF + IF(VOLT(L,NY,NX).GT.ZEROS(NY,NX))THEN FOSCXS=FOSCZL*FOSCXD*TFNX*TOMA/VOLT(L,NY,NX) + ELSE + FOSCXS=0.0 ENDIF -C IF(L.EQ.3.AND.K.EQ.2)THEN -C WRITE(*,1115)'MIX',I,J,L,LL,FOSCXS,FOSCZ0,FOSCZL,OSCXD,TOMA + ENDIF +C IF(I.GT.190.AND.NX.EQ.1)THEN +C WRITE(*,1115)'MIX',I,J,NX,NY,L,LL,FOSCXS,FOSCZ0,FOSCZL,OSCXD,TOMA C 2,TFNX,ORGR(L,NY,NX),VOLT(LL,NY,NX),ORGR(LL,NY,NX),VOLT(L,NY,NX) -1115 FORMAT(A8,4I4,20E12.4) +C 3,TKS(L,NY,NX),(OHC(K,L,NY,NX),K=0,4),(OHA(K,L,NY,NX),K=0,4) +1115 FORMAT(A8,6I4,30E12.4) C ENDIF IF(FOSCXS.NE.0.0)THEN DO 7971 K=1,2 @@ -2897,6 +2919,25 @@ SUBROUTINE nitro(I,J,NHW,NHE,NVN,NVS) 2123 FORMAT(A8,5I4,12E15.4) C ENDIF ENDIF + ELSE + RCO2O(L,NY,NX)=0.0 + RCH4O(L,NY,NX)=0.0 + RH2GO(L,NY,NX)=0.0 + RUPOXO(L,NY,NX)=0.0 + RN2G(L,NY,NX)=0.0 + RN2O(L,NY,NX)=0.0 + XNH4S(L,NY,NX)=0.0 + XNO3S(L,NY,NX)=0.0 + XNO2S(L,NY,NX)=0.0 + XH2PS(L,NY,NX)=0.0 + XH1PS(L,NY,NX)=0.0 + XNH4B(L,NY,NX)=0.0 + XNO3B(L,NY,NX)=0.0 + XNO2B(L,NY,NX)=0.0 + XH2BS(L,NY,NX)=0.0 + XH1BS(L,NY,NX)=0.0 + XN2GS(L,NY,NX)=0.0 + ENDIF 998 CONTINUE C WRITE(20,3434)'RN2O',IYRC,I,J,(RN2O(L,NY,NX),L=0,NL(NY,NX)) 3434 FORMAT(A8,3I4,20E12.4) diff --git a/f77src/outpd.f b/f77src/outpd.f old mode 100755 new mode 100644 diff --git a/f77src/outph.f b/f77src/outph.f old mode 100755 new mode 100644 diff --git a/f77src/outsd.f b/f77src/outsd.f old mode 100755 new mode 100644 index 27f1100..2c137c0 --- a/f77src/outsd.f +++ b/f77src/outsd.f @@ -185,7 +185,7 @@ SUBROUTINE outsd(I,NT,NE,NAX,NDX,NTX,NEX,NHW,NHE,NVN,NVS) IF(K.EQ.45)HEAD(M)=PSISM(11,NY,NX)+PSISO(11,NY,NX) IF(K.EQ.46)HEAD(M)=PSISM(12,NY,NX)+PSISO(12,NY,NX) IF(K.EQ.47)HEAD(M)=PSISM(15,NY,NX)+PSISO(15,NY,NX) - IF(K.EQ.48)HEAD(M)=PSISM(0,NY,NX) + IF(K.EQ.48)HEAD(M)=-CDPTH(NU(NY,NX)-1,NY,NX) 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)) ENDIF diff --git a/f77src/outsh.f b/f77src/outsh.f old mode 100755 new mode 100644 diff --git a/f77src/parameters.h b/f77src/parameters.h old mode 100755 new mode 100644 diff --git a/f77src/readi.f b/f77src/readi.f old mode 100755 new mode 100644 index 24d6504..d409d86 --- a/f77src/readi.f +++ b/f77src/readi.f @@ -139,6 +139,7 @@ SUBROUTINE readi(NA,ND,NT,NE,NAX,NDX,NTX,NEX,NF,NFX,NTZ 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) + NUI(NY,NX)=NU(NY,NX) NK(NY,NX)=NJ(NY,NX)+1 NM(NY,NX)=NJ(NY,NX)+NL1 NL(NY,NX)=NM(NY,NX)+NL2 @@ -146,7 +147,7 @@ SUBROUTINE readi(NA,ND,NT,NE,NAX,NDX,NTX,NEX,NF,NFX,NTZ 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)) + READ(9,*)(BKDX(L,NY,NX),L=NU(NY,NX),NM(NY,NX)) C C HYDROLOGIC PROPERTIES C @@ -232,19 +233,18 @@ SUBROUTINE readi(NA,ND,NT,NE,NAX,NDX,NTX,NEX,NF,NFX,NTZ 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 + IF(BKDX(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) + BKDX(L,NY,NX)=BKDX(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) @@ -257,10 +257,10 @@ SUBROUTINE readi(NA,ND,NT,NE,NAX,NDX,NTX,NEX,NF,NFX,NTZ 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) + CORGC(L,NY,NX)=1.00*CORGC(L+1,NY,NX) + CORGR(L,NY,NX)=1.00*CORGR(L+1,NY,NX) + CORGN(L,NY,NX)=1.00*CORGN(L+1,NY,NX) + CORGP(L,NY,NX)=1.00*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) @@ -309,7 +309,7 @@ SUBROUTINE readi(NA,ND,NT,NE,NAX,NDX,NTX,NEX,NF,NFX,NTZ 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) + BKDX(L,NY,NX)=BKDX(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) @@ -323,10 +323,10 @@ SUBROUTINE readi(NA,ND,NT,NE,NAX,NDX,NTX,NEX,NF,NFX,NTZ CEC(L,NY,NX)=CEC(L-1,NY,NX) AEC(L,NY,NX)=AEC(L-1,NY,NX) C IF(IPRC(NY,NX).EQ.0)THEN - CORGC(L,NY,NX)=0.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) + 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) @@ -379,9 +379,7 @@ SUBROUTINE readi(NA,ND,NT,NE,NAX,NDX,NTX,NEX,NF,NFX,NTZ C DO 28 L=1,NL(NY,NX) FMPR(L,NY,NX)=(1.0-ROCK(L,NY,NX))*(1.0-FHOL(L,NY,NX)) - IF(FHOL(L,NY,NX).GT.0.0)THEN - BKDS(L,NY,NX)=BKDS(L,NY,NX)/(1.0-FHOL(L,NY,NX)) - ENDIF + BKDS(L,NY,NX)=BKDX(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) diff --git a/f77src/readq.f b/f77src/readq.f old mode 100755 new mode 100644 diff --git a/f77src/reads.f b/f77src/reads.f old mode 100755 new mode 100644 index 59f79e3..5aa341d --- a/f77src/reads.f +++ b/f77src/reads.f @@ -622,7 +622,7 @@ SUBROUTINE reads(NA,ND,NT,NE,NAX,NDX,NTX,NEX,NF,NFX,NTZ DO 120 J=1,24 RRIG(J,I,NY,NX)=0.0 120 CONTINUE - PHQ(I,NY,NX)=0.0 + PHQ(I,NY,NX)=7.0 CN4Q(I,NY,NX)=0.0 CNOQ(I,NY,NX)=0.0 CPOQ(I,NY,NX)=0.0 diff --git a/f77src/redist.f b/f77src/redist.f old mode 100755 new mode 100644 index a2b6e54..5056c16 --- a/f77src/redist.f +++ b/f77src/redist.f @@ -6,14 +6,21 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) C include "parameters.h" include "blkc.h" + include "blk1n.h" + include "blk1p.h" + include "blk1cr.h" include "blk2a.h" include "blk2b.h" include "blk2c.h" + include "blk3.h" include "blk5.h" include "blk8a.h" include "blk8b.h" + include "blk9b.h" include "blk11a.h" include "blk11b.h" + include "blk12a.h" + include "blk12b.h" include "blk13a.h" include "blk13b.h" include "blk13c.h" @@ -151,8 +158,8 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 8,TOHGN(0:2),TOHGP(0:2), TOHGA(0:2),TOQGA(0:2),TOQHA(0:2) 9,THGQRS(JY,JX),THGFHS(JZ,JY,JX),THGFLG(JZ,JY,JX),THGFLS(JZ,JY,JX) 1,OMCL(0:JZ,JY,JX),OMNL(0:JZ,JY,JX),EFIRE(2,21:22) - 2,ONL(4,0:4),OPL(4,0:4) - PARAMETER (DNUMN=0.001,DNUMX=0.025) + 2,ONL(4,0:4),OPL(4,0:4),DDLYR(3),DDLYX(3),IFLGL(3) + 3,DVOLW(JZ,JY,JX),DVOLI(JZ,JY,JX) DATA SG/0.0/ DATA EFIRE/1.0,1.0,0.917,0.167/ TFLWT=0.0 @@ -185,6 +192,9 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) ZNAW(NY,NX)=ZNAW(NY,NX)+XNABLS(NY,NX) ZKAW(NY,NX)=ZKAW(NY,NX)+XKABLS(NY,NX) ZOHW(NY,NX)=ZOHW(NY,NX)+XOHBLS(NY,NX) +C WRITE(*,444)'ZOHW',I,J,NX,NY,ZOHW(NY,NX) +C 2,XOHBLS(NY,NX),TQSOH(NY,NX) +444 FORMAT(A8,4I4,12E12.4) ZSO4W(NY,NX)=ZSO4W(NY,NX)+XSOBLS(NY,NX) ZCLW(NY,NX)=ZCLW(NY,NX)+XCLBLS(NY,NX) ZCO3W(NY,NX)=ZCO3W(NY,NX)+XC3BLS(NY,NX) @@ -263,7 +273,8 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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) + ENGYW=VHCPW(NY,NX)*TKW(NY,NX) + HEATSO=HEATSO+ENGYW 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) @@ -343,9 +354,9 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) C IF(BKDS(NU(NY,NX),NY,NX).EQ.0.0.AND.ORGC(0,NY,NX).GT.0.0)THEN OSGX=ORGC(0,NY,NX) - RC=0.0 - RN=0.0 - RP=0.0 + DC=0.0 + DN=0.0 + DP=0.0 DO 1970 K=0,5 IF(K.NE.3.AND.K.NE.4)THEN C @@ -359,9 +370,9 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 2+OMN(M,N,K,0,NY,NX) OMP(M,N,K,NW(NY,NX),NY,NX)=OMP(M,N,K,NW(NY,NX),NY,NX) 2+OMP(M,N,K,0,NY,NX) - RC=RC+OMC(M,N,K,0,NY,NX) - RN=RN+OMN(M,N,K,0,NY,NX) - RP=RP+OMP(M,N,K,0,NY,NX) + DC=DC+OMC(M,N,K,0,NY,NX) + DN=DN+OMN(M,N,K,0,NY,NX) + DP=DP+OMP(M,N,K,0,NY,NX) OMC(M,N,K,0,NY,NX)=0.0 OMN(M,N,K,0,NY,NX)=0.0 OMP(M,N,K,0,NY,NX)=0.0 @@ -376,9 +387,9 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) ORC(M,K,NW(NY,NX),NY,NX)=ORC(M,K,NW(NY,NX),NY,NX)+ORC(M,K,0,NY,NX) ORN(M,K,NW(NY,NX),NY,NX)=ORN(M,K,NW(NY,NX),NY,NX)+ORN(M,K,0,NY,NX) ORP(M,K,NW(NY,NX),NY,NX)=ORP(M,K,NW(NY,NX),NY,NX)+ORP(M,K,0,NY,NX) - RC=RC+ORC(M,K,0,NY,NX) - RN=RN+ORN(M,K,0,NY,NX) - RP=RP+ORP(M,K,0,NY,NX) + DC=DC+ORC(M,K,0,NY,NX) + DN=DN+ORN(M,K,0,NY,NX) + DP=DP+ORP(M,K,0,NY,NX) ORC(M,K,0,NY,NX)=0.0 ORN(M,K,0,NY,NX)=0.0 ORP(M,K,0,NY,NX)=0.0 @@ -390,9 +401,9 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) OQN(K,NW(NY,NX),NY,NX)=OQN(K,NW(NY,NX),NY,NX)+OQN(K,0,NY,NX) OQP(K,NW(NY,NX),NY,NX)=OQP(K,NW(NY,NX),NY,NX)+OQP(K,0,NY,NX) OQA(K,NW(NY,NX),NY,NX)=OQA(K,NW(NY,NX),NY,NX)+OQA(K,0,NY,NX) - RC=RC+OQC(K,0,NY,NX)+OQA(K,0,NY,NX) - RN=RN+OQN(K,0,NY,NX) - RP=RP+OQP(K,0,NY,NX) + DC=DC+OQC(K,0,NY,NX)+OQA(K,0,NY,NX) + DN=DN+OQN(K,0,NY,NX) + DP=DP+OQP(K,0,NY,NX) OQC(K,0,NY,NX)=0.0 OQN(K,0,NY,NX)=0.0 OQP(K,0,NY,NX)=0.0 @@ -401,9 +412,9 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) OQNH(K,NW(NY,NX),NY,NX)=OQNH(K,NW(NY,NX),NY,NX)+OQNH(K,0,NY,NX) OQPH(K,NW(NY,NX),NY,NX)=OQPH(K,NW(NY,NX),NY,NX)+OQPH(K,0,NY,NX) OQAH(K,NW(NY,NX),NY,NX)=OQAH(K,NW(NY,NX),NY,NX)+OQAH(K,0,NY,NX) - RC=RC+OQCH(K,0,NY,NX)+OQAH(K,0,NY,NX) - RN=RN+OQNH(K,0,NY,NX) - RP=RP+OQPH(K,0,NY,NX) + DC=DC+OQCH(K,0,NY,NX)+OQAH(K,0,NY,NX) + DN=DN+OQNH(K,0,NY,NX) + DP=DP+OQPH(K,0,NY,NX) OQCH(K,0,NY,NX)=0.0 OQNH(K,0,NY,NX)=0.0 OQPH(K,0,NY,NX)=0.0 @@ -415,9 +426,9 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) OHN(K,NW(NY,NX),NY,NX)=OHN(K,NW(NY,NX),NY,NX)+OHN(K,0,NY,NX) OHP(K,NW(NY,NX),NY,NX)=OHP(K,NW(NY,NX),NY,NX)+OHP(K,0,NY,NX) OHA(K,NW(NY,NX),NY,NX)=OHA(K,NW(NY,NX),NY,NX)+OHA(K,0,NY,NX) - RC=RC+OHC(K,0,NY,NX)+OHA(K,0,NY,NX) - RN=RN+OHN(K,0,NY,NX) - RP=RP+OHP(K,0,NY,NX) + DC=DC+OHC(K,0,NY,NX)+OHA(K,0,NY,NX) + DN=DN+OHN(K,0,NY,NX) + DP=DP+OHP(K,0,NY,NX) OHC(K,0,NY,NX)=0.0 OHN(K,0,NY,NX)=0.0 OHP(K,0,NY,NX)=0.0 @@ -430,69 +441,24 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) OSA(M,K,NW(NY,NX),NY,NX)=OSA(M,K,NW(NY,NX),NY,NX)+OSA(M,K,0,NY,NX) OSN(M,K,NW(NY,NX),NY,NX)=OSN(M,K,NW(NY,NX),NY,NX)+OSN(M,K,0,NY,NX) OSP(M,K,NW(NY,NX),NY,NX)=OSP(M,K,NW(NY,NX),NY,NX)+OSP(M,K,0,NY,NX) - RC=RC+OSC(M,K,0,NY,NX) - RN=RN+OSN(M,K,0,NY,NX) - RP=RP+OSP(M,K,0,NY,NX) + DC=DC+OSC(M,K,0,NY,NX) + DN=DN+OSN(M,K,0,NY,NX) + DP=DP+OSP(M,K,0,NY,NX) OSC(M,K,0,NY,NX)=0.0 OSA(M,K,0,NY,NX)=0.0 OSN(M,K,0,NY,NX)=0.0 OSP(M,K,0,NY,NX)=0.0 1930 CONTINUE 1900 CONTINUE - TLRSDC=TLRSDC-RC - TLRSDN=TLRSDN-RN - TLRSDP=TLRSDP-RP - URSDC(NY,NX)=URSDC(NY,NX)-RC - URSDN(NY,NX)=URSDN(NY,NX)-RN - URSDP(NY,NX)=URSDP(NY,NX)-RP + TLRSDC=TLRSDC-DC + TLRSDN=TLRSDN-DN + TLRSDP=TLRSDP-DP + URSDC(NY,NX)=URSDC(NY,NX)-DC + URSDN(NY,NX)=URSDN(NY,NX)-DN + URSDP(NY,NX)=URSDP(NY,NX)-DP ORGC(0,NY,NX)=0.0 ORGN(0,NY,NX)=0.0 ORGR(0,NY,NX)=0.0 -C -C ADD RESIDUE SOLUTES TO SUBSURFACE SEDIMENT BELOW A POND SURFACE -C -C CO2S(NW(NY,NX),NY,NX)=CO2S(NW(NY,NX),NY,NX)+CO2S(0,NY,NX) -C CH4S(NW(NY,NX),NY,NX)=CH4S(NW(NY,NX),NY,NX)+CH4S(0,NY,NX) -C OXYS(NW(NY,NX),NY,NX)=OXYS(NW(NY,NX),NY,NX)+OXYS(0,NY,NX) -C Z2GS(NW(NY,NX),NY,NX)=Z2GS(NW(NY,NX),NY,NX)+Z2GS(0,NY,NX) -C Z2OS(NW(NY,NX),NY,NX)=Z2OS(NW(NY,NX),NY,NX)+Z2OS(0,NY,NX) -C H2GS(NW(NY,NX),NY,NX)=H2GS(NW(NY,NX),NY,NX)+H2GS(0,NY,NX) -C ZNH4S(NW(NY,NX),NY,NX)=ZNH4S(NW(NY,NX),NY,NX)+ZNH4S(0,NY,NX) -C ZNH3S(NW(NY,NX),NY,NX)=ZNH3S(NW(NY,NX),NY,NX)+ZNH3S(0,NY,NX) -C ZNO3S(NW(NY,NX),NY,NX)=ZNO3S(NW(NY,NX),NY,NX)+ZNO3S(0,NY,NX) -C H1PO4(NW(NY,NX),NY,NX)=H1PO4(NW(NY,NX),NY,NX)+H1PO4(0,NY,NX) -C H2PO4(NW(NY,NX),NY,NX)=H2PO4(NW(NY,NX),NY,NX)+H2PO4(0,NY,NX) -C ZNO2S(NW(NY,NX),NY,NX)=ZNO2S(NW(NY,NX),NY,NX)+ZNO2S(0,NY,NX) -C CS=CO2S(0,NY,NX)+CH4S(0,NY,NX) -C TLCO2G=TLCO2G-CS -C UCO2S(NY,NX)=UCO2S(NY,NX)-CS -C OS=OXYS(0,NY,NX) -C OXYGSO=OXYGSO-OS -C ZG=Z2GS(0,NY,NX)+Z2OS(0,NY,NX) -C TLN2G=TLN2G-ZG -C ZSH=ZNH4S(0,NY,NX)+ZNH3S(0,NY,NX) -C ZX=14.0*XN4(0,NY,NX) -C TLNH4=TLNH4-ZS-ZX -C UNH4(NY,NX)=UNH4(NY,NX)-ZS-ZX -C ZNO=ZNO3S(0,NY,NX)+ZNO2S(0,NY,NX) -C TLNO3=TLNO3-ZNO -C UNO3(NY,NX)=UNO3(NY,NX)-ZNO -C PS=H1PO4(0,NY,NX)+H2PO4(0,NY,NX) -C PX=31.0*(XH1P(0,NY,NX)+XH2P(0,NY,NX)) -C TLPO4=TLPO4-P4 -C UPO4(NY,NX)=UPO4(NY,NX)-PX -C CO2S(0,NY,NX)=0.0 -C CH4S(0,NY,NX)=0.0 -C OXYS(0,NY,NX)=0.0 -C Z2GS(0,NY,NX)=0.0 -C Z2OS(0,NY,NX)=0.0 -C H2GS(0,NY,NX)=0.0 -C ZNH4S(0,NY,NX)=0.0 -C ZNH3S(0,NY,NX)=0.0 -C ZNO3S(0,NY,NX)=0.0 -C H1PO4(0,NY,NX)=0.0 -C H2PO4(0,NY,NX)=0.0 -C ZNO2S(0,NY,NX)=0.0 ENDIF C C RUNOFF AND SUBSURFACE BOUNDARY FLUXES @@ -647,7 +613,7 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) C SURFACE FLUX ELECTRICAL CONDUCTIVITY C WX=QR(N,N5,N4) - IF(WX.NE.0.0)THEN + IF(ABS(WX).GT.ZEROS(N5,N4))THEN ECHY=0.337*AMAX1(0.0,XQRHY(N,N5,N4)/WX) ECOH=0.192*AMAX1(0.0,XQROH(N,N5,N4)/WX) ECAL=0.056*AMAX1(0.0,XQRAL(N,N5,N4)*3.0/WX) @@ -940,7 +906,7 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) C SUBSURFACE FLUX ELECTRICAL CONDUCTIVITY C WX=FLW(N,N6,N5,N4)+FLWH(N,N6,N5,N4) - IF(WX.NE.0.0)THEN + IF(ABS(WX).GT.ZEROS(NY,NX))THEN ECHY=0.337*AMAX1(0.0,(XHYFLS(N,N6,N5,N4) 2+XHYFHS(N,N6,N5,N4))/WX) ECOH=0.192*AMAX1(0.0,(XOHFLS(N,N6,N5,N4) @@ -1210,13 +1176,13 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) C WRITE(*,5431)'LG',I,J,NX,NY,L,LG,LX,THETP(L,NY,NX),THETX C 2,VOLP(L,NY,NX),TKS(L,NY,NX),VTGAS,VTATM 5431 FORMAT(A8,7I4,12E12.4) - TTHAW(L,NY,NX)=0.0 - TTHAWH(L,NY,NX)=0.0 - THTHAW(L,NY,NX)=0.0 TFLW(L,NY,NX)=0.0 TFLWX(L,NY,NX)=0.0 TFLWH(L,NY,NX)=0.0 THFLW(L,NY,NX)=0.0 + TTHAW(L,NY,NX)=0.0 + TTHAWH(L,NY,NX)=0.0 + THTHAW(L,NY,NX)=0.0 DO 8595 K=0,4 TOCFLS(K,L,NY,NX)=0.0 TONFLS(K,L,NY,NX)=0.0 @@ -1397,6 +1363,9 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) TQW(N2,N1)=TQW(N2,N1)+QW(N,N2,N1)-QW(N,N5,N4) TQI(N2,N1)=TQI(N2,N1)+QI(N,N2,N1)-QI(N,N5,N4) THQS(N2,N1)=THQS(N2,N1)+HQS(N,N2,N1)-HQS(N,N5,N4) +C WRITE(*,6631)'TQR',I,J,N,N1,N2,N4,N5 +C 2,TQR(N2,N1),QR(N,N2,N1),QR(N,N5,N4) +6631 FORMAT(A8,7I4,12E12.4) DO 8590 K=0,2 TOCQRS(K,N2,N1)=TOCQRS(K,N2,N1)+XOCQRS(K,N,N2,N1) 2-XOCQRS(K,N,N5,N4) @@ -1612,13 +1581,38 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) C GRID CELLS C IF(NCN(N2,N1).NE.3.OR.N.EQ.3)THEN + DO 1200 LL=N6,NL(N5,N4) + IF(VOLX(LL,N2,N1).GT.ZEROS(N2,N1))THEN + N6=LL + GO TO 1201 + ENDIF +1200 CONTINUE +1201 CONTINUE + IF(VOLX(N3,N2,N1).GT.ZEROS(N2,N1))THEN + IF(N3.EQ.NU(N2,N1).AND.N.EQ.3)THEN + TFLW(N3,N2,N1)=TFLW(N3,N2,N1)+FLW(N,N3,N2,N1)-FLWNU(N5,N4) + TFLWX(N3,N2,N1)=TFLWX(N3,N2,N1)+FLWX(N,N3,N2,N1)-FLWXNU(N5,N4) + TFLWH(N3,N2,N1)=TFLWH(N3,N2,N1)+FLWH(N,N3,N2,N1)-FLWHNU(N5,N4) + THFLW(N3,N2,N1)=THFLW(N3,N2,N1)+HFLW(N,N3,N2,N1)-HFLWNU(N5,N4) + ELSE + TFLW(N3,N2,N1)=TFLW(N3,N2,N1)+FLW(N,N3,N2,N1)-FLW(N,N6,N5,N4) + TFLWX(N3,N2,N1)=TFLWX(N3,N2,N1)+FLWX(N,N3,N2,N1) + 2-FLWX(N,N6,N5,N4) + TFLWH(N3,N2,N1)=TFLWH(N3,N2,N1)+FLWH(N,N3,N2,N1) + 2-FLWH(N,N6,N5,N4) + THFLW(N3,N2,N1)=THFLW(N3,N2,N1)+HFLW(N,N3,N2,N1) + 2-HFLW(N,N6,N5,N4) + ENDIF TTHAW(N3,N2,N1)=TTHAW(N3,N2,N1)+THAW(N,N3,N2,N1) TTHAWH(N3,N2,N1)=TTHAWH(N3,N2,N1)+THAWH(N,N3,N2,N1) THTHAW(N3,N2,N1)=THTHAW(N3,N2,N1)+HTHAW(N,N3,N2,N1) - TFLW(N3,N2,N1)=TFLW(N3,N2,N1)+FLW(N,N3,N2,N1)-FLW(N,N6,N5,N4) - TFLWX(N3,N2,N1)=TFLWX(N3,N2,N1)+FLWX(N,N3,N2,N1)-FLWX(N,N6,N5,N4) - TFLWH(N3,N2,N1)=TFLWH(N3,N2,N1)+FLWH(N,N3,N2,N1)-FLWH(N,N6,N5,N4) - THFLW(N3,N2,N1)=THFLW(N3,N2,N1)+HFLW(N,N3,N2,N1)-HFLW(N,N6,N5,N4) +C IF(NX.EQ.1.AND.L.LE.3)THEN +C WRITE(*,6632)'TFLW',I,J,N,N1,N2,N3,N4,N5,N6,NU(N2,N1) +C 2,TFLW(N3,N2,N1),FLW(N,N3,N2,N1),FLW(N,N6,N5,N4),FLWNU(N5,N4) +C 3,THFLW(N3,N2,N1),HFLW(N,N3,N2,N1),HFLW(N,N6,N5,N4) +C 2,HFLWNU(N5,N4) +6632 FORMAT(A8,10I4,12E12.4) +C ENDIF DO 8585 K=0,4 TOCFLS(K,N3,N2,N1)=TOCFLS(K,N3,N2,N1)+XOCFLS(K,N,N3,N2,N1) 2-XOCFLS(K,N,N6,N5,N4) @@ -1920,6 +1914,168 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 2-XC2BHB(N,N6,N5,N4) TM1BHB(N3,N2,N1)=TM1BHB(N3,N2,N1)+XM1BHB(N,N3,N2,N1) 2-XM1BHB(N,N6,N5,N4) + ENDIF + ELSE + TFLW(N3,N2,N1)=0.0 + TFLWX(N3,N2,N1)=0.0 + TFLWH(N3,N2,N1)=0.0 + THFLW(N3,N2,N1)=0.0 + TTHAW(N3,N2,N1)=0.0 + TTHAWH(N3,N2,N1)=0.0 + THTHAW(N3,N2,N1)=0.0 + DO 8596 K=0,4 + TOCFLS(K,N3,N2,N1)=0.0 + TONFLS(K,N3,N2,N1)=0.0 + TOPFLS(K,N3,N2,N1)=0.0 + TOAFLS(K,N3,N2,N1)=0.0 + TOCFHS(K,N3,N2,N1)=0.0 + TONFHS(K,N3,N2,N1)=0.0 + TOPFHS(K,N3,N2,N1)=0.0 + TOAFHS(K,N3,N2,N1)=0.0 +8596 CONTINUE + TCOFLS(N3,N2,N1)=0.0 + TCHFLS(N3,N2,N1)=0.0 + TOXFLS(N3,N2,N1)=0.0 + TNGFLS(N3,N2,N1)=0.0 + TN2FLS(N3,N2,N1)=0.0 + THGFLS(N3,N2,N1)=0.0 + TN4FLS(N3,N2,N1)=0.0 + TN3FLS(N3,N2,N1)=0.0 + TNOFLS(N3,N2,N1)=0.0 + TNXFLS(N3,N2,N1)=0.0 + TP1FLS(N3,N2,N1)=0.0 + TPOFLS(N3,N2,N1)=0.0 + TN4FLB(N3,N2,N1)=0.0 + TN3FLB(N3,N2,N1)=0.0 + TNOFLB(N3,N2,N1)=0.0 + TNXFLB(N3,N2,N1)=0.0 + TH1BFB(N3,N2,N1)=0.0 + TH2BFB(N3,N2,N1)=0.0 + TCOFHS(N3,N2,N1)=0.0 + TCHFHS(N3,N2,N1)=0.0 + TOXFHS(N3,N2,N1)=0.0 + TNGFHS(N3,N2,N1)=0.0 + TN2FHS(N3,N2,N1)=0.0 + THGFHS(N3,N2,N1)=0.0 + TN4FHS(N3,N2,N1)=0.0 + TN3FHS(N3,N2,N1)=0.0 + TNOFHS(N3,N2,N1)=0.0 + TNXFHS(N3,N2,N1)=0.0 + TP1FHS(N3,N2,N1)=0.0 + TPOFHS(N3,N2,N1)=0.0 + TN4FHB(N3,N2,N1)=0.0 + TN3FHB(N3,N2,N1)=0.0 + TNOFHB(N3,N2,N1)=0.0 + TNXFHB(N3,N2,N1)=0.0 + TH1BHB(N3,N2,N1)=0.0 + TH2BHB(N3,N2,N1)=0.0 + TCOFLG(N3,N2,N1)=0.0 + TCHFLG(N3,N2,N1)=0.0 + TOXFLG(N3,N2,N1)=0.0 + TNGFLG(N3,N2,N1)=0.0 + TN2FLG(N3,N2,N1)=0.0 + TNHFLG(N3,N2,N1)=0.0 + THGFLG(N3,N2,N1)=0.0 + IF(ISALT(N2,N1).NE.0)THEN + TALFLS(N3,N2,N1)=0.0 + TFEFLS(N3,N2,N1)=0.0 + THYFLS(N3,N2,N1)=0.0 + TCAFLS(N3,N2,N1)=0.0 + TMGFLS(N3,N2,N1)=0.0 + TNAFLS(N3,N2,N1)=0.0 + TKAFLS(N3,N2,N1)=0.0 + TOHFLS(N3,N2,N1)=0.0 + TSOFLS(N3,N2,N1)=0.0 + TCLFLS(N3,N2,N1)=0.0 + TC3FLS(N3,N2,N1)=0.0 + THCFLS(N3,N2,N1)=0.0 + TAL1FS(N3,N2,N1)=0.0 + TAL2FS(N3,N2,N1)=0.0 + TAL3FS(N3,N2,N1)=0.0 + TAL4FS(N3,N2,N1)=0.0 + TALSFS(N3,N2,N1)=0.0 + TFE1FS(N3,N2,N1)=0.0 + TFE2FS(N3,N2,N1)=0.0 + TFE3FS(N3,N2,N1)=0.0 + TFE4FS(N3,N2,N1)=0.0 + TFESFS(N3,N2,N1)=0.0 + TCAOFS(N3,N2,N1)=0.0 + TCACFS(N3,N2,N1)=0.0 + TCAHFS(N3,N2,N1)=0.0 + TCASFS(N3,N2,N1)=0.0 + TMGOFS(N3,N2,N1)=0.0 + TMGCFS(N3,N2,N1)=0.0 + TMGHFS(N3,N2,N1)=0.0 + TMGSFS(N3,N2,N1)=0.0 + TNACFS(N3,N2,N1)=0.0 + TNASFS(N3,N2,N1)=0.0 + TKASFS(N3,N2,N1)=0.0 + TH0PFS(N3,N2,N1)=0.0 + TH3PFS(N3,N2,N1)=0.0 + TF1PFS(N3,N2,N1)=0.0 + TF2PFS(N3,N2,N1)=0.0 + TC0PFS(N3,N2,N1)=0.0 + TC1PFS(N3,N2,N1)=0.0 + TC2PFS(N3,N2,N1)=0.0 + TM1PFS(N3,N2,N1)=0.0 + TH0BFB(N3,N2,N1)=0.0 + TH3BFB(N3,N2,N1)=0.0 + TF1BFB(N3,N2,N1)=0.0 + TF2BFB(N3,N2,N1)=0.0 + TC0BFB(N3,N2,N1)=0.0 + TC1BFB(N3,N2,N1)=0.0 + TC2BFB(N3,N2,N1)=0.0 + TM1BFB(N3,N2,N1)=0.0 + TALFHS(N3,N2,N1)=0.0 + TFEFHS(N3,N2,N1)=0.0 + THYFHS(N3,N2,N1)=0.0 + TCAFHS(N3,N2,N1)=0.0 + TMGFHS(N3,N2,N1)=0.0 + TNAFHS(N3,N2,N1)=0.0 + TKAFHS(N3,N2,N1)=0.0 + TOHFHS(N3,N2,N1)=0.0 + TSOFHS(N3,N2,N1)=0.0 + TCLFHS(N3,N2,N1)=0.0 + TC3FHS(N3,N2,N1)=0.0 + THCFHS(N3,N2,N1)=0.0 + TAL1HS(N3,N2,N1)=0.0 + TAL2HS(N3,N2,N1)=0.0 + TAL3HS(N3,N2,N1)=0.0 + TAL4HS(N3,N2,N1)=0.0 + TALSHS(N3,N2,N1)=0.0 + TFE1HS(N3,N2,N1)=0.0 + TFE2HS(N3,N2,N1)=0.0 + TFE3HS(N3,N2,N1)=0.0 + TFE4HS(N3,N2,N1)=0.0 + TFESHS(N3,N2,N1)=0.0 + TCAOHS(N3,N2,N1)=0.0 + TCACHS(N3,N2,N1)=0.0 + TCAHHS(N3,N2,N1)=0.0 + TCASHS(N3,N2,N1)=0.0 + TMGOHS(N3,N2,N1)=0.0 + TMGCHS(N3,N2,N1)=0.0 + TMGHHS(N3,N2,N1)=0.0 + TMGSHS(N3,N2,N1)=0.0 + TNACHS(N3,N2,N1)=0.0 + TNASHS(N3,N2,N1)=0.0 + TKASHS(N3,N2,N1)=0.0 + TH0PHS(N3,N2,N1)=0.0 + TH3PHS(N3,N2,N1)=0.0 + TF1PHS(N3,N2,N1)=0.0 + TF2PHS(N3,N2,N1)=0.0 + TC0PHS(N3,N2,N1)=0.0 + TC1PHS(N3,N2,N1)=0.0 + TC2PHS(N3,N2,N1)=0.0 + TM1PHS(N3,N2,N1)=0.0 + TH0BHB(N3,N2,N1)=0.0 + TH3BHB(N3,N2,N1)=0.0 + TF1BHB(N3,N2,N1)=0.0 + TF2BHB(N3,N2,N1)=0.0 + TC0BHB(N3,N2,N1)=0.0 + TC1BHB(N3,N2,N1)=0.0 + TC2BHB(N3,N2,N1)=0.0 + TM1BHB(N3,N2,N1)=0.0 + ENDIF ENDIF ENDIF 8580 CONTINUE @@ -1932,19 +2088,19 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) VOLW(0,NY,NX)=VOLW(0,NY,NX)+FLWR(NY,NX)+THAWR(NY,NX) 2+TQR(NY,NX) VOLI(0,NY,NX)=VOLI(0,NY,NX)-THAWR(NY,NX)/DENSI - ENGYR=VHCPR(NY,NX)*TKS(0,NY,NX)-HFLXD - VHCPR(NY,NX)=2.496E-06*ORGC(0,NY,NX)+4.19*VOLW(0,NY,NX) + ENGYR=VHCP(0,NY,NX)*TKS(0,NY,NX)-HFLXD + VHCP(0,NY,NX)=2.496E-06*ORGC(0,NY,NX)+4.19*VOLW(0,NY,NX) 2+1.9274*VOLI(0,NY,NX) - IF(VHCPR(NY,NX).GT.ZEROS(NY,NX))THEN + IF(VHCP(0,NY,NX).GT.ZEROS(NY,NX))THEN TKS(0,NY,NX)=(ENGYR+HFLWR(NY,NX)+HTHAWR(NY,NX) - 2+THQR(NY,NX))/VHCPR(NY,NX) + 2+THQR(NY,NX))/VHCP(0,NY,NX) ELSE - TKS(0,NY,NX)=TKS(NU(NY,NX),NY,NX) + TKS(0,NY,NX)=TKS(NUM(NY,NX),NY,NX) ENDIF - IF(VHCPR(NY,NX).LT.VHCPRX(NY,NX))THEN - HFLXR=VHCPR(NY,NX)*(TKS(0,NY,NX)-TKS(NU(NY,NX),NY,NX)) + IF(VHCP(0,NY,NX).LT.VHCPRX(NY,NX))THEN + HFLXR=VHCP(0,NY,NX)*(TKS(0,NY,NX)-TKS(NUM(NY,NX),NY,NX)) HEATOU=HEATOU+HFLXR - TKS(0,NY,NX)=TKS(NU(NY,NX),NY,NX) + TKS(0,NY,NX)=TKS(NUM(NY,NX),NY,NX) ENDIF HEATIN=HEATIN+HTHAWR(NY,NX)-HFLXD C UVOLW(NY,NX)=UVOLW(NY,NX)-VOLW(0,NY,NX)-VOLI(0,NY,NX)*DENSI @@ -1968,12 +2124,15 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 2+2.095*TKA(NY,NX)*PRECW(NY,NX) HEATIN=HEATIN+HEATH(NY,NX)+HTHAWW(NY,NX)+THFLXC(NY,NX) HEATOU=HEATOU-4.19*TKA(NY,NX)*PRECU(NY,NX) +C IF(NX.EQ.1)THEN +C WRITE(*,5151)'VOLW0',I,J,NX,NY,VOLW(0,NY,NX) +C 2,VOLI(0,NY,NX),FLWR(NY,NX),THAWR(NY,NX),TQR(NY,NX) C WRITE(*,5151)'TK0',I,J,NX,NY,TKS(0,NY,NX),ENGYR -C 2,HFLWR(NY,NX),HFLXD,HTHAWR(NY,NX),VHCPR(NY,NX),VOLW(0,NY,NX) -C 3,VOLI(0,NY,NX),FLWR(NY,NX),THAWR(NY,NX) -C 3,ORGC(0,NY,NX),VHCPR(NY,NX)*TKS(0,NY,NX),TQR(NY,NX) +C 2,HFLWR(NY,NX),HFLXD,HTHAWR(NY,NX),VHCP(0,NY,NX) +C 3,ORGC(0,NY,NX),VHCP(0,NY,NX)*TKS(0,NY,NX) C 4,THQR(NY,NX),HEATH(NY,NX),HTHAWW(NY,NX),THFLXC(NY,NX),HEATIN 5151 FORMAT(A8,4I4,30F20.6) +C ENDIF C C SURFACE BOUNDARY CO2, CH4 AND DOC FLUXES C @@ -1994,19 +2153,6 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) CO2GIN=CO2GIN+CI+CH TCOU=TCOU+CO+CX TNBP(NY,NX)=TNBP(NY,NX)+CH -C IF(NX.EQ.3.AND.NY.EQ.3)THEN -C WRITE(*,6644)'CO2',I,J,NX,NY,HCO2G(NY,NX),CI,XCODFS(NY,NX) -C 2,XCOFLG(3,NU(NY,NX),NY,NX),TCO2Z(NY,NX) -C 3,(FLQGQ(NY,NX)+FLQRQ(NY,NX))*CCOR(NY,NX) -C 4,(FLQGI(NY,NX)+FLQRI(NY,NX))*CCOQ(NY,NX) -C 5,XCODFG(0,NY,NX),XCODFR(NY,NX),VOLP(0,NY,NX) -C 6,VOLP(NU(NY,NX),NY,NX) -C WRITE(*,6644)'CH4',I,J,NX,NY,CH,XCHDFS(NY,NX) -C 2,XCHFLG(3,NU(NY,NX),NY,NX),TCH4Z(NY,NX),FLQGQ(NY,NX) -C 3,FLQRQ(NY,NX),FLQGI(NY,NX),FLQRI(NY,NX),CCHR(NY,NX),CCHQ(NY,NX) -C 4,XCHDFG(0,NY,NX),XCHDFR(NY,NX),CH4S(NU(NY,NX),NY,NX) -6644 FORMAT(A8,4I4,30E12.4) -C ENDIF C C SURFACE BOUNDARY O2 FLUXES C @@ -2024,7 +2170,7 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) H2GIN=H2GIN+HI HO=RH2GO(0,NY,NX) H2GOU=H2GOU+HO -C IF(J.EQ.14)THEN +C IF(I.EQ.256)THEN C WRITE(*,6646)'UOXYG',I,J,NX,NY,UCO2G(NY,NX),UOXYG(NY,NX),CI,OI C 2,XCODFS(NY,NX),XCOFLG(3,NU(NY,NX),NY,NX),TCO2Z(NY,NX) C 2,(FLQGQ(NY,NX)+FLQRQ(NY,NX))*CCOR(NY,NX) @@ -2075,10 +2221,11 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) HNH3G(NY,NX)=HNH3G(NY,NX)+ZNH3IN UN2GS(NY,NX)=UN2GS(NY,NX)+XN2GS(0,NY,NX) UH2GG(NY,NX)=UH2GG(NY,NX)+HI -C WRITE(*,6644)'HNH3G',I,J,NX,NY,HNH3G(NY,NX),ZNH3IN +C IF(I.EQ.168)THEN +C WRITE(*,6644)'HNH3G',I,J,NX,NY,NU(NY,NX),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 WRITE(*,6644)'ZN2GIN',I,J,NX,NY,NU(NY,NX),ZN2GIN,XNGDFS(NY,NX) C 3,XN2DFS(NY,NX),XN3DFS(NY,NX) C 2,XNBDFS(NY,NX),XNGFLG(3,NU(NY,NX),NY,NX) C 2,XN2FLG(3,NU(NY,NX),NY,NX) @@ -2086,7 +2233,8 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) C 4,(FLQGQ(NY,NX)+FLQRQ(NY,NX))*(CNNR(NY,NX)+CN2R(NY,NX)) C 5,(FLQGI(NY,NX)+FLQRI(NY,NX))*(CNNQ(NY,NX)+CN2Q(NY,NX)) C 6,XN2DFG(0,NY,NX)+XNGDFG(0,NY,NX),XN3DFG(0,NY,NX) -C 7,XNGDFR(NY,NX)+XN2DFR(NY,NX),XN3DFR(NY,NX) +C 7,XNGDFR(NY,NX)+XN2DFR(NY,NX),XN3DFR(NY,NX) +C ENDIF C C SURFACE BOUNDARY PO4 AND DOP FLUXES C @@ -2248,7 +2396,20 @@ 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 IF(NX.EQ.3.AND.NY.EQ.3)THEN +C WRITE(*,6644)'CO2',I,J,NX,NY,NU(NY,NX) +C 2,CO2S(NU(NY,NX),NY,NX),HCO2G(NY,NX) +C 2,CI,XCODFS(NY,NX),XCOFLG(3,NU(NY,NX),NY,NX),TCO2Z(NY,NX) +C 3,(FLQGQ(NY,NX)+FLQRQ(NY,NX))*CCOR(NY,NX) +C 4,(FLQGI(NY,NX)+FLQRI(NY,NX))*CCOQ(NY,NX) +C 5,XCODFG(0,NY,NX),XCODFR(NY,NX),VOLP(0,NY,NX) +C 6,VOLP(NU(NY,NX),NY,NX) +C WRITE(*,6644)'CH4',I,J,NX,NY,NU(NY,NX),CH,XCHDFS(NY,NX) +C 2,XCHFLG(3,NU(NY,NX),NY,NX),TCH4Z(NY,NX),FLQGQ(NY,NX) +C 3,FLQRQ(NY,NX),FLQGI(NY,NX),FLQRI(NY,NX),CCHR(NY,NX),CCHQ(NY,NX) +C 4,XCHDFG(0,NY,NX),XCHDFR(NY,NX),CH4S(NU(NY,NX),NY,NX) +6644 FORMAT(A8,5I4,30E12.4) +C ENDIFC C SURFACE LITTER ION EXCHANGE AND PRECIPITATION C XN4(0,NY,NX)=XN4(0,NY,NX)+TRXN4(0,NY,NX) @@ -2265,12 +2426,12 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) C C SURFACE LITTER OUTPUTS C -C IF(J.EQ.14)THEN +C IF(J.EQ.14.AND.NX.EQ.1)THEN C WRITE(*,1119)'CO2S0',I,J,NX,NY,CO2S(0,NY,NX),XCODFS(NY,NX) C 2,XCODFR(NY,NX),XCOFLS(3,0,NY,NX),XCODFG(0,NY,NX),RCO2O(0,NY,NX) -C 3,ORGC(0,NY,NX) +C 3,VOLT(0,NY,NX),CVRD(NY,NX) C WRITE(*,1119)'CH4S0',I,J,NX,NY,CH4S(0,NY,NX),XCHDFS(NY,NX) -C 2,XCHDFR(NY,NX),XCHFLS(3,0,NY,NX),RCH4O(0,NY,NX),XCHDFG(0,NY,NX) +C 2,XCHDFR(NY,NX),XCHFLS(3,0,NY,NX),XCHDFG(0,NY,NX),RCH4O(0,NY,NX) C 3,RCH4L(0,NY,NX) C WRITE(*,1119)'OXYS0',I,J,NX,NY,OXYS(0,NY,NX),XOXDFR(NY,NX) C 2,XOXFLS(3,0,NY,NX),XOXDFG(0,NY,NX),RUPOXO(0,NY,NX) @@ -2278,8 +2439,8 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 1119 FORMAT(A8,4I4,12E12.4) C ENDIF C IF(NX.EQ.5)THEN -C WRITE(20,5533)'NH30',I,J,NX,NY,ZNH4S(0,NY,NX),XN4FLW(3,0,NY,NX) -C 2,XNH4S(0,NY,NX),XN3FLW(3,0,NY,NX),TRN4S(0,NY,NX) +C WRITE(*,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),TRXN4(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) @@ -2287,7 +2448,7 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) C 3,XNO2S(0,NY,NX) C WRITE(*,5533)'H2PO40',I,J,NX,NY,H2PO4(0,NY,NX) C 2,XH2PFS(3,0,NY,NX),XH2PS(0,NY,NX),TRH2P(0,NY,NX) -5533 FORMAT(A8,4I4,20F14.7) +5533 FORMAT(A8,4I4,20F12.4) 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) @@ -2309,7 +2470,7 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) OQP(K,0,NY,NX)=OQP(K,0,NY,NX)+TOPQRS(K,NY,NX) OQA(K,0,NY,NX)=OQA(K,0,NY,NX)+TOAQRS(K,NY,NX) C IF(NX.EQ.1.AND.NY.EQ.6)THEN -C WRITE(*,2626)'OQC0',I,J,NX,NY,K,OQC(K,0,NY,NX) +C WRITE(*,2626)'OQCR',I,J,NX,NY,K,OQC(K,0,NY,NX) C 2,TOCQRS(K,NY,NX),OQN(K,0,NY,NX),TONQRS(K,NY,NX) 2626 FORMAT(A8,5I4,20E12.4) C ENDIF @@ -2434,11 +2595,12 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) C SURFACE SEDIMENT TRANSPORT C IF(IERSN(NY,NX).NE.0)THEN - IF(BKDS(NU(NY,NX),NY,NX).GT.ZERO)THEN SED(NY,NX)=SED(NY,NX)+TSEDER(NY,NX) + IF(BKDS(NU(NY,NX),NY,NX).GT.ZERO)THEN DLYR(3,NU(NY,NX),NY,NX)=DLYR(3,NU(NY,NX),NY,NX)+TSEDER(NY,NX) 2/(AREA(3,NU(NY,NX),NY,NX)*BKDS(NU(NY,NX),NY,NX)) - IF(TSEDER(NY,NX).GT.1.0E-06*BKVL(NU(NY,NX),NY,NX))IFLGS(NY,NX)=1 + VOLX(NU(NY,NX),NY,NX)=AREA(3,NU(NY,NX),NY,NX) + 2*DLYR(3,NU(NY,NX),NY,NX)*FMPR(NU(NY,NX),NY,NX) ENDIF C C SOIL MINERAL FRACTIONS @@ -2547,9 +2709,9 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) C C TOTAL C,N,P, SALTS IN SURFACE RESIDUE C - RC=0.0 - RN=0.0 - RP=0.0 + DC=0.0 + DN=0.0 + DP=0.0 DO 6975 K=0,5 RC0(K,NY,NX)=0.0 RA0(K,NY,NX)=0.0 @@ -2563,9 +2725,9 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) C DO 6960 N=1,7 DO 6960 M=1,3 - RC=RC+OMC(M,N,K,0,NY,NX) - RN=RN+OMN(M,N,K,0,NY,NX) - RP=RP+OMP(M,N,K,0,NY,NX) + DC=DC+OMC(M,N,K,0,NY,NX) + DN=DN+OMN(M,N,K,0,NY,NX) + DP=DP+OMP(M,N,K,0,NY,NX) RC0(K,NY,NX)=RC0(K,NY,NX)+OMC(M,N,K,0,NY,NX) RA0(K,NY,NX)=RA0(K,NY,NX)+OMC(M,N,K,0,NY,NX) TOMT(NY,NX)=TOMT(NY,NX)+OMC(M,N,K,0,NY,NX) @@ -2581,19 +2743,19 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) C DO 6900 K=0,2 DO 6940 M=1,2 - RC=RC+ORC(M,K,0,NY,NX) - RN=RN+ORN(M,K,0,NY,NX) - RP=RP+ORP(M,K,0,NY,NX) + DC=DC+ORC(M,K,0,NY,NX) + DN=DN+ORN(M,K,0,NY,NX) + DP=DP+ORP(M,K,0,NY,NX) RC0(K,NY,NX)=RC0(K,NY,NX)+ORC(M,K,0,NY,NX) RA0(K,NY,NX)=RA0(K,NY,NX)+ORC(M,K,0,NY,NX) 6940 CONTINUE C C TOTAL DOC, DON, DOP C - RC=RC+OQC(K,0,NY,NX)+OQCH(K,0,NY,NX)+OHC(K,0,NY,NX) + DC=DC+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) + DN=DN+OQN(K,0,NY,NX)+OQNH(K,0,NY,NX)+OHN(K,0,NY,NX) + DP=DP+OQP(K,0,NY,NX)+OQPH(K,0,NY,NX)+OHP(K,0,NY,NX) RC0(K,NY,NX)=RC0(K,NY,NX)+OQC(K,0,NY,NX)+OQCH(K,0,NY,NX) 2+OHC(K,0,NY,NX)+OQA(K,0,NY,NX)+OQAH(K,0,NY,NX)+OHA(K,0,NY,NX) RA0(K,NY,NX)=RA0(K,NY,NX)+OQC(K,0,NY,NX)+OQCH(K,0,NY,NX) @@ -2602,26 +2764,26 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) C TOTAL PLANT RESIDUE C,N,P C DO 6930 M=1,4 - RC=RC+OSC(M,K,0,NY,NX) - RN=RN+OSN(M,K,0,NY,NX) - RP=RP+OSP(M,K,0,NY,NX) + DC=DC+OSC(M,K,0,NY,NX) + DN=DN+OSN(M,K,0,NY,NX) + DP=DP+OSP(M,K,0,NY,NX) RC0(K,NY,NX)=RC0(K,NY,NX)+OSC(M,K,0,NY,NX) RA0(K,NY,NX)=RA0(K,NY,NX)+OSA(M,K,0,NY,NX) 6930 CONTINUE 6900 CONTINUE - ORGC(0,NY,NX)=RC - ORGN(0,NY,NX)=RN - ORGR(0,NY,NX)=RC - TLRSDC=TLRSDC+RC - URSDC(NY,NX)=URSDC(NY,NX)+RC - TLRSDN=TLRSDN+RN - URSDN(NY,NX)=URSDN(NY,NX)+RN - TLRSDP=TLRSDP+RP - URSDP(NY,NX)=URSDP(NY,NX)+RP + ORGC(0,NY,NX)=DC + ORGN(0,NY,NX)=DN + ORGR(0,NY,NX)=DC + TLRSDC=TLRSDC+DC + URSDC(NY,NX)=URSDC(NY,NX)+DC + TLRSDN=TLRSDN+DN + URSDN(NY,NX)=URSDN(NY,NX)+DN + TLRSDP=TLRSDP+DP + URSDP(NY,NX)=URSDP(NY,NX)+DP 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) + ENGYR=VHCP(0,NY,NX)*TKS(0,NY,NX) HEATSO=HEATSO+TENGYC(NY,NX)+ENGYR CS=CO2S(0,NY,NX)+CH4S(0,NY,NX) TLCO2G=TLCO2G+CS @@ -2637,6 +2799,24 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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 +C IF(I.GT.190.AND.NX.EQ.1)THEN +C DO 4342 K=0,4 +C WRITE(*,4341)'ORGC0',I,J,NX,NY,L,K,ORGC(0,NY,NX),DC +C 2,((OMC(M,N,K,0,NY,NX),M=1,3),N=1,7) +C 3,(ORC(M,K,0,NY,NX),M=1,2),(OSC(M,K,0,NY,NX),M=1,4) +C 4,OQC(K,0,NY,NX),OQCH(K,0,NY,NX),OHC(K,0,NY,NX) +C 2,OQA(K,0,NY,NX),OQAH(K,0,NY,NX),OHA(K,0,NY,NX) +4341 FORMAT(A8,6I4,120E12.4) +4342 CONTINUE +C WRITE(*,5456)'TLCO2G0',I,J,NX,NY,TLCO2G +C 2,CS,CO2S(0,NY,NX),CH4S(0,NY,NX) +C WRITE(*,5456)'TLN2G0',I,J,NX,NY,TLN2G +C 2,ZG,Z2GS(0,NY,NX),Z2OS(0,NY,NX) +C WRITE(*,5456)'TLNH40',I,J,NX,NY,TLNH4 +C 2,Z4S,Z4X,Z4F,XN4(0,NY,NX) +C 2,ZNH4S(0,NY,NX),ZNH3S(0,NY,NX) +5456 FORMAT(A8,4I4,30E16.6) +C ENDIF ZOS=ZNO3S(0,NY,NX)+ZNO2S(0,NY,NX) ZOF=14.0*ZNO3FA(0,NY,NX) TLNO3=TLNO3+ZOS+ZOF @@ -2735,17 +2915,17 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) C IF SNOWPACK OR SURFACE RESIDUE DISAPPEARS C IF(FLWSI(NY,NX).GT.0.0)THEN - VHCP(NU(NY,NX),NY,NX)=VHCM(NU(NY,NX),NY,NX) - 2+4.19*(VOLW(NU(NY,NX),NY,NX)+VOLWH(NU(NY,NX),NY,NX)) - 2+1.9274*(VOLI(NU(NY,NX),NY,NX)+VOLIH(NU(NY,NX),NY,NX)) - VOLI(NU(NY,NX),NY,NX)=VOLI(NU(NY,NX),NY,NX)+FLWSI(NY,NX) - ENGY=VHCP(NU(NY,NX),NY,NX)*TKS(NU(NY,NX),NY,NX) - VHCP(NU(NY,NX),NY,NX)=VHCM(NU(NY,NX),NY,NX) - 2+4.19*(VOLW(NU(NY,NX),NY,NX)+VOLWH(NU(NY,NX),NY,NX)) - 2+1.9274*(VOLI(NU(NY,NX),NY,NX)+VOLIH(NU(NY,NX),NY,NX)) - TKS(NU(NY,NX),NY,NX)=(ENGY+HFLWSI(NY,NX))/VHCP(NU(NY,NX),NY,NX) - ENDIF - VOLWX(NU(NY,NX),NY,NX)=VOLW(NU(NY,NX),NY,NX) + VHCP(NUM(NY,NX),NY,NX)=VHCM(NUM(NY,NX),NY,NX) + 2+4.19*(VOLW(NUM(NY,NX),NY,NX)+VOLWH(NUM(NY,NX),NY,NX)) + 2+1.9274*(VOLI(NUM(NY,NX),NY,NX)+VOLIH(NUM(NY,NX),NY,NX)) + VOLI(NUM(NY,NX),NY,NX)=VOLI(NUM(NY,NX),NY,NX)+FLWSI(NY,NX) + ENGY=VHCP(NUM(NY,NX),NY,NX)*TKS(NUM(NY,NX),NY,NX) + VHCP(NUM(NY,NX),NY,NX)=VHCM(NUM(NY,NX),NY,NX) + 2+4.19*(VOLW(NUM(NY,NX),NY,NX)+VOLWH(NUM(NY,NX),NY,NX)) + 2+1.9274*(VOLI(NUM(NY,NX),NY,NX)+VOLIH(NUM(NY,NX),NY,NX)) + TKS(NUM(NY,NX),NY,NX)=(ENGY+HFLWSI(NY,NX))/VHCP(NUM(NY,NX),NY,NX) + ENDIF + VOLWX(NUM(NY,NX),NY,NX)=VOLW(NUM(NY,NX),NY,NX) TCS(0,NY,NX)=TKS(0,NY,NX)-273.15 TSMX(0,NY,NX)=AMAX1(TSMX(0,NY,NX),TCS(0,NY,NX)) TSMN(0,NY,NX)=AMIN1(TSMN(0,NY,NX),TCS(0,NY,NX)) @@ -2760,9 +2940,9 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 2+1.9274*(VOLI(L,NY,NX)+VOLIH(L,NY,NX)) VOLW1=VOLW(L,NY,NX) VOLW(L,NY,NX)=VOLW(L,NY,NX)+TFLW(L,NY,NX)+FINH(L,NY,NX) - 2+TTHAW(L,NY,NX)+TUPWTR(L,NY,NX) - 3+FLU(L,NY,NX) - IF(VOLW(L,NY,NX).GT.ZEROS(NY,NX))THEN + 2+TTHAW(L,NY,NX)+TUPWTR(L,NY,NX)+FLU(L,NY,NX) + DVOLW(L,NY,NX)=VOLW1-VOLW(L,NY,NX) + IF(VOLW(L,NY,NX).GT.ZEROS2(NY,NX))THEN VOLWX(L,NY,NX)=VOLWX(L,NY,NX)+TFLWX(L,NY,NX)+FINH(L,NY,NX) 2+TTHAW(L,NY,NX)+TUPWTR(L,NY,NX)*VOLWX(L,NY,NX)/VOLW(L,NY,NX) 3+FLU(L,NY,NX)+FLWV(L,NY,NX) @@ -2771,13 +2951,19 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) ELSE VOLWX(L,NY,NX)=0.0 ENDIF + VOLI1=VOLI(L,NY,NX) VOLI(L,NY,NX)=VOLI(L,NY,NX)-TTHAW(L,NY,NX)/DENSI + DVOLI(L,NY,NX)=VOLI1-VOLI(L,NY,NX) VOLWH(L,NY,NX)=VOLWH(L,NY,NX)+TFLWH(L,NY,NX)-FINH(L,NY,NX) 2+TTHAWH(L,NY,NX) VOLIH(L,NY,NX)=VOLIH(L,NY,NX)-TTHAWH(L,NY,NX)/DENSI + IF(BKDS(L,NY,NX).GT.ZERO)THEN 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)) + ELSE + VOLP(L,NY,NX)=0.0 + ENDIF ENGY=VHCP(L,NY,NX)*TKS(L,NY,NX) VHCP1=VHCP(L,NY,NX) TKS1=TKS(L,NY,NX) @@ -2797,27 +2983,33 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) C C END ARTIFICIAL SOIL WARMING C + IF(VHCP(L,NY,NX).GT.ZEROS(NY,NX))THEN TKS(L,NY,NX)=(ENGY+THFLW(L,NY,NX)+THTHAW(L,NY,NX)+TUPHT(L,NY,NX) 2+HWFLU(L,NY,NX))/VHCP(L,NY,NX) + ELSE + TKS(L,NY,NX)=TKS(NUM(NY,NX),NY,NX) + ENDIF TCS(L,NY,NX)=TKS(L,NY,NX)-273.15 TSMX(L,NY,NX)=AMAX1(TSMX(L,NY,NX),TCS(L,NY,NX)) TSMN(L,NY,NX)=AMIN1(TSMN(L,NY,NX),TCS(L,NY,NX)) UN2GS(NY,NX)=UN2GS(NY,NX)+XN2GS(L,NY,NX) -C IF(J.EQ.15)THEN -C WRITE(*,6547)'VOLW',I,J,NX,NY,L,VOLW(L,NY,NX),VOLW1 +C IF(L.EQ.1)THEN +C WRITE(*,6547)'VOLW',I,J,NX,NY,L,VOLW(L,NY,NX),DVOLW(L,NY,NX) C 2,TFLW(L,NY,NX),FINH(L,NY,NX),TTHAW(L,NY,NX),TUPWTR(L,NY,NX) -C 3,FLU(L,NY,NX),TQR(NY,NX),VOLI(L,NY,NX),TTHAW(L,NY,NX),DENSI -C 4,PSISM(L,NY,NX),VOLI(L,NY,NX),VOLP(L,NY,NX),VOLA(L,NY,NX) +C 3,FLU(L,NY,NX),TQR(NY,NX),VOLI1,DENSI +C 4,PSISM(L,NY,NX),VOLI(L,NY,NX),DVOLI(L,NY,NX),VOLP(L,NY,NX) +C 5,VOLA(L,NY,NX),VOLX(L,NY,NX) +C 5,FLW(3,L,NY,NX),FLW(3,L+1,NY,NX),FLW(1,L,NY,NX+1) C WRITE(*,6547)'VOLWH',I,J,NX,NY,L,VOLWH(L,NY,NX),TFLWH(L,NY,NX) C 2,FINH(L,NY,NX),TTHAWH(L,NY,NX),VOLIH(L,NY,NX),VOLAH(L,NY,NX) -6547 FORMAT(A8,5I4,20E16.8) +6547 FORMAT(A8,5I4,20E14.6) C WRITE(*,6633)'TKS',I,J,NX,NY,L,TKS(L,NY,NX),ENGY,THFLW(L,NY,NX) C 2,THTHAW(L,NY,NX),TUPHT(L,NY,NX),HWFLU(L,NY,NX),VHCP(L,NY,NX) C 3,VHCP1,TKS1,VOLW(L,NY,NX),VOLWH(L,NY,NX),VOLI(L,NY,NX) C 4,VOLIH(L,NY,NX),TFLW(L,NY,NX),FINH(L,NY,NX),TTHAW(L,NY,NX) C 5,TUPWTR(L,NY,NX),FLU(L,NY,NX),TQR(NY,NX) -C 6,FLWSI(NY,NX),HFLWSI(NY,NX) -6633 FORMAT(A8,5I4,30F20.6) +C 6,FLWSI(NY,NX),HFLWSI(NY,NX),HFLW(3,L,NY,NX),HFLW(3,L+1,NY,NX) +6633 FORMAT(A8,5I4,30E12.4) C ENDIF C C RESIDUE FROM PLANT LITTERFALL @@ -2854,12 +3046,13 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 2-XOPFXS(K,L,NY,NX) OQAH(K,L,NY,NX)=OQAH(K,L,NY,NX)+TOAFHS(K,L,NY,NX) 2-XOAFXS(K,L,NY,NX) -C IF(L.LE.4)THEN -C WRITE(*,2627)'OQC',I,J,NX,NY,L,K,OQC(K,L,NY,NX),OQCH(K,L,NY,NX) -C 2,TOCFLS(K,L,NY,NX),XOCFXS(K,L,NY,NX) +C IF(I.EQ.187)THEN +C WRITE(*,2627)'OQCL',I,J,NX,NY,L,K +C 2,OQC(K,L,NY,NX),TOCFLS(K,L,NY,NX),XOCFXS(K,L,NY,NX) +C 4,OQCH(K,L,NY,NX),TOCFHS(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) C 4,OQNH(K,L,NY,NX),TONFHS(K,L,NY,NX),XONFXS(K,L,NY,NX) +C 5,OQA(K,L,NY,NX),TOAFLS(K,L,NY,NX),XOAFXS(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 @@ -2879,14 +3072,14 @@ 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+12.0*TRCO2(L,NY,NX)+XCOBBL(L,NY,NX) + 3+TRCO2(L,NY,NX)+XCOBBL(L,NY,NX) CH4S(L,NY,NX)=CH4S(L,NY,NX)+TCHFLS(L,NY,NX)+XCHDFG(L,NY,NX) 2-RCH4O(L,NY,NX)-TUPCHS(L,NY,NX)+RCHFLU(L,NY,NX) 3+XCHFXS(L,NY,NX)+XCHBBL(L,NY,NX) OXYS(L,NY,NX)=OXYS(L,NY,NX)+TOXFLS(L,NY,NX)+XOXDFG(L,NY,NX) 2-RUPOXO(L,NY,NX)-TUPOXS(L,NY,NX)+ROXFLU(L,NY,NX) 3+XOXFXS(L,NY,NX)+XOXBBL(L,NY,NX) -C IF(J.EQ.14)THEN +C IF(L.EQ.11)THEN C WRITE(*,5432)'CO2SL',I,J,NX,NY,L,CO2S(L,NY,NX),TCOFLS(L,NY,NX) C 2,XCODFG(L,NY,NX),RCO2O(L,NY,NX),TCO2S(L,NY,NX) C 3,RCOFLU(L,NY,NX),XCOFXS(L,NY,NX),TRCO2(L,NY,NX) @@ -2898,7 +3091,8 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) C WRITE(*,5432)'OXYSL',I,J,NX,NY,L,OXYS(L,NY,NX),TOXFLS(L,NY,NX) C 2,XOXDFG(L,NY,NX),RUPOXO(L,NY,NX),TUPOXS(L,NY,NX) C 3,ROXFLU(L,NY,NX),XOXFXS(L,NY,NX),XOXBBL(L,NY,NX),COXYS(L,NY,NX) -C 4,XOXFLS(3,L,NY,NX),XOXFLS(3,L+1,NY,NX),XOXDFS(NY,NX) +C 4,XOXFLS(3,L,NY,NX),XOXFLS(3,L+1,NY,NX),XOXFLS(1,L,NY,NX+1) +C 5,XOXDFS(NY,NX) 5432 FORMAT(A8,5I4,20E16.6) C ENDIF Z2GS(L,NY,NX)=Z2GS(L,NY,NX)+TNGFLS(L,NY,NX)+XNGDFG(L,NY,NX) @@ -2910,9 +3104,11 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) C IF(I.GT.160.AND.I.LT.190)THEN C WRITE(*,4444)'Z2OS',I,J,NX,NY,L,Z2OS(L,NY,NX),TN2FLS(L,NY,NX) C 2,XN2DFG(L,NY,NX),RN2O(L,NY,NX),TUPN2S(L,NY,NX),RN2FLU(L,NY,NX) -C 3,XN2FXS(L,NY,NX),Z2GS(L,NY,NX),TNGFLS(L,NY,NX),XNGDFG(L,NY,NX) +C 3,XN2FXS(L,NY,NX),XN2BBL(L,NY,NX),XN2FLS(3,L,NY,NX) +C 4,XN2FLS(3,L+1,NY,NX),XN2DFS(NY,NX) +C 3,Z2GS(L,NY,NX),TNGFLS(L,NY,NX),XNGDFG(L,NY,NX) C 4,RN2G(L,NY,NX),TUPNF(L,NY,NX),RNGFLU(L,NY,NX),XNGFXS(L,NY,NX) -C 5,XN2GS(L,NY,NX),XNGBBL(L,NY,NX) +C 5,XN2GS(L,NY,NX),XNGBBL(L,NY,NX),XNGDFS(NY,NX) C ENDIF H2GS(L,NY,NX)=H2GS(L,NY,NX)+THGFLS(L,NY,NX)+XHGDFG(L,NY,NX) 2-RH2GO(L,NY,NX)-TUPHGS(L,NY,NX)+RHGFLU(L,NY,NX) @@ -2923,7 +3119,7 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) ZNH4S(L,NY,NX)=ZNH4S(L,NY,NX)+TN4FLS(L,NY,NX)+XNH4S(L,NY,NX) 2+TRN4S(L,NY,NX)-TUPNH4(L,NY,NX)+RN4FLU(L,NY,NX) 3+XN4FXW(L,NY,NX) -C IF(L.EQ.1)THEN +C IF(IYRC.EQ.2006.AND.I.EQ.361.AND.NX.EQ.1)THEN C WRITE(*,4443)'H2GS',I,J,NX,NY,L,H2GS(L,NY,NX),THGFLS(L,NY,NX) C 2,XHGDFG(L,NY,NX),RH2GO(L,NY,NX),TUPHGS(L,NY,NX),RHGFLU(L,NY,NX) C 3,XHGFXS(L,NY,NX),XHGBBL(L,NY,NX),XHGDFS(NY,NX) @@ -2935,7 +3131,7 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) C 5,RN4FLU(L,NY,NX),XN4FXW(L,NY,NX),TN4QRS(NY,NX),TN3QRS(NY,NX) C 6,ZNH3SH(L,NY,NX),ZNH4SH(L,NY,NX),14.0*XN4(L,NY,NX) 4443 FORMAT(A8,5I4,30F16.8) -4444 FORMAT(A8,5I4,30F16.8) +4444 FORMAT(A8,5I4,30E12.4) C ENDIF ZNO3S(L,NY,NX)=ZNO3S(L,NY,NX)+TNOFLS(L,NY,NX)+XNO3S(L,NY,NX) 2+TRNO3(L,NY,NX)-TUPNO3(L,NY,NX)+RNOFLU(L,NY,NX) @@ -2947,7 +3143,7 @@ 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,40F15.8) +5545 FORMAT(A8,5I4,40E12.4) 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) @@ -3072,12 +3268,12 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 2+XOXBBL(L,NY,NX) RCH4L(L,NY,NX)=TCHFLS(L,NY,NX)+RCHFLU(L,NY,NX)+XCHFXS(L,NY,NX) 2+XCHBBL(L,NY,NX) -C IF(J.EQ.14)THEN +C IF(IYRC.EQ.2006.AND.I.EQ.361.AND.NX.EQ.1)THEN C WRITE(*,5432)'CO2GL',I,J,NX,NY,L,CO2G(L,NY,NX),TCOFLG(L,NY,NX) C 2,XCODFG(L,NY,NX),THETP(L,NY,NX) C WRITE(*,5432)'OXYGL',I,J,NX,NY,L,OXYG(L,NY,NX),TOXFLG(L,NY,NX) C 2,XOXDFG(L,NY,NX),COXYG(L,NY,NX),XOXFLG(3,L,NY,NX) -C 3,XOXFLG(3,L+1,NY,NX) +C 3,XOXFLG(3,L+1,NY,NX),XOXFLG(1,L,NY,NX+1) C WRITE(*,5432)'CH4GL',I,J,NX,NY,L,CH4G(L,NY,NX),TCHFLG(L,NY,NX) C 2,XCHDFG(L,NY,NX),CCH4G(L,NY,NX),XCHFLG(3,L,NY,NX) C 3,XCHFLG(3,L+1,NY,NX),XCHDFS(NY,NX),RCH4F(L,NY,NX) @@ -3127,15 +3323,15 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) ENDIF ENDIF CO2GIN=CO2GIN+CIB+CHB - COB=TCO2P(L,NY,NX)+TCO2S(L,NY,NX)-12.0*TRCO2(L,NY,NX) + COB=TCO2P(L,NY,NX)+TCO2S(L,NY,NX)-TRCO2(L,NY,NX) TCOU=TCOU+COB HCO2G(NY,NX)=HCO2G(NY,NX)+CIB UCO2G(NY,NX)=UCO2G(NY,NX)+CIB HCH4G(NY,NX)=HCH4G(NY,NX)+CHB UCH4G(NY,NX)=UCH4G(NY,NX)+CHB UCOP(NY,NX)=UCOP(NY,NX)+TCO2P(L,NY,NX)+TCO2S(L,NY,NX) - UDICD(NY,NX)=UDICD(NY,NX)-12.0*TRCO2(L,NY,NX) - TNBP(NY,NX)=TNBP(NY,NX)+CH+12.0*TRCO2(L,NY,NX) + UDICD(NY,NX)=UDICD(NY,NX)-12.0*TBCO2(L,NY,NX) + TNBP(NY,NX)=TNBP(NY,NX)+CH+12.0*TBCO2(L,NY,NX) OXYGIN=OXYGIN+OIB OOB=RUPOXO(L,NY,NX)+TUPOXP(L,NY,NX)+TUPOXS(L,NY,NX) OXYGOU=OXYGOU+OOB @@ -3152,13 +3348,14 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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 IF(I.EQ.256.AND.L.EQ.1)THEN C WRITE(*,6645)'PLT',I,J,NX,NY,L,LG,LL -C 2,HCH4G(NY,NX),CH -C 2,TCHFLA(L,NY,NX),XCHBBL(L,NY,NX),HOXYG(NY,NX),OI +C 2,HCH4G(NY,NX),CHB,TCHFLA(L,NY,NX),XCHBBL(L,NY,NX) +C 2,HOXYG(NY,NX),OIB C 3,XOXBBL(L,NY,NX),TUPOXP(L,NY,NX),TUPOXS(L,NY,NX) -C 4,TOXFLA(L,NY,NX),OXYG(L,NY,NX) -C 4,HCO2G(NY,NX),CI,TCOFLA(L,NY,NX),XCOBBL(L,NY,NX) +C 4,TOXFLA(L,NY,NX),OXYG(L,NY,NX),SOXYL(L,NY,NX) +C 4,HCO2G(NY,NX),CIB,TCOFLA(L,NY,NX),XCOBBL(L,NY,NX) +C 4,TRCO2(L,NY,NX) C 2,UN2GG(NY,NX),ZGI,XNGBBL(L,NY,NX) C 5,TN2FLA(L,NY,NX),TNHFLA(L,NY,NX),THGFLA(L,NY,NX) C 6,CH4G(LL,NY,NX) @@ -3174,12 +3371,12 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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) + SSB=TRH2O(L,NY,NX)+TBCO2(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 2,TBCO2(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 @@ -3234,8 +3431,8 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) C IF(NX.EQ.1.AND.NY.EQ.1)THEN C WRITE(*,8642)'TLCO2G',I,J,L,TLCO2G,CS,CO2G(L,NY,NX),CO2S(L,NY,NX) C 2,CO2SH(L,NY,NX),TLCO2P(L,NY,NX),CH4G(L,NY,NX),CH4S(L,NY,NX) -C 3,CH4SH(L,NY,NX),TLCH4P(L,NY,NX),UCO2S(NY,NX) -8642 FORMAT(A8,3I4,20F20.6) +C 3,CH4SH(L,NY,NX),TLCH4P(L,NY,NX) +8642 FORMAT(A8,3I4,20F16.6) C ENDIF OS=OXYG(L,NY,NX)+OXYS(L,NY,NX)+OXYSH(L,NY,NX)+TLOXYP(L,NY,NX) OXYGSO=OXYGSO+OS @@ -3250,8 +3447,13 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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 IF(I.EQ.168)THEN +C WRITE(*,5455)'TLN2GL',I,J,NX,NY,L,TLN2G +C 2,ZG,Z2GG(L,NY,NX),Z2GS(L,NY,NX),Z2GSH(L,NY,NX),TLN2OP(L,NY,NX) +C 2,Z2OG(L,NY,NX),Z2OS(L,NY,NX),Z2OSH(L,NY,NX),TLNH3P(L,NY,NX) +C 3,ZNH3G(L,NY,NX) +C WRITE(*,5455)'TLNH4L',I,J,NX,NY,L,TLNH4 +C 2,Z4S,Z4X,Z4F,XN4(L,NY,NX) C 2,XNB(L,NY,NX),ZNH4S(L,NY,NX),ZNH4SH(L,NY,NX) C 3,ZNH4B(L,NY,NX),ZNH4BH(L,NY,NX),ZNH3S(L,NY,NX),ZNH3SH(L,NY,NX) C 4,ZNH3B(L,NY,NX),ZNH3BH(L,NY,NX) @@ -3276,9 +3478,9 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) C C TOTAL SOC,SON,SOP C - RC=0.0 - RN=0.0 - RP=0.0 + DC=0.0 + DN=0.0 + DP=0.0 OC=0.0 ON=0.0 OP=0.0 @@ -3288,9 +3490,9 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) IF(K.LE.2)THEN DO 7960 N=1,7 DO 7960 M=1,3 - RC=RC+OMC(M,N,K,L,NY,NX) - RN=RN+OMN(M,N,K,L,NY,NX) - RP=RP+OMP(M,N,K,L,NY,NX) + DC=DC+OMC(M,N,K,L,NY,NX) + DN=DN+OMN(M,N,K,L,NY,NX) + DP=DP+OMP(M,N,K,L,NY,NX) TOMT(NY,NX)=TOMT(NY,NX)+OMC(M,N,K,L,NY,NX) TONT(NY,NX)=TONT(NY,NX)+OMN(M,N,K,L,NY,NX) TOPT(NY,NX)=TOPT(NY,NX)+OMP(M,N,K,L,NY,NX) @@ -3314,18 +3516,18 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) DO 7900 K=0,4 IF(K.LE.2)THEN DO 7940 M=1,2 - RC=RC+ORC(M,K,L,NY,NX) - RN=RN+ORN(M,K,L,NY,NX) - RP=RP+ORP(M,K,L,NY,NX) + DC=DC+ORC(M,K,L,NY,NX) + DN=DN+ORN(M,K,L,NY,NX) + DP=DP+ORP(M,K,L,NY,NX) 7940 CONTINUE - RC=RC+OQC(K,L,NY,NX)+OQCH(K,L,NY,NX)+OHC(K,L,NY,NX) + DC=DC+OQC(K,L,NY,NX)+OQCH(K,L,NY,NX)+OHC(K,L,NY,NX) 2+OQA(K,L,NY,NX)+OQAH(K,L,NY,NX)+OHA(K,L,NY,NX) - RN=RN+OQN(K,L,NY,NX)+OQNH(K,L,NY,NX)+OHN(K,L,NY,NX) - RP=RP+OQP(K,L,NY,NX)+OQPH(K,L,NY,NX)+OHP(K,L,NY,NX) + DN=DN+OQN(K,L,NY,NX)+OQNH(K,L,NY,NX)+OHN(K,L,NY,NX) + DP=DP+OQP(K,L,NY,NX)+OQPH(K,L,NY,NX)+OHP(K,L,NY,NX) DO 7930 M=1,4 - RC=RC+OSC(M,K,L,NY,NX) - RN=RN+OSN(M,K,L,NY,NX) - RP=RP+OSP(M,K,L,NY,NX) + DC=DC+OSC(M,K,L,NY,NX) + DN=DN+OSN(M,K,L,NY,NX) + DP=DP+OSP(M,K,L,NY,NX) 7930 CONTINUE ELSE DO 7920 M=1,2 @@ -3344,12 +3546,12 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 7910 CONTINUE ENDIF 7900 CONTINUE - ORGC(L,NY,NX)=RC+OC - ORGN(L,NY,NX)=RN+ON - ORGR(L,NY,NX)=RC -C IF(I.EQ.365.AND.J.EQ.24)THEN + ORGC(L,NY,NX)=DC+OC + ORGN(L,NY,NX)=DN+ON + ORGR(L,NY,NX)=DC +C IF(I.EQ.187)THEN C DO 4344 K=0,4 -C WRITE(*,4343)'ORGC',I,J,NX,NY,L,K,ORGC(L,NY,NX),RC,OC +C WRITE(*,4343)'ORGC',I,J,NX,NY,L,K,ORGC(L,NY,NX),DC,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) @@ -3358,22 +3560,22 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) C 2,((OMN(M,N,K,L,NY,NX),M=1,3),N=1,7) C 3,(ORN(M,K,L,NY,NX),M=1,2),(OSN(M,K,L,NY,NX),M=1,4) C 4,OQN(K,L,NY,NX),OQNH(K,L,NY,NX),OHN(K,L,NY,NX) -4343 FORMAT(A8,6I4,60E12.4) +4343 FORMAT(A8,6I4,120E12.4) 4344 CONTINUE C ENDIF - TLRSDC=TLRSDC+RC - URSDC(NY,NX)=URSDC(NY,NX)+RC - TLRSDN=TLRSDN+RN - URSDN(NY,NX)=URSDN(NY,NX)+RN - TLRSDP=TLRSDP+RP - URSDP(NY,NX)=URSDP(NY,NX)+RP + TLRSDC=TLRSDC+DC + URSDC(NY,NX)=URSDC(NY,NX)+DC + TLRSDN=TLRSDN+DN + URSDN(NY,NX)=URSDN(NY,NX)+DN + TLRSDP=TLRSDP+DP + URSDP(NY,NX)=URSDP(NY,NX)+DP TLORGC=TLORGC+OC UORGC(NY,NX)=UORGC(NY,NX)+OC TLORGN=TLORGN+ON UORGN(NY,NX)=UORGN(NY,NX)+ON TLORGP=TLORGP+OP UORGP(NY,NX)=UORGP(NY,NX)+OP - TSEDSO=TSEDSO+(RC+OC)*1.0E-06 + TSEDSO=TSEDSO+(DC+OC)*1.0E-06 C C TOTAL SALT IONS C @@ -3393,14 +3595,18 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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 + 2+ROHFLU(L,NY,NX)+XOHFXS(L,NY,NX) +C IF(L.EQ.1)THEN +C WRITE(*,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) +C WRITE(*,5545)'ZAL',I,J,NX,NY,L,ZAL(L,NY,NX),TRAL(L,NY,NX) +C 2,TALFLS(L,NY,NX),RALFLU(L,NY,NX),XALFXS(L,NY,NX) +C ENDIF 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) @@ -3624,7 +3830,7 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) C C SOIL ELECTRICAL CONDUCTIVITY C - IF(VOLW(L,NY,NX).GT.0.0)THEN + IF(VOLW(L,NY,NX).GT.ZEROS2(NY,NX))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)) @@ -3666,52 +3872,223 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) C WRITE(20,3339)'LBS',I,J,L,TION,TIONIN,TIONOU C 2,SSS,SSH,SSX,SSP,SSD,SHD,SSB 3339 FORMAT(A8,3I4,80E12.4) -125 CONTINUE - TRN(NY,NX)=TRN(NY,NX)+HEATI(NY,NX) - TLE(NY,NX)=TLE(NY,NX)+HEATE(NY,NX) - TSH(NY,NX)=TSH(NY,NX)+HEATS(NY,NX) - TGH(NY,NX)=TGH(NY,NX)-(HEATH(NY,NX)-HEATV(NY,NX)) - TLEC(NY,NX)=TLEC(NY,NX)+HEATE(NY,NX)*RAC(NY,NX) - TSHC(NY,NX)=TSHC(NY,NX)+HEATS(NY,NX)*RAC(NY,NX) - TCNET(NY,NX)=TCNET(NY,NX)+HCO2G(NY,NX) - RECO(NY,NX)=RECO(NY,NX)+HCO2G(NY,NX) - TNBP(NY,NX)=TNBP(NY,NX)+TCNET(NY,NX) +125 CONTINUE +C +C CALCULATE SUBSIDENCE +C + DO 225 L=NU(NY,NX),NL(NY,NX) + IF(IERSN(NY,NX).NE.0.AND.L.EQ.NU(NY,NX) + 2.AND.BKDS(NU(NY,NX),NY,NX).GT.ZERO)THEN + DDLYX(1)=(VOLXI(L,NY,NX)-VOLX(L,NY,NX))/AREA(3,L,NY,NX) + DDLYR(1)=DDLYX(1) + IFLGL(1)=1 + ELSEIF(BKDS(L,NY,NX).LE.ZERO.AND.BKDS(L+1,NY,NX).LE.ZERO)THEN + DDLYX1=(VOLAI(L,NY,NX)-VOLW(L,NY,NX)-VOLI(L,NY,NX)) + 2/AREA(3,L,NY,NX) + VOLWI=VOLW(L+1,NY,NX)+VOLI(L+1,NY,NX) + IF(DDLYX1.LT.-ZERO.OR.VOLWI.GT.0.0)THEN + DDLYX(1)=DDLYX1 + DDLYR(1)=AMIN1(DDLYX(1),(VOLWI/AREA(3,L,NY,NX))) + IFLGL(1)=1 + ELSE + DDLYX(1)=(VOLA(L,NY,NX)-VOLW(L,NY,NX)-VOLI(L,NY,NX)) + 2/AREA(3,L,NY,NX) + DDLYR(1)=DDLYX(1) + IFLGL(1)=2 + ENDIF + ELSEIF(BKDS(L,NY,NX).GT.ZERO.AND.CORGC(L,NY,NX).GT.FORGC)THEN + DDLYX(1)=(VOLA(L,NY,NX)-VOLW(L,NY,NX)-VOLI(L,NY,NX)) + 2/AREA(3,L,NY,NX) + IF(DDLYX(1).LT.-ZERO.OR.BKDS(L,NY,NX).LT.BKDX(L,NY,NX))THEN + DDLYR(1)=DDLYX(1) + ELSE + DDLYX(1)=0.0 + DDLYR(1)=0.0 + ENDIF + IFLGL(1)=0 + ELSE + DDLYX(1)=0.0 + DDLYR(1)=0.0 + IFLGL(1)=0 + ENDIF C -C UPDATE STATE VARIABLES WHEN SURFACE SEDIMENT TRANSPORT -C FORCES SOIL RE-LAYERING IF SURFACE LAYER BECOMES TOO -C THIN OR TOO THICK +C RESET LAYER DEPTHS C - IF(DLYR(3,NU(NY,NX),NY,NX).LT.DNUMN - 2.OR.DLYR(3,NU(NY,NX),NY,NX).GT.DNUMX)THEN - L0=NU(NY,NX) - IF(DLYR(3,NU(NY,NX),NY,NX).LT.DNUMN)THEN - FX=1.0 - L1=NU(NY,NX)+1 - NU(NY,NX)=L1 + IF(IFLGL(1).EQ.1)THEN + IF(L.EQ.NU(NY,NX).AND.BKDS(L,NY,NX).LE.ZERO)THEN + CDPTH(L-1,NY,NX)=CDPTH(L,NY,NX) + 2-DLYRI(3,L,NY,NX)+DDLYR(1) + ENDIF + CDPTH(L,NY,NX)=CDPTH(L,NY,NX)+DDLYR(1) + ELSEIF(IFLGL(1).EQ.0)THEN + DO 220 LL=L-1,0,-1 + CDPTH(LL,NY,NX)=CDPTH(LL,NY,NX)+DDLYR(1) +220 CONTINUE + ENDIF + IF(IFLGL(1).NE.0.AND.VOLW(L,NY,NX)+VOLI(L,NY,NX).GT.0.0)THEN + DDLYZ=AMIN1((DVOLW(L,NY,NX)+DVOLI(L,NY,NX))/AREA(3,L,NY,NX) + 2,CDPTH(L,NY,NX)-CDPTH(L-1,NY,NX)) + IF(DDLYR(1).LT.DDLYX(1))THEN + DDLYZ=DDLYZ-VOLW(L+1,NY,NX)-VOLI(L+1,NY,NX) + ENDIF + DO 215 LL=L-1,0,-1 + CDPTH(LL,NY,NX)=CDPTH(LL,NY,NX)+DDLYZ +215 CONTINUE + ENDIF + DLYR(3,L,NY,NX)=CDPTH(L,NY,NX)-CDPTH(L-1,NY,NX) + DPTH(L,NY,NX)=0.5*(CDPTH(L,NY,NX)+CDPTH(L-1,NY,NX)) + CDPTHZ(L,NY,NX)=CDPTH(L,NY,NX)-CDPTH(NU(NY,NX)-1,NY,NX) + IF(L.EQ.NU(NY,NX))THEN + DPTHZ(L,NY,NX)=0.5*CDPTHZ(L,NY,NX) ELSE - IF(NU(NY,NX).EQ.1)THEN - FX=(DLYR(3,NU(NY,NX),NY,NX)-DNUMX)/DLYR(3,NU(NY,NX),NY,NX) - L1=NU(NY,NX)+1 - NU(NY,NX)=L0 + DPTHZ(L,NY,NX)=0.5*(CDPTHZ(L,NY,NX)+CDPTHZ(L-1,NY,NX)) + ENDIF + IF(BKDS(L,NY,NX).LE.ZERO)THEN + VOLT(L,NY,NX)=AREA(3,L,NY,NX)*DLYR(3,L,NY,NX) + VOLX(L,NY,NX)=VOLT(L,NY,NX)*FMPR(L,NY,NX) + ENDIF +C IF(IYRC.EQ.2006.AND.I.EQ.361.AND.NX.EQ.1)THEN +C WRITE(*,1114)'DDLYR',I,J,NX,NY,L,IFLGL(1),DDLYR(1),DDLYX(1) +C 4,VOLAI(L,NY,NX),VOLA(L,NY,NX),VOLW(L,NY,NX),VOLI(L,NY,NX) +C 4,VOLW(L,NY,NX)+VOLI(L,NY,NX),DLYR(3,L-1,NY,NX),DLYR(3,L,NY,NX) +C 4,CDPTH(L-1,NY,NX),CDPTH(L,NY,NX) +C 3,CDPTHZ(L-1,NY,NX),CDPTHZ(L,NY,NX) +C 5,POROS(L-1,NY,NX),POROS(L,NY,NX) +C 5,VOLA(L-1,NY,NX),VOLA(L,NY,NX) +C 5,VOLX(L-1,NY,NX),VOLX(L,NY,NX) +C 5,VOLW(L-1,NY,NX),VOLW(L,NY,NX) +C 5,BKDX(L,NY,NX),BKDS(L,NY,NX),CORGC(L,NY,NX) +C 6,VOLAH(L,NY,NX),VOLWH(L,NY,NX) +1114 FORMAT(A8,6I4,30E14.6) +C ENDIF +C +C RESET SURFACE LAYER NUMBER IF LOST TO EVAPORATION, EROSION +C + IF(VOLX(NU(NY,NX),NY,NX).LE.ZEROS(NY,NX) + 2.OR.NUM(NY,NX).GT.NU(NY,NX))THEN + NUX=NU(NY,NX) + DO 9970 LL=NUX+1,NL(NY,NX) + IF(VOLX(LL,NY,NX).GT.ZEROS(NY,NX))THEN + NU(NY,NX)=LL + DDLYR(2)=1.0 + DDLYX(2)=1.0 + IFLGL(2)=1 + DLYR(3,NUX,NY,NX)=0.0 + IF(BKDS(NUX,NY,NX).LE.ZERO)THEN + VOLT(NUX,NY,NX)=AREA(3,NUX,NY,NX)*DLYR(3,NUX,NY,NX) + VOLX(NUX,NY,NX)=VOLT(NUX,NY,NX)*FMPR(NUX,NY,NX) + ENDIF + WRITE(*,5598)'SURFX',I,J,L,NX,NY,NUX,NU(NY,NX),NUM(NY,NX) + 2,DDLYR(2),VOLX(NUX,NY,NX) +5598 FORMAT(A8,8I4,12E14.6) + GO TO 9971 + ENDIF +9970 CONTINUE ELSE - FZ=DLYR(3,NU(NY,NX),NY,NX)-DNUMX - IF(FZ.GT.DNUMN)THEN - FX=(DLYR(3,NU(NY,NX),NY,NX)-DNUMX)/DLYR(3,NU(NY,NX),NY,NX) - L1=NU(NY,NX)-1 - NU(NY,NX)=L1 + DDLYR(2)=0.0 + DDLYX(2)=0.0 + IFLGL(2)=0 + ENDIF +9971 CONTINUE +C +C RESET SURFACE LAYER NUMBER IF GAIN FROM PRECIPITATION +C + IF(L.EQ.NU(NY,NX).AND.CDPTH(0,NY,NX).GT.CDPTHI(NY,NX) + 2.AND.((BKDS(L,NY,NX).GT.ZERO.AND.NU(NY,NX).GT.NUI(NY,NX) + 2.AND.TVOLG(NY,NX).GT.VOLWD(NY,NX)) + 3.OR.BKDS(L,NY,NX).LE.ZERO + 4.AND.TVOLG(NY,NX).GT.ZEROS(NY,NX)))THEN + NU(NY,NX)=NUI(NY,NX) + NUM(NY,NX)=NUI(NY,NX) + DDLYR(3)=-1.0 + DDLYX(3)=-1.0 + IFLGL(3)=1 + DDLYX1=-(VOLW(0,NY,NX)+VOLI(0,NY,NX)+VOLW(NU(NY,NX),NY,NX) + 2+VOLI(NU(NY,NX),NY,NX))/AREA(3,NU(NY,NX),NY,NX) + CDPTH(0,NY,NX)=CDPTH(NU(NY,NX),NY,NX)+DDLYX1-DDLYR(1) + DLYR(3,NU(NY,NX),NY,NX)=CDPTH(NU(NY,NX),NY,NX)-CDPTH(0,NY,NX) + DPTH(NU(NY,NX),NY,NX)=0.5*(CDPTH(NU(NY,NX),NY,NX) + 2+CDPTH(0,NY,NX)) + CDPTHZ(NU(NY,NX),NY,NX)=DLYR(3,NU(NY,NX),NY,NX) + DPTHZ(NU(NY,NX),NY,NX)=0.5*CDPTHZ(NU(NY,NX),NY,NX) + IF(BKDS(NU(NY,NX),NY,NX).LE.ZERO)THEN + VOLT(NU(NY,NX),NY,NX)=AREA(3,NU(NY,NX),NY,NX) + 2*DLYR(3,NU(NY,NX),NY,NX) + VOLX(NU(NY,NX),NY,NX)=VOLT(NU(NY,NX),NY,NX) + 2*FMPR(NU(NY,NX),NY,NX) + ENDIF + DLYR(3,0,NY,NX)=0.0 + VOLT(0,NY,NX)=0.0 + VOLX(0,NY,NX)=VOLT(0,NY,NX) + VOLXI(0,NY,NX)=VOLX(0,NY,NX) + WRITE(*,5598)'SURFY',I,J,L,NX,NY,NUI(NY,NX),NU(NY,NX),NUM(NY,NX) + 2,DDLYX1,DLYR(3,NU(NY,NX),NY,NX),ORGC(0,NY,NX),VOLW(0,NY,NX) + 2,VOLW(NU(NY,NX),NY,NX),DDLYR(3),TVOLG(NY,NX),VOLWD(NY,NX) + 3,CDPTH(0,NY,NX),CDPTH(NU(NY,NX),NY,NX),CDPTHI(NY,NX) + ELSE + DDLYR(3)=0.0 + DDLYX(3)=0.0 + IFLGL(3)=0 + ENDIF +C +C TRANSFER STATE VARIABLES BETWEEN LAYERS +C + DO 230 NN=1,3 + IF(DDLYR(NN).NE.0.0)IFLGS(NY,NX)=1 + IF(IFLGL(NN).EQ.1)THEN + IF(DDLYR(NN).NE.0.0)THEN + IF(DDLYR(NN).GT.0.0)THEN + IF(DDLYR(NN).LT.1.0)THEN + L1=L + L0=L+1 + IF(DDLYR(NN).LT.DDLYX(NN))THEN + FX=1.0 + ELSE + VOLWI=VOLW(L0,NY,NX)+VOLI(L0,NY,NX) + FX=AMIN1(1.0,DDLYR(NN)/(VOLWI/AREA(3,L0,NY,NX))) + ENDIF ELSE - FX=0.0 L1=NU(NY,NX) + L0=NUX + FX=1.0 ENDIF + ELSE + IF(DDLYR(NN).GT.-1.0)THEN + L1=L+1 + L0=L + VOLWI=VOLW(L0,NY,NX)+VOLI(L0,NY,NX) + FX=-AMIN1(1.0,DDLYR(NN)/(VOLWI/AREA(3,L0,NY,NX))) + ELSE + L1=NU(NY,NX) + L0=0 + FX=1.0 ENDIF ENDIF - WRITE(*,5599)'ERODE1',I,J,NX,NY,L0,L1,NU(NY,NX),DNUMN,DNUMX - 2,DLYR(3,L0,NY,NX),DLYR(3,L1,NY,NX),FX -5599 FORMAT(A8,7I4,12E12.4) - IF(FX.GT.0.0)THEN FY=1.0-FX - BKDS(L1,NY,NX)=(BKDS(L1,NY,NX) - 2*DLYR(3,L1,NY,NX)+BKDS(L0,NY,NX) +C IF(IYRC.EQ.2006.AND.I.EQ.361.AND.NX.EQ.1)THEN +C WRITE(*,5599)'ERODE1',I,J,NX,NY,L,L0,L1,NU(NY,NX),NN,FX,FY +C 3,DDLYR(NN),VOLXI(L0,NY,NX),VOLX(L0,NY,NX),VOLW(L0,NY,NX) +C 3,VOLI(L0,NY,NX),VOLXI(L1,NY,NX),VOLX(L1,NY,NX),VOLW(L1,NY,NX) +C 4,VOLI(L1,NY,NX),CDPTH(L0,NY,NX),CDPTH(L1,NY,NX) +C 5,VLNH4(L0,NY,NX),VLNH4(L1,NY,NX) +C 5,TKS(L0,NY,NX),TKS(L1,NY,NX) +C 5,VHCP(L0,NY,NX),VHCP(L1,NY,NX) +C 6,(WTRT1(1,L1,NR,1,NY,NX),NR=1,NRT(1,NY,NX)) +C 6,(WTRT2(1,L1,NR,1,NY,NX),NR=1,NRT(1,NY,NX)) +C 6,CPOOLR(1,L1,1,NY,NX) +C 6,(WTRT1(1,L0,NR,1,NY,NX),NR=1,NRT(1,NY,NX)) +C 6,(WTRT2(1,L0,NR,1,NY,NX),NR=1,NRT(1,NY,NX)) +C 6,CPOOLR(1,L0,1,NY,NX) +5599 FORMAT(A8,9I4,100E14.6) +C ENDIF +C +C SINK SOIL LAYER +C + IF(L0.NE.0)THEN + IF(DLYR(3,L1,NY,NX).GT.ZERO + 2.OR.FX*DLYR(3,L0,NY,NX).GT.ZERO)THEN + BKDX(L1,NY,NX)=(BKDX(L1,NY,NX) + 2*DLYR(3,L1,NY,NX)+BKDX(L0,NY,NX) 3*FX*DLYR(3,L0,NY,NX))/(DLYR(3,L1,NY,NX) 4+FX*DLYR(3,L0,NY,NX)) VLNHB(L1,NY,NX)=(VLNHB(L1,NY,NX) @@ -3729,12 +4106,7 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) VLNH4(L1,NY,NX)=1.0-VLNHB(L1,NY,NX) VLNO3(L1,NY,NX)=1.0-VLNOB(L1,NY,NX) VLPO4(L1,NY,NX)=1.0-VLPOB(L1,NY,NX) - DLYR(3,L1,NY,NX)=DLYR(3,L1,NY,NX) - 2+FX*DLYR(3,L0,NY,NX) - VOLX(L1,NY,NX)=VOLX(L1,NY,NX) - 2+FX*VOLX(L0,NY,NX) - BKVL(L1,NY,NX)=BKVL(L1,NY,NX) - 2+FX*BKVL(L0,NY,NX) + ENDIF SAND(L1,NY,NX)=SAND(L1,NY,NX) 2+FX*SAND(L0,NY,NX) SILT(L1,NY,NX)=SILT(L1,NY,NX) @@ -3745,26 +4117,36 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 2+FX*XCEC(L0,NY,NX) XAEC(L1,NY,NX)=XAEC(L1,NY,NX) 2+FX*XAEC(L0,NY,NX) + VOLWH(L1,NY,NX)=VOLWH(L1,NY,NX) + 2+FX*VOLWH(L0,NY,NX) + VOLIH(L1,NY,NX)=VOLIH(L1,NY,NX) + 2+FX*VOLIH(L0,NY,NX) +C VOLAH(L1,NY,NX)=VOLAH(L1,NY,NX) +C 2+FX*VOLAH(L0,NY,NX) + ENDIF VOLW(L1,NY,NX)=VOLW(L1,NY,NX) 2+FX*VOLW(L0,NY,NX) VOLI(L1,NY,NX)=VOLI(L1,NY,NX) 2+FX*VOLI(L0,NY,NX) - VOLIH(L1,NY,NX)=VOLIH(L1,NY,NX) - 2+FX*VOLIH(L0,NY,NX) VOLP(L1,NY,NX)=VOLP(L1,NY,NX) 2+FX*VOLP(L0,NY,NX) - VOLA(L1,NY,NX)=VOLA(L1,NY,NX) - 2+FX*VOLA(L0,NY,NX) - VOLWX(L1,NY,NX)=VOLW(L0,NY,NX) - VOLWH(L1,NY,NX)=VOLWH(L1,NY,NX) - 2+FX*VOLWH(L0,NY,NX) - VOLAH(L1,NY,NX)=VOLAH(L1,NY,NX) - 2+FX*VOLAH(L0,NY,NX) +C VOLA(L1,NY,NX)=VOLA(L1,NY,NX) +C 2+FX*VOLA(L0,NY,NX) + VOLWX(L1,NY,NX)=VOLW(L1,NY,NX) + ENGY1=VHCP(L1,NY,NX)*TKS(L1,NY,NX) + ENGY0=VHCP(L0,NY,NX)*TKS(L0,NY,NX) + ENGY1=ENGY1+FX*ENGY0 VHCM(L1,NY,NX)=VHCM(L1,NY,NX) 2+FX*VHCM(L0,NY,NX) VHCP(L1,NY,NX)=VHCM(L1,NY,NX) 2+4.19*(VOLW(L1,NY,NX)+VOLWH(L1,NY,NX)) 3+1.9274*(VOLI(L1,NY,NX)+VOLIH(L1,NY,NX)) + IF(VHCP(L1,NY,NX).GT.ZEROS(NY,NX))THEN + TKS(L1,NY,NX)=ENGY1/VHCP(L1,NY,NX) + ELSE + TKS(L1,NY,NX)=TKS(L0,NY,NX) + ENDIF + TCS(L1,NY,NX)=TKS(L1,NY,NX)-273.15 ZNH4FA(L1,NY,NX)=ZNH4FA(L1,NY,NX) 2+FX*ZNH4FA(L0,NY,NX) ZNH3FA(L1,NY,NX)=ZNH3FA(L1,NY,NX) @@ -3883,6 +4265,7 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 2+FX*ZCA2P(L0,NY,NX) ZMG1P(L1,NY,NX)=ZMG1P(L1,NY,NX) 2+FX*ZMG1P(L0,NY,NX) + IF(L0.NE.0)THEN H0POB(L1,NY,NX)=H0POB(L1,NY,NX) 2+FX*H0POB(L0,NY,NX) H1POB(L1,NY,NX)=H1POB(L1,NY,NX) @@ -3979,28 +4362,30 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 2+FX*CO2G(L0,NY,NX) CH4G(L1,NY,NX)=CH4G(L1,NY,NX) 2+FX*CH4G(L0,NY,NX) - CO2S(L1,NY,NX)=CO2S(L1,NY,NX) - 2+FX*CO2S(L0,NY,NX) - CH4S(L1,NY,NX)=CH4S(L1,NY,NX) - 2+FX*CH4S(L0,NY,NX) OXYG(L1,NY,NX)=OXYG(L1,NY,NX) 2+FX*OXYG(L0,NY,NX) - OXYS(L1,NY,NX)=OXYS(L1,NY,NX) - 2+FX*OXYS(L0,NY,NX) Z2GG(L1,NY,NX)=Z2GG(L1,NY,NX) 2+FX*Z2GG(L0,NY,NX) - Z2GS(L1,NY,NX)=Z2GS(L1,NY,NX) - 2+FX*Z2GS(L0,NY,NX) Z2OG(L1,NY,NX)=Z2OG(L1,NY,NX) 2+FX*Z2OG(L0,NY,NX) - Z2OS(L1,NY,NX)=Z2OS(L1,NY,NX) - 2+FX*Z2OS(L0,NY,NX) ZNH3G(L1,NY,NX)=ZNH3G(L1,NY,NX) 2+FX*ZNH3G(L0,NY,NX) H2GG(L1,NY,NX)=H2GG(L1,NY,NX) 2+FX*H2GG(L0,NY,NX) + ENDIF + CO2S(L1,NY,NX)=CO2S(L1,NY,NX) + 2+FX*CO2S(L0,NY,NX) + CH4S(L1,NY,NX)=CH4S(L1,NY,NX) + 2+FX*CH4S(L0,NY,NX) + OXYS(L1,NY,NX)=OXYS(L1,NY,NX) + 2+FX*OXYS(L0,NY,NX) + Z2GS(L1,NY,NX)=Z2GS(L1,NY,NX) + 2+FX*Z2GS(L0,NY,NX) + Z2OS(L1,NY,NX)=Z2OS(L1,NY,NX) + 2+FX*Z2OS(L0,NY,NX) H2GS(L1,NY,NX)=H2GS(L1,NY,NX) 2+FX*H2GS(L0,NY,NX) + IF(L0.NE.0)THEN ZNH4SH(L1,NY,NX)=ZNH4SH(L1,NY,NX) 2+FX*ZNH4SH(L0,NY,NX) ZNH3SH(L1,NY,NX)=ZNH3SH(L1,NY,NX) @@ -4137,6 +4522,7 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 2+FX*Z2GSH(L0,NY,NX) Z2OSH(L1,NY,NX)=Z2OSH(L1,NY,NX) 2+FX*Z2OSH(L0,NY,NX) + ENDIF ORGC(L1,NY,NX)=ORGC(L1,NY,NX) 2+FX*ORGC(L0,NY,NX) ORGN(L1,NY,NX)=ORGN(L1,NY,NX) @@ -4195,29 +4581,137 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 2+FX*OSP(M,K,L0,NY,NX) 7770 CONTINUE 7780 CONTINUE - CDPTH(L0,NY,NX)=CDPTH(L0,NY,NX) - 2-FX*DLYR(3,L0,NY,NX) - DLYR(3,L0,NY,NX)=FY*DLYR(3,L0,NY,NX) - VOLX(L0,NY,NX)=FY*VOLX(L0,NY,NX) - BKVL(L0,NY,NX)=FY*BKVL(L0,NY,NX) +C +C SINK ROOT LAYER +C + IF(L0.NE.0)THEN + DO 8900 NZ=1,NP(NY,NX) + DO 8895 N=1,MY(NZ,NY,NX) + CO2A(N,L1,NZ,NY,NX)=CO2A(N,L1,NZ,NY,NX) + 2+FX*CO2A(N,L0,NZ,NY,NX) + OXYA(N,L1,NZ,NY,NX)=OXYA(N,L1,NZ,NY,NX) + 2+FX*OXYA(N,L0,NZ,NY,NX) + CH4A(N,L1,NZ,NY,NX)=CH4A(N,L1,NZ,NY,NX) + 2+FX*CH4A(N,L0,NZ,NY,NX) + Z2OA(N,L1,NZ,NY,NX)=Z2OA(N,L1,NZ,NY,NX) + 2+FX*Z2OA(N,L0,NZ,NY,NX) + ZH3A(N,L1,NZ,NY,NX)=ZH3A(N,L1,NZ,NY,NX) + 2+FX*ZH3A(N,L0,NZ,NY,NX) + H2GA(N,L1,NZ,NY,NX)=H2GA(N,L1,NZ,NY,NX) + 2+FX*H2GA(N,L0,NZ,NY,NX) + CO2P(N,L1,NZ,NY,NX)=CO2P(N,L1,NZ,NY,NX) + 2+FX*CO2P(N,L0,NZ,NY,NX) + OXYP(N,L1,NZ,NY,NX)=OXYP(N,L1,NZ,NY,NX) + 2+FX*OXYP(N,L0,NZ,NY,NX) + CH4P(N,L1,NZ,NY,NX)=CH4P(N,L1,NZ,NY,NX) + 2+FX*CH4P(N,L0,NZ,NY,NX) + Z2OP(N,L1,NZ,NY,NX)=Z2OP(N,L1,NZ,NY,NX) + 2+FX*Z2OP(N,L0,NZ,NY,NX) + ZH3P(N,L1,NZ,NY,NX)=ZH3P(N,L1,NZ,NY,NX) + 2+FX*ZH3P(N,L0,NZ,NY,NX) + H2GP(N,L1,NZ,NY,NX)=H2GP(N,L1,NZ,NY,NX) + 2+FX*H2GP(N,L0,NZ,NY,NX) + DO 8870 NR=1,NRT(NZ,NY,NX) + WTRT1(N,L1,NR,NZ,NY,NX)=WTRT1(N,L1,NR,NZ,NY,NX) + 2+FX*WTRT1(N,L0,NR,NZ,NY,NX) + WTRT1N(N,L1,NR,NZ,NY,NX)=WTRT1N(N,L1,NR,NZ,NY,NX) + 2+FX*WTRT1N(N,L0,NR,NZ,NY,NX) + WTRT1P(N,L1,NR,NZ,NY,NX)=WTRT1P(N,L1,NR,NZ,NY,NX) + 2+FX*WTRT1P(N,L0,NR,NZ,NY,NX) + WTRT2(N,L1,NR,NZ,NY,NX)=WTRT2(N,L1,NR,NZ,NY,NX) + 2+FX*WTRT2(N,L0,NR,NZ,NY,NX) + WTRT2N(N,L1,NR,NZ,NY,NX)=WTRT2N(N,L1,NR,NZ,NY,NX) + 2+FX*WTRT2N(N,L0,NR,NZ,NY,NX) + WTRT2P(N,L1,NR,NZ,NY,NX)=WTRT2P(N,L1,NR,NZ,NY,NX) + 2+FX*WTRT2P(N,L0,NR,NZ,NY,NX) + RTLG1(N,L1,NR,NZ,NY,NX)=RTLG1(N,L1,NR,NZ,NY,NX) + 2+FX*RTLG1(N,L0,NR,NZ,NY,NX) + RTLG2(N,L1,NR,NZ,NY,NX)=RTLG2(N,L1,NR,NZ,NY,NX) + 2+FX*RTLG2(N,L0,NR,NZ,NY,NX) + RTN2(N,L1,NR,NZ,NY,NX)=RTN2(N,L1,NR,NZ,NY,NX) + 2+FX*RTN2(N,L0,NR,NZ,NY,NX) +8870 CONTINUE + CPOOLR(N,L1,NZ,NY,NX)=CPOOLR(N,L1,NZ,NY,NX) + 2+FX*CPOOLR(N,L0,NZ,NY,NX) + ZPOOLR(N,L1,NZ,NY,NX)=ZPOOLR(N,L1,NZ,NY,NX) + 2+FX*ZPOOLR(N,L0,NZ,NY,NX) + PPOOLR(N,L1,NZ,NY,NX)=PPOOLR(N,L1,NZ,NY,NX) + 2+FX*PPOOLR(N,L0,NZ,NY,NX) + WTRTL(N,L1,NZ,NY,NX)=WTRTL(N,L1,NZ,NY,NX) + 2+FX*WTRTL(N,L0,NZ,NY,NX) + WTRTD(N,L1,NZ,NY,NX)=WTRTD(N,L1,NZ,NY,NX) + 2+FX*WTRTD(N,L0,NZ,NY,NX) + WSRTL(N,L1,NZ,NY,NX)=WSRTL(N,L1,NZ,NY,NX) + 2+FX*WSRTL(N,L0,NZ,NY,NX) + RTN1(N,L1,NZ,NY,NX)=RTN1(N,L1,NZ,NY,NX) + 2+FX*RTN1(N,L0,NZ,NY,NX) + RTNL(N,L1,NZ,NY,NX)=RTNL(N,L1,NZ,NY,NX) + 2+FX*RTNL(N,L0,NZ,NY,NX) + RTLGP(N,L1,NZ,NY,NX)=RTLGP(N,L1,NZ,NY,NX) + 2+FX*RTLGP(N,L0,NZ,NY,NX) + RTDNP(N,L1,NZ,NY,NX)=RTDNP(N,L1,NZ,NY,NX) + 2+FX*RTDNP(N,L0,NZ,NY,NX) + RTVLP(N,L1,NZ,NY,NX)=RTVLP(N,L1,NZ,NY,NX) + 2+FX*RTVLP(N,L0,NZ,NY,NX) + RTVLW(N,L1,NZ,NY,NX)=RTVLW(N,L1,NZ,NY,NX) + 2+FX*RTVLW(N,L0,NZ,NY,NX) + RRAD1(N,L1,NZ,NY,NX)=RRAD1(N,L1,NZ,NY,NX) + 2+FX*RRAD1(N,L0,NZ,NY,NX) + RRAD2(N,L1,NZ,NY,NX)=RRAD2(N,L1,NZ,NY,NX) + 2+FX*RRAD2(N,L0,NZ,NY,NX) + RTARP(N,L1,NZ,NY,NX)=RTARP(N,L1,NZ,NY,NX) + 2+FX*RTARP(N,L0,NZ,NY,NX) + RTLGA(N,L1,NZ,NY,NX)=RTLGA(N,L1,NZ,NY,NX) + 2+FX*RTLGA(N,L0,NZ,NY,NX) +8895 CONTINUE + WTNDL(L1,NZ,NY,NX)=WTNDL(L1,NZ,NY,NX) + 2+FX*WTNDL(L0,NZ,NY,NX) + WTNDLN(L1,NZ,NY,NX)=WTNDLN(L1,NZ,NY,NX) + 2+FX*WTNDLN(L0,NZ,NY,NX) + WTNDLP(L1,NZ,NY,NX)=WTNDLP(L1,NZ,NY,NX) + 2+FX*WTNDLP(L0,NZ,NY,NX) + CPOOLN(L1,NZ,NY,NX)=CPOOLN(L1,NZ,NY,NX) + 2+FX*CPOOLN(L0,NZ,NY,NX) + ZPOOLN(L1,NZ,NY,NX)=ZPOOLN(L1,NZ,NY,NX) + 2+FX*ZPOOLN(L0,NZ,NY,NX) + PPOOLN(L1,NZ,NY,NX)=PPOOLN(L1,NZ,NY,NX) + 2+FX*PPOOLN(L0,NZ,NY,NX) +8900 CONTINUE + ENDIF +C +C SOURCE SOIL LAYER +C + IF(L0.NE.0)THEN SAND(L0,NY,NX)=FY*SAND(L0,NY,NX) SILT(L0,NY,NX)=FY*SILT(L0,NY,NX) CLAY(L0,NY,NX)=FY*CLAY(L0,NY,NX) XCEC(L0,NY,NX)=FY*XCEC(L0,NY,NX) XAEC(L0,NY,NX)=FY*XAEC(L0,NY,NX) + VOLWH(L0,NY,NX)=FY*VOLWH(L0,NY,NX) + VOLIH(L0,NY,NX)=FY*VOLIH(L0,NY,NX) +C VOLAH(L0,NY,NX)=FY*VOLAH(L0,NY,NX) + ENDIF VOLW(L0,NY,NX)=FY*VOLW(L0,NY,NX) VOLI(L0,NY,NX)=FY*VOLI(L0,NY,NX) VOLP(L0,NY,NX)=FY*VOLP(L0,NY,NX) - VOLA(L0,NY,NX)=FY*VOLA(L0,NY,NX) - VOLWX(L0,NY,NX)=FY*VOLWX(L0,NY,NX) - VOLWH(L0,NY,NX)=FY*VOLWH(L0,NY,NX) - VOLIH(L0,NY,NX)=FY*VOLIH(L0,NY,NX) - VOLAH(L0,NY,NX)=FY*VOLAH(L0,NY,NX) +C VOLA(L0,NY,NX)=FY*VOLA(L0,NY,NX) + VOLWX(L0,NY,NX)=VOLW(L0,NY,NX) + ENGY0=FY*ENGY0 VHCM(L0,NY,NX)=FY*VHCM(L0,NY,NX) - VHCP(L0,NY,NX)=FY*VHCP(L0,NY,NX) + IF(L0.NE.0)THEN VHCP(L0,NY,NX)=VHCM(L0,NY,NX) 2+4.19*(VOLW(L0,NY,NX)+VOLWH(L0,NY,NX)) 3+1.9274*(VOLI(L0,NY,NX)+VOLIH(L0,NY,NX)) + ELSE + VHCP(L0,NY,NX)=VHCM(L0,NY,NX) + 2+4.19*VOLW(L0,NY,NX)+1.9274*VOLI(L0,NY,NX) + ENDIF + IF(VHCP(L0,NY,NX).GT.ZEROS(NY,NX))THEN + TKS(L0,NY,NX)=ENGY0/VHCP(L0,NY,NX) + ELSE + TKS(L0,NY,NX)=TKS(L1,NY,NX) + ENDIF + TCS(L0,NY,NX)=TKS(L0,NY,NX)-273.15 ZNH4FA(L0,NY,NX)=FY*ZNH4FA(L0,NY,NX) ZNH3FA(L0,NY,NX)=FY*ZNH3FA(L0,NY,NX) ZNHUFA(L0,NY,NX)=FY*ZNHUFA(L0,NY,NX) @@ -4277,6 +4771,7 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) ZCA1P(L0,NY,NX)=FY*ZCA1P(L0,NY,NX) ZCA2P(L0,NY,NX)=FY*ZCA2P(L0,NY,NX) ZMG1P(L0,NY,NX)=FY*ZMG1P(L0,NY,NX) + IF(L0.NE.0)THEN H0POB(L0,NY,NX)=FY*H0POB(L0,NY,NX) H1POB(L0,NY,NX)=FY*H1POB(L0,NY,NX) H2POB(L0,NY,NX)=FY*H2POB(L0,NY,NX) @@ -4325,17 +4820,19 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) PCPMB(L0,NY,NX)=FY*PCPMB(L0,NY,NX) CO2G(L0,NY,NX)=FY*CO2G(L0,NY,NX) CH4G(L0,NY,NX)=FY*CH4G(L0,NY,NX) - CO2S(L0,NY,NX)=FY*CO2S(L0,NY,NX) - CH4S(L0,NY,NX)=FY*CH4S(L0,NY,NX) OXYG(L0,NY,NX)=FY*OXYG(L0,NY,NX) - OXYS(L0,NY,NX)=FY*OXYS(L0,NY,NX) Z2GG(L0,NY,NX)=FY*Z2GG(L0,NY,NX) - Z2GS(L0,NY,NX)=FY*Z2GS(L0,NY,NX) Z2OG(L0,NY,NX)=FY*Z2OG(L0,NY,NX) - Z2OS(L0,NY,NX)=FY*Z2OS(L0,NY,NX) ZNH3G(L0,NY,NX)=FY*ZNH3G(L0,NY,NX) H2GG(L0,NY,NX)=FY*H2GG(L0,NY,NX) + ENDIF + CO2S(L0,NY,NX)=FY*CO2S(L0,NY,NX) + CH4S(L0,NY,NX)=FY*CH4S(L0,NY,NX) + OXYS(L0,NY,NX)=FY*OXYS(L0,NY,NX) + Z2GS(L0,NY,NX)=FY*Z2GS(L0,NY,NX) + Z2OS(L0,NY,NX)=FY*Z2OS(L0,NY,NX) H2GS(L0,NY,NX)=FY*H2GS(L0,NY,NX) + IF(L0.NE.0)THEN ZNH4SH(L0,NY,NX)=FY*ZNH4SH(L0,NY,NX) ZNH3SH(L0,NY,NX)=FY*ZNH3SH(L0,NY,NX) ZNO3SH(L0,NY,NX)=FY*ZNO3SH(L0,NY,NX) @@ -4404,6 +4901,7 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) OXYSH(L0,NY,NX)=FY*OXYSH(L0,NY,NX) Z2GSH(L0,NY,NX)=FY*Z2GSH(L0,NY,NX) Z2OSH(L0,NY,NX)=FY*Z2OSH(L0,NY,NX) + ENDIF ORGC(L0,NY,NX)=FY*ORGC(L0,NY,NX) ORGN(L0,NY,NX)=FY*ORGN(L0,NY,NX) DO 7865 K=0,5 @@ -4438,39 +4936,119 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) OSP(M,K,L0,NY,NX)=FY*OSP(M,K,L0,NY,NX) 7870 CONTINUE 7880 CONTINUE - IF(FY.EQ.0.0)THEN - CCO2S(L0,NY,NX)=9999 - CCH4S(L0,NY,NX)=9999 - COXYS(L0,NY,NX)=9999 - THETW(L0,NY,NX)=9999 - THETI(L0,NY,NX)=9999 - PSISM(L0,NY,NX)=9999 - CZ2OS(L0,NY,NX)=9999 - CNH3S(L0,NY,NX)=9999 - TCS(L0,NY,NX)=9999 +C +C SOURCE ROOT LAYER +C + IF(L0.NE.0)THEN + DO 8910 NZ=1,NP(NY,NX) + DO 8905 N=1,MY(NZ,NY,NX) + CO2A(N,L0,NZ,NY,NX)=FY*CO2A(N,L0,NZ,NY,NX) + OXYA(N,L0,NZ,NY,NX)=FY*OXYA(N,L0,NZ,NY,NX) + CH4A(N,L0,NZ,NY,NX)=FY*CH4A(N,L0,NZ,NY,NX) + Z2OA(N,L0,NZ,NY,NX)=FY*Z2OA(N,L0,NZ,NY,NX) + ZH3A(N,L0,NZ,NY,NX)=FY*ZH3A(N,L0,NZ,NY,NX) + H2GA(N,L0,NZ,NY,NX)=FY*H2GA(N,L0,NZ,NY,NX) + CO2P(N,L0,NZ,NY,NX)=FY*CO2P(N,L0,NZ,NY,NX) + OXYP(N,L0,NZ,NY,NX)=FY*OXYP(N,L0,NZ,NY,NX) + CH4P(N,L0,NZ,NY,NX)=FY*CH4P(N,L0,NZ,NY,NX) + Z2OP(N,L0,NZ,NY,NX)=FY*Z2OP(N,L0,NZ,NY,NX) + ZH3P(N,L0,NZ,NY,NX)=FY*ZH3P(N,L0,NZ,NY,NX) + H2GP(N,L0,NZ,NY,NX)=FY*H2GP(N,L0,NZ,NY,NX) + DO 8970 NR=1,NRT(NZ,NY,NX) + WTRT1(N,L0,NR,NZ,NY,NX)=FY*WTRT1(N,L0,NR,NZ,NY,NX) + WTRT1N(N,L0,NR,NZ,NY,NX)=FY*WTRT1N(N,L0,NR,NZ,NY,NX) + WTRT1P(N,L0,NR,NZ,NY,NX)=FY*WTRT1P(N,L0,NR,NZ,NY,NX) + WTRT2(N,L0,NR,NZ,NY,NX)=FY*WTRT2(N,L0,NR,NZ,NY,NX) + WTRT2N(N,L0,NR,NZ,NY,NX)=FY*WTRT2N(N,L0,NR,NZ,NY,NX) + WTRT2P(N,L0,NR,NZ,NY,NX)=FY*WTRT2P(N,L0,NR,NZ,NY,NX) + RTLG1(N,L0,NR,NZ,NY,NX)=FY*RTLG1(N,L0,NR,NZ,NY,NX) + RTLG2(N,L0,NR,NZ,NY,NX)=FY*RTLG2(N,L0,NR,NZ,NY,NX) + RTN2(N,L0,NR,NZ,NY,NX)=FY*RTN2(N,L0,NR,NZ,NY,NX) +8970 CONTINUE + CPOOLR(N,L0,NZ,NY,NX)=FY*CPOOLR(N,L0,NZ,NY,NX) + ZPOOLR(N,L0,NZ,NY,NX)=FY*ZPOOLR(N,L0,NZ,NY,NX) + PPOOLR(N,L0,NZ,NY,NX)=FY*PPOOLR(N,L0,NZ,NY,NX) + WTRTL(N,L0,NZ,NY,NX)=FY*WTRTL(N,L0,NZ,NY,NX) + WTRTD(N,L0,NZ,NY,NX)=FY*WTRTD(N,L0,NZ,NY,NX) + WSRTL(N,L0,NZ,NY,NX)=FY*WSRTL(N,L0,NZ,NY,NX) + RTN1(N,L0,NZ,NY,NX)=FY*RTN1(N,L0,NZ,NY,NX) + RTNL(N,L0,NZ,NY,NX)=FY*RTNL(N,L0,NZ,NY,NX) + RTLGP(N,L0,NZ,NY,NX)=FY*RTLGP(N,L0,NZ,NY,NX) + RTDNP(N,L0,NZ,NY,NX)=FY*RTDNP(N,L0,NZ,NY,NX) + RTVLP(N,L0,NZ,NY,NX)=FY*RTVLP(N,L0,NZ,NY,NX) + RTVLW(N,L0,NZ,NY,NX)=FY*RTVLW(N,L0,NZ,NY,NX) + RRAD1(N,L0,NZ,NY,NX)=FY*RRAD1(N,L0,NZ,NY,NX) + RRAD2(N,L0,NZ,NY,NX)=FY*RRAD2(N,L0,NZ,NY,NX) + RTARP(N,L0,NZ,NY,NX)=FY*RTARP(N,L0,NZ,NY,NX) + RTLGA(N,L0,NZ,NY,NX)=FY*RTLGA(N,L0,NZ,NY,NX) +8905 CONTINUE + WTNDL(L0,NZ,NY,NX)=FY*WTNDL(L0,NZ,NY,NX) + WTNDLN(L0,NZ,NY,NX)=FY*WTNDLN(L0,NZ,NY,NX) + WTNDLP(L0,NZ,NY,NX)=FY*WTNDLP(L0,NZ,NY,NX) + CPOOLN(L0,NZ,NY,NX)=FY*CPOOLN(L0,NZ,NY,NX) + ZPOOLN(L0,NZ,NY,NX)=FY*ZPOOLN(L0,NZ,NY,NX) + PPOOLN(L0,NZ,NY,NX)=FY*PPOOLN(L0,NZ,NY,NX) +8910 CONTINUE ENDIF - IFLGS(NY,NX)=1 - WRITE(*,5599)'ERODE2',I,J,NX,NY,L0,L1,NU(NY,NX),DNUMN,DNUMX - 2,DLYR(3,L0,NY,NX),DLYR(3,L1,NY,NX),FX + IF(NN.EQ.1)THEN + IF(BKDS(L0,NY,NX).LE.ZERO.AND.BKDS(L1,NY,NX).LE.ZERO + 3.AND.VOLW(L0,NY,NX)+VOLI(L0,NY,NX).LE.ZEROS(NY,NX))THEN + CDPTH(L1,NY,NX)=CDPTH(L0,NY,NX) + ENDIF + ENDIF +C IF(IYRC.EQ.2006.AND.I.EQ.361.AND.NX.EQ.1)THEN +C WRITE(*,5599)'ERODE2',I,J,NX,NY,L,L0,L1,NU(NY,NX),NN,FX,FY +C 3,DDLYR(NN),VOLXI(L0,NY,NX),VOLX(L0,NY,NX),VOLW(L0,NY,NX) +C 3,VOLI(L0,NY,NX),VOLXI(L1,NY,NX),VOLX(L1,NY,NX),VOLW(L1,NY,NX) +C 4,VOLI(L1,NY,NX),CDPTH(L0,NY,NX),CDPTH(L1,NY,NX) +C 5,VLNH4(L0,NY,NX),VLNH4(L1,NY,NX) +C 5,TKS(L0,NY,NX),TKS(L1,NY,NX) +C 5,VHCP(L0,NY,NX),VHCP(L1,NY,NX) +C 6,(WTRT1(1,L1,NR,1,NY,NX),NR=1,NRT(1,NY,NX)) +C 6,(WTRT2(1,L1,NR,1,NY,NX),NR=1,NRT(1,NY,NX)) +C 6,CPOOLR(1,L1,1,NY,NX) +C 6,(WTRT1(1,L0,NR,1,NY,NX),NR=1,NRT(1,NY,NX)) +C 6,(WTRT2(1,L0,NR,1,NY,NX),NR=1,NRT(1,NY,NX)) +C 6,CPOOLR(1,L0,1,NY,NX) +C ENDIF ENDIF ENDIF +230 CONTINUE +225 CONTINUE + TRN(NY,NX)=TRN(NY,NX)+HEATI(NY,NX) + TLE(NY,NX)=TLE(NY,NX)+HEATE(NY,NX) + TSH(NY,NX)=TSH(NY,NX)+HEATS(NY,NX) + TGH(NY,NX)=TGH(NY,NX)-(HEATH(NY,NX)-HEATV(NY,NX)) + TLEC(NY,NX)=TLEC(NY,NX)+HEATE(NY,NX)*RAC(NY,NX) + TSHC(NY,NX)=TSHC(NY,NX)+HEATS(NY,NX)*RAC(NY,NX) + TCNET(NY,NX)=TCNET(NY,NX)+HCO2G(NY,NX) + RECO(NY,NX)=RECO(NY,NX)+HCO2G(NY,NX) + TNBP(NY,NX)=TNBP(NY,NX)+TCNET(NY,NX) + IF(NU(NY,NX).GT.NUI(NY,NX))THEN + DO 235 L=NUI(NY,NX),NU(NY,NX)-1 + IF(VOLX(L,NY,NX).LE.ZEROS(NY,NX))THEN + TKS(L,NY,NX)=TKS(NU(NY,NX),NY,NX) + TCS(L,NY,NX)=TKS(L,NY,NX)-273.15 + ENDIF +235 CONTINUE + ENDIF C C RESIDUE REMOVAL IF FIRE OR REMOVAL EVENT IS ENTERED IN DISTURBANCE FILE C IF(J.EQ.INT(ZNOON(NY,NX)).AND.(ITILL(I,NY,NX).EQ.21 2.OR.ITILL(I,NY,NX).EQ.22))THEN IF(ITILL(I,NY,NX).EQ.22)THEN - IFLGQ=0 + IFLGJ=0 NLL=-1 DO 2945 L=0,NL(NY,NX) -C WRITE(*,9494)'FIRE',I,J,L,IFLGQ,NLL,THETW(L,NY,NX) +C WRITE(*,9494)'FIRE',I,J,L,IFLGJ,NLL,THETW(L,NY,NX) 9494 FORMAT(A8,5I6,12E12.4) IF(L.EQ.0.OR.L.GE.NU(NY,NX))THEN - IF(IFLGQ.EQ.1)THEN + IF(IFLGJ.EQ.1)THEN GO TO 2946 ELSEIF(THETW(L,NY,NX).GT.FVLWB.OR.CORGC(L,NY,NX).LE.FORGC 2.OR.DPTH(L,NY,NX).GT.0.15)THEN - IFLGQ=1 + IFLGJ=1 ELSE NLL=L ENDIF @@ -4498,9 +5076,9 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) OC=0.0 ON=0.0 OP=0.0 - RC=0.0 - RN=0.0 - RP=0.0 + DC=0.0 + DN=0.0 + DP=0.0 DO 2955 K=0,4 DO 2955 M=1,4 ONL(M,K)=0.0 @@ -4531,9 +5109,9 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) OMC(M,N,K,L,NY,NX)=OMC(M,N,K,L,NY,NX)-OCH OMN(M,N,K,L,NY,NX)=OMN(M,N,K,L,NY,NX)-ONH OMP(M,N,K,L,NY,NX)=OMP(M,N,K,L,NY,NX)-OPH - RC=RC+OMC(M,N,K,L,NY,NX) - RN=RN+OMN(M,N,K,L,NY,NX) - RP=RP+OMP(M,N,K,L,NY,NX) + DC=DC+OMC(M,N,K,L,NY,NX) + DN=DN+OMN(M,N,K,L,NY,NX) + DP=DP+OMP(M,N,K,L,NY,NX) TOMT(NY,NX)=TOMT(NY,NX)+OMC(M,N,K,L,NY,NX) TONT(NY,NX)=TONT(NY,NX)+OMN(M,N,K,L,NY,NX) TOPT(NY,NX)=TOPT(NY,NX)+OMP(M,N,K,L,NY,NX) @@ -4566,9 +5144,9 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) ORC(M,K,L,NY,NX)=ORC(M,K,L,NY,NX)-OCH ORN(M,K,L,NY,NX)=ORN(M,K,L,NY,NX)-ONH ORP(M,K,L,NY,NX)=ORP(M,K,L,NY,NX)-OPH - RC=RC+ORC(M,K,L,NY,NX) - RN=RN+ORN(M,K,L,NY,NX) - RP=RP+ORP(M,K,L,NY,NX) + DC=DC+ORC(M,K,L,NY,NX) + DN=DN+ORN(M,K,L,NY,NX) + DP=DP+ORP(M,K,L,NY,NX) OC=OC+OCH ON=ON+ONX OP=OP+OPX @@ -4636,10 +5214,10 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) OHN(K,L,NY,NX)=OHN(K,L,NY,NX)-ONH OHP(K,L,NY,NX)=OHP(K,L,NY,NX)-OPH OHA(K,L,NY,NX)=OHA(K,L,NY,NX)-OAH - RC=RC+OQC(K,L,NY,NX)+OQCH(K,L,NY,NX)+OHC(K,L,NY,NX) + DC=DC+OQC(K,L,NY,NX)+OQCH(K,L,NY,NX)+OHC(K,L,NY,NX) 2+OQA(K,L,NY,NX)+OQAH(K,L,NY,NX)+OHA(K,L,NY,NX) - RN=RN+OQN(K,L,NY,NX)+OQNH(K,L,NY,NX)+OHN(K,L,NY,NX) - RP=RP+OQP(K,L,NY,NX)+OQPH(K,L,NY,NX)+OHP(K,L,NY,NX) + DN=DN+OQN(K,L,NY,NX)+OQNH(K,L,NY,NX)+OHN(K,L,NY,NX) + DP=DP+OQP(K,L,NY,NX)+OQPH(K,L,NY,NX)+OHP(K,L,NY,NX) OC=OC+OCH ON=ON+ONX OP=OP+OPX @@ -4659,9 +5237,9 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) OSA(M,K,L,NY,NX)=OSA(M,K,L,NY,NX)-OCA OSN(M,K,L,NY,NX)=OSN(M,K,L,NY,NX)-ONH OSP(M,K,L,NY,NX)=OSP(M,K,L,NY,NX)-OPH - RC=RC+OSC(M,K,L,NY,NX) - RN=RN+OSN(M,K,L,NY,NX) - RP=RP+OSP(M,K,L,NY,NX) + DC=DC+OSC(M,K,L,NY,NX) + DN=DN+OSN(M,K,L,NY,NX) + DP=DP+OSP(M,K,L,NY,NX) OC=OC+OCH ON=ON+ONX OP=OP+OPX @@ -4675,8 +5253,8 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) DO 2905 M=1,4 OSN(M,K,L,NY,NX)=OSN(M,K,L,NY,NX)+ONL(M,K) OSP(M,K,L,NY,NX)=OSP(M,K,L,NY,NX)+OPL(M,K) - RN=RN+ONL(M,K) - RP=RP+OPL(M,K) + DN=DN+ONL(M,K) + DP=DP+OPL(M,K) 2905 CONTINUE C C REMOVE FERTILIZER IN RESIDUE @@ -4702,12 +5280,12 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) ZNHUFA(L,NY,NX)=(1.0-DCORPC)*ZNHUFA(L,NY,NX) ZNO3FA(L,NY,NX)=(1.0-DCORPC)*ZNO3FA(L,NY,NX) ENDIF - ORGC(L,NY,NX)=RC - ORGN(L,NY,NX)=RN + ORGC(L,NY,NX)=DC + ORGN(L,NY,NX)=DN HFLXD=4.19E-06*(OSGX-ORGC(L,NY,NX))*TKS(L,NY,NX) HEATOU=HEATOU+HFLXD IF(L.EQ.0)THEN - VHCPR(NY,NX)=2.496E-06*ORGC(0,NY,NX)+4.19*VOLW(0,NY,NX) + VHCP(0,NY,NX)=2.496E-06*ORGC(0,NY,NX)+4.19*VOLW(0,NY,NX) 2+1.9274*VOLI(0,NY,NX) ELSE VHCP(L,NY,NX)=VHCM(L,NY,NX)+4.19*(VOLW(L,NY,NX)+VOLWH(L,NY,NX)) @@ -4750,7 +5328,7 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) ELSE DTBLZ(NY,NX)=0.0 ENDIF - DTBLX(NY,NX)=DTBLZ(NY,NX) + DTBLX(NY,NX)=DTBLZ(NY,NX)-CDPTH(NU(NY,NX)-1,NY,NX) ENDIF IF(J.EQ.INT(ZNOON(NY,NX)).AND.ITILL(I,NY,NX).EQ.24)THEN DDRGI(NY,NX)=DCORP(I,NY,NX) @@ -4777,7 +5355,7 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) C C TEMPORARY ACCUMULATORS C - TBKDS=0.0 + TBKDX=0.0 TFC=0.0 TWP=0.0 TSCNV=0.0 @@ -4954,9 +5532,9 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) C ACCUMULATE STATE VARIABLES IN SURFACE RESIDUE FOR ADDITION C TO SOIL IN TILLAGE MIXING ZONE C - RC=0.0 - RN=0.0 - RP=0.0 + DC=0.0 + DN=0.0 + DP=0.0 DO 3950 K=0,5 IF(K.NE.3.AND.K.NE.4)THEN DO 3945 N=1,7 @@ -4967,9 +5545,9 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) OMC(M,N,K,0,NY,NX)=OMC(M,N,K,0,NY,NX)*XCORP(NY,NX) OMN(M,N,K,0,NY,NX)=OMN(M,N,K,0,NY,NX)*XCORP(NY,NX) OMP(M,N,K,0,NY,NX)=OMP(M,N,K,0,NY,NX)*XCORP(NY,NX) - RC=RC+OMC(M,N,K,0,NY,NX) - RN=RN+OMN(M,N,K,0,NY,NX) - RP=RP+OMP(M,N,K,0,NY,NX) + DC=DC+OMC(M,N,K,0,NY,NX) + DN=DN+OMN(M,N,K,0,NY,NX) + DP=DP+OMP(M,N,K,0,NY,NX) 3945 CONTINUE ENDIF 3950 CONTINUE @@ -4981,9 +5559,9 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) ORC(M,K,0,NY,NX)=ORC(M,K,0,NY,NX)*XCORP(NY,NX) ORN(M,K,0,NY,NX)=ORN(M,K,0,NY,NX)*XCORP(NY,NX) ORP(M,K,0,NY,NX)=ORP(M,K,0,NY,NX)*XCORP(NY,NX) - RC=RC+ORC(M,K,0,NY,NX) - RN=RN+ORN(M,K,0,NY,NX) - RP=RP+ORP(M,K,0,NY,NX) + DC=DC+ORC(M,K,0,NY,NX) + DN=DN+ORN(M,K,0,NY,NX) + DP=DP+ORP(M,K,0,NY,NX) 3935 CONTINUE TOQGC(K)=OQC(K,0,NY,NX)*CORP TOQGN(K)=OQN(K,0,NY,NX)*CORP @@ -5012,10 +5590,10 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) OHN(K,0,NY,NX)=OHN(K,0,NY,NX)*XCORP(NY,NX) OHP(K,0,NY,NX)=OHP(K,0,NY,NX)*XCORP(NY,NX) OHA(K,0,NY,NX)=OHA(K,0,NY,NX)*XCORP(NY,NX) - RC=RC+OQC(K,0,NY,NX)+OQCH(K,0,NY,NX)+OHC(K,0,NY,NX)+OQA(K,0,NY,NX) + DC=DC+OQC(K,0,NY,NX)+OQCH(K,0,NY,NX)+OHC(K,0,NY,NX)+OQA(K,0,NY,NX) 2+OQAH(K,0,NY,NX)+OHA(K,0,NY,NX) - RN=RN+OQN(K,0,NY,NX)+OQNH(K,0,NY,NX)+OHN(K,0,NY,NX) - RP=RP+OQP(K,0,NY,NX)+OQPH(K,0,NY,NX)+OHP(K,0,NY,NX) + DN=DN+OQN(K,0,NY,NX)+OQNH(K,0,NY,NX)+OHN(K,0,NY,NX) + DP=DP+OQP(K,0,NY,NX)+OQPH(K,0,NY,NX)+OHP(K,0,NY,NX) DO 3965 M=1,4 TOSGC(M,K)=OSC(M,K,0,NY,NX)*CORP TOSGA(M,K)=OSA(M,K,0,NY,NX)*CORP @@ -5025,9 +5603,9 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) OSA(M,K,0,NY,NX)=OSA(M,K,0,NY,NX)*XCORP(NY,NX) OSN(M,K,0,NY,NX)=OSN(M,K,0,NY,NX)*XCORP(NY,NX) OSP(M,K,0,NY,NX)=OSP(M,K,0,NY,NX)*XCORP(NY,NX) - RC=RC+OSC(M,K,0,NY,NX) - RN=RN+OSN(M,K,0,NY,NX) - RP=RP+OSP(M,K,0,NY,NX) + DC=DC+OSC(M,K,0,NY,NX) + DN=DN+OSN(M,K,0,NY,NX) + DP=DP+OSP(M,K,0,NY,NX) 3965 CONTINUE 3940 CONTINUE TCO2GS=CO2S(0,NY,NX)*CORP @@ -5064,9 +5642,9 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) HEATIN=HEATIN-HFLXD HEATSO=HEATSO-HFLXD TENGYR=(4.19*TVOLWR+1.9274*TVOLIR)*TKS(0,NY,NX) - ORGC(0,NY,NX)=RC - ORGN(0,NY,NX)=RN - ORGR(0,NY,NX)=RC + ORGC(0,NY,NX)=DC + ORGN(0,NY,NX)=DN + ORGR(0,NY,NX)=DC CO2S(0,NY,NX)=CO2S(0,NY,NX)*XCORP(NY,NX) CH4S(0,NY,NX)=CH4S(0,NY,NX)*XCORP(NY,NX) OXYS(0,NY,NX)=OXYS(0,NY,NX)*XCORP(NY,NX) @@ -5096,7 +5674,7 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) ZNO3FA(0,NY,NX)=ZNO3FA(0,NY,NX)*XCORP(NY,NX) VOLW(0,NY,NX)=VOLW(0,NY,NX)*XCORP(NY,NX) VOLI(0,NY,NX)=VOLI(0,NY,NX)*XCORP(NY,NX) - VHCPR(NY,NX)=VHCPR(NY,NX)*XCORP(NY,NX) + VHCP(0,NY,NX)=VHCP(0,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) ZNHUX0=AMAX1(ZNHUX0,ZNHU0(0,NY,NX)) @@ -5112,12 +5690,13 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) C ACCUMULATE SOIL STATE VARIABLES WITHIN TILLAGE MIXING ZONE C DO 1000 L=NU(NY,NX),NL(NY,NX) - IF(CDPTH(L,NY,NX)-DLYR(3,L,NY,NX).LT.DCORPX)THEN + IF(CDPTH(L,NY,NX)-DLYR(3,L,NY,NX).LT.DCORPX + 2.AND.DLYR(3,L,NY,NX).GT.ZERO)THEN TL=AMIN1(DLYR(3,L,NY,NX),DCORPX-(CDPTH(L,NY,NX) 2-DLYR(3,L,NY,NX))) FI=TL/DCORPZ TI=TL/DLYR(3,L,NY,NX) - TBKDS=TBKDS+FI*BKDS(L,NY,NX) + TBKDX=TBKDX+FI*BKDX(L,NY,NX) TFC=TFC+FI*FC(L,NY,NX) TWP=TWP+FI*WP(L,NY,NX) TSCNV=TSCNV+FI*SCNV(L,NY,NX) @@ -5295,15 +5874,16 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) C CHANGE SOIL STATE VARIABLES IN TILLAGE MIXING ZONE C TO ACCOUNT FOR REDISTRIBUTION FROM MIXING C - HEATSR=VHCPW(NY,NX)*TKW(NY,NX)+VHCPR(NY,NX)*TKS(0,NY,NX) + HEATSR=VHCPW(NY,NX)*TKW(NY,NX)+VHCP(0,NY,NX)*TKS(0,NY,NX) DO 2000 L=NU(NY,NX),LL + IF(DLYR(3,L,NY,NX).GT.ZERO)THEN TL=AMIN1(DLYR(3,L,NY,NX),DCORPX-(CDPTH(L,NY,NX) 2-DLYR(3,L,NY,NX))) FI=TL/DCORPZ TI=TL/DLYR(3,L,NY,NX) TX=1.0-TI - BKDS(L,NY,NX)=TI*(BKDS(L,NY,NX)+CORP*(TBKDS-BKDS(L,NY,NX))) - 2+TX*BKDS(L,NY,NX) + BKDX(L,NY,NX)=TI*(BKDX(L,NY,NX)+CORP*(TBKDX-BKDX(L,NY,NX))) + 2+TX*BKDX(L,NY,NX) FC(L,NY,NX)=TI*(FC(L,NY,NX)+CORP*(TFC-FC(L,NY,NX))) 2+TX*FC(L,NY,NX) WP(L,NY,NX)=TI*(WP(L,NY,NX)+CORP*(TWP-WP(L,NY,NX))) @@ -5752,7 +6332,9 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) OC=0.0 ON=0.0 OP=0.0 - RC=0.0 + DC=0.0 + DN=0.0 + DP=0.0 DO 5985 K=0,5 DO 5985 N=1,7 DO 5985 M=1,3 @@ -5760,7 +6342,9 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) ON=ON+OMN(M,N,K,L,NY,NX) OP=OP+OMP(M,N,K,L,NY,NX) IF(K.LE.2)THEN - RC=RC+OMC(M,N,K,L,NY,NX) + DC=DC+OMC(M,N,K,L,NY,NX) + DN=DN+OMN(M,N,K,L,NY,NX) + DP=DP+OMP(M,N,K,L,NY,NX) ENDIF 5985 CONTINUE DO 6995 K=0,4 @@ -5769,7 +6353,9 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) ON=ON+ORN(M,K,L,NY,NX) OP=OP+ORP(M,K,L,NY,NX) IF(K.LE.2)THEN - RC=RC+ORC(M,K,L,NY,NX) + DC=DC+ORC(M,K,L,NY,NX) + DN=DN+ORN(M,K,L,NY,NX) + DP=DP+ORP(M,K,L,NY,NX) ENDIF 6985 CONTINUE OC=OC+OQC(K,L,NY,NX)+OQCH(K,L,NY,NX)+OHC(K,L,NY,NX) @@ -5777,21 +6363,25 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) ON=ON+OQN(K,L,NY,NX)+OQNH(K,L,NY,NX)+OHN(K,L,NY,NX) OP=OP+OQP(K,L,NY,NX)+OQPH(K,L,NY,NX)+OHP(K,L,NY,NX) IF(K.LE.2)THEN - RC=RC+OQC(K,L,NY,NX)+OQCH(K,L,NY,NX)+OHC(K,L,NY,NX) + DC=DC+OQC(K,L,NY,NX)+OQCH(K,L,NY,NX)+OHC(K,L,NY,NX) 2+OQA(K,L,NY,NX)+OQAH(K,L,NY,NX)+OHA(K,L,NY,NX) + DN=DN+OQN(K,L,NY,NX)+OQNH(K,L,NY,NX)+OHN(K,L,NY,NX) + DC=DC+OQC(K,L,NY,NX)+OQCH(K,L,NY,NX)+OHC(K,L,NY,NX) ENDIF DO 6980 M=1,4 OC=OC+OSC(M,K,L,NY,NX) ON=ON+OSN(M,K,L,NY,NX) OP=OP+OSP(M,K,L,NY,NX) IF(K.LE.2)THEN - RC=RC+OSC(M,K,L,NY,NX) + DC=DC+OSC(M,K,L,NY,NX) + DN=DN+OSN(M,K,L,NY,NX) + DP=DP+OSP(M,K,L,NY,NX) ENDIF 6980 CONTINUE 6995 CONTINUE ORGC(L,NY,NX)=OC ORGN(L,NY,NX)=ON - ORGR(L,NY,NX)=RC + ORGR(L,NY,NX)=DC CO2S(L,NY,NX)=CO2S(L,NY,NX)+FI*TCO2GS CH4S(L,NY,NX)=CH4S(L,NY,NX)+FI*TCH4GS OXYS(L,NY,NX)=OXYS(L,NY,NX)+FI*TOXYGS @@ -5825,6 +6415,7 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) ZNFNI(L,NY,NX)=(TI*ZNFNI(L,NY,NX)+CORP*(FI*TZNFNI 2-TI*ZNFNI(L,NY,NX))+TX*ZNFNI(L,NY,NX)+FI*TZNFNG)/FI TZNFN2=TZNFN2+ZNFNI(L,NY,NX) + ENDIF 2000 CONTINUE ZNFN0(0,NY,NX)=ZNFNX0 ZNFNI(0,NY,NX)=ZNFNI(0,NY,NX)*XCORP(NY,NX) @@ -5849,10 +6440,10 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 2,(ORGN(L,NY,NX)/AREA(3,L,NY,NX),L=0,NL(NY,NX)) 2221 FORMAT(A8,5I4,21E12.4) ENDIF -C IF(I.EQ.365.AND.J.EQ.24)THEN +C IF(I.EQ.168)THEN C WRITE(20,2221)'OMCL',I,J,IYRC,NX,NY,(OMCL(L,NY,NX),L=0,NL(NY,NX)) C WRITE(20,2221)'OMNL',I,J,IYRC,NX,NY,(OMNL(L,NY,NX),L=0,NL(NY,NX)) -C WRITE(20,2222)'TLC',I,J,IYRC,NX,NY,TLRSDC+TLORGC+TLCO2G-CO2GIN +C WRITE(*,2222)'TLC',I,J,IYRC,NX,NY,TLRSDC+TLORGC+TLCO2G-CO2GIN C 2+TCOU-TORGF-XCSN,TLRSDC,TLORGC,TLCO2G,CO2GIN,TCOU,TORGF,XCSN C 5,XCODFS(NY,NX),XCOFLG(3,NU(NY,NX),NY,NX),TCO2Z(NY,NX) C 2,FLQGQ(NY,NX)*CCOR(NY,NX),FLQGI(NY,NX)*CCOQ(NY,NX),XCODFG(0,NY,NX) @@ -5872,13 +6463,13 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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 WRITE(20,2222)'TLH',I,J,IYRC,NX,NY,HEATSO-HEATIN+HEATOU C 2,HEATSO,HEATIN,HEATOU,HTHAWR(NY,NX),HFLXD,4.19*TKA(NY,NX) C 3,2.095*TKA(NY,NX)*PRECW(NY,NX),HEATH(NY,NX),HTHAWW(NY,NX) C 4,THFLXC(NY,NX),(THTHAW(L,NY,NX),L=NU(NY,NX),NL(NY,NX)) C 5,(VHCP(L,NY,NX)*TKS(L,NY,NX),L=NU(NY,NX),NL(NY,NX)) C 5,4.19*TKA(NY,NX)*PRECU(NY,NX),TENGYC(NY,NX),ENGYR -C 6,VHCPW(NY,NX)*TKW(NY,NX),VHCPR(NY,NX)*TKS(0,NY,NX) +C 6,VHCPW(NY,NX)*TKW(NY,NX),VHCP(0,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) @@ -5887,8 +6478,7 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) C 3,(TUPOXP(L,NY,NX),L=1,NJ(NY,NX)),(TOXFLA(L,NY,NX),L=1,NJ(NY,NX)) C WRITE(20,2222)'TLN',I,J,IYRC,NX,NY,TLRSDN+TLORGN+TLN2G+TLNH4 C 2+TLNO3-ZN2GIN-TZIN+TZOU-TORGN-XZSN,TLRSDN,TLORGN,TLN2G,TLNH4 -C 3,TLNO3,ZN2GIN,TZIN,TZOU,TORGN,XZSN,PRECQ(NY,NX),PRECR(NY,NX) -C 4,PRECW(NY,NX),PRECI(NY,NX),FLQGM(NY,NX),FLQRM(NY,NX) +C 3,TLNO3,ZN2GIN,TZIN,TZOU,TORGN,XZSN 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) @@ -5896,6 +6486,8 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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 4,PRECQ(NY,NX),PRECR(NY,NX) +C 4,PRECW(NY,NX),PRECI(NY,NX),FLQGM(NY,NX),FLQRM(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) @@ -5925,9 +6517,9 @@ SUBROUTINE redist(I,J,NHW,NHE,NVN,NVS) 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) +2222 FORMAT(A8,5I6,240F16.6) +2223 FORMAT(A8,6I6,160F16.6) +2224 FORMAT(A8,5I6,160F16.6) C ENDIF 9990 CONTINUE 9995 CONTINUE diff --git a/f77src/routp.f b/f77src/routp.f old mode 100755 new mode 100644 diff --git a/f77src/routq.f b/f77src/routq.f old mode 100755 new mode 100644 diff --git a/f77src/routs.f b/f77src/routs.f old mode 100755 new mode 100644 index 6468ddf..0a4d3e5 --- a/f77src/routs.f +++ b/f77src/routs.f @@ -73,7 +73,7 @@ SUBROUTINE routs(NHW,NHE,NVN,NVS) 2,IFNOB(NY,NX),IFPOB(NY,NX),IUTYP(NY,NX),ZT(NY,NX),TFLWC(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) + 5,DPTHS(NY,NX),TCW(NY,NX),TKW(NY,NX),VHCPW(NY,NX) 6,VOLWG(NY,NX),URAIN(NY,NX),ARLFC(NY,NX),ARSTC(NY,NX),PPT(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) @@ -107,6 +107,7 @@ SUBROUTINE routs(NHW,NHE,NVN,NVS) READ(21,91)IDATE,IYR,(FHOL(L,NY,NX),L=1,NL(NY,NX)) READ(21,91)IDATE,IYR,(DLYR(3,L,NY,NX),L=0,NL(NY,NX)) READ(21,91)IDATE,IYR,(CDPTH(L,NY,NX),L=0,NL(NY,NX)) + READ(21,91)IDATE,IYR,(CDPTHZ(L,NY,NX),L=0,NL(NY,NX)) READ(21,91)IDATE,IYR,(BKDS(L,NY,NX),L=1,NL(NY,NX)) READ(21,91)IDATE,IYR,(CORGC(L,NY,NX),L=0,NL(NY,NX)) READ(21,91)IDATE,IYR,(POROS(L,NY,NX),L=1,NL(NY,NX)) @@ -134,8 +135,8 @@ SUBROUTINE routs(NHW,NHE,NVN,NVS) READ(21,91)IDATE,IYR,(XAEC(L,NY,NX),L=1,NL(NY,NX)) READ(21,91)IDATE,IYR,(TCS(L,NY,NX),L=0,NL(NY,NX)) READ(21,91)IDATE,IYR,(TKS(L,NY,NX),L=0,NL(NY,NX)) - READ(21,91)IDATE,IYR,(VHCP(L,NY,NX),L=1,NL(NY,NX)) - READ(21,91)IDATE,IYR,(VHCM(L,NY,NX),L=1,NL(NY,NX)) + READ(21,91)IDATE,IYR,(VHCP(L,NY,NX),L=0,NL(NY,NX)) + READ(21,91)IDATE,IYR,(VHCM(L,NY,NX),L=0,NL(NY,NX)) READ(21,91)IDATE,IYR,(CO2G(L,NY,NX),L=1,NL(NY,NX)) READ(21,91)IDATE,IYR,(CO2S(L,NY,NX),L=0,NL(NY,NX)) READ(21,91)IDATE,IYR,(CO2SH(L,NY,NX),L=1,NL(NY,NX)) diff --git a/f77src/soil.f b/f77src/soil.f old mode 100755 new mode 100644 diff --git a/f77src/solute.f b/f77src/solute.f old mode 100755 new mode 100644 index 6a00cde..d2d2d16 --- a/f77src/solute.f +++ b/f77src/solute.f @@ -31,7 +31,7 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) C DIMENSION RNHUI(0:2) PARAMETER (DPH2O=6.5E-09,SPALO=6.5E-22,SPFEO=6.5E-27 - 2,SPCAC=5.0E-03,SPCAS=1.4E+01,SPALP=1.0E-15,SPFEP=1.0E-20 + 2,SPCAC=3.8E-03,SPCAS=1.4E+01,SPALP=1.0E-15,SPFEP=1.0E-20 3,SPCAM=7.0E+07,SPCAD=1.0E-01,SPCAH=2.3E-31,SXOH2=4.5E-05 4,SXOH1=1.1E-06,SXH2P=2.0E+07,SXH1P=2.0E+07 5,DPCO2=4.2E-04,DPHCO=5.6E-08,DPN4=5.7E-07 @@ -69,7 +69,7 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 9,SHCAH2=SHCAH1/DPH2P**3,SYCAH2=SHCAH2*DPH2O**7) PARAMETER (MRXN=1,TPD=5.0E-03,TPDX=TPD/MRXN,TADA=5.0E-02 2,TADAX=TADA/MRXN,TADC=5.0E-02,TADCX=TADC/MRXN - 3,TADC0=TADC*1.0E-02,TSL=0.5,TSLX=TSL/MRXN) + 3,TADC0=TADC*1.0E-02,TSL=5.0E-01,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.0E-00 @@ -82,7 +82,8 @@ 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(VOLWM(NPH,L,NY,NX).GT.ZEROS(NY,NX))THEN + IF(VOLX(L,NY,NX).GT.ZEROS(NY,NX) + 2.AND.VOLWM(NPH,L,NY,NX).GT.ZEROS2(NY,NX))THEN C C WATER VOLUME IN NON-BAND AND BAND SOIL ZONES C @@ -101,7 +102,7 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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) + BKVLX=VOLA(L,NY,NX) BKVLNH=VOLWNH BKVLNB=VOLWNB BKVLNO=VOLWNO @@ -135,8 +136,10 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) IF(ZNHUFA(L,NY,NX).GT.ZEROS(NY,NX) 2.AND.BKVL(L,NY,NX).GT.ZEROS(NY,NX))THEN CNHUA=ZNHUFA(L,NY,NX)/BKVL(L,NY,NX) - ELSE + ELSEIF(VOLW(L,NY,NX).GT.ZEROS2(NY,NX))THEN CNHUA=ZNHUFA(L,NY,NX)/VOLW(L,NY,NX) + ELSE + CNHUA=0.0 ENDIF DFNSA=CNHUA/(CNHUA+DUKD) RSNUA=AMIN1(ZNHUFA(L,NY,NX) @@ -147,18 +150,21 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) IF(ZNHUFB(L,NY,NX).GT.ZEROS(NY,NX) 2.AND.BKVL(L,NY,NX).GT.ZEROS(NY,NX))THEN CNHUB=ZNHUFB(L,NY,NX)/BKVL(L,NY,NX) - ELSE + ELSEIF(VOLW(L,NY,NX).GT.ZEROS2(NY,NX))THEN CNHUB=ZNHUFB(L,NY,NX)/VOLW(L,NY,NX) + ELSE + CNHUB=0.0 ENDIF DFNSB=CNHUB/(CNHUB+DUKD) RSNUB=AMIN1(ZNHUFB(L,NY,NX) 2,SPNHU*TOQCK(L,NY,NX)*DFNSB*TFNQ(L,NY,NX))*(1.0-ZNHUI(L,NY,NX)) -C IF(J.EQ.13.AND.L.LE.4)THEN +C IF(IYRC.EQ.2012.AND.I.EQ.151.AND.NX.EQ.1)THEN C WRITE(*,8888)'UREA',I,J,L,IUTYP(NY,NX) C 2,ZNHUFA(L,NY,NX),ZNHUFB(L,NY,NX),RSNUA,RSNUB C 2,DFNSA,DFNSB,TFNQ(L,NY,NX),CNHUA,DUKD,DUKM,DUKI,TOQCK(L,NY,NX) C 3,BKVL(L,NY,NX),SPNHU,ZNHU0(L,NY,NX),ZNHUI(L,NY,NX) -C 4,RNHUI(IUTYP(NY,NX)) +C 4,RNHUI(IUTYP(NY,NX)),VLNH4(L,NY,NX),VLNHB(L,NY,NX) +C 5,THETW(L,NY,NX) 8888 FORMAT(A8,4I4,40E12.4) C ENDIF C @@ -188,7 +194,7 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) C SOLUBLE AND EXCHANGEABLE NH4 CONCENTRATIONS C IN NON-BAND AND BAND SOIL ZONES C - IF(VOLWNH.GT.ZEROS(NY,NX))THEN + IF(VOLWNH.GT.ZEROS2(NY,NX))THEN VOLWNX=14.0*VOLWNH RN4X=(-TUPNH4(L,NY,NX)+XNH4S(L,NY,NX)+14.0*RSN4AA)/VOLWNX RN3X=(-TUPN3S(L,NY,NX)+14.0*RSNUAA)/VOLWNX @@ -202,7 +208,7 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) CN31=0.0 XN41=0.0 ENDIF - IF(VOLWNB.GT.ZEROS(NY,NX))THEN + IF(VOLWNB.GT.ZEROS2(NY,NX))THEN VOLWNX=14.0*VOLWNB RNBX=(-TUPNHB(L,NY,NX)+XNH4B(L,NY,NX)+14.0*(RSN4BA+RSN4BB)) 2/VOLWNX @@ -218,18 +224,20 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) CN3B=0.0 XN4B=0.0 ENDIF +C IF(IYRC.EQ.2012.AND.I.EQ.151.AND.NX.EQ.1)THEN C WRITE(*,4141)'RN4X',I,J,NX,NY,L,RN4X,RN3X,RNBX,R3BX -C 2,CN41,CN31,CN4B,CN3B,TUPNH4(L,NY,NX),XNH4S(L,NY,NX) +C 2,CN41,CN31,CN4B,CN3B,ZNH4S(L,NY,NX),ZNH3S(L,NY,NX) C 3,RSN4AA,TUPN3S(L,NY,NX),RSNUAA,TUPNHB(L,NY,NX) C 4,XNH4B(L,NY,NX),RSN4BA,RSN4BB,TUPN3B(L,NY,NX) C 5,RSNUBA,RSNUBB,ZNH4S(L,NY,NX),ZNH3S(L,NY,NX) C 6,VOLWNX,BKVLNH 4141 FORMAT(A8,5I4,30E12.4) +C ENDIF C C SOLUBLE, EXCHANGEABLE AND PRECIPITATED PO4 CONCENTRATIONS IN C NON-BAND AND BAND SOIL ZONES C - IF(VOLWPO.GT.ZEROS(NY,NX))THEN + IF(VOLWPO.GT.ZEROS2(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 @@ -264,7 +272,7 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) PCAPD1=0.0 PCAPH1=0.0 ENDIF - IF(VOLWPB.GT.ZEROS(NY,NX))THEN + IF(VOLWPB.GT.ZEROS2(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 @@ -305,12 +313,12 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) C SOLUBLE NO3 CONCENTRATIONS C IN NON-BAND AND BAND SOIL ZONES C - IF(VOLWNO.GT.ZEROS(NY,NX))THEN + IF(VOLWNO.GT.ZEROS2(NY,NX))THEN CNO1=AMAX1(0.0,ZNO3S(L,NY,NX)/(14.0*VOLWNO)) ELSE CNO1=0.0 ENDIF - IF(VOLWNZ.GT.ZEROS(NY,NX))THEN + IF(VOLWNZ.GT.ZEROS2(NY,NX))THEN CNOB=AMAX1(0.0,ZNO3B(L,NY,NX)/(14.0*VOLWNZ)) ELSE CNOB=0.0 @@ -320,7 +328,12 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) C C SOLUTE ION AND ION PAIR CONCENTRATIONS C + IF(BKVLX.GT.ZEROS(NY,NX))THEN CCEC=AMAX1(ZERO,XCEC(L,NY,NX)/BKVLX) + ELSE + CCEC=ZERO + ENDIF + IF(VOLWM(NPH,L,NY,NX).GT.ZEROS2(NY,NX))THEN 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)) @@ -354,10 +367,45 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) CNAC1=AMAX1(0.0,ZNAC(L,NY,NX)/VOLWM(NPH,L,NY,NX)) CNAS1=AMAX1(0.0,ZNAS(L,NY,NX)/VOLWM(NPH,L,NY,NX)) CKAS1=AMAX1(0.0,ZKAS(L,NY,NX)/VOLWM(NPH,L,NY,NX)) + ELSE + COH1=0.0 + CAL1=0.0 + CFE1=0.0 + CCA1=0.0 + CMG1=0.0 + CNA1=0.0 + CKA1=0.0 + CSO41=0.0 + CCL1=0.0 + CCO31=0.0 + CHCO31=0.0 + CCO21=0.0 + CALO1=0.0 + CALO2=0.0 + CALO3=0.0 + CALO4=0.0 + CALS1=0.0 + CFEO1=0.0 + CFEO2=0.0 + CFEO3=0.0 + CFEO4=0.0 + CFES1=0.0 + CCAO1=0.0 + CCAC1=0.0 + CCAH1=0.0 + CCAS1=0.0 + CMGO1=0.0 + CMGC1=0.0 + CMGH1=0.0 + CMGS1=0.0 + CNAC1=0.0 + CNAS1=0.0 + CKAS1=0.0 + ENDIF C C PO4 CONCENTRATIONS IN NON-BAND AND BAND SOIL ZONES C - IF(VOLWPO.GT.ZEROS(NY,NX))THEN + IF(VOLWPO.GT.ZEROS2(NY,NX))THEN VOLWPX=31.0*VOLWPO CH0P1=AMAX1(0.0,H0PO4(L,NY,NX)/VOLWPO) CH3P1=AMAX1(0.0,H3PO4(L,NY,NX)/VOLWPO) @@ -377,7 +425,7 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) CC2P1=0.0 CM1P1=0.0 ENDIF - IF(VOLWPB.GT.ZEROS(NY,NX))THEN + IF(VOLWPB.GT.ZEROS2(NY,NX))THEN CH0PB=AMAX1(0.0,H0POB(L,NY,NX)/VOLWPB) CH3PB=AMAX1(0.0,H3POB(L,NY,NX)/VOLWPB) CF1PB=AMAX1(0.0,ZFE1PB(L,NY,NX)/VOLWPB) @@ -399,6 +447,7 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) C C EXCHANGEABLE ION CONCENTRATIONS C + IF(BKVLX.GT.ZEROS(NY,NX))THEN 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) @@ -417,6 +466,23 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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) + ELSE + XHY1=0.0 + XAL1=0.0 + XFE1=0.0 + XCA1=0.0 + XMG1=0.0 + XNA1=0.0 + XKA1=0.0 + XHC1=0.0 + XALO21=0.0 + XFEO21=0.0 + XCOOH=0.0 + PALOH1=0.0 + PFEOH1=0.0 + PCACO1=0.0 + PCASO1=0.0 + ENDIF C C CONVERGENCE TOWARDS SOLUTE EQILIBRIA C @@ -425,16 +491,16 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) CN4B=AMAX1(ZERO,CN4B) CN31=AMAX1(ZERO,CN31) CN3B=AMAX1(ZERO,CN3B) + CHY1=AMAX1(ZERO,10.0**(-(PH(L,NY,NX)-3.0))) + COH1=AMAX1(ZERO,DPH2O/CHY1) + CCO31=AMAX1(ZERO,CCO31) CAL1=AMAX1(ZERO,CAL1) CFE1=AMAX1(ZERO,CFE1) - CHY1=AMAX1(ZERO,CHY1) CCA1=AMAX1(ZERO,AMIN1(CCAMX,CCA1)) CMG1=AMAX1(ZERO,CMG1) CNA1=AMAX1(ZERO,CNA1) CKA1=AMAX1(ZERO,CKA1) - COH1=AMAX1(ZERO,COH1) CSO41=AMAX1(ZERO,CSO41) - CCO31=AMAX1(ZERO,CCO31) CHCO31=AMAX1(ZERO,CHCO31) CCO21=AMAX1(ZERO,CCO21) CALO1=AMAX1(ZERO,CALO1) @@ -611,9 +677,9 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) RHALO2=0.0 RHALO3=0.0 RHALO4=0.0 - R1=AMAX1(ZERO,R1) - P1=AMAX1(ZERO,P1) - P2=AMAX1(ZERO,P2) +C R1=AMAX1(ZERO,R1) +C P1=AMAX1(ZERO,P1) +C P2=AMAX1(ZERO,P2) SPX=SP*R1**NR1/P2**NP2 RPALOX=AMAX1(-PALOH1,TPDX*(P1-SPX)) IF(PX.EQ.AAL1)THEN @@ -627,10 +693,10 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) ELSEIF(PX.EQ.AALO4)THEN RHALO4=RPALOX ENDIF -C IF(I.EQ.180.AND.J.EQ.12)THEN +C IF(I.EQ.256)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 2,AOH1,AHY1,PX,R1,P1,P2,SP,SPX,RPALOX,RHAL1,RHALO1,RHALO2 +C 3,RHALO3,RHALO4,AAL1*AOH1**3,SPALO C ENDIF C C IRON HYDROXIDE @@ -753,7 +819,7 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) C C PHOSPHORUS PRECIPITATION-DISSOLUTION IN NON-BAND SOIL ZONE C - IF(VOLWPO.GT.ZEROS(NY,NX))THEN + IF(VOLWPO.GT.ZEROS2(NY,NX))THEN C C ALUMINUM PHOSPHATE (VARISCITE) C @@ -865,9 +931,9 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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 4,SPALP,CH0P1,CH1P1,CH2P1 C ENDIF -1112 FORMAT(A8,4I4,80E12.4) +1112 FORMAT(A8,4I5,80E12.4) C ENDIF C C IRON PHOSPHATE (STRENGITE) @@ -1043,10 +1109,21 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) ELSEIF(PX.EQ.AH2P1)THEN RHCAH2=RPCAHX ENDIF -C IF(I.EQ.180.AND.J.EQ.12)THEN -C WRITE(*,1112)'APATITE',I,J,L,M,PCAPH1,ACA1 +C IF((I/10)*10.EQ.I.AND.J.EQ.12)THEN +C WRITE(*,1112)'A1',I,L,K,M,A1,A2,A3,FSTR2,CSTR1 +C 2,CSTR2,CC3,CA3,CC2,CA2,CC1,CA1,VOLWM(NPH,L,NY,NX) +C WRITE(*,1112)'APATITE',I,J,L,M,PCAPH1,ACA1,XCA1 C 2,AH0P1,AH1P1,AH2P1,AHY1,AOH1,RPCAHX,RHCAH1,RHCAH2 C 3,SP,SPX,ACA1**5*AH0P1**3*AOH1,SPCAH,SHCAH1,SHCAH2 +C 3,CH0P1,CH1P1,CH2P1,XOH01,XOH11,XOH21,XH1P1,XH2P1 +C 4,RHA0P1,RHA1P1,RHA2P1,RHA3P1 +C 2,RHA4P1,RHF0P1,RHF1P1,RHF2P1 +C 3,RHF3P1,RHF4P1,RPCAD1,3.0*RHCAH1 +C 4,RXH1P,RH1P,RH2P,RF1P,RC1P,RM1P +C 5,RHA0P2,RHA1P2,RHA2P2,RHA3P2 +C 2,RHA4P2,RHF0P2,RHF1P2,RHF2P2 +C 3,RHF3P2,RHF4P2,RHCAD2,3.0*RHCAH2 +C 4,RXH2P,RYH2P,RH2P,RH3P,RF2P,RC2P,RH3P C ENDIF C C MONOCALCIUM PHOSPHATE @@ -1093,7 +1170,7 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) C C PHOSPHORUS PRECIPITATION-DISSOLUTION IN BAND SOIL ZONE C - IF(VOLWPB.GT.ZEROS(NY,NX))THEN + IF(VOLWPB.GT.ZEROS2(NY,NX))THEN C C ALUMINUM PHOSPHATE (VARISCITE) C @@ -1412,12 +1489,12 @@ 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 + IF(VOLWM(NPH,L,NY,NX).GT.ZEROS2(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) + IF(VOLWPO.GT.ZEROS2(NY,NX) 2.AND.XAEC(L,NY,NX).GT.ZEROS(NY,NX))THEN RXOH2=TADAX*(XOH11*AHY1-SXOH2*XOH21)/(XOH11+SXOH2)*VOLWBK RXOH1=TADAX*(XOH01*AHY1-SXOH1*XOH11)/(XOH01+SXOH1)*VOLWBK @@ -1449,7 +1526,7 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) C HPO4--, H+, OH- AND PROTONATED AND NON-PROTONATED -OH C EXCHANGE SITES C - IF(VOLWPB.GT.ZEROS(NY,NX) + IF(VOLWPB.GT.ZEROS2(NY,NX) 2.AND.XAEC(L,NY,NX).GT.ZEROS(NY,NX))THEN RXO2B=TADAX*(XH11B*AHY1-SXOH2*XH21B)/(XH11B+SXOH2)*VOLWBK RXO1B=TADAX*(XH01B*AHY1-SXOH1*XH11B)/(XH01B+SXOH1)*VOLWBK @@ -1526,22 +1603,21 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) C C NH4 EXCHANGE IN NON-BAND AND BAND SOIL ZONES C - RXN4=TADCX*(XN4Q-XN41)*AN41/XN4Q - RXNB=TADCX*(XNBQ-XN4B)*AN4B/XNBQ + RXN4=TADCX*AMIN1((XN4Q-XN41)*AN41/XN4Q,CN41) + RXNB=TADCX*AMIN1((XNBQ-XN4B)*AN4B/XNBQ,CN4B) C C H,AL,FE,CA,MG,NA,K EXCHANGE C - RXHY=TADCX*(XHYQ-XHY1)*AHY1/XHYQ - RXAL=TADCX*(XALQ-XAL1)*AALX/XALQ - RXFE=TADCX*(XFEQ-XFE1)*AFEX/XFEQ - RXCA=TADCX*(XCAQ-XCA1)*ACAX/XCAQ - RXMG=TADCX*(XMGQ-XMG1)*AMGX/XMGQ - RXNA=TADCX*(XNAQ-XNA1)*ANA1/XNAQ - RXKA=TADCX*(XKAQ-XKA1)*AKA1/XKAQ -C IF(I.EQ.180.AND.J.EQ.12)THEN -C WRITE(*,1112)'RXFE',I,J,L,M,CCEC,XCAX,XN41,XHY1,XAL1,XFE1 -C 2,XCA1,XMG1,XNA1,XKA1,AN41,AHY1,AALX,AFEX,ACAX,AMGX,ANA1 -C 3,AKA1,RXN4,RXHY,RXAL,RXFE,RXCA,RXMG,RXNA,RXKA + RXHY=TADCX*AMIN1((XHYQ-XHY1)*AHY1/XHYQ,CHY1) + RXAL=TADCX*AMIN1((XALQ-XAL1)*AALX/XALQ,CAL1) + RXFE=TADCX*AMIN1((XFEQ-XFE1)*AFEX/XFEQ,CFE1) + RXCA=TADCX*AMIN1((XCAQ-XCA1)*ACAX/XCAQ,CCA1) + RXMG=TADCX*AMIN1((XMGQ-XMG1)*AMGX/XMGQ,CMG1) + RXNA=TADCX*AMIN1((XNAQ-XNA1)*ANA1/XNAQ,CNA1) + RXKA=TADCX*AMIN1((XKAQ-XKA1)*AKA1/XKAQ,CKA1) +C IF(I.EQ.256.AND.L.EQ.1)THEN +C WRITE(*,1112)'RXAL',I,J,L,M,RXAL,TADCX,XALQ,XAL1,CAL1 +C 2,AAL1,AALX,CCEC,XCAX,GKCA(L,NY,NX),FX C ENDIF ELSE RXN4=0.0 @@ -1570,12 +1646,12 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) C C NH4-NH3+H IN NON-BAND AND BAND SOIL ZONES C - IF(VOLWNH.GT.ZEROS(NY,NX))THEN + IF(VOLWNH.GT.ZEROS2(NY,NX))THEN RNH4=TSLX*(AHY1*AN31-DPN4*AN41)/(DPN4+AHY1) ELSE RNH4=0.0 ENDIF - IF(VOLWNB.GT.ZEROS(NY,NX))THEN + IF(VOLWNB.GT.ZEROS2(NY,NX))THEN RNHB=TSLX*(AHY1*AN3B-DPN4*AN4B)/(DPN4+AHY1) ELSE RNHB=0.0 @@ -1701,7 +1777,7 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) C C PHOSPHORUS IN NON-BAND SOIL ZONE C - IF(VOLWPO.GT.ZEROS(NY,NX))THEN + IF(VOLWPO.GT.ZEROS2(NY,NX))THEN C C HPO4-H+PO4 C @@ -1770,7 +1846,7 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) C C PHOSPHORUS IN BAND SOIL ZONE C - IF(VOLWPB.GT.ZEROS(NY,NX))THEN + IF(VOLWPB.GT.ZEROS2(NY,NX))THEN C C HPO4-H+PO4 C @@ -1874,12 +1950,7 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) RSO4=-RPCASO-RALS-RFES-RCAS-RMGS-RNAS-RKAS RCO3=-RHCAC3-RHCO3-RCAC-RMGC-RNAC RHCO=-RHCACH-RCO2Q-RCAH-RMGH+RHCO3 - RCO2=-RHCACO +RCO2Q -C WRITE(20,27)'CO3',I,J,L,M,CCO31,CHCO31,CCO21,DPHCO,DPCO2 -C 2,RCO3,RHCAC3,RHCO3,RCAC,RMGC,RNAC -C 3,RHCO,RHCACH,RCO2Q,RCAH,RMGH,RHCO3 -C 4,RCO2,RHCACO,RCO2Q -27 FORMAT(A8,4I4,20F14.7) + RCO2=-RHCACO+RCO2Q RAL1=-RHALO1+RALO1-RALO2 2-(RHA1P1+RHA1P2)*VLPO4(L,NY,NX) 3-(RHA1B1+RHA1B2)*VLPOB(L,NY,NX) @@ -2015,13 +2086,20 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) RHOH=COH2-COH1 CHY1=CHY1+RHHY COH1=COH1+RHOH -C IF(I.EQ.180.AND.J.EQ.12)THEN -C WRITE(*,1111)'CCA1',I,J,L,M,ACA1,AHY1,AH1P1,AH2P1,ACO31,AHCO31 -C 2,RCA,RPCACX,RPCASO,RPCADX,RPCDBX,5.0*(RPCAHX+RPCHBX),RPCAMX -C 2,RPCMBX,RXCA,RCAO,RCAC,RCAH,RCAS,RC0P,RC1P,RC2P,RC0B,RC1B,RC2B -C WRITE(*,1111)'CAL1',I,J,L,M,CAL1,CAL1*A3 -C 2,RAL,RXAL,RALO1,RALS -C 3,CSO41,CALS1,DPALS,A1A23D +C IF(I.EQ.256.AND.L.EQ.1)THEN +C WRITE(*,1111)'CO3',I,J,L,M,CCO31,CHCO31,CCO21,DPHCO,DPCO2 +C 2,A1,A2,RCO3,RHCAC3,RHCO3,RCAC,RMGC,RNAC +C 3,RHCO,RHCACH,RCO2Q,RCAH,RMGH,RHCO3 +C 4,RCO2,RHCACO,AHY1,AHCO31,ACO21,TRCO2(L,NY,NX) +C WRITE(*,1111)'CCA1',I,J,L,M,CCA1,ACA1,AHY1,AH1P1,AH2P1,ACO31 +C 2,XCA1,AHCO31,RCA,RPCACX,RPCASO,RXCA,RCAO,RCAC,RCAH,RCAS +C 2,(RPCADX+RPCAMX+RC0P+RC1P+RC2P)*VLPO4(L,NY,NX) +C 3,(RPCDBX+RPCMBX+RC0B+RC1B+RC2B)*VLPOB(L,NY,NX) +C 4,5.0*(RPCAHX*VLPO4(L,NY,NX)+RPCHBX*VLPOB(L,NY,NX)) +C WRITE(*,1111)'CAL1',I,J,L,M,CAL1,A3,AAL1 +C 2,RAL,RHAL1,RXAL,RALO1,RALS +C 2,RHA0P1,RHA0P2,VLPO4(L,NY,NX) +C 3,RHA0B1,RHA0B2,VLPOB(L,NY,NX) C WRITE(*,1111)'CFEO2',I,J,L,M,CFEO2,CFEO2*A1 C 2,RFE2,RHFEO2,RHF2P1,RHF2P2,RHF2B1 C 2,RHF2B2,RFEO2,RFEO3 @@ -2107,6 +2185,7 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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 + TRCO2(L,NY,NX)=TRCO2(L,NY,NX)+RCO2 TRAL1(L,NY,NX)=TRAL1(L,NY,NX)+RAL1 TRAL2(L,NY,NX)=TRAL2(L,NY,NX)+RAL2 TRAL3(L,NY,NX)=TRAL3(L,NY,NX)+RAL3 @@ -2228,6 +2307,7 @@ 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) + TRCO2(L,NY,NX)=TRCO2(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) @@ -2308,10 +2388,9 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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) + TBCO2(L,NY,NX)=TRCO3(L,NY,NX) + 2+TRCAC(L,NY,NX)+TRMGC(L,NY,NX)+TRNAC(L,NY,NX)+TRCACO(L,NY,NX) + 3+2.0*(TRHCO(L,NY,NX)+TRCAH(L,NY,NX)+TRMGH(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)) @@ -2331,7 +2410,14 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) 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 IF(L.EQ.11)THEN +C WRITE(*,1111)'TRCO2',I,J,L,M,TRCO2(L,NY,NX),TRCO3(L,NY,NX) +C 2,TRHCO(L,NY,NX),TRCAC(L,NY,NX),TRMGC(L,NY,NX) +C 2,TRNAC(L,NY,NX),TRCAH(L,NY,NX) +C 2,TRMGH(L,NY,NX),TRCACO(L,NY,NX),VOLWM(NPH,L,NY,NX),RCO2 +C 3,RHCO,RHCACH,RCO2Q,RCAH,RMGH,RHCO3,AHY1,AHCO31,ACO21,DPCO2 +C WRITE(*,1111)'TBION',I,J,L,M,TBION(L,NY,NX) +C ENDIF C C IF NO SALTS IS SELECTED IN SITE FILE THEN A SUBSET C OF THE EQUILIBRIA REACTIONS ARE SOLVED: MOSTLY THOSE @@ -2344,7 +2430,11 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) C FOR THEIR EQUILIBRIUM CONSTANTS USING CURRENT C ION CONCENTRATION C + IF(BKVLX.GT.ZEROS(NY,NX))THEN CCEC=AMAX1(ZERO,XCEC(L,NY,NX)/BKVLX) + ELSE + CCEC=ZERO + ENDIF 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 @@ -2373,7 +2463,7 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) C C PHOSPHORUS TRANSFORMATIONS IN NON-BAND SOIL ZONE C - IF(VOLWPO.GT.ZEROS(NY,NX))THEN + IF(VOLWPO.GT.ZEROS2(NY,NX))THEN C C ALUMINUM PHOSPHATE (VARISCITE) C @@ -2402,7 +2492,7 @@ 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 IF((I/30)*30.EQ.i.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 @@ -2425,7 +2515,7 @@ 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 + IF(VOLWM(NPH,L,NY,NX).GT.ZEROS2(NY,NX))THEN VOLWBK=AMIN1(1.0,BKVL(L,NY,NX)/VOLWM(NPH,L,NY,NX)) ELSE VOLWBK=1.0 @@ -2487,12 +2577,12 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) C 2,CH2PA,CH2PF,CH2PD,CH2PH,CH2PM,RPALPX,RPFEPX,RPCADX,RPCAHX,RPCAMX C 3,XH2P1,RXH2P,RYH2P C 3,CAL1,CFE1,CCA1,CHY1,COH1 -2222 FORMAT(A8,3I4,40F14.7) +2222 FORMAT(A8,3I4,40E12.4) C ENDIF C C PHOSPHORUS PRECIPITATION-DISSOLUTION IN BAND SOIL ZONE C - IF(VOLWPB.GT.ZEROS(NY,NX))THEN + IF(VOLWPB.GT.ZEROS2(NY,NX))THEN C C ALUMINUM PHOSPHATE (VARISCITE) C @@ -2608,8 +2698,8 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) C C NH4 EXCHANGE IN NON-BAND AND BAND SOIL ZONES C - RXN4=TADC*(XN4Q-XN41)*CN41/XN4Q - RXNB=TADC*(XNBQ-XN4B)*CN4B/XNBQ + RXN4=TADC*AMIN1((XN4Q-XN41)*CN41/XN4Q,CN41) + RXNB=TADC*AMIN1((XNBQ-XN4B)*CN4B/XNBQ,CN4B) ELSE RXN4=0.0 RXNB=0.0 @@ -2623,22 +2713,22 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) C C NH4-NH3+H IN NON-BAND AND BAND SOIL ZONES C - IF(VOLWNH.GT.ZEROS(NY,NX))THEN + IF(VOLWNH.GT.ZEROS2(NY,NX))THEN RNH4=(CHY1*CN31-DPN4*CN41)/(DPN4+CHY1) ELSE RNH4=0.0 ENDIF - IF(VOLWNB.GT.ZEROS(NY,NX))THEN + IF(VOLWNB.GT.ZEROS2(NY,NX))THEN RNHB=(CHY1*CN3B-DPN4*CN4B)/(DPN4+CHY1) ELSE RNHB=0.0 ENDIF -C IF(J.EQ.12.AND.L.LE.6)THEN +C IF(IYRC.EQ.2012.AND.I.EQ.151.AND.NX.EQ.1)THEN C WRITE(*,2222)'RNH4',I,J,L,RNH4,CHY1,CN31,DPN4,CN41 C 2,RXN4,XN41,VOLWNH,RNHB,CN3B,CN4B,VOLWNB,RXNB,XN4B,FN4X C 2,CN41*VOLWNH,XN41*VOLWNH,CN4B*VOLWNB,XN4B*VOLWNB C 3,(CCA1)**0.5*XN41/(CN41*XCAQ),(CCA1)**0.5*XN4B/(CN4B*XCAQ) -C 4,RN4X,RN3X,RNBX,R3BX +C 4,RN4X,RN3X,RNBX,R3BX,ZEROS2(NY,NX) C ENDIF C C TOTAL ION FLUXES FOR ALL REACTIONS ABOVE @@ -2693,10 +2783,11 @@ 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 -C IF(L.EQ.1)THEN -C WRITE(20,24)'RHP1',I,J,L,RHP1,RH2P,RXH1P +C IF(IYRC.EQ.2012.AND.I.EQ.151.AND.NX.EQ.1)THEN +C WRITE(*,24)'RN4S',I,J,L,RN4S,RN3S,RNH4,RXN4 +C WRITE(*,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 WRITE(*,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) @@ -2728,7 +2819,8 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) DPNH4(NY,NX)=DPNH4(NY,NX)+DPFLW DPNHB(L,NY,NX)=DPNHB(L,NY,NX)+DPFLW IF(DPNHB(L,NY,NX).GT.DLYR(3,L,NY,NX))THEN - DPNHB(L+1,NY,NX)=DPNHB(L+1,NY,NX)+(DPNHB(L,NY,NX)-DLYR(3,L,NY,NX)) + DPNHB(L+1,NY,NX)=DPNHB(L+1,NY,NX) + 2+(DPNHB(L,NY,NX)-DLYR(3,L,NY,NX)) WDNHB(L+1,NY,NX)=WDNHB(L,NY,NX) DPNHB(L,NY,NX)=DLYR(3,L,NY,NX) ELSEIF(DPNHB(L,NY,NX).LT.0.0)THEN @@ -2742,8 +2834,12 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) C FROM BAND WIDTH X DEPTH C XVLNH4=VLNH4(L,NY,NX) + IF(DLYR(3,L,NY,NX).GT.ZERO)THEN VLNHB(L,NY,NX)=AMIN1(0.999,WDNHB(L,NY,NX)/ROWN(NY,NX) 2*DPNHB(L,NY,NX)/DLYR(3,L,NY,NX)) + ELSE + VLNHB(L,NY,NX)=0.0 + ENDIF VLNH4(L,NY,NX)=1.0-VLNHB(L,NY,NX) FVLNH4=AMIN1(0.0,(VLNH4(L,NY,NX)-XVLNH4)/XVLNH4) C @@ -2807,8 +2903,12 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) C FROM BAND WIDTH X DEPTH C XVLNO3=VLNO3(L,NY,NX) + IF(DLYR(3,L,NY,NX).GT.ZERO)THEN VLNOB(L,NY,NX)=AMIN1(0.999,WDNOB(L,NY,NX)/ROWO(NY,NX) 2*DPNOB(L,NY,NX)/DLYR(3,L,NY,NX)) + ELSE + VLNOB(L,NY,NX)=0.0 + ENDIF VLNO3(L,NY,NX)=1.0-VLNOB(L,NY,NX) FVLNO3=AMIN1(0.0,(VLNO3(L,NY,NX)-XVLNO3)/XVLNO3) C @@ -2867,8 +2967,12 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) C FROM BAND WIDTH X DEPTH C XVLPO4=VLPO4(L,NY,NX) + IF(DLYR(3,L,NY,NX).GT.ZERO)THEN VLPOB(L,NY,NX)=AMIN1(0.999,WDPOB(L,NY,NX)/ROWP(NY,NX) 2*DPPOB(L,NY,NX)/DLYR(3,L,NY,NX)) + ELSE + VLPOB(L,NY,NX)=0.0 + ENDIF VLPO4(L,NY,NX)=1.0-VLPOB(L,NY,NX) FVLPO4=AMIN1(0.0,(VLPO4(L,NY,NX)-XVLPO4)/XVLPO4) C @@ -3041,6 +3145,7 @@ 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 + TRCO2(L,NY,NX)=TRCO2(L,NY,NX)*12.0 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 @@ -3054,26 +3159,21 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) TRH2P(L,NY,NX)=TRH2P(L,NY,NX)*31.0 TRH1B(L,NY,NX)=TRH1B(L,NY,NX)*31.0 TRH2B(L,NY,NX)=TRH2B(L,NY,NX)*31.0 -C IF(L.EQ.1)THEN -C WRITE(20,9984)'TRN3S',I,J,L,TRN3S(L,NY,NX),TRN3B(L,NY,NX) -C 2,RSNUAA,RSNUBA,RSNUBB + ENDIF +C IF(I.EQ.116)THEN +C WRITE(*,9984)'TRN3S',I,J,L,TRN4S(L,NY,NX),TRN3S(L,NY,NX) 9984 FORMAT(A8,3I4,20F14.7) C ENDIF - ENDIF -9985 CONTINUE +9985 CONTINUE C C SURFACE RESIDUE C - IF(VOLWM(NPH,0,NY,NX).GT.ZEROS(NY,NX))THEN - IF(BKVL(0,NY,NX).GT.ZEROS(NY,NX))THEN + IF(VOLWM(NPH,0,NY,NX).GT.ZEROS2(NY,NX))THEN BKVLX=BKVL(0,NY,NX) - ELSE - BKVLX=VOLWM(NPH,0,NY,NX) - ENDIF C C UREA HYDROLYSIS IN SURFACE RESIDUE C - IF(VOLQ(0,NY,NX).GT.ZEROS(NY,NX))THEN + IF(VOLQ(0,NY,NX).GT.ZEROS2(NY,NX))THEN COMA=AMIN1(0.1E+06,TOQCK(0,NY,NX)/VOLQ(0,NY,NX)) ELSE COMA=0.1E+06 @@ -3121,13 +3221,17 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) RSN3AA=SPNH3*ZNH3FA(0,NY,NX) RSNUAA=RSNUA*THETW(0,NY,NX) RSNOAA=SPNO3*ZNO3FA(0,NY,NX)*THETW(0,NY,NX) - IF(VOLWM(NPH,0,NY,NX).GT.ZEROS(NY,NX))THEN + IF(VOLWM(NPH,0,NY,NX).GT.ZEROS2(NY,NX))THEN VOLWMX=14.0*VOLWM(NPH,0,NY,NX) RN4X=(XNH4S(0,NY,NX)+14.0*RSN4AA)/VOLWMX RN3X=14.0*RSNUAA/VOLWMX CN41=AMAX1(ZERO,ZNH4S(0,NY,NX)/VOLWMX+RN4X) CN31=AMAX1(ZERO,ZNH3S(0,NY,NX)/VOLWMX+RN3X) + IF(BKVLX.GT.ZEROS(NY,NX))THEN XN41=AMAX1(ZERO,XN4(0,NY,NX)/BKVLX) + ELSE + XN41=0.0 + ENDIF VOLWMP=31.0*VOLWM(NPH,0,NY,NX) RH1PX=XH1PS(0,NY,NX)/VOLWMP RH2PX=XH2PS(0,NY,NX)/VOLWMP @@ -3147,11 +3251,19 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) C C PHOSPHORUS TRANSFORMATIONS IN SURFACE RESIDUE C + IF(BKVLX.GT.ZEROS(NY,NX))THEN 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) + ELSE + PCAPM1=0.0 + PCAPD1=0.0 + PCAPH1=0.0 + PALPO1=0.0 + PFEPO1=0.0 + ENDIF CHY1=AMAX1(ZERO,10.0**(-(PH(0,NY,NX)-3.0))) COH1=AMAX1(ZERO,DPH2O/CHY1) CAL1=AMAX1(ZERO,SPALO/COH1**3) @@ -3209,10 +3321,10 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) C EQUILIBRIUM X-CA CONCENTRATION FROM CEC AND CATION C CONCENTRATIONS C - IF(VOLWM(NPH,0,NY,NX).GT.ZEROS(NY,NX))THEN - CCEC0=AMAX1(0.0,COOH*ORGC(0,NY,NX)/BKVLX) + IF(BKVLX.GT.ZEROS(NY,NX))THEN + CCEC0=AMAX1(ZERO,COOH*ORGC(0,NY,NX)/BKVLX) ELSE - CCEC0=0.0 + CCEC0=ZERO ENDIF CALX=AMAX1(ZERO,CAL1)**0.333 CFEX=AMAX1(ZERO,CFE1)**0.333 @@ -3239,11 +3351,12 @@ SUBROUTINE solute(I,J,NHW,NHE,NVN,NVS) RXN4=TADC0*(XN4Q-XN41) RNH4=(CHY1*CN31-DPN4*CN41)/(DPN4+CHY1) C IF(J.EQ.12)THEN -C WRITE(20,2223)'RXN4',I,J,RXN4,CN41,XN41,CCAX,CCA1,CCO20,CCO31 +C WRITE(*,2223)'RXN4',I,J,RXN4,CN41,XN41,TADC0,XN4Q +C 2,CCAX,CCA1,CCO20,CCO31 C 2,XCAQ,CCEC0,FN4X,FCAQ,GKC4(NU(NY,NX),NY,NX),PH(0,NY,NX),CHY1,RNH4 C 3,CN31,DPN4,ZNH4S(0,NY,NX),XN4(0,NY,NX),14.0*RSN4AA,RN4X,BKVLX C 4,BKVL(0,NY,NX),VOLWM(NPH,0,NY,NX) -2223 FORMAT(A8,2I4,30F14.7) +2223 FORMAT(A8,2I4,30E12.4) C ENDIF ELSE RSN4AA=0.0 diff --git a/f77src/starte.f b/f77src/starte.f old mode 100755 new mode 100644 index 4e598db..6ca72a3 --- a/f77src/starte.f +++ b/f77src/starte.f @@ -28,7 +28,7 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) 3,ACO2X=0.14,ACH4X=0.14,AOXYX=0.31,AN2GX=0.23,AN2OX=0.23 4,ANH3X=0.07,AH2GX=0.14) PARAMETER (DPH2O=6.5E-09,SPALO=6.5E-22,SPFEO=6.5E-27 - 2,SPCAC=5.0E-03,SPCAS=1.4E+01,SPALP=1.0E-15,SPFEP=1.0E-20 + 2,SPCAC=3.8E-03,SPCAS=1.4E+01,SPALP=1.0E-15,SPFEP=1.0E-20 3,SPCAM=7.0E+07,SPCAD=1.0E-01,SPCAH=2.3E-31,SXOH2=4.5E-05 4,SXOH1=1.1E-06,SXH2P=2.0E+07,SXH1P=2.0E+07 5,DPCO2=4.2E-04,DPHCO=5.6E-08,DPN4=5.7E-07 @@ -63,7 +63,8 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) 7,SHF4P2=SYF4P2*DPH2O**2,SHCAD2=SPCAD/DPH2P,SYCAD2=SHCAD2*DPH2O 8,SHCAH1=SPCAH/(DPH2O*DPH1P**3),SYCAH1=SHCAH1*DPH2O**4 9,SHCAH2=SHCAH1/DPH2P**3,SYCAH2=SHCAH2*DPH2O**7) - PARAMETER (TPD=0.1,TAD=0.1,TSL=0.1,A0=1.0,COOH=2.5E-02) + PARAMETER (TPD=5.0E-02,TAD=5.0E-02,TSL=0.5,A0=1.0,COOH=2.5E-02 + 2,CALMX=10.0,CFEMX=10.0,CCAMX=10.0,MRXN=1000) C C INITIALIZE CATION AND ANION CONCENTRATIONS C IN PRECIPITATION (K=1), IRRIGATION (K=2) AND SOIL (K=3) @@ -79,6 +80,9 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) DO 1200 I=1,366 DO 1200 L=NU(NY,NX),NL(NY,NX) DO 2000 K=1,3 +C +C INITIALIZE RAINFALL +C IF(K.EQ.1.AND.I.EQ.1.AND.L.EQ.1)THEN PH1=PHR(NY,NX) CHY1=10.0**(-(PHR(NY,NX)-3.0)) @@ -94,6 +98,9 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) CKAZ=CKAR(NY,NX) CSOZ=CSOR(NY,NX) CCLZ=CCLR(NY,NX) +C +C INITIALIZE IRRIGATION WATER +C ELSEIF(K.EQ.2.AND.L.EQ.1)THEN PH1=PHQ(I,NY,NX) CHY1=10.0**(-(PHQ(I,NY,NX)-3.0)) @@ -109,6 +116,9 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) CKAZ=CKAQ(I,NY,NX) CSOZ=CSOQ(I,NY,NX) CCLZ=CCLQ(I,NY,NX) +C +C INITIALIZE SOIL WATER +C 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) @@ -134,8 +144,8 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) CFEOHX=CFEOH(L,NY,NX) CCACOX=CCACO(L,NY,NX) 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) + XCEC(L,NY,NX)=AMAX1(CN4X,CEC(L,NY,NX))*BKVLX + XAEC(L,NY,NX)=AMAX1(CPOX,AEC(L,NY,NX))*BKVLX CHY1=10.0**(-(PH(L,NY,NX)-3.0)) COH1=DPH2O/CHY1 CN4Z=CN4X @@ -221,17 +231,17 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) CN31=ZERO ENDIF IF(CALZ.LT.0.0)THEN - CAL1=AMIN1(1.0E+03,SPALO/(COH1**3*A3)) + CAL1=AMIN1(CALMX,SPALO/(COH1**3*A3)) ELSE CAL1=AMIN1(CALZ,SPALO/(COH1**3*A3)) ENDIF IF(CFEZ.LT.0.0)THEN - CFE1=AMIN1(1.0E+03,SPFEO/(COH1**3*A3)) + CFE1=AMIN1(CFEMX,SPFEO/(COH1**3*A3)) ELSE CFE1=AMIN1(CFEZ,SPFEO/(COH1**3*A3)) ENDIF IF(CCAZ.LT.0.0)THEN - CCA1=AMIN1(1.0E+03,SPCAC/(CCO31*A2**2)) + CCA1=AMIN1(CCAMX,SPCAC/(CCO31*A2**2)) ELSE CCA1=AMIN1(CCAZ,SPCAC/(CCO31*A2**2)) ENDIF @@ -350,11 +360,6 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) 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 @@ -398,7 +403,7 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) C IF SALT OPTION IS SELECTED C IF(ISALT(NY,NX).NE.0)THEN - DO 1000 M=1,100 + DO 1000 M=1,MRXN CCO21=AMAX1(ZERO,CCO21) CCO31=CCO21*DPCO3*A0/(CHY1**2*A2) CHCO31=CCO21*DPCO2*A0/(CHY1*A1) @@ -582,8 +587,9 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) RHALO4=RPALOX ENDIF 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 WRITE(*,1112)'ALOHI',I,NX,NY,L,K,M,PALOH1,AAL1 +C 2,AALO1,AALO2,AALO3,AALO4,AOH1,CAL1,CALO1,CALO2,CALO3,CALO4 +C 2,COH1,R1,P1,P2,SP,SPX,RPALOX,RHAL1,RHALO1,RHALO2,RHALO3,RHALO4 C 3,AAL1*AOH1**3,SPALO,A1 C ENDIF C @@ -648,7 +654,8 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) RHFEO4=RPFEOX ENDIF C IF((M/25)*25.EQ.M)THEN -C WRITE(*,1112)'FEOHI',I,L,K,M,PFEOH1,AFE1,AFEO1,AFEO2,AFEO3,AFEO4 +C WRITE(*,1112)'FEOHI',I,NX,NY,L,K,M,PFEOH1,AFE1 +C 2,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 @@ -700,7 +707,8 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) 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 WRITE(*,1112)'CALC',I,J,NX,NY,,L,K,M,PCASO1 +C 2,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 @@ -815,11 +823,12 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) ENDIF ENDIF C IF((M/25)*25.EQ.M)THEN -C WRITE(*,1112)'ALPO4I',I,L,K,M,PALPO1,AAL1,AALO1,AALO2,AALO3,AALO4 +C WRITE(*,1112)'ALPO4I',I,NX,NY,L,K,M,PALPO1,AAL1 +C 2,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) +1112 FORMAT(A8,6I5,80E12.4) C ENDIF C C IRON PHOSPHATE (STRENGITE) @@ -929,7 +938,8 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) 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 WRITE(*,1112)'FEPO4I',I,NX,NY,L,K,M,PFEPO1,AFE1 +C 2,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 @@ -964,7 +974,7 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) RHCAD2=RPCADX ENDIF C IF((M/10)*10.EQ.M)THEN -C WRITE(*,1112)'CAPO4',I,J,L,M,PCAPM1,PCAPD1,CCA1 +C WRITE(*,1112)'CAPO4',I,J,NX,NY,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 @@ -995,11 +1005,6 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) ELSEIF(PX.EQ.AH2P1)THEN RHCAH2=RPCAHX ENDIF -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 @@ -1016,7 +1021,7 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) ELSE VOLWBK=1.0 ENDIF - IF(AEC(L,NY,NX).GT.ZEROS(NY,NX))THEN + IF(XAEC(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 @@ -1028,6 +1033,11 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) C SPH1P=SXH1P*DPH2O/DPH2P RXH1P=TAD*(XOH11*AH2P1-SPH1P*XH1P1)/(XOH11+SPH1P)*VOLWBK + XOH01=XOH01-RXOH1 + XOH11=XOH11+RXOH1-RXOH2-RYH2P-RXH1P + XOH21=XOH21+RXOH2-RXH2P + XH1P1=XH1P1+RXH1P + XH2P1=XH2P1+RXH2P+RYH2P ELSE RXOH2=0.0 RXOH1=0.0 @@ -1035,14 +1045,10 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) RYH2P=0.0 RXH1P=0.0 ENDIF - XOH01=XOH01-RXOH1 - XOH11=XOH11+RXOH1-RXOH2-RYH2P-RXH1P - XOH21=XOH21+RXOH2-RXH2P - XH1P1=XH1P1+RXH1P - XH2P1=XH2P1+RXH2P+RYH2P C C CATION EXCHANGE C + IF(XCEC(L,NY,NX).GT.ZEROS(NY,NX))THEN AALX=AAL1**0.333 AFEX=AFE1**0.333 ACAX=ACA1**0.500 @@ -1073,14 +1079,14 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) 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 + RXN4=TAD*AMIN1((XN4Q-XN41)*AN41/XN4Q,CN41) + RXHY=TAD*AMIN1((XHYQ-XHY1)*AHY1/XHYQ,CHY1) + RXAL=TAD*AMIN1((XALQ-XAL1)*AALX/XALQ,CAL1) + RXFE=TAD*AMIN1((XFEQ-XFE1)*AFEX/XFEQ,CFE1) + RXCA=TAD*AMIN1((XCAQ-XCA1)*ACAX/XCAQ,CCA1) + RXMG=TAD*AMIN1((XMGQ-XMG1)*AMGX/XMGQ,CMG1) + RXNA=TAD*AMIN1((XNAQ-XNA1)*ANA1/XNAQ,CNA1) + RXKA=TAD*AMIN1((XKAQ-XKA1)*AKA1/XKAQ,CKA1) XN41=XN41+RXN4 XHY1=XHY1+RXHY XAL1=XAL1+RXAL @@ -1089,9 +1095,20 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) XMG1=XMG1+RXMG XNA1=XNA1+RXNA XKA1=XKA1+RXKA + ELSE + 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 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 WRITE(*,1112)'RXALI',I,NX,NY,L,K,M +C 2,RXAL,TAD,XALQ,XAL1,AALX,CCEC,XCAX,FX +C 3,GKCA(L,NY,NX),XCEC(L,NY,NX),BKVLX,VOLA(L,NY,NX) C ENDIF C C ORGANIC MATTER @@ -1352,13 +1369,40 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) CC1P1=CC1P1+RC1P CC2P1=CC2P1+RC2P CM1P1=CM1P1+RM1P + IF(K.EQ.3.AND.(M/1)*1.EQ.M)THEN +C WRITE(*,1112)'A1I',I,NX,NY,L,K,M,A1,A2,A3,FSTR2,CSTR1 +C 2,CSTR2,CC3,CA3,CC2,CA2,CC1,CA1,VOLW(L,NY,NX) +C WRITE(*,1112)'ALPO4I',I,NX,NY,L,K,M,PALPO1,AAL1 +C 2,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,CH0P1,CH1P1,CH2P1,CH3P1,RHP0,RHP1,RHP2,RHP3 +C 5,RAL,RHAL1,RHA0P1,RHA0P2,RALO1,RALS,RXAL +C WRITE(*,1112)'FEPO4I',I,NX,NY,L,K,M,PFEPO1,AFE1 +C 2,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 WRITE(*,1112)'APATITEI',I,NX,NY,L,K,M,PCAPH1,ACA1,XCA1 +C 2,AH0P1,AH1P1,AH2P1,AHY1,AOH1,RPCAHX,RHCAH1,RHCAH2 +C 3,SP,SPX,ACA1**5*AH0P1**3*AOH1,SPCAH,SHCAH1,SHCAH2 +C 3,CH0P1,CH1P1,CH2P1,XOH01,XOH11,XOH21,XH1P1,XH2P1 +C 4,RHA0P1,RHA1P1,RHA2P1,RHA3P1 +C 2,RHA4P1,RHF0P1,RHF1P1,RHF2P1 +C 3,RHF3P1,RHF4P1,RPCAD1,3.0*RHCAH1 +C 4,RXH1P,RH1P,RH2P,RF1P,RC1P,RM1P +C 5,RHA0P2,RHA1P2,RHA2P2,RHA3P2 +C 2,RHA4P2,RHF0P2,RHF1P2,RHF2P2 +C 3,RHF3P2,RHF4P2,RHCAD2,3.0*RHCAH2 +C 4,RXH2P,RYH2P,RH2P,RH3P,RF2P,RC2P,RH3P + ENDIF 1000 CONTINUE - ELSE C C CONVERGE TOWARDS ALL SOLUBILITY EQUILIBRIA C IF SALT OPTION IS NOT SELECTED C - DO 1100 M=1,100 + ELSE + DO 1100 M=1,MRXN CCO21=AMAX1(ZERO,CCO21) CCO31=CCO21*DPCO3*A0/(CHY1**2*A2) CHCO31=CCO21*DPCO2*A0/(CHY1*A1) @@ -1397,27 +1441,26 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) ELSE VOLWBK=1.0 ENDIF - IF(AEC(L,NY,NX).GT.ZEROS(NY,NX))THEN + IF(XAEC(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 + XOH11=XOH11-RYH2P-RXH1P + XOH21=XOH21-RXH2P + XH1P1=XH1P1+RXH1P + XH2P1=XH2P1+RXH2P+RYH2P ELSE RXH2P=0.0 RYH2P=0.0 RXH1P=0.0 ENDIF - XOH11=XOH11-RYH2P-RXH1P - XOH21=XOH21-RXH2P - XH1P1=XH1P1+RXH1P - XH2P1=XH2P1+RXH2P+RYH2P C C CATION EXCHANGE C IF(XCEC(L,NY,NX).GT.ZEROS(NY,NX))THEN - CCEC=AMAX1(ZERO,XCEC(L,NY,NX)/BKVLX) CALX=CAL1**0.333 CFEX=CFE1**0.333 CCAX=CCA1**0.500 @@ -1441,15 +1484,11 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) FX=0.0 ENDIF XN4Q=FX*XN4Q - RXN4=TSL*(XN4Q-XN41)*CN41/XN4Q + RXN4=TSL*AMIN1((XN4Q-XN41)*CN41/XN4Q,CN41) + XN41=XN41+RXN4 ELSE RXN4=0.0 ENDIF - XN41=XN41+RXN4 -C WRITE(*,2224)'RXN4E',K,L,M,RXN4,CN41,XN4Q,XN41,XCAX,CCEC,FX -C 2,XHYQ,XALQ,XFEQ,XCAQ,XMGQ,XNAQ,XKAQ,CALX,CFEX,CCAX,CMGX,CNA1,CKA1 -C 3,CN4X,CNH4(L,NY,NX),XCEC(L,NY,NX) -2224 FORMAT(A8,3I4,40E12.4) ELSE RPALPX=0.0 RPFEPX=0.0 @@ -1651,7 +1690,7 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) CKASU(L,NY,NX)=CKAS1 CH0PU(L,NY,NX)=CH0P1 CH1PU(L,NY,NX)=CH1P1 - CPOU(L,NY,NX)=CH2P1 + CH2PU(L,NY,NX)=CH2P1 CH3PU(L,NY,NX)=CH3P1 CF1PU(L,NY,NX)=CF1P1 CF2PU(L,NY,NX)=CF2P1 @@ -1694,14 +1733,15 @@ SUBROUTINE starte(NHW,NHE,NVN,NVS) ZNH3B(L,NY,NX)=CN3U(L,NY,NX)*VOLW(L,NY,NX)*VLNHB(L,NY,NX)*14.0 ZNO3S(L,NY,NX)=CNOU(L,NY,NX)*VOLW(L,NY,NX)*VLNO3(L,NY,NX)*14.0 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) + H2PO4(L,NY,NX)=CH2PU(L,NY,NX)*VOLW(L,NY,NX)*VLPO4(L,NY,NX)*31.0 + H2POB(L,NY,NX)=CH2PU(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)*31.0 + H1POB(L,NY,NX)=CH1PU(L,NY,NX)*VOLW(L,NY,NX)*VLPOB(L,NY,NX)*31.0 ZNO2S(L,NY,NX)=0.0 ZNO2B(L,NY,NX)=0.0 C WRITE(*,444)'ZNH4S',NX,NY,L,ZNH4S(L,NY,NX),CN4U(L,NY,NX) -C 2,VOLW(L,NY,NX),VLNH4(L,NY,NX) +C 2,VOLW(L,NY,NX),VLNH4(L,NY,NX),H2PO4(L,NY,NX),CH2PU(L,NY,NX) +C 3,VLPO4(L,NY,NX) 444 FORMAT(A8,3I4,12E12.4) C C INITIAL STATE VARIABLES FOR CATIONS, ANIONS AND ION PAIRS IN SOIL diff --git a/f77src/startq.f b/f77src/startq.f old mode 100755 new mode 100644 index fd1c392..f1340b7 --- a/f77src/startq.f +++ b/f77src/startq.f @@ -1,737 +1,742 @@ - 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)=33.0+3.0*ZTYP(NZ,NY,NX) - ELSE - HTC(NZ,NY,NX)=27.0+3.0*ZTYP(NZ,NY,NX) - ENDIF - ELSE - HTC(NZ,NY,NX)=33.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 + 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)=30.0+3.0*ZTYP(NZ,NY,NX) + SSTX(NZ,NY,NX)=0.002 + ELSE + HTC(NZ,NY,NX)=27.0+3.0*ZTYP(NZ,NY,NX) + SSTX(NZ,NY,NX)=0.002 + ENDIF + ELSE + HTC(NZ,NY,NX)=27.0+3.0*ZTYP(NZ,NY,NX) + SSTX(NZ,NY,NX)=0.005 + 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 old mode 100755 new mode 100644 index 725af75..d1a9fc2 --- a/f77src/starts.f +++ b/f77src/starts.f @@ -41,11 +41,21 @@ SUBROUTINE starts(NHW,NHE,NVN,NVS) DATA BKRS/0.0500,0.0167,0.0167/ DATA FORGC,FVLWB,FCH4F/0.1E+06,1.0,0.01/ DATA PSIHY/-2500.0/ + NPH=NPX + NPT=NPY + NPG=NPH*NPT + NPR=10 + XNPH=1.0/NPH + XNPT=1.0/NPT + XNPG=1.0/NPG + XNPR=1.0/NPR + XNPD=600.0*XNPG NDIM=1 IF(NHE.GT.NHW)NDIM=NDIM+1 IF(NVS.GT.NVN)NDIM=NDIM+1 XDIM=1.0/NDIM ZERO=1.0E-16 + ZERO2=1.0E-08 TAREA=0.0 THETX=2.5E-03 THETPI=0.00 @@ -175,6 +185,7 @@ SUBROUTINE starts(NHW,NHE,NVN,NVS) DO 9985 NX=NHW,NHE DO 9980 NY=NVN,NVS ZEROS(NY,NX)=ZERO*DH(NY,NX)*DV(NY,NX) + ZEROS2(NY,NX)=ZERO2*DH(NY,NX)*DV(NY,NX) GAZI(NY,NX)=ASP(NY,NX)/57.29577951 GSINA(NY,NX)=ABS(SIN(GAZI(NY,NX))) GCOSA(NY,NX)=ABS(COS(GAZI(NY,NX))) @@ -186,12 +197,12 @@ SUBROUTINE starts(NHW,NHE,NVN,NVS) OMEGAG(N,NY,NX)=AMAX1(0.0,AMIN1(1.0,GCOS(NY,NX)*YSIN(N) 2+GSIN(NY,NX)*YCOS(N)*DGAZI)) 240 CONTINUE - IF(ASP(NY,NX).GT.90.0.AND.ASP(NY,NX).LT.270.0)THEN + IF(ASP(NY,NX).GT.90.0.AND.ASP(NY,NX).LE.270.0)THEN SLOPE(1,NY,NX)=SIN(SL(1,NY,NX)/57.29577951) ELSE SLOPE(1,NY,NX)=-SIN(SL(1,NY,NX)/57.29577951) ENDIF - IF(ASP(NY,NX).GT.0.0.AND.ASP(NY,NX).LT.180.0)THEN + IF(ASP(NY,NX).GT.0.0.AND.ASP(NY,NX).LE.180.0)THEN SLOPE(2,NY,NX)=SIN(SL(2,NY,NX)/57.29577951) ELSE SLOPE(2,NY,NX)=-SIN(SL(2,NY,NX)/57.29577951) @@ -203,22 +214,24 @@ SUBROUTINE starts(NHW,NHE,NVN,NVS) 2+0.5*DV(NY,NX)*SLOPE(2,NY,NX) ELSE ALT(NY,NX)=ALT(NY-1,NX) - 2+0.5*DH(NY,NX)*SLOPE(1,NY,NX) - 4+0.5*DV(NY,NX)*(SLOPE(2,NY,NX)) - 5+0.5*DV(NY-1,NX)*SLOPE(2,NY-1,NX) + 2+1.0*DH(NY,NX)*SLOPE(1,NY,NX) + 4+0.5*DV(NY-1,NX)*(SLOPE(2,NY-1,NX)) + 5+0.5*DV(NY,NX)*SLOPE(2,NY,NX) ENDIF ELSE IF(NY.EQ.NVN)THEN ALT(NY,NX)=ALT(NY,NX-1) - 2+0.5*DH(NY,NX)*SLOPE(1,NY,NX) - 3+0.5*DH(NY,NX-1)*SLOPE(1,NY,NX-1) + 2+0.5*DH(NY,NX-1)*SLOPE(1,NY,NX-1) + 3+0.5*DH(NY,NX)*SLOPE(1,NY,NX) + 2+0.5*DV(NY,NX-1)*SLOPE(2,NY,NX-1) + 3+0.5*DV(NY,NX)*SLOPE(2,NY,NX) ELSE ALT(NY,NX)=(ALT(NY,NX-1) - 2+0.5*DH(NY,NX)*SLOPE(1,NY,NX) - 3+0.5*DH(NY,NX-1)*SLOPE(1,NY,NX-1) + 2+0.5*DH(NY,NX-1)*SLOPE(1,NY,NX-1) + 3+0.5*DH(NY,NX)*SLOPE(1,NY,NX) 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 + 4+0.5*DV(NY-1,NX)*SLOPE(2,NY-1,NX) + 5+0.5*DV(NY,N)*SLOPE(2,NY,NX))/2.0 ENDIF ENDIF IF(NX.EQ.NHW.AND.NY.EQ.NVN)THEN @@ -226,9 +239,9 @@ SUBROUTINE starts(NHW,NHE,NVN,NVS) ELSE ALTY=MAX(ALTY,ALT(NY,NX)) ENDIF -C WRITE(18,1111)'ALT',NX,NY,ALT(NY,NX) -C 2,DH(NY,NX),DV(NY,NX),ASP(NY,NX),GSIN(NY,NX) -C 3,SLOPE(1,NY,NX),SLOPE(2,NY,NX) + WRITE(*,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 @@ -442,12 +455,13 @@ SUBROUTINE starts(NHW,NHE,NVN,NVS) C C LAYER DEPTHS AND THEIR PHYSICAL PROPOERTIES C - DLYR(1,L,NY,NX)=DH(NY,NX) - DLYR(2,L,NY,NX)=DV(NY,NX) + DLYRI(1,L,NY,NX)=DH(NY,NX) + DLYRI(2,L,NY,NX)=DV(NY,NX) + DLYR(1,L,NY,NX)=DLYRI(1,L,NY,NX) + DLYR(2,L,NY,NX)=DLYRI(2,L,NY,NX) AREA(3,L,NY,NX)=DLYR(1,L,NY,NX)*DLYR(2,L,NY,NX) IF(L.EQ.0)THEN TAREA=TAREA+AREA(3,L,NY,NX) - CDPTH(L,NY,NX)=0.0 CDPTHZ(L,NY,NX)=0.0 ORGC(L,NY,NX)=(RSC(0,L,NY,NX)+RSC(1,L,NY,NX)+RSC(2,L,NY,NX)) 2*AREA(3,L,NY,NX) @@ -456,31 +470,37 @@ SUBROUTINE starts(NHW,NHE,NVN,NVS) 2*AREA(3,L,NY,NX) VOLT(L,NY,NX)=VOLR(NY,NX) VOLX(L,NY,NX)=VOLT(L,NY,NX) + VOLXI(L,NY,NX)=VOLX(L,NY,NX) BKVL(L,NY,NX)=2.00E-06*ORGC(L,NY,NX) - DLYR(3,L,NY,NX)=VOLX(L,NY,NX)/AREA(3,L,NY,NX) + DLYRI(3,L,NY,NX)=VOLX(L,NY,NX)/AREA(3,L,NY,NX) + DLYR(3,L,NY,NX)=DLYRI(3,L,NY,NX) ELSE - DLYR(3,L,NY,NX)=(CDPTH(L,NY,NX)-CDPTH(L-1,NY,NX)) + DLYRI(3,L,NY,NX)=(CDPTH(L,NY,NX)-CDPTH(L-1,NY,NX)) + DLYR(3,L,NY,NX)=DLYRI(3,L,NY,NX) DPTH(L,NY,NX)=0.5*(CDPTH(L,NY,NX)+CDPTH(L-1,NY,NX)) CDPTHZ(L,NY,NX)=CDPTH(L,NY,NX)-CDPTH(NU(NY,NX),NY,NX) 2+DLYR(3,NU(NY,NX),NY,NX) DPTHZ(L,NY,NX)=0.5*(CDPTHZ(L,NY,NX)+CDPTHZ(L-1,NY,NX)) VOLT(L,NY,NX)=AREA(3,L,NY,NX)*DLYR(3,L,NY,NX) VOLX(L,NY,NX)=VOLT(L,NY,NX)*FMPR(L,NY,NX) + VOLXI(L,NY,NX)=VOLX(L,NY,NX) BKVL(L,NY,NX)=BKDS(L,NY,NX)*VOLX(L,NY,NX) - YDPTH(L,NY,NX)=ALT(NY,NX)-DPTH(L,NY,NX) RTDNT(L,NY,NX)=0.0 IF(BKDS(L,NY,NX).GT.0.0.AND.NW(NY,NX).EQ.0)NW(NY,NX)=L ENDIF AREA(1,L,NY,NX)=DLYR(3,L,NY,NX)*DLYR(2,L,NY,NX) AREA(2,L,NY,NX)=DLYR(3,L,NY,NX)*DLYR(1,L,NY,NX) 1195 CONTINUE + CDPTH(0,NY,NX)=CDPTH(NU(NY,NX),NY,NX)-DLYR(3,NU(NY,NX),NY,NX) + CDPTHI(NY,NX)=CDPTH(0,NY,NX) C C SURFACE WATER STORAGE AND LOWER HEAT SINK C VHCPW(NY,NX)=2.095*VOLSS(NY,NX)+4.19*VOLWS(NY,NX) 2+1.9274*VOLIS(NY,NX) VHCPWX(NY,NX)=10.5E-03*AREA(3,NU(NY,NX),NY,NX) - VHCPRX(NY,NX)=10.5E-05*AREA(3,NU(NY,NX),NY,NX) + VHCPRX(NY,NX)=4.19E-04*AREA(3,NU(NY,NX),NY,NX) + VHCPNX(NY,NX)=2.095E-03*AREA(3,NU(NY,NX),NY,NX) DPTHSK(NY,NX)=AMAX1(10.0,CDPTH(NL(NY,NX),NY,NX)+1.0) TCNDG=8.1E-03 TKSD(NY,NX)=ATKS(NY,NX)+2.052E-04*DPTHSK(NY,NX)/TCNDG @@ -843,10 +863,10 @@ SUBROUTINE starts(NHW,NHE,NVN,NVS) C CFOMC(1,L,NY,NX)=3.0*FC1/(2.0*FC1+1.0) CFOMC(2,L,NY,NX)=1.0-CFOMC(1,L,NY,NX) - WRITE(*,5432)'PART',L,FC0,FC1,FCX,HCX,TORGM,TORGL(L) - 2,CORGCX(4),CORGNX(4),CORGPX(4),DPTH(L,NY,NX),DTBLZ(NY,NX) - 3,CDPTH(NU(NY,NX),NY,NX),CDPTHG,CORGC(L,NY,NX),FORGC - 4,EXP(HCX*TORGL(L)) +C WRITE(*,5432)'PART',L,FC0,FC1,FCX,HCX,TORGM,TORGL(L) +C 2,CORGCX(4),CORGNX(4),CORGPX(4),DPTH(L,NY,NX),DTBLZ(NY,NX) +C 3,CDPTH(NU(NY,NX),NY,NX),CDPTHG,CORGC(L,NY,NX),FORGC +C 4,EXP(HCX*TORGL(L)) 5432 FORMAT(A8,I4,20E12.4) ENDIF C @@ -870,6 +890,7 @@ SUBROUTINE starts(NHW,NHE,NVN,NVS) POROS(L,NY,NX)=1.0 ENDIF VOLA(L,NY,NX)=POROS(L,NY,NX)*VOLX(L,NY,NX) + VOLAI(L,NY,NX)=VOLA(L,NY,NX) VOLAH(L,NY,NX)=FHOL(L,NY,NX)*VOLT(L,NY,NX) IF(ISOIL(1,L,NY,NX).EQ.0.AND.ISOIL(2,L,NY,NX).EQ.0)THEN IF(THW(L,NY,NX).GT.1.0.OR.DPTH(L,NY,NX).GE.DTBLZ(NY,NX))THEN @@ -890,13 +911,16 @@ SUBROUTINE starts(NHW,NHE,NVN,NVS) 2,POROS(L,NY,NX)-THW(L,NY,NX))) ENDIF THETW(L,NY,NX)=THW(L,NY,NX) + THETI(L,NY,NX)=THI(L,NY,NX) + ELSE + THETW(L,NY,NX)=0.75*POROS(L,NY,NX) + THETI(L,NY,NX)=0.0 + ENDIF VOLW(L,NY,NX)=THETW(L,NY,NX)*VOLX(L,NY,NX) VOLWX(L,NY,NX)=VOLW(L,NY,NX) VOLWH(L,NY,NX)=THETW(L,NY,NX)*VOLAH(L,NY,NX) - THETI(L,NY,NX)=THI(L,NY,NX) VOLI(L,NY,NX)=THETI(L,NY,NX)*VOLX(L,NY,NX) VOLIH(L,NY,NX)=THETI(L,NY,NX)*VOLAH(L,NY,NX) - ENDIF VOLP(L,NY,NX)=AMAX1(0.0,VOLA(L,NY,NX)-VOLW(L,NY,NX) 2-VOLI(L,NY,NX))+AMAX1(0.0,VOLAH(L,NY,NX)-VOLWH(L,NY,NX) 3-VOLIH(L,NY,NX)) @@ -928,9 +952,10 @@ SUBROUTINE starts(NHW,NHE,NVN,NVS) ENDIF THETP(L,NY,NX)=0.95-THETW(L,NY,NX) THETI(L,NY,NX)=0.0 - VHCPR(NY,NX)=2.496E-06*ORGC(L,NY,NX)+4.19*VOLW(L,NY,NX) - 2+1.9274*VOLI(L,NY,NX) ENDIF +C WRITE(*,2425)'VOLW',NX,NY,L,ISOIL(1,L,NY,NX),ISOIL(2,L,NY,NX) +C 2,VOLW(L,NY,NX),THETW(L,NY,NX),VOLX(L,NY,NX),POROS(L,NY,NX) +2425 FORMAT(A8,5I4,12E12.4) C C INITIALIZE SOM VARIABLES C @@ -1261,8 +1286,13 @@ SUBROUTINE starts(NHW,NHE,NVN,NVS) ZNFNI(L,NY,NX)=0.0 ZNFN0(L,NY,NX)=0.0 1200 CONTINUE + VHCP(0,NY,NX)=2.496E-06*ORGC(0,NY,NX)+4.19*VOLW(0,NY,NX) + 2+1.9274*VOLI(0,NY,NX) + VHCM(0,NY,NX)=0.0 + VOLAI(0,NY,NX)=0.0 9890 CONTINUE 9895 CONTINUE RETURN END + diff --git a/f77src/stomate.f b/f77src/stomate.f old mode 100755 new mode 100644 index f37b47b..109572f --- a/f77src/stomate.f +++ b/f77src/stomate.f @@ -1,377 +1,378 @@ - - 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 + + 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 old mode 100755 new mode 100644 index 197a8e1..8083d6b --- a/f77src/trnsfr.f +++ b/f77src/trnsfr.f @@ -144,7 +144,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 3,COQNH1(0:4),COQNH2(0:4),COQPH1(0:4),COQPH2(0:4) 4,COQAH1(0:4),COQAH2(0:4),DFVOC(0:4),DFVON(0:4),DFVOP(0:4) 5,DFVOA(0:4),DFHOC(0:4),DFHON(0:4),DFHOP(0:4),DFHOA(0:4) - DIMENSION THETW1(0:JZ,JY,JX) + DIMENSION THETW1(JZ,JY,JX) 2,DCO2G(3,JZ,JY,JX),DCH4G(3,JZ,JY,JX) 3,DOXYG(3,JZ,JY,JX),DZ2GG(3,JZ,JY,JX),DZ2OG(3,JZ,JY,JX) 4,DNH3G(3,JZ,JY,JX),VOLWCO(0:JZ,JY,JX),VOLWCH(0:JZ,JY,JX) @@ -174,7 +174,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 2,VOLN2R(JY,JX),VOLN3R(JY,JX),VOLHGR(JY,JX),VOLCOT(JY,JX) 3,VOLCHT(JY,JX),VOLOXT(JY,JX),VOLNGT(JY,JX),VOLN2T(JY,JX) 4,VOLN3T(JY,JX),VOLNBT(JY,JX),VOLHGT(JY,JX) - PARAMETER(DPN4=5.7E-07,XFRX=0.5,XFRS=0.05) + PARAMETER(DPN4=5.7E-07,VFLWX=0.5,XFRS=0.05) REAL*4 CCO2SQ,CCH4SQ,COXYSQ,CZ2GSQ,CZ2OSQ,CNH3SQ 2,CNH3BQ,CH2GSQ C @@ -432,7 +432,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) FLQTM=FLQGM(NY,NX)+FLQRM(NY,NX) IF(FLQTM.GT.ZEROS(NY,NX))THEN VOLWW=VOLWS(NY,NX)+VOLSS(NY,NX)+VOLIS(NY,NX)*DENSI - IF(VOLWW.GT.ZEROS(NY,NX))THEN + IF(VOLWW.GT.ZEROS2(NY,NX))THEN VFLWW=AMAX1(0.0,AMIN1(1.0,FLQTM/VOLWW)) ELSE VFLWW=1.0 @@ -594,9 +594,12 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) PARGN3(NY,NX)=PARGM*1.02 PARGH2(NY,NX)=PARGM*2.08 DO 10 L=NU(NY,NX),NL(NY,NX) +C +C HOURLY SOLUTE SINKS FROM WATSUB.F, NITRO.F, UPTAKE.F, SOLUTE.F +C CHY0(L,NY,NX)=10.0**(-(PH(L,NY,NX)-3.0)) FLWU(L,NY,NX)=TUPWTR(L,NY,NX)*XNPH - RCOSK2(L,NY,NX)=(RCO2O(L,NY,NX)+TCO2S(L,NY,NX)+TRCO2(L,NY,NX)) + RCOSK2(L,NY,NX)=(RCO2O(L,NY,NX)+TCO2S(L,NY,NX)-TRCO2(L,NY,NX)) 2*XNPG RCHSK2(L,NY,NX)=(RCH4O(L,NY,NX)+TUPCHS(L,NY,NX))*XNPG RNGSK2(L,NY,NX)=(RN2G(L,NY,NX)+XN2GS(L,NY,NX)+TUPNF(L,NY,NX)) @@ -630,6 +633,12 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 IF(IYRC.EQ.2012.AND.I.EQ.151.AND.NX.EQ.1)THEN +C WRITE(*,4441)'RN3SK2',I,J,NX,NY,L,RN3SK2(L,NY,NX) +C 2,TRN3S(L,NY,NX),TUPN3S(L,NY,NX),RN4SK2(L,NY,NX) +C 2,XNH4S(L,NY,NX),TRN4S(L,NY,NX),TUPNH4(L,NY,NX) +4441 FORMAT(A8,5I4,20E12.4) +C ENDIF C C HOURLY SOLUTE FLUXES FROM SUBSURFACE IRRIGATION C @@ -748,27 +757,8 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) ZN2BH2(L,NY,NX)=ZNO2BH(L,NY,NX) H1PBH2(L,NY,NX)=H1POBH(L,NY,NX) H2PBH2(L,NY,NX)=H2POBH(L,NY,NX) -C IF(CDPTH(L,NY,NX).LT.DPNH4(NY,NX).AND.ROWN(NY,NX).GT.0.0)THEN -C VLNHB(L,NY,NX)=WDNHB(L,NY,NX)/ROWN(NY,NX) -C ELSE -C VLNHB(L,NY,NX)=0.0 -C ENDIF -C VLNH4(L,NY,NX)=1.0-VLNHB(L,NY,NX) -C IF(CDPTH(L-1,NY,NX).LT.DPNO3(NY,NX).AND.ROWO(NY,NX).GT.0.0)THEN -C VLNOB(L,NY,NX)=WDNOB(L,NY,NX)/ROWO(NY,NX) -C ELSE -C VLNOB(L,NY,NX)=0.0 -C ENDIF -C VLNO3(L,NY,NX)=1.0-VLNOB(L,NY,NX) -C IF(CDPTH(L,NY,NX).LT.DPPO4(NY,NX).AND.ROWP(NY,NX).GT.0.0)THEN -C VLPOB(L,NY,NX)=WDPOB(L,NY,NX)/ROWP(NY,NX) -C ELSE -C VLPOB(L,NY,NX)=0.0 -C ENDIF -C VLPO4(L,NY,NX)=1.0-VLPOB(L,NY,NX) 10 CONTINUE 9990 CONTINUE - 9995 CONTINUE C C TIME STEP USED IN GAS AND SOLUTE FLUX CALCULATIONS @@ -884,6 +874,10 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) TNXFHB(L,NY,NX)=0.0 TH1BHB(L,NY,NX)=0.0 TH2BHB(L,NY,NX)=0.0 +C +C ADD HOURLY SOLUTE FLUXES + +C 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) @@ -915,9 +909,11 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) Z2OS2(L,NY,NX)=Z2OS2(L,NY,NX)-RN2SK2(L,NY,NX) H2GS2(L,NY,NX)=H2GS2(L,NY,NX)-RHGSK2(L,NY,NX) ZN3G2(L,NY,NX)=ZN3G2(L,NY,NX)-RNHSK2(L,NY,NX) +C IF(I.EQ.105)THEN C WRITE(*,444)'CO2S1',I,J,NX,NY,L,M,MM,CO2S2(L,NY,NX) C 2,RCOSK2(L,NY,NX),RCO2O(L,NY,NX),TCO2S(L,NY,NX) C 3,TRCO2(L,NY,NX) +C ENDIF 9885 CONTINUE C C SOLUTE FLUXES AT SOIL SURFACE FROM SURFACE WATER @@ -939,8 +935,6 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 2*VLNH4(NU(NY,NX),NY,NX) VOLPMB(NU(NY,NX),NY,NX)=VOLPM(M,NU(NY,NX),NY,NX) 2*VLNHB(NU(NY,NX),NY,NX) - THETW1(NU(NY,NX),NY,NX)=AMAX1(0.0,VOLWM(M,NU(NY,NX),NY,NX) - 2/VOLX(NU(NY,NX),NY,NX)) FLVM(NU(NY,NX),NY,NX)=FLPM(M,NU(NY,NX),NY,NX)*XNPT FLQM(3,NU(NY,NX),NY,NX)=(FLWM(M,3,NU(NY,NX),NY,NX) 2+FLWHM(M,3,NU(NY,NX),NY,NX))*XNPT @@ -949,9 +943,8 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) C THROUGH VOLATILIZATION-DISSOLUTION FROM AQUEOUS C DIFFUSIVITIES IN SURFACE RESIDUE C - IF(VOLWM(M,0,NY,NX).GT.ZEROS(NY,NX) - 2.AND.VOLT(0,NY,NX).GT.ZEROS(NY,NX))THEN - THETW1(0,NY,NX)=AMAX1(0.0,VOLWM(M,0,NY,NX)/VOLT(0,NY,NX)) + IF(CVRD(NY,NX).GT.ZERO + 2.AND.VOLWM(M,0,NY,NX).GT.ZEROS2(NY,NX))THEN VOLWCO(0,NY,NX)=VOLWM(M,0,NY,NX)*SCO2L(0,NY,NX) VOLWCH(0,NY,NX)=VOLWM(M,0,NY,NX)*SCH4L(0,NY,NX) VOLWOX(0,NY,NX)=VOLWM(M,0,NY,NX)*SOXYL(0,NY,NX) @@ -960,8 +953,9 @@ 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) + DLYR0=AMAX1(ZERO2,DLYR(3,0,NY,NX)) TORT0=TORT(M,0,NY,NX)*AREA(3,NU(NY,NX),NY,NX) - 2/(0.5*DLYR(3,0,NY,NX)) + 2/(0.5*DLYR0)*CVRD(NY,NX) DFGSCO=CLSGL2(0,NY,NX)*TORT0 DFGSCH=CQSGL2(0,NY,NX)*TORT0 DFGSOX=OLSGL2(0,NY,NX)*TORT0 @@ -1019,18 +1013,18 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) XN3DFR(NY,NX)=XN3DFR(NY,NX)+RN3DFR(NY,NX) XHGDFR(NY,NX)=XHGDFR(NY,NX)+RHGDFR(NY,NX) C IF(I.LE.90.AND.J.EQ.14)THEN -C WRITE(*,1118)'RCODFR',I,J,NX,NY,M,MM,CO2S2(0,NY,NX) +C WRITE(*,1118)'RCODFR',I,J,NX,NY,M,MM,NU(NY,NX),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 3,DCO21,CCO22,SCO2L(0,NY,NX),TORT1 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 WRITE(*,1118)'RCHDFR',I,J,NX,NY,M,MM,NU(NY,NX),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 WRITE(*,1118)'ROXDFR',I,J,NX,NY,M,MM,NU(NY,NX),ROXDFR(NY,NX) C 2,OXYGQ,OXYS2(0,NY,NX),PARR(NY,NX),COXYE(NY,NX) C 3,VOLWOX(0,NY,NX),DFGSOX,TORT(M,0,NY,NX),XOXDFR(NY,NX) C 4,VOLWM(M,0,NY,NX),VOLT(0,NY,NX),DLYR(3,0,NY,NX) -1118 FORMAT(A8,6I4,20E12.4) +1118 FORMAT(A8,7I4,30E12.4) C ENDIF ELSE RCODFR(NY,NX)=0.0 @@ -1053,7 +1047,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) C THROUGH VOLATILIZATION-DISSOLUTION FROM AQUEOUS C DIFFUSIVITIES IN SURFACE SOIL LAYER C - IF(VOLWM(M,NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN + IF(VOLWM(M,NU(NY,NX),NY,NX).GT.ZEROS2(NY,NX))THEN VOLWCO(NU(NY,NX),NY,NX)=VOLWM(M,NU(NY,NX),NY,NX) 2*SCO2L(NU(NY,NX),NY,NX) VOLWCH(NU(NY,NX),NY,NX)=VOLWM(M,NU(NY,NX),NY,NX) @@ -1070,8 +1064,9 @@ 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) + DLYR1=AMAX1(ZERO2,DLYR(3,NU(NY,NX),NY,NX)) TORT1=TORT(M,NU(NY,NX),NY,NX)*AREA(3,NU(NY,NX),NY,NX) - 2/(0.5*DLYR(3,NU(NY,NX),NY,NX)) + 2/(0.5*DLYR1) DFGSCO=CLSGL2(NU(NY,NX),NY,NX)*TORT1 DFGSCH=CQSGL2(NU(NY,NX),NY,NX)*TORT1 DFGSOX=OLSGL2(NU(NY,NX),NY,NX)*TORT1 @@ -1133,19 +1128,30 @@ 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)'RCODFS',I,J,NX,NY,M,MM,RCODFS(NY,NX) +C IF(IYRC.EQ.2006.AND.I.EQ.361.AND.NX.EQ.1)THEN +C WRITE(*,1118)'RCODFS',I,J,NX,NY,M,MM,NU(NY,NX),RCODFS(NY,NX) C 2,XCODFS(NY,NX),CO2GQ,CO2S2X,CO2S2(NU(NY,NX),NY,NX),PARG(NY,NX) C 3,CCO2E(NY,NX),VOLWCO(NU(NY,NX),NY,NX),DFGSCO C 2,TORT(M,NU(NY,NX),NY,NX),CLSGL2(NU(NY,NX),NY,NX),TORT1 -C 4,DLYR(3,NU(NY,NX),NY,NX) -C WRITE(*,1118)'RCHDFS',I,J,NX,NY,M,MM,RCHDFS(NY,NX) +C 4,DLYR(3,NU(NY,NX),NY,NX),CO2S(L,NY,NX),RCOSK2(L,NY,NX) +C WRITE(*,1118)'RCHDFS',I,J,NX,NY,M,MM,NU(NY,NX),RCHDFS(NY,NX) C 2,XCHDFS(NY,NX),CH4GQ,CH4S2X,CH4S2(NU(NY,NX),NY,NX),PARG(NY,NX) C 3,CCH4E(NY,NX),VOLWCH(NU(NY,NX),NY,NX),DFGSCH,TORT(M,0,NY,NX) -C WRITE(*,1118)'ROXDFS',I,J,NX,NY,M,MM,ROXDFS(NY,NX) +C WRITE(*,1118)'ROXDFS',I,J,NX,NY,M,MM,NU(NY,NX),ROXDFS(NY,NX) C 2,XOXDFS(NY,NX),OXYGQ,OXYS2X,OXYS2(NU(NY,NX),NY,NX),PARG(NY,NX) C 3,COXYE(NY,NX),VOLWOX(NU(NY,NX),NY,NX),DFGSOX,TORT(M,0,NY,NX) -C 4,XOXDFS(NY,NX) +C WRITE(*,1118)'RNGDFS',I,J,NX,NY,M,MM,NU(NY,NX),RNGDFS(NY,NX) +C 2,XNGDFS(NY,NX),Z2GGQ,Z2GS2X,Z2GS2(NU(NY,NX),NY,NX),PARG(NY,NX) +C 3,CZ2GE(NY,NX),VOLWNG(NU(NY,NX),NY,NX),DFGSNG,TORT(M,0,NY,NX) +C WRITE(*,1118)'RN2DFS',I,J,NX,NY,M,MM,NU(NY,NX),RN2DFS(NY,NX) +C 2,XN2DFS(NY,NX),Z2OGQ,Z2OS2X,Z2OS2(NU(NY,NX),NY,NX),PARG(NY,NX) +C 3,CZ2OE(NY,NX),VOLWN2(NU(NY,NX),NY,NX),DFGSN2,TORT(M,0,NY,NX) +C 4,VOLWM(M,NU(NY,NX),NY,NX),SN2OL(NU(NY,NX),NY,NX) +C 5,TKS(NU(NY,NX),NY,NX) +C WRITE(*,1118)'RN3DFS',I,J,NX,NY,M,MM,NU(NY,NX),RN3DFS(NY,NX) +C 2,XN3DFS(NY,NX),ZN3GQ,ZN3S2X,PARG(NY,NX),CNH3E(NY,NX) +C 3,VOLWN3(NU(NY,NX),NY,NX),DFGSN3,ZN3S2(NU(NY,NX),NY,NX) +C 4,ZN3G2(NU(NY,NX),NY,NX) C ENDIF ELSE RCODFS(NY,NX)=0.0 @@ -1176,10 +1182,10 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) C IN RESIDUE C IF(FLWRM1.GT.0.0)THEN - IF(VOLWM(M,0,NY,NX).GT.ZEROS(NY,NX))THEN - VFLW=AMAX1(0.0,AMIN1(XFRX,FLWRM1/VOLWM(M,0,NY,NX))) + IF(VOLWM(M,0,NY,NX).GT.ZEROS2(NY,NX))THEN + VFLW=AMAX1(0.0,AMIN1(VFLWX,FLWRM1/VOLWM(M,0,NY,NX))) ELSE - VFLW=XFRX + VFLW=VFLWX ENDIF DO 8820 K=0,4 RFLOC(K)=VFLW*AMAX1(0.0,OQC2(K,0,NY,NX)) @@ -1212,10 +1218,10 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) C IN SOIL SURFACE C ELSE - IF(VOLWM(M,NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN - VFLW=AMIN1(0.0,AMAX1(-XFRX,FLWRM1/VOLWM(M,NU(NY,NX),NY,NX))) + IF(VOLWM(M,NU(NY,NX),NY,NX).GT.ZEROS2(NY,NX))THEN + VFLW=AMIN1(0.0,AMAX1(-VFLWX,FLWRM1/VOLWM(M,NU(NY,NX),NY,NX))) ELSE - VFLW=-XFRX + VFLW=-VFLWX ENDIF DO 8815 K=0,4 RFLOC(K)=VFLW*AMAX1(0.0,OQC2(K,NU(NY,NX),NY,NX)) @@ -1247,8 +1253,9 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) C SOIL SURFACE FROM AQUEOUS DIFFUSIVITIES C AND CONCENTRATION DIFFERENCES C - IF(THETW1(0,NY,NX).GT.THETY(0,NY,NX) - 2.AND.THETW1(NU(NY,NX),NY,NX).GT.THETY(NU(NY,NX),NY,NX))THEN + IF((VOLT(0,NY,NX).GT.ZEROS(NY,NX) + 2.AND.VOLWM(M,0,NY,NX).GT.ZEROS2(NY,NX)) + 3.AND.(VOLWM(M,NU(NY,NX),NY,NX).GT.ZEROS2(NY,NX)))THEN C C MICROPORE CONCENTRATIONS FROM WATER IN RESIDUE AND SOIL SURFACE C @@ -1290,7 +1297,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 + IF(VOLWMA(NU(NY,NX),NY,NX).GT.ZEROS2(NY,NX))THEN CNH3S2=AMAX1(0.0,ZN3S2(NU(NY,NX),NY,NX) 2/VOLWMA(NU(NY,NX),NY,NX)) CNH4S2=AMAX1(0.0,ZNH4S2(NU(NY,NX),NY,NX) @@ -1299,21 +1306,21 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) CNH3S2=0.0 CNH4S2=0.0 ENDIF - IF(VOLWOA.GT.ZEROS(NY,NX))THEN + IF(VOLWOA.GT.ZEROS2(NY,NX))THEN CNO3S2=AMAX1(0.0,ZNO3S2(NU(NY,NX),NY,NX)/VOLWOA) CNO2S2=AMAX1(0.0,ZNO2S2(NU(NY,NX),NY,NX)/VOLWOA) ELSE CNO3S2=0.0 CNO2S2=0.0 ENDIF - IF(VOLWPA.GT.ZEROS(NY,NX))THEN + IF(VOLWPA.GT.ZEROS2(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 + IF(VOLWMB(NU(NY,NX),NY,NX).GT.ZEROS2(NY,NX))THEN CNH3B2=AMAX1(0.0,ZNBS2(NU(NY,NX),NY,NX) 2/VOLWMB(NU(NY,NX),NY,NX)) CNH4B2=AMAX1(0.0,ZNH4B2(NU(NY,NX),NY,NX) @@ -1322,14 +1329,14 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) CNH3B2=CNH3S2 CNH4B2=CNH4S2 ENDIF - IF(VOLWOB.GT.ZEROS(NY,NX))THEN + IF(VOLWOB.GT.ZEROS2(NY,NX))THEN CNO3B2=AMAX1(0.0,ZNO3B2(NU(NY,NX),NY,NX)/VOLWOB) CNO2B2=AMAX1(0.0,ZNO2B2(NU(NY,NX),NY,NX)/VOLWOB) ELSE CNO3B2=CNO3S2 CNO2B2=CNO2S2 ENDIF - IF(VOLWPB.GT.ZEROS(NY,NX))THEN + IF(VOLWPB.GT.ZEROS2(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 @@ -1339,11 +1346,12 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) C C DIFFUSIVITIES IN RESIDUE AND SOIL SURFACE C - TORT0=TORT(M,0,NY,NX)*AREA(3,NU(NY,NX),NY,NX) - 2/DLYR(3,0,NY,NX) - TORT1=TORT(M,NU(NY,NX),NY,NX)*AREA(3,NU(NY,NX),NY,NX) - 2/DLYR(3,NU(NY,NX),NY,NX) - DISPN=DISP(3,NU(NY,NX),NY,NX)*ABS(FLWRM1/AREA(3,NU(NY,NX),NY,NX)) + DLYR0=AMAX1(ZERO2,DLYR(3,0,NY,NX)) + TORT0=TORT(M,0,NY,NX)/DLYR0*CVRD(NY,NX) + DLYR1=AMAX1(ZERO2,DLYR(3,NU(NY,NX),NY,NX)) + TORT1=TORT(M,NU(NY,NX),NY,NX)/DLYR1 + DISPN=DISP(3,NU(NY,NX),NY,NX) + 2*AMIN1(VFLWX,ABS(FLWRM1/AREA(3,NU(NY,NX),NY,NX))) DIFOC0=(OCSGL2(0,NY,NX)*TORT0+DISPN) DIFON0=(ONSGL2(0,NY,NX)*TORT0+DISPN) DIFOP0=(OPSGL2(0,NY,NX)*TORT0+DISPN) @@ -1370,19 +1378,19 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) DIFNG1=(ZLSGL2(NU(NY,NX),NY,NX)*TORT1+DISPN) DIFN21=(ZVSGL2(NU(NY,NX),NY,NX)*TORT1+DISPN) DIFHG1=(HLSGL2(NU(NY,NX),NY,NX)*TORT1+DISPN) - DIFOC=DIFOC0*DIFOC1/(DIFOC0+DIFOC1) - DIFON=DIFON0*DIFON1/(DIFON0+DIFON1) - DIFOP=DIFOP0*DIFOP1/(DIFOP0+DIFOP1) - DIFOA=DIFOA0*DIFOA1/(DIFOA0+DIFOA1) - DIFNH=DIFNH0*DIFNH1/(DIFNH0+DIFNH1) - DIFNO=DIFNO0*DIFNO1/(DIFNO0+DIFNO1) - DIFPO=DIFPO0*DIFPO1/(DIFPO0+DIFPO1) - DIFCS=DIFCS0*DIFCS1/(DIFCS0+DIFCS1) - DIFCQ=DIFCQ0*DIFCQ1/(DIFCQ0+DIFCQ1) - DIFOS=DIFOS0*DIFOS1/(DIFOS0+DIFOS1) - DIFNG=DIFNG0*DIFNG1/(DIFNG0+DIFNG1) - DIFN2=DIFN20*DIFN21/(DIFN20+DIFN21) - DIFHG=DIFHG0*DIFHG1/(DIFHG0+DIFHG1) + DIFOC=DIFOC0*DIFOC1/(DIFOC0+DIFOC1)*AREA(3,NU(NY,NX),NY,NX) + DIFON=DIFON0*DIFON1/(DIFON0+DIFON1)*AREA(3,NU(NY,NX),NY,NX) + DIFOP=DIFOP0*DIFOP1/(DIFOP0+DIFOP1)*AREA(3,NU(NY,NX),NY,NX) + DIFOA=DIFOA0*DIFOA1/(DIFOA0+DIFOA1)*AREA(3,NU(NY,NX),NY,NX) + DIFNH=DIFNH0*DIFNH1/(DIFNH0+DIFNH1)*AREA(3,NU(NY,NX),NY,NX) + DIFNO=DIFNO0*DIFNO1/(DIFNO0+DIFNO1)*AREA(3,NU(NY,NX),NY,NX) + DIFPO=DIFPO0*DIFPO1/(DIFPO0+DIFPO1)*AREA(3,NU(NY,NX),NY,NX) + DIFCS=DIFCS0*DIFCS1/(DIFCS0+DIFCS1)*AREA(3,NU(NY,NX),NY,NX) + DIFCQ=DIFCQ0*DIFCQ1/(DIFCQ0+DIFCQ1)*AREA(3,NU(NY,NX),NY,NX) + DIFOS=DIFOS0*DIFOS1/(DIFOS0+DIFOS1)*AREA(3,NU(NY,NX),NY,NX) + DIFNG=DIFNG0*DIFNG1/(DIFNG0+DIFNG1)*AREA(3,NU(NY,NX),NY,NX) + DIFN2=DIFN20*DIFN21/(DIFN20+DIFN21)*AREA(3,NU(NY,NX),NY,NX) + DIFHG=DIFHG0*DIFHG1/(DIFHG0+DIFHG1)*AREA(3,NU(NY,NX),NY,NX) C C DIFFUSIVE FLUXES BETWEEN CURRENT AND ADJACENT GRID CELL C MICROPORES @@ -1411,6 +1419,13 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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) +C IF(I.EQ.53)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 +C 3,DIFOS,COXYS1,COXYS2,DIFOS0,DIFOS1,OXYS2(0,NY,NX) +C 4,VOLWM(M,0,NY,NX),CVRD(NY,NX) +3434 FORMAT(A8,6I4,20E12.4) +C ENDIF ELSE DO 8905 K=0,4 DFVOC(K)=0.0 @@ -1450,6 +1465,17 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) RONFLS(K,3,NU(NY,NX),NY,NX)=RONFL1(K,NY,NX)+RFLON(K)+DFVON(K) ROPFLS(K,3,NU(NY,NX),NY,NX)=ROPFL1(K,NY,NX)+RFLOP(K)+DFVOP(K) ROAFLS(K,3,NU(NY,NX),NY,NX)=ROAFL1(K,NY,NX)+RFLOA(K)+DFVOA(K) +C IF(I.EQ.187)THEN +C WRITE(*,448)'ROA',I,J,NU(NY,NX),M,MM,K +C 2,ROAFLS(K,3,NU(NY,NX),NY,NX),ROAFL1(K,NY,NX),RFLOA(K),DFVOA(K) +C 3,DIFOA,COQA1(K),COQA2(K),OQA2(K,0,NY,NX),VOLWM(M,0,NY,NX) +C 4,OQA2(K,NU(NY,NX),NY,NX),VOLWM(M,NU(NY,NX),NY,NX) +C 5,DIFOA0,OASGL2(0,NY,NX),TORT0,DISPN +C 6,DIFOA1,OASGL2(NU(NY,NX),NY,NX),TORT1,DISPN +C 7,TORT(M,0,NY,NX),DLYR(3,0,NY,NX) +C 8,TORT(M,NU(NY,NX),NY,NX),DLYR(3,NU(NY,NX),NY,NX) +448 FORMAT(A8,6I4,40E12.4) +C ENDIF 9760 CONTINUE RCOFLS(3,0,NY,NX)=RCOFL0(NY,NX)-RFLCOS-DFVCOS RCHFLS(3,0,NY,NX)=RCHFL0(NY,NX)-RFLCHS-DFVCHS @@ -1481,6 +1507,9 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) RNXFLB(3,NU(NY,NX),NY,NX)=RNXFL2(NY,NX)+RFLN2B+DFVN2B RH1BFB(3,NU(NY,NX),NY,NX)=RH1BF2(NY,NX)+RFLP1B+DFVP1B RH2BFB(3,NU(NY,NX),NY,NX)=RH2BF2(NY,NX)+RFLPOB+DFVPOB +C +C ACCUMULATE HOURLY FLUXES +C DO 9761 K=0,2 XOCFLS(K,3,0,NY,NX)=XOCFLS(K,3,0,NY,NX) 2-RFLOC(K)-DFVOC(K) @@ -1547,11 +1576,6 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 2+RFLP1B+DFVP1B XH2BFB(3,NU(NY,NX),NY,NX)=XH2BFB(3,NU(NY,NX),NY,NX) 2+RFLPOB+DFVPOB -C IF(I.EQ.118.AND.NX.EQ.3.AND.NY.EQ.4)THEN -C WRITE(*,3434)'ROXFLS',I,J,NX,NY,M,MM,ROXFLS(3,0,NY,NX) -C 2,XOXFLS(3,0,NY,NX),ROXFL0(NY,NX),RFLOXS,DFVOXS -3434 FORMAT(A8,6I4,12E12.4) -C ENDIF C C MACROPORE-MICROPORE SOLUTE EXCHANGE IN SOIL C SURFACE LAYER FROM WATER EXCHANGE IN 'WATSUB' AND @@ -1561,11 +1585,11 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) C MACROPORE TO MICROPORE TRANSFER C IF(FINHM(M,NU(NY,NX),NY,NX).GT.0.0)THEN - IF(VOLWHM(M,NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN - VFLW=AMAX1(0.0,AMIN1(XFRX,FINHM(M,NU(NY,NX),NY,NX) + IF(VOLWHM(M,NU(NY,NX),NY,NX).GT.ZEROS2(NY,NX))THEN + VFLW=AMAX1(0.0,AMIN1(VFLWX,FINHM(M,NU(NY,NX),NY,NX) 2/VOLWHM(M,NU(NY,NX),NY,NX))) ELSE - VFLW=XFRX + VFLW=VFLWX ENDIF DO 9870 K=0,4 RFLOC(K)=VFLW*AMAX1(0.0,OQCH2(K,NU(NY,NX),NY,NX)) @@ -1607,11 +1631,11 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) C MICROPORE TO MACROPORE TRANSFER C ELSEIF(FINHM(M,NU(NY,NX),NY,NX).LT.0.0)THEN - IF(VOLWM(M,NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN - VFLW=AMIN1(0.0,AMAX1(-XFRX,FINHM(M,NU(NY,NX),NY,NX) + IF(VOLWM(M,NU(NY,NX),NY,NX).GT.ZEROS2(NY,NX))THEN + VFLW=AMIN1(0.0,AMAX1(-VFLWX,FINHM(M,NU(NY,NX),NY,NX) 2/VOLWM(M,NU(NY,NX),NY,NX))) ELSE - VFLW=-XFRX + VFLW=-VFLWX ENDIF DO 9865 K=0,4 RFLOC(K)=VFLW*AMAX1(0.0,OQC2(K,NU(NY,NX),NY,NX)) @@ -1686,7 +1710,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 + IF(VOLWHM(M,NU(NY,NX),NY,NX).GT.ZEROS2(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 @@ -1694,79 +1718,79 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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)) + 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)) + 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)) + DFVOA(K)=XNPX*(AMAX1(0.0,OQAH2(K,NU(NY,NX),NY,NX)) 2*VOLWM(M,NU(NY,NX),NY,NX) 2-AMAX1(0.0,OQA2(K,NU(NY,NX),NY,NX))*VOLWHS)/VOLWT 8835 CONTINUE - DFVCOS=XNPX*( AMAX1(0.0,CO2SH2(NU(NY,NX),NY,NX)) + 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)) + 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)) + 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)) + 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)) + 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)) + 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)) + DFVNH4=XNPX*(AMAX1(0.0,ZNH4H2(NU(NY,NX),NY,NX)) 2*VOLWM(M,NU(NY,NX),NY,NX) 2-AMAX1(0.0,ZNH4S2(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT 3*VLNH4(NU(NY,NX),NY,NX) - DFVNH3=XNPX*( AMAX1(0.0,ZNH3H2(NU(NY,NX),NY,NX)) + DFVNH3=XNPX*(AMAX1(0.0,ZNH3H2(NU(NY,NX),NY,NX)) 2*VOLWM(M,NU(NY,NX),NY,NX) 2-AMAX1(0.0,ZN3S2(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT 3*VLNH4(NU(NY,NX),NY,NX) - DFVNO3=XNPX*( AMAX1(0.0,ZNO3H2(NU(NY,NX),NY,NX)) + DFVNO3=XNPX*(AMAX1(0.0,ZNO3H2(NU(NY,NX),NY,NX)) 2*VOLWM(M,NU(NY,NX),NY,NX) 2-AMAX1(0.0,ZNO3S2(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT 3*VLNO3(NU(NY,NX),NY,NX) - DFVNO2=XNPX*( AMAX1(0.0,ZNO2H2(NU(NY,NX),NY,NX)) + DFVNO2=XNPX*(AMAX1(0.0,ZNO2H2(NU(NY,NX),NY,NX)) 2*VOLWM(M,NU(NY,NX),NY,NX) 2-AMAX1(0.0,ZNO2S2(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT 3*VLNO3(NU(NY,NX),NY,NX) - DFVP14=XNPX*( AMAX1(0.0,H1P4H2(NU(NY,NX),NY,NX)) + DFVP14=XNPX*(AMAX1(0.0,H1P4H2(NU(NY,NX),NY,NX)) 2*VOLWM(M,NU(NY,NX),NY,NX) 2-AMAX1(0.0,H1PO42(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT 3*VLPO4(NU(NY,NX),NY,NX) - DFVPO4=XNPX*( AMAX1(0.0,H2P4H2(NU(NY,NX),NY,NX)) + 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)) + DFVN4B=XNPX*(AMAX1(0.0,ZN4BH2(NU(NY,NX),NY,NX)) 2*VOLWM(M,NU(NY,NX),NY,NX) 2-AMAX1(0.0,ZNH4B2(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT 3*VLNHB(NU(NY,NX),NY,NX) - DFVN3B=XNPX*( AMAX1(0.0,ZN3BH2(NU(NY,NX),NY,NX)) + DFVN3B=XNPX*(AMAX1(0.0,ZN3BH2(NU(NY,NX),NY,NX)) 2*VOLWM(M,NU(NY,NX),NY,NX) 2-AMAX1(0.0,ZNBS2(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT 3*VLNHB(NU(NY,NX),NY,NX) - DFVNOB=XNPX*( AMAX1(0.0,ZNOBH2(NU(NY,NX),NY,NX)) + DFVNOB=XNPX*(AMAX1(0.0,ZNOBH2(NU(NY,NX),NY,NX)) 2*VOLWM(M,NU(NY,NX),NY,NX) 2-AMAX1(0.0,ZNO3B2(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT 3*VLNOB(NU(NY,NX),NY,NX) - DFVN2B=XNPX*( AMAX1(0.0,ZN2BH2(NU(NY,NX),NY,NX)) + DFVN2B=XNPX*(AMAX1(0.0,ZN2BH2(NU(NY,NX),NY,NX)) 2*VOLWM(M,NU(NY,NX),NY,NX) 2-AMAX1(0.0,ZNO2B2(NU(NY,NX),NY,NX))*VOLWHS)/VOLWT 3*VLNOB(NU(NY,NX),NY,NX) - DFVP1B=XNPX*( AMAX1(0.0,H1PBH2(NU(NY,NX),NY,NX)) + 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)) + 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) @@ -1930,10 +1954,10 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) C IF OVERLAND FLOW IS FROM CURRENT TO ADJACENT GRID CELL C ELSEIF(QRM(M,N,N5,N4).GT.0.0)THEN - IF(VOLWM(M,0,N2,N1).GT.ZEROS(N2,N1))THEN - VFLW=AMAX1(0.0,AMIN1(XFRX,QRM(M,N,N5,N4)/VOLWM(M,0,N2,N1))) + IF(VOLWM(M,0,N2,N1).GT.ZEROS2(N2,N1))THEN + VFLW=AMAX1(0.0,AMIN1(VFLWX,QRM(M,N,N5,N4)/VOLWM(M,0,N2,N1))) ELSE - VFLW=XFRX + VFLW=VFLWX ENDIF DO 9835 K=0,4 RQROC(K,N,N5,N4)=VFLW*AMAX1(0.0,OQC2(K,0,N2,N1)) @@ -1957,10 +1981,10 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) C IF OVERLAND FLOW IS TO CURRENT FROM ADJACENT GRID CELL C ELSEIF(QRM(M,N,N5,N4).LT.0.0)THEN - IF(VOLWM(M,0,N5,N4).GT.ZEROS(N5,N4))THEN - VFLW=AMIN1(0.0,AMAX1(-XFRX,QRM(M,N,N5,N4)/VOLWM(M,0,N5,N4))) + IF(VOLWM(M,0,N5,N4).GT.ZEROS2(N5,N4))THEN + VFLW=AMIN1(0.0,AMAX1(-VFLWX,QRM(M,N,N5,N4)/VOLWM(M,0,N5,N4))) ELSE - VFLW=-XFRX + VFLW=-VFLWX ENDIF DO 9830 K=0,4 RQROC(K,N,N5,N4)=VFLW*AMAX1(0.0,OQC2(K,0,N5,N4)) @@ -2020,10 +2044,10 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) C IF DRIFT IS FROM CURRENT TO ADJACENT GRID CELL C ELSEIF(QSM(M,N,N5,N4).GT.0.0)THEN - IF(VOLS(N2,N1).GT.ZEROS(N2,N1))THEN - VFLW=AMAX1(0.0,AMIN1(XFRX,QSM(M,N,N5,N4)/VOLS(N2,N1))) + IF(VOLS(N2,N1).GT.ZEROS2(N2,N1))THEN + VFLW=AMAX1(0.0,AMIN1(VFLWX,QSM(M,N,N5,N4)/VOLS(N2,N1))) ELSE - VFLW=XFRX + VFLW=VFLWX ENDIF RQSCOS(N,N5,N4)=VFLW*AMAX1(0.0,CO2W2(N2,N1)) RQSCHS(N,N5,N4)=VFLW*AMAX1(0.0,CH4W2(N2,N1)) @@ -2039,10 +2063,10 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) C IF DRIFT IS TO CURRENT FROM ADJACENT GRID CELL C ELSEIF(QSM(M,N,N5,N4).LT.0.0)THEN - IF(VOLS(N5,N4).GT.ZEROS(N5,N4))THEN - VFLW=AMIN1(0.0,AMAX1(-XFRX,QSM(M,N,N5,N4)/VOLS(N5,N4))) + IF(VOLS(N5,N4).GT.ZEROS2(N5,N4))THEN + VFLW=AMIN1(0.0,AMAX1(-VFLWX,QSM(M,N,N5,N4)/VOLS(N5,N4))) ELSE - VFLW=-XFRX + VFLW=-VFLWX ENDIF RQSCOS(N,N5,N4)=VFLW*AMAX1(0.0,CO2W2(N5,N4)) RQSCHS(N,N5,N4)=VFLW*AMAX1(0.0,CH4W2(N5,N4)) @@ -2082,7 +2106,8 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) C EQUIVALENTS DEPENDING ON SOLUBILITY FROM 'HOUR1' C AND TRANSFER COEFFICIENT 'DFGS' FROM 'WATSUB' C - IF(VOLWM(M,0,NY,NX).GT.ZEROS(NY,NX))THEN + IF(CVRD(NY,NX).GT.ZERO + 2.AND.VOLWM(M,0,NY,NX).GT.ZEROS2(NY,NX))THEN CO2G0=CCO2G(0,NY,NX)*VOLPM(M,0,NY,NX) CH4G0=CCH4G(0,NY,NX)*VOLPM(M,0,NY,NX) OXYG0=COXYG(0,NY,NX)*VOLPM(M,0,NY,NX) @@ -2129,6 +2154,18 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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(J.EQ.24)THEN +C WRITE(*,323)'RCODFG',I,J,NX,NY,M,MM,RCODFG(0,NY,NX) +C 2,DFGS(M,0,NY,NX),CO2G0,VOLWCO(0,NY,NX),CO2S2(0,NY,NX) +C 3,VOLPM(M,0,NY,NX),VOLCOR(NY,NX),RCODXR +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 C C ACCUMULATE HOURLY FLUXES C @@ -2139,15 +2176,6 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) XN2DFG(0,NY,NX)=XN2DFG(0,NY,NX)+RN2DFG(0,NY,NX) XN3DFG(0,NY,NX)=XN3DFG(0,NY,NX)+RN3DFG(0,NY,NX) XHGDFG(0,NY,NX)=XHGDFG(0,NY,NX)+RHGDFG(0,NY,NX) -C IF(J.EQ.24)THEN -C WRITE(*,323)'RCHDFG',I,J,NX,NY,M,MM,RCHDFG(0,NY,NX) -C 2,DFGS(M,0,NY,NX),CH4G0,VOLWCH(0,NY,NX),CH4S2(0,NY,NX) -C 3,VOLPM(M,0,NY,NX),VOLCHR(NY,NX),RCHDXR -C WRITE(*,323)'ROXDFG',I,J,NX,NY,M,MM,ROXDFG(0,NY,NX) -C 2,DFGS(M,0,NY,NX),OXYG0,VOLWOX(0,NY,NX),OXYS2(0,NY,NX) -C 3,VOLPM(M,0,NY,NX),VOLOXR(NY,NX),ROXDXR,XOXDFG(0,NY,NX) -323 FORMAT(A8,6I4,30E12.4) -C ENDIF ELSE RCODFG(0,NY,NX)=0.0 RCHDFG(0,NY,NX)=0.0 @@ -2163,13 +2191,13 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) C LAYER C IF(THETPM(M,NU(NY,NX),NY,NX).GT.THETX - 2.AND.BKDS(NU(NY,NX),NY,NX).GT.0.0)THEN + 2.AND.BKDS(NU(NY,NX),NY,NX).GT.ZERO)THEN C C GASEOUS DIFFUSIVITIES C DFLG2=AMAX1(0.0,THETPM(M,NU(NY,NX),NY,NX))**2 2/POROQ(NU(NY,NX),NY,NX)*AREA(3,NU(NY,NX),NY,NX) - 3/AMAX1(0.001,DLYR(3,NU(NY,NX),NY,NX)) + 3/AMAX1(ZERO2,DLYR(3,NU(NY,NX),NY,NX)) DCO2G(3,NU(NY,NX),NY,NX)=DFLG2*CGSGL2(NU(NY,NX),NY,NX) DCH4G(3,NU(NY,NX),NY,NX)=DFLG2*CHSGL2(NU(NY,NX),NY,NX) DOXYG(3,NU(NY,NX),NY,NX)=DFLG2*OGSGL2(NU(NY,NX),NY,NX) @@ -2228,10 +2256,10 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) C IF(FLQM(3,NU(NY,NX),NY,NX).GT.0.0)THEN IF(VOLPM(M,NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN - VFLW=-AMAX1(0.0,AMIN1(XFRX,FLQM(3,NU(NY,NX),NY,NX) + VFLW=-AMAX1(0.0,AMIN1(VFLWX,FLQM(3,NU(NY,NX),NY,NX) 2/VOLPM(M,NU(NY,NX),NY,NX))) ELSE - VFLW=-XFRX + VFLW=-VFLWX ENDIF RFLCOG=VFLW*AMAX1(0.0,CO2G2(NU(NY,NX),NY,NX)) RFLCHG=VFLW*AMAX1(0.0,CH4G2(NU(NY,NX),NY,NX)) @@ -2295,7 +2323,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) C C SOIL SURFACE C - IF(THETW1(NU(NY,NX),NY,NX).GT.THETY(NU(NY,NX),NY,NX))THEN + IF(VOLWM(M,NU(NY,NX),NY,NX).GT.ZEROS2(NY,NX))THEN VOLCOT(NY,NX)=VOLWCO(NU(NY,NX),NY,NX)+VOLPM(M,NU(NY,NX),NY,NX) VOLCHT(NY,NX)=VOLWCH(NU(NY,NX),NY,NX)+VOLPM(M,NU(NY,NX),NY,NX) VOLOXT(NY,NX)=VOLWOX(NU(NY,NX),NY,NX)+VOLPM(M,NU(NY,NX),NY,NX) @@ -2329,8 +2357,8 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 3*VOLWN2(NU(NY,NX),NY,NX)-AMAX1(ZEROS(NY,NX) 2,Z2OS2(NU(NY,NX),NY,NX)+RN2DXS) 4*VOLPM(M,NU(NY,NX),NY,NX))/VOLN2T(NY,NX) - IF(VOLN3T(NY,NX).GT.ZEROS(NY,NX) - 2.AND.VOLWXA(NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN + IF(VOLN3T(NY,NX).GT.ZEROS2(NY,NX) + 2.AND.VOLWXA(NU(NY,NX),NY,NX).GT.ZEROS2(NY,NX))THEN RN3DFG(NU(NY,NX),NY,NX)=DFGS(M,NU(NY,NX),NY,NX) 2*(AMAX1(ZEROS(NY,NX),ZN3G2(NU(NY,NX),NY,NX)) 3*VOLWN3(NU(NY,NX),NY,NX)-AMAX1(ZEROS(NY,NX) @@ -2343,8 +2371,8 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) ELSE RN3DFG(NU(NY,NX),NY,NX)=0.0 ENDIF - IF(VOLNBT(NY,NX).GT.ZEROS(NY,NX) - 2.AND.VOLWXB(NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN + IF(VOLNBT(NY,NX).GT.ZEROS2(NY,NX) + 2.AND.VOLWXB(NU(NY,NX),NY,NX).GT.ZEROS2(NY,NX))THEN RNBDFG(NU(NY,NX),NY,NX)=DFGS(M,NU(NY,NX),NY,NX) 2*(AMAX1(ZEROS(NY,NX),ZN3G2(NU(NY,NX),NY,NX)) 3*VOLWNB(NU(NY,NX),NY,NX)-AMAX1(ZEROS(NY,NX) @@ -2462,12 +2490,21 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) N6=L+1 ENDIF ENDIF - IF(N3.GE.NU(N2,N1).AND.N6.GE.NU(N5,N4))THEN - IF(M.NE.MX)THEN + DO 1100 LL=N6,NL(NY,NX) + IF(VOLX(LL,N5,N4).GT.ZEROS(N5,N4))THEN + N6=LL + GO TO 1101 + ENDIF +1100 CONTINUE +1101 CONTINUE C C SOLUTE FLUXES BETWEEN ADJACENT GRID CELLS FROM C WATER CONTENTS AND WATER FLUXES 'FLQM' FROM 'WATSUB' C + IF(VOLX(N3,N2,N1).GT.ZEROS(N2,N1))THEN + IF(N3.GE.NU(N2,N1).AND.N6.GE.NU(N5,N4) + 2.AND.N3.LE.NL(N2,N1).AND.N6.LE.NL(N5,N4))THEN + IF(M.NE.MX)THEN VOLW4A=VOLWM(M,N3,N2,N1)*VLNH4(N3,N2,N1) VOLW4B=VOLWM(M,N3,N2,N1)*VLNHB(N3,N2,N1) VOLH4A=VOLWHM(M,N3,N2,N1)*VLNH4(N3,N2,N1) @@ -2521,11 +2558,11 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) C OF WATER FLUX AND MICROPORE GAS OR SOLUTE CONCENTRATIONS C IN CURRENT GRID CELL C - IF(VOLWM(M,N3,N2,N1).GT.ZEROS(N2,N1))THEN - VFLW=AMAX1(0.0,AMIN1(XFRX,FLWM(M,N,N6,N5,N4) + IF(VOLWM(M,N3,N2,N1).GT.ZEROS2(N2,N1))THEN + VFLW=AMAX1(0.0,AMIN1(VFLWX,FLWM(M,N,N6,N5,N4) 2/VOLWM(M,N3,N2,N1))) ELSE - VFLW=XFRX + VFLW=VFLWX ENDIF DO 9820 K=0,4 RFLOC(K)=VFLW*AMAX1(0.0,OQC2(K,N3,N2,N1)) @@ -2551,18 +2588,18 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) RFLN2B=VFLW*AMAX1(0.0,ZNO2B2(N3,N2,N1)) RFLP1B=VFLW*AMAX1(0.0,H1POB2(N3,N2,N1)) RFLPOB=VFLW*AMAX1(0.0,H2POB2(N3,N2,N1)) - ELSE C C IF MICROPORE WATER FLUX FROM 'WATSUB' IS TO CURRENT FROM C ADJACENT GRID CELL THEN CONVECTIVE TRANSPORT IS THE PRODUCT C OF WATER FLUX AND MICROPORE GAS OR SOLUTE CONCENTRATIONS C IN ADJACENT GRID CELL C - IF(VOLWM(M,N6,N5,N4).GT.ZEROS(N5,N4))THEN - VFLW=AMIN1(0.0,AMAX1(-XFRX,FLWM(M,N,N6,N5,N4) + ELSE + IF(VOLWM(M,N6,N5,N4).GT.ZEROS2(N5,N4))THEN + VFLW=AMIN1(0.0,AMAX1(-VFLWX,FLWM(M,N,N6,N5,N4) 2/VOLWM(M,N6,N5,N4))) ELSE - VFLW=-XFRX + VFLW=-VFLWX ENDIF DO 9815 K=0,4 RFLOC(K)=VFLW*AMAX1(0.0,OQC2(K,N6,N5,N4)) @@ -2595,7 +2632,9 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) C AND CONCENTRATION DIFFERENCES C IF(THETW1(N3,N2,N1).GT.THETY(N3,N2,N1) - 2.AND.THETW1(N6,N5,N4).GT.THETY(N6,N5,N4))THEN + 2.AND.THETW1(N6,N5,N4).GT.THETY(N6,N5,N4) + 3.AND.VOLWM(M,N3,N2,N1).GT.ZEROS2(N2,N1) + 4.AND.VOLWM(M,N6,N5,N4).GT.ZEROS2(N5,N4))THEN C C MICROPORE CONCENTRATIONS FROM WATER-FILLED POROSITY C IN CURRENT AND ADJACENT GRID CELLS @@ -2616,42 +2655,42 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) CZ2GS1=AMAX1(0.0,Z2GS2(N3,N2,N1)/VOLWM(M,N3,N2,N1)) CZ2OS1=AMAX1(0.0,Z2OS2(N3,N2,N1)/VOLWM(M,N3,N2,N1)) CH2GS1=AMAX1(0.0,H2GS2(N3,N2,N1)/VOLWM(M,N3,N2,N1)) - IF(VOLW4A.GT.ZEROS(N2,N1))THEN + IF(VOLW4A.GT.ZEROS2(N2,N1))THEN CNH4S1=AMAX1(0.0,ZNH4S2(N3,N2,N1)/VOLW4A) CNH3S1=AMAX1(0.0,ZN3S2(N3,N2,N1)/VOLW4A) ELSE CNH4S1=0.0 CNH3S1=0.0 ENDIF - IF(VOLW3A.GT.ZEROS(N2,N1))THEN + IF(VOLW3A.GT.ZEROS2(N2,N1))THEN CNO3S1=AMAX1(0.0,ZNO3S2(N3,N2,N1)/VOLW3A) CNO2S1=AMAX1(0.0,ZNO2S2(N3,N2,N1)/VOLW3A) ELSE CNO3S1=0.0 CNO2S1=0.0 ENDIF - IF(VOLW2A.GT.ZEROS(N2,N1))THEN + IF(VOLW2A.GT.ZEROS2(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 + IF(VOLW4B.GT.ZEROS2(N2,N1))THEN CNH4B1=AMAX1(0.0,ZNH4B2(N3,N2,N1)/VOLW4B) CNH3B1=AMAX1(0.0,ZNBS2(N3,N2,N1)/VOLW4B) ELSE CNH4B1=0.0 CNH3B1=0.0 ENDIF - IF(VOLW3B.GT.ZEROS(N2,N1))THEN + IF(VOLW3B.GT.ZEROS2(N2,N1))THEN CNO3B1=AMAX1(0.0,ZNO3B2(N3,N2,N1)/VOLW3B) CNO2B1=AMAX1(0.0,ZNO2B2(N3,N2,N1)/VOLW3B) ELSE CNO3B1=CNO3S1 CNO2B1=CNO2S1 ENDIF - IF(VOLW2B.GT.ZEROS(N2,N1))THEN + IF(VOLW2B.GT.ZEROS2(N2,N1))THEN CP14B1=AMAX1(0.0,H1POB2(N3,N2,N1)/VOLW2B) CPO4B1=AMAX1(0.0,H2POB2(N3,N2,N1)/VOLW2B) ELSE @@ -2664,42 +2703,42 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) CZ2GS2=AMAX1(0.0,Z2GS2(N6,N5,N4)/VOLWM(M,N6,N5,N4)) CZ2OS2=AMAX1(0.0,Z2OS2(N6,N5,N4)/VOLWM(M,N6,N5,N4)) CH2GS2=AMAX1(0.0,H2GS2(N6,N5,N4)/VOLWM(M,N6,N5,N4)) - IF(VOLWMA(N6,N5,N4).GT.ZEROS(N5,N4))THEN + IF(VOLWMA(N6,N5,N4).GT.ZEROS2(N5,N4))THEN CNH3S2=AMAX1(0.0,ZN3S2(N6,N5,N4)/VOLWMA(N6,N5,N4)) CNH4S2=AMAX1(0.0,ZNH4S2(N6,N5,N4)/VOLWMA(N6,N5,N4)) ELSE CNH3S2=0.0 CNH4S2=0.0 ENDIF - IF(VOLWOA.GT.ZEROS(N5,N4))THEN + IF(VOLWOA.GT.ZEROS2(N5,N4))THEN CNO3S2=AMAX1(0.0,ZNO3S2(N6,N5,N4)/VOLWOA) CNO2S2=AMAX1(0.0,ZNO2S2(N6,N5,N4)/VOLWOA) ELSE CNO3S2=0.0 CNO2S2=0.0 ENDIF - IF(VOLWPA.GT.ZEROS(N5,N4))THEN + IF(VOLWPA.GT.ZEROS2(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 + IF(VOLWMB(N6,N5,N4).GT.ZEROS2(N5,N4))THEN CNH3B2=AMAX1(0.0,ZNBS2(N6,N5,N4)/VOLWMB(N6,N5,N4)) CNH4B2=AMAX1(0.0,ZNH4B2(N6,N5,N4)/VOLWMB(N6,N5,N4)) ELSE CNH3B2=CNH3S2 CNH4B2=CNH4S2 ENDIF - IF(VOLWOB.GT.ZEROS(N5,N4))THEN + IF(VOLWOB.GT.ZEROS2(N5,N4))THEN CNO3B2=AMAX1(0.0,ZNO3B2(N6,N5,N4)/VOLWOB) CNO2B2=AMAX1(0.0,ZNO2B2(N6,N5,N4)/VOLWOB) ELSE CNO3B2=CNO3S2 CNO2B2=CNO2S2 ENDIF - IF(VOLWPB.GT.ZEROS(N5,N4))THEN + IF(VOLWPB.GT.ZEROS2(N5,N4))THEN CP14B2=AMAX1(0.0,H1POB2(N6,N5,N4)/VOLWPB) CPO4B2=AMAX1(0.0,H2POB2(N6,N5,N4)/VOLWPB) ELSE @@ -2709,10 +2748,12 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) C C DIFFUSIVITIES IN CURRENT AND ADJACENT GRID CELL MICROPORES C - TORTL=(TORT(M,N3,N2,N1)*DLYR(N,N3,N2,N1) - 2+TORT(M,N6,N5,N4)*DLYR(N,N6,N5,N4)) - 3/(DLYR(N,N3,N2,N1)+DLYR(N,N6,N5,N4)) - DISPN=DISP(N,N6,N5,N4)*ABS(FLWM(M,N,N6,N5,N4)/AREA(N,N6,N5,N4)) + DLYR1=AMAX1(ZERO2,DLYR(N,N3,N2,N1)) + DLYR2=AMAX1(ZERO2,DLYR(N,N6,N5,N4)) + TORTL=(TORT(M,N3,N2,N1)*DLYR1+TORT(M,N6,N5,N4)*DLYR2) + 2/(DLYR1+DLYR2) + DISPN=DISP(N,N6,N5,N4) + 2*AMIN1(VFLWX,ABS(FLWM(M,N,N6,N5,N4)/AREA(N,N6,N5,N4))) DIFOC=(OCSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) DIFON=(ONSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) DIFOP=(OPSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) @@ -2802,11 +2843,11 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) C OF WATER FLUX AND MACROPORE SOLUTE CONCENTRATIONS IN CURRENT C GRID CELL C - IF(VOLWHM(M,N3,N2,N1).GT.ZEROS(N2,N1))THEN - VFLW=AMAX1(0.0,AMIN1(XFRX,FLWHM(M,N,N6,N5,N4) + IF(VOLWHM(M,N3,N2,N1).GT.ZEROS2(N2,N1))THEN + VFLW=AMAX1(0.0,AMIN1(VFLWX,FLWHM(M,N,N6,N5,N4) 2/VOLWHM(M,N3,N2,N1))) ELSE - VFLW=XFRX + VFLW=VFLWX ENDIF C C ACCOUNT FOR OVERLAND TRANSPORT IN THE SURFACE SOIL LAYER @@ -2906,11 +2947,11 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) C OF WATER FLUX AND MACROPORE SOLUTE CONCENTRATIONS IN ADJACENT C GRID CELL C - IF(VOLWHM(M,N6,N5,N4).GT.ZEROS(N5,N4))THEN - VFLW=AMIN1(0.0,AMAX1(-XFRX,FLWHM(M,N,N6,N5,N4) + IF(VOLWHM(M,N6,N5,N4).GT.ZEROS2(N5,N4))THEN + VFLW=AMIN1(0.0,AMAX1(-VFLWX,FLWHM(M,N,N6,N5,N4) 2/VOLWHM(M,N6,N5,N4))) ELSE - VFLW=-XFRX + VFLW=-VFLWX ENDIF DO 9665 K=0,4 RFHOC(K)=VFLW*AMAX1(0.0,OQCH2(K,N6,N5,N4)) @@ -2991,42 +3032,42 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) CZ2GSH1=AMAX1(0.0,Z2GSH2(N3,N2,N1)/VOLWHM(M,N3,N2,N1)) CZ2OSH1=AMAX1(0.0,Z2OSH2(N3,N2,N1)/VOLWHM(M,N3,N2,N1)) CH2GSH1=AMAX1(0.0,H2GSH2(N3,N2,N1)/VOLWHM(M,N3,N2,N1)) - IF(VOLH4A.GT.ZEROS(N2,N1))THEN + IF(VOLH4A.GT.ZEROS2(N2,N1))THEN CNH4SH1=AMAX1(0.0,ZNH4H2(N3,N2,N1)/VOLH4A) CNH3SH1=AMAX1(0.0,ZNH3H2(N3,N2,N1)/VOLH4A) ELSE CNH4SH1=0.0 CNH3SH1=0.0 ENDIF - IF(VOLH3A.GT.ZEROS(N2,N1))THEN + IF(VOLH3A.GT.ZEROS2(N2,N1))THEN CNO3SH1=AMAX1(0.0,ZNO3H2(N3,N2,N1)/VOLH3A) CNO2SH1=AMAX1(0.0,ZNO2H2(N3,N2,N1)/VOLH3A) ELSE CNO3SH1=0.0 CNO2SH1=0.0 ENDIF - IF(VOLH2A.GT.ZEROS(N2,N1))THEN + IF(VOLH2A.GT.ZEROS2(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 + IF(VOLH4B.GT.ZEROS2(N2,N1))THEN CNH4BH1=AMAX1(0.0,ZN4BH2(N3,N2,N1)/VOLH4B) CNH3BH1=AMAX1(0.0,ZN3BH2(N3,N2,N1)/VOLH4B) ELSE CNH4BH1=CNH4SH1 CNH3BH1=CNH3SH1 ENDIF - IF(VOLH3B.GT.ZEROS(N2,N1))THEN + IF(VOLH3B.GT.ZEROS2(N2,N1))THEN CNO3BH1=AMAX1(0.0,ZNOBH2(N3,N2,N1)/VOLH3B) CNO2BH1=AMAX1(0.0,ZN2BH2(N3,N2,N1)/VOLH3B) ELSE CNO3BH1=CNO3SH1 CNO2BH1=CNO2SH1 ENDIF - IF(VOLH2B.GT.ZEROS(N2,N1))THEN + IF(VOLH2B.GT.ZEROS2(N2,N1))THEN CP14BH1=AMAX1(0.0,H1PBH2(N3,N2,N1)/VOLH2B) CPO4BH1=AMAX1(0.0,H2PBH2(N3,N2,N1)/VOLH2B) ELSE @@ -3040,7 +3081,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) CZ2OSH2=AMAX1(0.0,Z2OSH2(N6,N5,N4)/VOLWHM(M,N6,N5,N4)) CH2GSH2=AMAX1(0.0,H2GSH2(N6,N5,N4)/VOLWHM(M,N6,N5,N4)) VOLHMA=VOLWHM(M,N6,N5,N4)*VLNH4(N6,N5,N4) - IF(VOLHMA.GT.ZEROS(N5,N4))THEN + IF(VOLHMA.GT.ZEROS2(N5,N4))THEN CNH4SH2=AMAX1(0.0,ZNH4H2(N6,N5,N4)/VOLHMA) CNH3SH2=AMAX1(0.0,ZNH3H2(N6,N5,N4)/VOLHMA) ELSE @@ -3048,7 +3089,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) CNH3SH2=0.0 ENDIF VOLHOA=VOLWHM(M,N6,N5,N4)*VLNO3(N6,N5,N4) - IF(VOLHOA.GT.ZEROS(N5,N4))THEN + IF(VOLHOA.GT.ZEROS2(N5,N4))THEN CNO3SH2=AMAX1(0.0,ZNO3H2(N6,N5,N4)/VOLHOA) CNO2SH2=AMAX1(0.0,ZNO2H2(N6,N5,N4)/VOLHOA) ELSE @@ -3056,7 +3097,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) CNO2SH2=0.0 ENDIF VOLHPA=VOLWHM(M,N6,N5,N4)*VLPO4(N6,N5,N4) - IF(VOLHPA.GT.ZEROS(N5,N4))THEN + IF(VOLHPA.GT.ZEROS2(N5,N4))THEN CP14SH2=AMAX1(0.0,H1P4H2(N6,N5,N4)/VOLHPA) CPO4SH2=AMAX1(0.0,H2P4H2(N6,N5,N4)/VOLHPA) ELSE @@ -3064,7 +3105,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) CPO4SH2=0.0 ENDIF VOLHMB=VOLWHM(M,N6,N5,N4)*VLNHB(N6,N5,N4) - IF(VOLHMB.GT.ZEROS(N5,N4))THEN + IF(VOLHMB.GT.ZEROS2(N5,N4))THEN CNH4BH2=AMAX1(0.0,ZN4BH2(N6,N5,N4)/VOLHMB) CNH3BH2=AMAX1(0.0,ZN3BH2(N6,N5,N4)/VOLHMB) ELSE @@ -3072,7 +3113,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) CNH3BH2=CNH3SH2 ENDIF VOLHOB=VOLWHM(M,N6,N5,N4)*VLNOB(N6,N5,N4) - IF(VOLHOB.GT.ZEROS(N5,N4))THEN + IF(VOLHOB.GT.ZEROS2(N5,N4))THEN CNO3BH2=AMAX1(0.0,ZNOBH2(N6,N5,N4)/VOLHOB) CNO2BH2=AMAX1(0.0,ZN2BH2(N6,N5,N4)/VOLHOB) ELSE @@ -3080,7 +3121,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) CNO2BH2=CNO2SH2 ENDIF VOLHPB=VOLWHM(M,N6,N5,N4)*VLPOB(N6,N5,N4) - IF(VOLHPB.GT.ZEROS(N5,N4))THEN + IF(VOLHPB.GT.ZEROS2(N5,N4))THEN CP14BH2=AMAX1(0.0,H1PBH2(N6,N5,N4)/VOLHPB) CPO4BH2=AMAX1(0.0,H2PBH2(N6,N5,N4)/VOLHPB) ELSE @@ -3090,10 +3131,12 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) C C DIFFUSIVITIES IN CURRENT AND ADJACENT GRID CELL MACROPORES C - TORTL=(TORTH(M,N3,N2,N1)*DLYR(N,N3,N2,N1) - 2+TORTH(M,N6,N5,N4)*DLYR(N,N6,N5,N4)) - 3/(DLYR(N,N3,N2,N1)+DLYR(N,N6,N5,N4)) - DISPN=DISP(N,N6,N5,N4)*ABS(FLWHM(M,N,N6,N5,N4)/AREA(N,N6,N5,N4)) + DLYR1=AMAX1(ZERO2,DLYR(N,N3,N2,N1)) + DLYR2=AMAX1(ZERO2,DLYR(N,N6,N5,N4)) + TORTL=(TORTH(M,N3,N2,N1)*DLYR1+TORTH(M,N6,N5,N4)*DLYR2) + 3/(DLYR1+DLYR2) + DISPN=DISP(N,N6,N5,N4) + 2*AMIN1(VFLWX,ABS(FLWHM(M,N,N6,N5,N4)/AREA(N,N6,N5,N4))) DIFOC=(OCSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) DIFON=(ONSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) DIFOP=(OPSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) @@ -3226,7 +3269,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) RNXFHB(N,N6,N5,N4)=RFHN2B+DFHN2B RH1BHB(N,N6,N5,N4)=RFHP1B+DFHP1B RH2BHB(N,N6,N5,N4)=RFHPOB+DFHPOB -C IF(M.NE.MX.AND.J.EQ.12)THEN +C IF(IYRC.EQ.2006.AND.I.EQ.361.AND.NX.EQ.1)THEN C WRITE(*,443)'RCOFLS',I,J,N4,N5,N6,M,MM,N C 2,RCOFLS(N,N6,N5,N4),RFLCOS,DFVCOS,DIFCS,CCO2S1,CCO2S2 C 3,CLSGL2(N6,N5,N4),TORTL,DISPN,XDPTH(N,N6,N5,N4) @@ -3234,6 +3277,10 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) C WRITE(*,443)'ROXFLS',I,J,M,MM,N4,N5,N6,N C 2,ROXFLS(N,N6,N5,N4),RFLOXS,DFVOXS,DIFOS,COXYS1,COXYS2 C 3,OLSGL2(N6,N5,N4),TORTL,DISPN,XDPTH(N,N6,N5,N4) +C WRITE(*,443)'RN3FLW',I,J,M,MM,N4,N5,N6,N +C 2,RN3FLW(N,N6,N5,N4),RFLNH3,DFVNH3,DIFNH,CNH3S1,CNH3S2 +C 3,ZHSGL2(N6,N5,N4),TORTL,DIFNH0,DIFNH1,DISPN,XDPTH(N,N6,N5,N4) +C 4,VFLW,ZN3S2(N3,N2,N1),ZN3S2(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 @@ -3298,11 +3345,11 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) C MACROPORE TO MICROPORE TRANSFER C IF(FINHM(M,N6,N5,N4).GT.0.0)THEN - IF(VOLWHM(M,N6,N5,N4).GT.ZEROS(N5,N4))THEN - VFLW=AMAX1(0.0,AMIN1(XFRX,FINHM(M,N6,N5,N4) + IF(VOLWHM(M,N6,N5,N4).GT.ZEROS2(N5,N4))THEN + VFLW=AMAX1(0.0,AMIN1(VFLWX,FINHM(M,N6,N5,N4) 2/VOLWHM(M,N6,N5,N4))) ELSE - VFLW=XFRX + VFLW=VFLWX ENDIF DO 9970 K=0,4 RFLOC(K)=VFLW*AMAX1(0.0,OQCH2(K,N6,N5,N4)) @@ -3332,11 +3379,11 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) C MICROPORE TO MACROPORE TRANSFER C ELSEIF(FINHM(M,N6,N5,N4).LT.0.0)THEN - IF(VOLWM(M,N6,N5,N4).GT.ZEROS(N5,N4))THEN - VFLW=AMIN1(0.0,AMAX1(-XFRX,FINHM(M,N6,N5,N4) + IF(VOLWM(M,N6,N5,N4).GT.ZEROS2(N5,N4))THEN + VFLW=AMIN1(0.0,AMAX1(-VFLWX,FINHM(M,N6,N5,N4) 2/VOLWM(M,N6,N5,N4))) ELSE - VFLW=-XFRX + VFLW=-VFLWX ENDIF DO 9965 K=0,4 RFLOC(K)=VFLW*AMAX1(0.0,OQC2(K,N6,N5,N4)) @@ -3396,7 +3443,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) C MACROPORES FROM AQUEOUS DIFFUSIVITIES AND CONCENTRATION C DIFFERENCES C - IF(VOLWHM(M,N6,N5,N4).GT.ZEROS(N5,N4))THEN + IF(VOLWHM(M,N6,N5,N4).GT.ZEROS2(N5,N4))THEN VOLWHS=AMIN1(XFRS*VOLT(N6,N5,N4),VOLWHM(M,N6,N5,N4)) VOLWT=VOLWM(M,N6,N5,N4)+VOLWHS DO 9955 K=0,4 @@ -3610,10 +3657,10 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) DFVHGG=DH2GG(N,N6,N5,N4)*(CH2GG1-CH2GG2) IF(FLQM(N,N6,N5,N4).GT.0.0)THEN IF(VOLPM(M,N6,N5,N4).GT.ZEROS(N5,N4))THEN - VFLW=-AMAX1(0.0,AMIN1(XFRX,FLQM(N,N6,N5,N4) + VFLW=-AMAX1(0.0,AMIN1(VFLWX,FLQM(N,N6,N5,N4) 2/VOLPM(M,N6,N5,N4))) ELSE - VFLW=-XFRX + VFLW=-VFLWX ENDIF RFLCOG=VFLW*AMAX1(0.0,CO2G2(N6,N5,N4)) RFLCHG=VFLW*AMAX1(0.0,CH4G2(N6,N5,N4)) @@ -3624,10 +3671,10 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) RFLH2G=VFLW*AMAX1(0.0,H2GG2(N6,N5,N4)) ELSE IF(VOLPM(M,N3,N2,N1).GT.ZEROS(N2,N1))THEN - VFLW=-AMIN1(0.0,AMAX1(-XFRX,FLQM(N,N6,N5,N4) + VFLW=-AMIN1(0.0,AMAX1(-VFLWX,FLQM(N,N6,N5,N4) 2/VOLPM(M,N3,N2,N1))) ELSE - VFLW=XFRX + VFLW=VFLWX ENDIF RFLCOG=VFLW*AMAX1(0.0,CO2G2(N3,N2,N1)) RFLCHG=VFLW*AMAX1(0.0,CH4G2(N3,N2,N1)) @@ -3708,7 +3755,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 3-Z2OS2(N6,N5,N4)*VOLPM(M,N6,N5,N4)) 3/(VOLWN2(N6,N5,N4)+VOLPM(M,N6,N5,N4)) IF(VOLPMA(N6,N5,N4).GT.ZEROS(N5,N4) - 2.AND.VOLWXA(N6,N5,N4).GT.ZEROS(N5,N4))THEN + 2.AND.VOLWXA(N6,N5,N4).GT.ZEROS2(N5,N4))THEN RN3DFG(N6,N5,N4)=DFGS(M,N6,N5,N4)*(AMAX1(ZEROS(N5,N4) 2,ZN3G2(N6,N5,N4))*VOLWN3(N6,N5,N4) 3-ZN3S2(N6,N5,N4)*VOLPMA(N6,N5,N4)) @@ -3721,7 +3768,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) RN3DFG(N6,N5,N4)=0.0 ENDIF IF(VOLPMB(N6,N5,N4).GT.ZEROS(N5,N4) - 2.AND.VOLWXB(N6,N5,N4).GT.ZEROS(N5,N4))THEN + 2.AND.VOLWXB(N6,N5,N4).GT.ZEROS2(N5,N4))THEN RNBDFG(N6,N5,N4)=DFGS(M,N6,N5,N4)*(AMAX1(ZEROS(N5,N4) 2,ZN3G2(N6,N5,N4))*VOLWNB(N6,N5,N4) 3-ZNBS2(N6,N5,N4)*VOLPMB(N6,N5,N4)) @@ -3834,6 +3881,67 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) RN3FLG(N,N6,N5,N4)=0.0 RHGFLG(N,N6,N5,N4)=0.0 ENDIF + ELSE + DCO2G(N,N3,N2,N1)=0.0 + DCH4G(N,N3,N2,N1)=0.0 + DOXYG(N,N3,N2,N1)=0.0 + DZ2GG(N,N3,N2,N1)=0.0 + DZ2OG(N,N3,N2,N1)=0.0 + DNH3G(N,N3,N2,N1)=0.0 + DH2GG(N,N3,N2,N1)=0.0 + DO 9751 K=0,4 + ROCFLS(K,N,N3,N2,N1)=0.0 + RONFLS(K,N,N3,N2,N1)=0.0 + ROPFLS(K,N,N3,N2,N1)=0.0 + ROAFLS(K,N,N3,N2,N1)=0.0 + ROCFHS(K,N,N3,N2,N1)=0.0 + RONFHS(K,N,N3,N2,N1)=0.0 + ROPFHS(K,N,N3,N2,N1)=0.0 + ROAFHS(K,N,N3,N2,N1)=0.0 +9751 CONTINUE + RCOFLS(N,N3,N2,N1)=0.0 + RCHFLS(N,N3,N2,N1)=0.0 + ROXFLS(N,N3,N2,N1)=0.0 + RNGFLS(N,N3,N2,N1)=0.0 + RN2FLS(N,N3,N2,N1)=0.0 + RHGFLS(N,N3,N2,N1)=0.0 + RN4FLW(N,N3,N2,N1)=0.0 + RN3FLW(N,N3,N2,N1)=0.0 + RNOFLW(N,N3,N2,N1)=0.0 + RNXFLS(N,N3,N2,N1)=0.0 + RH1PFS(N,N3,N2,N1)=0.0 + RH2PFS(N,N3,N2,N1)=0.0 + RN4FLB(N,N3,N2,N1)=0.0 + RN3FLB(N,N3,N2,N1)=0.0 + RNOFLB(N,N3,N2,N1)=0.0 + RNXFLB(N,N3,N2,N1)=0.0 + RH2BFB(N,N3,N2,N1)=0.0 + RCOFHS(N,N3,N2,N1)=0.0 + RCHFHS(N,N3,N2,N1)=0.0 + ROXFHS(N,N3,N2,N1)=0.0 + RNGFHS(N,N3,N2,N1)=0.0 + RN2FHS(N,N3,N2,N1)=0.0 + RHGFHS(N,N3,N2,N1)=0.0 + RN4FHW(N,N3,N2,N1)=0.0 + RN3FHW(N,N3,N2,N1)=0.0 + RNOFHW(N,N3,N2,N1)=0.0 + RNXFHS(N,N3,N2,N1)=0.0 + RH1PHS(N,N3,N2,N1)=0.0 + RH2PHS(N,N3,N2,N1)=0.0 + RN4FHB(N,N3,N2,N1)=0.0 + RN3FHB(N,N3,N2,N1)=0.0 + RNOFHB(N,N3,N2,N1)=0.0 + RNXFHB(N,N3,N2,N1)=0.0 + RH1BHB(N,N3,N2,N1)=0.0 + RH2BHB(N,N3,N2,N1)=0.0 + RCOFLG(N,N3,N2,N1)=0.0 + RCHFLG(N,N3,N2,N1)=0.0 + ROXFLG(N,N3,N2,N1)=0.0 + RNGFLG(N,N3,N2,N1)=0.0 + RN2FLG(N,N3,N2,N1)=0.0 + RN3FLG(N,N3,N2,N1)=0.0 + RHGFLG(N,N3,N2,N1)=0.0 + ENDIF 120 CONTINUE C C CHECK FOR BUBBLING IF THE SUM OF ALL GASEOUS EQUIVALENT @@ -3852,6 +3960,16 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) C C GASEOUS EQUIVALENT PARTIAL CONCENTRATIONS C + IF(N3.EQ.NU(N2,N1))THEN + VCO2G2=(CO2S2(N3,N2,N1)+RCODFS(NY,NX))/SCO2X + VCH4G2=(CH4S2(N3,N2,N1)+RCHDFS(NY,NX))/SCH4X + VOXYG2=(OXYS2(N3,N2,N1)+ROXDFS(NY,NX))/SOXYX + VZ2GG2=(Z2GS2(N3,N2,N1)+RNGDFS(NY,NX))/SN2GX + VZ2OG2=(Z2OS2(N3,N2,N1)+RN2DFS(NY,NX))/SN2OX + VNH3G2=(ZN3S2(N3,N2,N1)+RN3DFS(NY,NX))/SNH3X + VNHBG2=(ZNBS2(N3,N2,N1)+RNBDFS(NY,NX))/SNH3X + VH2GG2=(H2GS2(N3,N2,N1)+RHGDFS(NY,NX))/SH2GX + ELSE VCO2G2=CO2S2(N3,N2,N1)/SCO2X VCH4G2=CH4S2(N3,N2,N1)/SCH4X VOXYG2=OXYS2(N3,N2,N1)/SOXYX @@ -3860,6 +3978,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) VNH3G2=ZN3S2(N3,N2,N1)/SNH3X VNHBG2=ZNBS2(N3,N2,N1)/SNH3X VH2GG2=H2GS2(N3,N2,N1)/SH2GX + ENDIF C C GASEOUS EQUIVALENT ATMOSPHERIC CONCENTRATION C @@ -3869,7 +3988,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) C PROPORTIONAL REMOVAL OF EXCESS AQUEOUS GASES C IF(VTGAS.GT.VTATM)THEN - DVTGAS=VTATM-VTGAS + DVTGAS=0.5*(VTATM-VTGAS) RCOBBL(N3,N2,N1)=AMIN1(0.0,DVTGAS*VCO2G2/VTGAS)*SCO2X RCHBBL(N3,N2,N1)=AMIN1(0.0,DVTGAS*VCH4G2/VTGAS)*SCH4X ROXBBL(N3,N2,N1)=AMIN1(0.0,DVTGAS*VOXYG2/VTGAS)*SOXYX @@ -3910,11 +4029,17 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) RNBBBL(N3,N2,N1)=0.0 RHGBBL(N3,N2,N1)=0.0 ENDIF -C IF(N1.EQ.2.AND.N2.EQ.1.AND.N3.EQ.13)THEN -C WRITE(*,6688)'BUBBL',I,J,N1,N2,N3,M,MM,IFLGB,VTGAS,VTATM +C IF(I.EQ.296)THEN +C WRITE(*,6688)'RCOBBL',I,J,N1,N2,N3,M,MM,IFLGB +C 2,RCOBBL(N3,N2,N1),XCOBBL(N3,N2,N1),VTGAS,VTATM +C 2,DVTGAS,SCO2X,VCO2G2,VCH4G2,VOXYG2,VZ2GG2,VZ2OG2 +C 3,VNH3G2,VNHBG2,VH2GG2 +C 4,CO2S2(N3,N2,N1),VOLWM(M,N3,N2,N1) +C WRITE(*,6688)'ROXBBL',I,J,N1,N2,N3,M,MM,IFLGB +C 2,ROXBBL(N3,N2,N1),XOXBBL(N3,N2,N1),VTGAS,VTATM C 2,DVTGAS,SOXYX,VCO2G2,VCH4G2,VOXYG2,VZ2GG2,VZ2OG2 -C 3,VNH3G2,VNHBG2,VH2GG2,ROXBBL(N3,N2,N1),XOXBBL(N3,N2,N1) -C 4,OXYS2(N3,N2,N1),VOLWM(M,N3,N2,N1) +C 3,VNH3G2,VNHBG2,VH2GG2,SOXYL(N3,N2,N1) +C 4,OXYS2(N3,N2,N1),VOLWM(M,N3,N2,N1),TCS(N3,N2,N1) 6688 FORMAT(A8,8I4,20E12.4) C ENDIF ENDIF @@ -4051,8 +4176,8 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) C ELSEIF(NN.EQ.1.AND.QRM(M,N,M5,M4).GT.0.0 2.OR.NN.EQ.2.AND.QRM(M,N,M5,M4).LT.0.0)THEN - IF(VOLWM(M,0,M2,M1).GT.ZEROS(M2,M1))THEN - VFLW=AMAX1(-XFRX,AMIN1(XFRX,QRM(M,N,M5,M4) + IF(VOLWM(M,0,M2,M1).GT.ZEROS2(M2,M1))THEN + VFLW=AMAX1(0.0,AMIN1(VFLWX,QRM(M,N,M5,M4) 2/VOLWM(M,0,M2,M1))) ELSE VFLW=0.0 @@ -4147,11 +4272,12 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) C C SOLUTE LOSS WITH SUBSURFACE MICROPORE WATER LOSS C + IF(VOLX(N3,N2,N1).GT.ZEROS(N2,N1))THEN IF(NCN(M2,M1).NE.3.OR.N.EQ.3)THEN IF(NN.EQ.1.AND.FLWM(M,N,M6,M5,M4).GT.0.0 2.OR.NN.EQ.2.AND.FLWM(M,N,M6,M5,M4).LT.0.0)THEN - IF(VOLWM(M,M3,M2,M1).GT.ZEROS(M2,M1))THEN - VFLW=AMAX1(-XFRX,AMIN1(XFRX,FLWM(M,N,M6,M5,M4) + IF(VOLWM(M,M3,M2,M1).GT.ZEROS2(M2,M1))THEN + VFLW=AMAX1(-VFLWX,AMIN1(VFLWX,FLWM(M,N,M6,M5,M4) 2/VOLWM(M,M3,M2,M1))) ELSE VFLW=0.0 @@ -4197,7 +4323,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 8765 FORMAT(A8,6I4,20E12.4) C ENDIF C -C NO SOLUTE GAIN WITH SUBSURFACE MICROPORE WATER GAIN +C SOLUTE GAIN WITH SUBSURFACE MICROPORE WATER GAIN C ELSE DO 9515 K=0,4 @@ -4212,17 +4338,28 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) RNGFLS(N,M6,M5,M4)=0.0 RN2FLS(N,M6,M5,M4)=0.0 RHGFLS(N,M6,M5,M4)=0.0 - RN4FLW(N,M6,M5,M4)=0.0 - RN3FLW(N,M6,M5,M4)=0.0 - RNOFLW(N,M6,M5,M4)=0.0 + RN4FLW(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CN4U(L,NY,NX) + 2*VLNH4(M3,M2,M1) + RN3FLW(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CN3U(L,NY,NX) + 2*VLNH4(M3,M2,M1) + RNOFLW(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4) + 2*CNOU(L,NY,NX)*VLNO3(M3,M2,M1) RNXFLS(N,M6,M5,M4)=0.0 - RH1PFS(N,M6,M5,M4)=0.0 - RH2PFS(N,M6,M5,M4)=0.0 - RN4FLB(N,M6,M5,M4)=0.0 - RN3FLB(N,M6,M5,M4)=0.0 - RNOFLB(N,M6,M5,M4)=0.0 + RH1PFS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CH1PU(L,NY,NX) + 2*VLPO4(M3,M2,M1) + RH2PFS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CH2PU(L,NY,NX) + 2*VLPO4(M3,M2,M1) + RN4FLB(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CN4U(L,NY,NX) + 2*VLNHB(M3,M2,M1) + RN3FLB(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CN3U(L,NY,NX) + 2*VLNHB(M3,M2,M1) + RNOFLB(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CNOU(L,NY,NX) + 2*VLNOB(M3,M2,M1) RNXFLB(N,M6,M5,M4)=0.0 - RH2BFB(N,M6,M5,M4)=0.0 + RH1BFB(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CH1PU(L,NY,NX) + 2*VLPOB(M3,M2,M1) + RH2BFB(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CH2PU(L,NY,NX) + 2*VLPOB(M3,M2,M1) ENDIF C IF(M.NE.MX.AND.I.GE.180.AND.I.LE.200)THEN C WRITE(*,1115)'LEACHX',I,J,M1,M2,M3,M,MM,N @@ -4236,8 +4373,8 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) C IF(NN.EQ.1.AND.FLWHM(M,N,M6,M5,M4).GT.0.0 2.OR.NN.EQ.2.AND.FLWHM(M,N,M6,M5,M4).LT.0.0)THEN - IF(VOLWHM(M,M3,M2,M1).GT.ZEROS(M2,M1))THEN - VFLW=AMAX1(-XFRX,AMIN1(XFRX,FLWHM(M,N,M6,M5,M4) + IF(VOLWHM(M,M3,M2,M1).GT.ZEROS2(M2,M1))THEN + VFLW=AMAX1(-VFLWX,AMIN1(VFLWX,FLWHM(M,N,M6,M5,M4) 2/VOLWHM(M,M3,M2,M1))) ELSE VFLW=0.0 @@ -4358,45 +4495,13 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) ENDIF ENDIF C -C NO GASOUS GAIN WITH SUBSURFACE MICROPORE WATER LOSS -C - FLGM=(FLWM(M,N,M6,M5,M4)+FLWHM(M,N,M6,M5,M4))*XNPT -C IF(NN.EQ.1.AND.FLGM.GT.0.0 -C 2.OR.NN.EQ.2.AND.FLGM.LT.0.0)THEN -C IF(VOLPM(M,M3,M2,M1).GT.ZEROS(M2,M1))THEN -C VFLW=-AMAX1(-XFRX,AMIN1(XFRX,FLGM -C 2/VOLPM(M,M3,M2,M1))) -C ELSE -C VFLW=0.0 -C ENDIF -C RCOFLG(N,M6,M5,M4)=VFLW*AMAX1(0.0,CO2G2(M3,M2,M1)) -C RCHFLG(N,M6,M5,M4)=VFLW*AMAX1(0.0,CH4G2(M3,M2,M1)) -C ROXFLG(N,M6,M5,M4)=VFLW*AMAX1(0.0,OXYG2(M3,M2,M1)) -C RNGFLG(N,M6,M5,M4)=VFLW*AMAX1(0.0,Z2GG2(M3,M2,M1)) -C RN2FLG(N,M6,M5,M4)=VFLW*AMAX1(0.0,Z2OG2(M3,M2,M1)) -C RN3FLG(N,M6,M5,M4)=VFLW*AMAX1(0.0,ZN3G2(M3,M2,M1)) -C RHGFLG(N,M6,M5,M4)=VFLW*AMAX1(0.0,H2GG2(M3,M2,M1)) -C XCOFLG(N,M6,M5,M4)=XCOFLG(N,M6,M5,M4)+RCOFLG(N,M6,M5,M4) -C XCHFLG(N,M6,M5,M4)=XCHFLG(N,M6,M5,M4)+RCHFLG(N,M6,M5,M4) -C XOXFLG(N,M6,M5,M4)=XOXFLG(N,M6,M5,M4)+ROXFLG(N,M6,M5,M4) -C XNGFLG(N,M6,M5,M4)=XNGFLG(N,M6,M5,M4)+RNGFLG(N,M6,M5,M4) -C XN2FLG(N,M6,M5,M4)=XN2FLG(N,M6,M5,M4)+RN2FLG(N,M6,M5,M4) -C XN3FLG(N,M6,M5,M4)=XN3FLG(N,M6,M5,M4)+RN3FLG(N,M6,M5,M4) -C XHGFLG(N,M6,M5,M4)=XHGFLG(N,M6,M5,M4)+RHGFLG(N,M6,M5,M4) -C IF(FLGM.NE.0.0)THEN -C WRITE(*,8766)'GAS IN',I,J,M,MM,N,NN,M3,M2,M1,M6,M5,M4 -C 2,VFLW,VOLPM(M,M3,M2,M1),ROXFLG(N,M6,M5,M4) -C 3,OXYG2(M3,M2,M1),FLGM,FLWM(M,N,M6,M5,M4) -C 4,FLWHM(M,N,M6,M5,M4) -8766 FORMAT(A8,12I4,20E12.4) -C ENDIF -C C GASOUS LOSS WITH SUBSURFACE MICROPORE WATER GAIN C + FLGM=(FLWM(M,N,M6,M5,M4)+FLWHM(M,N,M6,M5,M4))*XNPT IF(NN.EQ.1.AND.FLGM.LT.0.0 2.OR.NN.EQ.2.AND.FLGM.GT.0.0)THEN IF(VOLPM(M,M3,M2,M1).GT.ZEROS(M2,M1))THEN - VFLW=-AMAX1(-XFRX,AMIN1(XFRX,FLGM + VFLW=-AMAX1(-VFLWX,AMIN1(VFLWX,FLGM 2/VOLPM(M,M3,M2,M1))) ELSE VFLW=0.0 @@ -4430,6 +4535,39 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) RN3FLG(N,M6,M5,M4)=0.0 RHGFLG(N,M6,M5,M4)=0.0 ENDIF + ELSE + DO 9531 K=0,4 + ROCFHS(K,N,M6,M5,M4)=0.0 + RONFHS(K,N,M6,M5,M4)=0.0 + ROPFHS(K,N,M6,M5,M4)=0.0 + ROAFHS(K,N,M6,M5,M4)=0.0 +9531 CONTINUE + RCOFHS(N,M6,M5,M4)=0.0 + RCHFHS(N,M6,M5,M4)=0.0 + ROXFHS(N,M6,M5,M4)=0.0 + RNGFHS(N,M6,M5,M4)=0.0 + RN2FHS(N,M6,M5,M4)=0.0 + RN4FHW(N,M6,M5,M4)=0.0 + RHGFHS(N,M6,M5,M4)=0.0 + RN3FHW(N,M6,M5,M4)=0.0 + RNOFHW(N,M6,M5,M4)=0.0 + RNXFHS(N,M6,M5,M4)=0.0 + RH1PHS(N,M6,M5,M4)=0.0 + RH2PHS(N,M6,M5,M4)=0.0 + RN4FHB(N,M6,M5,M4)=0.0 + RN3FHB(N,M6,M5,M4)=0.0 + RNOFHB(N,M6,M5,M4)=0.0 + RNXFHB(N,M6,M5,M4)=0.0 + RH1BHB(N,M6,M5,M4)=0.0 + RH2BHB(N,M6,M5,M4)=0.0 + RCOFLG(N,M6,M5,M4)=0.0 + RCHFLG(N,M6,M5,M4)=0.0 + ROXFLG(N,M6,M5,M4)=0.0 + RNGFLG(N,M6,M5,M4)=0.0 + RN2FLG(N,M6,M5,M4)=0.0 + RN3FLG(N,M6,M5,M4)=0.0 + RHGFLG(N,M6,M5,M4)=0.0 + ENDIF 9575 CONTINUE C C TOTAL GAS AND SOLUTE FLUXES IN EACH GRID CELL @@ -4472,8 +4610,16 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) C C TOTAL SOLUTE FLUX IN MICROPORES AND MACROPORES C - IF(M.NE.MX)THEN IF(NCN(N2,N1).NE.3.OR.N.EQ.3)THEN + DO 1200 LL=N6,NL(NY,NX) + IF(VOLX(LL,N2,N1).GT.ZEROS(N2,N1))THEN + N6=LL + GO TO 1201 + ENDIF +1200 CONTINUE +1201 CONTINUE + IF(M.NE.MX)THEN + IF(VOLX(N3,N2,N1).GT.ZEROS(N2,N1))THEN DO 9545 K=0,4 TOCFLS(K,N3,N2,N1)=TOCFLS(K,N3,N2,N1)+ROCFLS(K,N,N3,N2,N1) 2-ROCFLS(K,N,N6,N5,N4) @@ -4564,12 +4710,66 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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) + ELSE + DO 9546 K=0,4 + TOCFLS(K,N3,N2,N1)=0.0 + TONFLS(K,N3,N2,N1)=0.0 + TOPFLS(K,N3,N2,N1)=0.0 + TOAFLS(K,N3,N2,N1)=0.0 + TOCFHS(K,N3,N2,N1)=0.0 + TONFHS(K,N3,N2,N1)=0.0 + TOPFHS(K,N3,N2,N1)=0.0 + TOAFHS(K,N3,N2,N1)=0.0 +9546 CONTINUE + TCOFLS(N3,N2,N1)=0.0 + TCHFLS(N3,N2,N1)=0.0 + TOXFLS(N3,N2,N1)=0.0 + TNGFLS(N3,N2,N1)=0.0 + TN2FLS(N3,N2,N1)=0.0 + THGFLS(N3,N2,N1)=0.0 + TN4FLW(N3,N2,N1)=0.0 + TN3FLW(N3,N2,N1)=0.0 + TNOFLW(N3,N2,N1)=0.0 + TNXFLS(N3,N2,N1)=0.0 + TH1PFS(N3,N2,N1)=0.0 + TH2PFS(N3,N2,N1)=0.0 + TN4FLB(N3,N2,N1)=0.0 + TN3FLB(N3,N2,N1)=0.0 + TNOFLB(N3,N2,N1)=0.0 + TNXFLB(N3,N2,N1)=0.0 + TH1BFB(N3,N2,N1)=0.0 + TH2BFB(N3,N2,N1)=0.0 + TCOFHS(N3,N2,N1)=0.0 + TCHFHS(N3,N2,N1)=0.0 + TOXFHS(N3,N2,N1)=0.0 + TNGFHS(N3,N2,N1)=0.0 + TN2FHS(N3,N2,N1)=0.0 + THGFHS(N3,N2,N1)=0.0 + TN4FHW(N3,N2,N1)=0.0 + TN3FHW(N3,N2,N1)=0.0 + TNOFHW(N3,N2,N1)=0.0 + TNXFHS(N3,N2,N1)=0.0 + TH1PHS(N3,N2,N1)=0.0 + TH2PHS(N3,N2,N1)=0.0 + TN4FHB(N3,N2,N1)=0.0 + TN3FHB(N3,N2,N1)=0.0 + TNOFHB(N3,N2,N1)=0.0 + TNXFHB(N3,N2,N1)=0.0 + TH1BHB(N3,N2,N1)=0.0 + TH2BHB(N3,N2,N1)=0.0 ENDIF +C IF(I.EQ.4.AND.NX.EQ.1)THEN +C WRITE(*,3378)'TCOFLS',I,J,M,MM,N1,N2,N3,N4,N5,N6,N +C 2,TCOFLS(N3,N2,N1),RCOFLS(N,N3,N2,N1) +C 2,RCOFLS(N,N6,N5,N4),XCOFLS(N,N3,N2,N1) +C 2,XCOFLS(N,N6,N5,N4) +3378 FORMAT(A8,11I4,20E12.4) +C ENDIF ENDIF C C TOTAL GAS FLUX C -C IF(NCN(N2,N1).NE.3.OR.N.EQ.3)THEN + IF(VOLX(N3,N2,N1).GT.ZEROS(N2,N1))THEN TCOFLG(N3,N2,N1)=TCOFLG(N3,N2,N1)+RCOFLG(N,N3,N2,N1) 2-RCOFLG(N,N6,N5,N4) TCHFLG(N3,N2,N1)=TCHFLG(N3,N2,N1)+RCHFLG(N,N3,N2,N1) @@ -4584,7 +4784,16 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 2-RN3FLG(N,N6,N5,N4) THGFLG(N3,N2,N1)=THGFLG(N3,N2,N1)+RHGFLG(N,N3,N2,N1) 2-RHGFLG(N,N6,N5,N4) -C ENDIF + ELSE + TCOFLG(N3,N2,N1)=0.0 + TCHFLG(N3,N2,N1)=0.0 + TOXFLG(N3,N2,N1)=0.0 + TNGFLG(N3,N2,N1)=0.0 + TN2FLG(N3,N2,N1)=0.0 + TN3FLG(N3,N2,N1)=0.0 + THGFLG(N3,N2,N1)=0.0 + ENDIF + ENDIF 9580 CONTINUE 9585 CONTINUE 9590 CONTINUE @@ -4630,6 +4839,9 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) C WRITE(*,442)'CO2S20',I,J,NX,NY,M,MX,CO2S2(0,NY,NX) C 2,CO2S2(NU(NY,NX),NY,NX),RCODFR(NY,NX),RCOFLS(3,0,NY,NX) C 3,RCODFS(NY,NX) +C WRITE(*,442)'OXYS20',I,J,NX,NY,M,MX,OXYS2(0,NY,NX) +C 2,OXYS2(NU(NY,NX),NY,NX),ROXDFR(NY,NX),ROXFLS(3,0,NY,NX) +C 3,ROXDFS(NY,NX) 442 FORMAT(A8,6I4,12E12.4) DO 9680 K=0,4 OQC2(K,0,NY,NX)=OQC2(K,0,NY,NX)+TQROC(K,NY,NX) @@ -4682,6 +4894,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) C DO 9685 L=NU(NY,NX),NL(NY,NX) IF(M.NE.MX)THEN + IF(VOLX(L,NY,NX).GT.ZEROS(NY,NX))THEN CO2S2(L,NY,NX)=CO2S2(L,NY,NX)+TCOFLS(L,NY,NX)+RCOFXS(L,NY,NX) 2+RCOFLZ(L,NY,NX)+RCOBBL(L,NY,NX) CH4S2(L,NY,NX)=CH4S2(L,NY,NX)+TCHFLS(L,NY,NX)+RCHFXS(L,NY,NX) @@ -4753,6 +4966,8 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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 + ENDIF + IF(VOLX(L,NY,NX).GT.ZEROS(NY,NX))THEN CO2S2(L,NY,NX)=CO2S2(L,NY,NX)+RCODFG(L,NY,NX) CH4S2(L,NY,NX)=CH4S2(L,NY,NX)+RCHDFG(L,NY,NX) OXYS2(L,NY,NX)=OXYS2(L,NY,NX)+ROXDFG(L,NY,NX) @@ -4769,19 +4984,28 @@ 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(L.EQ.NU(NY,NX))THEN -C WRITE(*,444)'CO2S2',I,J,NX,NY,L,M,MM + ENDIF +C IF(IYRC.EQ.2006.AND.I.EQ.361.AND.NX.EQ.1)THEN +C DO 9676 K=0,4 +C WRITE(*,446)'OQA2',I,J,NX,NY,L,M,MM,K,OQA2(K,L,NY,NX) +C 2,TOAFLS(K,L,NY,NX),ROAFXS(K,L,NY,NX),ROASK2(K,L,NY,NX) +446 FORMAT(A8,8I4,12E12.4) +9676 CONTINUE +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 3,RCODFS(NY,NX),PARG(NY,NX),CCO2E(NY,NX),CO2GQ +C 4,VOLWM(M,L,NY,NX),DLYR(3,L,NY,NX),AREA(1,L,NY,NX) +C 5,XH(1,L,NY,NX),XH(3,L,NY,NX) +C 6,RCO2O(L,NY,NX),TCO2S(L,NY,NX),TRCO2(L,NY,NX) C WRITE(*,444)'OXYS2',I,J,M,MX,NX,NY,L C 2,OXYS2(L,NY,NX),TOXFLS(L,NY,NX),ROXFXS(L,NY,NX) C 3,ROXFLZ(L,NY,NX),ROXBBL(L,NY,NX),ROXDFG(L,NY,NX) C 4,ROXSK(M,L,NY,NX),OXYG2(L,NY,NX),ROXFLS(3,L,NY,NX) -C 5,ROXFLS(3,L+1,NY,NX),ROXDFS(NY,NX),ROXSK2(L,NY,NX) -C 6,ROXSK(M,L,NY,NX),VOLWM(M,L,NY,NX) +C 5,ROXFLS(3,L+1,NY,NX),ROXFLS(1,L,NY,NX+1),ROXDFS(NY,NX) +C 6,XOXFLS(3,L,NY,NX),XOXFLS(3,L+1,NY,NX),XOXFLS(1,L,NY,NX+1) +C 6,ROXSK2(L,NY,NX),ROXSK(M,L,NY,NX),VOLWM(M,L,NY,NX) C WRITE(*,444)'OXYSH2',I,J,M,MX,NX,NY,L C 2,OXYSH2(L,NY,NX),TOXFHS(L,NY,NX),ROXFXS(L,NY,NX) C WRITE(*,444)'CH4S2',I,J,NX,NY,L,M,MM,CH4S2(L,NY,NX) @@ -4798,14 +5022,23 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) C 2,RNGBBL(L,NY,NX),Z2GG2(L,NY,NX),TNGFLG(L,NY,NX) C WRITE(*,444)'ZN3G2',I,J,M,MM,NX,NY,L,ZN3G2(L,NY,NX) C 2,TN3FLG(L,NY,NX),RN3DFG(L,NY,NX),RNBDFG(L,NY,NX) -C 3,ZN3S2(L,NY,NX),ZNBS2(L,NY,NX) -C 3,ZNH4S2(L,NY,NX),ZNH4B2(L,NY,NX),RNHSK2(L,NY,NX) +C 3,ZN3S2(L,NY,NX),ZNBS2(L,NY,NX),TN3FLW(L,NY,NX),RN3FXW(L,NY,NX) +C 2,RN3FLZ(L,NY,NX),RN3BBL(L,NY,NX),RN3SK2(L,NY,NX) +C 3,ZNH4S2(L,NY,NX),ZNH4B2(L,NY,NX),RN4SK2(L,NY,NX) +C 4,TN4FLW(L,NY,NX),RN4FXW(L,NY,NX),RN4FLZ(L,NY,NX) +C 5,RN4SK2(L,NY,NX) +C WRITE(*,444)'CO2G2',I,J,M,MM,NX,NY,L,CO2G2(L,NY,NX) +C 2,TCOFLG(L,NY,NX),RCODFG(L,NY,NX),CO2S2(L,NY,NX) +C 3,RCOFLG(3,L,NY,NX),RCOFLG(3,L+1,NY,NX),RCOFLG(1,L,NY,NX+1) +C 4,DCO2G(3,L,NY,NX),THETPM(M,L,NY,NX),PARGCO(NY,NX) +C 6,XCOFLG(3,L,NY,NX),XCOFLG(3,L+1,NY,NX),XCOFLG(1,L,NY,NX+1) +C 7,CCO2E(NY,NX),VOLPM(M,L,NY,NX) C WRITE(*,444)'OXYG2',I,J,M,MM,NX,NY,L,OXYG2(L,NY,NX) C 2,TOXFLG(L,NY,NX),ROXDFG(L,NY,NX),OXYS2(L,NY,NX) -C 3,ROXFLG(3,L,NY,NX),ROXFLG(3,L+1,NY,NX),DOXYG(3,L,NY,NX) -C 4,THETPM(M,L,NY,NX),PARGOX(NY,NX) -C 6,XOXFLG(3,L,NY,NX),XOXFLG(3,L+1,NY,NX) -C 7,COXYE(NY,NX),FLQM(N,L,NY,NX) +C 3,ROXFLG(3,L,NY,NX),ROXFLG(3,L+1,NY,NX),ROXFLG(1,L,NY,NX+1) +C 4,DOXYG(3,L,NY,NX),THETPM(M,L,NY,NX),PARGOX(NY,NX) +C 6,XOXFLG(3,L,NY,NX),XOXFLG(3,L+1,NY,NX),XOXFLG(1,L,NY,NX+1) +C 7,COXYE(NY,NX),VOLPM(M,L,NY,NX) C WRITE(*,444)'N2OG2',I,J,M,MM,NX,NY,L,Z2OG2(L,NY,NX) C 2,Z2OS2(L,NY,NX),Z2OSH2(L,NY,NX),TN2FLG(L,NY,NX),RN2DFG(L,NY,NX) C 3,TN2FLS(L,NY,NX),RN2FXS(L,NY,NX),RN2FLZ(L,NY,NX),RN2BBL(L,NY,NX) @@ -4819,7 +5052,7 @@ SUBROUTINE trnsfr(I,J,NHW,NHE,NVN,NVS) 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) +444 FORMAT(A8,7I4,20E12.4) C ENDIF 9685 CONTINUE CO2S2(0,NY,NX)=CO2S2(0,NY,NX)+RCODFG(0,NY,NX) @@ -4829,7 +5062,7 @@ 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) -C IF(J.EQ.12)THEN +C IF(I.EQ.53)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) diff --git a/f77src/trnsfrs.f b/f77src/trnsfrs.f old mode 100755 new mode 100644 index c1927c4..b5101c8 --- a/f77src/trnsfrs.f +++ b/f77src/trnsfrs.f @@ -49,6 +49,23 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) 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 RZAL2(0:JZ,JY,JX),RZFE2(0:JZ,JY,JX),RZHY2(0:JZ,JY,JX) + 2,RZCA2(0:JZ,JY,JX),RZMG2(0:JZ,JY,JX),RZNA2(0:JZ,JY,JX) + 3,RZKA2(0:JZ,JY,JX),RZOH2(0:JZ,JY,JX),RZSO42(0:JZ,JY,JX) + 4,RZHCO32(0:JZ,JY,JX),RZCL2(0:JZ,JY,JX),RZCO32(0:JZ,JY,JX) + 5,RZAL12(0:JZ,JY,JX),RZAL22(0:JZ,JY,JX),RZAL32(0:JZ,JY,JX) + 6,RZAL42(0:JZ,JY,JX),RZALS2(0:JZ,JY,JX),RZFE12(0:JZ,JY,JX) + 7,RZFE22(0:JZ,JY,JX),RZFE32(0:JZ,JY,JX),RZFE42(0:JZ,JY,JX) + 8,RZFES2(0:JZ,JY,JX),RZCAO2(0:JZ,JY,JX),RZCAC2(0:JZ,JY,JX) + 9,RZCAH2(0:JZ,JY,JX),RZCAS2(0:JZ,JY,JX),RZMGO2(0:JZ,JY,JX) + 1,RZMGC2(0:JZ,JY,JX),RZMGH2(0:JZ,JY,JX),RZMGS2(0:JZ,JY,JX) + 2,RZNAC2(0:JZ,JY,JX),RZNAS2(0:JZ,JY,JX),RZKAS2(0:JZ,JY,JX) + 3,RH0PO42(0:JZ,JY,JX),RH3PO42(0:JZ,JY,JX) + 4,RZFE1P2(0:JZ,JY,JX),RZFE2P2(0:JZ,JY,JX),RZCA0P2(0:JZ,JY,JX) + 5,RZCA1P2(0:JZ,JY,JX),RZCA2P2(0:JZ,JY,JX),RZMG1P2(0:JZ,JY,JX) + 6,RH0POB2(JZ,JY,JX),RH3POB2(JZ,JY,JX) + 7,RZF1PB2(JZ,JY,JX),RZF2PB2(JZ,JY,JX),RZC0PB2(JZ,JY,JX) + 8,RZC1PB2(JZ,JY,JX),RZC2PB2(JZ,JY,JX),RZM1PB2(JZ,JY,JX) DIMENSION ZALW2(JY,JX),ZFEW2(JY,JX),ZHYW2(JY,JX),ZCAW2(JY,JX) 2,ZMGW2(JY,JX),ZNAW2(JY,JX),ZKAW2(JY,JX),ZOHW2(JY,JX) 3,ZSO4W2(JY,JX),ZCLW2(JY,JX),ZCO3W2(JY,JX),ZHCO3W2(JY,JX) @@ -237,9 +254,9 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) 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) + DIMENSION THETW1(JZ,JY,JX),FLWU(JZ,JY,JX) 2,POSGL2(JZ,JY,JX) - PARAMETER (XFRX=0.5,XFRS=0.05) + PARAMETER (VFLWX=0.5,XFRS=0.05) XNPX=1.0*XNPH C C TIME STEPS FOR SOLUTE FLUX CALCULATIONS @@ -791,50 +808,57 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) C SOIL SURFACE FROM SNOWMELT IN 'WATSUB' AND 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)*DENSI FLQTM=FLQGM(NY,NX)+FLQRM(NY,NX) - CALW=FLQTM*ZALW(NY,NX)/VOLWW - CFEW=FLQTM*ZFEW(NY,NX)/VOLWW - CHYW=FLQTM*ZHYW(NY,NX)/VOLWW - CCAW=FLQTM*ZCAW(NY,NX)/VOLWW - CMGW=FLQTM*ZMGW(NY,NX)/VOLWW - CNAW=FLQTM*ZNAW(NY,NX)/VOLWW - CKAW=FLQTM*ZKAW(NY,NX)/VOLWW - COHW=FLQTM*ZOHW(NY,NX)/VOLWW - CSOW=FLQTM*ZSO4W(NY,NX)/VOLWW - CCLW=FLQTM*ZCLW(NY,NX)/VOLWW - CC3W=FLQTM*ZCO3W(NY,NX)/VOLWW - CHCW=FLQTM*ZHCO3W(NY,NX)/VOLWW - CAL1W=FLQTM*ZALH1W(NY,NX)/VOLWW - CAL2W=FLQTM*ZALH2W(NY,NX)/VOLWW - CAL3W=FLQTM*ZALH3W(NY,NX)/VOLWW - CAL4W=FLQTM*ZALH4W(NY,NX)/VOLWW - CALSW=FLQTM*ZALSW(NY,NX)/VOLWW - CFE1W=FLQTM*ZFEH1W(NY,NX)/VOLWW - CFE2W=FLQTM*ZFEH2W(NY,NX)/VOLWW - CFE3W=FLQTM*ZFEH3W(NY,NX)/VOLWW - CFE4W=FLQTM*ZFEH4W(NY,NX)/VOLWW - CFESW=FLQTM*ZFESW(NY,NX)/VOLWW - CCAOW=FLQTM*ZCAOW(NY,NX)/VOLWW - CCACW=FLQTM*ZCACW(NY,NX)/VOLWW - CCAHW=FLQTM*ZCAHW(NY,NX)/VOLWW - CCASW=FLQTM*ZCASW(NY,NX)/VOLWW - CMGOW=FLQTM*ZMGOW(NY,NX)/VOLWW - CMGCW=FLQTM*ZMGCW(NY,NX)/VOLWW - CMGHW=FLQTM*ZMGHW(NY,NX)/VOLWW - CMGSW=FLQTM*ZMGSW(NY,NX)/VOLWW - CNACW=FLQTM*ZNACW(NY,NX)/VOLWW - CNASW=FLQTM*ZNASW(NY,NX)/VOLWW - CKASW=FLQTM*ZKASW(NY,NX)/VOLWW - CH0PW=FLQTM*H0PO4W(NY,NX)/VOLWW - CH3PW=FLQTM*H3PO4W(NY,NX)/VOLWW - CF1PW=FLQTM*ZFE1PW(NY,NX)/VOLWW - CF2PW=FLQTM*ZFE2PW(NY,NX)/VOLWW - CC0PW=FLQTM*ZCA0PW(NY,NX)/VOLWW - CC1PW=FLQTM*ZCA1PW(NY,NX)/VOLWW - CC2PW=FLQTM*ZCA2PW(NY,NX)/VOLWW - CM1PW=FLQTM*ZMG1PW(NY,NX)/VOLWW + IF(FLQTM.GT.ZEROS(NY,NX))THEN + VOLWW=VOLWS(NY,NX)+VOLSS(NY,NX)+VOLIS(NY,NX)*DENSI + IF(VOLWW.GT.ZEROS2(NY,NX))THEN + VFLWW=AMAX1(0.0,AMIN1(1.0,FLQTM/VOLWW)) + ELSE + VFLWW=1.0 + ENDIF + VFLWG=FLQGM(NY,NX)/FLQTM + VFLWR=FLQRM(NY,NX)/FLQTM + CALW=ZALW(NY,NX)*VFLWW + CFEW=ZFEW(NY,NX)*VFLWW + CHYW=ZHYW(NY,NX)*VFLWW + CCAW=ZCAW(NY,NX)*VFLWW + CMGW=ZMGW(NY,NX)*VFLWW + CNAW=ZNAW(NY,NX)*VFLWW + CKAW=ZKAW(NY,NX)*VFLWW + COHW=ZOHW(NY,NX)*VFLWW + CSOW=ZSO4W(NY,NX)*VFLWW + CCLW=ZCLW(NY,NX)*VFLWW + CC3W=ZCO3W(NY,NX)*VFLWW + CHCW=ZHCO3W(NY,NX)*VFLWW + CAL1W=ZALH1W(NY,NX)*VFLWW + CAL2W=ZALH2W(NY,NX)*VFLWW + CAL3W=ZALH3W(NY,NX)*VFLWW + CAL4W=ZALH4W(NY,NX)*VFLWW + CALSW=ZALSW(NY,NX)*VFLWW + CFE1W=ZFEH1W(NY,NX)*VFLWW + CFE2W=ZFEH2W(NY,NX)*VFLWW + CFE3W=ZFEH3W(NY,NX)*VFLWW + CFE4W=ZFEH4W(NY,NX)*VFLWW + CFESW=ZFESW(NY,NX)*VFLWW + CCAOW=ZCAOW(NY,NX)*VFLWW + CCACW=ZCACW(NY,NX)*VFLWW + CCAHW=ZCAHW(NY,NX)*VFLWW + CCASW=ZCASW(NY,NX)*VFLWW + CMGOW=ZMGOW(NY,NX)*VFLWW + CMGCW=ZMGCW(NY,NX)*VFLWW + CMGHW=ZMGHW(NY,NX)*VFLWW + CMGSW=ZMGSW(NY,NX)*VFLWW + CNACW=ZNACW(NY,NX)*VFLWW + CNASW=ZNASW(NY,NX)*VFLWW + CKASW=ZKASW(NY,NX)*VFLWW + CH0PW=H0PO4W(NY,NX)*VFLWW + CH3PW=H3PO4W(NY,NX)*VFLWW + CF1PW=ZFE1PW(NY,NX)*VFLWW + CF2PW=ZFE2PW(NY,NX)*VFLWW + CC0PW=ZCA0PW(NY,NX)*VFLWW + CC1PW=ZCA1PW(NY,NX)*VFLWW + CC2PW=ZCA2PW(NY,NX)*VFLWW + CM1PW=ZMG1PW(NY,NX)*VFLWW XALBLS(NY,NX)=XALBLS(NY,NX)-CALW XFEBLS(NY,NX)=XFEBLS(NY,NX)-CFEW XHYBLS(NY,NX)=XHYBLS(NY,NX)-CHYW @@ -884,6 +908,11 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) ZNAW2(NY,NX)=ZNAW(NY,NX)+XNABLS(NY,NX) ZKAW2(NY,NX)=ZKAW(NY,NX)+XKABLS(NY,NX) ZOHW2(NY,NX)=ZOHW(NY,NX)+XOHBLS(NY,NX) +C WRITE(*,443)'ZOHW2',I,J,NX,NY,ZOHW(NY,NX) +C 2,XOHBLS(NY,NX),ZOHW2(NY,NX),COHW,PRECQ(NY,NX) +C 2,COHR(NY,NX),PRECI(NY,NX),COHQ(I,NY,NX) +C 3,FLQTM,ZOHW(NY,NX),VFLWW,FLQGM(NY,NX),FLQRM(NY,NX) +443 FORMAT(A8,4I4,20E12.4) ZSO4W2(NY,NX)=ZSO4W(NY,NX)+XSOBLS(NY,NX) ZCLW2(NY,NX)=ZCLW(NY,NX)+XCLBLS(NY,NX) ZCO3W2(NY,NX)=ZCO3W(NY,NX)+XC3BLS(NY,NX) @@ -920,8 +949,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) C C ACCUMULATE HOURLY FLUXES C - VFLWG=FLQGM(NY,NX)/FLQTM - VFLWR=FLQRM(NY,NX)/FLQTM XALFLS(3,0,NY,NX)=XALFLS(3,0,NY,NX)+CALW*VFLWR XFEFLS(3,0,NY,NX)=XFEFLS(3,0,NY,NX)+CFEW*VFLWR XHYFLS(3,0,NY,NX)=XHYFLS(3,0,NY,NX)+CHYW*VFLWR @@ -1221,10 +1248,62 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RC1BHB(3,NU(NY,NX),NY,NX)=XC1BHB(3,NU(NY,NX),NY,NX)*XNPH RC2BHB(3,NU(NY,NX),NY,NX)=XC2BHB(3,NU(NY,NX),NY,NX)*XNPH RM1BHB(3,NU(NY,NX),NY,NX)=XM1BHB(3,NU(NY,NX),NY,NX)*XNPH + DO 10 L=NU(NY,NX),NL(NY,NX) +C +C HOURLY SOLUTE FLUXES FROM SOLUTE.F +C + RZAL2(L,NY,NX)=-TRAL(L,NY,NX)*XNPH + RZFE2(L,NY,NX)=-TRFE(L,NY,NX)*XNPH + RZHY2(L,NY,NX)=-(TRHY(L,NY,NX)+XZHYS(L,NY,NX))*XNPH + RZCA2(L,NY,NX)=-TRCA(L,NY,NX)*XNPH + RZMG2(L,NY,NX)=-TRMG(L,NY,NX)*XNPH + RZNA2(L,NY,NX)=-TRNA(L,NY,NX)*XNPH + RZKA2(L,NY,NX)=-TRKA(L,NY,NX)*XNPH + RZOH2(L,NY,NX)=-TROH(L,NY,NX)*XNPH + RZSO42(L,NY,NX)=-TRSO4(L,NY,NX)*XNPH + RZCL2(L,NY,NX)=0.0 + RZCO32(L,NY,NX)=-TRCO3(L,NY,NX)*XNPH + RZHCO32(L,NY,NX)=-TRHCO(L,NY,NX)*XNPH + RZAL12(L,NY,NX)=-TRAL1(L,NY,NX)*XNPH + RZAL22(L,NY,NX)=-TRAL2(L,NY,NX)*XNPH + RZAL32(L,NY,NX)=-TRAL3(L,NY,NX)*XNPH + RZAL42(L,NY,NX)=-TRAL4(L,NY,NX)*XNPH + RZALS2(L,NY,NX)=-TRALS(L,NY,NX)*XNPH + RZFE12(L,NY,NX)=-TRFE1(L,NY,NX)*XNPH + RZFE22(L,NY,NX)=-TRFE2(L,NY,NX)*XNPH + RZFE32(L,NY,NX)=-TRFE3(L,NY,NX)*XNPH + RZFE42(L,NY,NX)=-TRFE4(L,NY,NX)*XNPH + RZFES2(L,NY,NX)=-TRFES(L,NY,NX)*XNPH + RZCAO2(L,NY,NX)=-TRCAO(L,NY,NX)*XNPH + RZCAC2(L,NY,NX)=-TRCAC(L,NY,NX)*XNPH + RZCAH2(L,NY,NX)=-TRCAH(L,NY,NX)*XNPH + RZCAS2(L,NY,NX)=-TRCAS(L,NY,NX)*XNPH + RZMGO2(L,NY,NX)=-TRMGO(L,NY,NX)*XNPH + RZMGC2(L,NY,NX)=-TRMGC(L,NY,NX)*XNPH + RZMGH2(L,NY,NX)=-TRMGH(L,NY,NX)*XNPH + RZMGS2(L,NY,NX)=-TRMGS(L,NY,NX)*XNPH + RZNAC2(L,NY,NX)=-TRNAC(L,NY,NX)*XNPH + RZNAS2(L,NY,NX)=-TRNAS(L,NY,NX)*XNPH + RZKAS2(L,NY,NX)=-TRKAS(L,NY,NX)*XNPH + RH0PO42(L,NY,NX)=-TRH0P(L,NY,NX)*XNPH + RH3PO42(L,NY,NX)=-TRH3P(L,NY,NX)*XNPH + RZFE1P2(L,NY,NX)=-TRF1P(L,NY,NX)*XNPH + RZFE2P2(L,NY,NX)=-TRF2P(L,NY,NX)*XNPH + RZCA0P2(L,NY,NX)=-TRC0P(L,NY,NX)*XNPH + RZCA1P2(L,NY,NX)=-TRC1P(L,NY,NX)*XNPH + RZCA2P2(L,NY,NX)=-TRC2P(L,NY,NX)*XNPH + RZMG1P2(L,NY,NX)=-TRM1P(L,NY,NX)*XNPH + RH0POB2(L,NY,NX)=-TRH0B(L,NY,NX)*XNPH + RH3POB2(L,NY,NX)=-TRH3B(L,NY,NX)*XNPH + RZF1PB2(L,NY,NX)=-TRF1B(L,NY,NX)*XNPH + RZF2PB2(L,NY,NX)=-TRF2B(L,NY,NX)*XNPH + RZC0PB2(L,NY,NX)=-TRC0B(L,NY,NX)*XNPH + RZC1PB2(L,NY,NX)=-TRC1B(L,NY,NX)*XNPH + RZC2PB2(L,NY,NX)=-TRC2B(L,NY,NX)*XNPH + RZM1PB2(L,NY,NX)=-TRM1B(L,NY,NX)*XNPH C C HOURLY SOLUTE FLUXES FROM SUBSURFACE IRRIGATION C - DO 10 L=NU(NY,NX),NL(NY,NX) FLWU(L,NY,NX)=TUPWTR(L,NY,NX)*XNPH RALFLU(L,NY,NX)=FLU(L,NY,NX)*CALQ(I,NY,NX) RFEFLU(L,NY,NX)=FLU(L,NY,NX)*CFEQ(I,NY,NX) @@ -1344,60 +1423,59 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) C3SGL2(L,NY,NX)=C3SGL(L,NY,NX)*XNPH HCSGL2(L,NY,NX)=HCSGL(L,NY,NX)*XNPH C -C STATE VARIABLES FOR GASES AND SOLUTES USED IN 'TRNSFR' +C STATE VARIABLES FOR SOLUTES USED IN 'TRNSFRS' C TO STORE SUB-HOURLY CHANGES DURING FLUX CALCULATIONS C INCLUDING TRANSFORMATIONS FROM REACTIONS IN ?SOLUTE? 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) - 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 - ZKA2(L,NY,NX)=ZKA(L,NY,NX)+TRKA(L,NY,NX)*XNPH - ZOH2(L,NY,NX)=ZOH(L,NY,NX)+TROH(L,NY,NX)*XNPH - ZSO42(L,NY,NX)=ZSO4(L,NY,NX)+TRSO4(L,NY,NX)*XNPH + ZAL2(L,NY,NX)=ZAL(L,NY,NX) + ZFE2(L,NY,NX)=ZFE(L,NY,NX) + ZHY2(L,NY,NX)=ZHY(L,NY,NX) + ZCA2(L,NY,NX)=ZCA(L,NY,NX) + ZMG2(L,NY,NX)=ZMG(L,NY,NX) + ZNA2(L,NY,NX)=ZNA(L,NY,NX) + ZKA2(L,NY,NX)=ZKA(L,NY,NX) + ZOH2(L,NY,NX)=ZOH(L,NY,NX) + ZSO42(L,NY,NX)=ZSO4(L,NY,NX) ZCL2(L,NY,NX)=ZCL(L,NY,NX) - ZCO32(L,NY,NX)=ZCO3(L,NY,NX)+TRCO3(L,NY,NX)*XNPH - ZHCO32(L,NY,NX)=ZHCO3(L,NY,NX)+TRHCO(L,NY,NX)*XNPH - ZAL12(L,NY,NX)=ZALOH1(L,NY,NX)+TRAL1(L,NY,NX)*XNPH - ZAL22(L,NY,NX)=ZALOH2(L,NY,NX)+TRAL2(L,NY,NX)*XNPH - ZAL32(L,NY,NX)=ZALOH3(L,NY,NX)+TRAL3(L,NY,NX)*XNPH - ZAL42(L,NY,NX)=ZALOH4(L,NY,NX)+TRAL4(L,NY,NX)*XNPH - ZALS2(L,NY,NX)=ZALS(L,NY,NX)+TRALS(L,NY,NX)*XNPH - ZFE12(L,NY,NX)=ZFEOH1(L,NY,NX)+TRFE1(L,NY,NX)*XNPH - ZFE22(L,NY,NX)=ZFEOH2(L,NY,NX)+TRFE2(L,NY,NX)*XNPH - ZFE32(L,NY,NX)=ZFEOH3(L,NY,NX)+TRFE3(L,NY,NX)*XNPH - ZFE42(L,NY,NX)=ZFEOH4(L,NY,NX)+TRFE4(L,NY,NX)*XNPH - ZFES2(L,NY,NX)=ZFES(L,NY,NX)+TRFES(L,NY,NX)*XNPH - ZCAO2(L,NY,NX)=ZCAO(L,NY,NX)+TRCAO(L,NY,NX)*XNPH - ZCAC2(L,NY,NX)=ZCAC(L,NY,NX)+TRCAC(L,NY,NX)*XNPH - ZCAH2(L,NY,NX)=ZCAH(L,NY,NX)+TRCAH(L,NY,NX)*XNPH - ZCAS2(L,NY,NX)=ZCAS(L,NY,NX)+TRCAS(L,NY,NX)*XNPH - ZMGO2(L,NY,NX)=ZMGO(L,NY,NX)+TRMGO(L,NY,NX)*XNPH - ZMGC2(L,NY,NX)=ZMGC(L,NY,NX)+TRMGC(L,NY,NX)*XNPH - ZMGH2(L,NY,NX)=ZMGH(L,NY,NX)+TRMGH(L,NY,NX)*XNPH - ZMGS2(L,NY,NX)=ZMGS(L,NY,NX)+TRMGS(L,NY,NX)*XNPH - ZNAC2(L,NY,NX)=ZNAC(L,NY,NX)+TRNAC(L,NY,NX)*XNPH - 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 - 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 - ZCA0P2(L,NY,NX)=ZCA0P(L,NY,NX)+TRC0P(L,NY,NX)*XNPH - ZCA1P2(L,NY,NX)=ZCA1P(L,NY,NX)+TRC1P(L,NY,NX)*XNPH - 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 - 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 - ZC0PB2(L,NY,NX)=ZCA0PB(L,NY,NX)+TRC0B(L,NY,NX)*XNPH - ZC1PB2(L,NY,NX)=ZCA1PB(L,NY,NX)+TRC1B(L,NY,NX)*XNPH - ZC2PB2(L,NY,NX)=ZCA2PB(L,NY,NX)+TRC2B(L,NY,NX)*XNPH - ZM1PB2(L,NY,NX)=ZMG1PB(L,NY,NX)+TRM1B(L,NY,NX)*XNPH + ZCO32(L,NY,NX)=ZCO3(L,NY,NX) + ZHCO32(L,NY,NX)=ZHCO3(L,NY,NX) + ZAL12(L,NY,NX)=ZALOH1(L,NY,NX) + ZAL22(L,NY,NX)=ZALOH2(L,NY,NX) + ZAL32(L,NY,NX)=ZALOH3(L,NY,NX) + ZAL42(L,NY,NX)=ZALOH4(L,NY,NX) + ZALS2(L,NY,NX)=ZALS(L,NY,NX) + ZFE12(L,NY,NX)=ZFEOH1(L,NY,NX) + ZFE22(L,NY,NX)=ZFEOH2(L,NY,NX) + ZFE32(L,NY,NX)=ZFEOH3(L,NY,NX) + ZFE42(L,NY,NX)=ZFEOH4(L,NY,NX) + ZFES2(L,NY,NX)=ZFES(L,NY,NX) + ZCAO2(L,NY,NX)=ZCAO(L,NY,NX) + ZCAC2(L,NY,NX)=ZCAC(L,NY,NX) + ZCAH2(L,NY,NX)=ZCAH(L,NY,NX) + ZCAS2(L,NY,NX)=ZCAS(L,NY,NX) + ZMGO2(L,NY,NX)=ZMGO(L,NY,NX) + ZMGC2(L,NY,NX)=ZMGC(L,NY,NX) + ZMGH2(L,NY,NX)=ZMGH(L,NY,NX) + ZMGS2(L,NY,NX)=ZMGS(L,NY,NX) + ZNAC2(L,NY,NX)=ZNAC(L,NY,NX) + ZNAS2(L,NY,NX)=ZNAS(L,NY,NX) + ZKAS2(L,NY,NX)=ZKAS(L,NY,NX) + H0PO42(L,NY,NX)=H0PO4(L,NY,NX) + H3PO42(L,NY,NX)=H3PO4(L,NY,NX) + ZFE1P2(L,NY,NX)=ZFE1P(L,NY,NX) + ZFE2P2(L,NY,NX)=ZFE2P(L,NY,NX) + ZCA0P2(L,NY,NX)=ZCA0P(L,NY,NX) + ZCA1P2(L,NY,NX)=ZCA1P(L,NY,NX) + ZCA2P2(L,NY,NX)=ZCA2P(L,NY,NX) + ZMG1P2(L,NY,NX)=ZMG1P(L,NY,NX) + H0POB2(L,NY,NX)=H0POB(L,NY,NX) + H3POB2(L,NY,NX)=H3POB(L,NY,NX) + ZF1PB2(L,NY,NX)=ZFE1PB(L,NY,NX) + ZF2PB2(L,NY,NX)=ZFE2PB(L,NY,NX) + ZC0PB2(L,NY,NX)=ZCA0PB(L,NY,NX) + ZC1PB2(L,NY,NX)=ZCA1PB(L,NY,NX) + ZC2PB2(L,NY,NX)=ZCA2PB(L,NY,NX) + ZM1PB2(L,NY,NX)=ZMG1PB(L,NY,NX) ZALH2(L,NY,NX)=ZALH(L,NY,NX) ZFEH2(L,NY,NX)=ZFEH(L,NY,NX) ZHYH2(L,NY,NX)=ZHYH(L,NY,NX) @@ -1645,6 +1723,58 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) TC1BHB(L,NY,NX)=0.0 TC2BHB(L,NY,NX)=0.0 TM1BHB(L,NY,NX)=0.0 +C +C ADD SINKS FROM SOLUTE.F +C + ZAL2(L,NY,NX)=ZAL2(L,NY,NX)-RZAL2(L,NY,NX) + ZFE2(L,NY,NX)=ZFE2(L,NY,NX)-RZFE2(L,NY,NX) + ZHY2(L,NY,NX)=ZHY2(L,NY,NX)-RZHY2(L,NY,NX) + ZCA2(L,NY,NX)=ZCA2(L,NY,NX)-RZCA2(L,NY,NX) + ZMG2(L,NY,NX)=ZMG2(L,NY,NX)-RZMG2(L,NY,NX) + ZNA2(L,NY,NX)=ZNA2(L,NY,NX)-RZNA2(L,NY,NX) + ZKA2(L,NY,NX)=ZKA2(L,NY,NX)-RZKA2(L,NY,NX) + ZOH2(L,NY,NX)=ZOH2(L,NY,NX)-RZOH2(L,NY,NX) + ZSO42(L,NY,NX)=ZSO42(L,NY,NX)-RZSO42(L,NY,NX) + ZCL2(L,NY,NX)=ZCL2(L,NY,NX)-RZCL2(L,NY,NX) + ZCO32(L,NY,NX)=ZCO32(L,NY,NX)-RZCO32(L,NY,NX) + ZHCO32(L,NY,NX)=ZHCO32(L,NY,NX)-RZHCO32(L,NY,NX) + ZAL12(L,NY,NX)=ZAL12(L,NY,NX)-RZAL12(L,NY,NX) + ZAL22(L,NY,NX)=ZAL22(L,NY,NX)-RZAL22(L,NY,NX) + ZAL32(L,NY,NX)=ZAL32(L,NY,NX)-RZAL32(L,NY,NX) + ZAL42(L,NY,NX)=ZAL42(L,NY,NX)-RZAL42(L,NY,NX) + ZALS2(L,NY,NX)=ZALS2(L,NY,NX)-RZALS2(L,NY,NX) + ZFE12(L,NY,NX)=ZFE12(L,NY,NX)-RZFE12(L,NY,NX) + ZFE22(L,NY,NX)=ZFE22(L,NY,NX)-RZFE22(L,NY,NX) + ZFE32(L,NY,NX)=ZFE32(L,NY,NX)-RZFE32(L,NY,NX) + ZFE42(L,NY,NX)=ZFE42(L,NY,NX)-RZFE42(L,NY,NX) + ZFES2(L,NY,NX)=ZFES2(L,NY,NX)-RZFES2(L,NY,NX) + ZCAO2(L,NY,NX)=ZCAO2(L,NY,NX)-RZCAO2(L,NY,NX) + ZCAC2(L,NY,NX)=ZCAC2(L,NY,NX)-RZCAC2(L,NY,NX) + ZCAH2(L,NY,NX)=ZCAH2(L,NY,NX)-RZCAH2(L,NY,NX) + ZCAS2(L,NY,NX)=ZCAS2(L,NY,NX)-RZCAS2(L,NY,NX) + ZMGO2(L,NY,NX)=ZMGO2(L,NY,NX)-RZMGO2(L,NY,NX) + ZMGC2(L,NY,NX)=ZMGC2(L,NY,NX)-RZMGC2(L,NY,NX) + ZMGH2(L,NY,NX)=ZMGH2(L,NY,NX)-RZMGH2(L,NY,NX) + ZMGS2(L,NY,NX)=ZMGS2(L,NY,NX)-RZMGS2(L,NY,NX) + ZNAC2(L,NY,NX)=ZNAC2(L,NY,NX)-RZNAC2(L,NY,NX) + ZNAS2(L,NY,NX)=ZNAS2(L,NY,NX)-RZNAS2(L,NY,NX) + ZKAS2(L,NY,NX)=ZKAS2(L,NY,NX)-RZKAS2(L,NY,NX) + H0PO42(L,NY,NX)=H0PO42(L,NY,NX)-RH0PO42(L,NY,NX) + H3PO42(L,NY,NX)=H3PO42(L,NY,NX)-RH3PO42(L,NY,NX) + ZFE1P2(L,NY,NX)=ZFE1P2(L,NY,NX)-RZFE1P2(L,NY,NX) + ZFE2P2(L,NY,NX)=ZFE2P2(L,NY,NX)-RZFE2P2(L,NY,NX) + ZCA0P2(L,NY,NX)=ZCA0P2(L,NY,NX)-RZCA0P2(L,NY,NX) + ZCA1P2(L,NY,NX)=ZCA1P2(L,NY,NX)-RZCA1P2(L,NY,NX) + ZCA2P2(L,NY,NX)=ZCA2P2(L,NY,NX)-RZCA2P2(L,NY,NX) + ZMG1P2(L,NY,NX)=ZMG1P2(L,NY,NX)-RZMG1P2(L,NY,NX) + H0POB2(L,NY,NX)=H0POB2(L,NY,NX)-RH0POB2(L,NY,NX) + H3POB2(L,NY,NX)=H3POB2(L,NY,NX)-RH3POB2(L,NY,NX) + ZF1PB2(L,NY,NX)=ZF1PB2(L,NY,NX)-RZF1PB2(L,NY,NX) + ZF2PB2(L,NY,NX)=ZF2PB2(L,NY,NX)-RZF2PB2(L,NY,NX) + ZC0PB2(L,NY,NX)=ZC0PB2(L,NY,NX)-RZC0PB2(L,NY,NX) + ZC1PB2(L,NY,NX)=ZC1PB2(L,NY,NX)-RZC1PB2(L,NY,NX) + ZC2PB2(L,NY,NX)=ZC2PB2(L,NY,NX)-RZC2PB2(L,NY,NX) + ZM1PB2(L,NY,NX)=ZM1PB2(L,NY,NX)-RZM1PB2(L,NY,NX) 9885 CONTINUE C C CONVECTIVE SOLUTE EXCHANGE BETWEEN RESIDUE AND SOIL SURFACE @@ -1657,10 +1787,10 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) C IN RESIDUE C IF(FLWRM1.GT.0.0)THEN - IF(VOLWM(M,0,NY,NX).GT.ZEROS(NY,NX))THEN - VFLW=AMAX1(0.0,AMIN1(XFRX,FLWRM1/VOLWM(M,0,NY,NX))) + IF(VOLWM(M,0,NY,NX).GT.ZEROS2(NY,NX))THEN + VFLW=AMAX1(0.0,AMIN1(VFLWX,FLWRM1/VOLWM(M,0,NY,NX))) ELSE - VFLW=XFRX + VFLW=VFLWX ENDIF RFLAL=VFLW*AMAX1(0.0,ZAL2(0,NY,NX)) RFLFE=VFLW*AMAX1(0.0,ZFE2(0,NY,NX)) @@ -1718,10 +1848,10 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) C IN SOIL SURFACE C ELSE - IF(VOLWM(M,NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN - VFLW=AMIN1(0.0,AMAX1(-XFRX,FLWRM1/VOLWM(M,NU(NY,NX),NY,NX))) + IF(VOLWM(M,NU(NY,NX),NY,NX).GT.ZEROS2(NY,NX))THEN + VFLW=AMIN1(0.0,AMAX1(-VFLWX,FLWRM1/VOLWM(M,NU(NY,NX),NY,NX))) ELSE - VFLW=-XFRX + VFLW=-VFLWX ENDIF RFLAL=VFLW*AMAX1(0.0,ZAL2(NU(NY,NX),NY,NX)) RFLFE=VFLW*AMAX1(0.0,ZFE2(NU(NY,NX),NY,NX)) @@ -1778,12 +1908,9 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) C SOIL SURFACE FROM AQUEOUS DIFFUSIVITIES C AND CONCENTRATION DIFFERENCES C - THETW1(0,NY,NX)=AMAX1(0.0,AMIN1(VOLA(0,NY,NX) - 2,VOLWM(M,0,NY,NX))/VOLX(0,NY,NX)) - THETW1(NU(NY,NX),NY,NX)=AMAX1(0.0,VOLWM(M,NU(NY,NX),NY,NX) - 2/VOLX(NU(NY,NX),NY,NX)) - IF(THETW1(0,NY,NX).GT.THETY(0,NY,NX) - 2.AND.THETW1(NU(NY,NX),NY,NX).GT.THETY(NU(NY,NX),NY,NX))THEN + IF((VOLT(0,NY,NX).GT.ZEROS(NY,NX) + 2.AND.VOLWM(M,0,NY,NX).GT.ZEROS2(NY,NX)) + 3.AND.(VOLWM(M,NU(NY,NX),NY,NX).GT.ZEROS2(NY,NX)))THEN C C MICROPORE CONCENTRATIONS FROM WATER IN RESIDUE AND SOIL SURFACE C @@ -1902,26 +2029,41 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) CM1PB2=CMG1P2 ENDIF C -C DIFFUSIVITIES IN CURRENT AND ADJACENT GRID CELL MICROPORES -C - 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)) - DIFPO=(POSGL2(NU(NY,NX),NY,NX)*TORTL+DISPN)*XDPTHM - DIFAL=(ALSGL2(NU(NY,NX),NY,NX)*TORTL+DISPN)*XDPTHM - DIFFE=(FESGL2(NU(NY,NX),NY,NX)*TORTL+DISPN)*XDPTHM - DIFHY=(HYSGL2(NU(NY,NX),NY,NX)*TORTL+DISPN)*XDPTHM - DIFCA=(CASGL2(NU(NY,NX),NY,NX)*TORTL+DISPN)*XDPTHM - DIFMG=(GMSGL2(NU(NY,NX),NY,NX)*TORTL+DISPN)*XDPTHM - DIFNA=(ANSGL2(NU(NY,NX),NY,NX)*TORTL+DISPN)*XDPTHM - DIFKA=(AKSGL2(NU(NY,NX),NY,NX)*TORTL+DISPN)*XDPTHM - DIFOH=(OHSGL2(NU(NY,NX),NY,NX)*TORTL+DISPN)*XDPTHM - DIFSO=(SOSGL2(NU(NY,NX),NY,NX)*TORTL+DISPN)*XDPTHM - DIFCL=(CLSXL2(NU(NY,NX),NY,NX)*TORTL+DISPN)*XDPTHM - DIFC3=(C3SGL2(NU(NY,NX),NY,NX)*TORTL+DISPN)*XDPTHM - DIFHC=(HCSGL2(NU(NY,NX),NY,NX)*TORTL+DISPN)*XDPTHM +C DIFFUSIVITIES IN RESIDUE AND SOIL SURFACE +C + DLYR0=AMAX1(ZERO2,DLYR(3,0,NY,NX)) + TORT0=TORT(M,0,NY,NX)*CVRD(NY,NX) + DLYR1=AMAX1(ZERO2,DLYR(3,NU(NY,NX),NY,NX)) + TORT1=TORT(M,NU(NY,NX),NY,NX) + TORTL=AMIN1(1.0,(TORT0+TORT1)/(DLYR0+DLYR1)) + DISPN=DISP(3,NU(NY,NX),NY,NX) + 2*AMIN1(VFLWX,ABS(FLWRM1/AREA(3,NU(NY,NX),NY,NX))) + DIFPO=(POSGL2(NU(NY,NX),NY,NX)*TORTL+DISPN) + 2*AREA(3,NU(NY,NX),NY,NX) + DIFAL=(ALSGL2(NU(NY,NX),NY,NX)*TORTL+DISPN) + 2*AREA(3,NU(NY,NX),NY,NX) + DIFFE=(FESGL2(NU(NY,NX),NY,NX)*TORTL+DISPN) + 2*AREA(3,NU(NY,NX),NY,NX) + DIFHY=(HYSGL2(NU(NY,NX),NY,NX)*TORTL+DISPN) + 2*AREA(3,NU(NY,NX),NY,NX) + DIFCA=(CASGL2(NU(NY,NX),NY,NX)*TORTL+DISPN) + 2*AREA(3,NU(NY,NX),NY,NX) + DIFMG=(GMSGL2(NU(NY,NX),NY,NX)*TORTL+DISPN) + 2*AREA(3,NU(NY,NX),NY,NX) + DIFNA=(ANSGL2(NU(NY,NX),NY,NX)*TORTL+DISPN) + 2*AREA(3,NU(NY,NX),NY,NX) + DIFKA=(AKSGL2(NU(NY,NX),NY,NX)*TORTL+DISPN) + 2*AREA(3,NU(NY,NX),NY,NX) + DIFOH=(OHSGL2(NU(NY,NX),NY,NX)*TORTL+DISPN) + 2*AREA(3,NU(NY,NX),NY,NX) + DIFSO=(SOSGL2(NU(NY,NX),NY,NX)*TORTL+DISPN) + 2*AREA(3,NU(NY,NX),NY,NX) + DIFCL=(CLSXL2(NU(NY,NX),NY,NX)*TORTL+DISPN) + 2*AREA(3,NU(NY,NX),NY,NX) + DIFC3=(C3SGL2(NU(NY,NX),NY,NX)*TORTL+DISPN) + 2*AREA(3,NU(NY,NX),NY,NX) + DIFHC=(HCSGL2(NU(NY,NX),NY,NX)*TORTL+DISPN) + 2*AREA(3,NU(NY,NX),NY,NX) DFVAL=DIFAL*(CAL1-CAL2) DFVFE=DIFFE*(CFE1-CFE2) DFVHY=DIFHY*(CHY1-CHY2) @@ -2116,6 +2258,13 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RC1BFB(3,NU(NY,NX),NY,NX)=RC1BF2+RFLC1B+DFVC1B RC2BFB(3,NU(NY,NX),NY,NX)=RC2BF2+RFLC2B+DFVC2B RM1BFB(3,NU(NY,NX),NY,NX)=RM1BF2+RFLM1B+DFVM1B +C IF(I.EQ.268)THEN +C WRITE(*,4444)'ROHFLS',I,J,M,NX,NY +C 2,ROHFLS(3,NU(NY,NX),NY,NX),ROHFL1,RFLOH,DFVOH +C 3,XOHFLS(3,NU(NY,NX),NY,NX),FLQGQ(NY,NX),COHR(NY,NX) +C 4,FLQGI(NY,NX),COHQ(I,NY,NX),COHW,VFLWG,FLQTM,ZOHW(NY,NX),VFLWW +4444 FORMAT(A8,5I4,20E12.4) +C ENDIF C C ACCUMULATE HOURLY FLUXES C @@ -2255,11 +2404,11 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) C MACROPORE TO MICROPORE TRANSFER C IF(FINHM(M,NU(NY,NX),NY,NX).GT.0.0)THEN - IF(VOLWHM(M,NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN - VFLW=AMAX1(0.0,AMIN1(XFRX,FINHM(M,NU(NY,NX),NY,NX) + IF(VOLWHM(M,NU(NY,NX),NY,NX).GT.ZEROS2(NY,NX))THEN + VFLW=AMAX1(0.0,AMIN1(VFLWX,FINHM(M,NU(NY,NX),NY,NX) 2/VOLWHM(M,NU(NY,NX),NY,NX))) ELSE - VFLW=XFRX + VFLW=VFLWX ENDIF RFLAL=VFLW*AMAX1(0.0,ZALH2(NU(NY,NX),NY,NX)) RFLFE=VFLW*AMAX1(0.0,ZFEH2(NU(NY,NX),NY,NX)) @@ -2330,11 +2479,11 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) C MICROPORE TO MACROPORE TRANSFER C ELSEIF(FINHM(M,NU(NY,NX),NY,NX).LT.0.0)THEN - IF(VOLWM(M,NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN - VFLW=AMIN1(0.0,AMAX1(-XFRX,FINHM(M,NU(NY,NX),NY,NX) + IF(VOLWM(M,NU(NY,NX),NY,NX).GT.ZEROS2(NY,NX))THEN + VFLW=AMIN1(0.0,AMAX1(-VFLWX,FINHM(M,NU(NY,NX),NY,NX) 2/VOLWM(M,NU(NY,NX),NY,NX))) ELSE - VFLW=-XFRX + VFLW=-VFLWX ENDIF RFLAL=VFLW*AMAX1(0.0,ZAL2(NU(NY,NX),NY,NX)) RFLFE=VFLW*AMAX1(0.0,ZFE2(NU(NY,NX),NY,NX)) @@ -2459,7 +2608,7 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) 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 + IF(VOLWHM(M,NU(NY,NX),NY,NX).GT.ZEROS2(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 @@ -2680,9 +2829,6 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) DFVC2B=0.0 DFVM1B=0.0 ENDIF -C -C ACCUMULATE HOURLY FLUXES -C RALFXS(NU(NY,NX),NY,NX)=RFLAL+DFVAL RFEFXS(NU(NY,NX),NY,NX)=RFLFE+DFVFE RHYFXS(NU(NY,NX),NY,NX)=RFLHY+DFVHY @@ -2732,6 +2878,9 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RC1BXB(NU(NY,NX),NY,NX)=RFLC1B+DFVC1B RC2BXB(NU(NY,NX),NY,NX)=RFLC2B+DFVC2B RM1BXB(NU(NY,NX),NY,NX)=RFLM1B+DFVM1B +C +C ACCUMULATE HOURLY FLUXES +C XALFXS(NU(NY,NX),NY,NX)=XALFXS(NU(NY,NX),NY,NX) 2+RALFXS(NU(NY,NX),NY,NX) XFEFXS(NU(NY,NX),NY,NX)=XFEFXS(NU(NY,NX),NY,NX) @@ -2913,11 +3062,11 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) C IF OVERLAND FLOW IS FROM CURRENT TO ADJACENT GRID CELL C ELSEIF(QRM(M,N,N5,N4).GT.0.0)THEN - IF(VOLWM(M,0,N2,N1).GT.ZEROS(N2,N1))THEN - VFLW=AMAX1(0.0,AMIN1(XFRX,QRM(M,N,N5,N4) + IF(VOLWM(M,0,N2,N1).GT.ZEROS2(N2,N1))THEN + VFLW=AMAX1(0.0,AMIN1(VFLWX,QRM(M,N,N5,N4) 2/VOLWM(M,0,N2,N1))) ELSE - VFLW=XFRX + VFLW=VFLWX ENDIF RQRAL(N,N5,N4)=VFLW*AMAX1(0.0,ZAL2(0,N2,N1)) RQRFE(N,N5,N4)=VFLW*AMAX1(0.0,ZFE2(0,N2,N1)) @@ -2964,11 +3113,11 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) C IF OVERLAND FLOW IS TO CURRENT FROM ADJACENT GRID CELL C ELSEIF(QRM(M,N,N5,N4).LT.0.0)THEN - IF(VOLWM(M,0,N5,N4).GT.ZEROS(N5,N4))THEN - VFLW=AMIN1(0.0,AMAX1(-XFRX,QRM(M,N,N5,N4) + IF(VOLWM(M,0,N5,N4).GT.ZEROS2(N5,N4))THEN + VFLW=AMIN1(0.0,AMAX1(-VFLWX,QRM(M,N,N5,N4) 2/VOLWM(M,0,N5,N4))) ELSE - VFLW=-XFRX + VFLW=-VFLWX ENDIF RQRAL(N,N5,N4)=VFLW*AMAX1(0.0,ZAL2(0,N5,N4)) RQRFE(N,N5,N4)=VFLW*AMAX1(0.0,ZFE2(0,N5,N4)) @@ -3106,9 +3255,9 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) C ELSEIF(QSM(M,N,N5,N4).GT.0.0)THEN IF(VOLS(N2,N1).GT.ZEROS(NY,NX))THEN - VFLW=AMAX1(0.0,AMIN1(XFRX,QSM(M,N,N5,N4)/VOLS(N2,N1))) + VFLW=AMAX1(0.0,AMIN1(VFLWX,QSM(M,N,N5,N4)/VOLS(N2,N1))) ELSE - VFLW=XFRX + VFLW=VFLWX ENDIF RQSAL(N,N5,N4)=VFLW*AMAX1(0.0,ZALW2(N2,N1)) RQSFE(N,N5,N4)=VFLW*AMAX1(0.0,ZFEW2(N2,N1)) @@ -3156,9 +3305,9 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) C ELSEIF(QSM(M,N,N5,N4).LT.0.0)THEN IF(VOLS(N5,N4).GT.ZEROS(N5,N4))THEN - VFLW=AMIN1(0.0,AMAX1(-XFRX,QSM(M,N,N5,N4)/VOLS(N5,N4))) + VFLW=AMIN1(0.0,AMAX1(-VFLWX,QSM(M,N,N5,N4)/VOLS(N5,N4))) ELSE - VFLW=-XFRX + VFLW=-VFLWX ENDIF RQSAL(N,N5,N4)=VFLW*AMAX1(0.0,ZALW2(N5,N4)) RQSFE(N,N5,N4)=VFLW*AMAX1(0.0,ZFEW2(N5,N4)) @@ -3284,11 +3433,20 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) N6=L+1 ENDIF ENDIF - IF(N3.GE.NU(N2,N1).AND.N6.GE.NU(N5,N4))THEN + DO 1100 LL=N6,NL(NY,NX) + IF(VOLX(LL,N5,N4).GT.ZEROS(N5,N4))THEN + N6=LL + GO TO 1101 + ENDIF +1100 CONTINUE +1101 CONTINUE C C SOLUTE FLUXES BETWEEN ADJACENT GRID CELLS FROM C WATER CONTENTS AND WATER FLUXES 'FLQM' FROM 'WATSUB' C + IF(VOLX(N3,N2,N1).GT.ZEROS(NY,NX))THEN + IF(N3.GE.NU(N2,N1).AND.N6.GE.NU(N5,N4) + 2.AND.N3.LE.NL(N2,N1).AND.N6.LE.NL(N5,N4))THEN THETW1(N3,N2,N1)=AMAX1(0.0,VOLWM(M,N3,N2,N1)/VOLX(N3,N2,N1)) THETW1(N6,N5,N4)=AMAX1(0.0,VOLWM(M,N6,N5,N4)/VOLX(N6,N5,N4)) THETH2=AMAX1(0.0,VOLWHM(M,N3,N2,N1)/VOLX(N3,N2,N1)) @@ -3303,11 +3461,11 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) C OF WATER FLUX AND MICROPORE GAS OR SOLUTE CONCENTRATIONS C IN CURRENT GRID CELL C - IF(VOLWM(M,N3,N2,N1).GT.ZEROS(N2,N1))THEN - VFLW=AMAX1(0.0,AMIN1(XFRX,FLWM(M,N,N6,N5,N4) + IF(VOLWM(M,N3,N2,N1).GT.ZEROS2(N2,N1))THEN + VFLW=AMAX1(0.0,AMIN1(VFLWX,FLWM(M,N,N6,N5,N4) 2/VOLWM(M,N3,N2,N1))) ELSE - VFLW=XFRX + VFLW=VFLWX ENDIF RFLAL=VFLW*AMAX1(0.0,ZAL2(N3,N2,N1)) RFLFE=VFLW*AMAX1(0.0,ZFE2(N3,N2,N1)) @@ -3365,11 +3523,11 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) C IN ADJACENT GRID CELL C ELSE - IF(VOLWM(M,N6,N5,N4).GT.ZEROS(N5,N4))THEN - VFLW=AMIN1(0.0,AMAX1(-XFRX,FLWM(M,N,N6,N5,N4) + IF(VOLWM(M,N6,N5,N4).GT.ZEROS2(N5,N4))THEN + VFLW=AMIN1(0.0,AMAX1(-VFLWX,FLWM(M,N,N6,N5,N4) 2/VOLWM(M,N6,N5,N4))) ELSE - VFLW=-XFRX + VFLW=-VFLWX ENDIF RFLAL=VFLW*AMAX1(0.0,ZAL2(N6,N5,N4)) RFLFE=VFLW*AMAX1(0.0,ZFE2(N6,N5,N4)) @@ -3427,7 +3585,9 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) C AND CONCENTRATION DIFFERENCES C IF(THETW1(N3,N2,N1).GT.THETY(N3,N2,N1) - 2.AND.THETW1(N6,N5,N4).GT.THETY(N6,N5,N4))THEN + 2.AND.THETW1(N6,N5,N4).GT.THETY(N6,N5,N4) + 3.AND.VOLWM(M,N3,N2,N1).GT.ZEROS2(N2,N1) + 4.AND.VOLWM(M,N6,N5,N4).GT.ZEROS2(N5,N4))THEN C C MICROPORE CONCENTRATIONS FROM WATER-FILLED POROSITY C IN CURRENT AND ADJACENT GRID CELLS @@ -3581,24 +3741,25 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) C C DIFFUSIVITIES IN CURRENT AND ADJACENT GRID CELL MICROPORES C - TORTL=(TORT(M,N3,N2,N1)*DLYR(N,N3,N2,N1) - 2+TORT(M,N6,N5,N4)*DLYR(N,N6,N5,N4)) - 3/(DLYR(N,N3,N2,N1)+DLYR(N,N6,N5,N4)) - DISPN=DISP(N,N6,N5,N4)*ABS(FLWM(M,N,N6,N5,N4)/AREA(N,N6,N5,N4)) - XDPTHM=XDPTH(N,N6,N5,N4)*(1.0-FMPR(N6,N5,N4)) - DIFPO=(POSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTHM - DIFAL=(ALSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTHM - DIFFE=(FESGL2(N6,N5,N4)*TORTL+DISPN)*XDPTHM - DIFHY=(HYSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTHM - DIFCA=(CASGL2(N6,N5,N4)*TORTL+DISPN)*XDPTHM - DIFMG=(GMSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTHM - DIFNA=(ANSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTHM - DIFKA=(AKSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTHM - DIFOH=(OHSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTHM - DIFSO=(SOSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTHM - DIFCL=(CLSXL2(N6,N5,N4)*TORTL+DISPN)*XDPTHM - DIFC3=(C3SGL2(N6,N5,N4)*TORTL+DISPN)*XDPTHM - DIFHC=(HCSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTHM + DLYR1=AMAX1(ZERO2,DLYR(N,N3,N2,N1)) + DLYR2=AMAX1(ZERO2,DLYR(N,N6,N5,N4)) + TORTL=(TORT(M,N3,N2,N1)*DLYR1+TORT(M,N6,N5,N4)*DLYR2) + 2/(DLYR1+DLYR2) + DISPN=DISP(N,N6,N5,N4) + 2*AMIN1(VFLWX,ABS(FLWM(M,N,N6,N5,N4)/AREA(N,N6,N5,N4))) + DIFPO=(POSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFAL=(ALSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFFE=(FESGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFHY=(HYSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFCA=(CASGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFMG=(GMSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFNA=(ANSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFKA=(AKSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFOH=(OHSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFSO=(SOSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFCL=(CLSXL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFC3=(C3SGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFHC=(HCSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) DFVAL=DIFAL*(CAL1-CAL2) DFVFE=DIFFE*(CFE1-CFE2) DFVHY=DIFHY*(CHY1-CHY2) @@ -3713,11 +3874,11 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) C OF WATER FLUX AND MACROPORE GAS OR SOLUTE CONCENTRATIONS C IN CURRENT GRID CELL C - IF(VOLWHM(M,N3,N2,N1).GT.ZEROS(N2,N1))THEN - VFLW=AMAX1(0.0,AMIN1(XFRX,FLWHM(M,N,N6,N5,N4) + IF(VOLWHM(M,N3,N2,N1).GT.ZEROS2(N2,N1))THEN + VFLW=AMAX1(0.0,AMIN1(VFLWX,FLWHM(M,N,N6,N5,N4) 2/VOLWHM(M,N3,N2,N1))) ELSE - VFLW=XFRX + VFLW=VFLWX ENDIF C C ACCOUNT FOR OVERLAND FLOW IF IN SURFACE SOIL LAYER @@ -3882,11 +4043,11 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) C OF WATER FLUX AND MACROPORE GAS OR SOLUTE CONCENTRATIONS C IN ADJACENT GRID CELL C - IF(VOLWHM(M,N6,N5,N4).GT.ZEROS(N5,N4))THEN - VFLW=AMIN1(0.0,AMAX1(-XFRX,FLWHM(M,N,N6,N5,N4) + IF(VOLWHM(M,N6,N5,N4).GT.ZEROS2(N5,N4))THEN + VFLW=AMIN1(0.0,AMAX1(-VFLWX,FLWHM(M,N,N6,N5,N4) 2/VOLWHM(M,N6,N5,N4))) ELSE - VFLW=-XFRX + VFLW=-VFLWX ENDIF RFHAL=VFLW*AMAX1(0.0,ZALH2(N6,N5,N4)) RFHFE=VFLW*AMAX1(0.0,ZFEH2(N6,N5,N4)) @@ -4102,24 +4263,25 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) C C DIFFUSIVITIES IN CURRENT AND ADJACENT GRID CELL MACROPORES C - TORTL=(TORTH(M,N3,N2,N1)*DLYR(N,N3,N2,N1) - 2+TORTH(M,N6,N5,N4)*DLYR(N,N6,N5,N4)) - 3/(DLYR(N,N3,N2,N1)+DLYR(N,N6,N5,N4)) - DISPN=DISP(N,N6,N5,N4)*ABS(FLWHM(M,N,N6,N5,N4)/AREA(N,N6,N5,N4)) - XDPTHM=XDPTH(N,N6,N5,N4)*FHOL(N6,N5,N4) - DIFPO=(POSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTHM - DIFAL=(ALSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTHM - DIFFE=(FESGL2(N6,N5,N4)*TORTL+DISPN)*XDPTHM - DIFHY=(HYSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTHM - DIFCA=(CASGL2(N6,N5,N4)*TORTL+DISPN)*XDPTHM - DIFMG=(GMSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTHM - DIFNA=(ANSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTHM - DIFKA=(AKSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTHM - DIFOH=(OHSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTHM - DIFSO=(SOSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTHM - DIFCL=(CLSXL2(N6,N5,N4)*TORTL+DISPN)*XDPTHM - DIFC3=(C3SGL2(N6,N5,N4)*TORTL+DISPN)*XDPTHM - DIFHC=(HCSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTHM + DLYR1=AMAX1(ZERO2,DLYR(N,N3,N2,N1)) + DLYR2=AMAX1(ZERO2,DLYR(N,N6,N5,N4)) + TORTL=(TORTH(M,N3,N2,N1)*DLYR1+TORTH(M,N6,N5,N4)*DLYR2) + 3/(DLYR1+DLYR2) + DISPN=DISP(N,N6,N5,N4) + 2*AMIN1(VFLWX,ABS(FLWHM(M,N,N6,N5,N4)/AREA(N,N6,N5,N4))) + DIFPO=(POSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFAL=(ALSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFFE=(FESGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFHY=(HYSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFCA=(CASGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFMG=(GMSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFNA=(ANSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFKA=(AKSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFOH=(OHSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFSO=(SOSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFCL=(CLSXL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFC3=(C3SGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) + DIFHC=(HCSGL2(N6,N5,N4)*TORTL+DISPN)*XDPTH(N,N6,N5,N4) C C DIFFUSIVE FLUXES BETWEEN CURRENT AND ADJACENT GRID CELL C MACROPORES @@ -4437,11 +4599,11 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) C MACROPORE TO MICROPORE TRANSFER C IF(FINHM(M,N6,N5,N4).GT.0.0)THEN - IF(VOLWHM(M,N6,N5,N4).GT.ZEROS(NY,NX))THEN - VFLW=AMAX1(0.0,AMIN1(XFRX,FINHM(M,N6,N5,N4) + IF(VOLWHM(M,N6,N5,N4).GT.ZEROS2(NY,NX))THEN + VFLW=AMAX1(0.0,AMIN1(VFLWX,FINHM(M,N6,N5,N4) 2/VOLWHM(M,N6,N5,N4))) ELSE - VFLW=XFRX + VFLW=VFLWX ENDIF RFLAL=VFLW*AMAX1(0.0,ZALH2(N6,N5,N4)) RFLFE=VFLW*AMAX1(0.0,ZFEH2(N6,N5,N4)) @@ -4512,11 +4674,11 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) C MICROPORE TO MACROPORE TRANSFER C ELSEIF(FINHM(M,N6,N5,N4).LT.0.0)THEN - IF(VOLWM(M,N6,N5,N4).GT.ZEROS(NY,NX))THEN - VFLW=AMIN1(0.0,AMAX1(-XFRX,FINHM(M,N6,N5,N4) + IF(VOLWM(M,N6,N5,N4).GT.ZEROS2(NY,NX))THEN + VFLW=AMIN1(0.0,AMAX1(-VFLWX,FINHM(M,N6,N5,N4) 2/VOLWM(M,N6,N5,N4))) ELSE - VFLW=-XFRX + VFLW=-VFLWX ENDIF RFLAL=VFLW*AMAX1(0.0,ZAL2(N6,N5,N4)) RFLFE=VFLW*AMAX1(0.0,ZFE2(N6,N5,N4)) @@ -4645,7 +4807,7 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) C DIFFUSIVE FLUXES OF SOLUTES BETWEEN MICROPORES AND C MACROPORES FROM AQUEOUS DIFFUSIVITIES AND CONCENTRATION DIFFERENCES C - IF(VOLWHM(M,N6,N5,N4).GT.ZEROS(NY,NX))THEN + IF(VOLWHM(M,N6,N5,N4).GT.ZEROS2(NY,NX))THEN VOLWHS=AMIN1(XFRS*VOLT(N6,N5,N4),VOLWHM(M,N6,N5,N4)) VOLWT=VOLWM(M,N6,N5,N4)+VOLWHS DFVAL=XNPX*(AMAX1(0.0,ZALH2(N6,N5,N4))*VOLWM(M,N6,N5,N4) @@ -5022,6 +5184,108 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) RC2BHB(N,N6,N5,N4)=0.0 RM1BHB(N,N6,N5,N4)=0.0 ENDIF + ELSE + THETW1(N3,N2,N1)=0.0 + THETW1(N6,N5,N4)=0.0 + RALFLS(N,N6,N5,N4)=0.0 + RFEFLS(N,N6,N5,N4)=0.0 + RHYFLS(N,N6,N5,N4)=0.0 + RCAFLS(N,N6,N5,N4)=0.0 + RMGFLS(N,N6,N5,N4)=0.0 + RNAFLS(N,N6,N5,N4)=0.0 + RKAFLS(N,N6,N5,N4)=0.0 + ROHFLS(N,N6,N5,N4)=0.0 + RSOFLS(N,N6,N5,N4)=0.0 + RCLFLS(N,N6,N5,N4)=0.0 + RC3FLS(N,N6,N5,N4)=0.0 + RHCFLS(N,N6,N5,N4)=0.0 + RAL1FS(N,N6,N5,N4)=0.0 + RAL2FS(N,N6,N5,N4)=0.0 + RAL3FS(N,N6,N5,N4)=0.0 + RAL4FS(N,N6,N5,N4)=0.0 + RALSFS(N,N6,N5,N4)=0.0 + RFE1FS(N,N6,N5,N4)=0.0 + RFE2FS(N,N6,N5,N4)=0.0 + RFE3FS(N,N6,N5,N4)=0.0 + RFE4FS(N,N6,N5,N4)=0.0 + RFESFS(N,N6,N5,N4)=0.0 + RCAOFS(N,N6,N5,N4)=0.0 + RCACFS(N,N6,N5,N4)=0.0 + RCAHFS(N,N6,N5,N4)=0.0 + RCASFS(N,N6,N5,N4)=0.0 + RMGOFS(N,N6,N5,N4)=0.0 + RMGCFS(N,N6,N5,N4)=0.0 + RMGHFS(N,N6,N5,N4)=0.0 + RMGSFS(N,N6,N5,N4)=0.0 + RNACFS(N,N6,N5,N4)=0.0 + RNASFS(N,N6,N5,N4)=0.0 + RKASFS(N,N6,N5,N4)=0.0 + RH0PFS(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 + RC0PFS(N,N6,N5,N4)=0.0 + RC1PFS(N,N6,N5,N4)=0.0 + RC2PFS(N,N6,N5,N4)=0.0 + RM1PFS(N,N6,N5,N4)=0.0 + RH0BFB(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 + RC0BFB(N,N6,N5,N4)=0.0 + RC1BFB(N,N6,N5,N4)=0.0 + RC2BFB(N,N6,N5,N4)=0.0 + RM1BFB(N,N6,N5,N4)=0.0 + RALFHS(N,N6,N5,N4)=0.0 + RFEFHS(N,N6,N5,N4)=0.0 + RHYFHS(N,N6,N5,N4)=0.0 + RCAFHS(N,N6,N5,N4)=0.0 + RMGFHS(N,N6,N5,N4)=0.0 + RNAFHS(N,N6,N5,N4)=0.0 + RKAFHS(N,N6,N5,N4)=0.0 + ROHFHS(N,N6,N5,N4)=0.0 + RSOFHS(N,N6,N5,N4)=0.0 + RCLFHS(N,N6,N5,N4)=0.0 + RC3FHS(N,N6,N5,N4)=0.0 + RHCFHS(N,N6,N5,N4)=0.0 + RAL1HS(N,N6,N5,N4)=0.0 + RAL2HS(N,N6,N5,N4)=0.0 + RAL3HS(N,N6,N5,N4)=0.0 + RAL4HS(N,N6,N5,N4)=0.0 + RALSHS(N,N6,N5,N4)=0.0 + RFE1HS(N,N6,N5,N4)=0.0 + RFE2HS(N,N6,N5,N4)=0.0 + RFE3HS(N,N6,N5,N4)=0.0 + RFE4HS(N,N6,N5,N4)=0.0 + RFESHS(N,N6,N5,N4)=0.0 + RCAOHS(N,N6,N5,N4)=0.0 + RCACHS(N,N6,N5,N4)=0.0 + RCAHHS(N,N6,N5,N4)=0.0 + RCASHS(N,N6,N5,N4)=0.0 + RMGOHS(N,N6,N5,N4)=0.0 + RMGCHS(N,N6,N5,N4)=0.0 + RMGHHS(N,N6,N5,N4)=0.0 + RMGSHS(N,N6,N5,N4)=0.0 + RNACHS(N,N6,N5,N4)=0.0 + RNASHS(N,N6,N5,N4)=0.0 + RKASHS(N,N6,N5,N4)=0.0 + RH0PHS(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 + RC0PHS(N,N6,N5,N4)=0.0 + RC1PHS(N,N6,N5,N4)=0.0 + RC2PHS(N,N6,N5,N4)=0.0 + RM1PHS(N,N6,N5,N4)=0.0 + RH0BHB(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 + RC0BHB(N,N6,N5,N4)=0.0 + RC1BHB(N,N6,N5,N4)=0.0 + RC2BHB(N,N6,N5,N4)=0.0 + RM1BHB(N,N6,N5,N4)=0.0 + ENDIF 120 CONTINUE 125 CONTINUE ENDIF @@ -5178,12 +5442,13 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) C SOLUTE LOSS FROM RUNOFF DEPENDING ON ASPECT C AND BOUNDARY CONDITIONS SET IN SITE FILE C - ELSEIF(QRM(M,N,M5,M4).GT.0.0)THEN - IF(VOLWM(M,0,M2,M1).GT.ZEROS(M2,M1))THEN - VFLW=AMAX1(0.0,AMIN1(XFRX,QRM(M,N,M5,M4) + ELSEIF(NN.EQ.1.AND.QRM(M,N,M5,M4).GT.0.0 + 2.OR.NN.EQ.2.AND.QRM(M,N,M5,M4).LT.0.0)THEN + IF(VOLWM(M,0,M2,M1).GT.ZEROS2(M2,M1))THEN + VFLW=AMAX1(0.0,AMIN1(VFLWX,QRM(M,N,M5,M4) 2/VOLWM(M,0,M2,M1))) ELSE - VFLW=XFRX + VFLW=0.0 ENDIF RQRAL(N,M5,M4)=VFLW*AMAX1(0.0,ZAL2(0,M2,M1)) RQRFE(N,M5,M4)=VFLW*AMAX1(0.0,ZFE2(0,M2,M1)) @@ -5235,7 +5500,7 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) C SOLUTE GAIN FROM RUNON DEPENDING ON ASPECT C AND BOUNDARY CONDITIONS SET IN SITE FILE C - ELSEIF(QRM(M,N,M5,M4).LT.0.0)THEN + ELSE RQRAL(N,M5,M4)=0.0 RQRFE(N,M5,M4)=0.0 RQRHY(N,M5,M4)=0.0 @@ -5367,11 +5632,12 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) C C SOLUTE LOSS WITH SUBSURFACE MICROPORE WATER LOSS C + IF(VOLX(N3,N2,N1).GT.ZEROS(NY,NX))THEN IF(NCN(M2,M1).NE.3.OR.N.EQ.3)THEN IF(NN.EQ.1.AND.FLWM(M,N,M6,M5,M4).GT.0.0 2.OR.NN.EQ.2.AND.FLWM(M,N,M6,M5,M4).LT.0.0)THEN - IF(VOLWM(M,M3,M2,M1).GT.ZEROS(M2,M1))THEN - VFLW=AMAX1(-XFRX,AMIN1(XFRX,FLWM(M,N,M6,M5,M4) + IF(VOLWM(M,M3,M2,M1).GT.ZEROS2(M2,M1))THEN + VFLW=AMAX1(-VFLWX,AMIN1(VFLWX,FLWM(M,N,M6,M5,M4) 2/VOLWM(M,M3,M2,M1))) ELSE VFLW=0.0 @@ -5445,79 +5711,79 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) C SOLUTE GAIN WITH SUBSURFACE MICROPORE WATER GAIN C ELSE - RALFLS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CALU(L,NY,NX) - RFEFLS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CFEU(L,NY,NX) - RHYFLS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CHYU(L,NY,NX) - RCAFLS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CCAU(L,NY,NX) - RMGFLS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CMGU(L,NY,NX) - RNAFLS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CNAU(L,NY,NX) - RKAFLS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CKAU(L,NY,NX) - ROHFLS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*COHU(L,NY,NX) - RSOFLS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CSOU(L,NY,NX) - RCLFLS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CCLU(L,NY,NX) - RC3FLS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CC3U(L,NY,NX) - RHCFLS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CHCU(L,NY,NX) - RAL1FS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CAL1U(L,NY,NX) - RAL2FS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CAL2U(L,NY,NX) - RAL3FS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CAL3U(L,NY,NX) - RAL4FS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CAL4U(L,NY,NX) - RALSFS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CALSU(L,NY,NX) - RFE1FS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CFE1U(L,NY,NX) - RFE2FS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CFE2U(L,NY,NX) - RFE3FS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CFE3U(L,NY,NX) - RFE4FS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CFE4U(L,NY,NX) - RFESFS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CFESU(L,NY,NX) - RCAOFS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CCAOU(L,NY,NX) - RCACFS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CCACU(L,NY,NX) - RCAHFS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CCAHU(L,NY,NX) - RCASFS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CCASU(L,NY,NX) - RMGOFS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CMGOU(L,NY,NX) - RMGCFS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CMGCU(L,NY,NX) - RMGHFS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CMGHU(L,NY,NX) - RMGSFS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CMGSU(L,NY,NX) - RNACFS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CNACU(L,NY,NX) - 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) - RH3PFS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CH3PU(L,NY,NX) - 2*VLPO4(L,NY,NX) - RF1PFS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CF1PU(L,NY,NX) - 2*VLPO4(L,NY,NX) - RF2PFS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CF2PU(L,NY,NX) - 2*VLPO4(L,NY,NX) - RC0PFS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CC0PU(L,NY,NX) - 2*VLPO4(L,NY,NX) - RC1PFS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CC1PU(L,NY,NX) - 2*VLPO4(L,NY,NX) - RC2PFS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CC2PU(L,NY,NX) - 2*VLPO4(L,NY,NX) - 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) - RH3BFB(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CH3PU(L,NY,NX) - 2*VLPOB(L,NY,NX) - RF1BFB(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CF1PU(L,NY,NX) - 2*VLPOB(L,NY,NX) - RF2BFB(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CF2PU(L,NY,NX) - 2*VLPOB(L,NY,NX) - RC0BFB(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CC0PU(L,NY,NX) - 2*VLPOB(L,NY,NX) - RC1BFB(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CC1PU(L,NY,NX) - 2*VLPOB(L,NY,NX) - RC2BFB(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CC2PU(L,NY,NX) - 2*VLPOB(L,NY,NX) - RM1BFB(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CM1PU(L,NY,NX) - 2*VLPOB(L,NY,NX) + RALFLS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CALU(M3,M2,M1) + RFEFLS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CFEU(M3,M2,M1) + RHYFLS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CHYU(M3,M2,M1) + RCAFLS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CCAU(M3,M2,M1) + RMGFLS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CMGU(M3,M2,M1) + RNAFLS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CNAU(M3,M2,M1) + RKAFLS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CKAU(M3,M2,M1) + ROHFLS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*COHU(M3,M2,M1) + RSOFLS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CSOU(M3,M2,M1) + RCLFLS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CCLU(M3,M2,M1) + RC3FLS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CC3U(M3,M2,M1) + RHCFLS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CHCU(M3,M2,M1) + RAL1FS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CAL1U(M3,M2,M1) + RAL2FS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CAL2U(M3,M2,M1) + RAL3FS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CAL3U(M3,M2,M1) + RAL4FS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CAL4U(M3,M2,M1) + RALSFS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CALSU(M3,M2,M1) + RFE1FS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CFE1U(M3,M2,M1) + RFE2FS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CFE2U(M3,M2,M1) + RFE3FS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CFE3U(M3,M2,M1) + RFE4FS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CFE4U(M3,M2,M1) + RFESFS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CFESU(M3,M2,M1) + RCAOFS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CCAOU(M3,M2,M1) + RCACFS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CCACU(M3,M2,M1) + RCAHFS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CCAHU(M3,M2,M1) + RCASFS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CCASU(M3,M2,M1) + RMGOFS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CMGOU(M3,M2,M1) + RMGCFS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CMGCU(M3,M2,M1) + RMGHFS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CMGHU(M3,M2,M1) + RMGSFS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CMGSU(M3,M2,M1) + RNACFS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CNACU(M3,M2,M1) + RNASFS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CNASU(M3,M2,M1) + RKASFS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CKASU(M3,M2,M1) + RH0PFS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CH0PU(M3,M2,M1) + 2*VLPO4(M3,M2,M1) + RH3PFS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CH3PU(M3,M2,M1) + 2*VLPO4(M3,M2,M1) + RF1PFS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CF1PU(M3,M2,M1) + 2*VLPO4(M3,M2,M1) + RF2PFS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CF2PU(M3,M2,M1) + 2*VLPO4(M3,M2,M1) + RC0PFS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CC0PU(M3,M2,M1) + 2*VLPO4(M3,M2,M1) + RC1PFS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CC1PU(M3,M2,M1) + 2*VLPO4(M3,M2,M1) + RC2PFS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CC2PU(M3,M2,M1) + 2*VLPO4(M3,M2,M1) + RM1PFS(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CM1PU(M3,M2,M1) + 2*VLPO4(M3,M2,M1) + RH0BFB(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CH0PU(M3,M2,M1) + 2*VLPOB(M3,M2,M1) + RH3BFB(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CH3PU(M3,M2,M1) + 2*VLPOB(M3,M2,M1) + RF1BFB(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CF1PU(M3,M2,M1) + 2*VLPOB(M3,M2,M1) + RF2BFB(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CF2PU(M3,M2,M1) + 2*VLPOB(M3,M2,M1) + RC0BFB(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CC0PU(M3,M2,M1) + 2*VLPOB(M3,M2,M1) + RC1BFB(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CC1PU(M3,M2,M1) + 2*VLPOB(M3,M2,M1) + RC2BFB(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CC2PU(M3,M2,M1) + 2*VLPOB(M3,M2,M1) + RM1BFB(N,M6,M5,M4)=FLWM(M,N,M6,M5,M4)*CM1PU(M3,M2,M1) + 2*VLPOB(M3,M2,M1) ENDIF C C SOLUTE LOSS WITH SUBSURFACE MACROPORE WATER LOSS C IF(NN.EQ.1.AND.FLWHM(M,N,M6,M5,M4).GT.0.0 2.OR.NN.EQ.2.AND.FLWHM(M,N,M6,M5,M4).LT.0.0)THEN - IF(VOLWHM(M,M3,M2,M1).GT.ZEROS(M2,M1))THEN - VFLW=AMAX1(-XFRX,AMIN1(XFRX,FLWHM(M,N,M6,M5,M4) + IF(VOLWHM(M,M3,M2,M1).GT.ZEROS2(M2,M1))THEN + VFLW=AMAX1(-VFLWX,AMIN1(VFLWX,FLWHM(M,N,M6,M5,M4) 2/VOLWHM(M,M3,M2,M1))) ELSE VFLW=0.0 @@ -5743,6 +6009,7 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) XC2BHB(N,M6,M5,M4)=XC2BHB(N,M6,M5,M4)+RC2BHB(N,M6,M5,M4) XM1BHB(N,M6,M5,M4)=XM1BHB(N,M6,M5,M4)+RM1BHB(N,M6,M5,M4) ENDIF + ENDIF 9575 CONTINUE C C TOTAL SOLUTE FLUXES IN EACH GRID CELL @@ -5837,6 +6104,15 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) C C TOTAL SOLUTE FLUX IN MICROPORES AND MACROPORES C + IF(NCN(N2,N1).NE.3.OR.N.EQ.3)THEN + DO 1200 LL=N6,NL(NY,NX) + IF(VOLX(LL,N2,N1).GT.ZEROS(N2,N1))THEN + N6=LL + GO TO 1201 + ENDIF +1200 CONTINUE +1201 CONTINUE + IF(VOLX(N3,N2,N1).GT.ZEROS(N2,N1))THEN TALFLS(N3,N2,N1)=TALFLS(N3,N2,N1)+RALFLS(N,N3,N2,N1) 2-RALFLS(N,N6,N5,N4) TFEFLS(N3,N2,N1)=TFEFLS(N3,N2,N1)+RFEFLS(N,N3,N2,N1) @@ -6033,6 +6309,107 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) 2-RC2BHB(N,N6,N5,N4) TM1BHB(N3,N2,N1)=TM1BHB(N3,N2,N1)+RM1BHB(N,N3,N2,N1) 2-RM1BHB(N,N6,N5,N4) + ELSE + TALFLS(N3,N2,N1)=0.0 + TFEFLS(N3,N2,N1)=0.0 + THYFLS(N3,N2,N1)=0.0 + TCAFLS(N3,N2,N1)=0.0 + TMGFLS(N3,N2,N1)=0.0 + TNAFLS(N3,N2,N1)=0.0 + TKAFLS(N3,N2,N1)=0.0 + TOHFLS(N3,N2,N1)=0.0 + TSOFLS(N3,N2,N1)=0.0 + TCLFLS(N3,N2,N1)=0.0 + TC3FLS(N3,N2,N1)=0.0 + THCFLS(N3,N2,N1)=0.0 + TAL1FS(N3,N2,N1)=0.0 + TAL2FS(N3,N2,N1)=0.0 + TAL3FS(N3,N2,N1)=0.0 + TAL4FS(N3,N2,N1)=0.0 + TALSFS(N3,N2,N1)=0.0 + TFE1FS(N3,N2,N1)=0.0 + TFE2FS(N3,N2,N1)=0.0 + TFE3FS(N3,N2,N1)=0.0 + TFE4FS(N3,N2,N1)=0.0 + TFESFS(N3,N2,N1)=0.0 + TCAOFS(N3,N2,N1)=0.0 + TCACFS(N3,N2,N1)=0.0 + TCAHFS(N3,N2,N1)=0.0 + TCASFS(N3,N2,N1)=0.0 + TMGOFS(N3,N2,N1)=0.0 + TMGCFS(N3,N2,N1)=0.0 + TMGHFS(N3,N2,N1)=0.0 + TMGSFS(N3,N2,N1)=0.0 + TNACFS(N3,N2,N1)=0.0 + TNASFS(N3,N2,N1)=0.0 + TKASFS(N3,N2,N1)=0.0 + TH0PFS(N3,N2,N1)=0.0 + TH3PFS(N3,N2,N1)=0.0 + TF1PFS(N3,N2,N1)=0.0 + TF2PFS(N3,N2,N1)=0.0 + TC0PFS(N3,N2,N1)=0.0 + TC1PFS(N3,N2,N1)=0.0 + TC2PFS(N3,N2,N1)=0.0 + TM1PFS(N3,N2,N1)=0.0 + TH0BFB(N3,N2,N1)=0.0 + TH3BFB(N3,N2,N1)=0.0 + TF1BFB(N3,N2,N1)=0.0 + TF2BFB(N3,N2,N1)=0.0 + TC0BFB(N3,N2,N1)=0.0 + TC1BFB(N3,N2,N1)=0.0 + TC2BFB(N3,N2,N1)=0.0 + TM1BFB(N3,N2,N1)=0.0 + TALFHS(N3,N2,N1)=0.0 + TFEFHS(N3,N2,N1)=0.0 + THYFHS(N3,N2,N1)=0.0 + TCAFHS(N3,N2,N1)=0.0 + TMGFHS(N3,N2,N1)=0.0 + TNAFHS(N3,N2,N1)=0.0 + TKAFHS(N3,N2,N1)=0.0 + TOHFHS(N3,N2,N1)=0.0 + TSOFHS(N3,N2,N1)=0.0 + TCLFHS(N3,N2,N1)=0.0 + TC3FHS(N3,N2,N1)=0.0 + THCFHS(N3,N2,N1)=0.0 + TAL1HS(N3,N2,N1)=0.0 + TAL2HS(N3,N2,N1)=0.0 + TAL3HS(N3,N2,N1)=0.0 + TAL4HS(N3,N2,N1)=0.0 + TALSHS(N3,N2,N1)=0.0 + TFE1HS(N3,N2,N1)=0.0 + TFE2HS(N3,N2,N1)=0.0 + TFE3HS(N3,N2,N1)=0.0 + TFE4HS(N3,N2,N1)=0.0 + TFESHS(N3,N2,N1)=0.0 + TCAOHS(N3,N2,N1)=0.0 + TCACHS(N3,N2,N1)=0.0 + TCAHHS(N3,N2,N1)=0.0 + TCASHS(N3,N2,N1)=0.0 + TMGOHS(N3,N2,N1)=0.0 + TMGCHS(N3,N2,N1)=0.0 + TMGHHS(N3,N2,N1)=0.0 + TMGSHS(N3,N2,N1)=0.0 + TNACHS(N3,N2,N1)=0.0 + TNASHS(N3,N2,N1)=0.0 + TKASHS(N3,N2,N1)=0.0 + TH0PHS(N3,N2,N1)=0.0 + TH3PHS(N3,N2,N1)=0.0 + TF1PHS(N3,N2,N1)=0.0 + TF2PHS(N3,N2,N1)=0.0 + TC0PHS(N3,N2,N1)=0.0 + TC1PHS(N3,N2,N1)=0.0 + TC2PHS(N3,N2,N1)=0.0 + TM1PHS(N3,N2,N1)=0.0 + TH0BHB(N3,N2,N1)=0.0 + TH3BHB(N3,N2,N1)=0.0 + TF1BHB(N3,N2,N1)=0.0 + TF2BHB(N3,N2,N1)=0.0 + TC0BHB(N3,N2,N1)=0.0 + TC1BHB(N3,N2,N1)=0.0 + TC2BHB(N3,N2,N1)=0.0 + TM1BHB(N3,N2,N1)=0.0 + ENDIF + ENDIF 9580 CONTINUE 9585 CONTINUE ENDIF @@ -6136,104 +6513,105 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) C REACTIONS IN SOLUTE C DO 9685 L=NU(NY,NX),NL(NY,NX) + IF(VOLX(L,NY,NX).GT.ZEROS(NY,NX))THEN ZAL2(L,NY,NX)=ZAL2(L,NY,NX)+TALFLS(L,NY,NX)+RALFXS(L,NY,NX) - 2+RALFLZ(L,NY,NX)+TRAL(L,NY,NX)*XNPH + 2+RALFLZ(L,NY,NX) 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 + 2+RFEFLZ(L,NY,NX) 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)+XZHYS(L,NY,NX))*XNPH + 2+RHYFLZ(L,NY,NX) 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 + 2+RCAFLZ(L,NY,NX) ZMG2(L,NY,NX)=ZMG2(L,NY,NX)+TMGFLS(L,NY,NX)+RMGFXS(L,NY,NX) - 2+RMGFLZ(L,NY,NX)+TRMG(L,NY,NX)*XNPH + 2+RMGFLZ(L,NY,NX) ZNA2(L,NY,NX)=ZNA2(L,NY,NX)+TNAFLS(L,NY,NX)+RNAFXS(L,NY,NX) - 2+RNAFLZ(L,NY,NX)+TRNA(L,NY,NX)*XNPH + 2+RNAFLZ(L,NY,NX) ZKA2(L,NY,NX)=ZKA2(L,NY,NX)+TKAFLS(L,NY,NX)+RKAFXS(L,NY,NX) - 2+RKAFLZ(L,NY,NX)+TRKA(L,NY,NX)*XNPH + 2+RKAFLZ(L,NY,NX) ZOH2(L,NY,NX)=ZOH2(L,NY,NX)+TOHFLS(L,NY,NX)+ROHFXS(L,NY,NX) - 2+ROHFLZ(L,NY,NX)+TROH(L,NY,NX)*XNPH + 2+ROHFLZ(L,NY,NX) ZSO42(L,NY,NX)=ZSO42(L,NY,NX)+TSOFLS(L,NY,NX)+RSOFXS(L,NY,NX) - 2+RSOFLZ(L,NY,NX)+TRSO4(L,NY,NX)*XNPH + 2+RSOFLZ(L,NY,NX) ZCL2(L,NY,NX)=ZCL2(L,NY,NX)+TCLFLS(L,NY,NX)+RCLFXS(L,NY,NX) 2+RCLFLZ(L,NY,NX) ZCO32(L,NY,NX)=ZCO32(L,NY,NX)+TC3FLS(L,NY,NX)+RC3FXS(L,NY,NX) - 2+RC3FLZ(L,NY,NX)+TRCO3(L,NY,NX)*XNPH + 2+RC3FLZ(L,NY,NX) ZHCO32(L,NY,NX)=ZHCO32(L,NY,NX)+THCFLS(L,NY,NX)+RHCFXS(L,NY,NX) - 2+RHCFLZ(L,NY,NX)+TRHCO(L,NY,NX)*XNPH + 2+RHCFLZ(L,NY,NX) ZAL12(L,NY,NX)=ZAL12(L,NY,NX)+TAL1FS(L,NY,NX)+RAL1XS(L,NY,NX) - 2+RAL1FZ(L,NY,NX)+TRAL1(L,NY,NX)*XNPH + 2+RAL1FZ(L,NY,NX) ZAL22(L,NY,NX)=ZAL22(L,NY,NX)+TAL2FS(L,NY,NX)+RAL2XS(L,NY,NX) - 2+RAL2FZ(L,NY,NX)+TRAL2(L,NY,NX)*XNPH + 2+RAL2FZ(L,NY,NX) ZAL32(L,NY,NX)=ZAL32(L,NY,NX)+TAL3FS(L,NY,NX)+RAL3XS(L,NY,NX) - 2+RAL3FZ(L,NY,NX)+TRAL3(L,NY,NX)*XNPH + 2+RAL3FZ(L,NY,NX) ZAL42(L,NY,NX)=ZAL42(L,NY,NX)+TAL4FS(L,NY,NX)+RAL4XS(L,NY,NX) - 2+RAL4FZ(L,NY,NX)+TRAL4(L,NY,NX)*XNPH + 2+RAL4FZ(L,NY,NX) ZALS2(L,NY,NX)=ZALS2(L,NY,NX)+TALSFS(L,NY,NX)+RALSXS(L,NY,NX) - 2+RALSFZ(L,NY,NX)+TRALS(L,NY,NX)*XNPH + 2+RALSFZ(L,NY,NX) ZFE12(L,NY,NX)=ZFE12(L,NY,NX)+TFE1FS(L,NY,NX)+RFE1XS(L,NY,NX) - 2+RFE1FZ(L,NY,NX)+TRFE1(L,NY,NX)*XNPH + 2+RFE1FZ(L,NY,NX) ZFE22(L,NY,NX)=ZFE22(L,NY,NX)+TFE2FS(L,NY,NX)+RFE2XS(L,NY,NX) - 2+RFE2FZ(L,NY,NX)+TRFE2(L,NY,NX)*XNPH + 2+RFE2FZ(L,NY,NX) ZFE32(L,NY,NX)=ZFE32(L,NY,NX)+TFE3FS(L,NY,NX)+RFE3XS(L,NY,NX) - 2+RFE3FZ(L,NY,NX)+TRFE3(L,NY,NX)*XNPH + 2+RFE3FZ(L,NY,NX) ZFE42(L,NY,NX)=ZFE42(L,NY,NX)+TFE4FS(L,NY,NX)+RFE4XS(L,NY,NX) - 2+RFE4FZ(L,NY,NX)+TRFE4(L,NY,NX)*XNPH + 2+RFE4FZ(L,NY,NX) ZFES2(L,NY,NX)=ZFES2(L,NY,NX)+TFESFS(L,NY,NX)+RFESXS(L,NY,NX) - 2+RFESFZ(L,NY,NX)+TRFES(L,NY,NX)*XNPH + 2+RFESFZ(L,NY,NX) ZCAO2(L,NY,NX)=ZCAO2(L,NY,NX)+TCAOFS(L,NY,NX)+RCAOXS(L,NY,NX) - 2+RCAOFZ(L,NY,NX)+TRCAO(L,NY,NX)*XNPH + 2+RCAOFZ(L,NY,NX) ZCAC2(L,NY,NX)=ZCAC2(L,NY,NX)+TCACFS(L,NY,NX)+RCACXS(L,NY,NX) - 2+RCACFZ(L,NY,NX)+TRCAC(L,NY,NX)*XNPH + 2+RCACFZ(L,NY,NX) ZCAH2(L,NY,NX)=ZCAH2(L,NY,NX)+TCAHFS(L,NY,NX)+RCAHXS(L,NY,NX) - 2+RCAHFZ(L,NY,NX)+TRCAH(L,NY,NX)*XNPH + 2+RCAHFZ(L,NY,NX) ZCAS2(L,NY,NX)=ZCAS2(L,NY,NX)+TCASFS(L,NY,NX)+RCASXS(L,NY,NX) - 2+RCASFZ(L,NY,NX)+TRCAS(L,NY,NX)*XNPH + 2+RCASFZ(L,NY,NX) ZMGO2(L,NY,NX)=ZMGO2(L,NY,NX)+TMGOFS(L,NY,NX)+RMGOXS(L,NY,NX) - 2+RMGOFZ(L,NY,NX)+TRMGO(L,NY,NX)*XNPH + 2+RMGOFZ(L,NY,NX) ZMGC2(L,NY,NX)=ZMGC2(L,NY,NX)+TMGCFS(L,NY,NX)+RMGCXS(L,NY,NX) - 2+RMGCFZ(L,NY,NX)+TRMGC(L,NY,NX)*XNPH + 2+RMGCFZ(L,NY,NX) ZMGH2(L,NY,NX)=ZMGH2(L,NY,NX)+TMGHFS(L,NY,NX)+RMGHXS(L,NY,NX) - 2+RMGHFZ(L,NY,NX)+TRMGH(L,NY,NX)*XNPH + 2+RMGHFZ(L,NY,NX) ZMGS2(L,NY,NX)=ZMGS2(L,NY,NX)+TMGSFS(L,NY,NX)+RMGSXS(L,NY,NX) - 2+RMGSFZ(L,NY,NX)+TRMGS(L,NY,NX)*XNPH + 2+RMGSFZ(L,NY,NX) ZNAC2(L,NY,NX)=ZNAC2(L,NY,NX)+TNACFS(L,NY,NX)+RNACXS(L,NY,NX) - 2+RNACFZ(L,NY,NX)+TRNAC(L,NY,NX)*XNPH + 2+RNACFZ(L,NY,NX) ZNAS2(L,NY,NX)=ZNAS2(L,NY,NX)+TNASFS(L,NY,NX)+RNASXS(L,NY,NX) - 2+RNASFZ(L,NY,NX)+TRNAS(L,NY,NX)*XNPH + 2+RNASFZ(L,NY,NX) ZKAS2(L,NY,NX)=ZKAS2(L,NY,NX)+TKASFS(L,NY,NX)+RKASXS(L,NY,NX) - 2+RKASFZ(L,NY,NX)+TRKAS(L,NY,NX)*XNPH + 2+RKASFZ(L,NY,NX) 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 + 2+RH0PFZ(L,NY,NX) 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 + 2+RH3PFZ(L,NY,NX) ZFE1P2(L,NY,NX)=ZFE1P2(L,NY,NX)+TF1PFS(L,NY,NX)+RF1PXS(L,NY,NX) - 2+RF1PFZ(L,NY,NX)+TRF1P(L,NY,NX)*XNPH + 2+RF1PFZ(L,NY,NX) ZFE2P2(L,NY,NX)=ZFE2P2(L,NY,NX)+TF2PFS(L,NY,NX)+RF2PXS(L,NY,NX) - 2+RF2PFZ(L,NY,NX)+TRF2P(L,NY,NX)*XNPH + 2+RF2PFZ(L,NY,NX) ZCA0P2(L,NY,NX)=ZCA0P2(L,NY,NX)+TC0PFS(L,NY,NX)+RC0PXS(L,NY,NX) - 2+RC0PFZ(L,NY,NX)+TRC0P(L,NY,NX)*XNPH + 2+RC0PFZ(L,NY,NX) ZCA1P2(L,NY,NX)=ZCA1P2(L,NY,NX)+TC1PFS(L,NY,NX)+RC1PXS(L,NY,NX) - 2+RC1PFZ(L,NY,NX)+TRC1P(L,NY,NX)*XNPH + 2+RC1PFZ(L,NY,NX) ZCA2P2(L,NY,NX)=ZCA2P2(L,NY,NX)+TC2PFS(L,NY,NX)+RC2PXS(L,NY,NX) - 2+RC2PFZ(L,NY,NX)+TRC2P(L,NY,NX)*XNPH + 2+RC2PFZ(L,NY,NX) ZMG1P2(L,NY,NX)=ZMG1P2(L,NY,NX)+TM1PFS(L,NY,NX)+RM1PXS(L,NY,NX) - 2+RM1PFZ(L,NY,NX)+TRM1P(L,NY,NX)*XNPH + 2+RM1PFZ(L,NY,NX) 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 + 2+RH0BBZ(L,NY,NX) 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 + 2+RH3BBZ(L,NY,NX) ZF1PB2(L,NY,NX)=ZF1PB2(L,NY,NX)+TF1BFB(L,NY,NX)+RF1BXB(L,NY,NX) - 2+RF1BBZ(L,NY,NX)+TRF1B(L,NY,NX)*XNPH + 2+RF1BBZ(L,NY,NX) ZF2PB2(L,NY,NX)=ZF2PB2(L,NY,NX)+TF2BFB(L,NY,NX)+RF2BXB(L,NY,NX) - 2+RF2BBZ(L,NY,NX)+TRF2B(L,NY,NX)*XNPH + 2+RF2BBZ(L,NY,NX) ZC0PB2(L,NY,NX)=ZC0PB2(L,NY,NX)+TC0BFB(L,NY,NX)+RC0BXB(L,NY,NX) - 2+RC0BBZ(L,NY,NX)+TRC0B(L,NY,NX)*XNPH + 2+RC0BBZ(L,NY,NX) ZC1PB2(L,NY,NX)=ZC1PB2(L,NY,NX)+TC1BFB(L,NY,NX)+RC1BXB(L,NY,NX) - 2+RC1BBZ(L,NY,NX)+TRC1B(L,NY,NX)*XNPH + 2+RC1BBZ(L,NY,NX) ZC2PB2(L,NY,NX)=ZC2PB2(L,NY,NX)+TC2BFB(L,NY,NX)+RC2BXB(L,NY,NX) - 2+RC2BBZ(L,NY,NX)+TRC2B(L,NY,NX)*XNPH + 2+RC2BBZ(L,NY,NX) ZM1PB2(L,NY,NX)=ZM1PB2(L,NY,NX)+TM1BFB(L,NY,NX)+RM1BXB(L,NY,NX) - 2+RM1BBZ(L,NY,NX)+TRM1B(L,NY,NX)*XNPH + 2+RM1BBZ(L,NY,NX) ZALH2(L,NY,NX)=ZALH2(L,NY,NX)+TALFHS(L,NY,NX)-RALFXS(L,NY,NX) ZFEH2(L,NY,NX)=ZFEH2(L,NY,NX)+TFEFHS(L,NY,NX)-RFEFXS(L,NY,NX) ZHYH2(L,NY,NX)=ZHYH2(L,NY,NX)+THYFHS(L,NY,NX)-RHYFXS(L,NY,NX) @@ -6283,6 +6661,16 @@ SUBROUTINE trnsfrs(I,J,NHW,NHE,NVN,NVS) ZC1BH2(L,NY,NX)=ZC1BH2(L,NY,NX)+TC1BHB(L,NY,NX)-RC1BXB(L,NY,NX) ZC2BH2(L,NY,NX)=ZC2BH2(L,NY,NX)+TC2BHB(L,NY,NX)-RC2BXB(L,NY,NX) ZM1BH2(L,NY,NX)=ZM1BH2(L,NY,NX)+TM1BHB(L,NY,NX)-RM1BXB(L,NY,NX) +C IF(I.EQ.268.AND.L.EQ.1)THEN +C WRITE(*,444)'ZOH2',I,J,M,NX,NY,L,ZOH2(L,NY,NX) +C 2,TOHFLS(L,NY,NX),ROHFXS(L,NY,NX),ROHFLZ(L,NY,NX) +C 3,ROHFLS(3,L-1,NY,NX),ROHFLS(3,L,NY,NX) +C WRITE(*,444)'ZAL2',I,J,M,NX,NY,L,ZAL2(L,NY,NX) +C 2,TALFLS(L,NY,NX),RALFXS(L,NY,NX),RALFLZ(L,NY,NX) +C 3,RZAL2(L,NY,NX),TRAL(L,NY,NX) +444 FORMAT(A8,6I4,20E12.4) +C ENDIF + ENDIF 9685 CONTINUE ENDIF 9690 CONTINUE diff --git a/f77src/uptake.f b/f77src/uptake.f old mode 100755 new mode 100644 index 3c33e4a..dbb2da6 --- a/f77src/uptake.f +++ b/f77src/uptake.f @@ -201,10 +201,14 @@ SUBROUTINE uptake(I,J,NHW,NHE,NVN,NVS) IF(L.EQ.NU(NY,NX))THEN FRTDPX(L,NZ)=1.0 ELSE + IF(DLYR(3,L,NY,NX).GT.ZERO)THEN RTDPX=AMAX1(0.0,RTDPZ-CDPTHZ(L-1,NY,NX)) RTDPX=AMAX1(0.0,AMIN1(DLYR(3,L,NY,NX),RTDPX) 2-AMAX1(0.0,SDPTH(NZ,NY,NX)-CDPTHZ(L-1,NY,NX)-HTCTL(NZ,NY,NX))) FRTDPX(L,NZ)=RTDPX/DLYR(3,L,NY,NX) + ELSE + FRTDPX(L,NZ)=0.0 + ENDIF ENDIF C IF(NZ.EQ.1.OR.NZ.EQ.2)THEN C WRITE(*,4413)'FRTDPX',I,J,NZ,L,N,FRTDPX(L,NZ) @@ -285,7 +289,9 @@ SUBROUTINE uptake(I,J,NHW,NHE,NVN,NVS) C 3,THETW(L,NY,NX) 2124 FORMAT(A8,8I4,20E12.4) C ENDIF - IF(RTDNP(N,L,NZ,NY,NX).GT.ZERO + IF(VOLX(L,NY,NX).GT.ZEROS(NY,NX) + 2.AND.VOLWM(NPH,L,NY,NX).GT.ZEROS2(NY,NX) + 2.AND.RTDNP(N,L,NZ,NY,NX).GT.ZERO 2.AND.CNDU(L,NY,NX).GT.ZERO 3.AND.RTN1(1,L,NZ,NY,NX).GT.ZEROP(NZ,NY,NX) 4.AND.RTNL(N,L,NZ,NY,NX).GT.ZEROP(NZ,NY,NX) @@ -439,7 +445,7 @@ SUBROUTINE uptake(I,J,NHW,NHE,NVN,NVS) C VHCPC(NZ,NY,NX)=VHCPX+4.19*(EVAPC(NZ,NY,NX)+FLWC(NZ,NY,NX)) TKCY=(TKCX*VHCPX+TKA(NY,NX)*PARHC+HFLXS)/(VHCPC(NZ,NY,NX)+PARHC) - TKCY=AMIN1(TKA(NY,NX)+20.0,AMAX1(TKA(NY,NX)-20.0,TKCY)) + TKCY=AMIN1(TKA(NY,NX)+10.0,AMAX1(TKA(NY,NX)-10.0,TKCY)) C C RESET CANOPY TEMPERATURE FOR NEXT ITERATION C @@ -457,10 +463,9 @@ SUBROUTINE uptake(I,J,NHW,NHE,NVN,NVS) C 2,TKA(NY,NX),TKCX,VHCPX,PARHC,HFLXS,VHCPC(NZ,NY,NX),WVPLT,EX C 2,FLWC(NZ,NY,NX),VOLWC(NZ,NY,NX),VOLWP(NZ,NY,NX),EVAPC(NZ,NY,NX) C 2,RAD1(NZ,NY,NX),EFLXC(NZ,NY,NX),RA(NZ,NY,NX),RC(NZ,NY,NX) -C 3,RADC(NZ,NY,NX),FDTHS,THRM1(NZ,NY,NX),VPC,VPA(NY,NX),PAREC C 2,EP(NZ,NY,NX),HFLXS,VFLXC,HFLWC1,RADC(NZ,NY,NX),FRADP(NZ,NY,NX) C 3,THS(NY,NX),THRMGX(NY,NX) -C 2,CH2O,RSX,RSMN(NZ,NY,NX),CCPOLT,OSWT,CCPOLP(NZ,NY,NX) +C 2,RSMN(NZ,NY,NX),CCPOLT,OSWT,CCPOLP(NZ,NY,NX),CPOOLP(NZ,NY,NX) C 4,DCO2(NZ,NY,NX),AREA(3,NU(NY,NX),NY,NX),WTLS(NZ,NY,NX) C 2,PSILT(NZ,NY,NX),PSILG(NZ,NY,NX),RACZ(NZ,NY,NX),RAZ(NZ,NY,NX),RI C 3,RIB(NY,NX),RA1,ARLFV(1,NZ,NY,NX),ARSTV(1,NZ,NY,NX) @@ -489,7 +494,6 @@ SUBROUTINE uptake(I,J,NHW,NHE,NVN,NVS) UPRT=UPRT+UPWTR(N,L,NZ,NY,NX) ELSE UPWTR(N,L,NZ,NY,NX)=0.0 - ENDIF C IF(I.GT.170.AND.NX.EQ.1.AND.NY.EQ.4.AND.NZ.EQ.2)THEN C WRITE(*,6565)'UPRT',I,J,NX,NY,NZ,L,N,NN,UPRT,UPWTR(N,L,NZ,NY,NX) C 2,VOLWM(NPH,L,NY,NX),PSILC,PSIST1(L),RSRS(N,L),RSSX(N,L) @@ -497,6 +501,7 @@ SUBROUTINE uptake(I,J,NHW,NHE,NVN,NVS) C 3,RSRR(N,NZ,NY,NX),VOLA(L,NY,NX),VOLWM(NPH,L,NY,NX) 6565 FORMAT(A8,8I4,30E12.4) C ENDIF + ENDIF 4200 CONTINUE C C TEST TRANSPIRATION - ROOT WATER UPTAKE VS. CHANGE IN CANOPY @@ -664,6 +669,7 @@ SUBROUTINE uptake(I,J,NHW,NHE,NVN,NVS) C IF(I.EQ.284)THEN C WRITE(*,1256)'PSIRT',I,J,NX,NY,NZ,NN,PSIRT(N,L,NZ,NY,NX) C 2,PSIST1(L),RSRT(N,L),PSILT(NZ,NY,NX),RSSX(N,L),RSRS(N,L) +C 3,RSRG(N,L),RSR1(N,L),RSR2(N,L),RTAR2,VOLWM(NPH,L,NY,NX) 1256 FORMAT(A8,6I4,20E12.4) C ENDIF 4510 CONTINUE @@ -784,6 +790,10 @@ SUBROUTINE uptake(I,J,NHW,NHE,NVN,NVS) C DO 955 N=1,MY(NZ,NY,NX) DO 950 L=NU(NY,NX),NI(NZ,NY,NX) + IF(VOLX(L,NY,NX).GT.ZEROS(NY,NX) + 2.AND.RTDNP(N,L,NZ,NY,NX).GT.ZERO + 3.AND.RTVLW(N,L,NZ,NY,NX).GT.ZEROP(NZ,NY,NX) + 4.AND.THETW(L,NY,NX).GT.ZERO)THEN TFOXYX=0.0 TFNH4X=0.0 TFNHBX=0.0 @@ -830,9 +840,6 @@ SUBROUTINE uptake(I,J,NHW,NHE,NVN,NVS) FZUP=0.0 FPUP=0.0 ENDIF - IF(RTDNP(N,L,NZ,NY,NX).GT.ZERO - 2.AND.RTVLW(N,L,NZ,NY,NX).GT.ZEROP(NZ,NY,NX) - 3.AND.THETW(L,NY,NX).GT.ZERO)THEN C NN=0 UPWTRP=AMAX1(0.0,-UPWTR(N,L,NZ,NY,NX)/PP(NZ,NY,NX)) UPWTRH=UPWTRP*XNPG @@ -1023,7 +1030,7 @@ SUBROUTINE uptake(I,J,NHW,NHE,NVN,NVS) DFNHA=0.0 DFHGA=0.0 ENDIF - DFGP=AMIN1(1.0,XNPD*SQRT(PORT(N,NZ,NY,NX)))*TFND(L,NY,NX) + DFGP=AMIN1(1.0,XNPD*SQRT(PORT(N,NZ,NY,NX))*TFND(L,NY,NX)) RCO2PX=-RCO2A(N,L,NZ,NY,NX)*XNPG C C SOLVE FOR GAS EXCHANGE IN SOIL AND ROOTS DURING ROOT UPTAKE @@ -1142,13 +1149,13 @@ SUBROUTINE uptake(I,J,NHW,NHE,NVN,NVS) C BETWEEN ROOT AND SOIL, CONSTRAINED BY COMPETITION C WITH OTHER ROOT AND MICROBIAL POPULATIONS C -C IF(NX.EQ.3.AND.NY.EQ.3)THEN +C IF(IYRC.EQ.2000.AND.I.LE.180)THEN C WRITE(*,5555)'COXYR',I,J,NX,NY,NZ,L,N,M,MX,COXYR,RUPOXR C 2,RMFOXS,RDFOXS,RDFOXP,COXYS1,COXYS1-COXYR,COXYP1,FOXYX C 3,WTRTG(L),DIFOL,DIFOP,THETM,OLSGL1,UPWTRH,RTARR(N,L) C 5,RTARSX,UPMXP,THETW(L,NY,NX),OXYS1,OXYS(L,NY,NX),OXYP1 C 3,OXYP(N,L,NZ,NY,NX),ROXYY(L,NY,NX),RTLGP(N,L,NZ,NY,NX) -C 2,UPMXP,DIFOX,THETW1,THETM,RRADS,RTARX,FPQ(L,NZ) +C 2,UPMXP,DIFOX,THETW1,THETM,RRADS,FPQ(L,NZ) C 4,RUPOXS(N,L,NZ,NY,NX),RUPOXP(N,L,NZ,NY,NX) C 5,COXYE(NY,NX),SOXYL(L,NY,NX),FRTDPX(L,NZ) 5555 FORMAT(A8,9I4,40E12.4) @@ -1285,17 +1292,6 @@ SUBROUTINE uptake(I,J,NHW,NHE,NVN,NVS) ZH3S1=ZH3S1+RNHDFQ-RUPNSX ZH3B1=ZH3B1+RNBDFQ-RUPNBX H2GS1=H2GS1+RHGDFQ-RUPHGX -C IF(L.EQ.1)THEN -C WRITE(*,5547)'CO2S1',I,J,NX,NY,NZ,L,N,M,MX,CO2S1,RCODFQ,RCO2SX -C 2,RDXCOS,RDFCOS,PP(NZ,NY,NX),RTVLW(N,L,NZ,NY,NX),VOLWMM,CO2P1 -C 3,CO2G1,RCO2FX,CCO2S1,CCO2P1,THETPM(M,L,NY,NX) -C 4,THETX,RCO2S(N,L,NZ,NY,NX) -C ENDIF -C IF(NZ.EQ.1.OR.NZ.EQ.4)THEN -C WRITE(*,5547)'OXYG1',I,J,NX,NY,NZ,L,N,M,MX,OXYG1,OXYS1 -C 2,ROXDFQ,ROXYFX,ROXYLX,RUPOSX -5547 FORMAT(A8,9I4,20E12.4) -C ENDIF C C GAS TRANSFER THROUGH ROOTS C @@ -1394,7 +1390,13 @@ SUBROUTINE uptake(I,J,NHW,NHE,NVN,NVS) RCO2P(N,L,NZ,NY,NX)=RCO2P(N,L,NZ,NY,NX)+RCO2PX+RCO2SX RUPOXP(N,L,NZ,NY,NX)=RUPOXP(N,L,NZ,NY,NX)+RUPOPX ROXSK(M,L,NY,NX)=ROXSK(M,L,NY,NX)+RUPOSX -C IF(NX.EQ.3.AND.NY.EQ.3)THEN +C IF(I.EQ.105)THEN +C WRITE(*,5566)'CO2P1',I,J,NX,NY,NZ,L,N,M,MX,RCO2SX +C 2,RCO2S(N,L,NZ,NY,NX),RDFCOS,RDXCOS,RMFCOS,DIFCL +C 3,CCO2S1,CCO2P1,RTVLW(N,L,NZ,NY,NX),CO2S1,VOLWMM +C 4,CO2P1,VOLWSP,PP(NZ,NY,NX),FPQ(L,NZ),RCODF1,RCO2PX +C 5,CO2PX,RTVLP(N,L,NZ,NY,NX),DFGP,VOLWCA,CO2A1 +C 6,XNPD,PORT(N,NZ,NY,NX),TFND(L,NY,NX) C WRITE(*,5566)'OXYP1',I,J,NX,NY,NZ,L,N,M,MX,UPMXP*PP(NZ,NY,NX) C 2,RUPOSX,ROXDFQ,OXYS1,RUPOPX,ROXDF1,OXYP1 C 3,FOXYX,DFGS(M,L,NY,NX),DFGP,ROXYFX,ROXYLX,ROXFL1 @@ -1422,7 +1424,7 @@ SUBROUTINE uptake(I,J,NHW,NHE,NVN,NVS) C WRITE(*,3368)'WFR',I,J,NX,NY,NZ,L,N,WFR(N,L,NZ,NY,NX) C 2,RUPOXP(N,L,NZ,NY,NX),RUPOXS(N,L,NZ,NY,NX) C 3,ROXYP(N,L,NZ,NY,NX) -3368 FORMAT(A8,7I4,12E24.16) +3368 FORMAT(A8,7I4,12E12.4) C ENDIF ELSE RUPOXT=0.0 @@ -1440,7 +1442,7 @@ SUBROUTINE uptake(I,J,NHW,NHE,NVN,NVS) C DO 195 K=0,4 VOLWK=VOLWM(NPH,L,NY,NX)*FOSRH(K,L,NY,NX) - IF(VOLWK.GT.ZEROS(NY,NX) + IF(VOLWK.GT.ZEROS2(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)) diff --git a/f77src/visual.f b/f77src/visual.f old mode 100755 new mode 100644 diff --git a/f77src/watsub.f b/f77src/watsub.f old mode 100755 new mode 100644 index c6889e2..d24edfe --- a/f77src/watsub.f +++ b/f77src/watsub.f @@ -28,19 +28,19 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) DIMENSION VOLWX1(JZ,JY,JX) 2,TVOL1(JY,JX),TVOLW(JY,JX),FMAC(JZ,JY,JX),FGRD(JZ,JY,JX) 3,VOLW1(0:JZ,JY,JX),VOLI1(0:JZ,JY,JX),VOLPX1(JZ,JY,JX) - 4,VHCP1(JZ,JY,JX),TK1(0:JZ,JY,JX),TWFLXL(JZ,JY,JX),TTFLXL(JZ,JY,JX) + 4,VHCP1(0:JZ,JY,JX),TK1(0:JZ,JY,JX),TWFLXL(JZ,JY,JX) 5,VOLP1(0:JZ,JY,JX),WGSG1(JZ,JY,JX),TWFLXH(JZ,JY,JX) 6,VOLS0(JY,JX),VOLI0(JY,JX),VOLW0(JY,JX),VOLS1(JY,JX) 7,DPTHS0(JY,JX),VHCP0(JY,JX),TK0(JY,JX),AREAU(JZ,JY,JX) 8,FLQ0S(JY,JX),FLQ0W(JY,JX),FLQ1(JY,JX),FLH1(JY,JX) 9,FLY1(JY,JX),HWFLQ0(JY,JX),HWFLQ1(JY,JX),HWFLY1(JY,JX) 1,RAR(JY,JX),RAGS(JY,JX),WGSG0(JY,JX),WRP(0:JZ,JY,JX),RARG(JY,JX) - 2,RAGR(JY,JX),RAGW(JY,JX),BARE(JY,JX),CVRD(JY,JX),PAREG(JY,JX) + 2,RAGR(JY,JX),RAGW(JY,JX),PAREG(JY,JX) 3,RAG(JY,JX),PARSG(JY,JX),PARER(JY,JX),PARSR(JY,JX),WGSGR0(JY,JX) - 4,VPQ(JY,JX),TKQ(JY,JX),VHCPR1(JY,JX),QR1(2,JV,JH),HQR1(2,JV,JH) + 4,VPQ(JY,JX),TKQ(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) + 7,TQI1(JY,JX),THQS1(JY,JX),EVAP(JY,JX),TTFLXL(JZ,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) @@ -56,7 +56,8 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) 6,TFLXR(JY,JX),HCNDR(JY,JX),CNDH1(JZ,JY,JX) 7,THETWX(0:JZ,JY,JX),THETIX(0:JZ,JY,JX),THETPX(0:JZ,JY,JX) 8,VOLAH1(JZ,JY,JX),VOLWH1(JZ,JY,JX),VOLPH1(JZ,JY,JX) - 9,VOLIH1(JZ,JY,JX),THETPY(0:JZ,JY,JX) + 9,VOLIH1(JZ,JY,JX),THETPY(0:JZ,JY,JX),FLWNX(JY,JX) + 1,FLWXNX(JY,JX),FLWHNX(JY,JX),HFLWNX(JY,JX),N6X(JY,JX) PARAMETER (EMMS=0.98,EMMW=0.98,EMMR=0.98 2,RACX=0.0278,RARX=0.0139,RZ=0.0278,RZR=0.0278,RZW=0.0278 3,RAM=1.39E-03,HYSTK=1.00,FQS=1.0E-00,DPTHSX=0.05,FPSISR=-4.0) @@ -69,8 +70,7 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) 5,DNUSW=(1.0+(0.492/PRNTW)**0.5625)**0.4444 6,DNUSA=(1.0+(0.492/PRNTA)**0.5625)**0.4444 7,TRBW=0.375,TRBA=0.000) - PARAMETER (NPR=10,XNPR=1.0/NPR,FHFLX=0.67 - 2,FVOLAH=0.0,PSISX=-0.5,PSISXR=-0.5 + PARAMETER (FHFLX=1.0,FVOLAH=0.0,PSISX=-0.5,PSISXR=-0.5 3,DTHETW=1.0E-06,HCNDRR=25.0) REAL*4 RI,THETWR,THETW1,THETA1,THETAL,THETWL 2,TKR1,TKS1,TKY,TKW1,TK11,TK12,TK0X,TKXR,TK1X,TKX1,TFND1 @@ -84,11 +84,11 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) C XNPHR=XNPH*XNPR HYSTX=HYSTK + NUM(NY,NX)=NU(NY,NX) C C ADJUST SURFACE ELEVATION USED IN RUNOFF FOR EROSION C - ALTG(NY,NX)=ALT(NY,NX)-CDPTH(NU(NY,NX),NY,NX) - 2+DLYR(3,NU(NY,NX),NY,NX) + ALTG(NY,NX)=ALT(NY,NX)-CDPTH(NUM(NY,NX)-1,NY,NX) C C ENTER STATE VARIABLES AND DRIVERS INTO LOCAL ARRAYS C FOR USE AT INTERNAL TIME STEP @@ -102,7 +102,7 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) TK0(NY,NX)=TKW(NY,NX) WFLXR(NY,NX)=0.0 TFLXR(NY,NX)=0.0 - DO 65 L=NU(NY,NX),NL(NY,NX) + DO 65 L=NUM(NY,NX),NL(NY,NX) IF(CDPTH(L,NY,NX).GE.WDPTH(I,NY,NX))THEN LWDPTH=L GO TO 55 @@ -112,7 +112,7 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) C C SET INITIAL SOIL VALUES C - DO 30 L=NU(NY,NX),NL(NY,NX) + DO 30 L=NUM(NY,NX),NL(NY,NX) C C ENTER STATE VARIABLES AND DRIVERS INTO LOCAL ARRAYS C FOR USE AT INTERNAL TIME STEP @@ -123,32 +123,46 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) VOLI1(L,NY,NX)=VOLI(L,NY,NX) VOLWH1(L,NY,NX)=VOLWH(L,NY,NX) VOLIH1(L,NY,NX)=VOLIH(L,NY,NX) + IF(BKDS(L,NY,NX).GT.ZERO)THEN VOLP1(L,NY,NX)=AMAX1(0.0,VOLA(L,NY,NX)-VOLW1(L,NY,NX) 2-VOLI1(L,NY,NX)) + ELSE + VOLP1(L,NY,NX)=0.0 + ENDIF VOLAH1(L,NY,NX)=AMAX1(0.0,VOLAH(L,NY,NX)-FVOLAH*CCLAY(L,NY,NX) 2*(VOLW1(L,NY,NX)/VOLX(L,NY,NX)-WP(L,NY,NX))*VOLT(L,NY,NX)) + IF(BKDS(L,NY,NX).GT.ZERO)THEN VOLPH1(L,NY,NX)=AMAX1(0.0,VOLAH1(L,NY,NX)-VOLWH1(L,NY,NX) 2-VOLIH1(L,NY,NX)) + ELSE + VOLPH1(L,NY,NX)=0.0 + ENDIF VOLPX1(L,NY,NX)=VOLP1(L,NY,NX)*HYST(L,NY,NX) VOLWM(1,L,NY,NX)=VOLW1(L,NY,NX) VOLWHM(1,L,NY,NX)=VOLWH1(L,NY,NX) VOLPM(1,L,NY,NX)=VOLP1(L,NY,NX)+VOLPH1(L,NY,NX) 2+THETPI*(VOLI1(L,NY,NX)+VOLIH1(L,NY,NX)) + IF(VOLT(L,NY,NX).GT.ZEROS(NY,NX))THEN THETWX(L,NY,NX)=AMAX1(0.0,(VOLW1(L,NY,NX)+VOLWH1(L,NY,NX)) 2/VOLT(L,NY,NX)) THETIX(L,NY,NX)=AMAX1(0.0,(VOLI1(L,NY,NX)+VOLIH1(L,NY,NX)) 2/VOLT(L,NY,NX)) THETPX(L,NY,NX)=AMAX1(0.0,(VOLP1(L,NY,NX)+VOLPH1(L,NY,NX)) 2/VOLT(L,NY,NX)) + ELSE + THETWX(L,NY,NX)=0.0 + THETIX(L,NY,NX)=0.0 + THETPX(L,NY,NX)=0.0 + ENDIF THETPM(1,L,NY,NX)=THETPX(L,NY,NX) - VHCP1(L,NY,NX)=VHCM(L,NY,NX)+4.19*(VOLW1(L,NY,NX) - 2+VOLWH1(L,NY,NX))+1.9274*(VOLI1(L,NY,NX)+VOLIH1(L,NY,NX)) IF(VOLA(L,NY,NX)+VOLAH(L,NY,NX).GT.ZEROS(NY,NX))THEN THETPY(L,NY,NX)=AMAX1(0.0,(VOLP1(L,NY,NX)+VOLPH1(L,NY,NX)) 2/(VOLA(L,NY,NX)+VOLAH(L,NY,NX))) ELSE THETPY(L,NY,NX)=0.0 ENDIF + VHCP1(L,NY,NX)=VHCM(L,NY,NX)+4.19*(VOLW1(L,NY,NX) + 2+VOLWH1(L,NY,NX))+1.9274*(VOLI1(L,NY,NX)+VOLIH1(L,NY,NX)) C C MACROPOROSITY C @@ -190,7 +204,7 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) C C INITIALIZE SNOW AND SOIL-RESIDUE THERMAL CONDUCTIVITIES C - VHCPR1(NY,NX)=2.496E-06*ORGC(0,NY,NX)+4.19*VOLW(0,NY,NX) + VHCP1(0,NY,NX)=2.496E-06*ORGC(0,NY,NX)+4.19*VOLW(0,NY,NX) 2+1.9274*VOLI(0,NY,NX) VOLW1(0,NY,NX)=AMAX1(0.0,VOLW(0,NY,NX)) VOLI1(0,NY,NX)=AMAX1(0.0,VOLI(0,NY,NX)) @@ -201,6 +215,7 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) TVOL1(NY,NX)=AMAX1(0.0,VOLW1(0,NY,NX)+VOLI1(0,NY,NX) 2-VOLWRX(NY,NX)) TVOLW(NY,NX)=AMAX1(0.0,VOLW1(0,NY,NX)-VOLWRX(NY,NX)) + TVOLG(NY,NX)=AMAX1(0.0,TVOLW(NY,NX)-VHCPRX(NY,NX)/4.19) VOLGM(1,NY,NX)=AMAX1(0.0,TVOL1(NY,NX)) IF(VOLR(NY,NX).GT.ZEROS(NY,NX))THEN THETWX(0,NY,NX)=AMAX1(0.0,VOLW1(0,NY,NX)/VOLR(NY,NX)) @@ -216,23 +231,25 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) 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 2,VOLI1(0,NY,NX),VOLP1(0,NY,NX),THETWX(0,NY,NX) C 3,THETIX(0,NY,NX),THETPX(0,NY,NX),TVOL1(NY,NX),VOLWD(NY,NX) C 4,VOLWG(NY,NX),ZS(NY,NX) 7751 FORMAT(A8,4I4,20E12.4) C C RESIDUE COVERAGE OF SOIL SURFACE C - IF(BKDS(NU(NY,NX),NY,NX).GT.ZERO)THEN - BARE(NY,NX)=AMAX1(0.0,EXP(-0.8E-02*(TRC0(NY,NX) - 2/AREA(3,0,NY,NX)))-AMIN1(1.0,TVOLW(NY,NX)/VOLWG(NY,NX))) - ELSE - BARE(NY,NX)=0.0 - ENDIF + BARE(NY,NX)=AMAX1(0.0,AMIN1(1.0,AMAX1(0.0,EXP(-0.8E-02 + 2*(TRC0(NY,NX)/AREA(3,0,NY,NX)))) + 2-AMIN1(1.0,AMAX1(0.0,TVOLG(NY,NX)/VOLWG(NY,NX))))) CVRD(NY,NX)=1.0-BARE(NY,NX) PRECD(NY,NX)=PRECA(NY,NX)*FRADG(NY,NX)*BARE(NY,NX) PRECB(NY,NX)=(PRECA(NY,NX)-PRECD(NY,NX) 2-TFLWC(NY,NX))*BARE(NY,NX) +C IF(J.EQ.12)THEN +C WRITE(*,3112)'BARE',I,J,NX,NY,BARE(NY,NX) +C 2,TRC0(NY,NX)/AREA(3,0,NY,NX),TVOLG(NY,NX),VOLWG(NY,NX) +3112 FORMAT(A8,4I4,12E12.4) +C ENDIF C C VARIABLES TO TRANSFER SNOWPACK INTO SOIL SURFACE AT FINAL MELT C @@ -271,8 +288,8 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) HFLWQR=4.19*TKW(NY,NX)*FLWQR FLWQG=WMELT-FLWQR HFLWQG=4.19*TKW(NY,NX)*FLWQG - FLWQGS=FLWQG*FGRD(NU(NY,NX),NY,NX) - FLWQGH=FLWQG*FMAC(NU(NY,NX),NY,NX) + FLWQGS=FLWQG*FGRD(NUM(NY,NX),NY,NX) + FLWQGH=FLWQG*FMAC(NUM(NY,NX),NY,NX) ELSE WMELT=0.0 FLWQR=0.0 @@ -307,8 +324,8 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) HFLWQB=4.19*TKA(NY,NX)*FLWQBX FLWQAX=PRECA(NY,NX)-TFLWC(NY,NX)-FLWQBX HFLWQA=4.19*TKA(NY,NX)*FLWQAX - FLWQAS=FLWQAX*FGRD(NU(NY,NX),NY,NX) - FLWQAH=FLWQAX*FMAC(NU(NY,NX),NY,NX) + FLWQAS=FLWQAX*FGRD(NUM(NY,NX),NY,NX) + FLWQAH=FLWQAX*FMAC(NUM(NY,NX),NY,NX) ENDIF ELSE IF(VHCPW(NY,NX).GT.VHCPWX(NY,NX))THEN @@ -329,8 +346,8 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) HFLWQB=4.19*TKA(NY,NX)*FLWQBX FLWQAX=-TFLWC(NY,NX)-FLWQBX HFLWQA=4.19*TKA(NY,NX)*FLWQAX - FLWQAS=FLWQAX*FGRD(NU(NY,NX),NY,NX) - FLWQAH=FLWQAX*FMAC(NU(NY,NX),NY,NX) + FLWQAS=FLWQAX*FGRD(NUM(NY,NX),NY,NX) + FLWQAH=FLWQAX*FMAC(NUM(NY,NX),NY,NX) ENDIF ENDIF C @@ -382,7 +399,7 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) C 2,PSISM1(0,NY,NX),PSISM(0,NY,NX) C 2,FLQ1(NY,NX),FLH1(NY,NX),FLWQBX,FLWQR C 2,FLWQAS,FLWQGS,FLWZ,FLWQAH,FLWQGH -C 3,FGRD(NU(NY,NX),NY,NX),FMAC(NU(NY,NX),NY,NX) +C 3,FGRD(NUM(NY,NX),NY,NX),FMAC(NUM(NY,NX),NY,NX) C 4,FHOL(L,NY,NX),VOLAH1(L,NY,NX),VOLAH(L,NY,NX) C 5,FLWQAX,PRECA(NY,NX),TFLWC(NY,NX),FLWQBX,CVRD(NY,NX) C 6,BARE(NY,NX),TRC0(NY,NX),TVOLW(NY,NX),VOLWG(NY,NX) @@ -399,10 +416,10 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) THRYW(NY,NX)=(THS(NY,NX)*FRADG(NY,NX)+THRMCX(NY,NX))*XNPH THRYG(NY,NX)=THRYW(NY,NX)*BARE(NY,NX) THRYR(NY,NX)=THRYW(NY,NX)*CVRD(NY,NX)*XNPR - THRMW(NY,NX)=EMMW*2.04E-10*AREA(3,NU(NY,NX),NY,NX)*XNPH - THRMS(NY,NX)=EMMS*2.04E-10*AREA(3,NU(NY,NX),NY,NX)*XNPH + THRMW(NY,NX)=EMMW*2.04E-10*AREA(3,NUM(NY,NX),NY,NX)*XNPH + THRMS(NY,NX)=EMMS*2.04E-10*AREA(3,NUM(NY,NX),NY,NX)*XNPH 2*BARE(NY,NX) - THRMR(NY,NX)=EMMR*2.04E-10*AREA(3,NU(NY,NX),NY,NX)*XNPHR + THRMR(NY,NX)=EMMR*2.04E-10*AREA(3,NUM(NY,NX),NY,NX)*XNPHR 2*CVRD(NY,NX) C C AERODYNAMIC RESISTANCE OF CANOPY TO SNOW/RESIDUE/SOIL @@ -420,9 +437,9 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) UAG=UA(NY,NX) ENDIF VPQ(NY,NX)=VPA(NY,NX)-1.0*TLEX(NY,NX) - 2/(VAP*AREA(3,NU(NY,NX),NY,NX)) + 2/(VAP*AREA(3,NUM(NY,NX),NY,NX)) TKQ(NY,NX)=TKA(NY,NX)-1.0*TSHX(NY,NX) - 2/(1.25E-03*AREA(3,NU(NY,NX),NY,NX)) + 2/(1.25E-03*AREA(3,NUM(NY,NX),NY,NX)) C C AERODYNAMIC RESISTANCE OF RESIDUE AND SOIL C SURFACE TO ENERGY EXCHANGE WITH ATMOSPHERE @@ -430,7 +447,7 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) C WGSG0(NY,NX)=WGSGW(NY,NX)*XNPH WGSGR0(NY,NX)=WGSGR(NY,NX)*XNPH - DO 25 L=NU(NY,NX),NL(NY,NX) + DO 25 L=NUM(NY,NX),NL(NY,NX) IF(POROS(L,NY,NX).GT.0.0)THEN WFPS=THETW(L,NY,NX)/POROS(L,NY,NX) ELSE @@ -445,23 +462,29 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) 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 +C IF(VOLR(NY,NX).GT.ZEROS(NY,NX) +C 2.AND.VHCP1(0,NY,NX).GT.VHCPRX(NY,NX))THEN + RAR1=RAR(NY,NX)/AMAX1(THETX,THETPX(0,NY,NX))**2.33*CVRD(NY,NX) +C ELSE +C RAR1=0.0 +C ENDIF RAGS(NY,NX)=RAG(NY,NX)+RAR1 - PARR(NY,NX)=AREA(3,NU(NY,NX),NY,NX)*XNPH/RAGR(NY,NX) - PARG(NY,NX)=AREA(3,NU(NY,NX),NY,NX)*XNPH/RAGS(NY,NX) - PAREG(NY,NX)=AREA(3,NU(NY,NX),NY,NX)*XNPH + PARR(NY,NX)=AREA(3,NUM(NY,NX),NY,NX)*XNPH/RAGR(NY,NX) + PARG(NY,NX)=AREA(3,NUM(NY,NX),NY,NX)*XNPH/RAGS(NY,NX) + PAREG(NY,NX)=AREA(3,NUM(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 + PARSG(NY,NX)=1.25E-03*AREA(3,NUM(NY,NX),NY,NX)*XNPH PARSR(NY,NX)=PARSG(NY,NX)*XNPR*CVRD(NY,NX) -C IF(J.EQ.24)THEN +C IF(I.EQ.153)THEN C WRITE(*,3111)'RAC',I,J,ALFZ,RAC(NY,NX),ZT(NY,NX),RAB(NY,NX) C 2,RAR(NY,NX),RAR1,PARG(NY,NX),PARR(NY,NX) C 3,DLYRR(NY,NX),RAG(NY,NX),RAGS(NY,NX),RAGR(NY,NX) C 4,THETPX(0,NY,NX),WGSGR(NY,NX),VOLW1(0,NY,NX) C 5,VOLI1(0,NY,NX),VOLP1(0,NY,NX),VOLR(NY,NX),VOLA(0,NY,NX) C 4,TLEX(NY,NX),TSHX(NY,NX),RADG(NY,NX),THS(NY,NX) -C 5,FRADG(NY,NX),THRMCX(NY,NX),ZS(NY,NX) -3111 FORMAT(A8,2I4,30E12.4) +C 5,FRADG(NY,NX),THRMCX(NY,NX),ZS(NY,NX),BARE(NY,NX) +C 6,TVOLW(NY,NX),VHCPRX(NY,NX)/4.19,VOLWD(NY,NX),TRC0(NY,NX) +3111 FORMAT(A8,2I4,40E12.4) C ENDIF 9990 CONTINUE 9995 CONTINUE @@ -471,11 +494,8 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) C DO 9985 NX=NHW,NHE DO 9980 NY=NVN,NVS - DO 35 L=NU(NY,NX),NL(NY,NX) + DO 35 L=NUM(NY,NX),NL(NY,NX) DO 40 N=NCN(NY,NX),3 - TFLXL(N,L,NY,NX)=0.0 - WFLXL(N,L,NY,NX)=0.0 - WFLXLH(N,L,NY,NX)=0.0 N1=NX N2=NY N3=L @@ -559,7 +579,7 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) THETWT=0.0 ENDIF TORT(M,0,NY,NX)=0.7*THETWT**2 - DO 9885 L=NU(NY,NX),NL(NY,NX) + DO 9885 L=NUM(NY,NX),NL(NY,NX) TWFLXL(L,NY,NX)=0.0 TWFLXH(L,NY,NX)=0.0 TTFLXL(L,NY,NX)=0.0 @@ -587,13 +607,17 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) ELSE DFGS(M,L,NY,NX)=0.0 ENDIF -C IF(L.EQ.NU(NY,NX))THEN +C IF(L.EQ.NUM(NY,NX))THEN C WRITE(*,3377)'DFGS',I,J,M,NX,NY,L,DFGS(M+1,L,NY,NX) C 2,XNPD,TFACL,Z1S,Z2S,THETWA,Z3S,Z2S*(THETWA-Z3S) C 3,EXP(Z2S*(THETWA-Z3S)),Z1S**-1 C 4,(Z1S**-1)*EXP(Z2S*(THETWA-Z3S)) + IF(BKDS(L,NY,NX).GT.ZEROS(NY,NX))THEN 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)) + ELSE + TORT(M,L,NY,NX)=0.7 + ENDIF 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) @@ -610,8 +634,8 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) HFLWR1=4.19*TKA(NY,NX)*FLWR1 FLYM=FLY1(NY,NX)-FLWR1 HWFLYM=HWFLY1(NY,NX)-HFLWR1 - FLQM=FLQ1(NY,NX)+FLWR1*FGRD(NU(NY,NX),NY,NX) - FLHM=FLH1(NY,NX)+FLWR1*FMAC(NU(NY,NX),NY,NX) + FLQM=FLQ1(NY,NX)+FLWR1*FGRD(NUM(NY,NX),NY,NX) + FLHM=FLH1(NY,NX)+FLWR1*FMAC(NUM(NY,NX),NY,NX) HWFLQM=HWFLQ1(NY,NX)+HFLWR1 C C REDISTRIBUTE SURFACE WATER FROM WATER REPELLANCY @@ -620,10 +644,10 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) C HFLWPR=4.19*TKA(NY,NX)*FLWPR C FLYM=FLYM-FLWPR C HWFLYM=HWFLYM-HFLWPR -C FLQM=FLQM+FLWPR*FGRD(NU(NY,NX),NY,NX) -C FLHM=FLHM+FLWPR*FMAC(NU(NY,NX),NY,NX) +C FLQM=FLQM+FLWPR*FGRD(NUM(NY,NX),NY,NX) +C FLHM=FLHM+FLWPR*FMAC(NUM(NY,NX),NY,NX) C HWFLQM=HWFLQM+HFLWPR -C FLWP1=FLQM*(1.0-WRP(NU(NY,NX),NY,NX)) +C FLWP1=FLQM*(1.0-WRP(NUM(NY,NX),NY,NX)) C FLQM=FLQM-FLWP1 C FLHM=FLHM+FLWP1 FLYM2=FLYM*XNPR @@ -632,13 +656,13 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) C WRITE(*,3132)'FLWR1',I,J,M,NX,NY,FLY1(NY,NX),FLQ1(NY,NX) C 2,VHCP0(NY,NX),VHCPWX(NY,NX) C 2,FLH1(NY,NX),FLYM,FLQM,FLHM,VOLWRM,FLWR1 -C 3,FMAC(NU(NY,NX),NY,NX),FGRD(NU(NY,NX),NY,NX) -C 5,VOLAH(NU(NY,NX),NY,NX),FVOLAH,CCLAY(NU(NY,NX),NY,NX) -C 4,VOLW1(NU(NY,NX),NY,NX),VOLX(NU(NY,NX),NY,NX),WP(L,NY,NX) -C 2,VOLT(NU(NY,NX),NY,NX),VOLAH1(NU(NY,NX),NY,NX) +C 3,FMAC(NUM(NY,NX),NY,NX),FGRD(NUM(NY,NX),NY,NX) +C 5,VOLAH(NUM(NY,NX),NY,NX),FVOLAH,CCLAY(NUM(NY,NX),NY,NX) +C 4,VOLW1(NUM(NY,NX),NY,NX),VOLX(NUM(NY,NX),NY,NX),WP(L,NY,NX) +C 2,VOLT(NUM(NY,NX),NY,NX),VOLAH1(NUM(NY,NX),NY,NX) C 5,VOLWRX(NY,NX),VOLW1(0,NY,NX),VOLI1(0,NY,NX) -C 6,WRP(0,NY,NX),WRP(NU(NY,NX),NY,NX),PSISM1(0,NY,NX) -C 7,PSISM1(NU(NY,NX),NY,NX) +C 6,WRP(0,NY,NX),WRP(NUM(NY,NX),NY,NX),PSISM1(0,NY,NX) +C 7,PSISM1(NUM(NY,NX),NY,NX) 3132 FORMAT(A8,5I4,40E12.4) C ENDIF C @@ -651,29 +675,29 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) C SOIL SURFACE USED IN FLUX CALCULATIONS C DENSS=AMIN1(0.6,DENS0(NY,NX)+DENS1(NY,NX)*VOLS0(NY,NX) - 2/AREA(3,NU(NY,NX),NY,NX)) + 2/AREA(3,NUM(NY,NX),NY,NX)) VOLS1(NY,NX)=VOLS0(NY,NX)/DENSS+VOLW0(NY,NX)+VOLI0(NY,NX) - DPTHS0(NY,NX)=VOLS1(NY,NX)/AREA(3,NU(NY,NX),NY,NX) + DPTHS0(NY,NX)=VOLS1(NY,NX)/AREA(3,NUM(NY,NX),NY,NX) THETP0=AMAX1(THETPI,1.0-(VOLS0(NY,NX)+VOLI0(NY,NX) 2+VOLW0(NY,NX))/VOLS1(NY,NX)) - THETW1=AMAX1(THETY(NU(NY,NX),NY,NX),AMIN1(POROS(NU(NY,NX),NY,NX) - 2,VOLW1(NU(NY,NX),NY,NX)/VOLX(NU(NY,NX),NY,NX))) -C IF(BKVL(NU(NY,NX),NY,NX).GT.0.0)THEN - IF(THETW1.LT.FC(NU(NY,NX),NY,NX))THEN - PSISM1(NU(NY,NX),NY,NX)=AMAX1(PSIHY,-EXP(PSIMX(NY,NX) - 2+((FCL(NU(NY,NX),NY,NX)-LOG(THETW1)) - 3/FCD(NU(NY,NX),NY,NX)*PSIMD(NY,NX)))) - ELSEIF(THETW1.LT.POROS(NU(NY,NX),NY,NX)-DTHETW)THEN - PSISM1(NU(NY,NX),NY,NX)=-EXP(PSIMS(NY,NX) - 2+(((PSL(NU(NY,NX),NY,NX)-LOG(THETW1)) - 3/PSD(NU(NY,NX),NY,NX))**SRP(NU(NY,NX),NY,NX)*PSISD(NY,NX))) - ELSE - PSISM1(NU(NY,NX),NY,NX)=PSISE(NU(NY,NX),NY,NX) + THETW1=AMAX1(THETY(NUM(NY,NX),NY,NX),AMIN1(POROS(NUM(NY,NX),NY,NX) + 2,VOLW1(NUM(NY,NX),NY,NX)/VOLXI(NUM(NY,NX),NY,NX))) + IF(BKVL(NUM(NY,NX),NY,NX).GT.0.0)THEN + IF(THETW1.LT.FC(NUM(NY,NX),NY,NX))THEN + PSISM1(NUM(NY,NX),NY,NX)=AMAX1(PSIHY,-EXP(PSIMX(NY,NX) + 2+((FCL(NUM(NY,NX),NY,NX)-LOG(THETW1)) + 3/FCD(NUM(NY,NX),NY,NX)*PSIMD(NY,NX)))) + ELSEIF(THETW1.LT.POROS(NUM(NY,NX),NY,NX)-DTHETW)THEN + PSISM1(NUM(NY,NX),NY,NX)=-EXP(PSIMS(NY,NX) + 2+(((PSL(NUM(NY,NX),NY,NX)-LOG(THETW1)) + 3/PSD(NUM(NY,NX),NY,NX))**SRP(NUM(NY,NX),NY,NX)*PSISD(NY,NX))) + ELSE + PSISM1(NUM(NY,NX),NY,NX)=PSISE(NUM(NY,NX),NY,NX) ENDIF -C ELSE -C PSISM1(NU(NY,NX),NY,NX)=PSISE(NU(NY,NX),NY,NX) -C ENDIF - PSISV1=PSISM1(NU(NY,NX),NY,NX)+PSISO(NU(NY,NX),NY,NX) + ELSE + PSISM1(NUM(NY,NX),NY,NX)=PSISE(NUM(NY,NX),NY,NX) + ENDIF + PSISV1=PSISM1(NUM(NY,NX),NY,NX)+PSISO(NUM(NY,NX),NY,NX) C C SNOWPACK ALBEDO, NET RADIATION C @@ -699,7 +723,7 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) PARE=PAREG(NY,NX)/(RA+RZW) PARS=PARSG(NY,NX)/RA TKW1=TK0(NY,NX) - TK11=TK1(NU(NY,NX),NY,NX) + TK11=TK1(NUM(NY,NX),NY,NX) VP0=2.173E-03/TKW1 2*0.61*EXP(5360.0*(3.661E-03-1.0/TKW1)) VP1=2.173E-03/TK11 @@ -720,40 +744,41 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) C BALANCE OCCURS, SOLVE LATENT, SENSIBLE AND STORAGE HEAT FLUXES C SFLX=PARS*(TKQ(NY,NX)-TK0(NY,NX)) - HFLW0=RFLX+EFLX+SFLX+VFLX + HFLX0=RFLX+EFLX+SFLX + HFLW0=HFLX0+VFLX C C VAPOR PRESSURES AND CONDUCTIVITY BETWEEN SNOWPACK C AND SOIL SURFACE C CNV0=THETP0**1.33*WGSG0(NY,NX) - CNV1=THETPX(NU(NY,NX),NY,NX)**2/POROQ(NU(NY,NX),NY,NX) - 2*WGSG1(NU(NY,NX),NY,NX) + CNV1=THETPX(NUM(NY,NX),NY,NX)**2/POROQ(NUM(NY,NX),NY,NX) + 2*WGSG1(NUM(NY,NX),NY,NX) IF(CNV0.GT.ZERO.AND.CNV1.GT.ZERO)THEN AVCNV1=2.0*CNV0*CNV1 - 2/(CNV0*DLYR(3,NU(NY,NX),NY,NX)+CNV1*DPTHS0(NY,NX)) + 2/(CNV0*DLYR(3,NUM(NY,NX),NY,NX)+CNV1*DPTHS0(NY,NX)) ELSE AVCNV1=2.0*CNV0 - 2/(DLYR(3,NU(NY,NX),NY,NX)+DPTHS0(NY,NX)) + 2/(DLYR(3,NUM(NY,NX),NY,NX)+DPTHS0(NY,NX)) ENDIF C C HEAT AND VAPOR FLUXES BETWEEN SNOWPACK AND SOIL SURFACE C - TKY=(TK0(NY,NX)*VHCP0(NY,NX)+TK1(NU(NY,NX),NY,NX) - 2*VHCP1(NU(NY,NX),NY,NX))/(VHCP0(NY,NX)+VHCP1(NU(NY,NX),NY,NX)) + TKY=(TK0(NY,NX)*VHCP0(NY,NX)+TK1(NUM(NY,NX),NY,NX) + 2*VHCP1(NUM(NY,NX),NY,NX))/(VHCP0(NY,NX)+VHCP1(NUM(NY,NX),NY,NX)) HFLWX=(TK0(NY,NX)-TKY)*VHCP0(NY,NX)*FHFLX*XDIM - FLVX=AVCNV1*(VP0-VP1)*AREA(3,NU(NY,NX),NY,NX)*BARE(NY,NX) + FLVX=AVCNV1*(VP0-VP1)*AREA(3,NUM(NY,NX),NY,NX)*BARE(NY,NX) IF(FLVX.GE.0.0)THEN - FLV1=AMIN1(FLVX,VOLW0(NY,NX)*XNPH) + FLV1=AMIN1(FLVX,VOLW0(NY,NX)*XH(3,0,NY,NX)) IF(HFLWX.GE.0.0)THEN FLV1=AMIN1(FLV1,HFLWX/(4.19*TK0(NY,NX)+VAP)) ENDIF HWFLV1=(4.19*TK0(NY,NX)+VAP)*FLV1 ELSE - FLV1=AMAX1(FLVX,-VOLW1(NU(NY,NX),NY,NX)*XNPH) + FLV1=AMAX1(FLVX,-VOLW1(NUM(NY,NX),NY,NX)*XH(3,NUM(NY,NX),NY,NX)) IF(HFLWX.LT.0.0)THEN - FLV1=AMAX1(FLV1,HFLWX/(4.19*TK1(NU(NY,NX),NY,NX)+VAP)) + FLV1=AMAX1(FLV1,HFLWX/(4.19*TK1(NUM(NY,NX),NY,NX)+VAP)) ENDIF - HWFLV1=(4.19*TK1(NU(NY,NX),NY,NX)+VAP)*FLV1 + HWFLV1=(4.19*TK1(NUM(NY,NX),NY,NX)+VAP)*FLV1 ENDIF IF(VOLS1(NY,NX).GT.ZEROS(NY,NX))THEN DENSW=(VOLS0(NY,NX)+VOLW0(NY,NX)+VOLI0(NY,NX))/VOLS1(NY,NX) @@ -768,26 +793,26 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) ELSE TCNDW=4.97E-04-3.64E-03*DENSW+1.16E-02*DENSW**2 ENDIF - WTHET1=1.467-0.467*THETPY(NU(NY,NX),NY,NX) - TCND1=(STC(NU(NY,NX),NY,NX)+THETWX(NU(NY,NX),NY,NX)*2.067E-03 - 2+0.611*THETIX(NU(NY,NX),NY,NX)*7.844E-03 - 3+WTHET1*THETPX(NU(NY,NX),NY,NX)*9.050E-05) - 4/(DTC(NU(NY,NX),NY,NX)+THETWX(NU(NY,NX),NY,NX) - 5+0.611*THETIX(NU(NY,NX),NY,NX)+WTHET1*THETPX(NU(NY,NX),NY,NX)) + WTHET1=1.467-0.467*THETPY(NUM(NY,NX),NY,NX) + TCND1=(STC(NUM(NY,NX),NY,NX)+THETWX(NUM(NY,NX),NY,NX)*2.067E-03 + 2+0.611*THETIX(NUM(NY,NX),NY,NX)*7.844E-03 + 3+WTHET1*THETPX(NUM(NY,NX),NY,NX)*9.050E-05) + 4/(DTC(NUM(NY,NX),NY,NX)+THETWX(NUM(NY,NX),NY,NX) + 5+0.611*THETIX(NUM(NY,NX),NY,NX)+WTHET1*THETPX(NUM(NY,NX),NY,NX)) IF(BARE(NY,NX).GT.ZERO)THEN TCNDW1=TCNDW*XNPH TCND1W=TCND1*XNPH - ATCND0=2.0*TCNDW1*TCND1W/(TCNDW1*DLYR(3,NU(NY,NX),NY,NX) + ATCND0=2.0*TCNDW1*TCND1W/(TCNDW1*DLYR(3,NUM(NY,NX),NY,NX) 2+TCND1W*DPTHS0(NY,NX))*BARE(NY,NX) ELSE ATCND0=0.0 ENDIF TK0X=TK0(NY,NX)-HWFLV1/VHCP0(NY,NX) - TK1X=TK1(NU(NY,NX),NY,NX)+HWFLV1/VHCP1(NU(NY,NX),NY,NX) - TKY=(TK0X*VHCP0(NY,NX)+TK1X*VHCP1(NU(NY,NX),NY,NX)) - 2/(VHCP0(NY,NX)+VHCP1(NU(NY,NX),NY,NX)) + TK1X=TK1(NUM(NY,NX),NY,NX)+HWFLV1/VHCP1(NUM(NY,NX),NY,NX) + TKY=(TK0X*VHCP0(NY,NX)+TK1X*VHCP1(NUM(NY,NX),NY,NX)) + 2/(VHCP0(NY,NX)+VHCP1(NUM(NY,NX),NY,NX)) HFLWX=(TK0X-TKY)*VHCP0(NY,NX)*FHFLX*XDIM - HFLWC=ATCND0*(TK0X-TK1X)*AREA(3,NU(NY,NX),NY,NX) + HFLWC=ATCND0*(TK0X-TK1X)*AREA(3,NUM(NY,NX),NY,NX) IF(HFLWC.GE.0.0)THEN HFLC01=AMAX1(0.0,AMIN1(HFLWX,HFLWC)) ELSE @@ -801,10 +826,10 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) C 3,VHCP0(NY,NX),RA,RI,RZ,RAGX,RAGW(NY,NX),RAG(NY,NX),RAB(NY,NX) C 4,WFLXA(NY,NX),WFLXB(NY,NX),CNV0,PARG(NY,NX),UA(NY,NX),UAG,ALFZ C 5,THETP0,VOLS0(NY,NX),VOLI0(NY,NX),VOLW0(NY,NX),VOLS1(NY,NX) -C 6,WGSG0(NY,NX),WGSG1(NU(NY,NX),NY,NX),DPTHS0(NY,NX) -C 7,VOLW1(NU(NY,NX),NY,NX),FLQM,FLYM,WMELT +C 6,WGSG0(NY,NX),WGSG1(NUM(NY,NX),NY,NX),DPTHS0(NY,NX) +C 7,VOLW1(NUM(NY,NX),NY,NX),FLQM,FLYM,WMELT C 8,HWFLQM,HWFLV1,HFLC01,HFLCR1 -C 9,WGSG0(NY,NX),THETPY(NU(NY,NX),NY,NX) +C 9,WGSG0(NY,NX),THETPY(NUM(NY,NX),NY,NX) C 1,DENSS(NY,NX),VOLS0(NY,NX),VOLS1(NY,NX),TCNDW 1113 FORMAT(A8,5I4,60E12.4) C ENDIF @@ -817,10 +842,10 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) HWFLVS=0.0 HFLC0R=0.0 HFLCR1=0.0 - IF(VHCPR1(NY,NX).GT.VHCPRX(NY,NX))THEN + IF(VHCP1(0,NY,NX).GT.VHCPRX(NY,NX))THEN TK0X=TK0(NY,NX) TKXR=TK1(0,NY,NX) - TK1X=TK1(NU(NY,NX),NY,NX) + TK1X=TK1(NUM(NY,NX),NY,NX) CNV01=CNV0*XNPR CNV11=CNV1*XNPR CNVR1=THETPX(0,NY,NX)**2/POROQ(0,NY,NX)*WGSGR0(NY,NX)*XNPR @@ -834,10 +859,10 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) ENDIF IF(CNVR1.GT.ZERO.AND.CNV11.GT.ZERO)THEN AVCNVS=2.0*CNVR1*CNV11 - 2/(CNVR1*DLYR(3,NU(NY,NX),NY,NX)+CNV11*DLYRR(NY,NX))*CVRD(NY,NX) + 2/(CNVR1*DLYR(3,NUM(NY,NX),NY,NX)+CNV11*DLYRR(NY,NX))*CVRD(NY,NX) ELSE AVCNVS=2.0*CNV11 - 2/(DLYR(3,NU(NY,NX),NY,NX)+DLYRR(NY,NX))*CVRD(NY,NX) + 2/(DLYR(3,NUM(NY,NX),NY,NX)+DLYRR(NY,NX))*CVRD(NY,NX) ENDIF THETRR=AMAX1(0.0,1.0-THETPX(0,NY,NX)-THETWX(0,NY,NX) 2-THETIX(0,NY,NX)) @@ -856,7 +881,7 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) IF(TCNDR.GT.ZERO.AND.TCND1.GT.ZERO)THEN TCND11=TCND1*XNPHR ATCNDS=2.0*TCNDR1*TCND11 - 2/(TCNDR1*DLYR(3,NU(NY,NX),NY,NX)+TCND11*DLYRR(NY,NX))*CVRD(NY,NX) + 2/(TCNDR1*DLYR(3,NUM(NY,NX),NY,NX)+TCND11*DLYRR(NY,NX))*CVRD(NY,NX) ELSE ATCNDS=0.0 ENDIF @@ -872,87 +897,87 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) VPR=2.173E-03/TKXR 2*0.61*EXP(5360.0*(3.661E-03-1.0/TKXR)) 3*EXP(18.0*PSISM1(0,NY,NX)/(8.3143*TKXR)) - TKY=(TKXR*VHCPR1(NY,NX)+TK0X*VHCP0(NY,NX)) - 2/(VHCPR1(NY,NX)+VHCP0(NY,NX)) - HFLWX=(TKY-TKXR)*VHCPR1(NY,NX)*FHFLX*XDIM - FLVX=AVCNVR*(VP0-VPR)*AREA(3,NU(NY,NX),NY,NX) + TKY=(TKXR*VHCP1(0,NY,NX)+TK0X*VHCP0(NY,NX)) + 2/(VHCP1(0,NY,NX)+VHCP0(NY,NX)) + HFLWX=(TKY-TKXR)*VHCP1(0,NY,NX)*FHFLX*XDIM + FLVX=AVCNVR*(VP0-VPR)*AREA(3,NUM(NY,NX),NY,NX) IF(FLVX.GE.0.0)THEN - FLVR1=AMIN1(FLVX,VOLW0(NY,NX)*XNPHR) + FLVR1=AMIN1(FLVX,VOLW0(NY,NX)*XHS(NY,NX)) IF(HFLWX.GE.0.0)THEN FLVR1=AMIN1(FLVR1,HFLWX/(4.19*TK0X+VAP)) ENDIF HWFLVR1=(4.19*TK0X+VAP)*FLVR1 ELSE - FLVR1=AMAX1(FLVX,-VOLW1(0,NY,NX)*XNPHR) + FLVR1=AMAX1(FLVX,-VOLW1(0,NY,NX)*XH(3,0,NY,NX)) IF(HFLWX.LT.0.0)THEN FLVR1=AMAX1(FLVR1,HFLWX/(4.19*TKXR+VAP)) ENDIF HWFLVR1=(4.19*TKXR+VAP)*FLVR1 ENDIF TK0X=TK0X-HWFLVR1/VHCP0(NY,NX) - TKXR=TKXR+HWFLVR1/VHCPR1(NY,NX) - TKY=(TKXR*VHCPR1(NY,NX)+TK0X*VHCP0(NY,NX)) - 2/(VHCPR1(NY,NX)+VHCP0(NY,NX)) - HFLWX=(TKY-TKXR)*VHCPR1(NY,NX)*FHFLX*XDIM - HFLWC=ATCNDR*(TK0X-TKXR)*AREA(3,NU(NY,NX),NY,NX) + TKXR=TKXR+HWFLVR1/VHCP1(0,NY,NX) + TKY=(TKXR*VHCP1(0,NY,NX)+TK0X*VHCP0(NY,NX)) + 2/(VHCP1(0,NY,NX)+VHCP0(NY,NX)) + HFLWX=(TKY-TKXR)*VHCP1(0,NY,NX)*FHFLX*XDIM + HFLWC=ATCNDR*(TK0X-TKXR)*AREA(3,NUM(NY,NX),NY,NX) IF(HFLWC.GE.0.0)THEN HFLC0R1=AMAX1(0.0,AMIN1(HFLWX,HFLWC)) ELSE HFLC0R1=AMIN1(0.0,AMAX1(HFLWX,HFLWC)) ENDIF TK0X=TK0X-HFLC0R1/VHCP0(NY,NX) - TKXR=TKXR+HFLC0R1/VHCPR1(NY,NX) + TKXR=TKXR+HFLC0R1/VHCP1(0,NY,NX) C C HEAT FLUX BETWEEN SURFACE RESIDUE AND SOIL SURFACE UNDER SNOWPACK C VP1=2.173E-03/TK1X 2*0.61*EXP(5360.0*(3.661E-03-1.0/TK1X)) 3*EXP(18.0*PSISV1/(8.3143*TK1X)) - TKY=(TKXR*VHCPR1(NY,NX)+TK1X*VHCP1(NU(NY,NX),NY,NX)) - 2/(VHCPR1(NY,NX)+VHCP1(NU(NY,NX),NY,NX)) - HFLWX=(TKXR-TKY)*VHCPR1(NY,NX)*FHFLX*XDIM - FLVX=AVCNVS*(VPR-VP1)*AREA(3,NU(NY,NX),NY,NX) + TKY=(TKXR*VHCP1(0,NY,NX)+TK1X*VHCP1(NUM(NY,NX),NY,NX)) + 2/(VHCP1(0,NY,NX)+VHCP1(NUM(NY,NX),NY,NX)) + HFLWX=(TKXR-TKY)*VHCP1(0,NY,NX)*FHFLX*XDIM + FLVX=AVCNVS*(VPR-VP1)*AREA(3,NUM(NY,NX),NY,NX) IF(FLVX.GE.0.0)THEN - FLVS1=AMIN1(FLVX,VOLW1(0,NY,NX)*XNPHR) + FLVS1=AMIN1(FLVX,VOLW1(0,NY,NX)*XH(3,0,NY,NX)) IF(HFLWX.GE.0.0)THEN FLVS1=AMIN1(FLVS1,HFLWX/(4.19*TKXR+VAP)) ENDIF HWFLVS1=(4.19*TKXR+VAP)*FLVS1 ELSE - FLVS1=AMAX1(FLVX,-VOLW1(NU(NY,NX),NY,NX)*XNPHR) + FLVS1=AMAX1(FLVX,-VOLW1(NUM(NY,NX),NY,NX)*XH(3,NUM(NY,NX),NY,NX)) IF(HFLWX.LT.0.0)THEN FLVS1=AMAX1(FLVS1,HFLWX/(4.19*TK1X+VAP)) ENDIF HWFLVS1=(4.19*TK1X+VAP)*FLVS1 ENDIF - TKXR=TKXR-HWFLVS1/VHCPR1(NY,NX) - TK1X=TK1X+HWFLVS1/VHCP1(NU(NY,NX),NY,NX) - TKY=(TKXR*VHCPR1(NY,NX)+TK1X*VHCP1(NU(NY,NX),NY,NX)) - 2/(VHCPR1(NY,NX)+VHCP1(NU(NY,NX),NY,NX)) - HFLWX=(TKXR-TKY)*VHCPR1(NY,NX)*FHFLX*XDIM - HFLWC=ATCNDS*(TKXR-TK1X)*AREA(3,NU(NY,NX),NY,NX) + TKXR=TKXR-HWFLVS1/VHCP1(0,NY,NX) + TK1X=TK1X+HWFLVS1/VHCP1(NUM(NY,NX),NY,NX) + TKY=(TKXR*VHCP1(0,NY,NX)+TK1X*VHCP1(NUM(NY,NX),NY,NX)) + 2/(VHCP1(0,NY,NX)+VHCP1(NUM(NY,NX),NY,NX)) + HFLWX=(TKXR-TKY)*VHCP1(0,NY,NX)*FHFLX*XDIM + HFLWC=ATCNDS*(TKXR-TK1X)*AREA(3,NUM(NY,NX),NY,NX) IF(HFLWC.GE.0.0)THEN HFLCR11=AMAX1(0.0,AMIN1(HFLWX,HFLWC)) ELSE HFLCR11=AMIN1(0.0,AMAX1(HFLWX,HFLWC)) ENDIF - TKXR=TKXR-HFLCR11/VHCPR1(NY,NX) - TK1X=TK1X+HFLCR11/VHCP1(NU(NY,NX),NY,NX) + TKXR=TKXR-HFLCR11/VHCP1(0,NY,NX) + TK1X=TK1X+HFLCR11/VHCP1(NUM(NY,NX),NY,NX) FLVR=FLVR+FLVR1 HWFLVR=HWFLVR+HWFLVR1 FLVS=FLVS+FLVS1 HWFLVS=HWFLVS+HWFLVS1 HFLC0R=HFLC0R+HFLC0R1 HFLCR1=HFLCR1+HFLCR11 -C IF(NX.EQ.4.AND.NY.EQ.5)THEN +C IF(I.EQ.328)THEN C WRITE(*,1114)'FLVR0',I,J,M,NX,NY,N,TK0(NY,NX),TK1(0,NY,NX) -C 2,TK1(NU(NY,NX),NY,NX),TK0X,TKXR,TK1X,FLVR1,HWFLVR1,FLVS1 +C 2,TK1(NUM(NY,NX),NY,NX),TK0X,TKXR,TK1X,FLVR1,HWFLVR1,FLVS1 C 4,HWFLVS1,HFLC0R1,HFLCR11,FLVR,HWFLVR,FLVS,HWFLVS C 3,HFLC0R,HFLCR1,VPQ(NY,NX),VP0,VPR,VP1,PSISM1(0,NY,NX),PSISV1 -C 5,AVCNVR,ATCNDR,AVCNVS,ATCNDS,VHCP0(NY,NX),VHCPR1(NY,NX) -C 6,VHCP1(NU(NY,NX),NY,NX),DLYRR(NY,NX),DPTHS0(NY,NX),CNV01,CNVR1 -C 7,CNV11,CNV1,THETPX(NU(NY,NX),NY,NX),POROQ(NU(NY,NX),NY,NX) -C 2,WGSG1(NU(NY,NX),NY,NX),CVRD(NY,NX) +C 5,AVCNVR,ATCNDR,AVCNVS,ATCNDS,VHCP0(NY,NX),VHCP1(0,NY,NX) +C 6,VHCP1(NUM(NY,NX),NY,NX),DLYRR(NY,NX),DPTHS0(NY,NX),CNV01,CNVR1 +C 7,CNV11,CNV1,THETPX(NUM(NY,NX),NY,NX),POROQ(NUM(NY,NX),NY,NX) +C 2,WGSG1(NUM(NY,NX),NY,NX),CVRD(NY,NX),HFLR1,HWFLV1,HFLCR1 1114 FORMAT(A8,6I4,60E12.4) C ENDIF 4000 CONTINUE @@ -963,7 +988,7 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) ENDIF PSISM1(0,NY,NX)=PSISE(0,NY,NX)*THETWR**FPSISR ELSE - PSISM1(0,NY,NX)=PSISM1(NU(NY,NX),NY,NX) + PSISM1(0,NY,NX)=PSISM1(NUM(NY,NX),NY,NX) ENDIF EVAPR(NY,NX)=0.0 RFLXR=0.0 @@ -977,26 +1002,28 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) FLW0S(NY,NX)=FLQ0S(NY,NX)+EVAPS(NY,NX) FLW0L(NY,NX)=FLQ0W(NY,NX)+EVAP(NY,NX)-FLV1-FLVR HFLW0L(NY,NX)=HWFLQ0(NY,NX)+HFLW0-HWFLV1-HWFLVR-HFLC01-HFLC0R - FLWL(3,NU(NY,NX),NY,NX)=FLQM+FLV1+FLVS - FLWLX(3,NU(NY,NX),NY,NX)=FLQM+FLV1 - FLWHL(3,NU(NY,NX),NY,NX)=FLHM - HFLWL(3,NU(NY,NX),NY,NX)=HWFLQM+HWFLV1+HWFLVS+HFLC01+HFLCR1 + FLWL(3,NUM(NY,NX),NY,NX)=FLQM+FLV1+FLVS + FLWLX(3,NUM(NY,NX),NY,NX)=FLQM+FLV1 + FLWHL(3,NUM(NY,NX),NY,NX)=FLHM + HFLWL(3,NUM(NY,NX),NY,NX)=HWFLQM+HWFLV1+HWFLVS+HFLC01+HFLCR1 FLWRL(NY,NX)=FLYM+FLVR-FLVS HFLWRL(NY,NX)=HWFLYM+HFLC0R-HFLCR1+HWFLVR-HWFLVS - FLWVL(NU(NY,NX),NY,NX)=0.0 - FLWV(NU(NY,NX),NY,NX)=FLWV(NU(NY,NX),NY,NX) - 2+FLWVL(NU(NY,NX),NY,NX) -C IF(NX.EQ.2.AND.NY.EQ.2)THEN -C WRITE(*,7753)'FLW0L',I,J,M,NX,NY,FLW0L(NY,NX) + FLWVL(NUM(NY,NX),NY,NX)=0.0 + FLWV(NUM(NY,NX),NY,NX)=FLWV(NUM(NY,NX),NY,NX) + 2+FLWVL(NUM(NY,NX),NY,NX) +C IF(I.EQ.328)THEN +C WRITE(*,7753)'FLWL',I,J,M,NX,NY,NUM(NY,NX) +C 2,FLWL(3,NUM(NY,NX),NY,NX),FLQM,FLV1,FLVS +C WRITE(*,7753)'FLW0L',I,J,M,NX,NY,NUM(NY,NX),FLW0L(NY,NX) C 2,FLQ0W(NY,NX),EVAP(NY,NX),FLV1,FLVR,VOLW0(NY,NX) -C 2,FLW0S(NY,NX),FLQ0S(NY,NX),EVAPS(NY,NX) +C 2,FLW0S(NY,NX),FLQ0S(NY,NX),EVAPS(NY,NX) C 3,EVAPT,PARE,VPQ(NY,NX),VP0,TK0(NY,NX),HFLW0L(NY,NX) C 4,HWFLQ0(NY,NX),HFLW0,HWFLV1,HWFLVR,HFLC01,HFLC0R -C WRITE(*,7753)'FLWRL',I,J,M,NX,NY,FLWRL(NY,NX) +C WRITE(*,7753)'FLWRL',I,J,M,NX,NY,NUM(NY,NX),FLWRL(NY,NX) C 3,PSISM1(0,NY,NX),PSISE(0,NY,NX) C 2,FLYM,FLVR,FLVS,HFLWRL(NY,NX),VOLW1(0,NY,NX) C 2,HWFLYM,HFLC0R,HFLCR1,HWFLVR,HWFLVS -7753 FORMAT(A8,5I4,30E12.4) +7753 FORMAT(A8,6I4,30E12.4) C ENDIF C C FREEZE-THAW IN SNOWPACK FROM NET CHANGE IN SNOWPACK @@ -1013,11 +1040,11 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) FVOLS0=0.0 FVOLI0=0.0 ENDIF - TFLX0(NY,NX)=AMAX1(-333.0*TVOLWS*XNPH,TFLX) + TFLX0(NY,NX)=AMAX1(-333.0*TVOLWS*XHS(NY,NX),TFLX) WFLXA(NY,NX)=-TFLX0(NY,NX)*FVOLS0/333.0 WFLXB(NY,NX)=-TFLX0(NY,NX)*FVOLI0/333.0 ELSE - TFLX0(NY,NX)=AMIN1(333.0*VOLW0(NY,NX)*XNPH,TFLX) + TFLX0(NY,NX)=AMIN1(333.0*VOLW0(NY,NX)*XHS(NY,NX),TFLX) WFLXA(NY,NX)=0.0 WFLXB(NY,NX)=-TFLX0(NY,NX)/333.0 ENDIF @@ -1047,50 +1074,59 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) C AIR AND WATER-FILLED POROSITY, AND WATER POTENTIAL USED IN C FLUX CALCULATIONS C -C IF(BKVL(NU(NY,NX),NY,NX).GT.0.0)THEN - THETW1=AMAX1(THETY(NU(NY,NX),NY,NX),AMIN1(POROS(NU(NY,NX),NY,NX) - 2,VOLW1(NU(NY,NX),NY,NX)/VOLX(NU(NY,NX),NY,NX))) - IF(THETW1.LT.FC(NU(NY,NX),NY,NX))THEN - PSISM1(NU(NY,NX),NY,NX)=AMAX1(PSIHY,-EXP(PSIMX(NY,NX) - 2+((FCL(NU(NY,NX),NY,NX)-LOG(THETW1)) - 3/FCD(NU(NY,NX),NY,NX)*PSIMD(NY,NX)))) - ELSEIF(THETW1.LT.POROS(NU(NY,NX),NY,NX)-DTHETW)THEN - PSISM1(NU(NY,NX),NY,NX)=-EXP(PSIMS(NY,NX) - 2+(((PSL(NU(NY,NX),NY,NX)-LOG(THETW1)) - 3/PSD(NU(NY,NX),NY,NX))**SRP(NU(NY,NX),NY,NX)*PSISD(NY,NX))) + IF(BKVL(NUM(NY,NX),NY,NX).GT.0.0)THEN + THETW1=AMAX1(THETY(NUM(NY,NX),NY,NX),AMIN1(POROS(NUM(NY,NX),NY,NX) + 2,VOLW1(NUM(NY,NX),NY,NX)/VOLXI(NUM(NY,NX),NY,NX))) + IF(THETW1.LT.FC(NUM(NY,NX),NY,NX))THEN + PSISM1(NUM(NY,NX),NY,NX)=AMAX1(PSIHY,-EXP(PSIMX(NY,NX) + 2+((FCL(NUM(NY,NX),NY,NX)-LOG(THETW1)) + 3/FCD(NUM(NY,NX),NY,NX)*PSIMD(NY,NX)))) + ELSEIF(THETW1.LT.POROS(NUM(NY,NX),NY,NX)-DTHETW)THEN + PSISM1(NUM(NY,NX),NY,NX)=-EXP(PSIMS(NY,NX) + 2+(((PSL(NUM(NY,NX),NY,NX)-LOG(THETW1)) + 3/PSD(NUM(NY,NX),NY,NX))**SRP(NUM(NY,NX),NY,NX)*PSISD(NY,NX))) ELSE - PSISM1(NU(NY,NX),NY,NX)=PSISE(NU(NY,NX),NY,NX) + PSISM1(NUM(NY,NX),NY,NX)=PSISE(NUM(NY,NX),NY,NX) ENDIF -C ELSE -C PSISM1(NU(NY,NX),NY,NX)=PSISE(NU(NY,NX),NY,NX) -C ENDIF - PSISV1=PSISM1(NU(NY,NX),NY,NX)+PSISO(NU(NY,NX),NY,NX) + ELSE + PSISM1(NUM(NY,NX),NY,NX)=PSISE(NUM(NY,NX),NY,NX) + ENDIF + PSISV1=PSISM1(NUM(NY,NX),NY,NX)+PSISO(NUM(NY,NX),NY,NX) C IF(NX.EQ.4.AND.NY.EQ.5)THEN -C WRITE(*,3232)'PSISV1',I,J,M,NX,NY,NU(NY,NX),PSISV1 -C 2,PSISM1(NU(NY,NX),NY,NX),PSISO(NU(NY,NX),NY,NX) -C 3,THETWX(NU(NY,NX),NY,NX),THETW1,POROS(NU(NY,NX),NY,NX) -C 4,PSL(NU(NY,NX),NY,NX),LOG(THETW1),PSD(NU(NY,NX),NY,NX) -C 5,SRP(NU(NY,NX),NY,NX) +C WRITE(*,3232)'PSISV1',I,J,M,NX,NY,NUM(NY,NX),PSISV1 +C 2,PSISM1(NUM(NY,NX),NY,NX),PSISO(NUM(NY,NX),NY,NX) +C 3,THETWX(NUM(NY,NX),NY,NX),THETW1,POROS(NUM(NY,NX),NY,NX) +C 4,PSL(NUM(NY,NX),NY,NX),LOG(THETW1),PSD(NUM(NY,NX),NY,NX) +C 5,SRP(NUM(NY,NX),NY,NX) 3232 FORMAT(A8,6I4,12E12.4) C ENDIF C C SOIL SURFACE ALBEDO, NET RADIATION C - VOLWXG=VOLW1(NU(NY,NX),NY,NX)+VOLWH1(NU(NY,NX),NY,NX) - VOLIXG=VOLI1(NU(NY,NX),NY,NX)+VOLIH1(NU(NY,NX),NY,NX) - ALBG=(ALBS(NY,NX)*BKVL(NU(NY,NX),NY,NX)+0.06*VOLWXG - 2+0.30*VOLIXG)/(BKVL(NU(NY,NX),NY,NX)+VOLWXG+VOLIXG) + VOLWXG=VOLW1(NUM(NY,NX),NY,NX)+VOLWH1(NUM(NY,NX),NY,NX) + VOLIXG=VOLI1(NUM(NY,NX),NY,NX)+VOLIH1(NUM(NY,NX),NY,NX) + IF(VOLWXG+VOLIXG.GT.ZEROS(NY,NX))THEN + ALBG=(ALBS(NY,NX)*BKVL(NUM(NY,NX),NY,NX)+0.06*VOLWXG + 2+0.30*VOLIXG)/(BKVL(NUM(NY,NX),NY,NX)+VOLWXG+VOLIXG) + ELSE + ALBG=ALBS(NY,NX) + ENDIF RFLX1=(1.0-ALBG)*RADXG(NY,NX)+THRYG(NY,NX) - THRMA=THRMS(NY,NX)*TK1(NU(NY,NX),NY,NX)**4 + THRMA=THRMS(NY,NX)*TK1(NUM(NY,NX),NY,NX)**4 RFLX=RFLX1-THRMA C C AERODYNAMIC RESISTANCE ABOVE SOIL SURFACE INCLUDING C RESISTANCE IMPOSED BY PLANT CANOPY C - RAR1=RAR(NY,NX)/AMAX1(THETX,THETPX(0,NY,NX))**2.33 +C IF(VOLR(NY,NX).GT.ZEROS(NY,NX) +C 2.AND.VHCP1(0,NY,NX).GT.VHCPRX(NY,NX))THEN + RAR1=RAR(NY,NX)/AMAX1(THETX,THETPX(0,NY,NX))**2.33*CVRD(NY,NX) +C ELSE +C RAR1=0.0 +C ENDIF 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)))) + 2-TK1(NUM(NY,NX),NY,NX)))) RAGX=AMAX1(RAM,0.75*RAGS(NY,NX),AMIN1(1.33*RAGS(NY,NX) 2,RAGZ/(1.0-10.0*RI))) RAGS(NY,NX)=RAGX @@ -1100,50 +1136,44 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) C PARE=PAREG(NY,NX)/(RA+RZ) PARS=PARSG(NY,NX)/RA - TKX1=TK1(NU(NY,NX),NY,NX) + TKX1=TK1(NUM(NY,NX),NY,NX) VP1=2.173E-03/TKX1 2*0.61*EXP(5360.0*(3.661E-03-1.0/TKX1)) 3*EXP(18.0*PSISV1/(8.3143*TKX1)) EVAP(NY,NX)=AMAX1(PARE*(VPQ(NY,NX)-VP1) - 2,-AMAX1(0.0,VOLW1(NU(NY,NX),NY,NX))*XNPH) + 2,-AMAX1(0.0,VOLW1(NUM(NY,NX),NY,NX)*XH(3,NUM(NY,NX),NY,NX))) EVAPS(NY,NX)=0.0 EFLX=EVAP(NY,NX)*VAP IF(EVAP(NY,NX).LT.0.0)THEN - VFLX=EVAP(NY,NX)*4.19*TK1(NU(NY,NX),NY,NX) + VFLX=EVAP(NY,NX)*4.19*TK1(NUM(NY,NX),NY,NX) ELSE VFLX=EVAP(NY,NX)*4.19*TKQ(NY,NX) ENDIF -C IF(NX.EQ.4.AND.NY.EQ.5)THEN -C WRITE(*,3376)'EVAP',I,J,M,NX,NY,EVAP(NY,NX),RFLX,RFLX1,THRMA -C 3,THETPX(0,NY,NX),VHCPR1(NY,NX),CVRD(NY,NX) -C 2,PARE,VPQ(NY,NX),VP1,RA,RAZ,RAGS(NY,NX),RI,RAR1,RAR(NY,NX),RAGZ -C 3,RAG(NY,NX),RIB(NY,NX),TKX1,PSISV1,VOLW1(NU(NY,NX),NY,NX) -C 4,DLYRR(NY,NX),WGSGR(NY,NX),VOLX(0,NY,NX),ORGC(0,NY,NX) -C 5,VOLA(0,NY,NX),VOLW1(0,NY,NX),VOLI1(0,NY,NX),VOLP1(0,NY,NX) -C ENDIF C C SOLVE FOR SOIL SURFACE TEMPERATURE AT WHICH ENERGY C BALANCE OCCURS, SOLVE LATENT, SENSIBLE AND STORAGE HEAT FLUXES C - SFLX=PARS*(TKQ(NY,NX)-TK1(NU(NY,NX),NY,NX)) - HFLW1=RFLX+EFLX+SFLX+VFLX -C IF(I.EQ.208)THEN -C WRITE(*,1112)'EFLX',I,J,M,NX,NY,TK1(NU(NY,NX),NY,NX) -C 2,RFLX,EFLX,SFLX,VFLX,HFLW1,RA,RAC(NY,NX),RAG(NY,NX),RAS1,RAGZ,RAR1 -C 3,RAGX,RI,RAGS(NY,NX),VOLW1(NU(NY,NX),NY,NX),VOLI1(NU(NY,NX),NY,NX) + SFLX=PARS*(TKQ(NY,NX)-TK1(NUM(NY,NX),NY,NX)) + HFLX1=RFLX+EFLX+SFLX + HFLW1=HFLX1+VFLX +C IF(J.EQ.12.AND.NX.EQ.2.AND.M.EQ.NPH)THEN +C WRITE(*,1112)'EFLX',I,J,M,NX,NY,NUM(NY,NX),TK1(NUM(NY,NX),NY,NX) +C 2,RFLX,EFLX,SFLX,VFLX,HFLX1,HFLW1,RA,RAC(NY,NX),RAG(NY,NX) +C 3,RAGZ,RAR1,RAGX,RI,RAGS(NY,NX),BKVL(NUM(NY,NX),NY,NX) +C 3,VOLW1(NUM(NY,NX),NY,NX),VOLI1(NUM(NY,NX),NY,NX),RFLX1,ALBG C 4,RADXG(NY,NX),THRYG(NY,NX),THRMA,THRYW(NY,NX),THS(NY,NX) -C 5,BARE(NY,NX),PARG(NY,NX),VPQ(NY,NX),VP1,FRADG(NY,NX),THRMCX(NY,NX) -C 5,PSISM1(NU(NY,NX),NY,NX),PSISO(NU(NY,NX),NY,NX) -C 6,FLQM,EVAP(NY,NX),PARE,HFLW1,PARS,PARSG(NY,NX),HWFLQM -C 7,ATCNDS,TCND1,THETPY(NU(NY,NX),NY,NX),RAR(NY,NX),THETPY(0,NY,NX) -C 8,VHCP1(NU(NY,NX),NY,NX),PARS -C 3,TKQ(NY,NX) -1112 FORMAT(A8,5I4,60E12.4) +C 5,PARG(NY,NX),VPQ(NY,NX),VP1,FRADG(NY,NX),THRMCX(NY,NX) +C 5,PSISM1(NUM(NY,NX),NY,NX),PSISO(NUM(NY,NX),NY,NX) +C 6,FLQM,EVAP(NY,NX),PARE,PARS,PARSG(NY,NX),HWFLQM +C 7,THETPY(NUM(NY,NX),NY,NX),RAR(NY,NX),THETPY(0,NY,NX) +C 8,VHCP1(0,NY,NX),VHCPRX(NY,NX),VHCP1(NUM(NY,NX),NY,NX),PARS +C 3,TKQ(NY,NX),XH(3,NUM(NY,NX),NY,NX),BARE(NY,NX) +1112 FORMAT(A8,6I4,60E12.4) C ENDIF C C ENERGY BALANCE AT RESIDUE SURFACE C - IF(VHCPR1(NY,NX).GT.VHCPRX(NY,NX))THEN + IF(VHCP1(0,NY,NX).GT.VHCPRX(NY,NX))THEN C C PARAMETERS FOR CALCULATING LATENT AND SENSIBLE HEAT FLUXES C @@ -1165,35 +1195,34 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) RFLX1=(1.0-ALBR)*RADXR(NY,NX)+THRYR(NY,NX) TKR1=TK1(0,NY,NX) VOLWR2=VOLW1(0,NY,NX) - VHCPR2=VHCPR1(NY,NX) - TKS1=TK1(NU(NY,NX),NY,NX) - HFLW2=HFLW1*XNPR - VOLW12=VOLW1(NU(NY,NX),NY,NX) - VHCP12=VHCP1(NU(NY,NX),NY,NX) + VHCPR2=VHCP1(0,NY,NX) + TKS1=TK1(NUM(NY,NX),NY,NX) + VOLW12=VOLW1(NUM(NY,NX),NY,NX) + VHCP12=VHCP1(NUM(NY,NX),NY,NX) C C THERMAL CONDUCTIVITY BETWEEN SURFACE RESIDUE AND SOIL SURFACE C CNVR=THETPX(0,NY,NX)**2/POROQ(0,NY,NX)*WGSGR0(NY,NX)*XNPR - CNV1=THETPX(NU(NY,NX),NY,NX)**2/POROQ(NU(NY,NX),NY,NX)*XNPR - 2*WGSG1(NU(NY,NX),NY,NX) + CNV1=THETPX(NUM(NY,NX),NY,NX)**2/POROQ(NUM(NY,NX),NY,NX)*XNPR + 2*WGSG1(NUM(NY,NX),NY,NX) IF(CVRD(NY,NX).GT.ZERO)THEN IF(CNVR.GT.ZERO.AND.CNV1.GT.ZERO)THEN AVCNVS=2.0*CNVR*CNV1 - 2/(CNVR*DLYR(3,NU(NY,NX),NY,NX)+CNV1*DLYRR(NY,NX))*CVRD(NY,NX) + 2/(CNVR*DLYR(3,NUM(NY,NX),NY,NX)+CNV1*DLYRR(NY,NX))*CVRD(NY,NX) ELSE AVCNVS=2.0*CNVR - 2/(DLYR(3,NU(NY,NX),NY,NX)+DLYRR(NY,NX))*CVRD(NY,NX) + 2/(DLYR(3,NUM(NY,NX),NY,NX)+DLYRR(NY,NX))*CVRD(NY,NX) ENDIF ELSE AVCNVS=0.0 ENDIF THETRR=AMAX1(0.0,1.0-THETPX(0,NY,NX)-THETWX(0,NY,NX) 2-THETIX(0,NY,NX)) - DTKX=ABS(TK1(0,NY,NX)-TK1(NU(NY,NX),NY,NX))*1.0E-06 + DTKX=ABS(TK1(0,NY,NX)-TK1(NUM(NY,NX),NY,NX))*1.0E-06 DTHW0=AMAX1(0.0,THETWX(0,NY,NX)-TRBW)**3 DTHA0=AMAX1(0.0,THETPX(0,NY,NX)-TRBA)**3 - DTHW1=AMAX1(0.0,THETWX(NU(NY,NX),NY,NX)-TRBW)**3 - DTHA1=AMAX1(0.0,THETPX(NU(NY,NX),NY,NX)-TRBA)**3 + DTHW1=AMAX1(0.0,THETWX(NUM(NY,NX),NY,NX)-TRBW)**3 + DTHA1=AMAX1(0.0,THETPX(NUM(NY,NX),NY,NX)-TRBA)**3 RYLXW0=DTKX*DTHW0 RYLXA0=DTKX*DTHA0 RYLXW1=DTKX*DTHW1 @@ -1217,14 +1246,14 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) 4/(0.779*THETRR+0.622*THETWX(0,NY,NX) 5+0.380*THETIX(0,NY,NX)+WTHET0*THETPX(0,NY,NX)) TCNDR1=TCNDR*XNPHR - WTHET1=1.467-0.467*THETPY(NU(NY,NX),NY,NX) - TCND1=(STC(NU(NY,NX),NY,NX)+THETWX(NU(NY,NX),NY,NX)*TCNDW1 - 2+0.611*THETIX(NU(NY,NX),NY,NX)*7.844E-03 - 3+WTHET1*THETPX(NU(NY,NX),NY,NX)*TCNDA1) - 4/(DTC(NU(NY,NX),NY,NX)+THETWX(NU(NY,NX),NY,NX) - 5+0.611*THETIX(NU(NY,NX),NY,NX)+WTHET1*THETPX(NU(NY,NX),NY,NX)) + WTHET1=1.467-0.467*THETPY(NUM(NY,NX),NY,NX) + TCND1=(STC(NUM(NY,NX),NY,NX)+THETWX(NUM(NY,NX),NY,NX)*TCNDW1 + 2+0.611*THETIX(NUM(NY,NX),NY,NX)*7.844E-03 + 3+WTHET1*THETPX(NUM(NY,NX),NY,NX)*TCNDA1) + 4/(DTC(NUM(NY,NX),NY,NX)+THETWX(NUM(NY,NX),NY,NX) + 5+0.611*THETIX(NUM(NY,NX),NY,NX)+WTHET1*THETPX(NUM(NY,NX),NY,NX)) TCND1R=TCND1*XNPHR - ATCNDR=2.0*TCNDR1*TCND1R/(TCNDR1*DLYR(3,NU(NY,NX),NY,NX) + ATCNDR=2.0*TCNDR1*TCND1R/(TCNDR1*DLYR(3,NUM(NY,NX),NY,NX) 2+TCND1R*DLYRR(NY,NX))*CVRD(NY,NX) C C SMALLER TIME STEP FOR SOLVING SURFACE RESIDUE ENERGY EXCHANGE @@ -1262,7 +1291,7 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) VP1=2.173E-03/TKS1 2*0.61*EXP(5360.0*(3.661E-03-1.0/TKS1)) 3*EXP(18.0*PSISV1/(8.3143*TKS1)) - EVAPR2=AMIN1(VOLWRM*XNPHR,AMAX1(-AMAX1(0.0,VOLWR2)*XNPHR + EVAPR2=AMIN1(VOLWRM,AMAX1(-AMAX1(0.0,VOLWR2*XH(3,0,NY,NX)) 2,PARE*(VPQ(NY,NX)-VPR))) EFLXR2=EVAPR2*VAP VFLXR2=EVAPR2*4.19*TKR1 @@ -1272,15 +1301,15 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) C TKY=(TKR1*VHCPR2+TKS1*VHCP12)/(VHCPR2+VHCP12) HFLWX=(TKR1-TKY)*VHCPR2*FHFLX*XDIM - FLVX=AVCNVS*(VPR-VP1)*AREA(3,NU(NY,NX),NY,NX) + FLVX=AVCNVS*(VPR-VP1)*AREA(3,NUM(NY,NX),NY,NX) IF(FLVX.GE.0.0)THEN - FLV2=AMIN1(FLVX,VOLWR2*XNPHR) + FLV2=AMIN1(FLVX,VOLWR2*XH(3,0,NY,NX)) IF(HFLWX.GE.0.0)THEN FLV2=AMIN1(FLV2,HFLWX/(4.19*TKR1+VAP)) ENDIF HWFLV2=(4.19*TKR1+VAP)*FLV2 ELSE - FLV2=AMAX1(FLVX,-VOLW12*XNPHR) + FLV2=AMAX1(FLVX,-VOLW12*XH(3,0,NY,NX)) IF(HFLWX.LT.0.0)THEN FLV2=AMAX1(FLV2,HFLWX/(4.19*TKS1+VAP)) ENDIF @@ -1297,7 +1326,8 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) HFLCR2=AMIN1(0.0,AMAX1(HFLWX,HFLWC)) ENDIF SFLXR2=PARS*(TKQ(NY,NX)-TKR1) - HFLR2=RFLXR2+EFLXR2+SFLXR2+VFLXR2 + HFLXR2=RFLXR2+EFLXR2+SFLXR2 + HFLR2=HFLXR2+VFLXR2 C C AGGREGATE WATER AND ENERGY FLUXES FROM RESIDUE TIME STEP C TO MODEL TIME STEP @@ -1330,31 +1360,34 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) VHCPR2=2.496E-06*ORGC(0,NY,NX)+4.19*VOLWR2 2+1.9274*VOLI1(0,NY,NX) VHCP12=VHCP12+4.19*FLV2 - TKR1=(ENGYR+HWFLM2+HFLR2-HWFLV2-HFLCR2)/VHCPR2 - TKS1X=TKS1 - TKS1=TKS1+(HFLW2+HWFLV2+HFLCR2)/VHCP12 -C IF(NX.EQ.1.AND.NY.EQ.6)THEN -C WRITE(*,1111)'EFLXR2',I,J,M,NX,NY,N,TKR1,TKS1,TKQ(NY,NX) -C 2,EFLXR2,SFLXR2,VFLXR2,FLV2,FLVX,VPR,VP1,AVCNVS,PSISE(0,NY,NX) -C 3,PSISM1(0,NY,NX),PSISV1,THETWR,VOLWR2,VOLWRX(NY,NX),TRC0(NY,NX) -C 4,PARS,PARE,RA,RZR,RI,TKQ(NY,NX),VOLWR2,VOLW12,HFLWX,FLV1 -C 5,VOLW1(NU(NY,NX),NY,NX),THRMZ2,VOLW1(0,NY,NX) -C 3,HWFLV2,HFLCR2,HWFLM2,RA,RAGX,RAG(NY,NX),RAB(NY,NX),RAC(NY,NX) -C 4,RZR,RZ,PARS + TKR1=(ENGYR+HFLR2+HWFLM2-HWFLV2-HFLCR2)/VHCPR2 + TKS1=TKS1+(HWFLV2+HFLCR2)/VHCP12 +C IF(I.EQ.328)THEN +C WRITE(*,1111)'EFLXR2',I,J,M,NX,NY,NUM(NY,NX),N,TKR1,TKS1 +C 2,TKQ(NY,NX),RFLXR2,EFLXR2,SFLXR2,VFLXR2,HFLR2,HWFLM2,HWFLV2 +C 3,HFLCR2,VHCPR2,HWFLV2,VHCP12,VOLWR2,VOLW12 +C 3,FLVX,FLV2,FLVX,VPR,VP1,AVCNVS,CNVR,CNV1 +C 3,PSISM1(0,NY,NX),PSISV1,THETWR,VOLWRX(NY,NX),TRC0(NY,NX) +C 4,VHCPRX(NY,NX),PARS,PARE,RA,RZR,RZ,RI,TKQ(NY,NX),VOLW1(0,NY,NX) +C 5,VOLW1(NUM(NY,NX),NY,NX),VOLT(NUM(NY,NX),NY,NX),THRMZ2,HFLWX,FLV1 +C 3,RA,RAGX,RAG(NY,NX),RAB(NY,NX),RAC(NY,NX) C 4,RAR1,PARE,VPQ(NY,NX),EVAPR(NY,NX),EVAPR2 -C 5,VHCPR2,VHCP12,CNVR,CNV1,VOLX(0,NY,NX) -C 5,ATCNDR,TCNDR,TCNDR1,TCND1R,DLYR(3,NU(NY,NX),NY,NX) -C 6,DLYRR(NY,NX),DLYR(3,0,NY,NX),POROQ(0,NY,NX),WGSGR(NY,NX) +C 5,CNVR,CNV1,VOLX(0,NY,NX),POROQ(0,NY,NX),WGSGR(NY,NX) +C 5,ATCNDR,TCNDR,TCNDR1,TCND1R +C 6,TCND1,STC(NUM(NY,NX),NY,NX),THETWX(NUM(NY,NX),NY,NX),TCNDW1 +C 2,THETIX(NUM(NY,NX),NY,NX),WTHET1,THETPX(NUM(NY,NX),NY,NX),TCNDA1 +C 4,DTC(NUM(NY,NX),NY,NX),VOLP1(0,NY,NX),VOLR(NY,NX) C 7,THETWX(0,NY,NX),THETIX(0,NY,NX),THETPY(0,NY,NX),ORGC(0,NY,NX) -C 8,CVRD(NY,NX),EFLXR,EFLX,TRA0(NY,NX),ATCNDR*(TKR1-TKS1),TKS1X -1111 FORMAT(A8,6I4,100E12.4) +C 6,DLYR(3,0,NY,NX),DLYR(3,NUM(NY,NX),NY,NX) +C 8,CVRD(NY,NX),TVOLW(NY,NX),VOLWG(NY,NX),XH(3,0,NY,NX) +1111 FORMAT(A8,7I4,100E12.4) C ENDIF 5000 CONTINUE C C IF NO SURFACE RESIDUE C ELSE - TK1(0,NY,NX)=TK1(NU(NY,NX),NY,NX) + TK1(0,NY,NX)=TK1(NUM(NY,NX),NY,NX) EVAPR(NY,NX)=0.0 RFLXR=0.0 EFLXR=0.0 @@ -1370,26 +1403,30 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) C GATHER WATER, VAPOR AND HEAT FLUXES INTO FLUX ARRAYS C FOR LATER UPDATES TO STATE VARIABLES C - FLWL(3,NU(NY,NX),NY,NX)=FLQM+EVAP(NY,NX)+FLV1 - FLWLX(3,NU(NY,NX),NY,NX)=FLQM+EVAP(NY,NX)+FLV1 - FLWHL(3,NU(NY,NX),NY,NX)=FLHM - HFLWL(3,NU(NY,NX),NY,NX)=HWFLQM+HFLW1+HWFLV1+HFLCR1 + FLWL(3,NUM(NY,NX),NY,NX)=FLQM+EVAP(NY,NX)+FLV1 + FLWLX(3,NUM(NY,NX),NY,NX)=FLQM+EVAP(NY,NX)+FLV1 + FLWHL(3,NUM(NY,NX),NY,NX)=FLHM + HFLWL(3,NUM(NY,NX),NY,NX)=HWFLQM+HFLW1+HWFLV1+HFLCR1 FLWRL(NY,NX)=FLYM+EVAPR(NY,NX)-FLV1 HFLWRL(NY,NX)=HWFLYM+HFLR1-HWFLV1-HFLCR1 - FLWVL(NU(NY,NX),NY,NX)=RFLWV(NY,NX)*(VOLW1(NU(NY,NX),NY,NX) - 2-VOLWX1(NU(NY,NX),NY,NX)) - FLWV(NU(NY,NX),NY,NX)=FLWV(NU(NY,NX),NY,NX) - 2+FLWVL(NU(NY,NX),NY,NX) -C IF(NX.EQ.1.AND.NY.EQ.6)THEN -C WRITE(*,3376)'FLW1',I,J,M,NX,NY,FLWL(3,NU(NY,NX),NY,NX) -C 2,PSISM1(0,NY,NX),PSISM1(NU(NY,NX),NY,NX),VOLWRX(NY,NX) -C 3,VOLW1(0,NY,NX),VOLW1(NU(NY,NX),NY,NX),THETWX(NU(NY,NX),NY,NX) -C 2,FLQM,EVAP(NY,NX),PARE,VPQ(NY,NX),VP1 -C 4,FLWRL(NY,NX),FLYM,EVAPR(NY,NX),FLV1 -C WRITE(*,3376)'HFLW1',I,J,M,NX,NY,HFLWL(3,NU(NY,NX),NY,NX) -C 2,HWFLQM,HFLW1,HWFLV1,HFLCR1,HFLWRL(NY,NX),HWFLYM -C 3,HFLR1,HWFLV1,HFLCR1 -3376 FORMAT(A8,5I4,40E12.4) + FLWVL(NUM(NY,NX),NY,NX)=RFLWV(NY,NX)*(VOLW1(NUM(NY,NX),NY,NX) + 2-VOLWX1(NUM(NY,NX),NY,NX)) + FLWV(NUM(NY,NX),NY,NX)=FLWV(NUM(NY,NX),NY,NX) + 2+FLWVL(NUM(NY,NX),NY,NX) +C IF(I.GE.110.AND.NX.EQ.2)THEN +C WRITE(*,3376)'FLW1',I,J,M,NX,NY,NUM(NY,NX) +C 2,FLWL(3,NUM(NY,NX),NY,NX) +C 2,PSISM1(0,NY,NX),PSISM1(NUM(NY,NX),NY,NX),VOLWRX(NY,NX) +C 3,VOLW1(0,NY,NX),VOLW1(NUM(NY,NX),NY,NX) +C 3,THETWX(NUM(NY,NX),NY,NX) +C 2,FLQM,EVAP(NY,NX),PARE,VPQ(NY,NX),VP1,TK1(NUM(NY,NX),NY,NX) +C 4,FLWRL(NY,NX),FLYM,EVAPR(NY,NX),FLV1,VOLX(NUM(NY,NX),NY,NX) +C WRITE(*,3376)'FLWHL',I,J,M,NX,NY,NUM(NY,NX) +C 2,FLWHL(3,NUM(NY,NX),NY,NX),FLHM +C 2,HFLWL(3,NUM(NY,NX),NY,NX),HFLW1,RFLX,EFLX,SFLX,VFLX +C 2,HWFLQM,HWFLV1,HFLCR1,HFLWRL(NY,NX),HWFLYM +C 3,HFLR1,HWFLV1,HFLCR1,TK1(NUM(NY,NX),NY,NX) +3376 FORMAT(A8,6I4,40E12.4) C ENDIF C C HEAT AND WATER TRANSFER WITH RESIDUAL SNOWPACK @@ -1411,114 +1448,128 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) C CNDR=HCNDR(NY,NX)*(PSISE(0,NY,NX)/PSISM1(0,NY,NX))**3 IF(VOLW1(0,NY,NX).GE.VOLWRX(NY,NX))THEN - CND1=HCND(3,1,NU(NY,NX),NY,NX)*XNPH + CND1=HCND(3,1,NUM(NY,NX),NY,NX)*XNPH ELSE - K1=MAX(1,MIN(100,INT(100.0*(AMAX1(0.0,POROS(NU(NY,NX),NY,NX) - 2-THETWX(NU(NY,NX),NY,NX)))/POROS(NU(NY,NX),NY,NX))+1)) - CND1=HCND(3,K1,NU(NY,NX),NY,NX)*XNPH + K1=MAX(1,MIN(100,INT(100.0*(AMAX1(0.0,POROS(NUM(NY,NX),NY,NX) + 2-THETWX(NUM(NY,NX),NY,NX)))/POROS(NUM(NY,NX),NY,NX))+1)) + CND1=HCND(3,K1,NUM(NY,NX),NY,NX)*XNPH ENDIF - AVCND1=2.0*CNDR*CND1/(CNDR*DLYR(3,NU(NY,NX),NY,NX) + AVCND1=2.0*CNDR*CND1/(CNDR*DLYR(3,NUM(NY,NX),NY,NX) 2+CND1*DLYRR(NY,NX)) - FLXQR=AVCND1*(PSISM1(0,NY,NX)-PSISM1(NU(NY,NX),NY,NX)) - 2*AREA(3,NU(NY,NX),NY,NX) + FLXQR=AVCND1*(PSISM1(0,NY,NX)-PSISM1(NUM(NY,NX),NY,NX)) + 2*AREA(3,NUM(NY,NX),NY,NX) IF(FLXQR.LT.0.0)THEN - FLXSR=AMAX1(FLXQR,-XNPH*AMIN1(VOLW1(NU(NY,NX),NY,NX) + FLXSR=AMAX1(FLXQR,-XH(3,NUM(NY,NX),NY,NX) + 2*AMIN1(VOLW1(NUM(NY,NX),NY,NX) 2,AMAX1(0.0,VOLWRX(NY,NX)-VOLW1(0,NY,NX)-VOLI1(0,NY,NX)))) ELSE - FLXSR=AMIN1(FLXQR,XNPH*VOLW1(0,NY,NX)) - FLXSR=AMIN1(FLXSR,XNPH*VOLP1(NU(NY,NX),NY,NX)) + FLXSR=AMIN1(FLXQR,XH(3,0,NY,NX)*VOLW1(0,NY,NX)) + FLXSR=AMIN1(FLXSR,XH(3,NUM(NY,NX),NY,NX) + 2*VOLP1(NUM(NY,NX),NY,NX)) ENDIF IF(FLXSR.GT.0.0)THEN HFLXSR=4.19*TK1(0,NY,NX)*FLXSR ELSE - HFLXSR=4.19*TK1(NU(NY,NX),NY,NX)*FLXSR + HFLXSR=4.19*TK1(NUM(NY,NX),NY,NX)*FLXSR ENDIF - FLWL(3,NU(NY,NX),NY,NX)=FLWL(3,NU(NY,NX),NY,NX)+FLXSR - HFLWL(3,NU(NY,NX),NY,NX)=HFLWL(3,NU(NY,NX),NY,NX)+HFLXSR + FLWL(3,NUM(NY,NX),NY,NX)=FLWL(3,NUM(NY,NX),NY,NX)+FLXSR + HFLWL(3,NUM(NY,NX),NY,NX)=HFLWL(3,NUM(NY,NX),NY,NX)+HFLXSR FLWRL(NY,NX)=FLWRL(NY,NX)-FLXSR HFLWRL(NY,NX)=HFLWRL(NY,NX)-HFLXSR FLWRM(M,NY,NX)=FLXSR -C IF(NX.EQ.1.AND.NY.EQ.6)THEN -C WRITE(*,4322)'FLWLY',I,J,M,NX,NY,FLWRL(NY,NX),FLWLY,FLWLYR -C 2,FLWLYH,FLXSR,VOLX(NU(NY,NX),NY,NX),VOLA(NU(NY,NX),NY,NX) -C 3,VOLP1(NU(NY,NX),NY,NX),VOLW1(NU(NY,NX),NY,NX) -C 3,VOLI1(NU(NY,NX),NY,NX),VOLP1(0,NY,NX),VOLW1(0,NY,NX) +C IF(IYRC.EQ.2006.AND.I.EQ.361)THEN +C WRITE(*,4322)'FLXSR',I,J,M,NX,NY,FLWRL(NY,NX) +C 2,FLWL(3,NUM(NY,NX),NY,NX),FLWLY,FLWLYR +C 2,FLWLYH,FLXSR,VOLX(NUM(NY,NX),NY,NX),VOLA(NUM(NY,NX),NY,NX) +C 3,VOLP1(NUM(NY,NX),NY,NX),VOLW1(NUM(NY,NX),NY,NX) +C 3,VOLI1(NUM(NY,NX),NY,NX),VOLP1(0,NY,NX),VOLW1(0,NY,NX) C 3,VOLI1(0,NY,NX),FLXQR,PSISM1(0,NY,NX) -C 4,PSISM1(NU(NY,NX),NY,NX),AVCND1 -C 2,VOLAH1(NU(NY,NX),NY,NX),VOLPH1(NU(NY,NX),NY,NX) -C 2,VOLWH1(NU(NY,NX),NY,NX),VOLIH1(NU(NY,NX),NY,NX) -4322 FORMAT(A8,5I4,40E12.4) +C 4,PSISM1(NUM(NY,NX),NY,NX),AVCND1 +C 2,VOLAH1(NUM(NY,NX),NY,NX),VOLPH1(NUM(NY,NX),NY,NX) +C 2,VOLWH1(NUM(NY,NX),NY,NX),VOLIH1(NUM(NY,NX),NY,NX) +4322 FORMAT(A8,5I4,40E12.4) C ENDIF C C MOVE WATER UP DURING PRECIPITATION OR FREEZING C - IF(VOLW1(NU(NY,NX),NY,NX)+VOLI1(NU(NY,NX),NY,NX) - 2.GT.VOLA(NU(NY,NX),NY,NX))THEN - FLWLY=AMIN1(0.0,AMAX1(-XNPH*VOLW1(NU(NY,NX),NY,NX) - 2,VOLA(NU(NY,NX),NY,NX)-VOLW1(NU(NY,NX),NY,NX) - 3-VOLI1(NU(NY,NX),NY,NX))) - HFLWLY=FLWLY*4.19*TK1(NU(NY,NX),NY,NX) - FLWL(3,NU(NY,NX),NY,NX)=FLWL(3,NU(NY,NX),NY,NX)+FLWLY - HFLWL(3,NU(NY,NX),NY,NX)=HFLWL(3,NU(NY,NX),NY,NX)+HFLWLY - FLWLYR=AMIN1(0.0,FLWLY+VOLPH1(NU(NY,NX),NY,NX)) - HFLWYR=FLWLYR*4.19*TK1(NU(NY,NX),NY,NX) + IF(BKDS(NUM(NY,NX),NY,NX).GT.ZERO)THEN + IF(VOLW1(NUM(NY,NX),NY,NX)+VOLI1(NUM(NY,NX),NY,NX) + 2.GT.VOLA(NUM(NY,NX),NY,NX))THEN + FLWLY=AMIN1(0.0,AMAX1(-XH(3,NUM(NY,NX),NY,NX) + 2*VOLW1(NUM(NY,NX),NY,NX),VOLA(NUM(NY,NX),NY,NX) + 3-VOLW1(NUM(NY,NX),NY,NX)-VOLI1(NUM(NY,NX),NY,NX))) + HFLWLY=FLWLY*4.19*TK1(NUM(NY,NX),NY,NX) + FLWL(3,NUM(NY,NX),NY,NX)=FLWL(3,NUM(NY,NX),NY,NX)+FLWLY + HFLWL(3,NUM(NY,NX),NY,NX)=HFLWL(3,NUM(NY,NX),NY,NX)+HFLWLY + FLWLYR=AMIN1(0.0,FLWLY+VOLPH1(NUM(NY,NX),NY,NX)) + HFLWYR=FLWLYR*4.19*TK1(NUM(NY,NX),NY,NX) FLWLYH=FLWLY-FLWLYR - HFLWYH=FLWLYH*4.19*TK1(NU(NY,NX),NY,NX) + HFLWYH=FLWLYH*4.19*TK1(NUM(NY,NX),NY,NX) FLWRL(NY,NX)=FLWRL(NY,NX)-FLWLYR HFLWRL(NY,NX)=HFLWRL(NY,NX)-HFLWYR - FLWHL(3,NU(NY,NX),NY,NX)=FLWHL(3,NU(NY,NX),NY,NX)-FLWLYH - HFLWL(3,NU(NY,NX),NY,NX)=HFLWL(3,NU(NY,NX),NY,NX)-HFLWYH - ENDIF - IF(VOLWH1(NU(NY,NX),NY,NX)+VOLIH1(NU(NY,NX),NY,NX) - 2.GT.VOLAH1(NU(NY,NX),NY,NX))THEN - FLWHY=AMIN1(0.0,AMAX1(-XNPH*VOLWH1(NU(NY,NX),NY,NX) - 2,VOLAH1(NU(NY,NX),NY,NX)-VOLWH1(NU(NY,NX),NY,NX) - 3-VOLIH1(NU(NY,NX),NY,NX))) - HFLWHY=FLWHY*4.19*TK1(NU(NY,NX),NY,NX) - FLWHL(3,NU(NY,NX),NY,NX)=FLWHL(3,NU(NY,NX),NY,NX)+FLWHY - HFLWL(3,NU(NY,NX),NY,NX)=HFLWL(3,NU(NY,NX),NY,NX)+HFLWHY + FLWHL(3,NUM(NY,NX),NY,NX)=FLWHL(3,NUM(NY,NX),NY,NX)-FLWLYH + HFLWL(3,NUM(NY,NX),NY,NX)=HFLWL(3,NUM(NY,NX),NY,NX)-HFLWYH +C IF(I.GE.110.AND.NX.EQ.2)THEN +C WRITE(*,4323)'FLWLY',I,J,M,NX,NY,FLWRL(NY,NX) +C 2,FLWL(3,NUM(NY,NX),NY,NX),FLWLY +C 2,VOLAH1(NUM(NY,NX),NY,NX),VOLPH1(NUM(NY,NX),NY,NX) +C 2,VOLWH1(NUM(NY,NX),NY,NX),VOLIH1(NUM(NY,NX),NY,NX) +C 2,VOLAH1(NUM(NY,NX)+1,NY,NX),VOLPH1(NUM(NY,NX)+1,NY,NX) +C 2,VOLWH1(NUM(NY,NX)+1,NY,NX),VOLIH1(NUM(NY,NX)+1,NY,NX) +C 3,VOLW1(0,NY,NX) +4323 FORMAT(A8,5I4,30E12.4) +C ENDIF + ENDIF + IF(VOLWH1(NUM(NY,NX),NY,NX)+VOLIH1(NUM(NY,NX),NY,NX) + 2.GT.VOLAH1(NUM(NY,NX),NY,NX))THEN + FLWHY=AMIN1(0.0,AMAX1(-XH(3,NUM(NY,NX),NY,NX) + 2*VOLWH1(NUM(NY,NX),NY,NX),VOLAH1(NUM(NY,NX),NY,NX) + 3-VOLWH1(NUM(NY,NX),NY,NX)-VOLIH1(NUM(NY,NX),NY,NX))) + HFLWHY=FLWHY*4.19*TK1(NUM(NY,NX),NY,NX) + FLWHL(3,NUM(NY,NX),NY,NX)=FLWHL(3,NUM(NY,NX),NY,NX)+FLWHY + HFLWL(3,NUM(NY,NX),NY,NX)=HFLWL(3,NUM(NY,NX),NY,NX)+HFLWHY FLWRL(NY,NX)=FLWRL(NY,NX)-FLWHY - HFLWRL(NY,NX)=HFLWRL(NY,NX)-HFLWHY -C IF(NX.EQ.1.AND.NY.EQ.6)THEN -C WRITE(*,4324)'FLWHY',I,J,M,NX,NY,FLWRL(NY,NX),FLWHY -C 2,VOLAH1(NU(NY,NX),NY,NX),VOLPH1(NU(NY,NX),NY,NX) -C 2,VOLWH1(NU(NY,NX),NY,NX),VOLIH1(NU(NY,NX),NY,NX) -C 2,VOLAH1(NU(NY,NX)+1,NY,NX),VOLPH1(NU(NY,NX)+1,NY,NX) -C 2,VOLWH1(NU(NY,NX)+1,NY,NX),VOLIH1(NU(NY,NX)+1,NY,NX) + HFLWRL(NY,NX)=HFLWRL(NY,NX)-HFLWHY +C IF(I.GE.110.AND.NX.EQ.2)THEN +C WRITE(*,4324)'FLWHY',I,J,M,NX,NY,FLWRL(NY,NX) +C 2,FLWL(3,NUM(NY,NX),NY,NX),FLWHY +C 2,VOLAH1(NUM(NY,NX),NY,NX),VOLPH1(NUM(NY,NX),NY,NX) +C 2,VOLWH1(NUM(NY,NX),NY,NX),VOLIH1(NUM(NY,NX),NY,NX) +C 2,VOLAH1(NUM(NY,NX)+1,NY,NX),VOLPH1(NUM(NY,NX)+1,NY,NX) +C 2,VOLWH1(NUM(NY,NX)+1,NY,NX),VOLIH1(NUM(NY,NX)+1,NY,NX) C 3,VOLW1(0,NY,NX) 4324 FORMAT(A8,5I4,30E12.4) C ENDIF ENDIF + ENDIF C IF((I/10)*10.EQ.I)THEN C WRITE(*,4321)'HCNDR',I,J,M,NX,NY,K1,AVCND1,CNDR,CND1,DLYRR(NY,NX) -C 2,PSISM1(0,NY,NX),PSISM1(NU(NY,NX),NY,NX),FLXQR,FLXSR,HFLXSR +C 2,PSISM1(0,NY,NX),PSISM1(NUM(NY,NX),NY,NX),FLXQR,FLXSR,HFLXSR C 3,VOLWR2,TRA0(NY,NX),EVAPR(NY,NX),VOLWRX(NY,NX)-VOLW1(0,NY,NX) -C 2-VOLI1(0,NY,NX),VOLW1(NU(NY,NX),NY,NX),VOLW1(0,NY,NX) -C 4,VOLP1(NU(NY,NX),NY,NX),POROS(NU(NY,NX),NY,NX) +C 2-VOLI1(0,NY,NX),VOLW1(NUM(NY,NX),NY,NX),VOLW1(0,NY,NX) +C 4,VOLP1(NUM(NY,NX),NY,NX),POROS(NUM(NY,NX),NY,NX) C 5,VOLWG(NY,NX),FLYM,HCNDR(NY,NX),PSISE(0,NY,NX),PSISM1(0,NY,NX) -C 6,THETWR,VHCPR1(NY,NX),VHCPRX(NY,NX) +C 6,THETWR,VHCP1(0,NY,NX),VHCPRX(NY,NX) 4321 FORMAT(A8,6I4,30E12.4) C ENDIF C C OVERLAND FLOW INTO MACROPORES WHEN WATER STORAGE CAPACITY C OF THE SOIL SURFACE IS EXCEEDED C - IF(VOLPH1(NU(NY,NX),NY,NX).GT.0.0)THEN + IF(VOLPH1(NUM(NY,NX),NY,NX).GT.0.0)THEN IF(VOLW1(0,NY,NX).GT.VOLWRX(NY,NX))THEN - AVCNH1=2.0*CNDH1(NU(NY,NX),NY,NX)/DLYR(3,NU(NY,NX),NY,NX) - FLWHX=AVCNH1*0.0098*DPTH(NU(NY,NX),NY,NX)*AREA(3,NU(NY,NX),NY,NX) - FINHR=AMIN1(VOLPH1(NU(NY,NX),NY,NX) - 2,VOLW1(0,NY,NX)-VOLWRX(NY,NX),FLWHX) + FINHR=AMIN1(VOLPH1(NUM(NY,NX),NY,NX) + 2,VOLW1(0,NY,NX)-VOLWRX(NY,NX)) HFINHR=FINHR*4.19*TK1(0,NY,NX) FLWRL(NY,NX)=FLWRL(NY,NX)-FINHR HFLWRL(NY,NX)=HFLWRL(NY,NX)-HFINHR - FLWHL(3,NU(NY,NX),NY,NX)=FLWHL(3,NU(NY,NX),NY,NX)+FINHR - HFLWL(3,NU(NY,NX),NY,NX)=HFLWL(3,NU(NY,NX),NY,NX)+HFINHR -C IF(NX.EQ.1.AND.NY.EQ.6)THEN + FLWHL(3,NUM(NY,NX),NY,NX)=FLWHL(3,NUM(NY,NX),NY,NX)+FINHR + HFLWL(3,NUM(NY,NX),NY,NX)=HFLWL(3,NUM(NY,NX),NY,NX)+HFINHR +C IF(I.GE.110.AND.NX.EQ.2)THEN C WRITE(*,4357)'FINHR',I,J,M,NX,NY,FLWRL(NY,NX),FINHR -C 2,VOLPH1(NU(NY,NX),NY,NX),TVOLW(NY,NX),FLWHX,VOLW1(0,NY,NX) -C 3,VOLWRX(NY,NX),FLWHL(3,NU(NY,NX),NY,NX) -C 4,HFINHR,TK1(0,NY,NX),HFLWRL(NY,NX),HFLWL(3,NU(NY,NX),NY,NX) +C 2,FLWHL(3,NUM(NY,NX),NY,NX),VOLPH1(NUM(NY,NX),NY,NX) +C 3,TVOLW(NY,NX),VOLW1(0,NY,NX),VOLWRX(NY,NX) +C 4,HFINHR,TK1(0,NY,NX),HFLWRL(NY,NX),HFLWL(3,NUM(NY,NX),NY,NX) 4357 FORMAT(A8,5I4,40E12.4) C ENDIF ENDIF @@ -1534,12 +1585,12 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) 4.AND.VOLI1(0,NY,NX).GT.ZERO*VOLA(0,NY,NX)))THEN TFLX1=1.0/(1.0+TFREEZ*6.2913E-03) 2*(TFREEZ*4.19*FLWRL(NY,NX) - 3+VHCPR1(NY,NX)*(TFREEZ-TK1(0,NY,NX)) + 3+VHCP1(0,NY,NX)*(TFREEZ-TK1(0,NY,NX)) 4-HFLWRL(NY,NX)) IF(TFLX1.LT.0.0)THEN - TFLX=AMAX1(-333.0*DENSI*VOLI1(0,NY,NX)*XNPH,TFLX1) + TFLX=AMAX1(-333.0*DENSI*VOLI1(0,NY,NX)*XH(3,0,NY,NX),TFLX1) ELSE - TFLX=AMIN1(333.0*VOLW1(0,NY,NX)*XNPH,TFLX1) + TFLX=AMIN1(333.0*VOLW1(0,NY,NX)*XH(3,0,NY,NX),TFLX1) ENDIF WFLX=-TFLX/333.0 IF(WFLX.GT.0.0.AND.VOLI1(0,NY,NX) @@ -1567,92 +1618,96 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) C SURFACE HEAT STORAGE C TFREEZ=-9.0959E+04/(PSISV1-333.0) - IF((TK1(NU(NY,NX),NY,NX).LT.TFREEZ - 2.AND.VOLW1(NU(NY,NX),NY,NX).GT.ZERO*VOLA(NU(NY,NX),NY,NX) - 3.AND.VOLI1(NU(NY,NX),NY,NX).LT.VOLA(NU(NY,NX),NY,NX)) - 4.OR.(TK1(NU(NY,NX),NY,NX).GT.TFREEZ - 5.AND.VOLI1(NU(NY,NX),NY,NX).GT.ZERO*VOLA(NU(NY,NX),NY,NX)))THEN - TFLX1=FGRD(NU(NY,NX),NY,NX)*(1.0/(1.0+TFREEZ*6.2913E-03) - 2*(TFREEZ*4.19*(FLWL(3,NU(NY,NX),NY,NX)+FLWHL(3,NU(NY,NX),NY,NX)) - 3+VHCP1(NU(NY,NX),NY,NX)*(TFREEZ-TK1(NU(NY,NX),NY,NX)) - 4-HFLWL(3,NU(NY,NX),NY,NX))) + IF((TK1(NUM(NY,NX),NY,NX).LT.TFREEZ + 2.AND.VOLW1(NUM(NY,NX),NY,NX).GT.ZERO*VOLA(NUM(NY,NX),NY,NX) + 3.AND.VOLI1(NUM(NY,NX),NY,NX).LT.VOLA(NUM(NY,NX),NY,NX)) + 4.OR.(TK1(NUM(NY,NX),NY,NX).GT.TFREEZ + 5.AND.VOLI1(NUM(NY,NX),NY,NX).GT.ZERO*VOLA(NUM(NY,NX),NY,NX)))THEN + TFLX1=FGRD(NUM(NY,NX),NY,NX)*(1.0/(1.0+TFREEZ*6.2913E-03) + 2*(TFREEZ*4.19*(FLWL(3,NUM(NY,NX),NY,NX)+FLWHL(3,NUM(NY,NX),NY,NX)) + 3+VHCP1(NUM(NY,NX),NY,NX)*(TFREEZ-TK1(NUM(NY,NX),NY,NX)) + 4-HFLWL(3,NUM(NY,NX),NY,NX))) IF(TFLX1.LT.0.0)THEN - TFLX=AMAX1(-333.0*DENSI*VOLI1(NU(NY,NX),NY,NX)*XNPH,TFLX1) + TFLX=AMAX1(-333.0*DENSI*VOLI1(NUM(NY,NX),NY,NX) + 2*XH(3,NUM(NY,NX),NY,NX),TFLX1) ELSE - TFLX=AMIN1(333.0*VOLW1(NU(NY,NX),NY,NX)*XNPH,TFLX1) + TFLX=AMIN1(333.0*VOLW1(NUM(NY,NX),NY,NX) + 2*XH(3,NUM(NY,NX),NY,NX),TFLX1) ENDIF WFLX=-TFLX/333.0 - IF(WFLX.GT.0.0.AND.VOLI1(NU(NY,NX),NY,NX) + IF(WFLX.GT.0.0.AND.VOLI1(NUM(NY,NX),NY,NX) 2.GT.ZEROS(NY,NX))THEN - WFLXL(3,NU(NY,NX),NY,NX)=WFLX - ELSEIF(WFLX.LT.0.0.AND.VOLW1(NU(NY,NX),NY,NX) + WFLXL(3,NUM(NY,NX),NY,NX)=WFLX + ELSEIF(WFLX.LT.0.0.AND.VOLW1(NUM(NY,NX),NY,NX) 2.GT.ZEROS(NY,NX))THEN - WFLXL(3,NU(NY,NX),NY,NX)=WFLX + WFLXL(3,NUM(NY,NX),NY,NX)=WFLX ELSE TFLX=0.0 - WFLXL(3,NU(NY,NX),NY,NX)=0.0 + WFLXL(3,NUM(NY,NX),NY,NX)=0.0 ENDIF ELSE TFLX=0.0 - WFLXL(3,NU(NY,NX),NY,NX)=0.0 + WFLXL(3,NUM(NY,NX),NY,NX)=0.0 ENDIF C C FREEZE-THAW IN SOIL SURFACE MACROPORE FROM NET CHANGE IN SOIL C SURFACE HEAT STORAGE C - IF((TK1(NU(NY,NX),NY,NX).LT.273.15.AND.VOLWH1(NU(NY,NX),NY,NX) - 2.GT.ZERO*VOLT(NU(NY,NX),NY,NX)).OR.(TK1(NU(NY,NX),NY,NX) - 3.GT.273.15.AND.VOLIH1(NU(NY,NX),NY,NX) - 4.GT.ZERO*VOLT(NU(NY,NX),NY,NX)))THEN - TFLX1=FMAC(NU(NY,NX),NY,NX)*(1.0/(1.0+273.15*6.2913E-03) - 2*(273.15*4.19*(FLWL(3,NU(NY,NX),NY,NX)+FLWHL(3,NU(NY,NX),NY,NX)) - 3+VHCP1(NU(NY,NX),NY,NX)*(273.15-TK1(NU(NY,NX),NY,NX)) - 4-HFLWL(3,NU(NY,NX),NY,NX))) + IF((TK1(NUM(NY,NX),NY,NX).LT.273.15.AND.VOLWH1(NUM(NY,NX),NY,NX) + 2.GT.ZERO*VOLT(NUM(NY,NX),NY,NX)).OR.(TK1(NUM(NY,NX),NY,NX) + 3.GT.273.15.AND.VOLIH1(NUM(NY,NX),NY,NX) + 4.GT.ZERO*VOLT(NUM(NY,NX),NY,NX)))THEN + TFLX1=FMAC(NUM(NY,NX),NY,NX)*(1.0/(1.0+273.15*6.2913E-03) + 2*(273.15*4.19*(FLWL(3,NUM(NY,NX),NY,NX)+FLWHL(3,NUM(NY,NX),NY,NX)) + 3+VHCP1(NUM(NY,NX),NY,NX)*(273.15-TK1(NUM(NY,NX),NY,NX)) + 4-HFLWL(3,NUM(NY,NX),NY,NX))) IF(TFLX1.LT.0.0)THEN - TFLXH=AMAX1(-333.0*DENSI*VOLIH1(NU(NY,NX),NY,NX)*XNPH,TFLX1) + TFLXH=AMAX1(-333.0*DENSI*VOLIH1(NUM(NY,NX),NY,NX) + 2*XH(3,NUM(NY,NX),NY,NX),TFLX1) ELSE - TFLXH=AMIN1(333.0*VOLWH1(NU(NY,NX),NY,NX)*XNPH,TFLX1) + TFLXH=AMIN1(333.0*VOLWH1(NUM(NY,NX),NY,NX) + 2*XH(3,NUM(NY,NX),NY,NX),TFLX1) ENDIF WFLXH=-TFLXH/333.0 - IF(WFLXH.GT.0.0.AND.VOLIH1(NU(NY,NX),NY,NX) + IF(WFLXH.GT.0.0.AND.VOLIH1(NUM(NY,NX),NY,NX) 2.GT.ZEROS(NY,NX))THEN - WFLXLH(3,NU(NY,NX),NY,NX)=WFLXH - ELSEIF(WFLXH.LT.0.0.AND.VOLWH1(NU(NY,NX),NY,NX) + WFLXLH(3,NUM(NY,NX),NY,NX)=WFLXH + ELSEIF(WFLXH.LT.0.0.AND.VOLWH1(NUM(NY,NX),NY,NX) 2.GT.ZEROS(NY,NX))THEN - WFLXLH(3,NU(NY,NX),NY,NX)=WFLXH + WFLXLH(3,NUM(NY,NX),NY,NX)=WFLXH ELSE TFLXH=0.0 - WFLXLH(3,NU(NY,NX),NY,NX)=0.0 + WFLXLH(3,NUM(NY,NX),NY,NX)=0.0 ENDIF ELSE TFLXH=0.0 - WFLXLH(3,NU(NY,NX),NY,NX)=0.0 + WFLXLH(3,NUM(NY,NX),NY,NX)=0.0 ENDIF - TFLXL(3,NU(NY,NX),NY,NX)=TFLX+TFLXH + TFLXL(3,NUM(NY,NX),NY,NX)=TFLX+TFLXH C IF(NY.EQ.1)THEN -C WRITE(*,4358)'TFLX',I,J,M,TFREEZ,TK1(NU(NY,NX),NY,NX),PSISV1 -C 2,TFLX,TFLXH,TFLXL(3,NU(NY,NX),NY,NX),WFLX,WFLXH -C 2,WFLXL(3,NU(NY,NX),NY,NX),WFLXLH(3,NU(NY,NX),NY,NX) -C 4,VOLW1(NU(NY,NX),NY,NX),VOLWH1(NU(NY,NX),NY,NX) -C 4,VOLI1(NU(NY,NX),NY,NX),VOLIH1(NU(NY,NX),NY,NX) -C 5,FGRD(NU(NY,NX),NY,NX),FMAC(NU(NY,NX),NY,NX) +C WRITE(*,4358)'TFLX',I,J,M,TFREEZ,TK1(NUM(NY,NX),NY,NX),PSISV1 +C 2,TFLX,TFLXH,TFLXL(3,NUM(NY,NX),NY,NX),WFLX,WFLXH +C 2,WFLXL(3,NUM(NY,NX),NY,NX),WFLXLH(3,NUM(NY,NX),NY,NX) +C 4,VOLW1(NUM(NY,NX),NY,NX),VOLWH1(NUM(NY,NX),NY,NX) +C 4,VOLI1(NUM(NY,NX),NY,NX),VOLIH1(NUM(NY,NX),NY,NX) +C 5,FGRD(NUM(NY,NX),NY,NX),FMAC(NUM(NY,NX),NY,NX) 4358 FORMAT(A8,3I4,20E12.4) C ENDIF C C C THICKNESS OF WATER FILMS FOR GAS EXCHANGE IN 'TRNSFR' C - IF(VHCPR1(NY,NX).GT.VHCPRX(NY,NX))THEN + IF(VHCP1(0,NY,NX).GT.VHCPRX(NY,NX))THEN FILM(M,0,NY,NX)=AMAX1(1.0E-06 2,EXP(-13.650-0.857*LOG(-PSISM1(0,NY,NX)))) ELSE FILM(M,0,NY,NX)=1.0E-03 ENDIF -C IF(BKVL(NU(NY,NX),NY,NX).GT.0.0)THEN - FILM(M,NU(NY,NX),NY,NX)=AMAX1(1.0E-06 - 2,EXP(-13.650-0.857*LOG(-PSISM1(NU(NY,NX),NY,NX)))) +C IF(BKVL(NUM(NY,NX),NY,NX).GT.0.0)THEN + FILM(M,NUM(NY,NX),NY,NX)=AMAX1(1.0E-06 + 2,EXP(-13.650-0.857*LOG(-PSISM1(NUM(NY,NX),NY,NX)))) C ELSE -C FILM(M,NU(NY,NX),NY,NX)=DLYR(3,NU(NY,NX),NY,NX) +C FILM(M,NUM(NY,NX),NY,NX)=DLYR(3,NUM(NY,NX),NY,NX) C ENDIF C C OVERLAND FLOW WHEN WATER STORAGE CAPACITY @@ -1672,7 +1727,7 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) ELSE N4=NX+1 N5=NY - WDTH=DLYR(2,NU(NY,NX),NY,NX) + WDTH=DLYR(2,NUM(NY,NX),NY,NX) ENDIF ELSEIF(N.EQ.2)THEN IF(NY.EQ.NVS)THEN @@ -1680,7 +1735,7 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) ELSE N4=NX N5=NY+1 - WDTH=DLYR(1,NU(NY,NX),NY,NX) + WDTH=DLYR(1,NUM(NY,NX),NY,NX) ENDIF ENDIF C @@ -1688,14 +1743,14 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) C TVOLZ2=AMAX1(0.0,VOLW1(0,N5,N4)+VOLI1(0,N5,N4)-VOLWRX(N5,N4)) VOLWZ2=AMAX1(0.0,VOLW1(0,N5,N4)-VOLWRX(N5,N4)) - ALT1=ALTG(N2,N1)+TVOLZ1/AREA(3,NU(N2,N1),N2,N1) + ALT1=ALTG(N2,N1)+TVOLZ1/AREA(3,NUM(N2,N1),N2,N1) ALT2=ALTG(N5,N4)+TVOLZ2/AREA(3,NU(N5,N4),N5,N4) C C EXCESS SURFACE WATER DEPTH, WETTED PERIMETER, SLOPE, VELOCITY C IF(ALT1.GT.ALT2.AND.TVOLZ1.GT.VOLWG(N2,N1))THEN QRX1=TVOLZ1-VOLWG(N2,N1) - D=QRX1/AREA(3,NU(N2,N1),N2,N1) + D=QRX1/AREA(3,NUM(N2,N1),N2,N1) R=D/2.828 S=(ALT1-ALT2)/DIST(N,NU(N5,N4),N5,N4) V=R**0.67*SQRT(S)/ZM(N2,N1) @@ -1703,10 +1758,10 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) C RUNOFF C Q=V*D*AMIN1(1.0,D/ZS(N2,N1))*WDTH*3.6E+03*XNPH - QRQ1=AMAX1(0.0,((ALT1-ALT2)*AREA(3,NU(N2,N1),N2,N1) - 2*AREA(3,NU(N5,N4),N5,N4)-TVOLZ2*AREA(3,NU(N2,N1),N2,N1) + QRQ1=AMAX1(0.0,((ALT1-ALT2)*AREA(3,NUM(N2,N1),N2,N1) + 2*AREA(3,NU(N5,N4),N5,N4)-TVOLZ2*AREA(3,NUM(N2,N1),N2,N1) 3+TVOLZ1*AREA(3,NU(N5,N4),N5,N4)) - 4/(AREA(3,NU(N2,N1),N2,N1)+AREA(3,NU(N5,N4),N5,N4))) + 4/(AREA(3,NUM(N2,N1),N2,N1)+AREA(3,NU(N5,N4),N5,N4))) QR1(N,N5,N4)=AMIN1(Q,0.25*QRQ1,0.25*QRX1)*VOLWZ1/TVOLZ1 HQR1(N,N5,N4)=4.19*TK1(0,N2,N1)*QR1(N,N5,N4) C @@ -1723,10 +1778,10 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) C Q=V*D*AMIN1(1.0,D/ZS(N5,N4))*DLYR(N,NU(N5,N4),N5,N4) 2*3.6E+03*XNPH - QRQ1=AMIN1(0.0,((ALT1-ALT2)*AREA(3,NU(N2,N1),N2,N1) - 2*AREA(3,NU(N5,N4),N5,N4)-TVOLZ2*AREA(3,NU(N2,N1),N2,N1) + QRQ1=AMIN1(0.0,((ALT1-ALT2)*AREA(3,NUM(N2,N1),N2,N1) + 2*AREA(3,NU(N5,N4),N5,N4)-TVOLZ2*AREA(3,NUM(N2,N1),N2,N1) 3+TVOLZ1*AREA(3,NU(N5,N4),N5,N4)) - 4/(AREA(3,NU(N2,N1),N2,N1)+AREA(3,NU(N5,N4),N5,N4))) + 4/(AREA(3,NUM(N2,N1),N2,N1)+AREA(3,NU(N5,N4),N5,N4))) QR1(N,N5,N4)=AMAX1(-Q,0.25*QRQ1,-0.25*QRX1)*VOLWZ2/TVOLZ2 HQR1(N,N5,N4)=4.19*TK1(0,N5,N4)*QR1(N,N5,N4) ELSE @@ -1738,8 +1793,7 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) HQR(N,N5,N4)=HQR(N,N5,N4)+HQR1(N,N5,N4) QRM(M,N,N5,N4)=QR1(N,N5,N4) QRV(M,N,N5,N4)=V -C IF(I.EQ.186)THEN -C WRITE(*,5555)'QR1',I,J,M,N1,N2,N4,N5,N,QR1(N,N5,N4) +C IF(I.EQ.168)THEN C 2,ALT1,ALT2,ALTG(N2,N1),ALTG(N5,N4),QRX1,D,R,S,V,Q,QRQ1 C 2,VOLW1(0,N2,N1),VOLI1(0,N2,N1) C 3,VOLW1(0,N5,N4),VOLI1(0,N5,N4) @@ -1793,20 +1847,20 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) C THAWR(NY,NX)=THAWR(NY,NX)+WFLXR(NY,NX) HTHAWR(NY,NX)=HTHAWR(NY,NX)+TFLXR(NY,NX) - THAW(3,NU(NY,NX),NY,NX)=THAW(3,NU(NY,NX),NY,NX) - 2+WFLXL(3,NU(NY,NX),NY,NX) - THAWH(3,NU(NY,NX),NY,NX)=THAWH(3,NU(NY,NX),NY,NX) - 2+WFLXLH(3,NU(NY,NX),NY,NX) - HTHAW(3,NU(NY,NX),NY,NX)=HTHAW(3,NU(NY,NX),NY,NX) - 2+TFLXL(3,NU(NY,NX),NY,NX) - FLW(3,NU(NY,NX),NY,NX)=FLW(3,NU(NY,NX),NY,NX) - 2+FLWL(3,NU(NY,NX),NY,NX) - FLWX(3,NU(NY,NX),NY,NX)=FLWX(3,NU(NY,NX),NY,NX) - 2+FLWLX(3,NU(NY,NX),NY,NX) - FLWH(3,NU(NY,NX),NY,NX)=FLWH(3,NU(NY,NX),NY,NX) - 2+FLWHL(3,NU(NY,NX),NY,NX) - HFLW(3,NU(NY,NX),NY,NX)=HFLW(3,NU(NY,NX),NY,NX) - 2+HFLWL(3,NU(NY,NX),NY,NX) + THAW(3,NUM(NY,NX),NY,NX)=THAW(3,NUM(NY,NX),NY,NX) + 2+WFLXL(3,NUM(NY,NX),NY,NX) + THAWH(3,NUM(NY,NX),NY,NX)=THAWH(3,NUM(NY,NX),NY,NX) + 2+WFLXLH(3,NUM(NY,NX),NY,NX) + HTHAW(3,NUM(NY,NX),NY,NX)=HTHAW(3,NUM(NY,NX),NY,NX) + 2+TFLXL(3,NUM(NY,NX),NY,NX) + FLW(3,NUM(NY,NX),NY,NX)=FLW(3,NUM(NY,NX),NY,NX) + 2+FLWL(3,NUM(NY,NX),NY,NX) + FLWX(3,NUM(NY,NX),NY,NX)=FLWX(3,NUM(NY,NX),NY,NX) + 2+FLWLX(3,NUM(NY,NX),NY,NX) + FLWH(3,NUM(NY,NX),NY,NX)=FLWH(3,NUM(NY,NX),NY,NX) + 2+FLWHL(3,NUM(NY,NX),NY,NX) + HFLW(3,NUM(NY,NX),NY,NX)=HFLW(3,NUM(NY,NX),NY,NX) + 2+HFLWL(3,NUM(NY,NX),NY,NX) FLWR(NY,NX)=FLWR(NY,NX)+FLWRL(NY,NX) HFLWR(NY,NX)=HFLWR(NY,NX)+HFLWRL(NY,NX) HEATI(NY,NX)=HEATI(NY,NX)+RFLX+RFLXR @@ -1816,88 +1870,59 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) HEATH(NY,NX)=HEATH(NY,NX)+RFLX+RFLXR 2+SFLX+SFLXR+EFLX+EFLXR+VFLX+VFLXR TEVAPG(NY,NX)=TEVAPG(NY,NX)+EVAP(NY,NX)+EVAPS(NY,NX)+EVAPR(NY,NX) - VOLWX1(NU(NY,NX),NY,NX)=VOLW1(NU(NY,NX),NY,NX) - HYSM(M,NU(NY,NX),NY,NX)=HYST(NU(NY,NX),NY,NX) - FLWM(M,3,NU(NY,NX),NY,NX)=FLWL(3,NU(NY,NX),NY,NX) - FLWHM(M,3,NU(NY,NX),NY,NX)=FLWHL(3,NU(NY,NX),NY,NX) + VOLWX1(NUM(NY,NX),NY,NX)=VOLW1(NUM(NY,NX),NY,NX) + HYSM(M,NUM(NY,NX),NY,NX)=HYST(NUM(NY,NX),NY,NX) + FLWM(M,3,NUM(NY,NX),NY,NX)=FLWL(3,NUM(NY,NX),NY,NX) + FLWHM(M,3,NUM(NY,NX),NY,NX)=FLWHL(3,NUM(NY,NX),NY,NX) C C DELAYED MIGRATION OF PRECIPITATION OR MELTWATER INTO MICROPORES C - IF(FLQM.GT.0.0.AND.VOLPX1(NU(NY,NX),NY,NX).GT.ZEROS(NY,NX) - 2.AND.HYST(NU(NY,NX),NY,NX).GT.ZERO)THEN - HYST(NU(NY,NX),NY,NX)=AMIN1(1.0,AMAX1(0.0,HYST(NU(NY,NX),NY,NX) - 2-FLQM/VOLPX1(NU(NY,NX),NY,NX))) + IF(FLQM.GT.0.0.AND.VOLPX1(NUM(NY,NX),NY,NX).GT.ZEROS(NY,NX) + 2.AND.HYST(NUM(NY,NX),NY,NX).GT.ZERO)THEN + HYST(NUM(NY,NX),NY,NX)=AMIN1(1.0,AMAX1(0.0,HYST(NUM(NY,NX),NY,NX) + 2-FLQM/VOLPX1(NUM(NY,NX),NY,NX))) ENDIF - HYST(NU(NY,NX),NY,NX)=HYST(NU(NY,NX),NY,NX) - 2+(1.0-HYST(NU(NY,NX),NY,NX))*HYSTX + HYST(NUM(NY,NX),NY,NX)=HYST(NUM(NY,NX),NY,NX) + 2+(1.0-HYST(NUM(NY,NX),NY,NX))*HYSTX C C INFILTRATION OF WATER FROM MACROPORES INTO MICROPORES C - IF(VOLWH1(NU(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN - FINHX=XNPH*6.283*HCND(2,1,NU(NY,NX),NY,NX)*AREA(3,NU(NY,NX),NY,NX) - 2*(PSISE(NU(NY,NX),NY,NX)-PSISM1(NU(NY,NX),NY,NX)) - 3/LOG(PHOL(NU(NY,NX),NY,NX)/HRAD(NU(NY,NX),NY,NX)) + IF(VOLWH1(NUM(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN + FINHX=XNPH*6.283*HCND(2,1,NUM(NY,NX),NY,NX) + 2*AREA(N,NUM(NY,NX),NY,NX) + 2*(PSISE(NUM(NY,NX),NY,NX)-PSISM1(NUM(NY,NX),NY,NX)) + 3/LOG(PHOL(NUM(NY,NX),NY,NX)/HRAD(NUM(NY,NX),NY,NX)) IF(FINHX.GT.0.0)THEN - FINHL(NU(NY,NX),NY,NX)=AMAX1(0.0,AMIN1(FINHX - 2,XNPH*VOLWH1(NU(NY,NX),NY,NX),VOLPX1(NU(NY,NX),NY,NX))) + FINHL(NUM(NY,NX),NY,NX)=AMAX1(0.0,AMIN1(FINHX + 2,XH(3,NUM(NY,NX),NY,NX)*VOLWH1(NUM(NY,NX),NY,NX) + 3,VOLPX1(NUM(NY,NX),NY,NX))) ELSE - FINHL(NU(NY,NX),NY,NX)=AMIN1(0.0,AMAX1(FINHX - 2,-VOLPH1(NU(NY,NX),NY,NX),-XNPH*VOLW1(NU(NY,NX),NY,NX))) + FINHL(NUM(NY,NX),NY,NX)=AMIN1(0.0,AMAX1(FINHX + 2,-VOLPH1(NUM(NY,NX),NY,NX) + 3,-XH(3,NUM(NY,NX),NY,NX)*VOLW1(NUM(NY,NX),NY,NX))) ENDIF - FINHM(M,NU(NY,NX),NY,NX)=FINHL(NU(NY,NX),NY,NX) - FINH(NU(NY,NX),NY,NX)=FINH(NU(NY,NX),NY,NX)+FINHL(NU(NY,NX),NY,NX) + FINHM(M,NUM(NY,NX),NY,NX)=FINHL(NUM(NY,NX),NY,NX) + FINH(NUM(NY,NX),NY,NX)=FINH(NUM(NY,NX),NY,NX) + 2+FINHL(NUM(NY,NX),NY,NX) C IF(J.EQ.12.AND.M.EQ.1)THEN C WRITE(*,3367)'HOLE',I,J,M,NX,NY -C 2,FINHL(NU(NY,NX),NY,NX),FINHX -C 2,VOLWH1(NU(NY,NX),NY,NX),VOLPH1(NU(NY,NX),NY,NX) -C 3,VOLAH1(NU(NY,NX),NY,NX),PSISE(NU(NY,NX),NY,NX) -C 4,PSISM1(NU(NY,NX),NY,NX),VOLW1(NU(NY,NX),NY,NX) -C 5,HCND(2,1,NU(NY,NX),NY,NX),PHOL(NU(NY,NX),NY,NX) -C 5,HRAD(NU(NY,NX),NY,NX) +C 2,FINHL(NUM(NY,NX),NY,NX),FINHX +C 2,VOLWH1(NUM(NY,NX),NY,NX),VOLPH1(NUM(NY,NX),NY,NX) +C 3,VOLAH1(NUM(NY,NX),NY,NX),PSISE(NUM(NY,NX),NY,NX) +C 4,PSISM1(NUM(NY,NX),NY,NX),VOLW1(NUM(NY,NX),NY,NX) +C 5,HCND(2,1,NUM(NY,NX),NY,NX),PHOL(NUM(NY,NX),NY,NX) +C 5,HRAD(NUM(NY,NX),NY,NX) 3367 FORMAT(A8,5I4,20E12.4) C ENDIF ELSE - FINHM(M,NU(NY,NX),NY,NX)=0.0 - FINHL(NU(NY,NX),NY,NX)=0.0 + FINHM(M,NUM(NY,NX),NY,NX)=0.0 + FINHL(NUM(NY,NX),NY,NX)=0.0 ENDIF C C WATER AND ENERGY TRANSFER THROUGH SOIL PROFILE C IFLGH=0 DO 4400 L=1,NL(NY,NX) -C -C CALCULATE CHANGE IN THICKNESS OF ICE LAYER -C -C IF(BKDS(L,NY,NX).EQ.0.0)THEN -C 2.AND.CDPTH(L-1,NY,NX).LT.DPTHA(NY,NX))THEN -C DDLYR=AMIN1(DLYR(3,L,NY,NX),(VOLA(L,NY,NX)-(VOLW1(L,NY,NX) -C 2+VOLI1(L,NY,NX)))/AREA(3,L,NY,NX)) -C IF(DLYR(3,L,NY,NX).GT.1.0E-03.OR.DDLYR.LT.0.0)THEN -C DO 900 LL=NU(NY,NX),L -C CDPTH(LL-1,NY,NX)=CDPTH(LL-1,NY,NX)+DDLYR -900 CONTINUE -C DO 905 LL=NU(NY,NX),L -C DPTH(LL,NY,NX)=0.5*(CDPTH(LL,NY,NX)+CDPTH(LL-1,NY,NX)) -C YDPTH(LL,NY,NX)=ALT(NY,NX)-DPTH(LL,NY,NX) -905 CONTINUE -C DLYR(3,L,NY,NX)=(CDPTH(L,NY,NX)-CDPTH(L-1,NY,NX)) -C VOLT(L,NY,NX)=AREA(3,L,NY,NX)*DLYR(3,L,NY,NX) -C VOLX(L,NY,NX)=VOLT(L,NY,NX)*FMPR(L,NY,NX) -C VOLA(L,NY,NX)=POROS(L,NY,NX)*VOLX(L,NY,NX) -C VOLP1(L,NY,NX)=AMAX1(0.0,VOLA(L,NY,NX)-VOLW1(L,NY,NX) -C 2-VOLI1(L,NY,NX)) -C IF((I/5)*5.EQ.I.AND.J.EQ.15.AND.BKDS(L,NY,NX).EQ.0.0)THEN -C WRITE(*,910)'DDLYR',I,J,L,M,L,DDLYR,VOLW1(L,NY,NX) -C 2,VOLI1(L,NY,NX),VOLA(L,NY,NX),CDPTH(L-1,NY,NX) -C 3,CDPTH(L,NY,NX),DPTH(L,NY,NX),YDPTH(L,NY,NX),DLYR(3,L,NY,NX) -C 4,VOLP1(L,NY,NX) -910 FORMAT(A8,5I4,12E16.8) -C ENDIF -C ENDIF -C ENDIF -C -C END CHANGE IN THICKNESS -C N1=NX N2=NY N3=L @@ -1942,19 +1967,28 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) N6=L+1 ENDIF ENDIF + DO 1100 LL=N6,NL(NY,NX) + IF(VOLX(LL,N5,N4).GT.ZEROS(N5,N4))THEN + N6=LL + GO TO 1101 + ENDIF +1100 CONTINUE +1101 CONTINUE + IF(N3.EQ.NU(N2,N1))N6X(N2,N1)=N6 C C POROSITIES 'THETP*', WATER CONTENTS 'THETA*', AND POTENTIALS C 'PSIS*' FOR EACH GRID CELL C - IF(N3.GE.NU(N2,N1).AND.N6.GE.NU(N5,N4) + IF(VOLX(N3,N2,N1).GT.ZEROS(N2,N1))THEN + IF(N3.GE.NUM(N2,N1).AND.N6.GE.NU(N5,N4) 2.AND.N3.LE.NL(N2,N1).AND.N6.LE.NL(N5,N4))THEN THETP1=AMAX1(0.0,VOLPX1(N3,N2,N1)/VOLX(N3,N2,N1)) THETPL=AMAX1(0.0,VOLPX1(N6,N5,N4)/VOLX(N6,N5,N4)) THETA1=AMAX1(THETY(N3,N2,N1),AMIN1(POROS(N3,N2,N1) - 2,VOLW1(N3,N2,N1)/VOLX(N3,N2,N1))) + 2,VOLW1(N3,N2,N1)/VOLXI(N3,N2,N1))) THETAL=AMAX1(THETY(N6,N5,N4),AMIN1(POROS(N6,N5,N4) - 2,VOLW1(N6,N5,N4)/VOLX(N6,N5,N4))) -C IF(BKVL(N3,N2,N1).GT.ZERO)THEN + 2,VOLW1(N6,N5,N4)/VOLXI(N6,N5,N4))) + IF(BKVL(N3,N2,N1).GT.ZERO)THEN IF(THETA1.LT.FC(N3,N2,N1))THEN PSISA1=AMAX1(PSIHY,-EXP(PSIMX(N2,N1) 2+((FCL(N3,N2,N1)-LOG(THETA1)) @@ -1966,10 +2000,10 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) ELSE PSISA1=PSISE(N3,N2,N1) ENDIF -C ELSE -C PSISA1=PSISE(N3,N2,N1) -C ENDIF -C IF(BKVL(N6,N5,N4).GT.ZERO)THEN + ELSE + PSISA1=PSISE(N3,N2,N1) + ENDIF + IF(BKVL(N6,N5,N4).GT.ZERO)THEN IF(THETAL.LT.FC(N6,N5,N4))THEN PSISAL=AMAX1(PSIHY,-EXP(PSIMX(N5,N4) 2+((FCL(N6,N5,N4)-LOG(THETAL)) @@ -1981,9 +2015,9 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) ELSE PSISAL=PSISE(N6,N5,N4) ENDIF -C ELSE -C PSISAL=PSISE(N6,N5,N4) -C ENDIF + ELSE + PSISAL=PSISE(N6,N5,N4) + ENDIF C IF(J.GE.20)THEN C WRITE(*,7272)'PSIM',I,J,N1,N2,N3,N4,N5,N6,M,PSISM1(N6,N5,N4) C 2,PSIMX(N5,N4),FCL(N6,N5,N4),THETWL,FCD(N6,N5,N4),PSIMD(N5,N4) @@ -2022,11 +2056,11 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) ELSEIF(PSISA1.GT.PSISA(N3,N2,N1))THEN THETW1=THETA1 THETWL=AMAX1(THETY(N6,N5,N4),AMIN1(POROS(N6,N5,N4) - 2,VOLWX1(N6,N5,N4)/VOLX(N6,N5,N4))) + 2,VOLWX1(N6,N5,N4)/VOLXI(N6,N5,N4))) CND1=HCND(N,1,N3,N2,N1)*XNPH CNDL=HCND(N,1,N6,N5,N4)*XNPH PSISM1(N3,N2,N1)=PSISA1 -C IF(BKVL(N6,N5,N4).GT.ZERO)THEN + IF(BKVL(N6,N5,N4).GT.ZERO)THEN IF(THETWL.LT.FC(N6,N5,N4))THEN PSISM1(N6,N5,N4)=AMAX1(PSIHY,-EXP(PSIMX(N5,N4) 2+((FCL(N6,N5,N4)-LOG(THETWL)) @@ -2038,20 +2072,20 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) ELSE PSISM1(N6,N5,N4)=PSISE(N6,N5,N4) ENDIF -C ELSE -C PSISM1(N6,N5,N4)=PSISE(N6,N5,N4) -C ENDIF + ELSE + PSISM1(N6,N5,N4)=PSISE(N6,N5,N4) + ENDIF FLGX=0.0 C C GREEN-AMPT FLOW IF ADJACENT CELL SATURATED C ELSEIF(PSISAL.GT.PSISA(N6,N5,N4))THEN THETW1=AMAX1(THETY(N3,N2,N1),AMIN1(POROS(N3,N2,N1) - 2,VOLWX1(N3,N2,N1)/VOLX(N3,N2,N1))) + 2,VOLWX1(N3,N2,N1)/VOLXI(N3,N2,N1))) THETWL=THETAL CND1=HCND(N,1,N3,N2,N1)*XNPH CNDL=HCND(N,1,N6,N5,N4)*XNPH -C IF(BKVL(N3,N2,N1).GT.ZERO)THEN + IF(BKVL(N3,N2,N1).GT.ZERO)THEN IF(THETW1.LT.FC(N3,N2,N1))THEN PSISM1(N3,N2,N1)=AMAX1(PSIHY,-EXP(PSIMX(N2,N1) 2+((FCL(N3,N2,N1)-LOG(THETW1)) @@ -2063,9 +2097,9 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) ELSE PSISM1(N3,N2,N1)=PSISE(N3,N2,N1) ENDIF -C ELSE -C PSISM1(N3,N2,N1)=PSISE(N3,N2,N1) -C ENDIF + ELSE + PSISM1(N3,N2,N1)=PSISE(N3,N2,N1) + ENDIF FLGX=0.0 C C RICHARDS FLOW IF NEITHER CELL IS SATURATED @@ -2115,12 +2149,12 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) C FLQX=AVCNDL*(PSIST1-PSISTL)*AREA(N,N3,N2,N1) IF(FLQX.GE.0.0)THEN - FLQL=AMAX1(0.0,AMIN1(FLQX,VOLW1(N3,N2,N1)*XNPH)) - FLQL=AMIN1(FLQL,VOLP1(N6,N5,N4)*XNPH) + FLQL=AMAX1(0.0,AMIN1(FLQX,VOLW1(N3,N2,N1)*XH(N,N3,N2,N1))) + FLQL=AMIN1(FLQL,VOLP1(N6,N5,N4)*XH(N,N6,N5,N4)) HWFLQL=4.19*TK1(N3,N2,N1)*FLQL ELSE - FLQL=AMIN1(0.0,AMAX1(FLQX,-VOLW1(N6,N5,N4)*XNPH)) - FLQL=AMAX1(FLQL,-VOLP1(N3,N2,N1)*XNPH) + FLQL=AMIN1(0.0,AMAX1(FLQX,-VOLW1(N6,N5,N4)*XH(N,N6,N5,N4))) + FLQL=AMAX1(FLQL,-VOLP1(N3,N2,N1)*XH(N,N3,N2,N1)) HWFLQL=4.19*TK1(N6,N5,N4)*FLQL ENDIF FLQ2=FLGX*FLQL @@ -2128,15 +2162,15 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) C INFILTRATION OF WATER FROM MACROPORES INTO MICROPORES C IF(N.EQ.3.AND.VOLWH1(N6,N5,N4).GT.ZEROS(N5,N4))THEN - FINHX=XNPH*6.283*HCND(2,1,N6,N5,N4)*AREA(3,N6,N5,N4) + FINHX=XNPH*6.283*HCND(2,1,N6,N5,N4)*AREA(N,N6,N5,N4) 2*(PSISE(N6,N5,N4)-PSISM1(N6,N5,N4)) 3/LOG(PHOL(N6,N5,N4)/HRAD(N6,N5,N4)) IF(FINHX.GT.0.0)THEN - FINHL(N6,N5,N4)=AMAX1(0.0,AMIN1(FINHX,XNPH*VOLWH1(N6,N5,N4) - 2,VOLPX1(N6,N5,N4))) + FINHL(N6,N5,N4)=AMAX1(0.0,AMIN1(FINHX,XH(N,N6,N5,N4) + 2*VOLWH1(N6,N5,N4),VOLPX1(N6,N5,N4))) ELSE FINHL(N6,N5,N4)=AMIN1(0.0,AMAX1(FINHX,-VOLPH1(N6,N5,N4) - 2,-XNPH*VOLW1(N6,N5,N4))) + 2,-XH(N,N6,N5,N4)*VOLW1(N6,N5,N4))) ENDIF FINHM(M,N6,N5,N4)=FINHL(N6,N5,N4) FINH(N6,N5,N4)=FINH(N6,N5,N4)+FINHL(N6,N5,N4) @@ -2232,13 +2266,13 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) HFLWX=(TKY-TK1(N6,N5,N4))*VHCP1(N6,N5,N4)*FHFLX*XDIM FLVX=AVCNVL*(VP1-VPL)*AREA(N,N3,N2,N1) IF(FLVX.GE.0.0)THEN - FLVL=AMIN1(FLVX,VOLW1(N3,N2,N1)*XNPH) + FLVL=AMIN1(FLVX,VOLW1(N3,N2,N1)*XH(N,N3,N2,N1)) IF(HFLWX.GE.0.0)THEN FLVL=AMIN1(FLVL,HFLWX/(4.19*TK1(N3,N2,N1)+VAP)) ENDIF HWFLVL=(4.19*TK1(N3,N2,N1)+VAP)*FLVL ELSE - FLVL=AMAX1(FLVX,-VOLW1(N6,N5,N4)*XNPH) + FLVL=AMAX1(FLVX,-VOLW1(N6,N5,N4)*XH(N,N6,N5,N4)) IF(HFLWX.LT.0.0)THEN FLVL=AMAX1(FLVL,HFLWX/(4.19*TK1(N6,N5,N4)+VAP)) ENDIF @@ -2247,101 +2281,136 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) HWFLWL=HWFLQL+HWFLVL FLWL(N,N6,N5,N4)=FLQL+FLVL FLWLX(N,N6,N5,N4)=FLQ2+FLVL -C IF(N3.EQ.NU(NY,NX))THEN -C WRITE(*,1115)'FLWL',I,J,M,N4,N5,N6,N,FLWL(N,N3,N2,N1) -C 2,FLWL(N,N6,N5,N4),FLQL,FLVL,FLQX,FLVX,HFLWX,FLWLY,FLWHY +C IF(IYRC.EQ.2006.AND.I.EQ.361.AND.NX.EQ.1)THEN +C WRITE(*,1115)'FLWL',I,J,M,N1,N2,N3,N4,N5,N6,N,FLWL(N,N3,N2,N1) +C 2,FLWL(N,N6,N5,N4),FLW(N,N3,N2,N1),FLW(N,N6,N5,N4) +C 3,FLQL,FLVL,FLQX,FLVX,HFLWX C 3,CND1,CNDL,AVCNDL,AVCNVL,VP1,VPL,PSIST1,PSISTL C 4,UAG,VOLA(N6,N5,N4),VOLI1(N6,N5,N4),SCNV(N6,N5,N4),THETP1 C 5,THETPL,VOLPX1(N3,N2,N1),VOLPX1(N6,N5,N4),TKY C 7,TK1(N3,N2,N1),TK1(N6,N5,N4),VOLT(N3,N2,N1),VOLT(N6,N5,N4) C 8,VOLW1(N6,N5,N4),VOLP1(N6,N5,N4),VOLX(N6,N5,N4),VOLW1(N3,N2,N1) -C 9,VOLP1(N3,N2,N1),VOLX(N3,N2,N1),POROS(N6,N5,N4),POROS(N3,N2,N1) -C 6,THETW1,THETWL,THETK1,THETKL,PSISA1,PSISAL,PSISM1(N3,N2,N1) +C 9,VOLP1(N3,N2,N1),VOLX(N3,N2,N1),VOLA(N6,N5,N4),VOLA(N3,N2,N1) +C 6,THETW1,THETWL,PSISA1,PSISAL,PSISM1(N3,N2,N1) C 7,PSISM1(N6,N5,N4),PSISH(N3,N2,N1),PSISH(N6,N5,N4) C 8,DLYR(N,N3,N2,N1),DLYR(N,N6,N5,N4),AREA(N,N3,N2,N1) -C 9,VHCP1(N3,N2,N1),VHCP1(N6,N5,N4),POROS(N6,N5,N4),THETAL -1115 FORMAT(A8,7I4,60E12.4) +C 9,VHCP1(N3,N2,N1),VHCP1(N6,N5,N4),POROS(N6,N5,N4) +1115 FORMAT(A8,10I4,60E12.4) C ENDIF C C THERMAL CONDUCTIVITY C DTKX=ABS(TK1(N3,N2,N1)-TK1(N6,N5,N4))*1.0E-06 + IF(BKDS(N3,N2,N1).GT.ZERO.OR.THETWX(N3,N2,N1).GT.ZERO)THEN DTHW1=AMAX1(0.0,THETWX(N3,N2,N1)-TRBW)**3 DTHA1=AMAX1(0.0,THETPX(N3,N2,N1)-TRBA)**3 - DTHW2=AMAX1(0.0,THETWX(N6,N5,N4)-TRBW)**3 - DTHA2=AMAX1(0.0,THETPX(N6,N5,N4)-TRBA)**3 RYLXW1=DTKX*DTHW1 RYLXA1=DTKX*DTHA1 - RYLXW2=DTKX*DTHW2 - RYLXA2=DTKX*DTHA2 RYLNW1=AMIN1(1.0E+04,RYLXW*RYLXW1) RYLNA1=AMIN1(1.0E+04,RYLXA*RYLXA1) - RYLNW2=AMIN1(1.0E+04,RYLXW*RYLXW2) - RYLNA2=AMIN1(1.0E+04,RYLXA*RYLXA2) XNUSW1=AMAX1(1.0,0.68+0.67*RYLNW1**0.25/DNUSW) XNUSA1=AMAX1(1.0,0.68+0.67*RYLNA1**0.25/DNUSA) - XNUSW2=AMAX1(1.0,0.68+0.67*RYLNW2**0.25/DNUSW) - XNUSA2=AMAX1(1.0,0.68+0.67*RYLNA2**0.25/DNUSA) TCNDW1=2.067E-03*XNUSW1 TCNDA1=9.050E-05*XNUSA1 - TCNDW2=2.067E-03*XNUSW2 - TCNDA2=9.050E-05*XNUSA2 WTHET1=1.467-0.467*THETPY(N3,N2,N1) TCND1=(STC(N3,N2,N1)+THETWX(N3,N2,N1)*TCNDW1 2+0.611*THETIX(N3,N2,N1)*7.844E-03 3+WTHET1*THETPX(N3,N2,N1)*TCNDA1) 4/(DTC(N3,N2,N1)+THETWX(N3,N2,N1)+0.611*THETIX(N3,N2,N1) 5+WTHET1*THETPX(N3,N2,N1)) + ELSE + TCND1=0.0 + ENDIF + IF(BKDS(N6,N5,N4).GT.ZERO.OR.THETWX(N6,N5,N4).GT.ZERO)THEN + DTHW2=AMAX1(0.0,THETWX(N6,N5,N4)-TRBW)**3 + DTHA2=AMAX1(0.0,THETPX(N6,N5,N4)-TRBA)**3 + RYLXW2=DTKX*DTHW2 + RYLXA2=DTKX*DTHA2 + RYLNW2=AMIN1(1.0E+04,RYLXW*RYLXW2) + RYLNA2=AMIN1(1.0E+04,RYLXA*RYLXA2) + XNUSW2=AMAX1(1.0,0.68+0.67*RYLNW2**0.25/DNUSW) + XNUSA2=AMAX1(1.0,0.68+0.67*RYLNA2**0.25/DNUSA) + TCNDW2=2.067E-03*XNUSW2 + TCNDA2=9.050E-05*XNUSA2 WTHET2=1.467-0.467*THETPY(N6,N5,N4) TCND2=(STC(N6,N5,N4)+THETWX(N6,N5,N4)*TCNDW2 2+0.611*THETIX(N6,N5,N4)*7.844E-03 3+WTHET2*THETPX(N6,N5,N4)*TCNDA2) 4/(DTC(N6,N5,N4)+THETWX(N6,N5,N4)+0.611*THETIX(N6,N5,N4) 5+WTHET2*THETPX(N6,N5,N4)) + ELSE + TCND2=0.0 + ENDIF ATCND1=(2.0*TCND1*TCND2)/(TCND1*DLYR(N,N6,N5,N4) 3+TCND2*DLYR(N,N3,N2,N1))*XNPH C C HEAT FLOW FROM THERMAL CONDUCTIVITY AND TEMPERATURE GRADIENT C + IF(VHCP1(N3,N2,N1).GT.ZEROS(NY,NX))THEN + IF(N3.EQ.NUM(NY,NX))THEN + TK1X=TK1(N3,N2,N1)-(HWFLVL-HFLX1)/VHCP1(N3,N2,N1) + ELSE TK1X=TK1(N3,N2,N1)-HWFLVL/VHCP1(N3,N2,N1) + ENDIF + ELSE + TK1X=TK1(N3,N2,N1) + ENDIF + IF(VHCP1(N6,N5,N4).GT.ZEROS(NY,NX))THEN TKLX=TK1(N6,N5,N4)+HWFLVL/VHCP1(N6,N5,N4) + ELSE + TKLX=TK1(N6,N5,N4) + ENDIF TKY=(VHCP1(N3,N2,N1)*TK1X+VHCP1(N6,N5,N4)*TKLX) 2/(VHCP1(N3,N2,N1)+VHCP1(N6,N5,N4)) HFLWX=(TKY-TKLX)*VHCP1(N6,N5,N4)*FHFLX*XDIM HFLWC=ATCND1*(TK1X-TKLX)*AREA(N,N3,N2,N1) IF(HFLWC.GE.0.0)THEN - HFLWC=AMAX1(0.0,AMIN1(HFLWC,HFLWX)) - ELSE - HFLWC=AMIN1(0.0,AMAX1(HFLWC,HFLWX)) - ENDIF - HFLWL(N,N6,N5,N4)=HWFLWL+HWFLHL+HFLWC -C IF((I/10)*10.EQ.I.AND.N5.EQ.2.AND.J.EQ.15.AND.N.EQ.3)THEN -C WRITE(*,8765)'HFLWL',I,J,N4,N5,N6,N,M,HFLWL(N,N6,N5,N4) -C 2,TCND1,TCND2,ATCND1,DTKX,DTHP1,DTHP2,THETPX(N3,N2,N1) -C 3,THETPX(N6,N5,N4),RYLNA1,RYLNA2,DNUSA,XNUSA1,XNUSA2 -C 4,TCNDA1,TCNDA2,RYLNW1,RYLNW2,DNUSW,XNUSW1,XNUSW2 -C 5,TCNDW1,TCNDW2 -8765 FORMAT(A8,7I4,60E12.4) + HFLWS=AMAX1(0.0,AMIN1(HFLWX,HFLWC)) + ELSE + HFLWS=AMIN1(0.0,AMAX1(HFLWX,HFLWC)) + ENDIF + HFLWL(N,N6,N5,N4)=HWFLWL+HWFLHL+HFLWS +C IF(I.EQ.346)THEN +C WRITE(*,8765)'HFLWL',I,J,M,N1,N2,N3,N4,N5,N6,N,HFLWL(N,N3,N2,N1) +C 2,HFLWL(N,N6,N5,N4),HWFLWL,HWFLHL,HFLWC,HFLWX,HFLWS,TCND1,TCND2 +C 3,ATCND1,TK1X,TKLX,TKY,HWFLVL,TK1(N3,N2,N1),TK1(N6,N5,N4) +C 2,DLYR(N,N3,N2,N1),DLYR(N,N6,N5,N4) +C 4,VHCP1(N3,N2,N1),VHCP1(N6,N5,N4),VOLX(N3,N2,N1) +C 5,VOLX(N6,N5,N4),VOLW1(N3,N2,N1),VOLW1(N6,N5,N4) +C 3,THETPX(N3,N2,N1),THETPX(N6,N5,N4),RYLNA1,RYLNA2,DNUSA,XNUSA1 +C 4,STC(N6,N5,N4),THETWX(N6,N5,N4),TCNDW2 +C 2,THETIX(N6,N5,N4) +C 3,WTHET2,THETPX(N6,N5,N4),TCNDA2 +C 4,DTC(N6,N5,N4),THETWX(N6,N5,N4),THETIX(N6,N5,N4) +C 5,WTHET2,THETPX(N6,N5,N4) +8765 FORMAT(A8,10I4,60E12.4) C ENDIF C C MOVE WATER UP DURING PRECIPITATION OR FREEZING C - IF(N.EQ.3)THEN - IF(VOLW1(N6,N5,N4)+VOLI1(N6,N5,N4).GT.VOLA(N6,N5,N4))THEN - FLWLY=AMIN1(0.0,AMAX1(-XNPH*VOLW1(N6,N5,N4) - 2,VOLA(N6,N5,N4)-VOLW1(N6,N5,N4)-VOLI1(N6,N5,N4))) - FLWLY=AMAX1(FLWLY,-VOLP1(N3,N2,N1)) - HFLWLY=FLWLY*4.19*TK1(N6,N5,N4) - FLWL(N,N6,N5,N4)=FLWL(N,N6,N5,N4)+FLWLY - HFLWL(N,N6,N5,N4)=HFLWL(N,N6,N5,N4)+HFLWLY - ENDIF - IF(VOLWH1(N6,N5,N4)+VOLIH1(N6,N5,N4).GT.VOLAH1(N6,N5,N4))THEN - FLWHY=AMIN1(0.0,AMAX1(-XNPH*VOLWH1(N6,N5,N4),-VOLPH1(N3,N2,N1) - 2,VOLAH1(N6,N5,N4)-VOLWH1(N6,N5,N4)-VOLIH1(N6,N5,N4))) - HFLWHY=FLWHY*4.19*TK1(N6,N5,N4) - FLWHL(N,N6,N5,N4)=FLWHL(N,N6,N5,N4)+FLWHY - HFLWL(N,N6,N5,N4)=HFLWL(N,N6,N5,N4)+HFLWHY - ENDIF + IF(N.EQ.3.AND.BKDS(N6,N5,N4).GT.ZERO)THEN +C IF(VOLW1(N6,N5,N4)+VOLI1(N6,N5,N4).GT.VOLA(N6,N5,N4))THEN +C FLWLY=AMIN1(0.0,AMAX1(-XH(N,N6,N5,N4)*VOLW1(N6,N5,N4) +C 2,VOLA(N6,N5,N4)-VOLW1(N6,N5,N4)-VOLI1(N6,N5,N4))) +C IF(BKDS(N3,N2,N1).GT.ZERO)FLWLY=AMAX1(FLWLY,-VOLP1(N3,N2,N1)) +C HFLWLY=FLWLY*4.19*TK1(N6,N5,N4) +C FLWL(N,N6,N5,N4)=FLWL(N,N6,N5,N4)+FLWLY +C HFLWL(N,N6,N5,N4)=HFLWL(N,N6,N5,N4)+HFLWLY +C IF(I.EQ.336)THEN +C WRITE(*,1115)'FLWLY',I,J,M,N1,N2,N3,N4,N5,N6,N,FLWL(N,N3,N2,N1) +C 2,FLWL(N,N6,N5,N4),FLW(N,N3,N2,N1),FLW(N,N6,N5,N4) +C 3,FLWLY,XH(N,N6,N5,N4),VOLW1(N6,N5,N4) +C 2,VOLA(N6,N5,N4),VOLW1(N6,N5,N4),VOLI1(N6,N5,N4),VOLP1(N3,N2,N1) +C ENDIF +C ENDIF +C IF(VOLWH1(N6,N5,N4)+VOLIH1(N6,N5,N4).GT.VOLAH1(N6,N5,N4))THEN +C FLWHY=AMIN1(0.0,AMAX1(-XH(N,N6,N5,N4)*VOLWH1(N6,N5,N4) +C 2,-VOLPH1(N3,N2,N1),VOLAH1(N6,N5,N4)-VOLWH1(N6,N5,N4) +C 3-VOLIH1(N6,N5,N4))) +C HFLWHY=FLWHY*4.19*TK1(N6,N5,N4) +C FLWHL(N,N6,N5,N4)=FLWHL(N,N6,N5,N4)+FLWHY +C HFLWL(N,N6,N5,N4)=HFLWL(N,N6,N5,N4)+HFLWHY +C ENDIF IF(PSISAL.GT.PSISA(N6,N5,N4))THEN FLWVL(N6,N5,N4)=VOLW1(N6,N5,N4)-VOLWX1(N6,N5,N4) ELSE @@ -2365,9 +2434,9 @@ 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*DENSI*VOLI1(N6,N5,N4)*XNPH,TFLX1) + TFLX=AMAX1(-333.0*DENSI*VOLI1(N6,N5,N4)*XH(N,N6,N5,N4),TFLX1) ELSE - TFLX=AMIN1(333.0*VOLW1(N6,N5,N4)*XNPH,TFLX1) + TFLX=AMIN1(333.0*VOLW1(N6,N5,N4)*XH(N,N6,N5,N4),TFLX1) ENDIF WFLX=-TFLX/333.0 IF(WFLX.GT.0.0.AND.VOLI1(N6,N5,N4).GT.ZEROS(N5,N4))THEN @@ -2394,9 +2463,9 @@ 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*DENSI*VOLIH1(N6,N5,N4)*XNPH,TFLX1) + TFLXH=AMAX1(-333.0*DENSI*VOLIH1(N6,N5,N4)*XH(N,N6,N5,N4),TFLX1) ELSE - TFLXH=AMIN1(333.0*VOLWH1(N6,N5,N4)*XNPH,TFLX1) + TFLXH=AMIN1(333.0*VOLWH1(N6,N5,N4)*XH(N,N6,N5,N4),TFLX1) ENDIF WFLXH=-TFLXH/333.0 IF(WFLXH.GT.0.0.AND.VOLIH1(N6,N5,N4).GT.ZEROS(N5,N4))THEN @@ -2440,6 +2509,21 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) HYST(N6,N5,N4)=AMIN1(1.0,AMAX1(0.0,HYST(N6,N5,N4) 2-FLWL(N,N6,N5,N4)/VOLPX1(N6,N5,N4))) ENDIF +C IF(I.EQ.55)THEN +C WRITE(*,1115)'FLWL2',I,J,M,N1,N2,N3,N4,N5,N6,N,FLWL(N,N3,N2,N1) +C 2,FLWL(N,N6,N5,N4),FLW(N,N3,N2,N1),FLW(N,N6,N5,N4) +C 3,FLQL,FLVL,FLQX,FLVX,HFLWX +C 3,CND1,CNDL,AVCNDL,AVCNVL,VP1,VPL,PSIST1,PSISTL +C 4,UAG,VOLA(N6,N5,N4),VOLI1(N6,N5,N4),SCNV(N6,N5,N4),THETP1 +C 5,THETPL,VOLPX1(N3,N2,N1),VOLPX1(N6,N5,N4),TKY +C 7,TK1(N3,N2,N1),TK1(N6,N5,N4),VOLT(N3,N2,N1),VOLT(N6,N5,N4) +C 8,VOLW1(N6,N5,N4),VOLP1(N6,N5,N4),VOLX(N6,N5,N4),VOLW1(N3,N2,N1) +C 9,VOLP1(N3,N2,N1),VOLX(N3,N2,N1),VOLA(N6,N5,N4),VOLA(N3,N2,N1) +C 6,THETW1,THETWL,PSISA1,PSISAL,PSISM1(N3,N2,N1) +C 7,PSISM1(N6,N5,N4),PSISH(N3,N2,N1),PSISH(N6,N5,N4) +C 8,DLYR(N,N3,N2,N1),DLYR(N,N6,N5,N4),AREA(N,N3,N2,N1) +C 9,VHCP1(N3,N2,N1),VHCP1(N6,N5,N4),POROS(N6,N5,N4) +C ENDIF C C WATER FILM THICKNESS FOR CALCULATING GAS EXCHANGE IN 'TRNSFR' C @@ -2456,8 +2540,41 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) FLWLX(N,N6,N5,N4)=0.0 FLWHL(N,N6,N5,N4)=0.0 HFLWL(N,N6,N5,N4)=0.0 + TFLXL(N,N6,N5,N4)=0.0 + WFLXL(N,N6,N5,N4)=0.0 + WFLXLH(N,N6,N5,N4)=0.0 + FLWM(M,N,N6,N5,N4)=0.0 FLWHM(M,N,N6,N5,N4)=0.0 ENDIF + ELSE + IF(N.EQ.3)THEN + FLWL(N,N3,N2,N1)=0.0 + FLWLX(N,N3,N2,N1)=0.0 + FLWHL(N,N3,N2,N1)=0.0 + HFLWL(N,N3,N2,N1)=0.0 + TFLXL(N,N3,N2,N1)=0.0 + WFLXL(N,N3,N2,N1)=0.0 + WFLXLH(N,N3,N2,N1)=0.0 + FLWHM(M,N,N3,N2,N1)=0.0 + FLWHM(M,N,N3,N2,N1)=0.0 + ELSE + FLWL(N,N6,N5,N4)=0.0 + FLWLX(N,N6,N5,N4)=0.0 + FLWHL(N,N6,N5,N4)=0.0 + HFLWL(N,N6,N5,N4)=0.0 + TFLXL(N,N6,N5,N4)=0.0 + WFLXL(N,N6,N5,N4)=0.0 + WFLXLH(N,N6,N5,N4)=0.0 + FLWM(M,N,N6,N5,N4)=0.0 + FLWHM(M,N,N6,N5,N4)=0.0 + ENDIF +C IF(I.EQ.336)THEN +C WRITE(*,1115)'FLWLX',I,J,M,N1,N2,N3,N4,N5,N6,N +C 2,FLWL(N,N3,N2,N1),FLW(N,N3,N2,N1) +C 2,FLWL(N,N6,N5,N4),FLW(N,N6,N5,N4) +C 3,VOLX(N3,N2,N1),VOLX(N6,N5,N4) +C ENDIF + ENDIF 4320 CONTINUE 4400 CONTINUE 9890 CONTINUE @@ -2467,7 +2584,7 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) C DO 9595 NX=NHW,NHE DO 9590 NY=NVN,NVS - DO 9585 L=NU(NY,NX),NL(NY,NX) + DO 9585 L=NUM(NY,NX),NL(NY,NX) TVOLZ1=TVOL1(NY,NX) VOLWZ1=TVOLW(NY,NX) VOLP2=VOLP1(L,NY,NX) @@ -2482,8 +2599,9 @@ 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)) - 2.OR.DPTH(LL,NY,NX).GT.DPTHA(NY,NX))THEN + IF((PSISM1(LL,NY,NX).LT.PSISE(LL,NY,NX) + 2+0.0098*(DPTH(LL,NY,NX)-DTBLX(NY,NX)) + 2.AND.L.NE.NL(NY,NX)).OR.DPTH(LL,NY,NX).GT.DPTHA(NY,NX))THEN IFLGU=1 ENDIF ENDIF @@ -2516,12 +2634,12 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) ELSE IFLGUH=1 ENDIF -C IF((I/30)*30.EQ.I.AND.M.EQ.1)THEN +C IF((I/30)*30.EQ.I.AND.J.EQ.15)THEN C WRITE(*,9567)'IFLGU',I,J,M,NX,NY,L,IFLGU,IFLGUH,PSISM1(L,NY,NX) -C 2,PSISE(L,NY,NX),DPTH(L,NY,NX),DTBLX(NY,NX),PSISE(L,NY,NX) -C 2+0.0098*(DPTH(L,NY,NX)-DTBLX(NY,NX)),THETX +C 2,PSISE(L,NY,NX)+0.0098*(DPTH(L,NY,NX)-DTBLX(NY,NX)) +C 2,DPTH(L,NY,NX),DTBLX(NY,NX),DPTHA(NY,NX) C 3,VOLAH1(L,NY,NX),VOLWH1(L,NY,NX),VOLIH1(L,NY,NX),CDPTH(L,NY,NX) -C 4,DLYR(3,L,NY,NX),DTBLZ(NY,NX),DPTHH +C 4,DLYR(3,L,NY,NX),DTBLZ(NY,NX),DPTHH,THETX 9567 FORMAT(A8,8I4,20E12.4) C ENDIF C @@ -2537,7 +2655,7 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) N4=NX+1 N5=NY N6=L - WDTH=DLYR(2,NU(NY,NX),NY,NX) + WDTH=DLYR(2,NUM(NY,NX),NY,NX) IF(NN.EQ.1)THEN IF(NX.EQ.NHE)THEN M1=NX @@ -2573,7 +2691,7 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) N4=NX N5=NY+1 N6=L - WDTH=DLYR(1,NU(NY,NX),NY,NX) + WDTH=DLYR(1,NUM(NY,NX),NY,NX) IF(NN.EQ.1)THEN IF(NY.EQ.NVS)THEN M1=NX @@ -2631,7 +2749,8 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) C BOUNDARY SURFACE RUNOFF DEPENDING ON ASPECT, SLOPE C VELOCITY, HYDRAULIC RADIUS AND SURFACE WATER STORAGE C - IF(L.EQ.NU(N2,N1).AND.N.NE.3)THEN + IF(L.EQ.NUM(N2,N1).AND.N.NE.3 + 2.AND.CDPTH(0,N2,N1).LE.CDPTHI(N2,N1))THEN IF(IRCHG(NN,N,N2,N1).EQ.0.OR.RCHQF.EQ.0.0)THEN V=0.0 QR1(N,M5,M4)=0.0 @@ -2640,14 +2759,14 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) C C RUNOFF C - ALT1=ALTG(N2,N1)+TVOLZ1/AREA(3,NU(N2,N1),N2,N1) - ALT2=ALTG(N2,N1)+VOLWG(N2,N1)/AREA(3,NU(N2,N1),N2,N1) - 2-GSIN(N2,N1)*DLYR(N,NU(N2,N1),N2,N1) + ALT1=ALTG(N2,N1)+TVOLZ1/AREA(3,NUM(N2,N1),N2,N1) + ALT2=ALTG(N2,N1)+VOLWG(N2,N1)/AREA(3,NUM(N2,N1),N2,N1) + 2-GSIN(N2,N1)*DLYR(N,NUM(N2,N1),N2,N1) IF(ALT1.GT.ALT2.AND.TVOLZ1.GT.VOLWG(N2,N1))THEN QRX1=TVOLZ1-VOLWG(N2,N1) D=QRX1/AREA(3,0,N2,N1) R=D/2.828 - S=(ALT1-ALT2)/DLYR(N,NU(N2,N1),N2,N1) + S=(ALT1-ALT2)/DLYR(N,NUM(N2,N1),N2,N1) V=R**0.67*SQRT(S)/ZM(N2,N1) Q=V*D*AMIN1(1.0,D/ZS(N2,N1))*WDTH*3.6E+03*XNPH*RCHQF QR1(N,M5,M4)=-XN*AMIN1(Q,0.25*QRX1)*VOLWZ1/TVOLZ1*RCHQF @@ -2658,8 +2777,8 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) C C RUNON C - QRX1=AMIN1(0.0,DTBLX(N2,N1)+TVOLZ1/AREA(3,NU(N2,N1),N2,N1)) - 2*AREA(3,NU(N2,N1),N2,N1) + QRX1=AMIN1(0.0,DTBLX(N2,N1)+TVOLZ1/AREA(3,NUM(N2,N1),N2,N1)) + 2*AREA(3,NUM(N2,N1),N2,N1) QR1(N,M5,M4)=-XN*0.25*QRX1*RCHQF HQR1(N,M5,M4)=4.19*TK1(0,N2,N1)*QR1(N,M5,M4) VOLWZ1=VOLWZ1+XN*QR1(N,M5,M4) @@ -2682,7 +2801,7 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) QI(N,M5,M4)=QI(N,M5,M4)+QI1(N,M5,M4) HQS(N,M5,M4)=HQS(N,M5,M4)+HQS1(N,M5,M4) QSM(M,N,M5,M4)=QS1(N,M5,M4) -C IF((I/10)*10.EQ.I.AND.M.EQ.NPH)THEN +C IF(I.EQ.168)THEN C WRITE(*,7744)'QRB',I,J,M,N1,N2,N3,M4,M5,M6,N,NN,IRCHG(NN,N,N2,N1) C 2,QR(N,M5,M4),QR1(N,M5,M4),Q,QRX1,V,S,D,ALT1,ALT2,ZM(N2,N1) C 3,ZS(N2,N1),VOLWZ1,TVOLZ1,RCHQF,VOLWG(N2,N1),VOLW1(0,N2,N1) @@ -2696,6 +2815,7 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) C BOUNDARY SUBSURFACE WATER AND HEAT TRANSFER DEPENDING C ON LEVEL OF WATER TABLE C + IF(VOLX(N3,N2,N1).GT.ZEROS(NY,NX))THEN IF(NCN(N2,N1).NE.3.OR.N.EQ.3)THEN C C IF NO WATER TABLE @@ -2711,10 +2831,10 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) 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 + FLWL(N,M6,M5,M4)=AMIN1(VOLW1(N3,N2,N1)*XH(N,N3,N2,N1) 2,XN*0.0098*-ABS(SLOPE(N,N2,N1))*CND1*AREA(3,N3,N2,N1)) 3*RCHGFU*RCHGFT - FLWLX(N,M6,M5,M4)=AMIN1(VOLWX1(N3,N2,N1)*XNPH + FLWLX(N,M6,M5,M4)=AMIN1(VOLWX1(N3,N2,N1)*XH(3,N3,N2,N1) 2,XN*0.0098*-ABS(SLOPE(N,N2,N1))*CNDX*AREA(3,N3,N2,N1)) 3*RCHGFU*RCHGFT FLWHL(N,M6,M5,M4)=AMIN1(VOLWH1(L,NY,NX) @@ -2722,14 +2842,15 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) 3*RCHGFU*RCHGFT HFLWL(N,M6,M5,M4)=4.19*TK1(N3,N2,N1) 2*(FLWL(N,M6,M5,M4)+FLWHL(N,M6,M5,M4)) -C IF(J.EQ.12.AND.M.EQ.1)THEN -C WRITE(*,4443)'ABV',I,J,M,N,NN,M4,M5,M6,XN,FLWL(N,M6,M5,M4) +C IF(I.EQ.336)THEN +C WRITE(*,4443)'ABV',I,J,M,N1,N2,N3,M4,M5,M6,N,NN,XN +C 2,FLWL(N,M6,M5,M4) C 2,VOLP2,RCHGFU,VOLX(N3,N2,N1),VOLW1(N3,N2,N1) C 3,VOLWH1(N3,N2,N1),VOLPH1(N3,N2,N1),VOLPH2,VOLI1(N3,N2,N1) C 4,VOLIH1(N3,N2,N1),VOLP1(N3,N2,N1),HFLWL(N,M6,M5,M4) C 5,PSISM1(N3,N2,N1),PSISE(N3,N2,N1),FLWHL(N,M6,M5,M4),DDRG(N2,N1) C 6,SLOPE(N,N2,N1) -4443 FORMAT(A8,8I4,30E12.4) +4443 FORMAT(A8,11I4,30E12.4) C ENDIF ELSE C @@ -2747,10 +2868,12 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) FLWL(N,M6,M5,M4)=XN*FLWT FLWLX(N,M6,M5,M4)=XN*FLWT HFLWL(N,M6,M5,M4)=4.19*TK1(N3,N2,N1)*XN*FLWT +C IF((I/30)*30.EQ.I.AND.J.EQ.15)THEN C WRITE(*,4445)'DISCHMI',I,J,M,N1,N2,N3,M4,M5,M6,N,NN,XN C 2,FLWL(N,M6,M5,M4),FLWT,PSISWT,HCND(N,1,N3,N2,N1) C 3,AREA(N,N3,N2,N1),AREAU(N3,N2,N1),RCHGFU,RCHGFT 4445 FORMAT(A8,11I4,30E12.4) +C ENDIF ELSE FLWL(N,M6,M5,M4)=0.0 FLWLX(N,M6,M5,M4)=0.0 @@ -2767,7 +2890,7 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) IF(PSISWTH.LT.0.0)PSISWTH=PSISWTH-PSISWD FLWTH=PSISWTH*CNDH1(N3,N2,N1)*AREA(N,N3,N2,N1) 2*(1.0-AREAU(N3,N2,N1))/(RCHGFU+1.0)*RCHGFT - FLWTHL=AMAX1(FLWTH,AMIN1(0.0,-XNPH*(VOLWH1(N3,N2,N1) + FLWTHL=AMAX1(FLWTH,AMIN1(0.0,-XH(N,N3,N2,N1)*(VOLWH1(N3,N2,N1) 2+FLWHL(3,N3,N2,N1)-FLWHL(3,N3+1,N2,N1)-FINHL(N3,N2,N1)))) FLWHL(N,M6,M5,M4)=XN*FLWTHL HFLWL(N,M6,M5,M4)=HFLWL(N,M6,M5,M4)+4.19*TK1(N3,N2,N1)*XN*FLWTHL @@ -2784,7 +2907,7 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) C IF(IPRC(N2,N1).NE.3.AND.DPTH(N3,N2,N1).GE.DTBLX(N2,N1) C 2.AND.DPTHA(N2,N1).GT.DTBLX(N2,N1) - 2.AND.(BKDS(N3,N2,N1).EQ.0.0.OR.VOLP2.GT.0.0))THEN + 2.AND.(BKDS(N3,N2,N1).LE.ZERO.OR.VOLP2.GT.0.0))THEN PSISWD=XN*0.005*SLOPE(N,N2,N1)*DLYR(N,N3,N2,N1) 2*(1.0-DTBLG(N2,N1)) PSISUT=AMAX1(0.0,PSISE(N3,N2,N1)-PSISM1(N3,N2,N1) @@ -2824,7 +2947,7 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) IF(PSISUTH.GT.0.0)PSISUTH=PSISUTH+PSISWD FLWUH=PSISUTH*CNDH1(N3,N2,N1)*AREA(N,N3,N2,N1) 2*AREAU(N3,N2,N1)/(RCHGFU+1.0)*RCHGFT - FLWUHL=AMIN1(FLWUH,AMAX1(0.0,XNPH*(VOLPH2 + FLWUHL=AMIN1(FLWUH,AMAX1(0.0,XH(N,N3,N2,N1)*(VOLPH2 2-FLWHL(3,N3,N2,N1)+FLWHL(3,N3+1,N2,N1)+FINHL(N3,N2,N1)))) FLWHL(N,M6,M5,M4)=FLWHL(N,M6,M5,M4)+XN*FLWUHL HFLWL(N,M6,M5,M4)=HFLWL(N,M6,M5,M4)+4.19*TK1(N3,N2,N1) @@ -2862,11 +2985,19 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) FLWM(M,N,M6,M5,M4)=FLWL(N,M6,M5,M4) FLWHM(M,N,M6,M5,M4)=FLWHL(N,M6,M5,M4) ENDIF + ELSE + FLWL(N,M6,M5,M4)=0.0 + FLWLX(N,M6,M5,M4)=0.0 + FLWHL(N,M6,M5,M4)=0.0 + HFLWL(N,M6,M5,M4)=0.0 + FLWM(M,N,M6,M5,M4)=0.0 + FLWHM(M,N,M6,M5,M4)=0.0 + ENDIF 9575 CONTINUE C C TOTAL WATER AND HEAT FLUXES IN EACH GRID CELL C - IF(L.EQ.NU(N2,N1).AND.N.NE.3)THEN + IF(L.EQ.NUM(N2,N1).AND.N.NE.3)THEN TQR1(N2,N1)=TQR1(N2,N1)+QR1(N,N2,N1)-QR1(N,N5,N4) THQR1(N2,N1)=THQR1(N2,N1)+HQR1(N,N2,N1)-HQR1(N,N5,N4) TQS1(N2,N1)=TQS1(N2,N1)+QS1(N,N2,N1)-QS1(N,N5,N4) @@ -2875,6 +3006,14 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) THQS1(N2,N1)=THQS1(N2,N1)+HQS1(N,N2,N1)-HQS1(N,N5,N4) ENDIF IF(NCN(N2,N1).NE.3.OR.N.EQ.3)THEN + DO 1200 LL=N6,NL(N5,N4) + IF(VOLX(LL,N2,N1).GT.ZEROS(N2,N1))THEN + N6=LL + GO TO 1201 + ENDIF +1200 CONTINUE +1201 CONTINUE + IF(VOLX(N3,N2,N1).GT.ZEROS(N2,N1))THEN TFLWL(N3,N2,N1)=TFLWL(N3,N2,N1)+FLWL(N,N3,N2,N1) 2-FLWL(N,N6,N5,N4) TFLWLX(N3,N2,N1)=TFLWLX(N3,N2,N1)+FLWLX(N,N3,N2,N1) @@ -2886,13 +3025,23 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) TWFLXL(N3,N2,N1)=TWFLXL(N3,N2,N1)+WFLXL(N,N3,N2,N1) TWFLXH(N3,N2,N1)=TWFLXH(N3,N2,N1)+WFLXLH(N,N3,N2,N1) TTFLXL(N3,N2,N1)=TTFLXL(N3,N2,N1)+TFLXL(N,N3,N2,N1) -C IF(L.EQ.NU(NY,NX))THEN -C WRITE(*,3378)'THFLWL',I,J,M,N1,N2,N3,N4,N5,N6,N,THFLWL(N3,N2,N1) -C 3,HFLWL(N,N3,N2,N1),HFLWL(N,N6,N5,N4),TFLWL(N3,N2,N1) -C 3,FLWL(N,N3,N2,N1),FLWL(N,N6,N5,N4),TFLWHL(N3,N2,N1) -C 3,FLWHL(N,N3,N2,N1),FLWHL(N,N6,N5,N4) +C IF(I.EQ.346)THEN +C WRITE(*,3378)'THFLW',I,J,M,N1,N2,N3,N4,N5,N6,N +C 2,TFLWL(N3,N2,N1),FLWL(N,N3,N2,N1),FLWL(N,N6,N5,N4) +C 2,THFLWL(N3,N2,N1),HFLWL(N,N3,N2,N1),HFLWL(N,N6,N5,N4) +C 2,FLW(N,N3,N2,N1),FLW(N,N6,N5,N4) +C 2,HFLW(N,N3,N2,N1),HFLW(N,N6,N5,N4) 3378 FORMAT(A8,10I4,20E12.4) C ENDIF + ELSE + TFLWL(N3,N2,N1)=0.0 + TFLWLX(N3,N2,N1)=0.0 + TFLWHL(N3,N2,N1)=0.0 + THFLWL(N3,N2,N1)=0.0 + TWFLXL(N3,N2,N1)=0.0 + TWFLXH(N3,N2,N1)=0.0 + TTFLXL(N3,N2,N1)=0.0 + ENDIF ENDIF 9580 CONTINUE 9585 CONTINUE @@ -2943,10 +3092,10 @@ 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(M+1,NY,NX)=AMAX1(0.0,TVOL1(NY,NX)) -C VOLXP2=(VOLP1(NU(NY,NX),NY,NX)+VOLPH1(NU(NY,NX),NY,NX)) -C 2*AMIN1(1.0,(VOLA(NU(NY,NX),NY,NX)+VOLAH1(NU(NY,NX),NY,NX)) +C VOLXP2=(VOLP1(NUM(NY,NX),NY,NX)+VOLPH1(NUM(NY,NX),NY,NX)) +C 2*AMIN1(1.0,(VOLA(NUM(NY,NX),NY,NX)+VOLAH1(NUM(NY,NX),NY,NX)) C 3/TVOL1(NY,NX)) -C VOLPX1(NU(NY,NX),NY,NX)=VOLXP2*HYST(NU(NY,NX),NY,NX) +C VOLPX1(NUM(NY,NX),NY,NX)=VOLXP2*HYST(NUM(NY,NX),NY,NX) VOLW1(0,NY,NX)=AMAX1(0.0,VOLW1(0,NY,NX)+FLWRL(NY,NX) 2+WFLXR(NY,NX)+TQR1(NY,NX)) VOLI1(0,NY,NX)=AMAX1(0.0,VOLI1(0,NY,NX)-WFLXR(NY,NX)/DENSI) @@ -2971,40 +3120,49 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) C 3,THETIX(0,NY,NX),THETPX(0,NY,NX),TVOL1(NY,NX),VOLWD(NY,NX) 7752 FORMAT(A8,5I4,20E12.4) C ENDIF - ENGYR=VHCPR1(NY,NX)*TK1(0,NY,NX) - VHCPR1(NY,NX)=2.496E-06*ORGC(0,NY,NX)+4.19*VOLW1(0,NY,NX) + ENGYR=VHCP1(0,NY,NX)*TK1(0,NY,NX) + VHCP1(0,NY,NX)=2.496E-06*ORGC(0,NY,NX)+4.19*VOLW1(0,NY,NX) 2+1.9274*VOLI1(0,NY,NX) - IF(VHCPR1(NY,NX).GT.VHCPRX(NY,NX))THEN + IF(VHCP1(0,NY,NX).GT.VHCPRX(NY,NX))THEN TK1(0,NY,NX)=(ENGYR+HFLWRL(NY,NX)+TFLXR(NY,NX) - 2+THQR1(NY,NX))/VHCPR1(NY,NX) + 2+THQR1(NY,NX))/VHCP1(0,NY,NX) +C IF(I.EQ.187)THEN C WRITE(*,7754)'TKR',I,J,M,NX,NY,TK1(0,NY,NX),ENGYR,HFLWRL(NY,NX) -C 2,TFLXR(NY,NX),THQR1(NY,NX),VHCPR1(NY,NX),VOLW1(0,NY,NX) -7754 FORMAT(A8,5I4,30E12.4) +C 2,TFLXR(NY,NX),THQR1(NY,NX),VHCP1(0,NY,NX),VOLW1(0,NY,NX) +7754 FORMAT(A8,5I4,30E12.4) +C ENDIF ELSE - TK1(0,NY,NX)=TK1(NU(NY,NX),NY,NX) + TK1(0,NY,NX)=TK1(NUM(NY,NX),NY,NX) ENDIF C C SOIL SURFACE WATER FROM RUNOFF C - VOLI1(NU(NY,NX),NY,NX)=VOLI1(NU(NY,NX),NY,NX)+FLSI1(NY,NX) - ENGY1=VHCP1(NU(NY,NX),NY,NX)*TK1(NU(NY,NX),NY,NX) - VHCP1(NU(NY,NX),NY,NX)=VHCM(NU(NY,NX),NY,NX) - 2+4.19*(VOLW1(NU(NY,NX),NY,NX)+VOLWH1(NU(NY,NX),NY,NX)) - 3+1.9274*(VOLI1(NU(NY,NX),NY,NX)+VOLIH1(NU(NY,NX),NY,NX)) - TK1(NU(NY,NX),NY,NX)=(ENGY1+HFLSI1(NY,NX)) - 2/VHCP1(NU(NY,NX),NY,NX) -C WRITE(*,7755)'TQR',I,J,M,NX,NY,VOLW1(NU(NY,NX),NY,NX) -C 2,VOLWH1(NU(NY,NX),NY,NX),TQR1(NY,NX) -C WRITE(*,7755)'TK1',I,J,M,NX,NY,TK1(NU(NY,NX),NY,NX) -C 2,VHCP1(NU(NY,NX),NY,NX),VHCM(NU(NY,NX),NY,NX) + VOLI1(NUM(NY,NX),NY,NX)=VOLI1(NUM(NY,NX),NY,NX)+FLSI1(NY,NX) + ENGY1=VHCP1(NUM(NY,NX),NY,NX)*TK1(NUM(NY,NX),NY,NX) + VHCP1(NUM(NY,NX),NY,NX)=VHCM(NUM(NY,NX),NY,NX) + 2+4.19*(VOLW1(NUM(NY,NX),NY,NX)+VOLWH1(NUM(NY,NX),NY,NX)) + 3+1.9274*(VOLI1(NUM(NY,NX),NY,NX)+VOLIH1(NUM(NY,NX),NY,NX)) + IF(VHCP1(NUM(NY,NX),NY,NX).GT.ZEROS(NY,NX))THEN + TK1(NUM(NY,NX),NY,NX)=(ENGY1+HFLSI1(NY,NX)) + 2/VHCP1(NUM(NY,NX),NY,NX) + ELSE + TK1(NUM(NY,NX),NY,NX)=TKQ(NY,NX) + ENDIF +C IF(I.EQ.168)THEN +C WRITE(*,7755)'TQR',I,J,M,NX,NY,VOLW1(NUM(NY,NX),NY,NX) +C 2,VOLWH1(NUM(NY,NX),NY,NX),TQR1(NY,NX) +C WRITE(*,7755)'TK1',I,J,M,NX,NY,TK1(NUM(NY,NX),NY,NX) +C 2,VHCP1(NUM(NY,NX),NY,NX),VHCM(NUM(NY,NX),NY,NX) C 2,ENGY1,THQR1(NY,NX),HFLSI1(NY,NX),TQR1(NY,NX) -C 3,VOLW1(NU(NY,NX),NY,NX),VOLWH1(NU(NY,NX),NY,NX) -C 4,VOLI1(NU(NY,NX),NY,NX),FLSI1(NY,NX) +C 3,VOLW1(NUM(NY,NX),NY,NX),VOLWH1(NUM(NY,NX),NY,NX) +C 4,VOLI1(NUM(NY,NX),NY,NX),FLSI1(NY,NX) 7755 FORMAT(A8,5I4,20E12.4) +C ENDIF C C SOIL LAYER WATER, ICE AND TEMPERATURE C - DO 9785 L=NU(NY,NX),NL(NY,NX) + DO 9785 L=NUM(NY,NX),NL(NY,NX) + IF(VOLT(L,NY,NX).GT.ZEROS(NY,NX))THEN VOLW1(L,NY,NX)=VOLW1(L,NY,NX)+TFLWL(L,NY,NX) 2+FINHL(L,NY,NX)+TWFLXL(L,NY,NX)+FLU1(L,NY,NX) VOLWX1(L,NY,NX)=VOLWX1(L,NY,NX)+TFLWLX(L,NY,NX) @@ -3014,12 +3172,20 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) VOLWH1(L,NY,NX)=VOLWH1(L,NY,NX)+TFLWHL(L,NY,NX) 2-FINHL(L,NY,NX)+TWFLXH(L,NY,NX) VOLIH1(L,NY,NX)=VOLIH1(L,NY,NX)-TWFLXH(L,NY,NX)/DENSI + IF(BKDS(L,NY,NX).GT.ZERO)THEN VOLP1(L,NY,NX)=AMAX1(0.0,VOLA(L,NY,NX)-VOLW1(L,NY,NX) 2-VOLI1(L,NY,NX)) + ELSE + VOLP1(L,NY,NX)=0.0 + ENDIF VOLAH1(L,NY,NX)=AMAX1(0.0,VOLAH(L,NY,NX)-FVOLAH*CCLAY(L,NY,NX) 2*(VOLW1(L,NY,NX)/VOLX(L,NY,NX)-WP(L,NY,NX))*VOLT(L,NY,NX)) + IF(BKDS(L,NY,NX).GT.ZERO)THEN VOLPH1(L,NY,NX)=AMAX1(0.0,VOLAH1(L,NY,NX)-VOLWH1(L,NY,NX) 2-VOLIH1(L,NY,NX)) + ELSE + VOLPH1(L,NY,NX)=0.0 + ENDIF VOLPX1(L,NY,NX)=VOLP1(L,NY,NX)*HYST(L,NY,NX) VOLWM(M+1,L,NY,NX)=VOLW1(L,NY,NX) VOLWHM(M+1,L,NY,NX)=VOLWH1(L,NY,NX) @@ -3054,9 +3220,9 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) VHCP1(L,NY,NX)=VHCM(L,NY,NX)+4.19*(VOLW1(L,NY,NX) 2+VOLWH1(L,NY,NX))+1.9274*(VOLI1(L,NY,NX)+VOLIH1(L,NY,NX)) C -C ARTIFICIAL SOIL WARMING +C BEGIN ARTIFICIAL SOIL WARMING C -C IF(NX.EQ.3.AND.NY.EQ.2.AND.L.GT.NU(NY,NX) +C IF(NX.EQ.3.AND.NY.EQ.2.AND.L.GT.NUM(NY,NX) C 3.AND.L.LE.17.AND.I.GE.152.AND.I.LE.304)THEN C THFLWL(L,NY,NX)=THFLWL(L,NY,NX) C 2+(TKSZ(I,J,L)-TK1(L,NY,NX))*VHCP1(L,NY,NX)*XNPH @@ -3065,39 +3231,98 @@ SUBROUTINE watsub(I,J,NHW,NHE,NVN,NVS) 3379 FORMAT(A8,6I4,12E12.4) C ENDIF C -C ARTIFICIAL SOIL WARMING +C END ARTIFICIAL SOIL WARMING C + IF(VHCP1(L,NY,NX).GT.ZEROS(NY,NX))THEN TK1(L,NY,NX)=(ENGY1+THFLWL(L,NY,NX)+TTFLXL(L,NY,NX) 2+HWFLU1(L,NY,NX))/VHCP1(L,NY,NX) -C IF(J.EQ.24.AND.L.EQ.NU(NY,NX))THEN -C WRITE(*,3377)'VOLW1',I,J,M,NX,NY,L,VOLW1(L,NY,NX) + ELSE + TK1(L,NY,NX)=TKQ(NY,NX) + ENDIF + ELSE + VOLWM(M+1,L,NY,NX)=0.0 + VOLWHM(M+1,L,NY,NX)=0.0 + VOLPM(M+1,L,NY,NX)=0.0 + FLPM(M,L,NY,NX)=VOLPM(M,L,NY,NX) + THETPM(M+1,L,NY,NX)=0.0 + ENDIF +C IF(IYRC.EQ.2006.AND.I.EQ.361.AND.NX.EQ.1)THEN +C WRITE(*,3377)'VOLW1',I,J,M,NX,NY,L,N6X(NY,NX),VOLW1(L,NY,NX) +C 2,TFLWL(L,NY,NX),FINHL(L,NY,NX),TWFLXL(L,NY,NX),FLU1(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 3,VOLP1(L,NY,NX),VOLPH1(L,NY,NX),VOLT(L,NY,NX),VOLX(L,NY,NX) +C 4,VOLA(L,NY,NX),VOLAH(L,NY,NX),DLYR(3,L,NY,NX) C 5,VOLPM(M,L,NY,NX),VOLPM(M+1,L,NY,NX) -C 2,TFLWL(L,NY,NX),FINHL(L,NY,NX),TWFLXL(L,NY,NX),FLU1(L,NY,NX) -C 3,TQR1(NY,NX),VOLP1(L,NY,NX) +C 3,TQR1(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 6,FLW(3,L,NY,NX),FLW(3,L+1,NY,NX) +C 7,FLW(2,L,NY,NX),FLW(2,L,NY+1,NX) +C 8,FLW(1,L,NY,NX),FLW(1,L,NY,NX+1) C 9,FLPM(M,L,NY,NX) -C WRITE(*,3377)'VOLWH1',I,J,M,NX,NY,L,VOLWH1(L,NY,NX) +C WRITE(*,3377)'VOLWH1',I,J,M,NX,NY,L,N6X(NY,NX),VOLWH1(L,NY,NX) C 2,TFLWHL(L,NY,NX),FINHL(L,NY,NX),VOLIH1(L,NY,NX) C 4,TWFLXH(L,NY,NX),TQR1(NY,NX),VOLPH1(L,NY,NX) -C 5,FLWHL(2,L,NY,NX),FLWHL(2,L,NY+1,NX) -C WRITE(*,3377)'TKL',I,J,M,NX,NY,L,TK1(L,NY,NX),ENGY1 +C 6,FLWHL(3,L,NY,NX),FLWHL(3,L+1,NY,NX) +C 7,FLWHL(2,L,NY,NX),FLWHL(2,L,NY+1,NX) +C 8,FLWHL(1,L,NY,NX),FLWHL(1,L,NY,NX+1) +C WRITE(*,3377)'TKL',I,J,M,NX,NY,L,N6X(NY,NX),TK1(L,NY,NX),ENGY1 C 2,THFLWL(L,NY,NX),TTFLXL(L,NY,NX),HWFLU1(L,NY,NX),VHCP1(L,NY,NX) C 3,VHCM(L,NY,NX),VOLW1(L,NY,NX),VOLWH1(L,NY,NX),VOLI1(L,NY,NX) C 4,THETW(L,NY,NX),THETI(L,NY,NX),FINHL(L,NY,NX),THQR1(NY,NX) -C 5,HFLSI1(NY,NX),HFLWL(2,L,NY,NX),HFLWL(2,L,NY+1,NX) -3377 FORMAT(A8,6I4,40E12.4) +C 5,HFLSI1(NY,NX),HFLWL(3,L,NY,NX),HFLWL(3,N6X(NY,NX),NY,NX) +C 6,HFLWL(1,L,NY,NX),HFLWL(1,L,NY,NX+1) +3377 FORMAT(A8,7I4,40E12.4) C ENDIF 9785 CONTINUE +C +C RESET SURFACE LAYER NUMBER IF LOST TO EVAPORATION +C + IF(BKDS(NUM(NY,NX),NY,NX).LE.ZERO + 2.AND.VHCP1(NUM(NY,NX),NY,NX).LE.VHCPNX(NY,NX))THEN + NUX=NUM(NY,NX) + DO 9970 LL=NUX+1,NL(NY,NX) + IF(VOLX(LL,NY,NX).GT.ZEROS(NY,NX))THEN + NUM(NY,NX)=LL + FLWNX(NY,NX)=FLW(3,NUM(NY,NX),NY,NX) + FLWXNX(NY,NX)=FLWX(3,NUM(NY,NX),NY,NX) + FLWHNX(NY,NX)=FLWH(3,NUM(NY,NX),NY,NX) + HFLWNX(NY,NX)=HFLW(3,NUM(NY,NX),NY,NX) + WRITE(*,5598)'SURFM',I,J,M,NX,NY,LL,NUX,NUM(NY,NX) + 2,VOLW1(NUX,NY,NX),VOLW1(NUM(NY,NX),NY,NX) + 2,VHCP1(NUX,NY,NX),VHCP1(NUM(NY,NX),NY,NX) + 2,TK1(NUX,NY,NX),TK1(NUM(NY,NX),NY,NX) + 3,FLW(3,NUX,NY,NX),FLW(3,NUM(NY,NX),NY,NX) + 3,HFLW(3,NUX,NY,NX),HFLW(3,NUM(NY,NX),NY,NX) +5598 FORMAT(A8,8I4,20E12.4) + GO TO 9971 + ENDIF +9970 CONTINUE + ENDIF +9971 CONTINUE 9790 CONTINUE 9795 CONTINUE + ELSE + DO 9695 NX=NHW,NHE + DO 9690 NY=NVN,NVS + IF(NUM(NY,NX).EQ.NU(NY,NX))THEN + FLWNU(NY,NX)=FLW(3,N6X(NY,NX),NY,NX) + FLWXNU(NY,NX)=FLWX(3,N6X(NY,NX),NY,NX) + FLWHNU(NY,NX)=FLWH(3,N6X(NY,NX),NY,NX) + HFLWNU(NY,NX)=HFLW(3,N6X(NY,NX),NY,NX) + ELSE + FLWNU(NY,NX)=FLWNX(NY,NX) + FLWXNU(NY,NX)=FLWXNX(NY,NX) + FLWHNU(NY,NX)=FLWHNX(NY,NX) + HFLWNU(NY,NX)=HFLWNX(NY,NX) + ENDIF +9690 CONTINUE +9695 CONTINUE ENDIF 3320 CONTINUE RETURN END + diff --git a/f77src/woutp.f b/f77src/woutp.f old mode 100755 new mode 100644 diff --git a/f77src/woutq.f b/f77src/woutq.f old mode 100755 new mode 100644 diff --git a/f77src/wouts.f b/f77src/wouts.f old mode 100755 new mode 100644 index 61b7fdc..96e1732 --- a/f77src/wouts.f +++ b/f77src/wouts.f @@ -47,7 +47,7 @@ SUBROUTINE wouts(I,NHW,NHE,NVN,NVS) 2,IFNOB(NY,NX),IFPOB(NY,NX),IUTYP(NY,NX),ZT(NY,NX),TFLWC(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) + 5,DPTHS(NY,NX),TCW(NY,NX),TKW(NY,NX),VHCPW(NY,NX) 6,VOLWG(NY,NX),URAIN(NY,NX),ARLFC(NY,NX),ARSTC(NY,NX),PPT(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) @@ -81,6 +81,7 @@ SUBROUTINE wouts(I,NHW,NHE,NVN,NVS) WRITE(21,91)I,IDATA(3),(FHOL(L,NY,NX),L=1,NL(NY,NX)) WRITE(21,91)I,IDATA(3),(DLYR(3,L,NY,NX),L=0,NL(NY,NX)) WRITE(21,91)I,IDATA(3),(CDPTH(L,NY,NX),L=0,NL(NY,NX)) + WRITE(21,91)I,IDATA(3),(CDPTHZ(L,NY,NX),L=0,NL(NY,NX)) WRITE(21,91)I,IDATA(3),(BKDS(L,NY,NX),L=1,NL(NY,NX)) WRITE(21,91)I,IDATA(3),(CORGC(L,NY,NX),L=0,NL(NY,NX)) WRITE(21,91)I,IDATA(3),(POROS(L,NY,NX),L=1,NL(NY,NX)) @@ -108,8 +109,8 @@ SUBROUTINE wouts(I,NHW,NHE,NVN,NVS) WRITE(21,91)I,IDATA(3),(XAEC(L,NY,NX),L=1,NL(NY,NX)) WRITE(21,91)I,IDATA(3),(TCS(L,NY,NX),L=0,NL(NY,NX)) WRITE(21,91)I,IDATA(3),(TKS(L,NY,NX),L=0,NL(NY,NX)) - WRITE(21,91)I,IDATA(3),(VHCP(L,NY,NX),L=1,NL(NY,NX)) - WRITE(21,91)I,IDATA(3),(VHCM(L,NY,NX),L=1,NL(NY,NX)) + WRITE(21,91)I,IDATA(3),(VHCP(L,NY,NX),L=0,NL(NY,NX)) + WRITE(21,91)I,IDATA(3),(VHCM(L,NY,NX),L=0,NL(NY,NX)) WRITE(21,91)I,IDATA(3),(CO2G(L,NY,NX),L=1,NL(NY,NX)) WRITE(21,91)I,IDATA(3),(CO2S(L,NY,NX),L=0,NL(NY,NX)) WRITE(21,91)I,IDATA(3),(CO2SH(L,NY,NX),L=1,NL(NY,NX)) diff --git a/f77src/wthr.f b/f77src/wthr.f old mode 100755 new mode 100644