source: LMDZ6/trunk/libf/phylmd/ecrad/ifsrrtm/rrtm_taumol7.F90 @ 4999

Last change on this file since 4999 was 4773, checked in by idelkadi, 7 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: 15.0 KB
Line 
1!----------------------------------------------------------------------------
2SUBROUTINE RRTM_TAUMOL7 (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_COLO3,P_COLCO2,P_COLDRY,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC, &
5 & P_RAT_H2OO3, P_RAT_H2OO3_1,PMINORFRAC,KINDMINOR) 
6
7!     BAND 7:  980-1080 cm-1 (low - H2O,O3; high - O3)
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 7:  980-1080 cm-1 (low key - h2o,o3; low minor - co2)
20!                            (high key - o3; high minor - co2)
21!      F. Vana  05-Mar-2015  Support for single precision
22! ---------------------------------------------------------------------------
23
24USE PARKIND1  ,ONLY : JPIM     ,JPRB
25USE YOMHOOK   ,ONLY : LHOOK, DR_HOOK, JPHOOK
26
27USE PARRRTM  , ONLY : JPBAND
28USE YOERRTM  , ONLY : JPGPT  ,NG7   ,NGS6
29USE YOERRTWN , ONLY : NSPA   ,NSPB
30USE YOERRTA7 , ONLY : ABSA   ,ABSB   ,KA_MCO2,KB_MCO2 ,FRACREFA ,FRACREFB,SELFREF,FORREF
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_TAUAERL(KIDIA:KFDIA,KLEV,JPBAND)
40REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC00(KIDIA:KFDIA,KLEV)
41REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC01(KIDIA:KFDIA,KLEV)
42REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC10(KIDIA:KFDIA,KLEV)
43REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC11(KIDIA:KFDIA,KLEV)
44INTEGER(KIND=JPIM),INTENT(IN)    :: K_JP(KIDIA:KFDIA,KLEV)
45INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT(KIDIA:KFDIA,KLEV)
46INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT1(KIDIA:KFDIA,KLEV)
47REAL(KIND=JPRB)   ,INTENT(IN)    :: P_ONEMINUS
48REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLH2O(KIDIA:KFDIA,KLEV)
49REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLO3(KIDIA:KFDIA,KLEV)
50REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLCO2(KIDIA:KFDIA,KLEV)
51REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLDRY(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_H2OO3(KIDIA:KFDIA,KLEV)
59REAL(KIND=JPRB)   ,INTENT(IN)   :: P_RAT_H2OO3_1(KIDIA:KFDIA,KLEV)
60INTEGER(KIND=JPIM),INTENT(IN)   :: K_INDFOR(KIDIA:KFDIA,KLEV)
61REAL(KIND=JPRB)   ,INTENT(IN)   :: P_FORFRAC(KIDIA:KFDIA,KLEV)
62REAL(KIND=JPRB)   ,INTENT(IN)   :: P_FORFAC(KIDIA:KFDIA,KLEV)
63REAL(KIND=JPRB)   ,INTENT(IN)   :: PMINORFRAC(KIDIA:KFDIA,KLEV)
64INTEGER(KIND=JPIM),INTENT(IN)   :: KINDMINOR(KIDIA:KFDIA,KLEV)
65
66
67! ---------------------------------------------------------------------------
68
69REAL(KIND=JPRB) :: Z_SPECCOMB(KLEV),Z_SPECCOMB1(KLEV), &
70& Z_SPECCOMB_MCO2(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, JMCO2
74INTEGER(KIND=JPIM) :: JLON
75
76REAL(KIND=JPRB) :: ZREFRAT_PLANCK_A, ZREFRAT_M_A
77REAL(KIND=JPRB) :: ZCHI_CO2, ZRATCO2, ZADJFAC, ZADJCOLCO2(KIDIA:KFDIA,KLEV)
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, ZCO2M1, ZCO2M2, ZABSCO2
84
85
86REAL(KIND=JPRB) :: Z_FS, Z_SPECMULT, Z_SPECPARM,  &
87& Z_FS1, Z_SPECMULT1, Z_SPECPARM1, &
88& Z_FPL, Z_SPECMULT_PLANCK, Z_SPECPARM_PLANCK, &
89& Z_FMCO2, Z_SPECMULT_MCO2, Z_SPECPARM_MCO2 
90REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
91
92IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL7',0,ZHOOK_HANDLE)
93
94! Minor gas mapping level :
95!     lower - co2, p = 706.2620 mbar, t= 278.94 k
96!     upper - co2, p = 12.9350 mbar, t = 234.01 k
97
98! Calculate reference ratio to be used in calculation of Planck
99! fraction in lower atmosphere.
100
101! P = 706.2620 mb
102      ZREFRAT_PLANCK_A = CHI_MLS(1,3)/CHI_MLS(3,3)
103
104! P = 706.2720 mb
105      ZREFRAT_M_A = CHI_MLS(1,3)/CHI_MLS(3,3)
106
107! Compute the optical depth by interpolating in ln(pressure),
108! temperature, and appropriate species.  Below laytrop, the water
109! vapor self-continuum and foreign continuum is interpolated
110! (in temperature) separately.
111
112DO JLAY = 1, KLEV
113  DO JLON = KIDIA, KFDIA
114    IF (JLAY <= K_LAYTROP(JLON)) THEN
115      Z_SPECCOMB(JLAY) = P_COLH2O(JLON,JLAY) + P_RAT_H2OO3(JLON,JLAY)*P_COLO3(JLON,JLAY)
116      !Z_SPECPARM = P_COLH2O(JLON,JLAY)/Z_SPECCOMB(JLAY)
117      Z_SPECPARM = 1._JPRB/(1._JPRB+P_RAT_H2OO3(JLON,JLAY)/P_COLH2O(JLON,JLAY)*P_COLO3(JLON,JLAY))
118      Z_SPECPARM=MIN(P_ONEMINUS,Z_SPECPARM)
119      Z_SPECMULT = 8._JPRB*Z_SPECPARM
120      JS = 1 + INT(Z_SPECMULT)
121      Z_FS = MOD(Z_SPECMULT,1.0_JPRB)
122
123      Z_SPECCOMB1(JLAY) = P_COLH2O(JLON,JLAY) + P_RAT_H2OO3_1(JLON,JLAY)*P_COLO3(JLON,JLAY)
124      !Z_SPECPARM1 = P_COLH2O(JLON,JLAY)/Z_SPECCOMB1(JLAY)
125      Z_SPECPARM1 = 1._JPRB/(1._JPRB+P_RAT_H2OO3_1(JLON,JLAY)/P_COLH2O(JLON,JLAY)*P_COLO3(JLON,JLAY))
126      IF (Z_SPECPARM1 >= P_ONEMINUS) Z_SPECPARM1 = P_ONEMINUS
127      Z_SPECMULT1 = 8._JPRB*(Z_SPECPARM1)
128      JS1 = 1 + INT(Z_SPECMULT1)
129      Z_FS1 = MOD(Z_SPECMULT1,1.0_JPRB)
130
131      Z_SPECCOMB_MCO2(JLAY) = P_COLH2O(JLON,JLAY) + ZREFRAT_M_A*P_COLO3(JLON,JLAY)
132      !Z_SPECPARM_MCO2 = P_COLH2O(JLON,JLAY)/Z_SPECCOMB_MCO2(JLAY)
133      Z_SPECPARM_MCO2 = 1._JPRB/(1._JPRB+ZREFRAT_M_A/P_COLH2O(JLON,JLAY)*P_COLO3(JLON,JLAY))
134      IF (Z_SPECPARM_MCO2 >= P_ONEMINUS) Z_SPECPARM_MCO2 = P_ONEMINUS
135      Z_SPECMULT_MCO2 = 8._JPRB*Z_SPECPARM_MCO2
136      JMCO2 = 1 + INT(Z_SPECMULT_MCO2)
137      Z_FMCO2 = MOD(Z_SPECMULT_MCO2,1.0_JPRB)
138
139! In atmospheres where the amount of CO2 is too great to be considered
140! a minor species, adjust the column amount of CO2 by an empirical factor
141! to obtain the proper contribution.
142      ZCHI_CO2 = P_COLCO2(JLON,JLAY)/P_COLDRY(JLON,JLAY)
143      ZRATCO2 = 1.E20_JPRB*ZCHI_CO2/CHI_MLS(2,K_JP(JLON,JLAY)+1)
144      IF (ZRATCO2 > 3.0_JPRB) THEN
145         ZADJFAC = 3.0_JPRB+(ZRATCO2-3.0_JPRB)**0.79_JPRB
146         ZADJCOLCO2(JLON,JLAY) = ZADJFAC*CHI_MLS(2,K_JP(JLON,JLAY)+1)*P_COLDRY(JLON,JLAY)*1.E-20_JPRB
147      ELSE
148         ZADJCOLCO2(JLON,JLAY) = P_COLCO2(JLON,JLAY)
149      ENDIF
150
151
152      Z_SPECCOMB_PLANCK(JLAY) = P_COLH2O(JLON,JLAY)+ZREFRAT_PLANCK_A*P_COLO3(JLON,JLAY)
153      !Z_SPECPARM_PLANCK = P_COLH2O(JLON,JLAY)/Z_SPECCOMB_PLANCK(JLAY)
154      Z_SPECPARM_PLANCK = 1._JPRB/(1._JPRB+ZREFRAT_PLANCK_A/P_COLH2O(JLON,JLAY)*P_COLO3(JLON,JLAY))
155      IF (Z_SPECPARM_PLANCK >= P_ONEMINUS) Z_SPECPARM_PLANCK=P_ONEMINUS
156      Z_SPECMULT_PLANCK = 8._JPRB*Z_SPECPARM_PLANCK
157      JPL= 1 + INT(Z_SPECMULT_PLANCK)
158      Z_FPL = MOD(Z_SPECMULT_PLANCK,1.0_JPRB)
159
160      IND0(JLAY) = ((K_JP(JLON,JLAY)-1)*5+(K_JT(JLON,JLAY)-1))*NSPA(7) + JS
161      IND1(JLAY) = (K_JP(JLON,JLAY)*5+(K_JT1(JLON,JLAY)-1))*NSPA(7) + JS1
162      INDS(JLAY) = K_INDSELF(JLON,JLAY)
163      INDF(JLAY) = K_INDFOR(JLON,JLAY)
164      INDM(JLAY) = KINDMINOR(JLON,JLAY)
165
166  IF (Z_SPECPARM < 0.125_JPRB) THEN
167            ZP = Z_FS - 1
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      ELSEIF (Z_SPECPARM > 0.875_JPRB) THEN
179            ZP = -Z_FS
180            ZP4 = ZP**4
181            ZFK0 = ZP4
182            ZFK1 = 1 - ZP - 2.0_JPRB*ZP4
183            ZFK2 = ZP + ZP4
184            Z_FAC000 = ZFK0*P_FAC00(JLON,JLAY)
185            Z_FAC100 = ZFK1*P_FAC00(JLON,JLAY)
186            Z_FAC200 = ZFK2*P_FAC00(JLON,JLAY)
187            Z_FAC010 = ZFK0*P_FAC10(JLON,JLAY)
188            Z_FAC110 = ZFK1*P_FAC10(JLON,JLAY)
189            Z_FAC210 = ZFK2*P_FAC10(JLON,JLAY)
190      ELSE
191            Z_FAC000 = (1._JPRB - Z_FS) * P_FAC00(JLON,JLAY)
192            Z_FAC010 = (1._JPRB - Z_FS) * P_FAC10(JLON,JLAY)
193            Z_FAC100 = Z_FS * P_FAC00(JLON,JLAY)
194            Z_FAC110 = Z_FS * P_FAC10(JLON,JLAY)
195      ENDIF
196      IF (Z_SPECPARM1 < 0.125_JPRB) THEN
197            ZP = Z_FS1 - 1
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      ELSEIF (Z_SPECPARM1 > 0.875_JPRB) THEN
209            ZP = -Z_FS1
210            ZP4 = ZP**4
211            ZFK0 = ZP4
212            ZFK1 = 1 - ZP - 2.0_JPRB*ZP4
213            ZFK2 = ZP + ZP4
214            Z_FAC001 = ZFK0*P_FAC01(JLON,JLAY)
215            Z_FAC101 = ZFK1*P_FAC01(JLON,JLAY)
216            Z_FAC201 = ZFK2*P_FAC01(JLON,JLAY)
217            Z_FAC011 = ZFK0*P_FAC11(JLON,JLAY)
218            Z_FAC111 = ZFK1*P_FAC11(JLON,JLAY)
219            Z_FAC211 = ZFK2*P_FAC11(JLON,JLAY)
220      ELSE
221            Z_FAC001 = (1._JPRB - Z_FS1) * P_FAC01(JLON,JLAY)
222            Z_FAC011 = (1._JPRB - Z_FS1) * P_FAC11(JLON,JLAY)
223            Z_FAC101 = Z_FS1 * P_FAC01(JLON,JLAY)
224            Z_FAC111 = Z_FS1 * P_FAC11(JLON,JLAY)
225      ENDIF
226
227!-- DS_000515
228!CDIR UNROLL=NG7
229      DO IG = 1, NG7
230!-- DS_000515
231         ZTAUSELF = P_SELFFAC(JLON,JLAY)* (SELFREF(INDS(JLAY),IG) + P_SELFFRAC(JLON,JLAY) * &
232          &       (SELFREF(INDS(JLAY)+1,IG) - SELFREF(INDS(JLAY),IG)))
233         ZTAUFOR = P_FORFAC(JLON,JLAY) * (FORREF(INDF(JLAY),IG) + P_FORFRAC(JLON,JLAY) * &
234          &       (FORREF(INDF(JLAY)+1,IG) - FORREF(INDF(JLAY),IG)))
235         ZCO2M1 = KA_MCO2(JMCO2,INDM(JLAY),IG) + Z_FMCO2 * &
236          &       (KA_MCO2(JMCO2+1,INDM(JLAY),IG) - KA_MCO2(JMCO2,INDM(JLAY),IG))
237         ZCO2M2 = KA_MCO2(JMCO2,INDM(JLAY)+1,IG) + Z_FMCO2 * &
238          &       (KA_MCO2(JMCO2+1,INDM(JLAY)+1,IG) - KA_MCO2(JMCO2,INDM(JLAY)+1,IG))
239         ZABSCO2 = ZCO2M1 + PMINORFRAC(JLON,JLAY) * (ZCO2M2 - ZCO2M1)
240
241            IF (Z_SPECPARM < 0.125_JPRB) THEN
242               ZTAU_MAJOR = Z_SPECCOMB(JLAY) * &
243                 &   (Z_FAC000 * ABSA(IND0(JLAY),IG) + &
244                 &   Z_FAC100 * ABSA(IND0(JLAY)+1,IG) + &
245                 &   Z_FAC200 * ABSA(IND0(JLAY)+2,IG) + &
246                 &   Z_FAC010 * ABSA(IND0(JLAY)+9,IG) + &
247                 &   Z_FAC110 * ABSA(IND0(JLAY)+10,IG) + &
248                 &   Z_FAC210 * ABSA(IND0(JLAY)+11,IG))
249            ELSEIF (Z_SPECPARM > 0.875_JPRB) THEN
250               ZTAU_MAJOR = Z_SPECCOMB(JLAY) * &
251                 &   (Z_FAC200 * ABSA(IND0(JLAY)-1,IG) + &
252                 &   Z_FAC100 * ABSA(IND0(JLAY),IG) + &
253                 &   Z_FAC000 * ABSA(IND0(JLAY)+1,IG) + &
254                 &   Z_FAC210 * ABSA(IND0(JLAY)+8,IG) + &
255                 &   Z_FAC110 * ABSA(IND0(JLAY)+9,IG) + &
256                 &   Z_FAC010 * ABSA(IND0(JLAY)+10,IG))
257            ELSE
258               ZTAU_MAJOR = Z_SPECCOMB(JLAY) * &
259                 &   (Z_FAC000 * ABSA(IND0(JLAY),IG) + &
260                 &   Z_FAC100 * ABSA(IND0(JLAY)+1,IG) + &
261                 &   Z_FAC010 * ABSA(IND0(JLAY)+9,IG) + &
262                 &   Z_FAC110 * ABSA(IND0(JLAY)+10,IG))
263            ENDIF
264
265            IF (Z_SPECPARM1 < 0.125_JPRB) THEN
266               ZTAU_MAJOR1 = Z_SPECCOMB1(JLAY) * &
267                &    (Z_FAC001 * ABSA(IND1(JLAY),IG) + &
268                &    Z_FAC101 * ABSA(IND1(JLAY)+1,IG) + &
269                &    Z_FAC201 * ABSA(IND1(JLAY)+2,IG) + &
270                &    Z_FAC011 * ABSA(IND1(JLAY)+9,IG) + &
271                &    Z_FAC111 * ABSA(IND1(JLAY)+10,IG) + &
272                &    Z_FAC211 * ABSA(IND1(JLAY)+11,IG))
273            ELSEIF (Z_SPECPARM1 > 0.875_JPRB) THEN
274               ZTAU_MAJOR1 = Z_SPECCOMB1(JLAY) * &
275                &    (Z_FAC201 * ABSA(IND1(JLAY)-1,IG) + &
276                &    Z_FAC101 * ABSA(IND1(JLAY),IG) + &
277                &    Z_FAC001 * ABSA(IND1(JLAY)+1,IG) + &
278                &    Z_FAC211 * ABSA(IND1(JLAY)+8,IG) + &
279                &    Z_FAC111 * ABSA(IND1(JLAY)+9,IG) + &
280                &    Z_FAC011 * ABSA(IND1(JLAY)+10,IG))
281            ELSE
282               ZTAU_MAJOR1 = Z_SPECCOMB1(JLAY) * &
283                &    (Z_FAC001 * ABSA(IND1(JLAY),IG) +  &
284                &    Z_FAC101 * ABSA(IND1(JLAY)+1,IG) + &
285                &    Z_FAC011 * ABSA(IND1(JLAY)+9,IG) + &
286                &    Z_FAC111 * ABSA(IND1(JLAY)+10,IG))
287            ENDIF
288
289
290        P_TAU(JLON,NGS6+IG,JLAY) = ZTAU_MAJOR + ZTAU_MAJOR1 &
291               & + ZTAUSELF + ZTAUFOR &
292               & + ZADJCOLCO2(JLON,JLAY)*ZABSCO2 &
293               & + P_TAUAERL(JLON,JLAY,7) 
294        PFRAC(JLON,NGS6+IG,JLAY) = FRACREFA(IG,JPL) + Z_FPL *&
295         & (FRACREFA(IG,JPL+1) - FRACREFA(IG,JPL)) 
296      ENDDO
297    ENDIF
298
299    IF (JLAY > K_LAYTROP(JLON)) THEN
300
301! In atmospheres where the amount of CO2 is too great to be considered
302! a minor species, adjust the column amount of CO2 by an empirical factor
303! to obtain the proper contribution.
304      ZCHI_CO2 = P_COLCO2(JLON,JLAY)/P_COLDRY(JLON,JLAY)
305      ZRATCO2 = 1.E20_JPRB*ZCHI_CO2/CHI_MLS(2,K_JP(JLON,JLAY)+1)
306      IF (ZRATCO2 > 3.0_JPRB) THEN
307         ZADJFAC = 2.0_JPRB+(ZRATCO2-2.0_JPRB)**0.79_JPRB
308         ZADJCOLCO2(JLON,JLAY) = ZADJFAC*CHI_MLS(2,K_JP(JLON,JLAY)+1)*P_COLDRY(JLON,JLAY)*1.E-20_JPRB
309      ELSE
310         ZADJCOLCO2(JLON,JLAY) = P_COLCO2(JLON,JLAY)
311      ENDIF
312
313
314      IND0(JLAY) = ((K_JP(JLON,JLAY)-13)*5+(K_JT(JLON,JLAY)-1))*NSPB(7) + 1
315      IND1(JLAY) = ((K_JP(JLON,JLAY)-12)*5+(K_JT1(JLON,JLAY)-1))*NSPB(7) + 1
316      INDM(JLAY) = KINDMINOR(JLON,JLAY)
317!-- JJM_000517
318!CDIR UNROLL=NG7
319      DO IG = 1, NG7
320!-- JJM_000517
321        ZABSCO2 = KB_MCO2(INDM(JLAY),IG) + PMINORFRAC(JLON,JLAY) * &
322         &       (KB_MCO2(INDM(JLAY)+1,IG) - KB_MCO2(INDM(JLAY),IG))
323
324        P_TAU(JLON,NGS6+IG,JLAY) = P_COLO3(JLON,JLAY) *&
325         & (P_FAC00(JLON,JLAY) * ABSB(IND0(JLAY)  ,IG) +&
326         & P_FAC10(JLON,JLAY) * ABSB(IND0(JLAY)+1,IG) +&
327         & P_FAC01(JLON,JLAY) * ABSB(IND1(JLAY)  ,IG) +&
328         & P_FAC11(JLON,JLAY) * ABSB(IND1(JLAY)+1,IG))&
329         & + ZADJCOLCO2(JLON,JLAY) * ZABSCO2 &
330         & + P_TAUAERL(JLON,JLAY,7) 
331        PFRAC(JLON,NGS6+IG,JLAY) = FRACREFB(IG)
332      ENDDO
333
334! Empirical modification to code to improve stratospheric cooling rates
335! for o3.  Revised to apply weighting for g-point reduction in this band.
336
337         P_TAU(JLON,NGS6+6,JLAY)=P_TAU(JLON,NGS6+6,JLAY)*0.92_JPRB
338         P_TAU(JLON,NGS6+7,JLAY)=P_TAU(JLON,NGS6+7,JLAY)*0.88_JPRB
339         P_TAU(JLON,NGS6+8,JLAY)=P_TAU(JLON,NGS6+8,JLAY)*1.07_JPRB
340         P_TAU(JLON,NGS6+9,JLAY)=P_TAU(JLON,NGS6+9,JLAY)*1.1_JPRB
341         P_TAU(JLON,NGS6+10,JLAY)=P_TAU(JLON,NGS6+10,JLAY)*0.99_JPRB
342         P_TAU(JLON,NGS6+11,JLAY)=P_TAU(JLON,NGS6+11,JLAY)*0.855_JPRB
343
344
345
346    ENDIF
347  ENDDO
348ENDDO
349
350IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL7',1,ZHOOK_HANDLE)
351
352END SUBROUTINE RRTM_TAUMOL7
Note: See TracBrowser for help on using the repository browser.