!OPTIONS XOPT(NOEVAL)
SUBROUTINE ACRADS ( KIDIA,KFDIA,KLON,KTDIA,KLEV,KJN,&
 !-----------------------------------------------------------------------
 ! - INPUT  2D .
 & PT,PAPRSF,PQ,PDELP,PRDELP,PFPLC,&
 ! - INPUT  1D .
 & PALB,PEMIS,PMU0,PTS,&
 ! - CONSTANTES.
 & PAC,PCOR,&
 & PRAB3C,PRAB3N,PRAB4C,PRAB4N,PRAB6C,PRAB6N,&
 & PRAT1C,PRAT1N,PRAT2C,PRAT2N,PRAT3C,PRAT3N,&
 & PRAT4C,PRAT4N,PRAT5C,PRAT5N,&
 ! - OUTPUT 2D .
 & PFRSO,PFRTH,&
 ! - LOCK ARGUMENTS .
 & CDLOCK)  

!**** *ACRADS * - COMPUTATION OF RADIATIVE FLUXES.

!     Subject.
!     --------
!     - ROUTINE FOR CALCULATION OF RADIATIVE FLUXES:
!         THERMAL RADIATION
!         SOLAR RADIATION

!**   Interface.
!     ----------
!        *CALL* *ACRADS*

! -   ARGUMENTS FOR INPUT
!     -------------------

! - DIMENSIONAL PARAMETERS OF PHYSICS

! KIDIA      : START OF HORIZONTAL LOOP (IST in CPG).
! KFDIA      : END OF HORIZONTAL LOOP (IEND in CPG).
! KLON       : HORIZONTAL DIMENSIONAL.
! KTDIA      : START OF THE VERTICAL LOOP IN THE PHYSIC (1 IN GENERAL).
! KLEV       : END OF VERTICAL LOOP AND VERTICAL DIMENSION "FULL LEVEL".
!              (NFLEVG in CPG).

! - THE NAME OF THE PHYSICAL VARIABLES

! - 2D (1:KLEV) .

! PT         : TEMPERATURE.
! PDELP      : LAYER THICKNESS IN PRESSURE UNITS.
! PRDELP     : INVERSE OF LAYER THICKNESS IN PRESSURE UNITS.
! PQ         : SPECIFIC HUMIDITY OF WATER VAPOR.
! PAPRSF     : PRESSURE ON FULL LEVELS.

! - 2D (0:KLEV) .

! PFPLC      : SUM OF CONVECTIVE PRECIPITATION AS RAIN AND AS SNOW.

! - 1D

! PTS        : SURFACE TEMPERATURE

! - 1D (DIAGNOSTIC) .

! PMU0       : LOCAL COSINE OF INSTANTENOUS SOLAR ZENITH ANGLE.
! PALB       : MODEL SURFACE SHORTWAVE ALBEDO.
! PEMIS      : MODEL SURFACE LONGWAVE EMISSIVITY.

! - CONSTANTES

! PAC        : COURTIS MATRIX FOR THERMAL RADIATION FOR CLEAR SKY
! PCOR       : CORRECTION FOR CLOUDINESS FOR THERMAL RADIATION

! PRAB3C     : CLEAR-SKY PARALLEL/DIFFUSE REFLECTIVITY.  ---
! PRAB4C     : CLEAR-SKY DIFFUSE TRANSMISSIVITY.            | equivalent
! PRAB6C     : CLEAR-SKY DIFFUSE REFLECTIVITY.              | coefficients
! PRAB3N     : CLOUDY PARALLEL/DIFFUSE REFLECTIVITY.        | from bottom
! PRAB4N     : CLOUDY DIFFUSE TRANSMISSIVITY.               | to given
! PRAB6N     : CLOUDY DIFFUSE REFLECTIVITY.              ---  level

! PRAT1C     : CLEAR-SKY PARALLEL TRANSMISSIVITY.        ---
! PRAT2C     : CLEAR-SKY PARALLEL/DIFFUSE TRANSMISSIVITY.   |
! PRAT3C     : CLEAR-SKY PARALLEL/DIFFUSE REFLECTIVITY.     |
! PRAT4C     : CLEAR-SKY DIFFUSE TRANSMISSIVITY.            | equivalent
! PRAT5C     : CLEAR-SKY DIFFUSE REFLECTIVITY.              | coefficients
! PRAT1N     : CLOUDY PARALLEL TRANSMISSIVITY.              | from top
! PRAT2N     : CLOUDY PARALLEL/DIFFUSE TRANSMISSIVITY.      | to given
! PRAT3N     : CLOUDY PARALLEL/DIFFUSE REFLECTIVITY.        | level
! PRAT4N     : CLOUDY DIFFUSE TRANSMISSIVITY.               |
! PRAT5N     : CLOUDY DIFFUSE REFLECTIVITY.              ---

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

! -   OUTPUT ARGUMENTS.
!     -----------------

! - 2D (0:KLEV) .

! PFRSO      : SHORTWAVE RADIATIVE FLUX.
! PFRTH      : LONGWAVE RADIATIVE FLUX.

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

! -   ARGUMENTS IMPLICITES.
!     ---------------------

! COMMON/YOMPHY /
! COMMON/YOMCST /
! COMMON/YOMPHY0/
! COMMON/YOMPHY3/
! COMMON/YOMGEM/
! COMMON/YOMSIMPHL/

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

!     Externals.
!     ----------

!     Method.
!     -------

!     Author.
!     -------
!        96-06, M. Janiskova

!     Modifications.
!     --------------
!        97-08, introduce CDLOCK - J.M. Piriou.
!        97-11, new cloudiness parametrization, correction of
!               computation B-matrix - M. Janiskova
!        98-01, code optimalization and cleaning - M. Janiskova
!        99-02, modifications in the thermal radiation due to mean
!               value of matrix PAC - M. Janiskova
!        M.Hamrud      01-Oct-2003 CY28 Cleaning

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

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

USE YOMPHY   , ONLY : LNEIGE
USE YOMCST   , ONLY : RSIGMA   ,RV       ,RCPV     ,&
 & RETV     ,RCW      ,RCS      ,RLVTT    ,RLSTT    ,&
 & RTT      ,RALPW    ,RBETW    ,RGAMW    ,RALPS    ,&
 & RBETS    ,RGAMS    ,RALPD    ,RBETD    ,RGAMD    ,&
 & RG  
USE YOMPHY0  , ONLY : NPCLO1   ,NPCLO2   ,HUCOE    ,HUTIL    ,&
 & QSNEBC   ,QSNEBS   ,QSSUSC   ,QSSUSS   ,QSUSXC   ,&
 & QSUSXS  
USE YOMPHY2  , ONLY : TSPHY
USE YOMPHY3  , ONLY : RII0
USE YOMGEM   , ONLY : VALH     ,VBH
USE YOMSIMPHL, ONLY : LCLOUDS

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KLON 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV 
INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KTDIA 
INTEGER(KIND=JPIM)               :: KJN ! Argument NOT used
REAL(KIND=JPRB)   ,INTENT(IN)    :: PT(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPRSF(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQ(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDELP(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRDELP(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PFPLC(KLON,0:KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PALB(KLON) 
REAL(KIND=JPRB)                  :: PEMIS(KLON) ! Argument NOT used
REAL(KIND=JPRB)   ,INTENT(IN)    :: PMU0(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTS(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAC(KLEV+1,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOR(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRAB3C(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRAB3N(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRAB4C(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRAB4N(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRAB6C(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRAB6N(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRAT1C(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRAT1N(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRAT2C(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRAT2N(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRAT3C(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRAT3N(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRAT4C(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRAT4N(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRAT5C(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRAT5N(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFRSO(KLON,0:KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFRTH(KLON,0:KLEV) 
CHARACTER(LEN=7)  ,INTENT(IN)    :: CDLOCK 
!     ------------------------------------------------------------------

REAL(KIND=JPRB) :: ZPAC(0:KLEV,0:KLEV)

REAL(KIND=JPRB) :: ZAB3(KLON,KLEV),ZAB4(KLON,KLEV),ZAB6(KLON,KLEV)&
 & ,ZAT1(KLON,KLEV),ZAT2(KLON,KLEV),ZAT3(KLON,KLEV)&
 & ,ZAT4(KLON,KLEV),ZAT5(KLON,KLEV)  

REAL(KIND=JPRB) :: ZNEBEQ(KLON,0:KLEV,0:KLEV),ZAN(KLON,0:KLEV,0:KLEV)
REAL(KIND=JPRB) :: ZBC(0:KLEV,0:KLEV)

REAL(KIND=JPRB) :: ZFLS(KLON,0:KLEV),ZFLF(KLON,0:KLEV)&
 & ,ZFLM(KLON,0:KLEV),ZZBB(KLON,0:KLEV),ZZNEB(KLON,0:KLEV)  
REAL(KIND=JPRB) :: ZNEB(KLON,KLEV),ZQSAT(KLON,KLEV),ZNBSB(KLON,KLEV),ZNBST(KLON,KLEV)
REAL(KIND=JPRB) :: ZHUC(KLEV)
REAL(KIND=JPRB) :: ZALP(KLON)
REAL(KIND=JPRB) :: ZSUM1(KLON),ZSUM2(KLON)&
 & ,ZZSUM(KLON),ZBX1(KLON),ZBX2(KLON),ZBX3(KLON)  
REAL(KIND=JPRB) :: ZVETAF(KLEV),ZVETAH(0:KLEV)

INTEGER(KIND=JPIM) :: I_KIFDIA(KJN),I_KIIDIA(KJN)

INTEGER(KIND=JPIM) :: IAUCR, JJ, JK, JLEV, JLON, JN

LOGICAL :: LLFDIA, LLIDIA

REAL(KIND=JPRB) :: ZALPHA, ZDELTA, ZEPS1, ZEPSNEB, ZESP1, ZEW1,&
 & ZNEBC, ZNEBS, ZQSC, ZQSS, ZSUM3, ZSUM4  
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"

#include"fcttrm.h"

!     CHECK RELIABILITY OF INPUT ARGUMENTS.

IF (LHOOK) CALL DR_HOOK('ACRADS',0,ZHOOK_HANDLE)
IF(CDLOCK /= 'ACRADS ') CALL ABOR1('BAD NUMBER OF ARGUMENTS!')

!*
!     ------------------------------------------------------------------
!     I. 1 - COMPUTATION OF DERIVED PARAMETERS, SECURITY CONSTANTS

ZEPS1=1.E-12_JPRB
ZEPSNEB=1.E-10_JPRB
ZALPHA=2.0_JPRB/3._JPRB

!*
!     -------------------------------------------------------------------
!     I. 2 - COMPUTATION OF SPECIFIC HUMIDITY OF SATURATION

! - TEMPORARY 2D.

! ZQSAT    : SPECIFIC HUMIDITY OF SATURATION

IF (LCLOUDS) THEN
  DO JLEV=KTDIA,KLEV
    DO JLON=KIDIA,KFDIA

!        SNOW OPTION DEPENDENT COMPUTATIONS.

      IF (LNEIGE) THEN
        ZDELTA=MAX(0.0_JPRB,SIGN(1.0_JPRB,RTT-PT(JLON,JLEV)))
      ELSE
        ZDELTA=0.0_JPRB
      ENDIF

!        COMPUTATION OF Qsat(PT)

      ZEW1= FOEW (PT(JLON,JLEV),ZDELTA)
      ZESP1=ZEW1/PAPRSF(JLON,JLEV)
      ZQSAT(JLON,JLEV)= FOQS (ZESP1)
    ENDDO
  ENDDO
ENDIF

!*
!     ------------------------------------------------------------------
!     II - COMPUTATION OF DAY/NIGHT LIMITS.

! - TEMPORARY(S) 1D .

! KIIDIA     : ARRAY OF INDICES OF BEGINNING OF "DAYLIGHT" INTERVALS.
! KIFDIA     : ARRAY OF INDICES OF END OF "DAYLIGHT" INTERVALS.

IAUCR=0
LLIDIA=PMU0(KIDIA) > 0.0_JPRB
LLFDIA=.FALSE.

IF (LLIDIA) THEN
  IAUCR=1
  I_KIIDIA(1)=KIDIA
ENDIF

!     NON VECTORIZED LOOP.

DO JLON=KIDIA,KFDIA
  LLFDIA=PMU0(JLON) > 0.0_JPRB

  IF (LLFDIA.NEQV.LLIDIA) THEN

    IF (LLFDIA) THEN
      IAUCR=IAUCR+1
      I_KIIDIA(IAUCR)=JLON
    ELSE
      I_KIFDIA(IAUCR)=JLON-1
    ENDIF

    LLIDIA=LLFDIA
  ENDIF

ENDDO

IF (LLFDIA) THEN
  I_KIFDIA(IAUCR)=KFDIA
ENDIF

!*
!     ------------------------------------------------------------------
!     III - COMPUTATION OF THE CLOUDINES OF EACH LAYER

! - TEMPORARY 2D

! ZNEB       : FRACTIONAL CLOUDINESS FOR RADIATION.

! - TEMPORARY 1D (KLEV)

! ZHUC       : CRITICAL MOISTURE FOR EACH LEVEL FOR ZNEB CALCULATION

IF (LCLOUDS) THEN

!        CRITICAL HUMIDITY

  ZVETAH(0)=VALH(0)+VBH(0)
  DO JLEV = KTDIA, KLEV
    ZVETAH(JLEV)=VALH(JLEV)+VBH(JLEV)
    ZVETAF(JLEV)=0.5_JPRB*(ZVETAH(JLEV)+ZVETAH(JLEV-1))
    ZHUC(JLEV)=1.0_JPRB-MAX( HUCOE*ZVETAF(JLEV)**NPCLO1*&
     & (1.0_JPRB-ZVETAF(JLEV))**NPCLO2*&
     & (1.0_JPRB+SQRT(HUTIL)*(ZVETAF(JLEV)-0.5_JPRB)),ZEPS1)  
  ENDDO

  DO JLEV=KTDIA,KLEV
    DO JLON=KIDIA,KFDIA

!           III. 1 - STRATIFORM PART
!                  ---------------

      ZQSS=QSSUSS*MAX(0.0_JPRB,PQ(JLON,JLEV)-ZHUC(JLEV)*ZQSAT(JLON,JLEV))
      ZQSS=QSUSXS*(1.0_JPRB-EXP(-ZQSS/QSUSXS))
      ZNEBS=MAX(ZEPSNEB,MIN(1.0_JPRB-ZEPSNEB,QSNEBS &
       & *SQRT(MAX(0.0_JPRB,ZQSS/ZQSAT(JLON,JLEV)))))  

!           III. 2 - CONVECTIVE PART
!                    ---------------

      ZQSC=MAX(0.0_JPRB,PFPLC(JLON,JLEV)-PFPLC(JLON,JLEV-1))&
       & *PRDELP(JLON,JLEV)*RG*QSSUSC*TSPHY  
      ZQSC=QSUSXC*(1.0_JPRB-EXP(-ZQSC/QSUSXC))
      ZNEBC=MAX(ZEPSNEB,MIN(1.0_JPRB-ZEPSNEB,QSNEBC*ZQSC))

!           III. 3 - TOTAL
!                    -----
      ZNEB(JLON,JLEV)=ZNEBS+(1.0_JPRB-ZNEBS)*ZNEBC
    ENDDO
  ENDDO
ELSE
  ZNEB(:,:)=0.0_JPRB
ENDIF

!*
!    -------------------------------------------------------------------
!     IV - COMPUTATION OF THERMAL RADIATION

!*
!    -------------------------------------------------------------------
!    IV. 1 - COMPUTATION OF EQUIVALENT CLOUDINESS FOR THERMAL
!            RADIATION

! - TEMPORARY(S) 3D (0:KLEV,0:KLEV)

!   ZNEBEQ    : EQUIVALENT CLOUDINESS FOR THERMAL RADIATION

IF (LCLOUDS) THEN
  DO JLON=KIDIA,KFDIA
    ZZNEB(JLON,KLEV)=0.0_JPRB
  ENDDO

  DO JLEV=KTDIA-1,KLEV-1
    DO JLON=KIDIA,KFDIA
      ZZNEB(JLON,JLEV)=ZNEB(JLON,JLEV+1)*PCOR(JLON,JLEV+1)
    ENDDO
  ENDDO

  DO JLEV=KTDIA-1,KLEV
    DO JLON=KIDIA,KFDIA
      ZSUM1(JLON)=1.0_JPRB-ZZNEB(JLON,JLEV)
      ZNEBEQ(JLON,JLEV,JLEV)=ZSUM1(JLON)
      ZSUM2(JLON)=1.0_JPRB-ZZNEB(JLON,JLEV)
    ENDDO

    DO JJ=JLEV+1,KLEV
      DO JLON=KIDIA,KFDIA
        ZSUM1(JLON)=ZSUM1(JLON)*(1.0_JPRB-ZZNEB(JLON,JJ))
        ZNEBEQ(JLON,JLEV,JJ)=ZSUM1(JLON)
      ENDDO
    ENDDO

    DO JJ=JLEV-1,KTDIA-1,-1
      DO JLON=KIDIA,KFDIA
        ZSUM2(JLON)=ZSUM2(JLON)*(1.0_JPRB-ZZNEB(JLON,JJ))
        ZNEBEQ(JLON,JLEV,JJ)=ZSUM2(JLON)
      ENDDO
    ENDDO
  ENDDO
ELSE
  ZZNEB(:,:)=0.0_JPRB
  ZNEBEQ(:,:,:)=1.0_JPRB
ENDIF

!*
!     -------------------------------------------------------------------
!     IV. 2 - COMPUTATION OF COEFFICIENTS OF MATRIX Bc

! - TEMPORARY(S) 2D (0:KLEV,0:KLEV)

! ZBC    : MATRIX Bc

ZBC(:,:)=0.0_JPRB

DO JJ=1,KLEV+1
  DO JK=1,KLEV+1
    ZPAC(JJ-1,JK-1)=PAC(JJ,JK)
  ENDDO
ENDDO

DO JLEV=KTDIA,KLEV
  ZSUM3=0.0_JPRB

  DO JJ=JLEV-1,KTDIA-1,-1
    ZSUM3=ZSUM3+ZPAC(JLEV,JJ)
    ZBC(JLEV,JJ)=1.0_JPRB-ZSUM3
  ENDDO
ENDDO

DO JLEV=KTDIA-1,KLEV
  ZSUM4=0.0_JPRB

  DO JJ=JLEV,KLEV
    ZSUM4=ZSUM4+ZPAC(JLEV,JJ)
    ZBC(JLEV,JJ)=-(1.0_JPRB+ZSUM4)
  ENDDO
ENDDO

!*
!     -------------------------------------------------------------------
!     IV. 3 - COMPUTATION OF COEFFICIENTS OF MATRIX An AS A FUNCTION
!             OF MATRIX Ac (FOR CLEAR AIR) AND CLOUDINESS

! - TEMPORARY(S) 3D (0:KLEV,0:KLEV)

! ZAN      : COURTIS MATRIX FOR THERMAL RADIATION FOR CLOUDY ATMOSPHERE

DO JLEV=KTDIA-1,KLEV
  DO JK=KTDIA-1,KLEV
    DO JLON=KIDIA,KFDIA
      ZAN(JLON,JLEV,JK)=ZNEBEQ(JLON,JLEV,JK)*(ZPAC(JLEV,JK)&
       & +ZZNEB(JLON,JK)*ZBC(JLEV,JK))  
    ENDDO
  ENDDO
ENDDO

!*
!     ------------------------------------------------------------------
!     IV. 4 - COMPUTATION OF THE BLACK-BODY FLUXES AT THE TOP OF LAYERS
!     (ASSUMED ISOTHERMAL) BLACK-BODY FLUXES ARE IN A (0:KLEV) ARRAY
!     SINCE THE SOIL IS CONSIDERED TO BE A LAYER OF INFINITE
!     OPTICAL DEPTH.

! - TEMPORARY(S) 2D (0:KLEV) .

! ZZBB      : BLACK-BODY FLUX AT THE TOP OF THE LAYERS.

!     BLACK-BODY FLUX.

DO JLEV=KTDIA,KLEV
  DO JLON=KIDIA,KFDIA
    ZZBB(JLON,JLEV-1)=RSIGMA*(PT(JLON,JLEV)*PT(JLON,JLEV))&
     & *(PT(JLON,JLEV)*PT(JLON,JLEV))  
  ENDDO
ENDDO
DO JLON=KIDIA,KFDIA
  ZZBB(JLON,KLEV)=RSIGMA*(PTS(JLON)*PTS(JLON))*(PTS(JLON)*PTS(JLON))
ENDDO

!*
!     ------------------------------------------------------------------
!     IV.5    COMPUTATION OF THE FINAL LONG-WAVE RADIATIVE FLUXES.

DO JLEV=KTDIA-1,KLEV
  DO JLON=KIDIA,KFDIA
    ZZSUM(JLON)=0.0_JPRB
  ENDDO

  DO JJ=KTDIA-1,KLEV
    DO JLON=KIDIA,KFDIA
      ZZSUM(JLON)=ZZSUM(JLON)+ZAN(JLON,JLEV,JJ)*ZZBB(JLON,JJ)
    ENDDO
  ENDDO

  DO JLON=KIDIA,KFDIA
    PFRTH(JLON,JLEV)=ZZSUM(JLON)
  ENDDO
ENDDO

!*
!     ------------------------------------------------------------------

!     V - COMPUTATION OF THE SOLAR ANGLE DEPENDENT ARRAYS AND OF THE
!     EFFECTIVE SURFACE ALBEDO.

!     INVERSE OF THE COSINE OF THE ZENITH ANGLE AND UPSCATTERED
!     FRACTIONS.

! - TEMPORARY(S) 1D .

! ZALP      : ALBEDO OF THE SURFACE FOR PARALLEL FLUX

DO JN=1,IAUCR
  DO JLON=I_KIIDIA(JN),I_KIFDIA(JN)
    ZALP(JLON)=(1.0_JPRB+0.5_JPRB*(PMU0(JLON)*(1.0_JPRB/PALB(JLON)-1.0_JPRB)))&
     & /(1.0_JPRB+(PMU0(JLON)*(1.0_JPRB/PALB(JLON)-1.0_JPRB)))**2  
  ENDDO
ENDDO

!*
!     ------------------------------------------------------------------
!     VI - SOLAR FLUXES' CALCULATION.

!*
!     -------------------------------------------------------------------
!     VI. 1 - COMPUTATION OF EQUIVALENT CLOUDINESS FOR SOLAR
!             RADIATION

! - TEMPORARY(S) 2D (1:KLEV)

!    ZNBST    : THE EQUIVALENT CLOUDINESS OF THE LAYERS 1,...,JK
!    ZNBSB    : THE EQUIVALENT CLOUDINESS OF THE LAYERS JK,...,NK

IF (LCLOUDS) THEN
  DO JLEV=KTDIA,KLEV
    DO JLON=KIDIA,KFDIA
      ZBX1(JLON)=1.0_JPRB-ZNEB(JLON,KTDIA)
      ZBX2(JLON)=ZNEB(JLON,KTDIA)*PDELP(JLON,KTDIA)
      ZBX3(JLON)=PDELP(JLON,KTDIA)
    ENDDO

    DO JJ=KTDIA+1,JLEV
      DO JLON=KIDIA,KFDIA
        ZBX1(JLON)=ZBX1(JLON)*(1.0_JPRB-ZNEB(JLON,JJ))
        ZBX2(JLON)=ZBX2(JLON)+ZNEB(JLON,JJ)*PDELP(JLON,JJ)
        ZBX3(JLON)=ZBX3(JLON)+PDELP(JLON,JJ)
      ENDDO
    ENDDO
    DO JLON=KIDIA,KFDIA
      ZNBST(JLON,JLEV)=ZALPHA*(1.0_JPRB-ZBX1(JLON))&
       & +(1.0_JPRB-ZALPHA)*ZBX2(JLON)/ZBX3(JLON)  
    ENDDO
  ENDDO

  DO JLEV=KTDIA,KLEV-1
    DO JLON=KIDIA,KFDIA
      ZBX1(JLON)=1.0_JPRB-ZNEB(JLON,JLEV+1)
      ZBX2(JLON)=ZNEB(JLON,JLEV+1)*PDELP(JLON,JLEV+1)
      ZBX3(JLON)=PDELP(JLON,JLEV+1)
    ENDDO

    DO JJ=JLEV+2,KLEV
      DO JLON=KIDIA,KFDIA
        ZBX1(JLON)=ZBX1(JLON)*(1.0_JPRB-ZNEB(JLON,JJ))
        ZBX2(JLON)=ZBX2(JLON)+ZNEB(JLON,JJ)*PDELP(JLON,JJ)
        ZBX3(JLON)=ZBX3(JLON)+PDELP(JLON,JJ)
      ENDDO
    ENDDO
    DO JLON=KIDIA,KFDIA
      ZNBSB(JLON,JLEV)=ZALPHA*(1.0_JPRB-ZBX1(JLON))&
       & +(1.0_JPRB-ZALPHA)*ZBX2(JLON)/ZBX3(JLON)  
    ENDDO
  ENDDO

  DO JLON=KIDIA,KFDIA
    ZNBSB(JLON,KLEV)=ZNEB(JLON,KLEV)
  ENDDO
ELSE
  ZNBST(:,:)=0.0_JPRB
  ZNBSB(:,:)=0.0_JPRB
ENDIF

!*
!     --------------------------------------------------------------------
!     VI. 2 - COMPUTATION OF EQUIVALENT COEFFICIENTS a1c,...,a6c (FOR
!             CLEAR AIR) AND a1n,...,a6n (FOR CLOUD ~ LIQUID WATER) AS
!             A FUNCTION OF CLOUDINESS

! - TEMPORARY(S) 2D (1:KLEV)
!                                            ---
! ZAB3     : PARALLEL/DIFFUSE REFLECTIVITY.     | equivalent coefficients
! ZAB4     : DIFFUSE TRANSMISSIVITY.            | from bottom
! ZAB6     : DIFFUSE REFLECTIVITY.           ---  to given level

! ZAT1     : PARALLEL TRANSMISSIVITY.        ---  equivalent
! ZAT2     : PARALLEL/DIFFUSE TRANSMISSIVITY.   | coefficients
! ZAT3     : PARALLEL/DIFFUSE REFLECTIVITY.     | from top
! ZAT4     : DIFFUSE TRANSMISSIVITY.            | to given
! ZAT5     : DIFFUSE REFLECTIVITY.           ---  level

DO JLEV=KTDIA,KLEV
  DO JLON=KIDIA,KFDIA

    ZAB3(JLON,JLEV)=(1.0_JPRB-ZNBSB(JLON,JLEV))*PRAB3C(JLON,JLEV)&
     & +ZNBSB(JLON,JLEV)*PRAB3N(JLON,JLEV)  
    ZAB4(JLON,JLEV)=(1.0_JPRB-ZNBSB(JLON,JLEV))*PRAB4C(JLON,JLEV)&
     & +ZNBSB(JLON,JLEV)*PRAB4N(JLON,JLEV)  
    ZAB6(JLON,JLEV)=(1.0_JPRB-ZNBSB(JLON,JLEV))*PRAB6C(JLON,JLEV)&
     & +ZNBSB(JLON,JLEV)*PRAB6N(JLON,JLEV)  

    ZAT1(JLON,JLEV)=(1.0_JPRB-ZNBST(JLON,JLEV))*PRAT1C(JLON,JLEV)&
     & +ZNBST(JLON,JLEV)*PRAT1N(JLON,JLEV)  
    ZAT2(JLON,JLEV)=(1.0_JPRB-ZNBST(JLON,JLEV))*PRAT2C(JLON,JLEV)&
     & +ZNBST(JLON,JLEV)*PRAT2N(JLON,JLEV)  
    ZAT3(JLON,JLEV)=(1.0_JPRB-ZNBST(JLON,JLEV))*PRAT3C(JLON,JLEV)&
     & +ZNBST(JLON,JLEV)*PRAT3N(JLON,JLEV)  
    ZAT4(JLON,JLEV)=(1.0_JPRB-ZNBST(JLON,JLEV))*PRAT4C(JLON,JLEV)&
     & +ZNBST(JLON,JLEV)*PRAT4N(JLON,JLEV)  
    ZAT5(JLON,JLEV)=(1.0_JPRB-ZNBST(JLON,JLEV))*PRAT5C(JLON,JLEV)&
     & +ZNBST(JLON,JLEV)*PRAT5N(JLON,JLEV)  
  ENDDO
ENDDO

!*
!    --------------------------------------------------------------------
!     VI. 3 - TOP OF THE ATMOSPHERE.

! - TEMPORARY(S) 2D (0:KLEV)

!    ZFLS   : DIRECT SOLAR FLUX
!    ZFLF   : DIFFUSE DOWNWARD FLUX
!    ZFLM   : DIFFUSE UPWARD FLUX

DO JN=1,IAUCR
  DO JLON=I_KIIDIA(JN),I_KIFDIA(JN)
    ZFLS(JLON,KTDIA-1)=RII0*PMU0(JLON)
    ZFLF(JLON,KTDIA-1)=0.0_JPRB

  ENDDO
ENDDO

!     -------------------------------------------------------------------
!     VI.4   SURFACE TREATMENT AND DIFFUSE UPWARD FLUX AT THE TOP
!             OF ATMOSPHERE

DO JN=1,IAUCR
  DO JLON=I_KIIDIA(JN),I_KIFDIA(JN)
    ZFLS(JLON,KLEV)=ZAT1(JLON,KLEV)*ZFLS(JLON,KTDIA-1)
    ZFLF(JLON,KLEV)=(ZAT2(JLON,KLEV)+ZAT5(JLON,KLEV)&
     & *ZAT1(JLON,KLEV)*PALB(JLON))*ZFLS(JLON,KTDIA-1)&
     & /(1.0_JPRB-ZAT5(JLON,KLEV)*ZALP(JLON))  
    ZFLM(JLON,KLEV)=PALB(JLON)*ZFLS(JLON,KLEV)+ZALP(JLON)*ZFLF(JLON,KLEV)

    ZFLM(JLON,KTDIA-1)=ZAT3(JLON,KLEV)*ZFLS(JLON,KTDIA-1)&
     & +ZAT4(JLON,KLEV)*ZFLM(JLON,KLEV)  
  ENDDO
ENDDO

!*
!     --------------------------------------------------------------------
!     VI.5   LOOP OVER THE LAYERS

DO JLEV=KTDIA,KLEV-1
  DO JN=1,IAUCR
    DO JLON=I_KIIDIA(JN),I_KIFDIA(JN)

      ZFLS(JLON,JLEV)=ZAT1(JLON,JLEV)*ZFLS(JLON,KTDIA-1)
      ZFLM(JLON,JLEV)=((ZAB3(JLON,JLEV)*ZAT1(JLON,JLEV)&
       & +ZAB6(JLON,JLEV)*ZAT2(JLON,JLEV))&
       & *ZFLS(JLON,KTDIA-1)&
       & +ZAB4(JLON,JLEV)*ZFLM(JLON,KLEV))&
       & /(1.0_JPRB-ZAB6(JLON,JLEV)*ZAT5(JLON,JLEV))  
      ZFLF(JLON,JLEV)=ZAT2(JLON,JLEV)*ZFLS(JLON,KTDIA-1)&
       & +ZAT5(JLON,JLEV)*ZFLM(JLON,JLEV)  

    ENDDO
  ENDDO
ENDDO

!*
!     --------------------------------------------------------------------
!     VI.6   FINAL COMPUTATIONS OF SHORTWAVE RADIATIVE FLUX.

DO JLEV=KTDIA-1,KLEV
  DO JN=1,IAUCR
    DO JLON=I_KIIDIA(JN),I_KIFDIA(JN)
      PFRSO(JLON,JLEV)=ZFLS(JLON,JLEV)+ZFLF(JLON,JLEV)-ZFLM(JLON,JLEV)
    ENDDO
  ENDDO
ENDDO

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