source: LMDZ5/trunk/libf/phymar/olwtt.F90 @ 5440

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

Inclusion de la physique de MAR


Integration of MAR physics

File size: 7.1 KB
Line 
1!OPTIONS XOPT(HSFUN)
2SUBROUTINE OLWTT (KIDIA,KFDIA,KLON, PGA,PGB,PUU, PTT)
3!
4!**** *LWTT* - LONGWAVE TRANSMISSION FUNCTIONS
5!
6!     PURPOSE.
7!     --------
8!           THIS ROUTINE COMPUTES THE TRANSMISSION FUNCTIONS FOR ALL THE
9!     ABSORBERS (H2O, UNIFORMLY MIXED GASES, AND O3) IN ALL SIX SPECTRAL
10!     INTERVALS.
11!
12!**   INTERFACE.
13!     ----------
14!          *LWTT* IS CALLED FROM *LWVN*, *LWVD*, *LWVB*
15!
16!
17!        EXPLICIT ARGUMENTS :
18!        --------------------
19!     ==== INPUTS ===
20! KND    :                     ; WEIGHTING INDEX
21! PUU    : (KLON,NUA)         ; ABSORBER AMOUNTS
22!     ==== OUTPUTS ===
23! PTT    : (KLON,NTRA)        ; TRANSMISSION FUNCTIONS
24!
25!        IMPLICIT ARGUMENTS :   NONE
26!        --------------------
27!
28!     METHOD.
29!     -------
30!
31!          1. TRANSMISSION FUNCTION BY H2O AND UNIFORMLY MIXED GASES ARE
32!     COMPUTED USING PADE APPROXIMANTS AND HORNER'S ALGORITHM.
33!          2. TRANSMISSION BY O3 IS EVALUATED WITH MALKMUS'S BAND MODEL.
34!          3. TRANSMISSION BY H2O CONTINUUM AND AEROSOLS FOLLOW AN
35!     A SIMPLE EXPONENTIAL DECREASE WITH ABSORBER AMOUNT.
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 : 88-12-15
55!
56!-----------------------------------------------------------------------
57!      IMPLICIT LOGICAL (L)
58!
59!#include "yoelw.h"
60!#include "yoerad.h"
61!#include "yoerdu.h"
62
63#include "tsmbkind.h"
64
65USE YOEOLW   , ONLY : NTRA     ,NUA      ,&
66            & O1H     , O2H     ,RPIALF0
67
68
69IMPLICIT NONE
70
71
72!     DUMMY INTEGER SCALARS
73INTEGER_M :: KFDIA
74INTEGER_M :: KIDIA
75INTEGER_M :: KLON
76
77!     ------------------------------------------------------------------
78!
79!*        0.1   ARGUMENTS
80!               ---------
81!
82REAL_B :: PUU(KLON,NUA), PTT(KLON,NTRA) &
83     &  ,  PGA(KLON,8,2), PGB(KLON,8,2)
84!
85!     ------------------------------------------------------------------
86!
87!*        0.2   LOCAL ARRAYS
88!               ------------
89!
90!     REAL ZXN(KLON,8),ZXD(KLON,8),ZZ(KLON,8)
91
92!     LOCAL INTEGER SCALARS
93INTEGER_M :: JA, JL
94
95!     LOCAL REAL SCALARS
96REAL_B :: ZA11, ZA12, ZAERCN, ZEU, ZEU10, ZEU11, ZEU12,&
97          &ZEU13, ZODH41, ZODH42, ZODN21, ZODN22, ZPU, ZPU10, &
98          &ZPU11, ZPU12, ZPU13, ZSQ1, ZSQ2, ZSQH41, &
99          &ZSQH42, ZSQN21, ZSQN22, ZTO1, ZTO2, ZTTF11, &
100          &ZTTF12, ZUU11, ZUU12, ZUXY, ZVXY, ZX, ZXCH4, &
101          &ZXD, ZXN, ZXN2O, ZY, ZYCH4, ZYN2O, ZZ
102
103!     ------------------------------------------------------------------
104!#!DIR$ VFUNCTION SQRTHF
105!
106!*         1.     HORNER'S ALGORITHM FOR H2O AND CO2 TRANSMISSION
107!                 -----------------------------------------------
108!
109DO JA = 1 , 8
110  DO JL = KIDIA,KFDIA
111    ZZ      =SQRT(PUU(JL,JA))
112!    ZXD(JL,1)=PGB( JL, 1,1) + ZZ(JL, 1)*(PGB( JL, 1,2) + ZZ(JL, 1))
113!    ZXN(JL,1)=PGA( JL, 1,1) + ZZ(JL, 1)*(PGA( JL, 1,2) )
114!    PTT(JL,1)=ZXN(JL,1)/ZXD(JL,1)
115    ZXD      =PGB( JL,JA,1) + ZZ       *(PGB( JL,JA,2) + ZZ       )
116    ZXN      =PGA( JL,JA,1) + ZZ       *(PGA( JL,JA,2) )
117    PTT(JL,JA)=ZXN      /ZXD
118  END DO
119END DO
120!
121!     ------------------------------------------------------------------
122!
123!*         2.     CONTINUUM, OZONE AND AEROSOL TRANSMISSION FUNCTIONS
124!                 ---------------------------------------------------
125!
126DO JL = KIDIA,KFDIA
127  PTT(JL, 9) = PTT(JL, 8)
128!
129!-  CONTINUUM ABSORPTION: E- AND P-TYPE
130!
131!-   13     350-500 cm-1
132!-   10     500-800 cm-1
133!-   11     800-970 + 1110-1250 cm-1
134!-   12     970-1110 cm-1
135!
136!  IF (INWCONT.EQ.0) THEN
137!- original ECMWF 16r1 coefficients     
138    ZPU   = 0.002 * PUU(JL,10)
139    ZPU10 = 112. * ZPU
140    ZPU11 = 6.25 * ZPU
141    ZPU12 = 5.00 * ZPU
142    ZPU13 = 80.0 * ZPU
143    ZEU   =  PUU(JL,11)
144    ZEU10 =  12. * ZEU
145    ZEU11 = 6.25 * ZEU
146    ZEU12 = 5.00 * ZEU
147    ZEU13 = 80.0 * ZEU
148!  ELSE IF (INWCONT.EQ.1) THEN
149!- coefficients proposed by Giorgetta and Wild
150!    ZPU10 =  0.8109 * PUU(JL,10)
151!    ZPU11 =  0.0208 * PUU(JL,10)
152!    ZPU12 =  0.0106 * PUU(JL,10)
153!    ZPU13 = 12.331  * PUU(JL,10)
154!    ZEU10 =   47.7  * PUU(JL,11)
155!    ZEU11 =    8.31 * PUU(JL,11)
156!    ZEU12 =    5.87 * PUU(JL,11)
157!    ZEU13 =   209.  * PUU(JL,11)
158!  ELSE IF (INWCONT.EQ.2) THEN
159!- coefficients adjusted from Clough CKD22
160!c   ZPU10 =  0.00488 * 81.63 * PUU(JL,10)
161!c   ZPU11 =  0.00022 *  8.43 * PUU(JL,10)
162!c   ZPU12 =  0.00001 *  5.08 * PUU(JL,10)
163!c   ZPU13 =  0.03638 * 721.8 * PUU(JL,10)
164!    ZPU10 =  0.3981  * PUU(JL,10)
165!    ZPU10 =  0.18    * PUU(JL,10)
166!    ZPU11 =  0.00127 * PUU(JL,10)
167!    ZPU12 =  0.00071 * PUU(JL,10)
168!    ZPU13 =  26.26   * PUU(JL,10)
169!         
170!!    ZEU10 =   81.63  * PUU(JL,11)
171!    ZEU10 =   18.    * PUU(JL,11)
172!    ZEU11 =    8.43  * PUU(JL,11)
173!    ZEU12 =    5.08  * PUU(JL,11)
174!    ZEU13 =   721.8  * PUU(JL,11)
175!  END IF   
176!
177!  IF (LNOCONT) THEN
178!    ZPU10 = 0.
179!    ZPU11 = 0.
180!    ZPU12 = 0.
181!    ZPU13 = 0.
182!
183!    ZEU10 = 0.
184!    ZEU11 = 0.
185!    ZEU12 = 0.
186!    ZEU13 = 0.
187!  END IF
188!
189!-  OZONE ABSORPTION
190!
191  ZX = PUU(JL,12)
192  ZY = PUU(JL,13)
193  ZUXY = 4. * ZX * ZX / (RPIALF0 * ZY)
194  ZSQ1 = SQRT(1. + O1H * ZUXY ) - 1.
195  ZSQ2 = SQRT(1. + O2H * ZUXY ) - 1.
196  ZVXY = RPIALF0 * ZY / (2. * ZX)
197  ZAERCN = PUU(JL,17) + ZEU12 + ZPU12
198  ZTO1 = EXP( - ZVXY * ZSQ1 - ZAERCN )
199  ZTO2 = EXP( - ZVXY * ZSQ2 - ZAERCN )
200     
201!  IF (LNOOZON) THEN
202!    ZTO1 = EXP( - ZAERCN )
203!    ZTO2 = EXP( - ZAERCN )
204!  END IF
205!
206!-- TRACE GASES (CH4, N2O, CFC-11, CFC-12)
207!
208!* CH4 IN INTERVAL 800-970 + 1110-1250 CM-1
209!
210  ZXCH4 = PUU(JL,19)
211  ZYCH4 = PUU(JL,20)
212  ZUXY = 4. * ZXCH4*ZXCH4/(0.103*ZYCH4)
213  ZSQH41 = SQRT(1. + 33.7 * ZUXY) - 1.
214  ZVXY = 0.103 * ZYCH4 / (2. * ZXCH4)
215  ZODH41 = ZVXY * ZSQH41
216!
217!* N2O IN INTERVAL 800-970 + 1110-1250 CM-1
218!
219  ZXN2O = PUU(JL,21)
220  ZYN2O = PUU(JL,22)
221  ZUXY = 4. * ZXN2O*ZXN2O/(0.416*ZYN2O)
222  ZSQN21 = SQRT(1. + 21.3 * ZUXY) - 1.
223  ZVXY = 0.416 * ZYN2O / (2. * ZXN2O)
224  ZODN21 = ZVXY * ZSQN21
225
226!* CH4 IN INTERVAL 1250-1450 + 1880-2820 CM-1
227!
228  ZUXY = 4. * ZXCH4*ZXCH4/(0.113*ZYCH4)
229  ZSQH42 = SQRT(1. + 400. * ZUXY) - 1.
230  ZVXY = 0.113 * ZYCH4 / (2. * ZXCH4)
231  ZODH42 = ZVXY * ZSQH42
232!
233!* N2O IN INTERVAL 1250-1450 + 1880-2820 CM-1
234!
235  ZUXY = 4. * ZXN2O*ZXN2O/(0.197*ZYN2O)
236  ZSQN22 = SQRT(1. + 2000. * ZUXY) - 1.
237  ZVXY = 0.197 * ZYN2O / (2. * ZXN2O)
238  ZODN22 = ZVXY * ZSQN22
239!
240!* CFC-11 IN INTERVAL 800-970 + 1110-1250 CM-1
241!
242  ZA11 = 2. * PUU(JL,23) * 4.404E+05
243  ZTTF11 = 1. - ZA11 * 0.003225
244!
245!* CFC-12 IN INTERVAL 800-970 + 1110-1250 CM-1
246!
247  ZA12 = 2. * PUU(JL,24) * 6.7435E+05
248  ZTTF12 = 1. - ZA12 * 0.003225
249!
250     
251!  IF (LNOUMG) THEN
252!    PTT(JL,7) = 1.
253!    PTT(JL,8) = 1.
254!    PTT(JL,9) = 1.
255!    ZODH41 = 0.
256!    ZODH42 = 0.
257!    ZODN21 = 0.
258!    ZODN22 = 0.
259!    ZTTF11 = 1.
260!    ZTTF12 = 1.
261!  END IF 
262       
263  ZUU11 = - PUU(JL,15) - ZEU10 - ZPU10
264  ZUU12 = - PUU(JL,16) - ZEU11 - ZPU11 - ZODH41 - ZODN21
265  PTT(JL,10) = EXP( - PUU(JL,14) )
266  PTT(JL,11) = EXP( ZUU11 )
267  PTT(JL,12) = EXP( ZUU12 ) * ZTTF11 * ZTTF12
268  PTT(JL,13) = 0.7554 * ZTO1 + 0.2446 * ZTO2
269  PTT(JL,14) = PTT(JL,10) * EXP( - ZEU13 - ZPU13 )
270  PTT(JL,15) = EXP ( - PUU(JL,14) - ZODH42 - ZODN22 )
271END DO
272!
273RETURN
274END SUBROUTINE OLWTT
Note: See TracBrowser for help on using the repository browser.