https://github.com/CFMIP/COSPv1
Raw File
Tip revision: 08f4cce0cde8431403f71ff8fa2c8b5ba7232e29 authored by dustinswales on 17 September 2018, 18:01:01 UTC
Merge pull request #4 from CFMIP/modisLidarBugFix
Tip revision: 08f4cce
cosp_types.F90
! (c) British Crown Copyright 2008, the Met Office.
! All rights reserved.
! 
! Redistribution and use in source and binary forms, with or without modification, are permitted 
! provided that the following conditions are met:
! 
!     * Redistributions of source code must retain the above copyright notice, this list 
!       of conditions and the following disclaimer.
!     * Redistributions in binary form must reproduce the above copyright notice, this list
!       of conditions and the following disclaimer in the documentation and/or other materials 
!       provided with the distribution.
!     * Neither the name of the Met Office nor the names of its contributors may be used 
!       to endorse or promote products derived from this software without specific prior written 
!       permission.
! 
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR 
! IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND 
! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR 
! CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 
! DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 
! DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER 
! IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT 
! OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

MODULE MOD_COSP_TYPES
    USE MOD_COSP_CONSTANTS
    USE MOD_COSP_UTILS

    use radar_simulator_types, only: class_param, nd, mt_nd, dmax, dmin

    IMPLICIT NONE

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!----------------------- DERIVED TYPES ----------------------------    
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

  ! Configuration choices (simulators, variables)
  TYPE COSP_CONFIG
     logical :: Lradar_sim,Llidar_sim,Lisccp_sim,Lmodis_sim,Lmisr_sim,Lrttov_sim,Lstats,Lwrite_output, &
                Lalbisccp,Latb532,Lboxptopisccp,Lboxtauisccp,LcfadDbze94, &
                LcfadLidarsr532,Lclcalipso2,Lclcalipso,Lclhcalipso,Lclisccp,Lcllcalipso, &
                Lclmcalipso,Lcltcalipso,Lcltlidarradar,Lpctisccp,Ldbze94,Ltauisccp,Lcltisccp, &
                Ltoffset,LparasolRefl,LclMISR,Lmeantbisccp,Lmeantbclrisccp, &
                Lclcalipsoliq,Lclcalipsoice,Lclcalipsoun, &
                Lclcalipsotmp,Lclcalipsotmpliq,Lclcalipsotmpice,Lclcalipsotmpun, &
	              Lcltcalipsoliq,Lcltcalipsoice,Lcltcalipsoun, &
                Lclhcalipsoliq,Lclhcalipsoice,Lclhcalipsoun, &
                Lclmcalipsoliq,Lclmcalipsoice,Lclmcalipsoun, &
                Lcllcalipsoliq,Lcllcalipsoice,Lcllcalipsoun, &
                Lfracout,LlidarBetaMol532,Ltbrttov, &
                Lcltmodis,Lclwmodis,Lclimodis,Lclhmodis,Lclmmodis,Lcllmodis,Ltautmodis,Ltauwmodis,Ltauimodis,Ltautlogmodis, &
                Ltauwlogmodis,Ltauilogmodis,Lreffclwmodis,Lreffclimodis,Lpctmodis,Llwpmodis, &
                Liwpmodis,Lclmodis,Lcrimodis,Lcrlmodis

     character(len=32) :: out_list(N_OUT_LIST)
  END TYPE COSP_CONFIG
  
  ! Outputs from RTTOV
  TYPE COSP_RTTOV
     ! Dimensions
     integer :: Npoints   ! Number of gridpoints
     integer :: Nchan     ! Number of channels
     
     ! Brightness temperatures (Npoints,Nchan)
     real,pointer :: tbs(:,:)
     
  END TYPE COSP_RTTOV
  
  ! Outputs from MISR simulator
  TYPE COSP_MISR
     ! Dimensions
     integer :: Npoints   ! Number of gridpoints
     integer :: Ntau      ! Number of tau intervals
     integer :: Nlevels   ! Number of cth levels

     ! --- (npoints,ntau,nlevels)
     !  the fraction of the model grid box covered by each of the MISR cloud types
     real,pointer :: fq_MISR(:,:,:)  
     
     ! --- (npoints)
     real,pointer :: MISR_meanztop(:), MISR_cldarea(:)
     ! --- (npoints,nlevels)
     real,pointer :: MISR_dist_model_layertops(:,:)
  END TYPE COSP_MISR

  ! Outputs from ISCCP simulator
  TYPE COSP_ISCCP
     ! Dimensions
     integer :: Npoints   ! Number of gridpoints
     integer :: Ncolumns  ! Number of columns
     integer :: Nlevels   ! Number of levels

    
     ! --- (npoints,tau=7,pressure=7)
     !  the fraction of the model grid box covered by each of the 49 ISCCP D level cloud types
     real,pointer :: fq_isccp(:,:,:)
     
     ! --- (npoints) ---
     ! The fraction of model grid box columns with cloud somewhere in them.
     ! This should equal the sum over all entries of fq_isccp
     real,pointer :: totalcldarea(:)
     ! mean all-sky 10.5 micron brightness temperature
     real,pointer ::  meantb(:)
     ! mean clear-sky 10.5 micron brightness temperature
     real,pointer ::  meantbclr(:)
     
     ! The following three means are averages over the cloudy areas only.  If no
     ! clouds are in grid box all three quantities should equal zero.
     
     !  mean cloud top pressure (mb) - linear averaging in cloud top pressure.
     real,pointer :: meanptop(:)
     !  mean optical thickness linear averaging in albedo performed.
     real,pointer :: meantaucld(:)
     ! mean cloud albedo. linear averaging in albedo performed 
     real,pointer :: meanalbedocld(:)  
     
     !--- (npoints,ncol) ---
     !  optical thickness in each column     
     real,pointer :: boxtau(:,:)
     !  cloud top pressure (mb) in each column
     real,pointer :: boxptop(:,:)        
  END TYPE COSP_ISCCP
  
  ! Summary statistics from radar
  TYPE COSP_VGRID
    logical :: use_vgrid ! Logical flag that indicates change of grid
    logical :: csat_vgrid ! Flag for Cloudsat grid
    integer :: Npoints   ! Number of sampled points
    integer :: Ncolumns  ! Number of subgrid columns
    integer :: Nlevels   ! Number of model levels
    integer :: Nlvgrid   ! Number of levels of new grid
    ! Array with dimensions (Nlvgrid)
    real, dimension(:), pointer :: z,zl,zu ! Height and lower and upper boundaries of new levels
    ! Array with dimensions (Nlevels)
    real, dimension(:), pointer :: mz,mzl,mzu ! Height and lower and upper boundaries of model levels
  END TYPE COSP_VGRID
  
  ! Output data from lidar code
  TYPE COSP_SGLIDAR
    ! Dimensions
    integer :: Npoints   ! Number of gridpoints
    integer :: Ncolumns  ! Number of columns
    integer :: Nlevels   ! Number of levels
    integer :: Nhydro    ! Number of hydrometeors    
    integer :: Nrefl     ! Number of parasol reflectances
    ! Arrays with dimensions (Npoints,Nlevels)
    real,dimension(:,:),pointer :: beta_mol   ! Molecular backscatter
    real,dimension(:,:),pointer :: temp_tot
    ! Arrays with dimensions (Npoints,Ncolumns,Nlevels)
    real,dimension(:,:,:),pointer :: betaperp_tot   ! Total backscattered signal
    real,dimension(:,:,:),pointer :: beta_tot   ! Total backscattered signal
    real,dimension(:,:,:),pointer :: tau_tot    ! Optical thickness integrated from top to level z
    ! Arrays with dimensions (Npoints,Ncolumns,Nrefl)
    real,dimension(:,:,:),pointer :: refl       ! parasol reflectances
  END TYPE COSP_SGLIDAR
  
  ! Output data from radar code
  TYPE COSP_SGRADAR
    ! Dimensions
    integer :: Npoints   ! Number of gridpoints
    integer :: Ncolumns  ! Number of columns
    integer :: Nlevels   ! Number of levels
    integer :: Nhydro    ! Number of hydrometeors
    ! output vertical levels: spaceborne radar -> from TOA to SURFACE
    ! Arrays with dimensions (Npoints,Nlevels)
    real,dimension(:,:),pointer :: att_gas ! 2-way attenuation by gases [dBZ]
    ! Arrays with dimensions (Npoints,Ncolumns,Nlevels)
    real,dimension(:,:,:),pointer :: Ze_tot ! Effective reflectivity factor [dBZ]
 
  END TYPE COSP_SGRADAR

  
  ! Summary statistics from radar
  TYPE COSP_RADARSTATS
    integer :: Npoints  ! Number of sampled points
    integer :: Ncolumns ! Number of subgrid columns
    integer :: Nlevels  ! Number of model levels
    integer :: Nhydro   ! Number of hydrometeors
    ! Array with dimensions (Npoints,dBZe_bins,Nlevels)
    real, dimension(:,:,:), pointer :: cfad_ze ! Ze CFAD
    ! Array with dimensions (Npoints)
    real,dimension(:),pointer :: radar_lidar_tcc ! Radar&lidar total cloud amount, grid-box scale
    ! Arrays with dimensions (Npoints,Nlevels)
    real, dimension(:,:),pointer :: lidar_only_freq_cloud
  END TYPE COSP_RADARSTATS

  ! Summary statistics from lidar
  TYPE COSP_LIDARSTATS
    integer :: Npoints  ! Number of sampled points
    integer :: Ncolumns ! Number of subgrid columns
    integer :: Nlevels  ! Number of model levels
    integer :: Nhydro   ! Number of hydrometeors
    integer :: Nrefl    ! Number of parasol reflectances
    
    ! Arrays with dimensions (SR_BINS)
    real, dimension(:),pointer :: srbval ! SR bins in cfad_sr
    ! Arrays with dimensions (Npoints,SR_BINS,Nlevels)
    real, dimension(:,:,:),pointer :: cfad_sr   ! CFAD of scattering ratio
    ! Arrays with dimensions (Npoints,Nlevels)
    real, dimension(:,:),pointer :: lidarcld    ! 3D "lidar" cloud fraction 
    ! Arrays with dimensions (Npoints,LIDAR_NCAT)
    real, dimension(:,:),pointer :: cldlayer      ! low, mid, high-level, total lidar cloud cover
   ! Arrays with dimensions (Npoints,Nlevels,Nphase)
    real, dimension(:,:,:),pointer :: lidarcldphase    ! 3D "lidar" phase cloud fraction 
     ! Arrays with dimensions (Npoints,LIDAR_NCAT,Nphase)
    real, dimension(:,:,:),pointer :: cldlayerphase      ! low, mid, high-level lidar phase cloud cover
    ! Arrays with dimensions (Npoints,Ntemps,Nphase)
    real, dimension(:,:,:),pointer :: lidarcldtmp    ! 3D "lidar" phase cloud temperature
    ! Arrays with dimensions (Npoints,PARASOL_NREFL)
    real, dimension(:,:),pointer :: parasolrefl   ! mean parasol reflectance

  END TYPE COSP_LIDARSTATS

    
  ! Input data for simulator. Subgrid scale.
  ! Input data from SURFACE to TOA
  TYPE COSP_SUBGRID
    ! Dimensions
    integer :: Npoints   ! Number of gridpoints
    integer :: Ncolumns  ! Number of columns
    integer :: Nlevels   ! Number of levels
    integer :: Nhydro    ! Number of hydrometeors
    
    real,dimension(:,:,:),pointer :: prec_frac  ! Subgrid precip array. Dimensions (Npoints,Ncolumns,Nlevels)
    real,dimension(:,:,:),pointer :: frac_out  ! Subgrid cloud array. Dimensions (Npoints,Ncolumns,Nlevels)
  END TYPE COSP_SUBGRID

  ! Input data for simulator at Subgrid scale.
  ! Used on a reduced number of points
  TYPE COSP_SGHYDRO
    ! Dimensions
    integer :: Npoints   ! Number of gridpoints
    integer :: Ncolumns  ! Number of columns
    integer :: Nlevels   ! Number of levels
    integer :: Nhydro    ! Number of hydrometeors
    real,dimension(:,:,:,:),pointer :: mr_hydro ! Mixing ratio of each hydrometeor 
                                                ! (Npoints,Ncolumns,Nlevels,Nhydro) [kg/kg]
    real,dimension(:,:,:,:),pointer :: Reff     ! Effective Radius of each hydrometeor
                                                ! (Reff==0 means use default size)   
                                                ! (Npoints,Ncolumns,Nlevels,Nhydro) [m]
    real,dimension(:,:,:,:),pointer :: Np       ! Total # concentration each hydrometeor 
                                                ! (Optional, ignored if Reff > 0).
                                                ! (Npoints,Ncolumns,Nlevels,Nhydro) [#/kg]
                                                ! Np = Ntot / rho_a  = [#/m^3] / [kg/m^3) 
                                                ! added by Roj with Quickbeam V3
  END TYPE COSP_SGHYDRO
  
  ! Input data for simulator. Gridbox scale.
  TYPE COSP_GRIDBOX
    ! Scalars and dimensions
    integer :: Npoints   ! Number of gridpoints
    integer :: Nlevels   ! Number of levels
    integer :: Ncolumns  ! Number of columns
    integer :: Nhydro    ! Number of hydrometeors
    integer :: Nprmts_max_hydro    ! Max number of parameters for hydrometeor size distributions
    integer :: Naero    ! Number of aerosol species
    integer :: Nprmts_max_aero    ! Max number of parameters for aerosol size distributions
    integer :: Npoints_it   ! Max number of gridpoints to be processed in one iteration
    
    ! Time [days]
    double precision :: time
    double precision :: time_bnds(2)
    
    ! Radar ancillary info
    real :: radar_freq, & ! Radar frequency [GHz]
            k2 ! |K|^2, -1=use frequency dependent default
    integer :: surface_radar, & ! surface=1, spaceborne=0
           use_mie_tables, & ! use a precomputed loopup table? yes=1,no=0
           use_gas_abs, & ! include gaseous absorption? yes=1,no=0
           do_ray, & ! calculate/output Rayleigh refl=1, not=0
           melt_lay ! melting layer model off=0, on=1
 
    ! structures used by radar simulator that need to be set only ONCE per radar configuration (e.g. freq, pointing direction) ... added by roj Feb 2008
    type(class_param) ::  hp    ! structure used by radar simulator to store Ze and N scaling constants and other information
    integer :: nsizes       ! number of discrete drop sizes (um) used to represent the distribution
    
    ! Lidar
    integer :: lidar_ice_type !ice particle shape hypothesis in lidar calculations 
                              !(ice_type=0 for spheres, ice_type=1 for non spherical particles)
    
    ! Radar
    logical ::  use_precipitation_fluxes  ! True if precipitation fluxes are input to the algorithm 
    logical ::  use_reff          ! True if Reff is to be used by radar (memory not allocated
    
    
    ! Geolocation (Npoints)
    real,dimension(:),pointer :: toffset   ! Time offset of esch point from the value in time
    real,dimension(:),pointer :: longitude ! longitude [degrees East]
    real,dimension(:),pointer :: latitude  ! latitude [deg North]
    ! Gridbox information (Npoints,Nlevels)
    real,dimension(:,:),pointer :: zlev ! Height of model levels [m]
    real,dimension(:,:),pointer :: zlev_half ! Height at half model levels [m] (Bottom of model layer)
    real,dimension(:,:),pointer :: dlev ! Depth of model levels  [m]
    real,dimension(:,:),pointer :: p  ! Pressure at full model levels [Pa]
    real,dimension(:,:),pointer :: ph ! Pressure at half model levels [Pa]
    real,dimension(:,:),pointer :: T ! Temperature at model levels [K]
    real,dimension(:,:),pointer :: q  ! Relative humidity to water (%)
    real,dimension(:,:),pointer :: sh ! Specific humidity to water [kg/kg]
    real,dimension(:,:),pointer :: dtau_s ! mean 0.67 micron optical depth of stratiform
                                          !  clouds in each model level
                                          !  NOTE:  this the cloud optical depth of only the
                                          !  cloudy part of the grid box, it is not weighted
                                          !  with the 0 cloud optical depth of the clear
                                          !         part of the grid box
    real,dimension(:,:),pointer :: dtau_c !  mean 0.67 micron optical depth of convective
                                          !  clouds in each model level.  Same note applies as in dtau_s.
    real,dimension(:,:),pointer :: dem_s  !  10.5 micron longwave emissivity of stratiform
                                          !  clouds in each model level.  Same note applies as in dtau_s.
    real,dimension(:,:),pointer :: dem_c  !  10.5 micron longwave emissivity of convective
                                          !  clouds in each model level.  Same note applies as in dtau_s.
    real,dimension(:,:),pointer :: mr_ozone !  Ozone mass mixing ratio [kg/kg]

    ! Point information (Npoints)
    real,dimension(:),pointer :: land !Landmask [0 - Ocean, 1 - Land]
    real,dimension(:),pointer :: psfc !Surface pressure [Pa]
    real,dimension(:),pointer :: sunlit ! (npoints) 1 for day points, 0 for nightime
    real,dimension(:),pointer :: skt  ! Skin temperature (K)
    real,dimension(:),pointer :: u_wind  ! eastward wind [m s-1]
    real,dimension(:),pointer :: v_wind  ! northward wind [m s-1]

    ! TOTAL and CONV cloud fraction for SCOPS
    real,dimension(:,:),pointer :: tca ! Total cloud fraction
    real,dimension(:,:),pointer :: cca ! Convective cloud fraction
    ! Precipitation fluxes on model levels
    real,dimension(:,:),pointer :: rain_ls ! large-scale precipitation flux of rain [kg/m2.s]
    real,dimension(:,:),pointer :: rain_cv ! convective precipitation flux of rain [kg/m2.s]
    real,dimension(:,:),pointer :: snow_ls ! large-scale precipitation flux of snow [kg/m2.s]
    real,dimension(:,:),pointer :: snow_cv ! convective precipitation flux of snow [kg/m2.s]
    real,dimension(:,:),pointer :: grpl_ls ! large-scale precipitation flux of graupel [kg/m2.s]
    ! Hydrometeors concentration and distribution parameters
!     real,dimension(:,:,:),pointer :: fr_hydro ! Fraction of the gridbox occupied by each hydrometeor (Npoints,Nlevels,Nhydro)
    real,dimension(:,:,:),pointer :: mr_hydro ! Mixing ratio of each hydrometeor (Npoints,Nlevels,Nhydro) [kg/kg]
    real,dimension(:,:),pointer   :: dist_prmts_hydro !Distributional parameters for hydrometeors (Nprmts_max_hydro,Nhydro)

    ! Effective radius [m]. (Npoints,Nlevels,Nhydro) -- OPTIONAL, value of 0 mean use fixed default
    real,dimension(:,:,:),pointer :: Reff

    ! Total Number Concentration [#/kg]. (Npoints,Nlevels,Nhydro) -- OPTIONAL, value of 0 mean use fixed default
    real,dimension(:,:,:),pointer :: Np ! added by Roj with Quickbeam V3
 
    ! Aerosols concentration and distribution parameters
    real,dimension(:,:,:),pointer :: conc_aero ! Aerosol concentration for each species (Npoints,Nlevels,Naero)
    integer,dimension(:),pointer :: dist_type_aero ! Particle size distribution type for each aerosol species (Naero)
    real,dimension(:,:,:,:),pointer :: dist_prmts_aero ! Distributional parameters for aerosols 
                                                       ! (Npoints,Nlevels,Nprmts_max_aero,Naero)
    ! ISCCP simulator inputs
    integer :: isccp_top_height !  1 = adjust top height using both a computed
                                !  infrared brightness temperature and the visible
                                !  optical depth to adjust cloud top pressure. Note
                                !  that this calculation is most appropriate to compare
                                !  to ISCCP data during sunlit hours.
                                !  2 = do not adjust top height, that is cloud top
                                !  pressure is the actual cloud top pressure
                                !  in the model
                                !  3 = adjust top height using only the computed
                                !  infrared brightness temperature. Note that this
                                !  calculation is most appropriate to compare to ISCCP
                                !  IR only algortihm (i.e. you can compare to nighttime
                                !  ISCCP data with this option)
    integer :: isccp_top_height_direction ! direction for finding atmosphere pressure level
                                 ! with interpolated temperature equal to the radiance
                                 ! determined cloud-top temperature
                                 ! 1 = find the *lowest* altitude (highest pressure) level
                                 ! with interpolated temperature equal to the radiance
                                 ! determined cloud-top temperature
                                 ! 2 = find the *highest* altitude (lowest pressure) level
                                 ! with interpolated temperature equal to the radiance 
                                 ! determined cloud-top temperature
                                 ! ONLY APPLICABLE IF top_height EQUALS 1 or 3
                                 ! 1 = default setting, and matches all versions of 
                                 ! ISCCP simulator with versions numbers 3.5.1 and lower
                                 ! 2 = experimental setting  
    integer :: isccp_overlap !  overlap type (1=max, 2=rand, 3=max/rand)
    real :: isccp_emsfc_lw      ! 10.5 micron emissivity of surface (fraction)
  
    ! RTTOV inputs/options
    integer :: plat      ! satellite platform
    integer :: sat       ! satellite
    integer :: inst      ! instrument
    integer :: Nchan     ! Number of channels to be computed
    integer, dimension(:), pointer :: Ichan   ! Channel numbers
    real,    dimension(:), pointer :: Surfem  ! Surface emissivity
    real    :: ZenAng ! Satellite Zenith Angles
    real :: co2,ch4,n2o,co ! Mixing ratios of trace gases

  END TYPE COSP_GRIDBOX
 
CONTAINS

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!------------- SUBROUTINE CONSTRUCT_COSP_RTTOV -------------------
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  SUBROUTINE CONSTRUCT_COSP_RTTOV(cfg,Npoints,Nchan,x)
    type(cosp_config),intent(in) :: cfg ! Configuration options
    integer,intent(in) :: Npoints  ! Number of sampled points
    integer,intent(in) :: Nchan ! Number of channels
    type(cosp_rttov),intent(out) :: x
    ! Local variables
    integer :: i,j
    
    ! Allocate minumum storage if simulator not used
    if (cfg%Lrttov_sim) then
      i = Npoints
      j = Nchan
    else
      i = 1
      j = 1
    endif
    x%Npoints  = i
    x%Nchan    = j
      
    ! --- Allocate arrays ---
    allocate(x%tbs(i, j))
    ! --- Initialise to zero ---
    x%tbs     = 0.0
  END SUBROUTINE CONSTRUCT_COSP_RTTOV

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!------------- SUBROUTINE FREE_COSP_RTTOV ------------------------
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  SUBROUTINE FREE_COSP_RTTOV(x)
    type(cosp_rttov),intent(inout) :: x
    
    ! --- Deallocate arrays ---
    deallocate(x%tbs)
  END SUBROUTINE FREE_COSP_RTTOV
  
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!------------- SUBROUTINE CONSTRUCT_COSP_MISR ------------------
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  SUBROUTINE CONSTRUCT_COSP_MISR(cfg,Npoints,x)
    type(cosp_config),intent(in) :: cfg ! Configuration options
    integer,intent(in) :: Npoints   ! Number of gridpoints
    type(cosp_misr),intent(out) :: x
    ! Local variables
    integer :: i,j,k
    
   
    ! Allocate minumum storage if simulator not used
    if (cfg%Lmisr_sim) then
      i = Npoints
      j = 7
      k = MISR_N_CTH
    else
      i = 1
      j = 1
      k = 1
    endif
    
    ! Dimensions
    x%Npoints = i
    x%Ntau    = j
    x%Nlevels = k
    
    ! allocate space for MISR simulator outputs ...
    allocate(x%fq_MISR(i,j,k), x%MISR_meanztop(i),x%MISR_cldarea(i), x%MISR_dist_model_layertops(i,k))
    x%fq_MISR = 0.0
    x%MISR_meanztop = 0.0
    x%MISR_cldarea = 0.0
    x%MISR_dist_model_layertops = 0.0
    
  END SUBROUTINE CONSTRUCT_COSP_MISR
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!------------- SUBROUTINE FREE_COSP_MISR ------------------
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  SUBROUTINE FREE_COSP_MISR(x)
    type(cosp_misr),intent(inout) :: x
    deallocate(x%fq_MISR, x%MISR_meanztop,x%MISR_cldarea, x%MISR_dist_model_layertops)
    
  END SUBROUTINE FREE_COSP_MISR

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!------------- SUBROUTINE CONSTRUCT_COSP_ISCCP ------------------
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  SUBROUTINE CONSTRUCT_COSP_ISCCP(cfg,Npoints,Ncolumns,Nlevels,x)
    type(cosp_config),intent(in) :: cfg ! Configuration options
    integer,intent(in) :: Npoints  ! Number of sampled points
    integer,intent(in) :: Ncolumns ! Number of subgrid columns
    integer,intent(in) :: Nlevels  ! Number of model levels
    type(cosp_isccp),intent(out) :: x
    ! Local variables
    integer :: i,j,k
    
    ! Allocate minumum storage if simulator not used
    if (cfg%Lisccp_sim) then
      i = Npoints
      j = Ncolumns
      k = Nlevels
    else
      i = 1
      j = 1
      k = 1
    endif
    
    ! Dimensions
    x%Npoints  = i
    x%Ncolumns = j
    x%Nlevels  = k
    
    ! --- Allocate arrays ---
    allocate(x%fq_isccp(i,7,7), x%totalcldarea(i), &
         x%meanptop(i), x%meantaucld(i), &
         x%meantb(i), x%meantbclr(i), &
         x%boxtau(i,j), x%boxptop(i,j), &
         x%meanalbedocld(i))
    ! --- Initialise to zero ---
    x%fq_isccp     = 0.0
    x%totalcldarea = 0.0
    x%meanptop     = 0.0
    x%meantaucld   = 0.0
    x%meantb       = 0.0
    x%meantbclr    = 0.0
    x%boxtau       = 0.0
    x%boxptop      = 0.0
    x%meanalbedocld= 0.0
  END SUBROUTINE CONSTRUCT_COSP_ISCCP

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!------------- SUBROUTINE FREE_COSP_ISCCP -----------------------
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  SUBROUTINE FREE_COSP_ISCCP(x)
    type(cosp_isccp),intent(inout) :: x
    
    deallocate(x%fq_isccp, x%totalcldarea, &
         x%meanptop, x%meantaucld, x%meantb, x%meantbclr, &
         x%boxtau, x%boxptop, x%meanalbedocld)
  END SUBROUTINE FREE_COSP_ISCCP
  
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!------------- SUBROUTINE CONSTRUCT_COSP_VGRID ------------------
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  SUBROUTINE CONSTRUCT_COSP_VGRID(gbx,Nlvgrid,use_vgrid,cloudsat,x)
    type(cosp_gridbox),intent(in) :: gbx ! Gridbox information
    integer,intent(in) :: Nlvgrid  ! Number of new levels    
    logical,intent(in) :: use_vgrid! Logical flag that controls the output on a different grid
    logical,intent(in) :: cloudsat ! TRUE if a CloudSat like grid (480m) is requested
    type(cosp_vgrid),intent(out) :: x
    
    ! Local variables
    integer :: i
    real :: zstep
    
    x%use_vgrid  = use_vgrid
    x%csat_vgrid = cloudsat
    
    ! Dimensions
    x%Npoints  = gbx%Npoints
    x%Ncolumns = gbx%Ncolumns
    x%Nlevels  = gbx%Nlevels
    
    ! --- Allocate arrays ---
    if (use_vgrid) then
      x%Nlvgrid = Nlvgrid
    else 
      x%Nlvgrid = gbx%Nlevels
    endif
    allocate(x%z(x%Nlvgrid),x%zl(x%Nlvgrid),x%zu(x%Nlvgrid))
    allocate(x%mz(x%Nlevels),x%mzl(x%Nlevels),x%mzu(x%Nlevels))
    
    ! --- Model vertical levels ---
    ! Use height levels of first model gridbox
    x%mz  = gbx%zlev(1,:)
    x%mzl = gbx%zlev_half(1,:)
    x%mzu(1:x%Nlevels-1) = gbx%zlev_half(1,2:x%Nlevels)
    x%mzu(x%Nlevels) = gbx%zlev(1,x%Nlevels) + (gbx%zlev(1,x%Nlevels) - x%mzl(x%Nlevels))
    
    if (use_vgrid) then
      ! --- Initialise to zero ---
      x%z  = 0.0
      x%zl = 0.0
      x%zu = 0.0
      if (cloudsat) then ! --- CloudSat grid requested ---
         zstep = 480.0
      else
         ! Other grid requested. Constant vertical spacing with top at 20 km
         zstep = 20000.0/x%Nlvgrid
      endif
      do i=1,x%Nlvgrid
         x%zl(i) = (i-1)*zstep
         x%zu(i) = i*zstep
      enddo
      x%z = (x%zl + x%zu)/2.0
    else
      x%z  = x%mz
      x%zl = x%mzl
      x%zu = x%mzu
    endif
    
  END SUBROUTINE CONSTRUCT_COSP_VGRID

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!------------------ SUBROUTINE FREE_COSP_VGRID ------------------
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  SUBROUTINE FREE_COSP_VGRID(x)
    type(cosp_vgrid),intent(inout) :: x

    deallocate(x%z, x%zl, x%zu, x%mz, x%mzl, x%mzu)
  END SUBROUTINE FREE_COSP_VGRID

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!------------- SUBROUTINE CONSTRUCT_COSP_SGLIDAR ------------------
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  SUBROUTINE CONSTRUCT_COSP_SGLIDAR(cfg,Npoints,Ncolumns,Nlevels,Nhydro,Nrefl,x)
    type(cosp_config),intent(in) :: cfg ! Configuration options
    integer,intent(in) :: Npoints  ! Number of sampled points
    integer,intent(in) :: Ncolumns ! Number of subgrid columns
    integer,intent(in) :: Nlevels  ! Number of model levels
    integer,intent(in) :: Nhydro   ! Number of hydrometeors
    integer,intent(in) :: Nrefl    ! Number of parasol reflectances ! parasol
    type(cosp_sglidar),intent(out) :: x
    ! Local variables
    integer :: i,j,k,l,m
    
    ! Allocate minumum storage if simulator not used
    if (cfg%Llidar_sim) then
      i = Npoints
      j = Ncolumns
      k = Nlevels
      l = Nhydro
      m = Nrefl
    else
      i = 1
      j = 1
      k = 1
      l = 1
      m = 1
    endif
    
    ! Dimensions
    x%Npoints  = i
    x%Ncolumns = j
    x%Nlevels  = k
    x%Nhydro   = l
    x%Nrefl    = m
    
    ! --- Allocate arrays ---
    allocate(x%beta_mol(i,k), x%beta_tot(i,j,k), &
             x%tau_tot(i,j,k),x%refl(i,j,m), &
             x%temp_tot(i,k),x%betaperp_tot(i,j,k))
    ! --- Initialise to zero ---
    x%beta_mol   = 0.0
    x%beta_tot   = 0.0
    x%tau_tot    = 0.0
    x%refl       = 0.0 ! parasol
    x%temp_tot   	= 0.0
    x%betaperp_tot 	= 0.0	
  END SUBROUTINE CONSTRUCT_COSP_SGLIDAR

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!------------------ SUBROUTINE FREE_COSP_SGLIDAR ------------------
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  SUBROUTINE FREE_COSP_SGLIDAR(x)
    type(cosp_sglidar),intent(inout) :: x

    deallocate(x%beta_mol, x%beta_tot, x%tau_tot, x%refl, &
               x%temp_tot, x%betaperp_tot)

  END SUBROUTINE FREE_COSP_SGLIDAR

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!------------- SUBROUTINE CONSTRUCT_COSP_SGRADAR ------------------
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  SUBROUTINE CONSTRUCT_COSP_SGRADAR(cfg,Npoints,Ncolumns,Nlevels,Nhydro,x)
    type(cosp_config),intent(in) :: cfg ! Configuration options
    integer,intent(in) :: Npoints  ! Number of sampled points
    integer,intent(in) :: Ncolumns ! Number of subgrid columns
    integer,intent(in) :: Nlevels  ! Number of model levels
    integer,intent(in) :: Nhydro   ! Number of hydrometeors
    type(cosp_sgradar),intent(out) :: x
    ! Local variables
    integer :: i,j,k,l
    
    if (cfg%Lradar_sim) then
      i = Npoints
      j = Ncolumns
      k = Nlevels
      l = Nhydro
    else ! Allocate minumum storage if simulator not used
      i = 1
      j = 1
      k = 1
      l = 1
    endif
    
    ! Dimensions
    x%Npoints  = i
    x%Ncolumns = j
    x%Nlevels  = k
    x%Nhydro   = l
    
    ! --- Allocate arrays ---
    allocate(x%att_gas(i,k), x%Ze_tot(i,j,k))
    ! --- Initialise to zero ---
    x%att_gas   = 0.0
    x%Ze_tot    = 0.0
    ! The following line give a compilation error on the Met Office NEC
!     call zero_real(x%Z_hydro, x%att_hydro)
!     f90: error(666): cosp_types.f90, line nnn:
!                                        Actual argument corresponding to dummy
!                                        argument of ELEMENTAL subroutine
!                                        "zero_real" with INTENET(OUT) attribute
!                                        is not array.
  END SUBROUTINE CONSTRUCT_COSP_SGRADAR

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!------------------ SUBROUTINE FREE_COSP_SGRADAR ----------------
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  SUBROUTINE FREE_COSP_SGRADAR(x)
    type(cosp_sgradar),intent(inout) :: x

    deallocate(x%att_gas, x%Ze_tot)
  END SUBROUTINE FREE_COSP_SGRADAR

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!----------- SUBROUTINE CONSTRUCT_COSP_RADARSTATS ---------------
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  SUBROUTINE CONSTRUCT_COSP_RADARSTATS(cfg,Npoints,Ncolumns,Nlevels,Nhydro,x)
    type(cosp_config),intent(in) :: cfg ! Configuration options
    integer,intent(in) :: Npoints  ! Number of sampled points
    integer,intent(in) :: Ncolumns ! Number of subgrid columns
    integer,intent(in) :: Nlevels  ! Number of model levels
    integer,intent(in) :: Nhydro   ! Number of hydrometeors
    type(cosp_radarstats),intent(out) :: x    
    ! Local variables
    integer :: i,j,k,l
    
    ! Allocate minumum storage if simulator not used
    if (cfg%Lradar_sim) then
      i = Npoints
      j = Ncolumns
      k = Nlevels
      l = Nhydro
    else
      i = 1
      j = 1
      k = 1
      l = 1
    endif
    
    ! Dimensions
    x%Npoints  = i
    x%Ncolumns = j
    x%Nlevels  = k
    x%Nhydro   = l
    
    ! --- Allocate arrays ---
    allocate(x%cfad_ze(i,DBZE_BINS,k),x%lidar_only_freq_cloud(i,k))
    allocate(x%radar_lidar_tcc(i))
    ! --- Initialise to zero ---
    x%cfad_ze = 0.0
    x%lidar_only_freq_cloud = 0.0
    x%radar_lidar_tcc = 0.0
  END SUBROUTINE CONSTRUCT_COSP_RADARSTATS

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!------------------ SUBROUTINE FREE_COSP_RADARSTATS -------------
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  SUBROUTINE FREE_COSP_RADARSTATS(x)
    type(cosp_radarstats),intent(inout) :: x

    deallocate(x%cfad_ze,x%lidar_only_freq_cloud,x%radar_lidar_tcc)
  END SUBROUTINE FREE_COSP_RADARSTATS

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!----------- SUBROUTINE CONSTRUCT_COSP_LIDARSTATS ---------------
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  SUBROUTINE CONSTRUCT_COSP_LIDARSTATS(cfg,Npoints,Ncolumns,Nlevels,Nhydro,Nrefl,x)
    type(cosp_config),intent(in) :: cfg ! Configuration options
    integer,intent(in) :: Npoints  ! Number of sampled points
    integer,intent(in) :: Ncolumns ! Number of subgrid columns
    integer,intent(in) :: Nlevels  ! Number of model levels
    integer,intent(in) :: Nhydro   ! Number of hydrometeors
    integer,intent(in) :: Nrefl    ! Number of parasol reflectance
    type(cosp_lidarstats),intent(out) :: x
    ! Local variables
    integer :: i,j,k,l,m
    
    ! Allocate minumum storage if simulator not used
    if (cfg%Llidar_sim) then
      i = Npoints
      j = Ncolumns
      k = Nlevels
      l = Nhydro
      m = Nrefl
    else
      i = 1
      j = 1
      k = 1
      l = 1
      m = 1
    endif
    
    ! Dimensions
    x%Npoints  = i
    x%Ncolumns = j
    x%Nlevels  = k
    x%Nhydro   = l
    x%Nrefl    = m
    
    ! --- Allocate arrays ---
    allocate(x%srbval(SR_BINS),x%cfad_sr(i,SR_BINS,k), &
             x%lidarcld(i,k), x%cldlayer(i,LIDAR_NCAT), x%parasolrefl(i,m))
    allocate(x%lidarcldphase(i,k,6),x%lidarcldtmp(i,LIDAR_NTEMP,5),&
             x%cldlayerphase(i,LIDAR_NCAT,6))
    ! --- Initialise to zero ---
    x%srbval    = 0.0
    x%cfad_sr   = 0.0
    x%lidarcld  = 0.0
    x%cldlayer  = 0.0
    x%parasolrefl  = 0.0
    x%lidarcldphase  = 0.0
    x%cldlayerphase  = 0.0
    x%lidarcldtmp  = 0.0

   END SUBROUTINE CONSTRUCT_COSP_LIDARSTATS

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!------------------ SUBROUTINE FREE_COSP_LIDARSTATS -------------
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  SUBROUTINE FREE_COSP_LIDARSTATS(x)
    type(cosp_lidarstats),intent(inout) :: x

    deallocate(x%srbval, x%cfad_sr, x%lidarcld, x%cldlayer, x%parasolrefl)
    deallocate(x%cldlayerphase, x%lidarcldtmp, x%lidarcldphase)
  END SUBROUTINE FREE_COSP_LIDARSTATS


!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!------------- SUBROUTINE CONSTRUCT_COSP_SUBGRID ------------------
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  SUBROUTINE CONSTRUCT_COSP_SUBGRID(Npoints,Ncolumns,Nlevels,y)
    integer,intent(in) :: Npoints, & ! Number of gridpoints
                                        Ncolumns, & ! Number of columns
                                        Nlevels   ! Number of levels
    type(cosp_subgrid),intent(out) :: y
    
    ! Dimensions
    y%Npoints  = Npoints
    y%Ncolumns = Ncolumns
    y%Nlevels  = Nlevels

    ! --- Allocate arrays ---
    allocate(y%frac_out(Npoints,Ncolumns,Nlevels))
    if (Ncolumns > 1) then
      allocate(y%prec_frac(Npoints,Ncolumns,Nlevels))
    else ! CRM mode, not needed
      allocate(y%prec_frac(1,1,1))
    endif
    ! --- Initialise to zero ---
    y%prec_frac = 0.0
    y%frac_out  = 0.0
    ! The following line gives a compilation error on the Met Office NEC
!     call zero_real(y%mr_hydro)
!     f90: error(666): cosp_types.f90, line nnn:
!                                        Actual argument corresponding to dummy
!                                        argument of ELEMENTAL subroutine
!                                        "zero_real" with INTENET(OUT) attribute
!                                        is not array.

  END SUBROUTINE CONSTRUCT_COSP_SUBGRID

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!------------- SUBROUTINE FREE_COSP_SUBGRID -----------------------
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  SUBROUTINE FREE_COSP_SUBGRID(y)
    type(cosp_subgrid),intent(inout) :: y
    
    ! --- Deallocate arrays ---
    deallocate(y%prec_frac, y%frac_out)
        
  END SUBROUTINE FREE_COSP_SUBGRID

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!------------- SUBROUTINE CONSTRUCT_COSP_SGHYDRO -----------------
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  SUBROUTINE CONSTRUCT_COSP_SGHYDRO(Npoints,Ncolumns,Nlevels,Nhydro,y)
    integer,intent(in) :: Npoints, & ! Number of gridpoints
                                        Ncolumns, & ! Number of columns
                                        Nhydro, & ! Number of hydrometeors
                                        Nlevels   ! Number of levels
    type(cosp_sghydro),intent(out) :: y
    
    ! Dimensions
    y%Npoints  = Npoints
    y%Ncolumns = Ncolumns
    y%Nlevels  = Nlevels
    y%Nhydro   = Nhydro

    ! --- Allocate arrays ---
    allocate(y%mr_hydro(Npoints,Ncolumns,Nlevels,Nhydro), &
             y%Reff(Npoints,Ncolumns,Nlevels,Nhydro), &
             y%Np(Npoints,Ncolumns,Nlevels,Nhydro)) ! added by roj with Quickbeam V3
             
    ! --- Initialise to zero ---
    y%mr_hydro = 0.0
    y%Reff     = 0.0
    y%Np       = 0.0                    ! added by roj with Quickbeam V3

  END SUBROUTINE CONSTRUCT_COSP_SGHYDRO

 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!------------- SUBROUTINE FREE_COSP_SGHYDRO -----------------------
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  SUBROUTINE FREE_COSP_SGHYDRO(y)
    type(cosp_sghydro),intent(inout) :: y
    
    ! --- Deallocate arrays ---
    deallocate(y%mr_hydro, y%Reff, y%Np)        ! added by Roj with Quickbeam V3
        
  END SUBROUTINE FREE_COSP_SGHYDRO
 
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!------------- SUBROUTINE CONSTRUCT_COSP_GRIDBOX ------------------
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  SUBROUTINE CONSTRUCT_COSP_GRIDBOX(time,time_bnds,radar_freq,surface_radar,use_mie_tables,use_gas_abs,do_ray,melt_lay,k2, &
                                   Npoints,Nlevels,Ncolumns,Nhydro,Nprmts_max_hydro,Naero,Nprmts_max_aero,Npoints_it, &
                                   lidar_ice_type,isccp_top_height,isccp_top_height_direction,isccp_overlap,isccp_emsfc_lw, &
                                   use_precipitation_fluxes,use_reff, &
                                   ! RTTOV inputs
                                   Plat,Sat,Inst,Nchan,ZenAng,Ichan,SurfEm,co2,ch4,n2o,co,&
                                   y,load_LUT)
    double precision,intent(in) :: time ! Time since start of run [days] 
    double precision,intent(in) :: time_bnds(2) ! Time boundaries
    real,intent(in)    :: radar_freq, & ! Radar frequency [GHz]
                          k2            ! |K|^2, -1=use frequency dependent default
    integer,intent(in) :: &
        surface_radar, &  ! surface=1,spaceborne=0
        use_mie_tables, & ! use a precomputed lookup table? yes=1,no=0,2=use first column everywhere
        use_gas_abs, &    ! include gaseous absorption? yes=1,no=0
        do_ray, &         ! calculate/output Rayleigh refl=1, not=0
        melt_lay          ! melting layer model off=0, on=1
    integer,intent(in) :: Npoints   ! Number of gridpoints
    integer,intent(in) :: Nlevels   ! Number of levels
    integer,intent(in) :: Ncolumns  ! Number of columns
    integer,intent(in) :: Nhydro    ! Number of hydrometeors
    integer,intent(in) :: Nprmts_max_hydro    ! Max number of parameters for hydrometeor size distributions
    integer,intent(in) :: Naero    ! Number of aerosol species
    integer,intent(in) :: Nprmts_max_aero    ! Max number of parameters for aerosol size distributions
    integer,intent(in) :: Npoints_it   ! Number of gridpoints processed in one iteration
    integer,intent(in) :: lidar_ice_type ! Ice particle shape in lidar calculations (0=ice-spheres ; 1=ice-non-spherical)
    integer,intent(in) :: isccp_top_height
    integer,intent(in) :: isccp_top_height_direction
    integer,intent(in) :: isccp_overlap
    real,intent(in)    :: isccp_emsfc_lw
    logical,intent(in) :: use_precipitation_fluxes,use_reff
    integer,intent(in) :: Plat
    integer,intent(in) :: Sat
    integer,intent(in) :: Inst
    integer,intent(in) :: Nchan
    integer,intent(in) :: Ichan(Nchan)
    real,intent(in)    :: SurfEm(Nchan)
    real,intent(in)    :: ZenAng
    real,intent(in)    :: co2,ch4,n2o,co
    type(cosp_gridbox),intent(out) :: y
    logical,intent(in),optional :: load_LUT


    ! local variables
    character*240 :: LUT_file_name
    logical :: local_load_LUT

    if (present(load_LUT)) then
      local_load_LUT = load_LUT
    else
      local_load_LUT = RADAR_SIM_LOAD_scale_LUTs_flag
    endif

    ! Dimensions and scalars
    y%radar_freq       = radar_freq
    y%surface_radar    = surface_radar
    y%use_mie_tables   = use_mie_tables
    y%use_gas_abs      = use_gas_abs
    y%do_ray           = do_ray
    y%melt_lay         = melt_lay
    y%k2               = k2
    y%Npoints          = Npoints
    y%Nlevels          = Nlevels
    y%Ncolumns         = Ncolumns
    y%Nhydro           = Nhydro
    y%Nprmts_max_hydro = Nprmts_max_hydro
    y%Naero            = Naero
    y%Nprmts_max_aero  = Nprmts_max_aero
    y%Npoints_it       = Npoints_it
    y%lidar_ice_type   = lidar_ice_type
    y%isccp_top_height = isccp_top_height
    y%isccp_top_height_direction = isccp_top_height_direction
    y%isccp_overlap    = isccp_overlap
    y%isccp_emsfc_lw   = isccp_emsfc_lw
    y%use_precipitation_fluxes = use_precipitation_fluxes
    y%use_reff = use_reff
    
    y%time      = time
    y%time_bnds = time_bnds
    
    ! RTTOV parameters
    y%Plat   = Plat
    y%Sat    = Sat
    y%Inst   = Inst
    y%Nchan  = Nchan
    y%ZenAng = ZenAng
    y%co2    = co2
    y%ch4    = ch4
    y%n2o    = n2o
    y%co     = co

    ! --- Allocate arrays ---
    ! Gridbox information (Npoints,Nlevels)
    allocate(y%zlev(Npoints,Nlevels), y%zlev_half(Npoints,Nlevels), y%dlev(Npoints,Nlevels), &
             y%p(Npoints,Nlevels), y%ph(Npoints,Nlevels), y%T(Npoints,Nlevels), &
             y%q(Npoints,Nlevels), y%sh(Npoints,Nlevels), &
             y%dtau_s(Npoints,Nlevels), y%dtau_c(Npoints,Nlevels), &
             y%dem_s(Npoints,Nlevels), y%dem_c(Npoints,Nlevels), &
             y%tca(Npoints,Nlevels), y%cca(Npoints,Nlevels), &
             y%rain_ls(Npoints,Nlevels), y%rain_cv(Npoints,Nlevels), y%grpl_ls(Npoints,Nlevels), &
             y%snow_ls(Npoints,Nlevels), y%snow_cv(Npoints,Nlevels),y%mr_ozone(Npoints,Nlevels))
             
             
    ! Surface information and geolocation (Npoints)
    allocate(y%toffset(Npoints), y%longitude(Npoints),y%latitude(Npoints),y%psfc(Npoints), y%land(Npoints), &
             y%sunlit(Npoints),y%skt(Npoints),y%u_wind(Npoints),y%v_wind(Npoints))
    ! Hydrometeors concentration and distribution parameters
    allocate(y%mr_hydro(Npoints,Nlevels,Nhydro), &
             y%dist_prmts_hydro(Nprmts_max_hydro,Nhydro), &
             y%Reff(Npoints,Nlevels,Nhydro), &
             y%Np(Npoints,Nlevels,Nhydro))      ! added by Roj with Quickbeam V3
    ! Aerosols concentration and distribution parameters
    allocate(y%conc_aero(Npoints,Nlevels,Naero), y%dist_type_aero(Naero), &
             y%dist_prmts_aero(Npoints,Nlevels,Nprmts_max_aero,Naero))
    
    ! RTTOV channels and sfc. emissivity
    allocate(y%ichan(Nchan),y%surfem(Nchan))
    
    ! RTTOV parameters
    y%ichan   =  ichan
    y%surfem  =  surfem
    
    ! --- Initialise to zero ---
    y%zlev      = 0.0
    y%zlev_half = 0.0
    y%dlev      = 0.0
    y%p         = 0.0
    y%ph        = 0.0
    y%T         = 0.0
    y%q         = 0.0
    y%sh        = 0.0
    y%dtau_s    = 0.0
    y%dtau_c    = 0.0
    y%dem_s     = 0.0
    y%dem_c     = 0.0
    y%tca       = 0.0
    y%cca       = 0.0
    y%rain_ls   = 0.0
    y%rain_cv   = 0.0
    y%grpl_ls   = 0.0
    y%snow_ls   = 0.0
    y%snow_cv   = 0.0
    y%Reff      = 0.0
    y%Np        = 0.0 ! added by Roj with Quickbeam V3
    y%mr_ozone  = 0.0
    y%u_wind    = 0.0
    y%v_wind    = 0.0

    
    ! (Npoints)
    y%toffset = 0.0
    y%longitude = 0.0
    y%latitude = 0.0
    y%psfc = 0.0
    y%land = 0.0
    y%sunlit = 0.0
    y%skt = 0.0
    ! (Npoints,Nlevels,Nhydro)
!     y%fr_hydro = 0.0
    y%mr_hydro = 0.0
    ! Others
    y%dist_prmts_hydro = 0.0 ! (Nprmts_max_hydro,Nhydro)
    y%conc_aero        = 0.0 ! (Npoints,Nlevels,Naero)
    y%dist_type_aero   = 0   ! (Naero)
    y%dist_prmts_aero  = 0.0 ! (Npoints,Nlevels,Nprmts_max_aero,Naero)


    ! NOTE: This location use to contain initialization of some radar simulator variables
    ! this initialization (including use of the variable "dist_prmts_hydro" - now obselete) 
    ! has been unified in the quickbeam v3 subroutine "radar_simulator_init".   Roj, June 2010

    ! --- Initialize the distributional parameters for hydrometeors in radar simulator

    write(*,*) 'RADAR_SIM microphysics scheme is set to: ', &
            trim(RADAR_SIM_MICROPHYSICS_SCHEME_NAME)


    if(y%Nhydro.ne.N_HYDRO) then

        write(*,*) 'Number of hydrometeor input to subroutine', &
               ' CONSTRUCT_COSP_GRIDBOX does not match value', &
               ' specified in cosp_constants.f90!'
        write(*,*) 
    endif

    ! NOTE: SAVE_scale_LUTs_flag is hard codded as .false. here 
    ! so that radar simulator will NOT update LUT each time it 
    ! is called, but rather will update when "Free_COSP_GRIDBOX" is called!
    ! Roj, June 2010

    LUT_file_name = trim(RADAR_SIM_LUT_DIRECTORY) // &
                trim(RADAR_SIM_MICROPHYSICS_SCHEME_NAME)

    call radar_simulator_init(radar_freq,k2, &
                      use_gas_abs,do_ray,R_UNDEF, &
                      y%Nhydro, &
                      HCLASS_TYPE,HCLASS_PHASE, &
                      HCLASS_DMIN,HCLASS_DMAX, &
                      HCLASS_APM,HCLASS_BPM,HCLASS_RHO, &
                      HCLASS_P1,HCLASS_P2,HCLASS_P3, &
                      local_load_LUT,    &
                      .false., &
                      LUT_file_name, &
                      y%hp)

END SUBROUTINE CONSTRUCT_COSP_GRIDBOX


!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!------------- SUBROUTINE FREE_COSP_GRIDBOX -----------------------
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  SUBROUTINE FREE_COSP_GRIDBOX(y,dglobal,save_LUT)

    use scale_LUTs_io

    type(cosp_gridbox),intent(inout) :: y
    logical,intent(in),optional :: dglobal
    logical,intent(in),optional :: save_LUT

    logical :: local_save_LUT

    if (present(save_LUT)) then
      local_save_LUT = save_LUT
    else
      local_save_LUT = RADAR_SIM_UPDATE_scale_LUTs_flag
    endif

    ! save any updates to radar simulator LUT
    if (local_save_LUT) call save_scale_LUTs(y%hp)

    deallocate(y%zlev, y%zlev_half, y%dlev, y%p, y%ph, y%T, y%q, &
               y%sh, y%dtau_s, y%dtau_c, y%dem_s, y%dem_c, &
               y%toffset, y%longitude,y%latitude,y%psfc, y%land, y%tca, y%cca, &
               y%mr_hydro, y%dist_prmts_hydro, &
               y%conc_aero, y%dist_type_aero, y%dist_prmts_aero, &
               y%rain_ls, y%rain_cv, y%snow_ls, y%snow_cv, y%grpl_ls, &
               y%sunlit, y%skt, y%Reff,y%Np, &
               y%ichan,y%surfem, &
               y%mr_ozone,y%u_wind,y%v_wind)

  END SUBROUTINE FREE_COSP_GRIDBOX

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!------------- SUBROUTINE COSP_GRIDBOX_CPHP ----------------------
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE COSP_GRIDBOX_CPHP(x,y)
    type(cosp_gridbox),intent(in) :: x
    type(cosp_gridbox),intent(inout) :: y

    integer :: i,j,k,sz(3)
    double precision :: tny

    tny = tiny(tny)
    y%hp%p1      = x%hp%p1
    y%hp%p2      = x%hp%p2
    y%hp%p3      = x%hp%p3
    y%hp%dmin    = x%hp%dmin
    y%hp%dmax    = x%hp%dmax
    y%hp%apm     = x%hp%apm
    y%hp%bpm     = x%hp%bpm
    y%hp%rho     = x%hp%rho
    y%hp%dtype   = x%hp%dtype
    y%hp%col     = x%hp%col
    y%hp%cp      = x%hp%cp
    y%hp%phase   = x%hp%phase

    y%hp%fc      = x%hp%fc
    y%hp%rho_eff = x%hp%rho_eff
    ! y%hp%ifc     = x%hp%ifc       obsolete, Roj, June 2010
    ! y%hp%idd     = x%hp%idd
    sz = shape(x%hp%Z_scale_flag)
    do k=1,sz(3)
      do j=1,sz(2)
        do i=1,sz(1)
           if (x%hp%N_scale_flag(i,k))   y%hp%N_scale_flag(i,k)      = .true.
           if (x%hp%Z_scale_flag(i,j,k)) y%hp%Z_scale_flag(i,j,k)    = .true.
           if (abs(x%hp%Ze_scaled(i,j,k)) > tny) y%hp%Ze_scaled(i,j,k) = x%hp%Ze_scaled(i,j,k)
           if (abs(x%hp%Zr_scaled(i,j,k)) > tny) y%hp%Zr_scaled(i,j,k) = x%hp%Zr_scaled(i,j,k)
           if (abs(x%hp%kr_scaled(i,j,k)) > tny) y%hp%kr_scaled(i,j,k) = x%hp%kr_scaled(i,j,k)
        enddo
      enddo
    enddo
    
END SUBROUTINE COSP_GRIDBOX_CPHP

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!------------- SUBROUTINE COSP_GRIDBOX_CPSECTION -----------------
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE COSP_GRIDBOX_CPSECTION(ix,iy,x,y)
    integer,intent(in),dimension(2) :: ix,iy
    type(cosp_gridbox),intent(in) :: x
    type(cosp_gridbox),intent(inout) :: y
    
    ! --- Copy arrays without Npoints as dimension ---
    y%dist_prmts_hydro = x%dist_prmts_hydro
    y%dist_type_aero   = x%dist_type_aero
  
    
!     call cosp_gridbox_cphp(x,y)    
    
    ! 1D
    y%longitude(iy(1):iy(2))  = x%longitude(ix(1):ix(2))
    y%latitude(iy(1):iy(2))   = x%latitude(ix(1):ix(2))
    y%psfc(iy(1):iy(2))       = x%psfc(ix(1):ix(2))
    y%land(iy(1):iy(2))       = x%land(ix(1):ix(2))
    y%sunlit(iy(1):iy(2))     = x%sunlit(ix(1):ix(2))
    y%skt(iy(1):iy(2))        = x%skt(ix(1):ix(2))
    y%u_wind(iy(1):iy(2))     = x%u_wind(ix(1):ix(2))
    y%v_wind(iy(1):iy(2))     = x%v_wind(ix(1):ix(2))
    ! 2D
    y%zlev(iy(1):iy(2),:)      = x%zlev(ix(1):ix(2),:)
    y%zlev_half(iy(1):iy(2),:) = x%zlev_half(ix(1):ix(2),:)
    y%dlev(iy(1):iy(2),:)      = x%dlev(ix(1):ix(2),:)
    y%p(iy(1):iy(2),:)         = x%p(ix(1):ix(2),:)
    y%ph(iy(1):iy(2),:)        = x%ph(ix(1):ix(2),:)
    y%T(iy(1):iy(2),:)         = x%T(ix(1):ix(2),:)
    y%q(iy(1):iy(2),:)         = x%q(ix(1):ix(2),:)
    y%sh(iy(1):iy(2),:)        = x%sh(ix(1):ix(2),:)
    y%dtau_s(iy(1):iy(2),:)    = x%dtau_s(ix(1):ix(2),:)
    y%dtau_c(iy(1):iy(2),:)    = x%dtau_c(ix(1):ix(2),:)
    y%dem_s(iy(1):iy(2),:)     = x%dem_s(ix(1):ix(2),:)
    y%dem_c(iy(1):iy(2),:)     = x%dem_c(ix(1):ix(2),:)
    y%tca(iy(1):iy(2),:)       = x%tca(ix(1):ix(2),:)
    y%cca(iy(1):iy(2),:)       = x%cca(ix(1):ix(2),:)
    y%rain_ls(iy(1):iy(2),:)   = x%rain_ls(ix(1):ix(2),:)
    y%rain_cv(iy(1):iy(2),:)   = x%rain_cv(ix(1):ix(2),:)
    y%grpl_ls(iy(1):iy(2),:)   = x%grpl_ls(ix(1):ix(2),:)
    y%snow_ls(iy(1):iy(2),:)   = x%snow_ls(ix(1):ix(2),:)
    y%snow_cv(iy(1):iy(2),:)   = x%snow_cv(ix(1):ix(2),:)
    y%mr_ozone(iy(1):iy(2),:)  = x%mr_ozone(ix(1):ix(2),:)
    ! 3D
    y%Reff(iy(1):iy(2),:,:)      = x%Reff(ix(1):ix(2),:,:)
    y%Np(iy(1):iy(2),:,:)      = x%Np(ix(1):ix(2),:,:)   ! added by Roj with Quickbeam V3
    y%conc_aero(iy(1):iy(2),:,:) = x%conc_aero(ix(1):ix(2),:,:)
    y%mr_hydro(iy(1):iy(2),:,:)  = x%mr_hydro(ix(1):ix(2),:,:)
    ! 4D
    y%dist_prmts_aero(iy(1):iy(2),:,:,:) = x%dist_prmts_aero(ix(1):ix(2),:,:,:)

END SUBROUTINE COSP_GRIDBOX_CPSECTION
 
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!------------- SUBROUTINE COSP_SUBGRID_CPSECTION -----------------
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE COSP_SUBGRID_CPSECTION(ix,iy,x,y)
    integer,intent(in),dimension(2) :: ix,iy
    type(cosp_subgrid),intent(in) :: x
    type(cosp_subgrid),intent(inout) :: y
    
    y%prec_frac(iy(1):iy(2),:,:)  = x%prec_frac(ix(1):ix(2),:,:)
    y%frac_out(iy(1):iy(2),:,:)   = x%frac_out(ix(1):ix(2),:,:)
END SUBROUTINE COSP_SUBGRID_CPSECTION

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!------------- SUBROUTINE COSP_SGRADAR_CPSECTION -----------------
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE COSP_SGRADAR_CPSECTION(ix,iy,x,y)
    integer,intent(in),dimension(2) :: ix,iy
    type(cosp_sgradar),intent(in) :: x
    type(cosp_sgradar),intent(inout) :: y
    
    y%att_gas(iy(1):iy(2),:)  = x%att_gas(ix(1):ix(2),:)
    y%Ze_tot(iy(1):iy(2),:,:) = x%Ze_tot(ix(1):ix(2),:,:)
END SUBROUTINE COSP_SGRADAR_CPSECTION

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!------------- SUBROUTINE COSP_SGLIDAR_CPSECTION -----------------
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE COSP_SGLIDAR_CPSECTION(ix,iy,x,y)
    integer,intent(in),dimension(2) :: ix,iy
    type(cosp_sglidar),intent(in) :: x
    type(cosp_sglidar),intent(inout) :: y

    y%temp_tot(iy(1):iy(2),:)       = x%temp_tot(ix(1):ix(2),:)
    y%betaperp_tot(iy(1):iy(2),:,:) = x%betaperp_tot(ix(1):ix(2),:,:)
    y%beta_mol(iy(1):iy(2),:)       = x%beta_mol(ix(1):ix(2),:)
    y%beta_tot(iy(1):iy(2),:,:)     = x%beta_tot(ix(1):ix(2),:,:)
    y%tau_tot(iy(1):iy(2),:,:)      = x%tau_tot(ix(1):ix(2),:,:)
    y%refl(iy(1):iy(2),:,:)         = x%refl(ix(1):ix(2),:,:)
END SUBROUTINE COSP_SGLIDAR_CPSECTION

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!------------- SUBROUTINE COSP_ISCCP_CPSECTION -----------------
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE COSP_ISCCP_CPSECTION(ix,iy,x,y)
    integer,intent(in),dimension(2) :: ix,iy
    type(cosp_isccp),intent(in) :: x
    type(cosp_isccp),intent(inout) :: y

    y%fq_isccp(iy(1):iy(2),:,:)  = x%fq_isccp(ix(1):ix(2),:,:)
    y%totalcldarea(iy(1):iy(2))  = x%totalcldarea(ix(1):ix(2))
    y%meantb(iy(1):iy(2))        = x%meantb(ix(1):ix(2))
    y%meantbclr(iy(1):iy(2))     = x%meantbclr(ix(1):ix(2))
    y%meanptop(iy(1):iy(2))      = x%meanptop(ix(1):ix(2))
    y%meantaucld(iy(1):iy(2))    = x%meantaucld(ix(1):ix(2))
    y%meanalbedocld(iy(1):iy(2)) = x%meanalbedocld(ix(1):ix(2))
    y%boxtau(iy(1):iy(2),:)      = x%boxtau(ix(1):ix(2),:)
    y%boxptop(iy(1):iy(2),:)     = x%boxptop(ix(1):ix(2),:)
END SUBROUTINE COSP_ISCCP_CPSECTION


!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!------------- SUBROUTINE COSP_MISR_CPSECTION -----------------
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE COSP_MISR_CPSECTION(ix,iy,x,y)
    integer,intent(in),dimension(2) :: ix,iy
    type(cosp_misr),intent(in) :: x
    type(cosp_misr),intent(inout) :: y
            
    y%fq_MISR(iy(1):iy(2),:,:)                 = x%fq_MISR(ix(1):ix(2),:,:)
    y%MISR_meanztop(iy(1):iy(2))               = x%MISR_meanztop(ix(1):ix(2))
    y%MISR_cldarea(iy(1):iy(2))                = x%MISR_cldarea(ix(1):ix(2))
    y%MISR_dist_model_layertops(iy(1):iy(2),:) = x%MISR_dist_model_layertops(ix(1):ix(2),:)
END SUBROUTINE COSP_MISR_CPSECTION

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!------------- SUBROUTINE COSP_RTTOV_CPSECTION -------------------
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE COSP_RTTOV_CPSECTION(ix,iy,x,y)
    integer,intent(in),dimension(2) :: ix,iy
    type(cosp_rttov),intent(in) :: x
    type(cosp_rttov),intent(inout) :: y
            
    y%tbs(iy(1):iy(2),:) = x%tbs(ix(1):ix(2),:)
END SUBROUTINE COSP_RTTOV_CPSECTION

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!------------- SUBROUTINE COSP_RADARSTATS_CPSECTION --------------
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE COSP_RADARSTATS_CPSECTION(ix,iy,x,y)
    integer,intent(in),dimension(2) :: ix,iy
    type(cosp_radarstats),intent(in) :: x
    type(cosp_radarstats),intent(inout) :: y
            
    y%cfad_ze(iy(1):iy(2),:,:)             = x%cfad_ze(ix(1):ix(2),:,:)
    y%radar_lidar_tcc(iy(1):iy(2))         = x%radar_lidar_tcc(ix(1):ix(2))
    y%lidar_only_freq_cloud(iy(1):iy(2),:) = x%lidar_only_freq_cloud(ix(1):ix(2),:)
END SUBROUTINE COSP_RADARSTATS_CPSECTION

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!------------- SUBROUTINE COSP_LIDARSTATS_CPSECTION --------------
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE COSP_LIDARSTATS_CPSECTION(ix,iy,x,y)
    integer,intent(in),dimension(2) :: ix,iy
    type(cosp_lidarstats),intent(in) :: x
    type(cosp_lidarstats),intent(inout) :: y
            
    y%srbval                     = x%srbval
    y%cfad_sr(iy(1):iy(2),:,:)   = x%cfad_sr(ix(1):ix(2),:,:)
    y%lidarcld(iy(1):iy(2),:)    = x%lidarcld(ix(1):ix(2),:)
    y%cldlayer(iy(1):iy(2),:)    = x%cldlayer(ix(1):ix(2),:)
    y%parasolrefl(iy(1):iy(2),:) = x%parasolrefl(ix(1):ix(2),:)
    y%lidarcldphase(iy(1):iy(2),:,:)  = x%lidarcldphase(ix(1):ix(2),:,:)
    y%cldlayerphase(iy(1):iy(2),:,:)  = x%cldlayerphase(ix(1):ix(2),:,:)
    y%lidarcldtmp(iy(1):iy(2),:,:)    = x%lidarcldtmp(ix(1):ix(2),:,:)
END SUBROUTINE COSP_LIDARSTATS_CPSECTION
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!------------- PRINT SUBROUTINES --------------
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
SUBROUTINE COSP_GRIDBOX_PRINT(x)
    type(cosp_gridbox),intent(in) :: x

    print *, '%%%%----- Information on COSP_GRIDBOX ------'
    ! Scalars and dimensions
    print *,  x%Npoints
    print *,  x%Nlevels
    print *,  x%Ncolumns
    print *,  x%Nhydro
    print *,  x%Nprmts_max_hydro
    print *,  x%Naero
    print *,  x%Nprmts_max_aero
    print *,  x%Npoints_it
    
    ! Time [days]
    print *,  x%time
    
    ! Radar ancillary info
    print *,  x%radar_freq, &
            x%k2
    print *,  x%surface_radar, &
              x%use_mie_tables, &
              x%use_gas_abs, &
              x%do_ray, &
              x%melt_lay

!               print *,  'shape(x%): ',shape(x%)
 
!     type(class_param) ::  hp  ! structure used by radar simulator to store Ze and N scaling constants and other information
!     type(mie)::  mt           ! structure used by radar simulator to store mie LUT information
    print *,  x%nsizes
    
    ! Lidar
    print *,  x%lidar_ice_type
    
    ! Radar
    print *,  x%use_precipitation_fluxes
    print *,  x%use_reff
    
    ! Geolocation (Npoints)
    print *,  'shape(x%longitude): ',shape(x%longitude)
    print *,  'shape(x%latitude): ',shape(x%latitude)
    ! Gridbox information (Npoints,Nlevels)
    print *,  'shape(x%zlev): ',shape(x%zlev)
    print *,  'shape(x%zlev_half): ',shape(x%zlev_half)
    print *,  'shape(x%dlev): ',shape(x%dlev)
    print *,  'shape(x%p): ',shape(x%p)
    print *,  'shape(x%ph): ',shape(x%ph)
    print *,  'shape(x%T): ',shape(x%T)
    print *,  'shape(x%q): ',shape(x%q)
    print *,  'shape(x%sh): ',shape(x%sh)
    print *,  'shape(x%dtau_s): ',shape(x%dtau_s)
    print *,  'shape(x%dtau_c): ',shape(x%dtau_c)
    print *,  'shape(x%dem_s): ',shape(x%dem_s)
    print *,  'shape(x%dem_c): ',shape(x%dem_c)
    print *,  'shape(x%mr_ozone): ',shape(x%mr_ozone)

    ! Point information (Npoints)
    print *,  'shape(x%land): ',shape(x%land)
    print *,  'shape(x%psfc): ',shape(x%psfc)
    print *,  'shape(x%sunlit): ',shape(x%sunlit)
    print *,  'shape(x%skt): ',shape(x%skt)
    print *,  'shape(x%u_wind): ',shape(x%u_wind)
    print *,  'shape(x%v_wind): ',shape(x%v_wind)

    ! TOTAL and CONV cloud fraction for SCOPS
    print *,  'shape(x%tca): ',shape(x%tca)
    print *,  'shape(x%cca): ',shape(x%cca)
    ! Precipitation fluxes on model levels
    print *,  'shape(x%rain_ls): ',shape(x%rain_ls)
    print *,  'shape(x%rain_cv): ',shape(x%rain_cv)
    print *,  'shape(x%snow_ls): ',shape(x%snow_ls)
    print *,  'shape(x%snow_cv): ',shape(x%snow_cv)
    print *,  'shape(x%grpl_ls): ',shape(x%grpl_ls)
    ! Hydrometeors concentration and distribution parameters
    print *,  'shape(x%mr_hydro): ',shape(x%mr_hydro)
    print *,  'shape(x%dist_prmts_hydro): ',shape(x%dist_prmts_hydro)
    ! Effective radius [m]. (Npoints,Nlevels,Nhydro)
    print *,  'shape(x%Reff): ',shape(x%Reff)
    print *,  'shape(x%Np): ',shape(x%Np)       ! added by roj with Quickbeam V3
    ! Aerosols concentration and distribution parameters
    print *,  'shape(x%conc_aero): ',shape(x%conc_aero)
    print *,  'shape(x%dist_type_aero): ',shape(x%dist_type_aero)
    print *,  'shape(x%dist_prmts_aero): ',shape(x%dist_prmts_aero)
    ! ISCCP simulator inputs
    print *, x%isccp_top_height
    print *, x%isccp_top_height_direction
    print *, x%isccp_overlap
    print *, x%isccp_emsfc_lw
  
    ! RTTOV inputs/options
    print *, x%plat
    print *, x%sat
    print *, x%inst
    print *, x%Nchan
    print *,  'shape(x%Ichan): ',x%Ichan
    print *,  'shape(x%Surfem): ',x%Surfem
    print *, x%ZenAng
    print *, x%co2,x%ch4,x%n2o,x%co
                
END SUBROUTINE COSP_GRIDBOX_PRINT

SUBROUTINE COSP_MISR_PRINT(x)
    type(cosp_misr),intent(in) :: x

    print *, '%%%%----- Information on COSP_MISR ------'
                
     ! Dimensions
    print *, x%Npoints
    print *, x%Ntau
    print *, x%Nlevels

     ! --- (npoints,ntau,nlevels)
     !  the fraction of the model grid box covered by each of the MISR cloud types
     print *,  'shape(x%fq_MISR): ',shape(x%fq_MISR)
     
     ! --- (npoints)
     print *,  'shape(x%MISR_meanztop): ',shape(x%MISR_meanztop)
     print *,  'shape(x%MISR_cldarea): ',shape(x%MISR_cldarea)
     ! --- (npoints,nlevels)
     print *,  'shape(x%MISR_dist_model_layertops): ',shape(x%MISR_dist_model_layertops)
    
END SUBROUTINE COSP_MISR_PRINT

SUBROUTINE COSP_ISCCP_PRINT(x)
    type(cosp_isccp),intent(in) :: x
            
    print *, x%Npoints
    print *, x%Ncolumns
    print *, x%Nlevels

    print *, '%%%%----- Information on COSP_ISCCP ------'
    
     print *, 'shape(x%fq_isccp): ',shape(x%fq_isccp)
     print *, 'shape(x%totalcldarea): ',shape(x%totalcldarea)
     print *, 'shape(x%meantb): ',shape(x%meantb)
     print *, 'shape(x%meantbclr): ',shape(x%meantbclr)
     
     print *, 'shape(x%meanptop): ',shape(x%meanptop)
     print *, 'shape(x%meantaucld): ',shape(x%meantaucld)
     print *, 'shape(x%meanalbedocld): ',shape(x%meanalbedocld)
     print *, 'shape(x%boxtau): ',shape(x%boxtau)
     print *, 'shape(x%boxptop): ',shape(x%boxptop)
END SUBROUTINE COSP_ISCCP_PRINT

SUBROUTINE COSP_VGRID_PRINT(x)
    type(cosp_vgrid),intent(in) :: x
            
    print *, '%%%%----- Information on COSP_VGRID ------'
    print *, x%use_vgrid
    print *, x%csat_vgrid
    print *, x%Npoints
    print *, x%Ncolumns
    print *, x%Nlevels
    print *, x%Nlvgrid
    ! Array with dimensions (Nlvgrid)
    print *, 'shape(x%z): ',shape(x%z)
    print *, 'shape(x%zl): ',shape(x%zl)
    print *, 'shape(x%zu): ',shape(x%zu)
    ! Array with dimensions (Nlevels)
    print *, 'shape(x%mz): ',shape(x%mz)
    print *, 'shape(x%mzl): ',shape(x%mzl)
    print *, 'shape(x%mzu): ',shape(x%mzu)
END SUBROUTINE COSP_VGRID_PRINT

SUBROUTINE COSP_SGLIDAR_PRINT(x)
    type(cosp_sglidar),intent(in) :: x
            
    print *, '%%%%----- Information on COSP_SGLIDAR ------'
    ! Dimensions
    print *, x%Npoints
    print *, x%Ncolumns
    print *, x%Nlevels
    print *, x%Nhydro
    print *, x%Nrefl
    ! Arrays with dimensions (Npoints,Nlevels)
    print *, 'shape(x%beta_mol): ',shape(x%beta_mol)
    ! Arrays with dimensions (Npoints,Ncolumns,Nlevels)
    print *, 'shape(x%beta_tot): ',shape(x%beta_tot)
    print *, 'shape(x%tau_tot): ',shape(x%tau_tot)
    ! Arrays with dimensions (Npoints,Ncolumns,Nrefl)
    print *, 'shape(x%refl): ',shape(x%refl)
END SUBROUTINE COSP_SGLIDAR_PRINT

SUBROUTINE COSP_SGRADAR_PRINT(x)
    type(cosp_sgradar),intent(in) :: x
            
    print *, '%%%%----- Information on COSP_SGRADAR ------'
    print *, x%Npoints
    print *, x%Ncolumns
    print *, x%Nlevels
    print *, x%Nhydro
    ! output vertical levels: spaceborne radar -> from TOA to SURFACE
    ! Arrays with dimensions (Npoints,Nlevels)
    print *, 'shape(x%att_gas): ', shape(x%att_gas)
    ! Arrays with dimensions (Npoints,Ncolumns,Nlevels)
    print *, 'shape(x%Ze_tot): ', shape(x%Ze_tot)
END SUBROUTINE COSP_SGRADAR_PRINT

SUBROUTINE COSP_RADARSTATS_PRINT(x)
    type(cosp_radarstats),intent(in) :: x
            
    print *, '%%%%----- Information on COSP_SGRADAR ------'
    print *, x%Npoints
    print *, x%Ncolumns
    print *, x%Nlevels
    print *, x%Nhydro
    print *, 'shape(x%cfad_ze): ',shape(x%cfad_ze)
    print *, 'shape(x%radar_lidar_tcc): ',shape(x%radar_lidar_tcc)
    print *, 'shape(x%lidar_only_freq_cloud): ',shape(x%lidar_only_freq_cloud)
END SUBROUTINE COSP_RADARSTATS_PRINT

SUBROUTINE COSP_LIDARSTATS_PRINT(x)
    type(cosp_lidarstats),intent(in) :: x
            
    print *, '%%%%----- Information on COSP_SGLIDAR ------'
    print *, x%Npoints
    print *, x%Ncolumns
    print *, x%Nlevels
    print *, x%Nhydro
    print *, x%Nrefl
    
    ! Arrays with dimensions (SR_BINS)
    print *, 'shape(x%srbval): ',shape(x%srbval)
    ! Arrays with dimensions (Npoints,SR_BINS,Nlevels)
    print *, 'shape(x%cfad_sr): ',shape(x%cfad_sr)
    ! Arrays with dimensions (Npoints,Nlevels)
    print *, 'shape(x%lidarcld): ',shape(x%lidarcld)
    ! Arrays with dimensions (Npoints,LIDAR_NCAT)
    print *, 'shape(x%cldlayer): ',shape(x%cldlayer)
    ! Arrays with dimensions (Npoints,PARASOL_NREFL)
    print *, 'shape(x%parasolrefl): ',shape(x%parasolrefl)
     ! Arrays with dimensions (Npoints,Nlevels,Nphase)
    print *, 'shape(x%lidarcldphase): ',shape(x%lidarcldphase)
     ! Arrays with dimensions (Npoints,LIDAR_NCAT,Nphase)
    print *, 'shape(x%cldlayerphase): ',shape(x%cldlayerphase)
     ! Arrays with dimensions (Npoints,Ntemps,Nphase)
    print *, 'shape(x%lidarcldphase): ',shape(x%lidarcldtmp)

END SUBROUTINE COSP_LIDARSTATS_PRINT

SUBROUTINE COSP_SUBGRID_PRINT(x)
    type(cosp_subgrid),intent(in) :: x
            
    print *, '%%%%----- Information on COSP_SUBGRID ------'
    print *, x%Npoints
    print *, x%Ncolumns
    print *, x%Nlevels
    print *, x%Nhydro
    
    print *, 'shape(x%prec_frac): ',shape(x%prec_frac)
    print *, 'shape(x%frac_out): ',shape(x%frac_out)
END SUBROUTINE COSP_SUBGRID_PRINT

SUBROUTINE COSP_SGHYDRO_PRINT(x)
    type(cosp_sghydro),intent(in) :: x
            
    print *, '%%%%----- Information on COSP_SGHYDRO ------'
    print *, x%Npoints
    print *, x%Ncolumns
    print *, x%Nlevels
    print *, x%Nhydro
    
    print *, 'shape(x%mr_hydro): ',shape(x%mr_hydro)
    print *, 'shape(x%Reff): ',shape(x%Reff)
    print *, 'shape(x%Np): ',shape(x%Np)         ! added by roj with Quickbeam V3
END SUBROUTINE COSP_SGHYDRO_PRINT

END MODULE MOD_COSP_TYPES
back to top