SUBROUTINE RADPAR &
 & ( KIDIA,  KFDIA,  KLON,   KLEVS,  KSTGLO,&
 & KTDIA,  KLEV,   KSTART, KSTEP,&
 !-----------------------------------------------------------------------
 ! - INPUT .
 & PAPRS,  PAPRSF, PT,     PQ  ,  PU    , PV,&
 & PL,     PI,     PA,&
 & PSNS,   PRSN,&
 & PTL,    PWL,    PWSA,   PVERVEL,&
 & PALBF,  &
 & PALUVP, PALUVD, PALNIP, PALNID, & 
 & PASN,   PEMISF, PLSM   ,&
 & PMU0M,  PGEMU,  PGZ0MCL,&
 & PTVL,   PTVH,   PCVL,   PCVH ,&
 & PLAILC, PLAIHC, PSOTY, PSOALUVP, PSOALUVD, PSOALNIP, PSOALNID,&
 & PHSTD,  PCI, PLIT, &
! & PAEROI,&
 & KLEVX,  KFLDX,  KFLDX2, &
 & PEXTRA, PEXTR2, &
 ! - UPDATED
 & PNTOP,  PNBAS,  PACPR,&
 ! - OUTPUT .
 & LDLAND, PALBD,  PALBP,  PCCNL,  PCCNO,&
 & PNEB,   PQICE,  PQLI,   PQSAT,&
 & PCCC,   PHCC,   PLCC,   PMCC,   PTCC,   PEMIR, PEMIW, PEMIT,&
 & PGZ0M  &
 & )
! &,PAERO )  

!**** *RADPAR * - CALL ECMWF PHYSICS (TO SUPPORT RADINT)

!     PURPOSE.
!     --------
!     - CALL THE SUBROUTINES OF THE E.C.M.W.F. PHYSICS PACKAGE,
!       THAT ARE NECESSARY TO SUPPORT THE CALL TO RADINT

!**   Interface.
!     ----------
!        *CALL* *RADPAR*

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

! -   INPUT ARGUMENTS.
!     -------------------

! - DIMENSIONS ETC.

! KIDIA   : START OF HORIZONTAL LOOP  
! KFDIA   : START OF HORIZONTAL LOOP  
! KLON    : HORIZONTAL DIMENSION                  
! KLEVS   : NUMBER OF LEVELS IN SOIL 
! KTDIA   : START OF THE VERTICAL LOOP IN THE PHYSICS
!            (IF SOME LEVELS ARE SKIPPED AT THE TOP OF THE MODEL).
! KLEV    : END OF VERTICAL LOOP AND VERTICAL DIMENSION
! KSTART  : FIRST STEP OF MODEL
! KSTEP   : CURRENT TIME STEP

! - 2D (0:KLEV) .

! PAPRS      : PRESSURE ON HALF-LEVELS.

! - 2D (1:KLEV) .

! PAPRSF     : PRESSURE ON FULL LEVELS.
! PT         : TEMPERATURE.
! PQ         : SPECIFIC HUMIDITY OF WATER VAPOUR.
! PU         : ZONAL WIND
! PV         : MERIDIONAL WIND
! PL         : CLOUD WATER
! PI         : CLOUD ICE WATER
! PA         : CLOUD FRACTION
! PVERVEL    : VERTICAL VELOCITY

! - 1D (PROGNOSTIC QUANTITIES) .

! PSNS       : MASS OF SNOW PER UNIT SURFACE
! PRSN       : DENSITY OF SNOW
! PWSA       : MULTI-LAYER SOIL WETMESS
! PTL        : SKIN (BRIGHTNESS) TEMPERATURE
! PWL        : INTERCEPTION RESERVOIR CONTENT

! - 1D (GEOGRAPHICAL DISTRIBUTION) .

! PALBF      : BACKGROUND SURFACE SHORTWAVE ALBEDO (SNOW-FREE).
! PALUVP     : BACKGROUND SURF.ALB.UV-VIS.PARALLEL RADIATION
! PALUVD     : BACKGROUND SURF.ALB.UV-VIS. DIFFUSE RADIATION
! PALNIP     : BACKGROUND SURF.ALB.N-IR. PARALLEL RADIATION
! PALNID     : BACKGROUND SURF.ALB.N-IR. DIFFUSE RADIATION
! PASN       : SNOW ALBEDO
! PEMISF     : BACKGROUND SURFACE LONGWAVE EMISSIVITY (SNOW-FREE).
! PLSM       : LAND/SEA MASK.
! PMU0M      : LOCAL COSINE OF INSTANTANEOUS MEAN SOLAR ZENITH ANGLE.
! PGEMU      : SINE OF LATITUDE
! PGZ0MCL    : GRAVITY * ROUGHNESS LENGTH
! PTVH       : HIGH VEGETATION DOMINANT TYPE
! PTVL       : LOW VEGETATION DOMINANT TYPE
! PCVH       : HIGH VEGETATION COVER
! PCVL       : LOW VEGETATION COVER
! PLAIL*        LOW VEGETATION LAI                           m2/m2
! PLAIH*        HIGH VEGETATION LAI                          m2/m2
! PSOTY      : SOIL TYPE
! PSOALUVP    : SOIL ALBEDO VIS/UV DIRECT
! PSOALUVD    : SOIL ALBEDO VIS/UV DIFFUSE
! PSOALNIP    : SOIL ALBEDO NIR DIRECT
! PSOALNID    : SOIL ALBEDO NIR DIFFUSE
! PHSTD      : STANDARD DEVIATION OF OROGRAPHY (*RG)
! PCI        : SEA-ICE FRACTION
!-----------------------------------------------------------------------

! -   UPDATED ARGUMENTS.
!     --------------------

! - 2D (1:KLEV) .

! PTENV      : DYNAMICAL TENDENCY OF V-COMP. OF WIND.
! PNTOP      : CONVECTIVE CLOUD TOP INDEX (TO BE CONVERTED TO INTEGER)
! PNBAS      : CONVECTIVE CLOUD BASE INDEX (TO BE CONVERTED TO INTEGER)
! PACPR      : CONVECTIVE RAINFALL ACCUMULATED BETWEEN TWO
!              (FULL) RADIATION TIME STEPS
!-----------------------------------------------------------------------

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

! - 1D (DIAGNOSTIC) .

! PEMIR      : MODEL SURFACE LONGWAVE OUTSIDE WINDOW EMISSIVITY.
! PEMIW      : MODEL SURFACE LONGWAVE WINDOW EMISSIVITY.
! PEMIT      : MODEL SURFACE LONGWAVE EMISSIVITY.
! PCCC       : CONVECTIVE CLOUD COVER
! PLCC       : LOW CLOUD COVER
! PMCC       : MEDIUM CLOUD COVER
! PHCC       : HIGH CLOUD COVER
! PTCC       : TOTAL CLOUD COVER

! - 2D (1:KLEV) .

! PNEB       : FRACTIONAL CLOUDINESS FOR RADIATION.
! PQICE      : SPECIFIC HUMIDITY OF SOLID WATER FOR RADIATION.
! PQLI       : SPECIFIC HUMIDITY OF LIQUID WATER FOR RADIATION.
! PQSAT      : SPECIFIC HUMIDITY AT SATURATION.

! - 1D (GEOGRAPHICAL DISTRIBUTION) .

! PGZ0M      : GRAVITY * ROUGHNESS LENGTH

! - 2D (DIAGNOSTIC) .

! PALBD      : DIFFUSE ALBEDO IN THE NTSW SW INTERVALS
! PALBP      : PARALLEL ALBEDO IN THE NTSW SW INTERVALS
! PCCNL      : CCN CONCENTRATION OVER LAND
! PCCNO      : CCN CONCENTRATION OVER OCEAN 

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

!     Externals.  SURFRAD-
!     ---------   SATUR  -
!                 CLOUD  -
!                 RADINT -

!     Method. See documentaion.
!     -------
!     Modifications.
!     --------------
!     ORIGINAL 94-12-5 G.MOZDZYNSKI (BASED ON CALLPAR)
!     Modified 99-03-26 P Viterbo: Tiling of the land-surface
!              01-10-15 JJMorcrette: CCNs
!              03-05    M.Janiskova: call for stat.cloud scheme
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        P.Viterbo     24-05-2004   Change surface units
!        JJMorcrette 20060625 MODIS albedo
!        G. Balsamo  20070115 Soil type
!        G. Balsamo  20080418 Lake tile
!        S. Boussetta/G.Balsamo   May 2009   (Add variable LAI)
!-----------------------------------------------------------------------
!     ******************************************************************
!     ****** IDIOSYNCRASIES *** IDIOSYNCRASIES *** IDIOSYNCRASIES ******
!     ******************************************************************
!     ***  HEALTH WARNING:                                           ***
!     ***  ===============                                           ***
!     ***  NOTE THAT WITHIN THE E.C.M.W.F. PHYSICS HALF-LEVELS       ***
!     ***  ARE INDEXED FROM 1 TO NFLEVG+1 WHILE THEY ARE BETWEEN     ***
!     ***  0 AND NFLEVG IN THE REST OF THE MODEL. THE CHANGE IS TAKEN***
!     ***  CARE OF IN THE CALL TO THE VARIOUS SUBROUTINES OF THE     ***
!     ***  PHYSICS PACKAGE                                           ***
!     ***                                                            ***
!     ***    THIS IS SUPPOSED TO BE A "TEMPORARY" FEATURE TO BE      ***
!     ***    STRAIGHTENED OUT IN THE "NEAR" FUTURE                   ***
!     ******************************************************************
!     ******************************************************************

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

USE YOMDPHY  , ONLY : NTILES
USE YOEPHY   , ONLY : LEDCLD   ,LERADS   ,LEPCLD
USE YOERAD   , ONLY : NSW      ,NTSW     ,RCCNLND  ,RCCNSEA  ,NRADPFR
USE YOMCST   , ONLY : RG       ,RLVTT    ,RLSTT    ,RTT  ,RDAY
USE YOETHF   , ONLY : R2ES     ,R3LES    ,R3IES    ,R4LES    ,&
 & R4IES    ,R5LES    ,R5IES    ,R5ALVCP  ,R5ALSCP  ,&
 & RALVDCP  ,RALSDCP  ,RTWAT    ,RTICE    ,RTICECU  ,&
 & RTWAT_RTICE_R      ,RTWAT_RTICECU_R  
USE YOPHNC   , ONLY : LENCLD2
USE YOMNCL   , ONLY : LNCLIN
USE YOMRIP   , ONLY : NINDAT   ,NSSSSS   ,RSTATI
USE YOMECEARTH , ONLY : LECEARTH, LECEARTH_UNCOUP, LLPJGFB

USE CPLNG

IMPLICIT NONE

INTERFACE
#include "surfrad.h"
#include "surfbc.h"
END INTERFACE

#include "cldpp.intfb.h"
#include "cloud.intfb.h"
#include "satur.intfb.h"
#include "updcal.intfb.h"

INTEGER(KIND=JPIM),INTENT(IN)    :: KLON 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLEVS 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV 
INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSTGLO 
INTEGER(KIND=JPIM),INTENT(IN)    :: KTDIA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSTART 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSTEP 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPRS(KLON,0:KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPRSF(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PT(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQ(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PU(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PV(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PL(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PI(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PA(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSNS(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRSN(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTL(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PWL(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PWSA(KLON,KLEVS) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PVERVEL(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT)    :: PALBF(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT)    :: PALUVP(KLON), PALUVD(KLON), PALNIP(KLON), PALNID(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PASN(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PEMISF(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLSM(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PMU0M(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGEMU(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGZ0MCL(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTVH(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTVL(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCVH(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCVL(KLON)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLAILC(KLON)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLAIHC(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSOTY(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSOALUVP(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSOALUVD(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSOALNIP(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSOALNID(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PHSTD(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCI(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLIT(KLON)
!>>dod
INTEGER(KIND=JPIM),INTENT(IN)    :: KLEVX 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFLDX 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFLDX2 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PEXTRA(KLON,KLEVX,KFLDX) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PEXTR2(KLON,KFLDX2) 
!<<dod
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PNTOP(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PNBAS(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PACPR(KLON) 
LOGICAL           ,INTENT(OUT)   :: LDLAND(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PALBD(KLON,NTSW) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PALBP(KLON,NTSW) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCCNL(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCCNO(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PNEB(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PQICE(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PQLI(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PQSAT(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCCC(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PHCC(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PLCC(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PMCC(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTCC(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PEMIR(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PEMIW(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PEMIT(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PGZ0M(KLON) 
!*
!     ------------------------------------------------------------------

!            0.2  LOCAL ARRAYS FOR ECMWF PHYSICS PACKAGE
!                 --------------------------------------

INTEGER(KIND=JPIM) :: ITOPC(KLON), IBASC(KLON)
INTEGER(KIND=JPIM) :: ITVH(KLON),ITVL(KLON),ISOTY(KLON)
INTEGER(KIND=JPIM) :: ID0, IM0, IY0, IDINCR,ISEC,IDD,IMM,IYY,ILMON(12)

LOGICAL :: LLSICE(KLON),LLNH(KLON)
LOGICAL :: LLLAKE(KLON)
LOGICAL :: LLOCN_KPP(KLON)

REAL(KIND=JPRB) :: ZSNM1M(KLON),ZRSNM1M(KLON),ZAZ0M(KLON),ZWLM1M(KLON)
REAL(KIND=JPRB) :: ZHSTD(KLON),ZWLMX(KLON),ZALB(KLON),ZWND(KLON)
REAL(KIND=JPRB) :: ZFRTI(KLON,NTILES),ZCVH(KLON),ZCVL(KLON)
REAL(KIND=JPRB) :: ZALBTI(KLON,NTILES)

!    Local arrays for variable LAI
REAL(KIND=JPRB) :: ZLAIL(KLON),ZLAIH(KLON)

!    Local arrays for new cloud scheme of the linearized model

REAL(KIND=JPRB) :: ZPA(KLON,KLEV)
REAL(KIND=JPRB) :: ZPL(KLON,KLEV)
REAL(KIND=JPRB) :: ZPI(KLON,KLEV)

! FLAKE: Lake model (Local for PASSIVE introduction)
REAL(KIND=JPRB) :: ZCLAKE(KLON)
REAL(KIND=JPRB) :: ZHLICE(KLON)
REAL(KIND=JPRB) :: ZTLICE(KLON)

REAL(KIND=JPRB) :: ZALBICE(KLON)

INTEGER(KIND=JPIM) :: IFLAG, JK, JL, JSW, IBLK

LOGICAL :: LLCLDCOVER

REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

#include "fcttre.h"
#include "fcttim.h"
! #include "icestateoasis3.intfb.h"
!     ------------------------------------------------------------------

!*       1.1   FIRST TIME-STEP

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

! Initialize Ocean and Lake variable for passive introduction  
LLOCN_KPP(:)=.FALSE.
LLLAKE(:)=.FALSE.
ZCLAKE(:)=0.0_JPRB
ZHLICE(:)=0.0_JPRB
ZTLICE(:)=0.0_JPRB

IF (KSTEP == KSTART) THEN
  PNTOP(KIDIA:KFDIA) = 1.0_JPRB
  PNBAS(KIDIA:KFDIA) = 1.0_JPRB
  PACPR(KIDIA:KFDIA) = 0.0_JPRB
  PGZ0M(KIDIA:KFDIA)=PGZ0MCL(KIDIA:KFDIA)
ENDIF

!*       1.2   CHANGE UNITS/SCALINGS
DO JL=KIDIA,KFDIA
  IF (PLSM(JL) > 0.5_JPRB) THEN
    ZHSTD (JL) = PHSTD(JL) /RG 
  ELSE
    ZHSTD (JL) = 0._JPRB
  ENDIF
ENDDO
ZAZ0M(KIDIA:KFDIA)  = PGZ0M(KIDIA:KFDIA) /RG
ZSNM1M(KIDIA:KFDIA) = PSNS(KIDIA:KFDIA)
ZWLM1M(KIDIA:KFDIA) = PWL (KIDIA:KFDIA)
ZRSNM1M(KIDIA:KFDIA) = PRSN(KIDIA:KFDIA)

!*      1.3   GLOBAL AUXILLIARY VARAIBLES

!*      1.3a   AUXILLIARY VARIABLES FOR VDF, SRF AND SURFRAD

IF (.NOT.LLPJGFB) THEN
  ! Populate these arrays with fixed inputs before they're updated in SURFBC
  ! if LPJ-GUESS is not coupled
  ! ZCVL/ZCVH are updated using the fixed cover fraction modifier or LAI (Beer's
  ! Law)
  ! ZLAIL/ZLAIH are updated using using either fixed look-up table values or
  ! satellite values (LEVLAI)
  DO JL=KIDIA,KFDIA
    ZCVL(JL)=PCVL(JL)
    ZCVH(JL)=PCVH(JL)
    ZLAIL(JL)=PLAILC(JL)
    ZLAIH(JL)=PLAIHC(JL)
  ENDDO
ENDIF

CALL SURFBC (KIDIA=KIDIA,KFDIA=KFDIA,KLON=KLON,KTILES=NTILES,&
 & PTVL=PTVL,PTVH=PTVH,PSOTY=PSOTY,&
 & PSOALUVP=PSOALUVP,PSOALUVD=PSOALUVD,PSOALNIP=PSOALNIP,PSOALNID=PSOALNID,&
 & PSDOR=ZHSTD,PCVLC=PCVL,PCVHC=PCVH,&
 & PLAILC=PLAILC,PLAIHC=PLAIHC,&
 & PLSM=PLSM,PCI=PCI,PCLAKE=ZCLAKE,PHLICE=ZHLICE,&
 & PGEMU=PGEMU,PSNM1M=ZSNM1M,PWLM1M=ZWLM1M,PRSNM1M=ZRSNM1M,&
 & LDLAND=LDLAND,LDSICE=LLSICE,LDLAKE=LLLAKE,LDNH=LLNH,LDOCN_KPP=LLOCN_KPP,&
 & KTVL=ITVL,KTVH=ITVH,KSOTY=ISOTY,&
 & PCVL=ZCVL,PCVH=ZCVH,PLAIL=ZLAIL,PLAIH=ZLAIH,&
 & PWLMX=ZWLMX,PFRTI=ZFRTI,&
 & PALBF=PALBF,PALUVP=PALUVP,PALUVD=PALUVD,PALNIP=PALNIP,PALNID=PALNID)


DO JL=KIDIA,KFDIA
  ITOPC(JL) = INT(PNTOP(JL)+0.01_JPRB)
  IBASC(JL) = INT(PNBAS(JL)+0.01_JPRB)
ENDDO

! Sea-ice variables for EC-Earth
IF (LECEARTH .AND. .NOT.LECEARTH_UNCOUP) THEN
  DO JL=KIDIA,KFDIA
    ZALBICE(JL) = CPLNG_FLD(CPLNG_IDX('A_Ice_albedo'))%D(KSTGLO+JL-1,1,1)
  ENDDO
ENDIF

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

!*         2.     RADIATION TRANSFER
!                 ------------------

!*         2.2 SURFACE BOUNDARY CONDITIONS

IF (LERADS) THEN
    
  DO JL=KIDIA,KFDIA
    ZWND(JL)=SQRT(PU(JL,KLEV)*PU(JL,KLEV)+PV(JL,KLEV)*PV(JL,KLEV))
  ENDDO  

  IY0=NCCAA(NINDAT)
  IM0=NMM(NINDAT)
  ID0=NDD(NINDAT)
  IDINCR=(NSSSSS+NINT(RSTATI,JPIB))/NINT(RDAY)
  ISEC=MOD(NSSSSS+NINT(RSTATI,JPIB),NINT(RDAY))
  CALL UPDCAL(ID0,IM0,IY0,IDINCR,IDD,IMM,IYY,ILMON,-1)

  CALL SURFRAD(KDD=IDD,KMM=IMM,KMON=ILMON,KSECO=ISEC,&
   & KIDIA=KIDIA,KFDIA=KFDIA,KLON=KLON,KTILES=NTILES,KSW=NSW,&
   & LDNH=LLNH,&
   & PALBF=PALBF,PALBICEF=ZALBICE,PTVH=PTVH,&
   & PALUVP=PALUVP,PALUVD=PALUVD,PALNIP=PALNIP,PALNID=PALNID,&
   & PASN=PASN,PMU0=PMU0M,PTS=PTL,PWND=ZWND,&
   & PWS1=PWSA(:,1),KSOTY=ISOTY,PLIT=PLIT,PFRTI=ZFRTI,PHLICE=ZHLICE,PTLICE=ZTLICE,&
   & PALBD=PALBD(:,1:NSW),PALBP=PALBP(:,1:NSW),PALB=ZALB,&
   & PEMIR=PEMIR,PEMIW=PEMIW,PEMIT=PEMIT,&
   & PALBTI=ZALBTI,PCCNL=PCCNL,PCCNO=PCCNO )


  DO JSW=NSW+1,NTSW
    PALBD(KIDIA:KFDIA,JSW)=PALBF(KIDIA:KFDIA)
    PALBP(KIDIA:KFDIA,JSW)=PALBF(KIDIA:KFDIA)
  ENDDO
ELSE
  DO JSW=1,NTSW
    DO JL=KIDIA,KFDIA
      PALBD(JL,JSW)=PALBF(JL)
      PALBP(JL,JSW)=PALBF(JL)
    ENDDO
  ENDDO

  DO JL=KIDIA,KFDIA
    PEMIR(JL) = PEMISF(JL)
    PEMIW(JL) = PEMISF(JL)
    PEMIT(JL) = PEMISF(JL)
    PCCNL(JL) = RCCNLND
    PCCNO(JL) = RCCNSEA
  ENDDO
ENDIF

!*         2.3 CLOUD 

IFLAG=2
CALL SATUR  (KIDIA , KFDIA , KLON  , KTDIA , KLEV,&
 & PAPRSF, PT    , PQSAT , IFLAG)  

LLCLDCOVER=(NRADPFR /= 0)
IF (LEDCLD) THEN
  IF(LEPCLD) THEN
    ! This call could probably be removed in the future, as PCCC etc.
    ! are only used for some diagnostic prints from the radiation scheme
    CALL  CLDPP &
     & ( KIDIA , KFDIA , KLON   , KLEV,&
     & PAPRS , PAPRSF, PA    , PL     , PI    , PT,&
! Following line should be PGELAT,PGELAM, but not available in this 
! routine and make little difference to the random number generator. 
     & PGEMU, PGEMU,&
     & LLCLDCOVER  , PCCC  , PHCC  , PLCC   , PMCC  , PTCC,&
     & PNEB  , PQICE , PQLI )  
!or  ELSEIF (LENCLD2) THEN
! preliminar modification before prognostic scheme is again called
! during NL computation of 4D-Var
  ELSEIF (LENCLD2 .AND. (LNCLIN .OR. (KSTEP /= KSTART))) THEN
    IBLK=(KSTGLO-1)/KLON + 1
    DO JK=1,KLEV
      DO JL=KIDIA,KFDIA
        ZPA(JL,JK) = PA(JL,JK)
        ZPL(JL,JK) = PL(JL,JK)
        ZPI(JL,JK) = PI(JL,JK)
      ENDDO
    ENDDO
    CALL  CLDPP &
     & ( KIDIA , KFDIA , KLON   , KLEV,&
     & PAPRS , PAPRSF, ZPA   , ZPL    , ZPI   , PT,&
! Following line should be PGELAT,PGELAM, but not available in this 
! routine and make little difference to the random number generator. 
     & PGEMU, PGEMU,&
     & LLCLDCOVER  , PCCC  , PHCC  , PLCC   , PMCC  , PTCC,&
     & PNEB  , PQICE , PQLI )      
  ELSE
    CALL  CLOUD &
     & ( KIDIA , KFDIA , KLON   , KLEV,&
     & IBASC , ITOPC,&
     & PAPRSF, PACPR,&
     & PQ    , PQSAT , PT     , PVERVEL,&
     & PCCC  , PHCC  , PLCC   , PMCC,&
     & PNEB  , PTCC  , PQICE , PQLI   )  
  ENDIF


  DO JL=KIDIA,KFDIA
! Revert to bug? as before new surface fields
!    PACPR(JL) = 0.0_JPRB
    IBASC(JL) = 1
    ITOPC(JL) = 1
  ENDDO

ELSE

  DO JK=1,KLEV
    DO JL=KIDIA,KFDIA
      PNEB(JL,JK)  = 0.0_JPRB
      PQLI(JL,JK)  = 0.0_JPRB
      PQICE(JL,JK) = 0.0_JPRB
    ENDDO
  ENDDO

  DO JL=KIDIA,KFDIA
    PCCC(JL) = 0.0_JPRB
    PHCC(JL) = 0.0_JPRB
    PLCC(JL) = 0.0_JPRB
    PMCC(JL) = 0.0_JPRB
    PTCC(JL) = 0.0_JPRB
  ENDDO
ENDIF

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

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