phylmd/Radlwsw/lwv.f

      SUBROUTINE LWV(KUAER,KTRAER, KLIM
     R  , PABCU,PB,PBINT,PBSUIN,PBSUR,PBTOP,PDBSL,PEMIS,PPMB,PTAVE
     R  , PGA,PGB,PGASUR,PGBSUR,PGATOP,PGBTOP
     S  , PCNTRB,PCTS,PFLUC)
      use dimens_m
      use dimphy
      use YOMCST
      use raddim
            use raddimlw
      IMPLICIT none
C
C-----------------------------------------------------------------------
C     PURPOSE.
C     --------
C           CARRIES OUT THE VERTICAL INTEGRATION TO GIVE LONGWAVE
C           FLUXES OR RADIANCES
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     REFERENCE.
C     ----------
C
C        SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
C        ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
C
C     AUTHOR.
C     -------
C        JEAN-JACQUES MORCRETTE  *ECMWF*
C
C     MODIFICATIONS.
C     --------------
C        ORIGINAL : 89-07-14
C-----------------------------------------------------------------------
C
C* ARGUMENTS:
      INTEGER KUAER,KTRAER, KLIM
C
      REAL*8 PABCU(KDLON,NUA,3*KFLEV+1) ! EFFECTIVE ABSORBER AMOUNTS
      REAL*8 PB(KDLON,Ninter,KFLEV+1) ! SPECTRAL HALF-LEVEL PLANCK FUNCTIONS
      REAL*8 PBINT(KDLON,KFLEV+1) ! HALF-LEVEL PLANCK FUNCTIONS
      REAL*8 PBSUR(KDLON,Ninter) ! SURFACE SPECTRAL PLANCK FUNCTION
      REAL*8 PBSUIN(KDLON) ! SURFACE PLANCK FUNCTION
      REAL*8 PBTOP(KDLON,Ninter) ! T.O.A. SPECTRAL PLANCK FUNCTION
      REAL*8 PDBSL(KDLON,Ninter,KFLEV*2) ! SUB-LAYER PLANCK FUNCTION GRADIENT
      REAL*8 PEMIS(KDLON) ! SURFACE EMISSIVITY
      REAL*8 PPMB(KDLON,KFLEV+1) ! HALF-LEVEL PRESSURE (MB)
      REAL*8 PTAVE(KDLON,KFLEV) ! TEMPERATURE
      REAL*8 PGA(KDLON,8,2,KFLEV) ! PADE APPROXIMANTS
      REAL*8 PGB(KDLON,8,2,KFLEV) ! PADE APPROXIMANTS
      REAL*8 PGASUR(KDLON,8,2) ! PADE APPROXIMANTS
      REAL*8 PGBSUR(KDLON,8,2) ! PADE APPROXIMANTS
      REAL*8 PGATOP(KDLON,8,2) ! PADE APPROXIMANTS
      REAL*8 PGBTOP(KDLON,8,2) ! PADE APPROXIMANTS
C
      REAL*8 PCNTRB(KDLON,KFLEV+1,KFLEV+1) ! CLEAR-SKY ENERGY EXCHANGE MATRIX
      REAL*8 PCTS(KDLON,KFLEV) ! COOLING-TO-SPACE TERM
      REAL*8 PFLUC(KDLON,2,KFLEV+1) ! CLEAR-SKY RADIATIVE FLUXES
C-----------------------------------------------------------------------
C LOCAL VARIABLES:
      REAL*8 ZADJD(KDLON,KFLEV+1)
      REAL*8 ZADJU(KDLON,KFLEV+1)
      REAL*8 ZDBDT(KDLON,Ninter,KFLEV)
      REAL*8 ZDISD(KDLON,KFLEV+1)
      REAL*8 ZDISU(KDLON,KFLEV+1)
C
      INTEGER jk, jl
C-----------------------------------------------------------------------
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.
 113  CONTINUE
 114  CONTINUE
C
C* CONTRIBUTION FROM ADJACENT LAYERS
C
      CALL LWVN(KUAER,KTRAER
     R  , PABCU,PDBSL,PGA,PGB
     S  , ZADJD,ZADJU,PCNTRB,ZDBDT)
C* CONTRIBUTION FROM DISTANT LAYERS
C
      CALL LWVD(KUAER,KTRAER
     R  , PABCU,ZDBDT,PGA,PGB
     S  , PCNTRB,ZDISD,ZDISU)
C
C* EXCHANGE WITH THE BOUNDARIES
C
      CALL LWVB(KUAER,KTRAER, KLIM
     R  , PABCU,ZADJD,ZADJU,PB,PBINT,PBSUIN,PBSUR,PBTOP
     R  , ZDISD,ZDISU,PEMIS,PPMB
     R  , PGA,PGB,PGASUR,PGBSUR,PGATOP,PGBTOP
     S  , PCTS,PFLUC)
C
C
      RETURN
      END
1	guez	24	SUBROUTINE LWV(KUAER,KTRAER, KLIM
2			R , PABCU,PB,PBINT,PBSUIN,PBSUR,PBTOP,PDBSL,PEMIS,PPMB,PTAVE
3			R , PGA,PGB,PGASUR,PGBSUR,PGATOP,PGBTOP
4			S , PCNTRB,PCTS,PFLUC)
5			use dimens_m
6			use dimphy
7			use YOMCST
8			use raddim
9			use raddimlw
10			IMPLICIT none
11			C
12			C-----------------------------------------------------------------------
13			C PURPOSE.
14			C --------
15			C CARRIES OUT THE VERTICAL INTEGRATION TO GIVE LONGWAVE
16			C FLUXES OR RADIANCES
17			C
18			C METHOD.
19			C -------
20			C
21			C 1. PERFORMS THE VERTICAL INTEGRATION DISTINGUISHING BETWEEN
22			C CONTRIBUTIONS BY - THE NEARBY LAYERS
23			C - THE DISTANT LAYERS
24			C - THE BOUNDARY TERMS
25			C 2. COMPUTES THE CLEAR-SKY DOWNWARD AND UPWARD EMISSIVITIES.
26			C
27			C REFERENCE.
28			C ----------
29			C
30			C SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
31			C ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
32			C
33			C AUTHOR.
34			C -------
35			C JEAN-JACQUES MORCRETTE ECMWF
36			C
37			C MODIFICATIONS.
38			C --------------
39			C ORIGINAL : 89-07-14
40			C-----------------------------------------------------------------------
41			C
42			C* ARGUMENTS:
43			INTEGER KUAER,KTRAER, KLIM
44			C
45			REAL8 PABCU(KDLON,NUA,3KFLEV+1) ! EFFECTIVE ABSORBER AMOUNTS
46			REAL*8 PB(KDLON,Ninter,KFLEV+1) ! SPECTRAL HALF-LEVEL PLANCK FUNCTIONS
47			REAL*8 PBINT(KDLON,KFLEV+1) ! HALF-LEVEL PLANCK FUNCTIONS
48			REAL*8 PBSUR(KDLON,Ninter) ! SURFACE SPECTRAL PLANCK FUNCTION
49			REAL*8 PBSUIN(KDLON) ! SURFACE PLANCK FUNCTION
50			REAL*8 PBTOP(KDLON,Ninter) ! T.O.A. SPECTRAL PLANCK FUNCTION
51			REAL8 PDBSL(KDLON,Ninter,KFLEV2) ! SUB-LAYER PLANCK FUNCTION GRADIENT
52			REAL*8 PEMIS(KDLON) ! SURFACE EMISSIVITY
53			REAL*8 PPMB(KDLON,KFLEV+1) ! HALF-LEVEL PRESSURE (MB)
54			REAL*8 PTAVE(KDLON,KFLEV) ! TEMPERATURE
55			REAL*8 PGA(KDLON,8,2,KFLEV) ! PADE APPROXIMANTS
56			REAL*8 PGB(KDLON,8,2,KFLEV) ! PADE APPROXIMANTS
57			REAL*8 PGASUR(KDLON,8,2) ! PADE APPROXIMANTS
58			REAL*8 PGBSUR(KDLON,8,2) ! PADE APPROXIMANTS
59			REAL*8 PGATOP(KDLON,8,2) ! PADE APPROXIMANTS
60			REAL*8 PGBTOP(KDLON,8,2) ! PADE APPROXIMANTS
61			C
62			REAL*8 PCNTRB(KDLON,KFLEV+1,KFLEV+1) ! CLEAR-SKY ENERGY EXCHANGE MATRIX
63			REAL*8 PCTS(KDLON,KFLEV) ! COOLING-TO-SPACE TERM
64			REAL*8 PFLUC(KDLON,2,KFLEV+1) ! CLEAR-SKY RADIATIVE FLUXES
65			C-----------------------------------------------------------------------
66			C LOCAL VARIABLES:
67			REAL*8 ZADJD(KDLON,KFLEV+1)
68			REAL*8 ZADJU(KDLON,KFLEV+1)
69			REAL*8 ZDBDT(KDLON,Ninter,KFLEV)
70			REAL*8 ZDISD(KDLON,KFLEV+1)
71			REAL*8 ZDISU(KDLON,KFLEV+1)
72			C
73			INTEGER jk, jl
74			C-----------------------------------------------------------------------
75			C
76			DO 112 JK=1,KFLEV+1
77			DO 111 JL=1, KDLON
78			ZADJD(JL,JK)=0.
79			ZADJU(JL,JK)=0.
80			ZDISD(JL,JK)=0.
81			ZDISU(JL,JK)=0.
82			111 CONTINUE
83			112 CONTINUE
84			C
85			DO 114 JK=1,KFLEV
86			DO 113 JL=1, KDLON
87			PCTS(JL,JK)=0.
88			113 CONTINUE
89			114 CONTINUE
90			C
91			C* CONTRIBUTION FROM ADJACENT LAYERS
92			C
93			CALL LWVN(KUAER,KTRAER
94			R , PABCU,PDBSL,PGA,PGB
95			S , ZADJD,ZADJU,PCNTRB,ZDBDT)
96			C* CONTRIBUTION FROM DISTANT LAYERS
97			C
98			CALL LWVD(KUAER,KTRAER
99			R , PABCU,ZDBDT,PGA,PGB
100			S , PCNTRB,ZDISD,ZDISU)
101			C
102			C* EXCHANGE WITH THE BOUNDARIES
103			C
104			CALL LWVB(KUAER,KTRAER, KLIM
105			R , PABCU,ZADJD,ZADJU,PB,PBINT,PBSUIN,PBSUR,PBTOP
106			R , ZDISD,ZDISU,PEMIS,PPMB
107			R , PGA,PGB,PGASUR,PGBSUR,PGATOP,PGBTOP
108			S , PCTS,PFLUC)
109			C
110			C
111			RETURN
112			END