SUBROUTINE UVRADI &
  &( KIDIA, KFDIA, KLON, KTDIA, KLEV , KAER , KSW  , KUV  , &
  &  PAERO, PALBD, PALBP, PAPH, PAP  , PCCNL, PCCNO, PCCO2, PCLDF, &
  &  PGELAM,PCLON, PSLON, PDP , PGEMU, PMU0 , POZ  , PQ   , PQSAT , &
  &  PQICE, PQLI , PLSM, PT   , PTL  , PUVC , PUVT , &
  &  PUVCTOT,PUVTTOT, PGFL) 

!**** *UVRADI* - COMPUTES THE ULTRA-VIOLET SHORTWAVE RADIATION FLUXES.

!     PURPOSE.
!     --------

!          THIS ROUTINE COMPUTES THE UV SURFACE RADIATION FLUXES IN N
!          SPECTRAL INTERVALS FOLLOWING FOUQUART AND BONNEL (1980).

!**   INTERFACE.
!     ----------

!          *UVRADI* IS CALLED FROM *CALLPAR*

!        IMPLICIT ARGUMENTS :
!        --------------------

!     ==== INPUTS ===
! PAERO  (KLON,KLEV,NACTAERO): PROGNOSTIC AEROSOLS
! PALBD  (KLON,KSW)    : DIFFUSE SURFACE ALBEDO
! PALBP  (KLON,KSW)    : DIRECT/PARALLEL SURFACE ALBEDO
! PAPH   (KLON,KLEV+1) : HALF-LEVEL PRESSURE (Pa)
! PAP    (KLON,KLEV)   : FULL-LEVEL PRESSURE (Pa)
! PCCNL  (KLON)        : NUMBER OF CCN OVER LAND  (m-3)
! PCCNO  (KLON)        : NUMBER OF CCN OVER OCEAN (m-3)
! PCCO2                : CO2 CONCENTRATION (kg/kg)
! PCLDF  (KLON,KLEV)   : CLOUD FRACTION
! PGELAM (KLON)        : LONGITUDE (radian)
! PCLON  (KLON)        : COSINE OF LONGITUDE
! PSLON  (KLON)        : SINE OF LONGITUDE
! PDP    (KLON,KLEV)   : PRESSURE THICKNESS OF LAYER (Pa)
! PGEMU  (KLON)        : LATITUDE (radian)
! PMU0   (KLON)        : COSINE SOLAR ZENITH ANGLE
! POZ    (KLON,KLEV)   : OZONE MIXING RATIO (kg/kg) -- prognostic --
! PQ     (KLON,KLEV)   : HUMIDITY (kg/kg)
! PQSAT  (KLON,KLEV)   : HUMIDITY AT SATURATION (kg/kg)
! PQICE  (KLON,KLEV)   : CLOUD ICE MIXING RATIO (kg/kg)
! PQLI   (KLON,KLEV)   : CLOUD LIQUID WATER M.RATIO (kg/kg)
! PLSM   (KLON)        : LAND-SEA MASK
! PT     (KLON,KLEV)   : TEMPERATURE (K)
! PTL    (KLON)        : SURFACE/SKIN TEMPERATURE (K)

!     ==== OUTPUTS ===
! PUVC   (KLON,KUV)    : SURFACE UV CLEAR-SKY SPECTRAL FLUX (W m-2 nm-1)
! PUVT   (KLON,KUV)    : SURFACE UV TOTAL SKY SPECTRAL FLUX (W m-2 nm-1)
! PUVCTOT(KLON)        : SURFACE UV CLEAR-SKY FLUX (W m-2)
! PUVTTOT(KLON)        : SURFACE UV TOTAL SKY FLUX (W m-2)
! PUVPOUT(KLON,KLEV)   : OUTPUTS RADIANCES
! PT340(KLON,KLEV)     : OPTICAL THICKNESS PROFILE AT 340 NM

!     METHOD.
!     -------
!          trimmed down version of SW scheme, but with increased spectral 
!          resolution in the UV

!          1. COMPUTES FLUXES IN U.V. INTERVALS         (UVFLX)

!     EXTERNALS.
!     ----------

!          *UVFLX*

!     REFERENCE.
!     ----------

!        SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT
!        DOCUMENTATION, AND FOUQUART AND BONNEL (1980)

!     AUTHOR.
!     -------
!        JEAN-JACQUES MORCRETTE  *ECMWF*

!     MODIFICATIONS.
!     --------------
!        ORIGINAL : 2005-10-04 based on *RADLSW* and *SW* but top to bottom
!     ------------------------------------------------------------------

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

USE YOMCST   , ONLY : RG  , RD    , RMD  , RMO3,  RNAVO, RTT  , RPI
USE YOMCT0   , ONLY : NSTART, LIFSMIN, LIFSTRAJ
USE YOMCT3   , ONLY : NSTEP
USE YOEPHY   , ONLY : LEO3CH
USE YOERAD   , ONLY : NOVLP, LCCNL  ,LCCNO, &
 & NRADIP , NRADLP , RCCNLND, RCCNSEA 
USE YOEAERD  , ONLY : RCAEROS
USE YOERDI   , ONLY : RRAE 
USE YOERDU   , ONLY : REPLOG   ,REPSC    ,REPSCT  ,REPSCW
USE YOECLD   , ONLY : REPSEC
USE YOEOVLP  , ONLY : RA1OVLP
USE YOETHF   , ONLY : RTICE
USE YOE_UVRAD, ONLY : RMUZUV, RK250, RTUV1, RTUV2, RSUVB, RAYUVB, &
              & RTAUVA, RPIUVA, RCGUVA, RCIEAS, RFCAER, & 
              & RASA, RASB, RASC, RASD, RASE, RASF, RFA0, RFA1, &
              & RFB0, RFB1, RFB2, RFB3, RFC0, RFC1, RFC2, RFC3, &
!              & RFD0, RFD1, RFD2, RFD3, JCOP, IPUV, RUVLAM    , &
              & JCOP, IPUV, RUVLAM    , &
!              & LUVTDEP, LUVDBG
              & LUVTDEP, LUVAERP 
USE YOM_YGFL, ONLY : YGFL, NACTAERO, YUVP

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),INTENT(IN)    :: KAER
INTEGER(KIND=JPIM),INTENT(IN)    :: KSW
INTEGER(KIND=JPIM),INTENT(IN)    :: KUV

REAL(KIND=JPRB)   ,INTENT(IN)    :: PCCO2 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PALBD(KLON,KSW) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PALBP(KLON,KSW) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAERO(KLON,KLEV,NACTAERO)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAP(KLON,KLEV)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPH(KLON,KLEV+1)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCCNL(KLON),PCCNO(KLON)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCLDF(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGELAM(KLON),PCLON(KLON),PSLON(KLON),PGEMU(KLON)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDP(KLON,KLEV)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLSM(KLON),PMU0(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: POZ(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQ(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQSAT(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQICE(KLON,KLEV),PQLI(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PT(KLON,KLEV),PTL(KLON)

REAL(KIND=JPRB)   ,INTENT(OUT)   :: PUVC(KLON,KUV), PUVT(KLON,KUV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PUVCTOT(KLON) , PUVTTOT(KLON) 

REAL(KIND=JPRB), INTENT(INOUT)      :: PGFL(KLON,KLEV,YGFL%NDIM)

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

!*       0.1   LOCAL ARRAYS
!              ------------

REAL(KIND=JPRB) :: ZAKI(KLON,2) &
  &, ZALBD(KLON)         , ZALBP(KLON)      , ZC1J(KLON,KLEV+1) &
  &, ZCLD(KLON,KLEV)     , ZCLEAR(KLON)     , ZCLOUD(KLON)      &
  &, ZDSIG(KLON,KLEV)    , ZFACT(KLON)      &
  &, ZCD(KLON,KUV,KLEV+1), ZFD(KLON,KUV,KLEV+1) &
  &, ZCDUV(KLON,KLEV+1)  , ZFDUV(KLON,KLEV+1)   & 
  &, ZQAER(KLON,6,KLEV)  , ZQOZ(KLON,KLEV)  , ZQOZC(KLON,KLEV)  &
  &, ZRMU(KLON),ZSEC(KLON) &
  &, ZSIGO(KLON)         , ZSIGN(KLON)      , ZTH(KLON,KLEV+1)  &
  &, ZTAU(KLON,KLEV)     , ZCG(KLON,KLEV)   , ZOMEGA(KLON,KLEV) &
  &, ZFIWP(KLON,KLEV)    , ZFLWP(KLON,KLEV) &
  &, ZIWC(KLON)          , ZLWC(KLON)       &
  &, ZCGAK(KLON,KLEV)    , ZPIZAK(KLON,KLEV), ZTAUAK(KLON,KLEV) &
  &, ZCGAZ(KLON,KLEV)    , ZPIZAZ(KLON,KLEV), ZTAUAZ(KLON,KLEV) &
  &, ZDESR(KLON,KLEV)    , ZRADIP(KLON,KLEV), ZRADLP(KLON,KLEV) &
  &, ZCOZ(KLON)          , ZRAYL(KLON)      &
  &, ZUD(KLON,2,KLEV+1)  , ZUDAC(KLON,2)    &
  &, ZGAER(KLON,6,KLEV)  , ZOAER(KLON,6,KLEV)&
  &, ZG340(KLON,KLEV)    , ZO340(KLON,KLEV)

REAL(KIND=JPRB) :: ZTCRAY(KLON,KUV),ZTCO3(KLON,KUV),ZTCAER(KLON,KUV),ZUVTSI(KLON)

REAL(KIND=JPRB) :: Z1S, Z2S, Z3S, ZCRAE

REAL(KIND=JPRB) :: ZASYMX, ZGI   , ZGL   , ZIWGKG, ZLWGKG,&
 & ZOI   , ZOL   , ZOMGMX, ZTAUMX, ZTEMPC, Z1RADI,&
 & ZTOI, ZTOL, ZDPOG, ZPODT  

REAL(KIND=JPRB) :: ZALND  , ZASEA  , ZD     , ZDEN  , ZNTOT, ZNUM  , ZRATIO, &
 & ZBETAI, ZOMGI , ZTCELS , ZFSR , ZAIWC , &
 & ZBIWC , &
 & ZDefRe, ZRefDe, ZALPHA1, &
 & ZCSTO , ZCSTR , ZDENB  , ZEFACT , ZFF    , ZGAR  , ZT250, ZTFACT, ZTRAY

INTEGER(KIND=JPIM) :: INWAVL, ITWAVL(19)
INTEGER(KIND=JPIM) :: JAER, JAEUV, JALUV, JCLUV, JK, JL, JPUV, JUV

REAL(KIND=JPRB) :: ZHOOK_HANDLE

REAL(KIND=JPRB) :: ZUVPOUT(KLON,KLEV), ZT340(KLON,KLEV)

#include "aer_tau.intfb.h"
#include "aer_rad.intfb.h"
#include "radaca.intfb.h"
! #include "radozc.intfb.h"
#include "uvflxa.intfb.h"

!     ------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('UVRADI',0,ZHOOK_HANDLE)

ZT340(:,:)  =0.0_JPRB
ZO340(:,:)  =0.0_JPRB
ZG340(:,:)  =0.0_JPRB
ZUVPOUT(:,:)=0.0_JPRB

!*         1.     USEFUL CLOUD-RELATED QUANTITIES
!                 -------------------------------

ZCRAE=RRAE*(RRAE+2.0_JPRB)

DO JL=KIDIA,KFDIA
  IF (PMU0(JL) > 1.E-10_JPRB) THEN
    ZRMU(JL)=RRAE/(SQRT(PMU0(JL) * PMU0(JL) + ZCRAE)-PMU0(JL))
  ELSE
    ZRMU(JL)=RRAE/SQRT(ZCRAE)
  ENDIF
  ZSEC(JL)=1.0_JPRB/ZRMU(JL)
  ZC1J(JL,1)=0.0_JPRB
  ZSIGO(JL) = PAPH(JL,1)
  ZCLEAR(JL)=1.0_JPRB
  ZCLOUD(JL)=0.0_JPRB
  ZUDAC(JL,1)=0.0_JPRB
  ZUDAC(JL,2)=0.0_JPRB
ENDDO
DO JK = 1 , KLEV
  ZALPHA1=RA1OVLP(JK)  
  DO JL = KIDIA,KFDIA
    ZSIGN(JL) = PAPH(JL,JK+1)
    ZDSIG(JL,JK) = (ZSIGN(JL) - ZSIGO(JL))/PAPH(JL,KLEV+1)
    ZSIGO(JL) = ZSIGN(JL)

    IF (NOVLP == 1) THEN
      ZCLEAR(JL)=ZCLEAR(JL)&
       & *(1.0_JPRB-MAX(PCLDF(JL,JK),ZCLOUD(JL)))&
       & /(1.0_JPRB-MIN(ZCLOUD(JL),1.0_JPRB-REPSEC))  
      ZC1J(JL,JK+1)= 1.0_JPRB - ZCLEAR(JL)
      ZCLOUD(JL) = PCLDF(JL,JK)
    ELSEIF (NOVLP == 2) THEN
      ZCLOUD(JL) = MAX(PCLDF(JL,JK),ZCLOUD(JL))
      ZC1J(JL,JK+1) = ZCLOUD(JL)
    ELSEIF (NOVLP == 3) THEN
      ZCLEAR(JL) = ZCLEAR(JL)*(1.0_JPRB-PCLDF(JL,JK))
      ZCLOUD(JL) = 1.0_JPRB - ZCLEAR(JL)
      ZC1J(JL,JK+1) = ZCLOUD(JL)
    ELSEIF (NOVLP == 4) THEN
!** Hogan & Illingworth (2001)      
      ZCLEAR(JL)=ZCLEAR(JL)*( &
       & ZALPHA1*(1.0_JPRB-MAX(PCLDF(JL,JK),ZCLOUD(JL))) &
       & /(1.0_JPRB-MIN(ZCLOUD(JL),1.0_JPRB-REPSEC)) &
       & +(1.0_JPRB-ZALPHA1)*(1.0_JPRB-PCLDF(JL,JK)) )  
      ZC1J(JL,JK+1) = 1.0_JPRB - ZCLEAR(JL) 
      ZCLOUD(JL) = PCLDF(JL,JK)
    ENDIF
  ENDDO
!  JL=KIDIA
!  IF(LUVDBG) print 8991,NOVLP,JK,ZCLEAR(JL),ZCLOUD(JL),ZC1J(JL,JK+1)
8991 format(1x,2I3,3F8.4)
ENDDO

DO JL=KIDIA,KFDIA
  ZCLEAR(JL)=1.0_JPRB-ZC1J(JL,KLEV+1)
!-- no fiddling -------------------------
!  ZCLEAR(JL)=0._JPRB
ENDDO
JL=KIDIA
!IF (LUVDBG) print *,'ZCLEAR ',ZCLEAR(JL) 
DO JK=1,KLEV
  DO JL=KIDIA,KFDIA
    IF (ZCLEAR(JL) < 1.0_JPRB) THEN
      ZCLD(JL,JK)=PCLDF(JL,JK)/(1.0_JPRB-ZCLEAR(JL))
    ELSE
      ZCLD(JL,JK)=0.0_JPRB
    ENDIF
    ZCLD(JL,JK)=MAX(0.0_JPRB,MIN(1.0_JPRB,ZCLD(JL,JK)))
!-- no fiddling -------------------------------------
!    ZCLD(JL,JK)=PCLDF(JL,JK)
  ENDDO
ENDDO


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

!*         2.     OZONE AND AEROSOLS
!                 ------------------

!-- BY DEFAULT, USE TEGEN ET AL. CLIMATOLOGY OF AEROSOLS

DO JK=2,KLEV
  DO JL=KIDIA,KFDIA
    Z1S = PAP(JL,JK-1)*(PAP(JL,JK)-PAPH(JL,JK))
    Z2S = PAP(JL,JK)  *(PAPH(JL,JK)-PAP(JL,JK-1))
    Z3S = PAPH(JL,JK) *(PAP(JL,JK)-PAP(JL,JK-1))
    ZTH(JL,JK)=(PT(JL,JK-1)*Z1S+PT(JL,JK)*Z2S)/Z3S
  ENDDO
ENDDO

DO JL=KIDIA,KFDIA
  ZTH(JL,1) =&
   & PT(JL,1)-PAP(JL,1) *(PT(JL,1)-ZTH(JL,2)) / (PAP(JL,1)-PAPH(JL,2))    
  ZTH(JL,KLEV+1)= PTL(JL)
ENDDO

!print 8990,(PAPH(JL,KLEV+1),JL=KIDIA,KFDIA,5)
8990 format(1x,'uvradi PAPH:',10E12.5)

!-- diagnostic aerosols from climatologies by default

CALL  RADACA ( KIDIA  , KFDIA, KLON , KLEV,&
  & PAPH , PGELAM, PGEMU, PCLON, PSLON, ZTH , &
  & ZQAER, ZQOZC )  

DO JAER = 1 , 6
  DO JK = 1 , KLEV
    DO JL = KIDIA,KFDIA
      ZQAER(JL,JAER,JK) = ZQAER(JL,JAER,JK)*RFCAER
    ENDDO
  ENDDO
ENDDO

!-- prognostic aerosols formatted as the diagnostic aerosols

IF (NACTAERO >= 12 .AND. LUVAERP) THEN

  INWAVL=1
  ITWAVL(:)=0
  ITWAVL(1)=1

  CALL AER_TAU ( &
   & KIDIA, KFDIA, KLON, 1 , KLEV , NACTAERO, INWAVL, ITWAVL, NSTART, NSTEP, &
   & PAP  , PAPH , PQ  , PT, PAERO, &
   & ZT340, ZO340, ZG340 )

  ITWAVL(:)=0
  ITWAVL(1)=9

  CALL AER_RAD ( &
   & KIDIA, KFDIA, KLON, 1 , KLEV , NACTAERO, INWAVL, ITWAVL, NSTART, NSTEP, &
   & PAP  , PAPH , PQ  , PT, PAERO, &
   & ZQAER, ZOAER, ZGAER )
ENDIF

!-- NB: the UV processor uses the prognostic ozone POZ if it is active

ZCSTO = 1.E-20_JPRB*RNAVO / (RMO3*RG*10._JPRB)

! factor 1.E-20 as O3 cross-section does not include this factor
DO JL=KIDIA,KFDIA
  ZCOZ(JL)=0._JPRB
ENDDO
!-- LEO3CH = .T. UV diagnostics from prognostic O3, .F. from climatological O3
IF (LEO3CH) THEN
  DO JK=1,KLEV
    DO JL=KIDIA,KFDIA
      ZQOZ(JL,JK)=POZ(JL,JK)*PDP(JL,JK)*ZCSTO
      ZCOZ(JL)   =ZCOZ(JL) + ZQOZ(JL,JK)
    ENDDO
  ENDDO
ELSE
  DO JK=1,KLEV
    DO JL=KIDIA,KFDIA
      ZQOZ(JL,JK)=ZQOZC(JL,JK)*ZCSTO
      ZCOZ(JL)   =ZCOZ(JL) + ZQOZ(JL,JK)
    ENDDO
  ENDDO
ENDIF

!print *,'KAER=',KAER

IF (KAER == 0) THEN
  DO JAER = 1 , 6
    DO JK = 1 , KLEV
      DO JL = KIDIA,KFDIA
        ZQAER(JL,JAER,JK) = RCAEROS
      ENDDO
    ENDDO
  ENDDO
ELSE
  DO JK = 1 , KLEV
    DO JL = KIDIA,KFDIA
      ZQAER(JL,5,JK) = RCAEROS
    ENDDO
  ENDDO
ENDIF
!DO JK=1,KLEV
!  JL=KIDIA
!  IF (LUVDBG) print 9000,JK,ZQOZ(JL,JK),(ZQAER(JL,JAER,JK),JAER=1,6)
9000 format(1x,'UVRAD_OZ AER:',I3,E13.6,1x,6E12.5)
!ENDDO



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

!*         3.     RAYLEIGH, CLOUD AND AEROSOLS OPTICAL PROPERTIES 
!                 -----------------------------------------------

ZRefDe = 0.64952_JPRB
ZDefRe = 1.0_JPRB / ZRefDe

DO JUV=1,KUV
  DO JK = 1 , KLEV+1
    DO JL = KIDIA,KFDIA
      ZFD(JL,JUV,JK) =0.0_JPRB
      ZCD(JL,JUV,JK) =0.0_JPRB
    ENDDO
  ENDDO
ENDDO

!*         3.1    PREPARATORY FOR CLOUD OPTICAL PROPERTIES
!                 ----------------------------------------

! OPTICAL PROPERTIES FOR LIQUID WATER CLOUDS FROM SLINGO (1989) 
! AND FOR ICE WATER CLOUDS FROM FU (1996)

DO JK=1,KLEV
  DO JL=KIDIA,KFDIA

! --- LIQUID WATER CONTENT (g.m-3) AND LIQUID WATER PATH (g.m-2)
    IF (PCLDF(JL,JK) > REPSC ) THEN
      ZLWGKG=MAX(PQLI(JL,JK)*1000.0_JPRB,0.0_JPRB)
      ZIWGKG=MAX(PQICE(JL,JK)*1000.0_JPRB,0.0_JPRB)
      ZLWGKG=ZLWGKG/PCLDF(JL,JK)
      ZIWGKG=ZIWGKG/PCLDF(JL,JK)
    ELSE
      ZLWGKG=0.0_JPRB
      ZIWGKG=0.0_JPRB
    ENDIF
    ZDPOG=PDP(JL,JK)/RG
    ZFLWP(JL,JK)= ZLWGKG*ZDPOG
    ZFIWP(JL,JK)= ZIWGKG*ZDPOG
    ZPODT=PAP(JL,JK)/(RD*PT(JL,JK))
    ZLWC(JL)=ZLWGKG*ZPODT
    ZIWC(JL)=ZIWGKG*ZPODT
  ENDDO

!*         3.2    CLOUD OPTICAL PROPERTIES: EFFECTIVE DROPLET RADIUS AND PARTICLE SIZE
!                 --------------------------------------------------------------------

  DO JL = KIDIA,KFDIA
!---- EFFECTIVE RADIUS FOR WATER, ICE AND RAIN PARTICLES

! very old parametrization as f(pressure)

    IF (NRADLP == 0) THEN
!-- very old parametrization as f(pressure) ERA-15
      ZRADLP(JL,JK)=10.0_JPRB + (100000.0_JPRB-PAP(JL,JK))*3.5_JPRB

    ELSEIF (NRADLP == 1) THEN
! simple distinction between land (10) and ocean (13) Zhang and Rossow
      IF (PLSM(JL) < 0.5_JPRB) THEN
        ZRADLP(JL,JK)=13.0_JPRB
      ELSE
        ZRADLP(JL,JK)=10.0_JPRB
      ENDIF
      
    ELSEIF (NRADLP >= 2) THEN
!--  based on Martin et al., 1994, JAS
      IF (PLSM(JL) < 0.5_JPRB) THEN
        IF (LCCNO) THEN
!          ZASEA=50.0_JPRB
          ZASEA=PCCNO(JL)
        ELSE  
          ZASEA=RCCNSEA
        ENDIF  
        ZD=0.33_JPRB
        ZNTOT=-1.15E-03_JPRB*ZASEA*ZASEA+0.963_JPRB*ZASEA+5.30_JPRB
      ELSE
        IF (LCCNL) THEN 
!          ZALND=900.0_JPRB
          ZALND=PCCNL(JL)
        ELSE  
          ZALND=RCCNLND
        ENDIF  
        ZD=0.43_JPRB
        ZNTOT=-2.10E-04_JPRB*ZALND*ZALND+0.568_JPRB*ZALND-27.9_JPRB
      ENDIF
      ZNUM=3.0_JPRB*ZLWC(JL)*(1.0_JPRB+3.0_JPRB*ZD*ZD)**2
      ZDEN=4.0_JPRB*RPI*ZNTOT*(1.0_JPRB+ZD*ZD)**3
      IF((ZNUM/ZDEN) > REPLOG)THEN
        ZRADLP(JL,JK)=100.0_JPRB*EXP(0.333_JPRB*LOG(ZNUM/ZDEN))
        ZRADLP(JL,JK)=MAX(ZRADLP(JL,JK), 4.0_JPRB)
        ZRADLP(JL,JK)=MIN(ZRADLP(JL,JK),16.0_JPRB)
      ELSE
        ZRADLP(JL,JK)=4.0_JPRB
      ENDIF
    ENDIF  
  ENDDO

  DO JL = KIDIA,KFDIA

! diagnosing the ice particle effective radius/diameter

!- ice particle effective radius =f(T) from Liou and Ou (1994)
 
    IF (PT(JL,JK) < RTICE) THEN
      ZTEMPC=PT(JL,JK)-RTT
    ELSE
      ZTEMPC=RTICE-RTT
    ENDIF
    ZRADIP(JL,JK)=326.3_JPRB+ZTEMPC*(12.42_JPRB + ZTEMPC*(0.197_JPRB + ZTEMPC*&
      & 0.0012_JPRB))    

    IF (NRADIP == 0) THEN
!-- fixed 40 micron effective radius
      ZRADIP(JL,JK)= 40.0_JPRB
      ZDESR(JL,JK) = ZDefRe * ZRADIP(JL,JK)
      
    ELSEIF (NRADIP == 1) THEN 

!-- old formulation based on Liou & Ou (1994) temperature (40-130microns)    
      ZRADIP(JL,JK)=MAX(ZRADIP(JL,JK),40.0_JPRB)
      ZDESR(JL,JK) = ZDefRe * ZRADIP(JL,JK)
      
    ELSEIF (NRADIP == 2) THEN  
!-- formulation following Jakob, Klein modifications to ice content    
      ZRADIP(JL,JK)=MAX(ZRADIP(JL,JK),30.0_JPRB)
      ZRADIP(JL,JK)=MIN(ZRADIP(JL,JK),60.0_JPRB)
      ZDESR(JL,JK)= ZDefRe * ZRADIP(JL,JK)
 
    ELSEIF (NRADIP == 3  ) THEN
 
!- ice particle effective radius =f(T,IWC) from Sun and Rikus (1999)
! revised by Sun (2001)
      IF (ZIWC(JL) > 0.0_JPRB ) THEN
        ZTEMPC = PT(JL,JK)-83.15_JPRB
        ZTCELS = PT(JL,JK)-RTT
        ZFSR = 1.2351_JPRB +0.0105_JPRB * ZTCELS
! Sun, 2001 (corrected from Sun & Rikus, 1999)
        ZAIWC = 45.8966_JPRB * ZIWC(JL)**0.2214_JPRB
        ZBIWC = 0.7957_JPRB * ZIWC(JL)**0.2535_JPRB
        ZDESR(JL,JK) = ZFSR * (ZAIWC + ZBIWC*ZTEMPC)
        ZDESR(JL,JK) = MIN ( MAX( ZDESR(JL,JK), 30.0_JPRB), 155.0_JPRB)
        ZRADIP(JL,JK)= ZRefDe * ZDESR(JL,JK)
      ELSE
        ZDESR(JL,JK) = 92.5_JPRB
        ZRADIP(JL,JK)= ZRefDe * ZDESR(JL,JK)
      ENDIF  
    ENDIF  
    
  ENDDO
!  JL=KIDIA
!  IF (LUVDBG) print 9001,JK,ZRADLP(JL,JK),ZRADIP(JL,JK),ZDESR(JL,JK),ZFLWP(JL,JK),ZFIWP(JL,JK)
9001 format(1x,'UVRAD_ReDe',I3,3F10.4,2E15.6)
ENDDO
!print *,'UVRAD_1 is finished'


!*         3.3    UV-SW OPTICAL PROPERTIES: RAYLEIGH, CLOUDS AND AEROSOLS
!                 -------------------------------------------------------

!IF (LUVDBG) THEN
!  DO JUV=1,4
!    DO JAER=1,6
!      print 9002,JUV,JAER,RTAUVA(JUV,JAER),RPIUVA(JUV,JAER),RCGUVA(JUV,JAER)
9002   format(1x,'Aerosols Coeff: ',2I3,3E15.7)
!    ENDDO
!  ENDDO
!ENDIF

DO JPUV=1,KUV
  JUV  =IPUV(JPUV)
  JCLUV=JCOP(JUV) 
  JAEUV=JCOP(JUV)
  JALUV=1

!*         3.3.1  OPTICAL THICKNESS FOR RAYLEIGH SCATTERING
!                 -----------------------------------------

! factor 10 to convert Rayleigh scattering cross section (cm2) to optical thickness (N.D.)
  ZCSTR = RAYUVB(JUV) * RNAVO / (RMD*RG*10._JPRB)

  DO JL = KIDIA,KFDIA
    IF (PMU0(JL) >= RMUZUV) THEN 
      ZFACT(JL) = PMU0(JL) * RSUVB(JUV)
    ELSE
      ZFACT(JL) = 0._JPRB
    ENDIF
    ZRAYL(JL) = ZCSTR * PAPH(JL,KLEV+1) 
    ZTCRAY(JL,JPUV)=ZRAYL(JL)
    ZTCAER(JL,JPUV)=0.0_JPRB
  ENDDO
!  JL=KIDIA
!  print 9003,JUV,JAEUV,JCLUV,JALUV,RAYUVB(JUV),ZRAYL(JL),ZCOZ(JL),ZFACT(JL)
9003 format(1x,'RAD2:JUV,JAE,JCL,JAL:',2I3,2I2,' CRAY=',E9.3,' TCRAY=',E9.3,' TCO3=',E9.3,' TSI=',E9.3) 

  DO JK=1,KLEV
    DO JL=KIDIA,KFDIA
      ZALBD(JL)=PALBD(JL,JALUV)
      ZALBP(JL)=PALBP(JL,JALUV)
      ZTAU(JL,JK)  = 0.0_JPRB
      ZOMEGA(JL,JK)= 1.0_JPRB
      ZCG(JL,JK)   = 0.0_JPRB
      ZCGAZ(JL,JK) = 0.0_JPRB
      ZPIZAZ(JL,JK)= 0.0_JPRB
      ZTAUAZ(JL,JK)= 0.0_JPRB
    ENDDO


!*         3.3.2  OPTICAL THICKNESS FOR MIX OF RAYLEIGH AND AEROSOLS LAYER-BY-LAYER
!                 -----------------------------------------------------------------

    DO JAER=1,6
      DO JL = KIDIA,KFDIA
        ZTAUAZ(JL,JK)=ZTAUAZ(JL,JK)+ZQAER(JL,JAER,JK)*RTAUVA(JAEUV,JAER)
        ZPIZAZ(JL,JK)=ZPIZAZ(JL,JK)+ZQAER(JL,JAER,JK)&
         & * RTAUVA(JAEUV,JAER)*RPIUVA(JAEUV,JAER)  
        ZCGAZ(JL,JK) = ZCGAZ(JL,JK)+ZQAER(JL,JAER,JK)&
         & * RTAUVA(JAEUV,JAER)*RPIUVA(JAEUV,JAER)*RCGUVA(JAEUV,JAER)  
      ENDDO
!      IF (JUV == 1 .AND. JK == 1) THEN
!        JL=KIDIA
!        print 9101,JUV,JK,JAER,ZQAER(JL,JAER,JK),ZTAUAZ(JL,JK),ZPIZAZ(JL,JK),ZCGAZ(JL,JK)
9101    format(1x,'dbg1:',3I3,4E13.6)
!      ENDIF
    ENDDO
    DO JL=KIDIA,KFDIA
      ZTCAER(JL,JPUV)=ZTCAER(JL,JPUV)+ZTAUAZ(JL,JK)
    ENDDO

    DO JL = KIDIA,KFDIA
      IF (KAER /= 0) THEN
        ZCGAK(JL,JK) = ZCGAZ(JL,JK)/ZPIZAZ(JL,JK)
        ZPIZAK(JL,JK)=ZPIZAZ(JL,JK)/ZTAUAZ(JL,JK)
        ZTAUAK(JL,JK)=ZTAUAZ(JL,JK)
        ZTRAY  = ZRAYL(JL) * ZDSIG(JL,JK)
!!!! wrong  ZRATIO = ZTRAY / (ZTRAY + ZTAUAK(JL,JK))
        ZGAR = ZCGAK(JL,JK)
        ZFF  = ZGAR * ZGAR

        ZDENB = ZTRAY+ZTAUAK(JL,JK)*(1.0_JPRB-ZPIZAK(JL,JK)*ZFF)
        ZRATIO= ZTRAY / ZDENB

        ZTAUAZ(JL,JK)= ZTRAY+ ZTAUAK(JL,JK)*(1.0_JPRB-ZPIZAK(JL,JK)*ZFF)
        ZCGAZ(JL,JK) = ZGAR * (1.0_JPRB - ZRATIO) / (1.0_JPRB + ZGAR)
        ZPIZAZ(JL,JK)= ZRATIO+(1.0_JPRB-ZRATIO)*ZPIZAK(JL,JK)*(1.0_JPRB-ZFF)&
         & / (1.0_JPRB - ZPIZAK(JL,JK) * ZFF)  
      ELSE
        ZTRAY = ZRAYL(JL) * ZDSIG(JL,JK)
        ZTAUAZ(JL,JK) = ZTRAY
        ZCGAZ(JL,JK)  = 0.0_JPRB
        ZPIZAZ(JL,JK) = 1.0_JPRB-REPSCT
        ZTAUAK(JL,JK) = 0.0_JPRB
        ZCGAK(JL,JK)  = 0.0_JPRB
        ZPIZAK(JL,JK) = 1.0_JPRB-REPSCT
      ENDIF
    ENDDO
!!    IF (JUV == 1 .AND. JK == KLEV) THEN
!      JL=KIDIA
!      print 9102,JUV,JK,KAER,ZRAYL(JL)*ZDSIG(JL,JK),ZTAUAZ(JL,JK),ZPIZAZ(JL,JK),ZCGAZ(JL,JK)
9102  format(1x,'dbg2:',3I3,4E13.6)
!!    ENDIF


!*         3.3.3  OPTICAL THICKNESS FOR CLOUDS LAYER-BY-LAYER
!                 -------------------------------------------

    DO JL = KIDIA,KFDIA
      ZTOL=0.0_JPRB
      ZGL =0.0_JPRB
      ZOL =0.0_JPRB
      ZTOI=0.0_JPRB
      ZGI =0.0_JPRB
      ZOI =0.0_JPRB
      IF (PCLDF(JL,JK) > REPSC .AND. ZFLWP(JL,JK)+ZFIWP(JL,JK) > REPSCW ) THEN
        IF (ZFLWP(JL,JK) > REPSCW ) THEN
!-- SW: Slingo, 1989
          ZTOL = ZFLWP(JL,JK)*(RASA(JCLUV)+RASB(JCLUV)/ZRADLP(JL,JK))
          ZGL  = RASE(JCLUV)+RASF(JCLUV)*ZRADLP(JL,JK)
          ZOL  = 1._JPRB - RASC(JCLUV)-RASD(JCLUV)*ZRADLP(JL,JK)
        ENDIF

        IF (ZFIWP(JL,JK) > REPSCW ) THEN
!-- SW: Fu 1996
          Z1RADI = 1.0_JPRB / ZDESR(JL,JK)
          ZBETAI = RFA0(JCLUV)+Z1RADI* RFA1(JCLUV)
          ZTOI = ZFIWP(JL,JK) * ZBETAI
          ZOMGI= RFB0(JCLUV)+ZDESR(JL,JK)*(RFB1(JCLUV) + ZDESR(JL,JK) &
           &   *(RFB2(JCLUV)+ZDESR(JL,JK)* RFB3(JCLUV) ))            
          ZOI  = 1.0_JPRB - ZOMGI
          ZGI  = RFC0(JCLUV)+ZDESR(JL,JK)*(RFC1(JCLUV) + ZDESR(JL,JK) &
           &   *(RFC2(JCLUV)+ZDESR(JL,JK)* RFC3(JCLUV) )) 
          ZGI  = MIN(1.0_JPRB, ZGI)
        ENDIF

!  - MIX of WATER and ICE CLOUDS
        ZTAUMX= ZTOL + ZTOI
        ZOMGMX= ZTOL*ZOL + ZTOI*ZOI
        ZASYMX= ZTOL*ZOL*ZGL + ZTOI*ZOI*ZGI

        ZASYMX= ZASYMX/ZOMGMX
        ZOMGMX= ZOMGMX/ZTAUMX

! --- SW FINAL CLOUD OPTICAL PARAMETERS

        ZTAU(JL,JK)  = ZTAUMX
        ZOMEGA(JL,JK)= ZOMGMX
        ZCG(JL,JK)   = ZASYMX
      ENDIF
    ENDDO
!    JL=KIDIA
!    IF(LUVDBG .AND. JK > 30) print 9004,JUV,JK,ZCLEAR(JL),ZCLD(JL,JK),ZTAU(JL,JK),ZOMEGA(JL,JK),ZCG(JL,JK), &
!      &   ZTAUAK(JL,JK),ZPIZAK(JL,JK),ZCGAK(JL,JK), &
!      &   ZRAYL(JL)*ZDSIG(JL,JK),ZQOZ(JL,JK) 
9004 format(1x,'UVRAD_3',2I3,9F8.5,E12.5)
  ENDDO
!  print *,'about to call UVFLX'


!*         3.3.4  EFFECTIVE ABSORPTION COEFFICIENT FOR O3 AND NO2 INCLUDING TEMPERATURE EFFECT
!                 ----------------------------------------------------------------------------

  DO JL=KIDIA,KFDIA
    ZUDAC(JL,1)=0.0_JPRB
    ZUDAC(JL,2)=0.0_JPRB
    ZUD(JL,1,1)=0.0_JPRB
    ZUD(JL,2,1)=0.0_JPRB
  ENDDO

  DO JK=1,KLEV
    DO JL=KIDIA,KFDIA
      IF (LUVTDEP) THEN
        ZT250= PT(JL,JK)-250._JPRB
        ZTFACT=ZT250*( RTUV1(JUV) + (ZT250* RTUV2(JUV) ))
        ZEFACT=EXP(ZTFACT)
      ELSE
        ZEFACT=1.0_JPRB
      ENDIF
      ZUD(JL,1,JK+1)=ZQOZ(JL,JK)*ZEFACT
      ZUDAC(JL,1)=ZUDAC(JL,1)+ZQOZ(JL,JK)*ZSEC(JL)
    ENDDO
  ENDDO

  DO JL=KIDIA,KFDIA
!    ZTR=EXP(-RK250(JUV)*ZUDAC(JL,1))
!    ZAKI(JL,1)=-LOG( ZTR(JL,1) ) / ZUDAC(JL,1)
    ZAKI(JL,1)=MAX(RK250(JUV), 1.E-18_JPRB)
    ZAKI(JL,2)=1.E-12_JPRB
  ENDDO

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

!*         4.     CALL FLUX ROUTINE 
!                 -----------------

!  CALL UVFLX &
!   & ( KIDIA, KFDIA , KLON  , KLEV , JUV   , &
!   &   ZALBD, ZALBP , ZCG   , ZCLD , ZCLEAR, &
!   &   ZDSIG, ZOMEGA, ZRAYL , ZRMU , ZSEC  , &
!   &   ZTAU , ZCGAZ , ZPIZAZ,ZTAUAZ, ZUD   , &
!   &   ZCDUV, ZFDUV &
!   & ) 

  CALL UVFLXA &
   &( KIDIA, KFDIA , KLON  , KLEV  , JUV  , &
   &  ZAKI , ZALBD , ZALBP , ZCG   , ZCLD , ZCLEAR, &
   &  ZDSIG, ZOMEGA, ZRAYL , ZRMU  , ZSEC , &
   &  ZTAU , ZCGAZ , ZPIZAZ, ZTAUAZ, ZUD  , &
   &  ZFDUV, ZCDUV &
   &)


!-- finally multiply by mu_zero*Incident solar radiation (in relevant spectral interval)

  DO JK = 1 , KLEV+1
    DO JL = KIDIA,KFDIA
      ZFD(JL,JPUV,JK)=ZFDUV(JL,JK)*ZFACT(JL)
      ZCD(JL,JPUV,JK)=ZCDUV(JL,JK)*ZFACT(JL)
     ENDDO
  ENDDO

!*         4.1    FILL THE DIAGNOSTIC ARRAYS 
!                 --------------------------

  DO JL = KIDIA,KFDIA
    PUVT(JL,JPUV) = ZFD(JL,JPUV,KLEV+1)
    PUVC(JL,JPUV) = MAX( ZCD(JL,JPUV,KLEV+1), 1.E-18_JPRB)
    ZTCO3(JL,JPUV)= ZUDAC(JL,1)
  ENDDO
ENDDO




!JL=KIDIA
!IF (LUVDBG) THEN
!  DO JK=1,KLEV+1
!    PRINT 9011,JK,(ZFD(JL,JUV,JK),JUV=1,KUV)
9011 format(1x,'ZFD',I3,25F6.3)
!  ENDDO
!ENDIF


DO JL=KIDIA,KFDIA
  PUVCTOT(JL)=0.0_JPRB
  PUVTTOT(JL)=0.0_JPRB
  ZUVTSI(JL) =0.0_JPRB
ENDDO
DO JUV=1,KUV
  DO JL=KIDIA,KFDIA
    PUVCTOT(JL)=PUVCTOT(JL)+PUVC(JL,JUV)*RCIEAS(JUV)
    PUVTTOT(JL)=PUVTTOT(JL)+PUVT(JL,JUV)*RCIEAS(JUV)
    ZUVTSI(JL) =ZUVTSI(JL)+RSUVB(JUV)*PMU0(JL)
  ENDDO
ENDDO
DO JL=KIDIA,KFDIA
  IF (PMU0(JL) >= RMUZUV) THEN
    ZUVPOUT(JL,1)=PMU0(JL)
    ZUVPOUT(JL,2)=PUVTTOT(JL)
    ZUVPOUT(JL,3)=PUVCTOT(JL)
  ENDIF
ENDDO
IF(KUV == 24) THEN
  DO JUV=1,KUV
    DO JL=KIDIA,KFDIA
      ZUVPOUT(JL,JUV+3    )= PUVT(JL,JUV)
      ZUVPOUT(JL,JUV+3+KUV)= PUVC(JL,JUV)
    ENDDO
  ENDDO
ENDIF

!------------------------------------------------------------------------------
!
!*         6.6     SET SOME FIELDS TO ZERO
!                  -----------------------


IF(.NOT.LIFSMIN .AND. .NOT. LIFSTRAJ) THEN
  PGFL(:,:,YUVP(1)%MP) = ZUVPOUT(:,:)
  PGFL(:,:,YUVP(2)%MP) = ZT340(:,:)
ENDIF


!-- for plots
JL=KIDIA
!print *,'  Wavl   TOAinc    CS-UV    TS_UV   RaylOT    O3_OT   Aer_OD   RatTS/CS'
!print *,'   nm     W/m2      W/m2     W/m2    tau       tau     tau             '
!DO JUV=1,KUV 
!  ZRATIO=PUVT(JL,JUV)/PUVC(JL,JUV)
!  print 9012,RUVLAM(JUV),RSUVB(JUV)*PMU0(JL),PUVC(JL,JUV),PUVT(JL,JUV),ZTCRAY(JL,JUV),ZTCO3(JL,JUV),ZTCAER(JL,JUV),ZRATIO
9012 format(1x,f7.2,7F9.4)
!ENDDO
!JL=KIDIA
!IF (ZCLEAR(JL) > 0.99_JPRB .AND. ZUVTSI(JL) > 1.E-06_JPRB) THEN
!  print 9013,ZCLEAR(JL),ZUVTSI(JL),PUVCTOT(JL),PUVTTOT(JL)
!ENDIF
9013 format(1x,'end UVRADI:',6x,4F9.4)

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

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

