Index: LMDZ6/trunk/libf/phylmd/cosp/cosp.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/cosp/cosp.F90	(revision 3232)
+++ 	(revision )
@@ -1,605 +1,0 @@
-! (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.
-
-#include "cosp_defs.h"
-MODULE MOD_COSP
-  USE MOD_COSP_TYPES
-  USE MOD_COSP_SIMULATOR
-  USE MOD_COSP_MODIS_SIMULATOR
-  IMPLICIT NONE
-
-CONTAINS
-
-
-!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-!--------------------- SUBROUTINE COSP ---------------------------
-!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-!#ifdef RTTOV
-!SUBROUTINE COSP(overlap,Ncolumns,cfg,vgrid,gbx,sgx,sgradar,sglidar,isccp,misr,modis,rttov,stradar,stlidar)
-!#else
-SUBROUTINE COSP(overlap,Ncolumns,cfg,vgrid,gbx,sgx,sgradar,sglidar,isccp,misr,modis,stradar,stlidar)
-!#endif
-  ! Arguments
-  integer,intent(in) :: overlap !  overlap type in SCOPS: 1=max, 2=rand, 3=max/rand
-  integer,intent(in) :: Ncolumns
-  type(cosp_config),intent(in) :: cfg   ! Configuration options
-  type(cosp_vgrid),intent(in) :: vgrid   ! Information on vertical grid of stats
-  type(cosp_gridbox),intent(inout) :: gbx
-  type(cosp_subgrid),intent(inout) :: sgx   ! Subgrid info
-  type(cosp_sgradar),intent(inout) :: sgradar ! Output from radar simulator
-  type(cosp_sglidar),intent(inout) :: sglidar ! Output from lidar simulator
-  type(cosp_isccp),intent(inout)   :: isccp   ! Output from ISCCP simulator
-  type(cosp_misr),intent(inout)    :: misr    ! Output from MISR simulator
-  type(cosp_modis),intent(inout)   :: modis   ! Output from MODIS simulator
-!#ifdef RTTOV
-!  type(cosp_rttov),intent(inout)   :: rttov   ! Output from RTTOV
-!#endif
-  type(cosp_radarstats),intent(inout) :: stradar ! Summary statistics from radar simulator
-  type(cosp_lidarstats),intent(inout) :: stlidar ! Summary statistics from lidar simulator
-
-  ! Local variables 
-  integer :: Npoints   ! Number of gridpoints
-  integer :: Nlevels   ! Number of levels
-  integer :: Nhydro    ! Number of hydrometeors
-  integer :: Niter     ! Number of calls to cosp_simulator
-  integer :: i_first,i_last ! First and last gridbox to be processed in each iteration
-  integer :: i,Ni
-  integer,dimension(2) :: ix,iy
-  logical :: reff_zero
-  real :: maxp,minp
-  integer,dimension(:),allocatable :: & ! Dimensions nPoints
-                  seed    !  It is recommended that the seed is set to a different value for each model
-                          !  gridbox it is called on, as it is possible that the choice of the same 
-                          !  seed value every time may introduce some statistical bias in the results, 
-                          !  particularly for low values of NCOL.
-  ! Types used in one iteration
-  type(cosp_gridbox) :: gbx_it
-  type(cosp_subgrid) :: sgx_it
-  type(cosp_vgrid)   :: vgrid_it
-  type(cosp_sgradar) :: sgradar_it
-  type(cosp_sglidar) :: sglidar_it
-  type(cosp_isccp)   :: isccp_it
-  type(cosp_modis)   :: modis_it
-  type(cosp_misr)    :: misr_it
-!#ifdef RTTOV
-!  type(cosp_rttov)   :: rttov_it
-!#endif
-  type(cosp_radarstats) :: stradar_it
-  type(cosp_lidarstats) :: stlidar_it
-
-!++++++++++ Dimensions ++++++++++++
-  Npoints  = gbx%Npoints
-  Nlevels  = gbx%Nlevels
-  Nhydro   = gbx%Nhydro
-
-!++++++++++ Depth of model layers ++++++++++++
-  do i=1,Nlevels-1
-    gbx%dlev(:,i) = gbx%zlev_half(:,i+1) - gbx%zlev_half(:,i)
-  enddo
-  gbx%dlev(:,Nlevels) = 2.0*(gbx%zlev(:,Nlevels) - gbx%zlev_half(:,Nlevels))
-
-!++++++++++ Apply sanity checks to inputs ++++++++++
-!  call cosp_check_input('longitude',gbx%longitude,min_val=0.0,max_val=360.0)
-  call cosp_check_input('longitude',gbx%longitude,min_val=-180.0,max_val=180.0)
-  call cosp_check_input('latitude',gbx%latitude,min_val=-90.0,max_val=90.0)
-  call cosp_check_input('dlev',gbx%dlev,min_val=0.0)
-  call cosp_check_input('p',gbx%p,min_val=0.0)
-  call cosp_check_input('ph',gbx%ph,min_val=0.0)
-  call cosp_check_input('T',gbx%T,min_val=0.0)
-  call cosp_check_input('q',gbx%q,min_val=0.0)
-  call cosp_check_input('sh',gbx%sh,min_val=0.0)
-  call cosp_check_input('dtau_s',gbx%dtau_s,min_val=0.0)
-  call cosp_check_input('dtau_c',gbx%dtau_c,min_val=0.0)
-  call cosp_check_input('dem_s',gbx%dem_s,min_val=0.0,max_val=1.0)
-  call cosp_check_input('dem_c',gbx%dem_c,min_val=0.0,max_val=1.0)
-  ! Point information (Npoints)
-  call cosp_check_input('land',gbx%land,min_val=0.0,max_val=1.0)
-  call cosp_check_input('psfc',gbx%psfc,min_val=0.0)
-  call cosp_check_input('sunlit',gbx%sunlit,min_val=0.0,max_val=1.0)
-  call cosp_check_input('skt',gbx%skt,min_val=0.0)
-  ! TOTAL and CONV cloud fraction for SCOPS
-  call cosp_check_input('tca',gbx%tca,min_val=0.0,max_val=1.0)
-  call cosp_check_input('cca',gbx%cca,min_val=0.0,max_val=1.0)
-  ! Precipitation fluxes on model levels
-  call cosp_check_input('rain_ls',gbx%rain_ls,min_val=0.0)
-  call cosp_check_input('rain_cv',gbx%rain_cv,min_val=0.0)
-  call cosp_check_input('snow_ls',gbx%snow_ls,min_val=0.0)
-  call cosp_check_input('snow_cv',gbx%snow_cv,min_val=0.0)
-  call cosp_check_input('grpl_ls',gbx%grpl_ls,min_val=0.0)
-  ! Hydrometeors concentration and distribution parameters
-  call cosp_check_input('mr_hydro',gbx%mr_hydro,min_val=0.0)
-  ! Effective radius [m]. (Npoints,Nlevels,Nhydro)
-  call cosp_check_input('Reff',gbx%Reff,min_val=0.0)
-  reff_zero=.true.
-  if (any(gbx%Reff > 1.e-8)) then
-     reff_zero=.false.
-      ! reff_zero == .false.
-      !     and gbx%use_reff == .true.   Reff use in radar and lidar
-      !     and reff_zero    == .false.  Reff use in lidar and set to 0 for radar
-  endif
-  if ((.not. gbx%use_reff) .and. (reff_zero)) then ! No Reff in radar. Default in lidar
-        gbx%Reff = DEFAULT_LIDAR_REFF
-        print *, '---------- COSP WARNING ------------'
-        print *, ''
-        print *, 'Using default Reff in lidar simulations'
-        print *, ''
-        print *, '----------------------------------'
-  endif
-  
-  ! Aerosols concentration and distribution parameters
-  call cosp_check_input('conc_aero',gbx%conc_aero,min_val=0.0)
-  ! Checks for CRM mode
-  if (Ncolumns == 1) then
-     if (gbx%use_precipitation_fluxes) then
-        print *, '---------- COSP ERROR ------------'
-        print *, ''
-        print *, 'Use of precipitation fluxes not supported in CRM mode (Ncolumns=1)'
-        print *, ''
-        print *, '----------------------------------'
-        stop
-     endif
-     if ((maxval(gbx%dtau_c) > 0.0).or.(maxval(gbx%dem_c) > 0.0)) then
-        print *, '---------- COSP ERROR ------------'
-        print *, ''
-        print *, ' dtau_c > 0.0 or dem_c > 0.0. In CRM mode (Ncolumns=1), '
-        print *, ' the optical depth (emmisivity) of all clouds must be '
-        print *, ' passed through dtau_s (dem_s)'
-        print *, ''
-        print *, '----------------------------------'
-        stop
-     endif
-  endif
-
-   ! We base the seed in the decimal part of the surface pressure.
-   allocate(seed(Npoints))
-   seed = int(gbx%psfc) ! This is to avoid division by zero when Npoints = 1   
-      ! Roj Oct/2008 ... Note: seed value of 0 caused me some problems + I want to 
-      ! randomize for each call to COSP even when Npoints ==1
-   minp = minval(gbx%psfc)
-   maxp = maxval(gbx%psfc)
-   if (Npoints .gt. 1) seed=int((gbx%psfc-minp)/(maxp-minp)*100000) + 1
-   ! Below it's how it was done in the original implementation of the ISCCP simulator. 
-   ! The one above is better for offline data, when you may have packed data 
-   ! that subsamples the decimal fraction of the surface pressure. 
-!    if (Npoints .gt. 1) seed=(gbx%psfc-int(gbx%psfc))*1000000 
-
-  
-   if (gbx%Npoints_it >= gbx%Npoints) then ! One iteration gbx%Npoints
-!#ifdef RTTOV
-!        call cosp_iter(overlap,seed,cfg,vgrid,gbx,sgx,sgradar,sglidar,isccp,misr,modis,rttov,stradar,stlidar)
-!#else
-        call cosp_iter(overlap,seed,cfg,vgrid,gbx,sgx,sgradar,sglidar,isccp,misr,modis,stradar,stlidar)
-!#endif
-   else ! Several iterations to save memory
-        Niter = gbx%Npoints/gbx%Npoints_it ! Integer division
-        if (Niter*gbx%Npoints_it < gbx%Npoints) Niter = Niter + 1
-        do i=1,Niter
-            i_first = (i-1)*gbx%Npoints_it + 1
-            i_last  = i_first + gbx%Npoints_it - 1
-            i_last  = min(i_last,gbx%Npoints)
-            Ni = i_last - i_first + 1
-            if (i == 1) then
-                ! Allocate types for all but last iteration
-                call construct_cosp_gridbox(gbx%time,gbx%time_bnds,gbx%radar_freq,gbx%surface_radar,gbx%use_mie_tables, &
-                                            gbx%use_gas_abs,gbx%do_ray,gbx%melt_lay,gbx%k2,Ni,Nlevels, &
-                                            Ncolumns,N_HYDRO,gbx%Nprmts_max_hydro, &
-                                            gbx%Naero,gbx%Nprmts_max_aero,Ni,gbx%lidar_ice_type,gbx%isccp_top_height, &
-                                            gbx%isccp_top_height_direction,gbx%isccp_overlap,gbx%isccp_emsfc_lw, &
-                                            gbx%use_precipitation_fluxes,gbx%use_reff, &
-                                            gbx%plat,gbx%sat,gbx%inst,gbx%nchan,gbx%ZenAng, &
-                                            gbx%Ichan(1:gbx%nchan),gbx%surfem(1:gbx%nchan), &
-                                            gbx%co2,gbx%ch4,gbx%n2o,gbx%co, &
-                                            gbx_it)
-                call construct_cosp_vgrid(gbx_it,vgrid%Nlvgrid,vgrid%use_vgrid,vgrid%csat_vgrid,vgrid_it)
-                call construct_cosp_subgrid(Ni, Ncolumns, Nlevels, sgx_it)
-                call construct_cosp_sgradar(cfg,Ni,Ncolumns,Nlevels,N_HYDRO,sgradar_it)
-                call construct_cosp_sglidar(cfg,Ni,Ncolumns,Nlevels,N_HYDRO,PARASOL_NREFL,sglidar_it)
-                call construct_cosp_isccp(cfg,Ni,Ncolumns,Nlevels,isccp_it)
-                call construct_cosp_modis(cfg, Ni, modis_it)
-                call construct_cosp_misr(cfg,Ni,misr_it)
-!#ifdef RTTOV
-!                call construct_cosp_rttov(Ni,gbx%nchan,rttov_it)
-!#endif
-                call construct_cosp_radarstats(cfg,Ni,Ncolumns,vgrid%Nlvgrid,N_HYDRO,stradar_it)
-                call construct_cosp_lidarstats(cfg,Ni,Ncolumns,vgrid%Nlvgrid,N_HYDRO,PARASOL_NREFL,stlidar_it)
-            elseif (i == Niter) then ! last iteration
-                call free_cosp_gridbox(gbx_it,.true.)
-                call free_cosp_subgrid(sgx_it)
-                call free_cosp_vgrid(vgrid_it)
-                call free_cosp_sgradar(sgradar_it)
-                call free_cosp_sglidar(sglidar_it)
-                call free_cosp_isccp(isccp_it)
-                call free_cosp_modis(modis_it)
-                call free_cosp_misr(misr_it)
-!#ifdef RTTOV
-!                call free_cosp_rttov(rttov_it)
-!#endif
-                call free_cosp_radarstats(stradar_it)
-                call free_cosp_lidarstats(stlidar_it)
-                ! Allocate types for iterations
-                call construct_cosp_gridbox(gbx%time,gbx%time_bnds,gbx%radar_freq,gbx%surface_radar,gbx%use_mie_tables, &
-                                            gbx%use_gas_abs,gbx%do_ray,gbx%melt_lay,gbx%k2,Ni,Nlevels, &
-                                            Ncolumns,N_HYDRO,gbx%Nprmts_max_hydro, &
-                                            gbx%Naero,gbx%Nprmts_max_aero,Ni,gbx%lidar_ice_type,gbx%isccp_top_height, &
-                                            gbx%isccp_top_height_direction,gbx%isccp_overlap,gbx%isccp_emsfc_lw, &
-                                            gbx%use_precipitation_fluxes,gbx%use_reff, &
-                                            gbx%plat,gbx%sat,gbx%inst,gbx%nchan,gbx%ZenAng, &
-                                            gbx%Ichan(1:gbx%nchan),gbx%surfem(1:gbx%nchan), &
-                                            gbx%co2,gbx%ch4,gbx%n2o,gbx%co, &
-                                            gbx_it)
-                ! --- Copy arrays without Npoints as dimension ---
-                gbx_it%dist_prmts_hydro = gbx%dist_prmts_hydro
-                gbx_it%dist_type_aero   = gbx_it%dist_type_aero
-                call construct_cosp_vgrid(gbx_it,vgrid%Nlvgrid,vgrid%use_vgrid,vgrid%csat_vgrid,vgrid_it)
-                call construct_cosp_subgrid(Ni, Ncolumns, Nlevels, sgx_it)
-                call construct_cosp_sgradar(cfg,Ni,Ncolumns,Nlevels,N_HYDRO,sgradar_it)
-                call construct_cosp_sglidar(cfg,Ni,Ncolumns,Nlevels,N_HYDRO,PARASOL_NREFL,sglidar_it)
-                call construct_cosp_isccp(cfg,Ni,Ncolumns,Nlevels,isccp_it)
-                call construct_cosp_modis(cfg,Ni, modis_it)
-                call construct_cosp_misr(cfg,Ni,misr_it)
-!#ifdef RTTOV 
-!                call construct_cosp_rttov(Ni,gbx%nchan,rttov_it) 
-!#endif 
-                call construct_cosp_radarstats(cfg,Ni,Ncolumns,vgrid%Nlvgrid,N_HYDRO,stradar_it)
-                call construct_cosp_lidarstats(cfg,Ni,Ncolumns,vgrid%Nlvgrid,N_HYDRO,PARASOL_NREFL,stlidar_it)
-            endif
-            ! --- Copy sections of arrays with Npoints as dimension ---
-            ix=(/i_first,i_last/)
-            iy=(/1,Ni/)
-            call cosp_gridbox_cpsection(ix,iy,gbx,gbx_it)
-              ! These serve as initialisation of *_it types
-            call cosp_subgrid_cpsection(ix,iy,sgx,sgx_it)
-            if (cfg%Lradar_sim) call cosp_sgradar_cpsection(ix,iy,sgradar,sgradar_it)
-            if (cfg%Llidar_sim) call cosp_sglidar_cpsection(ix,iy,sglidar,sglidar_it)
-            if (cfg%Lisccp_sim) call cosp_isccp_cpsection(ix,iy,isccp,isccp_it)
-            if (cfg%Lmodis_sim) call cosp_modis_cpsection(ix,iy,modis,modis_it)
-            if (cfg%Lmisr_sim)  call cosp_misr_cpsection(ix,iy,misr,misr_it)
-!#ifdef RTTOV 
-!            if (cfg%Lrttov_sim) call cosp_rttov_cpsection(ix,iy,rttov,rttov_it) 
-!#endif
-            if (cfg%Lradar_sim) call cosp_radarstats_cpsection(ix,iy,stradar,stradar_it)
-            if (cfg%Llidar_sim) call cosp_lidarstats_cpsection(ix,iy,stlidar,stlidar_it)
-!#ifdef RTTOV
-!            call cosp_iter(overlap,seed(ix(1):ix(2)),cfg,vgrid_it,gbx_it,sgx_it,sgradar_it, &
-!                           sglidar_it,isccp_it,misr_it,modis_it,rttov_it,stradar_it,stlidar_it)
-!#else
-            call cosp_iter(overlap,seed(ix(1):ix(2)),cfg,vgrid_it,gbx_it,sgx_it,sgradar_it, &
-                           sglidar_it,isccp_it,misr_it,modis_it,stradar_it,stlidar_it)
-!#endif
-            ! --- Copy results to output structures ---
-            ix=(/1,Ni/)
-            iy=(/i_first,i_last/)
-            call cosp_subgrid_cpsection(ix,iy,sgx_it,sgx)
-            if (cfg%Lradar_sim) call cosp_sgradar_cpsection(ix,iy,sgradar_it,sgradar)
-            if (cfg%Llidar_sim) call cosp_sglidar_cpsection(ix,iy,sglidar_it,sglidar)
-            if (cfg%Lisccp_sim) call cosp_isccp_cpsection(ix,iy,isccp_it,isccp)
-            if (cfg%Lmodis_sim) call cosp_modis_cpsection(ix,iy,modis_it,modis)
-            if (cfg%Lmisr_sim)  call cosp_misr_cpsection(ix,iy,misr_it,misr)
-!#ifdef RTTOV 
-!            if (cfg%Lrttov_sim) call cosp_rttov_cpsection(ix,iy,rttov_it,rttov) 
-!#endif 
-            if (cfg%Lradar_sim) call cosp_radarstats_cpsection(ix,iy,stradar_it,stradar)
-            if (cfg%Llidar_sim) call cosp_lidarstats_cpsection(ix,iy,stlidar_it,stlidar)
-        enddo
-        ! Deallocate types
-        call free_cosp_gridbox(gbx_it,.true.)
-        call free_cosp_subgrid(sgx_it)
-        call free_cosp_vgrid(vgrid_it)
-        call free_cosp_sgradar(sgradar_it)
-        call free_cosp_sglidar(sglidar_it)
-        call free_cosp_isccp(isccp_it)
-        call free_cosp_modis(modis_it)
-        call free_cosp_misr(misr_it)
-!#ifdef RTTOV 
-!        call free_cosp_rttov(rttov_it) 
-!#endif
-        call free_cosp_radarstats(stradar_it)
-        call free_cosp_lidarstats(stlidar_it)
-   endif
-   deallocate(seed)
-
-    
-END SUBROUTINE COSP
-
-!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-!--------------------- SUBROUTINE COSP_ITER ----------------------
-!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-!#ifdef RTTOV
-!SUBROUTINE COSP_ITER(overlap,seed,cfg,vgrid,gbx,sgx,sgradar,sglidar,isccp,misr,modis,rttov,stradar,stlidar)
-!#else
-SUBROUTINE COSP_ITER(overlap,seed,cfg,vgrid,gbx,sgx,sgradar,sglidar,isccp,misr,modis,stradar,stlidar)
-!#endif
-  ! Arguments
-  integer,intent(in) :: overlap !  overlap type in SCOPS: 1=max, 2=rand, 3=max/rand
-  integer,dimension(:),intent(in) :: seed
-  type(cosp_config),intent(in) :: cfg   ! Configuration options
-  type(cosp_vgrid),intent(in) :: vgrid   ! Information on vertical grid of stats
-  type(cosp_gridbox),intent(inout) :: gbx
-  type(cosp_subgrid),intent(inout) :: sgx   ! Subgrid info
-  type(cosp_sgradar),intent(inout) :: sgradar ! Output from radar simulator
-  type(cosp_sglidar),intent(inout) :: sglidar ! Output from lidar simulator
-  type(cosp_isccp),intent(inout)   :: isccp   ! Output from ISCCP simulator
-  type(cosp_misr),intent(inout)    :: misr    ! Output from MISR simulator
-  type(cosp_modis),intent(inout)   :: modis   ! Output from MODIS simulator
-!#ifdef RTTOV
-!  type(cosp_rttov),intent(inout)   :: rttov   ! Output from RTTOV
-!#endif
-  type(cosp_radarstats),intent(inout) :: stradar ! Summary statistics from radar simulator
-  type(cosp_lidarstats),intent(inout) :: stlidar ! Summary statistics from lidar simulator
-
-  ! Local variables 
-  integer :: Npoints   ! Number of gridpoints
-  integer :: Ncolumns  ! Number of subcolumns
-  integer :: Nlevels   ! Number of levels
-  integer :: Nhydro    ! Number of hydrometeors
-  integer :: i,j,k
-  integer :: I_HYDRO 
-  real,dimension(:,:),pointer :: column_frac_out ! Array with one column of frac_out
-  real,dimension(:,:),pointer :: column_prec_out ! Array with one column of prec_frac
-  integer :: scops_debug=0    !  set to non-zero value to print out inputs for debugging in SCOPS
-  real,dimension(:, :),allocatable :: cca_scops,ls_p_rate,cv_p_rate, &
-                     tca_scops ! Cloud cover in each model level (HORIZONTAL gridbox fraction) of total cloud.
-                               ! Levels are from TOA to SURFACE. (nPoints, nLev)
-  real,dimension(:,:),allocatable :: frac_ls,prec_ls,frac_cv,prec_cv ! Cloud/Precipitation fraction in each model level
-                                                                     ! Levels are from SURFACE to TOA
-  real,dimension(:,:),allocatable :: rho ! (Npoints, Nlevels). Atmospheric density
-  type(cosp_sghydro) :: sghydro   ! Subgrid info for hydrometeors en each iteration
-
-  
-  !++++++++++ Dimensions ++++++++++++
-  Npoints  = gbx%Npoints
-  Ncolumns = gbx%Ncolumns
-  Nlevels  = gbx%Nlevels
-  Nhydro   = gbx%Nhydro
-    
-  !++++++++++ Climate/NWP mode ++++++++++  
-  if (Ncolumns > 1) then
-        !++++++++++ Subgrid sampling ++++++++++
-        ! Allocate arrays before calling SCOPS
-        allocate(frac_ls(Npoints,Nlevels),frac_cv(Npoints,Nlevels),prec_ls(Npoints,Nlevels),prec_cv(Npoints,Nlevels))
-        allocate(tca_scops(Npoints,Nlevels),cca_scops(Npoints,Nlevels), &
-                ls_p_rate(Npoints,Nlevels),cv_p_rate(Npoints,Nlevels))
-        ! Initialize to zero
-        frac_ls=0.0
-        prec_ls=0.0
-        frac_cv=0.0
-        prec_cv=0.0
-        ! Cloud fractions for SCOPS from TOA to SFC
-        tca_scops = gbx%tca(:,Nlevels:1:-1)
-        cca_scops = gbx%cca(:,Nlevels:1:-1)
-        
-        ! Call to SCOPS
-        ! strat and conv arrays are passed with levels from TOA to SURFACE.
-        call scops(Npoints,Nlevels,Ncolumns,seed,tca_scops,cca_scops,overlap,sgx%frac_out,scops_debug)
-        
-        ! temporarily use prec_ls/cv to transfer information about precipitation flux into prec_scops
-        if(gbx%use_precipitation_fluxes) then
-            ls_p_rate(:,Nlevels:1:-1)=gbx%rain_ls(:,1:Nlevels)+gbx%snow_ls(:,1:Nlevels)+gbx%grpl_ls(:,1:Nlevels)
-            cv_p_rate(:,Nlevels:1:-1)=gbx%rain_cv(:,1:Nlevels)+gbx%snow_cv(:,1:Nlevels)
-        else
-            ls_p_rate(:,Nlevels:1:-1)=gbx%mr_hydro(:,1:Nlevels,I_LSRAIN)+ &
-                                      gbx%mr_hydro(:,1:Nlevels,I_LSSNOW)+ &
-                                      gbx%mr_hydro(:,1:Nlevels,I_LSGRPL)
-            cv_p_rate(:,Nlevels:1:-1)=gbx%mr_hydro(:,1:Nlevels,I_CVRAIN)+ &
-                                      gbx%mr_hydro(:,1:Nlevels,I_CVSNOW)
-        endif
-        
-        call prec_scops(Npoints,Nlevels,Ncolumns,ls_p_rate,cv_p_rate,sgx%frac_out,sgx%prec_frac)
-        
-        ! Precipitation fraction
-        do j=1,Npoints,1
-        do k=1,Nlevels,1
-            do i=1,Ncolumns,1
-                if (sgx%frac_out (j,i,Nlevels+1-k) == I_LSC) frac_ls(j,k)=frac_ls(j,k)+1.
-                if (sgx%frac_out (j,i,Nlevels+1-k) == I_CVC) frac_cv(j,k)=frac_cv(j,k)+1.
-                if (sgx%prec_frac(j,i,Nlevels+1-k) .eq. 1) prec_ls(j,k)=prec_ls(j,k)+1.
-                if (sgx%prec_frac(j,i,Nlevels+1-k) .eq. 2) prec_cv(j,k)=prec_cv(j,k)+1.
-                if (sgx%prec_frac(j,i,Nlevels+1-k) .eq. 3) then
-                    prec_cv(j,k)=prec_cv(j,k)+1.
-                    prec_ls(j,k)=prec_ls(j,k)+1.
-                endif
-            enddo  !i
-            frac_ls(j,k)=frac_ls(j,k)/Ncolumns
-            frac_cv(j,k)=frac_cv(j,k)/Ncolumns
-            prec_ls(j,k)=prec_ls(j,k)/Ncolumns
-            prec_cv(j,k)=prec_cv(j,k)/Ncolumns
-        enddo  !k
-        enddo  !j
-        
-         ! Levels from SURFACE to TOA.
-        if (Npoints*Ncolumns*Nlevels < 10000) then
-            sgx%frac_out(1:Npoints,:,1:Nlevels)  = sgx%frac_out(1:Npoints,:,Nlevels:1:-1)
-            sgx%prec_frac(1:Npoints,:,1:Nlevels) = sgx%prec_frac(1:Npoints,:,Nlevels:1:-1)
-        else
-            ! This is done within a loop (unvectorized) over nPoints to save memory
-            do j=1,Npoints
-                sgx%frac_out(j,:,1:Nlevels)  = sgx%frac_out(j,:,Nlevels:1:-1)
-                sgx%prec_frac(j,:,1:Nlevels) = sgx%prec_frac(j,:,Nlevels:1:-1)
-            enddo
-        endif
-       
-       ! Deallocate arrays that will no longer be used
-        deallocate(tca_scops,cca_scops,ls_p_rate,cv_p_rate)
-
-        ! Populate the subgrid arrays
-        call construct_cosp_sghydro(Npoints,Ncolumns,Nlevels,Nhydro,sghydro)
-        do k=1,Ncolumns
-            !--------- Mixing ratios for clouds and Reff for Clouds and precip -------
-            column_frac_out => sgx%frac_out(:,k,:)
-            where (column_frac_out == I_LSC)     !+++++++++++ LS clouds ++++++++
-                sghydro%mr_hydro(:,k,:,I_LSCLIQ) = gbx%mr_hydro(:,:,I_LSCLIQ)
-                sghydro%mr_hydro(:,k,:,I_LSCICE) = gbx%mr_hydro(:,:,I_LSCICE)
-
-                sghydro%Reff(:,k,:,I_LSCLIQ)     = gbx%Reff(:,:,I_LSCLIQ)
-                sghydro%Reff(:,k,:,I_LSCICE)     = gbx%Reff(:,:,I_LSCICE)
-
-                sghydro%Np(:,k,:,I_LSCLIQ)     = gbx%Np(:,:,I_LSCLIQ)
-                sghydro%Np(:,k,:,I_LSCICE)     = gbx%Np(:,:,I_LSCICE)
-
-            elsewhere (column_frac_out == I_CVC) !+++++++++++ CONV clouds ++++++++
-                sghydro%mr_hydro(:,k,:,I_CVCLIQ) = gbx%mr_hydro(:,:,I_CVCLIQ)
-                sghydro%mr_hydro(:,k,:,I_CVCICE) = gbx%mr_hydro(:,:,I_CVCICE)
-
-                sghydro%Reff(:,k,:,I_CVCLIQ)     = gbx%Reff(:,:,I_CVCLIQ)
-                sghydro%Reff(:,k,:,I_CVCICE)     = gbx%Reff(:,:,I_CVCICE)
-
-                sghydro%Np(:,k,:,I_CVCLIQ)     = gbx%Np(:,:,I_CVCLIQ)
-                sghydro%Np(:,k,:,I_CVCICE)     = gbx%Np(:,:,I_CVCICE)
-
-            end where
-            column_prec_out => sgx%prec_frac(:,k,:)
-            where ((column_prec_out == 1) .or. (column_prec_out == 3) )  !++++ LS precip ++++
-                sghydro%Reff(:,k,:,I_LSRAIN) = gbx%Reff(:,:,I_LSRAIN)
-                sghydro%Reff(:,k,:,I_LSSNOW) = gbx%Reff(:,:,I_LSSNOW)
-                sghydro%Reff(:,k,:,I_LSGRPL) = gbx%Reff(:,:,I_LSGRPL)
-
-                sghydro%Np(:,k,:,I_LSRAIN)     = gbx%Np(:,:,I_LSRAIN)
-                sghydro%Np(:,k,:,I_LSSNOW)     = gbx%Np(:,:,I_LSSNOW)
-                sghydro%Np(:,k,:,I_LSGRPL)     = gbx%Np(:,:,I_LSGRPL)
-            elsewhere ((column_prec_out == 2) .or. (column_prec_out == 3)) !++++ CONV precip ++++
-                sghydro%Reff(:,k,:,I_CVRAIN) = gbx%Reff(:,:,I_CVRAIN)
-                sghydro%Reff(:,k,:,I_CVSNOW) = gbx%Reff(:,:,I_CVSNOW)
-
-                sghydro%Np(:,k,:,I_CVRAIN)     = gbx%Np(:,:,I_CVRAIN)
-                sghydro%Np(:,k,:,I_CVSNOW)     = gbx%Np(:,:,I_CVSNOW)
-            end where
-            !--------- Precip -------
-            if (.not. gbx%use_precipitation_fluxes) then
-                where (column_frac_out == I_LSC)  !+++++++++++ LS Precipitation ++++++++
-                    sghydro%mr_hydro(:,k,:,I_LSRAIN) = gbx%mr_hydro(:,:,I_LSRAIN)
-                    sghydro%mr_hydro(:,k,:,I_LSSNOW) = gbx%mr_hydro(:,:,I_LSSNOW)
-                    sghydro%mr_hydro(:,k,:,I_LSGRPL) = gbx%mr_hydro(:,:,I_LSGRPL)
-                elsewhere (column_frac_out == I_CVC) !+++++++++++ CONV Precipitation ++++++++
-                    sghydro%mr_hydro(:,k,:,I_CVRAIN) = gbx%mr_hydro(:,:,I_CVRAIN)
-                    sghydro%mr_hydro(:,k,:,I_CVSNOW) = gbx%mr_hydro(:,:,I_CVSNOW)
-                end where 
-            endif
-        enddo
-        ! convert the mixing ratio and precipitation flux from gridbox mean to the fraction-based values
-        do k=1,Nlevels
-            do j=1,Npoints
-                !--------- Clouds -------
-                if (frac_ls(j,k) .ne. 0.) then
-                    sghydro%mr_hydro(j,:,k,I_LSCLIQ) = sghydro%mr_hydro(j,:,k,I_LSCLIQ)/frac_ls(j,k)
-                    sghydro%mr_hydro(j,:,k,I_LSCICE) = sghydro%mr_hydro(j,:,k,I_LSCICE)/frac_ls(j,k)
-                endif
-                if (frac_cv(j,k) .ne. 0.) then
-                    sghydro%mr_hydro(j,:,k,I_CVCLIQ) = sghydro%mr_hydro(j,:,k,I_CVCLIQ)/frac_cv(j,k)
-                    sghydro%mr_hydro(j,:,k,I_CVCICE) = sghydro%mr_hydro(j,:,k,I_CVCICE)/frac_cv(j,k)
-                endif
-                !--------- Precip -------
-                if (gbx%use_precipitation_fluxes) then
-                    if (prec_ls(j,k) .ne. 0.) then
-                        gbx%rain_ls(j,k) = gbx%rain_ls(j,k)/prec_ls(j,k)
-                        gbx%snow_ls(j,k) = gbx%snow_ls(j,k)/prec_ls(j,k)
-                        gbx%grpl_ls(j,k) = gbx%grpl_ls(j,k)/prec_ls(j,k)
-                    endif
-                    if (prec_cv(j,k) .ne. 0.) then
-                        gbx%rain_cv(j,k) = gbx%rain_cv(j,k)/prec_cv(j,k)
-                        gbx%snow_cv(j,k) = gbx%snow_cv(j,k)/prec_cv(j,k)
-                    endif
-                else
-                    if (prec_ls(j,k) .ne. 0.) then
-                        sghydro%mr_hydro(j,:,k,I_LSRAIN) = sghydro%mr_hydro(j,:,k,I_LSRAIN)/prec_ls(j,k)
-                        sghydro%mr_hydro(j,:,k,I_LSSNOW) = sghydro%mr_hydro(j,:,k,I_LSSNOW)/prec_ls(j,k)
-                        sghydro%mr_hydro(j,:,k,I_LSGRPL) = sghydro%mr_hydro(j,:,k,I_LSGRPL)/prec_ls(j,k)
-                    endif
-                    if (prec_cv(j,k) .ne. 0.) then
-                        sghydro%mr_hydro(j,:,k,I_CVRAIN) = sghydro%mr_hydro(j,:,k,I_CVRAIN)/prec_cv(j,k)
-                        sghydro%mr_hydro(j,:,k,I_CVSNOW) = sghydro%mr_hydro(j,:,k,I_CVSNOW)/prec_cv(j,k)
-                    endif
-                endif  
-            enddo !k
-        enddo !j
-        deallocate(frac_ls,prec_ls,frac_cv,prec_cv)
-        
-        if (gbx%use_precipitation_fluxes) then
-        
-#ifdef MMF_V3p5_TWO_MOMENT
-
-        write(*,*) 'Precipitation Flux to Mixing Ratio conversion not (yet?) supported ', &
-               'for MMF3.5 Two Moment Microphysics'
-        stop
-#else
-            ! Density
-            allocate(rho(Npoints,Nlevels))
-            I_HYDRO = I_LSRAIN
-            call cosp_precip_mxratio(Npoints,Nlevels,Ncolumns,gbx%p,gbx%T,sgx%prec_frac,1., &
-                    n_ax(I_HYDRO),n_bx(I_HYDRO),alpha_x(I_HYDRO),c_x(I_HYDRO),d_x(I_HYDRO), &
-                    g_x(I_HYDRO),a_x(I_HYDRO),b_x(I_HYDRO), &
-                    gamma_1(I_HYDRO),gamma_2(I_HYDRO),gamma_3(I_HYDRO),gamma_4(I_HYDRO), &
-                    gbx%rain_ls,sghydro%mr_hydro(:,:,:,I_HYDRO),sghydro%Reff(:,:,:,I_HYDRO))
-            I_HYDRO = I_LSSNOW
-            call cosp_precip_mxratio(Npoints,Nlevels,Ncolumns,gbx%p,gbx%T,sgx%prec_frac,1., &
-                    n_ax(I_HYDRO),n_bx(I_HYDRO),alpha_x(I_HYDRO),c_x(I_HYDRO),d_x(I_HYDRO), &
-                    g_x(I_HYDRO),a_x(I_HYDRO),b_x(I_HYDRO), &
-                    gamma_1(I_HYDRO),gamma_2(I_HYDRO),gamma_3(I_HYDRO),gamma_4(I_HYDRO), &
-                    gbx%snow_ls,sghydro%mr_hydro(:,:,:,I_HYDRO),sghydro%Reff(:,:,:,I_HYDRO))
-            I_HYDRO = I_CVRAIN
-            call cosp_precip_mxratio(Npoints,Nlevels,Ncolumns,gbx%p,gbx%T,sgx%prec_frac,2., &
-                    n_ax(I_HYDRO),n_bx(I_HYDRO),alpha_x(I_HYDRO),c_x(I_HYDRO),d_x(I_HYDRO), &
-                    g_x(I_HYDRO),a_x(I_HYDRO),b_x(I_HYDRO), &
-                    gamma_1(I_HYDRO),gamma_2(I_HYDRO),gamma_3(I_HYDRO),gamma_4(I_HYDRO), &
-                    gbx%rain_cv,sghydro%mr_hydro(:,:,:,I_HYDRO),sghydro%Reff(:,:,:,I_HYDRO))
-            I_HYDRO = I_CVSNOW
-            call cosp_precip_mxratio(Npoints,Nlevels,Ncolumns,gbx%p,gbx%T,sgx%prec_frac,2., &
-                    n_ax(I_HYDRO),n_bx(I_HYDRO),alpha_x(I_HYDRO),c_x(I_HYDRO),d_x(I_HYDRO), &
-                    g_x(I_HYDRO),a_x(I_HYDRO),b_x(I_HYDRO), &
-                    gamma_1(I_HYDRO),gamma_2(I_HYDRO),gamma_3(I_HYDRO),gamma_4(I_HYDRO), &
-                    gbx%snow_cv,sghydro%mr_hydro(:,:,:,I_HYDRO),sghydro%Reff(:,:,:,I_HYDRO))
-            I_HYDRO = I_LSGRPL
-            call cosp_precip_mxratio(Npoints,Nlevels,Ncolumns,gbx%p,gbx%T,sgx%prec_frac,1., &
-                    n_ax(I_HYDRO),n_bx(I_HYDRO),alpha_x(I_HYDRO),c_x(I_HYDRO),d_x(I_HYDRO), &
-                    g_x(I_HYDRO),a_x(I_HYDRO),b_x(I_HYDRO), &
-                    gamma_1(I_HYDRO),gamma_2(I_HYDRO),gamma_3(I_HYDRO),gamma_4(I_HYDRO), &
-                    gbx%grpl_ls,sghydro%mr_hydro(:,:,:,I_HYDRO),sghydro%Reff(:,:,:,I_HYDRO))
-            if(allocated(rho)) deallocate(rho)
-#endif
-
-        endif
-   !++++++++++ CRM mode ++++++++++
-   else
-      call construct_cosp_sghydro(Npoints,Ncolumns,Nlevels,Nhydro,sghydro)
-      sghydro%mr_hydro(:,1,:,:) = gbx%mr_hydro
-      sghydro%Reff(:,1,:,:) = gbx%Reff
-      sghydro%Np(:,1,:,:) = gbx%Np      ! added by Roj with Quickbeam V3.0
-      
-      !--------- Clouds -------
-      where ((gbx%dtau_s > 0.0))
-             sgx%frac_out(:,1,:) = 1  ! Subgrid cloud array. Dimensions (Npoints,Ncolumns,Nlevels)
-      endwhere
-   endif ! Ncolumns > 1
-  
-   !++++++++++ Simulator ++++++++++
-!#ifdef RTTOV
-!    call cosp_simulator(gbx,sgx,sghydro,cfg,vgrid,sgradar,sglidar,isccp,misr,modis,rttov,stradar,stlidar)
-!#else
-    call cosp_simulator(gbx,sgx,sghydro,cfg,vgrid,sgradar,sglidar,isccp,misr,modis,stradar,stlidar)
-!#endif
-
-    ! Deallocate subgrid arrays
-    call free_cosp_sghydro(sghydro)
-END SUBROUTINE COSP_ITER
-
-END MODULE MOD_COSP
Index: LMDZ6/trunk/libf/phylmd/cosp/cosp_constants.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/cosp/cosp_constants.F90	(revision 3232)
+++ 	(revision )
@@ -1,304 +1,0 @@
-! (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.
-
-!
-! History:
-! Jul 2007 - A. Bodas-Salcedo - Initial version
-! Jul 2008 - A. Bodas-Salcedo - Added definitions of ISCCP axes
-! Oct 2008 - H. Chepfer       - Added PARASOL_NREFL
-! Jun 2010 - R. Marchand      - Modified to support quickbeam V3, added ifdef for hydrometeor definitions
-! 
-!
-! 
-
-#include "cosp_defs.h"
-MODULE MOD_COSP_CONSTANTS
-    IMPLICIT NONE
-
-    character(len=32) :: COSP_VERSION='COSP v1.4'
-
-    ! Indices to address arrays of LS and CONV hydrometeors
-    integer,parameter :: I_LSCLIQ = 1
-    integer,parameter :: I_LSCICE = 2
-    integer,parameter :: I_LSRAIN = 3
-    integer,parameter :: I_LSSNOW = 4
-    integer,parameter :: I_CVCLIQ = 5
-    integer,parameter :: I_CVCICE = 6
-    integer,parameter :: I_CVRAIN = 7
-    integer,parameter :: I_CVSNOW = 8
-    integer,parameter :: I_LSGRPL = 9
-
-    ! Missing value
-    real,parameter :: R_UNDEF = -1.0E30
-
-    ! Number of possible output variables
-    integer,parameter :: N_OUT_LIST = 74 !OPAQ 65+7 !TIBO 72+2
-    integer,parameter :: N3D = 11                   !TIBO 10+1
-    integer,parameter :: N2D = 19        !OPAQ 14+4 !TIBO 18+1
-    integer,parameter :: N1D = 43        !OPAQ 40+3
-
-    ! Value for forward model result from a level that is under the ground
-    real,parameter :: R_GROUND = -1.0E20
-
-    ! Stratiform and convective clouds in frac_out
-    integer, parameter :: I_LSC = 1, & ! Large-scale clouds
-                          I_CVC = 2    ! Convective clouds
-
-    ! Timing of different simulators, including statistics module
-    integer, parameter :: N_SIMULATORS = 7
-    integer,parameter :: I_RADAR = 1
-    integer,parameter :: I_LIDAR = 2
-    integer,parameter :: I_ISCCP = 3
-    integer,parameter :: I_MISR  = 4
-    integer,parameter :: I_MODIS = 5
-    integer,parameter :: I_RTTOV = 6
-    integer,parameter :: I_STATS = 7
-    character*32, dimension(N_SIMULATORS) :: SIM_NAME = (/'Radar','Lidar','ISCCP','MISR ','MODIS','RTTOV','Stats'/)
-    integer,dimension(N_SIMULATORS) :: tsim
-    data tsim/N_SIMULATORS*0.0/
-
-    !--- Radar constants
-    ! CFAD constants
-    integer,parameter :: DBZE_BINS     =   15   ! Number of dBZe bins in histogram (cfad)
-    real,parameter    :: DBZE_MIN      = -100.0 ! Minimum value for radar reflectivity
-    real,parameter    :: DBZE_MAX      =   80.0 ! Maximum value for radar reflectivity
-    real,parameter    :: CFAD_ZE_MIN   =  -50.0 ! Lower value of the first CFAD Ze bin
-    real,parameter    :: CFAD_ZE_WIDTH =    5.0 ! Bin width (dBZe)
-
-
-    !--- Lidar constants
-    ! CFAD constants
-    integer,parameter :: SR_BINS       =   15
-    integer,parameter :: DPOL_BINS     =   6
-    real,parameter    :: LIDAR_UNDEF   =   999.999
-
-    ! Other constants
-    integer,parameter :: LIDAR_NCAT    =   4
-    integer,parameter :: LIDAR_NTYPE   =   3 !OPAQ
-    integer,parameter :: PARASOL_NREFL =   5 ! parasol
-    real,parameter,dimension(PARASOL_NREFL) :: PARASOL_SZA = (/0.0, 20.0, 40.0, 60.0, 80.0/)
-    real,parameter    :: DEFAULT_LIDAR_REFF = 30.0e-6 ! Default lidar effective radius
-
-    integer,parameter :: LIDAR_NTEMP = 40
-    real,parameter,dimension(LIDAR_NTEMP) :: LIDAR_PHASE_TEMP=(/-91.5,-88.5,-85.5,-82.5,-79.5,-76.5,-73.5,-70.5,-67.5,-64.5, &
-                   -61.5,-58.5,-55.5,-52.5,-49.5,-46.5,-43.5,-40.5,-37.5,-34.5, &
-                   -31.5,-28.5,-25.5,-22.5,-19.5,-16.5,-13.5,-10.5, -7.5, -4.5, &
-                    -1.5,  1.5,  4.5,  7.5, 10.5, 13.5, 16.5, 19.5, 22.5, 25.5/)
-    real,parameter,dimension(2,LIDAR_NTEMP) :: LIDAR_PHASE_TEMP_BNDS=reshape(source=(/-273.15,-90.,-90.,-87.,-87.,-84.,-84.,-81.,-81.,-78., &
-                   -78.,-75.,-75.,-72.,-72.,-69.,-69.,-66.,-66.,-63., &
-                   -63.,-60.,-60.,-57.,-57.,-54.,-54.,-51.,-51.,-48., &
-                   -48.,-45.,-45.,-42.,-42.,-39.,-39.,-36.,-36.,-33., &
-                   -33.,-30.,-30.,-27.,-27.,-24.,-24.,-21.,-21.,-18., &
-                   -18.,-15.,-15.,-12.,-12., -9., -9., -6., -6., -3., &
-                    -3.,  0.,  0.,  3.,  3.,  6.,  6.,  9.,  9., 12., &
-                    12., 15., 15., 18., 18., 21., 21., 24., 24.,100./),shape=(/2,40/))
-
-    !--- MISR constants
-    integer,parameter :: MISR_N_CTH = 16
-
-    !--- RTTOV constants
-    integer,parameter :: RTTOV_MAX_CHANNELS = 20
-
-    ! ISCCP tau-Pc axes
-    real,parameter,dimension(7) :: ISCCP_TAU = (/0.15, 0.80, 2.45, 6.5, 16.2, 41.5, 100.0/)
-    real,parameter,dimension(2,7) :: ISCCP_TAU_BNDS = reshape(source=(/0.0,0.3,0.3,1.30,1.30,3.6,3.6,9.4, &
-                                                      9.4,23.0,23.0,60.0,60.0,100000.0/), shape=(/2,7/))
-
-    real,parameter,dimension(7) :: ISCCP_PC = (/90000., 74000., 62000., 50000., 37500., 24500., 9000./)
-    real,parameter,dimension(2,7) :: ISCCP_PC_BNDS = reshape(source=(/100000.0,80000.0,80000.0,68000.0,68000.0,56000.0 &
-                               ,56000.0,44000.0,44000.0,31000.0,31000.0,18000.0,18000.0,0.0/), shape=(/2,7/))
-
-    real,parameter,dimension(MISR_N_CTH) :: MISR_CTH = 1000.0*(/ 0., 0.25, 0.75, 1.25, 1.75, 2.25, 2.75, 3.5, &
-                                            4.5, 6., 8., 10., 12., 14.5, 16., 18./)
-    real,parameter,dimension(2,MISR_N_CTH) :: MISR_CTH_BNDS = 1000.0*reshape(source=(/ &
-                                            -99.0,  0.0,       0.0,  0.5,       0.5,  1.0,      1.0,  1.5, &
-                                              1.5,  2.0,       2.0,  2.5,       2.5,  3.0,      3.0,  4.0, &
-                                              4.0,  5.0,       5.0,  7.0,       7.0,  9.0,      9.0, 11.0, &
-                                             11.0, 13.0,      13.0, 15.0,      15.0, 17.0,     17.0, 99.0/), &
-                                             shape=(/2,MISR_N_CTH/))
-
-
-    !
-    ! The following code was modifed by Roj with implementation of quickbeam V3
-    !   (1) use ifdef to support more than one microphyscis scheme 
-    !   (2) added constants  microphysic_scheme_name, LOAD_scale_LUTs, and SAVE_scale_LUTs 
-    !
-
-    ! directory where LUTs will be stored
-    character*120 :: RADAR_SIM_LUT_DIRECTORY = './'
-
-#ifdef MMF_V3_SINGLE_MOMENT
-
-    !        
-    !  Table hclass for quickbeam to support one-moment (bulk) microphysics scheme used by MMF V3.0 & V3.5
-    !
-
-    !
-    ! NOTE:  if ANY value in this section of code is changed, the existing LUT 
-    !        (i.e., the associated *.dat file) MUST be deleted so that a NEW
-    !        LUT will be created !!!
-    !
-    character*120 :: RADAR_SIM_MICROPHYSICS_SCHEME_NAME = 'MMF_v3_single_moment'
-
-    logical :: RADAR_SIM_LOAD_scale_LUTs_flag   = .false.
-    logical :: RADAR_SIM_UPDATE_scale_LUTs_flag = .false.
-    integer,parameter :: N_HYDRO = 9
-
-    integer :: HCLASS_TYPE(N_HYDRO),HCLASS_PHASE(N_HYDRO)
-
-    real :: HCLASS_DMIN(N_HYDRO),HCLASS_DMAX(N_HYDRO), &
-            HCLASS_APM(N_HYDRO),HCLASS_BPM(N_HYDRO),HCLASS_RHO(N_HYDRO), &
-            HCLASS_P1(N_HYDRO),HCLASS_P2(N_HYDRO),HCLASS_P3(N_HYDRO)
-
-    ! HCLASS_CP is not used in the version of Quickbeam included in COSP
-    !                   LSL    LSI      LSR     LSS   CVL    CVI   CVR     CVS   LSG
-    data HCLASS_TYPE/    5,      1,      2,      2,     5,     1,   2,      2,    2/
-    data HCLASS_PHASE/   0,      1,      0,      1,     0,     1,   0,      1,    1/
-    data HCLASS_DMIN/   -1,     -1,     -1,     -1,    -1,    -1,   -1,    -1,   -1/
-    data HCLASS_DMAX/   -1,     -1,     -1,     -1,    -1,    -1,   -1,    -1,   -1/
-    data HCLASS_APM/   524,  110.8,    524,     -1,   524, 110.8,  524,    -1,   -1/
-    data HCLASS_BPM/     3,   2.91,      3,     -1,     3,  2.91,    3,    -1,   -1/
-    data HCLASS_RHO/    -1,     -1,     -1,    100,    -1,    -1,   -1,   100,  400/
-    data HCLASS_P1/     -1,     -1,   8.e6,   3.e6,    -1,    -1, 8.e6,  3.e6, 4.e6/
-    data HCLASS_P2/      6,     40,     -1,      -1,    6,    40,   -1,    -1,   -1/
-    data HCLASS_P3/    0.3,      2,     -1,      -1,  0.3,     2,   -1,    -1,   -1/
-
-    ! NOTES on HCLASS variables
-    !
-    ! TYPE - Set to
-    ! 1 for modified gamma distribution,
-    ! 2 for exponential distribution,
-    ! 3 for power law distribution,
-    ! 4 for monodisperse distribution,
-    ! 5 for lognormal distribution.
-
-    ! PHASE - Set to 0 for liquid, 1 for ice.
-
-    ! DMIN - The minimum drop size for this class (micron), ignored for monodisperse.
-    ! DMAX - The maximum drop size for this class (micron), ignored for monodisperse.
-    ! Important note: The settings for DMIN and DMAX are
-    ! ignored in the current version for all distributions except for power
-    ! law. Except when the power law distribution is used, particle size
-    ! is fixed to vary from zero to infinity, a restriction that is expected
-    ! to be lifted in future versions. A placeholder must still be specified
-    ! for each.
-
-    ! Density of particles is given by apm*D^bpm or a fixed value rho. ONLY specify ONE of these two!!
-    ! APM - The alpha_m coefficient in equation (1) (kg m**-beta_m )
-    ! BPM - The beta_m coefficient in equation (1), see section 4.1.
-
-    ! RHO - Hydrometeor density (kg m-3 ).
-
-    ! P1, P2, P3 - are default distribution parameters that depend on the type
-    ! of distribution (see quickmbeam documentation for more information)
-    !
-    ! Modified Gamma (must set P3 and one of P1 or P2)
-    ! P1 - Set to the total particle number concentration Nt /rho_a (kg-1 ), where
-    ! rho_a is the density of air in the radar volume.
-    ! P2 - Set to the particle mean diameter D (micron).
-    ! P3 - Set to the distribution width nu.
-    !
-    ! Exponetial (set one of)
-    ! P1 - Set to a constant intercept parameter N0 (m-4).
-    ! P2 - Set to a constant lambda (micron-1).
-    !
-    ! Power Law
-    ! P1 - Set this to the value of a constant power law parameter br
-    !
-    ! Monodisperse
-    ! P1 - Set to a constant diameter D0 (micron) = Re.
-    !
-    ! Log-normal (must set P3 and one of P1 or P2)
-    ! P1 - Set to the total particle number concentration Nt /rho_a (kg-1 )
-    ! P2 - Set to the geometric mean particle radius rg (micron).
-    ! P3 - Set to the natural logarithm of the geometric standard deviation.
-    !
-
-
-    real,dimension(N_HYDRO) :: N_ax,N_bx,alpha_x,c_x,d_x,g_x,a_x,b_x,gamma_1,gamma_2,gamma_3,gamma_4
-
-    ! Microphysical settings for the precipitation flux to mixing ratio conversion
-    !                LSL    LSI       LSR       LSS   CVL    CVI       CVR       CVS      LSG
-    data N_ax/       -1.,   -1.,     8.e6,     3.e6,  -1.,   -1.,     8.e6,     3.e6,     4.e6/
-    data N_bx/       -1.,   -1.,      0.0,      0.0,  -1.,   -1.,      0.0,      0.0,      0.0/
-    data alpha_x/    -1.,   -1.,      0.0,      0.0,  -1.,   -1.,      0.0,      0.0,      0.0/
-    data c_x/        -1.,   -1.,    842.0,     4.84,  -1.,   -1.,    842.0,     4.84,     94.5/
-    data d_x/        -1.,   -1.,      0.8,     0.25,  -1.,   -1.,      0.8,     0.25,      0.5/
-    data g_x/        -1.,   -1.,      0.5,      0.5,  -1.,   -1.,      0.5,      0.5,      0.5/
-    data a_x/        -1.,   -1.,    524.0,    52.36,  -1.,   -1.,    524.0,    52.36,   209.44/
-    data b_x/        -1.,   -1.,      3.0,      3.0,  -1.,   -1.,      3.0,      3.0,      3.0/
-    data gamma_1/    -1.,   -1., 17.83725, 8.284701,  -1.,   -1., 17.83725, 8.284701, 11.63230/
-    data gamma_2/    -1.,   -1.,      6.0,      6.0,  -1.,   -1.,      6.0,      6.0,      6.0/
-    data gamma_3/    -1.,   -1.,      2.0,      2.0,  -1.,   -1.,      2.0,      2.0,      2.0/
-    data gamma_4/    -1.,   -1.,      6.0,      6.0,  -1.,   -1.,      6.0,      6.0,      6.0/
-
-
-
-#endif
-
-
-#ifdef MMF_V3p5_TWO_MOMENT
-
-    !
-    !  Table hclass for quickbeam to support two-moment "morrison" microphysics scheme used by V3.5 (SAM 6.8)
-    !
-    !  This Number concentriation Np in [1/kg] MUST be input to COSP/radar simulator
-    !
-    !  NOTE:  Be sure to check that the ice-density (rho) set it this tables matches what you used
-    !
-
-    !
-    ! NOTE:  if ANY value in this section of code is changed, the existing LUT 
-    !        (i.e., the associated *.dat file) MUST be deleted so that a NEW
-    !        LUT will be created !!!
-    !
-    character*120 :: RADAR_SIM_MICROPHYSICS_SCHEME_NAME = 'MMF_v3.5_two_moment'
-
-    logical :: RADAR_SIM_LOAD_scale_LUTs_flag   = .false.
-    logical :: RADAR_SIM_UPDATE_scale_LUTs_flag = .false.
-
-    integer,parameter :: N_HYDRO = 9
-
-    integer :: HCLASS_TYPE(N_HYDRO),HCLASS_PHASE(N_HYDRO) 
-
-    real :: HCLASS_DMIN(N_HYDRO),HCLASS_DMAX(N_HYDRO), &           
-            HCLASS_APM(N_HYDRO),HCLASS_BPM(N_HYDRO),HCLASS_RHO(N_HYDRO), &
-            HCLASS_P1(N_HYDRO),HCLASS_P2(N_HYDRO),HCLASS_P3(N_HYDRO)
-
-    ! HCLASS_CP is not used in the version of Quickbeam included in COSP
-    !                   LSL    LSI      LSR     LSS   CVL    CVI   CVR     CVS   LSG
-    data HCLASS_TYPE/    1,      1,      1,      1,     1,     1,    1,      1,    1/
-    data HCLASS_PHASE/   0,      1,      0,      1,     0,     1,    0,      1,    1/
-    data HCLASS_DMIN/   -1,     -1,     -1,     -1,    -1,    -1,   -1,     -1,   -1/
-    data HCLASS_DMAX/   -1,     -1,     -1,     -1,    -1,    -1,   -1,     -1,   -1/
-    data HCLASS_APM/   524,     -1,    524,     -1,   524,    -1,  524,     -1,   -1/
-    data HCLASS_BPM/     3,     -1,      3,     -1,     3,    -1,    3,     -1,   -1/
-    data HCLASS_RHO/    -1,    500,     -1,    100,    -1,   500,   -1,    100,  900/
-    data HCLASS_P1/     -1,     -1,     -1,     -1,    -1,    -1,   -1,     -1,   -1/
-    data HCLASS_P2/     -1,     -1,     -1,     -1,    -1,    -1,   -1,     -1,   -1/
-    data HCLASS_P3/     -2,      1,      1,      1,    -2,     1,    1,      1,    1/
-    ! Note: value of "-2" for HCLASS_P3 uses martin 1994 parameteriztion of gamma function width with Number concentration
-#endif
-
-END MODULE MOD_COSP_CONSTANTS
Index: LMDZ6/trunk/libf/phylmd/cosp/cosp_isccp_simulator.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/cosp/cosp_isccp_simulator.F90	(revision 3232)
+++ 	(revision )
@@ -1,96 +1,0 @@
-! (c) British Crown Copyright 2008, the Met Office.
-! All rights reserved.
-! $Revision: 23 $, $Date: 2011-03-31 15:41:37 +0200 (jeu. 31 mars 2011) $
-! $URL: http://cfmip-obs-sim.googlecode.com/svn/stable/v1.4.0/cosp_isccp_simulator.F90 $
-! 
-! 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_ISCCP_SIMULATOR
-  USE MOD_COSP_CONSTANTS
-  USE MOD_COSP_TYPES
-  IMPLICIT NONE
-
-CONTAINS
-
-
-!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-!-------------- SUBROUTINE COSP_ISCCP_SIMULATOR -----------------
-!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-SUBROUTINE COSP_ISCCP_SIMULATOR(gbx,sgx,y)
-  
-  ! Arguments
-  type(cosp_gridbox),intent(in) :: gbx  ! Gridbox info
-  type(cosp_subgrid),intent(in) :: sgx  ! Subgridbox info
-  type(cosp_isccp),intent(inout) :: y   ! ISCCP simulator output
-  
-  ! Local variables 
-  integer :: Nlevels,Npoints
-  real :: pfull(gbx%Npoints, gbx%Nlevels)
-  real :: phalf(gbx%Npoints, gbx%Nlevels + 1)
-  real :: qv(gbx%Npoints, gbx%Nlevels)
-  real :: cc(gbx%Npoints, gbx%Nlevels)
-  real :: conv(gbx%Npoints, gbx%Nlevels)
-  real :: dtau_s(gbx%Npoints, gbx%Nlevels)
-  real :: dtau_c(gbx%Npoints, gbx%Nlevels)
-  real :: at(gbx%Npoints, gbx%Nlevels)
-  real :: dem_s(gbx%Npoints, gbx%Nlevels)
-  real :: dem_c(gbx%Npoints, gbx%Nlevels)
-  real :: frac_out(gbx%Npoints, gbx%Ncolumns, gbx%Nlevels)
-  integer :: sunlit(gbx%Npoints)
-  
-  Nlevels = gbx%Nlevels
-  Npoints = gbx%Npoints
-  ! Flip inputs. Levels from TOA to surface
-  pfull  = gbx%p(:,Nlevels:1:-1) 
-  phalf(:,1)         = 0.0 ! Top level
-  phalf(:,2:Nlevels+1) = gbx%ph(:,Nlevels:1:-1)
-  qv     = gbx%sh(:,Nlevels:1:-1) 
-  cc     = 0.999999*gbx%tca(:,Nlevels:1:-1) 
-  conv   = 0.999999*gbx%cca(:,Nlevels:1:-1) 
-  dtau_s = gbx%dtau_s(:,Nlevels:1:-1) 
-  dtau_c = gbx%dtau_c(:,Nlevels:1:-1) 
-  at     = gbx%T(:,Nlevels:1:-1) 
-  dem_s  = gbx%dem_s(:,Nlevels:1:-1) 
-  dem_c  = gbx%dem_c(:,Nlevels:1:-1) 
-  frac_out(1:Npoints,:,1:Nlevels) = sgx%frac_out(1:Npoints,:,Nlevels:1:-1)
-  sunlit = int(gbx%sunlit)
-  call icarus(0,0,gbx%npoints,sunlit,gbx%nlevels,gbx%ncolumns, &
-            pfull,phalf,qv,cc,conv,dtau_s,dtau_c, &
-            gbx%isccp_top_height,gbx%isccp_top_height_direction, &
-            gbx%isccp_overlap,frac_out, &
-            gbx%skt,gbx%isccp_emsfc_lw,at,dem_s,dem_c,y%fq_isccp,y%totalcldarea, &
-            y%meanptop,y%meantaucld,y%meanalbedocld, &
-            y%meantb,y%meantbclr,y%boxtau,y%boxptop)
-
-  ! Flip outputs. Levels from surface to TOA
-  ! --- (npoints,tau=7,pressure=7)
-  y%fq_isccp(:,:,:) = y%fq_isccp(:,:,7:1:-1)
-     
- 
-  ! Check if there is any value slightly greater than 1
-  where ((y%totalcldarea > 1.0-1.e-5) .and. (y%totalcldarea < 1.0+1.e-5))
-    y%totalcldarea = 1.0
-  endwhere
-              
-END SUBROUTINE COSP_ISCCP_SIMULATOR
-
-END MODULE MOD_COSP_ISCCP_SIMULATOR
Index: LMDZ6/trunk/libf/phylmd/cosp/cosp_lidar.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/cosp/cosp_lidar.F90	(revision 3232)
+++ 	(revision )
@@ -1,87 +1,0 @@
-! (c) British Crown Copyright 2008, the Met Office.
-! All rights reserved.
-! $Revision: 88 $, $Date: 2013-11-13 15:08:38 +0100 (mer. 13 nov. 2013) $
-! $URL: http://cfmip-obs-sim.googlecode.com/svn/stable/v1.4.0/cosp_lidar.F90 $
-! 
-! 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.
-
-!
-! History:
-! Jul 2007 - A. Bodas-Salcedo - Initial version
-! Oct 2008 - S. Bony          - Instructions "Call for large-scale cloud" removed  -> sgx%frac_out is used instead.
-!                               Call lidar_simulator changed (lsca, gbx%cca and depol removed; 
-!                               frac_out changed in sgx%frac_out)
-! Jun 2011 - G. Cesana        - Added betaperp_tot argument
-!
-! 
-MODULE MOD_COSP_LIDAR
-  USE MOD_COSP_CONSTANTS
-  USE MOD_COSP_TYPES
-  IMPLICIT NONE
-
-CONTAINS
-
-
-!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-!------------------- SUBROUTINE COSP_LIDAR ------------------------
-!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-SUBROUTINE COSP_LIDAR(gbx,sgx,sghydro,y)
-
-  ! Arguments
-  type(cosp_gridbox),intent(in) :: gbx  ! Gridbox info
-  type(cosp_subgrid),intent(in) :: sgx  ! Subgrid info
-  type(cosp_sghydro),intent(in) :: sghydro  ! Subgrid info for hydrometeors
-  type(cosp_sglidar),intent(inout) :: y ! Subgrid output
-
-  ! Local variables 
-  integer :: i
-  real :: presf(sgx%Npoints, sgx%Nlevels + 1)
-  real,dimension(sgx%Npoints, sgx%Nlevels) :: lsca,mr_ll,mr_li,mr_cl,mr_ci
-  real,dimension(sgx%Npoints, sgx%Nlevels) :: beta_tot,tau_tot
-  real,dimension(sgx%Npoints, sgx%Nlevels) :: betaperp_tot
-  real,dimension(sgx%Npoints, PARASOL_NREFL)  :: refle
-
-  presf(:,1:sgx%Nlevels) = gbx%ph
-  presf(:,sgx%Nlevels + 1) = 0.0
-  lsca = gbx%tca-gbx%cca
-  do i=1,sgx%Ncolumns
-      ! Temporary arrays for simulator call
-      mr_ll(:,:) = sghydro%mr_hydro(:,i,:,I_LSCLIQ)
-      mr_li(:,:) = sghydro%mr_hydro(:,i,:,I_LSCICE)
-      mr_cl(:,:) = sghydro%mr_hydro(:,i,:,I_CVCLIQ)
-      mr_ci(:,:) = sghydro%mr_hydro(:,i,:,I_CVCICE)
-      call lidar_simulator(sgx%Npoints, sgx%Nlevels, 4, PARASOL_NREFL, LIDAR_UNDEF  &
-                 , gbx%p, presf, gbx%T, mr_ll, mr_li, mr_cl, mr_ci &
-                 , gbx%Reff(:,:,I_LSCLIQ), gbx%Reff(:,:,I_LSCICE) &
-                 , gbx%Reff(:,:,I_CVCLIQ), gbx%Reff(:,:,I_CVCICE) &
-                 , gbx%lidar_ice_type, y%beta_mol, beta_tot &
-                 , betaperp_tot, tau_tot, refle )
-
-      y%betaperp_tot(:,i,:) = betaperp_tot(:,:)
-      y%beta_tot(:,i,:) = beta_tot(:,:)
-      y%tau_tot(:,i,:)  = tau_tot(:,:)
-      y%refl(:,i,:)     = refle(:,:)
-  enddo
-
-END SUBROUTINE COSP_LIDAR
-
-END MODULE MOD_COSP_LIDAR
Index: LMDZ6/trunk/libf/phylmd/cosp/cosp_misr_simulator.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/cosp/cosp_misr_simulator.F90	(revision 3232)
+++ 	(revision )
@@ -1,80 +1,0 @@
-! (c) British Crown Copyright 2008, the Met Office.
-! All rights reserved.
-! $Revision: 23 $, $Date: 2011-03-31 15:41:37 +0200 (jeu. 31 mars 2011) $
-! $URL: http://cfmip-obs-sim.googlecode.com/svn/stable/v1.4.0/cosp_misr_simulator.F90 $
-! 
-! 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.
-
-!
-! History:
-! Nov 2008 - A. Bodas-Salcedo - Initial version
-!
-!
-
-MODULE MOD_COSP_MISR_SIMULATOR
-  USE MOD_COSP_CONSTANTS
-  USE MOD_COSP_TYPES
-  IMPLICIT NONE
-
-CONTAINS
-
-
-!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-!-------------- SUBROUTINE COSP_MISR_SIMULATOR -----------------
-!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-SUBROUTINE COSP_MISR_SIMULATOR(gbx,sgx,y)
-  
-  ! Arguments
-  type(cosp_gridbox),intent(in) :: gbx  ! Gridbox info
-  type(cosp_subgrid),intent(in) :: sgx  ! Subgridbox info
-  type(cosp_misr),intent(inout) :: y    ! MISR simulator output
-  
-  ! Local variables 
-  integer :: Nlevels,Npoints
-  real :: dtau_s(gbx%Npoints, gbx%Nlevels)
-  real :: dtau_c(gbx%Npoints, gbx%Nlevels)
-  real :: at(gbx%Npoints, gbx%Nlevels)
-  real :: frac_out(gbx%Npoints, gbx%Ncolumns, gbx%Nlevels)
-  integer :: sunlit(gbx%Npoints)
-  
-  real :: zfull(gbx%Npoints, gbx%Nlevels) !  height (in meters) of full model levels (i.e. midpoints)
-                                          !  zfull(npoints,1)    is    top level of model
-                                          !  zfull(npoints,nlev) is bottom level of model
-     
-    
-  Nlevels = gbx%Nlevels
-  Npoints = gbx%Npoints
-  ! Levels from TOA to surface
-  zfull  = gbx%zlev(:,Nlevels:1:-1)
-  at     = gbx%T(:,Nlevels:1:-1) 
-  dtau_s = gbx%dtau_s(:,Nlevels:1:-1) 
-  dtau_c = gbx%dtau_c(:,Nlevels:1:-1) 
-  frac_out(1:Npoints,:,1:Nlevels) = sgx%frac_out(1:Npoints,:,Nlevels:1:-1)
-  sunlit = int(gbx%sunlit)
- 
-  call MISR_simulator(gbx%npoints,gbx%nlevels,gbx%ncolumns,&
-                     sunlit,zfull,at,dtau_s,dtau_c,frac_out, R_UNDEF, &
-                     y%fq_MISR,y%MISR_dist_model_layertops,y%MISR_meanztop,y%MISR_cldarea)
-            
-END SUBROUTINE COSP_MISR_SIMULATOR
-
-END MODULE MOD_COSP_MISR_SIMULATOR
Index: LMDZ6/trunk/libf/phylmd/cosp/cosp_modis_simulator.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/cosp/cosp_modis_simulator.F90	(revision 3232)
+++ 	(revision )
@@ -1,487 +1,0 @@
-! (c) 2009, Regents of the Unversity of Colorado
-!   Author: Robert Pincus, Cooperative Institute for Research in the Environmental Sciences
-! All rights reserved.
-! $Revision: 88 $, $Date: 2013-11-13 07:08:38 -0700 (Wed, 13 Nov 2013) $
-! $URL: http://cfmip-obs-sim.googlecode.com/svn/stable/v1.4.0/cosp_modis_simulator.F90 $
-! 
-! 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.
-!
-
-!
-! History:
-!   May 2009 - Robert Pincus - Initial version
-!   Dec 2009 - Robert Pincus - Tiny revisions
-!
-MODULE MOD_COSP_Modis_Simulator
-  USE MOD_COSP_CONSTANTS
-  USE MOD_COSP_TYPES
-  use mod_modis_sim, numModisTauBins      => numTauHistogramBins,      &
-                     numModisPressureBins => numPressureHistogramBins, &
-                     MODIS_TAU      => nominalTauHistogramCenters,     &
-                     MODIS_TAU_BNDS => nominalTauHistogramBoundaries,  &
-                     MODIS_PC       => nominalPressureHistogramCenters, &
-                     MODIS_PC_BNDS  => nominalPressureHistogramBoundaries                     
-  implicit none
-  !------------------------------------------------------------------------------------------------
-  ! Public type
-  !
-  ! Summary statistics from MODIS retrievals
-  type COSP_MODIS
-     ! Dimensions
-     integer :: Npoints   ! Number of gridpoints
-     
-     !
-     ! Grid means; dimension nPoints
-     ! 
-     real, dimension(:),       pointer :: & 
-       Cloud_Fraction_Total_Mean,       Cloud_Fraction_Water_Mean,       Cloud_Fraction_Ice_Mean,       &
-       Cloud_Fraction_High_Mean,        Cloud_Fraction_Mid_Mean,         Cloud_Fraction_Low_Mean,       &
-       Optical_Thickness_Total_Mean,    Optical_Thickness_Water_Mean,    Optical_Thickness_Ice_Mean,    &
-       Optical_Thickness_Total_LogMean, Optical_Thickness_Water_LogMean, Optical_Thickness_Ice_LogMean, &
-                                        Cloud_Particle_Size_Water_Mean,  Cloud_Particle_Size_Ice_Mean,  &
-       Cloud_Top_Pressure_Total_Mean,                                                                   &
-                                        Liquid_Water_Path_Mean,          Ice_Water_Path_Mean
-     !
-     ! Also need the ISCCP-type optical thickness/cloud top pressure histogram
-     !
-     real, dimension(:, :, :), pointer :: Optical_Thickness_vs_Cloud_Top_Pressure
-     real, dimension(:, :, :), pointer :: Optical_Thickness_vs_ReffICE
-     real, dimension(:, :, :), pointer :: Optical_Thickness_vs_ReffLIQ
-  end type COSP_MODIS 
-  
-contains
-  !------------------------------------------------------------------------------------------------
-  subroutine COSP_Modis_Simulator(gridBox, subCols, subcolHydro, isccpSim, modisSim)
-    ! Arguments
-    type(cosp_gridbox), intent(in   ) :: gridBox     ! Gridbox info
-    type(cosp_subgrid), intent(in   ) :: subCols     ! subCol indicators of convective/stratiform 
-    type(cosp_sghydro), intent(in   ) :: subcolHydro ! subcol hydrometeor contens
-    type(cosp_isccp),   intent(in   ) :: isccpSim    ! ISCCP simulator output
-    type(cosp_modis),   intent(  out) :: modisSim    ! MODIS simulator subcol output
-    
-    ! ------------------------------------------------------------
-    ! Local variables 
-    !   Leave space only for sunlit points
-    
-    integer :: nPoints, nSubCols, nLevels, nSunlit, i, j, k
-    
-    ! Grid-mean quanties;  dimensions nPoints, nLevels
-    real, &
-      dimension(count(gridBox%sunlit(:) > 0),                  gridBox%nLevels) :: &
-        temperature, pressureLayers
-    real, &
-      dimension(count(gridBox%sunlit(:) > 0),                  gridBox%nLevels + 1) :: &
-        pressureLevels
-    
-    ! Subcol quantities, dimension nPoints, nSubCols, nLevels 
-    real, &
-      dimension(count(gridBox%sunlit(:) > 0), subCols%nColumns, gridBox%nLevels) :: & 
-        opticalThickness, cloudWater, cloudIce, waterSize, iceSize
-    
-    ! Vertically-integrated subcol quantities; dimensions nPoints, nSubcols 
-    integer, &
-      dimension(count(gridBox%sunlit(:) > 0), subCols%nColumns) :: & 
-        retrievedPhase
-    real, &
-      dimension(count(gridBox%sunlit(:) > 0), subCols%nColumns) :: & 
-        isccpTau, isccpCloudTopPressure, retrievedCloudTopPressure, retrievedTau, retrievedSize  
-    
-    ! Vertically-integrated results
-    real, dimension(count(gridBox%sunlit(:) > 0)) :: & 
-        cfTotal, cfLiquid, cfIce,                &
-        cfHigh,  cfMid,    cfLow,                &
-        meanTauTotal, meanTauLiquid, meanTauIce, &
-        meanLogTauTotal, meanLogTauLiquid, meanLogTauIce , &
-        meanSizeLiquid, meanSizeIce,             &
-        meanCloudTopPressure,                    &
-        meanLiquidWaterPath, meanIceWaterPath
-        
-    real, dimension(count(gridBox%sunlit(:) > 0), numModisTauBins, numModisPressureBins) :: & 
-         jointHistogram
-    real, dimension(count(gridBox%sunlit(:) > 0), numModisTauBins, numMODISReffIceBins) :: & 
-         jointHistogram2
-    real, dimension(count(gridBox%sunlit(:) > 0), numModisTauBins, numMODISReffLiqBins) :: & 
-         jointHistogram3
-    
-    integer, dimension(count(gridBox%sunlit(:) >  0)) :: sunlit
-    integer, dimension(count(gridBox%sunlit(:) <= 0)) :: notSunlit
-    ! ------------------------------------------------------------
-    
-    !
-    ! Are there any sunlit points? 
-    !
-    nSunlit = count(gridBox%sunlit(:) > 0)
-    if(nSunlit > 0) then 
-      nLevels  = gridBox%Nlevels
-      nPoints  = gridBox%Npoints
-      nSubCols = subCols%Ncolumns
-      !
-      ! This is a vector index indicating which points are sunlit
-      !
-      sunlit(:)    = pack((/ (i, i = 1, nPoints ) /), mask =       gridBox%sunlit(:) > 0)
-      notSunlit(:) = pack((/ (i, i = 1, nPoints ) /), mask = .not. gridBox%sunlit(:) > 0)
-               
-      !
-      ! Copy needed quantities, reversing vertical order and removing points with no sunlight 
-      !
-      pressureLevels(:, 1) = 0.0 ! Top of model, following ISCCP sim
-      temperature(:, :)     = gridBox%T (sunlit(:), nLevels:1:-1) 
-      pressureLayers(:, :)  = gridBox%p (sunlit(:), nLevels:1:-1) 
-      pressureLevels(:, 2:) = gridBox%ph(sunlit(:), nLevels:1:-1) 
-      
-      !
-      ! Subcolumn properties - first stratiform cloud...
-      ! 
-      where(subCols%frac_out(sunlit(:), :, :) == I_LSC)
-        !opticalThickness(:, :, :) = & 
-        !               spread(gridBox%dtau_s      (sunlit(:),    :), dim = 2, nCopies = nSubCols)
-        cloudWater(:, :, :) = subcolHydro%mr_hydro(sunlit(:), :, :, I_LSCLIQ)
-        waterSize (:, :, :) = subcolHydro%reff    (sunlit(:), :, :, I_LSCLIQ)
-        cloudIce  (:, :, :) = subcolHydro%mr_hydro(sunlit(:), :, :, I_LSCICE)
-        iceSize   (:, :, :) = subcolHydro%reff    (sunlit(:), :, :, I_LSCICE)
-      elsewhere
-        opticalThickness(:, :, :) = 0.
-        cloudWater      (:, :, :) = 0.
-        cloudIce        (:, :, :) = 0.
-        waterSize       (:, :, :) = 0.
-        iceSize         (:, :, :) = 0.
-      end where 
-
-      ! Loop version of spread above - intrinsic doesn't work on certain platforms. 
-      do k = 1, nLevels
-        do j = 1, nSubCols
-          do i = 1, nSunlit
-            if(subCols%frac_out(sunlit(i), j, k) == I_LSC) then
-              opticalThickness(i, j, k) = gridBox%dtau_s(sunlit(i), k)
-            else
-              opticalThickness(i, j, k) = 0.   
-            end if 
-          end do 
-        end do
-      end do
-
-      !
-      ! .. then add convective cloud...
-      !
-      where(subCols%frac_out(sunlit(:), :, :) == I_CVC) 
-        !opticalThickness(:, :, :) = &
-        !               spread(gridBox%dtau_c(      sunlit(:),    :), dim = 2, nCopies = nSubCols)
-        cloudWater(:, :, :) = subcolHydro%mr_hydro(sunlit(:), :, :, I_CVCLIQ)
-        waterSize (:, :, :) = subcolHydro%reff    (sunlit(:), :, :, I_CVCLIQ)
-        cloudIce  (:, :, :) = subcolHydro%mr_hydro(sunlit(:), :, :, I_CVCICE)
-        iceSize   (:, :, :) = subcolHydro%reff    (sunlit(:), :, :, I_CVCICE)
-      end where
-
-      ! Loop version of spread above - intrinsic doesn't work on certain platforms. 
-      do k = 1, nLevels
-        do j = 1, nSubCols
-          do i = 1, nSunlit
-            if(subCols%frac_out(sunlit(i), j, k) == I_CVC) opticalThickness(i, j, k) = gridBox%dtau_c(sunlit(i), k)
-          end do 
-        end do
-      end do
-
-      !
-      ! Reverse vertical order 
-      !
-      opticalThickness(:, :, :)  = opticalThickness(:, :, nLevels:1:-1)
-      cloudWater      (:, :, :)  = cloudWater      (:, :, nLevels:1:-1)
-      waterSize       (:, :, :)  = waterSize       (:, :, nLevels:1:-1)
-      cloudIce        (:, :, :)  = cloudIce        (:, :, nLevels:1:-1)
-      iceSize         (:, :, :)  = iceSize         (:, :, nLevels:1:-1)
-      
-      isccpTau(:, :)              = isccpSim%boxtau (sunlit(:), :)
-      isccpCloudTopPressure(:, :) = isccpSim%boxptop(sunlit(:), :)
-      
-      do i = 1, nSunlit
-        call modis_L2_simulator(temperature(i, :), pressureLayers(i, :), pressureLevels(i, :),     &
-                                opticalThickness(i, :, :), cloudWater(i, :, :), cloudIce(i, :, :), &
-                                waterSize(i, :, :), iceSize(i, :, :),                       &
-                                isccpTau(i, :), isccpCloudTopPressure(i, :),                &
-                                retrievedPhase(i, :), retrievedCloudTopPressure(i, :),      & 
-                                retrievedTau(i, :), retrievedSize(i, :))
-     end do
-     
-      ! DJS2015: Call L3 modis simulator used by cospv2.0
-     ! call modis_L3_simulator(retrievedPhase,              &
-     !                         retrievedCloudTopPressure,   &
-     !                         retrievedTau, retrievedSize, &
-     !                         cfTotal,         cfLiquid,         cfIce,         &
-     !                         cfHigh,          cfMid,            cfLow,         &
-     !                         meanTauTotal,    meanTauLiquid,    meanTauIce,    &
-     !                         meanLogTauTotal, meanLogTauLiquid, meanLogTauIce, &
-     !                         meanSizeLiquid,   meanSizeIce,   &
-     !                         meanCloudTopPressure,                             &
-     !                         meanLiquidWaterPath, meanIceWaterPath, &
-     !                         jointHistogram)
-     call modis_column(nSunlit,nSubcols,retrievedPhase,retrievedCloudTopPressure,   &
-                        retrievedTau,retrievedSize,cfTotal,cfLiquid,cfIce,cfHigh,    &
-                        cfMid,cfLow,meanTauTotal,meanTauLiquid,meanTauIce,           &
-                        meanLogTauTotal,meanLogTauLiquid,meanLogTauIce,              &
-                        meanSizeLiquid,meanSizeIce,meanCloudTopPressure,             &
-                        meanLiquidWaterPath, meanIceWaterPath,                       &
-                        jointHistogram,jointHistogram2,jointHistogram3)
-      ! DJS2015: END
-      
-      !
-      ! Copy results into COSP structure
-      !
-      modisSim%Cloud_Fraction_Total_Mean(sunlit(:)) = cfTotal(:)
-      modisSim%Cloud_Fraction_Water_Mean(sunlit(:)) = cfLiquid
-      modisSim%Cloud_Fraction_Ice_Mean  (sunlit(:)) = cfIce
-  
-      modisSim%Cloud_Fraction_High_Mean(sunlit(:)) = cfHigh
-      modisSim%Cloud_Fraction_Mid_Mean (sunlit(:)) = cfMid
-      modisSim%Cloud_Fraction_Low_Mean (sunlit(:)) = cfLow
-  
-      modisSim%Optical_Thickness_Total_Mean(sunlit(:)) = meanTauTotal
-      modisSim%Optical_Thickness_Water_Mean(sunlit(:)) = meanTauLiquid
-      modisSim%Optical_Thickness_Ice_Mean  (sunlit(:)) = meanTauIce
-  
-      modisSim%Optical_Thickness_Total_LogMean(sunlit(:)) = meanLogTauTotal
-      modisSim%Optical_Thickness_Water_LogMean(sunlit(:)) = meanLogTauLiquid
-      modisSim%Optical_Thickness_Ice_LogMean  (sunlit(:)) = meanLogTauIce
-  
-      modisSim%Cloud_Particle_Size_Water_Mean(sunlit(:)) = meanSizeLiquid
-      modisSim%Cloud_Particle_Size_Ice_Mean  (sunlit(:)) = meanSizeIce
-  
-      modisSim%Cloud_Top_Pressure_Total_Mean(sunlit(:)) = meanCloudTopPressure
-  
-      modisSim%Liquid_Water_Path_Mean(sunlit(:)) = meanLiquidWaterPath
-      modisSim%Ice_Water_Path_Mean   (sunlit(:)) = meanIceWaterPath
-      
-      modisSim%Optical_Thickness_vs_Cloud_Top_Pressure(sunlit(:), 2:numModisTauBins+1, :) = jointHistogram(:, :, :)
-      modisSim%Optical_Thickness_vs_ReffICE(sunlit(:),2:numModisTauBins+1,:)              = jointHistogram2(:, :, :)
-      modisSim%Optical_Thickness_vs_ReffLIQ(sunlit(:),2:numModisTauBins+1,:)              = jointHistogram3(:, :, :)
-      ! 
-      ! Reorder pressure bins in joint histogram to go from surface to TOA 
-      !
-      modisSim%Optical_Thickness_vs_Cloud_Top_Pressure(:,:,:) = modisSim%Optical_Thickness_vs_Cloud_Top_Pressure(:, :, numModisPressureBins:1:-1)
-      if(nSunlit < nPoints) then 
-        !
-        ! Where it's night and we haven't done the retrievals the values are undefined
-        !
-        modisSim%Cloud_Fraction_Total_Mean(notSunlit(:)) = R_UNDEF
-        modisSim%Cloud_Fraction_Water_Mean(notSunlit(:)) = R_UNDEF
-        modisSim%Cloud_Fraction_Ice_Mean  (notSunlit(:)) = R_UNDEF
-    
-        modisSim%Cloud_Fraction_High_Mean(notSunlit(:)) = R_UNDEF
-        modisSim%Cloud_Fraction_Mid_Mean (notSunlit(:)) = R_UNDEF
-        modisSim%Cloud_Fraction_Low_Mean (notSunlit(:)) = R_UNDEF
-
-        modisSim%Optical_Thickness_Total_Mean(notSunlit(:)) = R_UNDEF
-        modisSim%Optical_Thickness_Water_Mean(notSunlit(:)) = R_UNDEF
-        modisSim%Optical_Thickness_Ice_Mean  (notSunlit(:)) = R_UNDEF
-    
-        modisSim%Optical_Thickness_Total_LogMean(notSunlit(:)) = R_UNDEF
-        modisSim%Optical_Thickness_Water_LogMean(notSunlit(:)) = R_UNDEF
-        modisSim%Optical_Thickness_Ice_LogMean  (notSunlit(:)) = R_UNDEF
-    
-        modisSim%Cloud_Particle_Size_Water_Mean(notSunlit(:)) = R_UNDEF
-        modisSim%Cloud_Particle_Size_Ice_Mean  (notSunlit(:)) = R_UNDEF
-    
-        modisSim%Cloud_Top_Pressure_Total_Mean(notSunlit(:)) = R_UNDEF
-    
-        modisSim%Liquid_Water_Path_Mean(notSunlit(:)) = R_UNDEF
-        modisSim%Ice_Water_Path_Mean   (notSunlit(:)) = R_UNDEF
-  
-        modisSim%Optical_Thickness_vs_Cloud_Top_Pressure(notSunlit(:), :, :) = R_UNDEF
-        modisSim%Optical_Thickness_vs_ReffICE(notSunlit(:), :, :) = R_UNDEF
-        modisSim%Optical_Thickness_vs_ReffLIQ(notSunlit(:), :, :) = R_UNDEF
-      end if 
-    else
-      !
-      ! It's nightime everywhere - everything is undefined
-      !
-      modisSim%Cloud_Fraction_Total_Mean(:) = R_UNDEF
-      modisSim%Cloud_Fraction_Water_Mean(:) = R_UNDEF
-      modisSim%Cloud_Fraction_Ice_Mean  (:) = R_UNDEF
-  
-      modisSim%Cloud_Fraction_High_Mean(:) = R_UNDEF
-      modisSim%Cloud_Fraction_Mid_Mean (:) = R_UNDEF
-      modisSim%Cloud_Fraction_Low_Mean (:) = R_UNDEF
-
-      modisSim%Optical_Thickness_Total_Mean(:) = R_UNDEF
-      modisSim%Optical_Thickness_Water_Mean(:) = R_UNDEF
-      modisSim%Optical_Thickness_Ice_Mean  (:) = R_UNDEF
-  
-      modisSim%Optical_Thickness_Total_LogMean(:) = R_UNDEF
-      modisSim%Optical_Thickness_Water_LogMean(:) = R_UNDEF
-      modisSim%Optical_Thickness_Ice_LogMean  (:) = R_UNDEF
-  
-      modisSim%Cloud_Particle_Size_Water_Mean(:) = R_UNDEF
-      modisSim%Cloud_Particle_Size_Ice_Mean  (:) = R_UNDEF
-  
-      modisSim%Cloud_Top_Pressure_Total_Mean(:) = R_UNDEF
-  
-      modisSim%Liquid_Water_Path_Mean(:) = R_UNDEF
-      modisSim%Ice_Water_Path_Mean   (:) = R_UNDEF
-  
-      modisSim%Optical_Thickness_vs_Cloud_Top_Pressure(:, :, :) = R_UNDEF
-      modisSim%Optical_Thickness_vs_ReffICE(:, :, :) = R_UNDEF
-      modisSim%Optical_Thickness_vs_ReffLIQ(:, :, :) = R_UNDEF
-    end if 
-
-  end subroutine COSP_Modis_Simulator
-  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-  !------------- SUBROUTINE CONSTRUCT_COSP_MODIS ------------------
-  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-  SUBROUTINE CONSTRUCT_COSP_MODIS(cfg, nPoints, x)
-    type(cosp_config), intent(in)  :: cfg ! Configuration options
-    integer,           intent(in)  :: Npoints  ! Number of sampled points
-    type(cosp_MODIS),  intent(out) :: x
-    !
-    ! Allocate minumum storage if simulator not used
-    !
-    if (cfg%LMODIS_sim) then
-      x%nPoints  = nPoints
-    else
-      x%Npoints  = 1
-    endif
-    
-    ! --- Allocate arrays ---
-    allocate(x%Cloud_Fraction_Total_Mean(x%nPoints)) 
-    allocate(x%Cloud_Fraction_Water_Mean(x%nPoints)) 
-    allocate(x%Cloud_Fraction_Ice_Mean(x%nPoints)) 
-    
-    allocate(x%Cloud_Fraction_High_Mean(x%nPoints)) 
-    allocate(x%Cloud_Fraction_Mid_Mean(x%nPoints)) 
-    allocate(x%Cloud_Fraction_Low_Mean(x%nPoints)) 
-    
-    allocate(x%Optical_Thickness_Total_Mean(x%nPoints)) 
-    allocate(x%Optical_Thickness_Water_Mean(x%nPoints)) 
-    allocate(x%Optical_Thickness_Ice_Mean(x%nPoints)) 
-    
-    allocate(x%Optical_Thickness_Total_LogMean(x%nPoints)) 
-    allocate(x%Optical_Thickness_Water_LogMean(x%nPoints)) 
-    allocate(x%Optical_Thickness_Ice_LogMean(x%nPoints)) 
-    
-    allocate(x%Cloud_Particle_Size_Water_Mean(x%nPoints)) 
-    allocate(x%Cloud_Particle_Size_Ice_Mean(x%nPoints)) 
-    
-    allocate(x%Cloud_Top_Pressure_Total_Mean(x%nPoints)) 
-    
-    allocate(x%Liquid_Water_Path_Mean(x%nPoints)) 
-    allocate(x%Ice_Water_Path_Mean(x%nPoints)) 
-      
-    allocate(x%Optical_Thickness_vs_Cloud_Top_Pressure(nPoints, numModisTauBins+1, numModisPressureBins))
-    allocate(x%Optical_Thickness_vs_ReffICE(nPoints, numModisTauBins+1, numModisReffIceBins))
-    allocate(x%Optical_Thickness_vs_ReffLIQ(nPoints, numModisTauBins+1, numModisReffLiqBins))
-    x%Optical_Thickness_vs_Cloud_Top_Pressure(:, :, :) = R_UNDEF
-    x%Optical_Thickness_vs_ReffLIQ(:, :, :) = R_UNDEF
-    x%Optical_Thickness_vs_ReffICE(:, :, :) = R_UNDEF
-
-  END SUBROUTINE CONSTRUCT_COSP_MODIS
-
-  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-  !------------- SUBROUTINE FREE_COSP_MODIS -----------------------
-  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-  SUBROUTINE FREE_COSP_MODIS(x)
-    type(cosp_MODIS),intent(inout) :: x
-    !
-    ! Free space used by cosp_modis variable. 
-    !
-    
-    if(associated(x%Cloud_Fraction_Total_Mean)) deallocate(x%Cloud_Fraction_Total_Mean) 
-    if(associated(x%Cloud_Fraction_Water_Mean)) deallocate(x%Cloud_Fraction_Water_Mean) 
-    if(associated(x%Cloud_Fraction_Ice_Mean  )) deallocate(x%Cloud_Fraction_Ice_Mean) 
-    
-    if(associated(x%Cloud_Fraction_High_Mean)) deallocate(x%Cloud_Fraction_High_Mean) 
-    if(associated(x%Cloud_Fraction_Mid_Mean )) deallocate(x%Cloud_Fraction_Mid_Mean) 
-    if(associated(x%Cloud_Fraction_Low_Mean )) deallocate(x%Cloud_Fraction_Low_Mean) 
-    
-    if(associated(x%Optical_Thickness_Total_Mean)) deallocate(x%Optical_Thickness_Total_Mean) 
-    if(associated(x%Optical_Thickness_Water_Mean)) deallocate(x%Optical_Thickness_Water_Mean) 
-    if(associated(x%Optical_Thickness_Ice_Mean  )) deallocate(x%Optical_Thickness_Ice_Mean) 
-    
-    if(associated(x%Optical_Thickness_Total_LogMean)) deallocate(x%Optical_Thickness_Total_LogMean) 
-    if(associated(x%Optical_Thickness_Water_LogMean)) deallocate(x%Optical_Thickness_Water_LogMean) 
-    if(associated(x%Optical_Thickness_Ice_LogMean  )) deallocate(x%Optical_Thickness_Ice_LogMean) 
-    
-    if(associated(x%Cloud_Particle_Size_Water_Mean)) deallocate(x%Cloud_Particle_Size_Water_Mean) 
-    if(associated(x%Cloud_Particle_Size_Ice_Mean  )) deallocate(x%Cloud_Particle_Size_Ice_Mean) 
-    
-    if(associated(x%Cloud_Top_Pressure_Total_Mean )) deallocate(x%Cloud_Top_Pressure_Total_Mean   ) 
-    
-    if(associated(x%Liquid_Water_Path_Mean)) deallocate(x%Liquid_Water_Path_Mean   ) 
-    if(associated(x%Ice_Water_Path_Mean   )) deallocate(x%Ice_Water_Path_Mean   ) 
-    
-    if(associated(x%Optical_Thickness_vs_Cloud_Top_Pressure)) deallocate(x%Optical_Thickness_vs_Cloud_Top_Pressure   ) 
-    if(associated(x%Optical_Thickness_vs_ReffIce)) deallocate(x%Optical_Thickness_vs_ReffIce) 
-    if(associated(x%Optical_Thickness_vs_ReffLiq)) deallocate(x%Optical_Thickness_vs_ReffLiq) 
-  END SUBROUTINE FREE_COSP_MODIS
-  ! -----------------------------------------------------
-
-  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-  !------------- SUBROUTINE COSP_MODIS_CPSECTION -----------------
-  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-  SUBROUTINE COSP_MODIS_CPSECTION(ix, iy, orig, copy)
-    integer, dimension(2), intent(in) :: ix, iy
-    type(cosp_modis),      intent(in   ) :: orig
-    type(cosp_modis),      intent(  out) :: copy
-    !
-    ! Copy a set of grid points from one cosp_modis variable to another.
-    !   Should test to be sure ix and iy refer to the same number of grid points 
-    !
-    integer :: orig_start, orig_end, copy_start, copy_end
-    
-    orig_start = ix(1); orig_end = ix(2)
-    copy_start = iy(1); copy_end = iy(2) 
-    
-    copy%Cloud_Fraction_Total_Mean(copy_start:copy_end) = orig%Cloud_Fraction_Total_Mean(orig_start:orig_end)
-    copy%Cloud_Fraction_Water_Mean(copy_start:copy_end) = orig%Cloud_Fraction_Water_Mean(orig_start:orig_end)
-    copy%Cloud_Fraction_Ice_Mean  (copy_start:copy_end) = orig%Cloud_Fraction_Ice_Mean  (orig_start:orig_end)
-    
-    copy%Cloud_Fraction_High_Mean(copy_start:copy_end) = orig%Cloud_Fraction_High_Mean(orig_start:orig_end)
-    copy%Cloud_Fraction_Mid_Mean (copy_start:copy_end) = orig%Cloud_Fraction_Mid_Mean (orig_start:orig_end)
-    copy%Cloud_Fraction_Low_Mean (copy_start:copy_end) = orig%Cloud_Fraction_Low_Mean (orig_start:orig_end)
-    
-    copy%Optical_Thickness_Total_Mean(copy_start:copy_end) = orig%Optical_Thickness_Total_Mean(orig_start:orig_end)
-    copy%Optical_Thickness_Water_Mean(copy_start:copy_end) = orig%Optical_Thickness_Water_Mean(orig_start:orig_end)
-    copy%Optical_Thickness_Ice_Mean  (copy_start:copy_end) = orig%Optical_Thickness_Ice_Mean  (orig_start:orig_end)
-    
-    copy%Optical_Thickness_Total_LogMean(copy_start:copy_end) = &
-                                                          orig%Optical_Thickness_Total_LogMean(orig_start:orig_end)
-    copy%Optical_Thickness_Water_LogMean(copy_start:copy_end) = &
-                                                          orig%Optical_Thickness_Water_LogMean(orig_start:orig_end)
-    copy%Optical_Thickness_Ice_LogMean  (copy_start:copy_end) = &
-                                                          orig%Optical_Thickness_Ice_LogMean  (orig_start:orig_end)
-
-    copy%Cloud_Particle_Size_Water_Mean(copy_start:copy_end) = orig%Cloud_Particle_Size_Water_Mean(orig_start:orig_end)
-    copy%Cloud_Particle_Size_Ice_Mean  (copy_start:copy_end) = orig%Cloud_Particle_Size_Ice_Mean  (orig_start:orig_end)
-
-    copy%Cloud_Top_Pressure_Total_Mean(copy_start:copy_end) = orig%Cloud_Top_Pressure_Total_Mean(orig_start:orig_end)
-    
-    copy%Liquid_Water_Path_Mean(copy_start:copy_end) = orig%Liquid_Water_Path_Mean(orig_start:orig_end)
-    copy%Ice_Water_Path_Mean   (copy_start:copy_end) = orig%Ice_Water_Path_Mean  (orig_start:orig_end)
-    
-    copy%Optical_Thickness_vs_Cloud_Top_Pressure(copy_start:copy_end, :, :) = &
-         orig%Optical_Thickness_vs_Cloud_Top_Pressure(orig_start:orig_end, :, :)
-    copy%Optical_Thickness_vs_ReffIce(copy_start:copy_end, :, :) = &
-         orig%Optical_Thickness_vs_ReffIce(orig_start:orig_end, :, :)
-    copy%Optical_Thickness_vs_ReffLiq(copy_start:copy_end, :, :) = &
-         orig%Optical_Thickness_vs_ReffLiq(orig_start:orig_end, :, :)
-
-  END SUBROUTINE COSP_MODIS_CPSECTION
-  ! -----------------------------------------------------
-
-END MODULE MOD_COSP_Modis_Simulator
Index: LMDZ6/trunk/libf/phylmd/cosp/cosp_radar.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/cosp/cosp_radar.F90	(revision 3232)
+++ 	(revision )
@@ -1,193 +1,0 @@
-! (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_RADAR
-  USE MOD_COSP_CONSTANTS
-  USE MOD_COSP_TYPES
-  USE MOD_COSP_UTILS
-  use radar_simulator_types
-  use array_lib
-  use atmos_lib
-  use format_input
-  IMPLICIT NONE
-
-  INTERFACE
-    subroutine radar_simulator(hp,nprof,ngate,undef, &
-        hgt_matrix,hm_matrix,re_matrix,Np_matrix, &
-        p_matrix,t_matrix,rh_matrix, &
-        Ze_non,Ze_ray,g_to_vol,a_to_vol,dBZe, &
-        g_to_vol_in,g_to_vol_out)
-
-        use m_mrgrnk
-        use array_lib
-        use math_lib
-        use optics_lib
-        use radar_simulator_types
-        implicit none
-
-        ! ----- INPUTS -----  
-        type(class_param) :: hp
-
-        integer, intent(in) :: nprof,ngate
-
-        real undef
-        real*8, dimension(nprof,ngate), intent(in) :: hgt_matrix, p_matrix, &
-            t_matrix,rh_matrix
-        real*8, dimension(hp%nhclass,nprof,ngate), intent(in) :: hm_matrix
-        real*8, dimension(hp%nhclass,nprof,ngate), intent(inout) :: re_matrix
-        real*8, dimension(hp%nhclass,nprof,ngate), intent(inout) :: Np_matrix
-
-        ! ----- OUTPUTS -----
-        real*8, dimension(nprof,ngate), intent(out) :: Ze_non,Ze_ray, &
-            g_to_vol,dBZe,a_to_vol
-        ! ----- OPTIONAL -----
-        real*8, optional, dimension(nprof,ngate) :: &
-            g_to_vol_in,g_to_vol_out
-     end subroutine radar_simulator
-  END INTERFACE
-
-CONTAINS
-
-!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-!------------------- SUBROUTINE COSP_RADAR ------------------------
-!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-SUBROUTINE COSP_RADAR(gbx,sgx,sghydro,z)
-  IMPLICIT NONE
-
-  ! Arguments
-  type(cosp_gridbox),intent(inout) :: gbx  ! Gridbox info
-  type(cosp_subgrid),intent(in) :: sgx  ! Subgrid info
-  type(cosp_sghydro),intent(in) :: sghydro  ! Subgrid info for hydrometeors
-  type(cosp_sgradar),intent(inout) :: z ! Output from simulator, subgrid
-
-  ! Local variables 
-  integer :: & 
-  nsizes            ! num of discrete drop sizes
-
-  real*8, dimension(:,:), allocatable :: &
-  g_to_vol ! integrated atten due to gases, r>v (dB)
-
-  real*8, dimension(:,:), allocatable :: &
-  Ze_non, &         ! radar reflectivity withOUT attenuation (dBZ)
-  Ze_ray, &         ! Rayleigh reflectivity (dBZ)
-  h_atten_to_vol, &     ! attenuation by hydromets, radar to vol (dB)
-  g_atten_to_vol, &     ! gaseous atteunation, radar to vol (dB)
-  dBZe, &           ! effective radar reflectivity factor (dBZ)
-  hgt_matrix, &         ! height of hydrometeors (km)
-  t_matrix, &                   !temperature (k)
-  p_matrix, &                   !pressure (hPa)
-  rh_matrix                     !relative humidity (%)
-
-  real*8, dimension(:,:,:), allocatable :: &
-  hm_matrix, &          ! hydrometeor mixing ratio (g kg^-1)
-  re_matrix, &          ! effective radius (microns).   Optional. 0 ==> use Np_matrix or defaults
-  Np_matrix         ! total number concentration (kg^-1).   Optional 0==> use defaults 
-
-  integer, parameter :: one = 1
-  ! logical :: hgt_reversed
-  logical :: hgt_descending
-  integer :: pr,i,j,k,unt,ngate
-
-! ----- main program settings ------
-
-  ! Inputs to Quickbeam
-  allocate(hgt_matrix(gbx%Npoints,gbx%Nlevels),p_matrix(gbx%Npoints,gbx%Nlevels), &
-           t_matrix(gbx%Npoints,gbx%Nlevels),rh_matrix(gbx%Npoints,gbx%Nlevels))
-  allocate(hm_matrix(gbx%Nhydro,gbx%Npoints,gbx%Nlevels))
-  allocate(re_matrix(gbx%Nhydro,gbx%Npoints,gbx%Nlevels))
-  allocate(Np_matrix(gbx%Nhydro,gbx%Npoints,gbx%Nlevels))
-
-  ! Outputs from Quickbeam
-  allocate(Ze_non(gbx%Npoints,gbx%Nlevels))
-  allocate(Ze_ray(gbx%Npoints,gbx%Nlevels))
-  allocate(h_atten_to_vol(gbx%Npoints,gbx%Nlevels))
-  allocate(g_atten_to_vol(gbx%Npoints,gbx%Nlevels))
-  allocate(dBZe(gbx%Npoints,gbx%Nlevels))
-
-  ! Optional argument. It is computed and returned in the first call to
-  ! radar_simulator, and passed as input in the rest
-  allocate(g_to_vol(gbx%Npoints,gbx%Nlevels))
-
-  ! Even if there is no unit conversion, they are needed for type conversion
-  p_matrix   = gbx%p/100.0     ! From Pa to hPa
-  hgt_matrix = gbx%zlev/1000.0 ! From m to km
-  t_matrix   = gbx%T
-  rh_matrix  = gbx%q
-  re_matrix  = 0.0
-
-
-  ! set flag denoting position of radar relative to hgt_matrix orientation
-	  ngate = size(hgt_matrix,2)
-
-	  hgt_descending = hgt_matrix(1,1) > hgt_matrix(1,ngate)
-
-	  if ( &
-	     (gbx%surface_radar == 1 .and. hgt_descending) .or.  &
-	     (gbx%surface_radar == 0 .and. (.not. hgt_descending)) &
-	     ) &
-	  then
-	    gbx%hp%radar_at_layer_one = .false.
-	  else
-	    gbx%hp%radar_at_layer_one = .true.
-	  endif
-
-  ! ----- loop over subcolumns -----
-  do pr=1,sgx%Ncolumns
-
-      !  NOTE:
-      !  atmospheric profiles are the same within the same gridbox
-      !  only hydrometeor profiles will be different for each subgridbox
-
-         do i=1,gbx%Nhydro
-            hm_matrix(i,:,:) = sghydro%mr_hydro(:,pr,:,i)*1000.0 ! Units from kg/kg to g/kg
-            if (gbx%use_reff) then
-              re_matrix(i,:,:) = sghydro%Reff(:,pr,:,i)*1.e6       ! Units from m to micron
-              Np_matrix(i,:,:) = sghydro%Np(:,pr,:,i)              ! Units [#/kg]
-            endif
-         enddo
-
-      !   ----- call radar simulator -----
-      if (pr == 1) then ! Compute gaseous attenuation for all profiles
-         call radar_simulator(gbx%hp,gbx%Npoints,gbx%Nlevels,R_UNDEF, &
-           hgt_matrix,hm_matrix,re_matrix,Np_matrix, &
-           p_matrix,t_matrix,rh_matrix, &
-           Ze_non,Ze_ray,h_atten_to_vol,g_atten_to_vol,dBZe,g_to_vol_out=g_to_vol)
-      else ! Use gaseous atteunuation for pr = 1
-         call radar_simulator(gbx%hp,gbx%Npoints,gbx%Nlevels,R_UNDEF, &
-           hgt_matrix,hm_matrix,re_matrix,Np_matrix, &
-           p_matrix,t_matrix,rh_matrix, &
-           Ze_non,Ze_ray,h_atten_to_vol,g_atten_to_vol,dBZe,g_to_vol_in=g_to_vol)
-      endif
-
-      ! store caluculated dBZe values for later output/processing
-      z%Ze_tot(:,pr,:)=dBZe(:,:)
-  enddo !pr
-
-  deallocate(hgt_matrix,p_matrix,t_matrix,rh_matrix)
-  deallocate(hm_matrix,re_matrix, &
-      Ze_non,Ze_ray,h_atten_to_vol,g_atten_to_vol,dBZe)
-  deallocate(g_to_vol)
-END SUBROUTINE COSP_RADAR
-
-END MODULE MOD_COSP_RADAR
Index: LMDZ6/trunk/libf/phylmd/cosp/cosp_simulator.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/cosp/cosp_simulator.F90	(revision 3232)
+++ 	(revision )
@@ -1,247 +1,0 @@
-! (c) British Crown Copyright 2008, the Met Office.
-! All rights reserved.
-! $Revision: 88 $, $Date: 2013-11-13 15:08:38 +0100 (mer. 13 nov. 2013) $
-! $URL: http://cfmip-obs-sim.googlecode.com/svn/stable/v1.4.0/cosp_simulator.F90 $
-! 
-! 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.
-
-!
-! History:
-! Jul 2007 - A. Bodas-Salcedo - Initial version
-! Jan 2013 - G. Cesana - Add new variables linked to the lidar cloud phase 
-!
-
-#include "cosp_defs.h" 
-MODULE MOD_COSP_SIMULATOR
-  USE MOD_COSP_CONSTANTS, ONLY: I_RADAR, I_LIDAR, I_ISCCP, I_MISR, I_MODIS, &
-                                I_RTTOV, I_STATS, tsim
-  USE MOD_COSP_TYPES
-  USE MOD_COSP_RADAR
-  USE MOD_COSP_LIDAR
-  USE MOD_COSP_ISCCP_SIMULATOR
-  USE MOD_COSP_MODIS_SIMULATOR
-  USE MOD_COSP_MISR_SIMULATOR
-!#ifdef RTTOV
-!  USE MOD_COSP_RTTOV_SIMULATOR
-!#endif
-  USE MOD_COSP_STATS
-  IMPLICIT NONE
-
-CONTAINS
-
-
-!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-!--------------------- SUBROUTINE COSP_SIMULATOR ------------------
-!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-!#ifdef RTTOV
-!SUBROUTINE COSP_SIMULATOR(gbx,sgx,sghydro,cfg,vgrid,sgradar,sglidar,isccp,misr,modis,rttov,stradar,stlidar)
-!#else
-SUBROUTINE COSP_SIMULATOR(gbx,sgx,sghydro,cfg,vgrid,sgradar,sglidar,isccp,misr,modis,stradar,stlidar)
-!#endif
-
-  ! Arguments
-  type(cosp_gridbox),intent(inout) :: gbx      ! Grid-box inputs
-  type(cosp_subgrid),intent(in) :: sgx      ! Subgrid inputs
-  type(cosp_sghydro),intent(in) :: sghydro  ! Subgrid info for hydrometeors
-  type(cosp_config),intent(in)  :: cfg      ! Configuration options
-  type(cosp_vgrid),intent(in)   :: vgrid    ! Information on vertical grid of stats
-  type(cosp_sgradar),intent(inout) :: sgradar ! Output from radar simulator
-  type(cosp_sglidar),intent(inout) :: sglidar ! Output from lidar simulator
-  type(cosp_isccp),intent(inout)   :: isccp   ! Output from ISCCP simulator
-  type(cosp_misr),intent(inout)    :: misr    ! Output from MISR simulator
-  type(cosp_modis),intent(inout)   :: modis   ! Output from MODIS simulator
-!#ifdef RTTOV
-!  type(cosp_rttov),intent(inout)    :: rttov    ! Output from RTTOV
-!#endif
-  type(cosp_radarstats),intent(inout) :: stradar ! Summary statistics from radar simulator
-  type(cosp_lidarstats),intent(inout) :: stlidar ! Summary statistics from lidar simulator
-  ! Local variables
-  integer :: i,j,k,isim
-  logical :: inconsistent
-  ! Timing variables
-  integer :: t0,t1
-
-  t0 = 0
-  t1 = 0
-
-  inconsistent=.false.
-!   do k=1,gbx%Nhydro
-!   do j=1,gbx%Nlevels
-!   do i=1,gbx%Npoints
-!     if ((gbx%mr_hydro(i,j,k)>0.0).and.(gbx%Reff(i,j,k)<=0.0)) inconsistent=.true.
-!   enddo
-!   enddo
-!   enddo
-!  if (inconsistent)  print *, '%%%% COSP_SIMULATOR: inconsistency in mr_hydro and Reff'
-
-
-  !+++++++++ Radar model ++++++++++
-  isim = I_RADAR
-  if (cfg%Lradar_sim) then
-    call system_clock(t0)
-    call cosp_radar(gbx,sgx,sghydro,sgradar)
-    call system_clock(t1)
-    tsim(isim) = tsim(isim) + (t1 -t0)
-  endif
-
-  !+++++++++ Lidar model ++++++++++
-  isim = I_LIDAR
-  if (cfg%Llidar_sim) then
-    call system_clock(t0)
-    call cosp_lidar(gbx,sgx,sghydro,sglidar)
-    call system_clock(t1)
-    tsim(isim) = tsim(isim) + (t1 -t0)
-  endif
-
-  !+++++++++ ISCCP simulator ++++++++++
-  isim = I_ISCCP
-  if (cfg%Lisccp_sim) then
-    call system_clock(t0)
-    call cosp_isccp_simulator(gbx,sgx,isccp)
-    call system_clock(t1)
-    tsim(isim) = tsim(isim) + (t1 -t0)
-  endif
-
-  !+++++++++ MISR simulator ++++++++++
-  isim = I_MISR
-  if (cfg%Lmisr_sim) then
-    call system_clock(t0)
-    call cosp_misr_simulator(gbx,sgx,misr)
-    call system_clock(t1)
-    tsim(isim) = tsim(isim) + (t1 -t0)
-  endif
-
-  !+++++++++ MODIS simulator ++++++++++
-  isim = I_MODIS
-  if (cfg%Lmodis_sim) then
-    call system_clock(t0)
-    call cosp_modis_simulator(gbx,sgx,sghydro,isccp, modis)
-    call system_clock(t1)
-    tsim(isim) = tsim(isim) + (t1 -t0)
-  endif
-
-  !+++++++++ RTTOV ++++++++++ 
-  isim = I_RTTOV
-!#ifdef RTTOV
-!  if (cfg%Lrttov_sim) then 
-!    call system_clock(t0)
-!    call cosp_rttov_simulator(gbx,rttov)
-!    call system_clock(t1)
-!    tsim(isim) = tsim(isim) + (t1 -t0)
-!  endif
-!#endif
-
-  !+++++++++++ Summary statistics +++++++++++
-  isim = I_STATS
-  if (cfg%Lstats) then
-    call system_clock(t0)
-    call cosp_stats(gbx,sgx,cfg,sgradar,sglidar,vgrid,stradar,stlidar)
-    call system_clock(t1)
-    tsim(isim) = tsim(isim) + (t1 -t0)
-  endif
-
-  !+++++++++++ Change of units after computation of statistics +++++++++++
-  ! This avoids using UDUNITS in CMOR
-
-  ! Cloud fractions from 1 to %
-!  if (cfg%Lclcalipso) then
-!    where(stlidar%lidarcld /= R_UNDEF) stlidar%lidarcld = stlidar%lidarcld*100.0
-!  endif
-!  if (cfg%Lcltcalipso.OR.cfg%Lcllcalipso.OR.cfg%Lclmcalipso.OR.cfg%Lclhcalipso) then
-!    where(stlidar%cldlayer /= R_UNDEF) stlidar%cldlayer = stlidar%cldlayer*100.0
-!  endif
-  if (cfg%Lclcalipso2) then
-    where(stradar%lidar_only_freq_cloud /= R_UNDEF) stradar%lidar_only_freq_cloud = stradar%lidar_only_freq_cloud*100.0
-  endif
-
-  if (cfg%Lcltcalipsoliq.OR.cfg%Lcllcalipsoliq.OR.cfg%Lclmcalipsoliq.OR.cfg%Lclhcalipsoliq.OR. &
-      cfg%Lcltcalipsoice.OR.cfg%Lcllcalipsoice.OR.cfg%Lclmcalipsoice.OR.cfg%Lclhcalipsoice.OR. &
-      cfg%Lcltcalipsoun.OR.cfg%Lcllcalipsoun.OR.cfg%Lclmcalipsoun.OR.cfg%Lclhcalipsoun ) then
-    where(stlidar%cldlayerphase /= R_UNDEF) stlidar%cldlayerphase = stlidar%cldlayerphase*100.0
-  endif
-  if (cfg%Lclcalipsoliq.OR.cfg%Lclcalipsoice.OR.cfg%Lclcalipsoun) then
-    where(stlidar%lidarcldphase /= R_UNDEF) stlidar%lidarcldphase = stlidar%lidarcldphase*100.0
-  endif
-  if (cfg%Lclcalipsotmp.OR.cfg%Lclcalipsotmpliq.OR.cfg%Lclcalipsotmpice.OR.cfg%Lclcalipsotmpun) then
-    where(stlidar%lidarcldtmp /= R_UNDEF) stlidar%lidarcldtmp = stlidar%lidarcldtmp*100.0
-  endif
-
-  if (cfg%Lcltisccp) then
-     where(isccp%totalcldarea /= R_UNDEF) isccp%totalcldarea = isccp%totalcldarea*100.0
-  endif  
-  if (cfg%Lclisccp) then
-    where(isccp%fq_isccp /= R_UNDEF) isccp%fq_isccp = isccp%fq_isccp*100.0
-  endif
-
-  if (cfg%LclMISR) then
-    where(misr%fq_MISR /= R_UNDEF) misr%fq_MISR = misr%fq_MISR*100.0
-  endif
-
-  if (cfg%Lcltlidarradar) then
-    where(stradar%radar_lidar_tcc /= R_UNDEF) stradar%radar_lidar_tcc = stradar%radar_lidar_tcc*100.0
-  endif
-
-  if (cfg%Lclmodis) then
-    where(modis%Optical_Thickness_vs_Cloud_Top_Pressure /= R_UNDEF) modis%Optical_Thickness_vs_Cloud_Top_Pressure = &
-                                                      modis%Optical_Thickness_vs_Cloud_Top_Pressure*100.0
-  endif
-  if (cfg%Lcrimodis) then
-     where(modis%Optical_Thickness_vs_ReffICE /= R_UNDEF) modis%Optical_Thickness_vs_ReffICE = &
-                                                      modis%Optical_Thickness_vs_ReffICE*100.0
-  endif
-  if (cfg%Lcrlmodis) then
-     where(modis%Optical_Thickness_vs_ReffLIQ /= R_UNDEF) modis%Optical_Thickness_vs_ReffLIQ = &
-                                                      modis%Optical_Thickness_vs_ReffLIQ*100.0
-  endif
-
-  if (cfg%Lcltmodis) then
-    where(modis%Cloud_Fraction_Total_Mean /= R_UNDEF) modis%Cloud_Fraction_Total_Mean = modis%Cloud_Fraction_Total_Mean*100.0
-  endif
-  if (cfg%Lclwmodis) then
-     where(modis%Cloud_Fraction_Water_Mean /= R_UNDEF) modis%Cloud_Fraction_Water_Mean = modis%Cloud_Fraction_Water_Mean*100.0
-  endif
-  if (cfg%Lclimodis) then
-     where(modis%Cloud_Fraction_Ice_Mean /= R_UNDEF) modis%Cloud_Fraction_Ice_Mean = modis%Cloud_Fraction_Ice_Mean*100.0
-  endif
-
-  if (cfg%Lclhmodis) then
-     where(modis%Cloud_Fraction_High_Mean /= R_UNDEF) modis%Cloud_Fraction_High_Mean = modis%Cloud_Fraction_High_Mean*100.0
-  endif
-  if (cfg%Lclmmodis) then
-     where(modis%Cloud_Fraction_Mid_Mean /= R_UNDEF) modis%Cloud_Fraction_Mid_Mean = modis%Cloud_Fraction_Mid_Mean*100.0
-  endif
-  if (cfg%Lcllmodis) then
-     where(modis%Cloud_Fraction_Low_Mean /= R_UNDEF) modis%Cloud_Fraction_Low_Mean = modis%Cloud_Fraction_Low_Mean*100.0
-  endif
-
-  ! Change pressure from hPa to Pa.
-  if (cfg%Lboxptopisccp) then
-    where(isccp%boxptop /= R_UNDEF) isccp%boxptop = isccp%boxptop*100.0
-  endif
-  if (cfg%Lpctisccp) then
-    where(isccp%meanptop /= R_UNDEF) isccp%meanptop = isccp%meanptop*100.0
-  endif
-
-
-END SUBROUTINE COSP_SIMULATOR
-
-END MODULE MOD_COSP_SIMULATOR
Index: LMDZ6/trunk/libf/phylmd/cosp/cosp_stats.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/cosp/cosp_stats.F90	(revision 3232)
+++ 	(revision )
@@ -1,304 +1,0 @@
-! (c) British Crown Copyright 2008, the Met Office.
-! All rights reserved.
-! $Revision: 88 $, $Date: 2013-11-13 15:08:38 +0100 (mer. 13 nov. 2013) $
-! $URL: http://cfmip-obs-sim.googlecode.com/svn/stable/v1.4.0/cosp_stats.F90 $
-!
-! 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.
-
-!
-! History:
-! Jul 2007 - A. Bodas-Salcedo - Initial version
-! Jul 2008 - A. Bodas-Salcedo - Added capability of producing outputs in standard grid
-! Oct 2008 - J.-L. Dufresne   - Bug fixed. Assignment of Npoints,Nlevels,Nhydro,Ncolumns in COSP_STATS
-! Oct 2008 - H. Chepfer       - Added PARASOL reflectance arguments
-! Jun 2010 - T. Yokohata, T. Nishimura and K. Ogochi - Added NEC SXs optimisations
-! Jan 2013 - G. Cesana        - Added betaperp and temperature arguments 
-!                             - Added phase 3D/3Dtemperature/Map output variables in diag_lidar 
-!
-!
-#include "cosp_defs.h" 
-MODULE MOD_COSP_STATS
-  USE MOD_COSP_CONSTANTS
-  USE MOD_COSP_TYPES
-  USE MOD_LLNL_STATS
-  USE MOD_LMD_IPSL_STATS
-  IMPLICIT NONE
-
-CONTAINS
-
-!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-!------------------- SUBROUTINE COSP_STATS ------------------------
-!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-SUBROUTINE COSP_STATS(gbx,sgx,cfg,sgradar,sglidar,vgrid,stradar,stlidar)
-
-   ! Input arguments
-   type(cosp_gridbox),intent(in) :: gbx
-   type(cosp_subgrid),intent(in) :: sgx
-   type(cosp_config),intent(in)  :: cfg
-   type(cosp_sgradar),intent(in) :: sgradar
-   type(cosp_sglidar),intent(in) :: sglidar
-   type(cosp_vgrid),intent(in)   :: vgrid
-   ! Output arguments
-   type(cosp_radarstats),intent(inout) :: stradar ! Summary statistics for radar
-   type(cosp_lidarstats),intent(inout) :: stlidar ! Summary statistics for lidar
-
-   ! Local variables
-   integer :: Npoints  !# of grid points
-   integer :: Nlevels  !# of levels
-   integer :: Nhydro   !# of hydrometeors
-   integer :: Ncolumns !# of columns
-   integer :: Nlr
-   logical :: ok_lidar_cfad = .false.
-   real,dimension(:,:,:),allocatable :: Ze_out,betatot_out,betamol_in,betamol_out,ph_in,ph_out
-   real,dimension(:,:),allocatable :: ph_c,betamol_c
-   real,dimension(:,:,:),allocatable ::  betaperptot_out, temp_in, temp_out 
-   real,dimension(:,:),allocatable :: temp_c
-
-   Npoints  = gbx%Npoints
-   Nlevels  = gbx%Nlevels
-   Nhydro   = gbx%Nhydro
-   Ncolumns = gbx%Ncolumns
-   Nlr      = vgrid%Nlvgrid
-
-   if (cfg%LcfadLidarsr532) ok_lidar_cfad=.true.
-
-   if (vgrid%use_vgrid) then ! Statistics in a different vertical grid
-        allocate(Ze_out(Npoints,Ncolumns,Nlr),betatot_out(Npoints,Ncolumns,Nlr), &
-                 betamol_in(Npoints,1,Nlevels),betamol_out(Npoints,1,Nlr),betamol_c(Npoints,Nlr), &
-                 ph_in(Npoints,1,Nlevels),ph_out(Npoints,1,Nlr),ph_c(Npoints,Nlr))
-        Ze_out = 0.0
-        betatot_out  = 0.0
-        betamol_out= 0.0
-        betamol_c  = 0.0
-        ph_in(:,1,:)  = gbx%ph(:,:)
-        ph_out  = 0.0
-        ph_c    = 0.0
-        allocate(betaperptot_out(Npoints,Ncolumns,Nlr),temp_in(Npoints,1,Nlevels),temp_out(Npoints,1,Nlr), &
-                 temp_c(Npoints,Nlr))
-        betaperptot_out = 0.0
-        temp_in = 0.0
-        temp_out = 0.0
-        temp_c = 0.0
-
-        !++++++++++++ Radar CFAD ++++++++++++++++
-        if (cfg%Lradar_sim) then
-            call cosp_change_vertical_grid(Npoints,Ncolumns,Nlevels,gbx%zlev,gbx%zlev_half,sgradar%Ze_tot, &
-                                           Nlr,vgrid%zl,vgrid%zu,Ze_out,log_units=.true.)
-            stradar%cfad_ze = cosp_cfad(Npoints,Ncolumns,Nlr,DBZE_BINS,Ze_out, &
-                                        DBZE_MIN,DBZE_MAX,CFAD_ZE_MIN,CFAD_ZE_WIDTH)
-        endif
-        !++++++++++++ Lidar CFAD ++++++++++++++++
-        if (cfg%Llidar_sim) then
-            betamol_in(:,1,:) = sglidar%beta_mol(:,:)
-            call cosp_change_vertical_grid(Npoints,1,Nlevels,gbx%zlev,gbx%zlev_half,betamol_in, &
-                                           Nlr,vgrid%zl,vgrid%zu,betamol_out)
-            call cosp_change_vertical_grid(Npoints,Ncolumns,Nlevels,gbx%zlev,gbx%zlev_half,sglidar%beta_tot, &
-                                           Nlr,vgrid%zl,vgrid%zu,betatot_out)
-
-            temp_in(:,1,:) = gbx%T(:,:)
-            call cosp_change_vertical_grid(Npoints,Ncolumns,Nlevels,gbx%zlev,gbx%zlev_half,sglidar%betaperp_tot, &
-                                           Nlr,vgrid%zl,vgrid%zu,betaperptot_out)
-            call cosp_change_vertical_grid(Npoints,1,Nlevels,gbx%zlev,gbx%zlev_half,temp_in, &
-                                           Nlr,vgrid%zl,vgrid%zu,temp_out)
-            temp_c(:,:) = temp_out(:,1,:)
-            stlidar%proftemp = temp_c                                     !TIBO
-            where (stlidar%proftemp  < 150.) stlidar%proftemp   = R_UNDEF !TIBO
-            where (stlidar%proftemp  > 350.) stlidar%proftemp   = R_UNDEF !TIBO
-
-            call cosp_change_vertical_grid(Npoints,1,Nlevels,gbx%zlev,gbx%zlev_half,ph_in, &
-                                           Nlr,vgrid%zl,vgrid%zu,ph_out)
-            ph_c(:,:) = ph_out(:,1,:)
-            betamol_c(:,:) = betamol_out(:,1,:)
-            ! Stats from lidar_stat_summary
-            call diag_lidar(Npoints,Ncolumns,Nlr,SR_BINS,PARASOL_NREFL &
-                            ,temp_c,betatot_out,betaperptot_out,betamol_c,sglidar%refl,gbx%land,ph_c &
-                            ,LIDAR_UNDEF,ok_lidar_cfad &
-                            ,stlidar%cfad_sr,stlidar%srbval &
-                            ,LIDAR_NCAT,LIDAR_NTYPE,stlidar%lidarcld,stlidar%lidarcldtype & !OPAQ
-                            ,stlidar%lidarcldphase,stlidar%cldlayer,stlidar%cldtype &       !OPAQ
-                            ,stlidar%cldlayerphase,stlidar%lidarcldtmp &                    !OPAQ
-                            ,stlidar%parasolrefl,vgrid%z,stlidar%profSR)                    !OPAQ !TIBO
-        endif
-
-        !++++++++++++ Lidar-only cloud amount and lidar&radar total cloud mount ++++++++++++++++
-        if (cfg%Lradar_sim.and.cfg%Llidar_sim) call cosp_lidar_only_cloud(Npoints,Ncolumns,Nlr, &
-                                    temp_c,betatot_out,betaperptot_out,betamol_c,Ze_out, &
-                                    stradar%lidar_only_freq_cloud,stradar%radar_lidar_tcc)
-        deallocate(temp_in,temp_out,temp_c,betaperptot_out) !TIBO +temp_in
-
-        ! Deallocate arrays at coarse resolution
-        deallocate(Ze_out,betatot_out,betamol_in,betamol_out,betamol_c,ph_in,ph_out,ph_c)
-   else ! Statistics in model levels
-        !++++++++++++ Radar CFAD ++++++++++++++++
-        if (cfg%Lradar_sim) stradar%cfad_ze = cosp_cfad(Npoints,Ncolumns,Nlr,DBZE_BINS,sgradar%Ze_tot, &
-                                        DBZE_MIN,DBZE_MAX,CFAD_ZE_MIN,CFAD_ZE_WIDTH)
-        !++++++++++++ Lidar CFAD ++++++++++++++++
-        ! Stats from lidar_stat_summary
-        if (cfg%Llidar_sim) call diag_lidar(Npoints,Ncolumns,Nlr,SR_BINS,PARASOL_NREFL &
-                        ,sglidar%temp_tot,sglidar%beta_tot,sglidar%betaperp_tot,sglidar%beta_mol,sglidar%refl,gbx%land,gbx%ph &
-                        ,LIDAR_UNDEF,ok_lidar_cfad &
-                        ,stlidar%cfad_sr,stlidar%srbval &
-                        ,LIDAR_NCAT,LIDAR_NTYPE,stlidar%lidarcld,stlidar%lidarcldtype & !OPAQ
-                        ,stlidar%lidarcldphase,stlidar%cldlayer,stlidar%cldtype &       !OPAQ
-                        ,stlidar%cldlayerphase,stlidar%lidarcldtmp &                    !OPAQ
-                        ,stlidar%parasolrefl,vgrid%z,stlidar%profSR)                    !OPAQ !TIBO
-        !++++++++++++ Lidar-only cloud amount and lidar&radar total cloud mount ++++++++++++++++
-        if (cfg%Lradar_sim.and.cfg%Llidar_sim) call cosp_lidar_only_cloud(Npoints,Ncolumns,Nlr, &
-                                    sglidar%temp_tot,sglidar%beta_tot,sglidar%betaperp_tot,sglidar%beta_mol,sgradar%Ze_tot, &
-                                    stradar%lidar_only_freq_cloud,stradar%radar_lidar_tcc)
-   endif
-   ! Replace undef
-   where (stlidar%cfad_sr   == LIDAR_UNDEF) stlidar%cfad_sr   = R_UNDEF
-   where (stlidar%profSR   == LIDAR_UNDEF) stlidar%profSR   = R_UNDEF !TIBO
-   where (stlidar%lidarcld  == LIDAR_UNDEF) stlidar%lidarcld  = R_UNDEF
-   where (stlidar%lidarcldtype  == LIDAR_UNDEF) stlidar%lidarcldtype  = R_UNDEF !OPAQ
-   where (stlidar%cldlayer  == LIDAR_UNDEF) stlidar%cldlayer  = R_UNDEF
-   where (stlidar%cldtype  == LIDAR_UNDEF) stlidar%cldtype  = R_UNDEF           !OPAQ
-   where (stlidar%parasolrefl == LIDAR_UNDEF) stlidar%parasolrefl = R_UNDEF
-   where (stlidar%cldlayerphase  == LIDAR_UNDEF) stlidar%cldlayerphase  = R_UNDEF
-   where (stlidar%lidarcldphase  == LIDAR_UNDEF) stlidar%lidarcldphase  = R_UNDEF
-   where (stlidar%lidarcldtmp  == LIDAR_UNDEF) stlidar%lidarcldtmp  = R_UNDEF
-
-END SUBROUTINE COSP_STATS
-
-!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-!---------- SUBROUTINE COSP_CHANGE_VERTICAL_GRID ----------------
-!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-SUBROUTINE COSP_CHANGE_VERTICAL_GRID(Npoints,Ncolumns,Nlevels,zfull,zhalf,y,Nglevels,newgrid_bot,newgrid_top,r,log_units)
-   implicit none
-   ! Input arguments
-   integer,intent(in) :: Npoints  !# of grid points
-   integer,intent(in) :: Nlevels  !# of levels
-   integer,intent(in) :: Ncolumns !# of columns
-   real,dimension(Npoints,Nlevels),intent(in) :: zfull ! Height at model levels [m] (Bottom of model layer)
-   real,dimension(Npoints,Nlevels),intent(in) :: zhalf ! Height at half model levels [m] (Bottom of model layer)
-   real,dimension(Npoints,Ncolumns,Nlevels),intent(in) :: y     ! Variable to be changed to a different grid
-   integer,intent(in) :: Nglevels  !# levels in the new grid
-   real,dimension(Nglevels),intent(in) :: newgrid_bot ! Lower boundary of new levels  [m]
-   real,dimension(Nglevels),intent(in) :: newgrid_top ! Upper boundary of new levels  [m]
-   logical,optional,intent(in) :: log_units ! log units, need to convert to linear units
-   ! Output
-   real,dimension(Npoints,Ncolumns,Nglevels),intent(out) :: r ! Variable on new grid
-
-   ! Local variables
-   integer :: i,j,k
-   logical :: lunits
-   integer :: l
-   real :: w ! Weight
-   real :: dbb, dtb, dbt, dtt ! Distances between edges of both grids
-   integer :: Nw  ! Number of weights
-   real :: wt  ! Sum of weights
-   real,dimension(Nlevels) :: oldgrid_bot,oldgrid_top ! Lower and upper boundaries of model grid
-   real :: yp ! Local copy of y at a particular point.
-              ! This allows for change of units.
-
-   lunits=.false.
-   if (present(log_units)) lunits=log_units
-
-   r = 0.0
-
-   do i=1,Npoints
-     ! Calculate tops and bottoms of new and old grids
-     oldgrid_bot = zhalf(i,:)
-     oldgrid_top(1:Nlevels-1) = oldgrid_bot(2:Nlevels)
-     oldgrid_top(Nlevels) = zfull(i,Nlevels) +  zfull(i,Nlevels) - zhalf(i,Nlevels) ! Top level symmetric
-     l = 0 ! Index of level in the old grid
-     ! Loop over levels in the new grid
-     do k = 1,Nglevels
-       Nw = 0 ! Number of weigths
-       wt = 0.0 ! Sum of weights
-       ! Loop over levels in the old grid and accumulate total for weighted average
-       do
-         l = l + 1
-         w = 0.0 ! Initialise weight to 0
-         ! Distances between edges of both grids
-         dbb = oldgrid_bot(l) - newgrid_bot(k)
-         dtb = oldgrid_top(l) - newgrid_bot(k)
-         dbt = oldgrid_bot(l) - newgrid_top(k)
-         dtt = oldgrid_top(l) - newgrid_top(k)
-         if (dbt >= 0.0) exit ! Do next level in the new grid
-         if (dtb > 0.0) then
-           if (dbb <= 0.0) then
-             if (dtt <= 0) then
-               w = dtb
-             else
-               w = newgrid_top(k) - newgrid_bot(k)
-             endif
-           else
-             if (dtt <= 0) then
-               w = oldgrid_top(l) - oldgrid_bot(l)
-             else
-               w = -dbt
-             endif
-           endif
-           ! If layers overlap (w/=0), then accumulate
-           if (w /= 0.0) then
-             Nw = Nw + 1
-             wt = wt + w
-             do j=1,Ncolumns
-               if (lunits) then
-                 if (y(i,j,l) /= R_UNDEF) then
-                   yp = 10.0**(y(i,j,l)/10.0)
-                 else
-                   yp = 0.0
-                 endif
-               else
-                 yp = y(i,j,l)
-               endif
-               r(i,j,k) = r(i,j,k) + w*yp
-             enddo
-           endif
-         endif
-       enddo
-       l = l - 2
-       if (l < 1) l = 0
-       ! Calculate average in new grid
-       if (Nw > 0) then
-         do j=1,Ncolumns
-           r(i,j,k) = r(i,j,k)/wt
-         enddo
-       endif
-     enddo
-   enddo
-
-   ! Set points under surface to R_UNDEF, and change to dBZ if necessary
-   do k=1,Nglevels
-     do j=1,Ncolumns
-       do i=1,Npoints
-         if (newgrid_top(k) > zhalf(i,1)) then ! Level above model bottom level
-           if (lunits) then
-             if (r(i,j,k) <= 0.0) then
-               r(i,j,k) = R_UNDEF
-             else
-               r(i,j,k) = 10.0*log10(r(i,j,k))
-             endif
-           endif
-         else ! Level below surface
-           r(i,j,k) = R_GROUND
-         endif
-       enddo
-     enddo
-   enddo
-
-END SUBROUTINE COSP_CHANGE_VERTICAL_GRID
-
-END MODULE MOD_COSP_STATS
Index: LMDZ6/trunk/libf/phylmd/cosp/cosp_types.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/cosp/cosp_types.F90	(revision 3232)
+++ 	(revision )
@@ -1,1676 +1,0 @@
-! (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,Lclopaquecalipso,Lclthincalipso, & !OPAQ (2)
-                Lclzopaquecalipso,Lclcalipsoopaque,Lclcalipsothin,Lclcalipsozopaque,    & !OPAQ (4)
-                Lclcalipsoopacity,LprofSR,Lproftemp                                       !OPAQ (1) !TIBO (2)
-
-     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 
-    real, dimension(:,:),pointer :: proftemp    ! Temperature profiles 40 levs !TIBO 
-    ! Arrays with dimensions (Npoints,LIDAR_NCAT)
-    real, dimension(:,:),pointer :: cldlayer      ! low, mid, high-level, total lidar cloud cover
-    ! Arrays with dimensions (Npoints,LIDAR_NTYPE)                                               !OPAQ
-    real, dimension(:,:),pointer :: cldtype       ! opaque and thin cloud covers, z_opaque       !OPAQ
-    ! Arrays with dimensions (Npoints,Nlevels,Nphase)
-    real, dimension(:,:,:),pointer :: lidarcldphase    ! 3D "lidar" phase cloud fraction 
-    ! Arrays with dimensions (Npoints,Nlevels,LIDAR_NTYPE+1)                                     !OPAQ
-    real, dimension(:,:,:),pointer :: lidarcldtype     ! 3D "lidar" OPAQ type fraction + opacity !OPAQ 
-    ! 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
-!    ! Arrays with dimensions (Npoints,Ncolumns,Nlevels)                     !TIBO
-!    real, dimension(:,:,:),pointer :: profSR      ! subcolumns for each day !TIBO 
-    ! Arrays with dimensions (Npoints,Nlevels,Ncolumns)                     !TIBO2
-    real, dimension(:,:,:),pointer :: profSR      ! subcolumns for each day !TIBO2 
-
-  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))
-    allocate(x%lidarcldtype(i,k,LIDAR_NTYPE+1),x%cldtype(i,LIDAR_NTYPE)) !OPAQ
-!    allocate(x%profSR(i,j,k),x%proftemp(i,k))                            !TIBO
-    allocate(x%profSR(i,k,j),x%proftemp(i,k))                            !TIBO2
-    ! --- 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
-    x%lidarcldtype  = 0.0 !OPAQ
-    x%cldtype  = 0.0      !OPAQ
-    x%profSR   = 0.0      !TIBO
-    x%proftemp = 0.0      !TIBO
-
-   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)
-    deallocate(x%lidarcldtype, x%cldtype) !OPAQ
-    deallocate(x%profSR, x%proftemp)      !TIBO
-  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),:,:)
-    y%lidarcldtype(iy(1):iy(2),:,:)    = x%lidarcldtype(ix(1):ix(2),:,:) !OPAQ
-    y%cldtype(iy(1):iy(2),:)           = x%cldtype(ix(1):ix(2),:)        !OPAQ
-    y%profSR(iy(1):iy(2),:,:)          = x%profSR(ix(1):ix(2),:,:)       !TIBO
-    y%proftemp(iy(1):iy(2),:)          = x%proftemp(ix(1):ix(2),:)       !TIBO
-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,Ncolumns,Nlevels) !TIBO
-!    print *, 'shape(x%profSR): ',shape(x%profSR)        !TIBO
-    ! Arrays with dimensions (Npoints,Nlevels,Ncolumns) !TIBO2
-    print *, 'shape(x%profSR): ',shape(x%profSR)        !TIBO2
-    ! Arrays with dimensions (Npoints,Nlevels)
-    print *, 'shape(x%lidarcld): ',shape(x%lidarcld)
-    print *, 'shape(x%proftemp): ',shape(x%proftemp)    !TIBO
-    ! Arrays with dimensions (Npoints,LIDAR_NCAT)
-    print *, 'shape(x%cldlayer): ',shape(x%cldlayer)
-    ! Arrays with dimensions (Npoints,LIDAR_NTYPE)            !OPAQ
-    print *, 'shape(x%cldtype): ',shape(x%cldtype)            !OPAQ
-    ! 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,Nlevels,LIDAR_NTYPE+1) !OPAQ
-    print *, 'shape(x%lidarcldtype): ',shape(x%lidarcldtype)  !OPAQ
-     ! 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
Index: LMDZ6/trunk/libf/phylmd/cosp/cosp_utils.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/cosp/cosp_utils.F90	(revision 3232)
+++ 	(revision )
@@ -1,344 +1,0 @@
-! (c) British Crown Copyright 2008, the Met Office.
-! All rights reserved.
-! $Revision: 23 $, $Date: 2011-03-31 15:41:37 +0200 (jeu. 31 mars 2011) $
-! $URL: http://cfmip-obs-sim.googlecode.com/svn/stable/v1.4.0/cosp_utils.F90 $
-! 
-! 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.
-
-!
-! History:
-! Jul 2007 - A. Bodas-Salcedo - Initial version
-!
-
-MODULE MOD_COSP_UTILS
-  USE MOD_COSP_CONSTANTS
-  IMPLICIT NONE
-
-  INTERFACE Z_TO_DBZ
-    MODULE PROCEDURE Z_TO_DBZ_2D,Z_TO_DBZ_3D,Z_TO_DBZ_4D
-  END INTERFACE
-
-  INTERFACE COSP_CHECK_INPUT
-    MODULE PROCEDURE COSP_CHECK_INPUT_1D,COSP_CHECK_INPUT_2D,COSP_CHECK_INPUT_3D
-  END INTERFACE
-CONTAINS
-
-!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-!------------------- SUBROUTINE COSP_PRECIP_MXRATIO --------------
-!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-SUBROUTINE COSP_PRECIP_MXRATIO(Npoints,Nlevels,Ncolumns,p,T,prec_frac,prec_type, &
-                          n_ax,n_bx,alpha_x,c_x,d_x,g_x,a_x,b_x,gamma1,gamma2,gamma3,gamma4, &
-                          flux,mxratio,reff)
-
-    ! Input arguments, (IN)
-    integer,intent(in) :: Npoints,Nlevels,Ncolumns
-    real,intent(in),dimension(Npoints,Nlevels) :: p,T,flux
-    real,intent(in),dimension(Npoints,Ncolumns,Nlevels) :: prec_frac
-    real,intent(in) :: n_ax,n_bx,alpha_x,c_x,d_x,g_x,a_x,b_x,gamma1,gamma2,gamma3,gamma4,prec_type
-    ! Input arguments, (OUT)
-    real,intent(out),dimension(Npoints,Ncolumns,Nlevels) :: mxratio
-    real,intent(inout),dimension(Npoints,Ncolumns,Nlevels) :: reff
-    ! Local variables
-    integer :: i,j,k
-    real :: sigma,one_over_xip1,xi,rho0,rho,lambda_x,gamma_4_3_2,delta
-    
-    mxratio = 0.0
-
-    if (n_ax >= 0.0) then ! N_ax is used to control which hydrometeors need to be computed
-        xi      = d_x/(alpha_x + b_x - n_bx + 1.0)
-        rho0    = 1.29
-        sigma   = (gamma2/(gamma1*c_x))*(n_ax*a_x*gamma2)**xi
-        one_over_xip1 = 1.0/(xi + 1.0)
-        gamma_4_3_2 = 0.5*gamma4/gamma3
-        delta = (alpha_x + b_x + d_x - n_bx + 1.0)
-        
-        do k=1,Nlevels
-            do j=1,Ncolumns
-                do i=1,Npoints
-                    if ((prec_frac(i,j,k)==prec_type).or.(prec_frac(i,j,k)==3.)) then
-                        rho = p(i,k)/(287.05*T(i,k))
-                        mxratio(i,j,k)=(flux(i,k)*((rho/rho0)**g_x)*sigma)**one_over_xip1
-                        mxratio(i,j,k)=mxratio(i,j,k)/rho
-                        ! Compute effective radius
-                        if ((reff(i,j,k) <= 0.0).and.(flux(i,k) /= 0.0)) then
-                           lambda_x = (a_x*c_x*((rho0/rho)**g_x)*n_ax*gamma1/flux(i,k))**(1./delta)
-                           reff(i,j,k) = gamma_4_3_2/lambda_x
-                        endif
-                    endif
-                enddo
-            enddo
-        enddo
-    endif
-END SUBROUTINE COSP_PRECIP_MXRATIO
-
-
-!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-!------------------- SUBROUTINE ZERO_INT -------------------------
-!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-ELEMENTAL SUBROUTINE ZERO_INT(x,y01,y02,y03,y04,y05,y06,y07,y08,y09,y10, &
-                                 y11,y12,y13,y14,y15,y16,y17,y18,y19,y20, &
-                                 y21,y22,y23,y24,y25,y26,y27,y28,y29,y30)
-
-  integer,intent(inout) :: x
-  integer,intent(inout),optional :: y01,y02,y03,y04,y05,y06,y07,y08,y09,y10, &
-                                    y11,y12,y13,y14,y15,y16,y17,y18,y19,y20, &
-                                    y21,y22,y23,y24,y25,y26,y27,y28,y29,y30
-  x = 0
-  if (present(y01)) y01 = 0
-  if (present(y02)) y02 = 0
-  if (present(y03)) y03 = 0
-  if (present(y04)) y04 = 0
-  if (present(y05)) y05 = 0
-  if (present(y06)) y06 = 0
-  if (present(y07)) y07 = 0
-  if (present(y08)) y08 = 0
-  if (present(y09)) y09 = 0
-  if (present(y10)) y10 = 0
-  if (present(y11)) y11 = 0
-  if (present(y12)) y12 = 0
-  if (present(y13)) y13 = 0
-  if (present(y14)) y14 = 0
-  if (present(y15)) y15 = 0
-  if (present(y16)) y16 = 0
-  if (present(y17)) y17 = 0
-  if (present(y18)) y18 = 0
-  if (present(y19)) y19 = 0
-  if (present(y20)) y20 = 0
-  if (present(y21)) y21 = 0
-  if (present(y22)) y22 = 0
-  if (present(y23)) y23 = 0
-  if (present(y24)) y24 = 0
-  if (present(y25)) y25 = 0
-  if (present(y26)) y26 = 0
-  if (present(y27)) y27 = 0
-  if (present(y28)) y28 = 0
-  if (present(y29)) y29 = 0
-  if (present(y30)) y30 = 0
-END SUBROUTINE  ZERO_INT
-
-!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-!------------------- SUBROUTINE ZERO_REAL ------------------------
-!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-ELEMENTAL SUBROUTINE ZERO_REAL(x,y01,y02,y03,y04,y05,y06,y07,y08,y09,y10, &
-                                 y11,y12,y13,y14,y15,y16,y17,y18,y19,y20, &
-                                 y21,y22,y23,y24,y25,y26,y27,y28,y29,y30)
-
-  real,intent(inout) :: x
-  real,intent(inout),optional :: y01,y02,y03,y04,y05,y06,y07,y08,y09,y10, &
-                                 y11,y12,y13,y14,y15,y16,y17,y18,y19,y20, &
-                                 y21,y22,y23,y24,y25,y26,y27,y28,y29,y30
-  x = 0.0
-  if (present(y01)) y01 = 0.0
-  if (present(y02)) y02 = 0.0
-  if (present(y03)) y03 = 0.0
-  if (present(y04)) y04 = 0.0
-  if (present(y05)) y05 = 0.0
-  if (present(y06)) y06 = 0.0
-  if (present(y07)) y07 = 0.0
-  if (present(y08)) y08 = 0.0
-  if (present(y09)) y09 = 0.0
-  if (present(y10)) y10 = 0.0
-  if (present(y11)) y11 = 0.0
-  if (present(y12)) y12 = 0.0
-  if (present(y13)) y13 = 0.0
-  if (present(y14)) y14 = 0.0
-  if (present(y15)) y15 = 0.0
-  if (present(y16)) y16 = 0.0
-  if (present(y17)) y17 = 0.0
-  if (present(y18)) y18 = 0.0
-  if (present(y19)) y19 = 0.0
-  if (present(y20)) y20 = 0.0
-  if (present(y21)) y21 = 0.0
-  if (present(y22)) y22 = 0.0
-  if (present(y23)) y23 = 0.0
-  if (present(y24)) y24 = 0.0
-  if (present(y25)) y25 = 0.0
-  if (present(y26)) y26 = 0.0
-  if (present(y27)) y27 = 0.0
-  if (present(y28)) y28 = 0.0
-  if (present(y29)) y29 = 0.0
-  if (present(y30)) y30 = 0.0
-END SUBROUTINE  ZERO_REAL
-
-!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-!--------------------- SUBROUTINE Z_TO_DBZ_2D --------------------
-!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-  SUBROUTINE Z_TO_DBZ_2D(mdi,z)
-    real,intent(in) :: mdi
-    real,dimension(:,:),intent(inout) :: z
-    ! Reflectivity Z:
-    ! Input in [m3]
-    ! Output in dBZ, with Z in [mm6 m-3]
-    
-    ! 1.e18 to convert from [m3] to [mm6 m-3]
-    z = 1.e18*z
-    where (z > 1.0e-6) ! Limit to -60 dBZ
-      z = 10.0*log10(z)
-    elsewhere
-      z = mdi
-    end where  
-  END SUBROUTINE Z_TO_DBZ_2D
-!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-!--------------------- SUBROUTINE Z_TO_DBZ_3D --------------------
-!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-  SUBROUTINE Z_TO_DBZ_3D(mdi,z)
-    real,intent(in) :: mdi
-    real,dimension(:,:,:),intent(inout) :: z
-    ! Reflectivity Z:
-    ! Input in [m3]
-    ! Output in dBZ, with Z in [mm6 m-3]
-    
-    ! 1.e18 to convert from [m3] to [mm6 m-3]
-    z = 1.e18*z
-    where (z > 1.0e-6) ! Limit to -60 dBZ
-      z = 10.0*log10(z)
-    elsewhere
-      z = mdi
-    end where  
-  END SUBROUTINE Z_TO_DBZ_3D
-!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-!--------------------- SUBROUTINE Z_TO_DBZ_4D --------------------
-!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-  SUBROUTINE Z_TO_DBZ_4D(mdi,z)
-    real,intent(in) :: mdi
-    real,dimension(:,:,:,:),intent(inout) :: z
-    ! Reflectivity Z:
-    ! Input in [m3]
-    ! Output in dBZ, with Z in [mm6 m-3]
-    
-    ! 1.e18 to convert from [m3] to [mm6 m-3]
-    z = 1.e18*z
-    where (z > 1.0e-6) ! Limit to -60 dBZ
-      z = 10.0*log10(z)
-    elsewhere
-      z = mdi
-    end where  
-  END SUBROUTINE Z_TO_DBZ_4D
-
-!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-!----------------- SUBROUTINES COSP_CHECK_INPUT_1D ---------------
-!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-  SUBROUTINE COSP_CHECK_INPUT_1D(vname,x,min_val,max_val)
-    character(len=*) :: vname
-    real,intent(inout) :: x(:)
-    real,intent(in),optional :: min_val,max_val
-    logical :: l_min,l_max
-    character(len=128) :: pro_name='COSP_CHECK_INPUT_1D'
-    
-    l_min=.false.
-    l_max=.false.
-    
-    if (present(min_val)) then
-!       if (x < min_val) x = min_val
-      if (any(x < min_val)) then 
-      l_min = .true.
-        where (x < min_val)
-          x = min_val
-        end where
-      endif
-    endif    
-    if (present(max_val)) then
-!       if (x > max_val) x = max_val
-      if (any(x > max_val)) then 
-        l_max = .true.
-        where (x > max_val)
-          x = max_val
-        end where  
-      endif    
-    endif    
-    
-    if (l_min) print *,'----- WARNING: '//trim(pro_name)//': minimum value of '//trim(vname)//' set to: ',min_val
-    if (l_max) print *,'----- WARNING: '//trim(pro_name)//': maximum value of '//trim(vname)//' set to: ',max_val
-  END SUBROUTINE COSP_CHECK_INPUT_1D
-!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-!----------------- SUBROUTINES COSP_CHECK_INPUT_2D ---------------
-!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-  SUBROUTINE COSP_CHECK_INPUT_2D(vname,x,min_val,max_val)
-    character(len=*) :: vname
-    real,intent(inout) :: x(:,:)
-    real,intent(in),optional :: min_val,max_val
-    logical :: l_min,l_max
-    character(len=128) :: pro_name='COSP_CHECK_INPUT_2D'
-    
-    l_min=.false.
-    l_max=.false.
-    
-    if (present(min_val)) then
-!       if (x < min_val) x = min_val
-      if (any(x < min_val)) then 
-      l_min = .true.
-        where (x < min_val)
-          x = min_val
-        end where
-      endif
-    endif    
-    if (present(max_val)) then
-!       if (x > max_val) x = max_val
-      if (any(x > max_val)) then 
-        l_max = .true.
-        where (x > max_val)
-          x = max_val
-        end where  
-      endif    
-    endif    
-    
-    if (l_min) print *,'----- WARNING: '//trim(pro_name)//': minimum value of '//trim(vname)//' set to: ',min_val
-    if (l_max) print *,'----- WARNING: '//trim(pro_name)//': maximum value of '//trim(vname)//' set to: ',max_val
-  END SUBROUTINE COSP_CHECK_INPUT_2D
-!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-!----------------- SUBROUTINES COSP_CHECK_INPUT_3D ---------------
-!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-  SUBROUTINE COSP_CHECK_INPUT_3D(vname,x,min_val,max_val)
-    character(len=*) :: vname
-    real,intent(inout) :: x(:,:,:)
-    real,intent(in),optional :: min_val,max_val
-    logical :: l_min,l_max
-    character(len=128) :: pro_name='COSP_CHECK_INPUT_3D'
-    
-    l_min=.false.
-    l_max=.false.
-    
-    if (present(min_val)) then
-!       if (x < min_val) x = min_val
-      if (any(x < min_val)) then 
-      l_min = .true.
-        where (x < min_val)
-          x = min_val
-        end where
-      endif
-    endif    
-    if (present(max_val)) then
-!       if (x > max_val) x = max_val
-      if (any(x > max_val)) then 
-        l_max = .true.
-        where (x > max_val)
-          x = max_val
-        end where  
-      endif    
-    endif    
-    
-    if (l_min) print *,'----- WARNING: '//trim(pro_name)//': minimum value of '//trim(vname)//' set to: ',min_val
-    if (l_max) print *,'----- WARNING: '//trim(pro_name)//': maximum value of '//trim(vname)//' set to: ',max_val
-  END SUBROUTINE COSP_CHECK_INPUT_3D
-
-
-END MODULE MOD_COSP_UTILS
Index: LMDZ6/trunk/libf/phylmd/cosp/format_input.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/cosp/format_input.F90	(revision 3232)
+++ LMDZ6/trunk/libf/phylmd/cosp/format_input.F90	(revision 3233)
Index: LMDZ6/trunk/libf/phylmd/cosp/llnl_stats.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/cosp/llnl_stats.F90	(revision 3232)
+++ 	(revision )
@@ -1,138 +1,0 @@
-! (c) 2008, Lawrence Livermore National Security Limited Liability Corporation.
-! All rights reserved.
-! $Revision: 88 $, $Date: 2013-11-13 15:08:38 +0100 (mer. 13 nov. 2013) $
-! $URL: http://cfmip-obs-sim.googlecode.com/svn/stable/v1.4.0/llnl/llnl_stats.F90 $
-! 
-! 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 Lawrence Livermore National Security Limited Liability Corporation 
-!       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.
-!
-! History
-!
-! Jan 2013 - G. Cesana        - Added betaperp_tot and temp_tot arguments 
-!
-
-
-MODULE MOD_LLNL_STATS
-  USE MOD_COSP_CONSTANTS
-  IMPLICIT NONE
-
-CONTAINS
-
-!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-!-------------------- FUNCTION COSP_CFAD ------------------------
-!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-FUNCTION COSP_CFAD(Npoints,Ncolumns,Nlevels,Nbins,x,xmin,xmax,bmin,bwidth)
-   ! Input arguments
-   integer,intent(in) :: Npoints,Ncolumns,Nlevels,Nbins
-   real,dimension(Npoints,Ncolumns,Nlevels),intent(in) :: x
-   real,intent(in) :: xmin,xmax 
-   real,intent(in) :: bmin,bwidth
-   
-   real,dimension(Npoints,Nbins,Nlevels) :: cosp_cfad
-   ! Local variables
-   integer :: i, j, k
-   integer :: ibin
-   
-   !--- Input arguments
-   ! Npoints: Number of horizontal points
-   ! Ncolumns: Number of subcolumns
-   ! Nlevels: Number of levels
-   ! Nbins: Number of x axis bins
-   ! x: variable to process (Npoints,Ncolumns,Nlevels)
-   ! xmin: minimum value allowed for x
-   ! xmax: minimum value allowed for x
-   ! bmin: mimumum value of first bin
-   ! bwidth: bin width
-   !
-   ! Output: 2D histogram on each horizontal point (Npoints,Nbins,Nlevels)
-   
-   cosp_cfad = 0.0
-   ! bwidth intervals in the range [bmin,bmax=bmin+Nbins*hwidth]
-   ! Valid x values smaller than bmin and larger than bmax are set 
-   ! into the smallest bin and largest bin, respectively.
-   do j = 1, Nlevels, 1
-      do k = 1, Ncolumns, 1
-         do i = 1, Npoints, 1
-            if (x(i,k,j) == R_GROUND) then
-               cosp_cfad(i,:,j) = R_UNDEF
-            elseif ((x(i,k,j) >= xmin) .and. (x(i,k,j) <= xmax)) then 
-               ibin = ceiling((x(i,k,j) - bmin)/bwidth)
-               if (ibin > Nbins) ibin = Nbins
-               if (ibin < 1)     ibin = 1
-               cosp_cfad(i,ibin,j) = cosp_cfad(i,ibin,j) + 1.0 
-            end if
-         enddo  !i
-      enddo  !k
-   enddo  !j
-   where ((cosp_cfad /= R_UNDEF).and.(cosp_cfad /= 0.0)) cosp_cfad = cosp_cfad / Ncolumns
-END FUNCTION COSP_CFAD
-
-!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-!------------- SUBROUTINE COSP_LIDAR_ONLY_CLOUD -----------------
-!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-SUBROUTINE COSP_LIDAR_ONLY_CLOUD(Npoints,Ncolumns,Nlevels,temp_tot,beta_tot, &
-                   betaperp_tot,beta_mol,Ze_tot,lidar_only_freq_cloud,tcc)
-   ! Input arguments
-   integer,intent(in) :: Npoints,Ncolumns,Nlevels
-   real,dimension(Npoints,Nlevels),intent(in) :: beta_mol   ! Molecular backscatter
-   real,dimension(Npoints,Ncolumns,Nlevels),intent(in) :: beta_tot   ! Total backscattered signal
-   real,dimension(Npoints,Ncolumns,Nlevels),intent(in) :: temp_tot   ! Total backscattered signal
-   real,dimension(Npoints,Ncolumns,Nlevels),intent(in) :: betaperp_tot   ! perpendicular Total backscattered signal
-   real,dimension(Npoints,Ncolumns,Nlevels),intent(in) :: Ze_tot     ! Radar reflectivity
-   ! Output arguments
-   real,dimension(Npoints,Nlevels),intent(out) :: lidar_only_freq_cloud
-   real,dimension(Npoints),intent(out) :: tcc
-
-   ! local variables
-   real :: sc_ratio
-   real :: s_cld, s_att
-   parameter (S_cld = 5.0)
-   parameter (s_att = 0.01)
-   integer :: flag_sat !first saturated level encountered from top
-   integer :: flag_cld !cloudy column
-   integer :: pr,i,j
-
-   lidar_only_freq_cloud = 0.0
-   tcc = 0.0
-   do pr=1,Npoints
-     do i=1,Ncolumns
-       flag_sat = 0
-       flag_cld = 0
-       do j=Nlevels,1,-1 !top->surf
-        sc_ratio = beta_tot(pr,i,j)/beta_mol(pr,j)
-        if ((sc_ratio .le. s_att) .and. (flag_sat .eq. 0)) flag_sat = j
-        if (Ze_tot(pr,i,j) .lt. -30.) then  !radar can't detect cloud
-         if ( (sc_ratio .gt. s_cld) .or. (flag_sat .eq. j) ) then  !lidar sense cloud
-            lidar_only_freq_cloud(pr,j)=lidar_only_freq_cloud(pr,j)+1. !top->surf
-            flag_cld=1
-         endif
-        else  !radar sense cloud (z%Ze_tot(pr,i,j) .ge. -30.)
-           flag_cld=1
-        endif
-       enddo !levels
-       if (flag_cld .eq. 1) tcc(pr)=tcc(pr)+1.
-     enddo !columns
-   enddo !points
-   lidar_only_freq_cloud=lidar_only_freq_cloud/Ncolumns
-   tcc=tcc/Ncolumns
-
-END SUBROUTINE COSP_LIDAR_ONLY_CLOUD
-END MODULE MOD_LLNL_STATS
Index: LMDZ6/trunk/libf/phylmd/cosp/lmd_ipsl_stats.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/cosp/lmd_ipsl_stats.F90	(revision 3232)
+++ 	(revision )
@@ -1,1181 +1,0 @@
-! Copyright (c) 2009, Centre National de la Recherche Scientifique
-! All rights reserved.
-! $Revision: 88 $, $Date: 2013-11-13 15:08:38 +0100 (mer. 13 nov. 2013) $
-! $URL: http://cfmip-obs-sim.googlecode.com/svn/stable/v1.4.0/actsim/lmd_ipsl_stats.F90 $
-!
-! 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 LMD/IPSL/CNRS/UPMC 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.
-
-
-!------------------------------------------------------------------------------------
-! Authors: Sandrine Bony and Helene Chepfer (LMD/IPSL, CNRS, UPMC, France).
-!------------------------------------------------------------------------------------
-MODULE MOD_LMD_IPSL_STATS
-  USE MOD_LLNL_STATS
-  IMPLICIT NONE
-
-CONTAINS
-      SUBROUTINE diag_lidar(npoints,ncol,llm,max_bin,nrefl &
-                  ,tmp,pnorm,pnorm_perp,pmol,refl,land,pplay,undef,ok_lidar_cfad &
-                  ,cfad2,srbval,ncat,ntype,lidarcld,lidarcldtype,lidarcldphase,cldlayer & !OPAQ
-                  ,cldtype,cldlayerphase,lidarcldtmp,parasolrefl,vgrid_z,profSR)          !OPAQ !TIBO
-!
-! -----------------------------------------------------------------------------------
-! Lidar outputs :
-!
-! Diagnose cloud fraction (3D cloud fraction + low/middle/high/total cloud fraction)
-! and phase cloud fraction (3D, low/mid/high/total and 3D temperature)
-! from the lidar signals (ATB, ATBperp and molecular ATB) computed from model outputs
-!      +
-! Compute CFADs of lidar scattering ratio SR and of depolarization index
-!
-! Authors: Sandrine Bony and Helene Chepfer (LMD/IPSL, CNRS, UPMC, France).
-!
-! December 2008, S. Bony,  H. Chepfer and J-L. Dufresne :
-! - change of the cloud detection threshold S_cld from 3 to 5, for better
-! with both day and night observations. The optical thinest clouds are missed.
-! - remove of the detection of the first fully attenuated layer encountered from above.
-! December 2008, A. Bodas-Salcedo:
-! - Dimensions of pmol reduced to (npoints,llm)
-! August 2009, A. Bodas-Salcedo:
-! - Warning message regarding PARASOL being valid only over ocean deleted.
-! February 2010, A. Bodas-Salcedo:
-! - Undef passed into cosp_cfad_sr
-! June 2010, T. Yokohata, T. Nishimura and K. Ogochi
-! Optimisation of COSP_CFAD_SR
-!
-! January 2013, G. Cesana, H. Chepfer:
-! - Add the perpendicular component of the backscattered signal (pnorm_perp) in the arguments
-! - Add the temperature (tmp) in the arguments
-! - Add the 3D Phase cloud fraction (lidarcldphase) in the arguments
-! - Add the Phase low mid high cloud fraction (cldlayerphase) in the arguments
-! - Add the 3D Phase cloud fraction as a function of temperature (lidarcldtmp) in the arguments
-! - Modification of the phase diagnosis within the COSP_CLDFRAC routine to integrate the phase
-!   diagnosis (3D, low/mid/high, 3D temperature)
-! Reference: Cesana G. and H. Chepfer (2013): Evaluation of the cloud water phase
-! in a climate model using CALIPSO-GOCCP, J. Geophys. Res., doi: 10.1002/jgrd.50376
-!
-! ------------------------------------------------------------------------------------
-
-! c inputs :
-      integer npoints
-      integer ncol
-      integer llm
-      integer max_bin               ! nb of bins for SR CFADs
-      integer ncat                  ! nb of cloud layer types (low,mid,high,total)
-      integer ntype                 ! nb of OPAQ products (opaque and thin clouds, z_opaque) !OPAQ
-      integer nrefl                 ! nb of solar zenith angles for parasol reflectances
-
-      real undef                    ! undefined value
-      real pnorm(npoints,ncol,llm)  ! lidar ATB
-      real pmol(npoints,llm)        ! molecular ATB
-      real land(npoints)            ! Landmask [0 - Ocean, 1 - Land]
-      real pplay(npoints,llm)       ! pressure on model levels (Pa)
-      logical ok_lidar_cfad         ! true if lidar CFAD diagnostics need to be computed
-      real refl(npoints,ncol,nrefl) ! subgrid parasol reflectance ! parasol
-      real tmp(npoints,llm)         ! temp at each levels
-      real pnorm_perp(npoints,ncol,llm)  ! lidar perpendicular ATB
-      real vgrid_z(llm)             ! mid-level altitude of the output vertical grid         !OPAQ
-
-! c outputs :
-      real lidarcld(npoints,llm)     ! 3D "lidar" cloud fraction
-      real lidarcldtype(npoints,llm,ntype+1)   ! 3D "lidar" OPAQ type fraction + opacity     !OPAQ
-      real sub(npoints,llm)     ! 3D "lidar" indice
-      real cldlayer(npoints,ncat)    ! "lidar" cloud layer fraction (low, mid, high, total)
-      real cldtype(npoints,ntype)  ! "lidar" OPAQ type covers (opaque/thin cloud + z_opaque) !OPAQ
-
-      real cfad2(npoints,max_bin,llm) ! CFADs of SR
-      real srbval(max_bin)           ! SR bins in CFADs
-      real parasolrefl(npoints,nrefl)! grid-averaged parasol reflectance
-!     real profSR(npoints,ncol,llm)  ! tableau avec les subcolumns SR !TIBO
-      real profSR(npoints,llm,ncol)  ! tableau avec les subcolumns SR !TIBO2
-
-! c threshold for cloud detection :
-      real S_clr
-      parameter (S_clr = 1.2)
-      real S_cld
-      parameter (S_cld = 5.)  ! Thresold for cloud detection
-      real S_att
-      parameter (S_att = 0.01)
-!      parameter (S_att = 0.06)  !OPAQ ! Threshold for "surface detection" equivalent
-
-! c local variables :
-      integer ic,k,i,j
-      real x3d(npoints,ncol,llm)
-      real x3d_c(npoints,llm),pnorm_c(npoints,llm)
-      real xmax
-
-! Output variables
-      integer,parameter :: nphase = 6 ! nb of cloud layer phase types (ice,liquid,undefined,false ice,false liquid,Percent of ice)
-      real lidarcldphase(npoints,llm,nphase)   ! 3D "lidar" phase cloud fraction
-      real lidarcldtmp(npoints,40,5)          ! 3D "lidar" phase cloud fraction as a function of temp
-      real cldlayerphase(npoints,ncat,nphase)  ! "lidar" phase low mid high cloud fraction 
-
-! SR detection threshold
-      real, parameter  ::  S_cld_att = 30. ! New threshold for undefine cloud phase detection	
-
-
-!
-! c -------------------------------------------------------
-! c 0- Initializations
-! c -------------------------------------------------------
-!
-!  Should be modified in future version
-      xmax=undef-1.0
-
-! c -------------------------------------------------------
-! c 1- Lidar scattering ratio :
-! c -------------------------------------------------------
-
-      do ic = 1, ncol
-        pnorm_c = pnorm(:,ic,:)
-        where ((pnorm_c.lt.xmax) .and. (pmol.lt.xmax) .and. (pmol.gt. 0.0 ))
-            x3d_c = pnorm_c/pmol
-        elsewhere
-            x3d_c = undef
-        end where
-         x3d(:,ic,:) = x3d_c
-!	profSR(:,ic,:) = x3d(:,ic,:) !TIBO
-	profSR(:,:,ic) = x3d(:,ic,:) !TIBO2
-      enddo
-
-! c -------------------------------------------------------
-! c 2- Diagnose cloud fractions (3D, low, middle, high, total)
-! c from subgrid-scale lidar scattering ratios :
-! c -------------------------------------------------------
-
-    CALL COSP_CLDFRAC(npoints,ncol,llm,ncat,nphase,  &
-              tmp,x3d,pnorm,pnorm_perp,pplay, S_att,S_cld,S_cld_att,undef,lidarcld, &
-              cldlayer,lidarcldphase,sub,cldlayerphase,lidarcldtmp)
-
-    CALL COSP_OPAQ(npoints,ncol,llm,ntype,x3d,S_cld,undef,lidarcldtype,            & !OPAQ
-                   cldtype,vgrid_z)                                                  !OPAQ
-
-! c -------------------------------------------------------
-! c 3- CFADs
-! c -------------------------------------------------------
-      if (ok_lidar_cfad) then
-!
-! c CFADs of subgrid-scale lidar scattering ratios :
-! c -------------------------------------------------------
-      CALL COSP_CFAD_SR(npoints,ncol,llm,max_bin,undef, &
-                 x3d, &
-                 S_att,S_clr,xmax,cfad2,srbval)
-
-      endif   ! ok_lidar_cfad
-! c -------------------------------------------------------
-
-! c -------------------------------------------------------
-! c 4- Compute grid-box averaged Parasol reflectances
-! c -------------------------------------------------------
-
-      parasolrefl(:,:) = 0.0
-
-      do k = 1, nrefl
-       do ic = 1, ncol
-         parasolrefl(:,k) = parasolrefl(:,k) + refl(:,ic,k)
-       enddo
-      enddo
-
-      do k = 1, nrefl
-        parasolrefl(:,k) = parasolrefl(:,k) / float(ncol)
-! if land=1 -> parasolrefl=undef
-! if land=0 -> parasolrefl=parasolrefl
-        parasolrefl(:,k) = parasolrefl(:,k) * MAX(1.0-land(:),0.0) &
-                           + (1.0 - MAX(1.0-land(:),0.0))*undef
-      enddo
-
-      RETURN
-      END SUBROUTINE diag_lidar
-
-
-!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-!-------------------- FUNCTION COSP_CFAD_SR ------------------------
-! Author: Sandrine Bony (LMD/IPSL, CNRS, Paris)
-!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-      SUBROUTINE COSP_CFAD_SR(Npoints,Ncolumns,Nlevels,Nbins,undef, &
-                      x,S_att,S_clr,xmax,cfad,srbval)
-      IMPLICIT NONE
-
-!--- Input arguments
-! Npoints: Number of horizontal points
-! Ncolumns: Number of subcolumns
-! Nlevels: Number of levels
-! Nbins: Number of x axis bins
-! xmax: maximum value allowed for x
-! S_att: Threshold for full attenuation
-! S_clr: Threshold for clear-sky layer
-!
-!--- Input-Outout arguments
-! x: variable to process (Npoints,Ncolumns,Nlevels), mofified where saturation occurs
-!
-! -- Output arguments
-! srbval : values of the histogram bins
-! cfad: 2D histogram on each horizontal point
-
-! Input arguments
-      integer Npoints,Ncolumns,Nlevels,Nbins
-      real xmax,S_att,S_clr,undef
-! Input-output arguments
-      real x(Npoints,Ncolumns,Nlevels)
-! Output :
-      real cfad(Npoints,Nbins,Nlevels)
-      real srbval(Nbins)
-! Local variables
-      integer i, j, k, ib
-      real srbval_ext(0:Nbins)
-
-! c -------------------------------------------------------
-! c 0- Initializations
-! c -------------------------------------------------------
-      if ( Nbins .lt. 6) return
-
-      srbval(1) =  S_att
-      srbval(2) =  S_clr
-      srbval(3) =  3.0
-      srbval(4) =  5.0
-      srbval(5) =  7.0
-      srbval(6) = 10.0
-      do i = 7, MIN(10,Nbins)
-       srbval(i) = srbval(i-1) + 5.0
-      enddo
-      DO i = 11, MIN(13,Nbins)
-       srbval(i) = srbval(i-1) + 10.0
-      enddo
-      srbval(MIN(14,Nbins)) = 80.0
-      srbval(Nbins) = xmax
-      cfad(:,:,:) = 0.0
-
-      srbval_ext(1:Nbins) = srbval
-      srbval_ext(0) = -1.0
-! c -------------------------------------------------------
-! c c- Compute CFAD
-! c -------------------------------------------------------
-      do j = 1, Nlevels
-         do ib = 1, Nbins
-            do k = 1, Ncolumns
-               do i = 1, Npoints
-                  if (x(i,k,j) /= undef) then
-                     if ((x(i,k,j).gt.srbval_ext(ib-1)).and.(x(i,k,j).le.srbval_ext(ib))) &
-                          cfad(i,ib,j) = cfad(i,ib,j) + 1.0
-                  else 
-                     cfad(i,ib,j) = undef
-                  endif
-               enddo
-            enddo
-         enddo
-      enddo
-
-      where (cfad .ne. undef)  cfad = cfad / float(Ncolumns)
-
-! c -------------------------------------------------------
-      RETURN
-      END SUBROUTINE COSP_CFAD_SR
-
-
-!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-!-------------------- SUBROUTINE COSP_CLDFRAC -------------------
-! c Purpose: Cloud fraction diagnosed from lidar measurements
-!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-      SUBROUTINE COSP_CLDFRAC(Npoints,Ncolumns,Nlevels,Ncat,Nphase, &
-                  tmp,x,ATB,ATBperp,pplay,S_att,S_cld,S_cld_att,undef,lidarcld, &
-                  cldlayer,lidarcldphase,nsub,cldlayerphase,lidarcldtemp)
-
-
-      IMPLICIT NONE
-! Input arguments
-      integer Npoints,Ncolumns,Nlevels,Ncat
-      real x(Npoints,Ncolumns,Nlevels)
-
-
-! Local parameters
-      integer nphase ! nb of cloud layer phase types 
-                                      ! (ice,liquid,undefined,false ice,false liquid,Percent of ice)
-      integer,parameter  ::  Ntemp=40 ! indice of the temperature vector
-      integer ip, k, iz, ic, ncol, nlev, i, itemp  ! loop indice
-      real  S_cld_att ! New threshold for undefine cloud phase detection (SR=30)	
-      integer toplvlsat  ! level of the first cloud with SR>30
-      real alpha50, beta50, gamma50, delta50, epsilon50, zeta50 ! Polynomial Coef of the phase
-                                                                ! discrimination line   
-
-! Input variables
-      real tmp(Npoints,Nlevels)			! temperature
-      real ATB(Npoints,Ncolumns,Nlevels) ! 3D Attenuated backscatter
-      real ATBperp(Npoints,Ncolumns,Nlevels) ! 3D perpendicular attenuated backscatter
-      real pplay(Npoints,Nlevels)
-      real S_att,S_cld
-      real undef
-
-! Output variables
-      real lidarcldtemp(Npoints,Ntemp,5) ! 3D Temperature 1=tot,2=ice,3=liq,4=undef,5=ice/ice+liq
-      real tempmod(Ntemp+1)     ! temperature bins
-      real lidarcldphase(Npoints,Nlevels,Nphase)    ! 3D cloud phase fraction
-      real cldlayerphase(Npoints,Ncat,Nphase) ! low, middle, high, total cloud fractions for ice liquid and undefine phase
-      real lidarcld(Npoints,Nlevels) ! 3D cloud fraction
-      real cldlayer(Npoints,Ncat)    ! low, middle, high, total cloud fractions
-
-! Local variables
-      real tmpi(Npoints,Ncolumns,Nlevels)	! temperature of ice cld
-      real tmpl(Npoints,Ncolumns,Nlevels)	! temperature of liquid cld
-      real tmpu(Npoints,Ncolumns,Nlevels)	! temperature of undef cld
-
-      real checktemp, ATBperp_tmp ! temporary variable
-      real checkcldlayerphase, checkcldlayerphase2 ! temporary variable
-      real sumlidarcldtemp(Npoints,Ntemp) ! temporary variable
-
-      real cldlayphase(Npoints,Ncolumns,Ncat,Nphase) ! subgrided low mid high phase cloud fraction
-      real cldlayerphasetmp(Npoints,Ncat) ! temporary variable
-      real cldlayerphasesum(Npoints,Ncat) ! temporary variable
-      real lidarcldtempind(Npoints,Ntemp) ! 3D Temperature indice
-      real lidarcldphasetmp(Npoints,Nlevels)  ! 3D sum of ice and liquid cloud occurences
-
-
-! Local variables
-      real p1
-      real cldy(Npoints,Ncolumns,Nlevels)
-      real srok(Npoints,Ncolumns,Nlevels)
-      real cldlay(Npoints,Ncolumns,Ncat)
-      real nsublay(Npoints,Ncolumns,Ncat), nsublayer(Npoints,Ncat)
-      real nsub(Npoints,Nlevels)
-
-#ifdef SYS_SX
-      real cldlay1(Npoints,Ncolumns)
-      real cldlay2(Npoints,Ncolumns)
-      real cldlay3(Npoints,Ncolumns)
-      real nsublay1(Npoints,Ncolumns)
-      real nsublay2(Npoints,Ncolumns)
-      real nsublay3(Npoints,Ncolumns)
-#endif
-
-
-
-
-! ---------------------------------------------------------------
-! 1- initialization
-! ---------------------------------------------------------------
-
-      if ( Ncat .ne. 4 ) then
-         print *,'Error in lmd_ipsl_stats.cosp_cldfrac, Ncat must be 4, not',Ncat
-         stop
-      endif
-
-      lidarcld = 0.0
-      nsub = 0.0
-      cldlay = 0.0
-      nsublay = 0.0
-
-      ATBperp_tmp = 0.
-      lidarcldphase(:,:,:) = 0.
-      cldlayphase(:,:,:,:) = 0.
-      cldlayerphase(:,:,:) = 0.
-      tmpi(:,:,:) = 0.
-      tmpl(:,:,:) = 0.
-      tmpu(:,:,:) = 0.
-      cldlayerphasesum(:,:) = 0.
-      lidarcldtemp(:,:,:) = 0.
-      lidarcldtempind(:,:) = 0.
-      sumlidarcldtemp(:,:) = 0.
-      toplvlsat=0
-      lidarcldphasetmp(:,:) = 0.
-
-! temperature bins
-      tempmod=(/-273.15,-90.,-87.,-84.,-81.,-78.,-75.,-72.,-69.,-66.,-63.,-60.,-57., &
-                -54.,-51.,-48.,-45.,-42.,-39.,-36.,-33.,-30.,-27.,-24.,-21.,-18.,  &
-                -15.,-12.,-9.,-6.,-3.,0.,3.,6.,9.,12.,15.,18.,21.,24.,200. /)
-	
-! convert C to K
-      tempmod=tempmod+273.15
-
-! Polynomial coefficient of the phase discrimination line used to separate liquid from ice
-! (Cesana and Chepfer, JGR, 2013)
-! ATBperp = ATB^5*alpha50 + ATB^4*beta50 + ATB^3*gamma50 + ATB^2*delta50 + ATB*epsilon50 + zeta50
-      alpha50   = 9.0322e+15
-      beta50    = -2.1358e+12
-      gamma50   = 173.3963e06
-      delta50   = -3.9514e03
-      epsilon50 = 0.2559
-      zeta50    = -9.4776e-07
-
-
-! ---------------------------------------------------------------
-! 2- Cloud detection
-! ---------------------------------------------------------------
-
-      do k = 1, Nlevels
-
-! cloud detection at subgrid-scale:
-         where ( (x(:,:,k).gt.S_cld) .and. (x(:,:,k).ne. undef) )
-           cldy(:,:,k)=1.0
-         elsewhere
-           cldy(:,:,k)=0.0
-         endwhere
-
-! number of usefull sub-columns:
-         where ( (x(:,:,k).gt.S_att) .and. (x(:,:,k).ne. undef)  )
-           srok(:,:,k)=1.0
-         elsewhere
-           srok(:,:,k)=0.0
-         endwhere
-
-      enddo ! k
-
-
-! ---------------------------------------------------------------
-! 3- grid-box 3D cloud fraction and layered cloud fractions (ISCCP pressure
-! categories) :
-! ---------------------------------------------------------------
-      lidarcld = 0.0
-      nsub = 0.0
-#ifdef SYS_SX
-!! XXX: Use cldlay[1-3] and nsublay[1-3] to avoid bank-conflicts.
-      cldlay1 = 0.0
-      cldlay2 = 0.0
-      cldlay3 = 0.0
-      cldlay(:,:,4) = 0.0 !! XXX: Ncat == 4
-      nsublay1 = 0.0
-      nsublay2 = 0.0
-      nsublay3 = 0.0
-      nsublay(:,:,4) = 0.0
-
-      do k = Nlevels, 1, -1
-       do ic = 1, Ncolumns
-        do ip = 1, Npoints
-
-         if(srok(ip,ic,k).gt.0.)then
-           ! Computation of the cloud fraction as a function of the temperature
-           ! instead of height, for ice,liquid and all clouds
-           do itemp=1,Ntemp
-             if( (tmp(ip,k).ge.tempmod(itemp)).and.(tmp(ip,k).lt.tempmod(itemp+1)) )then
-               lidarcldtempind(ip,itemp)=lidarcldtempind(ip,itemp)+1.
-             endif
-           enddo
-         endif
-
-         if (cldy(ip,ic,k).eq.1.) then
-           do itemp=1,Ntemp
-             if( (tmp(ip,k).ge.tempmod(itemp)).and.(tmp(ip,k).lt.tempmod(itemp+1)) )then
-               lidarcldtemp(ip,itemp,1)=lidarcldtemp(ip,itemp,1)+1.
-             endif
-           enddo
-         endif
-
-         p1 = pplay(ip,k)
-
-         if ( p1.gt.0. .and. p1.lt.(440.*100.)) then ! high clouds
-            cldlay3(ip,ic) = MAX(cldlay3(ip,ic), cldy(ip,ic,k))
-            nsublay3(ip,ic) = MAX(nsublay3(ip,ic), srok(ip,ic,k))
-         else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then  ! mid clouds
-            cldlay2(ip,ic) = MAX(cldlay2(ip,ic), cldy(ip,ic,k))
-            nsublay2(ip,ic) = MAX(nsublay2(ip,ic), srok(ip,ic,k))
-         else
-            cldlay1(ip,ic) = MAX(cldlay1(ip,ic), cldy(ip,ic,k))
-            nsublay1(ip,ic) = MAX(nsublay1(ip,ic), srok(ip,ic,k))
-         endif
-
-         cldlay(ip,ic,4) = MAX(cldlay(ip,ic,4), cldy(ip,ic,k))
-         lidarcld(ip,k)=lidarcld(ip,k) + cldy(ip,ic,k)
-         nsublay(ip,ic,4) = MAX(nsublay(ip,ic,4),srok(ip,ic,k))
-         nsub(ip,k)=nsub(ip,k) + srok(ip,ic,k)
-        enddo
-       enddo
-      enddo
-      cldlay(:,:,1) = cldlay1
-      cldlay(:,:,2) = cldlay2
-      cldlay(:,:,3) = cldlay3
-      nsublay(:,:,1) = nsublay1
-      nsublay(:,:,2) = nsublay2
-      nsublay(:,:,3) = nsublay3
-#else
-      cldlay = 0.0
-      nsublay = 0.0
-      do k = Nlevels, 1, -1
-       do ic = 1, Ncolumns
-        do ip = 1, Npoints
-
-          ! Computation of the cloud fraction as a function of the temperature
-          ! instead of height, for ice,liquid and all clouds
-          if(srok(ip,ic,k).gt.0.)then
-          do itemp=1,Ntemp
-            if( (tmp(ip,k).ge.tempmod(itemp)).and.(tmp(ip,k).lt.tempmod(itemp+1)) )then
-              lidarcldtempind(ip,itemp)=lidarcldtempind(ip,itemp)+1.
-            endif
-          enddo
-          endif
-
-          if(cldy(ip,ic,k).eq.1.)then
-          do itemp=1,Ntemp
-            if( (tmp(ip,k).ge.tempmod(itemp)).and.(tmp(ip,k).lt.tempmod(itemp+1)) )then
-              lidarcldtemp(ip,itemp,1)=lidarcldtemp(ip,itemp,1)+1.
-            endif
-          enddo
-          endif
-!
-
-          iz=1
-          p1 = pplay(ip,k)
-          if ( p1.gt.0. .and. p1.lt.(440.*100.)) then ! high clouds
-            iz=3
-          else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then  ! mid clouds
-            iz=2
-         endif
-
-         cldlay(ip,ic,iz) = MAX(cldlay(ip,ic,iz),cldy(ip,ic,k))
-         cldlay(ip,ic,4) = MAX(cldlay(ip,ic,4),cldy(ip,ic,k))
-         lidarcld(ip,k)=lidarcld(ip,k) + cldy(ip,ic,k)
-
-         nsublay(ip,ic,iz) = MAX(nsublay(ip,ic,iz),srok(ip,ic,k))
-         nsublay(ip,ic,4) = MAX(nsublay(ip,ic,4),srok(ip,ic,k))
-         nsub(ip,k)=nsub(ip,k) + srok(ip,ic,k)
-
-        enddo
-       enddo
-      enddo
-#endif
-
-
-! -- grid-box 3D cloud fraction
-
-      where ( nsub(:,:).gt.0.0 )
-         lidarcld(:,:) = lidarcld(:,:)/nsub(:,:)
-      elsewhere
-         lidarcld(:,:) = undef
-      endwhere
-
-! -- layered cloud fractions
-
-      cldlayer = 0.0
-      nsublayer = 0.0
-
-      do iz = 1, Ncat
-       do ic = 1, Ncolumns
-
-          cldlayer(:,iz)=cldlayer(:,iz) + cldlay(:,ic,iz)
-          nsublayer(:,iz)=nsublayer(:,iz) + nsublay(:,ic,iz)
-
-       enddo
-      enddo
-      where ( nsublayer(:,:).gt.0.0 )
-         cldlayer(:,:) = cldlayer(:,:)/nsublayer(:,:)
-      elsewhere
-         cldlayer(:,:) = undef
-      endwhere
-
-! ---------------------------------------------------------------
-! 4- grid-box 3D cloud Phase :
-! ---------------------------------------------------------------
-! ---------------------------------------------------------------
-! 4.1 - For Cloudy pixels with 8.16km < z < 19.2km
-! ---------------------------------------------------------------
-do ncol=1,Ncolumns
-do i=1,Npoints
-
-      do nlev=Nlevels,18,-1  ! from 19.2km until 8.16km
-         p1 = pplay(i,nlev)
-
-
-! Avoid zero values
-	if( (cldy(i,ncol,nlev).eq.1.) .and. (ATBperp(i,ncol,nlev).gt.0.) )then
-! Computation of the ATBperp along the phase discrimination line
-           ATBperp_tmp = (ATB(i,ncol,nlev)**5)*alpha50 + (ATB(i,ncol,nlev)**4)*beta50 + &
-                         (ATB(i,ncol,nlev)**3)*gamma50 + (ATB(i,ncol,nlev)**2)*delta50 + &
-                          ATB(i,ncol,nlev)*epsilon50 + zeta50
-
-!____________________________________________________________________________________________________
-!
-!4.1.a Ice: ATBperp above the phase discrimination line
-!____________________________________________________________________________________________________
-!
-           if( (ATBperp(i,ncol,nlev)-ATBperp_tmp).ge.0. )then   ! Ice clouds
-             ! ICE with temperature above 273,15°K = Liquid (false ice)
-            if(tmp(i,nlev).gt.273.15)then                ! Temperature above 273,15 K
-              ! Liquid: False ice corrected by the temperature to Liquid
-               lidarcldphase(i,nlev,2)=lidarcldphase(i,nlev,2)+1.   ! false ice detection ==> added to Liquid
-               tmpl(i,ncol,nlev)=tmp(i,nlev)
-               lidarcldphase(i,nlev,5)=lidarcldphase(i,nlev,5)+1.   ! keep the information "temperature criterium used"
-                                                    ! to classify the phase cloud
-         	   cldlayphase(i,ncol,4,2) = 1.                         ! tot cloud
-                if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
-        	   cldlayphase(i,ncol,3,2) = 1.
-         	else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
-         	   cldlayphase(i,ncol,2,2) = 1.
-	 	else                                                    ! low cloud
-         	   cldlayphase(i,ncol,1,2) = 1.
-                endif
-         	   cldlayphase(i,ncol,4,5) = 1.                         ! tot cloud
-         	if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
-        	   cldlayphase(i,ncol,3,5) = 1.
-         	else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
-         	   cldlayphase(i,ncol,2,5) = 1.
-	 	else                                                    ! low cloud
-         	   cldlayphase(i,ncol,1,5) = 1.
-                endif
-
-             else
-             ! ICE with temperature below 273,15°K
-              lidarcldphase(i,nlev,1)=lidarcldphase(i,nlev,1)+1.
-              tmpi(i,ncol,nlev)=tmp(i,nlev)
-         	   cldlayphase(i,ncol,4,1) = 1.                         ! tot cloud
-         	if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
-        	   cldlayphase(i,ncol,3,1) = 1.
-         	else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
-         	   cldlayphase(i,ncol,2,1) = 1.
-	 	else                                                    ! low cloud
-         	   cldlayphase(i,ncol,1,1) = 1.
-                endif
-
-              endif
-
-!____________________________________________________________________________________________________
-!
-! 4.1.b Liquid: ATBperp below the phase discrimination line
-!____________________________________________________________________________________________________
-!
-             else                                        ! Liquid clouds
-              ! Liquid with temperature above 231,15°K
-            if(tmp(i,nlev).gt.231.15)then 
-               lidarcldphase(i,nlev,2)=lidarcldphase(i,nlev,2)+1.
-               tmpl(i,ncol,nlev)=tmp(i,nlev)
-         	   cldlayphase(i,ncol,4,2) = 1.                         ! tot cloud
-         	if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
-         	   cldlayphase(i,ncol,3,2) = 1.  
-         	else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
-         	   cldlayphase(i,ncol,2,2) = 1.
-	 	else                                                    ! low cloud
-         	   cldlayphase(i,ncol,1,2) = 1.
-	 	endif
-
-             else
-             ! Liquid with temperature below 231,15°K = Ice (false liquid)
-               tmpi(i,ncol,nlev)=tmp(i,nlev)
-               lidarcldphase(i,nlev,1)=lidarcldphase(i,nlev,1)+1.   ! false liquid detection ==> added to ice
-               lidarcldphase(i,nlev,4)=lidarcldphase(i,nlev,4)+1.   ! keep the information "temperature criterium used"
-                                                    ! to classify the phase cloud
-         	   cldlayphase(i,ncol,4,4) = 1.                         ! tot cloud
-         	if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
-         	   cldlayphase(i,ncol,3,4) = 1.  
-         	else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
-         	   cldlayphase(i,ncol,2,4) = 1.
-	 	else                                                    ! low cloud
-         	   cldlayphase(i,ncol,1,4) = 1.
-	 	endif
-         	   cldlayphase(i,ncol,4,1) = 1.                         ! tot cloud
-        	if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
-         	   cldlayphase(i,ncol,3,1) = 1.  
-         	else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
-         	   cldlayphase(i,ncol,2,1) = 1.
-	 	else                                                    ! low cloud
-         	   cldlayphase(i,ncol,1,1) = 1.
-	 	endif
-
-             endif
-
-            endif  ! end of discrimination condition 
-	 endif  ! end of cloud condition
-      enddo ! end of altitude loop
-
-
-
-! ---------------------------------------------------------------
-! 4.2 - For Cloudy pixels with 0km < z < 8.16km
-! ---------------------------------------------------------------
-
-      toplvlsat=0
-      do nlev=17,1,-1  ! from 8.16km until 0km
-         p1 = pplay(i,nlev)
-
-	if( (cldy(i,ncol,nlev).eq.1.) .and. (ATBperp(i,ncol,nlev).gt.0.) )then
-! Phase discrimination line : ATBperp = ATB^5*alpha50 + ATB^4*beta50 + ATB^3*gamma50 + ATB^2*delta50 
-!                                  + ATB*epsilon50 + zeta50
-! Computation of the ATBperp of the phase discrimination line
-           ATBperp_tmp = (ATB(i,ncol,nlev)**5)*alpha50 + (ATB(i,ncol,nlev)**4)*beta50 + &
-                         (ATB(i,ncol,nlev)**3)*gamma50 + (ATB(i,ncol,nlev)**2)*delta50 + &
-                          ATB(i,ncol,nlev)*epsilon50 + zeta50
-!____________________________________________________________________________________________________
-!
-! 4.2.a Ice: ATBperp above the phase discrimination line
-!____________________________________________________________________________________________________
-!
-            ! ICE with temperature above 273,15°K = Liquid (false ice)
-          if( (ATBperp(i,ncol,nlev)-ATBperp_tmp).ge.0. )then   ! Ice clouds
-            if(tmp(i,nlev).gt.273.15)then 
-               lidarcldphase(i,nlev,2)=lidarcldphase(i,nlev,2)+1.  ! false ice ==> liq
-               tmpl(i,ncol,nlev)=tmp(i,nlev)
-               lidarcldphase(i,nlev,5)=lidarcldphase(i,nlev,5)+1.
-
-         	   cldlayphase(i,ncol,4,2) = 1.                         ! tot cloud
-               if ( p1.gt.0. .and. p1.lt.(440.*100.)) then              ! high cloud
-        	   cldlayphase(i,ncol,3,2) = 1.
-         	else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
-         	   cldlayphase(i,ncol,2,2) = 1.
-	 	else                                                    ! low cloud
-         	   cldlayphase(i,ncol,1,2) = 1.
-                endif
-
-         	   cldlayphase(i,ncol,4,5) = 1.                         ! tot cloud
-         	if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
-        	   cldlayphase(i,ncol,3,5) = 1.
-         	else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
-         	   cldlayphase(i,ncol,2,5) = 1.
-	 	else                                                    ! low cloud
-         	   cldlayphase(i,ncol,1,5) = 1.
-                endif
-
-             else
-              ! ICE with temperature below 273,15°K
-              lidarcldphase(i,nlev,1)=lidarcldphase(i,nlev,1)+1.
-              tmpi(i,ncol,nlev)=tmp(i,nlev)
-
-          	   cldlayphase(i,ncol,4,1) = 1.                         ! tot cloud
-        	if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
-        	   cldlayphase(i,ncol,3,1) = 1.
-         	else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
-         	   cldlayphase(i,ncol,2,1) = 1.
-	 	else                                                    ! low cloud
-         	   cldlayphase(i,ncol,1,1) = 1.
-                endif
-
-              endif
-
-!____________________________________________________________________________________________________
-!
-! 4.2.b Liquid: ATBperp below the phase discrimination line
-!____________________________________________________________________________________________________
-!
-          else  
-             ! Liquid with temperature above 231,15°K
-            if(tmp(i,nlev).gt.231.15)then 
-               lidarcldphase(i,nlev,2)=lidarcldphase(i,nlev,2)+1.
-               tmpl(i,ncol,nlev)=tmp(i,nlev)
-
-         	   cldlayphase(i,ncol,4,2) = 1.                         ! tot cloud
-         	if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
-         	   cldlayphase(i,ncol,3,2) = 1.  
-         	else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
-         	   cldlayphase(i,ncol,2,2) = 1.
-	 	else                                                    ! low cloud
-         	   cldlayphase(i,ncol,1,2) = 1.
-	 	endif
-
-             else
-             ! Liquid with temperature below 231,15°K = Ice (false liquid)
-               tmpi(i,ncol,nlev)=tmp(i,nlev)
-               lidarcldphase(i,nlev,1)=lidarcldphase(i,nlev,1)+1.  ! false liq ==> ice
-               lidarcldphase(i,nlev,4)=lidarcldphase(i,nlev,4)+1.  ! false liq ==> ice
-
-         	   cldlayphase(i,ncol,4,4) = 1.                         ! tot cloud
-         	if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
-         	   cldlayphase(i,ncol,3,4) = 1.  
-         	else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
-         	   cldlayphase(i,ncol,2,4) = 1.
-	 	else                                                    ! low cloud
-         	   cldlayphase(i,ncol,1,4) = 1.
-	 	endif
-
-         	   cldlayphase(i,ncol,4,1) = 1.                         ! tot cloud
-        	if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
-         	   cldlayphase(i,ncol,3,1) = 1.  
-         	else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
-         	   cldlayphase(i,ncol,2,1) = 1.
-	 	else                                                    ! low cloud
-         	   cldlayphase(i,ncol,1,1) = 1.
-	 	endif
-
-             endif
-           endif  ! end of discrimination condition 
-
-       	    toplvlsat=0
-
-           ! Find the level of the highest cloud with SR>30
-	    if(x(i,ncol,nlev).gt.S_cld_att)then	 ! SR > 30.
-      		toplvlsat=nlev-1
-       		goto 99 
-    	    endif
-
-	endif  ! end of cloud condition
-       enddo  ! end of altitude loop
-
-99 continue
-
-!____________________________________________________________________________________________________
-!
-! Undefined phase: For a cloud located below another cloud with SR>30 
-! see Cesana and Chepfer 2013 Sect.III.2
-!____________________________________________________________________________________________________
-!
-if(toplvlsat.ne.0)then     	
-      do nlev=toplvlsat,1,-1
-         p1 = pplay(i,nlev)
-	if(cldy(i,ncol,nlev).eq.1.)then
-           lidarcldphase(i,nlev,3)=lidarcldphase(i,nlev,3)+1.
-           tmpu(i,ncol,nlev)=tmp(i,nlev)
-
-         	   cldlayphase(i,ncol,4,3) = 1.                         ! tot cloud
-          if ( p1.gt.0. .and. p1.lt.(440.*100.)) then              ! high cloud
-             cldlayphase(i,ncol,3,3) = 1.
-          else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then  ! mid cloud
-             cldlayphase(i,ncol,2,3) = 1.
-	  else                                                     ! low cloud
-             cldlayphase(i,ncol,1,3) = 1.
-	  endif
-
-        endif	
-      enddo
-endif
-     
-      toplvlsat=0
-
-enddo
-enddo
-
-
-
-!____________________________________________________________________________________________________
-!
-! Computation of final cloud phase diagnosis
-!____________________________________________________________________________________________________
-!
-
-! Compute the Ice percentage in cloud = ice/(ice+liq) as a function
-! of the occurrences
-lidarcldphasetmp(:,:)=lidarcldphase(:,:,1)+lidarcldphase(:,:,2);
-WHERE (lidarcldphasetmp(:,:).gt. 0.)
-   lidarcldphase(:,:,6)=lidarcldphase(:,:,1)/lidarcldphasetmp(:,:)
-ELSEWHERE
-   lidarcldphase(:,:,6) = undef
-ENDWHERE
-
-! Compute Phase 3D Cloud Fraction
-     WHERE ( nsub(:,:).gt.0.0 )
-       lidarcldphase(:,:,1)=lidarcldphase(:,:,1)/nsub(:,:)
-       lidarcldphase(:,:,2)=lidarcldphase(:,:,2)/nsub(:,:)
-       lidarcldphase(:,:,3)=lidarcldphase(:,:,3)/nsub(:,:)
-       lidarcldphase(:,:,4)=lidarcldphase(:,:,4)/nsub(:,:)
-       lidarcldphase(:,:,5)=lidarcldphase(:,:,5)/nsub(:,:)
-     ELSEWHERE
-       lidarcldphase(:,:,1) = undef
-       lidarcldphase(:,:,2) = undef
-       lidarcldphase(:,:,3) = undef
-       lidarcldphase(:,:,4) = undef
-       lidarcldphase(:,:,5) = undef
-     ENDWHERE
-
-
-! Compute Phase low mid high cloud fractions
-    do iz = 1, Ncat
-       do i=1,Nphase-3
-       do ic = 1, Ncolumns
-          cldlayerphase(:,iz,i)=cldlayerphase(:,iz,i) + cldlayphase(:,ic,iz,i)
-          cldlayerphasesum(:,iz)=cldlayerphasesum(:,iz)+cldlayphase(:,ic,iz,i)
-       enddo
-      enddo
-    enddo
-
-    do iz = 1, Ncat
-       do i=4,5
-       do ic = 1, Ncolumns
-          cldlayerphase(:,iz,i)=cldlayerphase(:,iz,i) + cldlayphase(:,ic,iz,i)          
-       enddo
-       enddo
-    enddo
-    
-! Compute the Ice percentage in cloud = ice/(ice+liq)
-cldlayerphasetmp(:,:)=cldlayerphase(:,:,1)+cldlayerphase(:,:,2)
-    WHERE (cldlayerphasetmp(:,:).gt. 0.)
-       cldlayerphase(:,:,6)=cldlayerphase(:,:,1)/cldlayerphasetmp(:,:)
-    ELSEWHERE
-       cldlayerphase(:,:,6) = undef
-    ENDWHERE
-
-    do i=1,Nphase-1
-      WHERE ( cldlayerphasesum(:,:).gt.0.0 )
-         cldlayerphase(:,:,i) = (cldlayerphase(:,:,i)/cldlayerphasesum(:,:)) * cldlayer(:,:) 
-      ENDWHERE
-    enddo
-
-
-    do i=1,Npoints
-       do iz=1,Ncat
-          checkcldlayerphase=0.
-          checkcldlayerphase2=0.
-
-          if (cldlayerphasesum(i,iz).gt.0.0 )then
-             do ic=1,Nphase-3
-                checkcldlayerphase=checkcldlayerphase+cldlayerphase(i,iz,ic)  
-             enddo
-             checkcldlayerphase2=cldlayer(i,iz)-checkcldlayerphase
-             if( (checkcldlayerphase2.gt.0.01).or.(checkcldlayerphase2.lt.-0.01) ) print *, checkcldlayerphase,cldlayer(i,iz)
-
-          endif
-
-       enddo
-    enddo
-
-    do i=1,Nphase-1
-      WHERE ( nsublayer(:,:).eq.0.0 )
-         cldlayerphase(:,:,i) = undef
-      ENDWHERE
-   enddo
-
-
-
-! Compute Phase 3D as a function of temperature
-do nlev=1,Nlevels
-do ncol=1,Ncolumns     
-do i=1,Npoints
-do itemp=1,Ntemp
-if(tmpi(i,ncol,nlev).gt.0.)then
-      if( (tmpi(i,ncol,nlev).ge.tempmod(itemp)).and.(tmpi(i,ncol,nlev).lt.tempmod(itemp+1)) )then
-        lidarcldtemp(i,itemp,2)=lidarcldtemp(i,itemp,2)+1.
-      endif
-elseif(tmpl(i,ncol,nlev).gt.0.)then
-      if( (tmpl(i,ncol,nlev).ge.tempmod(itemp)).and.(tmpl(i,ncol,nlev).lt.tempmod(itemp+1)) )then
-        lidarcldtemp(i,itemp,3)=lidarcldtemp(i,itemp,3)+1.
-      endif
-elseif(tmpu(i,ncol,nlev).gt.0.)then
-      if( (tmpu(i,ncol,nlev).ge.tempmod(itemp)).and.(tmpu(i,ncol,nlev).lt.tempmod(itemp+1)) )then
-        lidarcldtemp(i,itemp,4)=lidarcldtemp(i,itemp,4)+1.
-      endif
-endif
-enddo
-enddo
-enddo
-enddo
-
-! Check temperature cloud fraction
-do i=1,Npoints
-   do itemp=1,Ntemp
-checktemp=lidarcldtemp(i,itemp,2)+lidarcldtemp(i,itemp,3)+lidarcldtemp(i,itemp,4)
-
-	if(checktemp.NE.lidarcldtemp(i,itemp,1))then
-	  print *, i,itemp
-	  print *, lidarcldtemp(i,itemp,1:4)
-	endif
-
-   enddo
-enddo
-
-! Compute the Ice percentage in cloud = ice/(ice+liq)
-!   sumlidarcldtemp=sum(lidarcldtemp(:,:,2:3),3)
-   sumlidarcldtemp(:,:)=lidarcldtemp(:,:,2)+lidarcldtemp(:,:,3)
-
-WHERE(sumlidarcldtemp(:,:)>0.)
-  lidarcldtemp(:,:,5)=lidarcldtemp(:,:,2)/sumlidarcldtemp(:,:)
-ELSEWHERE
-  lidarcldtemp(:,:,5)=undef
-ENDWHERE
-
-do i=1,4
-  WHERE(lidarcldtempind(:,:).gt.0.)
-     lidarcldtemp(:,:,i) = lidarcldtemp(:,:,i)/lidarcldtempind(:,:)
-  ELSEWHERE
-     lidarcldtemp(:,:,i) = undef
-  ENDWHERE
-enddo
-
-       RETURN
-      END SUBROUTINE COSP_CLDFRAC
-! ---------------------------------------------------------------
-
-! BEGINNING OF OPAQ CHANGES
-    ! ####################################################################################
-    ! SUBROUTINE cosp_opaq
-    ! Conventions: Ntype must be equal to 3 (opaque cloud, thin cloud, z_opaque)
-    ! ####################################################################################
-    SUBROUTINE COSP_OPAQ(Npoints,Ncolumns,Nlevels,Ntype,x,S_cld,undef,lidarcldtype,   &
-                         cldtype,vgrid_z)
-
-      IMPLICIT NONE
-! Input arguments
-      integer Npoints,Ncolumns,Nlevels,Ntype
-      real x(Npoints,Ncolumns,Nlevels)
-      real S_cld
-      real undef
-      real vgrid_z(Nlevels)
-! Output :
-      real lidarcldtype(Npoints,Nlevels,Ntype+1) ! 3D "lidar" OPAQ type + opacity fraction
-      real cldtype(Npoints,Ntype)              ! opaque and thin cloud covers, z_opaque
-! Local variables
-      integer ip, k, iz, ic, zopac
-      real p1
-      real cldy(Npoints,Ncolumns,Nlevels)
-      real cldyopaq(Npoints,Ncolumns,Nlevels)
-      real srok(Npoints,Ncolumns,Nlevels)
-      real srokopaq(Npoints,Ncolumns,Nlevels)
-      real cldlay(Npoints,Ncolumns,Ntype+1)  ! opaque, thin, z_opaque and all cloud cover
-      real nsublay(Npoints,Ncolumns,Ntype+1) ! opaque, thin, z_opaque and all cloud cover
-      real nsublayer(Npoints,Ntype)
-      real nsub(Npoints,Nlevels)
-      real nsubopaq(Npoints,Nlevels)
-      real S_att_opaq
-      real S_att
-  
-    ! ####################################################################################
-	! 1) Initialize    
-    ! ####################################################################################
-    cldtype               = 0.0
-    lidarcldtype          = 0.0
-    nsub                  = 0.0
-    nsubopaq              = 0.0
-    cldlay                = 0.0
-    nsublay               = 0.0
-    nsublayer             = 0.0
-    S_att_opaq            = 0.06 ! Fully Attenuated threshold, from Guzman et al. 2017, JGR-A
-    S_att                 = 0.01 
-
-    ! ####################################################################################
-    ! 2) Cloud detection and Fully attenuated layer detection
-    ! ####################################################################################
-    do k=1,Nlevels
-       ! Cloud detection at subgrid-scale:
-       where ( (x(:,:,k) .gt. S_cld) .and. (x(:,:,k) .ne. undef) )
-          cldy(:,:,k)=1.0
-       elsewhere
-          cldy(:,:,k)=0.0
-       endwhere
-       ! Fully attenuated layer detection at subgrid-scale:
-       where ( (x(:,:,k) .gt. 0.0) .and. (x(:,:,k) .lt. S_att_opaq) .and. (x(:,:,k) .ne. undef) )
-          cldyopaq(:,:,k)=1.0
-       elsewhere
-          cldyopaq(:,:,k)=0.0
-       endwhere
-
-       ! Number of useful sub-column layers:
-       where ( (x(:,:,k) .gt. S_att) .and. (x(:,:,k) .ne. undef) )
-          srok(:,:,k)=1.0
-       elsewhere
-          srok(:,:,k)=0.0
-       endwhere
-       ! Number of useful sub-columns layers for z_opaque 3D fraction:
-       where ( (x(:,:,k) .gt. 0.0) .and. (x(:,:,k) .ne. undef) )
-          srokopaq(:,:,k)=1.0
-       elsewhere
-          srokopaq(:,:,k)=0.0
-       endwhere
-    enddo
-
-    ! ####################################################################################
-    ! 3) Grid-box 3D OPAQ product fraction and cloud type cover (opaque/thin) + mean z_opaque
-    ! ####################################################################################
-
-    do k= Nlevels,1,-1
-       do ic = 1, Ncolumns
-          do ip = 1, Npoints
-
-             cldlay(ip,ic,1)   = MAX(cldlay(ip,ic,1),cldyopaq(ip,ic,k)) ! Opaque clouds
-             cldlay(ip,ic,4)   = MAX(cldlay(ip,ic,4),cldy(ip,ic,k))     ! All clouds
-
-             nsublay(ip,ic,1)  = MAX(nsublay(ip,ic,1),srok(ip,ic,k))
-             nsublay(ip,ic,2)  = MAX(nsublay(ip,ic,2),srok(ip,ic,k))
-!             nsublay(ip,ic,4)  = MAX(nsublay(ip,ic,4),srok(ip,ic,k))
-             nsub(ip,k)        = nsub(ip,k) + srok(ip,ic,k)
-             nsubopaq(ip,k)    = nsubopaq(ip,k) + srokopaq(ip,ic,k)
-
-          enddo
-       enddo
-    enddo   
-
-! OPAQ variables
-     do ic = 1, Ncolumns
-        do ip = 1, Npoints
-
-     ! Declaring non-opaque cloudy profiles as thin cloud profiles
-	   if ( (cldlay(ip,ic,4) .eq. 1.0) .and. (cldlay(ip,ic,1) .eq. 0.0) ) then
-	      cldlay(ip,ic,2)  =  1.0
- 	   endif
-
-     ! Filling in 3D and 2D variables
-
-     ! Opaque cloud profiles
-	   if ( cldlay(ip,ic,1) .eq. 1.0 ) then
-	      zopac = 0.0
-	      do k=2,Nlevels
-     ! Declaring opaque cloud fraction and z_opaque altitude for 3D and 2D variables
-	         if ( (cldy(ip,ic,k) .eq. 1.0) .and. (zopac .eq. 0.0) ) then
-		    lidarcldtype(ip,k-1,3) = lidarcldtype(ip,k-1,3) + 1.0
-		    cldlay(ip,ic,3)        = vgrid_z(k-1) !z_opaque altitude
-		    nsublay(ip,ic,3)       = 1.0
-		    zopac = 1.0
-		 endif
-	         if ( cldy(ip,ic,k) .eq. 1.0 ) then
-		    lidarcldtype(ip,k,1)   = lidarcldtype(ip,k,1) + 1.0
-                 endif
-	      enddo
-	   endif
-
-     ! Thin cloud profiles
-	   if ( cldlay(ip,ic,2) .eq. 1.0 ) then
-	      do k=1,Nlevels
-     ! Declaring thin cloud fraction for 3D variable
-                 if ( cldy(ip,ic,k) .eq. 1.0 ) then
-                    lidarcldtype(ip,k,2) = lidarcldtype(ip,k,2) + 1.0
-                 endif
-	      enddo
-           endif
-
-       enddo
-    enddo   
-
-    ! 3D cloud types fraction (opaque=1 and thin=2)
-    where ( nsub(:,:) .gt. 0.0 )
-       lidarcldtype(:,:,1) = lidarcldtype(:,:,1)/nsub(:,:)
-       lidarcldtype(:,:,2) = lidarcldtype(:,:,2)/nsub(:,:)
-    elsewhere
-       lidarcldtype(:,:,1) = undef
-       lidarcldtype(:,:,2) = undef
-    endwhere
-    ! 3D z_opaque fraction (=3)
-    where ( nsubopaq(:,:) .gt. 0.0 )
-       lidarcldtype(:,:,3) = lidarcldtype(:,:,3)/nsubopaq(:,:)
-    elsewhere
-       lidarcldtype(:,:,3) = undef
-    endwhere
-    ! 3D opacity fraction (=4) !Summing z_opaque fraction from TOA(k=Nlevels) to SFC(k=1)
-       lidarcldtype(:,Nlevels,4) = lidarcldtype(:,Nlevels,3)
-    do ip = 1, Npoints
-     	do k = Nlevels-1, 1, -1
-           if ( lidarcldtype(ip,k,3) .ne. undef ) then
-	      lidarcldtype(ip,k,4) = lidarcldtype(ip,k+1,4) + lidarcldtype(ip,k,3)
-           endif
-	enddo
-    enddo
-    where ( nsubopaq(:,:) .eq. 0.0 )
-       lidarcldtype(:,:,4) = undef
-    endwhere
-
-    ! Layered cloud types (opaque, thin and z_opaque 2D variables)
-
-    do iz = 1, Ntype
-       do ic = 1, Ncolumns
-          cldtype(:,iz)   = cldtype(:,iz)   + cldlay(:,ic,iz)
-          nsublayer(:,iz) = nsublayer(:,iz) + nsublay(:,ic,iz)
-       enddo
-    enddo
-    where (nsublayer(:,:) .gt. 0.0)
-       cldtype(:,:) = cldtype(:,:)/nsublayer(:,:)
-    elsewhere
-       cldtype(:,:) = undef
-    endwhere
-
-  END SUBROUTINE COSP_OPAQ
-! END OF OPAQ CHANGES
-
-
-END MODULE MOD_LMD_IPSL_STATS
Index: LMDZ6/trunk/libf/phylmd/cosp/m_mrgrnk.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/cosp/m_mrgrnk.F90	(revision 3233)
+++ LMDZ6/trunk/libf/phylmd/cosp/m_mrgrnk.F90	(revision 3233)
@@ -0,0 +1,410 @@
+Module m_mrgrnk
+Integer, Parameter :: kdp = selected_real_kind(15)
+public :: mrgrnk
+private :: kdp
+private :: I_mrgrnk, D_mrgrnk
+interface mrgrnk
+  module procedure D_mrgrnk, I_mrgrnk
+end interface mrgrnk
+contains
+
+Subroutine D_mrgrnk (XDONT, IRNGT)
+! __________________________________________________________
+!   MRGRNK = Merge-sort ranking of an array
+!   For performance reasons, the first 2 passes are taken
+!   out of the standard loop, and use dedicated coding.
+! __________________________________________________________
+! __________________________________________________________
+      Real (kind=kdp), Dimension (:), Intent (In) :: XDONT
+      Integer, Dimension (:), Intent (Out) :: IRNGT
+! __________________________________________________________
+      Real (kind=kdp) :: XVALA, XVALB
+!
+      Integer, Dimension (SIZE(IRNGT)) :: JWRKT
+      Integer :: LMTNA, LMTNC, IRNG1, IRNG2
+      Integer :: NVAL, IIND, IWRKD, IWRK, IWRKF, JINDA, IINDA, IINDB
+!
+      NVAL = Min (SIZE(XDONT), SIZE(IRNGT))
+      Select Case (NVAL)
+      Case (:0)
+         Return
+      Case (1)
+         IRNGT (1) = 1
+         Return
+      Case Default
+         Continue
+      End Select
+!
+!  Fill-in the index array, creating ordered couples
+!
+      Do IIND = 2, NVAL, 2
+         If (XDONT(IIND-1) <= XDONT(IIND)) Then
+            IRNGT (IIND-1) = IIND - 1
+            IRNGT (IIND) = IIND
+         Else
+            IRNGT (IIND-1) = IIND
+            IRNGT (IIND) = IIND - 1
+         End If
+      End Do
+      If (Modulo(NVAL, 2) /= 0) Then
+         IRNGT (NVAL) = NVAL
+      End If
+!
+!  We will now have ordered subsets A - B - A - B - ...
+!  and merge A and B couples into     C   -   C   - ...
+!
+      LMTNA = 2
+      LMTNC = 4
+!
+!  First iteration. The length of the ordered subsets goes from 2 to 4
+!
+      Do
+         If (NVAL <= 2) Exit
+!
+!   Loop on merges of A and B into C
+!
+         Do IWRKD = 0, NVAL - 1, 4
+            If ((IWRKD+4) > NVAL) Then
+               If ((IWRKD+2) >= NVAL) Exit
+!
+!   1 2 3
+!
+               If (XDONT(IRNGT(IWRKD+2)) <= XDONT(IRNGT(IWRKD+3))) Exit
+!
+!   1 3 2
+!
+               If (XDONT(IRNGT(IWRKD+1)) <= XDONT(IRNGT(IWRKD+3))) Then
+                  IRNG2 = IRNGT (IWRKD+2)
+                  IRNGT (IWRKD+2) = IRNGT (IWRKD+3)
+                  IRNGT (IWRKD+3) = IRNG2
+!
+!   3 1 2
+!
+               Else
+                  IRNG1 = IRNGT (IWRKD+1)
+                  IRNGT (IWRKD+1) = IRNGT (IWRKD+3)
+                  IRNGT (IWRKD+3) = IRNGT (IWRKD+2)
+                  IRNGT (IWRKD+2) = IRNG1
+               End If
+               Exit
+            End If
+!
+!   1 2 3 4
+!
+            If (XDONT(IRNGT(IWRKD+2)) <= XDONT(IRNGT(IWRKD+3))) Cycle
+!
+!   1 3 x x
+!
+            If (XDONT(IRNGT(IWRKD+1)) <= XDONT(IRNGT(IWRKD+3))) Then
+               IRNG2 = IRNGT (IWRKD+2)
+               IRNGT (IWRKD+2) = IRNGT (IWRKD+3)
+               If (XDONT(IRNG2) <= XDONT(IRNGT(IWRKD+4))) Then
+!   1 3 2 4
+                  IRNGT (IWRKD+3) = IRNG2
+               Else
+!   1 3 4 2
+                  IRNGT (IWRKD+3) = IRNGT (IWRKD+4)
+                  IRNGT (IWRKD+4) = IRNG2
+               End If
+!
+!   3 x x x
+!
+            Else
+               IRNG1 = IRNGT (IWRKD+1)
+               IRNG2 = IRNGT (IWRKD+2)
+               IRNGT (IWRKD+1) = IRNGT (IWRKD+3)
+               If (XDONT(IRNG1) <= XDONT(IRNGT(IWRKD+4))) Then
+                  IRNGT (IWRKD+2) = IRNG1
+                  If (XDONT(IRNG2) <= XDONT(IRNGT(IWRKD+4))) Then
+!   3 1 2 4
+                     IRNGT (IWRKD+3) = IRNG2
+                  Else
+!   3 1 4 2
+                     IRNGT (IWRKD+3) = IRNGT (IWRKD+4)
+                     IRNGT (IWRKD+4) = IRNG2
+                  End If
+               Else
+!   3 4 1 2
+                  IRNGT (IWRKD+2) = IRNGT (IWRKD+4)
+                  IRNGT (IWRKD+3) = IRNG1
+                  IRNGT (IWRKD+4) = IRNG2
+               End If
+            End If
+         End Do
+!
+!  The Cs become As and Bs
+!
+         LMTNA = 4
+         Exit
+      End Do
+!
+!  Iteration loop. Each time, the length of the ordered subsets
+!  is doubled.
+!
+      Do
+         If (LMTNA >= NVAL) Exit
+         IWRKF = 0
+         LMTNC = 2 * LMTNC
+!
+!   Loop on merges of A and B into C
+!
+         Do
+            IWRK = IWRKF
+            IWRKD = IWRKF + 1
+            JINDA = IWRKF + LMTNA
+            IWRKF = IWRKF + LMTNC
+            If (IWRKF >= NVAL) Then
+               If (JINDA >= NVAL) Exit
+               IWRKF = NVAL
+            End If
+            IINDA = 1
+            IINDB = JINDA + 1
+!
+!   Shortcut for the case when the max of A is smaller
+!   than the min of B. This line may be activated when the
+!   initial set is already close to sorted.
+!
+!          IF (XDONT(IRNGT(JINDA)) <= XDONT(IRNGT(IINDB))) CYCLE
+!
+!  One steps in the C subset, that we build in the final rank array
+!
+!  Make a copy of the rank array for the merge iteration
+!
+            JWRKT (1:LMTNA) = IRNGT (IWRKD:JINDA)
+!
+            XVALA = XDONT (JWRKT(IINDA))
+            XVALB = XDONT (IRNGT(IINDB))
+!
+            Do
+               IWRK = IWRK + 1
+!
+!  We still have unprocessed values in both A and B
+!
+               If (XVALA > XVALB) Then
+                  IRNGT (IWRK) = IRNGT (IINDB)
+                  IINDB = IINDB + 1
+                  If (IINDB > IWRKF) Then
+!  Only A still with unprocessed values
+                     IRNGT (IWRK+1:IWRKF) = JWRKT (IINDA:LMTNA)
+                     Exit
+                  End If
+                  XVALB = XDONT (IRNGT(IINDB))
+               Else
+                  IRNGT (IWRK) = JWRKT (IINDA)
+                  IINDA = IINDA + 1
+                  If (IINDA > LMTNA) Exit! Only B still with unprocessed values
+                  XVALA = XDONT (JWRKT(IINDA))
+               End If
+!
+            End Do
+         End Do
+!
+!  The Cs become As and Bs
+!
+         LMTNA = 2 * LMTNA
+      End Do
+!
+      Return
+!
+End Subroutine D_mrgrnk
+
+Subroutine I_mrgrnk (XDONT, IRNGT)
+! __________________________________________________________
+!   MRGRNK = Merge-sort ranking of an array
+!   For performance reasons, the first 2 passes are taken
+!   out of the standard loop, and use dedicated coding.
+! __________________________________________________________
+! __________________________________________________________
+      Integer, Dimension (:), Intent (In)  :: XDONT
+      Integer, Dimension (:), Intent (Out) :: IRNGT
+! __________________________________________________________
+      Integer :: XVALA, XVALB
+!
+      Integer, Dimension (SIZE(IRNGT)) :: JWRKT
+      Integer :: LMTNA, LMTNC, IRNG1, IRNG2
+      Integer :: NVAL, IIND, IWRKD, IWRK, IWRKF, JINDA, IINDA, IINDB
+!
+      NVAL = Min (SIZE(XDONT), SIZE(IRNGT))
+      Select Case (NVAL)
+      Case (:0)
+         Return
+      Case (1)
+         IRNGT (1) = 1
+         Return
+      Case Default
+         Continue
+      End Select
+!
+!  Fill-in the index array, creating ordered couples
+!
+      Do IIND = 2, NVAL, 2
+         If (XDONT(IIND-1) <= XDONT(IIND)) Then
+            IRNGT (IIND-1) = IIND - 1
+            IRNGT (IIND) = IIND
+         Else
+            IRNGT (IIND-1) = IIND
+            IRNGT (IIND) = IIND - 1
+         End If
+      End Do
+      If (Modulo(NVAL, 2) /= 0) Then
+         IRNGT (NVAL) = NVAL
+      End If
+!
+!  We will now have ordered subsets A - B - A - B - ...
+!  and merge A and B couples into     C   -   C   - ...
+!
+      LMTNA = 2
+      LMTNC = 4
+!
+!  First iteration. The length of the ordered subsets goes from 2 to 4
+!
+      Do
+         If (NVAL <= 2) Exit
+!
+!   Loop on merges of A and B into C
+!
+         Do IWRKD = 0, NVAL - 1, 4
+            If ((IWRKD+4) > NVAL) Then
+               If ((IWRKD+2) >= NVAL) Exit
+!
+!   1 2 3
+!
+               If (XDONT(IRNGT(IWRKD+2)) <= XDONT(IRNGT(IWRKD+3))) Exit
+!
+!   1 3 2
+!
+               If (XDONT(IRNGT(IWRKD+1)) <= XDONT(IRNGT(IWRKD+3))) Then
+                  IRNG2 = IRNGT (IWRKD+2)
+                  IRNGT (IWRKD+2) = IRNGT (IWRKD+3)
+                  IRNGT (IWRKD+3) = IRNG2
+!
+!   3 1 2
+!
+               Else
+                  IRNG1 = IRNGT (IWRKD+1)
+                  IRNGT (IWRKD+1) = IRNGT (IWRKD+3)
+                  IRNGT (IWRKD+3) = IRNGT (IWRKD+2)
+                  IRNGT (IWRKD+2) = IRNG1
+               End If
+               Exit
+            End If
+!
+!   1 2 3 4
+!
+            If (XDONT(IRNGT(IWRKD+2)) <= XDONT(IRNGT(IWRKD+3))) Cycle
+!
+!   1 3 x x
+!
+            If (XDONT(IRNGT(IWRKD+1)) <= XDONT(IRNGT(IWRKD+3))) Then
+               IRNG2 = IRNGT (IWRKD+2)
+               IRNGT (IWRKD+2) = IRNGT (IWRKD+3)
+               If (XDONT(IRNG2) <= XDONT(IRNGT(IWRKD+4))) Then
+!   1 3 2 4
+                  IRNGT (IWRKD+3) = IRNG2
+               Else
+!   1 3 4 2
+                  IRNGT (IWRKD+3) = IRNGT (IWRKD+4)
+                  IRNGT (IWRKD+4) = IRNG2
+               End If
+!
+!   3 x x x
+!
+            Else
+               IRNG1 = IRNGT (IWRKD+1)
+               IRNG2 = IRNGT (IWRKD+2)
+               IRNGT (IWRKD+1) = IRNGT (IWRKD+3)
+               If (XDONT(IRNG1) <= XDONT(IRNGT(IWRKD+4))) Then
+                  IRNGT (IWRKD+2) = IRNG1
+                  If (XDONT(IRNG2) <= XDONT(IRNGT(IWRKD+4))) Then
+!   3 1 2 4
+                     IRNGT (IWRKD+3) = IRNG2
+                  Else
+!   3 1 4 2
+                     IRNGT (IWRKD+3) = IRNGT (IWRKD+4)
+                     IRNGT (IWRKD+4) = IRNG2
+                  End If
+               Else
+!   3 4 1 2
+                  IRNGT (IWRKD+2) = IRNGT (IWRKD+4)
+                  IRNGT (IWRKD+3) = IRNG1
+                  IRNGT (IWRKD+4) = IRNG2
+               End If
+            End If
+         End Do
+!
+!  The Cs become As and Bs
+!
+         LMTNA = 4
+         Exit
+      End Do
+!
+!  Iteration loop. Each time, the length of the ordered subsets
+!  is doubled.
+!
+      Do
+         If (LMTNA >= NVAL) Exit
+         IWRKF = 0
+         LMTNC = 2 * LMTNC
+!
+!   Loop on merges of A and B into C
+!
+         Do
+            IWRK = IWRKF
+            IWRKD = IWRKF + 1
+            JINDA = IWRKF + LMTNA
+            IWRKF = IWRKF + LMTNC
+            If (IWRKF >= NVAL) Then
+               If (JINDA >= NVAL) Exit
+               IWRKF = NVAL
+            End If
+            IINDA = 1
+            IINDB = JINDA + 1
+!
+!   Shortcut for the case when the max of A is smaller
+!   than the min of B. This line may be activated when the
+!   initial set is already close to sorted.
+!
+!          IF (XDONT(IRNGT(JINDA)) <= XDONT(IRNGT(IINDB))) CYCLE
+!
+!  One steps in the C subset, that we build in the final rank array
+!
+!  Make a copy of the rank array for the merge iteration
+!
+            JWRKT (1:LMTNA) = IRNGT (IWRKD:JINDA)
+!
+            XVALA = XDONT (JWRKT(IINDA))
+            XVALB = XDONT (IRNGT(IINDB))
+!
+            Do
+               IWRK = IWRK + 1
+!
+!  We still have unprocessed values in both A and B
+!
+               If (XVALA > XVALB) Then
+                  IRNGT (IWRK) = IRNGT (IINDB)
+                  IINDB = IINDB + 1
+                  If (IINDB > IWRKF) Then
+!  Only A still with unprocessed values
+                     IRNGT (IWRK+1:IWRKF) = JWRKT (IINDA:LMTNA)
+                     Exit
+                  End If
+                  XVALB = XDONT (IRNGT(IINDB))
+               Else
+                  IRNGT (IWRK) = JWRKT (IINDA)
+                  IINDA = IINDA + 1
+                  If (IINDA > LMTNA) Exit! Only B still with unprocessed values
+                  XVALA = XDONT (JWRKT(IINDA))
+               End If
+!
+            End Do
+         End Do
+!
+!  The Cs become As and Bs
+!
+         LMTNA = 2 * LMTNA
+      End Do
+!
+      Return
+!
+End Subroutine I_mrgrnk
+end module m_mrgrnk
Index: LMDZ6/trunk/libf/phylmd/cosp/mod_cosp.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/cosp/mod_cosp.F90	(revision 3233)
+++ LMDZ6/trunk/libf/phylmd/cosp/mod_cosp.F90	(revision 3233)
@@ -0,0 +1,605 @@
+! (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.
+
+#include "cosp_defs.h"
+MODULE MOD_COSP
+  USE MOD_COSP_TYPES
+  USE MOD_COSP_SIMULATOR
+  USE MOD_COSP_MODIS_SIMULATOR
+  IMPLICIT NONE
+
+CONTAINS
+
+
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!--------------------- SUBROUTINE COSP ---------------------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!#ifdef RTTOV
+!SUBROUTINE COSP(overlap,Ncolumns,cfg,vgrid,gbx,sgx,sgradar,sglidar,isccp,misr,modis,rttov,stradar,stlidar)
+!#else
+SUBROUTINE COSP(overlap,Ncolumns,cfg,vgrid,gbx,sgx,sgradar,sglidar,isccp,misr,modis,stradar,stlidar)
+!#endif
+  ! Arguments
+  integer,intent(in) :: overlap !  overlap type in SCOPS: 1=max, 2=rand, 3=max/rand
+  integer,intent(in) :: Ncolumns
+  type(cosp_config),intent(in) :: cfg   ! Configuration options
+  type(cosp_vgrid),intent(in) :: vgrid   ! Information on vertical grid of stats
+  type(cosp_gridbox),intent(inout) :: gbx
+  type(cosp_subgrid),intent(inout) :: sgx   ! Subgrid info
+  type(cosp_sgradar),intent(inout) :: sgradar ! Output from radar simulator
+  type(cosp_sglidar),intent(inout) :: sglidar ! Output from lidar simulator
+  type(cosp_isccp),intent(inout)   :: isccp   ! Output from ISCCP simulator
+  type(cosp_misr),intent(inout)    :: misr    ! Output from MISR simulator
+  type(cosp_modis),intent(inout)   :: modis   ! Output from MODIS simulator
+!#ifdef RTTOV
+!  type(cosp_rttov),intent(inout)   :: rttov   ! Output from RTTOV
+!#endif
+  type(cosp_radarstats),intent(inout) :: stradar ! Summary statistics from radar simulator
+  type(cosp_lidarstats),intent(inout) :: stlidar ! Summary statistics from lidar simulator
+
+  ! Local variables 
+  integer :: Npoints   ! Number of gridpoints
+  integer :: Nlevels   ! Number of levels
+  integer :: Nhydro    ! Number of hydrometeors
+  integer :: Niter     ! Number of calls to cosp_simulator
+  integer :: i_first,i_last ! First and last gridbox to be processed in each iteration
+  integer :: i,Ni
+  integer,dimension(2) :: ix,iy
+  logical :: reff_zero
+  real :: maxp,minp
+  integer,dimension(:),allocatable :: & ! Dimensions nPoints
+                  seed    !  It is recommended that the seed is set to a different value for each model
+                          !  gridbox it is called on, as it is possible that the choice of the same 
+                          !  seed value every time may introduce some statistical bias in the results, 
+                          !  particularly for low values of NCOL.
+  ! Types used in one iteration
+  type(cosp_gridbox) :: gbx_it
+  type(cosp_subgrid) :: sgx_it
+  type(cosp_vgrid)   :: vgrid_it
+  type(cosp_sgradar) :: sgradar_it
+  type(cosp_sglidar) :: sglidar_it
+  type(cosp_isccp)   :: isccp_it
+  type(cosp_modis)   :: modis_it
+  type(cosp_misr)    :: misr_it
+!#ifdef RTTOV
+!  type(cosp_rttov)   :: rttov_it
+!#endif
+  type(cosp_radarstats) :: stradar_it
+  type(cosp_lidarstats) :: stlidar_it
+
+!++++++++++ Dimensions ++++++++++++
+  Npoints  = gbx%Npoints
+  Nlevels  = gbx%Nlevels
+  Nhydro   = gbx%Nhydro
+
+!++++++++++ Depth of model layers ++++++++++++
+  do i=1,Nlevels-1
+    gbx%dlev(:,i) = gbx%zlev_half(:,i+1) - gbx%zlev_half(:,i)
+  enddo
+  gbx%dlev(:,Nlevels) = 2.0*(gbx%zlev(:,Nlevels) - gbx%zlev_half(:,Nlevels))
+
+!++++++++++ Apply sanity checks to inputs ++++++++++
+!  call cosp_check_input('longitude',gbx%longitude,min_val=0.0,max_val=360.0)
+  call cosp_check_input('longitude',gbx%longitude,min_val=-180.0,max_val=180.0)
+  call cosp_check_input('latitude',gbx%latitude,min_val=-90.0,max_val=90.0)
+  call cosp_check_input('dlev',gbx%dlev,min_val=0.0)
+  call cosp_check_input('p',gbx%p,min_val=0.0)
+  call cosp_check_input('ph',gbx%ph,min_val=0.0)
+  call cosp_check_input('T',gbx%T,min_val=0.0)
+  call cosp_check_input('q',gbx%q,min_val=0.0)
+  call cosp_check_input('sh',gbx%sh,min_val=0.0)
+  call cosp_check_input('dtau_s',gbx%dtau_s,min_val=0.0)
+  call cosp_check_input('dtau_c',gbx%dtau_c,min_val=0.0)
+  call cosp_check_input('dem_s',gbx%dem_s,min_val=0.0,max_val=1.0)
+  call cosp_check_input('dem_c',gbx%dem_c,min_val=0.0,max_val=1.0)
+  ! Point information (Npoints)
+  call cosp_check_input('land',gbx%land,min_val=0.0,max_val=1.0)
+  call cosp_check_input('psfc',gbx%psfc,min_val=0.0)
+  call cosp_check_input('sunlit',gbx%sunlit,min_val=0.0,max_val=1.0)
+  call cosp_check_input('skt',gbx%skt,min_val=0.0)
+  ! TOTAL and CONV cloud fraction for SCOPS
+  call cosp_check_input('tca',gbx%tca,min_val=0.0,max_val=1.0)
+  call cosp_check_input('cca',gbx%cca,min_val=0.0,max_val=1.0)
+  ! Precipitation fluxes on model levels
+  call cosp_check_input('rain_ls',gbx%rain_ls,min_val=0.0)
+  call cosp_check_input('rain_cv',gbx%rain_cv,min_val=0.0)
+  call cosp_check_input('snow_ls',gbx%snow_ls,min_val=0.0)
+  call cosp_check_input('snow_cv',gbx%snow_cv,min_val=0.0)
+  call cosp_check_input('grpl_ls',gbx%grpl_ls,min_val=0.0)
+  ! Hydrometeors concentration and distribution parameters
+  call cosp_check_input('mr_hydro',gbx%mr_hydro,min_val=0.0)
+  ! Effective radius [m]. (Npoints,Nlevels,Nhydro)
+  call cosp_check_input('Reff',gbx%Reff,min_val=0.0)
+  reff_zero=.true.
+  if (any(gbx%Reff > 1.e-8)) then
+     reff_zero=.false.
+      ! reff_zero == .false.
+      !     and gbx%use_reff == .true.   Reff use in radar and lidar
+      !     and reff_zero    == .false.  Reff use in lidar and set to 0 for radar
+  endif
+  if ((.not. gbx%use_reff) .and. (reff_zero)) then ! No Reff in radar. Default in lidar
+        gbx%Reff = DEFAULT_LIDAR_REFF
+        print *, '---------- COSP WARNING ------------'
+        print *, ''
+        print *, 'Using default Reff in lidar simulations'
+        print *, ''
+        print *, '----------------------------------'
+  endif
+  
+  ! Aerosols concentration and distribution parameters
+  call cosp_check_input('conc_aero',gbx%conc_aero,min_val=0.0)
+  ! Checks for CRM mode
+  if (Ncolumns == 1) then
+     if (gbx%use_precipitation_fluxes) then
+        print *, '---------- COSP ERROR ------------'
+        print *, ''
+        print *, 'Use of precipitation fluxes not supported in CRM mode (Ncolumns=1)'
+        print *, ''
+        print *, '----------------------------------'
+        stop
+     endif
+     if ((maxval(gbx%dtau_c) > 0.0).or.(maxval(gbx%dem_c) > 0.0)) then
+        print *, '---------- COSP ERROR ------------'
+        print *, ''
+        print *, ' dtau_c > 0.0 or dem_c > 0.0. In CRM mode (Ncolumns=1), '
+        print *, ' the optical depth (emmisivity) of all clouds must be '
+        print *, ' passed through dtau_s (dem_s)'
+        print *, ''
+        print *, '----------------------------------'
+        stop
+     endif
+  endif
+
+   ! We base the seed in the decimal part of the surface pressure.
+   allocate(seed(Npoints))
+   seed = int(gbx%psfc) ! This is to avoid division by zero when Npoints = 1   
+      ! Roj Oct/2008 ... Note: seed value of 0 caused me some problems + I want to 
+      ! randomize for each call to COSP even when Npoints ==1
+   minp = minval(gbx%psfc)
+   maxp = maxval(gbx%psfc)
+   if (Npoints .gt. 1) seed=int((gbx%psfc-minp)/(maxp-minp)*100000) + 1
+   ! Below it's how it was done in the original implementation of the ISCCP simulator. 
+   ! The one above is better for offline data, when you may have packed data 
+   ! that subsamples the decimal fraction of the surface pressure. 
+!    if (Npoints .gt. 1) seed=(gbx%psfc-int(gbx%psfc))*1000000 
+
+  
+   if (gbx%Npoints_it >= gbx%Npoints) then ! One iteration gbx%Npoints
+!#ifdef RTTOV
+!        call cosp_iter(overlap,seed,cfg,vgrid,gbx,sgx,sgradar,sglidar,isccp,misr,modis,rttov,stradar,stlidar)
+!#else
+        call cosp_iter(overlap,seed,cfg,vgrid,gbx,sgx,sgradar,sglidar,isccp,misr,modis,stradar,stlidar)
+!#endif
+   else ! Several iterations to save memory
+        Niter = gbx%Npoints/gbx%Npoints_it ! Integer division
+        if (Niter*gbx%Npoints_it < gbx%Npoints) Niter = Niter + 1
+        do i=1,Niter
+            i_first = (i-1)*gbx%Npoints_it + 1
+            i_last  = i_first + gbx%Npoints_it - 1
+            i_last  = min(i_last,gbx%Npoints)
+            Ni = i_last - i_first + 1
+            if (i == 1) then
+                ! Allocate types for all but last iteration
+                call construct_cosp_gridbox(gbx%time,gbx%time_bnds,gbx%radar_freq,gbx%surface_radar,gbx%use_mie_tables, &
+                                            gbx%use_gas_abs,gbx%do_ray,gbx%melt_lay,gbx%k2,Ni,Nlevels, &
+                                            Ncolumns,N_HYDRO,gbx%Nprmts_max_hydro, &
+                                            gbx%Naero,gbx%Nprmts_max_aero,Ni,gbx%lidar_ice_type,gbx%isccp_top_height, &
+                                            gbx%isccp_top_height_direction,gbx%isccp_overlap,gbx%isccp_emsfc_lw, &
+                                            gbx%use_precipitation_fluxes,gbx%use_reff, &
+                                            gbx%plat,gbx%sat,gbx%inst,gbx%nchan,gbx%ZenAng, &
+                                            gbx%Ichan(1:gbx%nchan),gbx%surfem(1:gbx%nchan), &
+                                            gbx%co2,gbx%ch4,gbx%n2o,gbx%co, &
+                                            gbx_it)
+                call construct_cosp_vgrid(gbx_it,vgrid%Nlvgrid,vgrid%use_vgrid,vgrid%csat_vgrid,vgrid_it)
+                call construct_cosp_subgrid(Ni, Ncolumns, Nlevels, sgx_it)
+                call construct_cosp_sgradar(cfg,Ni,Ncolumns,Nlevels,N_HYDRO,sgradar_it)
+                call construct_cosp_sglidar(cfg,Ni,Ncolumns,Nlevels,N_HYDRO,PARASOL_NREFL,sglidar_it)
+                call construct_cosp_isccp(cfg,Ni,Ncolumns,Nlevels,isccp_it)
+                call construct_cosp_modis(cfg, Ni, modis_it)
+                call construct_cosp_misr(cfg,Ni,misr_it)
+!#ifdef RTTOV
+!                call construct_cosp_rttov(Ni,gbx%nchan,rttov_it)
+!#endif
+                call construct_cosp_radarstats(cfg,Ni,Ncolumns,vgrid%Nlvgrid,N_HYDRO,stradar_it)
+                call construct_cosp_lidarstats(cfg,Ni,Ncolumns,vgrid%Nlvgrid,N_HYDRO,PARASOL_NREFL,stlidar_it)
+            elseif (i == Niter) then ! last iteration
+                call free_cosp_gridbox(gbx_it,.true.)
+                call free_cosp_subgrid(sgx_it)
+                call free_cosp_vgrid(vgrid_it)
+                call free_cosp_sgradar(sgradar_it)
+                call free_cosp_sglidar(sglidar_it)
+                call free_cosp_isccp(isccp_it)
+                call free_cosp_modis(modis_it)
+                call free_cosp_misr(misr_it)
+!#ifdef RTTOV
+!                call free_cosp_rttov(rttov_it)
+!#endif
+                call free_cosp_radarstats(stradar_it)
+                call free_cosp_lidarstats(stlidar_it)
+                ! Allocate types for iterations
+                call construct_cosp_gridbox(gbx%time,gbx%time_bnds,gbx%radar_freq,gbx%surface_radar,gbx%use_mie_tables, &
+                                            gbx%use_gas_abs,gbx%do_ray,gbx%melt_lay,gbx%k2,Ni,Nlevels, &
+                                            Ncolumns,N_HYDRO,gbx%Nprmts_max_hydro, &
+                                            gbx%Naero,gbx%Nprmts_max_aero,Ni,gbx%lidar_ice_type,gbx%isccp_top_height, &
+                                            gbx%isccp_top_height_direction,gbx%isccp_overlap,gbx%isccp_emsfc_lw, &
+                                            gbx%use_precipitation_fluxes,gbx%use_reff, &
+                                            gbx%plat,gbx%sat,gbx%inst,gbx%nchan,gbx%ZenAng, &
+                                            gbx%Ichan(1:gbx%nchan),gbx%surfem(1:gbx%nchan), &
+                                            gbx%co2,gbx%ch4,gbx%n2o,gbx%co, &
+                                            gbx_it)
+                ! --- Copy arrays without Npoints as dimension ---
+                gbx_it%dist_prmts_hydro = gbx%dist_prmts_hydro
+                gbx_it%dist_type_aero   = gbx_it%dist_type_aero
+                call construct_cosp_vgrid(gbx_it,vgrid%Nlvgrid,vgrid%use_vgrid,vgrid%csat_vgrid,vgrid_it)
+                call construct_cosp_subgrid(Ni, Ncolumns, Nlevels, sgx_it)
+                call construct_cosp_sgradar(cfg,Ni,Ncolumns,Nlevels,N_HYDRO,sgradar_it)
+                call construct_cosp_sglidar(cfg,Ni,Ncolumns,Nlevels,N_HYDRO,PARASOL_NREFL,sglidar_it)
+                call construct_cosp_isccp(cfg,Ni,Ncolumns,Nlevels,isccp_it)
+                call construct_cosp_modis(cfg,Ni, modis_it)
+                call construct_cosp_misr(cfg,Ni,misr_it)
+!#ifdef RTTOV 
+!                call construct_cosp_rttov(Ni,gbx%nchan,rttov_it) 
+!#endif 
+                call construct_cosp_radarstats(cfg,Ni,Ncolumns,vgrid%Nlvgrid,N_HYDRO,stradar_it)
+                call construct_cosp_lidarstats(cfg,Ni,Ncolumns,vgrid%Nlvgrid,N_HYDRO,PARASOL_NREFL,stlidar_it)
+            endif
+            ! --- Copy sections of arrays with Npoints as dimension ---
+            ix=(/i_first,i_last/)
+            iy=(/1,Ni/)
+            call cosp_gridbox_cpsection(ix,iy,gbx,gbx_it)
+              ! These serve as initialisation of *_it types
+            call cosp_subgrid_cpsection(ix,iy,sgx,sgx_it)
+            if (cfg%Lradar_sim) call cosp_sgradar_cpsection(ix,iy,sgradar,sgradar_it)
+            if (cfg%Llidar_sim) call cosp_sglidar_cpsection(ix,iy,sglidar,sglidar_it)
+            if (cfg%Lisccp_sim) call cosp_isccp_cpsection(ix,iy,isccp,isccp_it)
+            if (cfg%Lmodis_sim) call cosp_modis_cpsection(ix,iy,modis,modis_it)
+            if (cfg%Lmisr_sim)  call cosp_misr_cpsection(ix,iy,misr,misr_it)
+!#ifdef RTTOV 
+!            if (cfg%Lrttov_sim) call cosp_rttov_cpsection(ix,iy,rttov,rttov_it) 
+!#endif
+            if (cfg%Lradar_sim) call cosp_radarstats_cpsection(ix,iy,stradar,stradar_it)
+            if (cfg%Llidar_sim) call cosp_lidarstats_cpsection(ix,iy,stlidar,stlidar_it)
+!#ifdef RTTOV
+!            call cosp_iter(overlap,seed(ix(1):ix(2)),cfg,vgrid_it,gbx_it,sgx_it,sgradar_it, &
+!                           sglidar_it,isccp_it,misr_it,modis_it,rttov_it,stradar_it,stlidar_it)
+!#else
+            call cosp_iter(overlap,seed(ix(1):ix(2)),cfg,vgrid_it,gbx_it,sgx_it,sgradar_it, &
+                           sglidar_it,isccp_it,misr_it,modis_it,stradar_it,stlidar_it)
+!#endif
+            ! --- Copy results to output structures ---
+            ix=(/1,Ni/)
+            iy=(/i_first,i_last/)
+            call cosp_subgrid_cpsection(ix,iy,sgx_it,sgx)
+            if (cfg%Lradar_sim) call cosp_sgradar_cpsection(ix,iy,sgradar_it,sgradar)
+            if (cfg%Llidar_sim) call cosp_sglidar_cpsection(ix,iy,sglidar_it,sglidar)
+            if (cfg%Lisccp_sim) call cosp_isccp_cpsection(ix,iy,isccp_it,isccp)
+            if (cfg%Lmodis_sim) call cosp_modis_cpsection(ix,iy,modis_it,modis)
+            if (cfg%Lmisr_sim)  call cosp_misr_cpsection(ix,iy,misr_it,misr)
+!#ifdef RTTOV 
+!            if (cfg%Lrttov_sim) call cosp_rttov_cpsection(ix,iy,rttov_it,rttov) 
+!#endif 
+            if (cfg%Lradar_sim) call cosp_radarstats_cpsection(ix,iy,stradar_it,stradar)
+            if (cfg%Llidar_sim) call cosp_lidarstats_cpsection(ix,iy,stlidar_it,stlidar)
+        enddo
+        ! Deallocate types
+        call free_cosp_gridbox(gbx_it,.true.)
+        call free_cosp_subgrid(sgx_it)
+        call free_cosp_vgrid(vgrid_it)
+        call free_cosp_sgradar(sgradar_it)
+        call free_cosp_sglidar(sglidar_it)
+        call free_cosp_isccp(isccp_it)
+        call free_cosp_modis(modis_it)
+        call free_cosp_misr(misr_it)
+!#ifdef RTTOV 
+!        call free_cosp_rttov(rttov_it) 
+!#endif
+        call free_cosp_radarstats(stradar_it)
+        call free_cosp_lidarstats(stlidar_it)
+   endif
+   deallocate(seed)
+
+    
+END SUBROUTINE COSP
+
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!--------------------- SUBROUTINE COSP_ITER ----------------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!#ifdef RTTOV
+!SUBROUTINE COSP_ITER(overlap,seed,cfg,vgrid,gbx,sgx,sgradar,sglidar,isccp,misr,modis,rttov,stradar,stlidar)
+!#else
+SUBROUTINE COSP_ITER(overlap,seed,cfg,vgrid,gbx,sgx,sgradar,sglidar,isccp,misr,modis,stradar,stlidar)
+!#endif
+  ! Arguments
+  integer,intent(in) :: overlap !  overlap type in SCOPS: 1=max, 2=rand, 3=max/rand
+  integer,dimension(:),intent(in) :: seed
+  type(cosp_config),intent(in) :: cfg   ! Configuration options
+  type(cosp_vgrid),intent(in) :: vgrid   ! Information on vertical grid of stats
+  type(cosp_gridbox),intent(inout) :: gbx
+  type(cosp_subgrid),intent(inout) :: sgx   ! Subgrid info
+  type(cosp_sgradar),intent(inout) :: sgradar ! Output from radar simulator
+  type(cosp_sglidar),intent(inout) :: sglidar ! Output from lidar simulator
+  type(cosp_isccp),intent(inout)   :: isccp   ! Output from ISCCP simulator
+  type(cosp_misr),intent(inout)    :: misr    ! Output from MISR simulator
+  type(cosp_modis),intent(inout)   :: modis   ! Output from MODIS simulator
+!#ifdef RTTOV
+!  type(cosp_rttov),intent(inout)   :: rttov   ! Output from RTTOV
+!#endif
+  type(cosp_radarstats),intent(inout) :: stradar ! Summary statistics from radar simulator
+  type(cosp_lidarstats),intent(inout) :: stlidar ! Summary statistics from lidar simulator
+
+  ! Local variables 
+  integer :: Npoints   ! Number of gridpoints
+  integer :: Ncolumns  ! Number of subcolumns
+  integer :: Nlevels   ! Number of levels
+  integer :: Nhydro    ! Number of hydrometeors
+  integer :: i,j,k
+  integer :: I_HYDRO 
+  real,dimension(:,:),pointer :: column_frac_out ! Array with one column of frac_out
+  real,dimension(:,:),pointer :: column_prec_out ! Array with one column of prec_frac
+  integer :: scops_debug=0    !  set to non-zero value to print out inputs for debugging in SCOPS
+  real,dimension(:, :),allocatable :: cca_scops,ls_p_rate,cv_p_rate, &
+                     tca_scops ! Cloud cover in each model level (HORIZONTAL gridbox fraction) of total cloud.
+                               ! Levels are from TOA to SURFACE. (nPoints, nLev)
+  real,dimension(:,:),allocatable :: frac_ls,prec_ls,frac_cv,prec_cv ! Cloud/Precipitation fraction in each model level
+                                                                     ! Levels are from SURFACE to TOA
+  real,dimension(:,:),allocatable :: rho ! (Npoints, Nlevels). Atmospheric density
+  type(cosp_sghydro) :: sghydro   ! Subgrid info for hydrometeors en each iteration
+
+  
+  !++++++++++ Dimensions ++++++++++++
+  Npoints  = gbx%Npoints
+  Ncolumns = gbx%Ncolumns
+  Nlevels  = gbx%Nlevels
+  Nhydro   = gbx%Nhydro
+    
+  !++++++++++ Climate/NWP mode ++++++++++  
+  if (Ncolumns > 1) then
+        !++++++++++ Subgrid sampling ++++++++++
+        ! Allocate arrays before calling SCOPS
+        allocate(frac_ls(Npoints,Nlevels),frac_cv(Npoints,Nlevels),prec_ls(Npoints,Nlevels),prec_cv(Npoints,Nlevels))
+        allocate(tca_scops(Npoints,Nlevels),cca_scops(Npoints,Nlevels), &
+                ls_p_rate(Npoints,Nlevels),cv_p_rate(Npoints,Nlevels))
+        ! Initialize to zero
+        frac_ls=0.0
+        prec_ls=0.0
+        frac_cv=0.0
+        prec_cv=0.0
+        ! Cloud fractions for SCOPS from TOA to SFC
+        tca_scops = gbx%tca(:,Nlevels:1:-1)
+        cca_scops = gbx%cca(:,Nlevels:1:-1)
+        
+        ! Call to SCOPS
+        ! strat and conv arrays are passed with levels from TOA to SURFACE.
+        call scops(Npoints,Nlevels,Ncolumns,seed,tca_scops,cca_scops,overlap,sgx%frac_out,scops_debug)
+        
+        ! temporarily use prec_ls/cv to transfer information about precipitation flux into prec_scops
+        if(gbx%use_precipitation_fluxes) then
+            ls_p_rate(:,Nlevels:1:-1)=gbx%rain_ls(:,1:Nlevels)+gbx%snow_ls(:,1:Nlevels)+gbx%grpl_ls(:,1:Nlevels)
+            cv_p_rate(:,Nlevels:1:-1)=gbx%rain_cv(:,1:Nlevels)+gbx%snow_cv(:,1:Nlevels)
+        else
+            ls_p_rate(:,Nlevels:1:-1)=gbx%mr_hydro(:,1:Nlevels,I_LSRAIN)+ &
+                                      gbx%mr_hydro(:,1:Nlevels,I_LSSNOW)+ &
+                                      gbx%mr_hydro(:,1:Nlevels,I_LSGRPL)
+            cv_p_rate(:,Nlevels:1:-1)=gbx%mr_hydro(:,1:Nlevels,I_CVRAIN)+ &
+                                      gbx%mr_hydro(:,1:Nlevels,I_CVSNOW)
+        endif
+        
+        call prec_scops(Npoints,Nlevels,Ncolumns,ls_p_rate,cv_p_rate,sgx%frac_out,sgx%prec_frac)
+        
+        ! Precipitation fraction
+        do j=1,Npoints,1
+        do k=1,Nlevels,1
+            do i=1,Ncolumns,1
+                if (sgx%frac_out (j,i,Nlevels+1-k) == I_LSC) frac_ls(j,k)=frac_ls(j,k)+1.
+                if (sgx%frac_out (j,i,Nlevels+1-k) == I_CVC) frac_cv(j,k)=frac_cv(j,k)+1.
+                if (sgx%prec_frac(j,i,Nlevels+1-k) .eq. 1) prec_ls(j,k)=prec_ls(j,k)+1.
+                if (sgx%prec_frac(j,i,Nlevels+1-k) .eq. 2) prec_cv(j,k)=prec_cv(j,k)+1.
+                if (sgx%prec_frac(j,i,Nlevels+1-k) .eq. 3) then
+                    prec_cv(j,k)=prec_cv(j,k)+1.
+                    prec_ls(j,k)=prec_ls(j,k)+1.
+                endif
+            enddo  !i
+            frac_ls(j,k)=frac_ls(j,k)/Ncolumns
+            frac_cv(j,k)=frac_cv(j,k)/Ncolumns
+            prec_ls(j,k)=prec_ls(j,k)/Ncolumns
+            prec_cv(j,k)=prec_cv(j,k)/Ncolumns
+        enddo  !k
+        enddo  !j
+        
+         ! Levels from SURFACE to TOA.
+        if (Npoints*Ncolumns*Nlevels < 10000) then
+            sgx%frac_out(1:Npoints,:,1:Nlevels)  = sgx%frac_out(1:Npoints,:,Nlevels:1:-1)
+            sgx%prec_frac(1:Npoints,:,1:Nlevels) = sgx%prec_frac(1:Npoints,:,Nlevels:1:-1)
+        else
+            ! This is done within a loop (unvectorized) over nPoints to save memory
+            do j=1,Npoints
+                sgx%frac_out(j,:,1:Nlevels)  = sgx%frac_out(j,:,Nlevels:1:-1)
+                sgx%prec_frac(j,:,1:Nlevels) = sgx%prec_frac(j,:,Nlevels:1:-1)
+            enddo
+        endif
+       
+       ! Deallocate arrays that will no longer be used
+        deallocate(tca_scops,cca_scops,ls_p_rate,cv_p_rate)
+
+        ! Populate the subgrid arrays
+        call construct_cosp_sghydro(Npoints,Ncolumns,Nlevels,Nhydro,sghydro)
+        do k=1,Ncolumns
+            !--------- Mixing ratios for clouds and Reff for Clouds and precip -------
+            column_frac_out => sgx%frac_out(:,k,:)
+            where (column_frac_out == I_LSC)     !+++++++++++ LS clouds ++++++++
+                sghydro%mr_hydro(:,k,:,I_LSCLIQ) = gbx%mr_hydro(:,:,I_LSCLIQ)
+                sghydro%mr_hydro(:,k,:,I_LSCICE) = gbx%mr_hydro(:,:,I_LSCICE)
+
+                sghydro%Reff(:,k,:,I_LSCLIQ)     = gbx%Reff(:,:,I_LSCLIQ)
+                sghydro%Reff(:,k,:,I_LSCICE)     = gbx%Reff(:,:,I_LSCICE)
+
+                sghydro%Np(:,k,:,I_LSCLIQ)     = gbx%Np(:,:,I_LSCLIQ)
+                sghydro%Np(:,k,:,I_LSCICE)     = gbx%Np(:,:,I_LSCICE)
+
+            elsewhere (column_frac_out == I_CVC) !+++++++++++ CONV clouds ++++++++
+                sghydro%mr_hydro(:,k,:,I_CVCLIQ) = gbx%mr_hydro(:,:,I_CVCLIQ)
+                sghydro%mr_hydro(:,k,:,I_CVCICE) = gbx%mr_hydro(:,:,I_CVCICE)
+
+                sghydro%Reff(:,k,:,I_CVCLIQ)     = gbx%Reff(:,:,I_CVCLIQ)
+                sghydro%Reff(:,k,:,I_CVCICE)     = gbx%Reff(:,:,I_CVCICE)
+
+                sghydro%Np(:,k,:,I_CVCLIQ)     = gbx%Np(:,:,I_CVCLIQ)
+                sghydro%Np(:,k,:,I_CVCICE)     = gbx%Np(:,:,I_CVCICE)
+
+            end where
+            column_prec_out => sgx%prec_frac(:,k,:)
+            where ((column_prec_out == 1) .or. (column_prec_out == 3) )  !++++ LS precip ++++
+                sghydro%Reff(:,k,:,I_LSRAIN) = gbx%Reff(:,:,I_LSRAIN)
+                sghydro%Reff(:,k,:,I_LSSNOW) = gbx%Reff(:,:,I_LSSNOW)
+                sghydro%Reff(:,k,:,I_LSGRPL) = gbx%Reff(:,:,I_LSGRPL)
+
+                sghydro%Np(:,k,:,I_LSRAIN)     = gbx%Np(:,:,I_LSRAIN)
+                sghydro%Np(:,k,:,I_LSSNOW)     = gbx%Np(:,:,I_LSSNOW)
+                sghydro%Np(:,k,:,I_LSGRPL)     = gbx%Np(:,:,I_LSGRPL)
+            elsewhere ((column_prec_out == 2) .or. (column_prec_out == 3)) !++++ CONV precip ++++
+                sghydro%Reff(:,k,:,I_CVRAIN) = gbx%Reff(:,:,I_CVRAIN)
+                sghydro%Reff(:,k,:,I_CVSNOW) = gbx%Reff(:,:,I_CVSNOW)
+
+                sghydro%Np(:,k,:,I_CVRAIN)     = gbx%Np(:,:,I_CVRAIN)
+                sghydro%Np(:,k,:,I_CVSNOW)     = gbx%Np(:,:,I_CVSNOW)
+            end where
+            !--------- Precip -------
+            if (.not. gbx%use_precipitation_fluxes) then
+                where (column_frac_out == I_LSC)  !+++++++++++ LS Precipitation ++++++++
+                    sghydro%mr_hydro(:,k,:,I_LSRAIN) = gbx%mr_hydro(:,:,I_LSRAIN)
+                    sghydro%mr_hydro(:,k,:,I_LSSNOW) = gbx%mr_hydro(:,:,I_LSSNOW)
+                    sghydro%mr_hydro(:,k,:,I_LSGRPL) = gbx%mr_hydro(:,:,I_LSGRPL)
+                elsewhere (column_frac_out == I_CVC) !+++++++++++ CONV Precipitation ++++++++
+                    sghydro%mr_hydro(:,k,:,I_CVRAIN) = gbx%mr_hydro(:,:,I_CVRAIN)
+                    sghydro%mr_hydro(:,k,:,I_CVSNOW) = gbx%mr_hydro(:,:,I_CVSNOW)
+                end where 
+            endif
+        enddo
+        ! convert the mixing ratio and precipitation flux from gridbox mean to the fraction-based values
+        do k=1,Nlevels
+            do j=1,Npoints
+                !--------- Clouds -------
+                if (frac_ls(j,k) .ne. 0.) then
+                    sghydro%mr_hydro(j,:,k,I_LSCLIQ) = sghydro%mr_hydro(j,:,k,I_LSCLIQ)/frac_ls(j,k)
+                    sghydro%mr_hydro(j,:,k,I_LSCICE) = sghydro%mr_hydro(j,:,k,I_LSCICE)/frac_ls(j,k)
+                endif
+                if (frac_cv(j,k) .ne. 0.) then
+                    sghydro%mr_hydro(j,:,k,I_CVCLIQ) = sghydro%mr_hydro(j,:,k,I_CVCLIQ)/frac_cv(j,k)
+                    sghydro%mr_hydro(j,:,k,I_CVCICE) = sghydro%mr_hydro(j,:,k,I_CVCICE)/frac_cv(j,k)
+                endif
+                !--------- Precip -------
+                if (gbx%use_precipitation_fluxes) then
+                    if (prec_ls(j,k) .ne. 0.) then
+                        gbx%rain_ls(j,k) = gbx%rain_ls(j,k)/prec_ls(j,k)
+                        gbx%snow_ls(j,k) = gbx%snow_ls(j,k)/prec_ls(j,k)
+                        gbx%grpl_ls(j,k) = gbx%grpl_ls(j,k)/prec_ls(j,k)
+                    endif
+                    if (prec_cv(j,k) .ne. 0.) then
+                        gbx%rain_cv(j,k) = gbx%rain_cv(j,k)/prec_cv(j,k)
+                        gbx%snow_cv(j,k) = gbx%snow_cv(j,k)/prec_cv(j,k)
+                    endif
+                else
+                    if (prec_ls(j,k) .ne. 0.) then
+                        sghydro%mr_hydro(j,:,k,I_LSRAIN) = sghydro%mr_hydro(j,:,k,I_LSRAIN)/prec_ls(j,k)
+                        sghydro%mr_hydro(j,:,k,I_LSSNOW) = sghydro%mr_hydro(j,:,k,I_LSSNOW)/prec_ls(j,k)
+                        sghydro%mr_hydro(j,:,k,I_LSGRPL) = sghydro%mr_hydro(j,:,k,I_LSGRPL)/prec_ls(j,k)
+                    endif
+                    if (prec_cv(j,k) .ne. 0.) then
+                        sghydro%mr_hydro(j,:,k,I_CVRAIN) = sghydro%mr_hydro(j,:,k,I_CVRAIN)/prec_cv(j,k)
+                        sghydro%mr_hydro(j,:,k,I_CVSNOW) = sghydro%mr_hydro(j,:,k,I_CVSNOW)/prec_cv(j,k)
+                    endif
+                endif  
+            enddo !k
+        enddo !j
+        deallocate(frac_ls,prec_ls,frac_cv,prec_cv)
+        
+        if (gbx%use_precipitation_fluxes) then
+        
+#ifdef MMF_V3p5_TWO_MOMENT
+
+        write(*,*) 'Precipitation Flux to Mixing Ratio conversion not (yet?) supported ', &
+               'for MMF3.5 Two Moment Microphysics'
+        stop
+#else
+            ! Density
+            allocate(rho(Npoints,Nlevels))
+            I_HYDRO = I_LSRAIN
+            call cosp_precip_mxratio(Npoints,Nlevels,Ncolumns,gbx%p,gbx%T,sgx%prec_frac,1., &
+                    n_ax(I_HYDRO),n_bx(I_HYDRO),alpha_x(I_HYDRO),c_x(I_HYDRO),d_x(I_HYDRO), &
+                    g_x(I_HYDRO),a_x(I_HYDRO),b_x(I_HYDRO), &
+                    gamma_1(I_HYDRO),gamma_2(I_HYDRO),gamma_3(I_HYDRO),gamma_4(I_HYDRO), &
+                    gbx%rain_ls,sghydro%mr_hydro(:,:,:,I_HYDRO),sghydro%Reff(:,:,:,I_HYDRO))
+            I_HYDRO = I_LSSNOW
+            call cosp_precip_mxratio(Npoints,Nlevels,Ncolumns,gbx%p,gbx%T,sgx%prec_frac,1., &
+                    n_ax(I_HYDRO),n_bx(I_HYDRO),alpha_x(I_HYDRO),c_x(I_HYDRO),d_x(I_HYDRO), &
+                    g_x(I_HYDRO),a_x(I_HYDRO),b_x(I_HYDRO), &
+                    gamma_1(I_HYDRO),gamma_2(I_HYDRO),gamma_3(I_HYDRO),gamma_4(I_HYDRO), &
+                    gbx%snow_ls,sghydro%mr_hydro(:,:,:,I_HYDRO),sghydro%Reff(:,:,:,I_HYDRO))
+            I_HYDRO = I_CVRAIN
+            call cosp_precip_mxratio(Npoints,Nlevels,Ncolumns,gbx%p,gbx%T,sgx%prec_frac,2., &
+                    n_ax(I_HYDRO),n_bx(I_HYDRO),alpha_x(I_HYDRO),c_x(I_HYDRO),d_x(I_HYDRO), &
+                    g_x(I_HYDRO),a_x(I_HYDRO),b_x(I_HYDRO), &
+                    gamma_1(I_HYDRO),gamma_2(I_HYDRO),gamma_3(I_HYDRO),gamma_4(I_HYDRO), &
+                    gbx%rain_cv,sghydro%mr_hydro(:,:,:,I_HYDRO),sghydro%Reff(:,:,:,I_HYDRO))
+            I_HYDRO = I_CVSNOW
+            call cosp_precip_mxratio(Npoints,Nlevels,Ncolumns,gbx%p,gbx%T,sgx%prec_frac,2., &
+                    n_ax(I_HYDRO),n_bx(I_HYDRO),alpha_x(I_HYDRO),c_x(I_HYDRO),d_x(I_HYDRO), &
+                    g_x(I_HYDRO),a_x(I_HYDRO),b_x(I_HYDRO), &
+                    gamma_1(I_HYDRO),gamma_2(I_HYDRO),gamma_3(I_HYDRO),gamma_4(I_HYDRO), &
+                    gbx%snow_cv,sghydro%mr_hydro(:,:,:,I_HYDRO),sghydro%Reff(:,:,:,I_HYDRO))
+            I_HYDRO = I_LSGRPL
+            call cosp_precip_mxratio(Npoints,Nlevels,Ncolumns,gbx%p,gbx%T,sgx%prec_frac,1., &
+                    n_ax(I_HYDRO),n_bx(I_HYDRO),alpha_x(I_HYDRO),c_x(I_HYDRO),d_x(I_HYDRO), &
+                    g_x(I_HYDRO),a_x(I_HYDRO),b_x(I_HYDRO), &
+                    gamma_1(I_HYDRO),gamma_2(I_HYDRO),gamma_3(I_HYDRO),gamma_4(I_HYDRO), &
+                    gbx%grpl_ls,sghydro%mr_hydro(:,:,:,I_HYDRO),sghydro%Reff(:,:,:,I_HYDRO))
+            if(allocated(rho)) deallocate(rho)
+#endif
+
+        endif
+   !++++++++++ CRM mode ++++++++++
+   else
+      call construct_cosp_sghydro(Npoints,Ncolumns,Nlevels,Nhydro,sghydro)
+      sghydro%mr_hydro(:,1,:,:) = gbx%mr_hydro
+      sghydro%Reff(:,1,:,:) = gbx%Reff
+      sghydro%Np(:,1,:,:) = gbx%Np      ! added by Roj with Quickbeam V3.0
+      
+      !--------- Clouds -------
+      where ((gbx%dtau_s > 0.0))
+             sgx%frac_out(:,1,:) = 1  ! Subgrid cloud array. Dimensions (Npoints,Ncolumns,Nlevels)
+      endwhere
+   endif ! Ncolumns > 1
+  
+   !++++++++++ Simulator ++++++++++
+!#ifdef RTTOV
+!    call cosp_simulator(gbx,sgx,sghydro,cfg,vgrid,sgradar,sglidar,isccp,misr,modis,rttov,stradar,stlidar)
+!#else
+    call cosp_simulator(gbx,sgx,sghydro,cfg,vgrid,sgradar,sglidar,isccp,misr,modis,stradar,stlidar)
+!#endif
+
+    ! Deallocate subgrid arrays
+    call free_cosp_sghydro(sghydro)
+END SUBROUTINE COSP_ITER
+
+END MODULE MOD_COSP
Index: LMDZ6/trunk/libf/phylmd/cosp/mod_cosp_constants.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/cosp/mod_cosp_constants.F90	(revision 3233)
+++ LMDZ6/trunk/libf/phylmd/cosp/mod_cosp_constants.F90	(revision 3233)
@@ -0,0 +1,304 @@
+! (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.
+
+!
+! History:
+! Jul 2007 - A. Bodas-Salcedo - Initial version
+! Jul 2008 - A. Bodas-Salcedo - Added definitions of ISCCP axes
+! Oct 2008 - H. Chepfer       - Added PARASOL_NREFL
+! Jun 2010 - R. Marchand      - Modified to support quickbeam V3, added ifdef for hydrometeor definitions
+! 
+!
+! 
+
+#include "cosp_defs.h"
+MODULE MOD_COSP_CONSTANTS
+    IMPLICIT NONE
+
+    character(len=32) :: COSP_VERSION='COSP v1.4'
+
+    ! Indices to address arrays of LS and CONV hydrometeors
+    integer,parameter :: I_LSCLIQ = 1
+    integer,parameter :: I_LSCICE = 2
+    integer,parameter :: I_LSRAIN = 3
+    integer,parameter :: I_LSSNOW = 4
+    integer,parameter :: I_CVCLIQ = 5
+    integer,parameter :: I_CVCICE = 6
+    integer,parameter :: I_CVRAIN = 7
+    integer,parameter :: I_CVSNOW = 8
+    integer,parameter :: I_LSGRPL = 9
+
+    ! Missing value
+    real,parameter :: R_UNDEF = -1.0E30
+
+    ! Number of possible output variables
+    integer,parameter :: N_OUT_LIST = 74 !OPAQ 65+7 !TIBO 72+2
+    integer,parameter :: N3D = 11                   !TIBO 10+1
+    integer,parameter :: N2D = 19        !OPAQ 14+4 !TIBO 18+1
+    integer,parameter :: N1D = 43        !OPAQ 40+3
+
+    ! Value for forward model result from a level that is under the ground
+    real,parameter :: R_GROUND = -1.0E20
+
+    ! Stratiform and convective clouds in frac_out
+    integer, parameter :: I_LSC = 1, & ! Large-scale clouds
+                          I_CVC = 2    ! Convective clouds
+
+    ! Timing of different simulators, including statistics module
+    integer, parameter :: N_SIMULATORS = 7
+    integer,parameter :: I_RADAR = 1
+    integer,parameter :: I_LIDAR = 2
+    integer,parameter :: I_ISCCP = 3
+    integer,parameter :: I_MISR  = 4
+    integer,parameter :: I_MODIS = 5
+    integer,parameter :: I_RTTOV = 6
+    integer,parameter :: I_STATS = 7
+    character*32, dimension(N_SIMULATORS) :: SIM_NAME = (/'Radar','Lidar','ISCCP','MISR ','MODIS','RTTOV','Stats'/)
+    integer,dimension(N_SIMULATORS) :: tsim
+    data tsim/N_SIMULATORS*0.0/
+
+    !--- Radar constants
+    ! CFAD constants
+    integer,parameter :: DBZE_BINS     =   15   ! Number of dBZe bins in histogram (cfad)
+    real,parameter    :: DBZE_MIN      = -100.0 ! Minimum value for radar reflectivity
+    real,parameter    :: DBZE_MAX      =   80.0 ! Maximum value for radar reflectivity
+    real,parameter    :: CFAD_ZE_MIN   =  -50.0 ! Lower value of the first CFAD Ze bin
+    real,parameter    :: CFAD_ZE_WIDTH =    5.0 ! Bin width (dBZe)
+
+
+    !--- Lidar constants
+    ! CFAD constants
+    integer,parameter :: SR_BINS       =   15
+    integer,parameter :: DPOL_BINS     =   6
+    real,parameter    :: LIDAR_UNDEF   =   999.999
+
+    ! Other constants
+    integer,parameter :: LIDAR_NCAT    =   4
+    integer,parameter :: LIDAR_NTYPE   =   3 !OPAQ
+    integer,parameter :: PARASOL_NREFL =   5 ! parasol
+    real,parameter,dimension(PARASOL_NREFL) :: PARASOL_SZA = (/0.0, 20.0, 40.0, 60.0, 80.0/)
+    real,parameter    :: DEFAULT_LIDAR_REFF = 30.0e-6 ! Default lidar effective radius
+
+    integer,parameter :: LIDAR_NTEMP = 40
+    real,parameter,dimension(LIDAR_NTEMP) :: LIDAR_PHASE_TEMP=(/-91.5,-88.5,-85.5,-82.5,-79.5,-76.5,-73.5,-70.5,-67.5,-64.5, &
+                   -61.5,-58.5,-55.5,-52.5,-49.5,-46.5,-43.5,-40.5,-37.5,-34.5, &
+                   -31.5,-28.5,-25.5,-22.5,-19.5,-16.5,-13.5,-10.5, -7.5, -4.5, &
+                    -1.5,  1.5,  4.5,  7.5, 10.5, 13.5, 16.5, 19.5, 22.5, 25.5/)
+    real,parameter,dimension(2,LIDAR_NTEMP) :: LIDAR_PHASE_TEMP_BNDS=reshape(source=(/-273.15,-90.,-90.,-87.,-87.,-84.,-84.,-81.,-81.,-78., &
+                   -78.,-75.,-75.,-72.,-72.,-69.,-69.,-66.,-66.,-63., &
+                   -63.,-60.,-60.,-57.,-57.,-54.,-54.,-51.,-51.,-48., &
+                   -48.,-45.,-45.,-42.,-42.,-39.,-39.,-36.,-36.,-33., &
+                   -33.,-30.,-30.,-27.,-27.,-24.,-24.,-21.,-21.,-18., &
+                   -18.,-15.,-15.,-12.,-12., -9., -9., -6., -6., -3., &
+                    -3.,  0.,  0.,  3.,  3.,  6.,  6.,  9.,  9., 12., &
+                    12., 15., 15., 18., 18., 21., 21., 24., 24.,100./),shape=(/2,40/))
+
+    !--- MISR constants
+    integer,parameter :: MISR_N_CTH = 16
+
+    !--- RTTOV constants
+    integer,parameter :: RTTOV_MAX_CHANNELS = 20
+
+    ! ISCCP tau-Pc axes
+    real,parameter,dimension(7) :: ISCCP_TAU = (/0.15, 0.80, 2.45, 6.5, 16.2, 41.5, 100.0/)
+    real,parameter,dimension(2,7) :: ISCCP_TAU_BNDS = reshape(source=(/0.0,0.3,0.3,1.30,1.30,3.6,3.6,9.4, &
+                                                      9.4,23.0,23.0,60.0,60.0,100000.0/), shape=(/2,7/))
+
+    real,parameter,dimension(7) :: ISCCP_PC = (/90000., 74000., 62000., 50000., 37500., 24500., 9000./)
+    real,parameter,dimension(2,7) :: ISCCP_PC_BNDS = reshape(source=(/100000.0,80000.0,80000.0,68000.0,68000.0,56000.0 &
+                               ,56000.0,44000.0,44000.0,31000.0,31000.0,18000.0,18000.0,0.0/), shape=(/2,7/))
+
+    real,parameter,dimension(MISR_N_CTH) :: MISR_CTH = 1000.0*(/ 0., 0.25, 0.75, 1.25, 1.75, 2.25, 2.75, 3.5, &
+                                            4.5, 6., 8., 10., 12., 14.5, 16., 18./)
+    real,parameter,dimension(2,MISR_N_CTH) :: MISR_CTH_BNDS = 1000.0*reshape(source=(/ &
+                                            -99.0,  0.0,       0.0,  0.5,       0.5,  1.0,      1.0,  1.5, &
+                                              1.5,  2.0,       2.0,  2.5,       2.5,  3.0,      3.0,  4.0, &
+                                              4.0,  5.0,       5.0,  7.0,       7.0,  9.0,      9.0, 11.0, &
+                                             11.0, 13.0,      13.0, 15.0,      15.0, 17.0,     17.0, 99.0/), &
+                                             shape=(/2,MISR_N_CTH/))
+
+
+    !
+    ! The following code was modifed by Roj with implementation of quickbeam V3
+    !   (1) use ifdef to support more than one microphyscis scheme 
+    !   (2) added constants  microphysic_scheme_name, LOAD_scale_LUTs, and SAVE_scale_LUTs 
+    !
+
+    ! directory where LUTs will be stored
+    character*120 :: RADAR_SIM_LUT_DIRECTORY = './'
+
+#ifdef MMF_V3_SINGLE_MOMENT
+
+    !        
+    !  Table hclass for quickbeam to support one-moment (bulk) microphysics scheme used by MMF V3.0 & V3.5
+    !
+
+    !
+    ! NOTE:  if ANY value in this section of code is changed, the existing LUT 
+    !        (i.e., the associated *.dat file) MUST be deleted so that a NEW
+    !        LUT will be created !!!
+    !
+    character*120 :: RADAR_SIM_MICROPHYSICS_SCHEME_NAME = 'MMF_v3_single_moment'
+
+    logical :: RADAR_SIM_LOAD_scale_LUTs_flag   = .false.
+    logical :: RADAR_SIM_UPDATE_scale_LUTs_flag = .false.
+    integer,parameter :: N_HYDRO = 9
+
+    integer :: HCLASS_TYPE(N_HYDRO),HCLASS_PHASE(N_HYDRO)
+
+    real :: HCLASS_DMIN(N_HYDRO),HCLASS_DMAX(N_HYDRO), &
+            HCLASS_APM(N_HYDRO),HCLASS_BPM(N_HYDRO),HCLASS_RHO(N_HYDRO), &
+            HCLASS_P1(N_HYDRO),HCLASS_P2(N_HYDRO),HCLASS_P3(N_HYDRO)
+
+    ! HCLASS_CP is not used in the version of Quickbeam included in COSP
+    !                   LSL    LSI      LSR     LSS   CVL    CVI   CVR     CVS   LSG
+    data HCLASS_TYPE/    5,      1,      2,      2,     5,     1,   2,      2,    2/
+    data HCLASS_PHASE/   0,      1,      0,      1,     0,     1,   0,      1,    1/
+    data HCLASS_DMIN/   -1,     -1,     -1,     -1,    -1,    -1,   -1,    -1,   -1/
+    data HCLASS_DMAX/   -1,     -1,     -1,     -1,    -1,    -1,   -1,    -1,   -1/
+    data HCLASS_APM/   524,  110.8,    524,     -1,   524, 110.8,  524,    -1,   -1/
+    data HCLASS_BPM/     3,   2.91,      3,     -1,     3,  2.91,    3,    -1,   -1/
+    data HCLASS_RHO/    -1,     -1,     -1,    100,    -1,    -1,   -1,   100,  400/
+    data HCLASS_P1/     -1,     -1,   8.e6,   3.e6,    -1,    -1, 8.e6,  3.e6, 4.e6/
+    data HCLASS_P2/      6,     40,     -1,      -1,    6,    40,   -1,    -1,   -1/
+    data HCLASS_P3/    0.3,      2,     -1,      -1,  0.3,     2,   -1,    -1,   -1/
+
+    ! NOTES on HCLASS variables
+    !
+    ! TYPE - Set to
+    ! 1 for modified gamma distribution,
+    ! 2 for exponential distribution,
+    ! 3 for power law distribution,
+    ! 4 for monodisperse distribution,
+    ! 5 for lognormal distribution.
+
+    ! PHASE - Set to 0 for liquid, 1 for ice.
+
+    ! DMIN - The minimum drop size for this class (micron), ignored for monodisperse.
+    ! DMAX - The maximum drop size for this class (micron), ignored for monodisperse.
+    ! Important note: The settings for DMIN and DMAX are
+    ! ignored in the current version for all distributions except for power
+    ! law. Except when the power law distribution is used, particle size
+    ! is fixed to vary from zero to infinity, a restriction that is expected
+    ! to be lifted in future versions. A placeholder must still be specified
+    ! for each.
+
+    ! Density of particles is given by apm*D^bpm or a fixed value rho. ONLY specify ONE of these two!!
+    ! APM - The alpha_m coefficient in equation (1) (kg m**-beta_m )
+    ! BPM - The beta_m coefficient in equation (1), see section 4.1.
+
+    ! RHO - Hydrometeor density (kg m-3 ).
+
+    ! P1, P2, P3 - are default distribution parameters that depend on the type
+    ! of distribution (see quickmbeam documentation for more information)
+    !
+    ! Modified Gamma (must set P3 and one of P1 or P2)
+    ! P1 - Set to the total particle number concentration Nt /rho_a (kg-1 ), where
+    ! rho_a is the density of air in the radar volume.
+    ! P2 - Set to the particle mean diameter D (micron).
+    ! P3 - Set to the distribution width nu.
+    !
+    ! Exponetial (set one of)
+    ! P1 - Set to a constant intercept parameter N0 (m-4).
+    ! P2 - Set to a constant lambda (micron-1).
+    !
+    ! Power Law
+    ! P1 - Set this to the value of a constant power law parameter br
+    !
+    ! Monodisperse
+    ! P1 - Set to a constant diameter D0 (micron) = Re.
+    !
+    ! Log-normal (must set P3 and one of P1 or P2)
+    ! P1 - Set to the total particle number concentration Nt /rho_a (kg-1 )
+    ! P2 - Set to the geometric mean particle radius rg (micron).
+    ! P3 - Set to the natural logarithm of the geometric standard deviation.
+    !
+
+
+    real,dimension(N_HYDRO) :: N_ax,N_bx,alpha_x,c_x,d_x,g_x,a_x,b_x,gamma_1,gamma_2,gamma_3,gamma_4
+
+    ! Microphysical settings for the precipitation flux to mixing ratio conversion
+    !                LSL    LSI       LSR       LSS   CVL    CVI       CVR       CVS      LSG
+    data N_ax/       -1.,   -1.,     8.e6,     3.e6,  -1.,   -1.,     8.e6,     3.e6,     4.e6/
+    data N_bx/       -1.,   -1.,      0.0,      0.0,  -1.,   -1.,      0.0,      0.0,      0.0/
+    data alpha_x/    -1.,   -1.,      0.0,      0.0,  -1.,   -1.,      0.0,      0.0,      0.0/
+    data c_x/        -1.,   -1.,    842.0,     4.84,  -1.,   -1.,    842.0,     4.84,     94.5/
+    data d_x/        -1.,   -1.,      0.8,     0.25,  -1.,   -1.,      0.8,     0.25,      0.5/
+    data g_x/        -1.,   -1.,      0.5,      0.5,  -1.,   -1.,      0.5,      0.5,      0.5/
+    data a_x/        -1.,   -1.,    524.0,    52.36,  -1.,   -1.,    524.0,    52.36,   209.44/
+    data b_x/        -1.,   -1.,      3.0,      3.0,  -1.,   -1.,      3.0,      3.0,      3.0/
+    data gamma_1/    -1.,   -1., 17.83725, 8.284701,  -1.,   -1., 17.83725, 8.284701, 11.63230/
+    data gamma_2/    -1.,   -1.,      6.0,      6.0,  -1.,   -1.,      6.0,      6.0,      6.0/
+    data gamma_3/    -1.,   -1.,      2.0,      2.0,  -1.,   -1.,      2.0,      2.0,      2.0/
+    data gamma_4/    -1.,   -1.,      6.0,      6.0,  -1.,   -1.,      6.0,      6.0,      6.0/
+
+
+
+#endif
+
+
+#ifdef MMF_V3p5_TWO_MOMENT
+
+    !
+    !  Table hclass for quickbeam to support two-moment "morrison" microphysics scheme used by V3.5 (SAM 6.8)
+    !
+    !  This Number concentriation Np in [1/kg] MUST be input to COSP/radar simulator
+    !
+    !  NOTE:  Be sure to check that the ice-density (rho) set it this tables matches what you used
+    !
+
+    !
+    ! NOTE:  if ANY value in this section of code is changed, the existing LUT 
+    !        (i.e., the associated *.dat file) MUST be deleted so that a NEW
+    !        LUT will be created !!!
+    !
+    character*120 :: RADAR_SIM_MICROPHYSICS_SCHEME_NAME = 'MMF_v3.5_two_moment'
+
+    logical :: RADAR_SIM_LOAD_scale_LUTs_flag   = .false.
+    logical :: RADAR_SIM_UPDATE_scale_LUTs_flag = .false.
+
+    integer,parameter :: N_HYDRO = 9
+
+    integer :: HCLASS_TYPE(N_HYDRO),HCLASS_PHASE(N_HYDRO) 
+
+    real :: HCLASS_DMIN(N_HYDRO),HCLASS_DMAX(N_HYDRO), &           
+            HCLASS_APM(N_HYDRO),HCLASS_BPM(N_HYDRO),HCLASS_RHO(N_HYDRO), &
+            HCLASS_P1(N_HYDRO),HCLASS_P2(N_HYDRO),HCLASS_P3(N_HYDRO)
+
+    ! HCLASS_CP is not used in the version of Quickbeam included in COSP
+    !                   LSL    LSI      LSR     LSS   CVL    CVI   CVR     CVS   LSG
+    data HCLASS_TYPE/    1,      1,      1,      1,     1,     1,    1,      1,    1/
+    data HCLASS_PHASE/   0,      1,      0,      1,     0,     1,    0,      1,    1/
+    data HCLASS_DMIN/   -1,     -1,     -1,     -1,    -1,    -1,   -1,     -1,   -1/
+    data HCLASS_DMAX/   -1,     -1,     -1,     -1,    -1,    -1,   -1,     -1,   -1/
+    data HCLASS_APM/   524,     -1,    524,     -1,   524,    -1,  524,     -1,   -1/
+    data HCLASS_BPM/     3,     -1,      3,     -1,     3,    -1,    3,     -1,   -1/
+    data HCLASS_RHO/    -1,    500,     -1,    100,    -1,   500,   -1,    100,  900/
+    data HCLASS_P1/     -1,     -1,     -1,     -1,    -1,    -1,   -1,     -1,   -1/
+    data HCLASS_P2/     -1,     -1,     -1,     -1,    -1,    -1,   -1,     -1,   -1/
+    data HCLASS_P3/     -2,      1,      1,      1,    -2,     1,    1,      1,    1/
+    ! Note: value of "-2" for HCLASS_P3 uses martin 1994 parameteriztion of gamma function width with Number concentration
+#endif
+
+END MODULE MOD_COSP_CONSTANTS
Index: LMDZ6/trunk/libf/phylmd/cosp/mod_cosp_isccp_simulator.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/cosp/mod_cosp_isccp_simulator.F90	(revision 3233)
+++ LMDZ6/trunk/libf/phylmd/cosp/mod_cosp_isccp_simulator.F90	(revision 3233)
@@ -0,0 +1,96 @@
+! (c) British Crown Copyright 2008, the Met Office.
+! All rights reserved.
+! $Revision: 23 $, $Date: 2011-03-31 15:41:37 +0200 (jeu. 31 mars 2011) $
+! $URL: http://cfmip-obs-sim.googlecode.com/svn/stable/v1.4.0/cosp_isccp_simulator.F90 $
+! 
+! 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_ISCCP_SIMULATOR
+  USE MOD_COSP_CONSTANTS
+  USE MOD_COSP_TYPES
+  IMPLICIT NONE
+
+CONTAINS
+
+
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!-------------- SUBROUTINE COSP_ISCCP_SIMULATOR -----------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+SUBROUTINE COSP_ISCCP_SIMULATOR(gbx,sgx,y)
+  
+  ! Arguments
+  type(cosp_gridbox),intent(in) :: gbx  ! Gridbox info
+  type(cosp_subgrid),intent(in) :: sgx  ! Subgridbox info
+  type(cosp_isccp),intent(inout) :: y   ! ISCCP simulator output
+  
+  ! Local variables 
+  integer :: Nlevels,Npoints
+  real :: pfull(gbx%Npoints, gbx%Nlevels)
+  real :: phalf(gbx%Npoints, gbx%Nlevels + 1)
+  real :: qv(gbx%Npoints, gbx%Nlevels)
+  real :: cc(gbx%Npoints, gbx%Nlevels)
+  real :: conv(gbx%Npoints, gbx%Nlevels)
+  real :: dtau_s(gbx%Npoints, gbx%Nlevels)
+  real :: dtau_c(gbx%Npoints, gbx%Nlevels)
+  real :: at(gbx%Npoints, gbx%Nlevels)
+  real :: dem_s(gbx%Npoints, gbx%Nlevels)
+  real :: dem_c(gbx%Npoints, gbx%Nlevels)
+  real :: frac_out(gbx%Npoints, gbx%Ncolumns, gbx%Nlevels)
+  integer :: sunlit(gbx%Npoints)
+  
+  Nlevels = gbx%Nlevels
+  Npoints = gbx%Npoints
+  ! Flip inputs. Levels from TOA to surface
+  pfull  = gbx%p(:,Nlevels:1:-1) 
+  phalf(:,1)         = 0.0 ! Top level
+  phalf(:,2:Nlevels+1) = gbx%ph(:,Nlevels:1:-1)
+  qv     = gbx%sh(:,Nlevels:1:-1) 
+  cc     = 0.999999*gbx%tca(:,Nlevels:1:-1) 
+  conv   = 0.999999*gbx%cca(:,Nlevels:1:-1) 
+  dtau_s = gbx%dtau_s(:,Nlevels:1:-1) 
+  dtau_c = gbx%dtau_c(:,Nlevels:1:-1) 
+  at     = gbx%T(:,Nlevels:1:-1) 
+  dem_s  = gbx%dem_s(:,Nlevels:1:-1) 
+  dem_c  = gbx%dem_c(:,Nlevels:1:-1) 
+  frac_out(1:Npoints,:,1:Nlevels) = sgx%frac_out(1:Npoints,:,Nlevels:1:-1)
+  sunlit = int(gbx%sunlit)
+  call icarus(0,0,gbx%npoints,sunlit,gbx%nlevels,gbx%ncolumns, &
+            pfull,phalf,qv,cc,conv,dtau_s,dtau_c, &
+            gbx%isccp_top_height,gbx%isccp_top_height_direction, &
+            gbx%isccp_overlap,frac_out, &
+            gbx%skt,gbx%isccp_emsfc_lw,at,dem_s,dem_c,y%fq_isccp,y%totalcldarea, &
+            y%meanptop,y%meantaucld,y%meanalbedocld, &
+            y%meantb,y%meantbclr,y%boxtau,y%boxptop)
+
+  ! Flip outputs. Levels from surface to TOA
+  ! --- (npoints,tau=7,pressure=7)
+  y%fq_isccp(:,:,:) = y%fq_isccp(:,:,7:1:-1)
+     
+ 
+  ! Check if there is any value slightly greater than 1
+  where ((y%totalcldarea > 1.0-1.e-5) .and. (y%totalcldarea < 1.0+1.e-5))
+    y%totalcldarea = 1.0
+  endwhere
+              
+END SUBROUTINE COSP_ISCCP_SIMULATOR
+
+END MODULE MOD_COSP_ISCCP_SIMULATOR
Index: LMDZ6/trunk/libf/phylmd/cosp/mod_cosp_lidar.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/cosp/mod_cosp_lidar.F90	(revision 3233)
+++ LMDZ6/trunk/libf/phylmd/cosp/mod_cosp_lidar.F90	(revision 3233)
@@ -0,0 +1,87 @@
+! (c) British Crown Copyright 2008, the Met Office.
+! All rights reserved.
+! $Revision: 88 $, $Date: 2013-11-13 15:08:38 +0100 (mer. 13 nov. 2013) $
+! $URL: http://cfmip-obs-sim.googlecode.com/svn/stable/v1.4.0/cosp_lidar.F90 $
+! 
+! 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.
+
+!
+! History:
+! Jul 2007 - A. Bodas-Salcedo - Initial version
+! Oct 2008 - S. Bony          - Instructions "Call for large-scale cloud" removed  -> sgx%frac_out is used instead.
+!                               Call lidar_simulator changed (lsca, gbx%cca and depol removed; 
+!                               frac_out changed in sgx%frac_out)
+! Jun 2011 - G. Cesana        - Added betaperp_tot argument
+!
+! 
+MODULE MOD_COSP_LIDAR
+  USE MOD_COSP_CONSTANTS
+  USE MOD_COSP_TYPES
+  IMPLICIT NONE
+
+CONTAINS
+
+
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!------------------- SUBROUTINE COSP_LIDAR ------------------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+SUBROUTINE COSP_LIDAR(gbx,sgx,sghydro,y)
+
+  ! Arguments
+  type(cosp_gridbox),intent(in) :: gbx  ! Gridbox info
+  type(cosp_subgrid),intent(in) :: sgx  ! Subgrid info
+  type(cosp_sghydro),intent(in) :: sghydro  ! Subgrid info for hydrometeors
+  type(cosp_sglidar),intent(inout) :: y ! Subgrid output
+
+  ! Local variables 
+  integer :: i
+  real :: presf(sgx%Npoints, sgx%Nlevels + 1)
+  real,dimension(sgx%Npoints, sgx%Nlevels) :: lsca,mr_ll,mr_li,mr_cl,mr_ci
+  real,dimension(sgx%Npoints, sgx%Nlevels) :: beta_tot,tau_tot
+  real,dimension(sgx%Npoints, sgx%Nlevels) :: betaperp_tot
+  real,dimension(sgx%Npoints, PARASOL_NREFL)  :: refle
+
+  presf(:,1:sgx%Nlevels) = gbx%ph
+  presf(:,sgx%Nlevels + 1) = 0.0
+  lsca = gbx%tca-gbx%cca
+  do i=1,sgx%Ncolumns
+      ! Temporary arrays for simulator call
+      mr_ll(:,:) = sghydro%mr_hydro(:,i,:,I_LSCLIQ)
+      mr_li(:,:) = sghydro%mr_hydro(:,i,:,I_LSCICE)
+      mr_cl(:,:) = sghydro%mr_hydro(:,i,:,I_CVCLIQ)
+      mr_ci(:,:) = sghydro%mr_hydro(:,i,:,I_CVCICE)
+      call lidar_simulator(sgx%Npoints, sgx%Nlevels, 4, PARASOL_NREFL, LIDAR_UNDEF  &
+                 , gbx%p, presf, gbx%T, mr_ll, mr_li, mr_cl, mr_ci &
+                 , gbx%Reff(:,:,I_LSCLIQ), gbx%Reff(:,:,I_LSCICE) &
+                 , gbx%Reff(:,:,I_CVCLIQ), gbx%Reff(:,:,I_CVCICE) &
+                 , gbx%lidar_ice_type, y%beta_mol, beta_tot &
+                 , betaperp_tot, tau_tot, refle )
+
+      y%betaperp_tot(:,i,:) = betaperp_tot(:,:)
+      y%beta_tot(:,i,:) = beta_tot(:,:)
+      y%tau_tot(:,i,:)  = tau_tot(:,:)
+      y%refl(:,i,:)     = refle(:,:)
+  enddo
+
+END SUBROUTINE COSP_LIDAR
+
+END MODULE MOD_COSP_LIDAR
Index: LMDZ6/trunk/libf/phylmd/cosp/mod_cosp_misr_simulator.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/cosp/mod_cosp_misr_simulator.F90	(revision 3233)
+++ LMDZ6/trunk/libf/phylmd/cosp/mod_cosp_misr_simulator.F90	(revision 3233)
@@ -0,0 +1,80 @@
+! (c) British Crown Copyright 2008, the Met Office.
+! All rights reserved.
+! $Revision: 23 $, $Date: 2011-03-31 15:41:37 +0200 (jeu. 31 mars 2011) $
+! $URL: http://cfmip-obs-sim.googlecode.com/svn/stable/v1.4.0/cosp_misr_simulator.F90 $
+! 
+! 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.
+
+!
+! History:
+! Nov 2008 - A. Bodas-Salcedo - Initial version
+!
+!
+
+MODULE MOD_COSP_MISR_SIMULATOR
+  USE MOD_COSP_CONSTANTS
+  USE MOD_COSP_TYPES
+  IMPLICIT NONE
+
+CONTAINS
+
+
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!-------------- SUBROUTINE COSP_MISR_SIMULATOR -----------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+SUBROUTINE COSP_MISR_SIMULATOR(gbx,sgx,y)
+  
+  ! Arguments
+  type(cosp_gridbox),intent(in) :: gbx  ! Gridbox info
+  type(cosp_subgrid),intent(in) :: sgx  ! Subgridbox info
+  type(cosp_misr),intent(inout) :: y    ! MISR simulator output
+  
+  ! Local variables 
+  integer :: Nlevels,Npoints
+  real :: dtau_s(gbx%Npoints, gbx%Nlevels)
+  real :: dtau_c(gbx%Npoints, gbx%Nlevels)
+  real :: at(gbx%Npoints, gbx%Nlevels)
+  real :: frac_out(gbx%Npoints, gbx%Ncolumns, gbx%Nlevels)
+  integer :: sunlit(gbx%Npoints)
+  
+  real :: zfull(gbx%Npoints, gbx%Nlevels) !  height (in meters) of full model levels (i.e. midpoints)
+                                          !  zfull(npoints,1)    is    top level of model
+                                          !  zfull(npoints,nlev) is bottom level of model
+     
+    
+  Nlevels = gbx%Nlevels
+  Npoints = gbx%Npoints
+  ! Levels from TOA to surface
+  zfull  = gbx%zlev(:,Nlevels:1:-1)
+  at     = gbx%T(:,Nlevels:1:-1) 
+  dtau_s = gbx%dtau_s(:,Nlevels:1:-1) 
+  dtau_c = gbx%dtau_c(:,Nlevels:1:-1) 
+  frac_out(1:Npoints,:,1:Nlevels) = sgx%frac_out(1:Npoints,:,Nlevels:1:-1)
+  sunlit = int(gbx%sunlit)
+ 
+  call MISR_simulator(gbx%npoints,gbx%nlevels,gbx%ncolumns,&
+                     sunlit,zfull,at,dtau_s,dtau_c,frac_out, R_UNDEF, &
+                     y%fq_MISR,y%MISR_dist_model_layertops,y%MISR_meanztop,y%MISR_cldarea)
+            
+END SUBROUTINE COSP_MISR_SIMULATOR
+
+END MODULE MOD_COSP_MISR_SIMULATOR
Index: LMDZ6/trunk/libf/phylmd/cosp/mod_cosp_modis_simulator.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/cosp/mod_cosp_modis_simulator.F90	(revision 3233)
+++ LMDZ6/trunk/libf/phylmd/cosp/mod_cosp_modis_simulator.F90	(revision 3233)
@@ -0,0 +1,487 @@
+! (c) 2009, Regents of the Unversity of Colorado
+!   Author: Robert Pincus, Cooperative Institute for Research in the Environmental Sciences
+! All rights reserved.
+! $Revision: 88 $, $Date: 2013-11-13 07:08:38 -0700 (Wed, 13 Nov 2013) $
+! $URL: http://cfmip-obs-sim.googlecode.com/svn/stable/v1.4.0/cosp_modis_simulator.F90 $
+! 
+! 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.
+!
+
+!
+! History:
+!   May 2009 - Robert Pincus - Initial version
+!   Dec 2009 - Robert Pincus - Tiny revisions
+!
+MODULE MOD_COSP_Modis_Simulator
+  USE MOD_COSP_CONSTANTS
+  USE MOD_COSP_TYPES
+  use mod_modis_sim, numModisTauBins      => numTauHistogramBins,      &
+                     numModisPressureBins => numPressureHistogramBins, &
+                     MODIS_TAU      => nominalTauHistogramCenters,     &
+                     MODIS_TAU_BNDS => nominalTauHistogramBoundaries,  &
+                     MODIS_PC       => nominalPressureHistogramCenters, &
+                     MODIS_PC_BNDS  => nominalPressureHistogramBoundaries                     
+  implicit none
+  !------------------------------------------------------------------------------------------------
+  ! Public type
+  !
+  ! Summary statistics from MODIS retrievals
+  type COSP_MODIS
+     ! Dimensions
+     integer :: Npoints   ! Number of gridpoints
+     
+     !
+     ! Grid means; dimension nPoints
+     ! 
+     real, dimension(:),       pointer :: & 
+       Cloud_Fraction_Total_Mean,       Cloud_Fraction_Water_Mean,       Cloud_Fraction_Ice_Mean,       &
+       Cloud_Fraction_High_Mean,        Cloud_Fraction_Mid_Mean,         Cloud_Fraction_Low_Mean,       &
+       Optical_Thickness_Total_Mean,    Optical_Thickness_Water_Mean,    Optical_Thickness_Ice_Mean,    &
+       Optical_Thickness_Total_LogMean, Optical_Thickness_Water_LogMean, Optical_Thickness_Ice_LogMean, &
+                                        Cloud_Particle_Size_Water_Mean,  Cloud_Particle_Size_Ice_Mean,  &
+       Cloud_Top_Pressure_Total_Mean,                                                                   &
+                                        Liquid_Water_Path_Mean,          Ice_Water_Path_Mean
+     !
+     ! Also need the ISCCP-type optical thickness/cloud top pressure histogram
+     !
+     real, dimension(:, :, :), pointer :: Optical_Thickness_vs_Cloud_Top_Pressure
+     real, dimension(:, :, :), pointer :: Optical_Thickness_vs_ReffICE
+     real, dimension(:, :, :), pointer :: Optical_Thickness_vs_ReffLIQ
+  end type COSP_MODIS 
+  
+contains
+  !------------------------------------------------------------------------------------------------
+  subroutine COSP_Modis_Simulator(gridBox, subCols, subcolHydro, isccpSim, modisSim)
+    ! Arguments
+    type(cosp_gridbox), intent(in   ) :: gridBox     ! Gridbox info
+    type(cosp_subgrid), intent(in   ) :: subCols     ! subCol indicators of convective/stratiform 
+    type(cosp_sghydro), intent(in   ) :: subcolHydro ! subcol hydrometeor contens
+    type(cosp_isccp),   intent(in   ) :: isccpSim    ! ISCCP simulator output
+    type(cosp_modis),   intent(  out) :: modisSim    ! MODIS simulator subcol output
+    
+    ! ------------------------------------------------------------
+    ! Local variables 
+    !   Leave space only for sunlit points
+    
+    integer :: nPoints, nSubCols, nLevels, nSunlit, i, j, k
+    
+    ! Grid-mean quanties;  dimensions nPoints, nLevels
+    real, &
+      dimension(count(gridBox%sunlit(:) > 0),                  gridBox%nLevels) :: &
+        temperature, pressureLayers
+    real, &
+      dimension(count(gridBox%sunlit(:) > 0),                  gridBox%nLevels + 1) :: &
+        pressureLevels
+    
+    ! Subcol quantities, dimension nPoints, nSubCols, nLevels 
+    real, &
+      dimension(count(gridBox%sunlit(:) > 0), subCols%nColumns, gridBox%nLevels) :: & 
+        opticalThickness, cloudWater, cloudIce, waterSize, iceSize
+    
+    ! Vertically-integrated subcol quantities; dimensions nPoints, nSubcols 
+    integer, &
+      dimension(count(gridBox%sunlit(:) > 0), subCols%nColumns) :: & 
+        retrievedPhase
+    real, &
+      dimension(count(gridBox%sunlit(:) > 0), subCols%nColumns) :: & 
+        isccpTau, isccpCloudTopPressure, retrievedCloudTopPressure, retrievedTau, retrievedSize  
+    
+    ! Vertically-integrated results
+    real, dimension(count(gridBox%sunlit(:) > 0)) :: & 
+        cfTotal, cfLiquid, cfIce,                &
+        cfHigh,  cfMid,    cfLow,                &
+        meanTauTotal, meanTauLiquid, meanTauIce, &
+        meanLogTauTotal, meanLogTauLiquid, meanLogTauIce , &
+        meanSizeLiquid, meanSizeIce,             &
+        meanCloudTopPressure,                    &
+        meanLiquidWaterPath, meanIceWaterPath
+        
+    real, dimension(count(gridBox%sunlit(:) > 0), numModisTauBins, numModisPressureBins) :: & 
+         jointHistogram
+    real, dimension(count(gridBox%sunlit(:) > 0), numModisTauBins, numMODISReffIceBins) :: & 
+         jointHistogram2
+    real, dimension(count(gridBox%sunlit(:) > 0), numModisTauBins, numMODISReffLiqBins) :: & 
+         jointHistogram3
+    
+    integer, dimension(count(gridBox%sunlit(:) >  0)) :: sunlit
+    integer, dimension(count(gridBox%sunlit(:) <= 0)) :: notSunlit
+    ! ------------------------------------------------------------
+    
+    !
+    ! Are there any sunlit points? 
+    !
+    nSunlit = count(gridBox%sunlit(:) > 0)
+    if(nSunlit > 0) then 
+      nLevels  = gridBox%Nlevels
+      nPoints  = gridBox%Npoints
+      nSubCols = subCols%Ncolumns
+      !
+      ! This is a vector index indicating which points are sunlit
+      !
+      sunlit(:)    = pack((/ (i, i = 1, nPoints ) /), mask =       gridBox%sunlit(:) > 0)
+      notSunlit(:) = pack((/ (i, i = 1, nPoints ) /), mask = .not. gridBox%sunlit(:) > 0)
+               
+      !
+      ! Copy needed quantities, reversing vertical order and removing points with no sunlight 
+      !
+      pressureLevels(:, 1) = 0.0 ! Top of model, following ISCCP sim
+      temperature(:, :)     = gridBox%T (sunlit(:), nLevels:1:-1) 
+      pressureLayers(:, :)  = gridBox%p (sunlit(:), nLevels:1:-1) 
+      pressureLevels(:, 2:) = gridBox%ph(sunlit(:), nLevels:1:-1) 
+      
+      !
+      ! Subcolumn properties - first stratiform cloud...
+      ! 
+      where(subCols%frac_out(sunlit(:), :, :) == I_LSC)
+        !opticalThickness(:, :, :) = & 
+        !               spread(gridBox%dtau_s      (sunlit(:),    :), dim = 2, nCopies = nSubCols)
+        cloudWater(:, :, :) = subcolHydro%mr_hydro(sunlit(:), :, :, I_LSCLIQ)
+        waterSize (:, :, :) = subcolHydro%reff    (sunlit(:), :, :, I_LSCLIQ)
+        cloudIce  (:, :, :) = subcolHydro%mr_hydro(sunlit(:), :, :, I_LSCICE)
+        iceSize   (:, :, :) = subcolHydro%reff    (sunlit(:), :, :, I_LSCICE)
+      elsewhere
+        opticalThickness(:, :, :) = 0.
+        cloudWater      (:, :, :) = 0.
+        cloudIce        (:, :, :) = 0.
+        waterSize       (:, :, :) = 0.
+        iceSize         (:, :, :) = 0.
+      end where 
+
+      ! Loop version of spread above - intrinsic doesn't work on certain platforms. 
+      do k = 1, nLevels
+        do j = 1, nSubCols
+          do i = 1, nSunlit
+            if(subCols%frac_out(sunlit(i), j, k) == I_LSC) then
+              opticalThickness(i, j, k) = gridBox%dtau_s(sunlit(i), k)
+            else
+              opticalThickness(i, j, k) = 0.   
+            end if 
+          end do 
+        end do
+      end do
+
+      !
+      ! .. then add convective cloud...
+      !
+      where(subCols%frac_out(sunlit(:), :, :) == I_CVC) 
+        !opticalThickness(:, :, :) = &
+        !               spread(gridBox%dtau_c(      sunlit(:),    :), dim = 2, nCopies = nSubCols)
+        cloudWater(:, :, :) = subcolHydro%mr_hydro(sunlit(:), :, :, I_CVCLIQ)
+        waterSize (:, :, :) = subcolHydro%reff    (sunlit(:), :, :, I_CVCLIQ)
+        cloudIce  (:, :, :) = subcolHydro%mr_hydro(sunlit(:), :, :, I_CVCICE)
+        iceSize   (:, :, :) = subcolHydro%reff    (sunlit(:), :, :, I_CVCICE)
+      end where
+
+      ! Loop version of spread above - intrinsic doesn't work on certain platforms. 
+      do k = 1, nLevels
+        do j = 1, nSubCols
+          do i = 1, nSunlit
+            if(subCols%frac_out(sunlit(i), j, k) == I_CVC) opticalThickness(i, j, k) = gridBox%dtau_c(sunlit(i), k)
+          end do 
+        end do
+      end do
+
+      !
+      ! Reverse vertical order 
+      !
+      opticalThickness(:, :, :)  = opticalThickness(:, :, nLevels:1:-1)
+      cloudWater      (:, :, :)  = cloudWater      (:, :, nLevels:1:-1)
+      waterSize       (:, :, :)  = waterSize       (:, :, nLevels:1:-1)
+      cloudIce        (:, :, :)  = cloudIce        (:, :, nLevels:1:-1)
+      iceSize         (:, :, :)  = iceSize         (:, :, nLevels:1:-1)
+      
+      isccpTau(:, :)              = isccpSim%boxtau (sunlit(:), :)
+      isccpCloudTopPressure(:, :) = isccpSim%boxptop(sunlit(:), :)
+      
+      do i = 1, nSunlit
+        call modis_L2_simulator(temperature(i, :), pressureLayers(i, :), pressureLevels(i, :),     &
+                                opticalThickness(i, :, :), cloudWater(i, :, :), cloudIce(i, :, :), &
+                                waterSize(i, :, :), iceSize(i, :, :),                       &
+                                isccpTau(i, :), isccpCloudTopPressure(i, :),                &
+                                retrievedPhase(i, :), retrievedCloudTopPressure(i, :),      & 
+                                retrievedTau(i, :), retrievedSize(i, :))
+     end do
+     
+      ! DJS2015: Call L3 modis simulator used by cospv2.0
+     ! call modis_L3_simulator(retrievedPhase,              &
+     !                         retrievedCloudTopPressure,   &
+     !                         retrievedTau, retrievedSize, &
+     !                         cfTotal,         cfLiquid,         cfIce,         &
+     !                         cfHigh,          cfMid,            cfLow,         &
+     !                         meanTauTotal,    meanTauLiquid,    meanTauIce,    &
+     !                         meanLogTauTotal, meanLogTauLiquid, meanLogTauIce, &
+     !                         meanSizeLiquid,   meanSizeIce,   &
+     !                         meanCloudTopPressure,                             &
+     !                         meanLiquidWaterPath, meanIceWaterPath, &
+     !                         jointHistogram)
+     call modis_column(nSunlit,nSubcols,retrievedPhase,retrievedCloudTopPressure,   &
+                        retrievedTau,retrievedSize,cfTotal,cfLiquid,cfIce,cfHigh,    &
+                        cfMid,cfLow,meanTauTotal,meanTauLiquid,meanTauIce,           &
+                        meanLogTauTotal,meanLogTauLiquid,meanLogTauIce,              &
+                        meanSizeLiquid,meanSizeIce,meanCloudTopPressure,             &
+                        meanLiquidWaterPath, meanIceWaterPath,                       &
+                        jointHistogram,jointHistogram2,jointHistogram3)
+      ! DJS2015: END
+      
+      !
+      ! Copy results into COSP structure
+      !
+      modisSim%Cloud_Fraction_Total_Mean(sunlit(:)) = cfTotal(:)
+      modisSim%Cloud_Fraction_Water_Mean(sunlit(:)) = cfLiquid
+      modisSim%Cloud_Fraction_Ice_Mean  (sunlit(:)) = cfIce
+  
+      modisSim%Cloud_Fraction_High_Mean(sunlit(:)) = cfHigh
+      modisSim%Cloud_Fraction_Mid_Mean (sunlit(:)) = cfMid
+      modisSim%Cloud_Fraction_Low_Mean (sunlit(:)) = cfLow
+  
+      modisSim%Optical_Thickness_Total_Mean(sunlit(:)) = meanTauTotal
+      modisSim%Optical_Thickness_Water_Mean(sunlit(:)) = meanTauLiquid
+      modisSim%Optical_Thickness_Ice_Mean  (sunlit(:)) = meanTauIce
+  
+      modisSim%Optical_Thickness_Total_LogMean(sunlit(:)) = meanLogTauTotal
+      modisSim%Optical_Thickness_Water_LogMean(sunlit(:)) = meanLogTauLiquid
+      modisSim%Optical_Thickness_Ice_LogMean  (sunlit(:)) = meanLogTauIce
+  
+      modisSim%Cloud_Particle_Size_Water_Mean(sunlit(:)) = meanSizeLiquid
+      modisSim%Cloud_Particle_Size_Ice_Mean  (sunlit(:)) = meanSizeIce
+  
+      modisSim%Cloud_Top_Pressure_Total_Mean(sunlit(:)) = meanCloudTopPressure
+  
+      modisSim%Liquid_Water_Path_Mean(sunlit(:)) = meanLiquidWaterPath
+      modisSim%Ice_Water_Path_Mean   (sunlit(:)) = meanIceWaterPath
+      
+      modisSim%Optical_Thickness_vs_Cloud_Top_Pressure(sunlit(:), 2:numModisTauBins+1, :) = jointHistogram(:, :, :)
+      modisSim%Optical_Thickness_vs_ReffICE(sunlit(:),2:numModisTauBins+1,:)              = jointHistogram2(:, :, :)
+      modisSim%Optical_Thickness_vs_ReffLIQ(sunlit(:),2:numModisTauBins+1,:)              = jointHistogram3(:, :, :)
+      ! 
+      ! Reorder pressure bins in joint histogram to go from surface to TOA 
+      !
+      modisSim%Optical_Thickness_vs_Cloud_Top_Pressure(:,:,:) = modisSim%Optical_Thickness_vs_Cloud_Top_Pressure(:, :, numModisPressureBins:1:-1)
+      if(nSunlit < nPoints) then 
+        !
+        ! Where it's night and we haven't done the retrievals the values are undefined
+        !
+        modisSim%Cloud_Fraction_Total_Mean(notSunlit(:)) = R_UNDEF
+        modisSim%Cloud_Fraction_Water_Mean(notSunlit(:)) = R_UNDEF
+        modisSim%Cloud_Fraction_Ice_Mean  (notSunlit(:)) = R_UNDEF
+    
+        modisSim%Cloud_Fraction_High_Mean(notSunlit(:)) = R_UNDEF
+        modisSim%Cloud_Fraction_Mid_Mean (notSunlit(:)) = R_UNDEF
+        modisSim%Cloud_Fraction_Low_Mean (notSunlit(:)) = R_UNDEF
+
+        modisSim%Optical_Thickness_Total_Mean(notSunlit(:)) = R_UNDEF
+        modisSim%Optical_Thickness_Water_Mean(notSunlit(:)) = R_UNDEF
+        modisSim%Optical_Thickness_Ice_Mean  (notSunlit(:)) = R_UNDEF
+    
+        modisSim%Optical_Thickness_Total_LogMean(notSunlit(:)) = R_UNDEF
+        modisSim%Optical_Thickness_Water_LogMean(notSunlit(:)) = R_UNDEF
+        modisSim%Optical_Thickness_Ice_LogMean  (notSunlit(:)) = R_UNDEF
+    
+        modisSim%Cloud_Particle_Size_Water_Mean(notSunlit(:)) = R_UNDEF
+        modisSim%Cloud_Particle_Size_Ice_Mean  (notSunlit(:)) = R_UNDEF
+    
+        modisSim%Cloud_Top_Pressure_Total_Mean(notSunlit(:)) = R_UNDEF
+    
+        modisSim%Liquid_Water_Path_Mean(notSunlit(:)) = R_UNDEF
+        modisSim%Ice_Water_Path_Mean   (notSunlit(:)) = R_UNDEF
+  
+        modisSim%Optical_Thickness_vs_Cloud_Top_Pressure(notSunlit(:), :, :) = R_UNDEF
+        modisSim%Optical_Thickness_vs_ReffICE(notSunlit(:), :, :) = R_UNDEF
+        modisSim%Optical_Thickness_vs_ReffLIQ(notSunlit(:), :, :) = R_UNDEF
+      end if 
+    else
+      !
+      ! It's nightime everywhere - everything is undefined
+      !
+      modisSim%Cloud_Fraction_Total_Mean(:) = R_UNDEF
+      modisSim%Cloud_Fraction_Water_Mean(:) = R_UNDEF
+      modisSim%Cloud_Fraction_Ice_Mean  (:) = R_UNDEF
+  
+      modisSim%Cloud_Fraction_High_Mean(:) = R_UNDEF
+      modisSim%Cloud_Fraction_Mid_Mean (:) = R_UNDEF
+      modisSim%Cloud_Fraction_Low_Mean (:) = R_UNDEF
+
+      modisSim%Optical_Thickness_Total_Mean(:) = R_UNDEF
+      modisSim%Optical_Thickness_Water_Mean(:) = R_UNDEF
+      modisSim%Optical_Thickness_Ice_Mean  (:) = R_UNDEF
+  
+      modisSim%Optical_Thickness_Total_LogMean(:) = R_UNDEF
+      modisSim%Optical_Thickness_Water_LogMean(:) = R_UNDEF
+      modisSim%Optical_Thickness_Ice_LogMean  (:) = R_UNDEF
+  
+      modisSim%Cloud_Particle_Size_Water_Mean(:) = R_UNDEF
+      modisSim%Cloud_Particle_Size_Ice_Mean  (:) = R_UNDEF
+  
+      modisSim%Cloud_Top_Pressure_Total_Mean(:) = R_UNDEF
+  
+      modisSim%Liquid_Water_Path_Mean(:) = R_UNDEF
+      modisSim%Ice_Water_Path_Mean   (:) = R_UNDEF
+  
+      modisSim%Optical_Thickness_vs_Cloud_Top_Pressure(:, :, :) = R_UNDEF
+      modisSim%Optical_Thickness_vs_ReffICE(:, :, :) = R_UNDEF
+      modisSim%Optical_Thickness_vs_ReffLIQ(:, :, :) = R_UNDEF
+    end if 
+
+  end subroutine COSP_Modis_Simulator
+  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+  !------------- SUBROUTINE CONSTRUCT_COSP_MODIS ------------------
+  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+  SUBROUTINE CONSTRUCT_COSP_MODIS(cfg, nPoints, x)
+    type(cosp_config), intent(in)  :: cfg ! Configuration options
+    integer,           intent(in)  :: Npoints  ! Number of sampled points
+    type(cosp_MODIS),  intent(out) :: x
+    !
+    ! Allocate minumum storage if simulator not used
+    !
+    if (cfg%LMODIS_sim) then
+      x%nPoints  = nPoints
+    else
+      x%Npoints  = 1
+    endif
+    
+    ! --- Allocate arrays ---
+    allocate(x%Cloud_Fraction_Total_Mean(x%nPoints)) 
+    allocate(x%Cloud_Fraction_Water_Mean(x%nPoints)) 
+    allocate(x%Cloud_Fraction_Ice_Mean(x%nPoints)) 
+    
+    allocate(x%Cloud_Fraction_High_Mean(x%nPoints)) 
+    allocate(x%Cloud_Fraction_Mid_Mean(x%nPoints)) 
+    allocate(x%Cloud_Fraction_Low_Mean(x%nPoints)) 
+    
+    allocate(x%Optical_Thickness_Total_Mean(x%nPoints)) 
+    allocate(x%Optical_Thickness_Water_Mean(x%nPoints)) 
+    allocate(x%Optical_Thickness_Ice_Mean(x%nPoints)) 
+    
+    allocate(x%Optical_Thickness_Total_LogMean(x%nPoints)) 
+    allocate(x%Optical_Thickness_Water_LogMean(x%nPoints)) 
+    allocate(x%Optical_Thickness_Ice_LogMean(x%nPoints)) 
+    
+    allocate(x%Cloud_Particle_Size_Water_Mean(x%nPoints)) 
+    allocate(x%Cloud_Particle_Size_Ice_Mean(x%nPoints)) 
+    
+    allocate(x%Cloud_Top_Pressure_Total_Mean(x%nPoints)) 
+    
+    allocate(x%Liquid_Water_Path_Mean(x%nPoints)) 
+    allocate(x%Ice_Water_Path_Mean(x%nPoints)) 
+      
+    allocate(x%Optical_Thickness_vs_Cloud_Top_Pressure(nPoints, numModisTauBins+1, numModisPressureBins))
+    allocate(x%Optical_Thickness_vs_ReffICE(nPoints, numModisTauBins+1, numModisReffIceBins))
+    allocate(x%Optical_Thickness_vs_ReffLIQ(nPoints, numModisTauBins+1, numModisReffLiqBins))
+    x%Optical_Thickness_vs_Cloud_Top_Pressure(:, :, :) = R_UNDEF
+    x%Optical_Thickness_vs_ReffLIQ(:, :, :) = R_UNDEF
+    x%Optical_Thickness_vs_ReffICE(:, :, :) = R_UNDEF
+
+  END SUBROUTINE CONSTRUCT_COSP_MODIS
+
+  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+  !------------- SUBROUTINE FREE_COSP_MODIS -----------------------
+  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+  SUBROUTINE FREE_COSP_MODIS(x)
+    type(cosp_MODIS),intent(inout) :: x
+    !
+    ! Free space used by cosp_modis variable. 
+    !
+    
+    if(associated(x%Cloud_Fraction_Total_Mean)) deallocate(x%Cloud_Fraction_Total_Mean) 
+    if(associated(x%Cloud_Fraction_Water_Mean)) deallocate(x%Cloud_Fraction_Water_Mean) 
+    if(associated(x%Cloud_Fraction_Ice_Mean  )) deallocate(x%Cloud_Fraction_Ice_Mean) 
+    
+    if(associated(x%Cloud_Fraction_High_Mean)) deallocate(x%Cloud_Fraction_High_Mean) 
+    if(associated(x%Cloud_Fraction_Mid_Mean )) deallocate(x%Cloud_Fraction_Mid_Mean) 
+    if(associated(x%Cloud_Fraction_Low_Mean )) deallocate(x%Cloud_Fraction_Low_Mean) 
+    
+    if(associated(x%Optical_Thickness_Total_Mean)) deallocate(x%Optical_Thickness_Total_Mean) 
+    if(associated(x%Optical_Thickness_Water_Mean)) deallocate(x%Optical_Thickness_Water_Mean) 
+    if(associated(x%Optical_Thickness_Ice_Mean  )) deallocate(x%Optical_Thickness_Ice_Mean) 
+    
+    if(associated(x%Optical_Thickness_Total_LogMean)) deallocate(x%Optical_Thickness_Total_LogMean) 
+    if(associated(x%Optical_Thickness_Water_LogMean)) deallocate(x%Optical_Thickness_Water_LogMean) 
+    if(associated(x%Optical_Thickness_Ice_LogMean  )) deallocate(x%Optical_Thickness_Ice_LogMean) 
+    
+    if(associated(x%Cloud_Particle_Size_Water_Mean)) deallocate(x%Cloud_Particle_Size_Water_Mean) 
+    if(associated(x%Cloud_Particle_Size_Ice_Mean  )) deallocate(x%Cloud_Particle_Size_Ice_Mean) 
+    
+    if(associated(x%Cloud_Top_Pressure_Total_Mean )) deallocate(x%Cloud_Top_Pressure_Total_Mean   ) 
+    
+    if(associated(x%Liquid_Water_Path_Mean)) deallocate(x%Liquid_Water_Path_Mean   ) 
+    if(associated(x%Ice_Water_Path_Mean   )) deallocate(x%Ice_Water_Path_Mean   ) 
+    
+    if(associated(x%Optical_Thickness_vs_Cloud_Top_Pressure)) deallocate(x%Optical_Thickness_vs_Cloud_Top_Pressure   ) 
+    if(associated(x%Optical_Thickness_vs_ReffIce)) deallocate(x%Optical_Thickness_vs_ReffIce) 
+    if(associated(x%Optical_Thickness_vs_ReffLiq)) deallocate(x%Optical_Thickness_vs_ReffLiq) 
+  END SUBROUTINE FREE_COSP_MODIS
+  ! -----------------------------------------------------
+
+  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+  !------------- SUBROUTINE COSP_MODIS_CPSECTION -----------------
+  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+  SUBROUTINE COSP_MODIS_CPSECTION(ix, iy, orig, copy)
+    integer, dimension(2), intent(in) :: ix, iy
+    type(cosp_modis),      intent(in   ) :: orig
+    type(cosp_modis),      intent(  out) :: copy
+    !
+    ! Copy a set of grid points from one cosp_modis variable to another.
+    !   Should test to be sure ix and iy refer to the same number of grid points 
+    !
+    integer :: orig_start, orig_end, copy_start, copy_end
+    
+    orig_start = ix(1); orig_end = ix(2)
+    copy_start = iy(1); copy_end = iy(2) 
+    
+    copy%Cloud_Fraction_Total_Mean(copy_start:copy_end) = orig%Cloud_Fraction_Total_Mean(orig_start:orig_end)
+    copy%Cloud_Fraction_Water_Mean(copy_start:copy_end) = orig%Cloud_Fraction_Water_Mean(orig_start:orig_end)
+    copy%Cloud_Fraction_Ice_Mean  (copy_start:copy_end) = orig%Cloud_Fraction_Ice_Mean  (orig_start:orig_end)
+    
+    copy%Cloud_Fraction_High_Mean(copy_start:copy_end) = orig%Cloud_Fraction_High_Mean(orig_start:orig_end)
+    copy%Cloud_Fraction_Mid_Mean (copy_start:copy_end) = orig%Cloud_Fraction_Mid_Mean (orig_start:orig_end)
+    copy%Cloud_Fraction_Low_Mean (copy_start:copy_end) = orig%Cloud_Fraction_Low_Mean (orig_start:orig_end)
+    
+    copy%Optical_Thickness_Total_Mean(copy_start:copy_end) = orig%Optical_Thickness_Total_Mean(orig_start:orig_end)
+    copy%Optical_Thickness_Water_Mean(copy_start:copy_end) = orig%Optical_Thickness_Water_Mean(orig_start:orig_end)
+    copy%Optical_Thickness_Ice_Mean  (copy_start:copy_end) = orig%Optical_Thickness_Ice_Mean  (orig_start:orig_end)
+    
+    copy%Optical_Thickness_Total_LogMean(copy_start:copy_end) = &
+                                                          orig%Optical_Thickness_Total_LogMean(orig_start:orig_end)
+    copy%Optical_Thickness_Water_LogMean(copy_start:copy_end) = &
+                                                          orig%Optical_Thickness_Water_LogMean(orig_start:orig_end)
+    copy%Optical_Thickness_Ice_LogMean  (copy_start:copy_end) = &
+                                                          orig%Optical_Thickness_Ice_LogMean  (orig_start:orig_end)
+
+    copy%Cloud_Particle_Size_Water_Mean(copy_start:copy_end) = orig%Cloud_Particle_Size_Water_Mean(orig_start:orig_end)
+    copy%Cloud_Particle_Size_Ice_Mean  (copy_start:copy_end) = orig%Cloud_Particle_Size_Ice_Mean  (orig_start:orig_end)
+
+    copy%Cloud_Top_Pressure_Total_Mean(copy_start:copy_end) = orig%Cloud_Top_Pressure_Total_Mean(orig_start:orig_end)
+    
+    copy%Liquid_Water_Path_Mean(copy_start:copy_end) = orig%Liquid_Water_Path_Mean(orig_start:orig_end)
+    copy%Ice_Water_Path_Mean   (copy_start:copy_end) = orig%Ice_Water_Path_Mean  (orig_start:orig_end)
+    
+    copy%Optical_Thickness_vs_Cloud_Top_Pressure(copy_start:copy_end, :, :) = &
+         orig%Optical_Thickness_vs_Cloud_Top_Pressure(orig_start:orig_end, :, :)
+    copy%Optical_Thickness_vs_ReffIce(copy_start:copy_end, :, :) = &
+         orig%Optical_Thickness_vs_ReffIce(orig_start:orig_end, :, :)
+    copy%Optical_Thickness_vs_ReffLiq(copy_start:copy_end, :, :) = &
+         orig%Optical_Thickness_vs_ReffLiq(orig_start:orig_end, :, :)
+
+  END SUBROUTINE COSP_MODIS_CPSECTION
+  ! -----------------------------------------------------
+
+END MODULE MOD_COSP_Modis_Simulator
Index: LMDZ6/trunk/libf/phylmd/cosp/mod_cosp_radar.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/cosp/mod_cosp_radar.F90	(revision 3233)
+++ LMDZ6/trunk/libf/phylmd/cosp/mod_cosp_radar.F90	(revision 3233)
@@ -0,0 +1,193 @@
+! (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_RADAR
+  USE MOD_COSP_CONSTANTS
+  USE MOD_COSP_TYPES
+  USE MOD_COSP_UTILS
+  use radar_simulator_types
+  use array_lib
+  use atmos_lib
+  use format_input
+  IMPLICIT NONE
+
+  INTERFACE
+    subroutine radar_simulator(hp,nprof,ngate,undef, &
+        hgt_matrix,hm_matrix,re_matrix,Np_matrix, &
+        p_matrix,t_matrix,rh_matrix, &
+        Ze_non,Ze_ray,g_to_vol,a_to_vol,dBZe, &
+        g_to_vol_in,g_to_vol_out)
+
+        use m_mrgrnk
+        use array_lib
+        use math_lib
+        use optics_lib
+        use radar_simulator_types
+        implicit none
+
+        ! ----- INPUTS -----  
+        type(class_param) :: hp
+
+        integer, intent(in) :: nprof,ngate
+
+        real undef
+        real*8, dimension(nprof,ngate), intent(in) :: hgt_matrix, p_matrix, &
+            t_matrix,rh_matrix
+        real*8, dimension(hp%nhclass,nprof,ngate), intent(in) :: hm_matrix
+        real*8, dimension(hp%nhclass,nprof,ngate), intent(inout) :: re_matrix
+        real*8, dimension(hp%nhclass,nprof,ngate), intent(inout) :: Np_matrix
+
+        ! ----- OUTPUTS -----
+        real*8, dimension(nprof,ngate), intent(out) :: Ze_non,Ze_ray, &
+            g_to_vol,dBZe,a_to_vol
+        ! ----- OPTIONAL -----
+        real*8, optional, dimension(nprof,ngate) :: &
+            g_to_vol_in,g_to_vol_out
+     end subroutine radar_simulator
+  END INTERFACE
+
+CONTAINS
+
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!------------------- SUBROUTINE COSP_RADAR ------------------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+SUBROUTINE COSP_RADAR(gbx,sgx,sghydro,z)
+  IMPLICIT NONE
+
+  ! Arguments
+  type(cosp_gridbox),intent(inout) :: gbx  ! Gridbox info
+  type(cosp_subgrid),intent(in) :: sgx  ! Subgrid info
+  type(cosp_sghydro),intent(in) :: sghydro  ! Subgrid info for hydrometeors
+  type(cosp_sgradar),intent(inout) :: z ! Output from simulator, subgrid
+
+  ! Local variables 
+  integer :: & 
+  nsizes            ! num of discrete drop sizes
+
+  real*8, dimension(:,:), allocatable :: &
+  g_to_vol ! integrated atten due to gases, r>v (dB)
+
+  real*8, dimension(:,:), allocatable :: &
+  Ze_non, &         ! radar reflectivity withOUT attenuation (dBZ)
+  Ze_ray, &         ! Rayleigh reflectivity (dBZ)
+  h_atten_to_vol, &     ! attenuation by hydromets, radar to vol (dB)
+  g_atten_to_vol, &     ! gaseous atteunation, radar to vol (dB)
+  dBZe, &           ! effective radar reflectivity factor (dBZ)
+  hgt_matrix, &         ! height of hydrometeors (km)
+  t_matrix, &                   !temperature (k)
+  p_matrix, &                   !pressure (hPa)
+  rh_matrix                     !relative humidity (%)
+
+  real*8, dimension(:,:,:), allocatable :: &
+  hm_matrix, &          ! hydrometeor mixing ratio (g kg^-1)
+  re_matrix, &          ! effective radius (microns).   Optional. 0 ==> use Np_matrix or defaults
+  Np_matrix         ! total number concentration (kg^-1).   Optional 0==> use defaults 
+
+  integer, parameter :: one = 1
+  ! logical :: hgt_reversed
+  logical :: hgt_descending
+  integer :: pr,i,j,k,unt,ngate
+
+! ----- main program settings ------
+
+  ! Inputs to Quickbeam
+  allocate(hgt_matrix(gbx%Npoints,gbx%Nlevels),p_matrix(gbx%Npoints,gbx%Nlevels), &
+           t_matrix(gbx%Npoints,gbx%Nlevels),rh_matrix(gbx%Npoints,gbx%Nlevels))
+  allocate(hm_matrix(gbx%Nhydro,gbx%Npoints,gbx%Nlevels))
+  allocate(re_matrix(gbx%Nhydro,gbx%Npoints,gbx%Nlevels))
+  allocate(Np_matrix(gbx%Nhydro,gbx%Npoints,gbx%Nlevels))
+
+  ! Outputs from Quickbeam
+  allocate(Ze_non(gbx%Npoints,gbx%Nlevels))
+  allocate(Ze_ray(gbx%Npoints,gbx%Nlevels))
+  allocate(h_atten_to_vol(gbx%Npoints,gbx%Nlevels))
+  allocate(g_atten_to_vol(gbx%Npoints,gbx%Nlevels))
+  allocate(dBZe(gbx%Npoints,gbx%Nlevels))
+
+  ! Optional argument. It is computed and returned in the first call to
+  ! radar_simulator, and passed as input in the rest
+  allocate(g_to_vol(gbx%Npoints,gbx%Nlevels))
+
+  ! Even if there is no unit conversion, they are needed for type conversion
+  p_matrix   = gbx%p/100.0     ! From Pa to hPa
+  hgt_matrix = gbx%zlev/1000.0 ! From m to km
+  t_matrix   = gbx%T
+  rh_matrix  = gbx%q
+  re_matrix  = 0.0
+
+
+  ! set flag denoting position of radar relative to hgt_matrix orientation
+	  ngate = size(hgt_matrix,2)
+
+	  hgt_descending = hgt_matrix(1,1) > hgt_matrix(1,ngate)
+
+	  if ( &
+	     (gbx%surface_radar == 1 .and. hgt_descending) .or.  &
+	     (gbx%surface_radar == 0 .and. (.not. hgt_descending)) &
+	     ) &
+	  then
+	    gbx%hp%radar_at_layer_one = .false.
+	  else
+	    gbx%hp%radar_at_layer_one = .true.
+	  endif
+
+  ! ----- loop over subcolumns -----
+  do pr=1,sgx%Ncolumns
+
+      !  NOTE:
+      !  atmospheric profiles are the same within the same gridbox
+      !  only hydrometeor profiles will be different for each subgridbox
+
+         do i=1,gbx%Nhydro
+            hm_matrix(i,:,:) = sghydro%mr_hydro(:,pr,:,i)*1000.0 ! Units from kg/kg to g/kg
+            if (gbx%use_reff) then
+              re_matrix(i,:,:) = sghydro%Reff(:,pr,:,i)*1.e6       ! Units from m to micron
+              Np_matrix(i,:,:) = sghydro%Np(:,pr,:,i)              ! Units [#/kg]
+            endif
+         enddo
+
+      !   ----- call radar simulator -----
+      if (pr == 1) then ! Compute gaseous attenuation for all profiles
+         call radar_simulator(gbx%hp,gbx%Npoints,gbx%Nlevels,R_UNDEF, &
+           hgt_matrix,hm_matrix,re_matrix,Np_matrix, &
+           p_matrix,t_matrix,rh_matrix, &
+           Ze_non,Ze_ray,h_atten_to_vol,g_atten_to_vol,dBZe,g_to_vol_out=g_to_vol)
+      else ! Use gaseous atteunuation for pr = 1
+         call radar_simulator(gbx%hp,gbx%Npoints,gbx%Nlevels,R_UNDEF, &
+           hgt_matrix,hm_matrix,re_matrix,Np_matrix, &
+           p_matrix,t_matrix,rh_matrix, &
+           Ze_non,Ze_ray,h_atten_to_vol,g_atten_to_vol,dBZe,g_to_vol_in=g_to_vol)
+      endif
+
+      ! store caluculated dBZe values for later output/processing
+      z%Ze_tot(:,pr,:)=dBZe(:,:)
+  enddo !pr
+
+  deallocate(hgt_matrix,p_matrix,t_matrix,rh_matrix)
+  deallocate(hm_matrix,re_matrix, &
+      Ze_non,Ze_ray,h_atten_to_vol,g_atten_to_vol,dBZe)
+  deallocate(g_to_vol)
+END SUBROUTINE COSP_RADAR
+
+END MODULE MOD_COSP_RADAR
Index: LMDZ6/trunk/libf/phylmd/cosp/mod_cosp_simulator.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/cosp/mod_cosp_simulator.F90	(revision 3233)
+++ LMDZ6/trunk/libf/phylmd/cosp/mod_cosp_simulator.F90	(revision 3233)
@@ -0,0 +1,247 @@
+! (c) British Crown Copyright 2008, the Met Office.
+! All rights reserved.
+! $Revision: 88 $, $Date: 2013-11-13 15:08:38 +0100 (mer. 13 nov. 2013) $
+! $URL: http://cfmip-obs-sim.googlecode.com/svn/stable/v1.4.0/cosp_simulator.F90 $
+! 
+! 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.
+
+!
+! History:
+! Jul 2007 - A. Bodas-Salcedo - Initial version
+! Jan 2013 - G. Cesana - Add new variables linked to the lidar cloud phase 
+!
+
+#include "cosp_defs.h" 
+MODULE MOD_COSP_SIMULATOR
+  USE MOD_COSP_CONSTANTS, ONLY: I_RADAR, I_LIDAR, I_ISCCP, I_MISR, I_MODIS, &
+                                I_RTTOV, I_STATS, tsim
+  USE MOD_COSP_TYPES
+  USE MOD_COSP_RADAR
+  USE MOD_COSP_LIDAR
+  USE MOD_COSP_ISCCP_SIMULATOR
+  USE MOD_COSP_MODIS_SIMULATOR
+  USE MOD_COSP_MISR_SIMULATOR
+!#ifdef RTTOV
+!  USE MOD_COSP_RTTOV_SIMULATOR
+!#endif
+  USE MOD_COSP_STATS
+  IMPLICIT NONE
+
+CONTAINS
+
+
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!--------------------- SUBROUTINE COSP_SIMULATOR ------------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!#ifdef RTTOV
+!SUBROUTINE COSP_SIMULATOR(gbx,sgx,sghydro,cfg,vgrid,sgradar,sglidar,isccp,misr,modis,rttov,stradar,stlidar)
+!#else
+SUBROUTINE COSP_SIMULATOR(gbx,sgx,sghydro,cfg,vgrid,sgradar,sglidar,isccp,misr,modis,stradar,stlidar)
+!#endif
+
+  ! Arguments
+  type(cosp_gridbox),intent(inout) :: gbx      ! Grid-box inputs
+  type(cosp_subgrid),intent(in) :: sgx      ! Subgrid inputs
+  type(cosp_sghydro),intent(in) :: sghydro  ! Subgrid info for hydrometeors
+  type(cosp_config),intent(in)  :: cfg      ! Configuration options
+  type(cosp_vgrid),intent(in)   :: vgrid    ! Information on vertical grid of stats
+  type(cosp_sgradar),intent(inout) :: sgradar ! Output from radar simulator
+  type(cosp_sglidar),intent(inout) :: sglidar ! Output from lidar simulator
+  type(cosp_isccp),intent(inout)   :: isccp   ! Output from ISCCP simulator
+  type(cosp_misr),intent(inout)    :: misr    ! Output from MISR simulator
+  type(cosp_modis),intent(inout)   :: modis   ! Output from MODIS simulator
+!#ifdef RTTOV
+!  type(cosp_rttov),intent(inout)    :: rttov    ! Output from RTTOV
+!#endif
+  type(cosp_radarstats),intent(inout) :: stradar ! Summary statistics from radar simulator
+  type(cosp_lidarstats),intent(inout) :: stlidar ! Summary statistics from lidar simulator
+  ! Local variables
+  integer :: i,j,k,isim
+  logical :: inconsistent
+  ! Timing variables
+  integer :: t0,t1
+
+  t0 = 0
+  t1 = 0
+
+  inconsistent=.false.
+!   do k=1,gbx%Nhydro
+!   do j=1,gbx%Nlevels
+!   do i=1,gbx%Npoints
+!     if ((gbx%mr_hydro(i,j,k)>0.0).and.(gbx%Reff(i,j,k)<=0.0)) inconsistent=.true.
+!   enddo
+!   enddo
+!   enddo
+!  if (inconsistent)  print *, '%%%% COSP_SIMULATOR: inconsistency in mr_hydro and Reff'
+
+
+  !+++++++++ Radar model ++++++++++
+  isim = I_RADAR
+  if (cfg%Lradar_sim) then
+    call system_clock(t0)
+    call cosp_radar(gbx,sgx,sghydro,sgradar)
+    call system_clock(t1)
+    tsim(isim) = tsim(isim) + (t1 -t0)
+  endif
+
+  !+++++++++ Lidar model ++++++++++
+  isim = I_LIDAR
+  if (cfg%Llidar_sim) then
+    call system_clock(t0)
+    call cosp_lidar(gbx,sgx,sghydro,sglidar)
+    call system_clock(t1)
+    tsim(isim) = tsim(isim) + (t1 -t0)
+  endif
+
+  !+++++++++ ISCCP simulator ++++++++++
+  isim = I_ISCCP
+  if (cfg%Lisccp_sim) then
+    call system_clock(t0)
+    call cosp_isccp_simulator(gbx,sgx,isccp)
+    call system_clock(t1)
+    tsim(isim) = tsim(isim) + (t1 -t0)
+  endif
+
+  !+++++++++ MISR simulator ++++++++++
+  isim = I_MISR
+  if (cfg%Lmisr_sim) then
+    call system_clock(t0)
+    call cosp_misr_simulator(gbx,sgx,misr)
+    call system_clock(t1)
+    tsim(isim) = tsim(isim) + (t1 -t0)
+  endif
+
+  !+++++++++ MODIS simulator ++++++++++
+  isim = I_MODIS
+  if (cfg%Lmodis_sim) then
+    call system_clock(t0)
+    call cosp_modis_simulator(gbx,sgx,sghydro,isccp, modis)
+    call system_clock(t1)
+    tsim(isim) = tsim(isim) + (t1 -t0)
+  endif
+
+  !+++++++++ RTTOV ++++++++++ 
+  isim = I_RTTOV
+!#ifdef RTTOV
+!  if (cfg%Lrttov_sim) then 
+!    call system_clock(t0)
+!    call cosp_rttov_simulator(gbx,rttov)
+!    call system_clock(t1)
+!    tsim(isim) = tsim(isim) + (t1 -t0)
+!  endif
+!#endif
+
+  !+++++++++++ Summary statistics +++++++++++
+  isim = I_STATS
+  if (cfg%Lstats) then
+    call system_clock(t0)
+    call cosp_stats(gbx,sgx,cfg,sgradar,sglidar,vgrid,stradar,stlidar)
+    call system_clock(t1)
+    tsim(isim) = tsim(isim) + (t1 -t0)
+  endif
+
+  !+++++++++++ Change of units after computation of statistics +++++++++++
+  ! This avoids using UDUNITS in CMOR
+
+  ! Cloud fractions from 1 to %
+!  if (cfg%Lclcalipso) then
+!    where(stlidar%lidarcld /= R_UNDEF) stlidar%lidarcld = stlidar%lidarcld*100.0
+!  endif
+!  if (cfg%Lcltcalipso.OR.cfg%Lcllcalipso.OR.cfg%Lclmcalipso.OR.cfg%Lclhcalipso) then
+!    where(stlidar%cldlayer /= R_UNDEF) stlidar%cldlayer = stlidar%cldlayer*100.0
+!  endif
+  if (cfg%Lclcalipso2) then
+    where(stradar%lidar_only_freq_cloud /= R_UNDEF) stradar%lidar_only_freq_cloud = stradar%lidar_only_freq_cloud*100.0
+  endif
+
+  if (cfg%Lcltcalipsoliq.OR.cfg%Lcllcalipsoliq.OR.cfg%Lclmcalipsoliq.OR.cfg%Lclhcalipsoliq.OR. &
+      cfg%Lcltcalipsoice.OR.cfg%Lcllcalipsoice.OR.cfg%Lclmcalipsoice.OR.cfg%Lclhcalipsoice.OR. &
+      cfg%Lcltcalipsoun.OR.cfg%Lcllcalipsoun.OR.cfg%Lclmcalipsoun.OR.cfg%Lclhcalipsoun ) then
+    where(stlidar%cldlayerphase /= R_UNDEF) stlidar%cldlayerphase = stlidar%cldlayerphase*100.0
+  endif
+  if (cfg%Lclcalipsoliq.OR.cfg%Lclcalipsoice.OR.cfg%Lclcalipsoun) then
+    where(stlidar%lidarcldphase /= R_UNDEF) stlidar%lidarcldphase = stlidar%lidarcldphase*100.0
+  endif
+  if (cfg%Lclcalipsotmp.OR.cfg%Lclcalipsotmpliq.OR.cfg%Lclcalipsotmpice.OR.cfg%Lclcalipsotmpun) then
+    where(stlidar%lidarcldtmp /= R_UNDEF) stlidar%lidarcldtmp = stlidar%lidarcldtmp*100.0
+  endif
+
+  if (cfg%Lcltisccp) then
+     where(isccp%totalcldarea /= R_UNDEF) isccp%totalcldarea = isccp%totalcldarea*100.0
+  endif  
+  if (cfg%Lclisccp) then
+    where(isccp%fq_isccp /= R_UNDEF) isccp%fq_isccp = isccp%fq_isccp*100.0
+  endif
+
+  if (cfg%LclMISR) then
+    where(misr%fq_MISR /= R_UNDEF) misr%fq_MISR = misr%fq_MISR*100.0
+  endif
+
+  if (cfg%Lcltlidarradar) then
+    where(stradar%radar_lidar_tcc /= R_UNDEF) stradar%radar_lidar_tcc = stradar%radar_lidar_tcc*100.0
+  endif
+
+  if (cfg%Lclmodis) then
+    where(modis%Optical_Thickness_vs_Cloud_Top_Pressure /= R_UNDEF) modis%Optical_Thickness_vs_Cloud_Top_Pressure = &
+                                                      modis%Optical_Thickness_vs_Cloud_Top_Pressure*100.0
+  endif
+  if (cfg%Lcrimodis) then
+     where(modis%Optical_Thickness_vs_ReffICE /= R_UNDEF) modis%Optical_Thickness_vs_ReffICE = &
+                                                      modis%Optical_Thickness_vs_ReffICE*100.0
+  endif
+  if (cfg%Lcrlmodis) then
+     where(modis%Optical_Thickness_vs_ReffLIQ /= R_UNDEF) modis%Optical_Thickness_vs_ReffLIQ = &
+                                                      modis%Optical_Thickness_vs_ReffLIQ*100.0
+  endif
+
+  if (cfg%Lcltmodis) then
+    where(modis%Cloud_Fraction_Total_Mean /= R_UNDEF) modis%Cloud_Fraction_Total_Mean = modis%Cloud_Fraction_Total_Mean*100.0
+  endif
+  if (cfg%Lclwmodis) then
+     where(modis%Cloud_Fraction_Water_Mean /= R_UNDEF) modis%Cloud_Fraction_Water_Mean = modis%Cloud_Fraction_Water_Mean*100.0
+  endif
+  if (cfg%Lclimodis) then
+     where(modis%Cloud_Fraction_Ice_Mean /= R_UNDEF) modis%Cloud_Fraction_Ice_Mean = modis%Cloud_Fraction_Ice_Mean*100.0
+  endif
+
+  if (cfg%Lclhmodis) then
+     where(modis%Cloud_Fraction_High_Mean /= R_UNDEF) modis%Cloud_Fraction_High_Mean = modis%Cloud_Fraction_High_Mean*100.0
+  endif
+  if (cfg%Lclmmodis) then
+     where(modis%Cloud_Fraction_Mid_Mean /= R_UNDEF) modis%Cloud_Fraction_Mid_Mean = modis%Cloud_Fraction_Mid_Mean*100.0
+  endif
+  if (cfg%Lcllmodis) then
+     where(modis%Cloud_Fraction_Low_Mean /= R_UNDEF) modis%Cloud_Fraction_Low_Mean = modis%Cloud_Fraction_Low_Mean*100.0
+  endif
+
+  ! Change pressure from hPa to Pa.
+  if (cfg%Lboxptopisccp) then
+    where(isccp%boxptop /= R_UNDEF) isccp%boxptop = isccp%boxptop*100.0
+  endif
+  if (cfg%Lpctisccp) then
+    where(isccp%meanptop /= R_UNDEF) isccp%meanptop = isccp%meanptop*100.0
+  endif
+
+
+END SUBROUTINE COSP_SIMULATOR
+
+END MODULE MOD_COSP_SIMULATOR
Index: LMDZ6/trunk/libf/phylmd/cosp/mod_cosp_stats.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/cosp/mod_cosp_stats.F90	(revision 3233)
+++ LMDZ6/trunk/libf/phylmd/cosp/mod_cosp_stats.F90	(revision 3233)
@@ -0,0 +1,304 @@
+! (c) British Crown Copyright 2008, the Met Office.
+! All rights reserved.
+! $Revision: 88 $, $Date: 2013-11-13 15:08:38 +0100 (mer. 13 nov. 2013) $
+! $URL: http://cfmip-obs-sim.googlecode.com/svn/stable/v1.4.0/cosp_stats.F90 $
+!
+! 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.
+
+!
+! History:
+! Jul 2007 - A. Bodas-Salcedo - Initial version
+! Jul 2008 - A. Bodas-Salcedo - Added capability of producing outputs in standard grid
+! Oct 2008 - J.-L. Dufresne   - Bug fixed. Assignment of Npoints,Nlevels,Nhydro,Ncolumns in COSP_STATS
+! Oct 2008 - H. Chepfer       - Added PARASOL reflectance arguments
+! Jun 2010 - T. Yokohata, T. Nishimura and K. Ogochi - Added NEC SXs optimisations
+! Jan 2013 - G. Cesana        - Added betaperp and temperature arguments 
+!                             - Added phase 3D/3Dtemperature/Map output variables in diag_lidar 
+!
+!
+#include "cosp_defs.h" 
+MODULE MOD_COSP_STATS
+  USE MOD_COSP_CONSTANTS
+  USE MOD_COSP_TYPES
+  USE MOD_LLNL_STATS
+  USE MOD_LMD_IPSL_STATS
+  IMPLICIT NONE
+
+CONTAINS
+
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!------------------- SUBROUTINE COSP_STATS ------------------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+SUBROUTINE COSP_STATS(gbx,sgx,cfg,sgradar,sglidar,vgrid,stradar,stlidar)
+
+   ! Input arguments
+   type(cosp_gridbox),intent(in) :: gbx
+   type(cosp_subgrid),intent(in) :: sgx
+   type(cosp_config),intent(in)  :: cfg
+   type(cosp_sgradar),intent(in) :: sgradar
+   type(cosp_sglidar),intent(in) :: sglidar
+   type(cosp_vgrid),intent(in)   :: vgrid
+   ! Output arguments
+   type(cosp_radarstats),intent(inout) :: stradar ! Summary statistics for radar
+   type(cosp_lidarstats),intent(inout) :: stlidar ! Summary statistics for lidar
+
+   ! Local variables
+   integer :: Npoints  !# of grid points
+   integer :: Nlevels  !# of levels
+   integer :: Nhydro   !# of hydrometeors
+   integer :: Ncolumns !# of columns
+   integer :: Nlr
+   logical :: ok_lidar_cfad = .false.
+   real,dimension(:,:,:),allocatable :: Ze_out,betatot_out,betamol_in,betamol_out,ph_in,ph_out
+   real,dimension(:,:),allocatable :: ph_c,betamol_c
+   real,dimension(:,:,:),allocatable ::  betaperptot_out, temp_in, temp_out 
+   real,dimension(:,:),allocatable :: temp_c
+
+   Npoints  = gbx%Npoints
+   Nlevels  = gbx%Nlevels
+   Nhydro   = gbx%Nhydro
+   Ncolumns = gbx%Ncolumns
+   Nlr      = vgrid%Nlvgrid
+
+   if (cfg%LcfadLidarsr532) ok_lidar_cfad=.true.
+
+   if (vgrid%use_vgrid) then ! Statistics in a different vertical grid
+        allocate(Ze_out(Npoints,Ncolumns,Nlr),betatot_out(Npoints,Ncolumns,Nlr), &
+                 betamol_in(Npoints,1,Nlevels),betamol_out(Npoints,1,Nlr),betamol_c(Npoints,Nlr), &
+                 ph_in(Npoints,1,Nlevels),ph_out(Npoints,1,Nlr),ph_c(Npoints,Nlr))
+        Ze_out = 0.0
+        betatot_out  = 0.0
+        betamol_out= 0.0
+        betamol_c  = 0.0
+        ph_in(:,1,:)  = gbx%ph(:,:)
+        ph_out  = 0.0
+        ph_c    = 0.0
+        allocate(betaperptot_out(Npoints,Ncolumns,Nlr),temp_in(Npoints,1,Nlevels),temp_out(Npoints,1,Nlr), &
+                 temp_c(Npoints,Nlr))
+        betaperptot_out = 0.0
+        temp_in = 0.0
+        temp_out = 0.0
+        temp_c = 0.0
+
+        !++++++++++++ Radar CFAD ++++++++++++++++
+        if (cfg%Lradar_sim) then
+            call cosp_change_vertical_grid(Npoints,Ncolumns,Nlevels,gbx%zlev,gbx%zlev_half,sgradar%Ze_tot, &
+                                           Nlr,vgrid%zl,vgrid%zu,Ze_out,log_units=.true.)
+            stradar%cfad_ze = cosp_cfad(Npoints,Ncolumns,Nlr,DBZE_BINS,Ze_out, &
+                                        DBZE_MIN,DBZE_MAX,CFAD_ZE_MIN,CFAD_ZE_WIDTH)
+        endif
+        !++++++++++++ Lidar CFAD ++++++++++++++++
+        if (cfg%Llidar_sim) then
+            betamol_in(:,1,:) = sglidar%beta_mol(:,:)
+            call cosp_change_vertical_grid(Npoints,1,Nlevels,gbx%zlev,gbx%zlev_half,betamol_in, &
+                                           Nlr,vgrid%zl,vgrid%zu,betamol_out)
+            call cosp_change_vertical_grid(Npoints,Ncolumns,Nlevels,gbx%zlev,gbx%zlev_half,sglidar%beta_tot, &
+                                           Nlr,vgrid%zl,vgrid%zu,betatot_out)
+
+            temp_in(:,1,:) = gbx%T(:,:)
+            call cosp_change_vertical_grid(Npoints,Ncolumns,Nlevels,gbx%zlev,gbx%zlev_half,sglidar%betaperp_tot, &
+                                           Nlr,vgrid%zl,vgrid%zu,betaperptot_out)
+            call cosp_change_vertical_grid(Npoints,1,Nlevels,gbx%zlev,gbx%zlev_half,temp_in, &
+                                           Nlr,vgrid%zl,vgrid%zu,temp_out)
+            temp_c(:,:) = temp_out(:,1,:)
+            stlidar%proftemp = temp_c                                     !TIBO
+            where (stlidar%proftemp  < 150.) stlidar%proftemp   = R_UNDEF !TIBO
+            where (stlidar%proftemp  > 350.) stlidar%proftemp   = R_UNDEF !TIBO
+
+            call cosp_change_vertical_grid(Npoints,1,Nlevels,gbx%zlev,gbx%zlev_half,ph_in, &
+                                           Nlr,vgrid%zl,vgrid%zu,ph_out)
+            ph_c(:,:) = ph_out(:,1,:)
+            betamol_c(:,:) = betamol_out(:,1,:)
+            ! Stats from lidar_stat_summary
+            call diag_lidar(Npoints,Ncolumns,Nlr,SR_BINS,PARASOL_NREFL &
+                            ,temp_c,betatot_out,betaperptot_out,betamol_c,sglidar%refl,gbx%land,ph_c &
+                            ,LIDAR_UNDEF,ok_lidar_cfad &
+                            ,stlidar%cfad_sr,stlidar%srbval &
+                            ,LIDAR_NCAT,LIDAR_NTYPE,stlidar%lidarcld,stlidar%lidarcldtype & !OPAQ
+                            ,stlidar%lidarcldphase,stlidar%cldlayer,stlidar%cldtype &       !OPAQ
+                            ,stlidar%cldlayerphase,stlidar%lidarcldtmp &                    !OPAQ
+                            ,stlidar%parasolrefl,vgrid%z,stlidar%profSR)                    !OPAQ !TIBO
+        endif
+
+        !++++++++++++ Lidar-only cloud amount and lidar&radar total cloud mount ++++++++++++++++
+        if (cfg%Lradar_sim.and.cfg%Llidar_sim) call cosp_lidar_only_cloud(Npoints,Ncolumns,Nlr, &
+                                    temp_c,betatot_out,betaperptot_out,betamol_c,Ze_out, &
+                                    stradar%lidar_only_freq_cloud,stradar%radar_lidar_tcc)
+        deallocate(temp_in,temp_out,temp_c,betaperptot_out) !TIBO +temp_in
+
+        ! Deallocate arrays at coarse resolution
+        deallocate(Ze_out,betatot_out,betamol_in,betamol_out,betamol_c,ph_in,ph_out,ph_c)
+   else ! Statistics in model levels
+        !++++++++++++ Radar CFAD ++++++++++++++++
+        if (cfg%Lradar_sim) stradar%cfad_ze = cosp_cfad(Npoints,Ncolumns,Nlr,DBZE_BINS,sgradar%Ze_tot, &
+                                        DBZE_MIN,DBZE_MAX,CFAD_ZE_MIN,CFAD_ZE_WIDTH)
+        !++++++++++++ Lidar CFAD ++++++++++++++++
+        ! Stats from lidar_stat_summary
+        if (cfg%Llidar_sim) call diag_lidar(Npoints,Ncolumns,Nlr,SR_BINS,PARASOL_NREFL &
+                        ,sglidar%temp_tot,sglidar%beta_tot,sglidar%betaperp_tot,sglidar%beta_mol,sglidar%refl,gbx%land,gbx%ph &
+                        ,LIDAR_UNDEF,ok_lidar_cfad &
+                        ,stlidar%cfad_sr,stlidar%srbval &
+                        ,LIDAR_NCAT,LIDAR_NTYPE,stlidar%lidarcld,stlidar%lidarcldtype & !OPAQ
+                        ,stlidar%lidarcldphase,stlidar%cldlayer,stlidar%cldtype &       !OPAQ
+                        ,stlidar%cldlayerphase,stlidar%lidarcldtmp &                    !OPAQ
+                        ,stlidar%parasolrefl,vgrid%z,stlidar%profSR)                    !OPAQ !TIBO
+        !++++++++++++ Lidar-only cloud amount and lidar&radar total cloud mount ++++++++++++++++
+        if (cfg%Lradar_sim.and.cfg%Llidar_sim) call cosp_lidar_only_cloud(Npoints,Ncolumns,Nlr, &
+                                    sglidar%temp_tot,sglidar%beta_tot,sglidar%betaperp_tot,sglidar%beta_mol,sgradar%Ze_tot, &
+                                    stradar%lidar_only_freq_cloud,stradar%radar_lidar_tcc)
+   endif
+   ! Replace undef
+   where (stlidar%cfad_sr   == LIDAR_UNDEF) stlidar%cfad_sr   = R_UNDEF
+   where (stlidar%profSR   == LIDAR_UNDEF) stlidar%profSR   = R_UNDEF !TIBO
+   where (stlidar%lidarcld  == LIDAR_UNDEF) stlidar%lidarcld  = R_UNDEF
+   where (stlidar%lidarcldtype  == LIDAR_UNDEF) stlidar%lidarcldtype  = R_UNDEF !OPAQ
+   where (stlidar%cldlayer  == LIDAR_UNDEF) stlidar%cldlayer  = R_UNDEF
+   where (stlidar%cldtype  == LIDAR_UNDEF) stlidar%cldtype  = R_UNDEF           !OPAQ
+   where (stlidar%parasolrefl == LIDAR_UNDEF) stlidar%parasolrefl = R_UNDEF
+   where (stlidar%cldlayerphase  == LIDAR_UNDEF) stlidar%cldlayerphase  = R_UNDEF
+   where (stlidar%lidarcldphase  == LIDAR_UNDEF) stlidar%lidarcldphase  = R_UNDEF
+   where (stlidar%lidarcldtmp  == LIDAR_UNDEF) stlidar%lidarcldtmp  = R_UNDEF
+
+END SUBROUTINE COSP_STATS
+
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!---------- SUBROUTINE COSP_CHANGE_VERTICAL_GRID ----------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+SUBROUTINE COSP_CHANGE_VERTICAL_GRID(Npoints,Ncolumns,Nlevels,zfull,zhalf,y,Nglevels,newgrid_bot,newgrid_top,r,log_units)
+   implicit none
+   ! Input arguments
+   integer,intent(in) :: Npoints  !# of grid points
+   integer,intent(in) :: Nlevels  !# of levels
+   integer,intent(in) :: Ncolumns !# of columns
+   real,dimension(Npoints,Nlevels),intent(in) :: zfull ! Height at model levels [m] (Bottom of model layer)
+   real,dimension(Npoints,Nlevels),intent(in) :: zhalf ! Height at half model levels [m] (Bottom of model layer)
+   real,dimension(Npoints,Ncolumns,Nlevels),intent(in) :: y     ! Variable to be changed to a different grid
+   integer,intent(in) :: Nglevels  !# levels in the new grid
+   real,dimension(Nglevels),intent(in) :: newgrid_bot ! Lower boundary of new levels  [m]
+   real,dimension(Nglevels),intent(in) :: newgrid_top ! Upper boundary of new levels  [m]
+   logical,optional,intent(in) :: log_units ! log units, need to convert to linear units
+   ! Output
+   real,dimension(Npoints,Ncolumns,Nglevels),intent(out) :: r ! Variable on new grid
+
+   ! Local variables
+   integer :: i,j,k
+   logical :: lunits
+   integer :: l
+   real :: w ! Weight
+   real :: dbb, dtb, dbt, dtt ! Distances between edges of both grids
+   integer :: Nw  ! Number of weights
+   real :: wt  ! Sum of weights
+   real,dimension(Nlevels) :: oldgrid_bot,oldgrid_top ! Lower and upper boundaries of model grid
+   real :: yp ! Local copy of y at a particular point.
+              ! This allows for change of units.
+
+   lunits=.false.
+   if (present(log_units)) lunits=log_units
+
+   r = 0.0
+
+   do i=1,Npoints
+     ! Calculate tops and bottoms of new and old grids
+     oldgrid_bot = zhalf(i,:)
+     oldgrid_top(1:Nlevels-1) = oldgrid_bot(2:Nlevels)
+     oldgrid_top(Nlevels) = zfull(i,Nlevels) +  zfull(i,Nlevels) - zhalf(i,Nlevels) ! Top level symmetric
+     l = 0 ! Index of level in the old grid
+     ! Loop over levels in the new grid
+     do k = 1,Nglevels
+       Nw = 0 ! Number of weigths
+       wt = 0.0 ! Sum of weights
+       ! Loop over levels in the old grid and accumulate total for weighted average
+       do
+         l = l + 1
+         w = 0.0 ! Initialise weight to 0
+         ! Distances between edges of both grids
+         dbb = oldgrid_bot(l) - newgrid_bot(k)
+         dtb = oldgrid_top(l) - newgrid_bot(k)
+         dbt = oldgrid_bot(l) - newgrid_top(k)
+         dtt = oldgrid_top(l) - newgrid_top(k)
+         if (dbt >= 0.0) exit ! Do next level in the new grid
+         if (dtb > 0.0) then
+           if (dbb <= 0.0) then
+             if (dtt <= 0) then
+               w = dtb
+             else
+               w = newgrid_top(k) - newgrid_bot(k)
+             endif
+           else
+             if (dtt <= 0) then
+               w = oldgrid_top(l) - oldgrid_bot(l)
+             else
+               w = -dbt
+             endif
+           endif
+           ! If layers overlap (w/=0), then accumulate
+           if (w /= 0.0) then
+             Nw = Nw + 1
+             wt = wt + w
+             do j=1,Ncolumns
+               if (lunits) then
+                 if (y(i,j,l) /= R_UNDEF) then
+                   yp = 10.0**(y(i,j,l)/10.0)
+                 else
+                   yp = 0.0
+                 endif
+               else
+                 yp = y(i,j,l)
+               endif
+               r(i,j,k) = r(i,j,k) + w*yp
+             enddo
+           endif
+         endif
+       enddo
+       l = l - 2
+       if (l < 1) l = 0
+       ! Calculate average in new grid
+       if (Nw > 0) then
+         do j=1,Ncolumns
+           r(i,j,k) = r(i,j,k)/wt
+         enddo
+       endif
+     enddo
+   enddo
+
+   ! Set points under surface to R_UNDEF, and change to dBZ if necessary
+   do k=1,Nglevels
+     do j=1,Ncolumns
+       do i=1,Npoints
+         if (newgrid_top(k) > zhalf(i,1)) then ! Level above model bottom level
+           if (lunits) then
+             if (r(i,j,k) <= 0.0) then
+               r(i,j,k) = R_UNDEF
+             else
+               r(i,j,k) = 10.0*log10(r(i,j,k))
+             endif
+           endif
+         else ! Level below surface
+           r(i,j,k) = R_GROUND
+         endif
+       enddo
+     enddo
+   enddo
+
+END SUBROUTINE COSP_CHANGE_VERTICAL_GRID
+
+END MODULE MOD_COSP_STATS
Index: LMDZ6/trunk/libf/phylmd/cosp/mod_cosp_types.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/cosp/mod_cosp_types.F90	(revision 3233)
+++ LMDZ6/trunk/libf/phylmd/cosp/mod_cosp_types.F90	(revision 3233)
@@ -0,0 +1,1676 @@
+! (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,Lclopaquecalipso,Lclthincalipso, & !OPAQ (2)
+                Lclzopaquecalipso,Lclcalipsoopaque,Lclcalipsothin,Lclcalipsozopaque,    & !OPAQ (4)
+                Lclcalipsoopacity,LprofSR,Lproftemp                                       !OPAQ (1) !TIBO (2)
+
+     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 
+    real, dimension(:,:),pointer :: proftemp    ! Temperature profiles 40 levs !TIBO 
+    ! Arrays with dimensions (Npoints,LIDAR_NCAT)
+    real, dimension(:,:),pointer :: cldlayer      ! low, mid, high-level, total lidar cloud cover
+    ! Arrays with dimensions (Npoints,LIDAR_NTYPE)                                               !OPAQ
+    real, dimension(:,:),pointer :: cldtype       ! opaque and thin cloud covers, z_opaque       !OPAQ
+    ! Arrays with dimensions (Npoints,Nlevels,Nphase)
+    real, dimension(:,:,:),pointer :: lidarcldphase    ! 3D "lidar" phase cloud fraction 
+    ! Arrays with dimensions (Npoints,Nlevels,LIDAR_NTYPE+1)                                     !OPAQ
+    real, dimension(:,:,:),pointer :: lidarcldtype     ! 3D "lidar" OPAQ type fraction + opacity !OPAQ 
+    ! 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
+!    ! Arrays with dimensions (Npoints,Ncolumns,Nlevels)                     !TIBO
+!    real, dimension(:,:,:),pointer :: profSR      ! subcolumns for each day !TIBO 
+    ! Arrays with dimensions (Npoints,Nlevels,Ncolumns)                     !TIBO2
+    real, dimension(:,:,:),pointer :: profSR      ! subcolumns for each day !TIBO2 
+
+  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))
+    allocate(x%lidarcldtype(i,k,LIDAR_NTYPE+1),x%cldtype(i,LIDAR_NTYPE)) !OPAQ
+!    allocate(x%profSR(i,j,k),x%proftemp(i,k))                            !TIBO
+    allocate(x%profSR(i,k,j),x%proftemp(i,k))                            !TIBO2
+    ! --- 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
+    x%lidarcldtype  = 0.0 !OPAQ
+    x%cldtype  = 0.0      !OPAQ
+    x%profSR   = 0.0      !TIBO
+    x%proftemp = 0.0      !TIBO
+
+   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)
+    deallocate(x%lidarcldtype, x%cldtype) !OPAQ
+    deallocate(x%profSR, x%proftemp)      !TIBO
+  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),:,:)
+    y%lidarcldtype(iy(1):iy(2),:,:)    = x%lidarcldtype(ix(1):ix(2),:,:) !OPAQ
+    y%cldtype(iy(1):iy(2),:)           = x%cldtype(ix(1):ix(2),:)        !OPAQ
+    y%profSR(iy(1):iy(2),:,:)          = x%profSR(ix(1):ix(2),:,:)       !TIBO
+    y%proftemp(iy(1):iy(2),:)          = x%proftemp(ix(1):ix(2),:)       !TIBO
+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,Ncolumns,Nlevels) !TIBO
+!    print *, 'shape(x%profSR): ',shape(x%profSR)        !TIBO
+    ! Arrays with dimensions (Npoints,Nlevels,Ncolumns) !TIBO2
+    print *, 'shape(x%profSR): ',shape(x%profSR)        !TIBO2
+    ! Arrays with dimensions (Npoints,Nlevels)
+    print *, 'shape(x%lidarcld): ',shape(x%lidarcld)
+    print *, 'shape(x%proftemp): ',shape(x%proftemp)    !TIBO
+    ! Arrays with dimensions (Npoints,LIDAR_NCAT)
+    print *, 'shape(x%cldlayer): ',shape(x%cldlayer)
+    ! Arrays with dimensions (Npoints,LIDAR_NTYPE)            !OPAQ
+    print *, 'shape(x%cldtype): ',shape(x%cldtype)            !OPAQ
+    ! 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,Nlevels,LIDAR_NTYPE+1) !OPAQ
+    print *, 'shape(x%lidarcldtype): ',shape(x%lidarcldtype)  !OPAQ
+     ! 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
Index: LMDZ6/trunk/libf/phylmd/cosp/mod_cosp_utils.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/cosp/mod_cosp_utils.F90	(revision 3233)
+++ LMDZ6/trunk/libf/phylmd/cosp/mod_cosp_utils.F90	(revision 3233)
@@ -0,0 +1,344 @@
+! (c) British Crown Copyright 2008, the Met Office.
+! All rights reserved.
+! $Revision: 23 $, $Date: 2011-03-31 15:41:37 +0200 (jeu. 31 mars 2011) $
+! $URL: http://cfmip-obs-sim.googlecode.com/svn/stable/v1.4.0/cosp_utils.F90 $
+! 
+! 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.
+
+!
+! History:
+! Jul 2007 - A. Bodas-Salcedo - Initial version
+!
+
+MODULE MOD_COSP_UTILS
+  USE MOD_COSP_CONSTANTS
+  IMPLICIT NONE
+
+  INTERFACE Z_TO_DBZ
+    MODULE PROCEDURE Z_TO_DBZ_2D,Z_TO_DBZ_3D,Z_TO_DBZ_4D
+  END INTERFACE
+
+  INTERFACE COSP_CHECK_INPUT
+    MODULE PROCEDURE COSP_CHECK_INPUT_1D,COSP_CHECK_INPUT_2D,COSP_CHECK_INPUT_3D
+  END INTERFACE
+CONTAINS
+
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!------------------- SUBROUTINE COSP_PRECIP_MXRATIO --------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+SUBROUTINE COSP_PRECIP_MXRATIO(Npoints,Nlevels,Ncolumns,p,T,prec_frac,prec_type, &
+                          n_ax,n_bx,alpha_x,c_x,d_x,g_x,a_x,b_x,gamma1,gamma2,gamma3,gamma4, &
+                          flux,mxratio,reff)
+
+    ! Input arguments, (IN)
+    integer,intent(in) :: Npoints,Nlevels,Ncolumns
+    real,intent(in),dimension(Npoints,Nlevels) :: p,T,flux
+    real,intent(in),dimension(Npoints,Ncolumns,Nlevels) :: prec_frac
+    real,intent(in) :: n_ax,n_bx,alpha_x,c_x,d_x,g_x,a_x,b_x,gamma1,gamma2,gamma3,gamma4,prec_type
+    ! Input arguments, (OUT)
+    real,intent(out),dimension(Npoints,Ncolumns,Nlevels) :: mxratio
+    real,intent(inout),dimension(Npoints,Ncolumns,Nlevels) :: reff
+    ! Local variables
+    integer :: i,j,k
+    real :: sigma,one_over_xip1,xi,rho0,rho,lambda_x,gamma_4_3_2,delta
+    
+    mxratio = 0.0
+
+    if (n_ax >= 0.0) then ! N_ax is used to control which hydrometeors need to be computed
+        xi      = d_x/(alpha_x + b_x - n_bx + 1.0)
+        rho0    = 1.29
+        sigma   = (gamma2/(gamma1*c_x))*(n_ax*a_x*gamma2)**xi
+        one_over_xip1 = 1.0/(xi + 1.0)
+        gamma_4_3_2 = 0.5*gamma4/gamma3
+        delta = (alpha_x + b_x + d_x - n_bx + 1.0)
+        
+        do k=1,Nlevels
+            do j=1,Ncolumns
+                do i=1,Npoints
+                    if ((prec_frac(i,j,k)==prec_type).or.(prec_frac(i,j,k)==3.)) then
+                        rho = p(i,k)/(287.05*T(i,k))
+                        mxratio(i,j,k)=(flux(i,k)*((rho/rho0)**g_x)*sigma)**one_over_xip1
+                        mxratio(i,j,k)=mxratio(i,j,k)/rho
+                        ! Compute effective radius
+                        if ((reff(i,j,k) <= 0.0).and.(flux(i,k) /= 0.0)) then
+                           lambda_x = (a_x*c_x*((rho0/rho)**g_x)*n_ax*gamma1/flux(i,k))**(1./delta)
+                           reff(i,j,k) = gamma_4_3_2/lambda_x
+                        endif
+                    endif
+                enddo
+            enddo
+        enddo
+    endif
+END SUBROUTINE COSP_PRECIP_MXRATIO
+
+
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!------------------- SUBROUTINE ZERO_INT -------------------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ELEMENTAL SUBROUTINE ZERO_INT(x,y01,y02,y03,y04,y05,y06,y07,y08,y09,y10, &
+                                 y11,y12,y13,y14,y15,y16,y17,y18,y19,y20, &
+                                 y21,y22,y23,y24,y25,y26,y27,y28,y29,y30)
+
+  integer,intent(inout) :: x
+  integer,intent(inout),optional :: y01,y02,y03,y04,y05,y06,y07,y08,y09,y10, &
+                                    y11,y12,y13,y14,y15,y16,y17,y18,y19,y20, &
+                                    y21,y22,y23,y24,y25,y26,y27,y28,y29,y30
+  x = 0
+  if (present(y01)) y01 = 0
+  if (present(y02)) y02 = 0
+  if (present(y03)) y03 = 0
+  if (present(y04)) y04 = 0
+  if (present(y05)) y05 = 0
+  if (present(y06)) y06 = 0
+  if (present(y07)) y07 = 0
+  if (present(y08)) y08 = 0
+  if (present(y09)) y09 = 0
+  if (present(y10)) y10 = 0
+  if (present(y11)) y11 = 0
+  if (present(y12)) y12 = 0
+  if (present(y13)) y13 = 0
+  if (present(y14)) y14 = 0
+  if (present(y15)) y15 = 0
+  if (present(y16)) y16 = 0
+  if (present(y17)) y17 = 0
+  if (present(y18)) y18 = 0
+  if (present(y19)) y19 = 0
+  if (present(y20)) y20 = 0
+  if (present(y21)) y21 = 0
+  if (present(y22)) y22 = 0
+  if (present(y23)) y23 = 0
+  if (present(y24)) y24 = 0
+  if (present(y25)) y25 = 0
+  if (present(y26)) y26 = 0
+  if (present(y27)) y27 = 0
+  if (present(y28)) y28 = 0
+  if (present(y29)) y29 = 0
+  if (present(y30)) y30 = 0
+END SUBROUTINE  ZERO_INT
+
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!------------------- SUBROUTINE ZERO_REAL ------------------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ELEMENTAL SUBROUTINE ZERO_REAL(x,y01,y02,y03,y04,y05,y06,y07,y08,y09,y10, &
+                                 y11,y12,y13,y14,y15,y16,y17,y18,y19,y20, &
+                                 y21,y22,y23,y24,y25,y26,y27,y28,y29,y30)
+
+  real,intent(inout) :: x
+  real,intent(inout),optional :: y01,y02,y03,y04,y05,y06,y07,y08,y09,y10, &
+                                 y11,y12,y13,y14,y15,y16,y17,y18,y19,y20, &
+                                 y21,y22,y23,y24,y25,y26,y27,y28,y29,y30
+  x = 0.0
+  if (present(y01)) y01 = 0.0
+  if (present(y02)) y02 = 0.0
+  if (present(y03)) y03 = 0.0
+  if (present(y04)) y04 = 0.0
+  if (present(y05)) y05 = 0.0
+  if (present(y06)) y06 = 0.0
+  if (present(y07)) y07 = 0.0
+  if (present(y08)) y08 = 0.0
+  if (present(y09)) y09 = 0.0
+  if (present(y10)) y10 = 0.0
+  if (present(y11)) y11 = 0.0
+  if (present(y12)) y12 = 0.0
+  if (present(y13)) y13 = 0.0
+  if (present(y14)) y14 = 0.0
+  if (present(y15)) y15 = 0.0
+  if (present(y16)) y16 = 0.0
+  if (present(y17)) y17 = 0.0
+  if (present(y18)) y18 = 0.0
+  if (present(y19)) y19 = 0.0
+  if (present(y20)) y20 = 0.0
+  if (present(y21)) y21 = 0.0
+  if (present(y22)) y22 = 0.0
+  if (present(y23)) y23 = 0.0
+  if (present(y24)) y24 = 0.0
+  if (present(y25)) y25 = 0.0
+  if (present(y26)) y26 = 0.0
+  if (present(y27)) y27 = 0.0
+  if (present(y28)) y28 = 0.0
+  if (present(y29)) y29 = 0.0
+  if (present(y30)) y30 = 0.0
+END SUBROUTINE  ZERO_REAL
+
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!--------------------- SUBROUTINE Z_TO_DBZ_2D --------------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+  SUBROUTINE Z_TO_DBZ_2D(mdi,z)
+    real,intent(in) :: mdi
+    real,dimension(:,:),intent(inout) :: z
+    ! Reflectivity Z:
+    ! Input in [m3]
+    ! Output in dBZ, with Z in [mm6 m-3]
+    
+    ! 1.e18 to convert from [m3] to [mm6 m-3]
+    z = 1.e18*z
+    where (z > 1.0e-6) ! Limit to -60 dBZ
+      z = 10.0*log10(z)
+    elsewhere
+      z = mdi
+    end where  
+  END SUBROUTINE Z_TO_DBZ_2D
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!--------------------- SUBROUTINE Z_TO_DBZ_3D --------------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+  SUBROUTINE Z_TO_DBZ_3D(mdi,z)
+    real,intent(in) :: mdi
+    real,dimension(:,:,:),intent(inout) :: z
+    ! Reflectivity Z:
+    ! Input in [m3]
+    ! Output in dBZ, with Z in [mm6 m-3]
+    
+    ! 1.e18 to convert from [m3] to [mm6 m-3]
+    z = 1.e18*z
+    where (z > 1.0e-6) ! Limit to -60 dBZ
+      z = 10.0*log10(z)
+    elsewhere
+      z = mdi
+    end where  
+  END SUBROUTINE Z_TO_DBZ_3D
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!--------------------- SUBROUTINE Z_TO_DBZ_4D --------------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+  SUBROUTINE Z_TO_DBZ_4D(mdi,z)
+    real,intent(in) :: mdi
+    real,dimension(:,:,:,:),intent(inout) :: z
+    ! Reflectivity Z:
+    ! Input in [m3]
+    ! Output in dBZ, with Z in [mm6 m-3]
+    
+    ! 1.e18 to convert from [m3] to [mm6 m-3]
+    z = 1.e18*z
+    where (z > 1.0e-6) ! Limit to -60 dBZ
+      z = 10.0*log10(z)
+    elsewhere
+      z = mdi
+    end where  
+  END SUBROUTINE Z_TO_DBZ_4D
+
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!----------------- SUBROUTINES COSP_CHECK_INPUT_1D ---------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+  SUBROUTINE COSP_CHECK_INPUT_1D(vname,x,min_val,max_val)
+    character(len=*) :: vname
+    real,intent(inout) :: x(:)
+    real,intent(in),optional :: min_val,max_val
+    logical :: l_min,l_max
+    character(len=128) :: pro_name='COSP_CHECK_INPUT_1D'
+    
+    l_min=.false.
+    l_max=.false.
+    
+    if (present(min_val)) then
+!       if (x < min_val) x = min_val
+      if (any(x < min_val)) then 
+      l_min = .true.
+        where (x < min_val)
+          x = min_val
+        end where
+      endif
+    endif    
+    if (present(max_val)) then
+!       if (x > max_val) x = max_val
+      if (any(x > max_val)) then 
+        l_max = .true.
+        where (x > max_val)
+          x = max_val
+        end where  
+      endif    
+    endif    
+    
+    if (l_min) print *,'----- WARNING: '//trim(pro_name)//': minimum value of '//trim(vname)//' set to: ',min_val
+    if (l_max) print *,'----- WARNING: '//trim(pro_name)//': maximum value of '//trim(vname)//' set to: ',max_val
+  END SUBROUTINE COSP_CHECK_INPUT_1D
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!----------------- SUBROUTINES COSP_CHECK_INPUT_2D ---------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+  SUBROUTINE COSP_CHECK_INPUT_2D(vname,x,min_val,max_val)
+    character(len=*) :: vname
+    real,intent(inout) :: x(:,:)
+    real,intent(in),optional :: min_val,max_val
+    logical :: l_min,l_max
+    character(len=128) :: pro_name='COSP_CHECK_INPUT_2D'
+    
+    l_min=.false.
+    l_max=.false.
+    
+    if (present(min_val)) then
+!       if (x < min_val) x = min_val
+      if (any(x < min_val)) then 
+      l_min = .true.
+        where (x < min_val)
+          x = min_val
+        end where
+      endif
+    endif    
+    if (present(max_val)) then
+!       if (x > max_val) x = max_val
+      if (any(x > max_val)) then 
+        l_max = .true.
+        where (x > max_val)
+          x = max_val
+        end where  
+      endif    
+    endif    
+    
+    if (l_min) print *,'----- WARNING: '//trim(pro_name)//': minimum value of '//trim(vname)//' set to: ',min_val
+    if (l_max) print *,'----- WARNING: '//trim(pro_name)//': maximum value of '//trim(vname)//' set to: ',max_val
+  END SUBROUTINE COSP_CHECK_INPUT_2D
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!----------------- SUBROUTINES COSP_CHECK_INPUT_3D ---------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+  SUBROUTINE COSP_CHECK_INPUT_3D(vname,x,min_val,max_val)
+    character(len=*) :: vname
+    real,intent(inout) :: x(:,:,:)
+    real,intent(in),optional :: min_val,max_val
+    logical :: l_min,l_max
+    character(len=128) :: pro_name='COSP_CHECK_INPUT_3D'
+    
+    l_min=.false.
+    l_max=.false.
+    
+    if (present(min_val)) then
+!       if (x < min_val) x = min_val
+      if (any(x < min_val)) then 
+      l_min = .true.
+        where (x < min_val)
+          x = min_val
+        end where
+      endif
+    endif    
+    if (present(max_val)) then
+!       if (x > max_val) x = max_val
+      if (any(x > max_val)) then 
+        l_max = .true.
+        where (x > max_val)
+          x = max_val
+        end where  
+      endif    
+    endif    
+    
+    if (l_min) print *,'----- WARNING: '//trim(pro_name)//': minimum value of '//trim(vname)//' set to: ',min_val
+    if (l_max) print *,'----- WARNING: '//trim(pro_name)//': maximum value of '//trim(vname)//' set to: ',max_val
+  END SUBROUTINE COSP_CHECK_INPUT_3D
+
+
+END MODULE MOD_COSP_UTILS
Index: LMDZ6/trunk/libf/phylmd/cosp/mod_llnl_stats.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/cosp/mod_llnl_stats.F90	(revision 3233)
+++ LMDZ6/trunk/libf/phylmd/cosp/mod_llnl_stats.F90	(revision 3233)
@@ -0,0 +1,138 @@
+! (c) 2008, Lawrence Livermore National Security Limited Liability Corporation.
+! All rights reserved.
+! $Revision: 88 $, $Date: 2013-11-13 15:08:38 +0100 (mer. 13 nov. 2013) $
+! $URL: http://cfmip-obs-sim.googlecode.com/svn/stable/v1.4.0/llnl/llnl_stats.F90 $
+! 
+! 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 Lawrence Livermore National Security Limited Liability Corporation 
+!       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.
+!
+! History
+!
+! Jan 2013 - G. Cesana        - Added betaperp_tot and temp_tot arguments 
+!
+
+
+MODULE MOD_LLNL_STATS
+  USE MOD_COSP_CONSTANTS
+  IMPLICIT NONE
+
+CONTAINS
+
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!-------------------- FUNCTION COSP_CFAD ------------------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+FUNCTION COSP_CFAD(Npoints,Ncolumns,Nlevels,Nbins,x,xmin,xmax,bmin,bwidth)
+   ! Input arguments
+   integer,intent(in) :: Npoints,Ncolumns,Nlevels,Nbins
+   real,dimension(Npoints,Ncolumns,Nlevels),intent(in) :: x
+   real,intent(in) :: xmin,xmax 
+   real,intent(in) :: bmin,bwidth
+   
+   real,dimension(Npoints,Nbins,Nlevels) :: cosp_cfad
+   ! Local variables
+   integer :: i, j, k
+   integer :: ibin
+   
+   !--- Input arguments
+   ! Npoints: Number of horizontal points
+   ! Ncolumns: Number of subcolumns
+   ! Nlevels: Number of levels
+   ! Nbins: Number of x axis bins
+   ! x: variable to process (Npoints,Ncolumns,Nlevels)
+   ! xmin: minimum value allowed for x
+   ! xmax: minimum value allowed for x
+   ! bmin: mimumum value of first bin
+   ! bwidth: bin width
+   !
+   ! Output: 2D histogram on each horizontal point (Npoints,Nbins,Nlevels)
+   
+   cosp_cfad = 0.0
+   ! bwidth intervals in the range [bmin,bmax=bmin+Nbins*hwidth]
+   ! Valid x values smaller than bmin and larger than bmax are set 
+   ! into the smallest bin and largest bin, respectively.
+   do j = 1, Nlevels, 1
+      do k = 1, Ncolumns, 1
+         do i = 1, Npoints, 1
+            if (x(i,k,j) == R_GROUND) then
+               cosp_cfad(i,:,j) = R_UNDEF
+            elseif ((x(i,k,j) >= xmin) .and. (x(i,k,j) <= xmax)) then 
+               ibin = ceiling((x(i,k,j) - bmin)/bwidth)
+               if (ibin > Nbins) ibin = Nbins
+               if (ibin < 1)     ibin = 1
+               cosp_cfad(i,ibin,j) = cosp_cfad(i,ibin,j) + 1.0 
+            end if
+         enddo  !i
+      enddo  !k
+   enddo  !j
+   where ((cosp_cfad /= R_UNDEF).and.(cosp_cfad /= 0.0)) cosp_cfad = cosp_cfad / Ncolumns
+END FUNCTION COSP_CFAD
+
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!------------- SUBROUTINE COSP_LIDAR_ONLY_CLOUD -----------------
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+SUBROUTINE COSP_LIDAR_ONLY_CLOUD(Npoints,Ncolumns,Nlevels,temp_tot,beta_tot, &
+                   betaperp_tot,beta_mol,Ze_tot,lidar_only_freq_cloud,tcc)
+   ! Input arguments
+   integer,intent(in) :: Npoints,Ncolumns,Nlevels
+   real,dimension(Npoints,Nlevels),intent(in) :: beta_mol   ! Molecular backscatter
+   real,dimension(Npoints,Ncolumns,Nlevels),intent(in) :: beta_tot   ! Total backscattered signal
+   real,dimension(Npoints,Ncolumns,Nlevels),intent(in) :: temp_tot   ! Total backscattered signal
+   real,dimension(Npoints,Ncolumns,Nlevels),intent(in) :: betaperp_tot   ! perpendicular Total backscattered signal
+   real,dimension(Npoints,Ncolumns,Nlevels),intent(in) :: Ze_tot     ! Radar reflectivity
+   ! Output arguments
+   real,dimension(Npoints,Nlevels),intent(out) :: lidar_only_freq_cloud
+   real,dimension(Npoints),intent(out) :: tcc
+
+   ! local variables
+   real :: sc_ratio
+   real :: s_cld, s_att
+   parameter (S_cld = 5.0)
+   parameter (s_att = 0.01)
+   integer :: flag_sat !first saturated level encountered from top
+   integer :: flag_cld !cloudy column
+   integer :: pr,i,j
+
+   lidar_only_freq_cloud = 0.0
+   tcc = 0.0
+   do pr=1,Npoints
+     do i=1,Ncolumns
+       flag_sat = 0
+       flag_cld = 0
+       do j=Nlevels,1,-1 !top->surf
+        sc_ratio = beta_tot(pr,i,j)/beta_mol(pr,j)
+        if ((sc_ratio .le. s_att) .and. (flag_sat .eq. 0)) flag_sat = j
+        if (Ze_tot(pr,i,j) .lt. -30.) then  !radar can't detect cloud
+         if ( (sc_ratio .gt. s_cld) .or. (flag_sat .eq. j) ) then  !lidar sense cloud
+            lidar_only_freq_cloud(pr,j)=lidar_only_freq_cloud(pr,j)+1. !top->surf
+            flag_cld=1
+         endif
+        else  !radar sense cloud (z%Ze_tot(pr,i,j) .ge. -30.)
+           flag_cld=1
+        endif
+       enddo !levels
+       if (flag_cld .eq. 1) tcc(pr)=tcc(pr)+1.
+     enddo !columns
+   enddo !points
+   lidar_only_freq_cloud=lidar_only_freq_cloud/Ncolumns
+   tcc=tcc/Ncolumns
+
+END SUBROUTINE COSP_LIDAR_ONLY_CLOUD
+END MODULE MOD_LLNL_STATS
Index: LMDZ6/trunk/libf/phylmd/cosp/mod_lmd_ipsl_stats.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/cosp/mod_lmd_ipsl_stats.F90	(revision 3233)
+++ LMDZ6/trunk/libf/phylmd/cosp/mod_lmd_ipsl_stats.F90	(revision 3233)
@@ -0,0 +1,1181 @@
+! Copyright (c) 2009, Centre National de la Recherche Scientifique
+! All rights reserved.
+! $Revision: 88 $, $Date: 2013-11-13 15:08:38 +0100 (mer. 13 nov. 2013) $
+! $URL: http://cfmip-obs-sim.googlecode.com/svn/stable/v1.4.0/actsim/lmd_ipsl_stats.F90 $
+!
+! 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 LMD/IPSL/CNRS/UPMC 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.
+
+
+!------------------------------------------------------------------------------------
+! Authors: Sandrine Bony and Helene Chepfer (LMD/IPSL, CNRS, UPMC, France).
+!------------------------------------------------------------------------------------
+MODULE MOD_LMD_IPSL_STATS
+  USE MOD_LLNL_STATS
+  IMPLICIT NONE
+
+CONTAINS
+      SUBROUTINE diag_lidar(npoints,ncol,llm,max_bin,nrefl &
+                  ,tmp,pnorm,pnorm_perp,pmol,refl,land,pplay,undef,ok_lidar_cfad &
+                  ,cfad2,srbval,ncat,ntype,lidarcld,lidarcldtype,lidarcldphase,cldlayer & !OPAQ
+                  ,cldtype,cldlayerphase,lidarcldtmp,parasolrefl,vgrid_z,profSR)          !OPAQ !TIBO
+!
+! -----------------------------------------------------------------------------------
+! Lidar outputs :
+!
+! Diagnose cloud fraction (3D cloud fraction + low/middle/high/total cloud fraction)
+! and phase cloud fraction (3D, low/mid/high/total and 3D temperature)
+! from the lidar signals (ATB, ATBperp and molecular ATB) computed from model outputs
+!      +
+! Compute CFADs of lidar scattering ratio SR and of depolarization index
+!
+! Authors: Sandrine Bony and Helene Chepfer (LMD/IPSL, CNRS, UPMC, France).
+!
+! December 2008, S. Bony,  H. Chepfer and J-L. Dufresne :
+! - change of the cloud detection threshold S_cld from 3 to 5, for better
+! with both day and night observations. The optical thinest clouds are missed.
+! - remove of the detection of the first fully attenuated layer encountered from above.
+! December 2008, A. Bodas-Salcedo:
+! - Dimensions of pmol reduced to (npoints,llm)
+! August 2009, A. Bodas-Salcedo:
+! - Warning message regarding PARASOL being valid only over ocean deleted.
+! February 2010, A. Bodas-Salcedo:
+! - Undef passed into cosp_cfad_sr
+! June 2010, T. Yokohata, T. Nishimura and K. Ogochi
+! Optimisation of COSP_CFAD_SR
+!
+! January 2013, G. Cesana, H. Chepfer:
+! - Add the perpendicular component of the backscattered signal (pnorm_perp) in the arguments
+! - Add the temperature (tmp) in the arguments
+! - Add the 3D Phase cloud fraction (lidarcldphase) in the arguments
+! - Add the Phase low mid high cloud fraction (cldlayerphase) in the arguments
+! - Add the 3D Phase cloud fraction as a function of temperature (lidarcldtmp) in the arguments
+! - Modification of the phase diagnosis within the COSP_CLDFRAC routine to integrate the phase
+!   diagnosis (3D, low/mid/high, 3D temperature)
+! Reference: Cesana G. and H. Chepfer (2013): Evaluation of the cloud water phase
+! in a climate model using CALIPSO-GOCCP, J. Geophys. Res., doi: 10.1002/jgrd.50376
+!
+! ------------------------------------------------------------------------------------
+
+! c inputs :
+      integer npoints
+      integer ncol
+      integer llm
+      integer max_bin               ! nb of bins for SR CFADs
+      integer ncat                  ! nb of cloud layer types (low,mid,high,total)
+      integer ntype                 ! nb of OPAQ products (opaque and thin clouds, z_opaque) !OPAQ
+      integer nrefl                 ! nb of solar zenith angles for parasol reflectances
+
+      real undef                    ! undefined value
+      real pnorm(npoints,ncol,llm)  ! lidar ATB
+      real pmol(npoints,llm)        ! molecular ATB
+      real land(npoints)            ! Landmask [0 - Ocean, 1 - Land]
+      real pplay(npoints,llm)       ! pressure on model levels (Pa)
+      logical ok_lidar_cfad         ! true if lidar CFAD diagnostics need to be computed
+      real refl(npoints,ncol,nrefl) ! subgrid parasol reflectance ! parasol
+      real tmp(npoints,llm)         ! temp at each levels
+      real pnorm_perp(npoints,ncol,llm)  ! lidar perpendicular ATB
+      real vgrid_z(llm)             ! mid-level altitude of the output vertical grid         !OPAQ
+
+! c outputs :
+      real lidarcld(npoints,llm)     ! 3D "lidar" cloud fraction
+      real lidarcldtype(npoints,llm,ntype+1)   ! 3D "lidar" OPAQ type fraction + opacity     !OPAQ
+      real sub(npoints,llm)     ! 3D "lidar" indice
+      real cldlayer(npoints,ncat)    ! "lidar" cloud layer fraction (low, mid, high, total)
+      real cldtype(npoints,ntype)  ! "lidar" OPAQ type covers (opaque/thin cloud + z_opaque) !OPAQ
+
+      real cfad2(npoints,max_bin,llm) ! CFADs of SR
+      real srbval(max_bin)           ! SR bins in CFADs
+      real parasolrefl(npoints,nrefl)! grid-averaged parasol reflectance
+!     real profSR(npoints,ncol,llm)  ! tableau avec les subcolumns SR !TIBO
+      real profSR(npoints,llm,ncol)  ! tableau avec les subcolumns SR !TIBO2
+
+! c threshold for cloud detection :
+      real S_clr
+      parameter (S_clr = 1.2)
+      real S_cld
+      parameter (S_cld = 5.)  ! Thresold for cloud detection
+      real S_att
+      parameter (S_att = 0.01)
+!      parameter (S_att = 0.06)  !OPAQ ! Threshold for "surface detection" equivalent
+
+! c local variables :
+      integer ic,k,i,j
+      real x3d(npoints,ncol,llm)
+      real x3d_c(npoints,llm),pnorm_c(npoints,llm)
+      real xmax
+
+! Output variables
+      integer,parameter :: nphase = 6 ! nb of cloud layer phase types (ice,liquid,undefined,false ice,false liquid,Percent of ice)
+      real lidarcldphase(npoints,llm,nphase)   ! 3D "lidar" phase cloud fraction
+      real lidarcldtmp(npoints,40,5)          ! 3D "lidar" phase cloud fraction as a function of temp
+      real cldlayerphase(npoints,ncat,nphase)  ! "lidar" phase low mid high cloud fraction 
+
+! SR detection threshold
+      real, parameter  ::  S_cld_att = 30. ! New threshold for undefine cloud phase detection	
+
+
+!
+! c -------------------------------------------------------
+! c 0- Initializations
+! c -------------------------------------------------------
+!
+!  Should be modified in future version
+      xmax=undef-1.0
+
+! c -------------------------------------------------------
+! c 1- Lidar scattering ratio :
+! c -------------------------------------------------------
+
+      do ic = 1, ncol
+        pnorm_c = pnorm(:,ic,:)
+        where ((pnorm_c.lt.xmax) .and. (pmol.lt.xmax) .and. (pmol.gt. 0.0 ))
+            x3d_c = pnorm_c/pmol
+        elsewhere
+            x3d_c = undef
+        end where
+         x3d(:,ic,:) = x3d_c
+!	profSR(:,ic,:) = x3d(:,ic,:) !TIBO
+	profSR(:,:,ic) = x3d(:,ic,:) !TIBO2
+      enddo
+
+! c -------------------------------------------------------
+! c 2- Diagnose cloud fractions (3D, low, middle, high, total)
+! c from subgrid-scale lidar scattering ratios :
+! c -------------------------------------------------------
+
+    CALL COSP_CLDFRAC(npoints,ncol,llm,ncat,nphase,  &
+              tmp,x3d,pnorm,pnorm_perp,pplay, S_att,S_cld,S_cld_att,undef,lidarcld, &
+              cldlayer,lidarcldphase,sub,cldlayerphase,lidarcldtmp)
+
+    CALL COSP_OPAQ(npoints,ncol,llm,ntype,x3d,S_cld,undef,lidarcldtype,            & !OPAQ
+                   cldtype,vgrid_z)                                                  !OPAQ
+
+! c -------------------------------------------------------
+! c 3- CFADs
+! c -------------------------------------------------------
+      if (ok_lidar_cfad) then
+!
+! c CFADs of subgrid-scale lidar scattering ratios :
+! c -------------------------------------------------------
+      CALL COSP_CFAD_SR(npoints,ncol,llm,max_bin,undef, &
+                 x3d, &
+                 S_att,S_clr,xmax,cfad2,srbval)
+
+      endif   ! ok_lidar_cfad
+! c -------------------------------------------------------
+
+! c -------------------------------------------------------
+! c 4- Compute grid-box averaged Parasol reflectances
+! c -------------------------------------------------------
+
+      parasolrefl(:,:) = 0.0
+
+      do k = 1, nrefl
+       do ic = 1, ncol
+         parasolrefl(:,k) = parasolrefl(:,k) + refl(:,ic,k)
+       enddo
+      enddo
+
+      do k = 1, nrefl
+        parasolrefl(:,k) = parasolrefl(:,k) / float(ncol)
+! if land=1 -> parasolrefl=undef
+! if land=0 -> parasolrefl=parasolrefl
+        parasolrefl(:,k) = parasolrefl(:,k) * MAX(1.0-land(:),0.0) &
+                           + (1.0 - MAX(1.0-land(:),0.0))*undef
+      enddo
+
+      RETURN
+      END SUBROUTINE diag_lidar
+
+
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!-------------------- FUNCTION COSP_CFAD_SR ------------------------
+! Author: Sandrine Bony (LMD/IPSL, CNRS, Paris)
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+      SUBROUTINE COSP_CFAD_SR(Npoints,Ncolumns,Nlevels,Nbins,undef, &
+                      x,S_att,S_clr,xmax,cfad,srbval)
+      IMPLICIT NONE
+
+!--- Input arguments
+! Npoints: Number of horizontal points
+! Ncolumns: Number of subcolumns
+! Nlevels: Number of levels
+! Nbins: Number of x axis bins
+! xmax: maximum value allowed for x
+! S_att: Threshold for full attenuation
+! S_clr: Threshold for clear-sky layer
+!
+!--- Input-Outout arguments
+! x: variable to process (Npoints,Ncolumns,Nlevels), mofified where saturation occurs
+!
+! -- Output arguments
+! srbval : values of the histogram bins
+! cfad: 2D histogram on each horizontal point
+
+! Input arguments
+      integer Npoints,Ncolumns,Nlevels,Nbins
+      real xmax,S_att,S_clr,undef
+! Input-output arguments
+      real x(Npoints,Ncolumns,Nlevels)
+! Output :
+      real cfad(Npoints,Nbins,Nlevels)
+      real srbval(Nbins)
+! Local variables
+      integer i, j, k, ib
+      real srbval_ext(0:Nbins)
+
+! c -------------------------------------------------------
+! c 0- Initializations
+! c -------------------------------------------------------
+      if ( Nbins .lt. 6) return
+
+      srbval(1) =  S_att
+      srbval(2) =  S_clr
+      srbval(3) =  3.0
+      srbval(4) =  5.0
+      srbval(5) =  7.0
+      srbval(6) = 10.0
+      do i = 7, MIN(10,Nbins)
+       srbval(i) = srbval(i-1) + 5.0
+      enddo
+      DO i = 11, MIN(13,Nbins)
+       srbval(i) = srbval(i-1) + 10.0
+      enddo
+      srbval(MIN(14,Nbins)) = 80.0
+      srbval(Nbins) = xmax
+      cfad(:,:,:) = 0.0
+
+      srbval_ext(1:Nbins) = srbval
+      srbval_ext(0) = -1.0
+! c -------------------------------------------------------
+! c c- Compute CFAD
+! c -------------------------------------------------------
+      do j = 1, Nlevels
+         do ib = 1, Nbins
+            do k = 1, Ncolumns
+               do i = 1, Npoints
+                  if (x(i,k,j) /= undef) then
+                     if ((x(i,k,j).gt.srbval_ext(ib-1)).and.(x(i,k,j).le.srbval_ext(ib))) &
+                          cfad(i,ib,j) = cfad(i,ib,j) + 1.0
+                  else 
+                     cfad(i,ib,j) = undef
+                  endif
+               enddo
+            enddo
+         enddo
+      enddo
+
+      where (cfad .ne. undef)  cfad = cfad / float(Ncolumns)
+
+! c -------------------------------------------------------
+      RETURN
+      END SUBROUTINE COSP_CFAD_SR
+
+
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+!-------------------- SUBROUTINE COSP_CLDFRAC -------------------
+! c Purpose: Cloud fraction diagnosed from lidar measurements
+!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+      SUBROUTINE COSP_CLDFRAC(Npoints,Ncolumns,Nlevels,Ncat,Nphase, &
+                  tmp,x,ATB,ATBperp,pplay,S_att,S_cld,S_cld_att,undef,lidarcld, &
+                  cldlayer,lidarcldphase,nsub,cldlayerphase,lidarcldtemp)
+
+
+      IMPLICIT NONE
+! Input arguments
+      integer Npoints,Ncolumns,Nlevels,Ncat
+      real x(Npoints,Ncolumns,Nlevels)
+
+
+! Local parameters
+      integer nphase ! nb of cloud layer phase types 
+                                      ! (ice,liquid,undefined,false ice,false liquid,Percent of ice)
+      integer,parameter  ::  Ntemp=40 ! indice of the temperature vector
+      integer ip, k, iz, ic, ncol, nlev, i, itemp  ! loop indice
+      real  S_cld_att ! New threshold for undefine cloud phase detection (SR=30)	
+      integer toplvlsat  ! level of the first cloud with SR>30
+      real alpha50, beta50, gamma50, delta50, epsilon50, zeta50 ! Polynomial Coef of the phase
+                                                                ! discrimination line   
+
+! Input variables
+      real tmp(Npoints,Nlevels)			! temperature
+      real ATB(Npoints,Ncolumns,Nlevels) ! 3D Attenuated backscatter
+      real ATBperp(Npoints,Ncolumns,Nlevels) ! 3D perpendicular attenuated backscatter
+      real pplay(Npoints,Nlevels)
+      real S_att,S_cld
+      real undef
+
+! Output variables
+      real lidarcldtemp(Npoints,Ntemp,5) ! 3D Temperature 1=tot,2=ice,3=liq,4=undef,5=ice/ice+liq
+      real tempmod(Ntemp+1)     ! temperature bins
+      real lidarcldphase(Npoints,Nlevels,Nphase)    ! 3D cloud phase fraction
+      real cldlayerphase(Npoints,Ncat,Nphase) ! low, middle, high, total cloud fractions for ice liquid and undefine phase
+      real lidarcld(Npoints,Nlevels) ! 3D cloud fraction
+      real cldlayer(Npoints,Ncat)    ! low, middle, high, total cloud fractions
+
+! Local variables
+      real tmpi(Npoints,Ncolumns,Nlevels)	! temperature of ice cld
+      real tmpl(Npoints,Ncolumns,Nlevels)	! temperature of liquid cld
+      real tmpu(Npoints,Ncolumns,Nlevels)	! temperature of undef cld
+
+      real checktemp, ATBperp_tmp ! temporary variable
+      real checkcldlayerphase, checkcldlayerphase2 ! temporary variable
+      real sumlidarcldtemp(Npoints,Ntemp) ! temporary variable
+
+      real cldlayphase(Npoints,Ncolumns,Ncat,Nphase) ! subgrided low mid high phase cloud fraction
+      real cldlayerphasetmp(Npoints,Ncat) ! temporary variable
+      real cldlayerphasesum(Npoints,Ncat) ! temporary variable
+      real lidarcldtempind(Npoints,Ntemp) ! 3D Temperature indice
+      real lidarcldphasetmp(Npoints,Nlevels)  ! 3D sum of ice and liquid cloud occurences
+
+
+! Local variables
+      real p1
+      real cldy(Npoints,Ncolumns,Nlevels)
+      real srok(Npoints,Ncolumns,Nlevels)
+      real cldlay(Npoints,Ncolumns,Ncat)
+      real nsublay(Npoints,Ncolumns,Ncat), nsublayer(Npoints,Ncat)
+      real nsub(Npoints,Nlevels)
+
+#ifdef SYS_SX
+      real cldlay1(Npoints,Ncolumns)
+      real cldlay2(Npoints,Ncolumns)
+      real cldlay3(Npoints,Ncolumns)
+      real nsublay1(Npoints,Ncolumns)
+      real nsublay2(Npoints,Ncolumns)
+      real nsublay3(Npoints,Ncolumns)
+#endif
+
+
+
+
+! ---------------------------------------------------------------
+! 1- initialization
+! ---------------------------------------------------------------
+
+      if ( Ncat .ne. 4 ) then
+         print *,'Error in lmd_ipsl_stats.cosp_cldfrac, Ncat must be 4, not',Ncat
+         stop
+      endif
+
+      lidarcld = 0.0
+      nsub = 0.0
+      cldlay = 0.0
+      nsublay = 0.0
+
+      ATBperp_tmp = 0.
+      lidarcldphase(:,:,:) = 0.
+      cldlayphase(:,:,:,:) = 0.
+      cldlayerphase(:,:,:) = 0.
+      tmpi(:,:,:) = 0.
+      tmpl(:,:,:) = 0.
+      tmpu(:,:,:) = 0.
+      cldlayerphasesum(:,:) = 0.
+      lidarcldtemp(:,:,:) = 0.
+      lidarcldtempind(:,:) = 0.
+      sumlidarcldtemp(:,:) = 0.
+      toplvlsat=0
+      lidarcldphasetmp(:,:) = 0.
+
+! temperature bins
+      tempmod=(/-273.15,-90.,-87.,-84.,-81.,-78.,-75.,-72.,-69.,-66.,-63.,-60.,-57., &
+                -54.,-51.,-48.,-45.,-42.,-39.,-36.,-33.,-30.,-27.,-24.,-21.,-18.,  &
+                -15.,-12.,-9.,-6.,-3.,0.,3.,6.,9.,12.,15.,18.,21.,24.,200. /)
+	
+! convert C to K
+      tempmod=tempmod+273.15
+
+! Polynomial coefficient of the phase discrimination line used to separate liquid from ice
+! (Cesana and Chepfer, JGR, 2013)
+! ATBperp = ATB^5*alpha50 + ATB^4*beta50 + ATB^3*gamma50 + ATB^2*delta50 + ATB*epsilon50 + zeta50
+      alpha50   = 9.0322e+15
+      beta50    = -2.1358e+12
+      gamma50   = 173.3963e06
+      delta50   = -3.9514e03
+      epsilon50 = 0.2559
+      zeta50    = -9.4776e-07
+
+
+! ---------------------------------------------------------------
+! 2- Cloud detection
+! ---------------------------------------------------------------
+
+      do k = 1, Nlevels
+
+! cloud detection at subgrid-scale:
+         where ( (x(:,:,k).gt.S_cld) .and. (x(:,:,k).ne. undef) )
+           cldy(:,:,k)=1.0
+         elsewhere
+           cldy(:,:,k)=0.0
+         endwhere
+
+! number of usefull sub-columns:
+         where ( (x(:,:,k).gt.S_att) .and. (x(:,:,k).ne. undef)  )
+           srok(:,:,k)=1.0
+         elsewhere
+           srok(:,:,k)=0.0
+         endwhere
+
+      enddo ! k
+
+
+! ---------------------------------------------------------------
+! 3- grid-box 3D cloud fraction and layered cloud fractions (ISCCP pressure
+! categories) :
+! ---------------------------------------------------------------
+      lidarcld = 0.0
+      nsub = 0.0
+#ifdef SYS_SX
+!! XXX: Use cldlay[1-3] and nsublay[1-3] to avoid bank-conflicts.
+      cldlay1 = 0.0
+      cldlay2 = 0.0
+      cldlay3 = 0.0
+      cldlay(:,:,4) = 0.0 !! XXX: Ncat == 4
+      nsublay1 = 0.0
+      nsublay2 = 0.0
+      nsublay3 = 0.0
+      nsublay(:,:,4) = 0.0
+
+      do k = Nlevels, 1, -1
+       do ic = 1, Ncolumns
+        do ip = 1, Npoints
+
+         if(srok(ip,ic,k).gt.0.)then
+           ! Computation of the cloud fraction as a function of the temperature
+           ! instead of height, for ice,liquid and all clouds
+           do itemp=1,Ntemp
+             if( (tmp(ip,k).ge.tempmod(itemp)).and.(tmp(ip,k).lt.tempmod(itemp+1)) )then
+               lidarcldtempind(ip,itemp)=lidarcldtempind(ip,itemp)+1.
+             endif
+           enddo
+         endif
+
+         if (cldy(ip,ic,k).eq.1.) then
+           do itemp=1,Ntemp
+             if( (tmp(ip,k).ge.tempmod(itemp)).and.(tmp(ip,k).lt.tempmod(itemp+1)) )then
+               lidarcldtemp(ip,itemp,1)=lidarcldtemp(ip,itemp,1)+1.
+             endif
+           enddo
+         endif
+
+         p1 = pplay(ip,k)
+
+         if ( p1.gt.0. .and. p1.lt.(440.*100.)) then ! high clouds
+            cldlay3(ip,ic) = MAX(cldlay3(ip,ic), cldy(ip,ic,k))
+            nsublay3(ip,ic) = MAX(nsublay3(ip,ic), srok(ip,ic,k))
+         else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then  ! mid clouds
+            cldlay2(ip,ic) = MAX(cldlay2(ip,ic), cldy(ip,ic,k))
+            nsublay2(ip,ic) = MAX(nsublay2(ip,ic), srok(ip,ic,k))
+         else
+            cldlay1(ip,ic) = MAX(cldlay1(ip,ic), cldy(ip,ic,k))
+            nsublay1(ip,ic) = MAX(nsublay1(ip,ic), srok(ip,ic,k))
+         endif
+
+         cldlay(ip,ic,4) = MAX(cldlay(ip,ic,4), cldy(ip,ic,k))
+         lidarcld(ip,k)=lidarcld(ip,k) + cldy(ip,ic,k)
+         nsublay(ip,ic,4) = MAX(nsublay(ip,ic,4),srok(ip,ic,k))
+         nsub(ip,k)=nsub(ip,k) + srok(ip,ic,k)
+        enddo
+       enddo
+      enddo
+      cldlay(:,:,1) = cldlay1
+      cldlay(:,:,2) = cldlay2
+      cldlay(:,:,3) = cldlay3
+      nsublay(:,:,1) = nsublay1
+      nsublay(:,:,2) = nsublay2
+      nsublay(:,:,3) = nsublay3
+#else
+      cldlay = 0.0
+      nsublay = 0.0
+      do k = Nlevels, 1, -1
+       do ic = 1, Ncolumns
+        do ip = 1, Npoints
+
+          ! Computation of the cloud fraction as a function of the temperature
+          ! instead of height, for ice,liquid and all clouds
+          if(srok(ip,ic,k).gt.0.)then
+          do itemp=1,Ntemp
+            if( (tmp(ip,k).ge.tempmod(itemp)).and.(tmp(ip,k).lt.tempmod(itemp+1)) )then
+              lidarcldtempind(ip,itemp)=lidarcldtempind(ip,itemp)+1.
+            endif
+          enddo
+          endif
+
+          if(cldy(ip,ic,k).eq.1.)then
+          do itemp=1,Ntemp
+            if( (tmp(ip,k).ge.tempmod(itemp)).and.(tmp(ip,k).lt.tempmod(itemp+1)) )then
+              lidarcldtemp(ip,itemp,1)=lidarcldtemp(ip,itemp,1)+1.
+            endif
+          enddo
+          endif
+!
+
+          iz=1
+          p1 = pplay(ip,k)
+          if ( p1.gt.0. .and. p1.lt.(440.*100.)) then ! high clouds
+            iz=3
+          else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then  ! mid clouds
+            iz=2
+         endif
+
+         cldlay(ip,ic,iz) = MAX(cldlay(ip,ic,iz),cldy(ip,ic,k))
+         cldlay(ip,ic,4) = MAX(cldlay(ip,ic,4),cldy(ip,ic,k))
+         lidarcld(ip,k)=lidarcld(ip,k) + cldy(ip,ic,k)
+
+         nsublay(ip,ic,iz) = MAX(nsublay(ip,ic,iz),srok(ip,ic,k))
+         nsublay(ip,ic,4) = MAX(nsublay(ip,ic,4),srok(ip,ic,k))
+         nsub(ip,k)=nsub(ip,k) + srok(ip,ic,k)
+
+        enddo
+       enddo
+      enddo
+#endif
+
+
+! -- grid-box 3D cloud fraction
+
+      where ( nsub(:,:).gt.0.0 )
+         lidarcld(:,:) = lidarcld(:,:)/nsub(:,:)
+      elsewhere
+         lidarcld(:,:) = undef
+      endwhere
+
+! -- layered cloud fractions
+
+      cldlayer = 0.0
+      nsublayer = 0.0
+
+      do iz = 1, Ncat
+       do ic = 1, Ncolumns
+
+          cldlayer(:,iz)=cldlayer(:,iz) + cldlay(:,ic,iz)
+          nsublayer(:,iz)=nsublayer(:,iz) + nsublay(:,ic,iz)
+
+       enddo
+      enddo
+      where ( nsublayer(:,:).gt.0.0 )
+         cldlayer(:,:) = cldlayer(:,:)/nsublayer(:,:)
+      elsewhere
+         cldlayer(:,:) = undef
+      endwhere
+
+! ---------------------------------------------------------------
+! 4- grid-box 3D cloud Phase :
+! ---------------------------------------------------------------
+! ---------------------------------------------------------------
+! 4.1 - For Cloudy pixels with 8.16km < z < 19.2km
+! ---------------------------------------------------------------
+do ncol=1,Ncolumns
+do i=1,Npoints
+
+      do nlev=Nlevels,18,-1  ! from 19.2km until 8.16km
+         p1 = pplay(i,nlev)
+
+
+! Avoid zero values
+	if( (cldy(i,ncol,nlev).eq.1.) .and. (ATBperp(i,ncol,nlev).gt.0.) )then
+! Computation of the ATBperp along the phase discrimination line
+           ATBperp_tmp = (ATB(i,ncol,nlev)**5)*alpha50 + (ATB(i,ncol,nlev)**4)*beta50 + &
+                         (ATB(i,ncol,nlev)**3)*gamma50 + (ATB(i,ncol,nlev)**2)*delta50 + &
+                          ATB(i,ncol,nlev)*epsilon50 + zeta50
+
+!____________________________________________________________________________________________________
+!
+!4.1.a Ice: ATBperp above the phase discrimination line
+!____________________________________________________________________________________________________
+!
+           if( (ATBperp(i,ncol,nlev)-ATBperp_tmp).ge.0. )then   ! Ice clouds
+             ! ICE with temperature above 273,15°K = Liquid (false ice)
+            if(tmp(i,nlev).gt.273.15)then                ! Temperature above 273,15 K
+              ! Liquid: False ice corrected by the temperature to Liquid
+               lidarcldphase(i,nlev,2)=lidarcldphase(i,nlev,2)+1.   ! false ice detection ==> added to Liquid
+               tmpl(i,ncol,nlev)=tmp(i,nlev)
+               lidarcldphase(i,nlev,5)=lidarcldphase(i,nlev,5)+1.   ! keep the information "temperature criterium used"
+                                                    ! to classify the phase cloud
+         	   cldlayphase(i,ncol,4,2) = 1.                         ! tot cloud
+                if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
+        	   cldlayphase(i,ncol,3,2) = 1.
+         	else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
+         	   cldlayphase(i,ncol,2,2) = 1.
+	 	else                                                    ! low cloud
+         	   cldlayphase(i,ncol,1,2) = 1.
+                endif
+         	   cldlayphase(i,ncol,4,5) = 1.                         ! tot cloud
+         	if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
+        	   cldlayphase(i,ncol,3,5) = 1.
+         	else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
+         	   cldlayphase(i,ncol,2,5) = 1.
+	 	else                                                    ! low cloud
+         	   cldlayphase(i,ncol,1,5) = 1.
+                endif
+
+             else
+             ! ICE with temperature below 273,15°K
+              lidarcldphase(i,nlev,1)=lidarcldphase(i,nlev,1)+1.
+              tmpi(i,ncol,nlev)=tmp(i,nlev)
+         	   cldlayphase(i,ncol,4,1) = 1.                         ! tot cloud
+         	if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
+        	   cldlayphase(i,ncol,3,1) = 1.
+         	else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
+         	   cldlayphase(i,ncol,2,1) = 1.
+	 	else                                                    ! low cloud
+         	   cldlayphase(i,ncol,1,1) = 1.
+                endif
+
+              endif
+
+!____________________________________________________________________________________________________
+!
+! 4.1.b Liquid: ATBperp below the phase discrimination line
+!____________________________________________________________________________________________________
+!
+             else                                        ! Liquid clouds
+              ! Liquid with temperature above 231,15°K
+            if(tmp(i,nlev).gt.231.15)then 
+               lidarcldphase(i,nlev,2)=lidarcldphase(i,nlev,2)+1.
+               tmpl(i,ncol,nlev)=tmp(i,nlev)
+         	   cldlayphase(i,ncol,4,2) = 1.                         ! tot cloud
+         	if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
+         	   cldlayphase(i,ncol,3,2) = 1.  
+         	else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
+         	   cldlayphase(i,ncol,2,2) = 1.
+	 	else                                                    ! low cloud
+         	   cldlayphase(i,ncol,1,2) = 1.
+	 	endif
+
+             else
+             ! Liquid with temperature below 231,15°K = Ice (false liquid)
+               tmpi(i,ncol,nlev)=tmp(i,nlev)
+               lidarcldphase(i,nlev,1)=lidarcldphase(i,nlev,1)+1.   ! false liquid detection ==> added to ice
+               lidarcldphase(i,nlev,4)=lidarcldphase(i,nlev,4)+1.   ! keep the information "temperature criterium used"
+                                                    ! to classify the phase cloud
+         	   cldlayphase(i,ncol,4,4) = 1.                         ! tot cloud
+         	if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
+         	   cldlayphase(i,ncol,3,4) = 1.  
+         	else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
+         	   cldlayphase(i,ncol,2,4) = 1.
+	 	else                                                    ! low cloud
+         	   cldlayphase(i,ncol,1,4) = 1.
+	 	endif
+         	   cldlayphase(i,ncol,4,1) = 1.                         ! tot cloud
+        	if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
+         	   cldlayphase(i,ncol,3,1) = 1.  
+         	else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
+         	   cldlayphase(i,ncol,2,1) = 1.
+	 	else                                                    ! low cloud
+         	   cldlayphase(i,ncol,1,1) = 1.
+	 	endif
+
+             endif
+
+            endif  ! end of discrimination condition 
+	 endif  ! end of cloud condition
+      enddo ! end of altitude loop
+
+
+
+! ---------------------------------------------------------------
+! 4.2 - For Cloudy pixels with 0km < z < 8.16km
+! ---------------------------------------------------------------
+
+      toplvlsat=0
+      do nlev=17,1,-1  ! from 8.16km until 0km
+         p1 = pplay(i,nlev)
+
+	if( (cldy(i,ncol,nlev).eq.1.) .and. (ATBperp(i,ncol,nlev).gt.0.) )then
+! Phase discrimination line : ATBperp = ATB^5*alpha50 + ATB^4*beta50 + ATB^3*gamma50 + ATB^2*delta50 
+!                                  + ATB*epsilon50 + zeta50
+! Computation of the ATBperp of the phase discrimination line
+           ATBperp_tmp = (ATB(i,ncol,nlev)**5)*alpha50 + (ATB(i,ncol,nlev)**4)*beta50 + &
+                         (ATB(i,ncol,nlev)**3)*gamma50 + (ATB(i,ncol,nlev)**2)*delta50 + &
+                          ATB(i,ncol,nlev)*epsilon50 + zeta50
+!____________________________________________________________________________________________________
+!
+! 4.2.a Ice: ATBperp above the phase discrimination line
+!____________________________________________________________________________________________________
+!
+            ! ICE with temperature above 273,15°K = Liquid (false ice)
+          if( (ATBperp(i,ncol,nlev)-ATBperp_tmp).ge.0. )then   ! Ice clouds
+            if(tmp(i,nlev).gt.273.15)then 
+               lidarcldphase(i,nlev,2)=lidarcldphase(i,nlev,2)+1.  ! false ice ==> liq
+               tmpl(i,ncol,nlev)=tmp(i,nlev)
+               lidarcldphase(i,nlev,5)=lidarcldphase(i,nlev,5)+1.
+
+         	   cldlayphase(i,ncol,4,2) = 1.                         ! tot cloud
+               if ( p1.gt.0. .and. p1.lt.(440.*100.)) then              ! high cloud
+        	   cldlayphase(i,ncol,3,2) = 1.
+         	else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
+         	   cldlayphase(i,ncol,2,2) = 1.
+	 	else                                                    ! low cloud
+         	   cldlayphase(i,ncol,1,2) = 1.
+                endif
+
+         	   cldlayphase(i,ncol,4,5) = 1.                         ! tot cloud
+         	if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
+        	   cldlayphase(i,ncol,3,5) = 1.
+         	else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
+         	   cldlayphase(i,ncol,2,5) = 1.
+	 	else                                                    ! low cloud
+         	   cldlayphase(i,ncol,1,5) = 1.
+                endif
+
+             else
+              ! ICE with temperature below 273,15°K
+              lidarcldphase(i,nlev,1)=lidarcldphase(i,nlev,1)+1.
+              tmpi(i,ncol,nlev)=tmp(i,nlev)
+
+          	   cldlayphase(i,ncol,4,1) = 1.                         ! tot cloud
+        	if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
+        	   cldlayphase(i,ncol,3,1) = 1.
+         	else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
+         	   cldlayphase(i,ncol,2,1) = 1.
+	 	else                                                    ! low cloud
+         	   cldlayphase(i,ncol,1,1) = 1.
+                endif
+
+              endif
+
+!____________________________________________________________________________________________________
+!
+! 4.2.b Liquid: ATBperp below the phase discrimination line
+!____________________________________________________________________________________________________
+!
+          else  
+             ! Liquid with temperature above 231,15°K
+            if(tmp(i,nlev).gt.231.15)then 
+               lidarcldphase(i,nlev,2)=lidarcldphase(i,nlev,2)+1.
+               tmpl(i,ncol,nlev)=tmp(i,nlev)
+
+         	   cldlayphase(i,ncol,4,2) = 1.                         ! tot cloud
+         	if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
+         	   cldlayphase(i,ncol,3,2) = 1.  
+         	else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
+         	   cldlayphase(i,ncol,2,2) = 1.
+	 	else                                                    ! low cloud
+         	   cldlayphase(i,ncol,1,2) = 1.
+	 	endif
+
+             else
+             ! Liquid with temperature below 231,15°K = Ice (false liquid)
+               tmpi(i,ncol,nlev)=tmp(i,nlev)
+               lidarcldphase(i,nlev,1)=lidarcldphase(i,nlev,1)+1.  ! false liq ==> ice
+               lidarcldphase(i,nlev,4)=lidarcldphase(i,nlev,4)+1.  ! false liq ==> ice
+
+         	   cldlayphase(i,ncol,4,4) = 1.                         ! tot cloud
+         	if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
+         	   cldlayphase(i,ncol,3,4) = 1.  
+         	else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
+         	   cldlayphase(i,ncol,2,4) = 1.
+	 	else                                                    ! low cloud
+         	   cldlayphase(i,ncol,1,4) = 1.
+	 	endif
+
+         	   cldlayphase(i,ncol,4,1) = 1.                         ! tot cloud
+        	if ( p1.gt.0. .and. p1.lt.(440.*100.)) then             ! high cloud
+         	   cldlayphase(i,ncol,3,1) = 1.  
+         	else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then ! mid cloud
+         	   cldlayphase(i,ncol,2,1) = 1.
+	 	else                                                    ! low cloud
+         	   cldlayphase(i,ncol,1,1) = 1.
+	 	endif
+
+             endif
+           endif  ! end of discrimination condition 
+
+       	    toplvlsat=0
+
+           ! Find the level of the highest cloud with SR>30
+	    if(x(i,ncol,nlev).gt.S_cld_att)then	 ! SR > 30.
+      		toplvlsat=nlev-1
+       		goto 99 
+    	    endif
+
+	endif  ! end of cloud condition
+       enddo  ! end of altitude loop
+
+99 continue
+
+!____________________________________________________________________________________________________
+!
+! Undefined phase: For a cloud located below another cloud with SR>30 
+! see Cesana and Chepfer 2013 Sect.III.2
+!____________________________________________________________________________________________________
+!
+if(toplvlsat.ne.0)then     	
+      do nlev=toplvlsat,1,-1
+         p1 = pplay(i,nlev)
+	if(cldy(i,ncol,nlev).eq.1.)then
+           lidarcldphase(i,nlev,3)=lidarcldphase(i,nlev,3)+1.
+           tmpu(i,ncol,nlev)=tmp(i,nlev)
+
+         	   cldlayphase(i,ncol,4,3) = 1.                         ! tot cloud
+          if ( p1.gt.0. .and. p1.lt.(440.*100.)) then              ! high cloud
+             cldlayphase(i,ncol,3,3) = 1.
+          else if(p1.ge.(440.*100.) .and. p1.lt.(680.*100.)) then  ! mid cloud
+             cldlayphase(i,ncol,2,3) = 1.
+	  else                                                     ! low cloud
+             cldlayphase(i,ncol,1,3) = 1.
+	  endif
+
+        endif	
+      enddo
+endif
+     
+      toplvlsat=0
+
+enddo
+enddo
+
+
+
+!____________________________________________________________________________________________________
+!
+! Computation of final cloud phase diagnosis
+!____________________________________________________________________________________________________
+!
+
+! Compute the Ice percentage in cloud = ice/(ice+liq) as a function
+! of the occurrences
+lidarcldphasetmp(:,:)=lidarcldphase(:,:,1)+lidarcldphase(:,:,2);
+WHERE (lidarcldphasetmp(:,:).gt. 0.)
+   lidarcldphase(:,:,6)=lidarcldphase(:,:,1)/lidarcldphasetmp(:,:)
+ELSEWHERE
+   lidarcldphase(:,:,6) = undef
+ENDWHERE
+
+! Compute Phase 3D Cloud Fraction
+     WHERE ( nsub(:,:).gt.0.0 )
+       lidarcldphase(:,:,1)=lidarcldphase(:,:,1)/nsub(:,:)
+       lidarcldphase(:,:,2)=lidarcldphase(:,:,2)/nsub(:,:)
+       lidarcldphase(:,:,3)=lidarcldphase(:,:,3)/nsub(:,:)
+       lidarcldphase(:,:,4)=lidarcldphase(:,:,4)/nsub(:,:)
+       lidarcldphase(:,:,5)=lidarcldphase(:,:,5)/nsub(:,:)
+     ELSEWHERE
+       lidarcldphase(:,:,1) = undef
+       lidarcldphase(:,:,2) = undef
+       lidarcldphase(:,:,3) = undef
+       lidarcldphase(:,:,4) = undef
+       lidarcldphase(:,:,5) = undef
+     ENDWHERE
+
+
+! Compute Phase low mid high cloud fractions
+    do iz = 1, Ncat
+       do i=1,Nphase-3
+       do ic = 1, Ncolumns
+          cldlayerphase(:,iz,i)=cldlayerphase(:,iz,i) + cldlayphase(:,ic,iz,i)
+          cldlayerphasesum(:,iz)=cldlayerphasesum(:,iz)+cldlayphase(:,ic,iz,i)
+       enddo
+      enddo
+    enddo
+
+    do iz = 1, Ncat
+       do i=4,5
+       do ic = 1, Ncolumns
+          cldlayerphase(:,iz,i)=cldlayerphase(:,iz,i) + cldlayphase(:,ic,iz,i)          
+       enddo
+       enddo
+    enddo
+    
+! Compute the Ice percentage in cloud = ice/(ice+liq)
+cldlayerphasetmp(:,:)=cldlayerphase(:,:,1)+cldlayerphase(:,:,2)
+    WHERE (cldlayerphasetmp(:,:).gt. 0.)
+       cldlayerphase(:,:,6)=cldlayerphase(:,:,1)/cldlayerphasetmp(:,:)
+    ELSEWHERE
+       cldlayerphase(:,:,6) = undef
+    ENDWHERE
+
+    do i=1,Nphase-1
+      WHERE ( cldlayerphasesum(:,:).gt.0.0 )
+         cldlayerphase(:,:,i) = (cldlayerphase(:,:,i)/cldlayerphasesum(:,:)) * cldlayer(:,:) 
+      ENDWHERE
+    enddo
+
+
+    do i=1,Npoints
+       do iz=1,Ncat
+          checkcldlayerphase=0.
+          checkcldlayerphase2=0.
+
+          if (cldlayerphasesum(i,iz).gt.0.0 )then
+             do ic=1,Nphase-3
+                checkcldlayerphase=checkcldlayerphase+cldlayerphase(i,iz,ic)  
+             enddo
+             checkcldlayerphase2=cldlayer(i,iz)-checkcldlayerphase
+             if( (checkcldlayerphase2.gt.0.01).or.(checkcldlayerphase2.lt.-0.01) ) print *, checkcldlayerphase,cldlayer(i,iz)
+
+          endif
+
+       enddo
+    enddo
+
+    do i=1,Nphase-1
+      WHERE ( nsublayer(:,:).eq.0.0 )
+         cldlayerphase(:,:,i) = undef
+      ENDWHERE
+   enddo
+
+
+
+! Compute Phase 3D as a function of temperature
+do nlev=1,Nlevels
+do ncol=1,Ncolumns     
+do i=1,Npoints
+do itemp=1,Ntemp
+if(tmpi(i,ncol,nlev).gt.0.)then
+      if( (tmpi(i,ncol,nlev).ge.tempmod(itemp)).and.(tmpi(i,ncol,nlev).lt.tempmod(itemp+1)) )then
+        lidarcldtemp(i,itemp,2)=lidarcldtemp(i,itemp,2)+1.
+      endif
+elseif(tmpl(i,ncol,nlev).gt.0.)then
+      if( (tmpl(i,ncol,nlev).ge.tempmod(itemp)).and.(tmpl(i,ncol,nlev).lt.tempmod(itemp+1)) )then
+        lidarcldtemp(i,itemp,3)=lidarcldtemp(i,itemp,3)+1.
+      endif
+elseif(tmpu(i,ncol,nlev).gt.0.)then
+      if( (tmpu(i,ncol,nlev).ge.tempmod(itemp)).and.(tmpu(i,ncol,nlev).lt.tempmod(itemp+1)) )then
+        lidarcldtemp(i,itemp,4)=lidarcldtemp(i,itemp,4)+1.
+      endif
+endif
+enddo
+enddo
+enddo
+enddo
+
+! Check temperature cloud fraction
+do i=1,Npoints
+   do itemp=1,Ntemp
+checktemp=lidarcldtemp(i,itemp,2)+lidarcldtemp(i,itemp,3)+lidarcldtemp(i,itemp,4)
+
+	if(checktemp.NE.lidarcldtemp(i,itemp,1))then
+	  print *, i,itemp
+	  print *, lidarcldtemp(i,itemp,1:4)
+	endif
+
+   enddo
+enddo
+
+! Compute the Ice percentage in cloud = ice/(ice+liq)
+!   sumlidarcldtemp=sum(lidarcldtemp(:,:,2:3),3)
+   sumlidarcldtemp(:,:)=lidarcldtemp(:,:,2)+lidarcldtemp(:,:,3)
+
+WHERE(sumlidarcldtemp(:,:)>0.)
+  lidarcldtemp(:,:,5)=lidarcldtemp(:,:,2)/sumlidarcldtemp(:,:)
+ELSEWHERE
+  lidarcldtemp(:,:,5)=undef
+ENDWHERE
+
+do i=1,4
+  WHERE(lidarcldtempind(:,:).gt.0.)
+     lidarcldtemp(:,:,i) = lidarcldtemp(:,:,i)/lidarcldtempind(:,:)
+  ELSEWHERE
+     lidarcldtemp(:,:,i) = undef
+  ENDWHERE
+enddo
+
+       RETURN
+      END SUBROUTINE COSP_CLDFRAC
+! ---------------------------------------------------------------
+
+! BEGINNING OF OPAQ CHANGES
+    ! ####################################################################################
+    ! SUBROUTINE cosp_opaq
+    ! Conventions: Ntype must be equal to 3 (opaque cloud, thin cloud, z_opaque)
+    ! ####################################################################################
+    SUBROUTINE COSP_OPAQ(Npoints,Ncolumns,Nlevels,Ntype,x,S_cld,undef,lidarcldtype,   &
+                         cldtype,vgrid_z)
+
+      IMPLICIT NONE
+! Input arguments
+      integer Npoints,Ncolumns,Nlevels,Ntype
+      real x(Npoints,Ncolumns,Nlevels)
+      real S_cld
+      real undef
+      real vgrid_z(Nlevels)
+! Output :
+      real lidarcldtype(Npoints,Nlevels,Ntype+1) ! 3D "lidar" OPAQ type + opacity fraction
+      real cldtype(Npoints,Ntype)              ! opaque and thin cloud covers, z_opaque
+! Local variables
+      integer ip, k, iz, ic, zopac
+      real p1
+      real cldy(Npoints,Ncolumns,Nlevels)
+      real cldyopaq(Npoints,Ncolumns,Nlevels)
+      real srok(Npoints,Ncolumns,Nlevels)
+      real srokopaq(Npoints,Ncolumns,Nlevels)
+      real cldlay(Npoints,Ncolumns,Ntype+1)  ! opaque, thin, z_opaque and all cloud cover
+      real nsublay(Npoints,Ncolumns,Ntype+1) ! opaque, thin, z_opaque and all cloud cover
+      real nsublayer(Npoints,Ntype)
+      real nsub(Npoints,Nlevels)
+      real nsubopaq(Npoints,Nlevels)
+      real S_att_opaq
+      real S_att
+  
+    ! ####################################################################################
+	! 1) Initialize    
+    ! ####################################################################################
+    cldtype               = 0.0
+    lidarcldtype          = 0.0
+    nsub                  = 0.0
+    nsubopaq              = 0.0
+    cldlay                = 0.0
+    nsublay               = 0.0
+    nsublayer             = 0.0
+    S_att_opaq            = 0.06 ! Fully Attenuated threshold, from Guzman et al. 2017, JGR-A
+    S_att                 = 0.01 
+
+    ! ####################################################################################
+    ! 2) Cloud detection and Fully attenuated layer detection
+    ! ####################################################################################
+    do k=1,Nlevels
+       ! Cloud detection at subgrid-scale:
+       where ( (x(:,:,k) .gt. S_cld) .and. (x(:,:,k) .ne. undef) )
+          cldy(:,:,k)=1.0
+       elsewhere
+          cldy(:,:,k)=0.0
+       endwhere
+       ! Fully attenuated layer detection at subgrid-scale:
+       where ( (x(:,:,k) .gt. 0.0) .and. (x(:,:,k) .lt. S_att_opaq) .and. (x(:,:,k) .ne. undef) )
+          cldyopaq(:,:,k)=1.0
+       elsewhere
+          cldyopaq(:,:,k)=0.0
+       endwhere
+
+       ! Number of useful sub-column layers:
+       where ( (x(:,:,k) .gt. S_att) .and. (x(:,:,k) .ne. undef) )
+          srok(:,:,k)=1.0
+       elsewhere
+          srok(:,:,k)=0.0
+       endwhere
+       ! Number of useful sub-columns layers for z_opaque 3D fraction:
+       where ( (x(:,:,k) .gt. 0.0) .and. (x(:,:,k) .ne. undef) )
+          srokopaq(:,:,k)=1.0
+       elsewhere
+          srokopaq(:,:,k)=0.0
+       endwhere
+    enddo
+
+    ! ####################################################################################
+    ! 3) Grid-box 3D OPAQ product fraction and cloud type cover (opaque/thin) + mean z_opaque
+    ! ####################################################################################
+
+    do k= Nlevels,1,-1
+       do ic = 1, Ncolumns
+          do ip = 1, Npoints
+
+             cldlay(ip,ic,1)   = MAX(cldlay(ip,ic,1),cldyopaq(ip,ic,k)) ! Opaque clouds
+             cldlay(ip,ic,4)   = MAX(cldlay(ip,ic,4),cldy(ip,ic,k))     ! All clouds
+
+             nsublay(ip,ic,1)  = MAX(nsublay(ip,ic,1),srok(ip,ic,k))
+             nsublay(ip,ic,2)  = MAX(nsublay(ip,ic,2),srok(ip,ic,k))
+!             nsublay(ip,ic,4)  = MAX(nsublay(ip,ic,4),srok(ip,ic,k))
+             nsub(ip,k)        = nsub(ip,k) + srok(ip,ic,k)
+             nsubopaq(ip,k)    = nsubopaq(ip,k) + srokopaq(ip,ic,k)
+
+          enddo
+       enddo
+    enddo   
+
+! OPAQ variables
+     do ic = 1, Ncolumns
+        do ip = 1, Npoints
+
+     ! Declaring non-opaque cloudy profiles as thin cloud profiles
+	   if ( (cldlay(ip,ic,4) .eq. 1.0) .and. (cldlay(ip,ic,1) .eq. 0.0) ) then
+	      cldlay(ip,ic,2)  =  1.0
+ 	   endif
+
+     ! Filling in 3D and 2D variables
+
+     ! Opaque cloud profiles
+	   if ( cldlay(ip,ic,1) .eq. 1.0 ) then
+	      zopac = 0.0
+	      do k=2,Nlevels
+     ! Declaring opaque cloud fraction and z_opaque altitude for 3D and 2D variables
+	         if ( (cldy(ip,ic,k) .eq. 1.0) .and. (zopac .eq. 0.0) ) then
+		    lidarcldtype(ip,k-1,3) = lidarcldtype(ip,k-1,3) + 1.0
+		    cldlay(ip,ic,3)        = vgrid_z(k-1) !z_opaque altitude
+		    nsublay(ip,ic,3)       = 1.0
+		    zopac = 1.0
+		 endif
+	         if ( cldy(ip,ic,k) .eq. 1.0 ) then
+		    lidarcldtype(ip,k,1)   = lidarcldtype(ip,k,1) + 1.0
+                 endif
+	      enddo
+	   endif
+
+     ! Thin cloud profiles
+	   if ( cldlay(ip,ic,2) .eq. 1.0 ) then
+	      do k=1,Nlevels
+     ! Declaring thin cloud fraction for 3D variable
+                 if ( cldy(ip,ic,k) .eq. 1.0 ) then
+                    lidarcldtype(ip,k,2) = lidarcldtype(ip,k,2) + 1.0
+                 endif
+	      enddo
+           endif
+
+       enddo
+    enddo   
+
+    ! 3D cloud types fraction (opaque=1 and thin=2)
+    where ( nsub(:,:) .gt. 0.0 )
+       lidarcldtype(:,:,1) = lidarcldtype(:,:,1)/nsub(:,:)
+       lidarcldtype(:,:,2) = lidarcldtype(:,:,2)/nsub(:,:)
+    elsewhere
+       lidarcldtype(:,:,1) = undef
+       lidarcldtype(:,:,2) = undef
+    endwhere
+    ! 3D z_opaque fraction (=3)
+    where ( nsubopaq(:,:) .gt. 0.0 )
+       lidarcldtype(:,:,3) = lidarcldtype(:,:,3)/nsubopaq(:,:)
+    elsewhere
+       lidarcldtype(:,:,3) = undef
+    endwhere
+    ! 3D opacity fraction (=4) !Summing z_opaque fraction from TOA(k=Nlevels) to SFC(k=1)
+       lidarcldtype(:,Nlevels,4) = lidarcldtype(:,Nlevels,3)
+    do ip = 1, Npoints
+     	do k = Nlevels-1, 1, -1
+           if ( lidarcldtype(ip,k,3) .ne. undef ) then
+	      lidarcldtype(ip,k,4) = lidarcldtype(ip,k+1,4) + lidarcldtype(ip,k,3)
+           endif
+	enddo
+    enddo
+    where ( nsubopaq(:,:) .eq. 0.0 )
+       lidarcldtype(:,:,4) = undef
+    endwhere
+
+    ! Layered cloud types (opaque, thin and z_opaque 2D variables)
+
+    do iz = 1, Ntype
+       do ic = 1, Ncolumns
+          cldtype(:,iz)   = cldtype(:,iz)   + cldlay(:,ic,iz)
+          nsublayer(:,iz) = nsublayer(:,iz) + nsublay(:,ic,iz)
+       enddo
+    enddo
+    where (nsublayer(:,:) .gt. 0.0)
+       cldtype(:,:) = cldtype(:,:)/nsublayer(:,:)
+    elsewhere
+       cldtype(:,:) = undef
+    endwhere
+
+  END SUBROUTINE COSP_OPAQ
+! END OF OPAQ CHANGES
+
+
+END MODULE MOD_LMD_IPSL_STATS
Index: LMDZ6/trunk/libf/phylmd/cosp/mod_modis_sim.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/cosp/mod_modis_sim.F90	(revision 3233)
+++ LMDZ6/trunk/libf/phylmd/cosp/mod_modis_sim.F90	(revision 3233)
@@ -0,0 +1,1274 @@
+! (c) 2009-2010, Regents of the Unversity of Colorado
+!   Author: Robert Pincus, Cooperative Institute for Research in the Environmental Sciences
+! All rights reserved.
+! $Revision: 88 $, $Date: 2013-11-13 07:08:38 -0700 (Wed, 13 Nov 2013) $
+! $URL: http://cfmip-obs-sim.googlecode.com/svn/stable/v1.4.0/MODIS_simulator/modis_simulator.F90 $
+! 
+! 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.
+!
+
+!
+! History:
+!   May 2009 - Robert Pincus - Initial version
+!   June 2009 - Steve Platnick and Robert Pincus - Simple radiative transfer for size retrievals
+!   August 2009 - Robert Pincus - Consistency and bug fixes suggested by Rick Hemler (GFDL) 
+!   November 2009 - Robert Pincus - Bux fixes and speed-ups after experience with Rick Hemler using AM2 (GFDL) 
+!   January 2010 - Robert Pincus - Added high, middle, low cloud fractions 
+!
+
+!
+! Notes on using the MODIS simulator: 
+!  *) You may provide either layer-by-layer values of optical thickness at 0.67 and 2.1 microns, or 
+!     optical thickness at 0.67 microns and ice- and liquid-water contents (in consistent units of 
+!     your choosing)
+!  *) Required input also includes the optical thickness and cloud top pressure 
+!     derived from the ISCCP simulator run with parameter top_height = 1. 
+!  *) Cloud particle sizes are specified as radii, measured in meters, though within the module we 
+!     use units of microns. Where particle sizes are outside the bounds used in the MODIS retrieval
+!     libraries (parameters re_water_min, re_ice_min, etc.) the simulator returns missing values (re_fill)
+
+!
+! When error conditions are encountered this code calls the function complain_and_die, supplied at the 
+!   bottom of this module. Users probably want to replace this with something more graceful. 
+!
+module mod_modis_sim
+  USE MOD_COSP_TYPES, only: R_UNDEF
+  implicit none
+  ! ------------------------------
+  ! Algorithmic parameters
+  !
+ 
+  real, parameter :: ice_density          = 0.93               ! liquid density is 1.  
+  !
+  ! Retrieval parameters
+  !
+  real, parameter :: min_OpticalThickness = 0.3,             & ! Minimum detectable optical thickness
+                     CO2Slicing_PressureLimit = 700. * 100., & ! Cloud with higher pressures use thermal methods, units Pa
+                     CO2Slicing_TauLimit = 1.,               & ! How deep into the cloud does CO2 slicing see? 
+                     phase_TauLimit      = 1.,               & ! How deep into the cloud does the phase detection see?
+                     size_TauLimit       = 2.,               & ! Depth of the re retreivals
+                     phaseDiscrimination_Threshold = 0.7       ! What fraction of total extincton needs to be 
+                                                               !  in a single category to make phase discrim. work? 
+  real,    parameter :: re_fill= -999.
+  integer, parameter :: phaseIsNone = 0, phaseIsLiquid = 1, phaseIsIce = 2, phaseIsUndetermined = 3
+  
+  logical, parameter :: useSimpleReScheme = .false. 
+  !
+  ! These are the limits of the libraries for the MODIS collection 5 algorithms 
+  !   They are also the limits used in the fits for g and w0
+  !
+  real,    parameter :: re_water_min= 4., re_water_max= 30., re_ice_min= 5., re_ice_max= 90.
+  integer, parameter :: num_trial_res = 15             ! increase to make the linear pseudo-retrieval of size more accurate
+! DJS2015: Remove unused parameter
+!  logical, parameter :: use_two_re_iterations = .false. ! do two retrieval iterations? 
+! DJS2015 END  
+  !
+  ! Precompute near-IR optical params vs size for retrieval scheme
+  !
+  integer, private :: i 
+  real, dimension(num_trial_res), parameter :: & 
+        trial_re_w = re_water_min + (re_water_max - re_water_min)/(num_trial_res-1) * (/ (i - 1, i = 1, num_trial_res) /), &
+        trial_re_i = re_ice_min   + (re_ice_max -   re_ice_min)  /(num_trial_res-1) * (/ (i - 1, i = 1, num_trial_res) /)
+  
+  ! Can't initialze these during compilation, but do in before looping columns in retrievals
+  real, dimension(num_trial_res) ::  g_w, g_i, w0_w, w0_i
+  ! ------------------------------
+  ! Bin boundaries for the joint optical thickness/cloud top pressure histogram
+  !
+  integer, parameter :: numTauHistogramBins = 6, numPressureHistogramBins = 7
+
+  real, private :: dummy_real 
+  real, dimension(numTauHistogramBins + 1),      parameter :: &
+    tauHistogramBoundaries = (/ min_OpticalThickness, 1.3, 3.6, 9.4, 23., 60., 10000. /) 
+  real, dimension(numPressureHistogramBins + 1), parameter :: & ! Units Pa 
+    pressureHistogramBoundaries = (/ 0., 18000., 31000., 44000., 56000., 68000., 80000., 1000000. /) 
+  real, parameter :: highCloudPressureLimit = 440. * 100., lowCloudPressureLimit = 680. * 100.
+  !
+  ! For output - nominal bin centers and  bin boundaries. On output pressure bins are highest to lowest. 
+  !
+  integer, private :: k, l
+  real, parameter, dimension(2, numTauHistogramBins) ::   &
+    nominalTauHistogramBoundaries =                       &
+        reshape(source = (/ tauHistogramBoundaries(1),    &
+                            ((tauHistogramBoundaries(k), l = 1, 2), k = 2, numTauHistogramBins), &
+                            100000. /),                    &
+                shape = (/2,  numTauHistogramBins /) )
+  real, parameter, dimension(numTauHistogramBins) ::                    &
+    nominalTauHistogramCenters = (nominalTauHistogramBoundaries(1, :) + &
+                                  nominalTauHistogramBoundaries(2, :) ) / 2.
+  
+  real, parameter, dimension(2, numPressureHistogramBins) :: &
+    nominalPressureHistogramBoundaries =                     &
+        reshape(source = (/ 100000.,                         &
+                            ((pressureHistogramBoundaries(k), l = 1, 2), k = numPressureHistogramBins, 2, -1), &
+                            0.  /), &
+                shape = (/2,  numPressureHistogramBins /) )
+  real, parameter, dimension(numPressureHistogramBins) ::                         &
+    nominalPressureHistogramCenters = (nominalPressureHistogramBoundaries(1, :) + &
+                                       nominalPressureHistogramBoundaries(2, :) ) / 2.
+  ! DJS2015 START: Add bin descriptions for joint-histograms of partice-sizes and optical depth. This is
+  !                identical to what is done in COSPv.2.0.0 for histogram bin initialization. 
+  integer :: j
+  integer,parameter :: &
+       numMODISReffLiqBins = 6, & ! Number of bins for tau/ReffLiq joint-histogram
+       numMODISReffIceBins = 6    ! Number of bins for tau/ReffICE joint-histogram
+  real,parameter,dimension(numMODISReffLiqBins+1) :: &
+       reffLIQ_binBounds = (/0., 8e-6, 1.0e-5, 1.3e-5, 1.5e-5, 2.0e-5, 3.0e-5/)
+  real,parameter,dimension(numMODISReffIceBins+1) :: &
+       reffICE_binBounds = (/0., 1.0e-5, 2.0e-5, 3.0e-5, 4.0e-5, 6.0e-5, 9.0e-5/)
+  real,parameter,dimension(2,numMODISReffIceBins) :: &
+       reffICE_binEdges = reshape(source=(/reffICE_binBounds(1),((reffICE_binBounds(k),  &
+                                  l=1,2),k=2,numMODISReffIceBins),reffICE_binBounds(numMODISReffIceBins+1)/),  &
+                                  shape = (/2,numMODISReffIceBins/)) 
+  real,parameter,dimension(2,numMODISReffLiqBins) :: &
+       reffLIQ_binEdges = reshape(source=(/reffLIQ_binBounds(1),((reffLIQ_binBounds(k),  &
+                                  l=1,2),k=2,numMODISReffLiqBins),reffLIQ_binBounds(numMODISReffIceBins+1)/),  &
+                                  shape = (/2,numMODISReffLiqBins/))             
+  real,parameter,dimension(numMODISReffIceBins) :: &
+       reffICE_binCenters = (reffICE_binEdges(1,:)+reffICE_binEdges(2,:))/2.
+  real,parameter,dimension(numMODISReffLiqBins) :: &
+       reffLIQ_binCenters = (reffLIQ_binEdges(1,:)+reffLIQ_binEdges(2,:))/2.
+  ! DJS2015 END
+
+  ! ------------------------------
+  ! There are two ways to call the MODIS simulator: 
+  !  1) Provide total optical thickness and liquid/ice water content and we'll partition tau in 
+  !     subroutine modis_L2_simulator_oneTau, or 
+  !  2) Provide ice and liquid optical depths in each layer
+  !
+  interface modis_L2_simulator
+    module procedure modis_L2_simulator_oneTau, modis_L2_simulator_twoTaus
+  end interface 
+contains
+  !------------------------------------------------------------------------------------------------
+  ! MODIS simulator using specified liquid and ice optical thickness in each layer 
+  !
+  !   Note: this simulator operates on all points; to match MODIS itself night-time 
+  !     points should be excluded
+  !
+  !   Note: the simulator requires as input the optical thickness and cloud top pressure 
+  !     derived from the ISCCP simulator run with parameter top_height = 1. 
+  !     If cloud top pressure is higher than about 700 mb, MODIS can't use CO2 slicing 
+  !     and reverts to a thermal algorithm much like ISCCP's. Rather than replicate that 
+  !     alogrithm in this simulator we simply report the values from the ISCCP simulator. 
+  !
+  subroutine modis_L2_simulator_twoTaus(                                       &
+                                temp, pressureLayers, pressureLevels,          &
+                                liquid_opticalThickness, ice_opticalThickness, &
+                                waterSize, iceSize,                            & 
+                                isccpTau, isccpCloudTopPressure,               &
+                                retrievedPhase, retrievedCloudTopPressure, retrievedTau, retrievedSize)
+
+    ! Grid-mean quantities at layer centers, starting at the model top
+    !   dimension nLayers
+    real, dimension(:),    intent(in ) :: temp,           & ! Temperature, K
+                                          pressureLayers, & ! Pressure, Pa
+                                          pressureLevels    ! Pressure at layer edges, Pa (dimension nLayers + 1) 
+    ! Sub-column quantities
+    !   dimension  nSubcols, nLayers
+    real, dimension(:, :), intent(in ) :: liquid_opticalThickness, & ! Layer optical thickness @ 0.67 microns due to liquid
+                                          ice_opticalThickness       ! ditto, due to ice
+    real, dimension(:, :), intent(in ) :: waterSize,        & ! Cloud drop effective radius, microns
+                                          iceSize             ! Cloud ice effective radius, microns
+                                          
+    ! Cloud properties retrieved from ISCCP using top_height = 1
+    !    dimension nSubcols
+    real, dimension(:),    intent(in ) :: isccpTau, &           ! Column-integrated optical thickness 
+                                          isccpCloudTopPressure ! ISCCP-retrieved cloud top pressure (Pa) 
+
+    ! Properties retrieved by MODIS
+    !   dimension nSubcols
+    integer, dimension(:), intent(out) :: retrievedPhase               ! liquid/ice/other - integer, defined in module header
+    real,    dimension(:), intent(out) :: retrievedCloudTopPressure, & ! units of pressureLayers
+                                          retrievedTau,              & ! unitless
+                                          retrievedSize                ! microns 
+    ! ---------------------------------------------------
+    ! Local variables
+    logical, dimension(size(retrievedTau))                     :: cloudMask
+    real,    dimension(size(waterSize, 1), size(waterSize, 2)) :: tauLiquidFraction, tauTotal
+    real    :: integratedLiquidFraction
+    integer :: i, nSubcols, nLevels
+
+    ! ---------------------------------------------------
+    nSubcols = size(liquid_opticalThickness, 1)
+    nLevels  = size(liquid_opticalThickness, 2) 
+ 
+    !
+    ! Initial error checks 
+    !   
+    if(any((/ size(ice_opticalThickness, 1), size(waterSize, 1), size(iceSize, 1), &
+              size(isccpTau), size(isccpCloudTopPressure),              &
+              size(retrievedPhase), size(retrievedCloudTopPressure),    &
+              size(retrievedTau), size(retrievedSize) /) /= nSubcols )) &
+       call complain_and_die("Differing number of subcolumns in one or more arrays") 
+    
+    if(any((/ size(ice_opticalThickness, 2), size(waterSize, 2), size(iceSize, 2),      &
+              size(temp), size(pressureLayers), size(pressureLevels)-1 /) /= nLevels )) &
+       call complain_and_die("Differing number of levels in one or more arrays") 
+       
+       
+    if(any( (/ any(temp <= 0.), any(pressureLayers <= 0.),  &
+               any(liquid_opticalThickness < 0.),           &
+               any(ice_opticalThickness < 0.),              &
+               any(waterSize < 0.), any(iceSize < 0.) /) )) &
+       call complain_and_die("Input values out of bounds") 
+             
+    ! ---------------------------------------------------
+    !
+    ! Compute the total optical thickness and the proportion due to liquid in each cell
+    !
+    where(liquid_opticalThickness(:, :) + ice_opticalThickness(:, :) > 0.) 
+      tauLiquidFraction(:, :) = liquid_opticalThickness(:, :)/(liquid_opticalThickness(:, :) + ice_opticalThickness(:, :))
+    elsewhere
+      tauLiquidFraction(:, :) = 0. 
+    end  where 
+    tauTotal(:, :) = liquid_opticalThickness(:, :) + ice_opticalThickness(:, :) 
+    
+    !
+    ! Optical depth retrieval 
+    !   This is simply a sum over the optical thickness in each layer 
+    !   It should agree with the ISCCP values after min values have been excluded 
+    !
+    retrievedTau(:) = sum(tauTotal(:, :), dim = 2)
+
+    !
+    ! Cloud detection - does optical thickness exceed detection threshold? 
+    !
+    cloudMask = retrievedTau(:) >= min_OpticalThickness
+    
+    !
+    ! Initialize initial estimates for size retrievals
+    !
+    if(any(cloudMask) .and. .not. useSimpleReScheme) then 
+      g_w(:)  = get_g_nir(  phaseIsLiquid, trial_re_w(:))
+      w0_w(:) = get_ssa_nir(phaseIsLiquid, trial_re_w(:))
+      g_i(:)  = get_g_nir(  phaseIsIce,    trial_re_i(:))
+      w0_i(:) = get_ssa_nir(phaseIsIce,    trial_re_i(:))
+    end if 
+    
+    do i = 1, nSubCols
+      if(cloudMask(i)) then 
+        !
+        ! Cloud top pressure determination 
+        !   MODIS uses CO2 slicing for clouds with tops above about 700 mb and thermal methods for clouds
+        !   lower than that. 
+        !  For CO2 slicing we report the optical-depth weighted pressure, integrating to a specified 
+        !    optical depth
+        ! This assumes linear variation in p between levels. Linear in ln(p) is probably better, 
+        !   though we'd need to deal with the lowest pressure gracefully. 
+        !
+        retrievedCloudTopPressure(i) = cloud_top_pressure((/ 0., tauTotal(i, :) /), &
+                                                          pressureLevels,           &
+                                                          CO2Slicing_TauLimit)  
+        
+        
+        !
+        ! Phase determination - determine fraction of total tau that's liquid 
+        ! When ice and water contribute about equally to the extinction we can't tell 
+        !   what the phase is 
+        !
+        integratedLiquidFraction = weight_by_extinction(tauTotal(i, :),          &
+                                                        tauLiquidFraction(i, :), &
+                                                        phase_TauLimit)
+        if(integratedLiquidFraction >= phaseDiscrimination_Threshold) then 
+          retrievedPhase(i) = phaseIsLiquid
+        else if (integratedLiquidFraction <= 1.- phaseDiscrimination_Threshold) then 
+          retrievedPhase(i) = phaseIsIce
+        else 
+          retrievedPhase(i) = phaseIsUndetermined
+        end if 
+        
+        !
+        ! Size determination 
+        !
+        if(useSimpleReScheme) then 
+          !   This is the extinction-weighted size considering only the phase we've chosen 
+          !
+          if(retrievedPhase(i) == phaseIsIce) then 
+            retrievedSize(i) = weight_by_extinction(ice_opticalThickness(i, :),  &
+                                                    iceSize(i, :), &
+                                                    (1. - integratedLiquidFraction) * size_TauLimit)
+  
+          else if(retrievedPhase(i) == phaseIsLiquid) then 
+            retrievedSize(i) = weight_by_extinction(liquid_opticalThickness(i, :), &
+                                                    waterSize(i, :), &
+                                                    integratedLiquidFraction * size_TauLimit)
+  
+          else
+            retrievedSize(i) = 0. 
+          end if 
+        else
+          retrievedSize(i) = 1.0e-06*retrieve_re(retrievedPhase(i), retrievedTau(i), &
+                         obs_Refl_nir = compute_nir_reflectance(liquid_opticalThickness(i, :), waterSize(i, :)*1.0e6, & 
+                         ice_opticalThickness(i, :),      iceSize(i, :)*1.0e6))
+        end if 
+      else 
+        !
+        ! Values when we don't think there's a cloud. 
+        !
+        retrievedCloudTopPressure(i) = R_UNDEF 
+        retrievedPhase(i) = phaseIsNone
+        retrievedSize(i) = R_UNDEF 
+        retrievedTau(i) = R_UNDEF 
+      end if
+    end do
+    where((retrievedSize(:) < 0.).and.(retrievedSize(:) /= R_UNDEF)) retrievedSize(:) = 1.0e-06*re_fill
+
+    ! We use the ISCCP-derived CTP for low clouds, since the ISCCP simulator ICARUS 
+    !   mimics what MODIS does to first order. 
+    !   Of course, ISCCP cloud top pressures are in mb. 
+    !   
+    where(cloudMask(:) .and. retrievedCloudTopPressure(:) > CO2Slicing_PressureLimit) &
+      retrievedCloudTopPressure(:) = isccpCloudTopPressure * 100. 
+    
+  end subroutine modis_L2_simulator_twoTaus
+  !------------------------------------------------------------------------------------------------
+  !
+  ! MODIS simulator: provide a single optical thickness and the cloud ice and liquid contents; 
+  !   we'll partition this into ice and liquid optical thickness and call the full MODIS simulator 
+  ! 
+  subroutine modis_L2_simulator_oneTau(                                         &
+                                temp, pressureLayers, pressureLevels,           &
+                                opticalThickness, cloudWater, cloudIce,         &
+                                waterSize, iceSize,                             & 
+                                isccpTau, isccpCloudTopPressure,                &
+                                retrievedPhase, retrievedCloudTopPressure, retrievedTau, retrievedSize)
+    ! Grid-mean quantities at layer centers, 
+    !   dimension nLayers
+    real, dimension(:),    intent(in ) :: temp,           & ! Temperature, K
+                                          pressureLayers, & ! Pressure, Pa
+                                          pressureLevels    ! Pressure at layer edges, Pa (dimension nLayers + 1) 
+    ! Sub-column quantities
+    !   dimension nLayers, nSubcols
+    real, dimension(:, :), intent(in ) :: opticalThickness, & ! Layer optical thickness @ 0.67 microns
+                                          cloudWater,       & ! Cloud water content, arbitrary units
+                                          cloudIce            ! Cloud water content, same units as cloudWater
+    real, dimension(:, :), intent(in ) :: waterSize,        & ! Cloud drop effective radius, microns
+                                          iceSize             ! Cloud ice effective radius, microns
+
+    ! Cloud properties retrieved from ISCCP using top_height = 1
+    !    dimension nSubcols
+    
+    real, dimension(:),    intent(in ) :: isccpTau, &           ! Column-integrated optical thickness 
+                                          isccpCloudTopPressure ! ISCCP-retrieved cloud top pressure (Pa) 
+
+    ! Properties retrieved by MODIS
+    !   dimension nSubcols
+    integer, dimension(:), intent(out) :: retrievedPhase               ! liquid/ice/other - integer
+    real,    dimension(:), intent(out) :: retrievedCloudTopPressure, & ! units of pressureLayers
+                                          retrievedTau,              & ! unitless
+                                          retrievedSize                ! microns (or whatever units 
+                                                                       !   waterSize and iceSize are supplied in)
+    ! ---------------------------------------------------
+    ! Local variables
+    real, dimension(size(opticalThickness, 1), size(opticalThickness, 2)) :: & 
+           liquid_opticalThickness, ice_opticalThickness, tauLiquidFraction
+    
+    ! ---------------------------------------------------
+    
+    where(cloudIce(:, :) <= 0.) 
+      tauLiquidFraction(:, :) = 1. 
+    elsewhere
+      where (cloudWater(:, :) <= 0.) 
+        tauLiquidFraction(:, :) = 0. 
+      elsewhere 
+        ! 
+        ! Geometic optics limit - tau as LWP/re  (proportional to LWC/re) 
+        !
+        tauLiquidFraction(:, :) = (cloudWater(:, :)/waterSize(:, :)) / &
+                                  (cloudWater(:, :)/waterSize(:, :) + cloudIce(:, :)/(ice_density * iceSize(:, :)) ) 
+      end where
+    end where
+    liquid_opticalThickness(:, :) = tauLiquidFraction(:, :) * opticalThickness(:, :) 
+    ice_opticalThickness   (:, :) = opticalThickness(:, :) - liquid_opticalThickness(:, :)
+    
+    call modis_L2_simulator_twoTaus(temp, pressureLayers, pressureLevels,          &
+                                    liquid_opticalThickness, ice_opticalThickness, &
+                                    waterSize, iceSize,                            & 
+                                    isccpTau, isccpCloudTopPressure,               &
+                                    retrievedPhase, retrievedCloudTopPressure, retrievedTau, retrievedSize)
+                                
+  end subroutine modis_L2_simulator_oneTau
+
+  ! ########################################################################################
+  subroutine modis_column(nPoints,nSubCols,phase, cloud_top_pressure, optical_thickness, particle_size,      &
+       Cloud_Fraction_Total_Mean,         Cloud_Fraction_Water_Mean,         Cloud_Fraction_Ice_Mean,        &
+       Cloud_Fraction_High_Mean,          Cloud_Fraction_Mid_Mean,           Cloud_Fraction_Low_Mean,        &
+       Optical_Thickness_Total_Mean,      Optical_Thickness_Water_Mean,      Optical_Thickness_Ice_Mean,     &
+       Optical_Thickness_Total_MeanLog10, Optical_Thickness_Water_MeanLog10, Optical_Thickness_Ice_MeanLog10,&
+       Cloud_Particle_Size_Water_Mean,    Cloud_Particle_Size_Ice_Mean,      Cloud_Top_Pressure_Total_Mean,  &
+       Liquid_Water_Path_Mean,            Ice_Water_Path_Mean,                                               &    
+       Optical_Thickness_vs_Cloud_Top_Pressure,Optical_Thickness_vs_ReffIce,Optical_Thickness_vs_ReffLiq)
+    
+    ! INPUTS
+    integer,intent(in) :: &
+         nPoints,                           & ! Number of horizontal gridpoints
+         nSubCols                             ! Number of subcolumns
+    integer,intent(in), dimension(:,:) ::  &
+!ds    integer,intent(in), dimension(nPoints, nSubCols) ::  &
+         phase                             
+    real,intent(in),dimension(:,:) ::  &
+!ds    real,intent(in),dimension(nPoints, nSubCols) ::  &
+         cloud_top_pressure,                &
+         optical_thickness,                 &
+         particle_size
+ 
+    ! OUTPUTS 
+    real,intent(inout),dimension(:)  ::   & !
+!ds    real,intent(inout),dimension(nPoints)  ::   & !
+         Cloud_Fraction_Total_Mean,         & !
+         Cloud_Fraction_Water_Mean,         & !
+         Cloud_Fraction_Ice_Mean,           & !
+         Cloud_Fraction_High_Mean,          & !
+         Cloud_Fraction_Mid_Mean,           & !
+         Cloud_Fraction_Low_Mean,           & !
+         Optical_Thickness_Total_Mean,      & !
+         Optical_Thickness_Water_Mean,      & !
+         Optical_Thickness_Ice_Mean,        & !
+         Optical_Thickness_Total_MeanLog10, & !
+         Optical_Thickness_Water_MeanLog10, & !
+         Optical_Thickness_Ice_MeanLog10,   & !
+         Cloud_Particle_Size_Water_Mean,    & !
+         Cloud_Particle_Size_Ice_Mean,      & !
+         Cloud_Top_Pressure_Total_Mean,     & !
+         Liquid_Water_Path_Mean,            & !
+         Ice_Water_Path_Mean                  !
+    real,intent(inout),dimension(:,:,:) :: &
+!ds    real,intent(inout),dimension(nPoints,numTauHistogramBins,numPressureHistogramBins) :: &
+         Optical_Thickness_vs_Cloud_Top_Pressure
+    real,intent(inout),dimension(:,:,:) :: &    
+!ds    real,intent(inout),dimension(nPoints,numTauHistogramBins,numMODISReffIceBins) :: &    
+         Optical_Thickness_vs_ReffIce
+    real,intent(inout),dimension(:,:,:) :: &    
+!ds    real,intent(inout),dimension(nPoints,numTauHistogramBins,numMODISReffLiqBins) :: &    
+         Optical_Thickness_vs_ReffLiq         
+
+    ! LOCAL VARIABLES
+    real, parameter :: &
+         LWP_conversion = 2./3. * 1000. ! MKS units  
+    integer :: i, j
+    logical, dimension(nPoints,nSubCols) :: &
+         cloudMask,      &
+         waterCloudMask, &
+         iceCloudMask,   &
+         validRetrievalMask
+    real,dimension(nPoints,nSubCols) :: &
+         tauWRK,ctpWRK,reffIceWRK,reffLiqWRK
+    
+    ! ########################################################################################
+    ! Include only those pixels with successful retrievals in the statistics 
+    ! ########################################################################################
+    validRetrievalMask(1:nPoints,1:nSubCols) = particle_size(1:nPoints,1:nSubCols) > 0.
+    cloudMask(1:nPoints,1:nSubCols) = phase(1:nPoints,1:nSubCols) /= phaseIsNone .and.       &
+         validRetrievalMask(1:nPoints,1:nSubCols)
+    waterCloudMask(1:nPoints,1:nSubCols) = phase(1:nPoints,1:nSubCols) == phaseIsLiquid .and. &
+         validRetrievalMask(1:nPoints,1:nSubCols)
+    iceCloudMask(1:nPoints,1:nSubCols)   = phase(1:nPoints,1:nSubCols) == phaseIsIce .and.    &
+         validRetrievalMask(1:nPoints,1:nSubCols)
+
+    ! ########################################################################################
+    ! Use these as pixel counts at first 
+    ! ########################################################################################
+    Cloud_Fraction_Total_Mean(1:nPoints) = real(count(cloudMask,      dim = 2))
+    Cloud_Fraction_Water_Mean(1:nPoints) = real(count(waterCloudMask, dim = 2))
+    Cloud_Fraction_Ice_Mean(1:nPoints)   = real(count(iceCloudMask,   dim = 2))
+    Cloud_Fraction_High_Mean(1:nPoints)  = real(count(cloudMask .and. cloud_top_pressure <=          &
+                                           highCloudPressureLimit, dim = 2)) 
+    Cloud_Fraction_Low_Mean(1:nPoints)   = real(count(cloudMask .and. cloud_top_pressure >           &
+                                           lowCloudPressureLimit,  dim = 2)) 
+    Cloud_Fraction_Mid_Mean(1:nPoints)   = Cloud_Fraction_Total_Mean(1:nPoints) - Cloud_Fraction_High_Mean(1:nPoints)&
+                                           - Cloud_Fraction_Low_Mean(1:nPoints)
+
+    ! ########################################################################################
+    ! Compute mean optical thickness.
+    ! ########################################################################################
+    Optical_Thickness_Total_Mean(1:nPoints) = sum(optical_thickness, mask = cloudMask,      dim = 2) / &
+                                              Cloud_Fraction_Total_Mean(1:nPoints) 
+    Optical_Thickness_Water_Mean(1:nPoints) = sum(optical_thickness, mask = waterCloudMask, dim = 2) / &
+                                              Cloud_Fraction_Water_Mean(1:nPoints)
+    Optical_Thickness_Ice_Mean(1:nPoints)   = sum(optical_thickness, mask = iceCloudMask,   dim = 2) / &
+                                              Cloud_Fraction_Ice_Mean(1:nPoints)
+       
+    ! ########################################################################################
+    ! We take the absolute value of optical thickness here to satisfy compilers that complains 
+    ! when we evaluate the logarithm of a negative number, even though it's not included in 
+    ! the sum. 
+    ! ########################################################################################
+    Optical_Thickness_Total_MeanLog10(1:nPoints) = sum(log10(abs(optical_thickness)), mask = cloudMask, &
+         dim = 2) / Cloud_Fraction_Total_Mean(1:nPoints)
+    Optical_Thickness_Water_MeanLog10(1:nPoints) = sum(log10(abs(optical_thickness)), mask = waterCloudMask,&
+         dim = 2) / Cloud_Fraction_Water_Mean(1:nPoints)
+    Optical_Thickness_Ice_MeanLog10(1:nPoints) = sum(log10(abs(optical_thickness)), mask = iceCloudMask,&
+         dim = 2) / Cloud_Fraction_Ice_Mean(1:nPoints)
+    Cloud_Particle_Size_Water_Mean(1:nPoints) = sum(particle_size, mask = waterCloudMask, dim = 2) / &
+         Cloud_Fraction_Water_Mean(1:nPoints)
+    Cloud_Particle_Size_Ice_Mean(1:nPoints) = sum(particle_size, mask = iceCloudMask,   dim = 2) / &
+         Cloud_Fraction_Ice_Mean(1:nPoints)
+    Cloud_Top_Pressure_Total_Mean(1:nPoints) = sum(cloud_top_pressure, mask = cloudMask, dim = 2) / &
+         max(1, count(cloudMask, dim = 2))
+    Liquid_Water_Path_Mean(1:nPoints) = LWP_conversion*sum(particle_size*optical_thickness, &
+         mask=waterCloudMask,dim=2)/Cloud_Fraction_Water_Mean(1:nPoints)
+    Ice_Water_Path_Mean(1:nPoints) = LWP_conversion * ice_density*sum(particle_size*optical_thickness,&
+         mask=iceCloudMask,dim = 2) /Cloud_Fraction_Ice_Mean(1:nPoints)
+
+    ! ########################################################################################
+    ! Normalize pixel counts to fraction.
+    ! ########################################################################################
+    Cloud_Fraction_High_Mean(1:nPoints)  = Cloud_Fraction_High_Mean(1:nPoints)  /nSubcols
+    Cloud_Fraction_Mid_Mean(1:nPoints)   = Cloud_Fraction_Mid_Mean(1:nPoints)   /nSubcols
+    Cloud_Fraction_Low_Mean(1:nPoints)   = Cloud_Fraction_Low_Mean(1:nPoints)   /nSubcols
+    Cloud_Fraction_Total_Mean(1:nPoints) = Cloud_Fraction_Total_Mean(1:nPoints) /nSubcols
+    Cloud_Fraction_Ice_Mean(1:nPoints)   = Cloud_Fraction_Ice_Mean(1:nPoints)   /nSubcols
+    Cloud_Fraction_Water_Mean(1:nPoints) = Cloud_Fraction_Water_Mean(1:nPoints) /nSubcols
+    
+    ! ########################################################################################
+    ! Set clear-scenes to undefined
+    ! ########################################################################################
+    where (Cloud_Fraction_Total_Mean == 0)
+       Optical_Thickness_Total_Mean      = R_UNDEF
+       Optical_Thickness_Total_MeanLog10 = R_UNDEF
+       Cloud_Top_Pressure_Total_Mean     = R_UNDEF
+    endwhere
+    where (Cloud_Fraction_Water_Mean == 0)
+       Optical_Thickness_Water_Mean      = R_UNDEF
+       Optical_Thickness_Water_MeanLog10 = R_UNDEF
+       Cloud_Particle_Size_Water_Mean    = R_UNDEF
+       Liquid_Water_Path_Mean            = R_UNDEF
+    endwhere
+    where (Cloud_Fraction_Ice_Mean == 0)
+       Optical_Thickness_Ice_Mean        = R_UNDEF
+       Optical_Thickness_Ice_MeanLog10   = R_UNDEF
+       Cloud_Particle_Size_Ice_Mean      = R_UNDEF
+       Ice_Water_Path_Mean               = R_UNDEF
+    endwhere
+    where (Cloud_Fraction_High_Mean == 0)  Cloud_Fraction_High_Mean = R_UNDEF
+    where (Cloud_Fraction_Mid_Mean == 0)   Cloud_Fraction_Mid_Mean = R_UNDEF
+    where (Cloud_Fraction_Low_Mean == 0)   Cloud_Fraction_Low_Mean = R_UNDEF
+
+    ! ########################################################################################
+    ! Joint histogram  
+    ! ########################################################################################
+
+    ! Loop over all points
+    tauWRK(1:nPoints,1:nSubCols)     = optical_thickness(1:nPoints,1:nSubCols)
+    ctpWRK(1:nPoints,1:nSubCols)     = cloud_top_pressure(1:nPoints,1:nSubCols)
+    reffIceWRK(1:nPoints,1:nSubCols) = merge(particle_size,R_UNDEF,iceCloudMask)
+    reffLiqWRK(1:nPoints,1:nSubCols) = merge(particle_size,R_UNDEF,waterCloudMask)
+    do j=1,nPoints
+
+       ! Fill clear and optically thin subcolumns with fill
+       where(.not. cloudMask(j,1:nSubCols)) 
+          tauWRK(j,1:nSubCols) = -999.
+          ctpWRK(j,1:nSubCols) = -999.
+       endwhere
+       ! Joint histogram of tau/CTP
+       call hist2D(tauWRK(j,1:nSubCols),ctpWRK(j,1:nSubCols),nSubCols,&
+                   tauHistogramBoundaries,numTauHistogramBins,&
+                   pressureHistogramBoundaries,numPressureHistogramBins,&
+                   Optical_Thickness_vs_Cloud_Top_Pressure(j,1:numTauHistogramBins,1:numPressureHistogramBins))
+       ! Joint histogram of tau/ReffICE
+       call hist2D(tauWRK(j,1:nSubCols),reffIceWrk(j,1:nSubCols),nSubCols,               &
+                   tauHistogramBoundaries,numTauHistogramBins,reffICE_binBounds,         &
+                   numMODISReffIceBins, Optical_Thickness_vs_ReffIce(j,1:numTauHistogramBins,1:numMODISReffIceBins))
+       ! Joint histogram of tau/ReffLIQ
+       call hist2D(tauWRK(j,1:nSubCols),reffLiqWrk(j,1:nSubCols),nSubCols,               &
+                   tauHistogramBoundaries,numTauHistogramBins,reffLIQ_binBounds,         &
+                   numMODISReffLiqBins, Optical_Thickness_vs_ReffLiq(j,1:numTauHistogramBins,1:numMODISReffLiqBins))                   
+
+    enddo   
+    Optical_Thickness_vs_Cloud_Top_Pressure(1:nPoints,1:numTauHistogramBins,1:numPressureHistogramBins) = &
+         Optical_Thickness_vs_Cloud_Top_Pressure(1:nPoints,1:numTauHistogramBins,1:numPressureHistogramBins)/nSubCols
+    Optical_Thickness_vs_ReffIce(1:nPoints,1:numTauHistogramBins,1:numMODISReffIceBins) = &
+         Optical_Thickness_vs_ReffIce(1:nPoints,1:numTauHistogramBins,1:numMODISReffIceBins)/nSubCols
+    Optical_Thickness_vs_ReffLiq(1:nPoints,1:numTauHistogramBins,1:numMODISReffLiqBins) = &
+         Optical_Thickness_vs_ReffLiq(1:nPoints,1:numTauHistogramBins,1:numMODISReffLiqBins)/nSubCols 
+
+  end subroutine modis_column
+  ! ######################################################################################
+  ! SUBROUTINE hist2D
+  ! ######################################################################################
+  subroutine hist2D(var1,var2,npts,bin1,nbin1,bin2,nbin2,jointHist)
+    implicit none
+    
+    ! INPUTS
+    integer, intent(in) :: &
+         npts,  & ! Number of data points to be sorted
+         nbin1, & ! Number of bins in histogram direction 1 
+         nbin2    ! Number of bins in histogram direction 2
+    real,intent(in),dimension(npts) :: &
+         var1,  & ! Variable 1 to be sorted into bins
+         var2     ! variable 2 to be sorted into bins
+    real,intent(in),dimension(nbin1+1) :: &
+         bin1     ! Histogram bin 1 boundaries
+    real,intent(in),dimension(nbin2+1) :: &
+         bin2     ! Histogram bin 2 boundaries
+    ! OUTPUTS
+    real,intent(out),dimension(nbin1,nbin2) :: &
+         jointHist
+    
+    ! LOCAL VARIABLES
+    integer :: ij,ik
+    
+    do ij=2,nbin1+1
+       do ik=2,nbin2+1
+          jointHist(ij-1,ik-1)=count(var1 .ge. bin1(ij-1) .and. var1 .lt. bin1(ij) .and. &
+               var2 .ge. bin2(ik-1) .and. var2 .lt. bin2(ik))        
+       enddo
+    enddo
+  end subroutine hist2D
+  
+  !------------------------------------------------------------------------------------------------
+  subroutine modis_L3_simulator(phase, cloud_top_pressure, optical_thickness, particle_size,            &
+       Cloud_Fraction_Total_Mean,       Cloud_Fraction_Water_Mean,       Cloud_Fraction_Ice_Mean,       &
+       Cloud_Fraction_High_Mean,        Cloud_Fraction_Mid_Mean,         Cloud_Fraction_Low_Mean,       &
+       Optical_Thickness_Total_Mean,    Optical_Thickness_Water_Mean,    Optical_Thickness_Ice_Mean,    &
+       Optical_Thickness_Total_MeanLog10, Optical_Thickness_Water_MeanLog10, Optical_Thickness_Ice_MeanLog10, &
+                                        Cloud_Particle_Size_Water_Mean,  Cloud_Particle_Size_Ice_Mean,  &
+       Cloud_Top_Pressure_Total_Mean,                                                                   &
+                                        Liquid_Water_Path_Mean,          Ice_Water_Path_Mean,           &    
+       Optical_Thickness_vs_Cloud_Top_Pressure)
+    !
+    ! Inputs; dimension nPoints, nSubcols
+    !
+    integer, dimension(:, :),   intent(in)  :: phase
+    real,    dimension(:, :),   intent(in)  :: cloud_top_pressure, optical_thickness, particle_size
+    !
+    ! Outputs; dimension nPoints
+    !
+    real,    dimension(:),      intent(out) :: &
+       Cloud_Fraction_Total_Mean,       Cloud_Fraction_Water_Mean,       Cloud_Fraction_Ice_Mean,       &
+       Cloud_Fraction_High_Mean,        Cloud_Fraction_Mid_Mean,         Cloud_Fraction_Low_Mean,       &
+       Optical_Thickness_Total_Mean,    Optical_Thickness_Water_Mean,    Optical_Thickness_Ice_Mean,    &
+       Optical_Thickness_Total_MeanLog10, Optical_Thickness_Water_MeanLog10, Optical_Thickness_Ice_MeanLog10, &
+                                        Cloud_Particle_Size_Water_Mean,  Cloud_Particle_Size_Ice_Mean,  &
+       Cloud_Top_Pressure_Total_Mean,                                                                   &
+                                        Liquid_Water_Path_Mean,          Ice_Water_Path_Mean
+    ! tau/ctp histogram; dimensions nPoints, numTauHistogramBins , numPressureHistogramBins 
+    real,    dimension(:, :, :), intent(out) :: Optical_Thickness_vs_Cloud_Top_Pressure
+    ! ---------------------------
+    ! Local variables
+    !
+    real, parameter :: LWP_conversion = 2./3. * 1000. ! MKS units  
+    integer :: i, j
+    integer :: nPoints, nSubcols 
+    logical, dimension(size(phase, 1), size(phase, 2)) :: &
+      cloudMask, waterCloudMask, iceCloudMask, validRetrievalMask
+    logical, dimension(size(phase, 1), size(phase, 2), numTauHistogramBins     ) :: tauMask
+    logical, dimension(size(phase, 1), size(phase, 2), numPressureHistogramBins) :: pressureMask
+    ! ---------------------------
+    
+    nPoints  = size(phase, 1) 
+    nSubcols = size(phase, 2) 
+    !
+    ! Array conformance checks
+    !
+    if(any( (/ size(cloud_top_pressure, 1), size(optical_thickness, 1), size(particle_size, 1),                                &
+               size(Cloud_Fraction_Total_Mean),       size(Cloud_Fraction_Water_Mean),       size(Cloud_Fraction_Ice_Mean),    &
+               size(Cloud_Fraction_High_Mean),        size(Cloud_Fraction_Mid_Mean),         size(Cloud_Fraction_Low_Mean),    &
+               size(Optical_Thickness_Total_Mean),    size(Optical_Thickness_Water_Mean),    size(Optical_Thickness_Ice_Mean), &
+               size(Optical_Thickness_Total_MeanLog10), size(Optical_Thickness_Water_MeanLog10), &
+               size(Optical_Thickness_Ice_MeanLog10),   size(Cloud_Particle_Size_Water_Mean),    &
+               size(Cloud_Particle_Size_Ice_Mean),      size(Cloud_Top_Pressure_Total_Mean),     &
+               size(Liquid_Water_Path_Mean),          size(Ice_Water_Path_Mean) /) /= nPoints))  &
+      call complain_and_die("Some L3 arrays have wrong number of grid points") 
+    if(any( (/ size(cloud_top_pressure, 2), size(optical_thickness, 2), size(particle_size, 2) /)  /= nSubcols)) &
+      call complain_and_die("Some L3 arrays have wrong number of subcolumns") 
+    
+    
+    !
+    ! Include only those pixels with successful retrievals in the statistics 
+    !
+    validRetrievalMask(:, :) = particle_size(:, :) > 0.
+    cloudMask      = phase(:, :) /= phaseIsNone   .and. validRetrievalMask(:, :)
+    waterCloudMask = phase(:, :) == phaseIsLiquid .and. validRetrievalMask(:, :)
+    iceCloudMask   = phase(:, :) == phaseIsIce    .and. validRetrievalMask(:, :)
+    !
+    ! Use these as pixel counts at first 
+    !
+    Cloud_Fraction_Total_Mean(:) = real(count(cloudMask,      dim = 2))
+    Cloud_Fraction_Water_Mean(:) = real(count(waterCloudMask, dim = 2))
+    Cloud_Fraction_Ice_Mean(:)   = real(count(iceCloudMask,   dim = 2))
+    
+    Cloud_Fraction_High_Mean(:) = real(count(cloudMask .and. cloud_top_pressure <= highCloudPressureLimit, dim = 2)) 
+    Cloud_Fraction_Low_Mean(:)  = real(count(cloudMask .and. cloud_top_pressure >  lowCloudPressureLimit,  dim = 2)) 
+    Cloud_Fraction_Mid_Mean(:)  = Cloud_Fraction_Total_Mean(:) - Cloud_Fraction_High_Mean(:) - Cloud_Fraction_Low_Mean(:)
+    
+    !
+    ! Don't want to divide by 0, even though the sums will be 0 where the pixel counts are 0. 
+    !
+    where (Cloud_Fraction_Total_Mean == 0) Cloud_Fraction_Total_Mean = -1. 
+    where (Cloud_Fraction_Water_Mean == 0) Cloud_Fraction_Water_Mean = -1.
+    where (Cloud_Fraction_Ice_Mean   == 0) Cloud_Fraction_Ice_Mean   = -1.
+    
+    Optical_Thickness_Total_Mean = sum(optical_thickness, mask = cloudMask,      dim = 2) / Cloud_Fraction_Total_Mean(:) 
+    Optical_Thickness_Water_Mean = sum(optical_thickness, mask = waterCloudMask, dim = 2) / Cloud_Fraction_Water_Mean(:)
+    Optical_Thickness_Ice_Mean   = sum(optical_thickness, mask = iceCloudMask,   dim = 2) / Cloud_Fraction_Ice_Mean(:)
+   
+    ! We take the absolute value of optical thickness here to satisfy compilers that complains when we 
+    !   evaluate the logarithm of a negative number, even though it's not included in the sum. 
+    Optical_Thickness_Total_MeanLog10 = sum(log10(abs(optical_thickness)), mask = cloudMask,      dim = 2) / &
+                                        Cloud_Fraction_Total_Mean(:)
+    Optical_Thickness_Water_MeanLog10 = sum(log10(abs(optical_thickness)), mask = waterCloudMask, dim = 2) / &
+                                        Cloud_Fraction_Water_Mean(:)
+    Optical_Thickness_Ice_MeanLog10   = sum(log10(abs(optical_thickness)), mask = iceCloudMask,   dim = 2) / &
+                                        Cloud_Fraction_Ice_Mean(:)
+   
+    Cloud_Particle_Size_Water_Mean = sum(particle_size, mask = waterCloudMask, dim = 2) / Cloud_Fraction_Water_Mean(:)
+    Cloud_Particle_Size_Ice_Mean   = sum(particle_size, mask = iceCloudMask,   dim = 2) / Cloud_Fraction_Ice_Mean(:)
+    
+    Cloud_Top_Pressure_Total_Mean = sum(cloud_top_pressure, mask = cloudMask, dim = 2) / max(1, count(cloudMask, dim = 2))
+    
+    Liquid_Water_Path_Mean = LWP_conversion &
+                             * sum(particle_size * optical_thickness, mask = waterCloudMask, dim = 2) &
+                             / Cloud_Fraction_Water_Mean(:)
+    Ice_Water_Path_Mean    = LWP_conversion * ice_density &
+                             * sum(particle_size * optical_thickness, mask = iceCloudMask,   dim = 2) &
+                             / Cloud_Fraction_Ice_Mean(:)
+
+    !
+    ! Normalize pixel counts to fraction
+    !   The first three cloud fractions have been set to -1 in cloud-free areas, so set those places to 0.
+    ! 
+    Cloud_Fraction_Total_Mean(:) = max(0., Cloud_Fraction_Total_Mean(:)/nSubcols)
+    Cloud_Fraction_Water_Mean(:) = max(0., Cloud_Fraction_Water_Mean(:)/nSubcols)
+    Cloud_Fraction_Ice_Mean(:)   = max(0., Cloud_Fraction_Ice_Mean(:)  /nSubcols)
+    
+    Cloud_Fraction_High_Mean(:)  = Cloud_Fraction_High_Mean(:) /nSubcols
+    Cloud_Fraction_Mid_Mean(:)   = Cloud_Fraction_Mid_Mean(:)  /nSubcols
+    Cloud_Fraction_Low_Mean(:)   = Cloud_Fraction_Low_Mean(:)  /nSubcols
+    
+    ! ----
+    ! Joint histogram 
+    ! 
+    do i = 1, numTauHistogramBins 
+      where(cloudMask(:, :)) 
+        tauMask(:, :, i) = optical_thickness(:, :) >= tauHistogramBoundaries(i) .and. &
+                           optical_thickness(:, :) <  tauHistogramBoundaries(i+1)
+      elsewhere
+        tauMask(:, :, i) = .false.
+      end where
+    end do 
+
+    do i = 1, numPressureHistogramBins 
+      where(cloudMask(:, :)) 
+        pressureMask(:, :, i) = cloud_top_pressure(:, :) >= pressureHistogramBoundaries(i) .and. &
+                                cloud_top_pressure(:, :) <  pressureHistogramBoundaries(i+1)
+      elsewhere
+        pressureMask(:, :, i) = .false.
+      end where
+    end do 
+    
+    do i = 1, numPressureHistogramBins
+      do j = 1, numTauHistogramBins
+        Optical_Thickness_vs_Cloud_Top_Pressure(:, j, i) = & 
+          real(count(tauMask(:, :, j) .and. pressureMask(:, :, i), dim = 2)) / real(nSubcols)
+      end do 
+    end do 
+    
+  end subroutine modis_L3_simulator
+  !------------------------------------------------------------------------------------------------
+  function cloud_top_pressure(tauIncrement, pressure, tauLimit) 
+    real, dimension(:), intent(in) :: tauIncrement, pressure
+    real,               intent(in) :: tauLimit
+    real                           :: cloud_top_pressure
+    !
+    ! Find the extinction-weighted pressure. Assume that pressure varies linearly between 
+    !   layers and use the trapezoidal rule.
+    !
+    
+    real :: deltaX, totalTau, totalProduct
+    integer :: i 
+    
+    totalTau = 0.; totalProduct = 0. 
+    do i = 2, size(tauIncrement)
+      if(totalTau + tauIncrement(i) > tauLimit) then 
+        deltaX = tauLimit - totalTau
+        totalTau = totalTau + deltaX
+        !
+        ! Result for trapezoidal rule when you take less than a full step
+        !   tauIncrement is a layer-integrated value
+        !
+        totalProduct = totalProduct           &
+                     + pressure(i-1) * deltaX &
+                     + (pressure(i) - pressure(i-1)) * deltaX**2/(2. * tauIncrement(i)) 
+      else
+        totalTau =     totalTau     + tauIncrement(i) 
+        totalProduct = totalProduct + tauIncrement(i) * (pressure(i) + pressure(i-1)) / 2.
+      end if 
+      if(totalTau >= tauLimit) exit
+    end do 
+    cloud_top_pressure = totalProduct/totalTau
+  end function cloud_top_pressure
+  !------------------------------------------------------------------------------------------------
+  function weight_by_extinction(tauIncrement, f, tauLimit) 
+    real, dimension(:), intent(in) :: tauIncrement, f
+    real,               intent(in) :: tauLimit
+    real                           :: weight_by_extinction
+    !
+    ! Find the extinction-weighted value of f(tau), assuming constant f within each layer
+    !
+    
+    real    :: deltaX, totalTau, totalProduct
+    integer :: i 
+    
+    totalTau = 0.; totalProduct = 0. 
+    do i = 1, size(tauIncrement)
+      if(totalTau + tauIncrement(i) > tauLimit) then 
+        deltaX       = tauLimit - totalTau
+        totalTau     = totalTau     + deltaX
+        totalProduct = totalProduct + deltaX * f(i) 
+      else
+        totalTau     = totalTau     + tauIncrement(i) 
+        totalProduct = totalProduct + tauIncrement(i) * f(i) 
+      end if 
+      if(totalTau >= tauLimit) exit
+    end do 
+    weight_by_extinction = totalProduct/totalTau
+  end function weight_by_extinction
+  !------------------------------------------------------------------------------------------------
+  pure function compute_nir_reflectance(water_tau, water_size, ice_tau, ice_size) 
+    real, dimension(:), intent(in) :: water_tau, water_size, ice_tau, ice_size
+    real                           :: compute_nir_reflectance
+    
+    real, dimension(size(water_tau)) :: water_g, water_w0, ice_g, ice_w0, &
+                                        tau, g, w0
+    !----------------------------------------
+    water_g(:)  = get_g_nir(  phaseIsLiquid, water_size) 
+    water_w0(:) = get_ssa_nir(phaseIsLiquid, water_size) 
+    ice_g(:)    = get_g_nir(  phaseIsIce,    ice_size) 
+    ice_w0(:)   = get_ssa_nir(phaseIsIce,    ice_size) 
+    !
+    ! Combine ice and water optical properties
+    !
+    g(:) = 0; w0(:) = 0. 
+    tau(:) = ice_tau(:) + water_tau(:) 
+    where (tau(:) > 0) 
+      w0(:) = (water_tau(:) * water_w0(:)  + ice_tau(:) * ice_w0(:)) / &
+              tau(:)
+      g(:) = (water_tau(:) * water_g(:) * water_w0(:)  + ice_tau(:) * ice_g(:) * ice_w0(:)) / &
+             (w0(:) * tau(:))
+    end where
+    
+    compute_nir_reflectance = compute_toa_reflectace(tau, g, w0)
+  end function compute_nir_reflectance
+  !------------------------------------------------------------------------------------------------
+  ! Retreivals
+  !------------------------------------------------------------------------------------------------
+  elemental function retrieve_re (phase, tau, obs_Refl_nir)
+      integer, intent(in) :: phase
+      real,    intent(in) :: tau, obs_Refl_nir
+      real                :: retrieve_re
+      !
+      ! Finds the re that produces the minimum mis-match between predicted and observed reflectance in 
+      !   MODIS band 7 (near IR)
+      ! Uses 
+      !  fits for asymmetry parameter g(re) and single scattering albedo w0(re) based on MODIS tables 
+      !  two-stream for layer reflectance and transmittance as a function of optical thickness tau, g, and w0
+      !  adding-doubling for total reflectance 
+      !  
+      !
+      !
+      ! Local variables
+      !
+      real, parameter :: min_distance_to_boundary = 0.01
+      real    :: re_min, re_max, delta_re
+      integer :: i 
+      
+      real, dimension(num_trial_res) :: trial_re, g, w0, predicted_Refl_nir
+      ! --------------------------
+    
+    if(any(phase == (/ phaseIsLiquid, phaseIsUndetermined, phaseIsIce /))) then 
+      if (phase == phaseIsLiquid .OR. phase == phaseIsUndetermined) then
+        re_min = re_water_min
+        re_max = re_water_max
+        trial_re(:) = trial_re_w
+        g(:)   = g_w(:) 
+        w0(:)  = w0_w(:)
+      else
+        re_min = re_ice_min
+        re_max = re_ice_max
+        trial_re(:) = trial_re_i
+        g(:)   = g_i(:) 
+        w0(:)  = w0_i(:)
+      end if
+      !
+      ! 1st attempt at index: w/coarse re resolution
+      !
+      predicted_Refl_nir(:) = two_stream_reflectance(tau, g(:), w0(:))
+      retrieve_re = interpolate_to_min(trial_re(:), predicted_Refl_nir(:), obs_Refl_nir) 
+      !
+      ! If first retrieval works, can try 2nd iteration using greater re resolution 
+      !
+! DJS2015: Remove unused piece of code      
+!      if(use_two_re_iterations .and. retrieve_re > 0.) then
+!        re_min = retrieve_re - delta_re
+!        re_max = retrieve_re + delta_re
+!        delta_re = (re_max - re_min)/real(num_trial_res-1)
+!  
+!        trial_re(:) = re_min + delta_re * (/ (i - 1, i = 1, num_trial_res) /) 
+!        g(:)  = get_g_nir(  phase, trial_re(:))
+!        w0(:) = get_ssa_nir(phase, trial_re(:))
+!        predicted_Refl_nir(:) = two_stream_reflectance(tau, g(:), w0(:))
+!        retrieve_re = interpolate_to_min(trial_re(:), predicted_Refl_nir(:), obs_Refl_nir) 
+!      end if
+! DJS2015 END
+    else 
+      retrieve_re = re_fill
+    end if 
+    
+  end function retrieve_re
+  ! --------------------------------------------
+  pure function interpolate_to_min(x, y, yobs)
+    real, dimension(:), intent(in) :: x, y 
+    real,               intent(in) :: yobs
+    real                           :: interpolate_to_min
+    ! 
+    ! Given a set of values of y as y(x), find the value of x that minimizes abs(y - yobs)
+    !   y must be monotonic in x
+    !
+    real, dimension(size(x)) :: diff
+    integer                  :: nPoints, minDiffLoc, lowerBound, upperBound
+    ! ---------------------------------
+    nPoints = size(y)
+    diff(:) = y(:) - yobs
+    minDiffLoc = minloc(abs(diff), dim = 1) 
+    
+    if(minDiffLoc == 1) then 
+      lowerBound = minDiffLoc
+      upperBound = minDiffLoc + 1
+    else if(minDiffLoc == nPoints) then
+      lowerBound = minDiffLoc - 1
+      upperBound = minDiffLoc
+    else
+      if(diff(minDiffLoc-1) * diff(minDiffLoc) < 0) then
+        lowerBound = minDiffLoc-1
+        upperBound = minDiffLoc
+      else 
+        lowerBound = minDiffLoc
+        upperBound = minDiffLoc + 1
+      end if 
+    end if 
+    
+    if(diff(lowerBound) * diff(upperBound) < 0) then     
+      !
+      ! Interpolate the root position linearly if we bracket the root
+      !
+      interpolate_to_min = x(upperBound) - & 
+                           diff(upperBound) * (x(upperBound) - x(lowerBound)) / (diff(upperBound) - diff(lowerBound))
+    else 
+      interpolate_to_min = re_fill
+    end if 
+    
+
+  end function interpolate_to_min
+  ! --------------------------------------------
+  ! Optical properties
+  ! --------------------------------------------
+  elemental function get_g_nir (phase, re)
+    !
+    ! Polynomial fit for asummetry parameter g in MODIS band 7 (near IR) as a function 
+    !   of size for ice and water
+    ! Fits from Steve Platnick
+    !
+
+    integer, intent(in) :: phase
+    real,    intent(in) :: re
+    real :: get_g_nir 
+
+    real, dimension(3), parameter :: ice_coefficients         = (/ 0.7490, 6.5153e-3, -5.4136e-5 /), &
+                                     small_water_coefficients = (/ 1.0364, -8.8800e-2, 7.0000e-3 /)
+    real, dimension(4), parameter :: big_water_coefficients   = (/ 0.6035, 2.8993e-2, -1.1051e-3, 1.5134e-5 /)
+
+    ! approx. fits from MODIS Collection 6 LUT scattering calculations for 3.7 µm channel size retrievals
+    if(phase == phaseIsLiquid) then 
+       if(re < 7.) then
+          get_g_nir = fit_to_quadratic(re, small_water_coefficients)
+          if(re < re_water_min) get_g_nir = fit_to_quadratic(re_water_min, small_water_coefficients)
+       else
+          get_g_nir = fit_to_cubic(re, big_water_coefficients)
+          if(re > re_water_max) get_g_nir = fit_to_cubic(re_water_max, big_water_coefficients)
+       end if
+    else
+       get_g_nir = fit_to_quadratic(re, ice_coefficients)
+      if(re < re_ice_min) get_g_nir = fit_to_quadratic(re_ice_min, ice_coefficients)
+      if(re > re_ice_max) get_g_nir = fit_to_quadratic(re_ice_max, ice_coefficients)
+    end if 
+    
+  end function get_g_nir
+
+  ! --------------------------------------------
+    elemental function get_ssa_nir (phase, re)
+        integer, intent(in) :: phase
+        real,    intent(in) :: re
+        real                :: get_ssa_nir
+        !
+        ! Polynomial fit for single scattering albedo in MODIS band 7 (near IR) as a function 
+        !   of size for ice and water
+        ! Fits from Steve Platnick
+        !
+        real, dimension(4), parameter :: ice_coefficients   = (/ 0.9625, -1.8069e-2, 3.3281e-4,-2.2865e-6/)
+        real, dimension(3), parameter :: water_coefficients = (/ 1.0044, -1.1397e-2, 1.3300e-4 /)
+        
+        ! approx. fits from MODIS Collection 6 LUT scattering calculations
+        if(phase == phaseIsLiquid) then
+          get_ssa_nir = fit_to_quadratic(re, water_coefficients)
+          if(re < re_water_min) get_ssa_nir = fit_to_quadratic(re_water_min, water_coefficients)
+          if(re > re_water_max) get_ssa_nir = fit_to_quadratic(re_water_max, water_coefficients)
+        else
+          get_ssa_nir = fit_to_cubic(re, ice_coefficients)
+          if(re < re_ice_min) get_ssa_nir = fit_to_cubic(re_ice_min, ice_coefficients)
+          if(re > re_ice_max) get_ssa_nir = fit_to_cubic(re_ice_max, ice_coefficients)
+        end if 
+
+    end function get_ssa_nir
+   ! --------------------------------------------
+  pure function fit_to_cubic(x, coefficients) 
+    real,               intent(in) :: x
+    real, dimension(:), intent(in) :: coefficients
+    real                           :: fit_to_cubic
+    
+    
+    fit_to_cubic = coefficients(1) + x * (coefficients(2) + x * (coefficients(3) + x * coefficients(4)))
+ end function fit_to_cubic
+   ! --------------------------------------------
+  pure function fit_to_quadratic(x, coefficients) 
+    real,               intent(in) :: x
+    real, dimension(:), intent(in) :: coefficients
+    real                           :: fit_to_quadratic
+    
+    
+    fit_to_quadratic = coefficients(1) + x * (coefficients(2) + x * (coefficients(3)))
+ end function fit_to_quadratic
+  ! --------------------------------------------
+  ! Radiative transfer
+  ! --------------------------------------------
+  pure function compute_toa_reflectace(tau, g, w0)
+    real, dimension(:), intent(in) :: tau, g, w0
+    real                           :: compute_toa_reflectace
+    
+    logical, dimension(size(tau))         :: cloudMask
+    integer, dimension(count(tau(:) > 0)) :: cloudIndicies
+    real,    dimension(count(tau(:) > 0)) :: Refl,     Trans
+    real                                  :: Refl_tot, Trans_tot
+    integer                               :: i
+    ! ---------------------------------------
+    !
+    ! This wrapper reports reflectance only and strips out non-cloudy elements from the calculation
+    !
+    cloudMask = tau(:) > 0. 
+    cloudIndicies = pack((/ (i, i = 1, size(tau)) /), mask = cloudMask) 
+    do i = 1, size(cloudIndicies)
+      call two_stream(tau(cloudIndicies(i)), g(cloudIndicies(i)), w0(cloudIndicies(i)), Refl(i), Trans(i))
+    end do 
+                    
+    call adding_doubling(Refl(:), Trans(:), Refl_tot, Trans_tot)  
+    
+    compute_toa_reflectace = Refl_tot
+    
+  end function compute_toa_reflectace
+  ! --------------------------------------------
+  pure subroutine two_stream(tauint, gint, w0int, ref, tra) 
+    real, intent(in)  :: tauint, gint, w0int
+    real, intent(out) :: ref, tra
+    !
+    ! Compute reflectance in a single layer using the two stream approximation 
+    !   The code itself is from Lazaros Oreopoulos via Steve Platnick 
+    !
+    ! ------------------------
+    ! Local variables 
+    !   for delta Eddington code
+    !   xmu, gamma3, and gamma4 only used for collimated beam approximation (i.e., beam=1)
+    integer, parameter :: beam = 2
+    real,    parameter :: xmu = 0.866, minConservativeW0 = 0.9999999
+    real :: tau, w0, g, f, gamma1, gamma2, gamma3, gamma4, &
+            rh, a1, a2, rk, r1, r2, r3, r4, r5, t1, t2, t3, t4, t5, beta, e1, e2, ef1, ef2, den, th
+    !
+    ! Compute reflectance and transmittance in a single layer using the two stream approximation 
+    !   The code itself is from Lazaros Oreopoulos via Steve Platnick 
+    !
+    f   = gint**2
+    tau = (1 - w0int * f) * tauint
+    w0  = (1 - f) * w0int / (1 - w0int * f)
+    g   = (gint - f) / (1 - f)
+
+    ! delta-Eddington (Joseph et al. 1976)
+    gamma1 =  (7 - w0* (4 + 3 * g)) / 4.0
+    gamma2 = -(1 - w0* (4 - 3 * g)) / 4.0
+    gamma3 =  (2 - 3*g*xmu) / 4.0
+    gamma4 =   1 - gamma3
+
+    if (w0int > minConservativeW0) then
+      ! Conservative scattering
+      if (beam == 1) then
+          rh = (gamma1*tau+(gamma3-gamma1*xmu)*(1-exp(-tau/xmu)))
+          ref = rh / (1 + gamma1 * tau)
+          tra = 1 - ref       
+      else if(beam == 2) then
+          ref = gamma1*tau/(1 + gamma1*tau)
+          tra = 1 - ref
+      endif
+    else
+      ! Non-conservative scattering
+      a1 = gamma1 * gamma4 + gamma2 * gamma3
+      a2 = gamma1 * gamma3 + gamma2 * gamma4
+
+      rk = sqrt(gamma1**2 - gamma2**2)
+      
+      r1 = (1 - rk * xmu) * (a2 + rk * gamma3)
+      r2 = (1 + rk * xmu) * (a2 - rk * gamma3)
+      r3 = 2 * rk *(gamma3 - a2 * xmu)
+      r4 = (1 - (rk * xmu)**2) * (rk + gamma1)
+      r5 = (1 - (rk * xmu)**2) * (rk - gamma1)
+      
+      t1 = (1 + rk * xmu) * (a1 + rk * gamma4)
+      t2 = (1 - rk * xmu) * (a1 - rk * gamma4)
+      t3 = 2 * rk * (gamma4 + a1 * xmu)
+      t4 = r4
+      t5 = r5
+
+      beta = -r5 / r4         
+      
+      e1 = min(rk * tau, 500.) 
+      e2 = min(tau / xmu, 500.) 
+      
+      if (beam == 1) then
+         den = r4 * exp(e1) + r5 * exp(-e1)
+         ref  = w0*(r1*exp(e1)-r2*exp(-e1)-r3*exp(-e2))/den
+         den = t4 * exp(e1) + t5 * exp(-e1)
+         th  = exp(-e2)
+         tra = th-th*w0*(t1*exp(e1)-t2*exp(-e1)-t3*exp(e2))/den
+      elseif (beam == 2) then
+         ef1 = exp(-e1)
+         ef2 = exp(-2*e1)
+         ref = (gamma2*(1-ef2))/((rk+gamma1)*(1-beta*ef2))
+         tra = (2*rk*ef1)/((rk+gamma1)*(1-beta*ef2))
+      endif
+    end if
+  end subroutine two_stream
+  ! --------------------------------------------------
+  elemental function two_stream_reflectance(tauint, gint, w0int) 
+    real, intent(in) :: tauint, gint, w0int
+    real             :: two_stream_reflectance
+    !
+    ! Compute reflectance in a single layer using the two stream approximation 
+    !   The code itself is from Lazaros Oreopoulos via Steve Platnick 
+    !
+    ! ------------------------
+    ! Local variables 
+    !   for delta Eddington code
+    !   xmu, gamma3, and gamma4 only used for collimated beam approximation (i.e., beam=1)
+    integer, parameter :: beam = 2
+    real,    parameter :: xmu = 0.866, minConservativeW0 = 0.9999999
+    real :: tau, w0, g, f, gamma1, gamma2, gamma3, gamma4, &
+            rh, a1, a2, rk, r1, r2, r3, r4, r5, t1, t2, t3, t4, t5, beta, e1, e2, ef1, ef2, den
+    ! ------------------------
+
+
+    f   = gint**2
+    tau = (1 - w0int * f) * tauint
+    w0  = (1 - f) * w0int / (1 - w0int * f)
+    g   = (gint - f) / (1 - f)
+
+    ! delta-Eddington (Joseph et al. 1976)
+    gamma1 =  (7 - w0* (4 + 3 * g)) / 4.0
+    gamma2 = -(1 - w0* (4 - 3 * g)) / 4.0
+    gamma3 =  (2 - 3*g*xmu) / 4.0
+    gamma4 =   1 - gamma3
+
+    if (w0int > minConservativeW0) then
+      ! Conservative scattering
+      if (beam == 1) then
+          rh = (gamma1*tau+(gamma3-gamma1*xmu)*(1-exp(-tau/xmu)))
+          two_stream_reflectance = rh / (1 + gamma1 * tau)
+      elseif (beam == 2) then
+          two_stream_reflectance = gamma1*tau/(1 + gamma1*tau)
+      endif
+        
+    else    !
+
+        ! Non-conservative scattering
+         a1 = gamma1 * gamma4 + gamma2 * gamma3
+         a2 = gamma1 * gamma3 + gamma2 * gamma4
+
+         rk = sqrt(gamma1**2 - gamma2**2)
+         
+         r1 = (1 - rk * xmu) * (a2 + rk * gamma3)
+         r2 = (1 + rk * xmu) * (a2 - rk * gamma3)
+         r3 = 2 * rk *(gamma3 - a2 * xmu)
+         r4 = (1 - (rk * xmu)**2) * (rk + gamma1)
+         r5 = (1 - (rk * xmu)**2) * (rk - gamma1)
+         
+         t1 = (1 + rk * xmu) * (a1 + rk * gamma4)
+         t2 = (1 - rk * xmu) * (a1 - rk * gamma4)
+         t3 = 2 * rk * (gamma4 + a1 * xmu)
+         t4 = r4
+         t5 = r5
+
+         beta = -r5 / r4         
+         
+         e1 = min(rk * tau, 500.) 
+         e2 = min(tau / xmu, 500.) 
+         
+         if (beam == 1) then
+           den = r4 * exp(e1) + r5 * exp(-e1)
+           two_stream_reflectance  = w0*(r1*exp(e1)-r2*exp(-e1)-r3*exp(-e2))/den
+         elseif (beam == 2) then
+           ef1 = exp(-e1)
+           ef2 = exp(-2*e1)
+           two_stream_reflectance = (gamma2*(1-ef2))/((rk+gamma1)*(1-beta*ef2))
+         endif
+           
+      end if
+  end function two_stream_reflectance 
+  ! --------------------------------------------
+    pure subroutine adding_doubling (Refl, Tran, Refl_tot, Tran_tot)      
+      real,    dimension(:), intent(in)  :: Refl,     Tran
+      real,                  intent(out) :: Refl_tot, Tran_tot
+      !
+      ! Use adding/doubling formulas to compute total reflectance and transmittance from layer values
+      !
+      
+      integer :: i
+      real, dimension(size(Refl)) :: Refl_cumulative, Tran_cumulative
+      
+      Refl_cumulative(1) = Refl(1); Tran_cumulative(1) = Tran(1)    
+      
+      do i=2, size(Refl)
+          ! place (add) previous combined layer(s) reflectance on top of layer i, w/black surface (or ignoring surface):
+          Refl_cumulative(i) = Refl_cumulative(i-1) + Refl(i)*(Tran_cumulative(i-1)**2)/(1 - Refl_cumulative(i-1) * Refl(i))
+          Tran_cumulative(i) = (Tran_cumulative(i-1)*Tran(i)) / (1 - Refl_cumulative(i-1) * Refl(i))
+      end do
+      
+      Refl_tot = Refl_cumulative(size(Refl))
+      Tran_tot = Tran_cumulative(size(Refl))
+
+    end subroutine adding_doubling
+  ! --------------------------------------------------
+  subroutine complain_and_die(message) 
+    character(len = *), intent(in) :: message
+    
+    write(6, *) "Failure in MODIS simulator" 
+    write(6, *)  trim(message) 
+    stop
+  end subroutine complain_and_die
+  !------------------------------------------------------------------------------------------------
+end module mod_modis_sim
Index: LMDZ6/trunk/libf/phylmd/cosp/modis_simulator.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/cosp/modis_simulator.F90	(revision 3232)
+++ 	(revision )
@@ -1,1274 +1,0 @@
-! (c) 2009-2010, Regents of the Unversity of Colorado
-!   Author: Robert Pincus, Cooperative Institute for Research in the Environmental Sciences
-! All rights reserved.
-! $Revision: 88 $, $Date: 2013-11-13 07:08:38 -0700 (Wed, 13 Nov 2013) $
-! $URL: http://cfmip-obs-sim.googlecode.com/svn/stable/v1.4.0/MODIS_simulator/modis_simulator.F90 $
-! 
-! 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.
-!
-
-!
-! History:
-!   May 2009 - Robert Pincus - Initial version
-!   June 2009 - Steve Platnick and Robert Pincus - Simple radiative transfer for size retrievals
-!   August 2009 - Robert Pincus - Consistency and bug fixes suggested by Rick Hemler (GFDL) 
-!   November 2009 - Robert Pincus - Bux fixes and speed-ups after experience with Rick Hemler using AM2 (GFDL) 
-!   January 2010 - Robert Pincus - Added high, middle, low cloud fractions 
-!
-
-!
-! Notes on using the MODIS simulator: 
-!  *) You may provide either layer-by-layer values of optical thickness at 0.67 and 2.1 microns, or 
-!     optical thickness at 0.67 microns and ice- and liquid-water contents (in consistent units of 
-!     your choosing)
-!  *) Required input also includes the optical thickness and cloud top pressure 
-!     derived from the ISCCP simulator run with parameter top_height = 1. 
-!  *) Cloud particle sizes are specified as radii, measured in meters, though within the module we 
-!     use units of microns. Where particle sizes are outside the bounds used in the MODIS retrieval
-!     libraries (parameters re_water_min, re_ice_min, etc.) the simulator returns missing values (re_fill)
-
-!
-! When error conditions are encountered this code calls the function complain_and_die, supplied at the 
-!   bottom of this module. Users probably want to replace this with something more graceful. 
-!
-module mod_modis_sim
-  USE MOD_COSP_TYPES, only: R_UNDEF
-  implicit none
-  ! ------------------------------
-  ! Algorithmic parameters
-  !
- 
-  real, parameter :: ice_density          = 0.93               ! liquid density is 1.  
-  !
-  ! Retrieval parameters
-  !
-  real, parameter :: min_OpticalThickness = 0.3,             & ! Minimum detectable optical thickness
-                     CO2Slicing_PressureLimit = 700. * 100., & ! Cloud with higher pressures use thermal methods, units Pa
-                     CO2Slicing_TauLimit = 1.,               & ! How deep into the cloud does CO2 slicing see? 
-                     phase_TauLimit      = 1.,               & ! How deep into the cloud does the phase detection see?
-                     size_TauLimit       = 2.,               & ! Depth of the re retreivals
-                     phaseDiscrimination_Threshold = 0.7       ! What fraction of total extincton needs to be 
-                                                               !  in a single category to make phase discrim. work? 
-  real,    parameter :: re_fill= -999.
-  integer, parameter :: phaseIsNone = 0, phaseIsLiquid = 1, phaseIsIce = 2, phaseIsUndetermined = 3
-  
-  logical, parameter :: useSimpleReScheme = .false. 
-  !
-  ! These are the limits of the libraries for the MODIS collection 5 algorithms 
-  !   They are also the limits used in the fits for g and w0
-  !
-  real,    parameter :: re_water_min= 4., re_water_max= 30., re_ice_min= 5., re_ice_max= 90.
-  integer, parameter :: num_trial_res = 15             ! increase to make the linear pseudo-retrieval of size more accurate
-! DJS2015: Remove unused parameter
-!  logical, parameter :: use_two_re_iterations = .false. ! do two retrieval iterations? 
-! DJS2015 END  
-  !
-  ! Precompute near-IR optical params vs size for retrieval scheme
-  !
-  integer, private :: i 
-  real, dimension(num_trial_res), parameter :: & 
-        trial_re_w = re_water_min + (re_water_max - re_water_min)/(num_trial_res-1) * (/ (i - 1, i = 1, num_trial_res) /), &
-        trial_re_i = re_ice_min   + (re_ice_max -   re_ice_min)  /(num_trial_res-1) * (/ (i - 1, i = 1, num_trial_res) /)
-  
-  ! Can't initialze these during compilation, but do in before looping columns in retrievals
-  real, dimension(num_trial_res) ::  g_w, g_i, w0_w, w0_i
-  ! ------------------------------
-  ! Bin boundaries for the joint optical thickness/cloud top pressure histogram
-  !
-  integer, parameter :: numTauHistogramBins = 6, numPressureHistogramBins = 7
-
-  real, private :: dummy_real 
-  real, dimension(numTauHistogramBins + 1),      parameter :: &
-    tauHistogramBoundaries = (/ min_OpticalThickness, 1.3, 3.6, 9.4, 23., 60., 10000. /) 
-  real, dimension(numPressureHistogramBins + 1), parameter :: & ! Units Pa 
-    pressureHistogramBoundaries = (/ 0., 18000., 31000., 44000., 56000., 68000., 80000., 1000000. /) 
-  real, parameter :: highCloudPressureLimit = 440. * 100., lowCloudPressureLimit = 680. * 100.
-  !
-  ! For output - nominal bin centers and  bin boundaries. On output pressure bins are highest to lowest. 
-  !
-  integer, private :: k, l
-  real, parameter, dimension(2, numTauHistogramBins) ::   &
-    nominalTauHistogramBoundaries =                       &
-        reshape(source = (/ tauHistogramBoundaries(1),    &
-                            ((tauHistogramBoundaries(k), l = 1, 2), k = 2, numTauHistogramBins), &
-                            100000. /),                    &
-                shape = (/2,  numTauHistogramBins /) )
-  real, parameter, dimension(numTauHistogramBins) ::                    &
-    nominalTauHistogramCenters = (nominalTauHistogramBoundaries(1, :) + &
-                                  nominalTauHistogramBoundaries(2, :) ) / 2.
-  
-  real, parameter, dimension(2, numPressureHistogramBins) :: &
-    nominalPressureHistogramBoundaries =                     &
-        reshape(source = (/ 100000.,                         &
-                            ((pressureHistogramBoundaries(k), l = 1, 2), k = numPressureHistogramBins, 2, -1), &
-                            0.  /), &
-                shape = (/2,  numPressureHistogramBins /) )
-  real, parameter, dimension(numPressureHistogramBins) ::                         &
-    nominalPressureHistogramCenters = (nominalPressureHistogramBoundaries(1, :) + &
-                                       nominalPressureHistogramBoundaries(2, :) ) / 2.
-  ! DJS2015 START: Add bin descriptions for joint-histograms of partice-sizes and optical depth. This is
-  !                identical to what is done in COSPv.2.0.0 for histogram bin initialization. 
-  integer :: j
-  integer,parameter :: &
-       numMODISReffLiqBins = 6, & ! Number of bins for tau/ReffLiq joint-histogram
-       numMODISReffIceBins = 6    ! Number of bins for tau/ReffICE joint-histogram
-  real,parameter,dimension(numMODISReffLiqBins+1) :: &
-       reffLIQ_binBounds = (/0., 8e-6, 1.0e-5, 1.3e-5, 1.5e-5, 2.0e-5, 3.0e-5/)
-  real,parameter,dimension(numMODISReffIceBins+1) :: &
-       reffICE_binBounds = (/0., 1.0e-5, 2.0e-5, 3.0e-5, 4.0e-5, 6.0e-5, 9.0e-5/)
-  real,parameter,dimension(2,numMODISReffIceBins) :: &
-       reffICE_binEdges = reshape(source=(/reffICE_binBounds(1),((reffICE_binBounds(k),  &
-                                  l=1,2),k=2,numMODISReffIceBins),reffICE_binBounds(numMODISReffIceBins+1)/),  &
-                                  shape = (/2,numMODISReffIceBins/)) 
-  real,parameter,dimension(2,numMODISReffLiqBins) :: &
-       reffLIQ_binEdges = reshape(source=(/reffLIQ_binBounds(1),((reffLIQ_binBounds(k),  &
-                                  l=1,2),k=2,numMODISReffLiqBins),reffLIQ_binBounds(numMODISReffIceBins+1)/),  &
-                                  shape = (/2,numMODISReffLiqBins/))             
-  real,parameter,dimension(numMODISReffIceBins) :: &
-       reffICE_binCenters = (reffICE_binEdges(1,:)+reffICE_binEdges(2,:))/2.
-  real,parameter,dimension(numMODISReffLiqBins) :: &
-       reffLIQ_binCenters = (reffLIQ_binEdges(1,:)+reffLIQ_binEdges(2,:))/2.
-  ! DJS2015 END
-
-  ! ------------------------------
-  ! There are two ways to call the MODIS simulator: 
-  !  1) Provide total optical thickness and liquid/ice water content and we'll partition tau in 
-  !     subroutine modis_L2_simulator_oneTau, or 
-  !  2) Provide ice and liquid optical depths in each layer
-  !
-  interface modis_L2_simulator
-    module procedure modis_L2_simulator_oneTau, modis_L2_simulator_twoTaus
-  end interface 
-contains
-  !------------------------------------------------------------------------------------------------
-  ! MODIS simulator using specified liquid and ice optical thickness in each layer 
-  !
-  !   Note: this simulator operates on all points; to match MODIS itself night-time 
-  !     points should be excluded
-  !
-  !   Note: the simulator requires as input the optical thickness and cloud top pressure 
-  !     derived from the ISCCP simulator run with parameter top_height = 1. 
-  !     If cloud top pressure is higher than about 700 mb, MODIS can't use CO2 slicing 
-  !     and reverts to a thermal algorithm much like ISCCP's. Rather than replicate that 
-  !     alogrithm in this simulator we simply report the values from the ISCCP simulator. 
-  !
-  subroutine modis_L2_simulator_twoTaus(                                       &
-                                temp, pressureLayers, pressureLevels,          &
-                                liquid_opticalThickness, ice_opticalThickness, &
-                                waterSize, iceSize,                            & 
-                                isccpTau, isccpCloudTopPressure,               &
-                                retrievedPhase, retrievedCloudTopPressure, retrievedTau, retrievedSize)
-
-    ! Grid-mean quantities at layer centers, starting at the model top
-    !   dimension nLayers
-    real, dimension(:),    intent(in ) :: temp,           & ! Temperature, K
-                                          pressureLayers, & ! Pressure, Pa
-                                          pressureLevels    ! Pressure at layer edges, Pa (dimension nLayers + 1) 
-    ! Sub-column quantities
-    !   dimension  nSubcols, nLayers
-    real, dimension(:, :), intent(in ) :: liquid_opticalThickness, & ! Layer optical thickness @ 0.67 microns due to liquid
-                                          ice_opticalThickness       ! ditto, due to ice
-    real, dimension(:, :), intent(in ) :: waterSize,        & ! Cloud drop effective radius, microns
-                                          iceSize             ! Cloud ice effective radius, microns
-                                          
-    ! Cloud properties retrieved from ISCCP using top_height = 1
-    !    dimension nSubcols
-    real, dimension(:),    intent(in ) :: isccpTau, &           ! Column-integrated optical thickness 
-                                          isccpCloudTopPressure ! ISCCP-retrieved cloud top pressure (Pa) 
-
-    ! Properties retrieved by MODIS
-    !   dimension nSubcols
-    integer, dimension(:), intent(out) :: retrievedPhase               ! liquid/ice/other - integer, defined in module header
-    real,    dimension(:), intent(out) :: retrievedCloudTopPressure, & ! units of pressureLayers
-                                          retrievedTau,              & ! unitless
-                                          retrievedSize                ! microns 
-    ! ---------------------------------------------------
-    ! Local variables
-    logical, dimension(size(retrievedTau))                     :: cloudMask
-    real,    dimension(size(waterSize, 1), size(waterSize, 2)) :: tauLiquidFraction, tauTotal
-    real    :: integratedLiquidFraction
-    integer :: i, nSubcols, nLevels
-
-    ! ---------------------------------------------------
-    nSubcols = size(liquid_opticalThickness, 1)
-    nLevels  = size(liquid_opticalThickness, 2) 
- 
-    !
-    ! Initial error checks 
-    !   
-    if(any((/ size(ice_opticalThickness, 1), size(waterSize, 1), size(iceSize, 1), &
-              size(isccpTau), size(isccpCloudTopPressure),              &
-              size(retrievedPhase), size(retrievedCloudTopPressure),    &
-              size(retrievedTau), size(retrievedSize) /) /= nSubcols )) &
-       call complain_and_die("Differing number of subcolumns in one or more arrays") 
-    
-    if(any((/ size(ice_opticalThickness, 2), size(waterSize, 2), size(iceSize, 2),      &
-              size(temp), size(pressureLayers), size(pressureLevels)-1 /) /= nLevels )) &
-       call complain_and_die("Differing number of levels in one or more arrays") 
-       
-       
-    if(any( (/ any(temp <= 0.), any(pressureLayers <= 0.),  &
-               any(liquid_opticalThickness < 0.),           &
-               any(ice_opticalThickness < 0.),              &
-               any(waterSize < 0.), any(iceSize < 0.) /) )) &
-       call complain_and_die("Input values out of bounds") 
-             
-    ! ---------------------------------------------------
-    !
-    ! Compute the total optical thickness and the proportion due to liquid in each cell
-    !
-    where(liquid_opticalThickness(:, :) + ice_opticalThickness(:, :) > 0.) 
-      tauLiquidFraction(:, :) = liquid_opticalThickness(:, :)/(liquid_opticalThickness(:, :) + ice_opticalThickness(:, :))
-    elsewhere
-      tauLiquidFraction(:, :) = 0. 
-    end  where 
-    tauTotal(:, :) = liquid_opticalThickness(:, :) + ice_opticalThickness(:, :) 
-    
-    !
-    ! Optical depth retrieval 
-    !   This is simply a sum over the optical thickness in each layer 
-    !   It should agree with the ISCCP values after min values have been excluded 
-    !
-    retrievedTau(:) = sum(tauTotal(:, :), dim = 2)
-
-    !
-    ! Cloud detection - does optical thickness exceed detection threshold? 
-    !
-    cloudMask = retrievedTau(:) >= min_OpticalThickness
-    
-    !
-    ! Initialize initial estimates for size retrievals
-    !
-    if(any(cloudMask) .and. .not. useSimpleReScheme) then 
-      g_w(:)  = get_g_nir(  phaseIsLiquid, trial_re_w(:))
-      w0_w(:) = get_ssa_nir(phaseIsLiquid, trial_re_w(:))
-      g_i(:)  = get_g_nir(  phaseIsIce,    trial_re_i(:))
-      w0_i(:) = get_ssa_nir(phaseIsIce,    trial_re_i(:))
-    end if 
-    
-    do i = 1, nSubCols
-      if(cloudMask(i)) then 
-        !
-        ! Cloud top pressure determination 
-        !   MODIS uses CO2 slicing for clouds with tops above about 700 mb and thermal methods for clouds
-        !   lower than that. 
-        !  For CO2 slicing we report the optical-depth weighted pressure, integrating to a specified 
-        !    optical depth
-        ! This assumes linear variation in p between levels. Linear in ln(p) is probably better, 
-        !   though we'd need to deal with the lowest pressure gracefully. 
-        !
-        retrievedCloudTopPressure(i) = cloud_top_pressure((/ 0., tauTotal(i, :) /), &
-                                                          pressureLevels,           &
-                                                          CO2Slicing_TauLimit)  
-        
-        
-        !
-        ! Phase determination - determine fraction of total tau that's liquid 
-        ! When ice and water contribute about equally to the extinction we can't tell 
-        !   what the phase is 
-        !
-        integratedLiquidFraction = weight_by_extinction(tauTotal(i, :),          &
-                                                        tauLiquidFraction(i, :), &
-                                                        phase_TauLimit)
-        if(integratedLiquidFraction >= phaseDiscrimination_Threshold) then 
-          retrievedPhase(i) = phaseIsLiquid
-        else if (integratedLiquidFraction <= 1.- phaseDiscrimination_Threshold) then 
-          retrievedPhase(i) = phaseIsIce
-        else 
-          retrievedPhase(i) = phaseIsUndetermined
-        end if 
-        
-        !
-        ! Size determination 
-        !
-        if(useSimpleReScheme) then 
-          !   This is the extinction-weighted size considering only the phase we've chosen 
-          !
-          if(retrievedPhase(i) == phaseIsIce) then 
-            retrievedSize(i) = weight_by_extinction(ice_opticalThickness(i, :),  &
-                                                    iceSize(i, :), &
-                                                    (1. - integratedLiquidFraction) * size_TauLimit)
-  
-          else if(retrievedPhase(i) == phaseIsLiquid) then 
-            retrievedSize(i) = weight_by_extinction(liquid_opticalThickness(i, :), &
-                                                    waterSize(i, :), &
-                                                    integratedLiquidFraction * size_TauLimit)
-  
-          else
-            retrievedSize(i) = 0. 
-          end if 
-        else
-          retrievedSize(i) = 1.0e-06*retrieve_re(retrievedPhase(i), retrievedTau(i), &
-                         obs_Refl_nir = compute_nir_reflectance(liquid_opticalThickness(i, :), waterSize(i, :)*1.0e6, & 
-                         ice_opticalThickness(i, :),      iceSize(i, :)*1.0e6))
-        end if 
-      else 
-        !
-        ! Values when we don't think there's a cloud. 
-        !
-        retrievedCloudTopPressure(i) = R_UNDEF 
-        retrievedPhase(i) = phaseIsNone
-        retrievedSize(i) = R_UNDEF 
-        retrievedTau(i) = R_UNDEF 
-      end if
-    end do
-    where((retrievedSize(:) < 0.).and.(retrievedSize(:) /= R_UNDEF)) retrievedSize(:) = 1.0e-06*re_fill
-
-    ! We use the ISCCP-derived CTP for low clouds, since the ISCCP simulator ICARUS 
-    !   mimics what MODIS does to first order. 
-    !   Of course, ISCCP cloud top pressures are in mb. 
-    !   
-    where(cloudMask(:) .and. retrievedCloudTopPressure(:) > CO2Slicing_PressureLimit) &
-      retrievedCloudTopPressure(:) = isccpCloudTopPressure * 100. 
-    
-  end subroutine modis_L2_simulator_twoTaus
-  !------------------------------------------------------------------------------------------------
-  !
-  ! MODIS simulator: provide a single optical thickness and the cloud ice and liquid contents; 
-  !   we'll partition this into ice and liquid optical thickness and call the full MODIS simulator 
-  ! 
-  subroutine modis_L2_simulator_oneTau(                                         &
-                                temp, pressureLayers, pressureLevels,           &
-                                opticalThickness, cloudWater, cloudIce,         &
-                                waterSize, iceSize,                             & 
-                                isccpTau, isccpCloudTopPressure,                &
-                                retrievedPhase, retrievedCloudTopPressure, retrievedTau, retrievedSize)
-    ! Grid-mean quantities at layer centers, 
-    !   dimension nLayers
-    real, dimension(:),    intent(in ) :: temp,           & ! Temperature, K
-                                          pressureLayers, & ! Pressure, Pa
-                                          pressureLevels    ! Pressure at layer edges, Pa (dimension nLayers + 1) 
-    ! Sub-column quantities
-    !   dimension nLayers, nSubcols
-    real, dimension(:, :), intent(in ) :: opticalThickness, & ! Layer optical thickness @ 0.67 microns
-                                          cloudWater,       & ! Cloud water content, arbitrary units
-                                          cloudIce            ! Cloud water content, same units as cloudWater
-    real, dimension(:, :), intent(in ) :: waterSize,        & ! Cloud drop effective radius, microns
-                                          iceSize             ! Cloud ice effective radius, microns
-
-    ! Cloud properties retrieved from ISCCP using top_height = 1
-    !    dimension nSubcols
-    
-    real, dimension(:),    intent(in ) :: isccpTau, &           ! Column-integrated optical thickness 
-                                          isccpCloudTopPressure ! ISCCP-retrieved cloud top pressure (Pa) 
-
-    ! Properties retrieved by MODIS
-    !   dimension nSubcols
-    integer, dimension(:), intent(out) :: retrievedPhase               ! liquid/ice/other - integer
-    real,    dimension(:), intent(out) :: retrievedCloudTopPressure, & ! units of pressureLayers
-                                          retrievedTau,              & ! unitless
-                                          retrievedSize                ! microns (or whatever units 
-                                                                       !   waterSize and iceSize are supplied in)
-    ! ---------------------------------------------------
-    ! Local variables
-    real, dimension(size(opticalThickness, 1), size(opticalThickness, 2)) :: & 
-           liquid_opticalThickness, ice_opticalThickness, tauLiquidFraction
-    
-    ! ---------------------------------------------------
-    
-    where(cloudIce(:, :) <= 0.) 
-      tauLiquidFraction(:, :) = 1. 
-    elsewhere
-      where (cloudWater(:, :) <= 0.) 
-        tauLiquidFraction(:, :) = 0. 
-      elsewhere 
-        ! 
-        ! Geometic optics limit - tau as LWP/re  (proportional to LWC/re) 
-        !
-        tauLiquidFraction(:, :) = (cloudWater(:, :)/waterSize(:, :)) / &
-                                  (cloudWater(:, :)/waterSize(:, :) + cloudIce(:, :)/(ice_density * iceSize(:, :)) ) 
-      end where
-    end where
-    liquid_opticalThickness(:, :) = tauLiquidFraction(:, :) * opticalThickness(:, :) 
-    ice_opticalThickness   (:, :) = opticalThickness(:, :) - liquid_opticalThickness(:, :)
-    
-    call modis_L2_simulator_twoTaus(temp, pressureLayers, pressureLevels,          &
-                                    liquid_opticalThickness, ice_opticalThickness, &
-                                    waterSize, iceSize,                            & 
-                                    isccpTau, isccpCloudTopPressure,               &
-                                    retrievedPhase, retrievedCloudTopPressure, retrievedTau, retrievedSize)
-                                
-  end subroutine modis_L2_simulator_oneTau
-
-  ! ########################################################################################
-  subroutine modis_column(nPoints,nSubCols,phase, cloud_top_pressure, optical_thickness, particle_size,      &
-       Cloud_Fraction_Total_Mean,         Cloud_Fraction_Water_Mean,         Cloud_Fraction_Ice_Mean,        &
-       Cloud_Fraction_High_Mean,          Cloud_Fraction_Mid_Mean,           Cloud_Fraction_Low_Mean,        &
-       Optical_Thickness_Total_Mean,      Optical_Thickness_Water_Mean,      Optical_Thickness_Ice_Mean,     &
-       Optical_Thickness_Total_MeanLog10, Optical_Thickness_Water_MeanLog10, Optical_Thickness_Ice_MeanLog10,&
-       Cloud_Particle_Size_Water_Mean,    Cloud_Particle_Size_Ice_Mean,      Cloud_Top_Pressure_Total_Mean,  &
-       Liquid_Water_Path_Mean,            Ice_Water_Path_Mean,                                               &    
-       Optical_Thickness_vs_Cloud_Top_Pressure,Optical_Thickness_vs_ReffIce,Optical_Thickness_vs_ReffLiq)
-    
-    ! INPUTS
-    integer,intent(in) :: &
-         nPoints,                           & ! Number of horizontal gridpoints
-         nSubCols                             ! Number of subcolumns
-    integer,intent(in), dimension(:,:) ::  &
-!ds    integer,intent(in), dimension(nPoints, nSubCols) ::  &
-         phase                             
-    real,intent(in),dimension(:,:) ::  &
-!ds    real,intent(in),dimension(nPoints, nSubCols) ::  &
-         cloud_top_pressure,                &
-         optical_thickness,                 &
-         particle_size
- 
-    ! OUTPUTS 
-    real,intent(inout),dimension(:)  ::   & !
-!ds    real,intent(inout),dimension(nPoints)  ::   & !
-         Cloud_Fraction_Total_Mean,         & !
-         Cloud_Fraction_Water_Mean,         & !
-         Cloud_Fraction_Ice_Mean,           & !
-         Cloud_Fraction_High_Mean,          & !
-         Cloud_Fraction_Mid_Mean,           & !
-         Cloud_Fraction_Low_Mean,           & !
-         Optical_Thickness_Total_Mean,      & !
-         Optical_Thickness_Water_Mean,      & !
-         Optical_Thickness_Ice_Mean,        & !
-         Optical_Thickness_Total_MeanLog10, & !
-         Optical_Thickness_Water_MeanLog10, & !
-         Optical_Thickness_Ice_MeanLog10,   & !
-         Cloud_Particle_Size_Water_Mean,    & !
-         Cloud_Particle_Size_Ice_Mean,      & !
-         Cloud_Top_Pressure_Total_Mean,     & !
-         Liquid_Water_Path_Mean,            & !
-         Ice_Water_Path_Mean                  !
-    real,intent(inout),dimension(:,:,:) :: &
-!ds    real,intent(inout),dimension(nPoints,numTauHistogramBins,numPressureHistogramBins) :: &
-         Optical_Thickness_vs_Cloud_Top_Pressure
-    real,intent(inout),dimension(:,:,:) :: &    
-!ds    real,intent(inout),dimension(nPoints,numTauHistogramBins,numMODISReffIceBins) :: &    
-         Optical_Thickness_vs_ReffIce
-    real,intent(inout),dimension(:,:,:) :: &    
-!ds    real,intent(inout),dimension(nPoints,numTauHistogramBins,numMODISReffLiqBins) :: &    
-         Optical_Thickness_vs_ReffLiq         
-
-    ! LOCAL VARIABLES
-    real, parameter :: &
-         LWP_conversion = 2./3. * 1000. ! MKS units  
-    integer :: i, j
-    logical, dimension(nPoints,nSubCols) :: &
-         cloudMask,      &
-         waterCloudMask, &
-         iceCloudMask,   &
-         validRetrievalMask
-    real,dimension(nPoints,nSubCols) :: &
-         tauWRK,ctpWRK,reffIceWRK,reffLiqWRK
-    
-    ! ########################################################################################
-    ! Include only those pixels with successful retrievals in the statistics 
-    ! ########################################################################################
-    validRetrievalMask(1:nPoints,1:nSubCols) = particle_size(1:nPoints,1:nSubCols) > 0.
-    cloudMask(1:nPoints,1:nSubCols) = phase(1:nPoints,1:nSubCols) /= phaseIsNone .and.       &
-         validRetrievalMask(1:nPoints,1:nSubCols)
-    waterCloudMask(1:nPoints,1:nSubCols) = phase(1:nPoints,1:nSubCols) == phaseIsLiquid .and. &
-         validRetrievalMask(1:nPoints,1:nSubCols)
-    iceCloudMask(1:nPoints,1:nSubCols)   = phase(1:nPoints,1:nSubCols) == phaseIsIce .and.    &
-         validRetrievalMask(1:nPoints,1:nSubCols)
-
-    ! ########################################################################################
-    ! Use these as pixel counts at first 
-    ! ########################################################################################
-    Cloud_Fraction_Total_Mean(1:nPoints) = real(count(cloudMask,      dim = 2))
-    Cloud_Fraction_Water_Mean(1:nPoints) = real(count(waterCloudMask, dim = 2))
-    Cloud_Fraction_Ice_Mean(1:nPoints)   = real(count(iceCloudMask,   dim = 2))
-    Cloud_Fraction_High_Mean(1:nPoints)  = real(count(cloudMask .and. cloud_top_pressure <=          &
-                                           highCloudPressureLimit, dim = 2)) 
-    Cloud_Fraction_Low_Mean(1:nPoints)   = real(count(cloudMask .and. cloud_top_pressure >           &
-                                           lowCloudPressureLimit,  dim = 2)) 
-    Cloud_Fraction_Mid_Mean(1:nPoints)   = Cloud_Fraction_Total_Mean(1:nPoints) - Cloud_Fraction_High_Mean(1:nPoints)&
-                                           - Cloud_Fraction_Low_Mean(1:nPoints)
-
-    ! ########################################################################################
-    ! Compute mean optical thickness.
-    ! ########################################################################################
-    Optical_Thickness_Total_Mean(1:nPoints) = sum(optical_thickness, mask = cloudMask,      dim = 2) / &
-                                              Cloud_Fraction_Total_Mean(1:nPoints) 
-    Optical_Thickness_Water_Mean(1:nPoints) = sum(optical_thickness, mask = waterCloudMask, dim = 2) / &
-                                              Cloud_Fraction_Water_Mean(1:nPoints)
-    Optical_Thickness_Ice_Mean(1:nPoints)   = sum(optical_thickness, mask = iceCloudMask,   dim = 2) / &
-                                              Cloud_Fraction_Ice_Mean(1:nPoints)
-       
-    ! ########################################################################################
-    ! We take the absolute value of optical thickness here to satisfy compilers that complains 
-    ! when we evaluate the logarithm of a negative number, even though it's not included in 
-    ! the sum. 
-    ! ########################################################################################
-    Optical_Thickness_Total_MeanLog10(1:nPoints) = sum(log10(abs(optical_thickness)), mask = cloudMask, &
-         dim = 2) / Cloud_Fraction_Total_Mean(1:nPoints)
-    Optical_Thickness_Water_MeanLog10(1:nPoints) = sum(log10(abs(optical_thickness)), mask = waterCloudMask,&
-         dim = 2) / Cloud_Fraction_Water_Mean(1:nPoints)
-    Optical_Thickness_Ice_MeanLog10(1:nPoints) = sum(log10(abs(optical_thickness)), mask = iceCloudMask,&
-         dim = 2) / Cloud_Fraction_Ice_Mean(1:nPoints)
-    Cloud_Particle_Size_Water_Mean(1:nPoints) = sum(particle_size, mask = waterCloudMask, dim = 2) / &
-         Cloud_Fraction_Water_Mean(1:nPoints)
-    Cloud_Particle_Size_Ice_Mean(1:nPoints) = sum(particle_size, mask = iceCloudMask,   dim = 2) / &
-         Cloud_Fraction_Ice_Mean(1:nPoints)
-    Cloud_Top_Pressure_Total_Mean(1:nPoints) = sum(cloud_top_pressure, mask = cloudMask, dim = 2) / &
-         max(1, count(cloudMask, dim = 2))
-    Liquid_Water_Path_Mean(1:nPoints) = LWP_conversion*sum(particle_size*optical_thickness, &
-         mask=waterCloudMask,dim=2)/Cloud_Fraction_Water_Mean(1:nPoints)
-    Ice_Water_Path_Mean(1:nPoints) = LWP_conversion * ice_density*sum(particle_size*optical_thickness,&
-         mask=iceCloudMask,dim = 2) /Cloud_Fraction_Ice_Mean(1:nPoints)
-
-    ! ########################################################################################
-    ! Normalize pixel counts to fraction.
-    ! ########################################################################################
-    Cloud_Fraction_High_Mean(1:nPoints)  = Cloud_Fraction_High_Mean(1:nPoints)  /nSubcols
-    Cloud_Fraction_Mid_Mean(1:nPoints)   = Cloud_Fraction_Mid_Mean(1:nPoints)   /nSubcols
-    Cloud_Fraction_Low_Mean(1:nPoints)   = Cloud_Fraction_Low_Mean(1:nPoints)   /nSubcols
-    Cloud_Fraction_Total_Mean(1:nPoints) = Cloud_Fraction_Total_Mean(1:nPoints) /nSubcols
-    Cloud_Fraction_Ice_Mean(1:nPoints)   = Cloud_Fraction_Ice_Mean(1:nPoints)   /nSubcols
-    Cloud_Fraction_Water_Mean(1:nPoints) = Cloud_Fraction_Water_Mean(1:nPoints) /nSubcols
-    
-    ! ########################################################################################
-    ! Set clear-scenes to undefined
-    ! ########################################################################################
-    where (Cloud_Fraction_Total_Mean == 0)
-       Optical_Thickness_Total_Mean      = R_UNDEF
-       Optical_Thickness_Total_MeanLog10 = R_UNDEF
-       Cloud_Top_Pressure_Total_Mean     = R_UNDEF
-    endwhere
-    where (Cloud_Fraction_Water_Mean == 0)
-       Optical_Thickness_Water_Mean      = R_UNDEF
-       Optical_Thickness_Water_MeanLog10 = R_UNDEF
-       Cloud_Particle_Size_Water_Mean    = R_UNDEF
-       Liquid_Water_Path_Mean            = R_UNDEF
-    endwhere
-    where (Cloud_Fraction_Ice_Mean == 0)
-       Optical_Thickness_Ice_Mean        = R_UNDEF
-       Optical_Thickness_Ice_MeanLog10   = R_UNDEF
-       Cloud_Particle_Size_Ice_Mean      = R_UNDEF
-       Ice_Water_Path_Mean               = R_UNDEF
-    endwhere
-    where (Cloud_Fraction_High_Mean == 0)  Cloud_Fraction_High_Mean = R_UNDEF
-    where (Cloud_Fraction_Mid_Mean == 0)   Cloud_Fraction_Mid_Mean = R_UNDEF
-    where (Cloud_Fraction_Low_Mean == 0)   Cloud_Fraction_Low_Mean = R_UNDEF
-
-    ! ########################################################################################
-    ! Joint histogram  
-    ! ########################################################################################
-
-    ! Loop over all points
-    tauWRK(1:nPoints,1:nSubCols)     = optical_thickness(1:nPoints,1:nSubCols)
-    ctpWRK(1:nPoints,1:nSubCols)     = cloud_top_pressure(1:nPoints,1:nSubCols)
-    reffIceWRK(1:nPoints,1:nSubCols) = merge(particle_size,R_UNDEF,iceCloudMask)
-    reffLiqWRK(1:nPoints,1:nSubCols) = merge(particle_size,R_UNDEF,waterCloudMask)
-    do j=1,nPoints
-
-       ! Fill clear and optically thin subcolumns with fill
-       where(.not. cloudMask(j,1:nSubCols)) 
-          tauWRK(j,1:nSubCols) = -999.
-          ctpWRK(j,1:nSubCols) = -999.
-       endwhere
-       ! Joint histogram of tau/CTP
-       call hist2D(tauWRK(j,1:nSubCols),ctpWRK(j,1:nSubCols),nSubCols,&
-                   tauHistogramBoundaries,numTauHistogramBins,&
-                   pressureHistogramBoundaries,numPressureHistogramBins,&
-                   Optical_Thickness_vs_Cloud_Top_Pressure(j,1:numTauHistogramBins,1:numPressureHistogramBins))
-       ! Joint histogram of tau/ReffICE
-       call hist2D(tauWRK(j,1:nSubCols),reffIceWrk(j,1:nSubCols),nSubCols,               &
-                   tauHistogramBoundaries,numTauHistogramBins,reffICE_binBounds,         &
-                   numMODISReffIceBins, Optical_Thickness_vs_ReffIce(j,1:numTauHistogramBins,1:numMODISReffIceBins))
-       ! Joint histogram of tau/ReffLIQ
-       call hist2D(tauWRK(j,1:nSubCols),reffLiqWrk(j,1:nSubCols),nSubCols,               &
-                   tauHistogramBoundaries,numTauHistogramBins,reffLIQ_binBounds,         &
-                   numMODISReffLiqBins, Optical_Thickness_vs_ReffLiq(j,1:numTauHistogramBins,1:numMODISReffLiqBins))                   
-
-    enddo   
-    Optical_Thickness_vs_Cloud_Top_Pressure(1:nPoints,1:numTauHistogramBins,1:numPressureHistogramBins) = &
-         Optical_Thickness_vs_Cloud_Top_Pressure(1:nPoints,1:numTauHistogramBins,1:numPressureHistogramBins)/nSubCols
-    Optical_Thickness_vs_ReffIce(1:nPoints,1:numTauHistogramBins,1:numMODISReffIceBins) = &
-         Optical_Thickness_vs_ReffIce(1:nPoints,1:numTauHistogramBins,1:numMODISReffIceBins)/nSubCols
-    Optical_Thickness_vs_ReffLiq(1:nPoints,1:numTauHistogramBins,1:numMODISReffLiqBins) = &
-         Optical_Thickness_vs_ReffLiq(1:nPoints,1:numTauHistogramBins,1:numMODISReffLiqBins)/nSubCols 
-
-  end subroutine modis_column
-  ! ######################################################################################
-  ! SUBROUTINE hist2D
-  ! ######################################################################################
-  subroutine hist2D(var1,var2,npts,bin1,nbin1,bin2,nbin2,jointHist)
-    implicit none
-    
-    ! INPUTS
-    integer, intent(in) :: &
-         npts,  & ! Number of data points to be sorted
-         nbin1, & ! Number of bins in histogram direction 1 
-         nbin2    ! Number of bins in histogram direction 2
-    real,intent(in),dimension(npts) :: &
-         var1,  & ! Variable 1 to be sorted into bins
-         var2     ! variable 2 to be sorted into bins
-    real,intent(in),dimension(nbin1+1) :: &
-         bin1     ! Histogram bin 1 boundaries
-    real,intent(in),dimension(nbin2+1) :: &
-         bin2     ! Histogram bin 2 boundaries
-    ! OUTPUTS
-    real,intent(out),dimension(nbin1,nbin2) :: &
-         jointHist
-    
-    ! LOCAL VARIABLES
-    integer :: ij,ik
-    
-    do ij=2,nbin1+1
-       do ik=2,nbin2+1
-          jointHist(ij-1,ik-1)=count(var1 .ge. bin1(ij-1) .and. var1 .lt. bin1(ij) .and. &
-               var2 .ge. bin2(ik-1) .and. var2 .lt. bin2(ik))        
-       enddo
-    enddo
-  end subroutine hist2D
-  
-  !------------------------------------------------------------------------------------------------
-  subroutine modis_L3_simulator(phase, cloud_top_pressure, optical_thickness, particle_size,            &
-       Cloud_Fraction_Total_Mean,       Cloud_Fraction_Water_Mean,       Cloud_Fraction_Ice_Mean,       &
-       Cloud_Fraction_High_Mean,        Cloud_Fraction_Mid_Mean,         Cloud_Fraction_Low_Mean,       &
-       Optical_Thickness_Total_Mean,    Optical_Thickness_Water_Mean,    Optical_Thickness_Ice_Mean,    &
-       Optical_Thickness_Total_MeanLog10, Optical_Thickness_Water_MeanLog10, Optical_Thickness_Ice_MeanLog10, &
-                                        Cloud_Particle_Size_Water_Mean,  Cloud_Particle_Size_Ice_Mean,  &
-       Cloud_Top_Pressure_Total_Mean,                                                                   &
-                                        Liquid_Water_Path_Mean,          Ice_Water_Path_Mean,           &    
-       Optical_Thickness_vs_Cloud_Top_Pressure)
-    !
-    ! Inputs; dimension nPoints, nSubcols
-    !
-    integer, dimension(:, :),   intent(in)  :: phase
-    real,    dimension(:, :),   intent(in)  :: cloud_top_pressure, optical_thickness, particle_size
-    !
-    ! Outputs; dimension nPoints
-    !
-    real,    dimension(:),      intent(out) :: &
-       Cloud_Fraction_Total_Mean,       Cloud_Fraction_Water_Mean,       Cloud_Fraction_Ice_Mean,       &
-       Cloud_Fraction_High_Mean,        Cloud_Fraction_Mid_Mean,         Cloud_Fraction_Low_Mean,       &
-       Optical_Thickness_Total_Mean,    Optical_Thickness_Water_Mean,    Optical_Thickness_Ice_Mean,    &
-       Optical_Thickness_Total_MeanLog10, Optical_Thickness_Water_MeanLog10, Optical_Thickness_Ice_MeanLog10, &
-                                        Cloud_Particle_Size_Water_Mean,  Cloud_Particle_Size_Ice_Mean,  &
-       Cloud_Top_Pressure_Total_Mean,                                                                   &
-                                        Liquid_Water_Path_Mean,          Ice_Water_Path_Mean
-    ! tau/ctp histogram; dimensions nPoints, numTauHistogramBins , numPressureHistogramBins 
-    real,    dimension(:, :, :), intent(out) :: Optical_Thickness_vs_Cloud_Top_Pressure
-    ! ---------------------------
-    ! Local variables
-    !
-    real, parameter :: LWP_conversion = 2./3. * 1000. ! MKS units  
-    integer :: i, j
-    integer :: nPoints, nSubcols 
-    logical, dimension(size(phase, 1), size(phase, 2)) :: &
-      cloudMask, waterCloudMask, iceCloudMask, validRetrievalMask
-    logical, dimension(size(phase, 1), size(phase, 2), numTauHistogramBins     ) :: tauMask
-    logical, dimension(size(phase, 1), size(phase, 2), numPressureHistogramBins) :: pressureMask
-    ! ---------------------------
-    
-    nPoints  = size(phase, 1) 
-    nSubcols = size(phase, 2) 
-    !
-    ! Array conformance checks
-    !
-    if(any( (/ size(cloud_top_pressure, 1), size(optical_thickness, 1), size(particle_size, 1),                                &
-               size(Cloud_Fraction_Total_Mean),       size(Cloud_Fraction_Water_Mean),       size(Cloud_Fraction_Ice_Mean),    &
-               size(Cloud_Fraction_High_Mean),        size(Cloud_Fraction_Mid_Mean),         size(Cloud_Fraction_Low_Mean),    &
-               size(Optical_Thickness_Total_Mean),    size(Optical_Thickness_Water_Mean),    size(Optical_Thickness_Ice_Mean), &
-               size(Optical_Thickness_Total_MeanLog10), size(Optical_Thickness_Water_MeanLog10), &
-               size(Optical_Thickness_Ice_MeanLog10),   size(Cloud_Particle_Size_Water_Mean),    &
-               size(Cloud_Particle_Size_Ice_Mean),      size(Cloud_Top_Pressure_Total_Mean),     &
-               size(Liquid_Water_Path_Mean),          size(Ice_Water_Path_Mean) /) /= nPoints))  &
-      call complain_and_die("Some L3 arrays have wrong number of grid points") 
-    if(any( (/ size(cloud_top_pressure, 2), size(optical_thickness, 2), size(particle_size, 2) /)  /= nSubcols)) &
-      call complain_and_die("Some L3 arrays have wrong number of subcolumns") 
-    
-    
-    !
-    ! Include only those pixels with successful retrievals in the statistics 
-    !
-    validRetrievalMask(:, :) = particle_size(:, :) > 0.
-    cloudMask      = phase(:, :) /= phaseIsNone   .and. validRetrievalMask(:, :)
-    waterCloudMask = phase(:, :) == phaseIsLiquid .and. validRetrievalMask(:, :)
-    iceCloudMask   = phase(:, :) == phaseIsIce    .and. validRetrievalMask(:, :)
-    !
-    ! Use these as pixel counts at first 
-    !
-    Cloud_Fraction_Total_Mean(:) = real(count(cloudMask,      dim = 2))
-    Cloud_Fraction_Water_Mean(:) = real(count(waterCloudMask, dim = 2))
-    Cloud_Fraction_Ice_Mean(:)   = real(count(iceCloudMask,   dim = 2))
-    
-    Cloud_Fraction_High_Mean(:) = real(count(cloudMask .and. cloud_top_pressure <= highCloudPressureLimit, dim = 2)) 
-    Cloud_Fraction_Low_Mean(:)  = real(count(cloudMask .and. cloud_top_pressure >  lowCloudPressureLimit,  dim = 2)) 
-    Cloud_Fraction_Mid_Mean(:)  = Cloud_Fraction_Total_Mean(:) - Cloud_Fraction_High_Mean(:) - Cloud_Fraction_Low_Mean(:)
-    
-    !
-    ! Don't want to divide by 0, even though the sums will be 0 where the pixel counts are 0. 
-    !
-    where (Cloud_Fraction_Total_Mean == 0) Cloud_Fraction_Total_Mean = -1. 
-    where (Cloud_Fraction_Water_Mean == 0) Cloud_Fraction_Water_Mean = -1.
-    where (Cloud_Fraction_Ice_Mean   == 0) Cloud_Fraction_Ice_Mean   = -1.
-    
-    Optical_Thickness_Total_Mean = sum(optical_thickness, mask = cloudMask,      dim = 2) / Cloud_Fraction_Total_Mean(:) 
-    Optical_Thickness_Water_Mean = sum(optical_thickness, mask = waterCloudMask, dim = 2) / Cloud_Fraction_Water_Mean(:)
-    Optical_Thickness_Ice_Mean   = sum(optical_thickness, mask = iceCloudMask,   dim = 2) / Cloud_Fraction_Ice_Mean(:)
-   
-    ! We take the absolute value of optical thickness here to satisfy compilers that complains when we 
-    !   evaluate the logarithm of a negative number, even though it's not included in the sum. 
-    Optical_Thickness_Total_MeanLog10 = sum(log10(abs(optical_thickness)), mask = cloudMask,      dim = 2) / &
-                                        Cloud_Fraction_Total_Mean(:)
-    Optical_Thickness_Water_MeanLog10 = sum(log10(abs(optical_thickness)), mask = waterCloudMask, dim = 2) / &
-                                        Cloud_Fraction_Water_Mean(:)
-    Optical_Thickness_Ice_MeanLog10   = sum(log10(abs(optical_thickness)), mask = iceCloudMask,   dim = 2) / &
-                                        Cloud_Fraction_Ice_Mean(:)
-   
-    Cloud_Particle_Size_Water_Mean = sum(particle_size, mask = waterCloudMask, dim = 2) / Cloud_Fraction_Water_Mean(:)
-    Cloud_Particle_Size_Ice_Mean   = sum(particle_size, mask = iceCloudMask,   dim = 2) / Cloud_Fraction_Ice_Mean(:)
-    
-    Cloud_Top_Pressure_Total_Mean = sum(cloud_top_pressure, mask = cloudMask, dim = 2) / max(1, count(cloudMask, dim = 2))
-    
-    Liquid_Water_Path_Mean = LWP_conversion &
-                             * sum(particle_size * optical_thickness, mask = waterCloudMask, dim = 2) &
-                             / Cloud_Fraction_Water_Mean(:)
-    Ice_Water_Path_Mean    = LWP_conversion * ice_density &
-                             * sum(particle_size * optical_thickness, mask = iceCloudMask,   dim = 2) &
-                             / Cloud_Fraction_Ice_Mean(:)
-
-    !
-    ! Normalize pixel counts to fraction
-    !   The first three cloud fractions have been set to -1 in cloud-free areas, so set those places to 0.
-    ! 
-    Cloud_Fraction_Total_Mean(:) = max(0., Cloud_Fraction_Total_Mean(:)/nSubcols)
-    Cloud_Fraction_Water_Mean(:) = max(0., Cloud_Fraction_Water_Mean(:)/nSubcols)
-    Cloud_Fraction_Ice_Mean(:)   = max(0., Cloud_Fraction_Ice_Mean(:)  /nSubcols)
-    
-    Cloud_Fraction_High_Mean(:)  = Cloud_Fraction_High_Mean(:) /nSubcols
-    Cloud_Fraction_Mid_Mean(:)   = Cloud_Fraction_Mid_Mean(:)  /nSubcols
-    Cloud_Fraction_Low_Mean(:)   = Cloud_Fraction_Low_Mean(:)  /nSubcols
-    
-    ! ----
-    ! Joint histogram 
-    ! 
-    do i = 1, numTauHistogramBins 
-      where(cloudMask(:, :)) 
-        tauMask(:, :, i) = optical_thickness(:, :) >= tauHistogramBoundaries(i) .and. &
-                           optical_thickness(:, :) <  tauHistogramBoundaries(i+1)
-      elsewhere
-        tauMask(:, :, i) = .false.
-      end where
-    end do 
-
-    do i = 1, numPressureHistogramBins 
-      where(cloudMask(:, :)) 
-        pressureMask(:, :, i) = cloud_top_pressure(:, :) >= pressureHistogramBoundaries(i) .and. &
-                                cloud_top_pressure(:, :) <  pressureHistogramBoundaries(i+1)
-      elsewhere
-        pressureMask(:, :, i) = .false.
-      end where
-    end do 
-    
-    do i = 1, numPressureHistogramBins
-      do j = 1, numTauHistogramBins
-        Optical_Thickness_vs_Cloud_Top_Pressure(:, j, i) = & 
-          real(count(tauMask(:, :, j) .and. pressureMask(:, :, i), dim = 2)) / real(nSubcols)
-      end do 
-    end do 
-    
-  end subroutine modis_L3_simulator
-  !------------------------------------------------------------------------------------------------
-  function cloud_top_pressure(tauIncrement, pressure, tauLimit) 
-    real, dimension(:), intent(in) :: tauIncrement, pressure
-    real,               intent(in) :: tauLimit
-    real                           :: cloud_top_pressure
-    !
-    ! Find the extinction-weighted pressure. Assume that pressure varies linearly between 
-    !   layers and use the trapezoidal rule.
-    !
-    
-    real :: deltaX, totalTau, totalProduct
-    integer :: i 
-    
-    totalTau = 0.; totalProduct = 0. 
-    do i = 2, size(tauIncrement)
-      if(totalTau + tauIncrement(i) > tauLimit) then 
-        deltaX = tauLimit - totalTau
-        totalTau = totalTau + deltaX
-        !
-        ! Result for trapezoidal rule when you take less than a full step
-        !   tauIncrement is a layer-integrated value
-        !
-        totalProduct = totalProduct           &
-                     + pressure(i-1) * deltaX &
-                     + (pressure(i) - pressure(i-1)) * deltaX**2/(2. * tauIncrement(i)) 
-      else
-        totalTau =     totalTau     + tauIncrement(i) 
-        totalProduct = totalProduct + tauIncrement(i) * (pressure(i) + pressure(i-1)) / 2.
-      end if 
-      if(totalTau >= tauLimit) exit
-    end do 
-    cloud_top_pressure = totalProduct/totalTau
-  end function cloud_top_pressure
-  !------------------------------------------------------------------------------------------------
-  function weight_by_extinction(tauIncrement, f, tauLimit) 
-    real, dimension(:), intent(in) :: tauIncrement, f
-    real,               intent(in) :: tauLimit
-    real                           :: weight_by_extinction
-    !
-    ! Find the extinction-weighted value of f(tau), assuming constant f within each layer
-    !
-    
-    real    :: deltaX, totalTau, totalProduct
-    integer :: i 
-    
-    totalTau = 0.; totalProduct = 0. 
-    do i = 1, size(tauIncrement)
-      if(totalTau + tauIncrement(i) > tauLimit) then 
-        deltaX       = tauLimit - totalTau
-        totalTau     = totalTau     + deltaX
-        totalProduct = totalProduct + deltaX * f(i) 
-      else
-        totalTau     = totalTau     + tauIncrement(i) 
-        totalProduct = totalProduct + tauIncrement(i) * f(i) 
-      end if 
-      if(totalTau >= tauLimit) exit
-    end do 
-    weight_by_extinction = totalProduct/totalTau
-  end function weight_by_extinction
-  !------------------------------------------------------------------------------------------------
-  pure function compute_nir_reflectance(water_tau, water_size, ice_tau, ice_size) 
-    real, dimension(:), intent(in) :: water_tau, water_size, ice_tau, ice_size
-    real                           :: compute_nir_reflectance
-    
-    real, dimension(size(water_tau)) :: water_g, water_w0, ice_g, ice_w0, &
-                                        tau, g, w0
-    !----------------------------------------
-    water_g(:)  = get_g_nir(  phaseIsLiquid, water_size) 
-    water_w0(:) = get_ssa_nir(phaseIsLiquid, water_size) 
-    ice_g(:)    = get_g_nir(  phaseIsIce,    ice_size) 
-    ice_w0(:)   = get_ssa_nir(phaseIsIce,    ice_size) 
-    !
-    ! Combine ice and water optical properties
-    !
-    g(:) = 0; w0(:) = 0. 
-    tau(:) = ice_tau(:) + water_tau(:) 
-    where (tau(:) > 0) 
-      w0(:) = (water_tau(:) * water_w0(:)  + ice_tau(:) * ice_w0(:)) / &
-              tau(:)
-      g(:) = (water_tau(:) * water_g(:) * water_w0(:)  + ice_tau(:) * ice_g(:) * ice_w0(:)) / &
-             (w0(:) * tau(:))
-    end where
-    
-    compute_nir_reflectance = compute_toa_reflectace(tau, g, w0)
-  end function compute_nir_reflectance
-  !------------------------------------------------------------------------------------------------
-  ! Retreivals
-  !------------------------------------------------------------------------------------------------
-  elemental function retrieve_re (phase, tau, obs_Refl_nir)
-      integer, intent(in) :: phase
-      real,    intent(in) :: tau, obs_Refl_nir
-      real                :: retrieve_re
-      !
-      ! Finds the re that produces the minimum mis-match between predicted and observed reflectance in 
-      !   MODIS band 7 (near IR)
-      ! Uses 
-      !  fits for asymmetry parameter g(re) and single scattering albedo w0(re) based on MODIS tables 
-      !  two-stream for layer reflectance and transmittance as a function of optical thickness tau, g, and w0
-      !  adding-doubling for total reflectance 
-      !  
-      !
-      !
-      ! Local variables
-      !
-      real, parameter :: min_distance_to_boundary = 0.01
-      real    :: re_min, re_max, delta_re
-      integer :: i 
-      
-      real, dimension(num_trial_res) :: trial_re, g, w0, predicted_Refl_nir
-      ! --------------------------
-    
-    if(any(phase == (/ phaseIsLiquid, phaseIsUndetermined, phaseIsIce /))) then 
-      if (phase == phaseIsLiquid .OR. phase == phaseIsUndetermined) then
-        re_min = re_water_min
-        re_max = re_water_max
-        trial_re(:) = trial_re_w
-        g(:)   = g_w(:) 
-        w0(:)  = w0_w(:)
-      else
-        re_min = re_ice_min
-        re_max = re_ice_max
-        trial_re(:) = trial_re_i
-        g(:)   = g_i(:) 
-        w0(:)  = w0_i(:)
-      end if
-      !
-      ! 1st attempt at index: w/coarse re resolution
-      !
-      predicted_Refl_nir(:) = two_stream_reflectance(tau, g(:), w0(:))
-      retrieve_re = interpolate_to_min(trial_re(:), predicted_Refl_nir(:), obs_Refl_nir) 
-      !
-      ! If first retrieval works, can try 2nd iteration using greater re resolution 
-      !
-! DJS2015: Remove unused piece of code      
-!      if(use_two_re_iterations .and. retrieve_re > 0.) then
-!        re_min = retrieve_re - delta_re
-!        re_max = retrieve_re + delta_re
-!        delta_re = (re_max - re_min)/real(num_trial_res-1)
-!  
-!        trial_re(:) = re_min + delta_re * (/ (i - 1, i = 1, num_trial_res) /) 
-!        g(:)  = get_g_nir(  phase, trial_re(:))
-!        w0(:) = get_ssa_nir(phase, trial_re(:))
-!        predicted_Refl_nir(:) = two_stream_reflectance(tau, g(:), w0(:))
-!        retrieve_re = interpolate_to_min(trial_re(:), predicted_Refl_nir(:), obs_Refl_nir) 
-!      end if
-! DJS2015 END
-    else 
-      retrieve_re = re_fill
-    end if 
-    
-  end function retrieve_re
-  ! --------------------------------------------
-  pure function interpolate_to_min(x, y, yobs)
-    real, dimension(:), intent(in) :: x, y 
-    real,               intent(in) :: yobs
-    real                           :: interpolate_to_min
-    ! 
-    ! Given a set of values of y as y(x), find the value of x that minimizes abs(y - yobs)
-    !   y must be monotonic in x
-    !
-    real, dimension(size(x)) :: diff
-    integer                  :: nPoints, minDiffLoc, lowerBound, upperBound
-    ! ---------------------------------
-    nPoints = size(y)
-    diff(:) = y(:) - yobs
-    minDiffLoc = minloc(abs(diff), dim = 1) 
-    
-    if(minDiffLoc == 1) then 
-      lowerBound = minDiffLoc
-      upperBound = minDiffLoc + 1
-    else if(minDiffLoc == nPoints) then
-      lowerBound = minDiffLoc - 1
-      upperBound = minDiffLoc
-    else
-      if(diff(minDiffLoc-1) * diff(minDiffLoc) < 0) then
-        lowerBound = minDiffLoc-1
-        upperBound = minDiffLoc
-      else 
-        lowerBound = minDiffLoc
-        upperBound = minDiffLoc + 1
-      end if 
-    end if 
-    
-    if(diff(lowerBound) * diff(upperBound) < 0) then     
-      !
-      ! Interpolate the root position linearly if we bracket the root
-      !
-      interpolate_to_min = x(upperBound) - & 
-                           diff(upperBound) * (x(upperBound) - x(lowerBound)) / (diff(upperBound) - diff(lowerBound))
-    else 
-      interpolate_to_min = re_fill
-    end if 
-    
-
-  end function interpolate_to_min
-  ! --------------------------------------------
-  ! Optical properties
-  ! --------------------------------------------
-  elemental function get_g_nir (phase, re)
-    !
-    ! Polynomial fit for asummetry parameter g in MODIS band 7 (near IR) as a function 
-    !   of size for ice and water
-    ! Fits from Steve Platnick
-    !
-
-    integer, intent(in) :: phase
-    real,    intent(in) :: re
-    real :: get_g_nir 
-
-    real, dimension(3), parameter :: ice_coefficients         = (/ 0.7490, 6.5153e-3, -5.4136e-5 /), &
-                                     small_water_coefficients = (/ 1.0364, -8.8800e-2, 7.0000e-3 /)
-    real, dimension(4), parameter :: big_water_coefficients   = (/ 0.6035, 2.8993e-2, -1.1051e-3, 1.5134e-5 /)
-
-    ! approx. fits from MODIS Collection 6 LUT scattering calculations for 3.7 µm channel size retrievals
-    if(phase == phaseIsLiquid) then 
-       if(re < 7.) then
-          get_g_nir = fit_to_quadratic(re, small_water_coefficients)
-          if(re < re_water_min) get_g_nir = fit_to_quadratic(re_water_min, small_water_coefficients)
-       else
-          get_g_nir = fit_to_cubic(re, big_water_coefficients)
-          if(re > re_water_max) get_g_nir = fit_to_cubic(re_water_max, big_water_coefficients)
-       end if
-    else
-       get_g_nir = fit_to_quadratic(re, ice_coefficients)
-      if(re < re_ice_min) get_g_nir = fit_to_quadratic(re_ice_min, ice_coefficients)
-      if(re > re_ice_max) get_g_nir = fit_to_quadratic(re_ice_max, ice_coefficients)
-    end if 
-    
-  end function get_g_nir
-
-  ! --------------------------------------------
-    elemental function get_ssa_nir (phase, re)
-        integer, intent(in) :: phase
-        real,    intent(in) :: re
-        real                :: get_ssa_nir
-        !
-        ! Polynomial fit for single scattering albedo in MODIS band 7 (near IR) as a function 
-        !   of size for ice and water
-        ! Fits from Steve Platnick
-        !
-        real, dimension(4), parameter :: ice_coefficients   = (/ 0.9625, -1.8069e-2, 3.3281e-4,-2.2865e-6/)
-        real, dimension(3), parameter :: water_coefficients = (/ 1.0044, -1.1397e-2, 1.3300e-4 /)
-        
-        ! approx. fits from MODIS Collection 6 LUT scattering calculations
-        if(phase == phaseIsLiquid) then
-          get_ssa_nir = fit_to_quadratic(re, water_coefficients)
-          if(re < re_water_min) get_ssa_nir = fit_to_quadratic(re_water_min, water_coefficients)
-          if(re > re_water_max) get_ssa_nir = fit_to_quadratic(re_water_max, water_coefficients)
-        else
-          get_ssa_nir = fit_to_cubic(re, ice_coefficients)
-          if(re < re_ice_min) get_ssa_nir = fit_to_cubic(re_ice_min, ice_coefficients)
-          if(re > re_ice_max) get_ssa_nir = fit_to_cubic(re_ice_max, ice_coefficients)
-        end if 
-
-    end function get_ssa_nir
-   ! --------------------------------------------
-  pure function fit_to_cubic(x, coefficients) 
-    real,               intent(in) :: x
-    real, dimension(:), intent(in) :: coefficients
-    real                           :: fit_to_cubic
-    
-    
-    fit_to_cubic = coefficients(1) + x * (coefficients(2) + x * (coefficients(3) + x * coefficients(4)))
- end function fit_to_cubic
-   ! --------------------------------------------
-  pure function fit_to_quadratic(x, coefficients) 
-    real,               intent(in) :: x
-    real, dimension(:), intent(in) :: coefficients
-    real                           :: fit_to_quadratic
-    
-    
-    fit_to_quadratic = coefficients(1) + x * (coefficients(2) + x * (coefficients(3)))
- end function fit_to_quadratic
-  ! --------------------------------------------
-  ! Radiative transfer
-  ! --------------------------------------------
-  pure function compute_toa_reflectace(tau, g, w0)
-    real, dimension(:), intent(in) :: tau, g, w0
-    real                           :: compute_toa_reflectace
-    
-    logical, dimension(size(tau))         :: cloudMask
-    integer, dimension(count(tau(:) > 0)) :: cloudIndicies
-    real,    dimension(count(tau(:) > 0)) :: Refl,     Trans
-    real                                  :: Refl_tot, Trans_tot
-    integer                               :: i
-    ! ---------------------------------------
-    !
-    ! This wrapper reports reflectance only and strips out non-cloudy elements from the calculation
-    !
-    cloudMask = tau(:) > 0. 
-    cloudIndicies = pack((/ (i, i = 1, size(tau)) /), mask = cloudMask) 
-    do i = 1, size(cloudIndicies)
-      call two_stream(tau(cloudIndicies(i)), g(cloudIndicies(i)), w0(cloudIndicies(i)), Refl(i), Trans(i))
-    end do 
-                    
-    call adding_doubling(Refl(:), Trans(:), Refl_tot, Trans_tot)  
-    
-    compute_toa_reflectace = Refl_tot
-    
-  end function compute_toa_reflectace
-  ! --------------------------------------------
-  pure subroutine two_stream(tauint, gint, w0int, ref, tra) 
-    real, intent(in)  :: tauint, gint, w0int
-    real, intent(out) :: ref, tra
-    !
-    ! Compute reflectance in a single layer using the two stream approximation 
-    !   The code itself is from Lazaros Oreopoulos via Steve Platnick 
-    !
-    ! ------------------------
-    ! Local variables 
-    !   for delta Eddington code
-    !   xmu, gamma3, and gamma4 only used for collimated beam approximation (i.e., beam=1)
-    integer, parameter :: beam = 2
-    real,    parameter :: xmu = 0.866, minConservativeW0 = 0.9999999
-    real :: tau, w0, g, f, gamma1, gamma2, gamma3, gamma4, &
-            rh, a1, a2, rk, r1, r2, r3, r4, r5, t1, t2, t3, t4, t5, beta, e1, e2, ef1, ef2, den, th
-    !
-    ! Compute reflectance and transmittance in a single layer using the two stream approximation 
-    !   The code itself is from Lazaros Oreopoulos via Steve Platnick 
-    !
-    f   = gint**2
-    tau = (1 - w0int * f) * tauint
-    w0  = (1 - f) * w0int / (1 - w0int * f)
-    g   = (gint - f) / (1 - f)
-
-    ! delta-Eddington (Joseph et al. 1976)
-    gamma1 =  (7 - w0* (4 + 3 * g)) / 4.0
-    gamma2 = -(1 - w0* (4 - 3 * g)) / 4.0
-    gamma3 =  (2 - 3*g*xmu) / 4.0
-    gamma4 =   1 - gamma3
-
-    if (w0int > minConservativeW0) then
-      ! Conservative scattering
-      if (beam == 1) then
-          rh = (gamma1*tau+(gamma3-gamma1*xmu)*(1-exp(-tau/xmu)))
-          ref = rh / (1 + gamma1 * tau)
-          tra = 1 - ref       
-      else if(beam == 2) then
-          ref = gamma1*tau/(1 + gamma1*tau)
-          tra = 1 - ref
-      endif
-    else
-      ! Non-conservative scattering
-      a1 = gamma1 * gamma4 + gamma2 * gamma3
-      a2 = gamma1 * gamma3 + gamma2 * gamma4
-
-      rk = sqrt(gamma1**2 - gamma2**2)
-      
-      r1 = (1 - rk * xmu) * (a2 + rk * gamma3)
-      r2 = (1 + rk * xmu) * (a2 - rk * gamma3)
-      r3 = 2 * rk *(gamma3 - a2 * xmu)
-      r4 = (1 - (rk * xmu)**2) * (rk + gamma1)
-      r5 = (1 - (rk * xmu)**2) * (rk - gamma1)
-      
-      t1 = (1 + rk * xmu) * (a1 + rk * gamma4)
-      t2 = (1 - rk * xmu) * (a1 - rk * gamma4)
-      t3 = 2 * rk * (gamma4 + a1 * xmu)
-      t4 = r4
-      t5 = r5
-
-      beta = -r5 / r4         
-      
-      e1 = min(rk * tau, 500.) 
-      e2 = min(tau / xmu, 500.) 
-      
-      if (beam == 1) then
-         den = r4 * exp(e1) + r5 * exp(-e1)
-         ref  = w0*(r1*exp(e1)-r2*exp(-e1)-r3*exp(-e2))/den
-         den = t4 * exp(e1) + t5 * exp(-e1)
-         th  = exp(-e2)
-         tra = th-th*w0*(t1*exp(e1)-t2*exp(-e1)-t3*exp(e2))/den
-      elseif (beam == 2) then
-         ef1 = exp(-e1)
-         ef2 = exp(-2*e1)
-         ref = (gamma2*(1-ef2))/((rk+gamma1)*(1-beta*ef2))
-         tra = (2*rk*ef1)/((rk+gamma1)*(1-beta*ef2))
-      endif
-    end if
-  end subroutine two_stream
-  ! --------------------------------------------------
-  elemental function two_stream_reflectance(tauint, gint, w0int) 
-    real, intent(in) :: tauint, gint, w0int
-    real             :: two_stream_reflectance
-    !
-    ! Compute reflectance in a single layer using the two stream approximation 
-    !   The code itself is from Lazaros Oreopoulos via Steve Platnick 
-    !
-    ! ------------------------
-    ! Local variables 
-    !   for delta Eddington code
-    !   xmu, gamma3, and gamma4 only used for collimated beam approximation (i.e., beam=1)
-    integer, parameter :: beam = 2
-    real,    parameter :: xmu = 0.866, minConservativeW0 = 0.9999999
-    real :: tau, w0, g, f, gamma1, gamma2, gamma3, gamma4, &
-            rh, a1, a2, rk, r1, r2, r3, r4, r5, t1, t2, t3, t4, t5, beta, e1, e2, ef1, ef2, den
-    ! ------------------------
-
-
-    f   = gint**2
-    tau = (1 - w0int * f) * tauint
-    w0  = (1 - f) * w0int / (1 - w0int * f)
-    g   = (gint - f) / (1 - f)
-
-    ! delta-Eddington (Joseph et al. 1976)
-    gamma1 =  (7 - w0* (4 + 3 * g)) / 4.0
-    gamma2 = -(1 - w0* (4 - 3 * g)) / 4.0
-    gamma3 =  (2 - 3*g*xmu) / 4.0
-    gamma4 =   1 - gamma3
-
-    if (w0int > minConservativeW0) then
-      ! Conservative scattering
-      if (beam == 1) then
-          rh = (gamma1*tau+(gamma3-gamma1*xmu)*(1-exp(-tau/xmu)))
-          two_stream_reflectance = rh / (1 + gamma1 * tau)
-      elseif (beam == 2) then
-          two_stream_reflectance = gamma1*tau/(1 + gamma1*tau)
-      endif
-        
-    else    !
-
-        ! Non-conservative scattering
-         a1 = gamma1 * gamma4 + gamma2 * gamma3
-         a2 = gamma1 * gamma3 + gamma2 * gamma4
-
-         rk = sqrt(gamma1**2 - gamma2**2)
-         
-         r1 = (1 - rk * xmu) * (a2 + rk * gamma3)
-         r2 = (1 + rk * xmu) * (a2 - rk * gamma3)
-         r3 = 2 * rk *(gamma3 - a2 * xmu)
-         r4 = (1 - (rk * xmu)**2) * (rk + gamma1)
-         r5 = (1 - (rk * xmu)**2) * (rk - gamma1)
-         
-         t1 = (1 + rk * xmu) * (a1 + rk * gamma4)
-         t2 = (1 - rk * xmu) * (a1 - rk * gamma4)
-         t3 = 2 * rk * (gamma4 + a1 * xmu)
-         t4 = r4
-         t5 = r5
-
-         beta = -r5 / r4         
-         
-         e1 = min(rk * tau, 500.) 
-         e2 = min(tau / xmu, 500.) 
-         
-         if (beam == 1) then
-           den = r4 * exp(e1) + r5 * exp(-e1)
-           two_stream_reflectance  = w0*(r1*exp(e1)-r2*exp(-e1)-r3*exp(-e2))/den
-         elseif (beam == 2) then
-           ef1 = exp(-e1)
-           ef2 = exp(-2*e1)
-           two_stream_reflectance = (gamma2*(1-ef2))/((rk+gamma1)*(1-beta*ef2))
-         endif
-           
-      end if
-  end function two_stream_reflectance 
-  ! --------------------------------------------
-    pure subroutine adding_doubling (Refl, Tran, Refl_tot, Tran_tot)      
-      real,    dimension(:), intent(in)  :: Refl,     Tran
-      real,                  intent(out) :: Refl_tot, Tran_tot
-      !
-      ! Use adding/doubling formulas to compute total reflectance and transmittance from layer values
-      !
-      
-      integer :: i
-      real, dimension(size(Refl)) :: Refl_cumulative, Tran_cumulative
-      
-      Refl_cumulative(1) = Refl(1); Tran_cumulative(1) = Tran(1)    
-      
-      do i=2, size(Refl)
-          ! place (add) previous combined layer(s) reflectance on top of layer i, w/black surface (or ignoring surface):
-          Refl_cumulative(i) = Refl_cumulative(i-1) + Refl(i)*(Tran_cumulative(i-1)**2)/(1 - Refl_cumulative(i-1) * Refl(i))
-          Tran_cumulative(i) = (Tran_cumulative(i-1)*Tran(i)) / (1 - Refl_cumulative(i-1) * Refl(i))
-      end do
-      
-      Refl_tot = Refl_cumulative(size(Refl))
-      Tran_tot = Tran_cumulative(size(Refl))
-
-    end subroutine adding_doubling
-  ! --------------------------------------------------
-  subroutine complain_and_die(message) 
-    character(len = *), intent(in) :: message
-    
-    write(6, *) "Failure in MODIS simulator" 
-    write(6, *)  trim(message) 
-    stop
-  end subroutine complain_and_die
-  !------------------------------------------------------------------------------------------------
-end module mod_modis_sim
Index: LMDZ6/trunk/libf/phylmd/cosp/mrgrnk.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/cosp/mrgrnk.F90	(revision 3232)
+++ 	(revision )
@@ -1,410 +1,0 @@
-Module m_mrgrnk
-Integer, Parameter :: kdp = selected_real_kind(15)
-public :: mrgrnk
-private :: kdp
-private :: I_mrgrnk, D_mrgrnk
-interface mrgrnk
-  module procedure D_mrgrnk, I_mrgrnk
-end interface mrgrnk
-contains
-
-Subroutine D_mrgrnk (XDONT, IRNGT)
-! __________________________________________________________
-!   MRGRNK = Merge-sort ranking of an array
-!   For performance reasons, the first 2 passes are taken
-!   out of the standard loop, and use dedicated coding.
-! __________________________________________________________
-! __________________________________________________________
-      Real (kind=kdp), Dimension (:), Intent (In) :: XDONT
-      Integer, Dimension (:), Intent (Out) :: IRNGT
-! __________________________________________________________
-      Real (kind=kdp) :: XVALA, XVALB
-!
-      Integer, Dimension (SIZE(IRNGT)) :: JWRKT
-      Integer :: LMTNA, LMTNC, IRNG1, IRNG2
-      Integer :: NVAL, IIND, IWRKD, IWRK, IWRKF, JINDA, IINDA, IINDB
-!
-      NVAL = Min (SIZE(XDONT), SIZE(IRNGT))
-      Select Case (NVAL)
-      Case (:0)
-         Return
-      Case (1)
-         IRNGT (1) = 1
-         Return
-      Case Default
-         Continue
-      End Select
-!
-!  Fill-in the index array, creating ordered couples
-!
-      Do IIND = 2, NVAL, 2
-         If (XDONT(IIND-1) <= XDONT(IIND)) Then
-            IRNGT (IIND-1) = IIND - 1
-            IRNGT (IIND) = IIND
-         Else
-            IRNGT (IIND-1) = IIND
-            IRNGT (IIND) = IIND - 1
-         End If
-      End Do
-      If (Modulo(NVAL, 2) /= 0) Then
-         IRNGT (NVAL) = NVAL
-      End If
-!
-!  We will now have ordered subsets A - B - A - B - ...
-!  and merge A and B couples into     C   -   C   - ...
-!
-      LMTNA = 2
-      LMTNC = 4
-!
-!  First iteration. The length of the ordered subsets goes from 2 to 4
-!
-      Do
-         If (NVAL <= 2) Exit
-!
-!   Loop on merges of A and B into C
-!
-         Do IWRKD = 0, NVAL - 1, 4
-            If ((IWRKD+4) > NVAL) Then
-               If ((IWRKD+2) >= NVAL) Exit
-!
-!   1 2 3
-!
-               If (XDONT(IRNGT(IWRKD+2)) <= XDONT(IRNGT(IWRKD+3))) Exit
-!
-!   1 3 2
-!
-               If (XDONT(IRNGT(IWRKD+1)) <= XDONT(IRNGT(IWRKD+3))) Then
-                  IRNG2 = IRNGT (IWRKD+2)
-                  IRNGT (IWRKD+2) = IRNGT (IWRKD+3)
-                  IRNGT (IWRKD+3) = IRNG2
-!
-!   3 1 2
-!
-               Else
-                  IRNG1 = IRNGT (IWRKD+1)
-                  IRNGT (IWRKD+1) = IRNGT (IWRKD+3)
-                  IRNGT (IWRKD+3) = IRNGT (IWRKD+2)
-                  IRNGT (IWRKD+2) = IRNG1
-               End If
-               Exit
-            End If
-!
-!   1 2 3 4
-!
-            If (XDONT(IRNGT(IWRKD+2)) <= XDONT(IRNGT(IWRKD+3))) Cycle
-!
-!   1 3 x x
-!
-            If (XDONT(IRNGT(IWRKD+1)) <= XDONT(IRNGT(IWRKD+3))) Then
-               IRNG2 = IRNGT (IWRKD+2)
-               IRNGT (IWRKD+2) = IRNGT (IWRKD+3)
-               If (XDONT(IRNG2) <= XDONT(IRNGT(IWRKD+4))) Then
-!   1 3 2 4
-                  IRNGT (IWRKD+3) = IRNG2
-               Else
-!   1 3 4 2
-                  IRNGT (IWRKD+3) = IRNGT (IWRKD+4)
-                  IRNGT (IWRKD+4) = IRNG2
-               End If
-!
-!   3 x x x
-!
-            Else
-               IRNG1 = IRNGT (IWRKD+1)
-               IRNG2 = IRNGT (IWRKD+2)
-               IRNGT (IWRKD+1) = IRNGT (IWRKD+3)
-               If (XDONT(IRNG1) <= XDONT(IRNGT(IWRKD+4))) Then
-                  IRNGT (IWRKD+2) = IRNG1
-                  If (XDONT(IRNG2) <= XDONT(IRNGT(IWRKD+4))) Then
-!   3 1 2 4
-                     IRNGT (IWRKD+3) = IRNG2
-                  Else
-!   3 1 4 2
-                     IRNGT (IWRKD+3) = IRNGT (IWRKD+4)
-                     IRNGT (IWRKD+4) = IRNG2
-                  End If
-               Else
-!   3 4 1 2
-                  IRNGT (IWRKD+2) = IRNGT (IWRKD+4)
-                  IRNGT (IWRKD+3) = IRNG1
-                  IRNGT (IWRKD+4) = IRNG2
-               End If
-            End If
-         End Do
-!
-!  The Cs become As and Bs
-!
-         LMTNA = 4
-         Exit
-      End Do
-!
-!  Iteration loop. Each time, the length of the ordered subsets
-!  is doubled.
-!
-      Do
-         If (LMTNA >= NVAL) Exit
-         IWRKF = 0
-         LMTNC = 2 * LMTNC
-!
-!   Loop on merges of A and B into C
-!
-         Do
-            IWRK = IWRKF
-            IWRKD = IWRKF + 1
-            JINDA = IWRKF + LMTNA
-            IWRKF = IWRKF + LMTNC
-            If (IWRKF >= NVAL) Then
-               If (JINDA >= NVAL) Exit
-               IWRKF = NVAL
-            End If
-            IINDA = 1
-            IINDB = JINDA + 1
-!
-!   Shortcut for the case when the max of A is smaller
-!   than the min of B. This line may be activated when the
-!   initial set is already close to sorted.
-!
-!          IF (XDONT(IRNGT(JINDA)) <= XDONT(IRNGT(IINDB))) CYCLE
-!
-!  One steps in the C subset, that we build in the final rank array
-!
-!  Make a copy of the rank array for the merge iteration
-!
-            JWRKT (1:LMTNA) = IRNGT (IWRKD:JINDA)
-!
-            XVALA = XDONT (JWRKT(IINDA))
-            XVALB = XDONT (IRNGT(IINDB))
-!
-            Do
-               IWRK = IWRK + 1
-!
-!  We still have unprocessed values in both A and B
-!
-               If (XVALA > XVALB) Then
-                  IRNGT (IWRK) = IRNGT (IINDB)
-                  IINDB = IINDB + 1
-                  If (IINDB > IWRKF) Then
-!  Only A still with unprocessed values
-                     IRNGT (IWRK+1:IWRKF) = JWRKT (IINDA:LMTNA)
-                     Exit
-                  End If
-                  XVALB = XDONT (IRNGT(IINDB))
-               Else
-                  IRNGT (IWRK) = JWRKT (IINDA)
-                  IINDA = IINDA + 1
-                  If (IINDA > LMTNA) Exit! Only B still with unprocessed values
-                  XVALA = XDONT (JWRKT(IINDA))
-               End If
-!
-            End Do
-         End Do
-!
-!  The Cs become As and Bs
-!
-         LMTNA = 2 * LMTNA
-      End Do
-!
-      Return
-!
-End Subroutine D_mrgrnk
-
-Subroutine I_mrgrnk (XDONT, IRNGT)
-! __________________________________________________________
-!   MRGRNK = Merge-sort ranking of an array
-!   For performance reasons, the first 2 passes are taken
-!   out of the standard loop, and use dedicated coding.
-! __________________________________________________________
-! __________________________________________________________
-      Integer, Dimension (:), Intent (In)  :: XDONT
-      Integer, Dimension (:), Intent (Out) :: IRNGT
-! __________________________________________________________
-      Integer :: XVALA, XVALB
-!
-      Integer, Dimension (SIZE(IRNGT)) :: JWRKT
-      Integer :: LMTNA, LMTNC, IRNG1, IRNG2
-      Integer :: NVAL, IIND, IWRKD, IWRK, IWRKF, JINDA, IINDA, IINDB
-!
-      NVAL = Min (SIZE(XDONT), SIZE(IRNGT))
-      Select Case (NVAL)
-      Case (:0)
-         Return
-      Case (1)
-         IRNGT (1) = 1
-         Return
-      Case Default
-         Continue
-      End Select
-!
-!  Fill-in the index array, creating ordered couples
-!
-      Do IIND = 2, NVAL, 2
-         If (XDONT(IIND-1) <= XDONT(IIND)) Then
-            IRNGT (IIND-1) = IIND - 1
-            IRNGT (IIND) = IIND
-         Else
-            IRNGT (IIND-1) = IIND
-            IRNGT (IIND) = IIND - 1
-         End If
-      End Do
-      If (Modulo(NVAL, 2) /= 0) Then
-         IRNGT (NVAL) = NVAL
-      End If
-!
-!  We will now have ordered subsets A - B - A - B - ...
-!  and merge A and B couples into     C   -   C   - ...
-!
-      LMTNA = 2
-      LMTNC = 4
-!
-!  First iteration. The length of the ordered subsets goes from 2 to 4
-!
-      Do
-         If (NVAL <= 2) Exit
-!
-!   Loop on merges of A and B into C
-!
-         Do IWRKD = 0, NVAL - 1, 4
-            If ((IWRKD+4) > NVAL) Then
-               If ((IWRKD+2) >= NVAL) Exit
-!
-!   1 2 3
-!
-               If (XDONT(IRNGT(IWRKD+2)) <= XDONT(IRNGT(IWRKD+3))) Exit
-!
-!   1 3 2
-!
-               If (XDONT(IRNGT(IWRKD+1)) <= XDONT(IRNGT(IWRKD+3))) Then
-                  IRNG2 = IRNGT (IWRKD+2)
-                  IRNGT (IWRKD+2) = IRNGT (IWRKD+3)
-                  IRNGT (IWRKD+3) = IRNG2
-!
-!   3 1 2
-!
-               Else
-                  IRNG1 = IRNGT (IWRKD+1)
-                  IRNGT (IWRKD+1) = IRNGT (IWRKD+3)
-                  IRNGT (IWRKD+3) = IRNGT (IWRKD+2)
-                  IRNGT (IWRKD+2) = IRNG1
-               End If
-               Exit
-            End If
-!
-!   1 2 3 4
-!
-            If (XDONT(IRNGT(IWRKD+2)) <= XDONT(IRNGT(IWRKD+3))) Cycle
-!
-!   1 3 x x
-!
-            If (XDONT(IRNGT(IWRKD+1)) <= XDONT(IRNGT(IWRKD+3))) Then
-               IRNG2 = IRNGT (IWRKD+2)
-               IRNGT (IWRKD+2) = IRNGT (IWRKD+3)
-               If (XDONT(IRNG2) <= XDONT(IRNGT(IWRKD+4))) Then
-!   1 3 2 4
-                  IRNGT (IWRKD+3) = IRNG2
-               Else
-!   1 3 4 2
-                  IRNGT (IWRKD+3) = IRNGT (IWRKD+4)
-                  IRNGT (IWRKD+4) = IRNG2
-               End If
-!
-!   3 x x x
-!
-            Else
-               IRNG1 = IRNGT (IWRKD+1)
-               IRNG2 = IRNGT (IWRKD+2)
-               IRNGT (IWRKD+1) = IRNGT (IWRKD+3)
-               If (XDONT(IRNG1) <= XDONT(IRNGT(IWRKD+4))) Then
-                  IRNGT (IWRKD+2) = IRNG1
-                  If (XDONT(IRNG2) <= XDONT(IRNGT(IWRKD+4))) Then
-!   3 1 2 4
-                     IRNGT (IWRKD+3) = IRNG2
-                  Else
-!   3 1 4 2
-                     IRNGT (IWRKD+3) = IRNGT (IWRKD+4)
-                     IRNGT (IWRKD+4) = IRNG2
-                  End If
-               Else
-!   3 4 1 2
-                  IRNGT (IWRKD+2) = IRNGT (IWRKD+4)
-                  IRNGT (IWRKD+3) = IRNG1
-                  IRNGT (IWRKD+4) = IRNG2
-               End If
-            End If
-         End Do
-!
-!  The Cs become As and Bs
-!
-         LMTNA = 4
-         Exit
-      End Do
-!
-!  Iteration loop. Each time, the length of the ordered subsets
-!  is doubled.
-!
-      Do
-         If (LMTNA >= NVAL) Exit
-         IWRKF = 0
-         LMTNC = 2 * LMTNC
-!
-!   Loop on merges of A and B into C
-!
-         Do
-            IWRK = IWRKF
-            IWRKD = IWRKF + 1
-            JINDA = IWRKF + LMTNA
-            IWRKF = IWRKF + LMTNC
-            If (IWRKF >= NVAL) Then
-               If (JINDA >= NVAL) Exit
-               IWRKF = NVAL
-            End If
-            IINDA = 1
-            IINDB = JINDA + 1
-!
-!   Shortcut for the case when the max of A is smaller
-!   than the min of B. This line may be activated when the
-!   initial set is already close to sorted.
-!
-!          IF (XDONT(IRNGT(JINDA)) <= XDONT(IRNGT(IINDB))) CYCLE
-!
-!  One steps in the C subset, that we build in the final rank array
-!
-!  Make a copy of the rank array for the merge iteration
-!
-            JWRKT (1:LMTNA) = IRNGT (IWRKD:JINDA)
-!
-            XVALA = XDONT (JWRKT(IINDA))
-            XVALB = XDONT (IRNGT(IINDB))
-!
-            Do
-               IWRK = IWRK + 1
-!
-!  We still have unprocessed values in both A and B
-!
-               If (XVALA > XVALB) Then
-                  IRNGT (IWRK) = IRNGT (IINDB)
-                  IINDB = IINDB + 1
-                  If (IINDB > IWRKF) Then
-!  Only A still with unprocessed values
-                     IRNGT (IWRK+1:IWRKF) = JWRKT (IINDA:LMTNA)
-                     Exit
-                  End If
-                  XVALB = XDONT (IRNGT(IINDB))
-               Else
-                  IRNGT (IWRK) = JWRKT (IINDA)
-                  IINDA = IINDA + 1
-                  If (IINDA > LMTNA) Exit! Only B still with unprocessed values
-                  XVALA = XDONT (JWRKT(IINDA))
-               End If
-!
-            End Do
-         End Do
-!
-!  The Cs become As and Bs
-!
-         LMTNA = 2 * LMTNA
-      End Do
-!
-      Return
-!
-End Subroutine I_mrgrnk
-end module m_mrgrnk
Index: LMDZ6/trunk/libf/phylmd/cosp/phys_cosp.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/cosp/phys_cosp.F90	(revision 3232)
+++ LMDZ6/trunk/libf/phylmd/cosp/phys_cosp.F90	(revision 3233)
@@ -142,4 +142,6 @@
 !$OMP THREADPRIVATE(first_write)
 
+  logical, save :: ok_readxiosactive_cosp=.false.
+!$OMP THREADPRIVATE(ok_readxiosactive_cosp)
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Input variables from LMDZ-GCM
   integer                         :: overlaplmdz   !  overlap type: 1=max, 2=rand, 3=max/rand ! cosp input (output lmdz)
@@ -153,4 +155,7 @@
   real                            :: dtime,freq_cosp
   real,dimension(2)               :: time_bnds
+
+  double precision                            :: d_dtime
+  double precision,dimension(2)               :: d_time_bnds
   
    namelist/COSP_INPUT/overlap,isccp_topheight,isccp_topheight_direction, &
@@ -192,13 +197,10 @@
 !!! Ici on modifie les cles logiques selon les champs actives dans les .xml
 #ifdef CPP_XIOS
+ if (ok_readxiosactive_cosp) then
   if ((itap.gt.1).and.(first_write))then
-!    call read_xiosfieldactive(cfg)
      call read_cosp_output_nl(itap,cosp_output_nl,cfg)
-!       print*,' Dans cosp_write itap first_writ LcfadLidarsr532 =', &
-!                     itap, first_write, cfg%LcfadLidarsr532
      first_write=.false.
   endif
-!  print*,' Dans cosp_write itap LcfadLidarsr532 =', &
-!                     itap, cfg%LcfadLidarsr532
+ endif
 #endif
 
@@ -206,4 +208,8 @@
   time_bnds(1) = dtime-dtime/2.
   time_bnds(2) = dtime+dtime/2.
+
+  d_time_bnds=time_bnds
+  d_dtime=dtime
+
 
 !  print*,'Debut phys_cosp itap,dtime,freq_cosp,ecrit_mth,ecrit_day,ecrit_hf ', &
@@ -225,5 +231,5 @@
         emsfc_lw = 1.
 
-        call construct_cosp_gridbox(dtime,time_bnds,radar_freq,surface_radar,use_mie_tables,use_gas_abs, &
+        call construct_cosp_gridbox(d_dtime,d_time_bnds,radar_freq,surface_radar,use_mie_tables,use_gas_abs, &
                                     do_ray,melt_lay,k2, &
                                     Npoints,Nlevels,Ncolumns,N_HYDRO,Nprmts_max_hydro,Naero,Nprmts_max_aero,Npoints_it, &
@@ -441,187 +447,3 @@
   END SUBROUTINE read_cosp_input 
 
-  SUBROUTINE read_xiosfieldactive(cfg)
-
-    USE MOD_COSP_TYPES
-#ifdef CPP_XIOS
-    USE xios, ONLY: xios_field_is_active
-#endif
-  type(cosp_config),intent(out) :: cfg
-
-! VEREFIER LES CHAMPS DEMANDES DANS .XML
-! 2. Si champs active dans .xml alors mettre la cles de sortie en true
- IF (xios_field_is_active("cllcalipso")) cfg%Lcllcalipso=.TRUE.
- IF (xios_field_is_active("clmcalipso")) cfg%Lclmcalipso=.TRUE.
- IF (xios_field_is_active("clhcalipso")) cfg%Lclhcalipso=.TRUE.
- IF (xios_field_is_active("cltcalipso")) cfg%Lcltcalipso=.TRUE.
-! IF (xios_field_is_active("pcllcalipso")) cfg%Lcllcalipso=.TRUE.
-! IF (xios_field_is_active("pclmcalipso")) cfg%Lclmcalipso=.TRUE.
-! IF (xios_field_is_active("pclhcalipso")) cfg%Lclhcalipso=.TRUE.
-! IF (xios_field_is_active("pcltcalipso")) cfg%Lcltcalipso=.TRUE.
- IF (xios_field_is_active("cllcalipsoice")) cfg%Lcllcalipsoice=.TRUE.
- IF (xios_field_is_active("clmcalipsoice")) cfg%Lclmcalipsoice=.TRUE.
- IF (xios_field_is_active("clhcalipsoice")) cfg%Lclhcalipsoice=.TRUE.
- IF (xios_field_is_active("cltcalipsoice")) cfg%Lcltcalipsoice=.TRUE.
- IF (xios_field_is_active("cllcalipsoliq")) cfg%Lcllcalipsoliq=.TRUE.
- IF (xios_field_is_active("clmcalipsoliq")) cfg%Lclmcalipsoliq=.TRUE.
- IF (xios_field_is_active("clhcalipsoliq")) cfg%Lclhcalipsoliq=.TRUE.
- IF (xios_field_is_active("cltcalipsoliq")) cfg%Lcltcalipsoliq=.TRUE.
- IF (xios_field_is_active("cllcalipsoun")) cfg%Lcllcalipsoun=.TRUE.
- IF (xios_field_is_active("clmcalipsoun")) cfg%Lclmcalipsoun=.TRUE.
- IF (xios_field_is_active("clhcalipsoun")) cfg%Lclhcalipsoun=.TRUE.
- IF (xios_field_is_active("cltcalipsoun")) cfg%Lcltcalipsoun=.TRUE.
- IF (xios_field_is_active("clcalipso")) cfg%Lclcalipso=.TRUE.
-! IF (xios_field_is_active("pclcalipso")) cfg%Lclcalipso=.TRUE.
- IF (xios_field_is_active("clcalipsoice")) cfg%Lclcalipsoice=.TRUE.
- IF (xios_field_is_active("clcalipsoliq")) cfg%Lclcalipsoliq=.TRUE.
- IF (xios_field_is_active("clcalipsoun")) cfg%Lclcalipsoun=.TRUE.
- IF (xios_field_is_active("clcalipsotmp")) cfg%Lclcalipsotmp=.TRUE.
- IF (xios_field_is_active("clcalipsotmpice")) cfg%Lclcalipsotmpice=.TRUE.
- IF (xios_field_is_active("clcalipsotmpliq")) cfg%Lclcalipsotmpliq=.TRUE.
- IF (xios_field_is_active("clcalipsotmpun")) cfg%Lclcalipsotmpun=.TRUE.
- IF (xios_field_is_active("parasol_refl")) cfg%LparasolRefl=.TRUE.
- IF (xios_field_is_active("parasol_crefl")) cfg%LparasolRefl=.TRUE.
- IF (xios_field_is_active("Ncrefl")) cfg%LparasolRefl=.TRUE.
- IF (xios_field_is_active("cfad_lidarsr532")) cfg%LcfadLidarsr532=.TRUE.
- IF (xios_field_is_active("atb532")) cfg%Latb532=.TRUE.
- IF (xios_field_is_active("beta_mol532")) cfg%LlidarBetaMol532=.TRUE.
- IF (xios_field_is_active("clopaquecalipso")) cfg%Lclopaquecalipso=.TRUE.
- IF (xios_field_is_active("clthincalipso")) cfg%Lclthincalipso=.TRUE.
- IF (xios_field_is_active("clzopaquecalipso")) cfg%Lclzopaquecalipso=.TRUE.
- IF (xios_field_is_active("clcalipsoopaque")) cfg%Lclcalipsoopaque=.TRUE.
- IF (xios_field_is_active("clcalipsothin")) cfg%Lclcalipsothin=.TRUE.
- IF (xios_field_is_active("clcalipsozopaque")) cfg%Lclcalipsozopaque=.TRUE.
- IF (xios_field_is_active("clcalipsoopacity")) cfg%Lclcalipsoopacity=.TRUE.
- IF (xios_field_is_active("proftemp")) cfg%Lproftemp=.TRUE.
- IF (xios_field_is_active("profSR")) cfg%LprofSR=.TRUE.
-
- IF (xios_field_is_active("cfadDbze94")) cfg%LcfadDbze94=.TRUE.
- IF (xios_field_is_active("dbze94")) cfg%Ldbze94=.TRUE.
- IF (xios_field_is_active("cltlidarradar")) cfg%Lcltlidarradar=.TRUE.
- IF (xios_field_is_active("clcalipso2")) cfg%Lclcalipso2=.TRUE.
-
-   IF (xios_field_is_active("clisccp2")) cfg%Lclisccp=.TRUE.
- IF (xios_field_is_active("boxtauisccp")) cfg%Lboxtauisccp=.TRUE.
- IF (xios_field_is_active("boxptopisccp")) cfg%Lboxptopisccp=.TRUE.
- IF (xios_field_is_active("tclisccp")) cfg%Lcltisccp=.TRUE.
- IF (xios_field_is_active("ctpisccp")) cfg%Lpctisccp=.TRUE.
- IF (xios_field_is_active("tauisccp")) cfg%Ltauisccp=.TRUE.
- IF (xios_field_is_active("albisccp")) cfg%Lalbisccp=.TRUE.
- IF (xios_field_is_active("meantbisccp")) cfg%Lmeantbisccp=.TRUE.
- IF (xios_field_is_active("meantbclrisccp")) cfg%Lmeantbclrisccp=.TRUE.
-
-   IF (xios_field_is_active("clMISR")) cfg%LclMISR=.TRUE.
-
-IF (xios_field_is_active("cllmodis")) cfg%Lcllmodis=.TRUE.
- IF (xios_field_is_active("clmmodis")) cfg%Lclmmodis=.TRUE.
- IF (xios_field_is_active("clhmodis")) cfg%Lclhmodis=.TRUE.
- IF (xios_field_is_active("cltmodis")) cfg%Lcltmodis=.TRUE.
- IF (xios_field_is_active("clwmodis")) cfg%Lclwmodis=.TRUE.
- IF (xios_field_is_active("climodis")) cfg%Lclimodis=.TRUE.
- IF (xios_field_is_active("tautmodis")) cfg%Ltautmodis=.TRUE.
- IF (xios_field_is_active("tauwmodis")) cfg%Ltauwmodis=.TRUE.
- IF (xios_field_is_active("tauimodis")) cfg%Ltauimodis=.TRUE.
- IF (xios_field_is_active("tautlogmodis")) cfg%Ltautlogmodis=.TRUE.
- IF (xios_field_is_active("tauilogmodis")) cfg%Ltauilogmodis=.TRUE.
- IF (xios_field_is_active("tauwlogmodis")) cfg%Ltauwlogmodis=.TRUE.
- IF (xios_field_is_active("reffclwmodis")) cfg%Lreffclwmodis=.TRUE.
- IF (xios_field_is_active("reffclimodis")) cfg%Lreffclimodis=.TRUE.
- IF (xios_field_is_active("pctmodis")) cfg%Lpctmodis=.TRUE.
- IF (xios_field_is_active("lwpmodis")) cfg%Llwpmodis=.TRUE.
- IF (xios_field_is_active("iwpmodis")) cfg%Liwpmodis=.TRUE.
- IF (xios_field_is_active("clmodis")) cfg%Lclmodis=.TRUE.
- IF (xios_field_is_active("crimodis")) cfg%Lcrimodis=.TRUE.
- IF (xios_field_is_active("crlmodis")) cfg%Lcrlmodis=.TRUE.
-
-! 2.  si champs demande alors activer le simulateur correspondant
-   IF (xios_field_is_active("cllcalipso").OR. &
-       xios_field_is_active("clmcalipso").OR. &
-       xios_field_is_active("clhcalipso").OR. &
-       xios_field_is_active("cltcalipso").OR. &
-!       xios_field_is_active("pcllcalipso").OR. &
-!       xios_field_is_active("pclmcalipso").OR. &
-!       xios_field_is_active("pclhcalipso").OR. &
-!       xios_field_is_active("pcltcalipso").OR. &
-       xios_field_is_active("cllcalipsoice").OR. &
-       xios_field_is_active("clmcalipsoice").OR. &
-       xios_field_is_active("clhcalipsoice").OR. &
-       xios_field_is_active("cltcalipsoice").OR. &
-       xios_field_is_active("cllcalipsoliq").OR. &
-       xios_field_is_active("clmcalipsoliq").OR. &
-       xios_field_is_active("clhcalipsoliq").OR. &
-       xios_field_is_active("cltcalipsoliq").OR. &
-       xios_field_is_active("cllcalipsoun").OR. &
-       xios_field_is_active("clmcalipsoun").OR. &
-       xios_field_is_active("clhcalipsoun").OR. &
-       xios_field_is_active("cltcalipsoun").OR. &
-       xios_field_is_active("clcalipso").OR. &
-!       xios_field_is_active("pclcalipso").OR. &
-       xios_field_is_active("clcalipsoice").OR. &
-       xios_field_is_active("clcalipsoliq").OR. &
-       xios_field_is_active("clcalipsoun").OR. &
-       xios_field_is_active("clcalipsotmp").OR. &
-       xios_field_is_active("clcalipsotmpice").OR. &
-       xios_field_is_active("clcalipsotmpliq").OR. &
-       xios_field_is_active("clcalipsotmpun").OR. &
-       xios_field_is_active("parasol_refl").OR. &
-       xios_field_is_active("parasol_crefl").OR. &
-       xios_field_is_active("Ncrefl").OR. &
-       xios_field_is_active("cfad_lidarsr532").OR. &
-       xios_field_is_active("atb532").OR. &
-       xios_field_is_active("beta_mol532").OR. &
-       xios_field_is_active("clopaquecalipso").OR. &
-       xios_field_is_active("clthincalipso").OR. &
-       xios_field_is_active("clzopaquecalipso").OR. &
-       xios_field_is_active("clcalipsoopaque").OR. &
-       xios_field_is_active("clcalipsothin").OR. &
-       xios_field_is_active("clcalipsozopaque").OR. &
-       xios_field_is_active("clcalipsoopacity").OR. &
-       xios_field_is_active("proftemp").OR. &
-       xios_field_is_active("profSR")) cfg%Llidar_sim=.TRUE.
-
-    IF (xios_field_is_active("cfadDbze94").OR. &
-      xios_field_is_active("dbze94")) &
-               cfg%Lradar_sim=.TRUE.
-
-    IF (xios_field_is_active("cltlidarradar").OR. &
-      xios_field_is_active("clcalipso2")) THEN
-               cfg%Lradar_sim=.TRUE.
-               cfg%Llidar_sim=.TRUE.
-    ENDIF
-
-    IF (xios_field_is_active("clisccp2").OR. &
-       xios_field_is_active("boxtauisccp").OR. &
-       xios_field_is_active("boxptopisccp").OR. &
-       xios_field_is_active("tclisccp").OR. &
-       xios_field_is_active("ctpisccp").OR. &
-       xios_field_is_active("tauisccp").OR. &
-       xios_field_is_active("albisccp").OR. &
-       xios_field_is_active("meantbisccp").OR. &
-       xios_field_is_active("meantbclrisccp")) cfg%Lisccp_sim=.TRUE. 
-
-    IF (xios_field_is_active("clMISR")) cfg%Lmisr_sim=.TRUE.
-
-    IF (xios_field_is_active("cllmodis").OR. &
-       xios_field_is_active("clmmodis").OR. &
-       xios_field_is_active("clhmodis").OR. &
-       xios_field_is_active("cltmodis").OR. &
-       xios_field_is_active("clwmodis").OR. &
-       xios_field_is_active("climodis").OR. &
-       xios_field_is_active("tautmodis").OR. &
-       xios_field_is_active("tauwmodis").OR. &
-       xios_field_is_active("tauimodis").OR. &
-       xios_field_is_active("tautlogmodis").OR. &
-       xios_field_is_active("tauilogmodis").OR. &
-       xios_field_is_active("tauwlogmodis").OR. &
-       xios_field_is_active("reffclwmodis").OR. &
-       xios_field_is_active("reffclimodis").OR. &
-       xios_field_is_active("pctmodis").OR. &
-       xios_field_is_active("lwpmodis").OR. &
-       xios_field_is_active("iwpmodis").OR. &
-       xios_field_is_active("clmodis").OR. &
-       xios_field_is_active("crimodis").OR. &
-       xios_field_is_active("crlmodis")) cfg%Lmodis_sim=.TRUE.
-  END SUBROUTINE read_xiosfieldactive 
-
-
 end subroutine phys_cosp
Index: LMDZ6/trunk/libf/phylmd/cosp/read_cosp_output_nl.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/cosp/read_cosp_output_nl.F90	(revision 3232)
+++ LMDZ6/trunk/libf/phylmd/cosp/read_cosp_output_nl.F90	(revision 3233)
@@ -127,5 +127,5 @@
   CALL bcast(Lmeantbisccp)
   CALL bcast(Lmeantbclrisccp)
-  CALL bcast(Lfrac_out)
+  CALL bcast(Lfracout)
   CALL bcast(LlidarBetaMol532)
   CALL bcast(Lcltmodis)
@@ -239,5 +239,5 @@
   if ((.not.Lradar_sim).and.(.not.Llidar_sim).and. &
       (.not.Lisccp_sim).and.(.not.Lmisr_sim)) then
-    Lfrac_out = .false.
+    Lfracout = .false.
   endif
  if (.not.Lmodis_sim) then
@@ -533,5 +533,6 @@
   cfg%Lcrlmodis=Lcrlmodis
   
-    if (itap.gt.1) then
+#ifdef CPP_XIOS
+ if (itap.gt.1) then
 
 ! VEREFIER LES CHAMPS DEMANDES DANS .XML
@@ -709,6 +710,6 @@
        xios_field_is_active("crlmodis")) cfg%Lmodis_sim=.TRUE.
 
-  endif
-
+ endif
+#endif
 
  END SUBROUTINE READ_COSP_OUTPUT_NL
Index: LMDZ6/trunk/libf/phylmd/cosp/scale_LUTs_io.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/cosp/scale_LUTs_io.F90	(revision 3232)
+++ 	(revision )
@@ -1,137 +1,0 @@
-  ! scale_LUT_io:  Contains subroutines to load and save scaling Look Up Tables (LUTs) to a file
-  ! 
-  ! June 2010   Written by Roj Marchand
-  
-  module scale_LUTs_io
-  implicit none
-
-  contains
-
-  subroutine load_scale_LUTs(hp)
-  
-    use radar_simulator_types
-
-    type(class_param), intent(inout) :: hp
-
-    logical :: LUT_file_exists
-    integer :: i,j,k,ind
-    
-    !
-    ! load scale LUT from file 
-    !
-    inquire(file=trim(hp%scale_LUT_file_name) // '_radar_Z_scale_LUT.dat', &
-        exist=LUT_file_exists)
-
-    if(.not.LUT_file_exists) then
-    
-        write(*,*) '*************************************************'
-        write(*,*) 'Warning: Could NOT FIND radar LUT file: ', &
-        trim(hp%scale_LUT_file_name) // '_radar_Z_scale_LUT.dat'        
-        write(*,*) 'Will calculated LUT values as needed'
-        write(*,*) '*************************************************'
-        
-        return
-    else
-
-        OPEN(unit=12,file=trim(hp%scale_LUT_file_name) // '_radar_Z_scale_LUT.dat',&
-        form='unformatted', &
-        err= 89, &
-            access='DIRECT',&
-            recl=28)
-         
-            write(*,*) 'Loading radar LUT file: ', &
-        trim(hp%scale_LUT_file_name) // '_radar_Z_scale_LUT.dat'
-    
-            do i=1,maxhclass
-            do j=1,mt_ntt
-            do k=1,nRe_types
-        
-            ind = i+(j-1)*maxhclass+(k-1)*(nRe_types*mt_ntt)
-            
-            read(12,rec=ind) hp%Z_scale_flag(i,j,k), &
-                    hp%Ze_scaled(i,j,k), &
-                    hp%Zr_scaled(i,j,k), &
-                    hp%kr_scaled(i,j,k)
-                                                    
-                ! if(ind==1482329) then
-                !   write (*,*) ind, hp%Z_scale_flag(i,j,k), &
-                !   hp%Ze_scaled(i,j,k), &
-                !   hp%Zr_scaled(i,j,k), &
-                !   hp%kr_scaled(i,j,k)
-                !endif
-     
-            enddo
-            enddo
-            enddo
-        
-            close(unit=12)
-        return 
-    endif
-    
-  89    write(*,*) 'Error: Found but could NOT READ radar LUT file: ', &
-        trim(hp%scale_LUT_file_name) // '_radar_Z_scale_LUT.dat'
-    stop
-    
-  end subroutine load_scale_LUTs
-  
-  subroutine save_scale_LUTs(hp)
-
-    use radar_simulator_types
-  
-    type(class_param), intent(inout) :: hp
-    
-    logical :: LUT_file_exists
-    integer :: i,j,k,ind
-    
-    inquire(file=trim(hp%scale_LUT_file_name) // '_radar_Z_scale_LUT.dat', &
-        exist=LUT_file_exists)
-
-    OPEN(unit=12,file=trim(hp%scale_LUT_file_name) // '_radar_Z_scale_LUT.dat',&
-        form='unformatted', &
-        err= 99, &
-            access='DIRECT',&
-            recl=28)
-         
-        write(*,*) 'Creating or Updating radar LUT file: ', &
-        trim(hp%scale_LUT_file_name) // '_radar_Z_scale_LUT.dat'
-    
-        do i=1,maxhclass
-        do j=1,mt_ntt
-        do k=1,nRe_types
-        
-            ind = i+(j-1)*maxhclass+(k-1)*(nRe_types*mt_ntt)
-            
-            if(.not.LUT_file_exists .or. hp%Z_scale_added_flag(i,j,k)) then
-            
-                hp%Z_scale_added_flag(i,j,k)=.false.
-            
-                write(12,rec=ind) hp%Z_scale_flag(i,j,k), &
-                    hp%Ze_scaled(i,j,k), &
-                    hp%Zr_scaled(i,j,k), &
-                    hp%kr_scaled(i,j,k)
-                     
-                !  1482329 T  0.170626345026495        0.00000000000000       1.827402935860823E-003
-            
-                !if(ind==1482329) then
-                !   write (*,*) ind, hp%Z_scale_flag(i,j,k), &
-                !   hp%Ze_scaled(i,j,k), &
-                !   hp%Zr_scaled(i,j,k), &
-                !   hp%kr_scaled(i,j,k)
-                !endif
-            endif
-        enddo
-        enddo
-        enddo
-        
-        close(unit=12)
-    return 
-    
-  99    write(*,*) 'Error: Unable to create/update radar LUT file: ', &
-        trim(hp%scale_LUT_file_name) // '_radar_Z_scale_LUT.dat'
-    return  
-    
-  end subroutine save_scale_LUTs
-
-
-  end module scale_LUTs_io
-  
Index: LMDZ6/trunk/libf/phylmd/cosp/scale_luts_io.F90
===================================================================
--- LMDZ6/trunk/libf/phylmd/cosp/scale_luts_io.F90	(revision 3233)
+++ LMDZ6/trunk/libf/phylmd/cosp/scale_luts_io.F90	(revision 3233)
@@ -0,0 +1,137 @@
+  ! scale_LUT_io:  Contains subroutines to load and save scaling Look Up Tables (LUTs) to a file
+  ! 
+  ! June 2010   Written by Roj Marchand
+  
+  module scale_LUTs_io
+  implicit none
+
+  contains
+
+  subroutine load_scale_LUTs(hp)
+  
+    use radar_simulator_types
+
+    type(class_param), intent(inout) :: hp
+
+    logical :: LUT_file_exists
+    integer :: i,j,k,ind
+    
+    !
+    ! load scale LUT from file 
+    !
+    inquire(file=trim(hp%scale_LUT_file_name) // '_radar_Z_scale_LUT.dat', &
+        exist=LUT_file_exists)
+
+    if(.not.LUT_file_exists) then
+    
+        write(*,*) '*************************************************'
+        write(*,*) 'Warning: Could NOT FIND radar LUT file: ', &
+        trim(hp%scale_LUT_file_name) // '_radar_Z_scale_LUT.dat'        
+        write(*,*) 'Will calculated LUT values as needed'
+        write(*,*) '*************************************************'
+        
+        return
+    else
+
+        OPEN(unit=12,file=trim(hp%scale_LUT_file_name) // '_radar_Z_scale_LUT.dat',&
+        form='unformatted', &
+        err= 89, &
+            access='DIRECT',&
+            recl=28)
+         
+            write(*,*) 'Loading radar LUT file: ', &
+        trim(hp%scale_LUT_file_name) // '_radar_Z_scale_LUT.dat'
+    
+            do i=1,maxhclass
+            do j=1,mt_ntt
+            do k=1,nRe_types
+        
+            ind = i+(j-1)*maxhclass+(k-1)*(nRe_types*mt_ntt)
+            
+            read(12,rec=ind) hp%Z_scale_flag(i,j,k), &
+                    hp%Ze_scaled(i,j,k), &
+                    hp%Zr_scaled(i,j,k), &
+                    hp%kr_scaled(i,j,k)
+                                                    
+                ! if(ind==1482329) then
+                !   write (*,*) ind, hp%Z_scale_flag(i,j,k), &
+                !   hp%Ze_scaled(i,j,k), &
+                !   hp%Zr_scaled(i,j,k), &
+                !   hp%kr_scaled(i,j,k)
+                !endif
+     
+            enddo
+            enddo
+            enddo
+        
+            close(unit=12)
+        return 
+    endif
+    
+  89    write(*,*) 'Error: Found but could NOT READ radar LUT file: ', &
+        trim(hp%scale_LUT_file_name) // '_radar_Z_scale_LUT.dat'
+    stop
+    
+  end subroutine load_scale_LUTs
+  
+  subroutine save_scale_LUTs(hp)
+
+    use radar_simulator_types
+  
+    type(class_param), intent(inout) :: hp
+    
+    logical :: LUT_file_exists
+    integer :: i,j,k,ind
+    
+    inquire(file=trim(hp%scale_LUT_file_name) // '_radar_Z_scale_LUT.dat', &
+        exist=LUT_file_exists)
+
+    OPEN(unit=12,file=trim(hp%scale_LUT_file_name) // '_radar_Z_scale_LUT.dat',&
+        form='unformatted', &
+        err= 99, &
+            access='DIRECT',&
+            recl=28)
+         
+        write(*,*) 'Creating or Updating radar LUT file: ', &
+        trim(hp%scale_LUT_file_name) // '_radar_Z_scale_LUT.dat'
+    
+        do i=1,maxhclass
+        do j=1,mt_ntt
+        do k=1,nRe_types
+        
+            ind = i+(j-1)*maxhclass+(k-1)*(nRe_types*mt_ntt)
+            
+            if(.not.LUT_file_exists .or. hp%Z_scale_added_flag(i,j,k)) then
+            
+                hp%Z_scale_added_flag(i,j,k)=.false.
+            
+                write(12,rec=ind) hp%Z_scale_flag(i,j,k), &
+                    hp%Ze_scaled(i,j,k), &
+                    hp%Zr_scaled(i,j,k), &
+                    hp%kr_scaled(i,j,k)
+                     
+                !  1482329 T  0.170626345026495        0.00000000000000       1.827402935860823E-003
+            
+                !if(ind==1482329) then
+                !   write (*,*) ind, hp%Z_scale_flag(i,j,k), &
+                !   hp%Ze_scaled(i,j,k), &
+                !   hp%Zr_scaled(i,j,k), &
+                !   hp%kr_scaled(i,j,k)
+                !endif
+            endif
+        enddo
+        enddo
+        enddo
+        
+        close(unit=12)
+    return 
+    
+  99    write(*,*) 'Error: Unable to create/update radar LUT file: ', &
+        trim(hp%scale_LUT_file_name) // '_radar_Z_scale_LUT.dat'
+    return  
+    
+  end subroutine save_scale_LUTs
+
+
+  end module scale_LUTs_io
+  
