source: LMDZ6/branches/LMDZ_ECRad/libf/phylmd/ecrad/ifsrrtm/rrtm_taumol7.F90 @ 5134

Last change on this file since 5134 was 4728, checked in by idelkadi, 14 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: 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.