source: LMDZ6/branches/LMDZ_ECRad/libf/phylmd/ecrad/ifsrrtm/rrtm_taumol5.F90 @ 4771

Last change on this file since 4771 was 4728, checked in by idelkadi, 13 months ago

Update of ecrad in the LMDZ_ECRad branch of LMDZ:

  • version 1.6.1 of ecrad
  • files are no longer grouped in the same ecrad directory.
  • the structure of ecrad offline is preserved to facilitate updating in LMDZ
  • cfg.bld modified to take into account the new added subdirectories.
  • the interface routines and those added in ecrad are moved to the phylmd directory
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.