*=*=*=*= LWVN.html =*=*=*=*
SUBROUTINE LWVN ( KDLON,KFLEV,KUAER,KTRAER S , pga,pgb s , PABCUCO2,PABCUAER,PDBSL S , PADJD,PADJU,PDBDT ) IMPLICIT LOGICAL (L) C #include "dimensions.h" #include "dimphys.h" #include "dimradmars.h" C C**** *LWVN* - L.W., VERTICAL INTEGRATION, NEARBY LAYERS C C PURPOSE. C -------- C CARRIES OUT THE VERTICAL INTEGRATION ON NEARBY LAYERS C TO GIVE LONGWAVE FLUXES OR RADIANCES C C** INTERFACE. C ---------- C SUBROUTINE LWVN ( KDLON,KFLEV,KUAER,KTRAER C S , KXDIA, PABCUCO2,PABCUAER,PDBSL C S , PADJD,PADJU,PDBDT ) C C EXPLICIT ARGUMENTS : C -------------------- C ==== INPUTS === C KX... (KDLON,... ; TEMPERATURE INDICES C PABCUCO2 : (KDLON,NUA,3*KFLEV+1); ABSORBER AMOUNTS (CO2) C PABCUAER : (KDLON,NUA,3*KFLEV+1); ABSORBER AMOUNTS (AEROSOLS) C PDBSL : (KDLON,KFLEV*2) ; SUB-LAYER PLANCK FUNCTION GRADIENT C ==== OUTPUTS === C PADJ.. : (KDLON,KFLEV+1) ; CONTRIBUTION OF ADJACENT LAYERS C PDBDT : (KDLON,NUA,KFLEV) ; LAYER PLANCK FUNCTION GRADIENT C C IMPLICIT ARGUMENTS : NONE C -------------------- C C METHOD. C ------- C C 1. PERFORMS THE VERTICAL INTEGRATION CORRESPONDING TO THE C CONTRIBUTIONS OF THE ADJACENT LAYERS USING A GAUSSIAN QUADRATURE C C EXTERNALS. C ---------- C C *LWTT* 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 c! modif diffusion c! on ne prend en compte que les deux bandes du CO2. c! C 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 pga(NDLO2*2*3,kflev+1),pgb(NDLO2*2*3,kflev+1) REAL PABCUCO2(NDLO2,NUACO2,3*KFLEV+1) REAL PABCUAER(NDLO2,NIR,3*KFLEV+1) S , PDBSL(NDLO2,nir,KFLEV*2) C REAL PADJD(NDLO2,KFLEV+1), PADJU(NDLO2,KFLEV+1) c S , PCNTRB(NDLO2,KFLEV+1,KFLEV+1) S , PDBDT(NDLO2,nir,KFLEV) C C------------------------------------------------------------------------- C C* 0.2 LOCAL ARRAYS C ------------ C REAL ZGLAYD(NDLON),ZGLAYU(NDLON) S , ZTT(NDLON,NTRA), ZTT1(NDLON,NTRA), ZTT2(NDLON,NTRA) S , ZUU(NDLON,NUA) C C----------------------------------------------------------------------- C C* 1. INITIALIZATION C -------------- C 100 CONTINUE C C* 1.1 INITIALIZE LAYER CONTRIBUTIONS C ------------------------------ C 110 CONTINUE C DO 112 JK = 1 , KFLEV+1 DO 111 JL = 1 , KDLON PADJD(JL,JK) = 0. PADJU(JL,JK) = 0. 111 CONTINUE 112 CONTINUE C C* 1.2 INITIALIZE TRANSMISSION FUNCTIONS C --------------------------------- C 120 CONTINUE C DO 122 JA = 1 , NTRA DO 121 JL = 1 , KDLON ZTT (JL,JA) = 1.0 ZTT1(JL,JA) = 1.0 ZTT2(JL,JA) = 1.0 121 CONTINUE 122 CONTINUE C DO 124 JA = 1 , NUA DO 123 JL = 1 , KDLON ZUU(JL,JA) = 0. 123 CONTINUE 124 CONTINUE C C ------------------------------------------------------------------ C C* 2. VERTICAL INTEGRATION C -------------------- C 200 CONTINUE C IND1=0 IND3=0 IND4=1 IND2=1 C C* 2.1 CONTRIBUTION FROM ADJACENT LAYERS C --------------------------------- C 210 CONTINUE C DO 215 JK = 1 , KFLEV C C* 2.1.1 DOWNWARD LAYERS C --------------- C 2110 CONTINUE C KM12 = 2 * (JK - 1) KND = (JK - 1) * NG1P1 + 1 KXD = KND KNU = JK * NG1P1 + 1 KXU = KND C DO 2111 JL = 1 , KDLON ZGLAYD(JL) = 0. ZGLAYU(JL) = 0. 2111 CONTINUE C DO 213 IG = 1 , NG1 KBS = KM12 + IG KDD = KXD + IG DO 2113 JA = 1 , 4 DO 2112 JL = 1 , KDLON ZUU(JL,JA) = PABCUCO2(JL,JA,KND) - PABCUCO2(JL,JA,KDD) 2112 CONTINUE 2113 CONTINUE DO ja=3,4 DO jl=1,kdlon ztt(jl,ja)=pabcuaer(jl,ja-2,knd)/pabcuaer(jl,ja-2,kdd) ENDDO ENDDO C CALL LWTT(KDLON,pga(1,jk),pgb(1,jk),ZUU,ZTT) C DO 2114 JL = 1 , KDLON ZWTR= 1 PDBSL(JL,1,KBS)*ZTT(JL,1)*ZTT(JL,3) 2 + PDBSL(JL,2,KBS)*ZTT(JL,2)*ZTT(JL,4) ZGLAYD(JL)=ZGLAYD(JL)+ZWTR*WG1(IG) 2114 CONTINUE C C* 2.1.2 UPWARD LAYERS C --------------- C 2120 CONTINUE C KMU = KXU + IG DO 2122 JA = 1 , 4 DO 2121 JL = 1 , KDLON ZUU(JL,JA) = PABCUCO2(JL,JA,KMU) - PABCUCO2(JL,JA,KNU) 2121 CONTINUE 2122 CONTINUE DO ja=3,4 DO jl=1,kdlon ztt(jl,ja)=pabcuaer(jl,ja-2,kmu)/pabcuaer(jl,ja-2,knu) ENDDO ENDDO C CALL LWTT(KDLON,pga(1,jk),pgb(1,jk),ZUU,ZTT) C DO 2123 JL = 1 , KDLON ZWTR= 1 PDBSL(JL,1,KBS)*ZTT(JL,1)*ZTT(JL,3) 2 + PDBSL(JL,2,KBS)*ZTT(JL,2)*ZTT(JL,4) ZGLAYU(JL)=ZGLAYU(JL)+ZWTR*WG1(IG) 2123 CONTINUE C 213 CONTINUE C DO 214 JL = 1 , KDLON PADJD(JL,JK) = ZGLAYD(JL) c PCNTRB(JL,JK,JK+1) = ZGLAYD(JL) PADJU(JL,JK+1) = ZGLAYU(JL) c PCNTRB(JL,JK+1,JK) = ZGLAYU(JL) c PCNTRB(JL,JK ,JK) = 0.0 214 CONTINUE C 215 CONTINUE C DO 218 JK = 1 , KFLEV JK2 = 2 * JK JK1 = JK2 - 1 DO 217 JNU = 1 , nir DO 216 JL = 1 , KDLON PDBDT(JL,JNU,JK) = PDBSL(JL,JNU,JK1) + PDBSL(JL,JNU,JK2) 216 CONTINUE 217 CONTINUE 218 CONTINUE 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