*=*=*=*= LWC.html =*=*=*=*
SUBROUTINE LWC ( KDLON,KFLEV S , PBINT,PBSUIN,PCLDLW,PCNTRB,PCTS,PEMIS,PFDN,PFUP,PHFG S , PFLUX ) IMPLICIT LOGICAL (L) C #include "dimensions.h" #include "dimphys.h" #include "dimradmars.h" C C**** *LWC* - LONGWAVE RADIATION, CLOUD EFFECTS C C PURPOSE. C -------- C INTRODUCES CLOUD EFFECTS ON LONGWAVE FLUXES OR C RADIANCES C C** INTERFACE. C ---------- C SUBROUTINE LWC ( KDLON,KFLEV C S , PBINT,PBSUIN,PCLDLW,PCNTRB,PCTS,PEMIS,PFDN,PFUP,PHFG C S , PFLUX ) C C EXPLICIT ARGUMENTS : C -------------------- C ==== INPUTS === C PBINT : (KDLON,0:KFLEV) ; HALF LEVEL PLANCK FUNCTION C PBSUIN : (KDLON) ; SURFACE PLANCK FUNCTION C PCLDLW : (KDLON,KFLEV) ; CLOUD FRACTIONAL COVER C PCNTRB : (KDLON,0:KFLEV,0:KFLEV); CLEAR-SKY ENERGY EXCHANGE C PCTS : (KDLON,KFLEV) ; CLEAR-SKY LAYER COOLING-TO-SPACE C PEMIS : (KDLON) ; SURFACE EMISSIVITY C PFDN : (KDLON,0:KFLEV) ; CLEAR-SKY DOWNWARD FLUX C PFUP : (KDLON,0:KFLEV) ; CLEAR-SKY UPWARD FLUX C PHFG : (KDLON,KFLEV) ; CLEAR-SKY LAYER HEATING-FROM-GROUND C ==== OUTPUTS === C PFLUX(KDLON,2,KFLEV) ; RADIATIVE FLUXES : C 1 ==> UPWARD FLUX TOTAL C 2 ==> DOWNWARD FLUX TOTAL C C IMPLICIT ARGUMENTS : NONE C -------------------- C C METHOD. C ------- C C 1. INITIALIZES ALL FLUXES TO CLEAR-SKY VALUES C 2. EFFECT OF ONE OVERCAST UNITY EMISSIVITY CLOUD LAYER C 3. EFFECT OF SEMI-TRANSPARENT, PARTIAL OR MULTI-LAYERED C CLOUDS C C EXTERNALS. C ---------- C C NONE C C REFERENCE. C ---------- C C SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND C ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE "IN CORE MODEL" C C AUTHOR. C ------- C JEAN-JACQUES MORCRETTE *ECMWF* C C MODIFICATIONS. C -------------- C ORIGINAL : 89-07-14 C----------------------------------------------------------------------- C #include "yomcst.h" #include "yomrad.h" #include "yomaer.h" #include "yomlw.h" #include "yomsw.h" #include "yomrdu.h" C ----------------------------------------------------------------- C C----------------------------------------------------------------------- C C* 0.1 ARGUMENTS C --------- C REAL PBINT(NDLO2,KFLEV+1), PBSUIN(NDLO2), PCLDLW(NDLO2,KFLEV) S , PCNTRB(NDLO2,KFLEV+1,KFLEV+1), PCTS(NDLO2,KFLEV) S , PFDN(NDLO2,KFLEV+1),PFUP(NDLO2,KFLEV+1) S , PHFG(NDLO2,KFLEV), PEMIS(NDLO2) C REAL PFLUX(NDLO2,2,KFLEV+1) C C------------------------------------------------------------------------- C C* 0.2 LOCAL ARRAYS C ------------ C INTEGER IMX(NDLON), IMXP(NDLON) C REAL ZCLOUD(NDLON), ZDNF(NDLON,NFLEV+1,NFLEV+1) S , ZFD(NDLON), ZFU(NDLON), ZUPF(NDLON,NFLEV+1,NFLEV+1) C C----------------------------------------------------------------------- C C ------------------------------------------------------------------ C C* 1. INITIALIZATION C -------------- C 100 CONTINUE C IMAXC = 0 C DO 101 JL = 1 , KDLON IMX(JL)=0 IMXP(JL)=0 ZCLOUD(JL) = 0. 101 CONTINUE C C* 1.1 SEARCH THE LAYER INDEX OF THE HIGHEST CLOUD C ------------------------------------------- C 110 CONTINUE C DO 112 JK = 1 , KFLEV DO 111 JL = 1 , KDLON LO1=PCLDLW(JL,JK).GT.ZEPSC IMX1=IMX(JL) IMX2=JK C IMXP(JL)=CVMGT(IMX2,IMX1,LO1) IF (LO1) THEN IMXP(JL)=IMX2 ELSE IMXP(JL)=IMX1 ENDIF IMAXC=MAX0(IMXP(JL),IMAXC) IMX(JL)=IMXP(JL) 111 CONTINUE 112 CONTINUE C DO 114 JK = 1 , KFLEV+1 DO 113 JL = 1 , KDLON PFLUX(JL,1,JK) = PFUP(JL,JK) PFLUX(JL,2,JK) = PFDN(JL,JK) 113 CONTINUE 114 CONTINUE C C ------------------------------------------------------------------ C C* 2. EFFECT OF CLOUDINESS ON LONGWAVE FLUXES C --------------------------------------- C C C IF (NIMP.LT.4) THEN C PRINT 886,IMAXC C END IF C IF (IMAXC.GT.0) THEN C IMXP1 = IMAXC + 1 IMXM1 = IMAXC - 1 C C* 2.0 INITIALIZE TO CLEAR-SKY FLUXES C ------------------------------ C 200 CONTINUE C DO 203 JK1=1,KFLEV+1 DO 202 JK2=1,KFLEV+1 DO 201 JL = 1 , KDLON ZUPF(JL,JK2,JK1)=PFUP(JL,JK1) ZDNF(JL,JK2,JK1)=PFDN(JL,JK1) 201 CONTINUE 202 CONTINUE 203 CONTINUE C C* 2.1 FLUXES FOR ONE OVERCAST UNITY EMISSIVITY CLOUD C ---------------------------------------------- C 210 CONTINUE C DO 213 JKC = 1 , IMAXC JCLOUD=JKC JKCP1=JCLOUD+1 C C* 2.1.1 ABOVE THE CLOUD C --------------- C 2110 CONTINUE C DO 2115 JK=JKCP1,KFLEV+1 JKM1=JK-1 DO 2111 JL = 1 , KDLON ZFU(JL)=0. 2111 CONTINUE IF (JK .GT. JKCP1) THEN DO 2113 JKJ=JKCP1,JKM1 DO 2112 JL = 1 , KDLON ZFU(JL) = ZFU(JL) + PCNTRB(JL,JK,JKJ) 2112 CONTINUE 2113 CONTINUE END IF C DO 2114 JL = 1 , KDLON ZUPF(JL,JKCP1,JK)=PBINT(JL,JK)-ZFU(JL) 2114 CONTINUE 2115 CONTINUE C C* 2.1.2 BELOW THE CLOUD C --------------- C 2120 CONTINUE C DO 2125 JK=1,JCLOUD JKP1=JK+1 DO 2121 JL = 1 , KDLON ZFD(JL)=0. 2121 CONTINUE C IF (JK .LT. JCLOUD) THEN DO 2123 JKJ=JKP1,JCLOUD DO 2122 JL = 1 , KDLON ZFD(JL) = ZFD(JL) + PCNTRB(JL,JK,JKJ) 2122 CONTINUE 2123 CONTINUE END IF DO 2124 JL = 1 , KDLON ZDNF(JL,JKCP1,JK)=-PBINT(JL,JK)-ZFD(JL) 2124 CONTINUE 2125 CONTINUE C 213 CONTINUE C IF (NIMP.LT.2) THEN WRITE(NOUT,884) , ((ZUPF(JLIMPRAD,JK1,JK),JK=1,KFLEV+1),JK1=1,IMXP1) WRITE(NOUT,884) , ((ZDNF(JLIMPRAD,JK1,JK),JK=1,KFLEV+1),JK1=1,IMXP1) END IF C C* 2.2 FLUXES FOR PARTIAL/MULTIPLE LAYERED CLOUDINESS C ---------------------------------------------- C 220 CONTINUE C C C* 2.2.1 DOWNWARD FLUXES C --------------- C 2210 CONTINUE C DO 2212 JK= IMXP1 , KFLEV+1 DO 2211 JL = 1 , KDLON PFLUX(JL,2,JK)=ZDNF(JL,1,JK) 2211 CONTINUE 2212 CONTINUE C IF(IMXM1.GE.1) THEN C DO 2217 JK=1,IMXM1 JKP1=JK+1 DO 2213 JL = 1 , KDLON ZCLOUD(JL)=1. ZFD(JL)=ZDNF(JL,JKP1,JK)*PCLDLW(JL,JK) 2213 CONTINUE DO 2215 JKJ=JK,IMXM1 JKJ1=JKJ+1 JKJ2=JKJ+2 DO 2214 JL = 1 , KDLON ZCLOUD(JL)=ZCLOUD(JL)*(1.-PCLDLW(JL,JKJ)) ZCCLD=ZCLOUD(JL)*PCLDLW(JL,JKJ1) ZFD(JL)=ZFD(JL)+ZDNF(JL,JKJ2,JK)*ZCCLD 2214 CONTINUE 2215 CONTINUE JKJ=IMAXC DO 2216 JL = 1 , KDLON ZCLOUD(JL)=ZCLOUD(JL)*(1.-PCLDLW(JL,JKJ)) ZFD(JL)=ZFD(JL)+ZDNF(JL,1,JK)*ZCLOUD(JL) PFLUX(JL,2,JK)=ZFD(JL) 2216 CONTINUE 2217 CONTINUE C END IF C C* 2.2.2 UPWARD FLUX AT THE SURFACE C -------------------------- C 2220 CONTINUE C JK=IMAXC JKP1=JK+1 DO 2221 JL = 1 , KDLON ZFD(JL)=ZDNF(JL,JKP1,JK)*PCLDLW(JL,JK) S +ZDNF(JL,1,JK)*(1.-PCLDLW(JL,JK)) PFLUX(JL,2,JK)=ZFD(JL) PFLUX(JL,1,1)=PEMIS(JL)*PBSUIN(JL)-(1.-PEMIS(JL))*PFLUX(JL,2,1) 2221 CONTINUE C C* 2.2.3 UPWARD FLUXES C ------------- C 2230 CONTINUE C DO 2235 JK = 2 , KFLEV+1 JK1=MIN0(JK,IMXP1) JK2=JK1-1 JK2M1=JK2-1 DO 2231 JL = 1 , KDLON ZCLOUD(JL)=1. ZFU(JL)=ZUPF(JL,JK1,JK)*PCLDLW(JL,JK2) 2231 CONTINUE C IF(JK2M1.GE.1) THEN C DO 2233 JKJ=1,JK2M1 JKIJ=JK1-JKJ DO 2232 JL = 1 , KDLON ZCLOUD(JL)=ZCLOUD(JL)*(1.-PCLDLW(JL,JKIJ)) ZCCLD=ZCLOUD(JL)*PCLDLW(JL,JKIJ-1) ZFU(JL)=ZFU(JL)+ZUPF(JL,JKIJ,JK)*ZCCLD 2232 CONTINUE 2233 CONTINUE C END IF C JKJ=JK2 JKIJ=1 DO 2234 JL = 1 , KDLON ZCLOUD(JL)=ZCLOUD(JL)*(1.-PCLDLW(JL,JKIJ)) ZFU(JL)=ZFU(JL)+ZUPF(JL,1,JK)*ZCLOUD(JL) PFLUX(JL,1,JK)=ZFU(JL) 2234 CONTINUE 2235 CONTINUE C C END IF C C* 2.3 END OF CLOUD EFFECT COMPUTATIONS C 230 CONTINUE C DO 231 JL = 1 , KDLON PFLUX(JL,1,KFLEV+1) = PFLUX(JL,1,KFLEV)+PCTS(JL,KFLEV) S - PHFG(JL,KFLEV)*(1.-ZCLOUD(JL)) S + PFLUX(JL,2,KFLEV) 231 CONTINUE C C IF (NIMP.LT.4) THEN C WRITE(NOUT,884) (PFLUX(JLIMPRAD,1,JK),JK = 1 , KFLEV+1) C WRITE(NOUT,884) (PFLUX(JLIMPRAD,2,JK),JK = 1 , KFLEV+1) C END IF C RETURN C C----------------------------------------------------------------------- C FORMATS C ------- C 884 FORMAT (1X,F7.2,18F6.1,F7.2) 886 FORMAT (1X,20I5) 888 FORMAT (1X,13E9.2) 890 FORMAT (1X,2I4,13F9.2) C END