SUBROUTINE RRTM_RTRN1A_140GP (KIDIA,KFDIA,KLEV,K_ISTART,K_IEND,K_ICLDLYR,P_CLDFRAC,P_TAUCLD,P_ABSS1,&
 & P_OD,P_TAUSF1,P_TOTDFLUC,P_TOTDFLUX,P_TOTUFLUC,P_TOTUFLUX,&
 & P_TAVEL,P_TZ,P_TBOUND,PFRAC,P_SEMISS,P_SEMISLW)  

!     Reformatted for F90 by JJMorcrette, ECMWF, 980714
!     Speed-up by D.Salmond, ECMWF, 9907
!     Bug-fix by M.J. Iacono, AER, Inc., 9911
!     Bug-fix by JJMorcrette, ECMWF, 991209 (RAT1, RAT2 initialization)
!     Speed-up by D. Salmond, ECMWF, 9912
!     Bug-fix by JJMorcrette, ECMWF, 0005 (extrapolation T<160K)
!     Speed-up by D. Salmond, ECMWF, 000515
!        NEC           25-Oct-2007 Optimisations
!        D. Salmond    11-Dec-2007 Optimizations
!        O. Riviere    15-Sep-2008 Deallocate Z_BBU1, Z_BBUTOT1, Z_ATOT1

!-* This program calculates the upward fluxes, downward fluxes,
!   and heating rates for an arbitrary atmosphere.  The input to
!   this program is the atmospheric profile and all Planck function
!   information.  First-order "numerical" quadrature is used for the 
!   angle integration, i.e. only one exponential is computed per layer
!   per g-value per band.  Cloud overlap is treated with a generalized
!   maximum/random method in which adjacent cloud layers are treated
!   with maximum overlap, and non-adjacent cloud groups are treated
!   with random overlap.  For adjacent cloud layers, cloud information
!   is carried from the previous two layers.

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK

USE PARRRTM  , ONLY : JPBAND   ,JPGPT   ,JPLAY
USE YOERRTAB , ONLY : BPADE
USE YOERRTWN , ONLY : TOTPLNK  ,DELWAVE
USE YOERRTFTR, ONLY : NGB

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA
INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA
INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV 
INTEGER(KIND=JPIM),INTENT(IN)    :: K_ISTART 
INTEGER(KIND=JPIM),INTENT(IN)    :: K_IEND 
INTEGER(KIND=JPIM),INTENT(IN)    :: K_ICLDLYR(KIDIA:KFDIA,JPLAY) ! Cloud indicator
REAL(KIND=JPRB)   ,INTENT(IN)    :: P_CLDFRAC(KIDIA:KFDIA,JPLAY) ! Cloud fraction
REAL(KIND=JPRB)   ,INTENT(IN)    :: P_TAUCLD(KIDIA:KFDIA,JPLAY,JPBAND) ! Spectral optical thickness
REAL(KIND=JPRB)   ,INTENT(IN)    :: P_ABSS1(KIDIA:KFDIA,JPGPT,JPLAY) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: P_OD(JPGPT,JPLAY,KIDIA:KFDIA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: P_TAUSF1(KIDIA:KFDIA,JPGPT,JPLAY) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TOTDFLUC(KIDIA:KFDIA,0:JPLAY) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TOTDFLUX(KIDIA:KFDIA,0:JPLAY) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TOTUFLUC(KIDIA:KFDIA,0:JPLAY) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TOTUFLUX(KIDIA:KFDIA,0:JPLAY) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: P_TAVEL(KIDIA:KFDIA,JPLAY) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: P_TZ(KIDIA:KFDIA,0:JPLAY) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: P_TBOUND(KIDIA:KFDIA) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PFRAC(KIDIA:KFDIA,JPGPT,JPLAY) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SEMISS(KIDIA:KFDIA,JPBAND) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_SEMISLW(KIDIA:KFDIA)
!- from PROFILE             
!- from SP             
!- from SURFACE             
INTEGER(KIND=JPIM) :: INDLAY(KIDIA:KFDIA,JPLAY),INDLEV(KIDIA:KFDIA,0:JPLAY)

REAL(KIND=JPRB),ALLOCATABLE :: Z_BBU1(:,:),Z_BBUTOT1(:,:)
REAL(KIND=JPRB) :: Z_TLAYFRAC(KIDIA:KFDIA,JPLAY),Z_TLEVFRAC(KIDIA:KFDIA,0:JPLAY)
REAL(KIND=JPRB) :: Z_BGLEV(JPGPT)
!-- DS_000515
REAL(KIND=JPRB) :: Z_PLVL(KIDIA:KFDIA,JPBAND+1,0:JPLAY),Z_PLAY(KIDIA:KFDIA,JPBAND+1,0:JPLAY)
REAL(KIND=JPRB) :: Z_WTNUM = 0.5_JPRB
!-- DS_000515
REAL(KIND=JPRB) :: Z_ODCLDNW(JPGPT,JPLAY)
REAL(KIND=JPRB) :: Z_SEMIS(JPGPT,KIDIA:KFDIA),Z_RADUEMIT(JPGPT,KIDIA:KFDIA)

REAL(KIND=JPRB) :: Z_RADCLRU1(JPGPT,KIDIA:KFDIA) ,Z_RADCLRD1(JPGPT,KIDIA:KFDIA)
REAL(KIND=JPRB) :: Z_RADLU1(JPGPT,KIDIA:KFDIA)   ,Z_RADLD1(JPGPT,KIDIA:KFDIA)
!-- DS_000515
REAL(KIND=JPRB) :: Z_TRNCLD(KIDIA:KFDIA,JPLAY,JPBAND+1)
!-- DS_000515
REAL(KIND=JPRB) :: Z_ABSCLDNW(JPGPT,JPLAY)
REAL(KIND=JPRB),ALLOCATABLE :: Z_ATOT1(:,:)

REAL(KIND=JPRB) :: Z_SURFEMIS(KIDIA:KFDIA,JPBAND),Z_PLNKEMIT(KIDIA:KFDIA,JPBAND)

! dimension of arrays required for cloud overlap calculations

REAL(KIND=JPRB) :: Z_CLRRADU(jpgpt),Z_CLDRADU(jpgpt),Z_OLDCLD(jpgpt)
REAL(KIND=JPRB) :: Z_OLDCLR(jpgpt),Z_RAD(jpgpt)
REAL(KIND=JPRB) :: Z_FACCLD1(KIDIA:KFDIA,jplay+1),Z_FACCLD2(KIDIA:KFDIA,jplay+1)
REAL(KIND=JPRB) :: Z_FACCLR1(KIDIA:KFDIA,jplay+1),Z_FACCLR2(KIDIA:KFDIA,jplay+1)
REAL(KIND=JPRB) :: Z_FACCMB1(KIDIA:KFDIA,jplay+1),Z_FACCMB2(KIDIA:KFDIA,jplay+1)
REAL(KIND=JPRB) :: Z_FACCLD1D(KIDIA:KFDIA,0:jplay),Z_FACCLD2D(KIDIA:KFDIA,0:jplay),Z_FACCLR1D(KIDIA:KFDIA,0:jplay)
REAL(KIND=JPRB) :: Z_FACCLR2D(KIDIA:KFDIA,0:jplay),Z_FACCMB1D(KIDIA:KFDIA,0:jplay),Z_FACCMB2D(KIDIA:KFDIA,0:jplay)
REAL(KIND=JPRB) :: Z_CLRRADD(jpgpt),Z_CLDRADD(jpgpt)
INTEGER(KIND=JPIM) :: ISTCLD(KIDIA:KFDIA,jplay+1),ISTCLDD(KIDIA:KFDIA,0:jplay)
!******

!REAL_B :: ZPLVL(JPGPT+1,JPLAY)  ,ZPLAY(JPGPT+1,JPLAY)
!REAL_B :: ZTRNCLD(JPGPT+1,JPLAY),ZTAUCLD(JPGPT+1,JPLAY)

INTEGER(KIND=JPIM) :: JBAND, ICLDDN, IENT, INDBOUND(KIDIA:KFDIA), INDEX, JI, JLEV, I_NBI, ILEV
INTEGER(KIND=JPIM) :: JLON

REAL(KIND=JPRB) :: Z_BBD, Z_BBDTOT, Z_BGLAY, Z_CLDSRC, Z_DBDTLAY, Z_DBDTLEV,&
 & Z_DELBGDN, Z_DELBGUP, Z_FACTOT1, &
 & Z_FMAX, Z_FMIN, Z_GASSRC, Z_ODSM, Z_PLANKBND, &
 & Z_RADCLD, Z_RADD, Z_RADMOD, Z_RAT1(KIDIA:KFDIA), Z_RAT2(KIDIA:KFDIA), Z_SUMPL(KIDIA:KFDIA), &
 & Z_SUMPLEM(KIDIA:KFDIA), Z_TBNDFRAC(KIDIA:KFDIA), Z_TRNS, Z_TTOT, ZEXTAU  
REAL(KIND=JPRB) :: Z_URAD1_(KIDIA:KFDIA,KLEV), Z_URADCL1_(KIDIA:KFDIA,KLEV)
REAL(KIND=JPRB) :: Z_URADCL1__(KIDIA:KFDIA), Z_URAD1__(KIDIA:KFDIA)
REAL(KIND=JPRB) :: Z_DRAD1__, Z_DRADCL1__
REAL(KIND=JPRB) :: ZHOOK_HANDLE

!--------------------------------------------------------------------------
! Input
!  JPLAY                 ! Maximum number of model layers
!  JPGPT                 ! Total number of g-point subintervals
!  JPBAND                ! Number of longwave spectral bands
!  SECANG                ! Diffusivity angle
!  WTNUM                 ! Weight for radiance to flux conversion
!  KLEV                  ! Number of model layers
!  PAVEL(JPLAY)          ! Mid-layer pressures (hPa)
!  TAVEL(JPLAY)          ! Mid-layer temperatures (K)
!  TZ(0:JPLAY)           ! Interface temperatures (K)
!  TBOUND                ! Surface temperature
!  CLDFRAC(JPLAY)        ! Layer cloud fraction
!  TAUCLD(JPLAY,JPBAND)  ! Layer cloud optical thickness
!  ITR
!  PFRAC(JPGPT,JPLAY)    ! Planck function fractions
!  ICLDLYR(KIDIA:KFDIA,JPLAY)        ! Flag for cloudy layers
!  ICLD                  ! Flag for cloudy column
!  SEMISS(JPBAND)        ! Surface spectral emissivity
!  BPADE                 ! Pade constant
!  OD                    ! Clear-sky optical thickness
!  TAUSF1                ! 
!  ABSS1                 !  

!  ABSS(JPGPT*JPLAY)     !
!  ABSCLD(JPLAY)         !
!  ATOT(JPGPT*JPLAY)     !
!  ODCLR(JPGPT,JPLAY)    ! 
!  ODCLD(JPBAND,JPLAY)   !
!  EFCLFR1(JPBAND,JPLAY) ! Effective cloud fraction
!  RADLU(JPGPT)          ! Upward radiance
!  URAD                  ! Spectrally summed upward radiance
!  RADCLRU(JPGPT)        ! Clear-sky upward radiance
!  CLRURAD               ! Spectrally summed clear-sky upward radiance
!  RADLD(JPGPT)          ! Downward radiance
!  DRAD                  ! Spectrally summed downward radiance
!  RADCLRD(JPGPT)        ! Clear-sky downward radiance
!  CLRDRAD               ! Spectrally summed clear-sky downward radiance

! Output
!  TOTUFLUX(0:JPLAY)     ! Upward longwave flux
!  TOTDFLUX(0:JPLAY)     ! Downward longwave flux
!  TOTUFLUC(0:JPLAY)     ! Clear-sky upward longwave flux
!  TOTDFLUC(0:JPLAY)     ! Clear-sky downward longwave flux

! Maximum/Random cloud overlap variables
! for upward radiaitve transfer
!  FACCLR2  fraction of clear radiance from previous layer that needs to 
!           be switched to cloudy stream
!  FACCLR1  fraction of the radiance that had been switched in the previous
!           layer from cloudy to clear that needs to be switched back to
!           cloudy in the current layer
!  FACCLD2  fraction of cloudy radiance from previous layer that needs to 
!           be switched to clear stream
!           be switched to cloudy stream
!  FACCLD1  fraction of the radiance that had been switched in the previous
!           layer from clear to cloudy that needs to be switched back to
!           clear in the current layer
! for downward radiaitve transfer
!  FACCLR2D fraction of clear radiance from previous layer that needs to 
!           be switched to cloudy stream
!  FACCLR1D fraction of the radiance that had been switched in the previous
!           layer from cloudy to clear that needs to be switched back to
!           cloudy in the current layer
!  FACCLD2D fraction of cloudy radiance from previous layer that needs to 
!           be switched to clear stream
!           be switched to cloudy stream
!  FACCLD1D fraction of the radiance that had been switched in the previous
!           layer from clear to cloudy that needs to be switched back to
!           clear in the current layer

!--------------------------------------------------------------------------

IF (LHOOK) CALL DR_HOOK('RRTM_RTRN1A_140GP',0,ZHOOK_HANDLE)

ALLOCATE(Z_BBU1(JPGPT*JPLAY,KIDIA:KFDIA))
ALLOCATE(Z_BBUTOT1(JPGPT*JPLAY,KIDIA:KFDIA))
ALLOCATE(Z_ATOT1(JPGPT*JPLAY,KIDIA:KFDIA))

DO JLON = KIDIA, KFDIA
  !-start JJM_000511
  IF (P_TBOUND(JLON) < 339._JPRB .AND. P_TBOUND(JLON) >= 160._JPRB ) THEN
    INDBOUND(JLON) = P_TBOUND(JLON) - 159._JPRB
    Z_TBNDFRAC(JLON) = P_TBOUND(JLON) - INT(P_TBOUND(JLON))
  ELSEIF (P_TBOUND(JLON) >= 339._JPRB ) THEN
    INDBOUND(JLON) = 180
    Z_TBNDFRAC(JLON) = P_TBOUND(JLON) - 339._JPRB
  ELSEIF (P_TBOUND(JLON) < 160._JPRB ) THEN
    INDBOUND(JLON) = 1
    Z_TBNDFRAC(JLON) = P_TBOUND(JLON) - 160._JPRB
  ENDIF  
ENDDO
!-end JJM_000511
  
Z_URAD1_ = 0.0_JPRB
Z_URADCL1_ = 0.0_JPRB
!P_TOTUFLUC = 0.0_JPRB
P_TOTDFLUC(:,KLEV) = 0.0_JPRB
!P_TOTUFLUX = 0.0_JPRB
P_TOTDFLUX(:,KLEV) = 0.0_JPRB
Z_FACCLD1D = 0.0_JPRB
Z_FACCLD2D = 0.0_JPRB
Z_FACCLR1D = 0.0_JPRB
Z_FACCLR2D = 0.0_JPRB
Z_FACCMB1D = 0.0_JPRB
Z_FACCMB2D = 0.0_JPRB
Z_FACCLD1  = 0.0_JPRB
Z_FACCLD2  = 0.0_JPRB
Z_FACCLR1  = 0.0_JPRB
Z_FACCLR2 = 0.0_JPRB
Z_FACCMB1 = 0.0_JPRB
Z_FACCMB2 = 0.0_JPRB


DO JLEV = 0, KLEV
  DO JLON = KIDIA, KFDIA
    !-start JJM_000511
    IF (P_TZ(JLON,JLEV) < 339._JPRB .AND. P_TZ(JLON,JLEV) >= 160._JPRB ) THEN
      INDLEV(JLON,JLEV) = P_TZ(JLON,JLEV) - 159._JPRB
      Z_TLEVFRAC(JLON,JLEV) = P_TZ(JLON,JLEV) - INT(P_TZ(JLON,JLEV))
    ELSEIF (P_TZ(JLON,JLEV) >= 339._JPRB ) THEN
      INDLEV(JLON,JLEV) = 180
      Z_TLEVFRAC(JLON,JLEV) = P_TZ(JLON,JLEV) - 339._JPRB
    ELSEIF (P_TZ(JLON,JLEV) < 160._JPRB ) THEN
      INDLEV(JLON,JLEV) = 1
      Z_TLEVFRAC(JLON,JLEV) = P_TZ(JLON,JLEV) - 160._JPRB
    ENDIF    
    !-end JJM_000511
  ENDDO
ENDDO

DO JLON = KIDIA, KFDIA
  Z_RAT1(JLON) = 0.0_JPRB
  Z_RAT2(JLON) = 0.0_JPRB
  !_end_jjm 991209
  Z_SUMPL  (JLON) = 0.0_JPRB
  Z_SUMPLEM(JLON) = 0.0_JPRB
  ISTCLD (JLON,1   ) = 1
  ISTCLDD(JLON,KLEV) = 1
ENDDO

DO JLEV = 1, KLEV
  DO JLON = KIDIA, KFDIA
    !-- DS_000515
    !-start JJM_000511
    IF (P_TAVEL(JLON,JLEV) < 339._JPRB .AND. P_TAVEL(JLON,JLEV) >= 160._JPRB ) THEN
      INDLAY(JLON,JLEV) = P_TAVEL(JLON,JLEV) - 159._JPRB
      Z_TLAYFRAC(JLON,JLEV) = P_TAVEL(JLON,JLEV) - INT(P_TAVEL(JLON,JLEV))
    ELSEIF (P_TAVEL(JLON,JLEV) >= 339._JPRB ) THEN
      INDLAY(JLON,JLEV) = 180
      Z_TLAYFRAC(JLON,JLEV) = P_TAVEL(JLON,JLEV) - 339._JPRB
    ELSEIF (P_TAVEL(JLON,JLEV) < 160._JPRB ) THEN
      INDLAY(JLON,JLEV) = 1
      Z_TLAYFRAC(JLON,JLEV) = P_TAVEL(JLON,JLEV) - 160._JPRB
    ENDIF  
    !-end JJM_000511
  ENDDO
ENDDO
!-- DS_000515

DO JLEV = 1, KLEV
  DO JLON = KIDIA, KFDIA
    IF (K_ICLDLYR(JLON,JLEV) == 1) THEN

      !mji    
      ISTCLD(JLON,JLEV+1) = 0
      IF (JLEV  ==  KLEV) THEN
        Z_FACCLD1(JLON,JLEV+1) = 0.0_JPRB
        Z_FACCLD2(JLON,JLEV+1) = 0.0_JPRB
        Z_FACCLR1(JLON,JLEV+1) = 0.0_JPRB
        Z_FACCLR2(JLON,JLEV+1) = 0.0_JPRB
        !-- DS_000515      
        !      FACCMB1(LEV+1) = _ZERO_
      !      FACCMB2(LEV+1) = _ZERO_
        !mji      ISTCLD(JLON,LEV+1) = _ZERO_
      ELSEIF (P_CLDFRAC(JLON,JLEV+1)  >=  P_CLDFRAC(JLON,JLEV)) THEN
        Z_FACCLD1(JLON,JLEV+1) = 0.0_JPRB
        Z_FACCLD2(JLON,JLEV+1) = 0.0_JPRB
        IF (ISTCLD(JLON,JLEV)  ==  1) THEN
          !mji        ISTCLD(JLON,LEV+1) = 0
          Z_FACCLR1(JLON,JLEV+1) = 0.0_JPRB
          !mji        
          Z_FACCLR2(JLON,JLEV+1) = 0.0_JPRB
          IF (P_CLDFRAC(JLON,JLEV) < 1.0_JPRB) THEN
            Z_FACCLR2(JLON,JLEV+1) = (P_CLDFRAC(JLON,JLEV+1)-P_CLDFRAC(JLON,JLEV))/&
             & (1.0_JPRB-P_CLDFRAC(JLON,JLEV))  
          ENDIF   
        ELSE
          Z_FMAX = MAX(P_CLDFRAC(JLON,JLEV),P_CLDFRAC(JLON,JLEV-1))
          !mji
          IF (P_CLDFRAC(JLON,JLEV+1)  >  Z_FMAX) THEN
            Z_FACCLR1(JLON,JLEV+1) = Z_RAT2(JLON)
            Z_FACCLR2(JLON,JLEV+1) = (P_CLDFRAC(JLON,JLEV+1)-Z_FMAX)/(1.0_JPRB-Z_FMAX)
            !mji          
          ELSEIF (P_CLDFRAC(JLON,JLEV+1) < Z_FMAX) THEN
            Z_FACCLR1(JLON,JLEV+1) = (P_CLDFRAC(JLON,JLEV+1)-P_CLDFRAC(JLON,JLEV))/&
             & (P_CLDFRAC(JLON,JLEV-1)-P_CLDFRAC(JLON,JLEV))  
            Z_FACCLR2(JLON,JLEV+1) = 0.0_JPRB
            !mji
          ELSE
            Z_FACCLR1(JLON,JLEV+1) = Z_RAT2(JLON)  
            Z_FACCLR2(JLON,JLEV+1) = 0.0_JPRB
          ENDIF
        ENDIF
        IF (Z_FACCLR1(JLON,JLEV+1) > 0.0_JPRB .OR. Z_FACCLR2(JLON,JLEV+1) > 0.0_JPRB) THEN
          Z_RAT1(JLON) = 1.0_JPRB
          Z_RAT2(JLON) = 0.0_JPRB
        ENDIF
      ELSE
        Z_FACCLR1(JLON,JLEV+1) = 0.0_JPRB
        Z_FACCLR2(JLON,JLEV+1) = 0.0_JPRB
        IF (ISTCLD(JLON,JLEV)  ==  1) THEN
          !mji        ISTCLD(JLON,LEV+1) = 0
          Z_FACCLD1(JLON,JLEV+1) = 0.0_JPRB
          Z_FACCLD2(JLON,JLEV+1) = (P_CLDFRAC(JLON,JLEV)-P_CLDFRAC(JLON,JLEV+1))/P_CLDFRAC(JLON,JLEV)
        ELSE
          Z_FMIN = MIN(P_CLDFRAC(JLON,JLEV),P_CLDFRAC(JLON,JLEV-1))
          IF (P_CLDFRAC(JLON,JLEV+1)  <=  Z_FMIN) THEN
            Z_FACCLD1(JLON,JLEV+1) = Z_RAT1(JLON)
            Z_FACCLD2(JLON,JLEV+1) = (Z_FMIN-P_CLDFRAC(JLON,JLEV+1))/Z_FMIN
          ELSE
            Z_FACCLD1(JLON,JLEV+1) = (P_CLDFRAC(JLON,JLEV)-P_CLDFRAC(JLON,JLEV+1))/&
             & (P_CLDFRAC(JLON,JLEV)-Z_FMIN)  
            Z_FACCLD2(JLON,JLEV+1) = 0.0_JPRB
          ENDIF
        ENDIF
        IF (Z_FACCLD1(JLON,JLEV+1) > 0.0_JPRB .OR. Z_FACCLD2(JLON,JLEV+1) > 0.0_JPRB) THEN
          Z_RAT1(JLON) = 0.0_JPRB
          Z_RAT2(JLON) = 1.0_JPRB
        ENDIF
      ENDIF
      !fcc
      IF (JLEV == 1) THEN
        Z_FACCMB1(JLON,JLEV+1) = 0.
        Z_FACCMB2(JLON,JLEV+1) = Z_FACCLD1(JLON,JLEV+1) * Z_FACCLR2(JLON,JLEV)
      ELSE
        Z_FACCMB1(JLON,JLEV+1) = Z_FACCLR1(JLON,JLEV+1) * Z_FACCLD2(JLON,JLEV) *P_CLDFRAC(JLON,JLEV-1)
        Z_FACCMB2(JLON,JLEV+1) = Z_FACCLD1(JLON,JLEV+1) * Z_FACCLR2(JLON,JLEV) *&
         & (1.0_JPRB - P_CLDFRAC(JLON,JLEV-1))   
      ENDIF
      !end fcc
    ELSE
      !-- DS_000515
      ISTCLD(JLON,JLEV+1) = 1
    ENDIF
  ENDDO
ENDDO

!_start_jjm 991209
DO JLON = KIDIA, KFDIA
  Z_RAT1(JLON) = 0.0_JPRB
  Z_RAT2(JLON) = 0.0_JPRB
ENDDO
!_end_jjm 991209

!-- DS_000515

DO JLEV = KLEV, 2, -1
  DO JLON = KIDIA, KFDIA
    IF (K_ICLDLYR(JLON,JLEV) == 1) THEN
      !mji
      ISTCLDD(JLON,JLEV-1) = 0  
        !mji      ISTCLDD(JLON,LEV-1) = _ZERO_
      IF (P_CLDFRAC(JLON,JLEV-1)  >=  P_CLDFRAC(JLON,JLEV)) THEN
        Z_FACCLD1D(JLON,JLEV-1) = 0.0_JPRB
        Z_FACCLD2D(JLON,JLEV-1) = 0.0_JPRB
        IF (ISTCLDD(JLON,JLEV)  ==  1) THEN
          !mji        ISTCLDD(JLON,LEV-1) = 0
          Z_FACCLR1D(JLON,JLEV-1) = 0.0_JPRB
          Z_FACCLR2D(JLON,JLEV-1) = 0.0_JPRB
          IF (P_CLDFRAC(JLON,JLEV) < 1.0_JPRB) THEN
            Z_FACCLR2D(JLON,JLEV-1) = (P_CLDFRAC(JLON,JLEV-1)-P_CLDFRAC(JLON,JLEV))/&
             & (1.0_JPRB-P_CLDFRAC(JLON,JLEV))  
          ENDIF
        ELSE
          Z_FMAX = MAX(P_CLDFRAC(JLON,JLEV),P_CLDFRAC(JLON,JLEV+1))
          !mji
          IF (P_CLDFRAC(JLON,JLEV-1)  >  Z_FMAX) THEN
            Z_FACCLR1D(JLON,JLEV-1) = Z_RAT2(JLON)
            Z_FACCLR2D(JLON,JLEV-1) = (P_CLDFRAC(JLON,JLEV-1)-Z_FMAX)/(1.0_JPRB-Z_FMAX)
            !mji
          ELSEIF (P_CLDFRAC(JLON,JLEV-1) < Z_FMAX) THEN
            Z_FACCLR1D(JLON,JLEV-1) = (P_CLDFRAC(JLON,JLEV-1)-P_CLDFRAC(JLON,JLEV))/&
             & (P_CLDFRAC(JLON,JLEV+1)-P_CLDFRAC(JLON,JLEV))  
            Z_FACCLR2D(JLON,JLEV-1) = 0.0_JPRB
            !mji
          ELSE          
            Z_FACCLR1D(JLON,JLEV-1) = Z_RAT2(JLON)
            Z_FACCLR2D(JLON,JLEV-1) = 0.0_JPRB
          ENDIF
        ENDIF
        IF (Z_FACCLR1D(JLON,JLEV-1) > 0.0_JPRB .OR. Z_FACCLR2D(JLON,JLEV-1) > 0.0_JPRB)THEN
          Z_RAT1(JLON) = 1.0_JPRB
          Z_RAT2(JLON) = 0.0_JPRB
        ENDIF
      ELSE
        Z_FACCLR1D(JLON,JLEV-1) = 0.0_JPRB
        Z_FACCLR2D(JLON,JLEV-1) = 0.0_JPRB
        IF (ISTCLDD(JLON,JLEV)  ==  1) THEN
          !mji        ISTCLDD(JLON,LEV-1) = 0
          Z_FACCLD1D(JLON,JLEV-1) = 0.0_JPRB
          Z_FACCLD2D(JLON,JLEV-1) = (P_CLDFRAC(JLON,JLEV)-P_CLDFRAC(JLON,JLEV-1))/P_CLDFRAC(JLON,JLEV)
        ELSE
          Z_FMIN = MIN(P_CLDFRAC(JLON,JLEV),P_CLDFRAC(JLON,JLEV+1))
          IF (P_CLDFRAC(JLON,JLEV-1)  <=  Z_FMIN) THEN
            Z_FACCLD1D(JLON,JLEV-1) = Z_RAT1(JLON)
            Z_FACCLD2D(JLON,JLEV-1) = (Z_FMIN-P_CLDFRAC(JLON,JLEV-1))/Z_FMIN
          ELSE
            Z_FACCLD1D(JLON,JLEV-1) = (P_CLDFRAC(JLON,JLEV)-P_CLDFRAC(JLON,JLEV-1))/&
             & (P_CLDFRAC(JLON,JLEV)-Z_FMIN)  
            Z_FACCLD2D(JLON,JLEV-1) = 0.0_JPRB
          ENDIF
        ENDIF
        IF (Z_FACCLD1D(JLON,JLEV-1) > 0.0_JPRB .OR. Z_FACCLD2D(JLON,JLEV-1) > 0.0_JPRB)THEN
          Z_RAT1(JLON) = 0.0_JPRB
          Z_RAT2(JLON) = 1.0_JPRB
        ENDIF
      ENDIF
      Z_FACCMB1D(JLON,JLEV-1) = Z_FACCLR1D(JLON,JLEV-1) * Z_FACCLD2D(JLON,JLEV) *P_CLDFRAC(JLON,JLEV+1)
      Z_FACCMB2D(JLON,JLEV-1) = Z_FACCLD1D(JLON,JLEV-1) * Z_FACCLR2D(JLON,JLEV) *&
       & (1.0_JPRB - P_CLDFRAC(JLON,JLEV+1))  
    ELSE
      ISTCLDD(JLON,JLEV-1) = 1
    ENDIF
  ENDDO
ENDDO
!-----------
ILEV = 1
DO JLON = KIDIA, KFDIA
  IF (K_ICLDLYR(JLON,ILEV) == 1) THEN
    !mji
    ISTCLDD(JLON,ILEV-1) = 0  
    Z_FACCLD1D(JLON,ILEV-1) = 0.0_JPRB
    Z_FACCLD2D(JLON,ILEV-1) = 0.0_JPRB
    Z_FACCLR1D(JLON,ILEV-1) = 0.0_JPRB
    Z_FACCLR2D(JLON,ILEV-1) = 0.0_JPRB
    Z_FACCMB1D(JLON,ILEV-1) = 0.0_JPRB
    Z_FACCMB2D(JLON,ILEV-1) = 0.0_JPRB
    !mji      ISTCLDD(JLON,LEV-1) = _ZERO_
    Z_FACCMB1D(JLON,ILEV-1) = Z_FACCLR1D(JLON,ILEV-1) * Z_FACCLD2D(JLON,ILEV) *P_CLDFRAC(JLON,ILEV+1)
    Z_FACCMB2D(JLON,ILEV-1) = Z_FACCLD1D(JLON,ILEV-1) * Z_FACCLR2D(JLON,ILEV) *&
     & (1.0_JPRB - P_CLDFRAC(JLON,ILEV+1))  
  ELSE
    ISTCLDD(JLON,ILEV-1) = 1
  ENDIF
ENDDO
!-----------

!- Loop over frequency bands.

DO JBAND = K_ISTART, K_IEND
  DO JLON = KIDIA, KFDIA
    Z_DBDTLEV = TOTPLNK(INDBOUND(JLON)+1,JBAND)-TOTPLNK(INDBOUND(JLON),JBAND)
    Z_PLANKBND = DELWAVE(JBAND) * (TOTPLNK(INDBOUND(JLON),JBAND) + Z_TBNDFRAC(JLON) * Z_DBDTLEV)
    Z_DBDTLEV = TOTPLNK(INDLEV(JLON,0)+1,JBAND) -TOTPLNK(INDLEV(JLON,0),JBAND)
    !-- DS_000515
    Z_PLVL(JLON,JBAND,0) = DELWAVE(JBAND)&
     & * (TOTPLNK(INDLEV(JLON,0),JBAND) + Z_TLEVFRAC(JLON,0)*Z_DBDTLEV)  

    Z_SURFEMIS(JLON,JBAND) = P_SEMISS(JLON,JBAND)
    Z_PLNKEMIT(JLON,JBAND) = Z_SURFEMIS(JLON,JBAND) * Z_PLANKBND
    Z_SUMPLEM(JLON)  = Z_SUMPLEM(JLON) + Z_PLNKEMIT(JLON,JBAND)
    Z_SUMPL(JLON)    = Z_SUMPL(JLON)   + Z_PLANKBND
    !--DS
  ENDDO
ENDDO
!---

!-- DS_000515
DO JLEV = 1, KLEV
  DO JBAND = K_ISTART, K_IEND
    DO JLON = KIDIA, KFDIA
      !----              
      !- Calculate the integrated Planck functions for at the
      !  level and layer temperatures.
      !  Compute cloud transmittance for cloudy layers.
      Z_DBDTLEV = TOTPLNK(INDLEV(JLON,JLEV)+1,JBAND) - TOTPLNK(INDLEV(JLON,JLEV),JBAND)
      Z_DBDTLAY = TOTPLNK(INDLAY(JLON,JLEV)+1,JBAND) - TOTPLNK(INDLAY(JLON,JLEV),JBAND)
      !-- DS_000515
      Z_PLAY(JLON,JBAND,JLEV) = DELWAVE(JBAND)&
       & *(TOTPLNK(INDLAY(JLON,JLEV),JBAND)+Z_TLAYFRAC(JLON,JLEV)*Z_DBDTLAY)  
      Z_PLVL(JLON,JBAND,JLEV) = DELWAVE(JBAND)&
       & *(TOTPLNK(INDLEV(JLON,JLEV),JBAND)+Z_TLEVFRAC(JLON,JLEV)*Z_DBDTLEV)  
      IF (K_ICLDLYR(JLON,JLEV) > 0) THEN
        ZEXTAU = MIN( P_TAUCLD(JLON,JLEV,JBAND), 200._JPRB)
        Z_TRNCLD(JLON,JLEV,JBAND) = EXP( -ZEXTAU )
      ENDIF
      !-- DS_000515
    ENDDO
  ENDDO
ENDDO

DO JLON = KIDIA, KFDIA
  P_SEMISLW(JLON) = Z_SUMPLEM(JLON) / Z_SUMPL(JLON)
ENDDO

!--DS
!O JI = 1, JPGPT
! NBI = NGB(JI)
! DO LEV =  1 , KLEV
!-- DS_000515
!   ZPLAY(JI,LEV) = PLAY(LEV,NGB(JI))
!   ZPLVL(JI,LEV) = PLVL(LEV-1,NGB(JI))
!   ZTAUCLD(JI,LEV) = TAUCLD(LEV,NGB(JI))
!   ZTRNCLD(JI,LEV) = TRNCLD(LEV,NGB(JI))
!-- DS_000515
! ENDDO
!NDDO
!----      

!- For cloudy layers, set cloud parameters for radiative transfer.
DO JLON = KIDIA, KFDIA
  DO JLEV = 1, KLEV
    IF (K_ICLDLYR(JLON,JLEV) > 0) THEN
      DO JI = 1, JPGPT
        !--DS          
        !            NBI = NGB(JI)
        Z_ODCLDNW (JI,JLEV) =            P_TAUCLD(JLON,JLEV,NGB(JI))
        Z_ABSCLDNW(JI,JLEV) = 1.0_JPRB - Z_TRNCLD(JLON,JLEV,NGB(JI))
        !----            
        !            EFCLFRNW(JI,LEV) = ABSCLDNW(JI,LEV) * CLDFRAC(LEV)
      ENDDO
    ENDIF
  ENDDO

  !- Initialize for radiative transfer.
  DO JI = 1, JPGPT
    Z_RADCLRD1(JI,JLON) = 0.0_JPRB
    Z_RADLD1(JI,JLON)   = 0.0_JPRB
    I_NBI = NGB(JI)
    Z_SEMIS(JI,JLON) = Z_SURFEMIS(JLON,I_NBI)
    Z_RADUEMIT(JI,JLON) = PFRAC(JLON,JI,1) * Z_PLNKEMIT(JLON,I_NBI)
    Z_BGLEV(JI) = PFRAC(JLON,JI,KLEV) * Z_PLVL(JLON,I_NBI,KLEV)
  ENDDO

  !- Downward radiative transfer.
  !  *** DRAD1 holds summed radiance for total sky stream
  !  *** DRADCL1 holds summed radiance for clear sky stream

  ICLDDN = 0
  DO JLEV = KLEV, 1, -1
    Z_DRAD1__  = 0.0_JPRB
    Z_DRADCL1__ = 0.0_JPRB
    IENT = JPGPT * (JLEV-1)

    IF (K_ICLDLYR(JLON,JLEV) == 1) THEN

      !  *** Cloudy layer
      ICLDDN = 1
        IF (ISTCLDD(JLON,JLEV)  ==  1) THEN
      DO JI = 1, JPGPT
        INDEX = IENT + JI
        !--DS            
        !            NBI = NGB(JI)
        Z_BGLAY = PFRAC(JLON,JI,JLEV) * Z_PLAY(JLON,NGB(JI),JLEV)
        !----            
        Z_DELBGUP     = Z_BGLEV(JI) - Z_BGLAY
        Z_BBU1(INDEX,JLON) = Z_BGLAY + P_TAUSF1(JLON,INDEX,1) * Z_DELBGUP
        !--DS            
        Z_BGLEV(JI) = PFRAC(JLON,JI,JLEV) * Z_PLVL(JLON,NGB(JI),JLEV-1)
        !----            
        Z_DELBGDN = Z_BGLEV(JI) - Z_BGLAY
        Z_BBD = Z_BGLAY + P_TAUSF1(JLON,INDEX,1) * Z_DELBGDN
        !- total-sky downward flux          
        Z_ODSM = P_OD(JI,JLEV,JLON) + Z_ODCLDNW(JI,JLEV)
        Z_FACTOT1 = Z_ODSM / (BPADE + Z_ODSM)
        Z_BBUTOT1(INDEX,JLON) = Z_BGLAY + Z_FACTOT1 * Z_DELBGUP
        Z_ATOT1(INDEX,JLON) = P_ABSS1(JLON,INDEX,1) + Z_ABSCLDNW(JI,JLEV)&
         & - P_ABSS1(JLON,INDEX,1) * Z_ABSCLDNW(JI,JLEV)  
        Z_BBDTOT = Z_BGLAY + Z_FACTOT1 * Z_DELBGDN
        Z_GASSRC = Z_BBD * P_ABSS1(JLON,INDEX,1)
        !***
          Z_CLDRADD(JI) = P_CLDFRAC(JLON,JLEV) * Z_RADLD1(JI,JLON)
          Z_CLRRADD(JI) = Z_RADLD1(JI,JLON) - Z_CLDRADD(JI)
          Z_OLDCLD(JI) = Z_CLDRADD(JI)
          Z_OLDCLR(JI) = Z_CLRRADD(JI)
          Z_RAD(JI) = 0.0_JPRB
        Z_TTOT = 1.0_JPRB - Z_ATOT1(INDEX,JLON)
        Z_CLDSRC = Z_BBDTOT * Z_ATOT1(INDEX,JLON)
      
        ! Separate RT equations for clear and cloudy streams      
        Z_CLDRADD(JI) = Z_CLDRADD(JI) * Z_TTOT + P_CLDFRAC(JLON,JLEV) * Z_CLDSRC
        Z_CLRRADD(JI) = Z_CLRRADD(JI) * (1.0_JPRB-P_ABSS1(JLON,INDEX,1)) +&
         & (1.0_JPRB - P_CLDFRAC(JLON,JLEV)) * Z_GASSRC  

        !  Total sky downward radiance
        Z_RADLD1(JI,JLON) = Z_CLDRADD(JI) + Z_CLRRADD(JI)
        Z_DRAD1__ = Z_DRAD1__ + Z_RADLD1(JI,JLON)
      
        !  Clear-sky downward radiance          
        Z_RADCLRD1(JI,JLON) = Z_RADCLRD1(JI,JLON)+(Z_BBD-Z_RADCLRD1(JI,JLON))*P_ABSS1(JLON,INDEX,1)
        Z_DRADCL1__ = Z_DRADCL1__ + Z_RADCLRD1(JI,JLON)

        !* Code to account for maximum/random overlap:
        !   Performs RT on the radiance most recently switched between clear and
        !   cloudy streams
        Z_RADMOD = Z_RAD(JI) * (Z_FACCLR1D(JLON,JLEV-1) * (1.0_JPRB-P_ABSS1(JLON,INDEX,1)) +&
         & Z_FACCLD1D(JLON,JLEV-1) *  Z_TTOT) - &
         & Z_FACCMB1D(JLON,JLEV-1) * Z_GASSRC + &
         & Z_FACCMB2D(JLON,JLEV-1) * Z_CLDSRC  
       
        !   Computes what the clear and cloudy streams would have been had no
        !   radiance been switched       
        Z_OLDCLD(JI) = Z_CLDRADD(JI) - Z_RADMOD
        Z_OLDCLR(JI) = Z_CLRRADD(JI) + Z_RADMOD
      
        !   Computes the radiance to be switched between clear and cloudy.      
        Z_RAD(JI) = -Z_RADMOD + Z_FACCLR2D(JLON,JLEV-1)*Z_OLDCLR(JI) -&
         & Z_FACCLD2D(JLON,JLEV-1)*Z_OLDCLD(JI)  
        Z_CLDRADD(JI) = Z_CLDRADD(JI) + Z_RAD(JI)
        Z_CLRRADD(JI) = Z_CLRRADD(JI) - Z_RAD(JI)
        !***

      ENDDO
        ELSE
      DO JI = 1, JPGPT
        INDEX = IENT + JI
        !--DS            
        !            NBI = NGB(JI)
        Z_BGLAY = PFRAC(JLON,JI,JLEV) * Z_PLAY(JLON,NGB(JI),JLEV)
        !----            
        Z_DELBGUP     = Z_BGLEV(JI) - Z_BGLAY
        Z_BBU1(INDEX,JLON) = Z_BGLAY + P_TAUSF1(JLON,INDEX,1) * Z_DELBGUP
        !--DS            
        Z_BGLEV(JI) = PFRAC(JLON,JI,JLEV) * Z_PLVL(JLON,NGB(JI),JLEV-1)
        !----            
        Z_DELBGDN = Z_BGLEV(JI) - Z_BGLAY
        Z_BBD = Z_BGLAY + P_TAUSF1(JLON,INDEX,1) * Z_DELBGDN
        !- total-sky downward flux          
        Z_ODSM = P_OD(JI,JLEV,JLON) + Z_ODCLDNW(JI,JLEV)
        Z_FACTOT1 = Z_ODSM / (BPADE + Z_ODSM)
        Z_BBUTOT1(INDEX,JLON) = Z_BGLAY + Z_FACTOT1 * Z_DELBGUP
        Z_ATOT1(INDEX,JLON) = P_ABSS1(JLON,INDEX,1) + Z_ABSCLDNW(JI,JLEV)&
         & - P_ABSS1(JLON,INDEX,1) * Z_ABSCLDNW(JI,JLEV)  
        Z_BBDTOT = Z_BGLAY + Z_FACTOT1 * Z_DELBGDN
        Z_GASSRC = Z_BBD * P_ABSS1(JLON,INDEX,1)
        !***
        Z_TTOT = 1.0_JPRB - Z_ATOT1(INDEX,JLON)
        Z_CLDSRC = Z_BBDTOT * Z_ATOT1(INDEX,JLON)
      
        ! Separate RT equations for clear and cloudy streams      
        Z_CLDRADD(JI) = Z_CLDRADD(JI) * Z_TTOT + P_CLDFRAC(JLON,JLEV) * Z_CLDSRC
        Z_CLRRADD(JI) = Z_CLRRADD(JI) * (1.0_JPRB-P_ABSS1(JLON,INDEX,1)) +&
         & (1.0_JPRB - P_CLDFRAC(JLON,JLEV)) * Z_GASSRC  

        !  Total sky downward radiance
        Z_RADLD1(JI,JLON) = Z_CLDRADD(JI) + Z_CLRRADD(JI)
        Z_DRAD1__ = Z_DRAD1__ + Z_RADLD1(JI,JLON)
      
        !  Clear-sky downward radiance          
        Z_RADCLRD1(JI,JLON) = Z_RADCLRD1(JI,JLON)+(Z_BBD-Z_RADCLRD1(JI,JLON))*P_ABSS1(JLON,INDEX,1)
        Z_DRADCL1__ = Z_DRADCL1__ + Z_RADCLRD1(JI,JLON)

        !* Code to account for maximum/random overlap:
        !   Performs RT on the radiance most recently switched between clear and
        !   cloudy streams
        Z_RADMOD = Z_RAD(JI) * (Z_FACCLR1D(JLON,JLEV-1) * (1.0_JPRB-P_ABSS1(JLON,INDEX,1)) +&
         & Z_FACCLD1D(JLON,JLEV-1) *  Z_TTOT) - &
         & Z_FACCMB1D(JLON,JLEV-1) * Z_GASSRC + &
         & Z_FACCMB2D(JLON,JLEV-1) * Z_CLDSRC  
       
        !   Computes what the clear and cloudy streams would have been had no
        !   radiance been switched       
        Z_OLDCLD(JI) = Z_CLDRADD(JI) - Z_RADMOD
        Z_OLDCLR(JI) = Z_CLRRADD(JI) + Z_RADMOD
      
        !   Computes the radiance to be switched between clear and cloudy.      
        Z_RAD(JI) = -Z_RADMOD + Z_FACCLR2D(JLON,JLEV-1)*Z_OLDCLR(JI) -&
         & Z_FACCLD2D(JLON,JLEV-1)*Z_OLDCLD(JI)  
        Z_CLDRADD(JI) = Z_CLDRADD(JI) + Z_RAD(JI)
        Z_CLRRADD(JI) = Z_CLRRADD(JI) - Z_RAD(JI)
        !***

      ENDDO

        ENDIF

    ELSE

      !  *** Clear layer
      !  *** DRAD1 holds summed radiance for total sky stream
      !  *** DRADCL1 holds summed radiance for clear sky stream

      IF (ICLDDN == 1) THEN
        DO JI = 1, JPGPT
          INDEX = IENT + JI
          !--DS         
          !           NBI = NGB(JI)
          Z_BGLAY = PFRAC(JLON,JI,JLEV) * Z_PLAY(JLON,NGB(JI),JLEV)
          !----            
          Z_DELBGUP     = Z_BGLEV(JI) - Z_BGLAY
          Z_BBU1(INDEX,JLON) = Z_BGLAY + P_TAUSF1(JLON,INDEX,1) * Z_DELBGUP
          !--DS            
          Z_BGLEV(JI) = PFRAC(JLON,JI,JLEV) * Z_PLVL(JLON,NGB(JI),JLEV-1)
          !----                      
          Z_DELBGDN = Z_BGLEV(JI) - Z_BGLAY
          Z_BBD = Z_BGLAY + P_TAUSF1(JLON,INDEX,1) * Z_DELBGDN
        
          !- total-sky downward radiance
          Z_RADLD1(JI,JLON) = Z_RADLD1(JI,JLON)+(Z_BBD-Z_RADLD1(JI,JLON))*P_ABSS1(JLON,INDEX,1)
          Z_DRAD1__ = Z_DRAD1__ + Z_RADLD1(JI,JLON)
        
          !- clear-sky downward radiance
          !-  Set clear sky stream to total sky stream as long as layers
          !-  remain clear.  Streams diverge when a cloud is reached.
          Z_RADCLRD1(JI,JLON) = Z_RADCLRD1(JI,JLON)+(Z_BBD-Z_RADCLRD1(JI,JLON))*P_ABSS1(JLON,INDEX,1)
          Z_DRADCL1__ = Z_DRADCL1__ + Z_RADCLRD1(JI,JLON)
        ENDDO
            
      ELSE
        
        DO JI = 1, JPGPT
          INDEX = IENT + JI
          !--DS         
          !           NBI = NGB(JI)
          Z_BGLAY = PFRAC(JLON,JI,JLEV) * Z_PLAY(JLON,NGB(JI),JLEV)
          !----            
          Z_DELBGUP     = Z_BGLEV(JI) - Z_BGLAY
          Z_BBU1(INDEX,JLON) = Z_BGLAY + P_TAUSF1(JLON,INDEX,1) * Z_DELBGUP
          !--DS            
          Z_BGLEV(JI) = PFRAC(JLON,JI,JLEV) * Z_PLVL(JLON,NGB(JI),JLEV-1)
          !----                      
          Z_DELBGDN = Z_BGLEV(JI) - Z_BGLAY
          Z_BBD = Z_BGLAY + P_TAUSF1(JLON,INDEX,1) * Z_DELBGDN
          !- total-sky downward flux          
          Z_RADLD1(JI,JLON) = Z_RADLD1(JI,JLON)+(Z_BBD-Z_RADLD1(JI,JLON))*P_ABSS1(JLON,INDEX,1)
          Z_DRAD1__ = Z_DRAD1__ + Z_RADLD1(JI,JLON)
          !- clear-sky downward flux          
          !-  Set clear sky stream to total sky stream as long as layers
          !-  remain clear.  Streams diverge when a cloud is reached.
          Z_RADCLRD1(JI,JLON) = Z_RADLD1(JI,JLON)
        ENDDO
        Z_DRADCL1__ = Z_DRAD1__
      ENDIF
    
    ENDIF

    P_TOTDFLUC(JLON,JLEV-1) = Z_DRADCL1__ * Z_WTNUM
    P_TOTDFLUX(JLON,JLEV-1) = Z_DRAD1__   * Z_WTNUM

  ENDDO
ENDDO


DO JLON = KIDIA, KFDIA
  Z_URAD1__(JLON) = 0.0_JPRB
  Z_URADCL1__(JLON) = 0.0_JPRB
ENDDO
!cdir novector
DO JLON = KIDIA, KFDIA
  DO JI = 1, JPGPT
    ! Spectral reflectivity and reflectance
    ! Includes the contribution of spectrally varying longwave emissivity 
    ! and reflection from the surface to the upward radiative transfer.
    ! Note: Spectral and Lambertian reflections are identical for the one
    ! angle flux integration used here.

    !- Lambertian reflection.
    ! Clear-sky radiance
    !    RADCLD = _TWO_ * (RADCLRD1(JI) * WTNUM(1) )
    Z_RADCLD = Z_RADCLRD1(JI,JLON)
    Z_RADCLRU1(JI,JLON) = Z_RADUEMIT(JI,JLON) + (1.0_JPRB - Z_SEMIS(JI,JLON)) * Z_RADCLD
    Z_URADCL1__(JLON) = Z_URADCL1__(JLON) + Z_RADCLRU1(JI,JLON)

    ! Total sky radiance
    !    RADD = _TWO_ * (RADLD1(JI) * WTNUM(1) )
    Z_RADD = Z_RADLD1(JI,JLON)
    Z_RADLU1(JI,JLON) = Z_RADUEMIT(JI,JLON) + (1.0_JPRB - Z_SEMIS(JI,JLON)) * Z_RADD
    Z_URAD1__(JLON) = Z_URAD1__(JLON)+ Z_RADLU1(JI,JLON)
  ENDDO
ENDDO
DO JLON = KIDIA, KFDIA
  P_TOTUFLUC(JLON,0) = Z_WTNUM * Z_URADCL1__(JLON)
  P_TOTUFLUX(JLON,0) = Z_WTNUM * Z_URAD1__(JLON)
ENDDO


  !ELSE
  !!- Specular reflection.
  !  DO JI = 1, JPGPT
  !    RADCLU = RADUEMIT(JI)
  !    RADCLRU1(JI) = RADCLU + (_ONE_ - SEMIS(JI)) * RADCLRD1(JI)
  !    URADCL1 = URADCL1 + RADCLRU1(JI)

  !    RADU = RADUEMIT(JI)
  !    RADLU1(JI) = RADU + (_ONE_ - SEMIS(JI)) * RADLD1(JI)
  !    URAD1 = URAD1 + RADLU1(JI)
  !  ENDDO
  !  TOTUFLUC(0) = URADCL1 * WTNUM(1)
  !  TOTUFLUX(0) = URAD1   * WTNUM(1)
  !ENDIF

  !- Upward radiative transfer.
  !- *** URAD1 holds the summed radiance for total sky stream
  !- *** URADCL1 holds the summed radiance for clear sky stream
DO JLON = KIDIA, KFDIA
  DO JLEV = 1, KLEV
    IENT = JPGPT * (JLEV-1)
      ! Check flag for cloud in current layer
      IF (K_ICLDLYR(JLON,JLEV) == 1) THEN

        IF (ISTCLD(JLON,JLEV)  ==  1) THEN
    DO JI = 1, JPGPT
      INDEX = IENT + JI
      !- *** Cloudy layer
        !- total-sky upward flux          
        Z_GASSRC = Z_BBU1(INDEX,JLON) * P_ABSS1(JLON,INDEX,1)

        !- If first cloudy layer in sequence, split up radiance into clear and
        !    cloudy streams depending on cloud fraction
          Z_CLDRADU(JI) = P_CLDFRAC(JLON,JLEV) * Z_RADLU1(JI,JLON)
          Z_CLRRADU(JI) = Z_RADLU1(JI,JLON) - Z_CLDRADU(JI)
          Z_OLDCLD(JI) = Z_CLDRADU(JI)
          Z_OLDCLR(JI) = Z_CLRRADU(JI)
          Z_RAD(JI) = 0.0_JPRB
        Z_TTOT = 1.0_JPRB - Z_ATOT1(INDEX,JLON)
        Z_TRNS = 1.0_JPRB - P_ABSS1(JLON,INDEX,1)
        Z_CLDSRC = Z_BBUTOT1(INDEX,JLON) * Z_ATOT1(INDEX,JLON)

        !- Separate RT equations for clear and cloudy streams      
        Z_CLDRADU(JI) = Z_CLDRADU(JI) * Z_TTOT + P_CLDFRAC(JLON,JLEV) * Z_CLDSRC
        Z_CLRRADU(JI) = Z_CLRRADU(JI) * Z_TRNS +(1.0_JPRB - P_CLDFRAC(JLON,JLEV)) * Z_GASSRC
        !***

        !- total sky upward flux
        Z_RADLU1(JI,JLON) = Z_CLDRADU(JI) + Z_CLRRADU(JI)
        Z_URAD1_(JLON,JLEV) = Z_URAD1_(JLON,JLEV) + Z_RADLU1(JI,JLON)
      
        !- clear-sky upward flux
        Z_RADCLRU1(JI,JLON) = Z_RADCLRU1(JI,JLON) + (Z_BBU1(INDEX,JLON)-Z_RADCLRU1(JI,JLON))&
         & *P_ABSS1(JLON,INDEX,1)  
        Z_URADCL1_(JLON,JLEV) = Z_URADCL1_(JLON,JLEV) + Z_RADCLRU1(JI,JLON)

        !* Code to account for maximum/random overlap:
        !   Performs RT on the radiance most recently switched between clear and
        !   cloudy streams
        Z_RADMOD = Z_RAD(JI) * (Z_FACCLR1(JLON,JLEV+1) * Z_TRNS +&
         & Z_FACCLD1(JLON,JLEV+1) *  Z_TTOT) - &
         & Z_FACCMB1(JLON,JLEV+1) * Z_GASSRC + &
         & Z_FACCMB2(JLON,JLEV+1) * Z_CLDSRC  
       
        !   Computes what the clear and cloudy streams would have been had no
        !   radiance been switched       
        Z_OLDCLD(JI) = Z_CLDRADU(JI) - Z_RADMOD
        Z_OLDCLR(JI) = Z_CLRRADU(JI) + Z_RADMOD
      
        !   Computes the radiance to be switched between clear and cloudy.      
        Z_RAD(JI) = -Z_RADMOD + Z_FACCLR2(JLON,JLEV+1)*Z_OLDCLR(JI) -&
         & Z_FACCLD2(JLON,JLEV+1)*Z_OLDCLD(JI)  
        Z_CLDRADU(JI) = Z_CLDRADU(JI) + Z_RAD(JI)
        Z_CLRRADU(JI) = Z_CLRRADU(JI) - Z_RAD(JI)
        !***

    ENDDO
      ELSE
    DO JI = 1, JPGPT
      INDEX = IENT + JI
      !- *** Cloudy layer
        !- total-sky upward flux          
        Z_GASSRC = Z_BBU1(INDEX,JLON) * P_ABSS1(JLON,INDEX,1)

        !- If first cloudy layer in sequence, split up radiance into clear and
        !    cloudy streams depending on cloud fraction
        Z_TTOT = 1.0_JPRB - Z_ATOT1(INDEX,JLON)
        Z_TRNS = 1.0_JPRB - P_ABSS1(JLON,INDEX,1)
        Z_CLDSRC = Z_BBUTOT1(INDEX,JLON) * Z_ATOT1(INDEX,JLON)

        !- Separate RT equations for clear and cloudy streams      
        Z_CLDRADU(JI) = Z_CLDRADU(JI) * Z_TTOT + P_CLDFRAC(JLON,JLEV) * Z_CLDSRC
        Z_CLRRADU(JI) = Z_CLRRADU(JI) * Z_TRNS +(1.0_JPRB - P_CLDFRAC(JLON,JLEV)) * Z_GASSRC
        !***

        !- total sky upward flux
        Z_RADLU1(JI,JLON) = Z_CLDRADU(JI) + Z_CLRRADU(JI)
        Z_URAD1_(JLON,JLEV) = Z_URAD1_(JLON,JLEV) + Z_RADLU1(JI,JLON)
      
        !- clear-sky upward flux
        Z_RADCLRU1(JI,JLON) = Z_RADCLRU1(JI,JLON) + (Z_BBU1(INDEX,JLON)-Z_RADCLRU1(JI,JLON))&
         & *P_ABSS1(JLON,INDEX,1)  
        Z_URADCL1_(JLON,JLEV) = Z_URADCL1_(JLON,JLEV) + Z_RADCLRU1(JI,JLON)

        !* Code to account for maximum/random overlap:
        !   Performs RT on the radiance most recently switched between clear and
        !   cloudy streams
        Z_RADMOD = Z_RAD(JI) * (Z_FACCLR1(JLON,JLEV+1) * Z_TRNS +&
         & Z_FACCLD1(JLON,JLEV+1) *  Z_TTOT) - &
         & Z_FACCMB1(JLON,JLEV+1) * Z_GASSRC + &
         & Z_FACCMB2(JLON,JLEV+1) * Z_CLDSRC  
       
        !   Computes what the clear and cloudy streams would have been had no
        !   radiance been switched       
        Z_OLDCLD(JI) = Z_CLDRADU(JI) - Z_RADMOD
        Z_OLDCLR(JI) = Z_CLRRADU(JI) + Z_RADMOD
      
        !   Computes the radiance to be switched between clear and cloudy.      
        Z_RAD(JI) = -Z_RADMOD + Z_FACCLR2(JLON,JLEV+1)*Z_OLDCLR(JI) -&
         & Z_FACCLD2(JLON,JLEV+1)*Z_OLDCLD(JI)  
        Z_CLDRADU(JI) = Z_CLDRADU(JI) + Z_RAD(JI)
        Z_CLRRADU(JI) = Z_CLRRADU(JI) - Z_RAD(JI)
        !***

    ENDDO
      ENDIF
      ELSE
    DO JI = 1, JPGPT
      INDEX = IENT + JI

        !- *** Clear layer
        !- total-sky upward flux          
        Z_RADLU1(JI,JLON) = &
       &Z_RADLU1(JI,JLON)+(Z_BBU1(INDEX,JLON)-Z_RADLU1(JI,JLON))*P_ABSS1(JLON,INDEX,1)
        Z_URAD1_(JLON,JLEV) = &
       &Z_URAD1_(JLON,JLEV) + Z_RADLU1(JI,JLON)
        !- clear-sky upward flux
        !   Upward clear and total sky streams must be separate because surface
        !   reflectance is different for each.
        Z_RADCLRU1(JI,JLON) = &
       &Z_RADCLRU1(JI,JLON)+(Z_BBU1(INDEX,JLON)-Z_RADCLRU1(JI,JLON))*P_ABSS1(JLON,INDEX,1)
        Z_URADCL1_(JLON,JLEV) = &
       &Z_URADCL1_(JLON,JLEV) + Z_RADCLRU1(JI,JLON)
  ENDDO
      ENDIF
    ENDDO
ENDDO

DO JLEV = 1, KLEV
  DO JLON = KIDIA, KFDIA
    P_TOTUFLUC(JLON,JLEV) = Z_WTNUM * Z_URADCL1_(JLON,JLEV)
    P_TOTUFLUX(JLON,JLEV) = Z_WTNUM * Z_URAD1_(JLON,JLEV)
  ENDDO
ENDDO

DEALLOCATE(Z_BBU1)
DEALLOCATE(Z_BBUTOT1)
DEALLOCATE(Z_ATOT1)

IF (LHOOK) CALL DR_HOOK('RRTM_RTRN1A_140GP',1,ZHOOK_HANDLE)
END SUBROUTINE RRTM_RTRN1A_140GP
