source: LMDZ5/trunk/libf/phymar/olwvb.F90

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

Inclusion de la physique de MAR


Integration of MAR physics

File size: 7.0 KB
RevLine 
[2089]1SUBROUTINE OLWVB ( KIDIA,KFDIA,KLON,KLEV,KUAER &
2     &  , PABCU,PADJD,PADJU,PB,PBINT,PBSUI,PBSUR,PBTOP &
3     &  , PDISD,PDISU,PEMIS &
4     &  , PGA,PGB,PGASUR,PGBSUR,PGATOP,PGBTOP &
5     &  , PFLUC )
6!
7!**** *LWVB*   - L.W., VERTICAL INTEGRATION, EXCHANGE WITH BOUNDARIES
8!
9!     PURPOSE.
10!     --------
11!           INTRODUCES THE EFFECTS OF THE BOUNDARIES IN THE VERTICAL
12!           INTEGRATION
13!
14!**   INTERFACE.
15!     ----------
16!
17!        EXPLICIT ARGUMENTS :
18!        --------------------
19!     ==== INPUTS ===
20! PABCU : (KLON,NUA,3*KLEV+1); ABSORBER AMOUNTS
21! PADJ.. : (KLON,KLEV+1)     ; CONTRIBUTION BY ADJACENT LAYERS
22! PB     : (KLON,NISP,KLEV+1); SPECTRAL HALF-LEVEL PLANCK FUNCTIONS
23! PBINT  : (KLON,KLEV+1)     ; HALF-LEVEL PLANCK FUNCTIONS
24! PBSUI  : (KLON)            ; SURFACE PLANCK FUNCTION
25! PBSUR  : (KLON,NISP)       ; SPECTRAL SURFACE PLANCK FUNCTION
26! PBTOP  : (KLON,NISP)       ; SPECTRAL T.O.A. PLANCK FUNCTION
27! PDIS.. : (KLON,KLEV+1)     ; CONTRIBUTION BY DISTANT LAYERS
28! PEMIS  : (KLON)            ; SURFACE EMISSIVITY
29! PGA, PGB                   ; PADE APPROXIMANTS
30! PGASUR, PGBSUR             ; SURFACE PADE APPROXIMANTS
31! PGATOP, PGBTOP             ; T.O.A. PADE APPROXIMANTS
32!     ==== OUTPUTS ===
33! PFLUC(KLON,2,KLEV)         ; RADIATIVE FLUXES CLEAR-SKY:
34!                     1  ==>  UPWARD   FLUX TOTAL
35!
36!        IMPLICIT ARGUMENTS :   NONE
37!        --------------------
38!
39!     METHOD.
40!     -------
41!
42!          1. COMPUTES THE ENERGY EXCHANGE WITH TOP AND SURFACE OF THE
43!     ATMOSPHERE
44!          2. COMPUTES THE COOLING-TO-SPACE AND HEATING-FROM-GROUND
45!     TERMS FOR THE APPROXIMATE COOLING RATE ABOVE 10 HPA
46!          3. ADDS UP ALL CONTRIBUTIONS TO GET THE CLEAR-SKY FLUXES
47!
48!     EXTERNALS.
49!     ----------
50!
51!          *LWTT*
52!
53!     REFERENCE.
54!     ----------
55!
56!        SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
57!        ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
58!
59!     AUTHOR.
60!     -------
61!        JEAN-JACQUES MORCRETTE  *ECMWF*
62!
63!     MODIFICATIONS.
64!     --------------
65!        ORIGINAL : 89-07-14
66!-----------------------------------------------------------------------
67
68#include "tsmbkind.h"
69
70USE YOEOLW   , ONLY : NISP     ,NIPD     ,NTRA     ,NUA      ,NG1P1
71
72
73IMPLICIT NONE
74
75
76!     DUMMY INTEGER SCALARS
77INTEGER_M :: KFDIA
78INTEGER_M :: KIDIA
79INTEGER_M :: KLEV
80INTEGER_M :: KLON
81INTEGER_M :: KUAER
82
83
84!-----------------------------------------------------------------------
85!
86!*       0.1   ARGUMENTS
87!              ---------
88!
89!
90REAL_B :: PABCU(KLON,NUA,3*KLEV+1) &
91     &  ,  PADJD(KLON,KLEV+1), PADJU(KLON,KLEV+1) &
92     &  ,  PB(KLON,NISP,KLEV+1), PBINT(KLON,KLEV+1) &
93     &  ,  PBSUR(KLON,NISP), PBSUI(KLON), PBTOP(KLON,NISP) &
94     &  ,  PDISD(KLON,KLEV+1), PDISU(KLON,KLEV+1) &
95     &  ,  PEMIS(KLON) &
96     &  ,  PGA(KLON,8,2,KLEV), PGB(KLON,8,2,KLEV) &
97     &  ,  PGASUR(KLON,8,2), PGBSUR(KLON,8,2) &
98     &  ,  PGATOP(KLON,8,2), PGBTOP(KLON,8,2)
99!
100REAL_B :: PFLUC(KLON,2,KLEV+1)
101!
102!-----------------------------------------------------------------------
103!
104!*       0.2   LOCAL ARRAYS
105!              ------------
106!
107INTEGER_M :: ITX(KLON)
108!
109REAL_B :: ZBGND(KLON), ZFD(KLON), ZFDN(KLON,KLEV+1) &
110     &  ,  ZFN10(KLON), ZFU(KLON), ZFUP(KLON,KLEV+1) &
111     &  ,  ZTT(KLON,NTRA), ZTT1(KLON,NTRA), ZTT2(KLON,NTRA) &
112     &  ,  ZUU(KLON,NUA) , ZCNSOL(KLON), ZCNTOP(KLON)
113!
114
115!     LOCAL INTEGER SCALARS
116INTEGER_M :: IN, JA, JK, JL, IND1, IND2, IND3, IND4, JLIM
117
118!     LOCAL REAL SCALARS
119REAL_B :: ZCNTOP1, ZCNTOP2, ZCNTOP3, ZCNTOP4, ZCNTOP5, ZCNTOP6
120
121!-----------------------------------------------------------------------
122!
123!*         1.    INITIALIZATION
124!                --------------
125!
126!
127!*         1.2     INITIALIZE TRANSMISSION FUNCTIONS
128!                  ---------------------------------
129!
130DO JA=1,NTRA
131  DO JL=KIDIA,KFDIA
132    ZTT (JL,JA)=1.0
133    ZTT1(JL,JA)=1.0
134    ZTT2(JL,JA)=1.0
135  END DO
136END DO
137!
138DO JA=1,NUA
139  DO JL=KIDIA,KFDIA
140    ZUU(JL,JA)=1.0
141  END DO
142END DO
143!
144!     ------------------------------------------------------------------
145!
146!*         2.      VERTICAL INTEGRATION
147!                  --------------------
148!
149IND1=0
150IND3=0
151IND4=1
152IND2=1
153!
154!
155!*         2.3     EXCHANGE WITH TOP OF THE ATMOSPHERE
156!                  -----------------------------------
157!
158DO JK = 1 , KLEV
159  IN=(JK-1)*NG1P1+1
160!
161  DO JA=1,KUAER
162    DO JL=KIDIA,KFDIA
163      ZUU(JL,JA)=PABCU(JL,JA,IN)
164    END DO
165  END DO
166!
167!
168  CALL LWTT ( KIDIA,KFDIA,KLON &
169     &          , PGATOP(1,1,1), PGBTOP(1,1,1), ZUU, ZTT )
170!
171  DO JL = KIDIA,KFDIA
172    ZCNTOP(JL)=PBTOP(JL,1)*ZTT(JL,1)          *ZTT(JL,10) &
173    &      +PBTOP(JL,2)*ZTT(JL,2)*ZTT(JL,7)*ZTT(JL,11) &
174    &      +PBTOP(JL,3)*ZTT(JL,4)*ZTT(JL,8)*ZTT(JL,12) &
175    &      +PBTOP(JL,4)*ZTT(JL,5)*ZTT(JL,9)*ZTT(JL,13) &
176    &      +PBTOP(JL,5)*ZTT(JL,3)          *ZTT(JL,14) &
177    &      +PBTOP(JL,6)*ZTT(JL,6)          *ZTT(JL,15)
178    ZFD(JL)=ZCNTOP(JL)-PBINT(JL,JK)-PDISD(JL,JK)-PADJD(JL,JK)
179    ZFDN(JL,JK)=ZFD(JL)
180    PFLUC(JL,2,JK)=ZFD(JL)
181  END DO
182!
183END DO
184!
185JK = KLEV+1
186IN=(JK-1)*NG1P1+1
187!
188DO JL = KIDIA,KFDIA
189  ZCNTOP(JL)= PBTOP(JL,1) &
190  &   + PBTOP(JL,2) &
191  &   + PBTOP(JL,3) &
192  &   + PBTOP(JL,4) &
193  &   + PBTOP(JL,5) &
194  &   + PBTOP(JL,6)
195  ZFD(JL)=ZCNTOP(JL)-PBINT(JL,JK)-PDISD(JL,JK)-PADJD(JL,JK)
196  ZFDN(JL,JK)=ZFD(JL)
197  PFLUC(JL,2,JK)=ZFD(JL)
198END DO
199!
200!*         2.4     COOLING-TO-SPACE OF LAYERS ABOVE 10 HPA
201!                  ---------------------------------------
202!
203!
204!*         2.4.1   INITIALIZATION
205!                  --------------
206!
207!
208!*         2.5     EXCHANGE WITH LOWER LIMIT
209!                  -------------------------
210!
211DO JL = KIDIA,KFDIA
212  ZBGND(JL)=PBSUI(JL)*PEMIS(JL)-(1.-PEMIS(JL)) &
213  &               *PFLUC(JL,2,1)-PBINT(JL,1)
214END DO
215!
216JK = 1
217IN=(JK-1)*NG1P1+1
218!
219DO JL = KIDIA,KFDIA
220  ZCNSOL(JL)=PBSUR(JL,1) &
221  & +PBSUR(JL,2) &
222  & +PBSUR(JL,3) &
223  & +PBSUR(JL,4) &
224  & +PBSUR(JL,5) &
225  & +PBSUR(JL,6)
226  ZCNSOL(JL)=ZCNSOL(JL)*ZBGND(JL)/PBSUI(JL)
227  ZFU(JL)=ZCNSOL(JL)+PBINT(JL,JK)-PDISU(JL,JK)-PADJU(JL,JK)
228  ZFUP(JL,JK)=ZFU(JL)
229  PFLUC(JL,1,JK)=ZFU(JL)
230END DO
231!
232DO JK = 2 , KLEV+1
233  IN=(JK-1)*NG1P1+1
234!
235!
236  DO JA=1,KUAER
237    DO JL=KIDIA,KFDIA
238      ZUU(JL,JA)=PABCU(JL,JA,1)-PABCU(JL,JA,IN)
239    END DO
240  END DO
241!
242!
243  CALL LWTT ( KIDIA,KFDIA,KLON &
244     &          , PGASUR(1,1,1), PGBSUR(1,1,1), ZUU, ZTT )
245!
246  DO JL = KIDIA,KFDIA
247    ZCNSOL(JL)=PBSUR(JL,1)*ZTT(JL,1)          *ZTT(JL,10) &
248    &      +PBSUR(JL,2)*ZTT(JL,2)*ZTT(JL,7)*ZTT(JL,11) &
249    &      +PBSUR(JL,3)*ZTT(JL,4)*ZTT(JL,8)*ZTT(JL,12) &
250    &      +PBSUR(JL,4)*ZTT(JL,5)*ZTT(JL,9)*ZTT(JL,13) &
251    &      +PBSUR(JL,5)*ZTT(JL,3)          *ZTT(JL,14) &
252    &      +PBSUR(JL,6)*ZTT(JL,6)          *ZTT(JL,15)
253    ZCNSOL(JL)=ZCNSOL(JL)*ZBGND(JL)/PBSUI(JL)
254    ZFU(JL)=ZCNSOL(JL)+PBINT(JL,JK)-PDISU(JL,JK)-PADJU(JL,JK)
255    ZFUP(JL,JK)=ZFU(JL)
256    PFLUC(JL,1,JK)=ZFU(JL)
257  END DO
258!
259!
260END DO
261!
262!
263!
264!*         2.7     CLEAR-SKY FLUXES
265!                  ----------------
266!
267DO JK = 1 , KLEV+1
268  DO JL = KIDIA,KFDIA
269    PFLUC(JL,1,JK) = ZFUP(JL,JK)
270    PFLUC(JL,2,JK) = ZFDN(JL,JK)
271  END DO
272END DO
273!
274!     ------------------------------------------------------------------
275!
276RETURN
277END SUBROUTINE OLWVB
Note: See TracBrowser for help on using the repository browser.