MODULE YOMCOSP_MAIN
  ! IMPORT IFS SPECIFIC MODULES
  USE PARKIND1, ONLY : JPIM, JPRB, JPIB
  USE YOMMP,    ONLY : MYPROC
  USE YOMCT0,   ONLY : NSTART, NSTOP, NPROC
  USE YOMCT3,   ONLY : NSTEP
  USE YOMGEM,   ONLY : NGPTOT, NGPTOTG
  USE YOMDIM,   ONLY : NFLEVG, NPROMA, NGPBLKS
  USE YOMLUN,   ONLY : NULOUT, NULNAM, NULERR
  USE YOMCST,   ONLY : RG, RLVTT, RLSTT, RTT, RV, RCPD, &
       RDAY, RD, RETV, RA, REA, RSIGMA, RCPV
  USE YOETHF,   ONLY : R2ES, R3LES, R3IES, R4LES, R4IES, &
       R5LES, R5IES, R5ALVCP, R5ALSCP, &
       RALVDCP, RALSDCP, RTWAT, RTICE, RTICECU, &
       RTWAT_RTICE_R, RTWAT_RTICECU_R, RVTMP2
  USE YOECLDP,  ONLY : NCLV, NCLDQL, NCLDQR, NCLDQI, NCLDQS
  USE YOMRIP,   ONLY : NINDAT, NSTADD, NSSSSS, RSTATI, RDEASO
  USE YOM_YGFL , ONLY : YGFL, YO3, YL, YI, YA, YR, YS, LFIRE, LCO2SFC, &
       & YAERO, NAERO, NACTAERO,YGRG, NGRG, YGRGTEND, NGRG_CPLO4,      &
       & YGHG, NGHG, YTRAC , NTRAC,                                    &
       & NERA40 , YERA40, YLRCH4, LGRGSFC, YNOGW, YAEROUT, YUVP,       &
       & YCDNC, YICNC, YRE_LIQ, YRE_ICE
  USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK

  ! COSP-SPECIFIC MODULES
  USE MOD_COSP_CONSTANTS
  USE MOD_COSP_TYPES
  USE MOD_COSP_MODIS_SIMULATOR
  USE MOD_COSP
  USE YOMCOSP_VARIABLES

CONTAINS

  !***********************************************************
  ! MAIN ROUTINE TO COPY IFS STATE, DO PHYSICS, AND CALL COSP.
  !***********************************************************
  SUBROUTINE COSPSETUPANDCALL(KFLDXP,KFLDXP2,KLEVX,KFLDX,KFLDX2, &
       & PH,P,T,SH,LSM,SKT,                                      &
       & FL_CVRAIN,FL_CVSNOW,FL_LSRAIN,FL_LSSNOW,HGT_HALF,HGT,   &
       & CC,DTAUS,DTAUC,DEMS,DEMC,                               &
       & SUNLIT,REFFLIQ,REFFICE,CLDLIQ,CLDICE,CCA,               &
       ! OUTPUT
       & POUT3D,POUT2D)

    IMPLICIT NONE

    !-------------------------------------------------------------------------------
    ! VARIABLE DECLARATION: MODEL STATE
    INTEGER(KIND=JPIM), INTENT(IN) :: KFLDXP
    INTEGER(KIND=JPIM), INTENT(IN) :: KFLDXP2
    INTEGER(KIND=JPIM), INTENT(IN) :: KLEVX
    INTEGER(KIND=JPIM), INTENT(IN) :: KFLDX
    INTEGER(KIND=JPIM), INTENT(IN) :: KFLDX2
    REAL(KIND=JPRB), INTENT(IN) :: T(COSP_NPOINTS,COSP_NLEVELS)  ! TEMPERATURE
    REAL(KIND=JPRB), INTENT(IN) :: SH(COSP_NPOINTS,COSP_NLEVELS)  ! SPECIFIC HUMIDITY
    REAL(KIND=JPRB), INTENT(IN) :: CC(COSP_NPOINTS,COSP_NLEVELS)  ! CLOUD FRACTION
    REAL(KIND=JPRB), INTENT(IN) :: CLDLIQ(COSP_NPOINTS,COSP_NLEVELS)  ! WATER CLOUD FRACTION
    REAL(KIND=JPRB), INTENT(IN) :: CLDICE(COSP_NPOINTS,COSP_NLEVELS)  ! ICE CLOUD FRACTION
    REAL(KIND=JPRB), INTENT(IN) :: SKT(COSP_NPOINTS)      ! SKIN TEMPERATURE
    REAL(KIND=JPRB), INTENT(IN) :: CCA(COSP_NPOINTS)     ! CONVECTIVE CLOUD FRACTION
    REAL(KIND=JPRB), INTENT(IN) :: FL_CVRAIN(COSP_NPOINTS,COSP_NLEVELS) ! CV PRECIP RAIN.
    REAL(KIND=JPRB), INTENT(IN) :: FL_CVSNOW(COSP_NPOINTS,COSP_NLEVELS) ! CV PRECIP SNOW.
    REAL(KIND=JPRB), INTENT(IN) :: FL_LSRAIN(COSP_NPOINTS,COSP_NLEVELS) ! LS PRECIP RAIN.
    REAL(KIND=JPRB), INTENT(IN) :: FL_LSSNOW(COSP_NPOINTS,COSP_NLEVELS) ! LS PRECIP AS SNOW.
    REAL(KIND=JPRB), INTENT(IN) :: PH(COSP_NPOINTS,COSP_NLEVELS+1)   ! P HALF LEVELS
    REAL(KIND=JPRB), INTENT(IN) :: P(COSP_NPOINTS,COSP_NLEVELS) ! P FULL LEVELS
    REAL(KIND=JPRB), INTENT(IN) :: DTAUS(COSP_NPOINTS,COSP_NLEVELS) ! OPT DPTH LSCLD: 0.67 UM
    REAL(KIND=JPRB), INTENT(IN) :: DTAUC(COSP_NPOINTS,COSP_NLEVELS) ! OPT DPTH CVCLD: 0.67 UM
    REAL(KIND=JPRB), INTENT(IN) :: DEMS(COSP_NPOINTS,COSP_NLEVELS)    ! EMIS LSCLD: 10.5 UM
    REAL(KIND=JPRB), INTENT(IN) :: DEMC(COSP_NPOINTS,COSP_NLEVELS)    ! EMIS CVCLD: 10.5 UM
    REAL(KIND=JPRB), INTENT(IN) :: SUNLIT(COSP_NPOINTS)       ! SUN LIGHT
    REAL(KIND=JPRB), INTENT(IN) :: LSM(COSP_NPOINTS)          ! LAND SEA MASK
    REAL(KIND=JPRB), INTENT(IN) :: REFFLIQ(COSP_NPOINTS,COSP_NLEVELS) ! REFF FOR LIQ CLD
    REAL(KIND=JPRB), INTENT(IN) :: REFFICE(COSP_NPOINTS,COSP_NLEVELS) ! REFF FOR ICE CLD
    REAL(KIND=JPRB), INTENT(IN) :: HGT(COSP_NPOINTS,COSP_NLEVELS) ! GMH ON FULL LEVELS
    REAL(KIND=JPRB), INTENT(IN) :: HGT_HALF(COSP_NPOINTS,COSP_NLEVELS+1) ! GMH ON 1/2 LEVELS
    ! OUTPUT ARRAYS
    REAL(KIND=JPRB), INTENT(OUT) :: POUT3D(COSP_NPOINTS,KLEVX,KFLDX)
    REAL(KIND=JPRB), INTENT(OUT) :: POUT2D(COSP_NPOINTS,KFLDX2)
    ! -------------- IFS LOCAL VARIABLES ------------------------------------------
    INTEGER(KIND=JPIM)  :: I,J,K,L,M,JK,JL,JZ,JH
    REAL(KIND=JPRB)     :: ZQSAT,ZHOOK_HANDLE,ZESAT,ZSTEP
    REAL(KIND=JPRB), PARAMETER :: ZMISS     = -1.0E4_JPRB
    ! ATMOSPHERIC DENSITY
    REAL(KIND=JPRB) :: ZTV
    REAL(KIND=JPRB), DIMENSION(COSP_NPOINTS,COSP_NLEVELS) :: ZRHO
    ! MASS FLUXES ON FULL LEVELS. NPOINTS
    DOUBLE PRECISION :: TIME ! NOT USED
    DOUBLE PRECISION :: TIME_BNDS(2) ! NOT USED

#include "abor1.intfb.h"
#include "fcttre.h"
#include "fcttim.h"

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

    !************************************* PART 1 ************************************

    ! ASSIGN THE BASIC DIMENSION INFO TO COSP VARIABLES
    GBX%MYPROC   = MYPROC
    GBX%NSTEP    = NSTEP
    GBX%COSP_IBL = COSP_IBL
    GBX%NSTART   = NSTART
    GBX%NSTOP    = NSTOP
    GBX%NPOINTS  = COSP_NPOINTS
    GBX%NLEVELS  = COSP_NLEVELS
    GBX%NCOLUMNS = COSP_NCOLUMNS

    CALL CONSTRUCT_COSP_GRIDBOX(TIME,TIME_BNDS,COSP_RADAR_FREQ,    &
         COSP_SURFACE_RADAR,COSP_USE_MIE_TABLES,                   &
         COSP_USE_GAS_ABS,COSP_DO_RAY,COSP_MELT_LAY,COSP_K2,       &
         COSP_NPOINTS,COSP_NLEVELS,COSP_NCOLUMNS,                  &
         N_HYDRO,COSP_NPRMTS_MAX_HYDRO,                            &
         COSP_NUMAERO,COSP_NPRMTS_MAX_AERO,COSP_NPOINTS_IT,        &
         COSP_LIDAR_ICE_TYPE,                                      &
         COSP_ISCCP_TOPHEIGHT,COSP_ISCCP_TOPHEIGHT_DIRECTION,      &
         COSP_OVERLAP,COSP_EMSFC_LW,COSP_USE_PRECIPITATION_FLUXES, &
         COSP_USE_REFF,GBX) 
    ! DEBUGGING
    IF (COSP_DEBUG) CALL COSP_GRIDBOX_PRINT(GBX)
    !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    ! DEFINE NEW VERTICAL GRID
    !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    CALL CONSTRUCT_COSP_VGRID(GBX,COSP_NLVGRID,COSP_USE_VGRID,COSP_CSAT_VGRID,VGRID)
    IF (COSP_DEBUG) CALL COSP_VGRID_PRINT(VGRID)
    !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    CALL CONSTRUCT_COSP_SUBGRID(COSP_NPOINTS,COSP_NCOLUMNS,COSP_NLEVELS,SGX)
    IF (COSP_DEBUG) CALL COSP_SUBGRID_PRINT(SGX)
    !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    !----------- CONSTRUCT RADAR STRUCTS ---------------
    !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    ! ALLOCATE MINIMUM STORAGE IF SIMULATOR NOT USED
    IF (COSP_LRADAR_SIM) THEN
       CALL CONSTRUCT_COSP_SGRADAR(CFG,COSP_NPOINTS,COSP_NCOLUMNS,&
            COSP_NLEVELS,N_HYDRO,SGRADAR)
       CALL CONSTRUCT_COSP_RADARSTATS(CFG,COSP_NPOINTS,COSP_NCOLUMNS,&
            VGRID%NLVGRID,N_HYDRO,STRADAR)
       IF (COSP_DEBUG) CALL COSP_SGRADAR_PRINT(SGRADAR)
    ENDIF
    !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    !------------- CONSTRUCT LIDAR STRUCTS ------------------
    !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    IF (COSP_LLIDAR_SIM) THEN
       CALL CONSTRUCT_COSP_SGLIDAR(CFG,COSP_NPOINTS,COSP_NCOLUMNS,&
            COSP_NLEVELS,N_HYDRO,PARASOL_NREFL,SGLIDAR)
       CALL CONSTRUCT_COSP_LIDARSTATS(CFG,COSP_NPOINTS,COSP_NCOLUMNS, &
            VGRID%NLVGRID,N_HYDRO,PARASOL_NREFL,STLIDAR)
       IF (COSP_DEBUG) CALL COSP_SGLIDAR_PRINT(SGLIDAR)
       IF (COSP_DEBUG) CALL COSP_LIDARSTATS_PRINT(STLIDAR)
    ENDIF
    !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    !------------- CONSTRUCT ISCCP ------------------
    !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    IF (COSP_LISCCP_SIM) THEN
       CALL CONSTRUCT_COSP_ISCCP(CFG,COSP_NPOINTS,COSP_NCOLUMNS, &
            COSP_NLEVELS,ISCCP)
       IF (COSP_DEBUG) CALL COSP_ISCCP_PRINT(ISCCP)
    ENDIF
    !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    !------------- CONSTRUCT MISR ------------------
    !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    ! ALLOCATE MINIMUM STORAGE IF SIMULATOR NOT USED
    IF (COSP_LMISR_SIM) THEN
       CALL CONSTRUCT_COSP_MISR(CFG,COSP_NPOINTS,MISR)
       IF (COSP_DEBUG) CALL COSP_MISR_PRINT(MISR)
    ENDIF
    !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    !------------- CONSTRUCT MODIS -------------------
    !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    IF(COSP_LMODIS_SIM) THEN
       CALL CONSTRUCT_COSP_MODIS(CFG,COSP_NPOINTS,MODIS)
    ENDIF
    !*************************************************************************
    ! CALCULATION OF MODEL VARIABLES NOT READILY AVAILABLE IN IFS            !
    !*************************************************************************
    ZRHO(:,:) = 0.0_JPRB
    DO JL=1,COSP_NPOINTS
       DO JK=1,COSP_NLEVELS
          IF(SH(JL,JK) > 0.0) THEN
             ZTV = T(JL,JK) * ( 1.0_JPRB + SH(JL,JK) * (1.0_JPRB/0.622_JPRB) - 1.0_JPRB )
             ZRHO(JL,JK) = P(JL,JK) / (287.0_JPRB * ZTV)
          ENDIF
       ENDDO
       ! RH
       DO JK=1,COSP_NLEVELS
          ZESAT = FOEELIQ( T(JL,JK) ) * RV / RD
          ZQSAT = ( ( RD / RV ) * ZESAT / P(JL,JK) ) / &
               & (1.0_JPRB - ( RETV * ( RD / RV ) * ZESAT / P(JL,JK) ) )
          GBX%Q(JL,JK) = MAX( 0.0_JPRB, 100.0_JPRB* SH(JL,JK) / ZQSAT ) 
       ENDDO
    ENDDO

    !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    ! CONSTRACT AND POPULATE INPUT TYPES WITH MODEL FIELDS.
    ! OPENIFS ORDERS ARRAYS TOA->SFC (1->NLEV)
    ! HERE THE 3D SAMPLE MODEL FIELDS (TEMPERATURE,PRESSURE,ETC...)
    ! COSP1.4.1 EXPECTS ALL FIELDS TO BE ORDERED FROM SFC-2-TOA.
    !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    ! THESE VARIABLES ARE NON-EXISTENT IN IFS AND ARE SET TO 0.0_JPRB
    GBX%GRPL_LS  = 0.0_JPRB
    GBX%NP       = 0.0_JPRB  ! NO PARTICLE NUMBER INFORMATION IN IFS
    GBX%MR_HYDRO = 0.0_JPRB
    GBX%REFF     = 0.0_JPRB

    DO JL = 1,COSP_NPOINTS
       DO JK = 1,COSP_NLEVELS
          JH = COSP_NLEVELS - JK + 1
          GBX%P(JL,JK)       = P(JL,JH)
          GBX%ZLEV(JL,JK)    = HGT(JL,JH)
          GBX%T(JL,JK)       = T(JL,JH)
          GBX%SH(JL,JK)      = MAX(1.0E-6_JPRB,SH(JL,JH)) 
          GBX%TCA(JL,JK)     = MAX(0.0_JPRB,CC(JL,JH))
          GBX%RAIN_LS(JL,JK) = MAX(0.0_JPRB,FL_LSRAIN(JL,JH))
          GBX%SNOW_LS(JL,JK) = MAX(0.0_JPRB,FL_LSSNOW(JL,JH))
          GBX%RAIN_CV(JL,JK) = MAX(0.0_JPRB,FL_CVRAIN(JL,JH))
          GBX%SNOW_CV(JL,JK) = MAX(0.0_JPRB,FL_CVSNOW(JL,JH))
       ENDDO
    ENDDO
    WHERE(GBX%TCA > 1.0)
       GBX%TCA = 1.0_JPRB
    ENDWHERE
    
    ! HALF LEVEL ARRAYS. COSP DOESN'T NEED THE TOA LOCATED AT 1 IN IFS.
    ! THESE ARRAYS ARE ONLY DECLARED UP TO KLEV, NOT KLEV + 1    
    DO JL = 1,COSP_NPOINTS
       GBX%PH(JL,1:COSP_NLEVELS) = PH(JL,COSP_NLEVELS+1:2:-1) ! HERE TOA IS SET TO 0
       GBX%ZLEV_HALF(JL,1:COSP_NLEVELS) = HGT_HALF(JL,COSP_NLEVELS:1:-1) ! SFC HEIGHT IS 0
    ENDDO

    DO JL = 1,COSP_NPOINTS
       DO JK = 1, COSP_NLEVELS
          JH = COSP_NLEVELS - JK + 1
          GBX%MR_HYDRO(JL,JK,I_LSCLIQ) = MAX(0.0_JPRB,CLDLIQ(JL,JH)) ! CLD LIQ
          GBX%MR_HYDRO(JL,JK,I_LSCICE) = MAX(0.0_JPRB,CLDICE(JL,JH)) ! CLD ICE
          ! EFFECTIVE RADIUS CLOUD PARTICLES
          GBX%REFF(JL,JK,I_LSCLIQ) = MAX(0.0_JPRB,REFFLIQ(JL,JH)) * 1.0E-6 !4-30 UM CONVERT TO M
          GBX%REFF(JL,JK,I_LSCICE) = MAX(0.0_JPRB,REFFICE(JL,JH)) * 1.0E-6 !30-100 UM CONVERT TO M
          ! ISCCP SIMULATOR
          GBX%DTAU_S(JL,JK) = DTAUS(JL,JH)
          GBX%DEM_S(JL,JK)  = DEMS(JL,JH)
          ! NORMALLY THE TAU AND DEM FOR CONVECTIVE AREAS ARE 0. ASSUME THAT THESE ARE THE
          ! SAME AS TAU AND DEM FOR LS AREAS.
          IF( GBX%RAIN_CV(JL,JK) > 0.0 .OR. GBX%SNOW_CV(JL,JK) > 0.0 ) THEN
             GBX%DTAU_C(JL,JK) = DTAUS(JL,JH)
             GBX%DEM_C(JL,JK)  = DEMS(JL,JH)
             GBX%CCA(JL,JK)    = 0.05_JPRB
          ENDIF
       ENDDO
       GBX%LAND(JL)      = LSM(JL)
       GBX%PSFC(JL)      = PH(JL,COSP_NLEVELS+1)
       GBX%SKT(JL)       = SKT(JL) 
       GBX%SUNLIT(JL)    = MAX(0.0_JPRB,SUNLIT(JL))
    ENDDO
    !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    CALL COSP(COSP_OVERLAP,COSP_NCOLUMNS,CFG,VGRID,GBX,SGX,SGRADAR,SGLIDAR,ISCCP, &
         MISR,MODIS,STRADAR,STLIDAR)
    !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

    !***************** HANDLING THE OUTPUTS *****************************
    ! SET THESE FLAGS TO TRUE OR FALSE BASED ON WHICH OUTPUT IS REQUESTED
    !
    ! CONSTRUCT COSP OUTPUTS
    !----------------------------------------------------------------------------------
    POUT2D(:,D_CALIPSO_LCC%IXTR2) = ZMISS
    POUT2D(:,D_CALIPSO_MCC%IXTR2) = ZMISS
    POUT2D(:,D_CALIPSO_HCC%IXTR2) = ZMISS
    POUT2D(:,D_CALIPSO_TCC%IXTR2) = ZMISS
    POUT2D(:,D_ISCCP_TOTAL_CF%IXTR2) = ZMISS
    POUT2D(:,D_ISCCP_CTP%IXTR2) = ZMISS
    POUT2D(:,D_ISCCP_CLDALB%IXTR2) = ZMISS
    POUT2D(:,D_MODIS_TOTAL%IXTR2) = ZMISS
    POUT2D(:,D_MODIS_LIQ%IXTR2) = ZMISS
    POUT2D(:,D_MODIS_ICE%IXTR2) = ZMISS

    IF(COSP_LLIDAR_SIM) THEN
       ! CALIPSO CLOUD FRACTION
       WHERE(STLIDAR%CLDLAYER(:,1) >= 0.0)
          POUT2D(:,D_CALIPSO_LCC%IXTR2) = STLIDAR%CLDLAYER(:,1) !"CLDLAYER_LCC"
       ENDWHERE
       WHERE(STLIDAR%CLDLAYER(:,2) >= 0.0)
          POUT2D(:,D_CALIPSO_MCC%IXTR2) = STLIDAR%CLDLAYER(:,2) !"CLDLAYER_MCC"
       ENDWHERE
       WHERE(STLIDAR%CLDLAYER(:,3) >= 0.0)
          POUT2D(:,D_CALIPSO_HCC%IXTR2) = STLIDAR%CLDLAYER(:,3) !"CLDLAYER_HCC"
       ENDWHERE
       WHERE(STLIDAR%CLDLAYER(:,4) >= 0.0)
          POUT2D(:,D_CALIPSO_TCC%IXTR2) = STLIDAR%CLDLAYER(:,4) !"CLDLAYER_TCC"
       ENDWHERE
    ENDIF
    IF(COSP_LISCCP_SIM) THEN
       WHERE(ISCCP%TOTALCLDAREA(:) >= 0.0)
          POUT2D(:,D_ISCCP_TOTAL_CF%IXTR2) = ISCCP%TOTALCLDAREA(:)
       ENDWHERE
       WHERE(ISCCP%MEANPTOP(:) >= 0.0)
          POUT2D(:,D_ISCCP_CTP%IXTR2) = ISCCP%MEANPTOP(:)
       ENDWHERE
       WHERE(ISCCP%MEANALBEDOCLD(:) >= 0.0)
          POUT2D(:,D_ISCCP_CLDALB%IXTR2) = ISCCP%MEANALBEDOCLD(:)
       ENDWHERE
    ENDIF
    IF(COSP_LMODIS_SIM) THEN
       WHERE(MODIS%CLOUD_FRACTION_TOTAL_MEAN(:) >= 0.0)
          POUT2D(:,D_MODIS_TOTAL%IXTR2) = MODIS%CLOUD_FRACTION_TOTAL_MEAN(:) 
       ENDWHERE
       WHERE(MODIS%CLOUD_FRACTION_WATER_MEAN(:) >= 0.0)
          POUT2D(:,D_MODIS_LIQ%IXTR2) = MODIS%CLOUD_FRACTION_WATER_MEAN(:)
       ENDWHERE
       WHERE(MODIS%CLOUD_FRACTION_ICE_MEAN(:) >= 0.0)
          POUT2D(:,D_MODIS_ICE%IXTR2) = MODIS%CLOUD_FRACTION_ICE_MEAN(:)
       ENDWHERE
    ENDIF
    ! CLIP ANY BAD VALUES
    IF (COSP_LLIDAR_SIM) THEN
       POUT2D(:,D_CALIPSO_LCC%IXTR2) = MERGE(ZMISS, POUT2D(:,D_CALIPSO_LCC%IXTR2), &
                                           & POUT2D(:,D_CALIPSO_LCC%IXTR2) > 1.0E6)

       POUT2D(:,D_CALIPSO_MCC%IXTR2) = MERGE(ZMISS, POUT2D(:,D_CALIPSO_MCC%IXTR2), &
                                           & POUT2D(:,D_CALIPSO_MCC%IXTR2) > 1.0E6)

       POUT2D(:,D_CALIPSO_HCC%IXTR2) = MERGE(ZMISS, POUT2D(:,D_CALIPSO_HCC%IXTR2), &
                                           & POUT2D(:,D_CALIPSO_HCC%IXTR2) > 1.0E6)

       POUT2D(:,D_CALIPSO_TCC%IXTR2) = MERGE(ZMISS, POUT2D(:,D_CALIPSO_TCC%IXTR2), &
                                           & POUT2D(:,D_CALIPSO_TCC%IXTR2) > 1.0E6)
    END IF

    IF (COSP_LISCCP_SIM) THEN
       POUT2D(:,D_ISCCP_TOTAL_CF%IXTR2) = MERGE(ZMISS, POUT2D(:,D_ISCCP_TOTAL_CF%IXTR2), &
                                              & POUT2D(:,D_ISCCP_TOTAL_CF%IXTR2) > 1.0E6)

       POUT2D(:,D_ISCCP_CTP%IXTR2) = MERGE(ZMISS, POUT2D(:,D_ISCCP_CTP%IXTR2), &
                                         & POUT2D(:,D_ISCCP_CTP%IXTR2) > 1.0E6)

       POUT2D(:,D_ISCCP_CLDALB%IXTR2) = MERGE(ZMISS, POUT2D(:,D_ISCCP_CLDALB%IXTR2), & 
                                            & POUT2D(:,D_ISCCP_CLDALB%IXTR2) > 1.0E6)
    END IF

    IF (COSP_LMODIS_SIM) THEN
       POUT2D(:,D_MODIS_TOTAL%IXTR2) = MERGE(ZMISS, POUT2D(:,D_MODIS_TOTAL%IXTR2), &
                                           & POUT2D(:,D_MODIS_TOTAL%IXTR2) > 1.0E6)

       POUT2D(:,D_MODIS_LIQ%IXTR2) = MERGE(ZMISS, POUT2D(:,D_MODIS_LIQ%IXTR2), &
                                         & POUT2D(:,D_MODIS_LIQ%IXTR2) > 1.0E6)

       POUT2D(:,D_MODIS_ICE%IXTR2) = MERGE(ZMISS, POUT2D(:,D_MODIS_ICE%IXTR2), &
                                         & POUT2D(:,D_MODIS_ICE%IXTR2) > 1.0E6)
    END IF

    CALL FREE_COSP_GRIDBOX(GBX)
    CALL FREE_COSP_SUBGRID(SGX)
    IF (COSP_LRADAR_SIM) THEN
       CALL FREE_COSP_SGRADAR(SGRADAR)
       CALL FREE_COSP_RADARSTATS(STRADAR)
    ENDIF
    IF (COSP_LLIDAR_SIM) THEN
       CALL FREE_COSP_SGLIDAR(SGLIDAR)
       CALL FREE_COSP_LIDARSTATS(STLIDAR)
    ENDIF
    IF (COSP_LISCCP_SIM) CALL FREE_COSP_ISCCP(ISCCP)
    IF (COSP_LMISR_SIM) CALL FREE_COSP_MISR(MISR)
    IF(COSP_LMODIS_SIM) CALL FREE_COSP_MODIS(MODIS)
    CALL FREE_COSP_VGRID(VGRID)

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

  !===============================================================================
  ! SUBROUTINE MADE BY ECMWF TO GET RADIATION VARIABLES FROM GRID POINT VARIABLES.
  ! CONTACT RICHARD FORBES FOR QUESTIONS
  !===============================================================================
  SUBROUTINE RADFROMGP &
       &( KIDIA, KFDIA, KLON  , KLEV , KLW  , KSW  , KTYPE , &
       &  PAPH , PAP  , PGELAM, PGEMU, &
       &  PCLFR, PEMIS, PEMIW , PLSM , PMU0 , &
       &  POZON, PQ   , PQIWP , PQSWP, PQLWP, PQRWP,  &
       &  PT   , PTS  , PSWU  , PSWV , &
                                !-- outputs
       &  PCO2 , PCH4 , PN2O  , PCO  , PO3  , &
       &  PDTAUS,PDTAUC,PDEMS , PDEMC, PRADLI, PRADIC, PCCA , PSUNLIT)

    !**** *RADFROMGP* - COMPUTE QUANTITES TO BE USED AS INPUTS FOR THE COSP SIMULATOR

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

    !        EXPLICIT ARGUMENTS:
    !        -------------------
    !   ==== INPUTS ===
    ! KTYPE  : (KLON)            ; COLUMN STATE INDEX    (0=clear, 1= deep convection, 2=shallow convection, 3=mixed convection)
    ! PAPH   : (KLON,KLEV+1)     ; HALF LEVEL PRESSURE
    ! PAP    : (KLON,KLEV)       ; FULL LEVEL PRESSURE
    ! PCLFR  : (KLON,KLEV)       ; CLOUD FRACTIONAL COVER
    ! PEMIS  : (KLON)            ; SURFACE LW EMISSIVITY
    ! PEMIW  : (KLON)            ; SURFACE LW WINDOW EMISSIVITY
    ! PGELAM : (KLON)            ; LONGITUDE (RADIANS)
    ! PGEMU  : (KLON)            ; SINE OF LATITUDE
    ! PLSM   : (KLON)            ; LAND-SEA MASK
    ! PMU0   : (KLON)            ; SOLAR ANGLE
    ! POZON  : (KLON,KLEV)       ; OZONE AMOUNT
    ! PQ     : (KLON,KLEV)       ; SPECIFIC HUMIDITY KG/KG
    ! PQIWP  : (KLON,KLEV)       ; ICE (Small particles) KG/KG
    ! PQSWP  : (KLON,KLEV)       ; SNOW (Large particle) KG/KG
    ! PQLWP  : (KLON,KLEV)       ; LIQUID WATER KG/KG
    ! PQRWP  : (KLON,KLEV)       ; RAIN WATER KG/KG
    ! PT     : (KLON,KLEV)       ; FULL LEVEL TEMPERATURE
    ! PTS    : (KLON)            ; SURFACE TEMPERATURE
    ! PSWU   : (KLON)            ; U-COMPONENT SURFACE WIND (AT 10-M, m s-1)
    ! PSWV   : (KLON)            ; V-COMPONENT SURFACE WIND (AT 10-M, m s-1)
    !   ==== OUTPUTS ===
    ! PCO2   : (KLON,KLEV)       ; CONCENTRATION IN CO2 (KG/KG)
    ! PCH4   : (KLON,KLEV)       ; CONCENTRATION IN CH4 (KG/KG)
    ! PN2O   : (KLON,KLEV)       ; CONCENTRATION IN N2O (KG/KG)
    ! PCO    : (KLON,KLEV)       ; CONCENTRATION IN N2O (KG/KG)  ! non available, set to zero
    ! PO3    : (KLON,KLEV)       ; CONCENTRATION IN O3  (KG/KG)
    ! PCCA   : (KLON)            ; CONVECTIVE CLOUD AMOUNT  [0-1]
    ! PDTAUS : (KLON,KLEV)       ; OPTICAL DEPTH STRATIFORM CLOUD AT 0.67 UM
    ! PDTAUC : (KLON,KLEV)       ; OPTICAL DEPTH CONVECTVE CLOUD AT 0.67 UM
    ! PDEMS  : (KLON,KLEV)       ; EMISSIVITY STRATIFORM CLOUD AT 10.5 UM
    ! PDEMC  : (KLON,KLEV)       ; EMISSIVITY CONVECTIVE CLOUD AT 10.5 UM
    ! PRADLI : (KLON,KLEV)       ; EFFECTIVE RADIUS FOR LIQUID CLOUD
    ! PRADIC : (KLON,KLEV)       ; EFFECTIVE RADIUS FOR ICE CLOUD
    ! PSUNLIT: (KLON)            ; SUN-LIT POINTS

    !
    !     AUTHORS.
    !     --------
    !      J.-J. MORCRETTE         *ECMWF*
    !      ORIGINAL : 20130116
    !
    !     MODIFICATIONS.
    !     --------------
    !-----------------------------------------------------------------------

    USE PARKIND1  ,ONLY : JPIM     ,JPRB
    USE YOMLUN   , ONLY : NULOUT

    USE YOMCT0   , ONLY : NSTART
    USE YOMCT3   , ONLY : NSTEP
    USE YOMCST   , ONLY : RG      ,RD      ,RTT      ,RPI
    USE YOECLD   , ONLY : RDECORR_CF       ,RDECORR_CW
    USE YOERAD   , ONLY : NSW      ,NOVLP  ,LRRTM    ,&
         & LCCNL  , LCCNO  , LDIFFC , NDECOLAT, &
         & NRADIP , NRADLP , NICEOPT, NLIQOPT, NMINICE, &
         & RCCNLND, RCCNSEA, NMcICA , RMINICE, RRe2De
    USE YOELW    , ONLY : NTRA     ,NUA
    USE YOERDI   , ONLY : RCARDI   ,RCH4     ,RN2O
    USE YOESW    , ONLY : REBCUG   ,REBCUH   ,&
         & RHSAVI   ,RFULIO   ,RFUETA  ,RFUETB   ,RFUETC   ,RLILIA   ,RLILIB
    USE YOESRTCOP , ONLY : &
         & RSYFWA   ,RSYFWB   ,RSYFWC   ,RSYFWD   ,RSYFWE   ,RSYFWF  &
         & , RSECIA   ,RSECIB   ,RSECIC   ,RSECID   ,RSECIE   ,RSECIF &
         & , RSASWA   ,RSASWB   ,RSASWC   ,RSASWD   ,RSASWE   ,RSASWF &
         & , RSFUA0   ,RSFUA1   ,RSFUB0   ,RSFUB1   ,RSFUB2   ,RSFUB3 &
         & , RSFUC0   ,RSFUC1   ,RSFUC2   ,RSFUC3   &
         & , RSFLA0   ,RSFLA1   ,RSFLB0   ,RSFLB1   ,RSFLB2   ,RSFLB3 &
         & , RSFLC0   ,RSFLC1   ,RSFLC2   ,RSFLC3   ,RSFLD0   ,RSFLD1 &
         & , RSFLD2   ,RSFLD3

    USE YOERDU   , ONLY : NUAER  ,NTRAER   ,REPLOG   ,REPSC    ,REPSCA  ,REPSCW   ,DIFF
    USE YOETHF   , ONLY : RTICE
    USE YOEPHLI  , ONLY : LPHYLIN
    USE YOERRTFTR, ONLY : NGB
    USE YOESRTWN , ONLY : NMPSRTM
    USE YOEAEROP , ONLY : ALF_SU
    USE YOM_YGFL , ONLY : NACTAERO

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

    INTEGER(KIND=JPIM),INTENT(IN)    :: KTYPE(KLON)
    REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPH(KLON,KLEV+1)
    REAL(KIND=JPRB)   ,INTENT(IN)    :: PAP(KLON,KLEV)
    REAL(KIND=JPRB)   ,INTENT(IN)    :: PCLFR(KLON,KLEV)
    REAL(KIND=JPRB)   ,INTENT(IN)    :: PEMIS(KLON)
    REAL(KIND=JPRB)   ,INTENT(IN)    :: PEMIW(KLON)
    REAL(KIND=JPRB)   ,INTENT(IN)    :: PGELAM(KLON), PGEMU(KLON)
    REAL(KIND=JPRB)   ,INTENT(IN)    :: POZON(KLON,KLEV)
    REAL(KIND=JPRB)   ,INTENT(IN)    :: PLSM(KLON)
    REAL(KIND=JPRB)   ,INTENT(IN)    :: PMU0(KLON)
    REAL(KIND=JPRB)   ,INTENT(IN)    :: PQ(KLON,KLEV)
    REAL(KIND=JPRB)   ,INTENT(IN)    :: PQIWP(KLON,KLEV) ! Ice
    REAL(KIND=JPRB)   ,INTENT(IN)    :: PQSWP(KLON,KLEV) ! Snow
    REAL(KIND=JPRB)   ,INTENT(IN)    :: PQLWP(KLON,KLEV) ! Liquid
    REAL(KIND=JPRB)   ,INTENT(IN)    :: PQRWP(KLON,KLEV) ! Rain
    REAL(KIND=JPRB)   ,INTENT(IN)    :: PT(KLON,KLEV)
    REAL(KIND=JPRB)   ,INTENT(IN)    :: PTS(KLON)
    REAL(KIND=JPRB)   ,INTENT(IN)    :: PSWU(KLON), PSWV(KLON)


    REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCO2(KLON,KLEV)
    REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCH4(KLON,KLEV)
    REAL(KIND=JPRB)   ,INTENT(OUT)   :: PN2O(KLON,KLEV)
    REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCO(KLON,KLEV)
    REAL(KIND=JPRB)   ,INTENT(OUT)   :: PO3(KLON,KLEV)
    REAL(KIND=JPRB)   ,INTENT(OUT)   :: PDTAUS(KLON,KLEV)
    REAL(KIND=JPRB)   ,INTENT(OUT)   :: PDTAUC(KLON,KLEV)
    REAL(KIND=JPRB)   ,INTENT(OUT)   :: PDEMS(KLON,KLEV)
    REAL(KIND=JPRB)   ,INTENT(OUT)   :: PDEMC(KLON,KLEV)
    REAL(KIND=JPRB)   ,INTENT(OUT)   :: PRADLI(KLON,KLEV)
    REAL(KIND=JPRB)   ,INTENT(OUT)   :: PRADIC(KLON,KLEV)
    REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCCA(KLON)
    REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSUNLIT(KLON)

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

    INTEGER(KIND=JPIM) :: JL, JK, JVARLW, JVARSW, JRTM, JSW
    INTEGER(KIND=JPIM) :: IRADLP

    REAL(KIND=JPRB) :: ZCLFR(KLON,KLEV), ZETA(KLON,KLEV) , ZRHO(KLON,KLEV) , ZDP(KLON,KLEV)
    REAL(KIND=JPRB) :: ZFIWP(KLON,KLEV), ZFLWP(KLON,KLEV), ZFRWP(KLON,KLEV), ZFSWP(KLON,KLEV)
    REAL(KIND=JPRB) :: ZQIWP(KLON,KLEV), ZQLWP(KLON,KLEV), ZQRWP(KLON,KLEV), ZQSWP(KLON,KLEV)
    REAL(KIND=JPRB) :: ZIWC(KLON,KLEV) , ZLWC(KLON,KLEV) , ZRWC(KLON,KLEV) , ZSWC(KLON,KLEV)
    REAL(KIND=JPRB) :: ZRE_LIQ(KLON,KLEV), ZRADLI(KLON,KLEV)
    REAL(KIND=JPRB) :: ZTOLW(KLON,KLEV), ZTOSW(KLON,KLEV), ZOMSW(KLON,KLEV), ZASSW(KLON,KLEV)
    REAL(KIND=JPRB) :: ZRADIC(KLON,KLEV) , ZDESIC(KLON,KLEV)
    REAL(KIND=JPRB) :: ZTH(KLON,KLEV+1)


    REAL(KIND=JPRB) :: ZPS(KLON), ZLAT(KLON), ZCLAT(KLON), ZGLAT(KLON), ZWND(KLON)
    REAL(KIND=JPRB) :: ZCCNL(KLON), ZCCNO(KLON), ZQ(KLON), ZEXPO(KLON), ZEXPL(KLON)
    REAL(KIND=JPRB) :: ZDECORR_CF(KLON)     , ZDECORR_CW(KLON)        , ZMINICE(KLON)
    REAL(KIND=JPRB) :: ZRADIP(KLON), ZRADLP(KLON), ZDESR(KLON)


    REAL(KIND=JPRB) :: ZLW(KLON,KLW), ZSW(KLON,KSW)

    REAL(KIND=JPRB) :: ZRG, ZRPI, ZDPOG, ZPODT, ZTEMP, ZIWGKG, ZLWGKG, ZRWGKG, ZSWGKG
    REAL(KIND=JPRB) :: ZRefDe   , ZDefRe, Z1S , Z2S  , Z3S
    REAL(KIND=JPRB) :: ZASEA, ZK, ZNTOT, ZALND, ZNUM, ZDEN, ZRLRATIO, ZKL, ZKRATIO
    REAL(KIND=JPRB) :: ZREFACDEN, ZREFAC, ZTEMPC, ZTCELS, ZFSR, ZAIWC, ZBIWC

    REAL(KIND=JPRB) :: ZASYMX, ZDIFFD, ZGI, ZGL, ZGR
    REAL(KIND=JPRB) :: ZMULTI, ZMULTL, ZOI, ZOL, &
         & ZOMGMX, ZOR, ZRMUZ, ZTAUD, ZTAUMX, ZTOI, ZTOL, ZTOR
    REAL(KIND=JPRB) :: Z1RADI, Z1RADL, ZBETAI, ZOMGI, ZOMGP, ZFDEL, ZEXPN, &
         & ZRELVNT, ZEXTCF, Z1MOMG, ZRSAIA, ZRSAID, ZRSAIE, ZRSAIF, ZRSAIG, &
         & ZRSALD, ZEMICLD

    REAL(KIND=JPRB) :: ZHOOK_HANDLE
    !     -----------------------------------------------------------------

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

    !*         1.     PREPARATORY CALCULATIONS
    !                 ------------------------
    DO JL=KIDIA,KFDIA

       IF (KTYPE(JL) == 0) THEN
          PCCA(JL)=0.0_JPRB
       ELSE
          PCCA(JL)=0.05_JPRB
       ENDIF

       IF (PMU0(JL) <= 1.E-06_JPRB) THEN
          PSUNLIT(JL)=0.0_JPRB
       ELSE
          PSUNLIT(JL)=1.0_JPRB
       ENDIF
    ENDDO
    PDEMC(:,:)=0._JPRB
    PDEMS(:,:)=0._JPRB
    PDTAUC(:,:)=0._JPRB
    PDTAUS(:,:)=0._JPRB


    !          1.1    INITIALISATION OF VARIOUS FIELDS
    !                 --------------------------------

    ZRG=1.0_JPRB/RG !
    ZLW(:,:)       = 0.0_JPRB
    ZSW(:,:)       = 0.0_JPRB
    ZRE_LIQ(:,:)   = 0.0_JPRB

    !- SIMPLISTIC DEFINITION OF THE TRACE GASES CONCENTRATIONS
    !- *** SHOULD BE IMPROVED ***
    DO JL=KIDIA,KFDIA
       PCO2(JL,:) = RCARDI
       PCH4(JL,:) = RCH4
       PN2O(JL,:) = RN2O
       PCO(JL,:)  = 0.0_JPRB
       PO3(JL,:)  = POZON(JL,:)    ! to be checked  ....
    ENDDO
    !- defining the cloud concentration number over ocean and land

    DO JL=KIDIA,KFDIA
       ZWND(JL)=SQRT(PSWU(JL)*PSWU(JL)+PSWV(JL)*PSWV(JL))
       IF(LCCNO) THEN
          IF (ZWND(JL) > 30.0_JPRB) THEN
             ZQ(JL)=327.0_JPRB
          ELSEIF (ZWND(JL) > 15.0_JPRB) THEN
             ZQ(JL)=EXP(0.13_JPRB*ZWND(JL)+1.89_JPRB)
          ELSE
             ZQ(JL)=EXP(0.16_JPRB*ZWND(JL)+1.44_JPRB)
          ENDIF
          ZEXPO(JL)=1.2_JPRB+0.5_JPRB*LOG10(ZQ(JL))
          ZCCNO(JL)=10.0_JPRB**ZEXPO(JL)
       ELSE
          ZCCNO(JL)=RCCNSEA
       ENDIF
       IF (LCCNL) THEN
          IF (ZWND(JL) <= 15._JPRB) THEN
             ZQ(JL)=EXP(0.16_JPRB*ZWND(JL)+1.45_JPRB)
          ELSE
             ZQ(JL)=EXP(0.13_JPRB*ZWND(JL)+1.89_JPRB)
          ENDIF
          ZEXPL(JL)=2.21_JPRB+0.3_JPRB*LOG10(ZQ(JL))
          ZCCNL(JL)=10.0_JPRB**ZEXPL(JL)
       ELSE
          ZCCNL(JL)=RCCNLND
       ENDIF
    ENDDO

    !- defining temperature on half-levels

    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,KLEV+1)=PTS(JL)
       ZTH(JL,1)=PT(JL,1)-PAP(JL,1)*(PT(JL,1)-ZTH(JL,2))&
            & /(PAP(JL,1)-PAPH(JL,2))
    ENDDO
    !     -----------------------------------------------------------------

    !*         1.2    SET-UP INPUT QUANTITIES FOR ALL RADIATION CONFIGURATIONS
    !                 --------------------------------------------------------

    !-- in-cloud ice and water mixing ratios; cloud ice and liquid contents and paths

    DO JK=1,KLEV
       DO JL=KIDIA,KFDIA
          ZCLFR(JL,JK)   = PCLFR(JL,JK)
          ZETA(JL,JK) =PAP(JL,JK)/PAPH(JL,KLEV+1)
          ZDP(JL,JK) = PAPH(JL,JK+1)-PAPH(JL,JK)
          IF (PCLFR(JL,JK) >= 0.001_JPRB) THEN
             ZTEMP=1.0_JPRB/PCLFR(JL,JK)
             ZQIWP(JL,JK)=MAX(0.0_JPRB, PQIWP(JL,JK)*ZTEMP)
             ZQSWP(JL,JK)=MAX(0.0_JPRB, PQSWP(JL,JK)*ZTEMP)
             ! RMF SENS 20091223 Set snow to zero
             ZQSWP(JL,JK)=0.0_JPRB ! this sets the snow to 0 and makes the REFF of ice only
             ZQLWP(JL,JK)=MAX(0.0_JPRB, PQLWP(JL,JK)*ZTEMP)
             ZQRWP(JL,JK)=MAX(0.0_JPRB, PQRWP(JL,JK)*ZTEMP)
             ! RMF SENS 20100224 Set rain to zero
             !      ZQRWP(JL,JK)=0._JPRB
             ZIWGKG=ZQIWP(JL,JK)*1000.0_JPRB
             ZSWGKG=ZQSWP(JL,JK)*1000.0_JPRB
             ZLWGKG=ZQLWP(JL,JK)*1000.0_JPRB
             ZRWGKG=ZQRWP(JL,JK)*1000.0_JPRB
          ELSE
             ZCLFR(JL,JK)=0.0_JPRB
             ZQIWP(JL,JK)=0.0_JPRB
             ZQSWP(JL,JK)=0.0_JPRB
             ZQLWP(JL,JK)=0.0_JPRB
             ZQRWP(JL,JK)=0.0_JPRB
             ZIWGKG=0.0_JPRB
             ZSWGKG=0.0_JPRB
             ZLWGKG=0.0_JPRB
             ZRWGKG=0.0_JPRB
          ENDIF
          ZDPOG=ZDP(JL,JK)*ZRG
          ZFIWP(JL,JK) = ZIWGKG*ZDPOG
          ZFSWP(JL,JK) = ZSWGKG*ZDPOG
          ZFLWP(JL,JK) = ZLWGKG*ZDPOG
          ZFRWP(JL,JK) = ZRWGKG*ZDPOG
          ZPODT = PAP(JL,JK)/(RD*PT(JL,JK))
          ZRHO(JL,JK) = ZPODT
          ZIWC(JL,JK) = ZIWGKG*ZPODT
          ZSWC(JL,JK) = ZSWGKG*ZPODT
          ZLWC(JL,JK) = ZLWGKG*ZPODT
          ZRWC(JL,JK) = ZRWGKG*ZPODT
       ENDDO
    ENDDO

    ZRPI=1.0_JPRB/RPI
    DO JL=KIDIA,KFDIA
       ZPS(JL)=PAPH(JL,KLEV+1)
       ZLAT(JL) = ASIN(PGEMU(JL))
       ZGLAT(JL)= ZLAT(JL) * 180.0_JPRB*ZRPI
       ZCLAT(JL)= COS(ZLAT(JL))
       IF (NDECOLAT == 0) THEN
          ZDECORR_CF(JL)=RDECORR_CF
          ZDECORR_CW(JL)=RDECORR_CW
       ELSEIF (NDECOLAT == 1) THEN
          ZDECORR_CF(JL)=2.899_JPRB-0.02759_JPRB*ABS(ZGLAT(JL))
          ZDECORR_CW(JL)=ZDECORR_CF(JL)*0.5_JPRB
       ELSEIF (NDECOLAT == 2) THEN
          ZDECORR_CF(JL)=0.75_JPRB + 2.149_JPRB*ZCLAT(JL)*ZCLAT(JL)
          ZDECORR_CW(JL)=ZDECORR_CF(JL)*0.5_JPRB
       ENDIF
    ENDDO

    DO JL=KIDIA,KFDIA
       IF (NMINICE == 0) THEN
          ! Constant ice effective radius
          ZMINICE(JL) = RMINICE
       ELSEIF (NMINICE >= 1) THEN
          ! Ice effective radius varies with latitude, smaller at poles
          ZMINICE(JL) = 20.0_JPRB+(RMINICE-20.0_JPRB)*ZCLAT(JL)
       ENDIF
    ENDDO



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

    !*         1.3    EFFECTIVE RADII AND PARTICLE SIZE
    !                 ---------------------------------

    ZRefDe = RRe2De
    ZDefRe = 1.0_JPRB / ZRefDe
    IRADLP = NRADLP

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

          ! very old parametrization as f(pressure)

          IF (IRADLP == 0) THEN
             !WRITE(NULOUT,*) 'FEEDCOSP: USING VERY OLD EFFECTIVE RADIUS (LP) PARAMETRIZATION AS F(PRESSURE) ERA-15'
             ZRADLP(JL)=10.0_JPRB + (100000.0_JPRB-PAP(JL,JK))*3.5_JPRB

          ELSEIF (IRADLP == 1) THEN
             !WRITE(NULOUT,*) 'FEEDCOSP: EFFECTIVE RADIUS (LP): USING SIMPLE DISTINCTION BETWEEN LAND (10) AND OCEAN (13) ZHANG AND ROSSOW'
             IF (PLSM(JL) < 0.5_JPRB) THEN
                ZRADLP(JL)=13.0_JPRB
             ELSE
                ZRADLP(JL)=10.0_JPRB
             ENDIF

          ELSEIF (IRADLP == 2) THEN
             !WRITE(NULOUT,*) ' FEEDCOSP: MAKE EFFECTIVE RADIUS (LP) BASED ON MARTIN ET AL., 1994, JAS'
             IF (PLSM(JL) < 0.5_JPRB) THEN
                IF (LCCNO) THEN
                   !          ZASEA=50.0_JPRB
                   ZASEA=ZCCNO(JL)
                ELSE
                   ZASEA=RCCNSEA
                ENDIF
                ! Spectral dispersion of the droplet size distribution over sea
                ! ZD = 0.33_JPRB
                ! Constant (k) relating volume radius to effective radius rv^3=k*re^3
                ! k = (1.0+ZD*ZD)^3)/((1.0+3.0*ZD*ZD)^2)
                ! ZK=(1.0_JPRB+ZD*ZD)**3/(1.0_JPRB+3.0_JPRB*ZD*ZD)**2
                ZK = 0.77_JPRB
                ! Cloud droplet concentration in cm-3 (activated CCN) over ocean
                ZNTOT=-1.15E-03_JPRB*ZASEA*ZASEA+0.963_JPRB*ZASEA+5.30_JPRB
             ELSE
                IF (LCCNL) THEN
                   !          ZALND=900.0_JPRB
                   ZALND=ZCCNL(JL)
                ELSE
                   ZALND=RCCNLND
                ENDIF
                ! Spectral dispersion (d) of the droplet size distribution over land
                ! ZD=0.43_JPRB
                ! Constant (k) relating volume radius to effective radius rv^3=k*re^3
                ! k = (1.0_JPRB+ZD*ZD)^3)/((1.0_JPRB+3.0_JPRB*ZD*ZD)^2)
                ! ZK=(1.0_JPRB+ZD*ZD)**3/(1.0_JPRB+3.0_JPRB*ZD*ZD)**2
                ZK = 0.69_JPRB
                ! Cloud droplet concentration in cm-3 (activated CCN) over land
                ZNTOT=-2.10E-04*ZALND*ZALND+0.568_JPRB*ZALND-27.9_JPRB
             ENDIF

             ZNUM  = 3.0_JPRB*(ZLWC(JL,JK)+ZRWC(JL,JK))
             ZDEN  = 4.0_JPRB*RPI*ZNTOT*ZK ! *density of water 1000 kg m-3
             ZTEMP = 1.0_JPRB/ZDEN
             ! So for ZTEMP in SI units
             ! g m-3 and cm-3 units cancel out with density of water 10^6/(1000*1000)
             ! Need a factor of 10^6 to convert to microns
             ! and cubed root is factor of 100 which appears in ZRADLP equation below

             ! Adjustment to Martin_et_al(1994) effective radius
             ! from Wood(2000) param (Eq. 19)
             IF (ZLWC(JL,JK) > REPSCW) THEN
                !      IF (ZLWC(JL,JK) > REPSCW .AND. PLSM(JL) < 0.5_JPRB) THEN
                ZRLRATIO  = ZRWC(JL,JK)/ZLWC(JL,JK)
                ZKL       = 0.222_JPRB
                ZKRATIO   = (ZKL/ZK)**0.333_JPRB
                ZREFACDEN = 1.0_JPRB+0.2_JPRB*ZKRATIO*ZRLRATIO
                ZREFAC    = ((1.0_JPRB+ZRLRATIO)**0.666_JPRB)/ZREFACDEN
             ELSE
                ZREFAC    = 1.0_JPRB
             ENDIF

             IF((ZNUM*ZTEMP) > REPLOG)THEN

                ! R_eff=100*(ZNUM/ZDEN)^0.333, factor of 100 to convert from m to microns
                ZRADLP(JL)=100._JPRB*ZREFAC*EXP(0.333_JPRB*LOG(ZNUM*ZTEMP))

                ! Limit effective radius to within defined range
                ZRADLP(JL)=MAX(ZRADLP(JL), 4.0_JPRB)
                ZRADLP(JL)=MIN(ZRADLP(JL),30.0_JPRB)
             ELSE
                ZRADLP(JL)=4.0_JPRB
             ENDIF
          ELSEIF (IRADLP == 3) THEN
             !WRITE(NULOUT,*) 'FEEDCOSP: EFFECTIVE RADIUS (LP) OF DROPLETS LINKED TO PROGNOSTIC AEROSOL USING MEMON ET AL CCN'
             ZRADLP(JL) = ZRE_LIQ(JL,JK)
             ZRADLP(JL)=MAX(ZRADLP(JL), 2.0_JPRB)
             ZRADLP(JL)=MIN(ZRADLP(JL),24.0_JPRB)
          ENDIF
          ZRADLI(JL,JK)=ZRADLP(JL)
       ENDDO

       DO JL = KIDIA,KFDIA

          ! diagnosing the ice particle effective radius/diameter
          ! WRITE(NULOUT,*) 'FEEDCOSP: 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)=326.3_JPRB+ZTEMPC*(12.42_JPRB + ZTEMPC*(0.197_JPRB + ZTEMPC*&
               & 0.0012_JPRB))

          IF (NRADIP == 0) THEN
             !WRITE(NULOUT,*) 'FEEDCOSP: (RE ICE) FIXED 40 MICRON EFFECTIVE RADIUS'
             ZRADIP(JL)= 40.0_JPRB
             ZDESR(JL)= ZdefRe * ZRADIP(JL)
          ELSEIF (NRADIP == 1) THEN
             !WRITE(NULOUT,*) 'FEEDCOSP: (RE ICE) OLD FORMULATION BASED ON LIOU & OU (1994) TEMPERATURE (40-130MICRONS)'
             ZRADIP(JL)=MAX(ZRADIP(JL), 40.0_JPRB)
             ZRADIP(JL)=MIN(ZRADIP(JL),130.0_JPRB)
             ZDESR(JL)= ZdefRe * ZRADIP(JL)

          ELSEIF (NRADIP == 2) THEN
             !WRITE(NULOUT,*) 'FEEDCOSP: (RE ICE) FORMULATION FOLLOWING JAKOB, KLEIN MODIFICATIONS TO ICE CONTENT'
             ZRADIP(JL)=MAX(ZRADIP(JL),30.0_JPRB)
             ZRADIP(JL)=MIN(ZRADIP(JL),60.0_JPRB)
             ZDESR(JL)= ZDefRe * ZRADIP(JL)

          ELSEIF (NRADIP == 3  ) THEN
             !WRITE(NULOUT,*) 'FEEDCOSP: ICE PARTICLE EFFECTIVE RADIUS = F(T,IWC) FROM SUN AND RIKUS (1999)'
             ! revised by Sun (2001)
             IF (ZIWC(JL,JK)+ZSWC(JL,JK) > 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,JK)+ZSWC(JL,JK))**0.2214_JPRB
                ZBIWC = 0.7957_JPRB * (ZIWC(JL,JK)+ZSWC(JL,JK))**0.2535_JPRB
                ZDESR(JL) = ZFSR * (ZAIWC + ZBIWC*ZTEMPC)
                ZDESR(JL) = MIN ( MAX( ZDESR(JL), ZMINICE(JL)), 155.0_JPRB)
                ZRADIP(JL)= ZRefDe * ZDESR(JL)
             ELSE
                ZDESR(JL) = 80.0_JPRB
                ZRADIP(JL)= ZRefDe * ZDESR(JL)
             ENDIF
          ENDIF

          ZRADIC(JL,JK)=ZRADIP(JL)
          ZDESIC(JL,JK)=ZDESR(JL)

          !Store for output diagnostic
          PRADLI(JL,JK) = ZRADLI(JL,JK)
          PRADIC(JL,JK) = ZRADIC(JL,JK)

       ENDDO
    ENDDO

    !     -----------------------------------------------------------------
    DO JL=KIDIA,KFDIA
       ZTOLW(JL,:) = 0.0_JPRB
       ZTOSW(JL,:) = 0.0_JPRB
       ZOMSW(JL,:) = 1.0_JPRB
       ZASSW(JL,:) = 0.0_JPRB
    ENDDO


    !          2.1    CLOUD SHORTWAVE OPTICAL PROPERTIES
    !                 ----------------------------------
    !- cloud optical properties computed for interval 9 (12850-16000 cm-1)

    JSW=9
    DO JK=1,KLEV
       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
          ZTOR=0.0_JPRB
          ZGR =0.0_JPRB
          ZOR =0.0_JPRB
          IF (ZFLWP(JL,JK) > REPSCW .OR. ZFIWP(JL,JK) > REPSCW &
               &   .OR. ZFSWP(JL,JK) > REPSCW ) THEN
             IF (ZFLWP(JL,JK) > REPSCW ) THEN
                IF (NLIQOPT /= 0 ) THEN
                   !WRITE(NULOUT,*) 'SW LIQ OPTICAL DEPTH: Slingo, 1989'
                   ZTOL = ZFLWP(JL,JK)*(RSASWA(JSW)+RSASWB(JSW)/ZRADLI(JL,JK))
                   ZGL  = RSASWE(JSW)+RSASWF(JSW)*ZRADLI(JL,JK)
                   ZOL  = 1.0_JPRB - RSASWC(JSW)-RSASWD(JSW)*ZRADLI(JL,JK)
                ELSE
                   ZTOL = ZFLWP(JL,JK)*(RSYFWA(JSW)+RSYFWB(JSW)/ZRADLI(JL,JK))
                   ZGL  = RSYFWF(JSW)
                   ZOL  = RSYFWC(JSW)-RSYFWD(JSW)*EXP(-RSYFWE(JSW)*ZTOL)
                ENDIF
             ENDIF

             IF ((ZFIWP(JL,JK)+ZFSWP(JL,JK)) > REPSCW ) THEN
                IF (NICEOPT <= 1) THEN
                   ZTOI = (ZFIWP(JL,JK)+ZFSWP(JL,JK))*(RSECIA(JSW)+RSECIB(JSW)/ZRADIC(JL,JK))
                   ZGI  = RSECIE(JSW)+RSECIF(JSW)*ZRADIC(JL,JK)
                   ZOI  = 1.0_JPRB - RSECIC(JSW)-RSECID(JSW)*ZRADIC(JL,JK)
                ELSEIF (NICEOPT == 2) THEN
                   !WRITE(NULOUT,*) 'SW OPTICAL DEPTH: Fu-Liou 1993'
                   Z1RADI = 1.0_JPRB / ZDESIC(JL,JK)
                   ZBETAI = RSFLA0(JSW)+Z1RADI* RSFLA1(JSW)
                   ZTOI = (ZFIWP(JL,JK)+ZFSWP(JL,JK)) * ZBETAI
                   ZOMGI= RSFLB0(JSW)+ZRADIC(JL,JK)*(RSFLB1(JSW) + ZRADIC(JL,JK) &
                        & *(RSFLB2(JSW)+ZRADIC(JL,JK)* RSFLB3(JSW) ))
                   ZOI  = 1.0_JPRB - ZOMGI
                   ZOMGP= RSFLC0(JSW)+ZRADIC(JL,JK)*(RSFLC1(JSW) + ZRADIC(JL,JK) &
                        & *(RSFLC2(JSW)+ZRADIC(JL,JK)* RSFLC3(JSW) ))
                   ZFDEL= RSFLD0(JSW)+ZRADIC(JL,JK)*(RSFLD1(JSW) + ZRADIC(JL,JK) &
                        & *(RSFLD2(JSW)+ZRADIC(JL,JK)* RSFLD3(JSW) ))
                   ZGI  = ((1.0_JPRB-ZFDEL)*ZOMGP + ZFDEL*3.0_JPRB) *0.33333_JPRB
                ELSEIF (NICEOPT == 3) THEN
                   !WRITE(NULOUT,*) 'SW ICE OPTICAL DEPTH: Fu 1996'
                   Z1RADI = 1.0_JPRB / ZDESIC(JL,JK)
                   ZBETAI = RSFUA0(JSW)+Z1RADI* RSFUA1(JSW)
                   ZTOI = (ZFIWP(JL,JK)+ZFSWP(JL,JK)) * ZBETAI
                   ZOMGI= RSFUB0(JSW)+ZDESIC(JL,JK)*(RSFUB1(JSW) + ZDESIC(JL,JK) &
                        & *(RSFUB2(JSW)+ZDESIC(JL,JK)* RSFUB3(JSW) ))
                   ZOI  = 1.0_JPRB - ZOMGI
                   ZGI  = RSFUC0(JSW)+ZDESIC(JL,JK)*(RSFUC1(JSW) + ZDESIC(JL,JK) &
                        & *(RSFUC2(JSW)+ZDESIC(JL,JK)* RSFUC3(JSW) ))
                   ZGI  = MIN(1.0_JPRB, ZGI)
                ENDIF
             ENDIF

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

             ZASYMX= ZASYMX/ZOMGMX
             ZOMGMX= ZOMGMX/ZTAUMX

             ! --- SW FINAL CLOUD OPTICAL PARAMETERS

             ZTOSW(JL,JK) = ZTAUMX
             ZOMSW(JL,JK) = ZOMGMX
             ZASSW(JL,JK) = ZASYMX
          ENDIF
          PDTAUS(JL,JK)=ZTOSW(JL,JK)
          PDTAUC(JL,JK)=0.0_JPRB
       ENDDO
    ENDDO

    !          2.2    CLOUD LONGWAVE OPTICAL PROPERTIES FOR RRTM
    !                 ------------------------------------------
    !- cloud optical properties computed for interval 6 (820-980 cm-1)

    JRTM=6
    DO JK=1,KLEV
       DO JL = KIDIA,KFDIA
          ZRSALD = 0.0_JPRB
          ZRSAID = 0.0_JPRB

          IF (ZFLWP(JL,JK)+ZFIWP(JL,JK)+ZFSWP(JL,JK) > REPSCW) THEN

             IF (NLIQOPT == 0 .OR. NLIQOPT >= 3) THEN
                ! water cloud total emissivity a la Smith and Shi (1992)
                ZMULTL=1.2_JPRB-0.006_JPRB*ZRADLI(JL,JK)
                ZRSALD= 0.144_JPRB*ZMULTL *0.60240_JPRB

             ELSEIF (NLIQOPT == 1) THEN
                ! water cloud spectral emissivity a la Savijarvi (1997)
                ZRSALD= RHSAVI(JRTM,1) + ZRADLI(JL,JK)&
                     & *(RHSAVI(JRTM,2) + ZRADLI(JL,JK)*RHSAVI(JRTM,3))

             ELSEIF (NLIQOPT == 2) THEN
                ! water cloud spectral emissivity a la Lindner and Li (2000)
                Z1RADL = 1.0_JPRB / ZRADLI(JL,JK)
                ZEXTCF = RLILIA(JRTM,1)+ZRADLI(JL,JK)*RLILIA(JRTM,2)+ Z1RADL*&
                     & (RLILIA(JRTM,3) + Z1RADL*(RLILIA(JRTM,4) + Z1RADL*&
                     & RLILIA(JRTM,5) ))
                Z1MOMG = RLILIB(JRTM,1) + Z1RADL*RLILIB(JRTM,2) &
                     & + ZRADLI(JL,JK) *(RLILIB(JRTM,3) + ZRADLI(JL,JK)*RLILIB(JRTM,4) )
                ZRSALD = Z1MOMG * ZEXTCF
             ENDIF

             IF (NICEOPT == 0) THEN
                ! ice cloud spectral emissivity a la Smith & Shi (1992)
                ZMULTI=1.2_JPRB-0.006_JPRB*ZRADIC(JL,JK)
                ZRSAID= 0.103_JPRB*ZMULTI *0.60240_JPRB

             ELSEIF (NICEOPT == 1) THEN
                ! ice cloud spectral emissivity a la Ebert-Curry (1992)
                ZRSAID= REBCUH(JRTM)+REBCUG(JRTM)/ZRADIC(JL,JK)

             ELSEIF (NICEOPT == 2) THEN
                ! ice cloud spectral emissivity a la Fu & Liou (1993)
                Z1RADI= 1.0_JPRB / ZDESIC(JL,JK)
                ZRSAID = RFULIO(JRTM,1) + Z1RADI &
                     & *(RFULIO(JRTM,2) + Z1RADI*RFULIO(JRTM,3))

             ELSEIF (NICEOPT == 3) THEN
                ! ice cloud spectral emissivity a la Fu et al (1998) including
                ! parametrisation for LW scattering effect
                Z1RADI = 1.0_JPRB / ZDESIC(JL,JK)
                ZRSAIE = RFUETA(JRTM,1) + Z1RADI&
                     & *(RFUETA(JRTM,2) + Z1RADI*RFUETA(JRTM,3))
                ZRSAIA = Z1RADI*(RFUETB(JRTM,1) +ZDESIC(JL,JK)*( RFUETB(JRTM,2) +ZDESIC(JL,JK)*&
                     & ( RFUETB(JRTM,3) +ZDESIC(JL,JK)* RFUETB(JRTM,4))))
                ZRSAIG = RFUETC(JRTM,1) +ZDESIC(JL,JK)*( RFUETC(JRTM,2) +ZDESIC(JL,JK)*&
                     & ( RFUETC(JRTM,3) +ZDESIC(JL,JK)* RFUETC(JRTM,4)))
                ZRSAIF = 0.5_JPRB + ZRSAIG*( 0.3738_JPRB + ZRSAIG*( 0.0076_JPRB + ZRSAIG*0.1186_JPRB ) )
                ZRSAID = (1.0_JPRB - ZRSAIA/ZRSAIE * ZRSAIF) * ZRSAIE

             ENDIF

             ZTAUD = ZRSALD*ZFLWP(JL,JK)+ZRSAID*(ZFIWP(JL,JK)+ZFSWP(JL,JK))

             !- for COSP, "vertical" optical thickness
             ZDIFFD=1.0_JPRB
             ZTOLW(JL,JK) = ZTAUD*ZDIFFD
          ENDIF

          ZEMICLD=1.0_JPRB-EXP(-ZTOLW(JL,JK))
          PDEMS(JL,JK)=ZEMICLD
          PDEMC(JL,JK)=0.0_JPRB

       ENDDO
    ENDDO
    !     -----------------------------------------------------------------
    IF (LHOOK) CALL DR_HOOK('RADFROMGP',1,ZHOOK_HANDLE)
  END SUBROUTINE RADFROMGP

END MODULE YOMCOSP_MAIN
