source: LMDZ5/branches/IPSLCM5A2.1/libf/phylmd/rrtm/lwv.F90

Last change on this file was 1990, checked in by Laurent Fairhead, 11 years ago

Corrections à la version r1989 pour permettre la compilation avec RRTM
Inclusion de la licence CeCILL_V2 pour RRTM

Changes to revision r1989 to enable RRTM code compilation
RRTM part put under CeCILL_V2 licence
  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
File size: 5.8 KB
Line 
1SUBROUTINE LWV &
2 & ( KIDIA, KFDIA, KLON , KLEV , KUAER , KTRAER,&
3 & PABCU, PB   , PBINT, PBSUR, PBTOP , PDBSL,&
4 & PEMIS, PEMIW,&
5 & PGA  , PGB  , PGASUR,PGBSUR,PGATOP, PGBTOP,&
6 & PCNTRB,PFLUC &
7 & ) 
8
9!**** *LWV*   - LONGWAVE RADIATION, VERTICAL INTEGRATION
10
11!     PURPOSE.
12!     --------
13!           CARRIES OUT THE VERTICAL INTEGRATION TO GIVE LONGWAVE
14!           FLUXES OR RADIANCES
15
16!**   INTERFACE.
17!     ----------
18
19!        EXPLICIT ARGUMENTS :
20!        --------------------
21!     ==== INPUTS ===
22! PABCU : (KLON,NUA,3*KLEV+1); ABSORBER AMOUNTS
23! PB     : (KLON,NSIL,KLEV+1); SPECTRAL HALF-LEVEL PLANCK FUNCTIONS
24! PBINT  : (KLON,KLEV+1)     ; HALF-LEVEL PLANCK FUNCTIONS
25! PBSUR  : (KLON,NSIL)       ; SURFACE SPECTRAL PLANCK FUNCTION
26! PBTOP  : (KLON,NSIL)       ; T.O.A. SPECTRAL PLANCK FUNCTION
27! PDBSL  : (KLON,KLEV*2)     ; SUB-LAYER PLANCK FUNCTION GRADIENT
28! PEMIS  : (KLON)            ; SURFACE LW EMISSIVITY
29! PEMIW  : (KLON)            ; SURFACE LW WINDOW EMISSIVITY
30! PGA, PGB                   ; PADE APPROXIMANTS
31! PGASUR, PGBSUR             ; SURFACE PADE APPROXIMANTS
32! PGATOP, PGBTOP             ; T.O.A. PADE APPROXIMANTS
33!     ==== OUTPUTS ===
34! PCNTRB : (KLON,KLEV+1,KLEV+1); CLEAR-SKY ENERGY EXCHANGE MATRIX
35! PFLUC(KLON,2,KLEV)           ; RADIATIVE FLUXES CLEAR-SKY
36
37!        IMPLICIT ARGUMENTS :   NONE
38!        --------------------
39
40!     METHOD.
41!     -------
42
43!          1. PERFORMS THE VERTICAL INTEGRATION DISTINGUISHING BETWEEN
44!     CONTRIBUTIONS BY -  THE NEARBY LAYERS
45!                      -  THE DISTANT LAYERS
46!                      -  THE BOUNDARY TERMS
47!          2. COMPUTES THE CLEAR-SKY DOWNWARD AND UPWARD EMISSIVITIES.
48
49!     EXTERNALS.
50!     ----------
51
52!          *LWVN*, *LWVD*, *LWVB*
53
54!     REFERENCE.
55!     ----------
56
57!        SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
58!        ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
59
60!     AUTHOR.
61!     -------
62!        JEAN-JACQUES MORCRETTE  *ECMWF*
63
64!     MODIFICATIONS.
65!     --------------
66!        ORIGINAL : 89-07-14
67!        JJ Morcrette 96-06-07 Surface LW window emissivity
68!        M.Hamrud      01-Oct-2003 CY28 Cleaning
69!-----------------------------------------------------------------------
70
71USE PARKIND1  ,ONLY : JPIM     ,JPRB
72USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
73
74USE YOELW    , ONLY : NSIL     ,NIPD     ,NUA
75
76IMPLICIT NONE
77
78INTEGER(KIND=JPIM),INTENT(IN)    :: KLON
79INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV
80INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA
81INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA
82INTEGER(KIND=JPIM),INTENT(IN)    :: KUAER
83INTEGER(KIND=JPIM),INTENT(IN)    :: KTRAER
84REAL(KIND=JPRB)   ,INTENT(IN)    :: PABCU(KLON,NUA,3*KLEV+1)
85REAL(KIND=JPRB)   ,INTENT(IN)    :: PB(KLON,NSIL,KLEV+1)
86REAL(KIND=JPRB)   ,INTENT(IN)    :: PBINT(KLON,KLEV+1)
87REAL(KIND=JPRB)   ,INTENT(IN)    :: PBSUR(KLON,NSIL)
88REAL(KIND=JPRB)   ,INTENT(IN)    :: PBTOP(KLON,NSIL)
89REAL(KIND=JPRB)   ,INTENT(IN)    :: PDBSL(KLON,NSIL,KLEV*2)
90REAL(KIND=JPRB)   ,INTENT(IN)    :: PEMIS(KLON)
91REAL(KIND=JPRB)   ,INTENT(IN)    :: PEMIW(KLON)
92REAL(KIND=JPRB)   ,INTENT(IN)    :: PGA(KLON,NIPD,2,KLEV)
93REAL(KIND=JPRB)   ,INTENT(IN)    :: PGB(KLON,NIPD,2,KLEV)
94REAL(KIND=JPRB)   ,INTENT(IN)    :: PGASUR(KLON,NIPD,2)
95REAL(KIND=JPRB)   ,INTENT(IN)    :: PGBSUR(KLON,NIPD,2)
96REAL(KIND=JPRB)   ,INTENT(IN)    :: PGATOP(KLON,NIPD,2)
97REAL(KIND=JPRB)   ,INTENT(IN)    :: PGBTOP(KLON,NIPD,2)
98REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCNTRB(KLON,KLEV+1,KLEV+1)
99REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFLUC(KLON,2,KLEV+1)
100!-----------------------------------------------------------------------
101
102!*       0.1   ARGUMENTS
103!              ---------
104
105!-----------------------------------------------------------------------
106
107!              ------------
108
109REAL(KIND=JPRB) :: ZADJD(KLON,KLEV+1)  , ZADJU(KLON,KLEV+1)&
110 & ,  ZDBDT(KLON,NSIL,KLEV)&
111 & ,  ZDISD(KLON,KLEV+1)  , ZDISU(KLON,KLEV+1)&
112 & ,  ZDWFSU(KLON,NSIL) 
113
114INTEGER(KIND=JPIM) :: JA, JK, JL
115REAL(KIND=JPRB) :: ZHOOK_HANDLE
116
117#include "lwvb.intfb.h"
118#include "lwvd.intfb.h"
119#include "lwvn.intfb.h"
120
121!-----------------------------------------------------------------------
122
123!*         1.    INITIALIZATION
124!                --------------
125
126!*         1.1     INITIALIZE LAYER CONTRIBUTIONS
127!                  ------------------------------
128
129IF (LHOOK) CALL DR_HOOK('LWV',0,ZHOOK_HANDLE)
130DO JK=1,KLEV+1
131  DO JL=KIDIA,KFDIA
132    ZADJD(JL,JK)=0.0_JPRB
133    ZADJU(JL,JK)=0.0_JPRB
134    ZDISD(JL,JK)=0.0_JPRB
135    ZDISU(JL,JK)=0.0_JPRB
136  ENDDO
137ENDDO
138DO JA=1,NSIL
139  DO JL=KIDIA,KFDIA
140    ZDWFSU(JL,JA)=0.0_JPRB
141  ENDDO
142ENDDO
143
144!     ------------------------------------------------------------------
145
146!*         2.      VERTICAL INTEGRATION
147!                  --------------------
148
149!     ------------------------------------------------------------------
150
151!*         2.1     CONTRIBUTION FROM ADJACENT LAYERS
152!                  ---------------------------------
153
154CALL LWVN &
155 & ( KIDIA, KFDIA, KLON  , KLEV , KUAER,&
156 & PABCU, PDBSL, PGA   , PGB,&
157 & ZADJD, ZADJU, PCNTRB, ZDBDT, ZDWFSU  &
158 & ) 
159
160!     ------------------------------------------------------------------
161
162!*         2.2     CONTRIBUTION FROM DISTANT LAYERS
163!                  ---------------------------------
164
165CALL LWVD &
166 & ( KIDIA , KFDIA, KLON , KLEV  , KTRAER,&
167 & PABCU , ZDBDT, PGA  , PGB,&
168 & PCNTRB, ZDISD, ZDISU, ZDWFSU &
169 & ) 
170
171!     ------------------------------------------------------------------
172
173!*         2.3     EXCHANGE WITH THE BOUNDARIES
174!                  ----------------------------
175
176CALL LWVB &
177 & ( KIDIA , KFDIA , KLON  , KLEV  , KUAER,&
178 & PABCU , ZADJD , ZADJU,&
179 & PB    , PBINT , PBSUR , PBTOP,&
180 & ZDISD , ZDISU , PEMIS , PEMIW,&
181 & PGASUR, PGBSUR, PGATOP, PGBTOP,&
182 & ZDWFSU,PFLUC  &
183 & ) 
184
185!-----------------------------------------------------------------------
186
187IF (LHOOK) CALL DR_HOOK('LWV',1,ZHOOK_HANDLE)
188END SUBROUTINE LWV
Note: See TracBrowser for help on using the repository browser.