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 !----------------------------------------------------------------------- #include "tsmbkind.h" USE YOERAD , ONLY : NOVLP USE YOERDI , ONLY : REPCLC USE YOEOVLP , ONLY : RA1OVLP IMPLICIT NONE ! DUMMY INTEGER SCALARS INTEGER_M :: KFDIA INTEGER_M :: KIDIA INTEGER_M :: KLEV INTEGER_M :: KLON !----------------------------------------------------------------------- !* 0.1 ARGUMENTS ! --------- REAL_B ::& &PBINT(KLON,KLEV+1), PBSUI(KLON) & &, PCLDLD(KLON,KLEV) , PCLDLU(KLON,KLEV)& &, PCNTRB(KLON,KLEV+1,KLEV+1)& &, PEMIT(KLON)& &, PFLUC(KLON,2,KLEV+1) REAL_B :: PFLUX(KLON,2,KLEV+1) !----------------------------------------------------------------------- !* 0.2 LOCAL ARRAYS ! ------------ REAL_B :: 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) ! LOCAL INTEGER SCALARS INTEGER_M :: IKCP1, IKM1, IKP1, IMAXC, IMXM1, IMXP1, JCLOUD,& &JK, JK1, JK2, JKJ, JL ! LOCAL REAL SCALARS REAL_B :: ZALPHA1, ZCFRAC ! ------------------------------------------------------------------ !* 1. INITIALIZATION ! -------------- !100 CONTINUE !print *,' Enter LWC ' DO JL = KIDIA,KFDIA ZCLOUD(JL) = _ZERO_ 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)=_ZERO_ 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)=_ZERO_ 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) = _ZERO_ 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)=_ONE_ ZCLOUD(JL)=_ZERO_ ENDDO DO JK = JK1 - 1 , 1 , -1 DO JL = KIDIA,KFDIA IF (NOVLP == 1) THEN !* maximum-random ZCLEAR(JL)=ZCLEAR(JL)*(_ONE_-MAX(PCLDLU(JL,JK),ZCLOUD(JL)))& &/(_ONE_-MIN(ZCLOUD(JL),_ONE_-REPCLC)) ZCLM(JL,JK1,JK) = _ONE_ - ZCLEAR(JL) ZCLOUD(JL) = PCLDLU(JL,JK) ELSEIF (NOVLP == 2) THEN !* maximum ZCLOUD(JL) = MAX(ZCLOUD(JL) , PCLDLU(JL,JK)) ZCLM(JL,JK1,JK) = ZCLOUD(JL) ELSEIF (NOVLP == 3) THEN !* random ZCLEAR(JL) = ZCLEAR(JL)*(_ONE_ - PCLDLU(JL,JK)) ZCLOUD(JL) = _ONE_ - ZCLEAR(JL) ZCLM(JL,JK1,JK) = ZCLOUD(JL) ELSEIF (NOVLP == 4) THEN !** Hogan & Illingworth (2001) ZALPHA1=RA1OVLP(KLEV+1-JK) ZCLEAR(JL)=ZCLEAR(JL)*( & & ZALPHA1*(_ONE_-MAX(PCLDLU(JL,JK),ZCLOUD(JL))) & & /(_ONE_-MIN(ZCLOUD(JL),_ONE_-REPCLC)) & & +(_ONE_-ZALPHA1)*(_ONE_-PCLDLU(JL,JK)) ) ZCLM(JL,JK1,JK) = _ONE_ - 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)=_ONE_ ZCLOUD(JL)=_ZERO_ ENDDO DO JK = JK1 , KLEV DO JL = KIDIA,KFDIA IF (NOVLP == 1) THEN !* maximum-random ZCLEAR(JL)=ZCLEAR(JL)*(_ONE_-MAX(PCLDLD(JL,JK),ZCLOUD(JL)))& &/(_ONE_-MIN(ZCLOUD(JL),_ONE_-REPCLC)) ZCLM(JL,JK1,JK) = _ONE_ - ZCLEAR(JL) ZCLOUD(JL) = PCLDLD(JL,JK) ELSEIF (NOVLP == 2) THEN !* maximum ZCLOUD(JL) = MAX(ZCLOUD(JL) , PCLDLD(JL,JK)) ZCLM(JL,JK1,JK) = ZCLOUD(JL) ELSEIF (NOVLP == 3) THEN !* random ZCLEAR(JL) = ZCLEAR(JL)*(_ONE_ - PCLDLD(JL,JK)) ZCLOUD(JL) = _ONE_ - ZCLEAR(JL) ZCLM(JL,JK1,JK) = ZCLOUD(JL) ELSEIF (NOVLP == 4) THEN !** Hogan & Illingworth (2001) ZALPHA1=RA1OVLP(KLEV+1-JK) ZCLEAR(JL)=ZCLEAR(JL)*( & & ZALPHA1*(_ONE_-MAX(PCLDLD(JL,JK),ZCLOUD(JL))) & & /(_ONE_-MIN(ZCLOUD(JL),_ONE_-REPCLC)) & & +(_ONE_-ZALPHA1)*(_ONE_ - PCLDLD(JL,JK)) ) ZCLM(JL,JK1,JK) = _ONE_ - 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) = _ZERO_ ENDDO DO JK1 = KLEV , 1 , -1 !* CONTRIBUTION FROM CLEAR-SKY FRACTION DO JL = KIDIA,KFDIA ZFD (JL) = (_ONE_ - 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)-(_ONE_-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) = (_ONE_ - 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' !----------------------------------------------------------------------- RETURN END SUBROUTINE LWC