SUBROUTINE CLASSW(THLIQ, THICE, TBAR, TCAN, RCAN, SCAN, 1,58
1 RUNOFF, SNO, TSNOW, RHOSNO, ALBSNO,
2 ZPOND, TPOND, GROWTH, TBASE,
3 PCFC, PCLC, PCPN, PCPG, QFCF, QFCL,
4 QFN, QFG, QFC, HMFC, HMFG, HMFN,
5 HTCC, HTCS, HTC, ROFC, ROFN, ROVG,
6 WTRS, WTRG, OVRFLW, SUBFLW, BASFLW, EVAP,
7 TBARC, TBARG, TBARCS, TBARGS, THLIQC, THLIQG,
8 THICEC, THICEG, HCPC, HCPG, RPCP, TRPCP,
9 SPCP, TSPCP, PCPR, TA, RHOSNI,
A FC, FG, FCS, FGS, TPONDC, TPONDG,
B TPNDCS, TPNDGS, EVAPC, EVAPCG, EVAPG, EVAPCS,
C EVPCSG, EVAPGS, QFREZC, QFREZG, QMELTC, QMELTG,
D RAICAN, SNOCAN, RAICNS, SNOCNS, FROOT, AILCAN,
E AILCNS, FSVF, FSVFS, CWCAP, CWCAPS, TCANO,
F TCANS, CHCAP, CHCAPS, CMASSC, CMASCS, ZSNOW,
G GZEROC, GZEROG, GZROCS, GZROGS, G12C, G12G,
H G12CS, G12GS, G23C, G23G, G23CS, G23GS,
I TSNOCS, TSNOGS, ZPLIMC, ZPLIMG, ZPLMCS, ZPLMGS,
J THPOR, THLRET, THLMIN, BI, PSISAT, GRKSAT,
K GRKTLD, THLRAT, THFC, XDRAIN, HCPS,
L DELZW, ZBOTW, XSLOPE, GRKFAC, WFSURF, WFCINT,
M ISAND, IWF, ILG, IL1, IL2,
N JL, IC, IG, IGP1, IGP2,
O NLANDCS,NLANDGS,NLANDC, NLANDG, NLANDI)
C
C * AUG 19/04 - Y.DELAGE. REMOVE WORK ARRAYS FROM ARGUMENT LIST
C REGROUP COMMON BLOCKS
C MAKE DECLARATIONS EXPLICIT
C * DEC 09/02 - D.VERSEGHY. SWITCH CALLING ORDER OF TFREEZ AND
C * SNOVAP FOR CONSISTENCY WITH DIAGNOSTICS.
C * SEP 26.02 - D.VERSEGHY. CHANGED CALL TO SUBCAN.
C * AUG 01/02 - D.VERSEGHY. ADD CALL TO WATROF, NEW SUBROUTINE
C * CONTAINING WATERLOO OVERLAND FLOW
C * AND INTERFLOW CALCULATIONS.
C * SHORTENED CLASS3 COMMON BLOCK.
C * JUL 03/02 - D.VERSEGHY. STREAMLINE SUBROUTINE CALLS; MOVE
C * CALCULATION OF BACKGROUND SOIL
C * PROPERTIES INTO "CLASSB"; CHANGE
C * RHOSNI FROM CONSTANT TO VARIABLE.
C * OCT 04/01 - M.LAZARE. REMOVE SEVERAL OLD DIAGNOSTIC FIELDS
C * AND ADD NEW FIELD "ROVG".
C * MAY 14/01 - M.LAZARE. ADD CALLS TO SUBROUTINE "SNOVAP" FOR
C * FC AND FG SUBAREAS OF GRID CELL.
C * OCT 20/00 - D.VERSEGHY. ADD WORK ARRAY "RHOMAX" FOR SNOALBW.
C * JUN 20/97 - D.VERSEGHY. CLASS - VERSION 2.7.
C * CHANGES RELATED TO VARIABLE SOIL DEPTH
C * (MOISTURE HOLDING CAPACITY) AND DEPTH-
C * VARYING SOIL PROPERTIES.
C * JAN 02/96 - D.VERSEGHY. CLASS - VERSION 2.5.
C * COMPLETION OF ENERGY BALANCE
C * DIAGNOSTICS; INTRODUCE CALCULATION OF
C * OVERLAND FLOW.
C * AUG 30/95 - D.VERSEGHY. CLASS - VERSION 2.4.
C * VARIABLE SURFACE DETENTION CAPACITY
C * IMPLEMENTED.
C * AUG 24/95 - D.VERSEGHY. UPDATE ARRAY "EVAP" TO TAKE INTO
C * ACCOUNT "WLOST"; RATIONALIZE
C * CALCULATION OF THE LATTER.
C * COMPLETION OF WATER BUDGET DIAGNOSTICS.
C * AUG 18/95 - D.VERSEGHY. REVISIONS TO ALLOW FOR INHOMOGENEITY
C * BETWEEN SOIL LAYERS AND FRACTIONAL
C * ORGANIC MATTER CONTENT.
C * DEC 22/94 - D.VERSEGHY. CLASS - VERSION 2.3.
C * CHANGES TO SUBROUTINE CALLS ASSOCIATED
C * WITH REVISIONS TO DIAGNOSTICS.
C * ALLOW SPECIFICATION OF LIMITING POND
C * DEPTH "PNDLIM" (PARALLEL CHANGES MADE
C * SIMULTANEOUSLY IN TMCALC).
C * DEC 16/94 - D.VERSEGHY. TWO NEW DIAGNOSTIC FIELDS.
C * NOV 18/93 - D.VERSEGHY. LOCAL VERSION WITH INTERNAL WORK ARRAYS
C * HARD-CODED FOR USE ON PCS.
C * NOV 01/93 - D.VERSEGHY. CLASS - VERSION 2.2.
C * REVISIONS ASSOCIATED WITH NEW VERSION
C * OF TMCALC.
C * JUL 30/93 - D.VERSEGHY/M.LAZARE. NUMEROUS NEW DIAGNOSTIC FIELDS.
C * MAY 06/93 - D.VERSEGHY/M.LAZARE. CORRECT BUG IN CALL TO TMCALC
C * FOR CANOPY-SNOW CASE, WHERE
C * SHOULD BE PASSING "HCPCS"
C * INSTEAD OF "HCPGS".
C * MAY 15/92 - D.VERSEGHY/M.LAZARE. REVISED AND VECTORIZED CODE
C * FOR MODEL VERSION GCM7.
C * AUG 12/91 - D.VERSEGHY. CODE FOR MODEL VERSION GCM7U -
C CLASS VERSION 2.0 (WITH CANOPY).
C * APR 11/89 - D.VERSEGHY. LAND SURFACE WATER BUDGET CALCULATIONS.
C
IMPLICIT NONE
INTEGER IWF,I, ILG,IL1, IL2,JL, IC,IG,IGP1,IGP2,J
INTEGER IPTBAD,JPTBAD,KPTBAD,LPTBAD
INTEGER NLANDCS,NLANDGS,NLANDC, NLANDG, NLANDI
C * MAIN OUTPUT FIELDS.
C
REAL THLIQ (ILG,IG), THICE (ILG,IG), TBAR (ILG,IG)
C
REAL TCAN (ILG), RCAN (ILG), SCAN (ILG), RUNOFF(ILG),
1 SNO (ILG), TSNOW (ILG), RHOSNO(ILG), ALBSNO(ILG),
2 ZPOND (ILG), TPOND (ILG), GROWTH(ILG), TBASE (ILG)
C
C * DIAGNOSTIC ARRAYS.
C
REAL PCFC (ILG), PCLC (ILG), PCPN (ILG), PCPG (ILG),
1 QFCF (ILG), QFCL (ILG), QFN (ILG), QFG (ILG),
2 HMFC (ILG), HMFN (ILG), HTCC (ILG), HTCS (ILG),
3 ROFC (ILG), ROFN (ILG), ROVG (ILG), WTRS (ILG),
4 WTRG (ILG), OVRFLW(ILG), SUBFLW(ILG), BASFLW(ILG),
5 EVAP (ILG)
C
REAL QFC (ILG,IG), HMFG (ILG,IG), HTC (ILG,IG)
C
C * I/O FIELDS PASSED THROUGH CLASS.
C
REAL RPCP (ILG), TRPCP (ILG), SPCP (ILG), TSPCP (ILG),
1 PCPR (ILG), TA (ILG)
C
REAL TBARC(ILG,IG), TBARG(ILG,IG), TBARCS(ILG,IG),TBARGS(ILG,IG),
1 THLIQC(ILG,IG),THLIQG(ILG,IG),THICEC(ILG,IG),THICEG(ILG,IG),
2 HCPC (ILG,IG),HCPG (ILG,IG),FROOT(ILG,IG)
C
REAL FC (ILG), FG (ILG), FCS (ILG), FGS (ILG),
1 TPONDC(ILG), TPONDG(ILG), TPNDCS(ILG), TPNDGS(ILG),
2 EVAPC (ILG), EVAPCG(ILG), EVAPG (ILG), EVAPCS(ILG),
3 EVPCSG(ILG), EVAPGS(ILG), QFREZC(ILG), QFREZG(ILG),
4 QMELTC(ILG), QMELTG(ILG), RAICAN(ILG), SNOCAN(ILG),
5 RAICNS(ILG), SNOCNS(ILG), AILCAN(ILG), AILCNS(ILG),
6 FSVF (ILG), FSVFS (ILG), CWCAP (ILG), CWCAPS(ILG),
7 TCANO (ILG), TCANS (ILG), CHCAP (ILG), CHCAPS(ILG),
8 CMASSC(ILG), CMASCS(ILG), ZSNOW (ILG), RHOSNI(ILG),
9 GZEROC(ILG), GZEROG(ILG), GZROCS(ILG), GZROGS(ILG),
A G12C (ILG), G12G (ILG), G12CS (ILG), G12GS (ILG),
B G23C (ILG), G23G (ILG), G23CS (ILG), G23GS (ILG),
C TSNOCS(ILG), TSNOGS(ILG), ZPLIMC(ILG), ZPLIMG(ILG),
D ZPLMCS(ILG), ZPLMGS(ILG)
C
C * SOIL PROPERTY ARRAYS.
C
REAL THPOR (ILG,IG),THLRET(ILG,IG),THLMIN(ILG,IG),BI (ILG,IG),
1 GRKSAT(ILG,IG),PSISAT(ILG,IG),GRKTLD(ILG,IG),THLRAT(ILG,IG),
2 THFC (ILG,IG),HCPS (ILG,IG),DELZW (ILG,IG),DELZZ (ILG,IG),
3 ZBOTW (ILG,IG),XDRAIN(ILG), XSLOPE(ILG), GRKFAC(ILG),
4 WFSURF(ILG), WFCINT(ILG)
C
INTEGER ISAND(ILG,IG)
C
C * INTERNAL WORK ARRAYS USED THROUGHOUT CLASSW.
C
REAL TBARWC(ILG,IG),TBARWG(ILG,IG),TBRWCS(ILG,IG),TBRWGS(ILG,IG),
1 THLQCO(ILG,IG),THLQGO(ILG,IG),THLQCS(ILG,IG),THLQGS(ILG,IG),
2 THICCO(ILG,IG),THICGO(ILG,IG),THICCS(ILG,IG),THICGS(ILG,IG),
3 HCPCO (ILG,IG),HCPGO (ILG,IG),HCPCS (ILG,IG),HCPGS (ILG,IG)
C
REAL SPCC (ILG), SPCG (ILG), SPCCS (ILG), SPCGS (ILG),
1 TSPCC (ILG), TSPCG (ILG), TSPCCS(ILG), TSPCGS(ILG),
2 RPCC (ILG), RPCG (ILG), RPCCS (ILG), RPCGS (ILG),
3 TRPCC (ILG), TRPCG (ILG), TRPCCS(ILG), TRPCGS(ILG),
4 EVPIC (ILG), EVPIG (ILG), EVPICS(ILG), EVPIGS(ILG),
5 ZPONDC(ILG), ZPONDG(ILG), ZPNDCS(ILG), ZPNDGS(ILG),
6 XSNOWC(ILG), XSNOWG(ILG), XSNOCS(ILG), XSNOGS(ILG),
7 ZSNOWC(ILG), ZSNOWG(ILG), ZSNOCS(ILG), ZSNOGS(ILG),
8 ALBSC (ILG), ALBSG (ILG), ALBSCS(ILG), ALBSGS(ILG),
9 RHOSC (ILG), RHOSG (ILG), RHOSCS(ILG), RHOSGS(ILG),
A HCPSC (ILG), HCPSG (ILG), HCPSCS(ILG), HCPSGS(ILG),
B RUNFC (ILG), RUNFG (ILG), RUNFCS(ILG), RUNFGS(ILG)
C
REAL SUBLC (ILG), SUBLCS(ILG), WLOSTC(ILG), WLOSTG(ILG),
1 WLSTCS(ILG), WLSTGS(ILG), RAC (ILG), RACS (ILG),
2 SNC (ILG), SNCS (ILG), TSNOWC(ILG), TSNOWG(ILG),
3 DT (ILG), ZERO (ILG), RALB (ILG)
C
C * INTERNAL WORK ARRAYS FOR WPREP AND CANADD.
C
REAL RADD (ILG), SADD (ILG)
C
C * INTERNAL WORK FIELDS FOR GRINFL/GRDRAN/ICEBAL (AND THEIR CALLED
C * ROUTINES (I.E. WFILL,WFLOW,WEND).
C
REAL ZMAT (ILG,IGP2,IGP1)
C
REAL WMOVE (ILG,IGP2), TMOVE (ILG,IGP2)
C
REAL THLIQX(ILG,IGP1), THICEX(ILG,IGP1), TBARWX(ILG,IGP1),
1 DELZX (ILG,IGP1), ZBOTX (ILG,IGP1), FDT (ILG,IGP1),
2 TFDT (ILG,IGP1), PSIF (ILG,IGP1), THLINF(ILG,IGP1),
3 GRKINF(ILG,IGP1), FDUMMY(ILG,IGP1), TDUMMY(ILG,IGP1),
4 ZRMDR (ILG,IGP1)
C
REAL THLMAX(ILG,IG), THTEST(ILG,IG), THLDUM(ILG,IG),
1 THIDUM(ILG,IG), TDUMW (ILG,IG)
C
REAL TRMDR (ILG), ZF (ILG), FMAX (ILG), TUSED (ILG),
1 RDUMMY(ILG), WEXCES(ILG), FDTBND(ILG), WADD (ILG),
2 TADD (ILG), WADJ (ILG), TIMPND(ILG), DZF (ILG),
3 DTFLOW(ILG), THLNLZ(ILG), THLQLZ(ILG), DZDISP(ILG),
4 WDISP (ILG), WABS (ILG), ZMOVE (ILG), TBOT (ILG)
C
INTEGER IGRN (ILG), IGRD (ILG), IZERO (ILG),
1 IFILL (ILG), LZF (ILG), NINF (ILG),
2 IFIND (ILG), ITER (ILG), NEND (ILG),
3 ISIMP (ILG), ICONT (ILG)
C
C * INTERNAL WORK ARRAYS FOR CANVAP AND SNOALBW.
C
REAL EVLOST(ILG), RLOST (ILG), RHOMAX(ILG)
C
INTEGER IROOT (ILG)
C
C * INTERNAL WORK ARRAYS FOR WATROF.
C
REAL THCRIT(ILG,IG), DODRN (ILG), DOVER(ILG),
1 DIDRN (ILG,IG), DIDRNMX(ILG,IG)
C
C * INTERNAL WORK ARRAYS FOR CHKWAT.
C
REAL BAL (ILG)
real zpacc,tpacc
C
#include "class_com.cdk"
C
C-----------------------------------------------------------------------
C * PREPARATION.
C
CALL WPREP(THLQCO, THLQGO, THLQCS, THLQGS, THICCO, THICGO,
1 THICCS, THICGS, HCPCO, HCPGO, HCPCS, HCPGS,
2 SPCC, SPCG, SPCCS, SPCGS, TSPCC, TSPCG,
3 TSPCCS, TSPCGS, RPCC, RPCG, RPCCS, RPCGS,
4 TRPCC, TRPCG, TRPCCS, TRPCGS, EVPIC, EVPIG,
5 EVPICS, EVPIGS, ZPONDC, ZPONDG, ZPNDCS, ZPNDGS,
6 XSNOWC, XSNOWG, XSNOCS, XSNOGS, ZSNOWC, ZSNOWG,
7 ZSNOCS, ZSNOGS, ALBSC, ALBSG, ALBSCS, ALBSGS,
8 RHOSC, RHOSG, RHOSCS, RHOSGS, HCPSC, HCPSG,
9 HCPSCS, HCPSGS, RUNFC, RUNFG, RUNFCS, RUNFGS,
A SUBLC, SUBLCS, WLOSTC, WLOSTG, WLSTCS, WLSTGS,
B RAC, RACS, SNC, SNCS, TSNOWC, TSNOWG,
C OVRFLW, SUBFLW, BASFLW,
D PCFC, PCLC, PCPN, PCPG, QFCF, QFCL,
E QFN, QFG, QFC, HMFN, HMFG,
F ROVG, ROFC, ROFN,
G DT, ZERO, IZERO, DELZZ,
H FC, FG, FCS, FGS,
I THLIQC, THLIQG, THICEC, THICEG, HCPC, HCPG,
J FSVF, FSVFS, RAICAN, SNOCAN, RAICNS, SNOCNS,
K EVAPC, EVAPCG, EVAPG, EVAPCS, EVPCSG, EVAPGS,
L RPCP, TRPCP, SPCP, TSPCP, RHOSNI,
M ZPOND, ZSNOW, ALBSNO, RHOSNO,
N THPOR, HCPS, ISAND, DELZW,
O ILG, IL1, IL2, JL, IG,
P NLANDCS,NLANDGS,NLANDC, NLANDG, RADD, SADD )
C
C * CALCULATIONS FOR CANOPY OVER SNOW.
C
IF(NLANDCS.GT.0) THEN
CALL CANVAP(EVAPCS,SUBLCS,RAICNS,SNOCNS,TCANS,THLQCS,
1 TBARCS,ZSNOCS,WLSTCS,CHCAPS,QFCF,QFCL,QFN,QFC,
2 HTCC,HTCS,HTC,FCS,CMASCS,TSNOCS,HCPSCS,RHOSCS,
3 FROOT,THPOR,THLMIN,DELZW,EVLOST,RLOST,IROOT,
4 IG,ILG,IL1,IL2,JL )
CALL CANADD(2,RPCCS,TRPCCS,SPCCS,TSPCCS,RAICNS,SNOCNS,
1 TCANS,CHCAPS,HTCC,ROFC,ROVG,PCPN,PCPG,
2 FCS,AILCNS,FSVFS,CWCAPS,CMASCS,RHOSNI,RADD,SADD,
3 ILG,IL1,IL2,JL)
CALL CWCALC(TCANS,RAICNS,SNOCNS,CHCAPS,HMFC,HTCC,
1 FCS,CMASCS,ILG,IL1,IL2,JL)
CALL SUBCAN(2,RPCCS,TRPCCS,SPCCS,TSPCCS,RHOSNI,EVPCSG,
1 QFN,QFG,FCS,ILG,IL1,IL2,JL)
CALL TWCALC(TBARCS,THLQCS,THICCS,HCPCS,TBRWCS,HMFG,HTC,
1 FCS,ZERO,THPOR,THLMIN,HCPS,DELZW,DELZZ,ISAND,
2 IG,ILG,IL1,IL2,JL)
CALL SNOVAP(RHOSCS,ZSNOCS,HCPSCS,TSNOCS,EVPCSG,
1 QFN,QFG,HTCS,WLSTCS,FCS,RPCCS,SPCCS,RHOSNI,
2 ILG,IL1,IL2,JL)
CALL TFREEZ(ZPNDCS,TPNDCS,ZSNOCS,TSNOCS,ALBSCS,
1 RHOSCS,HCPSCS,GZROCS,HMFG,HTCS,HTC,
2 WTRS,WTRG,FCS,ZERO,TA,TBARCS,ISAND,
3 IG,ILG,IL1,IL2,JL)
CALL TMELT(ZSNOCS,TSNOCS,QMELTC,RPCCS,TRPCCS,
1 GZROCS,RALB,HMFN,HTCS,HTC,FCS,HCPSCS,
2 RHOSCS,ISAND,IG,ILG,IL1,IL2)
CALL SNOADD(ALBSCS,TSNOCS,RHOSCS,ZSNOCS,
1 HCPSCS,HTCS,FCS,SPCCS,TSPCCS,RHOSNI,
2 ILG,IL1,IL2,JL)
CALL SNINFL(RPCCS,TRPCCS,ZSNOCS,TSNOCS,RHOSCS,
1 HCPSCS,HTCS,HMFN,PCPG,ROFN,FCS,ILG,IL1,IL2,JL)
CALL GRINFL(1,THLQCS,THICCS,TBRWCS,BASFLW,RUNFCS,QFG,
1 WLSTCS,FCS,EVPCSG,RPCCS,TRPCCS,TPNDCS,ZPNDCS,
2 DT,ZMAT,WMOVE,TMOVE,THLIQX,THICEX,TBARWX,
3 DELZX,ZBOTX,FDT,TFDT,PSIF,THLINF,GRKINF,
4 THLMAX,THTEST,ZRMDR,FDUMMY,TDUMMY,THLDUM,
5 THIDUM,TDUMW,TRMDR,ZF,FMAX,TUSED,RDUMMY,
6 ZERO,WEXCES,FDTBND,WADD,TADD,WADJ,TIMPND,
7 DZF,DTFLOW,THLNLZ,THLQLZ,DZDISP,WDISP,WABS,
8 THPOR,THLRET,THLMIN,BI,PSISAT,GRKSAT,GRKTLD,
9 THLRAT,DELZW,ZBOTW,XDRAIN,ISAND,IGRN,
A IGRD,IFILL,IZERO,LZF,NINF,IFIND,ITER,
B NEND,ISIMP,IG,IGP1,IGP2,ILG,IL1,IL2,JL )
CALL GRDRAN(1,THLQCS,THICCS,TBRWCS,FDUMMY,TDUMMY,BASFLW,
1 RUNFCS,QFG,WLSTCS,FCS,EVPCSG,RPCCS,ZPNDCS,
2 DT,WEXCES,THLMAX,THTEST,THPOR,THLRET,THLMIN,
3 BI,PSISAT,GRKSAT,DELZW,XDRAIN,ISAND,
4 IGRN,IGRD,IG,IGP1,IGP2,ILG,IL1,IL2,JL )
CALL WATROF(THLQCS,THICCS,ZPNDCS,OVRFLW,SUBFLW,RUNFCS,
1 FCS,ZPLMCS,XSLOPE,GRKFAC,WFSURF,WFCINT,
2 DELZW,THPOR,THLMIN,BI,THFC,THCRIT,DODRN,DOVER,
3 DIDRN,DIDRNMX,ISAND,IWF,IG,ILG,IL1,IL2)
CALL TMCALC(TBARCS,THLQCS,THICCS,HCPCS,TPNDCS,ZPNDCS,
1 TSNOCS,ZSNOCS,ALBSCS,RHOSCS,HCPSCS,TBASE,
2 OVRFLW,RUNFCS,HMFG,HTC,HTCS,WTRS,WTRG,FCS,
3 TBRWCS,GZROCS,G12CS,G23CS,TA,ZPLMCS,
4 THPOR,THLMIN,HCPS,DELZW,DELZZ,
5 ISAND,IWF,IG,ILG,IL1,IL2,JL)
CALL CHKWAT(1,PCPR,EVPICS,RUNFCS,WLSTCS,RAICNS,SNOCNS,
1 RACS,SNCS,ZPNDCS,ZPOND,THLQCS,THICCS,
2 THLIQC,THICEC,ZSNOCS,RHOSCS,XSNOCS,SNO,
3 FCS,FGS,FCS,BAL,THPOR,THLMIN,DELZW,
4 ISAND,IG,ILG,IL1,IL2,JL )
CALL SNOALBW(ALBSCS,RHOSCS,ZSNOCS,HCPSCS,
1 TSNOCS,FCS,SPCCS,RALB,RHOMAX,
2 ISAND,ILG,IG,IL1,IL2,JL)
ENDIF
C
C * CALCULATIONS FOR SNOW-COVERED GROUND.
C
IF(NLANDGS.GT.0) THEN
CALL TWCALC(TBARGS,THLQGS,THICGS,HCPGS,TBRWGS,HMFG,HTC,
1 FGS,ZERO,THPOR,THLMIN,HCPS,DELZW,DELZZ,ISAND,
2 IG,ILG,IL1,IL2,JL)
CALL SNOVAP(RHOSGS,ZSNOGS,HCPSGS,TSNOGS,EVAPGS,
1 QFN,QFG,HTCS,WLSTGS,FGS,RPCGS,SPCGS,RHOSNI,
2 ILG,IL1,IL2,JL)
CALL TFREEZ(ZPNDGS,TPNDGS,ZSNOGS,TSNOGS,ALBSGS,
1 RHOSGS,HCPSGS,GZROGS,HMFG,HTCS,HTC,
2 WTRS,WTRG,FGS,ZERO,TA,TBARGS,ISAND,
3 IG,ILG,IL1,IL2,JL)
CALL TMELT(ZSNOGS,TSNOGS,QMELTG,RPCGS,TRPCGS,
1 GZROGS,RALB,HMFN,HTCS,HTC,FGS,HCPSGS,
2 RHOSGS,ISAND,IG,ILG,IL1,IL2)
CALL SNOADD(ALBSGS,TSNOGS,RHOSGS,ZSNOGS,
1 HCPSGS,HTCS,FGS,SPCGS,TSPCGS,RHOSNI,
2 ILG,IL1,IL2,JL)
CALL SNINFL(RPCGS,TRPCGS,ZSNOGS,TSNOGS,RHOSGS,
1 HCPSGS,HTCS,HMFN,PCPG,ROFN,FGS,ILG,IL1,IL2,JL)
IF(NLANDI.NE.0) THEN
CALL ICEBAL(TBARGS,TPNDGS,ZPNDGS,TSNOGS,RHOSGS,ZSNOGS,
1 HCPSGS,HMFG,HTCS,HTC,WTRS,WTRG,RUNFGS,OVRFLW,
2 FGS,EVAPGS,RPCGS,TRPCGS,GZROGS,G12GS,G23GS,
3 HCPGS,QMELTG,ZMAT,TMOVE,WMOVE,ZRMDR,TADD,
4 ZMOVE,TBOT,ISAND,ICONT,
5 IWF,IG,IGP1,IGP2,ILG,IL1,IL2,JL )
ENDIF
CALL GRINFL(2,THLQGS,THICGS,TBRWGS,BASFLW,RUNFGS,QFG,
1 WLSTGS,FGS,EVAPGS,RPCGS,TRPCGS,TPNDGS,ZPNDGS,
2 DT,ZMAT,WMOVE,TMOVE,THLIQX,THICEX,TBARWX,
3 DELZX,ZBOTX,FDT,TFDT,PSIF,THLINF,GRKINF,
4 THLMAX,THTEST,ZRMDR,FDUMMY,TDUMMY,THLDUM,
5 THIDUM,TDUMW,TRMDR,ZF,FMAX,TUSED,RDUMMY,
6 ZERO,WEXCES,FDTBND,WADD,TADD,WADJ,TIMPND,
7 DZF,DTFLOW,THLNLZ,THLQLZ,DZDISP,WDISP,WABS,
8 THPOR,THLRET,THLMIN,BI,PSISAT,GRKSAT,GRKTLD,
9 THLRAT,DELZW,ZBOTW,XDRAIN,ISAND,IGRN,
A IGRD,IFILL,IZERO,LZF,NINF,IFIND,ITER,
B NEND,ISIMP,IG,IGP1,IGP2,ILG,IL1,IL2,JL )
CALL GRDRAN(2,THLQGS,THICGS,TBRWGS,FDUMMY,TDUMMY,BASFLW,
1 RUNFGS,QFG,WLSTGS,FGS,EVAPGS,RPCGS,ZPNDGS,
2 DT,WEXCES,THLMAX,THTEST,THPOR,THLRET,THLMIN,
3 BI,PSISAT,GRKSAT,DELZW,XDRAIN,ISAND,
4 IGRN,IGRD,IG,IGP1,IGP2,ILG,IL1,IL2,JL )
CALL WATROF(THLQGS,THICGS,ZPNDGS,OVRFLW,SUBFLW,RUNFGS,
1 FGS,ZPLMGS,XSLOPE,GRKFAC,WFSURF,WFCINT,
2 DELZW,THPOR,THLMIN,BI,THFC,THCRIT,DODRN,DOVER,
3 DIDRN,DIDRNMX,ISAND,IWF,IG,ILG,IL1,IL2)
CALL TMCALC(TBARGS,THLQGS,THICGS,HCPGS,TPNDGS,ZPNDGS,
1 TSNOGS,ZSNOGS,ALBSGS,RHOSGS,HCPSGS,TBASE,
2 OVRFLW,RUNFGS,HMFG,HTC,HTCS,WTRS,WTRG,FGS,
3 TBRWGS,GZROGS,G12GS,G23GS,TA,ZPLMGS,
4 THPOR,THLMIN,HCPS,DELZW,DELZZ,
5 ISAND,IWF,IG,ILG,IL1,IL2,JL)
CALL CHKWAT(2,PCPR,EVPIGS,RUNFGS,WLSTGS,RAICNS,SNOCNS,
1 RACS,SNCS,ZPNDGS,ZPOND,THLQGS,THICGS,
2 THLIQG,THICEG,ZSNOGS,RHOSGS,XSNOGS,SNO,
3 FCS,FGS,FGS,BAL,THPOR,THLMIN,DELZW,
4 ISAND,IG,ILG,IL1,IL2,JL )
CALL SNOALBW(ALBSGS,RHOSGS,ZSNOGS,HCPSGS,
1 TSNOGS,FGS,SPCGS,RALB,RHOMAX,
2 ISAND,ILG,IG,IL1,IL2,JL)
ENDIF
C
C * CALCULATIONS FOR CANOPY OVER BARE GROUND.
C
IF(NLANDC.GT.0) THEN
CALL CANVAP(EVAPC,SUBLC,RAICAN,SNOCAN,TCANO,THLQCO,
1 TBARC,ZSNOWC,WLOSTC,CHCAP,QFCF,QFCL,QFN,QFC,
2 HTCC,HTCS,HTC,FC,CMASSC,TSNOWC,HCPSC,RHOSC,
3 FROOT,THPOR,THLMIN,DELZW,EVLOST,RLOST,IROOT,
4 IG,ILG,IL1,IL2,JL )
CALL CANADD(1,RPCC,TRPCC,SPCC,TSPCC,RAICAN,SNOCAN,
1 TCANO,CHCAP,HTCC,ROFC,ROVG,PCPN,PCPG,
2 FC,AILCAN,FSVF,CWCAP,CMASSC,RHOSNI,RADD,SADD,
3 ILG,IL1,IL2,JL)
CALL CWCALC(TCANO,RAICAN,SNOCAN,CHCAP,HMFC,HTCC,
1 FC,CMASSC,ILG,IL1,IL2,JL)
CALL SUBCAN(1,RPCC,TRPCC,SPCC,TSPCC,RHOSNI,EVAPCG,
1 QFN,QFG,FC,ILG,IL1,IL2,JL)
CALL TWCALC(TBARC,THLQCO,THICCO,HCPCO,TBARWC,HMFG,HTC,
1 FC,EVAPCG,THPOR,THLMIN,HCPS,DELZW,DELZZ,
2 ISAND,IG,ILG,IL1,IL2,JL)
CALL SNOVAP(RHOSC,ZSNOWC,HCPSC,TSNOWC,EVAPCG,
1 QFN,QFG,HTCS,WLOSTC,FC,RPCC,SPCC,RHOSNI,
2 ILG,IL1,IL2,JL)
CALL TFREEZ(ZPONDC,TPONDC,ZSNOWC,TSNOWC,ALBSC,
1 RHOSC,HCPSC,GZEROC,HMFG,HTCS,HTC,
2 WTRS,WTRG,FC,QFREZC,TA,TBARC,ISAND,
3 IG,ILG,IL1,IL2,JL)
CALL SNOADD(ALBSC,TSNOWC,RHOSC,ZSNOWC,
1 HCPSC,HTCS,FC,SPCC,TSPCC,RHOSNI,
2 ILG,IL1,IL2,JL)
CALL GRINFL(3,THLQCO,THICCO,TBARWC,BASFLW,RUNFC,QFG,
1 WLOSTC,FC,EVAPCG,RPCC,TRPCC,TPONDC,ZPONDC,
2 DT,ZMAT,WMOVE,TMOVE,THLIQX,THICEX,TBARWX,
3 DELZX,ZBOTX,FDT,TFDT,PSIF,THLINF,GRKINF,
4 THLMAX,THTEST,ZRMDR,FDUMMY,TDUMMY,THLDUM,
5 THIDUM,TDUMW,TRMDR,ZF,FMAX,TUSED,RDUMMY,
6 ZERO,WEXCES,FDTBND,WADD,TADD,WADJ,TIMPND,
7 DZF,DTFLOW,THLNLZ,THLQLZ,DZDISP,WDISP,WABS,
8 THPOR,THLRET,THLMIN,BI,PSISAT,GRKSAT,GRKTLD,
9 THLRAT,DELZW,ZBOTW,XDRAIN,ISAND,IGRN,
A IGRD,IFILL,IZERO,LZF,NINF,IFIND,ITER,
B NEND,ISIMP,IG,IGP1,IGP2,ILG,IL1,IL2,JL )
CALL GRDRAN(3,THLQCO,THICCO,TBARWC,FDUMMY,TDUMMY,BASFLW,
1 RUNFC,QFG,WLOSTC,FC,EVAPCG,RPCC,ZPONDC,
2 DT,WEXCES,THLMAX,THTEST,THPOR,THLRET,THLMIN,
3 BI,PSISAT,GRKSAT,DELZW,XDRAIN,ISAND,
4 IGRN,IGRD,IG,IGP1,IGP2,ILG,IL1,IL2,JL )
CALL WATROF(THLQCO,THICCO,ZPONDC,OVRFLW,SUBFLW,RUNFC,
1 FC,ZPLIMC,XSLOPE,GRKFAC,WFSURF,WFCINT,
2 DELZW,THPOR,THLMIN,BI,THFC,THCRIT,DODRN,DOVER,
3 DIDRN,DIDRNMX,ISAND,IWF,IG,ILG,IL1,IL2)
CALL TMCALC(TBARC,THLQCO,THICCO,HCPCO,TPONDC,ZPONDC,
1 TSNOWC,ZSNOWC,ALBSC,RHOSC,HCPSC,TBASE,
2 OVRFLW,RUNFC,HMFG,HTC,HTCS,WTRS,WTRG,FC,
3 TBARWC,GZEROC,G12C,G23C,TA,ZPLIMC,
4 THPOR,THLMIN,HCPS,DELZW,DELZZ,
5 ISAND,IWF,IG,ILG,IL1,IL2,JL)
CALL CHKWAT(3,PCPR,EVPIC,RUNFC,WLOSTC,RAICAN,SNOCAN,
1 RAC,SNC,ZPONDC,ZPOND,THLQCO,THICCO,
2 THLIQC,THICEC,ZSNOWC,RHOSC,XSNOWC,SNO,
3 FCS,FGS,FC,BAL,THPOR,THLMIN,DELZW,
4 ISAND,IG,ILG,IL1,IL2,JL )
C
ENDIF
C
C * CALCULATIONS FOR BARE GROUND.
C
IF(NLANDG.GT.0) THEN
CALL TWCALC(TBARG,THLQGO,THICGO,HCPGO,TBARWG,HMFG,HTC,
1 FG,EVAPG,THPOR,THLMIN,HCPS,DELZW,DELZZ,
2 ISAND,IG,ILG,IL1,IL2,JL)
CALL SNOVAP(RHOSG,ZSNOWG,HCPSG,TSNOWG,EVAPG,
1 QFN,QFG,HTCS,WLOSTG,FG,RPCG,SPCG,RHOSNI,
2 ILG,IL1,IL2,JL)
CALL TFREEZ(ZPONDG,TPONDG,ZSNOWG,TSNOWG,ALBSG,
1 RHOSG,HCPSG,GZEROG,HMFG,HTCS,HTC,
2 WTRS,WTRG,FG,QFREZG,TA,TBARG,ISAND,
3 IG,ILG,IL1,IL2,JL)
CALL SNOADD(ALBSG,TSNOWG,RHOSG,ZSNOWG,
1 HCPSG,HTCS,FG,SPCG,TSPCG,RHOSNI,
2 ILG,IL1,IL2,JL)
IF(NLANDI.NE.0) THEN
CALL ICEBAL(TBARG,TPONDG,ZPONDG,TSNOWG,RHOSG,ZSNOWG,
1 HCPSG,HMFG,HTCS,HTC,WTRS,WTRG,RUNFG,OVRFLW,
2 FG,EVAPG,RPCG,TRPCG,GZEROG,G12G,G23G,
3 HCPGO,QFREZG,ZMAT,TMOVE,WMOVE,ZRMDR,TADD,
4 ZMOVE,TBOT,ISAND,ICONT,
5 IWF,IG,IGP1,IGP2,ILG,IL1,IL2,JL )
ENDIF
CALL GRINFL(4,THLQGO,THICGO,TBARWG,BASFLW,RUNFG,QFG,
1 WLOSTG,FG,EVAPG,RPCG,TRPCG,TPONDG,ZPONDG,
2 DT,ZMAT,WMOVE,TMOVE,THLIQX,THICEX,TBARWX,
3 DELZX,ZBOTX,FDT,TFDT,PSIF,THLINF,GRKINF,
4 THLMAX,THTEST,ZRMDR,FDUMMY,TDUMMY,THLDUM,
5 THIDUM,TDUMW,TRMDR,ZF,FMAX,TUSED,RDUMMY,
6 ZERO,WEXCES,FDTBND,WADD,TADD,WADJ,TIMPND,
7 DZF,DTFLOW,THLNLZ,THLQLZ,DZDISP,WDISP,WABS,
8 THPOR,THLRET,THLMIN,BI,PSISAT,GRKSAT,GRKTLD,
9 THLRAT,DELZW,ZBOTW,XDRAIN,ISAND,IGRN,
A IGRD,IFILL,IZERO,LZF,NINF,IFIND,ITER,
B NEND,ISIMP,IG,IGP1,IGP2,ILG,IL1,IL2,JL )
CALL GRDRAN(4,THLQGO,THICGO,TBARWG,FDUMMY,TDUMMY,BASFLW,
1 RUNFG,QFG,WLOSTG,FG,EVAPG,RPCG,ZPONDG,
2 DT,WEXCES,THLMAX,THTEST,THPOR,THLRET,THLMIN,
3 BI,PSISAT,GRKSAT,DELZW,XDRAIN,ISAND,
4 IGRN,IGRD,IG,IGP1,IGP2,ILG,IL1,IL2,JL )
CALL WATROF(THLQGO,THICGO,ZPONDG,OVRFLW,SUBFLW,RUNFG,
1 FG,ZPLIMG,XSLOPE,GRKFAC,WFSURF,WFCINT,
2 DELZW,THPOR,THLMIN,BI,THFC,THCRIT,DODRN,DOVER,
3 DIDRN,DIDRNMX,ISAND,IWF,IG,ILG,IL1,IL2)
CALL TMCALC(TBARG,THLQGO,THICGO,HCPGO,TPONDG,ZPONDG,
1 TSNOWG,ZSNOWG,ALBSG,RHOSG,HCPSG,TBASE,
2 OVRFLW,RUNFG,HMFG,HTC,HTCS,WTRS,WTRG,FG,
3 TBARWG,GZEROG,G12G,G23G,TA,ZPLIMG,
4 THPOR,THLMIN,HCPS,DELZW,DELZZ,
5 ISAND,IWF,IG,ILG,IL1,IL2,JL)
CALL CHKWAT(4,PCPR,EVPIG,RUNFG,WLOSTG,RAICAN,SNOCAN,
1 RAC,SNC,ZPONDG,ZPOND,THLQGO,THICGO,
2 THLIQG,THICEG,ZSNOWG,RHOSG,XSNOWG,SNO,
3 FCS,FGS,FG,BAL,THPOR,THLMIN,DELZW,
4 ISAND,IG,ILG,IL1,IL2,JL )
C
ENDIF
C
C * AVERAGE RUNOFF AND PROGNOSTIC VARIABLES OVER FOUR GRID CELL
C * SUBAREAS.
C
IPTBAD=0
DO 600 J=1,IG
DO 600 I=IL1,IL2
IF(J.LT.IG) THEN
TBAR(I,J)=(FCS(I)*(TBARCS(I,J)+TFREZ)*(DELZW(I,J)*
1 HCPCS(I,J)+(DELZ(J)-DELZW(I,J))*HCPSND)+
2 FGS(I)*(TBARGS(I,J)+TFREZ)*(DELZW(I,J)*
3 HCPGS(I,J)+(DELZ(J)-DELZW(I,J))*HCPSND)+
4 FC (I)*(TBARC (I,J)+TFREZ)*(DELZW(I,J)*
5 HCPCO(I,J)+(DELZ(J)-DELZW(I,J))*HCPSND)+
6 FG (I)*(TBARG (I,J)+TFREZ)*(DELZW(I,J)*
7 HCPGO(I,J)+(DELZ(J)-DELZW(I,J))*HCPSND))/
8 (FCS(I)*(DELZW(I,J)*HCPCS(I,J)+
9 (DELZ(J)-DELZW(I,J))*HCPSND) +
A FGS(I)*(DELZW(I,J)*HCPGS(I,J)+
B (DELZ(J)-DELZW(I,J))*HCPSND) +
C FC (I)*(DELZW(I,J)*HCPCO(I,J)+
D (DELZ(J)-DELZW(I,J))*HCPSND) +
E FG (I)*(DELZW(I,J)*HCPGO(I,J)+
F (DELZ(J)-DELZW(I,J))*HCPSND))
ELSE
TBAR(I,J)=((FCS(I)*(TBARCS(I,J)+TFREZ)*HCPCS(I,J) +
1 FGS(I)*(TBARGS(I,J)+TFREZ)*HCPGS(I,J) +
2 FC (I)*(TBARC (I,J)+TFREZ)*HCPCO(I,J) +
3 FG (I)*(TBARG (I,J)+TFREZ)*HCPGO(I,J))*
4 DELZW(I,J)+TBASE(I)*HCPSND*
5 (DELZ(J)-DELZW(I,J)))/
4 ((FCS(I)*HCPCS(I,J) + FGS(I)*HCPGS(I,J) +
5 FC (I)*HCPCO(I,J) + FG (I)*HCPGO(I,J))*
8 DELZW(I,J)+HCPSND*(DELZ(J)-DELZW(I,J)))
ENDIF
THLIQ(I,J)=FCS(I)*THLQCS(I,J)+FGS(I)*THLQGS(I,J)+
1 FC (I)*THLQCO(I,J)+FG (I)*THLQGO(I,J)
THICE(I,J)=FCS(I)*THICCS(I,J)+FGS(I)*THICGS(I,J)+
1 FC (I)*THICCO(I,J)+FG (I)*THICGO(I,J)
IF(TBAR(I,J).LT.173. .OR. TBAR(I,J).GT.373.16) IPTBAD=I
600 CONTINUE
C
IF(IPTBAD.NE.0) THEN
WRITE(6,6600) IPTBAD,JL,(TBAR(IPTBAD,j),j=1,ig)
6600 FORMAT('0AT (I,J)= (',I3,',',I3,'), TBAR = ',3F10.5)
CALL XIT('CLASSW2',-1)
ENDIF
C
JPTBAD=0
KPTBAD=0
LPTBAD=0
DO 625 I=IL1,IL2
IF((FC(I)+FCS(I)).GT.0.) THEN
TCAN(I)=(FCS(I)*TCANS(I)*CHCAPS(I)+FC(I)*TCANO(I)*
1 CHCAP(I))/(FCS(I)*CHCAPS(I)+FC(I)*CHCAP(I))
ELSE
TCAN(I)=0.0
ENDIF
IF(TCAN(I).LT.0. .OR. TCAN(I).GT.373.16) JPTBAD=I
RCAN (I)=FCS(I)*RAICNS(I) + FC (I)*RAICAN(I)
SCAN (I)=FCS(I)*SNOCNS(I) + FC (I)*SNOCAN(I)
RUNOFF(I)=FCS(I)*RUNFCS(I) + FGS(I)*RUNFGS(I) +
1 FC (I)*RUNFC (I) + FG (I)*RUNFG (I)
RUNOFF(I)=RUNOFF(I)*RHOW
OVRFLW(I)=OVRFLW(I)*RHOW
BASFLW(I)=BASFLW(I)*RHOW
EVAP (I)=EVAP(I)-(FCS(I)*WLSTCS(I)+FGS(I)*WLSTGS(I)+
1 FC(I)*WLOSTC(I)+FG(I)*WLOSTG(I))/DELT
IF(ZPNDCS(I).GT.0.00001 .OR. ZPNDGS(I).GT.0.00001 .OR.
1 ZPONDC(I).GT.0.00001 .OR. ZPONDG(I).GT.0.00001) THEN
zpacc=0.
if(FCS(I).gt.0.) zpacc=zpacc+ZPNDCS(I)*FCS(I)
if(FGS(I).gt.0.) zpacc=zpacc+ZPNDGS(I)*FGS(I)
if(FC (I).gt.0.) zpacc=zpacc+ZPONDC(I)*FC (I)
if(FG (I).gt.0.) zpacc=zpacc+ZPONDG(I)*FG (I)
ZPOND(I)=zpacc
c ZPOND(I)=(FCS(I)*ZPNDCS(I)+FGS(I)*ZPNDGS(I)+
c 1 FC (I)*ZPONDC(I)+FG (I)*ZPONDG(I))
tpacc=0.
if(FCS(I).gt.0.) tpacc=tpacc+FCS(I)*(TPNDCS(I)+TFREZ)*ZPNDCS(I)
if(FGS(I).gt.0.) tpacc=tpacc+FGS(I)*(TPNDGS(I)+TFREZ)*ZPNDGS(I)
if(FC (I).gt.0.) tpacc=tpacc+FC (I)*(TPONDC(I)+TFREZ)*ZPONDC(I)
if(FG (I).gt.0.) tpacc=tpacc+FG (I)*(TPONDG(I)+TFREZ)*ZPONDG(I)
TPOND(I)=tpacc/ZPOND(I)
c TPOND(I)=(FCS(I)*(TPNDCS(I)+TFREZ)*ZPNDCS(I)+
c 1 FGS(I)*(TPNDGS(I)+TFREZ)*ZPNDGS(I)+
c 2 FC (I)*(TPONDC(I)+TFREZ)*ZPONDC(I)+
c 3 FG (I)*(TPONDG(I)+TFREZ)*ZPONDG(I))/
c 4 ZPOND(I)
ELSE
ZPOND(I)=0.0
TPOND(I)=0.0
ENDIF
625 CONTINUE
C
C * THESE 2 LOOPS MIGHT BE COMBINED ON THE SX-3 (WOULDN'T WORK
C * ON THE CRAY).
C
DO 650 I=IL1,IL2
IF(ZSNOCS(I).GT.0. .OR. ZSNOGS(I).GT.0. .OR.
1 ZSNOWC(I).GT.0. .OR. ZSNOWG(I).GT.0.) THEN
IF(ZSNOCS(I).GT.0. .OR. ZSNOGS(I).GT.0.) THEN
ALBSNO(I)=(FCS(I)*ALBSCS(I)*XSNOCS(I)+
1 FGS(I)*ALBSGS(I)*XSNOGS(I))/
2 (FCS(I)*XSNOCS(I)+FGS(I)*XSNOGS(I))
ELSE
ALBSNO(I)=(FC (I)*ALBSC(I)*XSNOWC(I) +
1 FG (I)*ALBSG(I)*XSNOWG(I))/
2 (FC (I)*XSNOWC(I)+FG (I)*XSNOWG(I))
ENDIF
TSNOW(I)=(FCS(I)*(TSNOCS(I)+TFREZ)*HCPSCS(I)*
1 ZSNOCS(I)*XSNOCS(I) +
2 FGS(I)*(TSNOGS(I)+TFREZ)*HCPSGS(I)*
3 ZSNOGS(I)*XSNOGS(I) +
4 FC (I)*(TSNOWC(I)+TFREZ)*HCPSC(I)*
5 ZSNOWC(I)*XSNOWC(I) +
6 FG (I)*(TSNOWG(I)+TFREZ)*HCPSG(I)*
7 ZSNOWG(I)*XSNOWG(I))/
8 (FCS(I)*HCPSCS(I)*ZSNOCS(I)*XSNOCS(I) +
9 FGS(I)*HCPSGS(I)*ZSNOGS(I)*XSNOGS(I) +
A FC (I)*HCPSC(I)*ZSNOWC(I)*XSNOWC(I) +
B FG (I)*HCPSG(I)*ZSNOWG(I)*XSNOWG(I))
RHOSNO(I)=(FCS(I)*RHOSCS(I)*ZSNOCS(I)*XSNOCS(I) +
1 FGS(I)*RHOSGS(I)*ZSNOGS(I)*XSNOGS(I) +
2 FC (I)*RHOSC(I)*ZSNOWC(I)*XSNOWC(I) +
3 FG (I)*RHOSG(I)*ZSNOWG(I)*XSNOWG(I))/
4 (FCS(I)*ZSNOCS(I)*XSNOCS(I) +
5 FGS(I)*ZSNOGS(I)*XSNOGS(I) +
6 FC (I)*ZSNOWC(I)*XSNOWC(I) +
7 FG (I)*ZSNOWG(I)*XSNOWG(I))
ZSNOW(I)=FCS(I)*ZSNOCS(I) + FGS(I)*ZSNOGS(I) +
1 FC (I)*ZSNOWC(I) + FG (I)*ZSNOWG(I)
SNO(I)=ZSNOW(I)*RHOSNO(I)
IF(SNO(I).LT.1.0E-9) THEN
SNO(I)=0.0
RHOSNO(I)=0.0
ENDIF
ELSE
TSNOW(I)=0.0
RHOSNO(I)=0.0
SNO(I)=0.0
ENDIF
C
IF(TSNOW(I).LT.0.0) KPTBAD=I
IF((TSNOW(I)-TFREZ).GT.1.0E-3) LPTBAD=I
650 CONTINUE
C
IF(JPTBAD.NE.0) THEN
WRITE(6,6625) JPTBAD,JL,TCAN(JPTBAD)
6625 FORMAT('0AT (I,J)= (',I3,',',I3,'), TCAN = ',F10.5)
CALL XIT('CLASSW2',-2)
ENDIF
C
IF(KPTBAD.NE.0) THEN
WRITE(6,6626) KPTBAD,JL,TSNOW(KPTBAD)
6626 FORMAT('0AT (I,J)= (',I3,',',I3,'), TSNOW = ',F10.5)
CALL XIT('CLASSW2',-3)
ENDIF
C
IF(LPTBAD.NE.0) THEN
WRITE(6,6626) LPTBAD,JL,TSNOW(LPTBAD)
CALL XIT('CLASSW2',-4)
ENDIF
C
CALL CGROW(GROWTH,TBAR,TA,FC,FCS,ILG,IG,IL1,IL2,JL)
C
RETURN
END