SUBROUTINE LWC & & ( KIDIA , KFDIA, KLON , KLEV,& & PBINT , PBSUI, PCLDLD, PCLDLU,& & PCNTRB, PEMIT, PFLUC,& & PFLUX & & ) !**** *LWC* - LONGWAVE RADIATION, CLOUD EFFECTS ! PURPOSE. ! -------- ! INTRODUCES CLOUD EFFECTS ON LONGWAVE FLUXES OR ! RADIANCES !** INTERFACE. ! ---------- ! EXPLICIT ARGUMENTS : ! -------------------- ! ==== INPUTS === ! PBINT : (KLON,KLEV+1) ; HALF LEVEL PLANCK FUNCTION ! PBSUI : (KLON) ; SURFACE PLANCK FUNCTION ! PCLDLD : (KLON,KLEV) ; DOWNWARD EFFECTIVE CLOUD FRACTION ! PCLDLU : (KLON,KLEV) ; UPWARD EFFECTIVE CLOUD FRACTION ! PCNTRB : (KLON,KLEV+1,KLEV+1); CLEAR-SKY ENERGY EXCHANGE MATRIX ! PEMIT : (KLON) ; SURFACE TOTAL LW EMISSIVITY ! PFLUC : (KLON,2,KLEV+1) ; CLEAR-SKY LW RADIATIVE FLUXES ! ==== OUTPUTS === ! PFLUX : (KLON,2,KLEV+1) ; TOTAL SKY LW RADIATIVE FLUXES : ! 1 ==> UPWARD FLUX TOTAL ! 2 ==> DOWNWARD FLUX TOTAL ! IMPLICIT ARGUMENTS : NONE ! -------------------- ! METHOD. ! ------- ! 1. INITIALIZES ALL FLUXES TO CLEAR-SKY VALUES ! 2. EFFECT OF ONE OVERCAST UNITY EMISSIVITY CLOUD LAYER ! 3. EFFECT OF SEMI-TRANSPARENT, PARTIAL OR MULTI-LAYERED ! CLOUDS ! EXTERNALS. ! ---------- ! NONE ! REFERENCE. ! ---------- ! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND ! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS ! AUTHOR. ! ------- ! JEAN-JACQUES MORCRETTE *ECMWF* ! MODIFICATIONS. ! -------------- ! ORIGINAL : 89-07-14 ! JJ Morcrette 97-04-18 Cleaning ! JJMorcrette 01-02-16 Hogan & Illingworth (2001)'s mixed overlap ! M.Hamrud 01-Oct-2003 CY28 Cleaning !----------------------------------------------------------------------- USE PARKIND1 ,ONLY : JPIM ,JPRB USE YOMHOOK ,ONLY : LHOOK, DR_HOOK USE YOERAD , ONLY : NOVLP USE YOERDI , ONLY : REPCLC USE YOEOVLP , ONLY : RA1OVLP IMPLICIT NONE INTEGER(KIND=JPIM),INTENT(IN) :: KLON INTEGER(KIND=JPIM),INTENT(IN) :: KLEV INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA REAL(KIND=JPRB) ,INTENT(IN) :: PBINT(KLON,KLEV+1) REAL(KIND=JPRB) ,INTENT(IN) :: PBSUI(KLON) REAL(KIND=JPRB) ,INTENT(IN) :: PCLDLD(KLON,KLEV) REAL(KIND=JPRB) ,INTENT(IN) :: PCLDLU(KLON,KLEV) REAL(KIND=JPRB) ,INTENT(IN) :: PCNTRB(KLON,KLEV+1,KLEV+1) REAL(KIND=JPRB) ,INTENT(IN) :: PEMIT(KLON) REAL(KIND=JPRB) ,INTENT(IN) :: PFLUC(KLON,2,KLEV+1) REAL(KIND=JPRB) ,INTENT(OUT) :: PFLUX(KLON,2,KLEV+1) !----------------------------------------------------------------------- !* 0.1 ARGUMENTS ! --------- !----------------------------------------------------------------------- ! ------------ REAL(KIND=JPRB) :: ZCLEAR(KLON) , ZCLOUD(KLON)& & , ZCLM(KLON,KLEV+1,KLEV+1), ZDNF(KLON,KLEV+1,KLEV+1)& & , ZFD(KLON) , ZFU(KLON)& & , ZUPF(KLON,KLEV+1,KLEV+1) INTEGER(KIND=JPIM) :: IKCP1, IKM1, IKP1, IMAXC, IMXM1, IMXP1, JCLOUD,& & JK, JK1, JK2, JKJ, JL REAL(KIND=JPRB) :: ZALPHA1, ZCFRAC REAL(KIND=JPRB) :: ZHOOK_HANDLE ! ------------------------------------------------------------------ !* 1. INITIALIZATION ! -------------- !100 CONTINUE ! print *,' Enter LWC ' IF (LHOOK) CALL DR_HOOK('LWC',0,ZHOOK_HANDLE) DO JL = KIDIA,KFDIA ZCLOUD(JL) = 0.0_JPRB ENDDO DO JK = 1 , KLEV+1 DO JL = KIDIA,KFDIA PFLUX(JL,1,JK) = PFLUC(JL,1,JK) PFLUX(JL,2,JK) = PFLUC(JL,2,JK) ENDDO ENDDO !GM******* IMAXC=KLEV !GM******* ! ------------------------------------------------------------------ !* 2. EFFECT OF CLOUDINESS ON LONGWAVE FLUXES ! --------------------------------------- IMXP1 = IMAXC + 1 IMXM1 = IMAXC - 1 !* 2.0 INITIALIZE TO CLEAR-SKY FLUXES ! ------------------------------ !200 CONTINUE DO JK1=1,KLEV+1 DO JK2=1,KLEV+1 DO JL = KIDIA,KFDIA ZUPF(JL,JK2,JK1)=PFLUC(JL,1,JK1) ZDNF(JL,JK2,JK1)=PFLUC(JL,2,JK1) ENDDO ENDDO ENDDO ! print *,' LWC after Initialisation to clear-sky fluxes' !* 2.1 FLUXES FOR ONE OVERCAST UNITY EMISSIVITY CLOUD ! ---------------------------------------------- !210 CONTINUE DO JCLOUD = 1 , IMAXC IKCP1=JCLOUD+1 !* 2.1.1 ABOVE THE CLOUD ! --------------- !2110 CONTINUE DO JK=IKCP1,KLEV+1 IKM1=JK-1 DO JL = KIDIA,KFDIA ZFU(JL)=0.0_JPRB ENDDO IF (JK > IKCP1) THEN DO JKJ=IKCP1,IKM1 DO JL = KIDIA,KFDIA ZFU(JL) = ZFU(JL) + PCNTRB(JL,JK,JKJ) ENDDO ENDDO ENDIF DO JL = KIDIA,KFDIA ZUPF(JL,IKCP1,JK)=PBINT(JL,JK)-ZFU(JL) ENDDO ENDDO !* 2.1.2 BELOW THE CLOUD ! --------------- !2120 CONTINUE DO JK=1,JCLOUD IKP1=JK+1 DO JL = KIDIA,KFDIA ZFD(JL)=0.0_JPRB ENDDO IF (JK < JCLOUD) THEN DO JKJ=IKP1,JCLOUD DO JL = KIDIA,KFDIA ZFD(JL) = ZFD(JL) + PCNTRB(JL,JK,JKJ) ENDDO ENDDO ENDIF DO JL = KIDIA,KFDIA ZDNF(JL,IKCP1,JK)=-PBINT(JL,JK)-ZFD(JL) ENDDO ENDDO ENDDO ! print *,' LWC after 213: Fluxes for unity emissivity' !* 2.2 CLOUD COVER MATRIX ! ------------------ !* ZCLM(JK1,JK2) IS THE OBSCURATION FACTOR BY CLOUD LAYERS BETWEEN ! HALF-LEVELS JK1 AND JK2 AS SEEN FROM JK1 !220 CONTINUE DO JK1 = 1 , KLEV+1 DO JK2 = 1 , KLEV+1 DO JL = KIDIA,KFDIA ZCLM(JL,JK1,JK2) = 0.0_JPRB ENDDO ENDDO ENDDO ! print *,' LWC after Initialisation CC matrix' !* 2.4 CLOUD COVER BELOW THE LEVEL OF CALCULATION ! ------------------------------------------ !240 CONTINUE DO JK1 = 2 , KLEV+1 DO JL = KIDIA,KFDIA ZCLEAR(JL)=1.0_JPRB ZCLOUD(JL)=0.0_JPRB ENDDO DO JK = JK1 - 1 , 1 , -1 ZALPHA1=RA1OVLP(KLEV+1-JK) DO JL = KIDIA,KFDIA !++MODIFCODE IF ((NOVLP==1).OR.(NOVLP==6).OR.(NOVLP==8)) THEN !--MODIFCODE !* maximum-random ZCLEAR(JL)=ZCLEAR(JL)*(1.0_JPRB-MAX(PCLDLU(JL,JK),ZCLOUD(JL)))& & /(1.0_JPRB-MIN(ZCLOUD(JL),1.0_JPRB-REPCLC)) ZCLM(JL,JK1,JK) = 1.0_JPRB - ZCLEAR(JL) ZCLOUD(JL) = PCLDLU(JL,JK) !++MODIFCODE ELSEIF ((NOVLP==2).OR.(NOVLP==7)) THEN !--MODIFCODE !* maximum ZCLOUD(JL) = MAX(ZCLOUD(JL) , PCLDLU(JL,JK)) ZCLM(JL,JK1,JK) = ZCLOUD(JL) !++MODIFCODE ELSEIF ((NOVLP == 3).OR.(NOVLP==5)) THEN !--MODIFCODE !* random ZCLEAR(JL) = ZCLEAR(JL)*(1.0_JPRB - PCLDLU(JL,JK)) ZCLOUD(JL) = 1.0_JPRB - ZCLEAR(JL) ZCLM(JL,JK1,JK) = ZCLOUD(JL) ELSEIF (NOVLP == 4) THEN !** Hogan & Illingworth (2001) ZCLEAR(JL)=ZCLEAR(JL)*( & & ZALPHA1*(1.0_JPRB-MAX(PCLDLU(JL,JK),ZCLOUD(JL))) & & /(1.0_JPRB-MIN(ZCLOUD(JL),1.0_JPRB-REPCLC)) & & +(1.0_JPRB-ZALPHA1)*(1.0_JPRB-PCLDLU(JL,JK)) ) ZCLM(JL,JK1,JK) = 1.0_JPRB - ZCLEAR(JL) ZCLOUD(JL) = PCLDLU(JL,JK) ENDIF ENDDO ENDDO ENDDO ! print *,' LWC after 244: CC below level of calculation' !* 2.5 CLOUD COVER ABOVE THE LEVEL OF CALCULATION ! ------------------------------------------ !250 CONTINUE DO JK1 = 1 , KLEV DO JL = KIDIA,KFDIA ZCLEAR(JL)=1.0_JPRB ZCLOUD(JL)=0.0_JPRB ENDDO DO JK = JK1 , KLEV ZALPHA1=RA1OVLP(KLEV+1-JK) DO JL = KIDIA,KFDIA !++MODIFCODE IF ((NOVLP == 1).OR.(NOVLP==6).OR.(NOVLP==8)) THEN !--MODIFCODE !* maximum-random ZCLEAR(JL)=ZCLEAR(JL)*(1.0_JPRB-MAX(PCLDLD(JL,JK),ZCLOUD(JL)))& & /(1.0_JPRB-MIN(ZCLOUD(JL),1.0_JPRB-REPCLC)) ZCLM(JL,JK1,JK) = 1.0_JPRB - ZCLEAR(JL) ZCLOUD(JL) = PCLDLD(JL,JK) !++MODIFCODE ELSEIF ((NOVLP == 2).OR.(NOVLP==7)) THEN !--MODIFCODE !* maximum ZCLOUD(JL) = MAX(ZCLOUD(JL) , PCLDLD(JL,JK)) ZCLM(JL,JK1,JK) = ZCLOUD(JL) !++MODIFCODE ELSEIF ((NOVLP == 3).OR.(NOVLP==5)) THEN !--MODIFCODE !* random ZCLEAR(JL) = ZCLEAR(JL)*(1.0_JPRB - PCLDLD(JL,JK)) ZCLOUD(JL) = 1.0_JPRB - ZCLEAR(JL) ZCLM(JL,JK1,JK) = ZCLOUD(JL) ELSEIF (NOVLP == 4) THEN !** Hogan & Illingworth (2001) ZCLEAR(JL)=ZCLEAR(JL)*( & & ZALPHA1*(1.0_JPRB-MAX(PCLDLD(JL,JK),ZCLOUD(JL))) & & /(1.0_JPRB-MIN(ZCLOUD(JL),1.0_JPRB-REPCLC)) & & +(1.0_JPRB-ZALPHA1)*(1.0_JPRB - PCLDLD(JL,JK)) ) ZCLM(JL,JK1,JK) = 1.0_JPRB - ZCLEAR(JL) ZCLOUD(JL) = PCLDLD(JL,JK) ENDIF ENDDO ENDDO ENDDO ! print *,' LWC after 254: CC above level of calculation' !* 3. FLUXES FOR PARTIAL/MULTIPLE LAYERED CLOUDINESS ! ---------------------------------------------- !300 CONTINUE !* 3.1 DOWNWARD FLUXES ! --------------- !310 CONTINUE DO JL = KIDIA,KFDIA PFLUX(JL,2,KLEV+1) = 0.0_JPRB ENDDO DO JK1 = KLEV , 1 , -1 !* CONTRIBUTION FROM CLEAR-SKY FRACTION DO JL = KIDIA,KFDIA ZFD (JL) = (1.0_JPRB - ZCLM(JL,JK1,KLEV)) * ZDNF(JL,1,JK1) !* CONTRIBUTION FROM ADJACENT CLOUD ZFD(JL) = ZFD(JL) + ZCLM(JL,JK1,JK1) * ZDNF(JL,JK1+1,JK1) ENDDO !* CONTRIBUTION FROM OTHER CLOUDY FRACTIONS DO JK = KLEV-1 , JK1 , -1 DO JL = KIDIA,KFDIA ZCFRAC = ZCLM(JL,JK1,JK+1) - ZCLM(JL,JK1,JK) ZFD(JL) = ZFD(JL) + ZCFRAC * ZDNF(JL,JK+2,JK1) ENDDO ENDDO DO JL = KIDIA,KFDIA PFLUX(JL,2,JK1) = ZFD (JL) ENDDO ENDDO ! print *,' LWC after 317: Downward fluxes' !* 3.2 UPWARD FLUX AT THE SURFACE ! -------------------------- !320 CONTINUE DO JL = KIDIA,KFDIA PFLUX(JL,1,1) = PEMIT(JL)*PBSUI(JL)-(1.0_JPRB-PEMIT(JL))*PFLUX(JL,2,1) ENDDO !* 3.3 UPWARD FLUXES ! ------------- !330 CONTINUE DO JK1 = 2 , KLEV+1 !* CONTRIBUTION FROM CLEAR-SKY FRACTION DO JL = KIDIA,KFDIA ZFU (JL) = (1.0_JPRB - ZCLM(JL,JK1,1)) * ZUPF(JL,1,JK1) !* CONTRIBUTION FROM ADJACENT CLOUD ZFU(JL) = ZFU(JL) + ZCLM(JL,JK1,JK1-1) * ZUPF(JL,JK1,JK1) ENDDO !* CONTRIBUTION FROM OTHER CLOUDY FRACTIONS DO JK = 2 , JK1-1 DO JL = KIDIA,KFDIA ZCFRAC = ZCLM(JL,JK1,JK-1) - ZCLM(JL,JK1,JK) ZFU(JL) = ZFU(JL) + ZCFRAC * ZUPF(JL,JK ,JK1) ENDDO ENDDO DO JL = KIDIA,KFDIA PFLUX(JL,1,JK1) = ZFU (JL) ENDDO ENDDO ! print *,' LWC after 337: Upward fluxes' !----------------------------------------------------------------------- IF (LHOOK) CALL DR_HOOK('LWC',1,ZHOOK_HANDLE) END SUBROUTINE LWC