*=*=*=*= LWMAIN.html =*=*=*=*
SUBROUTINE LWMAIN( KDLON,KFLEV,KAER,KMODE,KFLUX,KRAD S , PCCO2,PCLDLW,PDP,PDT0,PEMIS,PPMB,PPSOL,PQOF,PTL S , PAER,PTAVE,PVIEW,PWV S , PEMD,PEMU,PCOLR,PCOLC,PFLUX,PFLUC,PRAD,PRADC ) IMPLICIT LOGICAL (L) C #include "dimensions.h" #include "dimphys.h" #include "dimradmars.h" C C**** *LW* - ORGANIZES THE LONGWAVE CALCULATIONS C C PURPOSE. C -------- C DEPENDING ON KMODE, COMPUTES LONGWAVE FLUXES AND/OR C RADIANCES C C** INTERFACE. C ---------- C SUBROUTINE LWMAIN ( KDLON,KFLEV,KAER,KMODE,KFLUX,KRAD C S , PCCO2,PCLDLW,PDP,PDT0,PEMIS,PPMB,PPSOL,PQOF,PTL C S , PAER,PTAVE,PVIEW,PWV C S , PEMD,PEMU,PCOLR,PCOLC,PFLUX,PFLUC,PRAD,PRADC ) C C EXPLICIT ARGUMENTS : C -------------------- C PEMIS : (KDLON) ; SURFACE EMISSIVITY C PCCO2 : ; CONCENTRATION IN CO2 (PA/PA) C PQOF : (KDLON,KFLEV) ; CONCENTRATION IN OZONE (PA/PA) C PTAVE : (KDLON,KFLEV) ; TEMPERATURE C PTL : (KDLON,0:KFLEV) ; HALF LEVEL TEMPERATURE C PPMB : (KDLON,0:KFLEV) ; HALF LEVEL PRESSURE C PWV : (KDLSUR,KFLEV) ; SPECIFIC HUMIDITY PA/PA C PCLDLW : (KDLON,KFLEV) ; CLOUD FRACTIONAL COVER C PAER : (KDLON,KFLEV,5) ; OPTICAL THICKNESS OF THE AEROSOLS C PVIEW : (KDLON) ; COSECANT OF VIEWING ANGLE C ==== OUTPUTS === C IF KMODE = 0, 1, 2 C PFLUX(KDLON,2,KFLEV) ; RADIATIVE FLUXES : C 1 ==> UPWARD FLUX TOTAL C 2 ==> DOWNWARD FLUX TOTAL C PFLUC(KDLON,2,KFLEV) ; RADIATIVE FLUXES CLEAR SKY: C 1 ==> UPWARD FLUX TOTAL C 2 ==> DOWNWARD FLUX TOTAL C PCOLR(KDLON,KFLEV) ; LONG-WAVE TENDENCY C PCOLC(KDLON,KFLEV) ; LONG-WAVE TENDENCY CLEAR SKY C IF KMODE = 2, 3 C PRAD (KDLON,KRAD) ; RADIANCES C PRADC(KDLON,KRAD) ; CLEAR SKY RADIANCES C C IMPLICIT ARGUMENTS : NONE C -------------------- C C METHOD. C ------- C C 1. COMPUTES THE PRESSURE AND TEMPERATURE WEIGHTED AMOUNTS OF C ABSORBERS. C 2. COMPUTES THE PLANCK FUNCTIONS ON THE INTERFACES AND THE C GRADIENT OF PLANCK FUNCTIONS IN THE LAYERS. C 3. PERFORMS THE VERTICAL INTEGRATION DISTINGUISHING THE CON- C TRIBUTIONS OF THE ADJACENT AND DISTANT LAYERS AND THOSE FROM THE C BOUNDARIES. C 4. COMPUTES THE CLEAR-SKY DOWNWARD AND UPWARD EMISSIVITIES. C 5. INTRODUCES THE EFFECTS OF THE CLOUDS ON THE FLUXES. C C EXTERNALS. C ---------- C C *LWU*, *LWB*, *LWV*, *LWC* 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 #include "yomcst.h" #include "yomrad.h" #include "yomrdu.h" #include "yomaer.h" #include "yomsw.h" #include "yomlw.h" C C----------------------------------------------------------------------- C C* 0.1 ARGUMENTS C --------- C REAL PCLDLW(NDLO2,KFLEV), PDP(NDLO2,KFLEV), PDT0(NDLO2) S , PEMIS(NDLO2), PPMB(NDLO2,KFLEV+1) S , PPSOL(NDLO2), PQOF(NDLO2,KFLEV), PTL(NDLO2,KFLEV+1) S , PAER(NDLO2,KFLEV,5), PTAVE(NDLO2,KFLEV), PVIEW(NDLO2) S , PWV(NDLO2,KFLEV) C REAL PEMD(NDLO2,KFLEV), PEMU(NDLO2,KFLEV), PCOLR(NDLO2,KFLEV) S , PCOLC(NDLO2,KFLEV), PFLUX(NDLO2,2,KFLEV+1) S , PFLUC(NDLO2,2,KFLEV+1), PRAD(NDLO2,KRAD),PRADC(NDLO2,KRAD) C C------------------------------------------------------------------------- C C* 0.2 LOCAL ARRAYS C ------------ C REAL zga(ndlon*2*3,nflev+1),zgb(ndlon*2*3,nflev+1) REAL zgab(ndlon*2*3,2),zgbb(ndlon*2*3,2) REAL ZABCUCO2(NDLON,NUACO2,3*NFLEV+1) REAL ZABCUAER(NDLON,nir,3*NFLEV+1) REAL ZBINT(NDLON,NFLEV+1) S , ZBSUR(NDLON,nir), ZBSUI(NDLON), ZBTOP(NDLON,nir) S , ZCTS(NDLON,NFLEV) c soulagement d'un gros tableau inutile c S , ZCNTRB(NDLON,NFLEV+1,NFLEV+1) S , ZDBSL(NDLON,nir,NFLEV*2), ZFDN(NDLON,NFLEV+1) S , ZFUP(NDLON,NFLEV+1), ZHFG(NDLON,NFLEV) C C ------------------------------------------------------------------ C C* 1. INITIALIZATION C -------------- C 100 CONTINUE C C ------------------------------------------------------------------ C C* 1.1 COMPUTES ABSORBER AMOUNTS C ------------------------- C 110 CONTINUE C CALL LWU ( KDLON,KFLEV,KAER,KMODE,KFLUX,KRAD S , PAER,PCCO2,PDP,PPMB,PPSOL,PQOF,PTAVE,PVIEW,PWV S , ZABCUCO2,ZABCUAER ) C C ------------------------------------------------------------------ C C* 2. COMPUTES PLANCK FUNCTIONS C ------------------------- C 200 CONTINUE C CALL LWB ( KDLON,KFLEV,KMODE,KFLUX,KRAD S , PDT0,PTAVE,PTL S , ZBINT,ZBSUI,ZBSUR,ZBTOP,ZDBSL S , zga,zgb,zgab,zgbb) C C ------------------------------------------------------------------ C C* 3. PERFORMS THE VERTICAL INTEGRATION C --------------------------------- C 300 CONTINUE C CALL LWV ( KDLON,KFLEV,KMODE,KFLUX,KRAD,NUAER,NTRAER s , zga,zgb,zgab,zgbb S , ZABCUCO2,ZABCUAER,ZBINT,ZBSUI,ZBSUR,ZBTOP,ZDBSL,PEMIS,PTAVE S , ZCTS,ZHFG,PEMD,PEMU,PCOLC,PFLUC ) C DO 302 JK = 1 , KFLEV+1 DO 301 JL = 1 , KDLON ZFDN(JL,JK) = PFLUC(JL,2,JK) ZFUP(JL,JK) = PFLUC(JL,1,JK) 301 CONTINUE 302 CONTINUE C DO 303 JL = 1 , KDLON PFLUC(JL,1,KFLEV+1) = PFLUC(JL,1,KFLEV)+ZCTS(JL,KFLEV) S - ZHFG(JL,KFLEV) S + PFLUC(JL,2,KFLEV) 303 CONTINUE C DO 306 JK = 1 , KFLEV DO 305 JL = 1 , KDLON ZDFNET = PFLUC(JL,1,JK ) + PFLUC(JL,2,JK ) S -PFLUC(JL,1,JK+1) - PFLUC(JL,2,JK+1) PCOLC(JL,JK) = CDAY * ZDFNET / PDP(JL,JK) 305 CONTINUE 306 CONTINUE C IF (NIMP.LT.4) THEN PRINT*,'NIMP = ',NIMP WRITE(NOUT,9300) WRITE(NOUT,9301) (PFLUC(JLIMPRAD,1,JK),JK = 1 , KFLEV+1) WRITE(NOUT,9301) (PFLUC(JLIMPRAD,2,JK),JK = 1 , KFLEV+1) WRITE(NOUT,9302) (PCOLC(JLIMPRAD,JK),JK = 1 , KFLEV) END IF C C ------------------------------------------------------------------ C C* 4. INTRODUCES THE EFFECTS OF CLOUDS C -------------------------------- C 400 CONTINUE C c a partir de la c'est les nuages et on enleve tout c CALL LWC ( KDLON,KFLEV c S , ZBINT,ZBSUI,PCLDLW,ZCTS,PEMIS,ZFDN,ZFUP,ZHFG c S , PFLUX ) c c DO 402 JK = 1 , KFLEV c DO 401 JL = 1 , KDLON c ZDFNET = PFLUX(JL,1,JK ) + PFLUX(JL,2,JK ) c S -PFLUX(JL,1,JK+1) - PFLUX(JL,2,JK+1) c PCOLR(JL,JK) = CDAY * ZDFNET / PDP(JL,JK) c401 CONTINUE c402 CONTINUE c c ------------------------------------------------------------------ c c* 5. FILLS UP DIAGNOSTIC ARRAYS c -------------------------- c c500 CONTINUE c c c IF (NIMP.LT.4) THEN c WRITE(NOUT,9500) c WRITE(NOUT,9501) (PFLUX(JLIMPRAD,1,JK),JK = 1 , KFLEV+1) c WRITE(NOUT,9501) (PFLUX(JLIMPRAD,2,JK),JK = 1 , KFLEV+1) c WRITE(NOUT,9502) (PCOLR(JLIMPRAD,JK),JK = 1 , KFLEV) c END IF c c ------------------------------------------------------------------ C RETURN C C----------------------------------------------------------------------- C FORMATS C ------- C 9300 FORMAT (1X,'LW-CLEAR FLUXES') 9301 FORMAT (1X,'LW-C',F7.2,18F6.1,F7.2) 9302 FORMAT (1X,'LW-C',3X,19F6.3) 9500 FORMAT (1X,'LW-TOTAL FLUXES') 9501 FORMAT (1X,'LW-T',F7.2,18F6.1,F7.2) 9502 FORMAT (1X,'LW-T',3X,19F6.3) C END