source: LMDZ5/trunk/libf/phymar/olwvn.F90 @ 3847

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

Inclusion de la physique de MAR


Integration of MAR physics

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