source: LMDZ5/branches/testing/libf/phymar/lwu.F90 @ 5228

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