source: LMDZ6/branches/LMDZ-COSP/libf/phylmd/rrtm/lwtt.F90 @ 3847

Last change on this file since 3847 was 1990, checked in by Laurent Fairhead, 11 years ago

Corrections à la version r1989 pour permettre la compilation avec RRTM
Inclusion de la licence CeCILL_V2 pour RRTM


Changes to revision r1989 to enable RRTM code compilation
RRTM part put under CeCILL_V2 licence

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
File size: 5.9 KB
Line 
1!OPTIONS XOPT(HSFUN)
2SUBROUTINE LWTT ( 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!        EXPLICIT ARGUMENTS :
17!        --------------------
18!     ==== INPUTS ===
19! KND    :                    ; WEIGHTING INDEX
20! PUU    : (KLON,NUA)         ; ABSORBER AMOUNTS
21!     ==== OUTPUTS ===
22! PTT    : (KLON,NTRA)        ; TRANSMISSION FUNCTIONS
23
24!        IMPLICIT ARGUMENTS :   NONE
25!        --------------------
26
27!     METHOD.
28!     -------
29
30!          1. TRANSMISSION FUNCTION BY H2O AND UNIFORMLY MIXED GASES ARE
31!     COMPUTED USING PADE APPROXIMANTS AND HORNER'S ALGORITHM.
32!          2. TRANSMISSION BY O3 IS EVALUATED WITH MALKMUS'S BAND MODEL.
33!          3. TRANSMISSION BY H2O CONTINUUM AND AEROSOLS FOLLOW AN
34!     A SIMPLE EXPONENTIAL DECREASE WITH ABSORBER AMOUNT.
35
36!     EXTERNALS.
37!     ----------
38
39!          NONE
40
41!     REFERENCE.
42!     ----------
43
44!        SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
45!        ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
46
47!     AUTHOR.
48!     -------
49!        JEAN-JACQUES MORCRETTE  *ECMWF*
50
51!     MODIFICATIONS.
52!     --------------
53!        ORIGINAL : 88-12-15
54!        97-04-18  JJ Morcrette        Revised continuum
55!        M.Hamrud      01-Oct-2003 CY28 Cleaning
56   
57!-----------------------------------------------------------------------
58
59USE PARKIND1  ,ONLY : JPIM     ,JPRB
60USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
61
62USE YOELW    , ONLY : NTRA     ,NUA      ,RPTYPE   ,RETYPE   ,&
63 & RO1H     ,RO2H     ,RPIALF0 
64
65IMPLICIT NONE
66
67INTEGER(KIND=JPIM),INTENT(IN)    :: KLON
68INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA
69INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA
70REAL(KIND=JPRB)   ,INTENT(IN)    :: PGA(KLON,8,2)
71REAL(KIND=JPRB)   ,INTENT(IN)    :: PGB(KLON,8,2)
72REAL(KIND=JPRB)   ,INTENT(IN)    :: PUU(KLON,NUA)
73REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTT(KLON,NTRA)
74!     ------------------------------------------------------------------
75
76!*        0.1   ARGUMENTS
77!               ---------
78
79INTEGER(KIND=JPIM) :: JA, JL
80
81REAL(KIND=JPRB) :: ZA11, ZA12, ZAERCN, ZEU10, ZEU11, ZEU12,&
82 & ZEU13, ZODH41, ZODH42, ZODN21, ZODN22, ZPU10, &
83 & ZPU11, ZPU12, ZPU13, ZSQ1, ZSQ2, ZSQH41, &
84 & ZSQH42, ZSQN21, ZSQN22, ZTO1, ZTO2, ZTTF11, &
85 & ZTTF12, ZUU11, ZUU12, ZUXY, ZVXY, ZX, ZXCH4, &
86 & ZXD, ZXN, ZXN2O, ZY, ZYCH4, ZYN2O, ZZ 
87REAL(KIND=JPRB) :: ZHOOK_HANDLE
88
89!     ------------------------------------------------------------------
90
91!               ------------
92
93!     ------------------------------------------------------------------
94!DIR$ VFUNCTION SQRTHF
95
96!*         1.     HORNER'S ALGORITHM FOR H2O AND CO2 TRANSMISSION
97!                 -----------------------------------------------
98
99IF (LHOOK) CALL DR_HOOK('LWTT',0,ZHOOK_HANDLE)
100DO JA = 1 , 8
101  DO JL = KIDIA,KFDIA
102    ZZ  = SQRT(PUU(JL,JA))
103    ZXD = PGB( JL,JA,1) + ZZ* (PGB( JL,JA,2) + ZZ )
104    ZXN = PGA( JL,JA,1) + ZZ* (PGA( JL,JA,2)      )
105    PTT(JL,JA) = ZXN / ZXD
106  ENDDO
107ENDDO
108
109DO JL = KIDIA,KFDIA
110  PTT(JL,3)=MAX(PTT(JL,3),0.0_JPRB)
111ENDDO
112!     ------------------------------------------------------------------
113
114!*         2.     CONTINUUM, OZONE AND AEROSOL TRANSMISSION FUNCTIONS
115!                 ---------------------------------------------------
116
117DO JL = KIDIA,KFDIA
118  PTT(JL, 9) = PTT(JL, 8)
119
120!-  CONTINUUM ABSORPTION: E- AND P-TYPE (from Giorgetta and Wild, 1997)
121
122  ZPU10 = RPTYPE(1) * PUU(JL,10)
123  ZPU11 = RPTYPE(2) * PUU(JL,10)
124  ZPU12 = RPTYPE(3) * PUU(JL,10)
125  ZPU13 = RPTYPE(4) * PUU(JL,10)
126  ZEU10 = RETYPE(1) * PUU(JL,11)
127  ZEU11 = RETYPE(2) * PUU(JL,11)
128  ZEU12 = RETYPE(3) * PUU(JL,11)
129  ZEU13 = RETYPE(4) * PUU(JL,11)
130
131!-  OZONE ABSORPTION
132
133  ZX = PUU(JL,12)
134  ZY = PUU(JL,13)
135  ZUXY = 4._JPRB * ZX * ZX / (RPIALF0 * ZY)
136  ZSQ1 = SQRT(1.0_JPRB + RO1H * ZUXY ) - 1.0_JPRB
137  ZSQ2 = SQRT(1.0_JPRB + RO2H * ZUXY ) - 1.0_JPRB
138  ZVXY = RPIALF0 * ZY / (2.0_JPRB * ZX)
139  ZAERCN = PUU(JL,17) + ZEU12 + ZPU12
140  ZTO1 = EXP( - ZVXY * ZSQ1 - ZAERCN )
141  ZTO2 = EXP( - ZVXY * ZSQ2 - ZAERCN )
142
143!-- TRACE GASES (CH4, N2O, CFC-11, CFC-12)
144
145!* CH4 IN INTERVAL 800-970 + 1110-1250 CM-1
146
147  ZXCH4 = PUU(JL,19)
148  ZYCH4 = PUU(JL,20)
149  ZUXY = 4._JPRB * ZXCH4*ZXCH4/(0.103_JPRB*ZYCH4)
150  ZSQH41 = SQRT(1.0_JPRB + 33.7_JPRB * ZUXY) - 1.0_JPRB
151  ZVXY = 0.103_JPRB * ZYCH4 / (2.0_JPRB * ZXCH4)
152  ZODH41 = ZVXY * ZSQH41
153
154!* N2O IN INTERVAL 800-970 + 1110-1250 CM-1
155
156  ZXN2O = PUU(JL,21)
157  ZYN2O = PUU(JL,22)
158  ZUXY = 4._JPRB * ZXN2O*ZXN2O/(0.416_JPRB*ZYN2O)
159  ZSQN21 = SQRT(1.0_JPRB + 21.3_JPRB * ZUXY) - 1.0_JPRB
160  ZVXY = 0.416_JPRB * ZYN2O / (2.0_JPRB * ZXN2O)
161  ZODN21 = ZVXY * ZSQN21
162
163!* CH4 IN INTERVAL 1250-1450 + 1880-2820 CM-1
164
165  ZUXY = 4._JPRB * ZXCH4*ZXCH4/(0.113_JPRB*ZYCH4)
166  ZSQH42 = SQRT(1.0_JPRB + 400._JPRB * ZUXY) - 1.0_JPRB
167  ZVXY = 0.113_JPRB * ZYCH4 / (2.0_JPRB * ZXCH4)
168  ZODH42 = ZVXY * ZSQH42
169
170!* N2O IN INTERVAL 1250-1450 + 1880-2820 CM-1
171
172  ZUXY = 4._JPRB * ZXN2O*ZXN2O/(0.197_JPRB*ZYN2O)
173  ZSQN22 = SQRT(1.0_JPRB + 2000._JPRB * ZUXY) - 1.0_JPRB
174  ZVXY = 0.197_JPRB * ZYN2O / (2.0_JPRB * ZXN2O)
175  ZODN22 = ZVXY * ZSQN22
176
177!* CFC-11 IN INTERVAL 800-970 + 1110-1250 CM-1
178
179  ZA11 = 2.0_JPRB * PUU(JL,23) * 4.404E+05_JPRB
180  ZTTF11 = 1.0_JPRB - ZA11 * 0.003225_JPRB
181
182!* CFC-12 IN INTERVAL 800-970 + 1110-1250 CM-1
183
184  ZA12 = 2.0_JPRB * PUU(JL,24) * 6.7435E+05_JPRB
185  ZTTF12 = 1.0_JPRB - ZA12 * 0.003225_JPRB
186
187  ZUU11 = - PUU(JL,15) - ZEU10 - ZPU10
188  ZUU12 = - PUU(JL,16) - ZEU11 - ZPU11 - ZODH41 - ZODN21
189  PTT(JL,10) = EXP( - PUU(JL,14) )
190  PTT(JL,11) = EXP( ZUU11 )
191  PTT(JL,12) = EXP( ZUU12 ) * ZTTF11 * ZTTF12
192  PTT(JL,13) = 0.7554_JPRB * ZTO1 + 0.2446_JPRB * ZTO2
193  PTT(JL,14) = PTT(JL,10) * EXP( - ZEU13 - ZPU13 )
194  PTT(JL,15) = EXP ( - PUU(JL,14) - ZODH42 - ZODN22 )
195
196ENDDO
197
198IF (LHOOK) CALL DR_HOOK('LWTT',1,ZHOOK_HANDLE)
199END SUBROUTINE LWTT
Note: See TracBrowser for help on using the repository browser.