source: LMDZ6/branches/Ocean_skin/libf/phylmd/ecrad/rrtm_taumol5.F90 @ 5054

Last change on this file since 5054 was 3908, checked in by idelkadi, 3 years ago

Online implementation of the radiative transfer code ECRAD in the LMDZ model.

  • Inclusion of the ecrad directory containing the sources of the ECRAD code
    • interface routine : radiation_scheme.F90
  • Adaptation of compilation scripts :
    • compilation under CPP key CPP_ECRAD
    • compilation with option "-rad ecard" or "-ecard true"
    • The "-rad old/rtm/ecran" build option will need to replace the "-rrtm true" and "-ecrad true" options in the future.
  • Runing LMDZ simulations with ecrad, you need :
    • logical key iflag_rrtm = 2 in physiq.def
    • namelist_ecrad (DefLists?)
    • the directory "data" containing the configuration files is temporarily placed in ../libfphylmd/ecrad/
  • Compilation and execution are tested in the 1D case. The repository under svn would allow to continue the implementation work: tests, verification of the results, ...
File size: 14.5 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
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 
89REAL(KIND=JPRB) :: ZHOOK_HANDLE
90
91! Minor gas mapping level :
92!     lower - o3, p = 317.34 mbar, t = 240.77 k
93!     lower - ccl4
94
95! Calculate reference ratio to be used in calculation of Planck
96! fraction in lower/upper atmosphere.
97
98! P = 473.420 mb
99      Z_REFRAT_PLANCK_A = CHI_MLS(1,5)/CHI_MLS(2,5)
100
101! P = 0.2369 mb
102      Z_REFRAT_PLANCK_B = CHI_MLS(3,43)/CHI_MLS(2,43)
103
104! P = 317.3480
105      Z_REFRAT_M_A = CHI_MLS(1,7)/CHI_MLS(2,7)
106
107
108!     Compute the optical depth by interpolating in ln(pressure),
109!     temperature, and appropriate species.  Below LAYTROP, the water
110!     vapor self-continuum and foreign continuum is
111!     interpolated (in temperature) separately. 
112
113ASSOCIATE(NFLEVG=>KLEV)
114IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL5',0,ZHOOK_HANDLE)
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) + P_RAT_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      Z_SPECCOMB1(JLAY) = P_COLH2O(JLON,JLAY) + P_RAT_H2OCO2_1(JLON,JLAY)*P_COLCO2(JLON,JLAY)
127      Z_SPECPARM1 = P_COLH2O(JLON,JLAY)/Z_SPECCOMB1(JLAY)
128      IF (Z_SPECPARM1 >= P_ONEMINUS) Z_SPECPARM1 = P_ONEMINUS
129      Z_SPECMULT1 = 8._JPRB*(Z_SPECPARM1)
130      JS1 = 1 + INT(Z_SPECMULT1)
131      Z_FS1 = MOD(Z_SPECMULT1,1.0_JPRB)
132
133      Z_SPECCOMB_MO3(JLAY) = P_COLH2O(JLON,JLAY) + Z_REFRAT_M_A*P_COLCO2(JLON,JLAY)
134      Z_SPECPARM_MO3 = P_COLH2O(JLON,JLAY)/Z_SPECCOMB_MO3(JLAY)
135      IF (Z_SPECPARM_MO3 >= P_ONEMINUS) Z_SPECPARM_MO3 = P_ONEMINUS
136      Z_SPECMULT_MO3 = 8._JPRB*Z_SPECPARM_MO3
137      JMO3 = 1 + INT(Z_SPECMULT_MO3)
138      Z_FMO3 = MOD(Z_SPECMULT_MO3,1.0_JPRB)
139
140      Z_SPECCOMB_PLANCK(JLAY) = P_COLH2O(JLON,JLAY)+Z_REFRAT_PLANCK_A*P_COLCO2(JLON,JLAY)
141      Z_SPECPARM_PLANCK = P_COLH2O(JLON,JLAY)/Z_SPECCOMB_PLANCK(JLAY)
142      IF (Z_SPECPARM_PLANCK >= P_ONEMINUS) Z_SPECPARM_PLANCK=P_ONEMINUS
143      Z_SPECMULT_PLANCK = 8._JPRB*Z_SPECPARM_PLANCK
144      JPL= 1 + INT(Z_SPECMULT_PLANCK)
145      Z_FPL = MOD(Z_SPECMULT_PLANCK,1.0_JPRB)
146
147
148      IND0(JLAY) = ((K_JP(JLON,JLAY)-1)*5+(K_JT(JLON,JLAY)-1))*NSPA(5) + JS
149      IND1(JLAY) = (K_JP(JLON,JLAY)*5+(K_JT1(JLON,JLAY)-1))*NSPA(5) + JS1
150      INDS(JLAY) = K_INDSELF(JLON,JLAY)
151      INDF(JLAY) = K_INDFOR(JLON,JLAY)
152      INDM(JLAY) = KINDMINOR(JLON,JLAY)
153
154
155      IF (Z_SPECPARM < 0.125_JPRB) THEN
156            ZP = Z_FS - 1
157            ZP4 = ZP**4
158            ZFK0 = ZP4
159            ZFK1 = 1 - ZP - 2.0_JPRB*ZP4
160            ZFK2 = ZP + ZP4
161            Z_FAC000 = ZFK0*P_FAC00(JLON,JLAY)
162            Z_FAC100 = ZFK1*P_FAC00(JLON,JLAY)
163            Z_FAC200 = ZFK2*P_FAC00(JLON,JLAY)
164            Z_FAC010 = ZFK0*P_FAC10(JLON,JLAY)
165            Z_FAC110 = ZFK1*P_FAC10(JLON,JLAY)
166            Z_FAC210 = ZFK2*P_FAC10(JLON,JLAY)
167      ELSEIF (Z_SPECPARM > 0.875_JPRB) THEN
168            ZP = -Z_FS
169            ZP4 = ZP**4
170            ZFK0 = ZP4
171            ZFK1 = 1 - ZP - 2.0_JPRB*ZP4
172            ZFK2 = ZP + ZP4
173            Z_FAC000 = ZFK0*P_FAC00(JLON,JLAY)
174            Z_FAC100 = ZFK1*P_FAC00(JLON,JLAY)
175            Z_FAC200 = ZFK2*P_FAC00(JLON,JLAY)
176            Z_FAC010 = ZFK0*P_FAC10(JLON,JLAY)
177            Z_FAC110 = ZFK1*P_FAC10(JLON,JLAY)
178            Z_FAC210 = ZFK2*P_FAC10(JLON,JLAY)
179      ELSE
180            Z_FAC000 = (1._JPRB - Z_FS) * P_FAC00(JLON,JLAY)
181            Z_FAC010 = (1._JPRB - Z_FS) * P_FAC10(JLON,JLAY)
182            Z_FAC100 = Z_FS * P_FAC00(JLON,JLAY)
183            Z_FAC110 = Z_FS * P_FAC10(JLON,JLAY)
184      ENDIF
185      IF (Z_SPECPARM1 < 0.125_JPRB) THEN
186            ZP = Z_FS1 - 1
187            ZP4 = ZP**4
188            ZFK0 = ZP4
189            ZFK1 = 1 - ZP - 2.0_JPRB*ZP4
190            ZFK2 = ZP + ZP4
191            Z_FAC001 = ZFK0*P_FAC01(JLON,JLAY)
192            Z_FAC101 = ZFK1*P_FAC01(JLON,JLAY)
193            Z_FAC201 = ZFK2*P_FAC01(JLON,JLAY)
194            Z_FAC011 = ZFK0*P_FAC11(JLON,JLAY)
195            Z_FAC111 = ZFK1*P_FAC11(JLON,JLAY)
196            Z_FAC211 = ZFK2*P_FAC11(JLON,JLAY)
197      ELSEIF (Z_SPECPARM1 > 0.875_JPRB) THEN
198            ZP = -Z_FS1
199            ZP4 = ZP**4
200            ZFK0 = ZP4
201            ZFK1 = 1 - ZP - 2.0_JPRB*ZP4
202            ZFK2 = ZP + ZP4
203            Z_FAC001 = ZFK0*P_FAC01(JLON,JLAY)
204            Z_FAC101 = ZFK1*P_FAC01(JLON,JLAY)
205            Z_FAC201 = ZFK2*P_FAC01(JLON,JLAY)
206            Z_FAC011 = ZFK0*P_FAC11(JLON,JLAY)
207            Z_FAC111 = ZFK1*P_FAC11(JLON,JLAY)
208            Z_FAC211 = ZFK2*P_FAC11(JLON,JLAY)
209      ELSE
210            Z_FAC001 = (1._JPRB - Z_FS1) * P_FAC01(JLON,JLAY)
211            Z_FAC011 = (1._JPRB - Z_FS1) * P_FAC11(JLON,JLAY)
212            Z_FAC101 = Z_FS1 * P_FAC01(JLON,JLAY)
213            Z_FAC111 = Z_FS1 * P_FAC11(JLON,JLAY)
214      ENDIF
215
216
217
218!CDIR UNROLL=NG5
219      DO IG = 1, NG5
220
221         ZTAUSELF = P_SELFFAC(JLON,JLAY)* (SELFREF(INDS(JLAY),IG) + P_SELFFRAC(JLON,JLAY) * &
222            &     (SELFREF(INDS(JLAY)+1,IG) - SELFREF(INDS(JLAY),IG)))
223         ZTAUFOR = P_FORFAC(JLON,JLAY) * (FORREF(INDF(JLAY),IG) + P_FORFRAC(JLON,JLAY) * &
224            &     (FORREF(INDF(JLAY)+1,IG) - FORREF(INDF(JLAY),IG)))
225         ZO3M1 = KA_MO3(JMO3,INDM(JLAY),IG) + Z_FMO3 * &
226            &     (KA_MO3(JMO3+1,INDM(JLAY),IG) - KA_MO3(JMO3,INDM(JLAY),IG))
227         ZO3M2 = KA_MO3(JMO3,INDM(JLAY)+1,IG) + Z_FMO3 * &
228            &     (KA_MO3(JMO3+1,INDM(JLAY)+1,IG) - KA_MO3(JMO3,INDM(JLAY)+1,IG))
229         ZABSO3 = ZO3M1 + PMINORFRAC(JLON,JLAY) * (ZO3M2 - ZO3M1)
230
231
232            IF (Z_SPECPARM < 0.125_JPRB) THEN
233               ZTAU_MAJOR = Z_SPECCOMB(JLAY) * &
234                 &   (Z_FAC000 * ABSA(IND0(JLAY),IG) + &
235                 &   Z_FAC100 * ABSA(IND0(JLAY)+1,IG) + &
236                 &   Z_FAC200 * ABSA(IND0(JLAY)+2,IG) + &
237                 &   Z_FAC010 * ABSA(IND0(JLAY)+9,IG) + &
238                 &   Z_FAC110 * ABSA(IND0(JLAY)+10,IG) + &
239                 &   Z_FAC210 * ABSA(IND0(JLAY)+11,IG))
240            ELSEIF (Z_SPECPARM > 0.875_JPRB) THEN
241               ZTAU_MAJOR = Z_SPECCOMB(JLAY) * &
242                 &   (Z_FAC200 * ABSA(IND0(JLAY)-1,IG) + &
243                 &   Z_FAC100 * ABSA(IND0(JLAY),IG) + &
244                 &   Z_FAC000 * ABSA(IND0(JLAY)+1,IG) + &
245                 &   Z_FAC210 * ABSA(IND0(JLAY)+8,IG) + &
246                 &   Z_FAC110 * ABSA(IND0(JLAY)+9,IG) + &
247                 &   Z_FAC010 * ABSA(IND0(JLAY)+10,IG))
248            ELSE
249               ZTAU_MAJOR = Z_SPECCOMB(JLAY) * &
250                 &   (Z_FAC000 * ABSA(IND0(JLAY),IG) + &
251                 &   Z_FAC100 * ABSA(IND0(JLAY)+1,IG) + &
252                 &   Z_FAC010 * ABSA(IND0(JLAY)+9,IG) + &
253                 &   Z_FAC110 * ABSA(IND0(JLAY)+10,IG))
254            ENDIF
255
256            IF (Z_SPECPARM1 < 0.125_JPRB) THEN
257               ZTAU_MAJOR1 = Z_SPECCOMB1(JLAY) * &
258                 &   (Z_FAC001 * ABSA(IND1(JLAY),IG) + &
259                 &   Z_FAC101 * ABSA(IND1(JLAY)+1,IG) + &
260                 &   Z_FAC201 * ABSA(IND1(JLAY)+2,IG) + &
261                 &   Z_FAC011 * ABSA(IND1(JLAY)+9,IG) + &
262                 &   Z_FAC111 * ABSA(IND1(JLAY)+10,IG) + &
263                 &   Z_FAC211 * ABSA(IND1(JLAY)+11,IG))
264            ELSEIF (Z_SPECPARM1 > 0.875_JPRB) THEN
265               ZTAU_MAJOR1 = Z_SPECCOMB1(JLAY) * &
266                 &   (Z_FAC201 * ABSA(IND1(JLAY)-1,IG) + &
267                 &   Z_FAC101 * ABSA(IND1(JLAY),IG) + &
268                 &   Z_FAC001 * ABSA(IND1(JLAY)+1,IG) + &
269                 &   Z_FAC211 * ABSA(IND1(JLAY)+8,IG) + &
270                 &   Z_FAC111 * ABSA(IND1(JLAY)+9,IG) + &
271                 &   Z_FAC011 * ABSA(IND1(JLAY)+10,IG))
272            ELSE
273               ZTAU_MAJOR1 = Z_SPECCOMB1(JLAY) * &
274                 &   (Z_FAC001 * ABSA(IND1(JLAY),IG) +  &
275                 &   Z_FAC101 * ABSA(IND1(JLAY)+1,IG) + &
276                 &   Z_FAC011 * ABSA(IND1(JLAY)+9,IG) + &
277                 &   Z_FAC111 * ABSA(IND1(JLAY)+10,IG))
278            ENDIF
279
280
281
282        P_TAU(JLON,NGS4+IG,JLAY) = ZTAU_MAJOR + ZTAU_MAJOR1 &
283         & + ZTAUSELF + ZTAUFOR &
284         & + ZABSO3*P_COLO3(JLON,JLAY) &
285         & + P_WX(JLON,1,JLAY) * CCL4(IG)&
286         & + P_TAUAERL(JLON,JLAY,5) 
287        PFRAC(JLON,NGS4+IG,JLAY) = FRACREFA(IG,JPL) + Z_FPL *&
288         & (FRACREFA(IG,JPL+1) - FRACREFA(IG,JPL)) 
289      ENDDO
290    ENDIF
291
292    IF (JLAY > K_LAYTROP(JLON)) THEN
293      Z_SPECCOMB(JLAY) = P_COLO3(JLON,JLAY) + P_RAT_O3CO2(JLON,JLAY)*P_COLCO2(JLON,JLAY)
294      Z_SPECPARM = P_COLO3(JLON,JLAY)/Z_SPECCOMB(JLAY)
295      Z_SPECPARM=MIN(P_ONEMINUS,Z_SPECPARM)
296      Z_SPECMULT = 4._JPRB*(Z_SPECPARM)
297      JS = 1 + INT(Z_SPECMULT)
298      Z_FS = MOD(Z_SPECMULT,1.0_JPRB)
299
300      Z_SPECCOMB1(JLAY) = P_COLO3(JLON,JLAY) + P_RAT_O3CO2_1(JLON,JLAY)*P_COLCO2(JLON,JLAY)
301      Z_SPECPARM1 = P_COLO3(JLON,JLAY)/Z_SPECCOMB1(JLAY)
302      IF (Z_SPECPARM1 >= P_ONEMINUS) Z_SPECPARM1 = P_ONEMINUS
303      Z_SPECMULT1 = 4._JPRB*(Z_SPECPARM1)
304      JS1 = 1 + INT(Z_SPECMULT1)
305      Z_FS1 = MOD(Z_SPECMULT1,1.0_JPRB)
306
307      Z_FAC000 = (1._JPRB - Z_FS) * P_FAC00(JLON,JLAY)
308      Z_FAC010 = (1._JPRB - Z_FS) * P_FAC10(JLON,JLAY)
309      Z_FAC100 = Z_FS * P_FAC00(JLON,JLAY)
310      Z_FAC110 = Z_FS * P_FAC10(JLON,JLAY)
311      Z_FAC001 = (1._JPRB - Z_FS1) * P_FAC01(JLON,JLAY)
312      Z_FAC011 = (1._JPRB - Z_FS1) * P_FAC11(JLON,JLAY)
313      Z_FAC101 = Z_FS1 * P_FAC01(JLON,JLAY)
314      Z_FAC111 = Z_FS1 * P_FAC11(JLON,JLAY)
315
316      Z_SPECCOMB_PLANCK(JLAY) = P_COLO3(JLON,JLAY)+Z_REFRAT_PLANCK_B*P_COLCO2(JLON,JLAY)
317      Z_SPECPARM_PLANCK = P_COLO3(JLON,JLAY)/Z_SPECCOMB_PLANCK(JLAY)
318      IF (Z_SPECPARM_PLANCK >= P_ONEMINUS) Z_SPECPARM_PLANCK=P_ONEMINUS
319      Z_SPECMULT_PLANCK = 4._JPRB*Z_SPECPARM_PLANCK
320      JPL= 1 + INT(Z_SPECMULT_PLANCK)
321      Z_FPL = MOD(Z_SPECMULT_PLANCK,1.0_JPRB)
322
323
324      IND0(JLAY) = ((K_JP(JLON,JLAY)-13)*5+(K_JT(JLON,JLAY)-1))*NSPB(5) + JS
325      IND1(JLAY) = ((K_JP(JLON,JLAY)-12)*5+(K_JT1(JLON,JLAY)-1))*NSPB(5) + JS1
326
327
328
329!CDIR UNROLL=NG5
330      DO IG = 1, NG5
331!-- DS_000515
332        P_TAU(JLON,NGS4+IG,JLAY) = Z_SPECCOMB(JLAY) *   &
333         &(Z_FAC000 * ABSB(IND0(JLAY)  ,IG) +&
334         & Z_FAC100 * ABSB(IND0(JLAY)+1,IG) +&
335         & Z_FAC010 * ABSB(IND0(JLAY)+5,IG) +&
336         & Z_FAC110 * ABSB(IND0(JLAY)+6,IG)) +&
337         & Z_SPECCOMB1(JLAY) * &
338         & (Z_FAC001 * ABSB(IND1(JLAY)  ,IG) +&
339         & Z_FAC101 * ABSB(IND1(JLAY)+1,IG) +&
340         & Z_FAC011 * ABSB(IND1(JLAY)+5,IG) +&
341         & Z_FAC111 * ABSB(IND1(JLAY)+6,IG))+&
342         & P_WX(JLON,1,JLAY) * CCL4(IG)+&
343         & P_TAUAERL(JLON,JLAY,5) 
344        PFRAC(JLON,NGS4+IG,JLAY) = FRACREFB(IG,JPL) + Z_FPL *&
345         & (FRACREFB(IG,JPL+1) - FRACREFB(IG,JPL)) 
346      ENDDO
347    ENDIF
348  ENDDO
349ENDDO
350
351IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL5',1,ZHOOK_HANDLE)
352
353END ASSOCIATE
354END SUBROUTINE RRTM_TAUMOL5
Note: See TracBrowser for help on using the repository browser.