source: LMDZ6/branches/SETHET_DECOUPLE/libf/phylmd/rrtm/lwvn.F90 @ 5441

Last change on this file since 5441 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: 6.6 KB
Line 
1SUBROUTINE LWVN &
2 & ( KIDIA, KFDIA, KLON  , KLEV , KUAER,&
3 & PABCU, PDBSL, PGA   , PGB,&
4 & PADJD, PADJU, PCNTRB, PDBDT, PDWFSU &
5 & ) 
6
7!**** *LWVN*   - L.W., VERTICAL INTEGRATION, NEARBY LAYERS
8
9!     PURPOSE.
10!     --------
11!           CARRIES OUT THE VERTICAL INTEGRATION ON NEARBY LAYERS
12!           TO GIVE LONGWAVE FLUXES OR RADIANCES
13
14!**   INTERFACE.
15!     ----------
16
17!        EXPLICIT ARGUMENTS :
18!        --------------------
19!     ==== INPUTS ===
20! PABCU : (KLON,NUA,3*KLEV+1)  ; ABSORBER AMOUNTS
21! PDBSL  : (KLON,KLEV*2)       ; SUB-LAYER PLANCK FUNCTION GRADIENT
22! PGA, PGB                     ; PADE APPROXIMANTS
23!     ==== OUTPUTS ===
24! PADJ.. : (KLON,KLEV+1)       ; CONTRIBUTION OF ADJACENT LAYERS
25! PCNTRB : (KLON,KLEV+1,KLEV+1); CLEAR-SKY ENERGY EXCHANGE MATRIX
26! PDBDT  : (KLON,NUA,KLEV)     ; LAYER PLANCK FUNCTION GRADIENT
27! PDWFSU : (KLON,NSIL)         ; SPECTRAL DOWNWARD FLUX AT SURFACE
28
29!        IMPLICIT ARGUMENTS :   NONE
30!        --------------------
31
32!     METHOD.
33!     -------
34
35!          1. PERFORMS THE VERTICAL INTEGRATION CORRESPONDING TO THE
36!     CONTRIBUTIONS OF THE ADJACENT LAYERS USING A GAUSSIAN QUADRATURE
37
38!     EXTERNALS.
39!     ----------
40
41!          *LWTT*
42
43!     REFERENCE.
44!     ----------
45
46!        SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
47!        ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
48
49!     AUTHOR.
50!     -------
51!        JEAN-JACQUES MORCRETTE  *ECMWF*
52
53!     MODIFICATIONS.
54!     --------------
55!        ORIGINAL : 89-07-14
56!        JJ Morcrette 97-04-18 Revised Continuum + Surf.Emissiv.
57!        M.Hamrud      01-Oct-2003 CY28 Cleaning
58!-----------------------------------------------------------------------
59
60USE PARKIND1  ,ONLY : JPIM     ,JPRB
61USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
62
63USE YOELW    , ONLY : NSIL     ,NIPD     ,NTRA     ,NUA      ,&
64 & NG1      ,NG1P1    ,WG1 
65
66IMPLICIT NONE
67
68INTEGER(KIND=JPIM),INTENT(IN)    :: KLON
69INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV
70INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA
71INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA
72INTEGER(KIND=JPIM),INTENT(IN)    :: KUAER
73REAL(KIND=JPRB)   ,INTENT(IN)    :: PABCU(KLON,NUA,3*KLEV+1)
74REAL(KIND=JPRB)   ,INTENT(IN)    :: PDBSL(KLON,NSIL,KLEV*2)
75REAL(KIND=JPRB)   ,INTENT(IN)    :: PGA(KLON,NIPD,2,KLEV)
76REAL(KIND=JPRB)   ,INTENT(IN)    :: PGB(KLON,NIPD,2,KLEV)
77REAL(KIND=JPRB)   ,INTENT(OUT)   :: PADJD(KLON,KLEV+1)
78REAL(KIND=JPRB)   ,INTENT(OUT)   :: PADJU(KLON,KLEV+1)
79REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCNTRB(KLON,KLEV+1,KLEV+1)
80REAL(KIND=JPRB)   ,INTENT(OUT)   :: PDBDT(KLON,NSIL,KLEV)
81REAL(KIND=JPRB)   ,INTENT(INOUT) :: PDWFSU(KLON,NSIL)
82!-----------------------------------------------------------------------
83
84!*       0.1   ARGUMENTS
85!              ---------
86
87!-----------------------------------------------------------------------
88
89!              ------------
90
91REAL(KIND=JPRB) :: ZTT(KLON,NTRA), ZTT1(KLON,NTRA), ZTT2(KLON,NTRA),  ZUU(KLON,NUA)
92
93INTEGER(KIND=JPIM) :: IBS, IDD, IM12, IMU, IND, INU, IXD, IXU,&
94 & JA, JG, JK, JK1, JK2, JL, JNU 
95
96REAL(KIND=JPRB) :: ZWTR, ZWTR1, ZWTR2, ZWTR3, ZWTR4, ZWTR5, ZWTR6
97REAL(KIND=JPRB) :: ZHOOK_HANDLE
98
99#include "lwtt.intfb.h"
100
101!-----------------------------------------------------------------------
102
103!*         1.    INITIALIZATION
104!                --------------
105
106!*         1.1     INITIALIZE LAYER CONTRIBUTIONS
107!                  ------------------------------
108
109IF (LHOOK) CALL DR_HOOK('LWVN',0,ZHOOK_HANDLE)
110DO JK = 1 , KLEV+1
111  DO JL = KIDIA,KFDIA
112    PADJD(JL,JK) = 0.0_JPRB
113    PADJU(JL,JK) = 0.0_JPRB
114  ENDDO
115ENDDO
116
117!*         1.2     INITIALIZE TRANSMISSION FUNCTIONS
118!                  ---------------------------------
119
120DO JA = 1 , NTRA
121  DO JL = KIDIA,KFDIA
122    ZTT (JL,JA) = 1.0_JPRB
123    ZTT1(JL,JA) = 1.0_JPRB
124    ZTT2(JL,JA) = 1.0_JPRB
125  ENDDO
126ENDDO
127
128DO JA = 1 , NUA
129  DO JL = KIDIA,KFDIA
130    ZUU(JL,JA) = 0.0_JPRB
131  ENDDO
132ENDDO
133
134!     ------------------------------------------------------------------
135
136!*         2.      VERTICAL INTEGRATION
137!                  --------------------
138
139!*         2.1     CONTRIBUTION FROM ADJACENT LAYERS
140!                  ---------------------------------
141
142DO JK = 1 , KLEV
143
144!*         2.1.1   DOWNWARD LAYERS
145!                  ---------------
146
147  IM12 = 2 * (JK - 1)
148  IND = (JK - 1) * NG1P1 + 1
149  IXD = IND
150  INU = JK * NG1P1 + 1
151  IXU = IND
152
153  DO JG = 1 , NG1
154    IBS = IM12 + JG
155    IDD = IXD + JG
156
157    DO JA = 1 , KUAER
158      DO JL = KIDIA,KFDIA
159        ZUU(JL,JA) = PABCU(JL,JA,IND) - PABCU(JL,JA,IDD)
160      ENDDO
161    ENDDO
162
163    CALL LWTT &
164     & ( KIDIA        , KFDIA        , KLON,&
165     & PGA(1,1,1,JK), PGB(1,1,1,JK),&
166     & ZUU          , ZTT &
167     & ) 
168
169    DO JL = KIDIA,KFDIA
170      ZWTR1=PDBSL(JL,1,IBS)*ZTT(JL,1)          *ZTT(JL,10)
171      ZWTR2=PDBSL(JL,2,IBS)*ZTT(JL,2)*ZTT(JL,7)*ZTT(JL,11)
172      ZWTR3=PDBSL(JL,3,IBS)*ZTT(JL,4)*ZTT(JL,8)*ZTT(JL,12)
173      ZWTR4=PDBSL(JL,4,IBS)*ZTT(JL,5)*ZTT(JL,9)*ZTT(JL,13)
174      ZWTR5=PDBSL(JL,5,IBS)*ZTT(JL,3)          *ZTT(JL,14)
175      ZWTR6=PDBSL(JL,6,IBS)*ZTT(JL,6)          *ZTT(JL,15)
176      ZWTR=ZWTR1+ZWTR2+ZWTR3+ZWTR4+ZWTR5+ZWTR6
177      PADJD(JL,JK) = PADJD(JL,JK) + ZWTR * WG1(JG)
178      IF (JK == 1) THEN
179        PDWFSU(JL,1)=PDWFSU(JL,1)+WG1(JG)*ZWTR1
180        PDWFSU(JL,2)=PDWFSU(JL,2)+WG1(JG)*ZWTR2
181        PDWFSU(JL,3)=PDWFSU(JL,3)+WG1(JG)*ZWTR3
182        PDWFSU(JL,4)=PDWFSU(JL,4)+WG1(JG)*ZWTR4
183        PDWFSU(JL,5)=PDWFSU(JL,5)+WG1(JG)*ZWTR5
184        PDWFSU(JL,6)=PDWFSU(JL,6)+WG1(JG)*ZWTR6
185      ENDIF
186    ENDDO
187
188!*         2.1.2   UPWARD LAYERS
189!                  -------------
190
191    IMU = IXU + JG
192    DO JA = 1 , KUAER
193      DO JL = KIDIA,KFDIA
194        ZUU(JL,JA) = PABCU(JL,JA,IMU) - PABCU(JL,JA,INU)
195      ENDDO
196    ENDDO
197
198    CALL LWTT &
199     & ( KIDIA        , KFDIA        , KLON,&
200     & PGA(1,1,1,JK), PGB(1,1,1,JK),&
201     & ZUU          , ZTT &
202     & ) 
203
204    DO JL = KIDIA,KFDIA
205      ZWTR=PDBSL(JL,1,IBS)*ZTT(JL,1)          *ZTT(JL,10)&
206       & +PDBSL(JL,2,IBS)*ZTT(JL,2)*ZTT(JL,7)*ZTT(JL,11)&
207       & +PDBSL(JL,3,IBS)*ZTT(JL,4)*ZTT(JL,8)*ZTT(JL,12)&
208       & +PDBSL(JL,4,IBS)*ZTT(JL,5)*ZTT(JL,9)*ZTT(JL,13)&
209       & +PDBSL(JL,5,IBS)*ZTT(JL,3)          *ZTT(JL,14)&
210       & +PDBSL(JL,6,IBS)*ZTT(JL,6)          *ZTT(JL,15) 
211      PADJU(JL,JK+1) = PADJU(JL,JK+1) + ZWTR * WG1(JG)
212    ENDDO
213
214  ENDDO
215
216  DO JL = KIDIA,KFDIA
217    PCNTRB(JL,JK,JK+1) = PADJD(JL,JK)
218    PCNTRB(JL,JK+1,JK) = PADJU(JL,JK+1)
219    PCNTRB(JL,JK  ,JK) = 0.0_JPRB
220  ENDDO
221
222ENDDO
223
224DO JK = 1 , KLEV
225  JK2 = 2 * JK
226  JK1 = JK2 - 1
227
228  DO JNU = 1 , NSIL
229    DO JL = KIDIA,KFDIA
230      PDBDT(JL,JNU,JK) = PDBSL(JL,JNU,JK1) + PDBSL(JL,JNU,JK2)
231    ENDDO
232  ENDDO
233ENDDO
234
235!-----------------------------------------------------------------------
236
237IF (LHOOK) CALL DR_HOOK('LWVN',1,ZHOOK_HANDLE)
238END SUBROUTINE LWVN
Note: See TracBrowser for help on using the repository browser.