source: LMDZ6/branches/Ocean_skin/libf/phylmd/cosp2/cosp_interface_v1p4.F90 @ 5453

Last change on this file since 5453 was 3358, checked in by idelkadi, 6 years ago

Implementation de la nouvelle version COSPv2 dans LMDZ.
Pour compiler avec makelmdz_fcma utiliser l'option "-cosp2 true"

File size: 131.9 KB
Line 
1! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2! Copyright (c) 2015, Regents of the University of Colorado
3! All rights reserved.
4!
5! Redistribution and use in source and binary forms, with or without modification, are
6! permitted provided that the following conditions are met:
7!
8! 1. Redistributions of source code must retain the above copyright notice, this list of
9!    conditions and the following disclaimer.
10!
11! 2. Redistributions in binary form must reproduce the above copyright notice, this list
12!    of conditions and the following disclaimer in the documentation and/or other
13!    materials provided with the distribution.
14!
15! 3. Neither the name of the copyright holder nor the names of its contributors may be
16!    used to endorse or promote products derived from this software without specific prior
17!    written permission.
18!
19! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY
20! EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
21! MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL
22! THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
23! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT
24! OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
25! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
26! LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
27! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
28!
29! History
30! May 2015 - D. Swales - Original version
31! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
32#include "cosp_defs.h"
33MODULE MOD_COSP_INTERFACE_v1p4
34  use COSP_KINDS,          only: wp,dp
35  use cosp_phys_constants, only: amw,amd,amO3,amCO2,amCH4,amN2O,amCO
36  use MOD_COSP,            only: cosp_init,cosp_outputs,cosp_optical_inputs,              &
37                                 cosp_column_inputs,cosp_simulator,linitialization
38  use mod_cosp_config,     only: RTTOV_MAX_CHANNELS,N_HYDRO,numMODISTauBins,modis_histTau,&
39                                 modis_histTauEdges,modis_histTauCenters,ntau,ntauV1p4,   &
40                                 tau_binBounds,tau_binEdges,tau_binCenters,R_UNDEF,       &
41                                 tau_binBoundsV1p4,tau_binEdgesV1p4,tau_binCentersV1p4,   &
42                                 numMISRHgtBins,SR_BINS,LIDAR_NCAT,LIDAR_NTEMP,DBZE_BINS, &
43                                 numMODISReffIceBins, numMODISPresBins,PARASOL_NREFL,     &
44                                 numMODISReffLiqBins,vgrid_zl,vgrid_zu,vgrid_z,           &
45                                 numISCCPTauBins,numISCCPPresBins,numMISRTauBins
46  use mod_quickbeam_optics,only: size_distribution,hydro_class_init,quickbeam_optics_init,&
47                                 quickbeam_optics
48  use cosp_optics,         only: cosp_simulator_optics,lidar_optics,modis_optics,         &
49                                 modis_optics_partition
50  use quickbeam,           only: maxhclass,nRe_types,nd,mt_ntt,radar_cfg
51  use mod_rng,             only: rng_state, init_rng
52  use mod_scops,           only: scops
53  use mod_prec_scops,      only: prec_scops
54  use mod_cosp_utils,      only: cosp_precip_mxratio
55
56  implicit none
57 
58  character(len=120),parameter :: &
59       RADAR_SIM_LUT_DIRECTORY = './'
60  logical,parameter :: &
61       RADAR_SIM_LOAD_scale_LUTs_flag   = .false., &
62       RADAR_SIM_UPDATE_scale_LUTs_flag = .false.
63 
64  ! Indices to address arrays of LS and CONV hydrometeors
65  integer,parameter :: &
66       I_LSCLIQ = 1, & ! Large-scale (stratiform) liquid
67       I_LSCICE = 2, & ! Large-scale (stratiform) ice
68       I_LSRAIN = 3, & ! Large-scale (stratiform) rain
69       I_LSSNOW = 4, & ! Large-scale (stratiform) snow
70       I_CVCLIQ = 5, & ! Convective liquid
71       I_CVCICE = 6, & ! Convective ice
72       I_CVRAIN = 7, & ! Convective rain
73       I_CVSNOW = 8, & ! Convective snow
74       I_LSGRPL = 9    ! Large-scale (stratiform) groupel
75 
76  ! Stratiform and convective clouds in frac_out.
77  integer, parameter :: &
78       I_LSC = 1, & ! Large-scale clouds
79       I_CVC = 2    ! Convective clouds     
80 
81  ! Microphysical settings for the precipitation flux to mixing ratio conversion
82  real(wp),parameter,dimension(N_HYDRO) :: &
83                 ! LSL   LSI      LSR       LSS   CVL  CVI      CVR       CVS       LSG
84       N_ax    = (/-1., -1.,     8.e6,     3.e6, -1., -1.,     8.e6,     3.e6,     4.e6/),&
85       N_bx    = (/-1., -1.,      0.0,      0.0, -1., -1.,      0.0,      0.0,      0.0/),&
86       alpha_x = (/-1., -1.,      0.0,      0.0, -1., -1.,      0.0,      0.0,      0.0/),&
87       c_x     = (/-1., -1.,    842.0,     4.84, -1., -1.,    842.0,     4.84,     94.5/),&
88       d_x     = (/-1., -1.,      0.8,     0.25, -1., -1.,      0.8,     0.25,      0.5/),&
89       g_x     = (/-1., -1.,      0.5,      0.5, -1., -1.,      0.5,      0.5,      0.5/),&
90       a_x     = (/-1., -1.,    524.0,    52.36, -1., -1.,    524.0,    52.36,   209.44/),&
91       b_x     = (/-1., -1.,      3.0,      3.0, -1., -1.,      3.0,      3.0,      3.0/),&
92       gamma_1 = (/-1., -1., 17.83725, 8.284701, -1., -1., 17.83725, 8.284701, 11.63230/),&
93       gamma_2 = (/-1., -1.,      6.0,      6.0, -1., -1.,      6.0,      6.0,      6.0/),&
94       gamma_3 = (/-1., -1.,      2.0,      2.0, -1., -1.,      2.0,      2.0,      2.0/),&
95       gamma_4 = (/-1., -1.,      6.0,      6.0, -1., -1.,      6.0,      6.0,      6.0/)
96 
97  ! Initialization fields
98  type(size_distribution) :: &
99       sd                ! Hydrometeor description
100  type(radar_cfg) :: &
101       rcfg_cloudsat     ! Radar configuration
102 
103  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
104  ! TYPE COSP_CONFIG
105  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
106  TYPE COSP_CONFIG
107     logical :: &
108          Lstats,           & ! Control for L3 stats output
109          Lwrite_output,    & ! Control for output
110          Ltoffset,         & ! Time difference between each profile and the value
111                              ! recorded in varaible time.
112          Lradar_sim,       & ! Radar simulator on/off switch
113          Llidar_sim,       & ! LIDAR simulator on/off switch
114          Lisccp_sim,       & ! ISCCP simulator on/off switch
115          Lmodis_sim,       & ! MODIS simulatoe on/off switch
116          Lmisr_sim,        & ! MISR simulator on/off switch
117          Lrttov_sim,       & ! RTTOV simulator on/off switch
118          Lparasol_sim,     & ! PARASOL simulator on/off switch
119          Lpctisccp,        & ! ISCCP mean cloud top pressure
120          Lclisccp,         & ! ISCCP cloud area fraction
121          Lboxptopisccp,    & ! ISCCP CTP in each column
122          Lboxtauisccp,     & ! ISCCP optical epth in each column
123          Ltauisccp,        & ! ISCCP mean optical depth
124          Lcltisccp,        & ! ISCCP total cloud fraction
125          Lmeantbisccp,     & ! ISCCP mean all-sky 10.5micron brightness temperature
126          Lmeantbclrisccp,  & ! ISCCP mean clear-sky 10.5micron brightness temperature
127          Lalbisccp,        & ! ISCCP mean cloud albedo
128          LcfadDbze94,      & ! CLOUDSAT radar reflectivity CFAD
129          Ldbze94,          & ! CLOUDSAT radar reflectivity
130          LparasolRefl,     & ! PARASOL reflectance
131          Latb532,          & ! CALIPSO attenuated total backscatter (532nm)
132          LlidarBetaMol532, & ! CALIPSO molecular backscatter (532nm)
133          LcfadLidarsr532,  & ! CALIPSO scattering ratio CFAD
134          Lclcalipso2,      & ! CALIPSO cloud fraction undetected by cloudsat
135          Lclcalipso,       & ! CALIPSO cloud area fraction
136          Lclhcalipso,      & ! CALIPSO high-level cloud fraction
137          Lcllcalipso,      & ! CALIPSO low-level cloud fraction
138          Lclmcalipso,      & ! CALIPSO mid-level cloud fraction
139          Lcltcalipso,      & ! CALIPSO total cloud fraction
140          Lcltlidarradar,   & ! CALIPSO-CLOUDSAT total cloud fraction
141          Lclcalipsoliq,    & ! CALIPSO liquid cloud area fraction
142          Lclcalipsoice,    & ! CALIPSO ice cloud area fraction
143          Lclcalipsoun,     & ! CALIPSO undetected cloud area fraction
144          Lclcalipsotmp,    & ! CALIPSO undetected cloud area fraction
145          Lclcalipsotmpliq, & ! CALIPSO liquid cloud area fraction
146          Lclcalipsotmpice, & ! CALIPSO ice cloud area fraction
147          Lclcalipsotmpun,  & ! CALIPSO undetected cloud area fraction
148          Lcltcalipsoliq,   & ! CALIPSO liquid total cloud fraction
149          Lcltcalipsoice,   & ! CALIPSO ice total cloud fraction
150          Lcltcalipsoun,    & ! CALIPSO undetected total cloud fraction
151          Lclhcalipsoliq,   & ! CALIPSO high-level liquid cloud fraction
152          Lclhcalipsoice,   & ! CALIPSO high-level ice cloud fraction
153          Lclhcalipsoun,    & ! CALIPSO high-level undetected cloud fraction
154          Lclmcalipsoliq,   & ! CALIPSO mid-level liquid cloud fraction
155          Lclmcalipsoice,   & ! CALIPSO mid-level ice cloud fraction
156          Lclmcalipsoun,    & ! CALIPSO mid-level undetected cloud fraction
157          Lcllcalipsoliq,   & ! CALIPSO low-level liquid cloud fraction
158          Lcllcalipsoice,   & ! CALIPSO low-level ice cloud fraction
159          Lcllcalipsoun,    & ! CALIPSO low-level undetected cloud fraction
160          Lcltmodis,        & ! MODIS total cloud fraction
161          Lclwmodis,        & ! MODIS liquid cloud fraction
162          Lclimodis,        & ! MODIS ice cloud fraction
163          Lclhmodis,        & ! MODIS high-level cloud fraction
164          Lclmmodis,        & ! MODIS mid-level cloud fraction
165          Lcllmodis,        & ! MODIS low-level cloud fraction
166          Ltautmodis,       & ! MODIS total cloud optical thicknes
167          Ltauwmodis,       & ! MODIS liquid optical thickness
168          Ltauimodis,       & ! MODIS ice optical thickness
169          Ltautlogmodis,    & ! MODIS total cloud optical thickness (log10 mean)
170          Ltauwlogmodis,    & ! MODIS liquid optical thickness (log10 mean)
171          Ltauilogmodis,    & ! MODIS ice optical thickness (log10 mean)
172          Lreffclwmodis,    & ! MODIS liquid cloud particle size
173          Lreffclimodis,    & ! MODIS ice particle size
174          Lpctmodis,        & ! MODIS cloud top pressure
175          Llwpmodis,        & ! MODIS cloud ice water path
176          Liwpmodis,        & ! MODIS cloud liquid water path
177          Lclmodis,         & ! MODIS cloud area fraction
178          LclMISR,          & ! MISR cloud fraction
179          Lfracout,         & ! SCOPS Subcolumn output
180          Ltbrttov            ! RTTOV mean clear-sky brightness temperature
181!     character(len=32),dimension(:),allocatable :: out_list
182      character(len=32) :: out_list(78)
183  END TYPE COSP_CONFIG       
184  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
185  ! TYPE cosp_vgrid
186  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
187  TYPE COSP_VGRID
188     logical ::  &
189          use_vgrid,  & ! Logical flag that indicates change of grid
190          csat_vgrid    ! Flag for Cloudsat grid
191     integer :: &
192          Npoints,    & ! Number of sampled points
193          Ncolumns,   & ! Number of subgrid columns
194          Nlevels,    & ! Number of model levels
195          Nlvgrid       ! Number of levels of new grid
196     real(wp), dimension(:), pointer :: &
197          z,          & ! Height of new level              (Nlvgrid)
198          zl,         & ! Lower boundaries of new levels   (Nlvgrid)
199          zu,         & ! Upper boundaries of new levels   (Nlvgrid)
200          mz,         & ! Height of model levels           (Nlevels)
201          mzl,        & ! Lower boundaries of model levels (Nlevels)
202          mzu           ! Upper boundaries of model levels (Nlevels)
203  END TYPE COSP_VGRID
204 
205  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
206  ! TYPE COSP_SUBGRID
207  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
208  TYPE COSP_SUBGRID
209     integer ::      &
210          Npoints,   & ! Number of gridpoints
211          Ncolumns,  & ! Number of columns
212          Nlevels,   & ! Number of levels
213          Nhydro       ! Number of hydrometeor types
214     real(wp),dimension(:,:,:),pointer :: &
215          prec_frac, & ! Subgrid precip array (Npoints,Ncolumns,Nlevels)
216          frac_out     ! Subgrid cloud array  (Npoints,Ncolumns,Nlevels)
217  END TYPE COSP_SUBGRID 
218  ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
219  ! TYPE class_param
220  ! With the reorganizing of COSPv2.0, this derived type
221  ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
222  type class_param
223     ! Variables used to store hydrometeor "default" properties
224     real(dp),dimension(maxhclass) :: p1,p2,p3,dmin,dmax,apm,bpm,rho
225     integer, dimension(maxhclass) :: dtype,col,cp,phase
226     
227     ! Radar properties
228     real(dp) :: freq,k2
229     integer  :: nhclass           ! number of hydrometeor classes in use
230     integer  :: use_gas_abs, do_ray
231     
232     ! Defines location of radar relative to hgt_matrix.   
233     logical :: radar_at_layer_one ! If true radar is assume to be at the edge
234                                   ! of the first layer, if the first layer is the
235                                   ! surface than a ground-based radar.   If the
236                                   ! first layer is the top-of-atmosphere, then
237                                   ! a space borne radar.
238     
239     ! Variables used to store Z scale factors
240     character(len=240)                             :: scale_LUT_file_name
241     logical                                        :: load_scale_LUTs, update_scale_LUTs
242     logical, dimension(maxhclass,nRe_types)        :: N_scale_flag
243     logical, dimension(maxhclass,mt_ntt,nRe_types) :: Z_scale_flag,Z_scale_added_flag
244     real(dp),dimension(maxhclass,mt_ntt,nRe_types) :: Ze_scaled,Zr_scaled,kr_scaled
245     real(dp),dimension(maxhclass,nd,nRe_types)     :: fc, rho_eff     
246  end type class_param
247  ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
248  ! TYPE cosp_gridbox
249  ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
250  TYPE cosp_gridbox
251     integer :: &
252          Npoints,          & ! Number of gridpoints
253          Nlevels,          & ! Number of levels
254          Ncolumns,         & ! Number of columns
255          Nhydro,           & ! Number of hydrometeors
256          Nprmts_max_hydro, & ! Max number of parameters for hydrometeor size distribution
257          Naero,            & ! Number of aerosol species
258          Nprmts_max_aero,  & ! Max number of parameters for aerosol size distributions
259          Npoints_it          ! Max number of gridpoints to be processed in one iteration
260     
261     ! Time [days]
262     double precision :: time
263     double precision :: time_bnds(2)
264     
265     ! Radar ancillary info
266     real(wp) :: &
267          radar_freq,    & ! Radar frequency [GHz]
268          k2               ! |K|^2, -1=use frequency dependent default
269     integer :: surface_radar,  & ! surface=1, spaceborne=0
270          use_mie_tables, & ! use a precomputed loopup table? yes=1,no=0
271          use_gas_abs,    & ! include gaseous absorption? yes=1,no=0
272          do_ray,         & ! calculate/output Rayleigh refl=1, not=0
273          melt_lay          ! melting layer model off=0, on=1
274     
275     
276     ! Structures used by radar simulator that need to be set only ONCE per
277     ! radar configuration (e.g. freq, pointing direction) ... added by roj Feb 2008
278     type(class_param) :: &
279          hp     ! Structure used by radar simulator to store Ze and N scaling constants
280                 ! and other information
281     integer :: &
282          nsizes ! Number of discrete drop sizes (um) used to represent the distribution
283     
284     ! Lidar
285     integer :: &
286          lidar_ice_type ! Ice particle shape hypothesis in lidar calculations
287                         ! (ice_type=0 for spheres, ice_type=1 for non spherical particles)
288   
289     ! Radar
290     logical :: &
291          use_precipitation_fluxes, & ! True if precipitation fluxes are input to the
292                                      ! algorithm
293          use_reff                    ! True if Reff is to be used by radar (memory not
294                                      ! allocated)       
295     
296     ! Geolocation and point information (Npoints)
297     real(wp),dimension(:),pointer :: &
298          toffset,   & ! Time offset of esch point from the value in time
299          longitude, & ! Longitude [degrees East]                       
300          latitude,  & ! Latitude [deg North]                         
301          land,      & ! Landmask [0 - Ocean, 1 - Land]             
302          psfc,      & ! Surface pressure [Pa]                     
303          sunlit,    & ! 1 for day points, 0 for nightime           
304          skt,       & ! Skin temperature (K)                     
305          u_wind,    & ! Eastward wind [m s-1]                   
306          v_wind       ! Northward wind [m s-1]     
307     
308     ! Gridbox information (Npoints,Nlevels)
309     real(wp),dimension(:,:),pointer :: &
310          zlev,      & ! Height of model levels [m]                           
311          zlev_half, & ! Height at half model levels [m] (Bottom of layer)   
312          dlev,      & ! Depth of model levels  [m]                         
313          p,         & ! Pressure at full model levels [Pa]     
314          ph,        & ! Pressure at half model levels [Pa]             
315          T,         & ! Temperature at model levels [K]                 
316          q,         & ! Relative humidity to water (%)                       
317          sh,        & ! Specific humidity to water [kg/kg]             
318          dtau_s,    & ! mean 0.67 micron optical depth of stratiform clouds 
319          dtau_c,    & ! mean 0.67 micron optical depth of convective clouds
320          dem_s,     & ! 10.5 micron longwave emissivity of stratiform clouds
321          dem_c,     & ! 10.5 micron longwave emissivity of convective clouds
322          mr_ozone     ! Ozone mass mixing ratio [kg/kg]   
323     
324     ! TOTAL and CONV cloud fraction for SCOPS
325     real(wp),dimension(:,:),pointer :: &
326          tca,       & ! Total cloud fraction
327          cca          ! Convective cloud fraction
328     
329     ! Precipitation fluxes on model levels
330     real(wp),dimension(:,:),pointer :: &
331          rain_ls,   & ! Large-scale precipitation flux of rain [kg/m2.s]
332          rain_cv,   & ! Convective precipitation flux of rain [kg/m2.s]
333          snow_ls,   & ! Large-scale precipitation flux of snow [kg/m2.s]
334          snow_cv,   & ! Convective precipitation flux of snow [kg/m2.s]
335          grpl_ls      ! large-scale precipitation flux of graupel [kg/m2.s]
336     
337     ! Hydrometeors concentration and distribution parameters
338     real(wp),dimension(:,:,:),pointer :: &
339          mr_hydro         ! Mixing ratio of each hydrometeor
340                           ! (Npoints,Nlevels,Nhydro) [kg/kg]
341     real(wp),dimension(:,:),pointer :: &
342          dist_prmts_hydro ! Distributional parameters for hydrometeors
343                           ! (Nprmts_max_hydro,Nhydro)
344     real(wp),dimension(:,:,:),pointer :: &
345          Reff             ! Effective radius [m].
346                           ! (Npoints,Nlevels,Nhydro)
347     real(wp),dimension(:,:,:),pointer :: &
348          Np               ! Total Number Concentration [#/kg].
349                           ! (Npoints,Nlevels,Nhydro)
350 
351     ! Aerosols concentration and distribution parameters
352     real(wp),dimension(:,:,:),pointer :: &
353          conc_aero       ! Aerosol concentration for each species
354                          ! (Npoints,Nlevels,Naero)
355     integer,dimension(:),pointer :: &
356          dist_type_aero  ! Particle size distribution type for each aerosol species
357                          ! (Naero)
358     real(wp),dimension(:,:,:,:),pointer :: &
359          dist_prmts_aero ! Distributional parameters for aerosols
360                          ! (Npoints,Nlevels,Nprmts_max_aero,Naero)
361     ! ISCCP simulator inputs
362     integer :: &
363          ! ISCCP_TOP_HEIGHT
364          ! 1 = adjust top height using both a computed infrared brightness temperature and
365          !     the visible optical depth to adjust cloud top pressure. Note that this
366          !     calculation is most appropriate to compare to ISCCP data during sunlit
367          !     hours.
368          ! 2 = do not adjust top height, that is cloud top pressure is the actual cloud
369          !     top pressure in the model.
370          ! 3 = adjust top height using only the computed infrared brightness temperature.
371          !     Note that this calculation is most appropriate to compare to ISCCP IR only
372          !     algortihm (i.e. you can compare to nighttime ISCCP data with this option)
373          isccp_top_height, &
374          ! ISCCP_TOP_HEIGHT_DIRECTION
375          ! Direction for finding atmosphere pressure level with interpolated temperature
376          ! equal to the radiance determined cloud-top temperature
377          ! 1 = find the *lowest* altitude (highest pressure) level with interpolated
378          !     temperature equal to the radiance determined cloud-top temperature
379          ! 2 = find the *highest* altitude (lowest pressure) level with interpolated
380          !     temperature equal to the radiance determined cloud-top temperature
381          !     ONLY APPLICABLE IF top_height EQUALS 1 or 3
382          ! 1 = default setting, and matches all versions of ISCCP simulator with versions
383          !     numbers 3.5.1 and lower; 2 = experimental setting 
384          isccp_top_height_direction, &
385          ! Overlap type (1=max, 2=rand, 3=max/rand)
386          isccp_overlap
387     real(wp) :: &
388          isccp_emsfc_lw      ! 10.5 micron emissivity of surface (fraction)
389     
390     ! RTTOV inputs/options
391     integer :: &
392          plat,   & ! Satellite platform
393          sat,    & ! Satellite
394          inst,   & ! Instrument
395          Nchan     ! Number of channels to be computed
396     integer, dimension(:), pointer :: &
397          Ichan     ! Channel numbers
398     real(wp),dimension(:), pointer :: &
399          Surfem    ! Surface emissivity
400     real(wp) :: &
401          ZenAng, & ! Satellite Zenith Angles
402          co2,    & ! CO2 mixing ratio
403          ch4,    & ! CH4 mixing ratio
404          n2o,    & ! N2O mixing ratio
405          co        ! CO mixing ratio
406  END TYPE cosp_gridbox
407  ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
408  ! TYPE cosp_modis
409  ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
410  type cosp_modis
411     integer,pointer ::                    & !
412          Npoints                            ! Number of gridpoints
413     real(wp),pointer,dimension(:) ::      & ! 
414          Cloud_Fraction_Total_Mean,       & ! L3 MODIS retrieved cloud fraction (total)
415          Cloud_Fraction_Water_Mean,       & ! L3 MODIS retrieved cloud fraction (liq)
416          Cloud_Fraction_Ice_Mean,         & ! L3 MODIS retrieved cloud fraction (ice)
417          Cloud_Fraction_High_Mean,        & ! L3 MODIS retrieved cloud fraction (high)
418          Cloud_Fraction_Mid_Mean,         & ! L3 MODIS retrieved cloud fraction (middle)
419          Cloud_Fraction_Low_Mean,         & ! L3 MODIS retrieved cloud fraction (low )
420          Optical_Thickness_Total_Mean,    & ! L3 MODIS retrieved optical thickness (tot)
421          Optical_Thickness_Water_Mean,    & ! L3 MODIS retrieved optical thickness (liq)
422          Optical_Thickness_Ice_Mean,      & ! L3 MODIS retrieved optical thickness (ice)
423          Optical_Thickness_Total_LogMean, & ! L3 MODIS retrieved log10 optical thickness
424          Optical_Thickness_Water_LogMean, & ! L3 MODIS retrieved log10 optical thickness
425          Optical_Thickness_Ice_LogMean,   & ! L3 MODIS retrieved log10 optical thickness
426          Cloud_Particle_Size_Water_Mean,  & ! L3 MODIS retrieved particle size (liquid)
427          Cloud_Particle_Size_Ice_Mean,    & ! L3 MODIS retrieved particle size (ice)
428          Cloud_Top_Pressure_Total_Mean,   & ! L3 MODIS retrieved cloud top pressure
429          Liquid_Water_Path_Mean,          & ! L3 MODIS retrieved liquid water path
430          Ice_Water_Path_Mean                ! L3 MODIS retrieved ice water path
431     real(wp),pointer,dimension(:,:,:) ::  &
432          Optical_Thickness_vs_Cloud_Top_Pressure,  & ! Tau/Pressure joint histogram
433          Optical_Thickness_vs_ReffICE,             & ! Tau/ReffICE joint histogram
434          Optical_Thickness_vs_ReffLIQ                ! Tau/ReffLIQ joint histogram
435
436  end type cosp_modis 
437  ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
438  ! TYPE cosp_misr     
439  ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
440  TYPE COSP_MISR
441     integer,pointer :: &
442        Npoints,       & ! Number of gridpoints
443        Ntau,          & ! Number of tau intervals
444        Nlevels          ! Number of cth levels 
445     real(wp),dimension(:,:,:),pointer ::   & !
446        fq_MISR          ! Fraction of the model grid box covered by each of the MISR
447                                         ! cloud types
448     real(wp),dimension(:,:),pointer ::   & !
449        MISR_dist_model_layertops ! 
450     real(wp),dimension(:),pointer ::   & !
451        MISR_meanztop, & ! Mean MISR cloud top height
452        MISR_cldarea     ! Mean MISR cloud cover area
453  END TYPE COSP_MISR 
454  ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
455  ! TYPE cosp_rttov
456  ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
457  TYPE COSP_RTTOV
458     ! Dimensions
459     integer,pointer :: &
460        Npoints,  & ! Number of gridpoints
461        Nchan       ! Number of channels
462     
463     ! Brightness temperatures (Npoints,Nchan)
464     real(wp),pointer :: tbs(:,:)
465  END TYPE COSP_RTTOV
466 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
467 ! TYPE cosp_isccp
468 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
469  TYPE COSP_ISCCP
470     integer,pointer  ::&
471        Npoints,      & ! Number of gridpoints.
472        Ncolumns,     & ! Number of columns.
473        Nlevels         ! Number of levels.
474     real(wp),dimension(:),pointer :: &
475        totalcldarea, & ! The fraction of model grid box columns with cloud somewhere in
476                                          ! them.
477        meantb,       & ! Mean all-sky 10.5 micron brightness temperature.
478        meantbclr,    & ! Mean clear-sky 10.5 micron brightness temperature.
479        meanptop,     & ! Mean cloud top pressure (mb).
480        meantaucld,   & ! Mean optical thickness.
481        meanalbedocld   ! Mean cloud albedo.
482     real(wp),dimension(:,:),pointer ::&
483        boxtau,       & ! Optical thickness in each column   .
484        boxptop         ! Cloud top pressure (mb) in each column.
485     real(wp),dimension(:,:,:),pointer :: &
486        fq_isccp        ! The fraction of the model grid box covered by each of the 49
487                                    ! ISCCP D level cloud types.
488  END TYPE COSP_ISCCP
489  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
490  ! TYPE cosp_sglidar
491  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
492  type cosp_sglidar
493     integer,pointer :: &
494          Npoints,         & ! Number of sampled points
495          Ncolumns,        & ! Number of subgrid columns
496          Nlevels,         & ! Number of model levels
497          Nhydro,          & ! Number of hydrometeors
498          Nrefl              ! Number of parasol reflectances
499     real(wp),dimension(:,:),pointer :: &
500          beta_mol,      & ! Molecular backscatter
501          temp_tot
502     real(wp),dimension(:,:,:),pointer :: &
503          betaperp_tot,  & ! Total backscattered signal
504          beta_tot,      & ! Total backscattered signal
505          tau_tot,       & ! Optical thickness integrated from top to level z
506          refl             ! PARASOL reflectances
507  end type cosp_sglidar
508  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
509  ! TYPE cosp_lidarstats
510  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
511  type cosp_lidarstats
512     integer,pointer :: &
513          Npoints,         & ! Number of sampled points
514          Ncolumns,        & ! Number of subgrid columns
515          Nlevels,         & ! Number of model levels
516          Nhydro,          & ! Number of hydrometeors
517          Nrefl              ! Number of parasol reflectances
518     real(wp), dimension(:,:,:),pointer :: &
519          lidarcldphase,   & ! 3D "lidar" phase cloud fraction
520          cldlayerphase,   & ! low, mid, high-level lidar phase cloud cover
521          lidarcldtmp,     & ! 3D "lidar" phase cloud temperature
522          cfad_sr            ! CFAD of scattering ratio
523     real(wp), dimension(:,:),pointer :: &
524          lidarcld,        & ! 3D "lidar" cloud fraction
525          cldlayer,        & ! low, mid, high-level, total lidar cloud cover
526          parasolrefl
527     real(wp), dimension(:),pointer :: &
528          srbval             ! SR bins in cfad_sr
529  end type cosp_lidarstats 
530  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
531  ! TYPE cosp_sgradar
532  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
533  type cosp_sgradar
534     ! Dimensions
535     integer,pointer :: &
536          Npoints,            & ! Number of gridpoints
537          Ncolumns,           & ! Number of columns
538          Nlevels,            & ! Number of levels
539          Nhydro                ! Number of hydrometeors
540     real(wp),dimension(:,:),pointer :: &
541          att_gas               ! 2-way attenuation by gases [dBZ] (Npoints,Nlevels)
542     real(wp),dimension(:,:,:),pointer :: &
543          Ze_tot                ! Effective reflectivity factor (Npoints,Ncolumns,Nlevels)
544  end type cosp_sgradar
545  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
546  ! TYPE cosp_radarstats
547  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
548  type cosp_radarstats
549     integer,pointer  :: &
550          Npoints,            & ! Number of sampled points
551          Ncolumns,           & ! Number of subgrid columns
552          Nlevels,            & ! Number of model levels
553          Nhydro                ! Number of hydrometeors
554     real(wp), dimension(:,:,:), pointer :: &
555          cfad_ze               ! Ze CFAD(Npoints,dBZe_bins,Nlevels)
556     real(wp),dimension(:),pointer :: &
557          radar_lidar_tcc       ! Radar&lidar total cloud amount, grid-box scale (Npoints)
558     real(wp), dimension(:,:),pointer :: &
559          lidar_only_freq_cloud !(Npoints,Nlevels)
560  end type cosp_radarstats
561     
562contains
563 
564  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
565  !                            SUBROUTINE COSP_INTERFACE (v1.4)
566  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
567  subroutine cosp_interface_v1p4(overlap,Ncolumns,cfg,vgrid,gbx,sgx,sgradar,sglidar,   &
568                                 isccp,misr,modis,rttov,stradar,stlidar)
569    ! Inputs
570    integer,                intent(in)    :: overlap  ! Overlap type in SCOPS: 1=max,
571                                                      ! 2=rand, 3=max/rand
572    integer,                intent(in)    :: Ncolumns ! Number of columns
573    type(cosp_config),      intent(in)    :: cfg      ! Configuration options
574    type(cosp_vgrid),target,intent(in)    :: vgrid    ! Information on vertical grid of
575                                                      ! stats
576    type(cosp_subgrid),     intent(inout) :: sgx      ! Subgrid info
577    type(cosp_sgradar),     intent(inout) :: sgradar  ! Output from radar simulator (pixel)
578    type(cosp_sglidar),     intent(inout) :: sglidar  ! Output from lidar simulator (pixel)
579    type(cosp_isccp),       intent(inout) :: isccp    ! Output from ISCCP simulator
580    type(cosp_misr),        intent(inout) :: misr     ! Output from MISR simulator
581    type(cosp_modis),       intent(inout) :: modis    ! Output from MODIS simulator
582    type(cosp_rttov),       intent(inout) :: rttov    ! Output from RTTOV
583    type(cosp_radarstats),  intent(inout) :: stradar  ! Summary statistics from cloudsat
584                                                      ! simulator (gridbox)
585    type(cosp_lidarstats),  intent(inout) :: stlidar  ! Output from LIDAR simulator (gridbox)
586    type(cosp_gridbox),intent(inout),target :: gbx ! COSP gridbox type from v1.4
587                                                          ! Shares memory with new type
588 
589    ! Outputs from COSP2
590    type(cosp_outputs),target :: cospOUT  ! NEW derived type output that contains all
591                                                          ! simulator information
592    ! Local variables
593    integer :: i
594    integer :: &
595         num_chunks, & ! Number of iterations to make
596         start_idx,  & ! Starting index when looping over points
597         end_idx,    & ! Ending index when looping over points
598         Nptsperit     ! Number of points for current iteration                                           
599    logical :: &
600         lsingle=.true., & ! True if using MMF_v3_single_moment CLOUDSAT microphysical scheme (default)
601         ldouble=.false.   ! True if using MMF_v3.5_two_moment CLOUDSAT microphysical scheme 
602    type(cosp_optical_inputs) :: &
603         cospIN            ! COSP optical (or derived?) fields needed by simulators
604    type(cosp_column_inputs) :: &
605         cospstateIN       ! COSP model fields needed by simulators
606    character(len=256),dimension(100) :: cosp_status
607
608#ifdef MMF_V3_SINGLE_MOMENT                                       
609    character(len=64) :: &
610         cloudsat_micro_scheme = 'MMF_v3_single_moment'
611#endif
612#ifdef MMF_V3p5_TWO_MOMENT
613    character(len=64) :: &
614         cloudsat_micro_scheme = 'MMF_v3.5_two_moment'
615#endif
616   
617    ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
618    ! Initialize COSP
619    ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
620
621    ! Initialize MODIS optical-depth bin boundaries for joint-histogram. (defined in cosp_config.F90)
622    if (.not. allocated(modis_histTau)) then
623       allocate(modis_histTau(ntauV1p4+1),modis_histTauEdges(2,ntauV1p4),modis_histTauCenters(ntauV1p4))
624       numMODIStauBins      = ntauV1p4+1
625       modis_histTau        = tau_binBoundsV1p4
626       modis_histTauEdges   = tau_binEdgesV1p4
627       modis_histTauCenters = tau_binCentersV1p4
628    endif
629
630    print*,'allocated(vgrid_zl)',allocated(vgrid_zl)
631    if (.not. allocated(vgrid_zl) .or. .not. allocated(vgrid_zu) .or. .not. allocated(vgrid_z)) then
632       
633       ! Initialize quickbeam_optics, also if two-moment radar microphysics scheme is wanted...
634       if (cloudsat_micro_scheme == 'MMF_v3.5_two_moment')  then
635          ldouble = .true.
636          lsingle = .false.
637       endif
638       
639       ! Initialize the distributional parameters for hydrometeors in radar simulator
640       call hydro_class_init(lsingle,ldouble,sd)
641       
642       ! Initialize COSP simulator
643       call COSP_INIT(cfg%Lisccp_sim,cfg%Lmodis_sim,cfg%Lmisr_sim,cfg%Lradar_sim,        &
644            cfg%Llidar_sim,cfg%Lparasol_sim,cfg%Lrttov_sim,gbx%Npoints,gbx%Nlevels,      &
645            gbx%radar_freq,gbx%k2,gbx%use_gas_abs,gbx%do_ray,gbx%isccp_top_height,       &
646            gbx%isccp_top_height_direction,gbx%surface_radar,rcfg_cloudsat,gbx%Nchan,    &
647            gbx%Ichan,gbx%plat,gbx%sat,gbx%inst,vgrid%use_vgrid,vgrid%csat_vgrid,        &
648            vgrid%Nlvgrid,cloudsat_micro_scheme,cospOUT)
649    endif
650   
651   
652    ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
653    ! Construct output type for cosp
654    ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
655    call construct_cosp_outputs(cfg%Lpctisccp,cfg%Lclisccp,cfg%Lboxptopisccp,            &
656                                cfg%Lboxtauisccp,cfg%Ltauisccp,cfg%Lcltisccp,            &
657                                cfg%Lmeantbisccp,cfg%Lmeantbclrisccp,cfg%Lalbisccp,      &
658                                cfg%LclMISR,cfg%Lcltmodis,cfg%Lclwmodis,cfg%Lclimodis,   &
659                                cfg%Lclhmodis,cfg%Lclmmodis,cfg%Lcllmodis,cfg%Ltautmodis,&
660                                cfg%Ltauwmodis,cfg%Ltauimodis,cfg%Ltautlogmodis,         &
661                                cfg%Ltauwlogmodis,cfg%Ltauilogmodis,cfg%Lreffclwmodis,   &
662                                cfg%Lreffclimodis,cfg%Lpctmodis,cfg%Llwpmodis,           &
663                                cfg%Liwpmodis,cfg%Lclmodis,cfg%Latb532,                  &
664                                cfg%LlidarBetaMol532,cfg%LcfadLidarsr532,cfg%Lclcalipso2,&
665                                cfg%Lclcalipso,cfg%Lclhcalipso,cfg%Lcllcalipso,          &
666                                cfg%Lclmcalipso,cfg%Lcltcalipso,cfg%Lcltlidarradar,      &
667                                cfg%Lclcalipsoliq,cfg%Lclcalipsoice,cfg%Lclcalipsoun,    &
668                                cfg%Lclcalipsotmp,cfg%Lclcalipsotmpliq,                  &
669                                cfg%Lclcalipsotmpice,cfg%Lclcalipsotmpun,                &
670                                cfg%Lcltcalipsoliq,cfg%Lcltcalipsoice,cfg%Lcltcalipsoun, &
671                                cfg%Lclhcalipsoliq,cfg%Lclhcalipsoice,cfg%Lclhcalipsoun, &
672                                cfg%Lclmcalipsoliq,cfg%Lclmcalipsoice,cfg%Lclmcalipsoun, &
673                                cfg%Lcllcalipsoliq,cfg%Lcllcalipsoice,cfg%Lcllcalipsoun, &
674                                cfg%LcfadDbze94,cfg%Ldbze94,cfg%Lparasolrefl,            &
675                                cfg%Ltbrttov,gbx%Npoints,gbx%Ncolumns,gbx%Nlevels,       &
676                                vgrid%Nlvgrid,gbx%Nchan,cospOUT)
677
678    !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
679    ! Break COSP into chunks, only applicable when gbx%Npoints_it > gbx%Npoints
680    !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
681    num_chunks = gbx%Npoints/gbx%Npoints_it+1
682    do i=1,num_chunks
683       !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
684       ! Determine indices for "chunking" (again, if necessary)
685       !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
686       if (num_chunks .eq. 1) then
687          start_idx = 1
688          end_idx   = gbx%Npoints
689          Nptsperit = gbx%Npoints
690       else
691          start_idx = (i-1)*gbx%Npoints_it+1
692          end_idx   = i*gbx%Npoints_it
693          if (end_idx .gt. gbx%Npoints) end_idx=gbx%Npoints
694          Nptsperit = end_idx-start_idx+1
695       endif
696
697       !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
698       ! Allocate space
699       !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
700       if (i .eq. 1) then
701          call construct_cospIN(Nptsperit,gbx%ncolumns,gbx%nlevels,cospIN)
702          call construct_cospstateIN(Nptsperit,gbx%nlevels,gbx%nchan,cospstateIN)
703       endif
704       if (i .eq. num_chunks) then
705          call destroy_cospIN(cospIN)
706          call destroy_cospstateIN(cospstateIN)
707          call construct_cospIN(Nptsperit,gbx%ncolumns,gbx%nlevels,cospIN)
708          call construct_cospstateIN(Nptsperit,gbx%nlevels,gbx%nchan,cospstateIN)   
709       endif
710       !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
711       ! Generate subcolumns and compute optical inputs to COSP.
712       ! This subroutine essentially contains all of the pieces of code that were removed
713       ! from the simulators during the v2.0 reconstruction.
714       !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
715       call subsample_and_optics(overlap,gbx,sgx,cfg,Nptsperit,start_idx,end_idx,cospIN,     &
716                                 cospstateIN)
717       
718       !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
719       ! Call COSPv2.0
720       !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
721       cosp_status = COSP_SIMULATOR(cospIN, cospstateIN, cospOUT, start_idx,end_idx,.false.)
722    enddo
723    !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
724    ! Free up memory
725    !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
726    call destroy_cospIN(cospIN)
727    call destroy_cospstateIN(cospstateIN)
728   
729    !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
730    ! Copy new output to old output types.
731    !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
732    ! MISR
733    if (cfg%Lmisr_sim) then
734       if (cfg%LclMISR) misr%fq_MISR  = cospOUT%misr_fq
735       ! *NOTE* These 3 fields are not output, but were part of the v1.4.0 cosp_misr, so
736       !        they are still computed. Should probably have a logical to control these
737       !        outputs in cosp_config. In the meantime, only assign v1.4.0 outputs to
738       !        v2.0 outputs IF a MISR diagnostic was requested.
739       if (cfg%LclMISR) misr%MISR_meanztop             = cospOUT%misr_meanztop
740       if (cfg%LclMISR) misr%MISR_cldarea              = cospOUT%misr_cldarea
741       if (cfg%LclMISR) misr%MISR_dist_model_layertops = cospOUT%misr_dist_model_layertops
742    endif
743   
744    ! ISCCP
745    if (cfg%Lisccp_sim) then
746       if (cfg%Lboxtauisccp)    isccp%boxtau        = cospOUT%isccp_boxtau
747       if (cfg%Lboxptopisccp)   isccp%boxptop       = cospOUT%isccp_boxptop
748       if (cfg%Lclisccp)        isccp%fq_isccp      = cospOUT%isccp_fq
749       if (cfg%Lcltisccp)       isccp%totalcldarea  = cospOUT%isccp_totalcldarea
750       if (cfg%Lmeantbisccp)    isccp%meantb        = cospOUT%isccp_meantb
751       if (cfg%Lmeantbclrisccp) isccp%meantbclr     = cospOUT%isccp_meantbclr
752       if (cfg%Lpctisccp)       isccp%meanptop      = cospOUT%isccp_meanptop
753       if (cfg%Ltauisccp)       isccp%meantaucld    = cospOUT%isccp_meantaucld
754       if (cfg%Lalbisccp)       isccp%meanalbedocld = cospOUT%isccp_meanalbedocld
755   endif
756
757    ! MODIS
758    if (cfg%Lmodis_sim) then
759       if (cfg%Lcltmodis)     modis%Cloud_Fraction_Total_Mean =                         &
760                          cospOUT%modis_Cloud_Fraction_Total_Mean
761       if (cfg%Lclwmodis)     modis%Cloud_Fraction_Water_Mean =                         &
762                          cospOUT%modis_Cloud_Fraction_Water_Mean
763       if (cfg%Lclimodis)     modis%Cloud_Fraction_Ice_Mean =                           &
764                          cospOUT%modis_Cloud_Fraction_Ice_Mean
765       if (cfg%Lclhmodis)     modis%Cloud_Fraction_High_Mean =                          &
766                          cospOUT%modis_Cloud_Fraction_High_Mean
767       if (cfg%Lclmmodis)     modis%Cloud_Fraction_Mid_Mean =                           &
768                          cospOUT%modis_Cloud_Fraction_Mid_Mean
769       if (cfg%Lcllmodis)     modis%Cloud_Fraction_Low_Mean =                           &
770                          cospOUT%modis_Cloud_Fraction_Low_Mean
771       if (cfg%Ltautmodis)    modis%Optical_Thickness_Total_Mean =                      &
772                          cospOUT%modis_Optical_Thickness_Total_Mean
773       if (cfg%Ltauwmodis)    modis%Optical_Thickness_Water_Mean =                      &
774                          cospOUT%modis_Optical_Thickness_Water_Mean
775       if (cfg%Ltauimodis)    modis%Optical_Thickness_Ice_Mean =                        &
776                          cospOUT%modis_Optical_Thickness_Ice_Mean
777       if (cfg%Ltautlogmodis) modis%Optical_Thickness_Total_LogMean =                   &
778                          cospOUT%modis_Optical_Thickness_Total_LogMean
779       if (cfg%Ltauwlogmodis) modis%Optical_Thickness_Water_LogMean =                   &
780                          cospOUT%modis_Optical_Thickness_Water_LogMean
781       if (cfg%Ltauilogmodis) modis%Optical_Thickness_Ice_LogMean =                     &
782                          cospOUT%modis_Optical_Thickness_Ice_LogMean
783       if (cfg%Lreffclwmodis) modis%Cloud_Particle_Size_Water_Mean =                    &
784                          cospOUT%modis_Cloud_Particle_Size_Water_Mean
785       if (cfg%Lreffclimodis) modis%Cloud_Particle_Size_Ice_Mean =                      &
786                          cospOUT%modis_Cloud_Particle_Size_Ice_Mean
787       if (cfg%Lpctmodis)     modis%Cloud_Top_Pressure_Total_Mean =                     &
788                          cospOUT%modis_Cloud_Top_Pressure_Total_Mean
789       if (cfg%Llwpmodis)     modis%Liquid_Water_Path_Mean =                            &
790                          cospOUT%modis_Liquid_Water_Path_Mean
791       if (cfg%Liwpmodis)     modis%Ice_Water_Path_Mean =                               &
792                          cospOUT%modis_Ice_Water_Path_Mean
793       if (cfg%Lclmodis) then
794          modis%Optical_Thickness_vs_Cloud_Top_Pressure =                               &
795             cospOUT%modis_Optical_Thickness_vs_Cloud_Top_Pressure
796          modis%Optical_Thickness_vs_ReffICE = cospOUT%modis_Optical_Thickness_vs_ReffICE
797          modis%Optical_Thickness_vs_ReffLIQ = cospOUT%modis_Optical_Thickness_vs_ReffLIQ
798       endif
799    endif
800
801    ! PARASOL
802    if (cfg%Lparasol_sim) then
803       if (cfg%Lparasolrefl) sglidar%refl        = cospOUT%parasolPix_refl
804       if (cfg%Lparasolrefl) stlidar%parasolrefl = cospOUT%parasolGrid_refl
805    endif
806
807    ! RTTOV
808    if (cfg%Lrttov_sim) then
809       if (cfg%Ltbrttov) rttov%tbs = cospOUT%rttov_tbs 
810    endif
811   
812    ! CALIPSO
813    if (cfg%Llidar_sim) then
814       ! *NOTE* In COSPv2.0 all outputs are ordered from TOA-2-SFC, but in COSPv1.4 this is
815       !        not true. To maintain the outputs of v1.4, the affected fields are flipped.
816
817       if (cfg%LlidarBetaMol532) then
818          sglidar%beta_mol         = cospOUT%calipso_beta_mol!(:,sglidar%Nlevels:1:-1)
819       endif
820       if (cfg%Latb532) then
821          !cospOUT%calipso_beta_tot = cospOUT%calipso_beta_tot(:,:,sglidar%Nlevels:1:-1)
822          sglidar%beta_tot         = cospOUT%calipso_beta_tot
823       endif
824       if (cfg%LcfadLidarsr532)  then
825          stlidar%srbval       = cospOUT%calipso_srbval
826          stlidar%cfad_sr      = cospOUT%calipso_cfad_sr(:,:,vgrid%Nlvgrid:1:-1)
827          sglidar%betaperp_tot = cospOUT%calipso_betaperp_tot(:,:,sglidar%Nlevels:1:-1)
828       endif
829
830       if (cfg%Lclcalipso) then
831          stlidar%lidarcld = cospOUT%calipso_lidarcld(:,stlidar%Nlevels:1:-1)
832       endif       
833       if (cfg%Lclhcalipso .or. cfg%Lclmcalipso .or. cfg%Lcllcalipso .or. cfg%Lcltcalipso) then
834          stlidar%cldlayer = cospOUT%calipso_cldlayer
835       endif
836       if (cfg%Lclcalipsoice .or. cfg%Lclcalipsoliq .or. cfg%Lclcalipsoun) then
837          stlidar%lidarcldphase = cospOUT%calipso_lidarcldphase(:,vgrid%Nlvgrid:1:-1,:)
838       endif
839       if (cfg%Lcllcalipsoice .or. cfg%Lclmcalipsoice .or. cfg%Lclhcalipsoice .or.                   &
840           cfg%Lcltcalipsoice .or. cfg%Lcllcalipsoliq .or. cfg%Lclmcalipsoliq .or.                   &
841           cfg%Lclhcalipsoliq .or. cfg%Lcltcalipsoliq .or. cfg%Lcllcalipsoun  .or.                   &
842           cfg%Lclmcalipsoun  .or. cfg%Lclhcalipsoun  .or. cfg%Lcltcalipsoun) then       
843          stlidar%cldlayerphase         = cospOUT%calipso_cldlayerphase
844       endif
845       if (cfg%Lclcalipsotmp .or. cfg%Lclcalipsotmpliq .or. cfg%Lclcalipsoice .or. cfg%Lclcalipsotmpun) then
846          stlidar%lidarcldtmp = cospOUT%calipso_lidarcldtmp
847       endif
848       ! Fields present, but not controlled by logical switch
849       if (any([cfg%Lclcalipsoliq,cfg%Lclcalipsoice,cfg%Lclcalipsoun,cfg%Lclcalipsotmp,          &
850            cfg%Lclcalipsotmpliq,cfg%Lclcalipsotmpice,cfg%Lclcalipsotmpun,cfg%Lclhcalipsoliq,&
851            cfg%Lcllcalipsoliq,cfg%Lclmcalipsoliq,cfg%Lcltcalipsoliq,cfg%Lclhcalipsoice,&
852            cfg%Lcllcalipsoice,cfg%Lclmcalipsoice,cfg%Lcltcalipsoice,cfg%Lclhcalipsoun,&
853            cfg%Lcllcalipsoun,cfg%Lclmcalipsoun,cfg%Lcltcalipsoun])) then
854          sglidar%temp_tot = cospOUT%calipso_temp_tot(:,sglidar%Nlevels:1:-1)
855          sglidar%tau_tot  = cospOUT%calipso_tau_tot(:,:,sglidar%Nlevels:1:-1)
856       endif       
857    endif
858   
859    ! Cloudsat             
860    if (cfg%Lradar_sim) then
861       ! *NOTE* In COSP2 all outputs are ordered from TOA-2-SFC, but in COSPv1.4 this is
862       !        not true. To maintain the outputs of v1.4, the affected fields are flipped.   
863       if (cfg%Ldbze94) then
864          sgradar%Ze_tot = cospOUT%cloudsat_Ze_tot!(:,:,sgradar%Nlevels:1:-1) 
865       endif
866       if (cfg%LcfadDbze94) then
867          stradar%cfad_ze = cospOUT%cloudsat_cfad_ze(:,:,stradar%Nlevels:1:-1)             
868       endif
869    endif
870
871    ! Combined instrument products
872    if (cfg%Lclcalipso2) then
873       stradar%lidar_only_freq_cloud = cospOUT%lidar_only_freq_cloud(:,stradar%Nlevels:1:-1)   
874    endif
875    if (cfg%Lcltlidarradar) stradar%radar_lidar_tcc = cospOUT%radar_lidar_tcc     
876   
877    ! Subcolumns
878    sgx%frac_out = sgx%frac_out(:,:,sgx%Nlevels:1:-1)
879   
880    ! Clean-up memory
881    call destroy_cosp_outputs(cospOUT)
882    deallocate(vgrid_zl,vgrid_zu,vgrid_z)
883
884  end subroutine cosp_interface_v1p4
885   
886   !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
887   ! SUBROUTINE subsample_and_optics
888   !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
889  subroutine subsample_and_optics(overlap,gbx,sgx,cfg,npoints,start_idx,end_idx,cospIN,cospgridIN)
890
891    ! Inputs
892    integer, intent(in) :: overlap  ! Overlap type in SCOPS: 1=max, 2=rand, 3=max/rand
893    type(cosp_gridbox),intent(in)    :: gbx   ! Grid box description
894    type(cosp_config),intent(in)     :: cfg   ! Configuration information
895    type(cosp_subgrid),intent(inout) :: sgx   ! Sub-grid scale description
896    integer,intent(in) :: &
897         npoints,     & ! Number of points
898         start_idx,   & ! Starting index for subsetting input data.
899         end_idx        ! Ending index for subsetting input data.
900    ! Outputs
901    type(cosp_optical_inputs),intent(inout) :: &
902         cospIN         ! Optical (or derived) fields needed by simulators
903    type(cosp_column_inputs),intent(inout) :: &
904         cospgridIN     ! Model fields needed by simulators
905   
906    ! Local variables
907    integer :: i,j,k,ij
908    real(wp),dimension(npoints,gbx%Nlevels) :: column_frac_out,column_prec_out
909    real(wp),dimension(:,:),    allocatable :: frac_ls,frac_cv,prec_ls,prec_cv,ls_p_rate,&
910                                               cv_p_rate,g_vol
911    real(wp),dimension(:,:,:),allocatable :: hm_matrix,re_matrix,                        &
912                                             Np_matrix,MODIS_cloudWater,MODIS_cloudIce,  &
913                                             MODIS_watersize,MODIS_iceSize,              &
914                                             MODIS_opticalThicknessLiq,                  &
915                                             MODIS_opticalThicknessIce
916    real(wp),dimension(:,:,:,:),allocatable :: mr_hydro,Reff,Np
917    type(rng_state),allocatable,dimension(:) :: rngs  ! Seeds for random number generator
918    integer,dimension(:),allocatable :: seed
919    logical :: cmpGases=.true.
920   
921    !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
922    ! Initialize COSP inputs
923    !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
924    cospIN%tautot_S_liq                                 = 0._wp
925    cospIN%tautot_S_ice                                 = 0._wp
926    cospIN%emsfc_lw                                     = gbx%isccp_emsfc_lw
927    cospIN%rcfg_cloudsat                                = rcfg_cloudsat
928    cospgridIN%hgt_matrix(1:nPoints,1:gbx%Nlevels)      = gbx%zlev(start_idx:end_idx,gbx%Nlevels:1:-1)
929    cospgridIN%hgt_matrix_half(1:nPoints,1:gbx%Nlevels) = gbx%zlev_half(start_idx:end_idx,gbx%Nlevels:1:-1)
930    cospgridIN%sunlit(1:nPoints)                        = gbx%sunlit(start_idx:end_idx)
931    cospgridIN%skt(1:nPoints)                           = gbx%skt(start_idx:end_idx)
932    cospgridIN%land(1:nPoints)                          = gbx%land(start_idx:end_idx)
933    cospgridIN%qv(1:nPoints,1:gbx%Nlevels)              = gbx%sh(start_idx:end_idx,gbx%Nlevels:1:-1)
934    cospgridIN%at(1:nPoints,1:gbx%Nlevels)              = gbx%T(start_idx:end_idx,gbx%Nlevels:1:-1)
935    cospgridIN%pfull(1:nPoints,1:gbx%Nlevels)           = gbx%p(start_idx:end_idx,gbx%Nlevels:1:-1)
936    cospgridIN%o3(1:nPoints,1:gbx%Nlevels)              = gbx%mr_ozone(start_idx:end_idx,gbx%Nlevels:1:-1)*(amd/amO3)*1e6
937    cospgridIN%u_sfc(1:nPoints)                         = gbx%u_wind(start_idx:end_idx)
938    cospgridIN%v_sfc(1:nPoints)                         = gbx%v_wind(start_idx:end_idx)
939    cospgridIN%emis_sfc                                 = gbx%surfem
940    cospgridIN%lat(1:nPoints)                           = gbx%latitude(start_idx:end_idx)
941    cospgridIN%lon(1:nPoints)                           = gbx%longitude(start_idx:end_idx)
942    cospgridIN%month                                    = 2 ! This is needed by RTTOV only for the surface emissivity calculation.
943    cospgridIN%co2                                      = gbx%co2*(amd/amCO2)*1e6
944    cospgridIN%ch4                                      = gbx%ch4*(amd/amCH4)*1e6 
945    cospgridIN%n2o                                      = gbx%n2o*(amd/amN2O)*1e6
946    cospgridIN%co                                       = gbx%co*(amd/amCO)*1e6
947    cospgridIN%zenang                                   = gbx%zenang
948    cospgridIN%phalf(:,1)                               = 0._wp
949    cospgridIN%phalf(:,2:gbx%Nlevels+1)                 = gbx%ph(start_idx:end_idx,gbx%Nlevels:1:-1)   
950    if (gbx%Ncolumns .gt. 1) then
951       
952       !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
953       ! Random number generator
954       !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
955       allocate(rngs(Npoints),seed(Npoints))
956       seed(:)=0
957       seed = int(gbx%psfc)  ! In case of Npoints=1
958       if (Npoints .gt. 1) seed=int((gbx%psfc(start_idx:end_idx)-minval(gbx%psfc(start_idx:end_idx)))/      &
959            (maxval(gbx%psfc(start_idx:end_idx))-minval(gbx%psfc(start_idx:end_idx)))*100000) + 1
960       call init_rng(rngs, seed) 
961
962       !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
963       ! Generate subcolumns for clouds (SCOPS) and precipitation type (PREC_SCOPS)
964       !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
965       ! Call SCOPS
966       if (gbx%Ncolumns .gt. 1) then
967          call scops(npoints,gbx%Nlevels,gbx%Ncolumns,rngs,                              &
968                     gbx%tca(start_idx:end_idx,gbx%Nlevels:1:-1),                        &
969                     gbx%cca(start_idx:end_idx,gbx%Nlevels:1:-1),overlap,                &
970                     sgx%frac_out(start_idx:end_idx,:,:),0)
971          deallocate(seed,rngs)
972       else
973          sgx%frac_out(start_idx:end_idx,:,:) = 1 
974       endif
975       cospIN%frac_out=sgx%frac_out(start_idx:end_idx,:,:)
976       
977       ! Sum up precipitation rates
978       allocate(ls_p_rate(npoints,gbx%Nlevels),cv_p_rate(npoints,gbx%Nlevels))
979       if(gbx%use_precipitation_fluxes) then
980          ls_p_rate(:,gbx%Nlevels:1:-1) = gbx%rain_ls(start_idx:end_idx,1:gbx%Nlevels) + &
981               gbx%snow_ls(start_idx:end_idx,1:gbx%Nlevels) + &
982               gbx%grpl_ls(start_idx:end_idx,1:gbx%Nlevels)
983          cv_p_rate(:,gbx%Nlevels:1:-1) = gbx%rain_cv(start_idx:end_idx,1:gbx%Nlevels) + &
984               gbx%snow_cv(start_idx:end_idx,1:gbx%Nlevels)
985       else
986          ls_p_rate(:,gbx%Nlevels:1:-1) = &
987               gbx%mr_hydro(start_idx:end_idx,1:gbx%Nlevels,I_LSRAIN) +                  &
988               gbx%mr_hydro(start_idx:end_idx,1:gbx%Nlevels,I_LSSNOW) +                  &
989               gbx%mr_hydro(start_idx:end_idx,1:gbx%Nlevels,I_LSGRPL)
990          cv_p_rate(:,gbx%Nlevels:1:-1) =                                                &
991               gbx%mr_hydro(start_idx:end_idx,1:gbx%Nlevels,I_CVRAIN) +                  &
992               gbx%mr_hydro(start_idx:end_idx,1:gbx%Nlevels,I_CVSNOW)
993       endif
994       
995       ! Call PREC_SCOPS
996       call prec_scops(npoints,gbx%Nlevels,gbx%Ncolumns,ls_p_rate,cv_p_rate,             &
997                       sgx%frac_out(start_idx:end_idx,:,:),                              &
998                       sgx%prec_frac(start_idx:end_idx,:,:))
999       deallocate(ls_p_rate,cv_p_rate)
1000
1001       !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1002       ! Compute precipitation fraction in each gridbox
1003       !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1004       ! Allocate
1005       allocate(frac_ls(npoints,gbx%Nlevels),prec_ls(npoints,gbx%Nlevels),               &
1006                frac_cv(npoints,gbx%Nlevels),prec_cv(npoints,gbx%Nlevels))
1007
1008       ! Initialize
1009       frac_ls(1:npoints,1:gbx%Nlevels) = 0._wp
1010       prec_ls(1:npoints,1:gbx%Nlevels) = 0._wp
1011       frac_cv(1:npoints,1:gbx%Nlevels) = 0._wp
1012       prec_cv(1:npoints,1:gbx%Nlevels) = 0._wp
1013       do j=1,npoints,1
1014          do k=1,gbx%Nlevels,1
1015             do i=1,gbx%Ncolumns,1
1016                if (sgx%frac_out(start_idx+j-1,i,gbx%Nlevels+1-k) == I_LSC)              &
1017                     frac_ls(j,k) = frac_ls(j,k)+1._wp
1018                if (sgx%frac_out(start_idx+j-1,i,gbx%Nlevels+1-k) == I_CVC)              &
1019                     frac_cv(j,k) = frac_cv(j,k)+1._wp
1020                if (sgx%prec_frac(start_idx+j-1,i,gbx%Nlevels+1-k) .eq. 1)               &
1021                     prec_ls(j,k) = prec_ls(j,k)+1._wp
1022                if (sgx%prec_frac(start_idx+j-1,i,gbx%Nlevels+1-k) .eq. 2)               &
1023                     prec_cv(j,k) = prec_cv(j,k)+1._wp
1024                if (sgx%prec_frac(start_idx+j-1,i,gbx%Nlevels+1-k) .eq. 3)               &
1025                     prec_cv(j,k) = prec_cv(j,k)+1._wp
1026                if (sgx%prec_frac(start_idx+j-1,i,gbx%Nlevels+1-k) .eq. 3)               &
1027                     prec_ls(j,k) = prec_ls(j,k)+1._wp
1028             enddo
1029             frac_ls(j,k)=frac_ls(j,k)/gbx%Ncolumns
1030             frac_cv(j,k)=frac_cv(j,k)/gbx%Ncolumns
1031             prec_ls(j,k)=prec_ls(j,k)/gbx%Ncolumns
1032             prec_cv(j,k)=prec_cv(j,k)/gbx%Ncolumns
1033          enddo
1034       enddo
1035
1036       ! Flip SCOPS output from TOA-to-SFC to SFC-to-TOA
1037       sgx%frac_out(start_idx:end_idx,:,1:gbx%Nlevels)  =                                &
1038            sgx%frac_out(start_idx:end_idx,:,gbx%Nlevels:1:-1)
1039       sgx%prec_frac(start_idx:end_idx,:,1:gbx%Nlevels) =                                &
1040            sgx%prec_frac(start_idx:end_idx,:,gbx%Nlevels:1:-1)
1041       
1042       !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1043       ! Compute mixing ratios, effective radii and precipitation fluxes for clouds
1044       ! and precipitation
1045       !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1046       allocate(mr_hydro(npoints, gbx%Ncolumns, gbx%Nlevels, gbx%Nhydro),                &
1047                Reff(    npoints, gbx%Ncolumns, gbx%Nlevels, gbx%Nhydro),                &
1048                Np(      npoints, gbx%Ncolumns, gbx%Nlevels, gbx%Nhydro))
1049       mr_hydro(:,:,:,:) = 0._wp
1050       Reff(:,:,:,:)     = 0._wp
1051       Np(:,:,:,:)       = 0._wp
1052       do k=1,gbx%Ncolumns
1053          ! Subcolumn cloud fraction
1054          column_frac_out = sgx%frac_out(start_idx:end_idx,k,:)
1055
1056          ! LS clouds
1057          where (column_frac_out == I_LSC)
1058             mr_hydro(:,k,:,I_LSCLIQ) = gbx%mr_hydro(start_idx:end_idx,:,I_LSCLIQ)
1059             mr_hydro(:,k,:,I_LSCICE) = gbx%mr_hydro(start_idx:end_idx,:,I_LSCICE)
1060             Reff(:,k,:,I_LSCLIQ)     = gbx%Reff(start_idx:end_idx,:,I_LSCLIQ)
1061             Reff(:,k,:,I_LSCICE)     = gbx%Reff(start_idx:end_idx,:,I_LSCICE)
1062             Np(:,k,:,I_LSCLIQ)       = gbx%Np(start_idx:end_idx,:,I_LSCLIQ)
1063             Np(:,k,:,I_LSCICE)       = gbx%Np(start_idx:end_idx,:,I_LSCICE)
1064             ! CONV clouds   
1065          elsewhere (column_frac_out == I_CVC)
1066             mr_hydro(:,k,:,I_CVCLIQ) = gbx%mr_hydro(start_idx:end_idx,:,I_CVCLIQ)
1067             mr_hydro(:,k,:,I_CVCICE) = gbx%mr_hydro(start_idx:end_idx,:,I_CVCICE)
1068             Reff(:,k,:,I_CVCLIQ)     = gbx%Reff(start_idx:end_idx,:,I_CVCLIQ)
1069             Reff(:,k,:,I_CVCICE)     = gbx%Reff(start_idx:end_idx,:,I_CVCICE)
1070             Np(:,k,:,I_CVCLIQ)       = gbx%Np(start_idx:end_idx,:,I_CVCLIQ)
1071             Np(:,k,:,I_CVCICE)       = gbx%Np(start_idx:end_idx,:,I_CVCICE)
1072          end where
1073         
1074          ! Subcolumn precipitation
1075          column_prec_out = sgx%prec_frac(start_idx:end_idx,k,:)
1076         
1077          ! LS Precipitation
1078          where ((column_prec_out == 1) .or. (column_prec_out == 3) )
1079             Reff(:,k,:,I_LSRAIN) = gbx%Reff(start_idx:end_idx,:,I_LSRAIN)
1080             Reff(:,k,:,I_LSSNOW) = gbx%Reff(start_idx:end_idx,:,I_LSSNOW)
1081             Reff(:,k,:,I_LSGRPL) = gbx%Reff(start_idx:end_idx,:,I_LSGRPL)
1082             Np(:,k,:,I_LSRAIN)   = gbx%Np(start_idx:end_idx,:,I_LSRAIN)
1083             Np(:,k,:,I_LSSNOW)   = gbx%Np(start_idx:end_idx,:,I_LSSNOW)
1084             Np(:,k,:,I_LSGRPL)   = gbx%Np(start_idx:end_idx,:,I_LSGRPL)
1085          ! CONV precipitation   
1086          elsewhere ((column_prec_out == 2) .or. (column_prec_out == 3))
1087             Reff(:,k,:,I_CVRAIN) = gbx%Reff(start_idx:end_idx,:,I_CVRAIN)
1088             Reff(:,k,:,I_CVSNOW) = gbx%Reff(start_idx:end_idx,:,I_CVSNOW)
1089             Np(:,k,:,I_CVRAIN)   = gbx%Np(start_idx:end_idx,:,I_CVRAIN)
1090             Np(:,k,:,I_CVSNOW)   = gbx%Np(start_idx:end_idx,:,I_CVSNOW)
1091          end where
1092       enddo
1093       
1094       !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1095       ! Convert the mixing ratio and precipitation fluxes from gridbox mean to
1096       ! the fraction-based values
1097       !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1098       do k=1,gbx%Nlevels
1099          do j=1,npoints
1100             ! Clouds
1101             if (frac_ls(j,k) .ne. 0.) then
1102                mr_hydro(j,:,k,I_LSCLIQ) = mr_hydro(j,:,k,I_LSCLIQ)/frac_ls(j,k)
1103                mr_hydro(j,:,k,I_LSCICE) = mr_hydro(j,:,k,I_LSCICE)/frac_ls(j,k)
1104             endif
1105             if (frac_cv(j,k) .ne. 0.) then
1106                mr_hydro(j,:,k,I_CVCLIQ) = mr_hydro(j,:,k,I_CVCLIQ)/frac_cv(j,k)
1107                mr_hydro(j,:,k,I_CVCICE) = mr_hydro(j,:,k,I_CVCICE)/frac_cv(j,k)
1108             endif
1109             ! Precipitation
1110             if (gbx%use_precipitation_fluxes) then
1111                if (prec_ls(j,k) .ne. 0.) then
1112                   gbx%rain_ls(start_idx+j-1,k) = gbx%rain_ls(start_idx+j-1,k)/prec_ls(j,k)
1113                   gbx%snow_ls(start_idx+j-1,k) = gbx%snow_ls(start_idx+j-1,k)/prec_ls(j,k)
1114                   gbx%grpl_ls(start_idx+j-1,k) = gbx%grpl_ls(start_idx+j-1,k)/prec_ls(j,k)
1115                endif
1116                if (prec_cv(j,k) .ne. 0.) then
1117                   gbx%rain_cv(start_idx+j-1,k) = gbx%rain_cv(start_idx+j-1,k)/prec_cv(j,k)
1118                   gbx%snow_cv(start_idx+j-1,k) = gbx%snow_cv(start_idx+j-1,k)/prec_cv(j,k)
1119                endif
1120             else
1121                if (prec_ls(j,k) .ne. 0.) then
1122                   mr_hydro(j,:,k,I_LSRAIN) = mr_hydro(j,:,k,I_LSRAIN)/prec_ls(j,k)
1123                   mr_hydro(j,:,k,I_LSSNOW) = mr_hydro(j,:,k,I_LSSNOW)/prec_ls(j,k)
1124                   mr_hydro(j,:,k,I_LSGRPL) = mr_hydro(j,:,k,I_LSGRPL)/prec_ls(j,k)
1125                endif
1126                if (prec_cv(j,k) .ne. 0.) then
1127                   mr_hydro(j,:,k,I_CVRAIN) = mr_hydro(j,:,k,I_CVRAIN)/prec_cv(j,k)
1128                   mr_hydro(j,:,k,I_CVSNOW) = mr_hydro(j,:,k,I_CVSNOW)/prec_cv(j,k)
1129                endif
1130             endif
1131          enddo
1132       enddo
1133       deallocate(frac_ls,prec_ls,frac_cv,prec_cv)
1134
1135       !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1136       ! Convert precipitation fluxes to mixing ratios
1137       !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1138       if (gbx%use_precipitation_fluxes) then
1139          call cosp_precip_mxratio(npoints, gbx%Nlevels, gbx%Ncolumns,                   &
1140                                   gbx%p(start_idx:end_idx,:),gbx%T(start_idx:end_idx,:),&
1141                                   sgx%prec_frac(start_idx:end_idx,:,:), 1._wp,          &
1142                                   n_ax(I_LSRAIN), n_bx(I_LSRAIN),   alpha_x(I_LSRAIN),  &
1143                                   c_x(I_LSRAIN),   d_x(I_LSRAIN),   g_x(I_LSRAIN),      &
1144                                   a_x(I_LSRAIN),   b_x(I_LSRAIN),   gamma_1(I_LSRAIN),  &
1145                                   gamma_2(I_LSRAIN),gamma_3(I_LSRAIN),gamma_4(I_LSRAIN),&
1146                                   gbx%rain_ls(start_idx:end_idx,:),                     &
1147                                   mr_hydro(:,:,:,I_LSRAIN),Reff(:,:,:,I_LSRAIN))
1148          call cosp_precip_mxratio(npoints, gbx%Nlevels, gbx%Ncolumns,                   &
1149                                   gbx%p(start_idx:end_idx,:),gbx%T(start_idx:end_idx,:),&
1150                                   sgx%prec_frac(start_idx:end_idx,:,:), 1._wp,          &         
1151                                   n_ax(I_LSSNOW),  n_bx(I_LSSNOW),  alpha_x(I_LSSNOW),  &
1152                                   c_x(I_LSSNOW),   d_x(I_LSSNOW),   g_x(I_LSSNOW),      &
1153                                   a_x(I_LSSNOW),   b_x(I_LSSNOW),   gamma_1(I_LSSNOW),  &
1154                                   gamma_2(I_LSSNOW),gamma_3(I_LSSNOW),gamma_4(I_LSSNOW),&
1155                                   gbx%snow_ls(start_idx:end_idx,:),                     &
1156                                   mr_hydro(:,:,:,I_LSSNOW),Reff(:,:,:,I_LSSNOW))
1157          call cosp_precip_mxratio(npoints, gbx%Nlevels, gbx%Ncolumns,                   &
1158                                   gbx%p(start_idx:end_idx,:),gbx%T(start_idx:end_idx,:),&
1159                                   sgx%prec_frac(start_idx:end_idx,:,:), 2._wp,          &
1160                                   n_ax(I_CVRAIN),  n_bx(I_CVRAIN),  alpha_x(I_CVRAIN),  &
1161                                   c_x(I_CVRAIN),   d_x(I_CVRAIN),   g_x(I_CVRAIN),      &
1162                                   a_x(I_CVRAIN),   b_x(I_CVRAIN),   gamma_1(I_CVRAIN),  &
1163                                   gamma_2(I_CVRAIN),gamma_3(I_CVRAIN),gamma_4(I_CVRAIN),&
1164                                   gbx%rain_cv(start_idx:end_idx,:),                     &
1165                                   mr_hydro(:,:,:,I_CVRAIN),Reff(:,:,:,I_CVRAIN))
1166          call cosp_precip_mxratio(npoints, gbx%Nlevels, gbx%Ncolumns,                   &
1167                                   gbx%p(start_idx:end_idx,:),gbx%T(start_idx:end_idx,:),&
1168                                   sgx%prec_frac(start_idx:end_idx,:,:), 2._wp,          &         
1169                                   n_ax(I_CVSNOW),  n_bx(I_CVSNOW),  alpha_x(I_CVSNOW),  &
1170                                   c_x(I_CVSNOW),   d_x(I_CVSNOW),   g_x(I_CVSNOW),      &
1171                                   a_x(I_CVSNOW),   b_x(I_CVSNOW),   gamma_1(I_CVSNOW),  &
1172                                   gamma_2(I_CVSNOW),gamma_3(I_CVSNOW),gamma_4(I_CVSNOW),&
1173                                   gbx%snow_cv(start_idx:end_idx,:),                     &
1174                                   mr_hydro(:,:,:,I_CVSNOW),Reff(:,:,:,I_CVSNOW))
1175          call cosp_precip_mxratio(npoints, gbx%Nlevels, gbx%Ncolumns,                   &
1176                                   gbx%p(start_idx:end_idx,:),gbx%T(start_idx:end_idx,:),&
1177                                   sgx%prec_frac(start_idx:end_idx,:,:), 1._wp,          &         
1178                                   n_ax(I_LSGRPL),  n_bx(I_LSGRPL),  alpha_x(I_LSGRPL),  &
1179                                   c_x(I_LSGRPL),   d_x(I_LSGRPL),   g_x(I_LSGRPL),      &
1180                                   a_x(I_LSGRPL),   b_x(I_LSGRPL),   gamma_1(I_LSGRPL),  &
1181                                   gamma_2(I_LSGRPL),gamma_3(I_LSGRPL),gamma_4(I_LSGRPL),&
1182                                   gbx%grpl_ls(start_idx:end_idx,:),                     &
1183                                   mr_hydro(:,:,:,I_LSGRPL),Reff(:,:,:,I_LSGRPL))
1184       endif
1185    else
1186       allocate(mr_hydro(npoints, 1, gbx%Nlevels, gbx%Nhydro),                           &
1187                Reff(npoints,     1, gbx%Nlevels, gbx%Nhydro),                           &
1188                Np(npoints,       1, gbx%Nlevels, gbx%Nhydro))
1189       mr_hydro(:,1,:,:) = gbx%mr_hydro(start_idx:end_idx,:,:)
1190       Reff(:,1,:,:)     = gbx%Reff(start_idx:end_idx,:,:)
1191       Np(:,1,:,:)       = gbx%Np(start_idx:end_idx,:,:)
1192       where(gbx%dtau_s(start_idx:end_idx,:) .gt. 0)
1193          sgx%frac_out(start_idx:end_idx,1,:) = 1
1194       endwhere
1195    endif
1196
1197    !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1198    ! 11 micron emissivity
1199    !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1200    call cosp_simulator_optics(npoints,gbx%Ncolumns,gbx%Nlevels,                         &
1201                               sgx%frac_out(start_idx:end_idx,:,gbx%Nlevels:1:-1),       &
1202                               gbx%dem_c(start_idx:end_idx,gbx%Nlevels:1:-1),            &
1203                               gbx%dem_s(start_idx:end_idx,gbx%Nlevels:1:-1),            &
1204                               cospIN%emiss_11)
1205 
1206    !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1207    ! 0.67 micron optical depth
1208    !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1209    call cosp_simulator_optics(npoints,gbx%Ncolumns,gbx%Nlevels,                         &
1210                               sgx%frac_out(start_idx:end_idx,:,gbx%Nlevels:1:-1),       &
1211                               gbx%dtau_c(start_idx:end_idx,gbx%Nlevels:1:-1),           &
1212                               gbx%dtau_s(start_idx:end_idx,gbx%Nlevels:1:-1),           &
1213                               cospIN%tau_067)
1214   
1215    !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1216    ! LIDAR Polarized optics
1217    !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1218    if (cfg%Llidar_sim) then
1219       call lidar_optics(npoints,gbx%Ncolumns,gbx%Nlevels,4,gbx%lidar_ice_type,          &
1220                         mr_hydro(:,:,cospIN%Nlevels:1:-1,I_LSCLIQ),                     &
1221                         mr_hydro(:,:,cospIN%Nlevels:1:-1,I_LSCICE),                     &
1222                         mr_hydro(:,:,cospIN%Nlevels:1:-1,I_CVCLIQ),                     &
1223                         mr_hydro(:,:,cospIN%Nlevels:1:-1,I_CVCICE),                     &
1224                         gbx%Reff(start_idx:end_idx,cospIN%Nlevels:1:-1,I_LSCLIQ),       &
1225                         gbx%Reff(start_idx:end_idx,cospIN%Nlevels:1:-1,I_LSCICE),       &
1226                         gbx%Reff(start_idx:end_idx,cospIN%Nlevels:1:-1,I_CVCLIQ),       &
1227                         gbx%Reff(start_idx:end_idx,cospIN%Nlevels:1:-1,I_CVCICE),       &
1228                         cospgridIN%pfull,cospgridIN%phalf,cospgridIN%at,                &
1229                         cospIN%beta_mol,cospIN%betatot,cospIN%tau_mol,cospIN%tautot,    &
1230                         cospIN%tautot_S_liq,cospIN%tautot_S_ice,                        &
1231                         betatot_ice = cospIN%betatot_ice,                               &
1232                         betatot_liq=cospIN%betatot_liq,tautot_ice=cospIN%tautot_ice,    &
1233                         tautot_liq = cospIN%tautot_liq)
1234    endif
1235    !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1236    ! CLOUDSAT RADAR OPTICS
1237    !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1238    if (cfg%Lradar_sim) then
1239       allocate(g_vol(nPoints,gbx%Nlevels))
1240       do ij=1,gbx%Ncolumns
1241          if (ij .eq. 1) then
1242             cmpGases = .true.
1243             call quickbeam_optics(sd, rcfg_cloudsat,npoints,gbx%Nlevels, R_UNDEF,       &
1244                  mr_hydro(:,ij,gbx%Nlevels:1:-1,1:N_HYDRO)*1000._wp,                    &
1245                  Reff(:,ij,gbx%Nlevels:1:-1,1:N_HYDRO)*1.e6_wp,                         &
1246                  Np(:,ij,gbx%Nlevels:1:-1,1:N_HYDRO),                                   &
1247                  gbx%p(start_idx:end_idx,gbx%Nlevels:1:-1),                             &
1248                  gbx%T(start_idx:end_idx,gbx%Nlevels:1:-1),                             &
1249                  gbx%sh(start_idx:end_idx,gbx%Nlevels:1:-1),cmpGases,                   &
1250                  cospIN%z_vol_cloudsat(1:npoints,ij,:),                                 &
1251                  cospIN%kr_vol_cloudsat(1:npoints,ij,:),                                &
1252                  cospIN%g_vol_cloudsat(1:npoints,ij,:),g_vol_out=g_vol)
1253          else
1254             cmpGases = .false.
1255             call quickbeam_optics(sd, rcfg_cloudsat,npoints,gbx%Nlevels, R_UNDEF,       &
1256                  mr_hydro(:,ij,gbx%Nlevels:1:-1,1:N_HYDRO)*1000._wp,                    &
1257                  Reff(:,ij,gbx%Nlevels:1:-1,1:N_HYDRO)*1.e6_wp,                         &
1258                  Np(:,ij,gbx%Nlevels:1:-1,1:N_HYDRO),                                   &
1259                  gbx%p(start_idx:end_idx,gbx%Nlevels:1:-1),                             &
1260                  gbx%T(start_idx:end_idx,gbx%Nlevels:1:-1),                             &
1261                  gbx%sh(start_idx:end_idx,gbx%Nlevels:1:-1),cmpGases,                   &
1262                  cospIN%z_vol_cloudsat(1:npoints,ij,:),                                 &
1263                  cospIN%kr_vol_cloudsat(1:npoints,ij,:),                                &
1264                  cospIN%g_vol_cloudsat(1:npoints,ij,:),g_vol_in=g_vol)
1265          end if
1266       enddo
1267    end if
1268    !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1269    ! MODIS optics
1270    !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1271    if (cfg%Lmodis_sim) then
1272       ! Allocate memory
1273       allocate(MODIS_cloudWater(npoints,gbx%Ncolumns,gbx%Nlevels),                      &
1274                MODIS_cloudIce(npoints,gbx%Ncolumns,gbx%Nlevels),                        &
1275                MODIS_waterSize(npoints,gbx%Ncolumns,gbx%Nlevels),                       &
1276                MODIS_iceSize(npoints,gbx%Ncolumns,gbx%Nlevels),                         &
1277                MODIS_opticalThicknessLiq(npoints,gbx%Ncolumns,gbx%Nlevels),             &
1278                MODIS_opticalThicknessIce(npoints,gbx%Ncolumns,gbx%Nlevels))
1279       ! Cloud water
1280       call cosp_simulator_optics(npoints,gbx%Ncolumns,gbx%Nlevels,                      &
1281            sgx%frac_out(start_idx:end_idx,:,:),mr_hydro(:,:,:,I_CVCLIQ),                &
1282            mr_hydro(:,:,:,I_LSCLIQ),MODIS_cloudWater(:, :, gbx%Nlevels:1:-1))   
1283       ! Cloud ice
1284       call cosp_simulator_optics(npoints,gbx%Ncolumns,gbx%Nlevels,                      &
1285            sgx%frac_out(start_idx:end_idx,:,:),mr_hydro(:,:,:,I_CVCICE),                &
1286            mr_hydro(:,:,:,I_LSCICE),MODIS_cloudIce(:, :, gbx%Nlevels:1:-1)) 
1287       ! Water droplet size
1288       call cosp_simulator_optics(npoints,gbx%Ncolumns,gbx%Nlevels,                      &
1289            sgx%frac_out(start_idx:end_idx,:,:),reff(:,:,:,I_CVCLIQ),                    &
1290            reff(:,:,:,I_LSCLIQ),MODIS_waterSize(:, :, gbx%Nlevels:1:-1))
1291       ! Ice crystal size
1292       call cosp_simulator_optics(npoints,gbx%Ncolumns,gbx%Nlevels,                      &
1293            sgx%frac_out(start_idx:end_idx,:,:),reff(:,:,:,I_CVCICE),                    &
1294            reff(:,:,:,I_LSCICE),MODIS_iceSize(:, :, gbx%Nlevels:1:-1))
1295       ! Partition optical thickness into liquid and ice parts
1296       call modis_optics_partition(npoints,gbx%Nlevels,gbx%Ncolumns,MODIS_cloudWater,    &
1297            MODIS_cloudIce,MODIS_waterSize,MODIS_iceSize,cospIN%tau_067,                 &
1298            MODIS_opticalThicknessLiq, MODIS_opticalThicknessIce)
1299       ! Compute assymetry parameter and single scattering albedo
1300       call modis_optics(npoints,gbx%Nlevels,gbx%Ncolumns,MODIS_opticalThicknessLiq,     &
1301            MODIS_waterSize*1.0e6_wp,MODIS_opticalThicknessIce,MODIS_iceSize*1.0e6_wp,   &
1302            cospIN%fracLiq, cospIN%asym, cospIN%ss_alb)
1303       
1304       ! Deallocate memory
1305       deallocate(MODIS_cloudWater,MODIS_cloudIce,MODIS_WaterSize,MODIS_iceSize,         &
1306                  MODIS_opticalThicknessLiq,MODIS_opticalThicknessIce,mr_hydro,          &
1307                  Reff,Np)
1308    end if
1309   
1310  end subroutine subsample_and_optics
1311 
1312  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1313  ! SUBROUTINE construct_cosp_gridbox
1314  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1315  SUBROUTINE CONSTRUCT_cosp_gridbox(time,time_bnds,radar_freq,surface_radar,         &
1316                                         use_mie_tables,use_gas_abs,do_ray,melt_lay,k2,   &
1317                                         Npoints,Nlevels,Ncolumns,Nhydro,Nprmts_max_hydro,&
1318                                         Naero,Nprmts_max_aero,Npoints_it,lidar_ice_type, &
1319                                         isccp_top_height,isccp_top_height_direction,     &
1320                                         isccp_overlap,isccp_emsfc_lw,                    &
1321                                         use_precipitation_fluxes,use_reff,Plat,Sat,Inst, &
1322                                         Nchan,ZenAng,Ichan,SurfEm,co2,ch4,n2o,co,        &
1323                                         y,load_LUT)
1324    ! Inputs
1325    double precision,intent(in) :: &
1326         time,          & ! Time since start of run [days]
1327         time_bnds(2)     ! Time boundaries
1328    integer,intent(in) :: &
1329         surface_radar,     & ! surface=1,spaceborne=0
1330         use_mie_tables,    & ! use a precomputed lookup table? yes=1,no=0,2=use first
1331                              ! column everywhere
1332         use_gas_abs,       & ! include gaseous absorption? yes=1,no=0
1333         do_ray,            & ! calculate/output Rayleigh refl=1, not=0
1334         melt_lay,          & ! melting layer model off=0, on=1
1335         Npoints,           & ! Number of gridpoints
1336         Nlevels,           & ! Number of levels
1337         Ncolumns,          & ! Number of columns
1338         Nhydro,            & ! Number of hydrometeors
1339         Nprmts_max_hydro,  & ! Max number of parameters for hydrometeor size
1340                              ! distributions
1341         Naero,             & ! Number of aerosol species
1342         Nprmts_max_aero,   & ! Max number of parameters for aerosol size distributions
1343         Npoints_it,        & ! Number of gridpoints processed in one iteration
1344         lidar_ice_type,    & ! Ice particle shape in lidar calculations (0=ice-spheres ;
1345                              ! 1=ice-non-spherical)
1346         isccp_top_height , & !
1347         isccp_top_height_direction, & !
1348         isccp_overlap,     & !
1349         Plat,              & ! RTTOV satellite platform
1350         Sat,               & ! RTTOV satellite
1351         Inst,              & ! RTTOV instrument
1352         Nchan                ! RTTOV number of channels
1353    integer,intent(in),dimension(Nchan) :: &
1354         Ichan
1355    real(wp),intent(in) :: &
1356         radar_freq,       & ! Radar frequency [GHz]
1357         k2,               & ! |K|^2, -1=use frequency dependent default
1358         isccp_emsfc_lw,   & ! 11microm surface emissivity
1359         co2,              & ! CO2
1360         ch4,              & ! CH4
1361         n2o,              & ! N2O
1362         co,               & ! CO
1363         ZenAng              ! RTTOV zenith abgle
1364    real(wp),intent(in),dimension(Nchan) :: &
1365         SurfEm
1366    logical,intent(in) :: &
1367         use_precipitation_fluxes,&
1368         use_reff
1369    logical,intent(in),optional :: load_LUT
1370
1371    ! Outputs
1372    type(cosp_gridbox),intent(out) :: y
1373   
1374    ! local variables
1375    logical :: local_load_LUT
1376   
1377    if (present(load_LUT)) then
1378       local_load_LUT = load_LUT
1379    else
1380       local_load_LUT = RADAR_SIM_LOAD_scale_LUTs_flag
1381    endif
1382
1383    ! Dimensions and scalars
1384    y%radar_freq       = radar_freq
1385    y%surface_radar    = surface_radar
1386    y%use_mie_tables   = use_mie_tables
1387    y%use_gas_abs      = use_gas_abs
1388    y%do_ray           = do_ray
1389    y%melt_lay         = melt_lay
1390    y%k2               = k2
1391    y%Npoints          = Npoints
1392    y%Nlevels          = Nlevels
1393    y%Ncolumns         = Ncolumns
1394    y%Nhydro           = Nhydro
1395    y%Nprmts_max_hydro = Nprmts_max_hydro
1396    y%Naero            = Naero
1397    y%Nprmts_max_aero  = Nprmts_max_aero
1398    y%Npoints_it       = Npoints_it
1399    y%lidar_ice_type   = lidar_ice_type
1400    y%isccp_top_height = isccp_top_height
1401    y%isccp_top_height_direction = isccp_top_height_direction
1402    y%isccp_overlap    = isccp_overlap
1403    y%isccp_emsfc_lw   = isccp_emsfc_lw
1404    y%use_precipitation_fluxes = use_precipitation_fluxes
1405    y%use_reff = use_reff
1406    y%time      = time
1407    y%time_bnds = time_bnds
1408   
1409    ! RTTOV parameters
1410    y%Plat   = Plat
1411    y%Sat    = Sat
1412    y%Inst   = Inst
1413    y%Nchan  = Nchan
1414    y%ZenAng = ZenAng
1415    y%co2    = co2
1416    y%ch4    = ch4
1417    y%n2o    = n2o
1418    y%co     = co
1419   
1420    ! Gridbox information (Npoints,Nlevels)
1421    allocate(y%zlev(Npoints,Nlevels),y%zlev_half(Npoints,Nlevels),                       &
1422             y%dlev(Npoints,Nlevels),y%p(Npoints,Nlevels),y%ph(Npoints,Nlevels),         &
1423             y%T(Npoints,Nlevels),y%q(Npoints,Nlevels), y%sh(Npoints,Nlevels),           &
1424             y%dtau_s(Npoints,Nlevels),y%dtau_c(Npoints,Nlevels),                        &
1425             y%dem_s(Npoints,Nlevels),y%dem_c(Npoints,Nlevels),y%tca(Npoints,Nlevels),   &
1426             y%cca(Npoints,Nlevels),y%rain_ls(Npoints,Nlevels),                          &
1427             y%rain_cv(Npoints,Nlevels),y%grpl_ls(Npoints,Nlevels),                      &
1428             y%snow_ls(Npoints,Nlevels),y%snow_cv(Npoints,Nlevels),                      &
1429             y%mr_ozone(Npoints,Nlevels))
1430   
1431    ! Surface information and geolocation (Npoints)
1432    allocate(y%toffset(Npoints),y%longitude(Npoints),y%latitude(Npoints),y%psfc(Npoints),&
1433             y%land(Npoints),y%sunlit(Npoints),y%skt(Npoints),y%u_wind(Npoints),         &
1434             y%v_wind(Npoints))
1435   
1436    ! Hydrometeors concentration and distribution parameters
1437    allocate(y%mr_hydro(Npoints,Nlevels,Nhydro),y%Reff(Npoints,Nlevels,Nhydro),          &
1438             y%dist_prmts_hydro(Nprmts_max_hydro,Nhydro),y%Np(Npoints,Nlevels,Nhydro))
1439
1440    ! Aerosols concentration and distribution parameters
1441    allocate(y%conc_aero(Npoints,Nlevels,Naero), y%dist_type_aero(Naero), &
1442             y%dist_prmts_aero(Npoints,Nlevels,Nprmts_max_aero,Naero))
1443   
1444    ! RTTOV channels and sfc. emissivity
1445    allocate(y%ichan(Nchan),y%surfem(Nchan))
1446    y%ichan  = ichan
1447    y%surfem = surfem
1448   
1449    ! Initialize   
1450    y%zlev      = 0.0
1451    y%zlev_half = 0.0
1452    y%dlev      = 0.0
1453    y%p         = 0.0
1454    y%ph        = 0.0
1455    y%T         = 0.0
1456    y%q         = 0.0
1457    y%sh        = 0.0
1458    y%dtau_s    = 0.0
1459    y%dtau_c    = 0.0
1460    y%dem_s     = 0.0
1461    y%dem_c     = 0.0
1462    y%tca       = 0.0
1463    y%cca       = 0.0
1464    y%rain_ls   = 0.0
1465    y%rain_cv   = 0.0
1466    y%grpl_ls   = 0.0
1467    y%snow_ls   = 0.0
1468    y%snow_cv   = 0.0
1469    y%Reff      = 0.0
1470    y%Np        = 0.0
1471    y%mr_ozone  = 0.0
1472    y%u_wind    = 0.0
1473    y%v_wind    = 0.0
1474    y%toffset   = 0.0
1475    y%longitude = 0.0
1476    y%latitude  = 0.0
1477    y%psfc      = 0.0
1478    y%land      = 0.0
1479    y%sunlit    = 0.0
1480    y%skt       = 0.0
1481    y%mr_hydro  = 0.0
1482    y%dist_prmts_hydro = 0.0
1483    y%conc_aero        = 0.0
1484    y%dist_type_aero   = 0   
1485    y%dist_prmts_aero  = 0.0
1486   
1487  END SUBROUTINE CONSTRUCT_cosp_gridbox
1488   
1489  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1490  ! SUBROUTINE destroy_cosp_gridbox
1491  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1492  SUBROUTINE destroy_cosp_gridbox(y,save_LUT)
1493   
1494    type(cosp_gridbox),intent(inout) :: y
1495    logical,intent(in),optional :: save_LUT
1496   
1497    logical :: local_save_LUT
1498    if (present(save_LUT)) then
1499       local_save_LUT = save_LUT
1500    else
1501       local_save_LUT = RADAR_SIM_UPDATE_scale_LUTs_flag
1502    endif
1503   
1504    ! save any updates to radar simulator LUT
1505    if (local_save_LUT) call save_scale_LUTs(y%hp)
1506   
1507    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,&
1508               y%dem_c,y%toffset,y%longitude,y%latitude,y%psfc,y%land,y%tca,y%cca,       &
1509               y%mr_hydro,y%dist_prmts_hydro,y%conc_aero,y%dist_type_aero,               &
1510               y%dist_prmts_aero,y%rain_ls,y%rain_cv,y%snow_ls,y%snow_cv,y%grpl_ls,      &
1511               y%sunlit,y%skt,y%Reff,y%Np,y%ichan,y%surfem,y%mr_ozone,y%u_wind,y%v_wind)
1512   
1513  END SUBROUTINE destroy_cosp_gridbox
1514  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1515  ! SUBROUTINE construct_cosp_subgrid
1516  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1517  SUBROUTINE CONSTRUCT_COSP_SUBGRID(Npoints,Ncolumns,Nlevels,y)
1518    ! Inputs
1519    integer,intent(in) :: &
1520         Npoints,  & ! Number of gridpoints
1521         Ncolumns, & ! Number of columns
1522         Nlevels     ! Number of levels
1523    ! Outputs
1524    type(cosp_subgrid),intent(out) :: y
1525   
1526    ! Dimensions
1527    y%Npoints  = Npoints
1528    y%Ncolumns = Ncolumns
1529    y%Nlevels  = Nlevels
1530   
1531    ! Allocate
1532    allocate(y%frac_out(Npoints,Ncolumns,Nlevels))
1533    if (Ncolumns > 1) then
1534       allocate(y%prec_frac(Npoints,Ncolumns,Nlevels))
1535    else ! CRM mode, not needed
1536       allocate(y%prec_frac(1,1,1))
1537    endif
1538   
1539    ! Initialize
1540    y%prec_frac = 0._wp
1541    y%frac_out  = 0._wp
1542  END SUBROUTINE CONSTRUCT_COSP_SUBGRID 
1543  ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1544  ! SUBROUTINE save_scale_LUTs
1545  ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1546  subroutine save_scale_LUTs(hp)
1547    type(class_param), intent(inout) :: hp
1548    logical                          :: LUT_file_exists
1549    integer                          :: i,j,k,ind
1550   
1551    inquire(file=trim(hp%scale_LUT_file_name) // '_radar_Z_scale_LUT.dat', &
1552         exist=LUT_file_exists)
1553   
1554    OPEN(unit=12,file=trim(hp%scale_LUT_file_name) // '_radar_Z_scale_LUT.dat',&
1555         form='unformatted',err= 99,access='DIRECT',recl=28)
1556   
1557    write(*,*) 'Creating or Updating radar LUT file: ', &
1558         trim(hp%scale_LUT_file_name) // '_radar_Z_scale_LUT.dat'
1559   
1560    do i=1,maxhclass
1561       do j=1,mt_ntt
1562          do k=1,nRe_types
1563             ind = i+(j-1)*maxhclass+(k-1)*(nRe_types*mt_ntt)
1564             if(.not.LUT_file_exists .or. hp%Z_scale_added_flag(i,j,k)) then
1565                hp%Z_scale_added_flag(i,j,k)=.false.
1566                write(12,rec=ind) hp%Z_scale_flag(i,j,k), &
1567                     hp%Ze_scaled(i,j,k), &
1568                     hp%Zr_scaled(i,j,k), &
1569                     hp%kr_scaled(i,j,k)
1570             endif
1571          enddo
1572       enddo
1573    enddo
1574    close(unit=12)
1575    return
1576   
157799  write(*,*) 'Error: Unable to create/update radar LUT file: ', &
1578         trim(hp%scale_LUT_file_name) // '_radar_Z_scale_LUT.dat'
1579    return 
1580  end subroutine save_scale_LUTs
1581
1582  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1583  !SUBROUTINE construct_cosp_vgrid
1584  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1585  SUBROUTINE CONSTRUCT_COSP_VGRID(gbx,Nlvgrid,use_vgrid,cloudsat,x)
1586    type(cosp_gridbox),intent(in) :: gbx ! Gridbox information
1587    integer,intent(in) :: Nlvgrid  ! Number of new levels   
1588    logical,intent(in) :: use_vgrid! Logical flag that controls the output on a different grid
1589    logical,intent(in) :: cloudsat ! TRUE if a CloudSat like grid (480m) is requested
1590    type(cosp_vgrid),intent(out) :: x
1591   
1592    ! Local variables
1593    integer :: i
1594    real :: zstep
1595   
1596    x%use_vgrid  = use_vgrid
1597    x%csat_vgrid = cloudsat
1598   
1599    ! Dimensions
1600    x%Npoints  = gbx%Npoints
1601    x%Ncolumns = gbx%Ncolumns
1602    x%Nlevels  = gbx%Nlevels
1603   
1604    ! --- Allocate arrays ---
1605    if (use_vgrid) then
1606       x%Nlvgrid = Nlvgrid
1607    else
1608       x%Nlvgrid = gbx%Nlevels
1609    endif
1610    allocate(x%z(x%Nlvgrid),x%zl(x%Nlvgrid),x%zu(x%Nlvgrid))
1611    allocate(x%mz(x%Nlevels),x%mzl(x%Nlevels),x%mzu(x%Nlevels))
1612   
1613    ! --- Model vertical levels ---
1614    ! Use height levels of first model gridbox
1615    x%mz  = gbx%zlev(1,:)
1616    x%mzl = gbx%zlev_half(1,:)
1617    x%mzu(1:x%Nlevels-1) = gbx%zlev_half(1,2:x%Nlevels)
1618    x%mzu(x%Nlevels) = gbx%zlev(1,x%Nlevels) + (gbx%zlev(1,x%Nlevels) - x%mzl(x%Nlevels))
1619   
1620    if (use_vgrid) then
1621       ! --- Initialise to zero ---
1622       x%z  = 0.0
1623       x%zl = 0.0
1624       x%zu = 0.0
1625       if (cloudsat) then ! --- CloudSat grid requested ---
1626          zstep = 480.0
1627       else
1628          ! Other grid requested. Constant vertical spacing with top at 20 km
1629          zstep = 20000.0/x%Nlvgrid
1630       endif
1631       do i=1,x%Nlvgrid
1632          x%zl(i) = (i-1)*zstep
1633          x%zu(i) = i*zstep
1634       enddo
1635       x%z = (x%zl + x%zu)/2.0
1636    else
1637       x%z  = x%mz
1638       x%zl = x%mzl
1639       x%zu = x%mzu
1640    endif
1641   
1642  END SUBROUTINE CONSTRUCT_COSP_VGRID
1643  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1644  ! SUBROUTINE construct_cosp_sgradar
1645  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1646  subroutine construct_cosp_sgradar(Npoints,Ncolumns,Nlevels,Nhydro,x)
1647    integer,target,     intent(in)  :: Npoints  ! Number of sampled points
1648    integer,target,     intent(in)  :: Ncolumns ! Number of subgrid columns
1649    integer,target,     intent(in)  :: Nlevels  ! Number of model levels
1650    integer,target,     intent(in)  :: Nhydro   ! Number of hydrometeors
1651    type(cosp_sgradar), intent(out) :: x
1652
1653    ! Dimensions
1654    x%Npoints  => Npoints
1655    x%Ncolumns => Ncolumns
1656    x%Nlevels  => Nlevels
1657    x%Nhydro   => Nhydro
1658
1659    ! Allocate
1660    allocate(x%att_gas(Npoints,Nlevels),x%Ze_tot(Npoints,Ncolumns,Nlevels))
1661
1662    ! Initialize
1663    x%att_gas = 0._wp
1664    x%Ze_tot  = 0._wp
1665
1666  end subroutine construct_cosp_sgradar
1667 
1668  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1669  ! SUBROUTINE construct_cosp_radarstats
1670  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1671  subroutine construct_cosp_radarstats(Npoints,Ncolumns,Nlevels,Nhydro,x)
1672    integer,target,       intent(in)  :: Npoints  ! Number of sampled points
1673    integer,target,       intent(in)  :: Ncolumns ! Number of subgrid columns
1674    integer,target,       intent(in)  :: Nlevels  ! Number of model levels
1675    integer,target,       intent(in)  :: Nhydro   ! Number of hydrometeors
1676    type(cosp_radarstats),intent(out) :: x
1677
1678    ! Dimensions
1679    x%Npoints  => Npoints
1680    x%Ncolumns => Ncolumns
1681    x%Nlevels  => Nlevels
1682    x%Nhydro   => Nhydro
1683
1684    ! Allocate
1685    allocate(x%cfad_ze(Npoints,DBZE_BINS,Nlevels),x%lidar_only_freq_cloud(Npoints,Nlevels), &
1686             x%radar_lidar_tcc(Npoints))
1687   
1688    ! Initialize
1689    x%cfad_ze               = 0._wp
1690    x%lidar_only_freq_cloud = 0._wp
1691    x%radar_lidar_tcc       = 0._wp   
1692   
1693  end subroutine construct_cosp_radarstats
1694  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1695  ! SUBROUTINE destroy_cosp_subgrid
1696  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1697  subroutine destroy_cosp_subgrid(y)
1698    type(cosp_subgrid),intent(inout) :: y   
1699    deallocate(y%prec_frac, y%frac_out)
1700  end subroutine destroy_cosp_subgrid
1701 
1702  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1703  ! SUBROUTINE destroy_cosp_sgradar
1704  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1705  subroutine destroy_cosp_sgradar(x)
1706    type(cosp_sgradar),intent(inout) :: x
1707
1708    deallocate(x%att_gas,x%Ze_tot)
1709
1710  end subroutine destroy_cosp_sgradar
1711 
1712  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1713  ! SUBROUTINE destroy_cosp_radarstats
1714  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1715  subroutine destroy_cosp_radarstats(x)
1716    type(cosp_radarstats),intent(inout) :: x
1717
1718    deallocate(x%cfad_ze,x%lidar_only_freq_cloud,x%radar_lidar_tcc)
1719
1720  end subroutine destroy_cosp_radarstats
1721  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1722  ! SUBROUTINE construct_cosp_sglidar
1723  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1724  subroutine construct_cosp_sglidar(Npoints,Ncolumns,Nlevels,Nhydro,Nrefl,x)
1725    ! Inputs
1726    integer,intent(in),target :: &
1727         Npoints,  & ! Number of sampled points
1728         Ncolumns, & ! Number of subgrid columns
1729         Nlevels,  & ! Number of model levels
1730         Nhydro,   & ! Number of hydrometeors
1731         Nrefl       ! Number of parasol reflectances ! parasol
1732    ! Outputs
1733    type(cosp_sglidar),intent(out) :: x
1734
1735    ! Dimensions
1736    x%Npoints  => Npoints
1737    x%Ncolumns => Ncolumns
1738    x%Nlevels  => Nlevels
1739    x%Nhydro   => Nhydro
1740    x%Nrefl    => Nrefl
1741
1742    ! Allocate
1743    allocate(x%beta_mol(x%Npoints,x%Nlevels), x%beta_tot(x%Npoints,x%Ncolumns,x%Nlevels), &
1744             x%tau_tot(x%Npoints,x%Ncolumns,x%Nlevels),x%refl(x%Npoints,x%Ncolumns,x%Nrefl), &
1745             x%temp_tot(x%Npoints,x%Nlevels),x%betaperp_tot(x%Npoints,x%Ncolumns,x%Nlevels))
1746
1747    ! Initialize
1748    x%beta_mol     = 0._wp
1749    x%beta_tot     = 0._wp
1750    x%tau_tot      = 0._wp
1751    x%refl         = 0._wp
1752    x%temp_tot     = 0._wp
1753    x%betaperp_tot = 0._wp
1754  end subroutine construct_cosp_sglidar
1755 
1756  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1757  ! SUBROUTINE construct_cosp_lidarstats
1758  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1759  subroutine construct_cosp_lidarstats(Npoints,Ncolumns,Nlevels,Nhydro,Nrefl,x)
1760    ! Inputs
1761    integer,intent(in),target :: &
1762         Npoints,  & ! Number of sampled points
1763         Ncolumns, & ! Number of subgrid columns
1764         Nlevels,  & ! Number of model levels
1765         Nhydro,   & ! Number of hydrometeors
1766         Nrefl       ! Number of parasol reflectances
1767    ! Outputs
1768    type(cosp_lidarstats),intent(out) :: x
1769
1770    ! Dimensions
1771    x%Npoints  => Npoints
1772    x%Ncolumns => Ncolumns
1773    x%Nlevels  => Nlevels
1774    x%Nhydro   => Nhydro
1775    x%Nrefl    => Nrefl
1776
1777    ! Allocate
1778    allocate(x%srbval(SR_BINS),x%cfad_sr(x%Npoints,SR_BINS,x%Nlevels), &
1779         x%lidarcld(x%Npoints,x%Nlevels), x%cldlayer(x%Npoints,LIDAR_NCAT),&
1780         x%parasolrefl(x%Npoints,x%Nrefl),x%lidarcldphase(x%Npoints,x%Nlevels,6),&
1781         x%lidarcldtmp(x%Npoints,LIDAR_NTEMP,5),x%cldlayerphase(x%Npoints,LIDAR_NCAT,6))
1782
1783    ! Initialize
1784    x%srbval        = 0._wp
1785    x%cfad_sr       = 0._wp
1786    x%lidarcld      = 0._wp
1787    x%cldlayer      = 0._wp
1788    x%parasolrefl   = 0._wp
1789    x%lidarcldphase = 0._wp
1790    x%cldlayerphase = 0._wp
1791    x%lidarcldtmp   = 0._wp
1792
1793  end subroutine construct_cosp_lidarstats
1794
1795  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1796  ! SUBROUTINE destroy_cosp_lidarstats
1797  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1798  subroutine destroy_cosp_lidarstats(x)
1799    type(cosp_lidarstats),intent(inout) :: x
1800
1801    deallocate(x%srbval,x%cfad_sr,x%lidarcld,x%cldlayer,x%parasolrefl,x%cldlayerphase,   &
1802               x%lidarcldtmp,x%lidarcldphase)
1803
1804  end subroutine destroy_cosp_lidarstats
1805 
1806  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1807  ! SUBROUTINE destroy_cosp_sglidar
1808  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1809  subroutine destroy_cosp_sglidar(x)
1810    type(cosp_sglidar),intent(inout) :: x
1811
1812    deallocate(x%beta_mol,x%beta_tot,x%tau_tot,x%refl,x%temp_tot,x%betaperp_tot)
1813  end subroutine destroy_cosp_sglidar
1814  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1815  !                           SUBROUTINE construct_cosp_isccp
1816  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1817  SUBROUTINE CONSTRUCT_COSP_ISCCP(Npoints,Ncolumns,Nlevels,x)
1818    integer,target,   intent(in)  :: Npoints  ! Number of sampled points
1819    integer,target,   intent(in)  :: Ncolumns ! Number of subgrid columns
1820    integer,target,   intent(in)  :: Nlevels  ! Number of model levels
1821    type(cosp_isccp), intent(out) :: x        ! Output
1822
1823    x%Npoints  => Npoints
1824    x%Ncolumns => Ncolumns
1825    x%Nlevels  => Nlevels
1826    x%Npoints  => Npoints
1827    x%Ncolumns => Ncolumns
1828    x%Nlevels  => Nlevels
1829
1830    ! Allocate
1831    allocate(x%fq_isccp(Npoints,7,7),x%totalcldarea(Npoints),x%meanptop(Npoints),        &
1832             x%meantaucld(Npoints),x%meantb(Npoints),x%meantbclr(Npoints),               &
1833             x%meanalbedocld(Npoints),x%boxtau(Npoints,Ncolumns),                        &
1834             x%boxptop(Npoints,Ncolumns))
1835
1836    ! Initialize
1837    x%fq_isccp     = 0._wp
1838    x%totalcldarea = 0._wp
1839    x%meanptop     = 0._wp
1840    x%meantaucld   = 0._wp
1841    x%meantb       = 0._wp
1842    x%meantbclr    = 0._wp
1843    x%meanalbedocld= 0._wp
1844    x%boxtau       = 0._wp
1845    x%boxptop      = 0._wp
1846
1847  END SUBROUTINE CONSTRUCT_COSP_ISCCP
1848
1849 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1850 !                          SUBROUTINE destroy_cosp_isccp
1851 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1852  SUBROUTINE destroy_cosp_isccp(x)
1853    type(cosp_isccp),intent(inout) :: x
1854   
1855    deallocate(x%fq_isccp,x%totalcldarea,x%meanptop,x%meantaucld,x%meantb,x%meantbclr,   &
1856               x%meanalbedocld,x%boxtau,x%boxptop)
1857  END SUBROUTINE destroy_cosp_isccp
1858
1859  ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1860  !                                     SUBROUTINE construct_cosp_misr
1861  ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1862  SUBROUTINE CONSTRUCT_COSP_MISR(Npoints,x)
1863    integer,          intent(in),target   :: Npoints  ! Number of gridpoints
1864    type(cosp_misr),  intent(out)         :: x
1865
1866    ! Local variables
1867    integer,target :: &
1868         Ntau=7,Ncth=numMISRHgtBins
1869   
1870    x%Npoints => Npoints
1871    x%Ntau    => Ntau
1872    x%Nlevels => Ncth
1873
1874    ! Allocate
1875    allocate(x%fq_MISR(x%Npoints,x%Ntau,x%Nlevels),x%MISR_meanztop(x%Npoints),           &
1876             x%MISR_cldarea(x%Npoints),x%MISR_dist_model_layertops(x%Npoints,x%Nlevels))
1877
1878    ! Initialize
1879    x%fq_MISR                   = 0._wp
1880    x%MISR_meanztop             = 0._wp
1881    x%MISR_cldarea              = 0._wp
1882    x%MISR_dist_model_layertops = 0._wp
1883   
1884  END SUBROUTINE CONSTRUCT_COSP_MISR
1885 
1886 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1887 !                           SUBROUTINE destroy_cosp_misr
1888 !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1889  SUBROUTINE destroy_cosp_misr(x)
1890    type(cosp_misr),intent(inout) :: x
1891
1892    if (associated(x%fq_MISR))                   deallocate(x%fq_MISR)
1893    if (associated(x%MISR_meanztop))             deallocate(x%MISR_meanztop)
1894    if (associated(x%MISR_cldarea))              deallocate(x%MISR_cldarea)
1895    if (associated(x%MISR_dist_model_layertops)) deallocate(x%MISR_dist_model_layertops)
1896
1897  END SUBROUTINE destroy_cosp_misr
1898  ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1899  ! SUBROUTINE construct_cosp_modis
1900  ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1901  SUBROUTINE CONSTRUCT_COSP_MODIS(nPoints, x)
1902    integer,target,   intent(in)  :: Npoints  ! Number of sampled points
1903    type(cosp_MODIS), intent(out) :: x
1904   
1905    x%nPoints  => nPoints
1906   
1907    ! Allocate gridmean variables
1908    allocate(x%Cloud_Fraction_Total_Mean(Npoints),x%Cloud_Fraction_Water_Mean(Npoints),  &
1909             x%Cloud_Fraction_Ice_Mean(Npoints),x%Cloud_Fraction_High_Mean(Npoints),     &
1910             x%Cloud_Fraction_Mid_Mean(Npoints),x%Cloud_Fraction_Low_Mean(Npoints),      &
1911             x%Optical_Thickness_Total_Mean(Npoints),                                    &
1912             x%Optical_Thickness_Water_Mean(Npoints),                                    &
1913             x%Optical_Thickness_Ice_Mean(Npoints),                                      &
1914             x%Optical_Thickness_Total_LogMean(Npoints),                                 &
1915             x%Optical_Thickness_Water_LogMean(Npoints),                                 &
1916             x%Optical_Thickness_Ice_LogMean(Npoints),                                   &
1917             x%Cloud_Particle_Size_Water_Mean(Npoints),                                  &
1918             x%Cloud_Particle_Size_Ice_Mean(Npoints),                                    &
1919             x%Cloud_Top_Pressure_Total_Mean(Npoints),x%Liquid_Water_Path_Mean(Npoints), &
1920             x%Ice_Water_Path_Mean(Npoints),                                             &
1921             x%Optical_Thickness_vs_Cloud_Top_Pressure(nPoints,ntauV1p4+1,numMODISPresBins),&
1922             x%Optical_Thickness_vs_ReffICE(nPoints,ntauV1p4+1,numMODISReffIceBins),&
1923             x%Optical_Thickness_vs_ReffLIQ(nPoints,ntauV1p4+1,numMODISReffLiqBins))
1924    x%Optical_Thickness_vs_Cloud_Top_Pressure(:, :, :) = R_UNDEF
1925    x%Optical_Thickness_vs_ReffICE(:,:,:)              = R_UNDEF
1926    x%Optical_Thickness_vs_ReffLIQ(:,:,:)              = R_UNDEF
1927  END SUBROUTINE CONSTRUCT_COSP_MODIS
1928 
1929  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1930  ! SUBROUTINE destroy_cosp_modis
1931  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1932  SUBROUTINE destroy_cosp_modis(x)
1933    type(cosp_MODIS),intent(inout) :: x
1934   
1935    ! Free space used by cosp_modis variable.     
1936    if(associated(x%Cloud_Fraction_Total_Mean))  deallocate(x%Cloud_Fraction_Total_Mean)
1937    if(associated(x%Cloud_Fraction_Water_Mean))  deallocate(x%Cloud_Fraction_Water_Mean)
1938    if(associated(x%Cloud_Fraction_Ice_Mean))    deallocate(x%Cloud_Fraction_Ice_Mean)
1939    if(associated(x%Cloud_Fraction_High_Mean))   deallocate(x%Cloud_Fraction_High_Mean)
1940    if(associated(x%Cloud_Fraction_Mid_Mean))    deallocate(x%Cloud_Fraction_Mid_Mean)
1941    if(associated(x%Cloud_Fraction_Low_Mean))    deallocate(x%Cloud_Fraction_Low_Mean)
1942    if(associated(x%Liquid_Water_Path_Mean))     deallocate(x%Liquid_Water_Path_Mean)
1943    if(associated(x%Ice_Water_Path_Mean))        deallocate(x%Ice_Water_Path_Mean)
1944    if(associated(x%Optical_Thickness_Total_Mean))                                       &
1945         deallocate(x%Optical_Thickness_Total_Mean)
1946    if(associated(x%Optical_Thickness_Water_Mean))                                       &
1947         deallocate(x%Optical_Thickness_Water_Mean)
1948    if(associated(x%Optical_Thickness_Ice_Mean))                                         &
1949         deallocate(x%Optical_Thickness_Ice_Mean)
1950    if(associated(x%Optical_Thickness_Total_LogMean))                                    &
1951         deallocate(x%Optical_Thickness_Total_LogMean)
1952    if(associated(x%Optical_Thickness_Water_LogMean))                                    &
1953         deallocate(x%Optical_Thickness_Water_LogMean)
1954    if(associated(x%Optical_Thickness_Ice_LogMean))                                      &
1955         deallocate(x%Optical_Thickness_Ice_LogMean)
1956    if(associated(x%Cloud_Particle_Size_Water_Mean))                                     &
1957         deallocate(x%Cloud_Particle_Size_Water_Mean)
1958    if(associated(x%Cloud_Particle_Size_Ice_Mean))                                       &
1959         deallocate(x%Cloud_Particle_Size_Ice_Mean)
1960    if(associated(x%Cloud_Top_Pressure_Total_Mean))                                      &
1961         deallocate(x%Cloud_Top_Pressure_Total_Mean)
1962    if(associated(x%Optical_Thickness_vs_Cloud_Top_Pressure))                            &
1963         deallocate(x%Optical_Thickness_vs_Cloud_Top_Pressure)
1964    if(associated(x%Optical_Thickness_vs_ReffICE))                                       &
1965         deallocate(x%Optical_Thickness_vs_ReffICE)
1966    if(associated(x%Optical_Thickness_vs_ReffLIQ))                                       &
1967         deallocate(x%Optical_Thickness_vs_ReffLIQ)
1968  END SUBROUTINE destroy_cosp_modis 
1969  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1970  !                                              SUBROUTINE construct_cosp_rttov
1971  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1972  SUBROUTINE CONSTRUCT_COSP_RTTOV(Npoints,Nchan,x)
1973    integer,          intent(in)  :: Npoints  ! Number of sampled points
1974    integer,          intent(in)  :: Nchan    ! Number of channels
1975    type(cosp_rttov), intent(out) :: x
1976   
1977    ! Allocate
1978    allocate(x%tbs(Npoints,Nchan))
1979   
1980    ! Initialize
1981    x%tbs     = 0.0
1982  END SUBROUTINE CONSTRUCT_COSP_RTTOV
1983 
1984  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1985  !                             SUBROUTINE destroy_cosp_rttov
1986  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1987  SUBROUTINE destroy_cosp_rttov(x)
1988    type(cosp_rttov),intent(inout) :: x
1989   
1990    ! Deallocate
1991    deallocate(x%tbs)
1992  END SUBROUTINE destroy_cosp_rttov
1993  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1994  !                            SUBROUTINE destroy_cosp_
1995  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1996  subroutine destroy_cosp_vgrid(x)
1997    type(cosp_vgrid),intent(inout) :: x
1998    deallocate(x%z, x%zl, x%zu, x%mz, x%mzl, x%mzu)
1999  end subroutine destroy_cosp_vgrid
2000  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2001  ! SUBROUTINE construct_cospIN
2002  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2003  subroutine construct_cospIN(npoints,ncolumns,nlevels,y)
2004    ! Inputs
2005    integer,intent(in) :: &
2006         npoints,  & ! Number of horizontal gridpoints
2007         ncolumns, & ! Number of subcolumns
2008         nlevels     ! Number of vertical levels
2009    ! Outputs
2010    type(cosp_optical_inputs),intent(out) :: y
2011   
2012    ! Dimensions
2013    y%Npoints  = Npoints
2014    y%Ncolumns = Ncolumns
2015    y%Nlevels  = Nlevels
2016    y%Npart    = 4
2017    y%Nrefl    = PARASOL_NREFL
2018   
2019    allocate(y%tau_067(npoints,        ncolumns,nlevels),&
2020             y%emiss_11(npoints,       ncolumns,nlevels),&
2021             y%frac_out(npoints,       ncolumns,nlevels),&
2022             y%betatot(npoints,        ncolumns,nlevels),&
2023             y%betatot_ice(npoints,    ncolumns,nlevels),&
2024             y%fracLiq(npoints,        ncolumns,nlevels),&
2025             y%betatot_liq(npoints,    ncolumns,nlevels),&
2026             y%tautot(npoints,         ncolumns,nlevels),&
2027             y%tautot_ice(npoints,     ncolumns,nlevels),&
2028             y%tautot_liq(npoints,     ncolumns,nlevels),&
2029             y%z_vol_cloudsat(npoints, ncolumns,nlevels),&
2030             y%kr_vol_cloudsat(npoints,ncolumns,nlevels),&
2031             y%g_vol_cloudsat(npoints, ncolumns,nlevels),&
2032             y%asym(npoints,           ncolumns,nlevels),&
2033             y%ss_alb(npoints,         ncolumns,nlevels),&
2034             y%beta_mol(npoints,                nlevels),&
2035             y%tau_mol(npoints,                 nlevels),&
2036             y%tautot_S_ice(npoints,   ncolumns        ),&
2037             y%tautot_S_liq(npoints,   ncolumns))
2038  end subroutine construct_cospIN
2039 
2040  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2041  ! SUBROUTINE construct_cospstateIN
2042  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%     
2043  subroutine construct_cospstateIN(npoints,nlevels,nchan,y)
2044    ! Inputs
2045    integer,intent(in) :: &
2046         npoints, & ! Number of horizontal gridpoints
2047         nlevels, & ! Number of vertical levels
2048         nchan      ! Number of channels
2049    ! Outputs
2050    type(cosp_column_inputs),intent(out) :: y         
2051   
2052    allocate(y%sunlit(npoints),y%skt(npoints),y%land(npoints),y%at(npoints,nlevels),     &
2053             y%pfull(npoints,nlevels),y%phalf(npoints,nlevels+1),y%qv(npoints,nlevels),  &
2054             y%o3(npoints,nlevels),y%hgt_matrix(npoints,nlevels),y%u_sfc(npoints),       &
2055             y%v_sfc(npoints),y%lat(npoints),y%lon(nPoints),y%emis_sfc(nchan),           &
2056             y%cloudIce(nPoints,nLevels),y%cloudLiq(nPoints,nLevels),                    &
2057             y%fl_snow(nPoints,nLevels),y%fl_rain(nPoints,nLevels),y%seaice(npoints),    &
2058             y%tca(nPoints,nLevels),y%hgt_matrix_half(npoints,nlevels+1))
2059
2060  end subroutine construct_cospstateIN
2061
2062  ! ######################################################################################
2063  ! SUBROUTINE construct_cosp_outputs
2064  !
2065  ! This subroutine allocates output fields based on input logical flag switches.
2066  ! ###################################################################################### 
2067  subroutine construct_cosp_outputs(Lpctisccp,Lclisccp,&
2068                                    Lboxptopisccp,Lboxtauisccp,Ltauisccp,Lcltisccp,      &
2069                                    Lmeantbisccp,Lmeantbclrisccp,Lalbisccp,LclMISR,      &
2070                                    Lcltmodis,Lclwmodis,Lclimodis,Lclhmodis,Lclmmodis,   &
2071                                    Lcllmodis,Ltautmodis,Ltauwmodis,Ltauimodis,          &
2072                                    Ltautlogmodis,Ltauwlogmodis,Ltauilogmodis,           &
2073                                    Lreffclwmodis,Lreffclimodis,Lpctmodis,Llwpmodis,     &
2074                                    Liwpmodis,Lclmodis,Latb532,LlidarBetaMol532,         &
2075                                    LcfadLidarsr532,Lclcalipso2,                         &
2076                                    Lclcalipso,Lclhcalipso,Lcllcalipso,Lclmcalipso,      &
2077                                    Lcltcalipso,Lcltlidarradar,Lclcalipsoliq,            &
2078                                    Lclcalipsoice,Lclcalipsoun,Lclcalipsotmp,            &
2079                                    Lclcalipsotmpliq,Lclcalipsotmpice,Lclcalipsotmpun,   &
2080                                    Lcltcalipsoliq,Lcltcalipsoice,Lcltcalipsoun,         &
2081                                    Lclhcalipsoliq,Lclhcalipsoice,Lclhcalipsoun,         &
2082                                    Lclmcalipsoliq,Lclmcalipsoice,Lclmcalipsoun,         &
2083                                    Lcllcalipsoliq,Lcllcalipsoice,Lcllcalipsoun,         &
2084                                    LcfadDbze94,Ldbze94,Lparasolrefl,Ltbrttov, &
2085                                    Npoints,Ncolumns,Nlevels,Nlvgrid,Nchan,x)
2086     ! Inputs
2087     logical,intent(in) :: &
2088         Lpctisccp,        & ! ISCCP mean cloud top pressure
2089         Lclisccp,         & ! ISCCP cloud area fraction
2090         Lboxptopisccp,    & ! ISCCP CTP in each column
2091         Lboxtauisccp,     & ! ISCCP optical epth in each column
2092         Ltauisccp,        & ! ISCCP mean optical depth
2093         Lcltisccp,        & ! ISCCP total cloud fraction
2094         Lmeantbisccp,     & ! ISCCP mean all-sky 10.5micron brightness temperature
2095         Lmeantbclrisccp,  & ! ISCCP mean clear-sky 10.5micron brightness temperature
2096         Lalbisccp,        & ! ISCCP mean cloud albedo         
2097         LclMISR,          & ! MISR cloud fraction
2098         Lcltmodis,        & ! MODIS total cloud fraction
2099         Lclwmodis,        & ! MODIS liquid cloud fraction
2100         Lclimodis,        & ! MODIS ice cloud fraction
2101         Lclhmodis,        & ! MODIS high-level cloud fraction
2102         Lclmmodis,        & ! MODIS mid-level cloud fraction
2103         Lcllmodis,        & ! MODIS low-level cloud fraction
2104         Ltautmodis,       & ! MODIS total cloud optical thicknes
2105         Ltauwmodis,       & ! MODIS liquid optical thickness
2106         Ltauimodis,       & ! MODIS ice optical thickness
2107         Ltautlogmodis,    & ! MODIS total cloud optical thickness (log10 mean)
2108         Ltauwlogmodis,    & ! MODIS liquid optical thickness (log10 mean)
2109         Ltauilogmodis,    & ! MODIS ice optical thickness (log10 mean)
2110         Lreffclwmodis,    & ! MODIS liquid cloud particle size
2111         Lreffclimodis,    & ! MODIS ice particle size
2112         Lpctmodis,        & ! MODIS cloud top pressure
2113         Llwpmodis,        & ! MODIS cloud liquid water path
2114         Liwpmodis,        & ! MODIS cloud ice water path
2115         Lclmodis,         & ! MODIS cloud area fraction
2116         Latb532,          & ! CALIPSO attenuated total backscatter (532nm)
2117         LlidarBetaMol532, & ! CALIPSO molecular backscatter (532nm)         
2118         LcfadLidarsr532,  & ! CALIPSO scattering ratio CFAD
2119         Lclcalipso2,      & ! CALIPSO cloud fraction undetected by cloudsat
2120         Lclcalipso,       & ! CALIPSO cloud area fraction
2121         Lclhcalipso,      & ! CALIPSO high-level cloud fraction
2122         Lcllcalipso,      & ! CALIPSO low-level cloud fraction
2123         Lclmcalipso,      & ! CALIPSO mid-level cloud fraction
2124         Lcltcalipso,      & ! CALIPSO total cloud fraction
2125         Lcltlidarradar,   & ! CALIPSO-CLOUDSAT total cloud fraction
2126         Lclcalipsoliq,    & ! CALIPSO liquid cloud area fraction
2127         Lclcalipsoice,    & ! CALIPSO ice cloud area fraction
2128         Lclcalipsoun,     & ! CALIPSO undetected cloud area fraction
2129         Lclcalipsotmp,    & ! CALIPSO undetected cloud area fraction
2130         Lclcalipsotmpliq, & ! CALIPSO liquid cloud area fraction
2131         Lclcalipsotmpice, & ! CALIPSO ice cloud area fraction
2132         Lclcalipsotmpun,  & ! CALIPSO undetected cloud area fraction
2133         Lcltcalipsoliq,   & ! CALIPSO liquid total cloud fraction
2134         Lcltcalipsoice,   & ! CALIPSO ice total cloud fraction
2135         Lcltcalipsoun,    & ! CALIPSO undetected total cloud fraction
2136         Lclhcalipsoliq,   & ! CALIPSO high-level liquid cloud fraction
2137         Lclhcalipsoice,   & ! CALIPSO high-level ice cloud fraction
2138         Lclhcalipsoun,    & ! CALIPSO high-level undetected cloud fraction
2139         Lclmcalipsoliq,   & ! CALIPSO mid-level liquid cloud fraction
2140         Lclmcalipsoice,   & ! CALIPSO mid-level ice cloud fraction
2141         Lclmcalipsoun,    & ! CALIPSO mid-level undetected cloud fraction
2142         Lcllcalipsoliq,   & ! CALIPSO low-level liquid cloud fraction
2143         Lcllcalipsoice,   & ! CALIPSO low-level ice cloud fraction
2144         Lcllcalipsoun,    & ! CALIPSO low-level undetected cloud fraction
2145         LcfadDbze94,      & ! CLOUDSAT radar reflectivity CFAD
2146         Ldbze94,          & ! CLOUDSAT radar reflectivity
2147         LparasolRefl,     & ! PARASOL reflectance
2148         Ltbrttov            ! RTTOV mean clear-sky brightness temperature
2149     
2150     integer,intent(in) :: &
2151          Npoints,         & ! Number of sampled points
2152          Ncolumns,        & ! Number of subgrid columns
2153          Nlevels,         & ! Number of model levels
2154          Nlvgrid,         & ! Number of levels in L3 stats computation
2155          Nchan              ! Number of RTTOV channels 
2156         
2157     ! Outputs
2158     type(cosp_outputs),intent(out) :: &
2159          x           ! COSP output structure 
2160   
2161     ! ISCCP simulator outputs
2162    if (Lboxtauisccp)    allocate(x%isccp_boxtau(Npoints,Ncolumns))
2163    if (Lboxptopisccp)   allocate(x%isccp_boxptop(Npoints,Ncolumns))
2164    if (Lclisccp)        allocate(x%isccp_fq(Npoints,numISCCPTauBins,numISCCPPresBins))
2165    if (Lcltisccp)       allocate(x%isccp_totalcldarea(Npoints))
2166    if (Lpctisccp)       allocate(x%isccp_meanptop(Npoints))
2167    if (Ltauisccp)       allocate(x%isccp_meantaucld(Npoints))
2168    if (Lmeantbisccp)    allocate(x%isccp_meantb(Npoints))
2169    if (Lmeantbclrisccp) allocate(x%isccp_meantbclr(Npoints))
2170    if (Lalbisccp)       allocate(x%isccp_meanalbedocld(Npoints))
2171   
2172    ! MISR simulator
2173    if (LclMISR) then
2174       allocate(x%misr_fq(Npoints,numMISRTauBins,numMISRHgtBins))
2175       ! *NOTE* These 3 fields are not output, but were part of the v1.4.0 cosp_misr, so
2176       !        they are still computed. Should probably have a logical to control these
2177       !        outputs.
2178       allocate(x%misr_dist_model_layertops(Npoints,numMISRHgtBins))
2179       allocate(x%misr_meanztop(Npoints))
2180       allocate(x%misr_cldarea(Npoints))   
2181    endif
2182   
2183    ! MODIS simulator
2184    if (Lcltmodis)     allocate(x%modis_Cloud_Fraction_Total_Mean(Npoints))
2185    if (Lclwmodis)     allocate(x%modis_Cloud_Fraction_Water_Mean(Npoints))
2186    if (Lclimodis)     allocate(x%modis_Cloud_Fraction_Ice_Mean(Npoints))
2187    if (Lclhmodis)     allocate(x%modis_Cloud_Fraction_High_Mean(Npoints))
2188    if (Lclmmodis)     allocate(x%modis_Cloud_Fraction_Mid_Mean(Npoints))
2189    if (Lcllmodis)     allocate(x%modis_Cloud_Fraction_Low_Mean(Npoints))
2190    if (Ltautmodis)    allocate(x%modis_Optical_Thickness_Total_Mean(Npoints))
2191    if (Ltauwmodis)    allocate(x%modis_Optical_Thickness_Water_Mean(Npoints))
2192    if (Ltauimodis)    allocate(x%modis_Optical_Thickness_Ice_Mean(Npoints))
2193    if (Ltautlogmodis) allocate(x%modis_Optical_Thickness_Total_LogMean(Npoints))
2194    if (Ltauwlogmodis) allocate(x%modis_Optical_Thickness_Water_LogMean(Npoints))
2195    if (Ltauilogmodis) allocate(x%modis_Optical_Thickness_Ice_LogMean(Npoints))
2196    if (Lreffclwmodis) allocate(x%modis_Cloud_Particle_Size_Water_Mean(Npoints))
2197    if (Lreffclimodis) allocate(x%modis_Cloud_Particle_Size_Ice_Mean(Npoints))
2198    if (Lpctmodis)     allocate(x%modis_Cloud_Top_Pressure_Total_Mean(Npoints))
2199    if (Llwpmodis)     allocate(x%modis_Liquid_Water_Path_Mean(Npoints))
2200    if (Liwpmodis)     allocate(x%modis_Ice_Water_Path_Mean(Npoints))
2201    if (Lclmodis) then
2202        allocate(x%modis_Optical_Thickness_vs_Cloud_Top_Pressure(nPoints,numModisTauBins,numMODISPresBins))
2203        allocate(x%modis_Optical_thickness_vs_ReffLIQ(nPoints,numMODISTauBins,numMODISReffLiqBins))   
2204        allocate(x%modis_Optical_Thickness_vs_ReffICE(nPoints,numMODISTauBins,numMODISReffIceBins))
2205    endif
2206   
2207    ! LIDAR simulator
2208    if (LlidarBetaMol532) allocate(x%calipso_beta_mol(Npoints,Nlevels))
2209    if (Latb532)          allocate(x%calipso_beta_tot(Npoints,Ncolumns,Nlevels))
2210    if (LcfadLidarsr532)  then
2211        allocate(x%calipso_srbval(SR_BINS+1))
2212        allocate(x%calipso_cfad_sr(Npoints,SR_BINS,Nlvgrid))
2213        allocate(x%calipso_betaperp_tot(Npoints,Ncolumns,Nlevels)) 
2214    endif
2215    if (Lclcalipso)       allocate(x%calipso_lidarcld(Npoints,Nlvgrid))
2216    if (Lclhcalipso .or. Lclmcalipso .or. Lcllcalipso .or. Lcltcalipso) then
2217        allocate(x%calipso_cldlayer(Npoints,LIDAR_NCAT))
2218    endif   
2219    if (Lclcalipsoice .or. Lclcalipsoliq .or. Lclcalipsoun) then
2220        allocate(x%calipso_lidarcldphase(Npoints,Nlvgrid,6))
2221    endif
2222    if (Lclcalipsotmp .or. Lclcalipsotmpliq .or. Lclcalipsoice .or. Lclcalipsotmpun .or. Lclcalipsotmpice) then
2223        allocate(x%calipso_lidarcldtmp(Npoints,LIDAR_NTEMP,5))
2224    endif
2225    if (Lcllcalipsoice .or. Lclmcalipsoice .or. Lclhcalipsoice .or.                   &
2226        Lcltcalipsoice .or. Lcllcalipsoliq .or. Lclmcalipsoliq .or.                   &
2227        Lclhcalipsoliq .or. Lcltcalipsoliq .or. Lcllcalipsoun  .or.                   &
2228        Lclmcalipsoun  .or. Lclhcalipsoun  .or. Lcltcalipsoun) then
2229        allocate(x%calipso_cldlayerphase(Npoints,LIDAR_NCAT,6))     
2230    endif
2231    ! These 2 outputs are part of the calipso output type, but are not controlled by an
2232    ! logical switch in the output namelist, so if all other fields are on, then allocate
2233    if (LlidarBetaMol532 .or. Latb532        .or. LcfadLidarsr532 .or. Lclcalipso  .or.  &
2234        Lclcalipsoice    .or. Lclcalipsoliq  .or. Lclcalipsoun    .or. Lclcalipso2 .or.  &
2235        Lclhcalipso      .or. Lclmcalipso    .or. Lcllcalipso     .or. Lcltcalipso .or.  &
2236        Lclcalipsotmp    .or. Lclcalipsoice  .or. Lclcalipsotmpun .or.                   &
2237        Lclcalipsotmpliq .or. Lcllcalipsoice .or. Lclmcalipsoice  .or.                   &
2238        Lclhcalipsoice   .or. Lcltcalipsoice .or. Lcllcalipsoliq  .or.                   &
2239        Lclmcalipsoliq   .or. Lclhcalipsoliq .or. Lcltcalipsoliq  .or.                   &
2240        Lcllcalipsoun    .or. Lclmcalipsoun  .or. Lclhcalipsoun   .or. Lcltcalipsoun) then
2241       allocate(x%calipso_tau_tot(Npoints,Ncolumns,Nlevels))       
2242       allocate(x%calipso_temp_tot(Npoints,Nlevels))               
2243    endif
2244     
2245    ! PARASOL
2246    if (Lparasolrefl) then
2247        allocate(x%parasolPix_refl(Npoints,Ncolumns,PARASOL_NREFL))
2248        allocate(x%parasolGrid_refl(Npoints,PARASOL_NREFL))
2249    endif
2250
2251    ! Cloudsat simulator
2252    if (Ldbze94)        allocate(x%cloudsat_Ze_tot(Npoints,Ncolumns,Nlevels))
2253    if (LcfadDbze94)    allocate(x%cloudsat_cfad_ze(Npoints,DBZE_BINS,Nlvgrid))
2254
2255    ! Combined CALIPSO/CLOUDSAT fields
2256    if (Lclcalipso2)    allocate(x%lidar_only_freq_cloud(Npoints,Nlvgrid))
2257    if (Lcltlidarradar) allocate(x%radar_lidar_tcc(Npoints))
2258       
2259    ! RTTOV
2260    if (Ltbrttov) allocate(x%rttov_tbs(Npoints,Nchan))
2261 
2262  end subroutine construct_cosp_outputs
2263 
2264  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2265  ! SUBROUTINE destroy_cospIN     
2266  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2267  subroutine destroy_cospIN(y)
2268    type(cosp_optical_inputs),intent(inout) :: y
2269
2270    if (allocated(y%tau_067))         deallocate(y%tau_067)
2271    if (allocated(y%emiss_11))        deallocate(y%emiss_11)
2272    if (allocated(y%frac_out))        deallocate(y%frac_out)
2273    if (allocated(y%beta_mol))        deallocate(y%beta_mol)
2274    if (allocated(y%tau_mol))         deallocate(y%tau_mol)
2275    if (allocated(y%betatot))         deallocate(y%betatot)
2276    if (allocated(y%betatot_ice))     deallocate(y%betatot_ice)
2277    if (allocated(y%betatot_liq))     deallocate(y%betatot_liq)
2278    if (allocated(y%tautot))          deallocate(y%tautot)
2279    if (allocated(y%tautot_ice))      deallocate(y%tautot_ice)
2280    if (allocated(y%tautot_liq))      deallocate(y%tautot_liq)
2281    if (allocated(y%tautot_S_liq))    deallocate(y%tautot_S_liq)
2282    if (allocated(y%tautot_S_ice))    deallocate(y%tautot_S_ice)
2283    if (allocated(y%z_vol_cloudsat))  deallocate(y%z_vol_cloudsat)
2284    if (allocated(y%kr_vol_cloudsat)) deallocate(y%kr_vol_cloudsat)
2285    if (allocated(y%g_vol_cloudsat))  deallocate(y%g_vol_cloudsat)
2286    if (allocated(y%asym))            deallocate(y%asym)
2287    if (allocated(y%ss_alb))          deallocate(y%ss_alb)
2288    if (allocated(y%fracLiq))         deallocate(y%fracLiq)
2289
2290  end subroutine destroy_cospIN
2291  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2292  ! SUBROUTINE destroy_cospstateIN     
2293  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
2294  subroutine destroy_cospstateIN(y)
2295    type(cosp_column_inputs),intent(inout) :: y
2296
2297    if (allocated(y%sunlit))          deallocate(y%sunlit)
2298    if (allocated(y%skt))             deallocate(y%skt)
2299    if (allocated(y%land))            deallocate(y%land)
2300    if (allocated(y%at))              deallocate(y%at)
2301    if (allocated(y%pfull))           deallocate(y%pfull)
2302    if (allocated(y%phalf))           deallocate(y%phalf)
2303    if (allocated(y%qv))              deallocate(y%qv)
2304    if (allocated(y%o3))              deallocate(y%o3)
2305    if (allocated(y%hgt_matrix))      deallocate(y%hgt_matrix)
2306    if (allocated(y%u_sfc))           deallocate(y%u_sfc)
2307    if (allocated(y%v_sfc))           deallocate(y%v_sfc)
2308    if (allocated(y%lat))             deallocate(y%lat)
2309    if (allocated(y%lon))             deallocate(y%lon)
2310    if (allocated(y%emis_sfc))        deallocate(y%emis_sfc)
2311    if (allocated(y%cloudIce))        deallocate(y%cloudIce)
2312    if (allocated(y%cloudLiq))        deallocate(y%cloudLiq)
2313    if (allocated(y%seaice))          deallocate(y%seaice)
2314    if (allocated(y%fl_rain))         deallocate(y%fl_rain)
2315    if (allocated(y%fl_snow))         deallocate(y%fl_snow)
2316    if (allocated(y%tca))             deallocate(y%tca)
2317    if (allocated(y%hgt_matrix_half)) deallocate(y%hgt_matrix_half)   
2318   
2319  end subroutine destroy_cospstateIN
2320 
2321  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2322  ! SUBROUTINE destroy_cosp_outputs
2323  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 
2324  subroutine destroy_cosp_outputs(y)
2325     type(cosp_outputs),intent(inout) :: y
2326
2327     ! Deallocate and nullify
2328     if (associated(y%calipso_beta_mol))          then
2329        deallocate(y%calipso_beta_mol)
2330        nullify(y%calipso_beta_mol)
2331     endif
2332     if (associated(y%calipso_temp_tot))          then
2333        deallocate(y%calipso_temp_tot)
2334        nullify(y%calipso_temp_tot)     
2335     endif
2336     if (associated(y%calipso_betaperp_tot))      then
2337        deallocate(y%calipso_betaperp_tot)
2338        nullify(y%calipso_betaperp_tot)     
2339     endif
2340     if (associated(y%calipso_beta_tot))          then
2341        deallocate(y%calipso_beta_tot)   
2342        nullify(y%calipso_beta_tot)     
2343     endif
2344     if (associated(y%calipso_tau_tot))           then
2345        deallocate(y%calipso_tau_tot)
2346        nullify(y%calipso_tau_tot)     
2347     endif
2348     if (associated(y%calipso_lidarcldphase))     then
2349        deallocate(y%calipso_lidarcldphase)
2350        nullify(y%calipso_lidarcldphase)     
2351     endif
2352     if (associated(y%calipso_cldlayerphase))     then
2353        deallocate(y%calipso_cldlayerphase)
2354        nullify(y%calipso_cldlayerphase)     
2355     endif
2356     if (associated(y%calipso_lidarcldtmp))       then
2357        deallocate(y%calipso_lidarcldtmp)
2358        nullify(y%calipso_lidarcldtmp)     
2359     endif
2360     if (associated(y%calipso_cldlayer))          then
2361        deallocate(y%calipso_cldlayer)
2362        nullify(y%calipso_cldlayer)     
2363     endif
2364     if (associated(y%calipso_lidarcld))         then
2365        deallocate(y%calipso_lidarcld)
2366        nullify(y%calipso_lidarcld)     
2367     endif
2368     if (associated(y%calipso_srbval))            then
2369        deallocate(y%calipso_srbval)
2370        nullify(y%calipso_srbval)     
2371     endif
2372     if (associated(y%calipso_cfad_sr))          then
2373        deallocate(y%calipso_cfad_sr)
2374        nullify(y%calipso_cfad_sr)     
2375     endif
2376     if (associated(y%parasolPix_refl))           then
2377        deallocate(y%parasolPix_refl)
2378        nullify(y%parasolPix_refl)     
2379     endif
2380     if (associated(y%parasolGrid_refl))          then
2381        deallocate(y%parasolGrid_refl)
2382        nullify(y%parasolGrid_refl)     
2383     endif
2384     if (associated(y%cloudsat_Ze_tot))           then
2385        deallocate(y%cloudsat_Ze_tot)
2386        nullify(y%cloudsat_Ze_tot) 
2387     endif
2388     if (associated(y%cloudsat_cfad_ze))          then
2389        deallocate(y%cloudsat_cfad_ze)
2390        nullify(y%cloudsat_cfad_ze)     
2391     endif
2392     if (associated(y%radar_lidar_tcc))           then
2393        deallocate(y%radar_lidar_tcc)
2394        nullify(y%radar_lidar_tcc) 
2395     endif
2396     if (associated(y%lidar_only_freq_cloud))     then
2397        deallocate(y%lidar_only_freq_cloud)
2398        nullify(y%lidar_only_freq_cloud)     
2399     endif
2400     if (associated(y%isccp_totalcldarea))        then
2401        deallocate(y%isccp_totalcldarea)
2402        nullify(y%isccp_totalcldarea) 
2403     endif
2404     if (associated(y%isccp_meantb))              then
2405        deallocate(y%isccp_meantb)
2406        nullify(y%isccp_meantb)     
2407     endif
2408     if (associated(y%isccp_meantbclr))           then
2409        deallocate(y%isccp_meantbclr)
2410        nullify(y%isccp_meantbclr) 
2411     endif
2412     if (associated(y%isccp_meanptop))            then
2413        deallocate(y%isccp_meanptop)
2414        nullify(y%isccp_meanptop)     
2415     endif
2416     if (associated(y%isccp_meantaucld))          then
2417        deallocate(y%isccp_meantaucld)
2418        nullify(y%isccp_meantaucld)       
2419     endif
2420     if (associated(y%isccp_meanalbedocld))       then
2421        deallocate(y%isccp_meanalbedocld)
2422        nullify(y%isccp_meanalbedocld)     
2423     endif
2424     if (associated(y%isccp_boxtau))              then
2425        deallocate(y%isccp_boxtau)
2426        nullify(y%isccp_boxtau)       
2427     endif
2428     if (associated(y%isccp_boxptop))             then
2429        deallocate(y%isccp_boxptop)
2430        nullify(y%isccp_boxptop)     
2431     endif
2432     if (associated(y%isccp_fq))                  then
2433        deallocate(y%isccp_fq)
2434        nullify(y%isccp_fq)       
2435     endif
2436     if (associated(y%misr_fq))                   then
2437        deallocate(y%misr_fq)
2438        nullify(y%misr_fq)     
2439     endif
2440     if (associated(y%misr_dist_model_layertops)) then
2441        deallocate(y%misr_dist_model_layertops)
2442        nullify(y%misr_dist_model_layertops)       
2443     endif
2444     if (associated(y%misr_meanztop))             then
2445        deallocate(y%misr_meanztop)
2446        nullify(y%misr_meanztop)     
2447     endif
2448     if (associated(y%misr_cldarea))              then
2449        deallocate(y%misr_cldarea)
2450        nullify(y%misr_cldarea)     
2451     endif
2452     if (associated(y%rttov_tbs))                 then
2453        deallocate(y%rttov_tbs)
2454        nullify(y%rttov_tbs)     
2455     endif
2456     if (associated(y%modis_Cloud_Fraction_Total_Mean))                      then
2457        deallocate(y%modis_Cloud_Fraction_Total_Mean)       
2458        nullify(y%modis_Cloud_Fraction_Total_Mean)       
2459     endif
2460     if (associated(y%modis_Cloud_Fraction_Ice_Mean))                        then
2461        deallocate(y%modis_Cloud_Fraction_Ice_Mean)     
2462        nullify(y%modis_Cloud_Fraction_Ice_Mean)     
2463     endif
2464     if (associated(y%modis_Cloud_Fraction_Water_Mean))                      then
2465        deallocate(y%modis_Cloud_Fraction_Water_Mean)           
2466        nullify(y%modis_Cloud_Fraction_Water_Mean)           
2467     endif
2468     if (associated(y%modis_Cloud_Fraction_High_Mean))                       then
2469        deallocate(y%modis_Cloud_Fraction_High_Mean)     
2470        nullify(y%modis_Cloud_Fraction_High_Mean)     
2471     endif
2472     if (associated(y%modis_Cloud_Fraction_Mid_Mean))                        then
2473        deallocate(y%modis_Cloud_Fraction_Mid_Mean)       
2474        nullify(y%modis_Cloud_Fraction_Mid_Mean)       
2475     endif
2476     if (associated(y%modis_Cloud_Fraction_Low_Mean))                        then
2477        deallocate(y%modis_Cloud_Fraction_Low_Mean)     
2478        nullify(y%modis_Cloud_Fraction_Low_Mean)     
2479     endif
2480     if (associated(y%modis_Optical_Thickness_Total_Mean))                   then
2481        deallocate(y%modis_Optical_Thickness_Total_Mean) 
2482        nullify(y%modis_Optical_Thickness_Total_Mean) 
2483     endif
2484     if (associated(y%modis_Optical_Thickness_Water_Mean))                   then
2485        deallocate(y%modis_Optical_Thickness_Water_Mean)     
2486        nullify(y%modis_Optical_Thickness_Water_Mean)     
2487     endif
2488     if (associated(y%modis_Optical_Thickness_Ice_Mean))                     then
2489        deallocate(y%modis_Optical_Thickness_Ice_Mean)       
2490        nullify(y%modis_Optical_Thickness_Ice_Mean)       
2491     endif
2492     if (associated(y%modis_Optical_Thickness_Total_LogMean))                then
2493        deallocate(y%modis_Optical_Thickness_Total_LogMean)   
2494        nullify(y%modis_Optical_Thickness_Total_LogMean)   
2495     endif
2496     if (associated(y%modis_Optical_Thickness_Water_LogMean))                then
2497        deallocate(y%modis_Optical_Thickness_Water_LogMean)     
2498        nullify(y%modis_Optical_Thickness_Water_LogMean)     
2499     endif
2500     if (associated(y%modis_Optical_Thickness_Ice_LogMean))                  then
2501        deallocate(y%modis_Optical_Thickness_Ice_LogMean)     
2502        nullify(y%modis_Optical_Thickness_Ice_LogMean)     
2503     endif
2504     if (associated(y%modis_Cloud_Particle_Size_Water_Mean))                 then
2505        deallocate(y%modis_Cloud_Particle_Size_Water_Mean)       
2506        nullify(y%modis_Cloud_Particle_Size_Water_Mean)       
2507     endif
2508     if (associated(y%modis_Cloud_Particle_Size_Ice_Mean))                   then
2509        deallocate(y%modis_Cloud_Particle_Size_Ice_Mean)     
2510        nullify(y%modis_Cloud_Particle_Size_Ice_Mean)     
2511     endif
2512     if (associated(y%modis_Cloud_Top_Pressure_Total_Mean))                  then
2513        deallocate(y%modis_Cloud_Top_Pressure_Total_Mean)           
2514        nullify(y%modis_Cloud_Top_Pressure_Total_Mean)           
2515     endif
2516     if (associated(y%modis_Liquid_Water_Path_Mean))                         then
2517        deallocate(y%modis_Liquid_Water_Path_Mean)     
2518        nullify(y%modis_Liquid_Water_Path_Mean)     
2519     endif
2520     if (associated(y%modis_Ice_Water_Path_Mean))                            then
2521        deallocate(y%modis_Ice_Water_Path_Mean)       
2522        nullify(y%modis_Ice_Water_Path_Mean)       
2523     endif
2524     if (associated(y%modis_Optical_Thickness_vs_Cloud_Top_Pressure))        then
2525        deallocate(y%modis_Optical_Thickness_vs_Cloud_Top_Pressure)     
2526        nullify(y%modis_Optical_Thickness_vs_Cloud_Top_Pressure)     
2527     endif
2528     if (associated(y%modis_Optical_thickness_vs_ReffLIQ))                   then
2529        deallocate(y%modis_Optical_thickness_vs_ReffLIQ)
2530        nullify(y%modis_Optical_thickness_vs_ReffLIQ)
2531     endif
2532     if (associated(y%modis_Optical_thickness_vs_ReffICE))                   then
2533        deallocate(y%modis_Optical_thickness_vs_ReffICE)
2534        nullify(y%modis_Optical_thickness_vs_ReffICE)
2535     endif
2536       
2537   end subroutine destroy_cosp_outputs
2538
2539   
2540  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2541  !                                    END MODULE
2542  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
2543end module MOD_COSP_INTERFACE_v1p4
Note: See TracBrowser for help on using the repository browser.