source: LMDZ5/trunk/libf/phylmd/rrtm/rrtm_rtrn1a_140gp.F90 @ 1990

Last change on this file since 1990 was 1990, checked in by Laurent Fairhead, 10 years ago

Corrections à la version r1989 pour permettre la compilation avec RRTM
Inclusion de la licence CeCILL_V2 pour RRTM

Changes to revision r1989 to enable RRTM code compilation
RRTM part put under CeCILL_V2 licence
  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
File size: 28.9 KB
Line 
1SUBROUTINE 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
24USE PARKIND1  ,ONLY : JPIM     ,JPRB
25USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
26
27USE PARRRTM  , ONLY : JPBAND   ,JPGPT   ,JPLAY
28USE YOERRTAB , ONLY : BPADE
29USE YOERRTWN , ONLY : TOTPLNK  ,DELWAVE
30USE YOERRTFTR, ONLY : NGB
31
32IMPLICIT NONE
33
34INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV
35INTEGER(KIND=JPIM),INTENT(IN)    :: K_ISTART
36INTEGER(KIND=JPIM),INTENT(IN)    :: K_IEND
37INTEGER(KIND=JPIM),INTENT(IN)    :: K_ICLDLYR(JPLAY) ! Cloud indicator
38REAL(KIND=JPRB)   ,INTENT(IN)    :: P_CLDFRAC(JPLAY) ! Cloud fraction
39REAL(KIND=JPRB)                  :: Z_CLDFRAC(JPLAY) ! Cloud fraction
40REAL(KIND=JPRB)   ,INTENT(IN)    :: P_TAUCLD(JPLAY,JPBAND) ! Spectral optical thickness
41REAL(KIND=JPRB)   ,INTENT(IN)    :: P_ABSS1(JPGPT*JPLAY)
42REAL(KIND=JPRB)   ,INTENT(IN)    :: P_OD(JPGPT,JPLAY)
43REAL(KIND=JPRB)   ,INTENT(IN)    :: P_TAUSF1(JPGPT*JPLAY)
44REAL(KIND=JPRB)                  :: P_CLFNET(0:JPLAY) ! Argument NOT used
45REAL(KIND=JPRB)                  :: P_CLHTR(0:JPLAY) ! Argument NOT used
46REAL(KIND=JPRB)                  :: P_FNET(0:JPLAY) ! Argument NOT used
47REAL(KIND=JPRB)                  :: P_HTR(0:JPLAY) ! Argument NOT used
48REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TOTDFLUC(0:JPLAY)
49REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TOTDFLUX(0:JPLAY)
50REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TOTUFLUC(0:JPLAY)
51REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TOTUFLUX(0:JPLAY)
52REAL(KIND=JPRB)   ,INTENT(IN)    :: P_TAVEL(JPLAY)
53REAL(KIND=JPRB)                  :: PZ(0:JPLAY) ! Argument NOT used
54REAL(KIND=JPRB)   ,INTENT(IN)    :: P_TZ(0:JPLAY)
55REAL(KIND=JPRB)   ,INTENT(IN)    :: P_TBOUND
56REAL(KIND=JPRB)   ,INTENT(IN)    :: PFRAC(JPGPT,JPLAY)
57REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SEMISS(JPBAND)
58REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_SEMISLW
59INTEGER(KIND=JPIM)               :: K_IREFLECT ! Argument NOT used
60!- from PROFILE             
61!- from SP             
62!- from SURFACE             
63INTEGER(KIND=JPIM) :: INDLAY(JPLAY),INDLEV(0:JPLAY)
64
65REAL(KIND=JPRB) :: Z_BBU1(JPGPT*JPLAY),Z_BBUTOT1(JPGPT*JPLAY)
66REAL(KIND=JPRB) :: Z_TLAYFRAC(JPLAY),Z_TLEVFRAC(0:JPLAY)
67REAL(KIND=JPRB) :: Z_BGLEV(JPGPT)
68!-- DS_000515
69REAL(KIND=JPRB) :: Z_PLVL(JPBAND+1,0:JPLAY),Z_PLAY(JPBAND+1,0:JPLAY),Z_WTNUM(3)
70!-- DS_000515
71REAL(KIND=JPRB) :: Z_ODCLDNW(JPGPT,JPLAY)
72REAL(KIND=JPRB) :: Z_SEMIS(JPGPT),Z_RADUEMIT(JPGPT)
73
74REAL(KIND=JPRB) :: Z_RADCLRU1(JPGPT) ,Z_RADCLRD1(JPGPT)
75REAL(KIND=JPRB) :: Z_RADLU1(JPGPT)   ,Z_RADLD1(JPGPT)
76!-- DS_000515
77REAL(KIND=JPRB) :: Z_TRNCLD(JPLAY,JPBAND+1)
78!-- DS_000515
79REAL(KIND=JPRB) :: Z_ABSCLDNW(JPGPT,JPLAY)
80REAL(KIND=JPRB) :: Z_ATOT1(JPGPT*JPLAY)
81
82REAL(KIND=JPRB) :: Z_SURFEMIS(JPBAND),Z_PLNKEMIT(JPBAND)
83
84! dimension of arrays required for cloud overlap calculations
85
86REAL(KIND=JPRB) :: Z_CLRRADU(jpgpt),Z_CLDRADU(jpgpt),Z_OLDCLD(jpgpt)
87REAL(KIND=JPRB) :: Z_OLDCLR(jpgpt),Z_RAD(jpgpt),Z_FACCLD1(jplay+1),Z_FACCLD2(jplay+1)
88REAL(KIND=JPRB) :: Z_FACCLR1(jplay+1),Z_FACCLR2(jplay+1)
89REAL(KIND=JPRB) :: Z_FACCMB1(jplay+1),Z_FACCMB2(jplay+1)
90REAL(KIND=JPRB) :: Z_FACCLD1D(0:jplay),Z_FACCLD2D(0:jplay),Z_FACCLR1D(0:jplay)
91REAL(KIND=JPRB) :: Z_FACCLR2D(0:jplay),Z_FACCMB1D(0:jplay),Z_FACCMB2D(0:jplay)
92REAL(KIND=JPRB) :: Z_CLRRADD(jpgpt),Z_CLDRADD(jpgpt)
93INTEGER(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
99INTEGER(KIND=JPIM) :: IBAND, ICLDDN, IENT, INDBOUND, INDEX, IPR, I_LAY, I_LEV, I_NBI
100
101REAL(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 
105REAL(KIND=JPRB) :: ZHOOK_HANDLE
106
107!--------------------------------------------------------------------------
108! Input
109!  JPLAY                 ! Maximum number of model layers
110!  JPGPT                 ! Total number of g-point subintervals
111!  JPBAND                ! Number of longwave spectral bands
112!  SECANG                ! Diffusivity angle
113!  WTNUM                 ! Weight for radiance to flux conversion
114!  KLEV                  ! Number of model layers
115!  PAVEL(JPLAY)          ! Mid-layer pressures (hPa)
116!  PZ(0:JPLAY)           ! Interface pressures (hPa)
117!  TAVEL(JPLAY)          ! Mid-layer temperatures (K)
118!  TZ(0:JPLAY)           ! Interface temperatures (K)
119!  TBOUND                ! Surface temperature
120!  CLDFRAC(JPLAY)        ! Layer cloud fraction
121!  TAUCLD(JPLAY,JPBAND)  ! Layer cloud optical thickness
122!  ITR
123!  PFRAC(JPGPT,JPLAY)    ! Planck function fractions
124!  ICLDLYR(JPLAY)        ! Flag for cloudy layers
125!  ICLD                  ! Flag for cloudy column
126!  IREFLECT              ! Flag for specular reflection
127!  SEMISS(JPBAND)        ! Surface spectral emissivity
128!  BPADE                 ! Pade constant
129!  OD                    ! Clear-sky optical thickness
130!  TAUSF1                !
131!  ABSS1                 ! 
132
133!  ABSS(JPGPT*JPLAY)     !
134!  ABSCLD(JPLAY)         !
135!  ATOT(JPGPT*JPLAY)     !
136!  ODCLR(JPGPT,JPLAY)    !
137!  ODCLD(JPBAND,JPLAY)   !
138!  EFCLFR1(JPBAND,JPLAY) ! Effective cloud fraction
139!  RADLU(JPGPT)          ! Upward radiance
140!  URAD                  ! Spectrally summed upward radiance
141!  RADCLRU(JPGPT)        ! Clear-sky upward radiance
142!  CLRURAD               ! Spectrally summed clear-sky upward radiance
143!  RADLD(JPGPT)          ! Downward radiance
144!  DRAD                  ! Spectrally summed downward radiance
145!  RADCLRD(JPGPT)        ! Clear-sky downward radiance
146!  CLRDRAD               ! Spectrally summed clear-sky downward radiance
147
148! Output
149!  TOTUFLUX(0:JPLAY)     ! Upward longwave flux
150!  TOTDFLUX(0:JPLAY)     ! Downward longwave flux
151!  TOTUFLUC(0:JPLAY)     ! Clear-sky upward longwave flux
152!  TOTDFLUC(0:JPLAY)     ! Clear-sky downward longwave flux
153
154! Maximum/Random cloud overlap variables
155! for upward radiaitve transfer
156!  FACCLR2  fraction of clear radiance from previous layer that needs to
157!           be switched to cloudy stream
158!  FACCLR1  fraction of the radiance that had been switched in the previous
159!           layer from cloudy to clear that needs to be switched back to
160!           cloudy in the current layer
161!  FACCLD2  fraction of cloudy radiance from previous layer that needs to
162!           be switched to clear stream
163!           be switched to cloudy stream
164!  FACCLD1  fraction of the radiance that had been switched in the previous
165!           layer from clear to cloudy that needs to be switched back to
166!           clear in the current layer
167! for downward radiaitve transfer
168!  FACCLR2D fraction of clear radiance from previous layer that needs to
169!           be switched to cloudy stream
170!  FACCLR1D fraction of the radiance that had been switched in the previous
171!           layer from cloudy to clear that needs to be switched back to
172!           cloudy in the current layer
173!  FACCLD2D fraction of cloudy radiance from previous layer that needs to
174!           be switched to clear stream
175!           be switched to cloudy stream
176!  FACCLD1D fraction of the radiance that had been switched in the previous
177!           layer from clear to cloudy that needs to be switched back to
178!           clear in the current layer
179
180!--------------------------------------------------------------------------
181
182! CORRECTION PROVISOIRE BUG POTENTIEL MPLFH
183! on initialise le niveau klev+1 de p_cldfrac, tableau surdimensionne
184! a 100 mais apparemment non initialise en klev+1
185Z_CLDFRAC(1:KLEV)=P_CLDFRAC(1:KLEV)
186Z_CLDFRAC(KLEV+1)=0.0_JPRB
187IF (LHOOK) CALL DR_HOOK('RRTM_RTRN1A_140GP',0,ZHOOK_HANDLE)
188Z_WTNUM(1)=0.5_JPRB
189Z_WTNUM(2)=0.0_JPRB
190Z_WTNUM(3)=0.0_JPRB
191
192DO I_LAY = 0, KLEV
193ENDDO
194!-start JJM_000511
195IF (P_TBOUND < 339._JPRB .AND. P_TBOUND >= 160._JPRB ) THEN
196  INDBOUND = P_TBOUND - 159._JPRB
197  Z_TBNDFRAC = P_TBOUND - INT(P_TBOUND)
198ELSEIF (P_TBOUND >= 339._JPRB ) THEN
199  INDBOUND = 180
200  Z_TBNDFRAC = P_TBOUND - 339._JPRB
201ELSEIF (P_TBOUND < 160._JPRB ) THEN
202  INDBOUND = 1
203  Z_TBNDFRAC = P_TBOUND - 160._JPRB
204ENDIF 
205!-end JJM_000511
206 
207DO I_LAY = 0, KLEV
208  P_TOTUFLUC(I_LAY) = 0.0_JPRB
209  P_TOTDFLUC(I_LAY) = 0.0_JPRB
210  P_TOTUFLUX(I_LAY) = 0.0_JPRB
211  P_TOTDFLUX(I_LAY) = 0.0_JPRB
212!-start JJM_000511
213  IF (P_TZ(I_LAY) < 339._JPRB .AND. P_TZ(I_LAY) >= 160._JPRB ) THEN
214    INDLEV(I_LAY) = P_TZ(I_LAY) - 159._JPRB
215    Z_TLEVFRAC(I_LAY) = P_TZ(I_LAY) - INT(P_TZ(I_LAY))
216  ELSEIF (P_TZ(I_LAY) >= 339._JPRB ) THEN
217    INDLEV(I_LAY) = 180
218    Z_TLEVFRAC(I_LAY) = P_TZ(I_LAY) - 339._JPRB
219  ELSEIF (P_TZ(I_LAY) < 160._JPRB ) THEN
220    INDLEV(I_LAY) = 1
221    Z_TLEVFRAC(I_LAY) = P_TZ(I_LAY) - 160._JPRB
222  ENDIF   
223!-end JJM_000511
224ENDDO
225
226!_start_jjm 991209
227DO I_LEV=0,KLEV
228  Z_FACCLD1(I_LEV+1) = 0.0_JPRB
229  Z_FACCLD2(I_LEV+1) = 0.0_JPRB
230  Z_FACCLR1(I_LEV+1) = 0.0_JPRB
231  Z_FACCLR2(I_LEV+1) = 0.0_JPRB
232  Z_FACCMB1(I_LEV+1) = 0.0_JPRB
233  Z_FACCMB2(I_LEV+1) = 0.0_JPRB
234  Z_FACCLD1D(I_LEV) = 0.0_JPRB
235  Z_FACCLD2D(I_LEV) = 0.0_JPRB
236  Z_FACCLR1D(I_LEV) = 0.0_JPRB
237  Z_FACCLR2D(I_LEV) = 0.0_JPRB
238  Z_FACCMB1D(I_LEV) = 0.0_JPRB
239  Z_FACCMB2D(I_LEV) = 0.0_JPRB
240ENDDO 
241Z_RAT1 = 0.0_JPRB
242Z_RAT2 = 0.0_JPRB
243!_end_jjm 991209
244
245Z_SUMPL   = 0.0_JPRB
246Z_SUMPLEM = 0.0_JPRB
247
248ISTCLD(1) = 1
249ISTCLDD(KLEV) = 1
250
251DO I_LEV = 1, KLEV
252!-- DS_000515
253!-start JJM_000511
254  IF (P_TAVEL(I_LEV) < 339._JPRB .AND. P_TAVEL(I_LEV) >= 160._JPRB ) THEN
255    INDLAY(I_LEV) = P_TAVEL(I_LEV) - 159._JPRB
256    Z_TLAYFRAC(I_LEV) = P_TAVEL(I_LEV) - INT(P_TAVEL(I_LEV))
257  ELSEIF (P_TAVEL(I_LEV) >= 339._JPRB ) THEN
258    INDLAY(I_LEV) = 180
259    Z_TLAYFRAC(I_LEV) = P_TAVEL(I_LEV) - 339._JPRB
260  ELSEIF (P_TAVEL(I_LEV) < 160._JPRB ) THEN
261    INDLAY(I_LEV) = 1
262    Z_TLAYFRAC(I_LEV) = P_TAVEL(I_LEV) - 160._JPRB
263  ENDIF 
264!-end JJM_000511
265ENDDO
266!-- DS_000515
267
268!-- DS_000515
269!OCL SCALAR
270
271DO I_LEV = 1, KLEV
272  IF (K_ICLDLYR(I_LEV) == 1) THEN
273
274!mji   
275    ISTCLD(I_LEV+1) = 0
276    IF (I_LEV  ==  KLEV) THEN
277      Z_FACCLD1(I_LEV+1) = 0.0_JPRB
278      Z_FACCLD2(I_LEV+1) = 0.0_JPRB
279      Z_FACCLR1(I_LEV+1) = 0.0_JPRB
280      Z_FACCLR2(I_LEV+1) = 0.0_JPRB
281!-- DS_000515     
282!      FACCMB1(LEV+1) = _ZERO_
283!      FACCMB2(LEV+1) = _ZERO_
284!mji      ISTCLD(LEV+1) = _ZERO_
285    ELSEIF (Z_CLDFRAC(I_LEV+1)  >=  Z_CLDFRAC(I_LEV)) THEN
286      Z_FACCLD1(I_LEV+1) = 0.0_JPRB
287      Z_FACCLD2(I_LEV+1) = 0.0_JPRB
288      IF (ISTCLD(I_LEV)  ==  1) THEN
289!mji        ISTCLD(LEV+1) = 0
290        Z_FACCLR1(I_LEV+1) = 0.0_JPRB
291!mji       
292        Z_FACCLR2(I_LEV+1) = 0.0_JPRB
293        IF (Z_CLDFRAC(I_LEV) < 1.0_JPRB) THEN
294          Z_FACCLR2(I_LEV+1) = (Z_CLDFRAC(I_LEV+1)-Z_CLDFRAC(I_LEV))/&
295           & (1.0_JPRB-Z_CLDFRAC(I_LEV)) 
296        ENDIF   
297      ELSE
298        Z_FMAX = MAX(Z_CLDFRAC(I_LEV),Z_CLDFRAC(I_LEV-1))
299!mji
300        IF (Z_CLDFRAC(I_LEV+1)  >  Z_FMAX) THEN
301          Z_FACCLR1(I_LEV+1) = Z_RAT2
302          Z_FACCLR2(I_LEV+1) = (Z_CLDFRAC(I_LEV+1)-Z_FMAX)/(1.0_JPRB-Z_FMAX)
303!mji         
304        ELSEIF (Z_CLDFRAC(I_LEV+1) < Z_FMAX) THEN
305          Z_FACCLR1(I_LEV+1) = (Z_CLDFRAC(I_LEV+1)-Z_CLDFRAC(I_LEV))/&
306           & (Z_CLDFRAC(I_LEV-1)-Z_CLDFRAC(I_LEV)) 
307          Z_FACCLR2(I_LEV+1) = 0.0_JPRB
308!mji
309        ELSE
310          Z_FACCLR1(I_LEV+1) = Z_RAT2 
311          Z_FACCLR2(I_LEV+1) = 0.0_JPRB
312        ENDIF
313      ENDIF
314      IF (Z_FACCLR1(I_LEV+1) > 0.0_JPRB .OR. Z_FACCLR2(I_LEV+1) > 0.0_JPRB) THEN
315        Z_RAT1 = 1.0_JPRB
316        Z_RAT2 = 0.0_JPRB
317      ENDIF
318    ELSE
319      Z_FACCLR1(I_LEV+1) = 0.0_JPRB
320      Z_FACCLR2(I_LEV+1) = 0.0_JPRB
321      IF (ISTCLD(I_LEV)  ==  1) THEN
322!mji        ISTCLD(LEV+1) = 0
323        Z_FACCLD1(I_LEV+1) = 0.0_JPRB
324        Z_FACCLD2(I_LEV+1) = (Z_CLDFRAC(I_LEV)-Z_CLDFRAC(I_LEV+1))/Z_CLDFRAC(I_LEV)
325      ELSE
326        Z_FMIN = MIN(Z_CLDFRAC(I_LEV),Z_CLDFRAC(I_LEV-1))
327        IF (Z_CLDFRAC(I_LEV+1)  <=  Z_FMIN) THEN
328          Z_FACCLD1(I_LEV+1) = Z_RAT1
329          Z_FACCLD2(I_LEV+1) = (Z_FMIN-Z_CLDFRAC(I_LEV+1))/Z_FMIN
330        ELSE
331          Z_FACCLD1(I_LEV+1) = (Z_CLDFRAC(I_LEV)-Z_CLDFRAC(I_LEV+1))/&
332           & (Z_CLDFRAC(I_LEV)-Z_FMIN) 
333          Z_FACCLD2(I_LEV+1) = 0.0_JPRB
334        ENDIF
335      ENDIF
336      IF (Z_FACCLD1(I_LEV+1) > 0.0_JPRB .OR. Z_FACCLD2(I_LEV+1) > 0.0_JPRB) THEN
337        Z_RAT1 = 0.0_JPRB
338        Z_RAT2 = 1.0_JPRB
339      ENDIF
340    ENDIF
341!fcc
342    IF (I_LEV == 1) THEN
343      Z_FACCMB1(I_LEV+1) = 0.
344      Z_FACCMB2(I_LEV+1) = Z_FACCLD1(I_LEV+1) * Z_FACCLR2(I_LEV)
345    ELSE
346      Z_FACCMB1(I_LEV+1) = Z_FACCLR1(I_LEV+1) * Z_FACCLD2(I_LEV) *Z_CLDFRAC(I_LEV-1)
347      Z_FACCMB2(I_LEV+1) = Z_FACCLD1(I_LEV+1) * Z_FACCLR2(I_LEV) *&
348       & (1.0_JPRB - Z_CLDFRAC(I_LEV-1))   
349    ENDIF
350!end fcc
351  ELSE
352!-- DS_000515
353    ISTCLD(I_LEV+1) = 1
354  ENDIF
355ENDDO
356
357!_start_jjm 991209
358Z_RAT1 = 0.0_JPRB
359Z_RAT2 = 0.0_JPRB
360!_end_jjm 991209
361
362!-- DS_000515
363!OCL SCALAR
364
365DO I_LEV = KLEV, 1, -1
366  IF (K_ICLDLYR(I_LEV) == 1) THEN
367!mji
368    ISTCLDD(I_LEV-1) = 0 
369    IF (I_LEV  ==  1) THEN
370      Z_FACCLD1D(I_LEV-1) = 0.0_JPRB
371      Z_FACCLD2D(I_LEV-1) = 0.0_JPRB
372      Z_FACCLR1D(I_LEV-1) = 0.0_JPRB
373      Z_FACCLR2D(I_LEV-1) = 0.0_JPRB
374      Z_FACCMB1D(I_LEV-1) = 0.0_JPRB
375      Z_FACCMB2D(I_LEV-1) = 0.0_JPRB
376!mji      ISTCLDD(LEV-1) = _ZERO_
377    ELSEIF (Z_CLDFRAC(I_LEV-1)  >=  Z_CLDFRAC(I_LEV)) THEN
378      Z_FACCLD1D(I_LEV-1) = 0.0_JPRB
379      Z_FACCLD2D(I_LEV-1) = 0.0_JPRB
380      IF (ISTCLDD(I_LEV)  ==  1) THEN
381!mji        ISTCLDD(LEV-1) = 0
382        Z_FACCLR1D(I_LEV-1) = 0.0_JPRB
383        Z_FACCLR2D(I_LEV-1) = 0.0_JPRB
384        IF (Z_CLDFRAC(I_LEV) < 1.0_JPRB) THEN
385          Z_FACCLR2D(I_LEV-1) = (Z_CLDFRAC(I_LEV-1)-Z_CLDFRAC(I_LEV))/&
386           & (1.0_JPRB-Z_CLDFRAC(I_LEV)) 
387        ENDIF
388      ELSE
389        Z_FMAX = MAX(Z_CLDFRAC(I_LEV),Z_CLDFRAC(I_LEV+1))
390!mji
391        IF (Z_CLDFRAC(I_LEV-1)  >  Z_FMAX) THEN
392          Z_FACCLR1D(I_LEV-1) = Z_RAT2
393          Z_FACCLR2D(I_LEV-1) = (Z_CLDFRAC(I_LEV-1)-Z_FMAX)/(1.0_JPRB-Z_FMAX)
394!mji
395        ELSEIF (Z_CLDFRAC(I_LEV-1) < Z_FMAX) THEN
396          Z_FACCLR1D(I_LEV-1) = (Z_CLDFRAC(I_LEV-1)-Z_CLDFRAC(I_LEV))/&
397           & (Z_CLDFRAC(I_LEV+1)-Z_CLDFRAC(I_LEV)) 
398          Z_FACCLR2D(I_LEV-1) = 0.0_JPRB
399!mji
400        ELSE         
401          Z_FACCLR1D(I_LEV-1) = Z_RAT2
402          Z_FACCLR2D(I_LEV-1) = 0.0_JPRB
403        ENDIF
404      ENDIF
405      IF (Z_FACCLR1D(I_LEV-1) > 0.0_JPRB .OR. Z_FACCLR2D(I_LEV-1) > 0.0_JPRB)THEN
406        Z_RAT1 = 1.0_JPRB
407        Z_RAT2 = 0.0_JPRB
408      ENDIF
409    ELSE
410      Z_FACCLR1D(I_LEV-1) = 0.0_JPRB
411      Z_FACCLR2D(I_LEV-1) = 0.0_JPRB
412      IF (ISTCLDD(I_LEV)  ==  1) THEN
413!mji        ISTCLDD(LEV-1) = 0
414        Z_FACCLD1D(I_LEV-1) = 0.0_JPRB
415        Z_FACCLD2D(I_LEV-1) = (Z_CLDFRAC(I_LEV)-Z_CLDFRAC(I_LEV-1))/Z_CLDFRAC(I_LEV)
416      ELSE
417        Z_FMIN = MIN(Z_CLDFRAC(I_LEV),Z_CLDFRAC(I_LEV+1))
418        IF (Z_CLDFRAC(I_LEV-1)  <=  Z_FMIN) THEN
419          Z_FACCLD1D(I_LEV-1) = Z_RAT1
420          Z_FACCLD2D(I_LEV-1) = (Z_FMIN-Z_CLDFRAC(I_LEV-1))/Z_FMIN
421        ELSE
422          Z_FACCLD1D(I_LEV-1) = (Z_CLDFRAC(I_LEV)-Z_CLDFRAC(I_LEV-1))/&
423           & (Z_CLDFRAC(I_LEV)-Z_FMIN) 
424          Z_FACCLD2D(I_LEV-1) = 0.0_JPRB
425        ENDIF
426      ENDIF
427      IF (Z_FACCLD1D(I_LEV-1) > 0.0_JPRB .OR. Z_FACCLD2D(I_LEV-1) > 0.0_JPRB)THEN
428        Z_RAT1 = 0.0_JPRB
429        Z_RAT2 = 1.0_JPRB
430      ENDIF
431    ENDIF
432    Z_FACCMB1D(I_LEV-1) = Z_FACCLR1D(I_LEV-1) * Z_FACCLD2D(I_LEV) *Z_CLDFRAC(I_LEV+1)
433    Z_FACCMB2D(I_LEV-1) = Z_FACCLD1D(I_LEV-1) * Z_FACCLR2D(I_LEV) *&
434     & (1.0_JPRB - Z_CLDFRAC(I_LEV+1)) 
435  ELSE
436    ISTCLDD(I_LEV-1) = 1
437  ENDIF
438ENDDO
439
440!- Loop over frequency bands.
441
442DO IBAND = K_ISTART, K_IEND
443  Z_DBDTLEV = TOTPLNK(INDBOUND+1,IBAND)-TOTPLNK(INDBOUND,IBAND)
444  Z_PLANKBND = DELWAVE(IBAND) * (TOTPLNK(INDBOUND,IBAND) + Z_TBNDFRAC * Z_DBDTLEV)
445  Z_DBDTLEV = TOTPLNK(INDLEV(0)+1,IBAND) -TOTPLNK(INDLEV(0),IBAND)
446!-- DS_000515
447  Z_PLVL(IBAND,0) = DELWAVE(IBAND)&
448   & * (TOTPLNK(INDLEV(0),IBAND) + Z_TLEVFRAC(0)*Z_DBDTLEV) 
449
450  Z_SURFEMIS(IBAND) = P_SEMISS(IBAND)
451  Z_PLNKEMIT(IBAND) = Z_SURFEMIS(IBAND) * Z_PLANKBND
452  Z_SUMPLEM  = Z_SUMPLEM + Z_PLNKEMIT(IBAND)
453  Z_SUMPL    = Z_SUMPL   + Z_PLANKBND
454!--DS
455ENDDO
456!---
457
458!-- DS_000515
459DO I_LEV = 1, KLEV
460  DO IBAND = K_ISTART, K_IEND
461! print *,'RTRN1A: I_LEV JPLAY IBAND INDLAY',I_LEV,JPLAY,IBAND,INDLAY(I_LEV)
462!----             
463!- Calculate the integrated Planck functions for at the
464!  level and layer temperatures.
465!  Compute cloud transmittance for cloudy layers.
466    Z_DBDTLEV = TOTPLNK(INDLEV(I_LEV)+1,IBAND) - TOTPLNK(INDLEV(I_LEV),IBAND)
467    Z_DBDTLAY = TOTPLNK(INDLAY(I_LEV)+1,IBAND) - TOTPLNK(INDLAY(I_LEV),IBAND)
468!-- DS_000515
469    Z_PLAY(IBAND,I_LEV) = DELWAVE(IBAND)&
470     & *(TOTPLNK(INDLAY(I_LEV),IBAND)+Z_TLAYFRAC(I_LEV)*Z_DBDTLAY) 
471    Z_PLVL(IBAND,I_LEV) = DELWAVE(IBAND)&
472     & *(TOTPLNK(INDLEV(I_LEV),IBAND)+Z_TLEVFRAC(I_LEV)*Z_DBDTLEV) 
473    IF (K_ICLDLYR(I_LEV) > 0) THEN
474      ZEXTAU = MIN( P_TAUCLD(I_LEV,IBAND), 200._JPRB)
475      Z_TRNCLD(I_LEV,IBAND) = EXP( -ZEXTAU )
476    ENDIF
477!-- DS_000515
478  ENDDO
479
480ENDDO
481
482P_SEMISLW = Z_SUMPLEM / Z_SUMPL
483
484!--DS
485!O IPR = 1, JPGPT
486! NBI = NGB(IPR)
487! DO LEV =  1 , KLEV
488!-- DS_000515
489!   ZPLAY(IPR,LEV) = PLAY(LEV,NGB(IPR))
490!   ZPLVL(IPR,LEV) = PLVL(LEV-1,NGB(IPR))
491!   ZTAUCLD(IPR,LEV) = TAUCLD(LEV,NGB(IPR))
492!   ZTRNCLD(IPR,LEV) = TRNCLD(LEV,NGB(IPR))
493!-- DS_000515
494! ENDDO
495!NDDO
496!----     
497
498!- For cloudy layers, set cloud parameters for radiative transfer.
499DO I_LEV = 1, KLEV
500  IF (K_ICLDLYR(I_LEV) > 0) THEN
501    DO IPR = 1, JPGPT
502!--DS         
503!            NBI = NGB(IPR)
504      Z_ODCLDNW(IPR,I_LEV) = P_TAUCLD(I_LEV,NGB(IPR))
505      Z_ABSCLDNW(IPR,I_LEV) = 1.0_JPRB - Z_TRNCLD(I_LEV,NGB(IPR))
506!----           
507!            EFCLFRNW(IPR,LEV) = ABSCLDNW(IPR,LEV) * CLDFRAC(LEV)
508    ENDDO
509  ENDIF
510ENDDO
511
512!- Initialize for radiative transfer.
513DO IPR = 1, JPGPT
514  Z_RADCLRD1(IPR) = 0.0_JPRB
515  Z_RADLD1(IPR)   = 0.0_JPRB
516  I_NBI = NGB(IPR)
517  Z_SEMIS(IPR) = Z_SURFEMIS(I_NBI)
518  Z_RADUEMIT(IPR) = PFRAC(IPR,1) * Z_PLNKEMIT(I_NBI)
519!-- DS_000515
520  Z_BGLEV(IPR) = PFRAC(IPR,KLEV) * Z_PLVL(I_NBI,KLEV)
521ENDDO
522
523!- Downward radiative transfer.
524!  *** DRAD1 holds summed radiance for total sky stream
525!  *** DRADCL1 holds summed radiance for clear sky stream
526
527ICLDDN = 0
528DO I_LEV = KLEV, 1, -1
529  Z_DRAD1   = 0.0_JPRB
530  Z_DRADCL1 = 0.0_JPRB
531
532  IF (K_ICLDLYR(I_LEV) == 1) THEN
533
534!  *** Cloudy layer
535    ICLDDN = 1
536    IENT = JPGPT * (I_LEV-1)
537    DO IPR = 1, JPGPT
538      INDEX = IENT + IPR
539!--DS           
540!            NBI = NGB(IPR)
541      Z_BGLAY = PFRAC(IPR,I_LEV) * Z_PLAY(NGB(IPR),I_LEV)
542!----           
543      Z_DELBGUP     = Z_BGLEV(IPR) - Z_BGLAY
544      Z_BBU1(INDEX) = Z_BGLAY + P_TAUSF1(INDEX) * Z_DELBGUP
545!--DS           
546      Z_BGLEV(IPR) = PFRAC(IPR,I_LEV) * Z_PLVL(NGB(IPR),I_LEV-1)
547!----           
548      Z_DELBGDN = Z_BGLEV(IPR) - Z_BGLAY
549      Z_BBD = Z_BGLAY + P_TAUSF1(INDEX) * Z_DELBGDN
550!- total-sky downward flux         
551      Z_ODSM = P_OD(IPR,I_LEV) + Z_ODCLDNW(IPR,I_LEV)
552      Z_FACTOT1 = Z_ODSM / (BPADE + Z_ODSM)
553      Z_BBUTOT1(INDEX) = Z_BGLAY + Z_FACTOT1 * Z_DELBGUP
554      Z_ATOT1(INDEX) = P_ABSS1(INDEX) + Z_ABSCLDNW(IPR,I_LEV)&
555       & - P_ABSS1(INDEX) * Z_ABSCLDNW(IPR,I_LEV) 
556      Z_BBDTOT = Z_BGLAY + Z_FACTOT1 * Z_DELBGDN
557      Z_GASSRC = Z_BBD * P_ABSS1(INDEX)
558!***
559      IF (ISTCLDD(I_LEV)  ==  1) THEN
560        Z_CLDRADD(IPR) = Z_CLDFRAC(I_LEV) * Z_RADLD1(IPR)
561        Z_CLRRADD(IPR) = Z_RADLD1(IPR) - Z_CLDRADD(IPR)
562        Z_OLDCLD(IPR) = Z_CLDRADD(IPR)
563        Z_OLDCLR(IPR) = Z_CLRRADD(IPR)
564        Z_RAD(IPR) = 0.0_JPRB
565      ENDIF
566      Z_TTOT = 1.0_JPRB - Z_ATOT1(INDEX)
567      Z_CLDSRC = Z_BBDTOT * Z_ATOT1(INDEX)
568     
569! Separate RT equations for clear and cloudy streams     
570      Z_CLDRADD(IPR) = Z_CLDRADD(IPR) * Z_TTOT + Z_CLDFRAC(I_LEV) * Z_CLDSRC
571      Z_CLRRADD(IPR) = Z_CLRRADD(IPR) * (1.0_JPRB-P_ABSS1(INDEX)) +&
572       & (1.0_JPRB - Z_CLDFRAC(I_LEV)) * Z_GASSRC 
573
574!  Total sky downward radiance
575      Z_RADLD1(IPR) = Z_CLDRADD(IPR) + Z_CLRRADD(IPR)
576      Z_DRAD1 = Z_DRAD1 + Z_RADLD1(IPR)
577     
578!  Clear-sky downward radiance         
579      Z_RADCLRD1(IPR) = Z_RADCLRD1(IPR)+(Z_BBD-Z_RADCLRD1(IPR))*P_ABSS1(INDEX)
580      Z_DRADCL1 = Z_DRADCL1 + Z_RADCLRD1(IPR)
581
582!* Code to account for maximum/random overlap:
583!   Performs RT on the radiance most recently switched between clear and
584!   cloudy streams
585      Z_RADMOD = Z_RAD(IPR) * (Z_FACCLR1D(I_LEV-1) * (1.0_JPRB-P_ABSS1(INDEX)) +&
586       & Z_FACCLD1D(I_LEV-1) *  Z_TTOT) - &
587       & Z_FACCMB1D(I_LEV-1) * Z_GASSRC + &
588       & Z_FACCMB2D(I_LEV-1) * Z_CLDSRC 
589       
590!   Computes what the clear and cloudy streams would have been had no
591!   radiance been switched       
592      Z_OLDCLD(IPR) = Z_CLDRADD(IPR) - Z_RADMOD
593      Z_OLDCLR(IPR) = Z_CLRRADD(IPR) + Z_RADMOD
594     
595!   Computes the radiance to be switched between clear and cloudy.     
596      Z_RAD(IPR) = -Z_RADMOD + Z_FACCLR2D(I_LEV-1)*Z_OLDCLR(IPR) -&
597       & Z_FACCLD2D(I_LEV-1)*Z_OLDCLD(IPR) 
598      Z_CLDRADD(IPR) = Z_CLDRADD(IPR) + Z_RAD(IPR)
599      Z_CLRRADD(IPR) = Z_CLRRADD(IPR) - Z_RAD(IPR)
600!***
601
602    ENDDO
603
604  ELSE
605
606!  *** Clear layer
607!  *** DRAD1 holds summed radiance for total sky stream
608!  *** DRADCL1 holds summed radiance for clear sky stream
609
610    IENT = JPGPT * (I_LEV-1)
611    IF (ICLDDN == 1) THEN
612      DO IPR = 1, JPGPT
613        INDEX = IENT + IPR
614!--DS         
615!           NBI = NGB(IPR)
616        Z_BGLAY = PFRAC(IPR,I_LEV) * Z_PLAY(NGB(IPR),I_LEV)
617!----           
618        Z_DELBGUP     = Z_BGLEV(IPR) - Z_BGLAY
619        Z_BBU1(INDEX) = Z_BGLAY + P_TAUSF1(INDEX) * Z_DELBGUP
620!--DS           
621        Z_BGLEV(IPR) = PFRAC(IPR,I_LEV) * Z_PLVL(NGB(IPR),I_LEV-1)
622!----                     
623        Z_DELBGDN = Z_BGLEV(IPR) - Z_BGLAY
624        Z_BBD = Z_BGLAY + P_TAUSF1(INDEX) * Z_DELBGDN
625       
626!- total-sky downward radiance
627        Z_RADLD1(IPR) = Z_RADLD1(IPR)+(Z_BBD-Z_RADLD1(IPR))*P_ABSS1(INDEX)
628        Z_DRAD1 = Z_DRAD1 + Z_RADLD1(IPR)
629       
630!- clear-sky downward radiance
631!-  Set clear sky stream to total sky stream as long as layers
632!-  remain clear.  Streams diverge when a cloud is reached.
633        Z_RADCLRD1(IPR) = Z_RADCLRD1(IPR)+(Z_BBD-Z_RADCLRD1(IPR))*P_ABSS1(INDEX)
634        Z_DRADCL1 = Z_DRADCL1 + Z_RADCLRD1(IPR)
635      ENDDO
636           
637    ELSE
638       
639      DO IPR = 1, JPGPT
640        INDEX = IENT + IPR
641!--DS         
642!           NBI = NGB(IPR)
643        Z_BGLAY = PFRAC(IPR,I_LEV) * Z_PLAY(NGB(IPR),I_LEV)
644!----           
645        Z_DELBGUP     = Z_BGLEV(IPR) - Z_BGLAY
646        Z_BBU1(INDEX) = Z_BGLAY + P_TAUSF1(INDEX) * Z_DELBGUP
647!--DS           
648        Z_BGLEV(IPR) = PFRAC(IPR,I_LEV) * Z_PLVL(NGB(IPR),I_LEV-1)
649!----                     
650        Z_DELBGDN = Z_BGLEV(IPR) - Z_BGLAY
651        Z_BBD = Z_BGLAY + P_TAUSF1(INDEX) * Z_DELBGDN
652!- total-sky downward flux         
653        Z_RADLD1(IPR) = Z_RADLD1(IPR)+(Z_BBD-Z_RADLD1(IPR))*P_ABSS1(INDEX)
654        Z_DRAD1 = Z_DRAD1 + Z_RADLD1(IPR)
655!- clear-sky downward flux         
656!-  Set clear sky stream to total sky stream as long as layers
657!-  remain clear.  Streams diverge when a cloud is reached.
658        Z_RADCLRD1(IPR) = Z_RADLD1(IPR)
659      ENDDO
660      Z_DRADCL1 = Z_DRAD1
661    ENDIF
662   
663  ENDIF
664
665  P_TOTDFLUC(I_LEV-1) = Z_DRADCL1 * Z_WTNUM(1)
666  P_TOTDFLUX(I_LEV-1) = Z_DRAD1   * Z_WTNUM(1)
667
668ENDDO
669
670! Spectral reflectivity and reflectance
671! Includes the contribution of spectrally varying longwave emissivity
672! and reflection from the surface to the upward radiative transfer.
673! Note: Spectral and Lambertian reflections are identical for the one
674! angle flux integration used here.
675
676Z_URAD1   = 0.0_JPRB
677Z_URADCL1 = 0.0_JPRB
678
679!start JJM_000511
680!IF (IREFLECT  ==  0) THEN
681!- Lambertian reflection.
682DO IPR = 1, JPGPT
683! Clear-sky radiance
684!    RADCLD = _TWO_ * (RADCLRD1(IPR) * WTNUM(1) )
685  Z_RADCLD = Z_RADCLRD1(IPR)
686  Z_RADCLRU1(IPR) = Z_RADUEMIT(IPR) + (1.0_JPRB - Z_SEMIS(IPR)) * Z_RADCLD
687  Z_URADCL1 = Z_URADCL1 + Z_RADCLRU1(IPR)
688
689! Total sky radiance
690!    RADD = _TWO_ * (RADLD1(IPR) * WTNUM(1) )
691  Z_RADD = Z_RADLD1(IPR)
692  Z_RADLU1(IPR) = Z_RADUEMIT(IPR) + (1.0_JPRB - Z_SEMIS(IPR)) * Z_RADD
693  Z_URAD1 = Z_URAD1 + Z_RADLU1(IPR)
694ENDDO
695P_TOTUFLUC(0) = Z_URADCL1 * 0.5_JPRB
696P_TOTUFLUX(0) = Z_URAD1 * 0.5_JPRB
697!ELSE
698!!- Specular reflection.
699!  DO IPR = 1, JPGPT
700!    RADCLU = RADUEMIT(IPR)
701!    RADCLRU1(IPR) = RADCLU + (_ONE_ - SEMIS(IPR)) * RADCLRD1(IPR)
702!    URADCL1 = URADCL1 + RADCLRU1(IPR)
703
704!    RADU = RADUEMIT(IPR)
705!    RADLU1(IPR) = RADU + (_ONE_ - SEMIS(IPR)) * RADLD1(IPR)
706!    URAD1 = URAD1 + RADLU1(IPR)
707!  ENDDO
708!  TOTUFLUC(0) = URADCL1 * WTNUM(1)
709!  TOTUFLUX(0) = URAD1   * WTNUM(1)
710!ENDIF
711
712!- Upward radiative transfer.
713!- *** URAD1 holds the summed radiance for total sky stream
714!- *** URADCL1 holds the summed radiance for clear sky stream
715DO I_LEV = 1, KLEV
716  Z_URAD1   = 0.0_JPRB
717  Z_URADCL1 = 0.0_JPRB
718
719! Check flag for cloud in current layer
720  IF (K_ICLDLYR(I_LEV) == 1) THEN
721
722!- *** Cloudy layer
723    IENT = JPGPT * (I_LEV-1)
724    DO IPR = 1, JPGPT
725      INDEX = IENT + IPR
726!- total-sky upward flux         
727      Z_GASSRC = Z_BBU1(INDEX) * P_ABSS1(INDEX)
728
729!- If first cloudy layer in sequence, split up radiance into clear and
730!    cloudy streams depending on cloud fraction
731      IF (ISTCLD(I_LEV)  ==  1) THEN
732        Z_CLDRADU(IPR) = Z_CLDFRAC(I_LEV) * Z_RADLU1(IPR)
733        Z_CLRRADU(IPR) = Z_RADLU1(IPR) - Z_CLDRADU(IPR)
734        Z_OLDCLD(IPR) = Z_CLDRADU(IPR)
735        Z_OLDCLR(IPR) = Z_CLRRADU(IPR)
736        Z_RAD(IPR) = 0.0_JPRB
737      ENDIF
738      Z_TTOT = 1.0_JPRB - Z_ATOT1(INDEX)
739      Z_TRNS = 1.0_JPRB - P_ABSS1(INDEX)
740      Z_CLDSRC = Z_BBUTOT1(INDEX) * Z_ATOT1(INDEX)
741
742!- Separate RT equations for clear and cloudy streams     
743      Z_CLDRADU(IPR) = Z_CLDRADU(IPR) * Z_TTOT + Z_CLDFRAC(I_LEV) * Z_CLDSRC
744      Z_CLRRADU(IPR) = Z_CLRRADU(IPR) * Z_TRNS +(1.0_JPRB - Z_CLDFRAC(I_LEV)) * Z_GASSRC
745!***
746
747!- total sky upward flux
748      Z_RADLU1(IPR) = Z_CLDRADU(IPR) + Z_CLRRADU(IPR)
749      Z_URAD1 = Z_URAD1 + Z_RADLU1(IPR)
750     
751!- clear-sky upward flux
752      Z_RADCLRU1(IPR) = Z_RADCLRU1(IPR) + (Z_BBU1(INDEX)-Z_RADCLRU1(IPR))&
753       & *P_ABSS1(INDEX) 
754      Z_URADCL1 = Z_URADCL1 + Z_RADCLRU1(IPR)
755
756!* Code to account for maximum/random overlap:
757!   Performs RT on the radiance most recently switched between clear and
758!   cloudy streams
759      Z_RADMOD = Z_RAD(IPR) * (Z_FACCLR1(I_LEV+1) * Z_TRNS +&
760       & Z_FACCLD1(I_LEV+1) *  Z_TTOT) - &
761       & Z_FACCMB1(I_LEV+1) * Z_GASSRC + &
762       & Z_FACCMB2(I_LEV+1) * Z_CLDSRC 
763       
764!   Computes what the clear and cloudy streams would have been had no
765!   radiance been switched       
766      Z_OLDCLD(IPR) = Z_CLDRADU(IPR) - Z_RADMOD
767      Z_OLDCLR(IPR) = Z_CLRRADU(IPR) + Z_RADMOD
768     
769!   Computes the radiance to be switched between clear and cloudy.     
770      Z_RAD(IPR) = -Z_RADMOD + Z_FACCLR2(I_LEV+1)*Z_OLDCLR(IPR) -&
771       & Z_FACCLD2(I_LEV+1)*Z_OLDCLD(IPR) 
772      Z_CLDRADU(IPR) = Z_CLDRADU(IPR) + Z_RAD(IPR)
773      Z_CLRRADU(IPR) = Z_CLRRADU(IPR) - Z_RAD(IPR)
774!***
775    ENDDO
776
777  ELSE
778
779!- *** Clear layer
780    IENT = JPGPT * (I_LEV-1)
781    DO IPR = 1, JPGPT
782      INDEX = IENT + IPR
783!- total-sky upward flux         
784      Z_RADLU1(IPR) = Z_RADLU1(IPR)+(Z_BBU1(INDEX)-Z_RADLU1(IPR))*P_ABSS1(INDEX)
785      Z_URAD1 = Z_URAD1 + Z_RADLU1(IPR)
786!- clear-sky upward flux
787!   Upward clear and total sky streams must be separate because surface
788!   reflectance is different for each.
789      Z_RADCLRU1(IPR) = Z_RADCLRU1(IPR)+(Z_BBU1(INDEX)-Z_RADCLRU1(IPR))*P_ABSS1(INDEX)
790      Z_URADCL1 = Z_URADCL1 + Z_RADCLRU1(IPR)
791    ENDDO
792
793  ENDIF
794
795  P_TOTUFLUC(I_LEV) = Z_URADCL1 * Z_WTNUM(1)
796  P_TOTUFLUX(I_LEV) = Z_URAD1   * Z_WTNUM(1)
797
798ENDDO
799
800!* Convert radiances to fluxes and heating rates for total and clear sky.
801! ** NB: moved to calling routine
802!      TOTUFLUC(0) = TOTUFLUC(0) * FLUXFAC
803!      TOTDFLUC(0) = TOTDFLUC(0) * FLUXFAC
804!      TOTUFLUX(0) = TOTUFLUX(0) * FLUXFAC
805!      TOTDFLUX(0) = TOTDFLUX(0) * FLUXFAC
806
807!      CLFNET(0) = TOTUFLUC(0) - TOTDFLUC(0)
808!      FNET(0)   = TOTUFLUX(0) - TOTDFLUX(0)
809!      DO LEV = 1, KLEV
810!        TOTUFLUC(LEV) = TOTUFLUC(LEV) * FLUXFAC
811!        TOTDFLUC(LEV) = TOTDFLUC(LEV) * FLUXFAC
812!        CLFNET(LEV) = TOTUFLUC(LEV) - TOTDFLUC(LEV)
813
814!        TOTUFLUX(LEV) = TOTUFLUX(LEV) * FLUXFAC
815!        TOTDFLUX(LEV) = TOTDFLUX(LEV) * FLUXFAC
816!        FNET(LEV) = TOTUFLUX(LEV) - TOTDFLUX(LEV)
817!        L = LEV - 1
818
819!- Calculate Heating Rates.
820!        CLHTR(L)=HEATFAC*(CLFNET(L)-CLFNET(LEV))/(PZ(L)-PZ(LEV))
821!        HTR(L)  =HEATFAC*(FNET(L)  -FNET(LEV))  /(PZ(L)-PZ(LEV))
822!      END DO
823!      CLHTR(KLEV) = 0.0
824!      HTR(KLEV)   = 0.0
825
826IF (LHOOK) CALL DR_HOOK('RRTM_RTRN1A_140GP',1,ZHOOK_HANDLE)
827END SUBROUTINE RRTM_RTRN1A_140GP
Note: See TracBrowser for help on using the repository browser.