SUBROUTINE CLASSI(VPD,TADP,PADRY,RHOAIR,FCLOUD,RHOSNI, 1
1 RPCP,TRPCP,SPCP,TSPCP,
2 TA,QA,COSZS,PCPR,RRATE,SRATE,
3 PRESSG,QSWV,QSWI,QSWD,
3 IPCP,ILG,IL1,IL2,jl)
C
C * JUN 06/06 - V.FORTIN. ADD OPTION FOR PASSING IN
C * RAINFALL AND SNOWFALL RATES
C * CALCULATED BY ATMOSPHERIC MODEL.
C * AUG 19/04 - Y.DELAGE. REGROUP COMMON BLOCKS
C MAKE DECLARATIONS EXPLICIT
C * AUG 09/02 - D.VERSEGHY. MOVE CALCULATION OF SOME
C * ATMOSPHERIC VARIABLES HERE
C * PRIOR TO GATHERING.
C * JUL 26/02 - R.BROWN/S.FASSNACHT/D.VERSEGHY. PROVIDE
C * ALTERNATE METHODS OF ESTIMATING
C * RAINFALL/SNOWFALL PARTITIONING.
C * JUN 27/02 - D.VERSEGHY. ESTIMATE FRACTIONAL CLOUD COVER
C * AND RAINFALL/SNOWFALL RATES
C * IF NECESSARY.
C
IMPLICIT NONE
INTEGER IPCP,ILG,IL1,IL2,I,JL
REAL EA,CA,CB,EASAT,WA,CONST
C * OUTPUT ARRAYS.
C
REAL VPD (ILG), TADP (ILG), PADRY (ILG), RHOAIR(ILG),
1 FCLOUD(ILG), RHOSNI(ILG), RPCP (ILG), TRPCP (ILG),
2 SPCP (ILG), TSPCP (ILG)
C
C * INPUT ARRAYS.
C
REAL TA (ILG), QA (ILG), PRESSG(ILG), COSZS (ILG),
1 QSWV (ILG), QSWI (ILG), QSWD (ILG), PCPR (ILG),
2 RRATE (ILG), SRATE (ILG)
C
C * WORK ARRAYS.
C
REAL PHASE (ILG)
C
#include "class_com.cdk"
C----------------------------------------------------------------
C
DO 100 I=IL1,IL2
if(qa(i).lt.1.e-8) qa(i)=1.e-5
EA=QA(I)*PRESSG(I)/(0.622+0.378*QA(I))
IF(TA(I).GE.TFREZ) THEN
CA=17.269
CB=35.86
ELSE
CA=21.874
CB=7.66
ENDIF
EASAT=611.0*EXP(CA*(TA(I)-TFREZ)/(TA(I)-CB))
VPD(I)=MAX(0.0,(EASAT-EA)/100.0)
PADRY(I)=PRESSG(I)-EA
RHOAIR(I)=PADRY(I)/(RGAS*TA(I))+EA/(GASV*TA(I))
WA=QA(I)/(1.0-QA(I))
CONST=LOG(WA*PADRY(I)/(0.622*611.0))
TADP(I)=(CB*CONST-CA*TFREZ)/(CONST-CA)
C
C * CLOUD COVER AND DENSITY OF FRESH SNOW.
C
IF(COSZS(I).GT.0.0.AND.(QSWV(I)+QSWI(I)).GT.0.0) THEN
FCLOUD(I)=MAX(0.0,MIN(1.0,QSWD(I)/(QSWV(I)+QSWI(I))))
ELSE
FCLOUD(I)=0.
ENDIF
IF(TA(I).LE.TFREZ) THEN
RHOSNI(I)=67.92+51.25*EXP((TA(I)-TFREZ)/2.59)
ELSE
RHOSNI(I)=MIN((119.17+20.0*(TA(I)-TFREZ)),200.0)
ENDIF
C
C * PRECIPITATION PARTITIONING BETWEEN RAIN AND SNOW.
C
IF(PCPR(I).GT.0.) THEN
IF(IPCP.EQ.1) THEN
IF(TA(I).GT.TFREZ) THEN
RPCP (I)=PCPR(I)/RHOW
TRPCP(I)=MAX((TA(I)-TFREZ),0.0)
SPCP (I)=0.0
TSPCP(I)=0.0
ELSE
SPCP (I)=PCPR(I)/RHOSNI(I)
TSPCP(I)=MIN((TA(I)-TFREZ),0.0)
RPCP (I)=0.0
TRPCP(I)=0.0
ENDIF
ELSEIF(IPCP.EQ.2) THEN
IF(TA(I).LE.TFREZ) THEN
PHASE(I)=1.0
ELSEIF(TA(I).GE.(TFREZ+2.0)) THEN
PHASE(I)=0.0
ELSE
PHASE(I)=1.0-0.5*(TA(I)-TFREZ)
ENDIF
RPCP(I)=(1.0-PHASE(I))*PCPR(I)/RHOW
IF(RPCP(I).GT.0.0) TRPCP(I)=MAX((TA(I)-TFREZ),0.0)
SPCP(I)=PHASE(I)*PCPR(I)/RHOSNI(I)
IF(SPCP(I).GT.0.0) TSPCP(I)=MIN((TA(I)-TFREZ),0.0)
ELSEIF(IPCP.EQ.3) THEN
IF(TA(I).LE.TFREZ) THEN
PHASE(I)=1.0
ELSEIF(TA(I).GE.(TFREZ+6.0)) THEN
PHASE(I)=0.0
ELSE
PHASE(I)=(0.0202*(TA(I)-TFREZ)**6-0.3660*
1 (TA(I)-TFREZ)**5+2.0399*(TA(I)-TFREZ)**4-
2 1.5089*(TA(I)-TFREZ)**3-15.038*
3 (TA(I)-TFREZ)**2+4.6664*(TA(I)-TFREZ)+100.0)/
4 100.0
ENDIF
RPCP(I)=(1.0-PHASE(I))*PCPR(I)/RHOW
IF(RPCP(I).GT.0.0) TRPCP(I)=MAX((TA(I)-TFREZ),0.0)
SPCP(I)=PHASE(I)*PCPR(I)/RHOSNI(I)
IF(SPCP(I).GT.0.0) TSPCP(I)=MIN((TA(I)-TFREZ),0.0)
ELSEIF(IPCP.EQ.4) THEN
RPCP(I)=RRATE(I)/RHOW
SPCP(I)=SRATE(I)/RHOSNI(I)
IF (RPCP(i).EQ.0) THEN
TRPCP(I)=0
ELSE
TRPCP(I)=MAX((TA(I)-TFREZ),0.0)
ENDIF
IF (SPCP(i).EQ.0) THEN
TSPCP(I)=0
ELSE
TSPCP(I)=MIN((TA(I)-TFREZ),0.0)
ENDIF
ENDIF
ELSE
RPCP (I)=0.0
TRPCP(I)=0.0
SPCP (I)=0.0
TSPCP(I)=0.0
ENDIF
100 CONTINUE
C
RETURN
END