SUBROUTINE CLASSA(FC, FG, FCS, FGS, ALVSCN, ALIRCN, 1,4
1 ALVSG, ALIRG, ALVSCS, ALIRCS, ALVSSN, ALIRSN,
2 TRVSCN, TRIRCN, TRVSCS, TRIRCS, AILCAN, AILCNS,
3 FSVF, FSVFS, RAICAN, RAICNS, SNOCAN, SNOCNS,
4 FRAINC, FSNOWC, DISP, DISPS, ZOMLNC, ZOMLCS,
5 ZOELNC, ZOELCS, ZOMLNG, ZOMLNS, ZOELNG, ZOELNS,
6 CHCAP, CHCAPS, CMASSC, CMASCS, CWCAP, CWCAPS,
7 RC, RCS, DLEAF, FROOT, ZPLIMC, ZPLIMG,
8 ZPLMCS, ZPLMGS, TRSNOW, ZSNOW,
9 ALVS, ALIR, HTCC, HTCS, HTC,
A WTRC, WTRS, WTRG, CMAI,
B FCANMX, ZOLN, ALVSC, ALIRC, AILMAX, AILMIN,
C CWGTMX, ZRTMAX, RSMIN, QA50, VPDA, VPDB,
D PSIGA, PSIGB, AILDAT, HGTDAT, ACVDAT, ACIDAT,
E ASVDAT, ASIDAT, AGVDAT, AGIDAT, ALGWET, ALGDRY,
F THLIQ, THICE, TBAR, RCAN, SCAN, TCAN,
G GROWTH, SNO, TSNOW, RHOSNO, ALBSNO, ZBLEND,
H FCLOUD, TA, VPD, RHOAIR, COSZS, QSWINV,
I RADJ, ILAND, DLON, DELZW, ZBOTW, Z0ORO,
J THPOR, THLMIN, PSISAT, BI, PSIWLT, HCPS,
K ISAND, IDAY, ILG, IL1, IL2, JL,
L IC, ICP1, IG, IDISP, IZREF,
M ILAI, IHGT, IALC, IALS, IALG)
C
C * AUG 19/04 - Y.DELAGE. REMOVE WORK ARRAYS FROM ARGUMENT LIST
C REGROUP COMMON BLOCKS
C MAKE EXPLICIT DECLARATIONS
C * DEC 05/02 - D.VERSEGHY. NEW PARAMETERS FOR APREP.
C * JUL 31/02 - D.VERSEGHY. MODIFICATIONS ASSOCIATED WITH NEW
C * CALCULATION OF STOMATAL RESISTANCE.
C * SHORTENED CLASS3 COMMON BLOCK.
C * JUL 23/02 - D.VERSEGHY. MODIFICATIONS TO MOVE ADDITION OF AIR
C * TO CANOPY MASS INTO APREP; SHORTENED
C * CLASS4 COMMON BLOCK.
C * MAR 18/02 - D.VERSEGHY. NEW CALLS TO ALL SUBROUTINES TO ENABLE
C * ASSIGNMENT OF USER-SPECIFIED VALUES TO
C * ALBEDOS AND VEGETATION PROPERTIES; NEW
C * "CLASS8" COMMON BLOCK; MOVE CALCULATION
C * OF "FCLOUD" INTO CLASS DRIVER.
C * SEP 19/00 - D.VERSEGHY. PASS ADDITIONAL ARRAYS TO APREP IN COMMON
C * BLOCK CLASS7, FOR CALCULATION OF NEW
C * STOMATAL RESISTANCE COEFFICIENTS USED
C * IN TPREP.
C * APR 12/00 - D.VERSEGHY. RCMIN NOW VARIES WITH VEGETATION TYPE:
C * PASS IN BACKGROUND ARRAY "RCMINX".
C * DEC 16/99 - D.VERSEGHY. ADD "XLEAF" ARRAY TO CLASS7 COMMON BLOCK
C * AND CALCULATION OF LEAF DIMENSION PARAMETER
C * "DLEAF" IN APREP.
C * NOV 16/98 - M.LAZARE. "DLON" NOW PASSED IN AND USED DIRECTLY
C * (INSTEAD OF INFERRING FROM "LONSL" AND
C * "ILSL" WHICH USED TO BE PASSED) TO PASS
C * TO APREP TO CALCULATE GROWTH INDEX. THIS
C * IS DONE TO MAKE THE PHYSICS PLUG COMPATIBLE
C * FOR USE WITH THE RCM WHICH DOES NOT HAVE
C * EQUALLY-SPACED LONGITUDES.
C * JUN 20/97 - D.VERSEGHY. CLASS - VERSION 2.7.
C * MODIFICATIONS TO ALLOW FOR VARIABLE
C * SOIL PERMEABLE DEPTH.
C * SEP 27/96 - D.VERSEGHY. CLASS - VERSION 2.6.
C * FIX BUG TO CALCULATE GROUND ALBEDO
C * UNDER CANOPIES AS WELL AS OVER BARE
C * SOIL.
C * JAN 02/96 - D.VERSEGHY. CLASS - VERSION 2.5.
C * COMPLETION OF ENERGY BALANCE
C * DIAGNOSTICS.
C * ALSO, PASS IDISP TO SUBROUTINE APREP.
C * AUG 30/95 - D.VERSEGHY. CLASS - VERSION 2.4.
C * VARIABLE SURFACE DETENTION CAPACITY
C * IMPLEMENTED.
C * AUG 16/95 - D.VERSEGHY. THREE NEW ARRAYS TO COMPLETE WATER
C * BALANCE DIAGNOSTICS.
C * OCT 14/94 - D.VERSEGHY. CLASS - VERSION 2.3.
C * REVISE CALCULATION OF FCLOUD TO
C * HANDLE CASES WHERE INCOMING SOLAR
C * RADIATION IS ZERO AT LOW SUN ANGLES.
C * NOV 24/92 - M.LAZARE. CLASS - VERSION 2.1.
C * MODIFIED FOR MULTIPLE LATITUDES.
C * OCT 13/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. VISIBLE AND NEAR-IR ALBEDOS AND
C * TRANSMISSIVITIES FOR COMPONENTS OF
C * LAND SURFACE.
C
IMPLICIT NONE
C * OUTPUT ARRAYS.
C
REAL FC (ILG), FG (ILG), FCS (ILG), FGS (ILG),
1 ALVSCN(ILG), ALIRCN(ILG), ALVSG (ILG), ALIRG (ILG),
2 ALVSCS(ILG), ALIRCS(ILG), ALVSSN(ILG), ALIRSN(ILG),
3 TRVSCN(ILG), TRIRCN(ILG), TRVSCS(ILG), TRIRCS(ILG),
4 AILCAN(ILG), AILCNS(ILG), FSVF (ILG), FSVFS (ILG),
5 RAICAN(ILG), RAICNS(ILG), SNOCAN(ILG), SNOCNS(ILG),
6 FRAINC(ILG), FSNOWC(ILG), DISP (ILG), DISPS (ILG),
7 ZOMLNC(ILG), ZOMLCS(ILG), ZOELNC(ILG), ZOELCS(ILG),
8 ZOMLNG(ILG), ZOMLNS(ILG), ZOELNG(ILG), ZOELNS(ILG),
9 CHCAP (ILG), CHCAPS(ILG), CMASSC(ILG), CMASCS(ILG),
A CWCAP (ILG), CWCAPS(ILG), RC (ILG), RCS (ILG),
B ZPLIMC(ILG), ZPLIMG(ILG), ZPLMCS(ILG), ZPLMGS(ILG),
C DLEAF (ILG), TRSNOW(ILG), ZSNOW (ILG),
D ALVS (ILG), ALIR (ILG), HTCC (ILG), HTCS (ILG),
E WTRC (ILG), WTRS (ILG), WTRG (ILG), CMAI (ILG)
C
REAL FROOT (ILG,IG), HTC (ILG,IG)
C
C * INPUT ARRAYS DEPENDENT ON LONGITUDE.
C
REAL FCANMX(ILG,ICP1), ZOLN (ILG,ICP1),
1 ALVSC (ILG,ICP1), ALIRC (ILG,ICP1),
2 AILMAX(ILG,IC), AILMIN(ILG,IC), CWGTMX(ILG,IC),
3 ZRTMAX(ILG,IC), RSMIN (ILG,IC), QA50 (ILG,IC),
4 VPDA (ILG,IC), VPDB (ILG,IC), PSIGA (ILG,IC),
5 PSIGB (ILG,IC), AILDAT(ILG,IC), HGTDAT(ILG,IC),
4 ACVDAT(ILG,IC), ACIDAT(ILG,IC),
5 THLIQ (ILG,IG), THICE (ILG,IG), TBAR (ILG,IG)
C
REAL ASVDAT(ILG), ASIDAT(ILG), AGVDAT(ILG), AGIDAT(ILG),
1 ALGWET(ILG), ALGDRY(ILG), Z0ORO (ILG),
2 RCAN (ILG), SCAN (ILG), TCAN (ILG), GROWTH(ILG),
3 SNO (ILG), TSNOW (ILG), RHOSNO(ILG), ALBSNO(ILG),
4 FCLOUD(ILG), TA (ILG), VPD (ILG), RHOAIR(ILG),
5 COSZS (ILG), QSWINV(ILG), DLON (ILG), ZBLEND(ILG)
REAL RADJ(ILG)
C
INTEGER ILAND (ILG)
C
C * SOIL PROPERTY ARRAYS.
C
REAL DELZW (ILG,IG), ZBOTW (ILG,IG), THPOR (ILG,IG),
1 THLMIN(ILG,IG), PSISAT(ILG,IG), BI (ILG,IG),
2 PSIWLT(ILG,IG), HCPS (ILG,IG)
C
INTEGER ISAND (ILG,IG)
INTEGER IDAY, ILG, IL1, IL2, JL,
1 IC, ICP1, IG, IDISP, IZREF,
2 ILAI, IHGT, IALC, IALS, IALG
INTEGER I
C
C
C * INTERNAL WORK ARRAYS FOR THIS AND ASSOCIATED SUBROUTINES.
C
REAL RMAT (ILG,IC,IG),H (ILG,IC), HS (ILG,IC),
1 AIL (ILG,IC), AILS (ILG,IC), FCAN (ILG,IC),
2 FCANS (ILG,IC), CXTEFF(ILG,IC), RCACC (ILG,IC),
3 RCG (ILG,IC), RCV (ILG,IC)
C
REAL PSIGND(ILG), FSNOW (ILG), CWCPAV(ILG),
1 GROWA (ILG), GROWN (ILG), GROWB (ILG),
2 RRESID(ILG), SRESID(ILG), FRTOT (ILG),
3 RCT (ILG), GC (ILG)
C
integer j
#include "class_com.cdk"
REAL SNOLIM
DATA SNOLIM/0.10/
C------------------------------------------------------------------
C * CALCULATION OF SNOW DEPTH ZSNOW AND FRACTIONAL SNOW COVER
C * FSNOW; INITIALIZATION OF COMPUTATIONAL ARRAYS.
C
DO 100 I=IL1,IL2
IF(SNO(I).GT.0.0) THEN
ZSNOW(I)=SNO(I)/RHOSNO(I)
IF(ZSNOW(I).GE.SNOLIM) THEN
FSNOW(I)=1.0
ELSE
c FSNOW(I)=MAX(ZSNOW(I)/SNOLIM,1.E-4)
FSNOW(I)=ZSNOW(I)/SNOLIM
ZSNOW(I)=SNOLIM
ENDIF
if(FSNOW(I).gt..999) FSNOW(I)=1.0
if(FSNOW(I).lt.1.e-3) FSNOW(I)=0.
ELSE
ZSNOW(I)=0.0
FSNOW(I)=0.0
ENDIF
C
ALVSCN(I)=0.0
ALIRCN(I)=0.0
ALVSCS(I)=0.0
ALIRCS(I)=0.0
TRVSCN(I)=0.0
TRIRCN(I)=0.0
TRVSCS(I)=0.0
TRIRCS(I)=0.0
ALVSSN(I)=0.0
ALIRSN(I)=0.0
ALVSG (I)=0.0
ALIRG (I)=0.0
TRSNOW(I)=0.0
100 CONTINUE
C
C * PREPARATION.
C
CALL APREP (FC,FG,FCS,FGS,AILCAN,AILCNS,FSVF,FSVFS,
1 FRAINC,FSNOWC,RAICAN,RAICNS,SNOCAN,SNOCNS,DISP,
2 DISPS,ZOMLNC,ZOMLCS,ZOELNC,ZOELCS,ZOMLNG,ZOMLNS,
3 ZOELNG,ZOELNS,CHCAP,CHCAPS,CMASSC,CMASCS,CWCAP,
4 CWCAPS,DLEAF,FROOT,ZPLIMC,ZPLIMG,ZPLMCS,ZPLMGS,
5 HTCC,HTCS,HTC,WTRC,WTRS,WTRG,CMAI,
6 AIL,AILS,FCAN,FCANS,PSIGND,
7 FCANMX,ZOLN,AILMAX,AILMIN,CWGTMX,ZRTMAX,
8 AILDAT,HGTDAT,THLIQ,THICE,TBAR,RCAN,SCAN,
9 TCAN,GROWTH,ZSNOW,TSNOW,FSNOW,RHOSNO,SNO,Z0ORO,
A ZBLEND,TA,RHOAIR,RADJ,ILAND,DLON,DELZW,ZBOTW,
B THPOR,THLMIN,PSISAT,BI,PSIWLT,HCPS,ISAND,
C ILG,IL1,IL2,IC,ICP1,IG,IDAY,IDISP,IZREF,ILAI,IHGT,
D RMAT,H,HS,CWCPAV,GROWA,GROWN,GROWB,
E RRESID,SRESID,FRTOT,jl )
C
C * CANOPY ALBEDOS AND TRANSMISSIVITIES, AND VEGETATION
C * STOMATAL RESISTANCE.
C
CALL CANALB(ALVSCN,ALIRCN,ALVSCS,ALIRCS,TRVSCN,TRIRCN,
1 TRVSCS,TRIRCS,RC,RCS,
2 ALVSC,ALIRC,RSMIN,QA50,VPDA,VPDB,PSIGA,PSIGB,
3 FC,FCS,FSNOW,FSNOWC,FCAN,FCANS,AIL,AILS,PSIGND,
4 FROOT,FCLOUD,COSZS,QSWINV,VPD,TA,ACVDAT,ACIDAT,
5 ILG,IL1,IL2,JL,IC,ICP1,IG,IALC,
6 CXTEFF,RCACC,RCG,RCV,RCT,GC)
C
C * SNOW ALBEDOS AND TRANSMISSIVITY.
C
CALL SNOALBA(ALVSSN,ALIRSN,ALBSNO,TRSNOW,
1 ZSNOW,FSNOW,ASVDAT,ASIDAT,
2 ILG,IG,IL1,IL2,JL,IALS)
C
C * BARE SOIL ALBEDOS.
C
CALL GRALB(ALVSG,ALIRG,
1 ALGWET,ALGDRY,THLIQ,FSNOW,ALVSC(1,5),ALIRC(1,5),
2 FCANMX(1,5),AGVDAT,AGIDAT,ISAND,
3 ILG,IG,IL1,IL2,JL,IALG)
C
C * EFFECTIVE WHOLE-SURFACE VISIBLE AND NEAR-IR ALBEDOS.
C
DO 500 I=IL1,IL2
ALVS(I)=FC(I)*ALVSCN(I)+FG(I)*ALVSG(I)+FCS(I)*ALVSCS(I)+
1 FGS(I)*ALVSSN(I)
ALIR(I)=FC(I)*ALIRCN(I)+FG(I)*ALIRG(I)+FCS(I)*ALIRCS(I)+
1 FGS(I)*ALIRSN(I)
500 CONTINUE
C
RETURN
END