source: LMDZ5/branches/testing/libf/phymar/lwvn.F90 @ 5423

Last change on this file since 5423 was 2160, checked in by Laurent Fairhead, 10 years ago

Merged trunk changes -r2070:2158 into testing branch. Compilation problems introduced by revision r2155 have been corrected by hand
File size: 6.0 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!-----------------------------------------------------------------------
58
59#include "tsmbkind.h"
60
61USE YOELW    , ONLY : NSIL     ,NIPD     ,NTRA     ,NUA      ,&
62            &NG1      ,NG1P1    ,WG1
63
64
65IMPLICIT NONE
66
67
68!     DUMMY INTEGER SCALARS
69INTEGER_M :: KFDIA
70INTEGER_M :: KIDIA
71INTEGER_M :: KLEV
72INTEGER_M :: KLON
73INTEGER_M :: KUAER
74
75
76
77!-----------------------------------------------------------------------
78
79!*       0.1   ARGUMENTS
80!              ---------
81
82
83REAL_B :: PABCU(KLON,NUA,3*KLEV+1)&
84  &,  PDBSL(KLON,NSIL,KLEV*2)&
85  &,  PGA(KLON,NIPD,2,KLEV)   , PGB(KLON,NIPD,2,KLEV)
86
87REAL_B :: PADJD(KLON,KLEV+1)      , PADJU(KLON,KLEV+1)&
88  &,  PCNTRB(KLON,KLEV+1,KLEV+1)&
89  &,  PDBDT(KLON,NSIL,KLEV)   , PDWFSU(KLON,NSIL)
90
91!-----------------------------------------------------------------------
92
93!*       0.2   LOCAL ARRAYS
94!              ------------
95
96REAL_B :: ZTT(KLON,NTRA), ZTT1(KLON,NTRA), ZTT2(KLON,NTRA),  ZUU(KLON,NUA)
97
98!     LOCAL INTEGER SCALARS
99INTEGER_M :: IBS, IDD, IM12, IMU, IND, INU, IXD, IXU,&
100             &JA, JG, JK, JK1, JK2, JL, JNU
101
102!     LOCAL REAL SCALARS
103REAL_B :: ZWTR, ZWTR1, ZWTR2, ZWTR3, ZWTR4, ZWTR5, ZWTR6
104
105
106!-----------------------------------------------------------------------
107
108!*         1.    INITIALIZATION
109!                --------------
110
111!*         1.1     INITIALIZE LAYER CONTRIBUTIONS
112!                  ------------------------------
113
114DO JK = 1 , KLEV+1
115  DO JL = KIDIA,KFDIA
116    PADJD(JL,JK) = _ZERO_
117    PADJU(JL,JK) = _ZERO_
118  ENDDO
119ENDDO
120
121!*         1.2     INITIALIZE TRANSMISSION FUNCTIONS
122!                  ---------------------------------
123
124DO JA = 1 , NTRA
125  DO JL = KIDIA,KFDIA
126    ZTT (JL,JA) = _ONE_
127    ZTT1(JL,JA) = _ONE_
128    ZTT2(JL,JA) = _ONE_
129  ENDDO
130ENDDO
131
132DO JA = 1 , NUA
133  DO JL = KIDIA,KFDIA
134    ZUU(JL,JA) = _ZERO_
135  ENDDO
136ENDDO
137
138!     ------------------------------------------------------------------
139
140!*         2.      VERTICAL INTEGRATION
141!                  --------------------
142
143
144!*         2.1     CONTRIBUTION FROM ADJACENT LAYERS
145!                  ---------------------------------
146
147DO JK = 1 , KLEV
148
149!*         2.1.1   DOWNWARD LAYERS
150!                  ---------------
151
152  IM12 = 2 * (JK - 1)
153  IND = (JK - 1) * NG1P1 + 1
154  IXD = IND
155  INU = JK * NG1P1 + 1
156  IXU = IND
157
158  DO JG = 1 , NG1
159    IBS = IM12 + JG
160    IDD = IXD + JG
161
162    DO JA = 1 , KUAER
163      DO JL = KIDIA,KFDIA
164        ZUU(JL,JA) = PABCU(JL,JA,IND) - PABCU(JL,JA,IDD)
165      ENDDO
166    ENDDO
167
168
169    CALL LWTT &
170     &( KIDIA        , KFDIA        , KLON &
171     &, PGA(1,1,1,JK), PGB(1,1,1,JK)&
172     &, ZUU          , ZTT &
173     &)
174
175    DO JL = KIDIA,KFDIA
176      ZWTR1=PDBSL(JL,1,IBS)*ZTT(JL,1)          *ZTT(JL,10)
177      ZWTR2=PDBSL(JL,2,IBS)*ZTT(JL,2)*ZTT(JL,7)*ZTT(JL,11)
178      ZWTR3=PDBSL(JL,3,IBS)*ZTT(JL,4)*ZTT(JL,8)*ZTT(JL,12)
179      ZWTR4=PDBSL(JL,4,IBS)*ZTT(JL,5)*ZTT(JL,9)*ZTT(JL,13)
180      ZWTR5=PDBSL(JL,5,IBS)*ZTT(JL,3)          *ZTT(JL,14)
181      ZWTR6=PDBSL(JL,6,IBS)*ZTT(JL,6)          *ZTT(JL,15)
182      ZWTR=ZWTR1+ZWTR2+ZWTR3+ZWTR4+ZWTR5+ZWTR6
183      PADJD(JL,JK) = PADJD(JL,JK) + ZWTR * WG1(JG)
184      IF (JK == 1) THEN
185        PDWFSU(JL,1)=PDWFSU(JL,1)+WG1(JG)*ZWTR1
186        PDWFSU(JL,2)=PDWFSU(JL,2)+WG1(JG)*ZWTR2
187        PDWFSU(JL,3)=PDWFSU(JL,3)+WG1(JG)*ZWTR3
188        PDWFSU(JL,4)=PDWFSU(JL,4)+WG1(JG)*ZWTR4
189        PDWFSU(JL,5)=PDWFSU(JL,5)+WG1(JG)*ZWTR5
190        PDWFSU(JL,6)=PDWFSU(JL,6)+WG1(JG)*ZWTR6
191      ENDIF
192    ENDDO
193
194!*         2.1.2   UPWARD LAYERS
195!                  -------------
196
197    IMU = IXU + JG
198    DO JA = 1 , KUAER
199      DO JL = KIDIA,KFDIA
200        ZUU(JL,JA) = PABCU(JL,JA,IMU) - PABCU(JL,JA,INU)
201      ENDDO
202    ENDDO
203
204
205    CALL LWTT &
206     &( KIDIA        , KFDIA        , KLON &
207     &, PGA(1,1,1,JK), PGB(1,1,1,JK)&
208     &, ZUU          , ZTT &
209     &)
210
211    DO JL = KIDIA,KFDIA
212      ZWTR=PDBSL(JL,1,IBS)*ZTT(JL,1)          *ZTT(JL,10)&
213       &+PDBSL(JL,2,IBS)*ZTT(JL,2)*ZTT(JL,7)*ZTT(JL,11)&
214       &+PDBSL(JL,3,IBS)*ZTT(JL,4)*ZTT(JL,8)*ZTT(JL,12)&
215       &+PDBSL(JL,4,IBS)*ZTT(JL,5)*ZTT(JL,9)*ZTT(JL,13)&
216       &+PDBSL(JL,5,IBS)*ZTT(JL,3)          *ZTT(JL,14)&
217       &+PDBSL(JL,6,IBS)*ZTT(JL,6)          *ZTT(JL,15)
218      PADJU(JL,JK+1) = PADJU(JL,JK+1) + ZWTR * WG1(JG)
219    ENDDO
220
221  ENDDO
222
223  DO JL = KIDIA,KFDIA
224    PCNTRB(JL,JK,JK+1) = PADJD(JL,JK)
225    PCNTRB(JL,JK+1,JK) = PADJU(JL,JK+1)
226    PCNTRB(JL,JK  ,JK) = _ZERO_
227  ENDDO
228
229ENDDO
230
231DO JK = 1 , KLEV
232  JK2 = 2 * JK
233  JK1 = JK2 - 1
234
235  DO JNU = 1 , NSIL
236    DO JL = KIDIA,KFDIA
237      PDBDT(JL,JNU,JK) = PDBSL(JL,JNU,JK1) + PDBSL(JL,JNU,JK2)
238    ENDDO
239  ENDDO
240ENDDO
241
242!-----------------------------------------------------------------------
243
244RETURN
245END SUBROUTINE LWVN
Note: See TracBrowser for help on using the repository browser.