source: LMDZ5/branches/testing/libf/phymar/olwu.F90 @ 3946

Last change on this file since 3946 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: 10.6 KB
RevLine 
[2089]1SUBROUTINE OLWU ( KIDIA, KFDIA, KLON, KLEV &
2     &  ,  PAER, PCCO2, PDP, PAPH, PQOF, PT, PVIEW, PWV &
3     &  ,  PABCU     )
4!
5!**** *LWU* - LONGWAVE EFFECTIVE ABSORBER AMOUNTS
6!
7!     PURPOSE.
8!     --------
9!           COMPUTES ABSORBER AMOUNTS INCLUDING PRESSURE AND
10!           TEMPERATURE EFFECTS
11!
12!**   INTERFACE.
13!     ----------
14!
15!        EXPLICIT ARGUMENTS :
16!        --------------------
17!     ==== INPUTS ===
18! PAER   : (KLON,6,KLEV)     ; OPTICAL THICKNESS OF THE AEROSOLS
19! PCCO2  :                   ; CONCENTRATION IN CO2 (PA/PA)
20! PAPH   : (KLON,KLEV+1)     ; HALF LEVEL PRESSURE
21! PQOF   : (KLON,KLEV)       ; CONCENTRATION IN OZONE (PA/PA)
22! PT     : (KLON,KLEV)       ; TEMPERATURE
23! PWV    : (KLON,KLEV)       ; SPECIFIC HUMIDITY PA/PA
24! PVIEW  : (KLON)            ; COSECANT OF VIEWING ANGLE
25!     ==== OUTPUTS ===
26! PABCU  :(KLON,NUA,3*KLEV+1); EFFECTIVE ABSORBER AMOUNTS
27!
28!        IMPLICIT ARGUMENTS :   NONE
29!        --------------------
30!
31!     METHOD.
32!     -------
33!
34!          1. COMPUTES THE PRESSURE AND TEMPERATURE WEIGHTED AMOUNTS OF
35!     ABSORBERS.
36!
37!     EXTERNALS.
38!     ----------
39!
40!          NONE
41!
42!     REFERENCE.
43!     ----------
44!
45!        SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
46!        ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
47!
48!     AUTHOR.
49!     -------
50!        JEAN-JACQUES MORCRETTE  *ECMWF*
51!
52!     MODIFICATIONS.
53!     --------------
54!        ORIGINAL : 89-07-14
55!-----------------------------------------------------------------------
56
57#include "tsmbkind.h"
58
59USE YOMCST   , ONLY : RG
60USE YOESW    , ONLY : RAER
61USE YOEOLW   , ONLY : NISP     ,NUA      ,NG1      ,NG1P1    ,&
62            &AT       ,BT       ,RT1      ,TREF     ,OCT      ,&
63            &RVGCO2   ,RVGH2O   ,RVGO3
64USE YOERDI   , ONLY : RCH4     ,RN2O     ,RCFC11   ,RCFC12
65USE YOERDU   , ONLY : R10E     ,REPSCO   ,REPSCQ
66USE YOEDBUG  , ONLY : LDEBUG
67
68
69IMPLICIT NONE
70
71!     DUMMY INTEGER SCALARS
72INTEGER_M :: KFDIA
73INTEGER_M :: KIDIA
74INTEGER_M :: KLEV
75INTEGER_M :: KLON
76
77!     DUMMY REAL SCALARS
78REAL_B :: PCCO2
79
80CHARACTER*3 CVAR
81
82
83!-----------------------------------------------------------------------
84!
85!*       0.1   ARGUMENTS
86!              ---------
87!
88REAL_B :: PAER(KLON,6,KLEV) , PDP(KLON,KLEV) &
89     &  ,  PAPH(KLON,KLEV+1), PQOF(KLON,KLEV) &
90     &  ,  PT(KLON,KLEV), PVIEW(KLON),  PWV(KLON,KLEV)
91!
92REAL_B :: PABCU(KLON,NUA,3*KLEV+1)
93!
94!-----------------------------------------------------------------------
95!
96!*       0.2   LOCAL ARRAYS
97!              ------------
98REAL_B :: ZABLY(KLON,7, 3*KLEV),  ZDUC(KLON, 3*KLEV) &
99     &  , ZDPM(KLON, 3*KLEV), ZUPM(KLON, 3*KLEV)
100REAL_B :: ZPHIO(KLON),ZPSC2(KLON),ZPSC3(KLON),ZPSH1(KLON) &
101     &  ,  ZPSH2(KLON),ZPSH3(KLON),ZPSH4(KLON),ZPSH5(KLON) &
102     &  ,  ZPSH6(KLON),ZPSIO(KLON),ZTCON(KLON) &
103     &  ,  ZPHM6(KLON),ZPSM6(KLON),ZPHN6(KLON),ZPSN6(KLON)
104REAL_B :: ZSSIG(KLON,3*KLEV+1), ZTAVI(KLON) &
105     &  ,  ZUAER(KLON,6), ZXOZ(KLON), ZXWV(KLON)
106!
107
108!     LOCAL INTEGER SCALARS
109INTEGER_M :: IAE1, IAE2, IAE3, IC, ICCC, ICP1, IG1, IJ, IJPN,&
110             &IKIP1, IKJ, IKJP, IKJPN, IKJR, IKL, IPK, JA, JAE, &
111             &JK, JKI, JKK, JL, JAE1, JAE2, JAE3, JC, JCP1, JJ, JJPN, &
112             & JKJ, JKJR, JKJP, JKIP1, JKP1, JKJPN
113
114!     LOCAL REAL SCALARS
115REAL_B :: ZALUP, ZCAC8, ZCAH1, ZCAH2, ZCAH3, ZCAH4,&
116          &ZCAH5, ZCAH6, ZCBC8, ZCBH1, ZCBH2, ZCBH3, &
117          &ZCBH4, ZCBH5, ZCBH6, ZDIFF, ZDPMG, ZDPMP0, &
118          &ZFPPW, ZTX, ZTX2, ZU6, ZUP, ZUPMCO2, ZUPMG, &
119          &ZUPMH2O, ZUPMO3, ZZABLY
120
121!
122!-----------------------------------------------------------------------
123!
124!*         1.    INITIALIZATION
125!                --------------
126!
127!-----------------------------------------------------------------------
128!
129!
130!*         2.    PRESSURE OVER GAUSS SUB-LEVELS
131!                ------------------------------
132!
133DO JL = KIDIA,KFDIA
134  ZSSIG(JL, 1 ) = PAPH(JL,KLEV+1)
135END DO
136!
137DO JK = 1 , KLEV
138  JKJ=(JK-1)*NG1P1+1
139  JKJR = JKJ
140  JKJP = JKJ + NG1P1
141  IKL=KLEV+1-JK
142  DO JL = KIDIA,KFDIA
143    ZSSIG(JL,JKJP)=PAPH(JL,IKL)
144  END DO
145  DO IG1=1,NG1
146    JKJ=JKJ+1
147    DO JL = KIDIA,KFDIA
148      ZSSIG(JL,JKJ)= (ZSSIG(JL,JKJR)+ZSSIG(JL,JKJP))*0.5_JPRB &
149      &  + RT1(IG1) * (ZSSIG(JL,JKJP) - ZSSIG(JL,JKJR)) * 0.5_JPRB
150    END DO
151  END DO
152END DO
153!
154!-----------------------------------------------------------------------
155!
156!
157!*         4.    PRESSURE THICKNESS AND MEAN PRESSURE OF SUB-LAYERS
158!                --------------------------------------------------
159!
160DO JKI=1,3*KLEV
161  JKIP1=JKI+1
162  DO JL = KIDIA,KFDIA
163    ZUPM(JL,JKI)=(ZSSIG(JL,JKI)+ZSSIG(JL,JKIP1))*0.5_JPRB
164    ZDPM(JL,JKI)=(ZSSIG(JL,JKI)-ZSSIG(JL,JKIP1))/(10._JPRB*RG)
165  END DO
166END DO
167!
168DO JK = 1 , KLEV
169  JKP1=JK+1
170  IKL = KLEV+1 - JK
171  DO JL = KIDIA,KFDIA
172    ZXWV(JL) = MAX (PWV(JL,IKL) , REPSCQ )
173    ZXOZ(JL) = MAX (PQOF(JL,IKL) / PDP(JL,IKL) , REPSCO )
174  END DO
175  JKJ=(JK-1)*NG1P1+1
176  JKJPN=JKJ+NG1
177  DO JKK=JKJ,JKJPN
178    DO JL = KIDIA,KFDIA
179      ZDPMG = ZDPM(JL,JKK)
180      ZDPMP0 = ZDPMG / 101325._JPRB
181      ZUPMG =   ZUPM(JL,JKK) * ZDPMP0
182      ZUPMCO2 = ( ZUPM(JL,JKK) + RVGCO2 ) * ZDPMP0
183      ZUPMH2O = ( ZUPM(JL,JKK) + RVGH2O ) * ZDPMP0
184      ZUPMO3  = ( ZUPM(JL,JKK) + RVGO3  ) * ZDPMP0
185      ZDUC(JL,JKK) = ZDPMG
186      ZABLY(JL,6,JKK) = ZXOZ(JL) * ZDPMG
187      ZABLY(JL,7,JKK) = ZXOZ(JL) * ZUPMO3
188      ZU6 = ZXWV(JL) * ZUPMG
189      ZFPPW = 1.6078_JPRB * ZXWV(JL) / (1._JPRB+0.608_JPRB*ZXWV(JL))
190      ZABLY(JL,1,JKK) = ZXWV(JL) * ZUPMH2O
191      ZABLY(JL,5,JKK) = ZU6 * ZFPPW
192      ZABLY(JL,4,JKK) = ZU6 * (1._JPRB-ZFPPW)
193      ZABLY(JL,3,JKK) = PCCO2 * ZUPMCO2
194      ZABLY(JL,2,JKK) = PCCO2 * ZDPMG
195    END DO
196  END DO
197END DO
198!
199!-----------------------------------------------------------------------
200!
201!
202!*         5.    CUMULATIVE ABSORBER AMOUNTS FROM TOP OF ATMOSPHERE
203!                --------------------------------------------------
204!
205DO JA = 1, NUA
206  DO JL = KIDIA,KFDIA
207    PABCU(JL,JA,3*KLEV+1) = 0.
208  END DO
209END DO
210!
211
212DO JK = 1 , KLEV
213  JJ=(JK-1)*NG1P1+1
214  JJPN=JJ+NG1
215  IKL=KLEV+1-JK
216!
217!
218!*         5.1  CUMULATIVE AEROSOL AMOUNTS FROM TOP OF ATMOSPHERE
219!               --------------------------------------------------
220! --            NB: 'PAER' AEROSOLS ARE ENTERED FROM TOP TO BOTTOM
221!
222  JAE1=3*KLEV+1-JJ
223  JAE2=3*KLEV+1-(JJ+1)
224  JAE3=3*KLEV+1-JJPN
225  DO JAE=1,5
226    DO JL = KIDIA,KFDIA
227      ZUAER(JL,JAE) = (RAER(JAE,1)*PAER(JL, 1, JK ) &
228      &      +RAER(JAE,2)*PAER(JL, 2, JK)+RAER(JAE,3)*PAER(JL, 3, JK) &
229      &      +RAER(JAE,4)*PAER(JL, 4, JK)+RAER(JAE,5)*PAER(JL, 5, JK)) &
230      &      /(ZDUC(JL,JAE1)+ZDUC(JL,JAE2)+ZDUC(JL,JAE3))
231    END DO
232  END DO
233!
234!
235!*         5.2  INTRODUCES TEMPERATURE EFFECTS ON ABSORBER AMOUNTS
236!               --------------------------------------------------
237! --            NB: 'PT' TEMPERATURES ARE ENTERED FROM TOP TO BOTTOM
238!
239  DO JL = KIDIA,KFDIA
240 
241    ZTAVI(JL)=PT(JL,JK)
242    ZTCON(JL)=EXP(6.08_JPRB*(296._JPRB/ZTAVI(JL)-1._JPRB))
243    ZTX=ZTAVI(JL)-TREF
244    ZTX2=ZTX*ZTX
245    ZZABLY = ZABLY(JL,3,JAE1)+ZABLY(JL,3,JAE2)+ZABLY(JL,3,JAE3)
246    ZUP=MIN( MAX( 0.5_JPRB*R10E*LOG( ZZABLY ) + 5._JPRB, 0._JPRB), 6.0_JPRB)
247    ZCAH1=AT(1,1)+ZUP*(AT(1,2)+ZUP*(AT(1,3)))
248    ZCBH1=BT(1,1)+ZUP*(BT(1,2)+ZUP*(BT(1,3)))
249    ZPSH1(JL)=EXP( ZCAH1 * ZTX + ZCBH1 * ZTX2 )
250    ZCAH2=AT(2,1)+ZUP*(AT(2,2)+ZUP*(AT(2,3)))
251    ZCBH2=BT(2,1)+ZUP*(BT(2,2)+ZUP*(BT(2,3)))
252    ZPSH2(JL)=EXP( ZCAH2 * ZTX + ZCBH2 * ZTX2 )
253    ZCAH3=AT(3,1)+ZUP*(AT(3,2)+ZUP*(AT(3,3)))
254    ZCBH3=BT(3,1)+ZUP*(BT(3,2)+ZUP*(BT(3,3)))
255    ZPSH3(JL)=EXP( ZCAH3 * ZTX + ZCBH3 * ZTX2 )
256    ZCAH4=AT(4,1)+ZUP*(AT(4,2)+ZUP*(AT(4,3)))
257    ZCBH4=BT(4,1)+ZUP*(BT(4,2)+ZUP*(BT(4,3)))
258    ZPSH4(JL)=EXP( ZCAH4 * ZTX + ZCBH4 * ZTX2 )
259    ZCAH5=AT(5,1)+ZUP*(AT(5,2)+ZUP*(AT(5,3)))
260    ZCBH5=BT(5,1)+ZUP*(BT(5,2)+ZUP*(BT(5,3)))
261    ZPSH5(JL)=EXP( ZCAH5 * ZTX + ZCBH5 * ZTX2 )
262    ZCAH6=AT(6,1)+ZUP*(AT(6,2)+ZUP*(AT(6,3)))
263    ZCBH6=BT(6,1)+ZUP*(BT(6,2)+ZUP*(BT(6,3)))
264    ZPSH6(JL)=EXP( ZCAH6 * ZTX + ZCBH6 * ZTX2 )
265    ZPHM6(JL)=EXP(-5.81E-4_JPRB * ZTX - 1.13E-6 * ZTX2 )
266    ZPSM6(JL)=EXP(-5.57E-4_JPRB * ZTX - 3.30E-6 * ZTX2 )
267    ZPHN6(JL)=EXP(-3.46E-5_JPRB * ZTX + 2.05E-7 * ZTX2 )
268    ZPSN6(JL)=EXP( 3.70E-3_JPRB * ZTX - 2.30E-6 * ZTX2 )
269  END DO
270 
271!
272  DO JL = KIDIA,KFDIA
273 
274    ZTAVI(JL)=PT(JL,JK)
275    ZTX=ZTAVI(JL)-TREF
276    ZTX2=ZTX*ZTX
277    ZZABLY = ZABLY(JL,5,JAE1)+ZABLY(JL,5,JAE2)+ZABLY(JL,5,JAE3)
278    ZALUP = R10E * LOG ( ZZABLY )
279    ZUP   = MAX( 0.0_JPRB , 5.0_JPRB + 0.5_JPRB * ZALUP )
280    ZPSC2(JL) = (ZTAVI(JL)/TREF) ** ZUP
281    ZCAC8=AT(8,1)+ZUP*(AT(8,2)+ZUP*(AT(8,3)))
282    ZCBC8=BT(8,1)+ZUP*(BT(8,2)+ZUP*(BT(8,3)))
283    ZPSC3(JL)=EXP( ZCAC8 * ZTX + ZCBC8 * ZTX2 )
284    ZPHIO(JL) = EXP( OCT(1) * ZTX + OCT(2) * ZTX2)
285    ZPSIO(JL) = EXP( 2.* (OCT(3)*ZTX+OCT(4)*ZTX2))
286  END DO
287 
288
289  ICCC=2
290 
291  DO JKK=JJ,JJPN
292    JC=3*KLEV+1-JKK
293    JCP1=JC+1
294   
295    ICCC=ICCC+1
296   
297    DO JL = KIDIA,KFDIA
298      ZDIFF = PVIEW(JL)
299      PABCU(JL,10,JC)=PABCU(JL,10,JCP1)+ ZABLY(JL,4,JC)          *ZDIFF
300      PABCU(JL,11,JC)=PABCU(JL,11,JCP1)+ ZABLY(JL,5,JC)*ZTCON(JL)*ZDIFF
301!
302      PABCU(JL,12,JC)=PABCU(JL,12,JCP1)+ ZABLY(JL,6,JC)*ZPHIO(JL)*ZDIFF
303      PABCU(JL,13,JC)=PABCU(JL,13,JCP1)+ ZABLY(JL,7,JC)*ZPSIO(JL)*ZDIFF
304!
305      PABCU(JL, 7,JC)=PABCU(JL, 7,JCP1)+ ZABLY(JL,3,JC)*ZPSC2(JL)*ZDIFF
306      PABCU(JL, 8,JC)=PABCU(JL, 8,JCP1)+ ZABLY(JL,3,JC)*ZPSC3(JL)*ZDIFF
307      PABCU(JL, 9,JC)=PABCU(JL, 9,JCP1)+ ZABLY(JL,3,JC)*ZPSC3(JL)*ZDIFF
308!
309      PABCU(JL, 1,JC)=PABCU(JL, 1,JCP1)+ ZABLY(JL,1,JC)*ZPSH1(JL)*ZDIFF
310      PABCU(JL, 2,JC)=PABCU(JL, 2,JCP1)+ ZABLY(JL,1,JC)*ZPSH2(JL)*ZDIFF
311      PABCU(JL, 3,JC)=PABCU(JL, 3,JCP1)+ ZABLY(JL,1,JC)*ZPSH5(JL)*ZDIFF
312      PABCU(JL, 4,JC)=PABCU(JL, 4,JCP1)+ ZABLY(JL,1,JC)*ZPSH3(JL)*ZDIFF
313      PABCU(JL, 5,JC)=PABCU(JL, 5,JCP1)+ ZABLY(JL,1,JC)*ZPSH4(JL)*ZDIFF
314      PABCU(JL, 6,JC)=PABCU(JL, 6,JCP1)+ ZABLY(JL,1,JC)*ZPSH6(JL)*ZDIFF
315!
316      PABCU(JL,14,JC)=PABCU(JL,14,JCP1)+ ZUAER(JL,1) *ZDUC(JL,JC)*ZDIFF
317      PABCU(JL,15,JC)=PABCU(JL,15,JCP1)+ ZUAER(JL,2) *ZDUC(JL,JC)*ZDIFF
318      PABCU(JL,16,JC)=PABCU(JL,16,JCP1)+ ZUAER(JL,3) *ZDUC(JL,JC)*ZDIFF
319      PABCU(JL,17,JC)=PABCU(JL,17,JCP1)+ ZUAER(JL,4) *ZDUC(JL,JC)*ZDIFF
320      PABCU(JL,18,JC)=PABCU(JL,18,JCP1)+ ZUAER(JL,5) *ZDUC(JL,JC)*ZDIFF
321!
322      PABCU(JL,19,JC)=PABCU(JL,19,JCP1) &
323      &              +ZABLY(JL,2,JC)*RCH4/PCCO2*ZPHM6(JL)*ZDIFF
324      PABCU(JL,20,JC)=PABCU(JL,20,JCP1) &
325      &              +ZABLY(JL,3,JC)*RCH4/PCCO2*ZPSM6(JL)*ZDIFF
326      PABCU(JL,21,JC)=PABCU(JL,21,JCP1) &
327      &              +ZABLY(JL,2,JC)*RN2O/PCCO2*ZPHN6(JL)*ZDIFF
328      PABCU(JL,22,JC)=PABCU(JL,22,JCP1) &
329      &              +ZABLY(JL,3,JC)*RN2O/PCCO2*ZPSN6(JL)*ZDIFF
330!
331      PABCU(JL,23,JC)=PABCU(JL,23,JCP1) &
332      &               +ZABLY(JL,2,JC)*RCFC11/PCCO2       *ZDIFF
333      PABCU(JL,24,JC)=PABCU(JL,24,JCP1) &
334      &               +ZABLY(JL,2,JC)*RCFC12/PCCO2       *ZDIFF
335     
336    END DO
337  END DO
338!
339END DO
340
341!
342RETURN
343END SUBROUTINE OLWU
Note: See TracBrowser for help on using the repository browser.