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 SUPHEC_M
      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
      DOUBLE PRECISION PABCU(KDLON,NUA,3*KFLEV+1) ! EFFECTIVE ABSORBER AMOUNTS
      DOUBLE PRECISION PB(KDLON,Ninter,KFLEV+1) ! SPECTRAL HALF-LEVEL PLANCK FUNCTIONS
      DOUBLE PRECISION PBINT(KDLON,KFLEV+1) ! HALF-LEVEL PLANCK FUNCTIONS
      DOUBLE PRECISION PBSUR(KDLON,Ninter) ! SURFACE SPECTRAL PLANCK FUNCTION
      DOUBLE PRECISION PBSUIN(KDLON) ! SURFACE PLANCK FUNCTION
      DOUBLE PRECISION PBTOP(KDLON,Ninter) ! T.O.A. SPECTRAL PLANCK FUNCTION
      DOUBLE PRECISION PDBSL(KDLON,Ninter,KFLEV*2) ! SUB-LAYER PLANCK FUNCTION GRADIENT
      DOUBLE PRECISION PEMIS(KDLON) ! SURFACE EMISSIVITY
      DOUBLE PRECISION PPMB(KDLON,KFLEV+1) ! HALF-LEVEL PRESSURE (MB)
      DOUBLE PRECISION PTAVE(KDLON,KFLEV) ! TEMPERATURE
      DOUBLE PRECISION PGA(KDLON,8,2,KFLEV) ! PADE APPROXIMANTS
      DOUBLE PRECISION PGB(KDLON,8,2,KFLEV) ! PADE APPROXIMANTS
      DOUBLE PRECISION PGASUR(KDLON,8,2) ! PADE APPROXIMANTS
      DOUBLE PRECISION PGBSUR(KDLON,8,2) ! PADE APPROXIMANTS
      DOUBLE PRECISION PGATOP(KDLON,8,2) ! PADE APPROXIMANTS
      DOUBLE PRECISION PGBTOP(KDLON,8,2) ! PADE APPROXIMANTS
C
      DOUBLE PRECISION PCNTRB(KDLON,KFLEV+1,KFLEV+1) ! CLEAR-SKY ENERGY EXCHANGE MATRIX
      DOUBLE PRECISION PCTS(KDLON,KFLEV) ! COOLING-TO-SPACE TERM
      DOUBLE PRECISION PFLUC(KDLON,2,KFLEV+1) ! CLEAR-SKY RADIATIVE FLUXES
C-----------------------------------------------------------------------
C LOCAL VARIABLES:
      DOUBLE PRECISION ZADJD(KDLON,KFLEV+1)
      DOUBLE PRECISION ZADJU(KDLON,KFLEV+1)
      DOUBLE PRECISION ZDBDT(KDLON,Ninter,KFLEV)
      DOUBLE PRECISION ZDISD(KDLON,KFLEV+1)
      DOUBLE PRECISION 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	guez	38	use SUPHEC_M
8	guez	24	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	guez	71	DOUBLE PRECISION PABCU(KDLON,NUA,3*KFLEV+1) ! EFFECTIVE ABSORBER AMOUNTS
46			DOUBLE PRECISION PB(KDLON,Ninter,KFLEV+1) ! SPECTRAL HALF-LEVEL PLANCK FUNCTIONS
47			DOUBLE PRECISION PBINT(KDLON,KFLEV+1) ! HALF-LEVEL PLANCK FUNCTIONS
48			DOUBLE PRECISION PBSUR(KDLON,Ninter) ! SURFACE SPECTRAL PLANCK FUNCTION
49			DOUBLE PRECISION PBSUIN(KDLON) ! SURFACE PLANCK FUNCTION
50			DOUBLE PRECISION PBTOP(KDLON,Ninter) ! T.O.A. SPECTRAL PLANCK FUNCTION
51			DOUBLE PRECISION PDBSL(KDLON,Ninter,KFLEV*2) ! SUB-LAYER PLANCK FUNCTION GRADIENT
52			DOUBLE PRECISION PEMIS(KDLON) ! SURFACE EMISSIVITY
53			DOUBLE PRECISION PPMB(KDLON,KFLEV+1) ! HALF-LEVEL PRESSURE (MB)
54			DOUBLE PRECISION PTAVE(KDLON,KFLEV) ! TEMPERATURE
55			DOUBLE PRECISION PGA(KDLON,8,2,KFLEV) ! PADE APPROXIMANTS
56			DOUBLE PRECISION PGB(KDLON,8,2,KFLEV) ! PADE APPROXIMANTS
57			DOUBLE PRECISION PGASUR(KDLON,8,2) ! PADE APPROXIMANTS
58			DOUBLE PRECISION PGBSUR(KDLON,8,2) ! PADE APPROXIMANTS
59			DOUBLE PRECISION PGATOP(KDLON,8,2) ! PADE APPROXIMANTS
60			DOUBLE PRECISION PGBTOP(KDLON,8,2) ! PADE APPROXIMANTS
61	guez	24	C
62	guez	71	DOUBLE PRECISION PCNTRB(KDLON,KFLEV+1,KFLEV+1) ! CLEAR-SKY ENERGY EXCHANGE MATRIX
63			DOUBLE PRECISION PCTS(KDLON,KFLEV) ! COOLING-TO-SPACE TERM
64			DOUBLE PRECISION PFLUC(KDLON,2,KFLEV+1) ! CLEAR-SKY RADIATIVE FLUXES
65	guez	24	C-----------------------------------------------------------------------
66			C LOCAL VARIABLES:
67	guez	71	DOUBLE PRECISION ZADJD(KDLON,KFLEV+1)
68			DOUBLE PRECISION ZADJU(KDLON,KFLEV+1)
69			DOUBLE PRECISION ZDBDT(KDLON,Ninter,KFLEV)
70			DOUBLE PRECISION ZDISD(KDLON,KFLEV+1)
71			DOUBLE PRECISION ZDISU(KDLON,KFLEV+1)
72	guez	24	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