*=*=*=*= LWVD.html =*=*=*=*
SUBROUTINE LWVD ( KDLON,KFLEV,KUAER,KTRAER S , pga,pgb S , PABCUCO2,PABCUAER,PDBDT S , PDISD,PDISU ) IMPLICIT LOGICAL (L) C #include "dimensions.h" #include "dimphys.h" #include "dimradmars.h" C C**** *LWVD* - L.W., VERTICAL INTEGRATION, DISTANT LAYERS C C PURPOSE. C -------- C CARRIES OUT THE VERTICAL INTEGRATION ON THE DISTANT LAYERS C C** INTERFACE. C ---------- C SUBROUTINE LWVD ( KDLON,KFLEV,KUAER,KTRAER C S , KXDIA,KXT C S , PABCUCO2,PABCUAER,PDBDT C S , PDISD,PDISU ) 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 PDBDT : (KDLON,KFLEV) ; LAYER PLANCK FUNCTION GRADIENT C ==== OUTPUTS === C PDIS.. : (KDLON,KFLEV+1) ; CONTRIBUTION BY DISTANT LAYERS C C IMPLICIT ARGUMENTS : NONE C -------------------- C C METHOD. C ------- C C 1. PERFORMS THE VERTICAL INTEGRATION CORRESPONDING TO THE C CONTRIBUTIONS OF THE DISTANT LAYERS USING TRAPEZOIDAL RULE 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 , PDBDT(NDLO2,nir,KFLEV) C REAL PDISD(NDLO2,KFLEV+1), PDISU(NDLO2,KFLEV+1) 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 PDISD(JL,JK)=0. PDISU(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 C* 2.2 CONTRIBUTION FROM DISTANT LAYERS C --------------------------------- C 220 CONTINUE C C C* 2.2.1 DISTANT AND ABOVE LAYERS C ------------------------ C 2210 CONTINUE C C C C* 2.2.2 FIRST UPPER LEVEL C ----------------- C 2220 CONTINUE C DO 225 JK = 1 , KFLEV-1 JKP1=JK+1 KN=(JK-1)*NG1P1+1 KD1= JK *NG1P1+1 C DO 2223 JA = 1 , 4 DO 2222 JL = 1 , KDLON ZUU(JL,JA) = PABCUCO2(JL,JA,KN) - PABCUCO2(JL,JA,KD1) 2222 CONTINUE 2223 CONTINUE DO ja=3,4 DO jl=1,kdlon ztt(jl,ja)=pabcuaer(jl,ja-2,kn)/pabcuaer(jl,ja-2,kd1) ENDDO ENDDO C CALL LWTT(KDLON,pga(1,jk+1),pgb(1,jk+1),ZUU,ZTT) C DO 2225 JA = 1 , KTRAER DO 2224 JL = 1 , KDLON ZTT1(JL,JA)=ZTT(JL,JA) 2224 CONTINUE 2225 CONTINUE C C C C* 2.2.3 HIGHER UP C --------- C 2230 CONTINUE C DO 224 JKJ=JKP1,KFLEV KJP1=JKJ+1 KD2= JKJ *NG1P1+1 C DO 2233 JA = 1 , 4 DO 2232 JL = 1 , KDLON ZUU(JL,JA) = PABCUCO2(JL,JA,KN) - PABCUCO2(JL,JA,KD2) 2232 CONTINUE 2233 CONTINUE DO ja=3,4 DO jl=1,kdlon ztt(jl,ja)=pabcuaer(jl,ja-2,kn)/pabcuaer(jl,ja-2,kd2) ENDDO ENDDO C CALL LWTT(KDLON,pga(1,jkj+1),pgb(1,jkj+1),ZUU,ZTT) C DO 2235 JA = 1 , KTRAER DO 2234 JL = 1 , KDLON ZTT2(JL,JA)=ZTT(JL,JA) ZTT(JL,JA)=(ZTT1(JL,JA)+ZTT2(JL,JA))*0.5 2234 CONTINUE 2235 CONTINUE C DO 2236 JL = 1 , KDLON ZWW= 1 PDBDT(JL,1,JKJ)*ZTT(JL,1)*ZTT(JL,3) 2 + PDBDT(JL,2,JKJ)*ZTT(JL,2)*ZTT(JL,4) ZGLAYD(JL)=ZWW ZDZXDG=ZGLAYD(JL) PDISD(JL,JK)=PDISD(JL,JK)+ZDZXDG c PCNTRB(JL,JK,KJP1)=ZDZXDG 2236 CONTINUE C DO 2238 JA = 1 , KTRAER DO 2237 JL = 1 , KDLON ZTT1(JL,JA)=ZTT2(JL,JA) 2237 CONTINUE 2238 CONTINUE C 224 CONTINUE 225 CONTINUE C C C* 2.2.4 DISTANT AND BELOW LAYERS C ------------------------ C 2240 CONTINUE C C C C* 2.2.5 FIRST LOWER LEVEL C ----------------- C 2250 CONTINUE C DO 228 JK=3,KFLEV+1 KN=(JK-1)*NG1P1+1 KM1=JK-1 KJ=JK-2 KU1= KJ *NG1P1+1 C DO 2253 JA = 1 , 4 DO 2252 JL = 1 , KDLON ZUU(JL,JA) = PABCUCO2(JL,JA,KU1) - PABCUCO2(JL,JA,KN) 2252 CONTINUE 2253 CONTINUE DO ja=3,4 DO jl=1,kdlon ztt(jl,ja)=pabcuaer(jl,ja-2,ku1)/pabcuaer(jl,ja-2,kn) ENDDO ENDDO C CALL LWTT(KDLON,pga(1,kj+1),pgb(1,kj+1),ZUU,ZTT) C DO 2255 JA = 1 , KTRAER DO 2254 JL = 1 , KDLON ZTT1(JL,JA)=ZTT(JL,JA) 2254 CONTINUE 2255 CONTINUE C C C* 2.2.6 DOWN BELOW C ---------- C 2260 CONTINUE C DO 227 JLK=1,KJ JKL=KM1-JLK KU2=(JKL-1)*NG1P1+1 C DO 2263 JA = 1 , 4 DO 2262 JL = 1 , KDLON ZUU(JL,JA) = PABCUCO2(JL,JA,KU2) - PABCUCO2(JL,JA,KN) 2262 CONTINUE 2263 CONTINUE DO ja=3,4 DO jl=1,kdlon ztt(jl,ja)=pabcuaer(jl,ja-2,ku2)/pabcuaer(jl,ja-2,kn) ENDDO ENDDO C CALL LWTT(KDLON,pga(1,jkl),pgb(1,jkl),ZUU,ZTT) C DO 2265 JA = 1 , KTRAER DO 2264 JL = 1 , KDLON ZTT2(JL,JA)=ZTT(JL,JA) ZTT(JL,JA)=(ZTT1(JL,JA)+ZTT2(JL,JA))*0.5 2264 CONTINUE 2265 CONTINUE C DO 2266 JL = 1 , KDLON ZWW= 1 PDBDT(JL,1,JKL)*ZTT(JL,1)*ZTT(JL,3) 2 + PDBDT(JL,2,JKL)*ZTT(JL,2)*ZTT(JL,4) ZGLAYU(JL)=ZWW ZDZXMG=ZGLAYU(JL) PDISU(JL,JK)=PDISU(JL,JK)+ZDZXMG c PCNTRB(JL,JK,JKL)=ZDZXMG 2266 CONTINUE C DO 2268 JA = 1 , KTRAER DO 2267 JL = 1 , KDLON ZTT1(JL,JA)=ZTT2(JL,JA) 2267 CONTINUE 2268 CONTINUE C 227 CONTINUE 228 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