source: LMDZ6/branches/LMDZ_ECRad/libf/phylmd/ecrad/ifsrrtm/rrtm_taumol3.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: 16.7 KB
Line 
1!----------------------------------------------------------------------------
2SUBROUTINE RRTM_TAUMOL3 (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_COLCO2,P_COLN2O,P_COLDRY,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC, &
5 & PRAT_H2OCO2, PRAT_H2OCO2_1,PMINORFRAC,KINDMINOR) 
6
7!     BAND 3:  500-630 cm-1 (low - H2O,CO2; high - H2O,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 20130517 updated to rrtmg_lw_v4.85:
19!     band 3:  500-630 cm-1 (low key - h2o,co2; low minor - n2o)
20!                           (high key - h2o,co2; high minor - n2o)
21! ---------------------------------------------------------------------------
22
23USE PARKIND1  ,ONLY : JPIM     ,JPRB
24USE YOMHOOK   ,ONLY : LHOOK, DR_HOOK, JPHOOK
25
26USE PARRRTM  , ONLY : JPBAND
27USE YOERRTM  , ONLY : JPGPT  ,NG3   ,NGS2
28USE YOERRTWN , ONLY : NSPA   ,NSPB
29USE YOERRTA3 , ONLY : ABSA   ,ABSB   ,FRACREFA, FRACREFB,&
30 & FORREF   ,SELFREF , KA_MN2O ,  KB_MN2O
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)
44REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FORFAC(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_COLN2O(KIDIA:KFDIA,KLEV)
52REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLDRY(KIDIA:KFDIA,KLEV)
53INTEGER(KIND=JPIM),INTENT(IN)    :: K_LAYTROP(KIDIA:KFDIA)
54REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFAC(KIDIA:KFDIA,KLEV)
55REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFRAC(KIDIA:KFDIA,KLEV)
56INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDSELF(KIDIA:KFDIA,KLEV)
57REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFRAC(KIDIA:KFDIA,JPGPT,KLEV)
58
59REAL(KIND=JPRB)   ,INTENT(IN)   :: PRAT_H2OCO2(KIDIA:KFDIA,KLEV)
60REAL(KIND=JPRB)   ,INTENT(IN)   :: PRAT_H2OCO2_1(KIDIA:KFDIA,KLEV)
61INTEGER(KIND=JPIM),INTENT(IN)   :: K_INDFOR(KIDIA:KFDIA,KLEV)
62REAL(KIND=JPRB)   ,INTENT(IN)   :: P_FORFRAC(KIDIA:KFDIA,KLEV)
63REAL(KIND=JPRB)   ,INTENT(IN)   :: PMINORFRAC(KIDIA:KFDIA,KLEV)
64INTEGER(KIND=JPIM),INTENT(IN)   :: KINDMINOR(KIDIA:KFDIA,KLEV)
65! ---------------------------------------------------------------------------
66
67REAL(KIND=JPRB) :: Z_SPECCOMB(KLEV),Z_SPECCOMB1(KLEV),Z_SPECCOMB_MN2O(KLEV), &
68& Z_SPECCOMB_PLANCK(KLEV)
69REAL(KIND=JPRB) :: ZREFRAT_PLANCK_A, ZREFRAT_PLANCK_B, ZREFRAT_M_A, ZREFRAT_M_B
70
71INTEGER(KIND=JPIM) :: IND0(KLEV),IND1(KLEV),INDS(KLEV),INDF(KLEV),INDM(KLEV)
72INTEGER(KIND=JPIM) :: IG, JS, JLAY, JS1,JMN2O,JPL
73INTEGER(KIND=JPIM) :: JLON
74
75REAL(KIND=JPRB) :: Z_FS, Z_SPECMULT, Z_SPECPARM,  &
76 & Z_FS1, Z_SPECMULT1, Z_SPECPARM1,   &
77 & Z_FMN2O, Z_FMN2OMF, Z_SPECMULT_MN2O, Z_SPECPARM_MN2O,   &
78 & Z_FPL, Z_SPECMULT_PLANCK, Z_SPECPARM_PLANCK
79
80REAL(KIND=JPRB) :: ZADJFAC,ZADJCOLN2O(KIDIA:KFDIA,KLEV),ZRATN2O,Z_CHI_N2O
81
82 REAL(KIND=JPRB) ::  Z_FAC000, Z_FAC100, Z_FAC200,&
83 & Z_FAC010, Z_FAC110, Z_FAC210, &
84 & Z_FAC001, Z_FAC101, Z_FAC201, &
85 & Z_FAC011, Z_FAC111, Z_FAC211
86REAL(KIND=JPRB) :: ZP, ZP4, ZFK0, ZFK1, ZFK2
87REAL(KIND=JPRB) :: ZTAUFOR,ZTAUSELF,ZN2OM1,ZN2OM2,ZABSN2O,ZTAU_MAJOR,ZTAU_MAJOR1
88
89REAL(KIND=JPHOOK) :: ZHOOK_HANDLE
90
91IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL3',0,ZHOOK_HANDLE)
92
93!     Compute the optical depth by interpolating in ln(pressure),
94!     temperature, and appropriate species.  Below LAYTROP, the water
95!     vapor self-continuum is interpolated (in temperature) separately. 
96
97
98! Minor gas mapping levels:
99!     lower - n2o, p = 706.272 mbar, t = 278.94 k
100!     upper - n2o, p = 95.58 mbar, t = 215.7 k
101
102!  P = 212.725 mb
103      ZREFRAT_PLANCK_A = CHI_MLS(1,9)/CHI_MLS(2,9)
104
105!  P = 95.58 mb
106      ZREFRAT_PLANCK_B = CHI_MLS(1,13)/CHI_MLS(2,13)
107
108!  P = 706.270mb
109      ZREFRAT_M_A = CHI_MLS(1,3)/CHI_MLS(2,3)
110
111!  P = 95.58 mb
112      ZREFRAT_M_B = CHI_MLS(1,13)/CHI_MLS(2,13)
113ASSOCIATE(NFLEVG=>KLEV)
114
115
116DO JLAY = 1, KLEV
117  DO JLON = KIDIA, KFDIA
118    IF (JLAY <= K_LAYTROP(JLON)) THEN
119      Z_SPECCOMB(JLAY) = P_COLH2O(JLON,JLAY) + PRAT_H2OCO2(JLON,JLAY)*P_COLCO2(JLON,JLAY)
120      Z_SPECPARM = P_COLH2O(JLON,JLAY)/Z_SPECCOMB(JLAY)
121      Z_SPECPARM=MIN(P_ONEMINUS,Z_SPECPARM)
122      Z_SPECMULT = 8._JPRB*(Z_SPECPARM)
123      JS = 1 + INT(Z_SPECMULT)
124      Z_FS = MOD(Z_SPECMULT,1.0_JPRB)
125
126
127        Z_SPECCOMB1(JLAY) = P_COLH2O(JLON,JLAY) + PRAT_H2OCO2_1(JLON,JLAY)*P_COLCO2(JLON,JLAY)
128        Z_SPECPARM1 = P_COLH2O(JLON,JLAY)/Z_SPECCOMB1(JLAY)
129        IF (Z_SPECPARM1 >= P_ONEMINUS) Z_SPECPARM1 = P_ONEMINUS
130        Z_SPECMULT1 = 8._JPRB*(Z_SPECPARM1)
131        JS1 = 1 + INT(Z_SPECMULT1)
132        Z_FS1 = MOD(Z_SPECMULT1,1.0_JPRB)
133
134        Z_SPECCOMB_MN2O(JLAY) = P_COLH2O(JLON,JLAY) + ZREFRAT_M_A*P_COLCO2(JLON,JLAY)
135        Z_SPECPARM_MN2O = P_COLH2O(JLON,JLAY)/Z_SPECCOMB_MN2O(JLAY)
136        IF (Z_SPECPARM_MN2O >= P_ONEMINUS) Z_SPECPARM_MN2O = P_ONEMINUS
137        Z_SPECMULT_MN2O = 8._JPRB*Z_SPECPARM_MN2O
138        JMN2O = 1 + INT(Z_SPECMULT_MN2O)
139        Z_FMN2O = MOD(Z_SPECMULT_MN2O,1.0_JPRB)
140        Z_FMN2OMF = PMINORFRAC(JLON,JLAY)*Z_FMN2O
141!  In atmospheres where the amount of N2O is too great to be considered
142!  a minor species, adjust the column amount of N2O by an empirical factor
143!  to obtain the proper contribution.
144        Z_CHI_N2O = P_COLN2O(JLON,JLAY)/P_COLDRY(JLON,JLAY)
145        ZRATN2O = 1.E20_JPRB*Z_CHI_N2O/CHI_MLS(4,K_JP(JLON,JLAY)+1)
146        IF (ZRATN2O > 1.5_JPRB) THEN
147           ZADJFAC = 0.5_JPRB+(ZRATN2O-0.5_JPRB)**0.65_JPRB
148           ZADJCOLN2O(JLON,JLAY) = ZADJFAC*CHI_MLS(4,K_JP(JLON,JLAY)+1)*P_COLDRY(JLON,JLAY)*1.E-20_JPRB
149        ELSE
150           ZADJCOLN2O(JLON,JLAY) = P_COLN2O(JLON,JLAY)
151        ENDIF
152       
153        Z_SPECCOMB_PLANCK(JLAY) = P_COLH2O(JLON,JLAY)+ZREFRAT_PLANCK_A*P_COLCO2(JLON,JLAY)
154        Z_SPECPARM_PLANCK = P_COLH2O(JLON,JLAY)/Z_SPECCOMB_PLANCK(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
161
162      IND0(JLAY) = ((K_JP(JLON,JLAY)-1)*5+(K_JT(JLON,JLAY)-1))*NSPA(3) + JS
163      IND1(JLAY) = (K_JP(JLON,JLAY)*5+(K_JT1(JLON,JLAY)-1))*NSPA(3) + JS1
164      INDS(JLAY) = K_INDSELF(JLON,JLAY)
165      INDF(JLAY) = K_INDFOR(JLON,JLAY)
166      INDM(JLAY) = KINDMINOR(JLON,JLAY)
167
168
169
170         IF (Z_SPECPARM < 0.125_JPRB) THEN
171            ZP = Z_FS - 1
172            ZP4 = ZP**4
173            ZFK0 = ZP4
174            ZFK1 = 1 - ZP - 2.0_JPRB*ZP4
175            ZFK2 = ZP + ZP4
176            Z_FAC000 = ZFK0*P_FAC00(JLON,JLAY)
177            Z_FAC100 = ZFK1*P_FAC00(JLON,JLAY)
178            Z_FAC200 = ZFK2*P_FAC00(JLON,JLAY)
179            Z_FAC010 = ZFK0*P_FAC10(JLON,JLAY)
180            Z_FAC110 = ZFK1*P_FAC10(JLON,JLAY)
181            Z_FAC210 = ZFK2*P_FAC10(JLON,JLAY)
182         ELSEIF (Z_SPECPARM > 0.875_JPRB) THEN
183            ZP = -Z_FS
184            ZP4 = ZP**4
185            ZFK0 = ZP4
186            ZFK1 = 1 - ZP - 2.0_JPRB*ZP4
187            ZFK2 = ZP + ZP4
188            Z_FAC000 = ZFK0*P_FAC00(JLON,JLAY)
189            Z_FAC100 = ZFK1*P_FAC00(JLON,JLAY)
190            Z_FAC200 = ZFK2*P_FAC00(JLON,JLAY)
191            Z_FAC010 = ZFK0*P_FAC10(JLON,JLAY)
192            Z_FAC110 = ZFK1*P_FAC10(JLON,JLAY)
193            Z_FAC210 = ZFK2*P_FAC10(JLON,JLAY)
194         ELSE
195            Z_FAC000 = (1._JPRB - Z_FS) * P_FAC00(JLON,JLAY)
196            Z_FAC010 = (1._JPRB - Z_FS) * P_FAC10(JLON,JLAY)
197            Z_FAC100 = Z_FS * P_FAC00(JLON,JLAY)
198            Z_FAC110 = Z_FS * P_FAC10(JLON,JLAY)
199         ENDIF
200         IF (Z_SPECPARM1 < 0.125_JPRB) THEN
201            ZP = Z_FS1 - 1
202            ZP4 = ZP**4
203            ZFK0 = ZP4
204            ZFK1 = 1 - ZP - 2.0_JPRB*ZP4
205            ZFK2 = ZP + ZP4
206            Z_FAC001 = ZFK0*P_FAC01(JLON,JLAY)
207            Z_FAC101 = ZFK1*P_FAC01(JLON,JLAY)
208            Z_FAC201 = ZFK2*P_FAC01(JLON,JLAY)
209            Z_FAC011 = ZFK0*P_FAC11(JLON,JLAY)
210            Z_FAC111 = ZFK1*P_FAC11(JLON,JLAY)
211            Z_FAC211 = ZFK2*P_FAC11(JLON,JLAY)
212         ELSEIF (Z_SPECPARM1 > 0.875_JPRB) THEN
213            ZP = -Z_FS1
214            ZP4 = ZP**4
215            ZFK0 = ZP4
216            ZFK1 = 1 - ZP - 2.0_JPRB*ZP4
217            ZFK2 = ZP + ZP4
218            Z_FAC001 = ZFK0*P_FAC01(JLON,JLAY)
219            Z_FAC101 = ZFK1*P_FAC01(JLON,JLAY)
220            Z_FAC201 = ZFK2*P_FAC01(JLON,JLAY)
221            Z_FAC011 = ZFK0*P_FAC11(JLON,JLAY)
222            Z_FAC111 = ZFK1*P_FAC11(JLON,JLAY)
223            Z_FAC211 = ZFK2*P_FAC11(JLON,JLAY)
224         ELSE
225            Z_FAC001 = (1._JPRB - Z_FS1) * P_FAC01(JLON,JLAY)
226            Z_FAC011 = (1._JPRB - Z_FS1) * P_FAC11(JLON,JLAY)
227            Z_FAC101 = Z_FS1 * P_FAC01(JLON,JLAY)
228            Z_FAC111 = Z_FS1 * P_FAC11(JLON,JLAY)
229         ENDIF
230
231
232
233
234
235!-- DS_000515
236!CDIR UNROLL=NG3
237      DO IG = 1, NG3
238!-- DS_000515
239         ZTAUSELF = P_SELFFAC(JLON,JLAY)* (SELFREF(INDS(JLAY),IG) + P_SELFFRAC(JLON,JLAY) * &
240            &    (SELFREF(INDS(JLAY)+1,IG) - SELFREF(INDS(JLAY),IG)))
241         ZTAUFOR = P_FORFAC(JLON,JLAY) * (FORREF(INDF(JLAY),IG) + P_FORFRAC(JLON,JLAY) * &
242            &    (FORREF(INDF(JLAY)+1,IG) - FORREF(INDF(JLAY),IG)))
243         ZN2OM1 = KA_MN2O(JMN2O,INDM(JLAY),IG) + Z_FMN2O * &
244            &    (KA_MN2O(JMN2O+1,INDM(JLAY),IG) - KA_MN2O(JMN2O,INDM(JLAY),IG))
245         ZN2OM2 = KA_MN2O(JMN2O,INDM(JLAY)+1,IG) + Z_FMN2O * &
246            &    (KA_MN2O(JMN2O+1,INDM(JLAY)+1,IG) - KA_MN2O(JMN2O,INDM(JLAY)+1,IG))
247         ZABSN2O = ZN2OM1 + PMINORFRAC(JLON,JLAY) * (ZN2OM2 - ZN2OM1)
248
249            IF (Z_SPECPARM < 0.125_JPRB) THEN
250               ZTAU_MAJOR = Z_SPECCOMB(JLAY) * &
251                 &  (Z_FAC000 * ABSA(IND0(JLAY),IG) + &
252                 &  Z_FAC100 * ABSA(IND0(JLAY)+1,IG) + &
253                 &  Z_FAC200 * ABSA(IND0(JLAY)+2,IG) + &
254                 &  Z_FAC010 * ABSA(IND0(JLAY)+9,IG) + &
255                 &  Z_FAC110 * ABSA(IND0(JLAY)+10,IG) + &
256                 &  Z_FAC210 * ABSA(IND0(JLAY)+11,IG))
257            ELSEIF (Z_SPECPARM > 0.875_JPRB) THEN
258               ZTAU_MAJOR = Z_SPECCOMB(JLAY) * &
259                 &  (Z_FAC200 * ABSA(IND0(JLAY)-1,IG) + &
260                 &  Z_FAC100 * ABSA(IND0(JLAY),IG) + &
261                 &  Z_FAC000 * ABSA(IND0(JLAY)+1,IG) + &
262                 &  Z_FAC210 * ABSA(IND0(JLAY)+8,IG) + &
263                 &  Z_FAC110 * ABSA(IND0(JLAY)+9,IG) + &
264                 &  Z_FAC010 * ABSA(IND0(JLAY)+10,IG))
265            ELSE
266               ZTAU_MAJOR = Z_SPECCOMB(JLAY) * &
267                 &  (Z_FAC000 * ABSA(IND0(JLAY),IG) + &
268                 &  Z_FAC100 * ABSA(IND0(JLAY)+1,IG) + &
269                 &  Z_FAC010 * ABSA(IND0(JLAY)+9,IG) + &
270                 &  Z_FAC110 * ABSA(IND0(JLAY)+10,IG))
271            ENDIF
272
273            IF (Z_SPECPARM1 < 0.125_JPRB) THEN
274               ZTAU_MAJOR1 = Z_SPECCOMB1(JLAY) * &
275                 &  (Z_FAC001 * ABSA(IND1(JLAY),IG) + &
276                 &  Z_FAC101 * ABSA(IND1(JLAY)+1,IG) + &
277                 &  Z_FAC201 * ABSA(IND1(JLAY)+2,IG) + &
278                 &  Z_FAC011 * ABSA(IND1(JLAY)+9,IG) + &
279                 &  Z_FAC111 * ABSA(IND1(JLAY)+10,IG) + &
280                 &  Z_FAC211 * ABSA(IND1(JLAY)+11,IG))
281            ELSEIF (Z_SPECPARM1 > 0.875_JPRB) THEN
282               ZTAU_MAJOR1 = Z_SPECCOMB1(JLAY) * &
283                 &  (Z_FAC201 * ABSA(IND1(JLAY)-1,IG) + &
284                 &  Z_FAC101 * ABSA(IND1(JLAY),IG) + &
285                 &  Z_FAC001 * ABSA(IND1(JLAY)+1,IG) + &
286                 &  Z_FAC211 * ABSA(IND1(JLAY)+8,IG) + &
287                 &  Z_FAC111 * ABSA(IND1(JLAY)+9,IG) + &
288                 &  Z_FAC011 * ABSA(IND1(JLAY)+10,IG))
289            ELSE
290               ZTAU_MAJOR1 = Z_SPECCOMB1(JLAY) * &
291                 &  (Z_FAC001 * ABSA(IND1(JLAY),IG) +  &
292                 &  Z_FAC101 * ABSA(IND1(JLAY)+1,IG) + &
293                 &  Z_FAC011 * ABSA(IND1(JLAY)+9,IG) + &
294                 &  Z_FAC111 * ABSA(IND1(JLAY)+10,IG))
295            ENDIF
296 
297
298        P_TAU(JLON,NGS2+IG,JLAY) = ZTAU_MAJOR + ZTAU_MAJOR1 &
299               & + ZTAUSELF + ZTAUFOR &
300               & + ZADJCOLN2O(JLON,JLAY)*ZABSN2O &
301               & + P_TAUAERL(JLON,JLAY,3) 
302
303        !if (JPL < 1) call abort
304
305        PFRAC(JLON,NGS2+IG,JLAY) = FRACREFA(IG,JPL) + Z_FPL *&
306         & (FRACREFA(IG,JPL+1) - FRACREFA(IG,JPL)) 
307      ENDDO
308    ENDIF
309
310    IF (JLAY > K_LAYTROP(JLON)) THEN
311      Z_SPECCOMB(JLAY) = P_COLH2O(JLON,JLAY) + PRAT_H2OCO2(JLON,JLAY)*P_COLCO2(JLON,JLAY)
312      Z_SPECPARM = P_COLH2O(JLON,JLAY)/Z_SPECCOMB(JLAY)
313      Z_SPECPARM=MIN(P_ONEMINUS,Z_SPECPARM)
314      Z_SPECMULT = 4._JPRB*(Z_SPECPARM)
315      JS = 1 + INT(Z_SPECMULT)
316      Z_FS = MOD(Z_SPECMULT,1.0_JPRB)
317
318      Z_SPECCOMB1(JLAY) = P_COLH2O(JLON,JLAY) + PRAT_H2OCO2_1(JLON,JLAY)*P_COLCO2(JLON,JLAY)
319      Z_SPECPARM1 = P_COLH2O(JLON,JLAY)/Z_SPECCOMB1(JLAY)
320      IF (Z_SPECPARM1 >= P_ONEMINUS) Z_SPECPARM1 = P_ONEMINUS
321      Z_SPECMULT1 = 4._JPRB*(Z_SPECPARM1)
322      JS1 = 1 + INT(Z_SPECMULT1)
323      Z_FS1 = MOD(Z_SPECMULT1,1.0_JPRB)
324
325      Z_FAC000 = (1._JPRB - Z_FS) * P_FAC00(JLON,JLAY)
326      Z_FAC010 = (1._JPRB - Z_FS) * P_FAC10(JLON,JLAY)
327      Z_FAC100 = Z_FS * P_FAC00(JLON,JLAY)
328      Z_FAC110 = Z_FS * P_FAC10(JLON,JLAY)
329      Z_FAC001 = (1._JPRB - Z_FS1) * P_FAC01(JLON,JLAY)
330      Z_FAC011 = (1._JPRB - Z_FS1) * P_FAC11(JLON,JLAY)
331      Z_FAC101 = Z_FS1 * P_FAC01(JLON,JLAY)
332      Z_FAC111 = Z_FS1 * P_FAC11(JLON,JLAY)
333
334
335        Z_SPECCOMB_MN2O(JLAY) = P_COLH2O(JLON,JLAY) + ZREFRAT_M_B*P_COLCO2(JLON,JLAY)
336        Z_SPECPARM_MN2O = P_COLH2O(JLON,JLAY)/Z_SPECCOMB_MN2O(JLAY)
337        IF (Z_SPECPARM_MN2O >= P_ONEMINUS) Z_SPECPARM_MN2O = P_ONEMINUS
338        Z_SPECMULT_MN2O = 4._JPRB*Z_SPECPARM_MN2O
339        JMN2O = 1 + INT(Z_SPECMULT_MN2O)
340        Z_FMN2O = MOD(Z_SPECMULT_MN2O,1.0_JPRB)
341        Z_FMN2OMF = PMINORFRAC(JLON,JLAY)*Z_FMN2O
342!  In atmospheres where the amount of N2O is too great to be considered
343!  a minor species, adjust the column amount of N2O by an empirical factor
344!  to obtain the proper contribution.
345        Z_CHI_N2O = P_COLN2O(JLON,JLAY)/P_COLDRY(JLON,JLAY)
346        ZRATN2O = 1.E20_JPRB*Z_CHI_N2O/CHI_MLS(4,K_JP(JLON,JLAY)+1)
347        IF (ZRATN2O > 1.5_JPRB) THEN
348           ZADJFAC = 0.5_JPRB+(ZRATN2O-0.5_JPRB)**0.65_JPRB
349           ZADJCOLN2O(JLON,JLAY) = ZADJFAC*CHI_MLS(4,K_JP(JLON,JLAY)+1)*P_COLDRY(JLON,JLAY)*1.E-20_JPRB
350        ELSE
351           ZADJCOLN2O(JLON,JLAY) = P_COLN2O(JLON,JLAY)
352        ENDIF
353       
354        Z_SPECCOMB_PLANCK(JLAY) = P_COLH2O(JLON,JLAY)+ZREFRAT_PLANCK_B*P_COLCO2(JLON,JLAY)
355        Z_SPECPARM_PLANCK = P_COLH2O(JLON,JLAY)/Z_SPECCOMB_PLANCK(JLAY)
356        IF (Z_SPECPARM_PLANCK >= P_ONEMINUS) Z_SPECPARM_PLANCK=P_ONEMINUS
357        Z_SPECMULT_PLANCK = 4._JPRB*Z_SPECPARM_PLANCK
358        JPL= 1 + INT(Z_SPECMULT_PLANCK)
359        Z_FPL = MOD(Z_SPECMULT_PLANCK,1.0_JPRB)
360
361       IND0(JLAY) = ((K_JP(JLON,JLAY)-13)*5+(K_JT(JLON,JLAY)-1))*NSPB(3) + JS
362       IND1(JLAY) = ((K_JP(JLON,JLAY)-12)*5+(K_JT1(JLON,JLAY)-1))*NSPB(3) + JS1
363       INDF(JLAY) = K_INDFOR(JLON,JLAY)
364       INDM(JLAY) = KINDMINOR(JLON,JLAY)
365
366
367!CDIR UNROLL=NG3
368      DO IG = 1, NG3
369         ZTAUFOR = P_FORFAC(JLON,JLAY) * (FORREF(INDF(JLAY),IG) + P_FORFRAC(JLON,JLAY) * &
370               & (FORREF(INDF(JLAY)+1,IG) - FORREF(INDF(JLAY),IG)))
371         ZN2OM1 = KB_MN2O(JMN2O,INDM(JLAY),IG) + Z_FMN2O * &
372               & (KB_MN2O(JMN2O+1,INDM(JLAY),IG) - KB_MN2O(JMN2O,INDM(JLAY),IG))
373         ZN2OM2 = KB_MN2O(JMN2O,INDM(JLAY)+1,IG) + Z_FMN2O * &
374               & (KB_MN2O(JMN2O+1,INDM(JLAY)+1,IG) - KB_MN2O(JMN2O,INDM(JLAY)+1,IG))
375         ZABSN2O = ZN2OM1 + PMINORFRAC(JLON,JLAY) * (ZN2OM2 - ZN2OM1)
376
377
378        P_TAU(JLON,NGS2+IG,JLAY) = Z_SPECCOMB(JLAY) *   &
379          &(Z_FAC000 * ABSB(IND0(JLAY)  ,IG) +&
380          & Z_FAC100 * ABSB(IND0(JLAY)+1,IG) +&
381          & Z_FAC010 * ABSB(IND0(JLAY)+5,IG) +&
382          & Z_FAC110 * ABSB(IND0(JLAY)+6,IG)) +&
383          & Z_SPECCOMB1(JLAY) * &
384          & (Z_FAC001 * ABSB(IND1(JLAY)  ,IG) +&
385          & Z_FAC101 * ABSB(IND1(JLAY)+1,IG) +&
386          & Z_FAC011 * ABSB(IND1(JLAY)+5,IG) +&
387          & Z_FAC111 * ABSB(IND1(JLAY)+6,IG))+&
388          & ZTAUFOR + ZADJCOLN2O(JLON,JLAY)*ZABSN2O &
389          & + P_TAUAERL(JLON,JLAY,3) 
390
391
392        PFRAC(JLON,NGS2+IG,JLAY) = FRACREFB(IG,JPL) + Z_FPL *&
393         & (FRACREFB(IG,JPL+1) - FRACREFB(IG,JPL)) 
394      ENDDO
395    ENDIF
396  ENDDO
397ENDDO
398
399IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL3',1,ZHOOK_HANDLE)
400
401END ASSOCIATE
402END SUBROUTINE RRTM_TAUMOL3
Note: See TracBrowser for help on using the repository browser.