source: LMDZ6/trunk/libf/phylmd/ecrad/ifsrrtm/rrtm_taumol5.F90 @ 5450

Last change on this file since 5450 was 4773, checked in by idelkadi, 13 months ago
  • Update of Ecrad in LMDZ The same organization of the Ecrad offline version is retained in order to facilitate the updating of Ecrad in LMDZ and the comparison between online and offline results. version 1.6.1 of Ecrad (​https://github.com/lguez/ecrad.git)
  • Implementation of the double call of Ecrad in LMDZ


File size: 14.4 KB
Line 
1!----------------------------------------------------------------------------
2SUBROUTINE RRTM_TAUMOL5 (KIDIA,KFDIA,KLEV,P_TAU,P_WX,&
3 & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,P_FORFRAC,K_INDFOR,K_JP,K_JT,K_JT1,P_ONEMINUS,&
4 & P_COLH2O,P_COLCO2, P_COLO3,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC, &
5 & P_RAT_H2OCO2, P_RAT_H2OCO2_1, P_RAT_O3CO2, P_RAT_O3CO2_1,PMINORFRAC,KINDMINOR) 
6
7!     BAND 5:  700-820 cm-1 (low - H2O,CO2; high - O3,CO2)
8
9!     AUTHOR.
10!     -------
11!      JJMorcrette, ECMWF
12
13!     MODIFICATIONS.
14!     --------------
15!      M.Hamrud      01-Oct-2003 CY28 Cleaning
16!      NEC           25-Oct-2007 Optimisations
17!      JJMorcrette 20110613 flexible number of g-points
18!      ABozzo 201306 updated to rrtmg v4.85
19!      band 5:  700-820 cm-1 (low key - h2o,co2; low minor - o3, ccl4)
20!                            (high key - o3,co2)
21! ---------------------------------------------------------------------------
22
23USE PARKIND1  ,ONLY : JPIM     ,JPRB
24USE YOMHOOK   ,ONLY : LHOOK, DR_HOOK, JPHOOK
25
26USE PARRRTM  , ONLY : JPBAND ,JPXSEC
27USE YOERRTM  , ONLY : JPGPT  ,NG5    ,NGS4
28USE YOERRTWN , ONLY : NSPA   ,NSPB 
29USE YOERRTA5 , ONLY : ABSA   ,ABSB   ,CCL4   , FRACREFA, FRACREFB,SELFREF,FORREF, &
30 & KA_MO3
31USE YOERRTRF, ONLY : CHI_MLS
32
33IMPLICIT NONE
34
35INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA
36INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA
37INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV
38REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAU(KIDIA:KFDIA,JPGPT,KLEV)
39REAL(KIND=JPRB)   ,INTENT(IN)    :: P_WX(KIDIA:KFDIA,JPXSEC,KLEV) ! Amount of trace gases
40REAL(KIND=JPRB)   ,INTENT(IN)    :: P_TAUAERL(KIDIA:KFDIA,KLEV,JPBAND)
41REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC00(KIDIA:KFDIA,KLEV)
42REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC01(KIDIA:KFDIA,KLEV)
43REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC10(KIDIA:KFDIA,KLEV)
44REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC11(KIDIA:KFDIA,KLEV)
45INTEGER(KIND=JPIM),INTENT(IN)    :: K_JP(KIDIA:KFDIA,KLEV)
46INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT(KIDIA:KFDIA,KLEV)
47INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT1(KIDIA:KFDIA,KLEV)
48REAL(KIND=JPRB)   ,INTENT(IN)    :: P_ONEMINUS
49REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLH2O(KIDIA:KFDIA,KLEV)
50REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLCO2(KIDIA:KFDIA,KLEV)
51REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLO3(KIDIA:KFDIA,KLEV)
52INTEGER(KIND=JPIM),INTENT(IN)    :: K_LAYTROP(KIDIA:KFDIA)
53REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFAC(KIDIA:KFDIA,KLEV)
54REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFRAC(KIDIA:KFDIA,KLEV)
55INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDSELF(KIDIA:KFDIA,KLEV)
56REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFRAC(KIDIA:KFDIA,JPGPT,KLEV)
57
58REAL(KIND=JPRB)   ,INTENT(IN)   :: P_RAT_H2OCO2(KIDIA:KFDIA,KLEV)
59REAL(KIND=JPRB)   ,INTENT(IN)   :: P_RAT_H2OCO2_1(KIDIA:KFDIA,KLEV)
60REAL(KIND=JPRB)   ,INTENT(IN)   :: P_RAT_O3CO2(KIDIA:KFDIA,KLEV)
61REAL(KIND=JPRB)   ,INTENT(IN)   :: P_RAT_O3CO2_1(KIDIA:KFDIA,KLEV)
62INTEGER(KIND=JPIM),INTENT(IN)   :: K_INDFOR(KIDIA:KFDIA,KLEV)
63REAL(KIND=JPRB)   ,INTENT(IN)   :: P_FORFRAC(KIDIA:KFDIA,KLEV)
64REAL(KIND=JPRB)   ,INTENT(IN)   :: P_FORFAC(KIDIA:KFDIA,KLEV)
65REAL(KIND=JPRB)   ,INTENT(IN)   :: PMINORFRAC(KIDIA:KFDIA,KLEV)
66INTEGER(KIND=JPIM),INTENT(IN)   :: KINDMINOR(KIDIA:KFDIA,KLEV)
67! ---------------------------------------------------------------------------
68
69REAL(KIND=JPRB) :: Z_SPECCOMB(KLEV),Z_SPECCOMB1(KLEV), &
70& Z_SPECCOMB_MO3(KLEV), Z_SPECCOMB_PLANCK(KLEV)
71INTEGER(KIND=JPIM) :: IND0(KLEV),IND1(KLEV),INDS(KLEV),INDF(KLEV),INDM(KLEV)
72
73INTEGER(KIND=JPIM) :: IG, JS, JLAY, JS1, JPL, JMO3
74INTEGER(KIND=JPIM) :: JLON
75
76REAL(KIND=JPRB) :: Z_REFRAT_PLANCK_A, Z_REFRAT_PLANCK_B,Z_REFRAT_M_A
77
78REAL(KIND=JPRB) ::  Z_FAC000, Z_FAC100, Z_FAC200,&
79 & Z_FAC010, Z_FAC110, Z_FAC210, &
80 & Z_FAC001, Z_FAC101, Z_FAC201, &
81 & Z_FAC011, Z_FAC111, Z_FAC211
82REAL(KIND=JPRB) :: ZP, ZP4, ZFK0, ZFK1, ZFK2
83REAL(KIND=JPRB) :: ZTAUFOR,ZTAUSELF,ZTAU_MAJOR,ZTAU_MAJOR1, ZO3M1, ZO3M2, ZABSO3
84
85REAL(KIND=JPRB) :: Z_FS, Z_SPECMULT, Z_SPECPARM, &
86& Z_FS1, Z_SPECMULT1, Z_SPECPARM1, &
87& Z_FPL, Z_SPECMULT_PLANCK, Z_SPECPARM_PLANCK, &
88& Z_FMO3, Z_SPECMULT_MO3, Z_SPECPARM_MO3 
89
90REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
91
92IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL5',0,ZHOOK_HANDLE)
93
94! Minor gas mapping level :
95!     lower - o3, p = 317.34 mbar, t = 240.77 k
96!     lower - ccl4
97
98! Calculate reference ratio to be used in calculation of Planck
99! fraction in lower/upper atmosphere.
100
101! P = 473.420 mb
102      Z_REFRAT_PLANCK_A = CHI_MLS(1,5)/CHI_MLS(2,5)
103
104! P = 0.2369 mb
105      Z_REFRAT_PLANCK_B = CHI_MLS(3,43)/CHI_MLS(2,43)
106
107! P = 317.3480
108      Z_REFRAT_M_A = CHI_MLS(1,7)/CHI_MLS(2,7)
109
110!     Compute the optical depth by interpolating in ln(pressure),
111!     temperature, and appropriate species.  Below LAYTROP, the water
112!     vapor self-continuum and foreign continuum is
113!     interpolated (in temperature) separately. 
114
115DO JLAY = 1, KLEV
116  DO JLON = KIDIA, KFDIA
117    IF (JLAY <= K_LAYTROP(JLON)) THEN
118      Z_SPECCOMB(JLAY) = P_COLH2O(JLON,JLAY) + P_RAT_H2OCO2(JLON,JLAY)*P_COLCO2(JLON,JLAY)
119      Z_SPECPARM = P_COLH2O(JLON,JLAY)/Z_SPECCOMB(JLAY)
120      Z_SPECPARM=MIN(P_ONEMINUS,Z_SPECPARM)
121      Z_SPECMULT = 8._JPRB*(Z_SPECPARM)
122      JS = 1 + INT(Z_SPECMULT)
123      Z_FS = MOD(Z_SPECMULT,1.0_JPRB)
124
125      Z_SPECCOMB1(JLAY) = P_COLH2O(JLON,JLAY) + P_RAT_H2OCO2_1(JLON,JLAY)*P_COLCO2(JLON,JLAY)
126      Z_SPECPARM1 = P_COLH2O(JLON,JLAY)/Z_SPECCOMB1(JLAY)
127      IF (Z_SPECPARM1 >= P_ONEMINUS) Z_SPECPARM1 = P_ONEMINUS
128      Z_SPECMULT1 = 8._JPRB*(Z_SPECPARM1)
129      JS1 = 1 + INT(Z_SPECMULT1)
130      Z_FS1 = MOD(Z_SPECMULT1,1.0_JPRB)
131
132      Z_SPECCOMB_MO3(JLAY) = P_COLH2O(JLON,JLAY) + Z_REFRAT_M_A*P_COLCO2(JLON,JLAY)
133      Z_SPECPARM_MO3 = P_COLH2O(JLON,JLAY)/Z_SPECCOMB_MO3(JLAY)
134      IF (Z_SPECPARM_MO3 >= P_ONEMINUS) Z_SPECPARM_MO3 = P_ONEMINUS
135      Z_SPECMULT_MO3 = 8._JPRB*Z_SPECPARM_MO3
136      JMO3 = 1 + INT(Z_SPECMULT_MO3)
137      Z_FMO3 = MOD(Z_SPECMULT_MO3,1.0_JPRB)
138
139      Z_SPECCOMB_PLANCK(JLAY) = P_COLH2O(JLON,JLAY)+Z_REFRAT_PLANCK_A*P_COLCO2(JLON,JLAY)
140      Z_SPECPARM_PLANCK = P_COLH2O(JLON,JLAY)/Z_SPECCOMB_PLANCK(JLAY)
141      IF (Z_SPECPARM_PLANCK >= P_ONEMINUS) Z_SPECPARM_PLANCK=P_ONEMINUS
142      Z_SPECMULT_PLANCK = 8._JPRB*Z_SPECPARM_PLANCK
143      JPL= 1 + INT(Z_SPECMULT_PLANCK)
144      Z_FPL = MOD(Z_SPECMULT_PLANCK,1.0_JPRB)
145
146
147      IND0(JLAY) = ((K_JP(JLON,JLAY)-1)*5+(K_JT(JLON,JLAY)-1))*NSPA(5) + JS
148      IND1(JLAY) = (K_JP(JLON,JLAY)*5+(K_JT1(JLON,JLAY)-1))*NSPA(5) + JS1
149      INDS(JLAY) = K_INDSELF(JLON,JLAY)
150      INDF(JLAY) = K_INDFOR(JLON,JLAY)
151      INDM(JLAY) = KINDMINOR(JLON,JLAY)
152
153
154      IF (Z_SPECPARM < 0.125_JPRB) THEN
155            ZP = Z_FS - 1
156            ZP4 = ZP**4
157            ZFK0 = ZP4
158            ZFK1 = 1 - ZP - 2.0_JPRB*ZP4
159            ZFK2 = ZP + ZP4
160            Z_FAC000 = ZFK0*P_FAC00(JLON,JLAY)
161            Z_FAC100 = ZFK1*P_FAC00(JLON,JLAY)
162            Z_FAC200 = ZFK2*P_FAC00(JLON,JLAY)
163            Z_FAC010 = ZFK0*P_FAC10(JLON,JLAY)
164            Z_FAC110 = ZFK1*P_FAC10(JLON,JLAY)
165            Z_FAC210 = ZFK2*P_FAC10(JLON,JLAY)
166      ELSEIF (Z_SPECPARM > 0.875_JPRB) THEN
167            ZP = -Z_FS
168            ZP4 = ZP**4
169            ZFK0 = ZP4
170            ZFK1 = 1 - ZP - 2.0_JPRB*ZP4
171            ZFK2 = ZP + ZP4
172            Z_FAC000 = ZFK0*P_FAC00(JLON,JLAY)
173            Z_FAC100 = ZFK1*P_FAC00(JLON,JLAY)
174            Z_FAC200 = ZFK2*P_FAC00(JLON,JLAY)
175            Z_FAC010 = ZFK0*P_FAC10(JLON,JLAY)
176            Z_FAC110 = ZFK1*P_FAC10(JLON,JLAY)
177            Z_FAC210 = ZFK2*P_FAC10(JLON,JLAY)
178      ELSE
179            Z_FAC000 = (1._JPRB - Z_FS) * P_FAC00(JLON,JLAY)
180            Z_FAC010 = (1._JPRB - Z_FS) * P_FAC10(JLON,JLAY)
181            Z_FAC100 = Z_FS * P_FAC00(JLON,JLAY)
182            Z_FAC110 = Z_FS * P_FAC10(JLON,JLAY)
183      ENDIF
184      IF (Z_SPECPARM1 < 0.125_JPRB) THEN
185            ZP = Z_FS1 - 1
186            ZP4 = ZP**4
187            ZFK0 = ZP4
188            ZFK1 = 1 - ZP - 2.0_JPRB*ZP4
189            ZFK2 = ZP + ZP4
190            Z_FAC001 = ZFK0*P_FAC01(JLON,JLAY)
191            Z_FAC101 = ZFK1*P_FAC01(JLON,JLAY)
192            Z_FAC201 = ZFK2*P_FAC01(JLON,JLAY)
193            Z_FAC011 = ZFK0*P_FAC11(JLON,JLAY)
194            Z_FAC111 = ZFK1*P_FAC11(JLON,JLAY)
195            Z_FAC211 = ZFK2*P_FAC11(JLON,JLAY)
196      ELSEIF (Z_SPECPARM1 > 0.875_JPRB) THEN
197            ZP = -Z_FS1
198            ZP4 = ZP**4
199            ZFK0 = ZP4
200            ZFK1 = 1 - ZP - 2.0_JPRB*ZP4
201            ZFK2 = ZP + ZP4
202            Z_FAC001 = ZFK0*P_FAC01(JLON,JLAY)
203            Z_FAC101 = ZFK1*P_FAC01(JLON,JLAY)
204            Z_FAC201 = ZFK2*P_FAC01(JLON,JLAY)
205            Z_FAC011 = ZFK0*P_FAC11(JLON,JLAY)
206            Z_FAC111 = ZFK1*P_FAC11(JLON,JLAY)
207            Z_FAC211 = ZFK2*P_FAC11(JLON,JLAY)
208      ELSE
209            Z_FAC001 = (1._JPRB - Z_FS1) * P_FAC01(JLON,JLAY)
210            Z_FAC011 = (1._JPRB - Z_FS1) * P_FAC11(JLON,JLAY)
211            Z_FAC101 = Z_FS1 * P_FAC01(JLON,JLAY)
212            Z_FAC111 = Z_FS1 * P_FAC11(JLON,JLAY)
213      ENDIF
214
215
216
217!CDIR UNROLL=NG5
218      DO IG = 1, NG5
219
220         ZTAUSELF = P_SELFFAC(JLON,JLAY)* (SELFREF(INDS(JLAY),IG) + P_SELFFRAC(JLON,JLAY) * &
221            &     (SELFREF(INDS(JLAY)+1,IG) - SELFREF(INDS(JLAY),IG)))
222         ZTAUFOR = P_FORFAC(JLON,JLAY) * (FORREF(INDF(JLAY),IG) + P_FORFRAC(JLON,JLAY) * &
223            &     (FORREF(INDF(JLAY)+1,IG) - FORREF(INDF(JLAY),IG)))
224         ZO3M1 = KA_MO3(JMO3,INDM(JLAY),IG) + Z_FMO3 * &
225            &     (KA_MO3(JMO3+1,INDM(JLAY),IG) - KA_MO3(JMO3,INDM(JLAY),IG))
226         ZO3M2 = KA_MO3(JMO3,INDM(JLAY)+1,IG) + Z_FMO3 * &
227            &     (KA_MO3(JMO3+1,INDM(JLAY)+1,IG) - KA_MO3(JMO3,INDM(JLAY)+1,IG))
228         ZABSO3 = ZO3M1 + PMINORFRAC(JLON,JLAY) * (ZO3M2 - ZO3M1)
229
230
231            IF (Z_SPECPARM < 0.125_JPRB) THEN
232               ZTAU_MAJOR = Z_SPECCOMB(JLAY) * &
233                 &   (Z_FAC000 * ABSA(IND0(JLAY),IG) + &
234                 &   Z_FAC100 * ABSA(IND0(JLAY)+1,IG) + &
235                 &   Z_FAC200 * ABSA(IND0(JLAY)+2,IG) + &
236                 &   Z_FAC010 * ABSA(IND0(JLAY)+9,IG) + &
237                 &   Z_FAC110 * ABSA(IND0(JLAY)+10,IG) + &
238                 &   Z_FAC210 * ABSA(IND0(JLAY)+11,IG))
239            ELSEIF (Z_SPECPARM > 0.875_JPRB) THEN
240               ZTAU_MAJOR = Z_SPECCOMB(JLAY) * &
241                 &   (Z_FAC200 * ABSA(IND0(JLAY)-1,IG) + &
242                 &   Z_FAC100 * ABSA(IND0(JLAY),IG) + &
243                 &   Z_FAC000 * ABSA(IND0(JLAY)+1,IG) + &
244                 &   Z_FAC210 * ABSA(IND0(JLAY)+8,IG) + &
245                 &   Z_FAC110 * ABSA(IND0(JLAY)+9,IG) + &
246                 &   Z_FAC010 * ABSA(IND0(JLAY)+10,IG))
247            ELSE
248               ZTAU_MAJOR = Z_SPECCOMB(JLAY) * &
249                 &   (Z_FAC000 * ABSA(IND0(JLAY),IG) + &
250                 &   Z_FAC100 * ABSA(IND0(JLAY)+1,IG) + &
251                 &   Z_FAC010 * ABSA(IND0(JLAY)+9,IG) + &
252                 &   Z_FAC110 * ABSA(IND0(JLAY)+10,IG))
253            ENDIF
254
255            IF (Z_SPECPARM1 < 0.125_JPRB) THEN
256               ZTAU_MAJOR1 = Z_SPECCOMB1(JLAY) * &
257                 &   (Z_FAC001 * ABSA(IND1(JLAY),IG) + &
258                 &   Z_FAC101 * ABSA(IND1(JLAY)+1,IG) + &
259                 &   Z_FAC201 * ABSA(IND1(JLAY)+2,IG) + &
260                 &   Z_FAC011 * ABSA(IND1(JLAY)+9,IG) + &
261                 &   Z_FAC111 * ABSA(IND1(JLAY)+10,IG) + &
262                 &   Z_FAC211 * ABSA(IND1(JLAY)+11,IG))
263            ELSEIF (Z_SPECPARM1 > 0.875_JPRB) THEN
264               ZTAU_MAJOR1 = Z_SPECCOMB1(JLAY) * &
265                 &   (Z_FAC201 * ABSA(IND1(JLAY)-1,IG) + &
266                 &   Z_FAC101 * ABSA(IND1(JLAY),IG) + &
267                 &   Z_FAC001 * ABSA(IND1(JLAY)+1,IG) + &
268                 &   Z_FAC211 * ABSA(IND1(JLAY)+8,IG) + &
269                 &   Z_FAC111 * ABSA(IND1(JLAY)+9,IG) + &
270                 &   Z_FAC011 * ABSA(IND1(JLAY)+10,IG))
271            ELSE
272               ZTAU_MAJOR1 = Z_SPECCOMB1(JLAY) * &
273                 &   (Z_FAC001 * ABSA(IND1(JLAY),IG) +  &
274                 &   Z_FAC101 * ABSA(IND1(JLAY)+1,IG) + &
275                 &   Z_FAC011 * ABSA(IND1(JLAY)+9,IG) + &
276                 &   Z_FAC111 * ABSA(IND1(JLAY)+10,IG))
277            ENDIF
278
279
280
281        P_TAU(JLON,NGS4+IG,JLAY) = ZTAU_MAJOR + ZTAU_MAJOR1 &
282         & + ZTAUSELF + ZTAUFOR &
283         & + ZABSO3*P_COLO3(JLON,JLAY) &
284         & + P_WX(JLON,1,JLAY) * CCL4(IG)&
285         & + P_TAUAERL(JLON,JLAY,5) 
286        PFRAC(JLON,NGS4+IG,JLAY) = FRACREFA(IG,JPL) + Z_FPL *&
287         & (FRACREFA(IG,JPL+1) - FRACREFA(IG,JPL)) 
288      ENDDO
289    ENDIF
290
291    IF (JLAY > K_LAYTROP(JLON)) THEN
292      Z_SPECCOMB(JLAY) = P_COLO3(JLON,JLAY) + P_RAT_O3CO2(JLON,JLAY)*P_COLCO2(JLON,JLAY)
293      Z_SPECPARM = P_COLO3(JLON,JLAY)/Z_SPECCOMB(JLAY)
294      Z_SPECPARM=MIN(P_ONEMINUS,Z_SPECPARM)
295      Z_SPECMULT = 4._JPRB*(Z_SPECPARM)
296      JS = 1 + INT(Z_SPECMULT)
297      Z_FS = MOD(Z_SPECMULT,1.0_JPRB)
298
299      Z_SPECCOMB1(JLAY) = P_COLO3(JLON,JLAY) + P_RAT_O3CO2_1(JLON,JLAY)*P_COLCO2(JLON,JLAY)
300      Z_SPECPARM1 = P_COLO3(JLON,JLAY)/Z_SPECCOMB1(JLAY)
301      IF (Z_SPECPARM1 >= P_ONEMINUS) Z_SPECPARM1 = P_ONEMINUS
302      Z_SPECMULT1 = 4._JPRB*(Z_SPECPARM1)
303      JS1 = 1 + INT(Z_SPECMULT1)
304      Z_FS1 = MOD(Z_SPECMULT1,1.0_JPRB)
305
306      Z_FAC000 = (1._JPRB - Z_FS) * P_FAC00(JLON,JLAY)
307      Z_FAC010 = (1._JPRB - Z_FS) * P_FAC10(JLON,JLAY)
308      Z_FAC100 = Z_FS * P_FAC00(JLON,JLAY)
309      Z_FAC110 = Z_FS * P_FAC10(JLON,JLAY)
310      Z_FAC001 = (1._JPRB - Z_FS1) * P_FAC01(JLON,JLAY)
311      Z_FAC011 = (1._JPRB - Z_FS1) * P_FAC11(JLON,JLAY)
312      Z_FAC101 = Z_FS1 * P_FAC01(JLON,JLAY)
313      Z_FAC111 = Z_FS1 * P_FAC11(JLON,JLAY)
314
315      Z_SPECCOMB_PLANCK(JLAY) = P_COLO3(JLON,JLAY)+Z_REFRAT_PLANCK_B*P_COLCO2(JLON,JLAY)
316      Z_SPECPARM_PLANCK = P_COLO3(JLON,JLAY)/Z_SPECCOMB_PLANCK(JLAY)
317      IF (Z_SPECPARM_PLANCK >= P_ONEMINUS) Z_SPECPARM_PLANCK=P_ONEMINUS
318      Z_SPECMULT_PLANCK = 4._JPRB*Z_SPECPARM_PLANCK
319      JPL= 1 + INT(Z_SPECMULT_PLANCK)
320      Z_FPL = MOD(Z_SPECMULT_PLANCK,1.0_JPRB)
321
322
323      IND0(JLAY) = ((K_JP(JLON,JLAY)-13)*5+(K_JT(JLON,JLAY)-1))*NSPB(5) + JS
324      IND1(JLAY) = ((K_JP(JLON,JLAY)-12)*5+(K_JT1(JLON,JLAY)-1))*NSPB(5) + JS1
325
326
327
328!CDIR UNROLL=NG5
329      DO IG = 1, NG5
330!-- DS_000515
331        P_TAU(JLON,NGS4+IG,JLAY) = Z_SPECCOMB(JLAY) *   &
332         &(Z_FAC000 * ABSB(IND0(JLAY)  ,IG) +&
333         & Z_FAC100 * ABSB(IND0(JLAY)+1,IG) +&
334         & Z_FAC010 * ABSB(IND0(JLAY)+5,IG) +&
335         & Z_FAC110 * ABSB(IND0(JLAY)+6,IG)) +&
336         & Z_SPECCOMB1(JLAY) * &
337         & (Z_FAC001 * ABSB(IND1(JLAY)  ,IG) +&
338         & Z_FAC101 * ABSB(IND1(JLAY)+1,IG) +&
339         & Z_FAC011 * ABSB(IND1(JLAY)+5,IG) +&
340         & Z_FAC111 * ABSB(IND1(JLAY)+6,IG))+&
341         & P_WX(JLON,1,JLAY) * CCL4(IG)+&
342         & P_TAUAERL(JLON,JLAY,5) 
343        PFRAC(JLON,NGS4+IG,JLAY) = FRACREFB(IG,JPL) + Z_FPL *&
344         & (FRACREFB(IG,JPL+1) - FRACREFB(IG,JPL)) 
345      ENDDO
346    ENDIF
347  ENDDO
348ENDDO
349
350IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL5',1,ZHOOK_HANDLE)
351
352END SUBROUTINE RRTM_TAUMOL5
Note: See TracBrowser for help on using the repository browser.