*=*=*=*= LWU.html =*=*=*=*
SUBROUTINE LWU ( KDLON,KFLEV,KAER,KMODE,KFLUX,KRAD S , PAER,PCCO2,PDP,PPMB,PPSOL,PQOF,PTAVE,PVIEW,PWV S , PABCUCO2,PABCUAER ) IMPLICIT LOGICAL (L) C #include "dimensions.h" #include "dimphys.h" #include "dimradmars.h" C C**** *LWU* - LONGWAVE EFFECTIVE ABSORBER AMOUNTS C C PURPOSE. C -------- C COMPUTES ABSORBER AMOUNTS INCLUDING PRESSURE AND C TEMPERATURE EFFECTS C C** INTERFACE. C ---------- C SUBROUTINE LWU ( KDLON,KFLEV,KAER,KMODE,KFLUX,KRAD C S , PAER,PCCO2,PDP,PPMB,PPSOL,PQOF,PTAVE,PVIEW,PWV C S , KXDIA,KXT,KXTSU,KXTTP, PABCUCO2,PABCUAER ) C C EXPLICIT ARGUMENTS : C -------------------- C ==== INPUTS === C PAER : (KDLON,KFLEV,5) ; OPTICAL THICKNESS OF THE AEROSOLS C PCCO2 : ; CONCENTRATION IN CO2 (PA/PA) C PDP : (KDLON,KFLEV) ; LAYER PRESSURE THICKNESS (PA) C PPMB : (KDLON,0:KFLEV) ; HALF LEVEL PRESSURE C PPSOL : (KDLON) ; SURFACE PRESSURE C PQOF : (KDLON,KFLEV) ; CONCENTRATION IN OZONE (PA/PA) C PTAVE : (KDLON,KFLEV) ; TEMPERATURE C PWV : (KDLSUR,KFLEV) ; SPECIFIC HUMIDITY PA/PA C PVIEW : (KDLON) ; COSECANT OF VIEWING ANGLE C ==== OUTPUTS === C KX... : (KDLON,... ; TEMPERATURE INDICES C PABCUCO2 :(KDLON,NUACO2,3*KFLEV+1); EFFECTIVE ABSORBER AMOUNTS (CO2) C PABCUAER :(KDLON,NIR,3*KFLEV+1); EFFECTIVE ABSORBER AMOUNTS (AEROSOLS) C C IMPLICIT ARGUMENTS : NONE C -------------------- C C METHOD. C ------- C C 1. COMPUTES THE PRESSURE AND TEMPERATURE WEIGHTED AMOUNTS OF C ABSORBERS. 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 c! modif diffusion c! on ne change rien a la bande CO2 : les quantites d'absorbant CO2 c! sont multipliees par 1.66 et les extinctions par les poussieres c! sont directement calculees ici sous forme d'exponentielles. c! pour les bandes "poussieres", on calcule les quantites d'absorbant c! selon la normale (pas de facteur 1.66). 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 PAER(NDLO2,KFLEV,5), PDP(NDLO2,KFLEV) S , PPMB(NDLO2,KFLEV+1), PPSOL(NDLO2), PQOF(NDLO2,KFLEV) S , PTAVE(NDLO2,KFLEV), PVIEW(NDLO2), PWV(NDLO2,KFLEV) C REAL PABCUCO2(NDLO2,NUACO2,3*KFLEV+1) REAL PABCUAER(NDLO2,NIR,3*KFLEV+1) C C------------------------------------------------------------------------- C C* 0.2 LOCAL ARRAYS C ------------ REAL ZABLY(NDLON,NUA,3*NFLEV+1) S , ZDST(NDLON,NFLEV+1), ZDUC(NDLON, 3*NFLEV+1) REAL ZPHIO(NDLON) REAL ZPSC11(NDLON),ZPSC12(NDLON),ZPSC21(NDLON),ZPSC22(NDLON) REAL ZSSIG(NDLON,3*NFLEV+1) S , ZUAER(NDLON,nir), ZXOZ(NDLON), ZXWV(NDLON) REAL zphi(ndlon,2),zpsi(ndlon,2) common/scratch/ZABLY,ZDST,ZDUC,ZSSIG C C----------------------------------------------------------------------- C C* 1. INITIALIZATION C -------------- C 100 CONTINUE C C----------------------------------------------------------------------- C C C* 2. PRESSURE OVER GAUSS SUB-LEVELS C ------------------------------ C 200 CONTINUE C DO 201 JL = 1 , KDLON ZSSIG(JL, 1 ) = 1.0 201 CONTINUE C DO 206 JK = 1 , KFLEV JKJ=(JK-1)*NG1P1+1 JKJR = JKJ JKJP = JKJ + NG1P1 DO 203 JL = 1 , KDLON ZSSIG(JL,JKJP)=PPMB(JL,JK+1)/PPMB(JL,1) 203 CONTINUE DO 205 IG1=1,NG1 JKJ=JKJ+1 DO 204 JL = 1 , KDLON ZSSIG(JL,JKJ)= (ZSSIG(JL,JKJR)+ZSSIG(JL,JKJP))*0.5 S + RT1(IG1) * (ZSSIG(JL,JKJP) - ZSSIG(JL,JKJR)) * 0.5 204 CONTINUE 205 CONTINUE 206 CONTINUE C C----------------------------------------------------------------------- C C C* 4. PRESSURE THICKNESS AND MEAN PRESSURE OF SUB-LAYERS C -------------------------------------------------- C 400 CONTINUE c----------------------------------------------------------------------- c ATTENTION AUX UNITES: c psol est en Pa c pmb, comme son nom l'indique est en mb c le facteur .1 dans ZABLY(JL,3,JKI) fait passer des kg m-2 aux g cm-2 c ZDPM est la quantite d'absorbant en g cm-2 c ZPPP est la pression en Pa c----------------------------------------------------------------------- DO 402 JKI=1,3*KFLEV JKIP1=JKI+1 DO 401 JL = 1 , KDLON ZABLY(JL,5,JKI)=(ZSSIG(JL,JKI)+ZSSIG(JL,JKIP1))*0.5 ZABLY(JL,3,JKI)=(ZSSIG(JL,JKI)-ZSSIG(JL,JKIP1)) S *PPSOL(JL)/(10.*RG) 401 CONTINUE 402 CONTINUE C DO 406 JK = 1 , KFLEV JKP1=JK+1 JKL = KFLEV+1 - JK JKJ=(JK-1)*NG1P1+1 JKJPN=JKJ+NG1 DO 405 JKK=JKJ,JKJPN DO 404 JL = 1 , KDLON ZDPM = ZABLY(JL,3,JKK) ZPPP = ZABLY(JL,5,JKK) * PPSOL(JL) ZDUC(JL,JKK)=ZDPM ZABLY(JL,1,JKK)= PCCO2 * ZDPM ZABLY(JL,2,JKK)= PCCO2 * ZDPM * ZPPP / 101325. 404 CONTINUE 405 CONTINUE 406 CONTINUE C C----------------------------------------------------------------------- C C C* 5. CUMULATIVE ABSORBER AMOUNTS FROM TOP OF ATMOSPHERE C -------------------------------------------------- C 500 CONTINUE C DO 502 JI=1,NUACO2 DO 501 JL = 1 , KDLON PABCUCO2(JL,JI,3*KFLEV+1)=0. 501 CONTINUE 502 CONTINUE C DO 503 JI=1,NIR DO 504 JL = 1 , KDLON PABCUAER(JL,JI,3*KFLEV+1)=0. 504 CONTINUE 503 CONTINUE C DO 529 JK = 1 , KFLEV JJ=(JK-1)*NG1P1+1 JJPN=JJ+NG1 JKL=KFLEV+1-JK C C C* 5.1 CUMULATIVE AEROSOL AMOUNTS FROM TOP OF ATMOSPHERE C -------------------------------------------------- C 510 CONTINUE C JAE1=3*KFLEV+1-JJ JAE2=3*KFLEV+1-(JJ+1) JAE3=3*KFLEV+1-JJPN DO iir=1,nir do jl=1,kdlon zuaer(jl,iir)=0. do itra=1,ntra zuaer(jl,iir)= & zuaer(jl,iir)+qextaer(iir)*paer(jl,jkl,itra) enddo zuaer(jl,iir)=zuaer(jl,iir)/ & (ZDUC(JL,JAE1)+ZDUC(JL,JAE2)+ZDUC(JL,JAE3)) enddo enddo C C C* 5.2 INTRODUCES TEMPERATURE EFFECTS ON ABSORBER AMOUNTS C -------------------------------------------------- C 520 CONTINUE C C DO ja=1,2 DO jl=1,kdlon c modif 20 09 96, consolidation du code ztx=sign(min(abs(ptave(jl,jkl)-tref),70.) , ,ptave(jl,jkl)-tref) ztx2=ztx*ztx zphi(jl,ja)=at(1,ja)*ztx+bt(1,ja)*ztx2 zpsi(jl,ja)=at(2,ja)*ztx+bt(2,ja)*ztx2 zphi(jl,ja)=exp(zphi(jl,ja)/cst_voigt(2,ja)) zpsi(jl,ja)=exp(2.*zpsi(jl,ja)) ENDDO ENDDO c----------------------------------------------------------------------- c ZABLY(1) quantite d'absorbant u en g ms-2 c ZABLY(2) u*p/p0 c----------------------------------------------------------------------- DO jkk=jj,jjpn jc=3*kflev+1-jkk jcp1=jc+1 c! c! le co2 c! DO jl=1,kdlon zdiff = pview(jl) pabcuco2(jl,1,jc)=pabcuco2(jl,1,jcp1) S + zably(jl,1,jc)*zphi(jl,1)*zdiff pabcuco2(jl,2,jc)=pabcuco2(jl,2,jcp1) s + zably(jl,2,jc)*zpsi(jl,1)*zdiff pabcuco2(jl,3,jc)=pabcuco2(jl,3,jcp1) S + zably(jl,1,jc)*zphi(jl,2)*zdiff pabcuco2(jl,4,jc)=pabcuco2(jl,4,jcp1) s + zably(jl,2,jc)*zpsi(jl,2)*zdiff ENDDO c! c! les poussieres dans toutes les bandes (y compris la bande co2) c! DO iir=1,nir DO jl=1,kdlon pabcuaer(jl,iir,jc)=pabcuaer(jl,iir,jcp1) S +zuaer(jl,iir) *zduc(jl,jc) ENDDO ENDDO ENDDO C 529 CONTINUE C c! c! les poussieres dans la bande du co2 c! c on calcule directement les transmissions pour les aerosols. c on multiplie le Qext par 1-omega dans la bande du CO2. c et pourquoi pas d'abord? hourdin@lmd.ens.fr DO jc=1,3*kflev+1 DO iir=1,2 DO jl=1,kdlon zzz=pview(jl)*(1.-omegaer(iir)) pabcuaer(jl,iir,jc)=exp(-zzz*pabcuaer(jl,iir,jc)) ENDDO ENDDO ENDDO 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