LMDZ
rrtm_rtrn1a_140gp.F90
Go to the documentation of this file.
1 SUBROUTINE rrtm_rtrn1a_140gp (KLEV,K_ISTART,K_IEND,K_ICLDLYR,P_CLDFRAC,P_TAUCLD,P_ABSS1,&
2  & p_od,p_tausf1,p_clfnet,p_clhtr,p_fnet,p_htr,p_totdfluc,p_totdflux,p_totufluc,p_totuflux,&
3  & p_tavel,pz,p_tz,p_tbound,pfrac,p_semiss,p_semislw,k_ireflect)
4 
5 ! Reformatted for F90 by JJMorcrette, ECMWF, 980714
6 ! Speed-up by D.Salmond, ECMWF, 9907
7 ! Bug-fix by M.J. Iacono, AER, Inc., 9911
8 ! Bug-fix by JJMorcrette, ECMWF, 991209 (RAT1, RAT2 initialization)
9 ! Speed-up by D. Salmond, ECMWF, 9912
10 ! Bug-fix by JJMorcrette, ECMWF, 0005 (extrapolation T<160K)
11 ! Speed-up by D. Salmond, ECMWF, 000515
12 
13 !-* This program calculates the upward fluxes, downward fluxes,
14 ! and heating rates for an arbitrary atmosphere. The input to
15 ! this program is the atmospheric profile and all Planck function
16 ! information. First-order "numerical" quadrature is used for the
17 ! angle integration, i.e. only one exponential is computed per layer
18 ! per g-value per band. Cloud overlap is treated with a generalized
19 ! maximum/random method in which adjacent cloud layers are treated
20 ! with maximum overlap, and non-adjacent cloud groups are treated
21 ! with random overlap. For adjacent cloud layers, cloud information
22 ! is carried from the previous two layers.
23 
24 USE parkind1 ,ONLY : jpim ,jprb
25 USE yomhook ,ONLY : lhook, dr_hook
26 
27 USE parrrtm , ONLY : jpband ,jpgpt ,jplay
28 USE yoerrtab , ONLY : bpade
29 USE yoerrtwn , ONLY : totplnk ,delwave
30 USE yoerrtftr, ONLY : ngb
31 
32 IMPLICIT NONE
33 
34 INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
35 INTEGER(KIND=JPIM),INTENT(IN) :: K_ISTART
36 INTEGER(KIND=JPIM),INTENT(IN) :: K_IEND
37 INTEGER(KIND=JPIM),INTENT(IN) :: K_ICLDLYR(jplay) ! Cloud indicator
38 REAL(KIND=JPRB) ,INTENT(IN) :: P_CLDFRAC(jplay) ! Cloud fraction
39 REAL(KIND=JPRB) :: Z_CLDFRAC(jplay) ! Cloud fraction
40 REAL(KIND=JPRB) ,INTENT(IN) :: P_TAUCLD(jplay,jpband) ! Spectral optical thickness
41 REAL(KIND=JPRB) ,INTENT(IN) :: P_ABSS1(jpgpt*jplay)
42 REAL(KIND=JPRB) ,INTENT(IN) :: P_OD(jpgpt,jplay)
43 REAL(KIND=JPRB) ,INTENT(IN) :: P_TAUSF1(jpgpt*jplay)
44 REAL(KIND=JPRB) :: P_CLFNET(0:jplay) ! Argument NOT used
45 REAL(KIND=JPRB) :: P_CLHTR(0:jplay) ! Argument NOT used
46 REAL(KIND=JPRB) :: P_FNET(0:jplay) ! Argument NOT used
47 REAL(KIND=JPRB) :: P_HTR(0:jplay) ! Argument NOT used
48 REAL(KIND=JPRB) ,INTENT(OUT) :: P_TOTDFLUC(0:jplay)
49 REAL(KIND=JPRB) ,INTENT(OUT) :: P_TOTDFLUX(0:jplay)
50 REAL(KIND=JPRB) ,INTENT(OUT) :: P_TOTUFLUC(0:jplay)
51 REAL(KIND=JPRB) ,INTENT(OUT) :: P_TOTUFLUX(0:jplay)
52 REAL(KIND=JPRB) ,INTENT(IN) :: P_TAVEL(jplay)
53 REAL(KIND=JPRB) :: PZ(0:jplay) ! Argument NOT used
54 REAL(KIND=JPRB) ,INTENT(IN) :: P_TZ(0:jplay)
55 REAL(KIND=JPRB) ,INTENT(IN) :: P_TBOUND
56 REAL(KIND=JPRB) ,INTENT(IN) :: PFRAC(jpgpt,jplay)
57 REAL(KIND=JPRB) ,INTENT(IN) :: P_SEMISS(jpband)
58 REAL(KIND=JPRB) ,INTENT(OUT) :: P_SEMISLW
59 INTEGER(KIND=JPIM) :: K_IREFLECT ! Argument NOT used
60 !- from PROFILE
61 !- from SP
62 !- from SURFACE
63 INTEGER(KIND=JPIM) :: INDLAY(jplay),INDLEV(0:jplay)
64 
65 REAL(KIND=JPRB) :: Z_BBU1(jpgpt*jplay),Z_BBUTOT1(jpgpt*jplay)
66 REAL(KIND=JPRB) :: Z_TLAYFRAC(jplay),Z_TLEVFRAC(0:jplay)
67 REAL(KIND=JPRB) :: Z_BGLEV(jpgpt)
68 !-- DS_000515
69 REAL(KIND=JPRB) :: Z_PLVL(jpband+1,0:jplay),Z_PLAY(jpband+1,0:jplay),Z_WTNUM(3)
70 !-- DS_000515
71 REAL(KIND=JPRB) :: Z_ODCLDNW(jpgpt,jplay)
72 REAL(KIND=JPRB) :: Z_SEMIS(jpgpt),Z_RADUEMIT(jpgpt)
73 
74 REAL(KIND=JPRB) :: Z_RADCLRU1(jpgpt) ,Z_RADCLRD1(jpgpt)
75 REAL(KIND=JPRB) :: Z_RADLU1(jpgpt) ,Z_RADLD1(jpgpt)
76 !-- DS_000515
77 REAL(KIND=JPRB) :: Z_TRNCLD(jplay,jpband+1)
78 !-- DS_000515
79 REAL(KIND=JPRB) :: Z_ABSCLDNW(jpgpt,jplay)
80 REAL(KIND=JPRB) :: Z_ATOT1(jpgpt*jplay)
81 
82 REAL(KIND=JPRB) :: Z_SURFEMIS(jpband),Z_PLNKEMIT(jpband)
83 
84 ! dimension of arrays required for cloud overlap calculations
85 
86 REAL(KIND=JPRB) :: Z_CLRRADU(jpgpt),Z_CLDRADU(jpgpt),Z_OLDCLD(jpgpt)
87 REAL(KIND=JPRB) :: Z_OLDCLR(jpgpt),Z_RAD(jpgpt),Z_FACCLD1(jplay+1),Z_FACCLD2(jplay+1)
88 REAL(KIND=JPRB) :: Z_FACCLR1(jplay+1),Z_FACCLR2(jplay+1)
89 REAL(KIND=JPRB) :: Z_FACCMB1(jplay+1),Z_FACCMB2(jplay+1)
90 REAL(KIND=JPRB) :: Z_FACCLD1D(0:jplay),Z_FACCLD2D(0:jplay),Z_FACCLR1D(0:jplay)
91 REAL(KIND=JPRB) :: Z_FACCLR2D(0:jplay),Z_FACCMB1D(0:jplay),Z_FACCMB2D(0:jplay)
92 REAL(KIND=JPRB) :: Z_CLRRADD(jpgpt),Z_CLDRADD(jpgpt)
93 INTEGER(KIND=JPIM) :: istcld(jplay+1),istcldd(0:jplay)
94 !******
95 
96 !REAL_B :: ZPLVL(JPGPT+1,JPLAY) ,ZPLAY(JPGPT+1,JPLAY)
97 !REAL_B :: ZTRNCLD(JPGPT+1,JPLAY),ZTAUCLD(JPGPT+1,JPLAY)
98 
99 INTEGER(KIND=JPIM) :: IBAND, ICLDDN, IENT, INDBOUND, INDEX, IPR, I_LAY, I_LEV, I_NBI
100 
101 REAL(KIND=JPRB) :: Z_BBD, Z_BBDTOT, Z_BGLAY, Z_CLDSRC, Z_DBDTLAY, Z_DBDTLEV,&
102  & Z_DELBGDN, Z_DELBGUP, Z_DRAD1, Z_DRADCL1, Z_FACTOT1, &
103  & Z_FMAX, Z_FMIN, Z_GASSRC, Z_ODSM, Z_PLANKBND, Z_RADCLD, Z_RADD, Z_RADMOD, Z_RAT1, Z_RAT2, Z_SUMPL, &
104  & Z_SUMPLEM, Z_TBNDFRAC, Z_TRNS, Z_TTOT, Z_URAD1, Z_URADCL1, ZEXTAU
105 REAL(KIND=JPRB) :: ZHOOK_HANDLE
106 
107 
108 
109 REAL(KIND=JPRB) :: CLFNET(0:jplay) ! Argument NOT used
110 REAL(KIND=JPRB) :: CLHTR(0:jplay) ! Argument NOT used
111 REAL(KIND=JPRB) :: FNET(0:jplay) ! Argument NOT used
112 REAL(KIND=JPRB) :: HTR(0:jplay) ! Argument NOT used
113 
114 
115 
116 !--------------------------------------------------------------------------
117 ! Input
118 ! JPLAY ! Maximum number of model layers
119 ! JPGPT ! Total number of g-point subintervals
120 ! JPBAND ! Number of longwave spectral bands
121 ! SECANG ! Diffusivity angle
122 ! WTNUM ! Weight for radiance to flux conversion
123 ! KLEV ! Number of model layers
124 ! PAVEL(JPLAY) ! Mid-layer pressures (hPa)
125 ! PZ(0:JPLAY) ! Interface pressures (hPa)
126 ! TAVEL(JPLAY) ! Mid-layer temperatures (K)
127 ! TZ(0:JPLAY) ! Interface temperatures (K)
128 ! TBOUND ! Surface temperature
129 ! CLDFRAC(JPLAY) ! Layer cloud fraction
130 ! TAUCLD(JPLAY,JPBAND) ! Layer cloud optical thickness
131 ! ITR
132 ! PFRAC(JPGPT,JPLAY) ! Planck function fractions
133 ! ICLDLYR(JPLAY) ! Flag for cloudy layers
134 ! ICLD ! Flag for cloudy column
135 ! IREFLECT ! Flag for specular reflection
136 ! SEMISS(JPBAND) ! Surface spectral emissivity
137 ! BPADE ! Pade constant
138 ! OD ! Clear-sky optical thickness
139 ! TAUSF1 !
140 ! ABSS1 !
141 
142 ! ABSS(JPGPT*JPLAY) !
143 ! ABSCLD(JPLAY) !
144 ! ATOT(JPGPT*JPLAY) !
145 ! ODCLR(JPGPT,JPLAY) !
146 ! ODCLD(JPBAND,JPLAY) !
147 ! EFCLFR1(JPBAND,JPLAY) ! Effective cloud fraction
148 ! RADLU(JPGPT) ! Upward radiance
149 ! URAD ! Spectrally summed upward radiance
150 ! RADCLRU(JPGPT) ! Clear-sky upward radiance
151 ! CLRURAD ! Spectrally summed clear-sky upward radiance
152 ! RADLD(JPGPT) ! Downward radiance
153 ! DRAD ! Spectrally summed downward radiance
154 ! RADCLRD(JPGPT) ! Clear-sky downward radiance
155 ! CLRDRAD ! Spectrally summed clear-sky downward radiance
156 
157 ! Output
158 ! TOTUFLUX(0:JPLAY) ! Upward longwave flux
159 ! TOTDFLUX(0:JPLAY) ! Downward longwave flux
160 ! TOTUFLUC(0:JPLAY) ! Clear-sky upward longwave flux
161 ! TOTDFLUC(0:JPLAY) ! Clear-sky downward longwave flux
162 
163 ! Maximum/Random cloud overlap variables
164 ! for upward radiaitve transfer
165 ! FACCLR2 fraction of clear radiance from previous layer that needs to
166 ! be switched to cloudy stream
167 ! FACCLR1 fraction of the radiance that had been switched in the previous
168 ! layer from cloudy to clear that needs to be switched back to
169 ! cloudy in the current layer
170 ! FACCLD2 fraction of cloudy radiance from previous layer that needs to
171 ! be switched to clear stream
172 ! be switched to cloudy stream
173 ! FACCLD1 fraction of the radiance that had been switched in the previous
174 ! layer from clear to cloudy that needs to be switched back to
175 ! clear in the current layer
176 ! for downward radiaitve transfer
177 ! FACCLR2D fraction of clear radiance from previous layer that needs to
178 ! be switched to cloudy stream
179 ! FACCLR1D fraction of the radiance that had been switched in the previous
180 ! layer from cloudy to clear that needs to be switched back to
181 ! cloudy in the current layer
182 ! FACCLD2D fraction of cloudy radiance from previous layer that needs to
183 ! be switched to clear stream
184 ! be switched to cloudy stream
185 ! FACCLD1D fraction of the radiance that had been switched in the previous
186 ! layer from clear to cloudy that needs to be switched back to
187 ! clear in the current layer
188 
189 !--------------------------------------------------------------------------
190 
191 ! CORRECTION PROVISOIRE BUG POTENTIEL MPLFH
192 ! on initialise le niveau klev+1 de p_cldfrac, tableau surdimensionne
193 ! a 100 mais apparemment non initialise en klev+1
194 z_cldfrac(1:klev)=p_cldfrac(1:klev)
195 z_cldfrac(klev+1)=0.0_jprb
196 IF (lhook) CALL dr_hook('RRTM_RTRN1A_140GP',0,zhook_handle)
197 z_wtnum(1)=0.5_jprb
198 z_wtnum(2)=0.0_jprb
199 z_wtnum(3)=0.0_jprb
200 
201 DO i_lay = 0, klev
202 ENDDO
203 !-start JJM_000511
204 IF (p_tbound < 339._jprb .AND. p_tbound >= 160._jprb ) THEN
205  indbound = p_tbound - 159._jprb
206  z_tbndfrac = p_tbound - int(p_tbound)
207 ELSEIF (p_tbound >= 339._jprb ) THEN
208  indbound = 180
209  z_tbndfrac = p_tbound - 339._jprb
210 ELSEIF (p_tbound < 160._jprb ) THEN
211  indbound = 1
212  z_tbndfrac = p_tbound - 160._jprb
213 ENDIF
214 !-end JJM_000511
215 
216 DO i_lay = 0, klev
217  p_totufluc(i_lay) = 0.0_jprb
218  p_totdfluc(i_lay) = 0.0_jprb
219  p_totuflux(i_lay) = 0.0_jprb
220  p_totdflux(i_lay) = 0.0_jprb
221 !-start JJM_000511
222  IF (p_tz(i_lay) < 339._jprb .AND. p_tz(i_lay) >= 160._jprb ) THEN
223  indlev(i_lay) = p_tz(i_lay) - 159._jprb
224  z_tlevfrac(i_lay) = p_tz(i_lay) - int(p_tz(i_lay))
225  ELSEIF (p_tz(i_lay) >= 339._jprb ) THEN
226  indlev(i_lay) = 180
227  z_tlevfrac(i_lay) = p_tz(i_lay) - 339._jprb
228  ELSEIF (p_tz(i_lay) < 160._jprb ) THEN
229  indlev(i_lay) = 1
230  z_tlevfrac(i_lay) = p_tz(i_lay) - 160._jprb
231  ENDIF
232 !-end JJM_000511
233 ENDDO
234 
235 !_start_jjm 991209
236 DO i_lev=0,klev
237  z_faccld1(i_lev+1) = 0.0_jprb
238  z_faccld2(i_lev+1) = 0.0_jprb
239  z_facclr1(i_lev+1) = 0.0_jprb
240  z_facclr2(i_lev+1) = 0.0_jprb
241  z_faccmb1(i_lev+1) = 0.0_jprb
242  z_faccmb2(i_lev+1) = 0.0_jprb
243  z_faccld1d(i_lev) = 0.0_jprb
244  z_faccld2d(i_lev) = 0.0_jprb
245  z_facclr1d(i_lev) = 0.0_jprb
246  z_facclr2d(i_lev) = 0.0_jprb
247  z_faccmb1d(i_lev) = 0.0_jprb
248  z_faccmb2d(i_lev) = 0.0_jprb
249 ENDDO
250 
251 z_rat1 = 0.0_jprb
252 z_rat2 = 0.0_jprb
253 
254 !_end_jjm 991209
255 
256 z_sumpl = 0.0_jprb
257 z_sumplem = 0.0_jprb
258 
259 istcld(1) = 1
260 istcldd(klev) = 1
261 
262 DO i_lev = 1, klev
263 !-- DS_000515
264 !-start JJM_000511
265  IF (p_tavel(i_lev) < 339._jprb .AND. p_tavel(i_lev) >= 160._jprb ) THEN
266  indlay(i_lev) = p_tavel(i_lev) - 159._jprb
267  z_tlayfrac(i_lev) = p_tavel(i_lev) - int(p_tavel(i_lev))
268  ELSEIF (p_tavel(i_lev) >= 339._jprb ) THEN
269  indlay(i_lev) = 180
270  z_tlayfrac(i_lev) = p_tavel(i_lev) - 339._jprb
271  ELSEIF (p_tavel(i_lev) < 160._jprb ) THEN
272  indlay(i_lev) = 1
273  z_tlayfrac(i_lev) = p_tavel(i_lev) - 160._jprb
274  ENDIF
275 !-end JJM_000511
276 ENDDO
277 !-- DS_000515
278 
279 !-- DS_000515
280 !OCL SCALAR
281 
282 DO i_lev = 1, klev
283  IF (k_icldlyr(i_lev) == 1) THEN
284 
285 !mji
286  istcld(i_lev+1) = 0
287  IF (i_lev == klev) THEN
288  z_faccld1(i_lev+1) = 0.0_jprb
289  z_faccld2(i_lev+1) = 0.0_jprb
290  z_facclr1(i_lev+1) = 0.0_jprb
291  z_facclr2(i_lev+1) = 0.0_jprb
292 !-- DS_000515
293 !SB debug >>
294  z_faccmb1(i_lev+1) =0.0_jprb
295  z_faccmb2(i_lev+1) =0.0_jprb
296 !SB debug <<
297 !mji ISTCLD(LEV+1) = _ZERO_
298  ELSEIF (z_cldfrac(i_lev+1) >= z_cldfrac(i_lev)) THEN
299  z_faccld1(i_lev+1) = 0.0_jprb
300  z_faccld2(i_lev+1) = 0.0_jprb
301  IF (istcld(i_lev) == 1) THEN
302 !mji ISTCLD(LEV+1) = 0
303  z_facclr1(i_lev+1) = 0.0_jprb
304 !mji
305  z_facclr2(i_lev+1) = 0.0_jprb
306  IF (z_cldfrac(i_lev) < 1.0_jprb) THEN
307  z_facclr2(i_lev+1) = (z_cldfrac(i_lev+1)-z_cldfrac(i_lev))/&
308  & (1.0_jprb-z_cldfrac(i_lev))
309  ENDIF
310 !SB debug >>
311  z_facclr2(i_lev) = 0.0_jprb
312  z_faccld2(i_lev) = 0.0_jprb
313 !SB debug <<
314  ELSE
315  z_fmax = max(z_cldfrac(i_lev),z_cldfrac(i_lev-1))
316 !mji
317  IF (z_cldfrac(i_lev+1) > z_fmax) THEN
318  z_facclr1(i_lev+1) = z_rat2
319  z_facclr2(i_lev+1) = (z_cldfrac(i_lev+1)-z_fmax)/(1.0_jprb-z_fmax)
320 !mji
321  ELSEIF (z_cldfrac(i_lev+1) < z_fmax) THEN
322  z_facclr1(i_lev+1) = (z_cldfrac(i_lev+1)-z_cldfrac(i_lev))/&
323  & (z_cldfrac(i_lev-1)-z_cldfrac(i_lev))
324  z_facclr2(i_lev+1) = 0.0_jprb
325 !mji
326  ELSE
327  z_facclr1(i_lev+1) = z_rat2
328  z_facclr2(i_lev+1) = 0.0_jprb
329  ENDIF
330  ENDIF
331  IF (z_facclr1(i_lev+1) > 0.0_jprb .OR. z_facclr2(i_lev+1) > 0.0_jprb) THEN
332  z_rat1 = 1.0_jprb
333  z_rat2 = 0.0_jprb
334 !SB debug >>
335 ! ENDIF
336  ELSE
337  z_rat1 = 0.0_jprb
338  z_rat2 = 0.0_jprb
339  ENDIF
340 !SB debug <<
341  ELSE
342  z_facclr1(i_lev+1) = 0.0_jprb
343  z_facclr2(i_lev+1) = 0.0_jprb
344  IF (istcld(i_lev) == 1) THEN
345 !mji ISTCLD(LEV+1) = 0
346  z_faccld1(i_lev+1) = 0.0_jprb
347  z_faccld2(i_lev+1) = (z_cldfrac(i_lev)-z_cldfrac(i_lev+1))/z_cldfrac(i_lev)
348 !SB debug >>
349  z_facclr2(i_lev) = 0.0_jprb
350  z_faccld2(i_lev) = 0.0_jprb
351 !SB debug <<
352  ELSE
353  z_fmin = min(z_cldfrac(i_lev),z_cldfrac(i_lev-1))
354  IF (z_cldfrac(i_lev+1) <= z_fmin) THEN
355  z_faccld1(i_lev+1) = z_rat1
356  z_faccld2(i_lev+1) = (z_fmin-z_cldfrac(i_lev+1))/z_fmin
357  ELSE
358  z_faccld1(i_lev+1) = (z_cldfrac(i_lev)-z_cldfrac(i_lev+1))/&
359  & (z_cldfrac(i_lev)-z_fmin)
360  z_faccld2(i_lev+1) = 0.0_jprb
361  ENDIF
362  ENDIF
363  IF (z_faccld1(i_lev+1) > 0.0_jprb .OR. z_faccld2(i_lev+1) > 0.0_jprb) THEN
364  z_rat1 = 0.0_jprb
365  z_rat2 = 1.0_jprb
366 !SB debug >>
367 ! ENDIF
368  ELSE
369  z_rat1 = 0.0_jprb
370  z_rat2 = 0.0_jprb
371  ENDIF
372 !SB debug <<
373  ENDIF
374 !fcc
375 
376 !SB debug >>
377 ! IF (I_LEV == 1) THEN
378 ! Z_FACCMB1(I_LEV+1) = 0.
379 ! Z_FACCMB2(I_LEV+1) = Z_FACCLD1(I_LEV+1) * Z_FACCLR2(I_LEV)
380 ! ELSE
381 ! Z_FACCMB1(I_LEV+1) = Z_FACCLR1(I_LEV+1) * Z_FACCLD2(I_LEV) *Z_CLDFRAC(I_LEV-1)
382 ! Z_FACCMB2(I_LEV+1) = Z_FACCLD1(I_LEV+1) * Z_FACCLR2(I_LEV) *&
383 ! & (1.0_JPRB - Z_CLDFRAC(I_LEV-1))
384 ! ENDIF
385  if(istcld(i_lev).ne.1) then
386  z_faccmb1(i_lev+1) = max(0.,min(z_cldfrac(i_lev+1)-z_cldfrac(i_lev), &
387  z_cldfrac(i_lev-1)-z_cldfrac(i_lev)))
388  z_faccmb2(i_lev+1) = max(0.,min(z_cldfrac(i_lev)-z_cldfrac(i_lev+1), &
389  z_cldfrac(i_lev)-z_cldfrac(i_lev-1)))
390  endif
391 !SB debug <<
392 !end fcc
393  ELSE
394 !-- DS_000515
395  istcld(i_lev+1) = 1
396  ENDIF
397 ENDDO
398 
399 !_start_jjm 991209
400 z_rat1 = 0.0_jprb
401 z_rat2 = 0.0_jprb
402 !_end_jjm 991209
403 
404 !-- DS_000515
405 !OCL SCALAR
406 
407 DO i_lev = klev, 1, -1
408  IF (k_icldlyr(i_lev) == 1) THEN
409 !mji
410  istcldd(i_lev-1) = 0
411  IF (i_lev == 1) THEN
412  z_faccld1d(i_lev-1) = 0.0_jprb
413  z_faccld2d(i_lev-1) = 0.0_jprb
414  z_facclr1d(i_lev-1) = 0.0_jprb
415  z_facclr2d(i_lev-1) = 0.0_jprb
416  z_faccmb1d(i_lev-1) = 0.0_jprb
417  z_faccmb2d(i_lev-1) = 0.0_jprb
418 !mji ISTCLDD(LEV-1) = _ZERO_
419  ELSEIF (z_cldfrac(i_lev-1) >= z_cldfrac(i_lev)) THEN
420  z_faccld1d(i_lev-1) = 0.0_jprb
421  z_faccld2d(i_lev-1) = 0.0_jprb
422  IF (istcldd(i_lev) == 1) THEN
423 !mji ISTCLDD(LEV-1) = 0
424  z_facclr1d(i_lev-1) = 0.0_jprb
425  z_facclr2d(i_lev-1) = 0.0_jprb
426  IF (z_cldfrac(i_lev) < 1.0_jprb) THEN
427  z_facclr2d(i_lev-1) = (z_cldfrac(i_lev-1)-z_cldfrac(i_lev))/&
428  & (1.0_jprb-z_cldfrac(i_lev))
429  ENDIF
430 !SB debug >>
431  z_facclr2d(i_lev)=0.0_jprb
432  z_faccld2d(i_lev)=0.0_jprb
433 !SB debug <<
434  ELSE
435  z_fmax = max(z_cldfrac(i_lev),z_cldfrac(i_lev+1))
436 !mji
437  IF (z_cldfrac(i_lev-1) > z_fmax) THEN
438  z_facclr1d(i_lev-1) = z_rat2
439  z_facclr2d(i_lev-1) = (z_cldfrac(i_lev-1)-z_fmax)/(1.0_jprb-z_fmax)
440 !mji
441  ELSEIF (z_cldfrac(i_lev-1) < z_fmax) THEN
442  z_facclr1d(i_lev-1) = (z_cldfrac(i_lev-1)-z_cldfrac(i_lev))/&
443  & (z_cldfrac(i_lev+1)-z_cldfrac(i_lev))
444  z_facclr2d(i_lev-1) = 0.0_jprb
445 !mji
446  ELSE
447  z_facclr1d(i_lev-1) = z_rat2
448  z_facclr2d(i_lev-1) = 0.0_jprb
449  ENDIF
450  ENDIF
451  IF (z_facclr1d(i_lev-1) > 0.0_jprb .OR. z_facclr2d(i_lev-1) > 0.0_jprb)THEN
452  z_rat1 = 1.0_jprb
453  z_rat2 = 0.0_jprb
454 !SB debug >>
455 ! ENDIF
456  else
457  z_rat1 = 0.0_jprb
458  z_rat2 = 0.0_jprb
459  endif
460 !SB debug <<
461  ELSE
462  z_facclr1d(i_lev-1) = 0.0_jprb
463  z_facclr2d(i_lev-1) = 0.0_jprb
464  IF (istcldd(i_lev) == 1) THEN
465 !mji ISTCLDD(LEV-1) = 0
466  z_faccld1d(i_lev-1) = 0.0_jprb
467  z_faccld2d(i_lev-1) = (z_cldfrac(i_lev)-z_cldfrac(i_lev-1))/z_cldfrac(i_lev)
468 !SB debug >>
469  z_facclr2d(i_lev)=0.0_jprb
470  z_faccld2d(i_lev)=0.0_jprb
471 !SB debug <<
472  ELSE
473  z_fmin = min(z_cldfrac(i_lev),z_cldfrac(i_lev+1))
474  IF (z_cldfrac(i_lev-1) <= z_fmin) THEN
475  z_faccld1d(i_lev-1) = z_rat1
476  z_faccld2d(i_lev-1) = (z_fmin-z_cldfrac(i_lev-1))/z_fmin
477  ELSE
478  z_faccld1d(i_lev-1) = (z_cldfrac(i_lev)-z_cldfrac(i_lev-1))/&
479  & (z_cldfrac(i_lev)-z_fmin)
480  z_faccld2d(i_lev-1) = 0.0_jprb
481  ENDIF
482  ENDIF
483  IF (z_faccld1d(i_lev-1) > 0.0_jprb .OR. z_faccld2d(i_lev-1) > 0.0_jprb)THEN
484  z_rat1 = 0.0_jprb
485  z_rat2 = 1.0_jprb
486 !SB debug >>
487 ! ENDIF
488  ELSE
489  z_rat1 = 0.0_jprb
490  z_rat2 = 0.0_jprb
491  ENDIF
492 !SB debug <<
493  ENDIF
494 !SB debug >>
495 ! Z_FACCMB1D(I_LEV-1) = Z_FACCLR1D(I_LEV-1) * Z_FACCLD2D(I_LEV) *Z_CLDFRAC(I_LEV+1)
496 ! Z_FACCMB2D(I_LEV-1) = Z_FACCLD1D(I_LEV-1) * Z_FACCLR2D(I_LEV) *&
497 ! & (1.0_JPRB - Z_CLDFRAC(I_LEV+1))
498  if (istcldd(i_lev).ne.1.and.i_lev.ne.0) then
499  z_faccmb1d(i_lev-1) = max(0.,min(z_cldfrac(i_lev+1)-z_cldfrac(i_lev), &
500  z_cldfrac(i_lev-1)-z_cldfrac(i_lev)))
501  z_faccmb2d(i_lev-1) = max(0.,min(z_cldfrac(i_lev)-z_cldfrac(i_lev+1), &
502  z_cldfrac(i_lev)-z_cldfrac(i_lev-1)))
503  endif
504 !SB debug <<
505  ELSE
506  istcldd(i_lev-1) = 1
507  ENDIF
508 ENDDO
509 
510 !- Loop over frequency bands.
511 
512 DO iband = k_istart, k_iend
513  z_dbdtlev = totplnk(indbound+1,iband)-totplnk(indbound,iband)
514  z_plankbnd = delwave(iband) * (totplnk(indbound,iband) + z_tbndfrac * z_dbdtlev)
515  z_dbdtlev = totplnk(indlev(0)+1,iband) -totplnk(indlev(0),iband)
516 !-- DS_000515
517  z_plvl(iband,0) = delwave(iband)&
518  & * (totplnk(indlev(0),iband) + z_tlevfrac(0)*z_dbdtlev)
519 
520  z_surfemis(iband) = p_semiss(iband)
521  z_plnkemit(iband) = z_surfemis(iband) * z_plankbnd
522  z_sumplem = z_sumplem + z_plnkemit(iband)
523  z_sumpl = z_sumpl + z_plankbnd
524 !--DS
525 ENDDO
526 !---
527 
528 !-- DS_000515
529 DO i_lev = 1, klev
530  DO iband = k_istart, k_iend
531 ! print *,'RTRN1A: I_LEV JPLAY IBAND INDLAY',I_LEV,JPLAY,IBAND,INDLAY(I_LEV)
532 !----
533 !- Calculate the integrated Planck functions for at the
534 ! level and layer temperatures.
535 ! Compute cloud transmittance for cloudy layers.
536  z_dbdtlev = totplnk(indlev(i_lev)+1,iband) - totplnk(indlev(i_lev),iband)
537  z_dbdtlay = totplnk(indlay(i_lev)+1,iband) - totplnk(indlay(i_lev),iband)
538 !-- DS_000515
539  z_play(iband,i_lev) = delwave(iband)&
540  & *(totplnk(indlay(i_lev),iband)+z_tlayfrac(i_lev)*z_dbdtlay)
541  z_plvl(iband,i_lev) = delwave(iband)&
542  & *(totplnk(indlev(i_lev),iband)+z_tlevfrac(i_lev)*z_dbdtlev)
543  IF (k_icldlyr(i_lev) > 0) THEN
544  zextau = min( p_taucld(i_lev,iband), 200._jprb)
545  z_trncld(i_lev,iband) = exp( -zextau )
546  ENDIF
547 !-- DS_000515
548  ENDDO
549 
550 ENDDO
551 
552 p_semislw = z_sumplem / z_sumpl
553 
554 !--DS
555 !O IPR = 1, JPGPT
556 ! NBI = NGB(IPR)
557 ! DO LEV = 1 , KLEV
558 !-- DS_000515
559 ! ZPLAY(IPR,LEV) = PLAY(LEV,NGB(IPR))
560 ! ZPLVL(IPR,LEV) = PLVL(LEV-1,NGB(IPR))
561 ! ZTAUCLD(IPR,LEV) = TAUCLD(LEV,NGB(IPR))
562 ! ZTRNCLD(IPR,LEV) = TRNCLD(LEV,NGB(IPR))
563 !-- DS_000515
564 ! ENDDO
565 !NDDO
566 !----
567 
568 !- For cloudy layers, set cloud parameters for radiative transfer.
569 DO i_lev = 1, klev
570  IF (k_icldlyr(i_lev) > 0) THEN
571  DO ipr = 1, jpgpt
572 !--DS
573 ! NBI = NGB(IPR)
574  z_odcldnw(ipr,i_lev) = p_taucld(i_lev,ngb(ipr))
575  z_abscldnw(ipr,i_lev) = 1.0_jprb - z_trncld(i_lev,ngb(ipr))
576 !----
577 ! EFCLFRNW(IPR,LEV) = ABSCLDNW(IPR,LEV) * CLDFRAC(LEV)
578  ENDDO
579  ENDIF
580 ENDDO
581 
582 !- Initialize for radiative transfer.
583 DO ipr = 1, jpgpt
584  z_radclrd1(ipr) = 0.0_jprb
585  z_radld1(ipr) = 0.0_jprb
586  i_nbi = ngb(ipr)
587  z_semis(ipr) = z_surfemis(i_nbi)
588  z_raduemit(ipr) = pfrac(ipr,1) * z_plnkemit(i_nbi)
589 !-- DS_000515
590  z_bglev(ipr) = pfrac(ipr,klev) * z_plvl(i_nbi,klev)
591 ENDDO
592 
593 !- Downward radiative transfer.
594 ! *** DRAD1 holds summed radiance for total sky stream
595 ! *** DRADCL1 holds summed radiance for clear sky stream
596 
597 iclddn = 0
598 DO i_lev = klev, 1, -1
599  z_drad1 = 0.0_jprb
600  z_dradcl1 = 0.0_jprb
601 
602  IF (k_icldlyr(i_lev) == 1) THEN
603 
604 ! *** Cloudy layer
605  iclddn = 1
606  ient = jpgpt * (i_lev-1)
607  DO ipr = 1, jpgpt
608  index = ient + ipr
609 !--DS
610 ! NBI = NGB(IPR)
611  z_bglay = pfrac(ipr,i_lev) * z_play(ngb(ipr),i_lev)
612 !----
613  z_delbgup = z_bglev(ipr) - z_bglay
614  z_bbu1(index) = z_bglay + p_tausf1(index) * z_delbgup
615 !--DS
616  z_bglev(ipr) = pfrac(ipr,i_lev) * z_plvl(ngb(ipr),i_lev-1)
617 !----
618  z_delbgdn = z_bglev(ipr) - z_bglay
619  z_bbd = z_bglay + p_tausf1(index) * z_delbgdn
620 !- total-sky downward flux
621  z_odsm = p_od(ipr,i_lev) + z_odcldnw(ipr,i_lev)
622  z_factot1 = z_odsm / (bpade + z_odsm)
623  z_bbutot1(index) = z_bglay + z_factot1 * z_delbgup
624  z_atot1(index) = p_abss1(index) + z_abscldnw(ipr,i_lev)&
625  & - p_abss1(index) * z_abscldnw(ipr,i_lev)
626  z_bbdtot = z_bglay + z_factot1 * z_delbgdn
627  z_gassrc = z_bbd * p_abss1(index)
628 !***
629  IF (istcldd(i_lev) == 1) THEN
630  z_cldradd(ipr) = z_cldfrac(i_lev) * z_radld1(ipr)
631  z_clrradd(ipr) = z_radld1(ipr) - z_cldradd(ipr)
632  z_oldcld(ipr) = z_cldradd(ipr)
633  z_oldclr(ipr) = z_clrradd(ipr)
634  z_rad(ipr) = 0.0_jprb
635  ENDIF
636  z_ttot = 1.0_jprb - z_atot1(index)
637  z_cldsrc = z_bbdtot * z_atot1(index)
638 
639 ! Separate RT equations for clear and cloudy streams
640  z_cldradd(ipr) = z_cldradd(ipr) * z_ttot + z_cldfrac(i_lev) * z_cldsrc
641  z_clrradd(ipr) = z_clrradd(ipr) * (1.0_jprb-p_abss1(index)) +&
642  & (1.0_jprb - z_cldfrac(i_lev)) * z_gassrc
643 
644 ! Total sky downward radiance
645  z_radld1(ipr) = z_cldradd(ipr) + z_clrradd(ipr)
646  z_drad1 = z_drad1 + z_radld1(ipr)
647 
648 ! Clear-sky downward radiance
649  z_radclrd1(ipr) = z_radclrd1(ipr)+(z_bbd-z_radclrd1(ipr))*p_abss1(index)
650  z_dradcl1 = z_dradcl1 + z_radclrd1(ipr)
651 
652 !* Code to account for maximum/random overlap:
653 ! Performs RT on the radiance most recently switched between clear and
654 ! cloudy streams
655  z_radmod = z_rad(ipr) * (z_facclr1d(i_lev-1) * (1.0_jprb-p_abss1(index)) +&
656  & z_faccld1d(i_lev-1) * z_ttot) - &
657  & z_faccmb1d(i_lev-1) * z_gassrc + &
658  & z_faccmb2d(i_lev-1) * z_cldsrc
659 
660 ! Computes what the clear and cloudy streams would have been had no
661 ! radiance been switched
662  z_oldcld(ipr) = z_cldradd(ipr) - z_radmod
663  z_oldclr(ipr) = z_clrradd(ipr) + z_radmod
664 
665 ! Computes the radiance to be switched between clear and cloudy.
666  z_rad(ipr) = -z_radmod + z_facclr2d(i_lev-1)*z_oldclr(ipr) -&
667  & z_faccld2d(i_lev-1)*z_oldcld(ipr)
668  z_cldradd(ipr) = z_cldradd(ipr) + z_rad(ipr)
669  z_clrradd(ipr) = z_clrradd(ipr) - z_rad(ipr)
670 !***
671 
672  ENDDO
673 
674  ELSE
675 
676 ! *** Clear layer
677 ! *** DRAD1 holds summed radiance for total sky stream
678 ! *** DRADCL1 holds summed radiance for clear sky stream
679 
680  ient = jpgpt * (i_lev-1)
681  IF (iclddn == 1) THEN
682  DO ipr = 1, jpgpt
683  index = ient + ipr
684 !--DS
685 ! NBI = NGB(IPR)
686  z_bglay = pfrac(ipr,i_lev) * z_play(ngb(ipr),i_lev)
687 !----
688  z_delbgup = z_bglev(ipr) - z_bglay
689  z_bbu1(index) = z_bglay + p_tausf1(index) * z_delbgup
690 !--DS
691  z_bglev(ipr) = pfrac(ipr,i_lev) * z_plvl(ngb(ipr),i_lev-1)
692 !----
693  z_delbgdn = z_bglev(ipr) - z_bglay
694  z_bbd = z_bglay + p_tausf1(index) * z_delbgdn
695 
696 !- total-sky downward radiance
697  z_radld1(ipr) = z_radld1(ipr)+(z_bbd-z_radld1(ipr))*p_abss1(index)
698  z_drad1 = z_drad1 + z_radld1(ipr)
699 
700 !- clear-sky downward radiance
701 !- Set clear sky stream to total sky stream as long as layers
702 !- remain clear. Streams diverge when a cloud is reached.
703  z_radclrd1(ipr) = z_radclrd1(ipr)+(z_bbd-z_radclrd1(ipr))*p_abss1(index)
704  z_dradcl1 = z_dradcl1 + z_radclrd1(ipr)
705  ENDDO
706 
707  ELSE
708 
709  DO ipr = 1, jpgpt
710  index = ient + ipr
711 !--DS
712 ! NBI = NGB(IPR)
713  z_bglay = pfrac(ipr,i_lev) * z_play(ngb(ipr),i_lev)
714 !----
715  z_delbgup = z_bglev(ipr) - z_bglay
716  z_bbu1(index) = z_bglay + p_tausf1(index) * z_delbgup
717 !--DS
718  z_bglev(ipr) = pfrac(ipr,i_lev) * z_plvl(ngb(ipr),i_lev-1)
719 !----
720  z_delbgdn = z_bglev(ipr) - z_bglay
721  z_bbd = z_bglay + p_tausf1(index) * z_delbgdn
722 !- total-sky downward flux
723  z_radld1(ipr) = z_radld1(ipr)+(z_bbd-z_radld1(ipr))*p_abss1(index)
724  z_drad1 = z_drad1 + z_radld1(ipr)
725 !- clear-sky downward flux
726 !- Set clear sky stream to total sky stream as long as layers
727 !- remain clear. Streams diverge when a cloud is reached.
728  z_radclrd1(ipr) = z_radld1(ipr)
729  ENDDO
730  z_dradcl1 = z_drad1
731  ENDIF
732 
733  ENDIF
734 
735  p_totdfluc(i_lev-1) = z_dradcl1 * z_wtnum(1)
736  p_totdflux(i_lev-1) = z_drad1 * z_wtnum(1)
737 
738 ENDDO
739 
740 ! Spectral reflectivity and reflectance
741 ! Includes the contribution of spectrally varying longwave emissivity
742 ! and reflection from the surface to the upward radiative transfer.
743 ! Note: Spectral and Lambertian reflections are identical for the one
744 ! angle flux integration used here.
745 
746 z_urad1 = 0.0_jprb
747 z_uradcl1 = 0.0_jprb
748 
749 !start JJM_000511
750 !IF (IREFLECT == 0) THEN
751 !- Lambertian reflection.
752 DO ipr = 1, jpgpt
753 ! Clear-sky radiance
754 ! RADCLD = _TWO_ * (RADCLRD1(IPR) * WTNUM(1) )
755  z_radcld = z_radclrd1(ipr)
756  z_radclru1(ipr) = z_raduemit(ipr) + (1.0_jprb - z_semis(ipr)) * z_radcld
757  z_uradcl1 = z_uradcl1 + z_radclru1(ipr)
758 
759 ! Total sky radiance
760 ! RADD = _TWO_ * (RADLD1(IPR) * WTNUM(1) )
761  z_radd = z_radld1(ipr)
762  z_radlu1(ipr) = z_raduemit(ipr) + (1.0_jprb - z_semis(ipr)) * z_radd
763  z_urad1 = z_urad1 + z_radlu1(ipr)
764 ENDDO
765 p_totufluc(0) = z_uradcl1 * 0.5_jprb
766 p_totuflux(0) = z_urad1 * 0.5_jprb
767 !ELSE
768 !!- Specular reflection.
769 ! DO IPR = 1, JPGPT
770 ! RADCLU = RADUEMIT(IPR)
771 ! RADCLRU1(IPR) = RADCLU + (_ONE_ - SEMIS(IPR)) * RADCLRD1(IPR)
772 ! URADCL1 = URADCL1 + RADCLRU1(IPR)
773 
774 ! RADU = RADUEMIT(IPR)
775 ! RADLU1(IPR) = RADU + (_ONE_ - SEMIS(IPR)) * RADLD1(IPR)
776 ! URAD1 = URAD1 + RADLU1(IPR)
777 ! ENDDO
778 ! TOTUFLUC(0) = URADCL1 * WTNUM(1)
779 ! TOTUFLUX(0) = URAD1 * WTNUM(1)
780 !ENDIF
781 
782 !- Upward radiative transfer.
783 !- *** URAD1 holds the summed radiance for total sky stream
784 !- *** URADCL1 holds the summed radiance for clear sky stream
785 DO i_lev = 1, klev
786  z_urad1 = 0.0_jprb
787  z_uradcl1 = 0.0_jprb
788 
789 ! Check flag for cloud in current layer
790  IF (k_icldlyr(i_lev) == 1) THEN
791 
792 !- *** Cloudy layer
793  ient = jpgpt * (i_lev-1)
794  DO ipr = 1, jpgpt
795  index = ient + ipr
796 !- total-sky upward flux
797  z_gassrc = z_bbu1(index) * p_abss1(index)
798 
799 !- If first cloudy layer in sequence, split up radiance into clear and
800 ! cloudy streams depending on cloud fraction
801  IF (istcld(i_lev) == 1) THEN
802  z_cldradu(ipr) = z_cldfrac(i_lev) * z_radlu1(ipr)
803  z_clrradu(ipr) = z_radlu1(ipr) - z_cldradu(ipr)
804  z_oldcld(ipr) = z_cldradu(ipr)
805  z_oldclr(ipr) = z_clrradu(ipr)
806  z_rad(ipr) = 0.0_jprb
807  ENDIF
808  z_ttot = 1.0_jprb - z_atot1(index)
809  z_trns = 1.0_jprb - p_abss1(index)
810  z_cldsrc = z_bbutot1(index) * z_atot1(index)
811 
812 !- Separate RT equations for clear and cloudy streams
813  z_cldradu(ipr) = z_cldradu(ipr) * z_ttot + z_cldfrac(i_lev) * z_cldsrc
814  z_clrradu(ipr) = z_clrradu(ipr) * z_trns +(1.0_jprb - z_cldfrac(i_lev)) * z_gassrc
815 !***
816 
817 !- total sky upward flux
818  z_radlu1(ipr) = z_cldradu(ipr) + z_clrradu(ipr)
819  z_urad1 = z_urad1 + z_radlu1(ipr)
820 
821 !- clear-sky upward flux
822  z_radclru1(ipr) = z_radclru1(ipr) + (z_bbu1(index)-z_radclru1(ipr))&
823  & *p_abss1(index)
824  z_uradcl1 = z_uradcl1 + z_radclru1(ipr)
825 
826 !* Code to account for maximum/random overlap:
827 ! Performs RT on the radiance most recently switched between clear and
828 ! cloudy streams
829  z_radmod = z_rad(ipr) * (z_facclr1(i_lev+1) * z_trns +&
830  & z_faccld1(i_lev+1) * z_ttot) - &
831  & z_faccmb1(i_lev+1) * z_gassrc + &
832  & z_faccmb2(i_lev+1) * z_cldsrc
833 
834 ! Computes what the clear and cloudy streams would have been had no
835 ! radiance been switched
836  z_oldcld(ipr) = z_cldradu(ipr) - z_radmod
837  z_oldclr(ipr) = z_clrradu(ipr) + z_radmod
838 
839 ! Computes the radiance to be switched between clear and cloudy.
840  z_rad(ipr) = -z_radmod + z_facclr2(i_lev+1)*z_oldclr(ipr) -&
841  & z_faccld2(i_lev+1)*z_oldcld(ipr)
842  z_cldradu(ipr) = z_cldradu(ipr) + z_rad(ipr)
843  z_clrradu(ipr) = z_clrradu(ipr) - z_rad(ipr)
844 !***
845  ENDDO
846 
847  ELSE
848 
849 !- *** Clear layer
850  ient = jpgpt * (i_lev-1)
851  DO ipr = 1, jpgpt
852  index = ient + ipr
853 !- total-sky upward flux
854  z_radlu1(ipr) = z_radlu1(ipr)+(z_bbu1(index)-z_radlu1(ipr))*p_abss1(index)
855  z_urad1 = z_urad1 + z_radlu1(ipr)
856 !- clear-sky upward flux
857 ! Upward clear and total sky streams must be separate because surface
858 ! reflectance is different for each.
859  z_radclru1(ipr) = z_radclru1(ipr)+(z_bbu1(index)-z_radclru1(ipr))*p_abss1(index)
860  z_uradcl1 = z_uradcl1 + z_radclru1(ipr)
861  ENDDO
862 
863  ENDIF
864 
865  p_totufluc(i_lev) = z_uradcl1 * z_wtnum(1)
866  p_totuflux(i_lev) = z_urad1 * z_wtnum(1)
867 
868 ENDDO
869 
870 !* Convert radiances to fluxes and heating rates for total and clear sky.
871 ! ** NB: moved to calling routine
872 ! TOTUFLUC(0) = TOTUFLUC(0) * FLUXFAC
873 ! TOTDFLUC(0) = TOTDFLUC(0) * FLUXFAC
874 ! TOTUFLUX(0) = TOTUFLUX(0) * FLUXFAC
875 ! TOTDFLUX(0) = TOTDFLUX(0) * FLUXFAC
876 
877 ! CLFNET(0) = (P_TOTUFLUC(0) - P_TOTDFLUC(0))
878 ! FNET(0) = (P_TOTUFLUX(0) - P_TOTDFLUX(0))
879 ! DO LEV = 1, KLEV
880 ! TOTUFLUC(LEV) = TOTUFLUC(LEV) * FLUXFAC
881 ! TOTDFLUC(LEV) = TOTDFLUC(LEV) * FLUXFAC
882 ! CLFNET(LEV) =(P_TOTUFLUC(LEV) - P_TOTDFLUC(LEV))
883 
884 ! TOTUFLUX(LEV) = TOTUFLUX(LEV) * FLUXFAC
885 ! TOTDFLUX(LEV) = TOTDFLUX(LEV) * FLUXFAC
886 ! FNET(LEV) = (P_TOTUFLUX(LEV) - P_TOTDFLUX(LEV))
887 ! L = LEV - 1
888 
889 !- Calculate Heating Rates.
890 ! CLHTR(L)=HEATFAC*(CLFNET(L)-CLFNET(LEV))/(PZ(L)-PZ(LEV))
891 ! HTR(L) =HEATFAC*(FNET(L) -FNET(LEV)) /(PZ(L)-PZ(LEV))
892 ! END DO
893 ! CLHTR(KLEV) = 0.0
894 ! HTR(KLEV) = 0.0
895 
896 
897 
898 IF (lhook) CALL dr_hook('RRTM_RTRN1A_140GP',1,zhook_handle)
899 END SUBROUTINE rrtm_rtrn1a_140gp
yoerrtftr::ngb
integer(kind=jpim), dimension(jpgpt) ngb
Definition: yoerrtftr.F90:18
parrrtm::jpgpt
integer(kind=jpim), parameter jpgpt
Definition: parrrtm.F90:21
parrrtm::jpband
integer(kind=jpim), parameter jpband
Definition: parrrtm.F90:18
parkind1::jprb
integer, parameter jprb
Definition: parkind1.F90:31
yomhook::lhook
logical lhook
Definition: yomhook.F90:12
yoerrtwn::totplnk
real(kind=jprb), dimension(181, 16) totplnk
Definition: yoerrtwn.F90:19
parrrtm::jplay
integer(kind=jpim), parameter jplay
Definition: parrrtm.F90:15
yomhook::dr_hook
subroutine dr_hook(CDNAME, KSWITCH, PKEY)
Definition: yomhook.F90:17
yoerrtwn::delwave
real(kind=jprb), dimension(16) delwave
Definition: yoerrtwn.F90:17
yoerrtab::bpade
real(kind=jprb) bpade
Definition: yoerrtab.F90:14
parkind1::jpim
integer, parameter jpim
Definition: parkind1.F90:13
rrtm_rtrn1a_140gp
subroutine rrtm_rtrn1a_140gp(KLEV, K_ISTART, K_IEND, K_ICLDLYR, P_CLDFRAC, P_TAUCLD, P_ABSS1, P_OD, P_TAUSF1, P_CLFNET, P_CLHTR, P_FNET, P_HTR, P_TOTDFLUC, P_TOTDFLUX, P_TOTUFLUC, P_TOTUFLUX, P_TAVEL, PZ, P_TZ, P_TBOUND, PFRAC, P_SEMISS, P_SEMISLW, K_IREFLECT)
Definition: rrtm_rtrn1a_140gp.F90:4