*=*=*=*= LWV.html =*=*=*=*
SUBROUTINE LWV (KDLON,KFLEV,KMODE,KFLUX,KRAD,KUAER,KTRAER S , pga,pgb,pgab,pgbb S , PABCUCO2,PABCUAER,PBINT,PBSUIN,PBSUR,PBTOP,PDBSL,PEMIS,PTAVE S , PCTS,PHFG,PEMD,PEMU,PCOLC,PFLUC ) IMPLICIT LOGICAL (L) C #include "dimensions.h" #include "dimphys.h" #include "dimradmars.h" C C**** *LWV* - LONGWAVE RADIATION, VERTICAL INTEGRATION C C PURPOSE. C -------- C CARRIES OUT THE VERTICAL INTEGRATION TO GIVE LONGWAVE C FLUXES OR RADIANCES C C** INTERFACE. C ---------- C SUBROUTINE LWV ( KDLON,KFLEV,KMODE,KFLUX,KRAD,KUAER,KTRAER C S , KXDIA,KXT,KXTSU,KXTTP C S , PABCUCO2,PABCUAER,PBINT,PBSUIN,PBSUR,PBTOP,PDBSL,PEMIS,PTAVE C S , PCNTRB,PCTS,PHFG,PEMD,PEMU,PCOLC,PFLUC ) C C EXPLICIT ARGUMENTS : C -------------------- C ==== INPUTS === C KX... (KDLON,... ; TEMPERATURE INDICES C PABCUCO2 : (KDLON,NUACO2,3*KFLEV+1); ABSORBER AMOUNTS (CO2) C PABCUAER : (KDLON,NUAAER,3*KFLEV+1); ABSORBER AMOUNTS (AEROSOLS) C PBINT : (KDLON,0:KFLEV) ; HALF-LEVEL PLANCK FUNCTION C PBSUIN : (KDLON) ; SURFACE PLANCK FUNCTION C PBSUR : (KDLON,nir) ; SURFACE SPECTRAL PLANCK FUNCTION C PBTOP : (KDLON,nir) ; T.O.A. SPECTRAL PLANCK FUNCTION C PDBSL : (KDLON,KFLEV*2) ; SUB-LAYER PLANCK FUNCTION GRADIENT C PEMIS : (KDLON) ; SURFACE EMISSIVITY C PTAVE : (KDLON,KFLEV) ; TEMPERATURE C ==== OUTPUTS === c tableau retire C PCNTRB : (KDLON,KFLEV+1,KFLEV+1); CLEAR-SKY ENERGY EXCHANGE MATRIX C PCTS : (KDLON,KFLEV) ; COOLING-TO-SPACE TERM C PHFG : (KDLON,KFLEV) ; HEATING-FROM-GROUND TERM C PEMD : (KDLON,KFLEV) ; CLEAR-SKY LAYER DOWNWARD EMISSIVITY C PEMU : (KDLON,KFLEV) ; CLEAR-SKY LAYER UPWARD EMISSIVITY C IF KMODE = 0, 1, 2 C PFLUC(KDLON,2,KFLEV) ; RADIATIVE FLUXES CLEAR-SKY: C 1 ==> UPWARD FLUX TOTAL C PCOLC(KDLON,KFLEV) ; LONG-WAVE TENDENCY CLEAR SKY C C IMPLICIT ARGUMENTS : NONE C -------------------- C C METHOD. C ------- C C 1. PERFORMS THE VERTICAL INTEGRATION DISTINGUISHING BETWEEN C CONTRIBUTIONS BY - THE NEARBY LAYERS C - THE DISTANT LAYERS C - THE BOUNDARY TERMS C 2. COMPUTES THE CLEAR-SKY DOWNWARD AND UPWARD EMISSIVITIES. C C EXTERNALS. C ---------- C C *LWVN*, *LWVD*, *LWVB* 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! 1) c! la bande a 15 micron (CO2) reste inchangee : les poussieres c! n'interviennent que comme un milieu gris non diffusif avec c! Q=Qext*(1-Omega) c! cette bande est decoupee en deux sous bandes (indices 1 et 2) c! pour lesquelles les parametres optiques des poussieres sont c! identiques c! 2) c! le reste est decoupe en 4 bandes : une bande qui recouvre toutes c! les longueurs d'onde inferieures a celles de la bande a 15 microns c! (indice 3) et trois bandes pour les grandes longueurs d'onde c! (indices 4,5 et 6). sue chacune de ces 4 bandes, les poussieres c! sont supposees diffusantes grises. 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* 0.1 ARGUMENTS C --------- C REAL pga(NDLO2*2*3,kflev+1),pgb(NDLO2*2*3,kflev+1) REAL pgab(NDLO2*2*3,2),pgbb(NDLO2*2*3,2) REAL PABCUCO2(NDLO2,NUACO2,3*KFLEV+1) REAL PABCUAER(NDLO2,NIR,3*KFLEV+1) REAL PBINT(NDLO2,KFLEV+1) S , PBSUR(NDLO2,nir), PBSUIN(NDLO2), PBTOP(NDLO2,nir) S , PDBSL(NDLO2,nir,KFLEV*2), PEMIS(NDLO2) S , PTAVE(NDLO2,KFLEV) C REAL PCOLC(NDLO2,KFLEV) S , PCTS(NDLO2,KFLEV), PEMD(NDLO2,KFLEV), PEMU(NDLO2,KFLEV) S , PFLUC(NDLO2,2,KFLEV+1), PHFG(NDLO2,KFLEV) C C------------------------------------------------------------------------- C C* 0.2 LOCAL ARRAYS C ------------ C INTEGER ITX(NDLON) C REAL ZADJD(NDLON,NFLEV+1), ZADJU(NDLON,NFLEV+1) S , ZDBDT(NDLON,nir,NFLEV) S , ZDISD(NDLON,NFLEV+1), ZDISU(NDLON,NFLEV+1) S , ZFD(NDLON), ZFDN(NDLON,NFLEV+1), ZFU(NDLON) S , ZFUP(NDLON,NFLEV+1),ZGLAYD(NDLON),ZGLAYU(NDLON) S , ZOMEGADD(NDLON,NFLEV*2),ZGDD(NDLON,NFLEV*2) S , ZTAUDD(NDLON,NFLEV*2) S , ZBHDD(NDLON,NFLEV*2+1),ZBSDD(NDLON) S , ZZBHDD(NDLON,NFLEV*2+1),ZZBSDD(NDLON) S , ZFAHDD(NDLON,NFLEV*2+1),ZFDHDD(NDLON,NFLEV*2+1) S , ZZFAHDD(NDLON,NFLEV*2+1),ZZFDHDD(NDLON,NFLEV*2+1) C COMMON/scratch/ZADJD, ZADJU S , ZDBDT S , ZDISD, ZDISU S , ZFD, ZFDN, ZFU S , ZFUP,ZGLAYD,ZGLAYU S , ZOMEGADD,ZGDD S , ZTAUDD S , ZBHDD,ZBSDD S , ZZBHDD,ZZBSDD S , ZFAHDD,ZFDHDD S , ZZFAHDD,ZZFDHDD 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 ZADJD(JL,JK) = 0. ZADJU(JL,JK) = 0. ZDISD(JL,JK) = 0. ZDISU(JL,JK) = 0. 111 CONTINUE 112 CONTINUE C DO 114 JK = 1 , KFLEV DO 113 JL = 1 , KDLON PCTS(JL,JK) = 0. PHFG(JL,JK) = 0. 113 CONTINUE 114 CONTINUE C C ------------------------------------------------------------------ C C* 2. VERTICAL INTEGRATION C -------------------- C C ------------------------------------------------------------------ C C C ================================================================== C* 2.0 contribution des bandes "hors co2" C ================================================================== C 200 CONTINUE C C ------------------------------------------------------------------ C C* 2.0.1 preparation des Planck a chaque hauteur C ---------------------------------- C c! c! le nombre de couche pour la diffusion sera le nombre de layer * 2 c! soit NDD=KFLEV*2, donc la taille du vecteur des Planck sera c! KFLEV*2 + 1. la taille des vecteurs omega / g / tau sera c! par contre KFLEV*2 (voir dans FLUSV.F). c! NDD=KFLEV*2 DO indd=1,ndd+1 do jl=1,kdlon ZFAHDD(jl,indd)=0. ZFDHDD(jl,indd)=0. ZBHDD(jl,indd)=0. enddo ENDDO do jl=1,kdlon ZBSDD(jl)=0. enddo c! c! boucle sur les 4 bandes hors CO2 c! DO 10001 iir=3,nir c! do jl=1,kdlon ZZBHDD(JL,1)=PBTOP(JL,iir)/rpi enddo DO J1=2,NDD+1 do jl=1,kdlon ZZBHDD(JL,J1)= & ZZBHDD(JL,J1-1)-PDBSL(JL,iir,NDD-J1+2)/rpi enddo ENDDO do jl=1,kdlon ZZBSDD(JL)=PBSUR(JL,iir)/rpi enddo C C ------------------------------------------------------------------ C C* 2.0.2 preparation des coefficients de diffusion C ----------------------------------------- C ZOM=omegaer(iir) ZG=gaer(iir) c! les omega, g, tau ... boucle de bas en haut DO J2=1,KFLEV-1 J2DD2=(KFLEV-J2+1)*2 J2DD1=J2DD2-1 J2BOT=3*J2-2 J2TOP=3*J2+1 do jl=1,kdlon ZTADD=(PABCUAER(JL,iir,J2BOT)-PABCUAER(JL,iir,J2TOP))*0.5 ZTAUDD(JL,J2DD1)=ZTADD ZTAUDD(JL,J2DD2)=ZTADD ZOMEGADD(JL,J2DD1)=ZOM ZOMEGADD(JL,J2DD2)=ZOM ZGDD(JL,J2DD1)=ZG ZGDD(JL,J2DD2)=ZG enddo ENDDO J2=KFLEV J2DD2=2 J2DD1=1 J2BOT=3*J2-2 do jl=1,kdlon ZTADD=PABCUAER(JL,iir,J2BOT)*0.5 ZTAUDD(JL,J2DD1)=ZTADD ZTAUDD(JL,J2DD2)=ZTADD ZOMEGADD(JL,J2DD1)=ZOM ZOMEGADD(JL,J2DD2)=ZOM ZGDD(JL,J2DD1)=ZG ZGDD(JL,J2DD2)=ZG enddo C C ------------------------------------------------------------------ C C* 2.0.3 calcul de la diffusion C ---------------------- C CALL flusv(KDLON,0 & ,NDD,ZOMEGADD,ZGDD,ZTAUDD,PEMIS & ,ZZBHDD,ZZBSDD & ,ZZFAHDD,ZZFDHDD) c! c! Cumul des flux sur le spectre hors bande du CO2 c! DO indd=1,ndd+1 do jl=1,kdlon ZFAHDD(jl,indd)=ZFAHDD(jl,indd)+ZZFAHDD(jl,indd) ZFDHDD(jl,indd)=ZFDHDD(jl,indd)+ZZFDHDD(jl,indd) ZBHDD(jl,indd)=ZBHDD(jl,indd)+ZZBHDD(jl,indd)*rpi enddo ENDDO do jl=1,kdlon ZBSDD(jl)=ZBSDD(jl)+ZZBSDD(jl)*rpi enddo c! 10001 CONTINUE c! C C ================================================================== C TRAITEMENT DE LA BANDE DE CO2 (Richard lui souhaite longue vie!) C ================================================================== C ------------------------------------------------------------------ C C* 2.1 CONTRIBUTION FROM ADJACENT LAYERS C --------------------------------- C CALL LWVN ( KDLON,KFLEV,KUAER,KTRAER S , pga,pgb, PABCUCO2,PABCUAER,PDBSL S , ZADJD,ZADJU,ZDBDT ) C C ------------------------------------------------------------------ C C* 2.2 CONTRIBUTION FROM DISTANT LAYERS C --------------------------------- C 220 CONTINUE C CALL LWVD ( KDLON,KFLEV,KUAER,KTRAER S , pga,pgb, PABCUCO2,PABCUAER,ZDBDT S , ZDISD,ZDISU ) C C ------------------------------------------------------------------ C C* 2.3 EXCHANGE WITH THE BOUNDARIES C ---------------------------- c! c! Les Plancks cumules hors CO2 sont passes a LWVB c! pour corriger les BINT, BSURI et autres ... c! C 230 CONTINUE C CALL LWVB ( KDLON,KFLEV,KUAER,KTRAER S , pgab,pgbb S , PABCUCO2,PABCUAER,ZADJD,ZADJU,PBINT,PBSUIN,PBSUR,PBTOP S , ZDISD,ZDISU,PEMIS S , ZBHDD,ZBSDD S , PCTS,PHFG,PFLUC ) C C ------------------------------------------------------------------ C C* 2.3.1 somme de tous les flux C ---------------------- c! c! les flux du CO2 sont dans PFLUC. on y ajoute les resulats du c! calcul diffusif hors CO2. c! DO J2=1,KFLEV+1 J2DD=(KFLEV-J2+1)*2+1 do jl=1,kdlon PFLUC(JL,1,J2)=PFLUC(JL,1,J2)+ZFAHDD(JL,J2DD) PFLUC(JL,2,J2)=PFLUC(JL,2,J2)-ZFDHDD(JL,J2DD) enddo ENDDO C C ------------------------------------------------------------------ C C* 2.4 CLEAR-SKY FLUXES C ---------------- C 240 CONTINUE C c IF (NIMP.LT.4) THEN c WRITE(NOUT,884) (PFLUC(NIMPRAD,1,JK),JK = 1 , KFLEV+1) c WRITE(NOUT,884) (PFLUC(NIMPRAD,2,JK),JK = 1 , KFLEV+1) c END IF C C ------------------------------------------------------------------ C C* 3. EFFECTIVE DOWNWARD AND UPWARD CLEAR-SKY EMISSIVITIES C ---------------------------------------------------- C 300 CONTINUE C DO 302 JKL = 1 , KFLEV JK = KFLEV+1 - JKL DO 301 JL = 1 , KDLON ZDFNET = PFLUC(JL,1,JK+1) + PFLUC(JL,2,JK+1) S -PFLUC(JL,1,JK ) - PFLUC(JL,2,JK ) PCOLC(JL,JK) = ZDFNET PEMD(JL,JK)= (-PFLUC(JL,2,JK)+PFLUC(JL,2,JK+1)) S /(RSIGMA*PTAVE(JL,JK)**4.+PFLUC(JL,2,JK+1)) PEMU(JL,JKL)=(PFLUC(JL,1,JKL+1)-PFLUC(JL,1,JKL)) S /(RSIGMA*PTAVE(JL,JKL)**4.-PFLUC(JL,1,JKL)) 301 CONTINUE 302 CONTINUE C 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