source: LMDZ5/branches/IPSLCM5A2.1_ISO/libf/phymar/olwttm.F90 @ 5452

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