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	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 SUPHEC_M
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	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	C
62	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	C-----------------------------------------------------------------------
66	C LOCAL VARIABLES:
67	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	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