source: LMDZ6/branches/Amaury_dev/libf/phylmd/ecrad/ifsrrtm/rrtm_taumol13.F90

Last change on this file was 4773, checked in by idelkadi, 11 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.1 KB
Line 
1!----------------------------------------------------------------------------
2SUBROUTINE RRTM_TAUMOL13 (KIDIA,KFDIA,KLEV,P_TAU,&
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_COLN2O,P_COLCO2,P_COLO3,P_COLDRY,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC, &
5 & PRAT_H2ON2O, PRAT_H2ON2O_1,PMINORFRAC,KINDMINOR) 
6
7!     BAND 13:  2080-2250 cm-1 (low - H2O,N2O; high - nothing)
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 13:  2080-2250 cm-1 (low key - h2o,n2o; high minor - o3 minor)
20! ---------------------------------------------------------------------------
21
22USE PARKIND1  ,ONLY : JPIM     ,JPRB
23USE YOMHOOK   ,ONLY : LHOOK, DR_HOOK, JPHOOK
24
25USE PARRRTM  , ONLY : JPBAND
26USE YOERRTM  , ONLY : JPGPT  ,NG13  ,NGS12
27USE YOERRTWN , ONLY : NSPA   
28USE YOERRTA13, ONLY : ABSA   ,FRACREFA,FRACREFB,SELFREF,FORREF,KA_MCO2, KA_MCO, KB_MO3
29USE YOERRTRF, ONLY : CHI_MLS
30
31IMPLICIT NONE
32
33INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA
34INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA
35INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV
36REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAU(KIDIA:KFDIA,JPGPT,KLEV)
37REAL(KIND=JPRB)   ,INTENT(IN)    :: P_TAUAERL(KIDIA:KFDIA,KLEV,JPBAND)
38REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC00(KIDIA:KFDIA,KLEV)
39REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC01(KIDIA:KFDIA,KLEV)
40REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC10(KIDIA:KFDIA,KLEV)
41REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC11(KIDIA:KFDIA,KLEV)
42INTEGER(KIND=JPIM),INTENT(IN)    :: K_JP(KIDIA:KFDIA,KLEV)
43INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT(KIDIA:KFDIA,KLEV)
44INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT1(KIDIA:KFDIA,KLEV)
45REAL(KIND=JPRB)   ,INTENT(IN)    :: P_ONEMINUS
46REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLH2O(KIDIA:KFDIA,KLEV)
47REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLN2O(KIDIA:KFDIA,KLEV)
48REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLCO2(KIDIA:KFDIA,KLEV)
49REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLO3(KIDIA:KFDIA,KLEV)
50REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLDRY(KIDIA:KFDIA,KLEV)
51INTEGER(KIND=JPIM),INTENT(IN)    :: K_LAYTROP(KIDIA:KFDIA)
52REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFAC(KIDIA:KFDIA,KLEV)
53REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFRAC(KIDIA:KFDIA,KLEV)
54INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDSELF(KIDIA:KFDIA,KLEV)
55REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFRAC(KIDIA:KFDIA,JPGPT,KLEV)
56
57REAL(KIND=JPRB)   ,INTENT(IN)   :: PRAT_H2ON2O(KIDIA:KFDIA,KLEV)
58REAL(KIND=JPRB)   ,INTENT(IN)   :: PRAT_H2ON2O_1(KIDIA:KFDIA,KLEV)
59INTEGER(KIND=JPIM),INTENT(IN)   :: K_INDFOR(KIDIA:KFDIA,KLEV)
60REAL(KIND=JPRB)   ,INTENT(IN)   :: P_FORFAC(KIDIA:KFDIA,KLEV)
61REAL(KIND=JPRB)   ,INTENT(IN)   :: P_FORFRAC(KIDIA:KFDIA,KLEV)
62REAL(KIND=JPRB)   ,INTENT(IN)   :: PMINORFRAC(KIDIA:KFDIA,KLEV)
63INTEGER(KIND=JPIM),INTENT(IN)   :: KINDMINOR(KIDIA:KFDIA,KLEV)
64
65! ---------------------------------------------------------------------------
66
67
68REAL(KIND=JPRB) :: Z_SPECCOMB(KLEV),Z_SPECCOMB1(KLEV), Z_SPECCOMB_PLANCK(KLEV), &
69                   & Z_SPECCOMB_MCO2(KLEV), Z_SPECCOMB_MCO(KLEV)
70INTEGER(KIND=JPIM) :: IND0(KLEV),IND1(KLEV),INDS(KLEV),INDF(KLEV),INDM(KLEV)
71INTEGER(KIND=JPIM) :: IG, JS, JLAY, JS1, JPL, JMCO2, JMCO
72INTEGER(KIND=JPIM) :: JLON
73
74REAL(KIND=JPRB) :: ZREFRAT_PLANCK_A, ZREFRAT_M_A, ZREFRAT_M_A3
75REAL(KIND=JPRB) ::  Z_FAC000, Z_FAC100, Z_FAC200,&
76 & Z_FAC010, Z_FAC110, Z_FAC210, &
77 & Z_FAC001, Z_FAC101, Z_FAC201, &
78 & Z_FAC011, Z_FAC111, Z_FAC211
79REAL(KIND=JPRB) :: ZP, ZP4, ZFK0, ZFK1, ZFK2
80
81REAL(KIND=JPRB) :: ZTAUFOR,ZTAUSELF,ZTAU_MAJOR,ZTAU_MAJOR1, ZCO2M1, ZCO2M2, ZABSCO2
82REAL(KIND=JPRB) :: ZCOM1, ZCOM2, ZABSCO, ZABSO3
83REAL(KIND=JPRB) :: ZCHI_CO2, ZRATCO2, ZADJFAC, ZADJCOLCO2(KIDIA:KFDIA,KLEV)
84
85REAL(KIND=JPRB) :: Z_FS, Z_SPECMULT, Z_SPECPARM,  &
86& Z_FS1, Z_SPECMULT1, Z_SPECPARM1, &
87& Z_FMCO2, Z_SPECMULT_MCO2, Z_SPECPARM_MCO2, &
88& Z_FMCO , Z_SPECMULT_MCO , Z_SPECPARM_MCO , &
89& Z_FPL, Z_SPECMULT_PLANCK, Z_SPECPARM_PLANCK
90
91REAL(KIND=JPRB)   :: Z_COLCO(KIDIA:KFDIA,KLEV) !left =0 for now,not passed from rrtm_gasbas1a
92
93REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
94
95 
96ASSOCIATE(NFLEVG=>KLEV)
97IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL13',0,ZHOOK_HANDLE)
98
99! Minor gas mapping levels :
100!     lower - co2, p = 1053.63 mb, t = 294.2 k
101!     lower - co, p = 706 mb, t = 278.94 k
102!     upper - o3, p = 95.5835 mb, t = 215.7 k
103
104
105! Calculate reference ratio to be used in calculation of Planck
106! fraction in lower/upper atmosphere.
107
108! P = 473.420 mb (Level 5)
109      ZREFRAT_PLANCK_A = CHI_MLS(1,5)/CHI_MLS(4,5)
110
111! P = 1053. (Level 1)
112      ZREFRAT_M_A = CHI_MLS(1,1)/CHI_MLS(4,1)
113
114! P = 706. (Level 3)
115      ZREFRAT_M_A3 = CHI_MLS(1,3)/CHI_MLS(4,3)
116
117! Compute the optical depth by interpolating in ln(pressure),
118! temperature, and appropriate species.  Below laytrop, the water
119! vapor self-continuum and foreign continuum is interpolated
120! (in temperature) separately. 
121
122
123DO JLAY = 1, KLEV
124  DO JLON = KIDIA, KFDIA
125    Z_COLCO(JLON,JLAY) = 0.0_JPRB
126    IF (JLAY <= K_LAYTROP(JLON)) THEN
127      Z_SPECCOMB(JLAY) = P_COLH2O(JLON,JLAY) + PRAT_H2ON2O(JLON,JLAY)*P_COLN2O(JLON,JLAY)
128      Z_SPECPARM = P_COLH2O(JLON,JLAY)/Z_SPECCOMB(JLAY)
129      Z_SPECPARM=MIN(P_ONEMINUS,Z_SPECPARM)
130      Z_SPECMULT = 8._JPRB*(Z_SPECPARM)
131      JS = 1 + INT(Z_SPECMULT)
132      Z_FS = MOD(Z_SPECMULT,1.0_JPRB)
133
134      Z_SPECCOMB1(JLAY) = P_COLH2O(JLON,JLAY) + PRAT_H2ON2O_1(JLON,JLAY)*P_COLN2O(JLON,JLAY)
135      Z_SPECPARM1 = P_COLH2O(JLON,JLAY)/Z_SPECCOMB1(JLAY)
136      IF (Z_SPECPARM1 >= P_ONEMINUS) Z_SPECPARM1 = P_ONEMINUS
137      Z_SPECMULT1 = 8._JPRB*(Z_SPECPARM1)
138      JS1 = 1 + INT(Z_SPECMULT1)
139      Z_FS1 = MOD(Z_SPECMULT1,1.0_JPRB)
140
141      Z_SPECCOMB_MCO2(JLAY) = P_COLH2O(JLON,JLAY) + ZREFRAT_M_A*P_COLN2O(JLON,JLAY)
142      Z_SPECPARM_MCO2 = P_COLH2O(JLON,JLAY)/Z_SPECCOMB_MCO2(JLAY)
143      IF (Z_SPECPARM_MCO2 >= P_ONEMINUS) Z_SPECPARM_MCO2 = P_ONEMINUS
144      Z_SPECMULT_MCO2 = 8._JPRB*Z_SPECPARM_MCO2
145      JMCO2 = 1 + INT(Z_SPECMULT_MCO2)
146      Z_FMCO2 = MOD(Z_SPECMULT_MCO2,1.0_JPRB)
147! In atmospheres where the amount of CO2 is too great to be considered
148! a minor species, adjust the column amount of CO2 by an empirical factor
149! to obtain the proper contribution.
150      ZCHI_CO2 = P_COLCO2(JLON,JLAY)/P_COLDRY(JLON,JLAY)
151      ZRATCO2 = 1.E20_JPRB*ZCHI_CO2/3.55E-4_JPRB
152      IF (ZRATCO2 > 3.0_JPRB) THEN
153         ZADJFAC = 2.0_JPRB+(ZRATCO2-2.0_JPRB)**0.68_JPRB
154         ZADJCOLCO2(JLON,JLAY) = ZADJFAC*3.55E-4*P_COLDRY(JLON,JLAY)*1.E-20_JPRB
155      ELSE
156         ZADJCOLCO2(JLON,JLAY) = P_COLCO2(JLON,JLAY)
157      ENDIF
158
159      Z_SPECCOMB_MCO(JLAY) = P_COLH2O(JLON,JLAY) + ZREFRAT_M_A3*P_COLN2O(JLON,JLAY)
160      Z_SPECPARM_MCO = P_COLH2O(JLON,JLAY)/Z_SPECCOMB_MCO(JLAY)
161      IF (Z_SPECPARM_MCO >= P_ONEMINUS) Z_SPECPARM_MCO = P_ONEMINUS
162      Z_SPECMULT_MCO = 8._JPRB*Z_SPECPARM_MCO
163      JMCO = 1 + INT(Z_SPECMULT_MCO)
164      Z_FMCO = MOD(Z_SPECMULT_MCO,1.0_JPRB)
165
166      Z_SPECCOMB_PLANCK(JLAY) = P_COLH2O(JLON,JLAY)+ZREFRAT_PLANCK_A*P_COLN2O(JLON,JLAY)
167      Z_SPECPARM_PLANCK = P_COLH2O(JLON,JLAY)/Z_SPECCOMB_PLANCK(JLAY)
168      IF (Z_SPECPARM_PLANCK >= P_ONEMINUS) Z_SPECPARM_PLANCK=P_ONEMINUS
169      Z_SPECMULT_PLANCK = 8._JPRB*Z_SPECPARM_PLANCK
170      JPL= 1 + INT(Z_SPECMULT_PLANCK)
171      Z_FPL = MOD(Z_SPECMULT_PLANCK,1.0_JPRB)
172
173      IND0(JLAY) = ((K_JP(JLON,JLAY)-1)*5+(K_JT(JLON,JLAY)-1))*NSPA(13) + JS
174      IND1(JLAY) = (K_JP(JLON,JLAY)*5+(K_JT1(JLON,JLAY)-1))*NSPA(13) + JS1
175      INDS(JLAY) = K_INDSELF(JLON,JLAY)
176      INDF(JLAY) = K_INDFOR(JLON,JLAY)
177      INDM(JLAY) = KINDMINOR(JLON,JLAY)
178 
179IF (Z_SPECPARM < 0.125_JPRB) THEN
180            ZP = Z_FS - 1
181            ZP4 = ZP**4
182            ZFK0 = ZP4
183            ZFK1 = 1 - ZP - 2.0_JPRB*ZP4
184            ZFK2 = ZP + ZP4
185            Z_FAC000 = ZFK0*P_FAC00(JLON,JLAY)
186            Z_FAC100 = ZFK1*P_FAC00(JLON,JLAY)
187            Z_FAC200 = ZFK2*P_FAC00(JLON,JLAY)
188            Z_FAC010 = ZFK0*P_FAC10(JLON,JLAY)
189            Z_FAC110 = ZFK1*P_FAC10(JLON,JLAY)
190            Z_FAC210 = ZFK2*P_FAC10(JLON,JLAY)
191      ELSEIF (Z_SPECPARM > 0.875_JPRB) THEN
192            ZP = -Z_FS
193            ZP4 = ZP**4
194            ZFK0 = ZP4
195            ZFK1 = 1 - ZP - 2.0_JPRB*ZP4
196            ZFK2 = ZP + ZP4
197            Z_FAC000 = ZFK0*P_FAC00(JLON,JLAY)
198            Z_FAC100 = ZFK1*P_FAC00(JLON,JLAY)
199            Z_FAC200 = ZFK2*P_FAC00(JLON,JLAY)
200            Z_FAC010 = ZFK0*P_FAC10(JLON,JLAY)
201            Z_FAC110 = ZFK1*P_FAC10(JLON,JLAY)
202            Z_FAC210 = ZFK2*P_FAC10(JLON,JLAY)
203      ELSE
204            Z_FAC000 = (1._JPRB - Z_FS) * P_FAC00(JLON,JLAY)
205            Z_FAC010 = (1._JPRB - Z_FS) * P_FAC10(JLON,JLAY)
206            Z_FAC100 = Z_FS * P_FAC00(JLON,JLAY)
207            Z_FAC110 = Z_FS * P_FAC10(JLON,JLAY)
208      ENDIF
209      IF (Z_SPECPARM1 < 0.125_JPRB) THEN
210            ZP = Z_FS1 - 1
211            ZP4 = ZP**4
212            ZFK0 = ZP4
213            ZFK1 = 1 - ZP - 2.0_JPRB*ZP4
214            ZFK2 = ZP + ZP4
215            Z_FAC001 = ZFK0*P_FAC01(JLON,JLAY)
216            Z_FAC101 = ZFK1*P_FAC01(JLON,JLAY)
217            Z_FAC201 = ZFK2*P_FAC01(JLON,JLAY)
218            Z_FAC011 = ZFK0*P_FAC11(JLON,JLAY)
219            Z_FAC111 = ZFK1*P_FAC11(JLON,JLAY)
220            Z_FAC211 = ZFK2*P_FAC11(JLON,JLAY)
221      ELSEIF (Z_SPECPARM1 > 0.875_JPRB) THEN
222            ZP = -Z_FS1
223            ZP4 = ZP**4
224            ZFK0 = ZP4
225            ZFK1 = 1 - ZP - 2.0_JPRB*ZP4
226            ZFK2 = ZP + ZP4
227            Z_FAC001 = ZFK0*P_FAC01(JLON,JLAY)
228            Z_FAC101 = ZFK1*P_FAC01(JLON,JLAY)
229            Z_FAC201 = ZFK2*P_FAC01(JLON,JLAY)
230            Z_FAC011 = ZFK0*P_FAC11(JLON,JLAY)
231            Z_FAC111 = ZFK1*P_FAC11(JLON,JLAY)
232            Z_FAC211 = ZFK2*P_FAC11(JLON,JLAY)
233      ELSE
234            Z_FAC001 = (1._JPRB - Z_FS1) * P_FAC01(JLON,JLAY)
235            Z_FAC011 = (1._JPRB - Z_FS1) * P_FAC11(JLON,JLAY)
236            Z_FAC101 = Z_FS1 * P_FAC01(JLON,JLAY)
237            Z_FAC111 = Z_FS1 * P_FAC11(JLON,JLAY)
238      ENDIF
239
240
241!-- DS_000515
242!CDIR UNROLL=NG13
243      DO IG = 1, NG13
244!-- DS_000515
245        ZTAUSELF = P_SELFFAC(JLON,JLAY)* (SELFREF(INDS(JLAY),IG) + P_SELFFRAC(JLON,JLAY) * &
246          &       (SELFREF(INDS(JLAY)+1,IG) - SELFREF(INDS(JLAY),IG)))
247        ZTAUFOR = P_FORFAC(JLON,JLAY) * (FORREF(INDF(JLAY),IG) + P_FORFRAC(JLON,JLAY) * &
248          &       (FORREF(INDF(JLAY)+1,IG) - FORREF(INDF(JLAY),IG)))
249        ZCO2M1 = KA_MCO2(JMCO2,INDM(JLAY),IG) + Z_FMCO2 * &
250          &       (KA_MCO2(JMCO2+1,INDM(JLAY),IG) - KA_MCO2(JMCO2,INDM(JLAY),IG))
251        ZCO2M2 = KA_MCO2(JMCO2,INDM(JLAY)+1,IG) + Z_FMCO2 * &
252          &       (KA_MCO2(JMCO2+1,INDM(JLAY)+1,IG) - KA_MCO2(JMCO2,INDM(JLAY)+1,IG))
253        ZABSCO2 = ZCO2M1 + PMINORFRAC(JLON,JLAY) * (ZCO2M2 - ZCO2M1)
254        ZCOM1 = KA_MCO(JMCO,INDM(JLAY),IG) + Z_FMCO * &
255          &       (KA_MCO(JMCO+1,INDM(JLAY),IG) - KA_MCO(JMCO,INDM(JLAY),IG))
256        ZCOM2 = KA_MCO(JMCO,INDM(JLAY)+1,IG) + Z_FMCO * &
257          &       (KA_MCO(JMCO+1,INDM(JLAY)+1,IG) - KA_MCO(JMCO,INDM(JLAY)+1,IG))
258        ZABSCO = ZCOM1 + PMINORFRAC(JLON,JLAY) * (ZCOM2 - ZCOM1)
259
260      IF (Z_SPECPARM < 0.125_JPRB) THEN
261               ZTAU_MAJOR = Z_SPECCOMB(JLAY) * &
262                 &   (Z_FAC000 * ABSA(IND0(JLAY),IG) + &
263                 &   Z_FAC100 * ABSA(IND0(JLAY)+1,IG) + &
264                 &   Z_FAC200 * ABSA(IND0(JLAY)+2,IG) + &
265                 &   Z_FAC010 * ABSA(IND0(JLAY)+9,IG) + &
266                 &   Z_FAC110 * ABSA(IND0(JLAY)+10,IG) + &
267                 &   Z_FAC210 * ABSA(IND0(JLAY)+11,IG))
268            ELSEIF (Z_SPECPARM > 0.875_JPRB) THEN
269               ZTAU_MAJOR = Z_SPECCOMB(JLAY) * &
270                 &   (Z_FAC200 * ABSA(IND0(JLAY)-1,IG) + &
271                 &   Z_FAC100 * ABSA(IND0(JLAY),IG) + &
272                 &   Z_FAC000 * ABSA(IND0(JLAY)+1,IG) + &
273                 &   Z_FAC210 * ABSA(IND0(JLAY)+8,IG) + &
274                 &   Z_FAC110 * ABSA(IND0(JLAY)+9,IG) + &
275                 &   Z_FAC010 * ABSA(IND0(JLAY)+10,IG))
276            ELSE
277               ZTAU_MAJOR = Z_SPECCOMB(JLAY) * &
278                 &   (Z_FAC000 * ABSA(IND0(JLAY),IG) + &
279                 &   Z_FAC100 * ABSA(IND0(JLAY)+1,IG) + &
280                 &   Z_FAC010 * ABSA(IND0(JLAY)+9,IG) + &
281                 &   Z_FAC110 * ABSA(IND0(JLAY)+10,IG))
282            ENDIF
283
284            IF (Z_SPECPARM1 < 0.125_JPRB) THEN
285               ZTAU_MAJOR1 = Z_SPECCOMB1(JLAY) * &
286                &    (Z_FAC001 * ABSA(IND1(JLAY),IG) + &
287                &    Z_FAC101 * ABSA(IND1(JLAY)+1,IG) + &
288                &    Z_FAC201 * ABSA(IND1(JLAY)+2,IG) + &
289                &    Z_FAC011 * ABSA(IND1(JLAY)+9,IG) + &
290                &    Z_FAC111 * ABSA(IND1(JLAY)+10,IG) + &
291                &    Z_FAC211 * ABSA(IND1(JLAY)+11,IG))
292            ELSEIF (Z_SPECPARM1 > 0.875_JPRB) THEN
293               ZTAU_MAJOR1 = Z_SPECCOMB1(JLAY) * &
294                &    (Z_FAC201 * ABSA(IND1(JLAY)-1,IG) + &
295                &    Z_FAC101 * ABSA(IND1(JLAY),IG) + &
296                &    Z_FAC001 * ABSA(IND1(JLAY)+1,IG) + &
297                &    Z_FAC211 * ABSA(IND1(JLAY)+8,IG) + &
298                &    Z_FAC111 * ABSA(IND1(JLAY)+9,IG) + &
299                &    Z_FAC011 * ABSA(IND1(JLAY)+10,IG))
300            ELSE
301               ZTAU_MAJOR1 = Z_SPECCOMB1(JLAY) * &
302                &    (Z_FAC001 * ABSA(IND1(JLAY),IG) +  &
303                &    Z_FAC101 * ABSA(IND1(JLAY)+1,IG) + &
304                &    Z_FAC011 * ABSA(IND1(JLAY)+9,IG) + &
305                &    Z_FAC111 * ABSA(IND1(JLAY)+10,IG))
306            ENDIF
307
308
309        P_TAU(JLON,NGS12+IG,JLAY) = ZTAU_MAJOR + ZTAU_MAJOR1 &
310               & + ZTAUSELF + ZTAUFOR &
311               & + ZADJCOLCO2(JLON,JLAY)*ZABSCO2 &
312               & + Z_COLCO(JLON,JLAY)*ZABSCO &
313               & + P_TAUAERL(JLON,JLAY,13) 
314        PFRAC(JLON,NGS12+IG,JLAY) = FRACREFA(IG,JPL) + Z_FPL * &
315         & (FRACREFA(IG,JPL+1) - FRACREFA(IG,JPL)) 
316      ENDDO
317    ENDIF
318
319!-- JJM_000517
320    IF (JLAY > K_LAYTROP(JLON)) THEN
321      INDM(JLAY) = KINDMINOR(JLON,JLAY)
322!CDIR UNROLL=NG13
323      DO IG = 1, NG13
324!-- JJM_000517
325        ZABSO3 = KB_MO3(INDM(JLAY),IG) + PMINORFRAC(JLON,JLAY) * &
326         &       (KB_MO3(INDM(JLAY)+1,IG) - KB_MO3(INDM(JLAY),IG))
327        P_TAU(JLON,NGS12+IG,JLAY) = P_COLO3(JLON,JLAY)*ZABSO3+P_TAUAERL(JLON,JLAY,13)
328        PFRAC(JLON,NGS12+IG,JLAY) = FRACREFB(IG)
329      ENDDO
330    ENDIF
331  ENDDO
332ENDDO
333
334IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL13',1,ZHOOK_HANDLE)
335
336END ASSOCIATE
337END SUBROUTINE RRTM_TAUMOL13
Note: See TracBrowser for help on using the repository browser.