source: LMDZ5/branches/Cold_pool_death/libf/phymar/lwttm.F90 @ 5225

Last change on this file since 5225 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: 5.7 KB
Line 
1!OPTIONS XOPT(HSFUN)
2SUBROUTINE LWTTM ( KIDIA, KFDIA, KLON, PGA  , PGB, PUU1 , PUU2 , PTT        )
3
4!**** *LWTTM* - 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!          *LWTTM* IS CALLED FROM *LWVD*
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!        97-04-18 JJ Morcrette        Revised continuum
57
58!-----------------------------------------------------------------------
59
60#include "tsmbkind.h"
61
62USE YOELW    , ONLY : NTRA     ,NUA      ,RPTYPE   ,RETYPE   ,&
63            &RO1H     ,RO2H     ,RPIALF0
64
65
66IMPLICIT NONE
67
68
69!     DUMMY INTEGER SCALARS
70INTEGER_M :: KFDIA
71INTEGER_M :: KIDIA
72INTEGER_M :: KLON
73
74
75
76!     ------------------------------------------------------------------
77
78!*        0.1   ARGUMENTS
79!               ---------
80
81REAL_B :: PUU1(KLON,NUA), PUU2(KLON,NUA), PTT(KLON,NTRA)&
82  &,  PGA(KLON,8,2) , PGB(KLON,8,2)
83
84!     LOCAL INTEGER SCALARS
85INTEGER_M :: JA, JL
86
87!     LOCAL REAL SCALARS
88REAL_B :: ZA11, ZA12, ZAERCN, ZEU, ZEU10, ZEU11, ZEU12,&
89          &ZEU13, ZODH41, ZODH42, ZODN21, ZODN22, ZPU, &
90          &ZPU10, ZPU11, ZPU12, ZPU13, ZSQ1, ZSQ2, ZSQH41, &
91          &ZSQH42, ZSQN21, ZSQN22, ZTO1, ZTO2, ZTTF11, &
92          &ZTTF12, ZUU11, ZUU12, ZUXY, ZVXY, ZX, ZXCH4, &
93          &ZXD, ZXN, ZXN2O, ZY, ZYCH4, ZYN2O, ZZ
94
95
96!     ------------------------------------------------------------------
97!DIR$ VFUNCTION SQRTHF
98
99
100!*         1.     HORNER'S ALGORITHM FOR H2O AND CO2 TRANSMISSION
101!                 -----------------------------------------------
102
103DO JA = 1 , 8
104  DO JL = KIDIA,KFDIA
105    ZZ  = SQRT(PUU1(JL,JA) - PUU2(JL,JA))
106    ZXD = PGB( JL,JA,1) + ZZ * (PGB( JL,JA,2) + ZZ )
107    ZXN = PGA( JL,JA,1) + ZZ * (PGA( JL,JA,2) )
108    PTT(JL,JA) = ZXN / ZXD
109  ENDDO
110ENDDO
111
112DO JL = KIDIA,KFDIA
113  PTT(JL,3)=MAX(PTT(JL,3),_ZERO_)
114ENDDO
115!     ------------------------------------------------------------------
116
117!*         2.     CONTINUUM, OZONE AND AEROSOL TRANSMISSION FUNCTIONS
118!                 ---------------------------------------------------
119
120DO JL = KIDIA,KFDIA
121  PTT(JL, 9) = PTT(JL, 8)
122
123!-  CONTINUUM ABSORPTION: E- AND P-TYPE
124
125  ZPU   = (PUU1(JL,10) - PUU2(JL,10))
126  ZPU10 = RPTYPE(1) * ZPU
127  ZPU11 = RPTYPE(2) * ZPU
128  ZPU12 = RPTYPE(3) * ZPU
129  ZPU13 = RPTYPE(4) * ZPU
130  ZEU   = (PUU1(JL,11) - PUU2(JL,11))
131  ZEU10 = RETYPE(1) * ZEU
132  ZEU11 = RETYPE(2) * ZEU
133  ZEU12 = RETYPE(3) * ZEU
134  ZEU13 = RETYPE(4) * ZEU
135
136!-  OZONE ABSORPTION
137
138  ZX = (PUU1(JL,12) - PUU2(JL,12))
139  ZY = (PUU1(JL,13) - PUU2(JL,13))
140  ZUXY = 4._JPRB * ZX * ZX / (RPIALF0 * ZY)
141  ZSQ1 = SQRT(_ONE_ + RO1H * ZUXY ) - _ONE_
142  ZSQ2 = SQRT(_ONE_ + RO2H * ZUXY ) - _ONE_
143  ZVXY = RPIALF0 * ZY / (_TWO_ * ZX)
144  ZAERCN = (PUU1(JL,17) -PUU2(JL,17)) + ZEU12 + ZPU12
145  ZTO1 = EXP( - ZVXY * ZSQ1 - ZAERCN )
146  ZTO2 = EXP( - ZVXY * ZSQ2 - ZAERCN )
147
148!-- TRACE GASES (CH4, N2O, CFC-11, CFC-12)
149
150!* CH4 IN INTERVAL 800-970 + 1110-1250 CM-1
151
152  ZXCH4 = (PUU1(JL,19) - PUU2(JL,19))
153  ZYCH4 = (PUU1(JL,20) - PUU2(JL,20))
154  ZUXY = 4._JPRB * ZXCH4*ZXCH4/(0.103_JPRB*ZYCH4)
155  ZSQH41 = SQRT(_ONE_ + 33.7_JPRB * ZUXY) - _ONE_
156  ZVXY = 0.103_JPRB * ZYCH4 / (_TWO_ * ZXCH4)
157  ZODH41 = ZVXY * ZSQH41
158
159!* N2O IN INTERVAL 800-970 + 1110-1250 CM-1
160
161  ZXN2O = (PUU1(JL,21) - PUU2(JL,21))
162  ZYN2O = (PUU1(JL,22) - PUU2(JL,22))
163  ZUXY = 4._JPRB * ZXN2O*ZXN2O/(0.416_JPRB*ZYN2O)
164  ZSQN21 = SQRT(_ONE_ + 21.3_JPRB * ZUXY) - _ONE_
165  ZVXY = 0.416_JPRB * ZYN2O / (_TWO_ * ZXN2O)
166  ZODN21 = ZVXY * ZSQN21
167
168!* CH4 IN INTERVAL 1250-1450 + 1880-2820 CM-1
169
170  ZUXY = 4._JPRB * ZXCH4*ZXCH4/(0.113_JPRB*ZYCH4)
171  ZSQH42 = SQRT(_ONE_ + 400._JPRB * ZUXY) - _ONE_
172  ZVXY = 0.113_JPRB * ZYCH4 / (_TWO_ * ZXCH4)
173  ZODH42 = ZVXY * ZSQH42
174
175!* N2O IN INTERVAL 1250-1450 + 1880-2820 CM-1
176
177  ZUXY = 4._JPRB * ZXN2O*ZXN2O/(0.197_JPRB*ZYN2O)
178  ZSQN22 = SQRT(_ONE_ + 2000._JPRB * ZUXY) - _ONE_
179  ZVXY = 0.197_JPRB * ZYN2O / (_TWO_ * ZXN2O)
180  ZODN22 = ZVXY * ZSQN22
181
182!* CFC-11 IN INTERVAL 800-970 + 1110-1250 CM-1
183
184  ZA11 = (PUU1(JL,23) - PUU2(JL,23)) * 4.404E+05_JPRB
185  ZTTF11 = _ONE_ - ZA11 * 0.003225_JPRB
186
187!* CFC-12 IN INTERVAL 800-970 + 1110-1250 CM-1
188
189  ZA12 = (PUU1(JL,24) - PUU2(JL,24)) * 6.7435E+05_JPRB
190  ZTTF12 = _ONE_ - ZA12 * 0.003225_JPRB
191
192  ZUU11 = - (PUU1(JL,15) - PUU2(JL,15)) - ZEU10 - ZPU10
193  ZUU12 = - (PUU1(JL,16) - PUU2(JL,16)) - ZEU11 - ZPU11 -ZODH41 - ZODN21
194  PTT(JL,10) = EXP( - (PUU1(JL,14)- PUU2(JL,14)) )
195  PTT(JL,11) = EXP( ZUU11 )
196  PTT(JL,12) = EXP( ZUU12 ) * ZTTF11 * ZTTF12
197  PTT(JL,13) = 0.7554_JPRB * ZTO1 + 0.2446_JPRB * ZTO2
198  PTT(JL,14) = PTT(JL,10) * EXP( - ZEU13 - ZPU13 )
199  PTT(JL,15) = EXP( - (PUU1(JL,14) - PUU2(JL,14)) - ZODH42-ZODN22 )
200
201ENDDO
202
203RETURN
204END SUBROUTINE LWTTM
Note: See TracBrowser for help on using the repository browser.