source: LMDZ6/branches/blowing_snow/libf/phylmd/rrtm/lwttm.F90

Last change on this file 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: 6.1 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!        EXPLICIT ARGUMENTS :
17!        --------------------
18!     ==== INPUTS ===
19! PGA, PGB                    ; PADE APPROXIMANTS
20! PUU1   : (KLON,NUA)         ; ABSORBER AMOUNTS FROM TOP TO LEVEL 1
21! PUU2   : (KLON,NUA)         ; ABSORBER AMOUNTS FROM TOP TO LEVEL 2 
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!        97-04-18 JJ Morcrette        Revised continuum
56!        M.Hamrud      01-Oct-2003 CY28 Cleaning
57
58!-----------------------------------------------------------------------
59
60USE PARKIND1  ,ONLY : JPIM     ,JPRB
61USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
62
63USE YOELW    , ONLY : NTRA     ,NUA      ,RPTYPE   ,RETYPE   ,&
64 & RO1H     ,RO2H     ,RPIALF0 
65
66IMPLICIT NONE
67
68INTEGER(KIND=JPIM),INTENT(IN)    :: KLON
69INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA
70INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA
71REAL(KIND=JPRB)   ,INTENT(IN)    :: PGA(KLON,8,2)
72REAL(KIND=JPRB)   ,INTENT(IN)    :: PGB(KLON,8,2)
73REAL(KIND=JPRB)   ,INTENT(IN)    :: PUU1(KLON,NUA)
74REAL(KIND=JPRB)   ,INTENT(IN)    :: PUU2(KLON,NUA)
75REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTT(KLON,NTRA)
76!     ------------------------------------------------------------------
77
78!*        0.1   ARGUMENTS
79!               ---------
80
81INTEGER(KIND=JPIM) :: JA, JL
82
83REAL(KIND=JPRB) :: ZA11, ZA12, ZAERCN, ZEU, ZEU10, ZEU11, ZEU12,&
84 & ZEU13, ZODH41, ZODH42, ZODN21, ZODN22, ZPU, &
85 & ZPU10, ZPU11, ZPU12, ZPU13, ZSQ1, ZSQ2, ZSQH41, &
86 & ZSQH42, ZSQN21, ZSQN22, ZTO1, ZTO2, ZTTF11, &
87 & ZTTF12, ZUU11, ZUU12, ZUXY, ZVXY, ZX, ZXCH4, &
88 & ZXD, ZXN, ZXN2O, ZY, ZYCH4, ZYN2O, ZZ 
89REAL(KIND=JPRB) :: ZHOOK_HANDLE
90
91!     ------------------------------------------------------------------
92!DIR$ VFUNCTION SQRTHF
93
94!*         1.     HORNER'S ALGORITHM FOR H2O AND CO2 TRANSMISSION
95!                 -----------------------------------------------
96
97IF (LHOOK) CALL DR_HOOK('LWTTM',0,ZHOOK_HANDLE)
98DO JA = 1 , 8
99  DO JL = KIDIA,KFDIA
100    ZZ  = SQRT(PUU1(JL,JA) - PUU2(JL,JA))
101    ZXD = PGB( JL,JA,1) + ZZ * (PGB( JL,JA,2) + ZZ )
102    ZXN = PGA( JL,JA,1) + ZZ * (PGA( JL,JA,2) )
103    PTT(JL,JA) = ZXN / ZXD
104  ENDDO
105ENDDO
106
107DO JL = KIDIA,KFDIA
108  PTT(JL,3)=MAX(PTT(JL,3),0.0_JPRB)
109ENDDO
110!     ------------------------------------------------------------------
111
112!*         2.     CONTINUUM, OZONE AND AEROSOL TRANSMISSION FUNCTIONS
113!                 ---------------------------------------------------
114
115DO JL = KIDIA,KFDIA
116  PTT(JL, 9) = PTT(JL, 8)
117
118!-  CONTINUUM ABSORPTION: E- AND P-TYPE
119
120  ZPU   = (PUU1(JL,10) - PUU2(JL,10))
121  ZPU10 = RPTYPE(1) * ZPU
122  ZPU11 = RPTYPE(2) * ZPU
123  ZPU12 = RPTYPE(3) * ZPU
124  ZPU13 = RPTYPE(4) * ZPU
125  ZEU   = (PUU1(JL,11) - PUU2(JL,11))
126  ZEU10 = RETYPE(1) * ZEU
127  ZEU11 = RETYPE(2) * ZEU
128  ZEU12 = RETYPE(3) * ZEU
129  ZEU13 = RETYPE(4) * ZEU
130
131!-  OZONE ABSORPTION
132
133  ZX = (PUU1(JL,12) - PUU2(JL,12))
134  ZY = (PUU1(JL,13) - PUU2(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 = (PUU1(JL,17) -PUU2(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 = (PUU1(JL,19) - PUU2(JL,19))
148  ZYCH4 = (PUU1(JL,20) - PUU2(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 = (PUU1(JL,21) - PUU2(JL,21))
157  ZYN2O = (PUU1(JL,22) - PUU2(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 = (PUU1(JL,23) - PUU2(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 = (PUU1(JL,24) - PUU2(JL,24)) * 6.7435E+05_JPRB
185  ZTTF12 = 1.0_JPRB - ZA12 * 0.003225_JPRB
186
187  ZUU11 = - (PUU1(JL,15) - PUU2(JL,15)) - ZEU10 - ZPU10
188  ZUU12 = - (PUU1(JL,16) - PUU2(JL,16)) - ZEU11 - ZPU11 -ZODH41 - ZODN21
189  PTT(JL,10) = EXP( - (PUU1(JL,14)- PUU2(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( - (PUU1(JL,14) - PUU2(JL,14)) - ZODH42-ZODN22 )
195
196ENDDO
197
198IF (LHOOK) CALL DR_HOOK('LWTTM',1,ZHOOK_HANDLE)
199END SUBROUTINE LWTTM
Note: See TracBrowser for help on using the repository browser.