*=*=*=*= LWB.html =*=*=*=*
SUBROUTINE LWB ( KDLON,KFLEV,KMODE,KFLUX,KRAD S , PDT0,PTAVE,PTL S , PBINT,PBSUIN,PBSUR,PBTOP,PDBSL S , pga,pgb,pgab,pgbb ) IMPLICIT LOGICAL (L) C #include "dimensions.h" #include "dimphys.h" #include "dimradmars.h" C C**** *LWB* - COMPUTES BLACK-BODY FUNCTIONS FOR LONGWAVE CALCULATIONS C C PURPOSE. C -------- C COMPUTES PLANCK FUNCTIONS C C** INTERFACE. C ---------- C SUBROUTINE LWB ( KDLON,KFLEV,KAER,KMODE,KFLUX,KRAD C S , PDT0,PTAVE,PTL C S , PBINT,PBSUIN,PBSUR,PBTOP,PDBSL ) C C EXPLICIT ARGUMENTS : C -------------------- C ==== INPUTS === C PDT0 : (KDLON) ; SURFACE TEMPERATURE DISCONTINUITY C PTAVE : (KDLON,KFLEV) ; TEMPERATURE C PTL : (KDLON,0:KFLEV) ; HALF LEVEL TEMPERATURE C ==== OUTPUTS === 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) ; TOP SPECTRAL PLANCK FUNCTION C PDBSL : (KDLON,nir,KFLEV*2); SUB-LAYER PLANCK FUNCTION GRADIENT C C IMPLICIT ARGUMENTS : NONE C -------------------- C C METHOD. C ------- C C 1. COMPUTES THE PLANCK FUNCTION ON ALL LEVELS AND HALF LEVELS C FROM A POLYNOMIAL DEVELOPMENT OF PLANCK FUNCTION c 2. Reindexs the Pade approximants 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 #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 PDT0(NDLO2),PTAVE(NDLO2,KFLEV),PTL(NDLO2,KFLEV+1) REAL PBINT(NDLO2,KFLEV+1), PBSUIN(NDLO2), PBSUR(NDLO2,nir), S PBTOP(NDLO2,nir), PDBSL(NDLO2,nir,KFLEV*2) REAL pga(NDLO2,3,2,kflev+1),pgb(NDLO2,3,2,kflev+1) REAL pgab(NDLO2,3,2,2),pgbb(NDLO2,3,2,2) C------------------------------------------------------------------------- C C* 0.2 LOCAL ARRAYS C ------------ REAL ZBLAY(NDLON,NFLEV),ZBLEV(NDLON,NFLEV+1) REAL ZRES(NDLON),ZRES2(NDLON),ZTI(NDLON),ZTI2(NDLON) INTEGER indt(ndlon) c common/scratch/ZBLAY,ZBLEV C C ------------------------------------------------------------------ C C C* 1.0 PLANCK FUNCTIONS AND GRADIENTS C ------------------------------ C 100 CONTINUE C DO 102 JK = 1 , KFLEV+1 DO 101 JL = 1 , KDLON PBINT(JL,JK) = 0. 101 CONTINUE 102 CONTINUE DO 103 JL = 1 , KDLON PBSUIN(JL) = 0. 103 CONTINUE C DO 141 JNU=1,nir C C C* 1.1 LEVELS FROM SURFACE TO KFLEV C ---------------------------- C 110 CONTINUE C DO 112 JK = 1 , KFLEV DO 111 JL = 1 , KDLON ZTI(JL)=(PTL(JL,JK)-TSTAND)/TSTAND ZRES(JL) = XP(1,JNU)+ZTI(JL)*(XP(2,JNU)+ZTI(JL)*(XP(3,JNU) S +ZTI(JL)*(XP(4,JNU)+ZTI(JL)*(XP(5,JNU)+ZTI(JL)*(XP(6,JNU) S ))))) PBINT(JL,JK)=PBINT(JL,JK)+ZRES(JL) ZBLEV(JL,JK) = ZRES(JL) ZTI2(JL)=(PTAVE(JL,JK)-TSTAND)/TSTAND ZRES2(JL)=XP(1,JNU)+ZTI2(JL)*(XP(2,JNU)+ZTI2(JL)*(XP(3,JNU) S +ZTI2(JL)*(XP(4,JNU)+ZTI2(JL)*(XP(5,JNU)+ZTI2(JL)*(XP(6,JNU) S ))))) ZBLAY(JL,JK) = ZRES2(JL) 111 CONTINUE 112 CONTINUE C C C* 1.2 TOP OF THE ATMOSPHERE AND SURFACE C --------------------------------- C 120 CONTINUE C DO 121 JL = 1 , KDLON ZTI(JL)=(PTL(JL,KFLEV+1)-TSTAND)/TSTAND ZTI2(JL) = (PTL(JL,1) + PDT0(JL) - TSTAND) / TSTAND ZRES(JL) = XP(1,JNU)+ZTI(JL)*(XP(2,JNU)+ZTI(JL)*(XP(3,JNU) S +ZTI(JL)*(XP(4,JNU)+ZTI(JL)*(XP(5,JNU)+ZTI(JL)*(XP(6,JNU) S ))))) ZRES2(JL) = XP(1,JNU)+ZTI2(JL)*(XP(2,JNU)+ZTI2(JL)*(XP(3,JNU) S +ZTI2(JL)*(XP(4,JNU)+ZTI2(JL)*(XP(5,JNU)+ZTI2(JL)*(XP(6,JNU) S ))))) PBINT(JL,KFLEV+1) = PBINT(JL,KFLEV+1)+ZRES(JL) ZBLEV(JL,KFLEV+1) = ZRES(JL) PBTOP(JL,JNU) = ZRES(JL) PBSUR(JL,JNU) = ZRES2(JL) PBSUIN(JL) = PBSUIN(JL) + ZRES2(JL) 121 CONTINUE C C C* 1.3 GRADIENTS IN SUB-LAYERS C ----------------------- C 130 CONTINUE C DO 132 JK = 1 , KFLEV JK2 = 2 * JK JK1 = JK2 - 1 DO 131 JL = 1 , KDLON PDBSL(JL,JNU,JK1) = ZBLAY(JL,JK ) - ZBLEV(JL,JK) PDBSL(JL,JNU,JK2) = ZBLEV(JL,JK+1) - ZBLAY(JL,JK) 131 CONTINUE 132 CONTINUE C 141 CONTINUE C C----------------------------------------------------------------------- C* 3. PRESSURE-WEIGHTED TEMPERATURE AND TRANSMISSIVITY INDEX C ------------------------------------------------------ C 300 CONTINUE C c atmosphere: c ----------- jplk=2 DO jk=1,kflev+1 DO jl=1,kdlon indt(jl)=INT((ptl(jl,jk)-tmin_pade)/dt_pade+2.) ENDDO DO jl=1,kdlon indt(jl)=MAX0(MIN0(indt(jl),nt_pade),1) ENDDO DO ja=1,2 DO jl=1,kdlon DO jpad=1,3 pga(jl,jpad,ja,jk)=ga(jpad,ja,jplk,indt(jl)) pgb(jl,jpad,ja,jk)=gb(jpad,ja,jplk,indt(jl)) ENDDO ENDDO ENDDO ENDDO c surface: c -------- jplk=1 DO jl=1,kdlon indt(jl)=INT((ptl(jl,1)-tmin_pade)/dt_pade+2.) ENDDO DO jl=1,kdlon indt(jl)=MAX0(MIN0(indt(jl),nt_pade),1) ENDDO DO ja=1,2 DO jl=1,kdlon DO jpad=1,3 pgab(jl,jpad,ja,1)=ga(jpad,ja,jplk,indt(jl)) pgbb(jl,jpad,ja,1)=gb(jpad,ja,jplk,indt(jl)) ENDDO ENDDO ENDDO C c top of atmosphere: c ------------------ jplk=1 DO jl=1,kdlon indt(jl)=INT((ptl(jl,kflev+1)-tmin_pade)/dt_pade+2.) ENDDO DO jl=1,kdlon indt(jl)=MAX0(MIN0(indt(jl),nt_pade),1) ENDDO DO ja=1,2 DO jl=1,kdlon DO jpad=1,3 pgab(jl,jpad,ja,2)=ga(jpad,ja,jplk,indt(jl)) pgbb(jl,jpad,ja,2)=gb(jpad,ja,jplk,indt(jl)) ENDDO ENDDO ENDDO C ------------------------------------------------------------------ C RETURN END